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.