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  [Select][+][-]

1. unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,libxmp,sdl2;
9.  
10. type
11.   ESDL2Error = class(Exception);
12.   Uint8 = Byte;
13.   Uint16 = Word;
14.   Uint32 = LongWord;
15.   Int16 = SmallInt;
16.   Int32 = LongInt;
17.   AudioCallback = procedure(udata: Pointer; stream: PByte; len: Integer); cdecl;
18.  
19.     { TForm1 }
20.  
21.   TForm1 = class(TForm)
22.     Button1: TButton;
23.     Button2: TButton;
24.     Button3: TButton;
25.     MemoInfo: TMemo;
26.     Timer1: TTimer;
27.  
28.     procedure Button1Click(Sender: TObject);
29.     procedure Button2Click(Sender: TObject);
30.     procedure Button3Click(Sender: TObject);
31.     procedure FormCreate(Sender: TObject);
32.     procedure FormDestroy(Sender: TObject);
33.     procedure Timer1Timer(Sender: TObject);
34.  
35.   private
36.      xmp_context : Pointer;
37.   public
38.     ctx: xmp_context;
39.     playing: Boolean;
40.  
41.   end;
42.  
43. var
44.   Form1: TForm1;
45.   playing: Boolean;
46.  
47. implementation
48.  
49. {$R *.lfm}
50.  
51. procedure FillAudio(udata: Pointer; stream: PByte; len: Integer); cdecl;
52. begin
53.   if xmp_play_buffer(xmp_context(udata), stream, len, 0) < 0 then
54.     playing := False;
55. end;
56. function SDL_InitAudio(ctx: xmp_context): Integer;
57. var
58.   a : TSDL_AudioSpec;
59. begin
60.    // just audio
61.     try
62.       if SDL_Init(SDL_INIT_AUDIO) <> 0 then
63.         raise ESDL2Error.Create('SDL_Init failed: Flag = ' + IntToStr(SDL_INIT_AUDIO));
64.     except
65.       on E: ESDL2Error do
66.       try
67.         SDL_Quit;
68.       except
69.         raise;
70.       end;
71.     end;
72.     SDL_Quit;
73.  //  ShowMessage('SDL_Initialized... OK !!');
74.  
75.   a.freq := 44100;
76.   a.format := AUDIO_S16;
77.   a.channels := 2;
78.   a.samples := 2048;
79.   a.padding := 0;
80.   a.silence := 0;
81.   a.callback := @FillAudio;
82.   a.userdata := ctx;
83.  
84.   if SDL_OpenAudio(@a, nil) < 0 then
85.   begin
86.     ShowMessage(SDL_GetError);
87.     Result := -1;
88.     Exit;
89.   end;
90.  
91.   Result := 0;
92. end;
93.  
94. procedure TForm1.FormCreate(Sender: TObject);
95. var
96.   mi: xmp_module_info;
97.  
98. begin
99.   ctx := xmp_create_context;
100.   SDL_InitAudio(ctx);
101.   xmp_load_module(ctx, 'worm_hole.s3m');
102.   playing := True;
103.   SDL_PauseAudio(0);
104.   xmp_start_player(ctx, 44100, 0 );
105. end;
106.  
107. procedure TForm1.Button1Click(Sender: TObject); // stop module
108. begin
109.     if playing=true then begin
110.     SDL_PauseAudio(1);
111.     xmp_end_player(ctx);
112.     xmp_release_module(ctx);
113.     xmp_free_context(ctx);
114.     SDL_CloseAudio();
115.     playing := false;
116.     end;
117. end;
118.  
119. procedure TForm1.Button2Click(Sender: TObject);   // play
120.  
121. begin
122.          xmp_start_player(ctx, 44100, 0 );
123.  
124. end;
125.  
126. procedure TForm1.Button3Click(Sender: TObject);  // load module
127.  
128. begin
129.   ctx := xmp_create_context;
130.   SDL_InitAudio(ctx);
131.   xmp_load_module(ctx, 'worm_hole.s3m');
132.   playing := True;
133.   SDL_PauseAudio(0);
134.     playing := true;
135.  
136.  
137. end;
138.  
139. procedure TForm1.FormDestroy(Sender: TObject);
140. begin
141.     SDL_PauseAudio(1);
142.     xmp_end_player(ctx);
143.     xmp_release_module(ctx);
144.     xmp_free_context(ctx);
145.     SDL_CloseAudio();
146. end;
147.  
148. procedure TForm1.Timer1Timer(Sender: TObject);
149. var
150.   mi: xmp_module_info;
151.   fi: xmp_frame_info;
152.   moduleName: String;
153. begin
154.  
155.   xmp_get_module_info(ctx, mi);
156.   xmp_get_frame_info(ctx,fi);
157.   moduleName := String(mi.module^.name);
158.   memoinfo.Lines[8] := 'Title : ' +  moduleName ;
159.  // Affichage des informations du module en cours d ecoute  250 ms /
160.   memoinfo.Lines[0] := 'bmp: ' + IntToStr(fi.bpm) ;
161.   memoinfo.Lines[1] := 'speed: ' + IntToStr(fi.speed);
162.   memoinfo.Lines[2] := 'position: ' + IntToStr(fi.pos);
163.   memoinfo.Lines[3] := 'pattern: ' + IntToStr(fi.pattern);
164.   memoinfo.Lines[4] := 'row: ' + IntToStr(fi.row);
165.   memoinfo.Lines[5] := 'virtual Channel: ' + IntToStr(fi.virt_channels);
166.   memoinfo.Lines[6] := 'virtual Used: ' + IntToStr(fi.virt_used);
167.   memoinfo.Lines[7] := 'volume : ' + IntToStr(fi.volume);
168.  
169. end;
170.  
171. end.
172.  
173.  

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  [Select][+][-]

1. unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,
9.   BGRAVirtualScreen, libxmp, BGRABitmap, BGRABitmapTypes, mmsystem;
10.  
11. const
12.   SampleRate = 44100;
13.   Channels = 2;
14.   BitsPerSample = 16;
15.   BufferSize = 65536; // buffer a 65536 sinon lag dans le module -- to do !!!
16.  
17. type
18.   TForm1 = class(TForm)
19.     BGRAVirtualScreen1: TBGRAVirtualScreen;
20.     MemoInfo: TMemo;
21.     Timer1: TTimer;
22.     procedure BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
23.     procedure FormCreate(Sender: TObject);
24.     procedure FormDestroy(Sender: TObject);
25.     procedure Timer1Timer(Sender: TObject);
26.   private
27.     ctx: xmp_context;
28.   public
29.     playing: Boolean;
30.   end;
31.  
32. var
33.   Form1: TForm1;
34.   waveOut: HWAVEOUT;
35.   waveHeader: TWaveHdr;
36.   buffer: array[0..BufferSize-1] of Byte;
37.   playing: Boolean;
38.   // modules related vars ****
39.   mi: xmp_module_info;
40.   fi: xmp_frame_info;
41.   ti : xmp_test_info;
42.   ci : xmp_channel_info;
43.   moduleName: String;
44.   format : String;
45.  
46. implementation
47.  
48. {$R *.lfm}
49.  
50. procedure FillAudioBuffer(ctx: xmp_context);
51. begin
52.   if xmp_play_buffer(ctx, @buffer[0], BufferSize, 1) < 0 then
53.      playing := False;
54. end;
55.  
56. function WaveOutCallback(hwo: HWAVEOUT; uMsg: UINT16; dwInstance, dwParam1, dwParam2: DWORD): LongInt;
57. begin
58.   // buffer is empty , on le remplis !!!
59.   if uMsg = WOM_DONE then
60.   begin
61.      FillAudioBuffer(Form1.ctx);
62.     waveOutWrite(hwo, @waveHeader, SizeOf(TWaveHdr));
63.   end;
64.  
65.   Result := 0;
66. end;
67.  
68. function InitAudio(ctx: xmp_context): Integer;
69. var
70.   wFormat: TWaveFormatEx;
71. begin
72.   // les paramètres audio
73.   wFormat.wFormatTag := WAVE_FORMAT_PCM;
74.   wFormat.nChannels := Channels;
75.   wFormat.nSamplesPerSec := SampleRate;
76.   wFormat.wBitsPerSample := BitsPerSample;
77.   wFormat.nBlockAlign := (wFormat.wBitsPerSample * wFormat.nChannels) div 8;
78.   wFormat.nAvgBytesPerSec := wFormat.nSamplesPerSec * wFormat.nBlockAlign;
79.    wFormat.cbSize := 0;
80.  
81.  
82.   // Utilisation de CALLBACK_FUNCTION pour recevoir des notifications
83.   if waveOutOpen(@waveOut, WAVE_MAPPER, @wFormat, QWORD(@WaveOutCallback), 0, CALLBACK_FUNCTION) <> MMSYSERR_NOERROR then
84.   begin
85.     ShowMessage('Erreur lors de l''ouverture du périphérique audio.');
86.     Result := -1;
87.     Exit;
88.   end;
89.    FillAudioBuffer(ctx);
90.   waveHeader.lpData := @buffer[0];
91.   waveHeader.dwBufferLength := BufferSize;
92.   waveHeader.dwFlags := 0;
93.   waveHeader.dwLoops := 0;
94.   waveOutPrepareHeader(waveOut, @waveHeader, SizeOf(TWaveHdr));
95.   waveOutWrite(waveOut, @waveHeader, SizeOf(TWaveHdr));
96.  
97.   Result := 0;
98. end;
99.  
100. procedure CloseAudio;
101. begin
102.   waveOutUnprepareHeader(waveOut, @waveHeader, SizeOf(TWaveHdr));
103.   waveOutClose(waveOut);
104. end;
105.  
106. procedure TForm1.FormCreate(Sender: TObject);
107. begin
108.   ctx := xmp_create_context;
109.    playing := True;
110.   if InitAudio(ctx) = 0 then
111.   begin
112.     if xmp_load_module(ctx, 'mods/steeveb.mod') <> 0 then
113.     begin
114.       ShowMessage('Load module error.');
115.       Exit;
116.     end;
117.      xmp_start_player(ctx, SampleRate, 0) ;
118.  
119.   end ;
120.  
121. end;
122.  
123. procedure TForm1.BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
124. begin
125.   bitmap.FontName := 'Fairlight';
126.   bitmap.FontHeight := 44;
127.   bitmap.TextOut(42, 100, 'EXTENDED MODULE', BGRA(150, 150, 155));
128.   bitmap.TextOut(40, 100, 'EXTENDED MODULE', BGRA(0, 155, 255));
129.  
130.   bitmap.TextOut(82, 150, 'PLAYER V4.2.0', BGRA(150, 150, 155));
131.   bitmap.TextOut(80, 150, 'PLAYER V4.2.0', BGRA(0, 155, 255));
132.  
133. end;
134.  
135. procedure TForm1.FormDestroy(Sender: TObject);
136. begin
137.   playing := False;
138.   xmp_end_player(ctx);
139.   xmp_release_module(ctx);
140.   xmp_free_context(ctx);
141.   CloseAudio;
142. end;
143.  
144. procedure TForm1.Timer1Timer(Sender: TObject);
145. var
146.   i: Integer;
147.   chs_vol: Byte;
148. begin
149.   //if playing then
150.   //begin
151.   //  xmp_get_module_info(ctx, mi);
152.   //  xmp_get_frame_info(ctx, fi);
153.   //  moduleName := String(mi.module^.name);
154.   //  format := String(mi.module^.typ);
155.   //  MemoInfo.Clear;
156.   //
157.   //  MemoInfo.Lines[0] := 'bmp: ' + IntToStr(fi.bpm);
158.   //  MemoInfo.Lines[1] := 'speed: ' + IntToStr(fi.speed);
159.   //  MemoInfo.Lines[2] := 'position: ' + IntToStr(fi.pos);
160.   //  MemoInfo.Lines[3] := 'pattern: ' + IntToStr(fi.pattern);
161.   //  MemoInfo.Lines[4] := 'row: ' + IntToStr(fi.row);
162.   //  MemoInfo.Lines[5] := 'module channels: ' + IntToStr(mi.module^.chn);
163.   //  MemoInfo.Lines[6] := 'used channels: ' + IntToStr(fi.virt_used);
164.   //  MemoInfo.Lines[7] := 'volume: ' + IntToStr(fi.volume);
165.   //  MemoInfo.Lines[8] := 'Title: ' + moduleName;
166.   //  MemoInfo.Lines[9] := 'type: ' + format;
167.   //
168.   //  for i := 0 to mi.module^.chn - 1 do
169.   //  begin
170.   //    chs_vol := fi.channel_info[i].volume;
171.   //    MemoInfo.Lines[10 + i] := 'ch' + IntToStr(i) + ': ' + IntToStr(chs_vol);
172.   //  end;
173.   //end;
174.  
175.   BGRAVirtualScreen1.RedrawBitmap;
176. end;
177.  
178. end.
179.  

