47 lines
1.5 KiB
Haskell
47 lines
1.5 KiB
Haskell
|
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
|