X-Git-Url: https://git.distorted.org.uk/~mdw/clg/blobdiff_plain/8bb987b4f7849a7604c5bbbe6381ffca971d35d3..d92bb6e7fece0cabaac36ef2bb9888fe05d7c21d:/examples/testcairo.lisp?ds=sidebyside

diff --git a/examples/testcairo.lisp b/examples/testcairo.lisp
index 677b815..bbdc56c 100644
--- 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 @@
 (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 @@
 	       (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 @@
     (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 @@
      (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-reverse :dest-over)
 (define-operator-snippet operator-saturate :saturate)
 (define-operator-snippet operator-xor :xor)
+)
 
       
 
@@ -525,7 +534,7 @@
 
 
 (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.