{-# LANGUAGE CPP #-} ----------------------------------------------------------------------------- -- | -- Module : Hoodle.ModelAction.Layer -- Copyright : (c) 2011-2014 Ian-Woo Kim -- -- License : BSD3 -- Maintainer : Ian-Woo Kim -- Stability : experimental -- Portability : GHC -- ----------------------------------------------------------------------------- module Hoodle.ModelAction.Layer where -- from other packages import Control.Category import Control.Lens (view,over) import Data.IORef import qualified Graphics.UI.Gtk as Gtk -- from hoodle-platform import Data.Hoodle.Generic import Data.Hoodle.Zipper import Graphics.Hoodle.Render.Type -- import Hoodle.Util import Hoodle.Type.Alias -- import Prelude hiding ((.),id) -- | getCurrentLayer :: Page EditMode -> RLayer getCurrentLayer = current . view glayers -- | adjustCurrentLayer :: RLayer -> Page EditMode -> Page EditMode adjustCurrentLayer nlayer = over glayers (replace nlayer) -- | layerChooseDialog :: IORef Int -> Int -> Int -> IO Gtk.Dialog layerChooseDialog layernumref cidx len = do dialog <- Gtk.dialogNew layerentry <- Gtk.entryNew Gtk.entrySetText layerentry (show (succ cidx)) label <- Gtk.labelNew (Just (" / " ++ show len)) hbox <- Gtk.hBoxNew False 0 #ifdef GTK3 upper <- fmap Gtk.castToContainer (Gtk.dialogGetContentArea dialog) Gtk.containerAdd upper hbox #else upper <- Gtk.dialogGetUpper dialog Gtk.boxPackStart upper hbox Gtk.PackNatural 0 #endif Gtk.boxPackStart hbox layerentry Gtk.PackNatural 0 Gtk.boxPackStart hbox label Gtk.PackGrow 0 Gtk.widgetShowAll upper buttonOk <- Gtk.dialogAddButton dialog Gtk.stockOk Gtk.ResponseOk _buttonCancel <- Gtk.dialogAddButton dialog Gtk.stockCancel Gtk.ResponseCancel buttonOk `Gtk.on` Gtk.buttonActivated $ do txt <- Gtk.get layerentry Gtk.entryText maybe (return ()) (modifyIORef layernumref . const . pred) . maybeRead $ txt return dialog