never executed always true always false
    1 {-|
    2 Module: Flaw.UI
    3 Description: Basic user interface definitions.
    4 License: MIT
    5 -}
    6 
    7 {-# LANGUAGE GADTs, TypeFamilies #-}
    8 
    9 module Flaw.UI
   10   ( Metric
   11   , Position
   12   , Size
   13   , Rect
   14   , Visual(..)
   15   , SomeVisual(..)
   16   , Element(..)
   17   , InputEvent(..)
   18   , InputState(..)
   19   , SomeElement(..)
   20   , HasText(..)
   21   , AlignX(..), AlignY(..)
   22   , HasAlignment(..)
   23   , HasPassword(..)
   24   , HasActionHandler(..)
   25   , HasChangeHandler(..)
   26   , HasChecked(..)
   27   , HasFloatValue(..)
   28   , HasProgress(..)
   29   , Progress(..)
   30   , FreeContainer(..)
   31   , SomeFreeContainer(..)
   32   , DraggableInFreeContainer(..)
   33   , SomeFreeChild(..)
   34   , DefaultActionRedirector(..)
   35   , HasCommitHandler(..)
   36   , CommitReason(..)
   37   , Focusable(..)
   38   , Scrollable(..)
   39   , SomeScrollable(..)
   40   , MouseCursor(..) -- re-export from Flaw.Window
   41   ) where
   42 
   43 import Control.Concurrent.STM
   44 import qualified Data.Text as T
   45 
   46 import Flaw.Graphics
   47 import Flaw.Graphics.Font
   48 import Flaw.Input.Keyboard
   49 import Flaw.Input.Mouse
   50 import Flaw.Math
   51 import Flaw.UI.Drawer
   52 import Flaw.UI.Metrics
   53 import Flaw.Window
   54 
   55 -- | Visual is a paintable thing with layout.
   56 class Visual a where
   57   -- | Render visual.
   58   -- Style is set by parent element, so visual may react on mouse or pressed state.
   59   renderVisual :: Context c d => a -> Drawer d -> Position -> Size -> Style -> STM (Render c ())
   60 
   61 -- | Any visual.
   62 data SomeVisual where
   63   SomeVisual :: Visual a => !a -> SomeVisual
   64 
   65 -- | Element is a content able to react to input events.
   66 class Element a where
   67   -- | Set size of element.
   68   -- If (and only if) size has changed, element should re-calculate
   69   -- layout and call this method for nested visuals/elements.
   70   layoutElement :: a -> Size -> STM ()
   71   -- | Check that point is in element.
   72   -- Visual can return False for "holes".
   73   dabElement :: a -> Position -> STM Bool
   74   -- | Get mouse cursor element wants to show over.
   75   elementMouseCursor :: a -> STM MouseCursor
   76   elementMouseCursor _ = return MouseCursorArrow
   77   -- | Render element.
   78   -- Size is set by previous call to 'layout'. It's parent element's responsibility
   79   -- to correctly constrain viewport.
   80   renderElement :: Context c d => a -> Drawer d -> Position -> STM (Render c ())
   81   -- | Process input event addressed to the content.
   82   -- Element may return False which means it wants to return event
   83   -- back to container. It should be used for passing mouse events
   84   -- in transparent areas, and for skipping non-processed keyboard
   85   -- events, so container has chance to implement focus control with keys.
   86   processInputEvent :: a -> InputEvent -> InputState -> STM Bool
   87   -- | Container gives child keyboard focus.
   88   -- Child returns True if it accepts focus;
   89   -- in case of False container may try to give focus to
   90   -- another element.
   91   focusElement :: a -> STM Bool
   92   focusElement _ = return False
   93   -- | Container takes keyboard focus back.
   94   -- Element has to release focus.
   95   unfocusElement :: a -> STM ()
   96   unfocusElement _ = return ()
   97 
   98 -- | Input events.
   99 -- State of keyboard/mouse is provided before applying event.
  100 data InputEvent
  101   -- | Keyboard event. Sent to focused control.
  102   = KeyboardInputEvent !KeyboardEvent
  103   -- | Mouse event. CursorMoveEvent is adjusted to element's coordinates.
  104   | MouseInputEvent !MouseEvent
  105   -- | Mouse left the element.
  106   | MouseLeaveEvent
  107 
  108 -- | Input state.
  109 data InputState = InputState
  110   { inputStateKeyboard :: !KeyboardState
  111   , inputStateMouse :: !MouseState
  112   -- | Function to get (asynchronously) clipboard text.
  113   -- Text will be returned to the callback in separate transaction.
  114   , inputStateGetClipboardText :: (T.Text -> STM ()) -> STM ()
  115   -- | Function to set (asynchronously) clipboard text.
  116   , inputStateSetClipboardText :: T.Text -> STM ()
  117   }
  118 
  119 -- | Any element.
  120 data SomeElement where
  121   SomeElement :: Element a => !a -> SomeElement
  122 
  123 class HasText a where
  124   setText :: a -> T.Text -> STM ()
  125   setTextScript :: a -> FontScript -> STM ()
  126   getText :: a -> STM T.Text
  127 
  128 class HasText a => HasPassword a where
  129   setPasswordMode :: a -> Bool -> STM ()
  130 
  131 data AlignX = AlignLeft | AlignCenter | AlignRight
  132 data AlignY = AlignTop | AlignMiddle | AlignBottom
  133 
  134 class HasAlignment a where
  135   setAlignment :: a -> AlignX -> AlignY -> STM ()
  136 
  137 -- | Class of elements having action handler.
  138 -- Action means click for buttons, double click for listboxes and so on.
  139 class HasActionHandler a where
  140   setActionHandler :: a -> STM () -> STM ()
  141 
  142 class HasChangeHandler a where
  143   setChangeHandler :: a -> STM () -> STM ()
  144 
  145 class HasChecked a where
  146   setChecked :: a -> Bool -> STM ()
  147   getChecked :: a -> STM Bool
  148 
  149 class HasFloatValue a where
  150   setFloatValue :: a -> Float -> STM ()
  151   getFloatValue :: a -> STM Float
  152 
  153 class HasProgress a where
  154   setProgress :: a -> Progress -> STM ()
  155 
  156 data Progress = Progress Float | IndeterminateProgress
  157 
  158 -- | Free container is an element able to place other elements
  159 -- freely with explicit positions.
  160 class Element a => FreeContainer a where
  161   -- | Handle of child element added to free container.
  162   type FreeContainerChild a :: *
  163   -- | Set free container handler of 'layout' method.
  164   setLayoutHandler :: a -> (Size -> STM ()) -> STM ()
  165   -- | Add child element to free container.
  166   addFreeChild :: Element e => a -> e -> STM (FreeContainerChild a)
  167   -- | Remove child element from free container.
  168   removeFreeChild :: a -> FreeContainerChild a -> STM ()
  169   -- | Set position of child element in free container.
  170   placeFreeChild :: a -> FreeContainerChild a -> Position -> STM ()
  171   -- | Move child element relatively its current position.
  172   placeFreeChildRelatively :: a -> FreeContainerChild a -> Int2 -> STM ()
  173   -- | Bring element to the end of render list (in order to render on top of everything).
  174   bringFreeChildOnTop :: a -> FreeContainerChild a -> STM ()
  175   -- | Focus child element.
  176   focusFreeChild :: a -> FreeContainerChild a -> STM ()
  177 
  178 data SomeFreeContainer where
  179   SomeFreeContainer :: FreeContainer fc => fc -> SomeFreeContainer
  180 
  181 -- | Class of element which could be moved by mouse.
  182 class Element a => DraggableInFreeContainer a where
  183   -- | Tell element a "free child" object used for placement this element.
  184   -- After that element becomes movable and resizable (if flag is set).
  185   setSelfFreeChild :: FreeContainer fc
  186     => a -- ^ Element.
  187     -> fc -- ^ Container.
  188     -> FreeContainerChild fc -- ^ Free child in container.
  189     -> Bool -- ^ Resizable?
  190     -> STM ()
  191 
  192 data SomeFreeChild where
  193   SomeFreeChild :: FreeContainer fc => fc -> FreeContainerChild fc -> SomeFreeChild
  194 
  195 class Element a => DefaultActionRedirector a where
  196   setDefaultElement :: Element e => a -> e -> STM ()
  197   setCancelElement :: Element e => a -> e -> STM ()
  198 
  199 -- | Class of element which has commit handler.
  200 -- Commit handler is a handler called when change made in elements
  201 -- must be commited or cancelled.
  202 class Element a => HasCommitHandler a where
  203   setCommitHandler :: a -> (CommitReason -> STM Bool) -> STM ()
  204 
  205 -- | Reason for commit handler.
  206 data CommitReason
  207   = CommitAccept -- ^ User pressed Enter key.
  208   | CommitCancel -- ^ User pressed Esc key.
  209   | CommitLostFocus -- ^ Element lost focus.
  210   deriving Eq
  211 
  212 class Element a => Focusable a where
  213   isFocused :: a -> STM Bool
  214 
  215 -- | Class of scrollable elements.
  216 -- Scrollable element can render only part of itself.
  217 -- It does accept call to layoutElement with size of visible area,
  218 -- but then it must return real size via 'scrollableElementSize'.
  219 class Element a => Scrollable a where
  220   -- | Render specified part of element.
  221   renderScrollableElement
  222     :: Context c d
  223     => a -- ^ Scrollable element.
  224     -> Drawer d -- ^ Drawer.
  225     -- | Position of left-top corner (possible invisible or out-of-screen because of scrolling)
  226     -- of the element in render coordinates.
  227     -> Position
  228     -> Rect -- ^ Part of element to render, in element's coordinates.
  229     -> STM (Render c ())
  230   -- | Return real total size of the element.
  231   scrollableElementSize :: a -> STM Size
  232 
  233 data SomeScrollable where
  234   SomeScrollable :: Scrollable a => !a -> SomeScrollable