From 2d5b660ef096f63501e30088490449071b86dfaa Mon Sep 17 00:00:00 2001 From: Julian Squires Date: Fri, 24 Dec 2004 07:57:08 +0100 Subject: [PATCH] Cleaned up replay separation stuff a bit. --- mumble.asd | 7 ++--- src/mumble.lisp | 35 +++++++++++++++++++++++++ src/music-parser.lisp | 21 ++++++++------- src/replay-ymamoto.lisp | 68 +++++++++++++++++++++++++------------------------ 4 files changed, 84 insertions(+), 47 deletions(-) create mode 100644 src/mumble.lisp diff --git a/mumble.asd b/mumble.asd index 3aa229c..10c39d2 100644 --- a/mumble.asd +++ b/mumble.asd @@ -10,9 +10,10 @@ :components ((:file "package") (:file "classes" :depends-on ("package")) + (:file "music-utilities" :depends-on ("classes")) (:file "music-parser" :depends-on ("classes" "music-utilities")) - (:file "music-utilities" :depends-on ("classes")) - (:file "replay-ymamoto" :depends-on ("music-parser")) - (:file "replay-xm" :depends-on ("music-parser")))))) + (:file "mumble" :depends-on ("music-parser")) + (:file "replay-ymamoto" :depends-on ("mumble")) + (:file "replay-xm" :depends-on ("mumble")))))) diff --git a/src/mumble.lisp b/src/mumble.lisp new file mode 100644 index 0000000..8bfda64 --- /dev/null +++ b/src/mumble.lisp @@ -0,0 +1,35 @@ +(in-package :mumble) + +(eval-when (:compile-toplevel :load-toplevel :execute) + (defvar *replay-map* nil)) + +(defun register-replay (name special-handler channel-creator output-fn) + (push (list name special-handler channel-creator output-fn) + *replay-map*)) + +(defun set-tune-replay (name tune) + (dolist (replay *replay-map*) + (when (equal name (car replay)) + (setf (tune-replay tune) name))) + (equal (tune-replay tune) name)) + +(defun replay-output-fn (replay tune file) + (do ((list *replay-map* (cdr list))) + ((equal replay (caar list)) (funcall (fourth (car list)) tune file)))) + +(defun replay-create-channels (replay) + (do ((list *replay-map* (cdr list))) + ((equal replay (caar list)) (funcall (third (car list)))))) + +(defun replay-special-handler (replay stream channels) + (do ((list *replay-map* (cdr list))) + ((equal replay (caar list)) (funcall (second (car list)) + stream channels)))) + + +;;;; HIGH-LEVEL + +(defun compile-mumble (in-file out-file) + (with-open-file (stream in-file) + (let ((tune (parse-mumble-file stream))) + (replay-output-fn (tune-replay tune) tune out-file)))) \ No newline at end of file diff --git a/src/music-parser.lisp b/src/music-parser.lisp index 7d5214b..73e6235 100644 --- a/src/music-parser.lisp +++ b/src/music-parser.lisp @@ -33,7 +33,6 @@ (defparameter *default-staccato* 1) (defparameter *default-tempo* 120) - ;;;; LOW-LEVEL PARSE/LEX ROUTINES. (defun digit-to-int (char) @@ -183,7 +182,7 @@ (COMMENT (parse-comment-section stream)) (MACROS (parse-macro-section stream tune)) (HEADER (parse-header-section stream tune)) - (MUSIC (parse-music-section stream (tune-channels tune))))) + (MUSIC (parse-music-section stream tune)))) (end-of-file () tune)))) @@ -203,9 +202,9 @@ (case header (REPLAY ;; XXX genericize replay stuff - (assert (string= argument "YMamoto")) - (setf (tune-channels tune) (make-ymamoto-channels)) - (setf (tune-replay tune) argument)) + (assert (set-tune-replay argument tune)) + (setf (tune-channels tune) + (replay-create-channels (tune-replay tune)))) ((TITLE COMPOSER COPYRIGHT) (push (list header argument) (tune-metadata tune)))))))) @@ -255,7 +254,7 @@ -(defun parse-music-section (stream channels +(defun parse-music-section (stream tune &optional loop-channels in-loop-p) "Reads a music section from stream; returns at EOF or if a section change is detected. Writes data and property changes to channels. @@ -267,9 +266,9 @@ Highly intolerant of malformed inputs." (cond ((find next-char *channel-select-characters*) (setf current-channels nil) (dolist (c (expect-channels stream)) - (assert (< c (length channels)) + (assert (< c (length (tune-channels tune))) () "Invalid channel for this replay.") - (push (nth c channels) current-channels))) + (push (nth c (tune-channels tune)) current-channels))) ;; Repeats (unrolled loops). ((char= next-char #\[) @@ -278,7 +277,7 @@ Highly intolerant of malformed inputs." (dolist (c current-channels) (push (channel-current-position c) (channel-repeats c))) - (parse-music-section stream channels current-channels t)) + (parse-music-section stream tune current-channels t)) ((char= next-char #\]) (assert (and in-loop-p @@ -377,8 +376,8 @@ Highly intolerant of malformed inputs." ((char= next-char #\%) (assert current-channels () "Command outside channels.") (read-char stream) - ;; XXX genericize replay stuff - (ymamoto-special-handler stream channels)) + (replay-special-handler (tune-replay tune) stream + (tune-channels tune))) ;; Comment. ((char= next-char #\;) diff --git a/src/replay-ymamoto.lisp b/src/replay-ymamoto.lisp index 96f1e0b..fb55cb0 100644 --- a/src/replay-ymamoto.lisp +++ b/src/replay-ymamoto.lisp @@ -122,36 +122,38 @@ song_header: ;;;; HIGH-LEVEL -(defun mbl-to-ymamoto-file (mbl-file out-file) - (let (tune) - (with-open-file (stream mbl-file) - (setf tune (parse-mumble-file stream))) - (with-open-file (stream out-file - :direction :output - :if-exists :supersede) - ;; simple header - (output-ymamoto-header stream) - ;; for n tracks - (let ((track-num 1)) - (format stream "~&~8TDC.L track_~D" track-num)) - (ymamoto-output-length-loop-list-table - stream "arpeggio_table" (tune-get-table tune :arpeggio)) - (ymamoto-output-length-loop-list-table - stream "venv_table" (tune-get-table tune :volume-envelope)) - ;; for n tracks - (let ((track-num 1)) - ;; I bet the following could all be reduced to one big format - ;; statement. Yuck. - (format stream "~&track_~D:" track-num) - (do ((c (tune-channels tune) (cdr c)) - (ctr (char-code #\a) (1+ ctr))) - ((null c)) - (format stream "~&~8TDC.L channel_~A" (code-char ctr))) - (do ((c (tune-channels tune) (cdr c)) - (ctr (char-code #\a) (1+ ctr))) - ((null c)) - (format stream "~&channel_~A:" (code-char ctr)) - (ymamoto-output-note-stream (channel-data-stream (car c)) stream) - (if (channel-loop-point (car c)) - (format stream "~&~8TDC.W $8001") - (format stream "~&~8TDC.W $8000"))))))) +(defun ymamoto-output-asm (tune out-file) + (with-open-file (stream out-file + :direction :output + :if-exists :supersede) + ;; simple header + (output-ymamoto-header stream) + ;; for n tracks + (let ((track-num 1)) + (format stream "~&~8TDC.L track_~D" track-num)) + (ymamoto-output-length-loop-list-table + stream "arpeggio_table" (tune-get-table tune :arpeggio)) + (ymamoto-output-length-loop-list-table + stream "venv_table" (tune-get-table tune :volume-envelope)) + ;; for n tracks + (let ((track-num 1)) + ;; I bet the following could all be reduced to one big format + ;; statement. Yuck. + (format stream "~&track_~D:" track-num) + (do ((c (tune-channels tune) (cdr c)) + (ctr (char-code #\a) (1+ ctr))) + ((null c)) + (format stream "~&~8TDC.L channel_~A" (code-char ctr))) + (do ((c (tune-channels tune) (cdr c)) + (ctr (char-code #\a) (1+ ctr))) + ((null c)) + (format stream "~&channel_~A:" (code-char ctr)) + (ymamoto-output-note-stream (channel-data-stream (car c)) stream) + (if (channel-loop-point (car c)) + (format stream "~&~8TDC.W $8001") + (format stream "~&~8TDC.W $8000")))))) + +(register-replay "YMamoto" + #'ymamoto-special-handler + #'make-ymamoto-channels + #'ymamoto-output-asm) -- 2.11.4.GIT