Recent

« previous next »
Pages: [1]

Author Topic: Asap Player  (Read 1415 times)

Gigatron

  • Sr. Member
  • ****
  • Posts: 336
  • Amiga Rulez !!
Asap Player
« on: December 30, 2024, 07:09:51 pm »
Hi,
No UADE for now , but a nice player instead.

ASAP (Another Slight Atari Player) plays and converts 8-bit Atari music (*.sap, *.cmc, *.mpt, *.rmt, *.tmc, ...) ;
Just .sap files are tested ..
You can listen or download .sap files here ; https://asma.atari.org/

The DLL library is compiled to X64 and pascal header adapted by me;
So the library and example song are atached in zip format;

The main unit:

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, asap_lib,
  9.   mmsystem, windows;
  10.  
  11. const
  12.   Channels = 1;
  13.   BitsPerSample = 16;
  14.   SampleRate = 44100; // Nombre d'échantillons par seconde
  15.   BufSize =  4096   ;    // Taille du tampon audio x 2
  16.   BufferCount = 4;
  17.  
  18. type
  19.  
  20.   { TForm1 }
  21.  
  22.  
  23.   TForm1 = class(TForm)
  24.     Timer1: TTimer;
  25.     procedure FormCreate(Sender: TObject);
  26.     procedure FormShow(Sender: TObject);
  27.     procedure Timer1Timer(Sender: TObject);
  28.   private
  29.     buffers: array[0..BufferCount-1] of array[0..BufSize-1] of  SmallInt;
  30.     waveHeaders: array[0..BufferCount-1] of TWaveHdr;
  31.     currentBuffer: Integer;
  32.   public
  33.   end;
  34.  
  35. var
  36.   Form1: TForm1;
  37.   waveOut: HWAVEOUT;
  38.   ok_flag: Boolean = false;
  39.   fsize : integer;
  40.  
  41.   // asap
  42.   asap_instance : PASAP;
  43.   asap_ld : Boolean;
  44.   asap_inf:  PASAPInfo;
  45.   Buffer: array of Byte; // binary data song buffer
  46.  
  47. implementation
  48.  
  49. {$R *.lfm}
  50.  
  51. procedure HandleError(const Str: PAnsiChar);
  52. begin
  53.   if Str <> nil then
  54.   begin
  55.     ShowMessage('Error: ' + Str);
  56.     Halt(1);
  57.   end;
  58. end;
  59.  
  60. procedure FillBuffer(bufferIndex: Integer);
  61. var
  62.   NumChan: Integer;
  63.   GenSmp, NumSmp: Integer;
  64.   hz : integer;
  65. begin
  66.  
  67.   if ok_flag then
  68.   begin
  69.   // get song info  + channnels
  70.    asap_inf := ASAP_GetInfo(asap_instance);
  71.    NumChan := ASAPInfo_GetChannels(asap_inf);
  72.    //NumSmp :=  8192;
  73.    NumSmp := BufSize div (NumChan * (BitsPerSample div 16));
  74.    Gensmp := ASAP_Generate(asap_instance, @Form1.buffers[bufferIndex][0], NumSmp,ASAPSampleFormat.ASAPSampleFormat_S16_L_E) div 2  ;  // _U8
  75.     ASAPInfo_SetNtsc(asap_instance, false);
  76.  
  77.   end;
  78.  
  79. end;
  80.  
  81. function WaveOutCallback(hwo: HWAVEOUT; uMsg: UINT; dwInstance, dwParam1, dwParam2: DWORD_PTR): DWORD; stdcall;
  82. begin
  83.   if uMsg = WOM_DONE then
  84.   begin
  85.     FillBuffer(Form1.currentBuffer);
  86.     waveOutWrite(waveOut, @Form1.waveHeaders[Form1.currentBuffer], SizeOf(TWaveHdr));
  87.     Form1.currentBuffer := (Form1.currentBuffer + 1) mod BufferCount;
  88.   end;
  89.   Result := 0;
  90. end;
  91.  
  92. procedure InitAudio;
  93. var
  94.   wFormat: TWaveFormatEx;
  95.   i: Integer;
  96. begin
  97.   SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_LOWEST);
  98.  
  99.   with wFormat do
  100.   begin
  101.     wFormatTag := WAVE_FORMAT_PCM;
  102.     nChannels := Channels;
  103.     nSamplesPerSec := SampleRate;
  104.     wBitsPerSample := BitsPerSample;
  105.     nBlockAlign := (wBitsPerSample * nChannels) div 8;
  106.     nAvgBytesPerSec := nSamplesPerSec * nBlockAlign;
  107.     cbSize := 0;
  108.   end;
  109.  
  110.   if waveOutOpen(@waveOut, WAVE_MAPPER, @wFormat, QWORD(@WaveOutCallback), 0, CALLBACK_FUNCTION) <> MMSYSERR_NOERROR then
  111.     raise Exception.Create('Erreur lors de l''ouverture du périphérique audio');
  112.  
  113.   // Préparation des tampons
  114.   for i := 0 to BufferCount - 1 do
  115.   begin
  116.     ZeroMemory(@Form1.waveHeaders[i], SizeOf(TWaveHdr));
  117.     with Form1.waveHeaders[i] do
  118.     begin
  119.       lpData := @Form1.buffers[i][0];
  120.       dwBufferLength := BufSize  ;
  121.       dwFlags := 0;
  122.        FillBuffer(i);
  123.     end;
  124.     waveOutPrepareHeader(waveOut, @Form1.waveHeaders[i], SizeOf(TWaveHdr));
  125.   end;
  126.     Form1.currentBuffer := 0;
  127.     for i := 0 to BufferCount - 1 do
  128.      begin
  129.      FillBuffer(i);
  130.      waveOutWrite(waveOut, @Form1.waveHeaders[i], SizeOf(TWaveHdr));
  131.     end;
  132. end;
  133.  
  134. procedure LoadBinaryFileToBuffer(const FileName: string; var Buffer:   TBytes);
  135. var
  136.   MemoryStream: TMemoryStream;
  137. begin
  138.   MemoryStream := TMemoryStream.Create;
  139.   try
  140.     MemoryStream.LoadFromFile(FileName);
  141.     SetLength(Buffer, MemoryStream.Size); // Ajuste la taille du buffer
  142.     MemoryStream.ReadBuffer(Buffer[0], MemoryStream.Size);
  143.     fsize := MemoryStream.Size;
  144.   finally
  145.     MemoryStream.Free;
  146.   end;
  147. end;
  148.  
  149. procedure TForm1.FormCreate(Sender: TObject);
  150. var
  151.    FileName: string;
  152.    chn: Integer;
  153.    sr: Integer;
  154. begin
  155.     //FileName := 'Jet_Set_Willy.sap'; Sw P;
  156.       FileName := 'Anger.sap';  // Marek Pešout
  157.     // FileName := 'Gyruss.sap'; Paker Brothers
  158.     //  FileName := 'RSI_1.sap';  // Michal Szpilowski
  159.     //  FileName := 'fred.tm2';  //  Janusz Pelc SynError !! TO do !!
  160.   try
  161.     LoadBinaryFileToBuffer(FileName, Buffer);
  162.  
  163.   except
  164.     on E: Exception do
  165.       ShowMessage('Erreur : ' );
  166.   end;
  167.  
  168.     // Initialisation du décodeur ASAP
  169.     asap_instance := ASAP_New;
  170.     if asap_instance = nil then
  171.     begin
  172.       ShowMessage('ASAP init Error !!');
  173.       Exit;
  174.     end;
  175.  
  176.     asap_ld := ASAP_Load(asap_instance, PChar(FileName), @Buffer[0], Length(Buffer)); // load song to buffer !
  177.     ShowMessage('File Len : ' + IntToStr(Length(Buffer)));
  178.  
  179.     asap_inf := ASAP_GetInfo(asap_instance);      // song
  180.     chn := ASAPInfo_GetChannels(asap_inf);
  181.  
  182.     // start player !
  183.     ASAPInfo_SetNtsc(asap_instance,false);  // PAL/NTSC
  184.     ASAP_PlaySong(asap_instance, 0, -1);  //   songNum = 0(first)  duration -1 infinite ;
  185.  
  186.     sr := ASAPInfo_GetPlayerRateScanlines(asap_inf);
  187.     ShowMessage('Scanline  : ' + IntToStr(sr) + ' Hz');
  188. end;
  189.  
  190. procedure TForm1.FormShow(Sender: TObject);
  191. begin
  192.     InitAudio;
  193.     ok_flag := true;
  194. end;
  195.  
  196. // not used
  197. procedure TForm1.Timer1Timer(Sender: TObject);
  198. begin
  199. end;
  200.  
  201. end.
  202.  

