{-# LANGUAGE DataKinds #-}

module NanoUI.Frame.Redraw
  ( needsRedraw
  , pointerDragActive
  , textFieldActive
  , floatingPanelActive
  , debugPanelOpen
  , overlayMenuOpen
  , probeHotId
  ) where

import Data.IORef (IORef, readIORef)
import Data.Maybe (isJust)
import NanoUI.Context
  ( Context (..)
  , anyAnimating
  , anySelectOpen
  , getMenuPointerGesture
  , getScrollDrag
  , getStore
  , getTextInputMenu
  , getWindowDrag
  , getWindowResize
  , isDirty
  , modalActive
  )
import NanoUI.Frame.Hit (findNodeByWidgetId, nodePointVisible, overlayHitAllowed)
import NanoUI.Frame.Select (overlayMenuOwnerAt)
import NanoUI.Id (WidgetId (..), hashWidgetId)
import NanoUI.Input (Input (..), inputInteracted, inputMousePos, inputPointerHeld)
import NanoUI.Layout.Arena
  ( NodeType (..)
  , findNodeM
  , getNodeType
  , getOptions
  , getWidgetId
  , isFloatingNode
  , isWidgetNode
  )
import NanoUI.Types (V2 (..))

needsRedraw :: Context -> Input -> Input -> IO Bool
needsRedraw :: Context -> Input -> Input -> IO Bool
needsRedraw Context
ctx Input
prev Input
inp = do
  dirty <- Context -> IO Bool
isDirty Context
ctx
  anim <- anyAnimating ctx
  mDrag <- getScrollDrag ctx
  mWinDrag <- getWindowDrag ctx
  overlay <- overlayMenuOpen ctx
  edit <- textFieldActive ctx
  let moved = Input -> V2
inputMousePos Input
prev V2 -> V2 -> Bool
forall a. Eq a => a -> a -> Bool
/= Input -> V2
inputMousePos Input
inp
  if dirty
    || anim
    || inputInteracted prev inp
    || inputWindowRedraw inp
    || inputPointerHeld inp
    || isJust mDrag
    || isJust mWinDrag
    || (overlay && moved)
    || edit
    then pure True
    else
      -- Idle: hover can only change when the pointer moved since the frame
      -- whose hover state we still hold. Skip the O(n) hot probe otherwise.
      if not moved
        then pure False
        else do
          lastHot <- readIORef (ctxLastHotId ctx)
          (/= lastHot) <$> probeHotId ctx (inputMousePos inp)

-- Window/scroll/resize drag marks dirty every frame, so input must still be
-- polled on those frames.
-- Color picker and slider hold ctxActiveId without extra window/scroll refs.
pointerDragActive :: Context -> IO Bool
pointerDragActive :: Context -> IO Bool
pointerDragActive Context
ctx = do
  winDrag <- Maybe (WidgetId, Float, Float) -> Bool
forall a. Maybe a -> Bool
isJust (Maybe (WidgetId, Float, Float) -> Bool)
-> IO (Maybe (WidgetId, Float, Float)) -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Context -> IO (Maybe (WidgetId, Float, Float))
getWindowDrag Context
ctx
  scrollDrag <- isJust <$> getScrollDrag ctx
  winResize <- isJust <$> getWindowResize ctx
  sliderOrPicker <- focusedNodeIs ctx ctxActiveId (\NodeType
nt -> NodeType
nt NodeType -> NodeType -> Bool
forall a. Eq a => a -> a -> Bool
== NodeType
NodeSlider Bool -> Bool -> Bool
|| NodeType
nt NodeType -> NodeType -> Bool
forall a. Eq a => a -> a -> Bool
== NodeType
NodeColorPicker)
  pure (winDrag || scrollDrag || winResize || sliderOrPicker)

-- | Whether the node of the widget id held in @ref@ satisfies @p@.
focusedNodeIs :: Context -> (Context -> IORef WidgetId) -> (NodeType -> Bool) -> IO Bool
focusedNodeIs :: Context
-> (Context -> IORef WidgetId) -> (NodeType -> Bool) -> IO Bool
focusedNodeIs Context
ctx Context -> IORef WidgetId
ref NodeType -> Bool
p = do
  wid <- IORef WidgetId -> IO WidgetId
forall a. IORef a -> IO a
readIORef (Context -> IORef WidgetId
ref Context
ctx)
  if hashWidgetId wid == 0
    then pure False
    else do
      mIdx <- findNodeByWidgetId ctx wid
      case mIdx of
        Maybe NodeIdx
Nothing -> Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
        Just NodeIdx
idx -> NodeType -> Bool
p (NodeType -> Bool) -> IO NodeType -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NodeArena -> NodeIdx -> IO NodeType
getNodeType (Context -> NodeArena
ctxNodeArena Context
ctx) NodeIdx
idx

-- Select dropdown or text-input menu is open. Overlay hover is not a widget id.
-- A focused combo (a search-style field carrying options) also owns an open
-- dropdown: report it so every frame while it is up redraws with full damage:
-- the floating list is painted by an overlay, so clip-damage frames would
-- leave stale rows in the retained texture.
overlayMenuOpen :: Context -> IO Bool
overlayMenuOpen :: Context -> IO Bool
overlayMenuOpen Context
ctx = do
  store <- Context -> IO WidgetStore
getStore Context
ctx
  menu <- getTextInputMenu ctx
  if anySelectOpen store || isJust menu
    then pure True
    else do
      focus <- readIORef (ctxFocusId ctx)
      if hashWidgetId focus == 0
        then pure False
        else do
          mIdx <- findNodeByWidgetId ctx focus
          case mIdx of
            Maybe NodeIdx
Nothing -> Bool -> IO Bool
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Bool
False
            Just NodeIdx
idx -> do
              nt <- NodeArena -> NodeIdx -> IO NodeType
getNodeType (Context -> NodeArena
ctxNodeArena Context
ctx) NodeIdx
idx
              if nt /= NodeTextInput
                then pure False
                else not . null <$> getOptions (ctxNodeArena ctx) idx

-- Focused text field or its context menu. Keep the loop live so typed bytes
-- are not stuck behind SDL_WaitEvent.
textFieldActive :: Context -> IO Bool
textFieldActive :: Context -> IO Bool
textFieldActive Context
ctx = do
  menu <- Context -> IO (Maybe TextInputMenu)
getTextInputMenu Context
ctx
  if isJust menu
    then pure True
    else focusedNodeIs ctx ctxFocusId (\NodeType
nt -> NodeType
nt NodeType -> NodeType -> Bool
forall a. Eq a => a -> a -> Bool
== NodeType
NodeTextInput Bool -> Bool -> Bool
|| NodeType
nt NodeType -> NodeType -> Bool
forall a. Eq a => a -> a -> Bool
== NodeType
NodeTextArea)

-- Last frame still has a floating node (modal or window). Used by backends to
-- decide whether overlay content might need periodic refresh (debug HUD).
floatingPanelActive :: Context -> IO Bool
floatingPanelActive :: Context -> IO Bool
floatingPanelActive Context
ctx = do
  modal <- Context -> IO Bool
modalActive Context
ctx
  if modal
    then pure True
    else isJust <$> findNodeM (ctxNodeArena ctx) (fmap isFloatingNode . getNodeType (ctxNodeArena ctx))

-- Floating window overlay (debug HUD). Prev floating rects persist across idle frames.
debugPanelOpen :: Context -> IO Bool
debugPanelOpen :: Context -> IO Bool
debugPanelOpen Context
ctx =
  Maybe NodeIdx -> Bool
forall a. Maybe a -> Bool
isJust (Maybe NodeIdx -> Bool) -> IO (Maybe NodeIdx) -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> NodeArena -> (NodeIdx -> IO Bool) -> IO (Maybe NodeIdx)
findNodeM (Context -> NodeArena
ctxNodeArena Context
ctx) ((NodeType -> Bool) -> IO NodeType -> IO Bool
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (NodeType -> NodeType -> Bool
forall a. Eq a => a -> a -> Bool
== NodeType
NodeWindow) (IO NodeType -> IO Bool)
-> (NodeIdx -> IO NodeType) -> NodeIdx -> IO Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NodeArena -> NodeIdx -> IO NodeType
getNodeType (Context -> NodeArena
ctxNodeArena Context
ctx))

probeHotId :: Context -> V2 -> IO WidgetId
probeHotId :: Context -> V2 -> IO WidgetId
probeHotId Context
ctx V2
mouse = do
  gesture <- Context -> IO Bool
getMenuPointerGesture Context
ctx
  if gesture
    then pure (WidgetId 0)
    else do
      mOverlay <- overlayMenuOwnerAt ctx mouse
      case mOverlay of
        Just WidgetId
wid -> WidgetId -> IO WidgetId
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure WidgetId
wid
        -- Earlier siblings paint over later ones, so the first hit wins.
        Maybe WidgetId
Nothing -> IO WidgetId
-> (NodeIdx -> IO WidgetId) -> Maybe NodeIdx -> IO WidgetId
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (WidgetId -> IO WidgetId
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word64 -> WidgetId
WidgetId Word64
0)) (NodeArena -> NodeIdx -> IO WidgetId
getWidgetId NodeArena
na) (Maybe NodeIdx -> IO WidgetId) -> IO (Maybe NodeIdx) -> IO WidgetId
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< NodeArena -> (NodeIdx -> IO Bool) -> IO (Maybe NodeIdx)
findNodeM NodeArena
na NodeIdx -> IO Bool
hits
  where
    na :: NodeArena
na = Context -> NodeArena
ctxNodeArena Context
ctx
    hits :: NodeIdx -> IO Bool
hits NodeIdx
idx = do
      nt <- NodeArena -> NodeIdx -> IO NodeType
getNodeType NodeArena
na NodeIdx
idx
      if not (isWidgetNode nt)
        then pure False
        else do
          visible <- nodePointVisible ctx idx mouse
          if visible then overlayHitAllowed ctx idx mouse else pure False