From 929ab04c2cdaa2c2296a2bf64582981fed52eb8e Mon Sep 17 00:00:00 2001
From: Eugen Wissner <belka@caraus.de>
Date: Tue, 14 Mar 2023 09:52:02 +0100
Subject: [PATCH] Add a test program

---
 README.txt         |  7 ++++++-
 app/Main.hs        | 46 ++++++++++++++++++++++++++++++++++++++++++++++
 fountainhead.cabal | 24 ++++++++++++++++++++++++
 3 files changed, 76 insertions(+), 1 deletion(-)
 create mode 100644 app/Main.hs

diff --git a/README.txt b/README.txt
index d3038fa..a69c401 100644
--- a/README.txt
+++ b/README.txt
@@ -1 +1,6 @@
-TrueType font parser.
+# TrueType font parser.
+
+An experiment to create a TrueType and OpenType font parser and encoder
+that can be used to embed fonts in PDF.
+
+This project is currently only a draft.
diff --git a/app/Main.hs b/app/Main.hs
new file mode 100644
index 0000000..24e7a32
--- /dev/null
+++ b/app/Main.hs
@@ -0,0 +1,46 @@
+module Main
+    ( main
+    ) where
+
+import qualified Data.ByteString as ByteString
+import Data.ByteString (ByteString)
+import qualified Text.Megaparsec as Megaparsec
+import Data.Foldable (find)
+-- TODO: kern table since format 1.
+-- For details on subtable format see examples in TrueType reference.
+import Graphics.Fountainhead.Parser
+    ( fontDirectoryP
+    , os2TableP
+    , parseTable
+    , shortLocaTableP
+    )
+import Graphics.Fountainhead.TrueType (FontDirectory(..), TableDirectory(..))
+import System.Environment (getArgs)
+
+fontMain :: IO ()
+fontMain = do
+    fontFile <- head <$> getArgs
+    ttfContents <- ByteString.readFile fontFile
+
+    let initialState = Megaparsec.State
+            { stateInput = ttfContents
+            , stateOffset = 0
+            , statePosState = Megaparsec.PosState
+                { pstateInput = ttfContents
+                , pstateOffset = 0
+                , pstateSourcePos = Megaparsec.initialPos fontFile
+                , pstateTabWidth = Megaparsec.defaultTabWidth
+                , pstateLinePrefix = ""
+                }
+            , stateParseErrors = []
+            }
+        (processedState, Right directory) = Megaparsec.runParser' fontDirectoryP initialState
+    print directory
+    let Just tableDirectory' = find (("OS/2" ==) . tag) $ tableDirectory directory
+        tableResult = parseTable tableDirectory' os2TableP processedState
+    case tableResult of
+        Left e -> putStr (Megaparsec.errorBundlePretty e)
+        Right x -> print x
+
+main :: IO ()
+main = fontMain
diff --git a/fountainhead.cabal b/fountainhead.cabal
index 56158d4..b8536f8 100644
--- a/fountainhead.cabal
+++ b/fountainhead.cabal
@@ -35,3 +35,27 @@ library
     megaparsec ^>= 9.3,
     time ^>= 1.12,
     vector ^>= 0.13.0
+
+executable fountainhead
+  main-is: Main.hs
+
+  default-extensions:
+    OverloadedStrings
+    NamedFieldPuns
+    DataKinds
+    DuplicateRecordFields
+    ExplicitForAll
+    TypeApplications
+  build-depends:
+    base,
+    bytestring,
+    containers,
+    parser-combinators,
+    vector,
+    transformers,
+    text,
+    time,
+    megaparsec,
+    fountainhead
+  hs-source-dirs: app
+  default-language: Haskell2010