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 (defvar *channel-delta
* 0)
13 (defvar *total-frames
* 0)
17 (defun find-and-remove-loop (list)
18 "Finds :loop in the list, and returns two values, the list with the
19 :loop removed, and the position of the loop. Does not support
21 (aif (position :loop list
)
22 (values (remove :loop list
) it
)
26 ;;;; INPUT-RELATED FUNCTIONS
28 (defun make-ymamoto-channels ()
35 (defun ymamoto-special-handler (stream channels
)
37 (let ((next-char (read-char stream
)))
38 (cond ((char= next-char
#\e
)
40 (format t
"~&guilty env follow"))
42 (t (format t
"~&Ignored special invocator: @~A" next-char
)))))
47 (defun ymamoto-output-note-helper (note-word frames stream
48 &optional
(comma nil
))
49 (incf *channel-delta
* frames
)
50 (multiple-value-bind (frames leftovers
) (floor *channel-delta
*)
51 (setf *channel-delta
* leftovers
)
52 (setf (ldb (byte 7 8) note-word
) (1- frames
))
55 (incf *total-frames
* frames
)
56 (format stream
(if comma
", $~X" "~&~8TDC.W $~X") note-word
))))
59 (defun ymamoto-output-note (note channel stream
)
61 (frames (duration-to-frames (note-duration note
)
62 (channel-tempo channel
)
66 (cond ((eql (note-tone note
) :rest
)
67 (setf (ldb (byte 7 0) note-word
) 127))
68 ((eql (note-tone note
) :wait
)
69 (setf (ldb (byte 7 0) note-word
) 126))
71 (when (/= (channel-staccato channel
) 1)
72 (setf staccato-frames
(- frames
(* frames
73 (channel-staccato channel
))))
74 (when (< (- frames staccato-frames
) 1)
75 (decf staccato-frames
))
76 (setf frames
(- frames staccato-frames
)))
78 (setf (ldb (byte 7 0) note-word
) (note-tone note
))))
80 (ymamoto-output-note-helper note-word frames stream
)
81 (when (plusp staccato-frames
)
82 (ymamoto-output-note-helper 127 staccato-frames stream t
))))
85 (defun ymamoto-output-note-stream (notes stream
)
86 "Traverse a note-stream, keeping track of tempo and staccato
87 settings, and output assembly directives for this note stream."
88 (let ((channel (make-channel)))
89 (setf *channel-delta
* 0)
90 (setf *total-frames
* 0)
91 (loop for note across notes
92 do
(case (music-command-type note
)
93 (:note
(ymamoto-note-output note channel stream
))
95 (format stream
"~&~8TDC.W $~X"
96 (logior (ash #b11000000
8) (music-command-value note
))))
98 (setf (channel-tempo channel
) (music-command-value note
)))
100 (setf (channel-staccato channel
) (music-command-value note
)))))
101 (format t
"~&frames: ~A" *total-frames
*)))
104 (defun output-ymamoto-header (stream)
105 (format stream
";;; test song, in assembler form
109 DC.L arpeggio_table ; pointer to arpeggio table
110 DC.L venv_table ; pointer to volume envelope table
111 DC.B 1 ; number of tracks"))
114 (defun ymamoto-output-length-loop-list-table (stream name table
)
115 ;; note that the zeroth element of the table is skipped.
116 (format stream
"~&~A:~%~8TDC.B ~D" name
(max 0 (1- (length table
))))
118 ((>= i
(length table
)))
119 (multiple-value-bind (list loop
) (find-and-remove-loop (aref table i
))
120 (format stream
"~&~8TDC.B ~A, ~A~{, ~D~}" (length list
) loop list
))))
125 (defun ymamoto-output-asm (tune out-file
)
126 (with-open-file (stream out-file
128 :if-exists
:supersede
)
130 (output-ymamoto-header stream
)
133 (format stream
"~&~8TDC.L track_~D" track-num
))
134 (ymamoto-output-length-loop-list-table
135 stream
"arpeggio_table" (tune-get-table tune
:arpeggio
))
136 (ymamoto-output-length-loop-list-table
137 stream
"venv_table" (tune-get-table tune
:volume-envelope
))
140 ;; I bet the following could all be reduced to one big format
142 (format stream
"~&track_~D:" track-num
)
143 (do ((c (tune-channels tune
) (cdr c
))
144 (ctr (char-code #\a) (1+ ctr
)))
146 (format stream
"~&~8TDC.L channel_~A" (code-char ctr
)))
147 (do ((c (tune-channels tune
) (cdr c
))
148 (ctr (char-code #\a) (1+ ctr
)))
150 (format stream
"~&channel_~A:" (code-char ctr
))
151 (ymamoto-output-note-stream (channel-data-stream (car c
)) stream
)
152 (if (channel-loop-point (car c
))
153 (format stream
"~&~8TDC.W $8001")
154 (format stream
"~&~8TDC.W $8000"))))))
156 (register-replay "YMamoto"
157 #'ymamoto-special-handler
158 #'make-ymamoto-channels
159 #'ymamoto-output-asm
)