module NanoUI.Types
  ( V2 (..)
  , Rect (..)
  , Size (..)
  , Color (..)
  , colorRGBA
  , colorToWord32
  , colorR
  , colorG
  , colorB
  , colorA
  , colorFromWord32
  , rgbToHsv
  , hsvToRgb
  , clamp
  , clamp01
  , onGrid
  , roundHalfUp
  , lerpColor
  , colorLuminance
  , contrastRatio
  , ImageId (..)
  , rectContains
  , rectNonEmpty
  , rectHit
  , rectUnion
  , rectIntersect
  , rectFullyInside
  , rectOverlapArea
  , rectInflate
  , rectArea
  , Damage (..)
  , DamageBounds (..)
  , defaultDamageSlop
  , sliderDamageSlop
  , haloDamageSlop
  , resolveDamageRect
  , damageIsEmpty
  , v2Add
  , v2Sub
  , PopupAnchor (..)
  , PopupPlacement (..)
  ) where

import Data.Bits (shiftL, shiftR, (.&.), (.|.))
import Data.Word (Word8, Word32)

data V2 = V2
  { V2 -> Float
v2X :: {-# UNPACK #-} !Float
  , V2 -> Float
v2Y :: {-# UNPACK #-} !Float
  }
  deriving (V2 -> V2 -> Bool
(V2 -> V2 -> Bool) -> (V2 -> V2 -> Bool) -> Eq V2
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: V2 -> V2 -> Bool
== :: V2 -> V2 -> Bool
$c/= :: V2 -> V2 -> Bool
/= :: V2 -> V2 -> Bool
Eq, Int -> V2 -> ShowS
[V2] -> ShowS
V2 -> String
(Int -> V2 -> ShowS)
-> (V2 -> String) -> ([V2] -> ShowS) -> Show V2
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> V2 -> ShowS
showsPrec :: Int -> V2 -> ShowS
$cshow :: V2 -> String
show :: V2 -> String
$cshowList :: [V2] -> ShowS
showList :: [V2] -> ShowS
Show)

data Size = Size
  { Size -> Float
sizeW :: {-# UNPACK #-} !Float
  , Size -> Float
sizeH :: {-# UNPACK #-} !Float
  }
  deriving (Size -> Size -> Bool
(Size -> Size -> Bool) -> (Size -> Size -> Bool) -> Eq Size
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Size -> Size -> Bool
== :: Size -> Size -> Bool
$c/= :: Size -> Size -> Bool
/= :: Size -> Size -> Bool
Eq, Int -> Size -> ShowS
[Size] -> ShowS
Size -> String
(Int -> Size -> ShowS)
-> (Size -> String) -> ([Size] -> ShowS) -> Show Size
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Size -> ShowS
showsPrec :: Int -> Size -> ShowS
$cshow :: Size -> String
show :: Size -> String
$cshowList :: [Size] -> ShowS
showList :: [Size] -> ShowS
Show)

data Rect = Rect
  { Rect -> Float
rectX :: {-# UNPACK #-} !Float
  , Rect -> Float
rectY :: {-# UNPACK #-} !Float
  , Rect -> Float
rectW :: {-# UNPACK #-} !Float
  , Rect -> Float
rectH :: {-# UNPACK #-} !Float
  }
  deriving (Rect -> Rect -> Bool
(Rect -> Rect -> Bool) -> (Rect -> Rect -> Bool) -> Eq Rect
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Rect -> Rect -> Bool
== :: Rect -> Rect -> Bool
$c/= :: Rect -> Rect -> Bool
/= :: Rect -> Rect -> Bool
Eq, Int -> Rect -> ShowS
[Rect] -> ShowS
Rect -> String
(Int -> Rect -> ShowS)
-> (Rect -> String) -> ([Rect] -> ShowS) -> Show Rect
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Rect -> ShowS
showsPrec :: Int -> Rect -> ShowS
$cshow :: Rect -> String
show :: Rect -> String
$cshowList :: [Rect] -> ShowS
showList :: [Rect] -> ShowS
Show)

newtype ImageId = ImageId
  { ImageId -> Int
unImageId :: Int
  }
  deriving (ImageId -> ImageId -> Bool
(ImageId -> ImageId -> Bool)
-> (ImageId -> ImageId -> Bool) -> Eq ImageId
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ImageId -> ImageId -> Bool
== :: ImageId -> ImageId -> Bool
$c/= :: ImageId -> ImageId -> Bool
/= :: ImageId -> ImageId -> Bool
Eq, Eq ImageId
Eq ImageId =>
(ImageId -> ImageId -> Ordering)
-> (ImageId -> ImageId -> Bool)
-> (ImageId -> ImageId -> Bool)
-> (ImageId -> ImageId -> Bool)
-> (ImageId -> ImageId -> Bool)
-> (ImageId -> ImageId -> ImageId)
-> (ImageId -> ImageId -> ImageId)
-> Ord ImageId
ImageId -> ImageId -> Bool
ImageId -> ImageId -> Ordering
ImageId -> ImageId -> ImageId
forall a.
Eq a =>
(a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
$ccompare :: ImageId -> ImageId -> Ordering
compare :: ImageId -> ImageId -> Ordering
$c< :: ImageId -> ImageId -> Bool
< :: ImageId -> ImageId -> Bool
$c<= :: ImageId -> ImageId -> Bool
<= :: ImageId -> ImageId -> Bool
$c> :: ImageId -> ImageId -> Bool
> :: ImageId -> ImageId -> Bool
$c>= :: ImageId -> ImageId -> Bool
>= :: ImageId -> ImageId -> Bool
$cmax :: ImageId -> ImageId -> ImageId
max :: ImageId -> ImageId -> ImageId
$cmin :: ImageId -> ImageId -> ImageId
min :: ImageId -> ImageId -> ImageId
Ord, Int -> ImageId -> ShowS
[ImageId] -> ShowS
ImageId -> String
(Int -> ImageId -> ShowS)
-> (ImageId -> String) -> ([ImageId] -> ShowS) -> Show ImageId
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ImageId -> ShowS
showsPrec :: Int -> ImageId -> ShowS
$cshow :: ImageId -> String
show :: ImageId -> String
$cshowList :: [ImageId] -> ShowS
showList :: [ImageId] -> ShowS
Show)

newtype Color = Color Word32
  deriving (Color -> Color -> Bool
(Color -> Color -> Bool) -> (Color -> Color -> Bool) -> Eq Color
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Color -> Color -> Bool
== :: Color -> Color -> Bool
$c/= :: Color -> Color -> Bool
/= :: Color -> Color -> Bool
Eq, Int -> Color -> ShowS
[Color] -> ShowS
Color -> String
(Int -> Color -> ShowS)
-> (Color -> String) -> ([Color] -> ShowS) -> Show Color
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Color -> ShowS
showsPrec :: Int -> Color -> ShowS
$cshow :: Color -> String
show :: Color -> String
$cshowList :: [Color] -> ShowS
showList :: [Color] -> ShowS
Show, Integer -> Color
Color -> Color
Color -> Color -> Color
(Color -> Color -> Color)
-> (Color -> Color -> Color)
-> (Color -> Color -> Color)
-> (Color -> Color)
-> (Color -> Color)
-> (Color -> Color)
-> (Integer -> Color)
-> Num Color
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
$c+ :: Color -> Color -> Color
+ :: Color -> Color -> Color
$c- :: Color -> Color -> Color
- :: Color -> Color -> Color
$c* :: Color -> Color -> Color
* :: Color -> Color -> Color
$cnegate :: Color -> Color
negate :: Color -> Color
$cabs :: Color -> Color
abs :: Color -> Color
$csignum :: Color -> Color
signum :: Color -> Color
$cfromInteger :: Integer -> Color
fromInteger :: Integer -> Color
Num)

{-# INLINE colorRGBA #-}
colorRGBA :: Word8 -> Word8 -> Word8 -> Word8 -> Color
colorRGBA :: Word8 -> Word8 -> Word8 -> Word8 -> Color
colorRGBA Word8
r Word8
g Word8
b Word8
a =
  Word32 -> Color
Color (Word32 -> Color) -> Word32 -> Color
forall a b. (a -> b) -> a -> b
$
    (Word8 -> Word32
word32Of Word8
r Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
24)
      Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word32
word32Of Word8
g Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
16)
      Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. (Word8 -> Word32
word32Of Word8
b Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
8)
      Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Word8 -> Word32
word32Of Word8
a

{-# INLINE colorToWord32 #-}
colorToWord32 :: Color -> Word32
colorToWord32 :: Color -> Word32
colorToWord32 (Color Word32
w) = Word32
w

{-# INLINE colorR #-}
colorR :: Color -> Word8
colorR :: Color -> Word8
colorR (Color Word32
w) = Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word32
w Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
24) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0xFF)

{-# INLINE colorG #-}
colorG :: Color -> Word8
colorG :: Color -> Word8
colorG (Color Word32
w) = Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word32
w Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
16) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0xFF)

{-# INLINE colorB #-}
colorB :: Color -> Word8
colorB :: Color -> Word8
colorB (Color Word32
w) = Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word32
w Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
8) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0xFF)

{-# INLINE colorA #-}
colorA :: Color -> Word8
colorA :: Color -> Word8
colorA (Color Word32
w) = Word32 -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32
w Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0xFF)

{-# INLINE colorFromWord32 #-}
colorFromWord32 :: Word32 -> Color
colorFromWord32 :: Word32 -> Color
colorFromWord32 = Word32 -> Color
Color

{-# INLINE clamp #-}
clamp :: Ord a => a -> a -> a -> a
clamp :: forall a. Ord a => a -> a -> a -> a
clamp a
lo a
hi a
x = a -> a -> a
forall a. Ord a => a -> a -> a
max a
lo (a -> a -> a
forall a. Ord a => a -> a -> a
min a
hi a
x)

{-# INLINE clamp01 #-}
clamp01 :: Float -> Float
clamp01 :: Float -> Float
clamp01 Float
x = Float -> Float -> Float -> Float
forall a. Ord a => a -> a -> a -> a
clamp Float
0 Float
1 Float
x

-- | Round a logical coordinate onto the device-pixel grid implied by draw
-- scale @s@ (device px = logical * s). Every layer that positions pixels --
-- the layout solve, text pens, scroll offsets, paint and glyph rasterization --
-- must route its coordinates through this single function (backends through
-- 'roundHalfUp'), so geometry can never dephase from text. An identity when
-- @s <= 0@ (no scaling).
{-# INLINE onGrid #-}
onGrid :: Float -> Float -> Float
onGrid :: Float -> Float -> Float
onGrid Float
s Float
v
  | Float
s Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
0 = Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Float -> Int
roundHalfUp (Float
v Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
s)) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
s
  | Bool
otherwise = Float
v

-- | Round to the nearest integer, ties up: the device-pixel rounding shared by
-- 'onGrid' and the backends. Not ties-to-even (@round@): at a fractional scale
-- (125%: a 20px row is 25 device px) a column of rows can all sit on half
-- pixels, and ties-to-even would alternate them down and up, leaving uneven
-- gaps. Compares the exact fractional part rather than @floor (r + 0.5)@,
-- whose addition itself rounds: it lifts the float just below 0.5 to 1 and
-- odd integers past 2^23 up by one.
{-# INLINE roundHalfUp #-}
roundHalfUp :: Float -> Int
roundHalfUp :: Float -> Int
roundHalfUp Float
r =
  let f :: Int
f = Float -> Int
forall b. Integral b => Float -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor Float
r
   in if Float
r Float -> Float -> Float
forall a. Num a => a -> a -> a
- Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
f Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
>= Float
0.5 then Int
f Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 else Int
f

rgbToHsv :: Color -> (Float, Float, Float)
rgbToHsv :: Color -> (Float, Float, Float)
rgbToHsv Color
c =
  let r :: Float
r = Word8 -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Color -> Word8
colorR Color
c) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
255
      g :: Float
g = Word8 -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Color -> Word8
colorG Color
c) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
255
      b :: Float
b = Word8 -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Color -> Word8
colorB Color
c) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
255
      maxC :: Float
maxC = Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
r (Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
g Float
b)
      minC :: Float
minC = Float -> Float -> Float
forall a. Ord a => a -> a -> a
min Float
r (Float -> Float -> Float
forall a. Ord a => a -> a -> a
min Float
g Float
b)
      delta :: Float
delta = Float
maxC Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
minC
      v :: Float
v = Float
maxC
      s :: Float
s = if Float
maxC Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Float
0 then Float
0 else Float
delta Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
maxC
      rawH :: Float
rawH
        | Float
delta Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Float
0 = Float
0
        | Float
maxC Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
r =
            let t :: Float
t = (Float
g Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
b) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
delta
             in if Float
t Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
0 then Float
60 Float -> Float -> Float
forall a. Num a => a -> a -> a
* (Float
t Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
6) else Float
60 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
t
        | Float
maxC Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
g = Float
60 Float -> Float -> Float
forall a. Num a => a -> a -> a
* (((Float
b Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
r) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
delta) Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
2)
        | Bool
otherwise = Float
60 Float -> Float -> Float
forall a. Num a => a -> a -> a
* (((Float
r Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
g) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
delta) Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
4)
      h :: Float
h = if Float
rawH Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
0 then Float
rawH Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
360 else Float
rawH
   in (Float
h, Float
s, Float
v)

hsvToRgb :: Float -> Float -> Float -> Color
hsvToRgb :: Float -> Float -> Float -> Color
hsvToRgb Float
h Float
s Float
v =
  let hi :: Int
hi = Float -> Int
forall b. Integral b => Float -> b
forall a b. (RealFrac a, Integral b) => a -> b
floor (Float
h Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
60) :: Int
      f :: Float
f = Float
h Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
60 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Int -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
hi
      p :: Float
p = Float
v Float -> Float -> Float
forall a. Num a => a -> a -> a
* (Float
1 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
s)
      q :: Float
q = Float
v Float -> Float -> Float
forall a. Num a => a -> a -> a
* (Float
1 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
f Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
s)
      t :: Float
t = Float
v Float -> Float -> Float
forall a. Num a => a -> a -> a
* (Float
1 Float -> Float -> Float
forall a. Num a => a -> a -> a
- (Float
1 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
f) Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
s)
      (Float
r, Float
g, Float
b) =
        case Int
hi Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
6 of
          Int
0 -> (Float
v, Float
t, Float
p)
          Int
1 -> (Float
q, Float
v, Float
p)
          Int
2 -> (Float
p, Float
v, Float
t)
          Int
3 -> (Float
p, Float
q, Float
v)
          Int
4 -> (Float
t, Float
p, Float
v)
          Int
_ -> (Float
v, Float
p, Float
q)
      toCh :: Float -> Word8
toCh Float
x = Float -> Word8
forall b. Integral b => Float -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Float -> Float
clamp01 Float
x Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
255) :: Word8
   in Word8 -> Word8 -> Word8 -> Word8 -> Color
colorRGBA (Float -> Word8
toCh Float
r) (Float -> Word8
toCh Float
g) (Float -> Word8
toCh Float
b) Word8
255

-- | WCAG 2 relative-luminance contrast. 4.5 is AA for normal text.
--
-- Alpha is ignored, so both colours must be opaque. Passing a translucent
-- colour such as 'NanoUI.Style.themeOverlayDim' gives a meaningless ratio;
-- composite it over its backdrop first.
contrastRatio :: Color -> Color -> Double
contrastRatio :: Color -> Color -> Double
contrastRatio Color
a Color
b =
  let hi :: Double
hi = Double -> Double -> Double
forall a. Ord a => a -> a -> a
max (Color -> Double
colorLuminance Color
a) (Color -> Double
colorLuminance Color
b)
      lo :: Double
lo = Double -> Double -> Double
forall a. Ord a => a -> a -> a
min (Color -> Double
colorLuminance Color
a) (Color -> Double
colorLuminance Color
b)
   in (Double
hi Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
0.05) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ (Double
lo Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
0.05)

colorLuminance :: Color -> Double
colorLuminance :: Color -> Double
colorLuminance Color
c =
  Double
0.2126 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Word8 -> Double
srgb (Color -> Word8
colorR Color
c) Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
0.7152 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Word8 -> Double
srgb (Color -> Word8
colorG Color
c) Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
0.0722 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Word8 -> Double
srgb (Color -> Word8
colorB Color
c)

lerpColor :: Color -> Color -> Float -> Color
lerpColor :: Color -> Color -> Float -> Color
lerpColor (Color Word32
a) (Color Word32
b) Float
t =
  let u :: Float
u = Float -> Float
clamp01 Float
t
      ch :: Int -> Word32
ch Int
shift =
        Float -> Word32
forall b. Integral b => Float -> b
forall a b. (RealFrac a, Integral b) => a -> b
round (Float -> Word32) -> Float -> Word32
forall a b. (a -> b) -> a -> b
$
          Word32 -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word32
a Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
shift) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0xFF) Float -> Float -> Float
forall a. Num a => a -> a -> a
* (Float
1 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
u)
            Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Word32 -> Float
forall a b. (Integral a, Num b) => a -> b
fromIntegral ((Word32
b Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftR` Int
shift) Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.&. Word32
0xFF) Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
u
   in Word32 -> Color
Color
        ( (Int -> Word32
ch Int
24 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
24)
            Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. (Int -> Word32
ch Int
16 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
16)
            Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. (Int -> Word32
ch Int
8 Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`shiftL` Int
8)
            Word32 -> Word32 -> Word32
forall a. Bits a => a -> a -> a
.|. Int -> Word32
ch Int
0
        )

srgb :: Word8 -> Double
srgb :: Word8 -> Double
srgb Word8
ch =
  let x :: Double
x = Word8 -> Double
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
ch Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
255
   in if Double
x Double -> Double -> Bool
forall a. Ord a => a -> a -> Bool
<= Double
0.04045 then Double
x Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
12.92 else ((Double
x Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
0.055) Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1.055) Double -> Double -> Double
forall a. Floating a => a -> a -> a
** Double
2.4

{-# INLINE word32Of #-}
word32Of :: Word8 -> Word32
word32Of :: Word8 -> Word32
word32Of = Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral

{-# INLINE rectContains #-}
rectContains :: Rect -> V2 -> Bool
rectContains :: Rect -> V2 -> Bool
rectContains (Rect Float
x Float
y Float
w Float
h) (V2 Float
px Float
py) =
  Float
px Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
>= Float
x Bool -> Bool -> Bool
&& Float
px Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
x Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
w Bool -> Bool -> Bool
&& Float
py Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
>= Float
y Bool -> Bool -> Bool
&& Float
py Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
y Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
h

-- | A rect that has actually been laid out (nonzero extent).
{-# INLINE rectNonEmpty #-}
rectNonEmpty :: Rect -> Bool
rectNonEmpty :: Rect -> Bool
rectNonEmpty Rect
r = Rect -> Float
rectW Rect
r Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
0 Bool -> Bool -> Bool
&& Rect -> Float
rectH Rect
r Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
0

-- | Hit test that ignores rects that have not been laid out yet.
{-# INLINE rectHit #-}
rectHit :: Rect -> V2 -> Bool
rectHit :: Rect -> V2 -> Bool
rectHit Rect
r V2
p = Rect -> Bool
rectNonEmpty Rect
r Bool -> Bool -> Bool
&& Rect -> V2 -> Bool
rectContains Rect
r V2
p

{-# INLINE rectUnion #-}
rectUnion :: Rect -> Rect -> Rect
rectUnion :: Rect -> Rect -> Rect
rectUnion (Rect Float
x1 Float
y1 Float
w1 Float
h1) (Rect Float
x2 Float
y2 Float
w2 Float
h2) =
  let x :: Float
x = Float -> Float -> Float
forall a. Ord a => a -> a -> a
min Float
x1 Float
x2
      y :: Float
y = Float -> Float -> Float
forall a. Ord a => a -> a -> a
min Float
y1 Float
y2
      xEnd :: Float
xEnd = Float -> Float -> Float
forall a. Ord a => a -> a -> a
max (Float
x1 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
w1) (Float
x2 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
w2)
      yEnd :: Float
yEnd = Float -> Float -> Float
forall a. Ord a => a -> a -> a
max (Float
y1 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
h1) (Float
y2 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
h2)
   in Float -> Float -> Float -> Float -> Rect
Rect Float
x Float
y (Float
xEnd Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
x) (Float
yEnd Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
y)

{-# INLINE rectIntersect #-}
rectIntersect :: Rect -> Rect -> Maybe Rect
rectIntersect :: Rect -> Rect -> Maybe Rect
rectIntersect (Rect Float
x1 Float
y1 Float
w1 Float
h1) (Rect Float
x2 Float
y2 Float
w2 Float
h2) =
  let x :: Float
x = Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
x1 Float
x2
      y :: Float
y = Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
y1 Float
y2
      xEnd :: Float
xEnd = Float -> Float -> Float
forall a. Ord a => a -> a -> a
min (Float
x1 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
w1) (Float
x2 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
w2)
      yEnd :: Float
yEnd = Float -> Float -> Float
forall a. Ord a => a -> a -> a
min (Float
y1 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
h1) (Float
y2 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
h2)
      w :: Float
w = Float
xEnd Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
x
      h :: Float
h = Float
yEnd Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
y
   in if Float
w Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
0 Bool -> Bool -> Bool
&& Float
h Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
0 then Rect -> Maybe Rect
forall a. a -> Maybe a
Just (Float -> Float -> Float -> Float -> Rect
Rect Float
x Float
y Float
w Float
h) else Maybe Rect
forall a. Maybe a
Nothing

{-# INLINE rectFullyInside #-}
rectFullyInside :: Rect -> Rect -> Bool
rectFullyInside :: Rect -> Rect -> Bool
rectFullyInside (Rect Float
ix Float
iy Float
iw Float
ih) (Rect Float
ox Float
oy Float
ow Float
oh) =
  Float
iw Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
0
    Bool -> Bool -> Bool
&& Float
ih Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
0
    Bool -> Bool -> Bool
&& Float
ix Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
>= Float
ox
    Bool -> Bool -> Bool
&& Float
iy Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
>= Float
oy
    Bool -> Bool -> Bool
&& Float
ix Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
iw Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Float
ox Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
ow
    Bool -> Bool -> Bool
&& Float
iy Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
ih Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Float
oy Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
oh

{-# INLINE rectOverlapArea #-}
rectOverlapArea :: Rect -> Rect -> Float
rectOverlapArea :: Rect -> Rect -> Float
rectOverlapArea Rect
a Rect
b =
  Float -> (Rect -> Float) -> Maybe Rect -> Float
forall b a. b -> (a -> b) -> Maybe a -> b
maybe Float
0 (\Rect
r -> Rect -> Float
rectW Rect
r Float -> Float -> Float
forall a. Num a => a -> a -> a
* Rect -> Float
rectH Rect
r) (Rect -> Rect -> Maybe Rect
rectIntersect Rect
a Rect
b)

{-# INLINE rectInflate #-}
rectInflate :: Float -> Rect -> Rect
rectInflate :: Float -> Rect -> Rect
rectInflate Float
pad (Rect Float
x Float
y Float
w Float
h) =
  Float -> Float -> Float -> Float -> Rect
Rect (Float
x Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
pad) (Float
y Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
pad) (Float
w Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
pad Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
2) (Float
h Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
pad Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
2)

{-# INLINE rectArea #-}
rectArea :: Rect -> Float
rectArea :: Rect -> Float
rectArea (Rect Float
_ Float
_ Float
w Float
h) = Float
w Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
h

-- Full window vs a scissor box around widgets that actually changed (hover, anim).
data Damage
  = DamageFull
  | DamageClip Rect
  deriving (Damage -> Damage -> Bool
(Damage -> Damage -> Bool)
-> (Damage -> Damage -> Bool) -> Eq Damage
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Damage -> Damage -> Bool
== :: Damage -> Damage -> Bool
$c/= :: Damage -> Damage -> Bool
/= :: Damage -> Damage -> Bool
Eq, Int -> Damage -> ShowS
[Damage] -> ShowS
Damage -> String
(Int -> Damage -> ShowS)
-> (Damage -> String) -> ([Damage] -> ShowS) -> Show Damage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Damage -> ShowS
showsPrec :: Int -> Damage -> ShowS
$cshow :: Damage -> String
show :: Damage -> String
$cshowList :: [Damage] -> ShowS
showList :: [Damage] -> ShowS
Show)

{-# INLINE damageIsEmpty #-}
damageIsEmpty :: Damage -> Bool
damageIsEmpty :: Damage -> Bool
damageIsEmpty Damage
dmg =
  case Damage
dmg of
    Damage
DamageFull -> Bool
False
    DamageClip Rect
r -> Rect -> Float
rectW Rect
r Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Float
0 Bool -> Bool -> Bool
|| Rect -> Float
rectH Rect
r Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Float
0

-- | Invalidation bounding strategy for a widget and its interaction events.
data DamageBounds
  = DamageSelf                              -- ^ Exact layout bounding box Rect
  | DamageInflated {-# UNPACK #-} !Float    -- ^ Layout bounding box inflated by margin (focus rings, shadows, text slop)
  | DamageExact !Rect                       -- ^ Explicit rectangle in window space
  | DamageCustom (Rect -> Rect)             -- ^ Custom transformation on layout bounding box
  | DamageUnion !DamageBounds !DamageBounds -- ^ Combined invalidation bounds
  | DamageNone                              -- ^ No invalidation bounds

instance Show DamageBounds where
  show :: DamageBounds -> String
show DamageBounds
DamageSelf = String
"DamageSelf"
  show (DamageInflated Float
f) = String
"DamageInflated " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Float -> String
forall a. Show a => a -> String
show Float
f
  show (DamageExact Rect
r) = String
"DamageExact " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Rect -> String
forall a. Show a => a -> String
show Rect
r
  show (DamageCustom Rect -> Rect
_) = String
"DamageCustom <fn>"
  show (DamageUnion DamageBounds
a DamageBounds
b) = String
"DamageUnion (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ DamageBounds -> String
forall a. Show a => a -> String
show DamageBounds
a String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
") (" String -> ShowS
forall a. [a] -> [a] -> [a]
++ DamageBounds -> String
forall a. Show a => a -> String
show DamageBounds
b String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
")"
  show DamageBounds
DamageNone = String
"DamageNone"

instance Eq DamageBounds where
  DamageBounds
DamageSelf == :: DamageBounds -> DamageBounds -> Bool
== DamageBounds
DamageSelf = Bool
True
  DamageInflated Float
a == DamageInflated Float
b = Float
a Float -> Float -> Bool
forall a. Eq a => a -> a -> Bool
== Float
b
  DamageExact Rect
a == DamageExact Rect
b = Rect
a Rect -> Rect -> Bool
forall a. Eq a => a -> a -> Bool
== Rect
b
  DamageUnion DamageBounds
a1 DamageBounds
b1 == DamageUnion DamageBounds
a2 DamageBounds
b2 = DamageBounds
a1 DamageBounds -> DamageBounds -> Bool
forall a. Eq a => a -> a -> Bool
== DamageBounds
a2 Bool -> Bool -> Bool
&& DamageBounds
b1 DamageBounds -> DamageBounds -> Bool
forall a. Eq a => a -> a -> Bool
== DamageBounds
b2
  DamageBounds
DamageNone == DamageBounds
DamageNone = Bool
True
  DamageBounds
_ == DamageBounds
_ = Bool
False

-- | Standard damage slop for text overhang, focus rings, and border anti-aliasing.
defaultDamageSlop :: Float
defaultDamageSlop :: Float
defaultDamageSlop = Float
4.0

-- | Damage slop for slider handles that extend past track bounds.
sliderDamageSlop :: Float
sliderDamageSlop :: Float
sliderDamageSlop = Float
8.0

-- | Damage slop for window resize halos and shadows.
haloDamageSlop :: Float
haloDamageSlop :: Float
haloDamageSlop = Float
12.0

-- | Resolve damage bounds against a given layout rect.
resolveDamageRect :: DamageBounds -> Rect -> Rect
resolveDamageRect :: DamageBounds -> Rect -> Rect
resolveDamageRect DamageBounds
bounds Rect
r =
  case DamageBounds
bounds of
    DamageBounds
DamageSelf -> Rect
r
    DamageInflated Float
pad -> Float -> Rect -> Rect
rectInflate Float
pad Rect
r
    DamageExact Rect
exactR -> Rect
exactR
    DamageCustom Rect -> Rect
f -> Rect -> Rect
f Rect
r
    DamageUnion DamageBounds
a DamageBounds
b ->
      -- An empty side (DamageNone, or an unlaid-out rect) contributes
      -- nothing; a plain rect union would stretch the damage to the origin.
      let ra :: Rect
ra = DamageBounds -> Rect -> Rect
resolveDamageRect DamageBounds
a Rect
r
          rb :: Rect
rb = DamageBounds -> Rect -> Rect
resolveDamageRect DamageBounds
b Rect
r
       in if Bool -> Bool
not (Rect -> Bool
rectNonEmpty Rect
ra)
            then Rect
rb
            else if Bool -> Bool
not (Rect -> Bool
rectNonEmpty Rect
rb) then Rect
ra else Rect -> Rect -> Rect
rectUnion Rect
ra Rect
rb
    DamageBounds
DamageNone -> Float -> Float -> Float -> Float -> Rect
Rect Float
0 Float
0 Float
0 Float
0

{-# INLINE v2Add #-}
v2Add :: V2 -> V2 -> V2
v2Add :: V2 -> V2 -> V2
v2Add (V2 Float
x1 Float
y1) (V2 Float
x2 Float
y2) = Float -> Float -> V2
V2 (Float
x1 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
x2) (Float
y1 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
y2)

{-# INLINE v2Sub #-}
v2Sub :: V2 -> V2 -> V2
v2Sub :: V2 -> V2 -> V2
v2Sub (V2 Float
x1 Float
y1) (V2 Float
x2 Float
y2) = Float -> Float -> V2
V2 (Float
x1 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
x2) (Float
y1 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
y2)

data PopupAnchor
  = AnchorPoint !V2
  | AnchorRect !Rect
  deriving (PopupAnchor -> PopupAnchor -> Bool
(PopupAnchor -> PopupAnchor -> Bool)
-> (PopupAnchor -> PopupAnchor -> Bool) -> Eq PopupAnchor
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PopupAnchor -> PopupAnchor -> Bool
== :: PopupAnchor -> PopupAnchor -> Bool
$c/= :: PopupAnchor -> PopupAnchor -> Bool
/= :: PopupAnchor -> PopupAnchor -> Bool
Eq, Int -> PopupAnchor -> ShowS
[PopupAnchor] -> ShowS
PopupAnchor -> String
(Int -> PopupAnchor -> ShowS)
-> (PopupAnchor -> String)
-> ([PopupAnchor] -> ShowS)
-> Show PopupAnchor
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PopupAnchor -> ShowS
showsPrec :: Int -> PopupAnchor -> ShowS
$cshow :: PopupAnchor -> String
show :: PopupAnchor -> String
$cshowList :: [PopupAnchor] -> ShowS
showList :: [PopupAnchor] -> ShowS
Show)

data PopupPlacement
  = PlacementBelow
  | PlacementAbove
  | PlacementRight
  | PlacementLeft
  | PlacementAtCursor
  | PlacementAuto
  deriving (PopupPlacement -> PopupPlacement -> Bool
(PopupPlacement -> PopupPlacement -> Bool)
-> (PopupPlacement -> PopupPlacement -> Bool) -> Eq PopupPlacement
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: PopupPlacement -> PopupPlacement -> Bool
== :: PopupPlacement -> PopupPlacement -> Bool
$c/= :: PopupPlacement -> PopupPlacement -> Bool
/= :: PopupPlacement -> PopupPlacement -> Bool
Eq, Int -> PopupPlacement -> ShowS
[PopupPlacement] -> ShowS
PopupPlacement -> String
(Int -> PopupPlacement -> ShowS)
-> (PopupPlacement -> String)
-> ([PopupPlacement] -> ShowS)
-> Show PopupPlacement
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> PopupPlacement -> ShowS
showsPrec :: Int -> PopupPlacement -> ShowS
$cshow :: PopupPlacement -> String
show :: PopupPlacement -> String
$cshowList :: [PopupPlacement] -> ShowS
showList :: [PopupPlacement] -> ShowS
Show)