[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

Program Framework Title Panes and REDISPLAY-FUNCTION

I'm having problems getting output to the title pane of a program
framework using :redisplay-function.  Perhaps someone can identify a way
to modify my code to get the desired effect.

Assuming I have a program framework defined with a title pane like this:

	       :more-p nil
	       :deexposed-typeout-action :permit
	       :BLINKER-P T
				    (DW:MARGIN-LABEL :STRING "Erasmus Listener"
						     :STYLE (:FIX :ITALIC :NORMAL))

For the Symbolics version of the title pane's redisplay function
(ERASMUS-FRAME-TITLE) here's what we have:

(defun erasmus-frame-title (program stream)
  (declare (ignore program))
  (send stream :set-default-character-style '(:dutch :bold :large))
  (multiple-value-bind (ignore y)
      (send stream :draw-horizontally-centered-string "Erasmus" 0)
    (send stream :set-default-character-style '(:fix :roman :very-small))
    (send stream :draw-horizontally-centered-string
	  (+ y 2))))

The intent is to write "Erasmus" and "COPYRIGHT (C) 1990 THE BOEING
COMPANY" in the title pane.  The method
:DRAW-HORIZONTALLY-CENTERED-STRING is a locally defined method which
centers the strings in the window.

We tried this as an EW alternative:

(defun erasmus-frame-title (program stream)
  (declare (ignore program))
  (ew::set-window-style stream '(:dutch :bold :large))
    (ignore y)
      (draw-horizontally-centered-string stream "Erasmus" 0)
    (ew::set-window-style stream '(:fix :roman :very-small))
    (draw-horizontally-centered-string stream
	  (format nil "COPYRIGHT (C) ~s THE BOEING COMPANY"
		  (multiple-value-bind (sec min hr day mo yr) (cl:get-decoded-time)
		    (declare (ignore sec min hr day mo)) yr))
	  (+ y 2))))

The problem is that "Erasmus" is not drawn on the screen at all (or that
I can see).  The "COPYRIGHT ..." string appears in the Listener Pane (it
is centered, though :-) and it doesn't appear to be in the proper

Here's the definition for :DRAW-HORIZONTALLY-CENTERED-STRING for the

(defmethod (:draw-horizontally-centered-string graphics-mixin)
	   (string from-y &optional (font current-font) (alu char-aluf)
		   (inside-width (send self :inside-width)) (xoffset 0))
  "Draw string centered on the line whose y-coordinate is from-y; i.e. the top of
characters drawn will be at from-y.  string will be centered with respect to the
horizontal region from xoffset to (xoffset + inside-width).  Use font and alu
as specified.  The default behavior is to ceneter the string with respect to the
entire line"
  (let* ((string-width (erasmus::string-pixel-width string font))
	 (from-x (+ xoffset (max 0 (floor (- inside-width string-width) 2))))
	 (char-alu char-aluf))
    (setq current-font font char-aluf alu)
    (send self :set-default-character-style (si:backtranslate-font font))
    (send self :set-cursorpos from-x from-y)
    (send self :string-out string)
    (setq char-aluf char-alu)
    (values from-x (+ from-y
		      (send self :vsp)
		      (zl:font-char-height current-font)))))

and our try at a version for EW:

(pcl:defmethod draw-horizontally-centered-string ((self ew::program-title-pane)
	   string from-y &optional (font (ew::window-font self)) alu
		   (inside-width (ew::window-inside-width self)) (xoffset 0))
  (declare (ignore alu))
  (let* ((string-width (string-pixel-width string font))
	 (from-x (+ xoffset (max 0 (floor (- inside-width string-width) 2)))))
    (setf (ew::window-font self) font)
    (ew::set-window-style self (xfonts::backtranslate-font font))
    (ew:draw-string string from-x from-y)
    (values from-x (+ from-y
		      (ew::window-line-spacing self)
		      (ew::font-height font)))))

BTW, we defined a function called BACKTRANSLATE-FONT in fonts.lisp:

(defun backtranslate-font (font &rest ignore)
  (if (equal font *Cached-Font*) *Cached-Font-Style*
      (loop named find-the-font
	    for family in *font-table*
	    do (loop for faces in (rest family)
		     do (loop for (size xfont) in (rest faces)
			      when (equal xfont font)
				do (return-from find-the-font (list (first family) (first faces) size)))))))

Any ideas, thoughts?  I guess the stream passed to ERASMUS-FRAME-TITLE
should be a stream for the TITLE pane.  I s'pose I should go digging
through the code to find it ...  Naw, it's the end of the day.
Tomorrow, ...  maybe.  :-)

Stephen L. Nicoud  <snicoud@atc.boeing.com>  uw-beaver!bcsaic!snicoud
Boeing Advanced Technology Center for Computer Sciences