[fomus-cvs] CVS update: fomus/beams.lisp fomus/split.lisp fomus/splitrules.lisp

[David Psenicka]

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.