cells-devel

cells-devel@common-lisp.net

567 discussions

[cells-devel] Celtk: Question on mk-entry
by Frank Goenninger 13 May '06

13 May '06

Hi again, When using the mk-entry widget I seem to not get any value back: CL-USER> (et::run-entry-test) "----------UTILSRESET----------------------------------" *** Tk_AppInit has been called. *** OBSERVER VAL: slot 'val' of ENTRY-TEST set to NIL 0> entry | "md-value output" | ENTRY | "" tk> bind . <Escape> {destroy .} 0> no event handlers for | ENTRY | |write| 0> known key | CTK::|write| | SYMBOL 0> no event handlers for | ENTRY | |write| 0> known key | CTK::|write| | SYMBOL *** OBSERVER VAL: slot 'val' of ENTRY-TEST set to 0> tcl-do-one-event-loop has left the building NIL CL-USER> In order to get this output I turned on trc output in the defobserver .mdvalue ((self entry)) method. Yet the observer does not fire. When should/does the observer fire? On each change of the entry's entry field ? I used the following code to test (also attached as a file): (defpackage :et (:use :common-lisp)) (in-package :et) (eval-when (:load-toplevel :compile-toplevel :execute) #+asdf (progn #-cells (progn (asdf:operate 'asdf:load-op :cells) (use-package :cells)) #-cl-opengl (progn (asdf:operate 'asdf:load-op :cl-openg)) #-Celtk (progn (asdf:operate 'asdf:load-op :Celtk) (use-package :Celtk)) )) (defmodel entry-test (window) ((val :accessor val :initarg :val :initform (c-in nil))) (:default-initargs :title$ "entry test" :id :entry-test :kids (c? (the-kids (mk-row (:packing (c?pack-self)) (mk-label :text "Enter value:") (mk-entry :id :frgo-entry) (mk-button-ex ("Do it !" (setf (val (fm^ :entry-test)) (md-value (fm^ :frgo-entry)))))))))) ;;; DEBUG OBSERVERS (defobserver val ((self entry-test)) (format t "~&*** OBSERVER VAL: slot 'val' of ~S set to ~A~&" self new-value)) ;;; RUN/TEST FUNCTION (defun run-entry-test () (test-window 'entry-test)) ----- The code assumes the value of the entry widget (what the user entered) is stored in md-value of the entry widget. I tried monkey style copying from the demos to no avail so far. Hmmpf! What am I doing wrong ? Thx for any hints. Frank

1 0

[cells-devel] Multiple observers for a Cell slot ?
by Frank Goenninger 11 May '06

11 May '06

Hi Kenny, hi all: While developing a library here for I/O to a microcontroller I see that I need some observers being defined to handle operations of the I/O device. Naturally I am coding these as part of the library which I plan to ship just as a compiled file. The main application also needs to define observers on some Cell slots to update the GUI and other stuff. As an observer for the slot is already defined I am denied to define another one. Now, am I doing something wrong and is is just me or maybe there should be some hook-like behavior and defobserver just adds another observer to a list of observers maintained by the Cell woodoo magic ? Thanks for comments Frank

2 1

[cells-devel] Oops, I panicked...
by Ken Tilton 04 May '06

04 May '06

I recently made a fundamental change to (setf md-slot-value) in the face of a bug in which a SETF got deferred and I could not think of a way to make the code work without taking out the integrity wrapper in (setf md-slot-value). That was dumb. The way the slot was being used (setf?! Only in eventhandlers, please.) the slot should not have been a cell. (Specify ":cell nil" in the slot definition.) What I decided to do was go the other way (more Cell-ish) and use a rule to get the slot initialized. Now I get to go back and take out the dozen extra (with-integrity (:change)...) wrappers I had to add all over the ltktest-ci demo to get that working after the dumb "fix". Anyway, if you grabbed Cells in the past few days you might want to wait till the smoke clears and grab it again. And this time I will run the Cells regression test, which I did not think to do last time. <sigh> kt

1 0

[cells-devel] Re: [Lisp] Rapid prototyping idea rewards crap (README)
by Ken Tilton 20 Apr '06

20 Apr '06

