{-# LANGUAGE OverloadedStrings #-}

-- | Display helpers: styled labels, key/value rows, cards, toolbars, images
-- and colour boxes.
module NanoUI.Widgets.Display
  ( heading
  , muted
  , mono
  , danger
  , bold
  , italic
  , underline
  , kv
  , kvMono
  , kvBlock
  , card
  , toolbar
  , image
  , image'
  , freshImageId
  , registerImageRgba
  , svgIcon
  , svgIconWith
  , svgIconWith'
  , loadSvg
  , box
  )
where

import Control.Exception (IOException, try)
import Control.Monad (void)
import Data.ByteString (ByteString)
import Data.ByteString qualified as BS
import Data.IORef (IORef, atomicModifyIORef', newIORef, readIORef)
import Data.Map.Strict qualified as Map
import Data.Text.Encoding qualified as TE
import Data.Text (Text)
import Data.Text qualified as T
import Effectful (Eff, type (:>))
import NanoUI.Atlas qualified as Atlas
import NanoUI.Context (Context (..), askHostIO, registerImage, setHost)
import NanoUI.Draw (getDrawSnapScale)
import NanoUI.Layout.Arena (NodeType (..))
import NanoUI.Monad (Ui, askContext, nextId, uiIO, uiTheme)
import NanoUI.Svg (Svg, parseSvg, rasterizeSvg, svgKey, svgMonochrome, svgSize)
import NanoUI.Style
  ( Layout (..)
  , Sizing (..)
  , alignEnd
  , alignMid
  , defaultLayout
  , fillW
  , fontBold
  , fontDanger
  , fontItalic
  , fontMedium
  , fontMono
  , fontMuted
  , fontUnderline
  , gap
  , minW
  , padXY
  , styleFg
  , themePanel
  , tight
  )
import Data.Word (Word32)
import NanoUI.Types (Color (..), ImageId (..), colorRGBA, colorToWord32)
import NanoUI.WidgetText (intValueText)
import NanoUI.Widgets.Layout (labelEx, labelWith, panelWith, row', rowWith)
import NanoUI.Widgets.Node (Response, addWidget, addWidgetStyled)

heading :: Ui :> es => Text -> Eff es ()
heading :: forall (es :: [Effect]). (Ui :> es) => Text -> Eff es ()
heading = (Layout -> Layout) -> Text -> Eff es ()
forall (es :: [Effect]).
(Ui :> es) =>
(Layout -> Layout) -> Text -> Eff es ()
labelWith (Layout -> Layout
tight (Layout -> Layout) -> (Layout -> Layout) -> Layout -> Layout
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Layout -> Layout
fontMedium)

muted :: Ui :> es => Text -> Eff es ()
muted :: forall (es :: [Effect]). (Ui :> es) => Text -> Eff es ()
muted = (Layout -> Layout) -> Text -> Eff es ()
forall (es :: [Effect]).
(Ui :> es) =>
(Layout -> Layout) -> Text -> Eff es ()
labelWith (Layout -> Layout
fillW (Layout -> Layout) -> (Layout -> Layout) -> Layout -> Layout
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Layout -> Layout
fontMuted)

mono :: Ui :> es => Text -> Eff es ()
mono :: forall (es :: [Effect]). (Ui :> es) => Text -> Eff es ()
mono = (Layout -> Layout) -> Text -> Eff es ()
forall (es :: [Effect]).
(Ui :> es) =>
(Layout -> Layout) -> Text -> Eff es ()
labelWith Layout -> Layout
fontMono

danger :: Ui :> es => Text -> Eff es ()
danger :: forall (es :: [Effect]). (Ui :> es) => Text -> Eff es ()
danger = (Layout -> Layout) -> Text -> Eff es ()
forall (es :: [Effect]).
(Ui :> es) =>
(Layout -> Layout) -> Text -> Eff es ()
labelWith (Layout -> Layout
fillW (Layout -> Layout) -> (Layout -> Layout) -> Layout -> Layout
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Layout -> Layout
fontDanger)

bold :: Ui :> es => Text -> Eff es ()
bold :: forall (es :: [Effect]). (Ui :> es) => Text -> Eff es ()
bold = (Layout -> Layout) -> Text -> Eff es ()
forall (es :: [Effect]).
(Ui :> es) =>
(Layout -> Layout) -> Text -> Eff es ()
labelWith Layout -> Layout
fontBold

italic :: Ui :> es => Text -> Eff es ()
italic :: forall (es :: [Effect]). (Ui :> es) => Text -> Eff es ()
italic = (Layout -> Layout) -> Text -> Eff es ()
forall (es :: [Effect]).
(Ui :> es) =>
(Layout -> Layout) -> Text -> Eff es ()
labelWith Layout -> Layout
fontItalic

underline :: Ui :> es => Text -> Eff es ()
underline :: forall (es :: [Effect]). (Ui :> es) => Text -> Eff es ()
underline = (Layout -> Layout) -> Text -> Eff es ()
forall (es :: [Effect]).
(Ui :> es) =>
(Layout -> Layout) -> Text -> Eff es ()
labelWith Layout -> Layout
fontUnderline

-- | Key/value row: a muted key on the left, the value right-aligned. Trailing
-- whitespace in the value is dropped.
kv :: Ui :> es => Text -> Text -> Eff es ()
kv :: forall (es :: [Effect]). (Ui :> es) => Text -> Text -> Eff es ()
kv Text
k Text
v =
  Layout -> Eff es () -> Eff es ()
forall (es :: [Effect]) a.
(Ui :> es) =>
Layout -> Eff es a -> Eff es a
row' (Layout -> Layout
tight (Layout -> Layout) -> (Layout -> Layout) -> Layout -> Layout
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Layout -> Layout
gap Float
12 (Layout -> Layout) -> (Layout -> Layout) -> Layout -> Layout
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Layout -> Layout
alignMid (Layout -> Layout) -> (Layout -> Layout) -> Layout -> Layout
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Layout -> Layout
fillW (Layout -> Layout) -> Layout -> Layout
forall a b. (a -> b) -> a -> b
$ Layout
defaultLayout) (Eff es () -> Eff es ()) -> Eff es () -> Eff es ()
forall a b. (a -> b) -> a -> b
$ do
    Eff es Response -> Eff es ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Layout -> Text -> Eff es Response
forall (es :: [Effect]).
(Ui :> es) =>
Layout -> Text -> Eff es Response
labelEx (Layout -> Layout
fontMuted (Layout -> Layout) -> (Layout -> Layout) -> Layout -> Layout
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Layout -> Layout
tight (Layout -> Layout) -> (Layout -> Layout) -> Layout -> Layout
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Layout -> Layout
minW Float
88 (Layout -> Layout) -> Layout -> Layout
forall a b. (a -> b) -> a -> b
$ Layout
defaultLayout) Text
k)
    Eff es Response -> Eff es ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Layout -> Text -> Eff es Response
forall (es :: [Effect]).
(Ui :> es) =>
Layout -> Text -> Eff es Response
labelEx (Layout -> Layout
tight (Layout -> Layout) -> (Layout -> Layout) -> Layout -> Layout
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Layout -> Layout
fillW (Layout -> Layout) -> (Layout -> Layout) -> Layout -> Layout
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Layout -> Layout
alignEnd (Layout -> Layout) -> Layout -> Layout
forall a b. (a -> b) -> a -> b
$ Layout
defaultLayout) (Text -> Text
T.stripEnd Text
v))

