Forum > Audio and Video
Extended Module Player
Gigatron:
Hi,
I am working to implement xmp module player with lazarus pascal, the first test is ok and the module aquarium.digi was played without
problems. Used sdl2 and xmplayer library to call external dll functions;
https://xmp.sourceforge.net/
I will extract audio stuff from Sdl2 nothing else .
It's 2h43 late and just performed very interesting code !! stay tuned !!
Regards
Gtr
--- 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, StdCtrls,libxmp,sdl2; type ESDL2Error = class(Exception); Uint8 = Byte; Uint16 = Word; Uint32 = LongWord; Int16 = SmallInt; Int32 = LongInt; AudioCallback = procedure(udata: Pointer; stream: PByte; len: Integer); cdecl; { TForm1 } TForm1 = class(TForm) Button1: TButton; Button2: TButton; Button3: TButton; MemoInfo: TMemo; Timer1: TTimer; procedure Button1Click(Sender: TObject); procedure Button2Click(Sender: TObject); procedure Button3Click(Sender: TObject); procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure Timer1Timer(Sender: TObject); private xmp_context : Pointer; public ctx: xmp_context; playing: Boolean; end; var Form1: TForm1; playing: Boolean; implementation {$R *.lfm} procedure FillAudio(udata: Pointer; stream: PByte; len: Integer); cdecl;begin if xmp_play_buffer(xmp_context(udata), stream, len, 0) < 0 then playing := False;end;function SDL_InitAudio(ctx: xmp_context): Integer;var a : TSDL_AudioSpec;begin // just audio try if SDL_Init(SDL_INIT_AUDIO) <> 0 then raise ESDL2Error.Create('SDL_Init failed: Flag = ' + IntToStr(SDL_INIT_AUDIO)); except on E: ESDL2Error do try SDL_Quit; except raise; end; end; SDL_Quit; // ShowMessage('SDL_Initialized... OK !!'); a.freq := 44100; a.format := AUDIO_S16; a.channels := 2; a.samples := 2048; a.padding := 0; a.silence := 0; a.callback := @FillAudio; a.userdata := ctx; if SDL_OpenAudio(@a, nil) < 0 then begin ShowMessage(SDL_GetError); Result := -1; Exit; end; Result := 0;end; procedure TForm1.FormCreate(Sender: TObject);var mi: xmp_module_info; begin ctx := xmp_create_context; SDL_InitAudio(ctx); xmp_load_module(ctx, 'worm_hole.s3m'); playing := True; SDL_PauseAudio(0); xmp_start_player(ctx, 44100, 0 );end; procedure TForm1.Button1Click(Sender: TObject); // stop modulebegin if playing=true then begin SDL_PauseAudio(1); xmp_end_player(ctx); xmp_release_module(ctx); xmp_free_context(ctx); SDL_CloseAudio(); playing := false; end;end; procedure TForm1.Button2Click(Sender: TObject); // play begin xmp_start_player(ctx, 44100, 0 ); end; procedure TForm1.Button3Click(Sender: TObject); // load module begin ctx := xmp_create_context; SDL_InitAudio(ctx); xmp_load_module(ctx, 'worm_hole.s3m'); playing := True; SDL_PauseAudio(0); playing := true; end; procedure TForm1.FormDestroy(Sender: TObject);begin SDL_PauseAudio(1); xmp_end_player(ctx); xmp_release_module(ctx); xmp_free_context(ctx); SDL_CloseAudio();end; procedure TForm1.Timer1Timer(Sender: TObject);var mi: xmp_module_info; fi: xmp_frame_info; moduleName: String;begin xmp_get_module_info(ctx, mi); xmp_get_frame_info(ctx,fi); moduleName := String(mi.module^.name); memoinfo.Lines[8] := 'Title : ' + moduleName ; // Affichage des informations du module en cours d ecoute 250 ms / memoinfo.Lines[0] := 'bmp: ' + IntToStr(fi.bpm) ; memoinfo.Lines[1] := 'speed: ' + IntToStr(fi.speed); memoinfo.Lines[2] := 'position: ' + IntToStr(fi.pos); memoinfo.Lines[3] := 'pattern: ' + IntToStr(fi.pattern); memoinfo.Lines[4] := 'row: ' + IntToStr(fi.row); memoinfo.Lines[5] := 'virtual Channel: ' + IntToStr(fi.virt_channels); memoinfo.Lines[6] := 'virtual Used: ' + IntToStr(fi.virt_used); memoinfo.Lines[7] := 'volume : ' + IntToStr(fi.volume); end; end.
Xmp supports many module formats and variations. A few incomplete formats such as DTT and DMF were disabled in recent releases. Currently libxmp recognizes the following formats:
Amiga tracker formats
ChipTracker: KRIS
DIGI Booster: 1.4, 1.5, 1.6, 1.7
DigiBooster Pro (DBM): DBM0
Ice Tracker: IT10
MED 1.12 (MED): MED2
MED 2.10 (MED): MED3
MED 3.00 (MED): MED4
OctaMED (MED): MMD0, MMD1, MMD2, MMD3
Oktalyzer (OKT)
Protracker 3.59
Protracker song
Quadra Composer (EMOD): 0001
Sound/Noise/Protracker standard 31-instrument (MOD): M.K., M!K!, M&K!, N.T.
SoundFX (SFX): 1.3, 2.0?
Soundtracker 15-instrument (MOD, M15)
Soundtracker 2.6 MTN format
Startrekker/Audio Sculpture (MOD, MOD.NT): FLT4/8/N, EXO4/8
Ultimate Soundtracker 15-instrument (MOD)
PC tracker formats
Composer 669/UNIS 669 (669): if, JN
Digitrakker (MDL): 0.0, 1.0, 1.1
Farandole Composer (FAR): 1.0
Fast Tracker II extended module (XM): 1.02, 1.03, 1.04, MED2XM
Fast Tracker multichannel (MOD): 6CHN, 8CHN
Funktracker (FNK): R0, R1, R2
Imago Orpheus (IMF): 1.0
Impulse Tracker (IT): 1.00, 2.00, 2.14, 2.15
Liquid Tracker (LIQ): 0.0, 1.0
Mod's Grave 8-channel M.K. (MOD, WOW)
Multitracker (MTM): 1.0
Poly Tracker (PTM): 2.03
Real Tracker (RTM): 1.00
Scream Tracker 2 (STM): !Scream!, BMOD2STM
Scream Tracker 3 (S3M): 3.00, 3.01+
TakeTracker 4-channel (MOD): TDZ4
TakeTracker/Fast Tracker II multichannel (MOD): xxCH
Ultra Tracker (ULT): V0001, V0002, V0003, V0004
X-Tracker (DMF): 7, 8
Amiga packed formats
AC1D Packer
Heatseeker: mc1.0
FC-M Packer: 1.0
Fuchs Tracker
Fuzzac Packer
Hornet Packer: HRT!
Images Music System
Kefrens Sound Machine
Module Protector
NoisePacker: 1.0, 2.0, 3.0
NoiseRunner
The Player: 4.x, 5.0a, 6.0a, 6.1a
Tracker Packer: 3
Power Music
Pha Packer
ProPacker: 2.1
Promizer: 0.1, 1.0c, 1.8a, 2.0, 4.0
ProRunner: 1.0, 2.0
SKYT Packer
StarTrekker Packer
Titanics Player
Unic Tracker: 1.0, 2.0
Wanton Packer
XANN Packer
Zen Packer
PC packed formats
Dual Module Player DSMI (AMF): 0.9, 1.0, 1.1, 1.2, 1.3, 1.4
Generic Digital Music (GDM): 1.0
ST Music Interface Kit (STX): 1.0, 1.1
Game formats
AMOS Music Bank
ASYLUM Music Format (AMF)
Digital Illusions
Game Music Creator (GMC)
Epic Megagames MASI (PSM): Epic, Sinaria
Galaxy Music System 5.0 (J2B)
Galaxy Music System 4.0
Magnetic Fields Packer
Novotrade Packer
Protracker Studio (PSM): 0.01, 1.00
Slam Tilt
Epic Games Unreal/UT (UMX): IT, S3M, MOD, XM
Atari formats
Digital Tracker (MOD): FA04, FA06, FA08
Digital Tracker (DTM): 1.9
Flextrax (FLX) [effects not supported]
Graoumf Tracker (GTK): GTK1, GTK4
Octalyser multichannel (MOD): CD61, CD81
TCB Tracker (MOD): 'AN COOL.'
Acorn formats
Archimedes Tracker: V1.0+++
Digital Symphony: 0
Desktop Tracker
Gigatron:
Hi,
This project is now working on my X64 OS, not tested on the other OS ;
All autors are credited on the sources code , and nothing modifiyed but some parts removed;
Extended module player from :
Copyright (C) 1996-2016 Claudio Matsuoka and Hipolito Carraro Jr
Libxmp Pascal Header conversion to call external lib functions : Gigatron
SDL2-for-Pascal is based upon:
Pascal-Header-Conversion
Copyright (C) 2012-2020 Tim Blume aka End/EV1313
JEDI-SDL : Pascal units for SDL
Copyright (C) 2000 - 2004 Dominique Louis <Dominique@SavageSoftware.com.au>
You must download sdl library at : https://github.com/libsdl-org/SDL/releases/tag/release-2.30.7
For the exact module in the project download at : https://modland.com/pub/modules/Impulsetracker/Chuck%20Biscuits/
Good luck ;
Gigatron:
Hi,
Very late at night... here is another method to listen Protracker style modules without an external SDL2 library used to initialize Audio_device;
Ok now it uses the mmsystem unit API on Windows!
There are some buffer issues but need to be fixed, but I want to share the source here.
You just need the module and units libxmp.dll and libxmp.pas;
Greetings
--- 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, StdCtrls, BGRAVirtualScreen, libxmp, BGRABitmap, BGRABitmapTypes, mmsystem; const SampleRate = 44100; Channels = 2; BitsPerSample = 16; BufferSize = 65536; // buffer a 65536 sinon lag dans le module -- to do !!! type TForm1 = class(TForm) BGRAVirtualScreen1: TBGRAVirtualScreen; MemoInfo: TMemo; Timer1: TTimer; procedure BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap); procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure Timer1Timer(Sender: TObject); private ctx: xmp_context; public playing: Boolean; end; var Form1: TForm1; waveOut: HWAVEOUT; waveHeader: TWaveHdr; buffer: array[0..BufferSize-1] of Byte; playing: Boolean; // modules related vars **** mi: xmp_module_info; fi: xmp_frame_info; ti : xmp_test_info; ci : xmp_channel_info; moduleName: String; format : String; implementation {$R *.lfm} procedure FillAudioBuffer(ctx: xmp_context);begin if xmp_play_buffer(ctx, @buffer[0], BufferSize, 1) < 0 then playing := False;end; function WaveOutCallback(hwo: HWAVEOUT; uMsg: UINT16; dwInstance, dwParam1, dwParam2: DWORD): LongInt;begin // buffer is empty , on le remplis !!! if uMsg = WOM_DONE then begin FillAudioBuffer(Form1.ctx); waveOutWrite(hwo, @waveHeader, SizeOf(TWaveHdr)); end; Result := 0;end; function InitAudio(ctx: xmp_context): Integer;var wFormat: TWaveFormatEx;begin // les paramètres audio wFormat.wFormatTag := WAVE_FORMAT_PCM; wFormat.nChannels := Channels; wFormat.nSamplesPerSec := SampleRate; wFormat.wBitsPerSample := BitsPerSample; wFormat.nBlockAlign := (wFormat.wBitsPerSample * wFormat.nChannels) div 8; wFormat.nAvgBytesPerSec := wFormat.nSamplesPerSec * wFormat.nBlockAlign; wFormat.cbSize := 0; // Utilisation de CALLBACK_FUNCTION pour recevoir des notifications if waveOutOpen(@waveOut, WAVE_MAPPER, @wFormat, QWORD(@WaveOutCallback), 0, CALLBACK_FUNCTION) <> MMSYSERR_NOERROR then begin ShowMessage('Erreur lors de l''ouverture du périphérique audio.'); Result := -1; Exit; end; FillAudioBuffer(ctx); waveHeader.lpData := @buffer[0]; waveHeader.dwBufferLength := BufferSize; waveHeader.dwFlags := 0; waveHeader.dwLoops := 0; waveOutPrepareHeader(waveOut, @waveHeader, SizeOf(TWaveHdr)); waveOutWrite(waveOut, @waveHeader, SizeOf(TWaveHdr)); Result := 0;end; procedure CloseAudio;begin waveOutUnprepareHeader(waveOut, @waveHeader, SizeOf(TWaveHdr)); waveOutClose(waveOut);end; procedure TForm1.FormCreate(Sender: TObject);begin ctx := xmp_create_context; playing := True; if InitAudio(ctx) = 0 then begin if xmp_load_module(ctx, 'mods/steeveb.mod') <> 0 then begin ShowMessage('Load module error.'); Exit; end; xmp_start_player(ctx, SampleRate, 0) ; end ; end; procedure TForm1.BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);begin bitmap.FontName := 'Fairlight'; bitmap.FontHeight := 44; bitmap.TextOut(42, 100, 'EXTENDED MODULE', BGRA(150, 150, 155)); bitmap.TextOut(40, 100, 'EXTENDED MODULE', BGRA(0, 155, 255)); bitmap.TextOut(82, 150, 'PLAYER V4.2.0', BGRA(150, 150, 155)); bitmap.TextOut(80, 150, 'PLAYER V4.2.0', BGRA(0, 155, 255)); end; procedure TForm1.FormDestroy(Sender: TObject);begin playing := False; xmp_end_player(ctx); xmp_release_module(ctx); xmp_free_context(ctx); CloseAudio;end; procedure TForm1.Timer1Timer(Sender: TObject);var i: Integer; chs_vol: Byte;begin //if playing then //begin // xmp_get_module_info(ctx, mi); // xmp_get_frame_info(ctx, fi); // moduleName := String(mi.module^.name); // format := String(mi.module^.typ); // MemoInfo.Clear; // // MemoInfo.Lines[0] := 'bmp: ' + IntToStr(fi.bpm); // MemoInfo.Lines[1] := 'speed: ' + IntToStr(fi.speed); // MemoInfo.Lines[2] := 'position: ' + IntToStr(fi.pos); // MemoInfo.Lines[3] := 'pattern: ' + IntToStr(fi.pattern); // MemoInfo.Lines[4] := 'row: ' + IntToStr(fi.row); // MemoInfo.Lines[5] := 'module channels: ' + IntToStr(mi.module^.chn); // MemoInfo.Lines[6] := 'used channels: ' + IntToStr(fi.virt_used); // MemoInfo.Lines[7] := 'volume: ' + IntToStr(fi.volume); // MemoInfo.Lines[8] := 'Title: ' + moduleName; // MemoInfo.Lines[9] := 'type: ' + format; // // for i := 0 to mi.module^.chn - 1 do // begin // chs_vol := fi.channel_info[i].volume; // MemoInfo.Lines[10 + i] := 'ch' + IntToStr(i) + ': ' + IntToStr(chs_vol); // end; //end; BGRAVirtualScreen1.RedrawBitmap;end; end.
Gigatron:
Hi,
Ok , this is the 3rd version of extended xmplayer without SDL2 or other external library except libxmp.dll.
The nightmar is over now ; The player now uses a double buffer to solve the sound hatching problem.
So I can now use the player in the intros that I code in FPC :) And finally I am happy with the result.
System used : Windows 10 , X64 , 64gb ram, ti 1080 etc...
--- 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, StdCtrls, BGRAVirtualScreen,windows, libxmp, BGRABitmap, BGRABitmapTypes, mmsystem; const SampleRate = 44100; Channels = 2; BitsPerSample = 16; BufferSize = 8192; // buffer size=8192 is now Ok !!! BufferCount = 2;type TForm1 = class(TForm) BGRAVirtualScreen1: TBGRAVirtualScreen; MemoInfo: TMemo; Timer1: TTimer; procedure BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap); procedure FormCreate(Sender: TObject); procedure FormDestroy(Sender: TObject); procedure Timer1Timer(Sender: TObject); private ctx: xmp_context; buffers: array[0..BufferCount-1] of array[0..BufferSize-1] of Byte; waveHeaders: array[0..BufferCount-1] of TWaveHdr; currentBuffer: Integer; public end; var Form1: TForm1; waveOut: HWAVEOUT; waveHeader: TWaveHdr; // modules related vars **** mi: xmp_module_info; fi: xmp_frame_info; ti : xmp_test_info; ci : xmp_channel_info; moduleName: String; format : String; playing: Boolean; implementation {$R *.lfm} procedure FillBuffer(bufferIndex: Integer);begin if xmp_play_buffer(Form1.ctx, @Form1.buffers[bufferIndex][0], BufferSize, 0) < 0 then playing := False;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(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 // les paramètres audio wFormat.wFormatTag := WAVE_FORMAT_PCM; wFormat.nChannels := Channels; wFormat.nSamplesPerSec := SampleRate; wFormat.wBitsPerSample := BitsPerSample; wFormat.nBlockAlign := (wFormat.wBitsPerSample * wFormat.nChannels) div 8; wFormat.nAvgBytesPerSec := wFormat.nSamplesPerSec * wFormat.nBlockAlign; wFormat.cbSize := 0; if waveOutOpen(@waveOut, WAVE_MAPPER, @wFormat, QWORD(@WaveOutCallback), 0, CALLBACK_FUNCTION) <> MMSYSERR_NOERROR then raise Exception.Create('Erreur ouverture du perif audio'); for i := 0 to BufferCount - 1 do begin ZeroMemory(@Form1.waveHeaders[i], SizeOf(TWaveHdr)); Form1.waveHeaders[i].lpData := @Form1.buffers[i][0]; Form1.waveHeaders[i].dwBufferLength := BufferSize; Form1.waveHeaders[i].dwFlags := 0; Form1.waveHeaders[i].dwLoops := 0; 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 ctx := xmp_create_context; playing := True; SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_LOWEST); // un-comment for reduce cpu Usage; de 6% a 2 % InitAudio; if xmp_load_module(ctx, 'mods/streamline.it') <> 0 then begin ShowMessage('Load module error.'); Exit; end; xmp_start_player(ctx, SampleRate, 0) ; playing := true;end; procedure TForm1.BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);begin bitmap.FontName := 'Fairlight'; bitmap.FontHeight := 44; bitmap.TextOut(42, 100, 'EXTENDED MODULE', BGRA(150, 150, 155)); bitmap.TextOut(40, 100, 'EXTENDED MODULE', BGRA(0, 155, 255)); bitmap.TextOut(82, 150, 'PLAYER V4.2.0', BGRA(150, 150, 155)); bitmap.TextOut(80, 150, 'PLAYER V4.2.0', BGRA(0, 155, 255)); end; procedure TForm1.FormDestroy(Sender: TObject);begin playing := False; xmp_end_player(ctx); xmp_release_module(ctx); xmp_free_context(ctx); CloseAudio;end; procedure TForm1.Timer1Timer(Sender: TObject);var i: Integer; chs_vol: Byte;begin if playing then begin xmp_get_module_info(ctx, mi); xmp_get_frame_info(ctx, fi); moduleName := String(mi.module^.name); format := String(mi.module^.typ); MemoInfo.Clear; MemoInfo.Lines[0] := 'bmp: ' + IntToStr(fi.bpm); MemoInfo.Lines[1] := 'speed: ' + IntToStr(fi.speed); MemoInfo.Lines[2] := 'position: ' + IntToStr(fi.pos); MemoInfo.Lines[3] := 'pattern: ' + IntToStr(fi.pattern); MemoInfo.Lines[4] := 'row: ' + IntToStr(fi.row); MemoInfo.Lines[5] := 'module channels: ' + IntToStr(mi.module^.chn); MemoInfo.Lines[6] := 'used channels: ' + IntToStr(fi.virt_used); MemoInfo.Lines[7] := 'volume: ' + IntToStr(fi.volume); MemoInfo.Lines[8] := 'Title: ' + moduleName; MemoInfo.Lines[9] := 'type: ' + format; for i := 0 to mi.module^.chn - 1 do begin chs_vol := fi.channel_info[i].volume; MemoInfo.Lines[10 + i] := 'ch' + IntToStr(i) + ': ' + IntToStr(chs_vol); end; end; BGRAVirtualScreen1.RedrawBitmap;end; end.
bobby100:
DO you know BeRoXM?
It is written in Pascal (Delphi) without external dependencies.
Didn't try to use it with Lazarus and it is nowhere to find on the net anymore.
If you are interested, I could upload it for you here
Navigation
[0] Message Index
[#] Next page