{-# LANGUAGE OverloadedStrings #-}

-- | Process content stream operators maintaining graphics state
--
-- It is pretty experimental

module Pdf.Content.Processor
(
  Processor(..),
  GraphicsState(..),
  GlyphDecoder,
  Glyph(..),
  Span(..),
  initialGraphicsState,
  mkProcessor,
  processOp
)
where

import Pdf.Core
import Pdf.Core.Object.Util
import Pdf.Core.Util

import Pdf.Content.Ops
import Pdf.Content.Transform

import Data.ByteString (ByteString)
import Data.Text (Text)
import qualified Data.Scientific as Scientific
import qualified Data.Vector as Vector
import Control.Monad

-- | 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 -> ByteString -> [(Glyph, Double)]

-- | Glyph
data Glyph = Glyph {
  -- | The code as read from content stream
  Glyph -> Int
glyphCode :: Int,
  -- | Top-left corner of glyph's bounding box
  Glyph -> Vector Double
glyphTopLeft :: Vector Double,
  -- | Bottom-right corner of glyph's bounding box
  Glyph -> Vector Double
glyphBottomRight :: Vector Double,
  -- | Text ectracted from the glyph
  Glyph -> Maybe Text
glyphText :: Maybe Text
  }
  deriving Int -> Glyph -> ShowS
[Glyph] -> ShowS
Glyph -> String
(Int -> Glyph -> ShowS)
-> (Glyph -> String) -> ([Glyph] -> ShowS) -> Show Glyph
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Glyph] -> ShowS
$cshowList :: [Glyph] -> ShowS
show :: Glyph -> String
$cshow :: Glyph -> String
showsPrec :: Int -> Glyph -> ShowS
$cshowsPrec :: Int -> Glyph -> ShowS
Show

-- | Graphics state
data GraphicsState = GraphicsState {
  GraphicsState -> Bool
gsInText :: Bool,    -- ^ Indicates that we are inside text object
  GraphicsState -> Transform Double
gsCurrentTransformMatrix :: Transform Double,
  GraphicsState -> Maybe Name
gsFont :: Maybe Name,
  GraphicsState -> Maybe Double
gsFontSize :: Maybe Double,
  GraphicsState -> Transform Double
gsTextMatrix :: Transform Double,      -- ^ Defined only inside text object
  GraphicsState -> Transform Double
gsTextLineMatrix :: Transform Double,  -- ^ Defined only inside text object
  GraphicsState -> Double
gsTextLeading :: Double,
  GraphicsState -> Double
gsTextCharSpacing :: Double,
  GraphicsState -> Double
gsTextWordSpacing :: Double
  }
  deriving Int -> GraphicsState -> ShowS
[GraphicsState] -> ShowS
GraphicsState -> String
(Int -> GraphicsState -> ShowS)
-> (GraphicsState -> String)
-> ([GraphicsState] -> ShowS)
-> Show GraphicsState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GraphicsState] -> ShowS
$cshowList :: [GraphicsState] -> ShowS
show :: GraphicsState -> String
$cshow :: GraphicsState -> String
showsPrec :: Int -> GraphicsState -> ShowS
$cshowsPrec :: Int -> GraphicsState -> ShowS
Show

-- | Empty graphics state
initialGraphicsState :: GraphicsState
initialGraphicsState :: GraphicsState
initialGraphicsState = GraphicsState :: Bool
-> Transform Double
-> Maybe Name
-> Maybe Double
-> Transform Double
-> Transform Double
-> Double
-> Double
-> Double
-> GraphicsState
GraphicsState {
  gsInText :: Bool
gsInText = Bool
False,
  gsCurrentTransformMatrix :: Transform Double
gsCurrentTransformMatrix = Transform Double
forall a. Num a => Transform a
identity,
  gsFont :: Maybe Name
gsFont = Maybe Name
forall a. Maybe a
Nothing,
  gsFontSize :: Maybe Double
gsFontSize = Maybe Double
forall a. Maybe a
Nothing,
  gsTextMatrix :: Transform Double
gsTextMatrix = Transform Double
forall a. Num a => Transform a
identity,
  gsTextLineMatrix :: Transform Double
gsTextLineMatrix = Transform Double
forall a. Num a => Transform a
identity,
  gsTextLeading :: Double
gsTextLeading = Double
0,
  gsTextCharSpacing :: Double
gsTextCharSpacing = Double
0,
  gsTextWordSpacing :: Double
gsTextWordSpacing = Double
0
  }

