module Engine.Events.CursorPos where

import RIO

import Geomancy (Vec2, vec2, pattern WithVec2)
import GHC.Float (double2Float)
import UnliftIO.Resource (ReleaseKey)
import Vulkan.Core10 qualified as Vk
import Vulkan.NamedType ((:::))

import Engine.Types (StageRIO, askScreenVar)
import Engine.Window.CursorPos qualified as CursorPos
import Engine.Worker qualified as Worker

import Engine.Events (Sink)

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

handler
  :: ( Worker.HasInput cursor
     , Worker.GetInput cursor ~ Vec2
     )
  => cursor
  -> Sink e rs
  -> CursorPos.Callback rs
handler :: forall cursor e rs.
(HasInput cursor, GetInput cursor ~ Vec2) =>
cursor -> Sink e rs -> Callback rs
handler cursor
cursorVar Sink e rs
_sink Double
windowX Double
windowY = do
  -- logDebug $ "CursorPos event: " <> displayShow (windowX, windowY)
  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 :: StageRIO env Process
spawn :: forall env. StageRIO env Process
spawn = do
  Var Extent2D
screen <- forall env. StageRIO env (Var Extent2D)
askScreenVar
  Var Vec2
cursorWindow <- forall (m :: * -> *) a. MonadUnliftIO m => a -> m (Var a)
Worker.newVar Vec2
0
  forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Var Vec2
cursorWindow,) forall a b. (a -> b) -> a -> b
$
    forall (m :: * -> *) i1 i2 o.
(MonadUnliftIO m, HasOutput i1, HasOutput i2) =>
(GetOutput i1 -> GetOutput i2 -> o) -> i1 -> i2 -> m (Merge o)
Worker.spawnMerge2
      (\Vk.Extent2D{Word32
$sel:width:Extent2D :: Extent2D -> Word32
width :: Word32
width, Word32
$sel:height:Extent2D :: Extent2D -> Word32
height :: Word32
height} (WithVec2 Float
windowX Float
windowY) ->
          Float -> Float -> Vec2
vec2
            (Float
windowX forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
width forall a. Fractional a => a -> a -> a
/ Float
2)
            (Float
windowY forall a. Num a => a -> a -> a
- forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
height forall a. Fractional a => a -> a -> a
/ Float
2)
      )
      Var Extent2D
screen
      Var Vec2
cursorWindow