hpdft 0.1.0.6 → 0.1.1.1

raw patch · 15 files changed

+1323/−391 lines, 15 filesdep +regex-basedep +regex-compat-tdfaPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: regex-base, regex-compat-tdfa

API changes (from Hackage documentation)

Files

• README.md +7/−4
• data/sample/Sample.hs +0/−196
• hpdft.cabal +10/−3
• hpdft.hs +93/−11
• src/PDF/CFF.hs +453/−0
• src/PDF/Character.hs +135/−0
• src/PDF/Cmap.hs +13/−4
• src/PDF/ContentStream.hs +94/−30
• src/PDF/Definition.hs +4/−4
• src/PDF/DocumentStructure.hs +183/−94
• src/PDF/Object.hs +38/−32
• src/PDF/OpenType.hs +191/−0
• src/PDF/Outlines.hs +14/−5
• src/PDF/PDFIO.hs +27/−8
• src/PDF/Type1.hs +61/−0

@@ -5,22 +5,25 @@ Command usage:   ```-hpdft [-p|--page PAGE] [-r|--ref REF] [-R|--refs] [-T|--title]-             [-I|--info] [-O|--toc] FILE+hpdft [-p|--page PAGE] [-r|--ref REF] [-g|--grep RegExp] [-R|--refs]+             [-T|--title] [-I|--info] [-O|--toc] [--trailer] FILE  Available options:-  -p,--page PAGE           Page number+  -p,--page PAGE           Page number (nomble)   -r,--ref REF             Object reference+  -g,--grep RegExp         grep PDF   -R,--refs                Show object references in page order   -T,--title               Show title (from metadata)   -I,--info                Show PDF metainfo   -O,--toc                 Show table of contents (from metadata)-  --trailer                Show trailer object+  --trailer                Show the trailer of PDF   FILE                     input pdf file   -h,--help                Show this help text ```  ## install++Clone this repository and do cabal-install.  ``` $ cabal install

