-- | The functions from this module specify the geometry 
-- of the GUI-elements. They tell where to render the elements.
--
-- Every element is rectangular. To know where to place the element is 
-- to know the parameters of the bounding rectangle. All rectangles are
-- relative and automatically aligned. 
--
-- We have two functions for grouping. They construct horizontal and vertical
-- groups of the elements. Within the group we can change the relative size 
-- of the rectangles (by scaling one side of the rectangle). In place of rectangle
-- we can put an empty space. 
module Csound.Control.Gui.Layout (
    hor, ver, space, sca, horSca, verSca, grid,
    padding, margin, ScaleFactor, resizeGui,
) where

import Csound.Typed.Gui


-- | Layouts the widgets in grid. The first argument is the number of widgets in the row.
--
-- > grid rowLength widgets
grid :: Int -> [Gui] -> Gui
grid :: Int -> [Gui] -> Gui
grid Int
columnSize [Gui]
guis = [Gui] -> Gui
ver ([Gui] -> Gui) -> [Gui] -> Gui
forall a b. (a -> b) -> a -> b
$ ([Gui] -> Gui) -> [[Gui]] -> [Gui]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [Gui] -> Gui
hor ([[Gui]] -> [Gui]) -> [[Gui]] -> [Gui]
forall a b. (a -> b) -> a -> b
$ Int -> [Gui] -> [[Gui]]
splitList Int
columnSize [Gui]
guis
    where
        splitList :: Int -> [Gui] -> [[Gui]]
splitList Int
n [Gui]
xs = case Int -> [Gui] -> ([Gui], [Gui])
forall a. Int -> [a] -> ([a], [a])
splitAt Int
n [Gui]
xs of
            ([Gui]
res, []) -> [[Gui]
res [Gui] -> [Gui] -> [Gui]
forall a. [a] -> [a] -> [a]
++ [Gui] -> [Gui]
forall (t :: * -> *) a. Foldable t => t a -> [Gui]
spaceTail [Gui]
xs]
            ([Gui]
as,[Gui]
rest) -> [Gui]
as [Gui] -> [[Gui]] -> [[Gui]]
forall a. a -> [a] -> [a]
: Int -> [Gui] -> [[Gui]]
splitList Int
n [Gui]
rest

        spaceTail :: t a -> [Gui]
spaceTail t a
xs = Int -> Gui -> [Gui]
forall a. Int -> a -> [a]
replicate Int
n Gui
space
            where n :: Int
n = Int -> Int
getMissingToEven (t a -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length t a
xs)

        getMissingToEven :: Int -> Int
getMissingToEven Int
total =  case Int
total Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
columnSize of
            Int
0 -> Int
0
            Int
n -> Int
columnSize Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
n