-- | Key/value row with a monospace value.
kvMono :: Ui :> es => Text -> Text -> Eff es ()
kvMono :: forall (es :: [Effect]). (Ui :> es) => Text -> Text -> Eff es ()
kvMono Text
k Text
v =
  Layout -> Eff es () -> Eff es ()
forall (es :: [Effect]) a.
(Ui :> es) =>
Layout -> Eff es a -> Eff es a
row' (Layout -> Layout
tight (Layout -> Layout) -> (Layout -> Layout) -> Layout -> Layout
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Layout -> Layout
gap Float
12 (Layout -> Layout) -> (Layout -> Layout) -> Layout -> Layout
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Layout -> Layout
alignMid (Layout -> Layout) -> (Layout -> Layout) -> Layout -> Layout
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Layout -> Layout
fillW (Layout -> Layout) -> Layout -> Layout
forall a b. (a -> b) -> a -> b
$ Layout
defaultLayout) (Eff es () -> Eff es ()) -> Eff es () -> Eff es ()
forall a b. (a -> b) -> a -> b
$ do
    Eff es Response -> Eff es ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Layout -> Text -> Eff es Response
forall (es :: [Effect]).
(Ui :> es) =>
Layout -> Text -> Eff es Response
labelEx (Layout -> Layout
tight (Layout -> Layout) -> (Layout -> Layout) -> Layout -> Layout
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Layout -> Layout
minW Float
88 (Layout -> Layout) -> Layout -> Layout
forall a b. (a -> b) -> a -> b
$ Layout
defaultLayout) Text
k)
    Eff es Response -> Eff es ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Layout -> Text -> Eff es Response
