
DIRECTORY
FS USING [Error],
IO,
Real USING [ Round ],
TuneParse USING [ Db, Hertz, Milliseconds, Tone, ToneList, ToneSpec, ToneSpecRec ],
Rope
;

TuneParseImpl: CEDAR PROGRAM
IMPORTS Real, FS, IO, Rope
EXPORTS TuneParse = {


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: 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];
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] = {
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.
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;
};

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] => {
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];
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;
};

}.

  
  
TuneParseImpl.mesa
Derived from LarkPlayImpl
Copyright ╙ 1984, 1992 by Xerox Corporation.  All rights reserved.
Last Edited by: Pier, May 25, 1984 2:26:24 pm PDT
Polle Zellweger (PTZ) October 30, 1987 6:27:17 pm PST
Last Edited by: Swinehart, September 29, 1992 4:59 pm PDT
--------------------------------------------------------------
TYPEs and Constants
--------------------------------------------------------------
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.

if octave is 0, believe whatever's already there; might be precomputed slide
Build a list of tones.
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.
Polle Zellweger (PTZ) October 30, 1987 6:24:08 pm PST
Catch IO.Error for GetInt; because we now have users (via FinchValues) who may construct tunes with bad syntax.  Still need to report these errors to the user.
changes to: PlayStr
Dan Swinehart (DCS) September 11, 1992 1:18:32 pm PDT
Major revision and rename for use with Phoenix (Suns) in Unix.  Eliminate the list of lists nonsense.

 Э╩
