packages feed

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)