unit ToneFrm;

interface

uses
  Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  StdCtrls, ExtCtrls, ComCtrls,Math, Buttons, ToneGen, IniObj;

type
  TDemoType = (deUser, deMorse, deAlarm, deVolumePan, deTune, deRandom);

  //data used for demos
  DemoData=record
    Wave: TTGWave;
    Dur: Integer;
    Freq: Integer;
    A,D,S,R: Integer;
    Reps: Integer;
  end;


  TToneForm = class(TForm)
    RadioGroup1: TRadioGroup;
    RadioGroup2: TRadioGroup;
    UpDown1: TUpDown;
    Edit1: TEdit;
    Label1: TLabel;
    RadioGroup3: TRadioGroup;
    Edit2: TEdit;
    UpDown2: TUpDown;
    Label2: TLabel;
    LoopCheckBox: TCheckBox;
    AsyncCheckBox: TCheckBox;
    TrackBar1: TTrackBar;
    TrackBar2: TTrackBar;
    TrackBar3: TTrackBar;
    TrackBar4: TTrackBar;
    Label7: TLabel;
    Panel1: TPanel;
    Label3: TLabel;
    Panel2: TPanel;
    Label4: TLabel;
    Panel3: TPanel;
    Label5: TLabel;
    Panel4: TPanel;
    TrackBar5: TTrackBar;
    TrackBar6: TTrackBar;
    Label6: TLabel;
    PlayToneButton: TButton;
    Button7: TButton;
    PlayADSRButton: TButton;
    StopButton: TButton;
    RandomButton: TButton;
    MorseButton: TButton;
    Timer2: TTimer;
    AlarmButton: TButton;
    Timer3: TTimer;
    VolumePanButton: TButton;
    TuneButton: TButton;
    GroupBox2: TGroupBox;
    Label9: TLabel;
    Label8: TLabel;
    Bevel1: TBevel;
    Bevel3: TBevel;
    Label10: TLabel;
    Bevel2: TBevel;
    Button1: TButton;
    Button2: TButton;
    IniObject: TIniObject;
    ToneStyleRadioGroup: TRadioGroup;
    ToneShapeRadioGroup: TRadioGroup;
    OKButton: TButton;
    UseToneFormCheckBox: TCheckBox;
    BeeperDisabledCheckBox: TCheckBox;
    procedure Button1Click(Sender: TObject);
    procedure TrackBar1Change(Sender: TObject);
    procedure FormActivate(Sender: TObject);
    procedure LoopCheckBoxClick(Sender: TObject);
    procedure FormPaint(Sender: TObject);
    procedure FormCreate(Sender: TObject);
    procedure FormDestroy(Sender: TObject);
    procedure TrackBar5Change(Sender: TObject);
    procedure TrackBar6Change(Sender: TObject);
    procedure PlayToneButtonClick(Sender: TObject);
    procedure Button7Click(Sender: TObject);
    procedure StopButtonClick(Sender: TObject);
    procedure PlayADSRButtonClick(Sender: TObject);
    procedure RandomButtonClick(Sender: TObject);
    procedure MorseButtonClick(Sender: TObject);
    procedure Timer2Timer(Sender: TObject);
    procedure AlarmButtonClick(Sender: TObject);
    procedure Timer3Timer(Sender: TObject);
    procedure VolumePanButtonClick(Sender: TObject);
    procedure TuneButtonClick(Sender: TObject);
    procedure Button2Click(Sender: TObject);
    procedure FormClose(Sender: TObject; var Action: TCloseAction);
  private
    { Private declarations }
    FPlaying: boolean;
  public
    { Public declarations }
    CurDemo: TDemoType;
    procedure PlayStyle(Demo: TDemoType);
    procedure Play;
    procedure Stop;
  end;

var
  DD: array [TDemoType{0 .. 9}] of DemoData;
//  Demo: TDemoType;
  PanRight: bool;
  //tune data
  notes: array [0..13] of Smallint=(0,0,7,7,9,9,7,5,5,4,4,2,2,0);
  //note intervals
  interval: array[0..13] of Smallint=(500,500,500,500,500,500,1000,500,500,500,500,500,500,500);
  notepos: Integer;

function ToneForm: TToneForm;
implementation

{$R *.DFM}
const
  FToneForm: TToneForm = nil;

function ToneForm: TToneForm;
begin
  if FToneForm = nil then begin
    Application.CreateForm(TToneForm, FToneForm);
  end;
  Result := FToneForm;
end;

//exit
procedure TToneForm.Button1Click(Sender: TObject);
begin
  Close;
end;

