packages feed

keera-posture-0.1.3: src/Controller/Conditions/NotifyWindow.hs

-- | Shows a pseudo-overlay window when the user must be notified and this kind
-- of notification is enabled
module Controller.Conditions.NotifyWindow where

import Control.Arrow
import Control.Monad
import Graphics.UI.Gtk

import CombinedEnvironment
import Model.Model (Status(..))
import Hails.MVC.Model.ProtectedModel.Reactive

-- | Notifies/stops notifying when the system is started, or when notification,
-- status or overlay are changed.
installHandlers :: CEnv -> IO()
installHandlers cenv = void $ do
  let (vw, pm) = (view &&& model) cenv
  onEvent pm Initialised                       $ condition cenv
  onEvent pm NotificationEnabledChanged        $ condition cenv
  onEvent pm NotificationOverlayEnabledChanged $ condition cenv
  onEvent pm StatusChanged                     $ condition cenv

  -- FIXME: This should be on the view only
  win <- notificationWindow $ mainWindowBuilder vw
  widgetModifyBg win StateNormal $ Color 65256 32256 32256

-- | Resets the visibility of the notification window
condition :: CEnv -> IO()
condition cenv = onViewAsync $ do
  let (vw, pm) = (view &&& model) cenv
  status         <- getStatus pm
  notifyEnabled  <- getter notificationEnabledField pm
  overlayEnabled <- getter notificationOverlayEnabledField pm
  win            <- notificationWindow $ mainWindowBuilder vw
  
  if status == StatusNotifying && notifyEnabled && overlayEnabled
   then widgetShowAll win
   else widgetHideAll win