LarkPlayImpl:
CEDAR PROGRAM
IMPORTS Basics, FS, IO, Rope
EXPORTS LarkPlay = {
--------------------------------------------------------------
TYPEs and Constants
--------------------------------------------------------------
Note: TYPE = REF NoteRec;
NoteRec:
TYPE =
RECORD [
twelfths, octave, duration, breakTime: CARDINAL𡤀,
initialized: BOOL←FALSE
initialOctave: CARDINAL = 8;
initialDuration: CARDINAL = 128; -- approximately an eighth-note, as default
initialBreak: CARDINAL = 48; -- lower-case note gap, 3/64 by default
scale: TYPE = CHARACTER ['A..'G];
twelfths: ARRAY scale OF CARDINAL = [12, 14, 3, 5, 7, 8, 10];
root: LONG CARDINAL = 10595; -- 12th root of 2, times 10000
root96:
ARRAY [0..8)
OF
LONG
CARDINAL =
-- 2^(n/96), times 10000, for slides
[10000, 10072, 10145, 10219, 10293, 10368, 10443, 10518];
freqA: LONG CARDINAL = 1760; -- highest octave we'll bother with
maxToneSpecListLength: INT ← 17;
PlayString 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 period (".") in the string causes the LIST OF ToneSpec to be broken at this point. This is for "Ghostbusters mode". See Swinehart.
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. Doesn't work if file is true.
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: Treated as a No-op herein. A period (".") in the string causes the buffer to be shipped out, as for a semi-colon, and resets the octave, note duration, and implicit lower-case rest to their initial values. This is for when you're playing an entire file that contains several separate pieces.
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.
PlayString:
PUBLIC
PROC [music: Rope.
ROPE, file:
BOOLEAN ←
FALSE, volume:
CARDINAL]
RETURNS[tones: LarkPlay.ToneSpec ← NIL]= {
music2: Rope.ROPE;
IF ~file
THEN {
pos: INT = Rope.Find[music, "&"];
IF pos>=0
THEN {
music2 ← Rope.Substr[music, pos+1];
music ← Rope.Substr[music, 0, pos];
};
};
tones ← PlayStr[music, file, volume];
IF music2#
NIL
AND music2.Length[]#0
THEN {
tones2: LarkPlay.ToneSpec = PlayStr[music2, FALSE, 0];
tones ← MergeToneSpecs[tones, tones2];
};
};
PlayStr:
PROC [music: Rope.
ROPE, file:
BOOLEAN ←
FALSE, volume:
CARDINAL]
RETURNS[tones: LarkPlay.ToneSpec ← NIL]= {
mS: IO.STREAM;
note: Note;
octave: CARDINAL ← initialOctave;
duration: CARDINAL ← initialDuration;
break: CARDINAL ← initialBreak;
triplet:
BOOLEAN ←
FALSE;
-- gets set to TRUE between parentheses
Extracted from previous downstream code. Need to merge Note-processing and Tone-processing.
listLength: INT𡤀
lastToneList: LIST OF LarkPlay.ToneList ← NIL;
lastTone: LarkPlay.ToneList;
tone: LarkPlay.Tone ← [f1: 0, f2: 0, on: 0, off: 0];
inProgress: BOOL←FALSE;
repeatIndefinitely: BOOL←TRUE;
Frequency:
PROCEDURE [key: Note, tweak:
CARDINAL ← 0
-- 96ths -- ]
RETURNS [CARDINAL] = {
freq: LONG CARDINAL;
twelfths: CARDINAL ← key.twelfths;
octave: CARDINAL ← 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
freq ← freqA*LONG[32];
IF tweak >= 8 THEN twelfths ← twelfths + (tweak/8);
THROUGH [0..twelfths/12) DO octave ← octave/2 ENDLOOP;
THROUGH [0..twelfths
MOD 12)
DO
freq ← (freq*root+LONG[5000])/LONG[10000] ENDLOOP;
IF tweak # 0
THEN
freq ← (freq*root96[tweak MOD 8]+LONG[5000])/LONG[10000];
RETURN[Basics.LongDiv[freq + LONG[octave/2], octave]];
};
AddTone:
PROC [freq:
CARDINAL, duration:
CARDINAL] = {
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.
toneListEnt: LIST OF LarkPlay.ToneList;
toneEnt: LarkPlay.ToneList;
IF (listLength
MOD maxToneSpecListLength) = 0
THEN {
toneListEnt ← LIST[NIL];
IF lastToneList=NIL THEN tones.tones ← toneListEnt
ELSE lastToneList.rest ← toneListEnt;
lastToneList ← toneListEnt;
listLength ← 0;
lastTone ← NIL;
};
toneEnt ← LIST[tone];
IF lastTone=NIL THEN lastToneList.first←lastTone←toneEnt
ELSE { lastTone.rest ← toneEnt; lastTone←toneEnt }; -- Append
tone.off ← 0;
listLength ← listLength+1;
};
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;
IF file THEN mS ← FS.StreamOpen[fileName: music ! FS.Error => CONTINUE]
ELSE mS ← IO.RIS[music];
IF mS=NIL THEN RETURN; -- Should complain!
tones ← NEW[LarkPlay.ToneSpecRec ← []];
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;
'. => listLength ← maxToneSpecListLength;
'@ => duration ← mS.GetInt[!FS.Error => CONTINUE];
'! => volume ← mS.GetInt[!FS.Error => CONTINUE];
', => break ← mS.GetInt[!FS.Error => CONTINUE];
ENDCASE;
ENDLOOP;
NextNote[];
DonePlaying[];
tones.volume ← volume;
tones.repeatIndefinitely ← repeatIndefinitely;
};
};
MergeToneSpecs:
PUBLIC
PROC[t1, t2: LarkPlay.ToneSpec, t2Divisor:
NAT𡤁, t2Delay:
NAT𡤀, volumeIncrement:
NAT𡤀]
RETURNS[ts: LarkPlay.ToneSpec] = {
tone: LarkPlay.Tone ← [0,0,0,0, 0];
l1, l2: LarkPlay.ToneList;
ll1, ll2: LIST OF LarkPlay.ToneList;
lastSpecList: LIST OF LarkPlay.ToneList ← NIL;
lastTone: LarkPlay.ToneList ← NIL;
listLen: INT𡤀
volume: NAT ← volumeIncrement;
notif: Lark.CommandEvent ← [nothing, 0C];
SendTone:
PROC = {
IF tone.repetitions#0
THEN {
newLast: LarkPlay.ToneList ← LIST[tone];
IF (listLen
MOD maxToneSpecListLength) = 0
THEN {
newSpecList: LIST OF LarkPlay.ToneList ← LIST[NIL];
listLen ← 0;
IF ts.tones=NIL THEN ts.tones ← newSpecList ELSE lastSpecList.rest ← newSpecList;
lastSpecList ← newSpecList;
lastTone ← NIL;
};
IF lastTone=NIL THEN lastSpecList.first ← newLast ELSE lastTone.rest ← newLast;
lastTone ← newLast;
listLen ← listLen+1;
tone ← [0,0,0,0, 0];
};
};
d, d1, d2: Lark.Milliseconds ← 0;
IF t1=NIL THEN RETURN[t2]; -- aberrant call
ts ←
NEW[LarkPlay.ToneSpecRec ← [
repeatIndefinitely: t1.repeatIndefinitely, volume: t1.volume+volumeIncrement]];
IF t2Delay#0 THEN l2 ← LIST[[0, 0, 0, t2Delay, 0]];
ll1 ← t1.tones; IF t2#NIL THEN ll2 ← t2.tones;
DO
f1, f2: Lark.Milliseconds;
[f1, d1, l1, ll1] ← Duration[l1, ll1, d, 1];
[f2, d2, l2, ll2] ← Duration[l2, ll2, 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: LarkPlay.ToneList, ll:
LIST
OF LarkPlay.ToneList, reduction:
INTEGER, divisor:
NAT]
RETURNS
[f: Lark.Hertz, duration: Lark.Milliseconds, t: LarkPlay.ToneList,
newLl: LIST OF LarkPlay.ToneList] = {
newVal: INTEGER;
t ← oldT;
newLl ← ll;
IF t = NIL THEN [newLl, t] ← NextT[newLl, t];
IF t=NIL THEN RETURN[0, 0, NIL, NIL];
First, take care of reductions.
IF reduction#0
THEN {
newVal ← LOOPHOLE[t.first.on, INTEGER]-reduction;
IF newVal>=0
THEN {
IF newVal=0 AND t.first.off=0 THEN [newLl, t] ← NextT[newLl, t]
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, INTEGER]-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 [newLl, t] ← NextT[newLl, t] ELSE ERROR;
};
};
IF t=NIL THEN RETURN[0, 0, NIL, NIL];
IF t.first.on#0 THEN RETURN[t.first.f1/divisor, t.first.on, t, newLl]
ELSE IF t.first.off#0 THEN RETURN[0, t.first.off, t, newLl]
ELSE ERROR;
};
NextT:
PROC[oldLl:
LIST
OF LarkPlay.ToneList, oldT: LarkPlay.ToneList]
RETURNS [lL: LIST OF LarkPlay.ToneList, t: LarkPlay.ToneList] = {
lL←oldLl;
t ← oldT;
DO
IF t=
NIL
THEN {
IF lL = NIL THEN RETURN;
t ← lL.first;
lL ← lL.rest;
}
ELSE t←t.rest;
IF t#NIL THEN RETURN;
ENDLOOP;
};
}.