From cda2a2a446f16f1238ed5e145b3ad2f8aaaba88e Mon Sep 17 00:00:00 2001
From: Eugen Wissner <belka@caraus.de>
Date: Sun, 19 Nov 2023 09:42:29 +0100
Subject: Dump the loca table

---
 src/Graphics/Fountainhead/Parser.hs | 19 ++++++++++++++++---
 1 file changed, 16 insertions(+), 3 deletions(-)

(limited to 'src/Graphics/Fountainhead/Parser.hs')

diff --git a/src/Graphics/Fountainhead/Parser.hs b/src/Graphics/Fountainhead/Parser.hs
index 96209f7..209faa2 100644
--- a/src/Graphics/Fountainhead/Parser.hs
+++ b/src/Graphics/Fountainhead/Parser.hs
@@ -23,6 +23,7 @@ module Graphics.Fountainhead.Parser
     , headTableP
     , hheaTableP
     , hmtxTableP
+    , locaTableP
     , longDateTimeP
     , longLocaTableP
     , maxpTableP
@@ -107,6 +108,7 @@ import Graphics.Fountainhead.TrueType
     , HeadTable(..)
     , HheaTable(..)
     , HmtxTable(..)
+    , IndexToLocFormat(..)
     , LocaTable(..)
     , LongHorMetric(..)
     , MaxpTable(..)
@@ -293,9 +295,17 @@ headTableP = HeadTable
     <*> fontStyleP
     <*> Megaparsec.Binary.word16be
     <*> fontDirectionHintP
-    <*> Megaparsec.Binary.word16be
+    <*> indexToLocFormatP
     <*> Megaparsec.Binary.word16be
     <* Megaparsec.eof
+  where
+    indexToLocFormatP = do
+        indexToLocFormat' <- Megaparsec.Binary.int16be
+        case indexToLocFormat' of
+            0 -> pure ShortOffsetIndexToLocFormat
+            1 -> pure LongOffsetIndexToLocFormat
+            _ -> fail $ "Unknown loca table format indexToLocFormat: "
+                <> show indexToLocFormat'
 
 fontStyleP :: Parser FontStyle
 fontStyleP = go <$> Megaparsec.Binary.word16be
@@ -330,6 +340,10 @@ shortLocaTableP = ShortLocaTable
     <$> vectorP Megaparsec.Binary.word16be
     <?> "loca table, short version"
 
+locaTableP :: IndexToLocFormat -> Parser LocaTable
+locaTableP ShortOffsetIndexToLocFormat = shortLocaTableP
+locaTableP LongOffsetIndexToLocFormat = longLocaTableP
+
 -- * Horizontal metrics table
 
 longHorMetricP :: Parser LongHorMetric
@@ -587,9 +601,8 @@ simpleGlyphDefinitionP numberOfContours' = do
                     , thisXIsSame = testBit flag 4
                     , thisYIsSame = testBit flag 5
                     }
-                repeat = testBit flag 3
             repeatN <- 
-                if repeat
+                if testBit flag 3
                 then (1 +)
                     . fromIntegral
                     <$> Megaparsec.Binary.word8
-- 
cgit v1.2.3