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

Drawing Order


    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

- Ed

	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,,
Follow-Ups: References:
Main Index | Thread Index