harfbuzz-pure (empty) → 0.1.0.0
raw patch · 8 files changed
+1119/−0 lines, 8 filesdep +basedep +bytestringdep +freetype2setup-changed
Dependencies added: base, bytestring, freetype2, harfbuzz-pure, parallel, text, utf8-light
Files
- ChangeLog.md +5/−0
- Data/Text/Glyphize.hs +86/−0
- Data/Text/Glyphize/Buffer.hs +376/−0
- Data/Text/Glyphize/Font.hs +515/−0
- LICENSE +20/−0
- Main.hs +29/−0
- Setup.hs +2/−0
- harfbuzz-pure.cabal +86/−0
+ ChangeLog.md view
@@ -0,0 +1,5 @@+# Revision history for harfbuzz-pure++## 0.1.0.0 -- YYYY-mm-dd++* First version. Released on an unsuspecting world.
+ Data/Text/Glyphize.hs view
@@ -0,0 +1,86 @@+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 Control.Concurrent.QSem+import System.IO.Unsafe (unsafePerformIO)++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 = shapeWithFeatures font buf []++-- FIXME Certain input text can trigger a segfault. I'm not sure how to debug this.+-- Thought for a moment I fixed it with a semaphore+-- (seems related to number of threads), but appears not...++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+ waitQSem shapingSem+ 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_+ signalQSem shapingSem+ return $ zip infos pos++-- | Used to avoid segfaults...+{-# NOINLINE shapingSem #-}+shapingSem = unsafePerformIO $ newQSem 25++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
+ Data/Text/Glyphize/Buffer.hs view
@@ -0,0 +1,376 @@+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.Int++import Foreign.ForeignPtr+import Foreign.Ptr+import Foreign.Storable+import Foreign.Marshal.Alloc+import Foreign.C.Types+import Foreign.C.String+import Data.Word+import System.IO.Unsafe (unsafePerformIO, unsafeInterleaveIO)++import Data.Text.Lazy.Encoding+import Data.ByteString.Lazy.Internal as Lazy+import Data.ByteString.Internal as Strict hiding (w2c, c2w)+import Data.ByteString.Short.Internal as Strict hiding (w2c, c2w)+import Data.Bits ((.|.), (.&.), shiftR, shiftL, testBit)+import Data.Char (ord, chr, toUpper, toLower)++import Control.Monad (forM)+import Codec.Binary.UTF8.Light (encodeUTF8, w2c, c2w)++data Buffer = Buffer {+ text :: Either Lazy.Text Lazy.ByteString,+ -- ^ The Unicode text, in visual order, for HarfBuzz to convert into glyphs.+ contentType :: Maybe ContentType,+ -- ^ What the bytes of the ByteString contents represents,+ -- namely unicode characters (before shaping) or glyphs (result of shaping).+ -- Typically callers should leave this as `Just ContentTypeUnicode`.+ direction :: Maybe Direction,+ -- ^ The text flow direction of the buffer.+ -- No shaping can happen without setting buffer direction, and it controls+ -- the visual direction for the output glyphs; for RTL direction the glyphs+ -- will be reversed. Many layout features depend on the proper setting of+ -- 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 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 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,+ -- they are different concepts and should not be confused with each other.+ beginsText :: Bool,+ -- ^ special handling of the beginning of text paragraph can be applied to+ -- this buffer. Should usually be set, unless you are passing to the buffer+ -- only part of the text without the full context.+ endsText :: Bool,+ -- ^ special handling of the end of text paragraph can be applied to this buffer.+ preserveDefaultIgnorables :: Bool,+ -- ^ character with Default_Ignorable Unicode property should use the+ -- corresponding glyph from the font, instead of hiding them (done by+ -- replacing them with the space glyph and zeroing the advance width.)+ -- Takes precedance over `removeDefaultIgnorables`.+ removeDefaultIgnorables :: Bool,+ -- ^ character with Default_Ignorable Unicode property should be removed+ -- from glyph string instead of hiding them (done by replacing them with+ -- the space glyph and zeroing the advance width.)+ don'tInsertDottedCircle :: Bool,+ -- ^ a dotted circle should not be inserted in the rendering of incorrect+ -- character sequences (such at <0905 093E>).+ clusterLevel :: ClusterLevel,+ -- ^ dictates one aspect of how HarfBuzz will treat non-base characters+ -- during shaping.+ invisibleGlyph :: Char,+ -- ^ The glyph number that replaces invisible characters in the+ -- shaping result. If set to zero (default), the glyph for the U+0020+ -- SPACE character is used. Otherwise, this value is used verbatim.+ replacementCodepoint :: Char+ -- ^ the hb_codepoint_t that replaces invalid entries for a given encoding+ -- when adding text to buffer .+} deriving (Eq, Show, Read)++-- | An empty buffer with sensible default properties.+defaultBuffer = Buffer {+ text = Right LBS.empty,+ contentType = Just ContentTypeUnicode,+ direction = Nothing,+ script = Nothing,+ language = Nothing,+ beginsText = True,+ endsText = True,+ preserveDefaultIgnorables = False,+ removeDefaultIgnorables = False,+ don'tInsertDottedCircle = False,+ clusterLevel = ClusterMonotoneGraphemes,+ invisibleGlyph = '\0',+ replacementCodepoint = '\xFFFD'+ }++data ContentType = ContentTypeUnicode | ContentTypeGlyphs deriving (Eq, Show, Read)+data Direction = DirLTR | DirRTL | DirTTB | DirBTT deriving (Eq, Show, Read)+data ClusterLevel = ClusterMonotoneGraphemes | ClusterMonotoneChars | ClusterChars deriving (Eq, Show, Read)++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)+ alignment _ = alignment (undefined :: Word32)+ peek p = do+ codepoint' <- peek $ castPtr p+ cluster' <- peekElemOff (castPtr p) 1+ return $ GlyphInfo codepoint' cluster'+ poke p (GlyphInfo a b) = do+ q <- return $ castPtr p+ poke q a+ pokeElemOff q 1 b++data GlyphPos = GlyphPos {+ 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 :: Int32)+ alignment _ = alignment (undefined :: Int32)+ peek p = do+ q <- return $ castPtr p+ xa <- peek q+ ya <- peekElemOff q 1+ xoff <- peekElemOff q 2+ yoff <- peekElemOff q 3+ return $ GlyphPos xa ya xoff yoff+ poke p (GlyphPos xa ya xoff yoff) = do+ q <- return $ castPtr p+ poke q xa+ pokeElemOff q 1 ya+ pokeElemOff q 2 xoff+ pokeElemOff q 3 yoff++guessSegmentProperties :: Buffer -> Buffer+guessSegmentProperties = thaw . freeze+scriptHorizontalDir :: String -> Maybe Direction+scriptHorizontalDir script =+ int2dir $ hb_script_get_horizontal_direction $ hb_script_from_string 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+dirReverse DirTTB = DirBTT+dirReverse DirBTT = DirTTB+dirBackward dir = dir `Prelude.elem` [DirRTL, DirBTT]+dirForward dir = dir `Prelude.elem` [DirLTR, DirTTB]+dirHorizontal dir = dir `Prelude.elem` [DirLTR, DirRTL]+dirVertical dir = dir `Prelude.elem` [DirTTB, DirBTT]++---++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+ Right bs -> hb_buffer_add_bytestring buffer bs+ -- Convert text to bytestring for now due to the text 2.0 UTF-8 transition.+ -- Unfortunately this may prevent Harfbuzz from reading opening context+ -- So for correctness we'll eventually want to depend on text>2.0+ Left txt -> hb_buffer_add_bytestring buffer $ encodeUtf8 txt+ hb_buffer_set_content_type buffer $ case contentType buf of+ Nothing -> 0+ Just ContentTypeUnicode -> 1+ 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_string script'+ Nothing -> return ()+ case language buf of+ 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,+ if endsText buf then 2 else 0,+ if preserveDefaultIgnorables buf then 4 else 0,+ if removeDefaultIgnorables buf then 8 else 0,+ if don'tInsertDottedCircle buf then 16 else 0+ ]+ hb_buffer_set_cluster_level buffer $ case clusterLevel buf of+ ClusterMonotoneGraphemes -> 0+ ClusterMonotoneChars -> 1+ ClusterChars -> 2+ hb_buffer_set_invisible_glyph buffer $ c2w $ invisibleGlyph buf+ hb_buffer_set_replacement_codepoint buffer $ c2w $ replacementCodepoint buf+ case (contentType buf, direction buf, script buf, language buf) of+ (Just ContentTypeUnicode, Nothing, _, _) -> hb_buffer_guess_segment_properties buffer+ (Just ContentTypeUnicode, _, Nothing, _) -> hb_buffer_guess_segment_properties buffer+ (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 || arr == nullPtr+ then return []+ 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 || arr == nullPtr+ then return []+ 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'+ contentType' <- getter hb_buffer_get_content_type+ direction' <- getter hb_buffer_get_direction+ script' <- getter hb_buffer_get_script+ language' <- unsafeInterleaveIO $ do+ lang <- withForeignPtr buf' $ \buf'' -> hb_buffer_get_language buf''+ peekCString $ hb_language_to_string lang+ flags' <- getter hb_buffer_get_flags+ clusterLevel' <- getter hb_buffer_get_cluster_level+ invisibleGlyph' <- getter hb_buffer_get_invisible_glyph+ replacementCodepoint' <- getter hb_buffer_get_replacement_codepoint+ return Buffer {+ text = Right $ LBS.fromStrict $ encodeUTF8 $ Prelude.map codepoint glyphInfos',+ contentType = case contentType' of+ 1 -> Just ContentTypeUnicode+ 2 -> Just ContentTypeGlyphs+ _ -> Nothing,+ direction = int2dir direction',+ 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,+ don'tInsertDottedCircle = testBit flags' 4,+ clusterLevel = case clusterLevel' of+ 1 -> ClusterMonotoneChars+ 2 -> ClusterChars+ _ -> ClusterMonotoneGraphemes,+ invisibleGlyph = w2c invisibleGlyph', replacementCodepoint = w2c replacementCodepoint'+ }++foreign import ccall "hb_buffer_create" hb_buffer_create :: IO Buffer_+foreign import ccall "&hb_buffer_destroy" hb_buffer_destroy :: FunPtr (Buffer_ -> IO ())+foreign import ccall "hb_buffer_add_utf8" hb_buffer_add_utf8+ :: Buffer_ -> Ptr Word8 -> Int -> Int -> Int -> IO ()+hb_buffer_add_bytestring _ Lazy.Empty = return ()+hb_buffer_add_bytestring buf (Lazy.Chunk (Strict.PS ptr offset length) next) = do+ withForeignPtr ptr $ \ptr' -> hb_buffer_add_utf8 buf ptr' length offset (length - offset)+ hb_buffer_add_bytestring buf next+foreign import ccall "hb_buffer_set_content_type" hb_buffer_set_content_type+ :: Buffer_ -> Int -> IO ()+foreign import ccall "hb_buffer_set_direction" hb_buffer_set_direction+ :: Buffer_ -> Int -> IO ()+hb_tag_from_string :: String -> Word32+hb_tag_from_string str = case str ++ Prelude.repeat '\0' of+ c1:c2:c3:c4:_ -> Prelude.foldl (.|.) 0 [+ shiftL (c2w c1 .&. 0x7) 24,+ shiftL (c2w c2 .&. 0x7) 16,+ shiftL (c2w c3 .&. 0x7) 8,+ shiftL (c2w c4 .&. 0x7) 0+ ]+ _ -> 0+titlecase :: String -> String+titlecase "" = ""+titlecase (c:cs) = toUpper c : Prelude.map toLower cs+hb_script_from_string str = hb_tag_from_string $ case titlecase str of+ 'Q':'a':'a':'i':_ -> "Zinh"+ 'Q':'a':'a':'c':_ -> "Copt"++ 'A':'r':'a':'n':_ -> "Arab"+ 'C':'y':'r':'s':_ -> "Cyrl"+ 'G':'e':'o':'k':_ -> "Geor"+ 'H':'a':'n':'s':_ -> "Hani"+ 'H':'a':'n':'t':_ -> "Hani"+ 'J':'a':'m':'o':_ -> "Hang"+ 'L':'a':'t':'f':_ -> "Latn"+ 'L':'a':'t':'g':_ -> "Latn"+ 'S':'y':'r':'e':_ -> "Syrc"+ 'S':'y':'r':'j':_ -> "Syrc"+ 'S':'y':'r':'n':_ -> "Syrc"+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'+ :: 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 ()+foreign import ccall "hb_buffer_set_cluster_level" hb_buffer_set_cluster_level+ :: Buffer_ -> Int -> IO ()+foreign import ccall "hb_buffer_set_invisible_glyph" hb_buffer_set_invisible_glyph+ :: Buffer_ -> Word32 -> IO ()+foreign import ccall "hb_buffer_set_replacement_codepoint" hb_buffer_set_replacement_codepoint+ :: Buffer_ -> Word32 -> IO ()+foreign import ccall "hb_buffer_guess_segment_properties" hb_buffer_guess_segment_properties+ :: Buffer_ -> IO ()+++foreign import ccall "hb_buffer_get_content_type" hb_buffer_get_content_type+ :: Buffer_ -> IO Int+foreign import ccall "hb_buffer_get_direction" hb_buffer_get_direction :: Buffer_ -> IO Int+foreign import ccall "hb_buffer_get_script" hb_buffer_get_script :: Buffer_ -> IO Word32+hb_tag_to_string :: Word32 -> String+hb_tag_to_string tag = [+ w2c (shiftR tag 24 .&. 0x7),+ w2c (shiftR tag 16 .&. 0x7),+ w2c (shiftR tag 8 .&. 0x7),+ w2c (shiftR tag 0 .&. 0x7)+ ]+foreign import ccall "hb_buffer_get_language" hb_buffer_get_language :: Buffer_ -> IO (Ptr ())+foreign import ccall "hb_language_to_string" hb_language_to_string :: Ptr () -> CString+foreign import ccall "hb_buffer_get_flags" hb_buffer_get_flags :: Buffer_ -> IO Int+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 Word -> IO (Ptr GlyphInfo)+foreign import ccall "hb_buffer_get_glyph_positions" hb_buffer_get_glyph_positions+ :: 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+ :: Buffer_ -> IO Word32
+ Data/Text/Glyphize/Font.hs view
@@ -0,0 +1,515 @@+{-# LANGUAGE PackageImports #-}+module Data.Text.Glyphize.Font where++import Data.ByteString+import FreeType.Core.Base+import Data.Text.Glyphize.Buffer (Direction(..), dir2int, hb_tag_to_string)++import System.IO.Unsafe (unsafePerformIO)+import Foreign.Ptr+import Foreign.StablePtr+import Foreign.ForeignPtr+import qualified Foreign.Concurrent as Conc+import Foreign.Marshal.Alloc+import Foreign.Storable+import Foreign.C.String++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 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_ -> Word -> IO Face_+foreign import ccall "hb_face_destroy" hb_face_destroy :: Face_ -> IO ()+foreign import ccall "&hb_face_destroy" hb_face_destroy' :: FunPtr (Face_ -> IO ())+createFace :: ByteString -> Word -> Face+createFace bytes index = unsafePerformIO $ do+ blob <- bs2blob bytes+ face <- withForeignPtr blob $ flip hb_face_create index+ Conc.newForeignPtr face $ 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_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_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_ -> Word+-- | units-per-em+faceUpem :: Face -> Word+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 :: 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+ Conc.newForeignPtr font $ hb_font_destroy font++foreign import ccall "hb_ft_font_create_referenced" hb_ft_font_create_referenced+ :: FT_Face -> IO Font_+ftCreateFont :: FT_Face -> IO Font+ftCreateFont fce = do+ font <- hb_ft_font_create_referenced fce+ 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 _ = 4 * sizeOf (undefined :: Word32)+ alignment _ = alignment (undefined :: Word32)+ 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_ -> CString -> Int -> Ptr Word32 -> IO Bool+fontGlyphFromName :: Font -> String -> Maybe Word32+fontGlyphFromName font name = unsafePerformIO $+ withForeignPtr font $ \font' -> alloca $ \ret -> do+ 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 -> 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 -> 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 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'+ 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 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'+ 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 -> 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+ else return Nothing++foreign import ccall "hb_font_get_glyph_origin_for_direction"+ hb_font_get_glyph_origin_for_direction+ :: 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'+ 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 -> 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 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'+ 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 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'+ 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_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 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..fromEnum length-1] $ peekElemOff arr++foreign import ccall "hb_font_glyph_from_string" hb_font_glyph_from_string+ :: Font_ -> CString -> Int -> Ptr Word32 -> IO Bool+fontTxt2Glyph :: Font -> String -> Maybe Word32+fontTxt2Glyph font str = unsafePerformIO $+ withForeignPtr font $ \font' -> alloca $ \ret -> do+ ok <- withCString str $ \str' ->+ hb_font_glyph_from_string font' str' (-1) 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 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 (Word, Word),+ optionPtEm :: Maybe Float,+ optionScale :: Maybe (Int, Int)+}+defaultFontOptions = FontOptions {+ optionPPEm = Nothing, optionPtEm = Nothing,+ optionScale = Nothing+}++_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 ()++createFontWithOptions :: FontOptions -> Face -> Font+createFontWithOptions opts fce = unsafePerformIO $ do+ font <- withForeignPtr fce $ hb_font_create+ _setFontOptions font opts+ hb_font_make_immutable font+ Conc.newForeignPtr font $ hb_font_destroy font++ftCreateFontWithOptions :: FontOptions -> FT_Face -> Font+ftCreateFontWithOptions opts fce = unsafePerformIO $ do+ font <- hb_ft_font_create_referenced fce+ _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_ -> 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 ()++-- 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 :: 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+ Conc.newForeignPtr blob $ hb_blob_destroy blob++faceFunc :: (Face_ -> a) -> (Face -> a)+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
+ LICENSE view
@@ -0,0 +1,20 @@+Copyright (c) 2022 Adrian Cochrane++Permission is hereby granted, free of charge, to any person obtaining+a copy of this software and associated documentation files (the+"Software"), to deal in the Software without restriction, including+without limitation the rights to use, copy, modify, merge, publish,+distribute, sublicense, and/or sell copies of the Software, and to+permit persons to whom the Software is furnished to do so, subject to+the following conditions:++The above copyright notice and this permission notice shall be included+in all copies or substantial portions of the Software.++THE SOFTWARE IS PROVIDED "AS IS", WITHOUT WARRANTY OF ANY KIND,+EXPRESS OR IMPLIED, INCLUDING BUT NOT LIMITED TO THE WARRANTIES OF+MERCHANTABILITY, FITNESS FOR A PARTICULAR PURPOSE AND NONINFRINGEMENT.+IN NO EVENT SHALL THE AUTHORS OR COPYRIGHT HOLDERS BE LIABLE FOR ANY+CLAIM, DAMAGES OR OTHER LIABILITY, WHETHER IN AN ACTION OF CONTRACT,+TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE+SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
+ Main.hs view
@@ -0,0 +1,29 @@+{-# LANGUAGE PackageImports #-}+{-# LANGUAGE OverloadedStrings #-}+module Main where++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+import Data.ByteString.Char8 as UTF8++shapeStr font word = shape font $ defaultBuffer {+ text = Right $ LBS.fromStrict $ UTF8.pack word+ }++main :: IO ()+main = do+ print versionString+ words <- getArgs+ 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
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ harfbuzz-pure.cabal view
@@ -0,0 +1,86 @@+-- Initial harfbuzz-pure.cabal generated by cabal init. For further +-- documentation, see http://haskell.org/cabal/users-guide/++-- The name of the package.+name: harfbuzz-pure++-- The package version. See the Haskell package versioning policy (PVP) +-- for standards guiding when and how versions should be incremented.+-- https://wiki.haskell.org/Package_versioning_policy+-- PVP summary: +-+------- breaking API changes+-- | | +----- non-breaking API additions+-- | | | +--- code changes with no API change+version: 0.1.0.0++-- A short (one-line) description of the package.+synopsis: Pure-functional Harfbuzz language bindings++-- A longer description of the package.+description: HarfBuzz is a text shaping library. Using the HarfBuzz library allows programs to convert a sequence of Unicode input into properly formatted and positioned glyph output—for any writing system and language.++-- URL for the project homepage or repository.+homepage: https://harfbuzz.github.io/++-- The license under which the package is released.+license: MIT++-- The file containing the license text.+license-file: LICENSE++-- The package author(s).+author: Adrian Cochrane++-- An email address to which users can send suggestions, bug reports, and +-- patches.+maintainer: opensource@openwork.nz++-- A copyright notice.+-- copyright: ++category: Text++build-type: Simple++-- Extra files to be distributed with the package, such as examples or a +-- README.+extra-source-files: ChangeLog.md++-- Constraint on the version of Cabal needed to build this package.+cabal-version: >=1.10+++library+ -- Modules exported by the library.+ exposed-modules: Data.Text.Glyphize, Data.Text.Glyphize.Buffer, Data.Text.Glyphize.Font+ + -- Modules included in this library but not exported.+ -- other-modules: + + -- LANGUAGE extensions used by modules in this package.+ -- other-extensions: + + -- Other library packages from which modules are imported.+ build-depends: base >=4.9 && <5, freetype2 >= 0.2,+ bytestring >= 0.10.8.2 && < 0.12, text >= 1 && <3, utf8-light >= 0.3 && < 1+ pkgconfig-depends: harfbuzz+ + -- Directories containing source files.+ -- hs-source-dirs: + + -- Base language which the package is written in.+ default-language: Haskell2010++executable shape-text+ -- .hs file containing the Main module+ main-is: Main.hs++ -- Other library packages from which modules are imported+ build-depends: base >=4.9 && <5, harfbuzz-pure, parallel >= 2.2 && < 4, bytestring++ -- Directories containing source files.+ hs-source-dirs: .++ -- Base language which the package is written in.+ default-language: Haskell2010++ ghc-options: -threaded