forall (es :: [Effect]).
(Ui :> es) =>
Layout -> Text -> Eff es Response
labelEx (Layout -> Layout
tight (Layout -> Layout) -> (Layout -> Layout) -> Layout -> Layout
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Layout -> Layout
fillW (Layout -> Layout) -> (Layout -> Layout) -> Layout -> Layout
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Layout -> Layout
alignEnd (Layout -> Layout) -> (Layout -> Layout) -> Layout -> Layout
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Layout -> Layout
fontMono (Layout -> Layout) -> Layout -> Layout
forall a b. (a -> b) -> a -> b
$ Layout
defaultLayout) (Text -> Text
T.stripEnd Text
v))

-- | Key/value pairs as one monospace block with the keys padded to a column.
kvBlock :: (Foldable f, Ui :> es) => f (Text, Text) -> Eff es ()
kvBlock :: forall (f :: * -> *) (es :: [Effect]).
(Foldable f, Ui :> es) =>
f (Text, Text) -> Eff es ()
kvBlock f (Text, Text)
rows =
  let maxK :: Int
maxK = (Int -> (Text, Text) -> Int) -> Int -> f (Text, Text) -> Int
forall b a. (b -> a -> b) -> b -> f a -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' (\Int
acc (Text
k, Text
_) -> Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
acc (Text -> Int
T.length Text
k)) Int
0 f (Text, Text)
rows
      padK :: Text -> Text
padK Text
k = Int -> Char -> Text -> Text
T.justifyLeft Int
maxK Char
' ' Text
k
   in Eff es Response -> Eff es ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (Eff es Response -> Eff es ()) -> Eff es Response -> Eff es ()
forall a b. (a -> b) -> a -> b
$
        Layout -> Text -> Eff es Response
forall (es :: [Effect]).
(Ui :> es) =>
Layout -> Text -> Eff es Response
labelEx
          (Layout -> Layout
tight (Layout -> Layout) -> (Layout -> Layout) -> Layout -> Layout
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Layout -> Layout
gap Float
0 (Layout -> Layout) -> (Layout -> Layout) -> Layout -> Layout
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Layout -> Layout
fontMono (Layout -> Layout) -> Layout -> Layout
forall a b. (a -> b) -> a -> b
$ Layout
defaultLayout)
          ([Text] -> Text
T.concat (((Text, Text) -> [Text] -> [Text])
-> [Text] -> f (Text, Text) -> [Text]
forall a b. (a -> b -> b) -> b -> f a -> b
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr (\(Text
k, Text
v) [Text]
rest -> Text -> Text
padK Text
k Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Text
"  " Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Text
v Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: Text
"\n" Text -> [Text] -> [Text]
forall a. a -> [a] -> [a]
: [Text]
rest) [] f (Text, Text)
rows))

