X-Git-Url: https://git.distorted.org.uk/~mdw/clg/blobdiff_plain/1ed0a2c57d1624d098f180bff1c567960a9b1b36..c1e76b2d393d4a7d1c61c8d1711f233aff0fd456:/examples/testcairo.lisp diff --git a/examples/testcairo.lisp b/examples/testcairo.lisp index 131cfed..1954e63 100644 --- a/examples/testcairo.lisp +++ b/examples/testcairo.lisp @@ -2,12 +2,17 @@ ;; See http://cairographics.org/samples/ #+sbcl(require :gtk) -#+cmu(asdf:oos 'asdf:load-op :gtk) #+sbcl(require :cairo) -#+cmu(asdf:oos 'asdf:load-op :cairo) +#+(or cmu clisp)(asdf:oos 'asdf:load-op :gtk) +#+(or cmu clisp)(asdf:oos 'asdf:load-op :cairo) -;;#+sbcl(require :rsvg) -;;#+cmu(asdf:oos 'asdf:load-op :avg-cairo) +(eval-when (:compile-toplevel :load-toplevel :execute) + (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."))) + +#?(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) (defpackage "TESTCAIRO" (:use "COMMON-LISP" "GTK") @@ -17,11 +22,11 @@ (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* ()) @@ -30,9 +35,9 @@ (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)) - (setq *snippets* (pushnew ',name *snippets*)) + (pushnew ',name *snippets*) (defun ,name () (if (not ,window) (let ((,widget (make-instance 'drawing-area))) @@ -44,9 +49,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)) @@ -59,8 +64,8 @@ (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) @@ -106,11 +111,11 @@ (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)) @@ -119,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))) @@ -140,58 +145,59 @@ (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)) -;; (define-snippet curve-rectangle (cr) -;; (let ((x0 0.1) -;; (y0 0.1) -;; (width 0.8) -;; (height 0.8) -;; (radius 0.4)) -;; (unless (and (zerop width) (zerop height)) -;; (let ((x1 (+ x0 width)) -;; (y1 (+ y0 height))) -;; (cond -;; ((and (< (* 0.5 width) radius) (< (* 0.5 height) radius)) -;; (cairo:move-to cr x0 (* 0.5 (+ y0 y1))) -;; (cairo:curve-to cr x0 y0 x0 y0 (* 0.5 (+ x0 x1)) y0) -;; (cairo:curve-to cr x1 y0 x1 y0 x1 (* 0.5 (+ y0 y1))) -;; (cairo:curve-to cr x1 y1 x1 y1 (* 0.5 (+ x0 x1)) y1) -;; (cairo:curve-to cr x0 y1 x0 y1 x0 (* 0.5 (+ y0 y1)))) -;; ((< (* 0.5 width) radius) -;; (cairo:move-to cr x0 (+ y0 radius)) -;; (cairo:curve-to cr x0 y0 x0 y0 (* 0.5 (+ x0 x1)) y0) -;; (cairo:curve-to cr x1 y0 x1 y0 x1 (+ y0 radius)) -;; (cairo:line-to cr x1 (- y1 radius)) -;; (cairo:curve-to cr x1 y1 x1 y1 (* 0.5 (+ x0 x1)) y1) -;; (cairo:curve-to cr x0 y1 x0 y1 x0 (- y1 radius))) -;; ((< (* 0.5 height) radius) -;; (cairo:move-to cr x0 (* 0.5 (+ y0 y1))) -;; (cairo:curve-to cr x0 y0 x0 y0 (+ x0 radius) y0) -;; (cairo:line-to cr (- x1 radius) y0) -;; (cairo:curve-to cr x1 y0 x1 y0 x1 (* 0.5 (+ y0 y1))) -;; (cairo:curve-to cr x1 y1 x1 y1 (- x1 radius) y1) -;; (cairo:line-to cr (+ x0 radius) y1) -;; (cairo:curve-to cr x0 y1 x0 y1 x0 (* 0.5 (+ y0 y1)))) -;; (t -;; (cairo:move-to cr x0 (+ y0 radius)) -;; (cairo:curve-to cr x0 y0 x0 y0 (+ x0 radius) y0) -;; (cairo:line-to cr (- x1 radius) y0) -;; (cairo:curve-to cr x1 y0 x1 y0 x1 (+ y0 radius)) -;; (cairo:line-to cr x1 (- y1 radius)) -;; (cairo:curve-to cr x1 y1 x1 y1 (- x1 radius) y1) -;; (cairo:line-to cr (+ x0 radius) y1) -;; (cairo:curve-to cr x0 y1 x0 y1 x0 (- y1 radius)))) -;; (cairo:close-path cr) - -;; (cairo:set-source-color cr 0.5 0.5 1.0) -;; (cairo:fill cr t) -;; (cairo:set-source-color cr 0.5 0.0 0.0 0.5) -;; (cairo:stroke cr))))) - +(defun %curve-rectangle (cr x0 y0 width height radius) + (unless (and (zerop width) (zerop height)) + (let ((x1 (+ x0 width)) + (y1 (+ y0 height))) + (cond + ((and (< (* 0.5 width) radius) (< (* 0.5 height) radius)) + (cairo:move-to cr x0 (* 0.5 (+ y0 y1))) + (cairo:curve-to cr x0 y0 x0 y0 (* 0.5 (+ x0 x1)) y0) + (cairo:curve-to cr x1 y0 x1 y0 x1 (* 0.5 (+ y0 y1))) + (cairo:curve-to cr x1 y1 x1 y1 (* 0.5 (+ x0 x1)) y1) + (cairo:curve-to cr x0 y1 x0 y1 x0 (* 0.5 (+ y0 y1)))) + ((< (* 0.5 width) radius) + (cairo:move-to cr x0 (+ y0 radius)) + (cairo:curve-to cr x0 y0 x0 y0 (* 0.5 (+ x0 x1)) y0) + (cairo:curve-to cr x1 y0 x1 y0 x1 (+ y0 radius)) + (cairo:line-to cr x1 (- y1 radius)) + (cairo:curve-to cr x1 y1 x1 y1 (* 0.5 (+ x0 x1)) y1) + (cairo:curve-to cr x0 y1 x0 y1 x0 (- y1 radius))) + ((< (* 0.5 height) radius) + (cairo:move-to cr x0 (* 0.5 (+ y0 y1))) + (cairo:curve-to cr x0 y0 x0 y0 (+ x0 radius) y0) + (cairo:line-to cr (- x1 radius) y0) + (cairo:curve-to cr x1 y0 x1 y0 x1 (* 0.5 (+ y0 y1))) + (cairo:curve-to cr x1 y1 x1 y1 (- x1 radius) y1) + (cairo:line-to cr (+ x0 radius) y1) + (cairo:curve-to cr x0 y1 x0 y1 x0 (* 0.5 (+ y0 y1)))) + (t + (cairo:move-to cr x0 (+ y0 radius)) + (cairo:curve-to cr x0 y0 x0 y0 (+ x0 radius) y0) + (cairo:line-to cr (- x1 radius) y0) + (cairo:curve-to cr x1 y0 x1 y0 x1 (+ y0 radius)) + (cairo:line-to cr x1 (- y1 radius)) + (cairo:curve-to cr x1 y1 x1 y1 (- x1 radius) y1) + (cairo:line-to cr (+ x0 radius) y1) + (cairo:curve-to cr x0 y1 x0 y1 x0 (- y1 radius)))) + (cairo:close-path cr)))) + +(define-snippet curve-rectangle (cr) + (let ((x0 0.1) + (y0 0.1) + (width 0.8) + (height 0.8) + (radius 0.4)) + (%curve-rectangle cr x0 y0 width height radius) + (cairo:set-source-color cr 0.5 0.5 1.0) + (cairo:fill cr t) + (cairo:set-source-color cr 0.5 0.0 0.0 0.5) + (cairo:stroke cr))) (define-snippet curve-to (cr) @@ -205,7 +211,7 @@ (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) @@ -241,57 +247,87 @@ (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.0 0.0) + (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 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)) + (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) - (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)) @@ -303,46 +339,48 @@ (cairo:fill cr))) -;; (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))))) +#?(pkg-config:pkg-exists-p "librsvg-2.0" :atleast-version "2.13.93") +(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) 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")) +(define-snippet librsvg (cr) + (snippet-set-bg-svg cr "clg:examples;home.svg")) -(defmacro define-operator-snippet (operator) - (let ((name (intern (format nil "OPERATOR-~A" operator)))) - `(define-snippet ,name (cr) - (snippet-set-bg-svg cr "clg:examples;freedesktop.svg") - (setf (cairo:operator cr) ,operator) - - (cairo:set-source-color cr 1.0 0.0 0.0 0.5) - (cairo:rectangle cr 0.2 0.2 0.5 0.5) - (cairo:fill) - - (cairo:set-source-color cr 0.0 1.0 0.0) - (cairo:rectangle cr 0.4 0.4 0.4 0.4) - (cairo:fill) +(defmacro define-operator-snippet (name operator) + `(define-snippet ,name (cr) + (snippet-set-bg-svg cr "clg:examples;freedesktop.svg") + (setf (cairo:operator cr) ,operator) + + (cairo:set-source-color cr 1.0 0.0 0.0 0.5) + (cairo:rectangle cr 0.2 0.2 0.5 0.5) + (cairo:fill cr) + + (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)))) - -;; (define-operator-snippet :add) -;; (define-operator-snippet :atop) -;; (define-operator-snippet :atop-reverse) -;; (define-operator-snippet :in) -;; (define-operator-snippet :in-reverse) -;; (define-operator-snippet :out) -;; (define-operator-snippet :out-reverse) -;; (define-operator-snippet :over) -;; (define-operator-snippet :over-reverse) -;; (define-operator-snippet :saturate) -;; (define-operator-snippet :xor) + (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))) + +(define-operator-snippet operator-add :add) +(define-operator-snippet operator-atop :atop) +(define-operator-snippet operator-atop-reverse :dest-atop) +(define-operator-snippet operator-in :in) +(define-operator-snippet operator-in-reverse :dest-in) +(define-operator-snippet operator-out :out) +(define-operator-snippet operator-out-reverse :dest-out) +(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) +) @@ -354,59 +392,6 @@ (cairo:stroke cr)) -;; (let ((path)) -;; (define-snippet pattern-fill (cr) -;; (let ((spikes 10) -;; (text "KAPOW!")) -;; (unless path -;; (let ((x-fuzz 0.08) -;; (y-fuzz 0.08) -;; (x-inner-radius 0.3) -;; (y-inner-radius 0.2) -;; (x-outer-radius 0.45) -;; (y-outer-radius 0.35)) -;; (setq path (make-array (* 2 spikes))) -;; (loop -;; for i from 0 below (* 2 spikes) -;; do (multiple-value-bind (x-radius y-radius) -;; (if (evenp i) -;; (values x-inner-radius y-inner-radius) -;; (values x-outer-radius y-outer-radius)) -;; (setf -;; (svref path i) -;; (cons -;; (+ 0.5 (* (cos (* pi (/ i spikes))) x-radius) -;; (* (random 1.0) x-fuzz)) -;; (+ 0.5 (* (sin (* pi (/ i spikes))) y-radius) -;; (* (random 1.0) y-fuzz)))))))) - -;; (setf (cairo:line-width cr) 0.01) -;; (cairo:move-to cr (car (svref path 0)) (cdr (svref path 0))) -;; (loop -;; for i from 1 below (* 2 spikes) -;; do (cairo:line-to cr (car (svref path i)) (cdr (svref path i)))) -;; (cairo:close-path cr) -;; (cairo:stroke cr) -;; (cairo:move-to cr -;; (car (svref path (1- spikes))) (cdr (svref path (1- spikes)))) - -;; (cairo:select-font-face cr "Sans" :normal :bold) -;; (time (cairo:text-path cr text)) -;; (cairo:set-source-color cr 1.0 1.0 0.5) -;; (cairo:fill cr) - -;; (cairo:set-font-size cr 0.2) -;; (let* ((extents (cairo:text-extents cr text)) -;; (x (- 0.5 (+ (* 0.5 (cairo:text-extents-width extents)) (cairo:text-extents-x-bearing extents)))) -;; (y (- 0.5 (+ (* 0.5 (cairo:text-extents-height extents)) (cairo:text-extents-y-bearing extents))))) - -;; (cairo:move-to cr x y) -;; (cairo:text-path cr text) -;; (cairo:set-source-color cr 0 0 0) -;; (cairo:stroke cr))))) - - - (define-snippet set-line-cap (cr) (setf (cairo:line-width cr) 0.12) (setf (cairo:line-cap cr) :butt) @@ -423,7 +408,7 @@ (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) @@ -466,17 +451,17 @@ (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)) @@ -538,7 +523,7 @@ :vscrollbar-policy :automatic :border-width 10)) (close-button (make-instance 'button - :label "close" :can-default t + :stock "gtk-close" :can-default t :signal (list 'clicked #'widget-destroy :object main-window)))) @@ -551,12 +536,19 @@ (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)" - (lisp-implementation-type) - (lisp-implementation-version)) + :label #-cmu + (format nil "~A ~A" + (lisp-implementation-type) + #-clisp + (lisp-implementation-version) + #+clisp + (let ((version (lisp-implementation-version))) + (subseq version 0 (position #\sp version)))) ;; The version string in CMUCL is far too long #+cmu(lisp-implementation-type)) :fill nil) @@ -571,7 +563,7 @@ :focus-vadjustment (scrolled-window-vadjustment scrolled-window) :children (mapcar #'(lambda (snippet) (create-button (string-downcase snippet) snippet)) - (sort *snippets* #'string<))))) + (setq *snippets* (sort *snippets* #'string<)))))) (scrolled-window-add-with-viewport scrolled-window content-box)) (widget-grab-focus close-button) @@ -580,4 +572,12 @@ (clg-init) -;;(rsvg:init) +(rsvg:init) + +;; We need to turn off floating point exceptions, because Cairo is +;; presumably using internal code which generates NaNs in some cases. +;; Thanks to Christophe Rhodes for pointing this out. +#+sbcl(sb-int:set-floating-point-modes :traps nil) +#+cmu(ext:set-floating-point-modes :traps nil) + +(within-main-loop (create-tests))