-- | Glyphs drawn in one shot
data Span = Span
  { Span -> [Glyph]
spGlyphs :: [Glyph]
  , Span -> Name
spFontName :: Name
  }

-- | Processor maintains graphics state
data Processor = Processor {
  Processor -> GraphicsState
prState :: GraphicsState,
  Processor -> [GraphicsState]
prStateStack :: [GraphicsState],
  Processor -> GlyphDecoder
prGlyphDecoder :: GlyphDecoder,
  Processor -> [Span]
prSpans :: [Span]
  -- ^ Each element is a list of glyphs, drawn in one shot
  }

-- | Create processor in initial state
mkProcessor :: Processor
mkProcessor :: Processor
mkProcessor = Processor :: GraphicsState
-> [GraphicsState] -> GlyphDecoder -> [Span] -> Processor
Processor {
  prState :: GraphicsState
prState = GraphicsState
initialGraphicsState,
  prStateStack :: [GraphicsState]
prStateStack = [],
  prGlyphDecoder :: GlyphDecoder
prGlyphDecoder = \Name
_ ByteString
_ -> [],
  prSpans :: [Span]
prSpans = [Span]
forall a. Monoid a => a
mempty
  }

-- | Process one operation
processOp :: Operator -> Processor -> Either String Processor

processOp :: Operator -> Processor -> Either String Processor
processOp (Op
Op_q, []) Processor
p = Processor -> Either String Processor
forall a b. b -> Either a b
Right Processor
p {prStateStack :: [GraphicsState]
prStateStack = Processor -> GraphicsState
prState Processor
p GraphicsState -> [GraphicsState] -> [GraphicsState]
forall a. a -> [a] -> [a]
: Processor -> [GraphicsState]
prStateStack Processor
p}
processOp (Op
Op_q, [Object]
args) Processor
_ = String -> Either String Processor
forall a b. a -> Either a b
Left (String
"Op_q: wrong number of arguments: "
                                String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Object] -> String
forall a. Show a => a -> String
show [Object]
args)

processOp (Op
Op_Q, []) Processor
p =
  case Processor -> [GraphicsState]
prStateStack Processor
p of
    [] -> String -> Either String Processor
forall a b. a -> Either a b
Left String
"Op_Q: state is empty"
    (GraphicsState
x:[GraphicsState]
xs) -> Processor -> Either String Processor
forall a b. b -> Either a b
Right Processor
p {prState :: GraphicsState
prState = GraphicsState
x, prStateStack :: [GraphicsState]
prStateStack = [GraphicsState]
xs}
processOp (Op
Op_Q, [Object]
args) Processor
_ = String -> Either String Processor
forall a b. a -> Either a b
Left (String
"Op_Q: wrong number of arguments: "
                                String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Object] -> String
forall a. Show a => a -> String
show [Object]
args)

processOp (Op
Op_BT, []) Processor
p = do
  Bool -> Processor -> Either String ()
ensureInTextObject Bool
False Processor
p
  let gstate :: GraphicsState
gstate = Processor -> GraphicsState
prState Processor
p
  Processor -> Either String Processor
forall (m :: * -> *) a. Monad m => a -> m a
return Processor
p {prState :: GraphicsState
prState = GraphicsState
gstate {
    gsInText :: Bool
gsInText = Bool
True,
    gsTextMatrix :: Transform Double
gsTextMatrix = Transform Double
forall a. Num a => Transform a
identity,
    gsTextLineMatrix :: Transform Double
gsTextLineMatrix = Transform Double
forall a. Num a => Transform a
identity
    }}
processOp (Op
Op_BT, [Object]
args) Processor
_ = String -> Either String Processor
forall a b. a -> Either a b
Left (String
"Op_BT: wrong number of arguments: "
                                  String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Object] -> String
forall a. Show a => a -> String
show [Object]
args)

processOp (Op
Op_ET, []) Processor
p = do
  Bool -> Processor -> Either String ()
ensureInTextObject Bool
True Processor
p
  let gstate :: GraphicsState
gstate = Processor -> GraphicsState
prState Processor
p
  Processor -> Either String Processor
forall (m :: * -> *) a. Monad m => a -> m a
return Processor
p {prState :: GraphicsState
prState = GraphicsState
gstate {
    gsInText :: Bool
gsInText = Bool
False
    }}
