{- * 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 -} {-#LANGUAGE ViewPatterns #-} module Simple.UI.Layouts.SingleLayout ( SingleLayout (..), SingleLayoutData (..), SingleLayoutClass, singleLayoutNew, layoutIndex, def ) where import Control.Lens (element, (^?)) import Control.Monad (forM_) import Data.Default.Class import Simple.UI.Core.Internal.UIApp import Simple.UI.Core.Attribute import Simple.UI.Core.ListenerList import Simple.UI.Widgets.Container import Simple.UI.Widgets.Widget newtype SingleLayout = SingleLayout { _singleLayoutIndex :: Attribute Int } data SingleLayoutData = SingleLayoutData class LayoutClass w => SingleLayoutClass w where layoutIndex :: w -> Attribute Int instance LayoutClass SingleLayout where type LayoutData SingleLayout = SingleLayoutData layoutDraw (castToContainer -> container) drawing width height = do _widgets <- get container widgets forM_ _widgets $ \(widget, _) -> set widget visible False maybeWidget <- singleLayoutWidget container case maybeWidget of Just widget -> do set widget visible True fire widget draw (drawing, width, height) Nothing -> return () layoutComputeSize (castToContainer -> container) = do maybeWidget <- singleLayoutWidget container case maybeWidget of Just widget -> computeSize widget Nothing -> return (1, 1) instance SingleLayoutClass SingleLayout where layoutIndex = _singleLayoutIndex instance Default SingleLayoutData where def = SingleLayoutData singleLayoutNew :: UIApp u SingleLayout singleLayoutNew = do index <- attributeNew 0 return SingleLayout { _singleLayoutIndex = index } singleLayoutWidget :: Container SingleLayout -> UIApp u (Maybe Widget) singleLayoutWidget container = do _widgets <- get container widgets if null _widgets then return Nothing else do _layout <- get container layout index <- readAttr $ layoutIndex _layout return $ fst <$> _widgets ^? element index