[cells-devel] Celtk/cells: timing issue in initialization and No Widgets :-(
Frank Goenninger
fgoenninger at prion.de
Thu Apr 13 17:47:56 UTC 2006
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*
, at 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*
, at 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*
, at 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))
More information about the cells-devel
mailing list