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))