src/replay-ymamoto.lisp

   1 ;;;
   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.
   5 ;;;
   6 ;;; Julian Squires <tek@wiw.org> / 2004
   7 ;;;
   8
   9 (in-package :mumble)
  10
  11 (defparameter *ymamoto-frequency* 50)
  12 (defvar *channel-delta* 0)
  13 (defvar *total-frames* 0)
  14
  15 ;;;; UTILITIES
  16
  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
  20 multiple loops."
  21   (aif (position :loop list)
  22        (values (remove :loop list) it)
  23        (values list 0)))
  24
  25
  26 ;;;; INPUT-RELATED FUNCTIONS
  27
  28 (defun make-ymamoto-channels ()
  29   (list
  30    (make-channel)
  31    (make-channel)
  32    (make-channel)))
  33
  34
  35 (defun ymamoto-special-handler (stream channels)
  36   (read-char stream)
  37   (let ((next-char (read-char stream)))
  38     (cond ((char= next-char #\e)
  39            ;; env follow
  40            (format t "~&guilty env follow"))
  41           ;; Something else?
  42           (t (format t "~&Ignored special invocator: @~A" next-char)))))
  43
  44
  45 ;;;; OUTPUT FUNCTIONS
  46
  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))
  53
  54     (when (plusp frames)
  55       (incf *total-frames* frames)
  56       (format stream (if comma ", $~X" "~&~8TDC.W $~X") note-word))))
  57
  58
  59 (defun ymamoto-output-note (note channel stream)
  60   (let ((note-word 0)
  61         (frames (duration-to-frames (note-duration note)
  62                                     (channel-tempo channel)
  63                                     *ymamoto-frequency*))
  64         (staccato-frames 0))
  65
  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))
  70           (t
  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)))
  77
  78            (setf (ldb (byte 7 0) note-word) (note-tone note))))
  79
  80     (ymamoto-output-note-helper note-word frames stream)
  81     (when (plusp staccato-frames)
  82       (ymamoto-output-note-helper 127 staccato-frames stream t))))
  83
  84
  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))
  94             (:arpeggio
  95              (format stream "~&~8TDC.W $~X"
  96                      (logior (ash #b11000000 8) (music-command-value note))))
  97             (:tempo
  98              (setf (channel-tempo channel) (music-command-value note)))
  99             (:staccato
 100              (setf (channel-staccato channel) (music-command-value note)))))
 101     (format t "~&frames: ~A" *total-frames*)))
 102
 103
 104 (defun output-ymamoto-header (stream)
 105   (format stream ";;; test song, in assembler form
 106
 107         ORG 0
 108 song_header:
 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"))
 112
 113
 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))))
 117   (do ((i 1 (1+ i)))
 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))))
 121
 122
 123 ;;;; HIGH-LEVEL
 124
 125 (defun ymamoto-output-asm (tune out-file)
 126   (with-open-file (stream out-file
 127                    :direction :output
 128                    :if-exists :supersede)
 129     ;; simple header
 130     (output-ymamoto-header stream)
 131     ;; for n tracks
 132     (let ((track-num 1))
 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))
 138     ;; for n tracks
 139     (let ((track-num 1))
 140       ;; I bet the following could all be reduced to one big format
 141       ;; statement.  Yuck.
 142       (format stream "~&track_~D:" track-num)
 143       (do ((c (tune-channels tune) (cdr c))
 144            (ctr (char-code #\a) (1+ ctr)))
 145           ((null c))
 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)))
 149           ((null c))
 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"))))))
 155
 156 (register-replay "YMamoto"
 157                  #'ymamoto-special-handler
 158                  #'make-ymamoto-channels
 159                  #'ymamoto-output-asm)