From dpsenicka at common-lisp.net Fri Sep 2 05:56:48 2005 From: dpsenicka at common-lisp.net (David Psenicka) Date: Fri, 2 Sep 2005 07:56:48 +0200 (CEST) Subject: [fomus-cvs] CVS update: fomus/data.lisp fomus/fomus.asd fomus/test.lisp fomus/util.lisp fomus/version.lisp Message-ID: <20050902055648.5A6B4880E6@common-lisp.net> Update of /project/fomus/cvsroot/fomus In directory common-lisp.net:/tmp/cvs-serv27402 Modified Files: data.lisp fomus.asd test.lisp util.lisp version.lisp Log Message: bug fixes Date: Fri Sep 2 07:56:46 2005 Author: dpsenicka Index: fomus/data.lisp diff -u fomus/data.lisp:1.21 fomus/data.lisp:1.22 --- fomus/data.lisp:1.21 Wed Aug 31 23:17:59 2005 +++ fomus/data.lisp Fri Sep 2 07:56:45 2005 @@ -391,7 +391,7 @@ else if (= (instr-staves e) 2) collect (list :grandstaff sy) into k else if (find sy '(:soprano :mezzo-soprano :contralto :tenor :tenor-8dn :baritone :bass)) collect sy into v else if (find sy '(:soprano-choir :alto-choir :tenor-choir :bass-choir)) collect sy into c - else collect (cons (list :group sy) (/ (+ (instr-minp e) (instr-maxp e)) 2)) into i + else collect (cons (list :group sy) (instr-minp e)) into i finally (return (nconc (mapcar #'car (sort i #'> :key #'cdr)) p (list (cons :choirgroup v)) (list (cons :choirgroup c)) k)))))) Index: fomus/fomus.asd diff -u fomus/fomus.asd:1.9 fomus/fomus.asd:1.10 --- fomus/fomus.asd:1.9 Wed Aug 31 23:17:59 2005 +++ fomus/fomus.asd Fri Sep 2 07:56:45 2005 @@ -4,7 +4,7 @@ (asdf:defsystem "fomus" :description "Lisp music notation formatter" - :version "0.1.13" + :version "0.1.14" :author "David Psenicka" :licence "LLGPL" Index: fomus/test.lisp diff -u fomus/test.lisp:1.11 fomus/test.lisp:1.12 --- fomus/test.lisp:1.11 Wed Aug 31 23:18:00 2005 +++ fomus/test.lisp Fri Sep 2 07:56:45 2005 @@ -866,4 +866,3 @@ ;; Grace note rests ;; Mark Spanners ;; Compound meter -;; Auto Time Signatures \ No newline at end of file Index: fomus/util.lisp diff -u fomus/util.lisp:1.16 fomus/util.lisp:1.17 --- fomus/util.lisp:1.16 Wed Aug 31 23:18:00 2005 +++ fomus/util.lisp Fri Sep 2 07:56:45 2005 @@ -462,8 +462,8 @@ do (mapc (lambda (x) (declare (type symbol x)) (rmmark e x)) +marks-last-rest+) do (loop for sp in (list +marks-spanner-voices+ +marks-spanner-staves+) do (loop for (startsym contsym endsym) of-type (symbol symbol symbol) in sp - do (loop for (xxx n) in (getmarks e startsym) do (rmmark e (list contsym n))) - do (loop for (xxx n) in (getmarks e endsym) do (rmmark e (list contsym n))))))) + do (loop for n in (getmarks e startsym) do (rmmark e (list contsym (second (force-list n))))) + do (loop for n in (getmarks e endsym) do (rmmark e (list contsym (second (force-list n))))))))) (print-dot))) ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; @@ -569,7 +569,7 @@ si) when (> and mx) do (setf mx and) do (funcall fun p at o and) ; part, timesig, o1, o2 - finally (return (cons and at))))) + finally (return (when and (cons and at)))))) (loop with dts = (make-timesigex* *default-timesig*) for p in parts and (lo . at) in (loop @@ -596,7 +596,8 @@ (>= (- (timesig-off e2) (timesig-off e1)) (or *min-auto-timesig-dur* 0))) collect e1) z)) - do (setf at (ut ts p (when nx (timesig-off nx)) (car at))) ; (print-dot) + do (let ((x (ut ts p (when nx (timesig-off nx)) (car at)))) + (when x (setf at x))) ; (print-dot) finally (return at))) do (ut at p mx lo) #|(print-dot)|#)))) Index: fomus/version.lisp diff -u fomus/version.lisp:1.8 fomus/version.lisp:1.9 --- fomus/version.lisp:1.8 Wed Aug 31 23:18:00 2005 +++ fomus/version.lisp Fri Sep 2 07:56:45 2005 @@ -12,7 +12,7 @@ (declaim (type string +title+) (type cons +version+ +banner+)) (defparameter +title+ "FOMUS") -(defparameter +version+ '(0 1 13)) +(defparameter +version+ '(0 1 14)) (defparameter +banner+ `("Lisp music notation formatter" "Copyright (c) 2005 David Psenicka, All Rights Reserved" From dpsenicka at common-lisp.net Sat Sep 3 19:57:18 2005 From: dpsenicka at common-lisp.net (David Psenicka) Date: Sat, 3 Sep 2005 21:57:18 +0200 (CEST) Subject: [fomus-cvs] CVS update: fomus/classes.lisp fomus/fomus.asd fomus/test.lisp fomus/version.lisp fomus/CHANGELOG Message-ID: <20050903195718.06013880E6@common-lisp.net> Update of /project/fomus/cvsroot/fomus In directory common-lisp.net:/tmp/cvs-serv21550 Modified Files: classes.lisp fomus.asd test.lisp version.lisp Removed Files: CHANGELOG Log Message: bug fixes Date: Sat Sep 3 21:57:14 2005 Author: dpsenicka Index: fomus/classes.lisp diff -u fomus/classes.lisp:1.11 fomus/classes.lisp:1.12 --- fomus/classes.lisp:1.11 Tue Aug 30 00:28:03 2005 +++ fomus/classes.lisp Sat Sep 3 21:57:14 2005 @@ -21,7 +21,7 @@ ((time :type cons :accessor timesig-time :initform '(4 4) :initarg :time) (div :type list :accessor timesig-div :initform nil :initarg :div) ; list of divisions to force, ex: '((3 3 2) (3 2 3)) or '((3/2 1) (1 3/2)) (comp :type boolean :accessor timesig-comp :initform nil :initarg :comp) ; t or nil - (beat :type (or (rational 0) null) :accessor timesig-beat :initform 1/4 :initarg :beat) ; what actually gets the beat (ex: 1/4 = quarter note, 1/4 + 1/8 = dotted quarter), compound is deterined from signature + (beat :type (or (rational 0) null) :accessor timesig-beat :initform nil :initarg :beat) ; what actually gets the beat (ex: 1/4 = quarter note, 1/4 + 1/8 = dotted quarter), compound is deterined from signature (props :type list :accessor timesig-props :initform nil :initarg :props))) (defclass timesig (timesig-repl event-base) ((off :type (rational 0)) Index: fomus/fomus.asd diff -u fomus/fomus.asd:1.10 fomus/fomus.asd:1.11 --- fomus/fomus.asd:1.10 Fri Sep 2 07:56:45 2005 +++ fomus/fomus.asd Sat Sep 3 21:57:14 2005 @@ -4,7 +4,7 @@ (asdf:defsystem "fomus" :description "Lisp music notation formatter" - :version "0.1.14" + :version "0.1.15" :author "David Psenicka" :licence "LLGPL" Index: fomus/test.lisp diff -u fomus/test.lisp:1.12 fomus/test.lisp:1.13 --- fomus/test.lisp:1.12 Fri Sep 2 07:56:45 2005 +++ fomus/test.lisp Sat Sep 3 21:57:14 2005 @@ -808,7 +808,7 @@ (fomus ; :auto-percussion-durs :backend '((:data) (:lilypond :view t)) :ensemble-type :orchestra - :auto-percussion-durs nil + :auto-percussion-durs t :parts (list (make-part :name "Percussion" @@ -866,3 +866,4 @@ ;; Grace note rests ;; Mark Spanners ;; Compound meter + Index: fomus/version.lisp diff -u fomus/version.lisp:1.9 fomus/version.lisp:1.10 --- fomus/version.lisp:1.9 Fri Sep 2 07:56:45 2005 +++ fomus/version.lisp Sat Sep 3 21:57:14 2005 @@ -12,7 +12,7 @@ (declaim (type string +title+) (type cons +version+ +banner+)) (defparameter +title+ "FOMUS") -(defparameter +version+ '(0 1 14)) +(defparameter +version+ '(0 1 15)) (defparameter +banner+ `("Lisp music notation formatter" "Copyright (c) 2005 David Psenicka, All Rights Reserved" From dpsenicka at common-lisp.net Tue Sep 13 21:39:16 2005 From: dpsenicka at common-lisp.net (David Psenicka) Date: Tue, 13 Sep 2005 23:39:16 +0200 (CEST) Subject: [fomus-cvs] CVS update: fomus/TODO fomus/fomus.asd fomus/staves.lisp fomus/test.lisp fomus/version.lisp Message-ID: <20050913213916.730A68815C@common-lisp.net> Update of /project/fomus/cvsroot/fomus In directory common-lisp.net:/tmp/cvs-serv17171 Modified Files: TODO fomus.asd staves.lisp test.lisp version.lisp Log Message: bug fixes Date: Tue Sep 13 23:39:14 2005 Author: dpsenicka Index: fomus/TODO diff -u fomus/TODO:1.19 fomus/TODO:1.20 --- fomus/TODO:1.19 Wed Aug 31 23:17:59 2005 +++ fomus/TODO Tue Sep 13 23:39:14 2005 @@ -2,7 +2,8 @@ Immediate: - Testing and bug fixes + Bugs: + Quantizing nested tuplets--occasional hangups Splitting chords across staves (LilyPond) STAFF, CLEF and other marks for overriding FOMUS's decisions MusicXML backend @@ -12,7 +13,7 @@ most often used settings easy, indexed examples of all features Tuplet bracket setting - Marks affecting all voices + Marks affecting all voices (distinguishing them for purposes of MIDI playback, etc.) Aesthetic tweaks: avoid staff changes when notes move in other direction re-evaluate initial clef decision in measure 1 Index: fomus/fomus.asd diff -u fomus/fomus.asd:1.11 fomus/fomus.asd:1.12 --- fomus/fomus.asd:1.11 Sat Sep 3 21:57:14 2005 +++ fomus/fomus.asd Tue Sep 13 23:39:14 2005 @@ -4,7 +4,7 @@ (asdf:defsystem "fomus" :description "Lisp music notation formatter" - :version "0.1.15" + :version "0.1.16" :author "David Psenicka" :licence "LLGPL" Index: fomus/staves.lisp diff -u fomus/staves.lisp:1.9 fomus/staves.lisp:1.10 --- fomus/staves.lisp:1.9 Tue Aug 30 00:28:03 2005 +++ fomus/staves.lisp Tue Sep 13 23:39:14 2005 @@ -122,12 +122,17 @@ (push e li) (if (eq c0 (clefs-getclef nil li s)) ; goes back to original clef (return) - (if (or (or (null *clef-force-clef-change-dist*) + (if (or (and *clef-force-clef-change-dist* (> (- oo o) *clef-force-clef-change-dist*)) ; going too far (eq c (clefs-getclef c0 li s))) ; finally supported by necessary change (return t) (setf li (list e))))) ; necessary to change - (setf oo (event-off e) gg (event-grace e) li (list e)))))) + (setf oo (event-off e) gg (event-grace e) li (list e))) + finally + (return (unless (or (null li) (eq c0 (clefs-getclef nil li s))) ; goes back to original clef + (or (and *clef-force-clef-change-dist* + (> (- oo o) *clef-force-clef-change-dist*)) ; going too far + (eq c (clefs-getclef c0 li s)))))))) (setf (svref cs s) c ve (cons (let ((x (copy-event (first ve)))) (addmark x (list :clef c)) x) (rest ve))) Index: fomus/test.lisp diff -u fomus/test.lisp:1.13 fomus/test.lisp:1.14 --- fomus/test.lisp:1.13 Sat Sep 3 21:57:14 2005 +++ fomus/test.lisp Tue Sep 13 23:39:14 2005 @@ -11,7 +11,7 @@ (list (make-part :name "Piano" - :instr :piano + :instr '(:piano :staves 1) :events (loop for off from 0 to 10 by 1/2 Index: fomus/version.lisp diff -u fomus/version.lisp:1.10 fomus/version.lisp:1.11 --- fomus/version.lisp:1.10 Sat Sep 3 21:57:14 2005 +++ fomus/version.lisp Tue Sep 13 23:39:14 2005 @@ -12,7 +12,7 @@ (declaim (type string +title+) (type cons +version+ +banner+)) (defparameter +title+ "FOMUS") -(defparameter +version+ '(0 1 15)) +(defparameter +version+ '(0 1 16)) (defparameter +banner+ `("Lisp music notation formatter" "Copyright (c) 2005 David Psenicka, All Rights Reserved" From dpsenicka at common-lisp.net Tue Sep 20 23:23:18 2005 From: dpsenicka at common-lisp.net (David Psenicka) Date: Wed, 21 Sep 2005 01:23:18 +0200 (CEST) Subject: [fomus-cvs] CVS update: fomus/TODO fomus/package.lisp fomus/test.lisp fomus/util.lisp Message-ID: <20050920232318.E341688584@common-lisp.net> Update of /project/fomus/cvsroot/fomus In directory common-lisp.net:/tmp/cvs-serv21627 Modified Files: TODO package.lisp test.lisp util.lisp Log Message: minor changes Date: Wed Sep 21 01:23:16 2005 Author: dpsenicka Index: fomus/TODO diff -u fomus/TODO:1.20 fomus/TODO:1.21 --- fomus/TODO:1.20 Tue Sep 13 23:39:14 2005 +++ fomus/TODO Wed Sep 21 01:23:15 2005 @@ -4,6 +4,7 @@ Bugs: Quantizing nested tuplets--occasional hangups + Doc: list-instr-syms Splitting chords across staves (LilyPond) STAFF, CLEF and other marks for overriding FOMUS's decisions MusicXML backend Index: fomus/package.lisp diff -u fomus/package.lisp:1.10 fomus/package.lisp:1.11 --- fomus/package.lisp:1.10 Sun Aug 21 21:17:41 2005 +++ fomus/package.lisp Wed Sep 21 01:23:15 2005 @@ -14,7 +14,7 @@ (:export "FOMUS" "LOAD-INITFILE" ; interface functions "FOMUS-INIT" "FOMUS-NEWTIMESIG" "FOMUS-NEWPART" "FOMUS-NEWMARK" "FOMUS-NEWNOTE" "FOMUS-NEWREST" "FOMUS-EXEC" "FOMUS-PART" "LIST-FOMUS-SETTINGS" "LIST-FOMUS-INSTRUMENTS" "LIST-FOMUS-INSTRGROUPS" "LIST-FOMUS-PERCUSSION" "LIST-FOMUS-CLEFS" - "LIST-FOMUS-MEAS-DIVS" "LIST-FOMUS-TUPLET-DIVS" "GET-MIDI-INSTR" "IS-INSTR" "IS-CLEF" + "LIST-FOMUS-MEAS-DIVS" "LIST-FOMUS-TUPLET-DIVS" "GET-MIDI-INSTR" "IS-INSTR" "IS-CLEF" "GET-INSTR-SYMS" ; make/copy functions "MAKE-TIMESIG" "MAKE-TIMESIG-REPL" "MAKE-PART" "MAKE-MARK" "MAKE-NOTE" "MAKE-REST" "MAKE-INSTR" "MAKE-PERC" "COPY-INSTR" "COPY-PERC" "MAKE-MEAS" "COPY-TIMESIG" "COPY-TIMESIG-REPL" "COPY-EVENT" "COPY-PART" "COPY-MEAS" Index: fomus/test.lisp diff -u fomus/test.lisp:1.14 fomus/test.lisp:1.15 --- fomus/test.lisp:1.14 Tue Sep 13 23:39:14 2005 +++ fomus/test.lisp Wed Sep 21 01:23:15 2005 @@ -11,7 +11,7 @@ (list (make-part :name "Piano" - :instr '(:piano :staves 1) + :instr :piano :events (loop for off from 0 to 10 by 1/2 Index: fomus/util.lisp diff -u fomus/util.lisp:1.17 fomus/util.lisp:1.18 --- fomus/util.lisp:1.17 Fri Sep 2 07:56:45 2005 +++ fomus/util.lisp Wed Sep 21 01:23:15 2005 @@ -788,6 +788,10 @@ (loop for (s sn) on (rest +instr-keys+) collect (format nil (if sn "~A: ~S " "~A: ~S") (string-downcase s) (slot-value e (intern (symbol-name s) :fomus))))))))) +(defun get-instr-syms () + (set-instruments + (mapcar #'instr-sym (remove-duplicates (append *instruments* +instruments+) :key #'instr-sym :from-end t)))) + (defun list-fomus-percussion () (loop with li = (remove-duplicates *percussion* :key #'perc-sym :from-end t) with c = (+ (loop for e in li maximize (length (symbol-name (perc-sym e)))) 3) From dpsenicka at common-lisp.net Wed Sep 21 16:54:34 2005 From: dpsenicka at common-lisp.net (David Psenicka) Date: Wed, 21 Sep 2005 18:54:34 +0200 (CEST) Subject: [fomus-cvs] CVS update: fomus/beams.lisp fomus/split.lisp fomus/splitrules.lisp Message-ID: <20050921165434.1BE6D880DE@common-lisp.net> Update of /project/fomus/cvsroot/fomus In directory common-lisp.net:/tmp/cvs-serv30339 Modified Files: beams.lisp split.lisp splitrules.lisp Log Message: bug fixes Date: Wed Sep 21 18:54:31 2005 Author: dpsenicka Index: fomus/beams.lisp diff -u fomus/beams.lisp:1.6 fomus/beams.lisp:1.7 --- fomus/beams.lisp:1.6 Sun Aug 21 21:17:40 2005 +++ fomus/beams.lisp Wed Sep 21 18:54:31 2005 @@ -147,13 +147,13 @@ for (e0 e1) of-type ((or noteex restex) (or noteex restex null)) on ee while e1 for nb = (event-nbeams e1 ts) when (and (notep e0) (notep e1) (> (event-beamrt e0) 0) ; (event-nbeams e0 ts) - (and (< (event-beamlt e1) nb) (< (event-beamrt e1) nb))) + (< (event-beamlt e1) nb) #|(and (< (event-beamlt e1) nb) (< (event-beamrt e1) nb))|#) ; DEBUG do (push (cons (event-nbeams e1 ts) e1) ll))) (loop for ee of-type cons in spb do (loop for (e0 e1) of-type ((or noteex restex) (or noteex restex null)) on ee while e1 for nb = (event-nbeams e1 ts) when (and (notep e0) (notep e1) (> (event-beamlt e0) 0) ; (event-nbeams e0 ts) - (and (< (event-beamlt e1) nb) (< (event-beamrt e1) nb))) + (< (event-beamrt e1) nb) #|(and (< (event-beamlt e1) nb) (< (event-beamrt e1) nb))|#) ; DEBUG do (push (cons (event-nbeams e1 ts) e1) lr))) (loop for (nb . e) of-type ((integer 0) . noteex) in ll do (setf (event-beamlt e) nb)) (loop for (nb . e) of-type ((integer 0) . noteex) in lr do (setf (event-beamrt e) nb))))) Index: fomus/split.lisp diff -u fomus/split.lisp:1.16 fomus/split.lisp:1.17 --- fomus/split.lisp:1.16 Wed Aug 31 23:17:59 2005 +++ fomus/split.lisp Wed Sep 21 18:54:31 2005 @@ -257,7 +257,7 @@ (if (rule-comp rule) (no 2/3) (or (no 1) (no 2/3) (and (no 4/7) (not (event-noddot ev)))))))))) (unit-nodiv ; tlt/trt: nil = ties not allowed, t = tie is possible (etypecase ev - (rest #|nil|# (and (rule-rst rule) (no 1))) ; + (rest #|nil|# (and (rule-rst rule) (no 1))) ; (note (let ((aa (or (ti (event-tielt ev)) (ti (event-tiert ev))))) (and ; these are special, so duration is assumed to be valid (or (rule-tlt rule) aa) @@ -372,7 +372,7 @@ (declare (type cons sp rr)) (loop with nx = evs - for o of-type (rational (0) 1) in sp and r in rr ; o = split offset, r = rule + for o of-type (rational (0) 1) in sp and r in rr ; o = split offset, r = rule collect (loop with u = (when (baseunitp r) (rule-tup r)) ; u = tuplet list--rule should have all tuplet information for note and m = (when (baseunitp r) (rule-dmu r)) @@ -474,10 +474,10 @@ for e of-type (or noteex restex) in li when (restp e) do (setf (event-nomerge e) g))) (let ((re (or (itdepfirst*-engine (make-splitnode :rl #|(if (timesig-div* timesig) - (make-initdiv :time (timesig-time timesig) :comp (timesig-comp timesig) :beat (timesig-beat* timesig) - :list (timesig-div* timesig) :tsoff (timesig-off timesig) :comp (timesig-comp timesig)) - (make-sig :time (timesig-time timesig) :comp (timesig-comp timesig) :beat (timesig-beat* timesig) - :alt t :art t :top t :comp (timesig-comp timesig)))|# + (make-initdiv :time (timesig-time timesig) :comp (timesig-comp timesig) :beat (timesig-beat* timesig) + :list (timesig-div* timesig) :tsoff (timesig-off timesig) :comp (timesig-comp timesig)) + (make-sig :time (timesig-time timesig) :comp (timesig-comp timesig) :beat (timesig-beat* timesig) + :alt t :art t :top t :comp (timesig-comp timesig)))|# (first-splitrule timesig) :evs evs :of1 off :of2 endoff) Index: fomus/splitrules.lisp diff -u fomus/splitrules.lisp:1.4 fomus/splitrules.lisp:1.5 --- fomus/splitrules.lisp:1.4 Wed Aug 31 16:07:10 2005 +++ fomus/splitrules.lisp Wed Sep 21 18:54:31 2005 @@ -43,7 +43,7 @@ (defclass unit (baserule basesplit baseunit basecomp) ((div :type (integer 2) :accessor rule-div :initform 1 :initarg :div) ; 2? (sim :type (or null (rational (0))) :accessor rule-sim :initform nil :initarg :sim) - (sis :type (integer 0 1) :accessor rule-sis :initform 0 :initarg :sis))) + (sis :type (integer 0 1) :accessor rule-sis :initform 0 :initarg :sis))) ; simple-score: rules with sim values are split into two rules with sis = 0 and 1 (1 = no simple value) (defclass sig-nodiv (baserule basenodiv basecomp) ()) (defclass unit-nodiv (baserule basenodiv baseunit basecomp) ((rst :type boolean :accessor rule-rst :initform nil :initarg :rst))) @@ -109,9 +109,11 @@ (loop for (e1 e2) of-type ((rational 0 1) (or (rational 0 1) null)) on (cons 0 (append x '(1))) while e2 for ii in (if (listp i) i (list i (- tup i))) and tt = (- e2 e1) and a1 = t then a2 for a2 = (or (= e2 1) (and (expof2 e2) (expof2 (- tup e2)))) collect - (if (and (<= ii 1) (if (unitp rule) (rule-sim rule) t)) - (make-unit-nodiv :tup (cons tt tu) :comp (rule-comp rule) :dmu dmu :tlt t :trt t) - (make-unit :div (dv2 ii) :tup (cons tt tu) :dmu dmu :alt a1 :art a2 :irr ir :comp (rule-comp rule) :sim (when (eq tups :s) ii)))))))))) + (make-unit :div (dv2 ii) :tup (cons tt tu) :dmu dmu :alt a1 :art a2 :irr ir :comp (rule-comp rule) :sim (when (eq tups :s) ii)) +;; (if (and (<= ii 1) (if (unitp rule) (rule-sim rule) t)) +;; (make-unit-nodiv :tup (cons tt tu) :comp (rule-comp rule) :dmu dmu :tlt t :trt t) +;; (make-unit :div (dv2 ii) :tup (cons tt tu) :dmu dmu :alt a1 :art a2 :irr ir :comp (rule-comp rule) :sim (when (eq tups :s) ii))) + ))))))) (sort (etypecase rule ((or initdiv sig) (let* ((num (/ (rule-num rule) (* (rule-den rule) (rule-beat rule)))) ; 3/8 is treated like 1/4, etc. From dpsenicka at common-lisp.net Wed Sep 21 17:00:53 2005 From: dpsenicka at common-lisp.net (David Psenicka) Date: Wed, 21 Sep 2005 19:00:53 +0200 (CEST) Subject: [fomus-cvs] CVS update: fomus/beams.lisp Message-ID: <20050921170053.C8CDD880DE@common-lisp.net> Update of /project/fomus/cvsroot/fomus In directory common-lisp.net:/tmp/cvs-serv31085 Modified Files: beams.lisp Log Message: bug fixes Date: Wed Sep 21 19:00:53 2005 Author: dpsenicka Index: fomus/beams.lisp diff -u fomus/beams.lisp:1.7 fomus/beams.lisp:1.8 --- fomus/beams.lisp:1.7 Wed Sep 21 18:54:31 2005 +++ fomus/beams.lisp Wed Sep 21 19:00:53 2005 @@ -147,13 +147,13 @@ for (e0 e1) of-type ((or noteex restex) (or noteex restex null)) on ee while e1 for nb = (event-nbeams e1 ts) when (and (notep e0) (notep e1) (> (event-beamrt e0) 0) ; (event-nbeams e0 ts) - (< (event-beamlt e1) nb) #|(and (< (event-beamlt e1) nb) (< (event-beamrt e1) nb))|#) ; DEBUG + (and (< (event-beamlt e1) nb) (< (event-beamrt e1) nb))) do (push (cons (event-nbeams e1 ts) e1) ll))) (loop for ee of-type cons in spb do (loop for (e0 e1) of-type ((or noteex restex) (or noteex restex null)) on ee while e1 for nb = (event-nbeams e1 ts) when (and (notep e0) (notep e1) (> (event-beamlt e0) 0) ; (event-nbeams e0 ts) - (< (event-beamrt e1) nb) #|(and (< (event-beamlt e1) nb) (< (event-beamrt e1) nb))|#) ; DEBUG + (and (< (event-beamlt e1) nb) (< (event-beamrt e1) nb))) do (push (cons (event-nbeams e1 ts) e1) lr))) (loop for (nb . e) of-type ((integer 0) . noteex) in ll do (setf (event-beamlt e) nb)) (loop for (nb . e) of-type ((integer 0) . noteex) in lr do (setf (event-beamrt e) nb)))))