On 20 Apr 2006 13:40:40 -0400, Heow Eide-Goodman <lists(a)alphageeksinc.com> wrote: > > Actually Kenny, you hit it on the nose. > > Here is the process as-envisioned: > > 1. A prospective student has a gread project idea > 2. LispNYC reviews student and idea > 3. If we determine that idea and student are considered worthy, then > LispNYC says yeah or nay. > 4. (if (eq 'nay (lisp-nyc-review-process student) 'adios) (progn ... > )) > 5. We think they've got a fighting chance then LispNYC pledges $500 > 6. Student works and works and works > 7. Google reviews everything and the grants are awarded. > 8. If they're not funded by Google, then we give them the $500 > > > Since our intent is to attract smart motivated students to get a > head-start on the work rather than motivated shysters, then we should > carefully consider this. Everything comes with risks and this needs to > mitigate our risk rather than increase it. > > Please consider this, carefully. > > The RCP process is exactly the same review that we use for Google. > However, for a mere $500, it allows us: > > * More time to scrutinize the student. > * Determine whether she is sufficiently motivated to complete the > project. > * Better determine their technical chops, in Lisp or otherwise. OK, this makes no sense. Why not let Google waste their $500 instead of ours? We do the same due diligence either way, but if it turns out we screwed up, we take the hit. And I have to ask: what problem are you trying to solve? We did great last year. There was one screw-up, and I am completely to blame because I had an early warning of exactly what transpired. We have learned that lesson and will be more careful this time in the review process. But to be honest, again, I had all the early warning in the world on the cl-sockets didaster, I just sailed through that flashing red light. I thought the angle was "attract more projects". That was at least plausible. But, again, I doubt the guarantee would do that, I think it would attract (not reward) more crap. kt

1 0

[cells-devel] Re: [Lisp] Rapid prototyping idea rewards crap (README)
by Ken Tilton 20 Apr '06

20 Apr '06

On 4/20/06, Jason Scherer <jason.scherer(a)rga.com> wrote: > > > I wonder, is it legal to have one umbrella project and then have > multiple students work on different pieces of that project? Not last year. I have not looked at the rules this year. kt

1 0

[cells-devel] Celtk/Cells: How to best do own new widgets...
by Frank Goenninger 20 Apr '06

20 Apr '06

Kenny, all: some status report on my endeavor to create a hobby app with Celtk and also a few things to discuss: I have put together the GUI prototype for my app - using Tcl/Tk directly. Purpose was to learn Tcl/Tk and see how well I could do some advanced things like building my own widgets / GUI elements using only basic commands as supported by Celtk. Now there's some GUI there that can be translated straightforward to Celtk except for a meter widget for displaying analog value like voltage and current. You can test the GUI by firing it up with wish psu-rc-gui.tcl using the attached files. One is a font file that is needed to display LCD type characters (font DS-Dgital, folder ds-digital). I used the voltmeter.tcl file by Marco Maggi (http://wiki.tcl.tk/ 9109) as a reference but decided to go without actually creating a Tk widget. Now, I see the that I'd like to use some kind of new widget class either by sub-classing Celtk:widget or by enhancing the Celtk:widget class. I'd need some possibility to send over Tcl/Tk code to the wish upon first instance creation in order to install the widget on the Tk side. That's approach #1. #2 would be to do this all in Lisp and just send the drawing commands to the wish... Hmmm!? Which one would you choose. Why ? Thanks for any feedback! Cheers Frank P.S. If there's no files attached I think the cells-devel list does not allow posting attachments ... I'll send you the files if you say so.

2 2

