4 files changed, 290 insertions(+), 90 deletions(-)

M Data/Text/Glyphize.hs
M Data/Text/Glyphize/Buffer.hs
M Data/Text/Glyphize/Font.hs
M Main.hs

@@ 3,21 3,73 @@ module Data.Text.Glyphize where
 import Data.Text.Glyphize.Buffer
 import Data.Text.Glyphize.Font
 
+import Data.Word
+
 import Foreign.Ptr
 import Foreign.ForeignPtr
+import Foreign.Marshal.Alloc
+import Foreign.Storable
+import Foreign.C.String
+import Control.Monad (forM)
 import System.IO.Unsafe (unsafePerformIO)
 
-foreign import ccall "hb_shape" hb_shape :: Font_ -> Buffer_ -> Ptr () -> Int -> IO ()
+foreign import ccall "hb_shape" hb_shape :: Font_ -> Buffer_ -> Ptr Feature -> Int -> IO ()
+
+-- | Compute which glyphs from the provided font should be rendered where to
+-- depict the given buffer of text.
 shape :: Font -> Buffer -> [(GlyphInfo, GlyphPos)]
-shape font buf = unsafePerformIO $ do
-  buf_ <- freeze' buf
-  withForeignPtr font $ \font' -> withForeignPtr buf_ $ \buf' ->
-    hb_shape font' buf' nullPtr 0
-  infos <- glyphInfos' buf_
-  pos <- glyphsPos' buf_
-  return $ zip infos pos
--- Defer implementing font features...
-
--- version :: (Int, Int, Int)
--- versionAtLeast :: (Int, Int, Int) -> Bool
--- versionString :: ShortString
+shape font buf = shapeWithFeatures font buf []
+
+data Feature = Feature {
+    tag :: String,
+    value :: Word32,
+    start :: Word,
+    end :: Word
+}
+instance Storable Feature where
+    sizeOf _ = sizeOf (undefined :: Word32) * 2 + sizeOf (undefined :: Word) * 2
+    alignment _ = alignment (undefined :: Word32)
+    peek p = do
+        let q = castPtr p
+        tag' <- peek q
+        val' <- peekElemOff q 1
+        let r = castPtr $ plusPtr p (sizeOf (undefined :: Word32) * 2)
+        start' <- peek r
+        end' <- peekElemOff r 1
+        return $ Feature (hb_tag_to_string tag') val' start' end'
+
+    poke p (Feature tag' val' start' end') = do
+        let q = castPtr p
+        poke q $ hb_tag_from_string tag'
+        pokeElemOff q 1 val'
+        let r = castPtr $ plusPtr p (sizeOf (undefined :: Word32) * 2)
+        poke r start'
+        pokeElemOff r 1 end'
+
+-- | Variant of `shape` specifying OpenType features to apply.
+-- If two features have the same tag but overlapping ranges, the one with a
+-- higher index takes precedance.
+shapeWithFeatures :: Font -> Buffer -> [Feature] -> [(GlyphInfo, GlyphPos)]
+shapeWithFeatures font buf feats = unsafePerformIO $ do
+    buf_ <- freeze' buf
+    allocaBytes (sizeOf (undefined :: Feature) * length feats) $ \arr' -> do
+        forM (zip [0..] feats) $ \(i, feat) -> pokeElemOff arr' i feat
+        withForeignPtr font $ \font' -> withForeignPtr buf_ $ \buf' ->
+            hb_shape font' buf' arr' $ length feats
+    infos <- glyphInfos' buf_
+    pos <- glyphsPos' buf_
+    return $ zip infos pos
+
+foreign import ccall "hb_version" hb_version :: Ptr Int -> Ptr Int -> Ptr Int -> IO ()
+version :: (Int, Int, Int)
+version = unsafePerformIO $
+    alloca $ \a' -> alloca $ \b' -> alloca $ \c' -> do
+        hb_version a' b' c'
+        a <- peek a'
+        b <- peek b'
+        c <- peek c'
+        return (a, b, c)
+foreign import ccall "hb_version_atleast" versionAtLeast :: Int -> Int -> Int -> Bool
+foreign import ccall "hb_version_string" hb_version_string :: CString
+versionString :: String
+versionString = unsafePerformIO $ peekCString hb_version_string

@@ 3,7 3,7 @@ module Data.Text.Glyphize.Buffer where
 import Data.Text.Lazy as Lazy hiding (toUpper, toLower)
 import Data.ByteString.Lazy as Lazy hiding (toUpper, toLower)
 import Data.ByteString.Lazy as LBS
-import Data.Text.Short as Short
+import Data.Int
 
 import Foreign.ForeignPtr
 import Foreign.Ptr


@@ 39,11 39,11 @@ data Buffer = Buffer {
     -- the direction, for example, reversing RTL text before shaping,
     -- then shaping with LTR direction is not the same as keeping the text in
     -- logical order and shaping with RTL direction.
-    script :: Maybe ShortText,
+    script :: Maybe String,
     -- ^ Script is crucial for choosing the proper shaping behaviour for scripts
     -- that require it (e.g. Arabic) and the which OpenType features defined in
     -- the font to be applied.
-    language :: Maybe ShortText,
+    language :: Maybe String,
     -- ^ Languages are crucial for selecting which OpenType feature to apply to
     -- the buffer which can result in applying language-specific behaviour.
     -- Languages are orthogonal to the scripts, and though they are related,


@@ 101,7 101,16 @@ data ClusterLevel = ClusterMonotoneGraphemes | ClusterMonotoneChars | ClusterCha
 
 data GlyphInfo = GlyphInfo {
     codepoint :: Word32,
+    -- ^ Glyph index (or unicode codepoint)
     cluster :: Word32
+    -- ^ The index of the character in the original text that corresponds to
+    -- this `GlyphInfo`. More than one `GlyphInfo` may have the same `cluster`
+    -- value if they resulted from the same character, & when more than one
+    -- character gets merged into the same glyph `GlyphInfo` will have the
+    -- smallest cluster value of them.
+    -- By default some characters are merged into the same cluster even when
+    -- they are seperate glyphs, `Buffer`'s `clusterLevel` property allows
+    -- selecting more fine grained cluster handling.
 } deriving (Show, Read, Eq)
 instance Storable GlyphInfo where
     sizeOf _ = 2 * sizeOf (undefined :: Word32)


@@ 116,12 125,22 @@ instance Storable GlyphInfo where
         pokeElemOff q 1 b
 
 data GlyphPos = GlyphPos {
-    x_advance :: Word32, y_advance :: Word32,
-    x_offset :: Word32, y_offset :: Word32
+    x_advance :: Int32,
+    -- ^ How much the line advances after drawing this glyph when setting text
+    -- in horizontal direction.
+    y_advance :: Int32,
+    -- ^ How much the line advances after drawing this glyph when setting text
+    -- in vertical direction.
+    x_offset :: Int32,
+    -- ^ How much the glyph moves on the X-axis before drawing it, this should
+    -- not effect how much the line advances.
+    y_offset :: Int32
+    -- ^ How much the glyph moves on the Y-axis before drawing it, this should
+    -- not effect how much the line advances.
 } deriving (Show, Read, Eq)
 instance Storable GlyphPos where
-    sizeOf _ = 4 * sizeOf (undefined :: Word32)
-    alignment _ = alignment (undefined :: Word32)
+    sizeOf _ = 4 * sizeOf (undefined :: Int32)
+    alignment _ = alignment (undefined :: Int32)
     peek p = do
         q <- return $ castPtr p
         xa <- peek q


@@ 138,9 157,9 @@ instance Storable GlyphPos where
 
 guessSegmentProperties :: Buffer -> Buffer
 guessSegmentProperties = thaw . freeze
-scriptHorizontalDir :: ShortText -> Maybe Direction
+scriptHorizontalDir :: String -> Maybe Direction
 scriptHorizontalDir script =
-    int2dir $ hb_script_get_horizontal_direction $ hb_script_from_txt script
+    int2dir $ hb_script_get_horizontal_direction $ hb_script_from_string script
 
 int2dir 4 = Just DirLTR
 int2dir 5 = Just DirRTL


@@ 168,7 187,9 @@ type Buffer' = ForeignPtr Buffer''
 data Buffer''
 type Buffer_ = Ptr Buffer''
 
+-- | Converts from a Haskell `Buffer` representation into a C representation used internally.
 freeze = unsafePerformIO . freeze'
+-- | Variant of `freeze` for use in IO code.
 freeze' buf = do
     buffer <- hb_buffer_create
     case text buf of


@@ 183,10 204,10 @@ freeze' buf = do
         Just ContentTypeGlyphs -> 2
     hb_buffer_set_direction buffer $ dir2int $ direction buf
     case script buf of
-        Just script' -> hb_buffer_set_script buffer $ hb_script_from_txt script'
+        Just script' -> hb_buffer_set_script buffer $ hb_script_from_string script'
         Nothing -> return ()
     case language buf of
-        Just lang' -> hb_buffer_set_language buffer =<< hb_language_from_txt lang'
+        Just lang' -> hb_buffer_set_language buffer =<< hb_language_from_string lang'
         Nothing -> return ()
     hb_buffer_set_flags buffer $ Prelude.foldl (.|.) 0 [
         if beginsText buf then 1 else 0,


@@ 207,25 228,34 @@ freeze' buf = do
         (Just ContentTypeUnicode, _, _, Nothing) -> hb_buffer_guess_segment_properties buffer
     newForeignPtr hb_buffer_destroy buffer
 
+-- | The Buffer's glyph information list.
 glyphInfos :: Buffer' -> [GlyphInfo]
 glyphInfos = unsafePerformIO . glyphInfos'
+-- | Variant of `glyphInfos` for use in IO code.
 glyphInfos' :: Buffer' -> IO [GlyphInfo]
 glyphInfos' buf' = alloca $ \length' -> do
     arr <- withForeignPtr buf' $ \buf'' -> hb_buffer_get_glyph_infos buf'' length'
     length <- peek length'
     if length == 0
     then return []
-    else forM [0..length - 1] $ peekElemOff arr
+    else forM [0..fromEnum length - 1] $ peekElemOff arr
+-- | The Buffer's glyph position list. If not already computed defaults to all 0s.
+glyphsPos :: Buffer' -> [GlyphPos]
 glyphsPos = unsafePerformIO . glyphsPos'
+-- | Variant of `glyphsPos` for use in IO code.
+glyphsPos' :: Buffer' -> IO [GlyphPos]
 glyphsPos' buf' = alloca $ \length' -> do
       arr <- withForeignPtr buf' $ \buf'' -> hb_buffer_get_glyph_positions buf'' length'
       length <- peek length'
       if length == 0
       then return []
-      else forM [0..length-1] $ peekElemOff arr
+      else forM [0..fromEnum length-1] $ peekElemOff arr
 
+-- | Converts from the C representation of a Buffer used internally back into a
+-- pure-Haskell representation.
 thaw :: Buffer' -> Buffer
 thaw = unsafePerformIO . thaw'
+-- | Variant of `thaw` for use in IO code.
 thaw' buf' = do
     let getter cb = unsafeInterleaveIO $ withForeignPtr buf' cb
     glyphInfos' <- glyphInfos' buf'


@@ 246,8 276,8 @@ thaw' buf' = do
             2 -> Just ContentTypeGlyphs
             _ -> Nothing,
         direction = int2dir direction',
-        language = Just $ Short.fromString language',
-        script = Just $ Short.fromString $ hb_tag_to_string script',
+        language = Just language',
+        script = Just $ hb_tag_to_string script',
         beginsText = testBit flags' 0, endsText = testBit flags' 1,
         preserveDefaultIgnorables = testBit flags' 2,
         removeDefaultIgnorables = testBit flags' 3,


@@ 298,16 328,15 @@ hb_script_from_string str = hb_tag_from_string $ case titlecase str of
     'S':'y':'r':'e':_ -> "Syrc"
     'S':'y':'r':'j':_ -> "Syrc"
     'S':'y':'r':'n':_ -> "Syrc"
-hb_script_from_txt txt = hb_script_from_string $ Short.toString txt
 foreign import ccall "hb_buffer_set_script" hb_buffer_set_script
     :: Buffer_ -> Word32 -> IO ()
 foreign import ccall "hb_script_get_horizontal_direction" hb_script_get_horizontal_direction
     :: Word32 -> Int
-foreign import ccall "hb_language_from_string" hb_language_from_string
-    :: Ptr Word8 -> Int -> Int
-hb_language_from_txt txt = let Strict.PS ptr offset size = toByteString txt
-    in withForeignPtr ptr $ \ptr' -> return $
-        hb_language_from_string (plusPtr ptr' offset) (size - offset)
+foreign import ccall "hb_language_from_string" hb_language_from_string'
+    :: CString -> Int -> IO Int
+hb_language_from_string :: String -> IO Int
+hb_language_from_string str =
+    withCString str $ \str' -> hb_language_from_string' str' (-1)
 foreign import ccall "hb_buffer_set_language" hb_buffer_set_language
     :: Buffer_ -> Int -> IO ()
 foreign import ccall "hb_buffer_set_flags" hb_buffer_set_flags :: Buffer_ -> Int -> IO ()


@@ 338,9 367,9 @@ foreign import ccall "hb_buffer_get_flags" hb_buffer_get_flags :: Buffer_ -> IO 
 foreign import ccall "hb_buffer_get_cluster_level" hb_buffer_get_cluster_level
     :: Buffer_ -> IO Int
 foreign import ccall "hb_buffer_get_glyph_infos" hb_buffer_get_glyph_infos
-    :: Buffer_ -> Ptr Int -> IO (Ptr GlyphInfo)
+    :: Buffer_ -> Ptr Word -> IO (Ptr GlyphInfo)
 foreign import ccall "hb_buffer_get_glyph_positions" hb_buffer_get_glyph_positions
-    :: Buffer_ -> Ptr Int -> IO (Ptr GlyphPos)
+    :: Buffer_ -> Ptr Word -> IO (Ptr GlyphPos)
 foreign import ccall "hb_buffer_get_invisible_glyph" hb_buffer_get_invisible_glyph
     :: Buffer_ -> IO Word32
 foreign import ccall "hb_buffer_get_replacement_codepoint" hb_buffer_get_replacement_codepoint

@@ 2,9 2,8 @@
 module Data.Text.Glyphize.Font where
 
 import Data.ByteString
-import Data.Text.Short
 import FreeType.Core.Base
-import Data.Text.Glyphize.Buffer (Direction(..), dir2int)
+import Data.Text.Glyphize.Buffer (Direction(..), dir2int, hb_tag_to_string)
 
 import System.IO.Unsafe (unsafePerformIO)
 import Foreign.Ptr


@@ 26,15 25,15 @@ type Face = ForeignPtr Face'
 type Face_ = Ptr Face'
 data Face'
 
-foreign import ccall "hb_face_count" hb_face_count :: Blob_ -> IO Int
-countFace :: ByteString -> Int
+foreign import ccall "hb_face_count" hb_face_count :: Blob_ -> IO Word
+countFace :: ByteString -> Word
 countFace bytes = unsafePerformIO $ do
     blob <- bs2blob bytes
     withForeignPtr blob hb_face_count
 
-foreign import ccall "hb_face_create" hb_face_create :: Blob_ -> Int -> IO Face_
+foreign import ccall "hb_face_create" hb_face_create :: Blob_ -> Word -> IO Face_
 foreign import ccall "&hb_face_destroy" hb_face_destroy :: FunPtr (Face_ -> IO ())
-createFace :: ByteString -> Int -> Face
+createFace :: ByteString -> Word -> Face
 createFace bytes index = unsafePerformIO $ do
     blob <- bs2blob bytes
     face <- withForeignPtr blob $ flip hb_face_create index


@@ 50,17 49,49 @@ foreign import ccall "hb_face_get_empty" hb_face_get_empty :: Face_
 emptyFace :: Face
 emptyFace = unsafePerformIO $ newForeignPtr hb_face_destroy hb_face_get_empty
 
-foreign import ccall "hb_face_get_glyph_count" hb_face_get_glyph_count :: Face_ -> Int
-faceGlyphCount :: Face -> Int
+foreign import ccall "hb_face_get_table_tags" hb_face_get_table_tags
+    :: Face_ -> Word -> Ptr Word -> Ptr Word32 -> IO Word
+faceTableTags :: Face -> Word -> Word -> (Word, [String])
+faceTableTags fce offs cnt = unsafePerformIO $ withForeignPtr fce $ \fce' -> do
+    alloca $ \cnt' -> allocaBytes (fromEnum cnt * 4) $ \arr' -> do
+        poke cnt' cnt
+        length <- hb_face_get_table_tags fce' offs cnt' arr'
+        cnt_ <- peek cnt'
+        arr <- forM [0..fromEnum cnt_-1] $ peekElemOff arr'
+        return (length, Prelude.map hb_tag_to_string arr)
+
+foreign import ccall "hb_face_get_glyph_count" hb_face_get_glyph_count :: Face_ -> Word
+faceGlyphCount :: Face -> Word
 faceGlyphCount = faceFunc hb_face_get_glyph_count
 
-foreign import ccall "hb_face_get_index" hb_face_get_index :: Face_ -> Int
-faceIndex :: Face -> Int
+foreign import ccall "hb_face_collect_unicodes" hb_face_collect_unicodes
+    :: Face_ -> Set_ -> IO ()
+faceCollectUnicodes :: Face -> [Word32]
+faceCollectUnicodes = faceCollectFunc hb_face_collect_unicodes
+
+foreign import ccall "hb_face_collect_variation_selectors"
+    hb_face_collect_variation_selectors :: Face_ -> Set_ -> IO ()
+faceCollectVarSels :: Face -> [Word32]
+faceCollectVarSels = faceCollectFunc hb_face_collect_variation_selectors
+
+foreign import ccall "hb_face_collect_variation_unicodes"
+    hb_face_collect_variation_unicodes :: Face_ -> Word32 -> Set_ -> IO ()
+faceCollectVarUnicodes :: Face -> Word32 -> [Word32]
+faceCollectVarUnicodes fce varSel = unsafePerformIO $ withForeignPtr fce $ \fce' -> do
+    set <- createSet
+    withForeignPtr set $ hb_face_collect_variation_unicodes fce' varSel
+    set2list set
+
+foreign import ccall "hb_face_get_index" hb_face_get_index :: Face_ -> Word
+faceIndex :: Face -> Word
 faceIndex = faceFunc hb_face_get_index
 
-foreign import ccall "hb_face_get_upem" hb_face_get_upem :: Face_ -> Int
-faceUpem :: Face -> Int
+foreign import ccall "hb_face_get_upem" hb_face_get_upem :: Face_ -> Word
+-- | units-per-em
+faceUpem :: Face -> Word
 faceUpem = faceFunc hb_face_get_upem
+
+
 -- Defer implementation of other functions...
 
 ---


@@ 142,8 173,8 @@ data GlyphExtents = GlyphExtents {
     width :: Word32, height :: Word32
 }
 instance Storable GlyphExtents where
-    sizeOf (GlyphExtents a _ _ _) = 4 * sizeOf a
-    alignment (GlyphExtents a _ _ _) = alignment a
+    sizeOf _ = 4 * sizeOf (undefined :: Word32)
+    alignment _ = alignment (undefined :: Word32)
     peek p = do
         q <- return $ castPtr p
         x <- peek q


@@ 180,30 211,29 @@ fontGlyphExtentsForOrigin font glyph dir = unsafePerformIO $
         else return Nothing
 
 foreign import ccall "hb_font_get_glyph_from_name" hb_font_get_glyph_from_name
-    :: Font_ -> Ptr Word8 -> Int -> Ptr Word32 -> IO Bool
-fontGlyphFromName :: Font -> ShortText -> Maybe Word32
+    :: Font_ -> CString -> Int -> Ptr Word32 -> IO Bool
+fontGlyphFromName :: Font -> String -> Maybe Word32
 fontGlyphFromName font name = unsafePerformIO $
     withForeignPtr font $ \font' -> alloca $ \ret -> do
-        let PS ptr offset size = toByteString name
-        success <- withForeignPtr ptr $ \ptr' ->
-            hb_font_get_glyph_from_name font' (plusPtr ptr' offset) (size - offset) ret
+        success <- withCString name $ \name' ->
+            hb_font_get_glyph_from_name font' name' (-1) ret
         if success
         then return . Just =<< peek ret
         else return Nothing
 
 foreign import ccall "hb_font_get_glyph_h_advance" hb_font_get_glyph_h_advance
-    :: Font_ -> Word32 -> Word32
-fontGlyphHAdvance :: Font -> Word32 -> Word32
+    :: Font_ -> Word32 -> Int32
+fontGlyphHAdvance :: Font -> Word32 -> Int32
 fontGlyphHAdvance = fontFunc hb_font_get_glyph_h_advance
 
 foreign import ccall "hb_font_get_glyph_h_kerning" hb_font_get_glyph_h_kerning
-    :: Font_ -> Word32 -> Word32 -> Word32
-fontGlyphHKerning :: Font -> Word32 -> Word32 -> Word32
+    :: Font_ -> Word32 -> Word32 -> Int32
+fontGlyphHKerning :: Font -> Word32 -> Word32 -> Int32
 fontGlyphHKerning = fontFunc hb_font_get_glyph_h_kerning
 
 foreign import ccall "hb_font_get_glyph_h_origin" hb_font_get_glyph_h_origin
-    :: Font_ -> Word32 -> Ptr Word32 -> Ptr Word32 -> IO Bool
-fontGlyphHOrigin :: Font -> Word32 -> Maybe (Word32, Word32)
+    :: Font_ -> Word32 -> Ptr Int32 -> Ptr Int32 -> IO Bool
+fontGlyphHOrigin :: Font -> Word32 -> Maybe (Int32, Int32)
 fontGlyphHOrigin font glyph = unsafePerformIO $
     withForeignPtr font $ \font' -> alloca $ \x' -> alloca $ \y' -> do
         success <- hb_font_get_glyph_h_origin font' glyph x' y'


@@ 216,8 246,8 @@ fontGlyphHOrigin font glyph = unsafePerformIO $
 
 foreign import ccall "hb_font_get_glyph_kerning_for_direction"
     hb_font_get_glyph_kerning_for_direction
-        :: Font_ -> Word32 -> Word32 -> Int -> Ptr Word32 -> Ptr Word32 -> IO ()
-fontGlyphKerningForDir :: Font -> Word32 -> Word32 -> Maybe Direction -> (Word32, Word32)
+        :: Font_ -> Word32 -> Word32 -> Int -> Ptr Int32 -> Ptr Int32 -> IO ()
+fontGlyphKerningForDir :: Font -> Word32 -> Word32 -> Maybe Direction -> (Int32, Int32)
 fontGlyphKerningForDir font glyph1 glyph2 dir = unsafePerformIO $
     withForeignPtr font $ \font' -> alloca $ \x' -> alloca $ \y' -> do
         hb_font_get_glyph_kerning_for_direction font' glyph1 glyph2 (dir2int dir) x' y'


@@ 226,10 256,10 @@ fontGlyphKerningForDir font glyph1 glyph2 dir = unsafePerformIO $
         return (x, y)
 
 foreign import ccall "hb_font_get_glyph_name" hb_font_get_glyph_name
-    :: Font_ -> Word32 -> CString -> Int -> IO Bool
-fontGlyphName :: Font -> Word32 -> Int -> Maybe String
-fontGlyphName font glyph length = unsafePerformIO $
-    withForeignPtr font $ \font' -> allocaBytes length $ \ret -> do
+    :: Font_ -> Word32 -> CString -> Word -> IO Bool
+fontGlyphName :: Font -> Word32 -> Word -> Maybe String
+fontGlyphName font glyph length = let lengthi = fromEnum length in unsafePerformIO $
+    withForeignPtr font $ \font' -> allocaBytes lengthi $ \ret -> do
         success <- hb_font_get_glyph_name font' glyph ret length
         if success
         then return . Just =<< peekCString ret


@@ 237,8 267,8 @@ fontGlyphName font glyph length = unsafePerformIO $
 
 foreign import ccall "hb_font_get_glyph_origin_for_direction"
     hb_font_get_glyph_origin_for_direction
-        :: Font_ -> Word32 -> Int -> Ptr Word32 -> Ptr Word32 -> IO ()
-fontGlyphOriginForDir :: Font -> Word32 -> Maybe Direction -> (Word32, Word32)
+        :: Font_ -> Word32 -> Int -> Ptr Int32 -> Ptr Int32 -> IO ()
+fontGlyphOriginForDir :: Font -> Word32 -> Maybe Direction -> (Int32, Int32)
 fontGlyphOriginForDir font glyph dir = unsafePerformIO $
     withForeignPtr font $ \font' -> alloca $ \x' -> alloca $ \y' -> do
         hb_font_get_glyph_origin_for_direction font' glyph (dir2int dir) x' y'


@@ 247,13 277,13 @@ fontGlyphOriginForDir font glyph dir = unsafePerformIO $
         return (x, y)
 
 foreign import ccall "hb_font_get_glyph_v_advance"
-    hb_font_get_glyph_v_advance :: Font_ -> Word32 -> Word32
-fontGlyphVAdvance :: Font -> Word32 -> Word32
+    hb_font_get_glyph_v_advance :: Font_ -> Word32 -> Int32
+fontGlyphVAdvance :: Font -> Word32 -> Int32
 fontGlyphVAdvance = fontFunc hb_font_get_glyph_v_advance
 
 foreign import ccall "hb_font_get_glyph_v_origin" hb_font_get_glyph_v_origin
-    :: Font_ -> Word32 -> Ptr Word32 -> Ptr Word32 -> IO Bool
-fontGlyphVOrigin :: Font -> Word32 -> Maybe (Word32, Word32)
+    :: Font_ -> Word32 -> Ptr Int32 -> Ptr Int32 -> IO Bool
+fontGlyphVOrigin :: Font -> Word32 -> Maybe (Int32, Int32)
 fontGlyphVOrigin font glyph = unsafePerformIO $
     withForeignPtr font $ \font' -> alloca $ \x' -> alloca $ \y' -> do
         success <- hb_font_get_glyph_v_origin font' glyph x' y'


@@ 275,8 305,8 @@ fontNominalGlyph font char = unsafePerformIO $
         else return Nothing
 
 foreign import ccall "hb_font_get_ppem" hb_font_get_ppem
-    :: Font_ -> Ptr Int -> Ptr Int -> IO ()
-fontPPEm :: Font -> (Int, Int)
+    :: Font_ -> Ptr Word -> Ptr Word -> IO ()
+fontPPEm :: Font -> (Word, Word)
 fontPPEm font = unsafePerformIO $
     withForeignPtr font $ \font' -> alloca $ \x' -> alloca $ \y' -> do
         hb_font_get_ppem font' x' y'


@@ 298,23 328,32 @@ fontScale font = unsafePerformIO $
         y <- peek y'
         return (x, y)
 
+foreign import ccall "hb_font_get_variation_glyph" hb_font_get_variation_glyph
+    :: Font_ -> Word32 -> Word32 -> Ptr Word32 -> IO Bool
+fontVarGlyph :: Font -> Word32 -> Word32 -> Maybe Word32
+fontVarGlyph font unicode varSel = unsafePerformIO $
+    withForeignPtr font $ \font' -> alloca $ \glyph' -> do
+        success <- hb_font_get_variation_glyph font' unicode varSel glyph'
+        if success
+        then return . Just =<< peek glyph'
+        else return Nothing
+
 foreign import ccall "hb_font_get_var_coords_normalized"
-    hb_font_get_var_coords_normalized :: Font_ -> Ptr Int -> IO (Ptr Int)
+    hb_font_get_var_coords_normalized :: Font_ -> Ptr Word -> IO (Ptr Int)
 fontVarCoordsNormalized :: Font -> [Int]
 fontVarCoordsNormalized font = unsafePerformIO $
     withForeignPtr font $ \font' -> alloca $ \length' -> do
         arr <- hb_font_get_var_coords_normalized font' length'
         length <- peek length'
-        forM [0..length-1] $ peekElemOff arr
+        forM [0..fromEnum length-1] $ peekElemOff arr
 
 foreign import ccall "hb_font_glyph_from_string" hb_font_glyph_from_string
-    :: Font_ -> Ptr Word8 -> Int -> Ptr Word32 -> IO Bool
-fontTxt2Glyph :: Font -> ShortText -> Maybe Word32
-fontTxt2Glyph font txt = unsafePerformIO $
+    :: Font_ -> CString -> Int -> Ptr Word32 -> IO Bool
+fontTxt2Glyph :: Font -> String -> Maybe Word32
+fontTxt2Glyph font str = unsafePerformIO $
     withForeignPtr font $ \font' -> alloca $ \ret -> do
-        let PS ptr offset size = toByteString txt
-        ok <- withForeignPtr ptr $ \ptr' ->
-            hb_font_glyph_from_string font' (plusPtr ptr' offset) (size - offset) ret
+        ok <- withCString str $ \str' ->
+            hb_font_glyph_from_string font' str' (-1) ret
         if ok
         then return . Just =<< peek ret
         else return Nothing


@@ 327,10 366,55 @@ fontGlyph2Str font glyph length = unsafePerformIO $
         hb_font_glyph_to_string font' glyph ret length
         peekCString ret
 
+data FontExtents = FontExtents {
+    ascender :: Int32,
+    descender :: Int32,
+    lineGap :: Int32
+}
+
+instance Storable FontExtents where
+    sizeOf _ = sizeOf (undefined :: Int32) * 3
+    alignment _ = alignment (undefined :: Int32)
+    peek p = do
+        let q = castPtr p
+        asc <- peek q
+        desc <- peekElemOff q 1
+        gap <- peekElemOff q 2
+        return $ FontExtents asc desc gap
+    poke p (FontExtents asc desc gap) = do
+        let q = castPtr p
+        poke q asc
+        pokeElemOff q 1 desc
+        pokeElemOff q 2 gap
+
+foreign import ccall "hb_font_get_extents_for_direction"
+    hb_font_get_extents_for_direction :: Font_ -> Int -> Ptr FontExtents -> IO ()
+fontExtentsForDir :: Font -> Maybe Direction -> FontExtents
+fontExtentsForDir font dir = unsafePerformIO $ alloca $ \ret -> do
+    withForeignPtr font $ \font' ->
+        hb_font_get_extents_for_direction font' (dir2int dir) ret
+    peek ret
+
+foreign import ccall "hb_font_get_h_extents" hb_font_get_h_extents
+    :: Font_ -> Ptr FontExtents -> IO Bool
+fontHExtents font = unsafePerformIO $ alloca $ \ret -> do
+    ok <- withForeignPtr font $ \font' -> hb_font_get_h_extents font' ret
+    if ok
+    then return . Just =<< peek ret
+    else return Nothing
+
+foreign import ccall "hb_font_get_v_extents" hb_font_get_v_extents
+    :: Font_ -> Ptr FontExtents -> IO Bool
+fontVExtents font = unsafePerformIO $ alloca $ \ret -> do
+    ok <- withForeignPtr font $ \font' -> hb_font_get_v_extents font' ret
+    if ok
+    then return . Just =<< peek ret
+    else return Nothing
+
 ---
 
 data FontOptions = FontOptions {
-    optionPPEm :: Maybe (Int, Int),
+    optionPPEm :: Maybe (Word, Word),
     optionPtEm :: Maybe Float,
     optionScale :: Maybe (Int, Int)
 }


@@ 364,7 448,7 @@ ftCreateFontWithOptions opts fce = unsafePerformIO $ do
     hb_font_make_immutable font
     newForeignPtr hb_font_destroy font
 
-foreign import ccall "hb_font_set_ppem" hb_font_set_ppem :: Font_ -> Int -> Int -> IO ()
+foreign import ccall "hb_font_set_ppem" hb_font_set_ppem :: Font_ -> Word -> Word -> IO ()
 foreign import ccall "hb_font_set_ptem" hb_font_set_ptem :: Font_ -> Float -> IO ()
 foreign import ccall "hb_font_set_scale" hb_font_set_scale :: Font_ -> Int -> Int -> IO ()
 


@@ 396,3 480,34 @@ faceFunc cb fce = unsafePerformIO $ withForeignPtr fce $ return . cb
 
 fontFunc :: (Font_ -> a) -> (Font -> a)
 fontFunc cb fnt = unsafePerformIO $ withForeignPtr fnt $ return . cb
+
+data Set'
+type Set = ForeignPtr Set'
+type Set_ = Ptr Set'
+foreign import ccall "hb_set_create" hb_set_create :: IO Set_
+foreign import ccall "&hb_set_destroy" hb_set_destroy :: FunPtr (Set_ -> IO ())
+
+createSet :: IO Set
+createSet = do
+    ret <- hb_set_create
+    newForeignPtr hb_set_destroy ret
+
+foreign import ccall "hb_set_next" hb_set_next :: Set_ -> Ptr Word32 -> IO Bool
+setNext :: Set -> Word32 -> Maybe Word32
+setNext set iter = unsafePerformIO $ withForeignPtr set $ \set' -> alloca $ \iter' -> do
+    poke iter' iter
+    success <- hb_set_next set' iter'
+    if success
+    then return . Just =<< peek iter'
+    else return Nothing
+set2list :: Set -> IO [Word32]
+set2list set = return $ inner maxBound
+  where
+    inner iter | Just x <- setNext set iter = x : inner x
+        | otherwise = []
+
+faceCollectFunc :: (Face_ -> Set_ -> IO ()) -> (Face -> [Word32])
+faceCollectFunc cb fce = unsafePerformIO $ withForeignPtr fce $ \fce' -> do
+    set <- createSet
+    withForeignPtr set $ cb fce'
+    set2list set

@@ 6,6 6,8 @@ import "harfbuzz-pure" Data.Text.Glyphize
 import "harfbuzz-pure" Data.Text.Glyphize.Buffer
 import "harfbuzz-pure" Data.Text.Glyphize.Font
 
+import Control.Parallel.Strategies (parMap, rpar)
+
 import System.Environment
 import Data.ByteString.Lazy as LBS
 import Data.ByteString as BS


@@ 17,9 19,11 @@ shapeStr font word = shape font $ defaultBuffer {
 
 main :: IO ()
 main = do
-    print $ guessSegmentProperties $ defaultBuffer { text = Right "Testing, testing"}
-
+    print versionString
     words <- getArgs
-    blob <- BS.readFile "assets/Lora-Regular.ttf"
-    let font = createFont $ createFace blob 0
-    print $ Prelude.map (shapeStr font) words
+    if Prelude.null words
+    then print $ guessSegmentProperties $ defaultBuffer { text = Right "Testing, testing"}
+    else do
+      blob <- BS.readFile "assets/Lora-Regular.ttf"
+      let font = createFont $ createFace blob 0
+      print $ parMap rpar (shapeStr font) words