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

lost mail recovered

>From root Fri Mar 17 14:30:08 MET 1989 remote from ethz

>From iis!cernvax!scsult.uucp.arcom.ch!csnet Mon Mar 13 17:19:22 1989 remote from ethz
Received: by cernvax.uucp (1.2/Ultrix2.0-B)
	id AA25875; Mon, 13 Mar 89 17:19:22 +0100
Date: 13 Mar 89 17:16
From: "J. Penberthy" <cernvax!ibm.com!JSP>
To: mcc.com!vaughan, warbucks.ai.sri.com!slug
In-Reply-To: <19890303173252.7.VAUGHAN@PASSPORT.CAD.MCC.COM>
Message-Id: <19890313142612.1&JSP@ESCHER>

>Character-Type-Mappings: (1 0 (NIL 0) (NIL :BOLD NIL) "CPTFONTCB")

                         (2 0 (NIL 0) (NIL :ITALIC NIL) "CPTFONTI")
Fonts: CPTFONT, CPTFONTCB, CPTFONTI

Paul,

     The bug with the "munged outer box" is probably due to a bug I
found in the 1graphics:replacing-graphics-presentation0 function.
The patch below fixes this -- there is only a bit of flicker when you
move one presentation over another.  This seems unavoidable.

     Does anyone else have any other ideas?

Scott

;;; -*- Mode: Lisp; Package: GRAPHICS; Syntax: Common-Lisp; Base: 10; Vsp: 0; Patch-File: Yes -*-

2;;; Created 9/09/88 18:02:27 by J. Scott Penberthy
;;; using Lisp Machine M. C. Escher at HAWTHORNE


;;; The previous version of this function accidentally erased portions
;;; of the screen when replacing old graphics presentations.  The old
;;; routine would first determine a bounding rectangular region that
;;; covered both the new and old presentations.  This area of the screen
;;; was then XOR'd with a bitmap of the new presentation (BITMAP) and
;;; then stored in the local variable BITMAP.  BITMAP would therefore
;;; contain a portion of the old screen XORd with the bitmap for the new
;;; presentation.  When BITMAP was XORd with the physical screen, all of
;;; the screen bounded rectangular region would be erased, 0except 2for
;;; the area containing the new presentation.
;;;
;;; This algorithm was *almost* correct.  I imagine the programmer
;;; wanted to simply XOR away the old presentation and XOR in the new
;;; presentation with a singular BITMAP mask.  What s/he actually did,
;;; however, was to XOR away an entire portion of the screen bounded by
;;; LEFT, TOP, RIGHT, BOTTOM.  I fixed this bug by initially XORing only
;;; that portion of the screen covered by the old presentation.  This
;;; code section is delimited by down- & up-arrows.
;;;
;;; I also had to change the 0:redisplay-overlapping-presentations2 option
;;; to T when erasing the old presentation from the history.
;;; Unfortunately, this results in a bit of flicker when an object is
;;; replaced over "busy" areas of the screen.  A better approach would
;;; somehow bitblt this information onto the window.  However, I'm
;;; leaving that up to Symbolics or someone else in SLUG.
;;;
;;; Lastly, I had to add a few SETFs to ensure the the object and type
;;; of the presentation being replaced are not lost.
;;;
;;; Please fix this for the next release...
;;;
;;; Scott