[cells-devel] Celtk/cells: timing issue in initialization and No Widgets :-(
by Frank Goenninger 14 Apr '06

14 Apr '06

Hi Kenny and fellow I've been enhancing my power supply remote control app with some widgets to enter the RS232C/USB port name. Only issue I have is I don't see any error but no widgets appearing... Seems to be a simple one... HELP! Another, more serious thing in my eyes , is the issue I have with my different instances getting initialized. I have marked the challenging place in the code with <<< frgo: HERE - see :tk-fill ... Issue is that the object darc-rs232c-port does not seem to be finalized yet when the function darc-setup-panel gets called. So I cannot depend a text label on a cell slot of the darc-rs232c-port object... I tried to avoid this with some clumsy code but it seems simply to be wrong. Can't get my head to find another solution. Any input here of course very welcome!! Thx again! Frank ----- (in-package :cl-user) (eval-when (:load-toplevel :compile-toplevel :execute) #+asdf (progn #-cells (asdf:operate 'asdf:load-op :cells) #-Celtk (asdf:operate 'asdf:load-op :Celtk) )) (in-package :celtk-user) (defparameter *psu-rc-app* nil "The instance of the PSU Remote Control application.") ;; BASE CLASS FOR APPLICATIONS (defmodel application () (( .md-value :cell t :accessor view :initform (c-in nil) :initarg :view ) ( name :cell t :accessor name :initform (c-in nil) :initarg :name ) ( status :cell t :accessor status :initform (c- in :disabled) :initarg :status) )) ;(defmethod initialize-instance :after ((self application) &key) ; (incf (nr-instances self))) - does not work ... (defmodel application-object (family) (( .md-name :cell t :accessor id :initform (c- in :unknown) :initarg :id ))) ;; PUSHBUTTON, SIGNAL-LAMP, PUSHBUTTON-WITH-SIGNAL-LAMP MODELS (defmodel pushbutton (application-object) (( .md-value :cell t :accessor pb-state :initform (c? (if (^pressed) (on-off-toggle .cache) (initial-pb-state self))) :initarg :pb-state ) ( initial-pb-state :cell nil :initform :off :initarg :initial-pb-state :reader initial-pb-state ) ( pressed :cell :ephemeral :accessor pressed :initform (c-in nil)))) (defmacro mk-pushbutton (&rest initargs) `(make-instance 'pushbutton :fm-parent *parent* ,@initargs)) ;(defmacro push-the-button (button-id) ; `(setf (fm^v ,button-id) :pressed)) (defmodel signal-lamp (application-object) ((lamp-state :cell t :accessor lamp-state :initform (c? (if (^switched) (not .cache) (initial-lamp-state self))) :initarg :lamp-state ) ( initial-lamp-state :cell nil :initform :off :initarg :initial-lamp-state :reader initial-lamp-state ) ( switched :cell :ephemeral :accessor switched :initform (c-in nil)))) (defmacro mk-signal-lamp (&rest initargs) `(make-instance 'signal-lamp :fm-parent *parent* ,@initargs)) (defmodel pushbutton-with-signal-lamp (pushbutton signal-lamp) ()) (defmacro mk-pushbutton-with-signal-lamp (&rest initargs) `(make-instance 'pushbutton-with-signal-lamp :fm-parent *parent* ,@initargs)) ;; PSU-APP-RC MODEL (defun control-panel () (list ;; SIGNAL LAMPS ;; Mains signal lamp (mk-signal-lamp :id :mains-lamp ;:lamp-state (cr-mains-lamp-state) ) ;; OPER signal lamp (mk-signal-lamp :id :oper-lamp ;:lamp-state (cr-oper-lamp-state) ) ;; TEST signal lamp (mk-signal-lamp :id :test-lamp ;:lamp-state (cr-test-lamp-state) ) ;; FAIL signal lamp (mk-signal-lamp :id :fail-lamp ;:lamp-state (cr-fail-lamp-state) ) ;; PUSH BUTTONS AND LAMPS ;; Oper mode pushbutton with lamp (mk-pushbutton-with-signal-lamp :id :oper-mode-pb :initial-pb-state :off :lamp-state (c? (if (^pressed) (^pb-state) (initial-lamp-state self))) ) ;; Test mode pushbutton with lamp (mk-pushbutton-with-signal-lamp :id :test-mode-pb :initial-pb-state :off ;:lamp-state (c? (^pb-state)) ) ;; Ua-enable pushbutton with lamp (mk-pushbutton-with-signal-lamp :id :Ua-enable-pb :initial-pb-state :off) ;; Ug1 pushbutton with lamp (mk-pushbutton-with-signal-lamp :id :Ug1-pb :initial-pb-state :off) ;; Ug2 pushbutton with lamp (mk-pushbutton-with-signal-lamp :id :Ug2-pb :initial-pb-state :off) ;; Uh pushbutton with lamp (mk-pushbutton-with-signal-lamp :id :Uh-pb :initial-pb-state :off) ;; Uh pushbutton with lamp (mk-pushbutton-with-signal-lamp :id :Uh-pb :initial-pb-state :off) ) ) (defmodel psu-rc-app (application) ( ;; Mains status (may have several vaklues, :ok indicates OK ;-) ( mains-status :cell t :accessor mains-status :initform (c-in nil) :initarg :mains-status ) ;; Operate status: eitehr :operate-mode or :test-mode ( operate-status :cell t :accessor operate-status :initform (c- in nil) :initarg :operate-status ) ;; RS232C port ;; As soon as the port name is set try to read data from this port ;; DARC stands for Device and Application Remote Control ( darc-rs232c-port :cell t :accessor darc-rs232c-port :initform (c-in nil) :initarg :darc-rs232c-port ) ;; Voltage and current values to be displayed Units ( Ua :cell t :accessor Ua :initform (c-in nil) :initarg :Ua ) ; [ V ] ( Ia :cell t :accessor Ia :initform (c-in nil) :initarg :Ia ) ; [ A ] ( Uh :cell t :accessor Uh :initform (c-in nil) :initarg :Uh ) ; [ V ] ( Ih :cell t :accessor Ih :initform (c-in nil) :initarg :Ih ) ; [ A ] ( Ug1 :cell t :accessor Ug1 :initform (c-in nil) :initarg :Ug1 ) ; [ V ] ( Ig1 :cell t :accessor Ig1 :initform (c-in nil) :initarg :Ig1 ) ; [ mA ] ( Ug2 :cell t :accessor Ug2 :initform (c-in nil) :initarg :Ug2 ) ; [ V ] ( Ig2 :cell t :accessor Ig2 :initform (c-in nil) :initarg :Ig2 ) ; [ mA ] ) ) (defmodel rs232c-port (window) ; needs to be a widget to get a ; timer easily ;-) (( status :accessor status :cell t :initform (c-in :not-connected)) ( device-name :accessor device-name :cell t :initform (c-in nil) :initarg :device-name )) (:default-initargs :id :darc-port :timers (c? (list (make-instance 'timer :state (c-in :on) :repeat t :delay 1000 ; 1 s delay :action (lambda (timer) (declare (ignore timer)) (connect-to-darc (device-name self)))))))) (defun connect-to-darc (device-name) (when device-name (format t "~%*** Trying to connect to DARC via port ~a ...~&" device-name) ;; MISSING: Code that connects to the DARC port via USB ... ;; For now, just return NOT CONNECTED ... (values :not-connected) ) ) (defobserver status ((self rs232c-port)) (format t "~%*** Status of RS232C port ~a is now ~s.~%" (device-name self) (status self)) (when new-value (if (eq new-value :connected) (setf (state (first (timers self))) :off) (setf (state (first (timers self))) :on) ))) ;; HELPER FUNCTIONS ;; Toggles :on to :off and vice versa (defun on-off-toggle (on-or-off) (case on-or-off ( :on :off) ( :off :on ) (otherwise :off))) ; Safety ! Turn off in case of unknown value given ; (= bug in app) ... ;; PSU-RC-APP OBSERVERS (defobserver mains-status ((self psu-rc-app)) (format t "~%*** Mains-status is now ~s.~%" new-value)) (defobserver lamp-state ((self signal-lamp)) (format t "~%*** Signal lamp ~a is now ~s.~%" (id self) new-value)) (defobserver pressed ((self pushbutton)) (format t "~%*** Pushbutton ~a has been pressed (~s).~%" (id self) new-value)) (defobserver switched ((self signal-lamp)) (format t "~%*** Lamp ~a has been switched (~s).~%" (id self) new- value)) ;(defobserver pressed ((self pushbutton-with-signal-lamp)) ; (setf (switched (fm^ (md-name self)) t))) ;; Get a view / window right after making an instance ;; We only allow one instance to run ! (defmethod initialize-instance :after ((self psu-rc-app) &key) (when *psu-rc-app* (error "*** A PSU-APP-RC instance already exists. Only one allowed.")) (setq *psu-rc-app* self) (setf (view self) (make-instance 'psu-rc-app-view)) (setf (darc-rs232c-port self) (make-instance 'rs232c-port))) ;; PSU-RC-APP-VIEW - the view/GUI for the PSU Remote Control Application (defmodel psu-rc-app-view (window) ((selected-oper-pb :cell :ephemeral :accessor selected-oper-pb :initform (c-in nil) :initarg :selected-oper-pb) (selected-test-pb :cell :ephemeral :accessor selected-test-pb :initform (c-in nil) :initarg :selected-test-pb)) (:default-initargs :id :psu-rc-app-view :kids (c? (the-kids (app-menubar) (control-panel) (darc-setup-panel) )))) ;(defmethod initialize-instance :after ((self psu-rc-app-view) &key) ; (tk-format '(:configure "title") "wm title . ~a" (slot-value self 'title$))) (defobserver title$ ((self window)) (tk-format '(:configure "title") "wm title . ~a" (or new-value "Untitled"))) (defun app-menubar () (mk-menubar :id :psu-rc-menu-bar :kids (c? (the-kids (mk-menu-entry-cascade-ex (:label "File") (mk-menu-entry-command :label "Quit" :command "exit")) (mk-menu-entry-cascade-ex (:label "Operate") (mk-menu-entry-command :label "Set Mains Status to :OK" :command (c? (tk-callback .tkw 'set-mains-ok (lambda () (setf (mains-status *psu-rc-app*) :ok))))) (mk-menu-entry-command :label "Action: Push the OPER MODE button" :command (c? (tk-callback .tkw 'push-oper- mode-pb (lambda () (setf (pressed (fm^ :oper-mode-pb)) t)))) ) ) ) ) ) ) (defun darc-setup-panel () (mk-stack () (mk-row () (mk-label :text "DARC RS232C Port Device Name:") (mk-entry :id :darc-port-device-name :md-value (c-in "") :background "grey")) (mk-row () (mk-label :text "DARC Connect Status:") (mk-canvas ;; <<< frgo: HERE - see :tk-fill ... :height 40 :width 40 :kids (c? (the-kids (mk-rectangle :coords '(0 0 40 40) :tk-fill (c? (if (eq (if (darc-rs232c-port *psu-rc-app*) (status (darc-rs232c-port *psu-rc-app*)) nil) :connected) "green" "red"))))))) (mk-row () (mk-label :text (c? (if (darc-rs232c-port *psu-rc-app*) (status (darc-rs232c-port *psu-rc-app*)) "")) :relief 'sunken)))) ;; (defmodel main-controls-view (canvas) ;; () ;; (:default-initargs ;; :id :main-controls-view ;; :kids (c? (the-kids ;; ( (defun run-psu-rc-app () (cells-reset 'tk-user-queue-handler) (tk-test-class 'psu-rc-app))

