81 lines
2.6 KiB
Haskell
81 lines
2.6 KiB
Haskell
{-# LANGUAGE NamedFieldPuns #-}
|
|
module PDF.Layer (
|
|
Layer(..)
|
|
, unify
|
|
) where
|
|
|
|
import Data.Map (Map, (!), mapWithKey, member)
|
|
import qualified Data.Map as Map (empty, union)
|
|
import PDF.Object (
|
|
IndexedObjects, IndirectObjCoordinates(..), Occurrence(..)
|
|
, Structure(..), XRefEntry(..), XRefSection, eofMarker, outputBody
|
|
)
|
|
import qualified PDF.Output as Output (line)
|
|
import PDF.Output (
|
|
Offset, Output(..), Resource(..), byteString, getOffset, getOffsets, newLine
|
|
)
|
|
import Text.Printf (printf)
|
|
|
|
data Layer = Layer {
|
|
occurrences :: [Occurrence]
|
|
, objects :: IndexedObjects
|
|
, docStructure :: Structure
|
|
} deriving Show
|
|
|
|
updateXrefs :: XRefSection -> Map Resource Offset -> (XRefSection, Offset)
|
|
updateXrefs xRef offsets = (mapWithKey updateEntry xRef, offsets ! StartXRef)
|
|
where
|
|
updateEntry objectId e@(InUse {}) = e {offset = offsets ! (Object objectId)}
|
|
updateEntry _ e = e
|
|
|
|
instance Output Layer where
|
|
output (Layer {occurrences, objects, docStructure}) =
|
|
fmap (updateXrefs xRef) <$> getOffsets (outputBody (occurrences, objects))
|
|
>>= \(body, (xref, startXRef)) -> mconcat [
|
|
body
|
|
, Output.line "xref"
|
|
, output xref
|
|
, Output.line "trailer"
|
|
, output trailer, newLine
|
|
, Output.line "startxref"
|
|
, Output.line (printf "%d" (getOffset startXRef))
|
|
, byteString eofMarker
|
|
]
|
|
where
|
|
Structure {xRef, trailer} = docStructure
|
|
|
|
emptyLayer :: Layer
|
|
emptyLayer = Layer {
|
|
docStructure = Structure {xRef = Map.empty, trailer = Map.empty}
|
|
, objects = Map.empty
|
|
, occurrences = []
|
|
}
|
|
|
|
unify :: [Layer] -> Layer
|
|
unify = foldl complete emptyLayer
|
|
where
|
|
complete tmpLayer older =
|
|
let mergedObjects = Map.union (objects tmpLayer) (objects older) in
|
|
Layer {
|
|
docStructure =
|
|
unifyDocStructure (docStructure tmpLayer) (docStructure older)
|
|
, objects = mergedObjects
|
|
, occurrences =
|
|
unifyOccurrences mergedObjects (occurrences tmpLayer) (occurrences older)
|
|
}
|
|
|
|
unifyDocStructure :: Structure -> Structure -> Structure
|
|
unifyDocStructure new old = Structure {
|
|
xRef = Map.union (xRef new) (xRef old)
|
|
, trailer = Map.union (trailer new) (trailer old)
|
|
}
|
|
|
|
unifyOccurrences :: IndexedObjects -> [Occurrence] -> [Occurrence] -> [Occurrence]
|
|
unifyOccurrences objects new = foldr addOlder new
|
|
where
|
|
addOlder occurrence@(Comment _) existing = occurrence : existing
|
|
addOlder occurrence@(Indirect indirect) existing =
|
|
if objectId indirect `member` objects
|
|
then occurrence : existing
|
|
else existing
|