module NanoUI.WidgetText
  ( intValueText
  , treeEncodeStyle
  , treeDecodeStyle
  , treeDecodeStripe
  , textInputFieldText
  , textInputMinWidth
  , textInputFieldPadY
  , textInputFieldHeight
  , textInputFlagSearch
  , textInputSearchMode
  , textInputFlagSelectable
  , textInputSelectableMode
  , textInputFlagPassword
  , textInputPasswordMode
  , textInputFlagNumeric
  , textInputNumericMode
  , numericStepperW
  , numericTextClip
  , numericStepperRects
  , comboTextClip
  , searchFieldReserveW
  , searchFieldTextClip
  , searchFieldIconRects
  , selectDisplayText
  , selectChevronReserve
  , selectChevronCenterX
  , colorPickerGap
  , colorPickerSvH
  , colorPickerCurrentLabel
  , colorPickerNewLabel
  , colorToHex
  , colorToHexA
  , colorFromHex
  , colorPickerParseHex
  , buttonFlagClose
  , buttonCloseTrailing
  , buttonFlagTab
  , buttonFlagTable
  , buttonFlagMenu
  , buttonFlagMenuBar
  , buttonFlagMask
  , tableStripeEven
  , tableStripeOdd
  , tableSortReserve
  , tableStripeColor
  , stripeColor
  , packTextNodeStyleFull
  , textNodeFontVariant
  , textNodeFontWeight
  , textNodeFontStyle
  , textNodeTextDecoration
  , textNodeStripe
  , tableHeaderLabel
  , tableHeaderDisplayText
  , tableSortMarkOf
  , tableSortBlank
  , isCloseButtonStyle
  , isTabButtonStyle
  , isTableHeaderStyle
  , isMenuItemStyle
  , isMenuBarStyle
  , buttonVisualStyle
  , buttonFlagsFromStyle
  ) where

import Data.Bits ((.&.), (.|.), complement, shiftL, shiftR)
import Data.Char (digitToInt, isHexDigit)
import Data.Maybe (fromMaybe)
import Data.Primitive.SmallArray (SmallArray, indexSmallArray, smallArrayFromList)
import Data.Text (Text)
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Builder as TB
import qualified Data.Text.Lazy.Builder.Int as TB
import Data.Word (Word8)
import Numeric (showHex)
import NanoUI.Font (FontMetrics (..), fmLineHeight, widgetContentInset)
import NanoUI.Style (FontStyle (..), FontVariant (..), FontWeight (..), TextDecoration (..), Theme (..), styleBg, themeButton, themePanel, themeWindow)
import NanoUI.Types (Color (..), Rect (..), colorA, colorB, colorG, colorR, colorRGBA, lerpColor)
import qualified Data.Text as T

intValueText :: Int -> Text
intValueText :: Int -> Text
intValueText = LazyText -> Text
TL.toStrict (LazyText -> Text) -> (Int -> LazyText) -> Int -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Builder -> LazyText
TB.toLazyText (Builder -> LazyText) -> (Int -> Builder) -> Int -> LazyText
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Builder
forall a. Integral a => a -> Builder
TB.decimal

-- | styleIdx: nodeIdx in bits 11+, depth in 0-7, hasKids bit 8, expanded bit 9, stripeOdd bit 10.
treeEncodeStyle :: Int -> Int -> Bool -> Bool -> Bool -> Int
treeEncodeStyle :: Int -> Int -> Bool -> Bool -> Bool -> Int
treeEncodeStyle Int
nodeIdx Int
depth Bool
hasKids Bool
expanded Bool
isOdd =
  (Int
nodeIdx Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
11)
    Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. (if Bool
isOdd then Int
0x400 else Int
0)
    Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. (if Bool
expanded then Int
0x200 else Int
0)
    Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. (if Bool
hasKids then Int
0x100 else Int
0)
    Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. (Int
depth Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0xff)

treeDecodeStyle :: Int -> (Int, Int, Bool, Bool)
treeDecodeStyle :: Int -> (Int, Int, Bool, Bool)
treeDecodeStyle Int
s =
  ( Int
s Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
11
  , Int
s Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0xff
  , Int
s Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x100 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0
  , Int
s Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x200 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0
  )

