2 ;;; YMamoto conversion functions for mumble output. These functions
3 ;;; produce hisoft-style assembly output, which can be assembled into
4 ;;; a binary playable by the ymamoto playroutine.
6 ;;; Julian Squires <tek@wiw.org> / 2004
11 (defparameter *ymamoto-frequency
* 50)
12 ;; XXX: A lot of these global variables will disappear soon; I'm just lazy.
13 (defvar *channel-delta
* 0)
14 (defvar *total-frames
* 0)
15 (defvar *total-bytes
* 0)
16 (defvar *loop-point
* nil
)
20 (defun find-and-remove-loop (list)
21 "Finds :loop in the list, and returns two values, the list with the
22 :loop removed, and the position of the loop. Does not support
24 (aif (position :loop list
)
25 (values (remove :loop list
) it
)
28 (defun make-env-follow-command (options)
29 (let ((cmd (make-instance 'music-command
)))
30 (setf (slot-value cmd
'type
) :envelope-follow
)
31 (setf (slot-value cmd
'value
) options
)
35 ;;;; INPUT-RELATED FUNCTIONS
37 (defun make-ymamoto-channels ()
44 (defun ymamoto-special-handler (stream channels
)
45 (let ((special-char (read-char stream
)))
46 (cond ((char= special-char
#\e
)
48 (let ((next-char (peek-char nil stream
)))
49 (cond ((char= next-char
#\o
)
52 (vector-push-extend (make-env-follow-command :octave
)
53 (channel-data-stream c
))))
54 ((char= next-char
#\u
)
57 (vector-push-extend (make-env-follow-command :unison
)
58 (channel-data-stream c
))))
59 ((char= next-char
#\
0)
62 (vector-push-extend (make-env-follow-command :disable
)
63 (channel-data-stream c
))))
64 (t (format t
"~&Ignored bad env-follow: %e~A"
67 (t (format t
"~&Ignored special invocator: %~A" special-char
)))))
72 (defun ymamoto-output-note-helper (note-word frames stream
73 &optional
(comma nil
))
74 (incf *channel-delta
* frames
)
75 (multiple-value-bind (frames leftovers
) (floor *channel-delta
*)
76 (setf *channel-delta
* leftovers
)
77 (setf (ldb (byte 7 8) note-word
) (1- frames
))
80 (incf *total-frames
* frames
)
81 (incf *total-bytes
* 2)
82 (format stream
(if comma
", $~X" "~&~8TDC.W $~X") note-word
))))
85 (defun ymamoto-output-note (note channel stream
)
87 (frames (duration-to-frames (note-duration note
)
88 (channel-tempo channel
)
92 (cond ((eql (note-tone note
) :rest
)
93 (setf (ldb (byte 7 0) note-word
) 127))
94 ((eql (note-tone note
) :wait
)
95 (setf (ldb (byte 7 0) note-word
) 126))
97 (when (/= (channel-staccato channel
) 1)
98 (setf staccato-frames
(- frames
(* frames
99 (channel-staccato channel
))))
100 (when (< (- frames staccato-frames
) 1)
101 (decf staccato-frames
))
102 (setf frames
(- frames staccato-frames
)))
104 (setf (ldb (byte 7 0) note-word
) (note-tone note
))))
106 (ymamoto-output-note-helper note-word frames stream
)
107 (when (plusp staccato-frames
)
108 (ymamoto-output-note-helper 127 staccato-frames stream t
))))
111 (defun ymamoto-output-note-stream (notes channel stream
)
112 "Traverse a note-stream, keeping track of tempo and staccato
113 settings, and output assembly directives for this note stream."
114 (setf *channel-delta
* 0
117 (do* ((note-> 0 (1+ note-
>))
119 (channel-pos 0 (1+ channel-pos
)))
120 ((>= note-
> (length notes
)))
121 (setf note
(aref notes note-
>))
122 (case (music-command-type note
)
123 (:note
(ymamoto-output-note note channel stream
))
125 (format stream
"~&~8TDC.W $~X"
126 (logior (ash #b11000001
8) (music-command-value note
)))
127 (incf *total-bytes
* 2))
129 (setf (channel-tempo channel
) (music-command-value note
)))
131 (setf (channel-staccato channel
) (music-command-value note
)))
133 (setf (channel-volume channel
) (music-command-value note
))
134 (format stream
"~&~8TDC.W $~X"
135 (logior (ash #b11000011
8) (music-command-value note
)))
136 (incf *total-bytes
* 2))
138 (format stream
"~&~8TDC.W $~X"
139 (logior (ash #b11000100
8) (music-command-value note
)))
140 (incf *total-bytes
* 2))
142 (format stream
"~&~8TDC.W $~X"
143 (logior (ash #b11001011
8) (music-command-value note
)))
144 (incf *total-bytes
* 2))
146 (format stream
"~&~8TDC.W $~X"
147 (logior (ash #b11001000
8)
148 (ecase (music-command-value note
)
152 (t (format t
"~&WARNING: YMamoto ignoring ~A."
153 (music-command-type note
))))
154 (when (and (channel-loop-point channel
)
155 (= (channel-loop-point channel
)
157 (setf *loop-point
* *total-bytes
*)))
158 (format t
"~&frames: ~A, bytes: ~A" *total-frames
* *total-bytes
*))
161 (defun output-ymamoto-header (stream)
162 (format stream
";;; test song, in assembler form
166 DC.W arpeggio_table>>2
168 DC.W vibrato_table>>2
169 DC.B 0,1 ; pad, number of tracks"))
172 (defun ymamoto-output-length-loop-list-table (stream name table
)
173 ;; note that the zeroth element of the table is skipped.
174 (format stream
"~&~8TALIGN 4~&~A:~%~8TDC.B ~D" name
175 (max 0 (1- (length table
))))
177 ((>= i
(length table
)))
178 (multiple-value-bind (list loop
) (find-and-remove-loop (aref table i
))
179 (format stream
"~&~8TDC.B ~A, ~A~{, ~D~}" (length list
) loop list
))))
181 (defun ymamoto-output-vibrato-table (stream table
)
182 ;; note that the zeroth element of the table is skipped.
183 (format stream
"~&~8TALIGN 4~&vibrato_table:~%~8TDC.B ~D"
184 (max 0 (1- (length table
))))
186 ((>= i
(length table
)))
187 (flet ((get-field (list field
)
188 (nth (1+ (or (position field list
)
189 (error "Vibrato ~A lacks ~A!" i field
))) list
)))
190 (let* ((list (aref table i
))
191 (delay (get-field list
'DELAY
))
192 (depth (get-field list
'DEPTH
))
193 (speed (get-field list
'SPEED
)))
194 (format stream
"~&~8TDC.B 3, ~D, ~D, ~D, ~D" delay depth
195 (- 5 speed
) (ash 1 (- 5 speed
)))))))
201 (defun ymamoto-output-asm (tune out-file
)
202 (with-open-file (stream out-file
204 :if-exists
:supersede
)
206 (output-ymamoto-header stream
)
209 (format stream
"~&~8TDC.W track_~D>>2" track-num
))
210 (ymamoto-output-length-loop-list-table
211 stream
"arpeggio_table" (tune-get-table tune
:arpeggio
))
212 (ymamoto-output-length-loop-list-table
213 stream
"venv_table" (tune-get-table tune
:volume-envelope
))
214 (ymamoto-output-vibrato-table stream
(tune-get-table tune
:vibrato
))
217 ;; I bet the following could all be reduced to one big format
219 (format stream
"~&~8TALIGN 4~&track_~D:" track-num
)
220 (do ((c (tune-channels tune
) (cdr c
))
221 (ctr (char-code #\a) (1+ ctr
)))
223 (format stream
"~&~8TDC.W channel_~A~A>>2"
224 track-num
(code-char ctr
)))
226 ;; output channels themselves.
227 (do ((c (tune-channels tune
) (cdr c
))
228 (ctr (char-code #\a) (1+ ctr
)))
230 (format t
"~¬e ~A" (channel-loop-point (car c
)))
231 (format stream
"~&~8TALIGN 4~&channel_~A~A:"
232 track-num
(code-char ctr
))
233 (ymamoto-output-note-stream (channel-data-stream (car c
))
236 (if (channel-loop-point (car c
))
237 (format stream
"~&~8TDC.W $8001, $~X" *loop-point
*)
238 (format stream
"~&~8TDC.W $8000"))))))
240 (register-replay "YMamoto"
241 #'ymamoto-special-handler
242 #'make-ymamoto-channels
243 #'ymamoto-output-asm
)