[fomus-cvs] CVS fomus
dpsenicka
dpsenicka at common-lisp.net
Mon Feb 13 19:51:28 UTC 2006
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"
More information about the Fomus-cvs
mailing list