Types.hs

---------------------------------------------------------
-- |
-- Copyright   : (c) alpha 2006
-- License     : BSD-style
--
-- Maintainer  : misc@NOSPAMalpheccar.org
-- Stability   : experimental
-- Portability : portable
--
-- Low level stuff
---------------------------------------------------------
-- #hide
module Graphics.PDF.LowLevel.Types where

import qualified Data.ByteString.Lazy as B
import Data.ByteString.Base(c2w)
import qualified Data.Map as M
import Data.List(intersperse)
import Data.Int
import Text.Printf
import Control.Monad.State
import Control.Monad.Writer

import Data.Encoding
import Data.Encoding.UTF8
import Data.Encoding.ISO88591

-- | PDF Objects
class PdfObject a where
  toPDF :: a -> B.ByteString

-- | Anonymous PDF object
data AnyPdfObject = forall a . PdfObject a => AnyPdfObject a

instance PdfObject AnyPdfObject where
 toPDF (AnyPdfObject a) = toPDF a
 
-- | An integer in a PDF document
newtype PDFInteger = PDFInteger Int deriving(Eq,Show,Ord,Num)

-- | A length in a PDF document
data PDFLength = PDFLength Int64 deriving(Eq,Show,Ord)

instance Num PDFLength where
  (+) (PDFLength a) (PDFLength b) = PDFLength (a+b)
  (*) (PDFLength a) (PDFLength b) = PDFLength (a*b)
  negate (PDFLength a) = PDFLength (negate a)
  abs (PDFLength a) = PDFLength (abs a)
  signum (PDFLength a) = PDFLength (signum a)
  fromInteger a = PDFLength (fromInteger a)

-- | A real number in a PDF document
newtype PDFFloat = PDFFloat Double deriving(Eq,Ord,Num,Fractional,Floating,RealFrac,Real)

instance Show PDFFloat where
    show (PDFFloat x) = printf "%.5f" x

instance PdfObject PDFInteger where
  toPDF (PDFInteger a) = toByteString (show a)
  
instance PdfObject PDFLength where
  toPDF (PDFLength a) = toByteString (show a)
    
instance PdfObject PDFFloat where
  toPDF (PDFFloat a) = toByteString (show a)
  
instance PdfObject Bool where
  toPDF (True) = toByteString "true"
  toPDF (False) = toByteString "false"

-- | A PDFString
newtype PDFString = PDFString B.ByteString deriving(Eq,Ord)

-- | Create a PDF string from an Haskell one
toPDFString :: String -> PDFString
toPDFString = PDFString . encodeLazy ISO88591 . escapeString

-- | Convert an Haskell string to an UTF8 encoded bytestring
toByteString :: String -> B.ByteString
--toByteString = B.pack . encode
toByteString = encodeLazy UTF8

-- | Escape PDF characters which have a special meaning
escapeString :: String -> String
escapeString [] = []
escapeString ('(':l) = '\\':'(':escapeString l
escapeString (')':l) = '\\':')':escapeString l
escapeString ('\\':l) = '\\':'\\':escapeString l
escapeString (a:l) = a:escapeString l

-- Misc strings useful to build bytestrings

lparen :: B.ByteString
lparen = B.singleton . c2w $ '('

rparen :: B.ByteString
rparen = B.singleton . c2w $ ')'

lbracket :: B.ByteString
lbracket = B.singleton . c2w $ '['

rbracket :: B.ByteString
rbracket = B.singleton . c2w $ ']'

bspace :: B.ByteString
bspace = B.singleton . c2w $ ' '

blt :: B.ByteString
blt = B.singleton . c2w $ '<'

bgt :: B.ByteString
bgt = B.singleton . c2w $ '>'

newline :: B.ByteString
newline = B.singleton . c2w $ '\n'

noPdfObject :: B.ByteString
noPdfObject = B.empty

instance PdfObject PDFString where
  toPDF (PDFString a) = B.concat [ lparen
                                 ,  a
                                 , rparen
                                 ]

-- | A PDFName object
newtype PDFName = PDFName String deriving(Eq,Ord)

instance PdfObject PDFName where
 toPDF (PDFName a) = toByteString ("/" ++ a)
 
-- | A PDFArray
type PDFArray = [AnyPdfObject]

instance PdfObject PDFArray where
  toPDF l = B.concat $ (lbracket:intersperse bspace (map toPDF l)) ++ [bspace] ++ [rbracket]
                                 
-- | A PDFDictionary

newtype PDFDictionary = PDFDictionary (M.Map PDFName AnyPdfObject)

instance PdfObject PDFDictionary where
  toPDF (PDFDictionary a) = B.concat $ [blt,blt,newline]
                                       ++ [convertLevel a]
                                       ++ [bgt,bgt] 
   where
     convertLevel _ = let convertItem key value current = B.concat $ [  toPDF key
                                                                      , bspace
                                                                      , toPDF value
                                                                      , newline
                                                                      , current
                                                                      ]
                                                                       
          in 
           M.foldWithKey convertItem B.empty a
           
-- | Am empty dictionary
emptyDictionary :: PDFDictionary
emptyDictionary = PDFDictionary M.empty
           
isEmptyDictionary :: PDFDictionary -> Bool
isEmptyDictionary (PDFDictionary d) = M.null d

insertInPdfDict :: PDFName -> AnyPdfObject -> PDFDictionary -> PDFDictionary
insertInPdfDict key obj (PDFDictionary d) = PDFDictionary $ M.insert key obj d

pdfDictUnion :: PDFDictionary -> PDFDictionary -> PDFDictionary
pdfDictUnion (PDFDictionary a) (PDFDictionary b) = PDFDictionary $ M.union a b

  
-- | A PDF rectangle
data PDFRect = PDFRect !Int !Int !Int !Int
  
instance PdfObject PDFRect where
 toPDF (PDFRect a b c d) = toPDF . map (AnyPdfObject . PDFInteger) $ [a,b,c,d]
 
      
-- | A Referenced objects
data PDFReferencedObject a = PDFReferencedObject !Int !a

instance PdfObject a => PdfObject (PDFReferencedObject a) where
  toPDF (PDFReferencedObject referenceId obj) =
    B.concat $ [ toByteString . show $ referenceId
               , toByteString " 0 obj"
               , newline
               , toPDF obj
               , newline
               , toByteString "endobj"
               , newline , newline
               ]
               
-- | A reference to a PDF object
data PDFReference s = PDFReference !Int deriving(Eq,Ord,Show)

-- | Get the reference value
referenceValue :: PDFReference s -> Int
referenceValue (PDFReference i) = i

instance PdfObject s => Num (PDFReference s) where
  (+) (PDFReference a) (PDFReference b) = PDFReference (a+b)
  (*) (PDFReference a) (PDFReference b) = PDFReference (a*b)
  negate (PDFReference a) = PDFReference (negate a)
  abs (PDFReference a) = PDFReference (abs a)
  signum (PDFReference a) = PDFReference (signum a)
  fromInteger a = PDFReference (fromInteger a)

instance PdfObject s => PdfObject (PDFReference s) where
  toPDF (PDFReference i) = B.concat $ [ toByteString . show $ i
                                      , toByteString " 0 R"]
                                      
                                   
               
instance (PdfObject a,PdfObject b) => PdfObject (Either a b) where
  toPDF (Left a) = toPDF a
  toPDF (Right a) = toPDF a

modifyStrict :: (MonadState s m) => (s -> s) -> m ()
modifyStrict f = do
  	s <- get
  	put $! (f s)
  	
-- | A monad where paths can be created
class MonadWriter B.ByteString m => MonadPath m