processOp (Op
Op_ET, [Object]
args) Processor
_ = String -> Either String Processor
forall a b. a -> Either a b
Left (String
"Op_ET: wrong number of arguments: "
                                  String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Object] -> String
forall a. Show a => a -> String
show [Object]
args)

processOp (Op
Op_Td, [Object
txo, Object
tyo]) Processor
p = do
  Bool -> Processor -> Either String ()
ensureInTextObject Bool
True Processor
p
  Double
tx <- Object -> Maybe Double
realValue Object
txo Maybe Double -> String -> Either String Double
forall a. Maybe a -> String -> Either String a
`notice` String
"Td: x should be a real value"
  Double
ty <- Object -> Maybe Double
realValue Object
tyo Maybe Double -> String -> Either String Double
forall a. Maybe a -> String -> Either String a
`notice` String
"Td: y should be a real value"
  let gstate :: GraphicsState
gstate = Processor -> GraphicsState
prState Processor
p
      tm :: Transform Double
tm = Double -> Double -> Transform Double -> Transform Double
forall a. Num a => a -> a -> Transform a -> Transform a
translate Double
tx Double
ty (Transform Double -> Transform Double)
-> Transform Double -> Transform Double
forall a b. (a -> b) -> a -> b
$ GraphicsState -> Transform Double
gsTextLineMatrix GraphicsState
gstate
  Processor -> Either String Processor
forall a b. b -> Either a b
Right Processor
p {prState :: GraphicsState
prState = GraphicsState
gstate {
    gsTextMatrix :: Transform Double
gsTextMatrix = Transform Double
tm,
    gsTextLineMatrix :: Transform Double
gsTextLineMatrix = Transform Double
tm
    }}
processOp (Op
Op_Td, [Object]
args) Processor
_ = String -> Either String Processor
forall a b. a -> Either a b
Left (String
"Op_Td: wrong number of arguments: "
                                  String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Object] -> String
forall a. Show a => a -> String
show [Object]
args)

processOp (Op
Op_TD, [Object
txo, Object
tyo]) Processor
p = do
  Double
l <- Object -> Maybe Double
realValue Object
tyo Maybe Double -> String -> Either String Double
forall a. Maybe a -> String -> Either String a
`notice` String
"TD: y should be a real value"
  Processor
p' <- Operator -> Processor -> Either String Processor
processOp (Op
Op_TL, [Scientific -> Object
Number (Scientific -> Object) -> Scientific -> Object
forall a b. (a -> b) -> a -> b
$ Double -> Scientific
forall a. RealFloat a => a -> Scientific
Scientific.fromFloatDigits (Double -> Scientific) -> Double -> Scientific
forall a b. (a -> b) -> a -> b
$ Double -> Double
forall a. Num a => a -> a
negate Double
l]) Processor
p
  Operator -> Processor -> Either String Processor
processOp (Op
Op_Td, [Object
txo, Object
tyo]) Processor
p'
processOp (Op
Op_TD, [Object]
args) Processor
_ = String -> Either String Processor
forall a b. a -> Either a b
Left (String
"Op_TD: wrong number of arguments: "
                                  String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Object] -> String
forall a. Show a => a -> String
show [Object]
args)

