Mouse.hs

{-# OPTIONS_GHC -Wno-missing-pattern-synonym-signatures #-}

module Mischief.Input.Mouse
  ( Mouse,
    MousePlugin,
    pressed,
    released,
    justPressed,
    justReleased,
    pos,
    delta,
    getPos,
    getDelta,
    pattern Mischief.Input.Mouse.Left,
    pattern Mischief.Input.Mouse.Right,
    pattern Mischief.Input.Mouse.Middle,
    pattern Mischief.Input.Mouse.X1,
    pattern Mischief.Input.Mouse.X2,
  )
where

import Control.Monad.IO.Class (MonadIO (..))
import Foreign (Bits ((.&.)), Storable (peek), alloca)
import Foreign.C (CFloat)
import Mischief.ECS
import Mischief.ECS.App.Schedules
import Mischief.SDL
import SDL3.Sys qualified as SDL3

data MouseData = MouseData
  { flags :: SDL3.SDL_MouseButtonFlags,
    x :: CFloat,
    y :: CFloat
  }

data Mouse = Mouse
  { current :: MouseData,
    old :: MouseData
  }
  deriving (Component)

-- | Plugin which keeps track of key inputs and updates the 'Keys' resource.
data MousePlugin

instance Plugin MousePlugin where
  init = do
    systems updateMouse
      & schedule @First

    insertRes $ Mouse (MouseData 0 0 0) (MouseData 0 0 0)

  deps = [dep @SDLPlugin]

updateMouse :: System ()
updateMouse = do
  Just mouse <- res @Mouse

  (flags, x, y) <- liftIO $ alloca @CFloat $ \x -> alloca @CFloat $ \y -> do
    a <- liftIO $ SDL3.getMouseState x y
    x <- peek x
    y <- peek y
    pure (a, x, y)

  insertRes $ Mouse {old = mouse.current, current = MouseData flags x y}

pressed :: Mouse -> SDL3.SDL_MouseButtonFlags -> Bool
pressed Mouse {current = MouseData {flags}} = getVal flags

released :: Mouse -> SDL3.SDL_MouseButtonFlags -> Bool
released Mouse {current = MouseData {flags}} = getVal flags

justPressed :: Mouse -> SDL3.SDL_MouseButtonFlags -> Bool
justPressed Mouse {current = MouseData {flags}, old = MouseData {flags = flags'}} flag = getVal flags flag && not (getVal flags' flag)

justReleased :: Mouse -> SDL3.SDL_MouseButtonFlags -> Bool
justReleased Mouse {current = MouseData {flags}, old = MouseData {flags = flags'}} flag = not (getVal flags flag) && getVal flags' flag

getVal :: SDL3.SDL_MouseButtonFlags -> SDL3.SDL_MouseButtonFlags -> Bool
getVal x i = (x .&. i) /= 0

pos :: (MonadSystem w m) => m (Float, Float)
pos = getPos . unwrap <$> res @Mouse

getPos :: Mouse -> (Float, Float)
getPos Mouse {current = MouseData {x, y}} = (realToFrac x, realToFrac y)

delta :: (MonadSystem w m) => m (Float, Float)
delta = getDelta . unwrap <$> res @Mouse

getDelta :: Mouse -> (Float, Float)
getDelta Mouse {current = MouseData {x, y}, old = MouseData {x = x', y = y'}} = (realToFrac $ x - x', realToFrac $ y - y')

pattern Left = SDL3.SDL_BUTTON_LMASK

pattern Middle = SDL3.SDL_BUTTON_MMASK

pattern Right = SDL3.SDL_BUTTON_RMASK

pattern X1 = SDL3.SDL_BUTTON_X1MASK

pattern X2 = SDL3.SDL_BUTTON_X2MASK