Mercurial > hg > amuse
changeset 59:08468c3d5801
gsharp amuse implementation
darcs-hash:20070622062520-df18d-6c619e5668475044d209a1d987c24695ac065679.gz
| author | csr21 <csr21@cantab.net> |
|---|---|
| date | Fri, 22 Jun 2007 07:25:20 +0100 |
| parents | 48661eb2da71 |
| children | 8cc40d2b12fd |
| files | implementations/gsharp/amuse-gsharp.asd implementations/gsharp/classes.lisp implementations/gsharp/gsharp-import.lisp implementations/gsharp/methods.lisp implementations/gsharp/package.lisp |
| diffstat | 5 files changed, 126 insertions(+), 0 deletions(-) [+] |
line wrap: on
line diff
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/implementations/gsharp/amuse-gsharp.asd Fri Jun 22 07:25:20 2007 +0100 @@ -0,0 +1,7 @@ +(asdf:defsystem amuse-gsharp + :depends-on (amuse gsharp) + :components + ((:file "package") + (:file "classes" :depends-on ("package")) + (:file "methods" :depends-on ("package" "classes")) + (:file "gsharp-import" :depends-on ("package" "classes"))))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/implementations/gsharp/classes.lisp Fri Jun 22 07:25:20 2007 +0100 @@ -0,0 +1,8 @@ +(cl:in-package "AMUSE-GSHARP") + +(defclass gsharp-composition (amuse:composition) + ((buffer :initarg :buffer :reader buffer) + (tempi :initarg :tempi :reader tempi))) + +(defclass gsharp-pitched-event (chromatic-pitched-event) + ((note :initarg :note :reader note)))
--- /dev/null Thu Jan 01 00:00:00 1970 +0000 +++ b/implementations/gsharp/gsharp-import.lisp Fri Jun 22 07:25:20 2007 +0100 @@ -0,0 +1,103 @@ +(in-package "AMUSE-GSHARP") + +(defun last-bar-p (bar) + ;; I know most of this file is cut-and-pasted, but this is a + ;; particularly horrible example. + (eq bar (car (last (gsharp-buffer:bars (gsharp-buffer:slice bar)))))) + +(defun find-next-note (note) + (when (gsharp-buffer:tie-right note) + (let ((bar (gsharp-buffer:bar (gsharp-buffer:cluster note))) + (cluster (gsharp-buffer:cluster note)) + (next-element nil)) + (loop for (x y) on (gsharp-buffer:elements bar) + until (null y) + when (eq x cluster) do (setq next-element y)) + (cond + (next-element) + ((last-bar-p bar) (return-from find-next-note nil)) + (t (let ((next-bar (gsharp-buffer:barno (gsharp-buffer:slice bar) + (1+ (gsharp-numbering::number bar))))) + (if (gsharp-buffer:elements next-bar) + (setq next-element (car (gsharp-buffer:elements next-bar))) + (return-from find-next-note nil))))) + ;; now NEXT-ELEMENT is the next element! + (when (typep next-element 'gsharp-buffer:cluster) + (loop for n in (gsharp-buffer:notes next-element) + if (and (gsharp-buffer:tie-left n) + (= (gsharp-buffer:pitch n) (gsharp-buffer:pitch note)) + (eq (gsharp-buffer:staff n) (gsharp-buffer:staff note)) + (eq (gsharp-buffer:accidentals n) (gsharp-buffer:accidentals note))) + return n))))) + +(defun compute-duration (note) + (loop for n = note then (find-next-note n) + while n + sum (gsharp-buffer:duration (gsharp-buffer:cluster n)))) + +(defun events-from-element (element time channel) + (when (typep element 'gsharp-buffer:cluster) + (mapcar (lambda (note) + (make-instance 'gsharp-pitched-event + :note note + :number (gsharp-play::midi-pitch note) + :time time + :interval (* 4 (compute-duration note)))) + (remove-if #'gsharp-buffer:tie-left (gsharp-buffer:notes element))))) + +(defun events-from-bar (bar time channel) + (mapcan (lambda (element) + (prog1 (events-from-element element time channel) + (incf time (* 4 (gsharp-buffer:duration element))))) + (gsharp-buffer:elements bar))) + +(defun events-from-slice (slice channel durations) + (let ((time 0)) + (mapcan (lambda (bar duration) + (prog1 (events-from-bar bar time channel) + (incf time (* 4 duration)))) + (gsharp-buffer:bars slice) durations))) + +(defun segment-composition (segment) + (let* ((slices (mapcar #'gsharp-buffer:body (gsharp-buffer::layers segment))) + (durations (gsharp-play::measure-durations slices)) + (gsharp-play::*tuning* (gsharp-buffer:tuning segment)) + (events (loop for slice in slices + for i from 0 + for events = (events-from-slice slice i durations) + then (merge 'list events (events-from-slice slice i durations) 'time<) + finally (return events)))) + (let* ((duration (* 4 (reduce #'+ durations))) + (result (make-instance 'gsharp-composition + :buffer (gsharp-buffer:buffer segment) + ;; FIXME: this will break as soon as + ;; gsharp is made to have a sane + ;; divisions value in play.lisp + ;; instead of 25 + :tempi (list (make-tempo (* 128 (/ (* 4 25) (gsharp-buffer:tempo segment))) 0 duration)) + :time 0 + :interval duration))) + (sequence:adjust-sequence result (length events) + :initial-contents events)))) + +#| + +(in-package :clim-user) + +(define-command (amuse-play :name t :command-table gsharp::global-gsharp-table) + () + (let* ((segment (gsharp-cursor::segment (gsharp::current-cursor))) + (composition (amuse-gsharp::segment-composition segment))) + (amuse-utils::play composition))) + +(define-command (infer-key :name t :command-table gsharp::global-gsharp-table) + () + (let* ((segment (gsharp-cursor::segment (gsharp::current-cursor))) + (composition (amuse-gsharp::segment-composition segment)) + (result (amuse-utils:krumhansl-key-finder composition composition)) + (name (aref #("C" "C#" "D" "Eb" "E" "F" "F#" "G" "Ab" "A" "Bb" "B") (car result))) + (string (format nil "Key: ~A ~(~A~)" name (cadr result)))) + (esa:display-message string)) + + +|# \ No newline at end of file