processOp (Op
Op_Tm, [Object
a', Object
b', Object
c', Object
d', Object
e', Object
f']) Processor
p = do
  Bool -> Processor -> Either String ()
ensureInTextObject Bool
True Processor
p
  Double
a <- Object -> Maybe Double
realValue Object
a' Maybe Double -> String -> Either String Double
forall a. Maybe a -> String -> Either String a
`notice` String
"Tm: a should be a real value"
  Double
b <- Object -> Maybe Double
realValue Object
b' Maybe Double -> String -> Either String Double
forall a. Maybe a -> String -> Either String a
`notice` String
"Tm: b should be a real value"
  Double
c <- Object -> Maybe Double
realValue Object
c' Maybe Double -> String -> Either String Double
forall a. Maybe a -> String -> Either String a
`notice` String
"Tm: c should be a real value"
  Double
d <- Object -> Maybe Double
realValue Object
d' Maybe Double -> String -> Either String Double
forall a. Maybe a -> String -> Either String a
`notice` String
"Tm: d should be a real value"
  Double
e <- Object -> Maybe Double
realValue Object
e' Maybe Double -> String -> Either String Double
forall a. Maybe a -> String -> Either String a
`notice` String
"Tm: e should be a real value"
  Double
f <- Object -> Maybe Double
realValue Object
f' Maybe Double -> String -> Either String Double
forall a. Maybe a -> String -> Either String a
`notice` String
"Tm: f should be a real value"
  let gstate :: GraphicsState
gstate = Processor -> GraphicsState
prState Processor
p
      tm :: Transform Double
tm = Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> Transform Double
forall a. a -> a -> a -> a -> a -> a -> Transform a
Transform Double
a Double
b Double
c Double
d Double
e Double
f
  Processor -> Either String Processor
forall (m :: * -> *) a. Monad m => a -> m a
return Processor
p {prState :: GraphicsState
prState = GraphicsState
gstate {
    gsTextMatrix :: Transform Double
gsTextMatrix = Transform Double
tm,
    gsTextLineMatrix :: Transform Double
gsTextLineMatrix = Transform Double
tm
    }}
processOp (Op
Op_Tm, [Object]
args) Processor
_ = String -> Either String Processor
forall a b. a -> Either a b
Left (String
"Op_Tm: wrong number of arguments: "
                                  String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Object] -> String
forall a. Show a => a -> String
show [Object]
args)

processOp (Op
Op_T_star, []) Processor
p = do
  Bool -> Processor -> Either String ()
ensureInTextObject Bool
True Processor
p
  let gstate :: GraphicsState
gstate = Processor -> GraphicsState
prState Processor
p
      l :: Double
l = GraphicsState -> Double
gsTextLeading GraphicsState
gstate
  Operator -> Processor -> Either String Processor
processOp (Op
Op_TD, (Double -> Object) -> [Double] -> [Object]
forall a b. (a -> b) -> [a] -> [b]
map (Scientific -> Object
Number (Scientific -> Object)
-> (Double -> Scientific) -> Double -> Object
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Double -> Scientific
forall a. RealFloat a => a -> Scientific
Scientific.fromFloatDigits) [Double
0, Double -> Double
forall a. Num a => a -> a
negate Double
l]) Processor
p
processOp (Op
Op_T_star, [Object]
args) Processor
_ = String -> Either String Processor
forall a b. a -> Either a b
Left (String
"Op_T_star: wrong number of arguments: "
                                      String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Object] -> String
forall a. Show a => a -> String
show [Object]
args)

processOp (Op
Op_TL, [Object
lo]) Processor
p = do
  Double
l <- Object -> Maybe Double
realValue Object
lo Maybe Double -> String -> Either String Double
forall a. Maybe a -> String -> Either String a
`notice` String
"TL: l should be a real value"
  let gstate :: GraphicsState
gstate = Processor -> GraphicsState
prState Processor
p
  Processor -> Either String Processor
forall (m :: * -> *) a. Monad m => a -> m a
return Processor
p {prState :: GraphicsState
prState = GraphicsState
gstate {
    gsTextLeading :: Double
gsTextLeading = Double
l
    }}
processOp (Op
Op_TL, [Object]
args) Processor
_ = String -> Either String Processor
forall a b. a -> Either a b
Left (String
"Op_TL: wrong number of arguments: "
                                  String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Object] -> String
forall a. Show a => a -> String
show [Object]
args)

