From cec5d95bd57bdbd9b04b4b24b0aa5092f07264e3 Mon Sep 17 00:00:00 2001
From: Julian Squires <tek@wiw.org>
Date: Wed, 29 Dec 2004 23:23:15 +0100
Subject: [PATCH] Vibrato support in YMamoto.

---
 examples/ch-1.mbl       | 59 +++++++++++++++++++++++++------------------------
 examples/demo-y.mbl     | 13 ++++++-----
 src/classes.lisp        |  7 ++++++
 src/music-parser.lisp   |  6 +++--
 src/replay-ymamoto.lisp | 29 +++++++++++++++++++++---
 5 files changed, 75 insertions(+), 39 deletions(-)

diff --git a/examples/ch-1.mbl b/examples/ch-1.mbl
index d7f1d70..95aa704 100644
--- a/examples/ch-1.mbl
+++ b/examples/ch-1.mbl
@@ -22,20 +22,21 @@ maker "Julian Squires <tek@wiw.org>"
 
 ;;; Generic lead vibratos
 ; Retsyn vibratos
-@~1 = { delay 12 speed 3 depth 5 }
-@~2 = { delay 22 speed 2 depth 4 }
+@~1 = { delay 12 speed 2 depth 3 }
+@~2 = { delay 8 speed 2 depth 4 }
 ; mild vibrato
-@~3 = { delay 32 speed 2 depth 2 }
+@~3 = { delay 32 speed 2 depth 3 }
 
 
 #MUSIC
 
+
 ;;;; (G) Intro
 
 ABC t120
-A o3 q6 %2 v8
-B o2 q6 %2 v6
-C o1 q4
+A o3 q6 %2 v14 @~2
+B o2 q6 %2 v13
+C o1 q4 v13 %eu
 
 A r1  c2 <a-2  g4 g4 d4 g4  f2 a-4 b-4>
 B c2. r4  f2. r4  <b-2. r4  >d2. r4
@@ -48,8 +49,8 @@ C r1  r1  q7 g1  f1
 ;;;; (A) Midpart in C minor
 
 ABC t120
-A o3 q6 %2 v8
-B o2 q6 %2 v6
+A o3 q6 %2 v14
+B o2 q6 %2 v13
 C o1 q4
 
 AB @~0
@@ -73,8 +74,8 @@ C a-4 f8>f< g4 b4
 ;;;; (B) Bridge
 
 ABC t120
-A o3 q6 %2 v4
-B o2 q6 %2 v3
+A o3 q6 %2 v12
+B o2 q6 %2 v10
 C o1 q4
 
 AB @~2
@@ -114,8 +115,8 @@ C g2 >c2
 ;;;; (F) [modified]
 
 ABC t120
-A o3 q6 %2 v4
-B o3 q6 %2 v6
+A o3 q6 %2 v10
+B o3 q6 %2 v13
 C o1 q4
 
 AB @~0
@@ -139,8 +140,8 @@ C g4 f4 e-4
 ;;;; (D) lamenting solo in C minor
 
 ABC t120
-A o3 q7 %2 v9
-B o2 q6 %2 v5
+A o3 q7 %2 v12
+B o2 q6 %2 v10
 C o1 q4
 
 A @~1
@@ -159,8 +160,8 @@ C q7 >c4 c4 c4<b-4 a-4 a-4 a-4 a-4 g4 g4 g4f8e- d4 d4 d2
 ;;;; (E) solo part 2, Eb major
 
 ABC t120
-A o3 q7 %2 v9
-B o2 q6 %2 v5
+A o3 q7 %2 v13
+B o2 q6 %2 v10
 C o1 q7
 
 A @~1
@@ -188,8 +189,8 @@ C >c1
 ;;;; (B/H) Bridge
 
 ABC t120
-A o3 q6 %2 v4
-B o2 q6 %2 v3
+A o3 q6 %2 v12
+B o2 q6 %2 v10
 C o1 q4
 
 AB @~2
@@ -229,8 +230,8 @@ C g2 >c2
 ;;;; (A) Midpart in C minor repeat
 
 ABC t120