2 4

[cells-devel] Celtk/cells: No Widgets! Help!
by Frank Goenninger 14 Apr '06

14 Apr '06

Hi again ... With substantial help I was able to get some more stuff to work as expected. Now I am struggling with the fact that the menubar does indeed have the menus I installed but the few widgets I placed into the window simply don't appear... Hmm - well, yes, why?? (As always, there's a FRGO placed here and there) How do I debug what is being sent to wish ? Thx for any inputs. Frank --- ;; -*- mode: Lisp; Syntax: Common-Lisp; Package: celtk-user; -*- (in-package :cl-user) (eval-when (:load-toplevel :compile-toplevel :execute) #+asdf (progn #-cells (asdf:operate 'asdf:load-op :cells) #-Celtk (asdf:operate 'asdf:load-op :Celtk) )) (in-package :celtk-user) (defparameter *psu-rc-app* nil "The instance of the PSU Remote Control application.") ;; BASE CLASS FOR APPLICATIONS (defmodel application () (( .md-value :cell t :accessor view :initform (c-in nil) :initarg :view ) ( name :cell t :accessor name :initform (c-in nil) :initarg :name ) ( status :cell t :accessor status :initform (c- in :disabled) :initarg :status) )) ;(defmethod initialize-instance :after ((self application) &key) ; (incf (nr-instances self))) - does not work ... (defmodel application-object (family) (( .md-name :cell t :accessor id :initform (c- in :unknown) :initarg :id ))) ;; PUSHBUTTON, SIGNAL-LAMP, PUSHBUTTON-WITH-SIGNAL-LAMP MODELS (defmodel pushbutton (application-object) (( .md-value :cell t :accessor pb-state :initform (c? (if (^pressed) (on-off-toggle .cache) (initial-pb-state self))) :initarg :pb-state ) ( initial-pb-state :cell nil :initform :off :initarg :initial-pb-state :reader initial-pb-state ) ( pressed :cell :ephemeral :accessor pressed :initform (c-in nil)))) (defmacro mk-pushbutton (&rest initargs) `(make-instance 'pushbutton :fm-parent *parent* ,@initargs)) ;(defmacro push-the-button (button-id) ; `(setf (fm^v ,button-id) :pressed)) (defmodel signal-lamp (application-object) ((lamp-state :cell t :accessor lamp-state :initform (c? (if (^switched) (not .cache) (initial-lamp-state self))) :initarg :lamp-state ) ( initial-lamp-state :cell nil :initform :off :initarg :initial-lamp-state :reader initial-lamp-state ) ( switched :cell :ephemeral :accessor switched :initform (c-in nil)))) (defmacro mk-signal-lamp (&rest initargs) `(make-instance 'signal-lamp :fm-parent *parent* ,@initargs)) (defmodel pushbutton-with-signal-lamp (pushbutton signal-lamp) ()) (defmacro mk-pushbutton-with-signal-lamp (&rest initargs) `(make-instance 'pushbutton-with-signal-lamp :fm-parent *parent* ,@initargs)) ;; PSU-APP-RC MODEL (defun control-panel () (list ;; SIGNAL LAMPS ;; Mains signal lamp (mk-signal-lamp :id :mains-lamp ;:lamp-state (cr-mains-lamp-state) ) ;; OPER signal lamp (mk-signal-lamp :id :oper-lamp ;:lamp-state (cr-oper-lamp-state) ) ;; TEST signal lamp (mk-signal-lamp :id :test-lamp ;:lamp-state (cr-test-lamp-state) ) ;; FAIL signal lamp (mk-signal-lamp :id :fail-lamp ;:lamp-state (cr-fail-lamp-state) ) ;; PUSH BUTTONS AND LAMPS ;; Oper mode pushbutton with lamp (mk-pushbutton-with-signal-lamp :id :oper-mode-pb :initial-pb-state :off :lamp-state (c? (if (^pressed) (^pb-state) (initial-lamp-state self))) ) ;; Test mode pushbutton with lamp (mk-pushbutton-with-signal-lamp :id :test-mode-pb :initial-pb-state :off ;:lamp-state (c? (^pb-state)) ) ;; Ua-enable pushbutton with lamp (mk-pushbutton-with-signal-lamp :id :Ua-enable-pb :initial-pb-state :off) ;; Ug1 pushbutton with lamp (mk-pushbutton-with-signal-lamp :id :Ug1-pb :initial-pb-state :off) ;; Ug2 pushbutton with lamp (mk-pushbutton-with-signal-lamp :id :Ug2-pb :initial-pb-state :off) ;; Uh pushbutton with lamp (mk-pushbutton-with-signal-lamp :id :Uh-pb :initial-pb-state :off) ;; Uh pushbutton with lamp (mk-pushbutton-with-signal-lamp :id :Uh-pb :initial-pb-state :off) ) ) (defmodel psu-rc-app (application) ( ;; Mains status (may have several vaklues, :ok indicates OK ;-) ( mains-status :cell t :accessor mains-status :initform (c-in nil) :initarg :mains-status ) ;; Operate status: eitehr :operate-mode or :test-mode ( operate-status :cell t :accessor operate-status :initform (c- in nil) :initarg :operate-status ) ;; RS232C port ;; As soon as the port name is set try to read data from this port ;; DARC stands for Device and Application Remote Control ( darc-rs232c-port :cell t :accessor darc-rs232c-port :initform (c-in nil) :initarg :darc-rs232c-port ) ;; Voltage and current values to be displayed Units ( Ua :cell t :accessor Ua :initform (c-in nil) :initarg :Ua ) ; [ V ] ( Ia :cell t :accessor Ia :initform (c-in nil) :initarg :Ia ) ; [ A ] ( Uh :cell t :accessor Uh :initform (c-in nil) :initarg :Uh ) ; [ V ] ( Ih :cell t :accessor Ih :initform (c-in nil) :initarg :Ih ) ; [ A ] ( Ug1 :cell t :accessor Ug1 :initform (c-in nil) :initarg :Ug1 ) ; [ V ] ( Ig1 :cell t :accessor Ig1 :initform (c-in nil) :initarg :Ig1 ) ; [ mA ] ( Ug2 :cell t :accessor Ug2 :initform (c-in nil) :initarg :Ug2 ) ; [ V ] ( Ig2 :cell t :accessor Ig2 :initform (c-in nil) :initarg :Ig2 ) ; [ mA ] ) ) (defmodel rs232c-port (window) ; needs to be a widget to get a ; timer easily ;-) (( status :accessor status :cell t :initform (c-in :not-connected)) ( device-name :accessor device-name :cell t :initform (c-in nil) :initarg :device-name )) (:default-initargs :id :darc-port :timers (c? (list (make-instance 'timer :state (c-in :off) :repeat t :delay 10000 ; 10 s delay :action (lambda (timer) (declare (ignore timer)) (let ((status (status (darc-rs232c-port *psu-rc-app*))) (device-name (device-name (darc-rs232c-port *psu-rc-app*)))) (if (and (eq status :not-connected) device-name ) (connect-to-darc device-name))))))))) (defun connect-to-darc (device-name) (format t "~%*** connect-to-darc been called for port ~a ...~&" device-name) (when device-name (format t "~%*** Trying to connect to DARC via port ~a ...~&" device-name) ;; Missing: Code that connects to the DARC port via USB ... ;; For now, just return NOT CONNECTED ... :not-connected ) ) (defobserver status ((self rs232c-port)) (format t "~%*** Status of RS232C port ~a is now ~s.~%" (device-name self) (status self)) (when new-value (if (eq new-value :connected) (setf (state (first (timers self))) :off) (setf (state (first (timers self))) :on) ))) ;; HELPER FUNCTIONS ;; Toggles :on to :off and vice versa (defun on-off-toggle (on-or-off) (case on-or-off ( :on :off) ( :off :on ) (otherwise :off))) ; Safety ! Turn off in case of unknown value given ; (= bug in app) ... ;; PSU-RC-APP OBSERVERS (defobserver mains-status ((self psu-rc-app)) (format t "~%*** Mains-status is now ~s.~%" new-value)) (defobserver lamp-state ((self signal-lamp)) (format t "~%*** Signal lamp ~a is now ~s.~%" (id self) new-value)) (defobserver pressed ((self pushbutton)) (format t "~%*** Pushbutton ~a has been pressed (~s).~%" (id self) new-value)) (defobserver switched ((self signal-lamp)) (format t "~%*** Lamp ~a has been switched (~s).~%" (id self) new- value)) ;(defobserver pressed ((self pushbutton-with-signal-lamp)) ; (setf (switched (fm^ (md-name self)) t))) ;; Get a view / window right after making an instance ;; We only allow one instance to run ! (defmethod initialize-instance :after ((self psu-rc-app) &key) (when *psu-rc-app* (error "*** A PSU-APP-RC instance already exists. Only one allowed.")) (setq *psu-rc-app* self) (setf (view self) (make-instance 'psu-rc-app-view)) (setf (darc-rs232c-port self) (make-instance 'rs232c-port))) ;; PSU-RC-APP-VIEW - the view/GUI for the PSU Remote Control Application (defmodel psu-rc-app-view (window) ((selected-oper-pb :cell :ephemeral :accessor selected-oper-pb :initform (c-in nil) :initarg :selected-oper-pb) (selected-test-pb :cell :ephemeral :accessor selected-test-pb :initform (c-in nil) :initarg :selected-test-pb)) (:default-initargs :id :psu-rc-app-view :kids (c? (the-kids (app-menubar) (control-panel) (darc-setup-panel) )))) ;(defmethod initialize-instance :after ((self psu-rc-app-view) &key) ; (tk-format '(:configure "title") "wm title . ~a" (slot-value self 'title$))) (defobserver title$ ((self window)) (tk-format '(:configure "title") "wm title . ~a" (or new-value "Untitled"))) (defun app-menubar () (mk-menubar :id :psu-rc-menu-bar :kids (c? (the-kids (mk-menu-entry-cascade-ex (:label "File") (mk-menu-entry-command :label "Quit" :command "exit")) (mk-menu-entry-cascade-ex (:label "Operate") (mk-menu-entry-command :label "Set Mains Status to :OK" :command (c? (tk-callback .tkw 'set-mains-ok (lambda () (setf (mains-status *psu-rc-app*) :ok))))) (mk-menu-entry-command :label "Action: Push the OPER MODE button" :command (c? (tk-callback .tkw 'push-oper- mode-pb (lambda () (setf (pressed (fm^ :oper-mode-pb)) t)))) ) ) ) ) ) ) (defun darc-setup-panel () ; <<< frgo: HERE (mk-stack () (mk-row () (mk-label :text "DARC RS232C Port Device Name:") (mk-entry :id :darc-port-device-name :md-value (c-in "") :background "grey")) (mk-row () (mk-label :text "DARC Connect Status:") (mk-canvas ;; :height 40 :width 40 :kids (c? (the-kids (mk-rectangle :coords '(0 0 40 40) :tk-fill (c? (if (eq (if (darc-rs232c-port *psu-rc-app*) (status (darc-rs232c-port *psu-rc-app*)) nil) :connected) "green" "red"))))))) (mk-row () (mk-label :text (c? (if (darc-rs232c-port *psu-rc-app*) (status (darc-rs232c-port *psu-rc-app*)) "")) :relief 'sunken)))) (defun run-psu-rc-app () (cells-reset 'tk-user-queue-handler) (tk-test-class 'psu-rc-app))

3 4

[cells-devel] Re: Celtk/Cells: Need a little help...
by Frank Goenninger 12 Apr '06

12 Apr '06

Am 12.04.2006 um 22:26 schrieb Ken Tilton: > >> >> (setf (pb-state (fm^ :oper-mode-pb)) ;; FRGO: >> HERE !!! >> (on-off-toggle >> (fm^v :oper-mode-pb)))))) ;; FRGO: >> HERE !!! > > > (mk-menu-entry-command > :label "Action: Push the OPER MODE button" > :command (c? (tk-callback .tkw 'push-oper- > mode-pb > (lambda () > (setf (fm^v :oper-mode-pb) ;; FRGO: HERE !!! > (on-off-toggle > (fm^v :oper-mode-pb)))))) ;; FRGO: > HERE !!! > ) > > We have three slots in play now: .md-value, enabled, and pb- > state. .md-value because fm^v expands to (md-value (fm^ ...)) > > As the ltktest-cells-inside doc says, I like to use the slot md- > value of an instance the same way TK treats the name of an instance > as a variable, namely to hold the key value that instance > represents in the application. > > It is not clear to me that enabled is that slot, even tho you have > the pb-state initarg associated with it. I would think that pb- > state is currently playing the key role of holding the key on/off > value. This is confirmed by you setting the toggle result into pb- > state. > > On the other hand, I see pb-state is ephemeral. I also see: > > (defmacro push-the-button (button-id) > `(setf (fm^v ,button-id) :pressed)) > > Now there you are setting the md-value to :pressed, but since I see > toggle intentions, I am guessing this is a button that gets pressed > and then released then pressed again, and the second time produces > the opposite value as the first. So, putting it all together (and > throwing out altogether enabled since I see that is not yet > implemented): > > (defmodel pushbutton (application-object) > ((.md-value :cell t :accessor pb-state :initform (c-in :off)))) > > (mk-menu-entry-command > :label "Action: Push the OPER MODE button" > :command (c? (tk-callback .tkw 'push-oper-mode-pb > (lambda () > (setf (fm^v :oper-mode-pb) > (on-off-toggle > (fm^v :oper-mode-pb))))))) > > If you want to get a little fancier: > > (defmodel pushbutton (application-object) > ((.md-value :cell t :accessor pb-state > :initform (c? (if (^pressed) > (on-off-toggle .cache) > (initial-pb-state self)))) > (pressed :cell :ephemeral :intiform (c-in nil) ... etc) > (initial-pb-state :cell nil ....etc ))) > > (mk-menu-entry-command > :label "Action: Push the OPER MODE button" > :command (c? (tk-callback .tkw 'push-oper-mode-pb > (lambda () > (setf (pressed (fm^ :oper-mode-pb)) t))))) > > The latter can be good for doing things like associating a click > sound with the button press, because then you just have other cells > watching (^pressed). Otherwise you end up loading more and more > code into the menu callback. > > hth, ken You wonder if this helps? You just not only discovered some bugs but also explained to me .cache and real use of .md-value ... It certainly helps!! Thanks so much. Frank

1 0

Re: [cells-devel] initial stab at using Cells
by Ken Tilton 11 Apr '06

11 Apr '06

On 4/10/06, Jack Unrue <jdunrue(a)gmail.com> wrote: > > I feel the need to strike the right balance between UI/logic separation > vs. taking full advantage of Cells. Oh, if you are big on separation maybe you can confirm something I suspect, namely that Cells, by allowing different instances of the same class to have different rules for the same slot, makes OO design. For example, one can have a game normally look like: (make-instance 'game :speed (c? (* (^difficulty-slider) 500))... But then for debugging a hard problem you might want to play back a log at full speed and so the replay code goes: (make-instance 'game :speed 500... In the first case the game /instance/ is being driven by the GUI slider widget, but the game /class/ does not know about the GUI. Does that make sense in resolving the separation issue? ken

2 2

← Newer
1
...
35
36
37
38
39
40
41
...
57
Older →

Jump to page:

2024

2023

2022

2021

2020

2019

2018

2017

2016

2015

2014

2013

2012

2011

2010

2009

2008

2007

2006

2005

2004

2003

cells-devel