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 _ []]; tones.asRope _ music; 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; }; }. BLarkPlayImpl.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, November 18, 1985 10:02:36 am 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 "@;" 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. 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šœ™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˜Jšœžœ žœžœ ˜AJšœžœ˜Jšœ˜J˜—šžœ˜JšŸ<™J˜—J˜—Jš žœžœžœžœžœžœ˜%Jšžœžœžœ*˜EJšžœžœžœžœ˜;Jšžœžœ˜ J˜—J˜š œžœžœžœ,˜FJšžœžœžœ-˜AJšœ ˜ J˜ šž˜šžœžœžœ˜Jšžœžœžœžœ˜Jšœ ˜ Jšœ ˜ J˜—Jšžœ ˜Jšžœžœžœžœ˜Jšžœ˜—J˜—J˜Jšœ˜——…— H@0