{- | Module : Control.FRPNow.GTK.Buttons Copyright : (c) George Steel 2017 License : BSD3 Maintainer : george.steel@gmail.org Functions for creating buttons which interact with FRPNow. -} module Control.FRPNow.GTK.Buttons ( IconName, createButton, createDynamicButton, createToggleButton, -- * Checkboxes createCheckButton, createStaticChecklist, createDynamicChecklist, ) where import Control.FRPNow.GTK.Core import Control.FRPNow.GTK.Containers import Graphics.UI.Gtk import Control.Applicative import Control.Monad import Control.FRPNow import Data.Maybe import qualified Data.Text as T import Data.Text (Text) -- | Type for standard icon names. -- The value should be contained in the standard list at . type IconName = T.Text -- | Creates a button with (optionally) text and an icon. Returns the button and when it is pressed. createButton :: Maybe IconName -> Maybe Text -> Now (Button, EvStream ()) createButton micon mlbl = do btn <- sync buttonNew iattr <- case micon of Just icon -> do img <- sync $ imageNewFromIconName icon IconSizeButton return [buttonImage := img] Nothing -> return [] let tattr = maybeToList (fmap (buttonLabel :=) mlbl) sync $ set btn (iattr ++ tattr) pressed <- getUnitSignal buttonActivated btn return (btn, pressed) -- | Creates a toggle button with an initial state. Breutns the button and it's current state. createToggleButton :: Maybe IconName -> Maybe Text -> Bool -> Now (ToggleButton, Behavior Bool) createToggleButton micon mlbl initstate = do btn <- sync toggleButtonNew iattr <- case micon of Just icon -> do img <- sync $ imageNewFromIconName icon IconSizeButton return [buttonImage := img] Nothing -> return [] let tattr = maybeToList (fmap (buttonLabel :=) mlbl) sync $ set btn (iattr ++ tattr ++ [toggleButtonActive := initstate]) updated <- getSignal toggled btn (toggleButtonGetActive btn >>=) st <- sample $ fromChanges initstate updated return (btn,st) -- | Creates a button with dynamic text. createDynamicButton :: Behavior Text -> Now (Button,EvStream ()) createDynamicButton s = do button <- sync buttonNew setAttr buttonLabel button s stream <- getUnitSignal buttonActivated button return (button,stream) -------------------------------------------------------------------------------- -- | Creates a checkbox with text an an initial state. Returns the widget and its current state createCheckButton :: Text -> Bool -> Now (CheckButton, Behavior Bool) createCheckButton txt initstate = do btn <- sync $ checkButtonNewWithLabel txt sync $ set btn [toggleButtonActive := initstate] updated <- getSignal toggled btn (toggleButtonGetActive btn >>=) st <- sample $ fromChanges initstate updated return (btn,st) createChecklistItem :: (a, Text) -> Bool -> Now (CheckButton, Behavior [a]) createChecklistItem (val, txt) initstate = do (btn,st) <- createCheckButton txt initstate return (btn, fmap (\b -> if b then [val] else []) st) -- | Creates a set of checkboxes from a list of (item,label) pairs and a list of initially-checked items. Returns a list of 'CheckButton's (use a function on the "Containers" module to pack them) and the currently-selected items. createStaticChecklist :: Eq a => [(a,Text)] -> [a] -> Now ([CheckButton], Behavior [a]) createStaticChecklist items startchecked = do btns <- forM items $ \item@(val,txt) -> createChecklistItem item (val `elem` startchecked) let (cbs, results) = unzip btns vals = mconcat results return (cbs, vals) -- | Creates a checklist to select from a dynamic list of objects (updating the displayed checkboxes). Returns the checklist (stacked vertically in a VBox) and the currently selected items. createDynamicChecklist :: Eq a => Behavior [(a, Text)] -> Now (VBox, Behavior [a]) createDynamicChecklist dynitems = do box <- sync $ vBoxNew False 0 inititems <- sample dynitems (initboxes,initselected) <- createStaticChecklist inititems [] sync $ forM_ initboxes $ \cb -> boxPackStart box cb PackNatural 0 let itemsChanged = toChanges dynitems (outReplaced,replaceOut) <- callbackStream selected <- sample $ foldrSwitch initselected outReplaced flip callStream itemsChanged $ \itemslist -> do let newitems = last itemslist oldselection <- sample selected sync $ clearChildren box (newboxes,newselected) <- createStaticChecklist newitems oldselection sync $ forM_ newboxes $ \cb -> boxPackStart box cb PackNatural 0 sync $ widgetShowAll box sync $ replaceOut newselected return () return (box,selected)