[graphic-forms-cvs] r78 - 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 05:30:06 UTC 2006
Author: junrue
Date: Tue Mar 28 00:30:06 2006
New Revision: 78
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:
implemented pie wedge drawing functions
Modified: trunk/docs/manual/api.texinfo
==============================================================================
--- trunk/docs/manual/api.texinfo (original)
+++ trunk/docs/manual/api.texinfo Tue Mar 28 00:30:06 2006
@@ -798,41 +798,41 @@
@end deffn
@anchor{draw-arc}
- at deffn GenericFunction draw-arc self rect start-pnt end-pnt
+ at deffn GenericFunction draw-arc self rect start-point end-point
Draws an arc whose curve is formed by the ellipse bound by
@code{rect}, in a counter-clockwise direction from the point
@code{start-point} where it intersects a radial originating at the
center of the bounding rectangle. The arc ends at the point
- at code{end-pnt} where it intersects another radial also originating at
+ at code{end-point} where it intersects another radial also originating at
the center of the rectangle. The shape is drawn using the current pen
-style, pen width, and foreground color. If @code{start-pnt} and
- at code{end-pnt} are the same, a complete ellipse is drawn. See also
+style, pen width, and foreground color. If @code{start-point} and
+ at code{end-point} are the same, a complete ellipse is drawn. See also
@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,
+ at deffn GenericFunction draw-bezier self start-point end-point ctrl-point-1 ctrl-point-2
+Draws a B@'ezier curve between @code{start-point} and @code{end-point}
+using @code{ctrl-point-1} and @code{ctrl-point-2} as the control
+points. The curve is drawn using the current pen style, pen width,
and foreground color.
@end deffn
@anchor{draw-chord}
- at deffn GenericFunction draw-chord self rect start-pnt end-pnt
+ at deffn GenericFunction draw-chord self rect start-point end-point
Draws a closed shape comprised of:
@itemize @bullet
@item
an arc whose curve is formed by the ellipse bound by @code{rect}, in a
counter-clockwise direction from the point @code{start-point} where it
intersects a radial originating at the center of the bounding
-rectangle. The arc ends at the point @code{end-pnt} where it
+rectangle. The arc ends at the point @code{end-point} where it
intersects another radial also originating at the center of the
rectangle.
@item
-a line drawn between start-pnt and end-pnt
+a line drawn between start-point and end-point
@end itemize
The shape is drawn using the current pen style, pen width and
-foreground color. If @code{start-pnt} and @code{end-pnt} are the
+foreground color. If @code{start-point} and @code{end-point} are the
same, a complete ellipse is drawn. See also @ref{draw-arc}.
@end deffn
@@ -843,22 +843,22 @@
@end deffn
@anchor{draw-filled-chord}
- at deffn GenericFunction draw-filled-chord self rect start-pnt end-pnt
+ at deffn GenericFunction draw-filled-chord self rect start-point end-point
Draws a closed shape comprised of:
@itemize @bullet
@item
an arc whose curve is formed by the ellipse bound by @code{rect}, in a
counter-clockwise direction from the point @code{start-point} where it
intersects a radial originating at the center of the bounding
-rectangle. The arc ends at the point @code{end-pnt} where it
+rectangle. The arc ends at the point @code{end-point} where it
intersects another radial also originating at the center of the
rectangle.
@item
-a line drawn between start-pnt and end-pnt
+a line drawn between start-point and end-point
@end itemize
The shape is drawn using the current pen style, pen width and
foreground color and filled with the current background color. If
- at code{start-pnt} and @code{end-pnt} are the same, a complete ellipse
+ at code{start-point} and @code{end-point} are the same, a complete ellipse
is drawn.
@end deffn
@@ -869,6 +869,14 @@
color.
@end deffn
+ at deffn GenericFunction draw-filled-pie-wedge self rect start-point end-point
+Fills a pie-shaped wedge whose arc is defined by the ellipse bound by
+ at code{rect} and its intersection with the radials defined by
+ at code{start-point} and @code{end-point}. The shape is drawn using the
+current pen style, pen width, and foreground color, and filled with
+the current background color.
+ at end deffn
+
@deffn GenericFunction draw-filled-polygon self points
Fills the interior of a closed shape comprised by the line segments
defined by @code{points} in the current background color. The current
@@ -892,8 +900,15 @@
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 deffn GenericFunction draw-pie-wedge self rect start-point end-point
+Draws a pie-shaped wedge whose arc is defined by the ellipse bound
+by @code{rect} and its intersection with the radials defined by
+ at code{start-point} and @code{end-point}. The shape is drawn using the
+current pen style, pen width, and foreground color.
+ at end deffn
+
+ at deffn GenericFunction draw-poly-bezier self start-point points
+Draws a sequence of connected B@'ezier curves starting with @code{start-point}.
@code{points} is a list of lists, each sublist containing three points,
where:
@itemize @bullet
@@ -903,7 +918,7 @@
@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,
+The combined curve is drawn using the current pen style, pen width,
and foreground color.
@end deffn
Modified: trunk/src/packages.lisp
==============================================================================
--- trunk/src/packages.lisp (original)
+++ trunk/src/packages.lisp Tue Mar 28 00:30:06 2006
@@ -138,12 +138,14 @@
#:draw-filled-arc
#:draw-filled-chord
#:draw-filled-ellipse
+ #:draw-filled-pie-wedge
#:draw-filled-polygon
#:draw-filled-rectangle
#:draw-filled-rounded-rectangle
#:draw-focus
#:draw-image
#:draw-line
+ #:draw-pie-wedge
#:draw-point
#:draw-poly-bezier
#:draw-polygon
Modified: trunk/src/tests/uitoolkit/drawing-tester.lisp
==============================================================================
--- trunk/src/tests/uitoolkit/drawing-tester.lisp (original)
+++ trunk/src/tests/uitoolkit/drawing-tester.lisp Tue Mar 28 00:30:06 2006
@@ -356,6 +356,66 @@
(setf (draw-func-of *drawing-dispatcher*) #'draw-rects)
(gfw:redraw *drawing-win*))
+(defun draw-wedges (gc)
+ (let ((rect-pnt (gfs:make-point :x 15 :y 10))
+ (rect-size (gfs:make-size :width 80 :height 65))
+ (start-pnt (gfs:make-point :x 35 :y 75))
+ (end-pnt (gfs:make-point :x 85 :y 35))
+ (delta-x 0)
+ (delta-y 0))
+
+ (setf (gfg:background-color gc) gfg:*color-green*)
+ (setf (gfg:foreground-color gc) gfg:*color-blue*)
+ (setf (gfg:pen-width gc) 5)
+ (setf (gfg:pen-style gc) '(:dashdotdot :bevel-join))
+ (gfg:draw-filled-pie-wedge gc (make-instance 'gfs:rectangle :location rect-pnt :size rect-size) start-pnt end-pnt)
+ (setf delta-x (+ (gfs:size-width rect-size) 10))
+ (loop for pnt in (list rect-pnt start-pnt end-pnt)
+ do (incf (gfs:point-x pnt) delta-x))
+ (setf (gfg:pen-width gc) 3)
+ (setf (gfg:pen-style gc) '(:solid))
+ (gfg:draw-filled-pie-wedge gc (make-instance 'gfs:rectangle :location rect-pnt :size rect-size) start-pnt end-pnt)
+ (loop for pnt in (list rect-pnt start-pnt end-pnt)
+ do (incf (gfs:point-x pnt) delta-x))
+ (setf (gfg:pen-width gc) 1)
+ (gfg:draw-filled-pie-wedge gc (make-instance 'gfs:rectangle :location rect-pnt :size rect-size) start-pnt end-pnt)
+ (loop for pnt in (list rect-pnt start-pnt end-pnt)
+ do (incf (gfs:point-x pnt) delta-x))
+ (setf (gfg:foreground-color gc) (gfg:background-color gc))
+ (gfg:draw-filled-pie-wedge gc (make-instance 'gfs:rectangle :location rect-pnt :size rect-size) start-pnt end-pnt)
+
+ (setf (gfs:point-x rect-pnt) 15)
+ (setf (gfs:point-x start-pnt) 35)
+ (setf (gfs:point-x end-pnt) 85)
+ (setf delta-y (gfs:size-height rect-size))
+ (loop for pnt in (list rect-pnt start-pnt end-pnt)
+ do (incf (gfs:point-y pnt) delta-y))
+ (setf (gfg:foreground-color gc) gfg:*color-blue*)
+ (setf (gfg:pen-width gc) 5)
+ (setf (gfg:pen-style gc) '(:dot :round-join :flat-endcap))
+ (gfg:draw-pie-wedge gc (make-instance 'gfs:rectangle :location rect-pnt :size rect-size) start-pnt end-pnt)
+ (setf delta-x (+ (gfs:size-width rect-size) 10))
+ (loop for pnt in (list rect-pnt start-pnt end-pnt)
+ do (incf (gfs:point-x pnt) delta-x))
+ (setf (gfg:pen-width gc) 3)
+ (setf (gfg:pen-style gc) '(:dot))
+ (gfg:draw-pie-wedge gc (make-instance 'gfs:rectangle :location rect-pnt :size rect-size) start-pnt end-pnt)
+ (loop for pnt in (list rect-pnt start-pnt end-pnt)
+ do (incf (gfs:point-x pnt) delta-x))
+ (setf (gfg:pen-width gc) 1)
+ (setf (gfg:pen-style gc) '(:solid))
+ (gfg:draw-pie-wedge gc (make-instance 'gfs:rectangle :location rect-pnt :size rect-size) start-pnt end-pnt)
+ (loop for pnt in (list rect-pnt start-pnt end-pnt)
+ do (incf (gfs:point-x pnt) delta-x))
+ (setf (gfg:foreground-color gc) (gfg:background-color gc))
+ (gfg:draw-pie-wedge gc (make-instance 'gfs:rectangle :location rect-pnt :size rect-size) start-pnt end-pnt)))
+
+(defun select-wedges (disp item time rect)
+ (declare (ignore disp time rect))
+ (update-drawing-item-check item)
+ (setf (draw-func-of *drawing-dispatcher*) #'draw-wedges)
+ (gfw:redraw *drawing-win*))
+
(defun run-drawing-tester-internal ()
(setf *last-checked-drawing-item* nil)
(let ((menubar (gfw:defmenu ((:item "&File"
@@ -366,6 +426,7 @@
(:item "&Bézier Curves" :callback #'select-beziers)
(:item "&Ellipses" :callback #'select-ellipses)
(:item "&Lines and Polylines" :callback #'select-lines)
+ (:item "&Pie Wedges" :callback #'select-wedges)
(:item "&Rectangles" :callback #'select-rects)))))))
(setf *drawing-dispatcher* (make-instance 'drawing-win-events))
(setf (draw-func-of *drawing-dispatcher*) #'draw-arcs)
Modified: trunk/src/uitoolkit/graphics/graphics-context.lisp
==============================================================================
--- trunk/src/uitoolkit/graphics/graphics-context.lisp (original)
+++ trunk/src/uitoolkit/graphics/graphics-context.lisp Tue Mar 28 00:30:06 2006
@@ -216,6 +216,11 @@
(error 'gfs:disposed-error))
(call-rect-function #'gfs::ellipse "ellipse" (gfs:handle self) rect))
+(defmethod draw-filled-pie-wedge ((self graphics-context) rect start-pnt end-pnt)
+ (if (gfs:disposed-p self)
+ (error 'gfs:disposed-error))
+ (call-rect-and-range-function #'gfs::pie "pie" (gfs:handle self) rect start-pnt end-pnt))
+
(defmethod draw-filled-polygon ((self graphics-context) points)
(if (gfs:disposed-p self)
(error 'gfs:disposed-error))
@@ -232,6 +237,12 @@
(error 'gfs:disposed-error))
(call-points-function #'gfs::polyline "polyline" (gfs:handle self) (list start-pnt end-pnt)))
+(defmethod draw-pie-wedge ((self graphics-context) rect start-pnt end-pnt)
+ (if (gfs:disposed-p self)
+ (error 'gfs:disposed-error))
+ (with-null-brush (self)
+ (call-rect-and-range-function #'gfs::pie "pie" (gfs:handle self) rect start-pnt end-pnt)))
+
(defmethod draw-poly-bezier ((self graphics-context) start-pnt 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 Tue Mar 28 00:30:06 2006
@@ -78,6 +78,9 @@
(defgeneric draw-filled-ellipse (self rect)
(:documentation "Fills the interior of the ellipse defined by a rectangle."))
+(defgeneric draw-filled-pie-wedge (self rect start-pnt end-pnt)
+ (:documentation "Filles the interior of a pie-shaped wedge."))
+
(defgeneric draw-filled-polygon (self points)
(:documentation "Fills the interior of the closed polygon defined by points."))
@@ -90,12 +93,15 @@
(defgeneric draw-filled-wedge (self rect start-pnt end-pnt)
(:documentation "Fills the interior of an elliptical arc within the rectangle."))
-(defgeneric draw-image (self im pnt)
- (:documentation "Draws the given image in the receiver at the specified coordinates."))
+(defgeneric draw-image (self image pnt)
+ (:documentation "Draws an image at the specified coordinates."))
(defgeneric draw-line (self start-pnt end-pnt)
(:documentation "Draws a line using the foreground color between start-pnt and end-pnt."))
+(defgeneric draw-pie-wedge (self rect start-pnt end-pnt)
+ (:documentation "Draws a pie-shaped wedge defined by the intersection of an ellipse and two radials."))
+
(defgeneric draw-point (self pnt)
(:documentation "Draws a pixel in the foreground color at the specified point."))
Modified: trunk/src/uitoolkit/system/gdi32.lisp
==============================================================================
--- trunk/src/uitoolkit/system/gdi32.lisp (original)
+++ trunk/src/uitoolkit/system/gdi32.lisp Tue Mar 28 00:30:06 2006
@@ -43,10 +43,10 @@
("Arc" arc)
BOOL
(hdc HANDLE)
- (leftrect INT)
- (toprect INT)
- (rightrect INT)
- (bottomrect INT)
+ (rectleft INT)
+ (recttop INT)
+ (rectright INT)
+ (rectbottom INT)
(startx INT)
(starty INT)
(endx INT)
@@ -155,10 +155,10 @@
("Ellipse" ellipse)
BOOL
(hdc HANDLE)
- (leftrect INT)
- (toprect INT)
- (rightrect INT)
- (bottomrect INT))
+ (rectleft INT)
+ (recttop INT)
+ (rectright INT)
+ (rectbottom INT))
(defcfun
("ExtCreatePen" ext-create-pen)
@@ -254,6 +254,19 @@
(rop DWORD))
(defcfun
+ ("Pie" pie)
+ BOOL
+ (hdc HANDLE)
+ (rectleft INT)
+ (recttop INT)
+ (rightrect INT)
+ (bottomrect INT)
+ (radial1x INT)
+ (radial1y INT)
+ (radial2x INT)
+ (radial2y INT))
+
+(defcfun
("PolyBezier" poly-bezier)
BOOL
(hdc HANDLE)
More information about the Graphic-forms-cvs
mailing list