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+)