Tissevert
/
Hufflepdf
1
0
Fork 0
Code Issues Pull Requests Releases Wiki Activity

Implement Font retrieving for simple fonts with an /Encoding and no ToUnicode

This commit is contained in:
Tissevert 2020-02-05 22:15:18 +01:00
parent b5a15a692b
commit 5fa32e35db
3 changed files with 25 additions and 8 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

1
Hufflepdf.cabal
View File

@ -26,6 +26,7 @@ library
, PDF.Text , PDF.Text
, PDF.Update , PDF.Update
other-modules: Data.ByteString.Char8.Util other-modules: Data.ByteString.Char8.Util
, PDF.Encoding
, PDF.Encoding.MacRoman , PDF.Encoding.MacRoman
, PDF.Body , PDF.Body
, PDF.Font , PDF.Font

10
src/PDF/Encoding.hs Normal file
View File

@ -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

22
src/PDF/Pages.hs
View File

@ -6,6 +6,7 @@ module PDF.Pages (
) where ) where
import Codec.Compression.Zlib (decompress) import Codec.Compression.Zlib (decompress)
import Control.Applicative ((<|>))
import Control.Monad (foldM) import Control.Monad (foldM)
import Control.Monad.RWS (RWST(..), ask, evalRWST, mapRWST, modify) import Control.Monad.RWS (RWST(..), ask, evalRWST, mapRWST, modify)
import qualified Control.Monad.RWS as RWS (get) 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 Data.Map (Map, (!))
import qualified Data.Map as Map (empty, fromList, insert, lookup, toList) import qualified Data.Map as Map (empty, fromList, insert, lookup, toList)
import PDF.CMap (cMap) import PDF.CMap (cMap)
import PDF.Encoding.MacRoman (macRomanEncoding) import PDF.Encoding (encoding)
import PDF.Font (Font, FontSet) import PDF.Font (Font, FontSet)
import PDF.Object ( import PDF.Object (
Content(..), Dictionary, DirectObject(..), IndirectObjCoordinates(..) Content(..), Dictionary, DirectObject(..), IndirectObjCoordinates(..)
@ -78,13 +79,18 @@ cache loader objectId =
return value return value
loadFont :: ObjectId -> T Font loadFont :: ObjectId -> T Font
loadFont objectId = loadFont objectId = getObject objectId \\= dict >>= tryMappings
getObject objectId where
\\= dict tryMappings dictionary =
\\= key "ToUnicode" loadCMap dictionary
>>= follow <|> lift (key "Encoding" dictionary >>= loadEncoding)
\\= stream <|> lift (Left $ unknownFormat (show objectId) (show dictionary))
\\= cMap 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 :: Dictionary -> T FontSet
loadFonts = foldM addFont Map.empty . Map.toList loadFonts = foldM addFont Map.empty . Map.toList