From 65295b6cee739f361b21bfb832c37d4fe3cc7802 Mon Sep 17 00:00:00 2001
From: Zach Beane <xach@xach.com>
Date: Sun, 29 Jun 2008 20:39:39 -0400
Subject: [PATCH] - Use a fill source function unconditionally

---
 drawing.lisp | 78 ++++++++++++++++++++++++++++--------------------------------
 1 file changed, 37 insertions(+), 41 deletions(-)

diff --git a/drawing.lisp b/drawing.lisp
index d989de4..8bcc9e0 100644
--- a/drawing.lisp
+++ b/drawing.lisp
@@ -56,20 +56,12 @@
 (defun prelerp (p q a)
   (logand #xFF (- (+ p q) (imult a p))))
 
-(defun draw-function (data width height r.fg g.fg b.fg a.fg fill-source alpha-fun)
+(defun draw-function (data width height fill-source alpha-fun)
   "From http://www.teamten.com/lawrence/graphics/premultiplication/"
   (declare (ignore height))
-  (let* ((r.fg (float-octet r.fg))
-         (g.fg (float-octet g.fg))
-         (b.fg (float-octet b.fg))
-         (a.fg (float-octet a.fg))
-         (fill-fun (or fill-source
-                       (lambda (x y)
-                         (declare (ignore x y))
-                         (values r.fg g.fg b.fg a.fg)))))
-    (lambda (x y alpha)
-      (setf (values r.fg g.fg b.fg a.fg)
-            (funcall fill-fun x y))
+  (lambda (x y alpha)
+    (multiple-value-bind (r.fg g.fg b.fg a.fg)
+        (funcall fill-source x y)
       (setf alpha (funcall alpha-fun alpha))
       (when (plusp alpha)
         (let* ((i (* +png-channels+ (+ x (* y width))))
@@ -90,25 +82,17 @@
 
 (defun draw-function/clipped (data clip-data
                               width height
-                              r.fg g.fg b.fg a.fg fill-source
+                              fill-source
                               alpha-fun)
   "Like DRAW-FUNCTION, but uses uses the clipping channel."
   (declare (ignore height))
-  (let* ((r.fg (float-octet r.fg))
-         (g.fg (float-octet g.fg))
-         (b.fg (float-octet b.fg))
-         (a.fg (float-octet a.fg))
-         (fill-fun (or fill-source
-                       (lambda (x y)
-                         (declare (ignore x y))
-                         (values r.fg g.fg b.fg a.fg)))))
-    (lambda (x y alpha)
-      (let* ((clip-index (+ x (* y width)))
-             (clip (aref clip-data clip-index)))
-        (setf alpha (imult clip (funcall alpha-fun alpha)))
-        (when (plusp alpha)
-          (setf (values r.fg g.fg b.fg a.fg)
-                (funcall fill-fun x y))
+  (lambda (x y alpha)
+    (let* ((clip-index (+ x (* y width)))
+           (clip (aref clip-data clip-index)))
+      (setf alpha (imult clip (funcall alpha-fun alpha)))
+      (when (plusp alpha)
+        (multiple-value-bind (r.fg g.fg b.fg a.fg)
+            (funcall fill-source x y)
           (let* ((i (* clip-index +png-channels+))
                  (r.bg (aref data (+ i 0)))
                  (g.bg (aref data (+ i 1)))
@@ -127,13 +111,13 @@
 
 (defun make-draw-function (data clipping-path
                            width height
-                           r g b a fill-source
+                           fill-source
                            alpha-fun)
   (if (emptyp clipping-path)
-      (draw-function data width height r g b a fill-source alpha-fun)
+      (draw-function data width height fill-source alpha-fun)
       (draw-function/clipped data (clipping-data clipping-path)
                              width height
-                             r g b a fill-source
+                             fill-source
                              alpha-fun)))
 
 (defun intersect-clipping-paths (data temp)
@@ -194,34 +178,46 @@ for the set of paths PATHS."
             (aref image-data j) b
             (aref image-data k) a))))
 
-(defun state-draw-function (state color fill-source fill-style)
+(defun color-source-function (color)
+  (let ((red (float-octet (red color)))
+        (green (float-octet (green color)))
+        (blue (float-octet (blue color)))
+        (alpha (float-octet (alpha color))))
+    (lambda (x y)
+      (declare (ignore x y))
+      (values red green blue alpha))))
+
+(defun fill-source-function (state)
+  (or (fill-source state)
+      (color-source-function (fill-color state))))
+
+(defun stroke-source-function (state)
+  (color-source-function (stroke-color state)))
+
+(defun state-draw-function (state fill-source fill-style)
   "Create a draw function for the graphics state STATE."
   (make-draw-function (image-data state)
                       (clipping-path state)
                       (width state)
                       (height state)
-                      (red color)
-                      (green color)
-                      (blue color)
-                      (alpha color)
                       fill-source
                       (ecase fill-style
                         (:even-odd #'even-odd-alpha)
                         (:nonzero-winding #'nonzero-winding-alpha))))
 
 (defun stroke-draw-function (state)
-  (state-draw-function state (stroke-color state) nil :nonzero-winding))
+  (state-draw-function state
+                       (stroke-source-function state)
+                       :nonzero-winding))
 
 (defun fill-draw-function (state)
   (state-draw-function state
-                       (fill-color state)
-                       (fill-source state)
+                       (fill-source-function state)
                        :nonzero-winding))
 
 (defun even-odd-fill-draw-function (state)
   (state-draw-function state
-                       (fill-color state)
-                       (fill-source state)
+                       (fill-source-function state)
                        :even-odd))
 
 (defun tolerance-scale (state)
-- 
2.11.4.GIT