[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  [Select][+][-]

1. unit Unit1;
2.  
3. {$mode objfpc}{$H+}
4.  
5. interface
6.  
7. uses
8.   Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls,
9.   BGRAVirtualScreen,windows, libxmp, BGRABitmap, BGRABitmapTypes, mmsystem;
10.  
11. const
12.   SampleRate = 44100;
13.   Channels = 2;
14.   BitsPerSample = 16;
15.   BufferSize = 8192; // buffer size=8192 is now Ok  !!!
16.   BufferCount = 2;
17. type
18.   TForm1 = class(TForm)
19.     BGRAVirtualScreen1: TBGRAVirtualScreen;
20.     MemoInfo: TMemo;
21.     Timer1: TTimer;
22.     procedure BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
23.     procedure FormCreate(Sender: TObject);
24.     procedure FormDestroy(Sender: TObject);
25.     procedure Timer1Timer(Sender: TObject);
26.   private
27.      ctx: xmp_context;
28.      buffers: array[0..BufferCount-1] of array[0..BufferSize-1] of Byte;
29.      waveHeaders: array[0..BufferCount-1] of TWaveHdr;
30.      currentBuffer: Integer;
31.  
32.   public
33.  
34.   end;
35.  
36. var
37.   Form1: TForm1;
38.   waveOut: HWAVEOUT;
39.   waveHeader: TWaveHdr;
40.   // modules related vars ****
41.   mi: xmp_module_info;
42.   fi: xmp_frame_info;
43.   ti : xmp_test_info;
44.   ci : xmp_channel_info;
45.   moduleName: String;
46.   format : String;
47.   playing: Boolean;
48.  
49. implementation
50.  
51. {$R *.lfm}
52.  
53. procedure FillBuffer(bufferIndex: Integer);
54. begin
55.    if xmp_play_buffer(Form1.ctx, @Form1.buffers[bufferIndex][0], BufferSize, 0) < 0 then
56.     playing := False;
57. end;
58.  
59. function WaveOutCallback(hwo: HWAVEOUT; uMsg: UINT; dwInstance, dwParam1, dwParam2: DWORD_PTR): DWORD; stdcall;
60. begin
61.   if uMsg = WOM_DONE then
62.   begin
63.     FillBuffer(Form1.currentBuffer);
64.     waveOutWrite(hwo, @Form1.waveHeaders[Form1.currentBuffer], SizeOf(TWaveHdr));
65.     Form1.currentBuffer := (Form1.currentBuffer + 1) mod BufferCount;
66.   end;
67.   Result := 0;
68. end;
69.  
70. procedure InitAudio;
71. var
72.   wFormat: TWaveFormatEx;
73.   i : integer;
74. begin
75.   // les paramètres audio
76.   wFormat.wFormatTag := WAVE_FORMAT_PCM;
77.   wFormat.nChannels := Channels;
78.   wFormat.nSamplesPerSec := SampleRate;
79.   wFormat.wBitsPerSample := BitsPerSample;
80.   wFormat.nBlockAlign := (wFormat.wBitsPerSample * wFormat.nChannels) div 8;
81.   wFormat.nAvgBytesPerSec := wFormat.nSamplesPerSec * wFormat.nBlockAlign;
82.    wFormat.cbSize := 0;
83.  
84.    if waveOutOpen(@waveOut, WAVE_MAPPER, @wFormat, QWORD(@WaveOutCallback), 0, CALLBACK_FUNCTION) <> MMSYSERR_NOERROR then
85.     raise Exception.Create('Erreur ouverture du perif audio');
86.  
87.   for i := 0 to BufferCount - 1 do
88.   begin
89.     ZeroMemory(@Form1.waveHeaders[i], SizeOf(TWaveHdr));
90.     Form1.waveHeaders[i].lpData := @Form1.buffers[i][0];
91.     Form1.waveHeaders[i].dwBufferLength := BufferSize;
92.     Form1.waveHeaders[i].dwFlags := 0;
93.     Form1.waveHeaders[i].dwLoops := 0;
94.      waveOutPrepareHeader(waveOut, @Form1.waveHeaders[i], SizeOf(TWaveHdr));
95.   end;
96.  
97.   Form1.currentBuffer := 0;
98.   for i := 0 to BufferCount - 1 do
99.   begin
100.     FillBuffer(i);
101.     waveOutWrite(waveOut, @Form1.waveHeaders[i], SizeOf(TWaveHdr));
102.   end;
103.  
104. end;
105.  
106. procedure CloseAudio;
107. begin
108.   waveOutUnprepareHeader(waveOut, @waveHeader, SizeOf(TWaveHdr));
109.   waveOutClose(waveOut);
110. end;
111.  
112. procedure TForm1.FormCreate(Sender: TObject);
113.  
114. begin
115.     ctx := xmp_create_context;
116.     playing := True;
117.     SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_LOWEST);  // un-comment for reduce cpu Usage; de 6% a 2 %
118.      InitAudio;
119.     if xmp_load_module(ctx, 'mods/streamline.it') <> 0 then
120.     begin
121.       ShowMessage('Load module error.');
122.       Exit;
123.     end;
124.  
125.       xmp_start_player(ctx, SampleRate, 0) ;
126.       playing := true;
127. end;
128.  
129. procedure TForm1.BGRAVirtualScreen1Redraw(Sender: TObject; Bitmap: TBGRABitmap);
130. begin
131.   bitmap.FontName := 'Fairlight';
132.   bitmap.FontHeight := 44;
133.   bitmap.TextOut(42, 100, 'EXTENDED MODULE', BGRA(150, 150, 155));
134.   bitmap.TextOut(40, 100, 'EXTENDED MODULE', BGRA(0, 155, 255));
135.   bitmap.TextOut(82, 150, 'PLAYER V4.2.0', BGRA(150, 150, 155));
136.   bitmap.TextOut(80, 150, 'PLAYER V4.2.0', BGRA(0, 155, 255));
137.  
138. end;
139.  
140. procedure TForm1.FormDestroy(Sender: TObject);
141. begin
142.   playing := False;
143.   xmp_end_player(ctx);
144.   xmp_release_module(ctx);
145.   xmp_free_context(ctx);
146.   CloseAudio;
147. end;
148.  
149. procedure TForm1.Timer1Timer(Sender: TObject);
150. var
151.   i: Integer;
152.   chs_vol: Byte;
153. begin
154.   if playing then
155.   begin
156.     xmp_get_module_info(ctx, mi);
157.     xmp_get_frame_info(ctx, fi);
158.     moduleName := String(mi.module^.name);
159.     format := String(mi.module^.typ);
160.     MemoInfo.Clear;
161.  
162.     MemoInfo.Lines[0] := 'bmp: ' + IntToStr(fi.bpm);
163.     MemoInfo.Lines[1] := 'speed: ' + IntToStr(fi.speed);
164.     MemoInfo.Lines[2] := 'position: ' + IntToStr(fi.pos);
165.     MemoInfo.Lines[3] := 'pattern: ' + IntToStr(fi.pattern);
166.     MemoInfo.Lines[4] := 'row: ' + IntToStr(fi.row);
167.     MemoInfo.Lines[5] := 'module channels: ' + IntToStr(mi.module^.chn);
168.     MemoInfo.Lines[6] := 'used channels: ' + IntToStr(fi.virt_used);
169.     MemoInfo.Lines[7] := 'volume: ' + IntToStr(fi.volume);
170.     MemoInfo.Lines[8] := 'Title: ' + moduleName;
171.     MemoInfo.Lines[9] := 'type: ' + format;
172.  
173.     for i := 0 to mi.module^.chn - 1 do
174.     begin
175.       chs_vol := fi.channel_info[i].volume;
176.       MemoInfo.Lines[10 + i] := 'ch' + IntToStr(i) + ': ' + IntToStr(chs_vol);
177.     end;
178.   end;
179.  
180.   BGRAVirtualScreen1.RedrawBitmap;
181. end;
182.  
183. end.
184.  