//setup demo parameters
procedure SetDemo(ID: TDemoType);
begin
//set data
  with TheToneGen do begin
    Frequency :=DD[ID].Freq;
    Duration :=DD[ID].Dur;
    Waveform :=DD[ID].Wave;
    Attack :=DD[ID].A;
    Decay :=DD[ID].D;
    Sustain :=DD[ID].S;
    Release :=DD[ID].R;


    Loop := ToneForm.LoopCheckbox.Checked;
    Async := ToneForm.AsyncCheckbox.Checked;

{    if ID <> deRandom then begin
      Loop:= false;
      Async:=true;
    end else begin
      Loop := ToneForm.LoopCheckbox.Checked;
      Async := ToneForm.AsyncCheckbox.Checked;
    end;
}
  end;

//setup controls
  with ToneForm do begin
     Edit2.Text:=IntToStr(DD[ID].Freq);
     Edit1.Text:=IntToStr(DD[ID].Dur);
     Trackbar1.Position:=100-DD[ID].A;
     Trackbar2.Position:=100-DD[ID].D;
     Trackbar3.Position:=100-DD[ID].S;
     Trackbar4.Position:=100-DD[ID].R;
     Radiogroup3.ItemIndex:=Integer(DD[ID].Wave);
   end;

   ToneForm.Timer2.Enabled:=false;
   ToneForm.Timer3.Enabled:=false;

   //random
   if ID <> deRandom then begin
     ToneForm.Timer2.Enabled:=true;
   end;

  if ( (ID = deRandom) and TheToneGen.Loop) or (ID <> deRandom) then
    ToneForm.Timer3.Enabled:=true;

  ToneForm.Timer3.Interval := 5000;

//tune
  if ID = deTune then
    ToneForm.Timer3.Interval:=10000;

end;


//draw envelope graphic
procedure RedrawADSR;
var
   bleft,btop,apos,dpos,spos,rpos,wdth,hgt,total: Integer;
   xs,xe,ys,ye: Integer;
   fmc: TCanvas;

begin

with ToneForm do
    begin
    wdth:=Bevel1.Width-1;
    hgt:=Bevel1.Height-1;
    bleft:=Bevel1.Left+1;
    btop:=Bevel1.Top+1;

    fmc:= ToneForm.Canvas;

    apos:=100-trackbar1.Position;
    dpos:=100-trackbar2.Position;
    spos:=trackbar3.Position;
    rpos:=100-trackbar4.Position;

    total:=apos+dpos+rpos;

    if total>100 then
       begin
       apos:=apos * 100 div total;
       dpos:=dpos * 100 div total;
       rpos:=rpos * 100 div total;
       end;


    //attack
    fmc.Pen.Color:=clRed;
    xs:=bleft;
    xe:=bleft+(wdth * apos div 100);
    ys:=btop+hgt;
    ye:=btop;
    fmc.MoveTo(xs,ys);
    fmc.LineTo(xe,ye);

    //decay
    fmc.Pen.Color:=clBlue;
    xe:=xe+(wdth * dpos div 100);
    ye:=btop+(hgt * spos div 100);
    fmc.LineTo(xe,ye);

    //sustain
    fmc.Pen.Color:=clGreen;
    if total<100 then
       begin
       xe:=(bleft+wdth)-(wdth * rpos div 100);
       fmc.LineTo(xe,ye);
       end;

    //release
    fmc.Pen.Color:=clNavy;
    xe:=bleft+wdth;
    ye:=btop+hgt;
    fmc.LineTo(xe,ye);

    end;

end;

procedure TToneForm.FormActivate(Sender: TObject);
begin

TrackBar1Change(nil);
end;

//set async state from loop
procedure TToneForm.LoopCheckBoxClick(Sender: TObject);
begin
  AsyncCheckBox.Enabled := not LoopCheckBox.Checked;
end;

//set ADSR
procedure TToneForm.TrackBar1Change(Sender: TObject);
var
   tb1,tb2,tb3,tb4,Total: Integer;

begin
  tb1 := 100-TrackBar1.Position;
  tb2 := 100-TrackBar2.Position;
  tb3 := 100-TrackBar3.Position;
  tb4 := 100-TrackBar4.Position;

  Total:=tb1+tb2+tb4;


  with TheToneGen do begin
     Attack:=tb1;
     Decay:=tb2;
     Sustain:=tb3;
     Release:=tb4;
   end;


  if Total>100 then begin
   tb1:=tb1 * 100 div Total;
   tb2:=tb2 * 100 div Total;
   tb4:=tb4 * 100 div Total;
  end;

  Panel1.Caption:=IntToStr(tb1)+'%';
  Panel2.Caption:=IntToStr(tb2)+'%';
  Panel3.Caption:=IntToStr(tb3)+'%';
  Panel4.Caption:=IntToStr(tb4)+'%';


  //update graphic
  Bevel2.Invalidate;
  Update;