treeDecodeStripe :: Int -> Int
treeDecodeStripe :: Int -> Int
treeDecodeStripe Int
s = if Int
s Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x400 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0 then Int
tableStripeOdd else Int
tableStripeEven

textInputMinWidth :: Float
textInputMinWidth :: Float
textInputMinWidth = Float
160

textInputFieldPadY :: FontMetrics -> Float
textInputFieldPadY :: FontMetrics -> Float
textInputFieldPadY FontMetrics
fm = Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
3 (FontMetrics -> Char -> Float
fmAdvance FontMetrics
fm Char
' ' Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
1.25)

textInputFieldHeight :: FontMetrics -> Float
textInputFieldHeight :: FontMetrics -> Float
textInputFieldHeight FontMetrics
fm = FontMetrics -> Float
fmLineHeight FontMetrics
fm Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
2 Float -> Float -> Float
forall a. Num a => a -> a -> a
* FontMetrics -> Float
textInputFieldPadY FontMetrics
fm

-- | Search-field icon geometry. Returns
-- (icon diameter, outer pad, left chrome lead, right chrome tail). The lead/tail
-- are the horizontal space the magnifier / clear buttons reserve either side of
-- the editable text.
searchFieldChrome :: FontMetrics -> (Float, Float, Float, Float)
searchFieldChrome :: FontMetrics -> (Float, Float, Float, Float)
searchFieldChrome FontMetrics
fm =
  let (Float
ix, Float
_) = FontMetrics -> (Float, Float)
widgetContentInset FontMetrics
fm
      s :: Float
s = Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
12 (Float -> Float -> Float
forall a. Ord a => a -> a -> a
min Float
15 (FontMetrics -> Float
fmLineHeight FontMetrics
fm Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
0.8))
      pad :: Float
pad = FontMetrics -> Char -> Float
fmAdvance FontMetrics
fm Char
' ' Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
0.6
   in (Float
s, Float
ix, Float
ix Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
s Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
pad, Float
pad Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
s Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
ix)

-- | Total horizontal chrome a caption-less search box reserves for its icons.
searchFieldReserveW :: FontMetrics -> Float
searchFieldReserveW :: FontMetrics -> Float
searchFieldReserveW FontMetrics
fm =
  let (Float
_, Float
_, Float
lead, Float
tailw) = FontMetrics -> (Float, Float, Float, Float)
searchFieldChrome FontMetrics
fm
   in Float
lead Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
tailw

-- | Region a caption-less search field's editable text may occupy. Excludes the
-- magnifier on the left and the clear slot on the right.
searchFieldTextClip :: FontMetrics -> Float -> Float -> Float -> Float -> Rect
searchFieldTextClip :: FontMetrics -> Float -> Float -> Float -> Float -> Rect
searchFieldTextClip FontMetrics
fm Float
x Float
y Float
w Float
h =
  let (Float
_, Float
_, Float
lead, Float
tailw) = FontMetrics -> (Float, Float, Float, Float)
searchFieldChrome FontMetrics
fm
      (Float
_, Float
iy) = FontMetrics -> (Float, Float)
widgetContentInset FontMetrics
fm
   in Float -> Float -> Float -> Float -> Rect
Rect (Float
x Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
lead) (Float
y Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
iy) (Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
0 (Float
w Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
lead Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
tailw)) (Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
0 (Float
h Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
2 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
iy))

-- | Square slots (magnifier left, clear right) the search icons are drawn in.
searchFieldIconRects :: FontMetrics -> Float -> Float -> Float -> Float -> (Rect, Rect)
searchFieldIconRects :: FontMetrics -> Float -> Float -> Float -> Float -> (Rect, Rect)
searchFieldIconRects FontMetrics
fm Float
x Float
y Float
w Float
h =
  let (Float
s, Float
ix, Float
_, Float
_) = FontMetrics -> (Float, Float, Float, Float)
searchFieldChrome FontMetrics
fm
      cy :: Float
