[gsharp-cvs] CVS gsharp

[crhodes]

Update of /project/gsharp/cvsroot/gsharp
In directory clnet:/tmp/cvs-serv32040

Modified Files:
	score-pane.lisp 
Log Message:
Beam output records need to store the clipping-region, and use it when
replaying.  Fixes sloping partial beams.


--- /project/gsharp/cvsroot/gsharp/score-pane.lisp	2006/03/02 09:21:34	1.22
+++ /project/gsharp/cvsroot/gsharp/score-pane.lisp	2006/05/28 21:30:29	1.23
@@ -453,6 +453,7 @@
 
 (defclass beam-output-record (score-output-record)
   ((light-glyph-p :initarg :light-glyph-p)
+   (clipping-region :initarg :clipping-region)
    (thickness :initarg :thickness)))
 
 ;;; draw a horizontal beam around the vertical reference 
@@ -553,14 +554,15 @@
 				 (x-offset 0) (y-offset 0))
   (declare (ignore x-offset y-offset region))
   (with-bounding-rectangle* (x1 y1 x2 y2) record
-    (with-slots (thickness ink light-glyph-p) record
+    (with-slots (thickness ink clipping-region light-glyph-p) record
       (let ((medium (sheet-medium stream)))
 	(let ((*light-glyph* light-glyph-p))
-	  (with-drawing-options (medium :ink ink)
+	  (with-drawing-options 
+              (medium :ink ink :clipping-region clipping-region)
 	    (let ((*lighter-gray-progressions* (lighter-gray-progressions stream))
 		  (*darker-gray-progressions* (darker-gray-progressions stream)))
-	      (draw-downward-beam medium x1 y1 y2 thickness
-					(/ (- x2 x1) (- y2 y1))))))))))
+              (draw-downward-beam medium x1 y1 y2 thickness
+                                  (/ (- x2 x1) (- y2 y1))))))))))
 
 (defclass upward-beam-output-record (beam-output-record)
   ())
@@ -570,10 +572,11 @@
 				 (x-offset 0) (y-offset 0))
   (declare (ignore x-offset y-offset region))
   (with-bounding-rectangle* (x1 y1 x2 y2) record
-    (with-slots (thickness ink light-glyph-p) record
+    (with-slots (thickness ink clipping-region light-glyph-p) record
       (let ((medium (sheet-medium stream)))
 	(let ((*light-glyph* light-glyph-p))
-	  (with-drawing-options (medium :ink ink)
+	  (with-drawing-options 
+              (medium :ink ink :clipping-region clipping-region)
 	    (let ((*lighter-gray-progressions* (lighter-gray-progressions stream))
 		  (*darker-gray-progressions* (darker-gray-progressions stream)))
 	      (draw-upward-beam medium x1 y2 y1 thickness
@@ -596,7 +599,8 @@
 		    *pane* (make-instance 'downward-beam-output-record
 					  :x1 xx1 :y1 yy1 :x2 xx2 :y2 yy2
 					  :light-glyph-p *light-glyph*
-					  :thickness thickness :ink (medium-ink medium))))))
+					  :thickness thickness :ink (medium-ink medium)
+                                          :clipping-region (medium-clipping-region medium))))))
 	     (when (stream-drawing-p *pane*)
 	       (draw-downward-beam medium x1 y1 y2 thickness inverse-slope)))
 	    (t
@@ -609,7 +613,9 @@
 		    *pane* (make-instance 'upward-beam-output-record
 					  :x1 xx1 :y1 yy2 :x2 xx2 :y2 yy1
 					  :light-glyph-p *light-glyph*
-					  :thickness thickness :ink (medium-ink medium))))))
+					  :thickness thickness 
+                                          :ink (medium-ink medium)
+                                          :clipping-region (medium-clipping-region medium))))))
 	     (when (stream-drawing-p *pane*)
 	       (draw-upward-beam medium x1 y1 y2 thickness inverse-slope)))))))