end;

procedure TToneForm.FormPaint(Sender: TObject);
begin
  RedrawADSR;
end;

procedure TToneForm.FormCreate(Sender: TObject);
begin
  //set volume
  TrackBar5.Position:=100-TheToneGen.LeftVolume;
  TrackBar6.Position:=100-TheToneGen.RightVolume;

  Randomize;
  //initialise demo records
  //morse
  with DD[deMorse] do begin
    Freq:=440;
    Dur:=100;
    Wave:=tgSine;
    A:=0;
    D:=0;
    S:=100;
    R:=0;
  end;

  //alarm
  with DD[deAlarm] do begin
    Freq:=1500;
    Dur:=200;
    Wave:=tgTriangle;
    A:=0;
    D:=20;
    S:=80;
    R:=0;
  end;

  //pan
  with DD[deVolumePan] do begin
     Freq:=100;
     Dur:=100;
     Wave:=tgSquare;
     A:=10;
     D:=15;
     S:=75;
     R:=0;
  end;

  //tune
  with DD[deTune] do begin
     Freq:=500;
     Dur:=500;
     Wave:=tgSawtooth;
     A:=10;
     D:=15;
     S:=75;
     R:=16;
  end;

end;

procedure TToneForm.FormDestroy(Sender: TObject);
begin
  Stop;
end;

//left volume
procedure TToneForm.TrackBar5Change(Sender: TObject);
begin
TheToneGen.LeftVolume:=100-TrackBar5.Position;
end;

//right volume
procedure TToneForm.TrackBar6Change(Sender: TObject);
begin
TheToneGen.RightVolume:=100-TrackBar6.Position;
end;

//set component parameters from controls
procedure SetupTone;
begin
  with TheToneGen do begin
     Loop := ToneForm.LoopCheckBox.Checked;
     Async := ToneForm.AsyncCheckBox.Checked;
     Frequency:=StrToIntDef(ToneForm.Edit2.Text,440);
     Duration:=StrToIntDef(ToneForm.Edit1.Text,440);
     if ToneForm.RadioGroup2.ItemIndex=0 then
        Quality:=tgHiQ
     else
        Quality:=tgLoQ;

     if ToneForm.RadioGroup1.ItemIndex=0 then
        Resolution:=tg16Bit
     else
        Resolution:=tg8Bit;

     case ToneForm.RadioGroup3.ItemIndex of
          0: Waveform:=tgSine;
          1: Waveform:=tgSquare;
          2: Waveform:=tgTriangle;
          3: Waveform:=tgSawtooth;
          4: Waveform:=tgNoise;
     end;


     end;

end;

//paly tone
procedure TToneForm.PlayToneButtonClick(Sender: TObject);
begin
  Play;
end;

procedure TToneForm.Play;
begin
  if FPlaying then
    exit;
  PlayStyle(TDemoType(ToneStyleRadioGroup.ItemIndex));
end;

procedure TToneForm.PlayStyle(Demo: TDemoType);
begin
  Stop;
  ToneStyleRadioGroup.ItemIndex := Integer(Demo);
  CurDemo := Demo;
  case Demo of

    deUser: begin
      SetupTone;
      if ToneShapeRadioGroup.ItemIndex = 0 then
        TheToneGen.PlayADSR
      else
        TheToneGen.Play;
    end;

    deRandom: begin
      with DD[Demo] do begin
         Freq:=(10+random(1000))*10;
         Dur:=(10+random(90))*10;
         Wave:=TTGWave(random(5));
         A:=random(101);
         D:=random(101);
         S:=random(101);
         R:=random(101);
      end;

      {if random(2)>0 then
         LoopCheckbox.Checked:=true
      else
         LoopCheckbox.Checked:=false;}
      SetDemo(Demo);
      TheToneGen.PlayADSR;
    end;

    deTune: begin
      Notepos:=0;
      SetDemo(Demo);
    end;

    deVolumePan: begin
      TheToneGen.LeftVolume := 100;
      TheToneGen.RightVolume := 0;
      TheToneGen.PresetVolume;
      SetDemo(Demo);
      PanRight := true;
      Timer2.Interval := 200;
      Timer2.Enabled := true;
    end;

    deAlarm: begin
      Timer2.Interval:=400;
      SetDemo(Demo);
    end;

    deMorse: begin
      Timer2.Interval:=100+Random(300);
      SetDemo(Demo);
    end;
  else
    exit;
  end;
  FPlaying := true;
  StopButton.Enabled := true;
  PlayToneButton.Enabled := false;
end;