0(defun1 replacing-graphics-presentation-internal0 (continuation xstream presentation
						 &key pattern-array bitmap-stream)
  (if (null presentation)
      (with-output-as-graphics-presentation (xstream)
	(funcall continuation xstream))
    (flet ((use-bitmap-stream (bitmap-stream)
	     (funcall continuation bitmap-stream)
	     (multiple-value-bind (bitmap origin-x origin-y
				   new-left new-top new-right new-bottom)
		 (send bitmap-stream :bitmap-and-edges)
       		 2;;; BITMAP contains the new presentation image
0	       (ignore origin-x origin-y)
	       (let ((copy-for-history (and (send-if-handles xstream :output-recording-enabled)
					    (tv:bitmap-stream-copy-bitmap bitmap-stream))))
		 (multiple-value-bind (left top right bottom)
		     (dw:box-edges (dw:presentation-displayed-box presentation))
		   2;; 
0		   2;;
0		   (let* ((p-left left) (p-top top) (p-right right) (p-bottom bottom)
			  (p-width (- p-right p-left)) (p-height (- p-bottom p-top)))
		     2;;
0		     2;;
0		     2;; P-LEFT, P-TOP, P-RIGHT, P-BOTTOM are used to cache the box which
0		     2;; surrounds the last graphics presentation.
0		     2;;
0		     2;; 0	
		     2;;
0		     (minf left new-left) (minf top new-top)
		     (maxf right new-right) (maxf bottom new-bottom)
		     2;; increase scroll if necessary to show new bitmap
0		     (send bitmap-stream :assure-room-for-output left top right bottom)
		     (let ((width (- right left))
			   (height (- bottom top)))
		       (multiple-value-bind (bleft btop)
			 (send bitmap-stream :convert-to-relative-coordinates left top :inside)
			 2;; 
0			 2;;
0			 2;; Replaces
0			 2;; 0(send xstream :bitblt-from-sheet tv:alu-xor width height left top
			 2;;           0    bitmap bleft btop)
			 2;;
0			 (multiple-value-bind (bp-left bp-top)
			       (send bitmap-stream :convert-to-relative-coordinates p-left p-top :inside)
			   (send xstream :bitblt-from-sheet tv:alu-xor p-width p-height
				 p-left p-top bitmap bp-left bp-top))
			 2;; bitmap now contains <new presn image> xor <old presn image>
0			 2;;
0			 2;; 0	
			 (when (or (null pattern-array)
				   (multiple-value-bind (old-width old-height)
				       (decode-raster-array pattern-array)
				     (or (> width old-width) (> height old-height))))
			   (setq pattern-array (make-raster-array-with-correct-width
						 width height
						 :element-type (array-element-type bitmap))))
			 (bitblt tv:alu-seta width height bitmap bleft btop pattern-array 0 0))
		       2;; pattern-array now contains  (<new presn image> xor <old presen image>)
0		       (dw:with-output-recording-enabled (xstream nil)
			 (send xstream :bitblt tv:alu-xor width height pattern-array 0 0 left top))
		       2;; This doesn't affect the bitmap!!! -- just the history!!
0		       (dw:with-output-recording-enabled (xstream :history-only)
			 2;; 
0			 2;;
0			 2;; Replaces
0			 2;; 0(send xstream :erase-displayed-presentation presentation
			 2;;0    :enable-recording nil
			 2;;0    :redisplay-overlapping-presentations nil)2 
0			 2;;
0			 (send xstream :erase-displayed-presentation presentation
			       :enable-recording nil
			       :redisplay-overlapping-presentations t)
			 2;;
0			 2;; 
0			 (when copy-for-history
			   (let ((new-presentation
				   (with-output-as-graphics-presentation
				     (xstream :displayed-box (dw::make-box new-left new-top
									   new-right new-bottom))
				     (send xstream :draw-raster
					   (- new-right new-left) (- new-bottom new-top)
					   copy-for-history new-left new-top))))
			     2;; 
0			     2;;
0			     2;; Copy the contents of the old presentation into the new one.
0			     2;;
0			     (setf (dw:presentation-type new-presentation)
				   (dw:presentation-type presentation))
			     (setf (dw:presentation-object new-presentation)
				   (dw:presentation-object presentation))
			     2;;
0			     2;; 
0			     new-presentation))))))))))

      (values
	(if (null bitmap-stream)
	    (with-output-to-bitmap-stream (bitmap-stream :for-stream xstream)
	      (use-bitmap-stream bitmap-stream))
	    (send bitmap-stream :reset :for-stream xstream)
	    (use-bitmap-stream bitmap-stream))
	pattern-array))))