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)