asap unit :
Code: Pascal  [Select][+][-]
  1. unit asap_lib;
  2.  
  3.  
  4. {$mode objfpc}{$H+}
  5.  
  6. interface
  7.  
  8. uses
  9.     windows;
  10.  
  11.   const
  12.     ASAPLIB = 'asap.dll';
  13.   type
  14.  
  15.   TPoly9LookupArray = array[0..510] of Byte;
  16.   TPoly17LookupArray = array[0..16384] of Byte;
  17.   TSincLookupArray = array[0..1023, 0..31] of SmallInt;
  18.  
  19.  
  20.  
  21.   PASAPWriter = ^ASAPWriter;
  22.   ASAPWriter = record
  23.        output :PInt16;
  24.        outputOffset : Integer;
  25.        outputEnd: Integer;
  26.   end;
  27.  
  28.   ASAPModuleType = (amtUnknown, amtType1, amtType2,ASAPModuleType_SAP_B,
  29.         ASAPModuleType_SAP_C,
  30.         ASAPModuleType_SAP_D,
  31.         ASAPModuleType_SAP_S,
  32.         ASAPModuleType_CMC,
  33.         ASAPModuleType_CM3,
  34.         ASAPModuleType_CMR,
  35.         ASAPModuleType_CMS,
  36.         ASAPModuleType_DLT,
  37.         ASAPModuleType_MPT,
  38.         ASAPModuleType_RMT,
  39.         ASAPModuleType_TMC,
  40.         ASAPModuleType_TM2,
  41.         ASAPModuleType_FC);
  42.  
  43.  
  44.  
  45.    NmiStatus = (NmiStatus_RESET, NmiStatus_ON_V_BLANK,NmiStatus_WAS_V_BLANK);
  46.  
  47.   //   sample formats
  48.   ASAPSampleFormat = (
  49.     ASAPSampleFormat_U8,   // Unsigned 8-bit
  50.     ASAPSampleFormat_S16_L_E, // Signed 16-bit little-endian
  51.     ASAPSampleFormat_S16_B_E // Signed 16-bit big-endian
  52.     );
  53.  TPokeyChannel = record
  54.     Audf: Integer;
  55.     Audc: Integer;
  56.     PeriodCycles: Integer;
  57.     TickCycle: Integer;
  58.     TimerCycle: Integer;
  59.     Mute: Integer;
  60.     Out: Integer;
  61.     Delta: Integer;
  62.   end;
  63.  
  64.    TPokeyChannelArray = array[0..3] of TPokeyChannel;
  65.  
  66.   TPokey = record
  67.     Channels: TPokeyChannelArray;
  68.     Audctl: Integer;
  69.     Skctl: Integer;
  70.     Irqst: Integer;
  71.     Init: Boolean;
  72.     DivCycles: Integer;
  73.     ReloadCycles1: Integer;
  74.     ReloadCycles3: Integer;
  75.     PolyIndex: Integer;
  76.     DeltaBufferLength: Integer;
  77.     DeltaBuffer: PInteger; // Correspond à un pointeur sur int en C c'est sure !!
  78.     SumDACInputs: Integer;
  79.     SumDACOutputs: Integer;
  80.     IIRRate: Integer;
  81.     IIRAcc: Integer;
  82.     Trailing: Integer;
  83.   end;
  84.  
  85.   PokeyPair = record
  86.     Poly9Lookup: TPoly9LookupArray;
  87.     Poly17Lookup: TPoly17LookupArray;
  88.     ExtraPokeyMask: Integer;
  89.     BasePokey: TPokey;
  90.     ExtraPokey: TPokey;
  91.     SampleRate: Integer;
  92.     SincLookup: TSincLookupArray;
  93.     SampleFactor: Integer;
  94.     SampleOffset: Integer;
  95.     ReadySamplesStart: Integer;
  96.     ReadySamplesEnd: Integer;
  97.   end;
  98.  
  99.   PASAPInfo = ^ASAPInfo;
  100.   ASAPInfo = record
  101.     filename: PChar;
  102.     author: PChar;
  103.     title: PChar;
  104.     date: PChar;
  105.     channels: Integer;
  106.     songs: Integer;
  107.     defaultSong: Integer;
  108.     durations: array[0..31] of Integer;
  109.     loops: array[0..31] of Boolean;
  110.     ntsc: Boolean;
  111.     mtype_: ASAPModuleType;
  112.     fastplay: Integer;
  113.     music: Integer;
  114.     init: Integer;
  115.     player: Integer;
  116.     covoxAddr: Integer;
  117.     headerLen: Integer;
  118.     songPos: array[0..31] of Byte;
  119.   end;
  120.  
  121.   TCpu6502 = ^Cpu6502;
  122.   PASAP = ^ASAP;
  123.   Cpu6502 = record
  124.     asap:  PASAP;
  125.     memory: array[0..65535] of Byte;
  126.     cycle: Integer;
  127.     pc: Integer;
  128.     a: Integer;
  129.     x: Integer;
  130.     y: Integer;
  131.     s: Integer;
  132.     nz: Integer;
  133.     c: Integer;
  134.     vdi: Integer;
  135.   end;
  136.  
  137.   ASAP = record
  138.     nextEventCycle: Integer;
  139.     cpu: TCpu6502;
  140.     nextScanlineCycle: Integer;
  141.     nmist: NmiStatus;
  142.     consol: Integer;
  143.     covox: array[0..3] of Byte;
  144.     pokeys: PokeyPair;
  145.     moduleInfo: ASAPInfo;
  146.     nextPlayerCycle: Integer;
  147.     tmcPerFrameCounter: Integer;
  148.     currentSong: Integer;
  149.     currentDuration: Integer;
  150.     blocksPlayed: Integer;
  151.     silenceCycles: Integer;
  152.     silenceCyclesCounter: Integer;
  153.     gtiaOrCovoxPlayedThisFrame: Boolean;
  154.     currentSampleRate: Integer;
  155.   end;
  156.  
  157.  
  158. function ASAP_New: PASAP; cdecl; external ASAPLIB;
  159. procedure ASAP_Delete(var self: ASAP); cdecl; external ASAPLIB;
  160. procedure ASAP_DetectSilence( self: ASAP; seconds: Integer); cdecl; external ASAPLIB;
  161. function ASAP_Load( self: PASAP; filename: PChar; const module: PByte; moduleLen: Integer): Boolean; cdecl; external ASAPLIB;
  162. function ASAP_GetInfo(self: PASAP): PASAPInfo; cdecl; external ASAPLIB;
  163. procedure ASAP_MutePokeyChannels( self: ASAP; mask: Integer); cdecl; external ASAPLIB;
  164. procedure ASAPInfo_SetNtsc(self :PASAP ;   ntsc : Boolean); cdecl; external ASAPLIB;
  165. function ASAP_PlaySong( self: PASAP; song, duration: Integer): Boolean; cdecl; external ASAPLIB;
  166. function ASAP_GetBlocksPlayed(const self: ASAP): Integer; cdecl; external ASAPLIB;
  167. function ASAP_GetPosition( self: PASAP): Integer; cdecl; external ASAPLIB;
  168. function ASAP_SeekSample( self: ASAP; block: Integer): Boolean; cdecl; external ASAPLIB;
  169. function ASAP_Seek( self: ASAP; position: Integer): Boolean; cdecl; external ASAPLIB;
  170. function ASAP_GetWavHeader( self: PASAP; buffer: PByte; format: ASAPSampleFormat; metadata: Boolean): Integer; cdecl; external ASAPLIB;
  171. function ASAP_Generate(self: PASAP; buffer: PByte; bufferLen: Integer; format: ASAPSampleFormat): Integer; cdecl; external ASAPLIB;
  172. function ASAP_GetPokeyChannelVolume(const self: ASAP; channel: Integer): Integer; cdecl; external ASAPLIB;
  173. procedure ASAPInfo_Delete( self: PASAPInfo); cdecl; external ASAPLIB;
  174. function ASAPInfo_GetAuthor(const self: ASAPInfo): PChar; cdecl; external ASAPLIB;
  175. function ASAPInfo_SetAuthor( self: PASAPInfo; value: PChar): Boolean; cdecl; external ASAPLIB;
  176. function ASAPInfo_GetTitle(const self: PASAPInfo): PChar; cdecl; external ASAPLIB;
  177. function ASAPInfo_SetTitle( self: PASAPInfo; value: PChar): Boolean; cdecl; external ASAPLIB;
  178. function ASAPInfo_GetTitleOrFilename(const self: ASAPInfo): PChar; cdecl; external ASAPLIB;
  179. function ASAPInfo_GetDate(const self: PASAPInfo): PChar; cdecl; external ASAPLIB;
  180. function ASAPInfo_SetDate( self: PASAPInfo; value: PChar): Boolean; cdecl; external ASAPLIB;
  181. function ASAPInfo_GetYear(const self: PASAPInfo): Integer; cdecl; external ASAPLIB;
  182. function ASAPInfo_GetMonth(const self: PASAPInfo): Integer; cdecl; external ASAPLIB;
  183. function ASAPInfo_GetDayOfMonth(const self: PASAPInfo): Integer; cdecl; external ASAPLIB;
  184. function ASAPInfo_GetChannels(const self: PASAPInfo): Integer; cdecl; external ASAPLIB;
  185. function ASAPInfo_GetSongs(const self: PASAPInfo): Integer; cdecl; external ASAPLIB;
  186. function ASAPInfo_GetDefaultSong(const self: PASAPInfo): Integer; cdecl; external ASAPLIB;
  187. function ASAPInfo_SetDefaultSong( self: PASAPInfo; song: Integer): Boolean; cdecl; external ASAPLIB;
  188. function ASAPInfo_GetDuration(const self: pASAPInfo; song: Integer): Integer; cdecl; external ASAPLIB;
  189. function ASAPInfo_SetDuration( self: PASAPInfo; song, duration: Integer): Boolean; cdecl; external ASAPLIB;
  190. function ASAPInfo_GetLoop(const self: PASAPInfo; song: Integer): Boolean; cdecl; external ASAPLIB;
  191. function ASAPInfo_SetLoop( self: PASAPInfo; song: Integer; loop: Boolean): Boolean; cdecl; external ASAPLIB;
  192. function ASAPInfo_IsNtsc(const self: PASAPInfo): Boolean; cdecl; external ASAPLIB;
  193. function ASAPInfo_GetTypeLetter(const self: PASAPInfo): Integer; cdecl; external ASAPLIB;
  194. function ASAPInfo_GetPlayerRateScanlines(const self: PASAPInfo): Integer; cdecl; external ASAPLIB;
  195. function ASAPInfo_GetPlayerRateHz(const self: PASAPInfo): Integer; cdecl; external ASAPLIB;
  196. function ASAPInfo_GetMusicAddress(const self: PASAPInfo): Integer; cdecl; external ASAPLIB;
  197. function ASAPInfo_SetMusicAddress( self: PASAPInfo; address: Integer): Boolean; cdecl; external ASAPLIB;
  198. function ASAPInfo_GetInitAddress(const self: PASAPInfo): Integer; cdecl; external ASAPLIB;
  199. function ASAPInfo_GetPlayerAddress(const self: PASAPInfo): Integer; cdecl; external ASAPLIB;
  200. function ASAPInfo_GetCovoxAddress(const self: PASAPInfo): Integer; cdecl; external ASAPLIB;
  201. function ASAPInfo_GetSapHeaderLength(const self: PASAPInfo): Integer; cdecl; external ASAPLIB;
  202. function ASAPInfo_GetInstrumentNamesOffset(const self: PASAPInfo; const module: PByte; moduleLen: Integer): Integer; cdecl; external ASAPLIB;
  203. function ASAPInfo_ParseDuration(s: PChar): Integer; cdecl; external ASAPLIB;
  204. function ASAPInfo_IsOurFile(filename: PChar): Boolean; cdecl; external ASAPLIB;
  205. function ASAPInfo_IsOurExt(ext: PChar): Boolean; cdecl; external ASAPLIB;
  206. function ASAPInfo_Load( self: PASAPInfo; filename: PChar; const module: PByte; moduleLen: Integer): Boolean; cdecl; external ASAPLIB;
  207. function ASAPInfo_GetExtDescription(ext: PChar): PChar; cdecl; external ASAPLIB;
  208. function ASAPInfo_GetOriginalModuleExt(const self: PASAPInfo; const module: PByte; moduleLen: Integer): PChar; cdecl; external ASAPLIB;
  209. function ASAPWriter_New:PASAPWriter;cdecl; external ASAPLIB;
  210. procedure ASAPWriter_Delete( self: ASAPWriter); cdecl; external ASAPLIB;
  211. function ASAPWriter_GetSaveExts(exts: PPointer; const info: PASAPInfo; const module: PByte; moduleLen: Integer): Integer; cdecl; external ASAPLIB;
  212. function ASAPWriter_DurationToString(result: PByte; value: Integer): Integer; cdecl; external ASAPLIB;
  213. procedure ASAPWriter_SetOutput( self: PASAPWriter; output: PByte; startIndex, endIndex: Integer); cdecl; external ASAPLIB;
  214. function ASAPWriter_Write( self: PASAPWriter; targetFilename: PChar; const info: PASAPInfo; const module: PByte; moduleLen: Integer; tag: Boolean): Integer; cdecl; external ASAPLIB;
  215. implementation
  216.  
  217. end.
« Last Edit: December 30, 2024, 07:17:22 pm by Gigatron »
Logged
Trip to Europe...  finished in 40 days !
Pages: [1]
« previous next »
 

TinyPortal © 2005-2018