cy = Float
y Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
h Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
2
      mag :: Rect
mag = Float -> Float -> Float -> Float -> Rect
Rect (Float
x Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
ix) (Float
cy Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
s Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
2) Float
s Float
s
      clear :: Rect
clear = Float -> Float -> Float -> Float -> Rect
Rect (Float
x Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
w Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
ix Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
s) (Float
cy Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
s Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
2) Float
s Float
s
   in (Rect
mag, Rect
clear)

textInputFieldText :: Text -> Text -> Bool -> Text
textInputFieldText :: Text -> Text -> Bool -> Text
textInputFieldText Text
ph Text
value Bool
focused =
  let body :: Text
body = Text
value
   in if Text -> Bool
T.null Text
body Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
focused
        then Text
ph
        else Text
body

-- | Marks a @NodeTextInput@ as a caption-less search field. Lives in the high
-- style bits (like the button flags) so it survives the arena's int storage.
textInputFlagSearch :: Int
textInputFlagSearch :: Int
textInputFlagSearch = Int
0x04000000

{-# INLINE textInputSearchMode #-}
textInputSearchMode :: Int -> Bool
textInputSearchMode :: Int -> Bool
textInputSearchMode Int
si = Int
si Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
textInputFlagSearch Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0

-- | Marks a @NodeTextInput@ as a selectable text label: read-only, caption-less,
-- chrome-less, sized to its text content, with mouse drag-to-select and copy.
textInputFlagSelectable :: Int
textInputFlagSelectable :: Int
textInputFlagSelectable = Int
0x10000000

{-# INLINE textInputSelectableMode #-}
textInputSelectableMode :: Int -> Bool
textInputSelectableMode :: Int -> Bool
textInputSelectableMode Int
si = Int
si Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
textInputFlagSelectable Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0

-- | Marks a @NodeTextInput@ as a password field: its value is displayed masked
-- and is never copied or cut to the clipboard.
textInputFlagPassword :: Int
textInputFlagPassword :: Int
textInputFlagPassword = Int
0x20000000

{-# INLINE textInputPasswordMode #-}
textInputPasswordMode :: Int -> Bool
textInputPasswordMode :: Int -> Bool
textInputPasswordMode Int
si = Int
si Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
textInputFlagPassword Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0

-- | Marks a @NodeTextInput@ as a numeric field: a caption-less box whose text
-- stops short of an up / down stepper at its right edge.
textInputFlagNumeric :: Int
textInputFlagNumeric :: Int
textInputFlagNumeric = Int
0x40000000

{-# INLINE textInputNumericMode #-}
textInputNumericMode :: Int -> Bool
textInputNumericMode :: Int -> Bool
textInputNumericMode Int
si = Int
si Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
textInputFlagNumeric Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0

-- | Width of a numeric field's stepper column.
numericStepperW :: Float
numericStepperW :: Float
numericStepperW = Float
18

-- | Region a numeric field's text may occupy: inside the content inset, left
-- of the stepper.
numericTextClip :: FontMetrics -> Float -> Float -> Float -> Float -> Rect
numericTextClip :: FontMetrics -> Float -> Float -> Float -> Float -> Rect
numericTextClip FontMetrics
fm Float
x Float
y Float
w Float
h =
  let (Float
ix, Float
iy) = FontMetrics -> (Float, Float)
widgetContentInset FontMetrics
fm
   in Float -> Float -> Float -> Float -> Rect
Rect (Float
x Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
ix) (Float
y Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
iy) (Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
0 (Float
w Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
2 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
ix Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
numericStepperW)) (Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
0 (Float
h Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
2 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
iy))

-- | The up and down halves of a numeric field's stepper.
numericStepperRects :: Float -> Float -> Float -> Float -> (Rect, Rect)
numericStepperRects :: Float -> Float -> Float -> Float -> (Rect, Rect)
numericStepperRects Float
x Float
y Float
w Float
h =
  let sx :: Float
sx = Float
x Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
w Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
numericStepperW
      half :: Float
half = Float
h Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
2
   in (Float -> Float -> Float -> Float -> Rect
Rect Float
sx Float
y Float
numericStepperW Float
half, Float -> Float -> Float -> Float -> Rect
Rect Float
sx (Float
y Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
half) Float
numericStepperW (Float
h Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
half))

-- | Region a combo box's editable text may occupy: from the left content inset
-- to the select chevron reserve on the right.
comboTextClip :: FontMetrics -> Float -> Float -> Float -> Float -> Rect
comboTextClip :: FontMetrics -> Float -> Float -> Float -> Float -> Rect
comboTextClip FontMetrics
fm Float
x Float
y Float
w Float
h =
  let (Float
ix, Float
iy) = FontMetrics -> (Float, Float)
widgetContentInset FontMetrics
fm
   in Float -> Float -> Float -> Float -> Rect
Rect (Float
x Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
ix) (Float
y Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
iy) (Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
0 (Float
w Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
ix Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
selectChevronReserve)) (Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
0 (Float
h Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
2 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
iy))

selectDisplayText :: Text -> Text -> Text
selectDisplayText :: Text -> Text -> Text
selectDisplayText Text
lbl Text
opt
  | Text -> Bool
T.null Text
lbl = Text
opt
  | Bool
otherwise = Text
lbl Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
": " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
opt

-- Space reserved on the right of a select for the chevron.
selectChevronReserve :: Float
selectChevronReserve :: Float
selectChevronReserve = Float
16

selectChevronCenterX :: Float -> Float -> Float
selectChevronCenterX :: Float -> Float -> Float
selectChevronCenterX Float
x Float
w = Float
x Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
w Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
selectChevronReserve Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
2

colorPickerGap :: Float
colorPickerGap :: Float
colorPickerGap = Float
4

-- Height of a colour picker's field row; the field grows to a square this tall.
colorPickerSvH :: Float
colorPickerSvH :: Float
colorPickerSvH = Float
250

colorPickerCurrentLabel :: Text
colorPickerCurrentLabel :: Text
colorPickerCurrentLabel = Text
"Current"

colorPickerNewLabel :: Text
colorPickerNewLabel :: Text
colorPickerNewLabel = Text
"New"

colorToHex :: Color -> Text
colorToHex :: Color -> Text
colorToHex Color
c =
  Text
"#" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word8 -> Text
hexByte (Color -> Word8
colorR Color
c) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word8 -> Text
hexByte (Color -> Word8
colorG Color
c) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word8 -> Text
hexByte (Color -> Word8
colorB Color
c)

-- | Eight-digit form for the alpha-aware picker: @#RRGGBBAA@.
colorToHexA :: Color -> Text
colorToHexA :: Color -> Text
colorToHexA Color
c = Color -> Text
colorToHex Color
c Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Word8 -> Text
hexByte (Color -> Word8
colorA Color
c)

hexByte :: Word8 -> Text
hexByte :: Word8 -> Text
hexByte Word8
n = SmallArray Text -> Int -> Text
forall a. SmallArray a -> Int -> a
indexSmallArray SmallArray Text
hexBytes (Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
n)

-- Each byte's two-character representation is allocated once, shared by
-- color-picker labels instead of formatting fresh Strings every frame.
hexBytes :: SmallArray Text
hexBytes :: SmallArray Text
hexBytes =
  [Text] -> SmallArray Text
forall a. [a] -> SmallArray a
smallArrayFromList
    [Int -> Char -> Text -> Text
T.justifyRight Int
2 Char
'0' (String -> Text
T.pack (Int -> ShowS
forall a. Integral a => a -> ShowS
showHex Int
n String
"")) | Int
n <- [Int
0 .. Int
255 :: Int]]

-- | Parse a hex colour, accepting an optional leading @#@ and either 6 or 8
-- digits. The fourth component is 'Nothing' for the six-digit form.
colorPickerParseHex :: Text -> Maybe (Word8, Word8, Word8, Maybe Word8)
colorPickerParseHex :: Text -> Maybe (Word8, Word8, Word8, Maybe Word8)
colorPickerParseHex Text
txt =
  let bare :: Text
bare = (Char -> Bool) -> Text -> Text
T.dropWhile (Char -> Char -> Bool
forall a. Eq a => a -> a -> Bool
== Char
'#') (Text -> Text
T.strip Text
txt)
      pair :: Int -> Maybe Word8
pair Int
i = Text -> Maybe Word8
parseHexPair (Int -> Text -> Text
T.take Int
2 (Int -> Text -> Text
T.drop Int
i Text
bare))
      n :: Int
n = Text -> Int
T.length Text
bare
   in if Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
6 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
8
        then Maybe (Word8, Word8, Word8, Maybe Word8)
forall a. Maybe a
Nothing
        else do
          r <- Int -> Maybe Word8
pair Int
0
          g <- pair 2
          b <- pair 4
          a <- if n == 8 then Just <$> pair 6 else pure Nothing
          pure (r, g, b, a)

colorFromHex :: Text -> Maybe Color
colorFromHex :: Text -> Maybe Color
colorFromHex Text
txt = do
  (r, g, b, ma) <- Text -> Maybe (Word8, Word8, Word8, Maybe Word8)
colorPickerParseHex Text
txt
  pure (colorRGBA r g b (fromMaybe 255 ma))

parseHexPair :: Text -> Maybe Word8
parseHexPair :: Text -> Maybe Word8
parseHexPair Text
t = case Text -> String
T.unpack Text
t of
  [Char
hi, Char
lo]
    | Char -> Bool
isHexDigit Char
hi Bool -> Bool -> Bool
&& Char -> Bool
isHexDigit Char
lo -> Word8 -> Maybe Word8
forall a. a -> Maybe a
Just (Int -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Char -> Int
digitToInt Char
hi Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
16 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Char -> Int
digitToInt Char
lo))
  String
_ -> Maybe Word8
forall a. Maybe a
Nothing

tableStripeEven :: Int
tableStripeEven :: Int
tableStripeEven = Int
1

tableStripeOdd :: Int
tableStripeOdd :: Int
tableStripeOdd = Int
2

{-# INLINE packTextNodeStyleFull #-}
packTextNodeStyleFull :: FontVariant -> FontWeight -> FontStyle -> TextDecoration -> Int -> Int
packTextNodeStyleFull :: FontVariant
-> FontWeight -> FontStyle -> TextDecoration -> Int -> Int
packTextNodeStyleFull FontVariant
fvar FontWeight
weight FontStyle
fstyle TextDecoration
deco Int
stripe =
  (Int
stripe Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
4)
    Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. (FontVariant -> Int
forall a. Enum a => a -> Int
fromEnum FontVariant
fvar Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x0F)
    Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. ((FontWeight -> Int
forall a. Enum a => a -> Int
fromEnum FontWeight
weight Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x0F) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
8)
    Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. ((FontStyle -> Int
forall a. Enum a => a -> Int
fromEnum FontStyle
fstyle Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x03) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
12)
    Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. ((TextDecoration -> Int
forall a. Enum a => a -> Int
fromEnum TextDecoration
deco Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x03) Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftL` Int
14)

-- | The enum packed in the style bits at @shift@ under @mask@, or @fallback@
-- when they hold no constructor.
{-# INLINE decodeStyleEnum #-}
decodeStyleEnum :: forall a. (Bounded a, Enum a) => Int -> Int -> a -> Int -> a
decodeStyleEnum :: forall a. (Bounded a, Enum a) => Int -> Int -> a -> Int -> a
decodeStyleEnum Int
shift Int
mask a
fallback Int
si =
  let v :: Int
v = (Int
si Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
shift) Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
mask
   in if Int
v Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= a -> Int
forall a. Enum a => a -> Int
fromEnum (a
forall a. Bounded a => a
minBound :: a) Bool -> Bool -> Bool
&& Int
v Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= a -> Int
forall a. Enum a => a -> Int
fromEnum (a
forall a. Bounded a => a
maxBound :: a) then Int -> a
forall a. Enum a => Int -> a
toEnum Int
v else a
fallback

{-# INLINE textNodeFontVariant #-}
textNodeFontVariant :: Int -> FontVariant
textNodeFontVariant :: Int -> FontVariant
textNodeFontVariant = Int -> Int -> FontVariant -> Int -> FontVariant
forall a. (Bounded a, Enum a) => Int -> Int -> a -> Int -> a
decodeStyleEnum Int
0 Int
0x0F FontVariant
FontRegular

{-# INLINE textNodeFontWeight #-}
textNodeFontWeight :: Int -> FontWeight
textNodeFontWeight :: Int -> FontWeight
textNodeFontWeight = Int -> Int -> FontWeight -> Int -> FontWeight
forall a. (Bounded a, Enum a) => Int -> Int -> a -> Int -> a
decodeStyleEnum Int
8 Int
0x0F FontWeight
WeightNormal

{-# INLINE textNodeFontStyle #-}
textNodeFontStyle :: Int -> FontStyle
textNodeFontStyle :: Int -> FontStyle
textNodeFontStyle = Int -> Int -> FontStyle -> Int -> FontStyle
forall a. (Bounded a, Enum a) => Int -> Int -> a -> Int -> a
decodeStyleEnum Int
12 Int
0x03 FontStyle
FontStyleNormal

{-# INLINE textNodeTextDecoration #-}
textNodeTextDecoration :: Int -> TextDecoration
textNodeTextDecoration :: Int -> TextDecoration
textNodeTextDecoration = Int -> Int -> TextDecoration -> Int -> TextDecoration
forall a. (Bounded a, Enum a) => Int -> Int -> a -> Int -> a
decodeStyleEnum Int
14 Int
0x03 TextDecoration
DecorationNone

{-# INLINE textNodeStripe #-}
textNodeStripe :: Int -> Int
textNodeStripe :: Int -> Int
textNodeStripe Int
si = (Int
si Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
4) Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x0F

{-# INLINE stripeColor #-}
stripeColor :: Theme -> Int -> Maybe Color
stripeColor :: Theme -> Int -> Maybe Color
stripeColor Theme
theme Int
s
  | Int
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
tableStripeEven = Color -> Maybe Color
forall a. a -> Maybe a
Just (Color -> Color -> Float -> Color
lerpColor (Style -> Color
styleBg (Theme -> Style
themePanel Theme
theme)) (Theme -> Color
themeWindow Theme
theme) Float
0.26)
  | Int
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
tableStripeOdd = Color -> Maybe Color
forall a. a -> Maybe a
Just (Color -> Color -> Float -> Color
lerpColor (Style -> Color
styleBg (Theme -> Style
themePanel Theme
theme)) (Style -> Color
styleBg (Theme -> Style
themeButton Theme
theme)) Float
0.55)
  | Bool
otherwise = Maybe Color
forall a. Maybe a
Nothing

tableStripeColor :: Theme -> Int -> Maybe Color
tableStripeColor :: Theme -> Int -> Maybe Color
tableStripeColor Theme
theme Int
si = Theme -> Int -> Maybe Color
stripeColor Theme
theme (Int -> Int
textNodeStripe Int
si)

-- | Trailing slot reserved in every header so the sort mark never changes column width.
tableSortReserve :: Text
tableSortReserve :: Text
tableSortReserve = Text
"  ▲"

tableHeaderLabel :: Text -> Text
tableHeaderLabel :: Text -> Text
tableHeaderLabel Text
hdr = Text
hdr Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
tableSortReserve

-- | Sort direction encoded for a table-header style. Lives in bits 16-17: the
-- low nibbles are the font fields, and a mark value of 1 or 2 in bit 0-1 used
-- to flip the header's font variant (heading / muted), which blanked the
-- arrow glyph.
tableSortMarkOf :: Int -> Int
tableSortMarkOf :: Int -> Int
tableSortMarkOf Int
styleIdx = (Int
styleIdx Int -> Int -> Int
forall a. Bits a => a -> Int -> a
`shiftR` Int
16) Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
0x03

-- | Blank reserve slot (spaces only). The sort mark is drawn as a triangle
-- over this slot, so the ▲/▼ codepoint never enters measured or laid-out text
-- (the pruned UI font does not carry it).
tableSortBlank :: Text
tableSortBlank :: Text
tableSortBlank = (Char -> Char) -> Text -> Text
T.map (Char -> Char -> Char
forall a b. a -> b -> a
const Char
' ') Text
tableSortReserve

tableHeaderDisplayText :: Text -> Text
tableHeaderDisplayText :: Text -> Text
tableHeaderDisplayText Text
txt =
  Text -> Maybe Text -> Text
forall a. a -> Maybe a -> a
fromMaybe Text
txt (Text -> Text -> Maybe Text
T.stripSuffix Text
tableSortReserve Text
txt) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
tableSortBlank

-- Type flags live in bits 28-31 so visual style and tab index stay in the low bits.
buttonFlagClose :: Int
buttonFlagClose :: Int
buttonFlagClose = Int
0x20000000

-- | Visual style of a title-bar close button: its cross sits against the
-- box's right edge, so it lines up with the panel padding the way the title
-- does on the left.
buttonCloseTrailing :: Int
buttonCloseTrailing :: Int
buttonCloseTrailing = Int
1

buttonFlagTab :: Int
buttonFlagTab :: Int
buttonFlagTab = Int
0x40000000

buttonFlagTable :: Int
buttonFlagTable :: Int
buttonFlagTable = Int
0x80000000

-- Flat menu row / menu-bar entry: transparent at rest, hover highlight, and an
-- accent marker on hover. Rendered by 'menuItemVisualStyle'.
buttonFlagMenu :: Int
buttonFlagMenu :: Int
buttonFlagMenu = Int
0x10000000

-- Flat menu-bar title: same flat/hover/open fill as a menu row, but centered
-- text and no hover accent marker (that marker belongs to drop-down rows).
buttonFlagMenuBar :: Int
buttonFlagMenuBar :: Int
buttonFlagMenuBar = Int
0x08000000

buttonFlagMask :: Int
buttonFlagMask :: Int
buttonFlagMask = Int
buttonFlagClose Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
buttonFlagTab Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
buttonFlagTable Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
buttonFlagMenu Int -> Int -> Int
forall a. Bits a => a -> a -> a
.|. Int
buttonFlagMenuBar

{-# INLINE buttonVisualStyle #-}
buttonVisualStyle :: Int -> Int
buttonVisualStyle :: Int -> Int
buttonVisualStyle Int
si = Int
si Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int -> Int
forall a. Bits a => a -> a
complement Int
buttonFlagMask

{-# INLINE buttonFlagsFromStyle #-}
buttonFlagsFromStyle :: Int -> (Bool, Bool, Bool)
buttonFlagsFromStyle :: Int -> (Bool, Bool, Bool)
buttonFlagsFromStyle Int
si =
  ( Int
si Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
buttonFlagClose Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0
  , Int
si Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
buttonFlagTab Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0
  , Int
si Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
buttonFlagTable Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0
  )

{-# INLINE isCloseButtonStyle #-}
isCloseButtonStyle :: Int -> Bool
isCloseButtonStyle :: Int -> Bool
isCloseButtonStyle Int
si = Int
si Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
buttonFlagClose Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0

{-# INLINE isTabButtonStyle #-}
isTabButtonStyle :: Int -> Bool
isTabButtonStyle :: Int -> Bool
isTabButtonStyle Int
si = Int
si Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
buttonFlagTab Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0

{-# INLINE isTableHeaderStyle #-}
isTableHeaderStyle :: Int -> Bool
isTableHeaderStyle :: Int -> Bool
isTableHeaderStyle Int
si = Int
si Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
buttonFlagTable Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0

{-# INLINE isMenuItemStyle #-}
isMenuItemStyle :: Int -> Bool
isMenuItemStyle :: Int -> Bool
isMenuItemStyle Int
si = Int
si Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
buttonFlagMenu Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0

{-# INLINE isMenuBarStyle #-}
isMenuBarStyle :: Int -> Bool
isMenuBarStyle :: Int -> Bool
isMenuBarStyle Int
si = Int
si Int -> Int -> Int
forall a. Bits a => a -> a -> a
.&. Int
buttonFlagMenuBar Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0