Author: junrue Date: Mon Apr 17 00:31:21 2006 New Revision: 101
Modified: trunk/src/demos/unblocked/double-buffered-event-dispatcher.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/widgets/widget-classes.lisp Log: every event-source gets a default dispatcher now (subclasses or application can override the default, of course); minor cleanup of some places that instantiate gfs:rectangle which can use the default coordinate of (0,0)
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 Apr 17 00:31:21 2006 @@ -49,8 +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 :location (gfs:make-point) - :size (gfg:size image))))) + (gfg:draw-filled-rectangle gc (make-instance 'gfs:rectangle :size (gfg:size image)))))
(defmethod dispose ((self double-buffered-event-dispatcher)) (let ((image (image-buffer-of self)))
Modified: trunk/src/tests/uitoolkit/drawing-tester.lisp ============================================================================== --- trunk/src/tests/uitoolkit/drawing-tester.lisp (original) +++ trunk/src/tests/uitoolkit/drawing-tester.lisp Mon Apr 17 00:31:21 2006 @@ -69,9 +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 :location (gfs:make-point) - :size (gfw:client-size window))) + (gfg:draw-filled-rectangle gc (make-instance 'gfs:rectangle :size (gfw:client-size window))) (let ((func (draw-func-of self))) (unless (null func) (funcall func gc))))
Modified: trunk/src/tests/uitoolkit/hello-world.lisp ============================================================================== --- trunk/src/tests/uitoolkit/hello-world.lisp (original) +++ trunk/src/tests/uitoolkit/hello-world.lisp Mon Apr 17 00:31:21 2006 @@ -48,12 +48,10 @@ (exit-fn disp nil time nil))
(defmethod gfw:event-paint ((disp hellowin-events) window time gc rect) - (declare (ignore time)) - (setf rect (make-instance 'gfs:rectangle :location (gfs:make-point) - :size (gfw:client-size window))) + (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 rect) + (gfg:draw-filled-rectangle gc (make-instance 'gfs: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 Apr 17 00:31:21 2006 @@ -74,9 +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 :location (gfs:make-point) - :size (gfw:client-size window)))) + (gfg:draw-filled-rectangle gc (make-instance 'gfs: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 Apr 17 00:31:21 2006 @@ -50,12 +50,10 @@ (defclass test-win-events (gfw:event-dispatcher) ())
(defmethod gfw:event-paint ((d test-win-events) window time gc rect) - (declare (ignore time)) - (setf rect (make-instance 'gfs:rectangle :location (gfs:make-point) - :size (gfw:client-size window))) + (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 rect)) + (gfg:draw-filled-rectangle gc (make-instance 'gfs:rectangle :size (gfw:client-size window))))
(defclass test-mini-events (test-win-events) ())
Modified: trunk/src/uitoolkit/widgets/widget-classes.lisp ============================================================================== --- trunk/src/uitoolkit/widgets/widget-classes.lisp (original) +++ trunk/src/uitoolkit/widgets/widget-classes.lisp Mon Apr 17 00:31:21 2006 @@ -46,7 +46,7 @@ ((dispatcher :accessor dispatcher :initarg :dispatcher - :initform nil)) + :initform (make-instance 'event-dispatcher))) (:documentation "This is the base class for user interface objects that generate events."))
(defclass item (event-source)