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 :: forall env.
(forall a. StageRIO env a -> MomentIO a) -> MomentIO (Behavior Box)
setupScreenBox forall a. StageRIO env a -> MomentIO a
unlift = do
  Behavior Extent2D
screenExtent <- StageRIO env (Var Extent2D) -> MomentIO (Var Extent2D)
forall a. StageRIO env a -> MomentIO a
unlift StageRIO env (Var Extent2D)
forall env. StageRIO env (Var Extent2D)
Engine.askScreenVar MomentIO (Var Extent2D)
-> (Var Extent2D -> MomentIO (Behavior Extent2D))
-> MomentIO (Behavior Extent2D)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>=
    IO Extent2D -> MomentIO (Behavior Extent2D)
forall a. IO a -> MomentIO (Behavior a)
RBF.fromPoll (IO Extent2D -> MomentIO (Behavior Extent2D))
-> (Var Extent2D -> IO Extent2D)
-> Var Extent2D
-> MomentIO (Behavior Extent2D)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Var Extent2D -> IO Extent2D
forall worker (m :: * -> *).
(HasOutput worker, MonadIO m) =>
worker -> m (GetOutput worker)
Worker.getOutputData

  let
    screenSize :: Behavior Vec2
screenSize =
      Behavior Extent2D
screenExtent Behavior Extent2D -> (Extent2D -> Vec2) -> Behavior Vec2
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&>
        \Vk.Extent2D{Word32
$sel:width:Extent2D :: Extent2D -> Word32
width :: Word32
width, Word32
$sel:height:Extent2D :: Extent2D -> Word32
height :: Word32
height} ->
          Float -> Float -> Vec2
vec2
            (Word32 -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
width)
            (Word32 -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
height)

    screenBox :: Behavior Box
screenBox =
      Behavior Vec2
screenSize Behavior Vec2 -> (Vec2 -> Box) -> Behavior Box
forall (f :: * -> *) a b. Functor f => f a -> (a -> b) -> f b
<&> \Vec2
size ->
        Box :: Vec2 -> Vec2 -> Box
Layout.Box
          { $sel:boxPosition:Box :: Vec2
boxPosition = Vec2
0 -- XXX: since Camera.spawnOrthoPixelsCentered
          , $sel:boxSize:Box :: Vec2
boxSize     = Vec2
size
          }

  Behavior Box -> MomentIO (Behavior Box)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Behavior Box
screenBox

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

  Behavior Vec2
cursorPos <- Vec2 -> Event Vec2 -> m (Behavior Vec2)
forall (m :: * -> *) a.
MonadMoment m =>
a -> Event a -> m (Behavior a)
RB.stepper
    (Vec2
1Vec2 -> Vec2 -> Vec2
forall a. Fractional a => a -> a -> a
/Vec2
0) -- XXX: prevent accidental flash of hover at (0, 0)
    Event Vec2
cursorPosE
  pure (Event Vec2
cursorPosE, Behavior Vec2
cursorPos)
  where
    convertPos :: Box -> (Double, Double) -> Vec2
convertPos Layout.Box{Vec2
boxSize :: Vec2
$sel:boxSize:Box :: Box -> Vec2
boxSize} (Double
cx, Double
cy) =
      -- XXX: since Camera.spawnOrthoPixelsCentered
      Float -> Float -> Vec2
vec2 (Double -> Float
double2Float Double
cx) (Double -> Float
double2Float Double
cy) Vec2 -> Vec2 -> Vec2
forall a. Num a => a -> a -> a
-
      Vec2
boxSize Vec2 -> Float -> Vec2
forall v a. VectorSpace v a => v -> a -> v
^/ Float
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 :: forall cursor.
MomentIO (Event (ModifierKeys, MouseButtonState, MouseButton))
-> Behavior cursor
-> MomentIO (Collection (Event (ModifierKeys, cursor)))
setupMouseClicks MomentIO (Event (ModifierKeys, MouseButtonState, MouseButton))
fromMouseButton Behavior cursor
cursorPos = do
  -- imguiCaptureMouse <- RBF.fromPoll ImGui.wantCaptureMouse

  -- mouseButtonE <- RB.whenE (fmap not imguiCaptureMouse) <$> fromMouseButton
  Event (ModifierKeys, MouseButtonState, MouseButton)