card :: Ui :> es => Eff es a -> Eff es a
card :: forall (es :: [Effect]) a. (Ui :> es) => Eff es a -> Eff es a
card = (Layout -> Layout) -> Eff es a -> Eff es a
forall (es :: [Effect]) a.
(Ui :> es) =>
(Layout -> Layout) -> Eff es a -> Eff es a
panelWith (Float -> Layout -> Layout
minW Float
300 (Layout -> Layout) -> (Layout -> Layout) -> Layout -> Layout
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Float -> Layout -> Layout
padXY Float
12 Float
10 (Layout -> Layout) -> (Layout -> Layout) -> Layout -> Layout
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Layout -> Layout
gap Float
8 (Layout -> Layout) -> (Layout -> Layout) -> Layout -> Layout
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Layout -> Layout
fillW)

toolbar :: Ui :> es => Eff es a -> Eff es a
toolbar :: forall (es :: [Effect]) a. (Ui :> es) => Eff es a -> Eff es a
toolbar = (Layout -> Layout) -> Eff es a -> Eff es a
forall (es :: [Effect]) a.
(Ui :> es) =>
(Layout -> Layout) -> Eff es a -> Eff es a
rowWith (Layout -> Layout
tight (Layout -> Layout) -> (Layout -> Layout) -> Layout -> Layout
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Float -> Layout -> Layout
gap Float
8 (Layout -> Layout) -> (Layout -> Layout) -> Layout -> Layout
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Layout -> Layout
alignMid (Layout -> Layout) -> (Layout -> Layout) -> Layout -> Layout
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Layout -> Layout
fillW)

-- | An image registered with the host, sized by the layout modifier.
image :: Ui :> es => (Layout -> Layout) -> ImageId -> Eff es ()
image :: forall (es :: [Effect]).
(Ui :> es) =>
(Layout -> Layout) -> ImageId -> Eff es ()
image Layout -> Layout
f ImageId
iid = Eff es Response -> Eff es ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ((Layout -> Layout) -> ImageId -> Eff es Response
forall (es :: [Effect]).
(Ui :> es) =>
(Layout -> Layout) -> ImageId -> Eff es Response
image' Layout -> Layout
f ImageId
iid)

-- | 'image' with its 'Response', for example to 'NanoUI.keepAnimating' an
-- image whose id changes over time.
image' :: Ui :> es => (Layout -> Layout) -> ImageId -> Eff es Response
image' :: forall (es :: [Effect]).
(Ui :> es) =>
(Layout -> Layout) -> ImageId -> Eff es Response
image' Layout -> Layout
f (ImageId Int
tid) = do
  wid <- Eff es WidgetId
forall (es :: [Effect]). (Ui :> es) => Eff es WidgetId
nextId
  let
    stored = if Int
tid Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 then Text
T.empty else Int -> Text
intValueText Int
tid
  addWidget wid NodeImage stored 0 (f defaultLayout)

-- | An image id that no registered image uses and no earlier call returned.
-- Take one for each image registered while the app runs.
freshImageId :: Ui :> es => Eff es ImageId
freshImageId :: forall (es :: [Effect]). (Ui :> es) => Eff es ImageId
freshImageId = do
  ctx <- Eff es Context
forall (es :: [Effect]). (Ui :> es) => Eff es Context
askContext
  uiIO (Atlas.freshImageId (ctxImageAtlas ctx))

-- | Register an RGBA image (4 bytes a pixel, rows top to bottom) under an id
-- while the app runs, for 'image' to draw. Returns 'False' when the size or
-- pixels are invalid, an image of another size already has the id, or the
-- atlas is full. An image of the same size is replaced.
registerImageRgba :: Ui :> es => ImageId -> Int -> Int -> ByteString -> Eff es Bool
registerImageRgba :: forall (es :: [Effect]).
(Ui :> es) =>
ImageId -> Int -> Int -> ByteString -> Eff es Bool
registerImageRgba ImageId
iid Int
w Int
h ByteString
pixels = do
  ctx <- Eff es Context
forall (es :: [Effect]). (Ui :> es) => Eff es Context
askContext
  uiIO (registerImage ctx iid w h pixels)

