1. Christian Kellermann
  2. doodle

Commits

Christian Kellermann  committed 9ea4ff1

Don't pass on the argument lists of the new setter functions as they are

((1 1 1 1)) is not a proper color, use the car of the Argument list...

  • Participants
  • Parent commits 833ecf4
  • Branches master

Comments (0)

Files changed (1)

File doodle.scm

View file
  • Ignore whitespace
 (import chicken scheme)
 (use (srfi 1 4 18) cairo data-structures extras sdl-base clojurian-syntax matchable)
 
-(define *font-color* '(list 1 1 1 1))
+(define *font-color* '(1 1 1 1))
 (define (font-color . c)
  (if (null? c)
      *font-color*
-     (set! *font-color* c)))
+     (set! *font-color* (car c))))
 (define *font-size* 12)
 (define (font-size . s)
   (if (null? s)
       *font-size*
-      (set! *font-size* s)))
+      (set! *font-size* (car s))))
 
 (define *line-width* 2.0)
 (define (line-width . w)
   (if (null? w)
       *line-width*
-      (set! *line-width* w)))
+      (set! *line-width* (car w))))
 
 (define *current-background* '(0 0 0 1))
 (define (current-background . c)
   (if (null? c)
       *current-background*
-      (set! *current-background* c)))
+      (set! *current-background* (car c))))
 
 (define solid-black (list 0 0 0 1))
 (define solid-white (list 1 1 1 1))
                             ((#:right) (- x w))
                             (else x)))
                       (fy y))
-                  (apply cairo-set-source-rgba `(,*c* ,@*font-color*))
+                  (apply cairo-set-source-rgba (cons *c* *font-color*))
                   (doto *c*
                         (cairo-move-to fx fy)
                         (cairo-set-font-size *font-size*)
       (height (cairo-image-surface-get-height *c-surface*)))
   (if (list? color)
       (begin
-        (apply cairo-set-source-rgba `(,*c* ,@color))
+        (apply cairo-set-source-rgba (cons *c* color))
         (doto *c*
               (cairo-rectangle 0 0 width height)
               (cairo-fill)