#+(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.")))
-#?(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)
(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* ())
(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: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: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)))
(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)
- (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)
(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))
(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)
(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))
(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)
(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
#+sbcl(sb-int:set-floating-point-modes :traps nil)
#+cmu(ext:set-floating-point-modes :traps nil)
-(create-tests)
+(within-main-loop (create-tests))
~mdw / clg / blobdiff