mouseButtonE <- MomentIO (Event (ModifierKeys, MouseButtonState, MouseButton))
fromMouseButton

  -- XXX: Set up cursor event fusion, driven by mouseButtonE
  Collection
  (Event (ModifierKeys, cursor), Handler (ModifierKeys, cursor))
mouseButtons' <- forall (t :: * -> *) (f :: * -> *) a.
(Traversable t, Applicative f) =>
t (f a) -> f (t a)
sequenceA @MouseButton.Collection (Collection
   (MomentIO
      (Event (ModifierKeys, cursor), Handler (ModifierKeys, cursor)))
 -> MomentIO
      (Collection
         (Event (ModifierKeys, cursor), Handler (ModifierKeys, cursor))))
-> Collection
     (MomentIO
        (Event (ModifierKeys, cursor), Handler (ModifierKeys, cursor)))
-> MomentIO
     (Collection
        (Event (ModifierKeys, cursor), Handler (ModifierKeys, cursor)))
forall a b. (a -> b) -> a -> b
$ MomentIO
  (Event (ModifierKeys, cursor), Handler (ModifierKeys, cursor))
-> Collection
     (MomentIO
        (Event (ModifierKeys, cursor), Handler (ModifierKeys, cursor)))
forall (f :: * -> *) a. Applicative f => a -> f a
pure MomentIO
  (Event (ModifierKeys, cursor), Handler (ModifierKeys, cursor))
forall a. MomentIO (Event a, Handler a)
RBF.newEvent

  let
    dispatchButtons :: cursor -> (ModifierKeys, MouseButtonState, MouseButton) -> IO ()
dispatchButtons cursor
pos (ModifierKeys
mods, MouseButtonState
state, MouseButton
mb) =
      MouseButtonState -> IO () -> IO ()
forall (f :: * -> *).
Applicative f =>
MouseButtonState -> f () -> f ()
MouseButton.whenPressed MouseButtonState
state (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        -- XXX: Use one event handler to drive multiple derived events
        (Event (ModifierKeys, cursor), Handler (ModifierKeys, cursor))
-> Handler (ModifierKeys, cursor)
forall a b. (a, b) -> b
snd (Collection
  (Event (ModifierKeys, cursor), Handler (ModifierKeys, cursor))
-> MouseButton
-> (Event (ModifierKeys, cursor), Handler (ModifierKeys, cursor))
forall a. Collection a -> MouseButton -> a
MouseButton.atGlfw Collection
  (Event (ModifierKeys, cursor), Handler (ModifierKeys, cursor))
mouseButtons' MouseButton
mb) (ModifierKeys
mods, cursor
pos)

  Event (IO ()) -> MomentIO ()
RBF.reactimate (Event (IO ()) -> MomentIO ()) -> Event (IO ()) -> MomentIO ()
forall a b. (a -> b) -> a -> b
$
    cursor -> (ModifierKeys, MouseButtonState, MouseButton) -> IO ()
dispatchButtons (cursor -> (ModifierKeys, MouseButtonState, MouseButton) -> IO ())
-> Behavior cursor
-> Behavior
     ((ModifierKeys, MouseButtonState, MouseButton) -> IO ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Behavior cursor
cursorPos Behavior ((ModifierKeys, MouseButtonState, MouseButton) -> IO ())
-> Event (ModifierKeys, MouseButtonState, MouseButton)
-> Event (IO ())
forall a b. Behavior (a -> b) -> Event a -> Event b
<@> Event (ModifierKeys, MouseButtonState, MouseButton)
mouseButtonE

  pure $ ((Event (ModifierKeys, cursor), Handler (ModifierKeys, cursor))
 -> Event (ModifierKeys, cursor))
-> Collection
     (Event (ModifierKeys, cursor), Handler (ModifierKeys, cursor))
-> Collection (Event (ModifierKeys, cursor))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Event (ModifierKeys, cursor), Handler (ModifierKeys, cursor))
-> Event (ModifierKeys, cursor)
forall a b. (a, b) -> a
fst Collection
  (Event (ModifierKeys, cursor), Handler (ModifierKeys, cursor))
mouseButtons'