{- * Programmer: Piotr Borek * E-mail: piotrborek@op.pl * Copyright 2017 Piotr Borek * * Distributed under the terms of the GPL (GNU Public License) * * This program is free software; you can redistribute it and/or modify * it under the terms of the GNU General Public License as published by * the Free Software Foundation; either version 2 of the License, or * (at your option) any later version. * * This program is distributed in the hope that it will be useful, * but WITHOUT ANY WARRANTY; without even the implied warranty of * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the * GNU General Public License for more details. * * You should have received a copy of the GNU General Public License * along with this program; if not, write to the Free Software * Foundation, Inc., 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA -} 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