[imago-cvs] CVS update: imago/src/drawing.lisp imago/src/package.lisp
Matthieu Villeneuve
mvilleneuve at common-lisp.net
Wed Jan 5 21:11:11 UTC 2005
Update of /project/imago/cvsroot/imago/src
In directory common-lisp.net:/tmp/cvs-serv23348
Modified Files:
drawing.lisp package.lisp
Log Message:
Added Bezier curve drawing
Date: Wed Jan 5 22:11:10 2005
Author: mvilleneuve
Index: imago/src/drawing.lisp
diff -u imago/src/drawing.lisp:1.3 imago/src/drawing.lisp:1.4
--- imago/src/drawing.lisp:1.3 Mon Jan 3 22:25:29 2005
+++ imago/src/drawing.lisp Wed Jan 5 22:11:10 2005
@@ -90,3 +90,23 @@
(decf y)))
(incf x)
(circle-points x y color)))))
+
+(defun draw-bezier-curve (image x1 y1 x2 y2 x3 y3 x4 y4 color)
+ "Draws a cublic Bezier curve defined by a starting point, two control
+points, and an end point, in an image."
+ (flet ((point-on-bezier-curve (mu)
+ (let* ((mum1 (- 1 mu))
+ (c1 (* mum1 mum1 mum1))
+ (c2 (* 3.0 mu mum1 mum1))
+ (c3 (* 3.0 mu mu mum1))
+ (c4 (* mu mu mu)))
+ (values (round (+ (* c1 x1) (* c2 x2) (* c3 x3) (* c4 x4)))
+ (round (+ (* c1 y1) (* c2 y2) (* c3 y3) (* c4 y4)))))))
+ (multiple-value-bind (x0 y0)
+ (point-on-bezier-curve 0.0)
+ (loop for tt in '(0.1 0.2 0.3 0.4 0.5 0.6 0.7 0.8 0.9 1.0)
+ do (multiple-value-bind (x y)
+ (point-on-bezier-curve tt)
+ (draw-line image x0 y0 x y color)
+ (setf x0 x)
+ (setf y0 y))))))
Index: imago/src/package.lisp
diff -u imago/src/package.lisp:1.4 imago/src/package.lisp:1.5
--- imago/src/package.lisp:1.4 Mon Jan 3 22:25:29 2005
+++ imago/src/package.lisp Wed Jan 5 22:11:10 2005
@@ -44,6 +44,7 @@
#:draw-pixel #:draw-line
#:draw-rectangle #:draw-polygon
#:draw-circle
+ #:draw-bezier-curve
#:convolve
#:blur #:sharpen #:edge-detect #:emboss
More information about the Imago-cvs
mailing list