diff --git a/Graphics/PDF.hs b/Graphics/PDF.hs
--- a/Graphics/PDF.hs
+++ b/Graphics/PDF.hs
@@ -17,7 +17,7 @@
   , runPdf
   -- ** PDF Common Types
   , PDFRect(..)
-  , PDFFloat(..)
+  , PDFFloat
   , PDFReference
   , PDFString
   , PDFPage
@@ -30,6 +30,7 @@
   , module Graphics.PDF.Colors
   -- ** Geometry
   , module Graphics.PDF.Coordinates
+  , applyMatrix
   -- ** Text
   , module Graphics.PDF.Text
   -- ** Navigation
@@ -161,8 +162,8 @@
 -- | The PDFTrailer
 #ifndef __HADDOCK__
 data PDFTrailer = PDFTrailer 
-  !Int -- ^ Number of PDF objects in the document
-  !(PDFReference PDFCatalog) -- ^ Reference to the PDf catalog
+  !Int -- Number of PDF objects in the document
+  !(PDFReference PDFCatalog) -- Reference to the PDf catalog
   !(PDFDocumentInfo)
 #else
 data PDFTrailer
diff --git a/Graphics/PDF/Coordinates.hs b/Graphics/PDF/Coordinates.hs
--- a/Graphics/PDF/Coordinates.hs
+++ b/Graphics/PDF/Coordinates.hs
@@ -10,68 +10,113 @@
 -- Coordinates for a PDF document
 ---------------------------------------------------------
 
-module Graphics.PDF.Coordinates(
+module Graphics.PDF.Coordinates
+    ( module Data.Complex
     -- * Geometry
     -- ** Types
-      Angle(..)
+    , Angle(..)
+    , Point
     , Matrix(..)
     -- ** Transformations
-    , rotate, translate, scale, identity
-    -- ** Frame of reference operators
-    , applyMatrix
+    , toRadian
+    , dot, scalePt
+    , project, projectX, projectY
+    , pointMatrix
+    , transform
+    , identity, rotate, translate, scale, spiral
     )
     where
 
-import Graphics.PDF.LowLevel.Types
-import Graphics.PDF.Draw
-import Control.Monad.Writer
-
-import Graphics.PDF.LowLevel.Serializer
-import Data.Monoid
+import Data.Complex
+import Graphics.PDF.LowLevel.Types(PDFFloat)
 
 -- | Angle 
-data Angle = Degree PDFFloat -- ^ Angle in degrees
-           | Radian PDFFloat -- ^ Angle in radians
+data Angle = Degree !PDFFloat -- ^ Angle in degrees
+           | Radian !PDFFloat -- ^ Angle in radians
 
+toRadian :: Angle -> PDFFloat
+toRadian (Degree x) = (pi / 180) * x
+toRadian (Radian x) = x
 
+type Point = Complex PDFFloat
 
+-- | Dot product of two points
+-- 'dot (x :+ y) (a :+ b) == x * a  +  y * b'
+-- 'dot z w == magnitude z * magnitude w * cos (phase z - phase w)'
+dot :: (RealFloat t) => Complex t -> Complex t -> t
+dot (x0 :+ y0) (x1 :+ y1) = x0 * x1 + y0 * y1
 
+scalePt :: (RealFloat t) => t -> Complex t -> Complex t
+scalePt a (x :+ y) = a*x :+ a*y 
 
+-- | projects the first point onto the second
+project :: (RealFloat t) => Complex t -> Complex t -> Complex t
+project z w =  scalePt (dot z w / dot w w) w
 
--- | Apply a transformation matrix to the current coordinate frame
-applyMatrix :: Matrix -> Draw ()
-applyMatrix m@(Matrix a b c d e f)  = do
-    multiplyCurrentMatrixWith m
-    tell . mconcat $[ serialize '\n'
-                    , toPDF a
-                    , serialize ' '
-                    , toPDF b
-                    , serialize ' '
-                    , toPDF c
-                    , serialize ' '
-                    , toPDF d
-                    , serialize ' '
-                    , toPDF e
-                    , serialize ' '
-                    , toPDF f
-                    , serialize " cm"
-                    ]
+-- | projects a point onto the x-axis
+projectX :: (RealFloat t) => Complex t -> Complex t
+projectX (x :+ _) = (x :+ 0)
+
+-- | projects a point onto the y-axis
+projectY :: (RealFloat t) => Complex t -> Complex t
+projectY (_ :+ y) = (0 :+ y)
+
+-- | A transformation matrix. An affine transformation a b c d e f
+--
+-- @
+-- a b 0
+-- c d 0
+-- e f 1
+-- @
+       
+data Matrix = Matrix !PDFFloat !PDFFloat !PDFFloat !PDFFloat !PDFFloat !PDFFloat deriving (Eq, Show)
+		
+instance Num Matrix where
+    --  Matrix addition
+    (+) (Matrix ma mb mc md me mf ) (Matrix na nb nc nd ne nf) = 
+         Matrix (ma+na)  (mb+nb)  (mc+nc)  (md+nd)  (me+ne)  (mf+nf)
+    (*) (Matrix ma mb mc md me mf) (Matrix na nb nc nd ne nf) = 
+         Matrix (ma*na+mb*nc)  (ma*nb+mb*nd)  (mc*na+md*nc)  (mc*nb +md*nd)  (me*na+mf*nc+ne)  (me*nb+mf*nd+nf)
+    negate (Matrix ma mb mc md me mf )  =
+         Matrix (-ma)  (-mb)  (-mc)  (-md)  (-me)  (-mf)
+    abs m = m
+    signum _ = identity
+    fromInteger i = Matrix r 0 0 r  0  0
+                   where
+                    r = fromInteger i
+
+-- | Identity matrix
+identity :: Matrix
+identity = Matrix 1 0 0 1 0 0
+
+-- | Specifies a matrix as three points
+pointMatrix :: Point   -- ^ X component
+            -> Point   -- ^ Y component
+            -> Point   -- ^ translation component
+            -> Matrix
+pointMatrix (x0 :+ y0) (x1 :+ y1) (x2 :+ y2) = Matrix x0 y0 x1 y1 x2 y2
+
+-- | Applies a matrix to a point
+transform :: Matrix -> Point -> Point
+transform (Matrix x0 y0 x1 y1 x2 y2) (x :+ y) = (x*x0 + y*x1 + x2) :+ (x*y0 + y*y1 + y2)
+
                     
 -- | Rotation matrix
 rotate :: Angle -- ^ Rotation angle
        -> Matrix
-rotate r = Matrix ( (cos radian))  ( (sin radian))  (- ( (sin radian)))  ( (cos radian))  0  0
-           where
-             radian = case r of
-                      Degree angle -> angle / 180 *  pi
-                      Radian angle -> angle
-
+rotate r = spiral (cis (toRadian r))
 
--- | Translation matrix            
-translate :: PDFFloat -- ^ Horizontal translation
-          -> PDFFloat -- ^ Vertical translation
+-- | Translation matrix
+-- 'transform (translate z) w == z + w'             
+translate :: Point 
           -> Matrix
-translate tx ty  = Matrix  1  0  0  1  tx ty
+translate (tx :+ ty)  = Matrix  1  0  0  1  tx ty
+
+--  | 'Spiral z' rotates by 'phase z' and scales by 'magnitude z'
+--  'transform (spiral z) w == z * w'
+spiral :: Point 
+       -> Matrix
+spiral (x :+ y) = Matrix x y (-y) x 0 0
 
 
 -- | Scaling matrix          
diff --git a/Graphics/PDF/Document.hs b/Graphics/PDF/Document.hs
--- a/Graphics/PDF/Document.hs
+++ b/Graphics/PDF/Document.hs
@@ -35,7 +35,8 @@
  -- * Draw monad and drawing functions
  -- ** Types
  , Draw
- , PDFXObject(drawXObject,bounds)
+ , PDFXObject(drawXObject)
+ , PDFGlobals(..)
  -- ** General drawing functions
  , withNewContext
  , emptyDrawing
@@ -131,6 +132,6 @@
             Just (_,(oldState,oldW)) -> do
               -- Create a new cntent and update the stream
               myBounds <- gets xobjectBound
-              let (a,state',w') = runDrawing draw (emptyEnvironment {streamId = streamRef, xobjectb = myBounds}) oldState
+              let (a,state',w') = runDrawing draw (emptyEnvironment {streamId = streamRef, xobjectBoundD = myBounds}) oldState
               modifyStrict $ \s -> s {streams = IM.insert streamRef (Just page,(state',mappend oldW w')) lStreams}
               return a
diff --git a/Graphics/PDF/Draw.hs b/Graphics/PDF/Draw.hs
--- a/Graphics/PDF/Draw.hs
+++ b/Graphics/PDF/Draw.hs
@@ -1,3 +1,4 @@
+{-# OPTIONS_GHC -fglasgow-exts #-}
 ---------------------------------------------------------
 -- |
 -- Copyright   : (c) alpha 2006
@@ -12,11 +13,16 @@
 -- #hide
 module Graphics.PDF.Draw(
  -- * Draw monad
-   Draw(..)
+   Draw
  , PDFStream(..)
  , withNewContext
  , DrawState(..)
  , DrawEnvironment(..)
+ , readDrawST 
+ , writeDrawST 
+ , modifyDrawST 
+ , DrawTuple()
+ , penPosition
  , supplyName
  , emptyDrawing
 -- , writeCmd
@@ -27,7 +33,6 @@
  , PDFXObject(..)
  , AnyPdfXForm
  , pdfDictMember
- , getBound
  -- PDF types
  , PDF(..)
  , PDFPage(..)
@@ -65,54 +70,31 @@
  , emptyDrawState
  , Matrix(..)
  , identity
+ , applyMatrix
  , currentMatrix
  , multiplyCurrentMatrixWith
+ , PDFGlobals(..)
  ) where
  
-import Graphics.PDF.LowLevel.Types
-import Control.Monad.RWS
-import Control.Monad.Writer
-import Control.Monad.Reader
-import Control.Monad.State
+import Data.Maybe
+import Data.Monoid
+
 import qualified Data.Map as M
-import Graphics.PDF.Resources
 import qualified Data.IntMap as IM
-import Graphics.PDF.Data.PDFTree(PDFTree)
-import Data.Maybe
 import qualified Data.Binary.Builder as BU
-import Graphics.PDF.LowLevel.Serializer
-import Data.Monoid
 
--- | A transformation matrix. An affine transformation a b c d e f
---
--- @
--- a b 0
--- c d 0
--- e f 1
--- @
-       
-data Matrix = Matrix !PDFFloat !PDFFloat !PDFFloat !PDFFloat !PDFFloat !PDFFloat deriving (Eq)
-		
--- | Identity matrix
-identity :: Matrix
-identity = Matrix 1.0 0 0 1.0 0 0
+import Control.Monad.ST
+import Data.STRef
 
-instance Show Matrix where
-  show (Matrix ma mb mc md me mf) = "Matrix " ++ (unwords [(show ma),(show mb),(show mc),(show md),(show me),(show mf)])
+import Control.Monad.Writer.Class
+import Control.Monad.Reader.Class
+import Control.Monad.State
 
-instance Num Matrix where
-    --  Matrix addition
-    (+) (Matrix ma mb mc md me mf ) (Matrix na nb nc nd ne nf) = 
-         Matrix (ma+na)  (mb+nb)  (mc+nc)  (md+nd)  (me+ne)  (mf+nf)
-    (*) (Matrix ma mb mc md me mf) (Matrix na nb nc nd ne nf) = 
-         Matrix (ma*na+mb*nc)  (ma*nb+mb*nd)  (mc*na+md*nc)  (mc*nb +md*nd)  (me*na+mf*nc+ne)  (me*nb+mf*nd+nf)
-    negate (Matrix ma mb mc md me mf )  =
-         Matrix (-ma)  (-mb)  (-mc)  (-md)  (-me)  (-mf)
-    abs m = m
-    signum _ = identity
-    fromInteger i = Matrix r 0 0 r  0  0
-                   where
-                    r = fromInteger i
+import Graphics.PDF.Coordinates
+import Graphics.PDF.LowLevel.Types
+import Graphics.PDF.LowLevel.Serializer
+import Graphics.PDF.Resources
+import Graphics.PDF.Data.PDFTree(PDFTree)
 
 data AnnotationStyle = AnnotationStyle !(Maybe Color)
 
@@ -159,28 +141,66 @@
                 }
 data DrawEnvironment = DrawEnvironment {
                         streamId :: Int
-                     ,  xobjectb :: IM.IntMap (PDFFloat,PDFFloat)
+                     ,  xobjectBoundD :: IM.IntMap (PDFFloat,PDFFloat)
                      }   
+
+data DrawTuple s
+   = DrawTuple {  drawEnvironment    :: DrawEnvironment
+               ,  drawStateRef  :: STRef s DrawState
+               ,  builderRef :: STRef s BU.Builder
+               ,  penPosition :: STRef s Point
+               }
     
 emptyEnvironment :: DrawEnvironment
 emptyEnvironment = DrawEnvironment 0 IM.empty
+
+class PDFGlobals m where
+    bounds :: PDFXObject a => PDFReference a -> m (PDFFloat,PDFFloat)
     
+-- | The drawing monad
+newtype Draw a = Draw {unDraw :: forall s. DrawTuple s -> ST s a }
 
+instance Monad Draw where
+    m >>= f  = Draw $ \env -> do
+                          a <- unDraw m env
+                          unDraw (f a) env
+    return x = Draw $ \_env -> return x
 
--- | The drawing monad
-newtype Draw a = Draw {unDraw :: RWS DrawEnvironment BU.Builder DrawState a} 
-#ifndef __HADDOCK__
-               deriving(Monad,MonadWriter BU.Builder, MonadReader DrawEnvironment, MonadState DrawState, Functor)
-#else
-instance Monad Draw
-instance MonadWriter BU.Builder Draw
-instance MonadReader DrawEnvironment Draw
-instance MonadState DrawState Draw
-instance Functor Draw
-#endif
+instance MonadReader DrawEnvironment Draw where
+   ask       = Draw $ \env -> return (drawEnvironment env)
+   local f m = Draw $ \env -> let drawenv' = f (drawEnvironment env)
+                                  env' = env { drawEnvironment = drawenv' }
+                               in unDraw m env' 
 
