summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
Diffstat
-rw-r--r--app/Main.hs64
-rw-r--r--fountainhead.cabal15
-rw-r--r--lib/Graphics/Fountainhead.hs (renamed from src/Graphics/Fountainhead.hs)33
-rw-r--r--lib/Graphics/Fountainhead/Compression.hs27
-rw-r--r--lib/Graphics/Fountainhead/Dumper.hs (renamed from src/Graphics/Fountainhead/Dumper.hs)7
-rw-r--r--lib/Graphics/Fountainhead/Parser.hs (renamed from src/Graphics/Fountainhead/Parser.hs)0
-rw-r--r--lib/Graphics/Fountainhead/TrueType.hs (renamed from src/Graphics/Fountainhead/TrueType.hs)0
-rw-r--r--lib/Graphics/Fountainhead/Type.hs (renamed from src/Graphics/Fountainhead/Type.hs)0
8 files changed, 98 insertions, 48 deletions
diff --git a/app/Main.hs b/app/Main.hs
index afdee16..b79acaa 100644
--- a/app/Main.hs
+++ b/app/Main.hs
@@ -2,36 +2,52 @@ module Main
( main
) where
-import Data.Bifunctor (Bifunctor(..))
-import qualified Text.Megaparsec as Megaparsec
import qualified Data.Text.Lazy.Builder as Text.Builder
import qualified Data.Text.Lazy.IO as Text.Lazy
-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 System.Environment (getArgs)
+import Graphics.Fountainhead (dumpFontFile)
import System.Exit (exitWith)
import GHC.IO.Exception (ExitCode(..))
+import Options.Applicative
+ ( Parser
+ , ParserInfo(..)
+ , argument
+ , command
+ , execParser
+ , info
+ , fullDesc
+ , metavar
+ , progDesc
+ , str
+ , subparser
+ )
-fontMain :: FilePath -> IO ()
-fontMain fontFile = do
- putStrLn ("Dumping File:" <> fontFile <> "\n\n")
+data Operation
+ = Dump FilePath
+ | Afm FilePath
+ deriving (Eq, Show)
- (processedState, initialResult) <- parseFontDirectoryFromFile fontFile
+dump :: Parser Operation
+dump = Dump
+ <$> argument str (metavar "FONTFILE")
- case first DumpParseError initialResult >>= dumpTables processedState of
- Right fontDump -> Text.Lazy.putStrLn $ Text.Builder.toLazyText fontDump
- Left e
- | DumpParseError bundle <- e -> putStr
- $ Megaparsec.errorBundlePretty bundle
- | DumpRequiredTableMissingError tableName <- e -> putStr
- $ "Required table " <> tableName <> " is missing."
+afm :: Parser Operation
+afm = Afm
+ <$> argument str (metavar "FONTFILE")
+
+operationOptions :: ParserInfo Operation
+operationOptions = info commands fullDesc
+ where
+ commands = subparser
+ $ command "dump" (info dump (progDesc "Dumping the contents of a TrueType Font file"))
+ <> command "afm" (info afm (progDesc "Generating Adobe Font Metrics files for TrueType fonts"))
main :: IO ()
-main = do
- programArguments <- getArgs
- case programArguments of
- [fontFile] -> fontMain fontFile
- _ -> putStrLn "The program expects exactly one argument, the font file path."
- >> exitWith (ExitFailure 2)
+main = execParser operationOptions >>= handleArguments
+ where
+ handleArguments (Dump fontFile)
+ = putStrLn ("Dumping File:" <> fontFile <> "\n\n")
+ >> dumpFontFile fontFile
+ >>= either print (Text.Lazy.putStrLn . Text.Builder.toLazyText)
+ handleArguments (Afm _)
+ = putStrLn "The program expects exactly one argument, the font file path."
+ >> exitWith (ExitFailure 2)
diff --git a/fountainhead.cabal b/fountainhead.cabal
index 1271e18..c213d27 100644
--- a/fountainhead.cabal
+++ b/fountainhead.cabal
@@ -12,7 +12,7 @@ author: Eugen Wissner
license-files: LICENSE
license: MPL-2.0
-copyright: (c) 2023 Eugen Wissner
+copyright: (c) 2024 Eugen Wissner
category: Graphics
extra-source-files:
@@ -21,6 +21,7 @@ extra-source-files:
common dependencies
build-depends:
+ base >= 4.16 && < 5,
bytestring ^>= 0.11.0,
text ^>= 2.0,
zlib ^>= 0.6.3
@@ -30,13 +31,13 @@ library
import: dependencies
exposed-modules:
Graphics.Fountainhead
+ Graphics.Fountainhead.Compression
Graphics.Fountainhead.Dumper
Graphics.Fountainhead.Parser
Graphics.Fountainhead.Type
Graphics.Fountainhead.TrueType
- hs-source-dirs: src
+ hs-source-dirs: lib
build-depends:
- base >= 4.16 && < 5,
containers ^>= 0.6.5,
megaparsec ^>= 9.3,
time ^>= 1.12,
@@ -53,13 +54,13 @@ executable fountainhead
DuplicateRecordFields
ExplicitForAll
build-depends:
- base,
containers,
+ fountainhead,
+ megaparsec,
+ optparse-applicative ^>= 0.18.1,
parser-combinators,
vector,
transformers,
- time,
- megaparsec,
- fountainhead
+ time
hs-source-dirs: app
ghc-options: -Wall
diff --git a/src/Graphics/Fountainhead.hs b/lib/Graphics/Fountainhead.hs
index f965680..3852d51 100644
--- a/src/Graphics/Fountainhead.hs
+++ b/lib/Graphics/Fountainhead.hs
@@ -2,28 +2,31 @@
v. 2.0. If a copy of the MPL was not distributed with this file, You can
obtain one at https://mozilla.org/MPL/2.0/. -}
+-- | Convenience wrappers for working with font files.
module Graphics.Fountainhead
- ( parseFontDirectoryFromFile
+ ( dumpFontFile
+ , parseFontDirectoryFromFile
) where
-import qualified Codec.Compression.Zlib as Zlib
import Data.ByteString (ByteString)
-import qualified Data.ByteString as ByteString
-import qualified Data.ByteString.Lazy as ByteString.Lazy
import Data.Void (Void)
+import Graphics.Fountainhead.Dumper (dumpTables, DumpError(..))
import Graphics.Fountainhead.Parser (ParseErrorBundle, fontDirectoryP)
import Graphics.Fountainhead.TrueType (FontDirectory(..))
import qualified Text.Megaparsec as Megaparsec
import Text.Megaparsec (PosState(..), State(..))
-import System.IO (IOMode(..), SeekMode(..), hFileSize, hSeek, withBinaryFile)
+import System.IO (IOMode(..), withBinaryFile)
+import Data.Bifunctor (Bifunctor(..))
+import qualified Data.Text.Lazy.Builder as Text.Builder
+import Graphics.Fountainhead.Compression (hDecompress)
-parseFontDirectoryFromFile :: String
+parseFontDirectoryFromFile :: FilePath
-> IO (State ByteString Void, Either ParseErrorBundle FontDirectory)
parseFontDirectoryFromFile fontFile =
withBinaryFile fontFile ReadMode withFontHandle
where
withFontHandle fontHandle = doParsing
- <$> readFontContents fontHandle
+ <$> hDecompress fontHandle
doParsing ttfContents =
let initialState = Megaparsec.State
{ stateInput = ttfContents
@@ -38,13 +41,9 @@ parseFontDirectoryFromFile fontFile =
, stateParseErrors = []
}
in Megaparsec.runParser' fontDirectoryP initialState
- readFontContents fontHandle = do
- firstBytes <- ByteString.unpack <$> ByteString.hGet fontHandle 2
- hSeek fontHandle AbsoluteSeek 0
- fileSize <- fromIntegral <$> hFileSize fontHandle
- case firstBytes of
- 0x78 : [secondByte]
- | secondByte `elem` [0x01, 0x9c, 0x5e, 0xda] ->
- ByteString.Lazy.toStrict . Zlib.decompress
- <$> ByteString.Lazy.hGet fontHandle fileSize
- _ -> ByteString.hGetContents fontHandle
+
+dumpFontFile :: FilePath -> IO (Either DumpError Text.Builder.Builder)
+dumpFontFile fontFile = do
+ (processedState, initialResult) <- parseFontDirectoryFromFile fontFile
+
+ pure $ first DumpParseError initialResult >>= dumpTables processedState
diff --git a/lib/Graphics/Fountainhead/Compression.hs b/lib/Graphics/Fountainhead/Compression.hs
new file mode 100644
index 0000000..c1a05fc
--- /dev/null
+++ b/lib/Graphics/Fountainhead/Compression.hs
@@ -0,0 +1,27 @@
+-- | Font compression and decompression.
+module Graphics.Fountainhead.Compression
+ ( compress
+ , hDecompress
+ ) where
+
+import qualified Data.ByteString.Lazy as ByteString.Lazy
+import Data.ByteString (ByteString)
+import qualified Data.ByteString as ByteString
+import qualified Codec.Compression.Zlib as Zlib
+import System.IO (Handle, SeekMode(..), hFileSize, hSeek)
+
+-- | Reads the font from a file handle decompressing it if needed.
+hDecompress :: Handle -> IO ByteString
+hDecompress fontHandle = do
+ firstBytes <- ByteString.unpack <$> ByteString.hGet fontHandle 2
+ hSeek fontHandle AbsoluteSeek 0
+ fileSize <- fromIntegral <$> hFileSize fontHandle
+ case firstBytes of
+ 0x78 : [secondByte]
+ | secondByte `elem` [0x01, 0x9c, 0x5e, 0xda] ->
+ ByteString.Lazy.toStrict . Zlib.decompress
+ <$> ByteString.Lazy.hGet fontHandle fileSize
+ _ -> ByteString.hGetContents fontHandle
+
+compress :: ByteString -> ByteString
+compress = ByteString.Lazy.toStrict . Zlib.compress . ByteString.Lazy.fromStrict
diff --git a/src/Graphics/Fountainhead/Dumper.hs b/lib/Graphics/Fountainhead/Dumper.hs
index adda06f..bbb17c2 100644
--- a/src/Graphics/Fountainhead/Dumper.hs
+++ b/lib/Graphics/Fountainhead/Dumper.hs
@@ -127,6 +127,13 @@ import Prelude hiding (repeat)
data DumpError
= DumpParseError (Megaparsec.ParseErrorBundle ByteString Void)
| DumpRequiredTableMissingError String
+ deriving Eq
+
+instance Show DumpError
+ where
+ show (DumpParseError errorBundle) = Megaparsec.errorBundlePretty errorBundle
+ show (DumpRequiredTableMissingError tableName) =
+ "Required table " <> tableName <> " is missing."
data RequiredTables = RequiredTables
{ hheaTable :: HheaTable
diff --git a/src/Graphics/Fountainhead/Parser.hs b/lib/Graphics/Fountainhead/Parser.hs
index 31dcd0e..31dcd0e 100644
--- a/src/Graphics/Fountainhead/Parser.hs
+++ b/lib/Graphics/Fountainhead/Parser.hs
diff --git a/src/Graphics/Fountainhead/TrueType.hs b/lib/Graphics/Fountainhead/TrueType.hs
index 0c15081..0c15081 100644
--- a/src/Graphics/Fountainhead/TrueType.hs
+++ b/lib/Graphics/Fountainhead/TrueType.hs
diff --git a/src/Graphics/Fountainhead/Type.hs b/lib/Graphics/Fountainhead/Type.hs
index e809d9c..e809d9c 100644
--- a/src/Graphics/Fountainhead/Type.hs
+++ b/lib/Graphics/Fountainhead/Type.hs
generated by cgit v1.2.3 (git 2.26.2) at 2026-06-26 19:42:50 +0000