Index: score-pane.lisp
===================================================================
RCS file: /project/gsharp/cvsroot/gsharp/score-pane.lisp,v
retrieving revision 1.29
diff -u -r1.29 score-pane.lisp
--- score-pane.lisp	5 Jun 2006 00:53:41 -0000	1.29
+++ score-pane.lisp	5 Jun 2006 14:26:18 -0000
@@ -476,6 +476,12 @@
 		*lighter-gray-progressions* *darker-gray-progressions*))
 
 (defun draw-downward-beam (medium x1 y1 y2 thickness inverse-slope)
+  (when (typep medium 'clim-postscript::postscript-medium)
+    (let ((x2 (+ x1 (* (- y2 y1) inverse-slope))))
+      (return-from draw-downward-beam
+        ;; the 1+ here is wrong -- it only works for a pure
+        ;; translation transformation, not for scaling.
+        (draw-polygon* (medium-sheet medium) `(,x1 ,(1+ y1) ,x1 ,(- (1+ y1) thickness) ,x2 ,(- (1+ y2) thickness) ,x2 ,(1+ y2)) :closed t :filled t))))
   (loop for y from y1 below y2
 	for x from x1 by inverse-slope do
 	(draw-downward-beam-segment medium (round x) y
@@ -505,6 +511,19 @@
               (draw-downward-beam medium x1 y1 y2 thickness
                                   (/ (- x2 x1) (- y2 y1))))))))))
 
+(defmethod replay-output-record ((record downward-beam-output-record) stream
+                                 &optional (region +everywhere+)
+                                 (x-offset 0) (y-offset 0))
+  (with-bounding-rectangle* (x1 y1 x2 y2) 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 :clipping-region clipping-region)
+            (draw-downward-beam medium x1 y1 y2 thickness
+                                (/ (- x2 x1) (- y2 y1))))))))))
+  
+
 (defclass upward-beam-output-record (beam-output-record)
   ())
 
@@ -527,37 +546,43 @@
 ;;; of the two end points are indicated by y1 and y2. 
 (defun draw-sloped-beam (medium x1 y1 x2 y2)
   (multiple-value-bind (down up) (beam-offsets *font*)
-    (let ((transformation (medium-transformation *pane*))
+    (let ((transformation (medium-transformation (medium-sheet medium)))
 	  (inverse-slope (abs (/ (- x2 x1) (- y2 y1))))
 	  (thickness (- down up)))
       (cond ((< y1 y2)
-	     (when (stream-recording-p *pane*)
+	     (when (stream-recording-p (medium-sheet medium))
 	       (multiple-value-bind (xx1 yy1)
 		   (transform-position transformation x1 y1)
 		 (multiple-value-bind (xx2 yy2)
 		     (transform-position transformation x2 y2)
-		   (stream-add-output-record
-		    *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)
-                                          :clipping-region (medium-clipping-region medium))))))
-	     (when (stream-drawing-p *pane*)
+                   (multiple-value-bind (ignore ddown)
+                       (transform-position transformation 0 down)
+                     (declare (ignore ignore))
+                     (multiple-value-bind (ignore uup)
+                         (transform-position transformation 0 up)
+                       (declare (ignore ignore))
+                       (stream-add-output-record
+                        (medium-sheet medium) (make-instance 'downward-beam-output-record
+                                                             :x1 xx1 :y1 yy1 :x2 xx2 :y2 yy2
+                                                             :light-glyph-p *light-glyph*
+                                                             :thickness (- ddown uup) :ink (medium-ink medium)
+                                                             :clipping-region (medium-clipping-region medium))))))))
+	     (when (stream-drawing-p (medium-sheet medium))
 	       (draw-downward-beam medium x1 y1 y2 thickness inverse-slope)))
 	    (t
-	     (when (stream-recording-p *pane*)
+	     (when (stream-recording-p (medium-sheet medium))
 	       (multiple-value-bind (xx1 yy1)
 		   (transform-position transformation x1 y1)
 		 (multiple-value-bind (xx2 yy2)
 		     (transform-position transformation x2 y2)
 		   (stream-add-output-record
-		    *pane* (make-instance 'upward-beam-output-record
+		    (medium-sheet medium) (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)
                                           :clipping-region (medium-clipping-region medium))))))
-	     (when (stream-drawing-p *pane*)
+	     (when (stream-drawing-p (medium-sheet medium))
 	       (draw-upward-beam medium x1 y1 y2 thickness inverse-slope)))))))
 
 ;;; an offset of -1 means hang, 0 means straddle and 1 means sit
