[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-serv27569

Modified Files:
	drawing.lisp measure.lisp packages.lisp 
Log Message:
Moved some more code from drawing.lisp to measure.lisp

Date: Mon Nov 21 01:45:22 2005
Author: rstrandh

Index: gsharp/drawing.lisp
diff -u gsharp/drawing.lisp:1.29 gsharp/drawing.lisp:1.30
--- gsharp/drawing.lisp:1.29	Sat Nov 19 23:59:59 2005
+++ gsharp/drawing.lisp	Mon Nov 21 01:45:14 2005
@@ -197,26 +197,11 @@
    (final-absolute-xoffset :accessor final-absolute-element-xoffset)))
 
 (define-added-mixin vcluster () cluster
-  ((final-stem-direction :accessor final-stem-direction)
-   ;; the position, in staff steps, of the top not in the element.
-   (top-note-pos :accessor top-note-pos)
-   ;; the position, in staff steps, of the bottom note in the element.
-   (bot-note-pos :accessor bot-note-pos)))
+  ((final-stem-direction :accessor final-stem-direction)))
 
 (define-added-mixin welement () lyrics-element
   ((final-absolute-xoffset :accessor final-absolute-element-xoffset)))
 
-;;; Compute and store some important information about a non-empty
-;;; cluster:
-;;;  * the position, in staff steps of the top note.
-;;;  * the position, in staff steps of the bottom note.
-(defun compute-top-bot-pos (cluster)
-  (assert (non-empty-cluster-p cluster))
-  (let ((top-note (top-note (notes cluster)))
-	(bot-note (bot-note (notes cluster))))
-    (setf (top-note-pos cluster) (note-position top-note)
-	  (bot-note-pos cluster) (note-position bot-note))))
-
 ;;; Compute and store several important pieces of information
 ;;; about an element:
 ;;;  * the y-offset of the staff containing the top note.
@@ -305,11 +290,6 @@
 	    (incf start-time (duration element)))
 	  (elements bar))))
 
-;;; Return true if and only if the element is a non-empty cluster
-(defun non-empty-cluster-p (element)
-  (and (typep element 'cluster)
-       (not (null (notes element)))))
-
 ;;; Given a beam group containing at least two nonempty clusters,
 ;;; compute and store the final stem directions of all the non-empty
 ;;; clusters in the group
@@ -353,9 +333,9 @@
 ;;; Given a beam group, for each nonempty element, compute the top and
 ;;; bottom note position, and the final stem direction.
 (defun compute-positions-and-stem-direction (elements)
-  (loop for element in elements
-	when (non-empty-cluster-p element)
-	do (compute-top-bot-pos element))
+;;  (loop for element in elements
+;;	when (non-empty-cluster-p element)
+;;	do (compute-top-bot-pos element))
   (if (null (cdr elements))
       (let ((element (car elements)))
 	(when (non-empty-cluster-p element)


Index: gsharp/measure.lisp
diff -u gsharp/measure.lisp:1.9 gsharp/measure.lisp:1.10
--- gsharp/measure.lisp:1.9	Sat Nov 19 06:16:28 2005
+++ gsharp/measure.lisp	Mon Nov 21 01:45:18 2005
@@ -101,6 +101,26 @@
 ;;;
 ;;; Cluster
 
+(define-added-mixin rcluster () cluster
+  (;; the position, in staff steps, of the top not in the element.
+   (top-note-pos :accessor top-note-pos)
+   ;; the position, in staff steps, of the bottom note in the element.
+   (bot-note-pos :accessor bot-note-pos)))
+
+;;; Return true if and only if the element is a non-empty cluster
+(defun non-empty-cluster-p (element)
+  (and (typep element 'cluster)
+       (not (null (notes element)))))
+
+;;; Compute and store some important information about a non-empty
+;;; cluster:
+;;;  * the position, in staff steps of the top note.
+;;;  * the position, in staff steps of the bottom note.
+(defun compute-top-bot-pos (cluster)
+  (assert (non-empty-cluster-p cluster))
+  (setf (top-note-pos cluster) (note-position (top-note (notes cluster)))
+	(bot-note-pos cluster) (note-position (bot-note (notes cluster)))))
+
 (defmethod add-note :after ((element relement) (note note))
   (mark-modified element))
 
@@ -288,6 +308,23 @@
   (append (merge 'list (butlast bar1) (butlast bar2) #'<)
 	  (list (max (car (last bar1)) (car (last bar2))))))
 
+;;; compute some important parameters of an element
+(defgeneric compute-element-parameters (element))
+
+(defmethod compute-element-parameters (element)
+  nil)
+
+(defmethod compute-element-parameters ((element cluster))
+  (when (non-empty-cluster-p element)
+    (compute-top-bot-pos element)))
+
+;;; compute some important parameters of a bar
+(defun compute-bar-parameters (bar)
+  (loop for element in (elements bar)
+	do (when (modified-p element)
+	     (compute-element-parameters element)
+	     (setf (modified-p element) nil))))
+
 ;;; From a list of simultaneous bars (and some other stuff), create a
 ;;; measure.  The `other stuff' is the spacing style, which is neded
 ;;; in order to compute the coefficient of the measure, the position
@@ -297,6 +334,10 @@
 ;;; to indicate the position of the measure in the sequence of all
 ;;; measures of the buffer.
 (defun compute-measure (bars spacing-style seg-pos bar-pos)
+  (loop for bar in bars
+	do (when (modified-p bar)
+	     (compute-bar-parameters bar)
+	     (setf (modified-p bar) nil)))
   (let* ((start-times (remove-duplicates
 		       (reduce #'combine-bars
 			       (mapcar #'start-times bars))))


Index: gsharp/packages.lisp
diff -u gsharp/packages.lisp:1.29 gsharp/packages.lisp:1.30
--- gsharp/packages.lisp:1.29	Sun Nov 20 20:17:22 2005
+++ gsharp/packages.lisp	Mon Nov 21 01:45:18 2005
@@ -102,8 +102,8 @@
 	   #:buffer-cost-method
 	   #:reduced-width #:natural-width #:compress-factor
 	   #:measure-seq-cost
-	   #:note-position
-	   #:top-note #:bot-note))
+	   #:note-position #:non-empty-cluster-p
+	   #:top-note #:bot-note #:top-note-pos #:bot-note-pos))
 
 (defpackage :gsharp-postscript
   (:use :clim :clim-lisp)