fountainhead/lib/Graphics/Fountainhead/Dumper.hs

861 lines
45 KiB
Haskell
Raw Normal View History

2023-11-11 10:57:43 +01:00
{- This Source Code Form is subject to the terms of the Mozilla Public License,
v. 2.0. If a copy of the MPL was not distributed with this file, You can
obtain one at https://mozilla.org/MPL/2.0/. -}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE OverloadedStrings #-}
2023-11-28 20:02:57 +01:00
{-# LANGUAGE PatternGuards #-}
2023-11-11 10:57:43 +01:00
{-# LANGUAGE RecordWildCards #-}
2023-11-13 19:18:33 +01:00
{-# LANGUAGE LambdaCase #-}
2023-11-29 01:34:31 +01:00
{-# LANGUAGE NamedFieldPuns #-}
2023-11-28 20:02:57 +01:00
{-# LANGUAGE TypeApplications #-}
2023-11-11 10:57:43 +01:00
-- | Outputs information about a font as text.
module Graphics.Fountainhead.Dumper
2023-11-18 04:40:17 +01:00
( DumpError(..)
2023-11-11 10:57:43 +01:00
, dumpCmap
, dumpGASP
2024-02-02 01:44:49 +01:00
, dumpGlyf
2023-11-16 09:09:59 +01:00
, dumpHead
2023-11-18 04:40:17 +01:00
, dumpHmtx
2023-11-19 09:42:29 +01:00
, dumpHhea
, dumpLoca
2023-11-28 20:02:57 +01:00
, dumpName
2023-11-20 09:33:04 +01:00
, dumpMaxp
2023-12-01 08:21:39 +01:00
, dumpOs2
2023-11-29 01:34:31 +01:00
, dumpPost
, dumpTable
2023-12-27 16:19:21 +01:00
, dumpTables
2023-11-11 10:57:43 +01:00
, dumpOffsetTable
) where
2023-11-28 20:02:57 +01:00
import qualified Data.ByteString as ByteString
2023-12-04 09:39:08 +01:00
import Data.Int (Int64, Int16)
2023-11-28 20:02:57 +01:00
import Data.Word (Word8, Word16, Word32)
2023-11-12 10:13:38 +01:00
import qualified Data.IntMap as IntMap
2023-11-28 20:02:57 +01:00
import qualified Data.Text as Text
2023-11-11 10:57:43 +01:00
import qualified Data.Text.Encoding as Text
import qualified Data.Text.Lazy as Text.Lazy
import qualified Data.Text.Lazy.Builder as Text.Builder
import qualified Data.Text.Lazy.Builder.Int as Text.Builder
2024-02-02 01:44:49 +01:00
import qualified Data.Text.Lazy.Builder.RealFloat as Text.Builder
2023-11-15 21:25:18 +01:00
import Data.Vector (Vector)
2023-11-13 19:18:33 +01:00
import qualified Data.Vector as Vector
2023-11-11 10:57:43 +01:00
import GHC.Records (HasField(..))
import Graphics.Fountainhead.TrueType
( CmapTable(..)
2024-02-02 01:44:49 +01:00
, CompoundGlyphDefinition(..)
, ComponentGlyphPartDescription(..)
2023-11-11 10:57:43 +01:00
, FontDirectory(..)
2023-11-17 09:54:26 +01:00
, FontDirectionHint(..)
2023-12-06 11:04:08 +01:00
, GASPRange(..)
, GASPTable(..)
2024-02-02 01:44:49 +01:00
, GlyphArgument(..)
2023-11-16 09:09:59 +01:00
, HeadTable(..)
2023-11-17 09:54:26 +01:00
, HheaTable(..)
2023-11-18 04:40:17 +01:00
, HmtxTable(..)
2023-11-11 10:57:43 +01:00
, OffsetSubtable(..)
2023-11-29 01:34:31 +01:00
, PostHeader(..)
, PostSubtable(..)
, PostFormat2Table(..)
, PostTable(..)
2023-11-13 19:18:33 +01:00
, TableDirectory(..)
, CmapEncoding(..)
, CmapSubtable(..)
, CmapFormat4Table(..)
2023-11-16 09:09:59 +01:00
, FontStyle(..)
2024-02-02 01:44:49 +01:00
, GlyphArgument(..)
2024-01-15 09:42:17 +01:00
, GlyphCoordinate(..)
, GlyphDefinition(..)
, GlyphDescription(..)
, GlyfTable(..)
2023-11-18 04:40:17 +01:00
, LongHorMetric(..)
2023-11-19 09:42:29 +01:00
, LocaTable(..)
2023-11-28 20:02:57 +01:00
, NameRecord (..)
, NameTable(..)
2023-11-19 09:42:29 +01:00
, IndexToLocFormat(..)
2023-11-20 09:33:04 +01:00
, OpenMaxpTable(..)
, MaxpTable(..)
, TrueMaxpTable(..)
2023-11-28 20:02:57 +01:00
, nameStringOffset
2023-12-01 08:21:39 +01:00
, Os2BaseFields(..)
2023-12-03 08:17:05 +01:00
, Os2MicrosoftFields(..)
, Os2Version1Fields(..)
, Os2Version4Fields(..)
2023-12-04 09:39:08 +01:00
, Os2Version5Fields(..)
2023-12-01 08:21:39 +01:00
, Os2Table(..)
, Panose(..)
2024-01-15 09:42:17 +01:00
, SimpleGlyphDefinition(..)
2023-12-04 09:39:08 +01:00
, CVTable(..)
2024-02-02 01:44:49 +01:00
, OutlineFlag(..)
, ComponentGlyphFlags(..)
, GlyphTransformationOption(..)
, findTableByTag
2023-11-11 10:57:43 +01:00
)
import qualified Text.Megaparsec as Megaparsec
import Graphics.Fountainhead.Parser
( ParseErrorBundle
, ParseState
2023-11-12 10:13:38 +01:00
, parseTable
2023-11-11 10:57:43 +01:00
, cmapTableP
2023-11-16 09:09:59 +01:00
, headTableP
2023-11-17 09:54:26 +01:00
, hheaTableP
2023-11-18 04:40:17 +01:00
, hmtxTableP
2023-12-06 11:04:08 +01:00
, gaspTableP
2023-11-19 09:42:29 +01:00
, locaTableP
2023-11-29 01:34:31 +01:00
, maxpTableP
, nameTableP
2023-12-01 08:21:39 +01:00
, os2TableP
2023-12-27 16:19:21 +01:00
, postTableP
, cvTableP
2024-01-15 09:42:17 +01:00
, glyfTableP
2023-11-11 10:57:43 +01:00
)
2024-02-02 01:44:49 +01:00
import Graphics.Fountainhead.Type
( Fixed32(..)
, succIntegral
, ttfEpoch
, fixed2Double
)
import Data.Foldable (Foldable(..))
2024-02-02 01:44:49 +01:00
import Data.Maybe (fromMaybe, catMaybes)
2023-11-16 09:09:59 +01:00
import Data.Time (LocalTime(..), NominalDiffTime, diffLocalTime, midnight)
2023-12-01 08:21:39 +01:00
import Data.Bits (Bits(..), (.>>.))
2023-11-18 04:40:17 +01:00
import Data.Bifunctor (Bifunctor(first))
2023-11-28 20:02:57 +01:00
import Data.List (intersperse)
import Prelude hiding (repeat)
2023-11-11 10:57:43 +01:00
2023-11-18 04:40:17 +01:00
data DumpError
= DumpParseError ParseErrorBundle
2023-11-18 04:40:17 +01:00
| DumpRequiredTableMissingError String
| DumpRequestedTableMissingError String
2024-02-03 11:58:47 +01:00
deriving Eq
instance Show DumpError
where
show (DumpParseError errorBundle) = Megaparsec.errorBundlePretty errorBundle
show (DumpRequiredTableMissingError tableName) =
"Required table " <> tableName <> " is missing."
show (DumpRequestedTableMissingError tableName) =
"Requested table " <> tableName <> " is missing."
2023-11-11 10:57:43 +01:00
2023-11-19 09:42:29 +01:00
data RequiredTables = RequiredTables
{ hheaTable :: HheaTable
, headTable :: HeadTable
2024-01-15 09:42:17 +01:00
, locaTable :: LocaTable
2023-11-19 09:42:29 +01:00
} deriving (Eq, Show)
newlineBuilder :: Text.Builder.Builder
newlineBuilder = Text.Builder.singleton '\n'
2023-11-11 10:57:43 +01:00
paddedHexadecimal :: Integral a => a -> Text.Builder.Builder
paddedHexadecimal = ("0x" <>)
. Text.Builder.fromLazyText
. Text.Lazy.justifyRight 8 '0'
. Text.Builder.toLazyText
. Text.Builder.hexadecimal
2023-11-14 11:49:11 +01:00
halfPaddedHexadecimal :: Integral a => a -> Text.Builder.Builder
halfPaddedHexadecimal = Text.Builder.fromLazyText
. Text.Lazy.justifyRight 4 '0'
. Text.Builder.toLazyText
. Text.Builder.hexadecimal
2023-11-11 10:57:43 +01:00
justifyNumber :: Integral a => Int64 -> a -> Text.Builder.Builder
justifyNumber count = Text.Builder.fromLazyText
. Text.Lazy.justifyRight count ' '
. Text.Builder.toLazyText
. Text.Builder.decimal
2023-11-16 09:09:59 +01:00
dumpCaption :: String -> Text.Builder.Builder
dumpCaption headline = Text.Builder.fromString headline
2023-11-11 10:57:43 +01:00
<> newlineBuilder
<> Text.Builder.fromLazyText (Text.Lazy.replicate headlineLength "-")
<> newlineBuilder
where
headlineLength = fromIntegral $ Prelude.length headline
dumpOffsetTable :: FontDirectory -> Text.Builder.Builder
dumpOffsetTable directory
2023-11-16 09:09:59 +01:00
= dumpCaption "Offset Table"
2023-11-11 10:57:43 +01:00
<> " sfnt version: 1.0\n number of tables: "
<> Text.Builder.decimal (numTables $ offsetSubtable directory)
<> newlineBuilder
<> dumpOffsetSummary (tableDirectory directory)
where
2023-11-13 19:18:33 +01:00
dumpOffsetSummary = mconcat . fmap dumpOffsetRow . zip [0 :: Int ..]
2023-11-11 10:57:43 +01:00
dumpOffsetRow (index, table) = justifyNumber 4 index
<> ". '"
<> Text.Builder.fromText (Text.decodeASCII $ tag table)
<> "' - checksum = "
<> paddedHexadecimal (getField @"checkSum" table)
<> ", offset = "
<> paddedHexadecimal (getField @"offset" table)
<> ", len = "
<> justifyNumber 9 (getField @"length" table)
<> newlineBuilder
2023-11-17 09:54:26 +01:00
dumpFixed32 :: Fixed32 -> Text.Builder.Builder
dumpFixed32 (Fixed32 word)
= Text.Builder.decimal (shiftR word 16)
<> Text.Builder.singleton '.'
2024-02-11 18:50:25 +01:00
<> Text.Builder.decimal (word .&. 0xffff)
2023-11-17 09:54:26 +01:00
2023-11-18 04:40:17 +01:00
dumpHmtx :: HmtxTable -> Text.Builder.Builder
dumpHmtx HmtxTable{..} =
let caption = dumpCaption "'hmtx' Table - Horizontal Metrics"
lastAccumulator = foldl' dumpHMetric (0 :: Int, caption) hMetrics
in snd $ foldl' dumpLeftSideBear lastAccumulator leftSideBearing
where
dumpLeftSideBear (index, accumulator) leftSideBearing' =
let withNewLine = dumpIndex index <> ". LSbear: "
<> justifyNumber 4 leftSideBearing' <> newlineBuilder
in (succ index, accumulator <> withNewLine)
dumpHMetric (index, accumulator) metric =
let LongHorMetric{ leftSideBearing = leftSideBearing', ..} = metric
withNewLine = dumpIndex index <> ". advWid: "
<> justifyNumber 4 advanceWidth <> ", LSBear: "
<> justifyNumber 4 leftSideBearing' <> newlineBuilder
in (succ index, accumulator <> withNewLine)
dumpIndex = justifyNumber 12
2023-11-17 09:54:26 +01:00
dumpHhea :: HheaTable -> Text.Builder.Builder
dumpHhea HheaTable{..}
2023-11-18 04:40:17 +01:00
= dumpCaption "'hhea' Table - Horizontal Header"
2023-11-17 09:54:26 +01:00
<> " '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
2023-11-16 09:09:59 +01:00
dumpHead :: HeadTable -> Text.Builder.Builder
dumpHead HeadTable{..}
= dumpCaption "'head' Table - Font Header"
2023-11-17 09:54:26 +01:00
<> " head version: " <> dumpFixed32 version <> newlineBuilder
<> " fontRevision: " <> dumpFixed32 fontRevision <> newlineBuilder
2023-11-16 09:09:59 +01:00
<> " checkSumAdjustment: " <> paddedHexadecimal checkSumAdjustment <> newlineBuilder
<> " magicNumber: " <> paddedHexadecimal magicNumber <> newlineBuilder
<> " flags: 0x" <> halfPaddedHexadecimal flags <> newlineBuilder
<> " unitsPerEm: " <> Text.Builder.decimal unitsPerEm <> newlineBuilder
<> " created: " <> "0x" <> longDateTime created <> newlineBuilder
<> " modified: " <> "0x" <> longDateTime modified <> newlineBuilder
<> " xMin: " <> Text.Builder.decimal xMin <> newlineBuilder
<> " yMin: " <> Text.Builder.decimal yMin <> newlineBuilder
<> " xMax: " <> Text.Builder.decimal xMax <> newlineBuilder
<> " yMax: " <> Text.Builder.decimal yMax <> newlineBuilder
<> " macStyle bits: " <> "0x" <> dumpFontStyle macStyle <> newlineBuilder
2023-11-17 09:54:26 +01:00
<> " lowestRecPPEM " <> Text.Builder.decimal lowestRecPPEM <> newlineBuilder
<> " fontDirectionHint " <> dumpFontDirectionHint fontDirectionHint <> newlineBuilder
2023-11-19 09:42:29 +01:00
<> " indexToLocFormat " <> dumpIndexToLocFormat indexToLocFormat <> newlineBuilder
2023-11-17 09:54:26 +01:00
<> " glyphDataFormat " <> Text.Builder.decimal glyphDataFormat <> newlineBuilder
2023-11-19 09:42:29 +01:00
dumpIndexToLocFormat :: IndexToLocFormat -> Text.Builder.Builder
dumpIndexToLocFormat ShortOffsetIndexToLocFormat = "0"
dumpIndexToLocFormat LongOffsetIndexToLocFormat = "1"
2023-11-17 09:54:26 +01:00
dumpFontDirectionHint :: FontDirectionHint -> Text.Builder.Builder
dumpFontDirectionHint = \case
MixedDirectionalGlyphs -> "0"
StronglyLeftToRightGlyphs -> "1"
LeftToRightGlyphsWithNeutrals -> "2"
StronglyRightToLeftGlyphs -> "-1"
RightToLeftGlyphsWithNeutrals -> "-2"
2023-11-16 09:09:59 +01:00
dumpFontStyle :: FontStyle -> Text.Builder.Builder
dumpFontStyle FontStyle{..} = halfPaddedHexadecimal
2023-11-17 09:54:26 +01:00
$ foldr (go . fst) (zeroBits :: Int)
2023-11-16 09:09:59 +01:00
$ filter snd
$ zip [0..] [bold, italic, underline, outline, shadow, condensed, extended]
where
go bitNumber accumulator = setBit accumulator bitNumber
longDateTime :: LocalTime -> Text.Builder.Builder
longDateTime localTime = Text.Builder.fromLazyText
$ Text.Lazy.justifyRight 16 '0'
$ Text.Builder.toLazyText
$ Text.Builder.hexadecimal
$ (truncate :: NominalDiffTime -> Int)
$ diffLocalTime localTime (LocalTime ttfEpoch midnight)
2023-12-04 09:39:08 +01:00
dumpCVTable :: CVTable -> Text.Builder.Builder
dumpCVTable (CVTable cvTable) = dumpCaption "'cvt ' Table - Control Value Table"
<> "Size = " <> Text.Builder.decimal (tableSize * 2)
2024-02-04 11:07:15 +01:00
<> " bytes, " <> Text.Builder.decimal tableSize <> " entries" <> newlineBuilder
2023-12-04 09:39:08 +01:00
<> foldMap (uncurry go) (zip [0..] cvTable)
where
tableSize = Prelude.length cvTable
go :: Int -> Int16 -> Text.Builder.Builder
go index' entry = justifyNumber 13 index' <> ". "
<> Text.Builder.decimal entry <> newlineBuilder
2023-12-01 08:21:39 +01:00
dumpOs2 :: Os2Table -> Text.Builder.Builder
dumpOs2 = (dumpCaption "'OS/2' Table - OS/2 and Windows Metrics" <>) . go
where
go = \case
2023-12-03 08:17:05 +01:00
Os2Version0 baseFields msFields -> dumpBaseFields baseFields
<> maybe "" dumpMicrosoftFields msFields
Os2Version1 baseFields msFields extraFields -> dumpBaseFields baseFields
<> dumpMicrosoftFields msFields <> dumpVersion1Fields extraFields
Os2Version2 baseFields msFields extraFields -> dumpBaseFields baseFields
<> dumpMicrosoftFields msFields <> dumpVersion4Fields extraFields
Os2Version3 baseFields msFields extraFields -> dumpBaseFields baseFields
<> dumpMicrosoftFields msFields <> dumpVersion4Fields extraFields
Os2Version4 baseFields msFields extraFields -> dumpBaseFields baseFields
<> dumpMicrosoftFields msFields <> dumpVersion4Fields extraFields
2023-12-04 09:39:08 +01:00
Os2Version5 baseFields msFields extraFields -> dumpBaseFields baseFields
<> dumpMicrosoftFields msFields <> dumpVersion5Fields extraFields
2023-12-03 08:17:05 +01:00
dumpVersion1Fields Os2Version1Fields{..}
= " CodePage Range 1( Bits 0 - 31 ): " <> paddedHexadecimal ulCodePageRange1 <> newlineBuilder
<> " CodePage Range 2( Bits 32- 63 ): " <> paddedHexadecimal ulCodePageRange2 <> newlineBuilder
dumpVersion4Fields Os2Version4Fields{..}
= dumpVersion1Fields (Os2Version1Fields ulCodePageRange1 ulCodePageRange2)
2023-12-04 09:39:08 +01:00
<> " sxHeight: " <> Text.Builder.decimal sxHeight <> newlineBuilder
<> " sCapHeight: " <> Text.Builder.decimal sCapHeight <> newlineBuilder
<> " usDefaultChar: 0x" <> halfPaddedHexadecimal usDefaultChar <> newlineBuilder
<> " usBreakChar: 0x" <> halfPaddedHexadecimal usBreakChar <> newlineBuilder
<> " usMaxContext: " <> Text.Builder.decimal usMaxContext <> newlineBuilder
dumpVersion5Fields Os2Version5Fields{..}
= dumpVersion1Fields (Os2Version1Fields ulCodePageRange1 ulCodePageRange2)
<> " sxHeight: " <> Text.Builder.decimal sxHeight <> newlineBuilder
<> " sCapHeight: " <> Text.Builder.decimal sCapHeight <> newlineBuilder
<> " usDefaultChar: 0x" <> halfPaddedHexadecimal usDefaultChar <> newlineBuilder
<> " usBreakChar: 0x" <> halfPaddedHexadecimal usBreakChar <> newlineBuilder
<> " usMaxContext: " <> Text.Builder.decimal usMaxContext <> newlineBuilder
<> " usLowerOpticalPointSize: "
<> Text.Builder.decimal usLowerOpticalPointSize <> newlineBuilder
<> " usUpperOpticalPointSize: "
<> Text.Builder.decimal usUpperOpticalPointSize <> newlineBuilder
2023-12-03 08:17:05 +01:00
dumpMicrosoftFields Os2MicrosoftFields{..}
= " sTypoAscender: " <> Text.Builder.decimal sTypoAscender <> newlineBuilder
<> " sTypoDescender: " <> Text.Builder.decimal sTypoDescender <> newlineBuilder
<> " sTypoLineGap: " <> Text.Builder.decimal sTypoLineGap <> newlineBuilder
<> " usWinAscent: " <> Text.Builder.decimal usWinAscent <> newlineBuilder
<> " usWinDescent: " <> Text.Builder.decimal usWinDescent <> newlineBuilder
2023-12-01 08:21:39 +01:00
dumpBaseFields Os2BaseFields{..}
= " 'OS/2' version: " <> Text.Builder.decimal version <> newlineBuilder
<> " xAvgCharWidth: " <> Text.Builder.decimal xAvgCharWidth <> newlineBuilder
<> " usWeightClass: " <> weightClass usWeightClass <> newlineBuilder
<> " usWidthClass: " <> widthClass usWidthClass <> newlineBuilder
<> " fsType: " <> Text.Builder.decimal fsType <> newlineBuilder
<> " ySubscriptXSize: " <> Text.Builder.decimal ySubscriptXSize <> newlineBuilder
<> " ySubscriptYSize: " <> Text.Builder.decimal ySubscriptYSize <> newlineBuilder
<> " ySubscriptXOffset: " <> Text.Builder.decimal ySubscriptXOffset <> newlineBuilder
<> " ySubscriptYOffset: " <> Text.Builder.decimal ySubscriptYOffset <> newlineBuilder
<> " ySuperscriptXSize: " <> Text.Builder.decimal ySuperscriptXSize <> newlineBuilder
<> " ySuperscriptYSize: " <> Text.Builder.decimal ySuperscriptYSize <> newlineBuilder
<> " ySuperscriptXOffset: " <> Text.Builder.decimal ySuperscriptXOffset <> newlineBuilder
<> " ySuperscriptYOffset: " <> Text.Builder.decimal ySuperscriptYOffset <> newlineBuilder
<> " yStrikeoutSize: " <> Text.Builder.decimal yStrikeoutSize <> newlineBuilder
<> " yStrikeoutPosition: " <> Text.Builder.decimal yStrikeoutPosition <> newlineBuilder
2023-12-02 15:14:58 +01:00
<> " sFamilyClass:" <> familyClass sFamilyClass <> newlineBuilder
<> " PANOSE:" <> newlineBuilder <> dumpPanose panose
2023-12-02 15:14:58 +01:00
<> fold (Vector.imap dumpUnicodeRange ulUnicodeRange)
<> " achVendID: '" <> achVendID' achVendID <> "'\n"
2023-12-03 08:17:05 +01:00
<> " fsSelection: 0x" <> fsSelection' fsSelection <> newlineBuilder
<> " usFirstCharIndex: 0x" <> halfPaddedHexadecimal fsFirstCharIndex <> newlineBuilder
<> " usLastCharIndex: 0x" <> halfPaddedHexadecimal fsLastCharIndex <> newlineBuilder
fsSelection' value =
let description = fold
[ if testBit value 0 then "Italic " else ""
, if testBit value 5 then "Bold " else ""
]
in halfPaddedHexadecimal value <> " '" <> description <> "'"
2023-12-02 15:14:58 +01:00
achVendID' = Text.Builder.fromText . Text.decodeLatin1 . ByteString.pack . fmap fromIntegral . toList
dumpUnicodeRange index value =
let bits = index * 32
parens = "( Bits " <> Text.Builder.decimal bits <> " - "
<> Text.Builder.decimal (bits + 31) <> " ):"
in " Unicode Range: " <> Text.Builder.decimal (index + 1)
<> Text.Builder.fromLazyText (Text.Lazy.justifyLeft 25 ' ' (Text.Builder.toLazyText parens))
<> paddedHexadecimal value
<> newlineBuilder
dumpPanose Panose{..}
2023-12-02 15:14:58 +01:00
= " Family Kind: " <> dumpPanoseField bFamilyType
<> " Serif Style: " <> dumpPanoseField bSerifStyle
<> " Weight: " <> dumpPanoseField bWeight
<> " Proportion: " <> dumpPanoseField bProportion
<> " Contrast: " <> dumpPanoseField bContrast
<> " Stroke: " <> dumpPanoseField bStrokeVariation
<> " Arm Style: " <> dumpPanoseField bArmStyle
<> " Lettreform: " <> dumpPanoseField bLetterform
<> " Midline: " <> dumpPanoseField bMidline
<> " X-height: " <> dumpPanoseField bXHeight
dumpPanoseField field' =
let numericField = Text.Builder.fromLazyText
$ Text.Lazy.justifyLeft 8 ' '
$ Text.Builder.toLazyText
$ Text.Builder.decimal
$ fromEnum field'
in numericField
<> Text.Builder.singleton '\''
<> Text.Builder.fromString (show field')
<> Text.Builder.singleton '\''
<> newlineBuilder
2023-12-01 08:21:39 +01:00
familyClass value =
" " <> Text.Builder.decimal (value .>>. 8) <> " subclass = " <> Text.Builder.decimal (value .&. 0x00ff)
weightClass classValue
| Just wordValue <- fWeight classValue = Text.Builder.decimal classValue <> " '" <> wordValue <> "'"
| otherwise = Text.Builder.decimal classValue
widthClass classValue
| Just wordValue <- fWidth classValue = Text.Builder.decimal classValue <> " '" <> wordValue <> "'"
| otherwise = Text.Builder.decimal classValue
fWeight 100 = Just "Thin"
fWeight 200 = Just "Extra-light"
fWeight 300 = Just "Light"
fWeight 400 = Just "Normal"
fWeight 500 = Just "Medium"
fWeight 600 = Just "Semi-bold"
fWeight 700 = Just "Bold"
fWeight 800 = Just "Extra-bold"
fWeight 900 = Just "Black"
fWeight _ = Nothing
fWidth 1 = Just "Ultra-condensed"
fWidth 2 = Just "Extra-condensed"
fWidth 3 = Just "Condensed"
fWidth 4 = Just "Semi-condensed"
fWidth 5 = Just "Medium"
fWidth 6 = Just "Semi-expanded"
fWidth 7 = Just "Expanded"
fWidth 8 = Just "Extra-expanded"
fWidth 9 = Just "Ultra-expanded"
fWidth _ = Nothing
2023-11-29 01:34:31 +01:00
dumpPost :: PostTable -> Text.Builder.Builder
dumpPost PostTable{ postHeader = PostHeader{..}, postSubtable }
= dumpCaption "'post' Table - PostScript" <> newlineBuilder
<> " 'post' format: " <> dumpFixed32 format <> newlineBuilder
2024-02-11 18:50:25 +01:00
<> " italicAngle: " <> dumpFixed32 italicAngle <> newlineBuilder
2023-11-29 01:34:31 +01:00
<> " underlinePosition: " <> Text.Builder.decimal underlinePosition <> newlineBuilder
<> " underlineThichness: " <> Text.Builder.decimal underlineThickness <> newlineBuilder
<> " isFixedPitch: " <> dNumber isFixedPitch <> newlineBuilder
<> " minMemType42: " <> dNumber minMemType42 <> newlineBuilder
<> " maxMemType42: " <> dNumber maxMemType42 <> newlineBuilder
<> " minMemType1: " <> dNumber minMemType1 <> newlineBuilder
<> " maxMemType1: " <> dNumber maxMemType1 <> newlineBuilder
<> dumpPostSubtable
where
dNumber = (<> Text.Builder.singleton 'd') . Text.Builder.decimal
dumpPostSubtable = case postSubtable of
None -> "" -- Format 1 and 3 do not require a subtable.
PostFormat2 PostFormat2Table{..}
-> " Format 2.0: Non-Standard (for PostScript) TrueType Glyph Set." <> newlineBuilder
<> " numGlyphs: " <> Text.Builder.decimal (Prelude.length glyphNameIndex)
<> newlineBuilder <> fold (Vector.imap (dumpFormat2Pair names) glyphNameIndex)
PostFormat25 _ -> "Format 2.5"
PostFormat4 _ -> "Format 4.0"
dumpFormat2Pair names index glyphNameIndex'
= " Glyf " <> justifyNumber 3 index
<> " -> " <> glyphType names glyphNameIndex'
<> newlineBuilder
glyphType names glyphNameIndex'
| glyphNameIndex' >= 0
, glyphNameIndex' <= 257 = "Mac Glyph # " <> justifyNumber 3 glyphNameIndex'
| glyphNameIndex' >= 258
, glyphNameIndex' <= 32767 =
let nameIndex = fromIntegral $ glyphNameIndex' - 258
in "PSGlyph Name # " <> justifyNumber 3 (succ nameIndex) <> ", '"
<> Text.Builder.fromText (Text.decodeASCII (names Vector.! nameIndex))
<> Text.Builder.singleton '\''
| otherwise = "Reserved"
2023-11-11 10:57:43 +01:00
dumpCmap :: CmapTable -> Text.Builder.Builder
2023-11-12 10:13:38 +01:00
dumpCmap CmapTable{..}
2023-11-16 09:09:59 +01:00
= dumpCaption "'cmap' Table - Character to Glyph Index Mapping Table"
2023-11-12 10:13:38 +01:00
<> " 'cmap' version: " <> Text.Builder.decimal version <> newlineBuilder
<> " number of encodings: " <> Text.Builder.decimal encodingsLength <> newlineBuilder
<> " number of subtables: " <> Text.Builder.decimal (Prelude.length subtables) <> newlineBuilder
<> newlineBuilder
<> snd (foldr dumpCmapEncoding (pred encodingsLength, "") encodings) <> newlineBuilder
2023-11-13 19:18:33 +01:00
<> snd (foldr dumpCmapSubTable (pred subTablesLength, "") subtables) <> newlineBuilder
2023-11-12 10:13:38 +01:00
where
encodingsLength = Prelude.length encodings
2023-11-13 19:18:33 +01:00
subTablesLength = IntMap.size subtables
2023-11-12 10:13:38 +01:00
dumpCmapEncoding CmapEncoding{..} (index, accumulator) =
let findSubTableIndex = Text.Builder.decimal
. Prelude.length
. filter ((< offset) . fromIntegral)
. IntMap.keys
summary = "Encoding " <> Text.Builder.decimal index
<> ". PlatformID: " <> Text.Builder.decimal platformID <> newlineBuilder
<> " EcodingID: " <> Text.Builder.decimal platformSpecificID <> newlineBuilder
<> " SubTable: " <> findSubTableIndex subtables
<> ", Offset: " <> paddedHexadecimal offset <> newlineBuilder
in (pred index, summary <> newlineBuilder <> accumulator)
2023-11-13 19:18:33 +01:00
dumpCmapSubTable currentSubTable (index, accumulator) =
let contents = "SubTable " <> Text.Builder.decimal index
<> ". " <> dumpCmapSubTableFormat currentSubTable
in (pred index, contents <> accumulator)
dumpCmapSubTableFormat = \case
(CmapFormat0 _) -> "Format 0"
(CmapFormat2 _) -> "Format 2"
(CmapFormat4 CmapFormat4Table{..}) ->
2023-11-14 11:49:11 +01:00
let segCount = Vector.length startCode
2023-11-15 21:25:18 +01:00
dumpSegment' = dumpSegment segCount glyphIndexArray
2023-11-14 11:49:11 +01:00
in "Format 4 - Segment mapping to delta values\n\
\ Length: 994\n\
\ Version: 0\n\
\ segCount: "
<> Text.Builder.decimal segCount
<> newlineBuilder <> " searchRange: "
<> Text.Builder.decimal searchRange
<> newlineBuilder <> " entrySelector: "
<> Text.Builder.decimal entrySelector
<> newlineBuilder <> " rangeShift: "
<> Text.Builder.decimal (segCount * 2 - fromIntegral searchRange)
<> newlineBuilder
2023-11-15 21:25:18 +01:00
<> fold (Vector.izipWith4 (dumpSegmentSummary segCount) startCode endCode idDelta idRangeOffset)
<> " Number of glyphIndex "
<> Text.Builder.decimal (Vector.length glyphIndexArray) <> newlineBuilder
<> fold (Vector.imap dumpGlyphAtIndex glyphIndexArray)
<> fold (Vector.izipWith4 dumpSegment' startCode endCode idDelta idRangeOffset)
2023-11-13 19:18:33 +01:00
(CmapFormat6 _) -> "Format 6"
(CmapFormat8 _) -> "Format 8"
(CmapFormat10 _) -> "Format 10"
(CmapFormat12 _) -> "Format 12"
(CmapFormat13 _) -> "Format 13"
(CmapFormat14 _) -> "Format 14"
2023-11-15 21:25:18 +01:00
dumpSegment :: Int -> Vector Word16 -> Int -> Word16 -> Word16 -> Word16 -> Word16 -> Text.Builder.Builder
dumpSegment segCount glyphIndexArray' segmentIndex startCode' endCode' idDelta' idRangeOffset' =
let charRange = [startCode'..endCode']
dumpSegmentCharIndex' =
dumpSegmentCharIndex segCount glyphIndexArray' segmentIndex idDelta' idRangeOffset' startCode'
in "Segment " <> Text.Builder.decimal segmentIndex <> ":\n"
<> foldMap dumpSegmentCharIndex' charRange
dumpSegmentCharIndex segCount glyphIndexArray' segmentIndex idDelta' idRangeOffset' startCode' charCode =
let calculateGlyphIndex' =
calculateGlyphIndex charCode segmentIndex segCount glyphIndexArray' idRangeOffset' idDelta' startCode'
in " Char 0x"
<> halfPaddedHexadecimal charCode <> " -> Index "
<> Text.Builder.decimal calculateGlyphIndex'
<> newlineBuilder
dumpSegmentSummary segCount index startCode' endCode' idDelta' idRangeOffset'
2023-11-14 11:49:11 +01:00
= " Seg " <> justifyNumber 5 index
<> " : St = " <> halfPaddedHexadecimal startCode'
<> ", En = " <> halfPaddedHexadecimal endCode'
<> ", D = " <> justifyNumber 6 idDelta'
<> ", RO = " <> justifyNumber 6 idRangeOffset'
<> ", gId# = " <> dumpGlyphId index segCount idRangeOffset'
<> newlineBuilder
2023-11-15 21:25:18 +01:00
dumpGlyphId segmentIndex segCount idRangeOffset'
= maybe "N/A" Text.Builder.decimal
$ calculateGlyphId segmentIndex segCount idRangeOffset'
calculateGlyphIndex :: Word16 -> Int -> Int -> Vector Word16 -> Word16 -> Word16 -> Word16 -> Int
calculateGlyphIndex c segmentIndex segCount glyphIndexArray' idRangeOffset' idDelta' startCode' =
let defaultIndex = fromIntegral $ c + idDelta'
addOffset = fromIntegral
. fromMaybe 0
. (glyphIndexArray' Vector.!?)
. (+ fromIntegral (c - startCode'))
in maybe defaultIndex addOffset
$ calculateGlyphId segmentIndex segCount idRangeOffset'
calculateGlyphId segmentIndex segCount idRangeOffset'
| idRangeOffset' == 0 = Nothing
| otherwise = Just $ segmentIndex - segCount + (fromIntegral idRangeOffset' `div` 2)
dumpGlyphAtIndex index element = " glyphIdArray[" <> Text.Builder.decimal index <> "] = "
<> Text.Builder.decimal element <> newlineBuilder
2023-11-11 10:57:43 +01:00
2023-11-19 09:42:29 +01:00
dumpLoca :: LocaTable -> Text.Builder.Builder
dumpLoca table =
dumpCaption "'loca' Table - Index to Location"
<> go table
where
go (LongLocaTable elements) = dumpElements elements
go (ShortLocaTable elements) = dumpElements
$ (* 2)
. (fromIntegral :: Word16 -> Word32)
<$> elements
dumpElements elements =
case Vector.unsnoc elements of
Just (init', last')
-> foldMap dumpLocaLine (Vector.indexed init')
2023-11-20 09:33:04 +01:00
<> " Ended at " <> paddedHexadecimal last' <> newlineBuilder
2023-11-19 09:42:29 +01:00
Nothing -> mempty
dumpLocaLine :: Integral a => (Int, a) -> Text.Builder.Builder
dumpLocaLine (index, element)
= " Idx " <> justifyNumber 6 index
<> " -> GlyphOffset " <> paddedHexadecimal element <> newlineBuilder
2023-11-28 20:02:57 +01:00
dumpName :: NameTable -> Text.Builder.Builder
dumpName table'@NameTable{..} = dumpCaption "'name' Table - Naming Table"
<> " Format: " <> Text.Builder.decimal format <> newlineBuilder
<> " Number of Record: " <> Text.Builder.decimal (Prelude.length nameRecord) <> newlineBuilder
<> " Storage offset: " <> Text.Builder.decimal (nameStringOffset table') <> newlineBuilder
<> foldMap go (zip3 [0 :: Int ..] nameRecord variable)
where
go (index, NameRecord{ length = length', ..}, variable')
= "Name table " <> justifyNumber 3 index <> "."
<> " PlatformID: " <> Text.Builder.decimal platformID <> newlineBuilder
<> " EncodingID: " <> Text.Builder.decimal platformSpecificID <> newlineBuilder
<> " LanguageID: " <> Text.Builder.decimal languageID <> newlineBuilder
<> " NameID: " <> Text.Builder.decimal nameID <> newlineBuilder
<> " Length: " <> Text.Builder.decimal length' <> newlineBuilder
<> " Offset: " <> Text.Builder.decimal offset <> newlineBuilder
<> foldMap (" " <>) (dumpHexString $ ByteString.unpack variable')
dumpHexString :: [Word8] -> [Text.Builder.Builder]
dumpHexString byteCodes
| null byteCodes = [dumpHexLine " > " byteCodes]
| Prelude.length byteCodes < 10 = [dumpHexLine " > " byteCodes]
| otherwise = dumpHexLine " > " byteCodes
: dumpHexString (drop 10 byteCodes)
where
dumpHexLine separator variable' =
let firstTen = take 10 variable'
digits = fold $ intersperse (Text.Builder.singleton ' ') $ hexByte <$> firstTen
printables = foldMap printableByte firstTen
in digits
<> Text.Builder.fromText (Text.replicate (10 - Prelude.length firstTen) " ")
<> separator
<> printables
<> newlineBuilder
printableByte :: Word8 -> Text.Builder.Builder
printableByte code
| code >= 0x20
, code < 0x7f = Text.Builder.singleton $ toEnum $ fromIntegral code
| otherwise = Text.Builder.singleton '.'
2023-11-29 01:34:31 +01:00
hexByte :: Integral a => a -> Text.Builder.Builder
hexByte = Text.Builder.fromLazyText
. Text.Lazy.justifyRight 2 '0'
. Text.Builder.toLazyText
. Text.Builder.hexadecimal
2023-11-20 09:33:04 +01:00
dumpMaxp :: MaxpTable -> Text.Builder.Builder
dumpMaxp (TrueMaxp TrueMaxpTable{..})
= dumpCaption "'maxp' Table - Maximum Profile"
<> " 'maxp' version: " <> dumpFixed32 version <> newlineBuilder
<> " numGlyphs: " <> Text.Builder.decimal numGlyphs <> newlineBuilder
<> " maxPoints: " <> Text.Builder.decimal maxPoints <> newlineBuilder
<> " maxContours: " <> Text.Builder.decimal maxContours <> newlineBuilder
<> " maxCompositePoints: " <> Text.Builder.decimal maxComponentPoints <> newlineBuilder
<> " maxCompositeContours: " <> Text.Builder.decimal maxComponentContours <> newlineBuilder
<> " maxZones: " <> Text.Builder.decimal maxZones <> newlineBuilder
<> " maxTwilightPoints: " <> Text.Builder.decimal maxTwilightPoints <> newlineBuilder
<> " maxStorage: " <> Text.Builder.decimal maxStorage <> newlineBuilder
<> " maxFunctionDefs: " <> Text.Builder.decimal maxFunctionDefs <> newlineBuilder
<> " maxInstructionDefs: " <> Text.Builder.decimal maxInstructionDefs <> newlineBuilder
<> " maxStackElements: " <> Text.Builder.decimal maxStackElements <> newlineBuilder
<> " maxSizeOfInstructions: " <> Text.Builder.decimal maxSizeOfInstructions <> newlineBuilder
<> " maxComponentElements: " <> Text.Builder.decimal maxComponentElements <> newlineBuilder
<> " maxCompoenetDepth: " <> Text.Builder.decimal maxComponentDepth <> newlineBuilder
dumpMaxp (OpenMaxp OpenMaxpTable{..})
= dumpCaption "'maxp' Table - Maximum Profile"
<> " 'maxp' version: " <> dumpFixed32 version <> newlineBuilder <> newlineBuilder
<> " numGlyphs: " <> Text.Builder.decimal numGlyphs <> newlineBuilder
2023-12-06 11:04:08 +01:00
dumpGASP :: GASPTable -> Text.Builder.Builder
dumpGASP GASPTable{..} = dumpCaption "'gasp' Table - Grid-fitting And Scan-conversion Procedure"
<> "'gasp' version: " <> Text.Builder.decimal version <> newlineBuilder
<> "numRanges: " <> Text.Builder.decimal (Prelude.length gaspRange) <> newlineBuilder
<> foldMap dumpGASPRange (zip [0..] gaspRange)
where
dumpGASPRange :: (Int, GASPRange) -> Text.Builder.Builder
dumpGASPRange (index', GASPRange{..}) = newlineBuilder
<> " gasp Range " <> Text.Builder.decimal index' <> newlineBuilder
<> " rangeMaxPPEM: " <> Text.Builder.decimal rangeMaxPPEM <> newlineBuilder
<> " rangeGaspBehavior: 0x" <> halfPaddedHexadecimal rangeGaspBehavior <> newlineBuilder
2024-01-15 09:42:17 +01:00
dumpGlyf :: GlyfTable -> Text.Builder.Builder
dumpGlyf (GlyfTable glyfDescriptions) = dumpCaption "'glyf' Table - Glyf data"
<> foldMap go (Vector.indexed glyfDescriptions)
where
go (glyphIndex, GlyphDescription{..})
= "Glyph " <> justifyNumber 6 glyphIndex <> Text.Builder.singleton '.' <> newlineBuilder
<> " numberOfContours: " <> Text.Builder.decimal numberOfContours <> newlineBuilder
<> " xMin: " <> Text.Builder.decimal xMin <> newlineBuilder
<> " yMin: " <> Text.Builder.decimal yMin <> newlineBuilder
<> " xMax: " <> Text.Builder.decimal xMax <> newlineBuilder
<> " yMax: " <> Text.Builder.decimal yMax <> newlineBuilder
<> newlineBuilder <> dumpGlyphDefinition definition <> newlineBuilder
dumpEndPoint (endPointIndex, endPoint)
= " " <> justifyNumber 2 endPointIndex
<> ": " <> Text.Builder.decimal endPoint <> newlineBuilder
dumpGlyphDefinition (SimpleGlyph SimpleGlyphDefinition{..})
= " EndPoints" <> newlineBuilder
<> " ---------" <> newlineBuilder
<> foldMap dumpEndPoint (Vector.indexed endPtsOfContours) <> newlineBuilder
<> " Length of Instructions: "
<> Text.Builder.decimal (Vector.length instructions) <> newlineBuilder
2024-01-29 20:13:43 +01:00
<> newlineBuilder <> " Flags" <> newlineBuilder
2024-01-15 09:42:17 +01:00
<> " -----" <> newlineBuilder
<> fst (Vector.foldl' foldFlag ("", 0) flags) <> newlineBuilder
2024-01-29 20:13:43 +01:00
<> " Coordinates" <> newlineBuilder
<> " -----------" <> newlineBuilder
<> fst (Vector.ifoldl' foldCoordinate mempty coordinates)
2024-02-02 01:44:49 +01:00
dumpGlyphDefinition (CompoundGlyph CompoundGlyphDefinition{..})
= foldMap (dumpCompoundGlyph $ Vector.length components) (Vector.indexed components)
<> newlineBuilder <> " Length of Instructions: "
<> Text.Builder.decimal (Vector.length instructions) <> newlineBuilder
dumpCompoundGlyph :: Int -> (Int, ComponentGlyphPartDescription) -> Text.Builder.Builder
dumpCompoundGlyph componentsLength (componentIndex, description) =
let moreComponents = succ componentIndex < componentsLength
compoundFlags = dumpCompoundFlags moreComponents description
ComponentGlyphPartDescription{..} = description
in " " <> Text.Builder.decimal componentIndex
<> ": Flags: 0x" <> compoundFlags <> newlineBuilder
<> " Glyf Index: " <> Text.Builder.decimal glyphIndex <> newlineBuilder
<> " X" <> dumpArgument argument1 <> newlineBuilder
<> " Y" <> dumpArgument argument2 <> newlineBuilder
<> dumpTransformationOption transformationOption
<> " Others: " <> dumpOtherFlags flags <> newlineBuilder
<> newlineBuilder -- TODO
dumpTransformationOption GlyphNoScale = ""
dumpTransformationOption (GlyphScale scale) =
" X,Y Scale: " <> Text.Builder.realFloat (fixed2Double scale) <> newlineBuilder
dumpTransformationOption (GlyphXyScale xScale yScale)
= " X Scale: " <> Text.Builder.realFloat (fixed2Double xScale) <> newlineBuilder
<> " Y Scale: " <> Text.Builder.realFloat (fixed2Double yScale) <> newlineBuilder
dumpTransformationOption (Glyph2By2Scale xScale scale01 scale10 yScale)
= " X Scale: " <> Text.Builder.realFloat (fixed2Double xScale) <> newlineBuilder
<> " X,Y Scale: " <> Text.Builder.realFloat (fixed2Double scale01) <> newlineBuilder
<> " Y,X Scale: " <> Text.Builder.realFloat (fixed2Double scale10) <> newlineBuilder
<> " Y Scale: " <> Text.Builder.realFloat (fixed2Double yScale) <> newlineBuilder
dumpOtherFlags ComponentGlyphFlags{..} =
let roundXyToGridText = if roundXyToGrid then "Round X,Y to Grid " else " "
useMyMetricsText = if useMyMetrics then "Use My Metrics " else " "
overlapCompoundText = if overlapCompound then "Overlap " else " "
in roundXyToGridText <> overlapCompoundText <> useMyMetricsText
dumpCompoundFlags :: Bool -> ComponentGlyphPartDescription -> Text.Builder.Builder
dumpCompoundFlags moreComponents ComponentGlyphPartDescription{..} =
let setBits = glyphArgumentBits argument1
<> componentFlagBits flags
<> transformationOptionBits transformationOption
setBits' = if moreComponents then 5 : setBits else setBits
in Text.Builder.hexadecimal
$ foldr (flip setBit) (zeroBits :: Word16) setBits'
dumpArgument (GlyphInt8Argument argument) =
" BOffset: " <> Text.Builder.decimal argument
dumpArgument (GlyphInt16Argument argument) =
" WOffset: " <> Text.Builder.decimal argument
dumpArgument (GlyphWord8Argument argument) =
" BPoint: " <> Text.Builder.decimal argument
dumpArgument (GlyphWord16Argument argument) =
" WPoint: " <> Text.Builder.decimal argument
glyphArgumentBits (GlyphInt16Argument _) = [0, 1]
glyphArgumentBits (GlyphWord16Argument _) = [0]
glyphArgumentBits (GlyphInt8Argument _) = [1]
glyphArgumentBits (GlyphWord8Argument _) = []
componentFlagBits ComponentGlyphFlags{..} = catMaybes
[ if roundXyToGrid then Just 2 else Nothing
, if weHaveInstructions then Just 8 else Nothing
, if useMyMetrics then Just 9 else Nothing
, if overlapCompound then Just 10 else Nothing
]
transformationOptionBits GlyphScale{} = [3]
transformationOptionBits GlyphXyScale{} = [6]
transformationOptionBits Glyph2By2Scale{} = [7]
transformationOptionBits GlyphNoScale = []
dumpFlag lineValue coordinateIndex
= " " <> justifyNumber 2 coordinateIndex <> lineValue
foldFlag :: (Text.Builder.Builder, Int) -> OutlineFlag -> (Text.Builder.Builder, Int)
foldFlag (accumulator, coordinateIndex) OutlineFlag{..} =
let lineValue = ": "
<> (if thisYIsSame then "YDual " else " ")
<> (if thisXIsSame then "XDual " else " ")
<> (if repeat > 0 then "Repeat " else " ")
<> (if yShortVector then "Y-Short " else " ")
<> (if xShortVector then "X-Short " else " ")
<> (if onCurve then "On" else "Off")
<> newlineBuilder
repeatN = succIntegral repeat
repeatedLines = fold
$ Vector.cons accumulator
$ dumpFlag lineValue
<$> Vector.enumFromN coordinateIndex repeatN
in (repeatedLines, coordinateIndex + repeatN)
2024-01-29 20:13:43 +01:00
foldCoordinate
:: (Text.Builder.Builder, GlyphCoordinate)
-> Int
-> GlyphCoordinate
-> (Text.Builder.Builder, GlyphCoordinate)
foldCoordinate (accumulator, absCoordinate) coordinateIndex relCoordinate =
let nextAbs = relCoordinate <> absCoordinate
2024-01-29 20:13:43 +01:00
newLine = " " <> justifyNumber 2 coordinateIndex
<> " Rel " <> dumpCoordinate relCoordinate
<> " -> Abs " <> dumpCoordinate nextAbs
<> newlineBuilder
in (accumulator <> newLine, nextAbs)
dumpCoordinate GlyphCoordinate{..}
= "(" <> justifyNumber 7 coordinateX <> ", "
<> justifyNumber 7 coordinateY <> ")"
2024-01-15 09:42:17 +01:00
dumpTable
:: String
-> ParseState
-> FontDirectory
-> Either DumpError Text.Builder.Builder
dumpTable needle processedState fontDirectory
| Just neededTable <- findTableByTag needle fontDirectory
= parseRequired processedState fontDirectory
>>= maybe (pure mempty) (first DumpParseError)
. dumpSubTable processedState neededTable
| otherwise = Left $ DumpRequestedTableMissingError needle
2023-11-12 10:13:38 +01:00
dumpTables
:: ParseState
2023-11-11 10:57:43 +01:00
-> FontDirectory
2023-11-18 04:40:17 +01:00
-> Either DumpError Text.Builder.Builder
2023-11-19 09:42:29 +01:00
dumpTables processedState directory@FontDirectory{..}
= parseRequired processedState directory >>= traverseDirectory
2023-11-11 10:57:43 +01:00
where
2023-11-19 09:42:29 +01:00
traverseDirectory parsedRequired =
2023-11-18 04:40:17 +01:00
let initial = Right $ dumpOffsetTable directory
2023-11-19 09:42:29 +01:00
in foldl' (go parsedRequired) initial tableDirectory
2023-11-18 04:40:17 +01:00
go _ (Left accumulator) _ = Left accumulator
2023-11-19 09:42:29 +01:00
go parsedRequired (Right accumulator) tableEntry
2023-11-18 04:40:17 +01:00
= maybe (Right accumulator) (concatDump accumulator . first DumpParseError)
$ dumpSubTable processedState tableEntry parsedRequired
2023-11-11 10:57:43 +01:00
concatDump accumulator builderDump = ((accumulator <> newlineBuilder) <>)
<$> builderDump
parseRequired :: ParseState -> FontDirectory -> Either DumpError RequiredTables
parseRequired processedState fontDirectory = do
requiredHhea <- findRequired "hhea" hheaTableP
requiredHead@HeadTable{ indexToLocFormat } <-
findRequired "head" headTableP
requiredLoca <- findRequired "loca" (locaTableP indexToLocFormat)
pure $ RequiredTables
{ hheaTable = requiredHhea
, headTable = requiredHead
, locaTable = requiredLoca
}
where
findRequired tableName parser =
let missingError = Left $ DumpRequiredTableMissingError tableName
parseFound tableEntry = parseTable tableEntry parser processedState
in maybe missingError (first DumpParseError . parseFound)
$ findTableByTag tableName fontDirectory
dumpSubTable
:: ParseState
-> TableDirectory
-> RequiredTables
-> Maybe (Either ParseErrorBundle Text.Builder.Builder)
dumpSubTable processedState tableEntry RequiredTables{..} =
case getField @"tag" tableEntry of
"cmap" -> Just $ dumpCmap <$> parseTable tableEntry cmapTableP processedState
"head" -> Just $ Right $ dumpHead headTable
"hhea" -> Just $ Right $ dumpHhea hheaTable
"hmtx" -> Just $ dumpHmtx
<$> parseTable tableEntry (hmtxTableP $ getField @"numOfLongHorMetrics" hheaTable) processedState
"loca" -> Just $ Right $ dumpLoca locaTable
"maxp" -> Just $ dumpMaxp <$> parseTable tableEntry maxpTableP processedState
"name" -> Just $ dumpName <$> parseTable tableEntry nameTableP processedState
"post" -> Just $ dumpPost <$> parseTable tableEntry postTableP processedState
"OS/2" -> Just $ dumpOs2 <$> parseTable tableEntry os2TableP processedState
"cvt " -> Just $ dumpCVTable <$> parseTable tableEntry cvTableP processedState
"gasp" -> Just $ dumpGASP <$> parseTable tableEntry gaspTableP processedState
"glyf" -> Just $ dumpGlyf <$> parseTable tableEntry (glyfTableP locaTable) processedState
_ -> Nothing