Program Samples; { Expands a macro file to a Csound .sco file including samples }

{
All tag names: & . ; @ C D E F G H I L M N O P R S T U V W Z
Next Modification
- Fix forever the erasure of samples that are actually needed. The routine that upsamples and downsamples screws it up.
- Set up a push/pop mechanism.
~tt0 pushes the current value for t, and then sets t to a new value
^t sets t to the previously pushed value of t.
Decisions: Should the stack be a common stack for all values, or one for each of velocity,
tone, octave, etc?
Last Modified 7/31/02
- Find a way to determine the tempo for the start time fix from 4/10/01.

Last Modified 7/30/02
- Put an additional check on velocity to make sure it doesn't wrap around to 255, 253, and blow eardrums again.
- It should kick in at anything over 200, but seems to do so at 100

Last Modified 1/1/02
- Allow adjustment to the cent value by an amount in the McGill.dat file
CentsTable := CentsTable + ' 0 '; - this is the old way. Assumes they are all in tune. -

Last Modified 12/7/01
- Put in a check on the length of the macro contents to limit it to 230 bytes

Last modified 11/10/01
- Allow for sequential random choices: allow for the selection not of the same random choice,
but the next one in the series, with wrap around. Distinguish between p32: always the
same, and p33, always the next in the series, and p34, always the previous in the series.

Last modified 4/10/01
- Fixed the upsample so that it would not stray into another instrument. Still not very good,
but better than it used to be.
Allow the start time to be reduced to account for some samples not starting at time zero, especially
those that have an attack transient that is interesting, but does not represent the start of the beat.
This still needs work. See MoveForward, and TimeFactor.

Last modified 10/24/00
- Create a new variable (u for upsample) which will be used to select a different
sample instead of the one that would be selected based on note. u1 selects the
next higher sample. u0 selects the normally selected sample. u255 selects
the next lower sample. Need to change the routine that checks if a sample is
needed to remember that up sampling can take place.
Last modified 10/22/00
- Create a new variable (g for glissando) which will be used to specify a
function table that will be multiplied by the frequency of the note, to create
step functions, glissando, slides from notes to notes, etc. The variable will
point to one function table. f0 points to a flat fuction table that won't change
each note.
Last modified 10/11/00
- List non-referenced macros after the reference count.
- Create a new variable (z?) which slightly perturbs the rhythm by a small amount
For example: z1 will change all the durations from integers to slightly out of
synch start times. Instead of 256, it will start at a random number between 255.75
and 256.25. z10 will set the perturbation to a random number between 255.1 and 256.9.
z0 resets it to no perturbation. z100 will perturb up to ten beats plus or minus.
- Allow random seed to be taken from a file, making the same random pattern each
time.
Last modified 9/27/2000
- Allow the user to influence the likelihood of repeating the same
selected macro a second time, or never repeating it until all the
possible choices have been selected. Employ a new variable: p,
which if set to 8 makes the selection of macro the same as it is
today. If p is greater than 8, the likelihood of repeating the
same macro as previous choice becomes higher. If p is 16, it
always repeats the previous choice, non-randomly.

Enhanced 10/18/2001 to increase this to 32

If p is less than 8, the likelihood of repeating is lower, until
it reaches 0, when the program will always select any other choice
if one is available, random round robin style. The goal is for low
numbers to select a different macro, and for high numbers to tend
to repeat the same macro. The farther from 8, the more extreme the
tendency.

This will require two new variables to store with each macro:
- LastChosen: Boolean; which is set to true when a macro is
selected. All other possible macros must have this set to false
when one is chosen.
- ChosenTimes: Integer; Initially set to 0, is incremented each
time a macro is chosen. This is used to determine which one to
select next. When p is low, the lowest number not LastChosen
will be picked.

Example:
.macro1 &C.
.macro2 &E.
.macro3 &G.
.macro4 &A++.
p0&macro*. &macro*. &macro*. &macro*. &macro*. &macro*.
@ should produce:
@&C. &G. &A++. &E. &G. &C. &A++. &E. &C. &E. &A++. &G.
p16&macro*. &macro*. &macro*. &macro*. &macro*. &macro*.
@ should produce:
@&C. &C. &C. &C. &G. &G. &G. &G. &G. &G. &A++. &A++.

- LastChosen: Boolean; which is set to true when a macro is
- ChosenTimes: Integer; Initially set to 0, is incremented each
Last modified 7/8/2000
enhancements:
- n0f1 - use the first function table - removed 3/16/04
- n0i1 - use instrument #1 in the mwsynth.ini file - remove 3/16/04
- Allow the phrase n1i10 to be used for both MWSYNTH.INI use and also to
refer to instruments already defined in comments. n0i10 for channel 0
play sample file starting at function table 11. How to switch from the
MWSYNTH.INI interpretation of this as instrument 10 to function table 11?
Run time switch? Another switch in the file? A different letter from i,
for example f? F is currently a comment line, but there is no real
reason for it. Make is a function table start line, and use it to
write the voice number (parameter 7).
- Allow a tag to indicate slurred notes, with no retriggering
and modify the instrument to accept this. Set this by a new
instrument that supports two note, three note, four note slurs.
Tag name: W for warped, bent notes.
- if the W value is non-zero, this sets the amount the second note
should play, the value of p12. How to create one line for both notes is
left as an exercise for the programmer.....
Use instrument number 2 (i2) instead of i1 to use the slurred instrument.
Instrument 2 expects extra parms for the second ton,oct,dur
How to indicate in the score that you want the second note to be
a continuation of the first is a non-zero W value, e.g.:
c0v90d32t0o5r16s8 t8w8
Instead of writing this out as two lines, make one line from it.
How to anticipate that the second line is warped?
Input will look like this:
c0v90d32t0o5r16s8w8 t8
The first note will need to know that the second note is to be warped
to. You will know that the next note is a warp note, but not
what it will warp to.
Method:
1. List the first note now, but don't Writeln, just Write.
On second pass, finish the writeln
Requirements:
1. Must write both notes to instrument #2
2. Can only support two notes in slur - what to do when there are
3 or more? Error message? For wimps!

- Print the input file with all macros expanded. - done - printed to xref.txt file
- Print a report of all macros as saved, and as first used for debuging
purposes. - done - printed to xref.txt file
- Allow for other than 53 tones per octave for non-Csound version. - later.
}
uses dos,crt; {, crt Standard Turbo Units }

