[fomus-cvs] CVS update: fomus/TODO fomus/backend_mid.lisp fomus/misc.lisp fomus/test.lisp

[David Psenicka]

Update of /project/fomus/cvsroot/fomus
In directory common-lisp.net:/tmp/cvs-serv5066

Modified Files:
	TODO backend_mid.lisp misc.lisp test.lisp 
Log Message:
bug fixes
Date: Sat Oct  1 19:28:30 2005
Author: dpsenicka

Index: fomus/TODO
diff -u fomus/TODO:1.22 fomus/TODO:1.23
--- fomus/TODO:1.22	Sat Oct  1 02:49:45 2005
+++ fomus/TODO	Sat Oct  1 19:28:29 2005
@@ -4,6 +4,7 @@
 
     Bugs:
       Quantizing nested tuplets--occasional hangups
+      Hide accidental internal mark
     accidentals for trills and related figures (or just a note/step argument for MIDI playback)
     Doc: list-instr-syms
     Doc: CM MIDI backend


Index: fomus/backend_mid.lisp
diff -u fomus/backend_mid.lisp:1.1 fomus/backend_mid.lisp:1.2
--- fomus/backend_mid.lisp:1.1	Sat Oct  1 02:49:45 2005
+++ fomus/backend_mid.lisp	Sat Oct  1 19:28:29 2005
@@ -33,7 +33,7 @@
 				(< (midi-note x) (midi-note y))))
 			   ((midi-note x) t))
 		     (< (midi-dur x) (midi-dur y))))
-		((typep x *cm-midi*) t))
+		((typep y *cm-midi*) t))
 	  (< (midi-ch x) (midi-ch y)))
       (< (midi-off x) (midi-off y))))
 
@@ -216,7 +216,7 @@
 			    (gracedur *gracedur*) (minamp *minamp*) (trdursecs *trdursecs*) (tramp *tramp*)
 			    (fermatamults *fermatamults*) (breathdur *breathdur*) (tempo *tempo*)
 			    (staccatomult *staccatomult*) (staccatissimomult *staccatissimomult*) (tenutoadddur *tenutoadddur*)
-			    (trovlpadddur *trovlpadddur*) (mindursecs *mindursecs*) &allow-other-keys) options
+			    (trovlpadddur *trovlpadddur*) (mindursecs *mindursecs*) delay &allow-other-keys) options
     (when (typep play 'boolean) (setf nports 1))
     (let* ((*gracedur* gracedur)
 	   (*minamp* minamp)
@@ -327,12 +327,13 @@
 																	    (car i))
 																     :test #'equal))
 											    else collect
-											    (let ((i (make-instance *cm-midi* :channel ch :time of :duration du
-														    :keynum (if (and *transpose* (instr-tpose in))
-																(+ (instr-tpose in) n) n)
-														    :amplitude midi-vel)))
+											    (let ((i (cons (midi-marks ev bot top ex)
+													   (make-instance *cm-midi* :channel ch :time of :duration du
+															  :keynum (if (and *transpose* (instr-tpose in))
+																      (+ (instr-tpose in) n) n)
+															  :amplitude midi-vel))))
 											      (when tr (push i ts))
-											      (cons (midi-marks ev bot top ex) i)))
+											      i))
 										      (list (cons (midi-marks ev t t ex)
 												  (make-instance *cm-midi* :channel ch :time of :duration du
 														 :keynum nil
@@ -378,10 +379,10 @@
 			    (when (list>1p cs)
 			      (let ((ll (remove-if (lambda (e) (integerp (midi-note e))) es)))
 				(mapc (lambda (x) (setf (midi-note* x) (floor x) (midi-ch* x) (second cs))) ll)
-				(push (make-instance *cm-midipbend* :time 0 :channel (second cs) :bend (* pbendwidth 1024)) xta))))
+				(push (make-instance *cm-midipbend* :time 0 :channel (second cs) :bend (roundint (/ 2048 pbendwidth))) xta))))
 			  es)
 			finally (loop for e in (nreverse (delete-duplicates el :test #'string=)) do (format t e))))))
-      (let ((o (floor (loop for e in evs minimize (midi-off e))))) (when (minusp o) (push (cons o (- o)) adj)))
+      (let ((o (floor (loop for e in evs do (incf (midi-off* e) delay) minimize (midi-off e))))) (when (minusp o) (push (cons o (- o)) adj)))
       (loop for (o . a) in (merge-linear (sort adj #'> :key #'car) (lambda (x y) (when (= (car x) (car y)) (cons (car x) (max (cdr x) (cdr y))))))
 	    do (mapc (lambda (x) (when (if (typep x *cm-midi*) (> (midi-endoff x) o) (>= (midi-off x) o))
 				   (if (>= (midi-off x) o) (incf (midi-off* x) a) (incf (midi-dur* x) a))))
@@ -393,6 +394,7 @@
 		  (setf (midi-vel* x) (min (max (coerce (midi-vel x) 'single-float) 0.0) 1.0)
 			(midi-dur* x) (max (midi-dur x) md))))
 	      evs))
+      (setf xta (loop for e in (split-into-groups xta #'type-of) nconc (delete-duplicates e :key #'midi-ch)))
       (if (typep play 'boolean)
-	  (apply *cm-events* (nconc xta evs) filename :tempo tempo :play play cmargs)
+	  (apply *cm-events* (print (nconc xta evs)) filename :tempo tempo :play play cmargs)
 	  (apply *cm-rts* (nconc xta evs) play :tempo tempo cmargs)))))


Index: fomus/misc.lisp
diff -u fomus/misc.lisp:1.10 fomus/misc.lisp:1.11
--- fomus/misc.lisp:1.10	Sat Oct  1 02:49:45 2005
+++ fomus/misc.lisp	Sat Oct  1 19:28:29 2005
@@ -32,7 +32,7 @@
   (car (last list)))
 
 (set-dispatch-macro-character
- #\# #\I
+ #\# #\Z
  (lambda (s c n)
    (declare (type stream s) (ignore c n))
    (let ((r (read s t nil t)))
@@ -41,7 +41,7 @@
 (defmacro defprint (class &rest slots)
   `(defmethod print-object ((x ,class) s)
     (declare (type stream s))
-    (princ "#I" s)
+    (princ "#Z" s)
     (prin1 ,(nconc (list 'list (list 'quote class))
 		   (loop
 		      for i in slots


Index: fomus/test.lisp
diff -u fomus/test.lisp:1.16 fomus/test.lisp:1.17
--- fomus/test.lisp:1.16	Sat Oct  1 02:49:45 2005
+++ fomus/test.lisp	Sat Oct  1 19:28:29 2005
@@ -5,7 +5,7 @@
 ;; Example 1
 
 (fomus
- :backend '((:data) (:lilypond :view t))
+ :backend '((:data) (:lilypond :view t) (:midi :play t :tempo 120 :delay 10))
  :ensemble-type :orchestra
  :parts
  (list
@@ -24,7 +24,7 @@
 ;; Example 2
 
 (fomus
- :backend '((:data) (:lilypond :view t))
+ :backend '((:data) (:lilypond :view t) (:midi :play t :tempo 120 :delay 10))
  :ensemble-type :orchestra
  :default-beat 1/4
  :global (list (make-timesig :off 0 :time '(3 4))