tabloid-0.3: MultiWidgetContainerController.hs

{-# LANGUAGE ExistentialQuantification #-}

module MultiWidgetContainerController
    (
     new
    , test
    , view
    , Controller
    ) where

import Graphics.UI.Gtk
import qualified MultiWidgetContainerView as View
import qualified DataProcController as DP
import Component
import WindowedApp
import Control.Applicative
import qualified Data.Map as M

type Controller = Ref C

view = View.mainWidget . gui

new :: IO Controller
new = do
  v@(View.V _ _ _ ab) <- View.new 
  this <- newRef (C v M.empty)
  onClicked ab (this .<< addComponent) 
  return this

removeComponent :: String -> C -> C
removeComponent name state = 
  state { components = (M.delete name (components state)) }
  
addComponent :: C -> IO C
addComponent (C g cs) = do
  name <- entryGetText (View.nameE g)
  putStrLn $ "add comp " ++ name
  dpc <- DP.new
  (dpc .> DP.view) >>= View.add g name
  let cs' =  M.insert name dpc cs
  return (C g cs')

-- internal 
data C = C 
    { gui :: View.ViewState
    , components :: M.Map String DP.Controller
    }

test = windowedApp "RegexDefinitionController test" $ do
         clut <- new
         mw <- View.mainWidget <$>  (clut .> gui)         
         return mw