[graphic-forms-cvs] r161 - in trunk: docs/manual src src/demos/unblocked src/tests/uitoolkit src/uitoolkit/system src/uitoolkit/widgets
junrue at common-lisp.net
junrue at common-lisp.net
Mon Jun 26 04:25:54 UTC 2006
Author: junrue
Date: Mon Jun 26 00:25:52 2006
New Revision: 161
Modified:
trunk/docs/manual/api.texinfo
trunk/src/demos/unblocked/double-buffered-event-dispatcher.lisp
trunk/src/packages.lisp
trunk/src/tests/uitoolkit/drawing-tester.lisp
trunk/src/tests/uitoolkit/hello-world.lisp
trunk/src/tests/uitoolkit/layout-tester.lisp
trunk/src/tests/uitoolkit/windlg.lisp
trunk/src/uitoolkit/system/datastructs.lisp
trunk/src/uitoolkit/widgets/event.lisp
trunk/src/uitoolkit/widgets/flow-layout.lisp
trunk/src/uitoolkit/widgets/heap-layout.lisp
trunk/src/uitoolkit/widgets/label.lisp
Log:
corrected an early mistake whereby rectangle should have been a structure originally
Modified: trunk/docs/manual/api.texinfo
==============================================================================
--- trunk/docs/manual/api.texinfo (original)
+++ trunk/docs/manual/api.texinfo Mon Jun 26 00:25:52 2006
@@ -81,8 +81,6 @@
foreign pointer but should be treated as an opaque cookie.
@deffn Initarg :handle
@end deffn
- at deffn Reader handle
- at end deffn
@end deftp
@anchor{point}
@@ -91,18 +89,10 @@
@end deftp
@anchor{rectangle}
- at deftp Class rectangle location size
-This class identifies a region in the Cartesian coordinate system
-consisting of an upper-left coordinate and bounds. See @ref{point} and
+ at deftp Structure rectangle location size
+This structure identifies a region in the Cartesian coordinate system
+consisting of an upper-left coordinate and size. See @ref{point} and
@ref{size}.
- at deffn Initarg :location
- at end deffn
- at deffn Initarg :size
- at end deffn
- at deffn Accessor location
- at end deffn
- at deffn Accessor size
- at end deffn
@end deftp
@anchor{size}
@@ -112,7 +102,7 @@
@anchor{span}
@deftp Structure span start end
-This structure represents a range of values or times in a collection.
+This structure represents a range of values.
@end deftp
@@ -132,10 +122,18 @@
but secondary initialization code has not yet executed.
@end deffn
+ at deffn Macro location rect
+This macro returns the @code{location} slot of a @ref{rectangle}.
+ at end deffn
+
@deffn Function make-point :x :y :z
This function creates a new @ref{point} object.
@end deffn
+ at deffn Function make-rectangle :location :size
+This function creates a new @ref{rectangle} object.
+ at end deffn
+
@deffn Function make-size :width :height :depth
This function creates a new @ref{size} object.
@end deffn
@@ -144,6 +142,10 @@
This function creates a new @ref{span} object.
@end deffn
+ at deffn Macro size rect
+This macro returns the @code{size} slot of a @ref{rectangle}.
+ at end deffn
+
@node system conditions
@section system conditions
Modified: trunk/src/demos/unblocked/double-buffered-event-dispatcher.lisp
==============================================================================
--- trunk/src/demos/unblocked/double-buffered-event-dispatcher.lisp (original)
+++ trunk/src/demos/unblocked/double-buffered-event-dispatcher.lisp Mon Jun 26 00:25:52 2006
@@ -49,7 +49,7 @@
(let ((image (image-buffer-of self)))
(setf (gfg:background-color gc) *background-color*)
(setf (gfg:foreground-color gc) *background-color*)
- (gfg:draw-filled-rectangle gc (make-instance 'gfs:rectangle :size (gfg:size image)))))
+ (gfg:draw-filled-rectangle gc (gfs:make-rectangle :size (gfg:size image)))))
(defmethod dispose ((self double-buffered-event-dispatcher))
(let ((image (image-buffer-of self)))
Modified: trunk/src/packages.lisp
==============================================================================
--- trunk/src/packages.lisp (original)
+++ trunk/src/packages.lisp Mon Jun 26 00:25:52 2006
@@ -69,6 +69,7 @@
#:handle
#:location
#:make-point
+ #:make-rectangle
#:make-size
#:make-span
#:null-handle-p
Modified: trunk/src/tests/uitoolkit/drawing-tester.lisp
==============================================================================
--- trunk/src/tests/uitoolkit/drawing-tester.lisp (original)
+++ trunk/src/tests/uitoolkit/drawing-tester.lisp Mon Jun 26 00:25:52 2006
@@ -69,7 +69,7 @@
(declare (ignore time rect))
(setf (gfg:background-color gc) gfg:*color-white*)
(setf (gfg:foreground-color gc) gfg:*color-white*)
- (gfg:draw-filled-rectangle gc (make-instance 'gfs:rectangle :size (gfw:client-size window)))
+ (gfg:draw-filled-rectangle gc (gfs:make-rectangle :size (gfw:client-size window)))
(let ((func (draw-func-of self)))
(unless (null func)
(funcall func gc))))
@@ -145,7 +145,7 @@
(defun draw-arcs (gc)
(let* ((rect-pnt (gfs:make-point :x 15 :y 10))
(rect-size (gfs:make-size :width 80 :height 65))
- (rect (make-instance 'gfs:rectangle :location (clone-point rect-pnt) :size rect-size))
+ (rect (gfs:make-rectangle :location (clone-point rect-pnt) :size rect-size))
(start-pnt (gfs:make-point :x 15 :y 60))
(end-pnt (gfs:make-point :x 75 :y 25))
(delta-x (+ (gfs:size-width rect-size) 10))
@@ -154,12 +154,12 @@
(incf (gfs:point-y rect-pnt) delta-y)
(incf (gfs:point-y start-pnt) delta-y)
(incf (gfs:point-y end-pnt) delta-y)
- (setf rect (make-instance 'gfs:rectangle :location (clone-point rect-pnt) :size rect-size))
+ (setf rect (gfs:make-rectangle :location (clone-point rect-pnt) :size rect-size))
(draw-rect-start-end gc rect (clone-point start-pnt) (clone-point end-pnt) delta-x #'gfg:draw-chord nil)
(incf (gfs:point-y rect-pnt) delta-y)
(incf (gfs:point-y start-pnt) delta-y)
(incf (gfs:point-y end-pnt) delta-y)
- (setf rect (make-instance 'gfs:rectangle :location (clone-point rect-pnt) :size rect-size))
+ (setf rect (gfs:make-rectangle :location (clone-point rect-pnt) :size rect-size))
(draw-rect-start-end gc rect (clone-point start-pnt) (clone-point end-pnt) delta-x #'gfg:draw-arc nil)))
(defun select-arcs (disp item time rect)
@@ -194,12 +194,12 @@
(defun draw-ellipses (gc)
(let* ((rect-pnt (gfs:make-point :x 15 :y 10))
(rect-size (gfs:make-size :width 80 :height 65))
- (rect (make-instance 'gfs:rectangle :location (clone-point rect-pnt) :size rect-size))
+ (rect (gfs:make-rectangle :location (clone-point rect-pnt) :size rect-size))
(delta-x (+ (gfs:size-width rect-size) 10))
(delta-y (+ (gfs:size-height rect-size) 10)))
(draw-rectangular gc rect nil delta-x #'gfg:draw-filled-ellipse t)
(incf (gfs:point-y rect-pnt) delta-y)
- (setf rect (make-instance 'gfs:rectangle :location (clone-point rect-pnt) :size rect-size))
+ (setf rect (gfs:make-rectangle :location (clone-point rect-pnt) :size rect-size))
(draw-rectangular gc rect nil delta-x #'gfg:draw-ellipse nil)))
(defun select-ellipses (disp item time rect)
@@ -249,19 +249,19 @@
(defun draw-rects (gc)
(let* ((rect-pnt (gfs:make-point :x 15 :y 10))
(rect-size (gfs:make-size :width 80 :height 50))
- (rect (make-instance 'gfs:rectangle :location (clone-point rect-pnt) :size rect-size))
+ (rect (gfs:make-rectangle :location (clone-point rect-pnt) :size rect-size))
(delta-x (+ (gfs:size-width rect-size) 10))
(delta-y (+ (gfs:size-height rect-size) 10))
(arc-size (gfs:make-size :width 10 :height 10)))
(draw-rectangular gc rect arc-size delta-x #'gfg:draw-filled-rounded-rectangle t)
(incf (gfs:point-y rect-pnt) delta-y)
- (setf rect (make-instance 'gfs:rectangle :location (clone-point rect-pnt) :size rect-size))
+ (setf rect (gfs:make-rectangle :location (clone-point rect-pnt) :size rect-size))
(draw-rectangular gc rect nil delta-x #'gfg:draw-filled-rectangle t)
(incf (gfs:point-y rect-pnt) delta-y)
- (setf rect (make-instance 'gfs:rectangle :location (clone-point rect-pnt) :size rect-size))
+ (setf rect (gfs:make-rectangle :location (clone-point rect-pnt) :size rect-size))
(draw-rectangular gc rect arc-size delta-x #'gfg:draw-rounded-rectangle nil)
(incf (gfs:point-y rect-pnt) delta-y)
- (setf rect (make-instance 'gfs:rectangle :location (clone-point rect-pnt) :size rect-size))
+ (setf rect (gfs:make-rectangle :location (clone-point rect-pnt) :size rect-size))
(draw-rectangular gc rect nil delta-x #'gfg:draw-rectangle nil)))
(defun select-rects (disp item time rect)
@@ -323,7 +323,7 @@
(defun draw-wedges (gc)
(let* ((rect-pnt (gfs:make-point :x 5 :y 10))
(rect-size (gfs:make-size :width 80 :height 65))
- (rect (make-instance 'gfs:rectangle :location (clone-point rect-pnt) :size rect-size))
+ (rect (gfs:make-rectangle :location (clone-point rect-pnt) :size rect-size))
(delta-x (+ (gfs:size-width rect-size) 10))
(delta-y (gfs:size-height rect-size))
(start-pnt (gfs:make-point :x 35 :y 75))
@@ -333,7 +333,7 @@
(incf (gfs:point-y rect-pnt) delta-y)
(incf (gfs:point-y start-pnt) delta-y)
(incf (gfs:point-y end-pnt) delta-y)
- (setf rect (make-instance 'gfs:rectangle :location (clone-point rect-pnt) :size rect-size))
+ (setf rect (gfs:make-rectangle :location (clone-point rect-pnt) :size rect-size))
(draw-rect-start-end gc rect (clone-point start-pnt) (clone-point end-pnt) delta-x #'gfg:draw-pie-wedge nil)))
(defun select-wedges (disp item time rect)
Modified: trunk/src/tests/uitoolkit/hello-world.lisp
==============================================================================
--- trunk/src/tests/uitoolkit/hello-world.lisp (original)
+++ trunk/src/tests/uitoolkit/hello-world.lisp Mon Jun 26 00:25:52 2006
@@ -51,7 +51,7 @@
(declare (ignore time rect))
(setf (gfg:background-color gc) gfg:*color-white*)
(setf (gfg:foreground-color gc) gfg:*color-white*)
- (gfg:draw-filled-rectangle gc (make-instance 'gfs:rectangle :size (gfw:client-size window)))
+ (gfg:draw-filled-rectangle gc (gfs:make-rectangle :size (gfw:client-size window)))
(setf (gfg:background-color gc) gfg:*color-red*)
(setf (gfg:foreground-color gc) gfg:*color-green*)
(gfg:draw-text gc "Hello World!" (gfs:make-point)))
Modified: trunk/src/tests/uitoolkit/layout-tester.lisp
==============================================================================
--- trunk/src/tests/uitoolkit/layout-tester.lisp (original)
+++ trunk/src/tests/uitoolkit/layout-tester.lisp Mon Jun 26 00:25:52 2006
@@ -74,7 +74,7 @@
(declare (ignore time rect))
(setf (gfg:background-color gc) gfg:*color-white*)
(setf (gfg:foreground-color gc) gfg:*color-white*)
- (gfg:draw-filled-rectangle gc (make-instance 'gfs:rectangle :size (gfw:client-size window))))
+ (gfg:draw-filled-rectangle gc (gfs:make-rectangle :size (gfw:client-size window))))
(defclass test-panel (gfw:panel) ())
Modified: trunk/src/tests/uitoolkit/windlg.lisp
==============================================================================
--- trunk/src/tests/uitoolkit/windlg.lisp (original)
+++ trunk/src/tests/uitoolkit/windlg.lisp Mon Jun 26 00:25:52 2006
@@ -53,7 +53,7 @@
(declare (ignore time rect))
(setf (gfg:background-color gc) gfg:*color-white*)
(setf (gfg:foreground-color gc) gfg:*color-white*)
- (gfg:draw-filled-rectangle gc (make-instance 'gfs:rectangle :size (gfw:client-size window))))
+ (gfg:draw-filled-rectangle gc (gfs:make-rectangle :size (gfw:client-size window))))
(defclass test-mini-events (test-win-events) ())
@@ -129,7 +129,7 @@
(let ((parent (gfw:parent panel)))
(setf (gfg:background-color gc) (gfg:background-color parent))
(setf (gfg:foreground-color gc) (gfg:background-color parent))
- (gfg:draw-filled-rectangle gc (make-instance 'gfs:rectangle :size (gfw:size panel)))))
+ (gfg:draw-filled-rectangle gc (gfs:make-rectangle :size (gfw:size panel)))))
(defclass dialog-events (gfw:event-dispatcher) ())
Modified: trunk/src/uitoolkit/system/datastructs.lisp
==============================================================================
--- trunk/src/uitoolkit/system/datastructs.lisp (original)
+++ trunk/src/uitoolkit/system/datastructs.lisp Mon Jun 26 00:25:52 2006
@@ -37,19 +37,12 @@
(defstruct size (width 0) (height 0) (depth 0))
+(defstruct rectangle (location (make-point)) (size (make-size)))
+
(defstruct span (start 0) (end 0))
-(defclass rectangle ()
- ((location
- :accessor location
- :initarg :location
- :initform (make-point))
- (size
- :accessor size
- :initarg :size
- :initform (make-size)))
- (:documentation "Describes the perimeter of a rectangular region in a given coordinate system."))
+(defmacro location (rect)
+ `(rectangle-location ,rect))
-(defmethod print-object ((obj rectangle) stream)
- (print-unreadable-object (obj stream :type t)
- (format stream "location: ~a size: ~a" (location obj) (size obj))))
+(defmacro size (rect)
+ `(rectangle-size ,rect))
Modified: trunk/src/uitoolkit/widgets/event.lisp
==============================================================================
--- trunk/src/uitoolkit/widgets/event.lisp (original)
+++ trunk/src/uitoolkit/widgets/event.lisp Mon Jun 26 00:25:52 2006
@@ -152,7 +152,7 @@
(event-select (dispatcher item)
item
(event-time tc)
- (make-instance 'gfs:rectangle)))))) ; FIXME
+ (gfs:make-rectangle)))))) ; FIXME
((eq wparam-hi 1)
(format t "accelerator wparam: ~x lparam: ~x~%" wparam lparam)) ; FIXME: debug
(t
@@ -163,7 +163,7 @@
(event-select (dispatcher w)
w
(event-time tc)
- (make-instance 'gfs:rectangle))))))) ; FIXME
+ (gfs:make-rectangle))))))) ; FIXME
(warn 'gfs:toolkit-warning :detail "no object for hwnd")))
0)
@@ -286,7 +286,7 @@
(let* ((tc (thread-context))
(widget (get-widget tc hwnd)))
(if widget
- (let ((rct (make-instance 'gfs:rectangle)))
+ (let ((rct (gfs:make-rectangle)))
(cffi:with-foreign-object (ps-ptr 'gfs::paintstruct)
(cffi:with-foreign-slots ((gfs::rcpaint-x
gfs::rcpaint-y
Modified: trunk/src/uitoolkit/widgets/flow-layout.lisp
==============================================================================
--- trunk/src/uitoolkit/widgets/flow-layout.lisp (original)
+++ trunk/src/uitoolkit/widgets/flow-layout.lisp Mon Jun 26 00:25:52 2006
@@ -141,7 +141,7 @@
(gfs:point-y pnt) (flow-data-wrap-coord state)))
(incf (flow-data-next-coord state) (+ (funcall (flow-data-distance-fn state) kid-size)
(flow-data-spacing state)))
- (cons kid (make-instance 'gfs:rectangle :size kid-size :location pnt))))
+ (cons kid (gfs:make-rectangle :size kid-size :location pnt))))
(defun flow-container-layout (layout visible kids width-hint height-hint)
(let ((flows nil)
Modified: trunk/src/uitoolkit/widgets/heap-layout.lisp
==============================================================================
--- trunk/src/uitoolkit/widgets/heap-layout.lisp (original)
+++ trunk/src/uitoolkit/widgets/heap-layout.lisp Mon Jun 26 00:25:52 2006
@@ -63,7 +63,7 @@
(gfs:size-height size))
vert-margin)))
(new-pnt (gfs:make-point :x (left-margin-of self) :y (top-margin-of self)))
- (bounds (make-instance 'gfs:rectangle :size new-size :location new-pnt)))
+ (bounds (gfs:make-rectangle :size new-size :location new-pnt)))
(with-children (win kids)
(loop for kid in kids collect (cons kid bounds)))))
Modified: trunk/src/uitoolkit/widgets/label.lisp
==============================================================================
--- trunk/src/uitoolkit/widgets/label.lisp (original)
+++ trunk/src/uitoolkit/widgets/label.lisp Mon Jun 26 00:25:52 2006
@@ -132,7 +132,7 @@
(if tr-pnt
(let* ((color (gfg:background-color label))
(size (gfg:size image))
- (bounds (make-instance 'gfs:rectangle :size size))
+ (bounds (gfs:make-rectangle :size size))
(tmp-image (make-instance 'gfg:image :size size))
(gc (make-instance 'gfg:graphics-context :image tmp-image)))
(unwind-protect
More information about the Graphic-forms-cvs
mailing list