summaryrefslogtreecommitdiff
path: root/src/Graphics/Fountainhead/PDF.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Graphics/Fountainhead/PDF.hs')
-rw-r--r--src/Graphics/Fountainhead/PDF.hs316
1 files changed, 0 insertions, 316 deletions
diff --git a/src/Graphics/Fountainhead/PDF.hs b/src/Graphics/Fountainhead/PDF.hs
deleted file mode 100644
index 1ed42fc..0000000
--- a/src/Graphics/Fountainhead/PDF.hs
+++ /dev/null
@@ -1,316 +0,0 @@
-{- 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)
generated by cgit v1.2.3 (git 2.26.2) at 2026-06-26 19:29:21 +0000