fSoundAroundD.pas 4.8 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198
  1. unit fSoundAroundD;
  2. interface
  3. uses
  4. System.Classes,
  5. System.SysUtils,
  6. System.Math,
  7. Vcl.Forms,
  8. Vcl.ExtCtrls,
  9. Vcl.ComCtrls,
  10. Vcl.Controls,
  11. Vcl.StdCtrls,
  12. GLS.Scene,
  13. Stage.VectorTypes,
  14. GLS.Objects,
  15. GLS.Cadencer,
  16. Stage.VectorGeometry,
  17. GLS.SceneViewer,
  18. GLS.GeomObjects,
  19. GLS.SoundManager,
  20. GLS.Sounds.FMOD,
  21. GLS.Sounds.BASS,
  22. GLS.Sounds.OpenAL,
  23. GLS.Sounds.WaveOut,
  24. GLS.FileWAV,
  25. GLS.FileMP3,
  26. GLS.Coordinates,
  27. GLS.BaseClasses,
  28. Stage.Utils
  29. ;
  30. type
  31. TFormSoundAround = class(TForm)
  32. GLScene: TGLScene;
  33. GLSceneViewer: TGLSceneViewer;
  34. GLCamera1: TGLCamera;
  35. DummyCube: TGLDummyCube;
  36. Sphere: TGLSphere;
  37. GLLightSource: TGLLightSource;
  38. GLSoundLibrary: TGLSoundLibrary;
  39. GLSMBASS: TGLSMBASS;
  40. GLSMFMOD: TGLSMFMOD;
  41. GLSMOpenAL: TGLSMOpenAL;
  42. GLCadencer1: TGLCadencer;
  43. Timer: TTimer;
  44. Mickey: TGLSphere;
  45. Sphere2: TGLSphere;
  46. Sphere3: TGLSphere;
  47. Cone1: TGLCone;
  48. TrackBar: TTrackBar;
  49. Plane1: TGLPlane;
  50. Disk1: TGLDisk;
  51. Torus1: TGLTorus;
  52. TrackBar1: TTrackBar;
  53. Panel1: TPanel;
  54. Label1: TLabel;
  55. RBBass: TRadioButton;
  56. RBFMOD: TRadioButton;
  57. Button1: TButton;
  58. btnHowl: TButton;
  59. RBOpenAL: TRadioButton;
  60. LabelFPS: TLabel;
  61. procedure SphereProgress(Sender: TObject; const deltaTime, newTime: Double);
  62. procedure TimerTimer(Sender: TObject);
  63. procedure TrackBarChange(Sender: TObject);
  64. procedure TrackBar1Change(Sender: TObject);
  65. procedure FormCreate(Sender: TObject);
  66. procedure RBFMODClick(Sender: TObject);
  67. procedure Button1Click(Sender: TObject);
  68. procedure btnHowlClick(Sender: TObject);
  69. private
  70. Path: TFileName;
  71. public
  72. end;
  73. var
  74. FormSoundAround: TFormSoundAround;
  75. implementation
  76. {$R *.DFM}
  77. procedure TFormSoundAround.FormCreate(Sender: TObject);
  78. begin
  79. Path := GetCurrentAssetPath() + '\audio';
  80. SetCurrentDir(Path);
  81. // Load our sound samples
  82. GLSoundLibrary.Samples.AddFile('drumloop.wav', 'drumloop.wav');
  83. GLSoundLibrary.Samples.AddFile('chimes.wav', 'chimes.wav');
  84. GLSoundLibrary.Samples.AddFile('howl.mp3', 'howl.mp3');
  85. end;
  86. procedure TFormSoundAround.SphereProgress(Sender: TObject;
  87. const deltaTime, newTime: Double);
  88. var
  89. alpha: Single;
  90. begin
  91. // Move the red sphere (sound source) along an elliptic path
  92. alpha := 60 * DegToRad(newTime);
  93. TGLSphere(Sender).Position.SetPoint(sin(alpha) * 2, 0.5, cos(alpha) * 5);
  94. end;
  95. procedure TFormSoundAround.TrackBarChange(Sender: TObject);
  96. begin
  97. // Rotate the listener around the vertical axis
  98. DummyCube.TurnAngle := TrackBar.Position;
  99. Application.ProcessMessages;
  100. end;
  101. procedure TFormSoundAround.TrackBar1Change(Sender: TObject);
  102. begin
  103. // Move the listener forward/back
  104. Mickey.Position.Z := TrackBar1.Position / 10;
  105. Application.ProcessMessages;
  106. end;
  107. procedure TFormSoundAround.Button1Click(Sender: TObject);
  108. begin
  109. with TGLBSoundEmitter.Create(Sphere.Behaviours) do
  110. begin
  111. Source.SoundLibrary := GLSoundLibrary;
  112. Source.SoundName := 'chimes.wav';
  113. Playing := True;
  114. end;
  115. end;
  116. procedure TFormSoundAround.TimerTimer(Sender: TObject);
  117. var
  118. mngName: String;
  119. begin
  120. // some stats
  121. if ActiveSoundManager is TGLSMBASS then
  122. mngName := 'BASS'
  123. else if ActiveSoundManager is TGLSMFMOD then
  124. mngName := 'FMOD'
  125. else if ActiveSoundManager is TGLSMOpenAL then
  126. mngName := 'OpenAL'
  127. else
  128. mngName := '';
  129. if ActiveSoundManager <> nil then
  130. LabelFPS.Caption := Format('%.2f FPS, %s CPU use : %.2f%%',
  131. [GLSceneViewer.FramesPerSecond, mngName,
  132. ActiveSoundManager.CPUUsagePercent])
  133. else
  134. LabelFPS.Caption := 'No active sound manager.';
  135. GLSceneViewer.ResetPerformanceMonitor;
  136. end;
  137. procedure TFormSoundAround.RBFMODClick(Sender: TObject);
  138. var
  139. newManager: TGLSoundManager;
  140. begin
  141. // This method switches managers. On a real world project, this would never
  142. // happen: you would choose an API and then cling to it, but the GLSS
  143. // completely wraps the underlying complexity and makes it a snap
  144. if RBFMOD.Checked then
  145. begin
  146. newManager := GLSMFMOD;
  147. btnHowl.Enabled := true;
  148. end
  149. else if RBBass.Checked then
  150. begin
  151. newManager := GLSMBASS;
  152. btnHowl.Enabled := true;
  153. end
  154. else
  155. begin
  156. newManager := GLSMOpenAL;
  157. btnHowl.Enabled := false; // mp3 not supported
  158. end;
  159. if newManager <> ActiveSoundManager then
  160. begin
  161. // shut down current one, and activate the new one
  162. if ActiveSoundManager <> nil then
  163. ActiveSoundManager.Active := false;
  164. if newManager <> nil then
  165. newManager.Active := true;
  166. // restart sound
  167. GetOrCreateSoundEmitter(Sphere).Playing := true;
  168. end;
  169. end;
  170. procedure TFormSoundAround.btnHowlClick(Sender: TObject);
  171. begin
  172. with TGLBSoundEmitter.Create(Sphere.Behaviours) do
  173. begin
  174. Source.SoundLibrary := GLSoundLibrary;
  175. Source.SoundName := 'howl.mp3';
  176. Playing := True;
  177. end;
  178. end;
  179. end.