processOp (Op
Op_cm, [Object
a', Object
b', Object
c', Object
d', Object
e', Object
f']) Processor
p = do
  Double
a <- Object -> Maybe Double
realValue Object
a' Maybe Double -> String -> Either String Double
forall a. Maybe a -> String -> Either String a
`notice` String
"cm: a should be a real value"
  Double
b <- Object -> Maybe Double
realValue Object
b' Maybe Double -> String -> Either String Double
forall a. Maybe a -> String -> Either String a
`notice` String
"cm: b should be a real value"
  Double
c <- Object -> Maybe Double
realValue Object
c' Maybe Double -> String -> Either String Double
forall a. Maybe a -> String -> Either String a
`notice` String
"cm: c should be a real value"
  Double
d <- Object -> Maybe Double
realValue Object
d' Maybe Double -> String -> Either String Double
forall a. Maybe a -> String -> Either String a
`notice` String
"cm: d should be a real value"
  Double
e <- Object -> Maybe Double
realValue Object
e' Maybe Double -> String -> Either String Double
forall a. Maybe a -> String -> Either String a
`notice` String
"cm: e should be a real value"
  Double
f <- Object -> Maybe Double
realValue Object
f' Maybe Double -> String -> Either String Double
forall a. Maybe a -> String -> Either String a
`notice` String
"cm: f should be a real value"
  let gstate :: GraphicsState
gstate = Processor -> GraphicsState
prState Processor
p
      ctm :: Transform Double
ctm = Double
-> Double
-> Double
-> Double
-> Double
-> Double
-> Transform Double
forall a. a -> a -> a -> a -> a -> a -> Transform a
Transform Double
a Double
b Double
c Double
d Double
e Double
f Transform Double -> Transform Double -> Transform Double
forall a. Num a => Transform a -> Transform a -> Transform a
`multiply` GraphicsState -> Transform Double
gsCurrentTransformMatrix GraphicsState
gstate
  Processor -> Either String Processor
forall (m :: * -> *) a. Monad m => a -> m a
return Processor
p {prState :: GraphicsState
prState = GraphicsState
gstate {
    gsCurrentTransformMatrix :: Transform Double
gsCurrentTransformMatrix = Transform Double
ctm
    }}
processOp (Op
Op_cm, [Object]
args) Processor
_ = String -> Either String Processor
forall a b. a -> Either a b
Left (String
"Op_cm: wrong number of arguments: "
                                  String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Object] -> String
forall a. Show a => a -> String
show [Object]
args)

processOp (Op
Op_Tf, [Object
fontO, Object
szO]) Processor
p = do
  Name
font <- Object -> Maybe Name
nameValue Object
fontO Maybe Name -> String -> Either String Name
forall a. Maybe a -> String -> Either String a
`notice` String
"Tf: font should be a name"
  Double
sz <- Object -> Maybe Double
realValue Object
szO Maybe Double -> String -> Either String Double
forall a. Maybe a -> String -> Either String a
`notice` String
"Tf: size should be a real value"
  let gstate :: GraphicsState
gstate = Processor -> GraphicsState
prState Processor
p
  Processor -> Either String Processor
forall (m :: * -> *) a. Monad m => a -> m a
return Processor
p {prState :: GraphicsState
prState = GraphicsState
gstate {
    gsFont :: Maybe Name
gsFont = Name -> Maybe Name
forall a. a -> Maybe a
Just Name
font,
    gsFontSize :: Maybe Double
gsFontSize = Double -> Maybe Double
forall a. a -> Maybe a
Just Double
sz
    }}
processOp (Op
Op_Tf, [Object]
args) Processor
_ = String -> Either String Processor
forall a b. a -> Either a b
Left (String
"Op_Tf: wrong number of agruments: "
                                  String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Object] -> String
forall a. Show a => a -> String
show [Object]
args)

processOp (Op
Op_Tj, [String ByteString
str]) Processor
p = do
  let gstate :: GraphicsState
gstate = Processor -> GraphicsState
prState Processor
p
  Name
fontName <-
    case GraphicsState -> Maybe Name
gsFont GraphicsState
gstate of
      Maybe Name
Nothing -> String -> Either String Name
forall a b. a -> Either a b
Left String
"Op_Tj: font not set"
      Just Name
fn -> Name -> Either String Name
forall (m :: * -> *) a. Monad m => a -> m a
return Name
fn
  Double
fontSize <-
    case GraphicsState -> Maybe Double
gsFontSize GraphicsState
gstate of
      Maybe Double
Nothing -> String -> Either String Double
forall a b. a -> Either a b
Left String
"Op_Tj: font size not set"
      Just Double
fs -> Double -> Either String Double
forall (m :: * -> *) a. Monad m => a -> m a
return Double
fs
  let (Transform Double
tm, [Glyph]
glyphs) = Double
-> Transform Double
-> Transform Double
-> Double
-> Double
-> [(Glyph, Double)]
-> (Transform Double, [Glyph])
positionGlyghs
                       Double
fontSize
                       (GraphicsState -> Transform Double
gsCurrentTransformMatrix GraphicsState
gstate)
                       (GraphicsState -> Transform Double
gsTextMatrix GraphicsState
gstate)
                       (GraphicsState -> Double
gsTextCharSpacing GraphicsState
gstate)
                       (GraphicsState -> Double
gsTextWordSpacing GraphicsState
gstate)
                       (Processor -> GlyphDecoder
prGlyphDecoder Processor
p Name
fontName ByteString
str)
  let sp :: Span
sp = Span :: [Glyph] -> Name -> Span
Span
        { spGlyphs :: [Glyph]
spGlyphs = [Glyph]
glyphs
        , spFontName :: Name
spFontName = Name
fontName
        }
  Processor -> Either String Processor
