Mercurial > hg > amuse

changeset 58:48661eb2da71

Find changesets by keywords (author, files, the commit message), revision number or hash, or revset expression.
fix tabcode syntax for sure darcs-hash:20070622062430-df18d-e279377fee5ef17b02e59bdc0da829343a403cc7.gz
author csr21 <csr21@cantab.net>
date Fri, 22 Jun 2007 07:24:30 +0100
parents f308c2b7b796
children 08468c3d5801
files implementations/tabcode/classes.lisp implementations/tabcode/tabcode-import.lisp
diffstat 2 files changed, 25 insertions(+), 0 deletions(-) [+]
line wrap: on
line diff
--- a/implementations/tabcode/classes.lisp	Thu Jun 21 15:16:36 2007 +0100
+++ b/implementations/tabcode/classes.lisp	Fri Jun 22 07:24:30 2007 +0100
@@ -5,4 +5,5 @@
 
 (defclass tabcode-pitched-event (chromatic-pitched-event)
   ((course :initarg :course :reader course)
+   (fret :initarg :fret :reader fret)
    (word :initarg :word :reader word)))
--- a/implementations/tabcode/tabcode-import.lisp	Thu Jun 21 15:16:36 2007 +0100
+++ b/implementations/tabcode/tabcode-import.lisp	Fri Jun 22 07:24:30 2007 +0100
@@ -86,4 +86,28 @@
          (syntax (climacs::syntax buffer))
          (tabwords (slot-value syntax 'tabcode-syntax::tabwords)))
     (setq *composition* (amuse-tabcode::make-tabcode-composition tabwords))))
+
+(define-command (com-amuse-play
+		 :name t :command-table tabcode-syntax::tabcode-table)
+    ()
+  (let* ((window (esa:current-window))
+         (buffer (drei-buffer:buffer window))
+         (syntax (climacs::syntax buffer))
+         (tabwords (slot-value syntax 'tabcode-syntax::tabwords))
+	 (composition (amuse-tabcode::make-tabcode-composition tabwords)))
+    ;; HACK: emulate background playing.
+    (sb-thread:make-thread (lambda () (amuse-utils:play composition)))))
+	 
+(define-command (com-infer-key
+		 :name t :command-table tabcode-syntax::tabcode-table)
+    ()
+  (let* ((window (esa:current-window))
+         (buffer (drei-buffer:buffer window))
+         (syntax (climacs::syntax buffer))
+         (tabwords (slot-value syntax 'tabcode-syntax::tabwords))
+	 (composition (amuse-tabcode::make-tabcode-composition tabwords))
+	 (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~)</key>}~%" name (cadr result)))) 
+    (drei-buffer:insert-buffer-sequence buffer 0 string)))
 |#