diff --git a/Graphics/PDF.hs b/Graphics/PDF.hs
--- a/Graphics/PDF.hs
+++ b/Graphics/PDF.hs
@@ -54,6 +54,19 @@
   , module Graphics.PDF.Pattern
   -- ** Shading
   , module Graphics.PDF.Shading
+  -- ** Transparency
+  , module Graphics.PDF.Transparency
+  , ColorSpace(..)
+  , calculator1
+  , calculator2
+  , ColorFunction1(..)
+  , ColorFunction2(..)
+  , Function1(..)
+  , Function2(..)
+  , Global
+  , Local
+  , linearStitched
+  , FunctionObject
   -- ** Fonts
   , module Graphics.PDF.Fonts.Font 
   , module Graphics.PDF.Fonts.StandardFont
@@ -69,12 +82,12 @@
 #endif
  
 import Graphics.PDF.Typesetting
+import Graphics.PDF.Transparency
 import Graphics.PDF.Shading
 import Graphics.PDF.Pattern
 import Graphics.PDF.Navigation
 import Graphics.PDF.Text
 import qualified Data.IntMap as IM
-import qualified Data.Map.Strict as M
 import qualified Data.ByteString.Lazy as B
 import Data.Int
 import Text.Printf(printf)
@@ -86,14 +99,15 @@
 import Graphics.PDF.Shapes
 import Graphics.PDF.Coordinates
 import Graphics.PDF.Pages
-import Graphics.PDF.Document
+import Graphics.PDF.Document hiding (createPDFXFormExtra)
 import Codec.Compression.Zlib
 import Graphics.PDF.Action
 import Graphics.PDF.Image
 import Graphics.PDF.Resources(emptyResource)
 import Data.Binary.Builder(Builder,fromLazyByteString, toLazyByteString)
 import Graphics.PDF.LowLevel.Serializer
-import Data.List(unfoldr)
+import Data.List(mapAccumL)
+import Data.Maybe(fromMaybe)
 import qualified Data.Text as T
 import Graphics.PDF.Fonts.Font 
 import Graphics.PDF.Fonts.StandardFont
@@ -143,7 +157,7 @@
          case p of
              -- Not linked to a page
              Nothing -> do                  
