Dump compound glyph info

This commit is contained in:
Eugen Wissner 2024-02-02 01:44:49 +01:00
parent 1bcff4c519
commit 34d3ece99e
Signed by: belka
GPG Key ID: A27FDC1E8EE902C0
3 changed files with 90 additions and 4 deletions

View File

@ -14,6 +14,7 @@
module Graphics.Fountainhead.Dumper
( DumpError(..)
, dumpCmap
, dumpGlyf
, dumpHead
, dumpHmtx
, dumpHhea
@ -38,16 +39,20 @@ 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
import qualified Data.Text.Lazy.Builder.RealFloat as Text.Builder
import Data.Vector (Vector)
import qualified Data.Vector as Vector
import Data.Void
import GHC.Records (HasField(..))
import Graphics.Fountainhead.TrueType
( CmapTable(..)
, CompoundGlyphDefinition(..)
, ComponentGlyphPartDescription(..)
, FontDirectory(..)
, FontDirectionHint(..)
, GASPRange(..)
, GASPTable(..)
, GlyphArgument(..)
, HeadTable(..)
, HheaTable(..)
, HmtxTable(..)
@ -61,6 +66,7 @@ import Graphics.Fountainhead.TrueType
, CmapSubtable(..)
, CmapFormat4Table(..)
, FontStyle(..)
, GlyphArgument(..)
, GlyphCoordinate(..)
, GlyphDefinition(..)
, GlyphDescription(..)
@ -83,7 +89,9 @@ import Graphics.Fountainhead.TrueType
, Panose(..)
, SimpleGlyphDefinition(..)
, CVTable(..)
, OutlineFlag (..)
, OutlineFlag(..)
, ComponentGlyphFlags(..)
, GlyphTransformationOption(..)
)
import qualified Text.Megaparsec as Megaparsec
import Graphics.Fountainhead.Parser
@ -102,9 +110,14 @@ import Graphics.Fountainhead.Parser
, cvTableP
, glyfTableP
)
import Graphics.Fountainhead.Type (Fixed32(..), succIntegral, ttfEpoch)
import Graphics.Fountainhead.Type
( Fixed32(..)
, succIntegral
, ttfEpoch
, fixed2Double
)
import Data.Foldable (Foldable(..), find)
import Data.Maybe (fromMaybe)
import Data.Maybe (fromMaybe, catMaybes)
import Data.Time (LocalTime(..), NominalDiffTime, diffLocalTime, midnight)
import Data.Bits (Bits(..), (.>>.))
import Data.Bifunctor (Bifunctor(first))
@ -670,7 +683,69 @@ dumpGlyf (GlyfTable glyfDescriptions) = dumpCaption "'glyf' Table - Glyf data"
<> " Coordinates" <> newlineBuilder
<> " -----------" <> newlineBuilder
<> fst (Vector.ifoldl' foldCoordinate mempty coordinates)
dumpGlyphDefinition _ = "" -- TODO
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)

View File

@ -524,6 +524,8 @@ componentGlyphPartDescriptionP accumulator = do
-- MORE_COMPONENTS.
if testBit flags' 5 then componentGlyphPartDescriptionP updated else pure updated
-- | Arguments are: WE_HAVE_A_SCALE, WE_HAVE_AN_X_AND_Y_SCALE and
-- WE_HAVE_A_TWO_BY_TWO.
transformationOptionP :: Bool -> Bool -> Bool -> Parser GlyphTransformationOption
transformationOptionP True _ _ = GlyphScale <$> f2Dot14P <?> "scale"
transformationOptionP _ True _ = GlyphXyScale
@ -538,6 +540,7 @@ transformationOptionP _ _ True = Glyph2By2Scale
<?> "2 by 2 transformation"
transformationOptionP _ _ _ = pure GlyphNoScale
-- | Arguments are: ARG_1_AND_2_ARE_WORDS and ARGS_ARE_XY_VALUES.
glyphArgumentP :: Bool -> Bool -> Parser GlyphArgument
glyphArgumentP True True = GlyphInt16Argument
<$> Megaparsec.Binary.int16be

View File

@ -8,10 +8,12 @@ module Graphics.Fountainhead.Type
, Fixed32(..)
, FWord
, UFWord
, fixed2Double
, succIntegral
, ttfEpoch
) where
import Data.Bits ((.>>.), (.&.))
import Data.Int (Int16)
import Data.Word (Word16, Word32)
import Data.Time (Day(..))
@ -31,3 +33,9 @@ ttfEpoch = fromOrdinalDate 1904 1
succIntegral :: Integral a => a -> Int
succIntegral = succ . fromIntegral
fixed2Double :: F2Dot14 -> Double
fixed2Double (F2Dot14 fixed) =
let mantissa = realToFrac (fixed .>>. 14)
fraction = realToFrac (fixed .&. 0x3fff) / 16384.0
in mantissa + fraction