Modify the parser to save less outline flags

… than coordinates if the repeated value is given.

1 files changed, 36 insertions, 29 deletions

diff --git a/src/Graphics/Fountainhead/Parser.hs b/src/Graphics/Fountainhead/Parser.hs
index bb74ea7..72ea36d 100644
--- a/src/Graphics/Fountainhead/Parser.hs
+++ b/src/Graphics/Fountainhead/Parser.hs
@@ -142,7 +142,12 @@ import Graphics.Fountainhead.TrueType
     , VariationSelectorMap
     , unLocaTable
     )
-import Graphics.Fountainhead.Type (F2Dot14(..), Fixed32(..), ttfEpoch)
+import Graphics.Fountainhead.Type
+    ( F2Dot14(..)
+    , Fixed32(..)
+    , succIntegral
+    , ttfEpoch
+    )
 import Text.Megaparsec ((<?>))
 import qualified Text.Megaparsec as Megaparsec
 import qualified Text.Megaparsec.Byte.Binary as Megaparsec.Binary
@@ -561,60 +566,62 @@ simpleGlyphDefinitionP numberOfContours' = do
     instructions' <- vectorNP instructionLength
             (Megaparsec.Binary.word8 <?> "simple glyph instruction")
     flags' <- flagsP numberOfPoints mempty <?> "flags"
-    xs <- Vector.foldM (coordinateP xFlagPair) mempty flags'
-    ys <- Vector.foldM (coordinateP yFlagPair) mempty flags'
+    xs <- Vector.foldM (coordinatesP xFlagPair) mempty flags'
+    ys <- Vector.foldM (coordinatesP yFlagPair) mempty flags'
     pure $ SimpleGlyphDefinition
         { endPtsOfContours = endPtsOfContours'
         , instructions = instructions'
-        , coordinates = mkCoordinate <$> Vector.zip3 xs ys flags'
+        , flags = flags'
+        , coordinates = mkCoordinate <$> Vector.zip xs ys
         }
   where
-    mkCoordinate (x, y, OutlineFlag{ onCurve }) = GlyphCoordinate x y onCurve
+    mkCoordinate (x, y) = GlyphCoordinate x y
     xFlagPair :: OutlineFlag -> (Bool, Bool)
     xFlagPair OutlineFlag{ xShortVector, thisXIsSame } =
         (xShortVector, thisXIsSame)
     yFlagPair :: OutlineFlag -> (Bool, Bool)
     yFlagPair OutlineFlag{ yShortVector, thisYIsSame } =
         (yShortVector, thisYIsSame)
-    coordinateP
+    coordinateP :: Bool -> Bool -> Parser Int16
+    coordinateP True True = fromIntegral
+        <$> Megaparsec.Binary.word8
+        <?> "1 byte long positive coordinate"
+    coordinateP True False = negate . fromIntegral
+        <$> Megaparsec.Binary.word8
+        <?> "1 byte long negative coordinate"
+    coordinateP False False = Megaparsec.Binary.int16be
+        <?> "2 bytes long coordinate"
+    coordinateP False True = pure 0
+    coordinatesP
         :: (OutlineFlag -> (Bool, Bool))
         -> Vector Int16
         -> OutlineFlag
         -> Parser (Vector Int16)
-    coordinateP get accumulator first =
-        case get first of
-            (True, True) -> Vector.snoc accumulator . fromIntegral
-                <$> Megaparsec.Binary.word8
-                <?> "1 byte long positive coordinate"
-            (True, False)
-                -> Vector.snoc accumulator  . negate . fromIntegral
-                <$> Megaparsec.Binary.word8
-                <?> "1 byte long negative coordinate"
-            (False, False) -> Vector.snoc accumulator
-                <$> Megaparsec.Binary.int16be
-                <?> "2 bytes long coordinate"
-            (False, True) -> pure $ Vector.snoc accumulator 0
+    coordinatesP get accumulator first =
+        let parser = uncurry coordinateP $ get first
+            repeatN = succIntegral $ getField @"repeat" first
+         in (accumulator <>) <$> vectorNP repeatN parser
     flagsP :: Int -> Vector OutlineFlag -> Parser (Vector OutlineFlag)
     flagsP remaining accumulator
         | remaining < 0 = pure accumulator
         | otherwise = do
             flag <- Megaparsec.Binary.word8 <?> "outline flags"
+            repeatN <- 
+                if testBit flag 3
+                then fromIntegral
+                    <$> Megaparsec.Binary.word8
+                    <?> "flag repeat count"
+                else pure 0
             let flag' = OutlineFlag
                     { onCurve = testBit flag 0
                     , xShortVector = testBit flag 1
                     , yShortVector = testBit flag 2
+                    , repeat = fromIntegral repeatN
                     , thisXIsSame = testBit flag 4
                     , thisYIsSame = testBit flag 5
                     }
-            repeatN <- 
-                if testBit flag 3
-                then (1 +)
-                    . fromIntegral
-                    <$> Megaparsec.Binary.word8
-                    <?> "flag repeat count"
-                else pure 1
-            flagsP (remaining - repeatN)
-                $ accumulator <> Vector.replicate repeatN flag'
+            flagsP (remaining - repeatN - 1)
+                $ Vector.snoc accumulator flag'
 
 glyfTableP :: LocaTable -> Parser GlyfTable
 glyfTableP locaTable
@@ -871,7 +878,7 @@ cmapFormat2TableP = do
     length' <- fromIntegral <$> Megaparsec.Binary.word16be
     language' <- Megaparsec.Binary.word16be
     subHeaderKeys' <- vectorNP 256 Megaparsec.Binary.word16be
-    let maxIndex = succ $ fromIntegral $ Vector.maximum $ fmap (`div` 8) subHeaderKeys'
+    let maxIndex = succIntegral $ Vector.maximum $ fmap (`div` 8) subHeaderKeys'
     subHeaders' <- vectorNP maxIndex cmapFormat2SubheaderP
     let glyphIndexLength = div (length' - 518 - maxIndex * 8) 2
     glyphIndexArray' <- vectorNP glyphIndexLength Megaparsec.Binary.word16be