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

Modified Files: drawing.lisp measure.lisp packages.lisp Log Message: More code towards a better spacing algorithm

Date: Mon Nov 28 05:25:35 2005 Author: rstrandh

Index: gsharp/drawing.lisp diff -u gsharp/drawing.lisp:1.34 gsharp/drawing.lisp:1.35 --- gsharp/drawing.lisp:1.34 Mon Nov 21 23:40:48 2005 +++ gsharp/drawing.lisp Mon Nov 28 05:25:34 2005 @@ -96,6 +96,41 @@ collect (/ (nat-width method (measure-coeff measure) min-dist) compress))))

+(defun compute-elasticities (measures method) + (loop for measure in measures + do (loop with timelines = (timelines measure) + for i from 0 below (flexichain:nb-elements timelines) + for timeline = (flexichain:element* timelines i) + do (setf (elasticity timeline) + (expt (duration timeline) (spacing-style method)))))) + +(defgeneric left-bulge (element pane)) +(defgeneric right-bulge (element pane)) + +(defmethod left-bulge ((element element) pane) + 0) + +(defmethod right-bulge ((element element) pane) + 0) + +(defun compute-gaps (measures method pane) + (declare (ignore method)) + (loop for measure in measures + do (loop for bar in (measure-bars measure) + do (loop for (e1 e2) on (elements bar) + for t1 = (timeline e1) + do (cond ((null e2) + (when (flexichain:flexi-last-p t1) + (setf (smallest-gap t1) + (max (smallest-gap t1) + (right-bulge e1 pane))))) + ((eq (flexichain:flexi-next t1) + (timeline e2)) + (setf (smallest-gap t1) + (max (smallest-gap t1) + (+ (right-bulge e1 pane) + (left-bulge e2 pane)))))))))) + (defun draw-measure (pane measure min-dist compress x method draw-cursor) (let* ((width (/ (nat-width method (measure-coeff measure) min-dist) compress)) @@ -154,6 +189,8 @@ (let ((yy y)) (gsharp-measure::new-map-over-obseq-subsequences (lambda (measures) + (compute-elasticities measures method) + (compute-gaps measures method pane) (let ((widths (compute-widths measures method))) (score-pane:with-vertical-score-position (pane yy) (draw-system pane measures (+ x (left-offset buffer) timesig-offset)

Index: gsharp/measure.lisp diff -u gsharp/measure.lisp:1.15 gsharp/measure.lisp:1.16 --- gsharp/measure.lisp:1.15 Mon Nov 28 03:32:06 2005 +++ gsharp/measure.lisp Mon Nov 28 05:25:34 2005 @@ -48,7 +48,7 @@

(defrclass relement element ((duration :initform nil) - (timeline :accessor timeline))) + (timeline :accessor timeline)))

(defmethod duration :around ((element relement)) (with-slots (duration) element @@ -393,7 +393,10 @@ ((start-time :initarg :start-time :reader start-time) (elements :initform '() :accessor elements) (duration :initarg :duration :reader duration) - (elasticity :accessor elasticity))) + (elasticity :accessor elasticity) + ;; the minimum x offset from this timeline to the next, or, if this + ;; is the last timeline, from this one to the end of the measure + (smallest-gap :initform 0 :accessor smallest-gap)))

(defclass ranked-flexichain (flexichain:standard-flexichain flexichain:flexirank-mixin) ()) @@ -464,7 +467,7 @@ (defmethod measures :before ((segment rsegment)) (when (modified-p segment) (compute-measures segment (spacing-style (buffer-cost-method (buffer segment)))) - (mapc #'compute-timelines (measures segment)) + (mapc #'compute-timelines (slot-value segment 'measures)) (setf (modified-p segment) nil)))

(defmethod nb-measures ((segment rsegment))

Index: gsharp/packages.lisp diff -u gsharp/packages.lisp:1.34 gsharp/packages.lisp:1.35 --- gsharp/packages.lisp:1.34 Mon Nov 21 23:40:48 2005 +++ gsharp/packages.lisp Mon Nov 28 05:25:34 2005 @@ -133,7 +133,9 @@ #:top-note #:bot-note #:top-note-pos #:bot-note-pos #:beam-groups #:final-stem-direction #:group-notes-by-staff #:final-relative-note-xoffset - #:final-accidental #:final-relative-accidental-xoffset)) + #:final-accidental #:final-relative-accidental-xoffset + #:timeline #:timelines #:elasticity + #:smallest-gap))

(defpackage :gsharp-postscript (:use :clim :clim-lisp)