{-# 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
  { MouseData -> SDL_MouseButtonFlags
flags :: SDL3.SDL_MouseButtonFlags,
    MouseData -> CFloat
x :: CFloat,
    MouseData -> CFloat
y :: CFloat
  }

data Mouse = Mouse
  { Mouse -> MouseData
current :: MouseData,
    Mouse -> MouseData
old :: MouseData
  }
  deriving (Typeable Mouse
[Hook Mouse]
[HookRel Mouse]
Set DefaultComponentType
IsExclusive (IsExclusiveRel Mouse)
(Typeable Mouse, IsExclusive (IsExclusiveRel Mouse)) =>
Set DefaultComponentType
-> [Hook Mouse]
-> [Hook Mouse]
-> [Hook Mouse]
-> [HookRel Mouse]
-> [HookRel Mouse]
-> [HookRel Mouse]
-> Component Mouse
forall c.
(Typeable c, IsExclusive (IsExclusiveRel c)) =>
Set DefaultComponentType
-> [Hook c]
-> [Hook c]
-> [Hook c]
-> [HookRel c]
-> [HookRel c]
-> [HookRel c]
-> Component c
$crequired :: Set DefaultComponentType
required :: Set DefaultComponentType
$conAdd :: [Hook Mouse]
onAdd :: [Hook Mouse]
$conSet :: [Hook Mouse]
onSet :: [Hook Mouse]
$conRemove :: [Hook Mouse]
onRemove :: [Hook Mouse]
$conAddRel :: [HookRel Mouse]
onAddRel :: [HookRel Mouse]
$conSetRel :: [HookRel Mouse]
onSetRel :: [HookRel Mouse]
$conRemoveRel :: [HookRel Mouse]
onRemoveRel :: [HookRel Mouse]
Component)

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

instance Plugin MousePlugin where
  init :: System ()
init = do
    System () -> SystemConfig
forall a. ToSystems a => a -> SystemConfig
systems System ()
updateMouse
      SystemConfig -> (SystemConfig -> System ()) -> System ()
forall a b. a -> (a -> b) -> b
& forall sc. Schedule sc => SystemConfig -> System ()
forall {k} (sc :: k). Schedule sc => SystemConfig -> System ()
schedule @First

    Mouse -> System ()
forall r. (Component r, Bundle r) => r -> System ()
insertRes (Mouse -> System ()) -> Mouse -> System ()
forall a b. (a -> b) -> a -> b
$ MouseData -> MouseData -> Mouse
Mouse (SDL_MouseButtonFlags -> CFloat -> CFloat -> MouseData
MouseData SDL_MouseButtonFlags
0 CFloat
0 CFloat
0) (SDL_MouseButtonFlags -> CFloat -> CFloat -> MouseData
MouseData SDL_MouseButtonFlags
0 CFloat
0 CFloat
0)

  deps :: [Dependency]
deps = [forall p. Plugin p => Dependency
dep @SDLPlugin]

updateMouse :: System ()
updateMouse :: System ()
updateMouse = do
  Just mouse <- forall c (m :: * -> *) w.
(MonadSystem w m, Component c) =>
m (Maybe c)
res @Mouse

  (flags, x, y) <- liftIO $ alloca @CFloat $ \Ptr CFloat
x -> forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca @CFloat ((Ptr CFloat -> IO (SDL_MouseButtonFlags, CFloat, CFloat))
 -> IO (SDL_MouseButtonFlags, CFloat, CFloat))
-> (Ptr CFloat -> IO (SDL_MouseButtonFlags, CFloat, CFloat))
-> IO (SDL_MouseButtonFlags, CFloat, CFloat)
forall a b. (a -> b) -> a -> b
$ \Ptr CFloat
y -> do
    a <- IO SDL_MouseButtonFlags -> IO SDL_MouseButtonFlags
forall a. IO a -> IO a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (IO SDL_MouseButtonFlags -> IO SDL_MouseButtonFlags)
-> IO SDL_MouseButtonFlags -> IO SDL_MouseButtonFlags
forall a b. (a -> b) -> a -> b
$ Ptr CFloat -> Ptr CFloat -> IO SDL_MouseButtonFlags
SDL3.getMouseState Ptr CFloat
x Ptr CFloat
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 -> SDL_MouseButtonFlags -> Bool
pressed Mouse {current :: Mouse -> MouseData
current = MouseData {SDL_MouseButtonFlags
flags :: MouseData -> SDL_MouseButtonFlags
flags :: SDL_MouseButtonFlags
flags}} = SDL_MouseButtonFlags -> SDL_MouseButtonFlags -> Bool
getVal SDL_MouseButtonFlags
flags

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

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

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

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

pos :: (MonadSystem w m) => m (Float, Float)
pos :: forall w (m :: * -> *). MonadSystem w m => m (Float, Float)
pos = Mouse -> (Float, Float)
getPos (Mouse -> (Float, Float))
-> (Maybe Mouse -> Mouse) -> Maybe Mouse -> (Float, Float)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Mouse -> Mouse
forall (f :: * -> *) a. (HasCallStack, Unwrappable f) => f a -> a
unwrap (Maybe Mouse -> (Float, Float))
-> m (Maybe Mouse) -> m (Float, Float)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall c (m :: * -> *) w.
(MonadSystem w m, Component c) =>
m (Maybe c)
res @Mouse

getPos :: Mouse -> (Float, Float)
getPos :: Mouse -> (Float, Float)
getPos Mouse {current :: Mouse -> MouseData
current = MouseData {CFloat
x :: MouseData -> CFloat
x :: CFloat
x, CFloat
y :: MouseData -> CFloat
y :: CFloat
y}} = (CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
x, CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac CFloat
y)

delta :: (MonadSystem w m) => m (Float, Float)
delta :: forall w (m :: * -> *). MonadSystem w m => m (Float, Float)
delta = Mouse -> (Float, Float)
getDelta (Mouse -> (Float, Float))
-> (Maybe Mouse -> Mouse) -> Maybe Mouse -> (Float, Float)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe Mouse -> Mouse
forall (f :: * -> *) a. (HasCallStack, Unwrappable f) => f a -> a
unwrap (Maybe Mouse -> (Float, Float))
-> m (Maybe Mouse) -> m (Float, Float)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall c (m :: * -> *) w.
(MonadSystem w m, Component c) =>
m (Maybe c)
res @Mouse

getDelta :: Mouse -> (Float, Float)
getDelta :: Mouse -> (Float, Float)
getDelta Mouse {current :: Mouse -> MouseData
current = MouseData {CFloat
x :: MouseData -> CFloat
x :: CFloat
x, CFloat
y :: MouseData -> CFloat
y :: CFloat
y}, old :: Mouse -> MouseData
old = MouseData {x :: MouseData -> CFloat
x = CFloat
x', y :: MouseData -> CFloat
y = CFloat
y'}} = (CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac (CFloat -> Float) -> CFloat -> Float
forall a b. (a -> b) -> a -> b
$ CFloat
x CFloat -> CFloat -> CFloat
forall a. Num a => a -> a -> a
- CFloat
x', CFloat -> Float
forall a b. (Real a, Fractional b) => a -> b
realToFrac (CFloat -> Float) -> CFloat -> Float
forall a b. (a -> b) -> a -> b
$ CFloat
y CFloat -> CFloat -> CFloat
forall a. Num a => a -> a -> a
- CFloat
y')

pattern $mLeft :: forall {r}.
SDL_MouseButtonFlags -> ((# #) -> r) -> ((# #) -> r) -> r
$bLeft :: SDL_MouseButtonFlags
Left = SDL3.SDL_BUTTON_LMASK

pattern $mMiddle :: forall {r}.
SDL_MouseButtonFlags -> ((# #) -> r) -> ((# #) -> r) -> r
$bMiddle :: SDL_MouseButtonFlags
Middle = SDL3.SDL_BUTTON_MMASK

pattern $mRight :: forall {r}.
SDL_MouseButtonFlags -> ((# #) -> r) -> ((# #) -> r) -> r
$bRight :: SDL_MouseButtonFlags
Right = SDL3.SDL_BUTTON_RMASK

pattern $mX1 :: forall {r}.
SDL_MouseButtonFlags -> ((# #) -> r) -> ((# #) -> r) -> r
$bX1 :: SDL_MouseButtonFlags
X1 = SDL3.SDL_BUTTON_X1MASK

pattern $mX2 :: forall {r}.
SDL_MouseButtonFlags -> ((# #) -> r) -> ((# #) -> r) -> r
$bX2 :: SDL_MouseButtonFlags
X2 = SDL3.SDL_BUTTON_X2MASK