Implement output for Content streams

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

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 :: Show a => a -> String
-code = pack . expand . show
+code = expand . show
   where
     expand "" = ""
     expand (c:'_':s) = toLower c : expand s

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