unit Unit1;
{$mode objfpc}{$H+}
interface
uses
Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,
sc68, mmsystem, windows ;
const
Channels = 2;
BitsPerSample = 16;
SampleRate = 44100; // number of samples per second
BufSize = 8192 ; // multiple of 2
BufferCount = 2;
type
{ TForm1 }
TForm1 = class(TForm)
Label1: TLabel;
Memo1: TMemo;
Timer1: TTimer;
procedure FormCreate(Sender: TObject);
procedure FormShow(Sender: TObject);
procedure Timer1Timer(Sender: TObject);
procedure Process_SC68(BufferIndex: Integer);
procedure CloseAudio;
private
buffers: array[0..BufferCount-1] of array[0..BufSize-1] of byte;
waveHeaders: array[0..BufferCount-1] of TWaveHdr;
currentBuffer: Integer;
Music_Finished: Boolean;
public
end;
var
Form1: TForm1;
waveOut: HWAVEOUT;
waveHeader: TWaveHdr;
fsize : integer;
// sc68
sc_init: Tsc68Init;
sc_cr: Tsc68Create;
sc_inst : Pointer;
sc_code : Tsc68Code;
sc_minfos : Tsc68MusicInfo ; // music infos
sc_cinfos : Tsc68CInfo;
sc_disc : Tsc68Disk;
sc_play : Tsc68Play;
SC68Instance: Psc68;
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;
function WaveOutCallback(hwo: HWAVEOUT; uMsg: UINT; dwInstance, dwParam1, dwParam2: DWORD_PTR): DWORD; stdcall;
begin
if uMsg = WOM_DONE then
begin
Form1.Process_SC68(Form1.currentBuffer);
waveOutWrite(hwo, @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_TIME_CRITICAL);
with wFormat do
begin
wFormatTag := 1; // 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 ouverture periph audio');
// buffers init
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 * SizeOf(Byte);
dwFlags := 0;
end;
waveOutPrepareHeader(waveOut, @Form1.waveHeaders[i], SizeOf(TWaveHdr));
waveOutWrite(waveOut, @Form1.waveHeaders[i], SizeOf(TWaveHdr));
end;
Form1.currentBuffer := 0;
end;
procedure TForm1.FormCreate(Sender: TObject);
var
FileName: string;
appname: array[0..8] of Char = 'Lazarus'#0;
argv: array[0..0] of PChar;
begin
// Initialise les paramètres SC68 un cauchemar !!!!
FillChar(sc_init, SizeOf(Tsc68Init), 0);
argv[0] := appname;
sc_init.argc := Length(argv);
sc_init.argv := @argv[0];
sc_init.Flags.NoLoadConfig:=false;
FileName := 'madness.sc68';
sc_init.sampling_rate := 44100;
// Initialisation de SC68
if sc68_init(sc_init) < 0 then
begin
ShowMessage('Erreur d''initialisation SC68');
Exit;
end;
// instance SC68
FillChar(sc_cr, SizeOf(sc_cr), 0);
sc_cr.SamplingRate := 44100;
sc_cr.Name := PChar('Lazarus'#0);
SC68Instance := sc68_create(sc_cr);
if SC68Instance = nil then
begin
ShowMessage('Erreur lors de la creation de l''instance SC68');
Exit;
end;
// Charge le fichier SC68 ;
if sc68_load_uri(SC68Instance, pchar(Filename)) = 0 then
ShowMessage('file '+ Filename + ' Loaded to sc68 memory')
else
ShowMessage('ERROR: Unable to Load File into sc68 memory ' );
// get music information first and then get number of track
sc68_music_info(SC68Instance,sc_minfos,0,sc_disc);
// Force track number if >1 ; set to 2 ;
if sc_minfos.Tracks>1 then
sc68_play(SC68Instance,2,0) // madness has 3 tracks , no-loop else 1
else
sc68_play(SC68Instance,-1,0); // default track
end;
procedure TForm1.FormShow(Sender: TObject);
begin
Music_Finished := false;
InitAudio;
sc68_music_info(SC68Instance,sc_minfos,0,sc_disc);
memo1.clear;
memo1.Lines.Add( Pchar(sc_minfos.Album));
memo1.Lines.Add( Pchar(sc_minfos.Title));
memo1.Lines.Add( Pchar(sc_minfos.Artist));
memo1.Lines.Add( Pchar(sc_minfos.Format));
memo1.Lines.Add( Pchar(sc_minfos.Genre));
memo1.Lines.Add( Pchar(sc_minfos.Year));
memo1.Lines.Add( Pchar(sc_minfos.Ripper));
memo1.Lines.Add( Pchar(sc_minfos.Converter));
memo1.Lines.Add( Pchar(sc_minfos.LastTag));
memo1.Lines.Add( 'Num Tracks :' + InttoStr(sc_minfos.Tracks));
end;
procedure TForm1.Process_SC68(BufferIndex: Integer);
var
Samples: Integer;
resultCode: Tsc68Code;
begin
if not Music_Finished then
begin
Samples := BufSize div (Channels * (BitsPerSample div 8));
resultCode := Tsc68Code(sc68_process(SC68Instance, @buffers[BufferIndex][0], @Samples));
// resultCode := Tsc68Code(sc68_process(SC68Instance, @buffers[BufferIndex][0], @Samples) div 4 and Int64(SC68_END));
if (Int64(resultCode) and Int64(SC68_END)) <> 0 then
begin
Music_Finished := True;
ShowMessage('Musique terminée!');
sc68_close(SC68Instance);
sc68_destroy(SC68Instance);
CloseAudio;
Exit;
end;
end;
end;
procedure TForm1.CloseAudio;
var
i: Integer;
begin
for i := 0 to BufferCount - 1 do
begin
waveOutUnprepareHeader(waveOut, @waveHeaders[i], SizeOf(TWaveHdr));
end;
waveOutClose(waveOut);
end;
// not need here !!!
procedure TForm1.Timer1Timer(Sender: TObject);
begin
end;
end.
Recent
