Window.hs

module Engine.ReactiveBanana.Window where

import RIO

import Engine.Types (StageRIO)
import Engine.Types qualified as Engine
import Engine.UI.Layout qualified as Layout
import Engine.Window.MouseButton qualified as MouseButton
import Engine.Worker qualified as Worker
import Geomancy (Vec2, vec2, (^/))
import GHC.Float (double2Float)
import Reactive.Banana ((<@>), (<@>))
import Reactive.Banana qualified as RB
import Reactive.Banana.Frameworks qualified as RBF
import Vulkan.Core10 qualified as Vk

setupScreenBox
  :: (forall a. StageRIO env a -> RBF.MomentIO a)
  -> RBF.MomentIO (RB.Behavior Layout.Box)
setupScreenBox unlift = do
  screenExtent <- unlift Engine.askScreenVar >>=
    RBF.fromPoll . Worker.getOutputData

  let
    screenSize =
      screenExtent <&>
        \Vk.Extent2D{width, height} ->
          vec2
            (fromIntegral width)
            (fromIntegral height)

    screenBox =
      screenSize <&> \size ->
        Layout.Box
          { boxPosition = 0 -- XXX: since Camera.spawnOrthoPixelsCentered
          , boxSize     = size
          }

  pure screenBox

setupCursorPos
  :: RB.MonadMoment m
  => m (RB.Event (Double, Double))
  -> RB.Behavior Layout.Box
  -> m (RB.Event Vec2, RB.Behavior Vec2)
setupCursorPos fromCursorPos screenBox = do
  cursorPosRawE <- fromCursorPos
  let cursorPosE = convertPos <$> screenBox <@> cursorPosRawE

  cursorPos <- RB.stepper
    (1/0) -- XXX: prevent accidental flash of hover at (0, 0)
    cursorPosE
  pure (cursorPosE, cursorPos)
  where
    convertPos Layout.Box{boxSize} (cx, cy) =
      -- XXX: since Camera.spawnOrthoPixelsCentered
      vec2 (double2Float cx) (double2Float cy) -
      boxSize ^/ 2

setupMouseClicks
  :: RBF.MomentIO (RB.Event (MouseButton.ModifierKeys, MouseButton.MouseButtonState, MouseButton.MouseButton))
  -> RB.Behavior cursor
  -> RBF.MomentIO (MouseButton.Collection (RB.Event (MouseButton.ModifierKeys, cursor)))
setupMouseClicks fromMouseButton cursorPos = do
  -- imguiCaptureMouse <- RBF.fromPoll ImGui.wantCaptureMouse

  -- mouseButtonE <- RB.whenE (fmap not imguiCaptureMouse) <$> fromMouseButton
  mouseButtonE <- fromMouseButton

  -- XXX: Set up cursor event fusion, driven by mouseButtonE
  mouseButtons' <- sequenceA @MouseButton.Collection $ pure RBF.newEvent

  let
    dispatchButtons pos (mods, state, mb) =
      MouseButton.whenPressed state $
        -- XXX: Use one event handler to drive multiple derived events
        snd (MouseButton.atGlfw mouseButtons' mb) (mods, pos)

  RBF.reactimate $
    dispatchButtons <$> cursorPos <@> mouseButtonE

  pure $ fmap fst mouseButtons'