-A o3 q6 @2 v8
-B o2 q6 @2 v6
+A o3 q6 @2 v14
+B o2 q6 @2 v13
 C o1 q4
 
 AB @~0
@@ -254,8 +255,8 @@ C a-4 f8>f< g4 b4
 ;;;; (F)
 
 ABC t120
-A o3 q6 @2 v4
-B o3 q6 @2 v6
+A o3 q6 @2 v12
+B o3 q6 @2 v10
 C o1 q4
 
 AB @~0
@@ -279,8 +280,8 @@ C g2
 ;;;; (C)
 
 ABC t120
-A o2 q3 @2 v7
-B o2 q3 @0 v6
+A o2 q3 @2 v13
+B o2 q3 @0 v11
 C o1 q4
 
 AB @~0
@@ -296,9 +297,9 @@ C g4 >d8<b- cc>c<c  d4 a8f ccac  <f4>f8d <gg>db
 ;;;; (B) Bridge again
 
 ABC t120
-;A o3 q6 @2 l8 v4
-;B o2 q6 @2 l8 v3
-C o1 q4 l8
+;A o3 q6 @2 v12
+;B o2 q6 @2 v10
+C o1 q4
 
 AB @~2
 
@@ -337,8 +338,8 @@ C g2 >c2
 ;;;; (I) Final cadence.
 
 ABC t120
-A o3 q6 @2 v7
-B o2 q6 @2 v6
+A o3 q6 @2 v14
+B o2 q6 @2 v13
 C o1 q4
 
 AB @~1
diff --git a/examples/demo-y.mbl b/examples/demo-y.mbl
index 7b16a81..16369f7 100644
--- a/examples/demo-y.mbl
+++ b/examples/demo-y.mbl
@@ -22,6 +22,9 @@ copyright "Julian Squires / 2004"
 @a8 = { 0 | 4 3 -7 }
 @a9 = { 0 | 4 8 -12 }
 
+;; Rob Hubbard vibrato, or so.
+@~1 = { delay 8 speed 2 depth 3 }
+
 ;; This looks hideous -- it's just a test.
 @v1 = { 15 15 14 14 13 13 12 12 11 11 10 10 9 9 8 8
         7 7 7 7 6 6 6 6 6 | 7 }
@@ -33,7 +36,7 @@ copyright "Julian Squires / 2004"
 ;;;; D minor.
 
 ABC t140
-A q6 v8 %eu
+A q6 v12 @v1 %eu
 B q8 v10 @v2
 
 A o1     d1            | f1                |
@@ -45,8 +48,8 @@ B [f8f16f]3 f8f | @a1 e8e16ee8e @a2 ee16ee8e |
 C r | r |
 
 ABC !loop
-A o2
-C v11 q8
+A o1
+C v13 q8 @~1
 
 A     d4 d d d8>d<  | f4 f f f8e        |
 B @a1 [d8d16d]3 d8d | @a2 [c8c16c]3 c8c |
@@ -78,9 +81,9 @@ C c2 e4 a                    | b-2 a4 >c+                           |
 
 ;;;; A minor.
 
-A q6 v10
+A q6
 B @a0 q8
-C q8 @v2
+C q8 v13 @v2
 A o1 a4 a a a8>a   | c4 c c c8<b   |
 B o3 [a8a16a]3 a8a | [g8g16g]3 g8g |
 C o4 a8>cec a4 g   | >c4 <b8a g4 e |
diff --git a/src/classes.lisp b/src/classes.lisp
index a1a42ec..3212445 100644
--- a/src/classes.lisp
+++ b/src/classes.lisp
@@ -45,6 +45,13 @@
     (setf (slot-value cmd 'value) n)
     cmd))
 
