Forum > Audio and Video
Future Composer Player
Gigatron:
Hi,
Here is another great player from Amiga called Future Composer (C) Supersero of Superions 1990.(fc1.4)
C language wrapper library for Future Composer audio decoder
Copyright (C) 2008 Michael Schwendt
The library is compiled with Visual studio 2019 for X64 windows i have not linux installed sorry;
Demo music : Bit_arts; project, fc dynamic library in zip format are attached;
You can download FC 1.3 or FC 1.4 musics here :
https://modland.com/pub/modules/Future%20Composer%201.3/
https://modland.com/pub/modules/Future%20Composer%201.4/
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, fc_lib, mmsystem, windows; const Channels = 2; BitsPerSample = 16; SampleRate = 44100; // Nombre d'échantillons par seconde BufSize = 8192; // Taille du tampon audio x 2 BufferCount = 2; 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; fc_mus: Pointer; ok_flag: Boolean = false; fsize : integer; implementation {$R *.lfm} procedure HandleError(const Str: PAnsiChar);begin if Str <> nil then begin ShowMessage('Error: ' + Str); Halt(1); end;end; procedure FillBuffer(bufferIndex: Integer); begin if ok_flag then begin // ShowMessage('Remplissage buffer ici'); bufferIndex := Form1.currentBuffer; fc14dec_buffer_fill(fc_mus, @Form1.buffers[bufferIndex][0], BufSize ); end;end; function WaveOutCallback(hwo: HWAVEOUT; uMsg: UINT; dwInstance, dwParam1, dwParam2: DWORD_PTR): DWORD; stdcall;begin if uMsg = WOM_DONE then begin FillBuffer(Form1.currentBuffer); waveOutWrite(waveOut, @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_LOWEST); 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 lors de l''ouverture du périphérique audio'); // Préparation des tampons 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 ; dwFlags := 0; FillBuffer(i); end; waveOutPrepareHeader(waveOut, @Form1.waveHeaders[i], SizeOf(TWaveHdr)); end; Form1.currentBuffer := 0; for i := 0 to BufferCount - 1 do begin FillBuffer(i); waveOutWrite(waveOut, @Form1.waveHeaders[i], SizeOf(TWaveHdr)); end;end; procedure 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 Buffer: array of Byte; FileName: string; begin FileName := 'billy_the_kid.fc'; try LoadBinaryFileToBuffer(FileName, Buffer); except on E: Exception do ShowMessage('Erreur : ' ); end; // Initialisation du décodeur fc_mus := fc14dec_new; fc14dec_init(fc_mus, PByte(Buffer), fsize); fc14dec_mixer_init(fc_mus, 44100, 16, 2, 0); fc14dec_enableNtsc(fc_mus,false); end; procedure TForm1.FormShow(Sender: TObject);begin InitAudio; ok_flag := true; end; procedure TForm1.Timer1Timer(Sender: TObject);begin end; end. Fc library 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 fc_lib; {$mode objfpc}{$H+} interface uses windows; const FCLIB = 'futurecomposer.dll'; //type// TFC = class(TPaulaPlayer)// private// _dummyVoices: array[0..3] of TPaulaVoice;//// input: PByte;// inputLen: word;//// var silenceData: array[0..7] of Byte;// var periods: array[0..(5+6)*12+4-1] of Word;// var SMOD_waveInfo: array[0..47*4-1] of Word;// var SMOD_waveforms: array of Byte;////// public// songEnd: Boolean; // whether song end has been reached// isSMOD: Boolean; // whether file is in Future Composer 1.0 - 1.3 format// isFC14: Boolean; // whether file is in Future Composer 1.4 format//// formatName: string;// const SMOD_FORMAT_NAME = 'Future Composer 1.0-1.3';// const FC14_FORMAT_NAME = 'Future Composer 1.4';// const UNKNOWN_FORMAT_NAME = 'Unknown Format';//// const SMOD_SONGTAB_OFFSET = $0064; // 100// const FC14_SMPHEADERS_OFFSET = $0028; // 40// const FC14_WAVEHEADERS_OFFSET = $0064; // 100// const FC14_SONGTAB_OFFSET = $00B4; // 180//// const TRACKTAB_ENTRY_LENGTH = $000D; // 3*4+1// const PATTERN_LENGTH = $0040; // 32*2// const PATTERN_BREAK = $49;//// const SEQ_END = $E1;//// const SNDMOD_LOOP = $E0;// const SNDMOD_END = SEQ_END;// const SNDMOD_SETWAVE = $E2;// const SNDMOD_CHANGEWAVE = $E4;// const SNDMOD_NEWVIB = $E3;// const SNDMOD_SUSTAIN = $E8;// const SNDMOD_NEWSEQ = $E7;// const SNDMOD_SETPACKWAVE = $E9;// const SNDMOD_PITCHBEND = $EA;//// const ENVELOPE_LOOP = $E0;// const ENVELOPE_END = SEQ_END;// const ENVELOPE_SUSTAIN = $E8;// const ENVELOPE_SLIDE = $EA;//////// end; function fc14dec_new: Pointer; cdecl; external FCLIB;procedure fc14dec_delete(decoder: Pointer); cdecl; external FCLIB;function fc14dec_detect(decoder: Pointer; buffer: Pointer; length: Cardinal): Integer; cdecl; external FCLIB;function fc14dec_init(decoder: Pointer; buffer: Pointer; length: Cardinal): Integer; cdecl; external FCLIB;procedure fc14dec_restart(decoder: Pointer); cdecl; external FCLIB;procedure fc14dec_mixer_init(decoder: Pointer; frequency: Integer; precision: Integer; channels: Integer; zero: Integer); cdecl; external FCLIB;function fc14dec_song_end(decoder: Pointer): Integer; cdecl; external FCLIB;function fc14dec_duration(decoder: Pointer): Cardinal; cdecl; external FCLIB;procedure fc14dec_seek(decoder: Pointer; ms: LongInt); cdecl; external FCLIB;function fc14dec_format_name(decoder: Pointer): PChar; cdecl; external FCLIB;function fc14dec_buffer_fill(decoder: Pointer; buffer: Pointer; length: UINT): UINT; cdecl; external FCLIB;function fc14dec_isFC14(decoder: Pointer): Integer; cdecl; external FCLIB;procedure fc14dec_enableNtsc(decoder: Pointer; isEnabled: Boolean); cdecl; external FCLIB; implementation end.
hukka:
I have sources for a native FreePascal FC replayer at: https://github.com/hukkax/CaniNES/tree/main/src/basement/playroutines
Gigatron:
--- Quote from: hukka on November 10, 2024, 05:18:10 am ---I have sources for a native FreePascal FC replayer at: https://github.com/hukkax/CaniNES/tree/main/src/basement/playroutines
--- End quote ---
Thank you @hukka , interesting to understand how this FC library work in FreePascal;
TRon:
Very nice hukka.
It required some work to get a (more or less) standalone frame-decoder ( Linux only, using libao).
Original license(s) applies.
Guva:
I will make my contribution
However, there is a problem . For some reason it only works in {$mode delphi}
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 delphi}{$H+} interface uses Classes, SysUtils, Forms, Controls, Graphics, Dialogs, StdCtrls, raudio, fc_lib; type { TForm1 } TForm1 = class(TForm) Button1: TButton; Memo1: TMemo; OpenDialog1: TOpenDialog; procedure Button1Click(Sender: TObject); procedure FormClose(Sender: TObject; var CloseAction: TCloseAction); procedure FormCreate(Sender: TObject); private public end; var Form1: TForm1; stream: TAudioStream; fc_mus: pfc14; fsize : integer; const SampleRate = 44100; BufferSize = 8192 ; SampleSize = 16; Channels = 2; implementation {$R *.lfm} procedure FillAudio(bufferData: Pointer; frames: LongWord); cdecl;begin fc14dec_buffer_fill(fc_mus, bufferData, frames * 4);end; { TForm1 } procedure TForm1.FormCreate(Sender: TObject);var thelib, ordir: string;begin ordir := IncludeTrailingBackslash(ExtractFilePath(ParamStr(0))); {$IFDEF windows} thelib := 'fc14audiodecoder.dll'; {$Else} thelib := 'libfc14audiodecoder.so'; {$ENDIF} memo1.Lines.Clear; if fc14_Load(ordir + thelib) then begin fc_mus := fc14dec_new; end; {$IFDEF windows} thelib := 'raylib.dll'; {$Else} thelib := 'libraylib.so'; {$ENDIF} if rAudio_Load(ordir + thelib) then InitAudioDevice() else writeln('libraylib load error.'); SetAudioStreamBufferSizeDefault(BufferSize); Stream := LoadAudioStream(SampleRate, SampleSize, Channels); SetAudioStreamCallback(Stream,@FillAudio);end; procedure TForm1.Button1Click(Sender: TObject);var MemBuffer: TMemoryStream;begin if openDialog1.Execute then begin MemBuffer := TMemoryStream.Create; try MemBuffer.LoadFromFile(OpenDialog1.FileName); fc14dec_init(fc_mus, MemBuffer.Memory, MemBuffer.Size); fc14dec_mixer_init(fc_mus, SampleRate, SampleSize, Channels, 0); PlayAudioStream(stream); memo1.Lines.Add('Version: ' + fc14dec_format_name(fc_mus)); memo1.Lines.Add('Duration: ' + IntToStr(fc14dec_duration(fc_mus))); memo1.Lines.Add(' '); except on E: Exception do ShowMessage('ERROR : ' ); end; MemBuffer.Free; end;end; procedure TForm1.FormClose(Sender: TObject; var CloseAction: TCloseAction);begin StopAudioStream(stream);end; end.
Navigation
[0] Message Index
[#] Next page