packages feed

pdf-toolbox-content (empty) → 0.0.2.0

raw patch · 10 files changed

+1072/−0 lines, 10 filesdep +attoparsecdep +basedep +base16-bytestringsetup-changed

Dependencies added: attoparsec, base, base16-bytestring, bytestring, containers, encoding, io-streams, pdf-toolbox-core, text

Files

+ LICENSE view
@@ -0,0 +1,30 @@+Copyright (c) 2013, Yuras Shumovich++All rights reserved.++Redistribution and use in source and binary forms, with or without+modification, are permitted provided that the following conditions are met:++    * Redistributions of source code must retain the above copyright+      notice, this list of conditions and the following disclaimer.++    * Redistributions in binary form must reproduce the above+      copyright notice, this list of conditions and the following+      disclaimer in the documentation and/or other materials provided+      with the distribution.++    * Neither the name of Yuras Shumovich nor the names of other+      contributors may be used to endorse or promote products derived+      from this software without specific prior written permission.++THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS+"AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT+LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR+A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT+OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,+SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT+LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,+DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY+THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT+(INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE+OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
+ Setup.hs view
@@ -0,0 +1,2 @@+import Distribution.Simple+main = defaultMain
+ lib/Pdf/Toolbox/Content.hs view
@@ -0,0 +1,20 @@++-- | Low level tools for processing PDF page content stream.++module Pdf.Toolbox.Content+(+  module Pdf.Toolbox.Content.Ops,+  module Pdf.Toolbox.Content.Parser,+  module Pdf.Toolbox.Content.UnicodeCMap,+  module Pdf.Toolbox.Content.Processor,+  module Pdf.Toolbox.Content.Transform,+  module Pdf.Toolbox.Content.FontInfo+)+where++import Pdf.Toolbox.Content.Ops+import Pdf.Toolbox.Content.Parser+import Pdf.Toolbox.Content.UnicodeCMap+import Pdf.Toolbox.Content.Processor+import Pdf.Toolbox.Content.Transform+import Pdf.Toolbox.Content.FontInfo
+ lib/Pdf/Toolbox/Content/FontInfo.hs view
@@ -0,0 +1,182 @@++-- | Font info contains information, extracted from font,+-- that may be needed when processing content stream++module Pdf.Toolbox.Content.FontInfo+(+  FontInfo(..),+  FISimple(..),+  SimpleFontEncoding(..),+  FIComposite(..),+  CIDFontWidths(..),+  makeCIDFontWidths,+  cidFontGetWidth,+  fontInfoDecodeGlyphs+)+where++import Data.List+import Data.Monoid+import Data.Map (Map)+import qualified Data.Map as Map+import qualified Data.ByteString as BS+import qualified Data.Text as Text+import qualified Data.Text.Encoding as Text+import qualified Data.Encoding as Encoding+import qualified Data.Encoding.CP1252 as Encoding+import qualified Data.Encoding.MacOSRoman as Encoding+import Control.Monad++import Pdf.Toolbox.Core++import Pdf.Toolbox.Content.UnicodeCMap+import Pdf.Toolbox.Content.Transform+import Pdf.Toolbox.Content.Processor (Glyph(..))++-- | Font info+data FontInfo+  = FontInfoSimple FISimple+  | FontInfoComposite FIComposite+  deriving (Show)++-- | Font info for simple fonts+data FISimple = FISimple {+  fiSimpleUnicodeCMap :: Maybe UnicodeCMap,+  fiSimpleEncoding :: Maybe SimpleFontEncoding,+  fiSimpleWidths :: Maybe (Int, Int, [Double])  -- ^ FirstChar, LastChar, list of widths+  }+  deriving (Show)++-- | Encoding of simple font+data SimpleFontEncoding+  = SimpleFontEncodingWinAnsi+  | SimpleFontEncodingMacRoman+  deriving (Show)++-- | Font info for Type0 font+data FIComposite = FIComposite {+  fiCompositeUnicodeCMap :: Maybe UnicodeCMap,+  fiCompositeWidths :: CIDFontWidths,+  fiCompositeDefaultWidth :: Double+  }+  deriving (Show)++-- | Glyph widths for CID fonts+data CIDFontWidths = CIDFontWidths {+  cidFontWidthsChars :: Map Int Double,+  cidFontWidthsRanges :: [(Int, Int, Double)]+  }+  deriving (Show)++instance Monoid CIDFontWidths where+  mempty = CIDFontWidths {+    cidFontWidthsChars = mempty,+    cidFontWidthsRanges = mempty+    }+  w1 `mappend` w2 = CIDFontWidths {+    cidFontWidthsChars = cidFontWidthsChars w1 `mappend` cidFontWidthsChars w2,+    cidFontWidthsRanges = cidFontWidthsRanges w1 `mappend` cidFontWidthsRanges w2+    }++-- | Make `CIDFontWidths` from value of \"W\" key in descendant font+makeCIDFontWidths :: Monad m => Array -> PdfE m CIDFontWidths+makeCIDFontWidths (Array vals) = go mempty vals+  where+  go res [] = return res+  go res (ONumber x1 : ONumber x2 : ONumber x3 : xs) = do+    n1 <- intValue x1+    n2 <- intValue x2+    n3 <- realValue x3+    go res {cidFontWidthsRanges = (n1, n2, n3) : cidFontWidthsRanges res} xs+  go res (ONumber x: OArray (Array arr): xs) = do+    n <- intValue x+    ws <- forM arr $ \w -> fromObject w >>= realValue+    go res {cidFontWidthsChars = Map.fromList (zip [n ..] ws) `mappend` cidFontWidthsChars res} xs+  go _ _ = left $ UnexpectedError "Can't parse CIDFont width"++-- | Get glyph width by glyph code+cidFontGetWidth :: CIDFontWidths -> Int -> Maybe Double+cidFontGetWidth w code =+  case Map.lookup code (cidFontWidthsChars w) of+    Just width -> Just width+    Nothing -> case find (\(start, end, _) -> code >= start && code <= end) (cidFontWidthsRanges w) of+                 Just (_, _, width) -> Just width+                 _ -> Nothing++-- | Decode string into list of glyphs and their widths+fontInfoDecodeGlyphs :: FontInfo -> Str -> [(Glyph, Double)]+fontInfoDecodeGlyphs (FontInfoSimple fi) = \(Str bs) ->+  flip map (BS.unpack bs) $ \c ->+    let code = fromIntegral c+        txt =+          case fiSimpleUnicodeCMap fi of+            Nothing ->+              case fiSimpleEncoding fi of+                Nothing ->+                  case Text.decodeUtf8' (BS.pack [c]) of+                    Right t -> Just t+                    _ -> Nothing+                Just SimpleFontEncodingWinAnsi ->+                  case Encoding.decodeStrictByteStringExplicit Encoding.CP1252 (BS.pack [c]) of+                    Left _ -> Nothing+                    Right t -> Just $ Text.pack t+                Just SimpleFontEncodingMacRoman ->+                  case Encoding.decodeStrictByteStringExplicit Encoding.MacOSRoman (BS.pack [c]) of+                    Left _ -> Nothing+                    Right t -> Just $ Text.pack t+            Just toUnicode -> unicodeCMapDecodeGlyph toUnicode code+        width =+          case fiSimpleWidths fi of+            Nothing -> 0+            Just (firstChar, lastChar, widths) ->+              if code >= firstChar && code <= lastChar && (code - firstChar) < length widths+                 then (widths !! (code - firstChar)) / 1000+                 else 0+    in (Glyph {+      glyphCode = code,+      glyphTopLeft = Vector 0 0,+      glyphBottomRight = Vector width 1,+      glyphText = txt+      }, width)+fontInfoDecodeGlyphs (FontInfoComposite fi) = \str ->+  case fiCompositeUnicodeCMap fi of+    Nothing ->  -- XXX: use encoding here+      let Str bs = str+      in tryDecode2byte $ BS.unpack bs+    Just toUnicode ->+      let getWidth = fromMaybe (fiCompositeDefaultWidth fi) . cidFontGetWidth (fiCompositeWidths fi)+      in cmapDecodeString getWidth toUnicode str+  where+  -- Most of the time composite fonts have 2-byte encoding,+  -- so lets try that for now.+  tryDecode2byte (b1:b2:rest) =+    let code = fromIntegral b1 * 255 + fromIntegral b2+        width = (/ 1000) $ fromMaybe (fiCompositeDefaultWidth fi) $ cidFontGetWidth (fiCompositeWidths fi) code+        txt =+          case Text.decodeUtf8' (BS.pack [b1, b2]) of+            Right t -> Just t+            _ -> Nothing+        g = Glyph {+          glyphCode = code,+          glyphTopLeft = Vector 0 0,+          glyphBottomRight = Vector width 1,+          glyphText = txt+          }+    in (g, width) : tryDecode2byte rest+  tryDecode2byte _ = []++cmapDecodeString :: (Int -> Double) -> UnicodeCMap -> Str -> [(Glyph, Double)]+cmapDecodeString getWidth cmap (Str str) = go str+  where+  go s =+    case unicodeCMapNextGlyph cmap s of+      Nothing -> []+      Just (g, rest) ->+        let width = getWidth g / 1000+            glyph = Glyph {+          glyphCode = g,+          glyphTopLeft = Vector 0 0,+          glyphBottomRight = Vector width 1,+          glyphText = unicodeCMapDecodeGlyph cmap g+          }+        in (glyph, width) : go rest
+ lib/Pdf/Toolbox/Content/Ops.hs view
@@ -0,0 +1,196 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Content stream operators++module Pdf.Toolbox.Content.Ops+(+  Op(..),+  Expr(..),+  Operator,+  toOp+)+where++import Data.ByteString (ByteString)++import Pdf.Toolbox.Core++-- | Operator with arguments+type Operator = (Op, [Object ()])++-- | Content stream operators+data Op+  -- | Graphics State Operators+  = Op_q+  | Op_Q+  | Op_cm+  | Op_w+  | Op_J+  | Op_j+  | Op_M+  | Op_d+  | Op_ri+  | Op_i+  | Op_gs+  -- | Path Construction Operators+  | Op_m+  | Op_l+  | Op_c+  | Op_v+  | Op_y+  | Op_h+  | Op_re+  -- | Path Painting Operators+  | Op_S+  | Op_s+  | Op_f+  | Op_F+  | Op_f_star+  | Op_B+  | Op_B_star+  | Op_b+  | Op_b_star+  | Op_n+  -- | Clipping Path Operators+  | Op_W+  | Op_W_star+  -- | Text Object Operators+  | Op_BT+  | Op_ET+  -- | Text State Operators+  | Op_Tc+  | Op_Tw+  | Op_Tz+  | Op_TL+  | Op_Tf+  | Op_Tr+  | Op_Ts+  -- | Text Positioning Operators+  | Op_Td+  | Op_TD+  | Op_Tm+  | Op_T_star+  -- | Text Showing Operators+  | Op_Tj+  | Op_apostrophe+  | Op_quote+  | Op_TJ+  -- | Type 3 Font Operators+  | Op_d0+  | Op_d1+  -- | Color Operators+  | Op_CS+  | Op_cs+  | Op_SC+  | Op_SCN+  | Op_sc+  | Op_scn+  | Op_G+  | Op_g+  | Op_RG+  | Op_rg+  | Op_K+  | Op_k+  -- | Shading Operator+  | Op_sh+  -- | Inline Image Operators+  | Op_BI+  | Op_ID+  | Op_EI+  -- | XObject Operator+  | Op_Do+  -- | Marked Content Operators+  | Op_MP+  | Op_DP+  | Op_BMC+  | Op_BDC+  | Op_EMC+  -- | Compatibility Operators+  | Op_BX+  | Op_EX+  -- | Unknown+  | UnknownOp ByteString+  deriving (Show, Eq)++-- | Expression is a regular objects or an operators+data Expr+  = Obj (Object ())+  | Op Op+  deriving (Show, Eq)++-- | Conversion to operator+toOp :: ByteString -> Op+toOp "q" = Op_q+toOp "Q" = Op_Q+toOp "cm" = Op_cm+toOp "w" = Op_w+toOp "J" = Op_J+toOp "j" = Op_j+toOp "M" = Op_M+toOp "d" = Op_d+toOp "ri" = Op_ri+toOp "i" = Op_i+toOp "gs" = Op_gs+toOp "m" = Op_m+toOp "l" = Op_l+toOp "c" = Op_c+toOp "v" = Op_v+toOp "y" = Op_y+toOp "h" = Op_h+toOp "re" = Op_re+toOp "S" = Op_S+toOp "s" = Op_s+toOp "f" = Op_f+toOp "F" = Op_F+toOp "f*" = Op_f_star+toOp "B" = Op_B+toOp "B*" = Op_B_star+toOp "b" = Op_b+toOp "b*" = Op_b_star+toOp "n" = Op_n+toOp "W" = Op_W+toOp "W*" = Op_W_star+toOp "BT" = Op_BT+toOp "ET" = Op_ET+toOp "Tc" = Op_Tc+toOp "Tw" = Op_Tw+toOp "Tz" = Op_Tz+toOp "TL" = Op_TL+toOp "Tf" = Op_Tf+toOp "Tr" = Op_Tr+toOp "Ts" = Op_Ts+toOp "Td" = Op_Td+toOp "TD" = Op_TD+toOp "Tm" = Op_Tm+toOp "T*" = Op_T_star+toOp "Tj" = Op_Tj+toOp "'" = Op_apostrophe+toOp "\"" = Op_quote+toOp "TJ" = Op_TJ+toOp "d0" = Op_d0+toOp "d1" = Op_d1+toOp "CS" = Op_CS+toOp "cs" = Op_cs+toOp "SC" = Op_SC+toOp "SCN" = Op_SCN+toOp "sc" = Op_sc+toOp "scn" = Op_scn+toOp "G" = Op_G+toOp "g" = Op_g+toOp "RG" = Op_RG+toOp "rg" = Op_rg+toOp "K" = Op_K+toOp "k" = Op_k+toOp "sh" = Op_sh+toOp "BI" = Op_BI+toOp "ID" = Op_ID+toOp "EI" = Op_EI+toOp "Do" = Op_Do+toOp "MP" = Op_MP+toOp "DP" = Op_DP+toOp "BMC" = Op_BMC+toOp "BDC" = Op_BDC+toOp "EMC" = Op_EMC+toOp "BX" = Op_BX+toOp "EX" = Op_EX+toOp str = UnknownOp str
+ lib/Pdf/Toolbox/Content/Parser.hs view
@@ -0,0 +1,100 @@++-- | Parse content stream++module Pdf.Toolbox.Content.Parser+(+  parseContentStream,+  readNextOperator+)+where++import Data.Int+import Data.Attoparsec.Char8 (Parser)+import qualified Data.Attoparsec.Char8 as Parser+import Data.IORef+import Control.Applicative+import Control.Exception+import System.IO.Streams (InputStream)+import qualified System.IO.Streams as Streams+import qualified System.IO.Streams.Attoparsec as Streams++import Pdf.Toolbox.Core+import Pdf.Toolbox.Core.Parsers.Object++import Pdf.Toolbox.Content.Ops++-- | Parse content streams for a page+--+-- Note: we need content stream ref to be able to decrypt stream content.+-- We need stream length because it can be an indirect object in+-- stream dictionary+parseContentStream :: MonadIO m+                   => RIS                         -- ^ random input stream to read data from+                   -> [StreamFilter]              -- ^ how to unpack data+                   -> (Ref -> IS -> IO IS)        -- ^ how to decrypt data+                   -> [(Stream Int64, Ref, Int)]  -- ^ content streams (with offset), their refs and length+                   -> PdfE m (InputStream Expr)+parseContentStream ris filters decryptor streams = do+  is <- combineStreams ris filters decryptor streams+  liftIO $ Streams.parserToInputStream parseContent is++-- | Read the next operator if any+readNextOperator :: MonadIO m => InputStream Expr -> PdfE m (Maybe Operator)+readNextOperator is = annotateError "reading the next operator from content stream" $ go []+  where+  go args = do+    expr <- do+      e <- tryPdfIO $ (Right <$> Streams.read is)+        `catch` (\e -> return $ Left $ UnexpectedError $ show (e :: Streams.ParseException))+      case e of+        Right expr -> return expr+        Left er -> left er+    case expr of+      Nothing -> case args of+                   [] -> return Nothing+                   _ -> left $ UnexpectedError $ "Args without op: " ++ show args+      Just (Obj o) -> go (o : args)+      Just (Op o) -> return $ Just (o, reverse args)++combineStreams :: MonadIO m => RIS -> [StreamFilter] -> (Ref -> IS -> IO IS) -> [(Stream Int64, Ref, Int)] -> PdfE m IS+combineStreams _ _ _ [] = liftIO Streams.nullInput+combineStreams ris filters decryptor (x:xs) = do+  reader <- mkReader x xs+  ref <- liftIO $ newIORef reader+  liftIO $ Streams.makeInputStream (doRead ref)+  where+  mkReader (s, ref, len) ss = do+    Stream _ is <- decodedStreamContent ris filters (decryptor ref) len s+    return (is, ss)+  doRead ref = do+    (is, ss) <- liftIO $ readIORef ref+    chunk <- liftIO $ Streams.read is+    case chunk of+      Nothing ->+        case ss of+          [] -> return Nothing+          (h:t) -> do+            reader <- runEitherT $ mkReader h t+            case reader of+              Left e -> liftIO $ ioError $ userError $ show e+              Right r -> do+                liftIO $ writeIORef ref r+                doRead ref+      Just c -> return (Just c)++parseContent :: Parser (Maybe Expr)+parseContent+  = (skipSpace >> Parser.endOfInput >> return Nothing)+  <|> do+    skipSpace+    fmap Just $ fmap Obj parseObject <|> fmap (Op . toOp) (Parser.takeWhile1 isRegularChar)++-- Treat comments as spaces+skipSpace :: Parser ()+skipSpace = do+  Parser.skipSpace+  _ <- many $ do+    _ <- Parser.char '%'+    Parser.skipWhile $ \c -> c /= '\n' && c /= '\r'+    Parser.skipSpace+  return ()
+ lib/Pdf/Toolbox/Content/Processor.hs view
@@ -0,0 +1,294 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Process content stream operators maintaining graphics state+--+-- It is pretty experimental++module Pdf.Toolbox.Content.Processor+(+  Processor(..),+  GraphicsState(..),+  GlyphDecoder,+  Glyph(..),+  initialGraphicsState,+  mkProcessor,+  processOp+)+where++import Data.Monoid+import Data.Text (Text)+import Control.Monad++import Pdf.Toolbox.Core++import Pdf.Toolbox.Content.Ops+import Pdf.Toolbox.Content.Transform++-- | Given font name and string, it should return list of glyphs+-- and their widths.+--+-- Note: it should not try to position or scale glyphs to user space,+-- bounding boxes should be defined in glyph space.+--+-- Note: glyph width is a distance between the glyph's origin and+-- the next glyph's origin, so it generally can't be calculated+-- from bounding box+--+-- Note: the 'Processor' actually doesn't cares about glyph's+-- bounding box, so you can return anything you want+type GlyphDecoder = Name -> Str -> [(Glyph, Double)]++-- | Glyph+data Glyph = Glyph {+  -- | The code as read from content stream+  glyphCode :: Int,+  -- | Top-left corner of glyph's bounding box+  glyphTopLeft :: Vector Double,+  -- | Bottom-right corner of glyph's bounding box+  glyphBottomRight :: Vector Double,+  -- | Text ectracted from the glyph+  glyphText :: Maybe Text+  }+  deriving Show++-- | Graphics state+data GraphicsState = GraphicsState {+  gsInText :: Bool,    -- ^ Indicates that we are inside text object+  gsCurrentTransformMatrix :: Transform Double,+  gsFont :: Maybe Name,+  gsFontSize :: Maybe Double,+  gsTextMatrix :: Transform Double,      -- ^ Defined only inside text object+  gsTextLineMatrix :: Transform Double,  -- ^ Defined only inside text object+  gsTextLeading :: Double,+  gsTextCharSpacing :: Double,+  gsTextWordSpacing :: Double+  }+  deriving Show++-- | Empty graphics state+initialGraphicsState :: GraphicsState+initialGraphicsState = GraphicsState {+  gsInText = False,+  gsCurrentTransformMatrix = identity,+  gsFont = Nothing,+  gsFontSize = Nothing,+  gsTextMatrix = identity,+  gsTextLineMatrix = identity,+  gsTextLeading = 0,+  gsTextCharSpacing = 0,+  gsTextWordSpacing = 0+  }++-- | Processor maintains graphics state+data Processor = Processor {+  prState :: GraphicsState,+  prStateStack :: [GraphicsState],+  prGlyphDecoder :: GlyphDecoder,+  prGlyphs :: [[Glyph]]         -- ^ Each element is a list of glyphs, drawn in one shot+  }++-- | Create processor in initial state+mkProcessor :: Processor+mkProcessor = Processor {+  prState = initialGraphicsState,+  prStateStack = [],+  prGlyphDecoder = \_ _ -> [],+  prGlyphs = mempty+  }++-- | Process one operation+processOp :: Monad m => Operator -> Processor -> PdfE m Processor++processOp (Op_q, []) p = return p {prStateStack = prState p : prStateStack p}+processOp (Op_q, args) _ = left $ UnexpectedError $ "Op_q: wrong number of arguments: " ++ show args++processOp (Op_Q, []) p =+  case prStateStack p of+    [] -> left $ UnexpectedError "Op_Q: state is empty"+    (x:xs) -> return p {prState = x, prStateStack = xs}+processOp (Op_Q, args) _ = left $ UnexpectedError $ "Op_Q: wrong number of arguments: " ++ show args++processOp (Op_BT, []) p = do+  ensureInTextObject False p+  let gstate = prState p+  return p {prState = gstate {+    gsInText = True,+    gsTextMatrix = identity,+    gsTextLineMatrix = identity+    }}+processOp (Op_BT, args) _ = left $ UnexpectedError $ "Op_BT: wrong number of arguments: " ++ show args++processOp (Op_ET, []) p = do+  ensureInTextObject True p+  let gstate = prState p+  return p {prState = gstate {+    gsInText = False+    }}+processOp (Op_ET, args) _ = left $ UnexpectedError $ "Op_ET: wrong number of arguments: " ++ show args++processOp (Op_Td, [txo, tyo]) p = do+  ensureInTextObject True p+  tx <- fromObject txo >>= realValue+  ty <- fromObject tyo >>= realValue+  let gstate = prState p+      tm = translate tx ty $ gsTextLineMatrix gstate+  return p {prState = gstate {+    gsTextMatrix = tm,+    gsTextLineMatrix = tm+    }}+processOp (Op_Td, args) _ = left $ UnexpectedError $ "Op_Td: wrong number of arguments: " ++ show args++processOp (Op_TD, [txo, tyo]) p = do+  l <- fromObject tyo >>= realValue+  p' <- processOp (Op_TL, [ONumber $ NumReal $ negate l]) p+  processOp (Op_Td, [txo, tyo]) p'+processOp (Op_TD, args) _ = left $ UnexpectedError $ "Op_TD: wrong number of arguments: " ++ show args++processOp (Op_Tm, [a', b', c', d', e', f']) p = do+  ensureInTextObject True p+  a <- fromObject a' >>= realValue+  b <- fromObject b' >>= realValue+  c <- fromObject c' >>= realValue+  d <- fromObject d' >>= realValue+  e <- fromObject e' >>= realValue+  f <- fromObject f' >>= realValue+  let gstate = prState p+      tm = Transform a b c d e f+  return p {prState = gstate {+    gsTextMatrix = tm,+    gsTextLineMatrix = tm+    }}+processOp (Op_Tm, args) _ = left $ UnexpectedError $ "Op_Tm: wrong number of arguments: " ++ show args++processOp (Op_T_star, []) p = do+  ensureInTextObject True p+  let gstate = prState p+      l = gsTextLeading gstate+  processOp (Op_TD, map (ONumber . NumReal) [0, negate l]) p+processOp (Op_T_star, args) _ = left $ UnexpectedError $ "Op_T_star: wrong number of arguments: " ++ show args++processOp (Op_TL, [lo]) p = do+  l <- fromObject lo >>= realValue+  let gstate = prState p+  return p {prState = gstate {+    gsTextLeading = l+    }}+processOp (Op_TL, args) _ = left $ UnexpectedError $ "Op_TL: wrong number of arguments: " ++ show args++processOp (Op_cm, [a', b', c', d', e', f']) p = do+  a <- fromObject a' >>= realValue+  b <- fromObject b' >>= realValue+  c <- fromObject c' >>= realValue+  d <- fromObject d' >>= realValue+  e <- fromObject e' >>= realValue+  f <- fromObject f' >>= realValue+  let gstate = prState p+      ctm = Transform a b c d e f `multiply` gsCurrentTransformMatrix gstate+  return p {prState = gstate {+    gsCurrentTransformMatrix = ctm+    }}+processOp (Op_cm, args) _ = left $ UnexpectedError $ "Op_cm: wrong number of arguments: " ++ show args++processOp (Op_Tf, [fontO, szO]) p = do+  font <- fromObject fontO+  sz <- fromObject szO >>= realValue+  let gstate = prState p+  return p {prState = gstate {+    gsFont = Just font,+    gsFontSize = Just sz+    }}+processOp (Op_Tf, args) _ = left $ UnexpectedError $ "Op_Tf: wrong number of agruments: " ++ show args++processOp (Op_Tj, [OStr str]) p = do+  let gstate = prState p+  fontName <-+    case gsFont gstate of+      Nothing -> left $ UnexpectedError "Op_Tj: font not set"+      Just fn -> return fn+  fontSize <-+    case gsFontSize gstate of+      Nothing -> left $ UnexpectedError "Op_Tj: font size not set"+      Just fs -> return fs+  let (tm, glyphs) = positionGlyghs fontSize (gsCurrentTransformMatrix gstate)+                       (gsTextMatrix gstate) (gsTextCharSpacing gstate) (gsTextWordSpacing gstate) $+                       prGlyphDecoder p fontName str+  return p {+    prGlyphs = prGlyphs p ++ [glyphs],+    prState = gstate {+      gsTextMatrix = tm+      }+    }+processOp (Op_Tj, args) _ = left $ UnexpectedError $ "Op_Tj: wrong number of agruments:" ++ show args++processOp (Op_TJ, [OArray (Array array)]) p = do+  let gstate = prState p+  fontName <-+    case gsFont gstate of+      Nothing -> left $ UnexpectedError "Op_Tj: font not set"+      Just fn -> return fn+  fontSize <-+    case gsFontSize gstate of+      Nothing -> left $ UnexpectedError "Op_Tj: font size not set"+      Just fs -> return fs+  let (textMatrix, glyphs) = loop (gsTextMatrix gstate) [] array+        where+        loop tm res [] = (tm, reverse res)+        loop tm res (OStr str : rest) = let (tm', gs) = positionGlyghs fontSize (gsCurrentTransformMatrix gstate)+                                                          tm (gsTextCharSpacing gstate) (gsTextWordSpacing gstate)+                                                          (prGlyphDecoder p fontName str)+                                        in loop tm' (gs : res) rest+        loop tm res (ONumber (NumInt i): rest) = loop (translate (fromIntegral (-i) * fontSize / 1000) 0 tm) res rest+        loop tm res (ONumber (NumReal d): rest) = loop (translate (-d * fontSize / 1000) 0 tm) res rest+        loop tm res (_:rest) = loop tm res rest+  return p {+    prGlyphs = prGlyphs p ++ glyphs,+    prState = gstate {+      gsTextMatrix = textMatrix+      }+    }+processOp (Op_TJ, args) _ = left $ UnexpectedError $ "Op_TJ: wrong number of agruments:" ++ show args++processOp (Op_Tc, [o]) p = do+  spacing <- fromObject o >>= realValue+  let gstate = prState p+  return p {+    prState = gstate {+      gsTextCharSpacing = spacing+      }+    }+processOp (Op_Tc, args) _ = left $ UnexpectedError $ "Op_Tc: wrong number of agruments:" ++ show args++processOp (Op_Tw, [o]) p = do+  spacing <- fromObject o >>= realValue+  let gstate = prState p+  return p {+    prState = gstate {+      gsTextWordSpacing = spacing+      }+    }+processOp (Op_Tw, args) _ = left $ UnexpectedError $ "Op_Tw: wrong number of agruments:" ++ show args++processOp _ p = return p++ensureInTextObject :: Monad m => Bool -> Processor -> PdfE m ()+ensureInTextObject inText p =+  unless (inText == gsInText (prState p)) $ left $+    UnexpectedError $ "ensureInTextObject: expected: " ++ show inText ++ ", found: " ++ show (gsInText $ prState p)++positionGlyghs :: Double -> Transform Double -> Transform Double -> Double -> Double -> [(Glyph, Double)] -> (Transform Double, [Glyph])+positionGlyghs fontSize ctm textMatrix charSpacing wordSpacing = go textMatrix []+  where+  go tm res [] = (tm, reverse res)+  go tm res ((g, width):gs) =+    let g' = g {+          glyphTopLeft = transform (multiply tm ctm) topLeft,+          glyphBottomRight = transform (multiply tm ctm) bottomRight+          }+        topLeft = transform (scale fontSize fontSize) $ glyphTopLeft g+        bottomRight = transform (scale fontSize fontSize) $ glyphBottomRight g+        spacing = charSpacing + case glyphText g of+                                  Just " " -> wordSpacing+                                  _ -> 0+        tm' = translate (width * fontSize + spacing) 0 tm+    in go tm' (g':res) gs
+ lib/Pdf/Toolbox/Content/Transform.hs view
@@ -0,0 +1,54 @@++-- | 2d affine transform++module Pdf.Toolbox.Content.Transform+(+  Transform(..),+  Vector(..),+  identity,+  translation,+  scale,+  transform,+  translate,+  multiply+)+where++-- | Affine transform+data Transform a = Transform a a a a a a+  deriving Show++-- | 2d vector/point+data Vector a = Vector a a+  deriving Show++-- | Identity transform+identity :: Num a => Transform a+identity = Transform 1 0 0 1 0 0++-- | Translation+translation :: Num a => a -> a -> Transform a+translation tx ty = Transform 1 0 0 1 tx ty++-- | Scale+scale :: Num a => a -> a -> Transform a+scale sx sy = Transform sx 0 0 sy 0 0++-- | Apply transformation to vector+transform :: Num a => Transform a -> Vector a -> Vector a+transform (Transform a b c d e f) (Vector x y) = Vector (a * x + c * y + e) (b * x + d * y + f)++-- | Translate+translate :: Num a => a -> a -> Transform a -> Transform a+translate tx ty t = translation tx ty `multiply` t++-- | Combine two transformations+multiply :: Num a => Transform a -> Transform a -> Transform a+multiply (Transform a1 b1 c1 d1 e1 f1) (Transform a2 b2 c2 d2 e2 f2) = Transform a b c d e f+  where+  a = a1 * a2 + b1 * c2+  b = a1 * b2 + b1 * d2+  c = c1 * a2 + d1 * c2+  d = c1 * b2 + d1 * d2+  e = e1 * a2 + f1 * c2 + e2+  f = e1 * b2 + f1 * d2 + f2
+ lib/Pdf/Toolbox/Content/UnicodeCMap.hs view
@@ -0,0 +1,161 @@+{-# LANGUAGE OverloadedStrings #-}++-- | Unicode CMap defines mapping from glyphs to text++module Pdf.Toolbox.Content.UnicodeCMap+(+  UnicodeCMap(..),+  parseUnicodeCMap,+  unicodeCMapNextGlyph,+  unicodeCMapDecodeGlyph+)+where++import Data.Char+import Data.Map (Map)+import qualified Data.Map as Map+import Data.ByteString (ByteString)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Base16 as Base16+import Data.Text (Text)+import qualified Data.Text as Text+import qualified Data.Text.Encoding as Text+import Data.Attoparsec.Char8 (Parser, parseOnly)+import qualified Data.Attoparsec.Char8 as P+import Control.Monad++-- | Unicode character map+--+-- Font dictionary can contain \"ToUnicode\" key -- reference+-- to a stream with unicode CMap+data UnicodeCMap = UnicodeCMap {+  unicodeCMapCodeRanges :: [(ByteString, ByteString)],+  unicodeCMapChars :: Map Int Text,+  unicodeCMapRanges :: [(Int, Int, Char)]+  }+  deriving (Show)++-- | Parse content of unicode CMap+parseUnicodeCMap :: ByteString -> Either String UnicodeCMap+parseUnicodeCMap cmap =+  case (codeRanges, chars, ranges) of+    (Right cr, Right cs, Right rs) -> Right $ UnicodeCMap {+      unicodeCMapCodeRanges = cr,+      unicodeCMapChars = cs,+      unicodeCMapRanges = rs+      }+    (Left err, _, _) -> Left $ "CMap code ranges: " ++ err+    (_, Left err, _) -> Left $ "CMap chars: " ++ err+    (_, _, Left err) -> Left $ "CMap ranges: " ++ err+  where+  codeRanges = parseOnly codeRangesParser cmap+  chars = parseOnly charsParser cmap+  ranges = parseOnly rangesParser cmap++-- | Take the next glyph code from string, also returns the rest of the string+unicodeCMapNextGlyph :: UnicodeCMap -> ByteString -> Maybe (Int, ByteString)+unicodeCMapNextGlyph cmap = go 1+  where+  go 5 _ = Nothing+  go n str =+    let glyph = BS.take n str in+    if BS.length glyph /= n+      then Nothing+      else if any (inRange glyph) (unicodeCMapCodeRanges cmap)+             then Just (toCode glyph, BS.drop n str)+             else go (n + 1) str+  inRange glyph (start, end) = glyph >= start && glyph <= end++toCode :: ByteString -> Int+toCode bs = fst $ BS.foldr (\b (sm, i) -> (sm + fromIntegral b * i, i * 255)) (0, 1) bs+-- | Convert glyph to text+--+-- Note: one glyph can represent more then one char, e.g. for ligatures+unicodeCMapDecodeGlyph :: UnicodeCMap -> Int -> Maybe Text+unicodeCMapDecodeGlyph cmap glyph =+  case Map.lookup glyph (unicodeCMapChars cmap) of+    Just txt -> Just txt+    Nothing ->+      case filter inRange (unicodeCMapRanges cmap) of+        [(start, _, char)] -> Just (Text.singleton $ toEnum $ (fromEnum char) + (glyph - start))+        _ -> Nothing+  where+  inRange (start, end, _) = glyph >= start && glyph <= end++charsParser :: Parser (Map Int Text)+charsParser = do+  n <- P.option 0 $ skipTillParser $ do+    n <- P.decimal+    P.skipSpace+    _ <- P.string "beginbfchar"+    return n++  chars <- replicateM n $ do+    P.skipSpace+    _ <- P.char '<'+    i <- P.takeTill (== '>') >>= fromHex+    _ <- P.char '>'+    P.skipSpace+    _ <- P.char '<'+    j <- P.takeTill (== '>') >>= fromHex+    _ <- P.char '>'+    return (toCode i, Text.decodeUtf16BE j)++  return $ Map.fromList chars++rangesParser :: Parser [(Int, Int, Char)]+rangesParser = do+  n <- P.option 0 $ skipTillParser $ do+    n <- P.decimal+    P.skipSpace+    _ <- P.string "beginbfrange"+    return n++  replicateM n $ do+    P.skipSpace+    _ <- P.char '<'+    i <- P.takeTill (== '>') >>= fromHex+    _ <- P.char '>'+    P.skipSpace+    _ <- P.char '<'+    j <- P.takeTill (== '>') >>= fromHex+    _ <- P.char '>'+    P.skipSpace+    _ <- P.char '<'+    k <- P.takeTill (== '>') >>= fromHex+    _ <- P.char '>'+    return (toCode i, toCode j, Text.head $ Text.decodeUtf16BE k)++codeRangesParser :: Parser [(ByteString, ByteString)]+codeRangesParser = do+  n <- skipTillParser $ do+    n <- P.decimal+    P.skipSpace+    _ <- P.string "begincodespacerange"+    return n++  replicateM n $ do+    P.skipSpace+    _ <- P.char '<'+    i <- P.takeTill (== '>') >>= fromHex+    _ <- P.char '>'+    P.skipSpace+    _ <- P.char '<'+    j <- P.takeTill (== '>') >>= fromHex+    _ <- P.char '>'+    return (i, j)++fromHex :: Monad m => ByteString -> m ByteString+fromHex hex = do+  let (str, rest) = Base16.decode $ bsToLower hex+  unless (BS.null rest) $+    fail $ "Can't decode hex" ++ show rest+  return str+  where+  bsToLower = BS.map $ fromIntegral . fromEnum . toLower . toEnum . fromIntegral++skipTillParser :: Parser a -> Parser a+skipTillParser p = P.choice [+  p,+  P.anyChar >> skipTillParser p+  ]
+ pdf-toolbox-content.cabal view
@@ -0,0 +1,33 @@+name:                pdf-toolbox-content+version:             0.0.2.0+synopsis:            A collection of tools for processing PDF files+license:             BSD3+license-file:        LICENSE+author:              Yuras Shumovich+maintainer:          Yuras Shumovich <shumovichy@gmail.com>+copyright:           Copyright (c) Yuras Shumovich 2013+category:            PDF+build-type:          Simple+cabal-version:       >=1.8+description:+  Tools for processing PDF content streams++library+  hs-source-dirs:      lib+  exposed-modules:+                       Pdf.Toolbox.Content+                       Pdf.Toolbox.Content.Parser+                       Pdf.Toolbox.Content.Ops+                       Pdf.Toolbox.Content.Processor+                       Pdf.Toolbox.Content.Transform+                       Pdf.Toolbox.Content.UnicodeCMap+                       Pdf.Toolbox.Content.FontInfo+  build-depends:       base ==4.6.*,+                       containers,+                       attoparsec,+                       bytestring,+                       base16-bytestring,+                       text,+                       io-streams,+                       encoding,+                       pdf-toolbox-core ==0.0.2.*