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'