CursorPos.hs

module Engine.Events.CursorPos where

import RIO

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 cursorVar = CursorPos.callback . handler cursorVar

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

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

spawn
  :: MonadSink rs m
  => m Process
spawn = do
  screen <- askScreenVar
  cursorWindow <- Worker.newVar 0
  fmap (cursorWindow,) $
    Worker.spawnMerge2
      (\Vk.Extent2D{width, height} (WithVec2 windowX windowY) ->
          vec2
            (windowX - fromIntegral width / 2)
            (windowY - fromIntegral height / 2)
      )
      screen
      cursorWindow