From d7634db82b6b290681b00e8b208b256ce1aec526 Mon Sep 17 00:00:00 2001 From: Adrian Cochrane Date: Thu, 10 Nov 2022 17:29:45 +1300 Subject: [PATCH] Extend and document font & face language bindings. --- Data/Text/Glyphize/Font.hs | 358 ++++++++++++++++++++++++++++++++++--- 1 file changed, 337 insertions(+), 21 deletions(-) diff --git a/Data/Text/Glyphize/Font.hs b/Data/Text/Glyphize/Font.hs index fcb92d2..6f6d1bd 100644 --- a/Data/Text/Glyphize/Font.hs +++ b/Data/Text/Glyphize/Font.hs @@ -8,7 +8,7 @@ import Data.Int (Int32) import FreeType.Core.Base (FT_Face) import Data.Text.Glyphize.Buffer (tag_to_string, tag_from_string, Direction, dir2int) -import Control.Monad (forM) +import Control.Monad (forM, unless) import Codec.Binary.UTF8.Light (w2c, c2w) import Data.Maybe (fromMaybe) @@ -16,6 +16,7 @@ import System.IO.Unsafe (unsafePerformIO) import Foreign.ForeignPtr (ForeignPtr(..), withForeignPtr, newForeignPtr, newForeignPtr_) import Foreign.Ptr (Ptr(..), FunPtr(..), nullPtr, nullFunPtr, castPtr) import Foreign.Marshal.Alloc (alloca, allocaBytes) +import Foreign.Marshal.Array (withArray, withArrayLen) import Foreign.Storable (Storable(..)) import Foreign.Storable.Generic (GStorable(..)) import GHC.Generics (Generic(..)) @@ -25,19 +26,40 @@ import Foreign.C.String (CString, withCString, withCStringLen, peekCString, peek --- Features & Variants ------ +-- | The structure that holds information about requested feature application. +-- The feature will be applied with the given value to all glyphs which are +-- in clusters between start (inclusive) and end (exclusive). +-- Setting start to HB_FEATURE_GLOBAL_START and end to HB_FEATURE_GLOBAL_END specifies +-- that the feature always applies to the entire buffer. data Feature = Feature { featTag' :: Word32, + -- ^ Tag of the feature. Use `featTag` to decode as an ASCII string. featValue :: Word32, + -- ^ The value of the feature. + -- 0 disables the feature, non-zero (usually 1) enables the feature. + -- For features implemented as lookup type 3 (like 'salt') the value + -- is a one based index into the alternates. featStart :: Word, + -- ^ The cluster to start applying this feature setting (inclusive). featEnd :: Word + -- ^ The cluster to end applying this feature setting (exclusive). } deriving (Read, Show, Generic) instance GStorable Feature +-- | Parses a string into a hb_feature_t. +-- The format for specifying feature strings follows. All valid CSS +-- font-feature-settings values other than 'normal' and the global values +-- are also accepted. CSS string escapes are not supported. +-- See https://harfbuzz.github.io/harfbuzz-hb-common.html#hb-feature-from-string +-- for additional details. +-- The range indices refer to the positions between Unicode characters. +-- The position before the first character is always 0. parseFeature :: String -> Maybe Feature parseFeature str = unsafePerformIO $ withCStringLen str $ \(str', len) -> alloca $ \ret' -> do success <- hb_feature_from_string str' len ret' if success then Just <$> peek ret' else return Nothing foreign import ccall "hb_feature_from_string" hb_feature_from_string :: CString -> Int -> Ptr Feature -> IO Bool +-- | Converts a `Feature` into a `String` in the format understood by `parseFeature`. unparseFeature :: Feature -> String unparseFeature feature = unsafePerformIO $ alloca $ \feature' -> allocaBytes 128 $ \ret' -> do feature' `poke` feature @@ -46,17 +68,29 @@ unparseFeature feature = unsafePerformIO $ alloca $ \feature' -> allocaBytes 128 foreign import ccall "hb_feature_to_string" hb_feature_to_string :: Ptr Feature -> CString -> Word -> IO () +-- | Data type for holding variation data. +-- Registered OpenType variation-axis tags are listed in +-- [OpenType Axis Tag Registry](https://docs.microsoft.com/en-us/typography/opentype/spec/dvaraxisreg). data Variation = Variation { varTag' :: Word32, + -- ^ Tag of the variation-axis name. Use `verTag` to decode as an ASCII string. varValue :: Float + -- ^ Value of the variation axis. } deriving (Read, Show, Generic) instance GStorable Variation +-- | Parses a string into a hb_variation_t. +-- The format for specifying variation settings follows. +-- All valid CSS font-variation-settings values other than 'normal' and 'inherited' +-- are also accepted, though, not documented below. +-- The format is a tag, optionally followed by an equals sign, followed by a number. +-- For example wght=500, or slnt=-7.5. parseVariation :: String -> Maybe Variation parseVariation str = unsafePerformIO $ withCStringLen str $ \(str', len) -> alloca $ \ret' -> do success <- hb_variation_from_string str' len ret' if success then Just <$> peek ret' else return Nothing foreign import ccall "hb_variation_from_string" hb_variation_from_string :: CString -> Int -> Ptr Variation -> IO Bool +-- | Converts a `Variation` into a `String` in the format understood by `parseVariation`. unparseVariation var = unsafePerformIO $ alloca $ \var' -> allocaBytes 128 $ \ret' -> do var' `poke` var hb_variation_to_string var' ret' 128 @@ -64,25 +98,39 @@ unparseVariation var = unsafePerformIO $ alloca $ \var' -> allocaBytes 128 $ \re foreign import ccall "hb_variation_to_string" hb_variation_to_string :: Ptr Variation -> CString -> Word -> IO () +-- | Tag of the feature. featTag = tag_to_string . featTag' +-- | Tag of the variation-axis. varTag = tag_to_string . varTag' globalStart, globalEnd :: Word +-- | Special setting for `featStart` to apply the feature from the start of the buffer. globalStart = 0 +-- | Special setting for `featEnd` to apply the feature to the end of the buffer. globalEnd = maxBound ------ --- Faces ------ +-- | Fetches the number of `Face`s in a `ByteString`. countFace :: ByteString -> Word countFace bytes = unsafePerformIO $ do blob <- bs2blob bytes withForeignPtr blob hb_face_count foreign import ccall "hb_face_count" hb_face_count :: Blob_ -> IO Word +-- | A Font face. type Face = ForeignPtr Face' type Face_ = Ptr Face' data Face' +-- | Constructs a new face object from the specified blob and a face index into that blob. +-- The face index is used for blobs of file formats such as TTC and and DFont that +-- can contain more than one face. Face indices within such collections are zero-based. +-- Note: If the blob font format is not a collection, index is ignored. Otherwise, +-- only the lower 16-bits of index are used. The unmodified index can be accessed +-- via hb_face_get_index(). +-- Note: The high 16-bits of index, if non-zero, are used by hb_font_create() to +-- load named-instances in variable fonts. See hb_font_create() for details. createFace :: ByteString -> Word -> Face createFace bytes index = unsafePerformIO $ do blob <- bs2blob bytes @@ -93,16 +141,20 @@ foreign import ccall "hb_face_create" hb_face_create :: Blob_ -> Word -> IO Face foreign import ccall "hb_face_make_immutable" hb_face_make_immutable :: Face_ -> IO () foreign import ccall "&hb_face_destroy" hb_face_destroy :: FunPtr (Face_ -> IO ()) -ftCreateFace :: FT_Face -> Face -ftCreateFace = - unsafePerformIO . newForeignPtr hb_face_destroy . hb_ft_face_create_referenced +-- | Creates a`Face` object from the specified `FT_Face`. +-- Not thread-safe due to FreeType dependency. +ftCreateFace :: FT_Face -> IO Face +ftCreateFace = newForeignPtr hb_face_destroy . hb_ft_face_create_referenced foreign import ccall "hb_ft_face_create_referenced" hb_ft_face_create_referenced :: FT_Face -> Face_ +-- | Fetches the singleton empty `Face` object. emptyFace :: Face emptyFace = unsafePerformIO $ newForeignPtr hb_face_destroy hb_face_get_empty foreign import ccall "hb_face_get_empty" hb_face_get_empty :: Face_ +-- | Fetches a list of all table tags for a face, if possible. +-- The list returned will begin at the offset provided faceTableTags :: Face -> Word -> Word -> (Word, [String]) faceTableTags fce offs cnt = unsafePerformIO $ withForeignPtr fce $ \fce' -> do alloca $ \cnt' -> allocaBytes (fromEnum cnt * 4) $ \arr' -> do @@ -114,55 +166,151 @@ faceTableTags fce offs cnt = unsafePerformIO $ withForeignPtr fce $ \fce' -> do foreign import ccall "hb_face_get_table_tags" hb_face_get_table_tags :: Face_ -> Word -> Ptr Word -> Ptr Word32 -> IO Word +-- | Fetches the glyph-count value of the specified face object. faceGlyphCount :: Face -> Word faceGlyphCount = faceFunc hb_face_get_glyph_count foreign import ccall "hb_face_get_glyph_count" hb_face_get_glyph_count :: Face_ -> Word +-- | Collects all of the Unicode characters covered by `Face` into a list of unique values. faceCollectUnicodes :: Face -> [Word32] faceCollectUnicodes = faceCollectFunc hb_face_collect_unicodes foreign import ccall "hb_face_collect_unicodes" hb_face_collect_unicodes :: Face_ -> Set_ -> IO () +-- | Collects all Unicode "Variation Selector" characters covered by `Face` +-- into a list of unique values. faceCollectVarSels :: Face -> [Word32] faceCollectVarSels = faceCollectFunc hb_face_collect_variation_selectors foreign import ccall "hb_face_collect_variation_selectors" hb_face_collect_variation_selectors :: Face_ -> Set_ -> IO () +-- | Collects all Unicode characters for variation_selector covered by `Face` +-- into a list of unique values. faceCollectVarUnicodes :: Face -> Word32 -> [Word32] faceCollectVarUnicodes fce varSel = (faceCollectFunc inner) fce where inner a b = hb_face_collect_variation_unicodes a varSel b foreign import ccall "hb_face_collect_variation_unicodes" hb_face_collect_variation_unicodes :: Face_ -> Word32 -> Set_ -> IO () +-- | Fetches the face-index corresponding to the given `Face`. faceIndex :: Face -> Word faceIndex = faceFunc hb_face_get_index foreign import ccall "hb_face_get_index" hb_face_get_index :: Face_ -> Word --- | units-per-em +-- | Fetches the units-per-em (upem) value of the specified `Face` object. faceUpem :: Face -> Word faceUpem = faceFunc hb_face_get_upem foreign import ccall "hb_face_get_upem" hb_face_get_upem :: Face_ -> Word +-- | Fetches the binary blob that contains the specified `Face`. +-- Returns an empty `ByteString` if referencing face data is not possible. faceBlob :: Face -> ByteString faceBlob = blob2bs . faceFunc hb_face_reference_blob foreign import ccall "hb_face_reference_blob" hb_face_reference_blob :: Face_ -> Blob_ +-- | Fetches the specified table within the specified face. faceTable :: Face -> String -> ByteString faceTable face tag = blob2bs $ unsafePerformIO $ withForeignPtr face $ \fce' -> do hb_face_reference_table fce' $ tag_from_string tag foreign import ccall "hb_face_reference_table" hb_face_reference_table :: Face_ -> Word32 -> IO Blob_ --- TODO Do we want setters? How to expose those? --- TODO Face builders? +------ +--- Configure faces +------ + +-- | Allows configuring properties on a `Face` when creating it. +data FaceOptions = FaceOptions { + faceOptGlyphCount :: Maybe Int, + -- ^ Sets the glyph count for a newly-created `Face` to the specified value. + faceOptIndex :: Maybe Word, + -- ^ Assigns the specified face-index to the newly-created `Face`. + -- Note: changing the index has no effect on the face itself, + -- only value returned by `faceIndex`. + faceOptUPEm :: Maybe Word + -- ^ Sets the units-per-em (upem) for a newly-created `Face` object + -- to the specified value. +} +-- | `FaceOptions` which has no effect on the newly-created `Face` object. +defaultFaceOptions = FaceOptions Nothing Nothing Nothing +-- | Internal utility to apply the given `FaceOptions` to a `Face`. +_setFaceOptions face opts = do + case faceOptGlyphCount opts of + Just x -> hb_face_set_glyph_count face x + Nothing -> return () + case faceOptIndex opts of + Just x -> hb_face_set_index face x + Nothing -> return () + case faceOptUPEm opts of + Just x -> hb_face_set_upem face x + Nothing -> return () +foreign import ccall "hb_face_set_glyph_count" hb_face_set_glyph_count + :: Face_ -> Int -> IO () +foreign import ccall "hb_face_set_index" hb_face_set_index :: Face_ -> Word -> IO () +foreign import ccall "hb_face_set_upem" hb_face_set_upem :: Face_ -> Word -> IO () + +-- | Variant of `createFace` which applies given options. +createFaceWithOpts :: FaceOptions -> ByteString -> Word -> Face +createFaceWithOpts opts bytes index = unsafePerformIO $ do + blob <- bs2blob bytes + face <- withForeignPtr blob $ flip hb_face_create index + _setFaceOptions face opts + hb_face_make_immutable face + newForeignPtr hb_face_destroy face +-- | Variant of `ftCreateFace` which applies given options. +ftCreateFaceWithOpts :: FaceOptions -> FT_Face -> IO Face +ftCreateFaceWithOpts opts ftFace = do + let face = hb_ft_face_create_referenced ftFace + _setFaceOptions face opts + hb_face_make_immutable face + newForeignPtr hb_face_destroy face + +-- | Creates a `Face` containing the specified tables+tags, with the specified options. +-- Can be compiled to a binary font file by calling `faceBlob`, +-- with tables sorted by size then tag. +buildFace :: [(String, ByteString)] -> FaceOptions -> Face +buildFace tables opts = unsafePerformIO $ do + builder <- hb_face_builder_create + forM tables $ \(tag, bytes) -> do + blob <- bs2blob bytes + withForeignPtr blob $ hb_face_builder_add_table builder $ tag_from_string tag + _setFaceOptions builder opts + hb_face_make_immutable builder + newForeignPtr hb_face_destroy builder +foreign import ccall "hb_face_builder_create" hb_face_builder_create :: IO Face_ +foreign import ccall "hb_face_builder_add_table" hb_face_builder_add_table + :: Face_ -> Word32 -> Blob_ -> IO Bool +{- +-- | Creates a `Face` containing the specified tables+tags, with the specified options. +-- Can be compiled to a binary font file by calling `faceBlob`, +-- with tables in the given order. +buildOrderedFace :: [(String, ByteString)] -> FaceOptions -> Face +buildOrderedFace tables opts = unsafePerformIO $ do + builder <- hb_face_builder_create + forM tables $ \(tag, bytes) -> do + blob <- bs2blob bytes + withForeignPtr blob $ hb_face_builder_add_table builder $ tag_from_string tag + withArray (map tag_from_string $ map fst tables) $ hb_face_builder_sort_tables builder + _setFaceOptions builder opts + hb_face_make_immutable builder + newForeignPtr hb_face_destroy builder +foreign import ccall "hb_face_builder_sort_tables" hb_face_builder_sort_tables + :: Face_ -> Ptr Word32 -> IO ()-} ------ --- Fonts ------ +-- | Data type for holding fonts type Font = ForeignPtr Font' type Font_ = Ptr Font' data Font' +-- | Constructs a new `Font` object from the specified `Face`. +-- Note: If face's index value (as passed to `createFace` has non-zero top 16-bits, +-- those bits minus one are passed to hb_font_set_var_named_instance(), +-- effectively loading a named-instance of a variable font, +-- instead of the default-instance. +-- This allows specifying which named-instance to load by default when creating the face. createFont :: Face -> Font createFont fce = unsafePerformIO $ do font <- withForeignPtr fce $ hb_font_create @@ -172,6 +320,10 @@ 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 ()) +-- | Creates an hb_font_t font object from the specified FT_Face. +-- Note: You must set the face size on ft_face before calling `ftCreateFont` on it. +-- HarfBuzz assumes size is always set +-- and will access `size` member of `FT_Face` unconditionally. ftCreateFont :: FT_Face -> IO Font ftCreateFont fce = do font <- hb_ft_font_create_referenced fce @@ -180,16 +332,29 @@ ftCreateFont fce = do foreign import ccall "hb_ft_font_create_referenced" hb_ft_font_create_referenced :: FT_Face -> IO Font_ +-- | Constructs a sub-font font object from the specified parent font, +-- replicating the parent's properties. +createSubFont :: Font -> Font +createSubFont parent = unsafePerformIO $ do + font <- withForeignPtr parent $ hb_font_create_sub_font + hb_font_make_immutable font + newForeignPtr hb_font_destroy font +foreign import ccall "hb_font_create_sub_font" hb_font_create_sub_font :: Font_ -> IO Font_ + +-- | Fetches the empty `Font` object. emptyFont :: Font emptyFont = unsafePerformIO $ newForeignPtr hb_font_destroy hb_font_get_empty foreign import ccall "hb_font_get_empty" hb_font_get_empty :: Font_ +-- | Fetches the `Face` associated with the specified `Font` object. fontFace :: Font -> Face fontFace font = unsafePerformIO $ withForeignPtr font $ \font' -> do face' <- hb_font_get_face font' newForeignPtr_ face' -- FIXME: Keep the font alive... foreign import ccall "hb_font_get_face" hb_font_get_face :: Font_ -> IO Face_ + -- | Fetches the glyph ID for a Unicode codepoint in the specified `Font`, + -- with an optional variation selector. fontGlyph :: Font -> Char -> Maybe Char -> Maybe Word32 fontGlyph font char var = unsafePerformIO $ withForeignPtr font $ \font' -> alloca $ \ret -> do @@ -198,6 +363,10 @@ fontGlyph font char var = foreign import ccall "hb_font_get_glyph" hb_font_get_glyph :: Font_ -> Word32 -> Word32 -> Ptr Word32 -> IO Bool +-- | Fetches the advance for a glyph ID from the specified font, +-- in a text segment of the specified direction. +-- Calls the appropriate direction-specific variant (horizontal or vertical) +-- depending on the value of direction . fontGlyphAdvance :: Font -> Word32 -> Maybe Direction -> (Int32, Int32) fontGlyphAdvance font glyph dir = unsafePerformIO $ withForeignPtr font $ \font' -> alloca $ \x' -> alloca $ \y' -> do @@ -209,6 +378,8 @@ 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 () +-- | Fetches the (x,y) coordinates of a specified contour-point index +-- in the specified glyph, within the specified font. fontGlyphContourPoint :: Font -> Word32 -> Int -> Maybe (Int32, Int32) fontGlyphContourPoint font glyph index = unsafePerformIO $ withForeignPtr font $ \font' -> alloca $ \x' -> alloca $ \y' -> do @@ -222,6 +393,11 @@ fontGlyphContourPoint font glyph index = unsafePerformIO $ foreign import ccall "hb_font_get_glyph_contour_point" hb_font_get_glyph_contour_point :: Font_ -> Word32 -> Int -> Ptr Int32 -> Ptr Int32 -> IO Bool +-- | Fetches the (X,Y) coordinates of a specified contour-point index +-- in the specified glyph ID in the specified font, +-- with respect to the origin in a text segment in the specified direction. +-- Calls the appropriate direction-specific variant (horizontal or vertical) +-- depending on the value of direction . fontGlyphContourPointForOrigin :: Font -> Word32 -> Int -> Maybe Direction -> Maybe (Int32, Int32) fontGlyphContourPointForOrigin font glyph index dir = unsafePerformIO $ withForeignPtr font $ \font' -> alloca $ \x' -> alloca $ \y' -> do @@ -237,11 +413,20 @@ 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 +-- | Glyph extent values, measured in font units. +-- Note that height is negative, in coordinate systems that grow up. data GlyphExtents = GlyphExtents { - xBearing :: Word32, yBearing :: Word32, - width :: Word32, height :: Word32 + xBearing :: Word32, + -- ^ Distance from the x-origin to the left extremum of the glyph. + yBearing :: Word32, + -- ^ Distance from the top extremum of the glyph to the y-origin. + width :: Word32, + -- ^ Distance from the left extremum of the glyph to the right extremum. + height :: Word32 + -- ^ Distance from the top extremum of the glyph to the right extremum. } deriving (Generic) -instance GStorable GlyphExtents +instance GStorable GlyphExtents +-- | Fetches the `GlyphExtents` data for a glyph ID in the specified `Font`. fontGlyphExtents :: Font -> Word32 -> Maybe GlyphExtents fontGlyphExtents font glyph = unsafePerformIO $ withForeignPtr font $ \font' -> alloca $ \ret -> do @@ -252,6 +437,10 @@ fontGlyphExtents font glyph = unsafePerformIO $ foreign import ccall "hb_font_get_glyph_extents" hb_font_get_glyph_extents :: Font_ -> Word32 -> Ptr GlyphExtents -> IO Bool +-- | Fetches the `GlyphExtents` data for a glyph ID in the specified `Font`, +-- with respect to the origin in a text segment in the specified direction. +-- Calls the appropriate direction-specific variant (horizontal or vertical) +-- depending on the value of `dir`. fontGlyphExtentsForOrigin :: Font -> Word32 -> Maybe Direction -> Maybe GlyphExtents fontGlyphExtentsForOrigin font glyph dir = unsafePerformIO $ withForeignPtr font $ \font' -> alloca $ \ret -> do @@ -263,32 +452,41 @@ foreign import ccall "hb_font_get_glyph_extents_for_origin" hb_font_get_glyph_extents_for_origin :: Font_ -> Word32 -> Int -> Ptr GlyphExtents -> IO Bool +-- | Fetches the glyph ID that corresponds to a name string in the specified `Font`. 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 + success <- withCStringLen name $ \(name', len) -> + hb_font_get_glyph_from_name font' name' len ret if success 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 +-- | Fetches the advance for a glyph ID in the specified `Font`, +-- for horizontal text segments. fontGlyphHAdvance :: Font -> Word32 -> Int32 fontGlyphHAdvance = fontFunc hb_font_get_glyph_h_advance foreign import ccall "hb_font_get_glyph_h_advance" hb_font_get_glyph_h_advance :: Font_ -> Word32 -> Int32 +-- | Fetches the advance for a glyph ID in the specified `Font`, +-- for vertical text segments. fontGlyphVAdvance :: Font -> Word32 -> Int32 fontGlyphVAdvance = fontFunc hb_font_get_glyph_v_advance foreign import ccall "hb_font_get_glyph_v_advance" hb_font_get_glyph_v_advance :: Font_ -> Word32 -> Int32 +-- | Fetches the kerning-adjustment value for a glyph-pair in the specified `Font`, +-- for horizontal text segments. fontGlyphHKerning :: Font -> Word32 -> Word32 -> Int32 fontGlyphHKerning = fontFunc hb_font_get_glyph_h_kerning foreign import ccall "hb_font_get_glyph_h_kerning" hb_font_get_glyph_h_kerning :: Font_ -> Word32 -> Word32 -> Int32 +-- | Fetches the (X,Y) coordinate of the origin for a glyph ID in the specified `Font`, +-- for horizontal text segments. fontGlyphHOrigin :: Font -> Word32 -> Maybe (Int32, Int32) fontGlyphHOrigin font glyph = unsafePerformIO $ withForeignPtr font $ \font' -> alloca $ \x' -> alloca $ \y' -> do @@ -302,6 +500,8 @@ fontGlyphHOrigin font glyph = unsafePerformIO $ withForeignPtr font $ \font' -> foreign import ccall "hb_font_get_glyph_h_origin" hb_font_get_glyph_h_origin :: Font_ -> Word32 -> Ptr Int32 -> Ptr Int32 -> IO Bool +-- | Fetches the (X,Y) coordinates of the origin for a glyph ID in the specified `Font`, +-- for vertical text segments. fontGlyphVOrigin :: Font -> Word32 -> Maybe (Int32, Int32) fontGlyphVOrigin font glyph = unsafePerformIO $ withForeignPtr font $ \font' -> alloca $ \x' -> alloca $ \y' -> do @@ -315,7 +515,9 @@ fontGlyphVOrigin font glyph = unsafePerformIO $ withForeignPtr font $ \font' -> foreign import ccall "hb_font_get_glyph_v_origin" hb_font_get_glyph_v_origin :: Font_ -> Word32 -> Ptr Int32 -> Ptr Int32 -> IO Bool - +-- | Fetches the kerning-adjustment value for a glyph-pair in the specified `Font`. +-- Calls the appropriate direction-specific variant (horizontal or vertical) +-- depending on the value of `dir`. fontGlyphKerningForDir :: Font -> Word32 -> Word32 -> Maybe Direction -> (Int32, Int32) fontGlyphKerningForDir font a b dir = unsafePerformIO $ withForeignPtr font $ \font' -> alloca $ \x' -> alloca $ \y' -> do @@ -327,8 +529,11 @@ 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 () +-- | Fetches the glyph-name string for a glyph ID in the specified `font`. fontGlyphName :: Font -> Word32 -> Maybe String fontGlyphName a b = fontGlyphName_ a b 32 +-- | Variant of `fontGlyphName` which lets you specify the maximum of the return value. +-- Defaults to 32. fontGlyphName_ :: Font -> Word32 -> Int -> Maybe String fontGlyphName_ font glyph size = unsafePerformIO $ withForeignPtr font $ \font' -> allocaBytes size $ \name' -> do @@ -339,6 +544,9 @@ fontGlyphName_ font glyph size = unsafePerformIO $ withForeignPtr font $ \font' foreign import ccall "hb_font_get_glyph_name" hb_font_get_glyph_name :: Font_ -> Word32 -> CString -> Word32 -> IO Bool +-- | Fetches the (X,Y) coordinates of the origin for a glyph in the specified `Font`. +-- Calls the appropriate direction-specific variant (horizontal or vertical) +-- depending on the value of `dir`. fontGlyphOriginForDir :: Font -> Word32 -> Maybe Direction -> (Int32, Int32) fontGlyphOriginForDir font glyph dir = unsafePerformIO $ withForeignPtr font $ \font' -> alloca $ \x' -> alloca $ \y' -> do @@ -352,6 +560,10 @@ foreign import ccall "hb_font_get_glyph_origin_for_direction" -- Skipping Draw methodtables, easier to use FreeType for that. +-- | Fetches the nominal glyph ID for a Unicode codepoint in the specified font. +-- This version of the function should not be used to fetch glyph IDs for codepoints +-- modified by variation selectors. For variation-selector support use +-- `fontVarGlyph` or use `fontGlyph`. fontNominalGlyph :: Font -> Char -> Maybe Word32 fontNominalGlyph font c = unsafePerformIO $ withForeignPtr font $ \font' -> alloca $ \glyph' -> do @@ -360,6 +572,13 @@ fontNominalGlyph font c = foreign import ccall "hb_font_get_nominal_glyph" hb_font_get_nominal_glyph :: Font_ -> Word32 -> Ptr Word32 -> IO Bool +-- | Fetches the parent of the given `Font`. +fontParent :: Font -> Font +fontParent child = + unsafePerformIO (newForeignPtr_ =<< withForeignPtr child hb_font_get_parent) +foreign import ccall "hb_font_get_parent" hb_font_get_parent :: Font_ -> IO Font_ + +-- | Fetches the horizontal & vertical points-per-em (ppem) of a `Font`. fontPPEm :: Font -> (Word32, Word32) fontPPEm font = unsafePerformIO $ withForeignPtr font $ \font' -> alloca $ \x' -> alloca $ \y' -> do @@ -370,10 +589,12 @@ fontPPEm font = foreign import ccall "hb_font_get_ppem" hb_font_get_ppem :: Font_ -> Ptr Word32 -> Ptr Word32 -> IO () +-- | Fetches the "point size" of a `Font`. Used in CoreText to implement optical sizing. fontPtEm :: Font -> Float fontPtEm = fontFunc hb_font_get_ptem foreign import ccall "hb_font_get_ptem" hb_font_get_ptem :: Font_ -> Float +-- | Fetches the horizontal and vertical scale of a `Font`. fontScale :: Font -> (Int, Int) fontScale font = unsafePerformIO $ withForeignPtr font $ \font' -> alloca $ \x' -> alloca $ \y' -> do @@ -384,11 +605,15 @@ fontScale font = unsafePerformIO $ foreign import ccall "hb_font_get_scale" hb_font_get_scale :: Font_ -> Ptr Int -> Ptr Int -> IO () -{-fontSyntheticSlant :: Font -> Float +{- +-- | Fetches the "synthetic slant" of a font. +fontSyntheticSlant :: Font -> Float fontSyntheticSlant = fontFunc hb_font_get_synthetic_slant foreign import ccall "hb_font_get_synthetic_slant" hb_font_get_synthetic_slant :: Font_ -> Float-} +-- | Fetches the glyph ID for a Unicode codepoint when followed by +-- the specified variation-selector codepoint, in the specified `Font`. fontVarGlyph :: Font -> Word32 -> Word32 -> Maybe Word32 fontVarGlyph font unicode varSel = unsafePerformIO $ withForeignPtr font $ \font' -> alloca $ \glyph' -> do @@ -399,7 +624,12 @@ fontVarGlyph font unicode varSel = unsafePerformIO $ foreign import ccall "hb_font_get_variation_glyph" hb_font_get_variation_glyph :: Font_ -> Word32 -> Word32 -> Ptr Word32 -> IO Bool -{-fontVarCoordsDesign :: Font -> [Float] +{- +-- | Fetches the list of variation coordinates (in design-space units) +-- currently set on a `Font`. +-- Note that this returned list may only contain values for some (or none) of the axes; +-- ommitted axes effectively have their default values. +fontVarCoordsDesign :: Font -> [Float] fontVarCoordsDesign font = unsafePerformIO $ withForeignPtr font $ \font' -> alloca $ \length' -> do arr <- hb_font_get_var_coords_design font' length' @@ -408,6 +638,9 @@ fontVarCoordsDesign font = unsafePerformIO $ foreign import ccall "hb_font_get_var_coords_design" hb_font_get_var_coords_design :: Font_ -> Ptr Word -> IO (Ptr Float)-} +-- | Fetches the list of normalized variation coordinates currently set on a font. +-- Note that this returned list may only contain values for some (or none) of the axes; +-- ommitted axes effectively have default values. fontVarCoordsNormalized :: Font -> [Int] fontVarCoordsNormalized font = unsafePerformIO $ withForeignPtr font $ \font' -> alloca $ \length' -> do @@ -417,17 +650,22 @@ fontVarCoordsNormalized font = unsafePerformIO $ foreign import ccall "hb_font_get_var_coords_normalized" hb_font_get_var_coords_normalized :: Font_ -> Ptr Word -> IO (Ptr Int) +-- | Fetches the glyph ID from given `Font` that matches the specified string. +-- Strings of the format gidDDD or uniUUUU are parsed automatically. 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 + ok <- withCStringLen str $ \(str', len) -> + hb_font_glyph_from_string font' str' len ret if ok then return . Just =<< peek ret else return Nothing foreign import ccall "hb_font_glyph_from_string" hb_font_glyph_from_string :: Font_ -> CString -> Int -> Ptr Word32 -> IO Bool +-- | Fetches the name of the specified glyph ID in given `Font` as a string. +-- If the glyph ID has no name in the `Font`, a string of the form gidDDD is generated +-- with DDD being the glyph ID. fontGlyph2Str :: Font -> Word32 -> Int -> String fontGlyph2Str font glyph length = unsafePerformIO $ withForeignPtr font $ \font' -> allocaBytes length $ \ret -> do @@ -436,12 +674,23 @@ fontGlyph2Str font glyph length = unsafePerformIO $ foreign import ccall "hb_font_glyph_to_string" hb_font_glyph_to_string :: Font_ -> Word32 -> CString -> Int -> IO () +-- | Font-wide extent values, measured in font units. +-- Note that typically ascender is positive and descender is negative, +-- in coordinate systems that grow up. +-- Note: Due to presence of 9 additional private fields, +-- arrays of font extents will not decode correctly. So far this doesn't matter. data FontExtents = FontExtents { ascender :: Int32, + -- ^ The height of typographic ascenders. descender :: Int32, + -- ^ The depth of typographic descenders. lineGap :: Int32 + -- ^ The suggested line-spacing gap. } deriving (Generic) instance GStorable FontExtents +-- | Fetches the extents for a font in a text segment of the specified direction. +-- Calls the appropriate direction-specific variant (horizontal or vertical) +-- depending on the value of direction . fontExtentsForDir :: Font -> Maybe Direction -> FontExtents fontExtentsForDir font dir = unsafePerformIO $ alloca $ \ret -> do withForeignPtr font $ \font' -> @@ -450,6 +699,7 @@ fontExtentsForDir font dir = unsafePerformIO $ alloca $ \ret -> do foreign import ccall "hb_font_get_extents_for_direction" hb_font_get_extents_for_direction :: Font_ -> Int -> Ptr FontExtents -> IO () +-- | Fetches the extents for a specified font, for horizontal text segments. fontHExtents font = unsafePerformIO $ alloca $ \ret -> do ok <- withForeignPtr font $ \font' -> hb_font_get_h_extents font' ret if ok @@ -458,6 +708,7 @@ fontHExtents font = unsafePerformIO $ alloca $ \ret -> do foreign import ccall "hb_font_get_h_extents" hb_font_get_h_extents :: Font_ -> Ptr FontExtents -> IO Bool +-- | Fetches the extents for a specified font, for vertical text segments. fontVExtents font = unsafePerformIO $ alloca $ \ret -> do ok <- withForeignPtr font $ \font' -> hb_font_get_v_extents font' ret if ok @@ -466,7 +717,7 @@ fontVExtents font = unsafePerformIO $ alloca $ \ret -> do foreign import ccall "hb_font_get_v_extents" hb_font_get_v_extents :: Font_ -> Ptr FontExtents -> IO Bool --- Not exposing the Font Funcs API as being extremely imparative with little value to callers. +-- Not exposing the Font Funcs API as being extremely imperative with little value to callers. ------ --- Configurable fonts @@ -474,12 +725,43 @@ foreign import ccall "hb_font_get_v_extents" hb_font_get_v_extents data FontOptions = FontOptions { optionPPEm :: Maybe (Word, Word), + -- ^ Sets the horizontal and vertical pixels-per-em (ppem) of the newly-created `Font`. optionPtEm :: Maybe Float, - optionScale :: Maybe (Int, Int) + -- ^ Sets the "point size" of a newly-created `Font`. + -- Used in CoreText to implement optical sizing. + -- Note: There are 72 points in an inch. + optionScale :: Maybe (Int, Int), + -- ^ Sets the horizontal and vertical scale of a newly-created `Font`. + optionFace :: Maybe Face, + -- ^ Sets the font-face value of the newly-created `Font`. + optionParent :: Maybe Font, + -- ^ Sets the parent `Font` of the newly-created `Font`. +-- optionSynthSlant :: Maybe Float, + -- ^ Sets the "synthetic slant" of a newly-created `Font`. By default is zero. + -- Synthetic slant is the graphical skew applied to the font at rendering time. + -- Harfbuzz needs to know this value to adjust shaping results, metrics, + -- and style valuesto match the slanted rendering. + -- Note: The slant value is a ratio. For example, a 20% slant would be + -- represented as a 0.2 value. + optionVariations :: [Variation], + -- ^ Applies a list of font-variation settings to a font. + -- Axes not included will be effectively set to their default values. + optionVarCoordsDesign :: [Float], + -- ^ Applies a list of variation coordinates (in design-space units) + -- to a newly-created `Font`. + -- Axes not included in coords will be effectively set to their default values. + optionVarCoordsNormalized :: [Int], + -- ^ Applies a list of variation coordinates (in normalized units) + -- to a newly-created `Font`. + -- Axes not included in coords will be effectively set to their default values. + optionVarNamedInstance :: Maybe Word + -- ^ Sets design coords of a font from a named instance index. } defaultFontOptions = FontOptions { - optionPPEm = Nothing, optionPtEm = Nothing, - optionScale = Nothing + optionPPEm = Nothing, optionPtEm = Nothing, optionScale = Nothing, + optionFace = Nothing, optionParent = Nothing,-- optionSynthSlant = Nothing, + optionVariations = [], optionVarCoordsDesign = [], optionVarCoordsNormalized = [], + optionVarNamedInstance = Nothing } _setFontOptions font opts = do case optionPPEm opts of @@ -491,9 +773,43 @@ _setFontOptions font opts = do case optionScale opts of Just (x, y) -> hb_font_set_scale font x y Nothing -> return () + case optionFace opts of + Just face -> withForeignPtr face $ hb_font_set_face font + Nothing -> return () + case optionParent opts of + Just parent -> withForeignPtr parent $ hb_font_set_parent font + Nothing -> return () + {-case optionSynthSlant opts of + Just slant -> hb_font_set_synthetic_slant font slant + Nothing -> return ()-} + + unless (null $ optionVariations opts) $ + withArrayLen (optionVariations opts) $ \len vars -> + hb_font_set_variations font vars $ toEnum len + unless (null $ optionVarCoordsDesign opts) $ + withArrayLen (optionVarCoordsDesign opts) $ \len coords -> + hb_font_set_var_coords_design font coords $ toEnum len + unless (null $ optionVarCoordsNormalized opts) $ + withArrayLen (optionVarCoordsNormalized opts) $ \len coords -> + hb_font_set_var_coords_normalized font coords $ toEnum len + case optionVarNamedInstance opts of + Just inst -> hb_font_set_var_named_instance font inst + Nothing -> return () 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 () +foreign import ccall "hb_font_set_face" hb_font_set_face :: Font_ -> Face_ -> IO () +foreign import ccall "hb_font_set_parent" hb_font_set_parent :: Font_ -> Font_ -> IO () +{-foreign import ccall "hb_font_set_synthetic_slant" hb_font_set_synthetic_slant :: + Font_ -> Float -> IO ()-} +foreign import ccall "hb_font_set_variations" hb_font_set_variations :: + Font_ -> Ptr Variation -> Word -> IO () +foreign import ccall "hb_font_set_var_coords_design" hb_font_set_var_coords_design :: + Font_ -> Ptr Float -> Word -> IO () +foreign import ccall "hb_font_set_var_coords_normalized" + hb_font_set_var_coords_normalized :: Font_ -> Ptr Int -> Word -> IO () +foreign import ccall "hb_font_set_var_named_instance" hb_font_set_var_named_instance :: + Font_ -> Word -> IO () createFontWithOptions :: FontOptions -> Face -> Font createFontWithOptions opts fce = unsafePerformIO $ do -- 2.30.2