Add a test program

1 files changed, 46 insertions, 0 deletions

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