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