{- * Programmer: Piotr Borek * E-mail: piotrborek@op.pl * Copyright 2015 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 Coin.UI.Widgets.StackWidget ( StackWidget, stackWidgetNew, stackWidgetAdd, stackWidgetGet, stackWidgetShow, stackWidgetGetVisible ) where import qualified System.Glib.Types as Gtk import qualified Graphics.UI.Gtk as Gtk import qualified Data.Map.Strict as Map import Control.Monad import Coin.Utils.IORef data StackWidget = StackWidget { stackContainer :: Gtk.VBox, stackWidgetMap :: IORef (Map.Map String Gtk.Widget) } instance Gtk.GObjectClass StackWidget where toGObject = Gtk.toGObject . stackContainer unsafeCastGObject = undefined instance Gtk.WidgetClass StackWidget stackWidgetNew :: IO StackWidget stackWidgetNew = do box <- Gtk.vBoxNew False 0 Gtk.widgetShow box ref <- newIORef Map.empty return $ StackWidget box ref stackWidgetAdd :: Gtk.WidgetClass cls => StackWidget -> String -> cls -> IO () stackWidgetAdd stack name widget = do Gtk.boxPackStart (stackContainer stack) widget Gtk.PackGrow 0 atomicModifyIORef_' (stackWidgetMap stack) $ Map.insert name (Gtk.castToWidget widget) Gtk.widgetHide widget stackWidgetGet :: StackWidget -> String -> IO Gtk.Widget stackWidgetGet stack name = do (Just w) <- Map.lookup name <$> atomicReadIORef' (stackWidgetMap stack) return w stackWidgetShow :: StackWidget -> String -> IO () stackWidgetShow stack name = do m <- readIORef $ stackWidgetMap stack case Map.lookup name m of Just widget -> do forM_ (Map.elems m) Gtk.widgetHide Gtk.widgetShow widget Nothing -> return () stackWidgetGetVisible :: StackWidget -> IO (Maybe String) stackWidgetGetVisible stack = do m <- readIORef $ stackWidgetMap stack foldM (\rval (name, widget) -> case rval of j@(Just _) -> return j Nothing -> do visible <- Gtk.widgetGetVisible widget if visible then return $ Just name else return Nothing ) Nothing (Map.toList m)