forall (m :: * -> *) a. Monad m => a -> m a
return Processor
p {
    prSpans :: [Span]
prSpans = Span
sp Span -> [Span] -> [Span]
forall a. a -> [a] -> [a]
: Processor -> [Span]
prSpans Processor
p,
    prState :: GraphicsState
prState = GraphicsState
gstate {
      gsTextMatrix :: Transform Double
gsTextMatrix = Transform Double
tm
      }
    }
processOp (Op
Op_Tj, [Object]
args) Processor
_ = String -> Either String Processor
forall a b. a -> Either a b
Left (String
"Op_Tj: wrong number of agruments:"
                                  String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Object] -> String
forall a. Show a => a -> String
show [Object]
args)

processOp (Op
Op_TJ, [Array Array
array]) Processor
p = do
  let gstate :: GraphicsState
gstate = Processor -> GraphicsState
prState Processor
p
  Name
fontName <-
    case GraphicsState -> Maybe Name
gsFont GraphicsState
gstate of
      Maybe Name
Nothing -> String -> Either String Name
forall a b. a -> Either a b
Left String
"Op_Tj: font not set"
      Just Name
fn -> Name -> Either String Name
forall (m :: * -> *) a. Monad m => a -> m a
return Name
fn
  Double
fontSize <-
    case GraphicsState -> Maybe Double
gsFontSize GraphicsState
gstate of
      Maybe Double
Nothing -> String -> Either String Double
forall a b. a -> Either a b
Left String
"Op_Tj: font size not set"
      Just Double
fs -> Double -> Either String Double
forall (m :: * -> *) a. Monad m => a -> m a
return Double
fs
  let (Transform Double
textMatrix, [[Glyph]]
glyphs) = Transform Double
-> [[Glyph]] -> [Object] -> (Transform Double, [[Glyph]])
loop (GraphicsState -> Transform Double
gsTextMatrix GraphicsState
gstate) []
                                  (Array -> [Object]
forall a. Vector a -> [a]
Vector.toList Array
array)
        where
        loop :: Transform Double
-> [[Glyph]] -> [Object] -> (Transform Double, [[Glyph]])
loop Transform Double
tm [[Glyph]]
res [] = (Transform Double
tm, [[Glyph]] -> [[Glyph]]
forall a. [a] -> [a]
reverse [[Glyph]]
res)
        loop Transform Double
tm [[Glyph]]
res (String ByteString
str : [Object]
rest) =
          let (Transform Double
tm', [Glyph]
gs) = Double
-> Transform Double
-> Transform Double
-> Double
-> Double
-> [(Glyph, Double)]
-> (Transform Double, [Glyph])
positionGlyghs Double
fontSize
                                         (GraphicsState -> Transform Double
gsCurrentTransformMatrix GraphicsState
gstate)
                                         Transform Double
tm
                                         (GraphicsState -> Double
gsTextCharSpacing GraphicsState
gstate)
                                         (GraphicsState -> Double
gsTextWordSpacing GraphicsState
gstate)
                                         (Processor -> GlyphDecoder
prGlyphDecoder Processor
p Name
fontName ByteString
str)
          in Transform Double
-> [[Glyph]] -> [Object] -> (Transform Double, [[Glyph]])
loop Transform Double
tm' ([Glyph]
gs [Glyph] -> [[Glyph]] -> [[Glyph]]
forall a. a -> [a] -> [a]
: [[Glyph]]
res) [Object]
rest
        loop Transform Double
tm [[Glyph]]
res (Number Scientific
n : [Object]
rest) =
          let d :: Double
d = Scientific -> Double
forall a. RealFloat a => Scientific -> a
Scientific.toRealFloat Scientific
n
          in Transform Double
-> [[Glyph]] -> [Object] -> (Transform Double, [[Glyph]])
loop (Double -> Double -> Transform Double -> Transform Double
forall a. Num a => a -> a -> Transform a -> Transform a
translate (-Double
d Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
fontSize Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
1000) Double
0 Transform Double
tm) [[Glyph]]
res [Object]
rest
        loop Transform Double
tm [[Glyph]]
res (Object
_:[Object]
rest) = Transform Double
-> [[Glyph]] -> [Object] -> (Transform Double, [[Glyph]])
loop Transform Double
tm [[Glyph]]
res [Object]
rest

  let mkSpan :: [Glyph] -> Span
