X-Git-Url: https://git.distorted.org.uk/~mdw/clg/blobdiff_plain/f7f58f900d15c703dde92bb493e1764ab01ad5f5..c1e76b2d393d4a7d1c61c8d1711f233aff0fd456:/examples/testcairo.lisp

diff --git a/examples/testcairo.lisp b/examples/testcairo.lisp
index 0cf9fdb..1954e63 100644
--- a/examples/testcairo.lisp
+++ b/examples/testcairo.lisp
@@ -124,9 +124,9 @@
   (cairo:clip cr)
   (cairo:new-path cr)
 
-  (let ((image (cairo:image-surface-create-from-png 
-		#p"clg:examples;romedalen.png")))
-
+  (let ((image (make-instance 'cairo:image-surface 
+		:filename #p"clg:examples;romedalen.png")))
+	       
     (let ((width (cairo:surface-width image))
 	  (height (cairo:surface-height image)))
       (cairo:scale cr (/ 1.0 width) (/ 1.0 height)))
@@ -262,6 +262,36 @@
   (cairo:stroke cr))
 
 
+(define-snippet fill-style (cr)
+  (cairo:scale cr (/ 256.0) (/ 256.0))
+  (setf (cairo:line-width cr) 6)
+  (cairo:rectangle cr 12 12 232 70)
+  (cairo:new-sub-path cr)
+  (cairo:arc cr 64 64 40 0 (* 2 pi))
+  (cairo:new-sub-path cr)
+  (cairo:arc-negative cr 192 64 40 0 (* -2 pi))
+
+  (setf (cairo:fill-rule cr) :even-odd)
+  (cairo:set-source-color cr 0 0.7 0)
+  (cairo:fill cr t)
+  (cairo:set-source-color cr 0 0 0)
+  (cairo:stroke cr)
+
+  (cairo:translate cr 0 128)
+  (cairo:rectangle cr 12 12 232 70)
+  (cairo:new-sub-path cr)
+  (cairo:arc cr 64 64 40 0 (* 2 pi))
+  (cairo:new-sub-path cr)
+  (cairo:arc-negative cr 192 64 40 0 (* -2 pi))
+
+  (setf (cairo:fill-rule cr) :winding)
+  (cairo:set-source-color cr 0 0 0.9)
+  (cairo:fill cr t)
+  (cairo:set-source-color cr 0 0 0)
+  (cairo:stroke cr))
+
+
+
 (define-snippet gradient (cr)
   (let ((pattern (cairo:pattern-create-linear 0.0 0.0 0.0 1.0)))
     (cairo:pattern-add-color-stop pattern 1.0 0.0 0.0 0.0 1.0)
@@ -278,21 +308,21 @@
 
 
 (define-snippet image (cr)
-  (let ((image (cairo:image-surface-create-from-png 
-		#p"clg:examples;romedalen.png")))
+  (let ((image (make-instance 'cairo:image-surface 
+		:filename #p"clg:examples;romedalen.png")))
     (cairo:translate cr 0.5 0.5)
     (cairo:rotate cr (deg-to-rad 45.0))
     (let ((width (cairo:surface-width image))
 	  (height (cairo:surface-height image)))
-      (cairo:scale cr (/ 1.0 width) (/ 1.0 height))  
+      (cairo:scale cr (/ 1.0 width) (/ 1.0 height))
       (cairo:translate cr (* -0.5 width) (* -0.5 height)))
     (cairo:set-source-surface cr image 0 0)
     (cairo:paint cr)))
 
     
 (define-snippet image-pattern (cr)
-  (let* ((image (cairo:image-surface-create-from-png 
-		 #p"clg:examples;romedalen.png"))
+  (let* ((image (make-instance 'cairo:image-surface
+		 :filename #p"clg:examples;romedalen.png"))
 	 (pattern (cairo:pattern-create-for-surface image)))
     (setf (cairo:pattern-extend pattern) :repeat)    
     (cairo:translate cr 0.5 0.5)
@@ -506,11 +536,13 @@
     (make-instance 'v-box
      :parent main-window
      :child-args '(:expand nil)
-     :child (list (make-instance 'label :label (gtk-version)) :fill nil)
+     :child (list (make-instance 'label 
+		   :label (format nil "Cairo ~A" (cairo:version-string)))
+		  :fill nil)
      :child (list (make-instance 'label :label (clg-version)) :fill nil)
      :child (list (make-instance 'label 			  
 		   :label #-cmu
-		          (format nil "~A (~A)" 
+		          (format nil "~A ~A" 
 			   (lisp-implementation-type)
 			   #-clisp
 			   (lisp-implementation-version)
@@ -540,7 +572,6 @@
 
 
 (clg-init)
-#?(pkg-config:pkg-exists-p "librsvg-2.0" :atleast-version "2.13.93")
 (rsvg:init)
 
 ;; We need to turn off floating point exceptions, because Cairo is
@@ -549,4 +580,4 @@
 #+sbcl(sb-int:set-floating-point-modes :traps nil) 
 #+cmu(ext:set-floating-point-modes :traps nil)
 
-(create-tests)
+(within-main-loop (create-tests))