{-# LANGUAGE ExistentialQuantification #-} module MultiWidgetContainerController ( new , main , 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 M.empty) onClicked ab (addComponent this) return this removeComponent :: String -> C -> C removeComponent name state = state { components = (M.delete name (components state)) } addComponent :: Controller -> IO () addComponent this = this .<< \(C g cs env) -> do name <- entryGetText (View.nameE g) putStrLn $ "add comp " ++ name dpc <- DP.new (this .>> getEnv) (dpc .> DP.view) >>= View.add g name let cs' = M.insert name dpc cs dpc .< DP.onUpdate (Just (\ls -> this .<< dpcUpdated name ls)) return (C g cs' env) -- internal getEnv :: C -> IO DP.Env getEnv = return . contents dpcUpdated :: String -> [[String]] -> C -> IO C dpcUpdated name content state = do putStrLn $ "new content from " ++ name return (state {contents = M.insert name content (contents state)}) data C = C { gui :: View.ViewState , components :: M.Map String DP.Controller , contents :: DP.Env } main = windowedApp "tabloid" $ do clut <- new mw <- View.mainWidget <$> (clut .> gui) return mw