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

[Robert Strandh]

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

Modified Files:
	drawing.lisp measure.lisp packages.lisp 
Log Message:
Started moving code from drawing.lisp to measure.lisp in order to 
prepare for computing physical widths earlier. 


Date: Sat Nov 19 06:16:28 2005
Author: rstrandh

Index: gsharp/drawing.lisp
diff -u gsharp/drawing.lisp:1.26 gsharp/drawing.lisp:1.27
--- gsharp/drawing.lisp:1.26	Fri Nov 18 20:41:44 2005
+++ gsharp/drawing.lisp	Sat Nov 19 06:16:28 2005
@@ -204,36 +204,6 @@
 (define-added-mixin welement () lyrics-element
   ((final-absolute-xoffset :accessor final-absolute-element-xoffset)))
 
-;;; given a list of notes, return the one that is at the top
-(defun top-note (notes)
-  (reduce (lambda (n1 n2)
-	    (cond ((< (staff-yoffset (staff n1))
-		      (staff-yoffset (staff n2)))
-		   n1)
-		  ((> (staff-yoffset (staff n1))
-		      (staff-yoffset (staff n2)))
-		   n2)
-		  ((> (note-position n1)
-		      (note-position n2))
-		   n1)
-		  (t n2)))
-	  notes))
-
-;;; given a list of notes, return the one that is at the bottom
-(defun bot-note (notes)
-  (reduce  (lambda (n1 n2)
-	     (cond ((> (staff-yoffset (staff n1))
-		       (staff-yoffset (staff n2)))
-		    n1)
-		   ((< (staff-yoffset (staff n1))
-		       (staff-yoffset (staff n2)))
-		    n2)
-		   ((< (note-position n1)
-		       (note-position n2))
-		    n1)
-		   (t n2)))
-	   notes))
-
 ;;; Compute and store several important pieces of information
 ;;; about an element:
 ;;;  * the position, in staff steps of the top note.
@@ -492,12 +462,6 @@
 
 (defmethod note-difference ((note1 note) (note2 note))
   (- (pitch note1) (pitch note2)))
-
-(defmethod note-position ((note note))
-  (let ((clef (clef (staff note))))
-    (+ (- (pitch note)
-	  (ecase (name clef) (:treble 32) (:bass 24) (:c 35)))
-       (lineno clef))))
 
 (defun draw-ledger-lines (pane x notes)
   (score-pane:with-vertical-score-position (pane (staff-yoffset (staff (car notes))))


Index: gsharp/measure.lisp
diff -u gsharp/measure.lisp:1.8 gsharp/measure.lisp:1.9
--- gsharp/measure.lisp:1.8	Fri Nov 18 02:59:27 2005
+++ gsharp/measure.lisp	Sat Nov 19 06:16:28 2005
@@ -8,6 +8,13 @@
 
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
+;;; Staff
+
+(define-added-mixin rstaff () staff
+  ((rank :accessor staff-rank)))
+
+;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
+;;;
 ;;; Note
 
 (defrclass rnote note
@@ -54,6 +61,42 @@
   (declare (ignore dots))
   (mark-modified element))
 
+(defmethod note-position ((note note))
+  (let ((clef (clef (staff note))))
+    (+ (- (pitch note)
+	  (ecase (name clef) (:treble 32) (:bass 24) (:c 35)))
+       (lineno clef))))
+
+;;; given a list of notes, return the one that is at the top
+(defun top-note (notes)
+  (reduce (lambda (n1 n2)
+	    (cond ((< (staff-rank (staff n1))
+		      (staff-rank (staff n2)))
+		   n1)
+		  ((> (staff-rank (staff n1))
+		      (staff-rank (staff n2)))
+		   n2)
+		  ((> (note-position n1)
+		      (note-position n2))
+		   n1)
+		  (t n2)))
+	  notes))
+
+;;; given a list of notes, return the one that is at the bottom
+(defun bot-note (notes)
+  (reduce  (lambda (n1 n2)
+	     (cond ((> (staff-rank (staff n1))
+		       (staff-rank (staff n2)))
+		    n1)
+		   ((< (staff-rank (staff n1))
+		       (staff-rank (staff n2)))
+		    n2)
+		   ((< (note-position n1)
+		       (note-position n2))
+		    n1)
+		   (t n2)))
+	   notes))
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;;;
 ;;; Cluster
@@ -369,6 +412,10 @@
 
 (defmethod recompute-measures ((buffer rbuffer))
   (when (modified-p buffer)
+    ;; number the staves
+    (loop for staff in (staves buffer)
+	  for i from 0
+	  do (setf (staff-rank staff) i))
     ;; for now, invalidate everything
     (mapc #'adjust-lowpos-highpos (segments buffer))
     ;; initialize cost method from buffer-specific style parameters


Index: gsharp/packages.lisp
diff -u gsharp/packages.lisp:1.27 gsharp/packages.lisp:1.28
--- gsharp/packages.lisp:1.27	Mon Nov 14 15:27:32 2005
+++ gsharp/packages.lisp	Sat Nov 19 06:16:28 2005
@@ -100,7 +100,9 @@
 	   #:recompute-measures #:measure-cost-method #:make-measure-cost-method
 	   #:buffer-cost-method
 	   #:reduced-width #:natural-width #:compress-factor
-	   #:measure-seq-cost))
+	   #:measure-seq-cost
+	   #:note-position
+	   #:top-note #:bot-note))
 
 (defpackage :gsharp-postscript
   (:use :clim :clim-lisp)