Dump the hhea table

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

View File

@ -32,7 +32,9 @@ import GHC.Records (HasField(..))
import Graphics.Fountainhead.TrueType import Graphics.Fountainhead.TrueType
( CmapTable(..) ( CmapTable(..)
, FontDirectory(..) , FontDirectory(..)
, FontDirectionHint(..)
, HeadTable(..) , HeadTable(..)
, HheaTable(..)
, OffsetSubtable(..) , OffsetSubtable(..)
, TableDirectory(..) , TableDirectory(..)
, CmapEncoding(..) , CmapEncoding(..)
@ -46,12 +48,13 @@ import Graphics.Fountainhead.Parser
, parseTable , parseTable
, cmapTableP , cmapTableP
, headTableP , headTableP
, hheaTableP
) )
import Graphics.Fountainhead.Type (ttfEpoch) import Graphics.Fountainhead.Type (Fixed32(..), ttfEpoch)
import Data.Foldable (Foldable(..)) import Data.Foldable (Foldable(..))
import Data.Maybe (fromMaybe) import Data.Maybe (fromMaybe)
import Data.Time (LocalTime(..), NominalDiffTime, diffLocalTime, midnight) import Data.Time (LocalTime(..), NominalDiffTime, diffLocalTime, midnight)
import Data.Bits (Bits(setBit)) import Data.Bits (Bits(..))
type ParseErrorOrDump type ParseErrorOrDump
= Either (Megaparsec.ParseErrorBundle ByteString Void) Text.Builder.Builder = Either (Megaparsec.ParseErrorBundle ByteString Void) Text.Builder.Builder
@ -106,15 +109,38 @@ dumpOffsetTable directory
<> justifyNumber 9 (getField @"length" table) <> justifyNumber 9 (getField @"length" table)
<> newlineBuilder <> 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 -> Text.Builder.Builder
dumpHead HeadTable{..} dumpHead HeadTable{..}
= dumpCaption "'head' Table - Font Header" = dumpCaption "'head' Table - Font Header"
{- version <> " head version: " <> dumpFixed32 version <> newlineBuilder
<> lowestRecPPEM <> " fontRevision: " <> dumpFixed32 fontRevision <> newlineBuilder
<> indexToLocFormat
<> glyphDataFormat
<> fontRevision
<> fontDirectionHint -}
<> " checkSumAdjustment: " <> paddedHexadecimal checkSumAdjustment <> newlineBuilder <> " checkSumAdjustment: " <> paddedHexadecimal checkSumAdjustment <> newlineBuilder
<> " magicNumber: " <> paddedHexadecimal magicNumber <> newlineBuilder <> " magicNumber: " <> paddedHexadecimal magicNumber <> newlineBuilder
<> " flags: 0x" <> halfPaddedHexadecimal flags <> newlineBuilder <> " flags: 0x" <> halfPaddedHexadecimal flags <> newlineBuilder
@ -126,10 +152,22 @@ dumpHead HeadTable{..}
<> " xMax: " <> Text.Builder.decimal xMax <> newlineBuilder <> " xMax: " <> Text.Builder.decimal xMax <> newlineBuilder
<> " yMax: " <> Text.Builder.decimal yMax <> newlineBuilder <> " yMax: " <> Text.Builder.decimal yMax <> newlineBuilder
<> " macStyle bits: " <> "0x" <> dumpFontStyle macStyle <> 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 -> Text.Builder.Builder
dumpFontStyle FontStyle{..} = halfPaddedHexadecimal dumpFontStyle FontStyle{..} = halfPaddedHexadecimal
$ foldr (go . fst) (0 :: Int) $ foldr (go . fst) (zeroBits :: Int)
$ filter snd $ filter snd
$ zip [0..] [bold, italic, underline, outline, shadow, condensed, extended] $ zip [0..] [bold, italic, underline, outline, shadow, condensed, extended]
where where
@ -257,6 +295,7 @@ dumpTables processedState directory@FontDirectory{..}
case getField @"tag" tableEntry of case getField @"tag" tableEntry of
"cmap" -> Just $ dumpCmap <$> parseTable tableEntry cmapTableP processedState "cmap" -> Just $ dumpCmap <$> parseTable tableEntry cmapTableP processedState
"head" -> Just $ dumpHead <$> parseTable tableEntry headTableP processedState "head" -> Just $ dumpHead <$> parseTable tableEntry headTableP processedState
"hhea" -> Just $ dumpHhea <$> parseTable tableEntry hheaTableP processedState
_ -> Nothing _ -> Nothing
dumpTrueType :: ByteString -> FilePath -> ParseErrorOrDump dumpTrueType :: ByteString -> FilePath -> ParseErrorOrDump

View File

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

View File

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

View File

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