{-# LANGUAGE StrictData #-}

-- | Solid geometry emitters: rects, gradients, images, rounded fills and
-- borders, coverage-AA strokes, lines and triangles.
module NanoUI.Draw.Shapes
  ( pushRect
  , pushQuadGradient
  , pushImage
  , pushRoundedRect
  , pushRoundedRectRaw
  , pushRoundedStroke
  , pushRoundedStrokeRaw
  , pushCircle
  , pushCircleStroke
  , pushLine
  , pushStrokeAA
  , pushStroke
  , pushFilledTriangle
  ) where

import Control.Monad (when)
import Data.IORef (readIORef)
import Data.Word (Word32, Word8)
import Foreign.Ptr (Ptr)
import Foreign.Storable (pokeByteOff)
import NanoUI.Draw.Arena
import NanoUI.Draw.Types (DrawArena (..), glyphAtlasTextureId, indexSize, vertexSize)
import NanoUI.SIMD
  ( concentricOffsetsSIMD
  , pokeQuadGradientSIMD
  , pokeQuadSIMD
  , pokeVertexSIMD
  )
import NanoUI.Types (Color (..), Rect (..), onGrid)

{-# INLINE pushRect #-}
pushRect :: DrawArena -> Rect -> Color -> IO ()
pushRect :: DrawArena -> Rect -> Color -> IO ()
pushRect DrawArena
da Rect
rect Color
col = do
  r <- DrawArena -> Rect -> IO Rect
snapRectOrigin DrawArena
da Rect
rect
  setTexture da glyphAtlasTextureId
  pushQuad da r whitePixelU whitePixelV whitePixelU whitePixelV col

-- Quad with a color per corner. GPU interpolates across the two triangles.
-- Corners: top-left, top-right, bottom-right, bottom-left.
pushQuadGradient :: DrawArena -> Rect -> Color -> Color -> Color -> Color -> IO ()
pushQuadGradient :: DrawArena -> Rect -> Color -> Color -> Color -> Color -> IO ()
pushQuadGradient DrawArena
da (Rect Float
x Float
y Float
w Float
h) Color
tl Color
tr Color
br Color
bl
  | 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 = () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  | Bool
otherwise = do
      s <- IORef Float -> IO Float
forall a. IORef a -> IO a
readIORef (DrawArena -> IORef Float
daSnapScale DrawArena
da)
      setTexture da glyphAtlasTextureId
      let !px = Float -> Float -> Float
onGrid Float
s Float
x
          !py = Float -> Float -> Float
onGrid Float
s Float
y
          !c0 = Color -> (Float, Float, Float, Float)
unpackColorF Color
tl
          !c1 = Color -> (Float, Float, Float, Float)
unpackColorF Color
tr
          !c2 = Color -> (Float, Float, Float, Float)
unpackColorF Color
br
          !c3 = Color -> (Float, Float, Float, Float)
unpackColorF Color
bl
      withVerts da 4 6 $ \Ptr Word8
vp Ptr Word8
ip Int
vOff Int
iOff Word32
baseIdxWord ->
        Ptr Word8
-> Int
-> Ptr Word8
-> Int
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> (Float, Float, Float, Float)
-> (Float, Float, Float, Float)
-> (Float, Float, Float, Float)
-> (Float, Float, Float, Float)
-> Word32
-> IO ()
pokeQuadGradientSIMD Ptr Word8
vp Int
vOff Ptr Word8
ip Int
iOff Float
px Float
py Float
w Float
h Float
whitePixelU Float
whitePixelV (Float, Float, Float, Float)
c0 (Float, Float, Float, Float)
c1 (Float, Float, Float, Float)
c2 (Float, Float, Float, Float)
c3 Word32
baseIdxWord

{-# INLINE pushImage #-}
pushImage :: DrawArena -> Rect -> Int -> Float -> Float -> Float -> Float -> Color -> IO ()
pushImage :: DrawArena
-> Rect
-> Int
-> Float
-> Float
-> Float
-> Float
-> Color
-> IO ()
pushImage DrawArena
da Rect
rect Int
tex Float
u0 Float
v0 Float
u1 Float
v1 Color
col
  | Int
tex Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
0 = DrawArena -> Rect -> Color -> IO ()
pushRect DrawArena
da Rect
rect Color
col
  | Bool
otherwise = do
      r <- DrawArena -> Rect -> IO Rect
snapRectOrigin DrawArena
da Rect
rect
      setTexture da tex
      pushQuad da r u0 v0 u1 v1 col

-- 4 segments per 90° arc. Lookup table in cornerCosSin has 5 points per quadrant.
cornerSegments :: Int
cornerSegments :: Int
cornerSegments = Int
4

-- Precomputed unit-circle cos/sin for rounded-rect corners (4 segments per 90° arc).
{-# INLINE cornerCosSin #-}
cornerCosSin :: Int -> Int -> (Float, Float)
cornerCosSin :: Int -> Int -> (Float, Float)
cornerCosSin Int
q Int
seg =
  case Int
q Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
5 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
seg of
    Int
0 -> (-Float
1.0, Float
0.0)
    Int
1 -> (-Float
0.9238795325, -Float
0.3826834324)
    Int
2 -> (-Float
0.7071067812, -Float
0.7071067812)
    Int
3 -> (-Float
0.3826834324, -Float
0.9238795325)
    Int
4 -> (Float
0.0, -Float
1.0)
    Int
5 -> (Float
0.0, -Float
1.0)
    Int
6 -> (Float
0.3826834324, -Float
0.9238795325)
    Int
7 -> (Float
0.7071067812, -Float
0.7071067812)
    Int
8 -> (Float
0.9238795325, -Float
0.3826834324)
    Int
9 -> (Float
1.0, Float
0.0)
    Int
10 -> (Float
1.0, Float
0.0)
    Int
11 -> (Float
0.9238795325, Float
0.3826834324)
    Int
12 -> (Float
0.7071067812, Float
0.7071067812)
    Int
13 -> (Float
0.3826834324, Float
0.9238795325)
    Int
14 -> (Float
0.0, Float
1.0)
    Int
15 -> (Float
0.0, Float
1.0)
    Int
16 -> (-Float
0.3826834324, Float
0.9238795325)
    Int
17 -> (-Float
0.7071067812, Float
0.7071067812)
    Int
18 -> (-Float
0.9238795325, Float
0.3826834324)
    Int
19 -> (-Float
1.0, Float
0.0)
    Int
_ -> (Float
0.0, Float
0.0)

-- | Poke one coverage-AA strip into a reservation at vertex offset @vi@ and
-- index offset @ii@ (both relative to @base@/@baseIdx@). Callers guarantee
-- @(x0,y0) /= (x1,y1)@. Shared by straight strokes and the fused
-- rounded-stroke paths, so a whole border shares one arena reservation.
{-# INLINE pokeStripAt #-}
pokeStripAt ::
  Ptr Word8 ->
  Ptr Word8 ->
  Int ->
  Int ->
  Int ->
  Int ->
  Float ->
  Float ->
  Float ->
  Float ->
  Float ->
  Float ->
  Float ->
  Float ->
  Float ->
  IO ()
pokeStripAt :: Ptr Word8
-> Ptr Word8
-> Int
-> Int
-> Int
-> Int
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> IO ()
pokeStripAt Ptr Word8
vp Ptr Word8
ip Int
base Int
baseIdx Int
vi Int
ii Float
x0 Float
y0 Float
x1 Float
y1 Float
bw Float
r Float
g Float
b Float
a = do
  let !dx :: Float
dx = Float
x1 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
x0
      !dy :: Float
dy = Float
y1 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
y0
      !len :: Float
len = Float -> Float
forall a. Floating a => a -> a
sqrt (Float
dx Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
dx Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
dy Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
dy)
      !nx :: Float
nx = (-Float
dy) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
len
      !ny :: Float
ny = Float
dx Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
len
      !half :: Float
half = Float
bw Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
0.5
      !core :: Float
core = Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
0 (Float
half Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
0.5)
      !outer :: Float
outer = Float
half Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
0.5
      pokeEnd :: Int -> Float -> Float -> IO ()
pokeEnd !Int
ev !Float
ex !Float
ey = do
        let ((Float
p0x, Float
p0y), (Float
p1x, Float
p1y), (Float
p2x, Float
p2y), (Float
p3x, Float
p3y)) =
              Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> ((Float, Float), (Float, Float), (Float, Float), (Float, Float))
concentricOffsetsSIMD Float
ex Float
ey Float
nx Float
ny (-Float
outer) (-Float
core) Float
core Float
outer
            !vBase :: Int
vBase = (Int
base Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
vi Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ev) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
vertexSize
        Ptr Word8
-> Int
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> IO ()
pokeVertexSIMD Ptr Word8
vp Int
vBase Float
p0x Float
p0y Float
r Float
g Float
b Float
0 Float
whitePixelU Float
whitePixelV
        Ptr Word8
-> Int
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> IO ()
pokeVertexSIMD Ptr Word8
vp (Int
vBase Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
32) Float
p1x Float
p1y Float
r Float
g Float
b Float
a Float
whitePixelU Float
whitePixelV
        Ptr Word8
-> Int
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> IO ()
pokeVertexSIMD Ptr Word8
vp (Int
vBase Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
64) Float
p2x Float
p2y Float
r Float
g Float
b Float
a Float
whitePixelU Float
whitePixelV
        Ptr Word8
-> Int
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> IO ()
pokeVertexSIMD Ptr Word8
vp (Int
vBase Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
96) Float
p3x Float
p3y Float
r Float
g Float
b Float
0 Float
whitePixelU Float
whitePixelV
  Int -> Float -> Float -> IO ()
pokeEnd Int
0 Float
x0 Float
y0
  Int -> Float -> Float -> IO ()
pokeEnd Int
4 Float
x1 Float
y1
  let !va :: Word32
va = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
base Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
vi) :: Word32
      !vb :: Word32
vb = Word32
va Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
4
  Ptr Word8 -> Int -> Word32 -> Word32 -> Word32 -> Word32 -> IO ()
pokeQuadIndices Ptr Word8
ip ((Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ii) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
indexSize) Word32
va (Word32
va Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
1) (Word32
vb Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
1) Word32
vb
  Ptr Word8 -> Int -> Word32 -> Word32 -> Word32 -> Word32 -> IO ()
pokeQuadIndices Ptr Word8
ip ((Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ii Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
6) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
indexSize) (Word32
va Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
1) (Word32
va Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
2) (Word32
vb Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
2) (Word32
vb Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
1)
  Ptr Word8 -> Int -> Word32 -> Word32 -> Word32 -> Word32 -> IO ()
pokeQuadIndices Ptr Word8
ip ((Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ii Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
12) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
indexSize) (Word32
va Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
2) (Word32
va Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
3) (Word32
vb Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
3) (Word32
vb Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
2)

{-# INLINE pushRoundedRect #-}
pushRoundedRect :: DrawArena -> Rect -> Float -> Color -> IO ()
pushRoundedRect :: DrawArena -> Rect -> Float -> Color -> IO ()
pushRoundedRect DrawArena
da (Rect Float
x Float
y Float
w Float
h) Float
radius Color
col = do
  s <- IORef Float -> IO Float
forall a. IORef a -> IO a
readIORef (DrawArena -> IORef Float
daSnapScale DrawArena
da)
  pushRoundedRectRaw da (Rect (onGrid s x) (onGrid s y) w h) radius col

-- | Unsnapped variant used when the rect is already anchored to the snapped
-- device pixel grid, e.g. a mark that must stay concentric with a border that
-- has already snapped its own origin. Re-snapping here would round the
-- off-origin inset (delta = (box - mark)/2) away, and since absolute snapping
-- rides on the fractional part of the widget position the mark would drift
-- off-center by up to a pixel as the widget scrolls.
-- Keep the fused emitter out of its many paint callers: inlining it duplicates
-- the corner loops and increases instruction-cache pressure substantially.
{-# NOINLINE pushRoundedRectRaw #-}
pushRoundedRectRaw :: DrawArena -> Rect -> Float -> Color -> IO ()
pushRoundedRectRaw :: DrawArena -> Rect -> Float -> Color -> IO ()
pushRoundedRectRaw DrawArena
da (Rect Float
x Float
y Float
w Float
h) Float
radius Color
col
  | 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 = () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  | Float
radius Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Float
0.5 = DrawArena -> Rect -> Color -> IO ()
pushRect DrawArena
da (Float -> Float -> Float -> Float -> Rect
Rect Float
x Float
y Float
w Float
h) Color
col
  | Bool
otherwise = do
      square <- IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef (DrawArena -> IORef Bool
daSquareGeometry DrawArena
da)
      let !rad = Float -> Float -> Float
forall a. Ord a => a -> a -> a
min Float
radius (Float -> Float -> Float
forall a. Ord a => a -> a -> a
min (Float
w Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
0.5) (Float
h Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
0.5))
      if square || rad <= 0.5
        then pushRect da (Rect x y w h) col
        else do
          setTexture da glyphAtlasTextureId
          let !segs = Int
cornerSegments
              !ring = Int
segs Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
              !midW = 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
rad)
              !midH = 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
rad)
              !hasCenter = Float
midW Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
0 Bool -> Bool -> Bool
&& Float
midH Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
0
              !hasTB = Float
midW Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
0
              !hasLR = Float
midH Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
0
              !quadCount =
                (if Bool
hasCenter then Int
1 else Int
0)
                  Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (if Bool
hasTB then Int
2 else Int
0)
                  Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (if Bool
hasLR then Int
2 else Int
0)
              !cornerV = Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
ring
              !cornerI = Int
segs Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
9
              !needV = Int
quadCount Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
cornerV
              !needI = Int
quadCount Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
6 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
cornerI
          withVertsRaw da needV needI $ \Ptr Word8
vp Ptr Word8
ip Int
base Int
baseIdx -> do
            let !(Float
cr, Float
cg, Float
cb, Float
ca) = Color -> (Float, Float, Float, Float)
unpackColorF Color
col
                !u :: Float
u = Float
whitePixelU
                !v :: Float
v = Float
whitePixelV
                pokeQuadAt :: Int -> Int -> Float -> Float -> Float -> Float -> IO ()
pokeQuadAt !Int
vi !Int
ii !Float
qx !Float
qy !Float
qw !Float
qh =
                  Ptr Word8
-> Int
-> Ptr Word8
-> Int
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Word32
-> IO ()
pokeQuadSIMD
                    Ptr Word8
vp
                    ((Int
base Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
vi) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
vertexSize)
                    Ptr Word8
ip
                    ((Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ii) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
indexSize)
                    Float
qx
                    Float
qy
                    Float
qw
                    Float
qh
                    Float
u
                    Float
v
                    Float
u
                    Float
v
                    Float
cr
                    Float
cg
                    Float
cb
                    Float
ca
                    (Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
base Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
vi))
                pokeCorner :: Int -> Int -> Float -> Float -> Int -> IO ()
pokeCorner !Int
vi !Int
ii !Float
ccx !Float
ccy !Int
q = do
                  let !vBase :: Int
vBase = (Int
base Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
vi) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
vertexSize
                      !centerIdx :: Word32
centerIdx = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
base Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
vi) :: Word32
                      !inRad :: Float
inRad = Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
0 (Float
rad Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
1.0)
                  Ptr Word8
-> Int
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> IO ()
pokeVertexSIMD Ptr Word8
vp Int
vBase Float
ccx Float
ccy Float
cr Float
cg Float
cb Float
ca Float
u Float
v
                  Int -> Int -> (Int -> IO ()) -> IO ()
loopIO Int
0 Int
segs ((Int -> IO ()) -> IO ()) -> (Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Int
i -> do
                    let !(Float
ct, Float
st) = Int -> Int -> (Float, Float)
cornerCosSin Int
q Int
i
                        !rimI :: Int
rimI = Int
base Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
vi Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i
                        !outI :: Int
outI = Int
base Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
vi Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ring Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i
                    Ptr Word8
-> Int
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> IO ()
pokeVertexSIMD Ptr Word8
vp (Int
rimI Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
vertexSize) (Float
ccx Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
inRad Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
ct) (Float
ccy Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
inRad Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
st) Float
cr Float
cg Float
cb Float
ca Float
u Float
v
                    Ptr Word8
-> Int
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> IO ()
pokeVertexSIMD Ptr Word8
vp (Int
outI Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
vertexSize) (Float
ccx Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
rad Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
ct) (Float
ccy Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
rad Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
st) Float
cr Float
cg Float
cb Float
0 Float
u Float
v
                    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
i Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                      let !k :: Int
k = Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
                          !rim0 :: Word32
rim0 = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
base Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
vi Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i) :: Word32
                          !rim1 :: Word32
rim1 = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
base Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
vi Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i) :: Word32
                          !out0 :: Word32
out0 = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
base Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
vi Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ring Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
k) :: Word32
                          !out1 :: Word32
