packages feed

keera-posture-0.2.1: 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 Data.ReactiveValue
import Graphics.UI.Gtk
import Graphics.UI.Gtk.Reactive

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 = do

  -- Model RVs
  let stField      = mkFieldAccessor statusField                     (model cenv)
      notifEnabled = mkFieldAccessor notificationEnabledField        (model cenv)
      notifOverl   = mkFieldAccessor notificationOverlayEnabledField (model cenv)

  let shouldNotify = liftR3 (\x y z -> x && y && z)
                            ((StatusNotifying ==) `liftR` stField)
                            notifEnabled
                            notifOverl

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

  -- Reactive Rules
  widgetVisibleReactive win <:= shouldNotify

-- import Control.Monad
  -- onEvent pm Initialised                       $ condition cenv
  -- onEvent pm NotificationEnabledChanged        $ condition cenv
  -- onEvent pm NotificationOverlayEnabledChanged $ condition cenv
  -- onEvent pm StatusChanged                     $ condition cenv
-- -- | 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