Mostly Cairo releated fixes

[clg] / examples / testcairo.lisp

diff --git a/examples/testcairo.lisp b/examples/testcairo.lisp
index 41b7230c71ef0c41d45639fddd35c87f5d745221..9768b903bd2cf531dd788a3d59184ec53a32f9dd 100644 (file)
--- a/examples/testcairo.lisp
+++ b/examples/testcairo.lisp
@@ -7,10 +7,10 @@
 #+(or cmu clisp)(asdf:oos 'asdf:load-op :cairo)
 
 (eval-when (:compile-toplevel :load-toplevel :execute)
 #+(or cmu clisp)(asdf:oos 'asdf:load-op :cairo)
 
 (eval-when (:compile-toplevel :load-toplevel :execute)

-  (unless (pkg-config:pkg-exists-p "librsvg-2.0" :atleast-version "2.13.93")
+  (unless (pkg-config:pkg-exists-p "librsvg-2.0" :atleast-version "2.14.0")

     (warn "SVG tests disabled as the required version of librsvg is not available.")))
 
     (warn "SVG tests disabled as the required version of librsvg is not available.")))
 

-#?(pkg-config:pkg-exists-p "librsvg-2.0" :atleast-version "2.13.93")
+#?(pkg-config:pkg-exists-p "librsvg-2.0" :atleast-version "2.14.0")

 #+sbcl(require :rsvg)
 #+(or cmu clisp)(asdf:oos 'asdf:load-op :rsvg)
 
 #+sbcl(require :rsvg)
 #+(or cmu clisp)(asdf:oos 'asdf:load-op :rsvg)
 


@@ -22,11 +22,11 @@ (in-package "TESTCAIRO")
 
 (declaim (inline deg-to-rad))
 (defun deg-to-rad (deg)
 
 (declaim (inline deg-to-rad))
 (defun deg-to-rad (deg)

-  (* deg (/ pi 180)))
+  (* deg (/ pi 180.0)))

 
 (declaim (inline rad-to-deg))
 (defun rad-to-deg (rad)
 
 (declaim (inline rad-to-deg))
 (defun rad-to-deg (rad)

-  (/ (* rad 180) pi))
+  (/ (* rad 180.0) pi))

 
 
 (defvar *snippets* ())
 
 
 (defvar *snippets* ())


@@ -64,8 +64,8 @@        (defun ,name ()
      
 
 (defun arc-helper-lines (cr xc yc radius angle1 angle2)
      
 
 (defun arc-helper-lines (cr xc yc radius angle1 angle2)

-  (cairo:set-source-color cr 1 0.2 0.2 0.6)
-  (cairo:arc cr xc yc 0.05 0 (deg-to-rad 360))
+  (cairo:set-source-color cr 1.0 0.2 0.2 0.6)
+  (cairo:arc cr xc yc 0.05 0 (deg-to-rad 360.0))

   (cairo:fill cr)
   (setf (cairo:line-width cr) 0.03)
   (cairo:move-to cr xc yc)
   (cairo:fill cr)
   (setf (cairo:line-width cr) 0.03)
   (cairo:move-to cr xc yc)


@@ -111,11 +111,11 @@ (define-snippet clip (cr)
   (cairo:new-path cr) ; current path is not consumed by cairo:clip
   (cairo:rectangle cr 0 0 1 1)
   (cairo:fill cr)
   (cairo:new-path cr) ; current path is not consumed by cairo:clip
   (cairo:rectangle cr 0 0 1 1)
   (cairo:fill cr)

-  (cairo:set-source-color cr 0 1 0)
-  (cairo:move-to cr 0 0)
-  (cairo:line-to cr 1 1)
-  (cairo:move-to cr 1 0)
-  (cairo:line-to cr 0 1)
+  (cairo:set-source-color cr 0.0 1.0 0.0)
+  (cairo:move-to cr 0.0 0.0)
+  (cairo:line-to cr 1.0 1.0)
+  (cairo:move-to cr 1.0 0.0)
+  (cairo:line-to cr 0.0 1.0)

   (cairo:stroke cr))
 
 
   (cairo:stroke cr))
 
 


@@ -124,9 +124,9 @@ (define-snippet clip-image (cr)
   (cairo:clip cr)
   (cairo:new-path cr)
 
   (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)))
     (let ((width (cairo:surface-width image))
          (height (cairo:surface-height image)))
       (cairo:scale cr (/ 1.0 width) (/ 1.0 height)))


@@ -145,8 +145,8 @@ (define-snippet clip-rectangle (cr)
 
   (cairo:clip cr)
 
 
   (cairo:clip cr)
 

-  (cairo:move-to cr 0 0)
-  (cairo:line-to cr 1 1)
+  (cairo:move-to cr 0.0 0.0)
+  (cairo:line-to cr 1.0 1.0)

   (cairo:stroke cr))
 
 
   (cairo:stroke cr))
 
 


