Recent

Author Topic: Extended Module Player  (Read 3148 times)

Gigatron

  • Full Member
  • ***
  • Posts: 144
  • Amiga Rulez !!
Extended Module Player
« on: September 09, 2024, 09:11:48 pm »
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

« Last Edit: September 11, 2024, 02:12:47 pm by Gigatron »
Sub Quantum Technology ! Ufo Landing : Ezekiel 1-4;

Gigatron

  • Full Member
  • ***
  • Posts: 144
  • Amiga Rulez !!
Re: Extended Module Player
« Reply #1 on: September 11, 2024, 02:20:32 pm »
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 ;
Sub Quantum Technology ! Ufo Landing : Ezekiel 1-4;

Gigatron

  • Full Member
  • ***
  • Posts: 144
  • Amiga Rulez !!
Re: Extended Module Player
« Reply #2 on: September 12, 2024, 03:04:39 am »
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.  
« Last Edit: September 12, 2024, 01:05:26 pm by Gigatron »
Sub Quantum Technology ! Ufo Landing : Ezekiel 1-4;

Gigatron

  • Full Member
  • ***
  • Posts: 144
  • Amiga Rulez !!
Re: Extended Module Player
« Reply #3 on: September 12, 2024, 03:08:43 pm »
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.  
« Last Edit: September 12, 2024, 06:30:06 pm by Gigatron »
Sub Quantum Technology ! Ufo Landing : Ezekiel 1-4;

bobby100

  • Sr. Member
  • ****
  • Posts: 260
    • Malzilla
Re: Extended Module Player
« Reply #4 on: September 12, 2024, 05:53:08 pm »
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

  • Full Member
  • ***
  • Posts: 144
  • Amiga Rulez !!
Re: Extended Module Player
« Reply #5 on: September 12, 2024, 06:08:39 pm »
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
Sub Quantum Technology ! Ufo Landing : Ezekiel 1-4;

TRon

  • Hero Member
  • *****
  • Posts: 3463
Re: Extended Module Player
« Reply #6 on: September 12, 2024, 06:12:18 pm »
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   ;D
This tagline is powered by AI

Gigatron

  • Full Member
  • ***
  • Posts: 144
  • Amiga Rulez !!
Re: Extended Module Player
« Reply #7 on: September 12, 2024, 06:33:13 pm »
@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
Sub Quantum Technology ! Ufo Landing : Ezekiel 1-4;

Fred vS

  • Hero Member
  • *****
  • Posts: 3394
    • StrumPract is the musicians best friend
Re: Extended Module Player
« Reply #8 on: September 12, 2024, 06:40:31 pm »
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.
I use Lazarus 2.2.0 32/64 and FPC 3.2.2 32/64 on Debian 11 64 bit, Windows 10, Windows 7 32/64, Windows XP 32,  FreeBSD 64.
Widgetset: fpGUI, MSEgui, Win32, GTK2, Qt.

https://github.com/fredvs
https://gitlab.com/fredvs
https://codeberg.org/fredvs

TRon

  • Hero Member
  • *****
  • Posts: 3463
Re: Extended Module Player
« Reply #9 on: September 12, 2024, 07:00:01 pm »
@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.
This tagline is powered by AI

bobby100

  • Sr. Member
  • ****
  • Posts: 260
    • Malzilla
Re: Extended Module Player
« Reply #10 on: September 12, 2024, 07:00:28 pm »
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

  • Hero Member
  • *****
  • Posts: 3394
    • StrumPract is the musicians best friend
Re: Extended Module Player
« Reply #11 on: September 12, 2024, 07:06:45 pm »
@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.
 ;)
I use Lazarus 2.2.0 32/64 and FPC 3.2.2 32/64 on Debian 11 64 bit, Windows 10, Windows 7 32/64, Windows XP 32,  FreeBSD 64.
Widgetset: fpGUI, MSEgui, Win32, GTK2, Qt.

https://github.com/fredvs
https://gitlab.com/fredvs
https://codeberg.org/fredvs

TRon

  • Hero Member
  • *****
  • Posts: 3463
Re: Extended Module Player
« Reply #12 on: September 12, 2024, 07:20:07 pm »
Indeed but in C.
Yes, yes. working on it  :)
This tagline is powered by AI

Fred vS

  • Hero Member
  • *****
  • Posts: 3394
    • StrumPract is the musicians best friend
Re: Extended Module Player
« Reply #13 on: September 12, 2024, 07:29:32 pm »
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.  ;)
I use Lazarus 2.2.0 32/64 and FPC 3.2.2 32/64 on Debian 11 64 bit, Windows 10, Windows 7 32/64, Windows XP 32,  FreeBSD 64.
Widgetset: fpGUI, MSEgui, Win32, GTK2, Qt.

https://github.com/fredvs
https://gitlab.com/fredvs
https://codeberg.org/fredvs

Gigatron

  • Full Member
  • ***
  • Posts: 144
  • Amiga Rulez !!
Re: Extended Module Player
« Reply #14 on: September 12, 2024, 07:40:34 pm »
@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

Sub Quantum Technology ! Ufo Landing : Ezekiel 1-4;

 

TinyPortal © 2005-2018