k  ХNewlineDelimiter
Ц"cedarcode" styleЩ ЩJЩJЪЬ	╧eЬ6ЩBJЪЬ1Щ1IcodeЩ5JЩ9ЧKШ Ъ╧k	Ш	KЪЬЮЬ	ШKЪЮЬШKЪЬЮЬШKШSKЪЬШKШЧKШ ЪЬЮШKЪЮЬЮЬЮЬШKЪЮЬШKШ JЪЬ>Щ>JЪЬЩJЪЬ>Щ>KШ KЪЬЮЬ╧c7ШPKЪЬЮЬШKЪЬЮЬШ,KШ KЪЬЮЬЮЬ	ШЪЬ	ЮЬЮЬШKЪЬ'ЮЬШ-KЪЬЮЬЮШЪЬШKШ ЧЧKЪЬЮЬШKЪЬЮЬ	Я+ШHKЪЬЮЬЯ'Ш@KЪЬЮЬЮ	Ь
Ш!KЪЬ
ЮЬЮЬЮЬШ8KЪЬЮЬЯШ'Ъ
ЬЮЬЮЬЮЬЯЬЯШ7KШAЧKЪЬЮЬ
Я#Ш7KШ JЩEJЪЬ╙Щ╙JЪЬ║Щ║JЪЬЮЩЮJЪЬ┴Щ┴JЪЬБЩБJЪЬ╣Щ╣JЪЬщЩщJЪЬуЩуJЪЮЬVЮЬ=ЩШJЩсJЪЬЫЩЫJЪЬЦЩЦJЪЬ╥Щ╥KШ Ъ╧n	ЬЮЬЮЬЮЬШ4KЪЮЬ Ш'KЪЬЮЬШKЪЬЮЬШ ЪЮЬЮЬШKШ!KШ!KШЧKШЪЮЬЮЬШKШ0KШ&KШЧKШKШ ЧЪаЬЮЬЮЬ
ЮЬЮЬЮЬШYKЪЬЮЬЮЬШKЪЬШKЪЬЮЬШKЪЬ
ЮЬШ KЪЬЮЬШKЪЬ	ЮЬЮЬЯ'ШBKШ KЪЬЮЬШ#KШ5KЪЬЮЬЮЬШKЪЬЮЬЮЬШJЩ Ъа	ЬЮ	ЬЮЬЯЬШ=KЪЮЬЮЬШKЪЬЮЬШKЪЬ
ЮЬШKЪЬЮЬШKШ KЪЮЬЮЬЮЬЮЬШ4JЪЬLЩLKШKЪЮЬЮЬ!Ш3KЪЮЬЮЬЮЬШ6KЪЮЬЮЬЮЬЮЬШ;ЪЮЬЮШKЪЬЮЬШ"ЧKШ KШKЪЬШKШ ЧЪаЬЮЬЮЬЮЬШ,KЩЪЮЬ	ЮЬЮЬЮЬЮЬЮЬШPJЪЬ#Щ#ЪЮЬЮЬЮЬЯ0ШSKШKЪЬ
ЮЬШKЪЮЬ
ЮЬЮЬШ1KЪЮЬ0Я	Ш=KШKШЧKШKШKЪЬЮЬШKШЧKЪЮЬЮЬЮЬШ2ЪЮЬШ"JЩ-ЧKШKШ ЧKЪаЬЮ	ЬШ,KШ ЪаЬЮ	ЬШKЪЮЬЮЬЮЬЮЬШ$KШ(KЪЮЬЮЬШ4KШKЪЬШKШ ЧKЪЬЮЬЮЬЮЬШKЪЬЮЬЮЬШKЪ	ЮЬЮЬЮЬЮЬЯШ*KЪЬЮЬШ(KШKЪЬЮЬШЪЮЬЮЬЮШKЪЬЮЬШЪЮЬЮШШ ЪЮЬШKШKШKШKЪЬЮЬ	ЮЬЮЬ
ШAKЪЬЮЬШKЪЬШKШ ЧЪЮЬШJЪЯ<Щ<KЪЬШKШ+KШШKЪЮЬЮЬ	ЮЬЮЬШ@KЪЬШЧKШKЪЬЮЬШKЪЬШKШ ЧЪЬШKШKЪЬЮЬ	ЮЬЮЬ
ШAKЪЬЮЬШKЪЬШKШ ЧЪЬЮЬЮЬ$ЯШVKШ ЧЪЬЮЬЮШKШFЧKШ ЪЬЮЬЮШШKЪЮЬFШIKШ ЧЧKШKШKЪЬЮЬШ$KШKЪЬЮЬШKШKШ KШ"KШ KЪЬЮЬШ2KЪЬЮЬЮЬ
ЮЬЯШPKЪЬЮЬЮЬ
ЮЬЯШOKЪЬЮЬЮЬ
ЮЬЯШMKШ KЪЮЬШЧKЪЮЬШKШ ЧЧKЪЬШKЪЬШKШKШ.KЪЬШKЪЬШЧKШ KШ ЪаЬЮЬЮЬ(ЮЬЮЬЮЬШqKЪЮЬШ#KШ$KШKЪЬЮЬШ#KЪЬЮЬШЪаЬЮЬШЪЮЬЮЬШKЪЬЮЬШ)KЪЮЬ
ЮЬЮЬЮЬШEKШKШKШЧKШЧKШ&KЪ	ЮЬЮЬЮЬЮЬЯШ+ЪЬЮЬШ"KЪЬOШOЧKЪЮЬЮЬЮЬШ3KЪЬЮЬЮЬЮЬЮЬЮЬЮЬЮЬШSЪЮШKШKШ"KШ*KЪЬЮЬ	ШKЪЮЬЮЬЮЬ	ШKЪЮЬЮЬЮЬШЪЮЬЮЬЮЬШKЪЬШKШ(KШЧKЪЮЬШKШKЪЮЬШЧKЪЬШKШЧKШ KШ ЪаЬЮЬ&ЮЬЮЬШFKЪЮЬRШYKЪЬЮЬШKШ	KЪ
ЮЬЮЬЮЬЮЬЮЬШ JЩЪЮЬЮЬШKЪЬ	ЮЬЮЬШ-ЪЮЬЮЬШKЪЮЬ
ЮЬЮЬШ-ЪЮЬШЪЬЮЬЮЬШ"KЪЮЬЮЬ-Ш6ЧKШKШЧKШЧЪЮЬШKЪЮЬЮЬЮЬШ"KЪЬ	ЮЬЮЬШ.ЪЮЬ
ЮЬШKЪЮЬЮЬШ2KЪЮЬЮЬШ,KШЧKЪ
ЮЬЮЬ
ЮЬЮЬЮЬШ,KШЧKШЧKЪ
ЮЬЮЬЮЬЮЬЮЬШ KЪЮЬЮЬЮЬ#Ш>KЪЮЬЮЬЮЬЮЬШ4KЪЮЬЮЬШKШЧKШ KЪЬШKШ ЧЩ5KЪЬq╧tЬ.бЩбKЪЬ╧rЩЧЩ5KЩeЧKЩ Ч ЕЧ    м  8!  