Add the PDF generator snippets
This commit is contained in:
parent
57478f8362
commit
82ecf51fea
14
app/Main.hs
14
app/Main.hs
@ -16,10 +16,11 @@ import Graphics.Fountainhead.Parser
|
||||
)
|
||||
import Graphics.Fountainhead.TrueType (FontDirectory(..), TableDirectory(..))
|
||||
import System.Environment (getArgs)
|
||||
import System.Exit (exitWith)
|
||||
import GHC.IO.Exception (ExitCode(..))
|
||||
|
||||
fontMain :: IO ()
|
||||
fontMain = do
|
||||
fontFile <- head <$> getArgs
|
||||
fontMain :: FilePath -> IO ()
|
||||
fontMain fontFile = do
|
||||
ttfContents <- ByteString.readFile fontFile
|
||||
|
||||
let initialState = Megaparsec.State
|
||||
@ -43,4 +44,9 @@ fontMain = do
|
||||
Right x -> print x
|
||||
|
||||
main :: IO ()
|
||||
main = fontMain
|
||||
main = do
|
||||
programArguments <- getArgs
|
||||
case programArguments of
|
||||
[fontFile] -> fontMain fontFile
|
||||
_ -> putStrLn "The program expects exactly one argument, the font file path."
|
||||
>> exitWith (ExitFailure 2)
|
||||
|
||||
@ -7,13 +7,11 @@ description: TrueType font parseer.
|
||||
bug-reports: https://git.caraus.tech/OSS/fountainhead/issues
|
||||
homepage: https://git.caraus.tech/OSS/fountainhead
|
||||
maintainer: belka@caraus.de
|
||||
author: Eugen Wissner
|
||||
|
||||
license-files: LICENSE
|
||||
license: MPL-2.0
|
||||
|
||||
author: Eugen Wissner
|
||||
maintainer: belka@caraus.de
|
||||
|
||||
copyright: (c) 2023 Eugen Wissner
|
||||
category: Graphics
|
||||
|
||||
@ -24,16 +22,18 @@ extra-source-files:
|
||||
library
|
||||
exposed-modules:
|
||||
Graphics.Fountainhead.Parser
|
||||
Graphics.Fountainhead.PDF
|
||||
Graphics.Fountainhead.Type
|
||||
Graphics.Fountainhead.TrueType
|
||||
hs-source-dirs:
|
||||
src
|
||||
build-depends:
|
||||
base ^>=4.16.3.0,
|
||||
base >= 4.16 && < 5,
|
||||
bytestring ^>= 0.11.0,
|
||||
containers ^>= 0.6.5,
|
||||
megaparsec ^>= 9.3,
|
||||
time ^>= 1.12,
|
||||
transformers ^>= 0.5,
|
||||
vector ^>= 0.13.0
|
||||
|
||||
executable fountainhead
|
||||
|
||||
316
src/Graphics/Fountainhead/PDF.hs
Normal file
316
src/Graphics/Fountainhead/PDF.hs
Normal file
@ -0,0 +1,316 @@
|
||||
{- 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 EmptyDataDecls #-}
|
||||
|
||||
module Graphics.Fountainhead.PDF
|
||||
( Dictionary(..)
|
||||
, E5
|
||||
, Header(..)
|
||||
, Link(..)
|
||||
, Name(..)
|
||||
, Object(..)
|
||||
, Sink
|
||||
, TextString(..)
|
||||
, Trailer(..)
|
||||
, Type(..)
|
||||
, UncoatedString(..)
|
||||
, XRefSection(..)
|
||||
, XRefEntry(..)
|
||||
, arrayType
|
||||
, headerToPdf
|
||||
, dictionaryToPdf
|
||||
, dictionaryType
|
||||
, linkToPdf
|
||||
, linkType
|
||||
, nameToPdf
|
||||
, nameType
|
||||
, nextName
|
||||
, objectToPdf
|
||||
, sinkWithLength
|
||||
, stringType
|
||||
, textStringToPdf
|
||||
, textType
|
||||
, trailerToPdf
|
||||
, typeToPdf
|
||||
, uncoatedStringToPdf
|
||||
, xrefEntryToPdf
|
||||
, xrefSectionToPdf
|
||||
, writeObject
|
||||
) where
|
||||
|
||||
import Control.Monad.IO.Class (MonadIO(..))
|
||||
import Control.Monad.Trans.State (StateT, get, gets, put)
|
||||
import Data.ByteString (ByteString)
|
||||
import qualified Data.ByteString as ByteString
|
||||
import qualified Data.ByteString.Builder as ByteString.Builder
|
||||
import qualified Data.ByteString.Builder as ByteString (Builder)
|
||||
import qualified Data.ByteString.Lazy as ByteString.Lazy
|
||||
import Data.Char (ord)
|
||||
import Data.Fixed (Fixed(..), HasResolution(..), showFixed)
|
||||
import Data.Vector (Vector)
|
||||
import qualified Data.Vector as Vector
|
||||
|
||||
-- | The header in the first line of a PDF file contains a PDF version number
|
||||
-- consisting of a major and a minor version.
|
||||
data Header = Header Int Int
|
||||
deriving (Eq, Show)
|
||||
|
||||
-- | See t'Header'.
|
||||
headerToPdf :: Header -> ByteString.Builder
|
||||
headerToPdf (Header major minor)
|
||||
= ByteString.Builder.string7 "%PDF-"
|
||||
<> ByteString.Builder.intDec major
|
||||
<> ByteString.Builder.char7 '.'
|
||||
<> ByteString.Builder.intDec minor
|
||||
<> ByteString.Builder.char7 '\n'
|
||||
|
||||
-- | A name object is an atomic symbol uniquely defined by a sequence of
|
||||
-- characters.
|
||||
newtype Name = Name String
|
||||
deriving (Eq, Show)
|
||||
|
||||
-- | See t'Name'.
|
||||
nameToPdf :: Name -> ByteString.Builder
|
||||
nameToPdf (Name name) = ByteString.Builder.char7 '/'
|
||||
<> ByteString.Builder.string7 name
|
||||
|
||||
-- | A dictionary object is an associative table containing pairs of objects.
|
||||
newtype Dictionary = Dictionary (Vector (Name, Type))
|
||||
|
||||
-- | See t'Dictionary'.
|
||||
dictionaryToPdf :: Dictionary -> IO ByteString.Builder
|
||||
dictionaryToPdf (Dictionary valuePairs) = do
|
||||
pairs <- traverse pairToPdf valuePairs
|
||||
pure
|
||||
$ ByteString.Builder.string7 "<<"
|
||||
<> unwordBuilder pairs
|
||||
<> ByteString.Builder.string7 ">>"
|
||||
where
|
||||
pairToPdf (name, value) = do
|
||||
value' <- typeToPdf value
|
||||
pure $ nameToPdf name <> ByteString.Builder.char7 ' ' <> value'
|
||||
|
||||
-- | Hexadecimal data.
|
||||
newtype UncoatedString = UncoatedString String
|
||||
deriving (Eq, Show)
|
||||
|
||||
-- | See t'UncoatedString'.
|
||||
uncoatedStringToPdf :: UncoatedString -> ByteString.Builder
|
||||
uncoatedStringToPdf (UncoatedString uncoatedString)
|
||||
= ByteString.Builder.char7 '<'
|
||||
<> ByteString.Builder.string8 uncoatedString
|
||||
<> ByteString.Builder.char7 '>'
|
||||
|
||||
-- | A sequence of literal characters.
|
||||
newtype TextString = TextString String
|
||||
deriving (Eq, Show)
|
||||
|
||||
-- | See t'TextString'.
|
||||
textStringToPdf :: TextString -> ByteString.Builder
|
||||
textStringToPdf (TextString textString)
|
||||
= ByteString.Builder.char7 '('
|
||||
<> ByteString.Builder.stringUtf8 textString
|
||||
<> ByteString.Builder.char7 ')'
|
||||
|
||||
-- Resolution of 10^-5 = .001.
|
||||
data E5
|
||||
|
||||
instance HasResolution E5
|
||||
where
|
||||
resolution _ = 100000
|
||||
|
||||
-- | Reference to an inderect object, consisting of the object name and
|
||||
-- revision.
|
||||
data Link = Link Int Int
|
||||
deriving (Eq, Show)
|
||||
|
||||
-- | See t'Link'.
|
||||
linkToPdf :: Link -> ByteString.Builder
|
||||
linkToPdf (Link name revision)
|
||||
= ByteString.Builder.intDec name
|
||||
<> ByteString.Builder.char7 ' '
|
||||
<> ByteString.Builder.intDec revision
|
||||
<> ByteString.Builder.string8 " R"
|
||||
|
||||
-- | Basic types of object.
|
||||
data Type
|
||||
= DictionaryType Dictionary
|
||||
| ArrayType (Vector Type)
|
||||
| LinkType Link
|
||||
| NameType Name
|
||||
| IntegerType Int
|
||||
| RealType (Fixed E5)
|
||||
| StreamType Dictionary (IO ByteString)
|
||||
| StringType UncoatedString
|
||||
| TextType TextString
|
||||
| NullType
|
||||
|
||||
-- | See t'Type'.
|
||||
typeToPdf :: Type -> IO ByteString.Builder
|
||||
typeToPdf (DictionaryType dictionary) = dictionaryToPdf dictionary
|
||||
typeToPdf (ArrayType values) = do
|
||||
converted <- traverse typeToPdf values
|
||||
pure
|
||||
$ ByteString.Builder.char7 '['
|
||||
<> unwordBuilder converted
|
||||
<> ByteString.Builder.char7 ']'
|
||||
typeToPdf (LinkType link) = pure $ linkToPdf link
|
||||
typeToPdf (NameType name) = pure $ nameToPdf name
|
||||
typeToPdf (IntegerType pdfInteger) = pure $ ByteString.Builder.intDec pdfInteger
|
||||
typeToPdf (StreamType dictionary producer) = do
|
||||
streamContents <- producer
|
||||
producedDictionary <- dictionaryToPdf dictionary
|
||||
pure
|
||||
$ producedDictionary
|
||||
<> ByteString.Builder.string8 "\nstream\n"
|
||||
<> ByteString.Builder.byteString streamContents
|
||||
<> ByteString.Builder.string8 "\nendstream"
|
||||
typeToPdf (StringType string) = pure $ uncoatedStringToPdf string
|
||||
typeToPdf (TextType text) = pure $ textStringToPdf text
|
||||
typeToPdf (RealType realType) =
|
||||
pure $ ByteString.Builder.string7 $ showFixed True realType
|
||||
typeToPdf NullType = pure $ ByteString.Builder.string7 "null"
|
||||
|
||||
-- | Object number, generation number and object contents.
|
||||
data Object = Object Int Int Type
|
||||
|
||||
-- | See t'Object'.
|
||||
objectToPdf :: Object -> IO ByteString.Builder
|
||||
objectToPdf (Object name revision type') = do
|
||||
producedType <- typeToPdf type'
|
||||
pure $ ByteString.Builder.intDec name
|
||||
<> ByteString.Builder.char7 ' '
|
||||
<> ByteString.Builder.intDec revision
|
||||
<> ByteString.Builder.string7 " obj\n"
|
||||
<> producedType
|
||||
<> ByteString.Builder.string7 "\nendobj\n"
|
||||
|
||||
-- | Shortcut to create a t'Dictionary' type.
|
||||
dictionaryType :: [(Name, Type)] -> Type
|
||||
dictionaryType = DictionaryType . Dictionary . Vector.fromList
|
||||
|
||||
-- | Shortcut to create an t'Array' type.
|
||||
arrayType :: [Type] -> Type
|
||||
arrayType = ArrayType . Vector.fromList
|
||||
|
||||
-- | Shortcut to create a t'Name' type.
|
||||
nameType :: String -> Type
|
||||
nameType = NameType . Name
|
||||
|
||||
-- | Shortcut to create a t'UncoatedString' type.
|
||||
stringType :: String -> Type
|
||||
stringType = StringType . UncoatedString
|
||||
|
||||
-- | Shortcut to create a t'TextString' type.
|
||||
textType :: String -> Type
|
||||
textType = TextType . TextString
|
||||
|
||||
-- | Shortcut to create a t'Link' type.
|
||||
linkType :: Int -> Int -> Type
|
||||
linkType name revision = LinkType $ Link name revision
|
||||
|
||||
-- | Byte offset of an object in the file, generation number and whether this is
|
||||
-- an in-use entry.
|
||||
data XRefEntry = XRefEntry Int Int Bool
|
||||
deriving (Eq, Show)
|
||||
|
||||
-- | See t'XRefEntry'.
|
||||
xrefEntryToPdf :: XRefEntry -> ByteString.Builder
|
||||
xrefEntryToPdf (XRefEntry offset generation True)
|
||||
= pad 10 offset
|
||||
<> ByteString.Builder.char7 ' '
|
||||
<> pad 5 generation
|
||||
<> ByteString.Builder.string7 " n"
|
||||
xrefEntryToPdf (XRefEntry offset generation False)
|
||||
= pad 10 offset
|
||||
<> ByteString.Builder.char7 ' '
|
||||
<> pad 5 generation
|
||||
<> ByteString.Builder.string7 " f"
|
||||
|
||||
-- | Cross-reference table containing information about the indirect objects in
|
||||
-- the file.
|
||||
newtype XRefSection = XRefSection
|
||||
{ unXRefSection :: Vector XRefEntry
|
||||
} deriving (Eq, Show)
|
||||
|
||||
-- | See t'XRefSection'.
|
||||
xrefSectionToPdf :: XRefSection -> ByteString.Builder
|
||||
xrefSectionToPdf (XRefSection entries)
|
||||
= ByteString.Builder.string7 "xref\n0 "
|
||||
<> ByteString.Builder.intDec (length entries)
|
||||
<> newline
|
||||
<> Vector.foldMap (newline <>) (xrefEntryToPdf <$> entries)
|
||||
<> newline
|
||||
|
||||
instance Semigroup XRefSection
|
||||
where
|
||||
(XRefSection lhs) <> (XRefSection rhs) = XRefSection $ lhs <> rhs
|
||||
|
||||
instance Monoid XRefSection
|
||||
where
|
||||
mempty = XRefSection mempty
|
||||
|
||||
-- | A trailer giving the location of the cross-reference table and of certain
|
||||
-- special objects within the body of the file.
|
||||
data Trailer = Trailer Dictionary Int
|
||||
|
||||
-- | See t'Trailer'.
|
||||
trailerToPdf :: Trailer -> IO ByteString.Builder
|
||||
trailerToPdf (Trailer dictionary startxref) = do
|
||||
producedDictionary <- dictionaryToPdf dictionary
|
||||
pure $ ByteString.Builder.string7 "trailer "
|
||||
<> producedDictionary
|
||||
<> ByteString.Builder.string7 "\nstartxref\n"
|
||||
<> ByteString.Builder.intDec startxref
|
||||
<> ByteString.Builder.string7 "\n%%EOF\n"
|
||||
|
||||
pad :: Int -> Int -> ByteString.Builder
|
||||
pad length' number =
|
||||
let asString = ByteString.Builder.intDec number
|
||||
numberLength = builderLength asString
|
||||
padding = ByteString.Builder.byteString
|
||||
$ ByteString.replicate (length' - numberLength) zero
|
||||
in padding <> asString
|
||||
where
|
||||
zero = fromIntegral $ ord '0'
|
||||
builderLength = fromIntegral
|
||||
. ByteString.Lazy.length
|
||||
. ByteString.Builder.toLazyByteString
|
||||
|
||||
unwordBuilder :: Vector ByteString.Builder -> ByteString.Builder
|
||||
unwordBuilder = Vector.foldMap (ByteString.Builder.char7 ' ' <>)
|
||||
|
||||
newline :: ByteString.Builder
|
||||
newline = ByteString.Builder.char7 '\n'
|
||||
|
||||
type Sink = ByteString.Lazy.ByteString -> IO ()
|
||||
|
||||
-- | Creates a new object using the provided value, writes the object to the
|
||||
-- sink, and returns a reference to that object.
|
||||
--
|
||||
-- For example if the passed value is a dictionary, the created object could be
|
||||
-- @
|
||||
-- 2 0 obj <<…>> endobj
|
||||
-- @
|
||||
-- where "2 0" identifies the object. The name (2) is generated using the state,
|
||||
-- the revision is always 0.
|
||||
writeObject :: Sink -> Type -> StateT (Int, XRefSection) IO Link
|
||||
writeObject sink object = do
|
||||
(previousLength, XRefSection refs) <- get
|
||||
let objectName = length refs
|
||||
objectContents <- liftIO $ objectToPdf $ Object objectName 0 object
|
||||
writtenLength <- liftIO $ sinkWithLength sink objectContents
|
||||
put (previousLength + writtenLength, XRefSection $ Vector.snoc refs (XRefEntry previousLength 0 True))
|
||||
pure $ Link objectName 0
|
||||
|
||||
-- | Gets the name of the object which will be generated next.
|
||||
nextName :: StateT (Int, XRefSection) IO Int
|
||||
nextName = gets (length . unXRefSection . snd)
|
||||
|
||||
-- | Writes the data into the sink and returns the number of the written bytes.
|
||||
sinkWithLength :: Sink -> ByteString.Builder -> IO Int
|
||||
sinkWithLength sink data' =
|
||||
let lazyData = ByteString.Builder.toLazyByteString data'
|
||||
in sink lazyData >> pure (fromIntegral $ ByteString.Lazy.length lazyData)
|
||||
@ -1,3 +1,7 @@
|
||||
{- 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 DataKinds #-}
|
||||
{-# LANGUAGE DuplicateRecordFields #-}
|
||||
{-# LANGUAGE ExplicitForAll #-}
|
||||
|
||||
@ -1,3 +1,7 @@
|
||||
{- 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 DuplicateRecordFields #-}
|
||||
|
||||
-- | Types representing a TrueType font.
|
||||
|
||||
@ -1,3 +1,7 @@
|
||||
{- 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/. -}
|
||||
|
||||
-- | Generic font types.
|
||||
module Graphics.Fountainhead.Type
|
||||
( F2Dot14(..)
|
||||
|
||||
Loading…
Reference in New Issue
Block a user