diff options
| -rw-r--r-- | src/Graphics/Fountainhead/Dumper.hs | 83 | ||||
| -rw-r--r-- | src/Graphics/Fountainhead/Parser.hs | 3 | ||||
| -rw-r--r-- | src/Graphics/Fountainhead/Type.hs | 8 |
3 files changed, 90 insertions, 4 deletions
diff --git a/src/Graphics/Fountainhead/Dumper.hs b/src/Graphics/Fountainhead/Dumper.hs index 06756cb..adda06f 100644 --- a/src/Graphics/Fountainhead/Dumper.hs +++ b/src/Graphics/Fountainhead/Dumper.hs @@ -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) diff --git a/src/Graphics/Fountainhead/Parser.hs b/src/Graphics/Fountainhead/Parser.hs index 72ea36d..31dcd0e 100644 --- a/src/Graphics/Fountainhead/Parser.hs +++ b/src/Graphics/Fountainhead/Parser.hs @@ -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 diff --git a/src/Graphics/Fountainhead/Type.hs b/src/Graphics/Fountainhead/Type.hs index 07031e4..e809d9c 100644 --- a/src/Graphics/Fountainhead/Type.hs +++ b/src/Graphics/Fountainhead/Type.hs @@ -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 |