From 16227af7781b8a596863787d8267c3f5869d1c31 Mon Sep 17 00:00:00 2001 From: Julian Squires Date: Fri, 10 Dec 2004 07:02:11 +0100 Subject: [PATCH] added simple arpeggio support; improved staccato/frame tracking. --- music-parser.lisp | 55 ++++++++++++++++++++++++++++-- music-utilities.lisp | 5 ++- ymamoto.lisp | 96 ++++++++++++++++++++++++++++++++++++++++++++-------- 3 files changed, 138 insertions(+), 18 deletions(-) diff --git a/music-parser.lisp b/music-parser.lisp index 6fc2b74..0adc1de 100644 --- a/music-parser.lisp +++ b/music-parser.lisp @@ -1,6 +1,7 @@ ;;; ;;; Several of these functions are very flaky WRT EOF, and that should -;;; eventually be fixed. This is all just a quick hack. +;;; eventually be fixed. This is all just a quick hack. Most of this +;;; could be converted to a very data-driven style of programming. ;;; ;;; Other things that should be checked/fixed: ;;; - durations should get tweaked (say, by parse-music-section) if @@ -11,7 +12,7 @@ ;;; set event on any channel where we get a duration-dependant ;;; event before any tempo is set. ;;; -;;; (an abashed) Julian Squires / 2003 +;;; (an abashed) Julian Squires / 2004 ;;; (in-package :mumble) @@ -25,8 +26,10 @@ (defconstant +octave-size+ 12) +(defparameter *staccato-base-division* 1/8) (defparameter *default-duration* (make-duration 4)) (defparameter *default-octave* 4) +(defparameter *default-staccato* 1) (defparameter *default-tempo* 120) @@ -61,6 +64,19 @@ (setf (slot-value cmd 'value) tempo) cmd)) +(defun make-staccato-command (staccato) + (let ((cmd (make-instance 'music-command))) + (setf (slot-value cmd 'type) :staccato) + (setf (slot-value cmd 'value) staccato) + cmd)) + +;; This might become a special macro-command later. +(defun make-arpeggio-command (n) + (let ((cmd (make-instance 'music-command))) + (setf (slot-value cmd 'type) :arpeggio) + (setf (slot-value cmd 'value) n) + cmd)) + (defclass note (music-command) ((tone :reader note-tone) @@ -95,6 +111,7 @@ the current channel tempo.")) (let ((channel (make-instance 'channel))) (setf (channel-octave channel) *default-octave*) (setf (channel-tempo channel) *default-tempo*) + (setf (channel-staccato channel) *default-staccato*) (setf (channel-default-duration channel) *default-duration*) (setf (channel-data-stream channel) nil) channel)) @@ -268,7 +285,41 @@ Highly intolerant of malformed inputs." ((char= next-char #\#) (return)) + ;; Staccato. + ((char= next-char #\q) + (assert current-channels) + (read-char stream) + (let ((staccato (* *staccato-base-division* (expect-int stream)))) + (dolist (c current-channels) + (push (make-staccato-command staccato) + (channel-data-stream c)) + (setf (channel-staccato c) staccato)))) + + ;; Macro invocation. + ((char= next-char #\@) + (assert current-channels) + (parse-macro-invocation stream current-channels)) + + ;; Comment. + ((char= next-char #\;) + (read-line stream)) + ;; Something else? (t (format nil "~&Ignored character: ~A" (read-char stream)))) (eat-whitespace-and-barlines stream))) + + +(defun parse-macro-invocation (stream channels) + (read-char stream) + (let ((next-char (peek-char nil stream))) + ;; Arpeggio. + (cond ((char= next-char #\a) + (read-char stream) + (let ((arp-num (expect-int stream))) + (dolist (c channels) + (push (make-arpeggio-command arp-num) + (channel-data-stream c))))) + ;; Something else? + (t (format nil "~&Ignored macro invocator: @~A" + (read-char stream)))))) diff --git a/music-utilities.lisp b/music-utilities.lisp index 4ae69d1..d61b3a6 100644 --- a/music-utilities.lisp +++ b/music-utilities.lisp @@ -1,12 +1,15 @@ (in-package :mumble) +;; 60 seconds in a minute, 4 beats per whole note. (defconstant +seconds-per-minute+ 60) +(defconstant +beats-per-whole-note+ 4) (defun duration-to-frames (duration tempo &optional (frequency 50)) "Returns a /fractional/ duration -- the conversion routine is responsible for dealing with these fractions as it sees fit." - (let ((count (/ (/ frequency (/ tempo +seconds-per-minute+)) + (let ((count (/ (/ (* frequency +seconds-per-minute+) + (/ tempo +beats-per-whole-note+)) (duration-denominator duration)))) ;; dots (do ((dots (duration-dots duration) (1- dots)) diff --git a/ymamoto.lisp b/ymamoto.lisp index 8672979..cebb980 100644 --- a/ymamoto.lisp +++ b/ymamoto.lisp @@ -3,12 +3,14 @@ ;;; produce hisoft-style assembly output, which can be assembled into ;;; a binary playable by the ymamoto playroutine. ;;; -;;; Julian Squires / 2003 +;;; Julian Squires / 2004 ;;; (in-package :mumble) (defparameter *ymamoto-frequency* 50) +(defvar *channel-delta* 0) +(defvar *total-frames* 0) (defun make-ymamoto-channels () (list @@ -16,26 +18,63 @@ (make-channel) (make-channel))) + +(defun ymamoto-note-output (note channel stream) + (let ((note-word 0) + (frames (duration-to-frames (note-duration note) + (channel-tempo channel) + *ymamoto-frequency*)) + (staccato-frames 0)) + + (cond ((eql (note-tone note) :rest) + (setf (ldb (byte 7 0) note-word) 127)) + ((eql (note-tone note) :wait) + (setf (ldb (byte 7 0) note-word) 126)) + (t + (when (/= (channel-staccato channel) 1) + (setf staccato-frames (- frames (* frames + (channel-staccato channel)))) + (when (< (- frames staccato-frames) 1) + (decf staccato-frames)) + (setf frames (- frames staccato-frames))) + + (setf (ldb (byte 7 0) note-word) (note-tone note)))) + + (output-note note-word frames stream) + (when (>= staccato-frames 1) + (output-note 127 staccato-frames stream t)))) + +(defun output-note (note-word frames stream &optional (comma nil)) + (incf *channel-delta* frames) + (multiple-value-bind (frames leftovers) (floor *channel-delta*) + (setf *channel-delta* leftovers) + (setf (ldb (byte 7 8) note-word) (1- (floor frames))) + + (unless (< frames 1) + (incf *total-frames* (floor frames)) + (format stream (if comma ", $~X" "~& DC.W $~X") note-word)))) + + (defun output-ymamoto-notes (notes stream) ;; Traverse a note-stream, keeping track of tempo and staccato ;; settings, and output assembly directives for this note stream. (let ((channel (make-channel))) + (setf *channel-delta* 0) + (setf *total-frames* 0) (dolist (note notes) (cond ((eql (music-command-type note) :note) - (let ((note-word 0)) - (setf (ldb (byte 7 0) note-word) - (cond ((eql (note-tone note) :rest) 127) - ((eql (note-tone note) :wait) 126) - (t (note-tone note)))) - (setf (ldb (byte 7 8) note-word) - (round (duration-to-frames (note-duration note) - (channel-tempo channel) - *ymamoto-frequency*))) - - (format stream "~& DC.W $~X" note-word))) - + (ymamoto-note-output note channel stream)) + ((eql (music-command-type note) :arpeggio) + (format stream "~& DC.W $~X" + (logior (ash #b11000000 8) + (music-command-value note)))) ((eql (music-command-type note) :tempo) - (setf (channel-tempo channel) (music-command-value note))))))) + (setf (channel-tempo channel) (music-command-value note))) + ((eql (music-command-type note) :staccato) + (setf (channel-staccato channel) + (music-command-value note))))) + (format t "frames: ~A~%" *total-frames*))) + (defun mml-to-ymamoto-file (mml-file out-file) (let ((channels (make-ymamoto-channels))) @@ -49,9 +88,36 @@ ORG 0 song_header: + DC.L arpeggio_table ; pointer to arpeggio table + DC.L venv_table ; pointer to volume envelope table DC.B 1 ; number of tracks DC.L track_1 ; pointer to track +arpeggio_table: + DC.B 9 ; number of arpeggios + ; length, loop point, data... +arp_entry_1: + DC.B 4, 1, 0, 3, 9, -12 +arp_entry_2: + DC.B 4, 1, 0, 5, 7, -12 +arp_entry_3: + DC.B 4, 1, 0, 3, 4, -7 +arp_entry_4: + DC.B 4, 1, 0, 5, 4, -9 +arp_entry_5: + DC.B 4, 1, 0, 5, 3, -8 +arp_entry_6: + DC.B 4, 1, 0, 2, 3, -5 +arp_entry_7: + DC.B 4, 1, 0, 6, 3, -9 +arp_entry_8: + DC.B 4, 1, 0, 4, 3, -7 +arp_entry_9: + DC.B 4, 1, 0, 4, 8, -12 + +venv_table: + DC.B 0 + track_1: ;; channel pointers DC.L channel_a, channel_b, channel_c @@ -62,6 +128,6 @@ track_1: ((null c)) (format stream "~&channel_~A:" (code-char ctr)) (output-ymamoto-notes (channel-data-stream (car c)) stream) - (format stream "~& DC.W $8000"))))) + (format stream "~& DC.W $8000"))))) -- 2.11.4.GIT