module Simple.UI.Layouts.FillLayout (
FillLayout (..),
FillLayoutData (..),
fillLayoutVerticalNew,
fillLayoutHorizontalNew,
def
) where
import Control.Monad
import Data.Default.Class
import Data.Maybe
import Simple.UI.Core.Attribute
import Simple.UI.Core.Draw
import Simple.UI.Core.Internal.UIApp
import Simple.UI.Core.ListenerList
import Simple.UI.Widgets.Container
import Simple.UI.Widgets.Widget
data FillLayout = FillLayoutHorizontal
| FillLayoutVertical
deriving (Eq)
data FillLayoutData = FillLayoutData
{ fillLayoutHExpand :: Bool
, fillLayoutVExpand :: Bool
}
instance LayoutClass FillLayout where
type LayoutData FillLayout = FillLayoutData
layoutDraw container drawing width height = do
_layout <- get container layout
_widgets <- get container widgets
fillLayoutDraw _layout _widgets drawing width height
layoutComputeSize container = do
_widgets <- get container widgets
if null _widgets
then
return (0, 0)
else do
_layout <- get container layout
sizes <- forM _widgets $ \(widget, _) -> do
v <- get widget visible
if v then computeSize widget else return (0, 0)
fillLayoutComputeSize _layout sizes
instance Default FillLayoutData where
def = FillLayoutData
{ fillLayoutHExpand = True
, fillLayoutVExpand = True
}
fillLayoutComputeSize :: FillLayout -> [(Int, Int)] -> UIApp u (Int, Int)
fillLayoutComputeSize FillLayoutVertical sizes =
return (maximum $ fmap fst sizes, sum $ fmap snd sizes)
fillLayoutComputeSize FillLayoutHorizontal sizes =
return (sum $ fmap fst sizes, maximum $ fmap snd sizes)
fillLayoutDraw :: FillLayout -> [(Widget, FillLayoutData)] -> Drawing -> Int -> Int -> UIApp u ()
fillLayoutDraw FillLayoutVertical _widgets drawing width height = do
filteredWidgets <- flip filterM _widgets $ \(widget, _) ->
get widget visible
heights <- forM filteredWidgets $ \(widget, layoutData) ->
if fillLayoutVExpand layoutData
then return Nothing
else Just . snd <$> computeSize widget
let sumHeight = sum $ catMaybes heights
let deltaH = if height - sumHeight < 0 then 0 else height - sumHeight
let countEW = countExpandedWidgets filteredWidgets
let expandedH = if countEW == 0 then 0 else deltaH `div` countEW
let restH = if countEW == 0 then deltaH else deltaH `mod` countEW
drawWidgets (fmap fst filteredWidgets) heights expandedH restH 0
where
drawWidgets [] _ _ _ _ = return ()
drawWidgets _ [] _ _ _ = return ()
drawWidgets (_widget:ws) (maybeHeight:mhs) expandedH restH y =
case maybeHeight of
Nothing -> do
let h = expandedH + nat restH
layoutDrawWidget _widget drawing 0 y width h
drawWidgets ws mhs expandedH (dec restH) (y + h)
Just wHeight -> do
layoutDrawWidget _widget drawing 0 y width wHeight
drawWidgets ws mhs expandedH restH (y + wHeight)
countExpandedWidgets filteredWidgets = sum $
flip fmap filteredWidgets $ \(_, layoutData) ->
if fillLayoutVExpand layoutData
then 1
else 0
fillLayoutDraw FillLayoutHorizontal _widgets drawing width height = do
filteredWidgets <- flip filterM _widgets $ \(widget, _) ->
get widget visible
widths <- forM filteredWidgets $ \(widget, layoutData) ->
if fillLayoutHExpand layoutData
then return Nothing
else Just . fst <$> computeSize widget
let sumWidth = sum $ catMaybes widths
let deltaW = if width - sumWidth < 0 then 0 else width - sumWidth
let countEW = countExpandedWidgets filteredWidgets
let expandedW = if countEW == 0 then 0 else deltaW `div` countEW
let restH = if countEW == 0 then deltaW else deltaW `mod` countEW
drawWidgets (fmap fst filteredWidgets) widths expandedW restH 0
where
drawWidgets [] _ _ _ _ = return ()
drawWidgets _ [] _ _ _ = return ()
drawWidgets (_widget:ws) (maybeWidth:mws) expandedW restW x =
case maybeWidth of
Nothing -> do
let w = expandedW + nat restW
layoutDrawWidget _widget drawing x 0 w height
drawWidgets ws mws expandedW (dec restW) (x + w)
Just wWidth -> do
layoutDrawWidget _widget drawing x 0 wWidth height
drawWidgets ws mws expandedW restW (x + wWidth)
countExpandedWidgets filteredWidgets= sum $
flip fmap filteredWidgets $ \(_, layoutData) ->
if fillLayoutHExpand layoutData
then 1
else 0
layoutDrawWidget :: Widget -> Drawing -> Int -> Int -> Int -> Int -> UIApp u ()
layoutDrawWidget widget drawing x y width height = do
d <- drawingSliceNew drawing x y width height
fire widget draw (d, width, height)
fillLayoutVerticalNew :: UIApp u FillLayout
fillLayoutVerticalNew = return FillLayoutVertical
fillLayoutHorizontalNew :: UIApp u FillLayout
fillLayoutHorizontalNew = return FillLayoutHorizontal
dec :: Int -> Int
dec x = if x < 0 then x else x - 1
nat :: Int -> Int
nat x = if x > 0 then 1 else 0