M Data/Text/Glyphize/Buffer.hs => Data/Text/Glyphize/Buffer.hs +16 -19
@@ 146,12 146,18 @@ guessSegmentProperties :: Buffer -> Buffer
guessSegmentProperties = thaw . freeze
scriptHorizontalDir :: ShortText -> Maybe Direction
scriptHorizontalDir script =
- case hb_script_get_horizontal_direction $ hb_script_from_txt script of
- 4 -> Just DirLTR
- 5 -> Just DirRTL
- 6 -> Just DirTTB
- 7 -> Just DirBTT
- _ -> Nothing
+ int2dir $ hb_script_get_horizontal_direction $ hb_script_from_txt script
+
+int2dir 4 = Just DirLTR
+int2dir 5 = Just DirRTL
+int2dir 6 = Just DirTTB
+int2dir 7 = Just DirBTT
+int2dir _ = Nothing
+dir2int Nothing = 0
+dir2int (Just DirLTR) = 4
+dir2int (Just DirRTL) = 5
+dir2int (Just DirTTB) = 6
+dir2int (Just DirBTT) = 7
dirReverse DirLTR = DirRTL
dirReverse DirRTL = DirLTR
@@ 180,12 186,7 @@ freeze' buf = do
Nothing -> 0
Just ContentTypeUnicode -> 1
Just ContentTypeGlyphs -> 2
- hb_buffer_set_direction buffer $ case direction buf of
- Nothing -> 0
- Just DirLTR -> 4
- Just DirRTL -> 5
- Just DirTTB -> 6
- Just DirBTT -> 7
+ hb_buffer_set_direction buffer $ dir2int $ direction buf
case script buf of
Just script' -> hb_buffer_set_script buffer $ hb_script_from_txt script'
Nothing -> return ()
@@ 251,12 252,7 @@ thaw' buf' = do
1 -> Just ContentTypeUnicode
2 -> Just ContentTypeGlyphs
_ -> Nothing,
- direction = case direction' of
- 4 -> Just DirLTR
- 5 -> Just DirRTL
- 6 -> Just DirTTB
- 7 -> Just DirBTT
- _ -> Nothing,
+ direction = int2dir direction',
language = Just $ Short.fromString language',
script = Just $ Short.fromString $ hb_tag_to_string script',
beginsText = testBit flags' 0, endsText = testBit flags' 1,
@@ 318,7 314,8 @@ foreign import ccall "hb_script_get_horizontal_direction" hb_script_get_horizont
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 ptr' size
+ in withForeignPtr ptr $ \ptr' -> return $
+ hb_language_from_string (plusPtr ptr' offset) (size - offset)
foreign import ccall "hb_buffer_set_language" hb_buffer_set_language
:: Ptr Buffer'' -> Int -> IO ()
foreign import ccall "hb_buffer_set_flags" hb_buffer_set_flags :: Ptr Buffer'' -> Int -> IO ()
M Data/Text/Glyphize/Font.hs => Data/Text/Glyphize/Font.hs +417 -24
@@ 1,35 1,428 @@
+{-# LANGUAGE PackageImports #-}
module Data.Text.Glyphize.Font where
import Data.ByteString
import Data.Text.Short
+--import FreeType.Core.Base
+import Data.Text.Glyphize.Buffer (Direction(..), dir2int)
-data Face = Face -- TODO Define
+import System.IO.Unsafe (unsafePerformIO)
+import Foreign.Ptr
+import Foreign.StablePtr
+import Foreign.ForeignPtr
+import Foreign.Marshal.Alloc
+import Foreign.Storable
+import Foreign.C.String
--- countFace :: ByteString -> Int
--- createFace :: ByteString -> Int -> IO Face
--- ftCreateFace :: FT_Face -> Face
--- emptyFace :: Face
--- faceGlyphCount :: Face -> Int
--- faceIndex :: Face -> Int
--- faceUpem :: Face -> Int
--- Defer implementation of other functions
+import Data.Maybe (fromMaybe)
+import Data.Word
+import Data.Int
+import Data.ByteString.Internal hiding (c2w)
+import Codec.Binary.UTF8.Light (c2w)
+import Control.Monad (forM)
+
+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
+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_destroy" hb_face_destroy :: FunPtr (Face_ -> IO ())
+createFace :: ByteString -> Int -> Face
+createFace bytes index = unsafePerformIO $ do
+ blob <- bs2blob bytes
+ face <- withForeignPtr blob $ flip hb_face_create index
+ newForeignPtr hb_face_destroy face
+
+--foreign import ccall "hb_ft_face_create_referenced" hb_ft_face_create_referenced
+-- :: FT_Face -> Face_
+--ftCreateFace :: FT_Face -> Face
+--ftCreateFace =
+-- unsafePerformIO . newForeignPtr hb_face_destroy . hb_ft_face_create_referenced
+
+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
+faceGlyphCount = faceFunc hb_face_get_glyph_count
+
+foreign import ccall "hb_face_get_index" hb_face_get_index :: Face_ -> Int
+faceIndex :: Face -> Int
+faceIndex = faceFunc hb_face_get_index
+
+foreign import ccall "hb_face_get_upem" hb_face_get_upem :: Face_ -> Int
+faceUpem :: Face -> Int
+faceUpem = faceFunc hb_face_get_upem
+-- Defer implementation of other functions...
+
+---
+
+type Font = ForeignPtr Font'
+type Font_ = Ptr Font'
+data Font'
+
+foreign import ccall "hb_font_create" hb_font_create :: Face_ -> IO Font_
+foreign import ccall "hb_font_make_immutable" hb_font_make_immutable :: Font_ -> IO ()
+foreign import ccall "&hb_font_destroy" hb_font_destroy :: FunPtr (Font_ -> IO ())
+createFont :: Face -> Font
+createFont fce = unsafePerformIO $ do
+ font <- withForeignPtr fce $ hb_font_create
+ hb_font_make_immutable font
+ newForeignPtr hb_font_destroy font
+
+--foreign import ccall "hb_ft_font_create_referenced" hb_ft_font_create_referenced
+-- :: FT_Face -> IO Face_
+-- ftCreateFont :: FT_Face -> IO Font
+-- ftCreateFont fce = unsafePerformIO $ do
+-- font <- hb_ft_font_create_referenced
+-- hb_font_make_immutable font
+-- newForeignPtr hb_font_destroy font
+
+foreign import ccall "hb_font_get_empty" hb_font_get_empty :: Font_
+emptyFont :: Font
+emptyFont = unsafePerformIO $ newForeignPtr hb_font_destroy hb_font_get_empty
+
+foreign import ccall "hb_font_get_glyph" hb_font_get_glyph
+ :: Font_ -> Word32 -> Word32 -> Ptr Word32 -> IO Bool
+fontGlyph :: Font -> Char -> Maybe Char -> Maybe Word32
+fontGlyph font char var =
+ unsafePerformIO $ withForeignPtr font $ \font' -> alloca $ \ret -> do
+ success <- hb_font_get_glyph font' (c2w char) (c2w $ fromMaybe '\0' var) ret
+ if success then return . Just =<< peek ret else return Nothing
+
+foreign import ccall "hb_font_get_glyph_advance_for_direction"
+ hb_font_get_glyph_advance_for_direction
+ :: Font_ -> Word32 -> Int -> Ptr Int32 -> Ptr Int32 -> IO ()
+fontGlyphAdvance :: Font -> Word32 -> Maybe Direction -> (Int32, Int32)
+fontGlyphAdvance font glyph dir = unsafePerformIO $
+ withForeignPtr font $ \font' -> alloca $ \x' -> alloca $ \y' -> do
+ hb_font_get_glyph_advance_for_direction font' glyph (dir2int dir) x' y'
+ x <- peek x'
+ y <- peek y'
+ return (x, y)
+
+foreign import ccall "hb_font_get_glyph_contour_point" hb_font_get_glyph_contour_point
+ :: Font_ -> Word32 -> Int -> Ptr Int32 -> Ptr Int32 -> IO Bool
+fontGlyphContourPoint :: Font -> Word32 -> Int -> Maybe (Int32, Int32)
+fontGlyphContourPoint font glyph index = unsafePerformIO $
+ withForeignPtr font $ \font' -> alloca $ \x' -> alloca $ \y' -> do
+ success <- hb_font_get_glyph_contour_point font' glyph index x' y'
+ if success
+ then do
+ x <- peek x'
+ y <- peek y'
+ return $ Just (x, y)
+ else return Nothing
+
+foreign import ccall "hb_font_get_glyph_contour_point_for_origin"
+ hb_font_get_glyph_contour_point_for_origin
+ :: Font_ -> Word32 -> Int -> Int -> Ptr Int32 -> Ptr Int32 -> IO Bool
+fontGlyphContourPointForOrigin :: Font -> Word32 -> Int -> Maybe Direction -> Maybe (Int32, Int32)
+fontGlyphContourPointForOrigin font glyph index dir = unsafePerformIO $
+ withForeignPtr font $ \font' -> alloca $ \x' -> alloca $ \y' -> do
+ success <- hb_font_get_glyph_contour_point_for_origin font' glyph index
+ (dir2int dir) x' y'
+ if success
+ then do
+ x <- peek x'
+ y <- peek y'
+ return $ Just (x, y)
+ else return Nothing
+
+data GlyphExtents = GlyphExtents {
+ xBearing :: Word32, yBearing :: Word32,
+ width :: Word32, height :: Word32
+}
+instance Storable GlyphExtents where
+ sizeOf (GlyphExtents a _ _ _) = 4 * sizeOf a
+ alignment (GlyphExtents a _ _ _) = alignment a
+ peek p = do
+ q <- return $ castPtr p
+ x <- peek q
+ y <- peekElemOff q 1
+ width <- peekElemOff q 2
+ height <- peekElemOff q 3
+ return $ GlyphExtents x y width height
+ poke p (GlyphExtents x y width height) = do
+ q <- return $ castPtr p
+ poke q x
+ pokeElemOff q 1 y
+ pokeElemOff q 2 width
+ pokeElemOff q 3 height
+
+foreign import ccall "hb_font_get_glyph_extents" hb_font_get_glyph_extents
+ :: Font_ -> Word32 -> Ptr GlyphExtents -> IO Bool
+fontGlyphExtents :: Font -> Word32 -> Maybe GlyphExtents
+fontGlyphExtents font glyph = unsafePerformIO $
+ withForeignPtr font $ \font' -> alloca $ \ret -> do
+ success <- hb_font_get_glyph_extents font' glyph ret
+ if success
+ then return . Just =<< peek ret
+ else return Nothing
+
+foreign import ccall "hb_font_get_glyph_extents_for_origin"
+ hb_font_get_glyph_extents_for_origin
+ :: Font_ -> Word32 -> Int -> Ptr GlyphExtents -> IO Bool
+fontGlyphExtentsForOrigin :: Font -> Word32 -> Maybe Direction -> Maybe GlyphExtents
+fontGlyphExtentsForOrigin font glyph dir = unsafePerformIO $
+ withForeignPtr font $ \font' -> alloca $ \ret -> do
+ ok <- hb_font_get_glyph_extents_for_origin font' glyph (dir2int dir) ret
+ if ok
+ then return . Just =<< peek ret
+ 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
+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
+ 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
+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
+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)
+fontGlyphHOrigin font glyph = unsafePerformIO $
+ withForeignPtr font $ \font' -> alloca $ \x' -> alloca $ \y' -> do
+ success <- hb_font_get_glyph_h_origin font' glyph x' y'
+ if success
+ then do
+ x <- peek x'
+ y <- peek y'
+ return $ Just (x, y)
+ else return Nothing
+
+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)
+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'
+ x <- peek x'
+ y <- peek y'
+ 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
+ success <- hb_font_get_glyph_name font' glyph ret length
+ if success
+ then return . Just =<< peekCString ret
+ else return Nothing
+
+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)
+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'
+ x <- peek x'
+ y <- peek y'
+ 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
+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)
+fontGlyphVOrigin font glyph = unsafePerformIO $
+ withForeignPtr font $ \font' -> alloca $ \x' -> alloca $ \y' -> do
+ success <- hb_font_get_glyph_v_origin font' glyph x' y'
+ if success
+ then do
+ x <- peek x'
+ y <- peek y'
+ return $ Just (x, y)
+ else return Nothing
+
+foreign import ccall "hb_font_get_nominal_glyph" hb_font_get_nominal_glyph
+ :: Font_ -> Char -> Ptr Word32 -> IO Bool
+fontNominalGlyph :: Font -> Char -> Maybe Word32
+fontNominalGlyph font char = unsafePerformIO $
+ withForeignPtr font $ \font' -> alloca $ \ret -> do
+ success <- hb_font_get_nominal_glyph font' char ret
+ if success
+ then return . Just =<< peek ret
+ else return Nothing
+
+foreign import ccall "hb_font_get_ppem" hb_font_get_ppem
+ :: Font_ -> Ptr Int -> Ptr Int -> IO ()
+fontPPEm :: Font -> (Int, Int)
+fontPPEm font = unsafePerformIO $
+ withForeignPtr font $ \font' -> alloca $ \x' -> alloca $ \y' -> do
+ hb_font_get_ppem font' x' y'
+ x_ppem <- peek x'
+ y_ppem <- peek y'
+ return (x_ppem, y_ppem)
+
+foreign import ccall "hb_font_get_ptem" hb_font_get_ptem :: Font_ -> Float
+fontPtEm :: Font -> Float
+fontPtEm = fontFunc hb_font_get_ptem
+
+foreign import ccall "hb_font_get_scale" hb_font_get_scale
+ :: Font_ -> Ptr Int -> Ptr Int -> IO ()
+fontScale :: Font -> (Int, Int)
+fontScale font = unsafePerformIO $
+ withForeignPtr font $ \font' -> alloca $ \x' -> alloca $ \y' -> do
+ hb_font_get_scale font' x' y'
+ x <- peek x'
+ y <- peek y'
+ return (x, y)
+
+foreign import ccall "hb_font_get_synthetic_slant" hb_font_get_synthetic_slant
+ :: Font_ -> Float
+fontSynthSlant :: Font -> Float
+fontSynthSlant = fontFunc hb_font_get_synthetic_slant
+
+foreign import ccall "hb_font_get_variance_glyph" hb_font_get_variance_glyph
+ :: Font_ -> Word32 -> Word32 -> Ptr Word32 -> IO Bool
+fontVarianceGlyph :: Font -> Word32 -> Word32 -> Maybe Word32
+fontVarianceGlyph font glyph1 glyph2 = unsafePerformIO $
+ withForeignPtr font $ \font' -> alloca $ \ret -> do
+ success <- hb_font_get_variance_glyph font' glyph1 glyph2 ret
+ if success
+ then return . Just =<< peek ret
+ else return Nothing
+
+foreign import ccall "hb_font_get_var_coords_design" hb_font_get_var_coords_design
+ :: Font_ -> Ptr Int -> IO (Ptr Float)
+fontVarCoordsDesign :: Font -> [Float]
+fontVarCoordsDesign font = unsafePerformIO $
+ withForeignPtr font $ \font' -> alloca $ \length' -> do
+ arr <- hb_font_get_var_coords_design font' length'
+ length <- peek length'
+ forM [0..length-1] $ peekElemOff arr
+
+foreign import ccall "hb_font_get_var_coords_normalized"
+ hb_font_get_var_coords_normalized :: Font_ -> Ptr Int -> 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
+
+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 $
+ 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
+ if ok
+ then return . Just =<< peek ret
+ else return Nothing
+
+foreign import ccall "hb_font_glyph_to_string" hb_font_glyph_to_string
+ :: Font_ -> Word32 -> CString -> Int -> IO ()
+fontGlyph2Str :: Font -> Word32 -> Int -> String
+fontGlyph2Str font glyph length = unsafePerformIO $
+ withForeignPtr font $ \font' -> allocaBytes length $ \ret -> do
+ hb_font_glyph_to_string font' glyph ret length
+ peekCString ret
+
+---
-data Font = Font -- TODO Define
data FontOptions = FontOptions {
- x_ppem :: Int, y_ppem :: Int,
- ptem :: Int,
- x_scale :: Int, y_scale :: Int,
- slant :: Float
- -- Support variations? Variation coordinates?
+ optionPPEm :: Maybe (Int, Int),
+ optionPtEm :: Maybe Float,
+ optionScale :: Maybe (Int, Int),
+ optionSynthSlant :: Maybe Float
+}
+defaultFontOptions = FontOptions {
+ optionPPEm = Nothing, optionPtEm = Nothing,
+ optionScale = Nothing,
+ optionSynthSlant = Nothing
}
--- createFont :: Face -> FontOptions -> Font
--- ftCreateFont ::FT_Face -> FontOptions -> IO Font
--- emptyFont :: Font
--- fontFace :: Font -> Face
--- fontGlyph :: Font -> Char -> Maybe Char -> Maybe Int
--- fontString2Glyph :: Font -> ShortText -> Maybe Int
--- fontGlyph2String :: Font -> Int -> ShortText
--- Defer implementation of other functions
+_setFontOptions font opts = do
+ case optionPPEm opts of
+ Just (x, y) -> hb_font_set_ppem font x y
+ Nothing -> return ()
+ case optionPtEm opts of
+ Just ptem -> hb_font_set_ptem font ptem
+ Nothing -> return ()
+ case optionScale opts of
+ Just (x, y) -> hb_font_set_scale font x y
+ Nothing -> return ()
+ case optionSynthSlant opts of
+ Just slant -> hb_font_set_synthetic_slant font slant
+ Nothing -> return ()
+
+createFontWithOptions :: FontOptions -> Face -> Font
+createFontWithOptions opts fce = unsafePerformIO $ do
+ font <- withForeignPtr fce $ hb_font_create
+ _setFontOptions font opts
+ hb_font_make_immutable font
+ newForeignPtr hb_font_destroy font
+
+--ftCreateFontWithOptiosn :: FontOptions -> FT_Face -> Font
+--ftCreateFontWithOptions opts fce = unsafePerformIO $ do
+-- font <- hb_ft_font_create_referenced
+-- _setFontOptions font opts
+-- 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_ptem" hb_font_set_ptem :: Font_ -> Float -> IO ()
+foreign import ccall "hb_font_set_scale" hb_font_set_scale :: Font_ -> Int -> Int -> IO ()
+foreign import ccall "hb_font_set_synthetic_slant" hb_font_set_synthetic_slant
+ :: Font_ -> Float -> IO ()
+
+-- Defer implementation of other functions...
+
+---
+
+type Blob = ForeignPtr Blob'
+data Blob'
+type Blob_ = Ptr Blob'
+
+foreign import ccall "hb_blob_create" hb_blob_create :: Ptr Word8 -> Int -> Int
+ -> StablePtr ByteString -> FunPtr (StablePtr ByteString -> IO ()) -> IO Blob_
+hb_MEMORY_MODE_READONLY = 1
+foreign import ccall "&hb_blob_destroy" hb_blob_destroy :: FunPtr (Blob_ -> IO ())
+foreign import ccall "wrapper" hs_destructor
+ :: (StablePtr a -> IO ()) -> IO (FunPtr (StablePtr a -> IO ()))
+
+bs2blob bytes@(PS ptr offset length) = do
+ bytes' <- newStablePtr bytes
+ destructor <- hs_destructor freeStablePtr
+ blob <- withForeignPtr ptr $ \ptr' ->
+ hb_blob_create (plusPtr ptr' offset) (length - offset)
+ hb_MEMORY_MODE_READONLY bytes' destructor
+ newForeignPtr hb_blob_destroy blob
+
+faceFunc :: (Face_ -> a) -> (Face -> a)
+faceFunc cb fce = unsafePerformIO $ withForeignPtr fce $ return . cb
--- Do we need FontFuncs?
+fontFunc :: (Font_ -> a) -> (Font -> a)
+fontFunc cb fnt = unsafePerformIO $ withForeignPtr fnt $ return . cb
M harfbuzz-pure.cabal => harfbuzz-pure.cabal +2 -1
@@ 60,7 60,8 @@ library
-- other-extensions:
-- Other library packages from which modules are imported.
- build-depends: base >=4.9 && <4.10, bytestring, text, text-short, utf8-light
+ build-depends: base >=4.9 && <5, bytestring, text, text-short, utf8-light
+-- , freetype2 >= 0.2
extra-libraries: harfbuzz
-- Directories containing source files.