+;; This might become a special macro-command later.
+(defun make-vibrato-command (n)
+  (let ((cmd (make-instance 'music-command)))
+    (setf (slot-value cmd 'type) :vibrato)
+    (setf (slot-value cmd 'value) n)
+    cmd))
+
 
 (defclass note (music-command)
   ((tone :reader note-tone)
diff --git a/src/music-parser.lisp b/src/music-parser.lisp
index f80de04..8fc56e0 100644
--- a/src/music-parser.lisp
+++ b/src/music-parser.lisp
@@ -422,6 +422,7 @@ Highly intolerant of malformed inputs."
     (eat-whitespace stream *ws-and-barline-characters*)))
 
 
+;;; XXX: should use *macro-table-mapping*
 (defun parse-macro-invocation (stream channels)
   (read-char stream)
   (let ((next-char (peek-char nil stream)))
@@ -444,8 +445,9 @@ Highly intolerant of malformed inputs."
 	  ((char= next-char #\~)
 	   (read-char stream)
 	   (let ((vibrato-num (expect-int stream)))
-	     ;; XXX unimplemented
-	     vibrato-num))
+	     (dolist (c channels)
+	       (vector-push-extend (make-vibrato-command vibrato-num)
+				   (channel-data-stream c)))))
 
 	  ;; Something else?
 	  (t (format t "~&Ignored macro invocator: @~A (~:*~S)"
diff --git a/src/replay-ymamoto.lisp b/src/replay-ymamoto.lisp
index 5d9112f..c9dd35e 100644
--- a/src/replay-ymamoto.lisp
+++ b/src/replay-ymamoto.lisp
@@ -138,6 +138,10 @@ multiple loops."
        (format stream "~&~8TDC.W $~X"
 	       (logior (ash #b11000100 8) (music-command-value note)))
        (incf *total-bytes* 2))
+      (:vibrato
+       (format stream "~&~8TDC.W $~X"
+	       (logior (ash #b11001011 8) (music-command-value note)))
+       (incf *total-bytes* 2))
       (:envelope-follow
        (format stream "~&~8TDC.W $~X"
 	       (logior (ash #b11001000 8)
@@ -159,9 +163,10 @@ multiple loops."
 
 	ORG 0
 song_header:
-        DC.W arpeggio_table>>2  ; pointer to arpeggio table
-        DC.W venv_table>>2      ; pointer to volume envelope table
-	DC.B 1,0		; number of tracks, pad"))
+        DC.W arpeggio_table>>2
+        DC.W venv_table>>2
+        DC.W vibrato_table>>2
+	DC.B 0,1		; pad, number of tracks"))
 
 
 (defun ymamoto-output-length-loop-list-table (stream name table)
@@ -173,6 +178,23 @@ song_header:
     (multiple-value-bind (list loop) (find-and-remove-loop (aref table i))
       (format stream "~&~8TDC.B ~A, ~A~{, ~D~}" (length list) loop list))))
 
+(defun ymamoto-output-vibrato-table (stream table)
+  ;; note that the zeroth element of the table is skipped.
+  (format stream "~&~8TALIGN 4~&vibrato_table:~%~8TDC.B ~D"
+	  (max 0 (1- (length table))))
+  (do ((i 1 (1+ i)))
+      ((>= i (length table)))
+    (flet ((get-field (list field)
+	     (nth (1+ (or (position field list)
+			  (error "Vibrato ~A lacks ~A!" i field))) list)))
+      (let* ((list (aref table i))
+	     (delay (get-field list 'DELAY))
+	     (depth (get-field list 'DEPTH))
+	     (speed (get-field list 'SPEED)))
+	(format stream "~&~8TDC.B 3, ~D, ~D, ~D, ~D" delay depth
+		(- 5 speed) (ash 1 (- 5 speed)))))))
+
+
 
 ;;;; HIGH-LEVEL
 
@@ -189,6 +211,7 @@ song_header:
      stream "arpeggio_table" (tune-get-table tune :arpeggio))
     (ymamoto-output-length-loop-list-table
      stream "venv_table" (tune-get-table tune :volume-envelope))
+    (ymamoto-output-vibrato-table stream (tune-get-table tune :vibrato))
     ;; for n tracks
     (let ((track-num 1))
       ;; I bet the following could all be reduced to one big format
-- 
2.11.4.GIT