diff --git a/src/PDF/Content.hs b/src/PDF/Content.hs index 03f8c33..c9e4a7a 100644 --- a/src/PDF/Content.hs +++ b/src/PDF/Content.hs @@ -12,9 +12,10 @@ import Control.Applicative ((<|>)) import Control.Monad.State (evalStateT, modify) import Data.Attoparsec.ByteString.Char8 (sepBy) import Data.ByteString (ByteString) -import PDF.Object (blank, directObject) -import PDF.Parser (MonadParser, (), evalParser, string) import PDF.Content.Operator (Instruction, operator) +import PDF.Object (blank, directObject) +import PDF.Output (Output(..), line) +import PDF.Parser (MonadParser, (), evalParser, string) data GraphicContextUnit = GraphicInstruction Instruction @@ -55,3 +56,14 @@ parse = evalParser content () textContext :: MonadParser m => m TextContext textContext = string "BT" *> blank *> instruction `sepBy` blank <* blank <* string "ET" + +instance Output Content where + output (Content contentUnits) = output contentUnits + +instance Output ContentUnit where + output (GraphicContext gc) = line "q" `mappend` output gc `mappend` line "Q" + output (TextContext tc) = line "BT" `mappend` output tc `mappend` line "ET" + +instance Output GraphicContextUnit where + output (GraphicInstruction gi) = output gi + output (ContentUnit cu) = output cu diff --git a/src/PDF/Content/Operator.hs b/src/PDF/Content/Operator.hs index abe2cdc..47da602 100644 --- a/src/PDF/Content/Operator.hs +++ b/src/PDF/Content/Operator.hs @@ -1,5 +1,7 @@ {-# LANGUAGE ConstraintKinds #-} {-# LANGUAGE FlexibleContexts #-} +{-# LANGUAGE TypeSynonymInstances #-} +{-# LANGUAGE FlexibleInstances #-} module PDF.Content.Operator ( Instruction , Operator(..) @@ -18,6 +20,7 @@ import qualified PDF.Content.Operator.GraphicState as GraphicState (Operator, si 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) @@ -27,10 +30,18 @@ data Operator = | Path Path.Operator | Color Color.Operator | Text Text.Operator - deriving Show + +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) @@ -39,10 +50,10 @@ operatorsTable = Map.fromList ( ++ (prepare Text <$> Text.signature) ) where - prepare constructor (op, sig) = (code op, (constructor op, sig)) + prepare constructor (op, sig) = (pack $ code op, (constructor op, sig)) -code :: Show a => a -> ByteString -code = pack . expand . show +code :: Show a => a -> String +code = expand . show where expand "" = "" expand (c:'_':s) = toLower c : expand s diff --git a/src/PDF/Content/Text.hs b/src/PDF/Content/Text.hs index da17775..7b6bdb6 100644 --- a/src/PDF/Content/Text.hs +++ b/src/PDF/Content/Text.hs @@ -1,18 +1,20 @@ {-# LANGUAGE OverloadedStrings #-} module PDF.Content.Text ( - renderText + format + , renderText ) where import Control.Monad (foldM) import Control.Monad.Reader (ReaderT, asks, runReaderT) import Control.Monad.State (MonadState(..), StateT, evalStateT) +import Data.ByteString.Char8 (pack) import Data.Map ((!)) import Data.Text (Text) import PDF.Content (Content(..), ContentUnit(..), GraphicContextUnit(..)) import PDF.Content.Operator (Instruction, Operator(..)) import PDF.Content.Operator.Text (Operator(..)) import PDF.Font (Font, FontSet, emptyFont) -import PDF.Object (DirectObject(..), StringObject, toByteString) +import PDF.Object (DirectObject(..), StringObject(..), toByteString) type RenderingContext = ReaderT FontSet (Either String) type TextRenderingContext = StateT Font RenderingContext @@ -60,3 +62,10 @@ renderInstruction (Text DQuote, [StringObject outputString]) = (\t -> ["\n", t]) <$> decodeString outputString renderInstruction _ = return [] + +format :: String -> [Instruction] +format s = + case break (== '\n') s of + ("", "") -> [] + ("", left) -> (Text Tstar, []) : format (drop 1 left) + (line, left) -> (Text Tj, [StringObject . Literal $ pack line]) : format left