Get missing width for the font metrics

This commit is contained in:
Eugen Wissner 2024-02-13 09:16:14 +01:00
parent ca70d648a9
commit eedcacab59
Signed by: belka
GPG Key ID: A27FDC1E8EE902C0
5 changed files with 83 additions and 35 deletions

2
.gitignore vendored
View File

@ -1,4 +1,2 @@
/dist-newstyle/ /dist-newstyle/
/dist/ /dist/
/fonts/

View File

@ -40,3 +40,12 @@ fountainhead --help
for help. for help.
## Usage ## Usage
TrueType and OpenType fonts consist of a sequence of tables and various
informations about the font are encoded in these tables. There are both
required and optional tables. The first table is a font directory and it
describes the overall structure of the font, what tables it contains and at what
offset other tables can be found.
This library doesn't parse the whole font at once. The font directory has to be
parsed first and can be used then to parse further tables as needed.

BIN
fonts/OpenSans-Bold.ttf Normal file

Binary file not shown.

View File

@ -18,29 +18,38 @@ module Graphics.Fountainhead.Metrics
import Data.ByteString (ByteString) import Data.ByteString (ByteString)
import Data.List (findIndex) import Data.List (findIndex)
import qualified Data.List.NonEmpty as NonEmpty
import Data.Text (Text) import Data.Text (Text)
import qualified Data.Text.Encoding as Text import qualified Data.Text.Encoding as Text
import Graphics.Fountainhead.TrueType import Graphics.Fountainhead.TrueType
( HeadTable(..) ( BSerifStyle(..)
, FontDirectory(..)
, HeadTable(..)
, HheaTable(..) , HheaTable(..)
, HmtxTable(..)
, LongHorMetric(..)
, NameRecord(..) , NameRecord(..)
, NameTable(..) , NameTable(..)
, Os2BaseFields(..) , Os2BaseFields(..)
, Os2Version4Fields(..) , Os2Version4Fields(..)
, Os2Version5Fields(..) , Os2Version5Fields(..)
, Os2Table(..) , Os2Table(..)
, Panose(..)
, PostHeader(..) , PostHeader(..)
, PostTable(..) , PostTable(..)
, findTableByTag , findTableByTag
, pattern Os2Version4CommonFields , pattern Os2Version4CommonFields
) )
import Graphics.Fountainhead.Parser import Graphics.Fountainhead.Parser
( ParseErrorBundle ( Parser
, ParseErrorBundle
, ParseState
, nameTableP , nameTableP
, parseFontDirectory , parseFontDirectory
, parseTable , parseTable
, headTableP , headTableP
, hheaTableP , hheaTableP
, hmtxTableP
, os2TableP , os2TableP
, postTableP , postTableP
) )
@ -124,36 +133,34 @@ collectMetrics fontFile ttfContents =
(_processedState, Left initialResult) -> Left (_processedState, Left initialResult) -> Left
$ MetricsParseError initialResult $ MetricsParseError initialResult
(processedState, Right initialResult) -> do (processedState, Right initialResult) -> do
nameEntry <- maybeMetricsError (MetricsRequiredTableMissingError "name") let parseForMetrics' = parseForMetrics processedState initialResult
$ findTableByTag "name" initialResult
NameTable{ nameRecord, variable } <- first MetricsParseError NameTable{ nameRecord, variable } <- parseForMetrics' "name" nameTableP
$ parseTable nameEntry nameTableP processedState
psNameIndex <- maybeMetricsError (MetricsNameRecordNotFound 6) psNameIndex <- maybeMetricsError (MetricsNameRecordNotFound 6)
$ findIndex ((6 ==) . getField @"nameID") nameRecord $ findIndex ((6 ==) . getField @"nameID") nameRecord
headEntry <- maybeMetricsError (MetricsRequiredTableMissingError "head") headTable@HeadTable{ unitsPerEm } <- parseForMetrics' "head" headTableP
$ findTableByTag "head" initialResult
headTable@HeadTable{ unitsPerEm } <- first MetricsParseError
$ parseTable headEntry headTableP processedState
let scale = (1000.0 :: Float) / fromIntegral unitsPerEm let scale = (1000.0 :: Float) / fromIntegral unitsPerEm
hheaEntry <- maybeMetricsError (MetricsRequiredTableMissingError "hhea") HheaTable{ ascent, descent, numOfLongHorMetrics } <-
$ findTableByTag "hhea" initialResult parseForMetrics' "hhea" hheaTableP
HheaTable{ ascent, descent } <- first MetricsParseError PostTable{ postHeader } <- parseForMetrics' "post" postTableP
$ parseTable hheaEntry hheaTableP processedState
postEntry <- maybeMetricsError (MetricsRequiredTableMissingError "post") (capHeight, os2BaseFields) <- getCapHeight processedState initialResult
$ findTableByTag "post" initialResult let Os2BaseFields{ usWeightClass, panose } = os2BaseFields
PostTable{ postHeader } <- first MetricsParseError
$ parseTable postEntry postTableP processedState
(capHeight, weightClass) <- getCapHeight processedState initialResult HmtxTable{ hMetrics } <- parseForMetrics' "hmtx"
$ hmtxTableP numOfLongHorMetrics
let fixedPitchFlag = if getField @"isFixedPitch" postHeader > 0 then Just FixedPitch else Nothing
isSerifFlag = if isSerif $ getField @"bSerifStyle" panose then Just Serif else Nothing
pure $ FontDescriptor pure $ FontDescriptor
{ fontName = variableText nameRecord variable psNameIndex { fontName = variableText nameRecord variable psNameIndex
, flags = [] , flags = []
, stemV = calculateStemV $ fromIntegral weightClass , stemV = calculateStemV $ fromIntegral usWeightClass
, missingWidth = 0 , missingWidth = fromIntegral $ scalePs scale
$ getField @"advanceWidth" $ NonEmpty.head hMetrics
, fontBBox = calculateBoundingBox scale headTable , fontBBox = calculateBoundingBox scale headTable
, italicAngle = realToFrac $ getField @"italicAngle" postHeader , italicAngle = realToFrac $ getField @"italicAngle" postHeader
, capHeight = fromIntegral $ scalePs scale capHeight , capHeight = fromIntegral $ scalePs scale capHeight
@ -163,15 +170,12 @@ collectMetrics fontFile ttfContents =
where where
calculateStemV weightClass = 10 + 220 * (weightClass - 50) / 900 calculateStemV weightClass = 10 + 220 * (weightClass - 50) / 900
getCapHeight processedState initialResult = do getCapHeight processedState initialResult = do
os2Entry <- maybeMetricsError (MetricsRequiredTableMissingError "OS/2") os2Table <- parseForMetrics processedState initialResult "OS/2" os2TableP
$ findTableByTag "OS/2" initialResult
os2Table <- first MetricsParseError
$ parseTable os2Entry os2TableP processedState
case os2Table of case os2Table of
Os2Version4CommonFields Os2BaseFields{ usWeightClass } Os2Version4Fields{ sCapHeight } -> Os2Version4CommonFields os2BaseFields Os2Version4Fields{ sCapHeight } ->
Right (sCapHeight, usWeightClass) Right (sCapHeight, os2BaseFields)
Os2Version5 Os2BaseFields{ usWeightClass } _ Os2Version5Fields{ sCapHeight } -> Os2Version5 os2BaseFields _ Os2Version5Fields{ sCapHeight } ->
Right (sCapHeight, usWeightClass) Right (sCapHeight, os2BaseFields)
_ -> Left UnsupportedOs2VersionError _ -> Left UnsupportedOs2VersionError
calculateBoundingBox scale HeadTable{ xMin, xMax, yMin, yMax } = calculateBoundingBox scale HeadTable{ xMin, xMax, yMin, yMax } =
let xMin' = fromIntegral $ scalePs scale xMin let xMin' = fromIntegral $ scalePs scale xMin
@ -179,7 +183,7 @@ collectMetrics fontFile ttfContents =
xMax' = fromIntegral $ scalePs scale xMax xMax' = fromIntegral $ scalePs scale xMax
yMax' = fromIntegral $ scalePs scale yMax yMax' = fromIntegral $ scalePs scale yMax
in FontBBox xMin' yMin' xMax' yMax' in FontBBox xMin' yMin' xMax' yMax'
scalePs :: Float -> Int16 -> Int16 scalePs :: Integral a => Float -> a -> Int16
scalePs scale value = truncate $ fromIntegral value * scale scalePs scale value = truncate $ fromIntegral value * scale
variableText records variables recordIndex = variableText records variables recordIndex =
let NameRecord{ platformID } = records !! recordIndex let NameRecord{ platformID } = records !! recordIndex
@ -187,5 +191,39 @@ collectMetrics fontFile ttfContents =
in if platformID == 1 in if platformID == 1
then Text.decodeUtf8 variable then Text.decodeUtf8 variable
else Text.decodeUtf16BE variable else Text.decodeUtf16BE variable
maybeMetricsError metricsError Nothing = Left metricsError
maybeMetricsError _ (Just result) = Right result parseForMetrics
:: forall a
. ParseState
-> FontDirectory
-> String
-> Parser a
-> Either MetricsError a
parseForMetrics processedState fontDirectory tableName tableParser =
let foundTable = findTableByTag tableName fontDirectory
missingError = MetricsRequiredTableMissingError tableName
parseTable' rawTable = parseTable rawTable tableParser processedState
in maybeMetricsError missingError foundTable
>>= first MetricsParseError . parseTable'
maybeMetricsError :: forall a. MetricsError -> Maybe a -> Either MetricsError a
maybeMetricsError metricsError Nothing = Left metricsError
maybeMetricsError _ (Just result) = Right result
isSerif :: BSerifStyle -> Bool
isSerif AnySerifStyle = False
isSerif NoFitSerifStyle = False
isSerif CoveSerifStyle = True
isSerif ObtuseCoveSerifStyle = True
isSerif SquareCoveSerifStyle = True
isSerif ObtuseSquareCoveSerifStyle = True
isSerif SquareSerifStyle = True
isSerif ThinSerifStyle = True
isSerif BoneSerifStyle = True
isSerif ExaggeratedSerifStyle =True
isSerif TriangleSerifStyle = True
isSerif NormalSansSerifStyle = False
isSerif ObtuseSansSerifStyle = False
isSerif PerpSansSerifStyle = False
isSerif FlaredSerifStyle = True
isSerif RoundedSerifStyle = True

View File

@ -276,7 +276,10 @@ data PostHeader = PostHeader
, italicAngle :: Fixed32 -- ^ Italic angle in degrees , italicAngle :: Fixed32 -- ^ Italic angle in degrees
, underlinePosition :: Int16 -- ^ Underline position , underlinePosition :: Int16 -- ^ Underline position
, underlineThickness :: Int16 -- ^ Underline thickness , underlineThickness :: Int16 -- ^ Underline thickness
, isFixedPitch :: Word32 -- ^ Font is monospaced; set to 1 if the font is monospaced and 0 otherwise (N.B., to maintain compatibility with older versions of the TrueType spec, accept any non-zero value as meaning that the font is monospaced) -- | Font is monospaced; set to 1 if the font is monospaced and 0 otherwise
-- (N.B., to maintain compatibility with older versions of the TrueType
-- spec, accept any non-zero value as meaning that the font is monospaced)
, isFixedPitch :: Word32
, minMemType42 :: Word32 -- ^ Minimum memory usage when a TrueType font is downloaded as a Type 42 font , minMemType42 :: Word32 -- ^ Minimum memory usage when a TrueType font is downloaded as a Type 42 font
, maxMemType42 :: Word32 -- ^ Maximum memory usage when a TrueType font is downloaded as a Type 42 font , maxMemType42 :: Word32 -- ^ Maximum memory usage when a TrueType font is downloaded as a Type 42 font
, minMemType1 :: Word32 -- ^ Minimum memory usage when a TrueType font is downloaded as a Type 1 font , minMemType1 :: Word32 -- ^ Minimum memory usage when a TrueType font is downloaded as a Type 1 font