Create a Metrics module

CHANGELOG.md

@@ -1,3 +1,9 @@
-# Revision history for fountainhead
+# Changelog
+All notable changes to this project will be documented in this file.
+
+The format is based on
+[Keep a Changelog](https://keepachangelog.com/en/1.0.0/),
+and this project adheres to
+[Haskell Package Versioning Policy](https://pvp.haskell.org/).
 
 ## Unreleased

README.md

@@ -0,0 +1,39 @@
+# TrueType font parser.
+
+Fountainhead is a TrueType and OpenType font parser. Its main
+purpose is to extract information from the fonts to help to
+embed these fonts into PDF documents. It also supports dumping
+font information to the screen.
+
+There is also an executable to dump fonts.
+
+## Installation
+
+Add the library as dependency to your project.
+Alternatively build and run the executable with:
+
+```sh
+cabal build
+```
+
+The binary can be executed with:
+
+```sh
+cabal run fountainhead --
+```
+
+or installed locally and executed just as:
+
+```sh
+fountainhead
+```
+
+See
+
+```sh
+fountainhead --help
+```
+
+for help.
+
+## Usage

README.txt

@@ -1,6 +0,0 @@
-# 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.

fountainhead.cabal

@@ -17,7 +17,7 @@ category: Graphics
 
 extra-source-files:
   CHANGELOG.md
-  README.txt
+  README.md
 
 common dependencies
   build-depends:
@@ -25,7 +25,7 @@ common dependencies
     bytestring ^>= 0.11.0,
     text ^>= 2.0,
     zlib ^>= 0.6.3
-  default-language: Haskell2010
+  default-language: GHC2021
 
 library
   import: dependencies
@@ -33,6 +33,7 @@ library
     Graphics.Fountainhead
     Graphics.Fountainhead.Compression
     Graphics.Fountainhead.Dumper
+    Graphics.Fountainhead.Metrics
     Graphics.Fountainhead.Parser
     Graphics.Fountainhead.Type
     Graphics.Fountainhead.TrueType
@@ -62,5 +63,5 @@ executable fountainhead
     vector,
     transformers,
     time
-  hs-source-dirs: app
+  hs-source-dirs: src
   ghc-options: -Wall

lib/Graphics/Fountainhead/Dumper.hs

@@ -114,6 +114,7 @@ import Graphics.Fountainhead.Type
     ( Fixed32(..)
     , succIntegral
     , ttfEpoch
+    , newlineBuilder
     , fixed2Double
     )
 import Data.Foldable (Foldable(..), find)
@@ -160,9 +161,6 @@ justifyNumber count = Text.Builder.fromLazyText
     . Text.Builder.toLazyText
     . Text.Builder.decimal
 
-newlineBuilder :: Text.Builder.Builder
-newlineBuilder = Text.Builder.singleton '\n'
-
 dumpCaption :: String -> Text.Builder.Builder
 dumpCaption headline = Text.Builder.fromString headline
     <> newlineBuilder
@@ -288,7 +286,7 @@ longDateTime localTime = Text.Builder.fromLazyText
 dumpCVTable :: CVTable -> Text.Builder.Builder
 dumpCVTable (CVTable cvTable) = dumpCaption "'cvt ' Table - Control Value Table"
     <> "Size = " <> Text.Builder.decimal (tableSize * 2)
-    <> " bytes, " <> Text.Builder.decimal tableSize <> " entries\n"
+    <> " bytes, " <> Text.Builder.decimal tableSize <> " entries" <> newlineBuilder
     <> foldMap (uncurry go) (zip [0..] cvTable)
   where
     tableSize = Prelude.length cvTable

lib/Graphics/Fountainhead/Metrics.hs

@@ -0,0 +1,29 @@
+{- This Source Code Form is subject to the terms of the Mozilla Public License,
+   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/. -}
+
+{-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE RecordWildCards #-}
+
+module Graphics.Fountainhead.Metrics
+    ( FontMetrics(..)
+    , afmFontMetrics
+    ) where
+
+import qualified Data.Text.Lazy.Builder as Text.Builder
+import Data.Version (Version(..), showVersion)
+import Graphics.Fountainhead.Type (newlineBuilder)
+
+newtype FontMetrics = FontMetrics
+    { version :: Version
+    } deriving (Eq, Show)
+
+afmKeyString :: Text.Builder.Builder -> String -> Text.Builder.Builder
+afmKeyString key value = key <> Text.Builder.singleton '\t'
+    <> Text.Builder.fromString value <> newlineBuilder
+
+afmFontMetrics :: FontMetrics -> Text.Builder.Builder
+afmFontMetrics FontMetrics{..}
+    = afmKeyString "StartFontMetrics" (showVersion version)
+    <> afmKeyString "Comment" "Generated by Fountainhead"
+    <> "EndFontMetrics" <> newlineBuilder

lib/Graphics/Fountainhead/Type.hs

@@ -9,10 +9,12 @@ module Graphics.Fountainhead.Type
     , FWord
     , UFWord
     , fixed2Double
+    , newlineBuilder
     , succIntegral
     , ttfEpoch
     ) where
 
+import qualified Data.Text.Lazy.Builder as Text.Builder
 import Data.Bits ((.>>.), (.&.))
 import Data.Int (Int16)
 import Data.Word (Word16, Word32)
@@ -39,3 +41,6 @@ fixed2Double (F2Dot14 fixed) =
     let mantissa = realToFrac (fixed .>>. 14)
         fraction = realToFrac (fixed .&. 0x3fff) / 16384.0
      in mantissa + fraction
+
+newlineBuilder :: Text.Builder.Builder
+newlineBuilder = Text.Builder.singleton '\n'

src/Main.hs

@@ -10,9 +10,11 @@ import GHC.IO.Exception (ExitCode(..))
 import Options.Applicative
     ( Parser
     , ParserInfo(..)
+    , (<**>)
     , argument
     , command
     , execParser
+    , helper
     , info
     , fullDesc
     , metavar
@@ -22,32 +24,30 @@ import Options.Applicative
     )
 
 data Operation
-    = Dump FilePath
+    = Dump
-    | Afm FilePath
+    | Afm
     deriving (Eq, Show)
 
-dump :: Parser Operation
+data Options = Options Operation FilePath
-dump = Dump
+    deriving (Eq, Show)
-    <$> argument str (metavar "FONTFILE")
 
-afm :: Parser Operation
+operationOptions :: ParserInfo Options
-afm = Afm
+operationOptions = info (options <**> helper) fullDesc
-    <$> argument str (metavar "FONTFILE")
-
-operationOptions :: ParserInfo Operation
-operationOptions = info commands fullDesc
   where
+    options = Options
+        <$> commands
+        <*> argument str (metavar "FONTFILE")
     commands = subparser
-        $ command "dump" (info dump (progDesc "Dumping the contents of a TrueType Font file"))
+        $ command "dump" (info (pure Dump) (progDesc "Dumping the contents of a TrueType Font file."))
-        <> command "afm" (info afm (progDesc "Generating Adobe Font Metrics files for TrueType fonts"))
+        <> command "afm" (info (pure Afm) (progDesc "Generating Adobe Font Metrics files for TrueType fonts."))
 
 main :: IO ()
 main = execParser operationOptions >>= handleArguments
   where
-    handleArguments (Dump fontFile)
+    handleArguments (Options Dump fontFile)
         = putStrLn ("Dumping File:" <> fontFile <> "\n\n")
         >> dumpFontFile fontFile
         >>= either print (Text.Lazy.putStrLn . Text.Builder.toLazyText)
-    handleArguments (Afm _)
+    handleArguments (Options Afm _)
         = putStrLn "The program expects exactly one argument, the font file path."
         >> exitWith (ExitFailure 2)