[graphic-forms-cvs] r77 - in trunk: docs/manual src src/tests/uitoolkit src/uitoolkit/graphics src/uitoolkit/system
junrue at common-lisp.net
junrue at common-lisp.net
Tue Mar 28 01:34:52 UTC 2006
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
+ at 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.
+ at 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
+ at deffn GenericFunction draw-poly-bezier self start-pnt points
+Draws a sequence of connected B@'ezier curves starting with @code{start-pnt}.
+ at code{points} is a list of lists, each sublist containing three points,
+where:
+ at itemize @bullet
+ at item
+ at code{(first points)} is the current segment's end point
+ at item
+ at code{(second points)} and @code{(third points)} are the segment's
+control points.
+ at end itemize
+The aggregate curve is drawn using the current pen style, pen widget,
+and foreground color.
+ at 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)
More information about the Graphic-forms-cvs
mailing list