Update of /project/imago/cvsroot/imago/src In directory common-lisp.net:/tmp/cvs-serv7121

Modified Files: drawing.lisp package.lisp Log Message: Added a DRAW-POLYGON function Date: Mon Jan 3 22:25:30 2005 Author: mvilleneuve

Index: imago/src/drawing.lisp diff -u imago/src/drawing.lisp:1.2 imago/src/drawing.lisp:1.3 --- imago/src/drawing.lisp:1.2 Mon Jan 3 21:56:02 2005 +++ imago/src/drawing.lisp Mon Jan 3 22:25:29 2005 @@ -20,6 +20,7 @@

(defun draw-line (image x1 y1 x2 y2 color &key (dash-length 1) (dash-interval 0)) + "Draws a line between two points in an image." (let ((drawing t) (counter 0)) (do-line-pixels (image pixel x y x1 y1 x2 y2) @@ -34,24 +35,31 @@ (setf drawing t counter 0))))))

-(defun draw-rectangle (image x1 y1 width height color) +(defun draw-rectangle (image x1 y1 width height color + &key (dash-length 1) (dash-interval 0)) "Draws a rectangle in an image." - (let* ((image-width (image-width image)) - (pixels (image-pixels image)) - (index (+ (* y1 image-width) x1))) - (loop for index2 = index then (1+ index2) - repeat width - do (setf (row-major-aref pixels index2) color)) - (loop for index2 = (+ index (* (1- height) image-width)) then (1+ index2) - repeat width - do (setf (row-major-aref pixels index2) color)) - (loop for index2 = (+ index image-width) then (+ index2 image-width) - repeat (- height 2) - do (setf (row-major-aref pixels index2) color)) - (loop for index2 = (+ index image-width width -1) - then (+ index2 image-width) - repeat (- height 2) - do (setf (row-major-aref pixels index2) color)))) + (let ((x2 (+ x1 width -1)) + (y2 (+ y1 height -1))) + (draw-line image x1 y1 x2 y1 color + :dash-length dash-length :dash-interval dash-interval) + (draw-line image x1 y2 x2 y2 color + :dash-length dash-length :dash-interval dash-interval) + (draw-line image x1 y1 x1 y2 color + :dash-length dash-length :dash-interval dash-interval) + (draw-line image x2 y1 x2 y2 color + :dash-length dash-length :dash-interval dash-interval))) + +(defun draw-polygon (image coord-list color + &key (closed t) (dash-length 1) (dash-interval 0)) + "Draws a polygon in an image." + (loop for (x1 y1 x2 y2) on coord-list by #'cddr + do (when (and closed (null x2) (null y2)) + (setf x2 (first coord-list) + y2 (second coord-list))) + (unless (or (null x2) (null y2)) + (draw-line image x1 y1 x2 y2 color + :dash-length dash-length + :dash-interval dash-interval))))

(defun draw-circle (image center-x center-y radius color) "Draws a circle in an image."

Index: imago/src/package.lisp diff -u imago/src/package.lisp:1.3 imago/src/package.lisp:1.4 --- imago/src/package.lisp:1.3 Mon Jan 3 21:56:02 2005 +++ imago/src/package.lisp Mon Jan 3 22:25:29 2005 @@ -41,7 +41,9 @@ #:copy #:flip #:scale #:resize

- #:draw-pixel #:draw-line #:draw-rectangle #:draw-circle + #:draw-pixel #:draw-line + #:draw-rectangle #:draw-polygon + #:draw-circle

#:convolve #:blur #:sharpen #:edge-detect #:emboss