[gsharp-cvs] CVS update: gsharp/score-pane.lisp

[Christophe Rhodes]

Update of /project/gsharp/cvsroot/gsharp
In directory common-lisp.net:/tmp/cvs-serv28640

Modified Files:
	score-pane.lisp 
Log Message:
fix for pixmaps bogusly being cached across different connections to the 
X server.  (as seen on gsharp-devel "Problem of second gsharp" on
2004-02-25).

Date: Wed Feb 25 17:24:56 2004
Author: crhodes

Index: gsharp/score-pane.lisp
diff -u gsharp/score-pane.lisp:1.1.1.1 gsharp/score-pane.lisp:1.2
--- gsharp/score-pane.lisp:1.1.1.1	Mon Feb 16 10:46:21 2004
+++ gsharp/score-pane.lisp	Wed Feb 25 17:24:56 2004
@@ -1,7 +1,11 @@
 (in-package :score-pane)
 
 (defclass score-pane (application-pane)
-  ((pixmaps :initform (make-hash-table :test #'eq) :reader pane-pixmaps)))
+  ((pixmaps :initform (make-hash-table :test #'eq) :reader pane-pixmaps)
+   (darker-gray-progressions :initform (make-array 10 :initial-element nil :adjustable t)
+			     :reader darker-gray-progressions)
+   (lighter-gray-progressions :initform (make-array 10 :initial-element nil :adjustable t)
+			      :reader lighter-gray-progressions)))
 
 (defmethod dispatch-event :before ((pane score-pane) (event pointer-enter-event))
   (let ((port (port pane)))
@@ -474,10 +478,8 @@
     (when (stream-drawing-p *pane*)
       (medium-draw-rectangle* medium x1 y1 x2 y2 t))))
 
-(defparameter *darker-gray-progressions*
-  (make-array 10 :initial-element nil :adjustable t))
-(defparameter *lighter-gray-progressions*
-  (make-array 10 :initial-element nil :adjustable t))
+(defvar *darker-gray-progressions*)
+(defvar *lighter-gray-progressions*)
 
 ;;; don't delete this yet, since I don't know how the other one will work out. 
 ;; (defun ensure-gray-progressions (index)
@@ -563,7 +565,7 @@
 (defclass upward-beam-output-record (beam-output-record)
   ())
 
-(defmethod replay-output-record ((record upward-beam-output-record) stream
+(defmethod replay-output-record ((record upward-beam-output-record) (stream score-pane)
 				 &optional (region +everywhere+)
 				 (x-offset 0) (y-offset 0))
   (declare (ignore x-offset y-offset region))
@@ -572,15 +574,17 @@
       (let ((medium (sheet-medium stream)))
 	(let ((*light-glyph* (not (eq ink +black+))))
 	  (with-drawing-options (medium :ink ink)
-	    ;; we replay with the identity tranformation, so
-	    ;; we have to draw the other way
-	    (draw-downward-beam medium x1 (1- y2) (1- (+ y1 thickness)) thickness
-				(/ (- x2 x1) (- y2 y1 thickness)))))))))
+	    (let ((*lighter-gray-progressions* (lighter-gray-progressions stream))
+		  (*darker-gray-progressions* (darker-gray-progressions stream)))
+	      ;; we replay with the identity tranformation, so
+	      ;; we have to draw the other way
+	      (draw-downward-beam medium x1 (1- y2) (1- (+ y1 thickness)) thickness
+				  (/ (- x2 x1) (- y2 y1 thickness))))))))))
 
 (defclass downward-beam-output-record (beam-output-record)
   ())
 
-(defmethod replay-output-record ((record downward-beam-output-record) stream
+(defmethod replay-output-record ((record downward-beam-output-record) (stream score-pane)
 				 &optional (region +everywhere+)
 				 (x-offset 0) (y-offset 0))
   (declare (ignore x-offset y-offset region))
@@ -589,10 +593,12 @@
       (let ((medium (sheet-medium stream)))
 	(let ((*light-glyph* (not (eq ink +black+))))
 	  (with-drawing-options (medium :ink ink)
-	    ;; we replay with the identity tranformation, so
-	    ;; we have to draw the other way
-	    (draw-upward-beam medium x1 (1- (+ y1 thickness)) (1- y2) thickness
-			      (/ (- x2 x1) (- y2 y1 thickness)))))))))
+	    (let ((*lighter-gray-progressions* (lighter-gray-progressions stream))
+		  (*darker-gray-progressions* (darker-gray-progressions stream)))
+	      ;; we replay with the identity tranformation, so
+	      ;; we have to draw the other way
+	      (draw-upward-beam medium x1 (1- (+ y1 thickness)) (1- y2) thickness
+				(/ (- x2 x1) (- y2 y1 thickness))))))))))
 
 (defun draw-sloped-beam (medium x1 y1 x2 y2 thickness inverse-slope)
   (let ((transformation (medium-transformation *pane*)))
@@ -658,6 +664,8 @@
   (let ((pixmap (gensym))
 	(mirror (gensym)))
     `(let* ((*pane* ,pane)
+	    (*lighter-gray-progressions* (lighter-gray-progressions pane))
+	    (*darker-gray-progressions* (darker-gray-progressions pane))
 	    (,pixmap (allocate-pixmap *pane* 800 900))
 	    (,mirror (sheet-direct-mirror *pane*)))
       (draw-rectangle* ,pixmap 0 0 800 900 :filled t :ink +white+)