mkSpan [Glyph]
gs = Span :: [Glyph] -> Name -> Span
Span
        { spGlyphs :: [Glyph]
spGlyphs = [Glyph]
gs
        , spFontName :: Name
spFontName = Name
fontName
        }
  Processor -> Either String Processor
forall (m :: * -> *) a. Monad m => a -> m a
return Processor
p {
    prSpans :: [Span]
prSpans = [Span] -> [Span]
forall a. [a] -> [a]
reverse (([Glyph] -> Span) -> [[Glyph]] -> [Span]
forall a b. (a -> b) -> [a] -> [b]
map [Glyph] -> Span
mkSpan [[Glyph]]
glyphs) [Span] -> [Span] -> [Span]
forall a. [a] -> [a] -> [a]
++ Processor -> [Span]
prSpans Processor
p,
    prState :: GraphicsState
prState = GraphicsState
gstate {
      gsTextMatrix :: Transform Double
gsTextMatrix = Transform Double
textMatrix
      }
    }
processOp (Op
Op_TJ, [Object]
args) Processor
_ = String -> Either String Processor
forall a b. a -> Either a b
Left (String
"Op_TJ: wrong number of agruments:"
                                  String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Object] -> String
forall a. Show a => a -> String
show [Object]
args)

processOp (Op
Op_Tc, [Object
o]) Processor
p = do
  Double
spacing <- Object -> Maybe Double
realValue Object
o Maybe Double -> String -> Either String Double
forall a. Maybe a -> String -> Either String a
`notice` String
"Tc: spacing should be a real value"
  let gstate :: GraphicsState
gstate = Processor -> GraphicsState
prState Processor
p
  Processor -> Either String Processor
forall (m :: * -> *) a. Monad m => a -> m a
return Processor
p {
    prState :: GraphicsState
prState = GraphicsState
gstate {
      gsTextCharSpacing :: Double
gsTextCharSpacing = Double
spacing
      }
    }
processOp (Op
Op_Tc, [Object]
args) Processor
_ = String -> Either String Processor
forall a b. a -> Either a b
Left (String
"Op_Tc: wrong number of agruments:"
                                  String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Object] -> String
forall a. Show a => a -> String
show [Object]
args)

processOp (Op
Op_Tw, [Object
o]) Processor
p = do
  Double
spacing <- Object -> Maybe Double
realValue Object
o Maybe Double -> String -> Either String Double
forall a. Maybe a -> String -> Either String a
`notice` String
"Tw: spacing should be a real value"
  let gstate :: GraphicsState
gstate = Processor -> GraphicsState
prState Processor
p
  Processor -> Either String Processor
forall (m :: * -> *) a. Monad m => a -> m a
return Processor
p {
    prState :: GraphicsState
prState = GraphicsState
gstate {
      gsTextWordSpacing :: Double
gsTextWordSpacing = Double
spacing
      }
    }
processOp (Op
Op_Tw, [Object]
args) Processor
_ = String -> Either String Processor
forall a b. a -> Either a b
Left (String
"Op_Tw: wrong number of agruments:"
                                  String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Object] -> String
forall a. Show a => a -> String
show [Object]
args)

processOp (Op
Op_apostrophe, [Object
o]) Processor
p = do
  Processor
p' <- Operator -> Processor -> Either String Processor
processOp (Op
Op_T_star, []) Processor
p
  Operator -> Processor -> Either String Processor
processOp (Op
Op_Tj, [Object
o]) Processor
p'
processOp (Op
Op_apostrophe, [Object]
args) Processor
_ =
  String -> Either String Processor
forall a b. a -> Either a b
Left (String
"Op_apostrophe: wrong number of agruments:" String -> ShowS
forall a. [a] -> [a] -> [a]
++ [Object] -> String
forall a. Show a => a -> String
show [Object]
args)

processOp Operator
_ Processor
p = Processor -> Either String Processor
forall (m :: * -> *) a. Monad m => a -> m a
return Processor
p

ensureInTextObject :: Bool -> Processor -> Either String ()
ensureInTextObject :: Bool -> Processor -> Either String ()
ensureInTextObject Bool
inText Processor
p =
  Bool -> Either String () -> Either String ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Bool
inText Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
== GraphicsState -> Bool
gsInText (Processor -> GraphicsState
prState Processor
p)) (Either String () -> Either String ())
-> Either String () -> Either String ()
forall a b. (a -> b) -> a -> b
$
    String -> Either String ()
