diff --git a/Hufflepdf.cabal b/Hufflepdf.cabal index 3a1cb5d..d12c6b4 100644 --- a/Hufflepdf.cabal +++ b/Hufflepdf.cabal @@ -26,6 +26,7 @@ library , PDF.Text , PDF.Update other-modules: Data.ByteString.Char8.Util + , PDF.Encoding , PDF.Encoding.MacRoman , PDF.Body , PDF.Font diff --git a/src/PDF/Encoding.hs b/src/PDF/Encoding.hs new file mode 100644 index 0000000..f0c0a31 --- /dev/null +++ b/src/PDF/Encoding.hs @@ -0,0 +1,10 @@ +module PDF.Encoding ( + encoding + ) where + +import PDF.Encoding.MacRoman (macRomanEncoding) +import PDF.Font (Font) + +encoding :: String -> Either String Font +encoding "MacRomanEncoding" = Right macRomanEncoding +encoding s = Left $ "Unknown encoding " ++ s diff --git a/src/PDF/Pages.hs b/src/PDF/Pages.hs index 45dc5a9..e4af7df 100755 --- a/src/PDF/Pages.hs +++ b/src/PDF/Pages.hs @@ -6,6 +6,7 @@ module PDF.Pages ( ) where import Codec.Compression.Zlib (decompress) +import Control.Applicative ((<|>)) import Control.Monad (foldM) import Control.Monad.RWS (RWST(..), ask, evalRWST, mapRWST, modify) import qualified Control.Monad.RWS as RWS (get) @@ -14,7 +15,7 @@ import qualified Data.ByteString.Lazy as Lazy (fromStrict, toStrict) import Data.Map (Map, (!)) import qualified Data.Map as Map (empty, fromList, insert, lookup, toList) import PDF.CMap (cMap) -import PDF.Encoding.MacRoman (macRomanEncoding) +import PDF.Encoding (encoding) import PDF.Font (Font, FontSet) import PDF.Object ( Content(..), Dictionary, DirectObject(..), IndirectObjCoordinates(..) @@ -78,13 +79,18 @@ cache loader objectId = return value loadFont :: ObjectId -> T Font -loadFont objectId = - getObject objectId - \\= dict - \\= key "ToUnicode" - >>= follow - \\= stream - \\= cMap +loadFont objectId = getObject objectId \\= dict >>= tryMappings + where + tryMappings dictionary = + loadCMap dictionary + <|> lift (key "Encoding" dictionary >>= loadEncoding) + <|> lift (Left $ unknownFormat (show objectId) (show dictionary)) + unknownFormat = printf "Unknown font format for object #%s : %s" + loadCMap dictionary = + key "ToUnicode" dictionary //= follow \\= stream \\= cMap + loadEncoding (NameObject (Name name)) = encoding name + loadEncoding directObject = + Left . printf "Encoding must be a name, not that : %s" $ show directObject loadFonts :: Dictionary -> T FontSet loadFonts = foldM addFont Map.empty . Map.toList