<> <> <> <> 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; <> <> <" 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.>> <> <> <> <> <;" to give the note duration and/or ",;" for the lower-case implicit rest, where and are strings of digits representing milliseconds. The values will be constrained to the usual limits (e.g., will be forced between 16 and 1024 ms). Subsequent "*", "_", etc., have their usual effects.>> <<"!; 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.>> <> <> <> <> <> <> <> 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] => { <<-- 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_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; }; }.