language-Modula2-0.1: examples/Modula-2_Libraries/PMOS/sources/general/music3.mod
IMPLEMENTATION MODULE Music3;
(********************************************************)
(* *)
(* Translates 3-part music from *)
(* musical notation to the form *)
(* expected by module Play3B. *)
(* *)
(* Programmer: P. Moylan, T Channon *)
(* Last edited: 21 March 1995 *)
(* Changes: Signed wavetables. *)
(* Precomputed amplitudes *)
(* Precomputed envelopes *)
(* Status: Working *)
(* *)
(* This version is TC's version of Midsummer's *)
(* Day (i.e. the winter solstice), with some *)
(* modifications by PJM. *)
(* *)
(* Latest modifications: *)
(* Precomputed scaling factors *)
(* Slight change in the way gains are *)
(* calculated *)
(* Integer rather than shortint wave tables *)
(* *)
(********************************************************)
(************************************************************************)
(* IMPLEMENTATION NOTES *)
(* *)
(* The work done by this module falls into two distinct phases. In the *)
(* first phase we are receiving data, in more-or-less standard musical *)
(* notation, from the caller for the three voices separately. We do *)
(* a little processing of this data, to simplify the job of the second *)
(* phase, but basically we are just storing the caller's data in three *)
(* big arrays. The amount of pre-processing we can do is limited by *)
(* the fact that full processing (to produce a result in the form of an *)
(* actual waveform) would require arrays that would overflow the *)
(* 64 Kbyte segment size limit. *)
(* *)
(* The second phase starts when procedure PlayTheMusic is called. We *)
(* handle this in the separate module Play3B. *)
(* *)
(************************************************************************)
FROM Storage IMPORT ALLOCATE, DEALLOCATE;
FROM Play3 IMPORT
(* const*) CycleCount,
(* type *) WaveNumber, EnvelopeNumber, EnvelopePtr,
EnvelopeArrayIndex, GainType, WaveGroup,
(* proc *) DefineWaveform, DefineEnvelope, Play;
FROM MATHLIB IMPORT
(* proc *) Sin;
(************************************************************************)
CONST
(* The constant LowestInterval is a scaling factor for note *)
(* frequencies. In the present we've set it rather arbitrarily. *)
(* It could be adjusted more precisely to give an A440 tuning or *)
(* similar, but so far I haven't done the necessary calculations. *)
LowestInterval = 4.375*LONGREAL(CycleCount);
irrelevantnote = 0; (* used when remembering last note *)
DefaultDuration = 200;
TYPE
ZeroToTwelve = SHORTCARD [0..12];
Octave = SHORTCARD [0..8];
Note = SHORTCARD [0..63];
CodeSubscript = [0..4000];
VAR
(* Waveform tables. *)
Wave: ARRAY WaveNumber OF WaveGroup;
(* NoteToIntervalMap takes a note code and translates it to the *)
(* step amount to be used in stepping through a WaveForm array. *)
NoteToIntervalMap: ARRAY Note OF CARDINAL;
(* NoteTable performs the mapping C -> 1, D -> 3, E -> 5, F -> 6, *)
(* etc. The gaps in this sequence are accounted for by sharps and *)
(* flats, which are handled elsewhere. *)
NoteTable: ARRAY ["A".."G"] OF ZeroToTwelve;
(* We define a number of different attack/decay envelopes. *)
EnvelopeData: ARRAY EnvelopeNumber OF
RECORD
Attack, Decay, Sustain: CARDINAL;
shapeptr: EnvelopePtr;
END (*RECORD*);
(* VoiceData keeps information about where we are up to in the *)
(* translation of each voice. It is needed because the caller *)
(* is allowed to specify a few notes for one voice, then a few *)
(* notes for a second voice, and then perhaps to switch back to *)
(* the first voice, etc. *)
VoiceData: ARRAY VoiceNumber OF
RECORD
position: CARDINAL;
LastDuration, NextDuration: CARDINAL;
CurrentOctave: Octave;
LastNote: ZeroToTwelve;
Enabled: BOOLEAN;
Code: ARRAY CodeSubscript OF CARDINAL;
END (*RECORD*);
(************************************************************************)
(* APPENDING DATA TO THE BUFFERS *)
(************************************************************************)
PROCEDURE DurationSetting (V: VoiceNumber; newduration: CARDINAL);
(* Sets a new absolute duration for voice V. *)
BEGIN
WITH VoiceData[V] DO
Code[position] := 65534; INC (position);
Code[position] := newduration; INC (position);
LastDuration := newduration;
NextDuration := newduration;
END (*WITH*);
END DurationSetting;
(************************************************************************)
PROCEDURE AddNote (V: VoiceNumber; note: Note; duration: CARDINAL);
(* Appends a new note to the stored data for voice V. *)
BEGIN
WITH VoiceData[V] DO
IF duration <> LastDuration THEN
DurationSetting (V, duration);
END (*IF*);
Code[position] := NoteToIntervalMap[note];
INC (position);
END (*WITH*);
END AddNote;
(************************************************************************)
(* INTERPRETING MUSICAL NOTATION *)
(************************************************************************)
PROCEDURE Translate (VAR (*IN*) notes: ARRAY OF CHAR;
VAR (*INOUT*) place: CARDINAL): ZeroToTwelve;
(* Translates a note code in the conventional notation (C,D,etc.), *)
(* as stored in notes[place], into the numeric code expected by *)
(* module Play3. Parameter place is updated, so that on return *)
(* notes[place] is the first character not yet processed. *)
VAR result: ZeroToTwelve;
BEGIN
IF notes[place] = "R" THEN
result := 0; INC (place);
ELSE
result := NoteTable[notes[place]];
INC (place);
IF place <= HIGH(notes) THEN
(* Check for sharp or flat. *)
IF notes[place] = "#" THEN
INC(result); INC(place);
ELSIF notes[place] = "b" THEN
DEC(result); INC(place);
END (*IF*);
END (*IF*);
END (*IF*);
RETURN result;
END Translate;
(************************************************************************)
PROCEDURE Convert (voice: VoiceNumber; notes: ARRAY OF CHAR);
(* Converts the notes specified in array "notes". The result is *)
(* appended to the global coded note data. *)
TYPE CharSet = SET OF CHAR;
CONST Digits = CharSet {'0'..'9'};
VAR inplace: CARDINAL;
CurrentDuration, factor: CARDINAL;
CurrentOctave: Octave;
note, LastNote: Note;
BEGIN
CurrentDuration := VoiceData[voice].NextDuration;
CurrentOctave := VoiceData[voice].CurrentOctave;
LastNote := VoiceData[voice].LastNote;
inplace := 0;
(* The following loop translates from letter codes in array *)
(* "notes" to numeric codes in array VoiceData[voice].Code. *)
REPEAT
IF notes[inplace] = " " THEN INC(inplace) (* ignore spaces *)
(* Check for duration changes. *)
ELSIF notes[inplace] = "*" THEN
INC(inplace);
factor := 2;
IF notes[inplace] IN Digits THEN
factor := ORD(notes[inplace]) - ORD("0");
INC (inplace);
END (*IF*);
CurrentDuration := CurrentDuration*factor;
ELSIF notes[inplace] = "/" THEN
INC(inplace);
factor := 2;
IF notes[inplace] IN Digits THEN
factor := ORD(notes[inplace]) - ORD("0");
INC (inplace);
END (*IF*);
CurrentDuration := CurrentDuration DIV factor;
ELSIF notes[inplace] = "3" THEN
CurrentDuration := CurrentDuration DIV 3;
INC(inplace);
(* Check for octave changes. *)
ELSIF notes[inplace] = "u" THEN
IF CurrentOctave < MAX(Octave) THEN
INC(CurrentOctave);
END (*IF*);
INC (inplace);
ELSIF notes[inplace] = "d" THEN
IF CurrentOctave > 0 THEN DEC(CurrentOctave) END(*IF*);
INC (inplace);
ELSE
(* We have a note to translate. *)
(* N.B. procedure Translate updates inplace. *)
note := Translate (notes, inplace);
IF note = 0 THEN
AddNote (voice, 0, CurrentDuration);
ELSE
(* We now have the note in the form of a *)
(* ZeroToTwelve code, but we still have to decide *)
(* the octave. The criterion we use is to minimise *)
(* the distance from the last note played. This *)
(* can be overridden by the "u" and "d" codes. *)
IF LastNote <> irrelevantnote THEN
IF INTEGER(note)-INTEGER(LastNote) > 6 THEN
IF CurrentOctave > 0 THEN
DEC(CurrentOctave);
END(*IF*);
ELSIF INTEGER(LastNote) - INTEGER(note) > 6 THEN
IF CurrentOctave < MAX(Octave) THEN
INC(CurrentOctave)
END (*IF*);
END (*IF*);
END (*IF*);
LastNote := note;
AddNote (voice, VAL(Note, 12*CurrentOctave + note),
CurrentDuration);
END (*IF*);
END (*IF*);
UNTIL (inplace > HIGH(notes)) OR (notes[inplace] = CHR(0));
VoiceData[voice].NextDuration := CurrentDuration;
VoiceData[voice].CurrentOctave := CurrentOctave;
VoiceData[voice].LastNote := LastNote;
END Convert;
(************************************************************************)
PROCEDURE Voice1 (notes: ARRAY OF CHAR);
(* Appends more notes to Voice #1. *)
BEGIN
IF VoiceData[1].Enabled THEN
Convert (1, notes);
END (*IF*);
END Voice1;
(************************************************************************)
PROCEDURE Voice2 (notes: ARRAY OF CHAR);
(* Appends more notes to Voice #2. *)
BEGIN
IF VoiceData[2].Enabled THEN
Convert (2, notes);
END (*IF*);
END Voice2;
(************************************************************************)
PROCEDURE Voice3 (notes: ARRAY OF CHAR);
(* Appends more notes to Voice #3. *)
BEGIN
IF VoiceData[3].Enabled THEN
Convert (3, notes);
END (*IF*);
END Voice3;
(************************************************************************)
PROCEDURE EnableVoice (V: VoiceNumber; enable: BOOLEAN);
(* If enable is FALSE then the following data for voice V are *)
(* ignored. (This is for testing, when you want to suppress a *)
(* voice in order to listen to the others more closely.) The *)
(* default condition is that all voices are enabled. *)
BEGIN
VoiceData[V].Enabled := enable;
END EnableVoice;
(************************************************************************)
PROCEDURE SetWaveform (V: VoiceNumber; N: WaveformNumber);
(* Changes the waveform for voice V. *)
BEGIN
WITH VoiceData[V] DO
Code[position] := 65532; INC (position);
Code[position] := N; INC (position);
END (*WITH*);
END SetWaveform;
(************************************************************************)
(* ENVELOPE CALCULATIONS *)
(************************************************************************)
PROCEDURE EnvelopeModel0 (p: EnvelopePtr; Attack, Decay, Sustain: LONGREAL);
(* Calculates the envelope array using an attack/decay/sustain model.*)
CONST scaletogain = LONGREAL(MAX(GainType));
VAR level: LONGREAL;
phase: [0..1]; j: EnvelopeArrayIndex;
BEGIN
Decay := 1.0 - Decay;
phase := 0; level := 0.0;
FOR j := 0 TO MAX(EnvelopeArrayIndex) DO
IF phase = 0 THEN
(* Attack phase: ramp up linearly to maximum. *)
level := level + Attack;
IF level > 1.0 THEN
level := 1.0; INC(phase);
END(*IF*);
ELSE
(* Decay phase: we're using an exponential decay. *)
level := Sustain + Decay*(level - Sustain);
END (*IF*);
p^[j] := VAL(GainType, scaletogain*level);
END (*FOR*);
END EnvelopeModel0;
(************************************************************************)
PROCEDURE CreateEnvelope (attack, decay, sustain: CARDINAL): EnvelopeNumber;
(* Returns the envelope number corresponding to the parameters, if *)
(* such an envelope already exists; or creates a new envelope and *)
(* returns its number. *)
CONST scale = 1.0/LONGREAL(MAX(CARDINAL));
VAR E: EnvelopeNumber;
(********************************************************************)
PROCEDURE Match (E: EnvelopeNumber;
attack, decay, sustain: CARDINAL): BOOLEAN;
(* Returns TRUE iff envelope number E matches the parameters. *)
BEGIN
WITH EnvelopeData[E] DO
RETURN (Attack = attack) AND (Decay = decay)
AND (Sustain = sustain);
END (*WITH*);
END Match;
(********************************************************************)
BEGIN
E := 0;
LOOP
IF EnvelopeData[E].shapeptr = NIL THEN EXIT(*LOOP*)
ELSIF Match (E, attack, decay, sustain) THEN RETURN E
ELSIF E < MAX(EnvelopeNumber) THEN INC(E)
ELSE
(* We've run out of envelopes, steam an old one open. *)
DISPOSE(EnvelopeData[E].shapeptr);
EXIT(*LOOP*);
END(*IF*);
END (*LOOP*);
(* If we reach this point, then we haven't found a match with *)
(* an existing envelope and have to create a new one. *)
(* This section is still experimental. *)
WITH EnvelopeData[E] DO
Attack := attack; Decay := decay; Sustain := sustain;
NEW (shapeptr);
EnvelopeModel0 (shapeptr, scale*LONGREAL(attack),
scale*LONGREAL(decay), scale*LONGREAL(sustain));
DefineEnvelope (E, shapeptr);
END (*WITH*);
RETURN E;
END CreateEnvelope;
(************************************************************************)
PROCEDURE SetEnvelope (V: VoiceNumber; attack, decay, sustain: CARDINAL);
(* Use this to simulate different instruments. Parameters attack *)
(* and decay are in effect rates of change. The sustain parameter *)
(* is a steady-state amplitude (range [0..65535]) after the *)
(* "decay" phase. *)
VAR E: EnvelopeNumber;
BEGIN
E := CreateEnvelope (attack, decay, sustain);
WITH VoiceData[V] DO
Code[position] := 65531; INC (position);
Code[position] := E; INC (position);
END (*WITH*);
END SetEnvelope;
(************************************************************************)
PROCEDURE SetInstrument (N: WaveformNumber;
attack, decay, sustain: CARDINAL);
(* Like SetEnvelope and SetWaveform, but affects all voices. *)
VAR V: VoiceNumber;
BEGIN
FOR V := 1 TO MAX(VoiceNumber) DO
SetWaveform (V, N);
SetEnvelope (V, attack, decay, sustain);
END (*FOR*);
END SetInstrument;
(************************************************************************)
PROCEDURE SetDuration (value: CARDINAL);
(* Sets the duration for the following notes (all voices). *)
VAR V: VoiceNumber;
BEGIN
FOR V := 1 TO MAX(VoiceNumber) DO
DurationSetting (V, value);
END (*FOR*);
END SetDuration;
(************************************************************************)
PROCEDURE PlayTheMusic;
(* Plays the music that has been stored so far. *)
VAR V: VoiceNumber;
BEGIN
FOR V := 1 TO MAX(VoiceNumber) DO
WITH VoiceData[V] DO
Code[position] := 65535;
END (*WITH*);
END (*FOR*);
Play (VoiceData[1].Code, VoiceData[2].Code, VoiceData[3].Code);
END PlayTheMusic;
(************************************************************************)
(* MODULE INITIALISATION *)
(************************************************************************)
PROCEDURE Initialise;
(* Sets the initial duration and octave, and sets up the tables *)
(* for translating from music notation to the output codes. *)
CONST
PI = 3.141592653589793240;
freqstep = 1.057298094605; (* 2^(1/12) *)
offset = LONGREAL(128*CycleCount-1) / 3.0;
bound = 2.0*offset; (* limit on peak-to-peak value *)
VAR step, scale: LONGREAL;
j, break: SHORTCARD; note: Note;
voice: VoiceNumber; w: WaveNumber; E: EnvelopeNumber;
Gain: ARRAY GainType OF LONGREAL;
g: GainType;
(********************************************************************)
PROCEDURE WaveValue (w: WaveNumber; pos: BYTE; val: LONGREAL);
(* Is passed the value for maximum sound, fills in the tables *)
(* with all the scaled values. *)
VAR g: GainType;
BEGIN
FOR g := 0 TO MAX(GainType) DO
Wave[w][g]^[pos] := VAL(INTEGER, val*Gain[g]);
END;
END WaveValue;
(********************************************************************)
BEGIN
FOR g := 0 TO MAX(GainType) DO
Gain[g] := LONGREAL(g)/LONGREAL(MAX(GainType));
FOR w := 0 TO HIGH(Wave) DO
NEW (Wave[w][g]);
END (*FOR*);
END (*FOR*);
(* NoteTable translates from letter codes into a numeric code *)
(* consistent with a well-tempered tuning. *)
NoteTable["C"] := 1; NoteTable["D"] := 3;
NoteTable["E"] := 5; NoteTable["F"] := 6;
NoteTable["G"] := 8; NoteTable["A"] := 10;
NoteTable["B"] := 12;
(* Create the note-to-interval map. *)
step := LowestInterval;
NoteToIntervalMap[0] := 0;
FOR note := 1 TO MAX(Note) DO
NoteToIntervalMap[note] := VAL(CARDINAL, step);
step := step*freqstep;
END (*FOR*);
(* Create the waveform arrays. *)
(* Waveform #0: sine wave. *)
(* Waveform #1: sine wave + 3rd harmonic. *)
FOR j := 0 TO 255 DO
WaveValue (0, j, 0.5*bound*Sin(VAL(LONGREAL,j)*PI/128.0));
WaveValue (1, j, 0.56*bound*(Sin(VAL(LONGREAL,j)*PI/128.0)
+ 0.18*Sin(3.0*VAL(LONGREAL,j)*PI/128.0)));
END (*FOR*);
(* Waveforms #2, 3, 4: rectangular waves. *)
FOR w := 2 TO 4 DO
break := 56*SHORTCARD(w) + 16;
FOR j := 0 TO break-1 DO
WaveValue (w, j, offset);
END (*FOR*);
FOR j := break TO 255 DO
WaveValue (w, j, -offset);
END (*FOR*);
END (*FOR*);
(* Waveforms #5, 6, 7: triangular waves. *)
FOR w := 5 TO 6 DO
break := VAL(SHORTCARD, 64*w - 192);
scale := bound/LONGREAL(break);
FOR j := 0 TO break-1 DO
WaveValue (w,j, scale*LONGREAL(j)-offset);
END (*FOR*);
scale := bound/LONGREAL(256-CARDINAL(break));
FOR j := break TO 255 DO
WaveValue (w, j, scale*LONGREAL(256-CARDINAL(j))-offset);
END (*FOR*);
END (*FOR*);
FOR j := 0 TO 255 DO
WaveValue (7, j, bound*LONGREAL(j)/256.0-offset);
END (*FOR*);
(* Pass the waveforms to the subsidiary module. *)
FOR w := 0 TO MAX(WaveNumber) DO
DefineWaveform (w, Wave[w]);
END (*FOR*);
(* Initialise the EnvelopeData array. *)
FOR E := 0 TO MAX(EnvelopeNumber) DO
WITH EnvelopeData[E] DO
Attack := 0; Decay := 0; Sustain := 0;
shapeptr := NIL;
END (*WITH*);
END (*FOR*);
(* Set initial conditions for the voice data. *)
FOR voice := 1 TO MAX(VoiceNumber) DO
WITH VoiceData[voice] DO
position := 0;
LastDuration := DefaultDuration;
NextDuration := DefaultDuration;
CurrentOctave := 3;
LastNote := irrelevantnote;
Enabled := TRUE;
END (*WITH*);
END (*FOR*);
END Initialise;
(************************************************************************)
BEGIN
Initialise;
END Music3.