forall a b. a -> Either a b
Left (String -> Either String ()) -> String -> Either String ()
forall a b. (a -> b) -> a -> b
$ String
"ensureInTextObject: expected: " String -> ShowS
forall a. [a] -> [a] -> [a]
++ Bool -> String
forall a. Show a => a -> String
show Bool
inText String -> ShowS
forall a. [a] -> [a] -> [a]
++ String
", found: "
          String -> ShowS
forall a. [a] -> [a] -> [a]
++ Bool -> String
forall a. Show a => a -> String
show (GraphicsState -> Bool
gsInText (GraphicsState -> Bool) -> GraphicsState -> Bool
forall a b. (a -> b) -> a -> b
$ Processor -> GraphicsState
prState Processor
p)

positionGlyghs :: Double
               -> Transform Double
               -> Transform Double
               -> Double
               -> Double
               -> [(Glyph, Double)]
               -> (Transform Double, [Glyph])
positionGlyghs :: Double
-> Transform Double
-> Transform Double
-> Double
-> Double
-> [(Glyph, Double)]
-> (Transform Double, [Glyph])
positionGlyghs Double
fontSize Transform Double
ctm Transform Double
textMatrix Double
charSpacing Double
wordSpacing
  = Transform Double
-> [Glyph] -> [(Glyph, Double)] -> (Transform Double, [Glyph])
go Transform Double
textMatrix []
  where
  go :: Transform Double
-> [Glyph] -> [(Glyph, Double)] -> (Transform Double, [Glyph])
go Transform Double
tm [Glyph]
res [] = (Transform Double
tm, [Glyph] -> [Glyph]
forall a. [a] -> [a]
reverse [Glyph]
res)
  go Transform Double
tm [Glyph]
res ((Glyph
g, Double
width):[(Glyph, Double)]
gs) =
    let g' :: Glyph
g' = Glyph
g {
          glyphTopLeft :: Vector Double
glyphTopLeft = Transform Double -> Vector Double -> Vector Double
forall a. Num a => Transform a -> Vector a -> Vector a
transform (Transform Double -> Transform Double -> Transform Double
forall a. Num a => Transform a -> Transform a -> Transform a
multiply Transform Double
tm Transform Double
ctm) Vector Double
topLeft,
          glyphBottomRight :: Vector Double
glyphBottomRight = Transform Double -> Vector Double -> Vector Double
forall a. Num a => Transform a -> Vector a -> Vector a
transform (Transform Double -> Transform Double -> Transform Double
forall a. Num a => Transform a -> Transform a -> Transform a
multiply Transform Double
tm Transform Double
ctm) Vector Double
bottomRight
          }
        topLeft :: Vector Double
topLeft = Transform Double -> Vector Double -> Vector Double
forall a. Num a => Transform a -> Vector a -> Vector a
transform (Double -> Double -> Transform Double
forall a. Num a => a -> a -> Transform a
scale Double
fontSize Double
fontSize) (Vector Double -> Vector Double) -> Vector Double -> Vector Double
forall a b. (a -> b) -> a -> b
$ Glyph -> Vector Double
glyphTopLeft Glyph
g
        bottomRight :: Vector Double
bottomRight = Transform Double -> Vector Double -> Vector Double
forall a. Num a => Transform a -> Vector a -> Vector a
transform (Double -> Double -> Transform Double
forall a. Num a => a -> a -> Transform a
scale Double
fontSize Double
fontSize) (Vector Double -> Vector Double) -> Vector Double -> Vector Double
forall a b. (a -> b) -> a -> b
$ Glyph -> Vector Double
glyphBottomRight Glyph
g
        spacing :: Double
spacing = Double
charSpacing Double -> Double -> Double
forall a. Num a => a -> a -> a
+ case Glyph -> Maybe Text
glyphText Glyph
g of
                                  Just Text
" " -> Double
wordSpacing
                                  Maybe Text
_ -> Double
0
        tm' :: Transform Double
tm' = Double -> Double -> Transform Double -> Transform Double
forall a. Num a => a -> a -> Transform a -> Transform a
translate (Double
width Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
fontSize Double -> Double -> Double
forall a. Num a => a -> a -> a
+ Double
spacing) Double
0 Transform Double
tm
    in Transform Double
-> [Glyph] -> [(Glyph, Double)] -> (Transform Double, [Glyph])
go Transform Double
tm' (Glyph
g'Glyph -> [Glyph] -> [Glyph]
forall a. a -> [a] -> [a]
:[Glyph]
res) [(Glyph, Double)]
gs