77 lines
2.5 KiB
Haskell
77 lines
2.5 KiB
Haskell
{-# LANGUAGE ConstraintKinds #-}
|
|
{-# LANGUAGE FlexibleContexts #-}
|
|
{-# LANGUAGE TypeSynonymInstances #-}
|
|
{-# LANGUAGE FlexibleInstances #-}
|
|
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.Output (Output(..), join, line)
|
|
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
|
|
|
|
instance Show Operator where
|
|
show (GraphicState gcOp) = code gcOp
|
|
show (Path pOp) = code pOp
|
|
show (Color cOp) = code cOp
|
|
show (Text tOp) = code tOp
|
|
|
|
type Instruction = (Operator, [DirectObject])
|
|
|
|
instance Output Instruction where
|
|
output (op, args) = join " " ((output <$> args) ++ [line (show op)])
|
|
|
|
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) = (pack $ code op, (constructor op, sig))
|
|
|
|
code :: Show a => a -> String
|
|
code = 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)
|