CLIM mail archive
[Prev][Next][Index][Thread]

Multiple frames under Genera

Hi folks,

In an AI&Ed application we are building, we use lots of frames which
run under Allegro CL as independant processes. Those frames are
indexed in some hierarchical structure in a state variable of a parent
frame.  (E.g. on the top of our application we have a global variable
which holds an instance of the control frame holding several learner
frames which can run on different displays. Each learner frame in turn
has several children, and so on. This way frames can be created and/or
exposed by the user or the program.

How can I do that under Genera ? I got an old 3620 sitting around idle
and I'd like to do the same thing, but frames block each other, i.e.
once a frame is exposed, I can't use its parent frame anymore. Any
hints what I'd have to do in order to get a clim program running with
non-monolitic non-egoistic frames? Or do I need to be more precise?
See the ugly thing I tried below with #genera

Sorry if I'm wasting a bit of bandwith. But, as soon as we get a
half-baked alpha version running (in a month or so), we'll make it
available to the world via FTP. And in a year or so we'll distribute
a nice beta version of this intelligent learning environment. Yeah.

              - thanx !!!  - Daniel

;; --------------------------- bits of code ----------------------------
;;; warning: this is incomplete, it's here to illustrate

(defclass memolab-frame-mixin ()
	  ((name-string :initarg :name-string
			:initform "Unnamed Memolab Frame"
			:accessor frame-name-string)
	   (symbolic-name :initarg :symbolic-name
			:initform 'unknown-frame
			:accessor frame-symbolic-name)
	   ;; contains the process of a frame (Allegro, ?? under Genera)
	   (process :initarg :process
		    :initform nil
		    :accessor frame-process)
	   (associated-frames-defs :initarg :associated-frames-defs
				   :initform nil
				   :accessor frame-associated-frames-defs)
	   ;; contains the various (sub and associated) frames
	   ;; in an assoc list, (e.g. help hypertexts,)
	   (associated-frames :initarg :associated-frames
			      :initform nil
			      :accessor frame-associated-frames)
	   ;; contains ALL the various (sub) frames.
	   ;; those are not used for access, but just to kill dependent stuff
	   (sub-frames :initarg :sub-frames
		       :initform nil
		       :accessor frame-sub-frames)
	   ;; contains eventual parent frames
	   ;; -- do we need a list here $$??, for control??
	   (parent-frame :initarg :parent-frame
			 :initform nil
			 :accessor frame-parent-frame)
	   )
  (:documentation
   "A Memolab CLIM application frame"))


;; this is an example which shows how I associate child frames to a parent
(DEFINE-application-FRAME
 learner
 (clim:application-frame memolab-frame-mixin)

 (
  ;; ==== ==== system variables -- add intiargs when needed
  (oops-learner :initform nil       :accessor learner-oops-learner)
  (control      :initform 'total    :accessor learner-control)
  ;; ---- ---- Note: all frames belonging to the learner
  ;;           are put in the slot associated-frames
  (associated-frames-defs
   :initform '((memolab-coach
		:class memolab-coach
		:pretty-name "Memolab Coach"
		:parent parent
		:select-key #\k ;; koach !
		:top 10
		:left 300
		:width 500
		:height 300
		)
	       (memolab
		:class memolab
		:pretty-name "Memolab Laboratory"
		:left 100
		:select-key #\ ;; symbol-l
		:top 100
		:width 700
		:height 600)
	       (methodology
		:class hyper
		:pretty-name "Handbook of Methodology"
		;; #+genera :select-key #+genera #\circle
		:left 10
		:top 10
		:height 600
		:width 600
		:data-file "~/memolab/hyp/methodology.hypertext.com"
		)
	       ;;; lots of frames deleted here .....
	       )
   ))
 (:PANES
  ;; the panes used in the hyper system, (multiple configurations)
  (
   (random :application :scroll-bars nil
	   :DEFAULT-TEXT-STYLE '(:SANS-SERIF :ROMAN :very-SMALL))
   (menu :command-menu
	 :DEFAULT-TEXT-STYLE '(:SANS-SERIF :ROMAN :very-SMALL)
	 :vsp 0)
   ))
 (:layout
  ((default
    (:column 1
	     (menu 0.95)
	     (random :rest)
	     )))
  )					;layout
 )



(defmethod frame-instantiate-associated-frame ((frame clim:application-frame)
					       definition-list &optional spec-server-path)
  "takes a definition list for an associated frame and instantiates it"
  (run-application
   (find-item :class definition-list)
   :symbolic-name  (first definition-list)
   :pretty-name    (find-item :pretty-name   definition-list)
   :left           (find-item :left          definition-list)
   :top            (find-item :top           definition-list)
   :height         (find-item :height        definition-list)
   :width          (find-item :width         definition-list)
   :select-key     (find-item :select-key    definition-list)
   :slave-process  (find-item :slave-process definition-list)
   :caller         frame
   :data-file      (find-item :data-file     definition-list)
   :parent        (if spec-server-path
		      spec-server-path
		    (window-parent (frame-top-level-window frame)))
   ))

#+allegro
(defun run-application (class  &key
			(symbolic-name class)
			(pretty-name "random frame")
			(select-key nil)
			(parent (get-server-path))
			(left 50)
			(top 50)
			(height 200)
			(width 200)
			(caller nil)
			(slave-process nil)
			(data-file nil)
			)
  "launches an application with the right parameters"
  (declare (ignore select-key))
  (let ((app
	 (clim:make-application-frame class
				      :pretty-name pretty-name
				      :parent      parent ; clim root window
				      :left        left
				      :top         top
				      :height      height
				      :width       width
				      :parent-frame caller ; our parent frame
				      :symbolic-name symbolic-name
				      )))
    ;; ---- launch the frame
    (if slave-process
	;; for small dependent tasks where the user HAS to exit.
	;; not used currently, DOESN't work this way
	(run-frame-top-level app)
      ;; each memolab application frame knows its own process
      (setf (frame-process app)
	(mp:process-run-function
	 (format nil "~a" (gensym (format nil "~A-" (string-upcase pretty-name))))
	 #'clim:run-frame-top-level app)))
    ;; ---- we register the new frame as associated-frame of the caller
    ;;      and we put it in the sub-frame-list of ALL its parents
    (if caller
	(progn
	  (push (cons symbolic-name app) (frame-associated-frames caller))
	  (frame-register-sub-frame caller app)
	  ))
    (if data-file
	(progn (sleep 2)
	       (load-data-file app data-file)))
    app)
  )


#+genera
(defun run-application (class  &key
			(symbolic-name class)
			(pretty-name "random frame")
			(select-key nil)
			(parent (get-server-path))
			(left 50)
			(top 50)
			(height 200)
			(width 200)
			(caller nil)
			;; (exposed-p t)
			(data-file nil)
			)
  "launches an application with the right parameters"
  (let ((app
	 (clim:make-application-frame class
				      :pretty-name pretty-name
				      :parent      parent ; clim root window
				      :left        left
				      :top         top
				      :height      height
				      :width       width
				      :parent-frame caller ; our parent frame
				      :symbolic-name symbolic-name
				      )))
    ;; ????????
    (eval `(clim:define-genera-application
	     ,class
	     :pretty-name ,pretty-name
	     :select-key  ,select-key
	     ))
    ;; ---- launch the frame
    ;; each memolab application frame knows its own process
    ;; (clim:run-frame-top-level app)
    ;; ---- we register the new frame as direct-sub-frame of the caller
    ;;      and as sub-frame of ALL its parent
    (if caller
	(progn
	  (push (cons symbolic-name app) (frame-associated-frames caller))
	  (frame-register-sub-frame caller app)
	  ))
    (if data-file
	(load-data-file app data-file))
    app)
  )


(defmethod frame-get-associated-frame ((frame clim:application-frame)
				       symbolic-name &optional special-server-path)
  ;; --- 0 --- it is the frame itself
  (if (eq (frame-symbolic-name frame) symbolic-name)
      frame
    ;; --- 1 --- try to get an instantiated frame
    (let ((found-frame
	   (cdr (assoc symbolic-name (frame-associated-frames frame)))))
      (if (and found-frame
	       (not special-server-path))  ;; here we force a new frame in any case
	  found-frame
	;; --- 2 --- try to instantiate a frame
	(let ((frame-definition
	       (assoc symbolic-name (frame-associated-frames-defs frame))))
	  (if frame-definition
	      (frame-instantiate-associated-frame
	       frame frame-definition special-server-path)
	    ;; --- 3 --- try to see if the parent can help
	    (if (frame-parent-frame frame)
		(frame-get-associated-frame (frame-parent-frame frame)
					    symbolic-name special-server-path)
	      ;; --- 4 ---  means failure
	      nil)))))))
	     

(defmethod expose-associated-frame ((frame clim:application-frame)
				    symbolic-name &optional server-path)
  (let ((associated-frame
	 (frame-get-associated-frame frame symbolic-name server-path)))
    (frame-expose associated-frame)
    ;; return the frame - important !!
    associated-frame
    ))

;#+genera
;(defmethod expose-associated-frame ((frame clim:application-frame) symbolic-name)
;  (let ((associated-frame
;	  (frame-get-associated-frame frame symbolic-name)))
;    (dw:find-and-select-program-window
;      (frame-name associated-frame))
;    associated-frame))


----------------------

Daniel K.Schneider, TECFA (Educational Technologies and Learning)
Faculte de Psychologie et des Sciences de l'Education, University of Geneva,
1211 Geneva 4 (Switzerland), Tel.(..41)22 705 7652, Fax. (..41) 22 20 29 27.

Internet:   schneide@divsun.unige.ch  (and various national nets)    | if reply
CSnet/ARPA: schneide%divsun.unige.ch@relay.cs.net   (old style)      | does not
X400:       S=schneide;OU=divsun;O=unige;PRMD=switch;ADMD=arcom;C=ch | work,
uucp:       mcvax!cui!divsun.unige.ch!shneider                       | try one
BITNET:     schneide@cgeuge51                                        | of
DECNET:     UGUN2A::SCHNEIDE (local Swiss)                           | these
Main Index | Thread Index