unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, sid_lib,
mmsystem, windows;
const
Channels = 1;
BitsPerSample = 16;
SampleRate = 44100; // Nombre d'Ă©chantillons par seconde
BufSize = 4096; // Taille du tampon audio x 2
BufferCount = 2;
type
{ TForm1 }
TForm1 = class(TForm)
Timer1: TTimer;
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
private
buffers: array[0..BufferCount-1] of array[0..BufSize-1] of SmallInt;
waveHeaders: array[0..BufferCount-1] of TWaveHdr;
currentBuffer: Integer;
public
end;
var
Form1: TForm1;
waveOut: HWAVEOUT;
sid_mus : pointer;
ok_flag: Boolean = false;
fsize : integer;
// sid
s_config : TSidConfig;
s_kernal,s_basic,s_chargen : Pointer;
implementation
{$R *.lfm}
procedure HandleError(const Str: PAnsiChar);
begin
if Str <> nil then
begin
ShowMessage('Error: ' + Str);
Halt(1);
end;
end;
procedure FillBuffer(bufferIndex: Integer);
var
GenSmp, NumSmp,sid_sng: Integer;
begin
if ok_flag then
begin
bufferIndex := Form1.currentBuffer;
NumSmp := BufSize div (Channels * (BitsPerSample div 16));
GenSmp := sid_play(@Form1.buffers[0][0],NumSmp) ;
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);
with wFormat do
begin
wFormatTag := WAVE_FORMAT_PCM;
nChannels := Channels;
nSamplesPerSec := SampleRate;
wBitsPerSample := BitsPerSample;
nBlockAlign := (wBitsPerSample * nChannels) div 8;
nAvgBytesPerSec := nSamplesPerSec * nBlockAlign;
cbSize := 0;
end;
if waveOutOpen(@waveOut, WAVE_MAPPER, @wFormat, QWORD(@WaveOutCallback), 0, CALLBACK_FUNCTION) <> MMSYSERR_NOERROR then
raise Exception.Create('Erreur lors de l''ouverture du périphérique audio');
// Préparation des tampons
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 := BufSize ;
dwFlags := 0;
FillBuffer(i);
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 LoadBinaryFileToBuffer(const FileName: string; var Buffer: TBytes);
var
MemoryStream: TMemoryStream;
begin
MemoryStream := TMemoryStream.Create;
try
MemoryStream.LoadFromFile(FileName);
SetLength(Buffer, MemoryStream.Size); //taille du buffer
MemoryStream.ReadBuffer(Buffer[0], MemoryStream.Size);
fsize := MemoryStream.Size;
finally
MemoryStream.Free;
end;
end;
procedure LoadBinaryFileToPointer(const FileName: Pchar; var Buffer: Pointer; var FileSize: Integer);
var
fs: TFileStream;
begin
// VĂ©rifier si le fichier existe if not FileExists(FileName) then
raise Exception.Create('Erreur : Fichier introuvable - ' + FileName);
fs := TFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
try
FileSize := fs.Size; // Taille du fichier
fsize := fs.Size;
GetMem(Buffer, FileSize);
fs.Read(Buffer^, FileSize);
finally
fs.Free;
end;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
Sid_buff: array of Byte;
// roms
k_buff : array of Byte;
b_buff : array of Byte;
c_buff : array of Byte;
sid_cr : Pointer;
sid_ld : Boolean;
sid_cfg : Boolean;
sid_sng : integer;
song_state : Boolean;
begin
try
// LoadBinaryFileToBuffer('Miami_vice.mus', Sid_buff); // buffer load
// LoadBinaryFileToBuffer('Miami_Vice.sid', Sid_buff); // buffer load
LoadBinaryFileToBuffer('gyruss.psid', Sid_buff); // buffer load
except
on E: Exception do
ShowMessage('Erreur : ' );
end;
// load c64 roms !
LoadBinaryFileToBuffer('kernal.901227-03.bin', k_buff);
LoadBinaryFileToBuffer('basic.901226-01.bin', b_buff);
LoadBinaryFileToBuffer('characters.901225-01.bin', c_buff);
sid_cr := sid_Create;
sid_ld := sid_load(Pchar(sid_Buff),fsize);
ShowMessage('config ok : ' );
sid_cfg := sid_Config();
end;
procedure TForm1.FormShow(Sender: TObject);
var
sid_sng : integer; // in case
begin
InitAudio;
ok_flag := true;
end;
procedure TForm1.Timer1Timer(Sender: TObject);
begin
end;
end.