Decompress defalte compressed fonts

This commit is contained in:
2023-12-27 16:19:21 +01:00
parent a841f138fc
commit 16d9fc384f
6 changed files with 70 additions and 351 deletions

View File

@ -2,44 +2,25 @@ module Main
( main
) where
import Control.Monad (foldM_)
import Data.Int (Int64)
import qualified Data.ByteString as ByteString
import qualified Data.ByteString.Char8 as Char8
import Data.ByteString (ByteString)
import Data.Bifunctor (Bifunctor(..))
import qualified Text.Megaparsec as Megaparsec
import Data.Foldable (find)
import qualified Data.Text.Lazy.Builder as Text.Builder
import qualified Data.Text.Lazy.Builder.Int as Text.Builder
import qualified Data.Text.Lazy as Text.Lazy
import qualified Data.Text.Lazy.IO as Text.Lazy
import qualified Data.Text.Encoding as Text
import GHC.Records (HasField(..))
import Graphics.Fountainhead.Dumper (DumpError(..), dumpTrueType)
import Graphics.Fountainhead (parseFontDirectoryFromFile)
import Graphics.Fountainhead.Dumper (DumpError(..), dumpTables)
-- 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(..)
, OffsetSubtable(..)
, TableDirectory(..)
)
import System.Environment (getArgs)
import System.Exit (exitWith)
import GHC.IO.Exception (ExitCode(..))
fontMain :: FilePath -> IO ()
fontMain fontFile = do
putStrLn $ "Dumping File:" <> fontFile <> "\n\n"
putStrLn ("Dumping File:" <> fontFile <> "\n\n")
ttfContents <- ByteString.readFile fontFile
case dumpTrueType ttfContents fontFile of
(processedState, initialResult) <- parseFontDirectoryFromFile fontFile
case first DumpParseError initialResult >>= dumpTables processedState of
Right fontDump -> Text.Lazy.putStrLn $ Text.Builder.toLazyText fontDump
Left e
| DumpParseError bundle <- e -> putStr