+instance MonadState DrawState Draw where
+    get    = Draw $ \env -> readSTRef  (drawStateRef env)
+    put st = Draw $ \env -> writeSTRef (drawStateRef env) st
+
+instance MonadWriter BU.Builder Draw where
+    tell bu  = Draw $ \env -> modifySTRef (builderRef env) (`mappend` bu)
+    listen m = Draw $ \env -> do
+                 a <- unDraw m env
+                 w <- readSTRef (builderRef env)
+                 return (a,w)
+    pass   m = Draw $ \env -> do
+                 (a, f) <- unDraw m env
+                 modifySTRef (builderRef env) f
+                 return a
+
+instance Functor Draw where
+     fmap f = \m -> do { a <- m; return (f a) }
+
 instance MonadPath Draw
 
+readDrawST :: (forall s. DrawTuple s -> STRef s a) -> Draw a
+readDrawST   f   = Draw $ \env -> readSTRef   (f env) 
+
+writeDrawST :: (forall s. DrawTuple s -> STRef s a) -> a -> Draw ()
+writeDrawST  f x = Draw $ \env -> writeSTRef  (f env) x 
+
+modifyDrawST :: (forall s. DrawTuple s -> STRef s a) -> (a -> a) -> Draw ()
+modifyDrawST f g = Draw $ \env -> modifySTRef (f env) g
+
 -- | A PDF stream object
 data PDFStream = PDFStream !BU.Builder !Bool !(PDFReference PDFLength) !PDFDictionary
                                    
@@ -220,7 +240,20 @@
   
 -- | Execute the drawing commands to get a new state and an uncompressed PDF stream
 runDrawing :: Draw a -> DrawEnvironment -> DrawState -> (a,DrawState,BU.Builder)
-runDrawing drawing environment state = (runRWS . unDraw $ drawing) environment state 
+runDrawing drawing environment state 
+    = runST $ do
+        dRef <- newSTRef state
+        bRef <- newSTRef mempty
+        posRef <- newSTRef 0
+        let tuple = DrawTuple { drawEnvironment = environment
+                              , drawStateRef    = dRef
+                              , builderRef      = bRef
+                              , penPosition     = posRef
+                              } 
+        a <- unDraw drawing tuple
+        drawSt <- readSTRef (drawStateRef tuple)
+        builder <- readSTRef (builderRef tuple)
+        return (a, drawSt, builder)
      
 pushMatrixStack :: Matrix -> Draw ()
 pushMatrixStack m = do
@@ -262,10 +295,15 @@
              return (newName,M.insert values newName oldCache)
         Just n -> return (n,oldCache)
 
+instance PDFGlobals Draw where
+    bounds (PDFReference r) = getBoundInDraw r
+    
+instance PDFGlobals PDF where
+    bounds (PDFReference r) = getBoundInPDF r
+    
 -- | A PDF Xobject which can be drawn
 class PDFXObject a where
     drawXObject :: PDFReference a -> Draw ()
-    bounds :: PDFReference a -> Draw (PDFFloat,PDFFloat)
     
     privateDrawXObject :: PDFReference a -> Draw ()
     privateDrawXObject (PDFReference r) = do
@@ -278,8 +316,6 @@
                           ]
     drawXObject = privateDrawXObject
     
-    bounds (PDFReference r) = getBound r
-
 -- | An XObject
 data AnyPdfXForm = forall a. (PDFXObject a,PdfObject a) => AnyPdfXForm a
 instance PdfObject AnyPdfXForm where
@@ -299,12 +335,19 @@
     
 
 -- | Get the bounds for an xobject
-getBound :: Int -- ^ Reference
+getBoundInDraw :: Int -- ^ Reference
          -> Draw (PDFFloat,PDFFloat)  
-getBound ref = do
-    theBounds <- asks xobjectb
+getBoundInDraw ref = do
+    theBounds <- asks xobjectBoundD
     return $ IM.findWithDefault (0.0,0.0) ref theBounds
-    
+ 
+-- | Get the bounds for an xobject
+getBoundInPDF :: Int -- ^ Reference
+              -> PDF (PDFFloat,PDFFloat)  
+getBoundInPDF ref = do
+    theBounds <- gets xobjectBound
+    return $ IM.findWithDefault (0.0,0.0) ref theBounds
+   
 -----------
 --
 -- PDF types
@@ -336,13 +379,13 @@
 -- | A PDF Page object
 #ifndef __HADDOCK__
 data PDFPage = PDFPage 
-          !(Maybe (PDFReference PDFPages)) -- ^ Reference to parent
-          !PDFRect -- ^ Media box
-          !(PDFReference PDFStream) -- ^ Reference to content
-          !(Maybe (PDFReference PDFResource)) -- ^ Reference to resources
-          !(Maybe PDFFloat) -- ^ Optional duration
-          !(Maybe PDFTransition) -- ^ Optional transition
-          ![AnyPdfObject] -- ^ Annotation array
+          !(Maybe (PDFReference PDFPages)) --  Reference to parent
+          !(PDFRect) -- Media box
+          !(PDFReference PDFStream) -- Reference to content
+          !(Maybe (PDFReference PDFResource)) -- Reference to resources
+          !(Maybe PDFFloat) -- Optional duration
+          !(Maybe PDFTransition) -- Optional transition
+          ![AnyPdfObject] -- Annotation array
 #else
 data PDFPage
 #endif
