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))
Frank,
I see a few things. Deets next, but first my inclination is to leave the problems in place and work on the core to provide helpful error messages where possible (I will do anything to avoid writing documentation <g>). This will have the advantage over documentation in that it will catch careless veteran mistakes as well as newby mistakes.
Issues:
1. darc-setup-panel begins:
(defun darc-setup-panel () (mk-stack () <list of widgets>))
That is good in one respect, contrasted with control-panel, which begins
(defun control-panel () (list <list-of-widgets>))
That is not absolutely the end of the world, because the-kids here:
(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) ))))
Will flatten out the list returned by control-panel. In the end, every component listed by control-panel becomes a top-level widget of the window, meaning it needs packing instructions. And this brings us to the problem with the darc-setup-panel: it needs packing, too.
If you use stacks and rows, their kids get default packing. But the toplevel widget in a window does not get default packing. I tried that, but it gets in the way of the parent trying to do packing if the kids are doing packing. To do custom packing, one first must specify nil values for kid-packing values, then one has to pack each kid manually. I would explain that more, but let's just use stacks and rows.
I do not know how you visualize the outcome, but I see two big stacks coming, so:
control-panel now starts: (mk-stack () <widgets>)
and psu-rc-app-view kids becomes: (the-kids (app-menubar) (mk-row (:packing (c?pack-self)) ;; accept all TK packing defaults (control-panel) (darc-setup-panel))))
btw, if you check the lotsa-widgets demo you will see it starts that way. My policy when working with hairy libraries (like Celtk, I admit) is to take some sample code, make sure it works, and then rename it "kennys-new-app" and change things only as I need to. That let's me avoid /reading/ doc. (Notice a trend?) Eventually all the original code is gone and I understand what remains. Anyway...
With the above changes I now get a complaint about signal-lamp not having a path method, and I see that that is an "application-object", which suggests to me that you do not want it in the GUI at all, that all those are part of the model. I think we are on the verge of some deep OO design issues here. :) Let me send this off and stare at the code some more.
kt
Am 13.04.2006 um 21:04 schrieb Ken Tilton:
Frank,
I see a few things. Deets next, but first my inclination is to leave the problems in place and work on the core to provide helpful error messages where possible (I will do anything to avoid writing documentation <g>). This will have the advantage over documentation in that it will catch careless veteran mistakes as well as newby mistakes.
Understood.
Issues:
- darc-setup-panel begins:
(defun darc-setup-panel () (mk-stack () <list of widgets>))
That is good in one respect, contrasted with control-panel, which begins
(defun control-panel () (list <list-of-widgets>))
That is not absolutely the end of the world, because the-kids here:
(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) ))))
Will flatten out the list returned by control-panel. In the end, every component listed by control-panel becomes a top-level widget of the window, meaning it needs packing instructions. And this brings us to the problem with the darc-setup-panel: it needs packing, too.
If you use stacks and rows, their kids get default packing. But the toplevel widget in a window does not get default packing. I tried that, but it gets in the way of the parent trying to do packing if the kids are doing packing. To do custom packing, one first must specify nil values for kid-packing values, then one has to pack each kid manually. I would explain that more, but let's just use stacks and rows.
I do not know how you visualize the outcome, but I see two big stacks coming, so:
control-panel now starts: (mk-stack () <widgets>)
and psu-rc-app-view kids becomes: (the-kids (app-menubar) (mk-row (:packing (c?pack-self)) ;; accept all TK packing defaults (control-panel)
No. Control Panel is currently just the model. No View yet.
(darc-setup-panel))))
This is a View with an integrated model. No really pure OO just a quick hack.
I see I should do a widget hierarchy that looks like
window | +--- frame (= darc-setup-panel-frame) | | | |--- row | |--- ... | ----- frame (= control-panel-frame) | |---- row |--- .... Here the yet not coded control panel widgets should go in.
btw, if you check the lotsa-widgets demo you will see it starts that way. My policy when working with hairy libraries (like Celtk, I admit) is to take some sample code, make sure it works, and then rename it "kennys-new-app" and change things only as I need to. That let's me avoid /reading/ doc. (Notice a trend?) Eventually all the original code is gone and I understand what remains. Anyway...
With the above changes I now get a complaint about signal-lamp not having a path method, and I see that that is an "application- object", which suggests to me that you do not want it in the GUI at all, that all those are part of the model. I think we are on the verge of some deep OO design issues here. :)
Yep. As I admitted: Just a quick hack so far to test out several things.
Let me send this off and stare at the code some more.
kt
Now let me code some more to come up with a clean Model/View separation and with your inputs included.
THX!
Frank
Frank Goenninger wrote:
No. Control Panel is currently just the model. No View yet.
OK. Well, I guess there is no problem having non-GUI model (vs view, that is) instance as kids of the Window. If they are not subclasses of TK widgets, they will just sit there but still be in the fm-find*-able namespace, which is probably a good thing. Note tho that you could just stick them someplace else and still use the fm-find* routines by providing that someplace else as an argument to the fm-find stuff.
(darc-setup-panel))))This is a View with an integrated model. No really pure OO just a quick hack.
I see I should do a widget hierarchy that looks like
window | +--- frame (= darc-setup-panel-frame) | | | |--- row | |--- ... | ----- frame (= control-panel-frame) | |---- row |--- .... Here the yet not coded control panel widgets should go in.
OK, just remember to specify the :packing argument (or get fancy and try grid or place, but I do not think I have any support yet for place) for the toplevel frames.
kt
Am 14.04.2006 um 17:50 schrieb Ken Tilton:
Frank Goenninger wrote:
No. Control Panel is currently just the model. No View yet.
OK. Well, I guess there is no problem having non-GUI model (vs view, that is) instance as kids of the Window. If they are not subclasses of TK widgets, they will just sit there but still be in the fm-find*-able namespace, which is probably a good thing. Note tho that you could just stick them someplace else and still use the fm-find* routines by providing that someplace else as an argument to the fm-find stuff.
(darc-setup-panel))))This is a View with an integrated model. No really pure OO just a quick hack.
I see I should do a widget hierarchy that looks like
window | +--- frame (= darc-setup-panel-frame) | | | |--- row | |--- ... | ----- frame (= control-panel-frame) | |---- row |--- .... Here the yet not coded control panel widgets should go in.
OK, just remember to specify the :packing argument (or get fancy and try grid or place, but I do not think I have any support yet for place) for the toplevel frames.
kt
I remembered. And did it. Now the widgets appear. Yeah!
Now back to the initialization timing condition stuff...
Frank
-
Frank Goenninger -
Ken Tilton