keera-posture-0.1.3: src/Controller/Conditions/Welcome.hs
-- | Shows a splash window giving the user some basic instructions. This will
-- only be shown if the user executes the program for the first time.
module Controller.Conditions.Welcome where
import Control.Arrow
import Control.Monad
import Control.Monad.Trans
import Graphics.UI.Gtk
import CombinedEnvironment
import Hails.MVC.Model.ProtectedModel.Reactive
installHandlers :: CEnv -> IO()
installHandlers cenv = void $ do
let (ui, pm) = ((mainWindowBuilder . view) &&& model) cenv
-- Show the welcome window only when necessary (if this is not the first time
-- that the program is executed)
onEvent pm FirstRunChanged $ condition cenv
-- guardRO (firstRunField (model cenv) `liftR` (== Just True)) =:>
-- windowVisiblePassive welcomeWindow
-- buttonActivatedReactive btn =:> (windowVisiblePassive welcomeWindow `liftW` False)
-- windowCloseReactive btn =:> (windowVisiblePassive welcomeWindow `liftW` False)
-- Hide the window when requested
win <- welcomeWindow ui
win `on` deleteEvent $ liftIO (onViewAsync (widgetHide win)) >> return True
btn <- welcomeOkBtn ui
btn `on` buttonActivated $ onViewAsync (widgetHide win)
-- Shows the window if this is the first time the program is run
condition :: CEnv -> IO()
condition cenv = onViewAsync $ do
fr <- getter firstRunField $ model cenv
when (fr == Just True) $
widgetShowAll =<< welcomeWindow (mainWindowBuilder $ view cenv)