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)))