@@ -211,7 +211,7 @@ (define-snippet curve-to (cr)
 
     (cairo:stroke cr)
 
 
     (cairo:stroke cr)
 

-    (cairo:set-source-color cr 1 0.2 0.2 0.6)
+    (cairo:set-source-color cr 1.0 0.2 0.2 0.6)

     (setf (cairo:line-width cr) 0.03)
     (cairo:move-to cr x y)
     (cairo:line-to cr x1 y1)
     (setf (cairo:line-width cr) 0.03)
     (cairo:move-to cr x y)
     (cairo:line-to cr x1 y1)


@@ -247,41 +247,41 @@ (define-snippet fill-and-stroke2 (cr)
   (cairo:rel-line-to cr -0.2 -0.2)
   (cairo:close-path cr)
 
   (cairo:rel-line-to cr -0.2 -0.2)
   (cairo:close-path cr)
 

-  (cairo:set-source-color cr 0 0 1)
+  (cairo:set-source-color cr 0.0 0.0 1.0)

   (cairo:fill cr t)
   (cairo:fill cr t)

-  (cairo:set-source-color cr 0 0 0)
+  (cairo:set-source-color cr 0.0 0.0 0.0)

   (cairo:stroke cr))
 
 
 (define-snippet fill-and-stroke (cr)
   (fill-and-stroke-common cr)
 
   (cairo:stroke cr))
 
 
 (define-snippet fill-and-stroke (cr)
   (fill-and-stroke-common cr)
 

-  (cairo:set-source-color cr 0 0 1)
+  (cairo:set-source-color cr 0.0 0.0 1.0)

   (cairo:fill cr t)
   (cairo:fill cr t)

-  (cairo:set-source-color cr 0 0 0)
+  (cairo:set-source-color cr 0.0 0.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: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 1)
-    (cairo:pattern-add-color-stop pattern 0 1 1 1 1)
-    (cairo:rectangle cr 0 0 1 1)
+    (cairo:pattern-add-color-stop pattern 1.0 0.0 0.0 0.0 1.0)
+    (cairo:pattern-add-color-stop pattern 0.0 1.0 1.0 1.0 1.0)
+    (cairo:rectangle cr 0.0 0.0 1.0 1.0)

     (setf (cairo:source cr) pattern)
     (cairo:fill cr))
   (let ((pattern (cairo:pattern-create-radial 0.45 0.4 0.1 0.4 0.4 0.5)))
     (setf (cairo:source cr) pattern)
     (cairo:fill cr))
   (let ((pattern (cairo:pattern-create-radial 0.45 0.4 0.1 0.4 0.4 0.5)))

-    (cairo:pattern-add-color-stop pattern 0 1 1 1 1)
-    (cairo:pattern-add-color-stop pattern 1 0 0 0 1)
+    (cairo:pattern-add-color-stop pattern 0.0 1.0 1.0 1.0 1.0)
+    (cairo:pattern-add-color-stop pattern 1.0 0.0 0.0 0.0 1.0)

     (setf (cairo:source cr) pattern)
     (cairo:circle cr 0.5 0.5 0.3)
     (cairo:fill cr)))
 
 
 (define-snippet image (cr)
     (setf (cairo:source cr) pattern)
     (cairo:circle cr 0.5 0.5 0.3)
     (cairo:fill cr)))
 
 
 (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:translate cr 0.5 0.5)

