split rectangles

Layout.hs

{-# LANGUAGE OverlappingInstances #-}
{-# LANGUAGE IncoherentInstances #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE TypeOperators #-}
module Layout where

import Raylib.Types

-- | Horizontal split
newtype H a = H a

-- | Vertical split
newtype V a = V a

class Layout r where
  --  | split a Rectangle dispatching on the result type, so that
  --
  --  > let V (rw, H (b1, b2, b3)) = layout (Rectangle 0 0 80 80)
  --
  -- defines one big rectangle rw and three below it.
  layout :: Rectangle -> r

instance (r ~ Rectangle) => Layout r where
  layout r = r

instance (Layout r, Layout s) => Layout (H (r, s)) where
  layout r = case hcatn r 2 of
    [a,b] -> H (layout a,layout b)

instance (Layout r, Layout s, Layout t) => Layout (H (r, s, t)) where
  layout r = case hcatn r 3 of
    [a,b,c] -> H (layout a,layout b,layout c)

instance (Layout r, Layout s, Layout t, Layout u) => Layout (H (r, s, t, u)) where
  layout r = case hcatn r 4 of
    [a,b,c,d] -> H (layout a,layout b,layout c, layout d)

instance (Layout r, Layout s, Layout t, Layout u, Layout v) => Layout (H (r, s, t, u, v)) where
  layout r = case hcatn r 5 of
    [a,b,c,d, e] -> H (layout a,layout b,layout c, layout d, layout e)

instance (Layout r, Layout s, Layout t, Layout u, Layout v, Layout w) => Layout (H (r, s, t, u, v, w)) where
  layout r = case hcatn r 6 of
    [a,b,c,d,e,f] -> H (layout a,layout b,layout c, layout d, layout e, layout f)

instance (Layout r, Layout s, Layout t, Layout u, Layout v, Layout w, Layout x) => Layout (H (r, s, t, u, v, w, x)) where
  layout r = case hcatn r 7 of
    [a,b,c,d,e,f,g] -> H (layout a,layout b,layout c, layout d, layout e, layout f, layout g)

instance (Layout r, Layout s) => Layout (V (r, s)) where
  layout r = case vcatn r 2 of
    [a,b] -> V (layout a,layout b)

instance (Layout r, Layout s, Layout t) => Layout (V (r, s, t)) where
  layout r = case vcatn r 3 of
    [a,b,c] -> V (layout a,layout b,layout c)

instance (Layout r, Layout s, Layout t, Layout u) => Layout (V (r, s, t, u)) where
  layout r = case vcatn r 4 of
    [a,b,c,d] -> V (layout a,layout b,layout c, layout d)

instance (Layout r, Layout s, Layout t, Layout u, Layout v) => Layout (V (r, s, t, u, v)) where
  layout r = case vcatn r 5 of
    [a,b,c,d, e] -> V (layout a,layout b,layout c, layout d, layout e)

instance (Layout r, Layout s, Layout t, Layout u, Layout v, Layout w) => Layout (V (r, s, t, u, v, w)) where
  layout r = case vcatn r 6 of
    [a,b,c,d,e,f] -> V (layout a,layout b,layout c, layout d, layout e, layout f)

instance (Layout r, Layout s, Layout t, Layout u, Layout v, Layout w, Layout x) => Layout (V (r, s, t, u, v, w, x)) where
  layout r = case vcatn r 7 of
    [a,b,c,d,e,f,g] -> V (layout a,layout b,layout c, layout d, layout e, layout f, layout g)

hcatn :: Rectangle -> Float -> [Rectangle]
hcatn (Rectangle x y w h) n = [ Rectangle (x + i*w/n) y (1 + w/n) h | i <- [0 .. n-1]]

vcatn :: Rectangle -> Float -> [Rectangle]
vcatn (Rectangle x y w h) n = [ Rectangle x (y + i*w/n) w (1 + h/n) | i <- [0 .. n-1]]