OSS/fountainhead
1
0
Fork 0
Code Issues 2 Pull Requests Releases Activity

Dump the hhea table

Browse Source
This commit is contained in:
Eugen Wissner 2023-11-17 09:54:26 +01:00
parent ac03d3236d
commit 344467b850
4 changed files with 70 additions and 25 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

57
src/Graphics/Fountainhead/Dumper.hs
View File

@ -32,7 +32,9 @@ import GHC.Records (HasField(..))
import Graphics.Fountainhead.TrueType
( CmapTable(..)
, FontDirectory(..)
, FontDirectionHint(..)
, HeadTable(..)
, HheaTable(..)
, OffsetSubtable(..)
, TableDirectory(..)
, CmapEncoding(..)
@ -46,12 +48,13 @@ import Graphics.Fountainhead.Parser
, parseTable
, cmapTableP
, headTableP
, hheaTableP
)
import Graphics.Fountainhead.Type (ttfEpoch)
import Graphics.Fountainhead.Type (Fixed32(..), ttfEpoch)
import Data.Foldable (Foldable(..))
import Data.Maybe (fromMaybe)
import Data.Time (LocalTime(..), NominalDiffTime, diffLocalTime, midnight)
import Data.Bits (Bits(setBit))
import Data.Bits (Bits(..))
type ParseErrorOrDump
= Either (Megaparsec.ParseErrorBundle ByteString Void) Text.Builder.Builder
@ -106,15 +109,38 @@ dumpOffsetTable directory
<> justifyNumber 9 (getField @"length" table)
<> newlineBuilder
dumpFixed32 :: Fixed32 -> Text.Builder.Builder
dumpFixed32 (Fixed32 word)
= Text.Builder.decimal (shiftR word 16)
<> Text.Builder.singleton '.'
<> Text.Builder.decimal (word .&. 0xff00)
dumpHhea :: HheaTable -> Text.Builder.Builder
dumpHhea HheaTable{..}
= dumpCaption "'hhea' Table - Font Header"
<> " 'hhea' version: " <> dumpFixed32 version <> newlineBuilder
<> " yAscender: " <> Text.Builder.decimal ascent <> newlineBuilder
<> " yDescender: " <> Text.Builder.decimal descent <> newlineBuilder
<> " yLineGap: " <> Text.Builder.decimal lineGap <> newlineBuilder
<> " advanceWidthMax: " <> Text.Builder.decimal advanceWidthMax <> newlineBuilder
<> " minLeftSideBearing: " <> Text.Builder.decimal minLeftSideBearing <> newlineBuilder
<> " minRightSideBearing: " <> Text.Builder.decimal minRightSideBearing <> newlineBuilder
<> " xMaxExtent: " <> Text.Builder.decimal xMaxExtent <> newlineBuilder
<> " caretSlopeRise: " <> Text.Builder.decimal caretSlopeRise <> newlineBuilder
<> " caretSlopeRun: " <> Text.Builder.decimal caretSlopeRun <> newlineBuilder
<> " reserved0: 0" <> newlineBuilder
<> " reserved1: 0" <> newlineBuilder
<> " reserved2: 0" <> newlineBuilder
<> " reserved3: 0" <> newlineBuilder
<> " reserved4: 0" <> newlineBuilder
<> " metricDataFormat: " <> Text.Builder.decimal metricDataFormat <> newlineBuilder
<> " numberOfHMetrics: " <> Text.Builder.decimal numOfLongHorMetrics <> newlineBuilder
dumpHead :: HeadTable -> Text.Builder.Builder
dumpHead HeadTable{..}
= dumpCaption "'head' Table - Font Header"
{- version
<> lowestRecPPEM
<> indexToLocFormat
<> glyphDataFormat
<> fontRevision
<> fontDirectionHint -}
<> " head version: " <> dumpFixed32 version <> newlineBuilder
<> " fontRevision: " <> dumpFixed32 fontRevision <> newlineBuilder
<> " checkSumAdjustment: " <> paddedHexadecimal checkSumAdjustment <> newlineBuilder
<> " magicNumber: " <> paddedHexadecimal magicNumber <> newlineBuilder
<> " flags: 0x" <> halfPaddedHexadecimal flags <> newlineBuilder
@ -126,10 +152,22 @@ dumpHead HeadTable{..}
<> " xMax: " <> Text.Builder.decimal xMax <> newlineBuilder
<> " yMax: " <> Text.Builder.decimal yMax <> newlineBuilder
<> " macStyle bits: " <> "0x" <> dumpFontStyle macStyle <> newlineBuilder
<> " lowestRecPPEM " <> Text.Builder.decimal lowestRecPPEM <> newlineBuilder
<> " fontDirectionHint " <> dumpFontDirectionHint fontDirectionHint <> newlineBuilder
<> " indexToLocFormat " <> Text.Builder.decimal indexToLocFormat <> newlineBuilder
<> " glyphDataFormat " <> Text.Builder.decimal glyphDataFormat <> newlineBuilder
dumpFontDirectionHint :: FontDirectionHint -> Text.Builder.Builder
dumpFontDirectionHint = \case
MixedDirectionalGlyphs -> "0"
StronglyLeftToRightGlyphs -> "1"
LeftToRightGlyphsWithNeutrals -> "2"
StronglyRightToLeftGlyphs -> "-1"
RightToLeftGlyphsWithNeutrals -> "-2"
dumpFontStyle :: FontStyle -> Text.Builder.Builder
dumpFontStyle FontStyle{..} = halfPaddedHexadecimal
$ foldr (go . fst) (0 :: Int)
$ foldr (go . fst) (zeroBits :: Int)
$ filter snd
$ zip [0..] [bold, italic, underline, outline, shadow, condensed, extended]
where
@ -257,6 +295,7 @@ dumpTables processedState directory@FontDirectory{..}
case getField @"tag" tableEntry of
"cmap" -> Just $ dumpCmap <$> parseTable tableEntry cmapTableP processedState
"head" -> Just $ dumpHead <$> parseTable tableEntry headTableP processedState
"hhea" -> Just $ dumpHhea <$> parseTable tableEntry hheaTableP processedState
_ -> Nothing
dumpTrueType :: ByteString -> FilePath -> ParseErrorOrDump

