Author: junrue Date: Mon Mar 27 20:34:51 2006 New Revision: 77

Modified: trunk/docs/manual/api.texinfo trunk/src/packages.lisp trunk/src/tests/uitoolkit/drawing-tester.lisp trunk/src/uitoolkit/graphics/graphics-context.lisp trunk/src/uitoolkit/graphics/graphics-generics.lisp trunk/src/uitoolkit/system/gdi32.lisp Log: implement bezier curve drawing functions

Modified: trunk/docs/manual/api.texinfo ============================================================================== --- trunk/docs/manual/api.texinfo (original) +++ trunk/docs/manual/api.texinfo Mon Mar 27 20:34:51 2006 @@ -810,6 +810,13 @@ @ref{draw-chord}. @end deffn

+@deffn GenericFunction draw-bezier self start-pnt end-pnt ctrl-pnt-1 ctrl-pnt-2 +Draws a B@'ezier curve between @code{start-pnt} and @code{end-pnt} +using @code{ctrl-pnt-1} and @code{ctrl-pnt-2} as the control +points. The curve is drawn using the current pen style, pen widget, +and foreground color. +@end deffn + @anchor{draw-chord} @deffn GenericFunction draw-chord self rect start-pnt end-pnt Draws a closed shape comprised of: @@ -885,6 +892,21 @@ current pen style, pen width, and foreground color. @end deffn

+@deffn GenericFunction draw-poly-bezier self start-pnt points +Draws a sequence of connected B@'ezier curves starting with @code{start-pnt}. +@code{points} is a list of lists, each sublist containing three points, +where: +@itemize @bullet +@item +@code{(first points)} is the current segment's end point +@item +@code{(second points)} and @code{(third points)} are the segment's +control points. +@end itemize +The aggregate curve is drawn using the current pen style, pen widget, +and foreground color. +@end deffn + @anchor{draw-polygon} @deffn GenericFunction draw-polygon self points Draws a series of connected line segments determined by the list of

Modified: trunk/src/packages.lisp ============================================================================== --- trunk/src/packages.lisp (original) +++ trunk/src/packages.lisp Mon Mar 27 20:34:51 2006 @@ -132,6 +132,7 @@ #:depth #:descent #:draw-arc + #:draw-bezier #:draw-chord #:draw-ellipse #:draw-filled-arc @@ -144,6 +145,7 @@ #:draw-image #:draw-line #:draw-point + #:draw-poly-bezier #:draw-polygon #:draw-polyline #:draw-rectangle

Modified: trunk/src/tests/uitoolkit/drawing-tester.lisp ============================================================================== --- trunk/src/tests/uitoolkit/drawing-tester.lisp (original) +++ trunk/src/tests/uitoolkit/drawing-tester.lisp Mon Mar 27 20:34:51 2006 @@ -76,6 +76,44 @@ (unless (null func) (funcall func gc))))

