TSMALLRAMUGENCLASSES.PAS
{
**************************************************************
********** Ramugen Worker Objects ***********
**************************************************************
TMidiArray : component which handles musical phrases and is able to play them using MIDI.
TWeightingSystem : component which handles complex probabilistic selection using a simple
interface.
TGlobalProbability : tiny class which returns the runtime IsRequired property based on
a probability value.
TMidiArrayTimer : Timer component which is compatible with the notion of destroying itself
via a method of TMidiArray. The timer passes its FPlaying field as a var
parameter to its ValidatePerformance event-handler which is a method of
TMidiArray. This method, if it sets the var parameter to FALSE, results
in the timer being freed in its OnTimer event-handler, which is also a
method of TMidiArray.
This technique is the only reason I've subclassed from TTimer.
I daresay it could also have been done using Tag, but the timer also
carries a deep copy of the data it's playing, such that if the creating
array's data changes, the phrase being played won't be harmed.
}
unit TSmallRamugenClasses;
interface
uses Classes, StdCtrls, ExtCtrls;
type
TNoteStartEvent = procedure (Sender: TObject; Pitch : Integer; CounterValue : Integer; var CarryOnPlaying : boolean) of object;
TMidiArrayTimer = class(TTimer) //worker object for TMidiArray
protected
FHalt : TNoteStartEvent; //private event for linking to MidiArray
public //usually created on the fly
Counter : Integer;
Done : Boolean;
Pitches : array of Integer;
Durations : array of Integer;
Amplitudes : array of Integer;
Channel : Integer;
Handle : Integer;
Repeating : Boolean;
RepeatCount : Integer;
constructor Create(AOwner : TComponent); override;
destructor Destroy; override;
published
property ValidatePerformance : TNoteStartEvent read FHalt write FHalt;
end;
TMidiArray = class(TComponent)
protected
FPhraseLength : Integer;
FPitches : array of Integer;
FDurations : array of Integer;
FAmplitudes : array of Integer;
FChannel : Integer;
FVoice : Integer;
FHandle : Integer;
FOpenedOne : Boolean; //if it's opened a MIDI device it needs to shut it on free
FRepeating : Boolean;
FPlaying : Boolean;
FRepeatCount : Integer;
FPhraseStart : TNotifyEvent;
FPhraseEnd : TNotifyEvent;
FPlayNoteBegin : TNoteStartEvent;
FPlayNoteEnd : TNotifyEvent;
procedure SetPhraseLength(Length : Integer);
procedure SetChannel(MIDIChannel : Integer);
procedure SetVoice(MIDIVoice : Integer);
procedure HaltIt(Sender: TObject; Pitch : Integer; CounterValue : Integer; var CarryOnPlaying : boolean);
procedure InternalTimerHandler (Sender : TObject);
procedure TimerStopNote(Sender : TObject);
public
constructor Create(AOwner : TComponent); override;
destructor Destroy; override;
function Pitch(Index : Integer) : Integer; //access properties for end-users
function Duration(Index : Integer) : Integer;
function Amplitude(Index : Integer) : Integer;
procedure Assign(You : TPersistent); overload; override; //Added interface to array variables (next 3 overloads)
procedure Assign(Pitches : array of Integer; Durations : array of Integer; Amplitudes : array of Integer); reintroduce; overload;
procedure Assign(Pitches : array of Integer; Durations : array of Integer; Amplitude : Integer = 100); reintroduce; overload;
procedure Assign(Pitches : array of Integer; Duration : Integer = 700; Amplitude : Integer = 100); reintroduce; overload;
procedure AssignTo(Him : TPersistent); overload; override;
procedure AssignTo(var Pitches : array of Integer; var Durations : array of Integer; var Amplitudes : array of Integer); reintroduce; overload;
procedure AssignTo(var Pitches : array of Integer; var Durations : array of Integer); reintroduce; overload;
procedure AssignTo(var Pitches : array of Integer); reintroduce; overload;
procedure Append(You : TPersistent); overload;
procedure Append(Pitches : array of Integer; Durations : array of Integer; Amplitudes : array of Integer); overload;
procedure Append(Pitches : array of Integer; Durations : array of Integer; Amplitude : Integer = 100); overload;
procedure Append(Pitches : array of Integer; Duration : Integer = 700; Amplitude : Integer = 100); overload;
procedure SaveToFile(Filename : String = 'prompt');
procedure LoadFromFile(Filename : String = 'prompt'; Append : Boolean = false);
procedure Clear;
procedure Halt; //halts any phrases being managed by this array
procedure OpenMIDIDevice(DeviceID : Integer = 0);
procedure ShareMIDIDeviceOf(Handler : TObject);
procedure AddNote(Pitch : Integer; Duration : Integer = 700; Amplitude : Integer = 100); overload; virtual;
procedure AddNote(NoteName : string; Octave : Integer = 5; duration : Integer = 700; dynamicmarking : string = 'mf'); overload; virtual;
procedure PlayPhrase(TranspositionFactor : Integer = 0; SpeedPercent : Integer = 100; AmplitudeLowerLimit : Integer = 40; AmplitudeHigherLimit : Integer = 127); //all parameters optional
procedure StartNote(pitch, amplitude : Integer); overload; virtual;
procedure StopNote(pitch : Integer); overload; virtual;
procedure StartNote(notename : string; octave : Integer = 5; dynamicmarking : string = 'mf'); overload; virtual;
procedure StopNote(notename : string; octave : Integer = 5); overload; virtual;
procedure PlayNote(pitch : Integer; duration : Integer=700; amplitude : Integer=100); overload; virtual;
procedure PlayNote(notename : string; octave : Integer = 5; duration : Integer = 700; dynamicmarking : string = 'mf'); overload; virtual;
//data transformation methods
procedure Reverse(pitch : boolean = true; duration : boolean = true; amplitude : boolean = true; Probability : Single = 1); virtual;
procedure Invert(Min : Integer = 40; Max : Integer = 100; Probability : Single = 1); virtual;
procedure MutatePitch(Probability : Single; RangeUp : Integer = 1; RangeDown : Integer = 1); virtual;
procedure MutateDuration(Probability : Single; RangeUp : Integer = 50; RangeDown : Integer = 50); virtual;
procedure MutateAmplitude(Probability : Single; RangeUp : Integer = 10; Rangedown : Integer = 10); virtual;
procedure Shuffle(Probability : Single = 1; Pitch : Boolean = true; Duration : Boolean = true; Amplitude : Boolean = true; AttributesIndependent : Boolean = false); virtual;
procedure Transpose(TransposeFactor : Integer = 1; Min : Integer = 30; Max : Integer = 100; Probability : Single = 1); virtual;
procedure Stretch(SpeedPercent : Integer = 90; Probability : Single = 1); virtual;
procedure Dilate(IntervalWideningFactor : Integer = 1; Min : Integer = 40; Max : Integer = 100; Probability : Single = 1); virtual;
procedure RotateLeft(RotateFactor : Integer = 1); virtual;
procedure RotateRight(RotateFactor : Integer = 1); virtual;
procedure RandomisePitch(Min : Integer = 40; Max : Integer = 90; Probability : Single = 1); virtual;
procedure RandomiseDuration(Min : Integer = 100; Max : Integer = 1200; UnitSize : Integer = 100; Probability : Single = 1); virtual;
procedure RandomiseAmplitude(Min : Integer = 40; Max : Integer = 127; Probability : Single = 1); virtual;
procedure MakeRandomToneRow(Octave : Integer); overload; virtual;
procedure MakeRandomToneRow; overload; virtual; //random octaves
procedure FoxTransform(Pitches : Array of Integer); overload; virtual;
procedure FoxTransform(ChromaticScaleOf : Integer); overload; virtual;
//run-time properties
property PlayingPhrase : Boolean read FPlaying; //read-only
property Handle : Integer read FHandle write FHandle; //Likely to have already been checked
property PhraseLength : Integer read FPhraseLength write SetPhraseLength default 0;
published
//events
property OnNoteStart : TNoteStartEvent read FPlayNoteBegin write FPlayNoteBegin;
property OnNoteStop : TNotifyEvent read FPlayNoteEnd write FPlayNoteEnd;
property OnPhraseStart : TNotifyEvent read FPhraseStart write FPhraseStart;
property OnPhraseStop : TNotifyEvent read FPhraseEnd write FPhraseEnd;
//design-time properties
property Repeating : Boolean read FRepeating write FRepeating;
property RepeatCount : Integer read FRepeatCount write FRepeatCount;
property Channel : Integer read FChannel write SetChannel;
property Voice : Integer read FVoice write SetVoice;
end;
TWeightingSystem = class(TComponent)
protected
FChosen : Integer;
FValues : array[0..127] of Integer;
DTitle : string; //for InputWeightings dialogue box
DDescription : string;
{The following four methods are now interfaced by overloaded versions of the
Assign and AssignTo methods for greater stylistic compatibility with the Delphi VCL.}
procedure SaveFromPanel (Sender : TObject); virtual;
procedure SaveFromArray (A : array of Integer); virtual;
procedure LoadToPanel (Sender : TObject); virtual;
procedure LoadToArray (var A : array of Integer); virtual;
public
constructor Create(AOwner : TComponent); override;
destructor Destroy; override;
procedure Assign(aWS : TPersistent); overload; override;
{ Weighting Systems can interface with TEdit/TSpinEdit controls
on a TPanel object. A button on a TPanel can also be sent to
the Assign method and its parent TPanel will be read.
An alternative overloaded method is the 'economy' version which
takes input from a simple array of Integers }
procedure Assign(Obj : TObject); reintroduce; overload;
procedure Assign(A : array of Integer); reintroduce; overload;
procedure AssignTo(aWS : TPersistent); overload; override;
procedure AssignTo(Obj : TObject); reintroduce; overload;
procedure AssignTo(A : array of Integer); reintroduce; overload;
procedure Mu; virtual;
procedure Initialize (X : Integer); virtual;
procedure InputWeightings(Min : Integer = 0; Max : Integer = 127; ShowRulers : Boolean = False); virtual;
function Choose ( KMin, KMax : Integer ): Integer; virtual;
property Title : String read DTitle write DTitle;
property Description : String read DDescription write DDescription;
published
property LastChosen : Integer read FChosen;
end;
TGlobalProbability = class(TPersistent)
protected
FProbability : Double;
procedure SetProbability(T : Double); virtual;
function GetRequired : Boolean; virtual;
public
constructor Create; virtual;
destructor Destroy; override;
procedure Assign(aGP : TPersistent); override;
procedure AssignTo(aGP : TPersistent); override;
published
property Probability : Double read FProbability write SetProbability;
property IsRequired : Boolean read GetRequired;
end;
//unit level functions
function Octave(Pitch : Integer) : Integer;
function PitchClass(Pitch : Integer) : string;
function Frequency(Pitch : Integer) : single; overload;
function Frequency(PitchClass : string; Octave : Integer) : Single; overload;
function NoteNametoNoteValue(NoteName : string; Octave : Integer = 5) : Integer;
implementation
uses TRamugenClass, MMSystem, Controls, SysUtils, WSDialog, WinTypes, Dialogs, Math;
//unit-level functions exposed by this set of components
function NoteNametoNoteValue(NoteName : string; Octave : Integer = 5) : Integer;
var n : Integer;
begin
NoteName := LowerCase(NoteName);
Result := -1; //error-code
n := -1;
if NoteName = 'c' then n := 0;
if (NoteName = 'c#') or (NoteName = 'db') then n := 1;
if NoteName = 'd' then n := 2;
if (NoteName = 'd#') or (NoteName = 'eb') then n := 3;
if NoteName = 'e' then n := 4;
if NoteName = 'f' then n := 5;
if (NoteName = 'f#') or (NoteName = 'gb') then n := 6;
if NoteName = 'g' then n := 7;
if (NoteName = 'g#') or (NoteName = 'ab') then n := 8;
if NoteName = 'a' then n := 9;
if (NoteName = 'a#') or (NoteName = 'bb') then n := 10;
if NoteName = 'b' then n := 11;
if n > -1 then Result := (Octave * 12) + n;
if Result > 127 then Result := Result - 12;
if NoteName = 'rest' then Result := 255; //code for "rest"
end;
function Octave(Pitch : Integer) : Integer;
begin
Result := trunc((pitch - (pitch mod 12)) / 12);
end;
function PitchClass(Pitch : Integer) : string;
begin
pitch := pitch mod 12;
case pitch of
0 : Result := 'C';
1 : Result := 'C#';
2 : Result := 'D';
3 : Result := 'D#';
4 : Result := 'E';
5 : Result := 'F';
6 : Result := 'F#';
7 : Result := 'G';
8 : Result := 'G#';
9 : Result := 'A';
10 : Result := 'A#';
11 : Result := 'B';
end;
end;
function Frequency(Pitch : Integer) : Single;
begin
Result := 16.3515 * (power(2, pitch/12));
end;
function Frequency(PitchClass : string; Octave : Integer) : Single;
var t : Integer;
begin
t := NoteNameToNoteValue(PitchClass, Octave);
result := frequency(t);
end;
//constructors
constructor TMidiArrayTimer.Create(AOwner : TComponent);
begin
inherited Create(AOwner);
repeating := false;
done := false;
counter := 0;
end;
destructor TMidiArrayTimer.Destroy;
begin
Pitches := nil;
Durations := nil;
Amplitudes := nil;
inherited;
end;
constructor TMidiArray.Create(AOwner : TComponent);
begin
inherited Create(AOwner);
PhraseLength := 1;
FPitches[0] := 0; //must be initialized so that we know it's empty
FDurations[0] := 1; //in case someone tries to play it empty
FRepeating := false;
FRepeatCount := 1;
randomize;
FOpenedOne := false; //it hasn't opened its own MIDI Device
end;
destructor TMidiArray.Destroy;
begin
if FOpenedOne then MidiOutClose(FHandle); //close the MIDI Device only if you opened it!
inherited;
end;
constructor TWeightingSystem.Create(AOwner : TComponent);
begin
inherited Create(AOwner);
end;
destructor TWeightingSystem.Destroy;
begin
inherited;
end;
constructor TGlobalProbability.Create;
begin
inherited;
randomize;
end;
destructor TGlobalProbability.Destroy;
begin
inherited;
end;
//Assign
procedure TMidiArray.Assign(You : TPersistent);
var t : integer;
begin
if You is TMidiArray then begin
PhraseLength := TMidiArray(You).FPhraseLength;
for t := 0 to PhraseLength do begin
FPitches[t] := TMidiArray(You).FPitches[t];
FDurations[t] := TMidiArray(You).FDurations[t];
FAmplitudes[t] := TMidiArray(You).FAmplitudes[t];
end;
end else inherited Assign(You);
end;
procedure TMidiArray.Assign(Pitches : array of Integer; Durations : array of Integer; Amplitudes : array of Integer);
var t : Integer;
begin
//set length to the smallest of the passed arrays (eliminates "out of bounds" problems)
if High(Pitches) < High(Durations) then t := High(Pitches) else t := High(Durations);
if High(Amplitudes) < t then t := High(Amplitudes);
PhraseLength := t;
for t := 0 to PhraseLength do begin
FPitches[t] := Pitches[t];
FDurations[t] := Durations[t];
FAmplitudes[t] := Amplitudes[t];
end;
end;
procedure TMidiArray.Assign(Pitches : array of Integer; Durations : array of Integer; Amplitude : Integer = 100);
var t : Integer;
begin
if High(Pitches) < High(Durations) then t := High(Pitches) else t := High(Durations);
PhraseLength := t;
for t := 0 to High(FPitches) do FPitches[t] := Pitches[t];
for t := 0 to High(FDurations) do FDurations[t] := Durations[t];
for t := 0 to High(FAmplitudes) do FAmplitudes[t] := Amplitude;
end;
procedure TMidiArray.Assign(Pitches : array of Integer; Duration : Integer = 700; Amplitude : Integer = 100);
var t : Integer;
begin
PhraseLength := High(Pitches);
for t := 0 to PhraseLength do begin
FPitches[t] := Pitches[t];
FDurations[t] := Duration;
FAmplitudes[t] := Amplitude;
end;
end;
procedure TWeightingSystem.Assign(aWS : TPersistent);
var t : Integer;
begin
if aWS is TWeightingSystem then begin
Title := TWeightingSystem(aWS).Title;
Description := TWeightingSystem(aWS).Description;
for t := 0 to 127 do
FValues[t] := TWeightingSystem(aWS).FValues[t];
end
else
inherited Assign(aWS);
end;
procedure TWeightingSystem.Assign(Obj : TObject);
begin
SaveFromPanel(Obj);
end;
procedure TWeightingSystem.Assign(A : array of Integer);
begin
SaveFromArray(A);
end;
procedure TMidiArray.AssignTo(Him : TPersistent);
begin
if Him is TMidiArray then begin
TMidiArray(Him).FPitches := FPitches;
TMidiArray(Him).FDurations := FDurations;
TMidiArray(Him).FAmplitudes := FAmplitudes;
TMidiArray(Him).FPhraseLength := FPhraseLength;
end else inherited AssignTo(Him);
end;
procedure TMidiArray.AssignTo(var Pitches : array of Integer; var Durations : array of Integer; var Amplitudes : array of Integer);
var t,h : Integer;
begin
h := PhraseLength; //AssignTo fits as much data as there's room for, and no more...
if high(pitches) < h then h := high(pitches);
if high(durations) < h then h := high(durations);
if high(amplitudes) < h then h := high(amplitudes);
for t := 0 to h do begin
Pitches[t] := FPitches[t];
Durations[t] := FDurations[t];
Amplitudes[t] := FAmplitudes[t];
end;
end;
procedure TMidiArray.AssignTo(var Pitches : array of Integer; var Durations : array of Integer);
var t,h : Integer;
begin
h := PhraseLength;
if high(pitches) < h then h := high(pitches);
if high(durations) < h then h := high(durations);
for t := 0 to h do begin
Pitches[t] := FPitches[t];
Durations[t] := FDurations[t];
end;
end;
procedure TMidiArray.AssignTo(var Pitches : array of Integer);
var t,h : Integer;
begin
h := PhraseLength;
if high(pitches) < h then h := high(pitches);
for t := 0 to h do begin
Pitches[t] := FPitches[t];
end;
end;
procedure TWeightingSystem.AssignTo(aWS : TPersistent);
var t : Integer;
begin
if aWS is TWeightingSystem then begin
TWeightingSystem(aWS).Title := Title;
TWeightingSystem(aWS).Description := Description;
for t := 0 to 127 do
TWeightingSystem(aWS).FValues[t] := FValues[t];
end
else
inherited AssignTo(aWS);
end;
procedure TWeightingSystem.AssignTo(Obj : TObject);
begin
LoadToPanel(Obj);
end;
procedure TWeightingSystem.AssignTo(A : array of Integer);
begin
LoadToArray(A);
end;
procedure TGlobalProbability.Assign(aGP : TPersistent);
begin
if aGP is TGlobalProbability then begin
Probability := TGlobalProbability(aGP).Probability;
end
else
inherited Assign(aGP);
end;
procedure TGlobalProbability.AssignTo(aGP : TPersistent);
begin
if aGP is TGlobalProbability then begin
TGlobalProbability(aGP).Probability := Probability;
end
else
inherited Assign(aGP);
end;
//Load/Save
procedure TMidiArray.SaveToFile(Filename : String = 'prompt');
var
str1 : file of Integer;
savedialog1 : TSaveDialog;
t : Integer;
begin
if FileExists(filename) then
begin
if MessageDlg('Do you want to over-write the file?',mtConfirmation, [mbYes, mbNo], 0) = mrNo
then
Filename := 'prompt';
end;
if comparestr(Filename,'prompt') = 0 then
begin
savedialog1 := TSaveDialog.Create(nil);
try
savedialog1.Filter:='Ramugen Memory Dump|*.rmf';
savedialog1.DefaultExt := 'rmf';
savedialog1.Options := [ofOverwritePrompt];
if savedialog1.execute then Filename := savedialog1.filename;
finally
savedialog1.Free;
end;
end;
assignfile(str1,filename);
rewrite(str1);
try
t := High(FPitches) + 1;
write(str1, t);
for t := 0 to High(FPitches) do write (str1,FPitches[t]);
t := High(FDurations) + 1;
write(str1, t);
for t := 0 to High(FDurations) do write (str1,FDurations[t]);
t := High(FAmplitudes) + 1;
write(str1, t);
for t := 0 to High(FAmplitudes) do write (str1,FAmplitudes[t]);
finally
closefile(str1);
end;
end;
procedure TMidiArray.LoadFromFile(Filename : String = 'prompt'; Append : Boolean = false);
var
str1 : file of Integer;
opendialog1 : TOpenDialog;
x : TMidiArray;
t, g,h : Integer;
begin
x := TMidiArray.Create(nil);
try
x.clear;
if not Append then Clear;
if not(FileExists(filename)) then Filename := 'prompt';
if comparestr(filename, 'prompt') = 0 then
begin
opendialog1 := TOpenDialog.Create(nil);
try
opendialog1.Options := [ofFileMustExist];
opendialog1.filter:='Ramugen Memory Dump|*.rmf';
if opendialog1.execute then Filename := opendialog1.FileName;
finally
opendialog1.free;
end;
end;
if FileExists(FileName) then
begin
AssignFile(str1,filename);
Reset(str1);
try
Read(str1,t);
SetLength(x.FPitches,t);
g := High(x.FPitches);
for t := 0 to g do
begin
Read(str1,x.FPitches[t]);
end;
Read(str1,t);
SetLength(x.FDurations,t);
h := High(x.FDurations);
if h > g then h := g;
for t := 0 to h do
begin
Read(str1,x.FDurations[t]);
end;
Read(str1,t);
SetLength(x.FAmplitudes,t);
h := High(x.FAmplitudes);
if h > g then h := g;
for t := 0 to h do
begin
Read(str1,x.FAmplitudes[t]);
AddNote(x.FPitches[t],x.FDurations[t],x.FAmplitudes[t]);
end;
finally
closefile(str1);
end;
end;
finally
x.free;
end;
end;
//Append (like Assign)
procedure TMidiArray.Append(You : TPersistent);
var t : integer;
begin
if You is TMidiArray then
begin
for t := 0 to TMidiArray(You).PhraseLength do
AddNote(TMidiArray(You).Pitch(t),TMidiArray(You).Duration(t),TMidiArray(You).Amplitude(t));
end;
end;
procedure TMidiArray.Append(Pitches : array of Integer; Durations : array of Integer; Amplitudes : array of Integer);
var t : integer;
begin
for t := 0 to High(Pitches) do
begin
AddNote(Pitches[t],Durations[t],Amplitudes[t]);
end;
end;
procedure TMidiArray.Append(Pitches : array of Integer; Durations : array of Integer; Amplitude : Integer = 100);
var t : integer;
begin
for t := 0 to High(Pitches) do
begin
AddNote(Pitches[t],Durations[t],Amplitude);
end;
end;
procedure TMidiArray.Append(Pitches : array of Integer; Duration : Integer = 700; Amplitude : Integer = 100);
var t : integer;
begin
for t := 0 to High(Pitches) do
begin
AddNote(Pitches[t],Duration,Amplitude);
end;
end;
//Mu
procedure TWeightingSystem.Mu;
var x, y, z : Integer;
begin
z := 0;
for x := 0 to 127 do begin
y := trunc(random(20));
if y = 0 then FValues[x] := 0 else FValues[x] := y + z;
z := z + y;
end;
end;
//Midi Device Interface
procedure TMidiArray.ShareMIDIDeviceOf(Handler : TObject);
begin
if Handler is TMidiArray then FHandle := TMidiArray(Handler).FHandle;
if Handler is TCustRamugen then FHandle := TCustRamugen(Handler).Memory.FHandle;
end;
procedure TMidiArray.OpenMIDIDevice(DeviceID : Integer = 0);
begin
MidiOutClose(FHandle);
MidiOutOpen(addr(FHandle), DeviceID, 0, 0, 0);
FOpenedOne := true;
end;
//Setters and Getters
procedure TMidiArray.Clear; //(kind of a setter)
var t : Integer;
begin
for t := 0 to PhraseLength do FPitches[t] := 0;
FPhraseLength := 0;
SetLength(FPitches,1);
SetLength(FDurations,1); FDurations[0] := 10;
SetLength(FAmplitudes,1); FAmplitudes[0] := 0;
end;
procedure TMidiArray.SetPhraseLength(Length : Integer);
begin
if Length < 1 then Length := 1;
FPhraseLength := Length;
SetLength(FPitches,Length +1);
SetLength(FDurations,Length +1);
SetLength(FAmplitudes,Length +1);
end;
procedure TMidiArray.SetVoice(MIDIVoice : Integer);
begin
FVoice := MIDIVoice;
if FVoice < 0 then FVoice := 0;
if FVoice > 127 then FVoice := 127;
MidiOutShortMsg(FHandle, $C0 + FChannel + FVoice shl 8 + 0 shl 16);
end;
procedure TMidiArray.SetChannel(MIDIChannel : Integer);
begin
FChannel := MIDIChannel;
if FChannel > 15 then FChannel := 15;
if FChannel < 0 then FChannel := 0;
end;
procedure TGlobalProbability.SetProbability(T : Double);
begin
if T < 0 then T := 0; if T > 1 then T := 1;
FProbability := T;
end;
function TGlobalProbability.GetRequired : Boolean;
begin
result := (FProbability > Random);
end;
function TMIDIArray.Pitch(Index : Integer) : Integer; //access methods for end-users
begin
if Index > PhraseLength then
Result := 0
else
Result := FPitches[Index];
end;
function TMIDIArray.Duration(Index : Integer) : Integer;
begin
if Index > PhraseLength then
Result := 0
else
Result := FDurations[Index];
end;
function TMIDIArray.Amplitude(Index : Integer) : Integer;
begin
if Index > PhraseLength then
Result := 0
else
Result := FAmplitudes[Index];
end;
//Main Working Methods
procedure TMIDIArray.StartNote(pitch, amplitude : Integer);
var t : boolean;
begin
t := true;
if Assigned(FPlayNoteBegin) then FPlayNoteBegin(Self,Pitch,0,t);
MidiOutShortMsg(FHandle, $90 + FChannel + (pitch-1) shl 8 + amplitude shl 16);
end;
procedure TMIDIArray.StartNote(NoteName : string; Octave : Integer = 5; dynamicmarking : string = 'mf');
var n, v : Integer;
b : boolean;
begin
b := true;
n := NoteNametoNoteValue(NoteName, Octave);
v := 80; //default to mf
if dynamicmarking = 'pppp' then v := 25;
if dynamicmarking = 'ppp' then v := 37;
if dynamicmarking = 'pp' then v := 49;
if dynamicmarking = 'p' then v := 60;
if dynamicmarking = 'mp' then v := 70;
if dynamicmarking = 'f' then v := 90;
if dynamicmarking = 'ff' then v := 103;
if dynamicmarking = 'fff' then v := 115;
if dynamicmarking = 'ffff' then v := 127;
//under Ramugen (unlike general MIDI), a rest is a silent note with its own duration
if n = 255 then begin v := 0; n := 1; end;
if Assigned(FPlayNoteBegin) then FPlayNoteBegin(Self,n,0,b);
MidiOutShortMsg(FHandle, $90 + FChannel + (n-1) shl 8 + v shl 16);
end;
procedure TMIDIArray.StopNote(pitch : Integer);
begin
if Assigned(FPlayNoteEnd) then FPlayNoteEnd(Self);
MidiOutShortMsg(FHandle, $80 + FChannel + (pitch-1) shl 8 + 127 shl 16);
end;
procedure TMIDIArray.StopNote(NoteName : string; Octave : Integer = 5);
var n : Integer;
begin
n := NoteNametoNoteValue(NoteName, Octave);
if Assigned(FPlayNoteEnd) then FPlayNoteEnd(Self);
MidiOutShortMsg(FHandle, $80 + FChannel + (n-1) shl 8 + 127 shl 16);
end;
procedure TMIDIArray.PlayNote(pitch:Integer; duration: Integer=700; amplitude: Integer=100);
var temptim : TTimer;
begin
StartNote(pitch,amplitude);
temptim := TTimer.Create(nil);
temptim.tag := pitch;
temptim.Interval := duration;
temptim.OnTimer := TimerStopNote;
temptim.Enabled := true;
end;
procedure TMIDIArray.PlayNote(NoteName : string; Octave : Integer = 5; duration : Integer = 700; dynamicmarking : string = 'mf');
var temptim : TTimer;
begin
StartNote(NoteName, Octave, dynamicmarking);
temptim := TTimer.Create(nil);
temptim.tag := NoteNametoNoteValue(NoteName, Octave);
temptim.Interval := duration;
tempTim.OnTimer := TimerStopNote;
tempTim.Enabled := true;
end;
procedure TMIDIArray.TimerStopNote(Sender : TObject);
begin
try
StopNote(TComponent(Sender).Tag);
finally
Sender.Free;
end;
end;
procedure TMidiArray.AddNote(Pitch : Integer; Duration : Integer = 700; Amplitude : Integer = 100);
var t : Integer;
begin
while FPitches[PhraseLength] > 0 do PhraseLength := PhraseLength + 1; //find empty one
t := PhraseLength;
if FAmplitudes[0] = 0 then t := 0;
FPitches[t] := Pitch;
FDurations[t] := Duration;
FAmplitudes[t] := Amplitude;
if t = 0 then PhraseLength := 1
end;
procedure TMidiArray.AddNote(NoteName : string; Octave : Integer = 5; duration : Integer = 700; dynamicmarking : string = 'mf');
var pitch, amplitude : integer;
begin
pitch := NoteNametoNoteValue(NoteName, Octave);
if pitch = 255 then //rest
begin
pitch := 0;
amplitude := 0;
end else
begin
amplitude := 80; //default to mf
if dynamicmarking = 'pppp' then amplitude := 25;
if dynamicmarking = 'ppp' then amplitude := 37;
if dynamicmarking = 'pp' then amplitude := 49;
if dynamicmarking = 'p' then amplitude := 60;
if dynamicmarking = 'mp' then amplitude := 70;
if dynamicmarking = 'f' then amplitude := 90;
if dynamicmarking = 'ff' then amplitude := 103;
if dynamicmarking = 'fff' then amplitude := 115;
if dynamicmarking = 'ffff' then amplitude := 127;
end;
AddNote(pitch, duration, amplitude);
end;
procedure TMidiArray.PlayPhrase(TranspositionFactor : Integer = 0; SpeedPercent : Integer = 100; AmplitudeLowerLimit : Integer = 40; AmplitudeHigherLimit : Integer = 127);
var temptim : TMidiArrayTimer; t,z : integer;
begin //nb. 200 means twice as FAST
FPlaying := true;
temptim := TMidiArrayTimer.Create(nil);
temptim.Enabled := false;
temptim.ValidatePerformance := HaltIt;
SetLength(temptim.Pitches, FPhraseLength +1);
SetLength(temptim.Durations, FPhraseLength +1);
SetLength(temptim.Amplitudes, FPhraseLength +1);
for t := 0 to FPhraseLength do begin
temptim.Pitches[t] := FPitches[t] + TranspositionFactor;
if temptim.Pitches[t] < 0 then temptim.Pitches[t] := 0;
if temptim.Pitches[t] > 127 then temptim.Pitches[t] := 127;
temptim.Durations[t] := trunc(FDurations[t] * (1 / SpeedPercent * 100));
if temptim.Durations[t] < 5 then temptim.Durations[t] := 5;
temptim.Amplitudes[t] := FAmplitudes[t];
if temptim.Amplitudes[t] < AmplitudeLowerLimit then temptim.Amplitudes[t] := AmplitudeLowerLimit;
if temptim.Amplitudes[t] > AmplitudeHigherLimit then temptim.Amplitudes[t] := AmplitudeHigherLimit;
end;
temptim.Channel := FChannel;
temptim.Handle := FHandle;
temptim.Repeating := FRepeating;
temptim.RepeatCount := FRepeatCount;
temptim.Counter := 0;
temptim.Interval := temptim.Durations[temptim.Counter];
temptim.OnTimer := InternalTimerHandler; //see next method in unit
temptim.Done := false;
if Assigned(FPhraseStart) then FPhraseStart(Self); //event handler executes here
z := temptim.Pitches[temptim.Counter];
MidiOutShortMsg(FHandle, $90 + FChannel + (z-1) shl 8 + temptim.Amplitudes[temptim.Counter] shl 16);
if Assigned(FPlayNoteBegin) then FPlayNoteBegin(Self,z,temptim.Counter,FPlaying); //call event handler for the first NOTE, too
temptim.Enabled := true;
end;
procedure TMidiArray.InternalTimerHandler (Sender : TObject);
begin //assumes a note is already playing
with Sender as TMidiArrayTimer do begin
Enabled := false;
if counter <= high(pitches) then
begin
MidiOutShortMsg(FHandle, $80 + Channel + (Pitches[Counter]-1) shl 8 + 127 shl 16);
if Assigned(FPlayNoteEnd) then FPlayNoteEnd(Self);
end;
if Assigned(FHalt) then FHalt(Self,0,0,FPlaying); //interface with the MidiArray who made you
if not FPlaying then begin
if sender is TMidiArrayTimer then Sender.Free;
exit;
end;
if Counter = PhraseLength then begin
Counter := 0;
if RepeatCount = 0 then Repeating := false;
if Repeating then dec(RepeatCount);
Done := not Repeating;
if done then
begin
FPlaying := false;
if Assigned(FPhraseEnd) then FPhraseEnd(Self);
end;
end else begin
Inc(Counter);
end;
//play next note (if we're to be carrying on)
if not Done then
begin
if (counter <= high(pitches)) and (counter <= high(amplitudes))
then
begin
MidiOutShortMsg(Handle, $90 + Channel + (Pitches[Counter]-1) shl 8 + Amplitudes[Counter] shl 16);
if Assigned(FPlayNoteBegin) then FPlayNoteBegin(Self,Pitches[Counter],Counter,FPlaying); //event-handler for the new note
end;
if counter <= high(durations) then Interval := Durations[Counter];
Enabled := true;
end;
if Interval < 5 then Interval := 5;
end; //with
end;
procedure TMidiArray.Halt;
begin
FPlaying := false; //stop any phrases being managed by this array
end;
procedure TMidiArray.HaltIt(Sender: TObject; Pitch : Integer; CounterValue : Integer; var CarryOnPlaying : boolean);
begin
if Sender is TMidiArrayTimer then CarryOnPlaying := FPlaying;
//pass the MidiArray's non-playing status to the temp.timer object so it'll know to stop
end;
procedure TWeightingSystem.SaveFromPanel (Sender : TObject);
var t, x, y, z : Integer;
begin
x := 0;
//consider adding more interfaces for greater polymorphism, eg. StringList
//requires either a Panel, or a button on a Panel (flexible calls)
if Sender is TButton then
if TButton(Sender).Parent is TPanel then Sender := TButton(Sender).Parent
else exit;
if Sender is TPanel then
with Sender as TPanel do begin
for t := 0 to controlcount - 1 do begin
if controls[t] is TEdit then with controls[t] as TEdit do begin
val(text, z, y); if y <> 0 then z := 0;
if z = 0 then FValues[Integer(TabOrder)] := 0 else
FValues[Integer(TabOrder)] := x + z;
x := x + z;
end;
end;
end;
end;
procedure TWeightingSystem.LoadToPanel (Sender : TObject);
var t, x, y, z : Integer;
begin
//requires either a Panel, or a button on a Panel (flexible calls)
if Sender is TButton then
if TButton(Sender).Parent is TPanel then Sender := TButton(Sender).Parent
else exit;
z:=0;
if Sender is TPanel then
with Sender as TPanel do begin
for t := 0 to ControlCount -1 do
if Controls[t] is TEdit then with Controls[t] as TEdit do begin
x := FValues[Integer(TabOrder)];
if x > 0 then y := x - z else y := 0;
text := inttostr(y);
if comparestr(text, '0') = 0 then text := '' else z := x;
end;
end;
end;
procedure TWeightingSystem.SaveFromArray (A : array of integer);
var t : integer;
begin
for t := 0 to High(A) do FValues[t] := A[t];
end;
procedure TWeightingSystem.LoadToArray (var A : array of integer);
var t : Integer;
begin
for t := 0 to High(A) do A[t] := FValues[t];
end;
function TWeightingSystem.Choose (KMin, KMax : Integer) : Integer;
var p: Integer; yes: Boolean; t,lo,hi: Integer;
begin
Result := -1; //this represents an erroneous result
t := KMax; hi := FValues[t];
while (hi = 0) and (t > 0) do begin
dec(t); hi := FValues[t];
end;
t := KMin; lo := FValues[t];
while (lo = 0) and (t > 0) do begin
dec(t); lo := FValues[t];
end;
if hi = 0 then exit; // there are no selectable values : return error
if lo = 0 then inc(lo);
p := trunc(random(hi - lo + 1)) + lo; yes := true;
for t := KMin to KMax do begin
if (FValues[t] >= p) and (yes) then begin
yes := false;
Result := t;
end;
end;
if Result > -1 then FChosen := Result;
end;
procedure TWeightingSystem.Initialize (X : Integer);
var t : Integer;
begin
for t := 0 to 127 do FValues[t] := t * X;
end;
procedure TWeightingSystem.InputWeightings(Min : Integer = 0; Max : Integer = 127; ShowRulers : Boolean = False);
var
ADialogBox : TWSDialog; t : Integer;
begin
ADialogBox := TWSDialog.Create(nil);
try
ADialogBox.CategoryLabel.Caption := Title;
ADialogBox.DescriptionLabel.Caption := Description;
ADialogBox.PitchRuler.Visible := ShowRulers;
ADialogBox.OctaveRuler.Visible := ShowRulers;
LoadToPanel(ADialogBox.DataPanel);
for t := 0 to ADialogBox.DataPanel.ControlCount - 1 do begin
if ADialogBox.DataPanel.Controls[t] is TLabel then begin
if strtoint(TLabel(ADialogBox.DataPanel.Controls[t]).Caption) < Min then
TLabel(ADialogBox.DataPanel.Controls[t]).Visible := False;
if strtoint(TLabel(ADialogBox.DataPanel.Controls[t]).Caption) > Max then
TLabel(ADialogBox.DataPanel.Controls[t]).Visible := False;
end;
if ADialogBox.DataPanel.Controls[t] is TEdit then begin
if Integer(TEdit(ADialogBox.DataPanel.Controls[t]).TabOrder) < Min then
TEdit(ADialogBox.DataPanel.Controls[t]).Visible := False;
if Integer(TEdit(ADialogBox.DataPanel.Controls[t]).TabOrder) > Max then
TEdit(ADialogBox.DataPanel.Controls[t]).Visible := False;
end;
end;
//resize and centre the panels
//
if (ADialogBox.ShowModal = IDOK) then begin
SaveFromPanel(ADialogBox.DataPanel);
end;
finally
ADialogBox.Free;
end;
end;
//TMidiArray Musical Data Transformation Methods
procedure TMidiArray.Reverse(pitch : boolean = true; duration : boolean = true; amplitude : boolean = true; Probability : Single = 1);
var t,g : Integer; r : single;
begin
for t := 0 to (PhraseLength div 2) do
begin
r := random;
if (pitch) and (probability > r) then
begin
g := FPitches[t];
FPitches[t] := FPitches[PhraseLength - t];
FPitches[PhraseLength - t] := g;
end;
r := random;
if (duration) and (probability > r) then
begin
g := FDurations[t];
FDurations[t] := FDurations[PhraseLength - t];
FDurations[PhraseLength - t] := g;
end;
r := random;
if (amplitude) and (probability > r) then
begin
g := FAmplitudes[t];
FAmplitudes[t] := FAmplitudes[PhraseLength - t];
FAmplitudes[PhraseLength - t] := g;
end;
end;
end;
procedure TMidiArray.Invert(Min : Integer = 40; Max : Integer = 100; Probability : Single = 1);
var t,n : Integer; A : Array of Integer; ShiftDown : Boolean; ShiftUp : Boolean;
begin
ShiftDown := false; ShiftUp := false;
SetLength(A, PhraseLength + 1);
A[0] := FPitches[0];
if PhraseLength > 0 then
begin
for t := 1 to PhraseLength do
begin
if probability > random
then A[t] := A[t-1] - (FPitches[t] - FPitches[t-1])
else A[t] := A[t-1] + (FPitches[t] - FPitches[t-1]);
if A[t] < Min then ShiftUp := true; //move whole phrase up the octave
if A[t] > Max then ShiftDown := true;
end;
end;
for t := 0 to PhraseLength do
begin
n := A[t];
if (ShiftDown) and (n > (Min + 12)) then n := n - 12;
if (ShiftUp) and (n < (Max - 12)) then n := n + 12;
FPitches[t] := n;
end;
end;
procedure TMidiArray.MutatePitch(Probability : Single; RangeUp : Integer = 1; RangeDown : Integer = 1);
var t : Integer;
begin
for t := 0 to PhraseLength do
begin
if random < Probability then FPitches[t] := FPitches[t] + trunc(random(RangeUp + 1)) - trunc(random(RangeDown + 1));
end;
end;
procedure TMidiArray.MutateDuration(Probability : Single; RangeUp : Integer = 50; RangeDown : Integer = 50);
var t : Integer;
begin
for t := 0 to PhraseLength do
begin
if random < Probability then FDurations[t] := FDurations[t] + trunc(random(RangeUp + 1)) - trunc(random(RangeDown + 1));
end;
end;
procedure TMidiArray.MutateAmplitude(Probability : Single; RangeUp : Integer = 10; Rangedown : Integer = 10);
var t : Integer;
begin
for t := 0 to PhraseLength do
begin
if random < Probability then FAmplitudes[t] := FAmplitudes[t] + trunc(random(RangeUp + 1)) - trunc(random(RangeDown + 1));
end;
end;
procedure TMidiArray.Shuffle(Probability : Single = 1; Pitch : Boolean = true; Duration : Boolean = true; Amplitude : Boolean = true; AttributesIndependent : Boolean = false);
var t,g,p,d,a : Integer; r : single;
begin
for t := 0 to PhraseLength do
begin
p := FPitches[t];
d := FDurations[t];
a := FAmplitudes[t];
g := trunc(random(PhraseLength +1));
r := random;
if (pitch) and (probability > r) then
begin
FPitches[t] := FPitches[g];
FPitches[g] := p;
end;
if AttributesIndependent then //if true then do pitch/dur/amp separately (including own chance decision)
begin
g := trunc(random(PhraseLength +1));
r := random;
end;
if (duration) and (probability > r) then
begin
FDurations[t] := FDurations[g];
FDurations[g] := d;
end;
if AttributesIndependent then
begin
g := trunc(random(PhraseLength +1));
r := random;
end;
if (amplitude) and (probability > r) then
begin
FAmplitudes[t] := FAmplitudes[g];
FAmplitudes[g] := a;
end;
end;
end;
procedure TMidiArray.Transpose(TransposeFactor : Integer = 1; Min : Integer = 30; Max : Integer = 100; Probability : Single = 1); //negative values equal transpose DOWN
var t : Integer;
begin
for t := 0 to PhraseLength do
begin
if probability > random then FPitches[t] := FPitches[t] + TransposeFactor;
if FPitches[t] > Max then FPitches[t] := Max; //hard limits
if FPitches[t] < Min then FPitches[t] := Min;
end;
end;
procedure TMidiArray.Stretch(SpeedPercent : Integer = 90; Probability : Single = 1);
var t : Integer;
begin
for t := 0 to PhraseLength do
begin
if probability > random then
FDurations[t] := trunc(FDurations[t] * (1 / SpeedPercent * 100));
if FDurations[t] < 5 then FDurations[t] := 5; //hard lower limit to protect timer
end;
end;
procedure TMidiArray.RotateLeft(RotateFactor : Integer = 1);
var t,p,d,a : Integer;
begin //rotate the array (circular)
while RotateFactor > 0 do
begin
p := FPitches[0];
d := FDurations[0];
a := FAmplitudes[0];
for t := 0 to (PhraseLength - 1) do
begin
FPitches[t] := FPitches[t+1];
FDurations[t] := FDurations[t+1];
FAmplitudes[t] := FAmplitudes[t+1];
end;
FPitches[PhraseLength] := p;
FDurations[PhraseLength] := d;
FAmplitudes[PhraseLength] := a;
dec(RotateFactor);
end;
end;
procedure TMidiArray.RotateRight(RotateFactor : Integer = 1);
var t,p,d,a : Integer;
begin
while RotateFactor > 0 do
begin
p := FPitches[PhraseLength];
d := FDurations[PhraseLength];
a := FAmplitudes[PhraseLength];
for t := PhraseLength downto 1 do
begin
FPitches[t] := FPitches[t-1];
FDurations[t] := FDurations[t-1];
FAmplitudes[t] := FAmplitudes[t-1];
end;
FPitches[0] := p;
FDurations[0] := d;
FAmplitudes[0] := a;
dec(RotateFactor);
end;
end;
procedure TMidiArray.RandomisePitch(Min : Integer = 40; Max : Integer = 90; Probability : Single = 1);
var t : Integer;
begin
for t := 0 to PhraseLength do
if probability > random then FPitches[t] := trunc(random(Max - Min + 1)) + Min;
end;
procedure TMidiArray.RandomiseDuration(Min : Integer = 100; Max : Integer = 1200; UnitSize : Integer = 100; Probability : Single = 1);
var t,g : Integer;
begin
for t := 0 to PhraseLength do
begin
g := trunc(random(Max - Min + 1)) + Min;
g := g - (g mod UnitSize);
if probability > random then FDurations[t] := g;
end;
end;
procedure TMidiArray.RandomiseAmplitude(Min : Integer = 40; Max : Integer = 127; Probability : Single = 1);
var t : integer;
begin
for t := 0 to PhraseLength do
if probability > random then FAmplitudes[t] := trunc(random(Max - Min + 1)) + Min;
end;
procedure TMidiArray.MakeRandomToneRow(Octave : Integer);
var t : Integer;
begin
Clear;
for t := 0 to 11 do
begin
AddNote(t + (12 * Octave),400);
end;
Shuffle(1,True,False,False,False);
RandomiseDuration;
RandomiseAmplitude;
end;
procedure TMidiArray.MakeRandomToneRow; //random octaves
var t, Octave : Integer;
begin
Clear;
for t := 0 to 11 do
begin
Octave := trunc(random(4)) + 4;
AddNote(t + (12 * Octave),400);
end;
Shuffle(1,True,False,False,False);
RandomiseDuration;
RandomiseAmplitude;
end;
procedure TMidiArray.Dilate(IntervalWideningFactor : Integer = 1; Min : Integer = 40; Max : Integer = 100; Probability : Single = 1);
var t,n,g : Integer; A : Array of Integer; ShiftDown : Boolean; ShiftUp : Boolean;
begin
ShiftDown := false; ShiftUp := false;
SetLength(A, PhraseLength + 1);
A[0] := FPitches[0];
if PhraseLength > 0 then
begin
for t := 1 to PhraseLength do
begin
g := (FPitches[t] - FPitches[t-1]);
if g < 0 then g := g - IntervalWideningFactor;
if g > 0 then g := g + IntervalWideningFactor;
A[t] := A[t-1] + g;
if A[t] < Min then ShiftUp := true; //move whole phrase up the octave
if A[t] > Max then ShiftDown := true;
end;
end;
for t := 0 to PhraseLength do
begin
n := A[t];
if (ShiftDown) and (n > (Min + 12)) then n := n - 12;
if (ShiftUp) and (n < (Max - 12)) then n := n + 12;
FPitches[t] := n;
end;
end;
procedure TMidiArray.FoxTransform(Pitches : Array of Integer);
var t,g,h,x,y : Integer; temp : array of Integer;
begin
t := high(pitches);
g := phraselength;
if t < g then g := t; // if the passed array is smaller, don't overrun it
SetLength(temp, g + 1);
for t := 0 to g do
begin
x := FPitches[t] mod 12;
for h := 0 to g do
begin
y := Pitches[h] mod 12;
if y = x then temp[t] := FPitches[h];
end;
end;
for t := 0 to g do
begin
FPitches[t] := temp[t];
end;
temp := nil;
end;
procedure TMidiArray.FoxTransform(ChromaticScaleOf : Integer);
var t,g,h,x,y : Integer; temp : array of Integer;
begin
g := phraselength;
SetLength(temp, g + 1);
for t := 0 to g do
begin
x := FPitches[t] mod 12;
for h := 0 to g do
begin
y := (ChromaticScaleOf + h) mod 12;
if y = x then temp[t] := FPitches[h];
end;
end;
for t := 0 to g do
begin
FPitches[t] := temp[t];
end;
temp := nil;
end;
end.