out1 = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
base Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
vi Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ring Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i) :: Word32
                          !fillOff :: Int
fillOff = (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ii Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
3) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
indexSize
                          !fringeOff :: Int
fringeOff = (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ii Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
segs Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
k Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
6) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
indexSize
                      Ptr Word8 -> Int -> Word32 -> IO ()
forall b. Ptr b -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
ip Int
fillOff Word32
centerIdx
                      Ptr Word8 -> Int -> Word32 -> IO ()
forall b. Ptr b -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
ip (Int
fillOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4) Word32
rim0
                      Ptr Word8 -> Int -> Word32 -> IO ()
forall b. Ptr b -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
ip (Int
fillOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
8) Word32
rim1
                      Ptr Word8 -> Int -> Word32 -> Word32 -> Word32 -> Word32 -> IO ()
pokeQuadIndices Ptr Word8
ip Int
fringeOff Word32
rim0 Word32
out0 Word32
out1 Word32
rim1
                !vi1 :: Int
vi1 = if Bool
hasCenter then Int
4 else Int
0
                !ii1 :: Int
ii1 = if Bool
hasCenter then Int
6 else Int
0
                !vi2 :: Int
vi2 = Int
vi1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (if Bool
hasTB then Int
8 else Int
0)
                !ii2 :: Int
ii2 = Int
ii1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (if Bool
hasTB then Int
12 else Int
0)
                !vi3 :: Int
