Window.hs

module Engine.ReactiveBanana.Window where

import RIO

import Control.Monad.Trans.Resource (ResourceT)
import Engine.ReactiveBanana (eventHandler)
import Engine.Types (StageRIO)
import Engine.Types qualified as Engine
import Engine.UI.Layout qualified as Layout
import Engine.Window.CursorPos qualified as CursorPos
import Engine.Window.Drop qualified as Drop
import Engine.Window.Key qualified as Key
import Engine.Window.MouseButton qualified as MouseButton
import Engine.Window.Scroll qualified as Scroll
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

-- * Wrapped Engine.Window.* callbacks

-- | Set up a window callback to fire window "CursorPos"  events.
allocateCursorPos :: ResourceT (StageRIO st) (RBF.MomentIO (RB.Event (Double, Double)))
allocateCursorPos = eventHandler $ CursorPos.callback . curry

-- | Set up a window callback to fire window "Drop"  events.
allocateDrop :: ResourceT (StageRIO st) (RBF.MomentIO (RB.Event [FilePath]))
allocateDrop = eventHandler Drop.callback

{- | Set up a window callback to fire window "MouseButton"  events.

To prevent clicks when hovering over some ImGui window wrap in a `RB.whenE` filter:

@
imguiCaptureMouse <- RBF.fromPoll ImGui.wantCaptureMouse
mouseButtonE <- fmap (RB.whenE $ fmap not imguiCaptureMouse) fromMouseButton
@
-}
allocateMouseButton
  :: ResourceT
      (StageRIO st)
      ( RBF.MomentIO
          ( RB.Event
            ( MouseButton.ModifierKeys
            , MouseButton.MouseButtonState
            , MouseButton.MouseButton
            )
          )
        )
allocateMouseButton = eventHandler MouseButton.callback

-- | Set up a window callback to fire window "Scroll"  events.
allocateScroll :: ResourceT (StageRIO st) (RBF.MomentIO (RB.Event (Double, Double)))
allocateScroll = eventHandler $ Scroll.callback . curry

{- | Set up a window callback to fire window "Key"  events.

To prevent clicks when ImGui is busy with text input wrap in a `RB.whenE` filter:

@
imguiCaptureKeyboard <- RBF.fromPoll ImGui.wantCaptureKeyboard
keyE <- fmap (RB.whenE $ fmap not imguiCaptureKeyboard) fromKey
@
-}
allocateKey :: ResourceT (StageRIO st) (RBF.MomentIO (RB.Event (Int, (MouseButton.ModifierKeys, Key.KeyState, Key.Key))))
allocateKey = eventHandler $ Key.callback . curry

-- * 'Engine.UI.Layout' helpers

-- | Screen-sized layout base.
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

-- | Project window cursor position to layout.
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

-- | Set up a per-button collection of fused (position, modifier) click ("button pressed") events.
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

  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'