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> / 2003
   7 ;;;
   8
   9 (in-package :mumble)
  10
  11 (defparameter *ymamoto-frequency* 50)
  12
  13 (defun make-ymamoto-channels ()
  14   (list
  15    (make-channel)
  16    (make-channel)
  17    (make-channel)))
  18
  19 (defun output-ymamoto-notes (notes stream)
  20   ;; Traverse a note-stream, keeping track of tempo and staccato
  21   ;; settings, and output assembly directives for this note stream.
  22   (let ((channel (make-channel)))
  23     (dolist (note notes)
  24       (cond ((eql (music-command-type note) :note)
  25              (let ((note-word 0))
  26                (setf (ldb (byte 7 0) note-word)
  27                      (cond ((eql (note-tone note) :rest) 127)
  28                            ((eql (note-tone note) :wait) 126)
  29                            (t (note-tone note))))
  30                (setf (ldb (byte 7 8) note-word)
  31                      (round (duration-to-frames (note-duration note)
  32                                                 (channel-tempo channel)
  33                                                 *ymamoto-frequency*)))
  34
  35                (format stream "~&        DC.W $~X" note-word)))
  36
  37             ((eql (music-command-type note) :tempo)
  38              (setf (channel-tempo channel) (music-command-value note)))))))
  39
  40 (defun mml-to-ymamoto-file (mml-file out-file)
  41   (let ((channels (make-ymamoto-channels)))
  42     (with-open-file (stream mml-file)
  43       (parse-music-section stream channels))
  44
  45     (with-open-file (stream out-file
  46                             :direction :output
  47                             :if-exists :supersede)
  48       (format stream ";;; test song, in assembler form
  49
  50         ORG 0
  51 song_header:
  52         DC.B 1                  ; number of tracks
  53         DC.L track_1            ; pointer to track
  54
  55 track_1:
  56         ;; channel pointers
  57         DC.L channel_a, channel_b, channel_c
  58         DC.B 0                  ; initial tempo
  59 ")
  60       (do ((c channels (cdr c))
  61            (ctr (char-code #\a) (1+ ctr)))
  62           ((null c))
  63         (format stream "~&channel_~A:" (code-char ctr))
  64         (output-ymamoto-notes (channel-data-stream (car c)) stream)
  65         (format stream "~&        DC.W $8000")))))
  66
  67