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