13
src/Graphics/Fountainhead/Parser.hs
View File

@ -38,7 +38,7 @@ module Graphics.Fountainhead.Parser
) where
import Control.Applicative (Alternative(..))
import Control.Monad (foldM)
import Control.Monad (foldM, void)
import Data.Bits (Bits(..))
import Data.ByteString (ByteString)
import qualified Data.ByteString as ByteString
@ -260,9 +260,9 @@ hheaTableP = HheaTable
<*> Megaparsec.Binary.int16be
<*> Megaparsec.Binary.int16be
<*> Megaparsec.Binary.word16be
<*> Megaparsec.Binary.word16be
<*> Megaparsec.Binary.word16be
<*> Megaparsec.Binary.word16be
<*> Megaparsec.Binary.int16be
<*> Megaparsec.Binary.int16be
<*> Megaparsec.Binary.int16be
<*> Megaparsec.Binary.int16be
<*> Megaparsec.Binary.int16be
<*> Megaparsec.Binary.int16be
@ -423,12 +423,13 @@ deviceRecordP size = do
hdmxTableP :: Parser HdmxTable
hdmxTableP = do
Megaparsec.chunk $ ByteString.pack [0, 0]
void $ Megaparsec.chunk $ ByteString.pack [0, 0]
numberOfDeviceRecords <- fromIntegral <$> Megaparsec.Binary.int16be
sizeOfDeviceRecord <- fromIntegral <$> Megaparsec.Binary.int32be
records' <- Megaparsec.count numberOfDeviceRecords
$ deviceRecordP sizeOfDeviceRecord
Megaparsec.eof >> pure (HdmxTable 0 records')
Megaparsec.eof
pure $ HdmxTable 0 records'
-- * Glyph outline table

18
src/Graphics/Fountainhead/TrueType.hs
View File

@ -86,7 +86,7 @@ import Data.List.NonEmpty (NonEmpty(..))
import Data.Time (LocalTime(..))
import Data.Vector (Vector)
import Data.Word (Word8, Word16, Word32)
import Graphics.Fountainhead.Type (F2Dot14(..), Fixed32(..))
import Graphics.Fountainhead.Type (F2Dot14(..), Fixed32(..), FWord, UFWord)
-- * Font directory
@ -164,16 +164,16 @@ data MaxpTable = OpenMaxp OpenMaxpTable | TrueMaxp TrueMaxpTable
data HheaTable = HheaTable
{ version :: Fixed32 -- ^ 0x00010000 (1.0).
, ascent :: Int16 -- ^ Distance from baseline of highest ascender.
, descent :: Int16 -- ^ Distance from baseline of lowest descender.
, lineGap :: Int16 -- ^ Typographic line gap.
, advanceWidthMax :: Word16 -- ^ Must be consistent with horizontal metrics.
, minLeftSideBearing :: Word16 -- ^ Must be consistent with horizontal metrics.
, minRightSideBearing :: Word16 -- ^ Must be consistent with horizontal metrics.
, xMaxExtent :: Word16 -- ^ max(lsb + (xMax-xMin)).
, ascent :: FWord -- ^ Distance from baseline of highest ascender.
, descent :: FWord -- ^ Distance from baseline of lowest descender.
, lineGap :: FWord -- ^ Typographic line gap.
, advanceWidthMax :: UFWord -- ^ Must be consistent with horizontal metrics.
, minLeftSideBearing :: FWord -- ^ Must be consistent with horizontal metrics.
, minRightSideBearing :: FWord -- ^ Must be consistent with horizontal metrics.
, xMaxExtent :: FWord -- ^ max(lsb + (xMax-xMin)).
, caretSlopeRise :: Int16 -- ^ used to calculate the slope of the caret (rise/run) set to 1 for vertical caret.
, caretSlopeRun :: Int16 -- ^ 0 for vertical.
, caretOffset :: Int16 -- ^ Set value to 0 for non-slanted fonts.
, caretOffset :: FWord -- ^ Set value to 0 for non-slanted fonts.
, metricDataFormat :: Int16 -- ^ 0 for current format.
, numOfLongHorMetrics :: Word16 -- ^ Number of advance widths in metrics table.
} deriving (Eq, Show)

7
src/Graphics/Fountainhead/Type.hs
View File

@ -6,11 +6,13 @@
module Graphics.Fountainhead.Type
( F2Dot14(..)
, Fixed32(..)
, FWord
, UFWord
, ttfEpoch
) where
import Data.Int (Int16)
import Data.Word (Word32)
import Data.Word (Word16, Word32)
import Data.Time (Day(..))
import Data.Time.Calendar.OrdinalDate (fromOrdinalDate)
@ -20,5 +22,8 @@ newtype Fixed32 = Fixed32 Word32
newtype F2Dot14 = F2Dot14 Int16
deriving (Eq, Show)
type FWord = Int16
type UFWord = Word16
ttfEpoch :: Day
ttfEpoch = fromOrdinalDate 1904 1