@@ -1,196 +0,0 @@-{-# LANGUAGE OverloadedStrings #-}--module Main where--import PDF.Definition--import PDF.Object-import PDF.PDFIO-import PDF.Outlines--import Data.ByteString.UTF8 (ByteString)-import qualified Data.ByteString.Char8 as BS-import qualified Data.ByteString.Lazy.Char8 as BSL-import Data.List (nub)--import Debug.Trace--initstate = PSR { linex=0-                , liney=0-                , absolutex=0-                , absolutey=0-                , leftmargin=0.0-                , top=0.0-                , bottom=0.0-                , fontfactor=1-                , curfont=""-                , fontmaps=[]-                , cmaps=[]-                , colorspace=""-                , xcolorspaces=[]-                , text_lm = (0,0,0,0,0,0)-                , text_m = (0,0,0,0,0,0)-                , text_break=True-                }----- | Show bare data in 'ref'ed-object.--objectByRef filename ref = getObjectByRef ref (getPDFObjFromFile filename)---- | Show contents of page 'page' in 'filename'.--showPage filename page = do -  pagetree <- refByPage filename-  contentByRef filename $ pagetree !! (page - 1)-  --- | Show /Content referenced from the 'ref'ed-object in 'filename'.--contentByRef filename ref = do-  objs <- getPDFObjFromFile filename-  obj <- objectByRef filename ref-  BSL.putStrLn $ contentOfObject obj objs-  where contentOfObject obj objs =-          case findDictOfType "/Page" obj of-            Just dict -> contentsStream dict initstate objs-            Nothing -> ""---- | Show raw bytestring stream (without deflated) of page 'page' in 'filename'.--showRawPage filename page = do-  pagetree <- refByPage filename-  rawContentByRef filename $ pagetree !! (page - 1)---- | Show raw bytestring stream (without deflated) of 'ref'ed-object.--streamByRef filename ref = do-  obj <- getObjectByRef ref (getPDFObjFromFile filename) -  return $ rawStream obj---- | Show raw bytestring stream (without deflated) in a /Content referenced from the 'ref'ed-object in 'filename'.--rawContentByRef filename ref = do-  objs <- getPDFObjFromFile filename-  obj <- objectByRef filename ref-  BSL.putStrLn $ rawContentOfObject obj objs-  where rawContentOfObject obj objs =-          case findDictOfType "/Page" obj of-            Just dict -> rawContentsStream dict objs-            Nothing -> ""---- | Show CMap information in object 'ref' in 'filename'.--cmapStreamByRef filename ref = do-  objs <- getPDFObjFromFile filename-  return $ toUnicode ref objs-----data  PageTree = Nop | Page Int | Pages [PageTree]-                 deriving Show---- | Sort object references in page order.--refByPage filename = do-  root <- getRootRef filename-  objs <- getPDFObjFromFile filename-  return $  pageTreeToList $ pageorder root objs--pageorder :: Int -> [PDFObj] -> PageTree-pageorder parent objs = -  case findObjsByRef parent objs of-    Just os -> case findDictOfType "/Catalog" os of-      Just dict -> case pages dict of -        Just pr -> pageorder pr objs-        Nothing -> Nop-      Nothing -> case findDictOfType "/Pages" os of-        Just dict -> case pagesKids dict of-          Just kidsrefs -> Pages $ map (\f -> f objs) (map pageorder kidsrefs)-          Nothing -> Nop-        Nothing -> case findDictOfType "/Page" os of-          Just dict -> Page parent-          Nothing -> Nop-    Nothing -> Nop--pageTreeToList :: PageTree -> [Int]-pageTreeToList (Pages ps) = concatMap pageTreeToList ps-pageTreeToList (Page n) = [n]-pageTreeToList Nop = []----- | Get a whole text from 'filename'. It works as:---    (1) grub objects---    (2) parse within each object, deflating its stream---    (3) linearize stream--pdfToText filename = do-  contents <- BS.readFile filename-  let objs = map parsePDFObj $ getObjs contents-  let rootref = case rootRef contents of-                  Just r  -> r-                  Nothing -> 0-  putStrLn $ show $ linearize rootref objs--linearize :: Int -> [PDFObj] -> PDFStream-linearize parent objs = -  case findObjsByRef parent objs of-    Just os -> case findDictOfType "/Catalog" os of-      Just dict -> case pages dict of -        Just pr -> linearize pr objs-        Nothing -> ""-      Nothing -> case findDictOfType "/Pages" os of-        Just dict -> case pagesKids dict of-          Just kidsrefs -> BSL.concat $ map (\f -> f objs) (map linearize kidsrefs)-          Nothing -> ""-        Nothing -> case findDictOfType "/Page" os of-          Just dict -> contentsStream dict initstate objs-          Nothing -> ""-    Nothing -> ""----- | Show /Title from meta information in 'filename'--showTitle filename = do-  d <- getInfo filename-  let title = -        case findObjThroughDict d "/Title" of-          Just (PdfText s) -> s-          Just x -> show x-          Nothing -> error "No title anyway"-  putStrLn title-  return ()---- | Show /Info from meta information in 'filename'--showInfo filename = do-  d <- getInfo filename-  putStrLn $ toString 0 (PdfDict d)-  return ()---- | Show /Outlines from meta information in 'filename'--showOutlines filename = do-  d <- getOutlines filename-  putStrLn $ show d-  return ()----- | Show device color spaces of each page.--contentColorSpaceByRef filename ref = do-  objs <- getPDFObjFromFile filename-  obj <- objectByRef filename ref-  putStrLn $ show $ filter (/="") $ nub $ csOfObject obj objs-  where csOfObject obj objs =-          case findDictOfType "/Page" obj of-            Just dict -> contentsColorSpace dict initstate objs-            Nothing -> error "Seems to be no color space in content stream"---- | Show device color spaces of all pages.--showColorSpaces filename = do-  pages <- refByPage filename-  pagescs <- mapM (contentColorSpaceByRef filename) pages-  mapM (putStrLn . show) $ zip [1..] pagescs-  return ()

@@ -1,5 +1,6 @@+cabal-version:       3.0 name:                hpdft-version:             0.1.0.6+version:             0.1.1.1 synopsis:            A tool for looking through PDF file using Haskell -- description:          homepage:            https://github.com/k16shikano/hpdft@@ -11,12 +12,10 @@ category:            PDF build-type:          Simple extra-source-files:  README.md-cabal-version:       >=1.10  data-dir:            data/  data-files:          map/Adobe-Japan1-6.map-data-files:          sample/Sample.hs                          library@@ -29,6 +28,9 @@                      , PDF.DocumentStructure                      , PDF.Outlines                      , PDF.Object+                     , PDF.OpenType+                     , PDF.CFF+                     , PDF.Type1   other-modules:       Paths_hpdft   other-extensions:    OverloadedStrings   build-depends:       attoparsec >=0.13.0@@ -41,6 +43,7 @@                      , memory >= 0.14.5                      , optparse-applicative                      , parsec >=3.0 && <3.2+                     , regex-compat-tdfa >= 0.95.1.4                      , semigroups                      , text >=0.11                      , utf8-string >=0.3@@ -59,7 +62,11 @@                      , hpdft                      , memory >= 0.14.5                      , optparse-applicative+                     , regex-base >= 0.94.0.2+                     , regex-compat-tdfa >= 0.95.1.4+                     , regex-compat-tdfa >= 0.95.1.4                      , semigroups+                     , text >=0.11                      , utf8-string >=0.3   default-language:    Haskell2010   buildable:         True

@@ -1,3 +1,5 @@+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE PackageImports #-} {-# LANGUAGE OverloadedStrings #-}  module Main where@@ -14,12 +16,19 @@ import Data.ByteString.UTF8 (ByteString) import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy.Char8 as BSL-import Data.List (nub)+import Data.Text.Lazy as TL (unpack)+import Data.Text.Lazy.Encoding as TL+import Data.List (nub, find) import Data.Maybe (fromMaybe)  import Options.Applicative import Data.Semigroup ((<>)) +import "regex-compat-tdfa" Text.Regex as R+import Options.Applicative (strOption)+import Control.Monad (when)+import PDF.Definition (Obj(PdfStream))+ import Debug.Trace  initstate = PSR { linex=0@@ -54,6 +63,7 @@ data CmdOpt = CmdOpt {   page :: Int,   ref  :: Int,+  grep :: String,   refs :: Bool,   pdftitle :: Bool,   pdfinfo :: Bool,@@ -76,6 +86,12 @@             <> value 0             <> metavar "REF"             <> help "Object reference" )+          <*> strOption+          ( long "grep"+            <> short 'g'+            <> value ""+            <> metavar "RegExp"+            <> help "grep PDF" )           <*> switch           ( long "refs"             <> short 'R'@@ -101,14 +117,15 @@             <> action "file" )  hpdft :: CmdOpt -> IO ()-hpdft (CmdOpt 0 0 False False False False False fn) = pdfToText fn  -hpdft (CmdOpt 0 0 False True _ _ _ fn) = showTitle fn-hpdft (CmdOpt 0 0 False _ True _ _ fn) = showInfo fn-hpdft (CmdOpt 0 0 False _ _ True _ fn) = showOutlines fn-hpdft (CmdOpt 0 0 False _ _ _ True fn) = print =<< getTrailer fn-hpdft (CmdOpt 0 0 True _ _ _ _ fn) = print =<< refByPage fn-hpdft (CmdOpt n 0 False _ _ _ _ fn) = showPage fn n-hpdft (CmdOpt 0 r False _ _ _ _ fn) = print =<< getObjectByRef r =<< getPDFObjFromFile fn+hpdft (CmdOpt 0 0 "" False False False False False fn) = pdfToText fn  +hpdft (CmdOpt 0 0 "" False True _ _ _ fn) = showTitle fn+hpdft (CmdOpt 0 0 "" False _ True _ _ fn) = showInfo fn+hpdft (CmdOpt 0 0 "" False _ _ True _ fn) = showOutlines fn+hpdft (CmdOpt 0 0 "" False _ _ _ True fn) = print =<< getTrailer fn+hpdft (CmdOpt 0 0 "" True _ _ _ _ fn) = print =<< refByPage fn+hpdft (CmdOpt n 0 "" False _ _ _ _ fn) = showPage fn n+hpdft (CmdOpt 0 r "" False _ _ _ _ fn) = showContent fn r+hpdft (CmdOpt 0 0 r  False _ _ _ _ fn) = grepPDF fn r hpdft _ = return ()  -- | Get a whole text from 'filename'. It works as:@@ -172,7 +189,9 @@  showPage filename page = do    pagetree <- refByPage filename-  contentByRef filename $ pagetree !! (page - 1)+  case length pagetree >= page of+    True -> contentByRef filename $ pagetree !! (page - 1)+    False -> putStrLn $ "hpdft: No Page "++(show page)  -- | Show /Content referenced from the 'ref'ed-object in 'filename'. @@ -185,12 +204,39 @@             Just dict -> contentsStream dict initstate objs             Nothing -> "" +showContent filename ref = do+  objs <- getPDFObjFromFile filename+  obj <- getObjectByRef ref objs+  let d = fromMaybe [] $ findDict obj+  if hasStream obj+    then+      if hasSubtype d -- then it's not content stream+        then printStreamWithDict d obj+        else BSL.putStrLn =<< getStream False obj+    else print =<< getObjectByRef ref objs+  where++    hasStream obj = case find isStream obj of+      Just _ -> True+      Nothing -> False+    isStream (PdfStream _) = True+    isStream _             = False++    hasSubtype d = case find isSubtype d of+                       Just _ -> True+                       Nothing -> False+    isSubtype (PdfName "/Subtype", _) = True+    isSubtype x = False++    printStreamWithDict :: Dict -> [Obj] -> IO ()+    printStreamWithDict d obj = print (PdfDict d) >> (BSL.putStrLn =<< getStream True obj)+ -- | Show /Title from meta information in 'filename'  showTitle filename = do   d <- getInfo filename   let title = -        case findObjThroughDict d "/Title" of+        case findObjFromDict d "/Title" of           Just (PdfText s) -> s           Just x -> show x           Nothing -> "No title anyway"@@ -210,4 +256,40 @@   d <- getOutlines filename   putStrLn $ show d   return ()++-- | Find string in each page.++grepPDF filename re = do+  root <- getRootRef filename+  objs <- getPDFObjFromFile filename+  mapM+    (\(strm, pagenm) -> (grepByPage pagenm re . contentInObjs objs) strm)+    $ zip (pageTreeToList $ pageorder root objs) [1..]+  return ()   +  where+    contentInObjs objs ref =+      case findObjsByRef ref objs of+        Just obj -> case findDictOfType "/Page" obj of+                      Just dict -> contentsStream dict initstate objs+                      Nothing -> ""+        Nothing -> error $ "No Object with Ref " ++ show ref++    grepByPage :: Int -> String -> PDFStream -> IO ()+    grepByPage pagenm re txt = do+      let matched = filter (not . null) $ map (grepByLine re) $ BSL.lines txt+      when (not $ null matched) (showResult pagenm matched)+      return ()+      where+        showResult p m = do+          putStrLn $ "At page " <> show p <> "..."+          mapM (putStrLn . (" | " <>)) m+          return ()++    grepByLine :: String -> PDFStream -> String+    grepByLine re txt =+      case matchRegexAll (mkRegex re) $ TL.unpack $ TL.decodeUtf8 txt of+        Just (b, m, a, _) -> (b <> (highlight m) <> a)+        Nothing -> ""++    highlight m = "\ESC[31m" <> m <> "\ESC[0m"

@@ -0,0 +1,453 @@+{-# LANGUAGE OverloadedStrings #-}++module PDF.CFF (encoding) where++import Numeric (readInt)+import Data.Char (chr, intToDigit)+import Data.List (isPrefixOf)++import Data.Word+import Data.Bits++import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BSC+import qualified Data.ByteString.Lazy as BSL++import Data.Attoparsec.ByteString (Parser, parseOnly, word8, string)+import qualified Data.Attoparsec.ByteString as AP+import Data.Attoparsec.Combinator++import Control.Applicative++import Debug.Trace++import PDF.Definition++type SID = Integer++test f = do+  c <- BS.readFile f+  return $ encoding c++encoding :: ByteString -> Encoding+encoding c =+  Encoding $ map findEncodings $ zip charset encodings++  where+    ds = parseTopDictInd c+    encodings  = concatMap (parseEncoding c) ds+    charset = concatMap (parseCharset c) ds+    fontname = concat $ map (parseFontname c) ds+    strings = case parseOnly stringInd c of+                Right arr -> arr+                Left e -> error "Failed to parse STRING Index"++    findEncodings :: (SID, Char) -> (Char, String)+    findEncodings (char,enc) =+      case char of+        s | s > 390 -> (enc, stringToText $ strings !! fromInteger (char - 390 - 1))+          | s > 95 -> (enc, sidToText s)+          | otherwise -> (enc, [enc])++    -- defined in String INDEX of each font+    stringToText "a113" = "‡"+    stringToText "a114" = "・"+    stringToText "trianglesolid" = "▲"+    stringToText x = "[CFF:String " <> x <> "]"++    -- pre-defined in Appendix C of CFF specs+    sidToText n = [complementSID 0 predefinedChars !! fromInteger n]++parseTopDictInd :: ByteString -> [ByteString]+parseTopDictInd c = case parseOnly (header >> index *> index) c of+  Right ds -> ds+  Left e -> error "Can not find Top DICT INDEX"++parseEncoding :: ByteString -> ByteString -> [Char]+parseEncoding c d = case parseOnly (many1 dict) d of+  -- '16' is key for 'Encoding' in Top DICT+  Right dictData -> case lookup [16] dictData of +    Just (DictInt 0:[]) -> []  +    Just (DictInt 1:[]) -> [] -- Expert Encoding (not supported)+    Just (DictInt n:[]) -> -- n is offset+      case parseOnly encodingArray $ BS.drop n c of+        Right arr -> map (chr . fromInteger) arr+        Left e -> error "Failed to parse Encoding Array"+    Just a -> error (show a)+    Nothing -> error $ "No Encodind Array in " ++ show dictData+  Left _ -> error "Failed to parse Top DICT in CFF"++parseFontname c d = case parseOnly (many1 dict) d of+  Right dictData -> case lookup [2] dictData of+    Just (DictInt n:[]) ->+      case parseOnly stringInd c of+        Right arr -> arr !! (n - 390 - 1) -- 390 seems to be a magic number+        Left e -> error "Failed to parse Fontname"+    Just a -> error (show a)+    Nothing -> error $ "No Fontname in " <> show dictData+  Left _ -> error "Failed to parse Top DICT in CFF"++parseCharset c d = case parseOnly (many1 dict) d of+  Right dictData -> case lookup [15] dictData of+    Just (DictInt offset:[]) -> +      case parseOnly (charsetData $ charStringsInd c dictData) $+           BS.drop offset c of+        Right arr -> arr+        Left _ -> error ""+    Just a -> error (show a)+    Nothing -> error $ "No Charset in " <> show dictData+  Left _ -> error "Failed to parse Top DICT in CFF"++charStringsInd c dictData = +  case lookup [17] dictData of+    Just (DictInt offset:[]) -> +      case parseOnly index (BS.drop offset c) of+        Right [] -> error "failed to get CharStrings"+        Right ind -> ind+        Left "" -> error "failed to get CharStrings"+    Nothing -> error $ "No CharStrings in " <> show dictData++nameInd = map BSC.unpack <$> (header *> index)++dictInd = BSC.concat <$> (header >> index *> index)++stringInd = map BSC.unpack <$> (header >> index >> index *> index)++charsetData :: [ByteString] -> Parser [Integer]+charsetData ind = do+  format <- getCard 1+  charsetObj format+  +  where+    -- .notdef must be excluded, so minus one+    charsetObj 0 = count (length ind - 1) getSID +++encodingArray :: Parser [Integer]+encodingArray = do+  format <- getCard 1+  p <- fromInteger <$> getCard 1+  encodeObj format p++  where+    encodeObj :: Integer -> Int -> Parser [Integer]+    encodeObj 0 p = count (p - 1) (getCard 1)+    encodeObj 1 p = concat <$> count p getRange1+    encodeObj _ p = error "CFF Supplement Format is not supported."++    getRange1 :: Parser [Integer]+    getRange1 = do+      first <- getCard 1+      nleft <- getCard 1+      return $ [first .. first + nleft]++data DictOp = DictInt Int | DictReal Double+  deriving (Show)++dict = (flip (,)) <$> (manyTill dictOp (try $ lookAhead dictKey)) <*> dictKey++dictOp :: Parser DictOp+dictOp = do+  b0 <- fromInteger <$> getCard 1+  opEnc b0+  +  where+    opEnc :: Int -> Parser DictOp+    opEnc b0 | b0 >= 32 && b0 <= 246 = return $ DictInt $ b0 - 139+             | b0 >= 247 && b0 <= 250 = do+                 b1 <- fromInteger <$> getCard 1+                 return $ DictInt $ (b0 - 247) * 256 + b1 + 108+             | b0 >= 251 && b0 <= 254 = do+                 b1 <- fromInteger <$> getCard 1+                 return $ DictInt $ - (b0 - 251) * 256 - b1 - 108+             | b0 == 28 = do+                 b1 <- fromInteger <$> getCard 1+                 b2 <- fromInteger <$> getCard 1+                 return $ DictInt $ b1 `shiftL` 8 .|. b2+             | b0 == 29 = do+                 b1 <- fromInteger <$> getCard 1+                 b2 <- fromInteger <$> getCard 1+                 b3 <- fromInteger <$> getCard 1+                 b4 <- fromInteger <$> getCard 1+                 return $ DictInt $  b1 `shiftL` 24 .|. b2 `shiftL` 16 .|. b3 `shiftL` 8 .|. b4+             | b0 == 30 = do+                 r <- many1 $ AP.satisfy (\w -> (240 .|. w) `xor` 255 /= 0)+                 f <- getCard 1+                 return $ DictReal $ readNibble r f+             | otherwise = error (show b0)+    readNibble s1 s2 = 0++dictKey :: Parser [Word8]+dictKey = do+  key <- AP.choice [ try $ many1 $ AP.satisfy $ AP.inClass "\0-\5\13-\18"+                   , try $ (flip (flip (:) . (:[])))+                     <$> AP.satisfy (==12) <*> (AP.satisfy $ AP.inClass "\0-\8\20-\23\30-\38")+                   ]+  return key++index :: Parser [ByteString]+index = do+  indexCount <- fromInteger <$> getCard 2+  offSize <- fromInteger <$> getCard 1+  offsets <- map fromInteger <$> count (indexCount+1) (getCard offSize)+  indexData <- repeatFor offsets+  return indexData+  where+    repeatFor ls = sequence $ map AP.take $ differenciate ls+    differenciate ls = tail $ zipWith subtract (0:ls) ls++header :: Parser Integer+header = do+  major <- getCard 1+  minor <- getCard 1+  hrdSize <- getCard 1+  offSize <- getCard 1+  return $ major++getCard :: Int -> Parser Integer+getCard n = fromBytes <$> AP.take n++getSID :: Parser SID+getSID = fromBytes <$> AP.take 2++fromBytes :: ByteString -> Integer+fromBytes = BS.foldl' f 0+  where+    f a b = a `shiftL` 8 .|. fromIntegral b++complementSID _ [] = []+complementSID i arr@((n,c):rest) +  | i == n = c:(complementSID (i+1) rest)+  | otherwise = ' ':(complementSID (i+1) arr)++predefinedChars = +  [ (1, ' ')+  , (2, '!')+  , (3, '"')+  , (4, '#')+  , (5, '$')+  , (6, '%')+  , (7, '&')+  , (8, '’')+  , (9, '(')+  , (10, ')')+  , (11, '*')+  , (12, '+')+  , (13, ',')+  , (14, '-')+  , (15, '.')+  , (16, '/')+  , (17, '0')+  , (18, '1')+  , (19, '2')+  , (20, '3')+  , (21, '4')+  , (22, '5')+  , (23, '6')+  , (24, '7')+  , (25, '8')+  , (26, '9')+  , (27, ':')+  , (28, ';')+  , (29, '<')+  , (30, '=')+  , (31, '>')+  , (32, '?')+  , (33, '@')+  , (34, 'A')+  , (35, 'B')+  , (36, 'C')+  , (37, 'D')+  , (38, 'E')+  , (39, 'F')+  , (40, 'G')+  , (41, 'H')+  , (42, 'I')+  , (43, 'J')+  , (44, 'K')+  , (45, 'L')+  , (46, 'M')+  , (47, 'N')+  , (48, 'O')+  , (49, 'P')+  , (50, 'Q')+  , (51, 'R')+  , (52, 'S')+  , (53, 'T')+  , (54, 'U')+  , (55, 'V')+  , (56, 'W')+  , (57, 'X')+  , (58, 'Y')+  , (59, 'Z')+  , (60, '{')+  , (61, '/')+  , (62, '}')+  , (63, '^')+  , (64, '_')+  , (65, '‘')+  , (66, 'a')+  , (67, 'b')+  , (68, 'c')+  , (69, 'd')+  , (70, 'e')+  , (71, 'f')+  , (72, 'g')+  , (73, 'h')+  , (74, 'i')+  , (75, 'j')+  , (76, 'k')+  , (77, 'l')+  , (78, 'm')+  , (79, 'n')+  , (80, 'o')+  , (81, 'p')+  , (82, 'q')+  , (83, 'r')+  , (84, 's')+  , (85, 't')+  , (86, 'u')+  , (87, 'v')+  , (88, 'w')+  , (89, 'x')+  , (90, 'y')+  , (91, 'z')+  , (92, '[')+  , (93, 'ˉ')+  , (94, ']')+  , (95, '~')+  , (96, '¡')+  , (97, '¢')+  , (98, '£')+  , (99, '/')+  , (100, '¥')+  , (101, 'ƒ')+  , (102, '§')+  , (103, '$')+  , (104, '\'')+  , (105, '“')+  , (106, '«')+  , (107, '‹')+  , (108, '›')+  , (109, 'fi')+  , (110, 'fl')+  , (111, '–')+  , (112, '†')+  , (113, '‡')+  , (114, '·')+  , (115, '❡')+  , (116, '・')+  , (117, '‚')+  , (118, '„')+  , (119, '”')+  , (120, '»')+  , (121, '…')+  , (122, '‰')+  , (123, '¿')+  , (124, '`')+  , (125, '´')+  , (126, '^')+  , (127, '~')+  , (128, '¯')+  , (129, '˘')+  , (130, '˙')+  , (131, '¨')+  , (132, '°')+  , (133, '¸')+  , (134, '˝')+  , (135, '˛')+  , (136, 'ˇ')+  , (137, '—')+  , (138, 'Æ')+  , (139, 'ª')+  , (140, 'Ł')+  , (141, 'Ø')+  , (142, 'Œ')+  , (143, 'º')+  , (144, 'æ')+  , (145, 'ı')+  , (146, 'ł')+  , (147, 'ø')+  , (148, 'œ')+  , (149, 'ẞ')+  , (150, '¹')+  , (151, '￢')+  , (152, 'µ')+  , (153, '™')+  , (154, 'Ð')+  , (155, '½')+  , (156, '±')+  , (157, 'Þ')+  , (158, '¼')+  , (159, '÷')+  , (160, '¦')+  , (161, '°')+  , (162, 'þ')+  , (163, '¾')+  , (164, '²')+  , (165, '®')+  , (166, '－')+  , (167, 'ð')+  , (168, '×')+  , (169, '³')+  , (170, 'Ⓒ')+  , (171, 'Á')+  , (172, 'Â')+  , (173, 'Ä')+  , (174, 'À')+  , (175, 'Å')+  , (176, 'Ã')+  , (177, 'Ç')+  , (178, 'É')+  , (179, 'Ê')+  , (180, 'Ë')+  , (181, 'È')+  , (182, 'Í')+  , (183, 'Î')+  , (184, 'Ï')+  , (185, 'Ì')+  , (186, 'Ñ')+  , (187, 'Ó')+  , (188, 'Ô')+  , (189, 'Ö')+  , (190, 'Ò')+  , (191, 'Õ')+  , (192, 'Š')+  , (193, 'Ú')+  , (194, 'Û')+  , (195, 'Ü')+  , (196, 'Ù')+  , (197, 'Ý')+  , (198, 'Ÿ')+  , (199, 'Ž')+  , (200, 'á')+  , (201, 'â')+  , (202, 'ä')+  , (203, 'à')+  , (204, 'å')+  , (205, 'ã')+  , (206, 'ç')+  , (207, 'é')+  , (208, 'ê')+  , (209, 'ë')+  , (210, 'è')+  , (211, 'í')+  , (212, 'î')+  , (213, 'ï')+  , (214, 'ì')+  , (215, 'ñ')+  , (216, 'ó')+  , (217, 'ô')+  , (218, 'ö')+  , (219, 'ò')+  , (220, 'õ')+  , (221, 'š')+  , (222, 'ú')+  , (223, 'û')+  , (224, 'ü')+  , (225, 'ù')+  , (226, 'ý')+  , (227, 'ÿ')+  , (228, 'ž')+  ]

@@ -3,6 +3,7 @@  module PDF.Character        ( pdfcharmap+       , extendedAscii        , adobeJapanOneSixMap) where  import qualified Data.Text as T@@ -15,8 +16,142 @@  pdfcharmap = Map.fromList pdfchardict  +extendedAscii = Map.fromList extendedasciidict+ adobeJapanOneSixMap :: Map.Map Int BSLU.ByteString adobeJapanOneSixMap = decode . decompress . BSL.fromChunks . (:[]) $ $(embedFile "data/map/Adobe-Japan1-6.map")++extendedasciidict :: [(Int, Char)]+extendedasciidict =+  [ (128, '€')+  , (129, ' ')+  , (130, '‚')+  , (131, 'ƒ')+  , (132, '„')+  , (133, '…')+  , (134, '†')+  , (135, '‡')+  , (136, 'ˆ')+  , (137, '‰')+  , (138, 'Š')+  , (139, '‹')+  , (140, 'Œ')+  , (141, ' ')+  , (142, 'Ž')+  , (143, ' ')+  , (144, ' ')+  , (145, '‘')+  , (146, '’')+  , (147, '“')+  , (148, '”')+  , (149, '•')+  , (150, '–')+  , (151, '—')+  , (152, '˜')+  , (153, '™')+  , (154, 'š')+  , (155, '›')+  , (156, 'œ')+  , (157, ' ')+  , (158, 'ž')+  , (159, 'Ÿ')+  , (160, ' ')+  , (161, '¡')+  , (162, '¢')+  , (163, '£')+  , (164, '¤')+  , (165, '¥')+  , (166, '¦')+  , (167, '§')+  , (168, '¨')+  , (169, '©')+  , (170, 'ª')+  , (171, '«')+  , (172, '¬')+  , (173, '-')+  , (174, '®')+  , (175, '¯')+  , (176, '°')+  , (177, '±')+  , (178, '²')+  , (179, '³')+  , (180, '´')+  , (181, 'µ')+  , (182, '¶')+  , (183, '·')+  , (184, '¸')+  , (185, '¹')+  , (186, 'º')+  , (187, '»')+  , (188, '¼')+  , (189, '½')+  , (190, '¾')+  , (191, '¿')+  , (192, 'À')+  , (193, 'Á')+  , (194, 'Â')+  , (195, 'Ã')+  , (196, 'Ä')+  , (197, 'Å')+  , (198, 'Æ')+  , (199, 'Ç')+  , (200, 'È')+  , (201, 'É')+  , (202, 'Ê')+  , (203, 'Ë')+  , (204, 'Ì')+  , (205, 'Í')+  , (206, 'Î')+  , (207, 'Ï')+  , (208, 'Ð')+  , (209, 'Ñ')+  , (210, 'Ò')+  , (211, 'Ó')+  , (212, 'Ô')+  , (213, 'Õ')+  , (214, 'Ö')+  , (215, '×')+  , (216, 'Ø')+  , (217, 'Ù')+  , (218, 'Ú')+  , (219, 'Û')+  , (220, 'Ü')+  , (221, 'Ý')+  , (222, 'Þ')+  , (223, 'ß')+  , (224, 'à')+  , (225, 'á')+  , (226, 'â')+  , (227, 'ã')+  , (228, 'ä')+  , (229, 'å')+  , (230, 'æ')+  , (231, 'ç')+  , (232, 'è')+  , (233, 'é')+  , (234, 'ê')+  , (235, 'ë')+  , (236, 'ì')+  , (237, 'í')+  , (238, 'î')+  , (239, 'ï')+  , (240, 'ð')+  , (241, 'ñ')+  , (242, 'ò')+  , (243, 'ó')+  , (244, 'ô')+  , (245, 'õ')+  , (246, 'ö')+  , (247, '÷')+  , (248, 'ø')+  , (249, 'ù')+  , (250, 'ú')+  , (251, 'û')+  , (252, 'ü')+  , (253, 'ý')+  , (254, 'þ')+  , (255, 'ÿ')+  ]  pdfchardict :: [(String, T.Text)] pdfchardict =

@@ -34,8 +34,12 @@                                  (try $ string "endcmap"))                                () "" str of   Left err -> error $ "Can not parse CMap " ++ (show err)-  Right cmap -> cmap+  Right cmap -> mkUniq cmap +  where+    mkUniq = reverse++ skipHeader :: Parser () skipHeader = do   manyTill anyChar (try $ string "endcodespacerange")@@ -57,11 +61,13 @@  bfrange :: Parser [CMap] bfrange = do-  many1 digit+  d <- many1 digit   spaces    string "beginbfrange"   spaces-  ms <- many (toCmap <$> (getRange <$> hexletters <*> hexletters) <*> (hexletters <|> hexletterArray))+  ms <- many (toCmap+              <$> (getRange <$> hexletters <*> hexletters)+              <*> ((mkStrList d . lines) <$> (try hexletters <|> hexletterArray)))   spaces   string "endbfrange"   spaces@@ -69,7 +75,10 @@     where        gethex = fst.head.readHex       getRange cid cid' = [gethex cid .. gethex cid']-      toCmap range ucs = zip range (map ((:[]).chr) [gethex ucs ..])+      mkStrList d src = if (length src) == 1+                        then [gethex $ head src .. ]+                        else map gethex src+      toCmap range ucs = zip range (map ((:[]).chr) ucs)   hexletters :: Parser String