procedure TToneForm.Stop;
begin
  Timer2.Enabled:=false;
  Timer3.Enabled:=false;
  FPlaying := false;
  PlayToneButton.Enabled := true;
  StopButton.Enabled := false;
  with TheToneGen do begin
    Stop;
    //set volume after pan
    if CurDemo = deVolumePan then begin
      LeftVolume:=100;
      RightVolume:=100;
      Trackbar5.Position:=100-LeftVolume;
      Trackbar6.Position:=100-RightVolume;
    end;
  end;
end;


//set volume
procedure TToneForm.Button7Click(Sender: TObject);
begin
  TheToneGen.PresetVolume;
end;

//stop sound
procedure TToneForm.StopButtonClick(Sender: TObject);
begin
  Stop;
end;

//play ADSR
procedure TToneForm.PlayADSRButtonClick(Sender: TObject);
begin
  SetupTone;
  TheToneGen.PlayADSR;
end;

//random
procedure TToneForm.RandomButtonClick(Sender: TObject);
begin
  CurDemo := deRandom;

  with DD[CurDemo] do begin
     Freq:=(10+random(1000))*10;
     Dur:=(10+random(90))*10;
     Wave:=TTGWave(random(5));
     A:=random(101);
     D:=random(101);
     S:=random(101);
     R:=random(101);
  end;

//loop?
  {if random(2)>0 then
     LoopCheckbox.Checked:=true
  else
     LoopCheckbox.Checked:=false;
  }

  SetDemo(CurDemo);
  TheToneGen.PlayADSR;
end;

//morse
procedure TToneForm.MorseButtonClick(Sender: TObject);
begin
  CurDemo := deMorse;
  Timer2.Interval:=100+Random(300);
  SetDemo(CurDemo);
end;

//demo timer
procedure TToneForm.Timer2Timer(Sender: TObject);
var
   Base:Integer;

begin
  //morse
  if CurDemo = deMorse then begin
    Timer2.Interval := 50 + Random(300);
  end;

  //pan
  if CurDemo = deVolumePan then begin
    with TheToneGen do begin
      if PanRight then begin
         if RightVolume<100 then
            RightVolume:=RightVolume+50
         else
           if LeftVolume>0 then
             LeftVolume:=LeftVolume-50
           else
             PanRight:=false;
      end else begin
        if LeftVolume<100 then
          LeftVolume:=LeftVolume+50
        else
          if RightVolume>0 then
            RightVolume:=RightVolume-50
          else
            PanRight:=true;
      end;
      PresetVolume;
      Trackbar5.Position:=100-LeftVolume;
      Trackbar6.Position:=100-RightVolume;
    end;
  end;

//tune
  if CurDemo = deTune then begin
    if Notepos > 13 then
      Exit;
    //calculate frequency from note
    Base := 523;
    TheToneGen.Frequency:=Trunc(base * Power(2, notes[Notepos]/12));
    Timer2.Interval:=interval[notepos];
    Notepos:=Notepos+1;
  end;

  TheToneGen.PlayADSR;
end;

//alarm
procedure TToneForm.AlarmButtonClick(Sender: TObject);
begin
  CurDemo := deAlarm;
  Timer2.Interval:=400;
  SetDemo(CurDemo);
end;

//demo overall duration
procedure TToneForm.Timer3Timer(Sender: TObject);
begin
  if TheToneGen.Loop then
    exit;
  Stop;
{
  Timer3.Enabled:=false;
  Timer2.Enabled:=false;

  with ToneGen do begin
    Stop;
    //set volume after pan
    if Demo = deVolumePan then begin
      LeftVolume:=100;
      RightVolume:=100;
      Trackbar5.Position:=100-LeftVolume;
      Trackbar6.Position:=100-RightVolume;
    end;
  end;
  }
end;

//pan
procedure TToneForm.VolumePanButtonClick(Sender: TObject);
begin
  TheToneGen.LeftVolume := 100;
  TheToneGen.RightVolume := 0;
  TheToneGen.PresetVolume;

  CurDemo := deVolumePan;
  SetDemo(CurDemo);
  PanRight := true;
  Timer2.Interval := 200;
  Timer2.Enabled := true;
end;

//tune
procedure TToneForm.TuneButtonClick(Sender: TObject);
begin
  CurDemo := deTune;
  Notepos :=0;
  SetDemo(CurDemo);
end;

procedure TToneForm.Button2Click(Sender: TObject);
begin
  Application.HelpFile := ExtractFilePath(Application.ExeName)+'TTonegen.hlp';
  Application.HelpCommand(HELP_CONTENTS, 0);
end;

procedure TToneForm.FormClose(Sender: TObject; var Action: TCloseAction);
begin
  Stop;
end;

end.
