[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]
[no subject]
(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))))