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 -@deffn Reader handle -@end deffn @end deftp

@anchor{point} @@ -91,18 +89,10 @@ @end deftp

@anchor{rectangle} -@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 +@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}. -@deffn Initarg :location -@end deffn -@deffn Initarg :size -@end deffn -@deffn Accessor location -@end deffn -@deffn Accessor size -@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

+@deffn Macro location rect +This macro returns the @code{location} slot of a @ref{rectangle}. +@end deffn + @deffn Function make-point :x :y :z This function creates a new @ref{point} object. @end deffn

+@deffn Function make-rectangle :location :size +This function creates a new @ref{rectangle} object. +@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

+@deffn Macro size rect +This macro returns the @code{size} slot of a @ref{rectangle}. +@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