@@ -357,7 +400,7 @@
 #ifndef __HADDOCK__
 data PDFPages = PDFPages 
               !Int
-              !(Maybe (PDFReference PDFPages)) -- ^ Reference to parent 
+              !(Maybe (PDFReference PDFPages)) -- Reference to parent 
               [Either (PDFReference PDFPages) (PDFReference PDFPage)]
 #else
 data PDFPages
@@ -606,9 +649,9 @@
                                                ]
                                                
 instance PdfObject Color where
-   toPDF (Rgb r g b) = toPDF . map (AnyPdfObject . PDFFloat) $ [r,g,b]  
+   toPDF (Rgb r g b) = toPDF . map AnyPdfObject $ [r,g,b]  
    toPDF (Hsv h s v) = let (r,g,b) = hsvToRgb (h,s,v)
-    in toPDF . map (AnyPdfObject . PDFFloat) $ [r,g,b]
+    in toPDF . map AnyPdfObject $ [r,g,b]
 
 -- Degree for a transition direction
 floatDirection :: PDFTransDirection2 -> PDFFloat
@@ -636,14 +679,14 @@
       _ -> error "Hue value incorrect"
 
 getRgbColor :: Color -> (PDFFloat,PDFFloat,PDFFloat) 
-getRgbColor (Rgb r g b) = (PDFFloat r,PDFFloat g,PDFFloat b)  
-getRgbColor (Hsv h s v) = let (r,g,b) = hsvToRgb (h,s,v) in (PDFFloat r,PDFFloat g,PDFFloat b)  
+getRgbColor (Rgb r g b) = (r, g, b)  
+getRgbColor (Hsv h s v) = let (r,g,b) = hsvToRgb (h,s,v) in (r, g, b)  
 
 -- | Interpolation function
 interpole :: Int -> PDFFloat -> PDFFloat -> AnyPdfObject
 interpole n x y = AnyPdfObject . PDFDictionary . M.fromList $ 
                             [ (PDFName "FunctionType", AnyPdfObject . PDFInteger $ 2)
-                            , (PDFName "Domain", AnyPdfObject . map AnyPdfObject $ [PDFFloat 0,PDFFloat 1])
+                            , (PDFName "Domain", AnyPdfObject . map AnyPdfObject $ ([0,1] :: [PDFFloat]))
                             , (PDFName "C0", AnyPdfObject . map AnyPdfObject $ [x])
                             , (PDFName "C1", AnyPdfObject . map AnyPdfObject $ [y])
                             , (PDFName "N", AnyPdfObject . PDFInteger $  n)
@@ -673,3 +716,23 @@
         where
            (ra,ga,ba) = getRgbColor ca
            (rb,gb,bb) = getRgbColor cb
+
+
+-- | Apply a transformation matrix to the current coordinate frame
+applyMatrix :: Matrix -> Draw ()
+applyMatrix m@(Matrix a b c d e f)  = do
+    multiplyCurrentMatrixWith m
+    tell . mconcat $[ serialize '\n'
+                    , toPDF a
+                    , serialize ' '
+                    , toPDF b
+                    , serialize ' '
+                    , toPDF c
+                    , serialize ' '
+                    , toPDF d
+                    , serialize ' '
+                    , toPDF e
+                    , serialize ' '
+                    , toPDF f
+                    , serialize " cm"
+                    ]
diff --git a/Graphics/PDF/Image.hs b/Graphics/PDF/Image.hs
--- a/Graphics/PDF/Image.hs
+++ b/Graphics/PDF/Image.hs
@@ -306,7 +306,6 @@
     drawXObject a = withNewContext $ do
             (width,height) <- bounds a
             applyMatrix (scale width height)
-            applyMatrix (translate 0 0)
             privateDrawXObject a
         
 instance PdfObject PDFJpeg where
diff --git a/Graphics/PDF/LowLevel/Serializer.hs b/Graphics/PDF/LowLevel/Serializer.hs
--- a/Graphics/PDF/LowLevel/Serializer.hs
+++ b/Graphics/PDF/LowLevel/Serializer.hs
@@ -1,3 +1,4 @@
+{-# OPTIONS_GHC -fno-cse #-}
 ---------------------------------------------------------
 -- |
 -- Copyright   : (c) alpha 2006
@@ -27,6 +28,7 @@
 import Data.ByteString.Base
 import qualified Data.ByteString.Base as L(LazyByteString(..))
 #endif
+import System.IO.Unsafe
 
 foreign import ccall "conversion.h c_floatToString" cfloatToString :: Double -> Ptr Word8 -> IO Int
 foreign import ccall "conversion.h c_shortToString" cshortToString :: Int -> Ptr Word8 -> IO Int
@@ -52,18 +54,26 @@
 instance SerializeValue B.ByteString B.ByteString where
     serialize = id
     
+convertShort :: Int -> ByteString    
+convertShort a = unsafePerformIO (createAndTrim 12 (cshortToString a))
+{-# NOINLINE convertShort #-}
+
+convertFloat :: Double -> ByteString  
+convertFloat a = unsafePerformIO (createAndTrim 12 (cfloatToString a))
+{-# NOINLINE convertFloat #-}
+    
 #if __GLASGOW_HASKELL__ >= 608
 instance SerializeValue B.ByteString Int where
-    serialize a = L.Chunk (inlinePerformIO (createAndTrim 12 (cshortToString a))) L.Empty
+    serialize a = L.Chunk (convertShort a) L.Empty
  
 instance SerializeValue B.ByteString Double where
-    serialize a = L.Chunk (inlinePerformIO (createAndTrim 12 (cfloatToString a))) L.Empty
+    serialize a = L.Chunk (convertFloat a) L.Empty
 #else
 instance SerializeValue L.LazyByteString Int where
-    serialize a = L.LPS [inlinePerformIO (createAndTrim 12 (cshortToString a))]
+    serialize a = L.LPS [convertShort a]
 
 instance SerializeValue L.LazyByteString Double where
-    serialize a = L.LPS [inlinePerformIO (createAndTrim 12 (cfloatToString a))] 
+    serialize a = L.LPS [convertFloat a] 
 #endif
     
 instance SerializeValue BU.Builder Word8 where
diff --git a/Graphics/PDF/LowLevel/Types.hs b/Graphics/PDF/LowLevel/Types.hs
--- a/Graphics/PDF/LowLevel/Types.hs
+++ b/Graphics/PDF/LowLevel/Types.hs
@@ -15,14 +15,13 @@
 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.Word
-import System.Random 
 import Data.Binary.Builder(Builder,fromByteString)
 import Graphics.PDF.LowLevel.Serializer
 import Data.Monoid
+import Data.Complex
 import qualified Data.ByteString as S
 #if __GLASGOW_HASKELL__ >= 608
 import qualified Data.ByteString.Lazy.Internal as L(ByteString(..))
@@ -55,10 +54,7 @@
   fromInteger a = PDFLength (fromInteger a)
 
 -- | A real number in a PDF document
-newtype PDFFloat = PDFFloat Double deriving(Eq,Ord,Num,Fractional,Floating,RealFrac,Real,Random)
-
-instance Show PDFFloat where
-    show (PDFFloat x) = printf "%.5f" x
+type PDFFloat = Double 
 
 instance PdfObject PDFInteger where
     toPDF (PDFInteger a) = serialize a
@@ -70,10 +66,13 @@
     toPDF (PDFLength a) = serialize (show a)
     
 instance PdfObject PDFFloat where
-  toPDF (PDFFloat a) = serialize a
-  
-instance PdfObject Double where
   toPDF a = serialize a
+
+instance PdfObject (Complex PDFFloat) where
+  toPDF (x :+ y) = mconcat [ serialize x
+                           , serialize ' '
+                           , serialize y
+                           ] 
   
 instance PdfObject Bool where
   toPDF (True) = serialize "true"
@@ -84,7 +83,7 @@
 
 -- | Create a PDF string from an Haskell one
 toPDFString :: String -> PDFString
-toPDFString = PDFString . S.pack . map encodeISO88591 . escapeString
+toPDFString = PDFString . S.pack . map encodeISO88591 -- . escapeString
 
 encodeISO88591 :: Char -> Word8
 encodeISO88591 a = 
@@ -103,13 +102,19 @@
   serialize (PDFString t) = fromByteString t
 
 -- | 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
+escapeString :: PDFString -> PDFString
+escapeString (PDFString t) = PDFString . S.pack . escapeOnWords8 . S.unpack $ t
 
+pc2w :: Char -> Word8
+pc2w = fromIntegral . fromEnum
+
+escapeOnWords8 :: [Word8] -> [Word8]
+escapeOnWords8 [] = []
+escapeOnWords8 (a:l) | a == pc2w '(' = (pc2w '\\'):(pc2w '('):escapeOnWords8 l
+                     | a == pc2w ')' = (pc2w '\\'):(pc2w ')'):escapeOnWords8 l
+                     | a == pc2w '\\' = (pc2w '\\'):(pc2w '\\'):escapeOnWords8 l
+                     | otherwise = a:escapeOnWords8 l
+
 -- Misc strings useful to build bytestrings
 
 lparen :: SerializeValue s Char => s
@@ -141,7 +146,7 @@
     
 instance PdfObject PDFString where
   toPDF a = mconcat [ lparen
-                    , serialize a
+                    , serialize . escapeString $ a
                     , rparen
                     ]
 
diff --git a/Graphics/PDF/Pages.hs b/Graphics/PDF/Pages.hs
--- a/Graphics/PDF/Pages.hs
+++ b/Graphics/PDF/Pages.hs
@@ -79,7 +79,7 @@
   -- Create a new stream referenbce
   streamref <- supply
   myBounds <- gets xobjectBound
-  let (_,state',w') = runDrawing d (emptyEnvironment {streamId = streamref, xobjectb = myBounds}) (emptyDrawState streamref)
+  let (_,state',w') = runDrawing d (emptyEnvironment {streamId = streamref, xobjectBoundD = myBounds}) (emptyDrawState streamref)
   modifyStrict $ \s -> s {streams = IM.insert streamref (page,(state',w')) (streams s)}
   return (PDFReference streamref)
 
diff --git a/Graphics/PDF/Resources.hs b/Graphics/PDF/Resources.hs
--- a/Graphics/PDF/Resources.hs
+++ b/Graphics/PDF/Resources.hs
@@ -78,11 +78,11 @@
       
 newtype StrokeAlpha = StrokeAlpha Double deriving(Eq,Ord)  
 instance PdfResourceObject StrokeAlpha where
-  toRsrc (StrokeAlpha a) = AnyPdfObject . PDFDictionary . M.fromList $ [(PDFName "CA",AnyPdfObject . PDFFloat $ a)]
+  toRsrc (StrokeAlpha a) = AnyPdfObject . PDFDictionary . M.fromList $ [(PDFName "CA",AnyPdfObject a)]
   
 newtype FillAlpha = FillAlpha Double deriving(Eq,Ord)  
 instance PdfResourceObject FillAlpha where
-  toRsrc (FillAlpha a) = AnyPdfObject . PDFDictionary . M.fromList $ [(PDFName "ca",AnyPdfObject . PDFFloat $ a)]
+  toRsrc (FillAlpha a) = AnyPdfObject . PDFDictionary . M.fromList $ [(PDFName "ca",AnyPdfObject a)]
   
 class PdfResourceObject a where
       toRsrc :: a -> AnyPdfObject
diff --git a/Graphics/PDF/Shapes.hs b/Graphics/PDF/Shapes.hs
--- a/Graphics/PDF/Shapes.hs
+++ b/Graphics/PDF/Shapes.hs
@@ -12,12 +12,11 @@
 
 module Graphics.PDF.Shapes(
    -- * Shapes
-   -- ** Types
-     Point
-   -- ** Lines
-   , moveto
-   , lineto
    -- ** Paths
+     moveto
+   , lineto
+   , arcto
+   , curveto
    , beginPath
    , closePath
    , addBezierCubic
@@ -52,6 +51,7 @@
  ) where
 
 import Graphics.PDF.LowLevel.Types
+import Graphics.PDF.Coordinates
 import Graphics.PDF.Draw
 import Control.Monad.Writer
 import Graphics.PDF.LowLevel.Serializer
@@ -83,19 +83,21 @@
 data Line = Line PDFFloat PDFFloat PDFFloat PDFFloat deriving(Eq)
 instance Shape Line where
     addShape (Line x0 y0 x1 y1)= do
-        moveto x0 y0
-        lineto x1 y1
+        moveto (x0 :+ y0)
+        lineto (x1 :+ y1)
     fill _ = error "Can't fill a line !"
     fillAndStroke _ = error "Can't fill a line !"
     fillEO _ = error "Can't fill a line !"
     fillAndStrokeEO _ = error "Can't fill a line !"
     
-data Rectangle = Rectangle PDFFloat PDFFloat PDFFloat PDFFloat deriving(Eq)
+data Rectangle = Rectangle !Point !Point deriving (Eq) 
 instance Shape Rectangle where
- addShape (Rectangle x0 y0 x1 y1) = do
-    let poly = [(x0,y0),(x1,y0),(x1,y1),(x0,y1)]
-    addPolygonToPath poly
-    closePath
+ addShape (Rectangle a b) 
+     = tell . mconcat $ [ serialize '\n'
+                        , toPDF a
+                        , serialize ' '
+                        , toPDF (b - a)
+                        , serialize " re" ]
  
 data Arc = Arc PDFFloat PDFFloat PDFFloat PDFFloat deriving(Eq)
 instance Shape Arc where
@@ -103,8 +105,8 @@
         let height = y1 - y0
             width = x1 - x0
             kappa = 0.5522847498
-        beginPath x0 y0
-        addBezierCubic (x0+width*kappa) y0 x1 (y1-height*kappa) x1 y1
+        beginPath (x0 :+ y0)
+        addBezierCubic ((x0+width*kappa) :+ y0) (x1 :+ (y1-height*kappa)) (x1 :+ y1)
                
 data Ellipse = Ellipse PDFFloat PDFFloat PDFFloat PDFFloat deriving(Eq)
 instance Shape Ellipse where
@@ -115,11 +117,11 @@
             h = k*(abs (y1 - y0)/2.0)
             w = k*(abs (x1 - x0)/2.0)
 
-        beginPath xm y0
-        addBezierCubic (xm + w) y0 x1 (ym - h) x1 ym
-        addBezierCubic x1 (ym + h) (xm + w) y1 xm y1
-        addBezierCubic (xm - w) y1 x0 (ym + h) x0 ym
-        addBezierCubic x0 (ym - h) (xm - w) y0 xm y0
+        beginPath (xm :+ y0)
+        addBezierCubic ((xm + w) :+ y0) (x1 :+ (ym - h)) (x1 :+ ym)
+        addBezierCubic (x1 :+ (ym + h)) ((xm + w) :+ y1) (xm :+ y1)
+        addBezierCubic ((xm - w) :+ y1) (x0 :+ (ym + h)) (x0 :+ ym)
+        addBezierCubic (x0 :+ (ym - h)) ((xm - w) :+ y0) (xm :+ y0)
 
 data RoundRectangle = RoundRectangle PDFFloat PDFFloat PDFFloat PDFFloat PDFFloat PDFFloat deriving(Eq)
 instance Shape RoundRectangle where
@@ -128,16 +130,16 @@
             h = k*rw
             w = k*rh
 
-        beginPath (x0+rw) y0
-        addLineToPath (x1-rw) y0
-        addBezierCubic ((x1-rw) + w) y0 x1 (y0+rh - h) x1 (y0+rh)
-        addLineToPath x1 (y1-rh)
-        addBezierCubic x1 ((y1-rh) + h) (x1-rw + w) y1 (x1-rw) y1
-        addLineToPath (x0+rw) y1
-        addBezierCubic (x0 + rw - w) y1 x0 (y1-rh + h) x0 (y1-rh)
-        addLineToPath x0 (y0+rh)
-        addBezierCubic x0 (y0 + rh - h) (x0 + rw - w) y0 (x0 + rw) y0
-        addLineToPath (x1-rw) y0
+        beginPath ((x0+rw) :+ y0)
+        addLineToPath ((x1-rw) :+ y0)
+        addBezierCubic ((x1-rw + w) :+ y0) (x1 :+ (y0+rh - h)) (x1 :+ (y0+rh))
+        addLineToPath (x1 :+ (y1-rh))
+        addBezierCubic (x1 :+ (y1-rh + h)) ((x1-rw + w) :+ y1) ((x1-rw) :+ y1)
+        addLineToPath ((x0+rw) :+ y1)
+        addBezierCubic ((x0+rw - w) :+ y1) (x0 :+ (y1-rh + h)) (x0 :+ (y1-rh))
+        addLineToPath (x0 :+ (y0+rh))
+        addBezierCubic (x0 :+ (y0+rh - h)) ((x0+rw - w) :+ y0) ((x0+rw) :+ y0)
+        addLineToPath ((x1-rw) :+ y0)
         
 data Circle = Circle PDFFloat PDFFloat PDFFloat deriving(Eq)
 instance Shape Circle where
@@ -169,7 +171,7 @@
               deriving(Eq,Enum)
               
 -- | Line join styles
-data JoinStyle = MilterJoin
+data JoinStyle = MiterJoin
                | RoundJoin
                | BevelJoin
                deriving(Eq,Enum)
@@ -204,9 +206,8 @@
 setNoDash :: MonadPath m => m ()
 setNoDash = setDash (DashPattern [] 0)
     
--- | Begin a new path at position x y
-beginPath :: PDFFloat -- ^ Horizontal coordinate
-          -> PDFFloat -- ^ Vertical coordinate
+-- | Begin a new path at a position
+beginPath :: Point 
           -> Draw ()
 beginPath = moveto
 
@@ -216,77 +217,78 @@
 
 
 -- | Append a cubic Bezier curve to the current path. The curve extends 
--- from the current point to the point (x3 , y3 ), using (x1 , y1 ) and 
+-- from the current point to the point (x3 , y3), using (x1 , y1 ) and 
 -- (x2, y2) as the Bezier control points
-addBezierCubic :: PDFFloat -- ^ x1
-               -> PDFFloat -- ^ y1
-               -> PDFFloat -- ^ x2 
-               -> PDFFloat -- ^ y2 
-               -> PDFFloat -- ^ x3 
-               -> PDFFloat -- ^ y3
+addBezierCubic :: Point
+               -> Point
+               -> Point
                -> Draw ()
-addBezierCubic x1 y1 x2 y2 x3 y3 = 
-    tell . mconcat $[ serialize "\n" 
-                    , toPDF x1
-                    , serialize ' '
-                    , toPDF y1
-                    , serialize ' '
-                    , toPDF x2
-                    , serialize ' '
-                    , toPDF y2
-                    , serialize ' '
-                    , toPDF x3
-                    , serialize ' '
-                    , toPDF y3
-                    , serialize " c"
-                    ]
+addBezierCubic b c d = do
+    tell . mconcat $ [ serialize "\n" 
+                     , toPDF b
+                     , serialize ' '
+                     , toPDF c
+                     , serialize ' '
+                     , toPDF d
+                     , serialize " c"
+                     ]
+    writeDrawST penPosition d
                     
 -- | Move pen to a given point without drawing anything
-moveto :: PDFFloat -- ^ Horizontal coordinate
-       -> PDFFloat -- ^ Vertical coordinate
+moveto :: Point 
        -> Draw ()
-moveto x y = 
-    tell . mconcat $[ serialize "\n" 
-                    , toPDF x
-                    , serialize ' '
-                    , toPDF y
-                    , serialize " m"
-                    ]
+moveto a = do 
+    tell . mconcat $ [ serialize "\n" 
+                     , toPDF a
+                     , serialize " m"
+                     ]
+    writeDrawST penPosition a
 
 -- | Draw a line from current point to the one specified by lineto
-lineto :: PDFFloat -- ^ Horizontal coordinate 
-       -> PDFFloat -- ^ Vertical coordinate
-       -> Draw ()
-lineto x y = 
-    tell . mconcat $[ serialize "\n" 
-                    , toPDF x
-                    , serialize ' '
-                    , toPDF y
-                    , serialize " l s"
-                    ]
-    
--- | Add a line from current point to the one specified by lineto
-addLineToPath :: PDFFloat -- ^ Horizontal coordinate 
-              -> PDFFloat -- ^ Vertical coordinate
-              -> Draw ()
-addLineToPath x y = 
+lineto :: Point 
+       -> Draw () 
+lineto a = do
     tell . mconcat $[ serialize "\n" 
-                    , toPDF x
-                    , serialize ' '
-                    , toPDF y
+                    , toPDF a
                     , serialize " l"
                     ]
-    
+    writeDrawST penPosition a
 
--- | A point
-type Point = (PDFFloat,PDFFloat)
+curveto :: Point -> Point -> Point -> Draw ()
+curveto = addBezierCubic
 
+-- | Approximate a circular arc by one cubic bezier curve.
+-- larger arc angles mean larger distortions
+arcto :: Angle   -- ^ Extent of arc
+      -> Point   -- ^ Center of arc
+      -> Draw ()
+arcto extent 
+    = let theta = toRadian extent
+          kappa = 4 / 3 * tan (theta / 4)
+          cis_theta = cis theta
+          rot90 (x :+ y) = ((-y) :+ x)
+       in if theta == 0
+          then \_center -> return ()
+          else \center -> do
+            a <- readDrawST penPosition
+            let delta  = a - center
+                delta' = scalePt kappa (rot90 delta)
+                d = center + delta * cis_theta
+                c = d - delta' * cis_theta
+                b = a + delta'
+            curveto b c d
+
+addLineToPath :: Point 
+              -> Draw ()
+addLineToPath = lineto
+
 -- | Add a polygon to current path
 addPolygonToPath :: [Point]
                  -> Draw ()
-addPolygonToPath l =  do
-    (uncurry moveto) . head $ l
-    mapM_ (\(x,y) -> addLineToPath x y) (tail l)  
+addPolygonToPath []  = return ()
+addPolygonToPath (l : ls) =  do
+    moveto l
+    mapM_ addLineToPath ls  
     
 -- | Draw current path
 strokePath :: Draw ()             
diff --git a/Graphics/PDF/Text.hs b/Graphics/PDF/Text.hs
--- a/Graphics/PDF/Text.hs
+++ b/Graphics/PDF/Text.hs
@@ -126,19 +126,21 @@
                                    , tl :: !PDFFloat
                                    , ts :: !PDFFloat
                                    , fontState :: FontState
+                                   , currentFont :: PDFFont
                                    }
 defaultParameters :: TextParameter
-defaultParameters = TextParameter 0 0 100 0 0 (Set.empty)
+defaultParameters = TextParameter 0 0 100 0 0 (Set.empty) (PDFFont Times_Roman 12)
 
      
 -- | The text monad 
 newtype PDFText a = PDFText {unText :: WriterT Builder (State TextParameter) a}          
 #ifndef __HADDOCK__                    
-  deriving(Monad,Functor,MonadWriter Builder)
+  deriving(Monad,Functor,MonadWriter Builder,MonadState TextParameter)
 #else
 instance Monad PDFText
 instance Functor PDFText
 instance MonadWriter Builder PDFText
+instance MonadState TextParameter PDFText
 #endif
     
 instance MonadPath PDFText
@@ -159,8 +161,8 @@
 
 -- | Select a font to use
 setFont :: PDFFont -> PDFText ()
-setFont (PDFFont n size) = PDFText $ do
-    lift (modifyStrict $ \s -> s {fontState = Set.insert n (fontState s)})
+setFont f@(PDFFont n size) = PDFText $ do
+    lift (modifyStrict $ \s -> s {fontState = Set.insert n (fontState s), currentFont = f})
     tell . mconcat$ [ serialize "\n/" 
                     , serialize (show n)
                     , serialize ' '
@@ -200,6 +202,19 @@
 displayText t = do
     tell . toPDF $ t
     tell . serialize $ " Tj"
+--    f <- gets currentFont
+--    let rt = ripText f t
+--    tell . serialize $ '\n'
+--    tell lbracket
+--    mapM_ displayGlyphs rt
+--    tell rbracket
+--    tell $ serialize " TJ"
+-- where
+-- 	displayGlyphs (w,c) = do
+-- 		tell $ toPDF (toPDFString $ c:[])
+-- 		tell bspace
+-- 		tell . toPDF $ w
+-- 		tell bspace
 
  
 -- | Start a new line (leading value must have been set)
diff --git a/Graphics/PDF/Typesetting.hs b/Graphics/PDF/Typesetting.hs
--- a/Graphics/PDF/Typesetting.hs
+++ b/Graphics/PDF/Typesetting.hs
@@ -32,6 +32,7 @@
   , VerState(..)
   , Container
   , Justification(..)
+  , Orientation(..)
   -- * Functions
   -- ** Text display
   , displayFormattedText
@@ -63,6 +64,7 @@
   , containerContentLeftBorder
   , containerCurrentHeight
   , containerContentRectangle
+  , drawTextBox
   -- * Settings (similar to TeX ones)
   -- ** Line breaking settings
   , setFirstPassTolerance 
@@ -92,6 +94,7 @@
 import Graphics.PDF.Text
 import Graphics.PDF.Draw
 import Graphics.PDF.Shapes
+import Graphics.PDF.Coordinates
 import Control.Monad.RWS
 import Graphics.PDF.Typesetting.Breaking
 import Graphics.PDF.Typesetting.Vertical
@@ -109,7 +112,7 @@
                      -> s -- ^ Default horizontal style
                      -> TM ps s a -- ^ Typesetting monad
                      -> Draw a -- ^ Draw monad
-displayFormattedText (Rectangle xa ya xb yb) defaultVStyle defaultHStyle t  = 
+displayFormattedText (Rectangle (xa :+ ya) (xb :+ yb)) defaultVStyle defaultHStyle t  = 
     do
     --withNewContext $ do
     --    addShape $ Rectangle (xa-1) y' (xb+1) y''
@@ -411,3 +414,46 @@
 setJustification :: Justification -- ^ Centered, left or fully justified
                  -> TM ps s ()
 setJustification j = modifyStrict $ \s -> s {paraSettings = (paraSettings s){centered = j}}
+
+-------------------------------
+--
+-- Tools to ease tech drawings
+--
+-------------------------------
+
+data Orientation = E | W | N | S | NE | NW | SE | SW deriving(Eq,Show)
+
+-- | Draw a text box with relative position. Useful for labels
+drawTextBox :: (ParagraphStyle ps s, Style s) 
+            => PDFFloat -- ^ x
+            -> PDFFloat -- ^ y
+            -> PDFFloat -- ^ width limit
+            -> PDFFloat -- ^ height limit
+            -> Orientation
+            -> ps -- ^ default vertical style
+            -> s -- ^ Default horizontal style
+            -> TM ps s a -- ^ Typesetting monad
+            -> (Rectangle,Draw ())
+drawTextBox x y w h ori ps p t = 
+    let b = getBoxes ps p t
+        sh = styleHeight p
+        c = mkContainer 0 0 w h sh
+        (d,c',_) = fillContainer (defaultVerState ps) c b
+        Rectangle (xa :+ ya) (xb :+ yb)  = containerContentRectangle  c'
+        wc = xb - xa
+        hc = yb - ya
+        (dx,dy) = case ori of
+          NE -> (x,y)
+          NW -> (x - wc,y)
+          SE -> (x,y + hc)
+          SW -> (x - wc,y + hc)
+          E -> (x,y + hc / 2.0)
+          W -> (x - wc,y + hc / 2.0)
+          N -> (x - wc/2.0,y)
+          S -> (x - wc/2.0,y + hc)
+        box = withNewContext $ do
+    	   applyMatrix $ translate (dx :+ dy)
+    	   d
+        r = Rectangle ((xa + dx) :+ (ya + dy)) ((xb + dx) :+ (yb + dy))
+    in
+    (r,box)
diff --git a/Graphics/PDF/Typesetting/Box.hs b/Graphics/PDF/Typesetting/Box.hs
--- a/Graphics/PDF/Typesetting/Box.hs
+++ b/Graphics/PDF/Typesetting/Box.hs
@@ -44,7 +44,7 @@
 instance DisplayableBox DrawBox where
     strokeBox (DrawBox a) x y = do
         withNewContext $ do
-            applyMatrix $ translate x y
+            applyMatrix $ translate (x :+ y)
             a
     
 instance Show DrawBox where
diff --git a/Graphics/PDF/Typesetting/Breaking.hs b/Graphics/PDF/Typesetting/Breaking.hs
--- a/Graphics/PDF/Typesetting/Breaking.hs
+++ b/Graphics/PDF/Typesetting/Breaking.hs
@@ -558,10 +558,10 @@
          normalW = ws * h
      in
      case (centered settings) of
-        FullJustification -> [Glue normalW (normalW*sy/2.0*f) (normalW*sz/3.0) (Just s)]
+        FullJustification -> [Glue (normalW) (normalW*sy/2.0*f) (normalW*sz/3.0) (Just s)]
         Centered -> [ Glue 0 (centeredDilatationFactor*normalW) 0 (Just s)
                     , Penalty 0
-                    , Glue normalW (-2*centeredDilatationFactor*normalW) 0 (Just s)
+                    , Glue (normalW) (-2*centeredDilatationFactor*normalW) 0 (Just s)
                     , Kern 0 (Just s)
                     , Penalty infinity
                     , Glue 0 (centeredDilatationFactor*normalW) 0 (Just s)
@@ -618,6 +618,12 @@
                   -> [Letter s] -- ^ Boxes
 createLetterBoxes _ _ [] = []  
 createLetterBoxes settings s ((_,'/'):(w,'-'):l) = hyphenPenalty settings s w : createLetterBoxes settings s l
+createLetterBoxes settings s ((w',','):(_,' '):l) = (createChar s w' ',') : ((spaceGlueBox settings s 2.0) ++ createLetterBoxes settings s l)
+createLetterBoxes settings s ((w',';'):(_,' '):l) = (createChar s w' ';') : ((spaceGlueBox settings s 2.0) ++ createLetterBoxes settings s l)
+createLetterBoxes settings s ((w','.'):(_,' '):l) = (createChar s w' '.') : ((spaceGlueBox settings s 2.0) ++ createLetterBoxes settings s l)
+createLetterBoxes settings s ((w',':'):(_,' '):l) = (createChar s w' ':') : ((spaceGlueBox settings s 2.0) ++ createLetterBoxes settings s l)
+createLetterBoxes settings s ((w','!'):(_,' '):l) = (createChar s w' '!') : ((spaceGlueBox settings s 2.0) ++ createLetterBoxes settings s l)
+createLetterBoxes settings s ((w','?'):(_,' '):l) = (createChar s w' '?') : ((spaceGlueBox settings s 2.0) ++ createLetterBoxes settings s l)
 createLetterBoxes settings s ((_,' '):l) = (spaceGlueBox settings s 1.0) ++ createLetterBoxes settings s l
 createLetterBoxes settings s ((w,t):l) = (createChar s w t) : createLetterBoxes settings s l
 
diff --git a/Graphics/PDF/Typesetting/Horizontal.hs b/Graphics/PDF/Typesetting/Horizontal.hs
--- a/Graphics/PDF/Typesetting/Horizontal.hs
+++ b/Graphics/PDF/Typesetting/Horizontal.hs
@@ -20,6 +20,7 @@
 import Graphics.PDF.Typesetting.Breaking
 import Graphics.PDF.Shapes
 import Graphics.PDF.Draw
+import Graphics.PDF.Coordinates
 import qualified Data.ByteString.Char8 as S(pack)
 import Data.Maybe(isJust,fromJust)
 import Data.List(foldl')
@@ -209,7 +210,7 @@
            w' = foldl' (\x' ny -> x' + boxWidth ny) 0.0 l'
        if (isJust . sentenceStyle $ style)
              then do
-                 (fromJust . sentenceStyle $ style) (Rectangle x (y - hl) (x+w') (y)) (drawTextLine style l' x y')
+                 (fromJust . sentenceStyle $ style) (Rectangle (x :+ (y - hl)) ((x+w') :+ y)) (drawTextLine style l' x y')
              else do
                  drawTextLine style l' x y'
        drawLineOfHboxes hl dl l'' (x + w') y
@@ -311,7 +312,7 @@
          -- otherwise we apply a different function to the sentence
          if (isJust . wordStyle $ style)
              then
-                 (fromJust . wordStyle $ style) (Rectangle x (y' - de) (x+w) (y' - de + he)) DrawGlue (return ())
+                 (fromJust . wordStyle $ style) (Rectangle (x :+ (y' - de)) ((x+w) :+ (y' - de + he))) DrawGlue (return ())
              else
                  return ()
                  
@@ -323,7 +324,7 @@
          -- otherwise we apply a different function to the sentence
          if (isJust . wordStyle $ style)
              then
-                 (fromJust . wordStyle $ style) (Rectangle x (y' - de) (x+w) (y' - de + he)) DrawWord (drawText $ drawTheTextBox OneBlock style x y' (Just t))
+                 (fromJust . wordStyle $ style) (Rectangle (x :+ (y' - de)) ((x+w) :+ (y' - de + he))) DrawWord (drawText $ drawTheTextBox OneBlock style x y' (Just t))
              else 
                  drawText $ drawTheTextBox OneBlock style x y' (Just t)
 
diff --git a/Graphics/PDF/Typesetting/Layout.hs b/Graphics/PDF/Typesetting/Layout.hs
--- a/Graphics/PDF/Typesetting/Layout.hs
+++ b/Graphics/PDF/Typesetting/Layout.hs
@@ -38,6 +38,7 @@
 import Graphics.PDF.LowLevel.Types
 import Graphics.PDF.Typesetting.Breaking
 import Graphics.PDF.Draw
+import Graphics.PDF.Coordinates
 import Graphics.PDF.Shapes(Rectangle(..))
 import Graphics.PDF.Typesetting.Box
 import Data.List(foldl')
@@ -108,7 +109,7 @@
         strokeBox (VGlue h w delta _ (Just style)) x y = 
             if (isJust . interline $ style)
                 then
-                    (fromJust . interline $ style) $ Rectangle (x+delta) (y-h) (x+w+delta) y
+                    (fromJust . interline $ style) $ Rectangle ((x+delta) :+ (y-h)) ((x+w+delta) :+ y)
                 else
                    return()
         strokeBox (VGlue _ _ _ _ _) _ _ = return ()
@@ -176,7 +177,7 @@
 
 -- | Return the rectangle containing the text after formatting and glue dilatation
 containerContentRectangle :: Container ps s -> Rectangle
-containerContentRectangle c = Rectangle (x+l) (y-th) (x+r) y 
+containerContentRectangle c = Rectangle ((x+l) :+ (y-th)) ((x+r) :+ y)
  where
     x = containerX c
     y = containerY c
@@ -319,7 +320,7 @@
       then do
           let xleft = (minimum $ 100000:map getBoxDelta l' ) + xa
               xright = (maximum $ 0:(map (\x -> boxWidth x + getBoxDelta x) l')) + xa
-          (fromJust . paragraphStyle $ style) (Rectangle xleft (y'- h') xright (y')) (recurseStrokeVBoxes 1 l' xa y')
+          (fromJust . paragraphStyle $ style) (Rectangle (xleft :+ (y'- h')) (xright :+ y')) (recurseStrokeVBoxes 1 l' xa y')
       else
          recurseStrokeVBoxes 1 l' xa y'
     strokeVBoxes l'' xa (y' - h')
diff --git a/HPDF.cabal b/HPDF.cabal
--- a/HPDF.cabal
+++ b/HPDF.cabal
@@ -1,12 +1,13 @@
 Name: HPDF
-Version: 1.3
+Version: 1.4
 cabal-version: >=1.2
 License: LGPL
 License-file:LICENSE
-Copyright: Copyright (c) 2007, alpheccar
+Copyright: Copyright (c) 2007-2008, alpheccar
 category: Graphics
 synopsis: Generation of PDF documents
 maintainer: misc@NOSPAMalpheccar.org
+build-type: Simple
 tested-with: GHC==6.8.1
 homepage: http://www.alpheccar.org
 description: A PDF library with support for several pages, page transitions, outlines, annotations, compression, colors, shapes, patterns, jpegs, fonts, typesetting ...
diff --git a/NEWS.txt b/NEWS.txt
--- a/NEWS.txt
+++ b/NEWS.txt
@@ -1,6 +1,14 @@
-WHAT'S NEW IN HPDF 1.3
+WHAT'S NEW IN HPDF 1.4
 ======================
-1 - Can be built with ghc 6.8.1 and ghc 6.6 if you have the most recent Cabal and update a few libraries ;
-2 - Bug corrections in the line breaking algorithm ;
-3 - Automatic hyphenation algorithm (default Language is English). To add new language you have to use hyphenation patterns like in TeX.
-Look at Graphics/PDF/Hyphenate.hs and Graphics/PDF/Hyphenate/English.hs
+Lot's of contributions from Leon Smith ! Thank you. Here is a summary:
+
+A - Changes by Leon
+===================
+1 - Huge speed improvement of the draw monad ;
+2 - New implementation of shapes (Rectangle, curveto, arcto, point datatype) ;
+3 - Cleaning of the API (coordinates, shapes) ;
+
+B - Changes by alpheccar
+=========================
+1 - Lots of bug corrections for typesetting ;
+2 - An API to draw text boxes 
diff --git a/Test/Makefile b/Test/Makefile
--- a/Test/Makefile
+++ b/Test/Makefile
@@ -5,7 +5,7 @@
 	ghc -o test -prof -auto-all -ffi -cpp -Wall -funbox-strict-fields  -fglasgow-exts  -O2 -hidir interfaces -odir bin -optc-I../c -i..  ../c/metrics.c ../c/conversion.c --make test.hs
 	
 runprof:
-	./test +RTS -p
+	./test +RTS -p -hc
 		
 demo:
 	ghc -o test -fglasgow-exts  -O2 --make test.hs
diff --git a/Test/Penrose.hs b/Test/Penrose.hs
--- a/Test/Penrose.hs
+++ b/Test/Penrose.hs
@@ -23,7 +23,7 @@
 
 tilea :: PDFFloat -> Tile -> Int -> Draw ()
 tilea angle k n = withNewContext $ do
-    applyMatrix (translate width 0)
+    applyMatrix (translate (width :+ 0))
     applyMatrix (rotate . Degree $ angle)
     applyMatrix (scale (1/golden) (1/golden))
     divide (n-1) k 
@@ -31,7 +31,7 @@
 
 tileb :: PDFFloat -> Tile -> Int ->  Draw ()
 tileb angle k n = withNewContext $ do
-    applyMatrix (translate (width*golden) 0)
+    applyMatrix (translate ((width*golden) :+ 0))
     applyMatrix (rotate . Degree $ angle)
     applyMatrix (scale (1/golden) (1/golden))
     divide (n-1) k
@@ -66,9 +66,9 @@
       setFillAlpha 0.8
       fillColor myBlue
       strokeColor myBlue
-      let pol = [ (0,0)
-                , ((s*cos(phi)),(s*sin(phi)))
-                , ((s*golden),0)
+      let pol = [ 0
+                , mkPolar s phi 
+                , ((s*golden) :+ 0)
                 ]
       fillAndStroke (Polygon pol)
       strokeColor black 
@@ -86,9 +86,9 @@
       setFillAlpha 0.8
       fillColor myGreen
       strokeColor myGreen
-      let pol = [ (0,0)
-                , ((s*cos(phi)),(s*sin(phi)))
-                , (s,0)
+      let pol = [ 0
+                , mkPolar s phi
+                , (s :+ 0)
                 ]     
       fillAndStroke (Polygon pol)
       strokeColor black 
@@ -104,10 +104,11 @@
     page <- addPage (Just (PDFRect 0 0 (round (1.5*width)) (round width)))
     newSection (toPDFString "Penrose") Nothing Nothing $ do
         drawWithPage page $ do
-            applyMatrix (translate 20 5)
+            applyMatrix (translate (20 :+ 5))
             applyMatrix (rotate . Degree $ 36) 
-            divide 4 B 
-            divide 4 B'
+            let r = 4
+            divide r B 
+            divide r B'
 
 
            
diff --git a/Test/test.hs b/Test/test.hs
--- a/Test/test.hs
+++ b/Test/test.hs
@@ -1,3 +1,4 @@
+{-# OPTIONS_GHC -fglasgow-exts #-}
 ---------------------------------------------------------
 -- |
 -- Copyright   : (c) alpha 2007
@@ -31,13 +32,13 @@
      strokeColor $ Rgb 1 0 0
      stroke $ Line 10 200 612 200
      fill $ Circle 10 200 10
-     stroke $ Rectangle 10 (200.0 - (getDescent f)) (10.0 + textWidth f t) (200.0 - getDescent f + getHeight f)           
+     stroke $ Rectangle (10 :+ (200.0 - (getDescent f))) ((10.0 + textWidth f t) :+ (200.0 - getDescent f + getHeight f))
 
       
 geometryTest :: Draw ()
 geometryTest  = do
         strokeColor red
-        stroke $ Rectangle 0 0 200 100
+        stroke $ Rectangle 0 (200 :+ 100)
         fillColor blue
         fill $ Ellipse 100 100 300 200
         fillAndStroke $ RoundRectangle 32 32 200 200 600 400
@@ -52,7 +53,7 @@
             
 shadingTest :: Draw ()
 shadingTest  = do
-     paintWithShading (RadialShading 0 0 50 0 0 600 (Rgb 1 0 0) (Rgb 0 0 1)) (addShape $ Rectangle 0 0 300 300)
+     paintWithShading (RadialShading 0 0 50 0 0 600 (Rgb 1 0 0) (Rgb 0 0 1)) (addShape $ Rectangle 0 (300 :+ 300))
      paintWithShading (AxialShading 300 300 600 400 (Rgb 1 0 0) (Rgb 0 0 1)) (addShape $ Ellipse 300 300 600 400)
      
                      
@@ -82,20 +83,20 @@
     p1 <- addPage Nothing
     drawWithPage p1 $ do
       withNewContext $ do
-        applyMatrix $ translate 50 0
+        applyMatrix $ translate (50 :+ 0)
         r
     p2 <- addPage Nothing
     drawWithPage p2 $ do
       strokeColor red
       stroke $ Line 0 0 100 0
-      applyMatrix $ translate 100 0
+      applyMatrix $ translate (100 :+ 0)
       strokeColor green
       stroke $ Line 0 0 100 0
       withNewContext $ do
           applyMatrix $ rotate (Degree (-20))
           strokeColor $ Rgb 1 1 0
           stroke $ Line 0 0 100 0
-          applyMatrix $ translate 50 50
+          applyMatrix $ translate (50 :+ 50)
           strokeColor blue
           stroke $ Line 0 0 100 0
           withNewContext $ do
@@ -112,14 +113,14 @@
         strokeColor red
         newAnnotation (URLLink (toPDFString "Go to my blog") [0,0,200,100] "http://www.alpheccar.org" True)
         drawText $ text (PDFFont Times_Roman 12) 10 30 (toPDFString "Go to my blog")
-        stroke $ Rectangle 0 0 200 100
+        stroke $ Rectangle 0 (200 :+ 100)
         newAnnotation (TextAnnotation (toPDFString "Key annotation") [100,100,130,130] Key)
  
 textTest :: Draw ()
 textTest = do
     strokeColor red
     fillColor blue
-    fontDebug (PDFFont Times_Roman 48) (toPDFString "This is a test (éèçàù)!")
+    fontDebug (PDFFont Times_Roman 48) (toPDFString "This is a \\test (éèçàù)!")
 
               
 testImage ::  JpegFile -> PDFReference PDFPage -> PDF ()
@@ -131,7 +132,7 @@
           drawXObject jpg
       withNewContext $ do
            applyMatrix $ rotate (Degree 20)
-           applyMatrix $ translate 200 200
+           applyMatrix $ translate (200 :+ 200)
            applyMatrix $ scale 2 2
            drawXObject jpg
            
@@ -190,14 +191,14 @@
     wordStyle (SuperCrazy l _) = Just ws 
      where
         ws _ DrawGlue _ = return ()
-        ws (Rectangle xa ya xb yb) DrawWord drawWord = do
+        ws (Rectangle (xa :+ ya) (xb :+ yb)) DrawWord drawWord = do
             let [a,b,c,d,e,f,g,h] :: [PDFFloat] = map (\x -> x / 16.0) . map fromIntegral . take 8 $ l
                 --angle = head angl
-                p = Polygon [ (xa-a,ya+b)
-                            , (xb+c,ya+d)
-                            , (xb+e,yb-f)
-                            , (xa-g,yb-h)
-                            , (xa-a,ya+b)
+                p = Polygon [ (xa-a) :+ (ya+b)
+                            , (xb+c) :+ (ya+d)
+                            , (xb+e) :+ (yb-f)
+                            , (xa-g) :+ (yb-h)
+                            , (xa-a) :+ (ya+b)
                             ]
             strokeColor red
             stroke p
@@ -222,14 +223,14 @@
 
              
 crazyWord :: Rectangle -> StyleFunction -> Draw a -> Draw ()
-crazyWord r@(Rectangle xa ya xb yb) DrawWord d = do
+crazyWord r@(Rectangle (xa :+ ya) (xb :+ yb)) DrawWord d = do
     fillColor $ Rgb 0.6 1 0.6 
     fill r
     d
     strokeColor $ Rgb 0 0 1
     let m = (ya+yb)/2.0
     stroke $ Line xa m xb m 
-crazyWord (Rectangle xa ya xb yb) DrawGlue _ = do
+crazyWord (Rectangle (xa :+ ya) (xb :+ yb)) DrawGlue _ = do
     fillColor $ Rgb 0 0 1
     fill (Circle ((xa+xb)/2.0) ((ya+yb)/2.0) ((xb-xa)/2.0))
     
@@ -273,10 +274,10 @@
     paragraphChange (BluePara _) _ (AChar st c _:l) = 
         let f = PDFFont Helvetica_Bold 45
             w' = charWidth f c 
-            charRect = Rectangle 0 (- getDescent f) w' (getHeight f - getDescent f)
+            charRect = Rectangle (0 :+ (- getDescent f)) (w' :+ (getHeight f - getDescent f))
             c' = mkLetter (0,0,0) Nothing . mkDrawBox $ do
                 withNewContext $ do
-                    applyMatrix $ translate (-w') (getDescent f - getHeight f + styleHeight st - styleDescent st)
+                    applyMatrix $ translate ((-w') :+ (getDescent f - getHeight f + styleHeight st - styleDescent st))
                     fillColor $ Rgb 0.6 0.6 1
                     strokeColor $ Rgb 0.6 0.6 1
                     fillAndStroke $ charRect
@@ -292,8 +293,8 @@
     
     paragraphChange s _ l = (s,l)
     
-    paragraphStyle (BluePara _) = Just $ \(Rectangle xa ya xb yb) b -> do
-        let f = Rectangle (xa-3) (ya-3) (xb+3) (yb+3)
+    paragraphStyle (BluePara _) = Just $ \(Rectangle (xa :+ ya) (xb :+ yb)) b -> do
+        let f = Rectangle ((xa-3) :+ (ya-3)) ((xb+3) :+ (yb+3))
         fillColor $ Rgb 0.6 0.6 1
         fill f
         b
@@ -304,7 +305,7 @@
     
             
 containerTest :: PDFReference PDFPage -> Rectangle ->( TM StandardParagraphStyle StandardStyle ())   -> PDF ()
-containerTest p (Rectangle xa ya xb yb) theText = 
+containerTest p (Rectangle (xa :+ ya) (xb :+ yb)) theText = 
     let c = mkContainer xa ya xb yb 0
         (d,c',r) = fillContainer (defaultVerState NormalParagraph) c . getBoxes NormalParagraph (Font (PDFFont Times_Roman 10) black black) $ do
             theText
@@ -318,7 +319,7 @@
           w = containerWidth c'
           --h = containerHeight c'
       strokeColor red
-      stroke $ Rectangle x y (x+w) (ya-100-yb)
+      stroke $ Rectangle (x :+ y) ((x+w) :+ (ya-100-yb))
       strokeColor blue
       stroke $ containerContentRectangle c'
       stroke $ containerContentRectangle c''
@@ -445,18 +446,18 @@
           0 -> do
                 strokeColor red
                 stroke $ Line 10 300 (10+100) 300
-                displayFormattedText (Rectangle 10 0 (10+100) 300) NormalPara Normal simpleText
+                displayFormattedText (Rectangle (10 :+ 0) ((10+100) :+ 300)) NormalPara Normal simpleText
                 
           1 -> do
               strokeColor red
               stroke $ Line 10 400 (10+maxw) 400
-              displayFormattedText (Rectangle 10 0 (10+maxw) 400) NormalPara Normal myText
+              displayFormattedText (Rectangle (10 :+ 0) ((10+maxw) :+ 400)) NormalPara Normal myText
           2 -> do
               strokeColor red
               stroke $ Line 10 300 (10+maxw) 300
-              displayFormattedText (Rectangle 10 0 (10+maxw) 300) NormalPara Normal debugText
+              displayFormattedText (Rectangle (10 :+ 0) ((10+maxw) :+ 300)) NormalPara Normal debugText
           3 -> do
-              let r = (Rectangle 10 200 (10+maxw) 300)
+              let r = (Rectangle (10 :+ 200) ((10+maxw) :+ 300))
               displayFormattedText r CirclePara Normal $ do
                    setStyle Normal
                    setFirstPassTolerance 5000
@@ -470,62 +471,83 @@
                        txt $ "Ut enim ad minim"
               strokeColor red
               stroke r
-          4 -> displayFormattedText ((Rectangle 10 0 (10+maxw) 300)) NormalParagraph (Font (PDFFont Times_Roman 10) black black) standardStyleTest
+          4 -> displayFormattedText (Rectangle (10 :+ 0) ((10+maxw) :+ 300)) NormalParagraph (Font (PDFFont Times_Roman 10) black black) standardStyleTest
           5 -> do
               strokeColor red
-              stroke $ Rectangle 10 300 (10+maxw) 400
-              displayFormattedText ((Rectangle 10 300 (10+maxw) 400)) NormalParagraph (Font (PDFFont Times_Roman 10) black black) $ do
+              stroke $ Rectangle (10 :+ 300) ((10+maxw) :+ 400)
+              displayFormattedText (Rectangle (10 :+ 300) ((10+maxw) :+ 400)) NormalParagraph (Font (PDFFont Times_Roman 10) black black) $ do
                   setJustification Centered
                   testText
                   
               strokeColor red
-              stroke $ Rectangle 10 200 (10+maxw) 300
-              displayFormattedText ((Rectangle 10 200 (10+maxw) 300)) NormalParagraph (Font (PDFFont Times_Roman 10) black black) $ do
+              stroke $ Rectangle (10 :+ 200) ((10+maxw) :+ 300)
+              displayFormattedText (Rectangle (10 :+ 200) ((10+maxw) :+ 300)) NormalParagraph (Font (PDFFont Times_Roman 10) black black) $ do
                   setJustification LeftJustification
                   testText
               
               strokeColor red
-              stroke $ Rectangle 10 100 (10+maxw) 200
-              displayFormattedText ((Rectangle 10 100 (10+maxw) 200)) NormalParagraph (Font (PDFFont Times_Roman 10) black black) $ do
+              stroke $ Rectangle (10 :+ 100) ((10+maxw) :+ 200)
+              displayFormattedText (Rectangle (10 :+ 100) ((10+maxw) :+ 200)) NormalParagraph (Font (PDFFont Times_Roman 10) black black) $ do
                   setJustification RightJustification
                   testText
               strokeColor red
               fillColor blue
-              stroke $ Rectangle 10 0 (10+maxw) 100
+              stroke $ Rectangle (10 :+ 0) ((10+maxw) :+ 100)
               drawText $ text (PDFFont Helvetica_Bold 24) 10 100 (toPDFString "Lorem ipsum")
               stroke $ Line 10 120 (10 + textWidth (PDFFont Helvetica_Bold 24) (toPDFString "Lorem ipsum") ) 120 
-              displayFormattedText ((Rectangle 10 0 (10+maxw) 100)) NormalParagraph (Font (PDFFont Times_Roman 10) black black) $ do
+              displayFormattedText (Rectangle (10 :+ 0) ((10+maxw) :+ 100)) NormalParagraph (Font (PDFFont Times_Roman 10) black black) $ do
                   setJustification LeftJustification
                   paragraph $ do
                       setStyle (Font (PDFFont Helvetica_Bold 24) black black)
                       txt $ "Lorem ipsum"
           6 -> do
                 strokeColor red
-                stroke $ Rectangle 10 300 (10+maxw) 400
-                displayFormattedText ((Rectangle 10 300 (10+maxw) 400)) NormalParagraph (Font (PDFFont Times_Roman 10) black black) $ do
+                stroke $ Rectangle (10 :+ 300) ((10+maxw) :+ 400)
+                displayFormattedText (Rectangle (10 :+ 300) ((10+maxw) :+ 400)) NormalParagraph (Font (PDFFont Times_Roman 10) black black) $ do
                     setJustification Centered
                     testBreakText
 
                 strokeColor red
-                stroke $ Rectangle 10 200 (10+maxw) 300
-                displayFormattedText ((Rectangle 10 200 (10+maxw) 300)) NormalParagraph (Font (PDFFont Times_Roman 10) black black) $ do
+                stroke $ Rectangle (10 :+ 200) ((10+maxw) :+ 300)
+                displayFormattedText (Rectangle (10 :+ 200) ((10+maxw) :+ 300)) NormalParagraph (Font (PDFFont Times_Roman 10) black black) $ do
                     setJustification LeftJustification
                     testBreakText
                 
                 strokeColor red
-                stroke $ Rectangle 10 100 (10+maxw) 200
-                displayFormattedText ((Rectangle 10 100 (10+maxw) 200)) NormalParagraph (Font (PDFFont Times_Roman 10) black black) $ do
+                stroke $ Rectangle (10 :+ 100) ((10+maxw) :+ 200)
+                displayFormattedText (Rectangle (10 :+ 100) ((10+maxw) :+ 200)) NormalParagraph (Font (PDFFont Times_Roman 10) black black) $ do
                     setJustification RightJustification
                     testBreakText
                     
                 strokeColor red
-                stroke $ Rectangle 10 0 (10+maxw) 100
-                displayFormattedText ((Rectangle 10 0 (10+maxw) 100)) NormalParagraph (Font (PDFFont Times_Roman 10) black black) $ do
+                stroke $ Rectangle (10 :+ 0) ((10+maxw) :+ 100)
+                displayFormattedText (Rectangle (10 :+ 0) ((10+maxw) :+ 100)) NormalParagraph (Font (PDFFont Times_Roman 10) black black) $ do
                     setJustification FullJustification
                     testBreakText
-          _ -> displayFormattedText ((Rectangle 0 300 (10+maxw) 300)) NormalPara Normal myText
+          _ -> displayFormattedText (Rectangle (0 :+ 300) ((10+maxw) :+ 300)) NormalPara Normal myText
      
-                                        
+textBoxes :: Draw ()
+textBoxes = do
+    let x = 230
+        y = 200
+        w = 220
+        h = 200
+    fillColor blue
+    fill $ Circle x y 5
+    let (r,b) = drawTextBox x y w h S NormalParagraph (Font (PDFFont Times_Roman 10) black black) $ do
+                setJustification FullJustification
+                paragraph $ do
+                    txt $ "Lorem ipsum dolor sit amet, consectetur adipisicing elit, sed do eiusmod tempor "
+                    txt $ "incididunt ut labore et dolore magna aliqua. Ut enim ad minim veniam, quis nostrud "
+                    txt $ "exercitation ullamco laboris nisi ut aliquip ex ea commodo consequat. Duis aute "
+                    txt $ "irure dolor in reprehenderit in voluptate velit esse cillum dolore eu fugiat nulla "
+                    txt $ "pariatur. Excepteur sint occaecat cupidatat non proident, sunt in culpa qui officia "
+                    txt $ "deserunt mollit anim id est laborum."
+    b
+    strokeColor red
+    stroke r
+    return ()
+                                       
 testAll :: JpegFile -> PDF ()
 testAll jpg = do
     page1 <- addPage Nothing
@@ -555,8 +577,8 @@
           
      page3c <- addPage Nothing
      newSection (toPDFString "Container") Nothing Nothing $ do
-            containerTest page3c (Rectangle 10 300 100 100) testText
-            containerTest page3c (Rectangle 210 300 200 100) $ do
+            containerTest page3c (Rectangle (10 :+ 300)  (100 :+ 100)) testText
+            containerTest page3c (Rectangle (210 :+ 300) (200 :+ 100)) $ do
                 setJustification Centered
                 testText
         
@@ -603,7 +625,10 @@
         textTest
     newSection (toPDFString "Fun") Nothing Nothing $ do
         penrose
-     
+    page12 <- addPage Nothing
+    newSection (toPDFString "Text box") Nothing Nothing $ do
+      drawWithPage page12 $ do
+        textBoxes
     
         
 main :: IO()