[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

[Gigatron]

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

Hi ,
Yes i know beroxm, what i need is to play many tracker based obscure format and xmplay do that.

If you want to download beroxm it will also be useful for me to analyze the source code i like look source code and understand how it's done,
thanks in advance.

Regards

Gtr

[TRon]

See also tralala (which more or less supports similar formats as BeroPlayer).

But yes, there are many formats that most re-players are not able to handle. Even xmp lacks ... a few   

[Gigatron]

@Tron you talk about

Action Amics Soundtool, AHX, AM Composer, AMOS Music Bank, Art & Magic player, Art of Noise (4 voices), Beathoven Synthesizer, Ben Daglish player, Ben Daglish SID player, Blade Packer, Chip Tracker, Cinemaware player, Core Design player, CustomMade, Darius Zendeh player, Dave Lowe new player, Dave Lowe player (DAVELOWE), Dave Lowe player (UNCLEART), David Whittaker player, Delta Music 1.0, Delta Music 2.0, Desire player, DigiBooster, Digital Sonix & Chrome player, Digital Sound Studio, Dynamic Synthesizer, Ear Ache, Editeur Musical Sequentiel (EMS), Fashion Tracker, "Forgotten Worlds" player, Fred Editor, Fred Gray player, Future Composer 1.3, Future Composer 1.4, Future Composer BSI, Future Player, GlueMon, Howie Davies player, Images Music System, In Stereo 1.0, In Stereo 2.0, Infogrames player, JamCracker, Janko Mrsic-Flogel player, Jason C. Brooke player, Jason Page player, Jeroen Tel player, Jochen Hippel player, Jochen Hippel 7V player, Jochen Hippel COSO player, Kris Hatlelid player, Leggless Music Editor, Magnetic Fields packer, Major Tom player, Maniacs of Noise player, Mark Cooksey player, Mark Cooksey old player, Mark II Sound System, Martin Walker player, MED/OctaMED (4 voices), MED/OctaMED (8 voices), Medley, Mike Davies player, MMDC, Mugician, Mugician II, Music Assembler, NovoTrade packer, Paul Robotham player, Paul Shields player, Paul Summers player, Peter Verswyvelen packer, Pierre Adane packer, PowerTracker, Professional Sound Artists player, PumaTracker, Quadra Composer, Richard Joseph player, Riff Raff player, Rob Hubbard player, Rob Hubbard ST player, Scumm player, Sean Connolly player, Sean Conran player, SIDMon 1.0, SIDMon 2.0, Silmarils player, Sonic Arranger, Sonic Arranger packed, Sonix, Soprol, Sound Master, Sound Player, Soundcontrol, Soundfactory, SoundFX, SoundImages, SoundMon 2.0, SoundMon 2.2, Special FX, Speedy A1 System, Speedy System, Steve Barrett player, Steve Turner player, SunTronic, SynthDream, Synthesis, SynthPack, SynTracker, TFMX, TFMX 7V, TFMX Pro, Tim Follin player, The Musical Enlightenment, Thomas Hermann player, TomyTracker, TronicTracker, Wally Beben player, Voodoo Supreme Synthesizer, YMST and custom players

[Fred vS]

Hello.
Nice project!
If you want to do it on Linux with the top-level library libasound.so.2 (present in all Linux distributions),
you can get inspiration from this:
https://github.com/fredvs/alsa_sound/blob/main/src/alsa_sound.pas

It produces some sounds from sine waves in the buffer, just replace it with your buffer xmp.

[TRon]

@Tron you talk about
...

That seems like a good summary Gigatron :-)

