DIRECTORY
Basics USING [LongDiv],
FS USING [Error, StreamOpen],
IO,
Lark USING [ CommandEvent, Hertz, Milliseconds ],
LarkPlay USING [ Tone, ToneList, ToneSpec, ToneSpecRec ],
Rope
;

LarkPlayImpl: CEDAR PROGRAM
IMPORTS Basics, FS, IO, Rope
EXPORTS LarkPlay = {


Note: TYPE = REF NoteRec;
NoteRec: TYPE = RECORD [
twelfths, octave, duration, breakTime: CARDINAL_0,
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: 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


listLength: INT_0;
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];
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 {
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;
};

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] => {
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_1, t2Delay: NAT_0, volumeIncrement: NAT_0]
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_0;
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];
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;
};

}.
@LarkPlayImpl.mesa
Copyright c 1984 by Xerox Corporation.  All rights reserved.
Last Edited by: Pier, May 25, 1984 2:26:24 pm PDT
Last Edited by: Swinehart, January 16, 1985 7:00:17 pm PST
--------------------------------------------------------------
TYPEs and Constants
--------------------------------------------------------------
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.
Extracted from previous downstream code.  Need to merge Note-processing and Tone-processing.

if octave is 0, believe whatever's already there; might be precomputed slide
A tone, end marker, or leading rest
Non-leading, non-trailing rest, or tied note.
-- this is where the "slop" mentioned for  brackets comes in
First, take care of reductions.
�Ê£˜Jš
œ™šœ
Ïm
œ1™<Jš
œ1™1J™:—J˜š
Ïk	˜	Jšœžœ˜Jšœžœ˜Jšžœ
˜Jšœžœ'˜1J˜9Jš
œ˜J˜
—J˜šœž
˜Jšžœ	žœžœ˜Jšžœ
˜J˜Jš
œ>™>Jš
œ™Jš
œ>™>J˜Jšœžœžœ	˜šœ	žœžœ˜Jšœ'žœ˜2Jšœ
žœ
ž˜š
œ˜J˜——Jšœžœ˜Jšœžœ	Ïc+˜MJšœžœŸ'˜EJšœžœž	œ
˜!Jšœ
žœžœ
žœ˜=Jšœžœ
žœŸ˜<š
œžœžœ
žœ
žœŸ$˜MJ˜9—Jšœžœ
žœ
Ÿ#˜AJ˜Jšœžœ˜ J˜Jš
œF™FJš
œÓ™ÓJš
œº™ºJš
œž™žJš
œÁ
™Á
Jš
œ�™�Jš
œ¹
™¹
Jš
œé™éJš
ϋ
™ã
Jš
Ϡ
™†
Jšž
œVžœ=™˜
Jš
œ€™€Jš
œ›™›Jš
œ–™–Jš
œ¨™¨Jš
œÒ
™Ò
J˜šÏn
œžœ
žœžœžœžœ
žœ
˜SJšžœžœ˜*Jšœ
žœ
˜šžœžœ˜Jšœžœ˜!šžœžœ˜J˜#J˜#J˜—J˜—J˜%šžœžœ
žœžœ˜*J˜6J˜&J˜—J˜J˜—š œžœžœžœžœ
žœ
˜IJšžœžœ˜*Jšœžœ
žœ
˜Jš
œ˜Jšœžœ˜!Jšœ
žœ˜%Jšœžœ˜šœ	žœžœŸ'˜BJ˜—J™\J˜J˜Jšœžœ
žœžœ
˜.J˜Jš
œ˜Jš
œ4˜4Jšœžœ
žœ
˜Jšœžœ
žœ
˜J™š 	œž	œžœŸœ˜BJšžœžœ˜Jšœžœ
žœ
˜Jšœ
žœ˜"Jšœžœ˜!J˜Jšžœžœžœ
žœ˜4Jš
œL™LJšœ
žœ˜Jšžœžœ!˜3Jšžœžœžœ
˜6šžœžœž˜Jšœžœžœžœ
˜2—šžœž˜Jšœžœžœžœ˜9—Jšžœžœ˜6J˜Jš
œ˜J˜—š œžœžœžœ˜6šžœ	žœžœžœ
žœžœ˜PJš
œ#™#šžœžœžœŸ0˜SJšœ
žœ
žœ˜'Jš
œ˜šžœ
žœžœ˜4Jšœžœ
žœ˜Jšžœžœ
žœ˜2Jšžœ"˜&Jš
œ˜J˜Jšœžœ
˜J˜—Jšœ
žœ˜Jšžœ
žœ
žœ$˜8Jšžœ0Ÿ	˜=Jš
œ
˜
J˜J˜—Jš
œ˜Jš
œ˜Jšœ
žœ
˜J˜
—Jšžœ
žœžœ˜2šžœ˜"J™-—J˜J˜—Jš œž	œ˜,J˜š œž	œ˜Jšžœ
žœžœ
žœ
˜$J˜(Jšžœžœ˜4J˜Jš
œ˜J˜—Jšœžœ
žœžœ
˜Jšžœžœ&žœ
žœ
˜GJšžœžœ
žœ˜Jšžœžœ
žœ
žœ˜*Jšœžœ˜'Jšœžœ
˜šžœ
žœž˜Jšœžœ˜šžœž˜˜šžœ˜J˜J˜J˜Jšœžœ	žœžœ
˜AJšœžœ
˜Jš
œ˜J˜—šžœ˜Jš
Ÿ<™<Jš
œ˜J˜+J˜š
œ˜Jšžœžœ	žœžœ˜@Jš
œ˜—J˜Jšœžœ
˜Jš
œ˜J˜—š
œ˜J˜Jšœžœ	žœžœ
˜AJšœžœ
˜Jš
œ˜J˜—šœžœžœ$Ÿ˜VJ˜—šœžœž˜Jš
œF˜F—J˜šœžœž˜š
œ˜JšžœF˜IJ˜——Jš
œ˜Jš
œ˜Jšœžœ˜$Jš
œ˜Jšœžœ
˜Jš
œ˜J˜J˜"J˜Jšœžœ˜2Jš
œ)˜)Jšœžœ
žœ˜2Jšœžœ
žœ˜0Jšœžœ
žœ˜/J˜Jšžœ
˜—Jšžœ
˜J˜——Jš
œ˜Jš
œ˜J˜J˜.Jš
œ˜Jš
œ˜—J˜J˜š œžœ
žœ'žœ
žœžœ˜pJšžœ˜"Jš
œ#˜#Jš
œ˜Jšœ
žœ
žœ˜$Jšœžœ
žœžœ
˜.Jšœžœ
˜"Jšœ	žœ˜Jšœžœ˜J˜*š œžœ˜šžœžœ˜Jšœžœ˜(šžœ
žœžœ˜2Jš	œ
žœ
žœžœ
žœ˜3Jš
œ˜Jšžœ
žœ
žœžœ!˜QJ˜Jšœžœ
˜J˜—Jšžœ
žœ
žœžœ˜OJ˜J˜Jš
œ˜J˜—J˜—J˜!Jš	žœžœ
žœ
žœŸ˜+šœžœ˜!Jš
œO˜O—Jšžœžœžœ˜3Jšœžœžœ
žœ˜.š
ž˜J˜J˜,J˜4Jšœžœ	˜Jšžœžœžœ	˜Jšžœžœ
žœ
˜šžœžœžœ˜Jš
œ˜Jš
œ(˜(J˜
—Jšžœ˜J˜Jšžœ
˜—Jš
œ˜J˜—J˜J˜š œžœžœ
žœžœžœ
˜hš
ž˜Jš
œB˜BJšœžœ
žœ˜%—Jšœžœ
˜J˜	Jš
œ˜Jšžœžœ
žœ˜-Jšžœžœ
žœ
žœžœžœ˜%J™šžœ
žœ˜Jšœ	žœ
žœ˜1šžœžœ˜Jšžœ
žœžœ˜?šžœ˜šœžœžœ˜"Jšžœ
žœ-˜6—J˜J˜—J˜
—šžœ˜Jšžœžœ
žœ
˜"Jšœ	žœžœ˜2šžœ
žœ˜Jšžœžœ˜2Jšžœžœ˜,J˜
—Jš
žœ
žœ
žœžœ
žœ
˜>J˜—J˜—Jšžœžœ
žœ
žœžœžœ˜%Jšžœžœ
žœ*˜EJšžœ
žœžœ
žœ˜;Jšžœ
žœ
˜J˜—J˜š œžœžœ
žœ,˜FJšžœžœ
žœ-˜AJš
œ	˜	J˜	š
ž˜šžœžœ
žœ˜Jšžœžœ
žœ
žœ
˜Jš
œ
˜
Jš
œ
˜
J˜
—Jšžœ
˜Jšžœžœ
žœ
žœ
˜Jšžœ
˜—J˜—J˜Jš
œ˜——…— 2@