[cells-devel] Celtk/cells: No Widgets! Help!
Ken Tilton
kentilton at gmail.com
Thu Apr 13 21:23:03 UTC 2006
Did you get the bit I sent to prion.de? I will resend to your mac account.
On 4/13/06, Frank Goenninger <fgoenninger at prion.de> wrote:
>
> 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)
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.
How do I debug what is being sent to wish ?
Hack ctk::tk-format-now in various ways to see all or selected messages.
Totally late, gotta run, but will resend shortly.
kt
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*
> , 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 :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))
>
> _______________________________________________
> cells-devel site list
> cells-devel at common-lisp.net
> http://common-lisp.net/mailman/listinfo/cells-devel
>
-------------- next part --------------
An HTML attachment was scrubbed...
URL: <https://mailman.common-lisp.net/pipermail/cells-devel/attachments/20060413/be5870ee/attachment.html>
More information about the cells-devel
mailing list