[mcclim-cvs] CVS update: mcclim/Examples/demodemo.lisp mcclim/Examples/fire.lisp

[Andy Hefner]

Update of /project/mcclim/cvsroot/mcclim/Examples
In directory common-lisp.net:/tmp/cvs-serv568/Examples

Modified Files:
	demodemo.lisp fire.lisp 
Log Message:
Add puzzle, demodemo, and dragndrop to the examples system.


Date: Mon Jan 31 21:35:30 2005
Author: ahefner

Index: mcclim/Examples/demodemo.lisp
diff -u mcclim/Examples/demodemo.lisp:1.6 mcclim/Examples/demodemo.lisp:1.7
--- mcclim/Examples/demodemo.lisp:1.6	Wed Jan 21 00:59:13 2004
+++ mcclim/Examples/demodemo.lisp	Mon Jan 31 21:35:30 2005
@@ -47,7 +47,7 @@
      (default
          (vertically (:equalize-width t)
            (progn ;;spacing (:thickness 10)
-             (labelling (:label "FreeCLIM Demos"
+             (labelling (:label "McCLIM Demos"
                                 :text-style (make-text-style :sans-serif :roman :huge)
                                 :align-x :center)))
            (progn ;; spacing (:thickness 10)
@@ -55,8 +55,15 @@
                ;; '+fill+
                (labelling (:label "Demos")
                  (vertically (:equalize-width t)
+                   (make-demo-button "CLIM-Fig"  'clim-fig)
+                   (make-demo-button "Calculator"  'calculator)
+                   (make-demo-button "Method Browser" 'method-browser)
+                   (make-demo-button "Address Book"  'address-book)
+                   (make-demo-button "Puzzle"  'puzzle)
+                   (make-demo-button "Gadget Test"  'gadget-test)
+                   (make-demo-button "Drag and Drop" 'dragndrop)
                    (make-demo-button "Colorslider" 'colorslider)
-                   (make-demo-button "Calculator"  'calculator)))
+                   (make-demo-button "Goatee Test" 'goatee::goatee-test)))
                (labelling (:label "Tests")
                  (vertically (:equalize-width t)
                    (make-demo-button "Label Test" 'label-test)
@@ -66,6 +73,7 @@
                    (make-demo-button "HBOX Test"  'hbox-test)))))))))
 
 (defun demodemo ()
+  #+nil
   (loop for port in climi::*all-ports*
       do (destroy-port port))
   (run-frame-top-level (make-application-frame 'demodemo)))


Index: mcclim/Examples/fire.lisp
diff -u mcclim/Examples/fire.lisp:1.3 mcclim/Examples/fire.lisp:1.4
--- mcclim/Examples/fire.lisp:1.3	Wed Mar 12 22:55:27 2003
+++ mcclim/Examples/fire.lisp	Mon Jan 31 21:35:30 2005
@@ -52,8 +52,10 @@
 
 (defmethod handle-event :after ((pane clim-internals::fire-pane) (event pointer-event))
   (declare (ignorable event))
+  (hef:debugf pane event)
+  #+nil
   (let ((label (clim-internals::gadget-label (clim-internals::radio-box-current-selection
-					      (slot-value *application-frame* 'radio-box)))))
+					      (find-pane-named *application-frame* 'radio-box)))))
     (cond ((string= label "O")
 	   (progn
 	     (sleep 3)
@@ -73,20 +75,20 @@
 (defun callback-red (gadget value)
   (declare (ignorable gadget))
   (when value
-    (setf (clim-internals::gadget-current-color (slot-value *application-frame* 'fire))
-	  (clim-internals::gadget-normal-color (slot-value *application-frame* 'fire)))))
+    (setf (clim-internals::gadget-current-color (find-pane-named *application-frame* 'fire))
+	  (clim-internals::gadget-normal-color (find-pane-named *application-frame* 'fire)))))
 
 (defun callback-orange (gadget value)
   (declare (ignore gadget))
   (when value 
-    (setf (clim-internals::gadget-current-color (slot-value *application-frame* 'fire))
-	  (clim-internals::gadget-highlighted-color (slot-value *application-frame* 'fire)))))
+    (setf (clim-internals::gadget-current-color (find-pane-named *application-frame* 'fire))
+	  (clim-internals::gadget-highlighted-color (find-pane-named *application-frame* 'fire)))))
 
 (defun callback-green (gadget value)
   (declare (ignore gadget))
   (when value
-    (setf (clim-internals::gadget-current-color (slot-value *application-frame* 'fire))
-	  (clim-internals::gadget-pushed-and-highlighted-color (slot-value *application-frame* 'fire)))))
+    (setf (clim-internals::gadget-current-color (find-pane-named *application-frame* 'fire))
+	  (clim-internals::gadget-pushed-and-highlighted-color (find-pane-named *application-frame* 'fire)))))
 
 ;; test functions
 
@@ -97,13 +99,13 @@
   (run-frame-top-level (make-application-frame 'firelights)))
 
 (defmethod fire-frame-top-level ((frame application-frame))
-  (setf (slot-value *application-frame* 'fire) (car (last (frame-panes *application-frame*)))
-	(slot-value *application-frame* 'radio-box)
-	(with-radio-box ()
-	 (first (frame-panes *application-frame*))
-	 (second (frame-panes *application-frame*))
-	 (radio-box-current-selection (third (frame-panes *application-frame*)))))
-  (loop (event-read (frame-pane frame))))
+  (with-look-and-feel-realization ((frame-manager frame) frame)
+    (setf (slot-value *application-frame* 'radio-box)
+          (with-radio-box (:name 'radio-box)
+            (first (frame-panes *application-frame*))
+            (second (frame-panes *application-frame*))
+            (radio-box-current-selection (third (frame-panes *application-frame*)))))
+    (loop (event-read (find-pane-named frame 'fire)))))
 
 (define-application-frame firelights ()
   ((radio-box :initform nil)
@@ -141,4 +143,4 @@
 		 :value-changed-callback 'callback-orange))
    (:layouts
     (default (horizontally () (vertically () red-fire orange-fire green-fire) fire)))
-   (:top-level (fire-frame-top-level . nil)))
+   #+NIL (:top-level (fire-frame-top-level . nil)))