unit UMusic;
interface
{$I switches.inc}
{$IFDEF FPC}
{$MODE Delphi}
{$ENDIF}
uses Classes,
{$IFDEF win32}
windows,
{$ENDIF}
UCommon,
Messages,
SysUtils,
{$IFNDEF FPC}
Forms,
{$ENDIF}
{$IFDEF useBASS}
bass,
{$ENDIF}
ULog,
USongs;
procedure InitializeSound;
type
TSoundCard = record
Name: string;
Source: array of string;
end;
TFFTData = array [0..256] of Single;
TCustomSoundEntry = record
Filename : String;
Handle : hStream;
end;
TMusic = class
private
BassStart: hStream; // Wait, I've replaced this with BASS
BassBack: hStream; // It has almost all features we need
BassSwoosh: hStream;
BassChange: hStream; // Almost? It aleady has them all :)
BassOption: hStream;
BassClick: hStream;
BassDrum: hStream;
BassHihat: hStream;
BassClap: hStream;
BassShuffle: hStream;
//Custom Sounds
CustomSounds: array of TCustomSoundEntry;
Loaded: boolean;
Loop: boolean;
public
Bass: hStream;
procedure InitializePlayback;
procedure InitializeRecord;
procedure SetVolume(Volume: integer);
procedure SetMusicVolume(Volume: integer);
procedure SetLoop(Enabled: boolean);
function Open(Name: string): boolean; // true if succeed
procedure Rewind;
procedure MoveTo(Time: real);
procedure Play;
procedure Pause; //Pause Mod
procedure Stop;
procedure Close;
function Finished: boolean;
function Length: real;
function Position: real;
procedure PlayStart;
procedure PlayBack;
procedure PlaySwoosh;
procedure PlayChange;
procedure PlayOption;
procedure PlayClick;
procedure PlayDrum;
procedure PlayHihat;
procedure PlayClap;
procedure PlayShuffle;
procedure StopShuffle;
procedure CaptureStart;
procedure CaptureStop;
procedure CaptureCard(RecordI, PlayerLeft, PlayerRight: byte);
procedure StopCard(Card: byte);
function LoadSoundFromFile(var hStream: hStream; Name: string): boolean;
//Equalizer
function GetFFTData: TFFTData;
//Custom Sounds
function LoadCustomSound(const Filename: String): Cardinal;
procedure PlayCustomSound(const Index: Cardinal);
end;
const
RecordSystem = 1;
type
TMuzyka = record
Path: string;
Start: integer; // start of song in ms
IlNut: integer;
DlugoscNut: integer;
end;
PLine = ^TLine;
TLine = record
Start: integer;
StartNote: integer;
Lyric: string;
LyricWidth: real;
Koniec: integer;
BaseNote: integer;
HighNut: integer;
IlNut: integer;
TotalNotes: integer;
Nuta: array of record
Color: integer;
Start: integer;
Dlugosc: integer;
Ton: integer;
TonGamy: integer;
Tekst: string;
FreeStyle: boolean;
Wartosc: integer; // zwykla nuta x1, zlota nuta x2
end;
end;
ALine = array of TLine;
TCzesci = record
Akt: integer; // aktualna czesc utworu do rysowania
High: integer;
Ilosc: integer;
Resolution: integer;
NotesGAP: integer;
Wartosc: integer;
Czesc: ALine;
end;
TCzas = record // wszystko, co dotyczy aktualnej klatki
OldBeat: integer; // poprzednio wykryty beat w utworze
AktBeat: integer; // aktualny beat w utworze
MidBeat: real; // dokladny AktBeat
// now we use this for super synchronization!
// only used when analyzing voice
OldBeatD: integer; // poprzednio wykryty beat w utworze
AktBeatD: integer; // aktualny beat w utworze
MidBeatD: real; // dokladny AktBeatD
FracBeatD: real; // fractional part of MidBeatD
// we use this for audiable clicks
OldBeatC: integer; // poprzednio wykryty beat w utworze
AktBeatC: integer; // aktualny beat w utworze
MidBeatC: real; // dokladny AktBeatC
FracBeatC: real; // fractional part of MidBeatC
OldCzesc: integer; // poprzednio wyswietlana czesc
// akt jest w czesci.akt
Teraz: real; // aktualny czas w utworze
Razem: real; // caly czas utworu
end;
var
Music: TMusic;
// muzyka
Muzyka: TMuzyka;
// czesci z nutami;
Czesci: array of TCzesci;
// czas
Czas: TCzas;
fHWND: Thandle;
type
TMPModes = (mpNotReady, mpStopped, mpPlaying, mpRecording, mpSeeking,
mpPaused, mpOpen);
const
ModeStr: array[TMPModes] of string = ('Not ready', 'Stopped', 'Playing', 'Recording', 'Seeking', 'Paused', 'Open');
implementation
uses
{$IFDEF FPC}
lclintf,
{$ENDIF}
UGraphic,
URecord,
UFiles,
UIni,
UMain,
UThemes;
procedure InitializeSound;
begin
Log.LogStatus('Initializing Playback', 'InitializeSound'); Music.InitializePlayback;
Log.LogStatus('Initializing Record', 'InitializeSound'); Music.InitializeRecord;
end;
procedure TMusic.InitializePlayback;
var
Pet: integer;
S: integer;
begin
Log.BenchmarkStart(4);
Log.LogStatus('Initializing Playback Subsystem', 'Music Initialize');
Loaded := false;
Loop := false;
{$ifdef win32}
// TODO : JB_Linux ... is this needed ? :)
fHWND := AllocateHWND( nil); // TODO : JB_lazarus - can we do something different here ?? lazarus didnt like this function
{$ENDIF}
{$IFDEF useBASS}
// TODO : jb_linux replace with something other than bass
if not BASS_Init(1, 44100, 0, fHWND, nil) then
begin
{$IFNDEF FPC}
// TODO : JB_linux find a way to do this nice..
Application.MessageBox ('Could not initialize BASS', 'Error');
{$ENDIF}
Exit;
end;
{$ENDIF}
Log.BenchmarkEnd(4); Log.LogBenchmark('--> Bass Init', 4);
// config playing buffer
// BASS_SetConfig(BASS_CONFIG_UPDATEPERIOD, 10);
// BASS_SetConfig(BASS_CONFIG_BUFFER, 100);
Log.LogStatus('Loading Sounds', 'Music Initialize');
Log.BenchmarkStart(4);
LoadSoundFromFile(BassStart, SoundPath + 'Common Start.mp3');
LoadSoundFromFile(BassBack, SoundPath + 'Common Back.mp3');
LoadSoundFromFile(BassSwoosh, SoundPath + 'menu swoosh.mp3');
LoadSoundFromFile(BassChange, SoundPath + 'select music change music 50.mp3');
LoadSoundFromFile(BassOption, SoundPath + 'option change col.mp3');
LoadSoundFromFile(BassClick, SoundPath + 'rimshot022b.mp3');
// LoadSoundFromFile(BassDrum, SoundPath + 'bassdrumhard076b.mp3');
// LoadSoundFromFile(BassHihat, SoundPath + 'hihatclosed068b.mp3');
// LoadSoundFromFile(BassClap, SoundPath + 'claps050b.mp3');
// LoadSoundFromFile(BassShuffle, SoundPath + 'Shuffle.mp3');
Log.BenchmarkEnd(4); Log.LogBenchmark('--> Loading Sounds', 4);
end;
procedure TMusic.InitializeRecord;
var
S: integer;
device: integer;
descr: string;
input: integer;
input2: integer;
flags: integer;
mic: array[0..15] of integer;
SC: integer; // soundcard
SCI: integer; // soundcard input
begin
if RecordSystem = 1 then begin
SetLength(Sound, 6 {max players});//Ini.Players+1);
for S := 0 to High(Sound) do begin //Ini.Players do begin
Sound[S] := TSound.Create;
Sound[S].Num := S;
Sound[S].BufferNew := TMemoryStream.Create;
SetLength(Sound[S].BufferLong, 1);
Sound[S].BufferLong[0] := TMemoryStream.Create;
Sound[S].n := 4*1024;
end;
// check for recording devices;
{device := 0;
descr := BASS_RecordGetDeviceDescription(device);
SetLength(SoundCard, 0);
while (descr <> '') do begin
SC := High(SoundCard) + 1;
SetLength(SoundCard, SC+1);
Log.LogAnalyze('Device #'+IntToStr(device)+': '+ descr);
SoundCard[SC].Description := Descr;
// check for recording inputs
mic[device] := -1; // default to no change
input := 0;
BASS_RecordInit(device);
Log.LogAnalyze('Input #' + IntToStr(Input) + ': ' + BASS_RecordGetInputName(input));
flags := BASS_RecordGetInput(input);
SetLength(SoundCard[SC].Input, 0);
while (flags <> -1) do begin
SCI := High(SoundCard[SC].Input) + 1;
SetLength(SoundCard[SC].Input, SCI+1);
Log.LogAnalyze('Input #' + IntToStr(Input) + ': ' + BASS_RecordGetInputName(input));
SoundCard[SC].Input[SCI].Name := BASS_RecordGetInputName(Input);
if (flags and BASS_INPUT_TYPE_MASK) = BASS_INPUT_TYPE_MIC then begin
mic[device] := input; // auto set microphone
end;
Inc(Input);
flags := BASS_RecordGetInput(input);
end;
if mic[device] <> -1 then begin
Log.LogAnalyze('Found the mic at input ' + IntToStr(Mic[device]))
end else begin
Log.LogAnalyze('Mic not found');
mic[device] := 0; // setting to the first one (for kxproject)
end;
SoundCard[SC].InputSeleceted := Mic[Device];
BASS_RecordFree;
inc(Device);
descr := BASS_RecordGetDeviceDescription(Device);
end; // while}
end; // if
end;
procedure TMusic.SetVolume(Volume: integer);
begin
//Old Sets Wave Volume
//BASS_SetVolume(Volume);
//New: Sets Volume only for this Application
{$IFDEF useBASS}
// TODO : jb_linux replace with something other than bass
BASS_SetConfig(BASS_CONFIG_GVOL_SAMPLE, Volume);
BASS_SetConfig(BASS_CONFIG_GVOL_STREAM, Volume);
BASS_SetConfig(BASS_CONFIG_GVOL_MUSIC, Volume);
{$ENDIF}
end;
procedure TMusic.SetMusicVolume(Volume: Integer);
begin
//Max Volume Prevention
if Volume > 100 then
Volume := 100;
//Set Volume
{$IFDEF useBASS}
// TODO : jb_linux replace with something other than bass
BASS_ChannelSetAttributes (Bass, -1, Volume, -101);
{$ENDIF}
end;
procedure TMusic.SetLoop(Enabled: boolean);
begin
Loop := Enabled;
end;
function TMusic.Open(Name: string): boolean;
begin
Loaded := false;
if FileExists(Name) then
begin
{$IFDEF useBASS}
// TODO : jb_linux replace with something other than bass
Bass := Bass_StreamCreateFile(false, pchar(Name), 0, 0, 0);
{$ENDIF}
Loaded := true;
//Set Max Volume
SetMusicVolume (100);
end;
Result := Loaded;
end;
procedure TMusic.Rewind;
begin
if Loaded then begin
end;
end;
procedure TMusic.MoveTo(Time: real);
var
bytes: integer;
begin
{$IFDEF useBASS}
// TODO : jb_linux replace with something other than bass
bytes := BASS_ChannelSeconds2Bytes(Bass, Time);
BASS_ChannelSetPosition(Bass, bytes);
{$ENDIF}
end;
procedure TMusic.Play;
begin
{$IFDEF useBASS}
// TODO : jb_linux replace with something other than bass
if Loaded then
begin
if Loop then
BASS_ChannelPlay(Bass, True); // start from beginning... actually bass itself does not loop, nor does this TMusic Class
BASS_ChannelPlay(Bass, False); // for setting position before playing
end;
{$ENDIF}
end;
procedure TMusic.Pause; //Pause Mod
begin
{$IFDEF useBASS}
// TODO : jb_linux replace with something other than bass
if Loaded then begin
BASS_ChannelPause(Bass); // Pauses Song
end;
{$ENDIF}
end;
procedure TMusic.Stop;
begin
{$IFDEF useBASS}
// TODO : jb_linux replace with something other than bass
Bass_ChannelStop(Bass);
{$ENDIF}
end;
procedure TMusic.Close;
begin
{$IFDEF useBASS}
// TODO : jb_linux replace with something other than bass
Bass_StreamFree(Bass);
{$ENDIF}
end;
function TMusic.Length: real;
var
bytes: integer;
begin
Result := 60;
{$IFDEF useBASS}
// TODO : jb_linux replace with something other than bass
bytes := BASS_ChannelGetLength(Bass);
Result := BASS_ChannelBytes2Seconds(Bass, bytes);
{$ENDIF}
end;
function TMusic.Position: real;
var
bytes: integer;
begin
Result := 0;
{$IFDEF useBASS}
// TODO : jb_linux replace with something other than bass
bytes := BASS_ChannelGetPosition(BASS);
Result := BASS_ChannelBytes2Seconds(BASS, bytes);
{$ENDIF}
end;
function TMusic.Finished: boolean;
begin
Result := false;
{$IFDEF useBASS}
// TODO : jb_linux replace with something other than bass
if BASS_ChannelIsActive(BASS) = BASS_ACTIVE_STOPPED then
begin
Result := true;
end;
{$ENDIF}
end;
procedure TMusic.PlayStart;
begin
{$IFDEF useBASS}
// TODO : jb_linux replace with something other than bass
BASS_ChannelPlay(BassStart, True);
{$ENDIF}
end;
procedure TMusic.PlayBack;
begin
{$IFDEF useBASS}
// TODO : jb_linux replace with something other than bass
BASS_ChannelPlay(BassBack, True);// then
{$ENDIF}
end;
procedure TMusic.PlaySwoosh;
begin
{$IFDEF useBASS}
// TODO : jb_linux replace with something other than bass
BASS_ChannelPlay(BassSwoosh, True);
{$ENDIF}
end;
procedure TMusic.PlayChange;
begin
{$IFDEF useBASS}
// TODO : jb_linux replace with something other than bass
BASS_ChannelPlay(BassChange, True);
{$ENDIF}
end;
procedure TMusic.PlayOption;
begin
{$IFDEF useBASS}
// TODO : jb_linux replace with something other than bass
BASS_ChannelPlay(BassOption, True);
{$ENDIF}
end;
procedure TMusic.PlayClick;
begin
{$IFDEF useBASS}
// TODO : jb_linux replace with something other than bass
BASS_ChannelPlay(BassClick, True);
{$ENDIF}
end;
procedure TMusic.PlayDrum;
begin
{$IFDEF useBASS}
// TODO : jb_linux replace with something other than bass
BASS_ChannelPlay(BassDrum, True);
{$ENDIF}
end;
procedure TMusic.PlayHihat;
begin
{$IFDEF useBASS}
// TODO : jb_linux replace with something other than bass
BASS_ChannelPlay(BassHihat, True);
{$ENDIF}
end;
procedure TMusic.PlayClap;
begin
{$IFDEF useBASS}
// TODO : jb_linux replace with something other than bass
BASS_ChannelPlay(BassClap, True);
{$ENDIF}
end;
procedure TMusic.PlayShuffle;
begin
{$IFDEF useBASS}
// TODO : jb_linux replace with something other than bass
BASS_ChannelPlay(BassShuffle, True);
{$ENDIF}
end;
procedure TMusic.StopShuffle;
begin
{$IFDEF useBASS}
// TODO : jb_linux replace with something other than bass
BASS_ChannelStop(BassShuffle);
{$ENDIF}
end;
procedure TMusic.CaptureStart;
var
S: integer;
SC: integer;
P1: integer;
P2: integer;
begin
for S := 0 to High(Sound) do
Sound[S].BufferLong[0].Clear;
for SC := 0 to High(Ini.CardList) do begin
P1 := Ini.CardList[SC].ChannelL;
P2 := Ini.CardList[SC].ChannelR;
if P1 > PlayersPlay then P1 := 0;
if P2 > PlayersPlay then P2 := 0;
if (P1 > 0) or (P2 > 0) then
CaptureCard(SC, P1, P2);
end;
end;
procedure TMusic.CaptureStop;
var
SC: integer;
P1: integer;
P2: integer;
begin
for SC := 0 to High(Ini.CardList) do begin
P1 := Ini.CardList[SC].ChannelL;
P2 := Ini.CardList[SC].ChannelR;
if P1 > PlayersPlay then P1 := 0;
if P2 > PlayersPlay then P2 := 0;
if (P1 > 0) or (P2 > 0) then StopCard(SC);
end;
end;
//procedure TMusic.CaptureCard(RecordI, SoundNum, PlayerLeft, PlayerRight: byte);
procedure TMusic.CaptureCard(RecordI, PlayerLeft, PlayerRight: byte);
var
Error: integer;
ErrorMsg: string;
begin
{$IFDEF useBASS}
// TODO : jb_linux replace with something other than bass
if not BASS_RecordInit(RecordI) then begin
Error := BASS_ErrorGetCode;
ErrorMsg := IntToStr(Error);
if Error = BASS_ERROR_DX then ErrorMsg := 'No DX5';
if Error = BASS_ERROR_ALREADY then ErrorMsg := 'The device has already been initialized';
if Error = BASS_ERROR_DEVICE then ErrorMsg := 'The device number specified is invalid';
if Error = BASS_ERROR_DRIVER then ErrorMsg := 'There is no available device driver';
{Log.LogAnalyze('Error initializing record [' + IntToStr(RecordI) + ', '
+ IntToStr(PlayerLeft) + ', '+ IntToStr(PlayerRight) + ']: '
+ ErrorMsg);}
Log.LogError('Error initializing record [' + IntToStr(RecordI) + ', '
+ IntToStr(PlayerLeft) + ', '+ IntToStr(PlayerRight) + ']: '
+ ErrorMsg);
Log.LogError('Music -> CaptureCard: Error initializing record: ' + ErrorMsg);
end
else
begin
Recording.SoundCard[RecordI].BassRecordStream := BASS_RecordStart(44100, 2, MakeLong(0, 20) , @GetMicrophone, PlayerLeft + PlayerRight*256);
end;
{$ENDIF}
end;
procedure TMusic.StopCard(Card: byte);
begin
{$IFDEF useBASS}
// TODO : jb_linux replace with something other than bass
BASS_RecordSetDevice(Card);
BASS_RecordFree;
{$ENDIF}
end;
function TMusic.LoadSoundFromFile(var hStream: hStream; Name: string): boolean;
var
L: Integer;
begin
if FileExists(Name) then begin
Log.LogStatus('Loading Sound: "' + Name + '"', 'LoadSoundFromFile');
try
{$IFDEF useBASS}
// TODO : jb_linux replace with something other than bass
hStream := BASS_StreamCreateFile(False, pchar(Name), 0, 0, 0);
{$ENDIF}
//Add CustomSound
L := High(CustomSounds) + 1;
SetLength (CustomSounds, L + 1);
CustomSounds[L].Filename := Name;
CustomSounds[L].Handle := hStream;
except
Log.LogError('Failed to open using BASS', 'LoadSoundFromFile');
end;
end else begin
Log.LogError('Sound not found: "' + Name + '"', 'LoadSoundFromFile');
exit;
end;
end;
//Equalizer
function TMusic.GetFFTData: TFFTData;
var
Data: TFFTData;
begin
{$IFDEF useBASS}
// TODO : jb_linux replace with something other than bass
//Get Channel Data Mono and 256 Values
BASS_ChannelGetData(Bass, @Result, BASS_DATA_FFT512);
//Result := Data;
{$ENDIF}
end;
function TMusic.LoadCustomSound(const Filename: String): Cardinal;
var
S: hStream;
I: Integer;
F: String;
begin
//Search for Sound in already loaded Sounds
F := UpperCase(SoundPath + FileName);
For I := 0 to High(CustomSounds) do
begin
if (UpperCase(CustomSounds[I].Filename) = F) then
begin
Result := I;
Exit;
end;
end;
if LoadSoundFromFile(S, SoundPath + Filename) then
Result := High(CustomSounds)
else
Result := 0;
end;
procedure TMusic.PlayCustomSound(const Index: Cardinal);
begin
{$IFDEF useBASS}
// TODO : jb_linux replace with something other than bass
if Index <= High(CustomSounds) then
BASS_ChannelPlay(CustomSounds[Index].Handle, True);
{$ENDIF}
end;
end.