Dump common OS/2 table fields
This commit is contained in:
		| @@ -20,6 +20,7 @@ module Graphics.Fountainhead.Dumper | ||||
|     , dumpLoca | ||||
|     , dumpName | ||||
|     , dumpMaxp | ||||
|     , dumpOs2 | ||||
|     , dumpPost | ||||
|     , dumpTrueType | ||||
|     , dumpOffsetTable | ||||
| @@ -66,6 +67,8 @@ import Graphics.Fountainhead.TrueType | ||||
|     , MaxpTable(..) | ||||
|     , TrueMaxpTable(..) | ||||
|     , nameStringOffset | ||||
|     , Os2BaseFields(..) | ||||
|     , Os2Table(..) | ||||
|     ) | ||||
| import qualified Text.Megaparsec as Megaparsec | ||||
| import Graphics.Fountainhead.Parser | ||||
| @@ -78,13 +81,14 @@ import Graphics.Fountainhead.Parser | ||||
|     , locaTableP | ||||
|     , maxpTableP | ||||
|     , nameTableP | ||||
|     , os2TableP | ||||
|     , postTableP | ||||
|     ) | ||||
| import Graphics.Fountainhead.Type (Fixed32(..), ttfEpoch) | ||||
| import Data.Foldable (Foldable(..), find) | ||||
| import Data.Maybe (fromMaybe) | ||||
| import Data.Time (LocalTime(..), NominalDiffTime, diffLocalTime, midnight) | ||||
| import Data.Bits (Bits(..)) | ||||
| import Data.Bits (Bits(..), (.>>.)) | ||||
| import Data.Bifunctor (Bifunctor(first)) | ||||
| import Data.List (intersperse) | ||||
|  | ||||
| @@ -241,6 +245,62 @@ longDateTime localTime = Text.Builder.fromLazyText | ||||
|     $ (truncate :: NominalDiffTime -> Int) | ||||
|     $ diffLocalTime localTime (LocalTime ttfEpoch midnight) | ||||
|  | ||||
| dumpOs2 :: Os2Table -> Text.Builder.Builder | ||||
| dumpOs2 = (dumpCaption "'OS/2' Table - OS/2 and Windows Metrics" <>) . go | ||||
|   where | ||||
|     go = \case | ||||
|         Os2Version0 baseFields _ -> dumpBaseFields baseFields | ||||
|         Os2Version1 baseFields _ _ -> dumpBaseFields baseFields | ||||
|         Os2Version2 baseFields _ _ -> dumpBaseFields baseFields | ||||
|         Os2Version3 baseFields _ _ -> dumpBaseFields baseFields | ||||
|         Os2Version4 baseFields _ _ -> dumpBaseFields baseFields | ||||
|         Os2Version5 baseFields _ _ -> dumpBaseFields baseFields | ||||
|     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 | ||||
|         <> "         sFamilyClass:" <> familyClass sFamilyClass | ||||
|     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 | ||||
|  | ||||
| dumpPost :: PostTable -> Text.Builder.Builder | ||||
| dumpPost PostTable{ postHeader = PostHeader{..}, postSubtable } | ||||
|     = dumpCaption "'post' Table - PostScript" <> newlineBuilder | ||||
| @@ -500,6 +560,7 @@ dumpTables processedState directory@FontDirectory{..} | ||||
|             "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 | ||||
|             _ -> Nothing | ||||
|  | ||||
| dumpTrueType :: ByteString -> FilePath -> Either DumpError Text.Builder.Builder | ||||
|   | ||||
		Reference in New Issue
	
	Block a user