gtk/fix-demo: Use ->color now that Cairo does not accept names.
authorMatt Birkholz <matt@birchwood-abbey.net>
Mon, 12 Mar 2018 16:27:57 +0000 (09:27 -0700)
committerMatt Birkholz <matt@birchwood-abbey.net>
Mon, 12 Mar 2018 16:27:57 +0000 (09:27 -0700)
src/gtk/fix-demo.scm

index e496d598b56cb7cbb31859c4dfdd2b0184f284e1..48b420177b29389f2d490647fe9d9d6e10f5ccad 100644 (file)
@@ -200,10 +200,10 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 
 (define (draw-on-surface ink)
   (let* ((surface (surface-ink-surface ink))
-        (cr (cairo-create surface)))
-    (cairo-set-source-color cr (let ((color (->color "white" 'draw-on-surface)))
-                                ;(set-color-alpha! color 0.)
-                                color))
+        (cr (cairo-create surface))
+        (white (->color "white" 'draw-on-surface))
+        (blue (->color "blue" 'draw-on-surface)))
+    (cairo-set-source-color cr white)
     (cairo-paint cr)
     (let ((extent (fix-ink-extent ink)))
       (cairo-scale cr
@@ -213,10 +213,9 @@ Inc., 51 Franklin St, Fifth Floor, Boston, MA 02110-1301, USA.
 
     (let ((pattern #;(cairo-pattern-create-linear 0. 0. 1. 1.)
                   (cairo-pattern-create-radial .25 .25 0. .25 .25 1.)))
-      (cairo-pattern-add-color-stop pattern 0. "white")
-      (cairo-pattern-add-color-stop pattern 1. "blue")
-      (let ((2pi (flo:* 8. (flo:atan2 1. 1.))))
-       (cairo-arc cr 0. 0. 1. 0. 2pi))
+      (cairo-pattern-add-color-stop pattern 0. white)
+      (cairo-pattern-add-color-stop pattern 1. blue)
+      (cairo-arc cr 0. 0. 1. 0. (flo:* 8. (flo:atan2 1. 1.)))
       (cairo-set-source cr pattern)
       (cairo-fill cr)
       (cairo-pattern-destroy pattern)