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

[Robert Strandh]

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

Modified Files:
	score-pane.lisp sdl.lisp 
Log Message:
Fixed the beam-drawing problem reported by Christophe Rhodes.  There
might still be some glitches, but the foundation is now more sound, so
that future glitches should be easier to fix.


Date: Wed Jan  4 20:08:13 2006
Author: rstrandh

Index: gsharp/score-pane.lisp
diff -u gsharp/score-pane.lisp:1.18 gsharp/score-pane.lisp:1.19
--- gsharp/score-pane.lisp:1.18	Wed Dec  7 04:38:27 2005
+++ gsharp/score-pane.lisp	Wed Jan  4 20:08:12 2006
@@ -454,9 +454,11 @@
   ((light-glyph-p :initarg :light-glyph-p)
    (thickness :initarg :thickness)))
 
-(defun draw-horizontal-beam (medium x1 y1 x2 thickness)
-  (let ((y2 (- y1 thickness)))
-    (draw-rectangle* medium x1 y1 x2 y2)))
+;;; draw a horizontal beam around the vertical reference 
+;;; point y.
+(defun draw-horizontal-beam (medium x1 y x2)
+  (multiple-value-bind (down up) (beam-offsets *font*)
+    (draw-rectangle* medium x1 (+ y up) x2 (+ y down))))
 
 (defvar *darker-gray-progressions*)
 (defvar *lighter-gray-progressions*)
@@ -576,34 +578,39 @@
 	      (draw-upward-beam medium x1 y2 y1 thickness
 				  (/ (- x2 x1) (- y2 y1))))))))))
 
-(defun draw-sloped-beam (medium x1 y1 x2 y2 thickness inverse-slope)
-  (let ((transformation (medium-transformation *pane*)))
-    (cond ((< y1 y2)
-	   (when (stream-recording-p *pane*)
-	     (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))))))
-	   (when (stream-drawing-p *pane*)
-	     (draw-downward-beam medium x1 y1 y2 thickness inverse-slope)))
-	  (t
-	   (when (stream-recording-p *pane*)
-	     (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
-			   :x1 xx1 :y1 yy2 :x2 xx2 :y2 yy1
-                           :light-glyph-p *light-glyph*
-			   :thickness thickness :ink (medium-ink medium))))))
-	   (when (stream-drawing-p *pane*)
-	     (draw-upward-beam medium x1 y1 y2 thickness inverse-slope))))))
+;;; draw a sloped beam.  The vertical reference points 
+;;; 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*))
+	  (inverse-slope (abs (/ (- x2 x1) (- y2 y1))))
+	  (thickness (- down up)))
+      (cond ((< y1 y2)
+	     (when (stream-recording-p *pane*)
+	       (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))))))
+	     (when (stream-drawing-p *pane*)
+	       (draw-downward-beam medium x1 y1 y2 thickness inverse-slope)))
+	    (t
+	     (when (stream-recording-p *pane*)
+	       (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
+					  :x1 xx1 :y1 yy2 :x2 xx2 :y2 yy1
+					  :light-glyph-p *light-glyph*
+					  :thickness thickness :ink (medium-ink medium))))))
+	     (when (stream-drawing-p *pane*)
+	       (draw-upward-beam medium x1 y1 y2 thickness inverse-slope)))))))
 
 ;;; an offset of -1 means hang, 0 means straddle and 1 means sit
 (defun draw-beam (pane x1 staff-step-1 offset1 x2 staff-step-2 offset2)
@@ -612,16 +619,13 @@
       (multiple-value-bind (left right) (stem-offsets *font*)
 	(let* ((xx1 (+ x1 left))
 	       (xx2 (+ x2 right))
-	       (offset (round (staff-step 1/3)))
+	       (offset (beam-hang-sit-offset *font*))
 	       (y1 (- (+ (staff-step staff-step-1) (* offset1 offset))))
 	       (y2 (- (+ (staff-step staff-step-2) (* offset2 offset))))
-	       (slope (abs (/ (- y2 y1) (- xx2 xx1))))
-	       (thickness (/ (staff-line-distance *font*) 2))
 	       (medium (sheet-medium pane)))
-	  (assert (< slope 1))
 	  (if (= y1 y2)
-	      (draw-horizontal-beam pane xx1 y1 xx2 thickness)
-	      (draw-sloped-beam medium xx1 y1 xx2 y2 thickness (/ slope)))))))
+	      (draw-horizontal-beam pane xx1 y1 xx2)
+	      (draw-sloped-beam medium xx1 y1 xx2 y2))))))
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;


Index: gsharp/sdl.lisp
diff -u gsharp/sdl.lisp:1.13 gsharp/sdl.lisp:1.14
--- gsharp/sdl.lisp:1.13	Wed Jan  4 18:35:51 2006
+++ gsharp/sdl.lisp	Wed Jan  4 20:08:12 2006
@@ -115,7 +115,8 @@
       (setf beam-offset-up
 	    (- (ceiling (/ staff-line-distance 2) 2)))
       (setf beam-hang-sit-offset
-	    (/ (- (+ beam-offset-down beam-offset-up) staff-line-thickness) 2)))))
+	    (let ((beam-thickness (- beam-offset-down beam-offset-up)))
+	      (/ (- beam-thickness staff-line-thickness) 2))))))
 
 (defgeneric gf-char (glyph))
 (defgeneric pixmap (glyph))