-- | Read and parse an SVG file.
loadSvg :: FilePath -> IO (Either String Svg)
loadSvg :: String -> IO (Either String Svg)
loadSvg String
path = do
  result <- IO ByteString -> IO (Either IOException ByteString)
forall e a. Exception e => IO a -> IO (Either e a)
try (String -> IO ByteString
BS.readFile String
path)
  pure $ case result of
    Left (IOException
err :: IOException) -> String -> Either String Svg
forall a b. a -> Either a b
Left (IOException -> String
forall a. Show a => a -> String
show IOException
err)
    Right ByteString
bytes -> Text -> Either String Svg
parseSvg (ByteString -> Text
TE.decodeUtf8Lenient ByteString
bytes)

-- | An SVG icon @size@ logical pixels square, drawn in the text colour where
-- it is used: a one-colour document (every paint @currentColor@ or
-- unspecified) takes the colour as a tint, and a multicoloured one paints
-- its @currentColor@ with it.
{-# INLINE svgIcon #-}
svgIcon :: Ui :> es => Float -> Svg -> Eff es ()
svgIcon :: forall (es :: [Effect]). (Ui :> es) => Float -> Svg -> Eff es ()
svgIcon Float
size = (Layout -> Layout) -> Svg -> Eff es ()
forall (es :: [Effect]).
(Ui :> es) =>
(Layout -> Layout) -> Svg -> Eff es ()
svgIconWith (Float -> Layout -> Layout
fixedSquare Float
size)
  where
    fixedSquare :: Float -> Layout -> Layout
fixedSquare Float
n Layout
l = Layout
l {layoutWidth = Fixed n, layoutHeight = Fixed n}

-- | An SVG document sized by the layout modifier: a fixed width and height,
-- or else the document's own size. A 'NanoUI.fontColor' in the modifier
-- replaces the text colour.
{-# INLINE svgIconWith #-}
svgIconWith :: Ui :> es => (Layout -> Layout) -> Svg -> Eff es ()
svgIconWith :: forall (es :: [Effect]).
(Ui :> es) =>
(Layout -> Layout) -> Svg -> Eff es ()
svgIconWith Layout -> Layout
f Svg
doc = Eff es Response -> Eff es ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void ((Layout -> Layout) -> Svg -> Eff es Response
forall (es :: [Effect]).
(Ui :> es) =>
(Layout -> Layout) -> Svg -> Eff es Response
svgIconWith' Layout -> Layout
f Svg
doc)

-- | The document is rasterized once per pixel size and colour, at the
-- display's scale, and kept in the image atlas for as long as the app runs.
svgIconWith' :: Ui :> es => (Layout -> Layout) -> Svg -> Eff es Response
svgIconWith' :: forall (es :: [Effect]).
(Ui :> es) =>
(Layout -> Layout) -> Svg -> Eff es Response
svgIconWith' Layout -> Layout
f Svg
doc = do
  ctx <- Eff es Context
forall (es :: [Effect]). (Ui :> es) => Eff es Context
askContext
  theme <- uiTheme
  let lay0 = Layout -> Layout
f Layout
defaultLayout
      (docW, docH) = svgSize doc
      fixedOr Sizing
sizing Float
dflt = case Sizing
sizing of
        Fixed Float
n -> Float
n
        Sizing
_ -> Float
dflt
      w = Sizing -> Float -> Float
fixedOr (Layout -> Sizing
layoutWidth Layout
lay0) Float
docW
      h = Sizing -> Float -> Float
fixedOr (Layout -> Sizing
layoutHeight Layout
lay0) Float
docH
      color = Color -> (Color -> Color) -> Maybe Color -> Color
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Style -> Color
styleFg (Theme -> Style
themePanel Theme
theme)) Color -> Color
forall a. a -> a
id (Layout -> Maybe Color
layoutFontColor Layout
lay0)
      oneColour = Svg -> Bool
svgMonochrome Svg
doc
      white = Word8 -> Word8 -> Word8 -> Word8 -> Color
colorRGBA Word8
255 Word8
255 Word8
255 Word8
255
      lay = Layout
lay0 {layoutWidth = Fixed w, layoutHeight = Fixed h, layoutFontColor = Just (if oneColour then color else white)}
  iid <- uiIO $ do
    scale <- getDrawSnapScale (ctxDrawArena ctx)
    let pw = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Float -> Int
forall b. Integral b => Float -> b
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Float
w Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
1 Float
scale))
        ph = Int -> Int -> Int
