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

String Blinkers & Dynamic Windows Working Together

I got some help from Charles Lamb of Symbolics. He handled the scrolling
issue and the only thing I needed to change was that the presentation
display of the string needs to be a string of blanks (of length = string)
so that it does not interfere with the string blinker display (see below).
I have it working in my application now and if you have any questions,
contact me.

- Will

Date: Mon, 18 Jan 88 16:34 EST
From: Charles Lamb <Lamb@SAPSUCKER.SCRC.Symbolics.COM>
Subject: String Blinkers & Dynamic Windows
    Date:    Thu, 14 Jan 88 17:32:15 PST
    From:     TAYLOR%PLU@ames-io.ARPA
    I have been trying to use string blinkers in a dynamic window -
    (dw:with-output-as-presentation (:type 'string :object "string blinker"
       :stream <stream> :single-box t)
      (setf *blinker* (tv:make-blinker <stream> 'tv:string-blinker
    where <stream> is a dynamic window. The blinker is created, but
    does not scroll with the dynamic window and is not mouse
    sensitive. Is there something I missed or is this a capability
    that does not exist yet?  Anyone else fooled with this stuff?
    - thanks - will    taylor%plu@io.arc.nasa.gov
Blinkers are not presentations, so they don't constitute output to a
window.  One thing that you could do is to present the string, and then
make a string blinker with the same string at the same position.
The second problem that you're seeing (blinkers not scrolling with the
window) is because blinkers are only really put on the "inside" of the
sheet.  That means that if you want to scroll the blinker (in a dynamic
window), you have to manually turn the blinker on and off when it is no
longer visible, as well as move it to the correct position.
I've cooked up some simple code which presents a string as a blinker.
Although after seeing your second message, I'm not sure that this is
exactly what you want.  I don't guarantee that it will work in all
cases, but it should put you on the right track.  If you happen to use
it, be careful when debugging the :after method on
:set-viewport-position.  A breakpoint in there can throw you into the
cold load stream.
I hope this is useful.
;;; -*- Mode: LISP; Syntax: Common-lisp; Package: USER; Base: 10 -*-
(defflavor scrollable-blinker-mixin
	(abs-x abs-y)
  (:required-init-keywords :abs-x :abs-y))
(defmethod (:set-viewport-position dw:dynamic-window :after) (new-left new-top)
  new-left new-top
  (dolist (blinker tv:blinker-list)
    (when (typep blinker 'scrollable-blinker-mixin)
      (let* ((abs-x (scrollable-blinker-mixin-abs-x blinker))
	     (abs-y (scrollable-blinker-mixin-abs-y blinker))
	     (viewport dw::cursor-viewport)
	     (left (dw:box-left viewport))
	     (right (dw:box-right viewport))
	     (top (dw:box-top viewport))
	     (bottom (dw:box-bottom viewport)))
	(cond ((and (< left abs-x right) (< top abs-y bottom))
	       (send blinker :set-visibility :blink)
	       (multiple-value-bind (x y)
		   (send self :convert-to-relative-coordinates abs-x abs-y)
		 (send blinker :set-cursorpos x y)))
	       (send blinker :set-visibility nil)))))))
(defflavor scrollable-string-blinker
	(tv:string-blinker scrollable-blinker-mixin))
(defun present-string-blinking (string &optional (stream *standard-output*) &rest options)
  (let* ((presentation (present string 'string :stream stream))
	 (box (dw:presentation-displayed-box presentation))
	 (left (dw:box-left box))
	 (top (dw:box-top box)))
    (multiple-value-bind (inside-x inside-y)
	(send stream :convert-to-relative-coordinates left top)
      (apply #'tv:make-blinker (si:follow-syn-stream stream) 'scrollable-string-blinker
	     :x-pos inside-x :y-pos inside-y
	     :abs-x left :abs-y top
	     :string string


I did the following: (code segments)


;               Charles Lamb <Lamb@SAPSUCKER.SCRC.Symbolics.COM>
	((abs-x -10)			; initially out of viewport
	 (abs-y -10))

;; create blinkers

(let ((task-name-list (send schedule-object :task-name-list))
      (object-list ()))
  (dolist (task-name task-name-list)
    (setq object-list (append object-list	; assoc list - parsed task name as key
			      (list (list task-name
					  (tv:make-blinker (si:follow-syn-stream self)
							   :style *task-resource-bold-character-style*
							   :half-period 30.
							   :deselected-visibility :off
							   :visibility nil
							   :string (string task-name)))))))
  (send schedule-object :set-task-blinker-list object-list))


(let ((blinker-obj (second (assoc name task-blinker-list)))
      (blinker-y (- label-y 8)))
  (send blinker-obj :set-cursorpos label-start-x blinker-y)
  (send blinker-obj :set-abs-x label-start-x)
  (send blinker-obj :set-abs-y blinker-y))


(dw:with-output-as-presentation (:stream self :object string-name :type 'string :single-box t)
	;; put presentation box around string blinkers
	(graphics:draw-string (make-string string-length :initial-element #\ )
			      start-x label-y :stream self)


(defmethod (:DISPLAY ASAP-DISPLAY-WINDOW) (schedule-object &rest ignore)
  "display asap window for mode = :init or :scale"
  ;; .....
   (send *tasks-pane* :display schedule-object)
    (send *tasks-header-pane* :display schedule-object)
    (send *resources-header-pane* :display schedule-object)	; order of tasks/resources panes required
    (send *resources-pane* :display schedule-object)
    (send *plot-pane* :display schedule-object)	; *plot-header-pane* called from *plot-pane*
    ;; ....
      (send *scroll-pane* :X-SCROLL-TO (ceiling (* pixel-per-time relative-display-start)) :absolute))))

(defmethod (:Y-SCROLL-TO TASK-RESOURCE-HEADER-PANE-MIXIN :AFTER) (y mode &rest ignore)
  "automatically scroll display pane including string blinkers vertically when this one is scrolled"
  ;; ...
     (dolist (assoc-list-item (send *current-schedule-object* :task-blinker-list))
       (send *scroll-pane* :scroll-string-blinker (second assoc-list-item) *tasks-pane*))

(defmethod (:SCROLL-STRING-BLINKER SCROLL-PANE) (blinker stream)
  "move string blinker in dynamic window and turn blinker on/off accordingly"
  ;;               Charles Lamb <Lamb@SAPSUCKER.SCRC.Symbolics.COM>
  ;; generic-panes.lisp has :y-scroll-to method which calls this method
  (let* ((abs-x (send blinker :abs-x))
	 (abs-y (send blinker :abs-y))
	 (viewport (send stream :cursor-viewport))
	 (left (dw::box-left viewport))
	 (right (dw::box-right viewport))
	 (top (dw::box-top viewport))
	 (bottom (dw::box-bottom viewport)))
    (cond ((and (< left abs-x right) (< top abs-y bottom))
	   (send blinker :set-visibility t)
	   (multiple-value-bind (x y)
	       (send stream :convert-to-relative-coordinates abs-x abs-y)
	     (send blinker :set-cursorpos x y)))
	   (send blinker :set-visibility nil)))))