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)