[graphic-forms-cvs] r101 - in trunk/src: demos/unblocked tests/uitoolkit uitoolkit/widgets

[junrue at common-lisp.net]

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)