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

Drawing Order

    Date: Thu, 10 Dec 1992 18:32 EST
    From: Ed Gamble <ebg@hip.atr.co.jp>


	Date: Thu, 10 Dec 1992 12:13-0500
	From: Scott McKay <SWM@STONY-BROOK.SCRC.Symbolics.COM>
	Subject: Drawing Order

	    Date: Wed, 9 Dec 1992 18:37 EST
	    From: Ed Gamble <ebg@hip.atr.co.jp>

	    I'm not Eilerts but as best I can tell here is the same problem...

	Congratulations!  You found a previously unknown bug in incremental
	redisplay.  The fix is included below.

    The fix is fine except for about 1 in 10 trials.  Which isn't a serious
    problem for me but just so you know.  Thanks

The one-time-in-ten is actually a different bug (!).

	    For this test, I attempting to draw two sets of concentric circles.
	    One set is fixed; a large red circle with a small black one.  The other
	    set moves about randomly; it is blue with a yellow dot.

	    If you hit the "move" menu item the blue/yellow circle moves
	    obscuring the red/black.  Problem is the black dot disappears.  It 
	    can be seen again if the window is iconified, then reopened.

	    (clim:define-application-frame TEST ()
	      ()
	      (:default-initargs :height 200 :width 400)
	      (:panes ((foo :application
			    :display-function 'test-display
			    :incremental-redisplay t
			    :scroll-bars nil)
		       (menu :command-menu)))
	      (:layout ((standard
			 (:column 1 (menu :compute) (foo :rest))))))

	    (define-test-command (com-Move :menu "Move" :keystroke #\M)
		()
	      (let ((self clim:*application-frame*))
		(loop repeat 10 do
		      (clim:redisplay-frame-pane self 'foo))))

	    (define-test-command (com-Exit :menu "Exit" :keystroke #\X)
		()
	      (let ((self clim:*application-frame*))
		(clim:frame-exit self)))

	    (defun TEST-DISPLAY (frame pane)
	      (declare (ignore frame))
	      (clim:updating-output (pane :cache-value ':fixed)
		(clim:draw-circle* pane 150 100 50 :ink clim:+red+)
		(clim:draw-circle* pane 150 100 10 :ink clim:+black+))
	      (let ((rand (random 150)))
		(clim:updating-output (pane :cache-value rand :cache-test #'=)
		  (clim:draw-circle* pane (+ rand 100) 100 50 :ink clim:+blue+)
		  (clim:draw-circle* pane (+ rand 100) 100 10 :ink clim:+yellow+)
		  )))

	    (setq root (clim:open-root-window
			:clx :host (lcl:environment-variable "DISPLAY")))

	    (progn
	      (setf test (clim:make-application-frame 'test :parent root)
		    proc (lcl:make-process :function #'clim:run-frame-top-level
					   :args (list test) :name "test")))

	    CLIM 1.1 Beta, Lucid 4.0.1, Sparc



	Here is the fix for CLIM 1.1.  This fix will be part of CLIM 2.0 as well.

	(in-package :clim)
	(defmethod augment-draw-set
	     ((record output-record-element-mixin)
	      erases moves draws erase-overlapping move-overlapping
	      &optional (x-offset 0) (y-offset 0)
	      (old-x-offset 0) (old-y-offset 0))
	  (declare (fixnum x-offset y-offset old-x-offset old-y-offset))
	  (declare (values erases moves draws erase-overlapping move-overlapping))
	  (let ((new-draws nil))
	    (labels ((augment-draws (record x-offset y-offset
					    old-x-offset old-y-offset)
		       (when (and (displayed-output-record-element-p record)
				  (not (elements-never-overlap-p
					(output-record-parent record)))
				  (not (member record draws :key #'first))
				  (not (member record erases :key #'first))
				  (dolist (erase erases nil)
				    (when (region-intersects-region-p
					   record (first erase))
				      (return t))))
			 (push (list record
				     (bounding-rectangle-shift-position
				       record x-offset y-offset))
			       new-draws))
		       (when (output-record-p record)
			 (multiple-value-bind (start-x start-y)
			     (output-record-start-position* record)
			   (declare (fixnum start-x start-y))
			   (multiple-value-bind (o-start-x o-start-y)
			       (output-record-old-start-position* record)
			     (declare (fixnum o-start-x o-start-y))
			     (let ((x-offset (the fixnum (+ x-offset start-x)))
				   (y-offset (the fixnum (+ y-offset start-y)))
				   (old-x-offset (the fixnum (+ old-x-offset
								o-start-x)))
				   (old-y-offset (the fixnum (+ old-y-offset
								o-start-y))))
			       (map-over-output-record-elements record
				 #'augment-draws 0 0
				 x-offset y-offset old-x-offset old-y-offset)))))))
	      (declare (dynamic-extent #'augment-draws))
	      (augment-draws record x-offset y-offset old-x-offset old-y-offset))
	    (values erases moves (nconc (nreverse new-draws) draws)
		    erase-overlapping move-overlapping)))


0,,
References:
Main Index | Thread Index