[gsharp-cvs] CVS update: gsharp/drawing.lisp gsharp/measure.lisp

[Robert Strandh]

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

Modified Files:
	drawing.lisp measure.lisp 
Log Message:
Prepare for a separation of the functionality in drawing.lisp into 
two parts:

  1. A part that computes stem directions and x offsets of notes
     and accidentals relative to the x offset of the element.  These
     computations will be used to determine physical widths of elements.

  2. A part that computes exact x and y positions, beam slants, etc. 
     for the final drawing phase.

The first part will precede the line-breaking phase, so that the
line-breaking algorithm can take physical widths into account.


Date: Fri Nov 18 02:59:27 2005
Author: rstrandh

Index: gsharp/drawing.lisp
diff -u gsharp/drawing.lisp:1.20 gsharp/drawing.lisp:1.21
--- gsharp/drawing.lisp:1.20	Tue Nov 15 19:49:52 2005
+++ gsharp/drawing.lisp	Fri Nov 18 02:59:27 2005
@@ -221,19 +221,26 @@
 ;;; about an element:
 ;;;  * the position, in staff steps of the top note.
 ;;;  * the position, in staff steps of the bottom note.
+(defun compute-top-bot-pos (element)
+  (if (and (typep element 'cluster) (notes element))
+      (let ((top-note (top-note (notes element)))
+	    (bot-note (bot-note (notes element))))
+	(setf (top-note-pos element) (note-position top-note)
+	      (bot-note-pos element) (note-position bot-note)))
+      (setf (top-note-pos element) 4
+	    (bot-note-pos element) 4)))
+
+;;; compute and store several important pieces of information
+;;; about an element:
 ;;;  * the y-offset of the staff containing the top note.
 ;;;  * the y-offset of the staff containing the bottom note.
-(defun compute-top-bot-pos-yoffset (element)
+(defun compute-top-bot-yoffset (element)
   (if (and (typep element 'cluster) (notes element))
       (let ((top-note (top-note (notes element)))
 	    (bot-note (bot-note (notes element))))
-	(setf (top-note-pos element) (note-position top-note)
-	      (bot-note-pos element) (note-position bot-note)
-	      (bot-note-staff-yoffset element) (staff-yoffset (staff bot-note))
+	(setf (bot-note-staff-yoffset element) (staff-yoffset (staff bot-note))
 	      (top-note-staff-yoffset element) (staff-yoffset (staff top-note))))
-      (setf (top-note-pos element) 4
-	    (bot-note-pos element) 4
-	    ;; clearly wrong.  should be taken from element or layer.
+      (setf ;; clearly wrong.  should be taken from element or layer.
 	    (top-note-staff-yoffset element) 0
 	    (bot-note-staff-yoffset element) 0)))
 
@@ -342,7 +349,8 @@
 	  notes))
 
 (defun draw-beam-group (pane elements)
-  (mapc #'compute-top-bot-pos-yoffset elements)
+  (mapc #'compute-top-bot-pos elements)
+  (mapc #'compute-top-bot-yoffset elements)
   (if (null (cdr elements))
       (when (or (typep (car elements) 'rest) (notes (car elements)))
 	(compute-appearance (car elements))
@@ -399,10 +407,11 @@
 (defun draw-cursor (pane x)
   (draw-line* pane x (- (score-pane:staff-step -4)) x (- (score-pane:staff-step 12)) :ink +red+))
 
-(defmethod draw-bar (pane (bar melody-bar) x width time-alist draw-cursor)
-  (compute-element-x-positions bar x time-alist)
-  (let ((elements (elements bar))
-	(group '()))
+;;; Given a list of the elements of a bar, return a list of beam
+;;; groups, where each beam group is a list of elements that are
+;;; beamed together
+(defun beam-groups (elements)
+  (let ((group '()))
     (loop while (not (null elements)) do
 	  (setf group '())
 	  (push (pop elements) group)
@@ -410,7 +419,12 @@
 			   (> (rbeams (car group)) 0)
 			   (> (lbeams (car elements)) 0))
 		do (push (pop elements) group))
-	  (draw-beam-group pane (nreverse group))))
+	  collect (nreverse group))))
+
+(defmethod draw-bar (pane (bar melody-bar) x width time-alist draw-cursor)
+  (compute-element-x-positions bar x time-alist)
+  (loop for group in (beam-groups (elements bar))
+	do (draw-beam-group pane group))
   (when (eq (cursor-bar *cursor*) bar)
     (let ((elements (elements bar)))
       (if (null (cursor-element *cursor*))


Index: gsharp/measure.lisp
diff -u gsharp/measure.lisp:1.7 gsharp/measure.lisp:1.8
--- gsharp/measure.lisp:1.7	Thu Nov 17 01:42:42 2005
+++ gsharp/measure.lisp	Fri Nov 18 02:59:27 2005
@@ -28,13 +28,13 @@
 
 (defmethod duration :around ((element relement))
   (with-slots (duration) element
-    (when (or (modified-p element) (null duration))
-      (setf duration (call-next-method))
-      (setf (modified-p element) nil))
+    (when (null duration)
+      (setf duration (call-next-method)))
     duration))
 
 (defmethod mark-modified ((element relement))
-  (setf (modified-p element) t)
+  (setf (modified-p element) t
+	(slot-value element 'duration) nil)
   (when (bar element)
     (mark-modified (bar element))))