forall a. Ord a => a -> a -> a
max Int
1 (Float -> Int
forall b. Integral b => Float -> b
forall a b. (RealFrac a, Integral b) => a -> b
ceiling (Float
h Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
1 Float
scale))
        -- A one-colour raster is white and tinted when drawn, so every colour
        -- shares it.
        rasterColor = if Bool
oneColour then Color
white else Color
color
        key = (Svg -> Int
svgKey Svg
doc, Int
pw, Int
ph, Color -> Word32
colorToWord32 Color
rasterColor)
    cache <- svgRasterCache ctx
    known <- Map.lookup key <$> readIORef cache
    case known of
      Just ImageId
iid -> ImageId -> IO ImageId
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ImageId
iid
      Maybe ImageId
Nothing -> do
        iid <- ImageAtlas -> IO ImageId
Atlas.freshImageId (Context -> ImageAtlas
ctxImageAtlas Context
ctx)
        ok <- registerImage ctx iid pw ph (rasterizeSvg pw ph rasterColor doc)
        if ok
          then atomicModifyIORef' cache (\Map (Int, Int, Int, Word32) ImageId
m -> ((Int, Int, Int, Word32)
-> ImageId
-> Map (Int, Int, Int, Word32) ImageId
-> Map (Int, Int, Int, Word32) ImageId
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (Int, Int, Int, Word32)
key ImageId
iid Map (Int, Int, Int, Word32) ImageId
m, ()))
          else pure ()
        pure (if ok then iid else ImageId 0)
  image' (const lay) iid

-- | Rasterized SVG documents by document, pixel size and colour.
newtype SvgRasters = SvgRasters (IORef (Map.Map (Int, Int, Int, Word32) ImageId))

svgRasterCache :: Context -> IO (IORef (Map.Map (Int, Int, Int, Word32) ImageId))
svgRasterCache :: Context -> IO (IORef (Map (Int, Int, Int, Word32) ImageId))
svgRasterCache Context
ctx =
  Context -> IO (Maybe SvgRasters)
forall a. Typeable a => Context -> IO (Maybe a)
askHostIO Context
ctx IO (Maybe SvgRasters)
-> (Maybe SvgRasters
    -> IO (IORef (Map (Int, Int, Int, Word32) ImageId)))
-> IO (IORef (Map (Int, Int, Int, Word32) ImageId))
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \case
    Just (SvgRasters IORef (Map (Int, Int, Int, Word32) ImageId)
ref) -> IORef (Map (Int, Int, Int, Word32) ImageId)
-> IO (IORef (Map (Int, Int, Int, Word32) ImageId))
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure IORef (Map (Int, Int, Int, Word32) ImageId)
ref
    Maybe SvgRasters
Nothing -> do
      ref <- Map (Int, Int, Int, Word32) ImageId
-> IO (IORef (Map (Int, Int, Int, Word32) ImageId))
forall a. a -> IO (IORef a)
newIORef Map (Int, Int, Int, Word32) ImageId
forall k a. Map k a
Map.empty
      setHost ctx (SvgRasters ref)
      pure ref

-- | A solid rectangle sized by the layout modifier.
box :: Ui :> es => (Layout -> Layout) -> Color -> Eff es ()
box :: forall (es :: [Effect]).
(Ui :> es) =>
(Layout -> Layout) -> Color -> Eff es ()
box Layout -> Layout
f Color
col = do
  wid <- Eff es WidgetId
forall (es :: [Effect]). (Ui :> es) => Eff es WidgetId
nextId
  void
    ( addWidgetStyled
        wid
        NodeBox
        T.empty
        0
        (f defaultLayout)
        (fromIntegral (colorToWord32 col))
    )