66 lines
2.1 KiB
Haskell
66 lines
2.1 KiB
Haskell
{-# LANGUAGE ConstraintKinds #-}
|
|
{-# LANGUAGE FlexibleContexts #-}
|
|
module PDF.Content.Operator (
|
|
Instruction
|
|
, Operator
|
|
, operator
|
|
) where
|
|
|
|
import Control.Monad.Fail (MonadFail(..))
|
|
import Control.Monad.State (MonadState(..))
|
|
import Data.ByteString.Char8 (ByteString, pack, unpack)
|
|
import Data.Char (toLower)
|
|
import Data.Map (Map, (!?))
|
|
import qualified Data.Map as Map (fromList)
|
|
import qualified PDF.Content.Operator.Color as Color (Operator, signature)
|
|
import PDF.Content.Operator.Common (Signature)
|
|
import qualified PDF.Content.Operator.GraphicState as GraphicState (Operator, signature)
|
|
import qualified PDF.Content.Operator.Path as Path (Operator, signature)
|
|
import qualified PDF.Content.Operator.Text as Text (Operator, signature)
|
|
import PDF.Object (DirectObject, blank, regular)
|
|
import PDF.Parser (MonadParser, takeAll1)
|
|
import Prelude hiding (fail)
|
|
import Text.Printf (printf)
|
|
|
|
data Operator =
|
|
GraphicState GraphicState.Operator
|
|
| Path Path.Operator
|
|
| Color Color.Operator
|
|
| Text Text.Operator
|
|
deriving Show
|
|
|
|
type Instruction = (Operator, [DirectObject])
|
|
|
|
operatorsTable :: Map ByteString (Signature Operator)
|
|
operatorsTable = Map.fromList (
|
|
(prepare GraphicState <$> GraphicState.signature)
|
|
++ (prepare Path <$> Path.signature)
|
|
++ (prepare Color <$> Color.signature)
|
|
++ (prepare Text <$> Text.signature)
|
|
)
|
|
where
|
|
prepare constructor (op, sig) = (code op, (constructor op, sig))
|
|
|
|
code :: Show a => a -> ByteString
|
|
code = pack . expand . show
|
|
where
|
|
expand "" = ""
|
|
expand (c:'_':s) = toLower c : expand s
|
|
expand ('s':'t':'a':'r':s) = '*' : expand s
|
|
expand ('Q':'u':'o':'t':'e':s) = '\'' : expand s
|
|
expand ('D':'Q':'u':'o':'t':'e':s) = '"' : expand s
|
|
expand (c:s) = c : expand s
|
|
|
|
type StackParser m = (MonadState [DirectObject] m, MonadParser m)
|
|
|
|
operator :: StackParser m => m Instruction
|
|
operator = do
|
|
chunk <- takeAll1 regular <* blank
|
|
args <- reverse <$> get
|
|
case operatorsTable !? chunk of
|
|
Just (op, sig)
|
|
| sig args -> return (op, args)
|
|
| otherwise ->
|
|
get >>= fail . printf "Operator %s with stack %s" (show op) . show
|
|
_ -> fail ("Unknown chunk " ++ unpack chunk)
|