Update of /project/fomus/cvsroot/fomus In directory common-lisp:/tmp/cvs-serv27315

Modified Files: backend_cmn.lisp split.lisp splitrules.lisp version.lisp Log Message: irreg. measure split bug

--- /project/fomus/cvsroot/fomus/backend_cmn.lisp 2006/02/11 22:39:40 1.8 +++ /project/fomus/cvsroot/fomus/backend_cmn.lisp 2006/02/13 19:51:27 1.9 @@ -5,11 +5,6 @@ ;; backend_cmn.lisp ;;**************************************************************************************************

-; Unused lexical variable HA, in SAVE-CMN. -; Unused lexical variable HS, in SAVE-CMN. -; Unused lexical variable XXX (6 references), in SAVE-CMN. -; Unused lexical variable TU, in SAVE-CMN. - (in-package :fomus) (compile-settings)

@@ -203,7 +198,7 @@ for co = (+ stoff (cmndur (- (event-off e) (meas-off m)) m)) and l = (and (notep e) (> (event-beamlt e) 0)) and r = (and (notep e) (> (event-beamrt e) 0)) - and tu = (getmark e :starttup) + ;;and tu = (getmark e :starttup) do (setf st (or (third (getmark e '(:staff :voice))) st)) when (and r (not l)) do (when ee (setf (car ee) '-beam ee nil)) ;;(event-off e) @@ -228,8 +223,8 @@ and w in (event-writtennotes e) and a in (event-accs e) and a2 in (event-addaccs e) - for ha = (getmark e (list :harmonic :touched n)) - and hs = (getmark e (list :harmonic :sounding n)) + ;;for ha = (getmark e (list :harmonic :touched n)) + ;;and hs = (getmark e (list :harmonic :sounding n)) collect (cmnnote w a a2 nil (getmark e (list :hideacc n)) (getmark e (list :showacc n)) --- /project/fomus/cvsroot/fomus/split.lisp 2005/09/21 16:54:31 1.17 +++ /project/fomus/cvsroot/fomus/split.lisp 2006/02/13 19:51:28 1.18 @@ -353,7 +353,7 @@ (let ((x (sort (copy-list li) (complement #'sort-offdur)))) (setf li (ex (second x) (first x) x)))))) li)) - (let ((lm (/ (* (beat-division timesig) 8 #|65536|#)))) + (let ((lm (/ (* (beat-division timesig) 8)))) (flet ((scorefun (nd) ; score relative to ea. level (declare (type splitnode nd)) (let ((sis (if (unitp (splitnode-rl nd)) (rule-sis (splitnode-rl nd)) 0))) @@ -473,12 +473,7 @@ (loop with g = (delete-duplicates (mapcar #'event-off gr)) 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)))|# - (first-splitrule timesig) + (make-splitnode :rl (first-splitrule timesig) :evs evs :of1 off :of2 endoff) #'scorefun #'expandfun #'assemfun #'solutfun --- /project/fomus/cvsroot/fomus/splitrules.lisp 2005/09/21 16:54:31 1.5 +++ /project/fomus/cvsroot/fomus/splitrules.lisp 2006/02/13 19:51:28 1.6 @@ -109,11 +109,7 @@ (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 - (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))) - ))))))) + (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. @@ -122,45 +118,47 @@ (declare (type (member t :all :top :sig) sy)) (or (find sy '(t :all :sig)) (and (eq sy :top) (or (initdivp rule) (rule-top rule))))) - (in (n al ar in) ; n = division ratio + (in (n al ar in &optional ir) ; n = division ratio, ir = if rule is irregular & 2/3 duration is expof2 (declare (type (rational (0) (1)) n) (type boolean al ar) (type list in)) (if (if (rule-comp rule) (>= num (/ n)) (> num (/ n))) (make-sig :time (cons (* (rule-num rule) n) (rule-den rule)) :comp (rule-comp rule) :beat (rule-beat rule) :alt al :art ar :init in :irr (not ex) :comp (rule-comp rule)) - (make-unit :div (if (rule-comp rule) 3 2) :tup nil :alt t :art t :init in :irr (not ex) :comp (rule-comp rule)))) + (make-unit :div (if (or (rule-comp rule) ir) 3 2) ;; (if (rule-comp rule) 3 2) + :tup nil :alt t :art t :init in :irr (not ex) :comp (rule-comp rule)))) (snd (n tl tr) (declare (type (rational (0) (1)) n) (type boolean tl tr)) (if (if (rule-comp rule) (>= num (/ n)) (> num (/ n))) #|(> num (/ n))|# (make-sig-nodiv :comp (rule-comp rule) :tlt tl :trt tr :comp (rule-comp rule)) (make-unit-nodiv :tup nil :tlt tl :trt tr :comp (rule-comp rule))))) - (flet ((si (n wh al ar) ; n = division ratio, >1/4 or >3/8 comp. is designated with :sig, smaller durations become units + (flet ((si (n wh al ar &optional ir) ; n = division ratio, >1/4 or >3/8 comp. is designated with :sig, smaller durations become units (declare (type (rational (0) (1)) n) (type (member :l :r) wh) (type boolean al ar)) (etypecase rule - (initdiv (in n al ar nil)) + (initdiv (in n al ar nil ir)) (sig (if (if (rule-comp rule) (>= num (/ n)) (> num (/ n))) #|(> num (/ n))|# (make-sig :time (cons (* (rule-num rule) n) (rule-den rule)) :comp (rule-comp rule) :beat (rule-beat rule) :alt (if (eq wh :l) (and (rule-alt rule) al) (and (rule-alt rule) (rule-art rule) al)) :art (if (eq wh :r) (and (rule-art rule) ar) (and (rule-alt rule) (rule-art rule) ar)) :irr (not ex) :comp (rule-comp rule)) - (make-unit :div 2 #|(if (rule-comp rule) 3 2)|# :tup nil :alt t :art t :irr (not ex) #|(or (rule-comp rule) (not ex))|# :comp (rule-comp rule))))))) + (make-unit :div (if ir 3 2) :tup nil :alt t :art t :irr (not ex) #|(or (rule-comp rule) (not ex))|# :comp (rule-comp rule))))))) (nconc (etypecase rule (initdiv (loop - for ee of-type cons in (force-list2all (rule-list rule)) - #+debug unless #+debug (= (apply #'+ ee) num) + for ee0 of-type cons in (force-list2all (rule-list rule)) + #+debug unless #+debug (= (apply #'+ ee0) num) #+debug do #+debug (error "Error in SPLIT-RULES-BYLEVEL") collect (loop - for (e en) of-type ((rational (0)) (or (rational (0)) null)) on ee + for (e en) of-type ((rational (0)) (or (rational (0)) null)) on ee0 sum e into s collect (/ e num) into ee ; split durs when en collect (/ s num) into ll ; split points finally (return (cons (if (list>1p ll) ll (car ll)) (loop for (i n) of-type ((rational (0)) (or (rational (0)) null)) on ee + and ii of-type (rational (0)) in ee0 and x of-type (rational (0) 1) in (append ll '(1)) and la = t then aa for aa = (let ((xx (* x num))) (and (expof2 xx) (or (= num xx) (expof2 (- num xx))))) - collect (in i la (or (null n) aa) ee))))))) + collect (in i la (or (null n) aa) ee (expof2 (* ii 2/3))))))))) ;; 2/13/06 (sig (loop for nn of-type (integer 2) in (or (lowmult (numerator num)) (if (rule-comp rule) '(3) '(2))) nconc (loop @@ -171,7 +169,9 @@ (expof2 xx) (expof2 (- num xx))) collect (let ((aa (or (and co (expof2 (* xx 3/2)) (expof2 (* (- num xx) 3/2))) (and (expof2 xx) (expof2 (- num xx)))))) - (list x (si x :l t aa) (si (- 1 x) :r aa t))))))) + (list x + (si x :l t aa (and (rule-irr rule) (expof2 (* xx 2/3)))) ;; 2/13/06 + (si (- 1 x) :r aa t (and (rule-irr rule) (expof2 (* x 2/3)))))))))) ;; 2/13/06 (when (and (al *dotted-note-level*) (or (initdivp rule) (rule-alt rule)) ex (not (rule-comp rule))) (nconc (list (list 3/4 (snd 3/4 t nil) (si 1/4 :r t t))) ; dotted notes (when *double-dotted-notes* @@ -212,7 +212,7 @@ (declare (type (rational (0) (1)) n)) (when (rule-tup rule) (cons (* (the (rational (0)) (first (rule-tup rule))) n) (rest (rule-tup rule)))))) - (flet ((un (n wh al ar &optional d) + (flet ((un (n wh al ar &optional d) ; d is fraction of total number of divs (declare (type (rational (0) (1)) n) (type (member :l :r) wh) (type boolean al ar) (type (or (integer 1) null) d)) (if (and (rule-sim rule) (<= (* (rule-sim rule) n) 1)) (make-unit-nodiv :tup (tu n) :dmu (rule-dmu rule) :tlt t :trt t :comp (rule-comp rule) :rst t) --- /project/fomus/cvsroot/fomus/version.lisp 2006/02/11 22:39:40 1.31 +++ /project/fomus/cvsroot/fomus/version.lisp 2006/02/13 19:51:28 1.32 @@ -12,7 +12,7 @@ (declaim (type string +title+) (type cons +version+ +banner+)) (defparameter +title+ "FOMUS") -(defparameter +version+ '(0 1 36)) +(defparameter +version+ '(0 1 37)) (defparameter +banner+ `("Lisp music notation formatter" "Copyright (c) 2005, 2006 David Psenicka, All Rights Reserved"