never executed always true always false
    1 {-|
    2 Module: Flaw.UI.Popup
    3 Description: Popup.
    4 License: MIT
    5 -}
    6 
    7 module Flaw.UI.Popup
    8   ( Popup(..)
    9   , PopupService(..)
   10   , newPopupService
   11   , newPopup
   12   ) where
   13 
   14 import Control.Concurrent.STM
   15 
   16 import Flaw.Math
   17 import Flaw.UI
   18 import Flaw.UI.Metrics
   19 import Flaw.UI.Panel
   20 
   21 data Popup = Popup
   22   { popupPanel :: !Panel
   23   , popupClose :: !(STM ())
   24   }
   25 
   26 data PopupService = PopupService
   27   { popupServiceMetrics :: !Metrics
   28   , popupServiceContainer :: !SomeFreeContainer
   29   }
   30 
   31 newPopupService :: FreeContainer fc => Metrics -> fc -> STM PopupService
   32 newPopupService metrics container = return PopupService
   33   { popupServiceMetrics = metrics
   34   , popupServiceContainer = SomeFreeContainer container
   35   }
   36 
   37 newPopup :: PopupService -> Rect -> STM Popup
   38 newPopup PopupService
   39   { popupServiceContainer = SomeFreeContainer container
   40   } (Vec4 left top right bottom) = do
   41   panel <- newPanel True
   42   panelChild <- addFreeChild container panel
   43   let
   44     close = removeFreeChild container panelChild
   45     closeByCommit = do
   46       close
   47       return True
   48   setCommitHandler panel $ \commitReason -> let
   49     in case commitReason of
   50       CommitAccept -> return False
   51       CommitCancel -> closeByCommit
   52       CommitLostFocus -> closeByCommit
   53   placeFreeChild container panelChild $ Vec2 left top
   54   bringFreeChildOnTop container panelChild
   55   focusFreeChild container panelChild
   56   layoutElement panel $ Vec2 (right - left) (bottom - top)
   57   return Popup
   58     { popupPanel = panel
   59     , popupClose = close
   60     }