TuneParseImpl:
CEDAR PROGRAM
IMPORTS Real, FS, IO, Rope
EXPORTS TuneParse = {
--------------------------------------------------------------
TYPEs and Constants
--------------------------------------------------------------
Db: TYPE ~ TuneParse.Db; -- These are only used in interfaces; they're all INTs.
Hertz: TYPE ~ TuneParse.Hertz;
Milliseconds: TYPE ~ TuneParse.Milliseconds;
Note: TYPE = REF NoteRec;
NoteRec:
TYPE =
RECORD [
twelfths, octave, duration, breakTime: INT¬0,
initialized: BOOL¬FALSE
initialOctave: INT = 8;
initialDuration: INT = 128; -- approximately an eighth-note, as default
initialBreak: INT = 48; -- lower-case note gap, 3/64 by default
scale: TYPE = CHARACTER ['A..'G];
twelfths: ARRAY scale OF INT = [12, 14, 3, 5, 7, 8, 10];
root: REAL = 1.0595; -- 12th root of 2
root96:
ARRAY [0..8)
OF
REAL =
-- 2
(n/96), for slides
[1.0000, 1.0072, 1.0145, 1.0219, 1.0293, 1.0368, 1.0443, 1.0518];
freqA: INT = 1760; -- highest octave we'll bother with
ParseTune is the main procedure. It interprets its block as follows:
A letter from "A" through "G" specifies a note. If the letter is followed by "#" then the corresponding sharp-note is played (meaningful only for C, D, F, G, and A). All notes are eighth-notes, but upper-case letters cause tones that are "held" the full time while lower-case notes last for 3/64 seconds less and followed by a 3/64 rest.
C is the bottom of the octave; B is above C. When ">" is encountered, all subsequent notes are an octave higher; a "<" lowers all subsequent notes by an octave. Going up more than 3 octaves is not permitted (additional ">"s are ignored), and notes near the top of the highest octave may not be struck accurately.
A "/" in the string halves the note durations, down to a minimum of 64th-notes; a "*" doubles the durations up to a maximum of full-notes. A lower-case 1/16th-note would actually be a 64th-note followed by a 3/64 rest, which may or may not be what you want; a lower-case 32nd-note vanishes completely! To halve and double the amount of implicit rest "stolen" from lower-case notes, use "←" and "^", respectively.
Use "%" to get an explicit rest (as distinct from the implicit ones after lower-case notes). The rest is the same length as a note, i.e., initially an eighth-rest, and changed via "/" and "*".
A "+" causes the preceding note to be held for an extra 50%. Thus a quarter-note followed by a "+" becomes a 3/8-note, etc. A "-" causes the preceding note's duration to be halved. This is effectively a shorthand for bracketing the note with "/" and "*".
A left parenthesis causes subsequent notes and explicit rests to be at 2/3 normal duration, until a right parenthesis is reached. Three notes enclosed in parentheses yield a "triplet".
If you think you know exactly what tempo you want, use "@<n>;" to give the note duration and/or ",<d>;" for the lower-case implicit rest, where <n> and <d> are strings of digits representing milliseconds. The values will be constrained to the usual limits (e.g., <n> will be forced between 16 and 1024 ms). Subsequent "*", "←", etc., have their usual effects.
"!<n>; sets the volume to n. 0 is loudest, and some integer > 0 is softest; experiment. This overrides the default specified in PlayString, but may not take effect until several notes after it appears, unless specified first.
A colon (":") in the string toggles the "repeatIndefinitely" specification, originally TRUE. Thus, one can arrange for a single-repetition of the tune.
Everything following an ampersand ("&") represents a second tune to be played in parallel with the first. This is not compatible with "duet-mode"; it can be used to make customized standard ring-tones and DTMF tones, though.
NB: Not implemented any more. Two or more notes and/or rests enclosed in braces, as "{C%%%G#}", yield a "slide" from the first note to the last. The duration of the slide equals the total duration of the notes and rests; observe that upper- and lower-case notes have the same effect. The slide consists of 64th-notes at equally-spaced (logarithmic) frequencies. Warning: This can eat up a lot of array space!
NB: Not used for anything any more. The argument "chunkSize" is the number of tones (including rests, explicit and implicit) that are played as a unit; if you exceed this limit, the first chunk of music gets played and there is a slight pause while the next "chunkSize" notes get parsed. If you know where you want this pause to occur, you can force it by putting a semi-colon at that point in the string.
NB: Soon to disappear: explicit requests via "[" and "]" to break up the tune into playable pieces, and to request notification that a previous piece has almost finished. This function will instead compute it.
ParseTune:
PUBLIC
PROC [tune: Rope.
ROPE, volume: Db]
RETURNS[ tones: TuneParse.ToneSpec] ~ {
tune2: Rope.ROPE;
pos: INT = Rope.Find[tune, "&"];
IF pos>=0
THEN {
tune2 ¬ Rope.Substr[tune, pos+1];
tune ¬ Rope.Substr[tune, 0, pos];
};
tones ¬ ParseStr[tune, volume];
IF tune2.Length[]#0
THEN {
tones2: TuneParse.ToneSpec = ParseStr[tune2, 0];
tones ¬ MergeToneSpecs[tones, tones2];
};
};
ParseStr:
PROC [tune: Rope.
ROPE, volume:
INT]
RETURNS[tones: TuneParse.ToneSpec ¬
NIL]= {
mS: IO.STREAM;
note: Note;
octave: INT ¬ initialOctave;
duration: INT ¬ initialDuration;
break: INT ¬ initialBreak;
triplet: BOOLEAN ¬ FALSE; -- gets set to TRUE between parentheses
lastTone: TuneParse.ToneList ¬ NIL;
tone: TuneParse.Tone ¬ [f1: 0, f2: 0, on: 0, off: 0];
inProgress: BOOL¬FALSE;
repeatIndefinitely: BOOL¬TRUE;
Frequency:
PROCEDURE [key: Note, tweak:
INT ¬ 0
-- 96ths -- ]
RETURNS [freq: INT] = {
freqR: REAL¬0.0;
twelfths: INT ¬ key.twelfths;
octave: INT ¬ key.octave*32;
IF octave = 0 OR twelfths = 0 THEN RETURN[twelfths];
if octave is 0, believe whatever's already there; might be precomputed slide
freqR ¬ freqA*32;
IF tweak >= 8 THEN twelfths ¬ twelfths + (tweak/8);
THROUGH [0..twelfths/12) DO octave ¬ octave/2 ENDLOOP;
THROUGH [0..twelfths MOD 12) DO freqR ¬ freqR*root ENDLOOP;
IF tweak # 0
THEN
freqR ¬ freqR*root96[tweak MOD 8];
freqR ¬ (freqR+octave/2)/octave;
freq ¬ Real.Round[freqR];
};
AddTone:
PROC [freq:
INT, duration:
INT] = {
Build a list of tones.
IF (freq#0
AND (freq#tone.f1
OR tone.off#0))
OR ~inProgress
OR duration=0
THEN {
A tone, end marker, or leading rest
IF inProgress
AND tone.on#0
THEN {
-- in progress is previous note or leading rest.
toneEnt: TuneParse.ToneList;
toneEnt ¬ LIST[tone];
IF lastTone=NIL THEN tones.tones¬lastTone¬toneEnt
ELSE { lastTone.rest ¬ toneEnt; lastTone¬toneEnt }; -- Append
tone.off ¬ 0;
};
tone.f1 ¬ freq;
tone.on ¬ duration;
inProgress ¬ TRUE;
}
ELSE IF freq=0 THEN tone.off ¬ tone.off + duration
ELSE tone.on ¬ tone.on + duration;
Non-leading, non-trailing rest, or tied note.
};
DonePlaying: PROCEDURE = { AddTone[0, 0]; };
NextNote:
PROCEDURE [] = {
IF NOT note.initialized THEN RETURN;
AddTone[Frequency[note], note.duration];
IF note.breakTime#0 THEN AddTone[0, note.breakTime];
note ¬ [];
};
{ ENABLE UNWIND => CONTINUE;
mS ¬ IO.RIS[tune];
IF mS=NIL THEN RETURN; -- Should complain!
tones ¬ NEW[TuneParse.ToneSpecRec ¬ []];
tones.asRope ¬ tune;
note ¬ NEW[NoteRec¬[]];
WHILE
NOT mS.EndOf[]
DO
char: CHAR ¬ mS.GetChar[];
SELECT char
FROM
IN ['A..'G] => {
NextNote[];
note.twelfths ¬ twelfths[char];
note.octave ¬ octave;
note.duration ¬ IF triplet THEN (duration*2 + 1)/3 ELSE duration;
note.initialized ¬ TRUE;
};
IN ['a..'g] => {
-- this is where the "slop" mentioned for brackets comes in
NextNote[];
note.twelfths ¬ twelfths[char + ('A - 'a)];
note.octave ¬ octave;
note.duration ¬
MAX[(IF triplet THEN (duration*2 + 1)/3 ELSE duration), break] -
break;
note.breakTime ¬ break;
note.initialized ¬ TRUE;
};
'% => {
NextNote[];
note.duration ¬ IF triplet THEN (duration*2 + 1)/3 ELSE duration;
note.initialized ¬ TRUE;
};
'# =>
IF note.initialized
THEN note.twelfths ¬ note.twelfths + 1;
--sharps 1/12 higher
'+ =>
IF note.initialized
THEN
note.duration ¬ ((note.duration+note.breakTime)*3/2) - note.breakTime;
'- =>
IF note.initialized
THEN
note.duration ¬
MAX[((note.duration+note.breakTime)/2), note.breakTime] - note.breakTime;
'< => octave ¬ octave*2;
'> => octave ¬ octave/2;
'/ => duration ¬ MAX[duration/2, 8];
'* => duration ¬ duration*2;
'← => break ¬ MAX[break/2, 2];
'^ => break ¬ break*2;
'(, ') => triplet ¬ ( char = '( );
': => repeatIndefinitely ¬ NOT repeatIndefinitely;
'@ => duration ¬ mS.GetInt[!IO.Error, FS.Error => CONTINUE]; -- Should complain!
'! => volume ¬ -mS.GetInt[!IO.Error, FS.Error => CONTINUE]; -- Should complain!
', => break ¬ mS.GetInt[!IO.Error, FS.Error => CONTINUE]; -- Should complain!
ENDCASE;
ENDLOOP;
NextNote[];
DonePlaying[];
tones.volume ¬ volume;
tones.repeatIndefinitely ¬ repeatIndefinitely;
};
};
MergeToneSpecs:
PUBLIC
PROC[t1, t2: TuneParse.ToneSpec, t2Divisor:
INT¬1, t2Delay:
INT¬0, volumeIncrement:
INT¬0]
RETURNS[ts: TuneParse.ToneSpec] = {
tone: TuneParse.Tone ¬ [0,0,0,0, 0];
l1, l2: TuneParse.ToneList;
lastTone: TuneParse.ToneList ¬ NIL;
volume: INT ¬ volumeIncrement;
SendTone:
PROC = {
IF tone.repetitions#0
THEN {
newLast: TuneParse.ToneList ¬ LIST[tone];
IF lastTone=NIL THEN ts.tones ¬ newLast ELSE lastTone.rest ¬ newLast;
lastTone ¬ newLast;
tone ¬ [0,0,0,0, 0];
};
};
d, d1, d2: TuneParse.Milliseconds ¬ 0;
IF t1=NIL THEN RETURN[t2]; -- aberrant call
ts ¬
NEW[TuneParse.ToneSpecRec ¬ [
repeatIndefinitely: t1.repeatIndefinitely, volume: t1.volume+volumeIncrement]];
IF t2Delay#0 THEN l2 ¬ LIST[[0, 0, 0, t2Delay, 0]];
l1 ¬ t1.tones; IF t2#NIL THEN IF l2=NIL THEN l2 ¬ t2.tones ELSE l2.rest ¬ t2.tones;
DO
f1, f2: TuneParse.Milliseconds;
[f1, d1, l1] ¬ Duration[l1, d, 1];
[f2, d2, l2] ¬ Duration[l2, d, t2Divisor];
d ¬ MIN[d1, d2];
IF d=0 THEN d ¬ MAX[d1, d2];
IF d=0 THEN EXIT;
IF f1#0
OR f2#0
THEN {
SendTone[];
tone.f1 ¬ f1; tone.f2 ¬ f2; tone.on ¬ d;
}
ELSE tone.off ¬ tone.off + d;
tone.repetitions ¬ 1;
ENDLOOP;
SendTone[];
};
Duration:
PROC[oldT: TuneParse.ToneList, reduction:
INT, divisor:
INT]
RETURNS [f: TuneParse.Hertz, duration: TuneParse.Milliseconds, t: TuneParse.ToneList] = {
newVal: INT;
t ¬ oldT;
IF t=NIL THEN RETURN[0, 0, NIL];
First, take care of reductions.
IF reduction#0
THEN {
newVal ¬ LOOPHOLE[t.first.on, INT]-reduction;
IF newVal>=0
THEN {
IF newVal=0 AND t.first.off=0 THEN t ¬ t.rest
ELSE {
t ¬
IF t.first.repetitions=0
THEN t
ELSE CONS[[t.first.f1, 0, 0, t.first.off, 0], t.rest];
t.first.on ¬ newVal;
};
}
ELSE {
IF newVal#(-reduction) THEN ERROR;
newVal ¬ LOOPHOLE[t.first.off, INT]-reduction;
IF newVal>0
THEN {
IF t.first.repetitions=0 THEN t.first.off ¬ newVal
ELSE t ¬ CONS[[0, 0, 0, newVal, 0], t.rest];
}
ELSE IF newVal=0 THEN t ¬ t.rest ELSE ERROR;
};
};
IF t=NIL THEN RETURN[0, 0, NIL];
IF t.first.on#0 THEN RETURN[t.first.f1/divisor, t.first.on, t]
ELSE IF t.first.off#0 THEN RETURN[0, t.first.off, t]
ELSE ERROR;
};
}.