Forum > Audio and Video
SC68 Player
Gigatron:
Hi,
Another nightmare project to play Atari & Amiga SC68 modules player from Benjamin Gérard ;
This sc68.dll is compiled with visual studio 2019 for X64 and it's on beta stage this mean the
music is not playing correctly now (synch problem), if song end detected it crash !!
Some Amiga converted to SC68 module are supported :
David Whittaker, Delta Music 1.0, Delta Music 2.0, Digital Mugician, Fred Editor (Final), Future Composer 1.0 - 1.3
Future Composer 1.4, Hippel, JamCracker, SidMon 1.0, SidMon 2.0, SoundFX 1.x
https://sc68.atari.org/index.html
Modules are here : https://modland.scenesat.com/pub/modules/SC68/
I think there are 1776 files ;
example modules and project are atached in zip format;
sc68.dll is atached after this thread :)
Main unit :
--- Code: Pascal [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---unit Unit1;{$mode objfpc}{$H+} interface uses Classes, SysUtils, Forms, Controls, Graphics, Dialogs, ExtCtrls, StdCtrls, sc68, mmsystem, windows ; const Channels = 2; BitsPerSample = 16; SampleRate = 44100; // number of samples per second BufSize = 8192 ; // multiple of 2 BufferCount = 1; type { TForm1 } TForm1 = class(TForm) Timer1: TTimer; procedure FormCreate(Sender: TObject); procedure FormShow(Sender: TObject); procedure Timer1Timer(Sender: TObject); private buffers: array[0..BufferCount-1] of array[0..BufSize-1] of byte; waveHeaders: array[0..BufferCount-1] of TWaveHdr; currentBuffer: Integer; public end; var Form1: TForm1; waveOut: HWAVEOUT; waveHeader: TWaveHdr; ok_flag: Boolean = false; fsize : integer; // sc68 sc_init: Tsc68Init; sc_cr: Tsc68Create; sc_inst : Pointer; sc_code : Tsc68Code; sc_minfos : Tsc68MusicInfo ; // music infos SC68Instance: Psc68; implementation {$R *.lfm} { TForm1 } /// audio init et le reste !!procedure HandleError(const Str: PAnsiChar);begin if Str <> nil then begin ShowMessage('Error: Wrong Format ? '+ Str); Halt(1); end;end; function WaveOutCallback(hwo: HWAVEOUT; uMsg: UINT; dwInstance, dwParam1, dwParam2: DWORD_PTR): DWORD; stdcall;begin if uMsg = WOM_DONE then begin waveOutWrite(hwo, @Form1.waveHeaders[Form1.currentBuffer], SizeOf(TWaveHdr) ); Form1.currentBuffer := (Form1.currentBuffer + 1) mod BufferCount; end; Result := 0;end; procedure InitAudio;var wFormat: TWaveFormatEx; i: Integer;begin // SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_TIME_CRITICAL); with wFormat do begin wFormatTag := WAVE_FORMAT_PCM; nChannels := Channels; nSamplesPerSec := SampleRate; wBitsPerSample := BitsPerSample; nBlockAlign := (wBitsPerSample * nChannels) div 8; nAvgBytesPerSec := nSamplesPerSec * nBlockAlign; cbSize := 0; end; if waveOutOpen(@waveOut, WAVE_MAPPER, @wFormat, QWORD(@WaveOutCallback), 0, CALLBACK_FUNCTION) <> MMSYSERR_NOERROR then raise Exception.Create('Erreur ouverture periph audio'); // buffers for i := 0 to BufferCount - 1 do begin ZeroMemory(@Form1.waveHeaders[i], SizeOf(TWaveHdr)); with Form1.waveHeaders[i] do begin lpData := @Form1.buffers[i][0]; dwBufferLength := BufSize * SizeOf(Byte); dwFlags := 0; end; waveOutPrepareHeader(waveOut, @Form1.waveHeaders[i], SizeOf(TWaveHdr)); waveOutWrite(waveOut, @Form1.waveHeaders[i], SizeOf(TWaveHdr)); end; Form1.currentBuffer := 0; end; procedure LoadBinaryFileToBuffer(const FileName: string; var Buffer: TBytes);var MemoryStream: TMemoryStream;begin MemoryStream := TMemoryStream.Create; try MemoryStream.LoadFromFile(FileName); SetLength(Buffer, MemoryStream.Size); // Ajuste la taille du buffer MemoryStream.ReadBuffer(Buffer[0], MemoryStream.Size); fsize := MemoryStream.Size; finally MemoryStream.Free; end;end; procedure TForm1.FormCreate(Sender: TObject);var FileName: string; appname: array[0..8] of Char = 'Lazarus'#0; argv: array[0..0] of PChar; Buffer: array of Byte; n: integer;begin // Initialise les paramètres SC68 un cauchemar !!!! FillChar(sc_init, SizeOf(Tsc68Init), 0); argv[0] := appname; sc_init.argc := Length(argv); sc_init.argv := @argv[0]; sc_init.Flags.NoLoadConfig:=false; FileName := 'paradox.sc68'; sc_init.sampling_rate := 44100; // Initialisation de SC68 if sc68_init(sc_init) < 0 then begin ShowMessage('Erreur d''initialisation SC68'); Exit; end; // Crée une instance SC68 FillChar(sc_cr, SizeOf(sc_cr), 0); sc_cr.SamplingRate := 44100; sc_cr.Name := PChar('Lazarus'#0); SC68Instance := sc68_create(sc_cr); if SC68Instance = nil then begin ShowMessage('Erreur lors de la creation de l''instance SC68'); Exit; end; // Charge le fichier SC68 en memoire dans buffer; LoadBinaryFileToBuffer(FileName, Buffer ); if sc68_load_mem(SC68Instance, @Buffer[0], Length(Buffer)) < 0 then begin ShowMessage('Erreur lors du chargement du fichier SC68'); Exit; end; end; procedure TForm1.FormShow(Sender: TObject);begin InitAudio; ok_flag := true; Timer1.Enabled:= true; end; procedure TForm1.Timer1Timer(Sender: TObject); var n: integer; Buffer: array [0..BufSize-1] of byte;begin Timer1.Interval := Round((8192 / (44100 * 2 * 2)) * 1000); n := BufSize div (Channels * (BitsPerSample div 8)) ; if sc68_process(SC68Instance, @Buffer[0], @n) < 0 then begin Timer1.Enabled:= false; ShowMessage('Erreur traitement SC68 !! Or File Not Loaded'); Exit; end; Move(Buffer[0], buffers[0][0], n * Channels * (BitsPerSample div 8)); end; end.
sc68 unit:
--- Code: Pascal [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---unit sc68; {$mode objfpc}{$H+} interface uses SysUtils; type Psc68 = ^Tsc68; Tsc68 = record end; Tsc68Disk = Pointer; Tsc68MsgHandler = procedure(cat: Integer; sc68: Psc68; fmt: PChar; args: Pointer); cdecl; Tsc68InitFlags = record NoLoadConfig: Boolean; NoSaveConfig: Boolean; end; { Paramètres d'initialisation de l'API } Tsc68Init = record MsgHandler: Tsc68MsgHandler; DebugClrMask: Integer; DebugSetMask: Integer; Argc: Integer; Argv: PChar; Flags: Tsc68InitFlags; shared_path : PChar; user_path : PChar; lmusic_path: PChar; rmusic_path: PChar; sampling_rate : UInt16; end; init68 = ^Tsc68Init; Tsc68Create = record SamplingRate: Cardinal; Name: PChar; Log2Mem: Integer; Emu68Debug: Integer; Cookie: Pointer; end; Tsc68Tag = record Key: PChar; Value: PChar; end; Tsc68CInfo = record Track: Cardinal; TimeMs: Cardinal; TimeStr: array[0..11] of Char; UsesYM: Boolean; UsesSTE: Boolean; UsesAmiga: Boolean; UsesASID: Boolean; HardwareName: PChar; TagCount: Integer; Tags: ^Tsc68Tag; end; Tsc68MusicInfo = record Tracks: Integer; Addr: Cardinal; Rate: Cardinal; Replay: PChar; DiskInfo: Tsc68CInfo; TrackInfo: Tsc68CInfo; Album: PChar; Title: PChar; Artist: PChar; Format: PChar; Genre: PChar; Year: PChar; Ripper: PChar; Converter: PChar; LastTag: PChar; end; Psc68MusicInfo = ^Tsc68MusicInfo; Tsc68MInfo = Tsc68MusicInfo; Tsc68Code = ( SC68_IDLE = 1 shl 0, SC68_CHANGE = 1 shl 1, SC68_LOOP = 1 shl 2, SC68_END = 1 shl 3, SC68_SEEK = 1 shl 4, SC68_OK = 0, SC68_ERROR = -1 ); Tsc68Spr = ( SC68_SPR_QUERY = -1, SC68_SPR_DEFAULT = 0 ); Tsc68Play = ( SC68_DSK_TRACK = 0, SC68_DEF_LOOP = 0, SC68_INF_LOOP = -1, SC68_DEF_TRACK = -1, SC68_CUR_TRACK = -2, SC68_CUR_LOOP = -2 ); Tsc68PCM = ( SC68_PCM_S16 = 1, SC68_PCM_F32 = 2 ); Tsc68ASID = ( SC68_ASID_OFF = 0, SC68_ASID_ON = 1, SC68_ASID_FORCE = 2, SC68_ASID_NO_A = 4, SC68_ASID_NO_B = 8, SC68_ASID_NO_C = 16 ); Tsc68Cntl = ( SC68_NOP = 0, SC68_GET_LAST, SC68_GET_NAME, SC68_GET_TRACKS, SC68_GET_TRACK, SC68_GET_DEFTRK, SC68_GET_LOOPS, SC68_GET_LOOP, SC68_GET_DISK, SC68_GET_SPR, SC68_SET_SPR, SC68_GET_LEN, SC68_GET_TRKLEN, SC68_GET_DSKLEN, SC68_GET_ORG, SC68_GET_TRKORG, SC68_GET_POS, SC68_GET_DSKPOS, SC68_GET_PLAYPOS, SC68_SET_POS, SC68_GET_PCM, SC68_SET_PCM, SC68_CAN_ASID, SC68_GET_ASID, SC68_SET_ASID, SC68_GET_COOKIE, SC68_SET_COOKIE, SC68_EMULATORS, SC68_CONFIG_LOAD, SC68_CONFIG_SAVE, SC68_ENUM_OPT, SC68_GET_OPT, SC68_SET_OPT_STR, SC68_SET_OPT_INT, SC68_DIAL, SC68_CNTL_LAST ); function sc68_version: Integer; cdecl; external 'sc68.dll'; function sc68_versionstr: PChar; cdecl; external 'sc68.dll'; function sc68_init(var init: Tsc68Init): Integer; cdecl; external 'sc68.dll' name 'sc68_init'; procedure sc68_shutdown; cdecl; external 'sc68.dll'; function sc68_create(create: Tsc68Create): Pointer; cdecl; external 'sc68.dll' name 'sc68_create'; procedure sc68_destroy(sc68: Psc68); cdecl; external 'sc68.dll'; function sc68_cntl(sc68: Psc68; op: Integer; args: array of const): Integer; cdecl; external 'sc68.dll';// function sc68_error(sc68: Psc68): PChar; cdecl; external 'sc68.dll'; function sc68_process(sc68: Psc68; buf: Pointer; n: pointer): integer; cdecl; external 'sc68.dll' name 'sc68_process'; function sc68_play(sc68: Psc68; track, loop: Integer): Integer; cdecl; external 'sc68.dll'; function sc68_stop(sc68: Psc68): Integer; cdecl; external 'sc68.dll'; function sc68_music_info(sc68: Psc68; info: Psc68MusicInfo; track: Integer; disk: Tsc68Disk): Integer; cdecl; external 'sc68.dll'; function sc68_tag_get(sc68: Psc68; tag: Tsc68Tag; track: Integer; disk: Tsc68Disk): Integer; cdecl; external 'sc68.dll'; function sc68_tag(sc68: Psc68; key: PChar; track: Integer; disk: Tsc68Disk): PChar; cdecl; external 'sc68.dll'; function sc68_tag_enum(sc68: Psc68; tag: Tsc68Tag; track, idx: Integer; disk: Tsc68Disk): Integer; cdecl; external 'sc68.dll'; function sc68_mimetype: PChar; cdecl; external 'sc68.dll'; function sc68_vfs(uri: PChar; mode, argc: Integer; args: array of const): Pointer; cdecl; external 'sc68.dll'; function sc68_is_our_uri(uri, exts: PChar; var is_remote: Integer): Integer; cdecl; external 'sc68.dll'; function sc68_load(sc68: Psc68; is_: Pointer): Integer; cdecl; external 'sc68.dll'; function sc68_load_uri(sc68: Psc68; uri: PChar): Integer; cdecl; external 'sc68.dll'; function sc68_load_mem(sc68: Psc68; buffer: Pointer; len: Integer): Integer; cdecl; external 'sc68.dll'; function sc68_load_disk(is_: Pointer): Tsc68Disk; cdecl; external 'sc68.dll'; function sc68_load_disk_uri(uri: PChar): Tsc68Disk; cdecl; external 'sc68.dll'; function sc68_disk_load_mem(buffer: Pointer; len: Integer): Tsc68Disk; cdecl; external 'sc68.dll'; procedure sc68_disk_free(disk: Tsc68Disk); cdecl; external 'sc68.dll'; function sc68_open(sc68: Psc68; disk: Tsc68Disk): Integer; cdecl; external 'sc68.dll'; procedure sc68_close(sc68: Psc68); cdecl; external 'sc68.dll'; function sc68_ym_channels(sc68: Psc68; channels: Integer): Integer; cdecl; external 'sc68.dll'; implementation end.
Gigatron:
And then the sc68.dll ;
The modules must be in the project directory ;
I am working to improve it, so stay tuned.
Regards
Gigatron
Gigatron:
Okey, now some corrections are done to play sc68 module perfectly (the synchro problem is fixed , timer removed ) !
Music end detection flag was added ;
** Edit music info added ; Main unit & sc68 unit was changed !! so replace them by this one ;
--- 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, sc68, mmsystem, windows ; const Channels = 2; BitsPerSample = 16; SampleRate = 44100; // number of samples per second BufSize = 8192 ; // multiple of 2 BufferCount = 2; type { TForm1 } TForm1 = class(TForm) Memo1: TMemo; Timer1: TTimer; procedure FormCreate(Sender: TObject); procedure FormShow(Sender: TObject); procedure Timer1Timer(Sender: TObject); procedure Process_SC68(BufferIndex: Integer); procedure CloseAudio; private buffers: array[0..BufferCount-1] of array[0..BufSize-1] of byte; waveHeaders: array[0..BufferCount-1] of TWaveHdr; currentBuffer: Integer; Music_Finished: Boolean; public end; var Form1: TForm1; waveOut: HWAVEOUT; waveHeader: TWaveHdr; fsize : integer; // sc68 sc_init: Tsc68Init; sc_cr: Tsc68Create; sc_inst : Pointer; sc_code : Tsc68Code; sc_minfos : Tsc68MusicInfo ; // music infos sc_disc : Tsc68Disk; SC68Instance: Psc68; implementation {$R *.lfm} { TForm1 } /// audio init et le reste !!procedure HandleError(const Str: PAnsiChar);begin if Str <> nil then begin ShowMessage('Error: Wrong Format ? '+ Str); Halt(1); end;end; function WaveOutCallback(hwo: HWAVEOUT; uMsg: UINT; dwInstance, dwParam1, dwParam2: DWORD_PTR): DWORD; stdcall;begin if uMsg = WOM_DONE then begin Form1.Process_SC68(Form1.currentBuffer); waveOutWrite(hwo, @Form1.waveHeaders[Form1.currentBuffer], SizeOf(TWaveHdr)); Form1.currentBuffer := (Form1.currentBuffer + 1) mod BufferCount; end; Result := 0;end; procedure InitAudio;var wFormat: TWaveFormatEx; i: Integer;begin SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_TIME_CRITICAL); with wFormat do begin wFormatTag := 1; // pcm nChannels := Channels; nSamplesPerSec := SampleRate; wBitsPerSample := BitsPerSample; nBlockAlign := (wBitsPerSample * nChannels) div 8; nAvgBytesPerSec := nSamplesPerSec * nBlockAlign; cbSize := 0; end; if waveOutOpen(@waveOut, WAVE_MAPPER, @wFormat, QWORD(@WaveOutCallback), 0, CALLBACK_FUNCTION) <> MMSYSERR_NOERROR then raise Exception.Create('Erreur ouverture periph audio'); // buffers init for i := 0 to BufferCount - 1 do begin ZeroMemory(@Form1.waveHeaders[i], SizeOf(TWaveHdr)); with Form1.waveHeaders[i] do begin lpData := @Form1.buffers[i][0]; dwBufferLength := BufSize * SizeOf(Byte); dwFlags := 0; end; waveOutPrepareHeader(waveOut, @Form1.waveHeaders[i], SizeOf(TWaveHdr)); waveOutWrite(waveOut, @Form1.waveHeaders[i], SizeOf(TWaveHdr)); end; Form1.currentBuffer := 0; end; procedure LoadBinaryFileToBuffer(const FileName: string; var Buffer: TBytes);var MemoryStream: TMemoryStream;begin MemoryStream := TMemoryStream.Create; try MemoryStream.LoadFromFile(FileName); SetLength(Buffer, MemoryStream.Size); // Ajuste la taille du buffer MemoryStream.ReadBuffer(Buffer[0], MemoryStream.Size); fsize := MemoryStream.Size; finally MemoryStream.Free; end;end; procedure TForm1.FormCreate(Sender: TObject);var FileName: string; appname: array[0..8] of Char = 'Lazarus'#0; argv: array[0..0] of PChar; Buffer: array of Byte; begin // Initialise les paramètres SC68 un cauchemar !!!! FillChar(sc_init, SizeOf(Tsc68Init), 0); argv[0] := appname; sc_init.argc := Length(argv); sc_init.argv := @argv[0]; sc_init.Flags.NoLoadConfig:=false; FileName := 'barbarian2.sc68'; sc_init.sampling_rate := 44100; // Initialisation de SC68 if sc68_init(sc_init) < 0 then begin ShowMessage('Erreur d''initialisation SC68'); Exit; end; // instance SC68 FillChar(sc_cr, SizeOf(sc_cr), 0); sc_cr.SamplingRate := 44100; sc_cr.Name := PChar('Lazarus'#0); SC68Instance := sc68_create(sc_cr); if SC68Instance = nil then begin ShowMessage('Erreur lors de la creation de l''instance SC68'); Exit; end; // Charge le fichier SC68 en memoire dans buffer; LoadBinaryFileToBuffer(FileName, Buffer ); if sc68_load_mem(SC68Instance, @Buffer[0], Length(Buffer)) < 0 then begin ShowMessage('Erreur lors du chargement du fichier SC68'); Exit; end; end; procedure TForm1.FormShow(Sender: TObject);begin Music_Finished := false; InitAudio; sc68_music_info(SC68Instance,sc_minfos,0,sc_disc); memo1.clear; memo1.Lines.Add( Pchar(sc_minfos.Album)); memo1.Lines.Add( Pchar(sc_minfos.Title)); memo1.Lines.Add( Pchar(sc_minfos.Artist)); memo1.Lines.Add( Pchar(sc_minfos.Format)); memo1.Lines.Add( Pchar(sc_minfos.Genre)); memo1.Lines.Add( Pchar(sc_minfos.Year)); memo1.Lines.Add( Pchar(sc_minfos.Ripper)); memo1.Lines.Add( Pchar(sc_minfos.Converter)); memo1.Lines.Add( Pchar(sc_minfos.LastTag)); end; procedure TForm1.Process_SC68(BufferIndex: Integer);var Samples: Integer; resultCode: Tsc68Code;begin if not Music_Finished then begin Samples := BufSize div (Channels * (BitsPerSample div 8)); resultCode := Tsc68Code(sc68_process(SC68Instance, @buffers[BufferIndex][0], @Samples)); if (Int64(resultCode) and Int64(SC68_END)) <> 0 then begin Music_Finished := True; ShowMessage('Musique terminée!'); CloseAudio; Exit; end; end;end; procedure TForm1.CloseAudio;var i: Integer;begin for i := 0 to BufferCount - 1 do begin waveOutUnprepareHeader(waveOut, @waveHeaders[i], SizeOf(TWaveHdr)); end; waveOutClose(waveOut);end; // not need here !!!procedure TForm1.Timer1Timer(Sender: TObject);beginend; end.
SC68 Unit :
--- Code: Pascal [+][-]window.onload = function(){var x1 = document.getElementById("main_content_section"); if (x1) { var x = document.getElementsByClassName("geshi");for (var i = 0; i < x.length; i++) { x[i].style.maxHeight='none'; x[i].style.height = Math.min(x[i].clientHeight+15,306)+'px'; x[i].style.resize = "vertical";}};} ---unit sc68; {$mode objfpc}{$H+} interface uses SysUtils; type Psc68 = ^Tsc68; Tsc68 = record end; Tsc68Disk = Pointer; Tsc68MsgHandler = procedure(cat: Integer; sc68: Psc68; fmt: PChar; args: Pointer); cdecl; Tsc68InitFlags = record NoLoadConfig: Boolean; NoSaveConfig: Boolean; end; { Paramètres d'initialisation de l'API } Tsc68Init = record MsgHandler: Tsc68MsgHandler; DebugClrMask: Integer; DebugSetMask: Integer; Argc: Integer; Argv: PChar; Flags: Tsc68InitFlags; shared_path : PChar; user_path : PChar; lmusic_path: PChar; rmusic_path: PChar; sampling_rate : UInt16; end; init68 = ^Tsc68Init; Tsc68Create = record SamplingRate: Cardinal; Name: PChar; Log2Mem: Integer; Emu68Debug: Integer; Cookie: Pointer; end; Tsc68Tag = record Key: PChar; Value: PChar; end; Tsc68CInfo = record Track: Cardinal; TimeMs: Cardinal; TimeStr: array[0..11] of Char; UsesYM: Boolean; UsesSTE: Boolean; UsesAmiga: Boolean; UsesASID: Boolean; HardwareName: PChar; TagCount: Integer; Tags: ^Tsc68Tag; end; Tsc68MusicInfo = record Tracks: Integer; Addr: Cardinal; Rate: Cardinal; Replay: PChar; DiskInfo: Tsc68CInfo; TrackInfo: Tsc68CInfo; Album: PChar; Title: PChar; Artist: PChar; Format: PChar; Genre: PChar; Year: PChar; Ripper: PChar; Converter: PChar; LastTag: PChar; end; Psc68MusicInfo = ^Tsc68MusicInfo; Tsc68MInfo = Tsc68MusicInfo; type Tsc68Code = ( SC68_IDLE = 1 shl 0, SC68_CHANGE = 1 shl 1, SC68_LOOP = 1 shl 2, SC68_END = 1 shl 3, SC68_SEEK = 1 shl 4, SC68_OK = 0, SC68_ERROR = -1 ); Tsc68Spr = ( SC68_SPR_QUERY = -1, SC68_SPR_DEFAULT = 0 ); Tsc68Play = ( SC68_DSK_TRACK = 0, SC68_DEF_LOOP = 0, SC68_INF_LOOP = -1, SC68_DEF_TRACK = -1, SC68_CUR_TRACK = -2, SC68_CUR_LOOP = -2 ); Tsc68PCM = ( SC68_PCM_S16 = 1, SC68_PCM_F32 = 2 ); Tsc68ASID = ( SC68_ASID_OFF = 0, SC68_ASID_ON = 1, SC68_ASID_FORCE = 2, SC68_ASID_NO_A = 4, SC68_ASID_NO_B = 8, SC68_ASID_NO_C = 16 ); Tsc68Cntl = ( SC68_NOP = 0, SC68_GET_LAST, SC68_GET_NAME, SC68_GET_TRACKS, SC68_GET_TRACK, SC68_GET_DEFTRK, SC68_GET_LOOPS, SC68_GET_LOOP, SC68_GET_DISK, SC68_GET_SPR, SC68_SET_SPR, SC68_GET_LEN, SC68_GET_TRKLEN, SC68_GET_DSKLEN, SC68_GET_ORG, SC68_GET_TRKORG, SC68_GET_POS, SC68_GET_DSKPOS, SC68_GET_PLAYPOS, SC68_SET_POS, SC68_GET_PCM, SC68_SET_PCM, SC68_CAN_ASID, SC68_GET_ASID, SC68_SET_ASID, SC68_GET_COOKIE, SC68_SET_COOKIE, SC68_EMULATORS, SC68_CONFIG_LOAD, SC68_CONFIG_SAVE, SC68_ENUM_OPT, SC68_GET_OPT, SC68_SET_OPT_STR, SC68_SET_OPT_INT, SC68_DIAL, SC68_CNTL_LAST ); function sc68_version: Integer; cdecl; external 'sc68.dll'; function sc68_versionstr: PChar; cdecl; external 'sc68.dll'; function sc68_init(var init: Tsc68Init): Integer; cdecl; external 'sc68.dll' name 'sc68_init'; procedure sc68_shutdown; cdecl; external 'sc68.dll'; function sc68_create(create: Tsc68Create): Pointer; cdecl; external 'sc68.dll' name 'sc68_create'; procedure sc68_destroy(sc68: Psc68); cdecl; external 'sc68.dll'; function sc68_cntl(sc68: Psc68; op: Integer; args: array of const): Integer; cdecl; external 'sc68.dll';// function sc68_error(sc68: Psc68): PChar; cdecl; external 'sc68.dll'; function sc68_process(sc68: Psc68; buf: Pointer; n: pointer): integer; cdecl; external 'sc68.dll' name 'sc68_process'; function sc68_play(sc68: Psc68; track, loop: Integer): Integer; cdecl; external 'sc68.dll'; function sc68_stop(sc68: Psc68): Integer; cdecl; external 'sc68.dll'; function sc68_music_info(sc68: Psc68; info: Tsc68MusicInfo; track: Integer; disk: Tsc68Disk): Integer; cdecl; external 'sc68.dll'; function sc68_tag_get(sc68: Psc68; tag: Tsc68Tag; track: Integer; disk: Tsc68Disk): Integer; cdecl; external 'sc68.dll'; function sc68_tag(sc68: Psc68; key: PChar; track: Integer; disk: Tsc68Disk): PChar; cdecl; external 'sc68.dll'; function sc68_tag_enum(sc68: Psc68; tag: Tsc68Tag; track, idx: Integer; disk: Tsc68Disk): Integer; cdecl; external 'sc68.dll'; function sc68_mimetype: PChar; cdecl; external 'sc68.dll'; function sc68_vfs(uri: PChar; mode, argc: Integer; args: array of const): Pointer; cdecl; external 'sc68.dll'; function sc68_is_our_uri(uri, exts: PChar; var is_remote: Integer): Integer; cdecl; external 'sc68.dll'; function sc68_load(sc68: Psc68; is_: Pointer): Integer; cdecl; external 'sc68.dll'; function sc68_load_uri(sc68: Psc68; uri: PChar): Integer; cdecl; external 'sc68.dll'; function sc68_load_mem(sc68: Psc68; buffer: Pointer; len: Integer): Integer; cdecl; external 'sc68.dll'; function sc68_load_disk(is_: Pointer): Tsc68Disk; cdecl; external 'sc68.dll'; function sc68_load_disk_uri(uri: PChar): Tsc68Disk; cdecl; external 'sc68.dll'; function sc68_disk_load_mem(buffer: Pointer; len: Integer): Tsc68Disk; cdecl; external 'sc68.dll'; procedure sc68_disk_free(disk: Tsc68Disk); cdecl; external 'sc68.dll'; function sc68_open(sc68: Psc68; disk: Tsc68Disk): Integer; cdecl; external 'sc68.dll'; procedure sc68_close(sc68: Psc68); cdecl; external 'sc68.dll'; function sc68_ym_channels(sc68: Psc68; channels: Integer): Integer; cdecl; external 'sc68.dll'; implementation end.
TRon:
fwiw:
--- 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";}};} --- if sc68_load_uri(decoder, pchar(Filename)) = 0 then writeln('file ', Filename, ' loaded to sc68 memory') else writeln('ERROR: unable to load file into sc68 memory (', sc68_error(decoder), ')');
Gigatron:
--- Quote from: TRon on November 22, 2024, 07:30:10 pm ---fwiw:
--- 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";}};} --- if sc68_load_uri(decoder, pchar(Filename)) = 0 then writeln('file ', Filename, ' loaded to sc68 memory') else writeln('ERROR: unable to load file into sc68 memory (', sc68_error(decoder), ')');
I always said you were a fantastic programmer :) merci
--- End quote ---
--- 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, sc68, mmsystem, windows ; const Channels = 2; BitsPerSample = 16; SampleRate = 44100; // number of samples per second BufSize = 8192 ; // multiple of 2 BufferCount = 2; type { TForm1 } TForm1 = class(TForm) Label1: TLabel; Memo1: TMemo; Timer1: TTimer; procedure FormCreate(Sender: TObject); procedure FormShow(Sender: TObject); procedure Timer1Timer(Sender: TObject); procedure Process_SC68(BufferIndex: Integer); procedure CloseAudio; private buffers: array[0..BufferCount-1] of array[0..BufSize-1] of byte; waveHeaders: array[0..BufferCount-1] of TWaveHdr; currentBuffer: Integer; Music_Finished: Boolean; public end; var Form1: TForm1; waveOut: HWAVEOUT; waveHeader: TWaveHdr; fsize : integer; // sc68 sc_init: Tsc68Init; sc_cr: Tsc68Create; sc_inst : Pointer; sc_code : Tsc68Code; sc_minfos : Tsc68MusicInfo ; // music infos sc_disc : Tsc68Disk; SC68Instance: Psc68; implementation {$R *.lfm} { TForm1 } /// audio init et le reste !!procedure HandleError(const Str: PAnsiChar);begin if Str <> nil then begin ShowMessage('Error: Wrong Format ? '+ Str); Halt(1); end;end; function WaveOutCallback(hwo: HWAVEOUT; uMsg: UINT; dwInstance, dwParam1, dwParam2: DWORD_PTR): DWORD; stdcall;begin if uMsg = WOM_DONE then begin Form1.Process_SC68(Form1.currentBuffer); waveOutWrite(hwo, @Form1.waveHeaders[Form1.currentBuffer], SizeOf(TWaveHdr)); Form1.currentBuffer := (Form1.currentBuffer + 1) mod BufferCount; end; Result := 0;end; procedure InitAudio;var wFormat: TWaveFormatEx; i: Integer;begin SetThreadPriority(GetCurrentThread, THREAD_PRIORITY_TIME_CRITICAL); with wFormat do begin wFormatTag := 1; // pcm nChannels := Channels; nSamplesPerSec := SampleRate; wBitsPerSample := BitsPerSample; nBlockAlign := (wBitsPerSample * nChannels) div 8; nAvgBytesPerSec := nSamplesPerSec * nBlockAlign; cbSize := 0; end; if waveOutOpen(@waveOut, WAVE_MAPPER, @wFormat, QWORD(@WaveOutCallback), 0, CALLBACK_FUNCTION) <> MMSYSERR_NOERROR then raise Exception.Create('Erreur ouverture periph audio'); // buffers init for i := 0 to BufferCount - 1 do begin ZeroMemory(@Form1.waveHeaders[i], SizeOf(TWaveHdr)); with Form1.waveHeaders[i] do begin lpData := @Form1.buffers[i][0]; dwBufferLength := BufSize * SizeOf(Byte); dwFlags := 0; end; waveOutPrepareHeader(waveOut, @Form1.waveHeaders[i], SizeOf(TWaveHdr)); waveOutWrite(waveOut, @Form1.waveHeaders[i], SizeOf(TWaveHdr)); end; Form1.currentBuffer := 0; end; procedure TForm1.FormCreate(Sender: TObject);var FileName: string; appname: array[0..8] of Char = 'Lazarus'#0; argv: array[0..0] of PChar;begin // Initialise les paramètres SC68 un cauchemar !!!! FillChar(sc_init, SizeOf(Tsc68Init), 0); argv[0] := appname; sc_init.argc := Length(argv); sc_init.argv := @argv[0]; sc_init.Flags.NoLoadConfig:=false; FileName := 'barbarian2.sc68'; sc_init.sampling_rate := 44100; // Initialisation de SC68 if sc68_init(sc_init) < 0 then begin ShowMessage('Erreur d''initialisation SC68'); Exit; end; // instance SC68 FillChar(sc_cr, SizeOf(sc_cr), 0); sc_cr.SamplingRate := 44100; sc_cr.Name := PChar('Lazarus'#0); SC68Instance := sc68_create(sc_cr); if SC68Instance = nil then begin ShowMessage('Erreur lors de la creation de l''instance SC68'); Exit; end; // Charge le fichier SC68 ; sc68_load_uri(SC68Instance, pchar(Filename)) ; end; procedure TForm1.FormShow(Sender: TObject);begin Music_Finished := false; InitAudio; sc68_music_info(SC68Instance,sc_minfos,0,sc_disc); memo1.clear; memo1.Lines.Add( Pchar(sc_minfos.Album)); memo1.Lines.Add( Pchar(sc_minfos.Title)); memo1.Lines.Add( Pchar(sc_minfos.Artist)); memo1.Lines.Add( Pchar(sc_minfos.Format)); memo1.Lines.Add( Pchar(sc_minfos.Genre)); memo1.Lines.Add( Pchar(sc_minfos.Year)); memo1.Lines.Add( Pchar(sc_minfos.Ripper)); memo1.Lines.Add( Pchar(sc_minfos.Converter)); memo1.Lines.Add( Pchar(sc_minfos.LastTag)); end; procedure TForm1.Process_SC68(BufferIndex: Integer);var Samples: Integer; resultCode: Tsc68Code;begin if not Music_Finished then begin Samples := BufSize div (Channels * (BitsPerSample div 8)); resultCode := Tsc68Code(sc68_process(SC68Instance, @buffers[BufferIndex][0], @Samples)); if (Int64(resultCode) and Int64(SC68_END)) <> 0 then begin Music_Finished := True; ShowMessage('Musique terminée!'); CloseAudio; Exit; end; end;end; procedure TForm1.CloseAudio;var i: Integer;begin for i := 0 to BufferCount - 1 do begin waveOutUnprepareHeader(waveOut, @waveHeaders[i], SizeOf(TWaveHdr)); end; waveOutClose(waveOut);end; // not need here !!!procedure TForm1.Timer1Timer(Sender: TObject);beginend; end.
Navigation
[0] Message Index
[#] Next page