vi3 = Int
vi2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (if Bool
hasLR then Int
8 else Int
0)
                !ii3 :: Int
ii3 = Int
ii2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (if Bool
hasLR then Int
12 else Int
0)
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
hasCenter (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> Int -> Float -> Float -> Float -> Float -> IO ()
pokeQuadAt Int
0 Int
0 (Float
x Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
rad) (Float
y Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
rad) Float
midW Float
midH
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
hasTB (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
              Int -> Int -> Float -> Float -> Float -> Float -> IO ()
pokeQuadAt Int
vi1 Int
ii1 (Float
x Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
rad) Float
y Float
midW Float
rad
              Int -> Int -> Float -> Float -> Float -> Float -> IO ()
pokeQuadAt (Int
vi1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4) (Int
ii1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
6) (Float
x Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
rad) (Float
y Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
h Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
rad) Float
midW Float
rad
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
hasLR (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
              Int -> Int -> Float -> Float -> Float -> Float -> IO ()
pokeQuadAt Int
vi2 Int
ii2 Float
x (Float
y Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
rad) Float
rad Float
midH
              Int -> Int -> Float -> Float -> Float -> Float -> IO ()
pokeQuadAt (Int
vi2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4) (Int
ii2 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
6) (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
rad) (Float
y Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
rad) Float
rad Float
midH
            Int -> Int -> Float -> Float -> Int -> IO ()
pokeCorner Int
vi3 Int
ii3 (Float
x Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
rad) (Float
y Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
rad) Int
0
            Int -> Int -> Float -> Float -> Int -> IO ()
pokeCorner (Int
vi3 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
cornerV) (Int
ii3 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
cornerI) (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
rad) (Float
y Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
rad) Int
1
            Int -> Int -> Float -> Float -> Int -> IO ()
pokeCorner (Int
vi3 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
cornerV) (Int
ii3 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
cornerI) (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
rad) (Float
y Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
h Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
rad) Int
2
            Int -> Int -> Float -> Float -> Int -> IO ()
pokeCorner (Int
vi3 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
cornerV) (Int
ii3 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
cornerI) (Float
x Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
rad) (Float
y Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
h Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
rad) Int
3

-- | A filled circle. The centre snaps to the device pixel grid, not the
-- bounding box's origin: snapping the origin rounds @cx - radius@, so two
-- circles sharing a centre but not a radius would land up to a pixel apart.
{-# INLINE pushCircle #-}
pushCircle :: DrawArena -> Float -> Float -> Float -> Color -> IO ()
pushCircle :: DrawArena -> Float -> Float -> Float -> Color -> IO ()
pushCircle DrawArena
da Float
cx Float
cy Float
radius Color
col = do
  s <- IORef Float -> IO Float
forall a. IORef a -> IO a
readIORef (DrawArena -> IORef Float
daSnapScale DrawArena
da)
  pushRoundedRectRaw da (circleBox (onGrid s cx) (onGrid s cy) radius) radius col

-- | A circle's outline, its centre snapped as 'pushCircle' snaps it.
{-# INLINE pushCircleStroke #-}
pushCircleStroke :: DrawArena -> Float -> Float -> Float -> Float -> Color -> IO ()
pushCircleStroke :: DrawArena -> Float -> Float -> Float -> Float -> Color -> IO ()
pushCircleStroke DrawArena
da Float
cx Float
cy Float
radius Float
bw Color
col = do
  s <- IORef Float -> IO Float
forall a. IORef a -> IO a
readIORef (DrawArena -> IORef Float
daSnapScale DrawArena
da)
  pushRoundedStrokeRaw da (circleBox (onGrid s cx) (onGrid s cy) radius) radius bw col

circleBox :: Float -> Float -> Float -> Rect
circleBox :: Float -> Float -> Float -> Rect
circleBox Float
cx Float
cy Float
radius = Float -> Float -> Float -> Float -> Rect
Rect (Float
cx Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
radius) (Float
cy Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
radius) (Float
2 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
radius) (Float
2 Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
radius)

{-# INLINE pushRoundedStroke #-}
pushRoundedStroke :: DrawArena -> Rect -> Float -> Float -> Color -> IO ()
pushRoundedStroke :: DrawArena -> Rect -> Float -> Float -> Color -> IO ()
pushRoundedStroke DrawArena
da (Rect Float
x Float
y Float
w Float
h) Float
radius Float
bw Color
col = do
  s <- IORef Float -> IO Float
forall a. IORef a -> IO a
readIORef (DrawArena -> IORef Float
daSnapScale DrawArena
da)
  pushRoundedStrokeRaw da (Rect (onGrid s x) (onGrid s y) w h) radius bw col

-- | 'pushRoundedStroke' without snapping the origin, for a rect already
-- anchored to the grid; see 'pushRoundedRectRaw'.
{-# NOINLINE pushRoundedStrokeRaw #-}
pushRoundedStrokeRaw :: DrawArena -> Rect -> Float -> Float -> Color -> IO ()
pushRoundedStrokeRaw :: DrawArena -> Rect -> Float -> Float -> Color -> IO ()
pushRoundedStrokeRaw DrawArena
da (Rect Float
px Float
py Float
w Float
h) Float
radius Float
bw Color
col
  | 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 Bool -> Bool -> Bool
|| Float
bw Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Float
0 = () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  | Bool
otherwise = do
      DrawArena -> Int -> IO ()
setTexture DrawArena
da Int
glyphAtlasTextureId
      square <- IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef (DrawArena -> IORef Bool
daSquareGeometry DrawArena
da)
      let !rad = Float -> Float -> Float
forall a. Ord a => a -> a -> a
min (Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
0 Float
radius) (Float -> Float -> Float
forall a. Ord a => a -> a -> a
min (Float
w Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
0.5) (Float
h Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
0.5))
          !ibw = Float -> Float -> Float
forall a. Ord a => a -> a -> a
min Float
bw (Float -> Float -> Float
forall a. Ord a => a -> a -> a
min (Float
w Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
0.5) (Float
h Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
0.5))
      if square
        then pushSquareStroke da px py w h ibw col
        else if rad <= 0.5
        then do
          let !t = Float
ibw
              !ox = Float
px Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
t Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
2
              !oy = Float
py Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
t Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
2
              !ow = 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
t)
              !oh = 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
t)
              !doTB = Float
ow Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
>= Float
0.001
              !doLR = Float
oh Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
>= Float
0.001
              !stripCount = (if Bool
doTB then Int
2 else Int
0) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (if Bool
doLR then Int
2 else Int
0)
          withVertsRaw da (stripCount * 8) (stripCount * 18) $ \Ptr Word8
vp Ptr Word8
ip Int
base Int
baseIdx -> do
            let !(Float
r, Float
g, Float
b, Float
a) = Color -> (Float, Float, Float, Float)
unpackColorF Color
col
                !viLR :: Int
viLR = if Bool
doTB then Int
16 else Int
0
                !iiLR :: Int
iiLR = if Bool
doTB then Int
36 else Int
0
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
doTB (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
              Ptr Word8
-> Ptr Word8
-> Int
-> Int
-> Int
-> Int
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> IO ()
pokeStripAt Ptr Word8
vp Ptr Word8
ip Int
base Int
baseIdx Int
0 Int
0 Float
ox Float
oy (Float
ox Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
ow) Float
oy Float
t Float
r Float
g Float
b Float
a
              Ptr Word8
-> Ptr Word8
-> Int
-> Int
-> Int
-> Int
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> IO ()
pokeStripAt Ptr Word8
vp Ptr Word8
ip Int
base Int
baseIdx Int
8 Int
18 Float
ox (Float
oy Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
oh) (Float
ox Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
ow) (Float
oy Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
oh) Float
t Float
r Float
g Float
b Float
a
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
doLR (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
              Ptr Word8
-> Ptr Word8
-> Int
-> Int
-> Int
-> Int
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> IO ()
pokeStripAt Ptr Word8
vp Ptr Word8
ip Int
base Int
baseIdx Int
viLR Int
iiLR Float
ox Float
oy Float
ox (Float
oy Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
oh) Float
t Float
r Float
g Float
b Float
a
              Ptr Word8
-> Ptr Word8
-> Int
-> Int
-> Int
-> Int
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> IO ()
pokeStripAt Ptr Word8
vp Ptr Word8
ip Int
base Int
baseIdx (Int
viLR Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
8) (Int
iiLR Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
18) (Float
ox Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
ow) Float
oy (Float
ox Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
ow) (Float
oy Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
oh) Float
t Float
r Float
g Float
b Float
a
        else do
          let !n = Int
cornerSegments
          let !midW = 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
rad)
              !midH = 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
rad)
              !topY = Float
py Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
ibw Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
2
              !botY = Float
py Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
h Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
ibw Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
2
              !leftX = Float
px Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
ibw Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
2
              !rightX = Float
px Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
w Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
ibw Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
2
              !cr = Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
0.25 (Float
rad Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
ibw Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
2)
              !doTB = Float
midW Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
>= Float
0.001
              !doLR = Float
midH Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
>= Float
0.001
              !stripCount = (if Bool
doTB then Int
2 else Int
0) Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (if Bool
doLR then Int
2 else Int
0)
              -- Hairlines have coincident inner/outer core rings. Share that
              -- ring and omit its zero-area triangles instead of submitting
              -- a fourth vertex and a third quad for every arc segment.
              !core = Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
0 (Float
ibw Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
0.5 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
0.5)
              !hasCore = Float
core Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
0
              !arcStride = if Bool
hasCore then Int
4 else Int
3
              !arcIndices = if Bool
hasCore then Int
18 else Int
12
              !arcV = (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
arcStride
              !arcI = Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
arcIndices
              !needV = Int
stripCount Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
arcV
              !needI = Int
stripCount Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
18 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
arcI
          withVertsRaw da needV needI $ \Ptr Word8
vp Ptr Word8
ip Int
base Int
baseIdx -> do
            let !(Float
r, Float
g, Float
b, Float
a) = Color -> (Float, Float, Float, Float)
unpackColorF Color
col
                pokeArc :: Int -> Int -> Float -> Float -> Int -> IO ()
pokeArc !Int
vi !Int
ii !Float
ccx !Float
ccy !Int
q = do
                  let !inner :: Float
inner = Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
0 (Float
cr Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
core)
                      !outerR :: Float
outerR = Float
cr Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
core
                      !innerAA :: Float
innerAA = Float -> Float -> Float
forall a. Ord a => a -> a -> a
max Float
0 (Float
inner Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
1.0)
                      !outerAA :: Float
outerAA = Float
outerR Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
1.0
                  Int -> Int -> (Int -> IO ()) -> IO ()
loopIO Int
0 Int
n ((Int -> IO ()) -> IO ()) -> (Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Int
i -> do
                    let !(Float
ct, Float
st) = Int -> Int -> (Float, Float)
cornerCosSin Int
q Int
i
                        !v0 :: Int
v0 = Int
base Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
vi Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
arcStride
                        !vBase :: Int
vBase = Int
v0 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
vertexSize
                        ((Float
p0x, Float
p0y), (Float
p1x, Float
p1y), (Float
p2x, Float
p2y), (Float
p3x, Float
p3y)) =
                          Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> ((Float, Float), (Float, Float), (Float, Float), (Float, Float))
concentricOffsetsSIMD Float
ccx Float
ccy Float
ct Float
st Float
innerAA Float
inner Float
outerR Float
outerAA
                    Ptr Word8
-> Int
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> IO ()
pokeVertexSIMD Ptr Word8
vp Int
vBase Float
p0x Float
p0y Float
r Float
g Float
b Float
0 Float
whitePixelU Float
whitePixelV
                    Ptr Word8
-> Int
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> IO ()
pokeVertexSIMD Ptr Word8
vp (Int
vBase Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
32) Float
p1x Float
p1y Float
r Float
g Float
b Float
a Float
whitePixelU Float
whitePixelV
                    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
hasCore (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                      Ptr Word8
-> Int
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> IO ()
pokeVertexSIMD Ptr Word8
vp (Int
vBase Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
64) Float
p2x Float
p2y Float
r Float
g Float
b Float
a Float
whitePixelU Float
whitePixelV
                    Ptr Word8
-> Int
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> IO ()
pokeVertexSIMD Ptr Word8
vp (Int
vBase Int -> Int -> Int
forall a. Num a => a -> a -> a
+ (Int
arcStride Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
vertexSize) Float
p3x Float
p3y Float
r Float
g Float
b Float
0 Float
whitePixelU Float
whitePixelV
                  Int -> Int -> (Int -> IO ()) -> IO ()
loopIO Int
0 (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) ((Int -> IO ()) -> IO ()) -> (Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Int
i -> do
                    let !va :: Word32
va = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int
base Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
vi Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
arcStride) :: Word32
                        !vb :: Word32
vb = Word32
va Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
arcStride
                        !iOff :: Int
iOff = (Int
baseIdx Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
ii Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
i Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
arcIndices) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
indexSize
                    Ptr Word8 -> Int -> Word32 -> Word32 -> Word32 -> Word32 -> IO ()
pokeQuadIndices Ptr Word8
ip Int
iOff Word32
va (Word32
va Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
1) (Word32
vb Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
1) Word32
vb
                    Ptr Word8 -> Int -> Word32 -> Word32 -> Word32 -> Word32 -> IO ()
pokeQuadIndices Ptr Word8
ip (Int
iOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
24) (Word32
va Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
1) (Word32
va Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
2) (Word32
vb Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
2) (Word32
vb Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
1)
                    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
hasCore (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                      Ptr Word8 -> Int -> Word32 -> Word32 -> Word32 -> Word32 -> IO ()
pokeQuadIndices Ptr Word8
ip (Int
iOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
48) (Word32
va Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
2) (Word32
va Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
3) (Word32
vb Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
3) (Word32
vb Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
2)
                !viLR :: Int
viLR = if Bool
doTB then Int
16 else Int
0
                !iiLR :: Int
iiLR = if Bool
doTB then Int
36 else Int
0
                !viC :: Int
viC = Int
stripCount Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
8
                !iiC :: Int
iiC = Int
stripCount Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
18
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
doTB (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
              Ptr Word8
-> Ptr Word8
-> Int
-> Int
-> Int
-> Int
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> IO ()
pokeStripAt Ptr Word8
vp Ptr Word8
ip Int
base Int
baseIdx Int
0 Int
0 (Float
px Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
rad) Float
topY (Float
px Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
rad Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
midW) Float
topY Float
ibw Float
r Float
g Float
b Float
a
              Ptr Word8
-> Ptr Word8
-> Int
-> Int
-> Int
-> Int
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> IO ()
pokeStripAt Ptr Word8
vp Ptr Word8
ip Int
base Int
baseIdx Int
8 Int
18 (Float
px Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
rad) Float
botY (Float
px Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
rad Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
midW) Float
botY Float
ibw Float
r Float
g Float
b Float
a
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
doLR (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
              Ptr Word8
-> Ptr Word8
-> Int
-> Int
-> Int
-> Int
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> IO ()
pokeStripAt Ptr Word8
vp Ptr Word8
ip Int
base Int
baseIdx Int
viLR Int
iiLR Float
leftX (Float
py Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
rad) Float
leftX (Float
py Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
rad Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
midH) Float
ibw Float
r Float
g Float
b Float
a
              Ptr Word8
-> Ptr Word8
-> Int
-> Int
-> Int
-> Int
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> IO ()
pokeStripAt Ptr Word8
vp Ptr Word8
ip Int
base Int
baseIdx (Int
viLR Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
8) (Int
iiLR Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
18) Float
rightX (Float
py Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
rad) Float
rightX (Float
py Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
rad Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
midH) Float
ibw Float
r Float
g Float
b Float
a
            Int -> Int -> Float -> Float -> Int -> IO ()
pokeArc Int
viC Int
iiC (Float
px Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
rad) (Float
py Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
rad) Int
0
            Int -> Int -> Float -> Float -> Int -> IO ()
pokeArc (Int
viC Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
arcV) (Int
iiC Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
arcI) (Float
px Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
w Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
rad) (Float
py Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
rad) Int
1
            Int -> Int -> Float -> Float -> Int -> IO ()
pokeArc (Int
viC Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
arcV) (Int
iiC Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
2 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
arcI) (Float
px Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
w Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
rad) (Float
py Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
h Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
rad) Int
2
            Int -> Int -> Float -> Float -> Int -> IO ()
pokeArc (Int
viC Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
arcV) (Int
iiC Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
3 Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
arcI) (Float
px Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
rad) (Float
py Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
h Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
rad) Int
3

-- | Border of four flat rects inside @(x, y, w, h)@, @t@ thick. The origin is
-- already snapped by the caller; the texture is already selected.
pushSquareStroke :: DrawArena -> Float -> Float -> Float -> Float -> Float -> Color -> IO ()
pushSquareStroke :: DrawArena
-> Float -> Float -> Float -> Float -> Float -> Color -> IO ()
pushSquareStroke DrawArena
da Float
x Float
y Float
w Float
h Float
t Color
col = do
  let edge :: Float -> Float -> Float -> Float -> IO ()
edge Float
qx Float
qy Float
qw Float
qh =
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Float
qw Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
0 Bool -> Bool -> Bool
&& Float
qh Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
> Float
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
          DrawArena
-> Rect -> Float -> Float -> Float -> Float -> Color -> IO ()
pushQuad DrawArena
da (Float -> Float -> Float -> Float -> Rect
Rect Float
qx Float
qy Float
qw Float
qh) Float
whitePixelU Float
whitePixelV Float
whitePixelU Float
whitePixelV Color
col
      !innerH :: Float
innerH = 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
t
  Float -> Float -> Float -> Float -> IO ()
edge Float
x Float
y Float
w Float
t
  Float -> Float -> Float -> Float -> IO ()
edge Float
x (Float
y Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
h Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
t) Float
w Float
t
  Float -> Float -> Float -> Float -> IO ()
edge Float
x (Float
y Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
t) Float
t Float
innerH
  Float -> Float -> Float -> Float -> IO ()
edge (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
t) (Float
y Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
t) Float
t Float
innerH

-- | A line @thickness@ wide with round caps: a coverage-AA strip with a
-- round cap on each end. An axis-aligned line is a plain rect spanning its
-- caps.
{-# INLINE pushLine #-}
pushLine :: DrawArena -> Float -> Float -> Float -> Float -> Float -> Color -> IO ()
pushLine :: DrawArena
-> Float -> Float -> Float -> Float -> Float -> Color -> IO ()
pushLine DrawArena
da Float
x1 Float
y1 Float
x2 Float
y2 Float
thickness Color
col = do
  square <- IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef (DrawArena -> IORef Bool
daSquareGeometry DrawArena
da)
  let !r = Float
thickness Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
2
      cap Float
cx Float
cy = DrawArena -> Float -> Float -> Float -> Color -> IO ()
pushCircle DrawArena
da Float
cx Float
cy Float
r Color
col
  if square
    then pushStroke da x1 y1 x2 y2 thickness col
    else
      if x1 == x2 || y1 == y2
        then pushRect da (Rect (min x1 x2 - r) (min y1 y2 - r) (abs (x2 - x1) + thickness) (abs (y2 - y1) + thickness)) col
        else when (thickness > 0) $ do
          pushStrokeAA da x1 y1 x2 y2 thickness col
          cap x1 y1
          cap x2 y2

-- Coverage-AA strip for a straight segment. Same weight as pushCornerArcStroke,
-- without round caps that blob at rounded-rect corners.
{-# INLINE pushStrokeAA #-}
pushStrokeAA :: DrawArena -> Float -> Float -> Float -> Float -> Float -> Color -> IO ()
pushStrokeAA :: DrawArena
-> Float -> Float -> Float -> Float -> Float -> Color -> IO ()
pushStrokeAA DrawArena
da Float
x0 Float
y0 Float
x1 Float
y1 Float
bw Color
col
  | Float
bw Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Float
0 = () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  | Bool
otherwise = do
      s <- IORef Float -> IO Float
forall a. IORef a -> IO a
readIORef (DrawArena -> IORef Float
daSnapScale DrawArena
da)
      pushStrokeAARaw da (onGrid s x0) (onGrid s y0) (onGrid s x1) (onGrid s y1) bw col

-- | Unsnapped variant: the caller already snapped the endpoints.
pushStrokeAARaw :: DrawArena -> Float -> Float -> Float -> Float -> Float -> Color -> IO ()
pushStrokeAARaw :: DrawArena
-> Float -> Float -> Float -> Float -> Float -> Color -> IO ()
pushStrokeAARaw DrawArena
da Float
x0 Float
y0 Float
x1 Float
y1 Float
bw Color
col = do
  square <- IORef Bool -> IO Bool
forall a. IORef a -> IO a
readIORef (DrawArena -> IORef Bool
daSquareGeometry DrawArena
da)
  if square
    then pushStroke da x0 y0 x1 y1 bw col
    else case strokeAxes x0 y0 x1 y1 of
      Maybe (Float, Float, Float)
Nothing -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
      Just (Float, Float, Float)
_ -> do
        DrawArena -> Int -> IO ()
setTexture DrawArena
da Int
glyphAtlasTextureId
        let !(Float
r, Float
g, Float
b, Float
a) = Color -> (Float, Float, Float, Float)
unpackColorF Color
col
        DrawArena
-> Int
-> Int
-> (Ptr Word8 -> Ptr Word8 -> Int -> Int -> IO ())
-> IO ()
withVertsRaw DrawArena
da Int
8 Int
18 ((Ptr Word8 -> Ptr Word8 -> Int -> Int -> IO ()) -> IO ())
-> (Ptr Word8 -> Ptr Word8 -> Int -> Int -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
vp Ptr Word8
ip Int
base Int
baseIdx ->
          Ptr Word8
-> Ptr Word8
-> Int
-> Int
-> Int
-> Int
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> IO ()
pokeStripAt Ptr Word8
vp Ptr Word8
ip Int
base Int
baseIdx Int
0 Int
0 Float
x0 Float
y0 Float
x1 Float
y1 Float
bw Float
r Float
g Float
b Float
a

strokeAxes :: Float -> Float -> Float -> Float -> Maybe (Float, Float, Float)
strokeAxes :: Float -> Float -> Float -> Float -> Maybe (Float, Float, Float)
strokeAxes Float
x0 Float
y0 Float
x1 Float
y1 =
  let dx :: Float
dx = Float
x1 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
x0
      dy :: Float
dy = Float
y1 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
y0
      len :: Float
len = Float -> Float
forall a. Floating a => a -> a
sqrt (Float
dx Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
dx Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
dy Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
dy)
   in if Float
len Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
< Float
0.001 then Maybe (Float, Float, Float)
forall a. Maybe a
Nothing else (Float, Float, Float) -> Maybe (Float, Float, Float)
forall a. a -> Maybe a
Just (Float
dx, Float
dy, Float
len)

-- One quad per segment. Plots and diagrams use this; pushLine adds round caps.
pushStroke :: DrawArena -> Float -> Float -> Float -> Float -> Float -> Color -> IO ()
pushStroke :: DrawArena
-> Float -> Float -> Float -> Float -> Float -> Color -> IO ()
pushStroke DrawArena
da Float
x1 Float
y1 Float
x2 Float
y2 Float
thickness Color
col
  | Float
thickness Float -> Float -> Bool
forall a. Ord a => a -> a -> Bool
<= Float
0 = () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
  | Bool
otherwise = do
      s <- IORef Float -> IO Float
forall a. IORef a -> IO a
readIORef (DrawArena -> IORef Float
daSnapScale DrawArena
da)
      let !px1 = Float -> Float -> Float
onGrid Float
s Float
x1
          !py1 = Float -> Float -> Float
onGrid Float
s Float
y1
          !px2 = Float -> Float -> Float
onGrid Float
s Float
x2
          !py2 = Float -> Float -> Float
onGrid Float
s Float
y2
      case strokeAxes px1 py1 px2 py2 of
        Maybe (Float, Float, Float)
Nothing -> () -> IO ()
forall a. a -> IO a
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
        Just (Float
dx, Float
dy, Float
len) -> do
          DrawArena -> Int -> IO ()
setTexture DrawArena
da Int
glyphAtlasTextureId
          let !invLen :: Float
invLen = (Float
thickness Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
0.5) Float -> Float -> Float
forall a. Fractional a => a -> a -> a
/ Float
len
              !hx :: Float
hx = (-Float
dy) Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
invLen
              !hy :: Float
hy = Float
dx Float -> Float -> Float
forall a. Num a => a -> a -> a
* Float
invLen
          DrawArena
-> Int
-> Int
-> (Ptr Word8 -> Ptr Word8 -> Int -> Int -> Word32 -> IO ())
-> IO ()
withVerts DrawArena
da Int
4 Int
6 ((Ptr Word8 -> Ptr Word8 -> Int -> Int -> Word32 -> IO ())
 -> IO ())
-> (Ptr Word8 -> Ptr Word8 -> Int -> Int -> Word32 -> IO ())
-> IO ()
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
vp Ptr Word8
ip Int
vOff Int
iOff Word32
baseIdxWord -> do
            let !(Float
r, Float
g, Float
b, Float
a) = Color -> (Float, Float, Float, Float)
unpackColorF Color
col
                poke :: Int -> Float -> Float -> IO ()
poke Int
off Float
px Float
py = Ptr Word8
-> Int
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> IO ()
pokeVertexSIMD Ptr Word8
vp Int
off Float
px Float
py Float
r Float
g Float
b Float
a Float
whitePixelU Float
whitePixelV
            Int -> Float -> Float -> IO ()
poke Int
vOff (Float
px1 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
hx) (Float
py1 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
hy)
            Int -> Float -> Float -> IO ()
poke (Int
vOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
32) (Float
px2 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
hx) (Float
py2 Float -> Float -> Float
forall a. Num a => a -> a -> a
+ Float
hy)
            Int -> Float -> Float -> IO ()
poke (Int
vOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
64) (Float
px2 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
hx) (Float
py2 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
hy)
            Int -> Float -> Float -> IO ()
poke (Int
vOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
96) (Float
px1 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
hx) (Float
py1 Float -> Float -> Float
forall a. Num a => a -> a -> a
- Float
hy)
            Ptr Word8 -> Int -> Word32 -> Word32 -> Word32 -> Word32 -> IO ()
pokeQuadIndices Ptr Word8
ip Int
iOff Word32
baseIdxWord (Word32
baseIdxWord Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
1) (Word32
baseIdxWord Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
2) (Word32
baseIdxWord Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
3)

pushFilledTriangle :: DrawArena -> Float -> Float -> Float -> Float -> Float -> Float -> Color -> IO ()
pushFilledTriangle :: DrawArena
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Color
-> IO ()
pushFilledTriangle DrawArena
da Float
x0 Float
y0 Float
x1 Float
y1 Float
x2 Float
y2 Color
col = do
  s <- IORef Float -> IO Float
forall a. IORef a -> IO a
readIORef (DrawArena -> IORef Float
daSnapScale DrawArena
da)
  setTexture da glyphAtlasTextureId
  let !(r, g, b, a) = unpackColorF col
  withVerts da 3 3 $ \Ptr Word8
vp Ptr Word8
ip Int
vOff Int
iOff Word32
baseIdxWord -> do
    Ptr Word8
-> Int
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> IO ()
pokeVertexSIMD Ptr Word8
vp Int
vOff (Float -> Float -> Float
onGrid Float
s Float
x0) (Float -> Float -> Float
onGrid Float
s Float
y0) Float
r Float
g Float
b Float
a Float
whitePixelU Float
whitePixelV
    Ptr Word8
-> Int
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> IO ()
pokeVertexSIMD Ptr Word8
vp (Int
vOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
32) (Float -> Float -> Float
onGrid Float
s Float
x1) (Float -> Float -> Float
onGrid Float
s Float
y1) Float
r Float
g Float
b Float
a Float
whitePixelU Float
whitePixelV
    Ptr Word8
-> Int
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> Float
-> IO ()
pokeVertexSIMD Ptr Word8
vp (Int
vOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
64) (Float -> Float -> Float
onGrid Float
s Float
x2) (Float -> Float -> Float
onGrid Float
s Float
y2) Float
r Float
g Float
b Float
a Float
whitePixelU Float
whitePixelV
    Ptr Word8 -> Int -> Word32 -> IO ()
forall b. Ptr b -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
ip Int
iOff Word32
baseIdxWord
    Ptr Word8 -> Int -> Word32 -> IO ()
forall b. Ptr b -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
ip (Int
iOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
4) (Word32
baseIdxWord Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
1)
    Ptr Word8 -> Int -> Word32 -> IO ()
forall b. Ptr b -> Int -> Word32 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Word8
ip (Int
iOff Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
8) (Word32
baseIdxWord Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
2)