montis/src/Montis/Standard/Mouse.hs


1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49

module Montis.Standard.Mouse where

import Data.Data (Typeable)
import Montis.Core
import Montis.Core.Runtime (focusToplevel, toplevelAt)
import Montis.Core.State
  ( Config (startingHooks),
    ConfigModule (..),
    Hooks (buttonHook, motionHook),
    StateExtension (..),
  )
import Control.Monad (forM_)

data MouseConfig where
  MouseConfig :: MouseConfig
  deriving (Typeable)

instance ConfigModule Montis MouseConfig where
  alterConfig _ c =
    let ohb = buttonHook (startingHooks c)
        ohm = motionHook (startingHooks c)
     in c
          { startingHooks =
              (startingHooks c)
                { buttonHook = \ev -> onButton ev >> ohb ev,
                  motionHook = \ev -> onMotion ev >> ohm ev
                }
          }

newtype CursorPosition = CursorPosition (Double, Double)
  deriving (Typeable)

instance StateExtension CursorPosition where
  initialValue = CursorPosition (0, 0)
  marshalExtension _ = Nothing
  demarshalExtension _ = Nothing

onMotion :: MotionEvent -> Montis ()
onMotion ev = do
  let (x, y) = motionEvent_absolute ev
  xStatePut (CursorPosition (x, y))

onButton :: ButtonEvent -> Montis ()
onButton ev
  | buttonEvent_state ev /= ButtonPressed = return ()
  | otherwise = do
      CursorPosition (x, y) <- xStateGet
      mtl <- toplevelAt x y
      forM_ mtl focusToplevel