(* profile ..\..\..\tc.pro *) (*{$B-} {Boolean complete evaluation off}*) {$S+} {Stack checking on} {$I-} {I/O checking off} {$M 65520,16384,655360} {Turbo 3 default stack and heap} Program Samples; { Expands a macro file to a Csound .sco file including samples } { Fix required: the randomization setting has no effect 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 3/29/07 - Added the A and F parameters. A is the current overall amplitude. It is used to crescendo and decrescendo all instruments at the same time. I suppose it should be better to have a different amplitude for each instrument. Later. For now, it is useful to control the overall amplitude of the piece, and allow a gradual change of volume over many notes. F is to pass the line as is to the output file. Last Modified 5/27/04 - Allow for an additional parameter, envelope2 for the second side of the envelope. Used to implement doppler shift - New variable takes the place of warp, which was the old way to do bent notes. w = envelope for right channel - If w = 0 then w = e, so they both have the same envelope. 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. g0 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¯o*. ¯o*. ¯o*. ¯o*. ¯o*. ¯o*. @ should produce: @&C. &G. &A++. &E. &G. &C. &A++. &E. &C. &E. &A++. &G. p16¯o*. ¯o*. ¯o*. ¯o*. ¯o*. ¯o*. @ 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. - reused for second envelope 5/27/04 - 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. Ported to Free Pascal 7/22/12 - mostly just making sure we never reference Nil Pointers or exceed array bounds. Rearrange some While loops to check the Pointer = Nil prior to the other check. And is sequential } 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 = 250; { Getting close? } MaxMacroLength = 230; { Needs to be 250 to run cuenta14 } MaxMacroNameLength = 23; { } 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: Integer; { 0 is flat, 1-500 are tables } Upsample: Byte; { 0 is normal, 1 is next higher, 255 is next lower } Envelope: Byte; { Pick an Envelope Function Table 0 to 255 } Duration: Integer; { 0..32767 } HoldDuration: Integer; { 0..32767 } WarEnvelope: Byte; { 0..255 } LyricNumber: Byte; {0..50} NowVolume: Byte; {0..255} NowTempo: Integer; {0..32k} { 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 } NumSamples: Byte; { this was added 4/9/12 to make sure upsample didn't go outside sample range } 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 } SampleNumber: Byte; { relative number of this sample in the set } end; MacroPtr = ^MacroType; MacroType = Record Name: String[MaxMacroNameLength]; Content: String[MaxMacroLength]; LastChosen: Boolean; ChosenTimes: Integer; Next: MacroPtr; end; EndType = Record ToneInScale: Byte; Octave: Byte; Channel: Byte; end; Var { 236 } Ovv : Byte; Ntp : Integer; OldMethod: Boolean; AutoOctaveShift: 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, McGillRelativeNum: Integer; (* InstrumentName: String[20]; { e.g. [Trumpet] } *) Music,Sco,Ovf,McGill,Xref: Text; { Warped: Boolean; } TimeFactor: Single; Input: String; Cha,Ran,Oct,Env,Ton,Vel: Integer; MaxDuration: LongInt; MaxTableSlot: Integer; FunctionTableNumber: Integer; StartOfFunctionTable, MonoStereoAkaiTable: String; Root: Byte; Ste: Byte; Dur: Integer; Hol: Integer; War: Integer; Pat: Byte; Num,Ins,Per,Ups,Lyr: Byte; Gli: Integer; { NoteFile: File of VisNoteType; } TotalNotes: LongInt; TotalMacros: Integer; MacroList:Record First: MacroPtr; Current: MacroPtr; end; DelayKeyPress: Integer; SampleCount: Byte; (*{$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,MaxAvail Not available in Free Pascal');} 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 Begin McGillDesc[i].Used := False; McGillDesc[i].SampleNumber := 0; End; FunctionTableNumber := 4; StartOfFunctionTable := 'f1 0 64 -2 0 '; { locations of start of function tables } MonoStereoAkaiTable := 'f2 0 64 -2 0'; { 4= akai sample points } McGillDescIndex := 0; McGillRelativeNum := 0; MaxDuration := 0; MacroList.First := Nil; MacroList.Current := Nil; DelayKeyPress := 0; 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 } Lyr := 0; { LyricNumber } Ovv := 0; { overall volume level } Ntp := 0; { overall Tempo level } Vel := 0; { velocity or volume } Ran := 16; { random play or silence } Ste := 8; { stereo placement } Hol := 0; { hold note for how long } War := 0; { Right Channel Envelope - if 0 then same as Env } 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(4) = '1997'; OldMethod := True; AutoOctaveShift := ParamStr(4) = '2014'; Writeln('AutoOctaveShift = ',AutoOctaveShift); Val(Copy(ParamStr(5),1,3),Root,Io); If Io <> 0 then Root := 72; { Warped := False; } 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(Ovf,ParamStr(3)); {$i-} ReWrite(Ovf); { open for Writing } {$i+} Io := Ioresult; If Io <> 0 then Begin Writeln('Attempt to Create Ovf file failed. Io = ',io); Writeln('File was called ',ParamStr(3)); 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: 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 first of several lines referring to the instrument } SampleCount := 0; 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); { 11/24/05 - increased the number of samples per instrument to 64 } FunctionTable := 'f' + TableNumber + ' 0 64 -2 0 '; FunctionTableNumber := FunctionTableNumber + 1; Str(FunctionTableNumber,TableNumber); CentsTable := 'f' + TableNumber + ' 0 64 -2 0 '; FunctionTableNumber := FunctionTableNumber + 1; Str(FunctionTableNumber,TableNumber); LoopTable := 'f' + TableNumber + ' 0 64 -2 0 '; McGillRelativeNum := 0; Repeat { write the name of the sample file name for each sample } FunctionTableNumber := FunctionTableNumber + 1; SampleCount := SampleCount + 1; { Store the Function table number in the McGillDesc.FunctionTableNum field } Str(FunctionTableNumber,FunctionTableName); McGillDesc[McGillDescIndex].FTable := Copy(Input,23,255); { file name of this sample } { 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; { 4-9-12 find the lowest and highest base notes in the sample set } If FunctionTableNumber > 300 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 stores the relative sample in all sets. } McGillRelativeNum := McGillRelativeNum + 1; McGillDesc[McGillDescIndex].SampleNumber := McGillRelativeNum; {Writeln(xref,'McGillDesc[',McGillDescIndex,'].SampleNumber = ',McGillDesc[McGillDescIndex].SampleNumber);} 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 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; { if the first channel is 40, why is the second lowsample set to 36? } Channels[Channel].NumSamples := Channels[i].NumSamples; {Writeln(xref,'Copy from another instrument. Channels[',Channel, '].NumSamples = ',Channels[Channel].NumSamples);} 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); Channels[Channel].NumSamples := SampleCount; {Writeln(xref,'Channels[',Channel,'].NumSamples = ',Channels[Channel].NumSamples);} end; end; { ExpandMcGill } { 3-23-12 extended glissando to an integer value } {Procedure LoadValues(Channel,Oct,ToneInScale,Vel,Ran,Ste,Env,Per,Gli,Ups,Ovv: Byte; Ntp,Dur,Hol,War,Lyr:Integer);} Procedure LoadValues(Channel,Oct,ToneInScale,Vel,Ran,Ste,Env,Per,Ups,Ovv: Byte; Ntp,Dur,Hol,War,Lyr,Gli: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.WarEnvelope := War; AudNote.LyricNumber := Lyr; AudNote.NowVolume := Ovv; AudNote.NowTempo := Ntp; 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); {Writeln(xref,' 1 2 3 4 5 6 7 8');} {Writeln(xref,'12345678901234567890123456789012345678901234567890123456789012345678901234567890');} {Writeln(xref,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 InputPos: Byte; Notes : Boolean; Procedure StoreMacro(MacroName,Content:String); Var Macro: MacroPtr; {Found: Boolean;} Current: MacroPtr; LeadingBlanks: Boolean; Begin {Writeln('In StoreMacro. MacroName = "',MacroName,'" Content = "',Content,'"');} Repeat LeadingBlanks := Copy(Content,1,1) = ' '; If LeadingBlanks then Content := Copy(Content,2,Length(Content)); Until (Not LeadingBlanks); {Writeln('About to set Current := MacroList.First');} { the next line is what triggers the error 216.} { Free Pascal does not permit referencing variables with Nil addresses } { You must be sure the variable is not Nil before referencing it } Current := MacroList.First; {Writeln('Current = Nil is ',Current=Nil);} { See if this Macro is already in the current list of Macros } If Current <> Nil then While (Current <> Nil) and (Current^.Name <> MacroName) do Current := Current^.Next; If Current = Nil then Begin {Writeln('Current = Nil. About to call New(Macro).');} New (Macro); TotalMacros := TotalMacros + 1; If (TotalMacros mod 500 = 0) or (TotalMacros = 1) then Writeln('Created macro ',TotalMacros:6); If MacroList.First = Nil then MacroList.First := Macro else MacroList.Current^.Next := Macro; Macro^.Name := MacroName; { Check first to make sure it will fit } If Length(Content) > MaxMacroLength then Begin Writeln('Macro named "',MacroName,'" is too long'); Writeln(' Trucating "',Content,'"'); Writeln('Only room for "',Copy(Content,1,MaxMacroLength),'"'); Writeln(Length(Content),' > ',MaxMacroLength); Halt(1); end; 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 space after the macro name as 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 {Writeln('In DefineMacro. MacroName = "',MacroName,'"');} Blank := False; i := 0; Repeat i := i + 1; If Copy(MacroName,i,1) = ' ' then Blank := True; Until (i = Length(MacroName)) or Blank; {Writeln('Blank = ',Blank,' i = ',i,' MacroName = "',MacroName,'"');} {Writeln('i+1 = ',i+1,' length(MacroName) = ',Length(MacroName));} Content := Copy(MacroName,i+1,Length(MacroName)); {Writeln('Content = "',Content,'"');} 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; {Writeln('In DefineMacro. About to store macro named "',MacroName,'" with content: "',Content,'"');} StoreMacro(MacroName,Content); InputPos := Length(Input); end; { DefineMacro } Procedure ExpandMacro(MacroName:String); Var i,j : Byte; BlankOrDot: Boolean; PreDeAmpLen, PostDeAmpLen: Byte; Name: String; Current: MacroPtr; PotentialContents: Array [0..100] of MacroPtr; PotentialIndex: Byte; ChosenIndex, Least: Byte; FixedPortion: String; Done: Boolean; { Passed a string with some number of ampersand macros, expands them inside out to return final string } Function DeAmpersand(Name: String): String; Var i,AmpersandLoc,DotLoc: Byte; Ampersand,Dot: Boolean; PreAmp, MacroName, PostDot: String[MaxMacroNameLength]; Temp: String[MaxMacroNameLength]; Begin { If you discover a dot before you find an ampersand, you've found a normal macro. } { If you find a ampersand before a dot, this is a macro within a marco } i := 0; Ampersand := False; Dot := False; Repeat i := i + 1; Ampersand := (Copy(Name,i,1) = '&'); Dot := (Copy(Name,i,1) = '.'); If Dot then DotLoc := i; Until (i = Length(Name)) or Ampersand; AmpersandLoc := i; i := 0; Dot := False; Repeat i := i + 1; Dot := (Copy(Name,i,1) = '.'); Until (i = Length(Name)) or Dot; If Dot then DotLoc := i Else DotLoc := 0; If AmpersandLoc < DotLoc then Begin (* Writeln('found an Ampersand at ',AmpersandLoc,' and a Dot at ',DotLoc); *) PreAmp := Copy(Name,1,AmpersandLoc-1); MacroName := Copy(Name,AmpersandLoc+1,DotLoc-(AmpersandLoc+1)); PostDot := Copy(Name,DotLoc+1,Length(Name)-DotLoc); (* Writeln('Preamp = "',PreAmp,'" MacroName = "',MacroName,'" PostDot = "',PostDot,'"'); *) { Need to reset current to first element in the linked list } Current := MacroList.First; While (Current <> Nil) and (Current^.Name <> MacroName) do Current := Current^.Next; If Current = Nil then Begin Writeln('Macro Not Found. Name = "',MacroName,'"'); Halt(3); { quit the bat file } end Else Begin { found the macro in the list of macros } { Keep track of how often it has been called } Current^.ChosenTimes := Current^.ChosenTimes + 1; Current^.LastChosen := True; { do you want to set this even if it is chosen explicitly? I guess so. } { Pass the contents of the macro as if it just regular values in the file } Temp := PreAmp + Current^.Content + PostDot; end; {Writeln('Passing Temp = "',Temp,'" to DeAmpersand');} Name := DeAmpersand(Temp); {Writeln('Back from passing Temp to DeAmpersand. Name = "',Name,'"');} end; DeAmpersand := Name; end; {DeAmpersand} Function Asterisk(Name: String):Boolean; { returns true if it ends in an asterisk } Begin Asterisk := Name[Length(Name)] = '*'; end; { Asterisk } Begin { ExpandMacro } { Find out how long macro is } { leading first ampersand has already been stripped off } { store the length of the whole MacroName before being DeAmpersanded } PreDeAmpLen := Length(MacroName); (* Writeln('In ExpandMacro with MacroName = "',MacroName,'" InputPos = ',InputPos); Writeln('Before DeAmpersand MacroName = "',MacroName,'"'); *) MacroName := DeAmpersand(MacroName); { resolve a macro within a macro } PostDeAmpLen := Length(MacroName); (* Writeln('After DeAmpersand MacroName = "',MacroName,'"'); *) BlankOrDot := 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 BlankOrDot := True; Until (i = Length(MacroName)) or BlankOrDot; If BlankOrDot then Begin { need to make sure we advance InputPos by the right length. } { It should advance by the number of bytes before its internal macros are resolved } InputPos := InputPos + i +(PreDeAmpLen - PostDeAmpLen); 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, ', 'or the name was over ',MaxMacroNameLength,' long ', 'or there is a missing x at the end of a redirect macro' ); Writeln('Processing line containing:'); Writeln('"',Input,'"'); Halt(3); { quit the bat file } end; { At this point Name consists of the macro with leading ampersand and the trailing dot stripped off. } { If there was an ampersand inside the name it has been resolved by now } { Name has been altered to be the resolved name with no internal ampersands left } { 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 many that match up to the asterisk } {Writeln(Xref,'InputPos = ',InputPos);} Current := MacroList.First; If Asterisk(Name) then Begin PotentialIndex := 0; FixedPortion := Copy(Name,1,Length(Name)-1); { drop the asterisk from the end } Done := False; Repeat { examine every macro to find all the ones that match } While (Current <> Nil) and (Copy(Current^.Name,1,Length(FixedPortion)) <> FixedPortion) do Current := Current^.Next; { do the letters up to the asterisk 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 = 200 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(xref,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 = 35 then Begin { Markov Drunkard's Walk: Either the next or the previous } If Random(2) = 0 then Begin { Get the next one in the list } 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 Begin { Get the previous one in the list } 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 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); (* Writeln(Xref,'ChosenIndex=',ChosenIndex,' j = ',j,' PotentialIndex = ',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; {Writeln('PotentialIndex = ',PotentialIndex);} { Remember if you chose it this time } For j := 0 to PotentialIndex-1 do Begin (* Writeln(xref,'line 1005. j = ',j); Writeln(xref,'PotentialContents[',j,'].LastChosen = ', PotentialContents[j]^.LastChosen); *) { Free Pascal has trouble with the next line. Perhaps we need to test if it's pointing to Nil. } PotentialContents[j]^.LastChosen := (ChosenIndex = j); end; PotentialContents[ChosenIndex]^.ChosenTimes := PotentialContents[ChosenIndex]^.ChosenTimes + 1; (* Writeln(Xref,'PotentialContents[ChosenIndex]^.Content = "', PotentialContents[ChosenIndex]^.Content,'"'); *) ParseValues(PotentialContents[ChosenIndex]^.Content) end Else Begin { for some reason, wild card macros are never reported as missing, just go runtime error 216 } Writeln('Wild Card Macro Not Found. Name = "',Name,'"'); Halt(3); { quit the bat file } end end Else Begin { Not asterisk } {Writeln('looking for macro "',Name,'"');} While (Current <> Nil) and (Current^.Name <> Name) 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 } { Keep track of how often it has been called } Current^.ChosenTimes := Current^.ChosenTimes + 1; Current^.LastChosen := True; { do you want to set this even if it is chosen explicitly? I guess so. } { Pass the contents of the macro as if it just regular values in the file } {Writeln(xref,'About to send ParseValues this: "',Current^.Content,'"');} 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: 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,Lyr } Notes := False; InputPos := 1; {Writeln(xref,'In ParseValues. Input = "',Input,'"');} { Start here: Need a way to write something to the xref.txt file when you want to. for example, what key you are in, the duration of it, the variable being called Cnmaj 24 Fnmaj 16 Abmaj 24 Fnmaj 16 } 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 InputPos := Length(Input); { Pass it to Csound } Writeln(Ovf,Copy(Input,2,Length(Input)-1)); end; Ord('A'): Begin Ovv := Extract(Ins,Copy(Input,InputPos+1,7)); { OverallVolume } end; Ord('Q'): Begin Ntp := Extract(Ins,Copy(Input,InputPos+1,7)); { OverallTempo } end; Ord('E'): Begin Env := Extract(Env,Copy(Input,InputPos+1,7)); { Envelope } If (Env > 255) 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('Y'): Begin { Lyrics Y } Lyr := Extract(Lyr,Copy(Input,InputPos+1,7)); Notes := True; 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; If Not AutoOctaveShift then Oct := Oct + 1; end Else if (Ton < 0) then Begin Ton := Root + Ton; If Not AutoOctaveShift then Oct := Oct - 1; { see if not automatically incrementing keeps the octaves under control 3/25/14 } 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,Ups,Ovv,Ntp,Dur,Hol,War,Lyr,Gli); end; Ord('.'): Begin DefineMacro(Copy(Input,InputPos+1, { define macro } Length(Input)-(InputPos + 1))); end; Ord('&'): Begin { execute macro } ExpandMacro(Copy(Input,InputPos+1,MaxMacroNameLength)); Notes := True; end; Ord('H'): Begin { Hold note for duration } Hol := Extract(Hol,Copy(Input,InputPos+1,7)); Notes := True; end; Ord('W'): Begin { W_envelpe - right channel envelope } 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; Ord('X'): Begin { pass this info to xref.txt file for reporting what was chosen } InputPos := Length(Input); { Ignore all that follows and pass it to xref.txt } Writeln(Xref,Copy(Input,2,Length(Input)-1)); end; Ord(','): Begin Writeln('Error - invalid comma found in input "',Input,'"'); Halt(3); end; end; { Case } InputPos := InputPos + 1; end; { Begin } end; { ParseValues } Procedure ShowNotes; Var i: Byte; Lines: byte; {OldTime,NewTime,Delta: Integer;} TempVel: Byte; MaxTime: LongInt; LastTempo: Integer; TempAudNote: AudNoteType; SameEndTime: Boolean; RealStart: Real; UnMatchedTimes: Boolean; SampleIndex: Integer; FoundSample, FoundFunctionTable: Boolean; OverallVolumeChan: Byte; OverallVolumeTime: Real; CheckF: integer; LastVolume: byte; LastDuration: 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 } OverallVolumeChan := 0; 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 R-Env;Channel'); Writeln(sco,';p1 p2 p3 p4 p5 p6 ', ' p7 p8 p9 p10 p11 p12 ;Channel'); MaxTime := 0; For i := LowChannel to HighChannel do Begin Channels[i].Current := Channels[i].First; Channels[i].StartTime := 0; (* Writeln(xref,'Channels[',i,'].NumSamples = ',Channels[i].NumSamples, ' Instrument = ',Channels[i].Instrument, ' FunctionTable = ',Channels[i].FunctionTable ); *) 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 {Writeln('in ShowNotes Ton=',ToneInScale,' octave=',Octave,' Channel i =',i);} { 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 the max} If HoldDuration = 0 then HoldDuration := Duration; (* if ((TempVel > 0) and (Duration > 0)) then *) { 1/21/05 we need to allow for zero duration but non zero hold time } if ((TempVel > 0) and (HoldDuration > 0)) then Begin { If not zero velocity, play the note } { if the Ovv value (A) is non-zero, then this is an overall velocity channel } If (NowVolume > 0) then OverallVolumeChan := i; { 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/Root)*12)); { find midi note number nearest this one } (* Writeln(xref,'********Octave = ',Octave,' Ton = ',ToneInScale,' Root = ',Root); Writeln(xref,'CheckF = ',CheckF); *) { this section puts the wrong samples into the output file } { it needs some serious work. Samples are being left out } { I don't think it does anything any more } 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); If SampleIndex < 0 then SampleIndex := 0; { fixed 12-28-15 } { Writeln('SampleIndex = ',SampleIndex,' McGillSamples = ',McGillSamples,' McGillDescIndex = ',McGillDescIndex); } { check if within bounds first } While McGillDesc[SampleIndex].Channel <> FunctionTable do SampleIndex := SampleIndex + 1; { Runtime error 216 here } 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); SampleIndex := SampleIndex - 1; RealStart := StartTime + Perturb/16-Perturb*Random/8 - McGillDesc[SampleIndex].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].MoveForward); } If RealStart < 0 then RealStart := 0; If WarEnvelope = 0 then WarEnvelope := Envelope; (* Writeln(xref,'Check to see if Upsample will ask for a sample out of range'); Writeln(xref,'Upsample = ', Upsample, ' McGillDesc[', SampleIndex, '].SampleNumber = ', McGillDesc[SampleIndex].SampleNumber, ' Channels[', i, '].NumSamples = ', NumSamples); *) If Upsample > 128 then Begin { downsample requested. Deny it if there is no lower samples to raise } (* Writeln(xref,'Upsample - 256 = ',Upsample - 256); Writeln(xref,'prior to do loop. McGillDesc[',SampleIndex,'].SampleNumber = ', McGillDesc[SampleIndex].SampleNumber); Writeln(xref,'Prior to do loop Calc = ', McGillDesc[SampleIndex].SampleNumber + (Upsample - 256)); *) While ((McGillDesc[SampleIndex].SampleNumber + (Upsample - 256) < 1) and (Upsample <> 0)) do If Upsample = 255 then Upsample := 0 Else Upsample := Upsample + 1; {Writeln(xref,'Upsamp > 128. After while do loop Upsample = ',Upsample);} end Else if Upsample > 0 then Begin { Upsample a higher sample will be lowered, but not if there aren't any } (* Writeln(xref,'Upsample > 0 loop. Upsample = ',Upsample); Writeln(xref,'McGillDesc[',SampleIndex,'].SampleNumber = ', McGillDesc[SampleIndex].SampleNumber); Writeln(xref,'NumSamples = ',NumSamples); *) While(McGillDesc[SampleIndex].SampleNumber + Upsample > NumSamples) do Upsample := Upsample - 1; {Writeln(xref,'Upsamp GT 0 LT 128. After while do loop Upsample = ',Upsample);} end; (* Writeln(xref,'HoldDuration = ',HoldDuration,' McGillDesc[',SampleIndex,'].BaseNote = ', McGillDesc[SampleIndex].BaseNote); Writeln(xref,'Upsample = ',UpSample,' ToneInScale = ', ToneInScale,' Octave = ',Octave); Writeln(xref,'Channels[',i,'].NumSamples = ',NumSamples); Writeln(xref,'Sample File Name = "',McGillDesc[SampleIndex].FTable,'"'); Writeln(xref,'Relative Instrument # = ',FunctionTable,' Instrument # ',i:6); *) 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,WarEnvelope: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,WarEnvelope: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 } { 1250 } { at this point we know how long the piece is in beats, we have one instrument created for the sole purpose of keeping track of what the overall volume should be along the way, and we need to write out the array that includes that. } { it should be a function table that looks like this: f1 0 65536 7 and then a pair of levels and beats for each change of volume in the input file which look like this: dur level dur level dur level } { write the overallVolume csound file } Write(Ovf,' f1 0 65536 7 '); Channels[OverallVolumeChan].Current := Channels[OverallVolumeChan].First; Channels[OverallVolumeChan].StartTime := 0; Lines := 0; With Channels[OverallVolumeChan] do Repeat If (Current <> -1) then Begin Seek(AudNoteFile,Current); Read(AudNoteFile,TempAudNote); With TempAudNote do Begin StartTime := StartTime + Duration; OverallVolumeTime := Duration*(65536/Maxtime); Write(Ovf,' ',NowVolume:6,' ',OverallVolumeTime:8:0); LastVolume := NowVolume; Lines := Lines + 1; If Lines > 5 then Begin Writeln(Ovf,' '); Write(Ovf,' '); Lines := 0; end; end; Current := TempAudNote.Next; { where are we in the file } end; Until (Current = -1); { LastVolume := 0; } Writeln(Ovf,' ',LastVolume); { need to fix this so it doesn't prematurely fade to silence } { start here } { find a way to reduce the number of values in T0 function tables - limit is 100 on Windows or less } { The t0 function table can't be larger than a certain amount. I don't know what that is } { we should also write the t0 tempo array at this point } Write(Ovf,' t0 '); Write(sco,' t0 '); Channels[OverallVolumeChan].Current := Channels[OverallVolumeChan].First; Channels[OverallVolumeChan].StartTime := 0; Lines := 0; SameEndTime := False; With Channels[OverallVolumeChan] do Repeat If (Current <> -1) then Begin Seek(AudNoteFile,Current); Read(AudNoteFile,TempAudNote); With TempAudNote do Begin StartTime := StartTime + Duration; If StartTime < Maxtime then Begin Write(Ovf,' ',NowTempo:6,StartTime:8); Write(sco,' ',NowTempo:6,StartTime:8); end Else Begin Writeln(Ovf,' ',NowTempo:6); Writeln(sco,' ',NowTempo:6); SameEndTime := True; end; LastTempo := NowTempo; Lines := Lines + 1; If Lines > 6 then Begin Writeln(Ovf,' '); Write(Ovf,' '); Writeln(sco,' '); Write(sco,' '); Lines := 0; end; end; Current := TempAudNote.Next; { where are we in the file } end; Until (Current = -1); { now explain what you wrote } If SameEndTime then Writeln(sco,' ') Else Writeln(sco,' ',LastTempo:6); Writeln(Ovf,'; Maxtime = ',Maxtime); Writeln(Ovf,'; Actual beats in the piece'); Writeln(Ovf,'; Start Duration Volume Tempo StartN DurN'); Channels[OverallVolumeChan].Current := Channels[OverallVolumeChan].First; Channels[OverallVolumeChan].StartTime := 0; With Channels[OverallVolumeChan] do Repeat If (Current <> -1) then Begin Seek(AudNoteFile,Current); Read(AudNoteFile,TempAudNote); With TempAudNote do Begin StartTime := StartTime + Duration; LastDuration := Duration; Writeln(Ovf,'; ',StartTime:6,Duration:6,NowVolume:6,' ', NowTempo:6,Int(StartTime*(65536/Maxtime)):8:0,Int(Duration*(65536/Maxtime)):8:0); end; Current := TempAudNote.Next; { where are we in the file } end; Until (Current = -1); Writeln(Ovf,'i99 0 ',MaxDuration+LastDuration+10); { Used for an instrument that modifies overall volume } Writeln(Ovf,''); Writeln(Ovf,''); Writeln(sco,''); Writeln(sco,''); Writeln('Last StartTime = ',MaxTime:6); {Writeln('Total memory at end:,MemAvail:8,MaxAvail:8 changed for Free Pascal');} 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 {OldTime,NewTime,Delta: Integer;} Current: MacroPtr; 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; 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 + 1) * 12 + ((ToneInScale/Root)*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 } { made changes here on 12/28/15 to deal with negative numbers in SampleIndex } if UpSample > 128 then Begin { Down sample. This means a lower instrument note will be raised farther } SampleIndex := SampleIndex + (UpSample - 256); { Writeln('UpSample was >128 ',UpSample,' SampleIndex = ',SampleIndex,' McGillSamples = ',McGillSamples,' McGillDescIndex = ',McGillDescIndex); } If SampleIndex < 0 then SampleIndex := 0; { fixed 12-28-15 } { Runtime error 216 in the next line. Need to test for less than 0 } 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; { Writeln('UpSample was not> ',UpSample,' SampleIndex = ',SampleIndex,' McGillSamples = ',McGillSamples,' McGillDescIndex = ',McGillDescIndex); } { SampleIndex := SampleIndex + (UpSample - 256); } 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 - very mysterious } McGillDesc[SampleIndex].Used := True; end; { with Current^ do } Current := TempAudNote.Next; { where are we in the file } end; Until (Current = -1); end; { This needs more work. Basically copy all the samples to the output file, even if not needed } 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 ; should not be required - uncomment if needed 2-28-2009'); (* For SampleIndex := 0 to McGillDescIndex-1 do with McGillDesc[SampleIndex] do Writeln(xref,'McGillDesc[',SampleIndex,'].BaseNote = ',BaseNote, ' FunctionTableNum = ',FunctionTableNum,' SampleNumber = ',SampleNumber); *) end; { WriteSampleFiles } Begin Writeln; Randomize; Init; { Begin a string of notes to play } { stat mfgid subst node } writeln('Root is ',Root); Repeat ReadValues(Input); ParseValues(Input); Until Eof(Music); WriteSampleFiles; ShowNotes; PlayNotes; Close(Music); Close(sco); Close(Ovf); Close(AudNoteFile); Close(ChannelFile); Close(Xref); end.