module Engine.Events.CursorPos where

import RIO

import Data.Type.Equality (type (~))
import Geomancy (Vec2, vec2, pattern WithVec2)
import GHC.Float (double2Float)
import UnliftIO.Resource (MonadResource, ReleaseKey)
import Vulkan.Core10 qualified as Vk
import Vulkan.NamedType ((:::))

import Engine.Events.Sink (MonadSink, Sink)
import Engine.Types (askScreenVar)
import Engine.Window.CursorPos qualified as CursorPos
import Engine.Worker qualified as Worker

callback
  :: ( MonadSink rs m
     , Worker.HasInput cursor
     , Worker.GetInput cursor ~ Vec2
     )
  => cursor
  -> Sink e st
  -> m ReleaseKey
callback :: forall rs (m :: * -> *) cursor e st.
(MonadSink rs m, HasInput cursor, GetInput cursor ~ Vec2) =>
cursor -> Sink e st -> m ReleaseKey
callback cursor
cursorVar = Callback m -> m ReleaseKey
forall rs (m :: * -> *).
MonadSink rs m =>
Callback m -> m ReleaseKey
CursorPos.callback (Callback m -> m ReleaseKey)
-> (Sink e st -> Callback m) -> Sink e st -> m ReleaseKey
forall b c a. (b -> c) -> (a -> b) -> a -> c
. cursor -> Sink e st -> Callback m
forall (m :: * -> *) cursor e st.
(MonadResource m, HasInput cursor, GetInput cursor ~ Vec2) =>
cursor -> Sink e st -> Callback m
handler cursor
cursorVar

handler
  :: ( MonadResource m
     , Worker.HasInput cursor
     , Worker.GetInput cursor ~ Vec2
     )
  => cursor
  -> Sink e st
  -> CursorPos.Callback m
handler :: forall (m :: * -> *) cursor e st.
(MonadResource m, HasInput cursor, GetInput cursor ~ Vec2) =>
cursor -> Sink e st -> Callback m
handler cursor
cursorVar Sink e st
_sink Double
windowX Double
windowY = do
  -- logDebug $ "CursorPos event: " <> displayShow (windowX, windowY)
  cursor -> (GetInput cursor -> GetInput cursor) -> m ()
forall (m :: * -> *) var.
(MonadIO m, HasInput var) =>
var -> (GetInput var -> GetInput var) -> m ()
Worker.pushInput cursor
cursorVar \GetInput cursor
_old ->
    Float -> Float -> Vec2
vec2 (Double -> Float
double2Float Double
windowX) (Double -> Float
double2Float Double
windowY)

type Process = Worker.Cell ("window" ::: Vec2) ("centered" ::: Vec2)

spawn
  :: MonadSink rs m
  => m Process
spawn :: forall rs (m :: * -> *). MonadSink rs m => m Process
spawn = do
  Var Extent2D
screen <- m (Var Extent2D)
forall st (m :: * -> *).
MonadReader (App GlobalHandles st) m =>
m (Var Extent2D)
askScreenVar
  Var Vec2
cursorWindow <- Vec2 -> m (Var Vec2)
forall (m :: * -> *) a. MonadUnliftIO m => a -> m (Var a)
Worker.newVar Vec2
0
  (Merge Vec2 -> Process) -> m (Merge Vec2) -> m Process
forall a b. (a -> b) -> m a -> m b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Var Vec2
cursorWindow,) (m (Merge Vec2) -> m Process) -> m (Merge Vec2) -> m Process
forall a b. (a -> b) -> a -> b
$
    (GetOutput (Var Extent2D) -> GetOutput (Var Vec2) -> Vec2)
-> Var Extent2D -> Var Vec2 -> m (Merge Vec2)
forall (m :: * -> *) i1 i2 o.
(MonadUnliftIO m, MonadResource m, HasOutput i1, HasOutput i2) =>
(GetOutput i1 -> GetOutput i2 -> o) -> i1 -> i2 -> m (Merge o)
Worker.spawnMerge2
      (\Vk.Extent2D{Word32
width :: Word32
$sel:width:Extent2D :: Extent2D -> Word32
width, Word32
height :: Word32
$sel:height:Extent2D :: Extent2D -> Word32
height} (WithVec2 Float
windowX Float
windowY) ->
          Float -> Float -> Vec2
vec2
            (Float
windowX Float -> Float -> Float
forall a. Num a => a -> a -> a
- Word32 -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
width Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
2)
            (Float
windowY Float -> Float -> Float
forall a. Num a => a -> a -> a
- Word32 -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
height Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
2)
      )
      Var Extent2D
screen
      Var Vec2
cursorWindow