CursorPos.hs

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

handler
  :: ( Worker.HasInput cursor
     , Worker.GetInput cursor ~ Vec2
     )
  => cursor
  -> Sink e rs
  -> CursorPos.Callback rs
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 :: StageRIO env 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