-                  return $ (otherRsrcs state') `pdfDictUnion` (PDFDictionary . M.fromList  $ [(PDFName "Resources",AnyPdfObject rsrcRef)])
+                  return $ (otherRsrcs state') `pdfDictUnion` (dictFromList  $ [entry "Resources" rsrcRef])
              -- Linked to a page
              Just pageRef -> do
                   setPageAnnotations (annots state') pageRef
@@ -157,12 +171,12 @@
        then do
          let w''' = compress . toLazyByteString $ w'
              w'' = fromLazyByteString w'''
-         updateObject (PDFReference k :: PDFReference PDFStream) (PDFStream w'' True ref resources)
-         updateObject ref (UnknownLength)
+         updateObject (PDFReference k :: PDFReference PDFStream) (PDFStream w'' True (Left ref) resources)
+         updateObject ref UnknownLength
          --updateObject ref (PDFLength (B.length w'''))
        else do
-         updateObject (PDFReference k :: PDFReference PDFStream) (PDFStream w' False ref resources)
-         updateObject ref (UnknownLength)
+         updateObject (PDFReference k :: PDFReference PDFStream) (PDFStream w' False (Left ref) resources)
+         updateObject ref UnknownLength
          --updateObject ref (PDFLength (B.length . toLazyByteString $ w'))
 
 -- | Save all the pages and streams in the main object dictionary
@@ -192,15 +206,15 @@
 #endif
     
 instance PdfObject PDFTrailer where
-   toPDF (PDFTrailer size root infos) = toPDF $ PDFDictionary. M.fromList $ 
-     [ (PDFName "Size",AnyPdfObject . PDFInteger $ size)
-     , (PDFName "Root",AnyPdfObject root)
-     , (PDFName "Info",AnyPdfObject . PDFDictionary . M.fromList $ allInfos)
+   toPDF (PDFTrailer size root infos) = toPDF $ dictFromList $
+     [ entry "Size" (PDFInteger $ size)
+     , entry "Root" root
+     , entry "Info" (dictFromList $ allInfos)
      ]
      where
-      allInfos = [ (PDFName "Author",AnyPdfObject . toPDFString . author $ infos)
-                 , (PDFName "Subject",AnyPdfObject . toPDFString . subject $ infos)
-                 , (PDFName "Producer",AnyPdfObject $ toPDFString (T.pack "HPDF - The Haskell PDF Library" ))
+      allInfos = [ entry "Author" (toPDFString . author $ infos)
+                 , entry "Subject" (toPDFString . subject $ infos)
+                 , entry "Producer" (toPDFString (T.pack "HPDF - The Haskell PDF Library" ))
                  ]
 
 instance PdfLengthInfo PDFTrailer where
@@ -264,19 +278,14 @@
           objectEncoding (x,a) = toPDF . PDFReferencedObject (fromIntegral $! x) $ a
           (root,s) = flip runState pdfState  . unPDF $ createPDF >> m >> saveObjects
           objs = objects s
-          encodeAnObject (_,[]) = Nothing 
-          encodeAnObject (im,k:t) = 
+          encodeAnObject im k =
             let Just o = IM.lookup k im
-                result = do 
-                    (l,PDFReference ref) <- pdfLengthInfo o 
-                    let im' = IM.insert ref (AnyPdfObject (KnownLength (PDFLength l))) im
-                    return im'
-            in
-            case result of 
-              Nothing -> Just (objectEncoding (k,o),(im,t)) 
-              Just im' ->  Just (objectEncoding (k,o),(im',t)) 
+                mim = do
+                    (l, PDFReference ref) <- pdfLengthInfo o
+                    return $ IM.insert ref (AnyPdfObject (KnownLength l)) im
+            in (fromMaybe im mim, objectEncoding (k,o))
 
-          encodedObjects = unfoldr encodeAnObject (objs,IM.keys objs)
+          encodedObjects = snd $ mapAccumL encodeAnObject objs (IM.keys objs)
           objectContents = header : encodedObjects
           (_nb, _len, _toc) = writeObjectsAndCreateToc objectContents
       in
diff --git a/Graphics/PDF/Action.hs b/Graphics/PDF/Action.hs
--- a/Graphics/PDF/Action.hs
+++ b/Graphics/PDF/Action.hs
@@ -19,7 +19,6 @@
  ) where
      
 import Graphics.PDF.LowLevel.Types
-import qualified Data.Map.Strict as M
 import Network.URI 
 
 
@@ -37,17 +36,17 @@
 
 --data Rendition = Rendition
 --instance PdfObject Rendition where
---  toPDF a = toPDF . PDFDictionary . M.fromList $
---                    [ (PDFName "Type",AnyPdfObject . PDFName $ "Rendition")
---                    , (PDFName "S",AnyPdfObject . PDFName $ "MR")
---                    , (PDFName "C",AnyPdfObject movie)
+--  toPDF a = toPDF . dictFromList $
+--                    [ entry "Type" (PDFName $ "Rendition")
+--                    , entry "S" (PDFName $ "MR")
+--                    , entry "C" movie
 --                    ]
 --    where
---        movie = PDFDictionary . M.fromList $
---               [ (PDFName "Type",AnyPdfObject . PDFName $ "MediaClip")
---               , (PDFName "S",AnyPdfObject . PDFName $ "MCD")
---               , (PDFName "CT",AnyPdfObject . toPDFString $ "video/3gpp")
---               , (PDFName "D",AnyPdfObject (toPDFString "17.3gp"))
+--        movie = dictFromList $
+--               [ entry "Type" (PDFName $ "MediaClip")
+--               , entry "S" (PDFName $ "MCD")
+--               , entry "CT" (toPDFString $ "video/3gpp")
+--               , entry "D" (toPDFString "17.3gp")
 --               ]
 
 --  Action to control a media
@@ -61,10 +60,10 @@
 
 
 instance PdfObject GoToURL where
-    toPDF (GoToURL s) = toPDF . PDFDictionary . M.fromList $
-                         [ (PDFName "Type",AnyPdfObject . PDFName $ "Action")
-                         , (PDFName "S",AnyPdfObject (PDFName "URI"))
-                         , (PDFName "URI",AnyPdfObject (urlToPdfString s))
+    toPDF (GoToURL s) = toPDF . dictFromList $
+                         [ entry "Type" (PDFName $ "Action")
+                         , entry "S" (PDFName "URI")
+                         , entry "URI" (urlToPdfString s)
                          ]
 instance Action GoToURL
 
@@ -72,12 +71,12 @@
 
 
 --instance PdfObject ControlMedia where
---    toPDF (ControlMedia operation relatedScreenAnnotation rendition) = toPDF . PDFDictionary . M.fromList $
---                         [ (PDFName "Type",AnyPdfObject . PDFName $ "Action")
---                         , (PDFName "S",AnyPdfObject (PDFName "Rendition"))
---                         , (PDFName "R",AnyPdfObject rendition)
---                         , (PDFName "OP",AnyPdfObject . PDFInteger $ (fromEnum operation))
---                         , (PDFName "AN",AnyPdfObject $ (PDFReference relatedScreenAnnotation :: PDFReference AnyPdfObject))
+--    toPDF (ControlMedia operation relatedScreenAnnotation rendition) = toPDF . dictFromList $
+--                         [ entry "Type" (PDFName $ "Action")
+--                         , entry "S" (PDFName "Rendition")
+--                         , entry "R" rendition
+--                         , entry "OP" (PDFInteger $ fromEnum operation)
+--                         , entry "AN" ((PDFReference relatedScreenAnnotation :: PDFReference AnyPdfObject))
 --                         ]
 --                         
 --instance Action ControlMedia
diff --git a/Graphics/PDF/Annotation.hs b/Graphics/PDF/Annotation.hs
--- a/Graphics/PDF/Annotation.hs
+++ b/Graphics/PDF/Annotation.hs
@@ -24,7 +24,6 @@
 
 import Graphics.PDF.LowLevel.Types
 import Graphics.PDF.Draw
-import qualified Data.Map.Strict as M
 import Graphics.PDF.Action
 import Graphics.PDF.Pages
 import Control.Monad.State(gets)
@@ -94,19 +93,19 @@
 getBorder True = [0,0,1]
 
 standardAnnotationDict :: AnnotationObject a => a -> [(PDFName,AnyPdfObject)]
-standardAnnotationDict a = [(PDFName "Type",AnyPdfObject . PDFName $ "Annot")
-                         , (PDFName "Subtype",AnyPdfObject $ annotationType a)
-                         , (PDFName "Rect",AnyPdfObject . map AnyPdfObject $ annotationRect a)
-                         , (PDFName "Contents",AnyPdfObject $ annotationContent a)
+standardAnnotationDict a = [entry "Type" (PDFName $ "Annot")
+                         , entry "Subtype" (annotationType a)
+                         , entry "Rect" (annotationRect a)
+                         , entry "Contents" (annotationContent a)
                          ]
 
 --instance PdfObject Screen where
---   toPDF a@(Screen _ _ _ p play stop) = toPDF . PDFDictionary . M.fromList $ 
---        standardAnnotationDict a ++ [(PDFName "P",AnyPdfObject p)]
---                                    ++ (maybe [] (\x -> [(PDFName "A",AnyPdfObject x)]) play)
---                                    ++ (maybe [] (\x -> [(PDFName "AA",AnyPdfObject $ otherActions x)]) stop)
+--   toPDF a@(Screen _ _ _ p play stop) = toPDF . dictFromList $
+--        standardAnnotationDict a ++ [entry "P" p]
+--                                    ++ (maybe [] (\x -> [entry "A" x]) play)
+--                                    ++ (maybe [] (\x -> [entry "AA" (otherActions x)]) stop)
 --         where
---             otherActions x = PDFDictionary . M.fromList $ [(PDFName "D",AnyPdfObject x)]
+--             otherActions x = dictFromList $ [entry "D" x]
 --
 --instance AnnotationObject Screen where
 --  addAnnotation (Screen video s rect p _ _) = do
@@ -120,8 +119,8 @@
 --  annotationRect (Screen _ _ r _ _ _) = r
                              
 instance PdfObject TextAnnotation where
-      toPDF a@(TextAnnotation _ _ i) = toPDF . PDFDictionary . M.fromList $ 
-           standardAnnotationDict a ++ [(PDFName "Name",AnyPdfObject . PDFName $ show i)]
+      toPDF a@(TextAnnotation _ _ i) = toPDF . dictFromList $
+           standardAnnotationDict a ++ [entry "Name" (PDFName $ show i)]
 
 instance PdfLengthInfo TextAnnotation where
 
@@ -135,10 +134,10 @@
         return $ TextAnnotation a gr b
     
 instance PdfObject URLLink where
-    toPDF a@(URLLink _ _ url border) = toPDF . PDFDictionary . M.fromList $ 
+    toPDF a@(URLLink _ _ url border) = toPDF . dictFromList $
            standardAnnotationDict a ++ 
-            [ (PDFName "A",AnyPdfObject (GoToURL url))
-            , (PDFName "Border",AnyPdfObject . map AnyPdfObject $ (getBorder border))
+            [ entry "A" (GoToURL url)
+            , entry "Border" (getBorder border)
             ]
 
 instance PdfLengthInfo URLLink where
@@ -153,10 +152,10 @@
         return $ URLLink a gr b c
         
 instance PdfObject PDFLink where
-    toPDF a@(PDFLink _ _ page x y border) = toPDF . PDFDictionary . M.fromList $ 
+    toPDF a@(PDFLink _ _ page x y border) = toPDF . dictFromList $
                standardAnnotationDict a ++ 
-                [(PDFName "Dest",AnyPdfObject dest)
-                ,(PDFName "Border",AnyPdfObject . map AnyPdfObject $ (getBorder border))]
+                [entry "Dest" dest
+                ,entry "Border" (getBorder border)]
      where
          dest =  [ AnyPdfObject page
                  , AnyPdfObject (PDFName "XYZ")
diff --git a/Graphics/PDF/Colors.hs b/Graphics/PDF/Colors.hs
--- a/Graphics/PDF/Colors.hs
+++ b/Graphics/PDF/Colors.hs
@@ -30,7 +30,6 @@
      
 import Graphics.PDF.Draw
 import Graphics.PDF.LowLevel.Types
-import Control.Monad.State(gets)
 import Graphics.PDF.Resources
 import Control.Monad.Writer
 import Graphics.PDF.LowLevel.Serializer
@@ -55,24 +54,26 @@
 -- | Set alpha value for transparency
 setStrokeAlpha :: Double -> Draw ()
 setStrokeAlpha alpha = do
-    alphaMap <- gets strokeAlphas
-    (newName,newMap) <- setResource "ExtGState" (StrokeAlpha alpha) alphaMap
-    modifyStrict $ \s -> s { strokeAlphas = newMap }
-    tell . mconcat $ [ serialize "\n/" 
-                     , serialize newName
-                     , serialize " gs"
-                     ]
-        
+    newName <-
+        registerResource "ExtGState"
+            strokeAlphas (\newMap s -> s { strokeAlphas = newMap })
+            (StrokeAlpha alpha)
+    tell . mconcat $[ serialize "\n/" 
+                    , serialize newName
+                    , serialize " gs"
+                    ]
+
 -- | Set alpha value for transparency
 setFillAlpha :: Double -> Draw ()
 setFillAlpha alpha = do
-    alphaMap <- gets fillAlphas
-    (newName,newMap) <- setResource "ExtGState" (FillAlpha alpha) alphaMap
-    modifyStrict $ \s -> s { fillAlphas = newMap }
-    tell . mconcat $ [ serialize "\n/" 
-                     , serialize newName
-                     , serialize " gs"
-                     ]
+    newName <-
+        registerResource "ExtGState"
+            fillAlphas (\newMap s -> s { fillAlphas = newMap })
+            (FillAlpha alpha)
+    tell . mconcat $[ serialize "\n/" 
+                    , serialize newName
+                    , serialize " gs"
+                    ]
     
 -- | Init the PDF color space to RGB.
 setRGBColorSpace :: Draw ()
@@ -84,46 +85,46 @@
 fillColor :: MonadPath m => Color -- ^ Filling color
           -> m ()
 fillColor (Rgb r g b) = do
-    tell . mconcat $ [ serialize "\n"
-                     , toPDF r
-                     , serialize ' '
-                     , toPDF g
-                     , serialize ' '
-                     , toPDF b
-                     , serialize " rg" 
-                     ]
+    tell . mconcat $[ serialize "\n"
+                    , toPDF r
+                    , serialize ' '
+                    , toPDF g
+                    , serialize ' '
+                    , toPDF b
+                    , serialize " rg" 
+                    ]
                     
 fillColor (Hsv h s v) = do
         let (r,g,b) = hsvToRgb (h,s,v)
-        tell . mconcat $ [ serialize "\n"
-                         , toPDF r
-                         , serialize ' '
-                         , toPDF g
-                         , serialize ' '
-                         , toPDF b
-                         , serialize " rg" 
-                         ]
+        tell . mconcat $[ serialize "\n"
+                        , toPDF r
+                        , serialize ' '
+                        , toPDF g
+                        , serialize ' '
+                        , toPDF b
+                        , serialize " rg" 
+                        ]
 
 -- | Select the drawing color
 strokeColor :: MonadPath m => Color -- ^ Drawing color
             -> m ()
 strokeColor (Rgb r g b) = do
-    tell . mconcat $ [ serialize "\n"
-                     , toPDF r
-                     , serialize ' '
-                     , toPDF g
-                     , serialize ' '
-                     , toPDF b
-                     , serialize " RG" 
-                     ]
+    tell . mconcat $[ serialize "\n"
+                    , toPDF r
+                    , serialize ' '
+                    , toPDF g
+                    , serialize ' '
+                    , toPDF b
+                    , serialize " RG" 
+                    ]
 strokeColor (Hsv h s v) = do
     let (r,g,b) = hsvToRgb (h,s,v)
-    tell . mconcat $ [ serialize "\n"
-                     , toPDF r
-                     , serialize ' '
-                     , toPDF g
-                     , serialize ' '
-                     , toPDF b
-                     , serialize " RG" 
-                     ]
+    tell . mconcat $[ serialize "\n"
+                    , toPDF r
+                    , serialize ' '
+                    , toPDF g
+                    , serialize ' '
+                    , toPDF b
+                    , serialize " RG" 
+                    ]
 
diff --git a/Graphics/PDF/Coordinates.hs b/Graphics/PDF/Coordinates.hs
--- a/Graphics/PDF/Coordinates.hs
+++ b/Graphics/PDF/Coordinates.hs
@@ -71,7 +71,7 @@
        
 data Matrix
    = Matrix !PDFFloat !PDFFloat !PDFFloat !PDFFloat !PDFFloat !PDFFloat
-   deriving (Eq, Show)
+   deriving (Eq, Ord, Show)
 
 instance Num Matrix where
     --  Matrix addition
diff --git a/Graphics/PDF/Document.hs b/Graphics/PDF/Document.hs
--- a/Graphics/PDF/Document.hs
+++ b/Graphics/PDF/Document.hs
@@ -19,6 +19,7 @@
  , addPageWithTransition
  , drawWithPage
  , createPDFXForm
+ , createPDFXFormExtra
  -- ** Page transitions
  , PDFTransition(..)
  , PDFTransStyle(..)
@@ -49,10 +50,11 @@
 import Graphics.PDF.LowLevel.Types
 import Graphics.PDF.Draw
 import Graphics.PDF.Pages
+import Graphics.PDF.Shapes (Rectangle(Rectangle))
 import Control.Monad.State
 import qualified Data.IntMap as IM
-import qualified Data.Map.Strict as M
 import qualified Data.Text as T
+import Data.Complex (Complex((:+)))
 
 -- | No information for the document  
 standardDocInfo :: PDFDocumentInfo          
@@ -65,15 +67,27 @@
               -> PDFFloat -- ^ Top
               -> Draw a -- ^ Drawing commands
               -> PDF (PDFReference PDFXForm)
-createPDFXForm xa ya xb yb d = let a' = do modifyStrict $ \s -> s  {otherRsrcs = PDFDictionary. M.fromList $ 
-                                                                       [ (PDFName "Type",AnyPdfObject . PDFName $ "XObject")
-                                                                       , (PDFName "Subtype",AnyPdfObject . PDFName $ "Form")
-                                                                       , (PDFName "FormType",AnyPdfObject . PDFInteger $ 1)
-                                                                       , (PDFName "Matrix",AnyPdfObject . (map (AnyPdfObject . PDFInteger)) $ [1,0,0,1,0,0])
-                                                                       , (PDFName "BBox",AnyPdfObject . (map AnyPdfObject) $ [xa,ya,xb,yb])
-                                                                       ]
-                                                                  }
-                                           d
+createPDFXForm xa ya xb yb d =
+    createPDFXFormExtra (Rectangle (xa:+ya) (xb:+yb)) d emptyDictionary
+
+-- | Create a PDF XObject
+createPDFXFormExtra ::
+                 Rectangle -- ^ Bounding Box
+              -> Draw a -- ^ Drawing commands
+              -> PDFDictionary
+              -> PDF (PDFReference PDFXForm)
+createPDFXFormExtra (Rectangle (xa:+ya) (xb:+yb)) d dict =
+ let a' = do
+            modifyStrict $ \s -> s {
+                otherRsrcs = pdfDictUnion dict $ dictFromList $
+                    [ entry "Type" (PDFName $ "XObject")
+                    , entry "Subtype" (PDFName $ "Form")
+                    , entry "FormType" (PDFInteger $ 1)
+                    , entry "Matrix" (map PDFInteger $ [1,0,0,1,0,0])
+                    , entry "BBox" (map AnyPdfObject $ [xa,ya,xb,yb])
+                    ]
+              }
+            d
  in do
      PDFReference s <- createContent a' Nothing  
      recordBound s (xb-xa) (yb-ya)
diff --git a/Graphics/PDF/Draw.hs b/Graphics/PDF/Draw.hs
--- a/Graphics/PDF/Draw.hs
+++ b/Graphics/PDF/Draw.hs
@@ -1,10 +1,12 @@
 {-# LANGUAGE CPP #-}
-{-# LANGUAGE RankNTypes #-}
+{-# LANGUAGE Rank2Types #-}
 {-# LANGUAGE EmptyDataDecls #-}
 {-# LANGUAGE ExistentialQuantification #-}
+{-# LANGUAGE GADTs #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
+{-# LANGUAGE StandaloneDeriving #-}
 ---------------------------------------------------------
 -- |
 -- Copyright   : (c) 2006-2016, alpheccar.org
@@ -34,6 +36,7 @@
 -- , writeCmd
  , runDrawing
  , setResource
+ , registerResource
  , emptyEnvironment
  , PDFXForm
  , PDFXObject(..)
@@ -72,6 +75,26 @@
  , AnyAnnotation(..)
  , AnnotationStyle(..)
  , PDFShading(..)
+ , ColorSpace(..)
+ , colorSpaceName
+ , calculator1
+ , calculator2
+ , ColorFunction1(..)
+ , ColorFunction2(..)
+ , Function1(..)
+ , Function2(..)
+ , Global
+ , Local
+ , linearStitched
+ , FunctionObject(FunctionObject, FunctionStream)
+ , rsrcFromCalculator
+ , rsrcFromInterpolated
+ , rsrcFromSampled
+ , rsrcFromStitched
+ , ColorTuple
+ , domain1Dict
+ , domain2Dict
+ , SoftMask(..)
  , getRgbColor
  , emptyDrawState
  , Matrix(..)
@@ -81,8 +104,7 @@
  , multiplyCurrentMatrixWith
  , PDFGlobals(..)
  ) where
- 
-import Data.Maybe
+
 #if !MIN_VERSION_base(4,8,0)
 import Data.Monoid
 #endif
@@ -91,6 +113,9 @@
 import qualified Data.IntMap as IM
 import qualified Data.Binary.Builder as BU
 import qualified Data.ByteString.Lazy as B
+import qualified Data.ByteString.Lazy.Char8 as C
+import qualified Data.Array as Array
+import Data.Array (Array)
 
 import Control.Monad.ST
 import Data.STRef
@@ -99,6 +124,8 @@
 import Control.Monad.Reader.Class
 import Control.Monad.State
 
+import qualified Graphics.PDF.Expression as Expr
+import Graphics.PDF.Expression (PDFExpression)
 import Graphics.PDF.Coordinates
 import Graphics.PDF.LowLevel.Types
 import Graphics.PDF.LowLevel.Serializer
@@ -107,6 +134,8 @@
 import qualified Data.Text as T
 import Graphics.PDF.Fonts.Font(PDFFont(..))
 
+import Text.Printf (printf)
+
 data AnnotationStyle = AnnotationStyle !(Maybe Color)
 
 class AnnotationObject a where
@@ -149,6 +178,7 @@
                 ,  patterns :: M.Map (PDFReference AnyPdfPattern) String
                 ,  colorSpaces :: M.Map PDFColorSpace String
                 ,  shadings :: M.Map PDFShading String
+                ,  softMasks :: M.Map SoftMask String
                 ,  matrix :: [Matrix]
                 }
 data DrawEnvironment = DrawEnvironment {
@@ -184,6 +214,7 @@
     m >>= f  = Draw $ \env -> do
                           a <- unDraw m env
                           unDraw (f a) env
+    return x = Draw $ \_env -> return x
 
 instance MonadReader DrawEnvironment Draw where
    ask       = Draw $ \env -> return (drawEnvironment env)
@@ -221,8 +252,13 @@
 modifyDrawST f g = Draw $ \env -> modifySTRef (f env) g
 
 -- | A PDF stream object
-data PDFStream = PDFStream !BU.Builder !Bool !(PDFReference MaybeLength) !PDFDictionary
-                                   
+data PDFStream =
+    PDFStream
+        !BU.Builder
+        !Bool
+        !(Either (PDFReference MaybeLength) PDFLength)
+        !PDFDictionary
+
 instance PdfObject PDFStream where
   toPDF (PDFStream s c l d) = 
       mconcat   $ [ toPDF dict
@@ -233,13 +269,17 @@
                   , serialize "endstream"]
    where
       compressedStream False = []
-      compressedStream True = if not (pdfDictMember (PDFName "Filter") d) then [(PDFName "Filter",AnyPdfObject $ [AnyPdfObject . PDFName $ "FlateDecode"])] else []
-      lenDict = PDFDictionary. M.fromList $ [ (PDFName "Length",AnyPdfObject l)] ++ compressedStream c
+      compressedStream True = if not (pdfDictMember (PDFName "Filter") d) then [entry "Filter" [PDFName $ "FlateDecode"]] else []
+      lenDict = dictFromList $ [either (entry "Length") (entry "Length") l] ++ compressedStream c
       dict = pdfDictUnion lenDict d
 
 instance PdfLengthInfo PDFStream where 
-  pdfLengthInfo (PDFStream s _ l _) = Just (B.length . BU.toLazyByteString $ s,l)
-    
+  pdfLengthInfo (PDFStream s _ el _) =
+      either
+        (\ref -> Just (PDFLength . B.length . BU.toLazyByteString $ s, ref))
+        (const Nothing)
+        el
+
 -- | An empty drawing
 emptyDrawing :: Draw ()
 emptyDrawing = return ()
@@ -258,7 +298,7 @@
 emptyDrawState :: Int -> DrawState
 emptyDrawState ref = 
     let names = (map (("O" ++ (show ref)) ++ ) $ [replicate k ['a'..'z'] | k <- [1..]] >>= sequence) in
-    DrawState names emptyRsrc M.empty M.empty M.empty M.empty emptyDictionary []  M.empty M.empty M.empty [identity]
+    DrawState names emptyRsrc M.empty M.empty M.empty M.empty emptyDictionary []  M.empty M.empty M.empty M.empty [identity]
   
 -- | Execute the drawing commands to get a new state and an uncompressed PDF stream
 runDrawing :: Draw a -> DrawEnvironment -> DrawState -> (a,DrawState,BU.Builder)
@@ -317,6 +357,20 @@
              return (newName,M.insert values newName oldCache)
         Just n -> return (n,oldCache)
 
+-- ToDo: setter and getter could be replaced by an Accessor or a Lens
+registerResource ::
+    (Ord a, PdfResourceObject a) =>
+    String ->
+    (DrawState -> M.Map a String) ->
+    (M.Map a String -> DrawState -> DrawState) ->
+    a -> Draw String
+registerResource dict getMap setMap resource = do
+    oldMap <- gets getMap
+    (newName,newMap) <- setResource dict resource oldMap
+    modifyStrict $ setMap newMap
+    return newName
+
+
 instance PDFGlobals Draw where
     bounds (PDFReference r) = getBoundInDraw r
     
@@ -329,9 +383,10 @@
     
     privateDrawXObject :: PDFReference a -> Draw ()
     privateDrawXObject (PDFReference r) = do
-        xobjectMap <- gets xobjects
-        (newName,newMap) <- setResource "XObject" (PDFReference r) xobjectMap
-        modifyStrict $ \s -> s { xobjects = newMap }
+        newName <-
+            registerResource "XObject"
+                xobjects (\newMap s -> s { xobjects = newMap })
+                (PDFReference r)
         tell . mconcat  $ [ serialize "\n/" 
                           , serialize newName
                           , serialize " Do"
@@ -519,10 +574,10 @@
 data PDFOutline = PDFOutline !(PDFReference PDFOutlineEntry) !(PDFReference PDFOutlineEntry)
 
 instance PdfObject PDFOutline where
- toPDF (PDFOutline first lasto) = toPDF $ PDFDictionary. M.fromList $ [
-    (PDFName "Type",AnyPdfObject . PDFName $ "Outlines")
-  , (PDFName "First",AnyPdfObject first)
-  , (PDFName "Last",AnyPdfObject lasto)
+ toPDF (PDFOutline first lasto) = toPDF $ dictFromList $ [
+    entry "Type" (PDFName $ "Outlines")
+  , entry "First" first
+  , entry "Last" lasto
   ]
 
 instance PdfLengthInfo PDFOutline where
@@ -561,14 +616,14 @@
 data OutlineLoc  a = OutlineLoc (Tree a) (OutlineCtx a)
 
 instance PdfObject PDFViewerPreferences where
-  toPDF (PDFViewerPreferences ht hm hwui fw cw ddt nfspm ) = toPDF $ PDFDictionary. M.fromList $ 
-   [ (PDFName "HideToolbar",AnyPdfObject ht)
-   , (PDFName "HideMenubar",AnyPdfObject hm)
-   , (PDFName "HideWindowUI",AnyPdfObject hwui)
-   , (PDFName "FitWindow",AnyPdfObject fw)
-   , (PDFName "CenterWindow",AnyPdfObject cw)
-   , (PDFName "DisplayDocTitle",AnyPdfObject ddt)
-   , (PDFName "NonFullScreenPageMode",AnyPdfObject  . PDFName . show $ nfspm)
+  toPDF (PDFViewerPreferences ht hm hwui fw cw ddt nfspm ) = toPDF $ dictFromList $
+   [ entry "HideToolbar" ht
+   , entry "HideMenubar" hm
+   , entry "HideWindowUI" hwui
+   , entry "FitWindow" fw
+   , entry "CenterWindow" cw
+   , entry "DisplayDocTitle" ddt
+   , entry "NonFullScreenPageMode" (PDFName . show $ nfspm)
    ]
 
 instance PdfLengthInfo PDFViewerPreferences where
@@ -583,20 +638,20 @@
    show (Glitter _) = "Glitter"
 
 instance PdfObject PDFTransition where
- toPDF (PDFTransition d t) = toPDF $ PDFDictionary. M.fromList $ 
-   [ (PDFName "Type",AnyPdfObject (PDFName "Trans"))
-   , (PDFName "S",AnyPdfObject (PDFName (show t)))
-   , (PDFName "D",AnyPdfObject d)
+ toPDF (PDFTransition d t) = toPDF $ dictFromList $
+   [ entry "Type" (PDFName "Trans")
+   , entry "S" (PDFName (show t))
+   , entry "D" d
    ] ++ optionalDm t ++ optionalM t ++ optionalDi t
   where
-    optionalDm (Split a _) = [ (PDFName "Dm",AnyPdfObject (PDFName (show a)))]
-    optionalDm (Blinds a) = [ (PDFName "Dm",AnyPdfObject (PDFName (show a)))]
+    optionalDm (Split a _) = [ entry "Dm" (PDFName (show a))]
+    optionalDm (Blinds a) = [ entry "Dm" (PDFName (show a))]
     optionalDm _ = []
-    optionalM (Split _ a) = [ (PDFName "M",AnyPdfObject (PDFName (show a)))]
-    optionalM (Box a) = [ (PDFName "M",AnyPdfObject (PDFName (show a)))]
+    optionalM (Split _ a) = [ entry "M" (PDFName (show a))]
+    optionalM (Box a) = [ entry "M" (PDFName (show a))]
     optionalM _ = []    
-    optionalDi (Wipe a) = [ (PDFName "Di",AnyPdfObject (floatDirection a))]
-    optionalDi (Glitter a)  = [ (PDFName "Di",AnyPdfObject (floatDirection a))]
+    optionalDi (Wipe a) = [ entry "Di" (floatDirection a)]
+    optionalDi (Glitter a)  = [ entry "Di" (floatDirection a)]
     optionalDi _ = []  
 
 instance PdfLengthInfo PDFTransition where
@@ -604,35 +659,33 @@
 -- PDF Pages
 
 instance PdfObject PDFPages where
- toPDF (PDFPages c Nothing l) = toPDF $ PDFDictionary. M.fromList $ 
-  [ (PDFName "Type",AnyPdfObject (PDFName "Pages"))
-  , (PDFName "Kids",AnyPdfObject $ map AnyPdfObject l)
-  , (PDFName "Count",AnyPdfObject . PDFInteger $ c)
-  ] 
- toPDF (PDFPages c (Just theParent) l) = toPDF $ PDFDictionary. M.fromList $ 
-  [ (PDFName "Type",AnyPdfObject (PDFName "Pages"))
-  , (PDFName "Parent",AnyPdfObject theParent)
-  , (PDFName "Kids",AnyPdfObject $ map AnyPdfObject l)
-  , (PDFName "Count",AnyPdfObject . PDFInteger $ c)
-  ] 
+ toPDF (PDFPages c Nothing l) = toPDF $ dictFromList $
+  [ entry "Type" (PDFName "Pages")
+  , entry "Kids" l
+  , entry "Count" (PDFInteger $ c)
+  ]
+ toPDF (PDFPages c (Just theParent) l) = toPDF $ dictFromList $
+  [ entry "Type" (PDFName "Pages")
+  , entry "Parent" theParent
+  , entry "Kids" l
+  , entry "Count" (PDFInteger $ c)
+  ]
 
 instance PdfLengthInfo PDFPages where
 
 
 instance PdfObject PDFPage where
- toPDF (PDFPage (Just theParent) box content theRsrc d t theAnnots) = toPDF $ PDFDictionary. M.fromList $ 
-  [ (PDFName "Type",AnyPdfObject (PDFName "Page"))
-  , (PDFName "Parent",AnyPdfObject theParent)
-  , (PDFName "MediaBox",AnyPdfObject box)
-  , (PDFName "Contents",AnyPdfObject content)
-  , if isJust theRsrc 
-      then
-       (PDFName "Resources",AnyPdfObject . fromJust $ theRsrc) 
-      else 
-       (PDFName "Resources",AnyPdfObject emptyDictionary)
-  ] ++ (maybe [] (\x -> [(PDFName "Dur",AnyPdfObject x)]) d)
-  ++ (maybe [] (\x -> [(PDFName "Trans",AnyPdfObject x)]) t)
-  ++ ((\x -> if null x then [] else [(PDFName "Annots",AnyPdfObject x)]) theAnnots)
+ toPDF (PDFPage (Just theParent) box content theRsrc d t theAnnots) = toPDF $ dictFromList $
+  [ entry "Type" (PDFName "Page")
+  , entry "Parent" theParent
+  , entry "MediaBox" box
+  , entry "Contents" content
+  , case theRsrc of
+      Just res -> entry "Resources" res
+      Nothing -> entry "Resources" emptyDictionary
+  ] ++ (maybe [] (\x -> [entry "Dur" x]) d)
+  ++ (maybe [] (\x -> [entry "Trans" x]) t)
+  ++ ((\x -> if null x then [] else [entry "Annots" x]) theAnnots)
  toPDF (PDFPage Nothing _ _ _ _ _ _) = noPdfObject
 
 instance PdfLengthInfo PDFPage where
@@ -640,13 +693,13 @@
 -- Main objects in a PDF document
 
 instance PdfObject PDFCatalog where
- toPDF (PDFCatalog outlines lPages pgMode pgLayout viewerPrefs) = toPDF $ PDFDictionary . M.fromList $ 
-   [ (PDFName "Type",AnyPdfObject (PDFName "Catalog"))
-   , (PDFName "Pages",AnyPdfObject lPages)
-   , (PDFName "PageMode", AnyPdfObject . PDFName . show $ pgMode)
-   , (PDFName "PageLayout", AnyPdfObject . PDFName . show $ pgLayout)
-   , (PDFName "ViewerPreferences", AnyPdfObject viewerPrefs)
-   ] ++ (maybe [] (\x -> [(PDFName "Outlines",AnyPdfObject x)]) outlines)
+ toPDF (PDFCatalog outlines lPages pgMode pgLayout viewerPrefs) = toPDF $ dictFromList $
+   [ entry "Type" (PDFName "Catalog")
+   , entry "Pages" lPages
+   , entry "PageMode" (PDFName . show $ pgMode)
+   , entry "PageLayout" (PDFName . show $ pgLayout)
+   , entry "ViewerPreferences" viewerPrefs
+   ] ++ (maybe [] (\x -> [entry "Outlines" x]) outlines)
 
 instance PdfLengthInfo PDFCatalog where
 
@@ -659,23 +712,23 @@
 
 instance PdfObject PDFOutlineEntry where
  toPDF (PDFOutlineEntry title theParent prev next first theLast count dest color style) = 
-     toPDF $ PDFDictionary. M.fromList $ [
-        (PDFName "Title",AnyPdfObject title)
-        , (PDFName "Parent",AnyPdfObject theParent)
+     toPDF $ dictFromList $ [
+        entry "Title" title
+        , entry "Parent" theParent
         ]
       ++
-      maybe [] (\x -> [(PDFName "Prev",AnyPdfObject x)]) prev
+      maybe [] (\x -> [entry "Prev" x]) prev
       ++
-      maybe [] (\x -> [(PDFName "Next",AnyPdfObject x)]) next
+      maybe [] (\x -> [entry "Next" x]) next
       ++
-      maybe [] (\x -> [(PDFName "First",AnyPdfObject x)]) first
+      maybe [] (\x -> [entry "First" x]) first
       ++
-      maybe [] (\x -> [(PDFName "Last",AnyPdfObject x)]) theLast
+      maybe [] (\x -> [entry "Last" x]) theLast
       ++
-      [ (PDFName "Count",AnyPdfObject (PDFInteger count))
-      , (PDFName "Dest",AnyPdfObject dest)
-      , (PDFName "C",AnyPdfObject color)
-      , (PDFName "F",AnyPdfObject style)
+      [ entry "Count" (PDFInteger count)
+      , entry "Dest" dest
+      , entry "C" color
+      , entry "F" style
       ]
 
 instance PdfLengthInfo PDFOutlineEntry where
@@ -690,9 +743,9 @@
 
                                               
 instance PdfObject Color where
-   toPDF (Rgb r g b) = toPDF . map AnyPdfObject $ [r,g,b]  
+   toPDF (Rgb r g b) = toPDF [r,g,b]
    toPDF (Hsv h s v) = let (r,g,b) = hsvToRgb (h,s,v)
-    in toPDF . map AnyPdfObject $ [r,g,b]
+    in toPDF [r,g,b]
 
 instance PdfLengthInfo Color where
 
@@ -725,57 +778,363 @@
 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)  
 
+type FloatRGB  = (PDFFloat, PDFFloat, PDFFloat)
+type FloatCMYK = (PDFFloat, PDFFloat, PDFFloat, PDFFloat)
+
+class ColorTuple a where
+    rgbHex :: a -> String
+    colorComponents :: a -> [PDFFloat]
+    colorDimensions :: f a e -> Int
+
+instance ColorTuple PDFFloat where
+    rgbHex c = printf "%02X" (byteFromFloat c)
+    colorComponents c = [c]
+    colorDimensions _ = 1
+
+instance (a ~ PDFFloat, b ~ PDFFloat, c ~ PDFFloat) => ColorTuple (a,b,c) where
+    rgbHex (r,g,b) =
+        printf "%02X%02X%02X"
+            (byteFromFloat r) (byteFromFloat g) (byteFromFloat b)
+    colorComponents (r,g,b) = [r,g,b]
+    colorDimensions _ = 3
+
+instance
+    (a ~ PDFFloat, b ~ PDFFloat, c ~ PDFFloat, d ~ PDFFloat) =>
+        ColorTuple (a,b,c,d) where
+    rgbHex (c,m,y,k) =
+        printf "%02X%02X%02X%02X"
+            (byteFromFloat c) (byteFromFloat m)
+            (byteFromFloat y) (byteFromFloat k)
+    colorComponents (c,m,y,k) = [c,m,y,k]
+    colorDimensions _ = 4
+
+byteFromFloat :: PDFFloat -> Int
+byteFromFloat x = round $ min 255 $ max 0 $ x*255
+
+pdfStreamFromLazyByteString :: C.ByteString -> PDFDictionary -> PDFStream
+pdfStreamFromLazyByteString stream dict =
+    PDFStream
+        (BU.fromLazyByteString stream)
+        False
+        (Right . PDFLength . B.length $ stream)
+        dict
+
+data FunctionObject a e =
+      FunctionObject (PDFReference PDFDictionary)
+    | FunctionStream (PDFReference PDFStream)
+    deriving (Eq, Ord)
+
+rsrcFromSampled ::
+    (ColorTuple a) =>
+    PDFDictionary ->
+    ((i, i) -> [Int]) -> Array i a -> PDFStream
+rsrcFromSampled domain computeSizes arr =
+    pdfStreamFromLazyByteString
+        ((C.pack $ concatMap rgbHex $ Array.elems arr)
+            <>
+            C.pack " >")
+        (pdfDictUnion domain . dictFromList $
+           [entry "FunctionType" (PDFInteger 0),
+            entry "Size" (computeSizes $ Array.bounds arr),
+            entry "BitsPerSample" (PDFInteger 8),
+            entry "Filter" (PDFName "ASCIIHexDecode")
+            ])
+
 -- | 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 $ ([0,1] :: [PDFFloat]))
-                            , (PDFName "C0", AnyPdfObject . map AnyPdfObject $ [x])
-                            , (PDFName "C1", AnyPdfObject . map AnyPdfObject $ [y])
-                            , (PDFName "N", AnyPdfObject . PDFInteger $  n)
+rsrcFromInterpolated ::
+    (ColorTuple a) =>
+    PDFDictionary -> PDFFloat -> a -> a -> PDFDictionary
+rsrcFromInterpolated domain n a b =
+    pdfDictUnion domain . dictFromList $
+                            [ entry "FunctionType" (PDFInteger 2)
+                            , entry "C0" (colorComponents a)
+                            , entry "C1" (colorComponents b)
+                            , entry "N" n
                             ]
 
--- | A shading                             
-data PDFShading = AxialShading PDFFloat PDFFloat PDFFloat PDFFloat Color Color
-                | RadialShading PDFFloat PDFFloat PDFFloat PDFFloat PDFFloat PDFFloat Color Color
+rsrcFromStitched ::
+    (ColorTuple a, Expr.Result e) =>
+    PDFDictionary ->
+    Function1 Local a e -> [(PDFFloat, Function1 Local a e)] -> PDFDictionary
+rsrcFromStitched domain part parts =
+    let funcs = part : map snd parts in
+    pdfDictUnion domain . dictFromList $
+        [ entry "FunctionType" (PDFInteger 3)
+        , entry "Bounds" (map fst parts)
+        , entry "Encode" (concatMap (const [0,1::Int]) funcs)
+        , entry "Functions" (map toRsrc funcs)
+        ]
+
+rsrcFromCalculator ::
+    (Expr.Function f) => PDFDictionary -> f -> PDFStream
+rsrcFromCalculator domain f =
+    pdfStreamFromLazyByteString
+        (C.cons '{' $ C.snoc (Expr.serialize f) '}')
+        (pdfDictUnion domain . dictFromList $
+            [entry "FunctionType" (PDFInteger 4)])
+
+
+type ExprFloat = PDFExpression PDFFloat
+type ExprRGB = (ExprFloat, ExprFloat, ExprFloat)
+type ExprCMYK = (ExprFloat, ExprFloat, ExprFloat, ExprFloat)
+
+
+data ColorSpace a e where
+    GraySpace :: ColorSpace PDFFloat ExprFloat
+    RGBSpace :: ColorSpace FloatRGB ExprRGB
+    CMYKSpace :: ColorSpace FloatCMYK ExprCMYK
+
+deriving instance Eq (ColorSpace a e)
+deriving instance Ord (ColorSpace a e)
+
+colorSpaceName :: ColorSpace a e -> PDFName
+colorSpaceName space =
+    case space of
+        GraySpace -> PDFName "DeviceGray"
+        RGBSpace -> PDFName "DeviceRGB"
+        CMYKSpace -> PDFName "DeviceCMYK"
+
+colorSpaceEntry :: ColorSpace a e -> (PDFName, AnyPdfObject)
+colorSpaceEntry space = entry "ColorSpace" $ colorSpaceName space
+
+rangeEntry :: (ColorTuple a) => f a e -> (PDFName, AnyPdfObject)
+rangeEntry func =
+    entry "Range" $ concat $ replicate (colorDimensions func) [0,1::Int]
+
+
+data ColorFunction1 =
+    forall a e.
+    (ColorTuple a, Expr.Result e) =>
+    ColorFunction1 (ColorSpace a e) (Function1 Local a e)
+
+instance Eq ColorFunction1 where
+    ColorFunction1 spaceA funcA == ColorFunction1 spaceB funcB  =
+        case (spaceA, spaceB) of
+            (GraySpace, GraySpace) -> funcA == funcB
+            (RGBSpace, RGBSpace) -> funcA == funcB
+            (CMYKSpace, CMYKSpace) -> funcA == funcB
+            _ -> False
+
+instance Ord ColorFunction1 where
+    compare (ColorFunction1 spaceA funcA) (ColorFunction1 spaceB funcB) =
+        case (spaceA, spaceB) of
+            (GraySpace, GraySpace) -> compare funcA funcB
+            (RGBSpace, RGBSpace) -> compare funcA funcB
+            (CMYKSpace, CMYKSpace) -> compare funcA funcB
+            (GraySpace, _) -> LT; (_, GraySpace) -> GT
+            (RGBSpace,  _) -> LT; (_, RGBSpace)  -> GT
+
+
+data ColorFunction2 =
+    forall a e.
+    (ColorTuple a, Expr.Result e) =>
+    ColorFunction2 (ColorSpace a e) (Function2 Local a e)
+
+instance Eq ColorFunction2 where
+    ColorFunction2 spaceA funcA == ColorFunction2 spaceB funcB  =
+        case (spaceA, spaceB) of
+            (GraySpace, GraySpace) -> funcA == funcB
+            (RGBSpace, RGBSpace) -> funcA == funcB
+            (CMYKSpace, CMYKSpace) -> funcA == funcB
+            _ -> False
+
+instance Ord ColorFunction2 where
+    compare (ColorFunction2 spaceA funcA) (ColorFunction2 spaceB funcB) =
+        case (spaceA, spaceB) of
+            (GraySpace, GraySpace) -> compare funcA funcB
+            (RGBSpace, RGBSpace) -> compare funcA funcB
+            (CMYKSpace, CMYKSpace) -> compare funcA funcB
+            (GraySpace, _) -> LT; (_, GraySpace) -> GT
+            (RGBSpace,  _) -> LT; (_, RGBSpace)  -> GT
+
+
+data Global
+data Local
+
+data Function1 scope a e where
+    GlobalFunction1 ::
+        FunctionObject (PDFFloat -> a) (ExprFloat -> e) ->
+        Function1 Local a e
+    Sampled1 :: Array Int a -> Function1 Global a e
+    Interpolated1 :: PDFFloat -> a -> a -> Function1 scope a e
+    Stitched1 ::
+        Function1 Local a e -> [(PDFFloat, Function1 Local a e)] ->
+        Function1 scope a e
+    Calculator1 :: (ExprFloat -> e) -> Function1 Global a e
+
+instance
+    (Local ~ scope, ColorTuple a, Eq a, Expr.Result e) =>
+        Eq (Function1 scope a e) where
+    a==b =
+        case (a,b) of
+            (GlobalFunction1 fa, GlobalFunction1 fb) -> fa == fb
+            (Interpolated1 na xa ya, Interpolated1 nb xb yb) ->
+                (na, xa, ya) == (nb, xb, yb)
+            (Stitched1 partA partsA, Stitched1 partB partsB) ->
+                (partA, partsA) == (partB, partsB)
+            _ -> False
+
+instance
+    (Local ~ scope, ColorTuple a, Ord a, Expr.Result e) =>
+        Ord (Function1 scope a e) where
+    compare a b =
+        case (a,b) of
+            (GlobalFunction1 fa, GlobalFunction1 fb) -> compare fa fb
+            (Interpolated1 na xa ya, Interpolated1 nb xb yb) ->
+                compare (na, xa, ya) (nb, xb, yb)
+            (Stitched1 partA partsA, Stitched1 partB partsB) ->
+                compare (partA, partsA) (partB, partsB)
+            (GlobalFunction1 _, _) -> LT
+            (_, GlobalFunction1 _) -> GT
+            (Interpolated1 _ _ _, _) -> LT
+            (_, Interpolated1 _ _ _) -> GT
+
+
+-- ToDo: would be more type-safe with non-empty: NonEmpty (NonEmpty [])
+mapAdjacent :: (a -> a -> b) -> [a] -> [b]
+mapAdjacent f xs = zipWith f xs (tail xs)
+
+linearStitched ::
+    (ColorTuple a) => a -> [(PDFFloat, a)] -> a -> Function1 Local a e
+linearStitched firstY nodes lastY =
+    case mapAdjacent (Interpolated1 1)
+            (firstY : map snd nodes ++ lastY : []) of
+        [] -> error "list should be non-empty by construction"
+        part:parts -> Stitched1 part (zip (map fst nodes) parts)
+
+calculator1 :: (ExprFloat -> e) -> Function1 Global a e
+calculator1 = Calculator1
+
+domain1Dict :: (ColorTuple a) => f a e -> PDFDictionary
+domain1Dict func =
+    dictFromList [
+        entry "Domain" [0,1::Int],
+        rangeEntry func
+    ]
+
+instance
+    (Local ~ scope, ColorTuple a, Expr.Result e) =>
+        PdfResourceObject (Function1 scope a e) where
+    toRsrc func =
+        let domain = domain1Dict func in
+        case func of
+            GlobalFunction1 (FunctionObject obj) -> AnyPdfObject obj
+            GlobalFunction1 (FunctionStream obj) -> AnyPdfObject obj
+            Interpolated1 n x y ->
+                AnyPdfObject $ rsrcFromInterpolated domain n x y
+            Stitched1 part parts ->
+                AnyPdfObject $ rsrcFromStitched domain part parts
+
+
+data Function2 scope a e where
+    GlobalFunction2 ::
+        FunctionObject
+            (PDFFloat -> PDFFloat -> a) (ExprFloat -> ExprFloat -> e) ->
+        Function2 Local a e
+    Sampled2 :: (Array (Int,Int) a) -> Function2 Global a e
+    Calculator2 :: (ExprFloat -> ExprFloat -> e) -> Function2 Global a e
+
+instance
+    (Local ~ scope, ColorTuple a, Eq a, Expr.Result e) =>
+        Eq (Function2 scope a e) where
+    a==b =
+        case (a,b) of
+            (GlobalFunction2 fa, GlobalFunction2 fb) -> fa == fb
+
+instance
+    (Local ~ scope, ColorTuple a, Ord a, Expr.Result e) =>
+        Ord (Function2 scope a e) where
+    compare a b =
+        case (a,b) of
+            (GlobalFunction2 fa, GlobalFunction2 fb) -> compare fa fb
+
+calculator2 :: (ExprFloat -> ExprFloat -> e) -> Function2 Global a e
+calculator2 = Calculator2
+
+domain2Dict :: (ColorTuple a) => f a e -> PDFDictionary
+domain2Dict func =
+    dictFromList [
+        entry "Domain" [0,1, 0,1::Int],
+        rangeEntry func
+    ]
+
+instance
+    (Local ~ scope, ColorTuple a, Expr.Result e) =>
+        PdfResourceObject (Function2 scope a e) where
+    toRsrc func =
+        case func of
+            GlobalFunction2 (FunctionObject obj) -> AnyPdfObject obj
+            GlobalFunction2 (FunctionStream obj) -> AnyPdfObject obj
+
+
+-- | A shading
+data PDFShading =
+      FunctionalShading Matrix ColorFunction2
+    | AxialShading PDFFloat PDFFloat PDFFloat PDFFloat ColorFunction1
+    | RadialShading PDFFloat PDFFloat PDFFloat PDFFloat PDFFloat PDFFloat ColorFunction1
                 deriving(Eq,Ord)
 
+matrixCoefficients :: Matrix -> [PDFFloat]
+matrixCoefficients (Matrix a b c d e f) = [a,b,c,d,e,f]
+
 instance PdfResourceObject PDFShading where
-      toRsrc (AxialShading x0 y0 x1 y1 ca cb) = AnyPdfObject . PDFDictionary . M.fromList $
-                                 [ (PDFName "ShadingType",AnyPdfObject . PDFInteger $ 2)
-                                 , (PDFName "Coords",AnyPdfObject . map AnyPdfObject $ [x0,y0,x1,y1])
-                                 , (PDFName "ColorSpace",AnyPdfObject . PDFName $ "DeviceRGB")
-                                 , (PDFName "Function",AnyPdfObject $ [interpole 1 ra rb,interpole 1 ga gb,interpole 1 ba bb])
+      toRsrc (FunctionalShading mat (ColorFunction2 cs func)) =
+          AnyPdfObject . dictFromList $
+                                 [ entry "ShadingType" (PDFInteger $ 1)
+                                 , entry "Matrix" (matrixCoefficients $ mat)
+                                 , colorSpaceEntry cs
+                                 , entry "Function" (toRsrc func)
                                  ]
-        where
-            (ra,ga,ba) = getRgbColor ca
-            (rb,gb,bb) = getRgbColor cb
-      toRsrc (RadialShading x0 y0 r0 x1 y1 r1 ca cb) = AnyPdfObject . PDFDictionary . M.fromList $
-                                         [ (PDFName "ShadingType",AnyPdfObject . PDFInteger $ 3)
-                                         , (PDFName "Coords",AnyPdfObject . map AnyPdfObject $ [x0,y0,r0,x1,y1,r1])
-                                         , (PDFName "ColorSpace",AnyPdfObject . PDFName $ "DeviceRGB")
-                                         , (PDFName "Function",AnyPdfObject $ [interpole 1 ra rb,interpole 1 ga gb,interpole 1 ba bb])
-                                         ]
-        where
-           (ra,ga,ba) = getRgbColor ca
-           (rb,gb,bb) = getRgbColor cb
+      toRsrc (AxialShading x0 y0 x1 y1 (ColorFunction1 cs func)) =
+          AnyPdfObject . dictFromList $
+                                 [ entry "ShadingType" (PDFInteger $ 2)
+                                 , entry "Coords" [x0,y0,x1,y1]
+                                 , entry "Extend" [True, True]
+                                 , colorSpaceEntry cs
+                                 , entry "Function" (toRsrc func)
+                                 ]
+      toRsrc (RadialShading x0 y0 r0 x1 y1 r1 (ColorFunction1 cs func)) =
+          AnyPdfObject . dictFromList $
+                                 [ entry "ShadingType" (PDFInteger $ 3)
+                                 , entry "Coords" [x0,y0,r0,x1,y1,r1]
+                                 , entry "Extend" [True, True]
+                                 , colorSpaceEntry cs
+                                 , entry "Function" (toRsrc func)
+                                 ]
 
 
+newtype SoftMask = SoftMask (PDFReference PDFXForm)
+    deriving (Eq, Ord)
+
+instance PdfResourceObject SoftMask where
+    toRsrc (SoftMask ref) =
+        AnyPdfObject $
+        dictFromList $
+            entry "Type" (PDFName "ExtGState") :
+            entry "SMask"
+                (dictFromList $
+                    entry "Type" (PDFName "Mask") :
+                    entry "S" (PDFName "Luminosity") :
+                    entry "G" ref :
+                    []) :
+            []
+
+
 -- | 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"
-                     ]
+    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/Expression.hs b/Graphics/PDF/Expression.hs
new file mode 100644
--- /dev/null
+++ b/Graphics/PDF/Expression.hs
@@ -0,0 +1,281 @@
+---------------------------------------------------------
+-- |
+-- Copyright   : (c) 2023, Henning Thielemann
+-- License     : BSD-style
+--
+-- Maintainer  : haskell@henning-thielemann.de
+-- Stability   : experimental
+-- Portability : portable
+--
+-- PDF expressions and functions
+---------------------------------------------------------
+module Graphics.PDF.Expression (
+    PDFExpression (..),
+    Function,
+    Result,
+    Argument,
+    serialize,
+
+    (==%), (/=%),
+    (<%), (>=%), (>%), (<=%),
+    min, max,
+    true, false,
+    (&&*), (||*), not,
+    ifThenElse,
+
+    sqrt,
+    sinDeg, cosDeg, log, log10,
+    pow, atan2Deg,
+
+    floor, ceiling, round, truncate,
+    ) where
+     
+import qualified Data.ByteString.Lazy.Char8 as CL
+import qualified Data.ByteString.Char8 as C
+import qualified Data.Ratio as Ratio
+
+import qualified Control.Monad.Trans as MT
+import qualified Control.Monad.RWS as MRWS
+import qualified Control.Monad.Writer as MW
+import qualified Control.Monad.State as MS
+import Control.Monad (when)
+import Control.Applicative (pure, liftA2, liftA3, (<*>))
+
+import Prelude hiding
+        (not, min, max, log, sqrt, floor, ceiling, round, truncate)
+
+
+data Token = Token C.ByteString | Index Int
+    deriving (Show)
+
+type ExprMonad = MRWS.RWS () [Token] Int
+
+newtype PDFExpression a = PDFExpression (ExprMonad ())
+
+
+serialize :: (Function f) => f -> CL.ByteString
+serialize f =
+    CL.unwords $
+    (\(n,_,stream) ->
+        map (\token ->
+                case token of
+                    Token str -> CL.fromStrict str
+                    Index k -> CL.pack $ show $ n-1+k) stream) $
+    MRWS.runRWS
+        (do
+            n <- MS.execStateT (serializeFunction f) 0
+            tokens $ replicate n "pop"
+            return n)
+        ()
+        0
+
+
+class Function f where
+    serializeFunction :: f -> MS.StateT Int ExprMonad ()
+
+instance (Argument a, Function f) => Function (a -> f) where
+    serializeFunction f = do
+        arg <- argumentExpression
+        serializeFunction $ f arg
+
+instance Function (PDFExpression a) where
+    serializeFunction = serializeResult
+
+instance (Result a, Result b) => Function (a,b) where
+    serializeFunction = serializeResult
+
+instance (Result a, Result b, Result c) => Function (a,b,c) where
+    serializeFunction = serializeResult
+
+instance
+    (Result a, Result b, Result c, Result d) =>
+        Function (a,b,c,d) where
+    serializeFunction = serializeResult
+
+
+{-
+Extra class is needed in order
+to forbid nested functions like (a -> (a, a->a))
+-}
+class (Function a) => Result a where
+    serializeResult :: a -> MS.StateT Int ExprMonad ()
+
+instance Result (PDFExpression a) where
+    serializeResult (PDFExpression a) = do
+        n <- MS.get
+        MT.lift $ do
+            a
+            when (n>0) (tokens [show (n+1), "1", "roll"])
+            MS.modify pred
+            depth <- MS.get
+            when (depth/=0) $ error "stack must be empty after evaluation"
+
+instance (Result a, Result b) => Result (a,b) where
+    serializeResult (a,b) =
+        serializeResult a >> serializeResult b
+
+instance (Result a, Result b, Result c) => Result (a,b,c) where
+    serializeResult (a,b,c) =
+        serializeResult a >> serializeResult b >> serializeResult c
+
+instance
+    (Result a, Result b, Result c, Result d) =>
+        Result (a,b,c,d) where
+    serializeResult (a,b,c,d) =
+        serializeResult a >> serializeResult b >>
+        serializeResult c >> serializeResult d
+
+
+
+class Argument a where
+    argumentExpression :: (Monad m) => MS.StateT Int m a
+
+instance Argument (PDFExpression a) where
+    argumentExpression = MS.StateT $ \n -> pure (argument n, n+1)
+
+instance (Argument a, Argument b) => Argument (a,b) where
+    argumentExpression =
+        liftA2 (,) argumentExpression argumentExpression
+
+instance (Argument a, Argument b, Argument c) => Argument (a,b,c) where
+    argumentExpression =
+        liftA3 (,,) argumentExpression argumentExpression argumentExpression
+
+instance
+    (Argument a, Argument b, Argument c, Argument d) =>
+        Argument (a,b,c,d) where
+    argumentExpression =
+        pure (,,,)
+            <*> argumentExpression
+            <*> argumentExpression
+            <*> argumentExpression
+            <*> argumentExpression
+
+
+tokens :: [String] -> ExprMonad ()
+tokens = MW.tell . map (Token . C.pack)
+
+
+argument :: Int -> PDFExpression a
+argument k = PDFExpression $ do
+    depth <- MS.get
+    MW.tell [Index (depth-k), Token $ C.pack "index"]
+    MS.modify succ
+
+
+constant :: [String] -> PDFExpression b
+constant ts =
+    PDFExpression $ tokens ts >> MS.modify succ
+
+function1 :: String -> PDFExpression a -> PDFExpression b
+function1 name (PDFExpression a) =
+    PDFExpression $ a >> tokens [name]
+
+function2 :: String -> PDFExpression a -> PDFExpression b -> PDFExpression c
+function2 name (PDFExpression a) (PDFExpression b) =
+    PDFExpression $ a >> b >> tokens [name] >> MS.modify pred
+
+
+infix 4 ==%, /=%, <%, <=%, >%, >=%
+
+(==%), (/=%) ::
+   (Eq a) => PDFExpression a -> PDFExpression a -> PDFExpression Bool
+(==%) = function2 "eq"
+(/=%) = function2 "ne"
+
+(<%), (>=%), (>%), (<=%) ::
+   (Ord a) => PDFExpression a -> PDFExpression a -> PDFExpression Bool
+(<%)  = function2 "lt"
+(>=%) = function2 "ge"
+(>%)  = function2 "gt"
+(<=%) = function2 "le"
+
+
+minMax ::
+    (Ord a) => String -> PDFExpression a -> PDFExpression a -> PDFExpression a
+minMax cmp (PDFExpression a) (PDFExpression b) =
+    PDFExpression $ do
+        a
+        b
+        tokens ["2", "copy", cmp, "{1 pop}", "{exch 1 pop}", "ifelse"]
+        MS.modify pred
+
+min, max :: (Ord a) => PDFExpression a -> PDFExpression a -> PDFExpression a
+min = minMax "lt"
+max = minMax "gt"
+
+
+true, false :: PDFExpression Bool
+true  = constant ["true"]
+false = constant ["false"]
+
+infixr 3 &&*
+(&&*) :: PDFExpression Bool -> PDFExpression Bool -> PDFExpression Bool
+(&&*) = function2 "and"
+
+infixr 2 ||*
+(||*) :: PDFExpression Bool -> PDFExpression Bool -> PDFExpression Bool
+(||*) = function2 "or"
+
+not :: PDFExpression Bool -> PDFExpression Bool
+not = function1 "not"
+
+
+
+ifThenElse ::
+    (Ord a) =>
+    PDFExpression Bool -> PDFExpression a -> PDFExpression a -> PDFExpression a
+ifThenElse (PDFExpression cond) (PDFExpression a) (PDFExpression b) =
+    PDFExpression $ do
+        cond
+        tokens ["{"] >> a >> tokens ["}"]
+        tokens ["{"] >> b >> tokens ["}"]
+        tokens ["ifelse"]
+        MS.modify pred
+        MS.modify pred
+
+
+
+
+instance (Num a) => Num (PDFExpression a) where
+    fromInteger k = constant [show k]
+    negate = function1 "negate"
+    abs = function1 "abs"
+    (+) = function2 "add"
+    (-) = function2 "sub"
+    (*) = function2 "mul"
+    signum (PDFExpression a) =
+        PDFExpression $ do
+            a
+            tokens ["dup", "0", "gt"]
+            tokens   ["{", "pop", "1", "}"]
+            tokens   ["{", "0", "lt", "{-1}", "{0}", "ifelse", "}"]
+            tokens ["ifelse"]
+
+instance (Fractional a) => Fractional (PDFExpression a) where
+    fromRational r =
+        constant [show (Ratio.numerator r), show (Ratio.denominator r), "div"]
+    (/) = function2 "div"
+
+
+sqrt, sinDeg, cosDeg, log, log10 ::
+    (Floating a) => PDFExpression a -> PDFExpression a
+sqrt = function1 "sqrt"
+sinDeg = function1 "sin"
+cosDeg = function1 "cos"
+log = function1 "ln"
+log10 = function1 "log"
+
+pow, atan2Deg ::
+    (Floating a) => PDFExpression a -> PDFExpression a -> PDFExpression a
+pow = function2 "exp"
+atan2Deg = function2 "atan"
+
+
+
+floor, ceiling, round, truncate ::
+    (RealFrac a) => PDFExpression a -> PDFExpression Int
+floor    = function1 "floor"
+ceiling  = function1 "ceiling"
+round    = function1 "round"
+truncate = function1 "truncate"
diff --git a/Graphics/PDF/Fonts/StandardFont.hs b/Graphics/PDF/Fonts/StandardFont.hs
--- a/Graphics/PDF/Fonts/StandardFont.hs
+++ b/Graphics/PDF/Fonts/StandardFont.hs
@@ -86,14 +86,14 @@
 data StdFont = StdFont FontStructure deriving Show
 
 instance PdfResourceObject StdFont where
-   toRsrc (StdFont f) =  AnyPdfObject . PDFDictionary . M.fromList $
-                           [(PDFName "Type",AnyPdfObject . PDFName $ "Font")
-                           , (PDFName "Subtype",AnyPdfObject . PDFName $ "Type1")
-                           , (PDFName "BaseFont",AnyPdfObject . PDFName $ baseFont f)
+   toRsrc (StdFont f) =  AnyPdfObject . dictFromList $
+                           [entry "Type" (PDFName $ "Font")
+                           , entry "Subtype" (PDFName $ "Type1")
+                           , entry "BaseFont" (PDFName $ baseFont f)
                            ] ++ encoding'
           where encoding' | baseFont f == show Symbol = [] 
                           | baseFont f == show ZapfDingbats = []
-                          | otherwise = [(PDFName "Encoding",AnyPdfObject . PDFName $ "MacRomanEncoding")]
+                          | otherwise = [entry "Encoding" (PDFName $ "MacRomanEncoding")]
 
 instance IsFont StdFont where 
   getDescent (StdFont fs) s = trueSize s $ descent fs 
diff --git a/Graphics/PDF/Fonts/Type1.hs b/Graphics/PDF/Fonts/Type1.hs
--- a/Graphics/PDF/Fonts/Type1.hs
+++ b/Graphics/PDF/Fonts/Type1.hs
@@ -67,14 +67,14 @@
 
 instance PdfResourceObject Type1Font where
    toRsrc (Type1Font f ref) =  
-                AnyPdfObject . PDFDictionary . M.fromList $
-                           [(PDFName "Type",AnyPdfObject . PDFName $ "Font")
-                           , (PDFName "Subtype",AnyPdfObject . PDFName $ "Type1")
-                           , (PDFName "BaseFont",AnyPdfObject . PDFName $ baseFont f)
-                           , (PDFName "FirstChar",AnyPdfObject . PDFInteger $ (fromIntegral firstChar))
-                           , (PDFName "LastChar",AnyPdfObject . PDFInteger $ (fromIntegral lastChar))
-                           , (PDFName "Widths",AnyPdfObject  $ widths)
-                           , (PDFName "FontDescriptor", AnyPdfObject descriptor)
+                AnyPdfObject . dictFromList $
+                           [entry "Type" (PDFName $ "Font")
+                           , entry "Subtype" (PDFName $ "Type1")
+                           , entry "BaseFont" (PDFName $ baseFont f)
+                           , entry "FirstChar" (PDFInteger $ fromIntegral firstChar)
+                           , entry "LastChar" (PDFInteger $ fromIntegral lastChar)
+                           , entry "Widths" widths
+                           , entry "FontDescriptor" descriptor
                            ] 
           where 
             codes = map fst . M.toList $ widthData f
@@ -82,16 +82,15 @@
             lastChar = head . reverse . sort $ codes
             findWidth c = PDFInteger . fromIntegral $ M.findWithDefault 0 c (widthData f)
             widths = map findWidth [firstChar .. lastChar] 
-            bbox = map AnyPdfObject .fontBBox $ f 
-            descriptor = PDFDictionary . M.fromList $ 
-              [ (PDFName "Type",AnyPdfObject . PDFName $ "Font")
-              , (PDFName "Subtype",AnyPdfObject . PDFName $ "Type1")
-              , (PDFName "BaseFont",AnyPdfObject . PDFName $ baseFont f)
-              , (PDFName "FontFile", AnyPdfObject ref)
-              , (PDFName "Flags",AnyPdfObject . PDFInteger . fromIntegral . mkFlags $ f)
-              , (PDFName "FontBBox",AnyPdfObject  $ bbox)
-              , (PDFName "ItalicAngle",AnyPdfObject $ italicAngle f)
-              , (PDFName "Ascent",AnyPdfObject . PDFInteger . fromIntegral $ ascent f)
-              , (PDFName "Descent",AnyPdfObject . PDFInteger . fromIntegral $ descent f)
-              , (PDFName "CapHeight",AnyPdfObject . PDFInteger . fromIntegral $ capHeight f)
+            descriptor = dictFromList $
+              [ entry "Type" (PDFName $ "Font")
+              , entry "Subtype" (PDFName $ "Type1")
+              , entry "BaseFont" (PDFName $ baseFont f)
+              , entry "FontFile" ref
+              , entry "Flags" (PDFInteger . fromIntegral . mkFlags $ f)
+              , entry "FontBBox" (fontBBox f)
+              , entry "ItalicAngle" (italicAngle f)
+              , entry "Ascent" (PDFInteger . fromIntegral $ ascent f)
+              , entry "Descent" (PDFInteger . fromIntegral $ descent f)
+              , entry "CapHeight" (PDFInteger . fromIntegral $ capHeight f)
                   ]
diff --git a/Graphics/PDF/Image.hs b/Graphics/PDF/Image.hs
--- a/Graphics/PDF/Image.hs
+++ b/Graphics/PDF/Image.hs
@@ -32,7 +32,6 @@
  ) where
      
 import Graphics.PDF.LowLevel.Types
-import qualified Data.Map.Strict as M
 import Graphics.PDF.Draw
 import Graphics.PDF.Resources
 import Graphics.PDF.Pages
@@ -331,21 +330,21 @@
         return (PDFReference s) 
     where
        color c = case c of
-           1 -> [(PDFName "ColorSpace",AnyPdfObject $ PDFName "DeviceGray")]
-           3 -> [(PDFName "ColorSpace",AnyPdfObject $ PDFName "DeviceRGB")]
-           4 -> [(PDFName "ColorSpace",AnyPdfObject $ PDFName "DeviceCMYK")
-                ,(PDFName "Decode",AnyPdfObject . map (AnyPdfObject . PDFInteger) $ [1,0,1,0,1,0,1,0])
+           1 -> [entry "ColorSpace" (PDFName "DeviceGray")]
+           3 -> [entry "ColorSpace" (PDFName "DeviceRGB")]
+           4 -> [entry "ColorSpace" (PDFName "DeviceCMYK")
+                ,entry "Decode" (map PDFInteger $ [1,0,1,0,1,0,1,0])
                 ]
            _ -> error "Jpeg color space not supported"
        a' = 
-                 do modifyStrict $ \s -> s  {otherRsrcs = PDFDictionary. M.fromList $ 
-                                                   [ (PDFName "Type",AnyPdfObject . PDFName $ "XObject")
-                                                   , (PDFName "Subtype",AnyPdfObject . PDFName $ "Image")
-                                                   , (PDFName "Width",AnyPdfObject . PDFInteger $ width)
-                                                   , (PDFName "Height",AnyPdfObject . PDFInteger $ height)
-                                                   , (PDFName "BitsPerComponent",AnyPdfObject . PDFInteger $ bits_per_component)
-                                                   , (PDFName "Interpolate", AnyPdfObject True)
-                                                   , (PDFName "Filter",AnyPdfObject . PDFName $ "DCTDecode")
+                 do modifyStrict $ \s -> s  {otherRsrcs = dictFromList $
+                                                   [ entry "Type" (PDFName $ "XObject")
+                                                   , entry "Subtype" (PDFName $ "Image")
+                                                   , entry "Width" (PDFInteger $ width)
+                                                   , entry "Height" (PDFInteger $ height)
+                                                   , entry "BitsPerComponent" (PDFInteger $ bits_per_component)
+                                                   , entry "Interpolate" True
+                                                   , entry "Filter" (PDFName $ "DCTDecode")
                                                    ] ++ color color_space
                                              }
                     tell img        
@@ -363,23 +362,23 @@
     where     
         getFilter = case pdfFilter of 
                     NoFilter -> []
-                    ASCIIHexDecode -> [(PDFName "Filter",AnyPdfObject . PDFName $ "ASCIIHexDecode")]
-                    ASCII85Decode -> [(PDFName "Filter",AnyPdfObject . PDFName $ "ASCII85Decode")]
-                    LZWDecode -> [(PDFName "Filter",AnyPdfObject . PDFName $ "LZWDecode")]
-                    FlateDecode -> [(PDFName "Filter",AnyPdfObject . PDFName $ "FlateDecode")]
-                    RunLengthDecode -> [(PDFName "Filter",AnyPdfObject . PDFName $ "RunLengthDecode")]
-                    CCITTFaxDecode -> [(PDFName "Filter",AnyPdfObject . PDFName $ "CCITTFaxDecode")]
-                    DCTDecode -> [(PDFName "Filter",AnyPdfObject . PDFName $ "DCTDecode")]
+                    ASCIIHexDecode -> [entry "Filter" (PDFName $ "ASCIIHexDecode")]
+                    ASCII85Decode -> [entry "Filter" (PDFName $ "ASCII85Decode")]
+                    LZWDecode -> [entry "Filter" (PDFName $ "LZWDecode")]
+                    FlateDecode -> [entry "Filter" (PDFName $ "FlateDecode")]
+                    RunLengthDecode -> [entry "Filter" (PDFName $ "RunLengthDecode")]
+                    CCITTFaxDecode -> [entry "Filter" (PDFName $ "CCITTFaxDecode")]
+                    DCTDecode -> [entry "Filter" (PDFName $ "DCTDecode")]
 
         a' =  do 
-                modifyStrict $ \s -> s  {otherRsrcs = PDFDictionary. M.fromList $ 
-                                                   [ (PDFName "Type",AnyPdfObject . PDFName $ "XObject")
-                                                   , (PDFName "Subtype",AnyPdfObject . PDFName $ "Image")
-                                                   , (PDFName "Width",AnyPdfObject . PDFInteger $ width)
-                                                   , (PDFName "Height",AnyPdfObject . PDFInteger $ height)
-                                                   , (PDFName "BitsPerComponent",AnyPdfObject . PDFInteger $ 8)
-                                                   , (PDFName "ColorSpace",AnyPdfObject $ PDFName "DeviceRGB")
-                                                   , (PDFName "Interpolate", AnyPdfObject interpolate)
+                modifyStrict $ \s -> s  {otherRsrcs = dictFromList $
+                                                   [ entry "Type" (PDFName $ "XObject")
+                                                   , entry "Subtype" (PDFName $ "Image")
+                                                   , entry "Width" (PDFInteger $ width)
+                                                   , entry "Height" (PDFInteger $ height)
+                                                   , entry "BitsPerComponent" (PDFInteger $ 8)
+                                                   , entry "ColorSpace" (PDFName "DeviceRGB")
+                                                   , entry "Interpolate" interpolate
                                                    ] ++ getFilter
                                              }
                 tell . fromLazyByteString $ stream
@@ -403,14 +402,14 @@
         addPixel [] = []
                         
         a' =  do 
-                modifyStrict $ \s -> s  {otherRsrcs = PDFDictionary. M.fromList $ 
-                                                   [ (PDFName "Type",AnyPdfObject . PDFName $ "XObject")
-                                                   , (PDFName "Subtype",AnyPdfObject . PDFName $ "Image")
-                                                   , (PDFName "Width",AnyPdfObject . PDFInteger $  width)
-                                                   , (PDFName "Height",AnyPdfObject . PDFInteger $  height)
-                                                   , (PDFName "BitsPerComponent",AnyPdfObject . PDFInteger $ 8)
-                                                   , (PDFName "ColorSpace",AnyPdfObject $ PDFName "DeviceRGB")
-                                                   , (PDFName "Interpolate", AnyPdfObject interpolate)
+                modifyStrict $ \s -> s  {otherRsrcs = dictFromList $
+                                                   [ entry "Type" (PDFName $ "XObject")
+                                                   , entry "Subtype" (PDFName $ "Image")
+                                                   , entry "Width" (PDFInteger $  width)
+                                                   , entry "Height" (PDFInteger $  height)
+                                                   , entry "BitsPerComponent" (PDFInteger $ 8)
+                                                   , entry "ColorSpace" (PDFName "DeviceRGB")
+                                                   , entry "Interpolate" interpolate
                                                    ]
                                              }
                 tell . fromLazyByteString . B.pack . addPixel . U.toList $ stream  
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
@@ -21,7 +21,7 @@
 
 import qualified Data.Map.Strict as M
 import Data.List(intersperse)
-import Data.Int
+import Data.Int(Int64)
 import Control.Monad.State
 import Control.Monad.Writer
 import Data.Binary.Builder(Builder,fromByteString)
@@ -57,7 +57,7 @@
   toPDF :: a -> Builder
 
 class PdfLengthInfo a where 
-  pdfLengthInfo :: a -> Maybe (Int64 , PDFReference MaybeLength)
+  pdfLengthInfo :: a -> Maybe (PDFLength , PDFReference MaybeLength)
   pdfLengthInfo _ = Nothing
 
 -- | Anonymous PDF object
@@ -286,6 +286,10 @@
 
 newtype PDFDictionary = PDFDictionary (M.Map PDFName AnyPdfObject)
 
+entry ::
+    (PdfObject a, PdfLengthInfo a) => String -> a -> (PDFName, AnyPdfObject)
+entry name obj = (PDFName name, AnyPdfObject obj)
+
 instance PdfObject PDFDictionary where
   toPDF (PDFDictionary a) = mconcat $ [blt,blt,newline]
                                        ++ [convertLevel a]
@@ -315,6 +319,9 @@
 
 pdfDictUnion :: PDFDictionary -> PDFDictionary -> PDFDictionary
 pdfDictUnion (PDFDictionary a) (PDFDictionary b) = PDFDictionary $ M.union a b
+
+dictFromList :: [(PDFName, AnyPdfObject)] -> PDFDictionary
+dictFromList = PDFDictionary . M.fromList
 
   
 -- | A PDF rectangle
diff --git a/Graphics/PDF/Pattern.hs b/Graphics/PDF/Pattern.hs
--- a/Graphics/PDF/Pattern.hs
+++ b/Graphics/PDF/Pattern.hs
@@ -26,7 +26,6 @@
 import Graphics.PDF.LowLevel.Types
 import Graphics.PDF.Draw
 import Graphics.PDF.Resources
-import qualified Data.Map.Strict as M
 import Graphics.PDF.Pages(recordBound,createContent)
 import Control.Monad.State
 import Control.Monad.Writer
@@ -78,15 +77,15 @@
                     -> Draw a -- ^ Drawing commands
                     -> PDF Int
 createTilingPattern xa ya xb yb hstep vstep pt tt d = 
-    let a' = do modifyStrict $ \s -> s  {otherRsrcs = PDFDictionary. M.fromList $ 
-                                             [ (PDFName "Type",AnyPdfObject . PDFName $ "Pattern")
-                                             , (PDFName "PatternType",AnyPdfObject . PDFInteger $ 1)
-                                             , (PDFName "PaintType",AnyPdfObject . PDFInteger $ (fromEnum pt) + 1)
-                                             , (PDFName "TilingType",AnyPdfObject . PDFInteger $ (fromEnum tt) + 1)
-                                             , (PDFName "Matrix",AnyPdfObject . (map (AnyPdfObject . PDFInteger)) $ [1,0,0,1,0,0])
-                                             , (PDFName "BBox",AnyPdfObject . map AnyPdfObject  $ [xa,ya,xb,yb])
-                                             , (PDFName "XStep",AnyPdfObject hstep)
-                                             , (PDFName "YStep",AnyPdfObject vstep)
+    let a' = do modifyStrict $ \s -> s  {otherRsrcs = dictFromList $
+                                             [ entry "Type" (PDFName $ "Pattern")
+                                             , entry "PatternType" (PDFInteger $ 1)
+                                             , entry "PaintType" (PDFInteger $ (fromEnum pt) + 1)
+                                             , entry "TilingType" (PDFInteger $ (fromEnum tt) + 1)
+                                             , entry "Matrix" (map PDFInteger $ [1,0,0,1,0,0])
+                                             , entry "BBox" [xa,ya,xb,yb]
+                                             , entry "XStep" hstep
+                                             , entry "YStep" vstep
                                              ]
                                          }
                 d
@@ -94,72 +93,71 @@
        PDFReference s <- createContent a' Nothing  
        recordBound s (xb-xa) (yb-ya)
        return s
-      
-       
+
+
+registerPattern :: PDFReference s -> Draw String
+registerPattern (PDFReference a) =
+    registerResource "Pattern"
+        patterns (\newMap s -> s { patterns = newMap })
+        (PDFReference a)
+
 -- | Set the fill pattern
 setColoredFillPattern :: PDFReference PDFColoredPattern -> Draw ()
-setColoredFillPattern (PDFReference a) = do
-     patternMap <- gets patterns
-     (newName,newMap) <- setResource "Pattern" (PDFReference a) patternMap
-     modifyStrict $ \s -> s { patterns = newMap }
-     tell . serialize $ ("\n/Pattern cs")
-     tell . mconcat $ [ serialize "\n/" 
-                      , serialize newName
-                      , serialize " scn"
-                      ]
+setColoredFillPattern ref = do
+    newName <- registerPattern ref
+    tell . serialize $ ("\n/Pattern cs")
+    tell . mconcat $ [ serialize "\n/"
+                     , serialize newName
+                     , serialize " scn"
+                     ]
      
 -- | Set the stroke pattern
 setColoredStrokePattern :: PDFReference PDFColoredPattern -> Draw ()
-setColoredStrokePattern (PDFReference a) = do
-  patternMap <- gets patterns
-  (newName,newMap) <- setResource "Pattern" (PDFReference a) patternMap
-  modifyStrict $ \s -> s { patterns = newMap }
-  tell . serialize $ ("\n/Pattern CS")
-  tell . mconcat $ [ serialize "\n/" 
-                   , serialize newName
-                   , serialize " SCN"
-                   ]
+setColoredStrokePattern ref = do
+    newName <- registerPattern ref
+    tell . serialize $ ("\n/Pattern CS")
+    tell . mconcat $
+                  [ serialize "\n/"
+                  , serialize newName
+                  , serialize " SCN"
+                  ]
   
   
 
 -- | Set the fill pattern
 setUncoloredFillPattern :: PDFReference PDFUncoloredPattern -> Color -> Draw ()
-setUncoloredFillPattern (PDFReference a) col = do
+setUncoloredFillPattern ref col = do
        let (r,g,b) = getRgbColor col
        colorMap <- gets colorSpaces
        (newColorName,_) <- setResource "ColorSpace" PatternRGB colorMap
-       patternMap <- gets patterns
-       (newName,newMap) <- setResource "Pattern" (PDFReference a) patternMap
-       modifyStrict $ \s -> s { patterns = newMap }
-       tell . mconcat $ [ serialize "\n/" 
-                        , serialize newColorName
-                        , serialize " cs"
-                        ]
-       tell . mconcat $ [ serialize '\n'
-                        , toPDF r
-                        , serialize ' '
-                        , toPDF g
-                        , serialize ' '
-                        , toPDF b
-                        , serialize ' '
-                        , serialize " /"
-                        , serialize newName
-                        , serialize " scn"
-                        ]
+       newName <- registerPattern ref
+       tell . mconcat $[ serialize "\n/"
+                       , serialize newColorName
+                       , serialize " cs"
+                       ]
+       tell . mconcat $[ serialize '\n'
+                       , toPDF r
+                       , serialize ' '
+                       , toPDF g
+                       , serialize ' '
+                       , toPDF b
+                       , serialize ' '
+                       , serialize " /"
+                       , serialize newName
+                       , serialize " scn"
+                       ]
 
 -- | Set the stroke pattern
 setUncoloredStrokePattern :: PDFReference PDFUncoloredPattern -> Color -> Draw ()
-setUncoloredStrokePattern (PDFReference a) col = do
+setUncoloredStrokePattern ref col = do
     let (r,g,b) = getRgbColor col
     colorMap <- gets colorSpaces
     (newColorName,_) <- setResource "ColorSpace" PatternRGB colorMap
-    patternMap <- gets patterns
-    (newName,newMap) <- setResource "Pattern" (PDFReference a) patternMap
-    modifyStrict $ \s -> s { patterns = newMap }
-    tell . mconcat $ [ serialize "\n/" 
-                     , serialize newColorName
-                     , serialize " CS"
-                     ]
+    newName <- registerPattern ref
+    tell . mconcat $[ serialize "\n/" 
+                    , serialize newColorName
+                    , serialize " CS"
+                    ]
     tell . mconcat $   [ serialize '\n'
                        , toPDF r
                        , serialize ' '
diff --git a/Graphics/PDF/Resources.hs b/Graphics/PDF/Resources.hs
--- a/Graphics/PDF/Resources.hs
+++ b/Graphics/PDF/Resources.hs
@@ -35,11 +35,11 @@
       
 newtype StrokeAlpha = StrokeAlpha Double deriving(Eq,Ord)  
 instance PdfResourceObject StrokeAlpha where
-  toRsrc (StrokeAlpha a) = AnyPdfObject . PDFDictionary . M.fromList $ [(PDFName "CA",AnyPdfObject a)]
+  toRsrc (StrokeAlpha a) = AnyPdfObject . dictFromList $ [entry "CA" a]
   
 newtype FillAlpha = FillAlpha Double deriving(Eq,Ord)  
 instance PdfResourceObject FillAlpha where
-  toRsrc (FillAlpha a) = AnyPdfObject . PDFDictionary . M.fromList $ [(PDFName "ca",AnyPdfObject a)]
+  toRsrc (FillAlpha a) = AnyPdfObject . dictFromList $ [entry "ca" a]
   
 class PdfResourceObject a where
       toRsrc :: a -> AnyPdfObject
@@ -56,9 +56,6 @@
 --emptyRsrc = PDFResource [AnyPdfObject . PDFName $ "PDF"] (M.empty)
 emptyRsrc = PDFResource [] (M.empty)        
 
-getResources :: M.Map PDFName PDFDictionary -> [(PDFName,AnyPdfObject)]
-getResources = M.toList . M.map AnyPdfObject
-
 instance PdfObject PDFResource where
  toPDF r = toPDF . resourceToDict $ r
      
@@ -74,12 +71,12 @@
                                        addValue (Nothing) = Just . PDFDictionary $ M.insert name newValue M.empty
  in
   r {resources = M.alter addValue dict (resources r)}
-    
+
 -- | Convert the resource to a PDf dictionary
 resourceToDict :: PDFResource -> PDFDictionary
-resourceToDict r = PDFDictionary . M.fromList  $
-    --[(PDFName "ProcSet",AnyPdfObject (procSet r))] ++
-    getResources (resources r)
+resourceToDict r = PDFDictionary $
+    -- M.insert (PDFName "ProcSet") (AnyPdfObject (procSet r)) $
+    M.map AnyPdfObject $ resources r
     
 emptyResource :: PDFResource -> Bool
 emptyResource (PDFResource a b) = null a && M.null b 
diff --git a/Graphics/PDF/Shading.hs b/Graphics/PDF/Shading.hs
--- a/Graphics/PDF/Shading.hs
+++ b/Graphics/PDF/Shading.hs
@@ -1,3 +1,4 @@
+{-# LANGUAGE GADTs #-}
 ---------------------------------------------------------
 -- |
 -- Copyright   : (c) 2006-2016, alpheccar.org
@@ -15,25 +16,74 @@
     PDFShading(..)
   , paintWithShading
   , applyShading
+  , createFunction1Object
+  , createFunction2Object
  ) where
-     
-import Graphics.PDF.Draw
-import Graphics.PDF.LowLevel.Types
-import Control.Monad.State(gets)
+
+import qualified Graphics.PDF.Expression as Expr
+import Graphics.PDF.Draw as Draw
+import Graphics.PDF.Pages(addObject)
 import Graphics.PDF.Shapes(setAsClipPath)
+import Graphics.PDF.Expression(PDFExpression)
+import Graphics.PDF.LowLevel.Serializer(serialize)
+import Graphics.PDF.LowLevel.Types(PDFFloat)
+
+import qualified Data.Array as Array
+
 import Control.Monad.Writer
-import Graphics.PDF.LowLevel.Serializer
 
+
+type ExprFloat = PDFExpression PDFFloat
+
+createFunction1Object ::
+    (ColorTuple a, Expr.Result e) =>
+    Function1 Global a e ->
+    PDF (FunctionObject (PDFFloat -> a) (ExprFloat -> e))
+createFunction1Object func =
+    let domain = domain1Dict func in
+    case func of
+        Calculator1 f ->
+            fmap FunctionStream $ addObject $
+            Draw.rsrcFromCalculator domain f
+        Interpolated1 n x y ->
+            fmap FunctionObject $ addObject $
+            Draw.rsrcFromInterpolated domain n x y
+        Stitched1 part parts ->
+            fmap FunctionObject $ addObject $
+            Draw.rsrcFromStitched domain part parts
+        Sampled1 arr ->
+            fmap FunctionStream $ addObject $
+            Draw.rsrcFromSampled domain (\bnds -> [Array.rangeSize bnds]) arr
+
+createFunction2Object ::
+    (ColorTuple a, Expr.Result e) =>
+    Function2 Global a e ->
+    PDF (FunctionObject
+            (PDFFloat -> PDFFloat -> a) (ExprFloat -> ExprFloat -> e))
+createFunction2Object func =
+    let domain = domain2Dict func in
+    fmap FunctionStream $ addObject $
+    case func of
+        Calculator2 f -> rsrcFromCalculator domain f
+        Sampled2 arr ->
+            rsrcFromSampled
+                domain
+                (\((lx,ly), (ux,uy)) ->
+                    [Array.rangeSize (lx,ux), Array.rangeSize (ly,uy)])
+                arr
+
+
 -- | Fill clipping region with a shading
 applyShading :: PDFShading -> Draw ()
 applyShading shade = do
-    shadingMap <- gets shadings
-    (newName,newMap) <- setResource "Shading" shade shadingMap
-    modifyStrict $ \s -> s { shadings = newMap }
-    tell . mconcat $ [ serialize "\n/" 
-                     , serialize newName
-                     , serialize " sh"
-                     ]
+    newName <-
+        registerResource "Shading"
+            shadings (\newMap s -> s { shadings = newMap })
+            shade
+    tell . mconcat $[ serialize "\n/" 
+                    , serialize newName
+                    , serialize " sh"
+                    ]
     
 paintWithShading :: PDFShading -- ^ Shading
                  -> Draw a -- ^ Shape to paint
diff --git a/Graphics/PDF/Shapes.hs b/Graphics/PDF/Shapes.hs
--- a/Graphics/PDF/Shapes.hs
+++ b/Graphics/PDF/Shapes.hs
@@ -151,17 +151,17 @@
 
 -- | Set pen width
 setWidth :: MonadPath m => PDFFloat -> m ()
-setWidth w = tell . mconcat $ [ serialize "\n" 
-                              , toPDF w
-                              , serialize " w"
-                              ]
+setWidth w = tell . mconcat $[ serialize "\n" 
+                             , toPDF w
+                             , serialize " w"
+                             ]
 
 -- | Set pen width
 setMiterLimit :: MonadPath m => PDFFloat -> m ()
-setMiterLimit w = tell . mconcat $ [ serialize "\n" 
-                                   , toPDF w
-                                   , serialize " M"
-                                   ]
+setMiterLimit w = tell . mconcat $[ serialize "\n" 
+                                  , toPDF w
+                                  , serialize " M"
+                                  ]
 
 -- | Line cap styles
 data CapStyle = ButtCap
@@ -177,29 +177,29 @@
                             
 -- | Set line cap
 setLineCap :: MonadPath m => CapStyle -> m ()
-setLineCap w = tell . mconcat $ [ serialize "\n " 
-                                , toPDF (fromEnum  w)
-                                , serialize " J"
-                                ]
+setLineCap w = tell . mconcat $[ serialize "\n " 
+                               , toPDF (fromEnum  w)
+                               , serialize " J"
+                               ]
 
 -- | Set line join
 setLineJoin :: MonadPath m => JoinStyle -> m ()
-setLineJoin w = tell . mconcat $ [ serialize "\n " 
-                                 , toPDF (fromEnum  w)
-                                 , serialize " j"
-                                 ]
+setLineJoin w = tell . mconcat $[ serialize "\n " 
+                                , toPDF (fromEnum  w)
+                                , serialize " j"
+                                ]
 
 data DashPattern = DashPattern ![PDFFloat] PDFFloat deriving(Eq)
 
 -- | Set the dash pattern
 setDash :: MonadPath m => DashPattern -> m()
 setDash (DashPattern a p) = 
-    tell . mconcat $ [ serialize "\n " 
-                     , toPDF a
-                     , serialize ' '
-                     , toPDF p
-                     , serialize " d"
-                     ]
+    tell . mconcat$ [ serialize "\n " 
+                    , toPDF a
+                    , serialize ' '
+                    , toPDF p
+                    , serialize " d"
+                    ]
 
 -- | No dash pattern
 setNoDash :: MonadPath m => m ()
@@ -247,10 +247,10 @@
 lineto :: Point 
        -> Draw () 
 lineto a = do
-    tell . mconcat $ [ serialize "\n" 
-                     , toPDF a
-                     , serialize " l"
-                     ]
+    tell . mconcat $[ serialize "\n" 
+                    , toPDF a
+                    , serialize " l"
+                    ]
     writeDrawST penPosition a
 
 curveto :: Point -> Point -> Point -> Draw ()
diff --git a/Graphics/PDF/Text.hs b/Graphics/PDF/Text.hs
--- a/Graphics/PDF/Text.hs
+++ b/Graphics/PDF/Text.hs
@@ -118,12 +118,12 @@
 setFont :: PDFFont -> PDFText ()
 setFont f@(PDFFont n size) = PDFText $ do
     lift (modifyStrict $ \s -> s {fontState = Set.insert n (fontState s), currentFont = Just f})
-    tell . mconcat $ [ serialize "\n/" 
-                     , serialize (name n)
-                     , serialize ' '
-                     , toPDF size
-                     , serialize " Tf"
-                     ]
+    tell . mconcat$ [ serialize "\n/" 
+                    , serialize (name n)
+                    , serialize ' '
+                    , toPDF size
+                    , serialize " Tf"
+                    ]
                     
   
 -- | Draw a text in the draw monad
@@ -144,12 +144,12 @@
 textStart :: PDFFloat
           -> PDFFloat
           -> PDFText ()
-textStart x y = tell . mconcat $ [ serialize '\n'
-                                 , toPDF x
-                                 , serialize ' '
-                                 , toPDF y
-                                 , serialize " Td"
-                                 ]
+textStart x y = tell . mconcat  $ [ serialize '\n'
+                                  , toPDF x
+                                  , serialize ' '
+                                  , toPDF y
+                                  , serialize " Td"
+                                  ]
  --writeCmd $ "\n" ++ (show x) ++ " " ++ (show y) ++ " Td"         
 
 
@@ -251,20 +251,20 @@
 -- | Set the text transformation matrix
 setTextMatrix :: Matrix -> PDFText()
 setTextMatrix (Matrix a b c d e f) = 
-    tell . mconcat $ [ serialize '\n'
-                     , toPDF a
-                     , serialize ' '
-                     , toPDF b
-                     , serialize ' '
-                     , toPDF c
-                     , serialize ' '
-                     , toPDF d
-                     , serialize ' '
-                     , toPDF e
-                     , serialize ' '
-                     , toPDF f
-                     , serialize " Tm"
-                     ]
+    tell . mconcat $[ serialize '\n'
+                    , toPDF a
+                    , serialize ' '
+                    , toPDF b
+                    , serialize ' '
+                    , toPDF c
+                    , serialize ' '
+                    , toPDF d
+                    , serialize ' '
+                    , toPDF e
+                    , serialize ' '
+                    , toPDF f
+                    , serialize " Tm"
+                    ]
     
 -- | Utility function to quickly display one line of text
 text :: PDFFont
diff --git a/Graphics/PDF/Transparency.hs b/Graphics/PDF/Transparency.hs
new file mode 100644
--- /dev/null
+++ b/Graphics/PDF/Transparency.hs
@@ -0,0 +1,84 @@
+---------------------------------------------------------
+-- |
+-- Copyright   : (c) 2023, haskell@henning-thielemann.de
+-- License     : BSD-style
+--
+-- Maintainer  : haskell@henning-thielemann.de
+-- Stability   : experimental
+-- Portability : portable
+--
+-- PDF transparency
+---------------------------------------------------------
+module Graphics.PDF.Transparency(
+  -- * Transparency
+  SoftMask,
+  createSoftMask,
+  createTransparencyGroup,
+  paintWithTransparency,
+  ) where
+
+import qualified Graphics.PDF.Draw as Draw
+import Graphics.PDF.Document (createPDFXFormExtra)
+import Graphics.PDF.Draw (PDF, Draw, SoftMask(SoftMask))
+import Graphics.PDF.Shapes (Rectangle)
+import Graphics.PDF.LowLevel.Serializer (serialize)
+import Graphics.PDF.LowLevel.Types
+
+import Control.Monad.Writer (tell)
+import Control.Monad (void)
+
+
+
+createSoftMask ::
+       Rectangle -- ^ Bounding box
+    -> Draw a -- ^ Content of the soft mask
+    -> PDF SoftMask
+createSoftMask bbox =
+    fmap SoftMask .
+    createTransparencyGroup Draw.GraySpace bbox
+
+createTransparencyGroup ::
+       Draw.ColorSpace a e
+    -> Rectangle -- ^ Bounding box
+    -> Draw b -- ^ Painting
+    -> PDF (PDFReference Draw.PDFXForm)
+createTransparencyGroup space bbox img =
+    createPDFXFormExtra bbox img $
+        dictFromList $
+            entry "Group" (dictFromList $
+                entry "Type" (PDFName "Group") :
+                entry "S" (PDFName "Transparency") :
+                entry "I" True :
+                entry "CS" (Draw.colorSpaceName space) :
+                []) :
+            []
+
+{- |
+If the Draw Monad paints overlapping geometric primitives or text,
+the result will certainly not be what you want.
+Text ignores soft masks.
+Each primitive other than text is painted with the soft mask
+over the previous geometric objects.
+It is very likely, that in this case you want
+to generate a transparency group for your drawing.
+-}
+paintWithTransparency ::
+       SoftMask -- ^ Soft mask
+    -> Draw a -- ^ Shape to paint
+    -> Draw ()
+paintWithTransparency softMask d =
+    Draw.withNewContext $ do
+        newName <-
+            Draw.registerResource "ExtGState"
+                Draw.softMasks (\newMap s -> s { Draw.softMasks = newMap })
+                softMask
+        tell . mconcat $
+            [ serialize "\n/"
+            , serialize newName
+            , serialize " gs"
+            ]
+        void d
+
+{-
+https://github.com/pdf-association/pdf20examples/issues/9
+-}
diff --git a/HPDF.cabal b/HPDF.cabal
--- a/HPDF.cabal
+++ b/HPDF.cabal
@@ -1,5 +1,5 @@
 Name: HPDF
-Version: 1.6.2
+Version: 1.7
 cabal-version: >=1.10
 License: BSD3
 License-file:LICENSE
@@ -61,6 +61,7 @@
                      text >= 1.2.0,
                      network-uri >= 2.6.0.3,
                      vector >=0.10,
+                     array,
                      filepath >= 1.4.0
 
   Default-language:  Haskell2010
@@ -108,6 +109,8 @@
      Graphics.PDF.Annotation
      Graphics.PDF.Pattern
      Graphics.PDF.Shading
+     Graphics.PDF.Transparency
+     Graphics.PDF.Expression
      Graphics.PDF.Typesetting
      Graphics.PDF.Documentation
   Other-Modules:
diff --git a/Test/test.hs b/Test/test.hs
--- a/Test/test.hs
+++ b/Test/test.hs
@@ -17,11 +17,13 @@
 module Main where
 
 
+import qualified Graphics.PDF.Expression as Expr
 import Graphics.PDF
 import Penrose
 import System.Random
 import qualified Data.Vector.Unboxed as U
 import qualified Data.Text as T
+import Data.Array (listArray)
 import Network.URI 
 import Data.Maybe(fromJust)
 import System.FilePath 
@@ -60,12 +62,85 @@
             geometryTest
             
             
-shadingTest :: Draw ()
-shadingTest  = do
-     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)
-     
-                     
+shadingTest :: PDFReference PDFPage -> PDF ()
+shadingTest page = do
+    funcObj <-
+        createFunction1Object $
+        Sampled1 $ listArray (0,3) [(1,0,0), (1,0,1), (0,0,1), (0,1,1)]
+    drawWithPage page $ do
+        paintWithShading
+            (RadialShading 0 0 50 0 0 350
+                (ColorFunction1 RGBSpace $ GlobalFunction1 funcObj))
+            (addShape $ Rectangle 0 (300 :+ 300))
+        paintWithShading
+            (AxialShading 300 300 600 400
+                (ColorFunction1 GraySpace $ Interpolated1 1  0.8 0.02))
+            (addShape $ Ellipse 300 300 600 400)
+
+functionalShadingTest :: PDFReference PDFPage -> PDF ()
+functionalShadingTest page = do
+    funcObj <-
+        createFunction2Object $ calculator2 $ \x y ->
+            (1-x,
+             0.5 * (1 + Expr.sinDeg ((360*5) * Expr.sqrt (x*x+y*y))),
+             1-y)
+    drawWithPage page $
+        paintWithShading
+            (FunctionalShading
+                (Matrix 300 0 0 300 150 50)
+                (ColorFunction2 RGBSpace $ GlobalFunction2 funcObj))
+            (addShape $ Rectangle (150:+50) (450 :+ 350))
+
+transparencyTest :: Rectangle -> SoftMask -> Draw ()
+transparencyTest rectB softMask = do
+    let rectA = Rectangle (100:+00) (400 :+ 300)
+    fillColor $ Rgb 1 0 0
+    fill rectA
+
+    paintWithTransparency softMask $ do
+        fillColor $ Rgb 1 1 0
+        fill rectB
+
+    setFillAlpha 0.5
+    let rectC = Rectangle (200:+100) (500 :+ 400)
+    fillColor $ Rgb 0 1 0
+    fill rectC
+
+trafficSign :: AnyFont -> Draw ()
+trafficSign helvetica = do
+    let font = PDFFont helvetica 180
+    let str = "P"
+    strokeColor black
+    drawText $ text font (-0.5 * textWidth font str) (-70) str
+    setWidth 30
+    strokeColor red
+    stroke $ Circle 0 0 100
+    let r = 100 * sqrt 0.5
+    stroke $ Line (-r) (-r) r r
+
+transparencyGroupTest ::
+    AnyFont -> Rectangle -> SoftMask -> PDFReference PDFXForm -> Draw ()
+transparencyGroupTest helvectica rectB softMask trafficSignObj = do
+    applyMatrix $ scale 0.5 0.5
+    applyMatrix $ translate $ 150:+150
+    withNewContext $ trafficSign helvectica
+    withNewContext $ do
+        applyMatrix $ translate $ 300:+0
+        -- alpha channel reveals internal structure of sign - not intended
+        setStrokeAlpha 0.5
+        setFillAlpha 0.5
+        trafficSign helvectica
+    withNewContext $ do
+        applyMatrix $ translate $ 600:+0
+        -- soft mask has no effect on text ... and additional graphics?
+        paintWithTransparency softMask $
+            trafficSign helvectica
+    withNewContext $ do
+        applyMatrix $ translate $ 900:+0
+        paintWithTransparency softMask $
+            drawXObject trafficSignObj
+
+
 patternTest :: PDFReference PDFPage -> PDF ()
 patternTest page = do
      p <- createUncoloredTiling 0 0 100 50 100 50 ConstantSpacing pattern
@@ -324,7 +399,7 @@
                         textStart 0 0
                         setFont (PDFFont theFont fontSize)
                         displayGlyphs (glyph c)
-                    paintWithShading (AxialShading 0 (- getDescent theFont fontSize) w' (getHeight theFont fontSize - getDescent theFont fontSize) (Rgb 1 0 0) (Rgb 0 0 1)) (addShape charRect)
+                    paintWithShading (AxialShading 0 (- getDescent theFont fontSize) w' (getHeight theFont fontSize - getDescent theFont fontSize) (ColorFunction1 RGBSpace $ Interpolated1 1 (1,0,0) (0,0,1))) (addShape charRect)
         in
         (BluePara theFont w', c':l)
     
@@ -654,10 +729,38 @@
         patternTest page7
         
      page8 <- addPage Nothing
-     newSection "Shading" Nothing Nothing $ do
-        drawWithPage page8 $ do
-          shadingTest
-          
+     newSection "Shading" Nothing Nothing $
+        shadingTest page8
+
+     page8a <- addPage Nothing
+     newSection "FunctionalShading" Nothing Nothing $
+        functionalShadingTest page8a
+
+     page8b <- addPage Nothing
+     newSection "Transparency" Nothing Nothing $ do
+        do  let rectB = Rectangle (150:+50) (450 :+ 350)
+            softMask <-
+                createSoftMask rectB
+                    (paintWithShading
+                        (AxialShading 300 300 600 400
+                            (ColorFunction1 GraySpace $
+                             Interpolated1 1  0.8 0.02))
+                        (addShape rectB))
+            drawWithPage page8b $
+                transparencyTest rectB softMask
+
+        page8c <- addPage Nothing
+        do  let bbox = Rectangle (-(150:+150)) (150:+150)
+            softMask <-
+                createSoftMask bbox $ do
+                    fillColor $ Rgb 0.5 0.5 0.5
+                    fill bbox
+            transpGroup <-
+                createTransparencyGroup RGBSpace bbox $
+                trafficSign helveticaBold
+            drawWithPage page8c $
+                transparencyGroupTest helveticaBold bbox softMask transpGroup
+
     page9 <- addPage Nothing
     newSection "Media" Nothing Nothing $ do
       newSection "image" Nothing Nothing $ do   
diff --git a/changelog.md b/changelog.md
--- a/changelog.md
+++ b/changelog.md
@@ -1,11 +1,8 @@
 # Changelog for [`HPDF` package](http://hackage.haskell.org/package/HPDF)
 
-## 1.6.2
-
-   * Removed use of cbits for float/int to string conversions for correctness
-     (see https://github.com/hsyl20/HPDF/issues/14)
+## 1.7
 
-   * Fix build warnings due to -Woperator-whitespace-ext-conflict
+   * Add transparency support and more function types (#16)
 
 ## 1.6.1