-- | Floating panel overlays: windows, popups and modals (with the modal
-- backdrop), each a menu-style panel with its subtree painted inside.
module NanoUI.Frame.Overlay
  ( drawWindowOverlays
  , drawModalOverlays
  , drawPopupOverlays
  ) where

import Control.Monad (when)
import Data.IORef (readIORef)
import NanoUI.Context (Context (..), nodeTheme)
import NanoUI.Draw (pushRect, withClip)
import NanoUI.Frame.Chrome (overlayMenuStyle, overlayModalStyle, overlayWindowStyle, paintMenuPanel)
import NanoUI.Frame.Hit (modalTreeOpen)
import NanoUI.Frame.Paint (walkChildren)
import NanoUI.Layout.Arena (NodeIdx, NodeType (..), forNodes_, getNodeType, getPadding, getRect)
import NanoUI.Style (Padding (..), Style, Theme, themeOverlayDim, themeSeparator)
import NanoUI.Types (Rect (..), Size (..))
import NanoUI.Widgets.Chrome (titleBarChromeHFor, windowChromeSepH)

drawWindowOverlays :: Context -> IO ()
drawWindowOverlays :: Context -> IO ()
drawWindowOverlays Context
ctx =
  Context -> NodeType -> (NodeIdx -> Rect -> IO ()) -> IO ()
forFloatingNode Context
ctx NodeType
NodeWindow ((NodeIdx -> Rect -> IO ()) -> IO ())
-> (NodeIdx -> Rect -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \NodeIdx
idx rect :: Rect
rect@(Rect Float
x Float
y Float
w Float
_) -> do
    theme <- Context -> NodeIdx -> IO Theme
nodeTheme Context
ctx NodeIdx
idx
    drawFloatingPanel ctx theme idx (overlayWindowStyle theme) rect
    pad <- getPadding (ctxNodeArena ctx) idx
    let sepY = Float
y Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Padding -> Float
padT Padding
pad Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
titleBarChromeHFor Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
windowChromeSepH
    pushRect
      (ctxDrawArena ctx)
      (Rect (x + padL pad) sepY (max 0 (w - padL pad - padR pad)) windowChromeSepH)
      (themeSeparator theme)

drawPopupOverlays :: Context -> IO ()
drawPopupOverlays :: Context -> IO ()
drawPopupOverlays Context
ctx =
  Context -> NodeType -> (NodeIdx -> Rect -> IO ()) -> IO ()
forFloatingNode Context
ctx NodeType
NodePopup ((NodeIdx -> Rect -> IO ()) -> IO ())
-> (NodeIdx -> Rect -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \NodeIdx
idx Rect
rect -> do
    theme <- Context -> NodeIdx -> IO Theme
nodeTheme Context
ctx NodeIdx
idx
    drawFloatingPanel ctx theme idx (overlayMenuStyle theme) rect

drawModalOverlays :: Context -> Size -> IO ()
drawModalOverlays :: Context -> Size -> IO ()
drawModalOverlays Context
ctx (Size Float
ww Float
wh) = do
  found <- Context -> IO Bool
modalTreeOpen Context
ctx
  when found $ do
    theme <- readIORef (ctxTheme ctx)
    pushRect (ctxDrawArena ctx) (Rect 0 0 ww wh) (themeOverlayDim theme)
    forFloatingNode ctx NodeModal $ \NodeIdx
idx Rect
rect -> do
      modalTheme <- Context -> NodeIdx -> IO Theme
nodeTheme Context
ctx NodeIdx
idx
      drawFloatingPanel ctx modalTheme idx (overlayModalStyle modalTheme) rect

forFloatingNode :: Context -> NodeType -> (NodeIdx -> Rect -> IO ()) -> IO ()
forFloatingNode :: Context -> NodeType -> (NodeIdx -> Rect -> IO ()) -> IO ()
forFloatingNode Context
ctx NodeType
nodeType NodeIdx -> Rect -> IO ()
draw =
  NodeArena -> (NodeIdx -> IO ()) -> IO ()
forNodes_ (Context -> NodeArena
ctxNodeArena Context
ctx) ((NodeIdx -> IO ()) -> IO ()) -> (NodeIdx -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \NodeIdx
idx -> do
    nt <- NodeArena -> NodeIdx -> IO NodeType
getNodeType (Context -> NodeArena
ctxNodeArena Context
ctx) NodeIdx
idx
    when (nt == nodeType) $ do
      (x, y, w, h) <- getRect (ctxNodeArena ctx) idx
      draw idx (Rect x y w h)

drawFloatingPanel :: Context -> Theme -> NodeIdx -> Style -> Rect -> IO ()
drawFloatingPanel :: Context -> Theme -> NodeIdx -> Style -> Rect -> IO ()
drawFloatingPanel Context
ctx Theme
theme NodeIdx
idx Style
style Rect
rect = do
  DrawArena -> Theme -> Style -> Rect -> IO ()
paintMenuPanel (Context -> DrawArena
ctxDrawArena Context
ctx) Theme
theme Style
style Rect
rect
  DrawArena -> Rect -> IO () -> IO ()
forall a. DrawArena -> Rect -> IO a -> IO a
withClip (Context -> DrawArena
ctxDrawArena Context
ctx) Rect
rect (Context -> NodeIdx -> IO ()
walkChildren Context
ctx NodeIdx
idx)