nano-ui-0.1.0.0: lib/NanoUI/Frame/Paint/Types.hs
-- Shared leaf module for NanoUI.Frame.Paint and its widget painter sibling:
-- both the walker (NanoUI.Frame.Paint) and the chrome painters
-- (NanoUI.Frame.Paint.Widgets) consume the paint env, so the record and its
-- small helpers live here to keep the module graph acyclic (Paint imports
-- Widgets, Widgets imports Types, Paint imports Types).
module NanoUI.Frame.Paint.Types
( PaintEnv (..)
, buildPaintEnv
, popupPanelRect
) where
import Data.IORef (readIORef)
import Data.Primitive.PrimArray (PrimArray)
import NanoUI.Context (Context (..))
import NanoUI.Draw (DrawArena)
import NanoUI.Font (FontMetrics)
import NanoUI.Id (WidgetId (..))
import NanoUI.Layout.Arena
( NodeArena
, NodeIdx
, NodeType (..)
, getNodeType
, getParent
, getRect
)
import NanoUI.Style (Theme)
import NanoUI.Types (Rect (..))
-- | Everything a paint pass needs, bundled so the walker does not re-read the
-- theme IORef (or rebuild arena handles) for every node. Baked once per
-- frame by 'buildPaintEnv'. Fields are lazy: under
-- -funbox-strict-fields a strict paint env would unbox every reachable
-- field of Context/Theme/Style recursively, turning each record selector into
-- a ~100-way case that dominates Core size; lazy fields stay single pointers
-- (all bindings here are already-evaluated values, so no thunks are paid).
data PaintEnv = PaintEnv
{ peContext :: Context
, peNodeArena :: NodeArena
, peDrawArena :: DrawArena
, peTheme :: Theme
, peScope :: Int
-- ^ The node scope 'peTheme' belongs to. A node in another scope repaints
-- its subtree with that scope's theme.
, peFontMetrics :: FontMetrics
, peOccluders :: PrimArray Float
-- ^ Opaque floating panel rects as @x0, y0, x1, y1@ runs; empty when the
-- frame has none.
, peFocusRing :: WidgetId
-- ^ The focused widget while its keyboard focus ring shows, else 0.
}
-- | Locality helper for callers inside the paint frame loop; a fresh env
-- re-reads the theme once.
{-# NOINLINE buildPaintEnv #-}
buildPaintEnv :: Context -> PrimArray Float -> IO PaintEnv
buildPaintEnv ctx occluders = do
theme <- readIORef (ctxTheme ctx)
focus <- readIORef (ctxFocusId ctx)
focusVisible <- readIORef (ctxFocusVisible ctx)
pure PaintEnv
{ peContext = ctx
, peNodeArena = ctxNodeArena ctx
, peDrawArena = ctxDrawArena ctx
, peTheme = theme
, peScope = 0
, peFontMetrics = ctxFontMetrics ctx
, peOccluders = occluders
, peFocusRing = if focusVisible then focus else WidgetId 0
}
-- | Rect of the nearest popup-panel ancestor of @idx@, if any. Menu rows use
-- it to paint hover fills edge-to-edge across the panel.
popupPanelRect :: Context -> NodeIdx -> IO (Maybe Rect)
popupPanelRect ctx = go
where
go i = do
p <- getParent (ctxNodeArena ctx) i
if p < 0
then pure Nothing
else do
nt <- getNodeType (ctxNodeArena ctx) p
if nt == NodePopup
then do
(px, py, pw, ph) <- getRect (ctxNodeArena ctx) p
pure (Just (Rect px py pw ph))
else go p