+(defun draw-bezier-test (gc start-pnt end-pnt ctrl-pnt-1 ctrl-pnt-2 pen-styles) + (setf (gfg:foreground-color gc) gfg:*color-blue*) + (setf (gfg:pen-width gc) 5) + (setf (gfg:pen-style gc) (first pen-styles)) + (gfg:draw-bezier gc start-pnt end-pnt ctrl-pnt-1 ctrl-pnt-2) + (setf (gfg:pen-width gc) 3) + (setf (gfg:pen-style gc) (second pen-styles)) + (gfg:draw-bezier gc + (gfs:make-point :x (+ (gfs:point-x start-pnt) 90) + :y (gfs:point-y start-pnt)) + (gfs:make-point :x (+ (gfs:point-x end-pnt) 90) + :y (gfs:point-y end-pnt)) + (gfs:make-point :x (+ (gfs:point-x ctrl-pnt-1) 90) + :y (gfs:point-y ctrl-pnt-1)) + (gfs:make-point :x (+ (gfs:point-x ctrl-pnt-2) 90) + :y (gfs:point-y ctrl-pnt-2))) + (setf (gfg:pen-width gc) 1) + (setf (gfg:pen-style gc) (third pen-styles)) + (gfg:draw-bezier gc + (gfs:make-point :x (+ (gfs:point-x start-pnt) 180) + :y (gfs:point-y start-pnt)) + (gfs:make-point :x (+ (gfs:point-x end-pnt) 180) + :y (gfs:point-y end-pnt)) + (gfs:make-point :x (+ (gfs:point-x ctrl-pnt-1) 180) + :y (gfs:point-y ctrl-pnt-1)) + (gfs:make-point :x (+ (gfs:point-x ctrl-pnt-2) 180) + :y (gfs:point-y ctrl-pnt-2))) + (setf (gfg:foreground-color gc) (gfg:background-color gc)) + (gfg:draw-bezier gc + (gfs:make-point :x (+ (gfs:point-x start-pnt) 270) + :y (gfs:point-y start-pnt)) + (gfs:make-point :x (+ (gfs:point-x end-pnt) 270) + :y (gfs:point-y end-pnt)) + (gfs:make-point :x (+ (gfs:point-x ctrl-pnt-1) 270) + :y (gfs:point-y ctrl-pnt-1)) + (gfs:make-point :x (+ (gfs:point-x ctrl-pnt-2) 270) + :y (gfs:point-y ctrl-pnt-2)))) + (defun draw-line-test (gc start-pnt end-pnt pen-styles) (setf (gfg:foreground-color gc) gfg:*color-blue*) (setf (gfg:pen-width gc) 5) @@ -254,6 +292,31 @@ (setf (draw-func-of *drawing-dispatcher*) #'draw-arcs) (gfw:redraw *drawing-win*))

+(defun draw-beziers (gc) + (let ((start-pnt (gfs:make-point :x 10 :y 32)) + (end-pnt (gfs:make-point :x 70 :y 32)) + (ctrl-pnt-1 (gfs:make-point :x 40 :y 0)) + (ctrl-pnt-2 (gfs:make-point :x 40 :y 65))) + (setf (gfg:background-color gc) gfg:*color-green*) + (setf (gfg:foreground-color gc) gfg:*color-blue*) + (draw-bezier-test gc start-pnt end-pnt ctrl-pnt-1 ctrl-pnt-2 '((:dashdotdot :bevel-join) (:solid) (:solid))) + (let ((poly-pnts (list (list (gfs:make-point :x 40 :y 100) + (gfs:make-point :x 35 :y 200) + (gfs:make-point :x 300 :y 180)) + (list (gfs:make-point :x 260 :y 190) + (gfs:make-point :x 140 :y 150) + (gfs:make-point :x 80 :y 200))))) + (setf (gfg:foreground-color gc) gfg:*color-blue*) + (setf (gfg:pen-width gc) 3) + (setf (gfg:pen-style gc) '(:dot :square-endcap)) + (gfg:draw-poly-bezier gc (gfs:make-point :x 10 :y 100) poly-pnts)))) + +(defun select-beziers (disp item time rect) + (declare (ignore disp time rect)) + (update-drawing-item-check item) + (setf (draw-func-of *drawing-dispatcher*) #'draw-beziers) + (gfw:redraw *drawing-win*)) + (defun draw-lines (gc) (let ((orig-points (list (gfs:make-point :x 15 :y 60) (gfs:make-point :x 75 :y 30) @@ -300,6 +363,7 @@ (:item "&Tests" :callback #'find-checked-item :submenu ((:item "&Arcs and Chords" :checked :callback #'select-arcs) + (:item "&B�zier Curves" :callback #'select-beziers) (:item "&Ellipses" :callback #'select-ellipses) (:item "&Lines and Polylines" :callback #'select-lines) (:item "&Rectangles" :callback #'select-rects)))))))

Modified: trunk/src/uitoolkit/graphics/graphics-context.lisp ============================================================================== --- trunk/src/uitoolkit/graphics/graphics-context.lisp (original) +++ trunk/src/uitoolkit/graphics/graphics-context.lisp Mon Mar 27 20:34:51 2006 @@ -186,6 +186,14 @@ (error 'gfs:disposed-error)) (call-rect-and-range-function #'gfs::arc "arc" (gfs:handle self) rect start-pnt end-pnt))

+(defmethod draw-bezier ((self graphics-context) start-pnt end-pnt ctrl-pnt-1 ctrl-pnt-2) + (if (gfs:disposed-p self) + (error 'gfs:disposed-error)) + (call-points-function #'gfs::poly-bezier + "poly-bezier" + (gfs:handle self) + (list start-pnt ctrl-pnt-1 ctrl-pnt-2 end-pnt))) + (defmethod draw-chord ((self graphics-context) rect start-pnt end-pnt) (if (gfs:disposed-p self) (error 'gfs:disposed-error)) @@ -224,6 +232,15 @@ (error 'gfs:disposed-error)) (call-points-function #'gfs::polyline "polyline" (gfs:handle self) (list start-pnt end-pnt)))

+(defmethod draw-poly-bezier ((self graphics-context) start-pnt points) + (if (gfs:disposed-p self) + (error 'gfs:disposed-error)) + (unless (null points) + (let ((tmp (loop for triplet in points + append (list (second triplet) (third triplet) (first triplet))))) + (push start-pnt tmp) + (call-points-function #'gfs::poly-bezier "poly-bezier" (gfs:handle self) tmp)))) + (defmethod draw-polygon ((self graphics-context) points) (if (gfs:disposed-p self) (error 'gfs:disposed-error))

Modified: trunk/src/uitoolkit/graphics/graphics-generics.lisp ============================================================================== --- trunk/src/uitoolkit/graphics/graphics-generics.lisp (original) +++ trunk/src/uitoolkit/graphics/graphics-generics.lisp Mon Mar 27 20:34:51 2006 @@ -63,6 +63,9 @@ (defgeneric draw-arc (self rect start-pnt end-pnt) (:documentation "Draws the outline of an elliptical arc within the specified rectangular area."))

+(defgeneric draw-bezier (self start-pnt end-pnt ctrl-pnt-1 ctrl-pnt-2) + (:documentation "Draws a Bezier curve between start-pnt and end-pnt.")) + (defgeneric draw-chord (self rect start-pnt end-pnt) (:documentation "Draws a region bounded by the intersection of an ellipse and a line segment."))

@@ -96,6 +99,9 @@ (defgeneric draw-point (self pnt) (:documentation "Draws a pixel in the foreground color at the specified point."))

+(defgeneric draw-poly-bezier (self start-pnt points) + (:documentation "Draws a series of connected Bezier curves.")) + (defgeneric draw-polygon (self points) (:documentation "Draws the closed polygon defined by the list of points."))

Modified: trunk/src/uitoolkit/system/gdi32.lisp ============================================================================== --- trunk/src/uitoolkit/system/gdi32.lisp (original) +++ trunk/src/uitoolkit/system/gdi32.lisp Mon Mar 27 20:34:51 2006 @@ -254,6 +254,13 @@ (rop DWORD))

(defcfun + ("PolyBezier" poly-bezier) + BOOL + (hdc HANDLE) + (points LPTR) + (count DWORD)) + +(defcfun ("Polygon" polygon) BOOL (hdc HANDLE)