Forum > Audio and Video
Adlib Player
(1/1)
Gigatron:
Hi,
Back to C++, C and then to FPC for making something nice to listening old OPL fm modules .. used on PCs,
will give some extra info later ;
What is Adlib/Adplug ? : https://adplug.github.io/
Supported file format not tested yet ;
AdLib / OPL2 sound chip Format file support .HSC, .SNG, .IMF/.WLF/.ADLIB, .A2M, .AMD, .BAM, .CMF, .D00, .DFM, .HSP, .KSM, .MAD, .LAA, .MKJ, .CFF, .DMO, .S3M, .DTM, .MTK, .RAD, .RAW, .SAT, .XAD, .LDS, .M, .ROL, .XSM, .DRO, .MSC, and .RIX.
Find Adlib Modules here : https://modland.com/pub/modules/Ad%20Lib/
Tested 2 extension .HSC and XSM ;
I used Visual studio 2019 , Hippoplayer Adplug and replay sources to extract some functions in adlib.dll. on X64 platforms ;
Just simple functions to play FM OPL modules are exported to .dll the replay routine is a bit faster than original will be fixed asap;
The library and 2 modules are attached in .zip file;
The modules must be in project drawer .dll too ;
** I am working with UADE ... a really nightmare ... done 40 % !!! hope it's will ready before 2025 !
Have Fun
Gigatron
The main Unit :
--- Code: Pascal [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---unit Unit1; {$mode objfpc}{$H+} interface uses Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls,adlib, mmsystem, windows,DynLibs; const Channels = 2; BitsPerSample = 16; SampleRate = 44100; // Nombre d'échantillons par seconde BufSize = 8192; // 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); procedure Process_OPL(BufferIndex: Integer); 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; ok_flag: Boolean = false; libHandle: TLibHandle; error: DWORD; core: boolean = false; p_tick : integer = 0; n_sample : SmallInt; opl : Pointer; // file pointer !! implementation {$R *.lfm} procedure HandleError(const Str: PAnsiChar);begin if Str <> nil then begin ShowMessage('Error: ' + 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_OPL(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; end; waveOutPrepareHeader(waveOut, @Form1.waveHeaders[i], SizeOf(TWaveHdr)); end; Form1.currentBuffer := 0; for i := 0 to BufferCount - 1 do begin waveOutWrite(waveOut, @Form1.waveHeaders[i], SizeOf(TWaveHdr)); end;end; procedure TForm1.FormCreate(Sender: TObject);var FileName: string; begin libHandle := LoadLibrary('adlib.dll'); if libHandle = 0 then begin error := GetLastError; ShowMessage('Erreur chargement de la DLL: ' + IntToStr(error)); end; core := CreateCore(true,2); // create OPL 20 channels max !! Type_Opl2 // FileName := 'neo_intro.xms'; // the famous Neo-Intro when PC had FM OPL soundchip and AMIGA PAULA !!! :) // Or this module file FileName := 'ezerious.hsc'; // Hannes Seifert / Input ShowMessage('init OK ' ); Set_OPLchip(0); Init_Opl; opl := Load_Mod(Pchar(filename) ); ShowMessage('file Ok ' ); ShowMessage('All Ok ' ); end; procedure TForm1.FormShow(Sender: TObject);begin InitAudio; ok_flag := true; end; procedure TForm1.Process_OPL(BufferIndex: Integer);var n: SmallInt;begin n := 2048; Write_pcm(@buffers[BufferIndex][0], n ); if Player_Update then begin inc(p_tick,2); // future end;end; procedure TForm1.Timer1Timer(Sender: TObject);begin end; end.
Adlib Unit;
--- Code: Pascal [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---unit adlib; {$mode objfpc}{$H+} interface uses windows; const ADLIBDLL = 'adlib.dll'; function CreateCore(isStereo: Boolean;core : integer): Boolean; cdecl; external ADLIBDLL;procedure Init_Opl; cdecl; external ADLIBDLL;procedure Write_Pcm(buf: Pointer; samples: SmallInt); cdecl; external ADLIBDLL;function Load_Mod(filename : Pchar ): Pointer; cdecl; external ADLIBDLL; procedure Set_OPLchip(chip: integer); cdecl; external ADLIBDLL;function Player_Update: Boolean; cdecl; external ADLIBDLL; implementation end.
Gigatron:
Ok
Here is the second version of Adlib player i've just added some new commands about modules informations:
Each modules have differents Opl Timer, to decrease speed ADD some bytes to BufferSize ; Or Substract to increase speed !
Main unit
--- Code: Pascal [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---unit Unit1; {$mode objfpc}{$H+} interface uses Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls,adlib, mmsystem, windows,DynLibs; const Channels = 2; BitsPerSample = 16; SampleRate = 44100; // Nombre d'échantillons par seconde BufSize = 8192+1024 ; // Taille du tampon audio x 2 // buffersize == module speed !! (neointro.hsc) is now ok !! BufferCount = 4; type { TForm1 } TForm1 = class(TForm) Timer1: TTimer; procedure FormCreate(Sender: TObject); procedure FormShow(Sender: TObject); procedure Timer1Timer(Sender: TObject); procedure Opl_Process(BufferIndex: Integer); private buffers: array[0..BufferCount-1] of array[0..BufSize-1] of Byte; waveHeaders: array[0..BufferCount-1] of TWaveHdr; currentBuffer: Integer; public end; var Form1: TForm1; waveOut: HWAVEOUT; ok_flag: Boolean = false; libHandle: TLibHandle; error: DWORD; core: boolean = false; opl : Pointer; // file pointer !! tick : integer; implementation {$R *.lfm} procedure HandleError(const Str: PAnsiChar);begin if Str <> nil then begin ShowMessage('Error: ' + Str); Halt(1); end;end; procedure SavePCMBuffer(const Buffer: Pointer; BufferSize: Integer; const FileName: string);var FileHandle: TFileStream;begin try FileHandle := TFileStream.Create(FileName, fmOpenWrite or fmCreate); try // Écrire les données du tampon FileHandle.Write(Buffer^, BufferSize); finally FileHandle.Free; end; except on E: Exception do ShowMessage('Erreur lors de la sauvegarde du fichier PCM: ' + E.Message); end;end; function WaveOutCallback(hwo: HWAVEOUT; uMsg: UINT; dwInstance, dwParam1, dwParam2: DWORD_PTR): DWORD; stdcall;begin if uMsg = WOM_DONE then begin Form1.Opl_Process(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_NORMAL); 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'); // 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 ; 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; begin libHandle := LoadLibrary('adlib.dll'); if libHandle = 0 then begin error := GetLastError; ShowMessage('Erreur chargement DLL: ' + IntToStr(error)); end; // FileName := 'kya.dmo'; // Benjamin Gérardin Twin-tracker // FileName := 'neo_intro.xms'; // the famous Neo-Intro when PC had FM OPL soundchip and AMIGA PAULA !!! :) // FileName := 'ezerious.hsc'; // Hannes Seifert / Input FileName := 'neo intro.hsc'; // Neo-Intro hsc format core := CreateCore(44100,true,true,0); // create OPL core : srate / 16bit? / stereo? / core type 0,1,2,3 {Harekiet's, 0} // CWemuopl {Ken Silverman's, 1} // CKemuopl {Jarek Burczynski's, 2}// CEmuopl {Nuked OPL3, 3} // CNemuopl ShowMessage('Init OPL Core OK !! ' ); Set_OPLchip(2); // TYPE_OPL2, TYPE_OPL3, TYPE_DUAL_OPL2 -- 0/1/2 -- Init_Opl(); opl := Load_Mod(Pchar(filename)); // Opl_Process(Form1.currentBuffer);end; procedure TForm1.FormShow(Sender: TObject);begin InitAudio; ok_flag := true; end; procedure TForm1.Opl_Process(BufferIndex: Integer);var smp_to_read: Integer;begin smp_to_read := BufSize div (Channels * (BitsPerSample div 8)); Write_pcm(@buffers[BufferIndex][0], smp_to_read); Player_Update();end; procedure TForm1.Timer1Timer(Sender: TObject);begin end; end.
Adlib Unit :
--- Code: Pascal [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---unit adlib; {$mode objfpc}{$H+} interface uses windows; const ADLIBDLL = 'adlib.dll'; type PAplayer = recordtitle : string;end;TAPlayer = ^PAplayer; function CreateCore(srate: integer; isBeat: Boolean; isStereo: Boolean; core : integer): Boolean; cdecl; external ADLIBDLL;procedure Init_Opl; cdecl; external ADLIBDLL;procedure Write_Pcm(buf: Pointer; samples: SmallInt); cdecl; external ADLIBDLL;function Load_Mod(filename : Pchar ): Pointer; cdecl; external ADLIBDLL; procedure Set_OPLchip(chip: integer); cdecl; external ADLIBDLL;//procedure Surround_Offset(offset : PDouble);cdecl; external ADLIBDLL;function Player_Update(): Boolean; cdecl; external ADLIBDLL;function Player_Get_Refresh: single; cdecl; external ADLIBDLL; // music infosfunction Get_Music_Title(title: Pointer) : Pchar; cdecl; external ADLIBDLL;function Get_Music_Type(tp: Pointer) : Pchar; cdecl; external ADLIBDLL;function Get_Music_Author(aut: Pointer) : Pchar; cdecl; external ADLIBDLL;function Get_Music_Desc(desc: Pointer) : Pchar; cdecl; external ADLIBDLL;function Get_Music_Pattern(pt: Pointer) : Integer; cdecl; external ADLIBDLL;function Get_Music_Orders(pt: Pointer) : Integer; cdecl; external ADLIBDLL;function Get_Music_Order(pt: Pointer) : Integer; cdecl; external ADLIBDLL;function Get_Music_Row(pt: Pointer) : Integer; cdecl; external ADLIBDLL;function Get_Music_Speed(pt: Pointer) : Integer; cdecl; external ADLIBDLL;function Get_Music_Subsongs(pt: Pointer) : Integer; cdecl; external ADLIBDLL;function Get_Music_Subsong(pt: Pointer) : Integer; cdecl; external ADLIBDLL;function Get_Music_Instruments(pt: Pointer) : Integer; cdecl; external ADLIBDLL; implementation end.
Navigation
[0] Message Index