From 38d6715432b2e78179688358c7dbc5055f6bb51d Mon Sep 17 00:00:00 2001
From: Julian Squires <julian@cipht.net>
Date: Tue, 2 Aug 2005 20:55:35 +0100
Subject: [PATCH] Slight restructuring of replay registration.

---
 src/mumble.lisp       | 71 ++++++++++++++++++++++++---------------------------
 src/music-parser.lisp | 11 ++++----
 2 files changed, 39 insertions(+), 43 deletions(-)
 rewrite src/mumble.lisp (63%)

diff --git a/src/mumble.lisp b/src/mumble.lisp
dissimilarity index 63%
index 7a1796f..17ca7be 100644
--- a/src/mumble.lisp
+++ b/src/mumble.lisp
@@ -1,37 +1,34 @@
-(in-package :mumble)
-
-(eval-when (:compile-toplevel :load-toplevel :execute)
-  (defvar *replay-map* nil))
-
-(defun register-replay (name special-handler channel-creator output-fn)
-  (let ((replay (list name special-handler channel-creator output-fn)))
-    (aif (position name *replay-map* :test #'equal :key #'car)
-	 (setf (nth it *replay-map*) replay)
-	 (push replay *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
+;;;
+;;; Mumble main body.
+;;; Julian Squires / 2004
+;;;
+
+(in-package :mumble)
+
+(eval-when (:compile-toplevel :load-toplevel :execute)
+  (defvar *replay-map* nil))
+
+(defstruct replay
+  (name) (special-handler) (channel-creator) (output-fn))
+
+(defun register-replay (name special-handler channel-creator output-fn)
+  (let ((replay (make-replay :name name :special-handler special-handler
+			     :channel-creator channel-creator
+			     :output-fn output-fn)))
+    (aif (position name *replay-map* :test #'equal :key #'replay-name)
+	 (setf (nth it *replay-map*) replay)
+	 (push replay *replay-map*))))
+
+(defun set-tune-replay (name tune)
+  (dolist (replay *replay-map*)
+    (when (equal name (replay-name replay))
+      (setf (tune-replay tune) replay)
+      (return)))
+  (equal (replay-name (tune-replay tune)) name))
+
+;;;; HIGH-LEVEL
+
+(defun compile-mumble (in-file out-file)
+  (with-open-file (stream in-file)
+    (let ((tune (parse-mumble-file stream)))
+      (funcall (replay-output-fn (tune-replay tune)) tune out-file))))
diff --git a/src/music-parser.lisp b/src/music-parser.lisp
index 8fc56e0..bba5a3f 100644
--- a/src/music-parser.lisp
+++ b/src/music-parser.lisp
@@ -231,7 +231,7 @@
 	   ;; XXX genericize replay stuff
 	   (assert (set-tune-replay argument tune))
 	   (setf (tune-channels tune)
-		 (replay-create-channels (tune-replay tune))))
+		 (funcall (replay-channel-creator (tune-replay tune)))))
 	  ((TITLE COMPOSER COPYRIGHT)
 	   (push (list header argument) (tune-metadata tune))))))))
 
@@ -377,12 +377,11 @@ Highly intolerant of malformed inputs."
 	       (setf (channel-tempo c) tempo))))
 	  
 	  ;; Section change.
-	  ;; XXX: add something to complain about unfinished loops.
 	  ((char= next-char #\#)
 	   (read-char stream)
 	   (when in-loop-p
-	     (format t "WARNING: changing sections during a [] repeat.  ~
-                       This probably won't work."))
+	     (warn "Changing sections during a [] repeat.  ~
+                    This probably won't work."))
 	   (return))
 
 	  ;; Staccato.
@@ -409,8 +408,8 @@ Highly intolerant of malformed inputs."
 	  ((char= next-char #\%)
 	   (assert current-channels () "Command outside channels.")
 	   (read-char stream)
-	   (replay-special-handler (tune-replay tune) stream
-				   current-channels))
+	   (funcall (replay-special-handler (tune-replay tune))
+		    stream current-channels))
 
 	  ;; Comment.
 	  ((char= next-char #\;)
-- 
2.11.4.GIT