-- | Per-node queries shared by the paint, span, scroll and hit passes: the
-- font a node renders and measures in, and a scroll node's fields and content
-- viewport.
module NanoUI.Frame.Node
  ( resolveFontFor
  , resolveTextFont
  , nodeFontMetrics
  , ScrollNode (..)
  , readScrollNode
  , scrollNodeViewport
  ) where

import Data.Text (Text)
import NanoUI.Context (Context (..))
import NanoUI.Draw.Types (TextFont (..))
import NanoUI.Font (FontMetrics, ScrollBarSlot, isDefaultNodeFont, measureTextIO)
import NanoUI.Frame.Scroll.Geometry
  ( ScrollConfig
  , decodeScrollConfig
  , scrollConfigNative2D
  , scrollContentClip
  , scrollViewportClip2D
  )
import NanoUI.Layout.Arena
  ( DirTag
  , NodeArena
  , NodeIdx
  , NodeType (..)
  , getDirection
  , getNodeFontSize
  , getNodeType
  , getNodeValue
  , getPadding
  , getScrollContentW
  , getStyleIdx
  )
import NanoUI.Layout.Solve (scrollBarSlotOf)
import NanoUI.Style (FontVariant (..), Padding)
import NanoUI.Types (Rect)
import NanoUI.WidgetText (textNodeFontStyle, textNodeFontVariant, textNodeFontWeight)

