Widget.hs

module Render.ImGui.Widget
  ( separator
  , sliderFloat
  , sliderFloat2
  , sliderAngle
  , sliderUVec2
  , button
  , text
  , render_
  ) where

import RIO

-- import Engine.Types (HKD)
-- import Data.These (These(..))
-- import Data.These.Combinators (justHere, justThere)
import DearImGui.Internal.Text (withCString)
import DearImGui.Raw qualified
import Engine.ReactiveBanana.Widget (Widget(..), Widget', draw_)
import Foreign (withForeignPtr, mallocForeignPtr)
import Foreign qualified
import Foreign.C.Types (CFloat(..))
import Geomancy (Vec2, UVec2)
import Reactive.Banana qualified as RB
import Reactive.Banana.Frameworks qualified as RBF
import DearImGui qualified

separator :: Widget Void ()
separator = draw_ DearImGui.Raw.separator

sliderFloat
  :: MonadIO m
  => Text
  -> Float
  -> (Float, Float) -- TODO: use Behavior somehow
  -> m (Widget' Float)
sliderFloat label initial (start, end) = liftIO do
  (ah, fire) <- RBF.newAddHandler

  ref <- mallocForeignPtr
  withForeignPtr ref \ptr ->
    Foreign.poke ptr (CFloat initial)

  pure Widget
    { plug = do
        event <- RBF.fromAddHandler ah
        beh <- RB.stepper initial event
        pure (event, beh)
    , draw =
        withCString label \labelPtr -> -- FIXME: make this static
          withForeignPtr ref \refPtr -> do
            changed <- DearImGui.Raw.sliderFloat
              labelPtr
              refPtr
              (CFloat start)
              (CFloat end)
              Foreign.nullPtr
            when changed do
              CFloat current <- Foreign.peek refPtr
              fire current
    }

sliderFloat2
  :: MonadIO m
  => Text
  -> Vec2
  -> (Float, Float)
  -> m (Widget' Vec2)
sliderFloat2 label initial (start, end) = liftIO do
  (ah, fire) <- RBF.newAddHandler

  ref <- mallocForeignPtr
  withForeignPtr ref \ptr ->
    Foreign.poke ptr initial

  pure Widget
    { plug = do
        event <- RBF.fromAddHandler ah
        beh <- RB.stepper initial event
        pure (event, beh)
    , draw =
        withCString label \labelPtr -> -- FIXME: make this static
          withForeignPtr ref \refPtr -> do
            changed <- DearImGui.Raw.sliderFloat2
              labelPtr
              (Foreign.castPtr refPtr)
              (CFloat start)
              (CFloat end)
              Foreign.nullPtr
            when changed do
              current <- Foreign.peek refPtr
              fire current
    }

sliderAngle
  :: MonadIO m
  => Text
  -> Float
  -> (Float, Float)
  -> m (Widget' Float)
sliderAngle label initial (start, end) = liftIO do
  (ah, fire) <- RBF.newAddHandler

  ref <- mallocForeignPtr
  withForeignPtr ref \ptr ->
    Foreign.poke ptr (CFloat initial)

  pure Widget
    { plug = do
        event <- RBF.fromAddHandler ah
        beh <- RB.stepper initial event
        pure (event, beh)
    , draw =
        withCString label \labelPtr -> -- FIXME: make this static
          withForeignPtr ref \refPtr -> do
            changed <- DearImGui.Raw.sliderAngle
              labelPtr
              refPtr
              (CFloat start)
              (CFloat end)
              Foreign.nullPtr
              DearImGui.Raw.ImGuiSliderFlags_None
            when changed do
              CFloat current <- Foreign.peek refPtr
              fire current
    }

sliderUVec2
  :: MonadIO m
  => Text
  -> UVec2
  -> (Word32, Word32)
  -> m (Widget' UVec2)
sliderUVec2 label initial (start, end) = liftIO do
  (ah, fire) <- RBF.newAddHandler

  ref <- mallocForeignPtr
  withForeignPtr ref \ptr ->
    Foreign.poke ptr initial

  pure Widget
    { plug = do
        event <- RBF.fromAddHandler ah
        beh <- RB.stepper initial event
        pure (event, beh)
    , draw =
        withCString label \labelPtr -> -- FIXME: make this static
          withForeignPtr ref \refPtr -> do
            changed <- DearImGui.Raw.sliderInt2
              labelPtr
              (Foreign.castPtr refPtr)
              (fromIntegral start)
              (fromIntegral end)
              Foreign.nullPtr
              DearImGui.Raw.ImGuiSliderFlags_None
            when changed do
              current <- Foreign.peek refPtr
              fire current
    }

button
  :: MonadIO m
  => Text
  -> m (Widget' ())
button label = liftIO do
  (ah, fire) <- RBF.newAddHandler
  pure Widget
    { plug = do
        event <- RBF.fromAddHandler ah
        pure (event, pure ())
    , draw =
        withCString label \labelPtr -> do
          clicked <- DearImGui.Raw.button labelPtr
          when clicked do
            fire ()
    }

text :: RB.Event Text -> RBF.MomentIO (Widget Void ())
text bodyE = render_ bodyE DearImGui.text

-- | Lift rendering fuction into 'Event' handler and wrap in a 'Widget'.
render_ :: RB.Event a -> (a -> IO ()) -> RBF.MomentIO (Widget Void ())
render_ srcE f = do
  drawer <- newIORef $ pure ()
  RBF.reactimate $ srcE <&> writeIORef drawer . f
  pure $ draw_ (join $ readIORef drawer)