Const
MaxEqual = 100; { Tones per octave }
MaxChans = 128 - 1; { channels 0 to 127 }
SampleFilesPerIns = 60; { Really only need 10-20 }
McGillSamples = 400; { Getting close? }
MaxMacroLength = 230; { Needs to be 250 to run cuenta14 }

Type
{ VisNoteType is not used, as far as I can tell }
VisNoteType = Record
Name: String[3]; { C, C+,C++,C#,C##,Dbb,Db,D--,D-,D etc }
TwelveTone:Byte; { 0 to 12, closest 12 tone note }
Cents:Byte; { 7 bit 2's complement -64 to +64 }
Interval: String[5]; { ' 3:2 ','11:10', etc. ' ', if none }
end;
AudNotePtr = ^AudNoteType;
AudNoteType = Record
Octave: Byte; { 0..11 }
ToneInScale: Byte; { 0..MaxEqual }
Velocity: Byte; { Loudness 0..127, if over 200, set it to zero 7/29/02 - changed to 200 9/12/03 }
Rand: Byte; { Random chance that note will play 0 - 16 }
Stereo: Byte; { Stereo 0 left 15 right }
Perturb: Byte; { 0 is no change, 100 is 100 plus or minus }
Glisand: Byte; { 0 is flat, 1-10 are tables }
Upsample: Byte; { 0 is normal, 1 is next higher, 255 is next lower }
Envelope: Byte; { Pick an Envelope Function Table 0 to 100 }
Duration: Integer; { 0..32767 }
HoldDuration: Integer; { 0..32767 }
WarpDuration: Integer; { 0..32767 }
{ Next: AudNotePtr; }
Next: LongInt; { file position, not a pointer any more }
end;
ChannelType = Record
{ First: AudNotePtr; } { Points to first note in channel }
{ Current: AudNotePtr; } { Points to first note in channel }
First: Longint; { points to a record location in the file }
Current: Longint; { Last written spot }
StartTime: LongInt; { Sum of Durations }
Instrument: Byte; { 1 to 129 named instruments }
FunctionTable: Byte; { unique function table set }
end;
InstrumentType = Record
FileName: String[12]; { trump69.wav }
WavePitch: Integer; { 69 }
DetuneCents: Integer; { etc }
Velocity: Integer;
MinimumNote: Integer;
MaximumNote: Integer;
MinVel: Integer;
MaxVel: Integer;
StartLoop: Integer;
EndLoop: Integer;
SustainEnv: Integer;
ReleaseEnv: Integer;
end;
McGillSampleType = Record
FunctionTableNum: Integer; { Which sample set is this for }
BaseNote: Integer;
Channel: Byte;
FTable: String[60];
Used: Boolean;
MoveForward: Single; { how many beats to subtract from start time }
end;
MacroPtr = ^MacroType;
MacroType = Record
Name: String[17];
Content: String[MaxMacroLength];
LastChosen: Boolean;
ChosenTimes: Integer;
Next: MacroPtr;
end;
EndType = Record
ToneInScale: Byte;
Octave: Byte;
Channel: Byte;
end;
Var
OldMethod: Boolean;
Channels: Array[0..MaxChans] of ChannelType;
LowChannel,HighChannel:Byte;
{ AudNote: AudNotePtr; }
AudNote: AudNoteType;
AudNoteFile: File of AudNoteType;
ChannelFile: File of ChannelType;
{ VisNote: Array[0..MaxEqual] of VisNoteType; }
InstrumentDesc: Array[0..SampleFilesPerIns] of InstrumentType;
McGillDesc: Array[0..McGillSamples] of McGillSampleType;
McGillDescIndex: Integer;
InstrumentName: String[20]; { e.g. [Trumpet] }
Music,Sco,McGill,Xref: Text;
FuncCode: Boolean;
{ Warped: Boolean; }
TimeFactor: Single;
st,Input: String;
Cha,Ran,Oct,Env,Ton,Vel: Integer;
MaxDuration: LongInt;
MaxTableSlot,MaxFunctionNumber: Integer;
FunctionTableNumber: Integer;
StartOfFunctionTable, MonoStereoAkaiTable: String;
Root: Byte;
Ste: Byte;
Dur: Integer;
Hol: Integer;
War: Integer;
Pat: Byte;
Ban,Num,Ins,Per,Gli,Ups: Byte;
{ NoteFile: File of VisNoteType; }
Tempo1: Byte;
Tempo2: Byte;
TotalNotes: LongInt;
TotalMacros: Integer;
Xpos,Ypos: Byte;
MacroList:Record
First: MacroPtr;
Current: MacroPtr;
end;
SaveForEnd: EndType;
DelayKeyPress: Integer;

(*{$i DectoHex.Inc }*)

Procedure Init;

var I,Io: Integer;

Begin
Assign(Xref,'Xref.txt');
{$i-}
ReWrite(Xref); { open for Writing }
{$i+}
Io := Ioresult;
If Io <> 0 then
Begin
Writeln('Attempt to Create Xref file failed. Io = ',io);
Writeln('File was called Xref.txt');
Halt(Io);
end;
{Writeln('In Init');}
Writeln('Total memory avail: ',MemAvail:8,MaxAvail:8);
For i := 0 to MaxChans do
Begin
{ Channels[i].First := Nil; }{ Make all channels empty }
Channels[i].First := -1;
Channels[i].Instrument := 0;
Channels[i].FunctionTable := 0;
end;
for i := 0 to McGillSamples do McGillDesc[i].Used := False;
MaxFunctionNumber := 26;
FunctionTableNumber := 4;
StartOfFunctionTable := 'f1 0 16 -2 0 '; { locations of start of function tables }
MonoStereoAkaiTable := 'f2 0 16 -2 0'; { 4= akai sample points }
McGillDescIndex := 0;
MaxDuration := 0;
MacroList.First := Nil;
MacroList.Current := Nil;
DelayKeyPress := 0;
Root := 43;
TotalNotes := 0;
TotalMacros := 0;
Cha := 0; { channel }
Oct := 3; { octave }
Env := 0; { envelope to use 0 = 197, 1 = 196, 2 = 195 etc. }
Ton := 0; { tone in scale }
Vel := 0; { velocity or volume }
Ran := 16; { random play or silence }
Ste := 8; { stereo placement }
Hol := 0; { hold note for how long }
War := 0; { slide from one note to another - not used any more }
Pat := 8; { 8 is standard random wild card parse; <8 is less repeat >8 is mostly repeat }
Per := 0; { default is no perturbation }
Gli := 0; { default is no glissando }
Ups := 0; { default is no up sample }
OldMethod := ParamStr(3) = '1997';
{ Warped := False; }
Tempo1 := 1;
Tempo2 := 30;
LowChannel := MaxChans;
HighChannel := 0;
Assign(Music,ParamStr(1));
{$i-}
ReSet(Music); { open for reading }
{$i+}
Io := Ioresult;
If Io <> 0 then
Begin
Writeln('Attempt to Find music file failed. Io = ',io);
Writeln('File was called ',ParamStr(1));
Halt(Io);
end;
Assign(Sco,ParamStr(2));
{$i-}
ReWrite(Sco); { open for Writing }
{$i+}
Io := Ioresult;
If Io <> 0 then
Begin
Writeln('Attempt to Create Sco file failed. Io = ',io);
Writeln('File was called ',ParamStr(2));
Halt(Io);
end;
Assign(McGill,'McGill.dat');
{$i-}
ReSet(McGill); { open for reading }
{$i+}
Io := Ioresult;
If Io <> 0 then
Begin
Writeln('Attempt to Find McGill Sample Description file. Io = ',io);
Writeln('File was called McGill.dat');
Halt(Io);
end;
Assign(AudNoteFile,'Notes.fil');
{$i-}
ReWrite(AudNoteFile);
{$i+}
Io := Ioresult;
If Io <> 0 then
Begin
Writeln('Attempt to create AudNoteFile failed. Io = ',io);
Writeln('File was called Notes.fil');
Halt(Io);
end;
Assign(ChannelFile,'Chann.fil');
{$i-}
ReWrite(ChannelFile);
{$i+}
Io := Ioresult;
If Io <> 0 then
Begin
Writeln('Attempt to create ChannelFile failed. Io = ',io);
Writeln('File was called Chann.fil');
Halt(Io);
end;
{ set the 2000 to the beats per minute factor in the file. Someday read it from the file. later }
TimeFactor := 1 / 2000 * 2646000; { 2000 beats per minute }
TimeFactor := 1 / 480 * 2646000; { 480 beats per minute }
TimeFactor := 1 / 5200 * 2646000; { 5200 beats per minute - time factor ~ 50 }
Writeln('TimeFactor: ',TimeFactor);
end; { Init }

Procedure ExpandMcGill(Channel,Ins: Byte);

var
FoundIns: Boolean;
i: integer;

Procedure ParseMcGill(Ins,FtabNum: Byte);

var
Found: Boolean;
RangeTable, FunctionTable, CentsTable, LoopTable: String;
TopOfRangeBaseNumber,FunctionTableName,InstrumentNumber,TableNumber: String;
BaseNumber,Code,Io,j: Integer;
SampleOffset: Integer;

Begin
Found := False;
{$i-}
ReSet(McGill); { open for reading }
{$i+}
Io := Ioresult;
If Io <> 0 then
Begin
Writeln('Could not find "McGill.dat" in current Directory. Io = ',io);
Halt(Io);
end;
Str(Ins:3,InstrumentNumber);
Repeat
Readln(McGill,Input);
Found := (Copy(Input,1,3) = InstrumentNumber);
Until Eof(McGill) or (Found);
If Not Found then
Begin
Writeln('Could not find instrument #',Ins:4,' in McGill.dat');
Halt(4);
end
Else
Begin { Found the lines referring to the instrument }
FunctionTableNumber := FunctionTableNumber + 1;
Str(FunctionTableNumber,TableNumber); { Start with 5 }
StartOfFunctionTable := StartOfFunctionTable + TableNumber + ' ';
If Copy(Input,6,1) = '1' then { if this field has a one it's mono, two it's stereo }
MonoStereoAkaiTable := MonoStereoAkaiTable + ' 4 ' { 4 is mono 5 is stereo }
Else MonoStereoAkaiTable := MonoStereoAkaiTable + ' 5 ';{ 4 is mono 5 is stereo }
{ Note that some percussion ensembles have a mix of mono and stereo in the same directory }
RangeTable := 'f' + TableNumber + ' 0 128 -17 0 ';
FunctionTableNumber := FunctionTableNumber + 1;
Str(FunctionTableNumber,TableNumber);
FunctionTable := 'f' + TableNumber + ' 0 32 -2 0 ';
FunctionTableNumber := FunctionTableNumber + 1;
Str(FunctionTableNumber,TableNumber);
CentsTable := 'f' + TableNumber + ' 0 32 -2 0 ';
FunctionTableNumber := FunctionTableNumber + 1;
Str(FunctionTableNumber,TableNumber);
LoopTable := 'f' + TableNumber + ' 0 32 -2 0 ';
Repeat { write the name of the sample file name for each sample }
FunctionTableNumber := FunctionTableNumber + 1;
{ Store the Function table number in the McGillDesc.FunctionTableNum field }
Str(FunctionTableNumber,FunctionTableName);
McGillDesc[McGillDescIndex].FTable := Copy(Input,23,255);
{ moved from 19 to 23 1/1/02 for CentsTable }
{ moved from 14 to 19 3/31/01 for MoveForward }
Val(Copy(Input,8,3),BaseNumber,Code);
If Code <> 0 then
Begin
Writeln('Invalid base number for instrument sample. Sample name: "',Input,'"');
Halt(4);
end;
Str(BaseNumber+1,TopOfRangeBaseNumber); { Should be average of this and next number }
RangeTable := RangeTable + FunctionTableName + ' ' + TopOfRangeBaseNumber + ' ';
FunctionTable := FunctionTable + Copy(Input,8,3) + ' '; { BaseNumber 55,57,59 etc. }
CentsTable := CentsTable + Copy(Input,19,4); { Read cent adjustment from McGill 1/1/02 }
{ CentsTable := CentsTable + ' 0 '; Assume the samples are in tune. Oh Really? 1/1/02 looking here }
LoopTable := LoopTable + Copy(Input,12,1) + ' ';
McGillDesc[McGillDescIndex].FunctionTableNum := FunctionTableNumber;
If FunctionTableNumber > 280 then
Begin
Writeln('Too many instruments. Attempt to set FunctionTableNumber > 280');
Halt(5);
end;
Val(Copy(Input,14,4),SampleOffset,Code); { 3/31/01 for MoveForward }
If Code <> 0 then
Begin
Writeln('Invalid sample offset for instrument sample. Sample name: "',Input,'"');
Halt(4);
end;
{ SampleOffset is an integer count of the number of samples before the real start of the note.
All else is leading sound }
McGillDesc[McGillDescIndex].MoveForward := SampleOffset / TimeFactor; { 3/31/01 for MoveForward }
{ MoveForward is a single precision count of beats, based on TimeFactor (2000 for now) }
McGillDesc[McGillDescIndex].BaseNote := BaseNumber;
{ ########## }
McGillDesc[McGillDescIndex].Channel := FTabNum;
{ ########## }
McGillDescIndex := McGillDescIndex + 1;
If McGillDescIndex > McGillSamples then
Begin
Writeln('Too many samples to handle. Max is ',McGillSamples);
Halt(5);
end;
Repeat
Readln(McGill,Input); { look out for comment lines }
Until (Copy(Input,1,1) <> ';') or (eof (McGill));
Found := (Copy(Input,1,3) = InstrumentNumber);
Until (Not Found) or (Eof(McGill));
For j := Length(RangeTable)-1 downto 1 do
If RangeTable[j] = ' ' then
Begin { fix the last number. It must be 127, not 1+base }
RangeTable := Copy(RangeTable,1,j) + '127';
j := 1;
end;
Writeln(Sco,RangeTable); { need to modify the last entry }
Writeln(Sco,FunctionTable);
Writeln(Sco,CentsTable);
Writeln(Sco,LoopTable);
end;
end; { ParseMcGill }

Begin { ExpandMcGill }
{ Find out if there have been any other requests for this instrument # }
MaxTableSlot := 0;
FoundIns := False;
i := 0;
While (i < MaxChans) and (Not FoundIns) do
Begin
DelayKeyPress := DelayKeyPress + 1;
If DelayKeyPress > 20000 then
Begin
If KeyPressed then Halt(1);
DelayKeyPress := 0;
end;
if Channels[i].FunctionTable > MaxTableSlot then
MaxTableSlot := Channels[i].FunctionTable;
if Channels[i].Instrument = Ins then
Begin
FoundIns := True;
Channels[Channel].FunctionTable := Channels[i].FunctionTable;
end;
i := i + 1;
end;
Channels[Channel].Instrument := Ins;
If (Not FoundIns) then
Begin
{ must now build the .sco function tables for this note }
Channels[Channel].FunctionTable := MaxTableSlot+1;
ParseMcGill(Ins,Channels[Channel].FunctionTable);
end;
end; { ExpandMcGill }

Procedure LoadValues(Channel,Oct,ToneInScale,Vel,Ran,Ste,Env,Per,Gli,Ups: Byte; Dur,Hol,War:Integer);

Var
WhereAreWe: Longint;
TempNote: AudNoteType;

Begin
DelayKeyPress := DelayKeyPress + 1;
If DelayKeyPress > 20000 then
Begin
If KeyPressed then Halt(1);
DelayKeyPress := 0;
end;
If Channel < LowChannel then LowChannel := Channel;
If Channel > HighChannel then HighChannel := Channel;
TotalNotes := TotalNotes + 1;
If (TotalNotes mod 1000 = 0) or (TotalNotes = 1) then
Writeln('Created note ',TotalNotes:6);
WhereAreWe := FileSize(AudNoteFile); { new note always goes at the end }
If Channels[Channel].First = -1 then Channels[Channel].First := WhereAreWe
else
Begin
Seek(AudNoteFile,Channels[Channel].Current);
Read(AudNoteFile,TempNote);
TempNote.Next := WhereAreWe; { currently at the end of the file }
Seek(AudNoteFile,Channels[Channel].Current);
Write(AudNoteFile,TempNote);
end;
{ Need to find the current one, and update its next pointer }
AudNote.Octave := Oct;
AudNote.ToneInScale := ToneInScale;
AudNote.Velocity := Vel;
AudNote.Rand := Ran;
AudNote.Stereo := Ste;
AudNote.Envelope := Env;
AudNote.Duration := Dur;
AudNote.HoldDuration := Hol;
AudNote.WarpDuration := War;
AudNote.Perturb := Per;
AudNote.Glisand := Gli;
AudNote.Upsample := Ups;
AudNote.Next := -1;
Seek(AudNoteFile,WhereAreWe);
Write(AudNoteFile,AudNote); { Store this note in notes.fil at the next available position }
Channels[Channel].Current := WhereAreWe; { Where are we in the file }
end; { LoadValues }

Procedure ReadValues(Var Input:String);

var
i: byte;

Begin
Readln(Music,Input);
Input := Input + ' ';
i := 1;
Repeat
If Copy(Input,i,2) = ' ' then Delete(Input,i,1)
else i := i + 1;
Until (i = Length(Input));
end; {ReadValues}

Procedure ParseValues(Input:String);

Var
St: String;
InputPos: Byte;
Notes : Boolean;

Procedure StoreMacro(MacroName,Content:String);

Var
Macro: MacroPtr;
Found: Boolean;
Current: MacroPtr;
LeadingBlanks: Boolean;

Begin
Repeat
LeadingBlanks := Copy(Content,1,1) = ' ';
If LeadingBlanks then Content := Copy(Content,2,Length(Content));
Until (Not LeadingBlanks);
Current := MacroList.First;
While (Current^.Name <> MacroName) and (Current <> Nil) do
Current := Current^.Next;
If Current = Nil then
Begin
If MemAvail > 255 then New(Macro)
Else
Begin
Writeln('Ran out of room in 640k limit for another macro');
Writeln('Created ',TotalMacros,' macros');
Writeln('No room for Macro named "',MacroName,'"');
Writeln('Contents: "',Content,'"');
Halt(1);
end;
TotalMacros := TotalMacros + 1;
If (TotalMacros mod 500 = 0) or (TotalMacros = 1) then
Writeln('Created macro ',TotalMacros:6,MemAvail:8,MaxAvail:8);
If MacroList.First = Nil then MacroList.First := Macro
else MacroList.Current^.Next := Macro;
Macro^.Name := MacroName;
Macro^.Content := Content;
Macro^.LastChosen := False;
Macro^.ChosenTimes := 0;
Macro^.Next := Nil;
MacroList.Current := Macro;
end
Else Current^.Content := Content; { replace the contents of the existing macro }
end; { StoreMacro }

Procedure DefineMacro(MacroName:String);

{ This procedure is passed the line following the . in a macro
definition. The Procedure then stores everything following
the macro name itself in the contents of the macro.
e.g. '.melody t+0 t+10 t+10', would store
't+0 t+10 t+10' in the macro melody }

Var
i: Byte;
Blank: Boolean;
Content: String;

Begin
Blank := False;
i := 0;
Repeat
i := i + 1;
If Copy(MacroName,i,1) = ' ' then Blank := True;
Until (i = Length(MacroName)) or Blank;
Content := Copy(MacroName,i+1,Length(MacroName));
If Blank then MacroName := Copy(MacroName,1,i-1)
Else
Begin
Writeln('Invalid macro. Name too long, "',MacroName,'"');
Halt(2); { quit the bat file }
end;
StoreMacro(MacroName,Content);
InputPos := Length(Input);
end; { DefineMacro }

Procedure ExpandMacro(MacroName:String);

Var
i,j : Byte;
Blank: Boolean;
Name: String;
Current: MacroPtr;
PotentialContents: Array [0..100] of MacroPtr;
PotentialIndex: Byte;
ChosenIndex, Least: Byte;
FixedPortion: String;
Done: Boolean;

Function Asterisk(Name: String):Boolean;

Var
i: Byte;

Begin
Asterisk := Name[Length(Name)] = '*';
end; { Asterisk }

Begin { ExpandMacro }
{ Find out how long macro is }
Blank := False;
i := 0;
{ This section does a very poor job of error handling. There has to be a
better way to handle a missing dot at the end of macro name }
Repeat
i := i + 1;
If (Copy(MacroName,i,1) = ' ') or (Copy(MacroName,i,1) = '.')
then Blank := True;
Until (i = Length(MacroName)) or Blank;
If Blank then
Begin
InputPos := InputPos + i;
Name := Copy(MacroName,1,i-1);
end
Else
Begin
Writeln('A Macro near the one Named "',Name,
'" did not terminate in a dot as it should have, ',
'or it was over 248 characters long');
Writeln('Processing line containing:');
Writeln('"',Input,'"');
Halt(3); { quit the bat file }
end;
{ Find the macro name in the list of macro names }
{ See if the macro ends with an asterisk, which would indicate that
the name could be one of any that meet a set of criteria }
Current := MacroList.First;
If Asterisk(Name) then
Begin
PotentialIndex := 0;
FixedPortion := Copy(Name,1,Length(Name)-1); { drop the asterisk }
Done := False;
Repeat { examine every macro to see if it is one of the ones to use here }
While (Copy(Current^.Name,1,Length(FixedPortion)) <> FixedPortion) and
(Current <> Nil) do Current := Current^.Next; { do the first letters match?}
If Current = Nil then Done := True
Else
Begin { store this macro address in an array of potential macros }
PotentialContents[PotentialIndex] := Current;
PotentialIndex := PotentialIndex + 1;
If PotentialIndex = 100 then
Begin
Writeln('Too many similar macros');
Writeln('Macro called "',Name,'"');
Halt(1);
end;
Current := Current^.Next;
end;
Until (Done);
If PotentialIndex > 0 then
Begin
{ current method returns any random element that satisfies wild card search }
{ pick a random number from zero to one less than the number of potential choices }
{ Writeln(Name,' Pat = ',Pat,' PotentialIndex = ',PotentialIndex); }
If Pat = 8 then ChosenIndex := Random(PotentialIndex)
Else if Pat = 0 then
Begin { pick least chosen macro in the list of potential candidates. }
Least := Random(PotentialIndex); { Start with a random pull }
For j := 0 to PotentialIndex - 1 do { swap if another is least used }
If PotentialContents[j]^.ChosenTimes <
PotentialContents[Least]^.ChosenTimes then Least := j;
ChosenIndex := Least; { save the result }
end
Else if Pat = 32 then
Begin { repeat the last one chosen, not random }
j := 0;
While (j < PotentialIndex) and not (PotentialContents[j]^.LastChosen) do
j := j + 1;
If j = PotentialIndex then ChosenIndex := Random(PotentialIndex)
else ChosenIndex := j;
end
Else if Pat = 33 then
Begin { pick the next one in the series, not random }
j := 0;
While (j < PotentialIndex) and not (PotentialContents[j]^.LastChosen) do
j := j + 1;
If j = PotentialIndex then
Begin
j := Random(PotentialIndex);
ChosenIndex := j;
end
else if j+1 = PotentialIndex then
Begin
j := 0;
ChosenIndex := j;
end
else
Begin
j := j + 1;
ChosenIndex := j;
end;
end
Else if Pat = 34 then
Begin { pick the previous one in the series, not random }
j := 0;
While (j < PotentialIndex) and not (PotentialContents[j]^.LastChosen) do
j := j + 1;
If j = PotentialIndex then
Begin
j := Random(PotentialIndex);
ChosenIndex := j;
end
else if j <> 0 then
Begin
j := j - 1;
ChosenIndex := j;
end
else
Begin
j := PotentialIndex - 1;
ChosenIndex := j;
end;
end
Else if Pat < 8 then
Begin { try to not pick the same one you picked for this macro last time }
j := 8;
Repeat
ChosenIndex := Random(PotentialIndex);
j := j - 1;
Until (j < Pat) or (Not PotentialContents[ChosenIndex]^.LastChosen) or (j=0);
end
Else
Begin { Pat > 8 then try to pick the same one you picked for this macro last time }
j := 8;
Repeat
ChosenIndex := Random(PotentialIndex);
j := j + 1; { if not the same, try one more time }
Until (j > Pat) or PotentialContents[ChosenIndex]^.LastChosen;
end;
For j := 0 to PotentialIndex do
PotentialContents[j]^.LastChosen := (ChosenIndex = j);
PotentialContents[ChosenIndex]^.ChosenTimes :=
PotentialContents[ChosenIndex]^.ChosenTimes + 1;
ParseValues(PotentialContents[ChosenIndex]^.Content)
end
Else
Begin
Writeln('Wild Card Macro Not Found. Name = "',Name,'"');
Halt(3); { quit the bat file }
end
end
Else
Begin { Not asterisk }
While (Current^.Name <> Name) and (Current <> Nil) do
Current := Current^.Next;
If Current = Nil then
Begin
Writeln('Macro Not Found. Name = "',Name,'"');
Halt(3); { quit the bat file }
end
Else
Begin { found the macro in the list of macros }
{ Pass the contents of the macro as if it just regular values in the file }
Current^.ChosenTimes := Current^.ChosenTimes + 1;
Current^.LastChosen := True; { do you want to set this even if it is chosen explicitly? }
ParseValues(Current^.Content);
end;
end;
end; { ExpandMacro }

Function Extract(Value: Integer;Chars:String):Integer;

Var
Temp,Code: Integer;
ValStr: String;

Function Parens(Chars: String): String;

Var
i: Integer;
x,y,z: Integer;
More: Boolean;
Fact: String[1];
Result: String;
Code, Code2, Code3: Integer;

Begin
i := 0;
More := False;
Repeat
i := i + 1;
If Copy(Chars,i,1) = '(' then More := True;
Until (i = Length(Chars)) or More;
If More then
Begin
Result := Parens(Copy(Chars,i+1,Length(Chars)-1));
Chars := Copy(Chars,1,i-1) + Result;
end;
Val(Chars, x, Code);
if Code = 0 then z := x
else
Begin
Fact := Copy(Chars,Code,1);
Val(Copy(Chars,1,Code - 1),x,Code2);
Val(Copy(Chars,Code + 1,Length(Chars)-Code),y,Code2);
If Code2 <> 0 then
Val(Copy(Chars,Code + 1,Code2-1),y,Code2);
Case Ord(Fact[1]) of
Ord('+'): z := x + y;
Ord('-'): z := x - y;
Ord('*'): z := x * y;
Ord('/'): z := x div y;
Else
Begin
Writeln('Invalid factor. "',Fact,'"');
Halt(3);
end
end;
end;
Str(z,Result);
Parens := Result;
end; { Parens }

Begin { Extract }
Str(Value,ValStr);
Case Ord(Chars[1]) of
Ord('('): Val(Parens(Copy(Chars,2,Length(Chars)-1)),Temp,Code);
Ord('+'),Ord('-'),Ord('*'),Ord('/'):
Chars := Parens(ValStr + Chars[1] + Copy(Chars,2,Length(Chars)));
end;
Val(Chars, Temp, Code);
if Code = 0 then Temp := Temp
Else if Code > 1 then Val(Copy(Chars,1,Code-1),Temp,Code)
Else Temp := 0;
Extract := Temp;
end; { Extract }

Begin { ParseValues }
{ Oct,ToneInScale,Vel,Dur,Hol,Ran,Ste,Env,War }
Notes := False;
InputPos := 1;
While InputPos < Length(Input)+1 do
Begin
Case Ord(Upcase(Input[InputPos])) of
Ord('@'): InputPos := Length(Input); { Comment Line }
Ord(';'): Begin
InputPos := Length(Input); { Comment Line From Csound }
Writeln(sco,Input);
end;
Ord('F'): Begin
Ins := Extract(Ins,Copy(Input,InputPos+1,7)); { Voice }
{BuiltInFunctionTable(Num,Ins);} { removed 3/16/04 }
InputPos := Length(Input);
end;
Ord('E'): Begin
Env := Extract(Env,Copy(Input,InputPos+1,7)); { Envelope }
If (Env > 100) then Env := 0;
Notes := True;
end;
Ord('N'): Begin
Num := Extract(Num,Copy(Input,InputPos+1,7)); { Channel number}
end;
Ord('I'): Begin
Ins := Extract(Ins,Copy(Input,InputPos+1,7)); { Voice }
{ ExpandInstrument(Num,Ins); } { Removed this code 3/16/04 to save RAM }
InputPos := Length(Input);
end;
Ord('M'): Begin
Ins := Extract(Ins,Copy(Input,InputPos+1,7)); { Voice }
ExpandMcGill(Num,Ins);
InputPos := Length(Input);
end;
Ord('L'): Begin { Literal }
InputPos := Length(Input); { Pass it to Csound }
Writeln(sco,Copy(Input,2,Length(Input)-1));
end;
Ord('C'): Begin { Channel }
Cha := Extract(Cha,Copy(Input,InputPos+1,7));
If (Cha > MaxChans) then Cha := 0;
Notes := True;
end;
Ord('O'): Begin { Octave }
Oct := Extract(Oct,Copy(Input,InputPos+1,7));
If (Oct > 15) then Oct := 0;
Notes := True;
end;
Ord('T'): Begin { Tone in scale }
Ton := Extract(Ton,Copy(Input,InputPos+1,7));
If (Ton >= Root) then
Begin
Ton := Ton - Root;
Oct := Oct + 1;
end
Else if (Ton < 0) then
Begin
Ton := Root + Ton;
Oct := Oct - 1;
end;
Notes := True;
end;
Ord('V'): Begin { Velocity, Volume }
Vel := Extract(Vel,Copy(Input,InputPos+1,7));
If (Vel > 200) then Vel := 0; { changed to 200 9/13/03 }
Notes := True;
end;
Ord('R'): Begin { Random chance of hearing }
Ran := Extract(Ran,Copy(Input,InputPos+1,7));
if Ran > 16 then Ran := 16
else if Ran < 0 then Ran := 0;
Notes := True;
end;
Ord('S'): Begin { Stereo location: s = 0 left 8 = middle 15 = right }
Ste := Extract(Ste,Copy(Input,InputPos+1,7));
If Ste > 16 then Ste := 0
Else if Ste = 0 then Ste := 15;
Notes := True;
end;
Ord('D'): Begin { Duration of note }
Dur := Extract(Dur,Copy(Input,InputPos+1,7));
Notes := True;
end;
Ord('Z'): Begin { perterb start time }
Per := Extract(Per,Copy(Input,InputPos+1,7));
Notes := True;
end;
Ord(' '): Begin { Store the previous note for later performance }
If Notes then
LoadValues(Cha,Oct,Ton,Vel,Ran,Ste,Env,Per,Gli,Ups,Dur,Hol,War);
end;
Ord('.'): DefineMacro(Copy(Input,InputPos+1, { define macro }
Length(Input)-(InputPos + 1)));
Ord('&'): Begin { execute macro }
ExpandMacro(Copy(Input,InputPos+1,16));
Notes := True;
end;
Ord('H'): Begin { Hold note for duration }
Hol := Extract(Hol,Copy(Input,InputPos+1,7));
Notes := True;
end;
Ord('W'): Begin { Warp to next note }
War := Extract(War,Copy(Input,InputPos+1,7));
Notes := True;
end;
Ord('P'): Begin { random algorithm }
Pat := Extract(Pat,Copy(Input,InputPos+1,7));
Notes := True;
end;
Ord('G'): Begin { glissando }
Gli := Extract(Gli,Copy(Input,InputPos+1,7));
Notes := True;
end;
Ord('U'): Begin { upsample }
Ups := Extract(Ups,Copy(Input,InputPos+1,7));
Notes := True;
end;
end; { Case }
InputPos := InputPos + 1;
end; { Begin }
end; { ParseValues }

Procedure ShowNotes;

Var
i: Byte;
OldTime,NewTime,Delta: Integer;
TempVel: Byte;
MaxTime: LongInt;
TempAudNote: AudNoteType;
RealStart: Real;
UnMatchedTimes: Boolean;
SampleIndex: Integer;
FoundSample, FoundFunctionTable: Boolean;
CheckF: integer;

Function AllChannelsDone: Boolean;

Var
i: Byte;
Done: Boolean;

Begin
Done := True;
i := LowChannel;
While (i < HighChannel + 1) and (Done) do
Begin
If Channels[i].Current <> -1 then Done := False;
i := i + 1;
end;
AllChannelsDone := Done;
end; { AllChannelsDone }

Begin { ShowNotes }
If FunctionTableNumber > 4 then
Begin
Writeln(Sco,StartOfFunctionTable);
Writeln(Sco,MonoStereoAkaiTable);
end;
Writeln(sco,';Inst Start Dur Vel Ton Oct ',
' Voice Stere Envlp Gliss Upsamp;Channel');
MaxTime := 0;
For i := LowChannel to HighChannel do
Begin
Channels[i].Current := Channels[i].First;
Channels[i].StartTime := 0;
end;
For i := LowChannel to HighChannel do
Begin
With Channels[i] do
Repeat
If (Current <> -1) then
Begin
Seek(AudNoteFile,Current);
Read(AudNoteFile,TempAudNote);
With TempAudNote do
Begin
{ e.g if Rand = 1, then very unlikely to play it }
{ if Rand = 16, then always play it }
If Random(16) < Rand then
TempVel := Velocity
Else TempVel := 0;
If TempVel > 200 then TempVel := 0; { fixed 9/13/03 to make 200 }
If HoldDuration = 0 then HoldDuration := Duration;
if TempVel > 0 then
Begin { If not zero velocity, play the note }
{ Find out what sample is being used here, then see if the start time needs adjusting }
SampleIndex := 0;
FoundSample := False;
FoundFunctionTable := False;
CheckF := Trunc(Octave * 12 + ((ToneInScale/43)*12)); { find midi note number nearest this one }
Repeat { until found or all samples examined }
If McGillDesc[SampleIndex].Channel = FunctionTable then { found the channel }
Begin { Now figure out which sample is for this note } { need to ensure sample exists }
FoundFunctionTable := True;
If McGillDesc[SampleIndex].BaseNote >= CheckF then
Begin { Function table is needed }
if UpSample > 128 then
Begin { Down sample. This means a lower instrument note will be raised farther }
{- makes a sharper sound }
SampleIndex := SampleIndex + (UpSample - 256);
While McGillDesc[SampleIndex].Channel <> FunctionTable do
SampleIndex := SampleIndex + 1;
end
Else
Begin { Up sample. A higher instrument note will be lowered farther }
{ - makes a mellower sound }
SampleIndex := SampleIndex + UpSample;
While McGillDesc[SampleIndex].Channel <> FunctionTable do
SampleIndex := SampleIndex - 1;
end;
FoundSample := True;
end; { This particular Function Table is needed }
end; { Found the channel, now figure out which sample is for this note }
SampleIndex := SampleIndex + 1;
Until (FoundSample) or (SampleIndex = McGillDescIndex-1) or
((McGillDesc[SampleIndex].Channel <> FunctionTable) and FoundFunctionTable);
RealStart := StartTime + Perturb/16-Perturb*Random/8 - McGillDesc[SampleIndex-1].MoveForward;
{ Should I add the time to the beginning and also make the duration longer to compensate? }
{ Not for now }
{ HoldDuration := HoldDuration + Round(McGillDesc[SampleIndex-1].MoveForward); }
If RealStart < 0 then RealStart := 0;
if OldMethod then
Writeln(sco,'i1 ', RealStart:13:10,
HoldDuration:6, TempVel:6,ToneInScale:6,
Octave:6,FunctionTable:6,Stereo:6,
Envelope:6,Glisand:6,Upsample:6,' ; ', i:6)
Else
Writeln(sco,'i1 ', RealStart:13:10,
HoldDuration:6, TempVel:6,ToneInScale:6,
Octave:6,Instrument:6,Stereo:6,
Envelope:6,Glisand:6,Upsample:6,' ; ', i:6);
end;
StartTime := StartTime + Duration;
If StartTime > MaxDuration then MaxDuration := StartTime;
end;
Current := TempAudNote.Next; { where are we in the file }
end;
Until (Current = -1);
if Channels[i].StartTime > MaxTime then MaxTime := Channels[i].StartTime;
end; { For i := LowChannel to HighChannel do }
{ only needed for reverb unit }
Writeln(sco,'i99 0 ',MaxDuration+32,' 1.5'); { reverb instrument commented out 9-21-01 }
Writeln(sco,'</CsScore>');
Writeln(sco,'</CsoundSynthesizer>');
Writeln('Last StartTime = ',MaxTime:6);
UnMatchedTimes := False;
For i := LowChannel to HighChannel do
If Channels[i].StartTime <> 0 then
If Channels[i].StartTime <> MaxTime then
UnMatchedTimes := True;
If UnMatchedTimes then
For i := LowChannel to HighChannel do
Writeln('Channel ',i:4,' Last start time was ',Channels[i].StartTime:7);
end; { ShowNotes }

Procedure PlayNotes;

Var
i: Byte;
Ch: Char;
OldTime,NewTime,Delta: Integer;
Current: MacroPtr;
Io: Integer;

Function AllChannelsDone: Boolean;

Var
i: Byte;
Done: Boolean;

Begin
Done := True;
i := LowChannel;
While (i < HighChannel + 1) and (Done) do
Begin
If Channels[i].Current <> -1 then Done := False;
i := i + 1;
end;
AllChannelsDone := Done;
end; { AllChannelsDone }

Begin { PlayNotes }
Writeln(Xref,'Name LastCh ChosenT Content');
Current := MacroList.First;
While (Current <> Nil) do
Begin
with Current^ do if ChosenTimes > 0 then
If Length(Name) < 8 then
Writeln(Xref,Name,Chr(09),Chr(09),LastChosen:5,' ',
ChosenTimes:6,' "',Content,'"')
Else
Writeln(Xref,Name,Chr(09),LastChosen:5,' ',
ChosenTimes:6,' "',Content,'"');
Current := Current^.Next;
end;
Current := MacroList.First;
Writeln(Xref,'The following macros were never referenced in this pass of the program');
While (Current <> Nil) do
Begin
with Current^ do if ChosenTimes = 0 then
If Length(Name) < 8 then
Writeln(Xref,Name,Chr(09),Chr(09),'"',Content,'"')
else
Writeln(Xref,Name,Chr(09),'"',Content,'"');
Current := Current^.Next;
end;
Close(Xref);
end; { PlayNotes }

Procedure WriteSampleFiles;

var
SampleIndex: Integer;
FoundSample, FoundFunctionTable: Boolean;
i,CheckF: integer;
TempAudNote: AudNoteType;

Begin
For i := LowChannel to HighChannel do Channels[i].Current := Channels[i].First;
For i := LowChannel to HighChannel do
Begin
Write(ChannelFile,Channels[i]);
With Channels[i] do
Repeat { for every channel }
If (Current <> -1) then
Begin { if you're not at the end of the channel }
Seek(AudNoteFile,Current);
Read(AudNoteFile,TempAudNote);
With TempAudNote do
Begin { look at this note }
{ Check all the sample files to see if they are needed to play this note }
SampleIndex := 0;
FoundSample := False;
FoundFunctionTable := False;
CheckF := Trunc(Octave * 12 + ((ToneInScale/43)*12)); { find midi note number nearest this one }
Repeat { until found or all samples examined }
If McGillDesc[SampleIndex].Channel = FunctionTable then { found the channel, see if this sample }
Begin
{ 4/1/01 Trying to fix this so that up or down sampling does not change the instrument }
FoundFunctionTable := True;
If McGillDesc[SampleIndex].BaseNote >= CheckF then
Begin { Function table is needed }
if UpSample > 128 then
Begin { Down sample. This means a lower instrument note will be raised farther }
SampleIndex := SampleIndex + (UpSample - 256);
While McGillDesc[SampleIndex].Channel <> FunctionTable do
SampleIndex := SampleIndex + 1;
end
Else
Begin { Up sample. A higher instrument note will be lowered farther }
SampleIndex := SampleIndex + UpSample;
While McGillDesc[SampleIndex].Channel <> FunctionTable do
SampleIndex := SampleIndex - 1;
end;
McGillDesc[SampleIndex].Used := True;
FoundSample := True;
end; { if this function table is needed }
end; { Found the channel }
SampleIndex := SampleIndex + 1;
Until (FoundSample) or (SampleIndex = McGillDescIndex-1) or
((McGillDesc[SampleIndex].Channel <> FunctionTable) and FoundFunctionTable);
If ((McGillDesc[SampleIndex].Channel <> FunctionTable) and FoundFunctionTable) then
McGillDesc[SampleIndex-1].Used := True;
If SampleIndex = McGillDescIndex-1 then
McGillDesc[SampleIndex].Used := True;
{ 2/13/04 hard code so samples are always used regardless of notes called for - }
{ temporary fix - doesn't work very well }
McGillDesc[SampleIndex].Used := True;
end; { with Current^ do }
Current := TempAudNote.Next; { where are we in the file }
end;
Until (Current = -1);
end;
For SampleIndex := 0 to McGillDescIndex-1 do
If McGillDesc[SampleIndex].Used then with McGillDesc[SampleIndex] do
Writeln(sco,'f',McGillDesc[SampleIndex].FunctionTableNum,' 0 0 1 "',
McGillDesc[SampleIndex].FTable,
'" 0 4 0');
{ Else
Writeln(sco,';f',McGillDesc[SampleIndex].FunctionTableNum,' 0 0 1 "',
McGillDesc[SampleIndex].FTable,
'" 0 4 0')
}
end; { WriteSampleFiles }

Begin
Writeln;
Randomize;
Xpos := WhereX; Ypos := WhereY;
Init;
{ Begin a string of notes to play }
{ stat mfgid subst node }
Repeat
ReadValues(Input);
ParseValues(Input);
Until Eof(Music);
WriteSampleFiles;
ShowNotes;
PlayNotes;
Close(Music);
Close(sco);
Close(AudNoteFile);
Close(ChannelFile);
end.