X-Git-Url: https://www.chiark.greenend.org.uk/ucgi/~mdw/git/clg/blobdiff_plain/c36ffea13a17c8e8a2a6583e72ac1723586faa85..0bbf3105ee7496ce6748411458f2d22eb40479a9:/examples/testcairo.lisp diff --git a/examples/testcairo.lisp b/examples/testcairo.lisp index dc0f7bb..9768b90 100644 --- a/examples/testcairo.lisp +++ b/examples/testcairo.lisp @@ -22,11 +22,11 @@ (in-package "TESTCAIRO") (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) - (/ (* rad 180) pi)) + (/ (* rad 180.0) pi)) (defvar *snippets* ()) @@ -64,8 +64,8 @@ (defun ,name () (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) @@ -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: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)) @@ -124,9 +124,9 @@ (define-snippet clip-image (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))) @@ -145,8 +145,8 @@ (define-snippet clip-rectangle (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)) @@ -211,7 +211,7 @@ (define-snippet curve-to (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) @@ -247,41 +247,41 @@ (define-snippet fill-and-stroke2 (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: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:set-source-color cr 0 0 1) + (cairo:set-source-color cr 0.0 0.0 1.0) (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: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))) - (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) - (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)) + (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)) @@ -291,13 +291,13 @@ (define-snippet image (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) - (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)) @@ -378,7 +378,7 @@ (define-snippet set-line-cap (cr) (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) @@ -421,17 +421,17 @@ (define-snippet text (cr) (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: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 - (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)) @@ -540,7 +540,6 @@ (defun create-tests () (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 +548,4 @@ (rsvg:init) #+sbcl(sb-int:set-floating-point-modes :traps nil) #+cmu(ext:set-floating-point-modes :traps nil) -(create-tests) +(within-main-loop (create-tests))