unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,
windows, mmsystem, ayfly;
const
REPLAY_RATE = 44100;
CHANNELS = 2;
REPLAY_DEPTH = 16;
BuffSize = 32768; // multiple of 2
BufferCount = 2;
type
{ TForm1 }
TForm1 = class(TForm)
Button1: TButton;
Button2: TButton;
Memo1: TMemo;
Memo2: TMemo;
Timer1: TTimer;
procedure Button1Click(Sender: TObject);
procedure Button2Click(Sender: TObject);
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
buffers: array[0..BufferCount-1] of array[0..BuffSize-1] of Byte;
waveHeaders: array[0..BufferCount-1] of TWaveHdr;
currentBuffer: Integer;
public
end;
var
Form1: TForm1;
waveOut: HWAVEOUT;
waveHeader: TWaveHdr;
playing: Boolean = false;
// ayfly
songInfo: PAYSongInfo;
implementation
{$R *.lfm}
{ TForm1 }
/// audio init et le reste !!
procedure HandleError(const Str: PAnsiChar);
begin
if Str <> nil then
begin
ShowMessage('Error: Wrong Format ? '+ Str);
Halt(1);
end;
end;
procedure FillBuffer(bufferIndex: Integer);
begin
if playing then
begin
//le buffer avec des données audio
bufferIndex := Form1.currentBuffer;
ay_rendersongbuffer(songInfo, @Form1.buffers[bufferIndex][0], BuffSize * SizeOf(Byte) );
end;
end;
function WaveOutCallback(hwo: HWAVEOUT; uMsg: UINT; dwInstance, dwParam1, dwParam2: DWORD_PTR): DWORD; stdcall;
begin
if uMsg = WOM_DONE then
begin
FillBuffer(Form1.currentBuffer);
waveOutWrite(waveOut, @Form1.waveHeaders[Form1.currentBuffer], SizeOf(TWaveHdr));
Form1.currentBuffer := (Form1.currentBuffer + 1) mod BufferCount;
end;
Result := 0;
end;
procedure InitAudio;
var
wFormat: TWaveFormatEx;
i: Integer;
begin
// SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_LOWEST); // if needed
with wFormat do
begin
wFormatTag := WAVE_FORMAT_PCM; // 1
nChannels := CHANNELS; // stereo 2
nSamplesPerSec := REPLAY_RATE; // 44100
wBitsPerSample := REPLAY_DEPTH; // 16 bits
nBlockAlign := nChannels * (wBitsPerSample div 8); // Taille echantillon
nAvgBytesPerSec := nSamplesPerSec * nBlockAlign;
cbSize := 0;
end;
if waveOutOpen(@waveOut, WAVE_MAPPER, @wFormat, QWORD(@WaveOutCallback), 0, CALLBACK_FUNCTION) <> MMSYSERR_NOERROR then
ShowMessage('Error: Audio initialization failed');
// buffers
for i := 0 to BufferCount - 1 do
begin
ZeroMemory(@Form1.waveHeaders[i], SizeOf(TWaveHdr));
with Form1.waveHeaders[i] do
begin
lpData := @Form1.buffers[i][0];
dwBufferLength := BuffSize * SizeOf(Byte);
dwFlags := 0 ;
end;
waveOutPrepareHeader(waveOut, @Form1.waveHeaders[i], SizeOf(TWaveHdr));
end;
Form1.currentBuffer := 0;
for i := 0 to BufferCount - 1 do
begin
FillBuffer(i);
waveOutWrite(waveOut, @Form1.waveHeaders[i], SizeOf(TWaveHdr));
end;
end;
procedure CloseAudio;
begin
waveOutUnprepareHeader(waveOut, @waveHeader, SizeOf(TWaveHdr));
waveOutClose(waveOut);
end;
procedure TForm1.FormCreate(Sender: TObject);
begin
// Init song Turbo-sound 2xAy chips for this song !! 6 channels
SongInfo := ay_initsong('Yerzmyey - 5 New Linel.pt3', REPLAY_RATE,SongInfo);
end;
procedure TForm1.Button1Click(Sender: TObject); // AY = 0
begin
ay_setchiptype(Songinfo,0);
end;
procedure TForm1.Button2Click(Sender: TObject); // YM = 1
begin
ay_setchiptype(Songinfo,1);
end;
procedure TForm1.FormShow(Sender: TObject);
begin
InitAudio;
playing := true;
// song infos
Memo1.Clear;
Memo1.Lines.Add('Song Name : ' + (SongInfo^.Name));
Memo1.Lines.Add('Song Author : ' + (SongInfo^.Author));
Memo1.Lines.Add('Song Compiler : ' + (SongInfo^.CompName));
Memo1.Lines.Add('Song Len : ' + IntToStr(SongInfo^.Length));
Memo1.Lines.Add('Song Loop Pos : ' + IntToStr(SongInfo^.Loop));
Memo1.Lines.Add('Number Of Song : ' + IntToStr(SongInfo^.NumSongs));
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
Memo2.Clear;
If playing then
begin
Memo2.Lines.Add('Elapsed Time : '+ IntToStr(ay_getelapsedtime(SongInfo) div 50));
end;
end;
// If subsongs exist then Songinfo^.CurrentSong = subsong number;
// ay_resetsong(SongInfo);
end.
Recent
