Custom types are now re-registered when a saved image is loaded

[clg] / examples / testcairo.lisp

diff --git a/examples/testcairo.lisp b/examples/testcairo.lisp
index 677b81504c153bf2ebdff9c06e2d65056b07c988..bbdc56c9381f7255eb18c8fe5664b00264b67690 100644 (file)
--- a/examples/testcairo.lisp
+++ b/examples/testcairo.lisp
@@ -5,8 +5,15 @@
 #+cmu(asdf:oos 'asdf:load-op :gtk)
 #+sbcl(require :cairo)
 #+cmu(asdf:oos 'asdf:load-op :cairo)
-#+sbcl(require :rsvg)
-#+cmu(asdf:oos 'asdf:load-op :rsvg)
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (if (pkg-config:pkg-exists-p "librsvg-2.0" :atleast-version "2.13.93" :error nil)
+      (push :rsvg *features*)
+    (warn "SVG tests disabled as the required version of librsvg is not available.")))
+
+
+#+(and sbcl rsvg)(require :rsvg)
+#+(and cmu  rsvg)(asdf:oos 'asdf:load-op :rsvg)
 
 (defpackage "TESTCAIRO"
   (:use "COMMON-LISP" "GTK")
@@ -29,7 +36,7 @@ (defvar *snippets* ())
 (defmacro define-snippet (name (cr) &body body)
   (let ((widget (make-symbol "WIDGET"))
        (window (make-symbol "WINDOW"))
-       (pointer (make-symbol "POINTER")))
+       (event (make-symbol "EVENT")))
     `(let ((,window nil))
        (pushnew ',name *snippets*)
        (defun ,name ()
@@ -43,9 +50,9 @@        (defun ,name ()
               (signal-connect ,window 'destroy 
                 #'(lambda () (setq ,window nil)))
               (signal-connect ,widget 'expose-event
-               #'(lambda (,pointer)
-                   (declare (ignore ,pointer))
-                   (let ((,cr (gdk:cairo-create (widget-window ,widget))))
+               #'(lambda (,event)
+                   (declare (ignore ,event))
+                   (gdk:with-cairo-context (,cr (widget-window ,widget))
                      (multiple-value-bind (width height) 
                          (widget-get-size-allocation ,widget)
                        (cairo:scale ,cr width height))
@@ -302,12 +309,13 @@ (define-snippet image-pattern (cr)
     (cairo:fill cr)))
 
 
+#+rsvg(progn
 (defun snippet-set-bg-svg (cr filename)
   (let ((handle (make-instance 'rsvg:handle :filename filename)))
     (cairo:with-context (cr)
-      (with-slots (rsvg:width rsvg:height) (rsvg:handle-dimensions handle)
-       (cairo:scale cr (/ 1.0 rsvg:width) (/ 1.0 rsvg:height))
-       (rsvg:cairo-render cr handle)))))
+      (with-slots (rsvg:width rsvg:height) handle
+        (cairo:scale cr (/ 1.0 rsvg:width) (/ 1.0 rsvg:height))
+       (rsvg:render-cairo handle cr)))))
 
 (define-snippet librsvg (cr)
   (snippet-set-bg-svg cr "clg:examples;home.svg"))
@@ -325,7 +333,7 @@ (defmacro define-operator-snippet (name operator)
      (cairo:set-source-color cr 0.0 1.0 0.0)
      (cairo:rectangle cr 0.4 0.4 0.4 0.4)
      (cairo:fill cr)
-     
+       
      (cairo:set-source-color cr 0.0 0.0 1.0)
      (cairo:rectangle cr 0.6 0.6 0.3 0.3)
      (cairo:fill cr)))
@@ -341,6 +349,7 @@ (define-operator-snippet operator-over :over)
 (define-operator-snippet operator-over-reverse :dest-over)
 (define-operator-snippet operator-saturate :saturate)
 (define-operator-snippet operator-xor :xor)
+)
 
       
 
@@ -525,7 +534,7 @@ (defun create-tests ()
 
 
 (clg-init)
-(rsvg:init)
+#+rsvg(rsvg:init)
 
 ;; We need to turn off floating point exceptions, because Cairo is
 ;; presumably using internal code which generates NaNs in some cases.