{-# LANGUAGE OverloadedStrings #-}
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
type GlyphDecoder = Name -> ByteString -> [(Glyph, Double)]
data Glyph = Glyph {
Glyph -> Int
glyphCode :: Int,
Glyph -> Vector Double
glyphTopLeft :: Vector Double,
Glyph -> Vector Double
glyphBottomRight :: Vector Double,
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
data GraphicsState = GraphicsState {
GraphicsState -> Bool
gsInText :: Bool,
GraphicsState -> Transform Double
gsCurrentTransformMatrix :: Transform Double,
GraphicsState -> Maybe Name
gsFont :: Maybe Name,
GraphicsState -> Maybe Double
gsFontSize :: Maybe Double,
GraphicsState -> Transform Double
gsTextMatrix :: Transform Double,
GraphicsState -> Transform Double
gsTextLineMatrix :: Transform Double,
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
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
}
data Span = Span
{ Span -> [Glyph]
spGlyphs :: [Glyph]
, Span -> Name
spFontName :: Name
}
data Processor = Processor {
Processor -> GraphicsState
prState :: GraphicsState,
Processor -> [GraphicsState]
prStateStack :: [GraphicsState],
Processor -> GlyphDecoder
prGlyphDecoder :: GlyphDecoder,
Processor -> [Span]
prSpans :: [Span]
}
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
}
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