{-# LINE 1 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
module KB.Text.Shape.FFI.Structs where

import Prelude hiding (id, error)

import Foreign
import Foreign.C

import KB.Text.Shape.FFI.Allocator (Allocator)
import KB.Text.Shape.FFI.Enums
import KB.Text.Shape.FFI.Flags
import KB.Text.Shape.FFI.Handles



data FontInfo = FontInfo
  { FontInfo -> [Ptr CChar]
strings :: [Ptr CChar] -- ^ @char *Strings[KBTS_FONT_INFO_STRING_ID_COUNT]@
  , FontInfo -> [Word16]
stringLengths :: [Word16] -- ^ @kbts_u16 StringLengths[KBTS_FONT_INFO_STRING_ID_COUNT]@

  , FontInfo -> FontStyleFlags
styleFlags :: FontStyleFlags
  , FontInfo -> FontWeight
weight :: FontWeight
  , FontInfo -> FontWidth
width :: FontWidth
  } deriving (FontInfo -> FontInfo -> Bool
(FontInfo -> FontInfo -> Bool)
-> (FontInfo -> FontInfo -> Bool) -> Eq FontInfo
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FontInfo -> FontInfo -> Bool
== :: FontInfo -> FontInfo -> Bool
$c/= :: FontInfo -> FontInfo -> Bool
/= :: FontInfo -> FontInfo -> Bool
Eq, Int -> FontInfo -> ShowS
[FontInfo] -> ShowS
FontInfo -> String
(Int -> FontInfo -> ShowS)
-> (FontInfo -> String) -> ([FontInfo] -> ShowS) -> Show FontInfo
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FontInfo -> ShowS
showsPrec :: Int -> FontInfo -> ShowS
$cshow :: FontInfo -> String
show :: FontInfo -> String
$cshowList :: [FontInfo] -> ShowS
showList :: [FontInfo] -> ShowS
Show)

instance Storable FontInfo where
  alignment :: FontInfo -> Int
alignment ~FontInfo
_ = Int
8
{-# LINE 26 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
  sizeOf ~_ = (144)
{-# LINE 27 "src/KB/Text/Shape/FFI/Structs.hsc" #-}

  peek :: Ptr FontInfo -> IO FontInfo
peek Ptr FontInfo
ptr = do
    strings <- Int -> Ptr (Ptr CChar) -> IO [Ptr CChar]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
FONT_INFO_STRING_ID_COUNT (Ptr (Ptr CChar) -> IO [Ptr CChar])
-> Ptr (Ptr CChar) -> IO [Ptr CChar]
forall a b. (a -> b) -> a -> b
$ Ptr FontInfo
ptr Ptr FontInfo -> Int -> Ptr (Ptr CChar)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` ((Int
0))
{-# LINE 30 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    stringLengths <- peekArray FONT_INFO_STRING_ID_COUNT $ ptr `plusPtr` ((104))
{-# LINE 31 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    styleFlags <- ((\hsc_ptr -> peekByteOff hsc_ptr 132)) ptr
{-# LINE 32 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    weight <- ((\hsc_ptr -> peekByteOff hsc_ptr 136)) ptr
{-# LINE 33 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    width <- ((\hsc_ptr -> peekByteOff hsc_ptr 140)) ptr
{-# LINE 34 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    pure FontInfo{..}

  poke :: Ptr FontInfo -> FontInfo -> IO ()
poke Ptr FontInfo
ptr FontInfo{[Word16]
[Ptr CChar]
FontWidth
FontWeight
FontStyleFlags
strings :: FontInfo -> [Ptr CChar]
stringLengths :: FontInfo -> [Word16]
styleFlags :: FontInfo -> FontStyleFlags
weight :: FontInfo -> FontWeight
width :: FontInfo -> FontWidth
strings :: [Ptr CChar]
stringLengths :: [Word16]
styleFlags :: FontStyleFlags
weight :: FontWeight
width :: FontWidth
..} = do
    Ptr (Ptr CChar) -> [Ptr CChar] -> IO ()
forall a. Storable a => Ptr a -> [a] -> IO ()
pokeArray (Ptr FontInfo
ptr Ptr FontInfo -> Int -> Ptr (Ptr CChar)
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` ((Int
0))) [Ptr CChar]
strings
{-# LINE 38 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    pokeArray (ptr `plusPtr` ((104))) stringLengths
{-# LINE 39 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 132)) ptr styleFlags
{-# LINE 40 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 136)) ptr weight
{-# LINE 41 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 140)) ptr width
{-# LINE 42 "src/KB/Text/Shape/FFI/Structs.hsc" #-}

data GlyphIterator = GlyphIterator
  { GlyphIterator -> Ptr GlyphStorage
glyphStorage :: Ptr GlyphStorage
  , GlyphIterator -> Ptr Glyph
currentGlyph :: Ptr Glyph

  , GlyphIterator -> Int
lastAdvanceX :: Int
  , GlyphIterator -> Int
x :: Int
  , GlyphIterator -> Int
y :: Int
  }
  deriving (Int -> GlyphIterator -> ShowS
[GlyphIterator] -> ShowS
GlyphIterator -> String
(Int -> GlyphIterator -> ShowS)
-> (GlyphIterator -> String)
-> ([GlyphIterator] -> ShowS)
-> Show GlyphIterator
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GlyphIterator -> ShowS
showsPrec :: Int -> GlyphIterator -> ShowS
$cshow :: GlyphIterator -> String
show :: GlyphIterator -> String
$cshowList :: [GlyphIterator] -> ShowS
showList :: [GlyphIterator] -> ShowS
Show)

instance Storable GlyphIterator where
  alignment :: GlyphIterator -> Int
alignment ~GlyphIterator
_ = Int
8
{-# LINE 55 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
  sizeOf ~_ = (32)
{-# LINE 56 "src/KB/Text/Shape/FFI/Structs.hsc" #-}

  peek :: Ptr GlyphIterator -> IO GlyphIterator
peek Ptr GlyphIterator
ptr = do
    glyphStorage <- ((\Ptr GlyphIterator
hsc_ptr -> Ptr GlyphIterator -> Int -> IO (Ptr GlyphStorage)
forall b. Ptr b -> Int -> IO (Ptr GlyphStorage)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr GlyphIterator
hsc_ptr Int
0)) Ptr GlyphIterator
ptr
{-# LINE 59 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    currentGlyph <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) ptr
{-# LINE 60 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    lastAdvanceX <- fromIntegral @CInt <$> ((\hsc_ptr -> peekByteOff hsc_ptr 16)) ptr
{-# LINE 61 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    x <- fromIntegral @CInt <$> ((\hsc_ptr -> peekByteOff hsc_ptr 20)) ptr
{-# LINE 62 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    y <- fromIntegral @CInt <$> ((\hsc_ptr -> peekByteOff hsc_ptr 24)) ptr
{-# LINE 63 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    pure GlyphIterator{..}

  poke :: Ptr GlyphIterator -> GlyphIterator -> IO ()
poke Ptr GlyphIterator
ptr GlyphIterator{Int
Ptr Glyph
Ptr GlyphStorage
glyphStorage :: GlyphIterator -> Ptr GlyphStorage
currentGlyph :: GlyphIterator -> Ptr Glyph
lastAdvanceX :: GlyphIterator -> Int
x :: GlyphIterator -> Int
y :: GlyphIterator -> Int
glyphStorage :: Ptr GlyphStorage
currentGlyph :: Ptr Glyph
lastAdvanceX :: Int
x :: Int
y :: Int
..} = do
    ((\Ptr GlyphIterator
hsc_ptr -> Ptr GlyphIterator -> Int -> Ptr GlyphStorage -> IO ()
forall b. Ptr b -> Int -> Ptr GlyphStorage -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr GlyphIterator
hsc_ptr Int
0)) Ptr GlyphIterator
ptr Ptr GlyphStorage
glyphStorage
{-# LINE 67 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) ptr currentGlyph
{-# LINE 68 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 16)) ptr $ fromIntegral @_ @CInt lastAdvanceX
{-# LINE 69 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 20)) ptr $ fromIntegral @_ @CInt x
{-# LINE 70 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 24)) ptr $ fromIntegral @_ @CInt y
{-# LINE 71 "src/KB/Text/Shape/FFI/Structs.hsc" #-}

data CodepointIterator = CodepointIterator
  { CodepointIterator -> Ptr Codepoint
codepoint :: Ptr Codepoint
  , CodepointIterator -> ShapeContext
context :: ShapeContext

  , CodepointIterator -> Word32
endBlockIndex :: Word32
  , CodepointIterator -> Word32
onePastLastCodepointIndex :: Word32
  , CodepointIterator -> Word32
blockIndex :: Word32
  , CodepointIterator -> Word32
codepointIndex :: Word32
  , CodepointIterator -> Word32
currentBlockCodepointCount :: Word32
  , CodepointIterator -> Word32
flatCodepointIndex :: Word32
  }
  deriving (Int -> CodepointIterator -> ShowS
[CodepointIterator] -> ShowS
CodepointIterator -> String
(Int -> CodepointIterator -> ShowS)
-> (CodepointIterator -> String)
-> ([CodepointIterator] -> ShowS)
-> Show CodepointIterator
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CodepointIterator -> ShowS
showsPrec :: Int -> CodepointIterator -> ShowS
$cshow :: CodepointIterator -> String
show :: CodepointIterator -> String
$cshowList :: [CodepointIterator] -> ShowS
showList :: [CodepointIterator] -> ShowS
Show)

instance Storable CodepointIterator where
  alignment :: CodepointIterator -> Int
alignment ~CodepointIterator
_ = Int
8
{-# LINE 87 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
  sizeOf ~_ = (40)
{-# LINE 88 "src/KB/Text/Shape/FFI/Structs.hsc" #-}

  peek :: Ptr CodepointIterator -> IO CodepointIterator
peek Ptr CodepointIterator
ptr = do
    codepoint <- ((\Ptr CodepointIterator
hsc_ptr -> Ptr CodepointIterator -> Int -> IO (Ptr Codepoint)
forall b. Ptr b -> Int -> IO (Ptr Codepoint)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr CodepointIterator
hsc_ptr Int
0)) Ptr CodepointIterator
ptr
{-# LINE 91 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    context <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) ptr
{-# LINE 92 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    endBlockIndex <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) ptr
{-# LINE 93 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    onePastLastCodepointIndex <- ((\hsc_ptr -> peekByteOff hsc_ptr 20)) ptr
{-# LINE 94 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    blockIndex <- ((\hsc_ptr -> peekByteOff hsc_ptr 24)) ptr
{-# LINE 95 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    codepointIndex <- ((\hsc_ptr -> peekByteOff hsc_ptr 28)) ptr
{-# LINE 96 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    currentBlockCodepointCount <- ((\hsc_ptr -> peekByteOff hsc_ptr 32)) ptr
{-# LINE 97 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    flatCodepointIndex <- ((\hsc_ptr -> peekByteOff hsc_ptr 36)) ptr
{-# LINE 98 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    pure CodepointIterator{..}

  poke :: Ptr CodepointIterator -> CodepointIterator -> IO ()
poke Ptr CodepointIterator
ptr CodepointIterator{Word32
Ptr Codepoint
ShapeContext
codepoint :: CodepointIterator -> Ptr Codepoint
context :: CodepointIterator -> ShapeContext
endBlockIndex :: CodepointIterator -> Word32
onePastLastCodepointIndex :: CodepointIterator -> Word32
blockIndex :: CodepointIterator -> Word32
codepointIndex :: CodepointIterator -> Word32
currentBlockCodepointCount :: CodepointIterator -> Word32
flatCodepointIndex :: CodepointIterator -> Word32
codepoint :: Ptr Codepoint
context :: ShapeContext
endBlockIndex :: Word32
onePastLastCodepointIndex :: Word32
blockIndex :: Word32
codepointIndex :: Word32
currentBlockCodepointCount :: Word32
flatCodepointIndex :: Word32
..} = do
    ((\Ptr CodepointIterator
hsc_ptr -> Ptr CodepointIterator -> Int -> Ptr Codepoint -> IO ()
forall b. Ptr b -> Int -> Ptr Codepoint -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr CodepointIterator
hsc_ptr Int
0)) Ptr CodepointIterator
ptr Ptr Codepoint
codepoint
{-# LINE 102 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) ptr context
{-# LINE 103 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 16)) ptr endBlockIndex
{-# LINE 104 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 20)) ptr onePastLastCodepointIndex
{-# LINE 105 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 24)) ptr blockIndex
{-# LINE 106 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 28)) ptr codepointIndex
{-# LINE 107 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 32)) ptr currentBlockCodepointCount
{-# LINE 108 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 36)) ptr flatCodepointIndex
{-# LINE 109 "src/KB/Text/Shape/FFI/Structs.hsc" #-}

data Run = Run
  { Run -> Font
font :: Font
  , Run -> Script
script :: Script
  , Run -> Direction
paragraphDirection :: Direction
  , Run -> Direction
direction :: Direction
  , Run -> BreakFlags
flags :: BreakFlags

  , Run -> GlyphIterator
glyphs :: GlyphIterator
  }
  deriving (Int -> Run -> ShowS
[Run] -> ShowS
Run -> String
(Int -> Run -> ShowS)
-> (Run -> String) -> ([Run] -> ShowS) -> Show Run
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Run -> ShowS
showsPrec :: Int -> Run -> ShowS
$cshow :: Run -> String
show :: Run -> String
$cshowList :: [Run] -> ShowS
showList :: [Run] -> ShowS
Show)

runGlyphIterator :: Ptr Run -> Ptr GlyphIterator
runGlyphIterator :: Ptr Run -> Ptr GlyphIterator
runGlyphIterator Ptr Run
runPtr = Ptr Run
runPtr Ptr Run -> Int -> Ptr GlyphIterator
forall a b. Ptr a -> Int -> Ptr b
`plusPtr` ((Int
24))
{-# LINE 123 "src/KB/Text/Shape/FFI/Structs.hsc" #-}

instance Storable Run where
  alignment :: Run -> Int
alignment ~Run
_ = Int
8
{-# LINE 126 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
  sizeOf ~_ = (56)
{-# LINE 127 "src/KB/Text/Shape/FFI/Structs.hsc" #-}

  peek :: Ptr Run -> IO Run
peek Ptr Run
ptr = do
    font <- ((\Ptr Run
hsc_ptr -> Ptr Run -> Int -> IO Font
forall b. Ptr b -> Int -> IO Font
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Run
hsc_ptr Int
0)) Ptr Run
ptr
{-# LINE 130 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    script <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) ptr
{-# LINE 131 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    paragraphDirection <- ((\hsc_ptr -> peekByteOff hsc_ptr 12)) ptr
{-# LINE 132 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    direction <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) ptr
{-# LINE 133 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    flags <- ((\hsc_ptr -> peekByteOff hsc_ptr 20)) ptr
{-# LINE 134 "src/KB/Text/Shape/FFI/Structs.hsc" #-}

    glyphs <- ((\Ptr Run
hsc_ptr -> Ptr Run -> Int -> IO GlyphIterator
forall b. Ptr b -> Int -> IO GlyphIterator
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Run
hsc_ptr Int
24)) ptr
{-# LINE 136 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    pure Run{..}

  poke :: Ptr Run -> Run -> IO ()
poke Ptr Run
ptr Run{Script
Direction
BreakFlags
Font
GlyphIterator
font :: Run -> Font
script :: Run -> Script
paragraphDirection :: Run -> Direction
direction :: Run -> Direction
flags :: Run -> BreakFlags
glyphs :: Run -> GlyphIterator
font :: Font
script :: Script
paragraphDirection :: Direction
direction :: Direction
flags :: BreakFlags
glyphs :: GlyphIterator
..} = do
    ((\Ptr Run
hsc_ptr -> Ptr Run -> Int -> Font -> IO ()
forall b. Ptr b -> Int -> Font -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Run
hsc_ptr Int
0)) Ptr Run
ptr Font
font
{-# LINE 140 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) ptr script
{-# LINE 141 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 12)) ptr paragraphDirection
{-# LINE 142 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 16)) ptr direction
{-# LINE 143 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 20)) ptr flags
{-# LINE 144 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 24)) ptr glyphs
{-# LINE 145 "src/KB/Text/Shape/FFI/Structs.hsc" #-}

data Arena = Arena
  { Arena -> FunPtr Allocator
allocator :: FunPtr Allocator
  , Arena -> Ptr ()
allocatorData :: Ptr ()

  , Arena -> ArenaBlockHeader
blockSentinel :: ArenaBlockHeader
  , Arena -> ArenaBlockHeader
freeBlockSentinel :: ArenaBlockHeader
  , Arena -> Int
error :: Int
  }
  deriving (Int -> Arena -> ShowS
[Arena] -> ShowS
Arena -> String
(Int -> Arena -> ShowS)
-> (Arena -> String) -> ([Arena] -> ShowS) -> Show Arena
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Arena -> ShowS
showsPrec :: Int -> Arena -> ShowS
$cshow :: Arena -> String
show :: Arena -> String
$cshowList :: [Arena] -> ShowS
showList :: [Arena] -> ShowS
Show)

instance Storable Arena where
  alignment :: Arena -> Int
alignment ~Arena
_ = Int
8
{-# LINE 158 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
  sizeOf ~_ = (56)
{-# LINE 159 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
  peek ptr = do
    allocator <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) ptr
{-# LINE 161 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    allocatorData <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) ptr
{-# LINE 162 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    blockSentinel <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) ptr
{-# LINE 163 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    freeBlockSentinel <- ((\hsc_ptr -> peekByteOff hsc_ptr 32)) ptr
{-# LINE 164 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    error <- ((\hsc_ptr -> peekByteOff hsc_ptr 48)) ptr
{-# LINE 165 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    pure Arena{..}
  poke :: Ptr Arena -> Arena -> IO ()
poke Ptr Arena
ptr Arena{Int
Ptr ()
FunPtr Allocator
ArenaBlockHeader
allocator :: Arena -> FunPtr Allocator
allocatorData :: Arena -> Ptr ()
blockSentinel :: Arena -> ArenaBlockHeader
freeBlockSentinel :: Arena -> ArenaBlockHeader
error :: Arena -> Int
allocator :: FunPtr Allocator
allocatorData :: Ptr ()
blockSentinel :: ArenaBlockHeader
freeBlockSentinel :: ArenaBlockHeader
error :: Int
..} = do
    ((\Ptr Arena
hsc_ptr -> Ptr Arena -> Int -> FunPtr Allocator -> IO ()
forall b. Ptr b -> Int -> FunPtr Allocator -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Arena
hsc_ptr Int
0)) Ptr Arena
ptr FunPtr Allocator
allocator
{-# LINE 168 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) ptr allocatorData
{-# LINE 169 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 16)) ptr blockSentinel
{-# LINE 170 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 32)) ptr freeBlockSentinel
{-# LINE 171 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 48)) ptr error
{-# LINE 172 "src/KB/Text/Shape/FFI/Structs.hsc" #-}

data ArenaBlockHeader = ArenaBlockHeader
  { ArenaBlockHeader -> Ptr ArenaBlockHeader
prev :: Ptr ArenaBlockHeader
  , ArenaBlockHeader -> Ptr ArenaBlockHeader
next :: Ptr ArenaBlockHeader
  }
  deriving (Int -> ArenaBlockHeader -> ShowS
[ArenaBlockHeader] -> ShowS
ArenaBlockHeader -> String
(Int -> ArenaBlockHeader -> ShowS)
-> (ArenaBlockHeader -> String)
-> ([ArenaBlockHeader] -> ShowS)
-> Show ArenaBlockHeader
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ArenaBlockHeader -> ShowS
showsPrec :: Int -> ArenaBlockHeader -> ShowS
$cshow :: ArenaBlockHeader -> String
show :: ArenaBlockHeader -> String
$cshowList :: [ArenaBlockHeader] -> ShowS
showList :: [ArenaBlockHeader] -> ShowS
Show)

instance Storable ArenaBlockHeader where
  alignment :: ArenaBlockHeader -> Int
alignment ~ArenaBlockHeader
_ = Int
8
{-# LINE 181 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
  sizeOf ~_ = (16)
{-# LINE 182 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
  peek ptr = do
    prev <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) ptr
{-# LINE 184 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    next <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) ptr
{-# LINE 185 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    pure ArenaBlockHeader{..}
  poke :: Ptr ArenaBlockHeader -> ArenaBlockHeader -> IO ()
poke Ptr ArenaBlockHeader
ptr ArenaBlockHeader{Ptr ArenaBlockHeader
prev :: ArenaBlockHeader -> Ptr ArenaBlockHeader
next :: ArenaBlockHeader -> Ptr ArenaBlockHeader
prev :: Ptr ArenaBlockHeader
next :: Ptr ArenaBlockHeader
..} = do
    ((\Ptr ArenaBlockHeader
hsc_ptr -> Ptr ArenaBlockHeader -> Int -> Ptr ArenaBlockHeader -> IO ()
forall b. Ptr b -> Int -> Ptr ArenaBlockHeader -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr ArenaBlockHeader
hsc_ptr Int
0)) Ptr ArenaBlockHeader
ptr Ptr ArenaBlockHeader
prev
{-# LINE 188 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) ptr next
{-# LINE 189 "src/KB/Text/Shape/FFI/Structs.hsc" #-}

data GlyphStorage = GlyphStorage
  { GlyphStorage -> Arena
arena :: Arena

  , GlyphStorage -> Glyph
glyphSentinel :: Glyph
  , GlyphStorage -> Glyph
freeGlyphSentinel :: Glyph
  }
  deriving (Int -> GlyphStorage -> ShowS
[GlyphStorage] -> ShowS
GlyphStorage -> String
(Int -> GlyphStorage -> ShowS)
-> (GlyphStorage -> String)
-> ([GlyphStorage] -> ShowS)
-> Show GlyphStorage
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GlyphStorage -> ShowS
showsPrec :: Int -> GlyphStorage -> ShowS
$cshow :: GlyphStorage -> String
show :: GlyphStorage -> String
$cshowList :: [GlyphStorage] -> ShowS
showList :: [GlyphStorage] -> ShowS
Show)

instance Storable GlyphStorage where
  alignment :: GlyphStorage -> Int
alignment ~GlyphStorage
_ = Int
8
{-# LINE 200 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
  sizeOf ~_ = (272)
{-# LINE 201 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
  peek ptr = do
    arena <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) ptr
{-# LINE 203 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    glyphSentinel <- ((\hsc_ptr -> peekByteOff hsc_ptr 56)) ptr
{-# LINE 204 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    freeGlyphSentinel <- ((\hsc_ptr -> peekByteOff hsc_ptr 160)) ptr
{-# LINE 205 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    pure GlyphStorage{..}
  poke :: Ptr GlyphStorage -> GlyphStorage -> IO ()
poke Ptr GlyphStorage
ptr GlyphStorage{Glyph
Arena
arena :: GlyphStorage -> Arena
glyphSentinel :: GlyphStorage -> Glyph
freeGlyphSentinel :: GlyphStorage -> Glyph
arena :: Arena
glyphSentinel :: Glyph
freeGlyphSentinel :: Glyph
..} = do
    ((\Ptr GlyphStorage
hsc_ptr -> Ptr GlyphStorage -> Int -> Arena -> IO ()
forall b. Ptr b -> Int -> Arena -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr GlyphStorage
hsc_ptr Int
0)) Ptr GlyphStorage
ptr Arena
arena
{-# LINE 208 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 56)) ptr glyphSentinel
{-# LINE 209 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 160)) ptr freeGlyphSentinel
{-# LINE 210 "src/KB/Text/Shape/FFI/Structs.hsc" #-}

data Glyph = Glyph
  { Glyph -> Ptr Glyph
prev :: Ptr Glyph
  , Glyph -> Ptr Glyph
next :: Ptr Glyph

  , Glyph -> Word32
codepoint :: Word32
  , Glyph -> Word16
id :: Word16 -- ^ Glyph index. This is what you want to use to query outline data.
  , Glyph -> Word16
uid :: Word16

  , Glyph -> Int
userIdOrCodepointIndex :: Int
    {- ^ This field is kept and returned as-is throughout the shaping process.

    When you are using the context API, it contains a codepoint index always!
    To get the original user ID with the context API, you need to get the corresponding kbts_shape_codepoint
    with kbts_ShapeGetShapeCodepoint(Context, Glyph->UserIdOrCodepointIndex, ...);
    -}

  -- Used by GPOS
  , Glyph -> Int32
offsetX :: Int32
  , Glyph -> Int32
offsetY :: Int32
  , Glyph -> Int32
advanceX :: Int32
  , Glyph -> Int32
advanceY :: Int32

  , Glyph -> Ptr Glyph
attachGlyph :: Ptr Glyph
  {- ^ Set by GPOS attachments

    Earlier on, we used to assume that, if a glyph had no advance, or had the MARK glyph class, then
    it could be handled as a mark in layout operations. This is inaccurate.
    Unicode makes a distinction between attached marks and standalone marks. For our purposes, attached
    marks are marks that have found a valid base character to attach to. In practice, this means that the
    font contains a valid display position/configuration for it in the current context.
    In contrast, standalone marks are marks that aren't attached to anything. Fonts may still have glyphs
    for them, in which case we want to display those just like regular glyphs that take up horizontal space
    on the line. When fonts don't have glyphs for them, they simply stay around as zero-width glyphs.
    Standalone marks have notably different behavior compared to attached marks, and so, once we start
    applying positioning features, it becomes worthwhile to track exactly which glyph has attached to which.
  -}

  , Glyph -> Ptr ()
config :: Ptr () -- kbts_glyph_config *Config;

  , Glyph -> Word64
decomposition :: Word64

  , Glyph -> Word32
classes :: Word32 -- kbts_glyph_classes Classes;
  , Glyph -> GlyphFlags
flags :: GlyphFlags -- kbts_glyph_flags Flags;
  , Glyph -> Word32
parentInfo :: Word32

  , Glyph -> Word16
ligatureUid :: Word16
    {- ^ This is set by GSUB and used by GPOS.
      A 0-index means that we should attach to the last component in the ligature.

      From the Microsoft docs:
        To correctly access the subtables, the client must keep track of the component associated with the mark.

        For a given mark assigned to a particular class, the appropriate base attachment point is determined by which
        ligature component the mark is associated with. This is dependent on the original character string and subsequent
        character- or glyph-sequence processing, not the font data alone. While a text-layout client is performing any
        character-based preprocessing or any glyph-substitution operations using the GSUB table, the text-layout client
        must keep track of associations of marks to particular ligature-glyph components.
    -}

  , Glyph -> Word16
ligatureComponentIndexPlusOne :: Word16
  , Glyph -> Word16
ligatureComponentCount :: Word16

  , Glyph -> UnicodeJoiningFeature
joiningFeature :: UnicodeJoiningFeature
    -- ^ Set in GSUB and used in GPOS, for STCH.

  -- Unicode properties filled in by CodepointToGlyph.
  , Glyph -> UnicodeJoiningType
joiningType :: UnicodeJoiningType
  , Glyph -> Word8
unicodeFlags :: Word8
  , Glyph -> Word8
syllabicClass :: Word8
  , Glyph -> Word8
syllabicPosition :: Word8
  , Glyph -> Word8
useClass :: Word8
  , Glyph -> Word8
combiningClass :: Word8

  , Glyph -> Word8
markOrdering :: Word8 -- ^ Only used temporarily in NORMALIZE for Arabic mark reordering.
  }
  deriving (Int -> Glyph -> ShowS
[Glyph] -> ShowS
Glyph -> String
(Int -> Glyph -> ShowS)
-> (Glyph -> String) -> ([Glyph] -> ShowS) -> Show Glyph
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Glyph -> ShowS
showsPrec :: Int -> Glyph -> ShowS
$cshow :: Glyph -> String
show :: Glyph -> String
$cshowList :: [Glyph] -> ShowS
showList :: [Glyph] -> ShowS
Show)

instance Storable Glyph where
  alignment :: Glyph -> Int
alignment ~Glyph
_ = Int
8
{-# LINE 290 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
  sizeOf ~_ = (104)
{-# LINE 291 "src/KB/Text/Shape/FFI/Structs.hsc" #-}

  peek :: Ptr Glyph -> IO Glyph
peek Ptr Glyph
ptr = do
    prev <- ((\Ptr Glyph
hsc_ptr -> Ptr Glyph -> Int -> IO (Ptr Glyph)
forall b. Ptr b -> Int -> IO (Ptr Glyph)
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Glyph
hsc_ptr Int
0)) Ptr Glyph
ptr
{-# LINE 294 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    next <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) ptr
{-# LINE 295 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    codepoint <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) ptr
{-# LINE 296 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    id <- ((\hsc_ptr -> peekByteOff hsc_ptr 20)) ptr
{-# LINE 297 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    uid <- ((\hsc_ptr -> peekByteOff hsc_ptr 22)) ptr
{-# LINE 298 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    userIdOrCodepointIndex <- fromIntegral @CInt <$> ((\hsc_ptr -> peekByteOff hsc_ptr 24)) ptr
{-# LINE 299 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    offsetX <- ((\hsc_ptr -> peekByteOff hsc_ptr 28)) ptr
{-# LINE 300 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    offsetY <- ((\hsc_ptr -> peekByteOff hsc_ptr 32)) ptr
{-# LINE 301 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    advanceX <- ((\hsc_ptr -> peekByteOff hsc_ptr 36)) ptr
{-# LINE 302 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    advanceY <- ((\hsc_ptr -> peekByteOff hsc_ptr 40)) ptr
{-# LINE 303 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    attachGlyph <- ((\hsc_ptr -> peekByteOff hsc_ptr 48)) ptr
{-# LINE 304 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    config <- ((\hsc_ptr -> peekByteOff hsc_ptr 56)) ptr
{-# LINE 305 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    decomposition <- ((\hsc_ptr -> peekByteOff hsc_ptr 64)) ptr
{-# LINE 306 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    classes <- ((\hsc_ptr -> peekByteOff hsc_ptr 72)) ptr
{-# LINE 307 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    flags <- ((\hsc_ptr -> peekByteOff hsc_ptr 76)) ptr
{-# LINE 308 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    parentInfo <- ((\hsc_ptr -> peekByteOff hsc_ptr 80)) ptr
{-# LINE 309 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    ligatureUid <- ((\hsc_ptr -> peekByteOff hsc_ptr 84)) ptr
{-# LINE 310 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    ligatureComponentIndexPlusOne <- ((\hsc_ptr -> peekByteOff hsc_ptr 86)) ptr
{-# LINE 311 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    ligatureComponentCount <- ((\hsc_ptr -> peekByteOff hsc_ptr 88)) ptr
{-# LINE 312 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    joiningFeature <- ((\hsc_ptr -> peekByteOff hsc_ptr 90)) ptr
{-# LINE 313 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    joiningType <- ((\hsc_ptr -> peekByteOff hsc_ptr 91)) ptr
{-# LINE 314 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    unicodeFlags <- ((\hsc_ptr -> peekByteOff hsc_ptr 92)) ptr
{-# LINE 315 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    syllabicClass <- ((\hsc_ptr -> peekByteOff hsc_ptr 93)) ptr
{-# LINE 316 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    syllabicPosition <- ((\hsc_ptr -> peekByteOff hsc_ptr 94)) ptr
{-# LINE 317 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    useClass <- ((\hsc_ptr -> peekByteOff hsc_ptr 95)) ptr
{-# LINE 318 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    combiningClass <- ((\hsc_ptr -> peekByteOff hsc_ptr 96)) ptr
{-# LINE 319 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    markOrdering <- ((\hsc_ptr -> peekByteOff hsc_ptr 97)) ptr
{-# LINE 320 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    pure Glyph{..}

  poke :: Ptr Glyph -> Glyph -> IO ()
poke Ptr Glyph
ptr Glyph{Int
Int32
Word8
Word16
Word32
Word64
Ptr ()
Ptr Glyph
UnicodeJoiningType
UnicodeJoiningFeature
GlyphFlags
prev :: Glyph -> Ptr Glyph
next :: Glyph -> Ptr Glyph
codepoint :: Glyph -> Word32
id :: Glyph -> Word16
uid :: Glyph -> Word16
userIdOrCodepointIndex :: Glyph -> Int
offsetX :: Glyph -> Int32
offsetY :: Glyph -> Int32
advanceX :: Glyph -> Int32
advanceY :: Glyph -> Int32
attachGlyph :: Glyph -> Ptr Glyph
config :: Glyph -> Ptr ()
decomposition :: Glyph -> Word64
classes :: Glyph -> Word32
flags :: Glyph -> GlyphFlags
parentInfo :: Glyph -> Word32
ligatureUid :: Glyph -> Word16
ligatureComponentIndexPlusOne :: Glyph -> Word16
ligatureComponentCount :: Glyph -> Word16
joiningFeature :: Glyph -> UnicodeJoiningFeature
joiningType :: Glyph -> UnicodeJoiningType
unicodeFlags :: Glyph -> Word8
syllabicClass :: Glyph -> Word8
syllabicPosition :: Glyph -> Word8
useClass :: Glyph -> Word8
combiningClass :: Glyph -> Word8
markOrdering :: Glyph -> Word8
prev :: Ptr Glyph
next :: Ptr Glyph
codepoint :: Word32
id :: Word16
uid :: Word16
userIdOrCodepointIndex :: Int
offsetX :: Int32
offsetY :: Int32
advanceX :: Int32
advanceY :: Int32
attachGlyph :: Ptr Glyph
config :: Ptr ()
decomposition :: Word64
classes :: Word32
flags :: GlyphFlags
parentInfo :: Word32
ligatureUid :: Word16
ligatureComponentIndexPlusOne :: Word16
ligatureComponentCount :: Word16
joiningFeature :: UnicodeJoiningFeature
joiningType :: UnicodeJoiningType
unicodeFlags :: Word8
syllabicClass :: Word8
syllabicPosition :: Word8
useClass :: Word8
combiningClass :: Word8
markOrdering :: Word8
..} = do
    ((\Ptr Glyph
hsc_ptr -> Ptr Glyph -> Int -> Ptr Glyph -> IO ()
forall b. Ptr b -> Int -> Ptr Glyph -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Glyph
hsc_ptr Int
0)) Ptr Glyph
ptr Ptr Glyph
prev
{-# LINE 324 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) ptr next
{-# LINE 325 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 16)) ptr codepoint
{-# LINE 326 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 20)) ptr id
{-# LINE 327 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 22)) ptr uid
{-# LINE 328 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 24)) ptr $ fromIntegral @_ @CInt userIdOrCodepointIndex
{-# LINE 329 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 28)) ptr offsetX
{-# LINE 330 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 32)) ptr offsetY
{-# LINE 331 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 36)) ptr advanceX
{-# LINE 332 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 40)) ptr advanceY
{-# LINE 333 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 48)) ptr attachGlyph
{-# LINE 334 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 56)) ptr config
{-# LINE 335 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 64)) ptr decomposition
{-# LINE 336 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 72)) ptr classes
{-# LINE 337 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 76)) ptr flags
{-# LINE 338 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 80)) ptr parentInfo
{-# LINE 339 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 84)) ptr ligatureUid
{-# LINE 340 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 86)) ptr ligatureComponentIndexPlusOne
{-# LINE 341 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 88)) ptr ligatureComponentCount
{-# LINE 342 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 90)) ptr joiningFeature
{-# LINE 343 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 91)) ptr joiningType
{-# LINE 344 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 92)) ptr unicodeFlags
{-# LINE 345 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 93)) ptr syllabicClass
{-# LINE 346 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 94)) ptr syllabicPosition
{-# LINE 347 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 95)) ptr useClass
{-# LINE 348 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 96)) ptr combiningClass
{-# LINE 349 "src/KB/Text/Shape/FFI/Structs.hsc" #-}

data Codepoint = Codepoint
  { Codepoint -> Font
font :: Font -- ^ Only set when @(BreakFlags & KBTS_BREAK_FLAG_GRAPHEME) != 0@.
  , Codepoint -> Ptr ()
config :: Ptr () -- kbts_glyph_config*

  , Codepoint -> Int
codepoint :: Int
  , Codepoint -> Int
userId :: Int

  , Codepoint -> BreakFlags
breakFlags :: BreakFlags
  , Codepoint -> Script
script :: Script -- ^ Only set when @(BreakFlags & KBTS_BREAK_FLAG_SCRIPT) != 0@.
  , Codepoint -> Direction
direction :: Direction -- ^ Only set when @(BreakFlags & KBTS_BREAK_FLAG_DIRECTION) != 0@.
  , Codepoint -> Direction
paragraphDirection :: Direction -- ^ Only set when @(BreakFlags & KBTS_BREAK_FLAG_PARAGRAPH_DIRECTION) != 0@.
  }
  deriving (Int -> Codepoint -> ShowS
[Codepoint] -> ShowS
Codepoint -> String
(Int -> Codepoint -> ShowS)
-> (Codepoint -> String)
-> ([Codepoint] -> ShowS)
-> Show Codepoint
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Codepoint -> ShowS
showsPrec :: Int -> Codepoint -> ShowS
$cshow :: Codepoint -> String
show :: Codepoint -> String
$cshowList :: [Codepoint] -> ShowS
showList :: [Codepoint] -> ShowS
Show)

instance Storable Codepoint where
  alignment :: Codepoint -> Int
alignment ~Codepoint
_ = Int
8
{-# LINE 366 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
  sizeOf ~_ = (40)
{-# LINE 367 "src/KB/Text/Shape/FFI/Structs.hsc" #-}

  peek :: Ptr Codepoint -> IO Codepoint
peek Ptr Codepoint
ptr = do
    font <- ((\Ptr Codepoint
hsc_ptr -> Ptr Codepoint -> Int -> IO Font
forall b. Ptr b -> Int -> IO Font
forall a b. Storable a => Ptr b -> Int -> IO a
peekByteOff Ptr Codepoint
hsc_ptr Int
0)) Ptr Codepoint
ptr
{-# LINE 370 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    config <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) ptr
{-# LINE 371 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    codepoint <- fromIntegral @CInt <$> ((\hsc_ptr -> peekByteOff hsc_ptr 16)) ptr
{-# LINE 372 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    userId <- fromIntegral @CInt <$> ((\hsc_ptr -> peekByteOff hsc_ptr 20)) ptr
{-# LINE 373 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    breakFlags <- ((\hsc_ptr -> peekByteOff hsc_ptr 24)) ptr
{-# LINE 374 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    script <- ((\hsc_ptr -> peekByteOff hsc_ptr 28)) ptr
{-# LINE 375 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    direction <- ((\hsc_ptr -> peekByteOff hsc_ptr 32)) ptr
{-# LINE 376 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    paragraphDirection <- ((\hsc_ptr -> peekByteOff hsc_ptr 36)) ptr
{-# LINE 377 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    pure Codepoint{..}

  poke :: Ptr Codepoint -> Codepoint -> IO ()
poke Ptr Codepoint
ptr Codepoint{Int
Ptr ()
Script
Direction
BreakFlags
Font
font :: Codepoint -> Font
config :: Codepoint -> Ptr ()
codepoint :: Codepoint -> Int
userId :: Codepoint -> Int
breakFlags :: Codepoint -> BreakFlags
script :: Codepoint -> Script
direction :: Codepoint -> Direction
paragraphDirection :: Codepoint -> Direction
font :: Font
config :: Ptr ()
codepoint :: Int
userId :: Int
breakFlags :: BreakFlags
script :: Script
direction :: Direction
paragraphDirection :: Direction
..} = do
    ((\Ptr Codepoint
hsc_ptr -> Ptr Codepoint -> Int -> Font -> IO ()
forall b. Ptr b -> Int -> Font -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Codepoint
hsc_ptr Int
0)) Ptr Codepoint
ptr Font
font
{-# LINE 381 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 16)) ptr $ fromIntegral @_ @CInt codepoint
{-# LINE 382 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 20)) ptr $ fromIntegral @_ @CInt userId
{-# LINE 383 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 24)) ptr breakFlags
{-# LINE 384 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 28)) ptr script
{-# LINE 385 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 32)) ptr direction
{-# LINE 386 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 36)) ptr paragraphDirection
{-# LINE 387 "src/KB/Text/Shape/FFI/Structs.hsc" #-}

data FeatureOverride = FeatureOverride
  { FeatureOverride -> FeatureTag
tag :: FeatureTag
  , FeatureOverride -> Int
value :: Int
  }
  deriving (FeatureOverride -> FeatureOverride -> Bool
(FeatureOverride -> FeatureOverride -> Bool)
-> (FeatureOverride -> FeatureOverride -> Bool)
-> Eq FeatureOverride
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FeatureOverride -> FeatureOverride -> Bool
== :: FeatureOverride -> FeatureOverride -> Bool
$c/= :: FeatureOverride -> FeatureOverride -> Bool
/= :: FeatureOverride -> FeatureOverride -> Bool
Eq, Eq FeatureOverride
Eq FeatureOverride =>
(FeatureOverride -> FeatureOverride -> Ordering)
-> (FeatureOverride -> FeatureOverride -> Bool)
-> (FeatureOverride -> FeatureOverride -> Bool)
-> (FeatureOverride -> FeatureOverride -> Bool)
-> (FeatureOverride -> FeatureOverride -> Bool)
-> (FeatureOverride -> FeatureOverride -> FeatureOverride)
-> (FeatureOverride -> FeatureOverride -> FeatureOverride)
-> Ord FeatureOverride
FeatureOverride -> FeatureOverride -> Bool
FeatureOverride -> FeatureOverride -> Ordering
FeatureOverride -> FeatureOverride -> FeatureOverride
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 :: FeatureOverride -> FeatureOverride -> Ordering
compare :: FeatureOverride -> FeatureOverride -> Ordering
$c< :: FeatureOverride -> FeatureOverride -> Bool
< :: FeatureOverride -> FeatureOverride -> Bool
$c<= :: FeatureOverride -> FeatureOverride -> Bool
<= :: FeatureOverride -> FeatureOverride -> Bool
$c> :: FeatureOverride -> FeatureOverride -> Bool
> :: FeatureOverride -> FeatureOverride -> Bool
$c>= :: FeatureOverride -> FeatureOverride -> Bool
>= :: FeatureOverride -> FeatureOverride -> Bool
$cmax :: FeatureOverride -> FeatureOverride -> FeatureOverride
max :: FeatureOverride -> FeatureOverride -> FeatureOverride
$cmin :: FeatureOverride -> FeatureOverride -> FeatureOverride
min :: FeatureOverride -> FeatureOverride -> FeatureOverride
Ord, Int -> FeatureOverride -> ShowS
[FeatureOverride] -> ShowS
FeatureOverride -> String
(Int -> FeatureOverride -> ShowS)
-> (FeatureOverride -> String)
-> ([FeatureOverride] -> ShowS)
-> Show FeatureOverride
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FeatureOverride -> ShowS
showsPrec :: Int -> FeatureOverride -> ShowS
$cshow :: FeatureOverride -> String
show :: FeatureOverride -> String
$cshowList :: [FeatureOverride] -> ShowS
showList :: [FeatureOverride] -> ShowS
Show)

instance Storable FeatureOverride where
  alignment :: FeatureOverride -> Int
alignment ~FeatureOverride
_ = Int
4
{-# LINE 396 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
  sizeOf ~_ = (8)
{-# LINE 397 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
  peek ptr = do
    tag <- peekByteOff ptr ((0))
{-# LINE 399 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    value <- fromIntegral @CInt <$> peekByteOff ptr ((4))
{-# LINE 400 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    pure FeatureOverride{..}
  poke :: Ptr FeatureOverride -> FeatureOverride -> IO ()
poke Ptr FeatureOverride
ptr FeatureOverride{Int
FeatureTag
tag :: FeatureOverride -> FeatureTag
value :: FeatureOverride -> Int
tag :: FeatureTag
value :: Int
..} = do
    Ptr FeatureOverride -> Int -> FeatureTag -> IO ()
forall b. Ptr b -> Int -> FeatureTag -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr FeatureOverride
ptr ((Int
0)) FeatureTag
tag
{-# LINE 403 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    pokeByteOff ptr ((4)) $ fromIntegral @_ @CInt value
{-# LINE 404 "src/KB/Text/Shape/FFI/Structs.hsc" #-}

data GlyphParent = GlyphParent
  { GlyphParent -> Word64
decomposition :: Word64
  , GlyphParent -> Word32
codepoint :: Word32
  }
  deriving (GlyphParent -> GlyphParent -> Bool
(GlyphParent -> GlyphParent -> Bool)
-> (GlyphParent -> GlyphParent -> Bool) -> Eq GlyphParent
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: GlyphParent -> GlyphParent -> Bool
== :: GlyphParent -> GlyphParent -> Bool
$c/= :: GlyphParent -> GlyphParent -> Bool
/= :: GlyphParent -> GlyphParent -> Bool
Eq, Eq GlyphParent
Eq GlyphParent =>
(GlyphParent -> GlyphParent -> Ordering)
-> (GlyphParent -> GlyphParent -> Bool)
-> (GlyphParent -> GlyphParent -> Bool)
-> (GlyphParent -> GlyphParent -> Bool)
-> (GlyphParent -> GlyphParent -> Bool)
-> (GlyphParent -> GlyphParent -> GlyphParent)
-> (GlyphParent -> GlyphParent -> GlyphParent)
-> Ord GlyphParent
GlyphParent -> GlyphParent -> Bool
GlyphParent -> GlyphParent -> Ordering
GlyphParent -> GlyphParent -> GlyphParent
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 :: GlyphParent -> GlyphParent -> Ordering
compare :: GlyphParent -> GlyphParent -> Ordering
$c< :: GlyphParent -> GlyphParent -> Bool
< :: GlyphParent -> GlyphParent -> Bool
$c<= :: GlyphParent -> GlyphParent -> Bool
<= :: GlyphParent -> GlyphParent -> Bool
$c> :: GlyphParent -> GlyphParent -> Bool
> :: GlyphParent -> GlyphParent -> Bool
$c>= :: GlyphParent -> GlyphParent -> Bool
>= :: GlyphParent -> GlyphParent -> Bool
$cmax :: GlyphParent -> GlyphParent -> GlyphParent
max :: GlyphParent -> GlyphParent -> GlyphParent
$cmin :: GlyphParent -> GlyphParent -> GlyphParent
min :: GlyphParent -> GlyphParent -> GlyphParent
Ord, Int -> GlyphParent -> ShowS
[GlyphParent] -> ShowS
GlyphParent -> String
(Int -> GlyphParent -> ShowS)
-> (GlyphParent -> String)
-> ([GlyphParent] -> ShowS)
-> Show GlyphParent
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> GlyphParent -> ShowS
showsPrec :: Int -> GlyphParent -> ShowS
$cshow :: GlyphParent -> String
show :: GlyphParent -> String
$cshowList :: [GlyphParent] -> ShowS
showList :: [GlyphParent] -> ShowS
Show)

instance Storable GlyphParent where
  alignment :: GlyphParent -> Int
alignment ~GlyphParent
_ = Int
8
{-# LINE 413 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
  sizeOf ~_ = (16)
{-# LINE 414 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
  peek ptr = do
    decomposition <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) ptr
{-# LINE 416 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    codepoint <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) ptr
{-# LINE 417 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    pure GlyphParent{..}
  poke :: Ptr GlyphParent -> GlyphParent -> IO ()
poke Ptr GlyphParent
ptr GlyphParent{Word32
Word64
decomposition :: GlyphParent -> Word64
codepoint :: GlyphParent -> Word32
decomposition :: Word64
codepoint :: Word32
..} = do
    ((\Ptr GlyphParent
hsc_ptr -> Ptr GlyphParent -> Int -> Word64 -> IO ()
forall b. Ptr b -> Int -> Word64 -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr GlyphParent
hsc_ptr Int
0)) Ptr GlyphParent
ptr Word64
decomposition
{-# LINE 420 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) ptr codepoint
{-# LINE 421 "src/KB/Text/Shape/FFI/Structs.hsc" #-}

pattern MAXIMUM_RECOMPOSITION_PARENTS :: Int
pattern $mMAXIMUM_RECOMPOSITION_PARENTS :: forall {r}. Int -> ((# #) -> r) -> ((# #) -> r) -> r
$bMAXIMUM_RECOMPOSITION_PARENTS :: Int
MAXIMUM_RECOMPOSITION_PARENTS = 19
{-# LINE 424 "src/KB/Text/Shape/FFI/Structs.hsc" #-}

data FontCoverageTest = FontCoverageTest
  { FontCoverageTest -> Font
font :: Font
  , FontCoverageTest -> Word32
baseCodepoint :: Word32

  , FontCoverageTest -> Int
currentBaseError :: Int
  , FontCoverageTest -> Int
error :: Int

  , FontCoverageTest -> Ptr GlyphParent
baseParents :: Ptr GlyphParent -- ^ @kbts_glyph_parent BaseParents[KBTS_MAXIMUM_RECOMPOSITION_PARENTS];@
  , FontCoverageTest -> Word32
baseParentCount :: Word32
  }
  deriving (Int -> FontCoverageTest -> ShowS
[FontCoverageTest] -> ShowS
FontCoverageTest -> String
(Int -> FontCoverageTest -> ShowS)
-> (FontCoverageTest -> String)
-> ([FontCoverageTest] -> ShowS)
-> Show FontCoverageTest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FontCoverageTest -> ShowS
showsPrec :: Int -> FontCoverageTest -> ShowS
$cshow :: FontCoverageTest -> String
show :: FontCoverageTest -> String
$cshowList :: [FontCoverageTest] -> ShowS
showList :: [FontCoverageTest] -> ShowS
Show)

instance Storable FontCoverageTest where
  alignment :: FontCoverageTest -> Int
alignment ~FontCoverageTest
_ = Int
8
{-# LINE 439 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
  sizeOf ~_ = (336)
{-# LINE 440 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
  peek ptr = do
    font <- ((\hsc_ptr -> peekByteOff hsc_ptr 0)) ptr
{-# LINE 442 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    baseCodepoint <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) ptr
{-# LINE 443 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    currentBaseError <- fromIntegral @CInt <$> ((\hsc_ptr -> peekByteOff hsc_ptr 12)) ptr
{-# LINE 444 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    error <- fromIntegral @CInt <$> ((\hsc_ptr -> peekByteOff hsc_ptr 16)) ptr
{-# LINE 445 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    baseParents <- ((\hsc_ptr -> peekByteOff hsc_ptr 24)) ptr
{-# LINE 446 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    baseParentCount <- ((\hsc_ptr -> peekByteOff hsc_ptr 328)) ptr
{-# LINE 447 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    pure FontCoverageTest{..}
  poke :: Ptr FontCoverageTest -> FontCoverageTest -> IO ()
poke Ptr FontCoverageTest
ptr FontCoverageTest{Int
Word32
Ptr GlyphParent
Font
font :: FontCoverageTest -> Font
baseCodepoint :: FontCoverageTest -> Word32
currentBaseError :: FontCoverageTest -> Int
error :: FontCoverageTest -> Int
baseParents :: FontCoverageTest -> Ptr GlyphParent
baseParentCount :: FontCoverageTest -> Word32
font :: Font
baseCodepoint :: Word32
currentBaseError :: Int
error :: Int
baseParents :: Ptr GlyphParent
baseParentCount :: Word32
..} = do
    ((\Ptr FontCoverageTest
hsc_ptr -> Ptr FontCoverageTest -> Int -> Font -> IO ()
forall b. Ptr b -> Int -> Font -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr FontCoverageTest
hsc_ptr Int
0)) Ptr FontCoverageTest
ptr Font
font
{-# LINE 450 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) ptr baseCodepoint
{-# LINE 451 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 12)) ptr $ fromIntegral @_ @CInt currentBaseError
{-# LINE 452 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 16)) ptr $ fromIntegral @_ @CInt error
{-# LINE 453 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 24)) ptr baseParents
{-# LINE 454 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 328)) ptr baseParentCount
{-# LINE 455 "src/KB/Text/Shape/FFI/Structs.hsc" #-}

data Break = Break
  { Break -> Int
position :: Int
    {- ^
      The break code mostly works in relative positions, but we convert to absolute positions for the user.
      That way, breaks can be trivially stored and compared and such and it just works.
    -}
  , Break -> BreakFlags
flags :: BreakFlags
  , Break -> Direction
direction :: Direction -- ^ Only valid if 'KBTS_BREAK_FLAG_DIRECTION' is set.
  , Break -> Direction
paragraphDirection :: Direction -- ^ Only valid if 'KBTS_BREAK_FLAG_PARAGRAPH_DIRECTION' is set.
  , Break -> Script
script :: Script -- ^ Only valid if 'KBTS_BREAK_FLAG_SCRIPT' is set.
  }
  deriving (Int -> Break -> ShowS
[Break] -> ShowS
Break -> String
(Int -> Break -> ShowS)
-> (Break -> String) -> ([Break] -> ShowS) -> Show Break
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Break -> ShowS
showsPrec :: Int -> Break -> ShowS
$cshow :: Break -> String
show :: Break -> String
$cshowList :: [Break] -> ShowS
showList :: [Break] -> ShowS
Show, Break -> Break -> Bool
(Break -> Break -> Bool) -> (Break -> Break -> Bool) -> Eq Break
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Break -> Break -> Bool
== :: Break -> Break -> Bool
$c/= :: Break -> Break -> Bool
/= :: Break -> Break -> Bool
Eq)

instance Storable Break where
  alignment :: Break -> Int
alignment ~Break
_ = Int
4
{-# LINE 471 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
  sizeOf ~_ = (20)
{-# LINE 472 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
  peek ptr = do
    position <- fromIntegral @CInt <$> ((\hsc_ptr -> peekByteOff hsc_ptr 0)) ptr
{-# LINE 474 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    flags <- ((\hsc_ptr -> peekByteOff hsc_ptr 4)) ptr
{-# LINE 475 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    direction <- ((\hsc_ptr -> peekByteOff hsc_ptr 8)) ptr
{-# LINE 476 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    paragraphDirection <- ((\hsc_ptr -> peekByteOff hsc_ptr 12)) ptr
{-# LINE 477 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    script <- ((\hsc_ptr -> peekByteOff hsc_ptr 16)) ptr
{-# LINE 478 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    pure Break{..}
  poke :: Ptr Break -> Break -> IO ()
poke Ptr Break
ptr Break{Int
Script
Direction
BreakFlags
position :: Break -> Int
flags :: Break -> BreakFlags
direction :: Break -> Direction
paragraphDirection :: Break -> Direction
script :: Break -> Script
position :: Int
flags :: BreakFlags
direction :: Direction
paragraphDirection :: Direction
script :: Script
..} = do
    ((\Ptr Break
hsc_ptr -> Ptr Break -> Int -> CInt -> IO ()
forall b. Ptr b -> Int -> CInt -> IO ()
forall a b. Storable a => Ptr b -> Int -> a -> IO ()
pokeByteOff Ptr Break
hsc_ptr Int
0)) Ptr Break
ptr (CInt -> IO ()) -> CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral @_ @CInt Int
position
{-# LINE 481 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 4)) ptr flags
{-# LINE 482 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 8)) ptr direction
{-# LINE 483 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 12)) ptr paragraphDirection
{-# LINE 484 "src/KB/Text/Shape/FFI/Structs.hsc" #-}
    ((\hsc_ptr -> pokeByteOff hsc_ptr 16)) ptr script
{-# LINE 485 "src/KB/Text/Shape/FFI/Structs.hsc" #-}