Most notable ones:
AHX (Abyss/Hively) , delta, FC, hippel, MON, octa(med), soundfx (nostalgic reasons), TFMX and TME. To/for me those are considered reasonably main-stream.

There are some re-players floating around on the web that could be converted to Pascal (if not done already) but it is still a lot of work to stuff it into a single re-player (If I remember correctly there is a javascript ? re-player floating around that supports most (obscure) formats).

@Fred vS:
There are examples in the xmp lib folder that f.e. shows how to uses alsa but also openal.

There are some issues with the header (which I'm currently working on) and which corrected allows me to try with libao.

[bobby100]

BeRoXM - Here is what I have (too big for forum): https://file.io/0jTZvep9ubJH
btw. my antivirus is not happy with the exe and dll files from this zip. It suspects it with some generic detection.

[Fred vS]

@Fred vS:
There are examples in the xmp lib folder that f.e. shows how to uses alsa but also openal.

Indeed but in C.
 

[TRon]

Indeed but in C.

Yes, yes. working on it 

[Fred vS]

Indeed but in C.

Yes, yes. working on it 

Ha, ok, then you may also get inspiration from this alsa-sound project, mainly for the alsa types and dynamicaly loaded methods from alsa lib. 

[Gigatron]

@Tron you talk about
...

That seems like a good summary Gigatron :-)

Most notable ones:
AHX (Abyss/Hively) , delta, FC, hippel, MON, octa(med), soundfx (nostalgic reasons), TFMX and TME. To/for me those are considered reasonably main-stream.

There are some re-players floating around on the web that could be converted to Pascal (if not done already) but it is still a lot of work to stuff it into a single re-player (If I remember correctly there is a javascript ? re-player floating around that supports most (obscure) formats).

@Fred vS:
There are examples in the xmp lib folder that f.e. shows how to uses alsa but also openal.

There are some issues with the header (which I'm currently working on) and which corrected allows me to try with libao.

Nice btw : libxmp can play  [octa(med) & soundfx ]

You mean sure Juergen Wothke www and neoart of Christian Corti's  Flod player ;

http://www.wothke.ch/playmod/

https://www.neoartcr.com/flod.htm