@@ -7,17 +7,16 @@  import Data.Char (chr, ord) import Data.String (fromString)-import Data.List (isPrefixOf)+import Data.List (isPrefixOf, dropWhileEnd) import Numeric (readOct, readHex) import Data.Maybe (fromMaybe)+import qualified Data.Map as Map -import Data.Binary (decode) import Data.ByteString (ByteString)-import qualified Data.ByteString.Char8 as BS-import qualified Data.ByteString.Lazy.Char8 as BSC-import qualified Data.ByteString.Lazy.UTF8 as BSL+import qualified Data.ByteString.Lazy.Char8 as BSLC (ByteString, pack)+import qualified Data.ByteString.Char8 as BSSC (unpack)+import qualified Data.ByteString.Lazy.UTF8 as BSLU (toString) import qualified Data.Text as T-import qualified Data.Map as Map import Data.Text.Encoding (encodeUtf8)  import Text.Parsec hiding (many, (<|>))@@ -28,7 +27,7 @@  import PDF.Definition import PDF.Object-import PDF.Character (pdfcharmap, adobeJapanOneSixMap)+import PDF.Character (pdfcharmap, extendedAscii, adobeJapanOneSixMap)  type PSParser a = GenParser Char PSR a @@ -36,11 +35,11 @@  parseStream :: PSR -> PDFStream -> PDFStream parseStream psr pdfstream = -  case parseContentStream (T.concat <$> many (elems <|> skipOther)) psr pdfstream of+  case parseContentStream (T.concat <$> (spaces >> many (try elems <|> skipOther))) psr pdfstream of     Left  err -> error $ "Nothing to be parsed: " ++ (show err) -    Right str -> BSC.pack $ BS.unpack $ encodeUtf8 str+    Right str -> BSLC.pack $ BSSC.unpack $ encodeUtf8 str -parseColorSpace :: PSR -> BSC.ByteString -> [T.Text]+parseColorSpace :: PSR -> BSLC.ByteString -> [T.Text] parseColorSpace psr pdfstream =    case parseContentStream (many (choice [ try colorSpace                                         , try $ T.concat <$> xObject@@ -59,6 +58,7 @@                , try pdfopTd                , try pdfopTm                , try pdfopTc+               , try pdfopTs                , try pdfopTw                , try pdfopTL                , try pdfopTz@@ -170,9 +170,7 @@  pdfopBDC :: PSParser T.Text pdfopBDC = do-  n1 <- (++) <$> string "/" <*> manyTill anyChar (try $ lookAhead propertyList)-  spaces-  n2 <- propertyList+  n1 <- name *> propertyList   spaces   string "BDC"   spaces@@ -186,11 +184,25 @@   return T.empty  propertyList :: PSParser T.Text-propertyList = do-  plist <- spaces >> string "<<" >> spaces *> manyTill anyChar (try $ spaces >> string ">>")-  return $ T.pack plist+propertyList = spaces >> choice [try dictionary, try name] +dictionary :: PSParser T.Text+dictionary = T.concat <$> (spaces >> string "<<" >> spaces+                            *> manyTill dictEntry (try (string ">>" >> (notFollowedBy $ string ">")))) +dictEntry :: PSParser T.Text+dictEntry = choice [ try name+                   , try letters+                   , T.pack <$> try hex+                   , T.pack <$> try (many1 digit)+                   ] <* spaces+  where+    hex = string "<" >> (manyTill (oneOf "0123456789abcdefABCDEF") (try $ string ">"))++name :: PSParser T.Text+name = T.pack <$> ((++) <$> string "/" <*> (manyTill anyChar (try $ lookAhead $ oneOf "><][)( \n\r/")) <* spaces)++ pdfopTj :: PSParser T.Text pdfopTj = do   spaces@@ -230,9 +242,15 @@ unknowns :: PSParser T.Text unknowns = do    ps <- manyTill anyChar (try $ oneOf "\r\n")-  return $ if ps=="" -           then "" -           else T.pack $ "[[[UNKNOWN STREAM:" ++ take 100 (show ps) ++ "]]]"+  st <- getState+  -- linebreak within (...) is parsed as Tj+  return $ case runParser elems st "" $ BSLC.pack ((Data.List.dropWhileEnd (=='\\') ps)++")Tj") of+             Right xs -> xs+             Left e -> case runParser elems st "" $ BSLC.pack ("("++ps) of+               Right xs -> xs+               Left e -> case ps of+                 "" -> ""+                 otherwise -> T.pack $ "[[[UNKNOWN STREAM:" ++ take 100 (show ps) ++ "]]]"  skipOther :: PSParser T.Text skipOther = do@@ -255,16 +273,48 @@ letters = do   char '('   st <- getState-  let letterParser = case lookup (curfont st) (fontmaps st) of-        Just (FontMap m) -> psletter m+  let cmap = fromMaybe [] (lookup (curfont st) (cmaps st))+      letterParser = case lookup (curfont st) (fontmaps st) of+        Just (Encoding m) -> psletter m         Just (CIDmap s) -> cidletter s-        Just (WithCharSet s) -> cidletters+        Just (WithCharSet s) -> try $ bytesletter cmap <|> cidletters         Just NullMap -> psletter []-        Nothing -> cidletter "Adobe-Japan1" -- as a defalt map-  lets <- manyTill letterParser (try $ char ')')+        Nothing -> (T.pack) <$> (many1 $ choice [ try $ ')' <$ (string "\\)")+                                                , try $ '(' <$ (string "\\(")+                                                , try $ noneOf ")"+                                                ])+  lets <- manyTill letterParser $ (try $ char ')')   spaces   return $ T.concat lets +bytesletter :: CMap -> PSParser T.Text+bytesletter cmap = do+  txt <- (many1 $ choice [ try $ ')' <$ (string "\\)")+                         , try $ '(' <$ (string "\\(")+                         , try $ (chr 10) <$ (string "\\n")+                         , try $ (chr 13) <$ (string "\\r")+                         , try $ (chr 8) <$ (string "\\b")+                         , try $ (chr 9) <$ (string "\\t")+                         , try $ (chr 12) <$ (string "\\f")+                         , try $ (chr 92) <$ (string "\\\\")+                         , try $ (chr 0) <$ (char '\NUL')+                         , try $ (chr 32) <$ (char ' ')+                         , try $ chr <$> ((string "\\") *> octnum)+                         , try $ noneOf ")"+                         ])+  return $ byteStringToText cmap txt+  where+    byteStringToText :: CMap -> String -> T.Text+    byteStringToText cmap str = T.concat $ map (toUcs cmap) $ asInt16 $ map ord str++    asInt16 :: [Int] -> [Int]+    asInt16 [] = []+    asInt16 (a:[]) = [a] --error $ "Can not read string "++(show a)+    asInt16 (a:b:rest) = (a * 256 + b):(asInt16 rest)++    -- for debug+    -- myToUcs cmap x = if x == 636 then trace (show cmap) $ toUcs cmap x else toUcs cmap x+ hexletters :: PSParser T.Text hexletters = do   char '<'@@ -281,21 +331,25 @@  adobeOneSix :: Int -> T.Text adobeOneSix a = case Map.lookup a adobeJapanOneSixMap of-  Just cs -> T.pack $ BSL.toString cs+  Just cs -> T.pack $ BSLU.toString cs   Nothing -> T.pack $ "[" ++ (show a) ++ "]"  toUcs :: CMap -> Int -> T.Text toUcs m h = case lookup h m of   Just ucs -> T.pack ucs-  Nothing -> adobeOneSix h+  Nothing -> if m == [] then adobeOneSix h else T.pack [chr h] -cidletters = choice [try hexletter, octletter]+cidletters = choice [try hexletter, try octletter]  hexletter :: PSParser T.Text hexletter = do   st <- getState-  let cmap = fromMaybe [] (lookup (curfont st) (cmaps st))-  (hexToString cmap . readHex) <$> (count 4 $ oneOf "0123456789ABCDEFabcdef")+  let font = curfont st+      cmap = fromMaybe [] (lookup font (cmaps st))+  (hexToString cmap . readHex) <$> choice [ try $ count 4 $ oneOf "0123456789ABCDEFabcdef"+                                          , try $ count 2 $ oneOf "0123456789ABCDEFabcdef"+                                          , try $ (:"0") <$> (oneOf "0123456789ABCDEFabcdef")+                                          ]   where hexToString m [(h,"")] = toUcs m h         hexToString _ _ = "????" @@ -326,7 +380,9 @@             [(i,"")] -> T.singleton $ chr i             [(i,x)] -> T.pack (chr i : " ")             _ -> T.pack s-          octToChar [(o,"")] = chr o+          octToChar [(o,"")] = case Map.lookup o extendedAscii of+            Just c -> c+            Nothing -> chr o           octToChar _ = '?'  cidletter :: String -> PSParser T.Text@@ -492,6 +548,14 @@   spaces   st <- getState   let ff = fontfactor st+  return $ ""++pdfopTs :: PSParser T.Text+pdfopTs = do+  tc <- digitParam+  spaces+  string "Ts"+  spaces   return $ ""  desideParagraphBreak :: Double -> Double -> Double -> Double -> Double -> Double 

@@ -48,11 +48,11 @@ toString depth (PdfNull) = ""  -data FontMap = CIDmap String | FontMap [(Char,String)] | WithCharSet String | NullMap+data Encoding = CIDmap String | Encoding [(Char,String)] | WithCharSet String | NullMap -instance Show FontMap where+instance Show Encoding where   show (CIDmap s) = "CIDmap"++s-  show (FontMap a) = "FontMap"++show a+  show (Encoding a) = "Encoding"++show a   show (WithCharSet s) = "WithCharSet"++s   show NullMap = [] @@ -71,7 +71,7 @@                , fontfactor :: Double                , curfont    :: String                , cmaps      :: [(String, CMap)]-               , fontmaps   :: [(String, FontMap)]+               , fontmaps   :: [(String, Encoding)]                , colorspace :: String                , xcolorspaces :: [String]                }

@@ -13,23 +13,28 @@        , expandObjStm        , rootRef        , contentsStream+       , rawStreamByRef        , findKids        , findPages        , findDict        , findDictByRef        , findDictOfType-       , findObjThroughDict-       , findObjThroughDictByRef+       , findObjFromDict+       , findObjFromDictWithRef        , findObjsByRef        , findObjs        , findTrailer+       , rawStream        ) where  import Data.Char (chr) import Data.List (find) import qualified Data.ByteString.Char8 as BS import qualified Data.ByteString.Lazy.Char8 as BSL+import qualified Data.ByteString.Builder as B import qualified Data.Text as T+import Data.Maybe (fromMaybe)+import Numeric (readDec)  import Data.Attoparsec.ByteString.Char8 hiding (take) import Data.Attoparsec.Combinator@@ -42,6 +47,9 @@ import PDF.Object import PDF.ContentStream (parseStream, parseColorSpace) import PDF.Cmap (parseCMap)+import qualified PDF.OpenType as OpenType+import qualified PDF.CFF as CFF+import qualified PDF.Type1 as Type1  spaces = skipSpace oneOf = satisfy . inClass@@ -67,13 +75,13 @@     isRefObj (Just x) (y, objs) = if x==y then True else False     isRefObj _ _ = False -findObjThroughDictByRef :: Int -> String -> [PDFObj] -> Maybe Obj-findObjThroughDictByRef ref name objs = case findDictByRef ref objs of -  Just d -> findObjThroughDict d name+findObjFromDictWithRef :: Int -> String -> [PDFObj] -> Maybe Obj+findObjFromDictWithRef ref name objs = case findDictByRef ref objs of +  Just d -> findObjFromDict d name   Nothing -> Nothing   -findObjThroughDict :: Dict -> String -> Maybe Obj-findObjThroughDict d name = case find isName d of+findObjFromDict :: Dict -> String -> Maybe Obj+findObjFromDict d name = case find isName d of   Just (_, o) -> Just o   otherwise -> Nothing   where isName (PdfName n, _) = if name == n then True else False@@ -118,17 +126,25 @@  contentsStream :: Dict -> PSR -> [PDFObj] -> PDFStream contentsStream dict st objs = case find contents dict of-  Just (PdfName "/Contents", PdfArray arr) -> parseContentStream dict st objs $ BSL.concat $ map (rawStreamByRef objs) (parseRefsArray arr)-  Just (PdfName "/Contents", ObjRef r)     -> parseContentStream dict st objs $ rawStreamByRef objs r-  Nothing                                  -> error "No content to be shown"+  Just (PdfName "/Contents", PdfArray arr) -> getContentArray arr+  Just (PdfName "/Contents", ObjRef r) ->+    case findObjsByRef r objs of+      Just [PdfArray arr] -> getContentArray arr+      Just _ -> getContent r+      Nothing -> error "No content to be shown"+  Nothing -> error "No content to be shown"   where     contents (PdfName "/Contents", _) = True-    contents _                        = False+    contents _ = False +    getContentArray arr = parseContentStream dict st objs $+                          BSL.concat $ map (rawStreamByRef objs) (parseRefsArray arr)+    getContent r = parseContentStream dict st objs $ rawStreamByRef objs r+ parseContentStream :: Dict -> PSR -> [PDFObj] -> BSL.ByteString -> PDFStream parseContentStream dict st objs s =    parseStream (st {fontmaps=fontdict, cmaps=cmap}) s-  where fontdict = findFontMap dict objs+  where fontdict = findFontEncoding dict objs         cmap = findCMap dict objs  rawStreamByRef :: [PDFObj] -> Int -> BSL.ByteString@@ -138,19 +154,23 @@  rawStream :: [Obj] -> BSL.ByteString rawStream objs = case find isStream objs of-  Just (PdfStream strm) -> streamFilter strm-  Nothing               -> error $ (show objs) ++ "\n  No stream to be shown"+  Just (PdfStream strm) -> rawStream' (fromMaybe [] $ findDict objs) strm+  Nothing               -> BSL.pack $ show objs   where     isStream (PdfStream s) = True     isStream _             = False -    streamFilter = case findDict objs of-                     Just d -> case find withFilter d of-                                 Just (PdfName "/Filter", PdfName "/FlateDecode")-                                   -> decompress-                                 Just _ -> id -- need fix-                                 Nothing -> id-                     Nothing -> id+    rawStream' :: Dict -> BSL.ByteString -> BSL.ByteString+    rawStream' d s = streamFilter d s++    streamFilter d = case find withFilter d of+      Just (PdfName "/Filter", PdfName "/FlateDecode")+        -> decompress+      Just (PdfName "/Filter", PdfName f)+        -> error $ "Unknown Stream Compression: " ++ f -- need fix+      Just _ -> error $ "No Stream Compression Filter."+      Nothing -> id+     withFilter (PdfName "/Filter", _) = True     withFilter _                      = False @@ -175,13 +195,13 @@     pairwise x = ""  findXObject dict objs = case findResourcesDict dict objs of-  Just d -> case findObjThroughDict d "/XObject" of+  Just d -> case findObjFromDict d "/XObject" of     Just (PdfDict d) -> d     otherwise -> []   Nothing -> []  xobjColorSpace :: Int -> [PDFObj] -> String-xobjColorSpace x objs = case findObjThroughDictByRef x "/ColorSpace" objs of+xobjColorSpace x objs = case findObjFromDictWithRef x "/ColorSpace" objs of   Just (PdfName cs) -> cs   otherwise -> "" @@ -189,31 +209,32 @@ -- find root ref from Trailer or Cross-Reference Dictionary  parseTrailer :: BS.ByteString -> Maybe Dict-parseTrailer bs = case parseOnly (try trailer <|> xref) bs of-  Left  err -> (trace (show err) Nothing)-  Right rlt -> Just (parseCRDict rlt)-  where trailer :: Parser BS.ByteString-        trailer = do-          manyTill anyChar (try $ string "trailer")-          t <- manyTill anyChar (try $ string "startxref")-          return $ BS.pack t-        xref :: Parser BS.ByteString-        xref = do-          manyTill anyChar (try $ string "startxref" >> spaces >> lookAhead (oneOf "123456789"))-          offset <- many1 digit-          return $ BS.drop (read offset :: Int) bs+parseTrailer bs = case BS.breakEnd (== '\n') bs of+  (source, eofLine)+    | "%%EOF" `BS.isPrefixOf` eofLine+      -> Just (parseCRDict $ BS.drop (getOffset source) bs)+    | source == "" -> Nothing+    | otherwise -> parseTrailer (BS.init bs) +getOffset bs = case BS.breakEnd (== '\n') (BS.init bs) of+  (_, nstr) -> case readDec $ BS.unpack nstr of+                 [(n,_)] -> n+                 _ -> error "Could not find Offset"+ parseCRDict :: BS.ByteString -> Dict parseCRDict rlt = case parseOnly crdict rlt of   Left  err  -> error $ show (BS.take 100 rlt)   Right (PdfDict dict) -> dict-  Right other -> error "Could not find Cross-Reference dictionary"-  where crdict :: Parser Obj-        crdict = do -          spaces-          many (many1 digit >> spaces >> digit >> string " obj" >> spaces)-          d <- pdfdictionary <* spaces-          return d+  Right _ -> error "Could not find Cross-Reference dictionary"+  where+    crdict :: Parser Obj+    crdict = do +      spaces+      (try skipCRtable <|> skipCRstream)+      d <- pdfdictionary <* spaces+      return d+    skipCRtable = ((manyTill anyChar (try $ string "trailer")) >> spaces)+    skipCRstream = (many1 digit >> spaces >> digit >> string " obj" >> spaces)  rootRef :: BS.ByteString -> Maybe Int rootRef bs = case parseTrailer bs of@@ -285,19 +306,22 @@  -- make fontmap from page's /Resources (see 3.7.2 of PDF Ref.) -findFontMap d os = findEncoding (fontObjs d os) os+findFontEncoding d os = findEncoding (fontObjs d os) os -findEncoding :: Dict -> [PDFObj] -> [(String, FontMap)]+findEncoding :: Dict -> [PDFObj] -> [(String, Encoding)] findEncoding dict objs = map pairwise dict-  where -    pairwise (PdfName n, ObjRef r) = (n, fontMap r objs)+  where+    pairwise (PdfName n, ObjRef r) = (n, encoding r objs)     pairwise x = ("", NullMap)  fontObjs :: Dict -> [PDFObj] -> Dict fontObjs dict objs = case findResourcesDict dict objs of-  Just d -> case findObjThroughDict d "/Font" of-    Just (PdfDict d) -> d-    otherwise -> []+  Just d -> case findObjFromDict d "/Font" of+    Just (PdfDict d') -> d'+    Just (ObjRef x) -> case findDictByRef x objs of+                         Just d' -> d'+                         otherwise -> error "cannot find /Font dictionary"+    otherwise -> trace (show d) $ []   Nothing -> []  findResourcesDict :: Dict -> [PDFObj] -> Maybe Dict@@ -309,61 +333,126 @@     resources (PdfName "/Resources", _) = True     resources _                         = False --- Needs rewrite!-fontMap :: Int -> [PDFObj] -> FontMap-fontMap x objs = case findObjThroughDictByRef x "/Encoding" objs of-  Just (ObjRef ref) -> case findObjThroughDictByRef ref "/Differences" objs of-    Just (PdfArray arr) -> charMap arr-    otherwise -> trace "no /differences" NullMap-  Just (PdfName "/StandardEncoding") -> NullMap-  Just (PdfName "/MacRomanEncoding") -> NullMap-  Just (PdfName "/MacExpertEncoding") -> NullMap-  Just (PdfName "/WinAnsiEncoding") -> NullMap-  otherwise -> case findObjThroughDictByRef x "/ToUnicode" objs of-    Just (ObjRef ref) -> case findObjThroughDictByRef ref "/CharSet" objs of-      Just (PdfText str) -> WithCharSet str-      otherwise -> WithCharSet ""-    otherwise -> case findObjThroughDictByRef x "/DescendantFonts" objs of -- needs CID to Unicode map-      Just (ObjRef ref) -> case findObjsByRef ref objs of-        Just [(PdfArray ((ObjRef subref):_))] -> case findObjThroughDictByRef subref "/CIDSystemInfo" objs of-          Just (ObjRef inforef) -> case findObjThroughDictByRef inforef "/Registry" objs of-            Just (PdfText "Adobe") -> case findObjThroughDictByRef inforef "/Ordering" objs of-              Just (PdfText "Japan1") -> case findObjThroughDictByRef inforef "/Supplement" objs of-                Just (PdfNumber _) -> CIDmap "Adobe-Japan1"-                _ -> trace (show inforef) defaultCIDMap-              _ -> trace (show inforef) defaultCIDMap-            _ -> trace (show inforef) defaultCIDMap-          _ -> trace (show subref ++ " no /cidsysteminfoy. using Adobe-Japan1...") defaultCIDMap-        _ -> trace (show ref ++ " no array in /descendantfonts. using Adobe-Japan1...") defaultCIDMap-      _ -> trace (show x ++ " no /descendantfonts. using Adobe-Japan1...") defaultCIDMap +encoding :: Int -> [PDFObj] -> Encoding+encoding x objs = case subtype of+  Just (PdfName "/Type0") -> case encoding of+    Just (PdfName "/Identity-H") -> head $ cidSysInfo descendantFonts+    -- TODO" when /Encoding is stream of CMap+    Just (PdfName s) -> error $ "Unknown Encoding " ++ (show s) ++ " for a Type0 font. Check " ++ show x+    _ -> error $ "Something wrong with a Type0 font. Check " ++ (show x)+  Just (PdfName "/Type1") -> case encoding of+    Just (ObjRef r) -> case findObjFromDictWithRef r "/Differences" objs of+                     Just (PdfArray arr) -> charDiff arr+                     _ -> error "No /Differences"+    Just (PdfDict d) -> case findObjFromDict d "/Differences" of+                     Just (PdfArray arr) -> charDiff arr+                     _ -> error "No /Differences"+    Just (PdfName "/MacRomanEncoding") -> NullMap+    Just (PdfName "/MacExpertEncoding") -> NullMap+    Just (PdfName "/WinAnsiEncoding") -> NullMap+    -- TODO: FontFile (Type 1), FontFile2 (TrueType), FontFile3 (Other than Type1C)+    _ -> case findObjFromDict (fontDescriptor' x) "/FontFile3" of+           Just (ObjRef fontfile) ->+             CFF.encoding $ BSL.toStrict $ rawStreamByRef objs fontfile+           _ -> case findObjFromDict (fontDescriptor' x) "/FontFile" of+             Just (ObjRef fontfile) ->+               Type1.encoding $ BSL.toStrict $ rawStreamByRef objs fontfile+             _ -> NullMap+  -- TODO+  Just (PdfName "/Type2") -> NullMap+  Just (PdfName "/Type3") -> NullMap+  _ -> NullMap+   where-    defaultCIDMap = CIDmap "Adobe-Japan1"+    subtype = get "/Subtype"+    encoding = get "/Encoding"+    toUnicode = get "/ToUnicode"  -charMap :: [Obj] -> FontMap-charMap objs = FontMap $ fontmap objs 0-  where fontmap (PdfNumber x : PdfName n : xs) i = +    get s = findObjFromDictWithRef x s objs++    -- Should be an array (or ref to an array) containing refs+    descendantFonts :: [Obj]+    descendantFonts = case findObjFromDictWithRef x "/DescendantFonts" objs of+      Just (PdfArray dfrs) -> dfrs+      Just (ObjRef r) -> case findObjsByRef r objs of+        Just [(PdfArray dfrs)] -> dfrs+        _ -> error $ "Can not find /DescendantFonts entries in " ++ show r+      _ -> error $ "Can not find /DescendantFonts itself in " ++ show x ++    cidSysInfo :: [Obj] -> [Encoding]+    cidSysInfo [] = []+    cidSysInfo ((ObjRef r):rs) = (cidSysInfo' r):(cidSysInfo rs)+    cidSysInfo' dfr = case findObjFromDictWithRef dfr "/CIDSystemInfo" objs of+      Just (PdfDict dict) -> getCIDSystemInfo dict+      Just (ObjRef r) -> case findDictByRef r objs of+                           Just dict -> getCIDSystemInfo dict+                           _ -> error $ "Can not find /CIDSystemInfo entries in" ++ show r+      _ -> error $ "Can not find /CidSystemInfo itself " ++ show dfr++    fontDescriptor :: [Obj] -> [Dict]+    fontDescriptor [] = []+    fontDescriptor ((ObjRef r):rs) = (fontDescriptor' r):(fontDescriptor rs)+    fontDescriptor' :: Int -> Dict+    fontDescriptor' fdr = case findObjFromDictWithRef fdr "/FontDescriptor" objs of+      Just (ObjRef r) -> case findDictByRef r objs of+                           Just dict -> dict+                           _ -> error $ "No /FontDescriptor entries in " ++ show r+      _ -> error $ "Can not find /FontDescriptor itself in " ++ show fdr++    getCIDSystemInfo d =+      let registry = case findObjFromDict d "/Registry" of+                       Just (PdfText r) -> r+                       otherwise -> error "Can not find /Registry"+          ordering = case findObjFromDict d "/Ordering" of+                       Just (PdfText o) -> o+                       othserwise -> error "Can not find /Ordering"+          supplement = case findObjFromDict d "/Supplement" of+                         Just (PdfNumber s) -> s+                         otherwise -> error "Can not find /Supprement"+          cmap = registry ++ "-" ++ ordering -- ex. "Adobe-Japan1"+      in if cmap == "Adobe-Japan1"+         then CIDmap cmap+         else WithCharSet ""+++charDiff :: [Obj] -> Encoding+charDiff objs = Encoding $ charmap objs 0+  where charmap (PdfNumber x : PdfName n : xs) i =            if i < truncate x then -            (chr $ truncate x, n) : (fontmap xs $ incr x)+            (chr $ truncate x, n) : (charmap xs $ incr x)           else -            (chr $ i, n) : (fontmap xs $ i+1)-        fontmap (PdfName n : xs) i = (chr i, n) : (fontmap xs $ i+1)-        fontmap [] i               = []+            (chr $ i, n) : (charmap xs $ i+1)+        charmap (PdfName n : xs) i = (chr i, n) : (charmap xs $ i+1)+        charmap [] i               = []         incr x = (truncate x) + 1 -findCMap d os = cMap (fontObjs d os) os -cMap :: Dict -> [PDFObj] -> [(String, CMap)]-cMap dict objs = map pairwise dict+findCMap :: Dict -> [PDFObj] -> [(String, CMap)]+findCMap d objs = map pairwise (fontObjs d objs)   where     pairwise (PdfName n, ObjRef r) = (n, toUnicode r objs)     pairwise x = ("", [])  toUnicode :: Int -> [PDFObj] -> CMap-toUnicode x objs = case findObjThroughDictByRef x "/ToUnicode" objs of-  Just (ObjRef ref) -> parseCMap $ rawStreamByRef objs ref-  otherwise -> case findObjThroughDictByRef x "/Encoding" objs of-    Just (PdfName "/Identity-H") -> case findObjThroughDictByRef x "/ToUnicode" objs of-      Just (ObjRef ref) -> parseCMap $ rawStreamByRef objs ref-      otherwise -> []+toUnicode x objs =+  case findObjFromDictWithRef x "/ToUnicode" objs of+    Just (ObjRef ref) ->+      parseCMap $ rawStreamByRef objs ref+    otherwise -> noToUnicode x objs++noToUnicode x objs = +  case findObjFromDictWithRef x "/DescendantFonts" objs of+    Just (ObjRef ref) ->+      case findObjsByRef ref objs of+        Just [(PdfArray ((ObjRef subref):_))] ->+          case findObjFromDictWithRef subref "/FontDescriptor" objs of+            Just (ObjRef desc) ->+              case findObjFromDictWithRef desc "/FontFile2" objs of+                Just (ObjRef fontfile) ->+                  OpenType.cmap $ BSL.toStrict $ rawStreamByRef objs fontfile+                otherwise -> []+            otherwise -> []+        otherwise -> []     otherwise -> []+

@@ -28,7 +28,7 @@ import qualified Data.ByteString.Lazy.Char8 as BSL import qualified Data.Text as T import Data.Text.Encoding (decodeUtf16BEWith)-import Data.Text.Encoding.Error (lenientDecode)+import Data.Text.Encoding.Error (strictDecode) import Numeric (readOct, readHex) import Data.ByteString.Builder (toLazyByteString, word16BE) @@ -40,7 +40,7 @@  import PDF.Definition -spaces = skipSpace+spaces = skipMany (comment <|> oneOf pdfspaces) --skipSpace oneOf = satisfy . inClass noneOf = satisfy . notInClass @@ -48,7 +48,7 @@  pdfObj :: Parser PDFBS pdfObj = do-  skipMany (comment <|> oneOf "\r\n")+  spaces -- skipMany (comment <|> oneOf pdfspaces)   objn <- many1 digit <* (spaces >> oneOf "0123456789" >> string " obj")   object <- manyTill anyChar (try $ string "endobj")   spaces@@ -56,6 +56,9 @@   skipMany startxref   return $ (read objn, BS.pack object) +pdfspaces :: [Char]+pdfspaces = map chr [0, 9, 10, 12, 13, 32]+ parsePDFObj :: PDFBS -> PDFObj parsePDFObj (n,pdfobject) = case parseOnly (spaces >> many1 (try pdfobj <|> try objother)) pdfobject of   Left  err -> (n,[PdfNull])@@ -103,43 +106,46 @@ pdfarray = PdfArray <$> (string "[" >> spaces *> manyTill pdfobj (try $ spaces >> string "]"))  pdfname :: Parser Obj-pdfname = PdfName . BS.unpack <$> (BS.append <$> string "/" <*> (BS.pack <$> (manyTill anyChar (try $ lookAhead $ oneOf "><][)( \n\r/")))) <* spaces+pdfname = PdfName . BS.unpack <$> (BS.append <$> string "/" <*> (BS.pack <$> manyTill anyChar (try $ lookAhead $ oneOf "><][)( \n\r/"))) <* spaces  pdfletters :: Parser Obj pdfletters = PdfText <$> parsePdfLetters  parsePdfLetters :: Parser String-parsePdfLetters = (concat <$> (char '(' *> manyTill (choice [try pdfutf, try pdfoctutf, pdfletter]) (try $ char ')')))-  where pdfletter = do-          str <- choice [ return <$> try (char '\\' >> oneOf "\\()")-                        , "\n" <$ try (string "\n")-                        , "\r" <$ try (string "\r")-                        , "\t" <$ try (string "\t")-                        , "\b" <$ try (string "\b")-                        , "\f" <$ try (string "\f")-                        , (++) <$> ("(" <$ char '(') <*> ((++")") . concat <$> manyTill pdfletter (try $ char ')'))-                        , return <$> (noneOf "\\")-                        ]-          return $ str+parsePdfLetters = concat <$> (char '(' *>+                               manyTill (choice [ try pdfutf+                                                , try pdfoctutf+                                                , pdfletter])+                               (try $ char ')'))+  where pdfletter =+          choice [ "(" <$ try (string "\\(")+                 , ")" <$ try (string "\\)")+                 , "\\" <$ try (string "\\\\")+                 , "\n" <$ try (string "\\n")+                 , "\r" <$ try (string "\\r")+                 , "\t" <$ try (string "\\t")+                 , "\b" <$ try (string "\\b")+                 , "\f" <$ try (string "\\f")+                 , octal <$> try (char '\\' *> count 3 (oneOf "01234567"))+                 , octal <$> try (char '\\' *> count 2 (oneOf "01234567"))+                 , octal . (:[]) <$> try (char '\\' *> oneOf "01234567")+                 , return <$> try (noneOf "\\")+                 , "" <$ string "\\"+                 ]++        octal = return . chr . fst . head . readOct+                 pdfutf :: Parser String         pdfutf = do -          str <- string "\254\255" *> manyTill anyChar (lookAhead $ string ")")-          return $ utf16be str+          str <- string "\254\255" *> manyTill pdfletter (lookAhead $ string ")")+          return $ utf16be $ concat str                  pdfoctutf :: Parser String         pdfoctutf = do-          string "\\376\\377" -          octstr <- manyTill (choice [ try (return . chr . fst . head . readOct <$> (char '\\' *> count 3 (oneOf "01234567")))-                                     , try ("\92" <$ string "\\\\")-                                     , return <$> noneOf "\\"-                                     ])-                    (lookAhead $ string ")")-          return $ utf16be $ concat octstr--        octToString [] = "????"-        octToString [(o,_)] = [chr o]--utf16be = T.unpack . decodeUtf16BEWith lenientDecode . BS.pack+          str <- string "\\376\\377" *> manyTill pdfletter (lookAhead $ string ")")+          return $ utf16be $ concat str+        +utf16be = T.unpack . decodeUtf16BEWith strictDecode . BS.pack  pdfstream :: Parser Obj pdfstream = PdfStream <$> stream@@ -185,13 +191,13 @@ pdfobj = choice [ try rrefs <* spaces                 , try pdfname <* spaces                 , try pdfnumber <* spaces-                , try pdfhex <* spaces+                , try pdfhex <* spaces -- Hexadecimal String                 , try pdfbool <* spaces                 , try pdfnull <* spaces                 , try pdfarray <* spaces                 , try pdfdictionary <* spaces                 , {-# SCC pdfstream #-} try pdfstream <* spaces-                , pdfletters <* spaces+                , pdfletters <* spaces -- Literal String                 ]  rrefs :: Parser Obj

@@ -0,0 +1,191 @@+{-# LANGUAGE OverloadedStrings #-}++module PDF.OpenType (cmap) where++import Numeric (readInt)+import Data.Char (chr)++import Data.Word+import Data.Bits++import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BSC++import Data.Attoparsec.ByteString (Parser, parseOnly, word8, string)+import qualified Data.Attoparsec.ByteString as AP+import Data.Attoparsec.Combinator++import Control.Applicative++import Debug.Trace++import PDF.Definition++data Table = Table String Integer Integer+  deriving (Show)++data EncRecord = EncRecord Integer Integer Integer+  deriving (Show)++{-+test f = do+  c <- BS.readFile f+  let bs = cmap c+  return bs+-}++cmap :: ByteString -> CMap+cmap c = case parseOnly (offsetTable >>= tableRecords) c of+  Right b -> let b' = (takeCmap b)+             in case parseOnly cmapEncRecords b' of+                  Right records -> concatMap (subtable b') records+                  Left e -> error e+  Left e -> error e+  where+    offsetTable = do+      sfntVersion+      n <- numTables+      searchRange >> entrySelector >> rangeShift+      return $ fromIntegral n++    takeCmap ((Table "cmap" start end):_)+      = BS.take (fromInteger end) $ BS.drop (fromInteger start) c+    takeCmap (_:rest) = takeCmap rest+    takeCmap [] = error "no cmap"++    cmapEncRecords =+      cmapVersion >>+      numEncRecords >>=+      (encodeRecords . fromIntegral)+      +subtable c (EncRecord pid eid offset) =+  let body = BS.drop (fromInteger offset) c+      format = fromBytes $ BS.take 2 body+  in case parseOnly (parserByFormat format) body of+       Right b -> b+       Left e -> error e++parserByFormat :: Integer -> Parser CMap+parserByFormat 14 = do+  format <- getUint16+  length <- getUint32+  rest <- (AP.take . fromInteger) length+  return $ []++parserByFormat 12 = do+  format <- getUint16+  reserved <- getUint16+  length <- getUint32+  language <- getUint32+  numGroups <- fromInteger <$> getUint32+  seqMapGroups <- count (numGroups) seqMapGroup+  return $ concat seqMapGroups++  where+    seqMapGroup :: Parser CMap+    seqMapGroup = do+      startCharCode <- fromInteger <$> getUint32+      endCharCode <- fromInteger <$> getUint32+      startGlyphID  <- fromInteger <$> getUint32+      return $ toCmap startGlyphID [startCharCode .. endCharCode]+    toCmap gid range = zip [gid ..] $ map ((:[]).chr) range++parserByFormat 4 = do+  format <- getUint16+  length <- fromInteger <$> getUint16+  language <- getUint16+  segCount2 <- fromInteger <$> getUint16+  searchRange <- getUint16+  entrySlector <- getUint16+  rangeShift <-getUint16+  let segCount = segCount2 `div` 2+  endCodes <- count segCount $ fromInteger <$> getUint16+  reservedPad <- contiguous [0x00, 0x00]+  startCodes <- count segCount $ fromInteger <$> getUint16+  idDelta <- count segCount $ fromInteger <$> getUint16+  rest <- AP.take (length - 16 - segCount2 * 3)+  return $ concat $ getGlyphIDs startCodes endCodes idDelta rest++  where+    getGlyphIDs [] _ _ _ = []+    getGlyphIDs (s:ss) (e:ee) (d:dd) rest =+      -- take 2bytes from idRangeOffset[uint16]+      let rest' = BS.drop 2 rest+      in (getGlyphID s e d rest):(getGlyphIDs ss ee dd rest')++    getGlyphID :: Int -> Int -> Int -> ByteString+                -> CMap+    getGlyphID start end delta rest =+      let offset = fromInteger $ fromBytes $ BS.take 2 rest+      in +        if offset == 0+        then zip (map (+delta) [start .. end])+                 (map ((:[]).chr) [start .. end])+        else zip (map (getRangeOffsetGlyphID start offset rest) [start .. end])+                 (map ((:[]).chr) [start .. end])+             +    getRangeOffsetGlyphID s o bytestring c =+      fromInteger $ fromBytes $ BS.take 2 $ BS.drop (o + 2 * (c - s)) bytestring++parserByFormat _ = return []+++-- main tables++sfntVersion :: Parser ByteString+sfntVersion = contiguous [0x00, 0x01, 0x00, 0x00] <|> string "OTTO"++numTables =  getUint16+searchRange = getUint16+entrySelector = getUint16+rangeShift = getUint16++tableRecords n = count n tableRecord++tableRecord :: Parser Table+tableRecord = do+  tableTag <- BSC.unpack <$> AP.take 4+  checkSum <- getUint32+  offset <- getUint32+  length <- getUint32+  return $ Table tableTag offset length++getUint16 :: Parser Integer+getUint16 = fromBytes <$> AP.take 2++getUint32 :: Parser Integer+getUint32 = fromBytes <$> AP.take 4++tableTag :: Parser String+tableTag = BSC.unpack <$> AP.take 4++-- subtables++cmapVersion = getUint16+numEncRecords = getUint16++encodeRecords n = count n encodeRecord++encodeRecord :: Parser EncRecord+encodeRecord = do+  platformID <- getUint16+  encodingID <- getUint16+  offset <- getUint32+  return $ EncRecord platformID encodingID offset+++fromBytes :: ByteString -> Integer+fromBytes = BS.foldl' f 0+  where+    f a b = a `shiftL` 8 .|. fromIntegral b++contiguous :: [Word8] -> Parser ByteString+contiguous bs = BS.pack <$> contiguous' bs+  where+    contiguous' (b:[]) = (:[]) <$> word8 b+    contiguous' (b:bs) = do+      byte <- word8 b+      rest <- contiguous' bs+      return $ (byte:rest)+

@@ -53,12 +53,14 @@     Nothing -> error "No top level outline entry."   firstdict <- case findObjsByRef firstref objs of     Just [PdfDict d] -> return d+    Just s -> error $ "Unknown Object: " ++ show s     Nothing -> error $ "No Object with Ref " ++ show firstref   return $ gatherOutlines firstdict objs  gatherChildren dict objs = case findFirst dict of   Just r -> case findObjsByRef r objs of     Just [PdfDict d] -> gatherOutlines d objs+    Just s -> error $ "Unknown Object at " ++ show r     Nothing -> error $ "No Object with Ref " ++ show r   Nothing -> PDFOutlinesNE @@ -70,14 +72,16 @@                                                             , text = findTitle dict objs ++ "\n"                                                             , subs = c}                                            : [gatherOutlines d objs])+      Just s -> error $ "Unknown Object at " ++ show r       Nothing -> error $ "No Object with Ref " ++ show r     Nothing -> PDFOutlinesEntry { dest = head $ findDest dict                                 , text = findTitle dict objs ++ "\n"-                                , subs = PDFOutlinesNE}+                                , subs = c}  outlines :: Dict -> Int outlines dict = case find isOutlinesRef dict of   Just (_, ObjRef x) -> x+  Just s -> error $ "Unknown Object: " ++ show s   Nothing            -> error "There seems no /Outlines in the root"   where     isOutlinesRef (PdfName "/Outlines", ObjRef x) = True@@ -95,30 +99,35 @@     Nothing   -> error "Something wrong..."   case findObjsByRef outlineref objs of     Just [PdfDict d] -> return d+    Just s -> error $ "Unknown Object: " ++ show s     Nothing -> error "Could not get outlines object"  findTitle dict objs = -  case findObjThroughDict dict "/Title" of+  case findObjFromDict dict "/Title" of     Just (PdfText s) -> case parseOnly parsePdfLetters (BS.pack s) of       Right t -> t       Left err -> s     Just (ObjRef r) -> case findObjsByRef r objs of       Just [PdfText s] -> s+      Just s -> error $ "Unknown Object at " ++ show r       Nothing -> error $ "No title object in " ++ show r     Just x -> show x     Nothing -> error "No title object."  findDest dict = -  case findObjThroughDict dict "/Dest" of+  case findObjFromDict dict "/Dest" of     Just (PdfArray a) -> parseRefsArray a+    Just s -> error $ "Unknown Object: " ++ show s     Nothing -> error "No destination object."  findNext dict = -  case findObjThroughDict dict "/Next" of+  case findObjFromDict dict "/Next" of     Just (ObjRef x) -> Just x+    Just s -> error $ "Unknown Object: " ++ show s     Nothing -> Nothing  findFirst dict =-  case findObjThroughDict dict "/First" of+  case findObjFromDict dict "/First" of     Just (ObjRef x) -> Just x+    Just s -> error $ "Unknown Object: " ++ show s     Nothing -> Nothing

@@ -1,3 +1,5 @@+{-# LANGUAGE OverloadedStrings #-}+ {-| Module      : PDF.PDFIO Description : IO utilities for hpdft@@ -13,19 +15,25 @@                  , getPDFObjFromFile                  , getRootRef                  , getRootObj+                 , getStream                  , getTrailer                  , getInfo                  ) where  import PDF.Definition-import PDF.DocumentStructure (findObjs, findObjsByRef, findDictByRef, findObjThroughDict, rootRef, findTrailer, expandObjStm)+import PDF.DocumentStructure+  (rawStream, rawStreamByRef, findObjs, findObjsByRef,+   findDictByRef, findObjFromDict, rootRef,+   findTrailer, expandObjStm) import PDF.Object (parsePDFObj)  import Debug.Trace  import qualified Data.ByteString.Char8 as BS+import qualified Data.ByteString.Builder as B+import qualified Data.ByteString.Lazy.Char8 as BSL --- | Get PDF objects as a whole bytestring. Use 'getPDFObjFromFile' instead if there's no reason to see a raw bytestring. +-- | Get PDF objects as a whole bytestring. Use `getPDFObjFromFile` instead if there's no reason to see a raw bytestring.   getPDFBSFromFile :: FilePath -> IO [PDFBS] getPDFBSFromFile f = do@@ -41,7 +49,7 @@   let obj = expandObjStm $ map parsePDFObj $ findObjs c   return obj --- | Get a PDF object from a whole 'PDFObj' by specifying 'ref :: Int'+-- | Get a PDF object from a whole 'PDFObj' by specifying `ref :: Int`  getObjectByRef :: Int -> [PDFObj] -> IO [Obj] getObjectByRef ref pdfobjs = do@@ -49,8 +57,19 @@     Just os -> return os     Nothing -> error $ "No Object with Ref " ++ show ref --- | The reference number of /Root in 'filename'.+-- | Get a PDF stream from a whole 'PDFObj' by specifying `ref :: Int` +getStream :: Bool -> [Obj] -> IO BSL.ByteString+getStream hex obj = return $ showBSL hex $ rawStream obj++showBSL hex s =+  let strm' = (B.toLazyByteString . B.lazyByteStringHex) s+  in if hex+     then if BSL.length strm' > 256 then BSL.concat [BSL.take 256 strm', "...(omit)"] else strm'+     else s++-- | The reference number of /Root in `filename`.+ getRootRef :: FilePath -> IO Int getRootRef filename = do   c <- BS.readFile filename@@ -59,7 +78,7 @@     Just i -> return i     Nothing -> error "Could not find rood object"     --- | The /Root object in 'filename'.+-- | The /Root object in `filename`.  getRootObj :: FilePath -> IO [Obj] getRootObj filename = do@@ -69,20 +88,20 @@     Just os -> return os     Nothing -> error "Could not get root object" --- | The trailer of 'filename'.+-- | The trailer of `filename`.  getTrailer :: FilePath -> IO Dict getTrailer filename = do   c <- BS.readFile filename   return $ findTrailer c --- | /Info of 'filename'.+-- | /Info of `filename`.  getInfo :: FilePath -> IO Dict getInfo filename = do   d <- getTrailer filename   objs <- getPDFObjFromFile filename-  let inforef = case findObjThroughDict d "/Info" of+  let inforef = case findObjFromDict d "/Info" of                   Just (ObjRef ref) -> ref                   Just _ -> error "There seems to be no Info"                   Nothing -> error "There seems to be no Info"

@@ -0,0 +1,61 @@+{-# LANGUAGE OverloadedStrings #-}++module PDF.Type1 (encoding) where++import Numeric (readInt)+import Data.Char (chr)++import Data.Word+import Data.Bits++import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Char8 as BSC+import qualified Data.ByteString.Lazy as BSL++import Data.Attoparsec.ByteString.Char8+import qualified Data.Attoparsec.ByteString as AP+import Data.Attoparsec.Combinator++import Control.Applicative++import Debug.Trace++import PDF.Definition++test f = do+  c <- BS.readFile f+  return $ encoding c++spaces = skipMany (oneOf " \n\r") --skipSpace+oneOf = satisfy . inClass+noneOf = satisfy . notInClass++encoding :: ByteString -> Encoding+encoding c = case parseOnly encodingArray c of+  Right ss -> Encoding ss+  Left e -> error "Can not find /Encoding in the Type1 Font"++encodingArray :: Parser [(Char,String)]+encodingArray = do+  manyTill anyChar (try $ lookAhead $ string "/Encoding")+  string "/Encoding"+  spaces+  choice [ [] <$ (string "StandardEncoding"+                   >> spaces >> string "def")+         , (skipFor >> spaces +             *> manyTill specialEncodings+             (try $ string "readonly" <|> string "def"))+         ]+    where+      skipFor = manyTill anyChar (try $ string "for")++specialEncodings :: Parser (Char, String)+specialEncodings = do+  spaces +  (,) <$> (spaces >> string "dup" >> spaces *> index)+    <*> (spaces >> charName <* spaces)+  where+    index = (chr . read) <$> many1 digit+    charName = manyTill anyChar (try $ (spaces >> string "put"))+