anchor.diff:  ;; TORT OR OTHERWISE, ARISING FROM, OUT OF OR IN CONNECTION WITH THE
   ;; SOFTWARE OR THE USE OR OTHER DEALINGS IN THE SOFTWARE.
   
  -;; $Id: cairo.lisp,v 1.23 2008-10-27 18:39:30 espen Exp $
  +;; $Id: cairo.lisp,v 1.24 2008-11-28 19:26:04 espen Exp $
   
   (in-package "CAIRO")
   
  
positive.code: 
  ;;; Surfaces
  
  (defmethod make-proxy-instance :around ((class surface-class) location 
  					&rest initargs)
    (let ((class (find-class (%surface-get-type location))))
  
negative.code: 
  ;; Image Surface
  
  (defmethod allocate-foreign ((surface image-surface) &key source type
  			     width height stride format)
    (etypecase source
     (stream
      (let ((stream-id (register-user-data source)))
        (unwind-protect
  	   (cond
  	     ((member type '("png" "image/png") :test #'equal)
  	      (%image-surface-create-from-png-stream stream-id))
  	     ((member type '("jpeg" "image/jpeg") :test #'equal)
  	      (%image-surface-create-from-jpeg-stream stream-id))
  	     ((not type) (error "Image type must be specified"))
  	     ((error "Can't handle image type ~A" type)))
  	(destroy-user-data stream-id))))
     ((or string pathname)
      (cond 
        ((member type '("png" "image/png") :test #'equal)
         (%image-surface-create-from-png source))
        ((member type '("jpeg" "image/jpeg") :test #'equal)
         (%image-surface-create-from-jpeg source))
        ((not type) (error "Image type must be specified"))
        ((error "Can't handle image type ~A" type))))
     (pointer
      (%image-surface-create-for-data source format width height 
       (or stride (format-stride-for-width format width))))
     (null (%image-surface-create format width height))))
  
  #?(pkg-exists-p "cairo" :atleast-version "1.6")
  (defbinding format-stride-for-width () int
    surface-format (width int))
  
  #?-(pkg-exists-p "cairo" :atleast-version "1.6")
  (defun format-stride-for-width (format width)
    (let ((element-size (cdr (assoc format '((:argb32 . 4) (:rgb24 . 4) (:a8 . 1) (:a1 1/8))))))
      (ceiling (* width element-size))))
  
  
  (defbinding %image-surface-create () pointer
  