-- | Font for a node of type @nt@ with an explicit size and packed style: the
-- metrics, whether the host returned a native styled face (paint then skips
-- synthetic weight and slant), and the matching measure. Base sans and mono
-- resolve to the pre-read metrics; everything else defers to the host
-- resolver. INLINE: it runs for every text-bearing node painted, and inlining
-- lets the result triple fold away at each call site (measured: 30 MB less
-- allocation over the 3000-frame profile).
--
-- Only text and text-input nodes pack a font into their style. Other widgets
-- keep their own data in those bits (a radio's option index, a colour picker
-- part, a tab's look), so their style must not be read as a font.
{-# INLINE resolveFontFor #-}
resolveFontFor :: Context -> NodeType -> Float -> Int -> IO (FontMetrics, Bool, Text -> IO (Float, Float))
resolveFontFor :: Context
-> NodeType
-> Float
-> Int
-> IO (FontMetrics, Bool, Text -> IO (Float, Float))
resolveFontFor Context
ctx NodeType
nt Float
size Int
packed
  | Float -> FontWeight -> FontStyle -> FontVariant -> Bool
isDefaultNodeFont Float
size FontWeight
weight FontStyle
style FontVariant
variant =
      (FontMetrics, Bool, Text -> IO (Float, Float))
-> IO (FontMetrics, Bool, Text -> IO (Float, Float))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ((FontMetrics, Bool, Text -> IO (Float, Float))
 -> IO (FontMetrics, Bool, Text -> IO (Float, Float)))
-> (FontMetrics, Bool, Text -> IO (Float, Float))
-> IO (FontMetrics, Bool, Text -> IO (Float, Float))
forall a b. (a -> b) -> a -> b
$
        if FontVariant
variant FontVariant -> FontVariant -> Bool
forall a. Eq a => a -> a -> Bool
== FontVariant
FontMono
          then (Context -> FontMetrics
ctxMonoFontMetrics Context
ctx, Bool
False, FontMetrics -> Text -> IO (Float, Float)
measureTextIO (Context -> FontMetrics
ctxMonoFontMetrics Context
ctx))
          else (Context -> FontMetrics
ctxFontMetrics Context
ctx, Bool
False, Context -> Text -> IO (Float, Float)
ctxMeasureText Context
ctx)
  | Bool
otherwise = do
      (fm, native) <- Context
-> Float
-> FontWeight
-> FontStyle
-> FontVariant
-> IO (FontMetrics, Bool)
ctxResolveFont Context
ctx Float
size FontWeight
weight FontStyle
style FontVariant
variant
      pure (fm, native, ctxResolveMeasure ctx size weight style variant)
  where
    si :: Int
si = if NodeType
nt NodeType -> NodeType -> Bool
forall a. Eq a => a -> a -> Bool
== NodeType
NodeText Bool -> Bool -> Bool
|| NodeType
nt NodeType -> NodeType -> Bool
forall a. Eq a => a -> a -> Bool
== NodeType
NodeTextInput then Int
packed else Int
0
    variant :: FontVariant
variant = Int -> FontVariant
textNodeFontVariant Int
si
    weight :: FontWeight
weight = Int -> FontWeight
textNodeFontWeight Int
si
    style :: FontStyle
style = Int -> FontStyle
textNodeFontStyle Int
si

-- | The font a 'DrawTextStyled' op names, and whether the host draws its
-- weight and slant natively.
resolveTextFont :: Context -> TextFont -> IO (FontMetrics, Bool)
resolveTextFont :: Context -> TextFont -> IO (FontMetrics, Bool)
resolveTextFont Context
ctx (TextFont Float
size FontVariant
variant FontWeight
weight FontStyle
style TextDecoration
_)
  | Float -> FontWeight -> FontStyle -> FontVariant -> Bool
isDefaultNodeFont Float
size FontWeight
weight FontStyle
style FontVariant
variant =
      (FontMetrics, Bool) -> IO (FontMetrics, Bool)
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (if FontVariant
variant FontVariant -> FontVariant -> Bool
forall a. Eq a => a -> a -> Bool
== FontVariant
FontMono then Context -> FontMetrics
ctxMonoFontMetrics Context
ctx else Context -> FontMetrics
ctxFontMetrics Context
ctx, Bool
False)
  | Bool
otherwise = Context
-> Float
-> FontWeight
-> FontStyle
-> FontVariant
-> IO (FontMetrics, Bool)
ctxResolveFont Context
ctx Float
size FontWeight
weight FontStyle
style FontVariant
variant

-- | Metrics of the font node @idx@ is styled with.
nodeFontMetrics :: Context -> NodeIdx -> IO FontMetrics
nodeFontMetrics :: Context -> Int -> IO FontMetrics
nodeFontMetrics Context
ctx Int
idx = do
  nt <- NodeArena -> Int -> IO NodeType
getNodeType (Context -> NodeArena
ctxNodeArena Context
ctx) Int
idx
  si <- getStyleIdx (ctxNodeArena ctx) idx
  size <- getNodeFontSize (ctxNodeArena ctx) idx
  (fm, _, _) <- resolveFontFor ctx nt size si
  pure fm

-- | What the scroll passes read off a scroll container: its bar slot, scroll
-- config, whether it scrolls natively in 2D, direction, padding, the content
-- extent along its main axis (the content height for 2D) and, for 2D, the
-- content width.
data ScrollNode = ScrollNode
  { ScrollNode -> ScrollBarSlot
snSlot :: !ScrollBarSlot
  , ScrollNode -> ScrollConfig
snConfig :: !ScrollConfig
  , ScrollNode -> Bool
sn2D :: !Bool
  , ScrollNode -> DirTag
snDir :: !DirTag
  , ScrollNode -> Padding
snPad :: {-# UNPACK #-} !Padding
  , ScrollNode -> Float
snContentMain :: {-# UNPACK #-} !Float
  , ScrollNode -> Float
snContentW :: {-# UNPACK #-} !Float
  }

{-# INLINE readScrollNode #-}
readScrollNode :: NodeArena -> NodeIdx -> IO ScrollNode
readScrollNode :: NodeArena -> Int -> IO ScrollNode
readScrollNode NodeArena
na Int
idx = do
  si <- NodeArena -> Int -> IO Int
getStyleIdx NodeArena
na Int
idx
  slot <- scrollBarSlotOf na idx
  dir <- getDirection na idx
  pad <- getPadding na idx
  contentMain <- getNodeValue na idx
  contentW <- getScrollContentW na idx
  let cfg = Int -> ScrollConfig
decodeScrollConfig Int
si
  pure $! ScrollNode slot cfg (si /= 0 && scrollConfigNative2D cfg) dir pad contentMain contentW

-- | Content viewport of a scroll node placed at @x y w h@: its padding box
-- minus the live scrollbar gutters.
scrollNodeViewport :: ScrollNode -> Float -> Float -> Float -> Float -> Rect
scrollNodeViewport :: ScrollNode -> Float -> Float -> Float -> Float -> Rect
scrollNodeViewport (ScrollNode ScrollBarSlot
slot ScrollConfig
cfg Bool
native2D DirTag
dir Padding
pad Float
contentMain Float
contentW) Float
x Float
y Float
w Float
h
  | Bool
native2D = ScrollBarSlot
-> ScrollConfig
-> Float
-> Float
-> Float
-> Float
-> Padding
-> Float
-> Float
-> Rect
scrollViewportClip2D ScrollBarSlot
slot ScrollConfig
cfg Float
x Float
y Float
w Float
h Padding
pad Float
contentW Float
contentMain
  | Bool
otherwise = ScrollBarSlot
-> ScrollConfig
-> DirTag
-> Float
-> Float
-> Float
-> Float
-> Padding
-> Float
-> Rect
scrollContentClip ScrollBarSlot
slot ScrollConfig
cfg DirTag
dir Float
x Float
y Float
w Float
h Padding
pad Float
contentMain