- gsharp-cvs@common-lisp.net - mailman3.common-lisp.net

[gsharp-cvs] CVS update: gsharp/measure.lisp
by rstrandh＠common-lisp.net 29 Nov '05

29 Nov '05

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv28565 Modified Files: measure.lisp Log Message: Fixed a bug in the code for creating the timelines. The calculation of the start times of the timelines was wrong. Date: Tue Nov 29 19:05:04 2005 Author: rstrandh Index: gsharp/measure.lisp diff -u gsharp/measure.lisp:1.17 gsharp/measure.lisp:1.18 --- gsharp/measure.lisp:1.17 Tue Nov 29 05:22:20 2005 +++ gsharp/measure.lisp Tue Nov 29 19:05:03 2005 @@ -653,10 +653,10 @@ (defun compute-timelines (measure) (let ((timelines (timelines measure)) - (start-times (measure-start-times measure))) + (durations (abs-rel (measure-start-times measure)))) ;; create a timeline for each start time of the measure - (loop for start-time in start-times - for duration in (abs-rel start-times) + (loop for duration in durations + for start-time = 0 then (+ start-time duration) for i from 0 do (let ((timeline (make-instance 'timeline :start-time start-time @@ -665,15 +665,15 @@ ;; link each timeline to its elements and each element of a ;; timeline to the timeline (loop for bar in (measure-bars measure) - do (loop for element in (elements bar) + do (loop with timeline-index = 0 + for element in (elements bar) for start-time = 0 then (+ start-time (duration element)) - for timeline-index from 0 do (loop while (< (start-time (flexichain:element* timelines timeline-index)) start-time) - do (incf timeline-index)) + do (incf timeline-index)) do (let ((timeline (flexichain:element* timelines timeline-index))) - (push element (elements timeline)) - (setf (timeline element) timeline)))))) + (push element (elements timeline)) + (setf (timeline element) timeline)))))) ;;; Compute all the measures of a segment by stepping through all the ;;; bars in parallel as long as there is at least one simultaneous bar.

1 0

[gsharp-cvs] CVS update: gsharp/drawing.lisp gsharp/measure.lisp
by rstrandh＠common-lisp.net 28 Nov '05

28 Nov '05

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv30924 Modified Files: drawing.lisp measure.lisp Log Message: Improved the computation of the bulge of a lyrics element. This improvement will allow me to test that the gaps between elements is calculated correctly. Also fixed a spelling error (was compute-bar-parameter, should be compute-bar-parameters) that made Gsharp fail on a score with lyrics. Date: Tue Nov 29 05:22:21 2005 Author: rstrandh Index: gsharp/drawing.lisp diff -u gsharp/drawing.lisp:1.36 gsharp/drawing.lisp:1.37 --- gsharp/drawing.lisp:1.36 Tue Nov 29 04:05:24 2005 +++ gsharp/drawing.lisp Tue Nov 29 05:22:20 2005 @@ -110,8 +110,16 @@ (defmethod left-bulge ((element element) pane) (score-pane:staff-step 1)) +(defmethod left-bulge ((element lyrics-element) pane) + (+ (score-pane:staff-step 0.5) + (/ (text-size pane (map 'string 'code-char (text element))) 2))) + (defmethod right-bulge ((element element) pane) (score-pane:staff-step 1)) + +(defmethod right-bulge ((element lyrics-element) pane) + (+ (score-pane:staff-step 0.5) + (/ (text-size pane (map 'string 'code-char (text element))) 2))) (defun compute-gaps-adjacent-timelines (bars method pane) (declare (ignore method)) Index: gsharp/measure.lisp diff -u gsharp/measure.lisp:1.16 gsharp/measure.lisp:1.17 --- gsharp/measure.lisp:1.16 Mon Nov 28 05:25:34 2005 +++ gsharp/measure.lisp Tue Nov 29 05:22:20 2005 @@ -621,7 +621,7 @@ ;;; compute some important parameters of a bar (defgeneric compute-bar-parameters (bar)) -(defmethod compute-bar-parameter (bar) +(defmethod compute-bar-parameters (bar) nil) (defmethod compute-bar-parameters ((bar melody-bar))

1 0

[gsharp-cvs] CVS update: gsharp/drawing.lisp
by rstrandh＠common-lisp.net 28 Nov '05

28 Nov '05

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv25450 Modified Files: drawing.lisp Log Message: More code towards a better spacing algorithm. Date: Tue Nov 29 04:05:25 2005 Author: rstrandh Index: gsharp/drawing.lisp diff -u gsharp/drawing.lisp:1.35 gsharp/drawing.lisp:1.36 --- gsharp/drawing.lisp:1.35 Mon Nov 28 05:25:34 2005 +++ gsharp/drawing.lisp Tue Nov 29 04:05:24 2005 @@ -108,28 +108,87 @@ (defgeneric right-bulge (element pane)) (defmethod left-bulge ((element element) pane) - 0) + (score-pane:staff-step 1)) (defmethod right-bulge ((element element) pane) - 0) + (score-pane:staff-step 1)) -(defun compute-gaps (measures method pane) +(defun compute-gaps-adjacent-timelines (bars method pane) + (declare (ignore method)) + (loop for bar in bars + 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 compute-gaps-separated-timelines (bars method pane) (declare (ignore method)) + (flet ((handle-timelines (timelines element-gap) + (let ((sum-gap (reduce #'+ timelines :key #'smallest-gap)) + (sum-elasticity (reduce #'+ timelines :key #'elasticity))) + (unless (> sum-gap element-gap) + (if (zerop sum-elasticity) + (loop for timeline = (find (/ element-gap (length timelines)) + timelines + :key #'smallest-gap + :test #'<) + until (null timeline) + do (decf element-gap (smallest-gap timeline)) + do (setf timelines (remove timeline timelines :test #'eq)) + finally (let ((gap (/ element-gap (length timelines)))) + (loop for timeline in timelines + do (setf (smallest-gap timeline) gap)))) + (loop for timeline = (let ((gap/elasticity (/ element-gap sum-elasticity))) + (find-if (lambda (timeline) + (> (smallest-gap timeline) + (* (elasticity timeline) gap/elasticity))) + timelines)) + until (null timeline) + do (decf element-gap (smallest-gap timeline)) + do (decf sum-elasticity (elasticity timeline)) + do (setf timelines (remove timeline timelines :test #'eq)) + finally (let ((gap/elasticity (/ element-gap sum-elasticity))) + (loop for timeline in timelines + do (setf (smallest-gap timeline) + (* (elasticity timeline) gap/elasticity)))))))))) + (loop for bar in bars + do (loop for (e1 e2) on (elements bar) + for t1 = (timeline e1) + do (cond ((null e2) + (unless (flexichain:flexi-last-p t1) + (let ((timelines (loop for tl = t1 then (flexichain:flexi-next tl) + collect tl + until (flexichain:flexi-last-p tl)))) + (handle-timelines timelines (right-bulge e1 pane))))) + ((not (eq (flexichain:flexi-next t1) + (timeline e2))) + (let ((timelines (loop for tl = t1 then (flexichain:flexi-next tl) + until (eq tl (timeline e2)) + collect tl))) + (handle-timelines timelines (+ (right-bulge e1 pane) + (left-bulge e2 pane)))))))))) + +(defun compute-gaps (measures method pane) (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)))))))))) + ;; initially, look only at adjacent elements whose + ;; corrsponding timelines are also adjacent, and at the last + ;; element of a bar, provided that its timeline is also the + ;; last one in the measure + do (compute-gaps-adjacent-timelines (measure-bars measure) method pane) + + ;; then look at adjacent elements whose corresponding + ;; timelines are NOT adjacent, or the last element of a bar + ;; whose corresponding timeline is not the last one in the meaure + do (compute-gaps-separated-timelines (measure-bars measure) method pane))) (defun draw-measure (pane measure min-dist compress x method draw-cursor) (let* ((width (/ (nat-width method (measure-coeff measure) min-dist)

1 0

[gsharp-cvs] CVS update: gsharp/Flexichain/flexichain-package.lisp gsharp/Flexichain/flexirank.lisp
by rstrandh＠common-lisp.net 28 Nov '05

28 Nov '05

Update of /project/gsharp/cvsroot/gsharp/Flexichain In directory common-lisp.net:/tmp/cvs-serv31819 Modified Files: flexichain-package.lisp flexirank.lisp Log Message: added flexi-first-p and flexi-last-p to flexirank.lisp Date: Mon Nov 28 22:27:03 2005 Author: rstrandh Index: gsharp/Flexichain/flexichain-package.lisp diff -u gsharp/Flexichain/flexichain-package.lisp:1.5 gsharp/Flexichain/flexichain-package.lisp:1.6 --- gsharp/Flexichain/flexichain-package.lisp:1.5 Mon Nov 28 00:43:50 2005 +++ gsharp/Flexichain/flexichain-package.lisp Mon Nov 28 22:27:02 2005 @@ -38,5 +38,6 @@ #:insert #:insert-sequence #:element< #:element> #:delete< #:delete> #:flexirank-mixin #:element-rank-mixin #:rank + #:flexi-first-p #:flexi-last-p #:flexi-next #:flexi-prev)) Index: gsharp/Flexichain/flexirank.lisp diff -u gsharp/Flexichain/flexirank.lisp:1.3 gsharp/Flexichain/flexirank.lisp:1.4 --- gsharp/Flexichain/flexirank.lisp:1.3 Mon Nov 28 01:25:59 2005 +++ gsharp/Flexichain/flexirank.lisp Mon Nov 28 22:27:02 2005 @@ -28,6 +28,8 @@ ;;; generic function rank. (defgeneric rank (element)) +(defgeneric flexi-first-p (element)) +(defgeneric flexi-last-p (element)) (defgeneric flexi-next (element)) (defgeneric flexi-prev (element)) @@ -38,16 +40,19 @@ (defmethod rank ((element element-rank-mixin)) (index-position (chain element) (index element))) +(defmethod flexi-first-p ((element element-rank-mixin)) + (zerop (rank element))) + +(defmethod flexi-last-p ((element element-rank-mixin)) + (= (rank element) (1- (nb-elements (chain element))))) + (defmethod flexi-next ((element element-rank-mixin)) - (let ((new-rank (1+ (rank element))) - (chain (chain element))) - (assert (< new-rank (nb-elements chain))) - (element* chain new-rank))) + (assert (not (flexi-last-p element))) + (element* (chain element) (1+ (rank element)))) (defmethod flexi-prev ((element element-rank-mixin)) - (let ((new-rank (1- (rank element)))) - (assert (not (minusp new-rank))) - (element* (chain element) new-rank))) + (assert (not (flexi-first-p element))) + (element* (chain element) (1- (rank element)))) ;;; this class must be mixed into a flexichain that contains ranked elements (defclass flexirank-mixin () ())

1 0

[gsharp-cvs] CVS update: gsharp/elasticity.lisp
by rstrandh＠common-lisp.net 28 Nov '05

28 Nov '05

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv23128 Added Files: elasticity.lisp Log Message: New file containing code for managing elasticity functions. It is not yet used in Gsharp, but it soon will be. Date: Mon Nov 28 20:34:18 2005 Author: rstrandh

1 0

[gsharp-cvs] CVS update: gsharp/drawing.lisp gsharp/measure.lisp gsharp/packages.lisp
by rstrandh＠common-lisp.net 27 Nov '05

27 Nov '05

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)

1 0

[gsharp-cvs] CVS update: gsharp/gsharp.asd gsharp/measure.lisp
by rstrandh＠common-lisp.net 27 Nov '05

27 Nov '05

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv12520 Modified Files: gsharp.asd measure.lisp Log Message: Added explicit timelines which will be used for a better spacing algorithm. Date: Mon Nov 28 03:32:06 2005 Author: rstrandh Index: gsharp/gsharp.asd diff -u gsharp/gsharp.asd:1.2 gsharp/gsharp.asd:1.3 --- gsharp/gsharp.asd:1.2 Mon Nov 21 21:37:45 2005 +++ gsharp/gsharp.asd Mon Nov 28 03:32:06 2005 @@ -20,7 +20,7 @@ :defaults *gsharp-directory*)) collect `(:file ,(pathname-name p) :pathname ,p)))))) -(gsharp-defsystem (:gsharp :depends-on (:mcclim)) +(gsharp-defsystem (:gsharp :depends-on (:mcclim :flexichain)) "packages" "esa" "utilities" Index: gsharp/measure.lisp diff -u gsharp/measure.lisp:1.14 gsharp/measure.lisp:1.15 --- gsharp/measure.lisp:1.14 Mon Nov 21 23:40:48 2005 +++ gsharp/measure.lisp Mon Nov 28 03:32:06 2005 @@ -47,7 +47,8 @@ ;;; modification to the element have taken place in the meantime. (defrclass relement element - ((duration :initform nil))) + ((duration :initform nil) + (timeline :accessor timeline))) (defmethod duration :around ((element relement)) (with-slots (duration) element @@ -380,15 +381,28 @@ ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;; -;;; Measure +;;; Timeline + +;;; A timeline of a measure is the set of all simultaneous elements of +;;; the bars of the meausure. The duration of a timeline is either +;;; the temporal distance between it and the next closest timeline +;;; following it, or, in case it is the last timeline of the measure, +;;; the duration of the longest element of the timeline. + +(defclass timeline (flexichain:element-rank-mixin) + ((start-time :initarg :start-time :reader start-time) + (elements :initform '() :accessor elements) + (duration :initarg :duration :reader duration) + (elasticity :accessor elasticity))) + +(defclass ranked-flexichain (flexichain:standard-flexichain flexichain:flexirank-mixin) + ()) -;;; A measure represents the set of simultaneous bars. Define a -;;; TIMELINE of a measure to be the set of all simultaneous elements -;;; of the bars of the measure. The DURATION of a timeline is either -;;; the temporal distance to the next closest timeline following it, -;;; or, in case it is the last timeline of the measure, the duration -;;; of the longest element of the timeline. +;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; +;;; +;;; Measure +;;; A measure represents the set of simultaneous bars. (defclass measure (obseq-elem) (;; the smallest duration of any timeline in the measure (min-dist :initarg :min-dist :reader measure-min-dist) @@ -406,7 +420,9 @@ (seg-pos :initarg :seg-pos :reader measure-seg-pos) (bar-pos :initarg :bar-pos :reader measure-bar-pos) ;; a list of the bars that make up this measure - (bars :initarg :bars :reader measure-bars))) + (bars :initarg :bars :reader measure-bars) + ;; the first timeline of the measure, or NIL of there are not timelines + (timelines :initform (make-instance 'ranked-flexichain) :reader timelines))) (defun make-measure (min-dist coeff start-times seg-pos bar-pos bars) (make-instance 'measure :min-dist min-dist :coeff coeff @@ -448,6 +464,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)) (setf (modified-p segment) nil))) (defmethod nb-measures ((segment rsegment)) @@ -630,6 +647,30 @@ (coeff (loop for duration in durations sum (expt duration spacing-style)))) (make-measure min-dist coeff start-times seg-pos bar-pos bars)))) + +(defun compute-timelines (measure) + (let ((timelines (timelines measure)) + (start-times (measure-start-times measure))) + ;; create a timeline for each start time of the measure + (loop for start-time in start-times + for duration in (abs-rel start-times) + for i from 0 + do (let ((timeline (make-instance 'timeline + :start-time start-time + :duration duration))) + (flexichain:insert* timelines i timeline))) + ;; link each timeline to its elements and each element of a + ;; timeline to the timeline + (loop for bar in (measure-bars measure) + do (loop for element in (elements bar) + for start-time = 0 then (+ start-time (duration element)) + for timeline-index from 0 + do (loop while (< (start-time (flexichain:element* timelines timeline-index)) + start-time) + do (incf timeline-index)) + do (let ((timeline (flexichain:element* timelines timeline-index))) + (push element (elements timeline)) + (setf (timeline element) timeline)))))) ;;; Compute all the measures of a segment by stepping through all the ;;; bars in parallel as long as there is at least one simultaneous bar.

1 0

[gsharp-cvs] CVS update: gsharp/Flexichain/flexirank.lisp
by rstrandh＠common-lisp.net 27 Nov '05

27 Nov '05

Update of /project/gsharp/cvsroot/gsharp/Flexichain In directory common-lisp.net:/tmp/cvs-serv2937 Modified Files: flexirank.lisp Log Message: Fixed a bug in the flexirank code. Or, rather, compensated for a quirk in flexichain.lisp that calls move-elements on sentinels. The best way would be to avoid this quirk, but I am not willing to modify the basic flexichain code right now. Date: Mon Nov 28 01:25:59 2005 Author: rstrandh Index: gsharp/Flexichain/flexirank.lisp diff -u gsharp/Flexichain/flexirank.lisp:1.2 gsharp/Flexichain/flexirank.lisp:1.3 --- gsharp/Flexichain/flexirank.lisp:1.2 Mon Nov 28 00:43:50 2005 +++ gsharp/Flexichain/flexirank.lisp Mon Nov 28 01:25:59 2005 @@ -52,10 +52,12 @@ ;;; this class must be mixed into a flexichain that contains ranked elements (defclass flexirank-mixin () ()) -(defmethod move-elements :after ((chain flexirank-mixin) to from start1 start2 end2) +(defmethod move-elements :before ((chain flexirank-mixin) to from start1 start2 end2) (loop for old from start2 below end2 for new from start1 - do (setf (index (aref from old)) new))) + do (let ((element (aref from old))) + (when (typep element 'element-rank-mixin) + (setf (index element) new))))) (defmethod insert* :after ((chain flexirank-mixin) position (object element-rank-mixin)) (setf (index object) (position-index chain position)

1 0

[gsharp-cvs] CVS update: gsharp/Flexichain/flexichain-package.lisp gsharp/Flexichain/flexichain.asd gsharp/Flexichain/flexirank.lisp
by rstrandh＠common-lisp.net 27 Nov '05

27 Nov '05

Update of /project/gsharp/cvsroot/gsharp/Flexichain In directory common-lisp.net:/tmp/cvs-serv32139 Modified Files: flexichain-package.lisp flexichain.asd flexirank.lisp Log Message: Added two more functions (flexi-next and flexi-prev) to flexirank. Date: Mon Nov 28 00:44:00 2005 Author: rstrandh Index: gsharp/Flexichain/flexichain-package.lisp diff -u gsharp/Flexichain/flexichain-package.lisp:1.4 gsharp/Flexichain/flexichain-package.lisp:1.5 --- gsharp/Flexichain/flexichain-package.lisp:1.4 Wed Nov 16 04:06:59 2005 +++ gsharp/Flexichain/flexichain-package.lisp Mon Nov 28 00:43:50 2005 @@ -37,5 +37,6 @@ #:move> #:move< #:insert #:insert-sequence #:element< #:element> #:delete< #:delete> - #:flexirank-mixin #:element-rank-mixin #:rank)) + #:flexirank-mixin #:element-rank-mixin #:rank + #:flexi-next #:flexi-prev)) Index: gsharp/Flexichain/flexichain.asd diff -u gsharp/Flexichain/flexichain.asd:1.4 gsharp/Flexichain/flexichain.asd:1.5 --- gsharp/Flexichain/flexichain.asd:1.4 Wed Nov 16 04:06:59 2005 +++ gsharp/Flexichain/flexichain.asd Mon Nov 28 00:43:50 2005 @@ -27,11 +27,11 @@ ;; The tester is not included, for it depends on clim. The stupid ;; implementation has also been left out, since it seems mostly useful ;; for testing. -(defsystem flexichain +(defsystem :flexichain :name "flexichain" :components ((:file "flexichain-package") (:file "utilities" :depends-on ("flexichain-package")) - (:file "flexichain" :depends-on ("utilities")) + (:file "flexichain" :depends-on ("utilities" "flexichain-package")) (:file "flexicursor" :depends-on ("flexichain")) (:file "flexirank" :depends-on ("flexichain")))) Index: gsharp/Flexichain/flexirank.lisp diff -u gsharp/Flexichain/flexirank.lisp:1.1 gsharp/Flexichain/flexirank.lisp:1.2 --- gsharp/Flexichain/flexirank.lisp:1.1 Wed Nov 16 04:06:59 2005 +++ gsharp/Flexichain/flexirank.lisp Mon Nov 28 00:43:50 2005 @@ -28,6 +28,8 @@ ;;; generic function rank. (defgeneric rank (element)) +(defgeneric flexi-next (element)) +(defgeneric flexi-prev (element)) (defclass element-rank-mixin () ((index :accessor index) @@ -35,6 +37,17 @@ (defmethod rank ((element element-rank-mixin)) (index-position (chain element) (index element))) + +(defmethod flexi-next ((element element-rank-mixin)) + (let ((new-rank (1+ (rank element))) + (chain (chain element))) + (assert (< new-rank (nb-elements chain))) + (element* chain new-rank))) + +(defmethod flexi-prev ((element element-rank-mixin)) + (let ((new-rank (1- (rank element)))) + (assert (not (minusp new-rank))) + (element* (chain element) new-rank))) ;;; this class must be mixed into a flexichain that contains ranked elements (defclass flexirank-mixin () ())

1 0

[gsharp-cvs] CVS update: gsharp/gui.lisp
by rstrandh＠common-lisp.net 26 Nov '05

26 Nov '05

Update of /project/gsharp/cvsroot/gsharp In directory common-lisp.net:/tmp/cvs-serv11943 Modified Files: gui.lisp Log Message: Invalidated elements of layers using a staff that has its key signature altered. Date: Sat Nov 26 22:30:43 2005 Author: rstrandh Index: gsharp/gui.lisp diff -u gsharp/gui.lisp:1.44 gsharp/gui.lisp:1.45 --- gsharp/gui.lisp:1.44 Sun Nov 20 20:17:22 2005 +++ gsharp/gui.lisp Sat Nov 26 22:30:13 2005 @@ -1089,39 +1089,59 @@ (layer (layer (cursor *application-frame*)))) (remove-staff-from-layer staff layer))) +(defun invalidate-slice-using-staff (slice staff) + (declare (ignore staff)) ; maybe use this later + (loop for bar in (bars slice) + do (loop for element in (elements bar) + do (mark-modified element)))) + (define-gsharp-command com-more-sharps () - (let ((keysig (keysig (car (staves (layer (cursor *application-frame*))))))) - (cond ((eq (aref keysig 3) :flat) (setf (aref keysig 3) :natural)) - ((eq (aref keysig 0) :flat) (setf (aref keysig 0) :natural)) - ((eq (aref keysig 4) :flat) (setf (aref keysig 4) :natural)) - ((eq (aref keysig 1) :flat) (setf (aref keysig 1) :natural)) - ((eq (aref keysig 5) :flat) (setf (aref keysig 5) :natural)) - ((eq (aref keysig 2) :flat) (setf (aref keysig 2) :natural)) - ((eq (aref keysig 6) :flat) (setf (aref keysig 6) :natural)) - ((eq (aref keysig 3) :natural) (setf (aref keysig 3) :sharp)) - ((eq (aref keysig 0) :natural) (setf (aref keysig 0) :sharp)) - ((eq (aref keysig 4) :natural) (setf (aref keysig 4) :sharp)) - ((eq (aref keysig 1) :natural) (setf (aref keysig 1) :sharp)) - ((eq (aref keysig 5) :natural) (setf (aref keysig 5) :sharp)) - ((eq (aref keysig 2) :natural) (setf (aref keysig 2) :sharp)) - ((eq (aref keysig 6) :natural) (setf (aref keysig 6) :sharp))))) + (let ((staff (car (staves (layer (cursor *application-frame*)))))) + (loop for segment in (segments (buffer *application-frame*)) + do (loop for layer in (layers segment) + do (when (member staff (staves layer)) + (invalidate-slice-using-staff (head layer) staff) + (invalidate-slice-using-staff (body layer) staff) + (invalidate-slice-using-staff (tail layer) staff)))) + (let ((keysig (keysig staff))) + (cond ((eq (aref keysig 3) :flat) (setf (aref keysig 3) :natural)) + ((eq (aref keysig 0) :flat) (setf (aref keysig 0) :natural)) + ((eq (aref keysig 4) :flat) (setf (aref keysig 4) :natural)) + ((eq (aref keysig 1) :flat) (setf (aref keysig 1) :natural)) + ((eq (aref keysig 5) :flat) (setf (aref keysig 5) :natural)) + ((eq (aref keysig 2) :flat) (setf (aref keysig 2) :natural)) + ((eq (aref keysig 6) :flat) (setf (aref keysig 6) :natural)) + ((eq (aref keysig 3) :natural) (setf (aref keysig 3) :sharp)) + ((eq (aref keysig 0) :natural) (setf (aref keysig 0) :sharp)) + ((eq (aref keysig 4) :natural) (setf (aref keysig 4) :sharp)) + ((eq (aref keysig 1) :natural) (setf (aref keysig 1) :sharp)) + ((eq (aref keysig 5) :natural) (setf (aref keysig 5) :sharp)) + ((eq (aref keysig 2) :natural) (setf (aref keysig 2) :sharp)) + ((eq (aref keysig 6) :natural) (setf (aref keysig 6) :sharp)))))) (define-gsharp-command com-more-flats () - (let ((keysig (keysig (car (staves (layer (cursor *application-frame*))))))) - (cond ((eq (aref keysig 6) :sharp) (setf (aref keysig 6) :natural)) - ((eq (aref keysig 2) :sharp) (setf (aref keysig 2) :natural)) - ((eq (aref keysig 5) :sharp) (setf (aref keysig 5) :natural)) - ((eq (aref keysig 1) :sharp) (setf (aref keysig 1) :natural)) - ((eq (aref keysig 4) :sharp) (setf (aref keysig 4) :natural)) - ((eq (aref keysig 0) :sharp) (setf (aref keysig 0) :natural)) - ((eq (aref keysig 3) :sharp) (setf (aref keysig 3) :natural)) - ((eq (aref keysig 6) :natural) (setf (aref keysig 6) :flat)) - ((eq (aref keysig 2) :natural) (setf (aref keysig 2) :flat)) - ((eq (aref keysig 5) :natural) (setf (aref keysig 5) :flat)) - ((eq (aref keysig 1) :natural) (setf (aref keysig 1) :flat)) - ((eq (aref keysig 4) :natural) (setf (aref keysig 4) :flat)) - ((eq (aref keysig 0) :natural) (setf (aref keysig 0) :flat)) - ((eq (aref keysig 3) :natural) (setf (aref keysig 3) :flat))))) + (let ((staff (car (staves (layer (cursor *application-frame*)))))) + (loop for segment in (segments (buffer *application-frame*)) + do (loop for layer in (layers segment) + do (when (member staff (staves layer)) + (invalidate-slice-using-staff (head layer) staff) + (invalidate-slice-using-staff (body layer) staff) + (invalidate-slice-using-staff (tail layer) staff)))) + (let ((keysig (keysig staff))) + (cond ((eq (aref keysig 6) :sharp) (setf (aref keysig 6) :natural)) + ((eq (aref keysig 2) :sharp) (setf (aref keysig 2) :natural)) + ((eq (aref keysig 5) :sharp) (setf (aref keysig 5) :natural)) + ((eq (aref keysig 1) :sharp) (setf (aref keysig 1) :natural)) + ((eq (aref keysig 4) :sharp) (setf (aref keysig 4) :natural)) + ((eq (aref keysig 0) :sharp) (setf (aref keysig 0) :natural)) + ((eq (aref keysig 3) :sharp) (setf (aref keysig 3) :natural)) + ((eq (aref keysig 6) :natural) (setf (aref keysig 6) :flat)) + ((eq (aref keysig 2) :natural) (setf (aref keysig 2) :flat)) + ((eq (aref keysig 5) :natural) (setf (aref keysig 5) :flat)) + ((eq (aref keysig 1) :natural) (setf (aref keysig 1) :flat)) + ((eq (aref keysig 4) :natural) (setf (aref keysig 4) :flat)) + ((eq (aref keysig 0) :natural) (setf (aref keysig 0) :flat)) + ((eq (aref keysig 3) :natural) (setf (aref keysig 3) :flat)))))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; ;;;

1 0