-    (cairo:rotate cr (deg-to-rad 45))
+    (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))  
     (let ((width (cairo:surface-width image))
          (height (cairo:surface-height image)))
       (cairo:scale cr (/ 1.0 width) (/ 1.0 height))  


@@ -291,13 +291,13 @@ (define-snippet image (cr)
 
     
 (define-snippet image-pattern (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)
         (pattern (cairo:pattern-create-for-surface image)))
     (setf (cairo:pattern-extend pattern) :repeat)    
     (cairo:translate cr 0.5 0.5)

-    (cairo:rotate cr (deg-to-rad 45))
-    (cairo:scale cr (/ 1.0 (sqrt 2)) (/ 1.0 (sqrt 2)))  
+    (cairo:rotate cr (deg-to-rad 45.0))
+    (cairo:scale cr (/ 1.0 (sqrt 2.0)) (/ 1.0 (sqrt 2.0)))  

     (cairo:translate cr -0.5 -0.5)
     (let ((width (cairo:surface-width image))
          (height (cairo:surface-height image))
     (cairo:translate cr -0.5 -0.5)
     (let ((width (cairo:surface-width image))
          (height (cairo:surface-height image))


@@ -378,7 +378,7 @@ (define-snippet set-line-cap (cr)
   (cairo:stroke cr)
 
   ;; draw helping lines
   (cairo:stroke cr)
 
   ;; draw helping lines

-  (cairo:set-source-color cr 1 0.2 0.2)
+  (cairo:set-source-color cr 1.0 0.2 0.2)

   (setf (cairo:line-width cr) 0.01)
   (cairo:move-to cr 0.25 0.2)
   (cairo:line-to cr 0.25 0.8)
   (setf (cairo:line-width cr) 0.01)
   (cairo:move-to cr 0.25 0.2)
   (cairo:line-to cr 0.25 0.8)


@@ -421,17 +421,17 @@ (define-snippet text (cr)
 
   (cairo:move-to cr 0.27 0.65)
   (cairo:text-path cr "void")
 
   (cairo:move-to cr 0.27 0.65)
   (cairo:text-path cr "void")

-  (cairo:set-source-color cr 0.5 0.5 1)
+  (cairo:set-source-color cr 0.5 0.5 1.0)

   (cairo:fill cr t)
 
   (cairo:fill cr t)
 

-  (cairo:set-source-color cr 0 0 0)
+  (cairo:set-source-color cr 0.0 0.0 0.0)

   (setf (cairo:line-width cr) 0.01)
   (cairo:stroke cr)
 
   ;; draw helping lines
   (setf (cairo:line-width cr) 0.01)
   (cairo:stroke cr)
 
   ;; draw helping lines

-  (cairo:set-source-color cr 1 0.2 0.2  0.6)
-  (cairo:arc cr 0.04 0.53 0.02 0 (deg-to-rad 360))
-  (cairo:arc cr 0.27 0.65 0.02 0 (deg-to-rad 360))
+  (cairo:set-source-color cr 1.0 0.2 0.2  0.6)
+  (cairo:arc cr 0.04 0.53 0.02 0 (deg-to-rad 360.0))
+  (cairo:arc cr 0.27 0.65 0.02 0 (deg-to-rad 360.0))

   (cairo:fill cr))
 
 
   (cairo:fill cr))
 
 


@@ -540,7 +540,6 @@ (defun create-tests ()
 
 
 (clg-init)
 
 
 (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
 (rsvg:init)
 
 ;; We need to turn off floating point exceptions, because Cairo is


@@ -549,4 +548,4 @@ (rsvg:init)
 #+sbcl(sb-int:set-floating-point-modes :traps nil) 
 #+cmu(ext:set-floating-point-modes :traps nil)
 
 #+sbcl(sb-int:set-floating-point-modes :traps nil) 
 #+cmu(ext:set-floating-point-modes :traps nil)
 

-(create-tests)
+(within-main-loop (create-tests))