[cl-gd-devel] cl-gd patch

[Jeff Cunningham]

Edi Weitz wrote:
> Hi,
>
> That nobody seems to have looked at it is probably a bit exaggerated
> as at least Hans and I looked at it, and Hans also asked for a
> revision (and I agree with this request) to which you haven't replied
> yet.
>
> FWIW, here are the patch guidelines again:
>
>   http://weitz.de/patches.html
>
> Thanks,
> Edi.
>
>
>   
It wasn't exaggerated from my perspective - the most recent activity on 
the list was May and I never saw Hans' post! I don't understand why, but 
that email from the list never showed up in my inbox (I even went back 
and checked through my spam). I checked the on-line November 
web-archives several times during the week and didn't see any activity 
there beyond mine and assumed this was a low priority. But now I see 
that Hans posted his reply the day after I posted to the list, but that 
posting didn't make it into the archives until just the last day or so 
(I checked most recently I think day before yesterday and it wasn't 
there). And yet, it says it was posted Nov 9th. Have there been other 
problems with the list server reported?

In any event, now that I've seen Hans' request, I slapped my forehead 
for not seeing the debug statements, removed them, and here's the remade 
patch.

Regards,
Jeff Cunningham


--- cl-gd-0.5.6/transform.lisp    2007-07-29 09:37:13.000000000 -0700
+++ source/cl-gd-0.5.6/transform.lisp    2009-11-15 08:24:03.000000000 -0800
@@ -72,7 +72,10 @@
   "Like ROUND but make sure result isn't longer than 32 bits."
   (mod (round x) +most-positive-unsigned-byte-32+))
 
-(defmacro with-transformation ((&key x1 x2 width y1 y2 height reverse-x 
reverse-y (radians t) (image '*default-image*)) &body body)
+(defmacro with-transformation ((&key (x1 0 x1set) (x2 0 x2set) (width 0 
wset)
+                                     (y1 0 y1set) (y2 0 y2set) (height 
0 hset)
+                                     reverse-x reverse-y (radians t) 
(image '*default-image*))
+                               &body body)
   "Executes BODY such that all points and width/height data are
 subject to a simple affine transformation defined by the keyword
 parameters. The new x-axis of IMAGE will start at X1 and end at X2 and
@@ -93,23 +96,18 @@
                         angle-transformer)
       ;; rebind for thread safety
       `(let ((*transformers* *transformers*))
-        (unless (<= 2 (count-if #'identity (list ,x1 ,x2 ,width)))
-          (error "You must provide at least two of X1, X2, and WIDTH."))
-        (unless (<= 2 (count-if #'identity (list ,y1 ,y2 ,height)))
-          (error "You must provide at least two of Y1, Y2, and HEIGHT."))
-        (when (and ,x1 ,x2 ,width
-                   (/= ,width (- ,x2 ,x1)))
-          (error "X1, X2, and WIDTH don't match. Try to provide just 
two of the three arguments."))
-        (when (and ,y1 ,y2 ,height
-                   (/= ,height (- ,y2 ,y1)))
-          (error "Y1, Y2, and HEIGHT don't match. Try to provide just 
two of the three arguments."))
-        ;; kludgy code to keep SBCL quiet
-        (unless ,x1 (setq ,x1 (- ,x2 ,width)))
-        (unless ,x2 (setq ,x2 (+ ,x1 ,width)))
-        (unless ,width (setq ,width (- ,x2 ,x1)))
-        (unless ,y1 (setq ,y1 (- ,y2 ,height)))
-        (unless ,y2 (setq ,y2 (+ ,y1 ,height)))
-        (unless ,height (setq ,height (- ,y2 ,y1)))
+         (macrolet ((checkargs (a1 a1set a2 a2set aspan aspanset c lbl)
+                      `(progn
+                         (cond ((and ,a1set ,a2set) (setq ,aspan (- ,a2 
,a1)))
+                               ((and ,a1set ,aspanset) (setq ,a2 (+ ,a1 
,aspan)))
+                               ((and ,a2set ,aspanset) (setq ,a1 (- ,a2 
,aspan)))
+                               (t (error "Require two of ~c1, ~:*~c2, 
or ~a to be set." ,c ,lbl)))
+                         (unless (> ,aspan 0)
+                           (error "Require ~c1 < ~:*~c2" ,c))
+                         (unless (< (abs (/ (- ,a2 (+ ,a1 ,aspan)) 
,aspan)) 1.e-5)
+                           (error "~c1, ~:*~c2, and ~a don't match. Try 
to provide just two of the three arguments." ,c ,lbl)))))
+           (checkargs ,x1 ,x1set ,x2 ,x2set ,width ,wset #\x "width")
+           (checkargs ,y1 ,y1set ,y2 ,y2set ,height ,hset #\y "height"))
         (multiple-value-bind (,image-width ,image-height)
             (without-transformations
              (image-size ,image))