diff --git a/src/Graphics/Fountainhead/Dumper.hs b/src/Graphics/Fountainhead/Dumper.hs index f09469d..e5bf6e7 100644 --- a/src/Graphics/Fountainhead/Dumper.hs +++ b/src/Graphics/Fountainhead/Dumper.hs @@ -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 diff --git a/src/Graphics/Fountainhead/Parser.hs b/src/Graphics/Fountainhead/Parser.hs index 02d7a29..f39cbda 100644 --- a/src/Graphics/Fountainhead/Parser.hs +++ b/src/Graphics/Fountainhead/Parser.hs @@ -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 diff --git a/src/Graphics/Fountainhead/TrueType.hs b/src/Graphics/Fountainhead/TrueType.hs index 16c95b1..0a0bde9 100644 --- a/src/Graphics/Fountainhead/TrueType.hs +++ b/src/Graphics/Fountainhead/TrueType.hs @@ -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) diff --git a/src/Graphics/Fountainhead/Type.hs b/src/Graphics/Fountainhead/Type.hs index 118df6b..06274dc 100644 --- a/src/Graphics/Fountainhead/Type.hs +++ b/src/Graphics/Fountainhead/Type.hs @@ -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