From 7a01b05b3861a667eb32ce2e0fc88ff3bacb99ae Mon Sep 17 00:00:00 2001
From: mogguh <mogguh@b956fd51-792f-4845-bead-9b4dfca2ff2c>
Date: Tue, 2 Sep 2008 17:25:26 +0000
Subject: Moved: The folder classes has been renamed to base Updated:
ultrastardx.dpr has been changed accordingly
git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/trunk@1339 b956fd51-792f-4845-bead-9b4dfca2ff2c
---
src/base/TextGL.pas | 462 ++++++
src/base/UAudioConverter.pas | 458 ++++++
src/base/UAudioCore_Bass.pas | 123 ++
src/base/UAudioCore_Portaudio.pas | 257 ++++
src/base/UAudioDecoder_Bass.pas | 242 ++++
src/base/UAudioDecoder_FFmpeg.pas | 1114 +++++++++++++++
src/base/UAudioInput_Bass.pas | 481 +++++++
src/base/UAudioInput_Portaudio.pas | 474 +++++++
src/base/UAudioPlaybackBase.pas | 292 ++++
src/base/UAudioPlayback_Bass.pas | 731 ++++++++++
src/base/UAudioPlayback_Portaudio.pas | 361 +++++
src/base/UAudioPlayback_SDL.pas | 160 +++
src/base/UAudioPlayback_SoftMixer.pas | 1132 +++++++++++++++
src/base/UCatCovers.pas | 173 +++
src/base/UCommandLine.pas | 334 +++++
src/base/UCommon.pas | 774 +++++++++++
src/base/UConfig.pas | 199 +++
src/base/UCore.pas | 525 +++++++
src/base/UCoreModule.pas | 128 ++
src/base/UCovers.pas | 430 ++++++
src/base/UDLLManager.pas | 253 ++++
src/base/UDataBase.pas | 533 +++++++
src/base/UDraw.pas | 1390 +++++++++++++++++++
src/base/UEditorLyrics.pas | 229 +++
src/base/UFiles.pas | 150 ++
src/base/UGraphic.pas | 760 ++++++++++
src/base/UGraphicClasses.pas | 673 +++++++++
src/base/UHooks.pas | 434 ++++++
src/base/UImage.pas | 993 +++++++++++++
src/base/UIni.pas | 928 +++++++++++++
src/base/UJoystick.pas | 282 ++++
src/base/ULCD.pas | 304 ++++
src/base/ULanguage.pas | 240 ++++
src/base/ULight.pas | 145 ++
src/base/ULog.pas | 417 ++++++
src/base/ULyrics.pas | 884 ++++++++++++
src/base/UMain.pas | 1107 +++++++++++++++
src/base/UMediaCore_FFmpeg.pas | 405 ++++++
src/base/UMediaCore_SDL.pas | 38 +
src/base/UMedia_dummy.pas | 243 ++++
src/base/UModules.pas | 26 +
src/base/UMusic.pas | 1233 +++++++++++++++++
src/base/UParty.pas | 630 +++++++++
src/base/UPlatform.pas | 174 +++
src/base/UPlatformLinux.pas | 173 +++
src/base/UPlatformMacOSX.pas | 294 ++++
src/base/UPlatformWindows.pas | 236 ++++
src/base/UPlaylist.pas | 490 +++++++
src/base/UPluginInterface.pas | 156 +++
src/base/URecord.pas | 766 ++++++++++
src/base/URingBuffer.pas | 128 ++
src/base/UServices.pas | 358 +++++
src/base/USingNotes.pas | 13 +
src/base/USingScores.pas | 973 +++++++++++++
src/base/USkins.pas | 185 +++
src/base/USong.pas | 1027 ++++++++++++++
src/base/USongs.pas | 806 +++++++++++
src/base/UTextClasses.pas | 60 +
src/base/UTexture.pas | 525 +++++++
src/base/UThemes.pas | 2234 ++++++++++++++++++++++++++++++
src/base/UTime.pas | 185 +++
src/base/UVideo.pas | 828 +++++++++++
src/base/UVisualizer.pas | 442 ++++++
src/base/UXMLSong.pas | 573 ++++++++
src/base/uPluginLoader.pas | 775 +++++++++++
src/classes/TextGL.pas | 462 ------
src/classes/UAudioConverter.pas | 458 ------
src/classes/UAudioCore_Bass.pas | 123 --
src/classes/UAudioCore_Portaudio.pas | 257 ----
src/classes/UAudioDecoder_Bass.pas | 242 ----
src/classes/UAudioDecoder_FFmpeg.pas | 1114 ---------------
src/classes/UAudioInput_Bass.pas | 481 -------
src/classes/UAudioInput_Portaudio.pas | 474 -------
src/classes/UAudioPlaybackBase.pas | 292 ----
src/classes/UAudioPlayback_Bass.pas | 731 ----------
src/classes/UAudioPlayback_Portaudio.pas | 361 -----
src/classes/UAudioPlayback_SDL.pas | 160 ---
src/classes/UAudioPlayback_SoftMixer.pas | 1132 ---------------
src/classes/UCatCovers.pas | 173 ---
src/classes/UCommandLine.pas | 334 -----
src/classes/UCommon.pas | 774 -----------
src/classes/UConfig.pas | 199 ---
src/classes/UCore.pas | 525 -------
src/classes/UCoreModule.pas | 128 --
src/classes/UCovers.pas | 430 ------
src/classes/UDLLManager.pas | 253 ----
src/classes/UDataBase.pas | 533 -------
src/classes/UDraw.pas | 1390 -------------------
src/classes/UEditorLyrics.pas | 229 ---
src/classes/UFiles.pas | 150 --
src/classes/UGraphic.pas | 760 ----------
src/classes/UGraphicClasses.pas | 673 ---------
src/classes/UHooks.pas | 434 ------
src/classes/UImage.pas | 993 -------------
src/classes/UIni.pas | 928 -------------
src/classes/UJoystick.pas | 282 ----
src/classes/ULCD.pas | 304 ----
src/classes/ULanguage.pas | 240 ----
src/classes/ULight.pas | 145 --
src/classes/ULog.pas | 417 ------
src/classes/ULyrics.pas | 884 ------------
src/classes/UMain.pas | 1107 ---------------
src/classes/UMediaCore_FFmpeg.pas | 405 ------
src/classes/UMediaCore_SDL.pas | 38 -
src/classes/UMedia_dummy.pas | 243 ----
src/classes/UModules.pas | 26 -
src/classes/UMusic.pas | 1233 -----------------
src/classes/UParty.pas | 630 ---------
src/classes/UPlatform.pas | 174 ---
src/classes/UPlatformLinux.pas | 173 ---
src/classes/UPlatformMacOSX.pas | 294 ----
src/classes/UPlatformWindows.pas | 236 ----
src/classes/UPlaylist.pas | 490 -------
src/classes/UPluginInterface.pas | 156 ---
src/classes/URecord.pas | 766 ----------
src/classes/URingBuffer.pas | 128 --
src/classes/UServices.pas | 358 -----
src/classes/USingNotes.pas | 13 -
src/classes/USingScores.pas | 973 -------------
src/classes/USkins.pas | 185 ---
src/classes/USong.pas | 1027 --------------
src/classes/USongs.pas | 806 -----------
src/classes/UTextClasses.pas | 60 -
src/classes/UTexture.pas | 525 -------
src/classes/UThemes.pas | 2234 ------------------------------
src/classes/UTime.pas | 185 ---
src/classes/UVideo.pas | 828 -----------
src/classes/UVisualizer.pas | 442 ------
src/classes/UXMLSong.pas | 573 --------
src/classes/uPluginLoader.pas | 775 -----------
src/ultrastardx.dpr | 132 +-
131 files changed, 32614 insertions(+), 32614 deletions(-)
create mode 100644 src/base/TextGL.pas
create mode 100644 src/base/UAudioConverter.pas
create mode 100644 src/base/UAudioCore_Bass.pas
create mode 100644 src/base/UAudioCore_Portaudio.pas
create mode 100644 src/base/UAudioDecoder_Bass.pas
create mode 100644 src/base/UAudioDecoder_FFmpeg.pas
create mode 100644 src/base/UAudioInput_Bass.pas
create mode 100644 src/base/UAudioInput_Portaudio.pas
create mode 100644 src/base/UAudioPlaybackBase.pas
create mode 100644 src/base/UAudioPlayback_Bass.pas
create mode 100644 src/base/UAudioPlayback_Portaudio.pas
create mode 100644 src/base/UAudioPlayback_SDL.pas
create mode 100644 src/base/UAudioPlayback_SoftMixer.pas
create mode 100644 src/base/UCatCovers.pas
create mode 100644 src/base/UCommandLine.pas
create mode 100644 src/base/UCommon.pas
create mode 100644 src/base/UConfig.pas
create mode 100644 src/base/UCore.pas
create mode 100644 src/base/UCoreModule.pas
create mode 100644 src/base/UCovers.pas
create mode 100644 src/base/UDLLManager.pas
create mode 100644 src/base/UDataBase.pas
create mode 100644 src/base/UDraw.pas
create mode 100644 src/base/UEditorLyrics.pas
create mode 100644 src/base/UFiles.pas
create mode 100644 src/base/UGraphic.pas
create mode 100644 src/base/UGraphicClasses.pas
create mode 100644 src/base/UHooks.pas
create mode 100644 src/base/UImage.pas
create mode 100644 src/base/UIni.pas
create mode 100644 src/base/UJoystick.pas
create mode 100644 src/base/ULCD.pas
create mode 100644 src/base/ULanguage.pas
create mode 100644 src/base/ULight.pas
create mode 100644 src/base/ULog.pas
create mode 100644 src/base/ULyrics.pas
create mode 100644 src/base/UMain.pas
create mode 100644 src/base/UMediaCore_FFmpeg.pas
create mode 100644 src/base/UMediaCore_SDL.pas
create mode 100644 src/base/UMedia_dummy.pas
create mode 100644 src/base/UModules.pas
create mode 100644 src/base/UMusic.pas
create mode 100644 src/base/UParty.pas
create mode 100644 src/base/UPlatform.pas
create mode 100644 src/base/UPlatformLinux.pas
create mode 100644 src/base/UPlatformMacOSX.pas
create mode 100644 src/base/UPlatformWindows.pas
create mode 100644 src/base/UPlaylist.pas
create mode 100644 src/base/UPluginInterface.pas
create mode 100644 src/base/URecord.pas
create mode 100644 src/base/URingBuffer.pas
create mode 100644 src/base/UServices.pas
create mode 100644 src/base/USingNotes.pas
create mode 100644 src/base/USingScores.pas
create mode 100644 src/base/USkins.pas
create mode 100644 src/base/USong.pas
create mode 100644 src/base/USongs.pas
create mode 100644 src/base/UTextClasses.pas
create mode 100644 src/base/UTexture.pas
create mode 100644 src/base/UThemes.pas
create mode 100644 src/base/UTime.pas
create mode 100644 src/base/UVideo.pas
create mode 100644 src/base/UVisualizer.pas
create mode 100644 src/base/UXMLSong.pas
create mode 100644 src/base/uPluginLoader.pas
delete mode 100644 src/classes/TextGL.pas
delete mode 100644 src/classes/UAudioConverter.pas
delete mode 100644 src/classes/UAudioCore_Bass.pas
delete mode 100644 src/classes/UAudioCore_Portaudio.pas
delete mode 100644 src/classes/UAudioDecoder_Bass.pas
delete mode 100644 src/classes/UAudioDecoder_FFmpeg.pas
delete mode 100644 src/classes/UAudioInput_Bass.pas
delete mode 100644 src/classes/UAudioInput_Portaudio.pas
delete mode 100644 src/classes/UAudioPlaybackBase.pas
delete mode 100644 src/classes/UAudioPlayback_Bass.pas
delete mode 100644 src/classes/UAudioPlayback_Portaudio.pas
delete mode 100644 src/classes/UAudioPlayback_SDL.pas
delete mode 100644 src/classes/UAudioPlayback_SoftMixer.pas
delete mode 100644 src/classes/UCatCovers.pas
delete mode 100644 src/classes/UCommandLine.pas
delete mode 100644 src/classes/UCommon.pas
delete mode 100644 src/classes/UConfig.pas
delete mode 100644 src/classes/UCore.pas
delete mode 100644 src/classes/UCoreModule.pas
delete mode 100644 src/classes/UCovers.pas
delete mode 100644 src/classes/UDLLManager.pas
delete mode 100644 src/classes/UDataBase.pas
delete mode 100644 src/classes/UDraw.pas
delete mode 100644 src/classes/UEditorLyrics.pas
delete mode 100644 src/classes/UFiles.pas
delete mode 100644 src/classes/UGraphic.pas
delete mode 100644 src/classes/UGraphicClasses.pas
delete mode 100644 src/classes/UHooks.pas
delete mode 100644 src/classes/UImage.pas
delete mode 100644 src/classes/UIni.pas
delete mode 100644 src/classes/UJoystick.pas
delete mode 100644 src/classes/ULCD.pas
delete mode 100644 src/classes/ULanguage.pas
delete mode 100644 src/classes/ULight.pas
delete mode 100644 src/classes/ULog.pas
delete mode 100644 src/classes/ULyrics.pas
delete mode 100644 src/classes/UMain.pas
delete mode 100644 src/classes/UMediaCore_FFmpeg.pas
delete mode 100644 src/classes/UMediaCore_SDL.pas
delete mode 100644 src/classes/UMedia_dummy.pas
delete mode 100644 src/classes/UModules.pas
delete mode 100644 src/classes/UMusic.pas
delete mode 100644 src/classes/UParty.pas
delete mode 100644 src/classes/UPlatform.pas
delete mode 100644 src/classes/UPlatformLinux.pas
delete mode 100644 src/classes/UPlatformMacOSX.pas
delete mode 100644 src/classes/UPlatformWindows.pas
delete mode 100644 src/classes/UPlaylist.pas
delete mode 100644 src/classes/UPluginInterface.pas
delete mode 100644 src/classes/URecord.pas
delete mode 100644 src/classes/URingBuffer.pas
delete mode 100644 src/classes/UServices.pas
delete mode 100644 src/classes/USingNotes.pas
delete mode 100644 src/classes/USingScores.pas
delete mode 100644 src/classes/USkins.pas
delete mode 100644 src/classes/USong.pas
delete mode 100644 src/classes/USongs.pas
delete mode 100644 src/classes/UTextClasses.pas
delete mode 100644 src/classes/UTexture.pas
delete mode 100644 src/classes/UThemes.pas
delete mode 100644 src/classes/UTime.pas
delete mode 100644 src/classes/UVideo.pas
delete mode 100644 src/classes/UVisualizer.pas
delete mode 100644 src/classes/UXMLSong.pas
delete mode 100644 src/classes/uPluginLoader.pas
diff --git a/src/base/TextGL.pas b/src/base/TextGL.pas
new file mode 100644
index 00000000..f7b3ac95
--- /dev/null
+++ b/src/base/TextGL.pas
@@ -0,0 +1,462 @@
+unit TextGL;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+uses
+ gl,
+ SDL,
+ UTexture,
+ Classes,
+// SDL_ttf,
+ ULog;
+
+procedure BuildFont; // build our bitmap font
+procedure KillFont; // delete the font
+function glTextWidth(text: PChar): real; // returns text width
+procedure glPrintLetter(letter: char);
+procedure glPrint(text: pchar); // custom GL "Print" routine
+procedure SetFontPos(X, Y: real); // sets X and Y
+procedure SetFontZ(Z: real); // sets Z
+procedure SetFontSize(Size: real);
+procedure SetFontStyle(Style: integer); // sets active font style (normal, bold, etc)
+procedure SetFontItalic(Enable: boolean); // sets italic type letter (works for all fonts)
+procedure SetFontAspectW(Aspect: real);
+procedure SetFontReflection(Enable:boolean;Spacing: real); // enables/disables text reflection
+procedure SetFontBlend(Enable: boolean); // enables/disables blending
+
+//function NextPowerOfTwo(Value: integer): integer;
+// Checks if the ttf exists, if yes then a SDL_ttf is returned
+//function LoadFont(FileName: PAnsiChar; PointSize: integer):PTTF_Font;
+// Does the renderstuff, color is in $ffeecc style
+//function RenderText(font: PTTF_Font; Text:PAnsiChar; Color: Cardinal):PSDL_Surface;
+
+type
+ TTextGL = record
+ X: real;
+ Y: real;
+ Z: real;
+ Text: string;
+ Size: real;
+ ColR: real;
+ ColG: real;
+ ColB: real;
+ end;
+
+ PFont = ^TFont;
+ TFont = record
+ Tex: TTexture;
+ Width: array[0..255] of byte;
+ AspectW: real;
+ Centered: boolean;
+ Outline: real;
+ Italic: boolean;
+ Reflection: boolean;
+ ReflectionSpacing: real;
+ Blend: boolean;
+ end;
+
+
+var
+ Fonts: array of TFont;
+ ActFont: integer;
+
+
+implementation
+
+uses
+ UMain,
+ UCommon,
+ SysUtils,
+ UGraphic;
+
+var
+ // Colours for the reflection
+ TempColor: array[0..3] of GLfloat;
+
+procedure LoadBitmapFontInfo(aID : integer; const aType, aResourceName: string);
+var
+ stream: TStream;
+begin
+ stream := GetResourceStream(aResourceName, aType);
+ if (not assigned(stream)) then
+ begin
+ Log.LogError('Unknown font['+ inttostr(aID) +': '+aType+']', 'loadfont');
+ Exit;
+ end;
+ try
+ stream.Read(Fonts[ aID ].Width, 256);
+ except
+ Log.LogError('Error while reading font['+ inttostr(aID) +': '+aType+']', 'loadfont');
+ end;
+ stream.Free;
+end;
+
+// Builds bitmap fonts
+procedure BuildFont;
+var
+ Count: integer;
+begin
+ ActFont := 0;
+
+ SetLength(Fonts, 5);
+ Fonts[0].Tex := Texture.LoadTexture(true, 'Font', TEXTURE_TYPE_TRANSPARENT, 0);
+ Fonts[0].Tex.H := 30;
+ Fonts[0].AspectW := 0.9;
+ Fonts[0].Outline := 0;
+
+ Fonts[1].Tex := Texture.LoadTexture(true, 'FontB', TEXTURE_TYPE_TRANSPARENT, 0);
+ Fonts[1].Tex.H := 30;
+ Fonts[1].AspectW := 1;
+ Fonts[1].Outline := 0;
+
+ Fonts[2].Tex := Texture.LoadTexture(true, 'FontO', TEXTURE_TYPE_TRANSPARENT, 0);
+ Fonts[2].Tex.H := 30;
+ Fonts[2].AspectW := 0.95;
+ Fonts[2].Outline := 5;
+
+ Fonts[3].Tex := Texture.LoadTexture(true, 'FontO2', TEXTURE_TYPE_TRANSPARENT, 0);
+ Fonts[3].Tex.H := 30;
+ Fonts[3].AspectW := 0.95;
+ Fonts[3].Outline := 4;
+
+{ Fonts[4].Tex := Texture.LoadTexture('FontO', TEXTURE_TYPE_TRANSPARENT, 0); // for score screen
+ Fonts[4].Tex.H := 30;
+ Fonts[4].AspectW := 0.95;
+ Fonts[4].Done := -1;
+ Fonts[4].Outline := 5;}
+
+ // load font info
+ LoadBitmapFontInfo( 0, 'FNT', 'Font');
+ LoadBitmapFontInfo( 1, 'FNT', 'FontB');
+ LoadBitmapFontInfo( 2, 'FNT', 'FontO');
+ LoadBitmapFontInfo( 3, 'FNT', 'FontO2');
+
+ for Count := 0 to 255 do
+ Fonts[1].Width[Count] := Fonts[1].Width[Count] div 2;
+
+ for Count := 0 to 255 do
+ Fonts[2].Width[Count] := Fonts[2].Width[Count] div 2 + 2;
+
+ for Count := 0 to 255 do
+ Fonts[3].Width[Count] := Fonts[3].Width[Count] + 1;
+
+{ for Count := 0 to 255 do
+ Fonts[4].Width[Count] := Fonts[4].Width[Count] div 2 + 2;}
+
+ // enable blending by default
+ for Count := 0 to High(Fonts) do
+ Fonts[Count].Blend := true;
+end;
+
+// Deletes the font
+procedure KillFont;
+begin
+ // delete all characters
+ //glDeleteLists(..., 256);
+end;
+
+function glTextWidth(text: pchar): real;
+var
+ Letter: char;
+ i: integer;
+begin
+ Result := 0;
+ for i := 0 to Length(text) -1 do
+ begin
+ Letter := Text[i];
+ Result := Result + Fonts[ActFont].Width[Ord(Letter)] * Fonts[ActFont].Tex.H / 30 * Fonts[ActFont].AspectW;
+ end;
+end;
+
+procedure glPrintLetter(Letter: char);
+var
+ TexX, TexY: real;
+ TexR, TexB: real;
+ TexHeight: real;
+ FWidth: real;
+ PL, PT: real;
+ PR, PB: real;
+ XItal: real; // X shift for italic type letter
+ ReflectionSpacing: real; // Distance of the reflection
+ Font: PFont;
+ Tex: PTexture;
+begin
+ Font := @Fonts[ActFont];
+ Tex := @Font.Tex;
+
+ FWidth := Font.Width[Ord(Letter)];
+
+ Tex.W := FWidth * (Tex.H/30) * Font.AspectW;
+
+ // set texture positions
+ TexX := (ord(Letter) mod 16) * 1/16 + 1/32 - FWidth/1024 - Font.Outline/1024;
+ TexY := (ord(Letter) div 16) * 1/16 + 2/1024;
+ TexR := (ord(Letter) mod 16) * 1/16 + 1/32 + FWidth/1024 + Font.Outline/1024;
+ TexB := (1 + ord(Letter) div 16) * 1/16 - 2/1024;
+
+ TexHeight := TexB - TexY;
+
+ // set vector positions
+ PL := Tex.X - Font.Outline * (Tex.H/30) * Font.AspectW /2;
+ PT := Tex.Y;
+ PR := PL + Tex.W + Font.Outline * (Tex.H/30) * Font.AspectW;
+ PB := PT + Tex.H;
+
+ if (not Font.Italic) then
+ XItal := 0
+ else
+ XItal := 12;
+
+ if (Font.Blend) then
+ begin
+ glEnable(GL_BLEND);
+ glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
+ end;
+
+ glEnable(GL_TEXTURE_2D);
+ glBindTexture(GL_TEXTURE_2D, Tex.TexNum);
+
+ glBegin(GL_QUADS);
+ glTexCoord2f(TexX, TexY); glVertex2f(PL+XItal, PT);
+ glTexCoord2f(TexX, TexB); glVertex2f(PL, PB);
+ glTexCoord2f(TexR, TexB); glVertex2f(PR, PB);
+ glTexCoord2f(TexR, TexY); glVertex2f(PR+XItal, PT);
+ glEnd;
+
+ // <mog> Reflection
+ // Yes it would make sense to put this in an extra procedure,
+ // but this works, doesn't take much lines, and is almost lightweight
+ if Font.Reflection then
+ begin
+ ReflectionSpacing := Font.ReflectionSpacing + Tex.H/2;
+
+ glDepthRange(0, 10);
+ glDepthFunc(GL_LEQUAL);
+ glEnable(GL_DEPTH_TEST);
+
+ glBegin(GL_QUADS);
+ glColor4f(TempColor[0], TempColor[1], TempColor[2], 0);
+ glTexCoord2f(TexX, TexY + TexHeight/2);
+ glVertex3f(PL, PB + ReflectionSpacing - Tex.H/2, Tex.z);
+
+ glColor4f(TempColor[0], TempColor[1], TempColor[2], Tex.Alpha-0.3);
+ glTexCoord2f(TexX, TexB );
+ glVertex3f(PL + XItal, PT + ReflectionSpacing, Tex.z);
+
+ glTexCoord2f(TexR, TexB );
+ glVertex3f(PR + XItal, PT + ReflectionSpacing, Tex.z);
+
+ glColor4f(TempColor[0], TempColor[1], TempColor[2], 0);
+ glTexCoord2f(TexR, TexY + TexHeight/2);
+ glVertex3f(PR, PB + ReflectionSpacing - Tex.H/2, Tex.z);
+ glEnd;
+
+ glDisable(GL_DEPTH_TEST);
+ end; // reflection
+
+ glDisable(GL_TEXTURE_2D);
+ if (Font.Blend) then
+ glDisable(GL_BLEND);
+
+ Tex.X := Tex.X + Tex.W;
+
+ //write the colour back
+ glColor4fv(@TempColor);
+end;
+
+// Custom GL "Print" Routine
+procedure glPrint(Text: PChar);
+var
+ Pos: integer;
+begin
+ // if there is no text do nothing
+ if ((Text = nil) or (Text = '')) then
+ Exit;
+
+ //Save the actual color and alpha (for reflection)
+ glGetFloatv(GL_CURRENT_COLOR, @TempColor);
+
+ for Pos := 0 to Length(Text) - 1 do
+ begin
+ glPrintLetter(Text[Pos]);
+ end;
+end;
+
+procedure SetFontPos(X, Y: real);
+begin
+ Fonts[ActFont].Tex.X := X;
+ Fonts[ActFont].Tex.Y := Y;
+end;
+
+procedure SetFontZ(Z: real);
+begin
+ Fonts[ActFont].Tex.Z := Z;
+end;
+
+procedure SetFontSize(Size: real);
+begin
+ Fonts[ActFont].Tex.H := 30 * (Size/10);
+end;
+
+procedure SetFontStyle(Style: integer);
+begin
+ ActFont := Style;
+end;
+
+procedure SetFontItalic(Enable: boolean);
+begin
+ Fonts[ActFont].Italic := Enable;
+end;
+
+procedure SetFontAspectW(Aspect: real);
+begin
+ Fonts[ActFont].AspectW := Aspect;
+end;
+
+procedure SetFontReflection(Enable: boolean; Spacing: real);
+begin
+ Fonts[ActFont].Reflection := Enable;
+ Fonts[ActFont].ReflectionSpacing := Spacing;
+end;
+
+procedure SetFontBlend(Enable: boolean);
+begin
+ Fonts[ActFont].Blend := Enable;
+end;
+
+
+
+
+(*
+<mog> I uncommented this, because it was some kind of after hour hack together with blindy
+it's actually just a prove of concept, as it's having some flaws
+- instead nice and clean ttf code should be placed here :)
+
+{$IFDEF FPC}
+ {$ASMMODE Intel}
+{$ENDIF}
+
+function NextPowerOfTwo(Value: integer): integer;
+begin
+ Result:= 1;
+{$IF Defined(CPUX86_64)}
+ asm
+ mov rcx, -1
+ bsr rcx, Value
+ inc rcx
+ shl Result, cl
+ end;
+{$ELSEIF Defined(CPU386) or Defined(CPUI386)}
+ asm
+ mov ecx, -1
+ bsr ecx, Value
+ inc ecx
+ shl Result, cl
+ end;
+{$ELSE}
+ while (Result <= Value) do
+ Result := 2 * Result;
+{$IFEND}
+end;
+
+function LoadFont(FileName: PAnsiChar; PointSize: integer):PTTF_Font;
+begin
+ if (FileExists(FileName)) then
+ begin
+ Result := TTF_OpenFont( FileName, PointSize );
+ end
+ else
+ begin
+ Log.LogStatus('ERROR Could not find font in ' + FileName , '');
+ ShowMessage( 'ERROR Could not find font in ' + FileName );
+ Result := nil;
+ end;
+end;
+
+function RenderText(font: PTTF_Font; Text:PAnsiChar; Color: Cardinal): PSDL_Surface;
+var
+ clr : TSDL_color;
+begin
+ clr.r := ((Color and $ff0000) shr 16 ) div 255;
+ clr.g := ((Color and $ff00 ) shr 8 ) div 255;
+ clr.b := ( Color and $ff ) div 255 ;
+
+ result := TTF_RenderText_Blended( font, text, cLr);
+end;
+
+procedure printrandomtext();
+var
+ stext,intermediary : PSDL_surface;
+ clrFg, clrBG : TSDL_color;
+ texture : Gluint;
+ font : PTTF_Font;
+ w,h : integer;
+begin
+
+ font := LoadFont('fonts\comicbd.ttf', 42);
+
+ clrFg.r := 255;
+ clrFg.g := 255;
+ clrFg.b := 255;
+ clrFg.unused := 255;
+
+ clrBg.r := 255;
+ clrbg.g := 0;
+ clrbg.b := 255;
+ clrbg.unused := 0;
+
+ sText := RenderText(font, 'katzeeeeeee', $fe198e);
+ //sText := TTF_RenderText_Blended( font, 'huuuuuuuuuund', clrFG);
+
+ // Convert the rendered text to a known format
+ w := nextpoweroftwo(sText.w);
+ h := nextpoweroftwo(sText.h);
+
+ intermediary := SDL_CreateRGBSurface(0, w, h, 32,
+ $000000ff, $0000ff00, $00ff0000, $ff000000);
+
+ SDL_SetAlpha(intermediary, 0, 255);
+ SDL_SetAlpha(sText, 0, 255);
+ SDL_BlitSurface(sText, nil, intermediary, nil);
+
+ glGenTextures(1, @texture);
+
+ glBindTexture(GL_TEXTURE_2D, texture);
+
+ glTexImage2D(GL_TEXTURE_2D, 0, 4, w, h, 0, GL_RGBA, GL_UNSIGNED_BYTE, intermediary.pixels);
+
+ glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
+ glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
+
+ glEnable(GL_TEXTURE_2D);
+ glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
+ glEnable(GL_BLEND);
+ glBindTexture(GL_TEXTURE_2D, texture);
+ glColor4f(1, 0, 1, 1);
+
+ glbegin(gl_quads);
+ glTexCoord2f(0, 0); glVertex2f(200 , 300 );
+ glTexCoord2f(0, sText.h/h); glVertex2f(200 , 300 + sText.h);
+ glTexCoord2f(sText.w/w, sText.h/h); glVertex2f(200 + sText.w, 300 + sText.h);
+ glTexCoord2f(sText.w/w, 0); glVertex2f(200 + sText.w, 300 );
+ glEnd;
+ glfinish();
+ glDisable(GL_BLEND);
+ gldisable(gl_texture_2d);
+
+ SDL_FreeSurface(sText);
+ SDL_FreeSurface(intermediary);
+ glDeleteTextures(1, @texture);
+ TTF_CloseFont(font);
+
+end;
+*)
+
+
+end.
diff --git a/src/base/UAudioConverter.pas b/src/base/UAudioConverter.pas
new file mode 100644
index 00000000..5647f27b
--- /dev/null
+++ b/src/base/UAudioConverter.pas
@@ -0,0 +1,458 @@
+unit UAudioConverter;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+uses
+ UMusic,
+ ULog,
+ ctypes,
+ {$IFDEF UseSRCResample}
+ samplerate,
+ {$ENDIF}
+ {$IFDEF UseFFmpegResample}
+ avcodec,
+ {$ENDIF}
+ UMediaCore_SDL,
+ sdl,
+ SysUtils,
+ Math;
+
+type
+ {*
+ * Notes:
+ * - 44.1kHz to 48kHz conversion or vice versa is not supported
+ * by SDL 1.2 (will be introduced in 1.3).
+ * No conversion takes place in this cases.
+ * This is because SDL just converts differences in powers of 2.
+ * So the result might not be that accurate.
+ * This IS audible (voice to high/low) and it needs good synchronization
+ * with the video or the lyrics timer.
+ * - float<->int16 conversion is not supported (will be part of 1.3) and
+ * SDL (<1.3) is not capable of handling floats at all.
+ * -> Using FFmpeg or libsamplerate for resampling is preferred.
+ * Use SDL for channel and format conversion only.
+ *}
+ TAudioConverter_SDL = class(TAudioConverter)
+ private
+ cvt: TSDL_AudioCVT;
+ public
+ function Init(SrcFormatInfo: TAudioFormatInfo; DstFormatInfo: TAudioFormatInfo): boolean; override;
+ destructor Destroy(); override;
+
+ function Convert(InputBuffer: PChar; OutputBuffer: PChar; var InputSize: integer): integer; override;
+ function GetOutputBufferSize(InputSize: integer): integer; override;
+ function GetRatio(): double; override;
+ end;
+
+ {$IFDEF UseFFmpegResample}
+ // Note: FFmpeg seems to be using "kaiser windowed sinc" for resampling, so
+ // the quality should be good.
+ TAudioConverter_FFmpeg = class(TAudioConverter)
+ private
+ // TODO: use SDL for multi-channel->stereo and format conversion
+ ResampleContext: PReSampleContext;
+ Ratio: double;
+ public
+ function Init(SrcFormatInfo: TAudioFormatInfo; DstFormatInfo: TAudioFormatInfo): boolean; override;
+ destructor Destroy(); override;
+
+ function Convert(InputBuffer: PChar; OutputBuffer: PChar; var InputSize: integer): integer; override;
+ function GetOutputBufferSize(InputSize: integer): integer; override;
+ function GetRatio(): double; override;
+ end;
+ {$ENDIF}
+
+ {$IFDEF UseSRCResample}
+ TAudioConverter_SRC = class(TAudioConverter)
+ private
+ ConverterState: PSRC_STATE;
+ ConversionData: SRC_DATA;
+ FormatConverter: TAudioConverter;
+ public
+ function Init(SrcFormatInfo: TAudioFormatInfo; DstFormatInfo: TAudioFormatInfo): boolean; override;
+ destructor Destroy(); override;
+
+ function Convert(InputBuffer: PChar; OutputBuffer: PChar; var InputSize: integer): integer; override;
+ function GetOutputBufferSize(InputSize: integer): integer; override;
+ function GetRatio(): double; override;
+ end;
+
+ // Note: SRC (=libsamplerate) provides several converters with different quality
+ // speed trade-offs. The SINC-types are slow but offer best quality.
+ // The SRC_SINC_* converters are too slow for realtime conversion,
+ // (SRC_SINC_FASTEST is approx. ten times slower than SRC_LINEAR) resulting
+ // in audible clicks and pops.
+ // SRC_LINEAR is very fast and should have a better quality than SRC_ZERO_ORDER_HOLD
+ // because it interpolates the samples. Normal "non-audiophile" users should not
+ // be able to hear a difference between the SINC_* ones and LINEAR. Especially
+ // if people sing along with the song.
+ // But FFmpeg might offer a better quality/speed ratio than SRC_LINEAR.
+ const
+ SRC_CONVERTER_TYPE = SRC_LINEAR;
+ {$ENDIF}
+
+implementation
+
+function TAudioConverter_SDL.Init(srcFormatInfo: TAudioFormatInfo; dstFormatInfo: TAudioFormatInfo): boolean;
+var
+ srcFormat: UInt16;
+ dstFormat: UInt16;
+begin
+ inherited Init(SrcFormatInfo, DstFormatInfo);
+
+ Result := false;
+
+ if (not ConvertAudioFormatToSDL(srcFormatInfo.Format, srcFormat) or
+ not ConvertAudioFormatToSDL(dstFormatInfo.Format, dstFormat)) then
+ begin
+ Log.LogError('Audio-format not supported by SDL', 'TSoftMixerPlaybackStream.InitFormatConversion');
+ Exit;
+ end;
+
+ if (SDL_BuildAudioCVT(@cvt,
+ srcFormat, srcFormatInfo.Channels, Round(srcFormatInfo.SampleRate),
+ dstFormat, dstFormatInfo.Channels, Round(dstFormatInfo.SampleRate)) = -1) then
+ begin
+ Log.LogError(SDL_GetError(), 'TSoftMixerPlaybackStream.InitFormatConversion');
+ Exit;
+ end;
+
+ Result := true;
+end;
+
+destructor TAudioConverter_SDL.Destroy();
+begin
+ // nothing to be done here
+ inherited;
+end;
+
+(*
+ * Returns the size of the output buffer. This might be bigger than the actual
+ * size of resampled audio data.
+ *)
+function TAudioConverter_SDL.GetOutputBufferSize(InputSize: integer): integer;
+begin
+ // Note: len_ratio must not be used here. Even if the len_ratio is 1.0, len_mult might be 2.
+ // Example: 44.1kHz/mono to 22.05kHz/stereo -> len_ratio=1, len_mult=2
+ Result := InputSize * cvt.len_mult;
+end;
+
+function TAudioConverter_SDL.GetRatio(): double;
+begin
+ Result := cvt.len_ratio;
+end;
+
+function TAudioConverter_SDL.Convert(InputBuffer: PChar; OutputBuffer: PChar; var InputSize: integer): integer;
+begin
+ Result := -1;
+
+ if (InputSize <= 0) then
+ begin
+ // avoid div-by-zero problems
+ if (InputSize = 0) then
+ Result := 0;
+ Exit;
+ end;
+
+ // OutputBuffer is always bigger than or equal to InputBuffer
+ Move(InputBuffer[0], OutputBuffer[0], InputSize);
+ cvt.buf := PUint8(OutputBuffer);
+ cvt.len := InputSize;
+ if (SDL_ConvertAudio(@cvt) = -1) then
+ Exit;
+
+ Result := cvt.len_cvt;
+end;
+
+
+{$IFDEF UseFFmpegResample}
+
+function TAudioConverter_FFmpeg.Init(SrcFormatInfo: TAudioFormatInfo; DstFormatInfo: TAudioFormatInfo): boolean;
+begin
+ inherited Init(SrcFormatInfo, DstFormatInfo);
+
+ Result := false;
+
+ // Note: ffmpeg does not support resampling for more than 2 input channels
+
+ if (srcFormatInfo.Format <> asfS16) then
+ begin
+ Log.LogError('Unsupported format', 'TAudioConverter_FFmpeg.Init');
+ Exit;
+ end;
+
+ // TODO: use SDL here
+ if (srcFormatInfo.Format <> dstFormatInfo.Format) then
+ begin
+ Log.LogError('Incompatible formats', 'TAudioConverter_FFmpeg.Init');
+ Exit;
+ end;
+
+ ResampleContext := audio_resample_init(
+ dstFormatInfo.Channels, srcFormatInfo.Channels,
+ Round(dstFormatInfo.SampleRate), Round(srcFormatInfo.SampleRate));
+ if (ResampleContext = nil) then
+ begin
+ Log.LogError('audio_resample_init() failed', 'TAudioConverter_FFmpeg.Init');
+ Exit;
+ end;
+
+ // calculate ratio
+ Ratio := (dstFormatInfo.Channels / srcFormatInfo.Channels) *
+ (dstFormatInfo.SampleRate / srcFormatInfo.SampleRate);
+
+ Result := true;
+end;
+
+destructor TAudioConverter_FFmpeg.Destroy();
+begin
+ if (ResampleContext <> nil) then
+ audio_resample_close(ResampleContext);
+ inherited;
+end;
+
+function TAudioConverter_FFmpeg.Convert(InputBuffer: PChar; OutputBuffer: PChar; var InputSize: integer): integer;
+var
+ InputSampleCount: integer;
+ OutputSampleCount: integer;
+begin
+ Result := -1;
+
+ if (InputSize <= 0) then
+ begin
+ // avoid div-by-zero in audio_resample()
+ if (InputSize = 0) then
+ Result := 0;
+ Exit;
+ end;
+
+ InputSampleCount := InputSize div SrcFormatInfo.FrameSize;
+ OutputSampleCount := audio_resample(
+ ResampleContext, PSmallInt(OutputBuffer), PSmallInt(InputBuffer),
+ InputSampleCount);
+ if (OutputSampleCount = -1) then
+ begin
+ Log.LogError('audio_resample() failed', 'TAudioConverter_FFmpeg.Convert');
+ Exit;
+ end;
+ Result := OutputSampleCount * DstFormatInfo.FrameSize;
+end;
+
+function TAudioConverter_FFmpeg.GetOutputBufferSize(InputSize: integer): integer;
+begin
+ Result := Ceil(InputSize * GetRatio());
+end;
+
+function TAudioConverter_FFmpeg.GetRatio(): double;
+begin
+ Result := Ratio;
+end;
+
+{$ENDIF}
+
+
+{$IFDEF UseSRCResample}
+
+function TAudioConverter_SRC.Init(SrcFormatInfo: TAudioFormatInfo; DstFormatInfo: TAudioFormatInfo): boolean;
+var
+ error: integer;
+ TempSrcFormatInfo: TAudioFormatInfo;
+ TempDstFormatInfo: TAudioFormatInfo;
+begin
+ inherited Init(SrcFormatInfo, DstFormatInfo);
+
+ Result := false;
+
+ FormatConverter := nil;
+
+ // SRC does not handle channel or format conversion
+ if ((SrcFormatInfo.Channels <> DstFormatInfo.Channels) or
+ not (SrcFormatInfo.Format in [asfS16, asfFloat])) then
+ begin
+ // SDL can not convert to float, so we have to convert to SInt16 first
+ TempSrcFormatInfo := TAudioFormatInfo.Create(
+ SrcFormatInfo.Channels, SrcFormatInfo.SampleRate, SrcFormatInfo.Format);
+ TempDstFormatInfo := TAudioFormatInfo.Create(
+ DstFormatInfo.Channels, SrcFormatInfo.SampleRate, asfS16);
+
+ // init format/channel conversion
+ FormatConverter := TAudioConverter_SDL.Create();
+ if (not FormatConverter.Init(TempSrcFormatInfo, TempDstFormatInfo)) then
+ begin
+ Log.LogError('Unsupported input format', 'TAudioConverter_SRC.Init');
+ FormatConverter.Free;
+ // exit after the format-info is freed
+ end;
+
+ // this info was copied so we do not need it anymore
+ TempSrcFormatInfo.Free;
+ TempDstFormatInfo.Free;
+
+ // leave if the format is not supported
+ if (not assigned(FormatConverter)) then
+ Exit;
+
+ // adjust our copy of the input audio-format for SRC conversion
+ Self.SrcFormatInfo.Channels := DstFormatInfo.Channels;
+ Self.SrcFormatInfo.Format := asfS16;
+ end;
+
+ if ((DstFormatInfo.Format <> asfS16) and
+ (DstFormatInfo.Format <> asfFloat)) then
+ begin
+ Log.LogError('Unsupported output format', 'TAudioConverter_SRC.Init');
+ Exit;
+ end;
+
+ ConversionData.src_ratio := DstFormatInfo.SampleRate / SrcFormatInfo.SampleRate;
+ if (src_is_valid_ratio(ConversionData.src_ratio) = 0) then
+ begin
+ Log.LogError('Invalid samplerate ratio', 'TAudioConverter_SRC.Init');
+ Exit;
+ end;
+
+ ConverterState := src_new(SRC_CONVERTER_TYPE, DstFormatInfo.Channels, @error);
+ if (ConverterState = nil) then
+ begin
+ Log.LogError('src_new() failed: ' + src_strerror(error), 'TAudioConverter_SRC.Init');
+ Exit;
+ end;
+
+ Result := true;
+end;
+
+destructor TAudioConverter_SRC.Destroy();
+begin
+ if (ConverterState <> nil) then
+ src_delete(ConverterState);
+ FormatConverter.Free;
+ inherited;
+end;
+
+function TAudioConverter_SRC.Convert(InputBuffer: PChar; OutputBuffer: PChar; var InputSize: integer): integer;
+var
+ FloatInputBuffer: PSingle;
+ FloatOutputBuffer: PSingle;
+ TempBuffer: PChar;
+ TempSize: integer;
+ NumSamples: integer;
+ OutputSize: integer;
+ error: integer;
+begin
+ Result := -1;
+
+ TempBuffer := nil;
+
+ // format conversion with external converter (to correct number of channels and format)
+ if (assigned(FormatConverter)) then
+ begin
+ TempSize := FormatConverter.GetOutputBufferSize(InputSize);
+ GetMem(TempBuffer, TempSize);
+ InputSize := FormatConverter.Convert(InputBuffer, TempBuffer, InputSize);
+ InputBuffer := TempBuffer;
+ end;
+
+ if (InputSize <= 0) then
+ begin
+ // avoid div-by-zero problems
+ if (InputSize = 0) then
+ Result := 0;
+ if (TempBuffer <> nil) then
+ FreeMem(TempBuffer);
+ Exit;
+ end;
+
+ if (SrcFormatInfo.Format = asfFloat) then
+ begin
+ FloatInputBuffer := PSingle(InputBuffer);
+ end else begin
+ NumSamples := InputSize div AudioSampleSize[SrcFormatInfo.Format];
+ GetMem(FloatInputBuffer, NumSamples * SizeOf(Single));
+ src_short_to_float_array(PCshort(InputBuffer), PCfloat(FloatInputBuffer), NumSamples);
+ end;
+
+ // calculate approx. output size
+ OutputSize := Ceil(InputSize * ConversionData.src_ratio);
+
+ if (DstFormatInfo.Format = asfFloat) then
+ begin
+ FloatOutputBuffer := PSingle(OutputBuffer);
+ end else begin
+ NumSamples := OutputSize div AudioSampleSize[DstFormatInfo.Format];
+ GetMem(FloatOutputBuffer, NumSamples * SizeOf(Single));
+ end;
+
+ with ConversionData do
+ begin
+ data_in := PCFloat(FloatInputBuffer);
+ input_frames := InputSize div SrcFormatInfo.FrameSize;
+ data_out := PCFloat(FloatOutputBuffer);
+ output_frames := OutputSize div DstFormatInfo.FrameSize;
+ // TODO: set this to 1 at end of file-playback
+ end_of_input := 0;
+ end;
+
+ error := src_process(ConverterState, @ConversionData);
+ if (error <> 0) then
+ begin
+ Log.LogError(src_strerror(error), 'TAudioConverter_SRC.Convert');
+ if (SrcFormatInfo.Format <> asfFloat) then
+ FreeMem(FloatInputBuffer);
+ if (DstFormatInfo.Format <> asfFloat) then
+ FreeMem(FloatOutputBuffer);
+ if (TempBuffer <> nil) then
+ FreeMem(TempBuffer);
+ Exit;
+ end;
+
+ if (SrcFormatInfo.Format <> asfFloat) then
+ FreeMem(FloatInputBuffer);
+
+ if (DstFormatInfo.Format <> asfFloat) then
+ begin
+ NumSamples := ConversionData.output_frames_gen * DstFormatInfo.Channels;
+ src_float_to_short_array(PCfloat(FloatOutputBuffer), PCshort(OutputBuffer), NumSamples);
+ FreeMem(FloatOutputBuffer);
+ end;
+
+ // free format conversion buffer if used
+ if (TempBuffer <> nil) then
+ FreeMem(TempBuffer);
+
+ if (assigned(FormatConverter)) then
+ InputSize := ConversionData.input_frames_used * FormatConverter.SrcFormatInfo.FrameSize
+ else
+ InputSize := ConversionData.input_frames_used * SrcFormatInfo.FrameSize;
+
+ // set result to output size according to SRC
+ Result := ConversionData.output_frames_gen * DstFormatInfo.FrameSize;
+end;
+
+function TAudioConverter_SRC.GetOutputBufferSize(InputSize: integer): integer;
+begin
+ Result := Ceil(InputSize * GetRatio());
+end;
+
+function TAudioConverter_SRC.GetRatio(): double;
+begin
+ // if we need additional channel/format conversion, use this ratio
+ if (assigned(FormatConverter)) then
+ Result := FormatConverter.GetRatio()
+ else
+ Result := 1.0;
+
+ // now the SRC ratio (Note: the format might change from SInt16 to float)
+ Result := Result *
+ ConversionData.src_ratio *
+ (DstFormatInfo.FrameSize / SrcFormatInfo.FrameSize);
+end;
+
+{$ENDIF}
+
+end.
\ No newline at end of file
diff --git a/src/base/UAudioCore_Bass.pas b/src/base/UAudioCore_Bass.pas
new file mode 100644
index 00000000..beb2db16
--- /dev/null
+++ b/src/base/UAudioCore_Bass.pas
@@ -0,0 +1,123 @@
+unit UAudioCore_Bass;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+uses
+ Classes,
+ SysUtils,
+ UMusic,
+ bass; // (Note: DWORD is defined here)
+
+type
+ TAudioCore_Bass = class
+ public
+ constructor Create();
+ class function GetInstance(): TAudioCore_Bass;
+ function ErrorGetString(): string; overload;
+ function ErrorGetString(errCode: integer): string; overload;
+ function ConvertAudioFormatToBASSFlags(Format: TAudioSampleFormat; out Flags: DWORD): boolean;
+ function ConvertBASSFlagsToAudioFormat(Flags: DWORD; out Format: TAudioSampleFormat): boolean;
+ end;
+
+implementation
+
+uses
+ UMain,
+ ULog;
+
+var
+ Instance: TAudioCore_Bass;
+
+constructor TAudioCore_Bass.Create();
+begin
+ inherited;
+end;
+
+class function TAudioCore_Bass.GetInstance(): TAudioCore_Bass;
+begin
+ if (not Assigned(Instance)) then
+ Instance := TAudioCore_Bass.Create();
+ Result := Instance;
+end;
+
+function TAudioCore_Bass.ErrorGetString(): string;
+begin
+ Result := ErrorGetString(BASS_ErrorGetCode());
+end;
+
+function TAudioCore_Bass.ErrorGetString(errCode: integer): string;
+begin
+ case errCode of
+ BASS_OK: result := 'No error';
+ BASS_ERROR_MEM: result := 'Insufficient memory';
+ BASS_ERROR_FILEOPEN: result := 'File could not be opened';
+ BASS_ERROR_DRIVER: result := 'Device driver not available';
+ BASS_ERROR_BUFLOST: result := 'Buffer lost';
+ BASS_ERROR_HANDLE: result := 'Invalid Handle';
+ BASS_ERROR_FORMAT: result := 'Sample-Format not supported';
+ BASS_ERROR_POSITION: result := 'Illegal position';
+ BASS_ERROR_INIT: result := 'BASS_Init has not been successfully called';
+ BASS_ERROR_START: result := 'Paused/stopped';
+ BASS_ERROR_ALREADY: result := 'Already created/used';
+ BASS_ERROR_NOCHAN: result := 'No free channels';
+ BASS_ERROR_ILLTYPE: result := 'Type is invalid';
+ BASS_ERROR_ILLPARAM: result := 'Illegal parameter';
+ BASS_ERROR_NO3D: result := 'No 3D support';
+ BASS_ERROR_NOEAX: result := 'No EAX support';
+ BASS_ERROR_DEVICE: result := 'Invalid device number';
+ BASS_ERROR_NOPLAY: result := 'Channel not playing';
+ BASS_ERROR_FREQ: result := 'Freq out of range';
+ BASS_ERROR_NOTFILE: result := 'Not a file stream';
+ BASS_ERROR_NOHW: result := 'No hardware support';
+ BASS_ERROR_EMPTY: result := 'Is empty';
+ BASS_ERROR_NONET: result := 'Network unavailable';
+ BASS_ERROR_CREATE: result := 'Creation error';
+ BASS_ERROR_NOFX: result := 'DX8 effects unavailable';
+ BASS_ERROR_NOTAVAIL: result := 'Not available';
+ BASS_ERROR_DECODE: result := 'Is a decoding channel';
+ BASS_ERROR_DX: result := 'Insufficient version of DirectX';
+ BASS_ERROR_TIMEOUT: result := 'Timeout';
+ BASS_ERROR_FILEFORM: result := 'File-Format not recognised/supported';
+ BASS_ERROR_SPEAKER: result := 'Requested speaker(s) not support';
+ BASS_ERROR_VERSION: result := 'Version error';
+ BASS_ERROR_CODEC: result := 'Codec not available/supported';
+ BASS_ERROR_ENDED: result := 'The channel/file has ended';
+ BASS_ERROR_UNKNOWN: result := 'Unknown error';
+ else result := 'Unknown error';
+ end;
+end;
+
+function TAudioCore_Bass.ConvertAudioFormatToBASSFlags(Format: TAudioSampleFormat; out Flags: DWORD): boolean;
+begin
+ case Format of
+ asfS16: Flags := 0;
+ asfFloat: Flags := BASS_SAMPLE_FLOAT;
+ asfU8: Flags := BASS_SAMPLE_8BITS;
+ else begin
+ Result := false;
+ Exit;
+ end;
+ end;
+
+ Result := true;
+end;
+
+function TAudioCore_Bass.ConvertBASSFlagsToAudioFormat(Flags: DWORD; out Format: TAudioSampleFormat): boolean;
+begin
+ if ((Flags and BASS_SAMPLE_FLOAT) <> 0) then
+ Format := asfFloat
+ else if ((Flags and BASS_SAMPLE_8BITS) <> 0) then
+ Format := asfU8
+ else
+ Format := asfS16;
+
+ Result := true;
+end;
+
+end.
diff --git a/src/base/UAudioCore_Portaudio.pas b/src/base/UAudioCore_Portaudio.pas
new file mode 100644
index 00000000..bcc8a001
--- /dev/null
+++ b/src/base/UAudioCore_Portaudio.pas
@@ -0,0 +1,257 @@
+unit UAudioCore_Portaudio;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I ../switches.inc}
+
+
+uses
+ Classes,
+ SysUtils,
+ portaudio;
+
+type
+ TAudioCore_Portaudio = class
+ public
+ constructor Create();
+ class function GetInstance(): TAudioCore_Portaudio;
+ function GetPreferredApiIndex(): TPaHostApiIndex;
+ function TestDevice(inParams, outParams: PPaStreamParameters; var sampleRate: Double): boolean;
+ end;
+
+implementation
+
+uses
+ ULog;
+
+{*
+ * The default API used by Portaudio is the least common denominator
+ * and might lack efficiency. In addition it might not even work.
+ * We use an array named ApiPreferenceOrder with which we define the order of
+ * preferred APIs to use. The first API-type in the list is tried first.
+ * If it is not available the next one is tried and so on ...
+ * If none of the preferred APIs was found the default API (detected by
+ * portaudio) is used.
+ *
+ * Pascal does not permit zero-length static arrays, so you must use paDefaultApi
+ * as an array's only member if you do not have any preferences.
+ * You can also append paDefaultApi to a non-zero length preferences array but
+ * this is optional because the default API is always used as a fallback.
+ *}
+const
+ paDefaultApi = -1;
+const
+ ApiPreferenceOrder:
+{$IF Defined(MSWINDOWS)}
+ // Note1: Portmixer has no mixer support for paASIO and paWASAPI at the moment
+ // Note2: Windows Default-API is MME, but DirectSound is faster
+ array[0..0] of TPaHostApiTypeId = ( paDirectSound );
+{$ELSEIF Defined(LINUX)}
+ // Note: Portmixer has no mixer support for JACK at the moment
+ array[0..2] of TPaHostApiTypeId = ( paALSA, paJACK, paOSS );
+{$ELSEIF Defined(DARWIN)}
+ array[0..0] of TPaHostApiTypeId = ( paDefaultApi ); // paCoreAudio
+{$ELSE}
+ array[0..0] of TPaHostApiTypeId = ( paDefaultApi );
+{$IFEND}
+
+
+{ TAudioInput_Portaudio }
+
+var
+ Instance: TAudioCore_Portaudio;
+
+constructor TAudioCore_Portaudio.Create();
+begin
+ inherited;
+end;
+
+class function TAudioCore_Portaudio.GetInstance(): TAudioCore_Portaudio;
+begin
+ if not assigned(Instance) then
+ Instance := TAudioCore_Portaudio.Create();
+ Result := Instance;
+end;
+
+function TAudioCore_Portaudio.GetPreferredApiIndex(): TPaHostApiIndex;
+var
+ i: integer;
+ apiIndex: TPaHostApiIndex;
+ apiInfo: PPaHostApiInfo;
+begin
+ result := -1;
+
+ // select preferred sound-API
+ for i:= 0 to High(ApiPreferenceOrder) do
+ begin
+ if(ApiPreferenceOrder[i] <> paDefaultApi) then
+ begin
+ // check if API is available
+ apiIndex := Pa_HostApiTypeIdToHostApiIndex(ApiPreferenceOrder[i]);
+ if(apiIndex >= 0) then
+ begin
+ // we found an API but we must check if it works
+ // (on linux portaudio might detect OSS but does not provide
+ // any devices if ALSA is enabled)
+ apiInfo := Pa_GetHostApiInfo(apiIndex);
+ if (apiInfo^.deviceCount > 0) then
+ begin
+ Result := apiIndex;
+ break;
+ end;
+ end;
+ end;
+ end;
+
+ // None of the preferred APIs is available -> use default
+ if(result < 0) then
+ begin
+ result := Pa_GetDefaultHostApi();
+ end;
+end;
+
+{*
+ * Portaudio test callback used by TestDevice().
+ *}
+function TestCallback(input: Pointer; output: Pointer; frameCount: Longword;
+ timeInfo: PPaStreamCallbackTimeInfo; statusFlags: TPaStreamCallbackFlags;
+ inputDevice: Pointer): Integer; cdecl;
+begin
+ // this callback is called only once
+ result := paAbort;
+end;
+
+(*
+ * Tests if the callback works. Some devices can be opened without
+ * an error but the callback is never called. Calling Pa_StopStream() on such
+ * a stream freezes USDX then. Probably because the callback-thread is deadlocked
+ * due to some bug in portaudio. The blocking Pa_ReadStream() and Pa_WriteStream()
+ * block forever too and though can't be used for testing.
+ *
+ * To avoid freezing Pa_AbortStream (or Pa_CloseStream which calls Pa_AbortStream)
+ * can be used to force the stream to stop. But for some reason this stops debugging
+ * in gdb with a "no process found" message.
+ *
+ * Because freezing devices are non-working devices we test the devices here to
+ * be able to exclude them from the device-selection list.
+ *
+ * Portaudio does not provide any test to check this error case (probably because
+ * it should not even occur). So we have to open the device, start the stream and
+ * check if the callback is called (the stream is stopped if the callback is called
+ * for the first time, so we can poll until the stream is stopped).
+ *
+ * Another error that occurs is that some devices (even the default device) might
+ * work at the beginning but stop after a few calls (maybe 50) of the callback.
+ * For me this problem occurs with the default output-device. The "dmix" or "front"
+ * device must be selected instead. Another problem is that (due to a bug in
+ * portaudio or ALSA) the "front" device is not detected every time portaudio
+ * is started. Sometimes it needs two or more restarts.
+ *
+ * There is no reasonable way to test for these errors. For the first error-case
+ * we could test if the callback is called 50 times but this can take a second
+ * for each device and it can fail in the 51st or even 100th callback call then.
+ *
+ * The second error-case cannot be tested at all. How should we now that one
+ * device is missing if portaudio is not even able to detect it.
+ * We could start and terminate Portaudio for several times and see if the device
+ * count changes but this is ugly.
+ *
+ * Conclusion: We are not able to autodetect a working device with
+ * portaudio (at least not with the newest v19_20071207) at the moment.
+ * So we have to provide the possibility to manually select an output device
+ * in the UltraStar options if we want to use portaudio instead of SDL.
+ *)
+function TAudioCore_Portaudio.TestDevice(inParams, outParams: PPaStreamParameters; var sampleRate: Double): boolean;
+var
+ stream: PPaStream;
+ err: TPaError;
+ cbWorks: boolean;
+ cbPolls: integer;
+ i: integer;
+const
+ altSampleRates: array[0..1] of Double = (44100, 48000); // alternative sample-rates
+begin
+ Result := false;
+
+ if (sampleRate <= 0) then
+ sampleRate := 44100;
+
+ // check if device supports our input-format
+ err := Pa_IsFormatSupported(inParams, outParams, sampleRate);
+ if(err <> paNoError) then
+ begin
+ // we cannot fix the error -> exit
+ if (err <> paInvalidSampleRate) then
+ Exit;
+
+ // try alternative sample-rates to the detected one
+ sampleRate := 0;
+ for i := 0 to High(altSampleRates) do
+ begin
+ // do not check the detected sample-rate twice
+ if (altSampleRates[i] = sampleRate) then
+ continue;
+ // check alternative
+ err := Pa_IsFormatSupported(inParams, outParams, altSampleRates[i]);
+ if (err = paNoError) then
+ begin
+ // sample-rate works
+ sampleRate := altSampleRates[i];
+ break;
+ end;
+ end;
+ // no working sample-rate found
+ if (sampleRate = 0) then
+ Exit;
+ end;
+
+ // FIXME: for some reason gdb stops after a call of Pa_AbortStream()
+ // which is implicitely called by Pa_CloseStream().
+ // gdb's stops with the message: "ptrace: no process found".
+ // Probably because the callback-thread is killed what confuses gdb.
+ {$IF Defined(Debug) and Defined(Linux)}
+ cbWorks := true;
+ {$ELSE}
+ // open device for testing
+ err := Pa_OpenStream(stream, inParams, outParams, sampleRate,
+ paFramesPerBufferUnspecified,
+ paNoFlag, @TestCallback, nil);
+ if(err <> paNoError) then
+ begin
+ exit;
+ end;
+
+ // start the callback
+ err := Pa_StartStream(stream);
+ if(err <> paNoError) then
+ begin
+ Pa_CloseStream(stream);
+ exit;
+ end;
+
+ cbWorks := false;
+ // check if the callback was called (poll for max. 200ms)
+ for cbPolls := 1 to 20 do
+ begin
+ // if the test-callback was called it should be aborted now
+ if (Pa_IsStreamActive(stream) = 0) then
+ begin
+ cbWorks := true;
+ break;
+ end;
+ // not yet aborted, wait and try (poll) again
+ Pa_Sleep(10);
+ end;
+
+ // finally abort the stream
+ Pa_CloseStream(stream);
+ {$IFEND}
+
+ Result := cbWorks;
+end;
+
+end.
diff --git a/src/base/UAudioDecoder_Bass.pas b/src/base/UAudioDecoder_Bass.pas
new file mode 100644
index 00000000..dba1fde4
--- /dev/null
+++ b/src/base/UAudioDecoder_Bass.pas
@@ -0,0 +1,242 @@
+unit UAudioDecoder_Bass;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+implementation
+
+uses
+ Classes,
+ SysUtils,
+ UMain,
+ UMusic,
+ UAudioCore_Bass,
+ ULog,
+ bass;
+
+type
+ TBassDecodeStream = class(TAudioDecodeStream)
+ private
+ Handle: HSTREAM;
+ FormatInfo : TAudioFormatInfo;
+ Error: boolean;
+ public
+ constructor Create(Handle: HSTREAM);
+ destructor Destroy(); override;
+
+ procedure Close(); override;
+
+ function GetLength(): real; override;
+ function GetAudioFormatInfo(): TAudioFormatInfo; override;
+ function GetPosition: real; override;
+ procedure SetPosition(Time: real); override;
+ function GetLoop(): boolean; override;
+ procedure SetLoop(Enabled: boolean); override;
+ function IsEOF(): boolean; override;
+ function IsError(): boolean; override;
+
+ function ReadData(Buffer: PChar; BufSize: integer): integer; override;
+ end;
+
+type
+ TAudioDecoder_Bass = class( TInterfacedObject, IAudioDecoder )
+ public
+ function GetName: string;
+
+ function InitializeDecoder(): boolean;
+ function FinalizeDecoder(): boolean;
+ function Open(const Filename: string): TAudioDecodeStream;
+ end;
+
+var
+ BassCore: TAudioCore_Bass;
+
+
+{ TBassDecodeStream }
+
+constructor TBassDecodeStream.Create(Handle: HSTREAM);
+var
+ ChannelInfo: BASS_CHANNELINFO;
+ Format: TAudioSampleFormat;
+begin
+ inherited Create();
+ Self.Handle := Handle;
+
+ // setup format info
+ if (not BASS_ChannelGetInfo(Handle, ChannelInfo)) then
+ begin
+ raise Exception.Create('Failed to open decode-stream');
+ end;
+ BassCore.ConvertBASSFlagsToAudioFormat(ChannelInfo.flags, Format);
+ FormatInfo := TAudioFormatInfo.Create(ChannelInfo.chans, ChannelInfo.freq, format);
+
+ Error := false;
+end;
+
+destructor TBassDecodeStream.Destroy();
+begin
+ Close();
+ inherited;
+end;
+
+procedure TBassDecodeStream.Close();
+begin
+ if (Handle <> 0) then
+ begin
+ BASS_StreamFree(Handle);
+ Handle := 0;
+ end;
+ PerformOnClose();
+ FreeAndNil(FormatInfo);
+ Error := false;
+end;
+
+function TBassDecodeStream.GetAudioFormatInfo(): TAudioFormatInfo;
+begin
+ Result := FormatInfo;
+end;
+
+function TBassDecodeStream.GetLength(): real;
+var
+ bytes: QWORD;
+begin
+ bytes := BASS_ChannelGetLength(Handle, BASS_POS_BYTE);
+ Result := BASS_ChannelBytes2Seconds(Handle, bytes);
+end;
+
+function TBassDecodeStream.GetPosition: real;
+var
+ bytes: QWORD;
+begin
+ bytes := BASS_ChannelGetPosition(Handle, BASS_POS_BYTE);
+ Result := BASS_ChannelBytes2Seconds(Handle, bytes);
+end;
+
+procedure TBassDecodeStream.SetPosition(Time: real);
+var
+ bytes: QWORD;
+begin
+ bytes := BASS_ChannelSeconds2Bytes(Handle, Time);
+ BASS_ChannelSetPosition(Handle, bytes, BASS_POS_BYTE);
+end;
+
+function TBassDecodeStream.GetLoop(): boolean;
+var
+ flags: DWORD;
+begin
+ // retrieve channel flags
+ flags := BASS_ChannelFlags(Handle, 0, 0);
+ if (flags = DWORD(-1)) then
+ begin
+ Log.LogError('BASS_ChannelFlags: ' + BassCore.ErrorGetString(), 'TBassDecodeStream.GetLoop');
+ Result := false;
+ Exit;
+ end;
+ Result := (flags and BASS_SAMPLE_LOOP) <> 0;
+end;
+
+procedure TBassDecodeStream.SetLoop(Enabled: boolean);
+var
+ flags: DWORD;
+begin
+ // set/unset loop-flag
+ if (Enabled) then
+ flags := BASS_SAMPLE_LOOP
+ else
+ flags := 0;
+
+ // set new flag-bits
+ if (BASS_ChannelFlags(Handle, flags, BASS_SAMPLE_LOOP) = DWORD(-1)) then
+ begin
+ Log.LogError('BASS_ChannelFlags: ' + BassCore.ErrorGetString(), 'TBassDecodeStream.SetLoop');
+ Exit;
+ end;
+end;
+
+function TBassDecodeStream.IsEOF(): boolean;
+begin
+ Result := (BASS_ChannelIsActive(Handle) = BASS_ACTIVE_STOPPED);
+end;
+
+function TBassDecodeStream.IsError(): boolean;
+begin
+ Result := Error;
+end;
+
+function TBassDecodeStream.ReadData(Buffer: PChar; BufSize: integer): integer;
+begin
+ Result := BASS_ChannelGetData(Handle, Buffer, BufSize);
+ // check error state (do not handle EOF as error)
+ if ((Result = -1) and (BASS_ErrorGetCode() <> BASS_ERROR_ENDED)) then
+ Error := true
+ else
+ Error := false;
+end;
+
+
+{ TAudioDecoder_Bass }
+
+function TAudioDecoder_Bass.GetName: String;
+begin
+ result := 'BASS_Decoder';
+end;
+
+function TAudioDecoder_Bass.InitializeDecoder(): boolean;
+begin
+ BassCore := TAudioCore_Bass.GetInstance();
+ Result := true;
+end;
+
+function TAudioDecoder_Bass.FinalizeDecoder(): boolean;
+begin
+ Result := true;
+end;
+
+function TAudioDecoder_Bass.Open(const Filename: string): TAudioDecodeStream;
+var
+ Stream: HSTREAM;
+ ChannelInfo: BASS_CHANNELINFO;
+ FileExt: string;
+begin
+ Result := nil;
+
+ // check if BASS was initialized
+ // in case the decoder is not used with BASS playback, init the NO_SOUND device
+ if ((integer(BASS_GetDevice) = -1) and (BASS_ErrorGetCode() = BASS_ERROR_INIT)) then
+ BASS_Init(0, 44100, 0, 0, nil);
+
+ // TODO: use BASS_STREAM_PRESCAN for accurate seeking in VBR-files?
+ // disadvantage: seeking will slow down.
+ Stream := BASS_StreamCreateFile(False, PChar(Filename), 0, 0, BASS_STREAM_DECODE);
+ if (Stream = 0) then
+ begin
+ //Log.LogError(BassCore.ErrorGetString(), 'TAudioDecoder_Bass.Open');
+ Exit;
+ end;
+
+ // check if BASS opened some erroneously recognized file-formats
+ if BASS_ChannelGetInfo(Stream, channelInfo) then
+ begin
+ fileExt := ExtractFileExt(Filename);
+ // BASS opens FLV-files (maybe others too) although it cannot handle them.
+ // Setting BASS_CONFIG_VERIFY to the max. value (100000) does not help.
+ if ((fileExt = '.flv') and (channelInfo.ctype = BASS_CTYPE_STREAM_MP1)) then
+ begin
+ BASS_StreamFree(Stream);
+ Exit;
+ end;
+ end;
+
+ Result := TBassDecodeStream.Create(Stream);
+end;
+
+
+initialization
+ MediaManager.Add(TAudioDecoder_Bass.Create);
+
+end.
diff --git a/src/base/UAudioDecoder_FFmpeg.pas b/src/base/UAudioDecoder_FFmpeg.pas
new file mode 100644
index 00000000..d9b4c93c
--- /dev/null
+++ b/src/base/UAudioDecoder_FFmpeg.pas
@@ -0,0 +1,1114 @@
+unit UAudioDecoder_FFmpeg;
+
+(*******************************************************************************
+ *
+ * This unit is primarily based upon -
+ * http://www.dranger.com/ffmpeg/ffmpegtutorial_all.html
+ *
+ * and tutorial03.c
+ *
+ * http://www.inb.uni-luebeck.de/~boehme/using_libavcodec.html
+ *
+ *******************************************************************************)
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+// show FFmpeg specific debug output
+{.$DEFINE DebugFFmpegDecode}
+
+// FFmpeg is very verbose and shows a bunch of errors.
+// Those errors (they can be considered as warnings by us) can be ignored
+// as they do not give any useful information.
+// There is no solution to fix this except for turning them off.
+{.$DEFINE EnableFFmpegErrorOutput}
+
+implementation
+
+uses
+ Classes,
+ SysUtils,
+ Math,
+ UMusic,
+ UIni,
+ UMain,
+ avcodec,
+ avformat,
+ avutil,
+ avio,
+ mathematics, // used for av_rescale_q
+ rational,
+ UMediaCore_FFmpeg,
+ SDL,
+ ULog,
+ UCommon,
+ UConfig;
+
+const
+ MAX_AUDIOQ_SIZE = (5 * 16 * 1024);
+
+const
+ // TODO: The factor 3/2 might not be necessary as we do not need extra
+ // space for synchronizing as in the tutorial.
+ AUDIO_BUFFER_SIZE = (AVCODEC_MAX_AUDIO_FRAME_SIZE * 3) div 2;
+
+type
+ TFFmpegDecodeStream = class(TAudioDecodeStream)
+ private
+ StateLock: PSDL_Mutex;
+
+ EOFState: boolean; // end-of-stream flag (locked by StateLock)
+ ErrorState: boolean; // error flag (locked by StateLock)
+
+ QuitRequest: boolean; // (locked by StateLock)
+ ParserIdleCond: PSDL_Cond;
+
+ // parser pause/resume data
+ ParserLocked: boolean;
+ ParserPauseRequestCount: integer;
+ ParserUnlockedCond: PSDL_Cond;
+ ParserResumeCond: PSDL_Cond;
+
+ SeekRequest: boolean; // (locked by StateLock)
+ SeekFlags: integer; // (locked by StateLock)
+ SeekPos: double; // stream position to seek for (in secs) (locked by StateLock)
+ SeekFlush: boolean; // true if the buffers should be flushed after seeking (locked by StateLock)
+ SeekFinishedCond: PSDL_Cond;
+
+ Loop: boolean; // (locked by StateLock)
+
+ ParseThread: PSDL_Thread;
+ PacketQueue: TPacketQueue;
+
+ FormatInfo: TAudioFormatInfo;
+
+ // FFmpeg specific data
+ FormatCtx: PAVFormatContext;
+ CodecCtx: PAVCodecContext;
+ Codec: PAVCodec;
+
+ AudioStreamIndex: integer;
+ AudioStream: PAVStream;
+ AudioStreamPos: double; // stream position in seconds (locked by DecoderLock)
+
+ // decoder pause/resume data
+ DecoderLocked: boolean;
+ DecoderPauseRequestCount: integer;
+ DecoderUnlockedCond: PSDL_Cond;
+ DecoderResumeCond: PSDL_Cond;
+
+ // state-vars for DecodeFrame (locked by DecoderLock)
+ AudioPaket: TAVPacket;
+ AudioPaketData: PChar;
+ AudioPaketSize: integer;
+ AudioPaketSilence: integer; // number of bytes of silence to return
+
+ // state-vars for AudioCallback (locked by DecoderLock)
+ AudioBufferPos: integer;
+ AudioBufferSize: integer;
+ AudioBuffer: PChar;
+
+ Filename: string;
+
+ procedure SetPositionIntern(Time: real; Flush: boolean; Blocking: boolean);
+ procedure SetEOF(State: boolean); {$IFDEF HasInline}inline;{$ENDIF}
+ procedure SetError(State: boolean); {$IFDEF HasInline}inline;{$ENDIF}
+ function IsSeeking(): boolean;
+ function IsQuit(): boolean;
+
+ procedure Reset();
+
+ procedure Parse();
+ function ParseLoop(): boolean;
+ procedure PauseParser();
+ procedure ResumeParser();
+
+ function DecodeFrame(Buffer: PChar; BufferSize: integer): integer;
+ procedure FlushCodecBuffers();
+ procedure PauseDecoder();
+ procedure ResumeDecoder();
+ public
+ constructor Create();
+ destructor Destroy(); override;
+
+ function Open(const Filename: string): boolean;
+ procedure Close(); override;
+
+ function GetLength(): real; override;
+ function GetAudioFormatInfo(): TAudioFormatInfo; override;
+ function GetPosition: real; override;
+ procedure SetPosition(Time: real); override;
+ function GetLoop(): boolean; override;
+ procedure SetLoop(Enabled: boolean); override;
+ function IsEOF(): boolean; override;
+ function IsError(): boolean; override;
+
+ function ReadData(Buffer: PChar; BufferSize: integer): integer; override;
+ end;
+
+type
+ TAudioDecoder_FFmpeg = class( TInterfacedObject, IAudioDecoder )
+ public
+ function GetName: string;
+
+ function InitializeDecoder(): boolean;
+ function FinalizeDecoder(): boolean;
+ function Open(const Filename: string): TAudioDecodeStream;
+ end;
+
+var
+ FFmpegCore: TMediaCore_FFmpeg;
+
+function ParseThreadMain(Data: Pointer): integer; cdecl; forward;
+
+
+{ TFFmpegDecodeStream }
+
+constructor TFFmpegDecodeStream.Create();
+begin
+ inherited Create();
+
+ StateLock := SDL_CreateMutex();
+ ParserUnlockedCond := SDL_CreateCond();
+ ParserResumeCond := SDL_CreateCond();
+ ParserIdleCond := SDL_CreateCond();
+ SeekFinishedCond := SDL_CreateCond();
+ DecoderUnlockedCond := SDL_CreateCond();
+ DecoderResumeCond := SDL_CreateCond();
+
+ // according to the documentation of avcodec_decode_audio(2), sample-data
+ // should be aligned on a 16 byte boundary. Otherwise internal calls
+ // (e.g. to SSE or Altivec operations) might fail or lack performance on some
+ // CPUs. Although GetMem() in Delphi and FPC seems to use a 16 byte or higher
+ // alignment for buffers of this size (alignment depends on the size of the
+ // requested buffer), we will set the alignment explicitly as the minimum
+ // alignment used by Delphi and FPC is on an 8 byte boundary.
+ //
+ // Note: AudioBuffer was previously defined as a field of type TAudioBuffer
+ // (array[0..AUDIO_BUFFER_SIZE-1] of byte) and hence statically allocated.
+ // Fields of records are aligned different to memory allocated with GetMem(),
+ // aligning depending on the type but will be at least 2 bytes.
+ // AudioBuffer was not aligned to a 16 byte boundary. The {$ALIGN x} directive
+ // was not applicable as Delphi in contrast to FPC provides at most 8 byte
+ // alignment ({$ALIGN 16} is not supported) by this directive.
+ AudioBuffer := GetAlignedMem(AUDIO_BUFFER_SIZE, 16);
+
+ Reset();
+end;
+
+procedure TFFmpegDecodeStream.Reset();
+begin
+ ParseThread := nil;
+
+ EOFState := false;
+ ErrorState := false;
+ Loop := false;
+ QuitRequest := false;
+
+ AudioPaketData := nil;
+ AudioPaketSize := 0;
+ AudioPaketSilence := 0;
+
+ AudioBufferPos := 0;
+ AudioBufferSize := 0;
+
+ ParserLocked := false;
+ ParserPauseRequestCount := 0;
+ DecoderLocked := false;
+ DecoderPauseRequestCount := 0;
+
+ FillChar(AudioPaket, SizeOf(TAVPacket), 0);
+end;
+
+{*
+ * Frees the decode-stream data.
+ *}
+destructor TFFmpegDecodeStream.Destroy();
+begin
+ Close();
+
+ SDL_DestroyMutex(StateLock);
+ SDL_DestroyCond(ParserUnlockedCond);
+ SDL_DestroyCond(ParserResumeCond);
+ SDL_DestroyCond(ParserIdleCond);
+ SDL_DestroyCond(SeekFinishedCond);
+ SDL_DestroyCond(DecoderUnlockedCond);
+ SDL_DestroyCond(DecoderResumeCond);
+
+ FreeAlignedMem(AudioBuffer);
+
+ inherited;
+end;
+
+function TFFmpegDecodeStream.Open(const Filename: string): boolean;
+var
+ SampleFormat: TAudioSampleFormat;
+ AVResult: integer;
+begin
+ Result := false;
+
+ Close();
+ Reset();
+
+ if (not FileExists(Filename)) then
+ begin
+ Log.LogError('Audio-file does not exist: "' + Filename + '"', 'UAudio_FFmpeg');
+ Exit;
+ end;
+
+ Self.Filename := Filename;
+
+ // open audio file
+ if (av_open_input_file(FormatCtx, PChar(Filename), nil, 0, nil) <> 0) then
+ begin
+ Log.LogError('av_open_input_file failed: "' + Filename + '"', 'UAudio_FFmpeg');
+ Exit;
+ end;
+
+ // generate PTS values if they do not exist
+ FormatCtx^.flags := FormatCtx^.flags or AVFMT_FLAG_GENPTS;
+
+ // retrieve stream information
+ if (av_find_stream_info(FormatCtx) < 0) then
+ begin
+ Log.LogError('av_find_stream_info failed: "' + Filename + '"', 'UAudio_FFmpeg');
+ Close();
+ Exit;
+ end;
+
+ // FIXME: hack used by ffplay. Maybe should not use url_feof() to test for the end
+ FormatCtx^.pb.eof_reached := 0;
+
+ {$IFDEF DebugFFmpegDecode}
+ dump_format(FormatCtx, 0, pchar(Filename), 0);
+ {$ENDIF}
+
+ AudioStreamIndex := FFmpegCore.FindAudioStreamIndex(FormatCtx);
+ if (AudioStreamIndex < 0) then
+ begin
+ Log.LogError('FindAudioStreamIndex: No Audio-stream found "' + Filename + '"', 'UAudio_FFmpeg');
+ Close();
+ Exit;
+ end;
+
+ //Log.LogStatus('AudioStreamIndex is: '+ inttostr(ffmpegStreamID), 'UAudio_FFmpeg');
+
+ AudioStream := FormatCtx.streams[AudioStreamIndex];
+ CodecCtx := AudioStream^.codec;
+
+ // TODO: should we use this or not? Should we allow 5.1 channel audio?
+ (*
+ {$IF LIBAVCODEC_VERSION >= 51042000}
+ if (CodecCtx^.channels > 0) then
+ CodecCtx^.request_channels := Min(2, CodecCtx^.channels)
+ else
+ CodecCtx^.request_channels := 2;
+ {$IFEND}
+ *)
+
+ Codec := avcodec_find_decoder(CodecCtx^.codec_id);
+ if (Codec = nil) then
+ begin
+ Log.LogError('Unsupported codec!', 'UAudio_FFmpeg');
+ CodecCtx := nil;
+ Close();
+ Exit;
+ end;
+
+ // set debug options
+ CodecCtx^.debug_mv := 0;
+ CodecCtx^.debug := 0;
+
+ // detect bug-workarounds automatically
+ CodecCtx^.workaround_bugs := FF_BUG_AUTODETECT;
+ // error resilience strategy (careful/compliant/agressive/very_aggressive)
+ //CodecCtx^.error_resilience := FF_ER_CAREFUL; //FF_ER_COMPLIANT;
+ // allow non spec compliant speedup tricks.
+ //CodecCtx^.flags2 := CodecCtx^.flags2 or CODEC_FLAG2_FAST;
+
+ // Note: avcodec_open() and avcodec_close() are not thread-safe and will
+ // fail if called concurrently by different threads.
+ FFmpegCore.LockAVCodec();
+ try
+ AVResult := avcodec_open(CodecCtx, Codec);
+ finally
+ FFmpegCore.UnlockAVCodec();
+ end;
+ if (AVResult < 0) then
+ begin
+ Log.LogError('avcodec_open failed!', 'UAudio_FFmpeg');
+ Close();
+ Exit;
+ end;
+
+ // now initialize the audio-format
+
+ if (not FFmpegCore.ConvertFFmpegToAudioFormat(CodecCtx^.sample_fmt, SampleFormat)) then
+ begin
+ // try standard format
+ SampleFormat := asfS16;
+ end;
+
+ FormatInfo := TAudioFormatInfo.Create(
+ CodecCtx^.channels,
+ CodecCtx^.sample_rate,
+ SampleFormat
+ );
+
+
+ PacketQueue := TPacketQueue.Create();
+
+ // finally start the decode thread
+ ParseThread := SDL_CreateThread(@ParseThreadMain, Self);
+
+ Result := true;
+end;
+
+procedure TFFmpegDecodeStream.Close();
+var
+ ThreadResult: integer;
+begin
+ // wake threads waiting for packet-queue data
+ // Note: normally, there are no waiting threads. If there were waiting
+ // ones, they would block the audio-callback thread.
+ if (assigned(PacketQueue)) then
+ PacketQueue.Abort();
+
+ // send quit request (to parse-thread etc)
+ SDL_mutexP(StateLock);
+ QuitRequest := true;
+ SDL_CondBroadcast(ParserIdleCond);
+ SDL_mutexV(StateLock);
+
+ // abort parse-thread
+ if (ParseThread <> nil) then
+ begin
+ // and wait until it terminates
+ SDL_WaitThread(ParseThread, ThreadResult);
+ ParseThread := nil;
+ end;
+
+ // Close the codec
+ if (CodecCtx <> nil) then
+ begin
+ // avcodec_close() is not thread-safe
+ FFmpegCore.LockAVCodec();
+ try
+ avcodec_close(CodecCtx);
+ finally
+ FFmpegCore.UnlockAVCodec();
+ end;
+ CodecCtx := nil;
+ end;
+
+ // Close the video file
+ if (FormatCtx <> nil) then
+ begin
+ av_close_input_file(FormatCtx);
+ FormatCtx := nil;
+ end;
+
+ PerformOnClose();
+
+ FreeAndNil(PacketQueue);
+ FreeAndNil(FormatInfo);
+end;
+
+function TFFmpegDecodeStream.GetLength(): real;
+begin
+ // do not forget to consider the start_time value here
+ Result := (FormatCtx^.start_time + FormatCtx^.duration) / AV_TIME_BASE;
+end;
+
+function TFFmpegDecodeStream.GetAudioFormatInfo(): TAudioFormatInfo;
+begin
+ Result := FormatInfo;
+end;
+
+function TFFmpegDecodeStream.IsEOF(): boolean;
+begin
+ SDL_mutexP(StateLock);
+ Result := EOFState;
+ SDL_mutexV(StateLock);
+end;
+
+procedure TFFmpegDecodeStream.SetEOF(State: boolean);
+begin
+ SDL_mutexP(StateLock);
+ EOFState := State;
+ SDL_mutexV(StateLock);
+end;
+
+function TFFmpegDecodeStream.IsError(): boolean;
+begin
+ SDL_mutexP(StateLock);
+ Result := ErrorState;
+ SDL_mutexV(StateLock);
+end;
+
+procedure TFFmpegDecodeStream.SetError(State: boolean);
+begin
+ SDL_mutexP(StateLock);
+ ErrorState := State;
+ SDL_mutexV(StateLock);
+end;
+
+function TFFmpegDecodeStream.IsSeeking(): boolean;
+begin
+ SDL_mutexP(StateLock);
+ Result := SeekRequest;
+ SDL_mutexV(StateLock);
+end;
+
+function TFFmpegDecodeStream.IsQuit(): boolean;
+begin
+ SDL_mutexP(StateLock);
+ Result := QuitRequest;
+ SDL_mutexV(StateLock);
+end;
+
+function TFFmpegDecodeStream.GetPosition(): real;
+var
+ BufferSizeSec: double;
+begin
+ PauseDecoder();
+
+ // ReadData() does not return all of the buffer retrieved by DecodeFrame().
+ // Determine the size of the unused part of the decode-buffer.
+ BufferSizeSec := (AudioBufferSize - AudioBufferPos) /
+ FormatInfo.BytesPerSec;
+
+ // subtract the size of unused buffer-data from the audio clock.
+ Result := AudioStreamPos - BufferSizeSec;
+
+ ResumeDecoder();
+end;
+
+procedure TFFmpegDecodeStream.SetPosition(Time: real);
+begin
+ SetPositionIntern(Time, true, true);
+end;
+
+function TFFmpegDecodeStream.GetLoop(): boolean;
+begin
+ SDL_mutexP(StateLock);
+ Result := Loop;
+ SDL_mutexV(StateLock);
+end;
+
+procedure TFFmpegDecodeStream.SetLoop(Enabled: boolean);
+begin
+ SDL_mutexP(StateLock);
+ Loop := Enabled;
+ SDL_mutexV(StateLock);
+end;
+
+
+(********************************************
+ * Parser section
+ ********************************************)
+
+procedure TFFmpegDecodeStream.PauseParser();
+begin
+ if (SDL_ThreadID() = ParseThread.threadid) then
+ Exit;
+
+ SDL_mutexP(StateLock);
+ Inc(ParserPauseRequestCount);
+ while (ParserLocked) do
+ SDL_CondWait(ParserUnlockedCond, StateLock);
+ SDL_mutexV(StateLock);
+end;
+
+procedure TFFmpegDecodeStream.ResumeParser();
+begin
+ if (SDL_ThreadID() = ParseThread.threadid) then
+ Exit;
+
+ SDL_mutexP(StateLock);
+ Dec(ParserPauseRequestCount);
+ SDL_CondSignal(ParserResumeCond);
+ SDL_mutexV(StateLock);
+end;
+
+procedure TFFmpegDecodeStream.SetPositionIntern(Time: real; Flush: boolean; Blocking: boolean);
+begin
+ // - Pause the parser first to prevent it from putting obsolete packages
+ // into the queue after the queue was flushed and before seeking is done.
+ // Otherwise we will hear fragments of old data, if the stream was seeked
+ // in stopped mode and resumed afterwards (applies to non-blocking mode only).
+ // - Pause the decoder to avoid race-condition that might occur otherwise.
+ // - Last lock the state lock because we are manipulating some shared state-vars.
+ PauseParser();
+ PauseDecoder();
+ SDL_mutexP(StateLock);
+
+ // configure seek parameters
+ SeekPos := Time;
+ SeekFlush := Flush;
+ SeekFlags := AVSEEK_FLAG_ANY;
+ SeekRequest := true;
+
+ // Note: the BACKWARD-flag seeks to the first position <= the position
+ // searched for. Otherwise e.g. position 0 might not be seeked correct.
+ // For some reason ffmpeg sometimes doesn't use position 0 but the key-frame
+ // following. In streams with few key-frames (like many flv-files) the next
+ // key-frame after 0 might be 5secs ahead.
+ if (Time < AudioStreamPos) then
+ SeekFlags := SeekFlags or AVSEEK_FLAG_BACKWARD;
+
+ EOFState := false;
+ ErrorState := false;
+
+ // send a reuse signal in case the parser was stopped (e.g. because of an EOF)
+ SDL_CondSignal(ParserIdleCond);
+
+ SDL_mutexV(StateLock);
+ ResumeDecoder();
+ ResumeParser();
+
+ // in blocking mode, wait until seeking is done
+ if (Blocking) then
+ begin
+ SDL_mutexP(StateLock);
+ while (SeekRequest) do
+ SDL_CondWait(SeekFinishedCond, StateLock);
+ SDL_mutexV(StateLock);
+ end;
+end;
+
+function ParseThreadMain(Data: Pointer): integer; cdecl;
+var
+ Stream: TFFmpegDecodeStream;
+begin
+ Stream := TFFmpegDecodeStream(Data);
+ if (Stream <> nil) then
+ Stream.Parse();
+ Result := 0;
+end;
+
+procedure TFFmpegDecodeStream.Parse();
+begin
+ // reuse thread as long as the stream is not terminated
+ while (ParseLoop()) do
+ begin
+ // wait for reuse or destruction of stream
+ SDL_mutexP(StateLock);
+ while (not (SeekRequest or QuitRequest)) do
+ SDL_CondWait(ParserIdleCond, StateLock);
+ SDL_mutexV(StateLock);
+ end;
+end;
+
+(**
+ * Parser main loop.
+ * Will not return until parsing of the stream is finished.
+ * Reasons for the parser to return are:
+ * - the end-of-file is reached
+ * - an error occured
+ * - the stream was quited (received a quit-request)
+ * Returns true if the stream can be resumed or false if the stream has to
+ * be terminated.
+ *)
+function TFFmpegDecodeStream.ParseLoop(): boolean;
+var
+ Packet: TAVPacket;
+ StatusPacket: PAVPacket;
+ SeekTarget: int64;
+ ByteIOCtx: PByteIOContext;
+ ErrorCode: integer;
+ StartSilence: double; // duration of silence at start of stream
+ StartSilencePtr: PDouble; // pointer for the EMPTY status packet
+
+ // Note: pthreads wakes threads waiting on a mutex in the order of their
+ // priority and not in FIFO order. SDL does not provide any option to
+ // control priorities. This might (and already did) starve threads waiting
+ // on the mutex (e.g. SetPosition) making usdx look like it was froozen.
+ // Instead of simply locking the critical section we set a ParserLocked flag
+ // instead and give priority to the threads requesting the parser to pause.
+ procedure LockParser();
+ begin
+ SDL_mutexP(StateLock);
+ while (ParserPauseRequestCount > 0) do
+ SDL_CondWait(ParserResumeCond, StateLock);
+ ParserLocked := true;
+ SDL_mutexV(StateLock);
+ end;
+
+ procedure UnlockParser();
+ begin
+ SDL_mutexP(StateLock);
+ ParserLocked := false;
+ SDL_CondBroadcast(ParserUnlockedCond);
+ SDL_mutexV(StateLock);
+ end;
+
+begin
+ Result := true;
+
+ while (true) do
+ begin
+ LockParser();
+ try
+
+ if (IsQuit()) then
+ begin
+ Result := false;
+ Exit;
+ end;
+
+ // handle seek-request (Note: no need to lock SeekRequest here)
+ if (SeekRequest) then
+ begin
+ // first try: seek on the audio stream
+ SeekTarget := Round(SeekPos / av_q2d(AudioStream^.time_base));
+ StartSilence := 0;
+ if (SeekTarget < AudioStream^.start_time) then
+ StartSilence := (AudioStream^.start_time - SeekTarget) * av_q2d(AudioStream^.time_base);
+ ErrorCode := av_seek_frame(FormatCtx, AudioStreamIndex, SeekTarget, SeekFlags);
+
+ if (ErrorCode < 0) then
+ begin
+ // second try: seek on the default stream (necessary for flv-videos and some ogg-files)
+ SeekTarget := Round(SeekPos * AV_TIME_BASE);
+ StartSilence := 0;
+ if (SeekTarget < FormatCtx^.start_time) then
+ StartSilence := (FormatCtx^.start_time - SeekTarget) / AV_TIME_BASE;
+ ErrorCode := av_seek_frame(FormatCtx, -1, SeekTarget, SeekFlags);
+ end;
+
+ // pause decoder and lock state (keep the lock-order to avoid deadlocks).
+ // Note that the decoder does not block in the packet-queue in seeking state,
+ // so locking the decoder here does not cause a dead-lock.
+ PauseDecoder();
+ SDL_mutexP(StateLock);
+ try
+ if (ErrorCode < 0) then
+ begin
+ // seeking failed
+ ErrorState := true;
+ Log.LogStatus('Seek Error in "'+FormatCtx^.filename+'"', 'UAudioDecoder_FFmpeg');
+ end
+ else
+ begin
+ if (SeekFlush) then
+ begin
+ // flush queue (we will send a Flush-Packet when seeking is finished)
+ PacketQueue.Flush();
+
+ // flush the decode buffers
+ AudioBufferSize := 0;
+ AudioBufferPos := 0;
+ AudioPaketSize := 0;
+ AudioPaketSilence := 0;
+ FlushCodecBuffers();
+
+ // Set preliminary stream position. The position will be set to
+ // the correct value as soon as the first packet is decoded.
+ AudioStreamPos := SeekPos;
+ end
+ else
+ begin
+ // request avcodec buffer flush
+ PacketQueue.PutStatus(PKT_STATUS_FLAG_FLUSH, nil);
+ end;
+
+ // fill the gap between position 0 and start_time with silence
+ // but not if we are in loop mode
+ if ((StartSilence > 0) and (not Loop)) then
+ begin
+ GetMem(StartSilencePtr, SizeOf(StartSilence));
+ StartSilencePtr^ := StartSilence;
+ PacketQueue.PutStatus(PKT_STATUS_FLAG_EMPTY, StartSilencePtr);
+ end;
+ end;
+
+ SeekRequest := false;
+ SDL_CondBroadcast(SeekFinishedCond);
+ finally
+ SDL_mutexV(StateLock);
+ ResumeDecoder();
+ end;
+ end;
+
+ if (PacketQueue.GetSize() > MAX_AUDIOQ_SIZE) then
+ begin
+ SDL_Delay(10);
+ Continue;
+ end;
+
+ if (av_read_frame(FormatCtx, Packet) < 0) then
+ begin
+ // failed to read a frame, check reason
+ {$IF (LIBAVFORMAT_VERSION_MAJOR >= 52)}
+ ByteIOCtx := FormatCtx^.pb;
+ {$ELSE}
+ ByteIOCtx := @FormatCtx^.pb;
+ {$IFEND}
+
+ // check for end-of-file (eof is not an error)
+ if (url_feof(ByteIOCtx) <> 0) then
+ begin
+ if (GetLoop()) then
+ begin
+ // rewind stream (but do not flush)
+ SetPositionIntern(0, false, false);
+ Continue;
+ end
+ else
+ begin
+ // signal end-of-file
+ PacketQueue.PutStatus(PKT_STATUS_FLAG_EOF, nil);
+ Exit;
+ end;
+ end;
+
+ // check for errors
+ if (url_ferror(ByteIOCtx) <> 0) then
+ begin
+ // an error occured -> abort and wait for repositioning or termination
+ PacketQueue.PutStatus(PKT_STATUS_FLAG_ERROR, nil);
+ Exit;
+ end;
+
+ // no error -> wait for user input
+ SDL_Delay(100);
+ Continue;
+ end;
+
+ if (Packet.stream_index = AudioStreamIndex) then
+ PacketQueue.Put(@Packet)
+ else
+ av_free_packet(@Packet);
+
+ finally
+ UnlockParser();
+ end;
+ end;
+end;
+
+
+(********************************************
+ * Decoder section
+ ********************************************)
+
+procedure TFFmpegDecodeStream.PauseDecoder();
+begin
+ SDL_mutexP(StateLock);
+ Inc(DecoderPauseRequestCount);
+ while (DecoderLocked) do
+ SDL_CondWait(DecoderUnlockedCond, StateLock);
+ SDL_mutexV(StateLock);
+end;
+
+procedure TFFmpegDecodeStream.ResumeDecoder();
+begin
+ SDL_mutexP(StateLock);
+ Dec(DecoderPauseRequestCount);
+ SDL_CondSignal(DecoderResumeCond);
+ SDL_mutexV(StateLock);
+end;
+
+procedure TFFmpegDecodeStream.FlushCodecBuffers();
+begin
+ // if no flush operation is specified, avcodec_flush_buffers will not do anything.
+ if (@CodecCtx.codec.flush <> nil) then
+ begin
+ // flush buffers used by avcodec_decode_audio, etc.
+ avcodec_flush_buffers(CodecCtx);
+ end
+ else
+ begin
+ // we need a Workaround to avoid plopping noise with ogg-vorbis and
+ // mp3 (in older versions of FFmpeg).
+ // We will just reopen the codec.
+ FFmpegCore.LockAVCodec();
+ try
+ avcodec_close(CodecCtx);
+ avcodec_open(CodecCtx, Codec);
+ finally
+ FFmpegCore.UnlockAVCodec();
+ end;
+ end;
+end;
+
+function TFFmpegDecodeStream.DecodeFrame(Buffer: PChar; BufferSize: integer): integer;
+var
+ PaketDecodedSize: integer; // size of packet data used for decoding
+ DataSize: integer; // size of output data decoded by FFmpeg
+ BlockQueue: boolean;
+ SilenceDuration: double;
+ {$IFDEF DebugFFmpegDecode}
+ TmpPos: double;
+ {$ENDIF}
+begin
+ Result := -1;
+
+ if (EOF) then
+ Exit;
+
+ while(true) do
+ begin
+ // for titles with start_time > 0 we have to generate silence
+ // until we reach the pts of the first data packet.
+ if (AudioPaketSilence > 0) then
+ begin
+ DataSize := Min(AudioPaketSilence, BufferSize);
+ FillChar(Buffer[0], DataSize, 0);
+ Dec(AudioPaketSilence, DataSize);
+ AudioStreamPos := AudioStreamPos + DataSize / FormatInfo.BytesPerSec;
+ Result := DataSize;
+ Exit;
+ end;
+
+ // read packet data
+ while (AudioPaketSize > 0) do
+ begin
+ DataSize := BufferSize;
+
+ {$IF LIBAVCODEC_VERSION >= 51030000} // 51.30.0
+ PaketDecodedSize := avcodec_decode_audio2(CodecCtx, PSmallint(Buffer),
+ DataSize, AudioPaketData, AudioPaketSize);
+ {$ELSE}
+ PaketDecodedSize := avcodec_decode_audio(CodecCtx, PSmallint(Buffer),
+ DataSize, AudioPaketData, AudioPaketSize);
+ {$IFEND}
+
+ if(PaketDecodedSize < 0) then
+ begin
+ // if error, skip frame
+ {$IFDEF DebugFFmpegDecode}
+ DebugWriteln('Skip audio frame');
+ {$ENDIF}
+ AudioPaketSize := 0;
+ Break;
+ end;
+
+ Inc(AudioPaketData, PaketDecodedSize);
+ Dec(AudioPaketSize, PaketDecodedSize);
+
+ // check if avcodec_decode_audio returned data, otherwise fetch more frames
+ if (DataSize <= 0) then
+ Continue;
+
+ // update stream position by the amount of fetched data
+ AudioStreamPos := AudioStreamPos + DataSize / FormatInfo.BytesPerSec;
+
+ // we have data, return it and come back for more later
+ Result := DataSize;
+ Exit;
+ end;
+
+ // free old packet data
+ if (AudioPaket.data <> nil) then
+ av_free_packet(@AudioPaket);
+
+ // do not block queue on seeking (to avoid deadlocks on the DecoderLock)
+ if (IsSeeking()) then
+ BlockQueue := false
+ else
+ BlockQueue := true;
+
+ // request a new packet and block if none available.
+ // If this fails, the queue was aborted.
+ if (PacketQueue.Get(AudioPaket, BlockQueue) <= 0) then
+ Exit;
+
+ // handle Status-packet
+ if (PChar(AudioPaket.data) = STATUS_PACKET) then
+ begin
+ AudioPaket.data := nil;
+ AudioPaketData := nil;
+ AudioPaketSize := 0;
+
+ case (AudioPaket.flags) of
+ PKT_STATUS_FLAG_FLUSH:
+ begin
+ // just used if SetPositionIntern was called without the flush flag.
+ FlushCodecBuffers;
+ end;
+ PKT_STATUS_FLAG_EOF: // end-of-file
+ begin
+ // ignore EOF while seeking
+ if (not IsSeeking()) then
+ SetEOF(true);
+ // buffer contains no data -> result = -1
+ Exit;
+ end;
+ PKT_STATUS_FLAG_ERROR:
+ begin
+ SetError(true);
+ Log.LogStatus('I/O Error', 'TFFmpegDecodeStream.DecodeFrame');
+ Exit;
+ end;
+ PKT_STATUS_FLAG_EMPTY:
+ begin
+ SilenceDuration := PDouble(PacketQueue.GetStatusInfo(AudioPaket))^;
+ AudioPaketSilence := Round(SilenceDuration * FormatInfo.SampleRate) * FormatInfo.FrameSize;
+ PacketQueue.FreeStatusInfo(AudioPaket);
+ end
+ else
+ begin
+ Log.LogStatus('Unknown status', 'TFFmpegDecodeStream.DecodeFrame');
+ end;
+ end;
+
+ Continue;
+ end;
+
+ AudioPaketData := PChar(AudioPaket.data);
+ AudioPaketSize := AudioPaket.size;
+
+ // if available, update the stream position to the presentation time of this package
+ if(AudioPaket.pts <> AV_NOPTS_VALUE) then
+ begin
+ {$IFDEF DebugFFmpegDecode}
+ TmpPos := AudioStreamPos;
+ {$ENDIF}
+ AudioStreamPos := av_q2d(AudioStream^.time_base) * AudioPaket.pts;
+ {$IFDEF DebugFFmpegDecode}
+ DebugWriteln('Timestamp: ' + floattostrf(AudioStreamPos, ffFixed, 15, 3) + ' ' +
+ '(Calc: ' + floattostrf(TmpPos, ffFixed, 15, 3) + '), ' +
+ 'Diff: ' + floattostrf(AudioStreamPos-TmpPos, ffFixed, 15, 3));
+ {$ENDIF}
+ end;
+ end;
+end;
+
+function TFFmpegDecodeStream.ReadData(Buffer: PChar; BufferSize: integer): integer;
+var
+ CopyByteCount: integer; // number of bytes to copy
+ RemainByteCount: integer; // number of bytes left (remain) to read
+ BufferPos: integer;
+
+ // prioritize pause requests
+ procedure LockDecoder();
+ begin
+ SDL_mutexP(StateLock);
+ while (DecoderPauseRequestCount > 0) do
+ SDL_CondWait(DecoderResumeCond, StateLock);
+ DecoderLocked := true;
+ SDL_mutexV(StateLock);
+ end;
+
+ procedure UnlockDecoder();
+ begin
+ SDL_mutexP(StateLock);
+ DecoderLocked := false;
+ SDL_CondBroadcast(DecoderUnlockedCond);
+ SDL_mutexV(StateLock);
+ end;
+
+begin
+ Result := -1;
+
+ // set number of bytes to copy to the output buffer
+ BufferPos := 0;
+
+ LockDecoder();
+ try
+ // leave if end-of-file is reached
+ if (EOF) then
+ Exit;
+
+ // copy data to output buffer
+ while (BufferPos < BufferSize) do
+ begin
+ // check if we need more data
+ if (AudioBufferPos >= AudioBufferSize) then
+ begin
+ AudioBufferPos := 0;
+
+ // we have already sent all our data; get more
+ AudioBufferSize := DecodeFrame(AudioBuffer, AUDIO_BUFFER_SIZE);
+
+ // check for errors or EOF
+ if(AudioBufferSize < 0) then
+ begin
+ Result := BufferPos;
+ Exit;
+ end;
+ end;
+
+ // calc number of new bytes in the decode-buffer
+ CopyByteCount := AudioBufferSize - AudioBufferPos;
+ // resize copy-count if more bytes available than needed (remaining bytes are used the next time)
+ RemainByteCount := BufferSize - BufferPos;
+ if (CopyByteCount > RemainByteCount) then
+ CopyByteCount := RemainByteCount;
+
+ Move(AudioBuffer[AudioBufferPos], Buffer[BufferPos], CopyByteCount);
+
+ Inc(BufferPos, CopyByteCount);
+ Inc(AudioBufferPos, CopyByteCount);
+ end;
+ finally
+ UnlockDecoder();
+ end;
+
+ Result := BufferSize;
+end;
+
+
+{ TAudioDecoder_FFmpeg }
+
+function TAudioDecoder_FFmpeg.GetName: String;
+begin
+ Result := 'FFmpeg_Decoder';
+end;
+
+function TAudioDecoder_FFmpeg.InitializeDecoder: boolean;
+begin
+ //Log.LogStatus('InitializeDecoder', 'UAudioDecoder_FFmpeg');
+ FFmpegCore := TMediaCore_FFmpeg.GetInstance();
+ av_register_all();
+
+ // Do not show uninformative error messages by default.
+ // FFmpeg prints all error-infos on the console by default what
+ // is very confusing as the playback of the files is correct.
+ // We consider these errors to be internal to FFMpeg. They can be fixed
+ // by the FFmpeg guys only and do not provide any useful information in
+ // respect to USDX.
+ {$IFNDEF EnableFFmpegErrorOutput}
+ {$IF LIBAVUTIL_VERSION_MAJOR >= 50}
+ av_log_set_level(AV_LOG_FATAL);
+ {$ELSE}
+ // FATAL and ERROR share one log-level, so we have to use QUIET
+ av_log_set_level(AV_LOG_QUIET);
+ {$IFEND}
+ {$ENDIF}
+
+ Result := true;
+end;
+
+function TAudioDecoder_FFmpeg.FinalizeDecoder(): boolean;
+begin
+ Result := true;
+end;
+
+function TAudioDecoder_FFmpeg.Open(const Filename: string): TAudioDecodeStream;
+var
+ Stream: TFFmpegDecodeStream;
+begin
+ Result := nil;
+
+ Stream := TFFmpegDecodeStream.Create();
+ if (not Stream.Open(Filename)) then
+ begin
+ Stream.Free;
+ Exit;
+ end;
+
+ Result := Stream;
+end;
+
+
+initialization
+ MediaManager.Add(TAudioDecoder_FFmpeg.Create);
+
+end.
diff --git a/src/base/UAudioInput_Bass.pas b/src/base/UAudioInput_Bass.pas
new file mode 100644
index 00000000..65a4704d
--- /dev/null
+++ b/src/base/UAudioInput_Bass.pas
@@ -0,0 +1,481 @@
+unit UAudioInput_Bass;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+
+uses
+ Classes,
+ SysUtils,
+ URecord,
+ UMusic;
+
+implementation
+
+uses
+ UMain,
+ UIni,
+ ULog,
+ UAudioCore_Bass,
+ UCommon, // (Note: for MakeLong on non-windows platforms)
+ {$IFDEF MSWINDOWS}
+ Windows, // (Note: for MakeLong)
+ {$ENDIF}
+ bass; // (Note: DWORD is redefined here -> insert after Windows-unit)
+
+type
+ TAudioInput_Bass = class(TAudioInputBase)
+ private
+ function EnumDevices(): boolean;
+ public
+ function GetName: String; override;
+ function InitializeRecord: boolean; override;
+ function FinalizeRecord: boolean; override;
+ end;
+
+ TBassInputDevice = class(TAudioInputDevice)
+ private
+ RecordStream: HSTREAM;
+ BassDeviceID: DWORD; // DeviceID used by BASS
+ SingleIn: boolean;
+
+ function SetInputSource(SourceIndex: integer): boolean;
+ function GetInputSource(): integer;
+ public
+ function Open(): boolean;
+ function Close(): boolean;
+ function Start(): boolean; override;
+ function Stop(): boolean; override;
+
+ function GetVolume(): single; override;
+ procedure SetVolume(Volume: single); override;
+ end;
+
+var
+ BassCore: TAudioCore_Bass;
+
+
+{ Global }
+
+{*
+ * Bass input capture callback.
+ * Params:
+ * stream - BASS input stream
+ * buffer - buffer of captured samples
+ * len - size of buffer in bytes
+ * user - players associated with left/right channels
+ *}
+function MicrophoneCallback(stream: HSTREAM; buffer: Pointer;
+ len: Cardinal; inputDevice: Pointer): boolean; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
+begin
+ AudioInputProcessor.HandleMicrophoneData(buffer, len, inputDevice);
+ Result := true;
+end;
+
+
+{ TBassInputDevice }
+
+function TBassInputDevice.GetInputSource(): integer;
+var
+ SourceCnt: integer;
+ i: integer;
+ flags: DWORD;
+begin
+ // get input-source config (subtract virtual device to get BASS indices)
+ SourceCnt := Length(Source)-1;
+
+ // find source
+ Result := -1;
+ for i := 0 to SourceCnt-1 do
+ begin
+ // get input settings
+ flags := BASS_RecordGetInput(i, PSingle(nil)^);
+ if (flags = DWORD(-1)) then
+ begin
+ Log.LogError('BASS_RecordGetInput: ' + BassCore.ErrorGetString(), 'TBassInputDevice.GetInputSource');
+ Exit;
+ end;
+
+ // check if current source is selected
+ if ((flags and BASS_INPUT_OFF) = 0) then
+ begin
+ // selected source found
+ Result := i;
+ Exit;
+ end;
+ end;
+end;
+
+function TBassInputDevice.SetInputSource(SourceIndex: integer): boolean;
+var
+ SourceCnt: integer;
+ i: integer;
+ flags: DWORD;
+begin
+ Result := false;
+
+ // check for invalid source index
+ if (SourceIndex < 0) then
+ Exit;
+
+ // get input-source config (subtract virtual device to get BASS indices)
+ SourceCnt := Length(Source)-1;
+
+ // turn on selected source (turns off the others for single-in devices)
+ if (not BASS_RecordSetInput(SourceIndex, BASS_INPUT_ON, -1)) then
+ begin
+ Log.LogError('BASS_RecordSetInput: ' + BassCore.ErrorGetString(), 'TBassInputDevice.Start');
+ Exit;
+ end;
+
+ // turn off all other sources (not needed for single-in devices)
+ if (not SingleIn) then
+ begin
+ for i := 0 to SourceCnt-1 do
+ begin
+ if (i = SourceIndex) then
+ continue;
+ // get input settings
+ flags := BASS_RecordGetInput(i, PSingle(nil)^);
+ if (flags = DWORD(-1)) then
+ begin
+ Log.LogError('BASS_RecordGetInput: ' + BassCore.ErrorGetString(), 'TBassInputDevice.GetInputSource');
+ Exit;
+ end;
+ // deselect source if selected
+ if ((flags and BASS_INPUT_OFF) = 0) then
+ BASS_RecordSetInput(i, BASS_INPUT_OFF, -1);
+ end;
+ end;
+
+ Result := true;
+end;
+
+function TBassInputDevice.Open(): boolean;
+var
+ FormatFlags: DWORD;
+ SourceIndex: integer;
+const
+ latency = 20; // 20ms callback period (= latency)
+begin
+ Result := false;
+
+ if (not BASS_RecordInit(BassDeviceID)) then
+ begin
+ Log.LogError('BASS_RecordInit['+Name+']: ' +
+ BassCore.ErrorGetString(), 'TBassInputDevice.Open');
+ Exit;
+ end;
+
+ if (not BassCore.ConvertAudioFormatToBASSFlags(AudioFormat.Format, FormatFlags)) then
+ begin
+ Log.LogError('Unhandled sample-format', 'TBassInputDevice.Open');
+ Exit;
+ end;
+
+ // start capturing in paused state
+ RecordStream := BASS_RecordStart(Round(AudioFormat.SampleRate), AudioFormat.Channels,
+ MakeLong(FormatFlags or BASS_RECORD_PAUSE, latency),
+ @MicrophoneCallback, Self);
+ if (RecordStream = 0) then
+ begin
+ Log.LogError('BASS_RecordStart: ' + BassCore.ErrorGetString(), 'TBassInputDevice.Open');
+ BASS_RecordFree;
+ Exit;
+ end;
+
+ // save current source selection and select new source
+ SourceIndex := Ini.InputDeviceConfig[CfgIndex].Input-1;
+ if (SourceIndex = -1) then
+ begin
+ // nothing to do if default source is used
+ SourceRestore := -1;
+ end
+ else
+ begin
+ // store current source-index and select new source
+ SourceRestore := GetInputSource();
+ SetInputSource(SourceIndex);
+ end;
+
+ Result := true;
+end;
+
+{* Start input-capturing on this device. *}
+function TBassInputDevice.Start(): boolean;
+begin
+ Result := false;
+
+ // recording already started -> stop first
+ if (RecordStream <> 0) then
+ Stop();
+
+ // TODO: Do not open the device here (takes too much time).
+ if not Open() then
+ Exit;
+
+ if (not BASS_ChannelPlay(RecordStream, true)) then
+ begin
+ Log.LogError('BASS_ChannelPlay: ' + BassCore.ErrorGetString(), 'TBassInputDevice.Start');
+ Exit;
+ end;
+
+ Result := true;
+end;
+
+{* Stop input-capturing on this device. *}
+function TBassInputDevice.Stop(): boolean;
+begin
+ Result := false;
+
+ if (RecordStream = 0) then
+ Exit;
+ if (not BASS_RecordSetDevice(BassDeviceID)) then
+ Exit;
+
+ if (not BASS_ChannelStop(RecordStream)) then
+ begin
+ Log.LogError('BASS_ChannelStop: ' + BassCore.ErrorGetString(), 'TBassInputDevice.Stop');
+ end;
+
+ // TODO: Do not close the device here (takes too much time).
+ Result := Close();
+end;
+
+function TBassInputDevice.Close(): boolean;
+begin
+ // restore source selection
+ if (SourceRestore >= 0) then
+ begin
+ SetInputSource(SourceRestore);
+ end;
+
+ // free data
+ if (not BASS_RecordFree()) then
+ begin
+ Log.LogError('BASS_RecordFree: ' + BassCore.ErrorGetString(), 'TBassInputDevice.Close');
+ Result := false;
+ end
+ else
+ begin
+ Result := true;
+ end;
+
+ RecordStream := 0;
+end;
+
+function TBassInputDevice.GetVolume(): single;
+var
+ SourceIndex: integer;
+ lVolume: Single;
+begin
+ Result := 0;
+
+ SourceIndex := Ini.InputDeviceConfig[CfgIndex].Input-1;
+ if (SourceIndex = -1) then
+ begin
+ // if default source used find selected source
+ SourceIndex := GetInputSource();
+ if (SourceIndex = -1) then
+ Exit;
+ end;
+
+ if (BASS_RecordGetInput(SourceIndex, lVolume) = DWORD(-1)) then
+ begin
+ Log.LogError('BASS_RecordGetInput: ' + BassCore.ErrorGetString() , 'TBassInputDevice.GetVolume');
+ Exit;
+ end;
+ Result := lVolume;
+end;
+
+procedure TBassInputDevice.SetVolume(Volume: single);
+var
+ SourceIndex: integer;
+begin
+ SourceIndex := Ini.InputDeviceConfig[CfgIndex].Input-1;
+ if (SourceIndex = -1) then
+ begin
+ // if default source used find selected source
+ SourceIndex := GetInputSource();
+ if (SourceIndex = -1) then
+ Exit;
+ end;
+
+ // clip volume to valid range
+ if (Volume > 1.0) then
+ Volume := 1.0
+ else if (Volume < 0) then
+ Volume := 0;
+
+ if (not BASS_RecordSetInput(SourceIndex, 0, Volume)) then
+ begin
+ Log.LogError('BASS_RecordSetInput: ' + BassCore.ErrorGetString() , 'TBassInputDevice.SetVolume');
+ end;
+end;
+
+
+{ TAudioInput_Bass }
+
+function TAudioInput_Bass.GetName: String;
+begin
+ result := 'BASS_Input';
+end;
+
+function TAudioInput_Bass.EnumDevices(): boolean;
+var
+ Descr: PChar;
+ SourceName: PChar;
+ Flags: integer;
+ BassDeviceID: integer;
+ BassDevice: TBassInputDevice;
+ DeviceIndex: integer;
+ DeviceInfo: BASS_DEVICEINFO;
+ SourceIndex: integer;
+ RecordInfo: BASS_RECORDINFO;
+ SelectedSourceIndex: integer;
+begin
+ result := false;
+
+ DeviceIndex := 0;
+ BassDeviceID := 0;
+ SetLength(AudioInputProcessor.DeviceList, 0);
+
+ // checks for recording devices and puts them into an array
+ while true do
+ begin
+ if (not BASS_RecordGetDeviceInfo(BassDeviceID, DeviceInfo)) then
+ break;
+
+ // try to initialize the device
+ if not BASS_RecordInit(BassDeviceID) then
+ begin
+ Log.LogStatus('Failed to initialize BASS Capture-Device['+inttostr(BassDeviceID)+']',
+ 'TAudioInput_Bass.InitializeRecord');
+ end
+ else
+ begin
+ SetLength(AudioInputProcessor.DeviceList, DeviceIndex+1);
+
+ // TODO: free object on termination
+ BassDevice := TBassInputDevice.Create();
+ AudioInputProcessor.DeviceList[DeviceIndex] := BassDevice;
+
+ Descr := DeviceInfo.name;
+
+ BassDevice.BassDeviceID := BassDeviceID;
+ BassDevice.Name := UnifyDeviceName(Descr, DeviceIndex);
+
+ // zero info-struct as some fields might not be set (e.g. freq is just set on Vista and MacOSX)
+ FillChar(RecordInfo, SizeOf(RecordInfo), 0);
+ // retrieve recording device info
+ BASS_RecordGetInfo(RecordInfo);
+
+ // check if BASS has capture-freq. info
+ if (RecordInfo.freq > 0) then
+ begin
+ // use current input sample rate (available only on Windows Vista and OSX).
+ // Recording at this rate will give the best quality and performance, as no resampling is required.
+ // FIXME: does BASS use LSB/MSB or system integer values for 16bit?
+ BassDevice.AudioFormat := TAudioFormatInfo.Create(2, RecordInfo.freq, asfS16)
+ end
+ else
+ begin
+ // BASS does not provide an explizit input channel count (except BASS_RECORDINFO.formats)
+ // but it doesn't fail if we use stereo input on a mono device
+ // -> use stereo by default
+ BassDevice.AudioFormat := TAudioFormatInfo.Create(2, 44100, asfS16)
+ end;
+
+ // get info if multiple input-sources can be selected at once
+ BassDevice.SingleIn := RecordInfo.singlein;
+
+ // init list for capture buffers per channel
+ SetLength(BassDevice.CaptureChannel, BassDevice.AudioFormat.Channels);
+
+ BassDevice.MicSource := -1;
+ BassDevice.SourceRestore := -1;
+
+ // add a virtual default source (will not change mixer-settings)
+ SetLength(BassDevice.Source, 1);
+ BassDevice.Source[0].Name := DEFAULT_SOURCE_NAME;
+
+ // add real input sources
+ SourceIndex := 1;
+
+ // process each input
+ while true do
+ begin
+ SourceName := BASS_RecordGetInputName(SourceIndex-1);
+
+ {$IFDEF DARWIN}
+ // Under MacOSX the SingStar Mics have an empty InputName.
+ // So, we have to add a hard coded Workaround for this problem
+ // FIXME: - Do we need this anymore? Doesn't the (new) default source already solve this problem?
+ // - Normally a nil return value of BASS_RecordGetInputName() means end-of-list, so maybe
+ // BASS is not able to detect any mic-sources (the default source will work then).
+ // - Does BASS_RecordGetInfo() return true or false? If it returns true in this case
+ // we could use this value to check if the device exists.
+ // Please check that, eddie.
+ // If it returns false, then the source is not detected and it does not make sense to add a second
+ // fake device here.
+ // What about BASS_RecordGetInput()? Does it return a value <> -1?
+ // - Does it even work at all with this fake source-index, now that input switching works?
+ // This info was not used before (sources were never switched), so it did not matter what source-index was used.
+ // But now BASS_RecordSetInput() will probably fail.
+ if ((SourceName = nil) and (SourceIndex = 1) and (Pos('USBMIC Serial#', Descr) > 0)) then
+ SourceName := 'Microphone'
+ {$ENDIF}
+
+ if (SourceName = nil) then
+ break;
+
+ SetLength(BassDevice.Source, Length(BassDevice.Source)+1);
+ BassDevice.Source[SourceIndex].Name := SourceName;
+
+ // get input-source info
+ Flags := BASS_RecordGetInput(SourceIndex, PSingle(nil)^);
+ if (Flags <> -1) then
+ begin
+ // is the current source a mic-source?
+ if ((Flags and BASS_INPUT_TYPE_MIC) <> 0) then
+ BassDevice.MicSource := SourceIndex;
+ end;
+
+ Inc(SourceIndex);
+ end;
+
+ // FIXME: this call hangs in FPC (windows) every 2nd time USDX is called.
+ // Maybe because the sound-device was not released properly?
+ BASS_RecordFree;
+
+ Inc(DeviceIndex);
+ end;
+
+ Inc(BassDeviceID);
+ end;
+
+ result := true;
+end;
+
+function TAudioInput_Bass.InitializeRecord(): boolean;
+begin
+ BassCore := TAudioCore_Bass.GetInstance();
+ Result := EnumDevices();
+end;
+
+function TAudioInput_Bass.FinalizeRecord(): boolean;
+begin
+ CaptureStop;
+ Result := inherited FinalizeRecord;
+end;
+
+
+initialization
+ MediaManager.Add(TAudioInput_Bass.Create);
+
+end.
diff --git a/src/base/UAudioInput_Portaudio.pas b/src/base/UAudioInput_Portaudio.pas
new file mode 100644
index 00000000..9a1c3e99
--- /dev/null
+++ b/src/base/UAudioInput_Portaudio.pas
@@ -0,0 +1,474 @@
+unit UAudioInput_Portaudio;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I ../switches.inc}
+
+
+uses
+ Classes,
+ SysUtils,
+ UMusic;
+
+implementation
+
+uses
+ {$IFDEF UsePortmixer}
+ portmixer,
+ {$ENDIF}
+ portaudio,
+ UAudioCore_Portaudio,
+ URecord,
+ UIni,
+ ULog,
+ UMain;
+
+type
+ TAudioInput_Portaudio = class(TAudioInputBase)
+ private
+ AudioCore: TAudioCore_Portaudio;
+ function EnumDevices(): boolean;
+ public
+ function GetName: String; override;
+ function InitializeRecord: boolean; override;
+ function FinalizeRecord: boolean; override;
+ end;
+
+ TPortaudioInputDevice = class(TAudioInputDevice)
+ private
+ RecordStream: PPaStream;
+ {$IFDEF UsePortmixer}
+ Mixer: PPxMixer;
+ {$ENDIF}
+ PaDeviceIndex: TPaDeviceIndex;
+ public
+ function Open(): boolean;
+ function Close(): boolean;
+ function Start(): boolean; override;
+ function Stop(): boolean; override;
+
+ function GetVolume(): single; override;
+ procedure SetVolume(Volume: single); override;
+ end;
+
+function MicrophoneCallback(input: Pointer; output: Pointer; frameCount: Longword;
+ timeInfo: PPaStreamCallbackTimeInfo; statusFlags: TPaStreamCallbackFlags;
+ inputDevice: Pointer): Integer; cdecl; forward;
+
+function MicrophoneTestCallback(input: Pointer; output: Pointer; frameCount: Longword;
+ timeInfo: PPaStreamCallbackTimeInfo; statusFlags: TPaStreamCallbackFlags;
+ inputDevice: Pointer): Integer; cdecl; forward;
+
+
+{ TPortaudioInputDevice }
+
+function TPortaudioInputDevice.Open(): boolean;
+var
+ Error: TPaError;
+ inputParams: TPaStreamParameters;
+ deviceInfo: PPaDeviceInfo;
+ SourceIndex: integer;
+begin
+ Result := false;
+
+ // get input latency info
+ deviceInfo := Pa_GetDeviceInfo(PaDeviceIndex);
+
+ // set input stream parameters
+ with inputParams do
+ begin
+ device := PaDeviceIndex;
+ channelCount := AudioFormat.Channels;
+ sampleFormat := paInt16;
+ suggestedLatency := deviceInfo^.defaultLowInputLatency;
+ hostApiSpecificStreamInfo := nil;
+ end;
+
+ //Log.LogStatus(deviceInfo^.name, 'Portaudio');
+ //Log.LogStatus(floattostr(deviceInfo^.defaultLowInputLatency), 'Portaudio');
+
+ // open input stream
+ Error := Pa_OpenStream(RecordStream, @inputParams, nil,
+ AudioFormat.SampleRate,
+ paFramesPerBufferUnspecified, paNoFlag,
+ @MicrophoneCallback, Pointer(Self));
+ if(Error <> paNoError) then
+ begin
+ Log.LogError('Error opening stream: ' + Pa_GetErrorText(Error), 'TPortaudioInputDevice.Open');
+ Exit;
+ end;
+
+ {$IFDEF UsePortmixer}
+ // open default mixer
+ Mixer := Px_OpenMixer(RecordStream, 0);
+ if (Mixer = nil) then
+ begin
+ Log.LogError('Error opening mixer: ' + Pa_GetErrorText(Error), 'TPortaudioInputDevice.Open');
+ end
+ else
+ begin
+ // save current source selection and select new source
+ SourceIndex := Ini.InputDeviceConfig[CfgIndex].Input-1;
+ if (SourceIndex = -1) then
+ begin
+ // nothing to do if default source is used
+ SourceRestore := -1;
+ end
+ else
+ begin
+ // store current source-index and select new source
+ SourceRestore := Px_GetCurrentInputSource(Mixer); // -1 in error case
+ Px_SetCurrentInputSource(Mixer, SourceIndex);
+ end;
+ end;
+ {$ENDIF}
+
+ Result := true;
+end;
+
+function TPortaudioInputDevice.Start(): boolean;
+var
+ Error: TPaError;
+begin
+ Result := false;
+
+ // recording already started -> stop first
+ if (RecordStream <> nil) then
+ Stop();
+
+ // TODO: Do not open the device here (takes too much time).
+ if (not Open()) then
+ Exit;
+
+ // start capture
+ Error := Pa_StartStream(RecordStream);
+ if(Error <> paNoError) then
+ begin
+ Log.LogError('Error starting stream: ' + Pa_GetErrorText(Error), 'TPortaudioInputDevice.Start');
+ Close();
+ RecordStream := nil;
+ Exit;
+ end;
+
+ Result := true;
+end;
+
+function TPortaudioInputDevice.Stop(): boolean;
+var
+ Error: TPaError;
+begin
+ Result := false;
+
+ if (RecordStream = nil) then
+ Exit;
+
+ // Note: do NOT call Pa_StopStream here!
+ // It gets stuck on devices with non-working callback as Pa_StopStream
+ // waits until all buffers have been handled (which never occurs in that case).
+ Error := Pa_AbortStream(RecordStream);
+ if (Error <> paNoError) then
+ begin
+ Log.LogError('Pa_AbortStream: ' + Pa_GetErrorText(Error), 'TPortaudioInputDevice.Stop');
+ end;
+
+ Result := Close();
+end;
+
+function TPortaudioInputDevice.Close(): boolean;
+var
+ Error: TPaError;
+begin
+ {$IFDEF UsePortmixer}
+ if (Mixer <> nil) then
+ begin
+ // restore source selection
+ if (SourceRestore >= 0) then
+ begin
+ Px_SetCurrentInputSource(Mixer, SourceRestore);
+ end;
+
+ // close mixer
+ Px_CloseMixer(Mixer);
+ Mixer := nil;
+ end;
+ {$ENDIF}
+
+ Error := Pa_CloseStream(RecordStream);
+ if (Error <> paNoError) then
+ begin
+ Log.LogError('Pa_CloseStream: ' + Pa_GetErrorText(Error), 'TPortaudioInputDevice.Close');
+ Result := false;
+ end
+ else
+ begin
+ Result := true;
+ end;
+
+ RecordStream := nil;
+end;
+
+function TPortaudioInputDevice.GetVolume(): single;
+begin
+ Result := 0;
+ {$IFDEF UsePortmixer}
+ if (Mixer <> nil) then
+ Result := Px_GetInputVolume(Mixer);
+ {$ENDIF}
+end;
+
+procedure TPortaudioInputDevice.SetVolume(Volume: single);
+begin
+ {$IFDEF UsePortmixer}
+ if (Mixer <> nil) then
+ begin
+ // clip to valid range
+ if (Volume > 1.0) then
+ Volume := 1.0
+ else if (Volume < 0) then
+ Volume := 0;
+ Px_SetInputVolume(Mixer, Volume);
+ end;
+ {$ENDIF}
+end;
+
+
+{ TAudioInput_Portaudio }
+
+function TAudioInput_Portaudio.GetName: String;
+begin
+ result := 'Portaudio';
+end;
+
+function TAudioInput_Portaudio.EnumDevices(): boolean;
+var
+ i: integer;
+ paApiIndex: TPaHostApiIndex;
+ paApiInfo: PPaHostApiInfo;
+ deviceName: string;
+ deviceIndex: TPaDeviceIndex;
+ deviceInfo: PPaDeviceInfo;
+ channelCnt: integer;
+ SC: integer; // soundcard
+ err: TPaError;
+ errMsg: string;
+ paDevice: TPortaudioInputDevice;
+ inputParams: TPaStreamParameters;
+ stream: PPaStream;
+ streamInfo: PPaStreamInfo;
+ sampleRate: double;
+ latency: TPaTime;
+ {$IFDEF UsePortmixer}
+ mixer: PPxMixer;
+ sourceCnt: integer;
+ sourceIndex: integer;
+ sourceName: string;
+ {$ENDIF}
+ cbPolls: integer;
+ cbWorks: boolean;
+begin
+ Result := false;
+
+ // choose the best available Audio-API
+ paApiIndex := AudioCore.GetPreferredApiIndex();
+ if(paApiIndex = -1) then
+ begin
+ Log.LogError('No working Audio-API found', 'TAudioInput_Portaudio.EnumDevices');
+ Exit;
+ end;
+
+ paApiInfo := Pa_GetHostApiInfo(paApiIndex);
+
+ SC := 0;
+
+ // init array-size to max. input-devices count
+ SetLength(AudioInputProcessor.DeviceList, paApiInfo^.deviceCount);
+ for i:= 0 to High(AudioInputProcessor.DeviceList) do
+ begin
+ // convert API-specific device-index to global index
+ deviceIndex := Pa_HostApiDeviceIndexToDeviceIndex(paApiIndex, i);
+ deviceInfo := Pa_GetDeviceInfo(deviceIndex);
+
+ channelCnt := deviceInfo^.maxInputChannels;
+
+ // current device is no input device -> skip
+ if (channelCnt <= 0) then
+ continue;
+
+ // portaudio returns a channel-count of 128 for some devices
+ // (e.g. the "default"-device), so we have to detect those
+ // fantasy channel counts.
+ if (channelCnt > 8) then
+ channelCnt := 2;
+
+ paDevice := TPortaudioInputDevice.Create();
+ AudioInputProcessor.DeviceList[SC] := paDevice;
+
+ // retrieve device-name
+ deviceName := deviceInfo^.name;
+ paDevice.Name := deviceName;
+ paDevice.PaDeviceIndex := deviceIndex;
+
+ sampleRate := deviceInfo^.defaultSampleRate;
+
+ // on vista and xp the defaultLowInputLatency may be set to 0 but it works.
+ // TODO: correct too low latencies (what is a too low latency, maybe < 10ms?)
+ latency := deviceInfo^.defaultLowInputLatency;
+
+ // setup desired input parameters
+ // TODO: retry with input-latency set to 20ms (defaultLowInputLatency might
+ // not be set correctly in OSS)
+ with inputParams do
+ begin
+ device := deviceIndex;
+ channelCount := channelCnt;
+ sampleFormat := paInt16;
+ suggestedLatency := latency;
+ hostApiSpecificStreamInfo := nil;
+ end;
+
+ // check souncard and adjust sample-rate
+ if (not AudioCore.TestDevice(@inputParams, nil, sampleRate)) then
+ begin
+ // ignore device if it does not work
+ Log.LogError('Device "'+paDevice.Name+'" does not work',
+ 'TAudioInput_Portaudio.EnumDevices');
+ paDevice.Free();
+ continue;
+ end;
+
+ // open device for further info
+ err := Pa_OpenStream(stream, @inputParams, nil, sampleRate,
+ paFramesPerBufferUnspecified, paNoFlag, @MicrophoneTestCallback, nil);
+ if(err <> paNoError) then
+ begin
+ // unable to open device -> skip
+ errMsg := Pa_GetErrorText(err);
+ Log.LogError('Device error: "'+ deviceName +'" ('+ errMsg +')',
+ 'TAudioInput_Portaudio.EnumDevices');
+ paDevice.Free();
+ continue;
+ end;
+
+ // adjust sample-rate (might be changed by portaudio)
+ streamInfo := Pa_GetStreamInfo(stream);
+ if (streamInfo <> nil) then
+ begin
+ if (sampleRate <> streamInfo^.sampleRate) then
+ begin
+ Log.LogStatus('Portaudio changed Samplerate from ' + FloatToStr(sampleRate) +
+ ' to ' + FloatToStr(streamInfo^.sampleRate),
+ 'TAudioInput_Portaudio.InitializeRecord');
+ sampleRate := streamInfo^.sampleRate;
+ end;
+ end;
+
+ // create audio-format info and resize capture-buffer array
+ paDevice.AudioFormat := TAudioFormatInfo.Create(
+ channelCnt,
+ sampleRate,
+ asfS16
+ );
+ SetLength(paDevice.CaptureChannel, paDevice.AudioFormat.Channels);
+
+ Log.LogStatus('InputDevice "'+paDevice.Name+'"@' +
+ IntToStr(paDevice.AudioFormat.Channels)+'x'+
+ FloatToStr(paDevice.AudioFormat.SampleRate)+'Hz ('+
+ FloatTostr(inputParams.suggestedLatency)+'sec)' ,
+ 'Portaudio.EnumDevices');
+
+ // portaudio does not provide a source-type check
+ paDevice.MicSource := -1;
+ paDevice.SourceRestore := -1;
+
+ // add a virtual default source (will not change mixer-settings)
+ SetLength(paDevice.Source, 1);
+ paDevice.Source[0].Name := DEFAULT_SOURCE_NAME;
+
+ {$IFDEF UsePortmixer}
+ // use default mixer
+ mixer := Px_OpenMixer(stream, 0);
+
+ // get input count
+ sourceCnt := Px_GetNumInputSources(mixer);
+ SetLength(paDevice.Source, sourceCnt+1);
+
+ // get input names
+ for sourceIndex := 1 to sourceCnt do
+ begin
+ sourceName := Px_GetInputSourceName(mixer, sourceIndex-1);
+ paDevice.Source[sourceIndex].Name := sourceName;
+ end;
+
+ Px_CloseMixer(mixer);
+ {$ENDIF}
+
+ // close test-stream
+ Pa_CloseStream(stream);
+
+ Inc(SC);
+ end;
+
+ // adjust size to actual input-device count
+ SetLength(AudioInputProcessor.DeviceList, SC);
+
+ Log.LogStatus('#Input-Devices: ' + inttostr(SC), 'Portaudio');
+
+ Result := true;
+end;
+
+function TAudioInput_Portaudio.InitializeRecord(): boolean;
+var
+ err: TPaError;
+begin
+ AudioCore := TAudioCore_Portaudio.GetInstance();
+
+ // initialize portaudio
+ err := Pa_Initialize();
+ if(err <> paNoError) then
+ begin
+ Log.LogError(Pa_GetErrorText(err), 'TAudioInput_Portaudio.InitializeRecord');
+ Result := false;
+ Exit;
+ end;
+
+ Result := EnumDevices();
+end;
+
+function TAudioInput_Portaudio.FinalizeRecord: boolean;
+begin
+ CaptureStop;
+ Pa_Terminate();
+ Result := inherited FinalizeRecord();
+end;
+
+{*
+ * Portaudio input capture callback.
+ *}
+function MicrophoneCallback(input: Pointer; output: Pointer; frameCount: Longword;
+ timeInfo: PPaStreamCallbackTimeInfo; statusFlags: TPaStreamCallbackFlags;
+ inputDevice: Pointer): Integer; cdecl;
+begin
+ AudioInputProcessor.HandleMicrophoneData(input, frameCount*4, inputDevice);
+ result := paContinue;
+end;
+
+{*
+ * Portaudio test capture callback.
+ *}
+function MicrophoneTestCallback(input: Pointer; output: Pointer; frameCount: Longword;
+ timeInfo: PPaStreamCallbackTimeInfo; statusFlags: TPaStreamCallbackFlags;
+ inputDevice: Pointer): Integer; cdecl;
+begin
+ // this callback is called only once
+ result := paAbort;
+end;
+
+
+initialization
+ MediaManager.add(TAudioInput_Portaudio.Create);
+
+end.
diff --git a/src/base/UAudioPlaybackBase.pas b/src/base/UAudioPlaybackBase.pas
new file mode 100644
index 00000000..2337d43f
--- /dev/null
+++ b/src/base/UAudioPlaybackBase.pas
@@ -0,0 +1,292 @@
+unit UAudioPlaybackBase;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+uses
+ UMusic;
+
+type
+ TAudioPlaybackBase = class(TInterfacedObject, IAudioPlayback)
+ protected
+ OutputDeviceList: TAudioOutputDeviceList;
+ MusicStream: TAudioPlaybackStream;
+ function CreatePlaybackStream(): TAudioPlaybackStream; virtual; abstract;
+ procedure ClearOutputDeviceList();
+ function GetLatency(): double; virtual; abstract;
+
+ // open sound or music stream (used by Open() and OpenSound())
+ function OpenStream(const Filename: string): TAudioPlaybackStream;
+ function OpenDecodeStream(const Filename: string): TAudioDecodeStream;
+ public
+ function GetName: string; virtual; abstract;
+
+ function Open(const Filename: string): boolean; // true if succeed
+ procedure Close;
+
+ procedure Play;
+ procedure Pause;
+ procedure Stop;
+ procedure FadeIn(Time: real; TargetVolume: single);
+
+ procedure SetSyncSource(SyncSource: TSyncSource);
+
+ procedure SetPosition(Time: real);
+ function GetPosition: real;
+
+ function InitializePlayback: boolean; virtual; abstract;
+ function FinalizePlayback: boolean; virtual;
+
+ //function SetOutputDevice(Device: TAudioOutputDevice): boolean;
+ function GetOutputDeviceList(): TAudioOutputDeviceList;
+
+ procedure SetAppVolume(Volume: single); virtual; abstract;
+ procedure SetVolume(Volume: single);
+ procedure SetLoop(Enabled: boolean);
+
+ procedure Rewind;
+ function Finished: boolean;
+ function Length: real;
+
+ // Sounds
+ function OpenSound(const Filename: string): TAudioPlaybackStream;
+ procedure PlaySound(Stream: TAudioPlaybackStream);
+ procedure StopSound(Stream: TAudioPlaybackStream);
+
+ // Equalizer
+ procedure GetFFTData(var Data: TFFTData);
+
+ // Interface for Visualizer
+ function GetPCMData(var Data: TPCMData): Cardinal;
+
+ function CreateVoiceStream(Channel: integer; FormatInfo: TAudioFormatInfo): TAudioVoiceStream; virtual; abstract;
+ end;
+
+
+implementation
+
+uses
+ ULog,
+ SysUtils;
+
+{ TAudioPlaybackBase }
+
+function TAudioPlaybackBase.FinalizePlayback: boolean;
+begin
+ FreeAndNil(MusicStream);
+ ClearOutputDeviceList();
+ Result := true;
+end;
+
+function TAudioPlaybackBase.Open(const Filename: string): boolean;
+begin
+ // free old MusicStream
+ MusicStream.Free;
+
+ MusicStream := OpenStream(Filename);
+ if not assigned(MusicStream) then
+ begin
+ Result := false;
+ Exit;
+ end;
+
+ //MusicStream.AddSoundEffect(TVoiceRemoval.Create());
+
+ Result := true;
+end;
+
+procedure TAudioPlaybackBase.Close;
+begin
+ FreeAndNil(MusicStream);
+end;
+
+function TAudioPlaybackBase.OpenDecodeStream(const Filename: String): TAudioDecodeStream;
+var
+ i: integer;
+begin
+ for i := 0 to AudioDecoders.Count-1 do
+ begin
+ Result := IAudioDecoder(AudioDecoders[i]).Open(Filename);
+ if (assigned(Result)) then
+ begin
+ Log.LogInfo('Using decoder ' + IAudioDecoder(AudioDecoders[i]).GetName() +
+ ' for "' + Filename + '"', 'TAudioPlaybackBase.OpenDecodeStream');
+ Exit;
+ end;
+ end;
+ Result := nil;
+end;
+
+procedure OnClosePlaybackStream(Stream: TAudioProcessingStream);
+var
+ PlaybackStream: TAudioPlaybackStream;
+ SourceStream: TAudioSourceStream;
+begin
+ PlaybackStream := TAudioPlaybackStream(Stream);
+ SourceStream := PlaybackStream.GetSourceStream();
+ SourceStream.Free;
+end;
+
+function TAudioPlaybackBase.OpenStream(const Filename: string): TAudioPlaybackStream;
+var
+ PlaybackStream: TAudioPlaybackStream;
+ DecodeStream: TAudioDecodeStream;
+begin
+ Result := nil;
+
+ //Log.LogStatus('Loading Sound: "' + Filename + '"', 'TAudioPlayback_Bass.OpenStream');
+
+ DecodeStream := OpenDecodeStream(Filename);
+ if (not assigned(DecodeStream)) then
+ begin
+ Log.LogStatus('Could not open "' + Filename + '"', 'TAudioPlayback_Bass.OpenStream');
+ Exit;
+ end;
+
+ // create a matching playback-stream for the decoder
+ PlaybackStream := CreatePlaybackStream();
+ if (not PlaybackStream.Open(DecodeStream)) then
+ begin
+ FreeAndNil(PlaybackStream);
+ FreeAndNil(DecodeStream);
+ Exit;
+ end;
+
+ PlaybackStream.AddOnCloseHandler(OnClosePlaybackStream);
+
+ Result := PlaybackStream;
+end;
+
+procedure TAudioPlaybackBase.Play;
+begin
+ if assigned(MusicStream) then
+ MusicStream.Play();
+end;
+
+procedure TAudioPlaybackBase.Pause;
+begin
+ if assigned(MusicStream) then
+ MusicStream.Pause();
+end;
+
+procedure TAudioPlaybackBase.Stop;
+begin
+ if assigned(MusicStream) then
+ MusicStream.Stop();
+end;
+
+function TAudioPlaybackBase.Length: real;
+begin
+ if assigned(MusicStream) then
+ Result := MusicStream.Length
+ else
+ Result := 0;
+end;
+
+function TAudioPlaybackBase.GetPosition: real;
+begin
+ if assigned(MusicStream) then
+ Result := MusicStream.Position
+ else
+ Result := 0;
+end;
+
+procedure TAudioPlaybackBase.SetPosition(Time: real);
+begin
+ if assigned(MusicStream) then
+ MusicStream.Position := Time;
+end;
+
+procedure TAudioPlaybackBase.SetSyncSource(SyncSource: TSyncSource);
+begin
+ if assigned(MusicStream) then
+ MusicStream.SetSyncSource(SyncSource);
+end;
+
+procedure TAudioPlaybackBase.Rewind;
+begin
+ SetPosition(0);
+end;
+
+function TAudioPlaybackBase.Finished: boolean;
+begin
+ if assigned(MusicStream) then
+ Result := (MusicStream.Status = ssStopped)
+ else
+ Result := true;
+end;
+
+procedure TAudioPlaybackBase.SetVolume(Volume: single);
+begin
+ if assigned(MusicStream) then
+ MusicStream.Volume := Volume;
+end;
+
+procedure TAudioPlaybackBase.FadeIn(Time: real; TargetVolume: single);
+begin
+ if assigned(MusicStream) then
+ MusicStream.FadeIn(Time, TargetVolume);
+end;
+
+procedure TAudioPlaybackBase.SetLoop(Enabled: boolean);
+begin
+ if assigned(MusicStream) then
+ MusicStream.Loop := Enabled;
+end;
+
+// Equalizer
+procedure TAudioPlaybackBase.GetFFTData(var data: TFFTData);
+begin
+ if assigned(MusicStream) then
+ MusicStream.GetFFTData(data);
+end;
+
+{*
+ * Copies interleaved PCM SInt16 stereo samples into data.
+ * Returns the number of frames
+ *}
+function TAudioPlaybackBase.GetPCMData(var data: TPCMData): Cardinal;
+begin
+ if assigned(MusicStream) then
+ Result := MusicStream.GetPCMData(data)
+ else
+ Result := 0;
+end;
+
+function TAudioPlaybackBase.OpenSound(const Filename: string): TAudioPlaybackStream;
+begin
+ Result := OpenStream(Filename);
+end;
+
+procedure TAudioPlaybackBase.PlaySound(stream: TAudioPlaybackStream);
+begin
+ if assigned(stream) then
+ stream.Play();
+end;
+
+procedure TAudioPlaybackBase.StopSound(stream: TAudioPlaybackStream);
+begin
+ if assigned(stream) then
+ stream.Stop();
+end;
+
+procedure TAudioPlaybackBase.ClearOutputDeviceList();
+var
+ DeviceIndex: integer;
+begin
+ for DeviceIndex := 0 to High(OutputDeviceList) do
+ OutputDeviceList[DeviceIndex].Free();
+ SetLength(OutputDeviceList, 0);
+end;
+
+function TAudioPlaybackBase.GetOutputDeviceList(): TAudioOutputDeviceList;
+begin
+ Result := OutputDeviceList;
+end;
+
+end.
diff --git a/src/base/UAudioPlayback_Bass.pas b/src/base/UAudioPlayback_Bass.pas
new file mode 100644
index 00000000..41a91173
--- /dev/null
+++ b/src/base/UAudioPlayback_Bass.pas
@@ -0,0 +1,731 @@
+unit UAudioPlayback_Bass;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+implementation
+
+uses
+ Classes,
+ SysUtils,
+ Math,
+ UIni,
+ UMain,
+ UMusic,
+ UAudioPlaybackBase,
+ UAudioCore_Bass,
+ ULog,
+ sdl,
+ bass;
+
+type
+ PHDSP = ^HDSP;
+
+type
+ TBassPlaybackStream = class(TAudioPlaybackStream)
+ private
+ Handle: HSTREAM;
+ NeedsRewind: boolean;
+ PausedSeek: boolean; // true if a seek was performed in pause state
+
+ procedure Reset();
+ function IsEOF(): boolean;
+ protected
+ function GetLatency(): double; override;
+ function GetLoop(): boolean; override;
+ procedure SetLoop(Enabled: boolean); override;
+ function GetLength(): real; override;
+ function GetStatus(): TStreamStatus; override;
+ function GetVolume(): single; override;
+ procedure SetVolume(Volume: single); override;
+ function GetPosition: real; override;
+ procedure SetPosition(Time: real); override;
+ public
+ constructor Create();
+ destructor Destroy(); override;
+
+ function Open(SourceStream: TAudioSourceStream): boolean; override;
+ procedure Close(); override;
+
+ procedure Play(); override;
+ procedure Pause(); override;
+ procedure Stop(); override;
+ procedure FadeIn(Time: real; TargetVolume: single); override;
+
+ procedure AddSoundEffect(Effect: TSoundEffect); override;
+ procedure RemoveSoundEffect(Effect: TSoundEffect); override;
+
+ procedure GetFFTData(var Data: TFFTData); override;
+ function GetPCMData(var Data: TPCMData): Cardinal; override;
+
+ function GetAudioFormatInfo(): TAudioFormatInfo; override;
+
+ function ReadData(Buffer: PChar; BufferSize: integer): integer;
+
+ property EOF: boolean READ IsEOF;
+ end;
+
+const
+ MAX_VOICE_DELAY = 0.020; // 20ms
+
+type
+ TBassVoiceStream = class(TAudioVoiceStream)
+ private
+ Handle: HSTREAM;
+ public
+ function Open(ChannelMap: integer; FormatInfo: TAudioFormatInfo): boolean; override;
+ procedure Close(); override;
+
+ procedure WriteData(Buffer: PChar; BufferSize: integer); override;
+ function ReadData(Buffer: PChar; BufferSize: integer): integer; override;
+ function IsEOF(): boolean; override;
+ function IsError(): boolean; override;
+ end;
+
+type
+ TAudioPlayback_Bass = class(TAudioPlaybackBase)
+ private
+ function EnumDevices(): boolean;
+ protected
+ function GetLatency(): double; override;
+ function CreatePlaybackStream(): TAudioPlaybackStream; override;
+ public
+ function GetName: String; override;
+ function InitializePlayback(): boolean; override;
+ function FinalizePlayback: boolean; override;
+ procedure SetAppVolume(Volume: single); override;
+ function CreateVoiceStream(ChannelMap: integer; FormatInfo: TAudioFormatInfo): TAudioVoiceStream; override;
+ end;
+
+ TBassOutputDevice = class(TAudioOutputDevice)
+ private
+ BassDeviceID: DWORD; // DeviceID used by BASS
+ end;
+
+var
+ BassCore: TAudioCore_Bass;
+
+
+{ TBassPlaybackStream }
+
+function PlaybackStreamHandler(handle: HSTREAM; buffer: Pointer; length: DWORD; user: Pointer): DWORD;
+{$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
+var
+ PlaybackStream: TBassPlaybackStream;
+ BytesRead: integer;
+begin
+ PlaybackStream := TBassPlaybackStream(user);
+ if (not assigned (PlaybackStream)) then
+ begin
+ Result := BASS_STREAMPROC_END;
+ Exit;
+ end;
+
+ BytesRead := PlaybackStream.ReadData(buffer, length);
+ // check for errors
+ if (BytesRead < 0) then
+ Result := BASS_STREAMPROC_END
+ // check for EOF
+ else if (PlaybackStream.EOF) then
+ Result := BytesRead or BASS_STREAMPROC_END
+ // no error/EOF
+ else
+ Result := BytesRead;
+end;
+
+function TBassPlaybackStream.ReadData(Buffer: PChar; BufferSize: integer): integer;
+var
+ AdjustedSize: integer;
+ RequestedSourceSize, SourceSize: integer;
+ SkipCount: integer;
+ SourceFormatInfo: TAudioFormatInfo;
+ FrameSize: integer;
+ PadFrame: PChar;
+ //Info: BASS_INFO;
+ //Latency: double;
+begin
+ Result := -1;
+
+ if (not assigned(SourceStream)) then
+ Exit;
+
+ // sanity check
+ if (BufferSize = 0) then
+ begin
+ Result := 0;
+ Exit;
+ end;
+
+ SourceFormatInfo := SourceStream.GetAudioFormatInfo();
+ FrameSize := SourceFormatInfo.FrameSize;
+
+ // check how much data to fetch to be in synch
+ AdjustedSize := Synchronize(BufferSize, SourceFormatInfo);
+
+ // skip data if we are too far behind
+ SkipCount := AdjustedSize - BufferSize;
+ while (SkipCount > 0) do
+ begin
+ RequestedSourceSize := Min(SkipCount, BufferSize);
+ SourceSize := SourceStream.ReadData(Buffer, RequestedSourceSize);
+ // if an error or EOF occured stop skipping and handle error/EOF with the next ReadData()
+ if (SourceSize <= 0) then
+ break;
+ Dec(SkipCount, SourceSize);
+ end;
+
+ // get source data (e.g. from a decoder)
+ RequestedSourceSize := Min(AdjustedSize, BufferSize);
+ SourceSize := SourceStream.ReadData(Buffer, RequestedSourceSize);
+ if (SourceSize < 0) then
+ Exit;
+
+ // set preliminary result
+ Result := SourceSize;
+
+ // if we are to far ahead, fill output-buffer with last frame of source data
+ // Note that AdjustedSize is used instead of SourceSize as the SourceSize might
+ // be less than expected because of errors etc.
+ if (AdjustedSize < BufferSize) then
+ begin
+ // use either the last frame for padding or fill with zero
+ if (SourceSize >= FrameSize) then
+ PadFrame := @Buffer[SourceSize-FrameSize]
+ else
+ PadFrame := nil;
+
+ FillBufferWithFrame(@Buffer[SourceSize], BufferSize - SourceSize,
+ PadFrame, FrameSize);
+ Result := BufferSize;
+ end;
+end;
+
+constructor TBassPlaybackStream.Create();
+begin
+ inherited;
+ Reset();
+end;
+
+destructor TBassPlaybackStream.Destroy();
+begin
+ Close();
+ inherited;
+end;
+
+function TBassPlaybackStream.Open(SourceStream: TAudioSourceStream): boolean;
+var
+ FormatInfo: TAudioFormatInfo;
+ FormatFlags: DWORD;
+begin
+ Result := false;
+
+ // close previous stream and reset state
+ Reset();
+
+ // sanity check if stream is valid
+ if not assigned(SourceStream) then
+ Exit;
+
+ Self.SourceStream := SourceStream;
+ FormatInfo := SourceStream.GetAudioFormatInfo();
+ if (not BassCore.ConvertAudioFormatToBASSFlags(FormatInfo.Format, FormatFlags)) then
+ begin
+ Log.LogError('Unhandled sample-format', 'TBassPlaybackStream.Open');
+ Exit;
+ end;
+
+ // create matching playback stream
+ Handle := BASS_StreamCreate(Round(FormatInfo.SampleRate), FormatInfo.Channels, formatFlags,
+ @PlaybackStreamHandler, Self);
+ if (Handle = 0) then
+ begin
+ Log.LogError('BASS_StreamCreate failed: ' + BassCore.ErrorGetString(BASS_ErrorGetCode()),
+ 'TBassPlaybackStream.Open');
+ Exit;
+ end;
+
+ Result := true;
+end;
+
+procedure TBassPlaybackStream.Close();
+begin
+ // stop and free stream
+ if (Handle <> 0) then
+ begin
+ Bass_StreamFree(Handle);
+ Handle := 0;
+ end;
+
+ // Note: PerformOnClose must be called before SourceStream is invalidated
+ PerformOnClose();
+ // unset source-stream
+ SourceStream := nil;
+end;
+
+procedure TBassPlaybackStream.Reset();
+begin
+ Close();
+ NeedsRewind := false;
+ PausedSeek := false;
+end;
+
+procedure TBassPlaybackStream.Play();
+var
+ NeedsFlush: boolean;
+begin
+ if (not assigned(SourceStream)) then
+ Exit;
+
+ NeedsFlush := true;
+
+ if (BASS_ChannelIsActive(Handle) = BASS_ACTIVE_PAUSED) then
+ begin
+ // only paused (and not seeked while paused) streams are not flushed
+ if (not PausedSeek) then
+ NeedsFlush := false;
+ // paused streams do not need a rewind
+ NeedsRewind := false;
+ end;
+
+ // rewind if necessary. Cases that require no rewind are:
+ // - stream was created and never played
+ // - stream was paused and is resumed now
+ // - stream was stopped and set to a new position already
+ if (NeedsRewind) then
+ SourceStream.Position := 0;
+
+ NeedsRewind := true;
+ PausedSeek := false;
+
+ // start playing and flush buffers on rewind
+ BASS_ChannelPlay(Handle, NeedsFlush);
+end;
+
+procedure TBassPlaybackStream.FadeIn(Time: real; TargetVolume: single);
+begin
+ // start stream
+ Play();
+ // start fade-in: slide from fadeStart- to fadeEnd-volume in FadeInTime
+ BASS_ChannelSlideAttribute(Handle, BASS_ATTRIB_VOL, TargetVolume, Trunc(Time * 1000));
+end;
+
+procedure TBassPlaybackStream.Pause();
+begin
+ BASS_ChannelPause(Handle);
+end;
+
+procedure TBassPlaybackStream.Stop();
+begin
+ BASS_ChannelStop(Handle);
+end;
+
+function TBassPlaybackStream.IsEOF(): boolean;
+begin
+ if (assigned(SourceStream)) then
+ Result := SourceStream.EOF
+ else
+ Result := true;
+end;
+
+function TBassPlaybackStream.GetLatency(): double;
+begin
+ // TODO: should we consider output latency for synching (needs BASS_DEVICE_LATENCY)?
+ //if (BASS_GetInfo(Info)) then
+ // Latency := Info.latency / 1000
+ //else
+ // Latency := 0;
+ Result := 0;
+end;
+
+function TBassPlaybackStream.GetVolume(): single;
+var
+ lVolume: single;
+begin
+ if (not BASS_ChannelGetAttribute(Handle, BASS_ATTRIB_VOL, lVolume)) then
+ begin
+ Log.LogError('BASS_ChannelGetAttribute: ' + BassCore.ErrorGetString(),
+ 'TBassPlaybackStream.GetVolume');
+ Result := 0;
+ Exit;
+ end;
+ Result := Round(lVolume);
+end;
+
+procedure TBassPlaybackStream.SetVolume(Volume: single);
+begin
+ // clamp volume
+ if Volume < 0 then
+ Volume := 0;
+ if Volume > 1.0 then
+ Volume := 1.0;
+ // set volume
+ BASS_ChannelSetAttribute(Handle, BASS_ATTRIB_VOL, Volume);
+end;
+
+function TBassPlaybackStream.GetPosition: real;
+var
+ BufferPosByte: QWORD;
+ BufferPosSec: double;
+begin
+ if assigned(SourceStream) then
+ begin
+ BufferPosByte := BASS_ChannelGetData(Handle, nil, BASS_DATA_AVAILABLE);
+ BufferPosSec := BASS_ChannelBytes2Seconds(Handle, BufferPosByte);
+ // decrease the decoding position by the amount buffered (and hence not played)
+ // in the BASS playback stream.
+ Result := SourceStream.Position - BufferPosSec;
+ end
+ else
+ begin
+ Result := -1;
+ end;
+end;
+
+procedure TBassPlaybackStream.SetPosition(Time: real);
+var
+ ChannelState: DWORD;
+begin
+ if assigned(SourceStream) then
+ begin
+ ChannelState := BASS_ChannelIsActive(Handle);
+ if (ChannelState = BASS_ACTIVE_STOPPED) then
+ begin
+ // if the stream is stopped, do not rewind when the stream is played next time
+ NeedsRewind := false
+ end
+ else if (ChannelState = BASS_ACTIVE_PAUSED) then
+ begin
+ // buffers must be flushed if in paused state but there is no
+ // BASS_ChannelFlush() function so we have to use BASS_ChannelPlay() called in Play().
+ PausedSeek := true;
+ end;
+
+ // set new position
+ SourceStream.Position := Time;
+ end;
+end;
+
+function TBassPlaybackStream.GetLength(): real;
+begin
+ if assigned(SourceStream) then
+ Result := SourceStream.Length
+ else
+ Result := -1;
+end;
+
+function TBassPlaybackStream.GetStatus(): TStreamStatus;
+var
+ State: DWORD;
+begin
+ State := BASS_ChannelIsActive(Handle);
+ case State of
+ BASS_ACTIVE_PLAYING,
+ BASS_ACTIVE_STALLED:
+ Result := ssPlaying;
+ BASS_ACTIVE_PAUSED:
+ Result := ssPaused;
+ BASS_ACTIVE_STOPPED:
+ Result := ssStopped;
+ else
+ begin
+ Log.LogError('Unknown status', 'TBassPlaybackStream.GetStatus');
+ Result := ssStopped;
+ end;
+ end;
+end;
+
+function TBassPlaybackStream.GetLoop(): boolean;
+begin
+ if assigned(SourceStream) then
+ Result := SourceStream.Loop
+ else
+ Result := false;
+end;
+
+procedure TBassPlaybackStream.SetLoop(Enabled: boolean);
+begin
+ if assigned(SourceStream) then
+ SourceStream.Loop := Enabled;
+end;
+
+procedure DSPProcHandler(handle: HDSP; channel: DWORD; buffer: Pointer; length: DWORD; user: Pointer);
+{$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
+var
+ Effect: TSoundEffect;
+begin
+ Effect := TSoundEffect(user);
+ if assigned(Effect) then
+ Effect.Callback(buffer, length);
+end;
+
+procedure TBassPlaybackStream.AddSoundEffect(Effect: TSoundEffect);
+var
+ DspHandle: HDSP;
+begin
+ if assigned(Effect.engineData) then
+ begin
+ Log.LogError('TSoundEffect.engineData already set', 'TBassPlaybackStream.AddSoundEffect');
+ Exit;
+ end;
+
+ DspHandle := BASS_ChannelSetDSP(Handle, @DSPProcHandler, Effect, 0);
+ if (DspHandle = 0) then
+ begin
+ Log.LogError(BassCore.ErrorGetString(), 'TBassPlaybackStream.AddSoundEffect');
+ Exit;
+ end;
+
+ GetMem(Effect.EngineData, SizeOf(HDSP));
+ PHDSP(Effect.EngineData)^ := DspHandle;
+end;
+
+procedure TBassPlaybackStream.RemoveSoundEffect(Effect: TSoundEffect);
+begin
+ if not assigned(Effect.EngineData) then
+ begin
+ Log.LogError('TSoundEffect.engineData invalid', 'TBassPlaybackStream.RemoveSoundEffect');
+ Exit;
+ end;
+
+ if not BASS_ChannelRemoveDSP(Handle, PHDSP(Effect.EngineData)^) then
+ begin
+ Log.LogError(BassCore.ErrorGetString(), 'TBassPlaybackStream.RemoveSoundEffect');
+ Exit;
+ end;
+
+ FreeMem(Effect.EngineData);
+ Effect.EngineData := nil;
+end;
+
+procedure TBassPlaybackStream.GetFFTData(var Data: TFFTData);
+begin
+ // get FFT channel data (Mono, FFT512 -> 256 values)
+ BASS_ChannelGetData(Handle, @Data, BASS_DATA_FFT512);
+end;
+
+{*
+ * Copies interleaved PCM SInt16 stereo samples into data.
+ * Returns the number of frames
+ *}
+function TBassPlaybackStream.GetPCMData(var Data: TPCMData): Cardinal;
+var
+ Info: BASS_CHANNELINFO;
+ nBytes: DWORD;
+begin
+ Result := 0;
+
+ FillChar(Data, SizeOf(TPCMData), 0);
+
+ // no support for non-stereo files at the moment
+ BASS_ChannelGetInfo(Handle, Info);
+ if (Info.chans <> 2) then
+ Exit;
+
+ nBytes := BASS_ChannelGetData(Handle, @Data, SizeOf(TPCMData));
+ if(nBytes <= 0) then
+ Result := 0
+ else
+ Result := nBytes div SizeOf(TPCMStereoSample);
+end;
+
+function TBassPlaybackStream.GetAudioFormatInfo(): TAudioFormatInfo;
+begin
+ if assigned(SourceStream) then
+ Result := SourceStream.GetAudioFormatInfo()
+ else
+ Result := nil;
+end;
+
+
+{ TBassVoiceStream }
+
+function TBassVoiceStream.Open(ChannelMap: integer; FormatInfo: TAudioFormatInfo): boolean;
+var
+ Flags: DWORD;
+begin
+ Result := false;
+
+ Close();
+
+ if (not inherited Open(ChannelMap, FormatInfo)) then
+ Exit;
+
+ // get channel flags
+ BassCore.ConvertAudioFormatToBASSFlags(FormatInfo.Format, Flags);
+
+ (*
+ // distribute the mics equally to both speakers
+ if ((ChannelMap and CHANNELMAP_LEFT) <> 0) then
+ Flags := Flags or BASS_SPEAKER_FRONTLEFT;
+ if ((ChannelMap and CHANNELMAP_RIGHT) <> 0) then
+ Flags := Flags or BASS_SPEAKER_FRONTRIGHT;
+ *)
+
+ // create the channel
+ Handle := BASS_StreamCreate(Round(FormatInfo.SampleRate), 1, Flags, STREAMPROC_PUSH, nil);
+
+ // start the channel
+ BASS_ChannelPlay(Handle, true);
+
+ Result := true;
+end;
+
+procedure TBassVoiceStream.Close();
+begin
+ if (Handle <> 0) then
+ begin
+ BASS_ChannelStop(Handle);
+ BASS_StreamFree(Handle);
+ end;
+ inherited Close();
+end;
+
+procedure TBassVoiceStream.WriteData(Buffer: PChar; BufferSize: integer);
+var QueueSize: DWORD;
+begin
+ if ((Handle <> 0) and (BufferSize > 0)) then
+ begin
+ // query the queue size (normally 0)
+ QueueSize := BASS_StreamPutData(Handle, nil, 0);
+ // flush the buffer if the delay would be too high
+ if (QueueSize > MAX_VOICE_DELAY * FormatInfo.BytesPerSec) then
+ BASS_ChannelPlay(Handle, true);
+ // send new data to playback buffer
+ BASS_StreamPutData(Handle, Buffer, BufferSize);
+ end;
+end;
+
+// Note: we do not need the read-function for the BASS implementation
+function TBassVoiceStream.ReadData(Buffer: PChar; BufferSize: integer): integer;
+begin
+ Result := -1;
+end;
+
+function TBassVoiceStream.IsEOF(): boolean;
+begin
+ Result := false;
+end;
+
+function TBassVoiceStream.IsError(): boolean;
+begin
+ Result := false;
+end;
+
+
+{ TAudioPlayback_Bass }
+
+function TAudioPlayback_Bass.GetName: String;
+begin
+ Result := 'BASS_Playback';
+end;
+
+function TAudioPlayback_Bass.EnumDevices(): boolean;
+var
+ BassDeviceID: DWORD;
+ DeviceIndex: integer;
+ Device: TBassOutputDevice;
+ DeviceInfo: BASS_DEVICEINFO;
+begin
+ Result := true;
+
+ ClearOutputDeviceList();
+
+ // skip "no sound"-device (ID = 0)
+ BassDeviceID := 1;
+
+ while (true) do
+ begin
+ // check for device
+ if (not BASS_GetDeviceInfo(BassDeviceID, DeviceInfo)) then
+ Break;
+
+ // set device info
+ Device := TBassOutputDevice.Create();
+ Device.Name := DeviceInfo.name;
+ Device.BassDeviceID := BassDeviceID;
+
+ // add device to list
+ SetLength(OutputDeviceList, BassDeviceID);
+ OutputDeviceList[BassDeviceID-1] := Device;
+
+ Inc(BassDeviceID);
+ end;
+end;
+
+function TAudioPlayback_Bass.InitializePlayback(): boolean;
+begin
+ result := false;
+
+ BassCore := TAudioCore_Bass.GetInstance();
+
+ EnumDevices();
+
+ //Log.BenchmarkStart(4);
+ //Log.LogStatus('Initializing Playback Subsystem', 'Music Initialize');
+
+ // TODO: use BASS_DEVICE_LATENCY to determine the latency
+ if not BASS_Init(-1, 44100, 0, 0, nil) then
+ begin
+ Log.LogError('Could not initialize BASS', 'TAudioPlayback_Bass.InitializePlayback');
+ Exit;
+ end;
+
+ //Log.BenchmarkEnd(4); Log.LogBenchmark('--> Bass Init', 4);
+
+ // config playing buffer
+ //BASS_SetConfig(BASS_CONFIG_UPDATEPERIOD, 10);
+ //BASS_SetConfig(BASS_CONFIG_BUFFER, 100);
+
+ result := true;
+end;
+
+function TAudioPlayback_Bass.FinalizePlayback(): boolean;
+begin
+ Close;
+ BASS_Free;
+ inherited FinalizePlayback();
+ Result := true;
+end;
+
+function TAudioPlayback_Bass.CreatePlaybackStream(): TAudioPlaybackStream;
+begin
+ Result := TBassPlaybackStream.Create();
+end;
+
+procedure TAudioPlayback_Bass.SetAppVolume(Volume: single);
+begin
+ // set volume for this application (ranges from 0..10000 since BASS 2.4)
+ BASS_SetConfig(BASS_CONFIG_GVOL_STREAM, Round(Volume*10000));
+end;
+
+function TAudioPlayback_Bass.CreateVoiceStream(ChannelMap: integer; FormatInfo: TAudioFormatInfo): TAudioVoiceStream;
+var
+ VoiceStream: TAudioVoiceStream;
+begin
+ Result := nil;
+
+ VoiceStream := TBassVoiceStream.Create();
+ if (not VoiceStream.Open(ChannelMap, FormatInfo)) then
+ begin
+ VoiceStream.Free;
+ Exit;
+ end;
+
+ Result := VoiceStream;
+end;
+
+function TAudioPlayback_Bass.GetLatency(): double;
+begin
+ Result := 0;
+end;
+
+
+initialization
+ MediaManager.Add(TAudioPlayback_Bass.Create);
+
+end.
diff --git a/src/base/UAudioPlayback_Portaudio.pas b/src/base/UAudioPlayback_Portaudio.pas
new file mode 100644
index 00000000..c3717ba6
--- /dev/null
+++ b/src/base/UAudioPlayback_Portaudio.pas
@@ -0,0 +1,361 @@
+unit UAudioPlayback_Portaudio;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+
+uses
+ Classes,
+ SysUtils,
+ UMusic;
+
+implementation
+
+uses
+ portaudio,
+ UAudioCore_Portaudio,
+ UAudioPlayback_SoftMixer,
+ ULog,
+ UIni,
+ UMain;
+
+type
+ TAudioPlayback_Portaudio = class(TAudioPlayback_SoftMixer)
+ private
+ paStream: PPaStream;
+ AudioCore: TAudioCore_Portaudio;
+ Latency: double;
+ function OpenDevice(deviceIndex: TPaDeviceIndex): boolean;
+ function EnumDevices(): boolean;
+ protected
+ function InitializeAudioPlaybackEngine(): boolean; override;
+ function StartAudioPlaybackEngine(): boolean; override;
+ procedure StopAudioPlaybackEngine(); override;
+ function FinalizeAudioPlaybackEngine(): boolean; override;
+ function GetLatency(): double; override;
+ public
+ function GetName: String; override;
+ end;
+
+ TPortaudioOutputDevice = class(TAudioOutputDevice)
+ private
+ PaDeviceIndex: TPaDeviceIndex;
+ end;
+
+
+{ TAudioPlayback_Portaudio }
+
+function PortaudioAudioCallback(input: Pointer; output: Pointer; frameCount: Longword;
+ timeInfo: PPaStreamCallbackTimeInfo; statusFlags: TPaStreamCallbackFlags;
+ userData: Pointer): Integer; cdecl;
+var
+ Engine: TAudioPlayback_Portaudio;
+begin
+ Engine := TAudioPlayback_Portaudio(userData);
+ // update latency
+ Engine.Latency := timeInfo.outputBufferDacTime - timeInfo.currentTime;
+ // call superclass callback
+ Engine.AudioCallback(output, frameCount * Engine.FormatInfo.FrameSize);
+ Result := paContinue;
+end;
+
+function TAudioPlayback_Portaudio.GetName: String;
+begin
+ Result := 'Portaudio_Playback';
+end;
+
+function TAudioPlayback_Portaudio.OpenDevice(deviceIndex: TPaDeviceIndex): boolean;
+var
+ DeviceInfo : PPaDeviceInfo;
+ SampleRate : double;
+ OutParams : TPaStreamParameters;
+ StreamInfo : PPaStreamInfo;
+ err : TPaError;
+begin
+ Result := false;
+
+ DeviceInfo := Pa_GetDeviceInfo(deviceIndex);
+
+ Log.LogInfo('Audio-Output Device: ' + DeviceInfo^.name, 'TAudioPlayback_Portaudio.OpenDevice');
+
+ SampleRate := DeviceInfo^.defaultSampleRate;
+
+ with OutParams do
+ begin
+ device := deviceIndex;
+ channelCount := 2;
+ sampleFormat := paInt16;
+ suggestedLatency := DeviceInfo^.defaultLowOutputLatency;
+ hostApiSpecificStreamInfo := nil;
+ end;
+
+ // check souncard and adjust sample-rate
+ if not AudioCore.TestDevice(nil, @OutParams, SampleRate) then
+ begin
+ Log.LogStatus('TestDevice failed!', 'TAudioPlayback_Portaudio.OpenDevice');
+ Exit;
+ end;
+
+ // open output stream
+ err := Pa_OpenStream(paStream, nil, @OutParams, SampleRate,
+ paFramesPerBufferUnspecified,
+ paNoFlag, @PortaudioAudioCallback, Self);
+ if(err <> paNoError) then
+ begin
+ Log.LogStatus(Pa_GetErrorText(err), 'TAudioPlayback_Portaudio.OpenDevice');
+ paStream := nil;
+ Exit;
+ end;
+
+ // get estimated latency (will be updated with real latency in the callback)
+ StreamInfo := Pa_GetStreamInfo(paStream);
+ if (StreamInfo <> nil) then
+ Latency := StreamInfo^.outputLatency
+ else
+ Latency := 0;
+
+ FormatInfo := TAudioFormatInfo.Create(
+ OutParams.channelCount,
+ SampleRate,
+ asfS16 // FIXME: is paInt16 system-dependant or -independant?
+ );
+
+ Result := true;
+end;
+
+function TAudioPlayback_Portaudio.EnumDevices(): boolean;
+var
+ i: integer;
+ paApiIndex: TPaHostApiIndex;
+ paApiInfo: PPaHostApiInfo;
+ deviceName: string;
+ deviceIndex: TPaDeviceIndex;
+ deviceInfo: PPaDeviceInfo;
+ channelCnt: integer;
+ SC: integer; // soundcard
+ err: TPaError;
+ errMsg: string;
+ paDevice: TPortaudioOutputDevice;
+ outputParams: TPaStreamParameters;
+ stream: PPaStream;
+ streamInfo: PPaStreamInfo;
+ sampleRate: double;
+ latency: TPaTime;
+ cbPolls: integer;
+ cbWorks: boolean;
+begin
+ Result := false;
+
+(*
+ // choose the best available Audio-API
+ paApiIndex := AudioCore.GetPreferredApiIndex();
+ if(paApiIndex = -1) then
+ begin
+ Log.LogError('No working Audio-API found', 'TAudioPlayback_Portaudio.EnumDevices');
+ Exit;
+ end;
+
+ paApiInfo := Pa_GetHostApiInfo(paApiIndex);
+
+ SC := 0;
+
+ // init array-size to max. output-devices count
+ SetLength(OutputDeviceList, paApiInfo^.deviceCount);
+ for i:= 0 to High(OutputDeviceList) do
+ begin
+ // convert API-specific device-index to global index
+ deviceIndex := Pa_HostApiDeviceIndexToDeviceIndex(paApiIndex, i);
+ deviceInfo := Pa_GetDeviceInfo(deviceIndex);
+
+ channelCnt := deviceInfo^.maxOutputChannels;
+
+ // current device is no output device -> skip
+ if (channelCnt <= 0) then
+ continue;
+
+ // portaudio returns a channel-count of 128 for some devices
+ // (e.g. the "default"-device), so we have to detect those
+ // fantasy channel counts.
+ if (channelCnt > 8) then
+ channelCnt := 2;
+
+ paDevice := TPortaudioOutputDevice.Create();
+ OutputDeviceList[SC] := paDevice;
+
+ // retrieve device-name
+ deviceName := deviceInfo^.name;
+ paDevice.Name := deviceName;
+ paDevice.PaDeviceIndex := deviceIndex;
+
+ if (deviceInfo^.defaultSampleRate > 0) then
+ sampleRate := deviceInfo^.defaultSampleRate
+ else
+ sampleRate := 44100;
+
+ // on vista and xp the defaultLowInputLatency may be set to 0 but it works.
+ // TODO: correct too low latencies (what is a too low latency, maybe < 10ms?)
+ latency := deviceInfo^.defaultLowInputLatency;
+
+ // setup desired output parameters
+ // TODO: retry with input-latency set to 20ms (defaultLowOutputLatency might
+ // not be set correctly in OSS)
+ with outputParams do
+ begin
+ device := deviceIndex;
+ channelCount := channelCnt;
+ sampleFormat := paInt16;
+ suggestedLatency := latency;
+ hostApiSpecificStreamInfo := nil;
+ end;
+
+ // check if mic-callback works (might not be called on some devices)
+ if (not TAudioCore_Portaudio.TestDevice(nil, @outputParams, sampleRate)) then
+ begin
+ // ignore device if callback did not work
+ Log.LogError('Device "'+paDevice.Name+'" does not respond',
+ 'TAudioPlayback_Portaudio.InitializeRecord');
+ paDevice.Free();
+ continue;
+ end;
+
+ // open device for further info
+ err := Pa_OpenStream(stream, nil, @outputParams, sampleRate,
+ paFramesPerBufferUnspecified, paNoFlag, @MicrophoneTestCallback, nil);
+ if(err <> paNoError) then
+ begin
+ // unable to open device -> skip
+ errMsg := Pa_GetErrorText(err);
+ Log.LogError('Device error: "'+ deviceName +'" ('+ errMsg +')',
+ 'TAudioPlayback_Portaudio.InitializeRecord');
+ paDevice.Free();
+ continue;
+ end;
+
+ // adjust sample-rate (might be changed by portaudio)
+ streamInfo := Pa_GetStreamInfo(stream);
+ if (streamInfo <> nil) then
+ begin
+ if (sampleRate <> streamInfo^.sampleRate) then
+ begin
+ Log.LogStatus('Portaudio changed Samplerate from ' + FloatToStr(sampleRate) +
+ ' to ' + FloatToStr(streamInfo^.sampleRate),
+ 'TAudioInput_Portaudio.InitializeRecord');
+ sampleRate := streamInfo^.sampleRate;
+ end;
+ end;
+
+ // create audio-format info and resize capture-buffer array
+ paDevice.AudioFormat := TAudioFormatInfo.Create(
+ channelCnt,
+ sampleRate,
+ asfS16
+ );
+ SetLength(paDevice.CaptureChannel, paDevice.AudioFormat.Channels);
+
+ Log.LogStatus('OutputDevice "'+paDevice.Name+'"@' +
+ IntToStr(paDevice.AudioFormat.Channels)+'x'+
+ FloatToStr(paDevice.AudioFormat.SampleRate)+'Hz ('+
+ FloatTostr(outputParams.suggestedLatency)+'sec)' ,
+ 'TAudioInput_Portaudio.InitializeRecord');
+
+ // close test-stream
+ Pa_CloseStream(stream);
+
+ Inc(SC);
+ end;
+
+ // adjust size to actual input-device count
+ SetLength(OutputDeviceList, SC);
+
+ Log.LogStatus('#Output-Devices: ' + inttostr(SC), 'Portaudio');
+*)
+
+ Result := true;
+end;
+
+function TAudioPlayback_Portaudio.InitializeAudioPlaybackEngine(): boolean;
+var
+ paApiIndex : TPaHostApiIndex;
+ paApiInfo : PPaHostApiInfo;
+ paOutDevice : TPaDeviceIndex;
+ err: TPaError;
+begin
+ Result := false;
+
+ AudioCore := TAudioCore_Portaudio.GetInstance();
+
+ // initialize portaudio
+ err := Pa_Initialize();
+ if(err <> paNoError) then
+ begin
+ Log.LogError(Pa_GetErrorText(err), 'TAudioInput_Portaudio.InitializeRecord');
+ Exit;
+ end;
+
+ paApiIndex := AudioCore.GetPreferredApiIndex();
+ if(paApiIndex = -1) then
+ begin
+ Log.LogError('No working Audio-API found', 'TAudioPlayback_Portaudio.InitializeAudioPlaybackEngine');
+ Exit;
+ end;
+
+ EnumDevices();
+
+ paApiInfo := Pa_GetHostApiInfo(paApiIndex);
+ Log.LogInfo('Audio-Output API-Type: ' + paApiInfo^.name, 'TAudioPlayback_Portaudio.OpenDevice');
+
+ paOutDevice := paApiInfo^.defaultOutputDevice;
+ if (not OpenDevice(paOutDevice)) then
+ begin
+ Exit;
+ end;
+
+ Result := true;
+end;
+
+function TAudioPlayback_Portaudio.StartAudioPlaybackEngine(): boolean;
+var
+ err: TPaError;
+begin
+ Result := false;
+
+ if (paStream = nil) then
+ Exit;
+
+ err := Pa_StartStream(paStream);
+ if(err <> paNoError) then
+ begin
+ Log.LogStatus('Pa_StartStream: '+Pa_GetErrorText(err), 'UAudioPlayback_Portaudio');
+ Exit;
+ end;
+
+ Result := true;
+end;
+
+procedure TAudioPlayback_Portaudio.StopAudioPlaybackEngine();
+begin
+ if (paStream <> nil) then
+ Pa_StopStream(paStream);
+end;
+
+function TAudioPlayback_Portaudio.FinalizeAudioPlaybackEngine(): boolean;
+begin
+ Pa_Terminate();
+ Result := true;
+end;
+
+function TAudioPlayback_Portaudio.GetLatency(): double;
+begin
+ Result := Latency;
+end;
+
+
+initialization
+ MediaManager.Add(TAudioPlayback_Portaudio.Create);
+
+end.
diff --git a/src/base/UAudioPlayback_SDL.pas b/src/base/UAudioPlayback_SDL.pas
new file mode 100644
index 00000000..deef91e8
--- /dev/null
+++ b/src/base/UAudioPlayback_SDL.pas
@@ -0,0 +1,160 @@
+unit UAudioPlayback_SDL;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+
+uses
+ Classes,
+ SysUtils,
+ UMusic;
+
+implementation
+
+uses
+ sdl,
+ UAudioPlayback_SoftMixer,
+ ULog,
+ UIni,
+ UMain;
+
+type
+ TAudioPlayback_SDL = class(TAudioPlayback_SoftMixer)
+ private
+ Latency: double;
+ function EnumDevices(): boolean;
+ protected
+ function InitializeAudioPlaybackEngine(): boolean; override;
+ function StartAudioPlaybackEngine(): boolean; override;
+ procedure StopAudioPlaybackEngine(); override;
+ function FinalizeAudioPlaybackEngine(): boolean; override;
+ function GetLatency(): double; override;
+ public
+ function GetName: String; override;
+ procedure MixBuffers(dst, src: PChar; size: Cardinal; volume: Single); override;
+ end;
+
+
+{ TAudioPlayback_SDL }
+
+procedure SDLAudioCallback(userdata: Pointer; stream: PChar; len: integer); cdecl;
+var
+ Engine: TAudioPlayback_SDL;
+begin
+ Engine := TAudioPlayback_SDL(userdata);
+ Engine.AudioCallback(stream, len);
+end;
+
+function TAudioPlayback_SDL.GetName: String;
+begin
+ Result := 'SDL_Playback';
+end;
+
+function TAudioPlayback_SDL.EnumDevices(): boolean;
+begin
+ // Note: SDL does not provide Device-Selection capabilities (will be introduced in 1.3)
+ ClearOutputDeviceList();
+ SetLength(OutputDeviceList, 1);
+ OutputDeviceList[0] := TAudioOutputDevice.Create();
+ OutputDeviceList[0].Name := '[SDL Default-Device]';
+ Result := true;
+end;
+
+function TAudioPlayback_SDL.InitializeAudioPlaybackEngine(): boolean;
+var
+ DesiredAudioSpec, ObtainedAudioSpec: TSDL_AudioSpec;
+ SampleBufferSize: integer;
+begin
+ Result := false;
+
+ EnumDevices();
+
+ if (SDL_InitSubSystem(SDL_INIT_AUDIO) = -1) then
+ begin
+ Log.LogError('SDL_InitSubSystem failed!', 'TAudioPlayback_SDL.InitializeAudioPlaybackEngine');
+ Exit;
+ end;
+
+ SampleBufferSize := IAudioOutputBufferSizeVals[Ini.AudioOutputBufferSizeIndex];
+ if (SampleBufferSize <= 0) then
+ begin
+ // Automatic setting default
+ // FIXME: too much glitches with 1024 samples
+ SampleBufferSize := 2048; //1024;
+ end;
+
+ FillChar(DesiredAudioSpec, SizeOf(DesiredAudioSpec), 0);
+ with DesiredAudioSpec do
+ begin
+ freq := 44100;
+ format := AUDIO_S16SYS;
+ channels := 2;
+ samples := SampleBufferSize;
+ callback := @SDLAudioCallback;
+ userdata := Self;
+ end;
+
+ // Note: always use the "obtained" parameter, otherwise SDL might try to convert
+ // the samples itself if the desired format is not available. This might lead
+ // to problems if for example ALSA does not support 44100Hz and proposes 48000Hz.
+ // Without the obtained parameter, SDL would try to convert 44.1kHz to 48kHz with
+ // its crappy (non working) converter resulting in a wrong (too high) pitch.
+ if(SDL_OpenAudio(@DesiredAudioSpec, @ObtainedAudioSpec) = -1) then
+ begin
+ Log.LogStatus('SDL_OpenAudio: ' + SDL_GetError(), 'TAudioPlayback_SDL.InitializeAudioPlaybackEngine');
+ Exit;
+ end;
+
+ FormatInfo := TAudioFormatInfo.Create(
+ ObtainedAudioSpec.channels,
+ ObtainedAudioSpec.freq,
+ asfS16
+ );
+
+ // Note: SDL does not provide info of the internal buffer state.
+ // So we use the average buffer-size.
+ Latency := (ObtainedAudioSpec.samples/2) / FormatInfo.SampleRate;
+
+ Log.LogStatus('Opened audio device', 'TAudioPlayback_SDL.InitializeAudioPlaybackEngine');
+
+ Result := true;
+end;
+
+function TAudioPlayback_SDL.StartAudioPlaybackEngine(): boolean;
+begin
+ SDL_PauseAudio(0);
+ Result := true;
+end;
+
+procedure TAudioPlayback_SDL.StopAudioPlaybackEngine();
+begin
+ SDL_PauseAudio(1);
+end;
+
+function TAudioPlayback_SDL.FinalizeAudioPlaybackEngine(): boolean;
+begin
+ SDL_CloseAudio();
+ SDL_QuitSubSystem(SDL_INIT_AUDIO);
+ Result := true;
+end;
+
+function TAudioPlayback_SDL.GetLatency(): double;
+begin
+ Result := Latency;
+end;
+
+procedure TAudioPlayback_SDL.MixBuffers(dst, src: PChar; size: Cardinal; volume: Single);
+begin
+ SDL_MixAudio(PUInt8(dst), PUInt8(src), size, Round(volume * SDL_MIX_MAXVOLUME));
+end;
+
+
+initialization
+ MediaManager.add(TAudioPlayback_SDL.Create);
+
+end.
diff --git a/src/base/UAudioPlayback_SoftMixer.pas b/src/base/UAudioPlayback_SoftMixer.pas
new file mode 100644
index 00000000..6ddae980
--- /dev/null
+++ b/src/base/UAudioPlayback_SoftMixer.pas
@@ -0,0 +1,1132 @@
+unit UAudioPlayback_SoftMixer;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+
+uses
+ Classes,
+ SysUtils,
+ sdl,
+ URingBuffer,
+ UMusic,
+ UAudioPlaybackBase;
+
+type
+ TAudioPlayback_SoftMixer = class;
+
+ TGenericPlaybackStream = class(TAudioPlaybackStream)
+ private
+ Engine: TAudioPlayback_SoftMixer;
+
+ SampleBuffer: PChar;
+ SampleBufferSize: integer;
+ SampleBufferCount: integer; // number of available bytes in SampleBuffer
+ SampleBufferPos: cardinal;
+
+ SourceBuffer: PChar;
+ SourceBufferSize: integer;
+ SourceBufferCount: integer; // number of available bytes in SourceBuffer
+
+ Converter: TAudioConverter;
+ Status: TStreamStatus;
+ InternalLock: PSDL_Mutex;
+ SoundEffects: TList;
+ fVolume: single;
+
+ FadeInStartTime, FadeInTime: cardinal;
+ FadeInStartVolume, FadeInTargetVolume: single;
+
+ NeedsRewind: boolean;
+
+ procedure Reset();
+
+ procedure ApplySoundEffects(Buffer: PChar; BufferSize: integer);
+ function InitFormatConversion(): boolean;
+ procedure FlushBuffers();
+
+ procedure LockSampleBuffer(); {$IFDEF HasInline}inline;{$ENDIF}
+ procedure UnlockSampleBuffer(); {$IFDEF HasInline}inline;{$ENDIF}
+ protected
+ function GetLatency(): double; override;
+ function GetStatus(): TStreamStatus; override;
+ function GetVolume(): single; override;
+ procedure SetVolume(Volume: single); override;
+ function GetLength(): real; override;
+ function GetLoop(): boolean; override;
+ procedure SetLoop(Enabled: boolean); override;
+ function GetPosition: real; override;
+ procedure SetPosition(Time: real); override;
+ public
+ constructor Create(Engine: TAudioPlayback_SoftMixer);
+ destructor Destroy(); override;
+
+ function Open(SourceStream: TAudioSourceStream): boolean; override;
+ procedure Close(); override;
+
+ procedure Play(); override;
+ procedure Pause(); override;
+ procedure Stop(); override;
+ procedure FadeIn(Time: real; TargetVolume: single); override;
+
+ function GetAudioFormatInfo(): TAudioFormatInfo; override;
+
+ function ReadData(Buffer: PChar; BufferSize: integer): integer;
+
+ function GetPCMData(var Data: TPCMData): Cardinal; override;
+ procedure GetFFTData(var Data: TFFTData); override;
+
+ procedure AddSoundEffect(Effect: TSoundEffect); override;
+ procedure RemoveSoundEffect(Effect: TSoundEffect); override;
+ end;
+
+ TAudioMixerStream = class
+ private
+ Engine: TAudioPlayback_SoftMixer;
+
+ ActiveStreams: TList;
+ MixerBuffer: PChar;
+ InternalLock: PSDL_Mutex;
+
+ AppVolume: single;
+
+ procedure Lock(); {$IFDEF HasInline}inline;{$ENDIF}
+ procedure Unlock(); {$IFDEF HasInline}inline;{$ENDIF}
+
+ function GetVolume(): single;
+ procedure SetVolume(Volume: single);
+ public
+ constructor Create(Engine: TAudioPlayback_SoftMixer);
+ destructor Destroy(); override;
+ procedure AddStream(Stream: TAudioPlaybackStream);
+ procedure RemoveStream(Stream: TAudioPlaybackStream);
+ function ReadData(Buffer: PChar; BufferSize: integer): integer;
+
+ property Volume: single read GetVolume write SetVolume;
+ end;
+
+ TAudioPlayback_SoftMixer = class(TAudioPlaybackBase)
+ private
+ MixerStream: TAudioMixerStream;
+ protected
+ FormatInfo: TAudioFormatInfo;
+
+ function InitializeAudioPlaybackEngine(): boolean; virtual; abstract;
+ function StartAudioPlaybackEngine(): boolean; virtual; abstract;
+ procedure StopAudioPlaybackEngine(); virtual; abstract;
+ function FinalizeAudioPlaybackEngine(): boolean; virtual; abstract;
+ procedure AudioCallback(Buffer: PChar; Size: integer); {$IFDEF HasInline}inline;{$ENDIF}
+
+ function CreatePlaybackStream(): TAudioPlaybackStream; override;
+ public
+ function GetName: String; override; abstract;
+ function InitializePlayback(): boolean; override;
+ function FinalizePlayback: boolean; override;
+
+ procedure SetAppVolume(Volume: single); override;
+
+ function CreateVoiceStream(ChannelMap: integer; FormatInfo: TAudioFormatInfo): TAudioVoiceStream; override;
+
+ function GetMixer(): TAudioMixerStream; {$IFDEF HasInline}inline;{$ENDIF}
+ function GetAudioFormatInfo(): TAudioFormatInfo;
+
+ procedure MixBuffers(DstBuffer, SrcBuffer: PChar; Size: Cardinal; Volume: Single); virtual;
+ end;
+
+type
+ TGenericVoiceStream = class(TAudioVoiceStream)
+ private
+ VoiceBuffer: TRingBuffer;
+ BufferLock: PSDL_Mutex;
+ PlaybackStream: TGenericPlaybackStream;
+ Engine: TAudioPlayback_SoftMixer;
+ public
+ constructor Create(Engine: TAudioPlayback_SoftMixer);
+
+ function Open(ChannelMap: integer; FormatInfo: TAudioFormatInfo): boolean; override;
+ procedure Close(); override;
+ procedure WriteData(Buffer: PChar; BufferSize: integer); override;
+ function ReadData(Buffer: PChar; BufferSize: integer): integer; override;
+ function IsEOF(): boolean; override;
+ function IsError(): boolean; override;
+ end;
+
+const
+ SOURCE_BUFFER_FRAMES = 4096;
+
+const
+ MAX_VOICE_DELAY = 0.500; // 20ms
+
+implementation
+
+uses
+ Math,
+ ULog,
+ UIni,
+ UFFT,
+ UAudioConverter,
+ UMain;
+
+{ TAudioMixerStream }
+
+constructor TAudioMixerStream.Create(Engine: TAudioPlayback_SoftMixer);
+begin
+ inherited Create();
+
+ Self.Engine := Engine;
+
+ ActiveStreams := TList.Create;
+ InternalLock := SDL_CreateMutex();
+ AppVolume := 1.0;
+end;
+
+destructor TAudioMixerStream.Destroy();
+begin
+ if assigned(MixerBuffer) then
+ Freemem(MixerBuffer);
+ ActiveStreams.Free;
+ SDL_DestroyMutex(InternalLock);
+ inherited;
+end;
+
+procedure TAudioMixerStream.Lock();
+begin
+ SDL_mutexP(InternalLock);
+end;
+
+procedure TAudioMixerStream.Unlock();
+begin
+ SDL_mutexV(InternalLock);
+end;
+
+function TAudioMixerStream.GetVolume(): single;
+begin
+ Lock();
+ Result := AppVolume;
+ Unlock();
+end;
+
+procedure TAudioMixerStream.SetVolume(Volume: single);
+begin
+ Lock();
+ AppVolume := Volume;
+ Unlock();
+end;
+
+procedure TAudioMixerStream.AddStream(Stream: TAudioPlaybackStream);
+begin
+ if not assigned(Stream) then
+ Exit;
+
+ Lock();
+ // check if stream is already in list to avoid duplicates
+ if (ActiveStreams.IndexOf(Pointer(Stream)) = -1) then
+ ActiveStreams.Add(Pointer(Stream));
+ Unlock();
+end;
+
+(*
+ * Sets the entry of stream in the ActiveStreams-List to nil
+ * but does not remove it from the list (Count is not changed!).
+ * Otherwise iterations over the elements might fail due to a
+ * changed Count-property.
+ * Call ActiveStreams.Pack() to remove the nil-pointers
+ * or check for nil-pointers when accessing ActiveStreams.
+ *)
+procedure TAudioMixerStream.RemoveStream(Stream: TAudioPlaybackStream);
+var
+ Index: integer;
+begin
+ Lock();
+ Index := activeStreams.IndexOf(Pointer(Stream));
+ if (Index <> -1) then
+ begin
+ // remove entry but do not decrease count-property
+ ActiveStreams[Index] := nil;
+ end;
+ Unlock();
+end;
+
+function TAudioMixerStream.ReadData(Buffer: PChar; BufferSize: integer): integer;
+var
+ i: integer;
+ Size: integer;
+ Stream: TGenericPlaybackStream;
+ NeedsPacking: boolean;
+begin
+ Result := BufferSize;
+
+ // zero target-buffer (silence)
+ FillChar(Buffer^, BufferSize, 0);
+
+ // resize mixer-buffer if necessary
+ ReallocMem(MixerBuffer, BufferSize);
+ if not assigned(MixerBuffer) then
+ Exit;
+
+ Lock();
+
+ NeedsPacking := false;
+
+ // mix streams to one stream
+ for i := 0 to ActiveStreams.Count-1 do
+ begin
+ if (ActiveStreams[i] = nil) then
+ begin
+ NeedsPacking := true;
+ continue;
+ end;
+
+ Stream := TGenericPlaybackStream(ActiveStreams[i]);
+ // fetch data from current stream
+ Size := Stream.ReadData(MixerBuffer, BufferSize);
+ if (Size > 0) then
+ begin
+ // mix stream-data with mixer-buffer
+ // Note: use Self.appVolume instead of Self.Volume to prevent recursive locking
+ Engine.MixBuffers(Buffer, MixerBuffer, Size, AppVolume * Stream.Volume);
+ end;
+ end;
+
+ // remove nil-pointers from list
+ if (NeedsPacking) then
+ begin
+ ActiveStreams.Pack();
+ end;
+
+ Unlock();
+end;
+
+
+{ TGenericPlaybackStream }
+
+constructor TGenericPlaybackStream.Create(Engine: TAudioPlayback_SoftMixer);
+begin
+ inherited Create();
+ Self.Engine := Engine;
+ InternalLock := SDL_CreateMutex();
+ SoundEffects := TList.Create;
+ Status := ssStopped;
+ Reset();
+end;
+
+destructor TGenericPlaybackStream.Destroy();
+begin
+ Close();
+ SDL_DestroyMutex(InternalLock);
+ FreeAndNil(SoundEffects);
+ inherited;
+end;
+
+procedure TGenericPlaybackStream.Reset();
+begin
+ SourceStream := nil;
+
+ FreeAndNil(Converter);
+
+ FreeMem(SampleBuffer);
+ SampleBuffer := nil;
+ SampleBufferPos := 0;
+ SampleBufferSize := 0;
+ SampleBufferCount := 0;
+
+ FreeMem(SourceBuffer);
+ SourceBuffer := nil;
+ SourceBufferSize := 0;
+ SourceBufferCount := 0;
+
+ NeedsRewind := false;
+
+ fVolume := 0;
+ SoundEffects.Clear;
+ FadeInTime := 0;
+end;
+
+function TGenericPlaybackStream.Open(SourceStream: TAudioSourceStream): boolean;
+begin
+ Result := false;
+
+ Close();
+
+ if (not assigned(SourceStream)) then
+ Exit;
+ Self.SourceStream := SourceStream;
+
+ if (not InitFormatConversion()) then
+ begin
+ // reset decode-stream so it will not be freed on destruction
+ Self.SourceStream := nil;
+ Exit;
+ end;
+
+ SourceBufferSize := SOURCE_BUFFER_FRAMES * SourceStream.GetAudioFormatInfo().FrameSize;
+ GetMem(SourceBuffer, SourceBufferSize);
+ fVolume := 1.0;
+
+ Result := true;
+end;
+
+procedure TGenericPlaybackStream.Close();
+begin
+ // stop audio-callback on this stream
+ Stop();
+
+ // Note: PerformOnClose must be called before SourceStream is invalidated
+ PerformOnClose();
+ // and free data
+ Reset();
+end;
+
+procedure TGenericPlaybackStream.LockSampleBuffer();
+begin
+ SDL_mutexP(InternalLock);
+end;
+
+procedure TGenericPlaybackStream.UnlockSampleBuffer();
+begin
+ SDL_mutexV(InternalLock);
+end;
+
+function TGenericPlaybackStream.InitFormatConversion(): boolean;
+var
+ SrcFormatInfo: TAudioFormatInfo;
+ DstFormatInfo: TAudioFormatInfo;
+begin
+ Result := false;
+
+ SrcFormatInfo := SourceStream.GetAudioFormatInfo();
+ DstFormatInfo := GetAudioFormatInfo();
+
+ // TODO: selection should not be done here, use a factory (TAudioConverterFactory) instead
+ {$IF Defined(UseFFmpegResample)}
+ Converter := TAudioConverter_FFmpeg.Create();
+ {$ELSEIF Defined(UseSRCResample)}
+ Converter := TAudioConverter_SRC.Create();
+ {$ELSE}
+ Converter := TAudioConverter_SDL.Create();
+ {$IFEND}
+
+ Result := Converter.Init(SrcFormatInfo, DstFormatInfo);
+end;
+
+procedure TGenericPlaybackStream.Play();
+var
+ Mixer: TAudioMixerStream;
+begin
+ // only paused streams are not flushed
+ if (Status = ssPaused) then
+ NeedsRewind := false;
+
+ // rewind if necessary. Cases that require no rewind are:
+ // - stream was created and never played
+ // - stream was paused and is resumed now
+ // - stream was stopped and set to a new position already
+ if (NeedsRewind) then
+ SetPosition(0);
+
+ // update status
+ Status := ssPlaying;
+
+ NeedsRewind := true;
+
+ // add this stream to the mixer
+ Mixer := Engine.GetMixer();
+ if (Mixer <> nil) then
+ Mixer.AddStream(Self);
+end;
+
+procedure TGenericPlaybackStream.FadeIn(Time: real; TargetVolume: single);
+begin
+ FadeInTime := Trunc(Time * 1000);
+ FadeInStartTime := SDL_GetTicks();
+ FadeInStartVolume := fVolume;
+ FadeInTargetVolume := TargetVolume;
+ Play();
+end;
+
+procedure TGenericPlaybackStream.Pause();
+var
+ Mixer: TAudioMixerStream;
+begin
+ if (Status <> ssPlaying) then
+ Exit;
+
+ Status := ssPaused;
+
+ Mixer := Engine.GetMixer();
+ if (Mixer <> nil) then
+ Mixer.RemoveStream(Self);
+end;
+
+procedure TGenericPlaybackStream.Stop();
+var
+ Mixer: TAudioMixerStream;
+begin
+ if (Status = ssStopped) then
+ Exit;
+
+ Status := ssStopped;
+
+ Mixer := Engine.GetMixer();
+ if (Mixer <> nil) then
+ Mixer.RemoveStream(Self);
+end;
+
+function TGenericPlaybackStream.GetLoop(): boolean;
+begin
+ if assigned(SourceStream) then
+ Result := SourceStream.Loop
+ else
+ Result := false;
+end;
+
+procedure TGenericPlaybackStream.SetLoop(Enabled: boolean);
+begin
+ if assigned(SourceStream) then
+ SourceStream.Loop := Enabled;
+end;
+
+function TGenericPlaybackStream.GetLength(): real;
+begin
+ if assigned(SourceStream) then
+ Result := SourceStream.Length
+ else
+ Result := -1;
+end;
+
+function TGenericPlaybackStream.GetLatency(): double;
+begin
+ Result := Engine.GetLatency();
+end;
+
+function TGenericPlaybackStream.GetStatus(): TStreamStatus;
+begin
+ Result := Status;
+end;
+
+function TGenericPlaybackStream.GetAudioFormatInfo(): TAudioFormatInfo;
+begin
+ Result := Engine.GetAudioFormatInfo();
+end;
+
+procedure TGenericPlaybackStream.FlushBuffers();
+begin
+ SampleBufferCount := 0;
+ SampleBufferPos := 0;
+ SourceBufferCount := 0;
+end;
+
+procedure TGenericPlaybackStream.ApplySoundEffects(Buffer: PChar; BufferSize: integer);
+var
+ i: integer;
+begin
+ for i := 0 to SoundEffects.Count-1 do
+ begin
+ if (SoundEffects[i] <> nil) then
+ begin
+ TSoundEffect(SoundEffects[i]).Callback(Buffer, BufferSize);
+ end;
+ end;
+end;
+
+function TGenericPlaybackStream.ReadData(Buffer: PChar; BufferSize: integer): integer;
+var
+ ConversionInputCount: integer;
+ ConversionOutputSize: integer; // max. number of converted data (= buffer size)
+ ConversionOutputCount: integer; // actual number of converted data
+ SourceSize: integer;
+ RequestedSourceSize: integer;
+ NeededSampleBufferSize: integer;
+ BytesNeeded, BytesAvail: integer;
+ SourceFormatInfo, OutputFormatInfo: TAudioFormatInfo;
+ SourceFrameSize, OutputFrameSize: integer;
+ SkipOutputCount: integer; // number of output-data bytes to skip
+ SkipSourceCount: integer; // number of source-data bytes to skip
+ FillCount: integer; // number of bytes to fill with padding data
+ CopyCount: integer;
+ PadFrame: PChar;
+ i: integer;
+begin
+ Result := -1;
+
+ // sanity check for the source-stream
+ if (not assigned(SourceStream)) then
+ Exit;
+
+ SkipOutputCount := 0;
+ SkipSourceCount := 0;
+ FillCount := 0;
+
+ SourceFormatInfo := SourceStream.GetAudioFormatInfo();
+ SourceFrameSize := SourceFormatInfo.FrameSize;
+ OutputFormatInfo := GetAudioFormatInfo();
+ OutputFrameSize := OutputFormatInfo.FrameSize;
+
+ // synchronize (adjust buffer size)
+ BytesNeeded := Synchronize(BufferSize, OutputFormatInfo);
+ if (BytesNeeded > BufferSize) then
+ begin
+ SkipOutputCount := BytesNeeded - BufferSize;
+ BytesNeeded := BufferSize;
+ end
+ else if (BytesNeeded < BufferSize) then
+ begin
+ FillCount := BufferSize - BytesNeeded;
+ end;
+
+ // lock access to sample-buffer
+ LockSampleBuffer();
+ try
+
+ // skip sample-buffer data
+ SampleBufferPos := SampleBufferPos + SkipOutputCount;
+ // size of available bytes in SampleBuffer after skipping
+ SampleBufferCount := SampleBufferCount - SampleBufferPos;
+ // update byte skip-count
+ SkipOutputCount := -SampleBufferCount;
+
+ // now that we skipped all buffered data from the last pass, we have to skip
+ // data directly after fetching it from the source-stream.
+ if (SkipOutputCount > 0) then
+ begin
+ SampleBufferCount := 0;
+ // convert skip-count to source-format units and resize to a multiple of
+ // the source frame-size.
+ SkipSourceCount := Round((SkipOutputCount * OutputFormatInfo.GetRatio(SourceFormatInfo)) /
+ SourceFrameSize) * SourceFrameSize;
+ SkipOutputCount := 0;
+ end;
+
+ // copy data to front of buffer
+ if ((SampleBufferCount > 0) and (SampleBufferPos > 0)) then
+ Move(SampleBuffer[SampleBufferPos], SampleBuffer[0], SampleBufferCount);
+ SampleBufferPos := 0;
+
+ // resize buffer to a reasonable size
+ if (BufferSize > SampleBufferCount) then
+ begin
+ // Note: use BufferSize instead of BytesNeeded to minimize the need for resizing
+ SampleBufferSize := BufferSize;
+ ReallocMem(SampleBuffer, SampleBufferSize);
+ if (not assigned(SampleBuffer)) then
+ Exit;
+ end;
+
+ // fill sample-buffer (fetch and convert one block of source data per loop)
+ while (SampleBufferCount < BytesNeeded) do
+ begin
+ // move remaining source data from the previous pass to front of buffer
+ if (SourceBufferCount > 0) then
+ begin
+ Move(SourceBuffer[SourceBufferSize-SourceBufferCount],
+ SourceBuffer[0],
+ SourceBufferCount);
+ end;
+
+ SourceSize := SourceStream.ReadData(
+ @SourceBuffer[SourceBufferCount], SourceBufferSize-SourceBufferCount);
+ // break on error (-1) or if no data is available (0), e.g. while seeking
+ if (SourceSize <= 0) then
+ begin
+ // if we do not have data -> exit
+ if (SourceBufferCount = 0) then
+ begin
+ FlushBuffers();
+ Exit;
+ end;
+ // if we have some data, stop retrieving data from the source stream
+ // and use the data we have so far
+ Break;
+ end;
+
+ SourceBufferCount := SourceBufferCount + SourceSize;
+
+ // end-of-file reached -> stop playback
+ if (SourceStream.EOF) then
+ begin
+ if (Loop) then
+ SourceStream.Position := 0
+ else
+ Stop();
+ end;
+
+ if (SkipSourceCount > 0) then
+ begin
+ // skip data and update source buffer count
+ SourceBufferCount := SourceBufferCount - SkipSourceCount;
+ SkipSourceCount := -SourceBufferCount;
+ // continue with next pass if we skipped all data
+ if (SourceBufferCount <= 0) then
+ begin
+ SourceBufferCount := 0;
+ Continue;
+ end;
+ end;
+
+ // calc buffer size (might be bigger than actual resampled byte count)
+ ConversionOutputSize := Converter.GetOutputBufferSize(SourceBufferCount);
+ NeededSampleBufferSize := SampleBufferCount + ConversionOutputSize;
+
+ // resize buffer if necessary
+ if (SampleBufferSize < NeededSampleBufferSize) then
+ begin
+ SampleBufferSize := NeededSampleBufferSize;
+ ReallocMem(SampleBuffer, SampleBufferSize);
+ if (not assigned(SampleBuffer)) then
+ begin
+ FlushBuffers();
+ Exit;
+ end;
+ end;
+
+ // resample source data (Note: ConversionInputCount might be adjusted by Convert())
+ ConversionInputCount := SourceBufferCount;
+ ConversionOutputCount := Converter.Convert(
+ SourceBuffer, @SampleBuffer[SampleBufferCount], ConversionInputCount);
+ if (ConversionOutputCount = -1) then
+ begin
+ FlushBuffers();
+ Exit;
+ end;
+
+ // adjust sample- and source-buffer count by the number of converted bytes
+ SampleBufferCount := SampleBufferCount + ConversionOutputCount;
+ SourceBufferCount := SourceBufferCount - ConversionInputCount;
+ end;
+
+ // apply effects
+ ApplySoundEffects(SampleBuffer, SampleBufferCount);
+
+ // copy data to result buffer
+ CopyCount := Min(BytesNeeded, SampleBufferCount);
+ Move(SampleBuffer[0], Buffer[BufferSize - BytesNeeded], CopyCount);
+ Dec(BytesNeeded, CopyCount);
+ SampleBufferPos := CopyCount;
+
+ // release buffer lock
+ finally
+ UnlockSampleBuffer();
+ end;
+
+ // pad the buffer with the last frame if we are to fast
+ if (FillCount > 0) then
+ begin
+ if (CopyCount >= OutputFrameSize) then
+ PadFrame := @Buffer[CopyCount-OutputFrameSize]
+ else
+ PadFrame := nil;
+ FillBufferWithFrame(@Buffer[CopyCount], FillCount,
+ PadFrame, OutputFrameSize);
+ end;
+
+ // BytesNeeded now contains the number of remaining bytes we were not able to fetch
+ Result := BufferSize - BytesNeeded;
+end;
+
+function TGenericPlaybackStream.GetPCMData(var Data: TPCMData): Cardinal;
+var
+ ByteCount: integer;
+begin
+ Result := 0;
+
+ // just SInt16 stereo support for now
+ if ((Engine.GetAudioFormatInfo().Format <> asfS16) or
+ (Engine.GetAudioFormatInfo().Channels <> 2)) then
+ begin
+ Exit;
+ end;
+
+ // zero memory
+ FillChar(Data, SizeOf(Data), 0);
+
+ // TODO: At the moment just the first samples of the SampleBuffer
+ // are returned, even if there is newer data in the upper samples.
+
+ LockSampleBuffer();
+ ByteCount := Min(SizeOf(Data), SampleBufferCount);
+ if (ByteCount > 0) then
+ begin
+ Move(SampleBuffer[0], Data, ByteCount);
+ end;
+ UnlockSampleBuffer();
+
+ Result := ByteCount div SizeOf(TPCMStereoSample);
+end;
+
+procedure TGenericPlaybackStream.GetFFTData(var Data: TFFTData);
+var
+ i: integer;
+ Frames: integer;
+ DataIn: PSingleArray;
+ AudioFormat: TAudioFormatInfo;
+begin
+ // only works with SInt16 and Float values at the moment
+ AudioFormat := GetAudioFormatInfo();
+
+ DataIn := AllocMem(FFTSize * SizeOf(Single));
+ if (DataIn = nil) then
+ Exit;
+
+ LockSampleBuffer();
+ // TODO: We just use the first Frames frames, the others are ignored.
+ Frames := Min(FFTSize, SampleBufferCount div AudioFormat.FrameSize);
+ // use only first channel and convert data to float-values
+ case AudioFormat.Format of
+ asfS16:
+ begin
+ for i := 0 to Frames-1 do
+ DataIn[i] := PSmallInt(@SampleBuffer[i*AudioFormat.FrameSize])^ / -Low(SmallInt);
+ end;
+ asfFloat:
+ begin
+ for i := 0 to Frames-1 do
+ DataIn[i] := PSingle(@SampleBuffer[i*AudioFormat.FrameSize])^;
+ end;
+ end;
+ UnlockSampleBuffer();
+
+ WindowFunc(fwfHanning, FFTSize, DataIn);
+ PowerSpectrum(FFTSize, DataIn, @Data);
+ FreeMem(DataIn);
+
+ // resize data to a 0..1 range
+ for i := 0 to High(TFFTData) do
+ begin
+ Data[i] := Sqrt(Data[i]) / 100;
+ end;
+end;
+
+procedure TGenericPlaybackStream.AddSoundEffect(Effect: TSoundEffect);
+begin
+ if (not assigned(Effect)) then
+ Exit;
+
+ LockSampleBuffer();
+ // check if effect is already in list to avoid duplicates
+ if (SoundEffects.IndexOf(Pointer(Effect)) = -1) then
+ SoundEffects.Add(Pointer(Effect));
+ UnlockSampleBuffer();
+end;
+
+procedure TGenericPlaybackStream.RemoveSoundEffect(Effect: TSoundEffect);
+begin
+ LockSampleBuffer();
+ SoundEffects.Remove(Effect);
+ UnlockSampleBuffer();
+end;
+
+function TGenericPlaybackStream.GetPosition: real;
+var
+ BufferedTime: double;
+begin
+ if assigned(SourceStream) then
+ begin
+ LockSampleBuffer();
+
+ // calc the time of source data that is buffered (in the SampleBuffer and SourceBuffer)
+ // but not yet outputed
+ BufferedTime := (SampleBufferCount - SampleBufferPos) / Engine.FormatInfo.BytesPerSec +
+ SourceBufferCount / SourceStream.GetAudioFormatInfo().BytesPerSec;
+ // and subtract it from the source position
+ Result := SourceStream.Position - BufferedTime;
+
+ UnlockSampleBuffer();
+ end
+ else
+ begin
+ Result := -1;
+ end;
+end;
+
+procedure TGenericPlaybackStream.SetPosition(Time: real);
+begin
+ if assigned(SourceStream) then
+ begin
+ LockSampleBuffer();
+
+ SourceStream.Position := Time;
+ if (Status = ssStopped) then
+ NeedsRewind := false;
+ // do not use outdated data
+ FlushBuffers();
+
+ AvgSyncDiff := -1;
+
+ UnlockSampleBuffer();
+ end;
+end;
+
+function TGenericPlaybackStream.GetVolume(): single;
+var
+ FadeAmount: Single;
+begin
+ LockSampleBuffer();
+ // adjust volume if fading is enabled
+ if (FadeInTime > 0) then
+ begin
+ FadeAmount := (SDL_GetTicks() - FadeInStartTime) / FadeInTime;
+ // check if fade-target is reached
+ if (FadeAmount >= 1) then
+ begin
+ // target reached -> stop fading
+ FadeInTime := 0;
+ fVolume := FadeInTargetVolume;
+ end
+ else
+ begin
+ // fading in progress
+ fVolume := FadeAmount*FadeInTargetVolume + (1-FadeAmount)*FadeInStartVolume;
+ end;
+ end;
+ // return current volume
+ Result := fVolume;
+ UnlockSampleBuffer();
+end;
+
+procedure TGenericPlaybackStream.SetVolume(Volume: single);
+begin
+ LockSampleBuffer();
+ // stop fading
+ FadeInTime := 0;
+ // clamp volume
+ if (Volume > 1.0) then
+ fVolume := 1.0
+ else if (Volume < 0) then
+ fVolume := 0
+ else
+ fVolume := Volume;
+ UnlockSampleBuffer();
+end;
+
+
+{ TGenericVoiceStream }
+
+constructor TGenericVoiceStream.Create(Engine: TAudioPlayback_SoftMixer);
+begin
+ inherited Create();
+ Self.Engine := Engine;
+end;
+
+function TGenericVoiceStream.Open(ChannelMap: integer; FormatInfo: TAudioFormatInfo): boolean;
+var
+ BufferSize: integer;
+begin
+ Result := false;
+
+ Close();
+
+ if (not inherited Open(ChannelMap, FormatInfo)) then
+ Exit;
+
+ // Note:
+ // - use Self.FormatInfo instead of FormatInfo as the latter one might have a
+ // channel size of 2.
+ // - the buffer-size must be a multiple of the FrameSize
+ BufferSize := (Ceil(MAX_VOICE_DELAY * Self.FormatInfo.BytesPerSec) div Self.FormatInfo.FrameSize) *
+ Self.FormatInfo.FrameSize;
+ VoiceBuffer := TRingBuffer.Create(BufferSize);
+
+ BufferLock := SDL_CreateMutex();
+
+
+ // create a matching playback stream for the voice-stream
+ PlaybackStream := TGenericPlaybackStream.Create(Engine);
+ // link voice- and playback-stream
+ if (not PlaybackStream.Open(Self)) then
+ begin
+ PlaybackStream.Free;
+ Exit;
+ end;
+
+ // start voice passthrough
+ PlaybackStream.Play();
+
+ Result := true;
+end;
+
+procedure TGenericVoiceStream.Close();
+begin
+ // stop and free the playback stream
+ FreeAndNil(PlaybackStream);
+
+ // free data
+ FreeAndNil(VoiceBuffer);
+ if (BufferLock <> nil) then
+ SDL_DestroyMutex(BufferLock);
+
+ inherited Close();
+end;
+
+procedure TGenericVoiceStream.WriteData(Buffer: PChar; BufferSize: integer);
+begin
+ // lock access to buffer
+ SDL_mutexP(BufferLock);
+ try
+ if (VoiceBuffer = nil) then
+ Exit;
+ VoiceBuffer.Write(Buffer, BufferSize);
+ finally
+ SDL_mutexV(BufferLock);
+ end;
+end;
+
+function TGenericVoiceStream.ReadData(Buffer: PChar; BufferSize: integer): integer;
+begin
+ Result := -1;
+
+ // lock access to buffer
+ SDL_mutexP(BufferLock);
+ try
+ if (VoiceBuffer = nil) then
+ Exit;
+ Result := VoiceBuffer.Read(Buffer, BufferSize);
+ finally
+ SDL_mutexV(BufferLock);
+ end;
+end;
+
+function TGenericVoiceStream.IsEOF(): boolean;
+begin
+ SDL_mutexP(BufferLock);
+ Result := (VoiceBuffer = nil);
+ SDL_mutexV(BufferLock);
+end;
+
+function TGenericVoiceStream.IsError(): boolean;
+begin
+ Result := false;
+end;
+
+
+{ TAudioPlayback_SoftMixer }
+
+function TAudioPlayback_SoftMixer.InitializePlayback: boolean;
+begin
+ Result := false;
+
+ //Log.LogStatus('InitializePlayback', 'UAudioPlayback_SoftMixer');
+
+ if(not InitializeAudioPlaybackEngine()) then
+ Exit;
+
+ MixerStream := TAudioMixerStream.Create(Self);
+
+ if(not StartAudioPlaybackEngine()) then
+ Exit;
+
+ Result := true;
+end;
+
+function TAudioPlayback_SoftMixer.FinalizePlayback: boolean;
+begin
+ Close;
+ StopAudioPlaybackEngine();
+
+ FreeAndNil(MixerStream);
+ FreeAndNil(FormatInfo);
+
+ FinalizeAudioPlaybackEngine();
+ inherited FinalizePlayback;
+ Result := true;
+end;
+
+procedure TAudioPlayback_SoftMixer.AudioCallback(Buffer: PChar; Size: integer);
+begin
+ MixerStream.ReadData(Buffer, Size);
+end;
+
+function TAudioPlayback_SoftMixer.GetMixer(): TAudioMixerStream;
+begin
+ Result := MixerStream;
+end;
+
+function TAudioPlayback_SoftMixer.GetAudioFormatInfo(): TAudioFormatInfo;
+begin
+ Result := FormatInfo;
+end;
+
+function TAudioPlayback_SoftMixer.CreatePlaybackStream(): TAudioPlaybackStream;
+begin
+ Result := TGenericPlaybackStream.Create(Self);
+end;
+
+function TAudioPlayback_SoftMixer.CreateVoiceStream(ChannelMap: integer; FormatInfo: TAudioFormatInfo): TAudioVoiceStream;
+var
+ VoiceStream: TGenericVoiceStream;
+begin
+ Result := nil;
+
+ // create a voice stream
+ VoiceStream := TGenericVoiceStream.Create(Self);
+ if (not VoiceStream.Open(ChannelMap, FormatInfo)) then
+ begin
+ VoiceStream.Free;
+ Exit;
+ end;
+
+ Result := VoiceStream;
+end;
+
+procedure TAudioPlayback_SoftMixer.SetAppVolume(Volume: single);
+begin
+ // sets volume only for this application
+ MixerStream.Volume := Volume;
+end;
+
+procedure TAudioPlayback_SoftMixer.MixBuffers(DstBuffer, SrcBuffer: PChar; Size: Cardinal; Volume: Single);
+var
+ SampleIndex: Cardinal;
+ SampleInt: Integer;
+ SampleFlt: Single;
+begin
+ SampleIndex := 0;
+ case FormatInfo.Format of
+ asfS16:
+ begin
+ while (SampleIndex < Size) do
+ begin
+ // apply volume and sum with previous mixer value
+ SampleInt := PSmallInt(@DstBuffer[SampleIndex])^ +
+ Round(PSmallInt(@SrcBuffer[SampleIndex])^ * Volume);
+ // clip result
+ if (SampleInt > High(SmallInt)) then
+ SampleInt := High(SmallInt)
+ else if (SampleInt < Low(SmallInt)) then
+ SampleInt := Low(SmallInt);
+ // assign result
+ PSmallInt(@DstBuffer[SampleIndex])^ := SampleInt;
+ // increase index by one sample
+ Inc(SampleIndex, SizeOf(SmallInt));
+ end;
+ end;
+ asfFloat:
+ begin
+ while (SampleIndex < Size) do
+ begin
+ // apply volume and sum with previous mixer value
+ SampleFlt := PSingle(@DstBuffer[SampleIndex])^ +
+ PSingle(@SrcBuffer[SampleIndex])^ * Volume;
+ // clip result
+ if (SampleFlt > 1.0) then
+ SampleFlt := 1.0
+ else if (SampleFlt < -1.0) then
+ SampleFlt := -1.0;
+ // assign result
+ PSingle(@DstBuffer[SampleIndex])^ := SampleFlt;
+ // increase index by one sample
+ Inc(SampleIndex, SizeOf(Single));
+ end;
+ end;
+ else
+ begin
+ Log.LogError('Incompatible format', 'TAudioMixerStream.MixAudio');
+ end;
+ end;
+end;
+
+end.
diff --git a/src/base/UCatCovers.pas b/src/base/UCatCovers.pas
new file mode 100644
index 00000000..d8f6cdb0
--- /dev/null
+++ b/src/base/UCatCovers.pas
@@ -0,0 +1,173 @@
+unit UCatCovers;
+/////////////////////////////////////////////////////////////////////////
+// UCatCovers by Whiteshark //
+// Class for listing and managing the Category Covers //
+/////////////////////////////////////////////////////////////////////////
+
+interface
+
+{$I switches.inc}
+
+uses UIni;
+
+type
+ TCatCovers = class
+ protected
+ cNames: array [0..high(ISorting)] of array of string;
+ cFiles: array [0..high(ISorting)] of array of string;
+ public
+ constructor Create;
+ procedure Load; //Load Cover aus Cover.ini and Cover Folder
+ procedure LoadPath(const CoversPath: string);
+ procedure Add(Sorting: integer; Name, Filename: string); //Add a Cover
+ function CoverExists(Sorting: integer; Name: string): boolean; //Returns True when a cover with the given Name exists
+ function GetCover(Sorting: integer; Name: string): string; //Returns the Filename of a Cover
+ end;
+
+var
+ CatCovers: TCatCovers;
+
+implementation
+
+uses
+ IniFiles,
+ SysUtils,
+ Classes,
+ // UFiles,
+ UMain,
+ ULog;
+
+constructor TCatCovers.Create;
+begin
+ inherited;
+ Load;
+end;
+
+procedure TCatCovers.Load;
+var
+ I: integer;
+begin
+ for I := 0 to CoverPaths.Count-1 do
+ LoadPath(CoverPaths[I]);
+end;
+
+(**
+ * Load Cover from Cover.ini and Cover Folder
+ *)
+procedure TCatCovers.LoadPath(const CoversPath: string);
+var
+ Ini: TMemIniFile;
+ SR: TSearchRec;
+ List: TStringlist;
+ I, J: Integer;
+ Name, Filename, Temp: string;
+begin
+ Ini := nil;
+ List := nil;
+
+ try
+ Ini := TMemIniFile.Create(CoversPath + 'covers.ini');
+ List := TStringlist.Create;
+
+ //Add every Cover in Covers Ini for Every Sorting option
+ for I := 0 to High(ISorting) do
+ begin
+ Ini.ReadSection(ISorting[I], List);
+
+ for J := 0 to List.Count - 1 do
+ Add(I, List.Strings[J], CoversPath + Ini.ReadString(ISorting[I], List.Strings[J], 'NoCover.jpg'));
+ end;
+ finally
+ Ini.Free;
+ List.Free;
+ end;
+
+ try
+ //Add Covers from Folder
+ if (FindFirst (CoversPath + '*.jpg', faAnyFile, SR) = 0) then
+ repeat
+ //Add Cover if it doesn't exist for every Section
+ Name := SR.Name;
+ Filename := CoversPath + Name;
+ Delete (Name, length(Name) - 3, 4);
+
+ for I := 0 to high(ISorting) do
+ begin
+ Temp := Name;
+ if ((I = sTitle) or (I = sTitle2)) and (Pos ('Title', Temp) <> 0) then
+ Delete (Temp, Pos ('Title', Temp), 5)
+ else if (I = sArtist) or (I = sArtist2) and (Pos ('Artist', Temp) <> 0) then
+ Delete (Temp, Pos ('Artist', Temp), 6);
+
+ if not CoverExists(I, Temp) then
+ Add (I, Temp, Filename);
+ end;
+ until FindNext (SR) <> 0;
+ finally
+ FindClose (SR);
+ end;
+end;
+
+ //Add a Cover
+procedure TCatCovers.Add(Sorting: integer; Name, Filename: string);
+begin
+ if FileExists (Filename) then //If Exists -> Add
+ begin
+ SetLength (CNames[Sorting], Length(CNames[Sorting]) + 1);
+ SetLength (CFiles[Sorting], Length(CNames[Sorting]) + 1);
+
+ CNames[Sorting][high(cNames[Sorting])] := Uppercase(Name);
+ CFiles[Sorting][high(cNames[Sorting])] := FileName;
+ end;
+end;
+
+ //Returns True when a cover with the given Name exists
+function TCatCovers.CoverExists(Sorting: integer; Name: string): boolean;
+var
+ I: Integer;
+begin
+ Result := False;
+ Name := Uppercase(Name); //Case Insensitiv
+
+ for I := 0 to high(cNames[Sorting]) do
+ begin
+ if (cNames[Sorting][I] = Name) then //Found Name
+ begin
+ Result := true;
+ break; //Break For Loop
+ end;
+ end;
+end;
+
+ //Returns the Filename of a Cover
+function TCatCovers.GetCover(Sorting: integer; Name: string): string;
+var
+ I: Integer;
+begin
+ Result := '';
+ Name := Uppercase(Name);
+
+ for I := 0 to high(cNames[Sorting]) do
+ begin
+ if cNames[Sorting][I] = Name then
+ begin
+ Result := cFiles[Sorting][I];
+ Break;
+ end;
+ end;
+
+ //No Cover
+ if (Result = '') then
+ begin
+ for I := 0 to CoverPaths.Count-1 do
+ begin
+ if (FileExists(CoverPaths[I] + 'NoCover.jpg')) then
+ begin
+ Result := CoverPaths[I] + 'NoCover.jpg';
+ Break;
+ end;
+ end;
+ end;
+end;
+
+end.
diff --git a/src/base/UCommandLine.pas b/src/base/UCommandLine.pas
new file mode 100644
index 00000000..8bdc4f5a
--- /dev/null
+++ b/src/base/UCommandLine.pas
@@ -0,0 +1,334 @@
+unit UCommandLine;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+
+type
+ //-----------
+ // TCMDParams - Class Reads Infos from ParamStr and set some easy Interface Variables
+ //-----------
+ TCMDParams = class
+ private
+ sLanguage: String;
+ sResolution: String;
+ public
+ //Some Boolean Variables Set when Reading Infos
+ Debug: Boolean;
+ Benchmark: Boolean;
+ NoLog: Boolean;
+ FullScreen: Boolean;
+ Joypad: Boolean;
+
+ //Some Value Variables Set when Reading Infos {-1: Not Set, others: Value}
+ Depth: Integer;
+ Screens: Integer;
+
+ //Some Strings Set when Reading Infos {Length=0 Not Set}
+ SongPath: String;
+ ConfigFile: String;
+ ScoreFile: String;
+
+ procedure showhelp();
+
+ //Pseudo Integer Values
+ Function GetLanguage: Integer;
+ Property Language: Integer read GetLanguage;
+
+ Function GetResolution: Integer;
+ Property Resolution: Integer read GetResolution;
+
+ //Some Procedures for Reading Infos
+ Constructor Create;
+
+ Procedure ResetVariables;
+ Procedure ReadParamInfo;
+ end;
+
+var
+ Params: TCMDParams;
+
+const
+ cHelp = 'help';
+ cDebug = 'debug';
+ cMediaInterfaces = 'showinterfaces';
+
+
+implementation
+
+uses SysUtils,
+ uPlatform;
+// uINI -- Nasty requirement... ( removed with permission of blindy )
+
+
+//-------------
+// Constructor - Create class, Reset Variables and Read Infos
+//-------------
+Constructor TCMDParams.Create;
+begin
+ inherited;
+
+ if FindCmdLineSwitch( cHelp ) or FindCmdLineSwitch( 'h' ) then
+ showhelp();
+
+ ResetVariables;
+ ReadParamInfo;
+end;
+
+procedure TCMDParams.showhelp();
+
+ function s( aString : String ) : string;
+ begin
+ result := aString + StringofChar( ' ', 15 - length( aString ) );
+ end;
+
+begin
+
+ writeln( '' );
+ writeln( '**************************************************************' );
+ writeln( ' UltraStar Deluxe - Command line switches ' );
+ writeln( '**************************************************************' );
+ writeln( '' );
+ writeln( ' '+s( 'Switch' ) +' : Purpose' );
+ writeln( ' ----------------------------------------------------------' );
+ writeln( ' '+s( cMediaInterfaces ) + #9 + ' : Show in-use media interfaces' );
+ writeln( ' '+s( cDebug ) + #9 + ' : Display Debugging info' );
+ writeln( '' );
+
+ platform.halt;
+end;
+
+//-------------
+// ResetVariables - Reset Class Variables
+//-------------
+Procedure TCMDParams.ResetVariables;
+begin
+ Debug := False;
+ Benchmark := False;
+ NoLog := False;
+ FullScreen := False;
+ Joypad := False;
+
+ //Some Value Variables Set when Reading Infos {-1: Not Set, others: Value}
+ sResolution := '';
+ sLanguage := '';
+ Depth := -1;
+ Screens := -1;
+
+ //Some Strings Set when Reading Infos {Length=0 Not Set}
+ SongPath := '';
+ ConfigFile := '';
+ ScoreFile := '';
+end;
+
+//-------------
+// ReadParamInfo - Read Infos from Parameters
+//-------------
+Procedure TCMDParams.ReadParamInfo;
+var
+ I: Integer;
+ PCount: Integer;
+ Command: String;
+begin
+ PCount := ParamCount;
+ //Log.LogError('ParamCount: ' + Inttostr(PCount));
+
+
+ //Check all Parameters
+ For I := 1 to PCount do
+ begin
+ Command := Paramstr(I);
+ //Log.LogError('Start parsing Command: ' + Command);
+ //Is String Parameter ?
+ if (Length(Command) > 1) AND (Command[1] = '-') then
+ begin
+ //Remove - from Command
+ Command := Lowercase(Trim(Copy(Command, 2, Length(Command) - 1)));
+ //Log.LogError('Command prepared: ' + Command);
+
+ //Check Command
+
+ // Boolean Triggers:
+ if (Command = 'debug') then
+ Debug := True
+ else if (Command = 'benchmark') then
+ Benchmark := True
+ else if (Command = 'nolog') then
+ NoLog := True
+ else if (Command = 'fullscreen') then
+ Fullscreen := True
+ else if (Command = 'window') then
+ Fullscreen := False
+ else if (Command = 'joypad') then
+ Joypad := True
+
+ //Integer Variables
+ else if (Command = 'depth') then
+ begin
+ //Check if there is another Parameter to get the Value from
+ if (PCount > I) then
+ begin
+ Command := ParamStr(I + 1);
+
+ //Check for valid Value
+ If (Command = '16') then
+ Depth := 0
+ Else If (Command = '32') then
+ Depth := 1;
+ end;
+ end
+
+ else if (Command = 'screens') then
+ begin
+ //Check if there is another Parameter to get the Value from
+ if (PCount > I) then
+ begin
+ Command := ParamStr(I + 1);
+
+ //Check for valid Value
+ If (Command = '1') then
+ Screens := 0
+ Else If (Command = '2') then
+ Screens := 1;
+ end;
+ end
+
+ //Pseudo Integer Values
+ else if (Command = 'language') then
+ begin
+ //Check if there is another Parameter to get the Value from
+ if (PCount > I) then
+ begin
+ //Write Value to String
+ sLanguage := Lowercase(ParamStr(I + 1));
+ end;
+ end
+
+ else if (Command = 'resolution') then
+ begin
+ //Check if there is another Parameter to get the Value from
+ if (PCount > I) then
+ begin
+ //Write Value to String
+ sResolution := Lowercase(ParamStr(I + 1));
+ end;
+ end
+
+ //String Values
+ else if (Command = 'songpath') then
+ begin
+ //Check if there is another Parameter to get the Value from
+ if (PCount > I) then
+ begin
+ //Write Value to String
+ SongPath := ParamStr(I + 1);
+ end;
+ end
+
+ else if (Command = 'configfile') then
+ begin
+ //Check if there is another Parameter to get the Value from
+ if (PCount > I) then
+ begin
+ //Write Value to String
+ ConfigFile := ParamStr(I + 1);
+
+ //is this a relative PAth -> then add Gamepath
+ if Not ((Length(ConfigFile) > 2) AND (ConfigFile[2] = ':')) then
+ ConfigFile := ExtractFilePath(ParamStr(0)) + Configfile;
+ end;
+ end
+
+ else if (Command = 'scorefile') then
+ begin
+ //Check if there is another Parameter to get the Value from
+ if (PCount > I) then
+ begin
+ //Write Value to String
+ ScoreFile := ParamStr(I + 1);
+ end;
+ end;
+
+ end;
+
+ end;
+
+{ Log.LogError('Values: ');
+
+ if Debug then
+ Log.LogError('Debug');
+
+ if Benchmark then
+ Log.LogError('Benchmark');
+
+ if NoLog then
+ Log.LogError('NoLog');
+
+ if Fullscreen then
+ Log.LogError('FullScreen');
+
+ if JoyStick then
+ Log.LogError('Joystick');
+
+
+ Log.LogError('Screens: ' + Inttostr(Screens));
+ Log.LogError('Depth: ' + Inttostr(Depth));
+
+ Log.LogError('Resolution: ' + Inttostr(Resolution));
+ Log.LogError('Resolution: ' + Inttostr(Language));
+
+ Log.LogError('sResolution: ' + sResolution);
+ Log.LogError('sLanguage: ' + sLanguage);
+
+ Log.LogError('ConfigFile: ' + ConfigFile);
+ Log.LogError('SongPath: ' + SongPath);
+ Log.LogError('ScoreFile: ' + ScoreFile); }
+
+end;
+
+//-------------
+// GetLanguage - Get Language ID from saved String Information
+//-------------
+Function TCMDParams.GetLanguage: Integer;
+var
+ I: integer;
+begin
+ Result := -1;
+{* JB - 12sep07 to remove uINI dependency
+
+ //Search for Language
+ For I := 0 to high(ILanguage) do
+ if (LowerCase(ILanguage[I]) = sLanguage) then
+ begin
+ Result := I;
+ Break;
+ end;
+*}
+end;
+
+//-------------
+// GetResolution - Get Resolution ID from saved String Information
+//-------------
+Function TCMDParams.GetResolution: Integer;
+var
+ I: integer;
+begin
+ Result := -1;
+{* JB - 12sep07 to remove uINI dependency
+
+ //Search for Resolution
+ For I := 0 to high(IResolution) do
+ if (LowerCase(IResolution[I]) = sResolution) then
+ begin
+ Result := I;
+ Break;
+ end;
+*}
+end;
+
+end.
diff --git a/src/base/UCommon.pas b/src/base/UCommon.pas
new file mode 100644
index 00000000..41e3c1f1
--- /dev/null
+++ b/src/base/UCommon.pas
@@ -0,0 +1,774 @@
+unit UCommon;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+uses
+ SysUtils,
+ Classes,
+ {$IFDEF MSWINDOWS}
+ Windows,
+ {$ENDIF}
+ sdl,
+ UConfig,
+ ULog;
+
+type
+ TMessageType = ( mtInfo, mtError );
+
+procedure ShowMessage( const msg : String; msgType: TMessageType = mtInfo );
+
+procedure ConsoleWriteLn(const msg: string);
+
+function GetResourceStream(const aName, aType : string): TStream;
+function RWopsFromStream(Stream: TStream): PSDL_RWops;
+
+{$IFDEF FPC}
+function RandomRange(aMin: Integer; aMax: Integer) : Integer;
+{$ENDIF}
+
+function StringReplaceW(text : WideString; search, rep: WideChar):WideString;
+function AdaptFilePaths( const aPath : widestring ): widestring;
+
+procedure DisableFloatingPointExceptions();
+procedure SetDefaultNumericLocale();
+procedure RestoreNumericLocale();
+
+{$IFNDEF MSWINDOWS}
+ procedure ZeroMemory( Destination: Pointer; Length: DWORD );
+ function MakeLong(a, b: Word): Longint;
+ (*
+ #define LOBYTE(a) (BYTE)(a)
+ #define HIBYTE(a) (BYTE)((a)>>8)
+ #define LOWORD(a) (WORD)(a)
+ #define HIWORD(a) (WORD)((a)>>16)
+ #define MAKEWORD(a,b) (WORD)(((a)&0xff)|((b)<<8))
+ *)
+{$ENDIF}
+
+function FileExistsInsensitive(var FileName: string): boolean;
+
+(*
+ * Character classes
+ *)
+
+function IsAlphaChar(ch: WideChar): boolean;
+function IsNumericChar(ch: WideChar): boolean;
+function IsAlphaNumericChar(ch: WideChar): boolean;
+function IsPunctuationChar(ch: WideChar): boolean;
+function IsControlChar(ch: WideChar): boolean;
+
+// A stable alternative to TList.Sort() (use TList.Sort() if applicable, see below)
+procedure MergeSort(List: TList; CompareFunc: TListSortCompare);
+
+function GetAlignedMem(Size: cardinal; Alignment: integer): Pointer;
+procedure FreeAlignedMem(P: Pointer);
+
+
+implementation
+
+uses
+ Math,
+ {$IFDEF Delphi}
+ Dialogs,
+ {$ENDIF}
+ UMain;
+
+
+// data used by the ...Locale() functions
+{$IFDEF LINUX}
+
+var
+ PrevNumLocale: string;
+
+const
+ LC_NUMERIC = 1;
+
+function setlocale(category: integer; locale: pchar): pchar; cdecl; external 'c' name 'setlocale';
+
+{$ENDIF}
+
+// In Linux and maybe MacOSX some units (like cwstring) call setlocale(LC_ALL, '')
+// to set the language/country specific locale (e.g. charset) for this application.
+// Unfortunately, LC_NUMERIC is set by this call too.
+// It defines the decimal-separator and other country-specific numeric settings.
+// This parameter is used by the C string-to-float parsing functions atof() and strtod().
+// After changing LC_NUMERIC some external C-based libs (like projectM) are not
+// able to parse strings correctly
+// (e.g. in Germany "0.9" is not recognized as a valid number anymore but "0,9" is).
+// So we reset the numeric settings to the default ('C').
+// Note: The behaviour of Pascal parsing functions (e.g. strtofloat()) is not
+// changed by this because it doesn't use the locale-settings.
+// TODO:
+// - Check if this is needed in MacOSX (at least the locale is set in cwstring)
+// - Find out which libs are concerned by this problem.
+// If only projectM is concerned by this problem set and restore the numeric locale
+// for each call to projectM instead of changing it globally.
+procedure SetDefaultNumericLocale();
+begin
+ {$ifdef LINUX}
+ PrevNumLocale := setlocale(LC_NUMERIC, nil);
+ setlocale(LC_NUMERIC, 'C');
+ {$endif}
+end;
+
+procedure RestoreNumericLocale();
+begin
+ {$ifdef LINUX}
+ setlocale(LC_NUMERIC, PChar(PrevNumLocale));
+ {$endif}
+end;
+
+(*
+ * If an invalid floating point operation was performed the Floating-point unit (FPU)
+ * generates a Floating-point exception (FPE). Dependending on the settings in
+ * the FPU's control-register (interrupt mask) the FPE is handled by the FPU itself
+ * (we will call this as "FPE disabled" later on) or is passed to the application
+ * (FPE enabled).
+ * If FPEs are enabled a floating-point division by zero (e.g. 10.0 / 0.0) is
+ * considered an error and an exception is thrown. Otherwise the FPU will handle
+ * the error and return the result infinity (INF) (10.0 / 0.0 = INF) without
+ * throwing an error to the application.
+ * The same applies to a division by INF that either raises an exception
+ * (FPE enabled) or returns 0.0 (FPE disabled).
+ * Normally (as with C-programs), Floating-point exceptions (FPE) are DISABLED
+ * on program startup (at least with Intel CPUs), but for some strange reasons
+ * they are ENABLED in pascal (both delphi and FPC) by default.
+ * Many libs operating with floating-point values rely heavily on the C-specific
+ * behaviour. So using them in delphi is a ticking time-bomb because sooner or
+ * later they will crash because of an FPE (this problem occurs massively
+ * in OpenGL-based libs like projectM). In contrast to this no error will occur
+ * if the lib is linked to a C-program.
+ *
+ * Further info on FPUs:
+ * For x86 and x86_64 CPUs we have to consider two FPU instruction sets.
+ * The math co-processor i387 (aka 8087 or x87) set introduced with the i386
+ * and SSE (Streaming SIMD Extensions) introduced with the Pentium3.
+ * Both of them have separate control-registers (x87: FPUControlWord, SSE: MXCSR)
+ * to control FPEs. Either has (among others) 6bits to enable/disable several
+ * exception types (Invalid,Denormalized,Zero,Overflow,Underflow,Precision).
+ * Those exception-types must all be masked (=1) to get the default C behaviour.
+ * The control-registers can be set with the asm-ops FLDCW (x87) and LDMXCSR (SSE).
+ * Instead of using assembler code, we can use Set8087CW() provided by delphi and
+ * FPC to set the x87 control-word. FPC also provides SetSSECSR() for SSE's MXCSR.
+ * Note that both Delphi and FPC enable FPEs (e.g. for div-by-zero) on program
+ * startup but only FPC enables FPEs (especially div-by-zero) for SSE too.
+ * So we have to mask FPEs for x87 in Delphi and FPC and for SSE in FPC only.
+ * FPC and Delphi both provide a SetExceptionMask() for control of the FPE
+ * mask. SetExceptionMask() sets the masks for x87 in Delphi and for x87 and SSE
+ * in FPC (seems as if Delphi [2005] is not SSE aware). So SetExceptionMask()
+ * is what we need and it even is plattform and CPU independent.
+ *
+ * Pascal OpenGL headers (like the Delphi standard ones or JEDI-SDL headers)
+ * already call Set8087CW() to disable FPEs but due to some bugs in the JEDI-SDL
+ * headers they do not work properly with FPC. I already patched them, so they
+ * work at least until they are updated the next time. In addition Set8086CW()
+ * does not suffice to disable FPEs because the SSE FPEs are not disabled by this.
+ * FPEs with SSE are a big problem with some libs because many linux distributions
+ * optimize code for SSE or Pentium3 (for example: int(INF) which convert the
+ * double value "infinity" to an integer might be automatically optimized by
+ * using SSE's CVTSD2SI instruction). So SSE FPEs must be turned off in any case
+ * to make USDX portable.
+ *
+ * Summary:
+ * Call this function on initialization to make sure FPEs are turned off.
+ * It will solve a lot of errors with FPEs in external libs.
+ *)
+procedure DisableFloatingPointExceptions();
+begin
+ (*
+ // We will use SetExceptionMask() instead of Set8087CW()/SetSSECSR().
+ // Note: Leave these lines for documentation purposes just in case
+ // SetExceptionMask() does not work anymore (due to bugs in FPC etc.).
+ {$IF Defined(CPU386) or Defined(CPUI386) or Defined(CPUX86_64)}
+ Set8087CW($133F);
+ {$IFEND}
+ {$IF Defined(FPC)}
+ if (has_sse_support) then
+ SetSSECSR($1F80);
+ {$IFEND}
+ *)
+
+ // disable all of the six FPEs (x87 and SSE) to be compatible with C/C++ and
+ // other libs which rely on the standard FPU behaviour (no div-by-zero FPE anymore).
+ SetExceptionMask([exInvalidOp, exDenormalized, exZeroDivide,
+ exOverflow, exUnderflow, exPrecision]);
+end;
+
+function StringReplaceW(text : WideString; search, rep: WideChar) : WideString;
+var
+ iPos : integer;
+// sTemp : WideString;
+begin
+(*
+ result := text;
+ iPos := Pos(search, result);
+ while (iPos > 0) do
+ begin
+ sTemp := copy(result, iPos + length(search), length(result));
+ result := copy(result, 1, iPos - 1) + rep + sTEmp;
+ iPos := Pos(search, result);
+ end;
+*)
+ result := text;
+
+ if search = rep then
+ exit;
+
+ for iPos := 1 to length(result) do
+ begin
+ if result[iPos] = search then
+ result[iPos] := rep;
+ end;
+end;
+
+function AdaptFilePaths( const aPath : widestring ): widestring;
+begin
+ result := StringReplaceW( aPath, '\', PathDelim );//, [rfReplaceAll] );
+end;
+
+
+{$IFNDEF MSWINDOWS}
+procedure ZeroMemory( Destination: Pointer; Length: DWORD );
+begin
+ FillChar( Destination^, Length, 0 );
+end;
+
+function MakeLong(A, B: Word): Longint;
+begin
+ Result := (LongInt(B) shl 16) + A;
+end;
+
+(*
+function QueryPerformanceCounter(lpPerformanceCount:TLARGEINTEGER):Bool;
+
+ // From http://en.wikipedia.org/wiki/RDTSC
+ function RDTSC: Int64; register;
+ asm
+ rdtsc
+ end;
+
+begin
+ // Use clock_gettime(CLOCK_REALTIME, ...) here (but not from the libc unit)
+ lpPerformanceCount := RDTSC();
+ result := true;
+end;
+
+function QueryPerformanceFrequency(lpFrequency:TLARGEINTEGER):Bool;
+begin
+ // clock_getres(CLOCK_REALTIME, ...)
+ lpFrequency := 0;
+ result := true;
+end;
+*)
+{$ENDIF}
+
+// Checks if a regular files or directory with the given name exists.
+// The comparison is case insensitive.
+function FileExistsInsensitive(var FileName: string): boolean;
+var
+ FilePath, LocalFileName: string;
+ SearchInfo: TSearchRec;
+begin
+{$IFDEF LINUX} // eddie: Changed FPC to LINUX: Windows and Mac OS X dont have case sensitive file systems
+ // speed up standard case
+ if FileExists(FileName) then
+ begin
+ Result := true;
+ exit;
+ end;
+
+ Result := false;
+
+ FilePath := ExtractFilePath(FileName);
+ if (FindFirst(FilePath+'*', faAnyFile, SearchInfo) = 0) then
+ begin
+ LocalFileName := ExtractFileName(FileName);
+ repeat
+ if (AnsiSameText(LocalFileName, SearchInfo.Name)) then
+ begin
+ FileName := FilePath + SearchInfo.Name;
+ Result := true;
+ break;
+ end;
+ until (FindNext(SearchInfo) <> 0);
+ end;
+ FindClose(SearchInfo);
+{$ELSE}
+ Result := FileExists(FileName);
+{$ENDIF}
+end;
+
+
+{$IFDEF Unix}
+ // include resource-file info (stored in the constant array "resources")
+ {$I ../resource.inc}
+{$ENDIF}
+
+function GetResourceStream(const aName, aType: string): TStream;
+{$IFDEF Unix}
+var
+ ResIndex: integer;
+ Filename: string;
+{$ENDIF}
+begin
+ Result := nil;
+
+ {$IFDEF Unix}
+ for ResIndex := 0 to High(resources) do
+ begin
+ if (resources[ResIndex][0] = aName ) and
+ (resources[ResIndex][1] = aType ) then
+ begin
+ try
+ Filename := ResourcesPath + resources[ResIndex][2];
+ Result := TFileStream.Create(Filename, fmOpenRead);
+ except
+ Log.LogError('Failed to open: "'+ resources[ResIndex][2] +'"', 'GetResourceStream');
+ end;
+ exit;
+ end;
+ end;
+ {$ELSE}
+ try
+ Result := TResourceStream.Create(HInstance, aName , PChar(aType));
+ except
+ Log.LogError('Invalid resource: "'+ aType + ':' + aName +'"', 'GetResourceStream');
+ end;
+ {$ENDIF}
+end;
+
+// +++++++++++++++++++++ helpers for RWOpsFromStream() +++++++++++++++
+ function SdlStreamSeek( context : PSDL_RWops; offset : Integer; whence : Integer ) : integer; cdecl;
+ var
+ stream : TStream;
+ origin : Word;
+ begin
+ stream := TStream( context.unknown );
+ if ( stream = nil ) then
+ raise EInvalidContainer.Create( 'SDLStreamSeek on nil' );
+ case whence of
+ 0 : origin := soFromBeginning; // Offset is from the beginning of the resource. Seek moves to the position Offset. Offset must be >= 0.
+ 1 : origin := soFromCurrent; // Offset is from the current position in the resource. Seek moves to Position + Offset.
+ 2 : origin := soFromEnd;
+ else
+ origin := soFromBeginning; // just in case
+ end;
+ Result := stream.Seek( offset, origin );
+ end;
+
+ function SdlStreamRead( context : PSDL_RWops; Ptr : Pointer; size : Integer; maxnum: Integer ) : Integer; cdecl;
+ var
+ stream : TStream;
+ begin
+ stream := TStream( context.unknown );
+ if ( stream = nil ) then
+ raise EInvalidContainer.Create( 'SDLStreamRead on nil' );
+ try
+ Result := stream.read( Ptr^, Size * maxnum ) div size;
+ except
+ Result := -1;
+ end;
+ end;
+
+ function SDLStreamClose( context : PSDL_RWops ) : Integer; cdecl;
+ var
+ stream : TStream;
+ begin
+ stream := TStream( context.unknown );
+ if ( stream = nil ) then
+ raise EInvalidContainer.Create( 'SDLStreamClose on nil' );
+ stream.Free;
+ Result := 1;
+ end;
+// -----------------------------------------------
+
+(*
+ * Creates an SDL_RWops handle from a TStream.
+ * The stream and RWops must be freed by the user after usage.
+ * Use SDL_FreeRW(...) to free the RWops data-struct.
+ *)
+function RWopsFromStream(Stream: TStream): PSDL_RWops;
+begin
+ Result := SDL_AllocRW();
+ if (Result = nil) then
+ Exit;
+
+ // set RW-callbacks
+ with Result^ do
+ begin
+ unknown := TUnknown(Stream);
+ seek := SDLStreamSeek;
+ read := SDLStreamRead;
+ write := nil;
+ close := SDLStreamClose;
+ type_ := 2;
+ end;
+end;
+
+
+
+{$IFDEF FPC}
+function RandomRange(aMin: Integer; aMax: Integer) : Integer;
+begin
+ RandomRange := Random(aMax-aMin) + aMin ;
+end;
+{$ENDIF}
+
+
+{$IFDEF FPC}
+var
+ MessageList: TStringList;
+ ConsoleHandler: TThreadID;
+ // Note: TRTLCriticalSection is defined in the units System and Libc, use System one
+ ConsoleCriticalSection: System.TRTLCriticalSection;
+ ConsoleEvent: PRTLEvent;
+ ConsoleQuit: boolean;
+{$ENDIF}
+
+(*
+ * Write to console if one is available.
+ * It checks if a console is available before output so it will not
+ * crash on windows if none is available.
+ * Do not use this function directly because it is not thread-safe,
+ * use ConsoleWriteLn() instead.
+ *)
+procedure _ConsoleWriteLn(const aString: string); {$IFDEF HasInline}inline;{$ENDIF}
+begin
+ {$IFDEF MSWINDOWS}
+ // sanity check to avoid crashes with writeln()
+ if (IsConsole) then
+ begin
+ {$ENDIF}
+ Writeln(aString);
+ {$IFDEF MSWINDOWS}
+ end;
+ {$ENDIF}
+end;
+
+{$IFDEF FPC}
+{*
+ * The console-handlers main-function.
+ * TODO: create a quit-event on closing.
+ *}
+function ConsoleHandlerFunc(param: pointer): PtrInt;
+var
+ i: integer;
+ quit: boolean;
+begin
+ quit := false;
+ while (not quit) do
+ begin
+ // wait for new output or quit-request
+ RTLeventWaitFor(ConsoleEvent);
+
+ System.EnterCriticalSection(ConsoleCriticalSection);
+ // output pending messages
+ for i := 0 to MessageList.Count-1 do
+ begin
+ _ConsoleWriteLn(MessageList[i]);
+ end;
+ MessageList.Clear();
+
+ // use local quit-variable to avoid accessing
+ // ConsoleQuit outside of the critical section
+ if (ConsoleQuit) then
+ quit := true;
+
+ RTLeventResetEvent(ConsoleEvent);
+ System.LeaveCriticalSection(ConsoleCriticalSection);
+ end;
+ result := 0;
+end;
+{$ENDIF}
+
+procedure InitConsoleOutput();
+begin
+ {$IFDEF FPC}
+ // init thread-safe output
+ MessageList := TStringList.Create();
+ System.InitCriticalSection(ConsoleCriticalSection);
+ ConsoleEvent := RTLEventCreate();
+ ConsoleQuit := false;
+ // must be a thread managed by FPC. Otherwise (e.g. SDL-thread)
+ // it will crash when using Writeln.
+ ConsoleHandler := BeginThread(@ConsoleHandlerFunc);
+ {$ENDIF}
+end;
+
+procedure FinalizeConsoleOutput();
+begin
+ {$IFDEF FPC}
+ // terminate console-handler
+ System.EnterCriticalSection(ConsoleCriticalSection);
+ ConsoleQuit := true;
+ RTLeventSetEvent(ConsoleEvent);
+ System.LeaveCriticalSection(ConsoleCriticalSection);
+ WaitForThreadTerminate(ConsoleHandler, 0);
+ // free data
+ System.DoneCriticalsection(ConsoleCriticalSection);
+ RTLeventDestroy(ConsoleEvent);
+ MessageList.Free();
+ {$ENDIF}
+end;
+
+{*
+ * With FPC console output is not thread-safe.
+ * Using WriteLn() from external threads (like in SDL callbacks)
+ * will damage the heap and crash the program.
+ * Most probably FPC uses thread-local-data (TLS) to lock a mutex on
+ * the console-buffer. This does not work with external lib's threads
+ * because these do not have the TLS data and so it crashes while
+ * accessing unallocated memory.
+ * The solution is to create an FPC-managed thread which has the TLS data
+ * and use it to handle the console-output (hence it is called Console-Handler)
+ * It should be safe to do so, but maybe FPC requires the main-thread to access
+ * the console-buffer only. In this case output should be delegated to it.
+ *
+ * TODO: - check if it is safe if an FPC-managed thread different than the
+ * main-thread accesses the console-buffer in FPC.
+ * - check if Delphi's WriteLn is thread-safe.
+ * - check if we need to synchronize file-output too
+ *}
+procedure ConsoleWriteLn(const msg: string);
+begin
+{$IFDEF CONSOLE}
+ {$IFDEF FPC}
+ // TODO: check for the main-thread and use a simple _ConsoleWriteLn() then?
+ //GetCurrentThreadThreadId();
+ System.EnterCriticalSection(ConsoleCriticalSection);
+ MessageList.Add(msg);
+ RTLeventSetEvent(ConsoleEvent);
+ System.LeaveCriticalSection(ConsoleCriticalSection);
+ {$ELSE}
+ _ConsoleWriteLn(msg);
+ {$ENDIF}
+{$ENDIF}
+end;
+
+procedure ShowMessage(const msg: String; msgType: TMessageType);
+{$IFDEF MSWINDOWS}
+var Flags: Cardinal;
+{$ENDIF}
+begin
+{$IF Defined(MSWINDOWS)}
+ case msgType of
+ mtInfo: Flags := MB_ICONINFORMATION or MB_OK;
+ mtError: Flags := MB_ICONERROR or MB_OK;
+ else Flags := MB_OK;
+ end;
+ MessageBox(0, PChar(msg), PChar(USDXVersionStr()), Flags);
+{$ELSE}
+ ConsoleWriteln(msg);
+{$IFEND}
+end;
+
+function IsAlphaChar(ch: WideChar): boolean;
+begin
+ // TODO: add chars > 255 when unicode-fonts work?
+ case ch of
+ 'A'..'Z', // A-Z
+ 'a'..'z', // a-z
+ #170,#181,#186,
+ #192..#214,
+ #216..#246,
+ #248..#255:
+ Result := true;
+ else
+ Result := false;
+ end;
+end;
+
+function IsNumericChar(ch: WideChar): boolean;
+begin
+ case ch of
+ '0'..'9':
+ Result := true;
+ else
+ Result := false;
+ end;
+end;
+
+function IsAlphaNumericChar(ch: WideChar): boolean;
+begin
+ Result := (IsAlphaChar(ch) or IsNumericChar(ch));
+end;
+
+function IsPunctuationChar(ch: WideChar): boolean;
+begin
+ // TODO: add chars outside of Latin1 basic (0..127)?
+ case ch of
+ ' '..'/',':'..'@','['..'`','{'..'~':
+ Result := true;
+ else
+ Result := false;
+ end;
+end;
+
+function IsControlChar(ch: WideChar): boolean;
+begin
+ case ch of
+ #0..#31,
+ #127..#159:
+ Result := true;
+ else
+ Result := false;
+ end;
+end;
+
+(*
+ * Recursive part of the MergeSort algorithm.
+ * OutList will be either InList or TempList and will be swapped in each
+ * depth-level of recursion. By doing this it we can directly merge into the
+ * output-list. If we only had In- and OutList parameters we had to merge into
+ * InList after the recursive calls and copy the data to the OutList afterwards.
+ *)
+procedure _MergeSort(InList, TempList, OutList: TList; StartPos, BlockSize: integer;
+ CompareFunc: TListSortCompare);
+var
+ LeftSize, RightSize: integer; // number of elements in left/right block
+ LeftEnd, RightEnd: integer; // Index after last element in left/right block
+ MidPos: integer; // index of first element in right block
+ Pos: integer; // position in output list
+begin
+ LeftSize := BlockSize div 2;
+ RightSize := BlockSize - LeftSize;
+ MidPos := StartPos + LeftSize;
+
+ // sort left and right halves of this block by recursive calls of this function
+ if (LeftSize >= 2) then
+ _MergeSort(InList, OutList, TempList, StartPos, LeftSize, CompareFunc)
+ else
+ TempList[StartPos] := InList[StartPos];
+ if (RightSize >= 2) then
+ _MergeSort(InList, OutList, TempList, MidPos, RightSize, CompareFunc)
+ else
+ TempList[MidPos] := InList[MidPos];
+
+ // merge sorted left and right sub-lists into output-list
+ LeftEnd := MidPos;
+ RightEnd := StartPos + BlockSize;
+ Pos := StartPos;
+ while ((StartPos < LeftEnd) and (MidPos < RightEnd)) do
+ begin
+ if (CompareFunc(TempList[StartPos], TempList[MidPos]) <= 0) then
+ begin
+ OutList[Pos] := TempList[StartPos];
+ Inc(StartPos);
+ end
+ else
+ begin
+ OutList[Pos] := TempList[MidPos];
+ Inc(MidPos);
+ end;
+ Inc(Pos);
+ end;
+
+ // copy remaining elements to output-list
+ while (StartPos < LeftEnd) do
+ begin
+ OutList[Pos] := TempList[StartPos];
+ Inc(StartPos);
+ Inc(Pos);
+ end;
+ while (MidPos < RightEnd) do
+ begin
+ OutList[Pos] := TempList[MidPos];
+ Inc(MidPos);
+ Inc(Pos);
+ end;
+end;
+
+(*
+ * Stable alternative to the instable TList.Sort() (uses QuickSort) implementation.
+ * A stable sorting algorithm preserves preordered items. E.g. if sorting by
+ * songs by title first and artist afterwards, the songs of each artist will
+ * be ordered by title. In contrast to this an unstable algorithm (like QuickSort)
+ * may destroy an existing order, so the songs of an artist will not be ordered
+ * by title anymore after sorting by artist in the previous example.
+ * If you do not need a stable algorithm, use TList.Sort() instead.
+ *)
+procedure MergeSort(List: TList; CompareFunc: TListSortCompare);
+var
+ TempList: TList;
+begin
+ TempList := TList.Create();
+ TempList.Count := List.Count;
+ if (List.Count >= 2) then
+ _MergeSort(List, TempList, List, 0, List.Count, CompareFunc);
+ TempList.Free;
+end;
+
+
+type
+ // stores the unaligned pointer of data allocated by GetAlignedMem()
+ PMemAlignHeader = ^TMemAlignHeader;
+ TMemAlignHeader = Pointer;
+
+(**
+ * Use this function to assure that allocated memory is aligned on a specific
+ * byte boundary.
+ * Alignment must be a power of 2.
+ *
+ * Important: Memory allocated with GetAlignedMem() MUST be freed with
+ * FreeAlignedMem(), FreeMem() will cause a segmentation fault.
+ *
+ * Hint: If you do not need dynamic memory, consider to allocate memory
+ * statically and use the {$ALIGN x} compiler directive. Note that delphi
+ * supports an alignment "x" of up to 8 bytes only whereas FPC supports
+ * alignments on 16 and 32 byte boundaries too.
+ *)
+{$WARNINGS OFF}
+function GetAlignedMem(Size: cardinal; Alignment: integer): Pointer;
+var
+ OrigPtr: Pointer;
+const
+ MIN_ALIGNMENT = 16;
+begin
+ // Delphi and FPC (tested with 2.2.0) align memory blocks allocated with
+ // GetMem() at least on 8 byte boundaries. Delphi uses a minimal alignment
+ // of either 8 or 16 bytes depending on the size of the requested block
+ // (see System.GetMinimumBlockAlignment). As we do not want to change the
+ // boundary for the worse, we align at least on MIN_ALIGN.
+ if (Alignment < MIN_ALIGNMENT) then
+ Alignment := MIN_ALIGNMENT;
+
+ // allocate unaligned memory
+ GetMem(OrigPtr, SizeOf(TMemAlignHeader) + Size + Alignment);
+ if (OrigPtr = nil) then
+ begin
+ Result := nil;
+ Exit;
+ end;
+
+ // reserve space for the header
+ Result := Pointer(PtrUInt(OrigPtr) + SizeOf(TMemAlignHeader));
+ // align memory
+ Result := Pointer(PtrUInt(Result) + Alignment - PtrUInt(Result) mod Alignment);
+
+ // set header with info on old pointer for FreeMem
+ PMemAlignHeader(PtrUInt(Result) - SizeOf(TMemAlignHeader))^ := OrigPtr;
+end;
+{$WARNINGS ON}
+
+{$WARNINGS OFF}
+procedure FreeAlignedMem(P: Pointer);
+begin
+ if (P <> nil) then
+ FreeMem(PMemAlignHeader(PtrUInt(P) - SizeOf(TMemAlignHeader))^);
+end;
+{$WARNINGS ON}
+
+
+initialization
+ InitConsoleOutput();
+
+finalization
+ FinalizeConsoleOutput();
+
+end.
diff --git a/src/base/UConfig.pas b/src/base/UConfig.pas
new file mode 100644
index 00000000..b77c2a5a
--- /dev/null
+++ b/src/base/UConfig.pas
@@ -0,0 +1,199 @@
+unit UConfig;
+
+// -------------------------------------------------------------------
+// Note on version comparison (for developers only):
+// -------------------------------------------------------------------
+// Delphi (in contrast to FPC) DOESN'T support MACROS. So we
+// can't define a macro like VERSION_MAJOR(version) to extract
+// parts of the version-number or to create version numbers for
+// comparison purposes as with a MAKE_VERSION(maj, min, rev) macro.
+// So we have to define constants for every part of the version here.
+//
+// In addition FPC (in contrast to delphi) DOES NOT support floating-
+// point numbers in $IF compiler-directives (e.g. {$IF VERSION > 1.23})
+// It also DOESN'T support arithmetic operations so we aren't able to
+// compare versions this way (brackets aren't supported too):
+// {$IF VERSION > ((VER_MAJ*2)+(VER_MIN*23)+(VER_REL*1))}
+//
+// Hence we have to use fixed numbers in the directives. At least
+// Pascal allows leading 0s so 0005 equals 5 (octals are
+// preceded by & and not by 0 in FPC).
+// We also fix the count of digits for each part of the version number
+// to 3 (aaaiiirrr with aaa=major, iii=minor, rrr=release version)
+//
+// A check for a library with at least a version of 2.5.11 would look
+// like this:
+// {$IF LIB_VERSION >= 002005011}
+//
+// If you just need to check the major version do this:
+// {$IF LIB_VERSION_MAJOR >= 23}
+//
+// IMPORTANT:
+// Because this unit must be included in a uses-section it is
+// not possible to use the version-numbers in this uses-clause.
+// Example:
+// interface
+// uses
+// versions, // include this file
+// {$IF USE_UNIT_XYZ}xyz;{$IFEND} // Error: USE_UNIT_XYZ not defined
+// const
+// {$IF USE_UNIT_XYZ}test = 2;{$IFEND} // OK
+// uses
+// {$IF USE_UNIT_XYZ}xyz;{$IFEND} // OK
+//
+// Even if this file was an include-file no constants could be declared
+// before the interface's uses clause.
+// In FPC macros {$DEFINE VER:= 3} could be used to declare the version-numbers
+// but this is incompatible to Delphi. In addition macros do not allow expand
+// arithmetic expressions. Although you can define
+// {$DEFINE FPC_VER:= FPC_VERSION*1000000+FPC_RELEASE*1000+FPC_PATCH}
+// the following check would fail:
+// {$IF FPC_VERSION_INT >= 002002000}
+// would fail because FPC_VERSION_INT is interpreted as a string.
+//
+// PLEASE consider this if you use version numbers in $IF compiler-
+// directives. Otherwise you might break portability.
+// -------------------------------------------------------------------
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+ {$MACRO ON} // for evaluation of FPC_VERSION/RELEASE/PATCH
+{$ENDIF}
+
+{$I switches.inc}
+
+uses
+ Sysutils;
+
+const
+ // IMPORTANT:
+ // If IncludeConstants is defined, the const-sections
+ // of the config-file will be included too.
+ // This switch is necessary because it is not possible to
+ // include the const-sections in the switches.inc.
+ // switches.inc is always included before the first uses-
+ // section but at that place no const-section is allowed.
+ // So we have to include the config-file in switches.inc
+ // with IncludeConstants undefined and in UConfig.pas with
+ // IncludeConstants defined (see the note above).
+ {$DEFINE IncludeConstants}
+
+ // include config-file (defines + constants)
+ {$IF Defined(MSWindows)}
+ {$I ../config-win.inc}
+ {$ELSEIF Defined(Linux)}
+ {$I ../config-linux.inc}
+ {$ELSEIF Defined(Darwin)}
+ {$I ../config-darwin.inc}
+ {$ELSE}
+ {$MESSAGE Fatal 'Unknown OS'}
+ {$IFEND}
+
+{* Libraries *}
+
+ VERSION_MAJOR = 1000000;
+ VERSION_MINOR = 1000;
+ VERSION_RELEASE = 1;
+
+ (*
+ * Current version of UltraStar Deluxe
+ *)
+ USDX_VERSION_MAJOR = 1;
+ USDX_VERSION_MINOR = 1;
+ USDX_VERSION_RELEASE = 0;
+ USDX_VERSION_STATE = 'Alpha';
+ USDX_STRING = 'UltraStar Deluxe';
+
+ (*
+ * FPC version numbers are already defined as built-in macros:
+ * FPC_VERSION (MAJOR)
+ * FPC_RELEASE (MINOR)
+ * FPC_PATCH (RELEASE)
+ * Since FPC_VERSION is already defined, we will use FPC_VERSION_INT as
+ * composed version number.
+ *)
+ {$IFNDEF FPC}
+ // Delphi 7 evaluates every $IF-directive even if it is disabled by a surrounding
+ // $IF or $IFDEF so the follwing will give you an error in delphi:
+ // {$IFDEF FPC}{$IF (FPC_VERSION > 2)}...{$IFEND}{$ENDIF}
+ // The reason for this error is that FPC_VERSION is not a valid constant.
+ // To avoid this error, we define dummys here.
+ FPC_VERSION = 0;
+ FPC_RELEASE = 0;
+ FPC_PATCH = 0;
+ {$ENDIF}
+
+ FPC_VERSION_INT = (FPC_VERSION * VERSION_MAJOR) +
+ (FPC_RELEASE * VERSION_MINOR) +
+ (FPC_PATCH * VERSION_RELEASE);
+
+
+ {$IFDEF HaveFFmpeg}
+
+ LIBAVCODEC_VERSION = (LIBAVCODEC_VERSION_MAJOR * VERSION_MAJOR) +
+ (LIBAVCODEC_VERSION_MINOR * VERSION_MINOR) +
+ (LIBAVCODEC_VERSION_RELEASE * VERSION_RELEASE);
+
+ LIBAVFORMAT_VERSION = (LIBAVFORMAT_VERSION_MAJOR * VERSION_MAJOR) +
+ (LIBAVFORMAT_VERSION_MINOR * VERSION_MINOR) +
+ (LIBAVFORMAT_VERSION_RELEASE * VERSION_RELEASE);
+
+ LIBAVUTIL_VERSION = (LIBAVUTIL_VERSION_MAJOR * VERSION_MAJOR) +
+ (LIBAVUTIL_VERSION_MINOR * VERSION_MINOR) +
+ (LIBAVUTIL_VERSION_RELEASE * VERSION_RELEASE);
+
+ {$IFDEF HaveSWScale}
+ LIBSWSCALE_VERSION = (LIBSWSCALE_VERSION_MAJOR * VERSION_MAJOR) +
+ (LIBSWSCALE_VERSION_MINOR * VERSION_MINOR) +
+ (LIBSWSCALE_VERSION_RELEASE * VERSION_RELEASE);
+ {$ENDIF}
+
+ {$ENDIF}
+
+ {$IFDEF HaveProjectM}
+ PROJECTM_VERSION = (PROJECTM_VERSION_MAJOR * VERSION_MAJOR) +
+ (PROJECTM_VERSION_MINOR * VERSION_MINOR) +
+ (PROJECTM_VERSION_RELEASE * VERSION_RELEASE);
+ {$ENDIF}
+
+ {$IFDEF HavePortaudio}
+ PORTAUDIO_VERSION = (PORTAUDIO_VERSION_MAJOR * VERSION_MAJOR) +
+ (PORTAUDIO_VERSION_MINOR * VERSION_MINOR) +
+ (PORTAUDIO_VERSION_RELEASE * VERSION_RELEASE);
+ {$ENDIF}
+
+ {$IFDEF HaveLibsamplerate}
+ LIBSAMPLERATE_VERSION = (LIBSAMPLERATE_VERSION_MAJOR * VERSION_MAJOR) +
+ (LIBSAMPLERATE_VERSION_MINOR * VERSION_MINOR) +
+ (LIBSAMPLERATE_VERSION_RELEASE * VERSION_RELEASE);
+ {$ENDIF}
+
+function USDXVersionStr(): string;
+function USDXShortVersionStr(): string;
+
+implementation
+
+uses
+ StrUtils, Math;
+
+function USDXShortVersionStr(): string;
+begin
+ Result :=
+ USDX_STRING +
+ IfThen(USDX_VERSION_STATE <> '', ' '+USDX_VERSION_STATE);
+end;
+
+function USDXVersionStr(): string;
+begin
+ Result :=
+ USDX_STRING + ' V ' +
+ IntToStr(USDX_VERSION_MAJOR) + '.' +
+ IntToStr(USDX_VERSION_MINOR) + '.' +
+ IntToStr(USDX_VERSION_RELEASE) +
+ IfThen(USDX_VERSION_STATE <> '', ' '+USDX_VERSION_STATE) +
+ ' Build';
+end;
+
+end.
diff --git a/src/base/UCore.pas b/src/base/UCore.pas
new file mode 100644
index 00000000..fe23a68e
--- /dev/null
+++ b/src/base/UCore.pas
@@ -0,0 +1,525 @@
+unit UCore;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+uses
+ uPluginDefs,
+ uCoreModule,
+ UHooks,
+ UServices,
+ UModules;
+
+{*********************
+ TCore
+ Class manages all CoreModules, teh StartUp, teh MainLoop and the shutdown process
+ Also it does some Error Handling, and maybe sometime multithreaded Loading ;)
+*********************}
+
+type
+ TModuleListItem = record
+ Module: TCoreModule; //Instance of the Modules Class
+ Info: TModuleInfo; //ModuleInfo returned by Modules Modulinfo Proc
+ NeedsDeInit: Boolean; //True if Module was succesful inited
+ end;
+
+ TCore = class
+ private
+ //Some Hook Handles. See Plugin SDKs Hooks.txt for Infos
+ hLoadingFinished: THandle;
+ hMainLoop: THandle;
+ hTranslate: THandle;
+ hLoadTextures: THandle;
+ hExitQuery: THandle;
+ hExit: THandle;
+ hDebug: THandle;
+ hError: THandle;
+ sReportError: THandle;
+ sReportDebug: THandle;
+ sShowMessage: THandle;
+ sRetranslate: THandle;
+ sReloadTextures: THandle;
+ sGetModuleInfo: THandle;
+ sGetApplicationHandle: THandle;
+
+ Modules: Array [0..High(CORE_MODULES_TO_LOAD)] of TModuleListItem;
+
+ //Cur + Last Executed Setting and Getting ;)
+ iCurExecuted: Integer;
+ iLastExecuted: Integer;
+
+ procedure SetCurExecuted(Value: Integer);
+
+ //Function Get all Modules and Creates them
+ function GetModules: Boolean;
+
+ //Loads Core and all Modules
+ function Load: Boolean;
+
+ //Inits Core and all Modules
+ function Init: Boolean;
+
+ //DeInits Core and all Modules
+ function DeInit: Boolean;
+
+ //Load the Core
+ function LoadCore: Boolean;
+
+ //Init the Core
+ function InitCore: Boolean;
+
+ //DeInit the Core
+ function DeInitCore: Boolean;
+
+ //Called one Time per Frame
+ function MainLoop: Boolean;
+
+ public
+ Hooks: THookManager; //Teh Hook Manager ;)
+ Services: TServiceManager;//The Service Manager
+
+ Name: String; //Name of this Application
+ Version: LongWord; //Version of this ". For Info Look PluginDefs Functions
+
+ LastErrorReporter:String; //Who Reported the Last Error String
+ LastErrorString: String; //Last Error String reported
+
+ property CurExecuted: Integer read iCurExecuted write SetCurExecuted; //ID of Plugin or Module curently Executed
+ property LastExecuted: Integer read iLastExecuted;
+
+ //---------------
+ //Main Methods to control the Core:
+ //---------------
+ constructor Create(const cName: String; const cVersion: LongWord);
+
+ //Starts Loading and Init Process. Then Runs MainLoop. DeInits on Shutdown
+ procedure Run;
+
+ //Method for other Classes to get Pointer to a specific Module
+ function GetModulebyName(const Name: String): PCoreModule;
+
+ //--------------
+ // Hook and Service Procs:
+ //--------------
+ function ShowMessage(wParam: TwParam; lParam: TlParam): integer; //Shows a Message (lParam: PChar Text, wParam: Symbol)
+ function ReportError(wParam: TwParam; lParam: TlParam): integer; //Shows a Message (wParam: Pchar(Message), lParam: PChar(Reportername))
+ function ReportDebug(wParam: TwParam; lParam: TlParam): integer; //Shows a Message (wParam: Pchar(Message), lParam: PChar(Reportername))
+ function Retranslate(wParam: TwParam; lParam: TlParam): integer; //Calls Translate hook
+ function ReloadTextures(wParam: TwParam; lParam: TlParam): integer; //Calls LoadTextures hook
+ function GetModuleInfo(wParam: TwParam; lParam: TlParam): integer; //If lParam = nil then get length of Moduleinfo Array. If lparam <> nil then write array of TModuleInfo to address at lparam
+ function GetApplicationHandle(wParam: TwParam; lParam: TlParam): integer; //Returns Application Handle
+ end;
+
+var
+ Core: TCore;
+
+implementation
+
+uses
+ {$IFDEF win32}
+ Windows,
+ {$ENDIF}
+ SysUtils;
+
+//-------------
+// Create - Creates Class + Hook and Service Manager
+//-------------
+constructor TCore.Create(const cName: String; const cVersion: LongWord);
+begin
+ inherited Create;
+
+ Name := cName;
+ Version := cVersion;
+ iLastExecuted := 0;
+ iCurExecuted := 0;
+
+ LastErrorReporter := '';
+ LastErrorString := '';
+
+ Hooks := THookManager.Create(50);
+ Services := TServiceManager.Create;
+end;
+
+//-------------
+//Starts Loading and Init Process. Then Runs MainLoop. DeInits on Shutdown
+//-------------
+procedure TCore.Run;
+var
+ Success: Boolean;
+
+ procedure HandleError(const ErrorMsg: string);
+ begin
+ if (LastErrorString <> '') then
+ Self.ShowMessage(CORE_SM_ERROR, PChar(ErrorMsg + ': ' + LastErrorString))
+ else
+ Self.ShowMessage(CORE_SM_ERROR, PChar(ErrorMsg));
+
+ //DeInit
+ DeInit;
+ end;
+
+begin
+ //Get Modules
+ try
+ Success := GetModules();
+ except
+ Success := False;
+ end;
+
+ if (not Success) then
+ begin
+ HandleError('Error Getting Modules');
+ Exit;
+ end;
+
+ //Loading
+ try
+ Success := Load();
+ except
+ Success := False;
+ end;
+
+ if (not Success) then
+ begin
+ HandleError('Error loading Modules');
+ Exit;
+ end;
+
+ //Init
+ try
+ Success := Init();
+ except
+ Success := False;
+ end;
+
+ if (not Success) then
+ begin
+ HandleError('Error initing Modules');
+ Exit;
+ end;
+
+ //Call Translate Hook
+ if (Hooks.CallEventChain(hTranslate, 0, nil) <> 0) then
+ begin
+ HandleError('Error translating');
+ Exit;
+ end;
+
+ //Calls LoadTextures Hook
+ if (Hooks.CallEventChain(hLoadTextures, 0, nil) <> 0) then
+ begin
+ HandleError('Error loading textures');
+ Exit;
+ end;
+
+ //Calls Loading Finished Hook
+ if (Hooks.CallEventChain(hLoadingFinished, 0, nil) <> 0) then
+ begin
+ HandleError('Error calling LoadingFinished Hook');
+ Exit;
+ end;
+
+ //Start MainLoop
+ while Success do
+ begin
+ Success := MainLoop();
+ // to-do : Call Display Draw here
+ end;
+end;
+
+//-------------
+//Called one Time per Frame
+//-------------
+function TCore.MainLoop: Boolean;
+begin
+ Result := False;
+end;
+
+//-------------
+//Function Get all Modules and Creates them
+//-------------
+function TCore.GetModules: Boolean;
+var
+ i: Integer;
+begin
+ Result := False;
+ for i := 0 to high(Modules) do
+ begin
+ try
+ Modules[i].NeedsDeInit := False;
+ Modules[i].Module := CORE_MODULES_TO_LOAD[i].Create;
+ Modules[i].Module.Info(@Modules[i].Info);
+ except
+ ReportError(Integer(PChar('Can''t get module #' + InttoStr(i) + ' "' + Modules[i].Info.Name + '"')), PChar('Core'));
+ Exit;
+ end;
+ end;
+ Result := True;
+end;
+
+//-------------
+//Loads Core and all Modules
+//-------------
+function TCore.Load: Boolean;
+var
+ i: Integer;
+begin
+ Result := LoadCore;
+
+ for i := 0 to High(CORE_MODULES_TO_LOAD) do
+ begin
+ try
+ Result := Modules[i].Module.Load;
+ except
+ Result := False;
+ end;
+
+ if (not Result) then
+ begin
+ ReportError(Integer(PChar('Error loading module #' + InttoStr(i) + ' "' + Modules[i].Info.Name + '"')), PChar('Core'));
+ break;
+ end;
+ end;
+end;
+
+//-------------
+//Inits Core and all Modules
+//-------------
+function TCore.Init: Boolean;
+var
+ i: Integer;
+begin
+ Result := InitCore;
+
+ for i := 0 to High(CORE_MODULES_TO_LOAD) do
+ begin
+ try
+ Result := Modules[i].Module.Init;
+ except
+ Result := False;
+ end;
+
+ if (not Result) then
+ begin
+ ReportError(Integer(PChar('Error initing module #' + InttoStr(i) + ' "' + Modules[i].Info.Name + '"')), PChar('Core'));
+ break;
+ end;
+
+ Modules[i].NeedsDeInit := Result;
+ end;
+end;
+
+//-------------
+//DeInits Core and all Modules
+//-------------
+function TCore.DeInit: boolean;
+var
+ i: integer;
+begin
+
+ for i := High(CORE_MODULES_TO_LOAD) downto 0 do
+ begin
+ try
+ if (Modules[i].NeedsDeInit) then
+ Modules[i].Module.DeInit;
+ except
+ end;
+ end;
+
+ DeInitCore;
+
+ Result := true;
+end;
+
+//-------------
+//Load the Core
+//-------------
+function TCore.LoadCore: Boolean;
+begin
+ hLoadingFinished := Hooks.AddEvent('Core/LoadingFinished');
+ hMainLoop := Hooks.AddEvent('Core/MainLoop');
+ hTranslate := Hooks.AddEvent('Core/Translate');
+ hLoadTextures := Hooks.AddEvent('Core/LoadTextures');
+ hExitQuery := Hooks.AddEvent('Core/ExitQuery');
+ hExit := Hooks.AddEvent('Core/Exit');
+ hDebug := Hooks.AddEvent('Core/NewDebugInfo');
+ hError := Hooks.AddEvent('Core/NewError');
+
+ sReportError := Services.AddService('Core/ReportError', nil, Self.ReportError);
+ sReportDebug := Services.AddService('Core/ReportDebug', nil, Self.ReportDebug);
+ sShowMessage := Services.AddService('Core/ShowMessage', nil, Self.ShowMessage);
+ sRetranslate := Services.AddService('Core/Retranslate', nil, Self.Retranslate);
+ sReloadTextures := Services.AddService('Core/ReloadTextures', nil, Self.ReloadTextures);
+ sGetModuleInfo := Services.AddService('Core/GetModuleInfo', nil, Self.GetModuleInfo);
+ sGetApplicationHandle := Services.AddService('Core/GetApplicationHandle', nil, Self.GetApplicationHandle);
+
+ //A little Test
+ Hooks.AddSubscriber('Core/NewError', HookTest);
+
+ result := true;
+end;
+
+//-------------
+//Init the Core
+//-------------
+function TCore.InitCore: Boolean;
+begin
+ //Don not init something atm.
+ result := true;
+end;
+
+//-------------
+//DeInit the Core
+//-------------
+function TCore.DeInitCore: Boolean;
+begin
+ // TODO: write TService-/HookManager.Free and call it here
+ Result := true;
+end;
+
+//-------------
+//Method for other classes to get pointer to a specific module
+//-------------
+function TCore.GetModuleByName(const Name: String): PCoreModule;
+var i: Integer;
+begin
+ Result := nil;
+ for i := 0 to High(Modules) do
+ begin
+ if (Modules[i].Info.Name = Name) then
+ begin
+ Result := @Modules[i].Module;
+ Break;
+ end;
+ end;
+end;
+
+//-------------
+// Shows a MessageDialog (lParam: PChar Text, wParam: Symbol)
+//-------------
+function TCore.ShowMessage(wParam: TwParam; lParam: TlParam): integer;
+{$IFDEF MSWINDOWS}
+var Params: Cardinal;
+{$ENDIF}
+begin
+ Result := -1;
+
+ {$IFDEF MSWINDOWS}
+ if (lParam <> nil) then
+ begin
+ Params := MB_OK;
+ case wParam of
+ CORE_SM_ERROR: Params := Params or MB_ICONERROR;
+ CORE_SM_WARNING: Params := Params or MB_ICONWARNING;
+ CORE_SM_INFO: Params := Params or MB_ICONINFORMATION;
+ end;
+
+ //Show:
+ Result := Messagebox(0, lParam, PChar(Name), Params);
+ end;
+ {$ENDIF}
+
+ // TODO: write ShowMessage for other OSes
+end;
+
+//-------------
+// Calls NewError HookChain (wParam: Pchar(Message), lParam: PChar(Reportername))
+//-------------
+function TCore.ReportError(wParam: TwParam; lParam: TlParam): integer;
+begin
+ //Update LastErrorReporter and LastErrorString
+ LastErrorReporter := String(PChar(lParam));
+ LastErrorString := String(PChar(Pointer(wParam)));
+
+ Hooks.CallEventChain(hError, wParam, lParam);
+
+ // FIXME: return a correct result
+ Result := 0;
+end;
+
+//-------------
+// Calls NewDebugInfo HookChain (wParam: Pchar(Message), lParam: PChar(Reportername))
+//-------------
+function TCore.ReportDebug(wParam: TwParam; lParam: TlParam): integer;
+begin
+ Hooks.CallEventChain(hDebug, wParam, lParam);
+
+ // FIXME: return a correct result
+ Result := 0;
+end;
+
+//-------------
+// Calls Translate hook
+//-------------
+function TCore.Retranslate(wParam: TwParam; lParam: TlParam): integer;
+begin
+ Hooks.CallEventChain(hTranslate, 1, nil);
+
+ // FIXME: return a correct result
+ Result := 0;
+end;
+
+//-------------
+// Calls LoadTextures hook
+//-------------
+function TCore.ReloadTextures(wParam: TwParam; lParam: TlParam): integer;
+begin
+ Hooks.CallEventChain(hLoadTextures, 1, nil);
+
+ // FIXME: return a correct result
+ Result := 0;
+end;
+
+//-------------
+// If lParam = nil then get length of Moduleinfo Array. If lparam <> nil then write array of TModuleInfo to address at lparam
+//-------------
+function TCore.GetModuleInfo(wParam: TwParam; lParam: TlParam): integer;
+var
+ I: integer;
+begin
+ if (Pointer(lParam) = nil) then
+ begin
+ Result := Length(Modules);
+ end
+ else
+ begin
+ try
+ for I := 0 to High(Modules) do
+ begin
+ AModuleInfo(Pointer(lParam))[I].Name := Modules[I].Info.Name;
+ AModuleInfo(Pointer(lParam))[I].Version := Modules[I].Info.Version;
+ AModuleInfo(Pointer(lParam))[I].Description := Modules[I].Info.Description;
+ end;
+ Result := Length(Modules);
+ except
+ Result := -1;
+ end;
+ end;
+end;
+
+//-------------
+// Returns Application Handle
+//-------------
+function TCore.GetApplicationHandle(wParam: TwParam; lParam: TlParam): integer;
+begin
+ Result := hInstance;
+end;
+
+//-------------
+// Called when setting CurExecuted
+//-------------
+procedure TCore.SetCurExecuted(Value: Integer);
+begin
+ //Set Last Executed
+ iLastExecuted := iCurExecuted;
+
+ //Set Cur Executed
+ iCurExecuted := Value;
+end;
+
+end.
diff --git a/src/base/UCoreModule.pas b/src/base/UCoreModule.pas
new file mode 100644
index 00000000..031fb04e
--- /dev/null
+++ b/src/base/UCoreModule.pas
@@ -0,0 +1,128 @@
+unit UCoreModule;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+{*********************
+ TCoreModule
+ Dummy Class that has Methods that will be called from Core
+ In the Best case every Piece of this Software is a Module
+*********************}
+uses UPluginDefs;
+
+type
+ PCoreModule = ^TCoreModule;
+ TCoreModule = class
+ public
+ Constructor Create; virtual;
+
+ //Function that gives some Infos about the Module to the Core
+ Procedure Info(const pInfo: PModuleInfo); virtual;
+
+ //Is Called on Loading.
+ //In this Method only Events and Services should be created
+ //to offer them to other Modules or Plugins during the Init process
+ //If False is Returned this will cause a Forced Exit
+ Function Load: Boolean; virtual;
+
+ //Is Called on Init Process
+ //In this Method you can Hook some Events and Create + Init
+ //your Classes, Variables etc.
+ //If False is Returned this will cause a Forced Exit
+ Function Init: Boolean; virtual;
+
+ //Is Called during Mainloop before 'Core/MainLoop' Hook and Drawing
+ //If False is Returned this will cause a Forced Exit
+ Function MainLoop: Boolean; virtual;
+
+ //Is Called if this Module has been Inited and there is a Exit.
+ //Deinit is in backwards Initing Order
+ //If False is Returned this will cause a Forced Exit
+ Procedure DeInit; virtual;
+
+ //Is Called if this Module will be unloaded and has been created
+ //Should be used to Free Memory
+ Destructor Destroy; override;
+ end;
+ cCoreModule = class of TCoreModule;
+
+implementation
+
+//-------------
+// Just the Constructor
+//-------------
+Constructor TCoreModule.Create;
+begin
+ //Dummy maaaan ;)
+ inherited;
+end;
+
+//-------------
+// Function that gives some Infos about the Module to the Core
+//-------------
+Procedure TCoreModule.Info(const pInfo: PModuleInfo);
+begin
+ pInfo^.Name := 'Not Set';
+ pInfo^.Version := 0;
+ pInfo^.Description := 'Not Set';
+end;
+
+//-------------
+//Is Called on Loading.
+//In this Method only Events and Services should be created
+//to offer them to other Modules or Plugins during the Init process
+//If False is Returned this will cause a Forced Exit
+//-------------
+Function TCoreModule.Load: Boolean;
+begin
+ //Dummy ftw!!
+ Result := True;
+end;
+
+//-------------
+//Is Called on Init Process
+//In this Method you can Hook some Events and Create + Init
+//your Classes, Variables etc.
+//If False is Returned this will cause a Forced Exit
+//-------------
+Function TCoreModule.Init: Boolean;
+begin
+ //Dummy ftw!!
+ Result := True;
+end;
+
+//-------------
+//Is Called during Mainloop before 'Core/MainLoop' Hook and Drawing
+//If False is Returned this will cause a Forced Exit
+//-------------
+Function TCoreModule.MainLoop: Boolean;
+begin
+ //Dummy ftw!!
+ Result := True;
+end;
+
+//-------------
+//Is Called if this Module has been Inited and there is a Exit.
+//Deinit is in backwards Initing Order
+//-------------
+Procedure TCoreModule.DeInit;
+begin
+ //Dummy ftw!!
+end;
+
+//-------------
+//Is Called if this Module will be unloaded and has been created
+//Should be used to Free Memory
+//-------------
+Destructor TCoreModule.Destroy;
+begin
+ //Dummy ftw!!
+ inherited;
+end;
+
+end.
diff --git a/src/base/UCovers.pas b/src/base/UCovers.pas
new file mode 100644
index 00000000..7bb57b4a
--- /dev/null
+++ b/src/base/UCovers.pas
@@ -0,0 +1,430 @@
+unit UCovers;
+
+{
+ TODO:
+ - adjust database to new song-loading (e.g. use SongIDs)
+ - support for deletion of outdated covers
+ - support for update of changed covers
+ - use paths relative to the song for removable disks support
+ (a drive might have a different drive-name the next time it is connected,
+ so "H:/songs/..." will not match "I:/songs/...")
+}
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+uses
+ sdl,
+ SQLite3,
+ SQLiteTable3,
+ SysUtils,
+ Classes,
+ UImage,
+ UTexture;
+
+type
+ ECoverDBException = class(Exception)
+ end;
+
+ TCover = class
+ private
+ ID: int64;
+ Filename: WideString;
+ public
+ constructor Create(ID: int64; Filename: WideString);
+ function GetPreviewTexture(): TTexture;
+ function GetTexture(): TTexture;
+ end;
+
+ TThumbnailInfo = record
+ CoverWidth: integer; // Original width of cover
+ CoverHeight: integer; // Original height of cover
+ PixelFormat: TImagePixelFmt; // Pixel-format of thumbnail
+ end;
+
+ TCoverDatabase = class
+ private
+ DB: TSQLiteDatabase;
+ procedure InitCoverDatabase();
+ function CreateThumbnail(const Filename: WideString; var Info: TThumbnailInfo): PSDL_Surface;
+ function LoadCover(CoverID: int64): TTexture;
+ procedure DeleteCover(CoverID: int64);
+ function FindCoverIntern(const Filename: WideString): int64;
+ procedure Open();
+ function GetVersion(): integer;
+ procedure SetVersion(Version: integer);
+ public
+ constructor Create();
+ destructor Destroy; override;
+ function AddCover(const Filename: WideString): TCover;
+ function FindCover(const Filename: WideString): TCover;
+ function CoverExists(const Filename: WideString): boolean;
+ function GetMaxCoverSize(): integer;
+ procedure SetMaxCoverSize(Size: integer);
+ end;
+
+ TBlobWrapper = class(TCustomMemoryStream)
+ function Write(const Buffer; Count: Integer): Integer; override;
+ end;
+
+var
+ Covers: TCoverDatabase;
+
+implementation
+
+uses
+ UMain,
+ ULog,
+ UPlatform,
+ UIni,
+ Math,
+ DateUtils;
+
+const
+ COVERDB_FILENAME = 'cover.db';
+ COVERDB_VERSION = 01; // 0.1
+ COVER_TBL = 'Cover';
+ COVER_THUMBNAIL_TBL = 'CoverThumbnail';
+ COVER_IDX = 'Cover_Filename_IDX';
+
+// Note: DateUtils.DateTimeToUnix() will throw an exception in FPC
+function DateTimeToUnixTime(time: TDateTime): int64;
+begin
+ Result := Round((time - UnixDateDelta) * SecsPerDay);
+end;
+
+// Note: DateUtils.UnixToDateTime() will throw an exception in FPC
+function UnixTimeToDateTime(timestamp: int64): TDateTime;
+begin
+ Result := timestamp / SecsPerDay + UnixDateDelta;
+end;
+
+
+{ TBlobWrapper }
+
+function TBlobWrapper.Write(const Buffer; Count: Integer): Integer;
+begin
+ SetPointer(Pointer(Buffer), Count);
+ Result := Count;
+end;
+
+
+{ TCover }
+
+constructor TCover.Create(ID: int64; Filename: WideString);
+begin
+ Self.ID := ID;
+ Self.Filename := Filename;
+end;
+
+function TCover.GetPreviewTexture(): TTexture;
+begin
+ Result := Covers.LoadCover(ID);
+end;
+
+function TCover.GetTexture(): TTexture;
+begin
+ Result := Texture.LoadTexture(Filename);
+end;
+
+
+{ TCoverDatabase }
+
+constructor TCoverDatabase.Create();
+begin
+ inherited;
+
+ Open();
+ InitCoverDatabase();
+end;
+
+destructor TCoverDatabase.Destroy;
+begin
+ DB.Free;
+ inherited;
+end;
+
+function TCoverDatabase.GetVersion(): integer;
+begin
+ Result := DB.GetTableValue('PRAGMA user_version');
+end;
+
+procedure TCoverDatabase.SetVersion(Version: integer);
+begin
+ DB.ExecSQL(Format('PRAGMA user_version = %d', [Version]));
+end;
+
+function TCoverDatabase.GetMaxCoverSize(): integer;
+begin
+ Result := ITextureSizeVals[Ini.TextureSize];
+end;
+
+procedure TCoverDatabase.SetMaxCoverSize(Size: integer);
+var
+ I: integer;
+begin
+ // search for first valid cover-size > Size
+ for I := 0 to Length(ITextureSizeVals)-1 do
+ begin
+ if (Size <= ITextureSizeVals[I]) then
+ begin
+ Ini.TextureSize := I;
+ Exit;
+ end;
+ end;
+
+ // fall-back to highest size
+ Ini.TextureSize := High(ITextureSizeVals);
+end;
+
+procedure TCoverDatabase.Open();
+var
+ Version: integer;
+ Filename: string;
+begin
+ Filename := UTF8Encode(Platform.GetGameUserPath() + COVERDB_FILENAME);
+
+ DB := TSQLiteDatabase.Create(Filename);
+ Version := GetVersion();
+
+ // check version, if version is too old/new, delete database file
+ if ((Version <> 0) and (Version <> COVERDB_VERSION)) then
+ begin
+ Log.LogInfo('Outdated cover-database file found', 'TCoverDatabase.Open');
+ // close and delete outdated file
+ DB.Free;
+ if (not DeleteFile(Filename)) then
+ raise ECoverDBException.Create('Could not delete ' + Filename);
+ // reopen
+ DB := TSQLiteDatabase.Create(Filename);
+ Version := 0;
+ end;
+
+ // set version number after creation
+ if (Version = 0) then
+ SetVersion(COVERDB_VERSION);
+
+ // speed-up disk-writing. The default FULL-synchronous mode is too slow.
+ // With this option disk-writing is approx. 4 times faster but the database
+ // might be corrupted if the OS crashes, although this is very unlikely.
+ DB.ExecSQL('PRAGMA synchronous = OFF;');
+
+ // the next line rather gives a slow-down instead of a speed-up, so we do not use it
+ //DB.ExecSQL('PRAGMA temp_store = MEMORY;');
+end;
+
+procedure TCoverDatabase.InitCoverDatabase();
+begin
+ DB.ExecSQL('CREATE TABLE IF NOT EXISTS ['+COVER_TBL+'] (' +
+ '[ID] INTEGER NOT NULL PRIMARY KEY AUTOINCREMENT, ' +
+ '[Filename] TEXT UNIQUE NOT NULL, ' +
+ '[Date] INTEGER NOT NULL, ' +
+ '[Width] INTEGER NOT NULL, ' +
+ '[Height] INTEGER NOT NULL ' +
+ ')');
+
+ DB.ExecSQL('CREATE INDEX IF NOT EXISTS ['+COVER_IDX+'] ON ['+COVER_TBL+'](' +
+ '[Filename] ASC' +
+ ')');
+
+ DB.ExecSQL('CREATE TABLE IF NOT EXISTS ['+COVER_THUMBNAIL_TBL+'] (' +
+ '[ID] INTEGER NOT NULL PRIMARY KEY, ' +
+ '[Format] INTEGER NOT NULL, ' +
+ '[Width] INTEGER NOT NULL, ' +
+ '[Height] INTEGER NOT NULL, ' +
+ '[Data] BLOB NULL' +
+ ')');
+end;
+
+function TCoverDatabase.FindCoverIntern(const Filename: WideString): int64;
+begin
+ Result := DB.GetTableValue('SELECT [ID] FROM ['+COVER_TBL+'] ' +
+ 'WHERE [Filename] = ?',
+ [UTF8Encode(Filename)]);
+end;
+
+function TCoverDatabase.FindCover(const Filename: WideString): TCover;
+var
+ CoverID: int64;
+begin
+ Result := nil;
+ try
+ CoverID := FindCoverIntern(Filename);
+ if (CoverID > 0) then
+ Result := TCover.Create(CoverID, Filename);
+ except on E: Exception do
+ Log.LogError(E.Message, 'TCoverDatabase.FindCover');
+ end;
+end;
+
+function TCoverDatabase.CoverExists(const Filename: WideString): boolean;
+begin
+ Result := false;
+ try
+ Result := (FindCoverIntern(Filename) > 0);
+ except on E: Exception do
+ Log.LogError(E.Message, 'TCoverDatabase.CoverExists');
+ end;
+end;
+
+function TCoverDatabase.AddCover(const Filename: WideString): TCover;
+var
+ CoverID: int64;
+ Thumbnail: PSDL_Surface;
+ CoverData: TBlobWrapper;
+ FileDate: TDateTime;
+ Info: TThumbnailInfo;
+begin
+ Result := nil;
+
+ //if (not FileExists(Filename)) then
+ // Exit;
+
+ // TODO: replace '\' with '/' in filename
+ FileDate := Now(); //FileDateToDateTime(FileAge(Filename));
+
+ Thumbnail := CreateThumbnail(Filename, Info);
+ if (Thumbnail = nil) then
+ Exit;
+
+ CoverData := TBlobWrapper.Create;
+ CoverData.Write(Thumbnail^.pixels, Thumbnail^.h * Thumbnail^.pitch);
+
+ try
+ // Note: use a transaction to speed-up file-writing.
+ // Without data written by the first INSERT might be moved at the second INSERT.
+ DB.BeginTransaction();
+
+ // add general cover info
+ DB.ExecSQL('INSERT INTO ['+COVER_TBL+'] ' +
+ '([Filename], [Date], [Width], [Height]) VALUES' +
+ '(?, ?, ?, ?)',
+ [UTF8Encode(Filename), DateTimeToUnixTime(FileDate),
+ Info.CoverWidth, Info.CoverHeight]);
+
+ // get auto-generated cover ID
+ CoverID := DB.GetLastInsertRowID();
+
+ // add thumbnail info
+ DB.ExecSQL('INSERT INTO ['+COVER_THUMBNAIL_TBL+'] ' +
+ '([ID], [Format], [Width], [Height], [Data]) VALUES' +
+ '(?, ?, ?, ?, ?)',
+ [CoverID, Ord(Info.PixelFormat),
+ Thumbnail^.w, Thumbnail^.h, CoverData]);
+
+ Result := TCover.Create(CoverID, Filename);
+ except on E: Exception do
+ Log.LogError(E.Message, 'TCoverDatabase.AddCover');
+ end;
+
+ DB.Commit();
+ CoverData.Free;
+ SDL_FreeSurface(Thumbnail);
+end;
+
+function TCoverDatabase.LoadCover(CoverID: int64): TTexture;
+var
+ Width, Height: integer;
+ PixelFmt: TImagePixelFmt;
+ Data: PChar;
+ DataSize: integer;
+ Filename: WideString;
+ Table: TSQLiteUniTable;
+begin
+ Table := nil;
+
+ try
+ Table := DB.GetUniTable(Format(
+ 'SELECT C.[Filename], T.[Format], T.[Width], T.[Height], T.[Data] ' +
+ 'FROM ['+COVER_TBL+'] C ' +
+ 'INNER JOIN ['+COVER_THUMBNAIL_TBL+'] T ' +
+ 'USING(ID) ' +
+ 'WHERE [ID] = %d', [CoverID]));
+
+ Filename := UTF8Decode(Table.FieldAsString(0));
+ PixelFmt := TImagePixelFmt(Table.FieldAsInteger(1));
+ Width := Table.FieldAsInteger(2);
+ Height := Table.FieldAsInteger(3);
+
+ Data := Table.FieldAsBlobPtr(4, DataSize);
+ if (Data <> nil) and
+ (PixelFmt = ipfRGB) then
+ begin
+ Result := Texture.CreateTexture(Data, Filename, Width, Height, 24)
+ end
+ else
+ begin
+ FillChar(Result, SizeOf(TTexture), 0);
+ end;
+ except on E: Exception do
+ Log.LogError(E.Message, 'TCoverDatabase.LoadCover');
+ end;
+
+ Table.Free;
+end;
+
+procedure TCoverDatabase.DeleteCover(CoverID: int64);
+begin
+ DB.ExecSQL(Format('DELETE FROM ['+COVER_TBL+'] WHERE [ID] = %d', [CoverID]));
+ DB.ExecSQL(Format('DELETE FROM ['+COVER_THUMBNAIL_TBL+'] WHERE [ID] = %d', [CoverID]));
+end;
+
+(**
+ * Returns a pointer to an array of bytes containing the texture data in the
+ * requested size
+ *)
+function TCoverDatabase.CreateThumbnail(const Filename: WideString; var Info: TThumbnailInfo): PSDL_Surface;
+var
+ TargetAspect, SourceAspect: double;
+ //TargetWidth, TargetHeight: integer;
+ Thumbnail: PSDL_Surface;
+ MaxSize: integer;
+begin
+ Result := nil;
+
+ MaxSize := GetMaxCoverSize();
+
+ Thumbnail := LoadImage(Filename);
+ if (not assigned(Thumbnail)) then
+ begin
+ Log.LogError('Could not load cover: "'+ Filename +'"', 'TCoverDatabase.AddCover');
+ Exit;
+ end;
+
+ // Convert pixel format as needed
+ AdjustPixelFormat(Thumbnail, TEXTURE_TYPE_PLAIN);
+
+ Info.CoverWidth := Thumbnail^.w;
+ Info.CoverHeight := Thumbnail^.h;
+ Info.PixelFormat := ipfRGB;
+
+ (* TODO: keep aspect ratio
+ TargetAspect := Width / Height;
+ SourceAspect := TexSurface.w / TexSurface.h;
+
+ // Scale texture to covers dimensions (keep aspect)
+ if (SourceAspect >= TargetAspect) then
+ begin
+ TargetWidth := Width;
+ TargetHeight := Trunc(Width / SourceAspect);
+ end
+ else
+ begin
+ TargetHeight := Height;
+ TargetWidth := Trunc(Height * SourceAspect);
+ end;
+ *)
+
+ // TODO: do not scale if image is smaller
+ ScaleImage(Thumbnail, MaxSize, MaxSize);
+
+ Result := Thumbnail;
+end;
+
+end.
+
diff --git a/src/base/UDLLManager.pas b/src/base/UDLLManager.pas
new file mode 100644
index 00000000..3d32a72a
--- /dev/null
+++ b/src/base/UDLLManager.pas
@@ -0,0 +1,253 @@
+unit UDLLManager;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+uses ModiSDK,
+ UFiles;
+
+type
+ TDLLMan = class
+ private
+ hLib: THandle;
+ P_Init: fModi_Init;
+ P_Draw: fModi_Draw;
+ P_Finish: fModi_Finish;
+ P_RData: pModi_RData;
+ public
+ Plugins: array of TPluginInfo;
+ PluginPaths: array of String;
+ Selected: ^TPluginInfo;
+
+ constructor Create;
+
+ procedure GetPluginList;
+ procedure ClearPluginInfo(No: Cardinal);
+ function LoadPluginInfo(Filename: String; No: Cardinal): boolean;
+
+ function LoadPlugin(No: Cardinal): boolean;
+ procedure UnLoadPlugin;
+
+ function PluginInit (const TeamInfo: TTeamInfo; var Playerinfo: TPlayerinfo; const Sentences: TSentences; const LoadTex: fModi_LoadTex; const Print: fModi_Print; LoadSound: fModi_LoadSound; PlaySound: pModi_PlaySound): boolean;
+ function PluginDraw (var Playerinfo: TPlayerinfo; const CurSentence: Cardinal): boolean;
+ function PluginFinish (var Playerinfo: TPlayerinfo): byte;
+ procedure PluginRData (handle: HSTREAM; buffer: Pointer; len: DWORD; user: DWORD);
+ end;
+
+var
+ DLLMan: TDLLMan;
+
+const
+ DLLPath = 'Plugins';
+
+ {$IFDEF MSWINDOWS}
+ DLLExt = '.dll';
+ {$ENDIF}
+ {$IFDEF LINUX}
+ DLLExt = '.so';
+ {$ENDIF}
+ {$IFDEF DARWIN}
+ DLLExt = '.dylib';
+ {$ENDIF}
+
+implementation
+
+uses {$IFDEF MSWINDOWS}
+ windows,
+ {$ELSE}
+ dynlibs,
+ {$ENDIF}
+ ULog,
+ SysUtils;
+
+
+constructor TDLLMan.Create;
+begin
+ inherited;
+ SetLength(Plugins, 0);
+ SetLength(PluginPaths, Length(Plugins));
+ GetPluginList;
+end;
+
+procedure TDLLMan.GetPluginList;
+var
+ SR: TSearchRec;
+begin
+
+ if FindFirst(DLLPath +PathDelim+ '*' + DLLExt, faAnyFile , SR) = 0 then
+ begin
+ repeat
+ SetLength(Plugins, Length(Plugins)+1);
+ SetLength(PluginPaths, Length(Plugins));
+
+ if LoadPluginInfo(SR.Name, High(Plugins)) then //Loaded succesful
+ begin
+ PluginPaths[High(PluginPaths)] := SR.Name;
+ end
+ else //Error Loading
+ begin
+ SetLength(Plugins, Length(Plugins)-1);
+ SetLength(PluginPaths, Length(Plugins));
+ end;
+
+ until FindNext(SR) <> 0;
+ FindClose(SR);
+ end;
+end;
+
+procedure TDLLMan.ClearPluginInfo(No: Cardinal);
+begin
+ //Set to Party Modi Plugin
+ Plugins[No].Typ := 8;
+
+ Plugins[No].Name := 'unknown';
+ Plugins[No].NumPlayers := 0;
+
+ Plugins[No].Creator := 'Nobody';
+ Plugins[No].PluginDesc := 'NO_PLUGIN_DESC';
+
+ Plugins[No].LoadSong := True;
+ Plugins[No].ShowScore := True;
+ Plugins[No].ShowBars := False;
+ Plugins[No].ShowNotes := True;
+ Plugins[No].LoadVideo := True;
+ Plugins[No].LoadBack := True;
+
+ Plugins[No].TeamModeOnly := False;
+ Plugins[No].GetSoundData := False;
+ Plugins[No].Dummy := False;
+
+
+ Plugins[No].BGShowFull := False;
+ Plugins[No].BGShowFull_O := True;
+
+ Plugins[No].ShowRateBar:= False;
+ Plugins[No].ShowRateBar_O := True;
+
+ Plugins[No].EnLineBonus := False;
+ Plugins[No].EnLineBonus_O := True;
+end;
+
+function TDLLMan.LoadPluginInfo(Filename: String; No: Cardinal): boolean;
+var
+ hLibg: THandle;
+ Info: pModi_PluginInfo;
+ I: Integer;
+begin
+ Result := False;
+ //Clear Plugin Info
+ ClearPluginInfo(No);
+
+ {//Workaround Plugins Loaded 2 Times
+ For I := low(PluginPaths) to high(PluginPaths) do
+ if (PluginPaths[I] = Filename) then
+ exit; }
+
+ //Load Libary
+ hLibg := LoadLibrary(PChar(DLLPath +PathDelim+ Filename));
+ //If Loaded
+ if (hLibg <> 0) then
+ begin
+ //Load Info Procedure
+ @Info := GetProcAddress (hLibg, PChar('PluginInfo'));
+
+ //If Loaded
+ if (@Info <> nil) then
+ begin
+ //Load PluginInfo
+ Info (Plugins[No]);
+ Result := True;
+ end
+ else
+ Log.LogError('Could not Load Plugin "' + Filename + '": Info Procedure not Found');
+
+ FreeLibrary (hLibg);
+ end
+ else
+ Log.LogError('Could not Load Plugin "' + Filename + '": Libary not Loaded');
+end;
+
+function TDLLMan.LoadPlugin(No: Cardinal): boolean;
+begin
+ Result := False;
+ //Load Libary
+ hLib := LoadLibrary(PChar(DLLPath +PathDelim+ PluginPaths[No]));
+ //If Loaded
+ if (hLib <> 0) then
+ begin
+ //Load Info Procedure
+ @P_Init := GetProcAddress (hLib, PChar('Init'));
+ @P_Draw := GetProcAddress (hLib, PChar('Draw'));
+ @P_Finish := GetProcAddress (hLib, PChar('Finish'));
+
+ //If Loaded
+ if (@P_Init <> nil) And (@P_Draw <> nil) And (@P_Finish <> nil) then
+ begin
+ Selected := @Plugins[No];
+ Result := True;
+ end
+ else
+ begin
+ Log.LogError('Could not Load Plugin "' + PluginPaths[No] + '": Procedures not Found');
+
+ end;
+ end
+ else
+ Log.LogError('Could not Load Plugin "' + PluginPaths[No] + '": Libary not Loaded');
+end;
+
+procedure TDLLMan.UnLoadPlugin;
+begin
+if (hLib <> 0) then
+ FreeLibrary (hLib);
+
+//Selected := nil;
+@P_Init := nil;
+@P_Draw := nil;
+@P_Finish := nil;
+@P_RData := nil;
+end;
+
+function TDLLMan.PluginInit (const TeamInfo: TTeamInfo; var Playerinfo: TPlayerinfo; const Sentences: TSentences; const LoadTex: fModi_LoadTex; const Print: fModi_Print; LoadSound: fModi_LoadSound; PlaySound: pModi_PlaySound): boolean;
+var
+ Methods: TMethodRec;
+begin
+ Methods.LoadTex := LoadTex;
+ Methods.Print := Print;
+ Methods.LoadSound := LoadSound;
+ Methods.PlaySound := PlaySound;
+
+ if (@P_Init <> nil) then
+ Result := P_Init (TeamInfo, PlayerInfo, Sentences, Methods)
+ else
+ Result := False
+end;
+
+function TDLLMan.PluginDraw (var Playerinfo: TPlayerinfo; const CurSentence: Cardinal): boolean;
+begin
+if (@P_Draw <> nil) then
+ Result := P_Draw (PlayerInfo, CurSentence)
+else
+ Result := False
+end;
+
+function TDLLMan.PluginFinish (var Playerinfo: TPlayerinfo): byte;
+begin
+if (@P_Finish <> nil) then
+ Result := P_Finish (PlayerInfo)
+else
+ Result := 0;
+end;
+
+procedure TDLLMan.PluginRData (handle: HSTREAM; buffer: Pointer; len: DWORD; user: DWORD);
+begin
+if (@P_RData <> nil) then
+ P_RData (handle, buffer, len, user);
+end;
+
+end.
diff --git a/src/base/UDataBase.pas b/src/base/UDataBase.pas
new file mode 100644
index 00000000..cd315df3
--- /dev/null
+++ b/src/base/UDataBase.pas
@@ -0,0 +1,533 @@
+unit UDataBase;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+uses USongs,
+ USong,
+ Classes,
+ SQLiteTable3;
+
+//--------------------
+//DataBaseSystem - Class including all DB Methods
+//--------------------
+type
+ TStatType = (
+ stBestScores, // Best Scores
+ stBestSingers, // Best Singers
+ stMostSungSong, // Most sung Songs
+ stMostPopBand // Most popular Band
+ );
+
+ // abstract super-class for statistic results
+ TStatResult = class
+ public
+ Typ: TStatType;
+ end;
+
+ TStatResultBestScores = class(TStatResult)
+ public
+ Singer: WideString;
+ Score: Word;
+ Difficulty: Byte;
+ SongArtist: WideString;
+ SongTitle: WideString;
+ end;
+
+ TStatResultBestSingers = class(TStatResult)
+ public
+ Player: WideString;
+ AverageScore: Word;
+ end;
+
+ TStatResultMostSungSong = class(TStatResult)
+ public
+ Artist: WideString;
+ Title: WideString;
+ TimesSung: Word;
+ end;
+
+ TStatResultMostPopBand = class(TStatResult)
+ public
+ ArtistName: WideString;
+ TimesSungTot: Word;
+ end;
+
+
+ TDataBaseSystem = class
+ private
+ ScoreDB: TSQLiteDatabase;
+ fFilename: string;
+
+ function GetVersion(): integer;
+ procedure SetVersion(Version: integer);
+ public
+ property Filename: string read fFilename;
+
+ destructor Destroy; override;
+
+ procedure Init(const Filename: string);
+ procedure ReadScore(Song: TSong);
+ procedure AddScore(Song: TSong; Level: integer; const Name: WideString; Score: integer);
+ procedure WriteScore(Song: TSong);
+
+ function GetStats(Typ: TStatType; Count: Byte; Page: Cardinal; Reversed: Boolean): TList;
+ procedure FreeStats(StatList: TList);
+ function GetTotalEntrys(Typ: TStatType): Cardinal;
+ function GetStatReset: TDateTime;
+ end;
+
+var
+ DataBase: TDataBaseSystem;
+
+implementation
+
+uses
+ ULog,
+ DateUtils,
+ StrUtils,
+ SysUtils;
+
+const
+ cDBVersion = 01; // 0.1
+ cUS_Scores = 'us_scores';
+ cUS_Songs = 'us_songs';
+ cUS_Statistics_Info = 'us_statistics_info';
+
+(**
+ * Opens Database and Create Tables if not Exist
+ *)
+procedure TDataBaseSystem.Init(const Filename: string);
+var
+ Version: integer;
+begin
+ if Assigned(ScoreDB) then
+ Exit;
+
+ Log.LogStatus('Initializing database: "'+Filename+'"', 'TDataBaseSystem.Init');
+
+ try
+
+ // Open Database
+ ScoreDB := TSQLiteDatabase.Create(Filename);
+ fFilename := Filename;
+
+ // Close and delete outdated file
+ Version := GetVersion();
+ if ((Version <> 0) and (Version <> cDBVersion)) then
+ begin
+ Log.LogInfo('Outdated cover-database file found', 'TDataBaseSystem.Init');
+ // Close and delete outdated file
+ ScoreDB.Free;
+ if (not DeleteFile(Filename)) then
+ raise Exception.Create('Could not delete ' + Filename);
+ // Reopen
+ ScoreDB := TSQLiteDatabase.Create(Filename);
+ Version := 0;
+ end;
+
+ // Set version number after creation
+ if (Version = 0) then
+ SetVersion(cDBVersion);
+
+
+ // SQLite does not handle VARCHAR(n) or INT(n) as expected.
+ // Texts do not have a restricted length, no matter which type is used,
+ // so use the native TEXT type. INT(n) is always INTEGER.
+ // In addition, SQLiteTable3 will fail if other types than the native SQLite
+ // types are used (especially FieldAsInteger). Also take care to write the
+ // types in upper-case letters although SQLite does not care about this -
+ // SQLiteTable3 is very sensitive in this regard.
+
+ ScoreDB.ExecSQL('CREATE TABLE IF NOT EXISTS ['+cUS_Scores+'] (' +
+ '[SongID] INTEGER NOT NULL, ' +
+ '[Difficulty] INTEGER NOT NULL, ' +
+ '[Player] TEXT NOT NULL, ' +
+ '[Score] INTEGER NOT NULL' +
+ ');');
+
+ ScoreDB.ExecSQL('CREATE TABLE IF NOT EXISTS ['+cUS_Songs+'] (' +
+ '[ID] INTEGER PRIMARY KEY, ' +
+ '[Artist] TEXT NOT NULL, ' +
+ '[Title] TEXT NOT NULL, ' +
+ '[TimesPlayed] INTEGER NOT NULL' +
+ ');');
+
+ if not ScoreDB.TableExists(cUS_Statistics_Info) then
+ begin
+ ScoreDB.ExecSQL('CREATE TABLE IF NOT EXISTS ['+cUS_Statistics_Info+'] (' +
+ '[ResetTime] INTEGER' +
+ ');');
+ // insert creation timestamp
+ ScoreDB.ExecSQL(Format('INSERT INTO ['+cUS_Statistics_Info+'] ' +
+ '([ResetTime]) VALUES(%d);',
+ [DateTimeToUnix(Now())]));
+ end;
+
+ except
+ on E: Exception do
+ begin
+ Log.LogError(E.Message, 'TDataBaseSystem.Init');
+ FreeAndNil(ScoreDB);
+ end;
+ end;
+
+end;
+
+(**
+ * Frees Database
+ *)
+destructor TDataBaseSystem.Destroy;
+begin
+ Log.LogInfo('TDataBaseSystem.Free', 'TDataBaseSystem.Destroy');
+ ScoreDB.Free;
+ inherited;
+end;
+
+(**
+ * Read Scores into SongArray
+ *)
+procedure TDataBaseSystem.ReadScore(Song: TSong);
+var
+ TableData: TSQLiteUniTable;
+ Difficulty: Integer;
+begin
+ if not Assigned(ScoreDB) then
+ Exit;
+
+ TableData := nil;
+
+ try
+ // Search Song in DB
+ TableData := ScoreDB.GetUniTable(
+ 'SELECT [Difficulty], [Player], [Score] FROM ['+cUS_Scores+'] ' +
+ 'WHERE [SongID] = (' +
+ 'SELECT [ID] FROM ['+cUS_Songs+'] ' +
+ 'WHERE [Artist] = ? AND [Title] = ? ' +
+ 'LIMIT 1) ' +
+ 'ORDER BY [Score] DESC LIMIT 15',
+ [UTF8Encode(Song.Artist), UTF8Encode(Song.Title)]);
+
+ // Empty Old Scores
+ SetLength(Song.Score[0], 0);
+ SetLength(Song.Score[1], 0);
+ SetLength(Song.Score[2], 0);
+
+ // Go through all Entrys
+ while (not TableData.EOF) do
+ begin
+ // Add one Entry to Array
+ Difficulty := TableData.FieldAsInteger(TableData.FieldIndex['Difficulty']);
+ if ((Difficulty >= 0) and (Difficulty <= 2)) and
+ (Length(Song.Score[Difficulty]) < 5) then
+ begin
+ SetLength(Song.Score[Difficulty], Length(Song.Score[Difficulty]) + 1);
+
+ Song.Score[Difficulty, High(Song.Score[Difficulty])].Name :=
+ UTF8Decode(TableData.FieldByName['Player']);
+ Song.Score[Difficulty, High(Song.Score[Difficulty])].Score :=
+ TableData.FieldAsInteger(TableData.FieldIndex['Score']);
+ end;
+
+ TableData.Next;
+ end; // while
+
+ except
+ for Difficulty := 0 to 2 do
+ begin
+ SetLength(Song.Score[Difficulty], 1);
+ Song.Score[Difficulty, 1].Name := 'Error Reading ScoreDB';
+ end;
+ end;
+
+ TableData.Free;
+end;
+
+(**
+ * Adds one new score to DB
+ *)
+procedure TDataBaseSystem.AddScore(Song: TSong; Level: integer; const Name: WideString; Score: integer);
+var
+ ID: Integer;
+ TableData: TSQLiteTable;
+begin
+ if not Assigned(ScoreDB) then
+ Exit;
+
+ // Prevent 0 Scores from being added
+ if (Score <= 0) then
+ Exit;
+
+ TableData := nil;
+
+ try
+
+ ID := ScoreDB.GetTableValue(
+ 'SELECT [ID] FROM ['+cUS_Songs+'] ' +
+ 'WHERE [Artist] = ? AND [Title] = ?',
+ [UTF8Encode(Song.Artist), UTF8Encode(Song.Title)]);
+ if (ID = 0) then
+ begin
+ // Create song if it does not exist
+ ScoreDB.ExecSQL(
+ 'INSERT INTO ['+cUS_Songs+'] ' +
+ '([ID], [Artist], [Title], [TimesPlayed]) VALUES ' +
+ '(NULL, ?, ?, 0);',
+ [UTF8Encode(Song.Artist), UTF8Encode(Song.Title)]);
+ // Get song-ID
+ ID := ScoreDB.GetLastInsertRowID();
+ end;
+ // Create new entry
+ ScoreDB.ExecSQL(
+ 'INSERT INTO ['+cUS_Scores+'] ' +
+ '([SongID] ,[Difficulty], [Player], [Score]) VALUES ' +
+ '(?, ?, ?, ?);',
+ [ID, Level, UTF8Encode(Name), Score]);
+
+ // Delete last position when there are more than 5 entrys.
+ // Fixes crash when there are > 5 ScoreEntrys
+ // Note: GetUniTable is not applicable here, as the results are used while
+ // table entries are deleted.
+ TableData := ScoreDB.GetTable(
+ 'SELECT [Player], [Score] FROM ['+cUS_Scores+'] ' +
+ 'WHERE [SongID] = ' + InttoStr(ID) + ' AND ' +
+ '[Difficulty] = ' + InttoStr(Level) +' ' +
+ 'ORDER BY [Score] DESC LIMIT -1 OFFSET 5');
+
+ while (not TableData.EOF) do
+ begin
+ // Note: Score is an int-value, so in contrast to Player, we do not bind
+ // this value. Otherwise we had to convert the string to an int to avoid
+ // an automatic cast of this field to the TEXT type (although it might even
+ // work that way).
+ ScoreDB.ExecSQL(
+ 'DELETE FROM ['+cUS_Scores+'] ' +
+ 'WHERE [SongID] = ' + InttoStr(ID) + ' AND ' +
+ '[Difficulty] = ' + InttoStr(Level) +' AND ' +
+ '[Player] = ? AND ' +
+ '[Score] = ' + TableData.FieldByName['Score'],
+ [TableData.FieldByName['Player']]);
+
+ TableData.Next;
+ end;
+
+ except on E: Exception do
+ Log.LogError(E.Message, 'TDataBaseSystem.AddScore');
+ end;
+
+ TableData.Free;
+end;
+
+(**
+ * Not needed with new System.
+ * Used for increment played count
+ *)
+procedure TDataBaseSystem.WriteScore(Song: TSong);
+begin
+ if not Assigned(ScoreDB) then
+ Exit;
+
+ try
+ // Increase TimesPlayed
+ ScoreDB.ExecSQL(
+ 'UPDATE ['+cUS_Songs+'] ' +
+ 'SET [TimesPlayed] = [TimesPlayed] + 1 ' +
+ 'WHERE [Title] = ? AND [Artist] = ?;',
+ [UTF8Encode(Song.Title), UTF8Encode(Song.Artist)]);
+ except on E: Exception do
+ Log.LogError(E.Message, 'TDataBaseSystem.WriteScore');
+ end;
+end;
+
+(**
+ * Writes some stats to array.
+ * Returns nil if the database is not ready or a list with zero or more statistic
+ * entries.
+ * Free the result-list with FreeStats() after usage to avoid memory leaks.
+ *)
+function TDataBaseSystem.GetStats(Typ: TStatType; Count: Byte; Page: Cardinal; Reversed: Boolean): TList;
+var
+ Query: String;
+ TableData: TSQLiteUniTable;
+ Stat: TStatResult;
+begin
+ Result := nil;
+
+ if not Assigned(ScoreDB) then
+ Exit;
+
+ {Todo: Add Prevention that only players with more than 5 scores are selected at type 2}
+
+ // Create query
+ case Typ of
+ stBestScores: begin
+ Query := 'SELECT [Player], [Difficulty], [Score], [Artist], [Title] FROM ['+cUS_Scores+'] ' +
+ 'INNER JOIN ['+cUS_Songs+'] ON ([SongID] = [ID]) ORDER BY [Score]';
+ end;
+ stBestSingers: begin
+ Query := 'SELECT [Player], ROUND(AVG([Score])) FROM ['+cUS_Scores+'] ' +
+ 'GROUP BY [Player] ORDER BY AVG([Score])';
+ end;
+ stMostSungSong: begin
+ Query := 'SELECT [Artist], [Title], [TimesPlayed] FROM ['+cUS_Songs+'] ' +
+ 'ORDER BY [TimesPlayed]';
+ end;
+ stMostPopBand: begin
+ Query := 'SELECT [Artist], SUM([TimesPlayed]) FROM ['+cUS_Songs+'] ' +
+ 'GROUP BY [Artist] ORDER BY SUM([TimesPlayed])';
+ end;
+ end;
+
+ // Add order direction
+ Query := Query + IfThen(Reversed, ' ASC', ' DESC');
+
+ // Add limit
+ Query := Query + ' LIMIT ' + InttoStr(Count * Page) + ', ' + InttoStr(Count) + ';';
+
+ // Execute query
+ try
+ TableData := ScoreDB.GetUniTable(Query);
+ except
+ on E: Exception do
+ begin
+ Log.LogError(E.Message, 'TDataBaseSystem.GetStats');
+ Exit;
+ end;
+ end;
+
+ Result := TList.Create;
+ Stat := nil;
+
+ // Copy result to stats array
+ while not TableData.EOF do
+ begin
+ case Typ of
+ stBestScores: begin
+ Stat := TStatResultBestScores.Create;
+ with TStatResultBestScores(Stat) do
+ begin
+ Singer := UTF8Decode(TableData.Fields[0]);
+ Difficulty := TableData.FieldAsInteger(1);
+ Score := TableData.FieldAsInteger(2);
+ SongArtist := UTF8Decode(TableData.Fields[3]);
+ SongTitle := UTF8Decode(TableData.Fields[4]);
+ end;
+ end;
+ stBestSingers: begin
+ Stat := TStatResultBestSingers.Create;
+ with TStatResultBestSingers(Stat) do
+ begin
+ Player := UTF8Decode(TableData.Fields[0]);
+ AverageScore := TableData.FieldAsInteger(1);
+ end;
+ end;
+ stMostSungSong: begin
+ Stat := TStatResultMostSungSong.Create;
+ with TStatResultMostSungSong(Stat) do
+ begin
+ Artist := UTF8Decode(TableData.Fields[0]);
+ Title := UTF8Decode(TableData.Fields[1]);
+ TimesSung := TableData.FieldAsInteger(2);
+ end;
+ end;
+ stMostPopBand: begin
+ Stat := TStatResultMostPopBand.Create;
+ with TStatResultMostPopBand(Stat) do
+ begin
+ ArtistName := UTF8Decode(TableData.Fields[0]);
+ TimesSungTot := TableData.FieldAsInteger(1);
+ end;
+ end
+ else
+ Log.LogCritical('Unknown stat-type', 'TDataBaseSystem.GetStats');
+ end;
+
+ Stat.Typ := Typ;
+ Result.Add(Stat);
+
+ TableData.Next;
+ end;
+
+ TableData.Free;
+end;
+
+procedure TDataBaseSystem.FreeStats(StatList: TList);
+var
+ I: integer;
+begin
+ if (StatList = nil) then
+ Exit;
+ for I := 0 to StatList.Count-1 do
+ TStatResult(StatList[I]).Free;
+ StatList.Free;
+end;
+
+(**
+ * Gets total number of entrys for a stats query
+ *)
+function TDataBaseSystem.GetTotalEntrys(Typ: TStatType): Cardinal;
+var
+ Query: String;
+begin
+ Result := 0;
+
+ if not Assigned(ScoreDB) then
+ Exit;
+
+ try
+ // Create query
+ case Typ of
+ stBestScores:
+ Query := 'SELECT COUNT([SongID]) FROM ['+cUS_Scores+'];';
+ stBestSingers:
+ Query := 'SELECT COUNT(DISTINCT [Player]) FROM ['+cUS_Scores+'];';
+ stMostSungSong:
+ Query := 'SELECT COUNT([ID]) FROM ['+cUS_Songs+'];';
+ stMostPopBand:
+ Query := 'SELECT COUNT(DISTINCT [Artist]) FROM ['+cUS_Songs+'];';
+ end;
+
+ Result := ScoreDB.GetTableValue(Query);
+ except on E: Exception do
+ Log.LogError(E.Message, 'TDataBaseSystem.GetTotalEntrys');
+ end;
+
+end;
+
+(**
+ * Gets reset date of statistic data
+ *)
+function TDataBaseSystem.GetStatReset: TDateTime;
+var
+ Query: string;
+ ResetTime: int64;
+begin
+ Result := 0;
+
+ if not Assigned(ScoreDB) then
+ Exit;
+
+ try
+ Query := 'SELECT [ResetTime] FROM ['+cUS_Statistics_Info+'];';
+ Result := UnixToDateTime(ScoreDB.GetTableValue(Query));
+ except on E: Exception do
+ Log.LogError(E.Message, 'TDataBaseSystem.GetStatReset');
+ end;
+end;
+
+function TDataBaseSystem.GetVersion(): integer;
+begin
+ Result := ScoreDB.GetTableValue('PRAGMA user_version');
+end;
+
+procedure TDataBaseSystem.SetVersion(Version: integer);
+begin
+ ScoreDB.ExecSQL(Format('PRAGMA user_version = %d', [Version]));
+end;
+
+end.
diff --git a/src/base/UDraw.pas b/src/base/UDraw.pas
new file mode 100644
index 00000000..ff0920f5
--- /dev/null
+++ b/src/base/UDraw.pas
@@ -0,0 +1,1390 @@
+unit UDraw;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+uses
+ UThemes,
+ ModiSDK,
+ UGraphicClasses;
+
+procedure SingDraw;
+procedure SingModiDraw (PlayerInfo: TPlayerInfo);
+procedure SingDrawBackground;
+procedure SingDrawOscilloscope(X, Y, W, H: real; NrSound: integer);
+procedure SingDrawNoteLines(Left, Top, Right: real; Space: integer);
+procedure SingDrawLyricHelper(Left, LyricsMid: real);
+procedure SingDrawBeatDelimeters(Left, Top, Right: real; NrLines: integer);
+procedure SingDrawLine(Left, Top, Right: real; NrLines: integer; Space: integer);
+procedure SingDrawPlayerLine(X, Y, W: real; PlayerIndex: integer; Space: integer);
+procedure SingDrawPlayerBGLine(Left, Top, Right: real; NrLines, PlayerIndex: integer; Space: integer);
+
+// TimeBar
+procedure SingDrawTimeBar();
+
+//Draw Editor NoteLines
+procedure EditDrawLine(Left, Top, Right: real; NrLines: integer; Space: integer);
+
+
+type
+ TRecR = record
+ Top: real;
+ Left: real;
+ Right: real;
+ Bottom: real;
+
+ Width: real;
+ WMid: real;
+ Height: real;
+ HMid: real;
+
+ Mid: real;
+ end;
+
+var
+ NotesW: real;
+ NotesH: real;
+ Starfr: integer;
+ StarfrG: integer;
+
+ //SingBar
+ TickOld: cardinal;
+ TickOld2:cardinal;
+
+const
+ Przedz = 32;
+
+implementation
+
+uses
+ gl,
+ UGraphic,
+ SysUtils,
+ UMusic,
+ URecord,
+ ULog,
+ UScreenSing,
+ UScreenSingModi,
+ ULyrics,
+ UMain,
+ TextGL,
+ UTexture,
+ UDrawTexture,
+ UIni,
+ Math,
+ UDLLManager;
+
+procedure SingDrawBackground;
+var
+ Rec: TRecR;
+ TexRec: TRecR;
+begin
+ if (ScreenSing.Tex_Background.TexNum > 0) then begin
+
+ glClearColor (1, 1, 1, 1);
+ glColor4f (1, 1, 1, 1);
+
+ if (Ini.MovieSize <= 1) then //HalfSize BG
+ begin
+ (* half screen + gradient *)
+ Rec.Top := 110; // 80
+ Rec.Bottom := Rec.Top + 20;
+ Rec.Left := 0;
+ Rec.Right := 800;
+
+ TexRec.Top := (Rec.Top / 600) * ScreenSing.Tex_Background.TexH;
+ TexRec.Bottom := (Rec.Bottom / 600) * ScreenSing.Tex_Background.TexH;
+ TexRec.Left := 0;
+ TexRec.Right := ScreenSing.Tex_Background.TexW;
+
+ glEnable(GL_TEXTURE_2D);
+ glBindTexture(GL_TEXTURE_2D, ScreenSing.Tex_Background.TexNum);
+ glEnable(GL_BLEND);
+ glBegin(GL_QUADS);
+ (* gradient draw *)
+ (* top *)
+ glColor4f(1, 1, 1, 0);
+ glTexCoord2f(TexRec.Right, TexRec.Top); glVertex2f(Rec.Right, Rec.Top);
+ glTexCoord2f(TexRec.Left, TexRec.Top); glVertex2f(Rec.Left, Rec.Top);
+ glColor4f(1, 1, 1, 1);
+ glTexCoord2f(TexRec.Left, TexRec.Bottom); glVertex2f(Rec.Left, Rec.Bottom);
+ glTexCoord2f(TexRec.Right, TexRec.Bottom); glVertex2f(Rec.Right, Rec.Bottom);
+ (* mid *)
+ Rec.Top := Rec.Bottom;
+ Rec.Bottom := 490 - 20; // 490 - 20
+ TexRec.Top := TexRec.Bottom;
+ TexRec.Bottom := (Rec.Bottom / 600) * ScreenSing.Tex_Background.TexH;
+ glTexCoord2f(TexRec.Left, TexRec.Top); glVertex2f(Rec.Left, Rec.Top);
+ glTexCoord2f(TexRec.Left, TexRec.Bottom); glVertex2f(Rec.Left, Rec.Bottom);
+ glTexCoord2f(TexRec.Right, TexRec.Bottom); glVertex2f(Rec.Right, Rec.Bottom);
+ glTexCoord2f(TexRec.Right, TexRec.Top); glVertex2f(Rec.Right, Rec.Top);
+ (* bottom *)
+ Rec.Top := Rec.Bottom;
+ Rec.Bottom := 490; // 490
+ TexRec.Top := TexRec.Bottom;
+ TexRec.Bottom := (Rec.Bottom / 600) * ScreenSing.Tex_Background.TexH;
+ glTexCoord2f(TexRec.Right, TexRec.Top); glVertex2f(Rec.Right, Rec.Top);
+ glTexCoord2f(TexRec.Left, TexRec.Top); glVertex2f(Rec.Left, Rec.Top);
+ glColor4f(1, 1, 1, 0);
+ glTexCoord2f(TexRec.Left, TexRec.Bottom); glVertex2f(Rec.Left, Rec.Bottom);
+ glTexCoord2f(TexRec.Right, TexRec.Bottom); glVertex2f(Rec.Right, Rec.Bottom);
+
+ glEnd;
+ glDisable(GL_TEXTURE_2D);
+ glDisable(GL_BLEND);
+ end
+ else //Full Size BG
+ begin
+ glEnable(GL_TEXTURE_2D);
+ glBindTexture(GL_TEXTURE_2D, ScreenSing.Tex_Background.TexNum);
+ //glEnable(GL_BLEND);
+ glBegin(GL_QUADS);
+
+ glTexCoord2f(0, 0); glVertex2f(0, 0);
+ glTexCoord2f(0, ScreenSing.Tex_Background.TexH); glVertex2f(0, 600);
+ glTexCoord2f( ScreenSing.Tex_Background.TexW, ScreenSing.Tex_Background.TexH); glVertex2f(800, 600);
+ glTexCoord2f( ScreenSing.Tex_Background.TexW, 0); glVertex2f(800, 0);
+
+ glEnd;
+ glDisable(GL_TEXTURE_2D);
+ //glDisable(GL_BLEND);
+ end;
+ end;
+end;
+
+procedure SingDrawOscilloscope(X, Y, W, H: real; NrSound: integer);
+var
+ SampleIndex: integer;
+ Sound: TCaptureBuffer;
+ MaxX, MaxY: real;
+begin;
+ Sound := AudioInputProcessor.Sound[NrSound];
+
+ // Log.LogStatus('Oscilloscope', 'SingDraw');
+ glColor3f(Skin_OscR, Skin_OscG, Skin_OscB);
+ {if (ParamStr(1) = '-black') or (ParamStr(1) = '-fsblack') then
+ glColor3f(1, 1, 1); }
+
+ MaxX := W-1;
+ MaxY := (H-1) / 2;
+
+ Sound.LockAnalysisBuffer();
+
+ glBegin(GL_LINE_STRIP);
+ for SampleIndex := 0 to High(Sound.AnalysisBuffer) do
+ begin
+ glVertex2f(X + MaxX * SampleIndex/High(Sound.AnalysisBuffer),
+ Y + MaxY * (1 - Sound.AnalysisBuffer[SampleIndex]/-Low(Smallint)));
+ end;
+ glEnd;
+
+ Sound.UnlockAnalysisBuffer();
+end;
+
+
+
+procedure SingDrawNoteLines(Left, Top, Right: real; Space: integer);
+var
+ Count: integer;
+begin
+ glEnable(GL_BLEND);
+ glColor4f(Skin_P1_LinesR, Skin_P1_LinesG, Skin_P1_LinesB, 0.4);
+ glBegin(GL_LINES);
+ for Count := 0 to 9 do begin
+ glVertex2f(Left, Top + Count * Space);
+ glVertex2f(Right, Top + Count * Space);
+ end;
+ glEnd;
+ glDisable(GL_BLEND);
+end;
+
+procedure SingDrawBeatDelimeters(Left, Top, Right: real; NrLines: integer);
+var
+ Count: integer;
+ TempR: real;
+begin
+ TempR := (Right-Left) / (Lines[NrLines].Line[Lines[NrLines].Current].End_ - Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start);
+ glEnable(GL_BLEND);
+ glBegin(GL_LINES);
+ for Count := Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start to Lines[NrLines].Line[Lines[NrLines].Current].End_ do begin
+ if (Count mod Lines[NrLines].Resolution) = Lines[NrLines].NotesGAP then
+ glColor4f(0, 0, 0, 1)
+ else
+ glColor4f(0, 0, 0, 0.3);
+ glVertex2f(Left + TempR * (Count - Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start), Top);
+ glVertex2f(Left + TempR * (Count - Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start), Top + 135);
+ end;
+ glEnd;
+ glDisable(GL_BLEND);
+end;
+
+// draw blank Notebars
+procedure SingDrawLine(Left, Top, Right: real; NrLines: integer; Space: integer);
+var
+ Rec: TRecR;
+ Count: integer;
+ TempR: real;
+ R,G,B: real;
+
+ PlayerNumber: Integer;
+
+ GoldenStarPos : real;
+
+ lTmpA ,
+ lTmpB : real;
+begin
+// We actually don't have a playernumber in this procedure, it should reside in NrLines - but it's always set to zero
+// So we exploit this behavior a bit - we give NrLines the playernumber, keep it in playernumber - and then we set NrLines to zero
+// This could also come quite in handy when we do the duet mode, cause just the notes for the player that has to sing should be drawn then
+// BUT this is not implemented yet, all notes are drawn! :D
+
+ PlayerNumber := NrLines + 1; // Player 1 is 0
+ NrLines := 0;
+
+// exploit done
+
+ glColor3f(1, 1, 1);
+ glEnable(GL_TEXTURE_2D);
+ glEnable(GL_BLEND);
+ glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
+
+ lTmpA := (Right-Left);
+ lTmpB := (Lines[NrLines].Line[Lines[NrLines].Current].End_ - Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start);
+
+ if ( lTmpA > 0 ) AND
+ ( lTmpB > 0 ) THEN
+ begin
+ TempR := lTmpA / lTmpB;
+ end
+ else
+ begin
+ TempR := 0;
+ end;
+
+
+ with Lines[NrLines].Line[Lines[NrLines].Current] do begin
+ for Count := 0 to HighNote do begin
+ with Note[Count] do begin
+ if NoteType <> ntFreestyle then begin
+
+
+ if Ini.EffectSing = 0 then
+ // If Golden note Effect of then Change not Color
+ begin
+ case NoteType of
+ ntNormal: glColor4f(1, 1, 1, 1); // We set alpha to 1, cause we can control the transparency through the png itself
+ ntGolden: glColor4f(1, 1, 0.3, 1); // no stars, paint yellow -> glColor4f(1, 1, 0.3, 0.85); - we could
+ end; // case
+ end //Else all Notes same Color
+ else
+ glColor4f(1, 1, 1, 1); // We set alpha to 1, cause we can control the transparency through the png itself
+ // Czesci == teil, element == piece, element | koniec == end / ending
+ // lewa czesc - left part
+ Rec.Left := (Start-Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start) * TempR + Left + 0.5 + 10*ScreenX;
+ Rec.Right := Rec.Left + NotesW;
+ Rec.Top := Top - (Tone-BaseNote)*Space/2 - NotesH;
+ Rec.Bottom := Rec.Top + 2 * NotesH;
+ glBindTexture(GL_TEXTURE_2D, Tex_plain_Left[PlayerNumber].TexNum);
+ glBegin(GL_QUADS);
+ glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top);
+ glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom);
+ glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom);
+ glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top);
+ glEnd;
+
+ //We keep the postion of the top left corner b4 it's overwritten
+ GoldenStarPos := Rec.Left;
+ //done
+
+ // srodkowa czesc - middle part
+ Rec.Left := Rec.Right;
+ Rec.Right := (Start+Length-Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start) * TempR + Left - NotesW - 0.5 + 10*ScreenX; // Dlugosc == length
+
+ glBindTexture(GL_TEXTURE_2D, Tex_plain_Mid[PlayerNumber].TexNum);
+ glTexParameterf( GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT );
+ glTexParameterf( GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT );
+ glBegin(GL_QUADS);
+ glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top);
+ glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom);
+ glTexCoord2f(round((Rec.Right-Rec.Left)/32), 1); glVertex2f(Rec.Right, Rec.Bottom);
+ glTexCoord2f(round((Rec.Right-Rec.Left)/32), 0); glVertex2f(Rec.Right, Rec.Top);
+ glEnd;
+
+ // prawa czesc - right part
+ Rec.Left := Rec.Right;
+ Rec.Right := Rec.Right + NotesW;
+
+ glBindTexture(GL_TEXTURE_2D, Tex_plain_Right[PlayerNumber].TexNum);
+ glBegin(GL_QUADS);
+ glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top);
+ glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom);
+ glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom);
+ glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top);
+ glEnd;
+
+ // Golden Star Patch
+ if (NoteType = ntGolden) AND (Ini.EffectSing=1) then
+ begin
+ GoldenRec.SaveGoldenStarsRec(GoldenStarPos, Rec.Top, Rec.Right, Rec.Bottom);
+ end;
+
+ end; // if not FreeStyle
+ end; // with
+ end; // for
+ end; // with
+
+ glDisable(GL_BLEND);
+ glDisable(GL_TEXTURE_2D);
+end;
+
+
+// draw sung notes
+procedure SingDrawPlayerLine(X, Y, W: real; PlayerIndex: integer; Space: integer);
+var
+ TempR: real;
+ Rec: TRecR;
+ N: integer;
+ R, G, B, A: real;
+ NotesH2: real;
+begin
+ //Log.LogStatus('Player notes', 'SingDraw');
+
+ //if NrGracza = 0 then LoadColor(R, G, B, 'P1Light')
+ //else LoadColor(R, G, B, 'P2Light');
+
+ //R := 71/255;
+ //G := 175/255;
+ //B := 247/255;
+
+ glColor3f(1, 1, 1);
+ glEnable(GL_TEXTURE_2D);
+ glEnable(GL_BLEND);
+ glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
+
+ //if Player[NrGracza].LengthNote > 0 then
+ begin
+ TempR := W / (Lines[0].Line[Lines[0].Current].End_ - Lines[0].Line[Lines[0].Current].Note[0].Start);
+ for N := 0 to Player[PlayerIndex].HighNote do
+ begin
+ with Player[PlayerIndex].Note[N] do
+ begin
+ // Left part of note
+ Rec.Left := X + (Start-Lines[0].Line[Lines[0].Current].Note[0].Start) * TempR + 0.5 + 10*ScreenX;
+ Rec.Right := Rec.Left + NotesW;
+
+ // Draw it in half size, if not hit
+ if Hit then
+ begin
+ NotesH2 := NotesH
+ end
+ else
+ begin
+ NotesH2 := int(NotesH * 0.65);
+ end;
+
+ Rec.Top := Y - (Tone-Lines[0].Line[Lines[0].Current].BaseNote)*Space/2 - NotesH2;
+ Rec.Bottom := Rec.Top + 2 *NotesH2;
+
+ // draw the left part
+ glColor3f(1, 1, 1);
+ glBindTexture(GL_TEXTURE_2D, Tex_Left[PlayerIndex+1].TexNum);
+ glBegin(GL_QUADS);
+ glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top);
+ glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom);
+ glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom);
+ glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top);
+ glEnd;
+
+ // Middle part of the note
+ Rec.Left := Rec.Right;
+ Rec.Right := X + (Start+Length-Lines[0].Line[Lines[0].Current].Note[0].Start) * TempR - NotesW - 0.5 + 10*ScreenX;
+
+ // (nowe) - dunno
+ if (Start+Length-1 = LyricsState.CurrentBeatD) then
+ Rec.Right := Rec.Right - (1-Frac(LyricsState.MidBeatD)) * TempR;
+ // the left note is more right than the right note itself, sounds weird - so we fix that xD
+ if Rec.Right <= Rec.Left then
+ Rec.Right := Rec.Left;
+
+ // draw the middle part
+ glBindTexture(GL_TEXTURE_2D, Tex_Mid[PlayerIndex+1].TexNum);
+ glTexParameterf( GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT );
+ glTexParameterf( GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT );
+ glBegin(GL_QUADS);
+ glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top);
+ glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom);
+ glTexCoord2f(round((Rec.Right-Rec.Left)/32), 1); glVertex2f(Rec.Right, Rec.Bottom);
+ glTexCoord2f(round((Rec.Right-Rec.Left)/32), 0); glVertex2f(Rec.Right, Rec.Top);
+ glEnd;
+ glColor3f(1, 1, 1);
+
+ // the right part of the note
+ Rec.Left := Rec.Right;
+ Rec.Right := Rec.Right + NotesW;
+
+ glBindTexture(GL_TEXTURE_2D, Tex_Right[PlayerIndex+1].TexNum);
+ glBegin(GL_QUADS);
+ glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top);
+ glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom);
+ glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom);
+ glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top);
+ glEnd;
+
+ // Perfect note is stored
+ if Perfect and (Ini.EffectSing=1) then
+ begin
+ A := 1 - 2*(LyricsState.GetCurrentTime() - GetTimeFromBeat(Start+Length));
+ if not (Start+Length-1 = LyricsState.CurrentBeatD) then
+ begin
+ //Star animation counter
+ //inc(Starfr);
+ //Starfr := Starfr mod 128;
+ GoldenRec.SavePerfectNotePos(Rec.Left, Rec.Top);
+ end;
+ end;
+ end; // with
+ end; // for
+
+ // actually we need a comparison here, to determine if the singing process
+ // is ahead Rec.Right even if there is no singing
+
+ if (Ini.EffectSing = 1) then
+ GoldenRec.GoldenNoteTwinkle(Rec.Top,Rec.Bottom,Rec.Right, PlayerIndex);
+ end; // if
+end;
+
+//draw Note glow
+procedure SingDrawPlayerBGLine(Left, Top, Right: real; NrLines, PlayerIndex: integer; Space: integer);
+var
+ Rec: TRecR;
+ Count: integer;
+ TempR: real;
+ R,G,B: real;
+ X1, X2, X3, X4: real;
+ W, H: real;
+
+ lTmpA ,
+ lTmpB : real;
+begin
+ if (Player[PlayerIndex].ScoreTotalInt >= 0) then
+ begin
+ glColor4f(1, 1, 1, sqrt((1+sin( AudioPlayback.Position * 3))/4)/ 2 + 0.5 );
+ glEnable(GL_TEXTURE_2D);
+ glEnable(GL_BLEND);
+ glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
+
+ lTmpA := (Right-Left);
+ lTmpB := (Lines[NrLines].Line[Lines[NrLines].Current].End_ - Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start);
+
+ if ( lTmpA > 0 ) and
+ ( lTmpB > 0 ) then
+ begin
+ TempR := lTmpA / lTmpB;
+ end
+ else
+ begin
+ TempR := 0;
+ end;
+
+ with Lines[NrLines].Line[Lines[NrLines].Current] do
+ begin
+ for Count := 0 to HighNote do
+ begin
+ with Note[Count] do
+ begin
+ if NoteType <> ntFreestyle then
+ begin
+ // begin: 14, 20
+ // easy: 6, 11
+ W := NotesW * 2 + 2;
+ H := NotesH * 1.5 + 3.5;
+
+ X2 := (Start-Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start) * TempR + Left + 0.5 + 10*ScreenX + 4; // wciecie
+ X1 := X2-W;
+
+ X3 := (Start+Length-Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start) * TempR + Left - 0.5 + 10*ScreenX - 4; // wciecie
+ X4 := X3+W;
+
+ // left
+ Rec.Left := X1;
+ Rec.Right := X2;
+ Rec.Top := Top - (Tone-BaseNote)*Space/2 - H;
+ Rec.Bottom := Rec.Top + 2 * H;
+
+ glBindTexture(GL_TEXTURE_2D, Tex_BG_Left[PlayerIndex+1].TexNum);
+ glBegin(GL_QUADS);
+ glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top);
+ glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom);
+ glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom);
+ glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top);
+ glEnd;
+
+ // srodkowa czesc
+ Rec.Left := X2;
+ Rec.Right := X3;
+
+ glBindTexture(GL_TEXTURE_2D, Tex_BG_Mid[PlayerIndex+1].TexNum);
+ glBegin(GL_QUADS);
+ glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top);
+ glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom);
+ glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom);
+ glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top);
+ glEnd;
+
+ // prawa czesc
+ Rec.Left := X3;
+ Rec.Right := X4;
+
+ glBindTexture(GL_TEXTURE_2D, Tex_BG_Right[PlayerIndex+1].TexNum);
+ glBegin(GL_QUADS);
+ glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top);
+ glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom);
+ glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom);
+ glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top);
+ glEnd;
+ end; // if not FreeStyle
+ end; // with
+ end; // for
+ end; // with
+
+ glDisable(GL_BLEND);
+ glDisable(GL_TEXTURE_2D);
+ end;
+end;
+
+(**
+ * Draws the lyrics helper bar.
+ * Left: position the bar starts at
+ * LyricsMid: the middle of the lyrics relative to the position Left
+ *)
+procedure SingDrawLyricHelper(Left, LyricsMid: real);
+var
+ Bounds: TRecR; // bounds of the lyric help bar
+ BarProgress: real; // progress of the lyrics helper
+ BarMoveDelta: real; // current beat relative to the beat the bar starts to move at
+ BarAlpha: real; // transparency
+ CurLine: PLine; // current lyric line (beat specific)
+ LineWidth: real; // lyric line width
+ FirstNoteBeat: integer; // beat of the first note in the current line
+ FirstNoteDelta: integer; // time in beats between the start of the current line and its first note
+ MoveStartX: real; // x-pos. the bar starts to move from
+ MoveDist: real; // number of pixels the bar will move
+ LyricEngine: TLyricEngine;
+const
+ BarWidth = 50; // width of the lyric helper bar
+ BarHeight = 30; // height of the lyric helper bar
+ BarMoveLimit = 40; // max. number of beats remaining before the bar starts to move
+begin
+ // get current lyrics line and the time in beats of its first note
+ CurLine := @Lines[0].Line[Lines[0].Current];
+
+ // FIXME: accessing ScreenSing is not that generic
+ LyricEngine := ScreenSing.Lyrics;
+
+ // do not draw the lyrics helper if the current line does not contain any note
+ if (Length(CurLine.Note) > 0) then
+ begin
+ // start beat of the first note of this line
+ FirstNoteBeat := CurLine.Note[0].Start;
+ // time in beats between the start of the current line and its first note
+ FirstNoteDelta := FirstNoteBeat - CurLine.Start;
+
+ // beats from current beat to the first note of the line
+ BarMoveDelta := FirstNoteBeat - LyricsState.MidBeat;
+
+ if (FirstNoteDelta > 8) and // if the wait-time is large enough
+ (BarMoveDelta > 0) then // and the first note of the line is not reached
+ begin
+ // let the bar blink to the beat
+ BarAlpha := 0.75 + cos(BarMoveDelta/2) * 0.25;
+
+ // if the number of beats to the first note is too big,
+ // the bar stays on the left side.
+ if (BarMoveDelta > BarMoveLimit) then
+ BarMoveDelta := BarMoveLimit;
+
+ // limit number of beats the bar moves
+ if (FirstNoteDelta > BarMoveLimit) then
+ FirstNoteDelta := BarMoveLimit;
+
+ // calc bar progress
+ BarProgress := 1 - BarMoveDelta / FirstNoteDelta;
+
+ // retrieve the width of the upper lyrics line on the display
+ if (LyricEngine.GetUpperLine() <> nil) then
+ LineWidth := LyricEngine.GetUpperLine().Width
+ else
+ LineWidth := 0;
+
+ // distance the bar will move (LyricRec.Left to beginning of text)
+ MoveDist := LyricsMid - LineWidth / 2 - BarWidth;
+ // if the line is too long the helper might move from right to left
+ // so we have to assure the start position is left of the text.
+ if (MoveDist >= 0) then
+ MoveStartX := Left
+ else
+ MoveStartX := Left + MoveDist;
+
+ // determine lyric help bar position and size
+ Bounds.Left := MoveStartX + BarProgress * MoveDist;
+ Bounds.Right := Bounds.Left + BarWidth;
+ Bounds.Top := Skin_LyricsT + 3;
+ Bounds.Bottom := Bounds.Top + BarHeight + 3;
+
+ // draw lyric help bar
+ glEnable(GL_TEXTURE_2D);
+ glEnable(GL_BLEND);
+ glColor4f(1, 1, 1, BarAlpha);
+ glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
+ glBindTexture(GL_TEXTURE_2D, Tex_Lyric_Help_Bar.TexNum);
+ glBegin(GL_QUADS);
+ glTexCoord2f(0, 0); glVertex2f(Bounds.Left, Bounds.Top);
+ glTexCoord2f(0, 1); glVertex2f(Bounds.Left, Bounds.Bottom);
+ glTexCoord2f(1, 1); glVertex2f(Bounds.Right, Bounds.Bottom);
+ glTexCoord2f(1, 0); glVertex2f(Bounds.Right, Bounds.Top);
+ glEnd;
+ glDisable(GL_BLEND);
+ end;
+ end;
+end;
+
+procedure SingDraw;
+var
+ NR: TRecR; // lyrics area bounds (NR = NoteRec?)
+ LyricEngine: TLyricEngine;
+begin
+ // positions
+ if Ini.SingWindow = 0 then
+ NR.Left := 120
+ else
+ NR.Left := 20;
+
+ NR.Right := 780;
+
+ NR.Width := NR.Right - NR.Left;
+ NR.WMid := NR.Width / 2;
+ NR.Mid := NR.Left + NR.WMid;
+
+ // FIXME: accessing ScreenSing is not that generic
+ LyricEngine := ScreenSing.Lyrics;
+
+ // background //BG Fullsize Mod
+ //SingDrawBackground;
+
+ // draw time-bar
+ SingDrawTimeBar();
+
+ // draw note-lines
+
+ if (PlayersPlay = 1) and (Ini.NoteLines = 1) then
+ SingDrawNoteLines(Nr.Left + 10*ScreenX, Skin_P2_NotesB - 105, Nr.Right + 10*ScreenX, 15);
+
+ if ((PlayersPlay = 2) or (PlayersPlay = 4)) and (Ini.NoteLines = 1) then
+ begin
+ SingDrawNoteLines(Nr.Left + 10*ScreenX, Skin_P1_NotesB - 105, Nr.Right + 10*ScreenX, 15);
+ SingDrawNoteLines(Nr.Left + 10*ScreenX, Skin_P2_NotesB - 105, Nr.Right + 10*ScreenX, 15);
+ end;
+
+ if ((PlayersPlay = 3) or (PlayersPlay = 6)) and (Ini.NoteLines = 1) then begin
+ SingDrawNoteLines(Nr.Left + 10*ScreenX, 120, Nr.Right + 10*ScreenX, 12);
+ SingDrawNoteLines(Nr.Left + 10*ScreenX, 245, Nr.Right + 10*ScreenX, 12);
+ SingDrawNoteLines(Nr.Left + 10*ScreenX, 370, Nr.Right + 10*ScreenX, 12);
+ end;
+
+ // draw Lyrics
+ LyricEngine.Draw(LyricsState.MidBeat);
+ SingDrawLyricHelper(NR.Left, NR.WMid);
+
+ // oscilloscope
+ if Ini.Oscilloscope = 1 then begin
+ if PlayersPlay = 1 then
+ SingDrawOscilloscope(190 + 10*ScreenX, 55, 180, 40, 0);
+
+ if PlayersPlay = 2 then begin
+ SingDrawOscilloscope(190 + 10*ScreenX, 55, 180, 40, 0);
+ SingDrawOscilloscope(425 + 10*ScreenX, 55, 180, 40, 1);
+ end;
+
+ if PlayersPlay = 4 then begin
+ if ScreenAct = 1 then begin
+ SingDrawOscilloscope(190 + 10*ScreenX, 55, 180, 40, 0);
+ SingDrawOscilloscope(425 + 10*ScreenX, 55, 180, 40, 1);
+ end;
+ if ScreenAct = 2 then begin
+ SingDrawOscilloscope(190 + 10*ScreenX, 55, 180, 40, 2);
+ SingDrawOscilloscope(425 + 10*ScreenX, 55, 180, 40, 3);
+ end;
+ end;
+
+ if PlayersPlay = 3 then begin
+ SingDrawOscilloscope(75 + 10*ScreenX, 95, 100, 20, 0);
+ SingDrawOscilloscope(370 + 10*ScreenX, 95, 100, 20, 1);
+ SingDrawOscilloscope(670 + 10*ScreenX, 95, 100, 20, 2);
+ end;
+
+ if PlayersPlay = 6 then begin
+ if ScreenAct = 1 then begin
+ SingDrawOscilloscope( 75 + 10*ScreenX, 95, 100, 20, 0);
+ SingDrawOscilloscope(370 + 10*ScreenX, 95, 100, 20, 1);
+ SingDrawOscilloscope(670 + 10*ScreenX, 95, 100, 20, 2);
+ end;
+ if ScreenAct = 2 then begin
+ SingDrawOscilloscope( 75 + 10*ScreenX, 95, 100, 20, 3);
+ SingDrawOscilloscope(370 + 10*ScreenX, 95, 100, 20, 4);
+ SingDrawOscilloscope(670 + 10*ScreenX, 95, 100, 20, 5);
+ end;
+ end;
+
+ end;
+
+ // Set the note heights according to the difficulty level
+ case Ini.Difficulty of
+ 0:
+ begin
+ NotesH := 11; // 9
+ NotesW := 6; // 5
+ end;
+ 1:
+ begin
+ NotesH := 8; // 7
+ NotesW := 4; // 4
+ end;
+ 2:
+ begin
+ NotesH := 5;
+ NotesW := 3;
+ end;
+ end;
+
+ // Draw the Notes
+ if PlayersPlay = 1 then begin
+ SingDrawPlayerBGLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 0, 15); // Background glow - colorized in playercolor
+ SingDrawLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 15); // Plain unsung notes - colorized in playercolor
+ SingDrawPlayerLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 0, 15); // imho the sung notes
+ end;
+
+ if (PlayersPlay = 2) then begin
+ SingDrawPlayerBGLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 0, 15);
+ SingDrawPlayerBGLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 1, 15);
+
+ SingDrawLine(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 15);
+ SingDrawLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 1, 15);
+
+ SingDrawPlayerLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 0, 15);
+ SingDrawPlayerLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 1, 15);
+ end;
+
+ if PlayersPlay = 3 then begin
+ NotesW := NotesW * 0.8;
+ NotesH := NotesH * 0.8;
+
+ SingDrawPlayerBGLine(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 0, 12);
+ SingDrawPlayerBGLine(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 1, 12);
+ SingDrawPlayerBGLine(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 2, 12);
+
+ SingDrawLine(NR.Left + 20, 120+95, NR.Right - 20, 0, 12);
+ SingDrawLine(NR.Left + 20, 245+95, NR.Right - 20, 1, 12);
+ SingDrawLine(NR.Left + 20, 370+95, NR.Right - 20, 2, 12);
+
+ SingDrawPlayerLine(Nr.Left + 20, 120+95, Nr.Width - 40, 0, 12);
+ SingDrawPlayerLine(Nr.Left + 20, 245+95, Nr.Width - 40, 1, 12);
+ SingDrawPlayerLine(Nr.Left + 20, 370+95, Nr.Width - 40, 2, 12);
+ end;
+
+ if PlayersPlay = 4 then begin
+ if ScreenAct = 1 then begin
+ SingDrawPlayerBGLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 0, 15);
+ SingDrawPlayerBGLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 1, 15);
+ end;
+ if ScreenAct = 2 then begin
+ SingDrawPlayerBGLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 2, 15);
+ SingDrawPlayerBGLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 3, 15);
+ end;
+
+ if ScreenAct = 1 then begin
+ SingDrawLine(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 15);
+ SingDrawLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 1, 15);
+ end;
+ if ScreenAct = 2 then begin
+ SingDrawLine(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 2, 15);
+ SingDrawLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 3, 15);
+ end;
+
+ if ScreenAct = 1 then begin
+ SingDrawPlayerLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 0, 15);
+ SingDrawPlayerLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 1, 15);
+ end;
+ if ScreenAct = 2 then begin
+ SingDrawPlayerLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 2, 15);
+ SingDrawPlayerLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 3, 15);
+ end;
+ end;
+
+ if PlayersPlay = 6 then begin
+ NotesW := NotesW * 0.8;
+ NotesH := NotesH * 0.8;
+
+ if ScreenAct = 1 then begin
+ SingDrawPlayerBGLine(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 0, 12);
+ SingDrawPlayerBGLine(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 1, 12);
+ SingDrawPlayerBGLine(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 2, 12);
+ end;
+ if ScreenAct = 2 then begin
+ SingDrawPlayerBGLine(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 3, 12);
+ SingDrawPlayerBGLine(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 4, 12);
+ SingDrawPlayerBGLine(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 5, 12);
+ end;
+
+ if ScreenAct = 1 then begin
+ SingDrawLine(NR.Left + 20, 120+95, NR.Right - 20, 0, 12);
+ SingDrawLine(NR.Left + 20, 245+95, NR.Right - 20, 1, 12);
+ SingDrawLine(NR.Left + 20, 370+95, NR.Right - 20, 2, 12);
+ end;
+ if ScreenAct = 2 then begin
+ SingDrawLine(NR.Left + 20, 120+95, NR.Right - 20, 3, 12);
+ SingDrawLine(NR.Left + 20, 245+95, NR.Right - 20, 4, 12);
+ SingDrawLine(NR.Left + 20, 370+95, NR.Right - 20, 5, 12);
+ end;
+
+ if ScreenAct = 1 then begin
+ SingDrawPlayerLine(Nr.Left + 20, 120+95, Nr.Width - 40, 0, 12);
+ SingDrawPlayerLine(Nr.Left + 20, 245+95, Nr.Width - 40, 1, 12);
+ SingDrawPlayerLine(Nr.Left + 20, 370+95, Nr.Width - 40, 2, 12);
+ end;
+ if ScreenAct = 2 then begin
+ SingDrawPlayerLine(Nr.Left + 20, 120+95, Nr.Width - 40, 3, 12);
+ SingDrawPlayerLine(Nr.Left + 20, 245+95, Nr.Width - 40, 4, 12);
+ SingDrawPlayerLine(Nr.Left + 20, 370+95, Nr.Width - 40, 5, 12);
+ end;
+ end;
+ glDisable(GL_BLEND);
+ glDisable(GL_TEXTURE_2D);
+end;
+
+// q'n'd for using the game mode dll's
+procedure SingModiDraw (PlayerInfo: TPlayerInfo);
+var
+ Count: integer;
+ Pet2: integer;
+ TempR: real;
+ Rec: TRecR;
+ TexRec: TRecR;
+ NR: TRecR;
+ FS: real;
+ BarFrom: integer;
+ BarAlpha: real;
+ BarWspol: real;
+ TempCol: real;
+ Tekst: string;
+ PetCz: integer;
+begin
+ // positions
+ if Ini.SingWindow = 0 then begin
+ NR.Left := 120;
+ end else begin
+ NR.Left := 20;
+ end;
+
+ NR.Right := 780;
+ NR.Width := NR.Right - NR.Left;
+ NR.WMid := NR.Width / 2;
+ NR.Mid := NR.Left + NR.WMid;
+
+ // time bar
+ SingDrawTimeBar();
+
+ if DLLMan.Selected.ShowNotes then
+ begin
+ if PlayersPlay = 1 then
+ SingDrawNoteLines(Nr.Left + 10*ScreenX, Skin_P2_NotesB - 105, Nr.Right + 10*ScreenX, 15);
+ if (PlayersPlay = 2) or (PlayersPlay = 4) then begin
+ SingDrawNoteLines(Nr.Left + 10*ScreenX, Skin_P1_NotesB - 105, Nr.Right + 10*ScreenX, 15);
+ SingDrawNoteLines(Nr.Left + 10*ScreenX, Skin_P2_NotesB - 105, Nr.Right + 10*ScreenX, 15);
+ end;
+
+ if (PlayersPlay = 3) or (PlayersPlay = 6) then begin
+ SingDrawNoteLines(Nr.Left + 10*ScreenX, 120, Nr.Right + 10*ScreenX, 12);
+ SingDrawNoteLines(Nr.Left + 10*ScreenX, 245, Nr.Right + 10*ScreenX, 12);
+ SingDrawNoteLines(Nr.Left + 10*ScreenX, 370, Nr.Right + 10*ScreenX, 12);
+ end;
+ end;
+
+ // Draw Lyrics
+ ScreenSingModi.Lyrics.Draw(LyricsState.MidBeat);
+
+ // todo: Lyrics
+{ // rysuje pasek, podpowiadajacy poczatek spiwania w scenie
+ FS := 1.3;
+ BarFrom := Lines[0].Line[Lines[0].Current].StartNote - Lines[0].Line[Lines[0].Current].Start;
+ if BarFrom > 40 then BarFrom := 40;
+ if (Lines[0].Line[Lines[0].Current].StartNote - Lines[0].Line[Lines[0].Current].Start > 8) and // dluga przerwa //16->12 for more help bars and then 12->8 for even more
+ (Lines[0].Line[Lines[0].Current].StartNote - LyricsState.MidBeat > 0) and // przed tekstem
+ (Lines[0].Line[Lines[0].Current].StartNote - LyricsState.MidBeat < 40) then begin // ale nie za wczesnie
+ BarWspol := (LyricsState.MidBeat - (Lines[0].Line[Lines[0].Current].StartNote - BarFrom)) / BarFrom;
+ Rec.Left := NR.Left + BarWspol * (ScreenSingModi.LyricMain.ClientX - NR.Left - 50) + 10*ScreenX;
+ Rec.Right := Rec.Left + 50;
+ Rec.Top := Skin_LyricsT + 3;
+ Rec.Bottom := Rec.Top + 33;//SingScreen.LyricMain.Size * 3;
+
+ glEnable(GL_TEXTURE_2D);
+ glEnable(GL_BLEND);
+ glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
+ glBindTexture(GL_TEXTURE_2D, Tex_Lyric_Help_Bar.TexNum);
+ glBegin(GL_QUADS);
+ glColor4f(1, 1, 1, 0);
+ glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top);
+ glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom);
+ glColor4f(1, 1, 1, 0.5);
+ glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom);
+ glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top);
+ glEnd;
+ glDisable(GL_BLEND);
+ end;
+ }
+
+ // oscilloscope | the thing that moves when you yell into your mic (imho)
+ if (((Ini.Oscilloscope = 1) AND (DLLMan.Selected.ShowRateBar_O)) AND (NOT DLLMan.Selected.ShowRateBar)) then begin
+ if PlayersPlay = 1 then
+ if PlayerInfo.Playerinfo[0].Enabled then
+ SingDrawOscilloscope(190 + 10*ScreenX, 55, 180, 40, 0);
+
+ if PlayersPlay = 2 then begin
+ if PlayerInfo.Playerinfo[0].Enabled then
+ SingDrawOscilloscope(190 + 10*ScreenX, 55, 180, 40, 0);
+ if PlayerInfo.Playerinfo[1].Enabled then
+ SingDrawOscilloscope(425 + 10*ScreenX, 55, 180, 40, 1);
+ end;
+
+ if PlayersPlay = 4 then begin
+ if ScreenAct = 1 then begin
+ if PlayerInfo.Playerinfo[0].Enabled then
+ SingDrawOscilloscope(190 + 10*ScreenX, 55, 180, 40, 0);
+ if PlayerInfo.Playerinfo[1].Enabled then
+ SingDrawOscilloscope(425 + 10*ScreenX, 55, 180, 40, 1);
+ end;
+ if ScreenAct = 2 then begin
+ if PlayerInfo.Playerinfo[2].Enabled then
+ SingDrawOscilloscope(190 + 10*ScreenX, 55, 180, 40, 2);
+ if PlayerInfo.Playerinfo[3].Enabled then
+ SingDrawOscilloscope(425 + 10*ScreenX, 55, 180, 40, 3);
+ end;
+ end;
+
+ if PlayersPlay = 3 then begin
+ if PlayerInfo.Playerinfo[0].Enabled then
+ SingDrawOscilloscope(75 + 10*ScreenX, 95, 100, 20, 0);
+ if PlayerInfo.Playerinfo[1].Enabled then
+ SingDrawOscilloscope(370 + 10*ScreenX, 95, 100, 20, 1);
+ if PlayerInfo.Playerinfo[2].Enabled then
+ SingDrawOscilloscope(670 + 10*ScreenX, 95, 100, 20, 2);
+ end;
+
+ if PlayersPlay = 6 then begin
+ if ScreenAct = 1 then begin
+ if PlayerInfo.Playerinfo[0].Enabled then
+ SingDrawOscilloscope( 75 + 10*ScreenX, 95, 100, 20, 0);
+ if PlayerInfo.Playerinfo[1].Enabled then
+ SingDrawOscilloscope(370 + 10*ScreenX, 95, 100, 20, 1);
+ if PlayerInfo.Playerinfo[2].Enabled then
+ SingDrawOscilloscope(670 + 10*ScreenX, 95, 100, 20, 2);
+ end;
+ if ScreenAct = 2 then begin
+ if PlayerInfo.Playerinfo[3].Enabled then
+ SingDrawOscilloscope( 75 + 10*ScreenX, 95, 100, 20, 3);
+ if PlayerInfo.Playerinfo[4].Enabled then
+ SingDrawOscilloscope(370 + 10*ScreenX, 95, 100, 20, 4);
+ if PlayerInfo.Playerinfo[5].Enabled then
+ SingDrawOscilloscope(670 + 10*ScreenX, 95, 100, 20, 5);
+ end;
+ end;
+
+ end;
+
+// resize the notes according to the difficulty level
+ case Ini.Difficulty of
+ 0:
+ begin
+ NotesH := 11; // 9
+ NotesW := 6; // 5
+ end;
+ 1:
+ begin
+ NotesH := 8; // 7
+ NotesW := 4; // 4
+ end;
+ 2:
+ begin
+ NotesH := 5;
+ NotesW := 3;
+ end;
+ end;
+
+ if (DLLMAn.Selected.ShowNotes And DLLMan.Selected.LoadSong) then
+ begin
+ if (PlayersPlay = 1) And PlayerInfo.Playerinfo[0].Enabled then begin
+ SingDrawPlayerBGLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 0, 15);
+ SingDrawLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 15);
+ SingDrawPlayerLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 0, 15);
+ end;
+
+ if (PlayersPlay = 2) then begin
+ if PlayerInfo.Playerinfo[0].Enabled then
+ begin
+ SingDrawPlayerBGLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 0, 15);
+ SingDrawLine(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 15);
+ SingDrawPlayerLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 0, 15);
+ end;
+ if PlayerInfo.Playerinfo[1].Enabled then
+ begin
+ SingDrawPlayerBGLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 1, 15);
+ SingDrawLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 15);
+ SingDrawPlayerLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 1, 15);
+ end;
+
+ end;
+
+ if PlayersPlay = 3 then begin
+ NotesW := NotesW * 0.8;
+ NotesH := NotesH * 0.8;
+
+ if PlayerInfo.Playerinfo[0].Enabled then
+ begin
+ SingDrawPlayerBGLine(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 0, 12);
+ SingDrawLine(NR.Left + 20, 120+95, NR.Right - 20, 0, 12);
+ SingDrawPlayerLine(Nr.Left + 20, 120+95, Nr.Width - 40, 0, 12);
+ end;
+
+ if PlayerInfo.Playerinfo[1].Enabled then
+ begin
+ SingDrawPlayerBGLine(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 1, 12);
+ SingDrawLine(NR.Left + 20, 245+95, NR.Right - 20, 0, 12);
+ SingDrawPlayerLine(Nr.Left + 20, 245+95, Nr.Width - 40, 1, 12);
+ end;
+
+ if PlayerInfo.Playerinfo[2].Enabled then
+ begin
+ SingDrawPlayerBGLine(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 2, 12);
+ SingDrawLine(NR.Left + 20, 370+95, NR.Right - 20, 0, 12);
+ SingDrawPlayerLine(Nr.Left + 20, 370+95, Nr.Width - 40, 2, 12);
+ end;
+ end;
+
+ if PlayersPlay = 4 then begin
+ if ScreenAct = 1 then begin
+ SingDrawPlayerBGLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 0, 15);
+ SingDrawPlayerBGLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 1, 15);
+ end;
+ if ScreenAct = 2 then begin
+ SingDrawPlayerBGLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 2, 15);
+ SingDrawPlayerBGLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 3, 15);
+ end;
+
+ SingDrawLine(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 15);
+ SingDrawLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 15);
+
+ if ScreenAct = 1 then begin
+ SingDrawPlayerLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 0, 15);
+ SingDrawPlayerLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 1, 15);
+ end;
+ if ScreenAct = 2 then begin
+ SingDrawPlayerLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 2, 15);
+ SingDrawPlayerLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 3, 15);
+ end;
+ end;
+
+ if PlayersPlay = 6 then begin
+ NotesW := NotesW * 0.8;
+ NotesH := NotesH * 0.8;
+
+ if ScreenAct = 1 then begin
+ SingDrawPlayerBGLine(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 0, 12);
+ SingDrawPlayerBGLine(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 1, 12);
+ SingDrawPlayerBGLine(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 2, 12);
+ end;
+ if ScreenAct = 2 then begin
+ SingDrawPlayerBGLine(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 3, 12);
+ SingDrawPlayerBGLine(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 4, 12);
+ SingDrawPlayerBGLine(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 5, 12);
+ end;
+
+ SingDrawLine(NR.Left + 20, 120+95, NR.Right - 20, 0, 12);
+ SingDrawLine(NR.Left + 20, 245+95, NR.Right - 20, 0, 12);
+ SingDrawLine(NR.Left + 20, 370+95, NR.Right - 20, 0, 12);
+
+ if ScreenAct = 1 then begin
+ SingDrawPlayerLine(Nr.Left + 20, 120+95, Nr.Width - 40, 0, 12);
+ SingDrawPlayerLine(Nr.Left + 20, 245+95, Nr.Width - 40, 1, 12);
+ SingDrawPlayerLine(Nr.Left + 20, 370+95, Nr.Width - 40, 2, 12);
+ end;
+ if ScreenAct = 2 then begin
+ SingDrawPlayerLine(Nr.Left + 20, 120+95, Nr.Width - 40, 3, 12);
+ SingDrawPlayerLine(Nr.Left + 20, 245+95, Nr.Width - 40, 4, 12);
+ SingDrawPlayerLine(Nr.Left + 20, 370+95, Nr.Width - 40, 5, 12);
+ end;
+ end;
+ end;
+
+ glDisable(GL_BLEND);
+ glDisable(GL_TEXTURE_2D);
+end;
+
+
+{//SingBar Mod
+procedure SingDrawSingbar(X, Y, W, H: real; Percent: integer);
+var
+ R: Real;
+ G: Real;
+ B: Real;
+ A: cardinal;
+ I: Integer;
+
+begin;
+
+ //SingBar Background
+ glColor4f(1, 1, 1, 0.8);
+ glEnable(GL_TEXTURE_2D);
+ glEnable(GL_BLEND);
+ glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
+ glBindTexture(GL_TEXTURE_2D, Tex_SingBar_Back.TexNum);
+ glBegin(GL_QUADS);
+ glTexCoord2f(0, 0); glVertex2f(X, Y);
+ glTexCoord2f(0, 1); glVertex2f(X, Y+H);
+ glTexCoord2f(1, 1); glVertex2f(X+W, Y+H);
+ glTexCoord2f(1, 0); glVertex2f(X+W, Y);
+ glEnd;
+
+ //SingBar coloured Bar
+ Case Percent of
+ 0..22: begin
+ R := 1;
+ G := 0;
+ B := 0;
+ end;
+ 23..42: begin
+ R := 1;
+ G := ((Percent-23)/100)*5;
+ B := 0;
+ end;
+ 43..57: begin
+ R := 1;
+ G := 1;
+ B := 0;
+ end;
+ 58..77: begin
+ R := 1-(Percent - 58)/100*5;
+ G := 1;
+ B := 0;
+ end;
+ 78..99: begin
+ R := 0;
+ G := 1;
+ B := 0;
+ end;
+ End; //Case
+
+ glColor4f(R, G, B, 1);
+ glEnable(GL_TEXTURE_2D);
+ glEnable(GL_BLEND);
+ glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
+ glBindTexture(GL_TEXTURE_2D, Tex_SingBar_Bar.TexNum);
+ //Size= Player[PlayerNum].ScorePercent of W
+ glBegin(GL_QUADS);
+ glTexCoord2f(0, 0); glVertex2f(X, Y);
+ glTexCoord2f(0, 1); glVertex2f(X, Y+H);
+ glTexCoord2f(1, 1); glVertex2f(X+(W/100 * (Percent +1)), Y+H);
+ glTexCoord2f(1, 0); glVertex2f(X+(W/100 * (Percent +1)), Y);
+ glEnd;
+
+ //SingBar Front
+ glColor4f(1, 1, 1, 0.6);
+ glEnable(GL_TEXTURE_2D);
+ glEnable(GL_BLEND);
+ glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
+ glBindTexture(GL_TEXTURE_2D, Tex_SingBar_Front.TexNum);
+ glBegin(GL_QUADS);
+ glTexCoord2f(0, 0); glVertex2f(X, Y);
+ glTexCoord2f(0, 1); glVertex2f(X, Y+H);
+ glTexCoord2f(1, 1); glVertex2f(X+W, Y+H);
+ glTexCoord2f(1, 0); glVertex2f(X+W, Y);
+ glEnd;
+end;
+//end Singbar Mod
+
+//PhrasenBonus - Line Bonus Pop Up
+procedure SingDrawLineBonus( const X, Y: Single; Color: TRGB; Alpha: Single; Text: string; Age: Integer);
+var
+Length, X2: Real; //Length of Text
+Size: Integer; //Size of Popup
+begin
+if Alpha <> 0 then
+begin
+
+//Set Font Propertys
+SetFontStyle(2); //Font: Outlined1
+if Age < 5 then SetFontSize(Age + 1) else SetFontSize(6);
+SetFontItalic(False);
+
+//Check Font Size
+Length := glTextWidth ( PChar(Text)) + 3; //Little Space for a Better Look ^^
+
+//Text
+SetFontPos (X + 50 - (Length / 2), Y + 12); //Position
+
+
+if Age < 5 then Size := Age * 10 else Size := 50;
+
+ //Draw Background
+ //glColor4f(Color.R, Color.G, Color.B, Alpha); //Set Color
+ glColor4f(1, 1, 1, Alpha);
+
+
+ glEnable(GL_TEXTURE_2D);
+ glEnable(GL_BLEND);
+ //glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
+
+
+ //New Method, Not Variable
+ glBindTexture(GL_TEXTURE_2D, Tex_SingLineBonusBack[2].TexNum);
+
+ glBegin(GL_QUADS);
+ glTexCoord2f(0, 0); glVertex2f(X + 50 - Size, Y + 25 - (Size/2));
+ glTexCoord2f(0, 1); glVertex2f(X + 50 - Size, Y + 25 + (Size/2));
+ glTexCoord2f(1, 1); glVertex2f(X + 50 + Size, Y + 25 + (Size/2));
+ glTexCoord2f(1, 0); glVertex2f(X + 50 + Size, Y + 25 - (Size/2));
+ glEnd;
+
+ glColor4f(1, 1, 1, Alpha); //Set Color
+ //Draw Text
+ glPrint (PChar(Text));
+end;
+end;
+//PhrasenBonus - Line Bonus Mod}
+
+// Draw Note Bars for Editor
+//There are 11 Resons for a new Procdedure: (nice binary :D )
+// 1. It don't look good when you Draw the Golden Note Star Effect in the Editor
+// 2. You can see the Freestyle Notes in the Editor SemiTransparent
+// 3. Its easier and Faster then changing the old Procedure
+procedure EditDrawLine(Left, Top, Right: real; NrLines: integer; Space: integer);
+var
+ Rec: TRecR;
+ Count: integer;
+ TempR: real;
+begin
+ glColor3f(1, 1, 1);
+ glEnable(GL_TEXTURE_2D);
+ glEnable(GL_BLEND);
+ glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
+ TempR := (Right-Left) / (Lines[NrLines].Line[Lines[NrLines].Current].End_ - Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start);
+ with Lines[NrLines].Line[Lines[NrLines].Current] do begin
+ for Count := 0 to HighNote do begin
+ with Note[Count] do begin
+
+ // Golden Note Patch
+ case NoteType of
+ ntFreestyle: glColor4f(1, 1, 1, 0.35);
+ ntNormal: glColor4f(1, 1, 1, 0.85);
+ ntGolden: Glcolor4f(1, 1, 0.3, 0.85);
+ end; // case
+
+
+
+ // lewa czesc - left part
+ Rec.Left := (Start-Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start) * TempR + Left + 0.5 + 10*ScreenX;
+ Rec.Right := Rec.Left + NotesW;
+ Rec.Top := Top - (Tone-BaseNote)*Space/2 - NotesH;
+ Rec.Bottom := Rec.Top + 2 * NotesH;
+ glBindTexture(GL_TEXTURE_2D, Tex_Left[Color].TexNum);
+ glBegin(GL_QUADS);
+ glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top);
+ glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom);
+ glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom);
+ glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top);
+ glEnd;
+
+ // srodkowa czesc - middle part
+ Rec.Left := Rec.Right;
+ Rec.Right := (Start+Length-Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start) * TempR + Left - NotesW - 0.5 + 10*ScreenX;
+
+ glBindTexture(GL_TEXTURE_2D, Tex_Mid[Color].TexNum);
+ glBegin(GL_QUADS);
+ glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top);
+ glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom);
+ glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom);
+ glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top);
+ glEnd;
+
+ // prawa czesc - right part
+ Rec.Left := Rec.Right;
+ Rec.Right := Rec.Right + NotesW;
+
+ glBindTexture(GL_TEXTURE_2D, Tex_Right[Color].TexNum);
+ glBegin(GL_QUADS);
+ glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top);
+ glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom);
+ glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom);
+ glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top);
+ glEnd;
+
+ end; // with
+ end; // for
+ end; // with
+
+ glDisable(GL_BLEND);
+ glDisable(GL_TEXTURE_2D);
+end;
+
+procedure SingDrawTimeBar();
+var
+ x,y: real;
+ width, height: real;
+ LyricsProgress: real;
+ CurLyricsTime: real;
+begin
+ x := Theme.Sing.StaticTimeProgress.x;
+ y := Theme.Sing.StaticTimeProgress.y;
+
+ width := Theme.Sing.StaticTimeProgress.w;
+ height := Theme.Sing.StaticTimeProgress.h;
+
+ glColor4f(Theme.Sing.StaticTimeProgress.ColR,
+ Theme.Sing.StaticTimeProgress.ColG,
+ Theme.Sing.StaticTimeProgress.ColB, 1); //Set Color
+
+ glEnable(GL_TEXTURE_2D);
+ glEnable(GL_BLEND);
+
+ glBindTexture(GL_TEXTURE_2D, Tex_TimeProgress.TexNum);
+
+ glBegin(GL_QUADS);
+ glTexCoord2f(0, 0);
+ glVertex2f(x, y);
+
+ CurLyricsTime := LyricsState.GetCurrentTime();
+ if (CurLyricsTime > 0) and
+ (LyricsState.TotalTime > 0) then
+ begin
+ LyricsProgress := CurLyricsTime / LyricsState.TotalTime;
+ glTexCoord2f((width * LyricsProgress) / 8, 0);
+ glVertex2f(x + width * LyricsProgress, y);
+
+ glTexCoord2f((width * LyricsProgress) / 8, 1);
+ glVertex2f(x + width * LyricsProgress, y + height);
+ end;
+
+ glTexCoord2f(0, 1);
+ glVertex2f(x, y + height);
+ glEnd;
+
+ glDisable(GL_TEXTURE_2D);
+ glDisable(GL_BLEND);
+ glcolor4f(1, 1, 1, 1);
+end;
+
+end.
+
diff --git a/src/base/UEditorLyrics.pas b/src/base/UEditorLyrics.pas
new file mode 100644
index 00000000..25e8423e
--- /dev/null
+++ b/src/base/UEditorLyrics.pas
@@ -0,0 +1,229 @@
+unit UEditorLyrics;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+uses
+ SysUtils,
+ gl,
+ UMusic,
+ UTexture;
+
+type
+ TWord = record
+ X: real;
+ Y: real;
+ Size: real;
+ Width: real;
+ Text: string;
+ ColR: real;
+ ColG: real;
+ ColB: real;
+ FontStyle: integer;
+ Italic: boolean;
+ Selected: boolean;
+ end;
+
+ TEditorLyrics = class
+ private
+ AlignI: integer;
+ XR: real;
+ YR: real;
+ SizeR: real;
+ SelectedI: integer;
+ FontStyleI: integer; // font number
+ Word: array of TWord;
+
+ procedure SetX(Value: real);
+ procedure SetY(Value: real);
+ function GetClientX: real;
+ procedure SetAlign(Value: integer);
+ function GetSize: real;
+ procedure SetSize(Value: real);
+ procedure SetSelected(Value: integer);
+ procedure SetFStyle(Value: integer);
+ procedure AddWord(Text: string);
+ procedure Refresh;
+ public
+ ColR: real;
+ ColG: real;
+ ColB: real;
+ ColSR: real;
+ ColSG: real;
+ ColSB: real;
+ Italic: boolean;
+
+ constructor Create;
+ destructor Destroy; override;
+
+ procedure AddLine(NrLine: integer);
+
+ procedure Clear;
+ procedure Draw;
+ published
+ property X: real write SetX;
+ property Y: real write SetY;
+ property ClientX: real read GetClientX;
+ property Align: integer write SetAlign;
+ property Size: real read GetSize write SetSize;
+ property Selected: integer read SelectedI write SetSelected;
+ property FontStyle: integer write SetFStyle;
+ end;
+
+implementation
+
+uses
+ TextGL, UGraphic, UDrawTexture, Math, USkins;
+
+constructor TEditorLyrics.Create;
+begin
+ inherited;
+end;
+
+destructor TEditorLyrics.Destroy;
+begin
+ SetLength(Word, 0);
+ inherited;
+end;
+
+procedure TEditorLyrics.SetX(Value: real);
+begin
+ XR := Value;
+end;
+
+procedure TEditorLyrics.SetY(Value: real);
+begin
+ YR := Value;
+end;
+
+function TEditorLyrics.GetClientX: real;
+begin
+ Result := Word[0].X;
+end;
+
+procedure TEditorLyrics.SetAlign(Value: integer);
+begin
+ AlignI := Value;
+end;
+
+function TEditorLyrics.GetSize: real;
+begin
+ Result := SizeR;
+end;
+
+procedure TEditorLyrics.SetSize(Value: real);
+begin
+ SizeR := Value;
+end;
+
+procedure TEditorLyrics.SetSelected(Value: integer);
+var
+ W: integer;
+begin
+ if (SelectedI > -1) and (SelectedI <= High(Word)) then
+ begin
+ Word[SelectedI].Selected := false;
+ Word[SelectedI].ColR := ColR;
+ Word[SelectedI].ColG := ColG;
+ Word[SelectedI].ColB := ColB;
+ end;
+
+ SelectedI := Value;
+ if (Value > -1) and (Value <= High(Word)) then
+ begin
+ Word[Value].Selected := true;
+ Word[Value].ColR := ColSR;
+ Word[Value].ColG := ColSG;
+ Word[Value].ColB := ColSB;
+ end;
+
+ Refresh;
+end;
+
+procedure TEditorLyrics.SetFStyle(Value: integer);
+begin
+ FontStyleI := Value;
+end;
+
+procedure TEditorLyrics.AddWord(Text: string);
+var
+ WordNum: integer;
+begin
+ WordNum := Length(Word);
+ SetLength(Word, WordNum + 1);
+ if WordNum = 0 then begin
+ Word[WordNum].X := XR;
+ end else begin
+ Word[WordNum].X := Word[WordNum - 1].X + Word[WordNum - 1].Width;
+ end;
+
+ Word[WordNum].Y := YR;
+ Word[WordNum].Size := SizeR;
+ Word[WordNum].FontStyle := FontStyleI;
+ SetFontStyle(FontStyleI);
+ SetFontSize(SizeR);
+ Word[WordNum].Width := glTextWidth(pchar(Text));
+ Word[WordNum].Text := Text;
+ Word[WordNum].ColR := ColR;
+ Word[WordNum].ColG := ColG;
+ Word[WordNum].ColB := ColB;
+ Word[WordNum].Italic := Italic;
+
+ Refresh;
+end;
+
+procedure TEditorLyrics.AddLine(NrLine: integer);
+var
+ N: integer;
+begin
+ Clear;
+ for N := 0 to Lines[0].Line[NrLine].HighNote do begin
+ Italic := Lines[0].Line[NrLine].Note[N].NoteType = ntFreestyle;
+ AddWord(Lines[0].Line[NrLine].Note[N].Text);
+ end;
+ Selected := -1;
+end;
+
+procedure TEditorLyrics.Clear;
+begin
+ SetLength(Word, 0);
+ SelectedI := -1;
+end;
+
+procedure TEditorLyrics.Refresh;
+var
+ W: integer;
+ TotWidth: real;
+begin
+ if AlignI = 1 then begin
+ TotWidth := 0;
+ for W := 0 to High(Word) do
+ TotWidth := TotWidth + Word[W].Width;
+
+ Word[0].X := XR - TotWidth / 2;
+ for W := 1 to High(Word) do
+ Word[W].X := Word[W - 1].X + Word[W - 1].Width;
+ end;
+end;
+
+procedure TEditorLyrics.Draw;
+var
+ W: integer;
+begin
+ for W := 0 to High(Word) do
+ begin
+ SetFontStyle(Word[W].FontStyle);
+ SetFontPos(Word[W].X+ 10*ScreenX, Word[W].Y);
+ SetFontSize(Word[W].Size);
+ SetFontItalic(Word[W].Italic);
+ glColor3f(Word[W].ColR, Word[W].ColG, Word[W].ColB);
+ glPrint(pchar(Word[W].Text));
+ end;
+end;
+
+end.
diff --git a/src/base/UFiles.pas b/src/base/UFiles.pas
new file mode 100644
index 00000000..ca43bb21
--- /dev/null
+++ b/src/base/UFiles.pas
@@ -0,0 +1,150 @@
+unit UFiles;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+{$I switches.inc}
+
+uses SysUtils,
+ ULog,
+ UMusic,
+ USongs,
+ USong;
+
+procedure ResetSingTemp;
+function SaveSong(Song: TSong; Lines: TLines; Name: string; Relative: boolean): boolean;
+
+var
+ SongFile: TextFile; // all procedures in this unit operates on this file
+ FileLineNo: integer; //Line which is readed at Last, for error reporting
+
+ // variables available for all procedures
+ Base : array[0..1] of integer;
+ Rel : array[0..1] of integer;
+ Mult : integer = 1;
+ MultBPM : integer = 4;
+
+implementation
+
+uses TextGL,
+ UIni,
+ UPlatform,
+ UMain;
+
+//--------------------
+// Resets the temporary Sentence Arrays for each Player and some other Variables
+//--------------------
+procedure ResetSingTemp;
+var
+ Count: integer;
+begin
+ SetLength(Lines, Length(Player));
+ for Count := 0 to High(Player) do begin
+ SetLength(Lines[Count].Line, 1);
+ SetLength(Lines[Count].Line[0].Note, 0);
+ Lines[Count].Line[0].Lyric := '';
+ Lines[Count].Line[0].LyricWidth := 0;
+ Player[Count].Score := 0;
+ Player[Count].LengthNote := 0;
+ Player[Count].HighNote := -1;
+ end;
+
+ (* FIXME
+ //Reset Path and Filename Values to Prevent Errors in Editor
+ if assigned( CurrentSong ) then
+ begin
+ SetLength(CurrentSong.BPM, 0);
+ CurrentSong.Path := '';
+ CurrentSong.FileName := '';
+ end;
+ *)
+
+// CurrentSong := nil;
+end;
+
+
+//--------------------
+// Saves a Song
+//--------------------
+function SaveSong(Song: TSong; Lines: TLines; Name: string; Relative: boolean): boolean;
+var
+ C: integer;
+ N: integer;
+ S: string;
+ B: integer;
+ RelativeSubTime: integer;
+ NoteState: String;
+
+begin
+// Relative := true; // override (idea - use shift+S to save with relative)
+ AssignFile(SongFile, Name);
+ Rewrite(SongFile);
+
+ Writeln(SongFile, '#TITLE:' + Song.Title + '');
+ Writeln(SongFile, '#ARTIST:' + Song.Artist);
+
+ if Song.Creator <> '' then Writeln(SongFile, '#CREATOR:' + Song.Creator);
+ if Song.Edition <> 'Unknown' then Writeln(SongFile, '#EDITION:' + Song.Edition);
+ if Song.Genre <> 'Unknown' then Writeln(SongFile, '#GENRE:' + Song.Genre);
+ if Song.Language <> 'Unknown' then Writeln(SongFile, '#LANGUAGE:' + Song.Language);
+
+ Writeln(SongFile, '#MP3:' + Song.Mp3);
+
+ if Song.Cover <> '' then Writeln(SongFile, '#COVER:' + Song.Cover);
+ if Song.Background <> '' then Writeln(SongFile, '#BACKGROUND:' + Song.Background);
+ if Song.Video <> '' then Writeln(SongFile, '#VIDEO:' + Song.Video);
+ if Song.VideoGAP <> 0 then Writeln(SongFile, '#VIDEOGAP:' + FloatToStr(Song.VideoGAP));
+ if Song.Resolution <> 4 then Writeln(SongFile, '#RESOLUTION:' + IntToStr(Song.Resolution));
+ if Song.NotesGAP <> 0 then Writeln(SongFile, '#NOTESGAP:' + IntToStr(Song.NotesGAP));
+ if Song.Start <> 0 then Writeln(SongFile, '#START:' + FloatToStr(Song.Start));
+ if Song.Finish <> 0 then Writeln(SongFile, '#END:' + IntToStr(Song.Finish));
+ if Relative then Writeln(SongFile, '#RELATIVE:yes');
+
+ Writeln(SongFile, '#BPM:' + FloatToStr(Song.BPM[0].BPM / 4));
+ Writeln(SongFile, '#GAP:' + FloatToStr(Song.GAP));
+
+ RelativeSubTime := 0;
+ for B := 1 to High(CurrentSong.BPM) do
+ Writeln(SongFile, 'B ' + FloatToStr(CurrentSong.BPM[B].StartBeat) + ' ' + FloatToStr(CurrentSong.BPM[B].BPM/4));
+
+ for C := 0 to Lines.High do begin
+ for N := 0 to Lines.Line[C].HighNote do begin
+ with Lines.Line[C].Note[N] do begin
+
+
+ //Golden + Freestyle Note Patch
+ case Lines.Line[C].Note[N].NoteType of
+ ntFreestyle: NoteState := 'F ';
+ ntNormal: NoteState := ': ';
+ ntGolden: NoteState := '* ';
+ end; // case
+ S := NoteState + IntToStr(Start-RelativeSubTime) + ' ' + IntToStr(Length) + ' ' + IntToStr(Tone) + ' ' + Text;
+
+
+ Writeln(SongFile, S);
+ end; // with
+ end; // N
+
+ if C < Lines.High then begin // don't write end of last sentence
+ if not Relative then
+ S := '- ' + IntToStr(Lines.Line[C+1].Start)
+ else begin
+ S := '- ' + IntToStr(Lines.Line[C+1].Start - RelativeSubTime) +
+ ' ' + IntToStr(Lines.Line[C+1].Start - RelativeSubTime);
+ RelativeSubTime := Lines.Line[C+1].Start;
+ end;
+ Writeln(SongFile, S);
+ end;
+
+ end; // C
+
+
+ Writeln(SongFile, 'E');
+ CloseFile(SongFile);
+
+ Result := true;
+end;
+
+end.
diff --git a/src/base/UGraphic.pas b/src/base/UGraphic.pas
new file mode 100644
index 00000000..2432503c
--- /dev/null
+++ b/src/base/UGraphic.pas
@@ -0,0 +1,760 @@
+unit UGraphic;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+uses
+ SDL,
+ gl,
+ glext,
+ UTexture,
+ TextGL,
+ ULog,
+ SysUtils,
+ ULyrics,
+ UImage,
+ UMusic,
+ UScreenLoading,
+ UScreenWelcome,
+ UScreenMain,
+ UScreenName,
+ UScreenLevel,
+ UScreenOptions,
+ UScreenOptionsGame,
+ UScreenOptionsGraphics,
+ UScreenOptionsSound,
+ UScreenOptionsLyrics,
+ UScreenOptionsThemes,
+ UScreenOptionsRecord,
+ UScreenOptionsAdvanced,
+ UScreenSong,
+ UScreenSing,
+ UScreenScore,
+ UScreenTop5,
+ UScreenEditSub,
+ UScreenEdit,
+ UScreenEditConvert,
+ UScreenEditHeader,
+ UScreenOpen,
+ UThemes,
+ USkins,
+ UScreenSongMenu,
+ UScreenSongJumpto,
+ {Party Screens}
+ UScreenSingModi,
+ UScreenPartyNewRound,
+ UScreenPartyScore,
+ UScreenPartyOptions,
+ UScreenPartyWin,
+ UScreenPartyPlayer,
+ {Stats Screens}
+ UScreenStatMain,
+ UScreenStatDetail,
+ {CreditsScreen}
+ UScreenCredits,
+ {Popup for errors, etc.}
+ UScreenPopup;
+
+type
+ TRecR = record
+ Top: real;
+ Left: real;
+ Right: real;
+ Bottom: real;
+ end;
+
+var
+ Screen: PSDL_Surface;
+ LoadingThread: PSDL_Thread;
+ Mutex: PSDL_Mutex;
+
+ RenderW: integer;
+ RenderH: integer;
+ ScreenW: integer;
+ ScreenH: integer;
+ Screens: integer;
+ ScreenAct: integer;
+ ScreenX: integer;
+
+ ScreenLoading: TScreenLoading;
+ ScreenWelcome: TScreenWelcome;
+ ScreenMain: TScreenMain;
+ ScreenName: TScreenName;
+ ScreenLevel: TScreenLevel;
+ ScreenSong: TScreenSong;
+ ScreenSing: TScreenSing;
+ ScreenScore: TScreenScore;
+ ScreenTop5: TScreenTop5;
+ ScreenOptions: TScreenOptions;
+ ScreenOptionsGame: TScreenOptionsGame;
+ ScreenOptionsGraphics: TScreenOptionsGraphics;
+ ScreenOptionsSound: TScreenOptionsSound;
+ ScreenOptionsLyrics: TScreenOptionsLyrics;
+ ScreenOptionsThemes: TScreenOptionsThemes;
+ ScreenOptionsRecord: TScreenOptionsRecord;
+ ScreenOptionsAdvanced: TScreenOptionsAdvanced;
+ ScreenEditSub: TScreenEditSub;
+ ScreenEdit: TScreenEdit;
+ ScreenEditConvert: TScreenEditConvert;
+ ScreenEditHeader: TScreenEditHeader;
+ ScreenOpen: TScreenOpen;
+
+ ScreenSongMenu: TScreenSongMenu;
+ ScreenSongJumpto: TScreenSongJumpto;
+
+ //Party Screens
+ ScreenSingModi: TScreenSingModi;
+ ScreenPartyNewRound: TScreenPartyNewRound;
+ ScreenPartyScore: TScreenPartyScore;
+ ScreenPartyWin: TScreenPartyWin;
+ ScreenPartyOptions: TScreenPartyOptions;
+ ScreenPartyPlayer: TScreenPartyPlayer;
+
+ //StatsScreens
+ ScreenStatMain: TScreenStatMain;
+ ScreenStatDetail: TScreenStatDetail;
+
+ //CreditsScreen
+ ScreenCredits: TScreenCredits;
+
+ //popup mod
+ ScreenPopupCheck: TScreenPopupCheck;
+ ScreenPopupError: TScreenPopupError;
+
+ //Notes
+ Tex_Left: array[0..6] of TTexture; //rename to tex_note_left
+ Tex_Mid: array[0..6] of TTexture; //rename to tex_note_mid
+ Tex_Right: array[0..6] of TTexture; //rename to tex_note_right
+
+ Tex_plain_Left: array[1..6] of TTexture; //rename to tex_notebg_left
+ Tex_plain_Mid: array[1..6] of TTexture; //rename to tex_notebg_mid
+ Tex_plain_Right: array[1..6] of TTexture; //rename to tex_notebg_right
+
+ Tex_BG_Left: array[1..6] of TTexture; //rename to tex_noteglow_left
+ Tex_BG_Mid: array[1..6] of TTexture; //rename to tex_noteglow_mid
+ Tex_BG_Right: array[1..6] of TTexture; //rename to tex_noteglow_right
+
+ Tex_Note_Star: TTexture;
+ Tex_Note_Perfect_Star: TTexture;
+
+
+ Tex_Ball: TTexture;
+ Tex_Lyric_Help_Bar: TTexture;
+ FullScreen: boolean;
+
+ Tex_TimeProgress: TTexture;
+
+ //Sing Bar Mod
+ Tex_SingBar_Back: TTexture;
+ Tex_SingBar_Bar: TTexture;
+ Tex_SingBar_Front: TTexture;
+ //end Singbar Mod
+
+ //PhrasenBonus - Line Bonus Mod
+ Tex_SingLineBonusBack: array[0..8] of TTexture;
+ //End PhrasenBonus - Line Bonus Mod
+
+ //ScoreBG Texs
+ Tex_ScoreBG: array [0..5] of TTexture;
+
+ //Score Screen Textures
+ Tex_Score_NoteBarLevel_Dark : array [1..6] of TTexture;
+ Tex_Score_NoteBarRound_Dark : array [1..6] of TTexture;
+
+ Tex_Score_NoteBarLevel_Light : array [1..6] of TTexture;
+ Tex_Score_NoteBarRound_Light : array [1..6] of TTexture;
+
+ Tex_Score_NoteBarLevel_Lightest : array [1..6] of TTexture;
+ Tex_Score_NoteBarRound_Lightest : array [1..6] of TTexture;
+
+ Tex_Score_Ratings : array [0..7] of TTexture;
+
+const
+ Skin_BGColorR = 1;
+ Skin_BGColorG = 1;
+ Skin_BGColorB = 1;
+
+ Skin_SpectrumR = 0;
+ Skin_SpectrumG = 0;
+ Skin_SpectrumB = 0;
+
+ Skin_Spectograph1R = 0.6;
+ Skin_Spectograph1G = 0.8;
+ Skin_Spectograph1B = 1;
+
+ Skin_Spectograph2R = 0;
+ Skin_Spectograph2G = 0;
+ Skin_Spectograph2B = 0.2;
+
+ Skin_SzczytR = 0.8;
+ Skin_SzczytG = 0;
+ Skin_SzczytB = 0;
+
+ Skin_SzczytLimitR = 0;
+ Skin_SzczytLimitG = 0.8;
+ Skin_SzczytLimitB = 0;
+
+ Skin_FontR = 0;
+ Skin_FontG = 0;
+ Skin_FontB = 0;
+
+ Skin_FontHighlightR = 0.3; // 0.3
+ Skin_FontHighlightG = 0.3; // 0.3
+ Skin_FontHighlightB = 1; // 1
+
+ Skin_TimeR = 0.25; //0,0,0
+ Skin_TimeG = 0.25;
+ Skin_TimeB = 0.25;
+
+ Skin_OscR = 0;
+ Skin_OscG = 0;
+ Skin_OscB = 0;
+
+ Skin_LyricsT = 494; // 500 / 510 / 400
+ Skin_SpectrumT = 470;
+ Skin_SpectrumBot = 570;
+ Skin_SpectrumH = 100;
+
+ Skin_P1_LinesR = 0.5; // 0.6 0.6 1
+ Skin_P1_LinesG = 0.5;
+ Skin_P1_LinesB = 0.5;
+
+ Skin_P2_LinesR = 0.5; // 1 0.6 0.6
+ Skin_P2_LinesG = 0.5;
+ Skin_P2_LinesB = 0.5;
+
+ Skin_P1_NotesB = 250;
+ Skin_P2_NotesB = 430; // 430 / 300
+
+ Skin_P1_ScoreT = 50;
+ Skin_P1_ScoreL = 20;
+
+ Skin_P2_ScoreT = 50;
+ Skin_P2_ScoreL = 640;
+
+procedure Initialize3D (Title: string);
+procedure Reinitialize3D;
+procedure SwapBuffers;
+
+procedure LoadTextures;
+procedure InitializeScreen;
+procedure LoadLoadingScreen;
+procedure LoadScreens;
+procedure UnLoadScreens;
+
+function LoadingThreadFunction: integer;
+
+
+implementation
+
+uses
+ UMain,
+ UIni,
+ UDisplay,
+ UCommandLine,
+ Classes;
+
+procedure LoadFontTextures;
+begin
+ Log.LogStatus('Building Fonts', 'LoadTextures');
+ BuildFont;
+end;
+
+procedure LoadTextures;
+
+
+var
+ P: integer;
+ R, G, B: real;
+ Col: integer;
+begin
+ // zaladowanie tekstur
+ Log.LogStatus('Loading Textures', 'LoadTextures');
+
+ Tex_Left[0] := Texture.LoadTexture(Skin.GetTextureFileName('GrayLeft'), TEXTURE_TYPE_TRANSPARENT, 0); //brauch man die noch?
+ Tex_Mid[0] := Texture.LoadTexture(Skin.GetTextureFileName('GrayMid'), TEXTURE_TYPE_PLAIN, 0); //brauch man die noch?
+ Tex_Right[0] := Texture.LoadTexture(Skin.GetTextureFileName('GrayRight'), TEXTURE_TYPE_TRANSPARENT, 0); //brauch man die noch?
+
+ Log.LogStatus('Loading Textures - A', 'LoadTextures');
+
+ // P1-6
+ // TODO... do it once for each player... this is a bit crappy !!
+ // can we make it any better !?
+ for P := 1 to 6 do
+ begin
+ LoadColor(R, G, B, 'P' + IntToStr(P) + 'Light');
+ Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255);
+
+ Tex_Left[P] := Texture.LoadTexture(Skin.GetTextureFileName('GrayLeft'), TEXTURE_TYPE_COLORIZED, Col);
+ Tex_Mid[P] := Texture.LoadTexture(Skin.GetTextureFileName('GrayMid'), TEXTURE_TYPE_COLORIZED, Col);
+ Tex_Right[P] := Texture.LoadTexture(Skin.GetTextureFileName('GrayRight'), TEXTURE_TYPE_COLORIZED, Col);
+
+ Tex_plain_Left[P] := Texture.LoadTexture(Skin.GetTextureFileName('NotePlainLeft'), TEXTURE_TYPE_COLORIZED, Col);
+ Tex_plain_Mid[P] := Texture.LoadTexture(Skin.GetTextureFileName('NotePlainMid'), TEXTURE_TYPE_COLORIZED, Col);
+ Tex_plain_Right[P] := Texture.LoadTexture(Skin.GetTextureFileName('NotePlainRight'), TEXTURE_TYPE_COLORIZED, Col);
+
+ Tex_BG_Left[P] := Texture.LoadTexture(Skin.GetTextureFileName('NoteBGLeft'), TEXTURE_TYPE_COLORIZED, Col);
+ Tex_BG_Mid[P] := Texture.LoadTexture(Skin.GetTextureFileName('NoteBGMid'), TEXTURE_TYPE_COLORIZED, Col);
+ Tex_BG_Right[P] := Texture.LoadTexture(Skin.GetTextureFileName('NoteBGRight'), TEXTURE_TYPE_COLORIZED, Col);
+ end;
+
+ Log.LogStatus('Loading Textures - B', 'LoadTextures');
+
+ Tex_Note_Perfect_Star := Texture.LoadTexture(Skin.GetTextureFileName('NotePerfectStar'), TEXTURE_TYPE_TRANSPARENT, 0);
+ Tex_Note_Star := Texture.LoadTexture(Skin.GetTextureFileName('NoteStar') , TEXTURE_TYPE_TRANSPARENT, $FFFFFF);
+ Tex_Ball := Texture.LoadTexture(Skin.GetTextureFileName('Ball'), TEXTURE_TYPE_TRANSPARENT, $FF00FF);
+ Tex_Lyric_Help_Bar := Texture.LoadTexture(Skin.GetTextureFileName('LyricHelpBar'), TEXTURE_TYPE_TRANSPARENT, $FF00FF);
+
+
+ //TimeBar mod
+ Tex_TimeProgress := Texture.LoadTexture(Skin.GetTextureFileName('TimeBar'));
+ //eoa TimeBar mod
+
+ //SingBar Mod
+ Tex_SingBar_Back := Texture.LoadTexture(Skin.GetTextureFileName('SingBarBack'), TEXTURE_TYPE_PLAIN, 0);
+ Tex_SingBar_Bar := Texture.LoadTexture(Skin.GetTextureFileName('SingBarBar'), TEXTURE_TYPE_PLAIN, 0);
+ Tex_SingBar_Front := Texture.LoadTexture(Skin.GetTextureFileName('SingBarFront'), TEXTURE_TYPE_PLAIN, 0);
+ //end Singbar Mod
+
+ Log.LogStatus('Loading Textures - C', 'LoadTextures');
+
+ //Line Bonus PopUp
+ for P := 0 to 8 do
+ begin
+ Case P of
+ 0: begin
+ R := 1;
+ G := 0;
+ B := 0;
+ end;
+ 1..3: begin
+ R := 1;
+ G := (P * 0.25);
+ B := 0;
+ end;
+ 4: begin
+ R := 1;
+ G := 1;
+ B := 0;
+ end;
+ 5..7: begin
+ R := 1-((P-4)*0.25);
+ G := 1;
+ B := 0;
+ end;
+ 8: begin
+ R := 0;
+ G := 1;
+ B := 0;
+ end;
+ End;
+
+ Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255);
+ Tex_SingLineBonusBack[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('LineBonusBack')), TEXTURE_TYPE_COLORIZED, Col);
+ end;
+
+//## backgrounds for the scores ##
+ for P := 0 to 5 do begin
+ LoadColor(R, G, B, 'P' + IntToStr(P+1) + 'Light');
+ Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255);
+ Tex_ScoreBG[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreBG')), TEXTURE_TYPE_COLORIZED, Col);
+ end;
+
+
+ Log.LogStatus('Loading Textures - D', 'LoadTextures');
+
+// ######################
+// Score screen textures
+// ######################
+
+//## the bars that visualize the score ##
+ for P := 1 to 6 do begin
+//NoteBar ScoreBar
+ LoadColor(R, G, B, 'P' + IntToStr(P) + 'Dark');
+ Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255);
+ Tex_Score_NoteBarLevel_Dark[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreLevel_Dark')), TEXTURE_TYPE_COLORIZED, Col);
+ Tex_Score_NoteBarRound_Dark[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreLevel_Dark_Round')), TEXTURE_TYPE_COLORIZED, Col);
+//LineBonus ScoreBar
+ LoadColor(R, G, B, 'P' + IntToStr(P) + 'Light');
+ Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255);
+ Tex_Score_NoteBarLevel_Light[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreLevel_Light')), TEXTURE_TYPE_COLORIZED, Col);
+ Tex_Score_NoteBarRound_Light[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreLevel_Light_Round')), TEXTURE_TYPE_COLORIZED, Col);
+//GoldenNotes ScoreBar
+ LoadColor(R, G, B, 'P' + IntToStr(P) + 'Lightest');
+ Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255);
+ Tex_Score_NoteBarLevel_Lightest[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreLevel_Lightest')), TEXTURE_TYPE_COLORIZED, Col);
+ Tex_Score_NoteBarRound_Lightest[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreLevel_Lightest_Round')), TEXTURE_TYPE_COLORIZED, Col);
+ end;
+
+//## rating pictures that show a picture according to your rate ##
+ for P := 0 to 7 do begin
+ Tex_Score_Ratings[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('Rating_'+IntToStr(P))), TEXTURE_TYPE_TRANSPARENT, 0);
+ end;
+
+ Log.LogStatus('Loading Textures - Done', 'LoadTextures');
+end;
+
+(*
+ * Load OpenGL extensions. Must be called after SDL_SetVideoMode() and each
+ * time the pixel-format or render-context (RC) changes.
+ *)
+procedure LoadOpenGLExtensions;
+begin
+ // Load OpenGL 1.2 extensions for OpenGL 1.2 compatibility
+ if (not Load_GL_version_1_2()) then
+ begin
+ Log.LogCritical('Failed loading OpenGL 1.2', 'UGraphic.Initialize3D');
+ end;
+
+ // Other extensions e.g. OpenGL 1.3-2.0 or Framebuffer-Object might be loaded here
+ // ...
+ //Load_GL_EXT_framebuffer_object();
+end;
+
+procedure Initialize3D (Title: string);
+var
+ Icon: PSDL_Surface;
+begin
+ Log.LogStatus('SDL_Init', 'UGraphic.Initialize3D');
+ if ( SDL_InitSubSystem(SDL_INIT_VIDEO) = -1 ) then
+ begin
+ Log.LogError('SDL_Init Failed', 'UGraphic.Initialize3D');
+ exit;
+ end;
+
+ // load icon image (must be 32x32 for win32)
+ Icon := LoadImage('WINDOWICON');
+ if (Icon <> nil) then
+ SDL_WM_SetIcon(Icon, 0);
+
+ SDL_WM_SetCaption(PChar(Title), nil);
+
+ //Log.BenchmarkStart(2);
+
+ InitializeScreen;
+
+ //Log.BenchmarkEnd(2);
+ //Log.LogBenchmark('--> Setting Screen', 2);
+
+ //Log.BenchmarkStart(2);
+ Texture := TTextureUnit.Create;
+ // FIXME: this does not seem to be correct as Limit is the max. of either
+ // width or height.
+ Texture.Limit := 1024*1024;
+
+ //LoadTextures;
+ //Log.BenchmarkEnd(2);
+ //Log.LogBenchmark('--> Loading Textures', 2);
+
+ {
+ Log.BenchmarkStart(2);
+ Lyric:= TLyric.Create;
+ Log.BenchmarkEnd(2);
+ Log.LogBenchmark('--> Loading Fonts', 2);
+ }
+
+ // Note: do not initialize video modules earlier. They might depend on some
+ // SDL video functions or OpenGL extensions initialized in InitializeScreen()
+ InitializeVideo();
+
+ //Log.BenchmarkStart(2);
+
+ Log.LogStatus('TDisplay.Create', 'UGraphic.Initialize3D');
+ Display := TDisplay.Create;
+
+ //Log.BenchmarkEnd(2); Log.LogBenchmark('====> Creating Display', 2);
+
+ //Log.LogStatus('Loading Screens', 'Initialize3D');
+ //Log.BenchmarkStart(3);
+
+ Log.LogStatus('Loading Font Textures', 'UGraphic.Initialize3D');
+ LoadFontTextures();
+
+ // Show the Loading Screen -------------
+ Log.LogStatus('Loading Loading Screen', 'UGraphic.Initialize3D');
+ LoadLoadingScreen;
+
+
+ Log.LogStatus(' Loading Textures', 'UGraphic.Initialize3D');
+ LoadTextures; // jb
+
+
+
+ // now that we have something to display while loading,
+ // start thread that loads the rest of ultrastar
+ //Mutex := SDL_CreateMutex;
+ //SDL_UnLockMutex(Mutex);
+
+ // does not work this way because the loading thread tries to access opengl.
+ // See comment below
+ //LoadingThread := SDL_CreateThread(@LoadingThread, nil);
+
+ // this would be run in the loadingthread
+ Log.LogStatus(' Loading Screens', 'UGraphic.Initialize3D');
+ LoadScreens;
+
+
+ // TODO:
+ // here should be a loop which
+ // * draws the loading screen (form time to time)
+ // * controlls the "process of the loading screen
+ // * checks if the loadingthread has loaded textures (check mutex) and
+ // * load the textures into opengl
+ // * tells the loadingthread, that the memory for the texture can be reused
+ // to load the netx texture (over another mutex)
+ // * runs as long as the loadingthread tells, that everything is loaded and ready (using a third mutex)
+ //
+ // therefor loadtexture have to be changed, that it, instat of caling some opengl functions
+ // for itself, it should change mutex
+ // the mainthread have to know somehow what opengl function have to be called with which parameters like
+ // texturetype, textureobjekt, textur-buffer-adress, ...
+
+ // wait for loading thread to finish
+ // currently does not work this way
+ // SDL_WaitThread(LoadingThread, I);
+ // SDL_DestroyMutex(Mutex);
+
+ Display.CurrentScreen^.FadeTo( @ScreenMain );
+
+ Log.BenchmarkEnd(2);
+ Log.LogBenchmark('--> Loading Screens', 2);
+
+ Log.LogStatus('Finish', 'Initialize3D');
+end;
+
+procedure SwapBuffers;
+begin
+ SDL_GL_SwapBuffers;
+ glMatrixMode(GL_PROJECTION);
+ glLoadIdentity;
+ glOrtho(0, RenderW, RenderH, 0, -1, 100);
+ glMatrixMode(GL_MODELVIEW);
+end;
+
+procedure Reinitialize3D;
+begin
+ InitializeScreen;
+end;
+
+procedure InitializeScreen;
+var
+ S: string;
+ I: integer;
+ W, H: integer;
+ Depth: Integer;
+begin
+ if (Params.Screens <> -1) then
+ Screens := Params.Screens + 1
+ else
+ Screens := Ini.Screens + 1;
+
+ SDL_GL_SetAttribute(SDL_GL_RED_SIZE, 5);
+ SDL_GL_SetAttribute(SDL_GL_GREEN_SIZE, 5);
+ SDL_GL_SetAttribute(SDL_GL_BLUE_SIZE, 5);
+ SDL_GL_SetAttribute(SDL_GL_ALPHA_SIZE, 5);
+ SDL_GL_SetAttribute(SDL_GL_DEPTH_SIZE, 16); // Z-Buffer depth
+ SDL_GL_SetAttribute(SDL_GL_DOUBLEBUFFER, 1);
+
+ // VSYNC works for windows only at the moment. SDL_GL_SWAP_CONTROL under
+ // linux uses GLX_MESA_swap_control which is not supported by nvidea cards.
+ // Maybe use glXSwapIntervalSGI(1) from the GLX_SGI_swap_control extension instead.
+ //SDL_GL_SetAttribute(SDL_GL_SWAP_CONTROL, 1); // VSYNC (currently Windows only)
+
+ // If there is a resolution in Parameters, use it, else use the Ini value
+ I := Params.Resolution;
+ if (I <> -1) then
+ S := IResolution[I]
+ else
+ S := IResolution[Ini.Resolution];
+
+ I := Pos('x', S);
+ W := StrToInt(Copy(S, 1, I-1)) * Screens;
+ H := StrToInt(Copy(S, I+1, 1000));
+
+ if (Params.Depth <> -1) then
+ Depth := Params.Depth
+ else
+ Depth := Ini.Depth;
+
+ Log.LogStatus('SDL_SetVideoMode', 'Initialize3D');
+ //SDL_GL_SetAttribute( SDL_GL_DOUBLEBUFFER, 1 );
+
+ if (Ini.FullScreen = 0) and (Not Params.FullScreen) then
+ begin
+ Log.LogStatus('SDL_SetVideoMode', 'Set Video Mode... Windowed');
+ screen := SDL_SetVideoMode(W, H, (Depth+1) * 16, SDL_OPENGL or SDL_RESIZABLE)
+ end
+ else
+ begin
+ Log.LogStatus('SDL_SetVideoMode', 'Set Video Mode... Full Screen');
+ screen := SDL_SetVideoMode(W, H, (Depth+1) * 16, SDL_OPENGL or SDL_FULLSCREEN );
+ SDL_ShowCursor(0);
+ end;
+
+ if (screen = nil) then
+ begin
+ Log.LogError('SDL_SetVideoMode Failed', 'Initialize3D');
+ exit;
+ end;
+
+ LoadOpenGLExtensions();
+
+ // define virtual (Render) and real (Screen) screen size
+ RenderW := 800;
+ RenderH := 600;
+ ScreenW := W;
+ ScreenH := H;
+
+ // clear screen once window is being shown
+ // Note: SwapBuffers uses RenderW/H, so they must be defined before
+ glClearColor(1, 1, 1, 1);
+ glClear(GL_COLOR_BUFFER_BIT);
+ SwapBuffers;
+end;
+
+procedure LoadLoadingScreen;
+begin
+ ScreenLoading := TScreenLoading.Create;
+ ScreenLoading.onShow;
+
+ Display.CurrentScreen := @ScreenLoading;
+
+ swapbuffers;
+
+ ScreenLoading.Draw;
+ Display.Draw;
+
+ SwapBuffers;
+end;
+
+procedure LoadScreens;
+begin
+{ ScreenLoading := TScreenLoading.Create;
+ ScreenLoading.onShow;
+ Display.CurrentScreen := @ScreenLoading;
+ ScreenLoading.Draw;
+ Display.Draw;
+ SwapBuffers;
+}
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Loading', 3); Log.BenchmarkStart(3);
+{ ScreenWelcome := TScreenWelcome.Create; //'BG', 4, 3);
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Welcome', 3); Log.BenchmarkStart(3);}
+ ScreenMain := TScreenMain.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Main', 3); Log.BenchmarkStart(3);
+ ScreenName := TScreenName.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Name', 3); Log.BenchmarkStart(3);
+ ScreenLevel := TScreenLevel.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Level', 3); Log.BenchmarkStart(3);
+ ScreenSong := TScreenSong.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Song', 3); Log.BenchmarkStart(3);
+ ScreenSongMenu := TScreenSongMenu.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Song Menu', 3); Log.BenchmarkStart(3);
+ ScreenSing := TScreenSing.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Sing', 3); Log.BenchmarkStart(3);
+ ScreenScore := TScreenScore.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Score', 3); Log.BenchmarkStart(3);
+ ScreenTop5 := TScreenTop5.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Top5', 3); Log.BenchmarkStart(3);
+ ScreenOptions := TScreenOptions.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options', 3); Log.BenchmarkStart(3);
+ ScreenOptionsGame := TScreenOptionsGame.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Game', 3); Log.BenchmarkStart(3);
+ ScreenOptionsGraphics := TScreenOptionsGraphics.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Graphics', 3); Log.BenchmarkStart(3);
+ ScreenOptionsSound := TScreenOptionsSound.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Sound', 3); Log.BenchmarkStart(3);
+ ScreenOptionsLyrics := TScreenOptionsLyrics.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Lyrics', 3); Log.BenchmarkStart(3);
+ ScreenOptionsThemes := TScreenOptionsThemes.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Themes', 3); Log.BenchmarkStart(3);
+ ScreenOptionsRecord := TScreenOptionsRecord.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Record', 3); Log.BenchmarkStart(3);
+ ScreenOptionsAdvanced := TScreenOptionsAdvanced.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Advanced', 3); Log.BenchmarkStart(3);
+ ScreenEditSub := TScreenEditSub.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Edit Sub', 3); Log.BenchmarkStart(3);
+ ScreenEdit := TScreenEdit.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Edit', 3); Log.BenchmarkStart(3);
+ ScreenEditConvert := TScreenEditConvert.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen EditConvert', 3); Log.BenchmarkStart(3);
+// ScreenEditHeader := TScreenEditHeader.Create(Skin.ScoreBG);
+// Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Edit Header', 3); Log.BenchmarkStart(3);
+ ScreenOpen := TScreenOpen.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Open', 3); Log.BenchmarkStart(3);
+ ScreenSingModi := TScreenSingModi.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Sing with Modi support', 3); Log.BenchmarkStart(3);
+ ScreenSongMenu := TScreenSongMenu.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen SongMenu', 3); Log.BenchmarkStart(3);
+ ScreenSongJumpto := TScreenSongJumpto.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen SongJumpto', 3); Log.BenchmarkStart(3);
+ ScreenPopupCheck := TScreenPopupCheck.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Popup (Check)', 3); Log.BenchmarkStart(3);
+ ScreenPopupError := TScreenPopupError.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Popup (Error)', 3); Log.BenchmarkStart(3);
+ ScreenPartyNewRound := TScreenPartyNewRound.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyNewRound', 3); Log.BenchmarkStart(3);
+ ScreenPartyScore := TScreenPartyScore.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyScore', 3); Log.BenchmarkStart(3);
+ ScreenPartyWin := TScreenPartyWin.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyWin', 3); Log.BenchmarkStart(3);
+ ScreenPartyOptions := TScreenPartyOptions.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyOptions', 3); Log.BenchmarkStart(3);
+ ScreenPartyPlayer := TScreenPartyPlayer.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyPlayer', 3); Log.BenchmarkStart(3);
+ ScreenStatMain := TScreenStatMain.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Stat Main', 3); Log.BenchmarkStart(3);
+ ScreenStatDetail := TScreenStatDetail.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Stat Detail', 3); Log.BenchmarkStart(3);
+ ScreenCredits := TScreenCredits.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Credits', 3); Log.BenchmarkStart(3);
+
+end;
+
+function LoadingThreadFunction: integer;
+begin
+ LoadScreens;
+ Result:= 1;
+end;
+
+procedure UnLoadScreens;
+begin
+ freeandnil( ScreenMain );
+ freeandnil( ScreenName );
+ freeandnil( ScreenLevel);
+ freeandnil( ScreenSong );
+ freeandnil( ScreenSongMenu );
+ freeandnil( ScreenSing );
+ freeandnil( ScreenScore);
+ freeandnil( ScreenTop5 );
+ freeandnil( ScreenOptions );
+ freeandnil( ScreenOptionsGame );
+ freeandnil( ScreenOptionsGraphics );
+ freeandnil( ScreenOptionsSound );
+ freeandnil( ScreenOptionsLyrics );
+// freeandnil( ScreenOptionsThemes );
+ freeandnil( ScreenOptionsRecord );
+ freeandnil( ScreenOptionsAdvanced );
+ freeandnil( ScreenEditSub );
+ freeandnil( ScreenEdit );
+ freeandnil( ScreenEditConvert );
+ freeandnil( ScreenOpen );
+ freeandnil( ScreenSingModi );
+ freeandnil( ScreenSongMenu );
+ freeandnil( ScreenSongJumpto);
+ freeandnil( ScreenPopupCheck );
+ freeandnil( ScreenPopupError );
+ freeandnil( ScreenPartyNewRound );
+ freeandnil( ScreenPartyScore );
+ freeandnil( ScreenPartyWin );
+ freeandnil( ScreenPartyOptions );
+ freeandnil( ScreenPartyPlayer );
+ freeandnil( ScreenStatMain );
+ freeandnil( ScreenStatDetail );
+end;
+
+end.
diff --git a/src/base/UGraphicClasses.pas b/src/base/UGraphicClasses.pas
new file mode 100644
index 00000000..b7174991
--- /dev/null
+++ b/src/base/UGraphicClasses.pas
@@ -0,0 +1,673 @@
+// notes:
+unit UGraphicClasses;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+uses UTexture,SDL;
+
+const DelayBetweenFrames : Cardinal = 60;
+type
+
+ TParticleType=(GoldenNote, PerfectNote, NoteHitTwinkle, PerfectLineTwinkle, ColoredStar, Flare);
+
+ TColour3f = Record
+ r, g, b: Real;
+ end;
+
+ TParticle = Class
+ X, Y : Real; //Position
+ Screen : Integer;
+ W, H : Cardinal; //dimensions of particle
+ Col : array of TColour3f; // Colour(s) of particle
+ Scale : array of Real; // Scaling factors of particle layers
+ Frame : Byte; //act. Frame
+ Tex : Cardinal; //Tex num from Textur Manager
+ Live : Byte; //How many Cycles before Kill
+ RecIndex : Integer; //To which rectangle this particle belongs (only GoldenNote)
+ StarType : TParticleType; // GoldenNote | PerfectNote | NoteHitTwinkle | PerfectLineTwinkle
+ Alpha : Real; // used for fading...
+ mX, mY : Real; // movement-vector for PerfectLineTwinkle
+ SizeMod : Real; // experimental size modifier
+ SurviveSentenceChange : Boolean;
+
+ Constructor Create(cX,cY: Real; cScreen: Integer; cLive: Byte; cFrame : integer; cRecArrayIndex : Integer; cStarType : TParticleType; Player: Cardinal);
+ Destructor Destroy(); override;
+ procedure Draw;
+ procedure LiveOn;
+ end;
+
+ RectanglePositions = Record
+ xTop, yTop, xBottom, yBottom : Real;
+ TotalStarCount : Integer;
+ CurrentStarCount : Integer;
+ Screen : Integer;
+ end;
+
+ PerfectNotePositions = Record
+ xPos, yPos : Real;
+ Screen : Integer;
+ end;
+
+ TEffectManager = Class
+ Particle : array of TParticle;
+ LastTime : Cardinal;
+ RecArray : Array of RectanglePositions;
+ TwinkleArray : Array[0..5] of Real; // store x-position of last twinkle for every player
+ PerfNoteArray : Array of PerfectNotePositions;
+
+ FlareTex: TTexture;
+
+ constructor Create;
+ destructor Destroy; override;
+ procedure Draw;
+ function Spawn(X, Y: Real;
+ Screen: Integer;
+ Live: Byte;
+ StartFrame: Integer;
+ RecArrayIndex: Integer; // this is only used with GoldenNotes
+ StarType: TParticleType;
+ Player: Cardinal // for PerfectLineTwinkle
+ ): Cardinal;
+ procedure SpawnRec();
+ procedure Kill(index: Cardinal);
+ procedure KillAll();
+ procedure SentenceChange();
+ procedure SaveGoldenStarsRec(Xtop, Ytop, Xbottom, Ybottom: Real);
+ procedure SavePerfectNotePos(Xtop, Ytop: Real);
+ procedure GoldenNoteTwinkle(Top,Bottom,Right: Real; Player: Integer);
+ procedure SpawnPerfectLineTwinkle();
+ end;
+
+var GoldenRec : TEffectManager;
+
+implementation
+
+uses sysutils,
+ gl,
+ UIni,
+ UMain,
+ UThemes,
+ USkins,
+ UGraphic,
+ UDrawTexture,
+ UCommon,
+ math;
+
+//TParticle
+Constructor TParticle.Create(cX,cY: Real; cScreen: Integer; cLive: Byte; cFrame : integer; cRecArrayIndex : Integer; cStarType : TParticleType; Player: Cardinal);
+begin
+ inherited Create;
+ // in this constructor we set all initial values for our particle
+ X := cX;
+ Y := cY;
+ Screen := cScreen;
+ Live := cLive;
+ Frame:= cFrame;
+ RecIndex := cRecArrayIndex;
+ StarType := cStarType;
+ Alpha := (-cos((Frame+1)*2*pi/16)+1); // neat fade-in-and-out
+ SetLength(Scale,1);
+ Scale[0] := 1;
+ SurviveSentenceChange := False;
+ SizeMod := 1;
+ case cStarType of
+ GoldenNote:
+ begin
+ Tex := Tex_Note_Star.TexNum;
+ W := 20;
+ H := 20;
+ SetLength(Scale,4);
+ Scale[1]:=0.8;
+ Scale[2]:=0.4;
+ Scale[3]:=0.3;
+ SetLength(Col,4);
+ Col[0].r := 1;
+ Col[0].g := 0.7;
+ Col[0].b := 0.1;
+
+ Col[1].r := 1;
+ Col[1].g := 1;
+ Col[1].b := 0.4;
+
+ Col[2].r := 1;
+ Col[2].g := 1;
+ Col[2].b := 1;
+
+ Col[3].r := 1;
+ Col[3].g := 1;
+ Col[3].b := 1;
+ end;
+ PerfectNote:
+ begin
+ Tex := Tex_Note_Perfect_Star.TexNum;
+ W := 30;
+ H := 30;
+ SetLength(Col,1);
+ Col[0].r := 1;
+ Col[0].g := 1;
+ Col[0].b := 0.95;
+ end;
+ NoteHitTwinkle:
+ begin
+ Tex := Tex_Note_Star.TexNum;
+ Alpha := (Live/16); // linear fade-out
+ W := 15;
+ H := 15;
+ Setlength(Col,1);
+ Col[0].r := 1;
+ Col[0].g := 1;
+ Col[0].b := RandomRange(10*Live,100)/90; //0.9;
+ end;
+ PerfectLineTwinkle:
+ begin
+ Tex := Tex_Note_Star.TexNum;
+ W := RandomRange(10,20);
+ H := W;
+ SizeMod := (-cos((Frame+1)*5*2*pi/16)*0.5+1.1);
+ SurviveSentenceChange:=True;
+ // assign colours according to player given
+ SetLength(Scale,3);
+ Scale[1]:=0.3;
+ Scale[2]:=0.2;
+ SetLength(Col,3);
+ case Player of
+ 0: LoadColor(Col[0].r,Col[0].g,Col[0].b,'P1Light');
+ 1: LoadColor(Col[0].r,Col[0].g,Col[0].b,'P2Light');
+ 2: LoadColor(Col[0].r,Col[0].g,Col[0].b,'P3Light');
+ 3: LoadColor(Col[0].r,Col[0].g,Col[0].b,'P4Light');
+ 4: LoadColor(Col[0].r,Col[0].g,Col[0].b,'P5Light');
+ 5: LoadColor(Col[0].r,Col[0].g,Col[0].b,'P6Light');
+ else LoadColor(Col[0].r,Col[0].g,Col[0].b,'P1Light');
+ end;
+ Col[1].r := 1;
+ Col[1].g := 1;
+ Col[1].b := 0.4;
+ Col[2].r:=Col[0].r+0.5;
+ Col[2].g:=Col[0].g+0.5;
+ Col[2].b:=Col[0].b+0.5;
+ mX := RandomRange(-5,5);
+ mY := RandomRange(-5,5);
+ end;
+ ColoredStar:
+ begin
+ Tex := Tex_Note_Star.TexNum;
+ W := RandomRange(10,20);
+ H := W;
+ SizeMod := (-cos((Frame+1)*5*2*pi/16)*0.5+1.1);
+ SurviveSentenceChange:=True;
+ // assign colours according to player given
+ SetLength(Scale,1);
+ SetLength(Col,1);
+ Col[0].b := (Player and $ff)/255;
+ Col[0].g := ((Player shr 8) and $ff)/255;
+ Col[0].r := ((Player shr 16) and $ff)/255;
+ mX := 0;
+ mY := 0;
+ end;
+ Flare:
+ begin
+ Tex := Tex_Note_Star.TexNum;
+ W := 7;
+ H := 7;
+ SizeMod := (-cos((Frame+1)*5*2*pi/16)*0.5+1.1);
+ mX := RandomRange(-5,5);
+ mY := RandomRange(-5,5);
+ SetLength(Scale,4);
+ Scale[1]:=0.8;
+ Scale[2]:=0.4;
+ Scale[3]:=0.3;
+ SetLength(Col,4);
+ Col[0].r := 1;
+ Col[0].g := 0.7;
+ Col[0].b := 0.1;
+
+ Col[1].r := 1;
+ Col[1].g := 1;
+ Col[1].b := 0.4;
+
+ Col[2].r := 1;
+ Col[2].g := 1;
+ Col[2].b := 1;
+
+ Col[3].r := 1;
+ Col[3].g := 1;
+ Col[3].b := 1;
+
+ end;
+ else // just some random default values
+ begin
+ Tex := Tex_Note_Star.TexNum;
+ Alpha := 1;
+ W := 20;
+ H := 20;
+ SetLength(Col,1);
+ Col[0].r := 1;
+ Col[0].g := 1;
+ Col[0].b := 1;
+ end;
+ end;
+end;
+
+Destructor TParticle.Destroy();
+begin
+ SetLength(Scale,0);
+ SetLength(Col,0);
+ inherited;
+end;
+
+procedure TParticle.LiveOn;
+begin
+ //Live = 0 => Live forever <blindy> ?? but if this is 0 they would be killed in the Manager at Draw
+ if (Live > 0) then
+ Dec(Live);
+
+ // animate frames
+ Frame := ( Frame + 1 ) mod 16;
+
+ // make our particles do funny stuff (besides being animated)
+ // changes of any particle-values throughout its life are done here
+ case StarType of
+ GoldenNote:
+ begin
+ Alpha := (-cos((Frame+1)*2*pi/16)+1); // neat fade-in-and-out
+ end;
+ PerfectNote:
+ begin
+ Alpha := (-cos((Frame+1)*2*pi/16)+1); // neat fade-in-and-out
+ end;
+ NoteHitTwinkle:
+ begin
+ Alpha := (Live/10); // linear fade-out
+ end;
+ PerfectLineTwinkle:
+ begin
+ Alpha := (-cos((Frame+1)*2*pi/16)+1); // neat fade-in-and-out
+ SizeMod := (-cos((Frame+1)*5*2*pi/16)*0.5+1.1);
+ // move around
+ X := X + mX;
+ Y := Y + mY;
+ end;
+ ColoredStar:
+ begin
+ Alpha := (-cos((Frame+1)*2*pi/16)+1); // neat fade-in-and-out
+ end;
+ Flare:
+ begin
+ Alpha := (-cos((Frame+1)/16*1.7*pi+0.3*pi)+1); // neat fade-in-and-out
+ SizeMod := (-cos((Frame+1)*5*2*pi/16)*0.5+1.1);
+ // move around
+ X := X + mX;
+ Y := Y + mY;
+ mY:=mY+1.8;
+// mX:=mX/2;
+ end;
+ end;
+end;
+
+procedure TParticle.Draw;
+var L: Cardinal;
+begin
+ if ScreenAct = Screen then
+ // this draws (multiple) texture(s) of our particle
+ for L:=0 to High(Col) do
+ begin
+ glColor4f(Col[L].r, Col[L].g, Col[L].b, Alpha);
+
+ glBindTexture(GL_TEXTURE_2D, Tex);
+ glEnable(GL_TEXTURE_2D);
+ glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
+ glEnable(GL_BLEND);
+
+ begin
+ glBegin(GL_QUADS);
+ glTexCoord2f((1/16) * Frame, 0); glVertex2f(X-W*Scale[L]*SizeMod, Y-H*Scale[L]*SizeMod);
+ glTexCoord2f((1/16) * Frame + (1/16), 0); glVertex2f(X-W*Scale[L]*SizeMod, Y+H*Scale[L]*SizeMod);
+ glTexCoord2f((1/16) * Frame + (1/16), 1); glVertex2f(X+W*Scale[L]*SizeMod, Y+H*Scale[L]*SizeMod);
+ glTexCoord2f((1/16) * Frame, 1); glVertex2f(X+W*Scale[L]*SizeMod, Y-H*Scale[L]*SizeMod);
+ glEnd;
+ end;
+ end;
+ glcolor4f(1,1,1,1);
+end;
+// end of TParticle
+
+// TEffectManager
+
+constructor TEffectManager.Create;
+var c: Cardinal;
+begin
+ inherited;
+ LastTime := SDL_GetTicks();
+ for c:=0 to 5 do
+ begin
+ TwinkleArray[c] := 0;
+ end;
+end;
+
+destructor TEffectManager.Destroy;
+begin
+ Killall;
+ inherited;
+end;
+
+
+procedure TEffectManager.Draw;
+var
+ I: Integer;
+ CurrentTime: Cardinal;
+//const
+// DelayBetweenFrames : Cardinal = 100;
+begin
+
+ CurrentTime := SDL_GetTicks();
+ //Manage particle life
+ if (CurrentTime - LastTime) > DelayBetweenFrames then
+ begin
+ LastTime := CurrentTime;
+ for I := 0 to high(Particle) do
+ Particle[I].LiveOn;
+ end;
+
+ I := 0;
+ //Kill dead particles
+ while (I <= High(Particle)) do
+ begin
+ if (Particle[I].Live <= 0) then
+ begin
+ kill(I);
+ end
+ else
+ begin
+ inc(I);
+ end;
+ end;
+
+ //Draw
+ for I := 0 to high(Particle) do
+ begin
+ Particle[I].Draw;
+ end;
+end;
+
+// this method creates just one particle
+function TEffectManager.Spawn(X, Y: Real; Screen: Integer; Live: Byte; StartFrame : Integer; RecArrayIndex : Integer; StarType : TParticleType; Player: Cardinal): Cardinal;
+begin
+ Result := Length(Particle);
+ SetLength(Particle, (Result + 1));
+ Particle[Result] := TParticle.Create(X, Y, Screen, Live, StartFrame, RecArrayIndex, StarType, Player);
+end;
+
+// manage Sparkling of GoldenNote Bars
+procedure TEffectManager.SpawnRec();
+Var
+ Xkatze, Ykatze : Real;
+ RandomFrame : Integer;
+ P : Integer; // P as seen on TV as Positionman
+begin
+//Spawn a random amount of stars within the given coordinates
+//RandomRange(0,14) <- this one starts at a random frame, 16 is our last frame - would be senseless to start a particle with 16, cause it would be dead at the next frame
+for P:= 0 to high(RecArray) do
+ begin
+ while (RecArray[P].TotalStarCount > RecArray[P].CurrentStarCount) do
+ begin
+ Xkatze := RandomRange(Ceil(RecArray[P].xTop), Ceil(RecArray[P].xBottom));
+ Ykatze := RandomRange(Ceil(RecArray[P].yTop), Ceil(RecArray[P].yBottom));
+ RandomFrame := RandomRange(0,14);
+ // Spawn a GoldenNote Particle
+ Spawn(Xkatze, Ykatze, RecArray[P].Screen, 16 - RandomFrame, RandomFrame, P, GoldenNote, 0);
+ inc(RecArray[P].CurrentStarCount);
+ end;
+ end;
+ draw;
+end;
+
+// kill one particle (with given index in our particle array)
+procedure TEffectManager.Kill(Index: Cardinal);
+var
+ LastParticleIndex : Integer;
+begin
+// delete particle indexed by Index,
+// overwrite it's place in our particle-array with the particle stored at the last array index,
+// shorten array
+ LastParticleIndex := high(Particle);
+ if not(LastParticleIndex = -1) then // is there still a particle to delete?
+ begin
+ if not(Particle[Index].RecIndex = -1) then // if it is a GoldenNote particle...
+ dec(RecArray[Particle[Index].RecIndex].CurrentStarCount); // take care of its associated GoldenRec
+ // now get rid of that particle
+ Particle[Index].Destroy;
+ Particle[Index] := Particle[LastParticleIndex];
+ SetLength(Particle, LastParticleIndex);
+ end;
+end;
+
+// clean up all particles and management structures
+procedure TEffectManager.KillAll();
+var c: Cardinal;
+begin
+//It's the kill all kennies rotuine
+ while Length(Particle) > 0 do // kill all existing particles
+ Kill(0);
+ SetLength(RecArray,0); // remove GoldenRec positions
+ SetLength(PerfNoteArray,0); // remove PerfectNote positions
+ for c:=0 to 5 do
+ begin
+ TwinkleArray[c] := 0; // reset GoldenNoteHit memory
+ end;
+end;
+
+procedure TEffectManager.SentenceChange();
+var c: Cardinal;
+begin
+ c:=0;
+ while c <= High(Particle) do
+ begin
+ if Particle[c].SurviveSentenceChange then
+ inc(c)
+ else
+ Kill(c);
+ end;
+ SetLength(RecArray,0); // remove GoldenRec positions
+ SetLength(PerfNoteArray,0); // remove PerfectNote positions
+ for c:=0 to 5 do
+ begin
+ TwinkleArray[c] := 0; // reset GoldenNoteHit memory
+ end;
+end;
+
+procedure TeffectManager.GoldenNoteTwinkle(Top,Bottom,Right: Real; Player: Integer);
+//Twinkle stars while golden note hit
+// this is called from UDraw.pas, SingDrawPlayerCzesc
+var
+ C, P, XKatze, YKatze, LKatze: Integer;
+ H: Real;
+begin
+ // make sure we spawn only one time at one position
+ if (TwinkleArray[Player] < Right) then
+ For P := 0 to high(RecArray) do // Are we inside a GoldenNoteRectangle?
+ begin
+ H := (Top+Bottom)/2; // helper...
+ with RecArray[P] do
+ if ((xBottom >= Right) and (xTop <= Right) and
+ (yTop <= H) and (yBottom >= H))
+ and (Screen = ScreenAct) then
+ begin
+ TwinkleArray[Player] := Right; // remember twinkle position for this player
+ for C := 1 to 10 do
+ begin
+ Ykatze := RandomRange(ceil(Top) , ceil(Bottom));
+ XKatze := RandomRange(-7,3);
+ LKatze := RandomRange(7,13);
+ Spawn(Ceil(Right)+XKatze, YKatze, ScreenAct, LKatze, 0, -1, NoteHitTwinkle, 0);
+ end;
+ for C := 1 to 3 do
+ begin
+ Ykatze := RandomRange(ceil(Top)-6 , ceil(Top));
+ XKatze := RandomRange(-5,1);
+ LKatze := RandomRange(4,7);
+ Spawn(Ceil(Right)+XKatze, YKatze, ScreenAct, LKatze, 0, -1, NoteHitTwinkle, 0);
+ end;
+ for C := 1 to 3 do
+ begin
+ Ykatze := RandomRange(ceil(Bottom), ceil(Bottom)+6);
+ XKatze := RandomRange(-5,1);
+ LKatze := RandomRange(4,7);
+ Spawn(Ceil(Right)+XKatze, YKatze, ScreenAct, LKatze, 0, -1, NoteHitTwinkle, 0);
+ end;
+ for C := 1 to 3 do
+ begin
+ Ykatze := RandomRange(ceil(Top)-10 , ceil(Top)-6);
+ XKatze := RandomRange(-5,1);
+ LKatze := RandomRange(1,4);
+ Spawn(Ceil(Right)+XKatze, YKatze, ScreenAct, LKatze, 0, -1, NoteHitTwinkle, 0);
+ end;
+ for C := 1 to 3 do
+ begin
+ Ykatze := RandomRange(ceil(Bottom)+6 , ceil(Bottom)+10);
+ XKatze := RandomRange(-5,1);
+ LKatze := RandomRange(1,4);
+ Spawn(Ceil(Right)+XKatze, YKatze, ScreenAct, LKatze, 0, -1, NoteHitTwinkle, 0);
+ end;
+
+ exit; // found a matching GoldenRec, did spawning stuff... done
+ end;
+ end;
+end;
+
+procedure TEffectManager.SaveGoldenStarsRec(Xtop, Ytop, Xbottom, Ybottom: Real);
+var
+ P : Integer; // P like used in Positions
+ NewIndex : Integer;
+begin
+ For P := 0 to high(RecArray) do // Do we already have that "new" position?
+ begin
+ if (ceil(RecArray[P].xTop) = ceil(Xtop)) and
+ (ceil(RecArray[P].yTop) = ceil(Ytop)) and
+ (ScreenAct = RecArray[p].Screen) then
+ exit; // it's already in the array, so we don't have to create a new one
+ end;
+
+ // we got a new position, add the new positions to our array
+ NewIndex := Length(RecArray);
+ SetLength(RecArray, NewIndex + 1);
+ RecArray[NewIndex].xTop := Xtop;
+ RecArray[NewIndex].yTop := Ytop;
+ RecArray[NewIndex].xBottom := Xbottom;
+ RecArray[NewIndex].yBottom := Ybottom;
+ RecArray[NewIndex].TotalStarCount := ceil(Xbottom - Xtop) div 12 + 3;
+ RecArray[NewIndex].CurrentStarCount := 0;
+ RecArray[NewIndex].Screen := ScreenAct;
+end;
+
+procedure TEffectManager.SavePerfectNotePos(Xtop, Ytop: Real);
+var
+ P : Integer; // P like used in Positions
+ NewIndex : Integer;
+ RandomFrame : Integer;
+ Xkatze, Ykatze : Integer;
+begin
+ For P := 0 to high(PerfNoteArray) do // Do we already have that "new" position?
+ begin
+ with PerfNoteArray[P] do
+ if (ceil(xPos) = ceil(Xtop)) and (ceil(yPos) = ceil(Ytop)) and
+ (Screen = ScreenAct) then
+ exit; // it's already in the array, so we don't have to create a new one
+ end; //for
+
+ // we got a new position, add the new positions to our array
+ NewIndex := Length(PerfNoteArray);
+ SetLength(PerfNoteArray, NewIndex + 1);
+ PerfNoteArray[NewIndex].xPos := Xtop;
+ PerfNoteArray[NewIndex].yPos := Ytop;
+ PerfNoteArray[NewIndex].Screen := ScreenAct;
+
+ for P:= 0 to 2 do
+ begin
+ Xkatze := RandomRange(ceil(Xtop) - 5 , ceil(Xtop) + 10);
+ Ykatze := RandomRange(ceil(Ytop) - 5 , ceil(Ytop) + 10);
+ RandomFrame := RandomRange(0,14);
+ Spawn(Xkatze, Ykatze, ScreenAct, 16 - RandomFrame, RandomFrame, -1, PerfectNote, 0);
+ end; //for
+
+end;
+
+procedure TEffectManager.SpawnPerfectLineTwinkle();
+var
+ P,I,Life: Cardinal;
+ Left, Right, Top, Bottom: Cardinal;
+ cScreen: Integer;
+begin
+// calculation of coordinates done with hardcoded values like in UDraw.pas
+// might need to be adjusted if drawing of SingScreen is modified
+// coordinates may still be a bit weird and need adjustment
+ if Ini.SingWindow = 0 then begin
+ Left := 130;
+ end else begin
+ Left := 30;
+ end;
+ Right := 770;
+ // spawn effect for every player with a perfect line
+ for P:=0 to PlayersPlay-1 do
+ if Player[P].LastSentencePerfect then
+ begin
+ // calculate area where notes of this player are drawn
+ case PlayersPlay of
+ 1: begin
+ Bottom:=Skin_P2_NotesB+10;
+ Top:=Bottom-105;
+ cScreen:=1;
+ end;
+ 2,4: begin
+ case P of
+ 0,2: begin
+ Bottom:=Skin_P1_NotesB+10;
+ Top:=Bottom-105;
+ end;
+ else begin
+ Bottom:=Skin_P2_NotesB+10;
+ Top:=Bottom-105;
+ end;
+ end;
+ case P of
+ 0,1: cScreen:=1;
+ else cScreen:=2;
+ end;
+ end;
+ 3,6: begin
+ case P of
+ 0,3: begin
+ Top:=130;
+ Bottom:=Top+85;
+ end;
+ 1,4: begin
+ Top:=255;
+ Bottom:=Top+85;
+ end;
+ 2,5: begin
+ Top:=380;
+ Bottom:=Top+85;
+ end;
+ end;
+ case P of
+ 0,1,2: cScreen:=1;
+ else cScreen:=2;
+ end;
+ end;
+ end;
+ // spawn Sparkling Stars inside calculated coordinates
+ for I:= 0 to 80 do
+ begin
+ Life:=RandomRange(8,16);
+ Spawn(RandomRange(Left,Right), RandomRange(Top,Bottom), cScreen, Life, 16-Life, -1, PerfectLineTwinkle, P);
+ end;
+ end;
+end;
+
+end.
+
diff --git a/src/base/UHooks.pas b/src/base/UHooks.pas
new file mode 100644
index 00000000..f0ba3276
--- /dev/null
+++ b/src/base/UHooks.pas
@@ -0,0 +1,434 @@
+unit UHooks;
+
+{*********************
+ THookManager
+ Class for saving, managing and calling of Hooks.
+ Saves all hookable events and their subscribers
+*********************}
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+uses uPluginDefs,
+ SysUtils;
+
+type
+ //Record that saves info from Subscriber
+ PSubscriberInfo = ^TSubscriberInfo;
+ TSubscriberInfo = record
+ Self: THandle; //ID of this Subscription (First Word: ID of Subscription; 2nd Word: ID of Hook)
+ Next: PSubscriberInfo; //Pointer to next Item in HookChain
+
+ Owner: Integer; //For Error Handling and Plugin Unloading.
+
+ //Here is s/t tricky
+ //To avoid writing of Wrapping Functions to Hook an Event with a Class
+ //We save a Normal Proc or a Method of a Class
+ Case isClass: boolean of
+ False: (Proc: TUS_Hook); //Proc that will be called on Event
+ True: (ProcOfClass: TUS_Hook_of_Object);
+ end;
+
+ TEventInfo = record
+ Name: String[60]; //Name of Event
+ FirstSubscriber: PSubscriberInfo; //First subscriber in chain
+ LastSubscriber: PSubscriberInfo; //Last " (for easier subscriber adding
+ end;
+
+ THookManager = class
+ private
+ Events: array of TEventInfo;
+ SpaceinEvents: Word; //Number of empty Items in Events Array. (e.g. Deleted Items)
+
+ Procedure FreeSubscriber(const EventIndex: Word; const Last, Cur: PSubscriberInfo);
+ public
+ constructor Create(const SpacetoAllocate: Word);
+
+ Function AddEvent (const EventName: PChar): THandle;
+ Function DelEvent (hEvent: THandle): Integer;
+
+ Function AddSubscriber (const EventName: PChar; const Proc: TUS_Hook = nil; const ProcOfClass: TUS_Hook_of_Object = nil): THandle;
+ Function DelSubscriber (const hSubscriber: THandle): Integer;
+
+ Function CallEventChain (const hEvent: THandle; const wParam: TwParam; lParam: TlParam): Integer;
+ Function EventExists (const EventName: PChar): Integer;
+
+ Procedure DelbyOwner(const Owner: Integer);
+ end;
+
+function HookTest(wParam: TwParam; lParam: TlParam): integer; stdcall;
+
+var
+ HookManager: THookManager;
+
+implementation
+uses
+ ULog,
+ UCore;
+
+//------------
+// Create - Creates Class and Set Standard Values
+//------------
+constructor THookManager.Create(const SpacetoAllocate: Word);
+var I: Integer;
+begin
+ inherited Create();
+
+ //Get the Space and "Zero" it
+ SetLength (Events, SpacetoAllocate);
+ For I := 0 to SpacetoAllocate-1 do
+ Events[I].Name[1] := chr(0);
+
+ SpaceinEvents := SpacetoAllocate;
+
+ {$IFDEF DEBUG}
+ debugWriteLn('HookManager: Succesful Created.');
+ {$ENDIF}
+end;
+
+//------------
+// AddEvent - Adds an Event and return the Events Handle or 0 on Failure
+//------------
+Function THookManager.AddEvent (const EventName: PChar): THandle;
+var I: Integer;
+begin
+ Result := 0;
+
+ if (EventExists(EventName) = 0) then
+ begin
+ If (SpaceinEvents > 0) then
+ begin
+ //There is already Space available
+ //Go Search it!
+ For I := 0 to High(Events) do
+ If (Events[I].Name[1] = chr(0)) then
+ begin //Found Space
+ Result := I;
+ Dec(SpaceinEvents);
+ Break;
+ end;
+
+ {$IFDEF DEBUG}
+ debugWriteLn('HookManager: Found Space for Event at Handle: ''' + InttoStr(Result+1) + '');
+ {$ENDIF}
+ end
+ else
+ begin //There is no Space => Go make some!
+ Result := Length(Events);
+ SetLength(Events, Result + 1);
+ end;
+
+ //Set Events Data
+ Events[Result].Name := EventName;
+ Events[Result].FirstSubscriber := nil;
+ Events[Result].LastSubscriber := nil;
+
+ //Handle is Index + 1
+ Inc(Result);
+
+ {$IFDEF DEBUG}
+ debugWriteLn('HookManager: Add Event succesful: ''' + EventName + '');
+ {$ENDIF}
+ end
+ {$IFDEF DEBUG}
+ else
+ debugWriteLn('HookManager: Trying to ReAdd Event: ''' + EventName + '');
+ {$ENDIF}
+end;
+
+//------------
+// DelEvent - Deletes an Event by Handle Returns False on Failure
+//------------
+Function THookManager.DelEvent (hEvent: THandle): Integer;
+var
+ Cur, Last: PSubscriberInfo;
+begin
+ hEvent := hEvent - 1; //Arrayindex is Handle - 1
+ Result := -1;
+
+
+ If (Length(Events) > hEvent) AND (Events[hEvent].Name[1] <> chr(0)) then
+ begin //Event exists
+ //Free the Space for all Subscribers
+ Cur := Events[hEvent].FirstSubscriber;
+
+ While (Cur <> nil) do
+ begin
+ Last := Cur;
+ Cur := Cur.Next;
+ FreeMem(Last, SizeOf(TSubscriberInfo));
+ end;
+
+ {$IFDEF DEBUG}
+ debugWriteLn('HookManager: Removed Event succesful: ''' + Events[hEvent].Name + '');
+ {$ENDIF}
+
+ //Free the Event
+ Events[hEvent].Name[1] := chr(0);
+ Inc(SpaceinEvents); //There is one more space for new events
+ end
+
+ {$IFDEF DEBUG}
+ else
+ debugWriteLn('HookManager: Try to Remove not Existing Event. Handle: ''' + InttoStr(hEvent) + '');
+ {$ENDIF}
+end;
+
+//------------
+// AddSubscriber - Adds an Subscriber to the Event by Name
+// Returns Handle of the Subscribtion or 0 on Failure
+//------------
+Function THookManager.AddSubscriber (const EventName: PChar; const Proc: TUS_Hook; const ProcOfClass: TUS_Hook_of_Object): THandle;
+var
+ EventHandle: THandle;
+ EventIndex: Cardinal;
+ Cur: PSubscriberInfo;
+begin
+ Result := 0;
+
+ If (@Proc <> nil) or (@ProcOfClass <> nil) then
+ begin
+ EventHandle := EventExists(EventName);
+
+ If (EventHandle <> 0) then
+ begin
+ EventIndex := EventHandle - 1;
+
+ //Get Memory
+ GetMem(Cur, SizeOf(TSubscriberInfo));
+
+ //Fill it with Data
+ Cur.Next := nil;
+
+ //Add Owner
+ Cur.Owner := Core.CurExecuted;
+
+ If (@Proc = nil) then
+ begin //Use the ProcofClass Method
+ Cur.isClass := True;
+ Cur.ProcOfClass := ProcofClass;
+ end
+ else //Use the normal Proc
+ begin
+ Cur.isClass := False;
+ Cur.Proc := Proc;
+ end;
+
+ //Create Handle (1st Word: Handle of Event; 2nd Word: unique ID
+ If (Events[EventIndex].LastSubscriber = nil) then
+ begin
+ If (Events[EventIndex].FirstSubscriber = nil) then
+ begin
+ Result := (EventHandle SHL 16);
+ Events[EventIndex].FirstSubscriber := Cur;
+ end
+ Else
+ begin
+ Result := Events[EventIndex].FirstSubscriber.Self + 1;
+ end;
+ end
+ Else
+ begin
+ Result := Events[EventIndex].LastSubscriber.Self + 1;
+ Events[EventIndex].LastSubscriber.Next := Cur;
+ end;
+
+ Cur.Self := Result;
+
+ //Add to Chain
+ Events[EventIndex].LastSubscriber := Cur;
+
+ {$IFDEF DEBUG}
+ debugWriteLn('HookManager: Add Subscriber to Event ''' + Events[EventIndex].Name + ''' succesful. Handle: ''' + InttoStr(Result) + ''' Owner: ' + InttoStr(Cur.Owner));
+ {$ENDIF}
+ end;
+ end;
+end;
+
+//------------
+// FreeSubscriber - Helper for DelSubscriber. Prevents Loss of Chain Items. Frees Memory.
+//------------
+Procedure THookManager.FreeSubscriber(const EventIndex: Word; const Last, Cur: PSubscriberInfo);
+begin
+ //Delete from Chain
+ If (Last <> nil) then
+ begin
+ Last.Next := Cur.Next;
+ end
+ else //Was first Popup
+ begin
+ Events[EventIndex].FirstSubscriber := Cur.Next;
+ end;
+
+ //Was this Last subscription ?
+ If (Cur = Events[EventIndex].LastSubscriber) then
+ begin //Change Last Subscriber
+ Events[EventIndex].LastSubscriber := Last;
+ end;
+
+ //Free Space:
+ FreeMem(Cur, SizeOf(TSubscriberInfo));
+end;
+
+//------------
+// DelSubscriber - Deletes a Subscribtion by Handle, return non Zero on Failure
+//------------
+Function THookManager.DelSubscriber (const hSubscriber: THandle): Integer;
+var
+ EventIndex: Cardinal;
+ Cur, Last: PSubscriberInfo;
+begin
+ Result := -1;
+ EventIndex := ((hSubscriber AND (High(THandle) xor High(Word))) SHR 16) - 1;
+
+ //Existing Event ?
+ If (EventIndex < Length(Events)) AND (Events[EventIndex].Name[1] <> chr(0)) then
+ begin
+ Result := -2; //Return -1 on not existing Event, -2 on not existing Subscription
+
+ //Search for Subscription
+ Cur := Events[EventIndex].FirstSubscriber;
+ Last := nil;
+
+ //go through the chain ...
+ While (Cur <> nil) do
+ begin
+ If (Cur.Self = hSubscriber) then
+ begin //Found Subscription we searched for
+ FreeSubscriber(EventIndex, Last, Cur);
+
+ {$IFDEF DEBUG}
+ debugWriteLn('HookManager: Del Subscriber from Event ''' + Events[EventIndex].Name + ''' succesful. Handle: ''' + InttoStr(hSubscriber) + '');
+ {$ENDIF}
+
+ //Set Result and Break the Loop
+ Result := 0;
+ Break;
+ end;
+
+ Last := Cur;
+ Cur := Cur.Next;
+ end;
+
+ end;
+end;
+
+
+//------------
+// CallEventChain - Calls the Chain of a specified EventHandle
+// Returns: -1: Handle doesn't Exist, 0 Chain is called until the End
+//------------
+Function THookManager.CallEventChain (const hEvent: THandle; const wParam: TwParam; lParam: TlParam): Integer;
+var
+ EventIndex: Cardinal;
+ Cur: PSubscriberInfo;
+ CurExecutedBackup: Integer; //backup of Core.CurExecuted Attribute
+begin
+ Result := -1;
+ EventIndex := hEvent - 1;
+
+ If ((EventIndex <= High(Events)) AND (Events[EventIndex].Name[1] <> chr(0))) then
+ begin //Existing Event
+ //Backup CurExecuted
+ CurExecutedBackup := Core.CurExecuted;
+
+ //Start calling the Chain !!!11
+ Cur := Events[EventIndex].FirstSubscriber;
+ Result := 0;
+ //Call Hooks until the Chain is at the End or breaked
+ While ((Cur <> nil) AND (Result = 0)) do
+ begin
+ //Set CurExecuted
+ Core.CurExecuted := Cur.Owner;
+ if (Cur.isClass) then
+ Result := Cur.ProcOfClass(wParam, lParam)
+ else
+ Result := Cur.Proc(wParam, lParam);
+
+ Cur := Cur.Next;
+ end;
+
+ //Restore CurExecuted
+ Core.CurExecuted := CurExecutedBackup;
+ end;
+
+ {$IFDEF DEBUG}
+ debugWriteLn('HookManager: Called Chain from Event ''' + Events[EventIndex].Name + ''' succesful. Result: ''' + InttoStr(Result) + '');
+ {$ENDIF}
+end;
+
+//------------
+// EventExists - Returns non Zero if an Event with the given Name exists
+//------------
+Function THookManager.EventExists (const EventName: PChar): Integer;
+var
+ I: Integer;
+ Name: String[60];
+begin
+ Result := 0;
+ //If (Length(EventName) <
+ Name := String(EventName);
+
+ //Sure not to search for empty space
+ If (Name[1] <> chr(0)) then
+ begin
+ //Search for Event
+ For I := 0 to High(Events) do
+ If (Events[I].Name = Name) then
+ begin //Event found
+ Result := I + 1;
+ Break;
+ end;
+ end;
+end;
+
+//------------
+// DelbyOwner - Dels all Subscriptions by a specific Owner. (For Clean Plugin/Module unloading)
+//------------
+Procedure THookManager.DelbyOwner(const Owner: Integer);
+var
+ I: Integer;
+ Cur, Last: PSubscriberInfo;
+begin
+ //Search for Owner in all Hooks Chains
+ For I := 0 to High(Events) do
+ begin
+ If (Events[I].Name[1] <> chr(0)) then
+ begin
+
+ Last := nil;
+ Cur := Events[I].FirstSubscriber;
+ //Went Through Chain
+ While (Cur <> nil) do
+ begin
+ If (Cur.Owner = Owner) then
+ begin //Found Subscription by Owner -> Delete
+ FreeSubscriber(I, Last, Cur);
+ If (Last <> nil) then
+ Cur := Last.Next
+ else
+ Cur := Events[I].FirstSubscriber;
+ end
+ Else
+ begin
+ //Next Item:
+ Last := Cur;
+ Cur := Cur.Next;
+ end;
+ end;
+ end;
+ end;
+end;
+
+
+function HookTest(wParam: TwParam; lParam: TlParam): integer; stdcall;
+begin
+ Result := 0; //Don't break the chain
+ Core.ShowMessage(CORE_SM_INFO, PChar(String(PChar(Pointer(lParam))) + ': ' + String(PChar(Pointer(wParam)))));
+end;
+
+end.
diff --git a/src/base/UImage.pas b/src/base/UImage.pas
new file mode 100644
index 00000000..d33c0d38
--- /dev/null
+++ b/src/base/UImage.pas
@@ -0,0 +1,993 @@
+unit UImage;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+uses
+ SDL;
+
+{$DEFINE HavePNG}
+{$DEFINE HaveBMP}
+{$DEFINE HaveJPG}
+
+const
+ PixelFmt_RGBA: TSDL_Pixelformat = (
+ palette: nil;
+ BitsPerPixel: 32;
+ BytesPerPixel: 4;
+ Rloss: 0;
+ Gloss: 0;
+ Bloss: 0;
+ Aloss: 0;
+ Rshift: 0;
+ Gshift: 8;
+ Bshift: 16;
+ Ashift: 24;
+ Rmask: $000000ff;
+ Gmask: $0000ff00;
+ Bmask: $00ff0000;
+ Amask: $ff000000;
+ ColorKey: 0;
+ Alpha: 255
+ );
+
+ PixelFmt_RGB: TSDL_Pixelformat = (
+ palette: nil;
+ BitsPerPixel: 24;
+ BytesPerPixel: 3;
+ Rloss: 0;
+ Gloss: 0;
+ Bloss: 0;
+ Aloss: 0;
+ Rshift: 0;
+ Gshift: 8;
+ Bshift: 16;
+ Ashift: 0;
+ Rmask: $000000ff;
+ Gmask: $0000ff00;
+ Bmask: $00ff0000;
+ Amask: $00000000;
+ ColorKey: 0;
+ Alpha: 255
+ );
+
+ PixelFmt_BGRA: TSDL_Pixelformat = (
+ palette: nil;
+ BitsPerPixel: 32;
+ BytesPerPixel: 4;
+ Rloss: 0;
+ Gloss: 0;
+ Bloss: 0;
+ Aloss: 0;
+ Rshift: 16;
+ Gshift: 8;
+ Bshift: 0;
+ Ashift: 24;
+ Rmask: $00ff0000;
+ Gmask: $0000ff00;
+ Bmask: $000000ff;
+ Amask: $ff000000;
+ ColorKey: 0;
+ Alpha: 255
+ );
+
+ PixelFmt_BGR: TSDL_Pixelformat = (
+ palette: nil;
+ BitsPerPixel: 24;
+ BytesPerPixel: 3;
+ Rloss: 0;
+ Gloss: 0;
+ Bloss: 0;
+ Aloss: 0;
+ Rshift: 16;
+ Gshift: 8;
+ Bshift: 0;
+ Ashift: 0;
+ Rmask: $00ff0000;
+ Gmask: $0000ff00;
+ Bmask: $000000ff;
+ Amask: $00000000;
+ ColorKey: 0;
+ Alpha: 255
+ );
+
+type
+ TImagePixelFmt = (
+ ipfRGBA, ipfRGB, ipfBGRA, ipfBGR
+ );
+
+(*******************************************************
+ * Image saving
+ *******************************************************)
+
+{$IFDEF HavePNG}
+function WritePNGImage(const FileName: string; Surface: PSDL_Surface): boolean;
+{$ENDIF}
+{$IFDEF HaveBMP}
+function WriteBMPImage(const FileName: string; Surface: PSDL_Surface): boolean;
+{$ENDIF}
+{$IFDEF HaveJPG}
+function WriteJPGImage(const FileName: string; Surface: PSDL_Surface; Quality: integer): boolean;
+{$ENDIF}
+
+(*******************************************************
+ * Image loading
+ *******************************************************)
+
+function LoadImage(const Identifier: string): PSDL_Surface;
+
+(*******************************************************
+ * Image manipulation
+ *******************************************************)
+
+function PixelFormatEquals(fmt1, fmt2: PSDL_PixelFormat): boolean;
+procedure ScaleImage(var ImgSurface: PSDL_Surface; Width, Height: Cardinal);
+procedure FitImage(var ImgSurface: PSDL_Surface; Width, Height: Cardinal);
+procedure ColorizeImage(ImgSurface: PSDL_Surface; NewColor: Cardinal);
+
+
+implementation
+
+uses
+ SysUtils,
+ Classes,
+ Math,
+ {$IFDEF MSWINDOWS}
+ Windows,
+ {$ENDIF}
+ {$IFDEF HaveJPG}
+ {$IFDEF Delphi}
+ Graphics,
+ jpeg,
+ {$ELSE}
+ jpeglib,
+ jerror,
+ jcparam,
+ jdatadst, jcapimin, jcapistd,
+ {$ENDIF}
+ {$ENDIF}
+ {$IFDEF HavePNG}
+ png,
+ {$ENDIF}
+ zlib,
+ sdl_image,
+ sdlutils,
+ UCommon,
+ ULog;
+
+
+function IsRGBSurface(pixelFmt: PSDL_PixelFormat): boolean;
+begin
+ Result := (pixelFmt.BitsPerPixel = 24) and
+ (pixelFmt.RMask = $0000FF) and
+ (pixelFmt.GMask = $00FF00) and
+ (pixelFmt.BMask = $FF0000);
+end;
+
+function IsRGBASurface(pixelFmt: PSDL_PixelFormat): boolean;
+begin
+ Result := (pixelFmt.BitsPerPixel = 32) and
+ (pixelFmt.RMask = $000000FF) and
+ (pixelFmt.GMask = $0000FF00) and
+ (pixelFmt.BMask = $00FF0000) and
+ (pixelFmt.AMask = $FF000000);
+end;
+
+function IsBGRSurface(pixelFmt: PSDL_PixelFormat): boolean;
+begin
+ Result := (pixelFmt.BitsPerPixel = 24) and
+ (pixelFmt.BMask = $0000FF) and
+ (pixelFmt.GMask = $00FF00) and
+ (pixelFmt.RMask = $FF0000);
+end;
+
+function IsBGRASurface(pixelFmt: PSDL_PixelFormat): boolean;
+begin
+ Result := (pixelFmt.BitsPerPixel = 32) and
+ (pixelFmt.BMask = $000000FF) and
+ (pixelFmt.GMask = $0000FF00) and
+ (pixelFmt.RMask = $00FF0000) and
+ (pixelFmt.AMask = $FF000000);
+end;
+
+// Converts alpha-formats to BGRA, non-alpha to BGR, and leaves BGR(A) as is
+// sets converted to true if the surface needed to be converted
+function ConvertToBGR_BGRASurface(Surface: PSDL_Surface; out Converted: boolean): PSDL_Surface;
+var
+ pixelFmt: PSDL_PixelFormat;
+begin
+ pixelFmt := Surface.format;
+ if (IsBGRSurface(pixelFmt) or IsBGRASurface(pixelFmt)) then
+ begin
+ Converted := false;
+ Result := Surface;
+ end
+ else
+ begin
+ // invalid format -> needs conversion
+ if (pixelFmt.AMask <> 0) then
+ Result := SDL_ConvertSurface(Surface, @PixelFmt_BGRA, SDL_SWSURFACE)
+ else
+ Result := SDL_ConvertSurface(Surface, @PixelFmt_BGR, SDL_SWSURFACE);
+ Converted := true;
+ end;
+end;
+
+// Converts alpha-formats to RGBA, non-alpha to RGB, and leaves RGB(A) as is
+// sets converted to true if the surface needed to be converted
+function ConvertToRGB_RGBASurface(Surface: PSDL_Surface; out Converted: boolean): PSDL_Surface;
+var
+ pixelFmt: PSDL_PixelFormat;
+begin
+ pixelFmt := Surface.format;
+ if (IsRGBSurface(pixelFmt) or IsRGBASurface(pixelFmt)) then
+ begin
+ Converted := false;
+ Result := Surface;
+ end
+ else
+ begin
+ // invalid format -> needs conversion
+ if (pixelFmt.AMask <> 0) then
+ Result := SDL_ConvertSurface(Surface, @PixelFmt_RGBA, SDL_SWSURFACE)
+ else
+ Result := SDL_ConvertSurface(Surface, @PixelFmt_RGB, SDL_SWSURFACE);
+ Converted := true;
+ end;
+end;
+
+
+(*******************************************************
+ * Image saving
+ *******************************************************)
+
+(***************************
+ * PNG section
+ *****************************)
+
+{$IFDEF HavePNG}
+
+// delphi does not support setjmp()/longjmp() -> define our own error-handler
+procedure user_error_fn(png_ptr: png_structp; error_msg: png_const_charp); cdecl;
+begin
+ raise Exception.Create(error_msg);
+end;
+
+procedure user_read_data(png_ptr: png_structp; data: png_bytep; length: png_size_t); cdecl;
+var
+ inFile: TFileStream;
+begin
+ inFile := TFileStream(png_get_io_ptr(png_ptr));
+ inFile.Read(data^, length);
+end;
+
+procedure user_write_data(png_ptr: png_structp; data: png_bytep; length: png_size_t); cdecl;
+var
+ outFile: TFileStream;
+begin
+ outFile := TFileStream(png_get_io_ptr(png_ptr));
+ outFile.Write(data^, length);
+end;
+
+procedure user_flush_data(png_ptr: png_structp); cdecl;
+//var
+// outFile: TFileStream;
+begin
+ // binary files are flushed automatically, Flush() works with Text-files only
+ //outFile := TFileStream(png_get_io_ptr(png_ptr));
+ //outFile.Flush();
+end;
+
+procedure DateTimeToPngTime(time: TDateTime; var pngTime: png_time);
+var
+ year, month, day: word;
+ hour, minute, second, msecond: word;
+begin
+ DecodeDate(time, year, month, day);
+ pngTime.year := year;
+ pngTime.month := month;
+ pngTime.day := day;
+ DecodeTime(time, hour, minute, second, msecond);
+ pngTime.hour := hour;
+ pngTime.minute := minute;
+ pngTime.second := second;
+end;
+
+(*
+ * ImageData must be in RGB-format
+ *)
+function WritePNGImage(const FileName: string; Surface: PSDL_Surface): boolean;
+var
+ png_ptr: png_structp;
+ info_ptr: png_infop;
+ pngFile: TFileStream;
+ row: integer;
+ rowData: array of png_bytep;
+// rowStride: integer;
+ converted: boolean;
+ colorType: integer;
+// time: png_time;
+begin
+ Result := false;
+
+ // open file for writing
+ try
+ pngFile := TFileStream.Create(FileName, fmCreate);
+ except
+ Log.LogError('Could not open file: "' + FileName + '"', 'WritePngImage');
+ Exit;
+ end;
+
+ // only 24bit (RGB) or 32bit (RGBA) data is supported, so convert to it
+ Surface := ConvertToRGB_RGBASurface(Surface, converted);
+
+ png_ptr := nil;
+
+ try
+ // initialize png (and enable a user-defined error-handler that throws an exception on error)
+ png_ptr := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, @user_error_fn, nil);
+ // the error-handler is called if png_create_write_struct() fails, so png_ptr should always be <> nil
+ if (png_ptr = nil) then
+ begin
+ Log.LogError('png_create_write_struct() failed', 'WritePngImage');
+ if (converted) then
+ SDL_FreeSurface(Surface);
+ Exit;
+ end;
+
+ info_ptr := png_create_info_struct(png_ptr);
+
+ if (Surface^.format^.BitsPerPixel = 24) then
+ colorType := PNG_COLOR_TYPE_RGB
+ else
+ colorType := PNG_COLOR_TYPE_RGBA;
+
+ // define write IO-functions (POSIX-style FILE-pointers are not available in Delphi)
+ png_set_write_fn(png_ptr, pngFile, @user_write_data, @user_flush_data);
+ png_set_IHDR(
+ png_ptr, info_ptr,
+ Surface.w, Surface.h,
+ 8,
+ colorType,
+ PNG_INTERLACE_NONE,
+ PNG_COMPRESSION_TYPE_DEFAULT,
+ PNG_FILTER_TYPE_DEFAULT
+ );
+
+ // TODO: do we need the modification time?
+ //DateTimeToPngTime(Now, time);
+ //png_set_tIME(png_ptr, info_ptr, @time);
+
+ if (SDL_MUSTLOCK(Surface)) then
+ SDL_LockSurface(Surface);
+
+ // setup data
+ SetLength(rowData, Surface.h);
+ for row := 0 to Surface.h-1 do
+ begin
+ // set rowData-elements to beginning of each image row
+ // Note: the byte-count of a row is pitch (which is not width*bitsPerPixel if the image is aligned)
+ rowData[row] := @PChar(Surface.pixels)[(Surface.h-row-1) * Surface.pitch];
+ end;
+
+ if (SDL_MUSTLOCK(Surface)) then
+ SDL_UnlockSurface(Surface);
+
+ png_write_info(png_ptr, info_ptr);
+ png_write_image(png_ptr, png_bytepp(rowData));
+ png_write_end(png_ptr, nil);
+
+ Result := true;
+ except on E: Exception do
+ Log.LogError(E.message, 'WritePngImage');
+ end;
+
+ // free row-data
+ SetLength(rowData, 0);
+
+ // free png-resources
+ if (png_ptr <> nil) then
+ png_destroy_write_struct(@png_ptr, nil);
+
+ if (converted) then
+ SDL_FreeSurface(Surface);
+
+ // close file
+ pngFile.Free;
+end;
+
+{$ENDIF}
+
+(***************************
+ * BMP section
+ *****************************)
+
+{$IFDEF HaveBMP}
+
+{$IFNDEF MSWINDOWS}
+const
+ (* constants for the biCompression field *)
+ BI_RGB = 0;
+ BI_RLE8 = 1;
+ BI_RLE4 = 2;
+ BI_BITFIELDS = 3;
+ BI_JPEG = 4;
+ BI_PNG = 5;
+
+type
+ BITMAPINFOHEADER = record
+ biSize: longword;
+ biWidth: longint;
+ biHeight: longint;
+ biPlanes: word;
+ biBitCount: word;
+ biCompression: longword;
+ biSizeImage: longword;
+ biXPelsPerMeter: longint;
+ biYPelsPerMeter: longint;
+ biClrUsed: longword;
+ biClrImportant: longword;
+ end;
+ LPBITMAPINFOHEADER = ^BITMAPINFOHEADER;
+ TBITMAPINFOHEADER = BITMAPINFOHEADER;
+ PBITMAPINFOHEADER = ^BITMAPINFOHEADER;
+
+ RGBTRIPLE = record
+ rgbtBlue: byte;
+ rgbtGreen: byte;
+ rgbtRed: byte;
+ end;
+ tagRGBTRIPLE = RGBTRIPLE;
+ TRGBTRIPLE = RGBTRIPLE;
+ PRGBTRIPLE = ^RGBTRIPLE;
+
+ RGBQUAD = record
+ rgbBlue: byte;
+ rgbGreen: byte;
+ rgbRed: byte;
+ rgbReserved: byte;
+ end;
+ tagRGBQUAD = RGBQUAD;
+ TRGBQUAD = RGBQUAD;
+ PRGBQUAD = ^RGBQUAD;
+
+ BITMAPINFO = record
+ bmiHeader: BITMAPINFOHEADER;
+ bmiColors: array[0..0] of RGBQUAD;
+ end;
+ LPBITMAPINFO = ^BITMAPINFO;
+ PBITMAPINFO = ^BITMAPINFO;
+ TBITMAPINFO = BITMAPINFO;
+
+ {$PACKRECORDS 2}
+ BITMAPFILEHEADER = record
+ bfType: word;
+ bfSize: longword;
+ bfReserved1: word;
+ bfReserved2: word;
+ bfOffBits: longword;
+ end;
+ {$PACKRECORDS DEFAULT}
+{$ENDIF}
+
+(*
+ * ImageData must be in BGR-format
+ *)
+function WriteBMPImage(const FileName: string; Surface: PSDL_Surface): boolean;
+var
+ bmpFile: TFileStream;
+ FileInfo: BITMAPINFOHEADER;
+ FileHeader: BITMAPFILEHEADER;
+ Converted: boolean;
+ Row: integer;
+ RowSize: integer;
+begin
+ Result := false;
+
+ // open file for writing
+ try
+ bmpFile := TFileStream.Create(FileName, fmCreate);
+ except
+ Log.LogError('Could not open file: "' + FileName + '"', 'WriteBMPImage');
+ Exit;
+ end;
+
+ // only 24bit (BGR) or 32bit (BGRA) data is supported, so convert to it
+ Surface := ConvertToBGR_BGRASurface(Surface, Converted);
+
+ // aligned (4-byte) row-size in bytes
+ RowSize := ((Surface.w * Surface.format.BytesPerPixel + 3) div 4) * 4;
+
+ // initialize bitmap info
+ FillChar(FileInfo, SizeOf(BITMAPINFOHEADER), 0);
+ with FileInfo do
+ begin
+ biSize := SizeOf(BITMAPINFOHEADER);
+ biWidth := Surface.w;
+ biHeight := Surface.h;
+ biPlanes := 1;
+ biBitCount := Surface^.format^.BitsPerPixel;
+ biCompression := BI_RGB;
+ biSizeImage := RowSize * Surface.h;
+ end;
+
+ // initialize header-data
+ FillChar(FileHeader, SizeOf(BITMAPFILEHEADER), 0);
+ with FileHeader do
+ begin
+ bfType := $4D42; // = 'BM'
+ bfOffBits := SizeOf(BITMAPFILEHEADER) + SizeOf(BITMAPINFOHEADER);
+ bfSize := bfOffBits + FileInfo.biSizeImage;
+ end;
+
+ // and move the whole stuff into the file ;-)
+ try
+ // write headers
+ bmpFile.Write(FileHeader, SizeOf(BITMAPFILEHEADER));
+ bmpFile.Write(FileInfo, SizeOf(BITMAPINFOHEADER));
+
+ // write image-data
+
+ if (SDL_MUSTLOCK(Surface)) then
+ SDL_LockSurface(Surface);
+
+ // BMP needs 4-byte alignment
+ if (Surface.pitch mod 4 = 0) then
+ begin
+ // aligned correctly -> write whole image at once
+ bmpFile.Write(Surface.pixels^, FileInfo.biSizeImage);
+ end
+ else
+ begin
+ // misaligned -> write each line separately
+ // Note: for the last line unassigned memory (> last Surface.pixels element)
+ // will be copied to the padding area (last bytes of a row),
+ // but we do not care because the content of padding data is ignored anyhow.
+ for Row := 0 to Surface.h do
+ bmpFile.Write(PChar(Surface.pixels)[Row * Surface.pitch], RowSize);
+ end;
+
+ if (SDL_MUSTLOCK(Surface)) then
+ SDL_UnlockSurface(Surface);
+
+ Result := true;
+ finally
+ Log.LogError('Could not write file: "' + FileName + '"', 'WriteBMPImage');
+ end;
+
+ if (Converted) then
+ SDL_FreeSurface(Surface);
+
+ // close file
+ bmpFile.Free;
+end;
+
+{$ENDIF}
+
+(***************************
+ * JPG section
+ *****************************)
+
+{$IFDEF HaveJPG}
+
+function WriteJPGImage(const FileName: string; Surface: PSDL_Surface; Quality: integer): boolean;
+var
+ {$IFDEF Delphi}
+ Bitmap: TBitmap;
+ BitmapInfo: TBitmapInfo;
+ Jpeg: TJpegImage;
+ row: integer;
+ {$ELSE}
+ cinfo: jpeg_compress_struct;
+ jerr : jpeg_error_mgr;
+ jpgFile: TFileStream;
+ rowPtr: array[0..0] of JSAMPROW;
+ {$ENDIF}
+ converted: boolean;
+begin
+ Result := false;
+
+ {$IFDEF Delphi}
+ // only 24bit (BGR) data is supported, so convert to it
+ if (IsBGRSurface(Surface.format)) then
+ converted := false
+ else
+ begin
+ Surface := SDL_ConvertSurface(Surface, @PixelFmt_BGR, SDL_SWSURFACE);
+ converted := true;
+ end;
+
+ // create and setup bitmap
+ Bitmap := TBitmap.Create;
+ Bitmap.PixelFormat := pf24bit;
+ Bitmap.Width := Surface.w;
+ Bitmap.Height := Surface.h;
+
+ // setup bitmap info on source image (Surface parameter)
+ ZeroMemory(@BitmapInfo, SizeOf(BitmapInfo));
+ with BitmapInfo.bmiHeader do
+ begin
+ biSize := SizeOf(BITMAPINFOHEADER);
+ biWidth := Surface.w;
+ biHeight := Surface.h;
+ biPlanes := 1;
+ biBitCount := 24;
+ biCompression := BI_RGB;
+ end;
+
+ if (SDL_MUSTLOCK(Surface)) then
+ SDL_LockSurface(Surface);
+
+ // use fast Win32-API functions to copy data instead of Bitmap.Canvas.Pixels
+ if (Surface.pitch mod 4 = 0) then
+ begin
+ // if the image is aligned (to a 4-byte boundary) -> copy all data at once
+ // Note: surfaces created with SDL (e.g. with SDL_ConvertSurface) are aligned
+ SetDIBits(0, Bitmap.Handle, 0, Bitmap.Height, Surface.pixels, BitmapInfo, DIB_RGB_COLORS);
+ end
+ else
+ begin
+ // wrong alignment -> copy each line separately.
+ // Note: for the last line unassigned memory (> last Surface.pixels element)
+ // will be copied to the padding area (last bytes of a row),
+ // but we do not care because the content of padding data is ignored anyhow.
+ for row := 0 to Surface.h do
+ begin
+ SetDIBits(0, Bitmap.Handle, row, 1, @PChar(Surface.pixels)[row * Surface.pitch],
+ BitmapInfo, DIB_RGB_COLORS);
+ end;
+ end;
+
+ if (SDL_MUSTLOCK(Surface)) then
+ SDL_UnlockSurface(Surface);
+
+ // assign Bitmap to JPEG and store the latter
+ Jpeg := TJPEGImage.Create;
+ Jpeg.Assign(Bitmap);
+ Bitmap.Free;
+ Jpeg.CompressionQuality := Quality;
+ try
+ // compress image (don't forget this line, otherwise it won't be compressed)
+ Jpeg.Compress();
+ Jpeg.SaveToFile(FileName);
+ except
+ Log.LogError('Could not save file: "' + FileName + '"', 'WriteJPGImage');
+ Exit;
+ end;
+ Jpeg.Free;
+ {$ELSE}
+ // based on example.pas in FPC's packages/base/pasjpeg directory
+
+ // only 24bit (RGB) data is supported, so convert to it
+ if (IsRGBSurface(Surface.format)) then
+ converted := false
+ else
+ begin
+ Surface := SDL_ConvertSurface(Surface, @PixelFmt_RGB, SDL_SWSURFACE);
+ converted := true;
+ end;
+
+ // allocate and initialize JPEG compression object
+ cinfo.err := jpeg_std_error(jerr);
+ // msg_level that will be displayed. (Nomssi)
+ //jerr.trace_level := 3;
+ // initialize the JPEG compression object
+ jpeg_create_compress(@cinfo);
+
+ // open file for writing
+ try
+ jpgFile := TFileStream.Create(FileName, fmCreate);
+ except
+ Log.LogError('Could not open file: "' + FileName + '"', 'WriteJPGImage');
+ Exit;
+ end;
+
+ // specify data destination
+ jpeg_stdio_dest(@cinfo, @jpgFile);
+
+ // set parameters for compression
+ cinfo.image_width := Surface.w;
+ cinfo.image_height := Surface.h;
+ cinfo.in_color_space := JCS_RGB;
+ cinfo.input_components := 3;
+ cinfo.data_precision := 8;
+
+ // set default compression parameters
+ jpeg_set_defaults(@cinfo);
+ jpeg_set_quality(@cinfo, quality, true);
+
+ // start compressor
+ jpeg_start_compress(@cinfo, true);
+
+ if (SDL_MUSTLOCK(Surface)) then
+ SDL_LockSurface(Surface);
+
+ while (cinfo.next_scanline < cinfo.image_height) do
+ begin
+ // Note: the byte-count of a row is pitch (which is not width*bitsPerPixel if the image is aligned)
+ rowPtr[0] := JSAMPROW(@PChar(Surface.pixels)[(Surface.h-cinfo.next_scanline-1) * Surface.pitch]);
+ jpeg_write_scanlines(@cinfo, JSAMPARRAY(@rowPtr), 1);
+ end;
+
+ if (SDL_MUSTLOCK(Surface)) then
+ SDL_UnlockSurface(Surface);
+
+ // finish compression
+ jpeg_finish_compress(@cinfo);
+ // close the output file
+ jpgFile.Free;
+
+ // release JPEG compression object
+ jpeg_destroy_compress(@cinfo);
+ {$ENDIF}
+
+ if (converted) then
+ SDL_FreeSurface(Surface);
+
+ Result := true;
+end;
+
+{$ENDIF}
+
+
+(*******************************************************
+ * Image loading
+ *******************************************************)
+
+
+(*
+ * Loads an image from the given file or resource
+ *)
+function LoadImage(const Identifier: string): PSDL_Surface;
+var
+ TexRWops: PSDL_RWops;
+ TexStream: TStream;
+ FileName: string;
+begin
+ Result := nil;
+ TexRWops := nil;
+
+ if Identifier = '' then
+ exit;
+
+ //Log.LogStatus( Identifier, 'LoadImage' );
+
+ FileName := Identifier;
+
+ if (FileExistsInsensitive(FileName)) then
+ begin
+ // load from file
+ //Log.LogStatus( 'Is File ( Loading : '+FileName+')', ' LoadImage' );
+ try
+ Result := IMG_Load(PChar(FileName));
+ //Log.LogStatus( ' '+inttostr( integer( Result ) ), ' LoadImage' );
+ except
+ Log.LogError('Could not load from file "'+FileName+'"', 'LoadImage');
+ Exit;
+ end;
+ end
+ else
+ begin
+ //Log.LogStatus( 'IS Resource, because file does not exist.('+Identifier+')', ' LoadImage' );
+
+ TexStream := GetResourceStream(Identifier, 'TEX');
+ if (not assigned(TexStream)) then
+ begin
+ Log.LogError( 'Invalid file or resource "'+ Identifier+'"', 'LoadImage');
+ Exit;
+ end;
+
+ TexRWops := RWopsFromStream(TexStream);
+ if (TexRWops = nil) then
+ begin
+ Log.LogError( 'Could not assign resource "'+Identifier+'"', 'LoadImage');
+ TexStream.Free();
+ Exit;
+ end;
+
+ //Log.LogStatus( 'resource Assigned....' , Identifier);
+ try
+ Result := IMG_Load_RW(TexRWops, 0);
+ except
+ Log.LogError( 'Could not read resource "'+Identifier+'"', 'LoadImage');
+ end;
+
+ SDL_FreeRW(TexRWops);
+ TexStream.Free();
+ end;
+end;
+
+
+(*******************************************************
+ * Image manipulation
+ *******************************************************)
+
+
+function PixelFormatEquals(fmt1, fmt2: PSDL_PixelFormat): boolean;
+begin
+ if (fmt1^.BitsPerPixel = fmt2^.BitsPerPixel) and
+ (fmt1^.BytesPerPixel = fmt2^.BytesPerPixel) and
+ (fmt1^.Rloss = fmt2^.Rloss) and (fmt1^.Gloss = fmt2^.Gloss) and
+ (fmt1^.Bloss = fmt2^.Bloss) and (fmt1^.Rmask = fmt2^.Rmask) and
+ (fmt1^.Gmask = fmt2^.Gmask) and (fmt1^.Bmask = fmt2^.Bmask) and
+ (fmt1^.Rshift = fmt2^.Rshift) and (fmt1^.Gshift = fmt2^.Gshift) and
+ (fmt1^.Bshift = fmt2^.Bshift)
+ then
+ Result := true
+ else
+ Result := false;
+end;
+
+procedure ScaleImage(var ImgSurface: PSDL_Surface; Width, Height: Cardinal);
+var
+ TempSurface: PSDL_Surface;
+begin
+ TempSurface := ImgSurface;
+ ImgSurface := SDL_ScaleSurfaceRect(TempSurface,
+ 0, 0, TempSurface^.W,TempSurface^.H,
+ Width, Height);
+ SDL_FreeSurface(TempSurface);
+end;
+
+procedure FitImage(var ImgSurface: PSDL_Surface; Width, Height: Cardinal);
+var
+ TempSurface: PSDL_Surface;
+ ImgFmt: PSDL_PixelFormat;
+begin
+ TempSurface := ImgSurface;
+
+ // create a new surface with given width and height
+ ImgFmt := TempSurface^.format;
+ ImgSurface := SDL_CreateRGBSurface(
+ SDL_SWSURFACE, Width, Height, ImgFmt^.BitsPerPixel,
+ ImgFmt^.RMask, ImgFmt^.GMask, ImgFmt^.BMask, ImgFmt^.AMask);
+
+ // copy image from temp- to new surface
+ SDL_SetAlpha(ImgSurface, 0, 255);
+ SDL_SetAlpha(TempSurface, 0, 255);
+ SDL_BlitSurface(TempSurface, nil, ImgSurface, nil);
+
+ SDL_FreeSurface(TempSurface);
+end;
+
+(*
+// Old slow floating point version of ColorizeTexture.
+// For an easier understanding of the faster fixed point version below.
+procedure ColorizeTexture(TexSurface: PSDL_Surface; Col: Cardinal);
+var
+ clr: array[0..2] of Double; // [0: R, 1: G, 2: B]
+ hsv: array[0..2] of Double; // [0: H(ue), 1: S(aturation), 2: V(alue)]
+ delta, f, p, q, t: Double;
+ max: Double;
+begin
+ clr[0] := PixelColors[0]/255;
+ clr[1] := PixelColors[1]/255;
+ clr[2] := PixelColors[2]/255;
+ max := maxvalue(clr);
+ delta := max - minvalue(clr);
+
+ hsv[0] := DestinationHue; // set H(ue)
+ hsv[2] := max; // set V(alue)
+ // calc S(aturation)
+ if (max = 0.0) then
+ hsv[1] := 0.0
+ else
+ hsv[1] := delta/max;
+
+ //ColorizePixel(PByteArray(Pixel), DestinationHue);
+ h_int := trunc(hsv[0]); // h_int = |_h_|
+ f := hsv[0]-h_int; // f = h-h_int
+ p := hsv[2]*(1.0-hsv[1]); // p = v*(1-s)
+ q := hsv[2]*(1.0-(hsv[1]*f)); // q = v*(1-s*f)
+ t := hsv[2]*(1.0-(hsv[1]*(1.0-f))); // t = v*(1-s*(1-f))
+ case h_int of
+ 0: begin clr[0] := hsv[2]; clr[1] := t; clr[2] := p; end; // (v,t,p)
+ 1: begin clr[0] := q; clr[1] := hsv[2]; clr[2] := p; end; // (q,v,p)
+ 2: begin clr[0] := p; clr[1] := hsv[2]; clr[2] := t; end; // (p,v,t)
+ 3: begin clr[0] := p; clr[1] := q; clr[2] := hsv[2]; end; // (p,q,v)
+ 4: begin clr[0] := t; clr[1] := p; clr[2] := hsv[2]; end; // (t,p,v)
+ 5: begin clr[0] := hsv[2]; clr[1] := p; clr[2] := q; end; // (v,p,q)
+ end;
+
+ // and store new rgb back into the image
+ PixelColors[0] := trunc(255*clr[0]);
+ PixelColors[1] := trunc(255*clr[1]);
+ PixelColors[2] := trunc(255*clr[2]);
+end;
+*)
+
+procedure ColorizeImage(ImgSurface: PSDL_Surface; NewColor: Cardinal);
+
+ //returns hue within range [0.0-6.0)
+ function col2hue(Color:Cardinal): double;
+ var
+ clr: array[0..2] of double;
+ hue, max, delta: double;
+ begin
+ clr[0] := ((Color and $ff0000) shr 16)/255; // R
+ clr[1] := ((Color and $ff00) shr 8)/255; // G
+ clr[2] := (Color and $ff) /255; // B
+ max := maxvalue(clr);
+ delta := max - minvalue(clr);
+ // calc hue
+ if (delta = 0.0) then hue := 0
+ else if (clr[0] = max) then hue := (clr[1]-clr[2])/delta
+ else if (clr[1] = max) then hue := 2.0+(clr[2]-clr[0])/delta
+ else if (clr[2] = max) then hue := 4.0+(clr[0]-clr[1])/delta;
+ if (hue < 0.0) then
+ hue := hue + 6.0;
+ Result := hue;
+ end;
+
+var
+ DestinationHue: Double;
+ PixelIndex: Cardinal;
+ Pixel: PByte;
+ PixelColors: PByteArray;
+ clr: array[0..2] of UInt32; // [0: R, 1: G, 2: B]
+ hsv: array[0..2] of UInt32; // [0: H(ue), 1: S(aturation), 2: V(alue)]
+ dhue: UInt32;
+ h_int: Cardinal;
+ delta, f, p, q, t: Longint;
+ max: Uint32;
+begin
+ DestinationHue := col2hue(NewColor);
+
+ dhue := Trunc(DestinationHue*1024);
+
+ Pixel := ImgSurface^.Pixels;
+
+ for PixelIndex := 0 to (ImgSurface^.W * ImgSurface^.H)-1 do
+ begin
+ PixelColors := PByteArray(Pixel);
+ // inlined colorize per pixel
+
+ // uses fixed point math
+ // get color values
+ clr[0] := PixelColors[0] shl 10;
+ clr[1] := PixelColors[1] shl 10;
+ clr[2] := PixelColors[2] shl 10;
+ //calculate luminance and saturation from rgb
+
+ max := clr[0];
+ if clr[1] > max then max := clr[1];
+ if clr[2] > max then max := clr[2];
+ delta := clr[0];
+ if clr[1] < delta then delta := clr[1];
+ if clr[2] < delta then delta := clr[2];
+ delta := max-delta;
+ hsv[0] := dhue; // shl 8
+ hsv[2] := max; // shl 8
+ if (max = 0) then
+ hsv[1] := 0
+ else
+ hsv[1] := (delta shl 10) div max; // shl 8
+ h_int := hsv[0] and $fffffC00;
+ f := hsv[0]-h_int; //shl 10
+ p := (hsv[2]*(1024-hsv[1])) shr 10;
+ q := (hsv[2]*(1024-(hsv[1]*f) shr 10)) shr 10;
+ t := (hsv[2]*(1024-(hsv[1]*(1024-f)) shr 10)) shr 10;
+ h_int := h_int shr 10;
+ case h_int of
+ 0: begin clr[0] := hsv[2]; clr[1] := t; clr[2] := p; end; // (v,t,p)
+ 1: begin clr[0] := q; clr[1] := hsv[2]; clr[2] := p; end; // (q,v,p)
+ 2: begin clr[0] := p; clr[1] := hsv[2]; clr[2] := t; end; // (p,v,t)
+ 3: begin clr[0] := p; clr[1] := q; clr[2] := hsv[2]; end; // (p,q,v)
+ 4: begin clr[0] := t; clr[1] := p; clr[2] := hsv[2]; end; // (t,p,v)
+ 5: begin clr[0] := hsv[2]; clr[1] := p; clr[2] := q; end; // (v,p,q)
+ end;
+
+ PixelColors[0] := clr[0] shr 10;
+ PixelColors[1] := clr[1] shr 10;
+ PixelColors[2] := clr[2] shr 10;
+
+ Inc(Pixel, ImgSurface^.format.BytesPerPixel);
+ end;
+end;
+
+end.
diff --git a/src/base/UIni.pas b/src/base/UIni.pas
new file mode 100644
index 00000000..b286c917
--- /dev/null
+++ b/src/base/UIni.pas
@@ -0,0 +1,928 @@
+unit UIni;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+uses
+ Classes,
+ IniFiles,
+ ULog,
+ SysUtils;
+
+type
+ // TInputDeviceConfig stores the configuration for an input device.
+ // Configurations will be stored in the InputDeviceConfig array.
+ // Note that not all devices listed in InputDeviceConfig are active devices.
+ // Some might be unplugged and hence unavailable.
+ // Available devices are held in TAudioInputProcessor.DeviceList. Each
+ // TAudioInputDevice listed there has a CfgIndex field which is the index to
+ // its configuration in the InputDeviceConfig array.
+ // Name:
+ // the name of the input device
+ // Input:
+ // the index of the input source to use for recording
+ // ChannelToPlayerMap:
+ // mapping of recording channels to players, e.g. ChannelToPlayerMap[0] = 2
+ // maps the channel 0 (left) to player 2. A player index of 0 means that
+ // the channel is not assigned to a player.
+ PInputDeviceConfig = ^TInputDeviceConfig;
+ TInputDeviceConfig = record
+ Name: string;
+ Input: integer;
+ ChannelToPlayerMap: array of integer;
+ end;
+
+type
+
+//Options
+
+ TVisualizerOption = (voOff, voWhenNoVideo, voOn);
+ TBackgroundMusicOption = (bmoOff, bmoOn);
+ TIni = class
+ private
+ function RemoveFileExt(FullName: string): string;
+ function ExtractKeyIndex(const Key, Prefix, Suffix: string): integer;
+ function GetMaxKeyIndex(Keys: TStringList; const Prefix, Suffix: string): integer;
+ function GetArrayIndex(const SearchArray: array of string; Value: string; CaseInsensitiv: Boolean = False): integer;
+ function ReadArrayIndex(const SearchArray: array of string; IniFile: TCustomIniFile;
+ IniSection: string; IniProperty: string; Default: integer): integer;
+
+ procedure LoadInputDeviceCfg(IniFile: TMemIniFile);
+ procedure SaveInputDeviceCfg(IniFile: TIniFile);
+ procedure LoadThemes(IniFile: TCustomIniFile);
+ procedure LoadPaths(IniFile: TCustomIniFile);
+ procedure LoadScreenModes(IniFile: TCustomIniFile);
+
+ public
+ Name: array[0..11] of string;
+
+ // Templates for Names Mod
+ NameTeam: array[0..2] of string;
+ NameTemplate: array[0..11] of string;
+
+ //Filename of the opened iniFile
+ Filename: string;
+
+ // Game
+ Players: integer;
+ Difficulty: integer;
+ Language: integer;
+ Tabs: integer;
+ Tabs_at_startup:integer; //Tabs at Startup fix
+ Sorting: integer;
+ Debug: integer;
+
+ // Graphics
+ Screens: integer;
+ Resolution: integer;
+ Depth: integer;
+ VisualizerOption:integer;
+ FullScreen: integer;
+ TextureSize: integer;
+ SingWindow: integer;
+ Oscilloscope: integer;
+ Spectrum: integer;
+ Spectrograph: integer;
+ MovieSize: integer;
+
+ // Sound
+ MicBoost: integer;
+ ClickAssist: integer;
+ BeatClick: integer;
+ SavePlayback: integer;
+ ThresholdIndex: integer;
+ AudioOutputBufferSizeIndex:integer;
+ VoicePassthrough:integer;
+
+ //Song Preview
+ PreviewVolume: integer;
+ PreviewFading: integer;
+
+ // Lyrics
+ LyricsFont: integer;
+ LyricsEffect: integer;
+ Solmization: integer;
+ NoteLines: integer;
+
+ // Themes
+ Theme: integer;
+ SkinNo: integer;
+ Color: integer;
+ BackgroundMusicOption:integer;
+
+ // Record
+ InputDeviceConfig: array of TInputDeviceConfig;
+
+ // Advanced
+ LoadAnimation: integer;
+ EffectSing: integer;
+ ScreenFade: integer;
+ AskBeforeDel: integer;
+ OnSongClick: integer;
+ LineBonus: integer;
+ PartyPopup: integer;
+
+ // Controller
+ Joypad: integer;
+
+ procedure Load();
+ procedure Save();
+ procedure SaveNames;
+ procedure SaveLevel;
+ end;
+
+var
+ Ini: TIni;
+ IResolution: array of string;
+ ILanguage: array of string;
+ ITheme: array of string;
+ ISkin: array of string;
+
+
+
+const
+ IPlayers: array[0..4] of string = ('1', '2', '3', '4', '6');
+ IPlayersVals: array[0..4] of integer = ( 1 , 2 , 3 , 4 , 6 );
+
+ IDifficulty: array[0..2] of string = ('Easy', 'Medium', 'Hard');
+ ITabs: array[0..1] of string = ('Off', 'On');
+
+ ISorting: array[0..7] of string = ('Edition', 'Genre', 'Language', 'Folder', 'Title', 'Artist', 'Title2', 'Artist2');
+ sEdition = 0;
+ sGenre = 1;
+ sLanguage = 2;
+ sFolder = 3;
+ sTitle = 4;
+ sArtist = 5;
+ sTitle2 = 6;
+ sArtist2 = 7;
+
+ IDebug: array[0..1] of string = ('Off', 'On');
+
+ IScreens: array[0..1] of string = ('1', '2');
+ IFullScreen: array[0..1] of string = ('Off', 'On');
+ IDepth: array[0..1] of string = ('16 bit', '32 bit');
+ IVisualizer: array[0..2] of string = ('Off', 'WhenNoVideo','On');
+
+ IBackgroundMusic: array[0..1] of string = ('Off', 'On');
+
+
+ ITextureSize: array[0..2] of string = ('128', '256', '512');
+ ITextureSizeVals: array[0..2] of integer = ( 128, 256, 512);
+
+ ISingWindow: array[0..1] of string = ('Small', 'Big');
+
+ //SingBar Mod
+ IOscilloscope: array[0..2] of string = ('Off', 'Osci', 'Bar');
+//IOscilloscope: array[0..1] of string = ('Off', 'On');
+
+ ISpectrum: array[0..1] of string = ('Off', 'On');
+ ISpectrograph: array[0..1] of string = ('Off', 'On');
+ IMovieSize: array[0..2] of string = ('Half', 'Full [Vid]', 'Full [BG+Vid]');
+
+ IClickAssist: array[0..1] of string = ('Off', 'On');
+ IBeatClick: array[0..1] of string = ('Off', 'On');
+ ISavePlayback: array[0..1] of string = ('Off', 'On');
+
+ IThreshold: array[0..3] of string = ('5%', '10%', '15%', '20%');
+ IThresholdVals: array[0..3] of single = (0.05, 0.10, 0.15, 0.20);
+
+ IVoicePassthrough: array[0..1] of string = ('Off', 'On');
+
+ IAudioOutputBufferSize: array[0..9] of string = ('Auto', '256', '512', '1024', '2048', '4096', '8192', '16384', '32768', '65536');
+ IAudioOutputBufferSizeVals: array[0..9] of integer = ( 0, 256, 512 , 1024 , 2048 , 4096 , 8192 , 16384 , 32768 , 65536 );
+
+ IAudioInputBufferSize: array[0..9] of string = ('Auto', '256', '512', '1024', '2048', '4096', '8192', '16384', '32768', '65536');
+ IAudioInputBufferSizeVals: array[0..9] of integer = ( 0, 256, 512 , 1024 , 2048 , 4096 , 8192 , 16384 , 32768 , 65536 );
+
+ //Song Preview
+ IPreviewVolume: array[0..10] of string = ('Off', '10%', '20%', '30%', '40%', '50%', '60%', '70%', '80%', '90%', '100%');
+ IPreviewVolumeVals: array[0..10] of single = ( 0, 0.10, 0.20, 0.30, 0.40, 0.50, 0.60, 0.70, 0.80, 0.90, 1.00 );
+
+ IPreviewFading: array[0..5] of string = ('Off', '1 Sec', '2 Secs', '3 Secs', '4 Secs', '5 Secs');
+ IPreviewFadingVals: array[0..5] of integer = ( 0, 1, 2, 3, 4, 5 );
+
+
+ ILyricsFont: array[0..2] of string = ('Plain', 'OLine1', 'OLine2');
+ ILyricsEffect: array[0..4] of string = ('Simple', 'Zoom', 'Slide', 'Ball', 'Shift');
+ ISolmization: array[0..3] of string = ('Off', 'Euro', 'Jap', 'American');
+ INoteLines: array[0..1] of string = ('Off', 'On');
+
+ IColor: array[0..8] of string = ('Blue', 'Green', 'Pink', 'Red', 'Violet', 'Orange', 'Yellow', 'Brown', 'Black');
+
+ // Advanced
+ ILoadAnimation: array[0..1] of string = ('Off', 'On');
+ IEffectSing: array[0..1] of string = ('Off', 'On');
+ IScreenFade: array[0..1] of string =('Off', 'On');
+ IAskbeforeDel: array[0..1] of string = ('Off', 'On');
+ IOnSongClick: array[0..2] of string = ('Sing', 'Select Players', 'Open Menu');
+ ILineBonus: array[0..2] of string = ('Off', 'At Score', 'At Notes');
+ IPartyPopup: array[0..1] of string = ('Off', 'On');
+
+ IJoypad: array[0..1] of string = ('Off', 'On');
+
+ // Recording options
+ IChannelPlayer: array[0..6] of string = ('Off', '1', '2', '3', '4', '5', '6');
+ IMicBoost: array[0..3] of string = ('Off', '+6dB', '+12dB', '+18dB');
+
+implementation
+
+uses
+ StrUtils,
+ UMain,
+ SDL,
+ ULanguage,
+ UPlatform,
+ USkins,
+ URecord,
+ UCommandLine;
+
+(**
+ * Returns the filename without its fileextension
+ *)
+function TIni.RemoveFileExt(FullName: string): string;
+begin
+ Result := ChangeFileExt(FullName, '');
+end;
+
+(**
+ * Extracts an index of a key that is surrounded by a Prefix/Suffix pair.
+ * Example: ExtractKeyIndex('MyKey[1]', '[', ']') will return 1.
+ *)
+function TIni.ExtractKeyIndex(const Key, Prefix, Suffix: string): integer;
+var
+ Value: string;
+ Start: integer;
+begin
+ Result := -1;
+
+ if Pos(Prefix, Key) > -1 then
+ begin
+ Start := Pos(Prefix, Key) + Length(Prefix);
+
+ // copy all between prefix and suffix
+ Value := Copy(Key, Start, Pos(Suffix, Key)-1 - Start);
+ Result := StrToIntDef(Value, -1);
+ end;
+end;
+
+(**
+ * Finds the maximum key-index in a key-list.
+ * The indexes of the list are surrounded by Prefix/Suffix,
+ * e.g. MyKey[1] (Prefix='[', Suffix=']')
+ *)
+function TIni.GetMaxKeyIndex(Keys: TStringList; const Prefix, Suffix: string): integer;
+var
+ i: integer;
+ KeyIndex: integer;
+begin
+ Result := -1;
+
+ for i := 0 to Keys.Count-1 do
+ begin
+ KeyIndex := ExtractKeyIndex(Keys[i], Prefix, Suffix);
+ if (KeyIndex > Result) then
+ Result := KeyIndex;
+ end;
+end;
+
+(**
+ * Returns the index of Value in SearchArray
+ * or -1 if Value is not in SearchArray.
+ *)
+function TIni.GetArrayIndex(const SearchArray: array of string; Value: string;
+ CaseInsensitiv: Boolean = False): integer;
+var
+ i: integer;
+begin
+ Result := -1;
+
+ for i := 0 to High(SearchArray) do
+ begin
+ if (SearchArray[i] = Value) or
+ (CaseInsensitiv and (UpperCase(SearchArray[i]) = UpperCase(Value))) then
+ begin
+ Result := i;
+ Break;
+ end;
+ end;
+end;
+
+(**
+ * Reads the property IniSeaction:IniProperty from IniFile and
+ * finds its corresponding index in SearchArray.
+ * If SearchArray does not contain the property value, the default value is
+ * returned.
+ *)
+function TIni.ReadArrayIndex(const SearchArray: array of string; IniFile: TCustomIniFile;
+ IniSection: string; IniProperty: string; Default: integer): integer;
+var
+ StrValue: string;
+begin
+ StrValue := IniFile.ReadString(IniSection, IniProperty, SearchArray[Default]);
+ Result := GetArrayIndex(SearchArray, StrValue);
+ if (Result = -1) then
+ begin
+ Result := Default;
+ end;
+end;
+
+
+procedure TIni.LoadInputDeviceCfg(IniFile: TMemIniFile);
+var
+ DeviceCfg: PInputDeviceConfig;
+ DeviceIndex: integer;
+ ChannelCount: integer;
+ ChannelIndex: integer;
+ RecordKeys: TStringList;
+ i: integer;
+begin
+ RecordKeys := TStringList.Create();
+
+ // read all record-keys for filtering
+ IniFile.ReadSection('Record', RecordKeys);
+
+ SetLength(InputDeviceConfig, 0);
+
+ for i := 0 to RecordKeys.Count-1 do
+ begin
+ // find next device-name
+ DeviceIndex := ExtractKeyIndex(RecordKeys[i], 'DeviceName[', ']');
+ if (DeviceIndex >= 0) then
+ begin
+ if not IniFile.ValueExists('Record', Format('DeviceName[%d]', [DeviceIndex])) then
+ break;
+
+ // resize list
+ SetLength(InputDeviceConfig, Length(InputDeviceConfig)+1);
+
+ // read an input device's config.
+ // Note: All devices are appended to the list whether they exist or not.
+ // Otherwise an external device's config will be lost if it is not
+ // connected (e.g. singstar mics or USB-Audio devices).
+ DeviceCfg := @InputDeviceConfig[High(InputDeviceConfig)];
+ DeviceCfg.Name := IniFile.ReadString('Record', Format('DeviceName[%d]', [DeviceIndex]), '');
+ DeviceCfg.Input := IniFile.ReadInteger('Record', Format('Input[%d]', [DeviceIndex]), 0);
+
+ // find the largest channel-number of the current device in the ini-file
+ ChannelCount := GetMaxKeyIndex(RecordKeys, 'Channel', Format('[%d]', [DeviceIndex]));
+ if (ChannelCount < 0) then
+ ChannelCount := 0;
+
+ SetLength(DeviceCfg.ChannelToPlayerMap, ChannelCount);
+
+ // read channel-to-player mapping for every channel of the current device
+ // or set non-configured channels to no player (=0).
+ for ChannelIndex := 0 to High(DeviceCfg.ChannelToPlayerMap) do
+ begin
+ DeviceCfg.ChannelToPlayerMap[ChannelIndex] :=
+ IniFile.ReadInteger('Record', Format('Channel%d[%d]', [ChannelIndex+1, DeviceIndex]), 0);
+ end;
+ end;
+ end;
+
+ RecordKeys.Free();
+
+ // MicBoost
+ //MicBoost := GetArrayIndex(IMicBoost, IniFile.ReadString('Record', 'MicBoost', 'Off'));
+ // Threshold
+ // ThresholdIndex := GetArrayIndex(IThreshold, IniFile.ReadString('Record', 'Threshold', IThreshold[1]));
+end;
+
+procedure TIni.SaveInputDeviceCfg(IniFile: TIniFile);
+var
+ DeviceIndex: integer;
+ ChannelIndex: integer;
+begin
+ for DeviceIndex := 0 to High(InputDeviceConfig) do
+ begin
+ // DeviceName and DeviceInput
+ IniFile.WriteString('Record', Format('DeviceName[%d]', [DeviceIndex+1]),
+ InputDeviceConfig[DeviceIndex].Name);
+ IniFile.WriteInteger('Record', Format('Input[%d]', [DeviceIndex+1]),
+ InputDeviceConfig[DeviceIndex].Input);
+
+ // Channel-to-Player Mapping
+ for ChannelIndex := 0 to High(InputDeviceConfig[DeviceIndex].ChannelToPlayerMap) do
+ begin
+ IniFile.WriteInteger('Record',
+ Format('Channel%d[%d]', [ChannelIndex+1, DeviceIndex+1]),
+ InputDeviceConfig[DeviceIndex].ChannelToPlayerMap[ChannelIndex]);
+ end;
+ end;
+
+ // MicBoost
+ //IniFile.WriteString('Record', 'MicBoost', IMicBoost[MicBoost]);
+ // Threshold
+ //IniFile.WriteString('Record', 'Threshold', IThreshold[ThresholdIndex]);
+end;
+
+procedure TIni.LoadPaths(IniFile: TCustomIniFile);
+var
+ PathStrings: TStringList;
+ I: integer;
+begin
+ PathStrings := TStringList.Create;
+ IniFile.ReadSection('Directories', PathStrings);
+
+ // Load song-paths
+ for I := 0 to PathStrings.Count-1 do
+ begin
+ if (AnsiStartsText('SongDir', PathStrings[I])) then
+ begin
+ AddSongPath(IniFile.ReadString('Directories', PathStrings[I], ''));
+ end;
+ end;
+
+ PathStrings.Free;
+end;
+
+procedure TIni.LoadThemes(IniFile: TCustomIniFile);
+var
+ SearchResult: TSearchRec;
+ ThemeIni: TMemIniFile;
+ ThemeName: string;
+ I: integer;
+begin
+ // Theme
+ SetLength(ITheme, 0);
+ Log.LogStatus('Searching for Theme : ' + ThemePath + '*.ini', 'Theme');
+
+ FindFirst(ThemePath + '*.ini',faAnyFile, SearchResult);
+ Repeat
+ Log.LogStatus('Found Theme: ' + SearchResult.Name, 'Theme');
+
+ //Read Themename from Theme
+ ThemeIni := TMemIniFile.Create(SearchResult.Name);
+ ThemeName := UpperCase(ThemeIni.ReadString('Theme','Name', RemoveFileExt(SearchResult.Name)));
+ ThemeIni.Free;
+
+ //Search for Skins for this Theme
+ for I := Low(Skin.Skin) to High(Skin.Skin) do
+ begin
+ if UpperCase(Skin.Skin[I].Theme) = ThemeName then
+ begin
+ SetLength(ITheme, Length(ITheme)+1);
+ ITheme[High(ITheme)] := RemoveFileExt(SearchResult.Name);
+ break;
+ end;
+ end;
+ until FindNext(SearchResult) <> 0;
+ FindClose(SearchResult);
+
+ // No Theme Found
+ if (Length(ITheme) = 0) then
+ begin
+ Log.CriticalError('Could not find any valid Themes.');
+ end;
+
+ Theme := GetArrayIndex(ITheme, IniFile.ReadString('Themes', 'Theme', 'DELUXE'), true);
+ if (Theme = -1) then
+ Theme := 0;
+
+ // Skin
+ Skin.onThemeChange;
+
+ SkinNo := GetArrayIndex(ISkin, IniFile.ReadString('Themes', 'Skin', ISkin[0]));
+end;
+
+procedure TIni.LoadScreenModes(IniFile: TCustomIniFile);
+
+ // swap two strings
+ procedure swap(var s1, s2: string);
+ var
+ s3: string;
+ begin
+ s3 := s1;
+ s1 := s2;
+ s2 := s3;
+ end;
+
+var
+ Modes: PPSDL_Rect;
+ I: integer;
+begin
+ // Screens
+ Screens := GetArrayIndex(IScreens, IniFile.ReadString('Graphics', 'Screens', IScreens[0]));
+
+ // FullScreen
+ FullScreen := GetArrayIndex(IFullScreen, IniFile.ReadString('Graphics', 'FullScreen', 'On'));
+
+ // Resolution
+ SetLength(IResolution, 0);
+
+ // Check if there are any modes available
+ // TODO: we should seperate windowed and fullscreen modes. Otherwise it is not
+ // possible to select a reasonable fullscreen mode when in windowed mode
+ if IFullScreen[FullScreen] = 'On' then
+ Modes := SDL_ListModes(nil, SDL_OPENGL or SDL_FULLSCREEN or SDL_RESIZABLE)
+ else
+ Modes := SDL_ListModes(nil, SDL_OPENGL or SDL_RESIZABLE) ;
+
+ if (Modes = nil) then
+ begin
+ Log.LogStatus( 'No resolutions Found' , 'Video');
+ end
+ else if (Modes = PPSDL_Rect(-1)) then
+ begin
+ // Fallback to some standard resolutions
+ SetLength(IResolution, 10);
+ IResolution[0] := '640x480';
+ IResolution[1] := '800x600';
+ IResolution[2] := '1024x768';
+ IResolution[3] := '1152x864';
+ IResolution[4] := '1280x800';
+ IResolution[5] := '1280x960';
+ IResolution[6] := '1400x1050';
+ IResolution[7] := '1440x900';
+ IResolution[8] := '1600x1200';
+ IResolution[9] := '1680x1050';
+
+ Resolution := GetArrayIndex(IResolution, IniFile.ReadString('Graphics', 'Resolution', '800x600'));
+ if Resolution = -1 then
+ begin
+ SetLength(IResolution, Length(IResolution) + 1);
+ IResolution[High(IResolution)] := IniFile.ReadString('Graphics', 'Resolution', '800x600');
+ Resolution := High(IResolution);
+ end;
+ end
+ else
+ begin
+ while assigned( Modes^ ) do //this should solve the biggest wine problem | THANKS Linnex (11.11.07)
+ begin
+ Log.LogStatus( 'Found Video Mode : ' + IntToStr(Modes^.w) + 'x' + IntToStr(Modes^.h) , 'Video');
+ SetLength(IResolution, Length(IResolution) + 1);
+ IResolution[High(IResolution)] := IntToStr(Modes^.w) + 'x' + IntToStr(Modes^.h);
+ Inc(Modes);
+ end;
+
+ // reverse order
+ for I := 0 to (Length(IResolution) div 2) - 1 do
+ begin
+ swap(IResolution[I], IResolution[High(IResolution)-I]);
+ end;
+ Resolution := GetArrayIndex(IResolution, IniFile.ReadString('Graphics', 'Resolution', '800x600'));
+
+ if Resolution = -1 then
+ begin
+ Resolution := GetArrayIndex(IResolution, '800x600');
+ if Resolution = -1 then
+ Resolution := 0;
+ end;
+ end;
+
+ // if no modes were set, then failback to 800x600
+ // as per http://sourceforge.net/forum/message.php?msg_id=4544965
+ // THANKS : linnex at users.sourceforge.net
+ if Length(IResolution) < 1 then
+ begin
+ Log.LogStatus( 'Found Video Mode : NONE !!! ( Defaulted to 800 x 600 )', 'Video');
+ SetLength(IResolution, 1);
+ IResolution[0] := '800x600';
+ Resolution := 0;
+ Log.LogStatus('SDL_ListModes Defaulted Res To : ' + IResolution[0] , 'Graphics - Resolutions');
+
+ // Default to fullscreen OFF, in this case !
+ FullScreen := 0;
+ end;
+
+ // Depth
+ Depth := GetArrayIndex(IDepth, IniFile.ReadString('Graphics', 'Depth', '32 bit'));
+end;
+
+procedure TIni.Load();
+var
+ IniFile: TMemIniFile;
+ I: integer;
+begin
+ GamePath := Platform.GetGameUserPath;
+
+ Log.LogStatus( 'GamePath : ' +GamePath , '' );
+
+ if (Params.ConfigFile <> '') then
+ try
+ FileName := Params.ConfigFile;
+ except
+ FileName := GamePath + 'config.ini';
+ end
+ else
+ FileName := GamePath + 'config.ini';
+
+ Log.LogStatus( 'Using config : ' + FileName , 'Ini');
+ IniFile := TMemIniFile.Create( FileName );
+
+ // Name
+ for I := 0 to 11 do
+ Name[I] := IniFile.ReadString('Name', 'P'+IntToStr(I+1), 'Player'+IntToStr(I+1));
+
+ // Templates for Names Mod
+ for I := 0 to 2 do
+ NameTeam[I] := IniFile.ReadString('NameTeam', 'T'+IntToStr(I+1), 'Team'+IntToStr(I+1));
+ for I := 0 to 11 do
+ NameTemplate[I] := IniFile.ReadString('NameTemplate', 'Name'+IntToStr(I+1), 'Template'+IntToStr(I+1));
+
+ // Players
+ Players := GetArrayIndex(IPlayers, IniFile.ReadString('Game', 'Players', IPlayers[0]));
+
+ // Difficulty
+ Difficulty := GetArrayIndex(IDifficulty, IniFile.ReadString('Game', 'Difficulty', 'Easy'));
+
+ // Language
+ Language := GetArrayIndex(ILanguage, IniFile.ReadString('Game', 'Language', 'English'));
+ //Language.ChangeLanguage(ILanguage[Language]);
+
+ // Tabs
+ Tabs := GetArrayIndex(ITabs, IniFile.ReadString('Game', 'Tabs', ITabs[0]));
+ Tabs_at_startup := Tabs; //Tabs at Startup fix
+
+ // Song Sorting
+ Sorting := GetArrayIndex(ISorting, IniFile.ReadString('Game', 'Sorting', ISorting[0]));
+
+ // Debug
+ Debug := GetArrayIndex(IDebug, IniFile.ReadString('Game', 'Debug', IDebug[0]));
+
+ LoadScreenModes(IniFile);
+
+ // TextureSize
+ TextureSize := GetArrayIndex(ITextureSize, IniFile.ReadString('Graphics', 'TextureSize', ITextureSize[1]));
+
+ // SingWindow
+ SingWindow := GetArrayIndex(ISingWindow, IniFile.ReadString('Graphics', 'SingWindow', 'Big'));
+
+ // Oscilloscope
+ Oscilloscope := GetArrayIndex(IOscilloscope, IniFile.ReadString('Graphics', 'Oscilloscope', 'Bar'));
+
+ // Spectrum
+ Spectrum := GetArrayIndex(ISpectrum, IniFile.ReadString('Graphics', 'Spectrum', 'Off'));
+
+ // Spectrograph
+ Spectrograph := GetArrayIndex(ISpectrograph, IniFile.ReadString('Graphics', 'Spectrograph', 'Off'));
+
+ // MovieSize
+ MovieSize := GetArrayIndex(IMovieSize, IniFile.ReadString('Graphics', 'MovieSize', IMovieSize[2]));
+
+ // ClickAssist
+ ClickAssist := GetArrayIndex(IClickAssist, IniFile.ReadString('Sound', 'ClickAssist', 'Off'));
+
+ // BeatClick
+ BeatClick := GetArrayIndex(IBeatClick, IniFile.ReadString('Sound', 'BeatClick', IBeatClick[0]));
+
+ // SavePlayback
+ SavePlayback := GetArrayIndex(ISavePlayback, IniFile.ReadString('Sound', 'SavePlayback', ISavePlayback[0]));
+
+ // AudioOutputBufferSize
+ AudioOutputBufferSizeIndex := ReadArrayIndex(IAudioOutputBufferSize, IniFile, 'Sound', 'AudioOutputBufferSize', 0);
+
+ //Preview Volume
+ PreviewVolume := GetArrayIndex(IPreviewVolume, IniFile.ReadString('Sound', 'PreviewVolume', IPreviewVolume[7]));
+
+ //Preview Fading
+ PreviewFading := GetArrayIndex(IPreviewFading, IniFile.ReadString('Sound', 'PreviewFading', IPreviewFading[1]));
+
+ //AudioRepeat aka VoicePassthrough
+ VoicePassthrough := GetArrayIndex(IVoicePassthrough, IniFile.ReadString('Sound', 'VoicePassthrough', IVoicePassthrough[0]));
+
+ // Lyrics Font
+ LyricsFont := GetArrayIndex(ILyricsFont, IniFile.ReadString('Lyrics', 'LyricsFont', ILyricsFont[1]));
+
+ // Lyrics Effect
+ LyricsEffect := GetArrayIndex(ILyricsEffect, IniFile.ReadString('Lyrics', 'LyricsEffect', ILyricsEffect[1]));
+
+ // Solmization
+ Solmization := GetArrayIndex(ISolmization, IniFile.ReadString('Lyrics', 'Solmization', ISolmization[0]));
+
+ // NoteLines
+ NoteLines := GetArrayIndex(INoteLines, IniFile.ReadString('Lyrics', 'NoteLines', INoteLines[1]));
+
+ LoadThemes(IniFile);
+
+ // Color
+ Color := GetArrayIndex(IColor, IniFile.ReadString('Themes', 'Color', IColor[0]));
+
+ LoadInputDeviceCfg(IniFile);
+
+ // LoadAnimation
+ LoadAnimation := GetArrayIndex(ILoadAnimation, IniFile.ReadString('Advanced', 'LoadAnimation', 'On'));
+
+ // ScreenFade
+ ScreenFade := GetArrayIndex(IScreenFade, IniFile.ReadString('Advanced', 'ScreenFade', 'On'));
+
+ // Visualizations
+ // <mog> this could be of use later..
+ // VisualizerOption :=
+ // TVisualizerOption(GetEnumValue(TypeInfo(TVisualizerOption),
+ // IniFile.ReadString('Graphics', 'Visualization', 'Off')));
+ // || VisualizerOption := TVisualizerOption(GetArrayIndex(IVisualizer, IniFile.ReadString('Graphics', 'Visualization', 'Off')));
+ VisualizerOption := GetArrayIndex(IVisualizer, IniFile.ReadString('Graphics', 'Visualization', 'Off'));
+
+{**
+ * Background music
+ *}
+ BackgroundMusicOption := GetArrayIndex(IBackgroundMusic, IniFile.ReadString('Sound', 'BackgroundMusic', 'Off'));
+
+ // EffectSing
+ EffectSing := GetArrayIndex(IEffectSing, IniFile.ReadString('Advanced', 'EffectSing', 'On'));
+
+ // AskbeforeDel
+ AskBeforeDel := GetArrayIndex(IAskbeforeDel, IniFile.ReadString('Advanced', 'AskbeforeDel', 'On'));
+
+ // OnSongClick
+ OnSongClick := GetArrayIndex(IOnSongClick, IniFile.ReadString('Advanced', 'OnSongClick', 'Sing'));
+
+ // Linebonus
+ LineBonus := GetArrayIndex(ILineBonus, IniFile.ReadString('Advanced', 'LineBonus', 'At Score'));
+
+ // PartyPopup
+ PartyPopup := GetArrayIndex(IPartyPopup, IniFile.ReadString('Advanced', 'PartyPopup', 'On'));
+
+ // Joypad
+ Joypad := GetArrayIndex(IJoypad, IniFile.ReadString('Controller', 'Joypad', IJoypad[0]));
+
+ LoadPaths(IniFile);
+
+ IniFile.Free;
+end;
+
+procedure TIni.Save;
+var
+ IniFile: TIniFile;
+begin
+ if (FileExists(Filename) and FileIsReadOnly(Filename)) then
+ begin
+ Log.LogError('Config-file is read-only', 'TIni.Save');
+ Exit;
+ end;
+
+ IniFile := TIniFile.Create(Filename);
+
+ // Players
+ IniFile.WriteString('Game', 'Players', IPlayers[Players]);
+
+ // Difficulty
+ IniFile.WriteString('Game', 'Difficulty', IDifficulty[Difficulty]);
+
+ // Language
+ IniFile.WriteString('Game', 'Language', ILanguage[Language]);
+
+ // Tabs
+ IniFile.WriteString('Game', 'Tabs', ITabs[Tabs]);
+
+ // Sorting
+ IniFile.WriteString('Game', 'Sorting', ISorting[Sorting]);
+
+ // Debug
+ IniFile.WriteString('Game', 'Debug', IDebug[Debug]);
+
+ // Screens
+ IniFile.WriteString('Graphics', 'Screens', IScreens[Screens]);
+
+ // FullScreen
+ IniFile.WriteString('Graphics', 'FullScreen', IFullScreen[FullScreen]);
+
+ // Visualization
+ IniFile.WriteString('Graphics', 'Visualization', IVisualizer[VisualizerOption]);
+
+ // Resolution
+ IniFile.WriteString('Graphics', 'Resolution', IResolution[Resolution]);
+
+ // Depth
+ IniFile.WriteString('Graphics', 'Depth', IDepth[Depth]);
+
+ // TextureSize
+ IniFile.WriteString('Graphics', 'TextureSize', ITextureSize[TextureSize]);
+
+ // Sing Window
+ IniFile.WriteString('Graphics', 'SingWindow', ISingWindow[SingWindow]);
+
+ // Oscilloscope
+ IniFile.WriteString('Graphics', 'Oscilloscope', IOscilloscope[Oscilloscope]);
+
+ // Spectrum
+ IniFile.WriteString('Graphics', 'Spectrum', ISpectrum[Spectrum]);
+
+ // Spectrograph
+ IniFile.WriteString('Graphics', 'Spectrograph', ISpectrograph[Spectrograph]);
+
+ // Movie Size
+ IniFile.WriteString('Graphics', 'MovieSize', IMovieSize[MovieSize]);
+
+ // ClickAssist
+ IniFile.WriteString('Sound', 'ClickAssist', IClickAssist[ClickAssist]);
+
+ // BeatClick
+ IniFile.WriteString('Sound', 'BeatClick', IBeatClick[BeatClick]);
+
+ // AudioOutputBufferSize
+ IniFile.WriteString('Sound', 'AudioOutputBufferSize', IAudioOutputBufferSize[AudioOutputBufferSizeIndex]);
+
+ // Background music
+ IniFile.WriteString('Sound', 'BackgroundMusic', IBackgroundMusic[BackgroundMusicOption]);
+
+ // Song Preview
+ IniFile.WriteString('Sound', 'PreviewVolume', IPreviewVolume[PreviewVolume]);
+
+ // PreviewFading
+ IniFile.WriteString('Sound', 'PreviewFading', IPreviewFading[PreviewFading]);
+
+ // SavePlayback
+ IniFile.WriteString('Sound', 'SavePlayback', ISavePlayback[SavePlayback]);
+
+ // VoicePasstrough
+ IniFile.WriteString('Sound', 'VoicePassthrough', IVoicePassthrough[VoicePassthrough]);
+
+ // Lyrics Font
+ IniFile.WriteString('Lyrics', 'LyricsFont', ILyricsFont[LyricsFont]);
+
+ // Lyrics Effect
+ IniFile.WriteString('Lyrics', 'LyricsEffect', ILyricsEffect[LyricsEffect]);
+
+ // Solmization
+ IniFile.WriteString('Lyrics', 'Solmization', ISolmization[Solmization]);
+
+ // NoteLines
+ IniFile.WriteString('Lyrics', 'NoteLines', INoteLines[NoteLines]);
+
+ // Theme
+ IniFile.WriteString('Themes', 'Theme', ITheme[Theme]);
+
+ // Skin
+ IniFile.WriteString('Themes', 'Skin', ISkin[SkinNo]);
+
+ // Color
+ IniFile.WriteString('Themes', 'Color', IColor[Color]);
+
+ SaveInputDeviceCfg(IniFile);
+
+ //LoadAnimation
+ IniFile.WriteString('Advanced', 'LoadAnimation', ILoadAnimation[LoadAnimation]);
+
+ //EffectSing
+ IniFile.WriteString('Advanced', 'EffectSing', IEffectSing[EffectSing]);
+
+ //ScreenFade
+ IniFile.WriteString('Advanced', 'ScreenFade', IScreenFade[ScreenFade]);
+
+ //AskbeforeDel
+ IniFile.WriteString('Advanced', 'AskbeforeDel', IAskbeforeDel[AskBeforeDel]);
+
+ //OnSongClick
+ IniFile.WriteString('Advanced', 'OnSongClick', IOnSongClick[OnSongClick]);
+
+ //Line Bonus
+ IniFile.WriteString('Advanced', 'LineBonus', ILineBonus[LineBonus]);
+
+ //Party Popup
+ IniFile.WriteString('Advanced', 'PartyPopup', IPartyPopup[PartyPopup]);
+
+ // Joypad
+ IniFile.WriteString('Controller', 'Joypad', IJoypad[Joypad]);
+
+ // Directories (add a template if section is missing)
+ if (not IniFile.SectionExists('Directories')) then
+ IniFile.WriteString('Directories', 'SongDir1', '');
+
+ IniFile.Free;
+end;
+
+procedure TIni.SaveNames;
+var
+ IniFile: TIniFile;
+ I: integer;
+begin
+ if not FileIsReadOnly(Filename) then
+ begin
+ IniFile := TIniFile.Create(Filename);
+
+ //Name Templates for Names Mod
+ for I := 1 to 12 do
+ IniFile.WriteString('Name', 'P' + IntToStr(I), Name[I-1]);
+ for I := 1 to 3 do
+ IniFile.WriteString('NameTeam', 'T' + IntToStr(I), NameTeam[I-1]);
+ for I := 1 to 12 do
+ IniFile.WriteString('NameTemplate', 'Name' + IntToStr(I), NameTemplate[I-1]);
+
+ IniFile.Free;
+ end;
+end;
+
+procedure TIni.SaveLevel;
+var
+ IniFile: TIniFile;
+begin
+ if not FileIsReadOnly(Filename) then
+ begin
+ IniFile := TIniFile.Create(Filename);
+
+ // Difficulty
+ IniFile.WriteString('Game', 'Difficulty', IDifficulty[Difficulty]);
+
+ IniFile.Free;
+ end;
+end;
+
+end.
diff --git a/src/base/UJoystick.pas b/src/base/UJoystick.pas
new file mode 100644
index 00000000..0ca7ba09
--- /dev/null
+++ b/src/base/UJoystick.pas
@@ -0,0 +1,282 @@
+unit UJoystick;
+
+interface
+
+{$I switches.inc}
+
+
+uses SDL;
+
+type
+ TJoyButton = record
+ State: integer;
+ Enabled: boolean;
+ Type_: byte;
+ Sym: cardinal;
+ end;
+
+ TJoyHatState = record
+ State: Boolean;
+ LastTick: Cardinal;
+ Enabled: boolean;
+ Type_: byte;
+ Sym: cardinal;
+ end;
+
+ TJoyUnit = record
+ Button: array[0..15] of TJoyButton;
+ HatState: Array[0..3] of TJoyHatState;
+ end;
+
+ TJoy = class
+ constructor Create;
+ procedure Update;
+ end;
+
+var
+ Joy: TJoy;
+ JoyUnit: TJoyUnit;
+ SDL_Joy: PSDL_Joystick;
+ JoyEvent: TSDL_Event;
+
+implementation
+
+uses SysUtils,
+ ULog;
+
+constructor TJoy.Create;
+var
+ B, N: integer;
+begin
+ inherited;
+
+ //Old Corvus5 Method
+ {// joystick support
+ SDL_JoystickEventState(SDL_IGNORE);
+ SDL_InitSubSystem(SDL_INIT_JOYSTICK);
+ if SDL_NumJoysticks <> 1 then
+ Log.LogStatus('Joystick count <> 1', 'TJoy.Create');
+
+ SDL_Joy := SDL_JoystickOpen(0);
+ if SDL_Joy = nil then
+ Log.LogError('SDL_JoystickOpen failed', 'TJoy.Create');
+
+ if SDL_JoystickNumButtons(SDL_Joy) <> 16 then
+ Log.LogStatus('Joystick button count <> 16', 'TJoy.Create');
+
+// SDL_JoystickEventState(SDL_ENABLE);
+ // Events don't work - thay hang the whole application with SDL_JoystickEventState(SDL_ENABLE)
+
+ // clear states
+ for B := 0 to 15 do
+ JoyUnit.Button[B].State := 1;
+
+ // mapping
+ JoyUnit.Button[1].Enabled := true;
+ JoyUnit.Button[1].Type_ := SDL_KEYDOWN;
+ JoyUnit.Button[1].Sym := SDLK_RETURN;
+ JoyUnit.Button[2].Enabled := true;
+ JoyUnit.Button[2].Type_ := SDL_KEYDOWN;
+ JoyUnit.Button[2].Sym := SDLK_ESCAPE;
+
+ JoyUnit.Button[12].Enabled := true;
+ JoyUnit.Button[12].Type_ := SDL_KEYDOWN;
+ JoyUnit.Button[12].Sym := SDLK_LEFT;
+ JoyUnit.Button[13].Enabled := true;
+ JoyUnit.Button[13].Type_ := SDL_KEYDOWN;
+ JoyUnit.Button[13].Sym := SDLK_DOWN;
+ JoyUnit.Button[14].Enabled := true;
+ JoyUnit.Button[14].Type_ := SDL_KEYDOWN;
+ JoyUnit.Button[14].Sym := SDLK_RIGHT;
+ JoyUnit.Button[15].Enabled := true;
+ JoyUnit.Button[15].Type_ := SDL_KEYDOWN;
+ JoyUnit.Button[15].Sym := SDLK_UP;
+ }
+ //New Sarutas method
+ SDL_JoystickEventState(SDL_IGNORE);
+ SDL_InitSubSystem(SDL_INIT_JOYSTICK);
+ if SDL_NumJoysticks < 1 then
+ begin
+ Log.LogError('No Joystick found');
+ exit;
+ end;
+
+
+ SDL_Joy := SDL_JoystickOpen(0);
+ if SDL_Joy = nil then
+ begin
+ Log.LogError('Could not Init Joystick');
+ exit;
+ end;
+ N := SDL_JoystickNumButtons(SDL_Joy);
+ //if N < 6 then Log.LogStatus('Joystick button count < 6', 'TJoy.Create');
+
+ for B := 0 to 5 do begin
+ JoyUnit.Button[B].Enabled := true;
+ JoyUnit.Button[B].State := 1;
+ JoyUnit.Button[B].Type_ := SDL_KEYDOWN;
+ end;
+
+ JoyUnit.Button[0].Sym := SDLK_Return;
+ JoyUnit.Button[1].Sym := SDLK_Escape;
+ JoyUnit.Button[2].Sym := SDLK_M;
+ JoyUnit.Button[3].Sym := SDLK_R;
+
+ JoyUnit.Button[4].Sym := SDLK_RETURN;
+ JoyUnit.Button[5].Sym := SDLK_ESCAPE;
+
+ //Set HatState
+ for B := 0 to 3 do begin
+ JoyUnit.HatState[B].Enabled := true;
+ JoyUnit.HatState[B].State := False;
+ JoyUnit.HatState[B].Type_ := SDL_KEYDOWN;
+ end;
+
+ JoyUnit.HatState[0].Sym := SDLK_UP;
+ JoyUnit.HatState[1].Sym := SDLK_RIGHT;
+ JoyUnit.HatState[2].Sym := SDLK_DOWN;
+ JoyUnit.HatState[3].Sym := SDLK_LEFT;
+end;
+
+procedure TJoy.Update;
+var
+ B: integer;
+ State: UInt8;
+ Tick: Cardinal;
+ Axes: Smallint;
+begin
+ SDL_JoystickUpdate;
+
+ //Manage Buttons
+ for B := 0 to 15 do begin
+ if (JoyUnit.Button[B].Enabled) and (JoyUnit.Button[B].State <> SDL_JoystickGetButton(SDL_Joy, B)) and (JoyUnit.Button[B].State = 0) then begin
+ JoyEvent.type_ := JoyUnit.Button[B].Type_;
+ JoyEvent.key.keysym.sym := JoyUnit.Button[B].Sym;
+ SDL_PushEvent(@JoyEvent);
+ end;
+ end;
+
+
+ for B := 0 to 15 do begin
+ JoyUnit.Button[B].State := SDL_JoystickGetButton(SDL_Joy, B);
+ end;
+
+ //Get Tick
+ Tick := SDL_GetTicks();
+
+ //Get CoolieHat
+ if (SDL_JoystickNumHats(SDL_Joy)>=1) then
+ State := SDL_JoystickGetHat(SDL_Joy, 0)
+ else
+ State := 0;
+
+ //Get Axis
+ if (SDL_JoystickNumAxes(SDL_Joy)>=2) then
+ begin
+ //Down - Up (X- Axis)
+ Axes := SDL_JoystickGetAxis(SDL_Joy, 1);
+ If Axes >= 15000 then
+ State := State or SDL_HAT_Down
+ Else If Axes <= -15000 then
+ State := State or SDL_HAT_UP;
+
+ //Left - Right (Y- Axis)
+ Axes := SDL_JoystickGetAxis(SDL_Joy, 0);
+ If Axes >= 15000 then
+ State := State or SDL_HAT_Right
+ Else If Axes <= -15000 then
+ State := State or SDL_HAT_Left;
+ end;
+
+ //Manage Hat and joystick Events
+ if (SDL_JoystickNumHats(SDL_Joy)>=1) OR (SDL_JoystickNumAxes(SDL_Joy)>=2) then
+ begin
+
+ //Up Button
+ If (JoyUnit.HatState[0].Enabled) and ((SDL_HAT_UP AND State) = SDL_HAT_UP) then
+ begin //IF Button is newly Pressed or if he is Pressed longer than 500 msecs
+ if (JoyUnit.HatState[0].State = False) OR (JoyUnit.HatState[0].Lasttick < Tick) then
+ begin
+ //Set Tick and State
+ if JoyUnit.HatState[0].State then
+ JoyUnit.HatState[0].Lasttick := Tick + 200
+ else
+ JoyUnit.HatState[0].Lasttick := Tick + 500;
+
+ JoyUnit.HatState[0].State := True;
+
+ JoyEvent.type_ := JoyUnit.HatState[0].Type_;
+ JoyEvent.key.keysym.sym := JoyUnit.HatState[0].Sym;
+ SDL_PushEvent(@JoyEvent);
+ end;
+ end
+ else
+ JoyUnit.HatState[0].State := False;
+
+ //Right Button
+ If (JoyUnit.HatState[1].Enabled) and ((SDL_HAT_RIGHT AND State) = SDL_HAT_RIGHT) then
+ begin //IF Button is newly Pressed or if he is Pressed longer than 500 msecs
+ if (JoyUnit.HatState[1].State = False) OR (JoyUnit.HatState[1].Lasttick < Tick) then
+ begin
+ //Set Tick and State
+ if JoyUnit.HatState[1].State then
+ JoyUnit.HatState[1].Lasttick := Tick + 200
+ else
+ JoyUnit.HatState[1].Lasttick := Tick + 500;
+
+ JoyUnit.HatState[1].State := True;
+
+ JoyEvent.type_ := JoyUnit.HatState[1].Type_;
+ JoyEvent.key.keysym.sym := JoyUnit.HatState[1].Sym;
+ SDL_PushEvent(@JoyEvent);
+ end;
+ end
+ else
+ JoyUnit.HatState[1].State := False;
+
+ //Down button
+ If (JoyUnit.HatState[2].Enabled) and ((SDL_HAT_DOWN AND State) = SDL_HAT_DOWN) then
+ begin //IF Button is newly Pressed or if he is Pressed longer than 230 msecs
+ if (JoyUnit.HatState[2].State = False) OR (JoyUnit.HatState[2].Lasttick < Tick) then
+ begin
+ //Set Tick and State
+ if JoyUnit.HatState[2].State then
+ JoyUnit.HatState[2].Lasttick := Tick + 200
+ else
+ JoyUnit.HatState[2].Lasttick := Tick + 500;
+
+ JoyUnit.HatState[2].State := True;
+
+ JoyEvent.type_ := JoyUnit.HatState[2].Type_;
+ JoyEvent.key.keysym.sym := JoyUnit.HatState[2].Sym;
+ SDL_PushEvent(@JoyEvent);
+ end;
+ end
+ else
+ JoyUnit.HatState[2].State := False;
+
+ //Left Button
+ If (JoyUnit.HatState[3].Enabled) and ((SDL_HAT_LEFT AND State) = SDL_HAT_LEFT) then
+ begin //IF Button is newly Pressed or if he is Pressed longer than 230 msecs
+ if (JoyUnit.HatState[3].State = False) OR (JoyUnit.HatState[3].Lasttick < Tick) then
+ begin
+ //Set Tick and State
+ if JoyUnit.HatState[3].State then
+ JoyUnit.HatState[3].Lasttick := Tick + 200
+ else
+ JoyUnit.HatState[3].Lasttick := Tick + 500;
+
+ JoyUnit.HatState[3].State := True;
+
+ JoyEvent.type_ := JoyUnit.HatState[3].Type_;
+ JoyEvent.key.keysym.sym := JoyUnit.HatState[3].Sym;
+ SDL_PushEvent(@JoyEvent);
+ end;
+ end
+ else
+ JoyUnit.HatState[3].State := False;
+ end;
+
+end;
+
+end.
diff --git a/src/base/ULCD.pas b/src/base/ULCD.pas
new file mode 100644
index 00000000..82f7ba2f
--- /dev/null
+++ b/src/base/ULCD.pas
@@ -0,0 +1,304 @@
+unit ULCD;
+
+interface
+
+{$I switches.inc}
+
+type
+ TLCD = class
+ private
+ Enabled: boolean;
+ Text: array[1..6] of string;
+ StartPos: integer;
+ LineBR: integer;
+ Position: integer;
+ procedure WriteCommand(B: byte);
+ procedure WriteData(B: byte);
+ procedure WriteString(S: string);
+ public
+ HalfInterface: boolean;
+ constructor Create;
+ procedure Enable;
+ procedure Clear;
+ procedure WriteText(Line: integer; S: string);
+ procedure MoveCursor(Line, Pos: integer);
+ procedure ShowCursor;
+ procedure HideCursor;
+
+ // for 2x16
+ procedure AddTextBR(S: string);
+ procedure MoveCursorBR(Pos: integer);
+ procedure ScrollUpBR;
+ procedure AddTextArray(Line:integer; S: string);
+ end;
+
+var
+ LCD: TLCD;
+
+const
+ Data = $378; // domy�lny adres portu
+ Status = Data + 1;
+ Control = Data + 2;
+
+implementation
+
+uses
+ SysUtils,
+ {$IFDEF UseSerialPort}
+ zlportio,
+ {$ENDIF}
+ SDL,
+ UTime;
+
+procedure TLCD.WriteCommand(B: Byte);
+// Wysylanie komend sterujacych
+begin
+{$IFDEF UseSerialPort}
+ if not HalfInterface then
+ begin
+ zlioportwrite(Control, 0, $02);
+ zlioportwrite(Data, 0, B);
+ zlioportwrite(Control, 0, $03);
+ end
+ else
+ begin
+ zlioportwrite(Control, 0, $02);
+ zlioportwrite(Data, 0, B and $F0);
+ zlioportwrite(Control, 0, $03);
+
+ SDL_Delay( 100 );
+
+ zlioportwrite(Control, 0, $02);
+ zlioportwrite(Data, 0, (B * 16) and $F0);
+ zlioportwrite(Control, 0, $03);
+ end;
+
+ if (B=1) or (B=2) then
+ Sleep(2)
+ else
+ SDL_Delay( 100 );
+{$ENDIF}
+end;
+
+procedure TLCD.WriteData(B: Byte);
+// Wysylanie danych
+begin
+{$IFDEF UseSerialPort}
+ if not HalfInterface then
+ begin
+ zlioportwrite(Control, 0, $06);
+ zlioportwrite(Data, 0, B);
+ zlioportwrite(Control, 0, $07);
+ end
+ else
+ begin
+ zlioportwrite(Control, 0, $06);
+ zlioportwrite(Data, 0, B and $F0);
+ zlioportwrite(Control, 0, $07);
+
+ SDL_Delay( 100 );
+
+ zlioportwrite(Control, 0, $06);
+ zlioportwrite(Data, 0, (B * 16) and $F0);
+ zlioportwrite(Control, 0, $07);
+ end;
+
+ SDL_Delay( 100 );
+ Inc(Position);
+{$ENDIF}
+end;
+
+procedure TLCD.WriteString(S: string);
+// Wysylanie slow
+var
+ I: integer;
+begin
+ for I := 1 to Length(S) do
+ WriteData(Ord(S[I]));
+end;
+
+constructor TLCD.Create;
+begin
+ inherited;
+end;
+
+procedure TLCD.Enable;
+{var
+ A: byte;
+ B: byte;}
+begin
+ Enabled := true;
+ if not HalfInterface then
+ WriteCommand($38)
+ else begin
+ WriteCommand($33);
+ WriteCommand($32);
+ WriteCommand($28);
+ end;
+
+// WriteCommand($06);
+// WriteCommand($0C);
+// sleep(10);
+end;
+
+procedure TLCD.Clear;
+begin
+ if Enabled then begin
+ WriteCommand(1);
+ WriteCommand(2);
+ Text[1] := '';
+ Text[2] := '';
+ Text[3] := '';
+ Text[4] := '';
+ Text[5] := '';
+ Text[6] := '';
+ StartPos := 1;
+ LineBR := 1;
+ end;
+end;
+
+procedure TLCD.WriteText(Line: integer; S: string);
+begin
+ if Enabled then begin
+ if Line <= 2 then begin
+ MoveCursor(Line, 1);
+ WriteString(S);
+ end;
+
+ Text[Line] := '';
+ AddTextArray(Line, S);
+ end;
+end;
+
+procedure TLCD.MoveCursor(Line, Pos: integer);
+var
+ I: integer;
+begin
+ if Enabled then begin
+ Pos := Pos + (Line-1) * 40;
+
+ if Position > Pos then begin
+ WriteCommand(2);
+ for I := 1 to Pos-1 do
+ WriteCommand(20);
+ end;
+
+ if Position < Pos then
+ for I := 1 to Pos - Position do
+ WriteCommand(20);
+
+ Position := Pos;
+ end;
+end;
+
+procedure TLCD.ShowCursor;
+begin
+ if Enabled then begin
+ WriteCommand(14);
+ end;
+end;
+
+procedure TLCD.HideCursor;
+begin
+ if Enabled then begin
+ WriteCommand(12);
+ end;
+end;
+
+procedure TLCD.AddTextBR(S: string);
+var
+ Word: string;
+// W: integer;
+ P: integer;
+ L: integer;
+begin
+ if Enabled then begin
+ if LineBR <= 6 then begin
+ L := LineBR;
+ P := Pos(' ', S);
+
+ if L <= 2 then
+ MoveCursor(L, 1);
+
+ while (L <= 6) and (P > 0) do begin
+ Word := Copy(S, 1, P);
+ if (Length(Text[L]) + Length(Word)-1) > 16 then begin
+ L := L + 1;
+ if L <= 2 then
+ MoveCursor(L, 1);
+ end;
+
+ if L <= 6 then begin
+ if L <= 2 then
+ WriteString(Word);
+ AddTextArray(L, Word);
+ end;
+
+ Delete(S, 1, P);
+ P := Pos(' ', S)
+ end;
+
+ LineBR := L + 1;
+ end;
+ end;
+end;
+
+procedure TLCD.MoveCursorBR(Pos: integer);
+{var
+ I: integer;
+ L: integer;}
+begin
+ if Enabled then begin
+ Pos := Pos - (StartPos-1);
+ if Pos <= Length(Text[1]) then
+ MoveCursor(1, Pos);
+
+ if Pos > Length(Text[1]) then begin
+ // bez zawijania
+// Pos := Pos - Length(Text[1]);
+// MoveCursor(2, Pos);
+
+ // z zawijaniem
+ Pos := Pos - Length(Text[1]);
+ ScrollUpBR;
+ MoveCursor(1, Pos);
+ end;
+ end;
+end;
+
+procedure TLCD.ScrollUpBR;
+var
+ T: array[1..5] of string;
+ SP: integer;
+ LBR: integer;
+begin
+ if Enabled then begin
+ T[1] := Text[2];
+ T[2] := Text[3];
+ T[3] := Text[4];
+ T[4] := Text[5];
+ T[5] := Text[6];
+ SP := StartPos + Length(Text[1]);
+ LBR := LineBR;
+
+ Clear;
+
+ StartPos := SP;
+ WriteText(1, T[1]);
+ WriteText(2, T[2]);
+ WriteText(3, T[3]);
+ WriteText(4, T[4]);
+ WriteText(5, T[5]);
+ LineBR := LBR-1;
+ end;
+end;
+
+procedure TLCD.AddTextArray(Line: integer; S: string);
+begin
+ if Enabled then begin
+ Text[Line] := Text[Line] + S;
+ end;
+end;
+
+end.
+
diff --git a/src/base/ULanguage.pas b/src/base/ULanguage.pas
new file mode 100644
index 00000000..d534b4e1
--- /dev/null
+++ b/src/base/ULanguage.pas
@@ -0,0 +1,240 @@
+unit ULanguage;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+
+type
+ TLanguageEntry = record
+ ID: string;
+ Text: string;
+ end;
+
+ TLanguageList = record
+ Name: string;
+ {FileName: string; }
+ end;
+
+ TLanguage = class
+ public
+ Entry: array of TLanguageEntry; //Entrys of Chosen Language
+ SEntry: array of TLanguageEntry; //Entrys of Standard Language
+ CEntry: array of TLanguageEntry; //Constant Entrys e.g. Version
+ Implode_Glue1, Implode_Glue2: String;
+ public
+ List: array of TLanguageList;
+
+ constructor Create;
+ procedure LoadList;
+ function Translate(Text: String): String;
+ procedure ChangeLanguage(Language: String);
+ procedure AddConst(ID, Text: String);
+ procedure ChangeConst(ID, Text: String);
+ function Implode(Pieces: Array of String): String;
+ end;
+
+var
+ Language: TLanguage;
+
+implementation
+
+uses UMain,
+ // UFiles,
+ UIni,
+ IniFiles,
+ Classes,
+ SysUtils,
+ {$IFDEF win32}
+ windows,
+ {$ENDIF}
+ ULog;
+
+//----------
+//Create - Construct Class then LoadList + Standard Language + Set Standard Implode Glues
+//----------
+constructor TLanguage.Create;
+var
+ I, J: Integer;
+begin
+ inherited;
+
+ LoadList;
+
+ //Set Implode Glues for Backward Compatibility
+ Implode_Glue1 := ', ';
+ Implode_Glue2 := ' and ';
+
+ if (Length(List) = 0) then //No Language Files Loaded -> Abort Loading
+ Log.CriticalError('Could not load any Language File');
+
+ //Standard Language (If a Language File is Incomplete)
+ //Then use English Language
+ for I := 0 to high(List) do //Search for English Language
+ begin
+ //English Language Found -> Load
+ if Uppercase(List[I].Name) = 'ENGLISH' then
+ begin
+ ChangeLanguage('English');
+
+ SetLength(SEntry, Length(Entry));
+ for J := low(Entry) to high(Entry) do
+ SEntry[J] := Entry[J];
+
+ SetLength(Entry, 0);
+
+ Break;
+ end;
+
+ if (I = high(List)) then
+ Log.LogError('English Languagefile missing! No standard Translation loaded');
+ end;
+ //Standard Language END
+
+end;
+
+//----------
+//LoadList - Parse the Language Dir searching Translations
+//----------
+procedure TLanguage.LoadList;
+var
+ SR: TSearchRec; // for parsing directory
+begin
+ SetLength(List, 0);
+ SetLength(ILanguage, 0);
+
+ if FindFirst(LanguagesPath + '*.ini', 0, SR) = 0 then begin
+ repeat
+ SetLength(List, Length(List)+1);
+ SetLength(ILanguage, Length(ILanguage)+1);
+ SR.Name := ChangeFileExt(SR.Name, '');
+
+ List[High(List)].Name := SR.Name;
+ ILanguage[High(ILanguage)] := SR.Name;
+
+ until FindNext(SR) <> 0;
+ SysUtils.FindClose(SR);
+ end; // if FindFirst
+end;
+
+//----------
+//ChangeLanguage - Load the specified LanguageFile
+//----------
+procedure TLanguage.ChangeLanguage(Language: String);
+var
+ IniFile: TIniFile;
+ E: integer; // entry
+ S: TStringList;
+begin
+ SetLength(Entry, 0);
+ IniFile := TIniFile.Create(LanguagesPath + Language + '.ini');
+ S := TStringList.Create;
+
+ IniFile.ReadSectionValues('Text', S);
+ SetLength(Entry, S.Count);
+ for E := 0 to high(Entry) do
+ begin
+ if S.Names[E] = 'IMPLODE_GLUE1' then
+ Implode_Glue1 := S.ValueFromIndex[E]+ ' '
+ else if S.Names[E] = 'IMPLODE_GLUE2' then
+ Implode_Glue2 := ' ' + S.ValueFromIndex[E] + ' ';
+
+ Entry[E].ID := S.Names[E];
+ Entry[E].Text := S.ValueFromIndex[E];
+ end;
+
+ S.Free;
+ IniFile.Free;
+end;
+
+//----------
+//Translate - Translate the Text
+//----------
+Function TLanguage.Translate(Text: String): String;
+var
+ E: integer; // entry
+begin
+ Result := Text;
+ Text := Uppercase(Result);
+
+ //Const Mod
+ for E := 0 to high(CEntry) do
+ if Text = CEntry[E].ID then
+ begin
+ Result := CEntry[E].Text;
+ exit;
+ end;
+ //Const Mod End
+
+ for E := 0 to high(Entry) do
+ if Text = Entry[E].ID then
+ begin
+ Result := Entry[E].Text;
+ exit;
+ end;
+
+ //Standard Language (If a Language File is Incomplete)
+ //Then use Standard Language
+ for E := low(SEntry) to high(SEntry) do
+ if Text = SEntry[E].ID then
+ begin
+ Result := SEntry[E].Text;
+ Break;
+ end;
+ //Standard Language END
+end;
+
+//----------
+//AddConst - Add a Constant ID that will be Translated but not Loaded from the LanguageFile
+//----------
+procedure TLanguage.AddConst (ID, Text: String);
+begin
+ SetLength (CEntry, Length(CEntry) + 1);
+ CEntry[high(CEntry)].ID := ID;
+ CEntry[high(CEntry)].Text := Text;
+end;
+
+//----------
+//ChangeConst - Change a Constant Value by ID
+//----------
+procedure TLanguage.ChangeConst(ID, Text: String);
+var
+ I: Integer;
+begin
+ for I := 0 to high(CEntry) do
+ begin
+ if CEntry[I].ID = ID then
+ begin
+ CEntry[I].Text := Text;
+ Break;
+ end;
+ end;
+end;
+
+//----------
+//Implode - Connect an Array of Strings with ' and ' or ', ' to one String
+//----------
+function TLanguage.Implode(Pieces: Array of String): String;
+var
+ I: Integer;
+begin
+ Result := '';
+ //Go through Pieces
+ for I := low(Pieces) to high(Pieces) do
+ begin
+ //Add Value
+ Result := Result + Pieces[I];
+
+ //Add Glue
+ if (I < high(Pieces) - 1) then
+ Result := Result + Implode_Glue1
+ else if (I < high(Pieces)) then
+ Result := Result + Implode_Glue2;
+ end;
+end;
+
+end.
diff --git a/src/base/ULight.pas b/src/base/ULight.pas
new file mode 100644
index 00000000..a0a399ab
--- /dev/null
+++ b/src/base/ULight.pas
@@ -0,0 +1,145 @@
+unit ULight;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+type
+ TLight = class
+ private
+ Enabled: boolean;
+ Light: array[0..7] of boolean;
+ LightTime: array[0..7] of real; // time to stop, need to call update to change state
+ LastTime: real;
+ public
+ constructor Create;
+ procedure Enable;
+ procedure SetState(State: integer);
+ procedure AutoSetState;
+ procedure TurnOn;
+ procedure TurnOff;
+ procedure LightOne(Number: integer; Time: real);
+ procedure Refresh;
+ end;
+
+var
+ Light: TLight;
+
+const
+ Data = $378; // default port address
+ Status = Data + 1;
+ Control = Data + 2;
+
+implementation
+
+uses
+ SysUtils,
+ {$IFDEF UseSerialPort}
+ zlportio,
+ {$ENDIF}
+ UTime;
+
+{$IFDEF FPC}
+
+ function GetTime: TDateTime;
+ var
+ SystemTime: TSystemTime;
+ begin
+ GetLocalTime(SystemTime);
+ with SystemTime do
+ begin
+ {$IFDEF UNIX}
+ Result := EncodeTime(Hour, Minute, Second, MilliSecond);
+ {$ELSE}
+ Result := EncodeTime(wHour, wMinute, wSecond, wMilliSeconds);
+ {$ENDIF}
+ end;
+ end;
+
+{$ENDIF}
+
+
+constructor TLight.Create;
+begin
+ inherited;
+ Enabled := false;
+end;
+
+procedure TLight.Enable;
+begin
+ Enabled := true;
+ LastTime := GetTime;
+end;
+
+procedure TLight.SetState(State: integer);
+begin
+ {$IFDEF UseSerialPort}
+ if Enabled then
+ PortWriteB($378, State);
+ {$ENDIF}
+end;
+
+procedure TLight.AutoSetState;
+var
+ State: integer;
+begin
+ if Enabled then begin
+ State := 0;
+ if Light[0] then State := State + 2;
+ if Light[1] then State := State + 1;
+ // etc
+ SetState(State);
+ end;
+end;
+
+procedure TLight.TurnOn;
+begin
+ if Enabled then
+ SetState(3);
+end;
+
+procedure TLight.TurnOff;
+begin
+ if Enabled then
+ SetState(0);
+end;
+
+procedure TLight.LightOne(Number: integer; Time: real);
+begin
+ if Enabled then begin
+ if Light[Number] = false then begin
+ Light[Number] := true;
+ AutoSetState;
+ end;
+
+ LightTime[Number] := GetTime + Time/1000; // [s]
+ end;
+end;
+
+procedure TLight.Refresh;
+var
+ Time: real;
+ L: integer;
+begin
+ if Enabled then begin
+ Time := GetTime;
+ for L := 0 to 7 do begin
+ if Light[L] = true then begin
+ if LightTime[L] > Time then begin
+ end else begin
+ Light[L] := false;
+ end;
+ end;
+ end;
+ LastTime := Time;
+ AutoSetState;
+ end;
+end;
+
+end.
+
+
diff --git a/src/base/ULog.pas b/src/base/ULog.pas
new file mode 100644
index 00000000..a9a2f3c4
--- /dev/null
+++ b/src/base/ULog.pas
@@ -0,0 +1,417 @@
+unit ULog;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+uses
+ Classes;
+
+(*
+ * LOG_LEVEL_[TYPE] defines the "minimum" index for logs of type TYPE. Each
+ * level greater than this BUT less or equal than LOG_LEVEL_[TYPE]_MAX is of this type.
+ * This means a level "LOG_LEVEL_ERROR >= Level <= LOG_LEVEL_ERROR_MAX" e.g.
+ * "Level := LOG_LEVEL_ERROR+2" is considered an error level.
+ * This is nice for debugging if you have more or less important debug messages.
+ * For example you can assign LOG_LEVEL_DEBUG+10 for the more important ones and
+ * LOG_LEVEL_DEBUG+20 for less important ones and so on. By changing the log-level
+ * you can hide the less important ones.
+ *)
+const
+ LOG_LEVEL_DEBUG_MAX = MaxInt;
+ LOG_LEVEL_DEBUG = 50;
+ LOG_LEVEL_INFO_MAX = LOG_LEVEL_DEBUG-1;
+ LOG_LEVEL_INFO = 40;
+ LOG_LEVEL_STATUS_MAX = LOG_LEVEL_INFO-1;
+ LOG_LEVEL_STATUS = 30;
+ LOG_LEVEL_WARN_MAX = LOG_LEVEL_STATUS-1;
+ LOG_LEVEL_WARN = 20;
+ LOG_LEVEL_ERROR_MAX = LOG_LEVEL_WARN-1;
+ LOG_LEVEL_ERROR = 10;
+ LOG_LEVEL_CRITICAL_MAX = LOG_LEVEL_ERROR-1;
+ LOG_LEVEL_CRITICAL = 0;
+ LOG_LEVEL_NONE = -1;
+
+ // define level that Log(File)Level is initialized with
+ LOG_LEVEL_DEFAULT = LOG_LEVEL_WARN;
+ LOG_FILE_LEVEL_DEFAULT = LOG_LEVEL_ERROR;
+
+type
+ TLog = class
+ private
+ LogFile: TextFile;
+ LogFileOpened: boolean;
+ BenchmarkFile: TextFile;
+ BenchmarkFileOpened: boolean;
+
+ LogLevel: integer;
+ // level of messages written to the log-file
+ LogFileLevel: integer;
+
+ procedure LogToFile(const Text: string);
+ public
+ BenchmarkTimeStart: array[0..31] of real;
+ BenchmarkTimeLength: array[0..31] of real;//TDateTime;
+
+ Title: String; //Application Title
+
+ // Write log message to log-file
+ FileOutputEnabled: Boolean;
+
+ constructor Create;
+
+ // destuctor
+ destructor Destroy; override;
+
+ // benchmark
+ procedure BenchmarkStart(Number: integer);
+ procedure BenchmarkEnd(Number: integer);
+ procedure LogBenchmark(const Text: string; Number: integer);
+
+ procedure SetLogLevel(Level: integer);
+ function GetLogLevel(): integer;
+
+ procedure LogMsg(const Text: string; Level: integer); overload;
+ procedure LogMsg(const Msg, Context: string; Level: integer); overload; {$IFDEF HasInline}inline;{$ENDIF}
+ procedure LogDebug(const Msg, Context: string); {$IFDEF HasInline}inline;{$ENDIF}
+ procedure LogInfo(const Msg, Context: string); {$IFDEF HasInline}inline;{$ENDIF}
+ procedure LogStatus(const Msg, Context: string); {$IFDEF HasInline}inline;{$ENDIF}
+ procedure LogWarn(const Msg, Context: string); {$IFDEF HasInline}inline;{$ENDIF}
+ procedure LogError(const Text: string); overload; {$IFDEF HasInline}inline;{$ENDIF}
+ procedure LogError(const Msg, Context: string); overload; {$IFDEF HasInline}inline;{$ENDIF}
+ //Critical Error (Halt + MessageBox)
+ procedure LogCritical(const Msg, Context: string); {$IFDEF HasInline}inline;{$ENDIF}
+ procedure CriticalError(const Text: string); {$IFDEF HasInline}inline;{$ENDIF}
+
+ // voice
+ procedure LogVoice(SoundNr: integer);
+ // buffer
+ procedure LogBuffer(const buf : Pointer; const bufLength : Integer; const filename : string);
+ end;
+
+procedure DebugWriteln(const aString: String);
+
+var
+ Log: TLog;
+
+implementation
+
+uses
+ SysUtils,
+ DateUtils,
+ URecord,
+ UMain,
+ UTime,
+ UCommon,
+ UCommandLine;
+
+(*
+ * Write to console if in debug mode (Thread-safe).
+ * If debug-mode is disabled nothing is done.
+ *)
+procedure DebugWriteln(const aString: string);
+begin
+ {$IFNDEF DEBUG}
+ if Params.Debug then
+ begin
+ {$ENDIF}
+ ConsoleWriteLn(aString);
+ {$IFNDEF DEBUG}
+ end;
+ {$ENDIF}
+end;
+
+
+constructor TLog.Create;
+begin
+ inherited;
+ LogLevel := LOG_LEVEL_DEFAULT;
+ LogFileLevel := LOG_FILE_LEVEL_DEFAULT;
+ FileOutputEnabled := true;
+end;
+
+destructor TLog.Destroy;
+begin
+ if BenchmarkFileOpened then
+ CloseFile(BenchmarkFile);
+ //if AnalyzeFileOpened then
+ // CloseFile(AnalyzeFile);
+ if LogFileOpened then
+ CloseFile(LogFile);
+ inherited;
+end;
+
+procedure TLog.BenchmarkStart(Number: integer);
+begin
+ BenchmarkTimeStart[Number] := USTime.GetTime; //Time;
+end;
+
+procedure TLog.BenchmarkEnd(Number: integer);
+begin
+ BenchmarkTimeLength[Number] := USTime.GetTime {Time} - BenchmarkTimeStart[Number];
+end;
+
+procedure TLog.LogBenchmark(const Text: string; Number: integer);
+var
+ Minutes: integer;
+ Seconds: integer;
+ Miliseconds: integer;
+
+ MinutesS: string;
+ SecondsS: string;
+ MilisecondsS: string;
+
+ ValueText: string;
+begin
+ if (FileOutputEnabled and Params.Benchmark) then
+ begin
+ if not BenchmarkFileOpened then
+ begin
+ BenchmarkFileOpened := true;
+ AssignFile(BenchmarkFile, LogPath + 'Benchmark.log');
+ {$I-}
+ Rewrite(BenchmarkFile);
+ if IOResult = 0 then
+ BenchmarkFileOpened := true;
+ {$I+}
+
+ //If File is opened write Date to Benchmark File
+ If (BenchmarkFileOpened) then
+ begin
+ WriteLn(BenchmarkFile, Title + ' Benchmark File');
+ WriteLn(BenchmarkFile, 'Date: ' + DatetoStr(Now) + ' Time: ' + TimetoStr(Now));
+ WriteLn(BenchmarkFile, '-------------------');
+
+ Flush(BenchmarkFile);
+ end;
+ end;
+
+ if BenchmarkFileOpened then
+ begin
+ Miliseconds := Trunc(Frac(BenchmarkTimeLength[Number]) * 1000);
+ Seconds := Trunc(BenchmarkTimeLength[Number]) mod 60;
+ Minutes := Trunc((BenchmarkTimeLength[Number] - Seconds) / 60);
+ //ValueText := FloatToStr(BenchmarkTimeLength[Number]);
+
+ {
+ ValueText := FloatToStr(SecondOf(BenchmarkTimeLength[Number]) +
+ MilliSecondOf(BenchmarkTimeLength[Number])/1000);
+ if MinuteOf(BenchmarkTimeLength[Number]) >= 1 then
+ ValueText := IntToStr(MinuteOf(BenchmarkTimeLength[Number])) + ':' + ValueText;
+ WriteLn(FileBenchmark, Text + ': ' + ValueText + ' seconds');
+ }
+
+ if (Minutes = 0) and (Seconds = 0) then begin
+ MilisecondsS := IntToStr(Miliseconds);
+ ValueText := MilisecondsS + ' miliseconds';
+ end;
+
+ if (Minutes = 0) and (Seconds >= 1) then begin
+ MilisecondsS := IntToStr(Miliseconds);
+ while Length(MilisecondsS) < 3 do
+ MilisecondsS := '0' + MilisecondsS;
+
+ SecondsS := IntToStr(Seconds);
+
+ ValueText := SecondsS + ',' + MilisecondsS + ' seconds';
+ end;
+
+ if Minutes >= 1 then begin
+ MilisecondsS := IntToStr(Miliseconds);
+ while Length(MilisecondsS) < 3 do
+ MilisecondsS := '0' + MilisecondsS;
+
+ SecondsS := IntToStr(Seconds);
+ while Length(SecondsS) < 2 do
+ SecondsS := '0' + SecondsS;
+
+ MinutesS := IntToStr(Minutes);
+
+ ValueText := MinutesS + ':' + SecondsS + ',' + MilisecondsS + ' minutes';
+ end;
+
+ WriteLn(BenchmarkFile, Text + ': ' + ValueText);
+ Flush(BenchmarkFile);
+ end;
+ end;
+end;
+
+procedure TLog.LogToFile(const Text: string);
+begin
+ if (FileOutputEnabled and not LogFileOpened) then
+ begin
+ AssignFile(LogFile, LogPath + 'Error.log');
+ {$I-}
+ Rewrite(LogFile);
+ if IOResult = 0 then
+ LogFileOpened := true;
+ {$I+}
+
+ //If File is opened write Date to Error File
+ if (LogFileOpened) then
+ begin
+ WriteLn(LogFile, Title + ' Error Log');
+ WriteLn(LogFile, 'Date: ' + DatetoStr(Now) + ' Time: ' + TimetoStr(Now));
+ WriteLn(LogFile, '-------------------');
+
+ Flush(LogFile);
+ end;
+ end;
+
+ if LogFileOpened then
+ begin
+ try
+ WriteLn(LogFile, Text);
+ Flush(LogFile);
+ except
+ LogFileOpened := false;
+ end;
+ end;
+end;
+
+procedure TLog.SetLogLevel(Level: integer);
+begin
+ LogLevel := Level;
+end;
+
+function TLog.GetLogLevel(): integer;
+begin
+ Result := LogLevel;
+end;
+
+procedure TLog.LogMsg(const Text: string; Level: integer);
+var
+ LogMsg: string;
+begin
+ // TODO: what if (LogFileLevel < LogLevel)? Log to file without printing to
+ // console or do not log at all? At the moment nothing is logged.
+ if (Level <= LogLevel) then
+ begin
+ if (Level <= LOG_LEVEL_CRITICAL_MAX) then
+ LogMsg := 'CRITICAL: ' + Text
+ else if (Level <= LOG_LEVEL_ERROR_MAX) then
+ LogMsg := 'ERROR: ' + Text
+ else if (Level <= LOG_LEVEL_WARN_MAX) then
+ LogMsg := 'WARN: ' + Text
+ else if (Level <= LOG_LEVEL_STATUS_MAX) then
+ LogMsg := 'STATUS: ' + Text
+ else if (Level <= LOG_LEVEL_INFO_MAX) then
+ LogMsg := 'INFO: ' + Text
+ else
+ LogMsg := 'DEBUG: ' + Text;
+
+ // output log-message
+ if (Level <= LogLevel) then
+ begin
+ DebugWriteLn(LogMsg);
+ end;
+
+ // write message to log-file
+ if (Level <= LogFileLevel) then
+ begin
+ LogToFile(LogMsg);
+ end;
+ end;
+
+ // exit application on criticial errors (cannot be turned off)
+ if (Level <= LOG_LEVEL_CRITICAL_MAX) then
+ begin
+ // Show information (window)
+ ShowMessage(Text, mtError);
+ Halt;
+ end;
+end;
+
+procedure TLog.LogMsg(const Msg, Context: string; Level: integer);
+begin
+ LogMsg(Msg + ' ['+Context+']', Level);
+end;
+
+procedure TLog.LogDebug(const Msg, Context: string);
+begin
+ LogMsg(Msg, Context, LOG_LEVEL_DEBUG);
+end;
+
+procedure TLog.LogInfo(const Msg, Context: string);
+begin
+ LogMsg(Msg, Context, LOG_LEVEL_INFO);
+end;
+
+procedure TLog.LogStatus(const Msg, Context: string);
+begin
+ LogMsg(Msg, Context, LOG_LEVEL_STATUS);
+end;
+
+procedure TLog.LogWarn(const Msg, Context: string);
+begin
+ LogMsg(Msg, Context, LOG_LEVEL_WARN);
+end;
+
+procedure TLog.LogError(const Msg, Context: string);
+begin
+ LogMsg(Msg, Context, LOG_LEVEL_ERROR);
+end;
+
+procedure TLog.LogError(const Text: string);
+begin
+ LogMsg(Text, LOG_LEVEL_ERROR);
+end;
+
+procedure TLog.CriticalError(const Text: string);
+begin
+ LogMsg(Text, LOG_LEVEL_CRITICAL);
+end;
+
+procedure TLog.LogCritical(const Msg, Context: string);
+begin
+ LogMsg(Msg, Context, LOG_LEVEL_CRITICAL);
+end;
+
+procedure TLog.LogVoice(SoundNr: integer);
+var
+ FS: TFileStream;
+ FileName: string;
+ Num: integer;
+begin
+ for Num := 1 to 9999 do begin
+ FileName := IntToStr(Num);
+ while Length(FileName) < 4 do
+ FileName := '0' + FileName;
+ FileName := LogPath + 'Voice' + FileName + '.raw';
+ if not FileExists(FileName) then
+ break
+ end;
+
+ FS := TFileStream.Create(FileName, fmCreate);
+
+ AudioInputProcessor.Sound[SoundNr].LogBuffer.Seek(0, soBeginning);
+ FS.CopyFrom(AudioInputProcessor.Sound[SoundNr].LogBuffer, AudioInputProcessor.Sound[SoundNr].LogBuffer.Size);
+
+ FS.Free;
+end;
+
+procedure TLog.LogBuffer(const buf: Pointer; const bufLength: Integer; const filename: string);
+var
+ f : TFileStream;
+begin
+ f := nil;
+
+ try
+ f := TFileStream.Create( filename, fmCreate);
+ f.Write( buf^, bufLength);
+ f.Free;
+ except
+ on e : Exception do begin
+ Log.LogError('TLog.LogBuffer: Failed to log buffer into file "' + filename + '". ErrMsg: ' + e.Message);
+ f.Free;
+ end;
+ end;
+end;
+
+end.
+
+
diff --git a/src/base/ULyrics.pas b/src/base/ULyrics.pas
new file mode 100644
index 00000000..305cb91f
--- /dev/null
+++ b/src/base/ULyrics.pas
@@ -0,0 +1,884 @@
+unit ULyrics;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+uses
+ gl,
+ glext,
+ UTexture,
+ UThemes,
+ UMusic;
+
+type
+ // stores two textures for enabled/disabled states
+ TPlayerIconTex = array [0..1] of TTexture;
+
+ PLyricWord = ^TLyricWord;
+ TLyricWord = record
+ X: Real; // left corner
+ Width: Real; // width
+ Start: Cardinal; // start of the word in quarters (beats)
+ Length: Cardinal; // length of the word in quarters
+ Text: String; // text
+ Freestyle: Boolean; // is freestyle?
+ end;
+ ALyricWord = array of TLyricWord;
+
+ TLyricLine = class
+ public
+ Text: String; // text
+ Tex: glUInt; // texture of the text
+ Width: Real; // width
+ Size: Byte; // fontsize
+ Words: ALyricWord; // words in this line
+ CurWord: Integer; // current active word idx (only valid if line is active)
+ Start: Integer; // start of this line in quarters (Note: negative start values are possible due to gap)
+ StartNote: Integer; // start of the first note of this line in quarters
+ Length: Integer; // length in quarters (from start of first to the end of the last note)
+ HasFreestyle: Boolean; // one or more word are freestyle?
+ CountFreestyle: Integer; // how often there is a change from freestyle to non freestyle in this line
+ Players: Byte; // players that should sing that line (bitset, Player1: 1, Player2: 2, Player3: 4)
+ LastLine: Boolean; // is this the last line of the song?
+
+ constructor Create();
+ destructor Destroy(); override;
+ procedure Reset();
+ end;
+
+ TLyricEngine = class
+ private
+ LastDrawBeat: Real;
+ UpperLine: TLyricLine; // first line displayed (top)
+ LowerLine: TLyricLine; // second lind displayed (bottom)
+ QueueLine: TLyricLine; // third line (will be displayed when lower line is finished)
+
+ IndicatorTex: TTexture; // texture for lyric indikator
+ BallTex: TTexture; // texture of the ball for the lyric effect
+
+ QueueFull: Boolean; // set to true if the queue is full and a line will be replaced with the next AddLine
+ LCounter: Word; // line counter
+
+ // duet mode - textures for player icons
+ // FIXME: do not use a fixed player count, use MAX_PLAYERS instead
+ PlayerIconTex: array[0..5] of TPlayerIconTex;
+
+ //Some helper Procedures for Lyric Drawing
+ procedure DrawLyrics (Beat: Real);
+ procedure DrawLyricsLine(X, W, Y: Real; Size: Byte; Line: TLyricLine; Beat: Real);
+ procedure DrawPlayerIcon(Player: Byte; Enabled: Boolean; X, Y, Size, Alpha: Real);
+ procedure DrawBall(XBall, YBall, Alpha:Real);
+
+ public
+ // positions, line specific settings
+ UpperLineX: Real; //X Start Pos of UpperLine
+ UpperLineW: Real; //Width of UpperLine with Icon(s) and Text
+ UpperLineY: Real; //Y Start Pos of UpperLine
+ UpperLineSize: Byte; //Max Size of Lyrics Text in UpperLine
+
+ LowerLineX: Real; //X Start Pos of LowerLine
+ LowerLineW: Real; //Width of LowerLine with Icon(s) and Text
+ LowerLineY: Real; //Y Start Pos of LowerLine
+ LowerLineSize: Byte; //Max Size of Lyrics Text in LowerLine
+
+ // display propertys
+ LineColor_en: TRGBA; //Color of Words in an Enabled Line
+ LineColor_dis: TRGBA; //Color of Words in a Disabled Line
+ LineColor_act: TRGBA; //Color of teh active Word
+ FontStyle: Byte; //Font for the Lyric Text
+ FontReSize: Boolean; //ReSize Lyrics if they don't fit Screen
+
+ { // currently not used
+ FadeInEffect: Byte; //Effect for Line Fading in: 0: No Effect; 1: Fade Effect; 2: Move Upwards from Bottom to Pos
+ FadeOutEffect: Byte; //Effect for Line Fading out: 0: No Effect; 1: Fade Effect; 2: Move Upwards
+ }
+
+ UseLinearFilter: Boolean; //Should Linear Tex Filter be used
+
+ // song specific settings
+ BPM: Real;
+ Resolution: Integer;
+
+ // properties to easily read options of this class
+ property IsQueueFull: Boolean read QueueFull; // line in queue?
+ property LineCounter: Word read LCounter; // lines that were progressed so far (after last clear)
+
+ procedure AddLine(Line: PLine); // adds a line to the queue, if there is space
+ procedure Draw (Beat: Real); // draw the current (active at beat) lyrics
+
+ // clears all cached song specific information
+ procedure Clear(cBPM: Real = 0; cResolution: Integer = 0);
+
+ function GetUpperLine(): TLyricLine;
+ function GetLowerLine(): TLyricLine;
+
+ function GetUpperLineIndex(): Integer;
+
+ constructor Create; overload;
+ constructor Create(ULX,ULY,ULW,ULS,LLX,LLY,LLW,LLS: Real); overload;
+ procedure LoadTextures;
+ destructor Destroy; override;
+ end;
+
+implementation
+
+uses SysUtils,
+ USkins,
+ TextGL,
+ UGraphic,
+ UDisplay,
+ ULog,
+ math,
+ UIni;
+
+//-----------
+//Helper procs to use TRGB in Opengl ...maybe this should be somewhere else
+//-----------
+procedure glColorRGB(Color: TRGB); overload;
+begin
+ glColor3f(Color.R, Color.G, Color.B);
+end;
+
+procedure glColorRGB(Color: TRGB; Alpha: Real); overload;
+begin
+ glColor4f(Color.R, Color.G, Color.B, Alpha);
+end;
+
+procedure glColorRGB(Color: TRGBA); overload;
+begin
+ glColor4f(Color.R, Color.G, Color.B, Color.A);
+end;
+
+procedure glColorRGB(Color: TRGBA; Alpha: Real); overload;
+begin
+ glColor4f(Color.R, Color.G, Color.B, Min(Color.A, Alpha));
+end;
+
+{ TLyricLine }
+
+constructor TLyricLine.Create();
+begin
+ inherited;
+ Reset();
+end;
+
+destructor TLyricLine.Destroy();
+begin
+ SetLength(Words, 0);
+ inherited;
+end;
+
+procedure TLyricLine.Reset();
+begin
+ Start := 0;
+ StartNote := 0;
+ Length := 0;
+ LastLine := False;
+
+ Text := '';
+ Width := 0;
+
+ // duet mode: players of that line (default: all)
+ Players := $FF;
+
+ SetLength(Words, 0);
+ CurWord := -1;
+
+ HasFreestyle := False;
+ CountFreestyle := 0;
+end;
+
+
+{ TLyricEngine }
+
+//---------------
+// Create - Constructor, just get Memory
+//---------------
+constructor TLyricEngine.Create;
+begin
+ inherited;
+
+ BPM := 0;
+ Resolution := 0;
+ LCounter := 0;
+ QueueFull := False;
+
+ UpperLine := TLyricLine.Create;
+ LowerLine := TLyricLine.Create;
+ QueueLine := TLyricLine.Create;
+
+ UseLinearFilter := True;
+ LastDrawBeat := 0;
+end;
+
+constructor TLyricEngine.Create(ULX,ULY,ULW,ULS,LLX,LLY,LLW,LLS:Real);
+begin
+ Create;
+
+ UpperLineX := ULX;
+ UpperLineW := ULW;
+ UpperLineY := ULY;
+ UpperLineSize := Trunc(ULS);
+
+ LowerLineX := LLX;
+ LowerLineW := LLW;
+ LowerLineY := LLY;
+ LowerLineSize := Trunc(LLS);
+
+ LoadTextures;
+end;
+
+
+//---------------
+// Destroy - Frees Memory
+//---------------
+destructor TLyricEngine.Destroy;
+begin
+ UpperLine.Free;
+ LowerLine.Free;
+ QueueLine.Free;
+ inherited;
+end;
+
+//---------------
+// Clear - Clears all cached Song specific Information
+//---------------
+procedure TLyricEngine.Clear(cBPM: Real; cResolution: Integer);
+begin
+ BPM := cBPM;
+ Resolution := cResolution;
+ LCounter := 0;
+ QueueFull := False;
+
+ LastDrawBeat:=0;
+end;
+
+
+//---------------
+// LoadTextures - Load Player Textures and Create Lyric Textures
+//---------------
+procedure TLyricEngine.LoadTextures;
+var
+ I: Integer;
+
+ function CreateLineTex: glUint;
+ begin
+ // generate and bind Texture
+ glGenTextures(1, @Result);
+ glBindTexture(GL_TEXTURE_2D, Result);
+
+ glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE);
+ glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE);
+
+ if UseLinearFilter then
+ begin
+ glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);
+ glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
+ end;
+ end;
+
+begin
+
+ // lyric indicator (bar that indicates when the line start)
+ IndicatorTex := Texture.LoadTexture(Skin.GetTextureFileName('LyricHelpBar'), TEXTURE_TYPE_TRANSPARENT, $FF00FF);
+
+ // ball for current word hover in ball effect
+ BallTex := Texture.LoadTexture(Skin.GetTextureFileName('Ball'), TEXTURE_TYPE_TRANSPARENT, 0);
+
+ // duet mode: load player icon
+ for I := 0 to 5 do
+ begin
+ PlayerIconTex[I][0] := Texture.LoadTexture(Skin.GetTextureFileName('LyricIcon_P' + InttoStr(I+1)), TEXTURE_TYPE_TRANSPARENT, 0);
+ PlayerIconTex[I][1] := Texture.LoadTexture(Skin.GetTextureFileName('LyricIconD_P' + InttoStr(I+1)), TEXTURE_TYPE_TRANSPARENT, 0);
+ end;
+
+ // create line textures
+ UpperLine.Tex := CreateLineTex;
+ LowerLine.Tex := CreateLineTex;
+ QueueLine.Tex := CreateLineTex;
+end;
+
+
+//---------------
+// AddLine - Adds LyricLine to queue
+// The LyricEngine stores three lines in its queue:
+// UpperLine: the upper line displayed in the lyrics
+// LowerLine: the lower line displayed in the lyrics
+// QueueLine: an offscreen line that precedes LowerLine
+// If the queue is full the next call to AddLine will replace UpperLine with
+// LowerLine, LowerLine with QueueLine and QueueLine with the Line parameter.
+//---------------
+procedure TLyricEngine.AddLine(Line: PLine);
+var
+ LyricLine: TLyricLine;
+ PosX: Real;
+ I: Integer;
+ CurWord: PLyricWord;
+ RenderPass: Integer;
+
+ function CalcWidth(LyricLine: TLyricLine): Real;
+ begin
+ Result := glTextWidth(PChar(LyricLine.Text));
+
+ Result := Result + (LyricLine.CountFreestyle * 10);
+
+ // if the line ends with a freestyle not, then leave the place to finish to draw the text italic
+ if (LyricLine.Words[High(LyricLine.Words)].Freestyle) then
+ Result := Result + 12;
+ end;
+
+begin
+ // only add lines, if there is space
+ if not IsQueueFull then
+ begin
+ // set LyricLine to line to write to
+ if (LineCounter = 0) then
+ LyricLine := UpperLine
+ else if (LineCounter = 1) then
+ LyricLine := LowerLine
+ else
+ begin
+ // now the queue is full
+ LyricLine := QueueLine;
+ QueueFull := True;
+ end;
+ end
+ else
+ begin // rotate lines (round-robin-like)
+ LyricLine := UpperLine;
+ UpperLine := LowerLine;
+ LowerLine := QueueLine;
+ QueueLine := LyricLine;
+ end;
+
+ // reset line state
+ LyricLine.Reset();
+
+ // check if sentence has notes
+ if (Line <> nil) and (Length(Line.Note) > 0) then
+ begin
+ // copy values from SongLine to LyricLine
+ LyricLine.Start := Line.Start;
+ LyricLine.StartNote := Line.Note[0].Start;
+ LyricLine.Length := Line.Note[High(Line.Note)].Start +
+ Line.Note[High(Line.Note)].Length -
+ Line.Note[0].Start;
+ LyricLine.LastLine := Line.LastLine;
+
+ // copy words
+ SetLength(LyricLine.Words, Length(Line.Note));
+ for I := 0 to High(Line.Note) do
+ begin
+ LyricLine.Words[I].Start := Line.Note[I].Start;
+ LyricLine.Words[I].Length := Line.Note[I].Length;
+ LyricLine.Words[I].Text := Line.Note[I].Text;
+ LyricLine.Words[I].Freestyle := Line.Note[I].NoteType = ntFreestyle;
+
+ LyricLine.HasFreestyle := LyricLine.HasFreestyle or LyricLine.Words[I].Freestyle;
+ LyricLine.Text := LyricLine.Text + LyricLine.Words[I].Text;
+
+ if (I > 0) and
+ LyricLine.Words[I-1].Freestyle and
+ not LyricLine.Words[I].Freestyle then
+ begin
+ Inc(LyricLine.CountFreestyle);
+ end;
+ end;
+
+ // set font params
+ SetFontStyle(FontStyle);
+ SetFontPos(0, 0);
+ LyricLine.Size := UpperLineSize;
+ SetFontSize(LyricLine.Size);
+ SetFontItalic(False);
+ SetFontReflection(False, 0);
+ glColor4f(1, 1, 1, 1);
+
+ // change fontsize to fit the screen
+ LyricLine.Width := CalcWidth(LyricLine);
+ while (LyricLine.Width > UpperLineW) do
+ begin
+ Dec(LyricLine.Size);
+
+ if (LyricLine.Size <=1) then
+ Break;
+
+ SetFontSize(LyricLine.Size);
+ LyricLine.Width := CalcWidth(LyricLine);
+ end;
+
+ // Offscreen rendering of LyricTexture:
+ // First we will create a white transparent background to draw on.
+ // If the text was simply drawn to the screen with blending, the translucent
+ // parts of the text would be merged with the current color of the background.
+ // This would result in a texture that partly contains the screen we are
+ // drawing on. This will be visible in the fonts outline when the LyricTexture
+ // is drawn to the screen later.
+ // So we have to draw the text in TWO passes.
+ // At the first pass we copy the characters to the back-buffer in such a way
+ // that preceding characters are not repainted by following chars (otherwise
+ // some characters would be blended twice in the 2nd pass).
+ // To achieve this we disable blending and enable the depth-test. The z-buffer
+ // is used as a mask or replacement for the missing stencil-buffer. A z-value
+ // of 1 means the pixel was not assigned yet, whereas 0 stands for a pixel
+ // that was already drawn on. In addition we set the depth-func in such a way
+ // that assigned pixels (0) will not be drawn a second time.
+ // At the second pass we draw the text with blending and without depth-test.
+ // This will blend overlapping characters but not the background as it was
+ // repainted in the first pass.
+
+ glPushAttrib(GL_VIEWPORT_BIT or GL_DEPTH_BUFFER_BIT);
+ glViewPort(0, 0, 800, 600);
+ glClearColor(0, 0, 0, 0);
+ glDepthRange(0, 1);
+ glClearDepth(1);
+ glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
+
+ SetFontZ(0);
+
+ // assure blending is off and the correct depth-func is enabled
+ glDisable(GL_BLEND);
+ glDepthFunc(GL_LESS);
+
+ // we need two passes to draw the font onto the screen.
+ for RenderPass := 0 to 1 do
+ begin
+ if (RenderPass = 0) then
+ begin
+ // first pass: simply copy each character to the screen without overlapping.
+ SetFontBlend(false);
+ glEnable(GL_DEPTH_TEST);
+ end
+ else
+ begin
+ // second pass: now we will blend overlapping characters.
+ SetFontBlend(true);
+ glDisable(GL_DEPTH_TEST);
+ end;
+
+ PosX := 0;
+
+ // set word positions and line size and draw the line to the back-buffer
+ for I := 0 to High(LyricLine.Words) do
+ begin
+ CurWord := @LyricLine.Words[I];
+
+ SetFontItalic(CurWord.Freestyle);
+
+ CurWord.X := PosX;
+
+ // Draw Lyrics
+ SetFontPos(PosX, 0);
+ glPrint(PChar(CurWord.Text));
+
+ CurWord.Width := glTextWidth(PChar(CurWord.Text));
+ if CurWord.Freestyle then
+ begin
+ if (I < High(LyricLine.Words)) and not LyricLine.Words[I+1].Freestyle then
+ CurWord.Width := CurWord.Width + 10
+ else if (I = High(LyricLine.Words)) then
+ CurWord.Width := CurWord.Width + 12;
+ end;
+ PosX := PosX + CurWord.Width;
+ end;
+ end;
+
+ // copy back-buffer to texture
+ glBindTexture(GL_TEXTURE_2D, LyricLine.Tex);
+ // FIXME: this does not work this way
+ glCopyTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, 0, 600-64, 1024, 64, 0);
+ if (glGetError() <> GL_NO_ERROR) then
+ Log.LogError('Creation of Lyrics-texture failed', 'TLyricEngine.AddLine');
+
+ // restore OpenGL state
+ glPopAttrib();
+
+ // clear buffer (use white to avoid flimmering if no cover/video is available)
+ glClearColor(1, 1, 1, 1);
+ glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
+ end; // if (Line <> nil) and (Length(Line.Note) > 0)
+
+ // increase the counter
+ Inc(LCounter);
+end;
+
+
+//---------------
+// Draw - Procedure Draws Lyrics; Beat is curent Beat in Quarters
+// Draw just manage the Lyrics, drawing is done by a call of DrawLyrics
+//---------------
+procedure TLyricEngine.Draw(Beat: Real);
+begin
+ DrawLyrics(Beat);
+ LastDrawBeat := Beat;
+end;
+
+//---------------
+// DrawLyrics(private) - Helper for Draw; main Drawing procedure
+//---------------
+procedure TLyricEngine.DrawLyrics(Beat: Real);
+begin
+ DrawLyricsLine(UpperLineX, UpperLineW, UpperlineY, 15, Upperline, Beat);
+ DrawLyricsLine(LowerLineX, LowerLineW, LowerlineY, 15, Lowerline, Beat);
+end;
+
+//---------------
+// DrawPlayerIcon(private) - Helper for Draw; Draws a Playericon
+//---------------
+procedure TLyricEngine.DrawPlayerIcon(Player: Byte; Enabled: Boolean; X, Y, Size, Alpha: Real);
+var
+ IEnabled: Byte;
+begin
+ if Enabled then
+ IEnabled := 0
+ else
+ IEnabled := 1;
+
+ glEnable(GL_TEXTURE_2D);
+ glEnable(GL_BLEND);
+ glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
+ glBindTexture(GL_TEXTURE_2D, PlayerIconTex[Player][IEnabled].TexNum);
+
+ glColor4f(1, 1, 1, Alpha);
+ glBegin(GL_QUADS);
+ glTexCoord2f(0, 0); glVertex2f(X, Y);
+ glTexCoord2f(0, 1); glVertex2f(X, Y + Size);
+ glTexCoord2f(1, 1); glVertex2f(X + Size, Y + Size);
+ glTexCoord2f(1, 0); glVertex2f(X + Size, Y);
+ glEnd;
+
+ glDisable(GL_BLEND);
+ glDisable(GL_TEXTURE_2D);
+end;
+
+//---------------
+// DrawBall(private) - Helper for Draw; Draws the Ball over the LyricLine if needed
+//---------------
+procedure TLyricEngine.DrawBall(XBall, YBall, Alpha: Real);
+begin
+ glEnable(GL_TEXTURE_2D);
+ glEnable(GL_BLEND);
+ glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
+ glBindTexture(GL_TEXTURE_2D, BallTex.TexNum);
+
+ glColor4f(1, 1, 1, Alpha);
+ glBegin(GL_QUADS);
+ glTexCoord2f(0, 0); glVertex2f(XBall - 10, YBall);
+ glTexCoord2f(0, 1); glVertex2f(XBall - 10, YBall + 20);
+ glTexCoord2f(1, 1); glVertex2f(XBall + 10, YBall + 20);
+ glTexCoord2f(1, 0); glVertex2f(XBall + 10, YBall);
+ glEnd;
+
+ glDisable(GL_BLEND);
+ glDisable(GL_TEXTURE_2D);
+end;
+
+//---------------
+// DrawLyricsLine(private) - Helper for Draw; Draws one LyricLine
+//---------------
+procedure TLyricEngine.DrawLyricsLine(X, W, Y: Real; Size: Byte; Line: TLyricLine; Beat: Real);
+var
+ CurWordStart, CurWordEnd: Real; // screen coordinates of current word and the rest of the sentence
+ FreestyleDiff: Integer; // difference between top and bottom coordiantes for freestyle lyrics
+ Progress: Real; // progress of singing the current word
+ LyricX: Real; // left
+ LyricX2: Real; // right
+ LyricY: Real; // top
+ LyricsHeight: Real; // height the lyrics are displayed
+ Alpha: Real; // alphalevel to fade out at end
+ CurWord, LastWord: PLyricWord; // current word
+
+ {// duet mode
+ IconSize: Real; // size of player icons
+ IconAlpha: Real; // alpha level of player icons
+ }
+begin
+ // do not draw empty lines
+ // Note: lines with no words in it do not have a valid texture
+ if (Length(Line.Words) = 0) or
+ (Line.Width <= 0) then
+ begin
+ Exit;
+ end;
+
+ // this is actually a bit more than the real font size
+ // it helps adjusting the "zoom-center"
+ LyricsHeight := 30.5 * (Line.Size/10);
+
+ {
+ // duet mode
+ IconSize := (2 * Size);
+ IconAlpha := Frac(Beat/(Resolution*4));
+
+ DrawPlayerIcon (0, True, X, Y + (42 - IconSize) / 2 , IconSize, IconAlpha);
+ DrawPlayerIcon (1, True, X + IconSize + 1, Y + (42 - IconSize) / 2, IconSize, IconAlpha);
+ DrawPlayerIcon (2, True, X + (IconSize + 1)*2, Y + (42 - IconSize) / 2, IconSize, IconAlpha);
+ }
+
+ LyricX := X + W/2 - Line.Width/2;
+ LyricX2 := LyricX + Line.Width;
+
+ // maybe center smaller lines
+ //LyricY := Y;
+ LyricY := Y + ((Size / Line.Size - 1) * LyricsHeight) / 2;
+
+ Alpha := 1;
+
+ // check if this line is active (at least its first note must be active)
+ if (Beat >= Line.StartNote) then
+ begin
+ // if this line just got active, CurWord is -1,
+ // this means we should try to make the first word active
+ if (Line.CurWord = -1) then
+ Line.CurWord := 0;
+
+ // check if the current active word is still active.
+ // Otherwise proceed to the next word if there is one in this line.
+ // Note: the max. value of Line.CurWord is High(Line.Words)
+ if (Line.CurWord < High(Line.Words)) and
+ (Beat >= Line.Words[Line.CurWord + 1].Start) then
+ begin
+ Inc(Line.CurWord);
+ end;
+
+ FreestyleDiff := 0;
+
+ // determine current and last word in this line.
+ // If the end of the line is reached use the last word as current word.
+ LastWord := @Line.Words[High(Line.Words)];
+ CurWord := @Line.Words[Line.CurWord];
+
+ // calc the progress of the lyrics effect
+ Progress := (Beat - CurWord.Start) / CurWord.Length;
+ if Progress >= 1 then
+ Progress := 1;
+ if Progress <= 0 then
+ Progress := 0;
+
+ // last word of this line finished, but this line did not hide -> fade out
+ if Line.LastLine and
+ (Beat > LastWord.Start + LastWord.Length) then
+ begin
+ Alpha := 1 - (Beat - (LastWord.Start + LastWord.Length)) / 15;
+ if (Alpha < 0) then
+ Alpha := 0;
+ end;
+
+ // determine the start-/end positions of the fragment of the current word
+ CurWordStart := CurWord.X;
+ CurWordEnd := CurWord.X + CurWord.Width;
+
+ // Slide Effect
+ // simply paint the active texture to the current position
+ if Ini.LyricsEffect = 2 then
+ begin
+ CurWordStart := CurWordStart + CurWord.Width * Progress;
+ CurWordEnd := CurWordStart;
+ end;
+
+ if CurWord.Freestyle then
+ begin
+ if (Line.CurWord < High(Line.Words)) and
+ (not Line.Words[Line.CurWord + 1].Freestyle) then
+ begin
+ FreestyleDiff := 2;
+ end
+ else
+ begin
+ FreestyleDiff := 12;
+ CurWordStart := CurWordStart - 1;
+ CurWordEnd := CurWordEnd - 2;
+ end;
+ end;
+
+ glEnable(GL_BLEND);
+ glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
+ glEnable(GL_TEXTURE_2D);
+ glBindTexture(GL_TEXTURE_2D, Line.Tex);
+
+ // draw sentence up to current word
+ // type 0: simple lyric effect
+ // type 3: ball lyric effect
+ // type 4: shift lyric effect
+ if (Ini.LyricsEffect in [0, 3, 4]) then
+ // ball lyric effect - only highlight current word and not that ones before in this line
+ glColorRGB(LineColor_en, Alpha)
+ else
+ glColorRGB(LineColor_act, Alpha);
+
+ glBegin(GL_QUADS);
+ glTexCoord2f(0, 1);
+ glVertex2f(LyricX, LyricY);
+
+ glTexCoord2f(0, 1-LyricsHeight/64);
+ glVertex2f(LyricX, LyricY + LyricsHeight);
+
+ glTexCoord2f(CurWordStart/1024, 1-LyricsHeight/64);
+ glVertex2f(LyricX + CurWordStart, LyricY + LyricsHeight);
+
+ glTexCoord2f((CurWordStart + FreestyleDiff)/1024, 1);
+ glVertex2f(LyricX + CurWordStart + FreestyleDiff, LyricY);
+ glEnd;
+
+ // draw rest of sentence
+ glColorRGB(LineColor_en, Alpha);
+ glBegin(GL_QUADS);
+ glTexCoord2f((CurWordEnd + FreestyleDiff)/1024, 1);
+ glVertex2f(LyricX + CurWordEnd + FreestyleDiff, LyricY);
+
+ glTexCoord2f(CurWordEnd/1024, 1-LyricsHeight/64);
+ glVertex2f(LyricX + CurWordEnd, LyricY + LyricsHeight);
+
+ glTexCoord2f(Line.Width/1024, 1-LyricsHeight/64);
+ glVertex2f(LyricX2, LyricY + LyricsHeight);
+
+ glTexCoord2f(Line.Width/1024, 1);
+ glVertex2f(LyricX2, LyricY);
+ glEnd;
+
+ // draw active word:
+ // type 0: simple lyric effect
+ // type 3: ball lyric effect
+ // type 4: shift lyric effect
+ // only change the color of the current word
+ if (Ini.LyricsEffect in [0, 3, 4]) then
+ begin
+ if (Ini.LyricsEffect = 4) then
+ LyricY := LyricY - 8 * (1-Progress);
+
+ glColor4f(LineColor_act.r, LineColor_act.g, LineColor_act.b, Alpha);
+ glBegin(GL_QUADS);
+ glTexCoord2f((CurWordStart + FreestyleDiff)/1024, 1);
+ glVertex2f(LyricX + CurWordStart + FreestyleDiff, LyricY);
+
+ glTexCoord2f(CurWordStart/1024, 0);
+ glVertex2f(LyricX + CurWordStart, LyricY + 64);
+
+ glTexCoord2f(CurWordEnd/1024, 0);
+ glVertex2f(LyricX + CurWordEnd, LyricY + 64);
+
+ glTexCoord2f((CurWordEnd + FreestyleDiff)/1024, 1);
+ glVertex2f(LyricX + CurWordEnd + FreestyleDiff, LyricY);
+ glEnd;
+
+ if (Ini.LyricsEffect = 4) then
+ LyricY := LyricY + 8 * (1-Progress);
+ end
+
+ // draw active word:
+ // type 1: zoom lyric effect
+ // change color and zoom current word
+ else if Ini.LyricsEffect = 1 then
+ begin
+ glPushMatrix;
+
+ glTranslatef(LyricX + CurWordStart + (CurWordEnd-CurWordStart)/2,
+ LyricY + LyricsHeight/2, 0);
+
+ // set current zoom factor
+ glScalef(1.0 + (1-Progress) * 0.5, 1.0 + (1-Progress) * 0.5, 1.0);
+
+ glColor4f(LineColor_act.r, LineColor_act.g, LineColor_act.b, Alpha);
+ glBegin(GL_QUADS);
+ glTexCoord2f((CurWordStart + FreestyleDiff)/1024, 1);
+ glVertex2f(-(CurWordEnd-CurWordStart)/2 + FreestyleDiff, -LyricsHeight/2);
+
+ glTexCoord2f(CurWordStart/1024, 1-LyricsHeight/64);
+ glVertex2f(-(CurWordEnd-CurWordStart)/2, LyricsHeight/2);
+
+ glTexCoord2f(CurWordEnd/1024, 1-LyricsHeight/64);
+ glVertex2f((CurWordEnd-CurWordStart)/2, LyricsHeight/2);
+
+ glTexCoord2f((CurWordEnd + FreestyleDiff)/1024, 1);
+ glVertex2f((CurWordEnd-CurWordStart)/2 + FreestyleDiff, -LyricsHeight/2);
+ glEnd;
+
+ glPopMatrix;
+ end;
+
+ glDisable(GL_TEXTURE_2D);
+ glDisable(GL_BLEND);
+
+ // type 3: ball lyric effect
+ if Ini.LyricsEffect = 3 then
+ begin
+ DrawBall(LyricX + CurWordStart + (CurWordEnd-CurWordStart) * Progress,
+ LyricY - 15 - 15*sin(Progress * Pi), Alpha);
+ end;
+ end
+ else
+ begin
+ // this section is called if the whole line can be drawn at once and no
+ // word has to be emphasized.
+
+ glEnable(GL_TEXTURE_2D);
+ glEnable(GL_BLEND);
+ glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
+ glBindTexture(GL_TEXTURE_2D, Line.Tex);
+
+ // enable the upper, disable the lower line
+ if (Line = UpperLine) then
+ glColorRGB(LineColor_en)
+ else
+ glColorRGB(LineColor_dis);
+
+ glBegin(GL_QUADS);
+ glTexCoord2f(0, 1);
+ glVertex2f(LyricX, LyricY);
+
+ glTexCoord2f(0, 1-LyricsHeight/64);
+ glVertex2f(LyricX, LyricY + LyricsHeight);
+
+ glTexCoord2f(Line.Width/1024, 1-LyricsHeight/64);
+ glVertex2f(LyricX2, LyricY + LyricsHeight);
+
+ glTexCoord2f(Line.Width/1024, 1);
+ glVertex2f(LyricX2, LyricY);
+ glEnd;
+
+ glDisable(GL_BLEND);
+ glDisable(GL_TEXTURE_2D);
+ end;
+end;
+
+//---------------
+// GetUpperLine() - Returns a reference to the upper line
+//---------------
+function TLyricEngine.GetUpperLine(): TLyricLine;
+begin
+ Result := UpperLine;
+end;
+
+//---------------
+// GetLowerLine() - Returns a reference to the lower line
+//---------------
+function TLyricEngine.GetLowerLine(): TLyricLine;
+begin
+ Result := LowerLine;
+end;
+
+//---------------
+// GetUpperLineIndex() - Returns the index of the upper line
+//---------------
+function TLyricEngine.GetUpperLineIndex(): Integer;
+const
+ QUEUE_SIZE = 3;
+begin
+ // no line in queue
+ if (LineCounter <= 0) then
+ Result := -1
+ // no line has been removed from queue yet
+ else if (LineCounter <= QUEUE_SIZE) then
+ Result := 0
+ // lines have been removed from queue already
+ else
+ Result := LineCounter - QUEUE_SIZE;
+end;
+
+end.
+
diff --git a/src/base/UMain.pas b/src/base/UMain.pas
new file mode 100644
index 00000000..5dacd5f8
--- /dev/null
+++ b/src/base/UMain.pas
@@ -0,0 +1,1107 @@
+unit UMain;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+uses
+ SysUtils,
+ Classes,
+ SDL,
+ UMusic,
+ URecord,
+ UTime,
+ UDisplay,
+ UIni,
+ ULog,
+ ULyrics,
+ UScreenSing,
+ USong,
+ gl;
+
+type
+ PPLayerNote = ^TPlayerNote;
+ TPlayerNote = record
+ Start: integer;
+ Length: integer;
+ Detect: real; // accurate place, detected in the note
+ Tone: real;
+ Perfect: boolean; // true if the note matches the original one, lit the star
+ Hit: boolean; // true if the note Hits the Line
+ end;
+
+ PPLayer = ^TPlayer;
+ TPlayer = record
+ Name: string;
+
+ // Index in Teaminfo record
+ TeamID: Byte;
+ PlayerID: Byte;
+
+ // Scores
+ Score: real;
+ ScoreLine: real;
+ ScoreGolden: real;
+
+ ScoreInt: integer;
+ ScoreLineInt: integer;
+ ScoreGoldenInt: integer;
+ ScoreTotalInt: integer;
+
+ // LineBonus
+ ScoreLast: Real;//Last Line Score
+
+ // PerfectLineTwinkle (effect)
+ LastSentencePerfect: Boolean;
+
+ HighNote: integer; // index of last note (= High(Note)?)
+ LengthNote: integer; // number of notes (= Length(Note)?).
+ Note: array of TPlayerNote;
+ end;
+
+
+var
+ // Absolute Paths
+ GamePath: string;
+ SoundPath: string;
+ SongPaths: TStringList;
+ LogPath: string;
+ ThemePath: string;
+ SkinsPath: string;
+ ScreenshotsPath: string;
+ CoverPaths: TStringList;
+ LanguagesPath: string;
+ PluginPath: string;
+ VisualsPath: string;
+ ResourcesPath: string;
+ PlayListPath: string;
+
+ Done: Boolean;
+ Event: TSDL_event;
+ // FIXME: ConversionFileName should not be global
+ ConversionFileName: string;
+ Restart: boolean;
+
+ // player and music info
+ Player: array of TPlayer;
+ PlayersPlay: integer;
+
+ CurrentSong : TSong;
+
+const
+ MAX_SONG_SCORE = 10000; // max. achievable points per song
+ MAX_SONG_LINE_BONUS = 1000; // max. achievable line bonus per song
+
+function FindPath(out PathResult: string; const RequestedPath: string; NeedsWritePermission: boolean): boolean;
+procedure InitializePaths;
+procedure AddSongPath(const Path: string);
+
+Procedure Main;
+procedure MainLoop;
+procedure CheckEvents;
+procedure Sing(Screen: TScreenSing);
+procedure NewSentence(Screen: TScreenSing);
+procedure NewBeatClick(Screen: TScreenSing); // executed when on then new beat for click
+procedure NewBeatDetect(Screen: TScreenSing); // executed when on then new beat for detection
+procedure NewNote(Screen: TScreenSing); // detect note
+function GetMidBeat(Time: real): real;
+function GetTimeFromBeat(Beat: integer): real;
+procedure ClearScores(PlayerNum: integer);
+
+implementation
+
+uses
+ Math,
+ StrUtils,
+ USongs,
+ UJoystick,
+ UCommandLine,
+ ULanguage,
+ //SDL_ttf,
+ USkins,
+ UCovers,
+ UCatCovers,
+ UDataBase,
+ UPlaylist,
+ UDLLManager,
+ UParty,
+ UConfig,
+ UCore,
+ UCommon,
+ UGraphic,
+ UGraphicClasses,
+ UPluginDefs,
+ UPlatform,
+ UThemes;
+
+
+
+
+procedure Main;
+var
+ WndTitle: string;
+begin
+ try
+ WndTitle := USDXVersionStr;
+
+ Platform.Init;
+
+ if Platform.TerminateIfAlreadyRunning(WndTitle) then
+ Exit;
+
+ // fix floating-point exceptions (FPE)
+ DisableFloatingPointExceptions();
+ // fix the locale for string-to-float parsing in C-libs
+ SetDefaultNumericLocale();
+
+ // setup separators for parsing
+ // Note: ThousandSeparator must be set because of a bug in TIniFile.ReadFloat
+ ThousandSeparator := ',';
+ DecimalSeparator := '.';
+
+ //------------------------------
+ //StartUp - Create Classes and Load Files
+ //------------------------------
+
+ // Initialize SDL
+ // Without SDL_INIT_TIMER SDL_GetTicks() might return strange values
+ SDL_Init(SDL_INIT_VIDEO or SDL_INIT_TIMER);
+ SDL_EnableUnicode(1);
+
+ USTime := TTime.Create;
+ VideoBGTimer := TRelativeTimer.Create;
+
+ // Commandline Parameter Parser
+ Params := TCMDParams.Create;
+
+ // Log + Benchmark
+ Log := TLog.Create;
+ Log.Title := WndTitle;
+ Log.FileOutputEnabled := not Params.NoLog;
+ Log.BenchmarkStart(0);
+
+ // Language
+ Log.BenchmarkStart(1);
+ Log.LogStatus('Initialize Paths', 'Initialization');
+ InitializePaths;
+ Log.LogStatus('Load Language', 'Initialization');
+ Language := TLanguage.Create;
+
+ // Add Const Values:
+ Language.AddConst('US_VERSION', USDXVersionStr);
+ Log.BenchmarkEnd(1);
+ Log.LogBenchmark('Loading Language', 1);
+
+ {
+ // SDL_ttf (Not used yet, maybe in version 1.5)
+ Log.BenchmarkStart(1);
+ Log.LogStatus('Initialize SDL_ttf', 'Initialization');
+ TTF_Init();
+ Log.BenchmarkEnd(1);
+ Log.LogBenchmark('Initializing SDL_ttf', 1);
+ }
+
+ // Skin
+ Log.BenchmarkStart(1);
+ Log.LogStatus('Loading Skin List', 'Initialization');
+ Skin := TSkin.Create;
+ Log.BenchmarkEnd(1);
+ Log.LogBenchmark('Loading Skin List', 1);
+
+ // Ini + Paths
+ Log.BenchmarkStart(1);
+ Log.LogStatus('Load Ini', 'Initialization');
+ Ini := TIni.Create;
+ Ini.Load;
+
+ //it's possible that this is the first run, create a .ini file if neccessary
+ Log.LogStatus('Write Ini', 'Initialization');
+ Ini.Save;
+
+ // Load Languagefile
+ if (Params.Language <> -1) then
+ Language.ChangeLanguage(ILanguage[Params.Language])
+ else
+ Language.ChangeLanguage(ILanguage[Ini.Language]);
+
+ Log.BenchmarkEnd(1);
+ Log.LogBenchmark('Loading Ini', 1);
+
+ // Sound
+ Log.BenchmarkStart(1);
+ Log.LogStatus('Initialize Sound', 'Initialization');
+ InitializeSound();
+ Log.BenchmarkEnd(1);
+ Log.LogBenchmark('Initializing Sound', 1);
+
+ // Lyrics-engine with media reference timer
+ LyricsState := TLyricsState.Create();
+
+ // Theme
+ Log.BenchmarkStart(1);
+ Log.LogStatus('Load Themes', 'Initialization');
+ Theme := TTheme.Create(ThemePath + ITheme[Ini.Theme] + '.ini', Ini.Color);
+ Log.BenchmarkEnd(1);
+ Log.LogBenchmark('Loading Themes', 1);
+
+ // Covers Cache
+ Log.BenchmarkStart(1);
+ Log.LogStatus('Creating Covers Cache', 'Initialization');
+ Covers := TCoverDatabase.Create;
+ Log.LogBenchmark('Loading Covers Cache Array', 1);
+ Log.BenchmarkStart(1);
+
+ // Category Covers
+ Log.BenchmarkStart(1);
+ Log.LogStatus('Creating Category Covers Array', 'Initialization');
+ CatCovers:= TCatCovers.Create;
+ Log.BenchmarkEnd(1);
+ Log.LogBenchmark('Loading Category Covers Array', 1);
+
+ // Songs
+ //Log.BenchmarkStart(1);
+ Log.LogStatus('Creating Song Array', 'Initialization');
+ Songs := TSongs.Create;
+ //Songs.LoadSongList;
+
+ Log.LogStatus('Creating 2nd Song Array', 'Initialization');
+ CatSongs := TCatSongs.Create;
+
+ Log.BenchmarkEnd(1);
+ Log.LogBenchmark('Loading Songs', 1);
+
+ // PluginManager
+ Log.BenchmarkStart(1);
+ Log.LogStatus('PluginManager', 'Initialization');
+ DLLMan := TDLLMan.Create; // Load PluginList
+ Log.BenchmarkEnd(1);
+ Log.LogBenchmark('Loading PluginManager', 1);
+
+ {// Party Mode Manager
+ Log.BenchmarkStart(1);
+ Log.LogStatus('PartySession Manager', 'Initialization');
+ PartySession := TPartySession.Create; //Load PartySession
+
+ Log.BenchmarkEnd(1);
+ Log.LogBenchmark('Loading PartySession Manager', 1); }
+
+ // Graphics
+ Log.BenchmarkStart(1);
+ Log.LogStatus('Initialize 3D', 'Initialization');
+ Initialize3D(WndTitle);
+ Log.BenchmarkEnd(1);
+ Log.LogBenchmark('Initializing 3D', 1);
+
+ // Score Saving System
+ Log.BenchmarkStart(1);
+ Log.LogStatus('DataBase System', 'Initialization');
+ DataBase := TDataBaseSystem.Create;
+
+ if (Params.ScoreFile = '') then
+ DataBase.Init (Platform.GetGameUserPath + 'Ultrastar.db')
+ else
+ DataBase.Init (Params.ScoreFile);
+
+ Log.BenchmarkEnd(1);
+ Log.LogBenchmark('Loading DataBase System', 1);
+
+ // Playlist Manager
+ Log.BenchmarkStart(1);
+ Log.LogStatus('Playlist Manager', 'Initialization');
+ PlaylistMan := TPlaylistManager.Create;
+ Log.BenchmarkEnd(1);
+ Log.LogBenchmark('Loading Playlist Manager', 1);
+
+ // GoldenStarsTwinkleMod
+ Log.BenchmarkStart(1);
+ Log.LogStatus('Effect Manager', 'Initialization');
+ GoldenRec := TEffectManager.Create;
+ Log.BenchmarkEnd(1);
+ Log.LogBenchmark('Loading Particle System', 1);
+
+ // Joypad
+ if (Ini.Joypad = 1) OR (Params.Joypad) then
+ begin
+ Log.BenchmarkStart(1);
+ Log.LogStatus('Initialize Joystick', 'Initialization');
+ Joy := TJoy.Create;
+ Log.BenchmarkEnd(1);
+ Log.LogBenchmark('Initializing Joystick', 1);
+ end;
+
+ Log.BenchmarkEnd(0);
+ Log.LogBenchmark('Loading Time', 0);
+
+ Log.LogStatus('Creating Core', 'Initialization');
+ {Core := TCore.Create(
+ USDXShortVersionStr,
+ MakeVersion(USDX_VERSION_MAJOR,
+ USDX_VERSION_MINOR,
+ USDX_VERSION_RELEASE,
+ chr(0))
+ ); }
+
+ Log.LogStatus('Running Core', 'Initialization');
+ //Core.Run;
+
+ //------------------------------
+ //Start- Mainloop
+ //------------------------------
+ Log.LogStatus('Main Loop', 'Initialization');
+ MainLoop;
+
+ finally
+ //------------------------------
+ //Finish Application
+ //------------------------------
+
+ // TODO:
+ // call an uninitialize routine for every initialize step
+ // or at least use the corresponding Free-Methods
+
+ FinalizeMedia();
+
+ //TTF_Quit();
+ SDL_Quit();
+
+ if assigned(Log) then
+ begin
+ Log.LogStatus('Main Loop', 'Finished');
+ Log.Free;
+ end;
+ end;
+end;
+
+procedure MainLoop;
+var
+ Delay: integer;
+const
+ MAX_FPS = 100;
+begin
+ Delay := 0;
+ SDL_EnableKeyRepeat(125, 125);
+
+ CountSkipTime(); // JB - for some reason this seems to be needed when we use the SDL Timer functions.
+ while not Done do
+ begin
+ // joypad
+ if (Ini.Joypad = 1) or (Params.Joypad) then
+ Joy.Update;
+
+ // keyboard events
+ CheckEvents;
+
+ // display
+ done := not Display.Draw;
+ SwapBuffers;
+
+ // delay
+ CountMidTime;
+
+ Delay := Floor(1000 / MAX_FPS - 1000 * TimeMid);
+
+ if Delay >= 1 then
+ SDL_Delay(Delay); // dynamic, maximum is 100 fps
+
+ CountSkipTime;
+
+ // reinitialization of graphics
+ if Restart then
+ begin
+ Reinitialize3D;
+ Restart := false;
+ end;
+
+ end;
+End;
+
+procedure CheckEvents;
+begin
+ if Assigned(Display.NextScreen) then
+ Exit;
+
+ while SDL_PollEvent( @event ) = 1 do
+ begin
+ case Event.type_ of
+ SDL_QUITEV:
+ begin
+ Display.Fade := 0;
+ Display.NextScreenWithCheck := nil;
+ Display.CheckOK := True;
+ end;
+ {
+ SDL_MOUSEBUTTONDOWN:
+ with Event.button Do
+ begin
+ if State = SDL_BUTTON_LEFT Then
+ begin
+ //
+ end;
+ end;
+ }
+ SDL_VIDEORESIZE:
+ begin
+ ScreenW := Event.resize.w;
+ ScreenH := Event.resize.h;
+ // Note: do NOT call SDL_SetVideoMode on Windows and MacOSX here.
+ // This would create a new OpenGL render-context and all texture data
+ // would be invalidated.
+ // On Linux the mode MUST be resetted, otherwise graphics will be corrupted.
+ {$IFDEF LINUX}
+ if boolean( Ini.FullScreen ) then
+ SDL_SetVideoMode(ScreenW, ScreenH, (Ini.Depth+1) * 16, SDL_OPENGL or SDL_FULLSCREEN)
+ else
+ SDL_SetVideoMode(ScreenW, ScreenH, (Ini.Depth+1) * 16, SDL_OPENGL or SDL_RESIZABLE);
+ {$ENDIF}
+ end;
+ SDL_KEYDOWN:
+ begin
+ // remap the "keypad enter" key to the "standard enter" key
+ if (Event.key.keysym.sym = SDLK_KP_ENTER) then
+ Event.key.keysym.sym := SDLK_RETURN;
+
+ if (Event.key.keysym.sym = SDLK_F11) or
+ ((Event.key.keysym.sym = SDLK_RETURN) and
+ ((Event.key.keysym.modifier and KMOD_ALT) <> 0)) then // toggle full screen
+ begin
+ Ini.FullScreen := integer( not boolean( Ini.FullScreen ) );
+
+ // FIXME: SDL_SetVideoMode creates a new OpenGL RC so we have to
+ // reload all texture data (-> whitescreen bug).
+ // Only Linux is able to handle screen-switching this way.
+ {$IFDEF LINUX}
+ if boolean( Ini.FullScreen ) then
+ begin
+ SDL_SetVideoMode(ScreenW, ScreenH, (Ini.Depth+1) * 16, SDL_OPENGL or SDL_FULLSCREEN);
+ SDL_ShowCursor(0);
+ end
+ else
+ begin
+ SDL_SetVideoMode(ScreenW, ScreenH, (Ini.Depth+1) * 16, SDL_OPENGL or SDL_RESIZABLE);
+ SDL_ShowCursor(1);
+ end;
+
+ glViewPort(0, 0, ScreenW, ScreenH);
+ {$ENDIF}
+ end
+ // if print is pressed -> make screenshot and save to screenshot path
+ else if (Event.key.keysym.sym = SDLK_SYSREQ) or (Event.key.keysym.sym = SDLK_PRINT) then
+ Display.SaveScreenShot
+ // if there is a visible popup then let it handle input instead of underlying screen
+ // shoud be done in a way to be sure the topmost popup has preference (maybe error, then check)
+ else if (ScreenPopupError <> nil) and (ScreenPopupError.Visible) then
+ done := not ScreenPopupError.ParseInput(Event.key.keysym.sym, WideChar(Event.key.keysym.unicode), True)
+ else if (ScreenPopupCheck <> nil) and (ScreenPopupCheck.Visible) then
+ done := not ScreenPopupCheck.ParseInput(Event.key.keysym.sym, WideChar(Event.key.keysym.unicode), True)
+ else
+ begin
+ // check if screen wants to exit
+ done := not Display.CurrentScreen^.ParseInput(Event.key.keysym.sym, WideChar(Event.key.keysym.unicode), True);
+
+ // if screen wants to exit
+ if done then
+ begin
+ // if question option is enabled then show exit popup
+ if (Ini.AskbeforeDel = 1) then
+ begin
+ Display.CurrentScreen^.CheckFadeTo(nil,'MSG_QUIT_USDX');
+ end
+ else // if ask-for-exit is disabled then simply exit
+ begin
+ Display.Fade := 0;
+ Display.NextScreenWithCheck := nil;
+ Display.CheckOK := True;
+ end;
+ end;
+
+ end;
+ end;
+ SDL_JOYAXISMOTION:
+ begin
+ // not implemented
+ end;
+ SDL_JOYBUTTONDOWN:
+ begin
+ // not implemented
+ end;
+ end; // case
+ end; // while
+end;
+
+function GetTimeForBeats(BPM, Beats: real): real;
+begin
+ Result := 60 / BPM * Beats;
+end;
+
+function GetBeats(BPM, msTime: real): real;
+begin
+ Result := BPM * msTime / 60;
+end;
+
+procedure GetMidBeatSub(BPMNum: integer; var Time: real; var CurBeat: real);
+var
+ NewTime: real;
+begin
+ if High(CurrentSong.BPM) = BPMNum then
+ begin
+ // last BPM
+ CurBeat := CurrentSong.BPM[BPMNum].StartBeat + GetBeats(CurrentSong.BPM[BPMNum].BPM, Time);
+ Time := 0;
+ end
+ else
+ begin
+ // not last BPM
+ // count how much time is it for start of the new BPM and store it in NewTime
+ NewTime := GetTimeForBeats(CurrentSong.BPM[BPMNum].BPM, CurrentSong.BPM[BPMNum+1].StartBeat - CurrentSong.BPM[BPMNum].StartBeat);
+
+ // compare it to remaining time
+ if (Time - NewTime) > 0 then
+ begin
+ // there is still remaining time
+ CurBeat := CurrentSong.BPM[BPMNum].StartBeat;
+ Time := Time - NewTime;
+ end
+ else
+ begin
+ // there is no remaining time
+ CurBeat := CurrentSong.BPM[BPMNum].StartBeat + GetBeats(CurrentSong.BPM[BPMNum].BPM, Time);
+ Time := 0;
+ end; // if
+ end; // if
+end;
+
+function GetMidBeat(Time: real): real;
+var
+ CurBeat: real;
+ CurBPM: integer;
+begin
+ // static BPM
+ if Length(CurrentSong.BPM) = 1 then
+ begin
+ Result := Time * CurrentSong.BPM[0].BPM / 60;
+ end
+ // variable BPM
+ else if Length(CurrentSong.BPM) > 1 then
+ begin
+ CurBeat := 0;
+ CurBPM := 0;
+ while (Time > 0) do
+ begin
+ GetMidBeatSub(CurBPM, Time, CurBeat);
+ Inc(CurBPM);
+ end;
+
+ Result := CurBeat;
+ end
+ // invalid BPM
+ else
+ begin
+ Result := 0;
+ end;
+end;
+
+function GetTimeFromBeat(Beat: integer): real;
+var
+ CurBPM: integer;
+begin
+ // static BPM
+ if Length(CurrentSong.BPM) = 1 then
+ begin
+ Result := CurrentSong.GAP / 1000 + Beat * 60 / CurrentSong.BPM[0].BPM;
+ end
+ // variable BPM
+ else if Length(CurrentSong.BPM) > 1 then
+ begin
+ Result := CurrentSong.GAP / 1000;
+ CurBPM := 0;
+ while (CurBPM <= High(CurrentSong.BPM)) and
+ (Beat > CurrentSong.BPM[CurBPM].StartBeat) do
+ begin
+ if (CurBPM < High(CurrentSong.BPM)) and
+ (Beat >= CurrentSong.BPM[CurBPM+1].StartBeat) then
+ begin
+ // full range
+ Result := Result + (60 / CurrentSong.BPM[CurBPM].BPM) *
+ (CurrentSong.BPM[CurBPM+1].StartBeat - CurrentSong.BPM[CurBPM].StartBeat);
+ end;
+
+ if (CurBPM = High(CurrentSong.BPM)) or
+ (Beat < CurrentSong.BPM[CurBPM+1].StartBeat) then
+ begin
+ // in the middle
+ Result := Result + (60 / CurrentSong.BPM[CurBPM].BPM) *
+ (Beat - CurrentSong.BPM[CurBPM].StartBeat);
+ end;
+ Inc(CurBPM);
+ end;
+
+ {
+ while (Time > 0) do
+ begin
+ GetMidBeatSub(CurBPM, Time, CurBeat);
+ Inc(CurBPM);
+ end;
+ }
+ end
+ // invalid BPM
+ else
+ begin
+ Result := 0;
+ end;
+end;
+
+procedure Sing(Screen: TScreenSing);
+var
+ Count: integer;
+ CountGr: integer;
+ CP: integer;
+ Done: real;
+ N: integer;
+ CurLine: PLine;
+ CurNote: PLineFragment;
+begin
+ LyricsState.UpdateBeats();
+
+ // sentences routines
+ for CountGr := 0 to 0 do //High(Lines)
+ begin;
+ CP := CountGr;
+ // old parts
+ LyricsState.OldLine := Lines[CP].Current;
+
+ // choose current parts
+ for Count := 0 to Lines[CP].High do
+ begin
+ if LyricsState.CurrentBeat >= Lines[CP].Line[Count].Start then
+ Lines[CP].Current := Count;
+ end;
+
+ // clean player note if there is a new line
+ // (optimization on halfbeat time)
+ if Lines[CP].Current <> LyricsState.OldLine then
+ NewSentence(Screen);
+
+ end; // for CountGr
+
+ // make some operations on clicks
+ if {(LyricsState.CurrentBeatC >= 0) and }(LyricsState.OldBeatC <> LyricsState.CurrentBeatC) then
+ NewBeatClick(Screen);
+
+ // make some operations when detecting new voice pitch
+ if (LyricsState.CurrentBeatD >= 0) and (LyricsState.OldBeatD <> LyricsState.CurrentBeatD) then
+ NewBeatDetect(Screen);
+
+ CurLine := @Lines[0].Line[Lines[0].Current];
+
+ // remove moving text
+ Done := 1;
+ for N := 0 to CurLine.HighNote do
+ begin
+ CurNote := @CurLine.Note[N];
+ if (CurNote.Start <= LyricsState.MidBeat) and
+ (CurNote.Start + CurNote.Length >= LyricsState.MidBeat) then
+ begin
+ Done := (LyricsState.MidBeat - CurNote.Start) / CurNote.Length;
+ end;
+ end;
+end;
+
+procedure NewSentence(Screen: TScreenSing);
+var
+ i: Integer;
+begin
+ // clean note of player
+ for i := 0 to High(Player) do
+ begin
+ Player[i].LengthNote := 0;
+ Player[i].HighNote := -1;
+ SetLength(Player[i].Note, 0);
+ end;
+
+ // on sentence change...
+ Screen.onSentenceChange(Lines[0].Current);
+end;
+
+procedure NewBeatClick;
+var
+ Count: integer;
+begin
+ // beat click
+ if ((Ini.BeatClick = 1) and
+ ((LyricsState.CurrentBeatC + Lines[0].Resolution + Lines[0].NotesGAP) mod Lines[0].Resolution = 0)) then
+ begin
+ AudioPlayback.PlaySound(SoundLib.Click);
+ end;
+
+ for Count := 0 to Lines[0].Line[Lines[0].Current].HighNote do
+ begin
+ if (Lines[0].Line[Lines[0].Current].Note[Count].Start = LyricsState.CurrentBeatC) then
+ begin
+ // click assist
+ if Ini.ClickAssist = 1 then
+ AudioPlayback.PlaySound(SoundLib.Click);
+
+ // drum machine
+ (*
+ TempBeat := LyricsState.CurrentBeat;// + 2;
+ if (TempBeat mod 8 = 0) then Music.PlayDrum;
+ if (TempBeat mod 8 = 4) then Music.PlayClap;
+ //if (TempBeat mod 4 = 2) then Music.PlayHihat;
+ if (TempBeat mod 4 <> 0) then Music.PlayHihat;
+ *)
+ end;
+ end;
+end;
+
+procedure NewBeatDetect(Screen: TScreenSing);
+begin
+ NewNote(Screen);
+end;
+
+procedure NewNote(Screen: TScreenSing);
+var
+ LineFragmentIndex: integer;
+ CurrentLineFragment: PLineFragment;
+ PlayerIndex: integer;
+ CurrentSound: TCaptureBuffer;
+ CurrentPlayer: PPlayer;
+ LastPlayerNote: PPLayerNote;
+ Line: PLine;
+ SentenceIndex: integer;
+ SentenceMin: integer;
+ SentenceMax: integer;
+ SentenceDetected: integer; // sentence of detected note
+ NoteAvailable: boolean;
+ NewNote: boolean;
+ Range: integer;
+ NoteHit: boolean;
+ MaxSongPoints: integer; // max. points for the song (without line bonus)
+ MaxLinePoints: Real; // max. points for the current line
+begin
+ // TODO: add duet mode support
+ // use Lines[LineSetIndex] with LineSetIndex depending on the current player
+
+ // count min and max sentence range for checking (detection is delayed to the notes we see on the screen)
+ SentenceMin := Lines[0].Current-1;
+ if (SentenceMin < 0) then
+ SentenceMin := 0;
+ SentenceMax := Lines[0].Current;
+
+ // check for an active note at the current time defined in the lyrics
+ NoteAvailable := false;
+ SentenceDetected := SentenceMin;
+ for SentenceIndex := SentenceMin to SentenceMax do
+ begin
+ Line := @Lines[0].Line[SentenceIndex];
+ for LineFragmentIndex := 0 to Line.HighNote do
+ begin
+ CurrentLineFragment := @Line.Note[LineFragmentIndex];
+ // check if line is active
+ if ((CurrentLineFragment.Start <= LyricsState.CurrentBeatD) and
+ (CurrentLineFragment.Start + CurrentLineFragment.Length-1 >= LyricsState.CurrentBeatD)) and
+ (CurrentLineFragment.NoteType <> ntFreestyle) and // but ignore FreeStyle notes
+ (CurrentLineFragment.Length > 0) then // and make sure the note lengths is at least 1
+ begin
+ SentenceDetected := SentenceIndex;
+ NoteAvailable := true;
+ Break;
+ end;
+ end;
+ // TODO: break here, if NoteAvailable is true? We would then use the first instead
+ // of the last note matching the current beat if notes overlap. But notes
+ // should not overlap at all.
+ //if (NoteAvailable) then
+ // Break;
+ end;
+
+ // analyze player signals
+ for PlayerIndex := 0 to PlayersPlay-1 do
+ begin
+ CurrentPlayer := @Player[PlayerIndex];
+ CurrentSound := AudioInputProcessor.Sound[PlayerIndex];
+ LastPlayerNote := @CurrentPlayer.Note[CurrentPlayer.HighNote];
+
+ // analyze buffer
+ CurrentSound.AnalyzeBuffer;
+
+ // add some noise
+ // TODO: do we need this?
+ //LyricsState.Tone := LyricsState.Tone + Round(Random(3)) - 1;
+
+ // add note if possible
+ if (CurrentSound.ToneValid and NoteAvailable) then
+ begin
+ Line := @Lines[0].Line[SentenceDetected];
+
+ // process until last note
+ for LineFragmentIndex := 0 to Line.HighNote do
+ begin
+ CurrentLineFragment := @Line.Note[LineFragmentIndex];
+ if (CurrentLineFragment.Start <= LyricsState.OldBeatD+1) and
+ (CurrentLineFragment.Start + CurrentLineFragment.Length > LyricsState.OldBeatD+1) then
+ begin
+ // compare notes (from song-file and from player)
+
+ // move players tone to proper octave
+ while (CurrentSound.Tone - CurrentLineFragment.Tone > 6) do
+ CurrentSound.Tone := CurrentSound.Tone - 12;
+
+ while (CurrentSound.Tone - CurrentLineFragment.Tone < -6) do
+ CurrentSound.Tone := CurrentSound.Tone + 12;
+
+ // half size notes patch
+ NoteHit := false;
+
+ //if Ini.Difficulty = 0 then Range := 2;
+ //if Ini.Difficulty = 1 then Range := 1;
+ //if Ini.Difficulty = 2 then Range := 0;
+ Range := 2 - Ini.Difficulty;
+
+ // check if the player hit the correct tone within the tolerated range
+ if (Abs(CurrentLineFragment.Tone - CurrentSound.Tone) <= Range) then
+ begin
+ // adjust the players tone to the correct one
+ // TODO: do we need to do this?
+ CurrentSound.Tone := CurrentLineFragment.Tone;
+
+ // half size notes patch
+ NoteHit := true;
+
+ if (Ini.LineBonus > 0) then
+ MaxSongPoints := MAX_SONG_SCORE - MAX_SONG_LINE_BONUS
+ else
+ MaxSongPoints := MAX_SONG_SCORE;
+
+ // Note: ScoreValue is the sum of all note values of the song
+ MaxLinePoints := MaxSongPoints / Lines[0].ScoreValue;
+
+ // FIXME: is this correct? Why do we add the points for a whole line
+ // if just one note is correct?
+ case CurrentLineFragment.NoteType of
+ ntNormal: CurrentPlayer.Score := CurrentPlayer.Score + MaxLinePoints;
+ ntGolden: CurrentPlayer.ScoreGolden := CurrentPlayer.ScoreGolden + MaxLinePoints;
+ end;
+
+ CurrentPlayer.ScoreInt := Floor(CurrentPlayer.Score / 10) * 10;
+ CurrentPlayer.ScoreGoldenInt := Floor(CurrentPlayer.ScoreGolden / 10) * 10;
+
+ CurrentPlayer.ScoreTotalInt := CurrentPlayer.ScoreInt +
+ CurrentPlayer.ScoreGoldenInt +
+ CurrentPlayer.ScoreLineInt;
+ end;
+
+ end; // operation
+ end; // for
+
+ // check if we have to add a new note or extend the note's length
+ if (SentenceDetected = SentenceMax) then
+ begin
+ // we will add a new note
+ NewNote := true;
+ // if last has the same tone
+ if ((CurrentPlayer.LengthNote > 0) and
+ (LastPlayerNote.Tone = CurrentSound.Tone) and
+ ((LastPlayerNote.Start + LastPlayerNote.Length) = LyricsState.CurrentBeatD)) then
+ begin
+ NewNote := false;
+ end;
+
+ // if is not as new note to control
+ for LineFragmentIndex := 0 to Line.HighNote do
+ begin
+ if (Line.Note[LineFragmentIndex].Start = LyricsState.CurrentBeatD) then
+ NewNote := true;
+ end;
+
+ // add new note
+ if NewNote then
+ begin
+ // new note
+ Inc(CurrentPlayer.LengthNote);
+ Inc(CurrentPlayer.HighNote);
+ SetLength(CurrentPlayer.Note, CurrentPlayer.LengthNote);
+
+ // update player's last note
+ LastPlayerNote := @CurrentPlayer.Note[CurrentPlayer.HighNote];
+ with LastPlayerNote^ do
+ begin
+ Start := LyricsState.CurrentBeatD;
+ Length := 1;
+ Tone := CurrentSound.Tone; // Tone || ToneAbs
+ Detect := LyricsState.MidBeat;
+ Hit := NoteHit; // half note patch
+ end;
+ end
+ else
+ begin
+ // extend note length
+ Inc(LastPlayerNote.Length);
+ end;
+
+ // check for perfect note and then lit the star (on Draw)
+ for LineFragmentIndex := 0 to Line.HighNote do
+ begin
+ CurrentLineFragment := @Line.Note[LineFragmentIndex];
+ if (CurrentLineFragment.Start = LastPlayerNote.Start) and
+ (CurrentLineFragment.Length = LastPlayerNote.Length) and
+ (CurrentLineFragment.Tone = LastPlayerNote.Tone) then
+ begin
+ LastPlayerNote.Perfect := true;
+ end;
+ end;
+ end; // if SentenceDetected = SentenceMax
+
+ end; // if Detected
+ end; // for PlayerIndex
+
+ //Log.LogStatus('EndBeat', 'NewBeat');
+
+ // on sentence end -> for LineBonus and display of SingBar (rating pop-up)
+ if (SentenceDetected >= Low(Lines[0].Line)) and
+ (SentenceDetected <= High(Lines[0].Line)) then
+ begin
+ Line := @Lines[0].Line[SentenceDetected];
+ CurrentLineFragment := @Line.Note[Line.HighNote];
+ if ((CurrentLineFragment.Start + CurrentLineFragment.Length - 1) = LyricsState.CurrentBeatD) then
+ begin
+ if assigned(Screen) then
+ Screen.OnSentenceEnd(SentenceDetected);
+ end;
+ end;
+
+end;
+
+procedure ClearScores(PlayerNum: integer);
+begin
+ with Player[PlayerNum] do
+ begin
+ Score := 0;
+ ScoreInt := 0;
+ ScoreLine := 0;
+ ScoreLineInt := 0;
+ ScoreGolden := 0;
+ ScoreGoldenInt := 0;
+ ScoreTotalInt := 0;
+ end;
+end;
+
+procedure AddSpecialPath(var PathList: TStringList; const Path: string);
+var
+ I: integer;
+ PathAbs, OldPathAbs: string;
+begin
+ if (PathList = nil) then
+ PathList := TStringList.Create;
+
+ if (Path = '') or not DirectoryExists(Path) then
+ Exit;
+
+ PathAbs := IncludeTrailingPathDelimiter(ExpandFileName(Path));
+
+ // check if path or a part of the path was already added
+ for I := 0 to PathList.Count-1 do
+ begin
+ OldPathAbs := IncludeTrailingPathDelimiter(ExpandFileName(PathList[I]));
+ // check if the new directory is a sub-directory of a previously added one.
+ // This is also true, if both paths point to the same directories.
+ if (AnsiStartsText(OldPathAbs, PathAbs)) then
+ begin
+ // ignore the new path
+ Exit;
+ end;
+
+ // check if a previously added directory is a sub-directory of the new one.
+ if (AnsiStartsText(PathAbs, OldPathAbs)) then
+ begin
+ // replace the old with the new one.
+ PathList[I] := PathAbs;
+ Exit;
+ end;
+ end;
+
+ PathList.Add(PathAbs);
+end;
+
+procedure AddSongPath(const Path: string);
+begin
+ AddSpecialPath(SongPaths, Path);
+end;
+
+procedure AddCoverPath(const Path: string);
+begin
+ AddSpecialPath(CoverPaths, Path);
+end;
+
+(**
+ * Initialize a path variable
+ * After setting paths, make sure that paths exist
+ *)
+function FindPath(out PathResult: string; const RequestedPath: string; NeedsWritePermission: boolean): boolean;
+begin
+ Result := false;
+
+ if (RequestedPath = '') then
+ Exit;
+
+ // Make sure the directory exists
+ if (not ForceDirectories(RequestedPath)) then
+ begin
+ PathResult := '';
+ Exit;
+ end;
+
+ PathResult := IncludeTrailingPathDelimiter(RequestedPath);
+
+ if (NeedsWritePermission) and
+ (FileIsReadOnly(RequestedPath)) then
+ begin
+ Exit;
+ end;
+
+ Result := true;
+end;
+
+(**
+ * Function sets all absolute paths e.g. song path and makes sure the directorys exist
+ *)
+procedure InitializePaths;
+begin
+ // Log directory (must be writable)
+ if (not FindPath(LogPath, Platform.GetLogPath, true)) then
+ begin
+ Log.FileOutputEnabled := false;
+ Log.LogWarn('Log directory "'+ Platform.GetLogPath +'" not available', 'InitializePaths');
+ end;
+
+ FindPath(SoundPath, Platform.GetGameSharedPath + 'sounds', false);
+ FindPath(ThemePath, Platform.GetGameSharedPath + 'themes', false);
+ FindPath(SkinsPath, Platform.GetGameSharedPath + 'themes', false);
+ FindPath(LanguagesPath, Platform.GetGameSharedPath + 'languages', false);
+ FindPath(PluginPath, Platform.GetGameSharedPath + 'plugins', false);
+ FindPath(VisualsPath, Platform.GetGameSharedPath + 'visuals', false);
+ FindPath(ResourcesPath, Platform.GetGameSharedPath + 'resources', false);
+
+ // Playlists are not shared as we need one directory to write too
+ FindPath(PlaylistPath, Platform.GetGameUserPath + 'playlists', true);
+
+ // Screenshot directory (must be writable)
+ if (not FindPath(ScreenshotsPath, Platform.GetGameUserPath + 'screenshots', true)) then
+ begin
+ Log.LogWarn('Screenshot directory "'+ Platform.GetGameUserPath +'" not available', 'InitializePaths');
+ end;
+
+ // Add song paths
+ AddSongPath(Params.SongPath);
+ AddSongPath(Platform.GetGameSharedPath + 'songs');
+ AddSongPath(Platform.GetGameUserPath + 'songs');
+
+ // Add category cover paths
+ AddCoverPath(Platform.GetGameSharedPath + 'covers');
+ AddCoverPath(Platform.GetGameUserPath + 'covers');
+end;
+
+end.
diff --git a/src/base/UMediaCore_FFmpeg.pas b/src/base/UMediaCore_FFmpeg.pas
new file mode 100644
index 00000000..cdd320ac
--- /dev/null
+++ b/src/base/UMediaCore_FFmpeg.pas
@@ -0,0 +1,405 @@
+unit UMediaCore_FFmpeg;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+uses
+ UMusic,
+ avcodec,
+ avformat,
+ avutil,
+ ULog,
+ sdl;
+
+type
+ PPacketQueue = ^TPacketQueue;
+ TPacketQueue = class
+ private
+ FirstListEntry: PAVPacketList;
+ LastListEntry: PAVPacketList;
+ PacketCount: integer;
+ Mutex: PSDL_Mutex;
+ Condition: PSDL_Cond;
+ Size: integer;
+ AbortRequest: boolean;
+ public
+ constructor Create();
+ destructor Destroy(); override;
+
+ function Put(Packet : PAVPacket): integer;
+ function PutStatus(StatusFlag: integer; StatusInfo: Pointer): integer;
+ procedure FreeStatusInfo(var Packet: TAVPacket);
+ function GetStatusInfo(var Packet: TAVPacket): Pointer;
+ function Get(var Packet: TAVPacket; Blocking: boolean): integer;
+ function GetSize(): integer;
+ procedure Flush();
+ procedure Abort();
+ function IsAborted(): boolean;
+ end;
+
+const
+ STATUS_PACKET: PChar = 'STATUS_PACKET';
+const
+ PKT_STATUS_FLAG_EOF = 1; // signal end-of-file
+ PKT_STATUS_FLAG_FLUSH = 2; // request the decoder to flush its avcodec decode buffers
+ PKT_STATUS_FLAG_ERROR = 3; // signal an error state
+ PKT_STATUS_FLAG_EMPTY = 4; // request the decoder to output empty data (silence or black frames)
+
+type
+ TMediaCore_FFmpeg = class
+ private
+ AVCodecLock: PSDL_Mutex;
+ public
+ constructor Create();
+ destructor Destroy(); override;
+ class function GetInstance(): TMediaCore_FFmpeg;
+
+ function GetErrorString(ErrorNum: integer): string;
+ function FindStreamIDs(FormatCtx: PAVFormatContext; out FirstVideoStream, FirstAudioStream: integer ): boolean;
+ function FindAudioStreamIndex(FormatCtx: PAVFormatContext): integer;
+ function ConvertFFmpegToAudioFormat(FFmpegFormat: TSampleFormat; out Format: TAudioSampleFormat): boolean;
+ procedure LockAVCodec();
+ procedure UnlockAVCodec();
+ end;
+
+implementation
+
+uses
+ SysUtils;
+
+var
+ Instance: TMediaCore_FFmpeg;
+
+constructor TMediaCore_FFmpeg.Create();
+begin
+ inherited;
+ AVCodecLock := SDL_CreateMutex();
+end;
+
+destructor TMediaCore_FFmpeg.Destroy();
+begin
+ SDL_DestroyMutex(AVCodecLock);
+ inherited;
+end;
+
+class function TMediaCore_FFmpeg.GetInstance(): TMediaCore_FFmpeg;
+begin
+ if (not Assigned(Instance)) then
+ Instance := TMediaCore_FFmpeg.Create();
+ Result := Instance;
+end;
+
+procedure TMediaCore_FFmpeg.LockAVCodec();
+begin
+ SDL_mutexP(AVCodecLock);
+end;
+
+procedure TMediaCore_FFmpeg.UnlockAVCodec();
+begin
+ SDL_mutexV(AVCodecLock);
+end;
+
+function TMediaCore_FFmpeg.GetErrorString(ErrorNum: integer): string;
+begin
+ case ErrorNum of
+ AVERROR_IO: Result := 'AVERROR_IO';
+ AVERROR_NUMEXPECTED: Result := 'AVERROR_NUMEXPECTED';
+ AVERROR_INVALIDDATA: Result := 'AVERROR_INVALIDDATA';
+ AVERROR_NOMEM: Result := 'AVERROR_NOMEM';
+ AVERROR_NOFMT: Result := 'AVERROR_NOFMT';
+ AVERROR_NOTSUPP: Result := 'AVERROR_NOTSUPP';
+ AVERROR_NOENT: Result := 'AVERROR_NOENT';
+ AVERROR_PATCHWELCOME: Result := 'AVERROR_PATCHWELCOME';
+ else Result := 'AVERROR_#'+inttostr(ErrorNum);
+ end;
+end;
+
+{
+ @param(FormatCtx is a PAVFormatContext returned from av_open_input_file )
+ @param(FirstVideoStream is an OUT value of type integer, this is the index of the video stream)
+ @param(FirstAudioStream is an OUT value of type integer, this is the index of the audio stream)
+ @returns(@true on success, @false otherwise)
+}
+function TMediaCore_FFmpeg.FindStreamIDs(FormatCtx: PAVFormatContext; out FirstVideoStream, FirstAudioStream: integer): boolean;
+var
+ i: integer;
+ Stream: PAVStream;
+begin
+ // find the first video stream
+ FirstAudioStream := -1;
+ FirstVideoStream := -1;
+
+ for i := 0 to FormatCtx.nb_streams-1 do
+ begin
+ Stream := FormatCtx.streams[i];
+
+ if (Stream.codec.codec_type = CODEC_TYPE_VIDEO) and
+ (FirstVideoStream < 0) then
+ begin
+ FirstVideoStream := i;
+ end;
+
+ if (Stream.codec.codec_type = CODEC_TYPE_AUDIO) and
+ (FirstAudioStream < 0) then
+ begin
+ FirstAudioStream := i;
+ end;
+ end;
+
+ // return true if either an audio- or video-stream was found
+ Result := (FirstAudioStream > -1) or
+ (FirstVideoStream > -1) ;
+end;
+
+function TMediaCore_FFmpeg.FindAudioStreamIndex(FormatCtx: PAVFormatContext): integer;
+var
+ i: integer;
+ StreamIndex: integer;
+ Stream: PAVStream;
+begin
+ // find the first audio stream
+ StreamIndex := -1;
+
+ for i := 0 to FormatCtx^.nb_streams-1 do
+ begin
+ Stream := FormatCtx^.streams[i];
+
+ if (Stream.codec^.codec_type = CODEC_TYPE_AUDIO) then
+ begin
+ StreamIndex := i;
+ Break;
+ end;
+ end;
+
+ Result := StreamIndex;
+end;
+
+function TMediaCore_FFmpeg.ConvertFFmpegToAudioFormat(FFmpegFormat: TSampleFormat; out Format: TAudioSampleFormat): boolean;
+begin
+ case FFmpegFormat of
+ SAMPLE_FMT_U8: Format := asfU8;
+ SAMPLE_FMT_S16: Format := asfS16;
+ SAMPLE_FMT_S24: Format := asfS24;
+ SAMPLE_FMT_S32: Format := asfS32;
+ SAMPLE_FMT_FLT: Format := asfFloat;
+ else begin
+ Result := false;
+ Exit;
+ end;
+ end;
+ Result := true;
+end;
+
+{ TPacketQueue }
+
+constructor TPacketQueue.Create();
+begin
+ inherited;
+
+ FirstListEntry := nil;
+ LastListEntry := nil;
+ PacketCount := 0;
+ Size := 0;
+
+ Mutex := SDL_CreateMutex();
+ Condition := SDL_CreateCond();
+end;
+
+destructor TPacketQueue.Destroy();
+begin
+ Flush();
+ SDL_DestroyMutex(Mutex);
+ SDL_DestroyCond(Condition);
+ inherited;
+end;
+
+procedure TPacketQueue.Abort();
+begin
+ SDL_LockMutex(Mutex);
+
+ AbortRequest := true;
+
+ SDL_CondBroadcast(Condition);
+ SDL_UnlockMutex(Mutex);
+end;
+
+function TPacketQueue.IsAborted(): boolean;
+begin
+ SDL_LockMutex(Mutex);
+ Result := AbortRequest;
+ SDL_UnlockMutex(Mutex);
+end;
+
+function TPacketQueue.Put(Packet : PAVPacket): integer;
+var
+ CurrentListEntry : PAVPacketList;
+begin
+ Result := -1;
+
+ if (Packet = nil) then
+ Exit;
+
+ if (PChar(Packet^.data) <> STATUS_PACKET) then
+ begin
+ if (av_dup_packet(Packet) < 0) then
+ Exit;
+ end;
+
+ CurrentListEntry := av_malloc(SizeOf(TAVPacketList));
+ if (CurrentListEntry = nil) then
+ Exit;
+
+ CurrentListEntry^.pkt := Packet^;
+ CurrentListEntry^.next := nil;
+
+ SDL_LockMutex(Mutex);
+ try
+ if (LastListEntry = nil) then
+ FirstListEntry := CurrentListEntry
+ else
+ LastListEntry^.next := CurrentListEntry;
+
+ LastListEntry := CurrentListEntry;
+ Inc(PacketCount);
+
+ Size := Size + CurrentListEntry^.pkt.size;
+ SDL_CondSignal(Condition);
+ finally
+ SDL_UnlockMutex(Mutex);
+ end;
+
+ Result := 0;
+end;
+
+(**
+ * Adds a status packet (EOF, Flush, etc.) to the end of the queue.
+ * StatusInfo can be used to pass additional information to the decoder.
+ * Only assign nil or a valid pointer to data allocated with Getmem() to
+ * StatusInfo because the pointer will be disposed with Freemem() on a call
+ * to Flush(). If the packet is removed from the queue it is the decoder's
+ * responsibility to free the StatusInfo data with FreeStatusInfo().
+ *)
+function TPacketQueue.PutStatus(StatusFlag: integer; StatusInfo: Pointer): integer;
+var
+ TempPacket: PAVPacket;
+begin
+ // create temp. package
+ TempPacket := av_malloc(SizeOf(TAVPacket));
+ if (TempPacket = nil) then
+ begin
+ Result := -1;
+ Exit;
+ end;
+ // init package
+ av_init_packet(TempPacket^);
+ TempPacket^.data := Pointer(STATUS_PACKET);
+ TempPacket^.flags := StatusFlag;
+ TempPacket^.priv := StatusInfo;
+ // put a copy of the package into the queue
+ Result := Put(TempPacket);
+ // data has been copied -> delete temp. package
+ av_free(TempPacket);
+end;
+
+procedure TPacketQueue.FreeStatusInfo(var Packet: TAVPacket);
+begin
+ if (Packet.priv <> nil) then
+ FreeMem(Packet.priv);
+end;
+
+function TPacketQueue.GetStatusInfo(var Packet: TAVPacket): Pointer;
+begin
+ Result := Packet.priv;
+end;
+
+function TPacketQueue.Get(var Packet: TAVPacket; Blocking: boolean): integer;
+var
+ CurrentListEntry: PAVPacketList;
+const
+ WAIT_TIMEOUT = 10; // timeout in ms
+begin
+ Result := -1;
+
+ SDL_LockMutex(Mutex);
+ try
+ while (true) do
+ begin
+ if (AbortRequest) then
+ Exit;
+
+ CurrentListEntry := FirstListEntry;
+ if (CurrentListEntry <> nil) then
+ begin
+ FirstListEntry := CurrentListEntry^.next;
+ if (FirstListEntry = nil) then
+ LastListEntry := nil;
+ Dec(PacketCount);
+
+ Size := Size - CurrentListEntry^.pkt.size;
+ Packet := CurrentListEntry^.pkt;
+ av_free(CurrentListEntry);
+
+ Result := 1;
+ Break;
+ end
+ else if (not Blocking) then
+ begin
+ Result := 0;
+ Break;
+ end
+ else
+ begin
+ // block until a new package arrives,
+ // but do not wait till infinity to avoid deadlocks
+ if (SDL_CondWaitTimeout(Condition, Mutex, WAIT_TIMEOUT) = SDL_MUTEX_TIMEDOUT) then
+ begin
+ Result := 0;
+ Break;
+ end;
+ end;
+ end;
+ finally
+ SDL_UnlockMutex(Mutex);
+ end;
+end;
+
+function TPacketQueue.GetSize(): integer;
+begin
+ SDL_LockMutex(Mutex);
+ Result := Size;
+ SDL_UnlockMutex(Mutex);
+end;
+
+procedure TPacketQueue.Flush();
+var
+ CurrentListEntry, TempListEntry: PAVPacketList;
+begin
+ SDL_LockMutex(Mutex);
+
+ CurrentListEntry := FirstListEntry;
+ while(CurrentListEntry <> nil) do
+ begin
+ TempListEntry := CurrentListEntry^.next;
+ // free status data
+ if (PChar(CurrentListEntry^.pkt.data) = STATUS_PACKET) then
+ FreeStatusInfo(CurrentListEntry^.pkt);
+ // free packet data
+ av_free_packet(@CurrentListEntry^.pkt);
+ // Note: param must be a pointer to a pointer!
+ av_freep(@CurrentListEntry);
+ CurrentListEntry := TempListEntry;
+ end;
+ LastListEntry := nil;
+ FirstListEntry := nil;
+ PacketCount := 0;
+ Size := 0;
+
+ SDL_UnlockMutex(Mutex);
+end;
+
+end.
diff --git a/src/base/UMediaCore_SDL.pas b/src/base/UMediaCore_SDL.pas
new file mode 100644
index 00000000..252f72a0
--- /dev/null
+++ b/src/base/UMediaCore_SDL.pas
@@ -0,0 +1,38 @@
+unit UMediaCore_SDL;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+uses
+ UMusic,
+ sdl;
+
+function ConvertAudioFormatToSDL(Format: TAudioSampleFormat; out SDLFormat: UInt16): boolean;
+
+implementation
+
+function ConvertAudioFormatToSDL(Format: TAudioSampleFormat; out SDLFormat: UInt16): boolean;
+begin
+ case Format of
+ asfU8: SDLFormat := AUDIO_U8;
+ asfS8: SDLFormat := AUDIO_S8;
+ asfU16LSB: SDLFormat := AUDIO_U16LSB;
+ asfS16LSB: SDLFormat := AUDIO_S16LSB;
+ asfU16MSB: SDLFormat := AUDIO_U16MSB;
+ asfS16MSB: SDLFormat := AUDIO_S16MSB;
+ asfU16: SDLFormat := AUDIO_U16;
+ asfS16: SDLFormat := AUDIO_S16;
+ else begin
+ Result := false;
+ Exit;
+ end;
+ end;
+ Result := true;
+end;
+
+end.
diff --git a/src/base/UMedia_dummy.pas b/src/base/UMedia_dummy.pas
new file mode 100644
index 00000000..438b89ab
--- /dev/null
+++ b/src/base/UMedia_dummy.pas
@@ -0,0 +1,243 @@
+unit UMedia_dummy;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+implementation
+
+uses
+ SysUtils,
+ math,
+ UMusic;
+
+type
+ TMedia_dummy = class( TInterfacedObject, IVideoPlayback, IVideoVisualization, IAudioPlayback, IAudioInput )
+ private
+ DummyOutputDeviceList: TAudioOutputDeviceList;
+ public
+ constructor Create();
+ function GetName: string;
+
+ function Init(): boolean;
+ function Finalize(): boolean;
+
+ function Open(const aFileName : string): boolean; // true if succeed
+ procedure Close;
+
+ procedure Play;
+ procedure Pause;
+ procedure Stop;
+
+ procedure SetPosition(Time: real);
+ function GetPosition: real;
+
+ procedure SetSyncSource(SyncSource: TSyncSource);
+
+ procedure GetFrame(Time: Extended);
+ procedure DrawGL(Screen: integer);
+
+ // IAudioInput
+ function InitializeRecord: boolean;
+ function FinalizeRecord: boolean;
+ procedure CaptureStart;
+ procedure CaptureStop;
+ procedure GetFFTData(var data: TFFTData);
+ function GetPCMData(var data: TPCMData): Cardinal;
+
+ // IAudioPlayback
+ function InitializePlayback: boolean;
+ function FinalizePlayback: boolean;
+
+ function GetOutputDeviceList(): TAudioOutputDeviceList;
+ procedure FadeIn(Time: real; TargetVolume: single);
+ procedure SetAppVolume(Volume: single);
+ procedure SetVolume(Volume: single);
+ procedure SetLoop(Enabled: boolean);
+ procedure Rewind;
+
+ function Finished: boolean;
+ function Length: real;
+
+ function OpenSound(const Filename: string): TAudioPlaybackStream;
+ procedure CloseSound(var PlaybackStream: TAudioPlaybackStream);
+ procedure PlaySound(stream: TAudioPlaybackStream);
+ procedure StopSound(stream: TAudioPlaybackStream);
+
+ function CreateVoiceStream(Channel: integer; FormatInfo: TAudioFormatInfo): TAudioVoiceStream;
+ procedure CloseVoiceStream(var VoiceStream: TAudioVoiceStream);
+ end;
+
+function TMedia_dummy.GetName: string;
+begin
+ Result := 'dummy';
+end;
+
+procedure TMedia_dummy.GetFrame(Time: Extended);
+begin
+end;
+
+procedure TMedia_dummy.DrawGL(Screen: integer);
+begin
+end;
+
+constructor TMedia_dummy.Create();
+begin
+ inherited;
+end;
+
+function TMedia_dummy.Init(): boolean;
+begin
+ Result := true;
+end;
+
+function TMedia_dummy.Finalize(): boolean;
+begin
+ Result := true;
+end;
+
+function TMedia_dummy.Open(const aFileName : string): boolean; // true if succeed
+begin
+ Result := false;
+end;
+
+procedure TMedia_dummy.Close;
+begin
+end;
+
+procedure TMedia_dummy.Play;
+begin
+end;
+
+procedure TMedia_dummy.Pause;
+begin
+end;
+
+procedure TMedia_dummy.Stop;
+begin
+end;
+
+procedure TMedia_dummy.SetPosition(Time: real);
+begin
+end;
+
+function TMedia_dummy.GetPosition: real;
+begin
+ Result := 0;
+end;
+
+procedure TMedia_dummy.SetSyncSource(SyncSource: TSyncSource);
+begin
+end;
+
+// IAudioInput
+function TMedia_dummy.InitializeRecord: boolean;
+begin
+ Result := true;
+end;
+
+function TMedia_dummy.FinalizeRecord: boolean;
+begin
+ Result := true;
+end;
+
+procedure TMedia_dummy.CaptureStart;
+begin
+end;
+
+procedure TMedia_dummy.CaptureStop;
+begin
+end;
+
+procedure TMedia_dummy.GetFFTData(var data: TFFTData);
+begin
+end;
+
+function TMedia_dummy.GetPCMData(var data: TPCMData): Cardinal;
+begin
+ Result := 0;
+end;
+
+// IAudioPlayback
+function TMedia_dummy.InitializePlayback: boolean;
+begin
+ SetLength(DummyOutputDeviceList, 1);
+ DummyOutputDeviceList[0] := TAudioOutputDevice.Create();
+ DummyOutputDeviceList[0].Name := '[Dummy Device]';
+ Result := true;
+end;
+
+function TMedia_dummy.FinalizePlayback: boolean;
+begin
+ Result := true;
+end;
+
+function TMedia_dummy.GetOutputDeviceList(): TAudioOutputDeviceList;
+begin
+ Result := DummyOutputDeviceList;
+end;
+
+procedure TMedia_dummy.SetAppVolume(Volume: single);
+begin
+end;
+
+procedure TMedia_dummy.SetVolume(Volume: single);
+begin
+end;
+
+procedure TMedia_dummy.SetLoop(Enabled: boolean);
+begin
+end;
+
+procedure TMedia_dummy.FadeIn(Time: real; TargetVolume: single);
+begin
+end;
+
+procedure TMedia_dummy.Rewind;
+begin
+end;
+
+function TMedia_dummy.Finished: boolean;
+begin
+ Result := false;
+end;
+
+function TMedia_dummy.Length: real;
+begin
+ Result := 60;
+end;
+
+function TMedia_dummy.OpenSound(const Filename: string): TAudioPlaybackStream;
+begin
+ Result := nil;
+end;
+
+procedure TMedia_dummy.CloseSound(var PlaybackStream: TAudioPlaybackStream);
+begin
+end;
+
+procedure TMedia_dummy.PlaySound(stream: TAudioPlaybackStream);
+begin
+end;
+
+procedure TMedia_dummy.StopSound(stream: TAudioPlaybackStream);
+begin
+end;
+
+function TMedia_dummy.CreateVoiceStream(Channel: integer; FormatInfo: TAudioFormatInfo): TAudioVoiceStream;
+begin
+ Result := nil;
+end;
+
+procedure TMedia_dummy.CloseVoiceStream(var VoiceStream: TAudioVoiceStream);
+begin
+end;
+
+initialization
+ MediaManager.Add(TMedia_dummy.Create);
+
+end.
diff --git a/src/base/UModules.pas b/src/base/UModules.pas
new file mode 100644
index 00000000..554a24c4
--- /dev/null
+++ b/src/base/UModules.pas
@@ -0,0 +1,26 @@
+unit UModules;
+
+interface
+
+{$I switches.inc}
+
+{*********************
+ UModules
+ Unit Contains all used Modules in its uses clausel
+ and a const with an array of all Modules to load
+*********************}
+
+uses
+ UCoreModule,
+ UPluginLoader;
+
+const
+ CORE_MODULES_TO_LOAD: Array[0..2] of cCoreModule = (
+ TPluginLoader, //First because it has to look if there are Module replacements (Feature o/t Future)
+ TCoreModule, //Remove this later, just a dummy
+ TtehPlugins //Represents the Plugins. Last because they may use CoreModules Services etc.
+ );
+
+implementation
+
+end.
\ No newline at end of file
diff --git a/src/base/UMusic.pas b/src/base/UMusic.pas
new file mode 100644
index 00000000..6476f629
--- /dev/null
+++ b/src/base/UMusic.pas
@@ -0,0 +1,1233 @@
+unit UMusic;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+uses
+ UTime,
+ Classes;
+
+type
+ TNoteType = (ntFreestyle, ntNormal, ntGolden);
+
+ (**
+ * TLineFragment represents a fragment of a lyrics line.
+ * This is a text-fragment (e.g. a syllable) assigned to a note pitch,
+ * represented by a bar in the sing-screen.
+ *)
+ PLineFragment = ^TLineFragment;
+ TLineFragment = record
+ Color: integer;
+ Start: integer; // beat the fragment starts at
+ Length: integer; // length in beats
+ Tone: integer; // full range tone
+ Text: string; // text assigned to this fragment (a syllable, word, etc.)
+ NoteType: TNoteType; // note-type: golden-note/freestyle etc.
+ end;
+
+ (**
+ * TLine represents one lyrics line and consists of multiple
+ * notes.
+ *)
+ PLine = ^TLine;
+ TLine = record
+ Start: integer; // the start beat of this line (<> start beat of the first note of this line)
+ Lyric: string;
+ LyricWidth: real; // @deprecated: width of the line in pixels.
+ // Do not use this as the width is not correct.
+ // Use TLyricsEngine.GetUpperLine().Width instead.
+ End_: integer;
+ BaseNote: integer;
+ HighNote: integer; // index of last note in line (= High(Note)?)
+ TotalNotes: integer; // value of all notes in the line
+ LastLine: boolean;
+ Note: array of TLineFragment;
+ end;
+
+ (**
+ * TLines stores sets of lyric lines and information on them.
+ * Normally just one set is defined but in duet mode it might for example
+ * contain two sets.
+ *)
+ TLines = record
+ Current: integer; // for drawing of current line
+ High: integer; // (= High(Line)?)
+ Number: integer;
+ Resolution: integer;
+ NotesGAP: integer;
+ ScoreValue: integer;
+ Line: array of TLine;
+ end;
+
+ (**
+ * TLyricsState contains all information concerning the
+ * state of the lyrics, e.g. the current beat or duration of the lyrics.
+ *)
+ TLyricsState = class
+ private
+ Timer: TRelativeTimer; // keeps track of the current time
+ public
+ OldBeat: integer; // previous discovered beat
+ CurrentBeat: integer; // current beat (rounded)
+ MidBeat: real; // current beat (float)
+
+ // now we use this for super synchronization!
+ // only used when analyzing voice
+ // TODO: change ...D to ...Detect(ed)
+ OldBeatD: integer; // previous discovered beat
+ CurrentBeatD: integer; // current discovered beat (rounded)
+ MidBeatD: real; // current discovered beat (float)
+
+ // we use this for audible clicks
+ // TODO: Change ...C to ...Click
+ OldBeatC: integer; // previous discovered beat
+ CurrentBeatC: integer;
+ MidBeatC: real; // like CurrentBeatC
+
+ OldLine: integer; // previous displayed sentence
+
+ StartTime: real; // time till start of lyrics (= Gap)
+ TotalTime: real; // total song time
+
+ constructor Create();
+ procedure Pause();
+ procedure Resume();
+
+ procedure Reset();
+ procedure UpdateBeats();
+
+ (**
+ * current song time (in seconds) used as base-timer for lyrics etc.
+ *)
+ function GetCurrentTime(): real;
+ procedure SetCurrentTime(Time: real);
+ end;
+
+
+const
+ FFTSize = 512; // size of FFT data (output: FFTSize/2 values)
+type
+ TFFTData = array[0..(FFTSize div 2)-1] of Single;
+
+type
+ PPCMStereoSample = ^TPCMStereoSample;
+ TPCMStereoSample = array[0..1] of SmallInt;
+ TPCMData = array[0..511] of TPCMStereoSample;
+
+type
+ TStreamStatus = (ssStopped, ssPlaying, ssPaused);
+const
+ StreamStatusStr: array[TStreamStatus] of string =
+ ('Stopped', 'Playing', 'Paused');
+
+type
+ TAudioSampleFormat = (
+ asfU8, asfS8, // unsigned/signed 8 bits
+ asfU16LSB, asfS16LSB, // unsigned/signed 16 bits (endianness: LSB)
+ asfU16MSB, asfS16MSB, // unsigned/signed 16 bits (endianness: MSB)
+ asfU16, asfS16, // unsigned/signed 16 bits (endianness: System)
+ asfS24, // signed 24 bits (endianness: System)
+ asfS32, // signed 32 bits (endianness: System)
+ asfFloat // float
+ );
+
+const
+ // Size of one sample (one channel only) in bytes
+ AudioSampleSize: array[TAudioSampleFormat] of integer = (
+ 1, 1, // asfU8, asfS8
+ 2, 2, // asfU16LSB, asfS16LSB
+ 2, 2, // asfU16MSB, asfS16MSB
+ 2, 2, // asfU16, asfS16
+ 3, // asfS24
+ 4, // asfS32
+ 4 // asfFloat
+ );
+
+const
+ CHANNELMAP_LEFT = 1;
+ CHANNELMAP_RIGHT = 2;
+ CHANNELMAP_FRONT = CHANNELMAP_LEFT or CHANNELMAP_RIGHT;
+
+type
+ TAudioFormatInfo = class
+ private
+ fSampleRate : double;
+ fChannels : byte;
+ fFormat : TAudioSampleFormat;
+ fFrameSize : integer;
+
+ procedure SetChannels(Channels: byte);
+ procedure SetFormat(Format: TAudioSampleFormat);
+ procedure UpdateFrameSize();
+ function GetBytesPerSec(): double;
+ public
+ constructor Create(Channels: byte; SampleRate: double; Format: TAudioSampleFormat);
+ function Copy(): TAudioFormatInfo;
+
+ (**
+ * Returns the inverse ratio of the size of data in this format to its
+ * size in a given target format.
+ * Example: SrcSize*SrcInfo.GetRatio(TgtInfo) = TgtSize
+ *)
+ function GetRatio(TargetInfo: TAudioFormatInfo): double;
+
+ property SampleRate: double read fSampleRate write fSampleRate;
+ property Channels: byte read fChannels write SetChannels;
+ property Format: TAudioSampleFormat read fFormat write SetFormat;
+ property FrameSize: integer read fFrameSize;
+ property BytesPerSec: double read GetBytesPerSec;
+ end;
+
+type
+ TSoundEffect = class
+ public
+ EngineData: Pointer; // can be used for engine-specific data
+ procedure Callback(Buffer: PChar; BufSize: integer); virtual; abstract;
+ end;
+
+ TVoiceRemoval = class(TSoundEffect)
+ public
+ procedure Callback(Buffer: PChar; BufSize: integer); override;
+ end;
+
+type
+ TSyncSource = class
+ function GetClock(): real; virtual; abstract;
+ end;
+
+ TAudioProcessingStream = class;
+ TOnCloseHandler = procedure(Stream: TAudioProcessingStream);
+
+ TAudioProcessingStream = class
+ protected
+ OnCloseHandlers: array of TOnCloseHandler;
+
+ function GetLength(): real; virtual; abstract;
+ function GetPosition(): real; virtual; abstract;
+ procedure SetPosition(Time: real); virtual; abstract;
+ function GetLoop(): boolean; virtual; abstract;
+ procedure SetLoop(Enabled: boolean); virtual; abstract;
+
+ procedure PerformOnClose();
+ public
+ function GetAudioFormatInfo(): TAudioFormatInfo; virtual; abstract;
+ procedure Close(); virtual; abstract;
+
+ (**
+ * Adds a new OnClose action handler.
+ * The handlers are performed in the order they were added.
+ * If not stated explicitely, member-variables might have been invalidated
+ * already. So do not use any member (variable/method/...) if you are not
+ * sure it is valid.
+ *)
+ procedure AddOnCloseHandler(Handler: TOnCloseHandler);
+
+ property Length: real read GetLength;
+ property Position: real read GetPosition write SetPosition;
+ property Loop: boolean read GetLoop write SetLoop;
+ end;
+
+ TAudioSourceStream = class(TAudioProcessingStream)
+ protected
+ function IsEOF(): boolean; virtual; abstract;
+ function IsError(): boolean; virtual; abstract;
+ public
+ function ReadData(Buffer: PChar; BufferSize: integer): integer; virtual; abstract;
+
+ property EOF: boolean read IsEOF;
+ property Error: boolean read IsError;
+ end;
+
+ (*
+ * State-Chart for playback-stream state transitions
+ * []: Transition, (): State
+ *
+ * /---[Play/FadeIn]--->-\ /-------[Pause]----->-\
+ * -[Create]->(Stop) (Play) (Pause)
+ * \\-<-[Stop/EOF*/Error]-/ \-<---[Play/FadeIn]--//
+ * \-<------------[Stop/EOF*/Error]--------------/
+ *
+ * *: if not looped, otherwise stream is repeated
+ * Note: SetPosition() does not change the state.
+ *)
+
+ TAudioPlaybackStream = class(TAudioProcessingStream)
+ protected
+ SyncSource: TSyncSource;
+ AvgSyncDiff: double;
+ SourceStream: TAudioSourceStream;
+
+ function GetLatency(): double; virtual; abstract;
+ function GetStatus(): TStreamStatus; virtual; abstract;
+ function GetVolume(): single; virtual; abstract;
+ procedure SetVolume(Volume: single); virtual; abstract;
+ function Synchronize(BufferSize: integer; FormatInfo: TAudioFormatInfo): integer;
+ procedure FillBufferWithFrame(Buffer: PChar; BufferSize: integer; Frame: PChar; FrameSize: integer);
+ public
+ (**
+ * Opens a SourceStream for playback.
+ * Note that the caller (not the TAudioPlaybackStream) is responsible to
+ * free the SourceStream after the Playback-Stream is closed.
+ * You may use an OnClose-handler to achieve this. GetSourceStream()
+ * guarantees to deliver this method's SourceStream parameter to
+ * the OnClose-handler. Freeing SourceStream at OnClose is allowed.
+ *)
+ function Open(SourceStream: TAudioSourceStream): boolean; virtual; abstract;
+
+ procedure Play(); virtual; abstract;
+ procedure Pause(); virtual; abstract;
+ procedure Stop(); virtual; abstract;
+ procedure FadeIn(Time: real; TargetVolume: single); virtual; abstract;
+
+ procedure GetFFTData(var data: TFFTData); virtual; abstract;
+ function GetPCMData(var data: TPCMData): Cardinal; virtual; abstract;
+
+ procedure AddSoundEffect(Effect: TSoundEffect); virtual; abstract;
+ procedure RemoveSoundEffect(Effect: TSoundEffect); virtual; abstract;
+
+ procedure SetSyncSource(SyncSource: TSyncSource);
+ function GetSourceStream(): TAudioSourceStream;
+
+ property Status: TStreamStatus read GetStatus;
+ property Volume: single read GetVolume write SetVolume;
+ end;
+
+ TAudioDecodeStream = class(TAudioSourceStream)
+ end;
+
+ TAudioVoiceStream = class(TAudioSourceStream)
+ protected
+ FormatInfo: TAudioFormatInfo;
+ ChannelMap: integer;
+ public
+ destructor Destroy; override;
+
+ function Open(ChannelMap: integer; FormatInfo: TAudioFormatInfo): boolean; virtual;
+ procedure Close(); override;
+
+ procedure WriteData(Buffer: PChar; BufferSize: integer); virtual; abstract;
+ function GetAudioFormatInfo(): TAudioFormatInfo; override;
+
+ function GetLength(): real; override;
+ function GetPosition(): real; override;
+ procedure SetPosition(Time: real); override;
+ function GetLoop(): boolean; override;
+ procedure SetLoop(Enabled: boolean); override;
+ end;
+
+type
+ // soundcard output-devices information
+ TAudioOutputDevice = class
+ public
+ Name: string; // soundcard name
+ end;
+ TAudioOutputDeviceList = array of TAudioOutputDevice;
+
+type
+ IGenericPlayback = Interface
+ ['{63A5EBC3-3F4D-4F23-8DFB-B5165FCE33DD}']
+ function GetName: String;
+
+ function Open(const Filename: string): boolean; // true if succeed
+ procedure Close;
+
+ procedure Play;
+ procedure Pause;
+ procedure Stop;
+
+ procedure SetPosition(Time: real);
+ function GetPosition: real;
+
+ property Position: real read GetPosition write SetPosition;
+ end;
+
+ IVideoPlayback = Interface( IGenericPlayback )
+ ['{3574C40C-28AE-4201-B3D1-3D1F0759B131}']
+ function Init(): boolean;
+ function Finalize: boolean;
+
+ procedure GetFrame(Time: Extended); // WANT TO RENAME THESE TO BE MORE GENERIC
+ procedure DrawGL(Screen: integer); // WANT TO RENAME THESE TO BE MORE GENERIC
+
+ end;
+
+ IVideoVisualization = Interface( IVideoPlayback )
+ ['{5AC17D60-B34D-478D-B632-EB00D4078017}']
+ end;
+
+ IAudioPlayback = Interface( IGenericPlayback )
+ ['{E4AE0B40-3C21-4DC5-847C-20A87E0DFB96}']
+ function InitializePlayback: boolean;
+ function FinalizePlayback: boolean;
+
+ function GetOutputDeviceList(): TAudioOutputDeviceList;
+
+ procedure SetAppVolume(Volume: single);
+ procedure SetVolume(Volume: single);
+ procedure SetLoop(Enabled: boolean);
+
+ procedure FadeIn(Time: real; TargetVolume: single);
+ procedure SetSyncSource(SyncSource: TSyncSource);
+
+ procedure Rewind;
+ function Finished: boolean;
+ function Length: real;
+
+ // Sounds
+ // TODO:
+ // add a TMediaDummyPlaybackStream implementation that will
+ // be used by the TSoundLib whenever OpenSound() fails, so checking for
+ // nil-pointers is not neccessary anymore.
+ // PlaySound/StopSound will be removed then, OpenSound will be renamed to
+ // CreateSound.
+ function OpenSound(const Filename: String): TAudioPlaybackStream;
+ procedure PlaySound(Stream: TAudioPlaybackStream);
+ procedure StopSound(Stream: TAudioPlaybackStream);
+
+ // Equalizer
+ procedure GetFFTData(var Data: TFFTData);
+
+ // Interface for Visualizer
+ function GetPCMData(var Data: TPCMData): Cardinal;
+
+ function CreateVoiceStream(ChannelMap: integer; FormatInfo: TAudioFormatInfo): TAudioVoiceStream;
+ end;
+
+ IGenericDecoder = Interface
+ ['{557B0E9A-604D-47E4-B826-13769F3E10B7}']
+ function GetName(): String;
+ function InitializeDecoder(): boolean;
+ function FinalizeDecoder(): boolean;
+ //function IsSupported(const Filename: string): boolean;
+ end;
+
+ (*
+ IVideoDecoder = Interface( IGenericDecoder )
+ ['{2F184B2B-FE69-44D5-9031-0A2462391DCA}']
+ function Open(const Filename: string): TVideoDecodeStream;
+ end;
+ *)
+
+ IAudioDecoder = Interface( IGenericDecoder )
+ ['{AB47B1B6-2AA9-4410-BF8C-EC79561B5478}']
+ function Open(const Filename: string): TAudioDecodeStream;
+ end;
+
+ IAudioInput = Interface
+ ['{A5C8DA92-2A0C-4AB2-849B-2F7448C6003A}']
+ function GetName: String;
+ function InitializeRecord: boolean;
+ function FinalizeRecord(): boolean;
+
+ procedure CaptureStart;
+ procedure CaptureStop;
+ end;
+
+type
+ TAudioConverter = class
+ protected
+ fSrcFormatInfo: TAudioFormatInfo;
+ fDstFormatInfo: TAudioFormatInfo;
+ public
+ function Init(SrcFormatInfo: TAudioFormatInfo; DstFormatInfo: TAudioFormatInfo): boolean; virtual;
+ destructor Destroy(); override;
+
+ (**
+ * Converts the InputBuffer and stores the result in OutputBuffer.
+ * If the result is not -1, InputSize will be set to the actual number of
+ * input-buffer bytes used.
+ * Returns the number of bytes written to the output-buffer or -1 if an error occured.
+ *)
+ function Convert(InputBuffer: PChar; OutputBuffer: PChar; var InputSize: integer): integer; virtual; abstract;
+
+ (**
+ * Destination/Source size ratio
+ *)
+ function GetRatio(): double; virtual; abstract;
+
+ function GetOutputBufferSize(InputSize: integer): integer; virtual; abstract;
+ property SrcFormatInfo: TAudioFormatInfo read fSrcFormatInfo;
+ property DstFormatInfo: TAudioFormatInfo read fDstFormatInfo;
+ end;
+
+(* TODO
+const
+ SOUNDID_START = 0;
+ SOUNDID_BACK = 1;
+ SOUNDID_SWOOSH = 2;
+ SOUNDID_CHANGE = 3;
+ SOUNDID_OPTION = 4;
+ SOUNDID_CLICK = 5;
+ LAST_SOUNDID = SOUNDID_CLICK;
+
+ BaseSoundFilenames: array[0..LAST_SOUNDID] of string = (
+ '%SOUNDPATH%/Common start.mp3', // Start
+ '%SOUNDPATH%/Common back.mp3', // Back
+ '%SOUNDPATH%/menu swoosh.mp3', // Swoosh
+ '%SOUNDPATH%/select music change music 50.mp3', // Change
+ '%SOUNDPATH%/option change col.mp3', // Option
+ '%SOUNDPATH%/rimshot022b.mp3' // Click
+ {
+ '%SOUNDPATH%/bassdrumhard076b.mp3', // Drum (unused)
+ '%SOUNDPATH%/hihatclosed068b.mp3', // Hihat (unused)
+ '%SOUNDPATH%/claps050b.mp3', // Clap (unused)
+ '%SOUNDPATH%/Shuffle.mp3' // Shuffle (unused)
+ }
+ );
+*)
+
+type
+ TSoundLibrary = class
+ private
+ // TODO
+ //Sounds: array of TAudioPlaybackStream;
+ public
+ // TODO: move sounds to the private section
+ // and provide IDs instead.
+ Start: TAudioPlaybackStream;
+ Back: TAudioPlaybackStream;
+ Swoosh: TAudioPlaybackStream;
+ Change: TAudioPlaybackStream;
+ Option: TAudioPlaybackStream;
+ Click: TAudioPlaybackStream;
+ BGMusic: TAudioPlaybackStream;
+
+ constructor Create();
+ destructor Destroy(); override;
+
+ procedure LoadSounds();
+ procedure UnloadSounds();
+
+ procedure StartBgMusic();
+ procedure PauseBgMusic();
+ // TODO
+ //function AddSound(Filename: string): integer;
+ //procedure RemoveSound(ID: integer);
+ //function GetSound(ID: integer): TAudioPlaybackStream;
+ //property Sound[ID: integer]: TAudioPlaybackStream read GetSound; default;
+ end;
+
+var
+ // TODO: JB --- THESE SHOULD NOT BE GLOBAL
+ Lines: array of TLines;
+ LyricsState: TLyricsState;
+ SoundLib: TSoundLibrary;
+
+
+procedure InitializeSound;
+procedure InitializeVideo;
+procedure FinalizeMedia;
+
+function Visualization(): IVideoPlayback;
+function VideoPlayback(): IVideoPlayback;
+function AudioPlayback(): IAudioPlayback;
+function AudioInput(): IAudioInput;
+function AudioDecoders(): TInterfaceList;
+
+function MediaManager: TInterfaceList;
+
+procedure DumpMediaInterfaces();
+
+implementation
+
+uses
+ sysutils,
+ math,
+ UIni,
+ UMain,
+ UCommandLine,
+ URecord,
+ ULog;
+
+var
+ DefaultVideoPlayback : IVideoPlayback;
+ DefaultVisualization : IVideoPlayback;
+ DefaultAudioPlayback : IAudioPlayback;
+ DefaultAudioInput : IAudioInput;
+ AudioDecoderList : TInterfaceList;
+ MediaInterfaceList : TInterfaceList;
+
+
+constructor TAudioFormatInfo.Create(Channels: byte; SampleRate: double; Format: TAudioSampleFormat);
+begin
+ inherited Create();
+ fChannels := Channels;
+ fSampleRate := SampleRate;
+ fFormat := Format;
+ UpdateFrameSize();
+end;
+
+procedure TAudioFormatInfo.SetChannels(Channels: byte);
+begin
+ fChannels := Channels;
+ UpdateFrameSize();
+end;
+
+procedure TAudioFormatInfo.SetFormat(Format: TAudioSampleFormat);
+begin
+ fFormat := Format;
+ UpdateFrameSize();
+end;
+
+function TAudioFormatInfo.GetBytesPerSec(): double;
+begin
+ Result := FrameSize * SampleRate;
+end;
+
+procedure TAudioFormatInfo.UpdateFrameSize();
+begin
+ fFrameSize := AudioSampleSize[fFormat] * fChannels;
+end;
+
+function TAudioFormatInfo.Copy(): TAudioFormatInfo;
+begin
+ Result := TAudioFormatInfo.Create(Self.Channels, Self.SampleRate, Self.Format);
+end;
+
+function TAudioFormatInfo.GetRatio(TargetInfo: TAudioFormatInfo): double;
+begin
+ Result := (TargetInfo.FrameSize / Self.FrameSize) *
+ (TargetInfo.SampleRate / Self.SampleRate)
+end;
+
+
+function MediaManager: TInterfaceList;
+begin
+ if (not assigned(MediaInterfaceList)) then
+ MediaInterfaceList := TInterfaceList.Create();
+ Result := MediaInterfaceList;
+end;
+
+function VideoPlayback(): IVideoPlayback;
+begin
+ Result := DefaultVideoPlayback;
+end;
+
+function Visualization(): IVideoPlayback;
+begin
+ Result := DefaultVisualization;
+end;
+
+function AudioPlayback(): IAudioPlayback;
+begin
+ Result := DefaultAudioPlayback;
+end;
+
+function AudioInput(): IAudioInput;
+begin
+ Result := DefaultAudioInput;
+end;
+
+function AudioDecoders(): TInterfaceList;
+begin
+ Result := AudioDecoderList;
+end;
+
+procedure FilterInterfaceList(const IID: TGUID; InList, OutList: TInterfaceList);
+var
+ i: integer;
+ obj: IInterface;
+begin
+ if (not assigned(OutList)) then
+ Exit;
+
+ OutList.Clear;
+ for i := 0 to InList.Count-1 do
+ begin
+ if assigned(InList[i]) then
+ begin
+ // add object to list if it implements the interface searched for
+ if (InList[i].QueryInterface(IID, obj) = 0) then
+ OutList.Add(obj);
+ end;
+ end;
+end;
+
+procedure InitializeSound;
+var
+ i: integer;
+ InterfaceList: TInterfaceList;
+ CurrentAudioDecoder: IAudioDecoder;
+ CurrentAudioPlayback: IAudioPlayback;
+ CurrentAudioInput: IAudioInput;
+begin
+ // create a temporary list for interface enumeration
+ InterfaceList := TInterfaceList.Create();
+
+ // initialize all audio-decoders first
+ FilterInterfaceList(IAudioDecoder, MediaManager, InterfaceList);
+ for i := 0 to InterfaceList.Count-1 do
+ begin
+ CurrentAudioDecoder := IAudioDecoder(InterfaceList[i]);
+ if (not CurrentAudioDecoder.InitializeDecoder()) then
+ begin
+ Log.LogError('Initialize failed, Removing - '+ CurrentAudioDecoder.GetName);
+ MediaManager.Remove(CurrentAudioDecoder);
+ end;
+ end;
+
+ // create and setup decoder-list (see AudioDecoders())
+ AudioDecoderList := TInterfaceList.Create;
+ FilterInterfaceList(IAudioDecoder, MediaManager, AudioDecoders);
+
+ // find and initialize playback interface
+ DefaultAudioPlayback := nil;
+ FilterInterfaceList(IAudioPlayback, MediaManager, InterfaceList);
+ for i := 0 to InterfaceList.Count-1 do
+ begin
+ CurrentAudioPlayback := IAudioPlayback(InterfaceList[i]);
+ if (CurrentAudioPlayback.InitializePlayback()) then
+ begin
+ DefaultAudioPlayback := CurrentAudioPlayback;
+ break;
+ end;
+ Log.LogError('Initialize failed, Removing - '+ CurrentAudioPlayback.GetName);
+ MediaManager.Remove(CurrentAudioPlayback);
+ end;
+
+ // find and initialize input interface
+ DefaultAudioInput := nil;
+ FilterInterfaceList(IAudioInput, MediaManager, InterfaceList);
+ for i := 0 to InterfaceList.Count-1 do
+ begin
+ CurrentAudioInput := IAudioInput(InterfaceList[i]);
+ if (CurrentAudioInput.InitializeRecord()) then
+ begin
+ DefaultAudioInput := CurrentAudioInput;
+ break;
+ end;
+ Log.LogError('Initialize failed, Removing - '+ CurrentAudioInput.GetName);
+ MediaManager.Remove(CurrentAudioInput);
+ end;
+
+ InterfaceList.Free;
+
+ // Update input-device list with registered devices
+ AudioInputProcessor.UpdateInputDeviceConfig();
+
+ // Load in-game sounds
+ SoundLib := TSoundLibrary.Create;
+end;
+
+procedure InitializeVideo();
+var
+ i: integer;
+ InterfaceList: TInterfaceList;
+ VideoInterface: IVideoPlayback;
+ VisualInterface: IVideoVisualization;
+begin
+ InterfaceList := TInterfaceList.Create;
+
+ // initialize and set video-playback singleton
+ DefaultVideoPlayback := nil;
+ FilterInterfaceList(IVideoPlayback, MediaManager, InterfaceList);
+ for i := 0 to InterfaceList.Count-1 do
+ begin
+ VideoInterface := IVideoPlayback(InterfaceList[i]);
+ if (VideoInterface.Init()) then
+ begin
+ DefaultVideoPlayback := VideoInterface;
+ break;
+ end;
+ Log.LogError('Initialize failed, Removing - '+ VideoInterface.GetName);
+ MediaManager.Remove(VideoInterface);
+ end;
+
+ // initialize and set visualization singleton
+ DefaultVisualization := nil;
+ FilterInterfaceList(IVideoVisualization, MediaManager, InterfaceList);
+ for i := 0 to InterfaceList.Count-1 do
+ begin
+ VisualInterface := IVideoVisualization(InterfaceList[i]);
+ if (VisualInterface.Init()) then
+ begin
+ DefaultVisualization := VisualInterface;
+ break;
+ end;
+ Log.LogError('Initialize failed, Removing - '+ VisualInterface.GetName);
+ MediaManager.Remove(VisualInterface);
+ end;
+
+ InterfaceList.Free;
+
+ // now that we have all interfaces, we can dump them
+ // TODO: move this to another place
+ if FindCmdLineSwitch( cMediaInterfaces ) then
+ begin
+ DumpMediaInterfaces();
+ halt;
+ end;
+end;
+
+procedure UnloadMediaModules;
+var
+ i: integer;
+ InterfaceList: TInterfaceList;
+begin
+ FreeAndNil(AudioDecoderList);
+ DefaultAudioPlayback := nil;
+ DefaultAudioInput := nil;
+ DefaultVideoPlayback := nil;
+ DefaultVisualization := nil;
+
+ // create temporary interface list
+ InterfaceList := TInterfaceList.Create();
+
+ // finalize audio playback interfaces (should be done before the decoders)
+ FilterInterfaceList(IAudioPlayback, MediaManager, InterfaceList);
+ for i := 0 to InterfaceList.Count-1 do
+ IAudioPlayback(InterfaceList[i]).FinalizePlayback();
+
+ // finalize audio input interfaces
+ FilterInterfaceList(IAudioInput, MediaManager, InterfaceList);
+ for i := 0 to InterfaceList.Count-1 do
+ IAudioInput(InterfaceList[i]).FinalizeRecord();
+
+ // finalize audio decoder interfaces
+ FilterInterfaceList(IAudioDecoder, MediaManager, InterfaceList);
+ for i := 0 to InterfaceList.Count-1 do
+ IAudioDecoder(InterfaceList[i]).FinalizeDecoder();
+
+ // finalize video interfaces
+ FilterInterfaceList(IVideoPlayback, MediaManager, InterfaceList);
+ for i := 0 to InterfaceList.Count-1 do
+ IVideoPlayback(InterfaceList[i]).Finalize();
+
+ // finalize audio decoder interfaces
+ FilterInterfaceList(IVideoVisualization, MediaManager, InterfaceList);
+ for i := 0 to InterfaceList.Count-1 do
+ IVideoVisualization(InterfaceList[i]).Finalize();
+
+ InterfaceList.Free;
+
+ // finally free interfaces (by removing all references to them)
+ FreeAndNil(MediaInterfaceList);
+end;
+
+procedure FinalizeMedia;
+begin
+ // stop, close and free sounds
+ SoundLib.Free;
+
+ // stop and close music stream
+ if (AudioPlayback <> nil) then
+ AudioPlayback.Close;
+
+ // stop any active captures
+ if (AudioInput <> nil) then
+ AudioInput.CaptureStop;
+
+ if (VideoPlayback <> nil) then
+ VideoPlayback.Close;
+
+ if (Visualization <> nil) then
+ Visualization.Close;
+
+ UnloadMediaModules();
+end;
+
+procedure DumpMediaInterfaces();
+begin
+ writeln( '' );
+ writeln( '--------------------------------------------------------------' );
+ writeln( ' In-use Media Interfaces ' );
+ writeln( '--------------------------------------------------------------' );
+ writeln( 'Registered Audio Playback Interface : ' + AudioPlayback.GetName );
+ writeln( 'Registered Audio Input Interface : ' + AudioInput.GetName );
+ writeln( 'Registered Video Playback Interface : ' + VideoPlayback.GetName );
+ writeln( 'Registered Visualization Interface : ' + Visualization.GetName );
+ writeln( '--------------------------------------------------------------' );
+ writeln( '' );
+end;
+
+
+{ TSoundLibrary }
+
+constructor TSoundLibrary.Create();
+begin
+ inherited;
+ LoadSounds();
+end;
+
+destructor TSoundLibrary.Destroy();
+begin
+ UnloadSounds();
+ inherited;
+end;
+
+procedure TSoundLibrary.LoadSounds();
+begin
+ UnloadSounds();
+
+ Start := AudioPlayback.OpenSound(SoundPath + 'Common start.mp3');
+ Back := AudioPlayback.OpenSound(SoundPath + 'Common back.mp3');
+ Swoosh := AudioPlayback.OpenSound(SoundPath + 'menu swoosh.mp3');
+ Change := AudioPlayback.OpenSound(SoundPath + 'select music change music 50.mp3');
+ Option := AudioPlayback.OpenSound(SoundPath + 'option change col.mp3');
+ Click := AudioPlayback.OpenSound(SoundPath + 'rimshot022b.mp3');
+
+ BGMusic := AudioPlayback.OpenSound(SoundPath + 'Bebeto_-_Loop010.mp3');
+
+ if (BGMusic <> nil) then
+ BGMusic.Loop := True;
+end;
+
+procedure TSoundLibrary.UnloadSounds();
+begin
+ FreeAndNil(Start);
+ FreeAndNil(Back);
+ FreeAndNil(Swoosh);
+ FreeAndNil(Change);
+ FreeAndNil(Option);
+ FreeAndNil(Click);
+ FreeAndNil(BGMusic);
+end;
+
+(* TODO
+function TSoundLibrary.GetSound(ID: integer): TAudioPlaybackStream;
+begin
+ if ((ID >= 0) and (ID < Length(Sounds))) then
+ Result := Sounds[ID]
+ else
+ Result := nil;
+end;
+*)
+
+procedure TSoundLibrary.StartBgMusic();
+begin
+ if (TBackgroundMusicOption(Ini.BackgroundMusicOption) = bmoOn) and
+ (Soundlib.BGMusic <> nil) and not (Soundlib.BGMusic.Status = ssPlaying) then
+ begin
+ AudioPlayback.PlaySound(Soundlib.BGMusic);
+ end;
+end;
+
+procedure TSoundLibrary.PauseBgMusic();
+begin
+ If (Soundlib.BGMusic <> nil) then
+ begin
+ Soundlib.BGMusic.Pause;
+ end;
+end;
+
+{ TVoiceRemoval }
+
+procedure TVoiceRemoval.Callback(Buffer: PChar; BufSize: integer);
+var
+ FrameIndex, FrameSize: integer;
+ Value: integer;
+ Sample: PPCMStereoSample;
+begin
+ FrameSize := 2 * SizeOf(SmallInt);
+ for FrameIndex := 0 to (BufSize div FrameSize)-1 do
+ begin
+ Sample := PPCMStereoSample(Buffer);
+ // channel difference
+ Value := Sample[0] - Sample[1];
+ // clip
+ if (Value > High(SmallInt)) then
+ Value := High(SmallInt)
+ else if (Value < Low(SmallInt)) then
+ Value := Low(SmallInt);
+ // assign result
+ Sample[0] := Value;
+ Sample[1] := Value;
+ // increase to next frame
+ Inc(Buffer, FrameSize);
+ end;
+end;
+
+
+{ TVoiceRemoval }
+
+constructor TLyricsState.Create();
+begin
+ // create a triggered timer, so we can Pause() it, set the time
+ // and Resume() it afterwards for better synching.
+ Timer := TRelativeTimer.Create(true);
+
+ // reset state
+ Reset();
+end;
+
+procedure TLyricsState.Pause();
+begin
+ Timer.Pause();
+end;
+
+procedure TLyricsState.Resume();
+begin
+ Timer.Resume();
+end;
+
+procedure TLyricsState.SetCurrentTime(Time: real);
+begin
+ // do not start the timer (if not started already),
+ // after setting the current time
+ Timer.SetTime(Time, false);
+end;
+
+function TLyricsState.GetCurrentTime(): real;
+begin
+ Result := Timer.GetTime();
+end;
+
+(**
+ * Resets the timer and state of the lyrics.
+ * The timer will be stopped afterwards so you have to call Resume()
+ * to start the lyrics timer.
+ *)
+procedure TLyricsState.Reset();
+begin
+ Pause();
+ SetCurrentTime(0);
+
+ StartTime := 0;
+ TotalTime := 0;
+
+ OldBeat := -1;
+ MidBeat := -1;
+ CurrentBeat := -1;
+
+ OldBeatC := -1;
+ MidBeatC := -1;
+ CurrentBeatC := -1;
+
+ OldBeatD := -1;
+ MidBeatD := -1;
+ CurrentBeatD := -1;
+end;
+
+(**
+ * Updates the beat information (CurrentBeat/MidBeat/...) according to the
+ * current lyric time.
+ *)
+procedure TLyricsState.UpdateBeats();
+var
+ CurLyricsTime: real;
+begin
+ CurLyricsTime := GetCurrentTime();
+
+ OldBeat := CurrentBeat;
+ MidBeat := GetMidBeat(CurLyricsTime - StartTime / 1000);
+ CurrentBeat := Floor(MidBeat);
+
+ OldBeatC := CurrentBeatC;
+ MidBeatC := GetMidBeat(CurLyricsTime - StartTime / 1000);
+ CurrentBeatC := Floor(MidBeatC);
+
+ OldBeatD := CurrentBeatD;
+ // MidBeatD = MidBeat with additional GAP
+ MidBeatD := -0.5 + GetMidBeat(CurLyricsTime - (StartTime + 120 + 20) / 1000);
+ CurrentBeatD := Floor(MidBeatD);
+end;
+
+
+{ TAudioConverter }
+
+function TAudioConverter.Init(SrcFormatInfo: TAudioFormatInfo; DstFormatInfo: TAudioFormatInfo): boolean;
+begin
+ fSrcFormatInfo := SrcFormatInfo.Copy();
+ fDstFormatInfo := DstFormatInfo.Copy();
+ Result := true;
+end;
+
+destructor TAudioConverter.Destroy();
+begin
+ FreeAndNil(fSrcFormatInfo);
+ FreeAndNil(fDstFormatInfo);
+end;
+
+
+{ TAudioProcessingStream }
+
+procedure TAudioProcessingStream.AddOnCloseHandler(Handler: TOnCloseHandler);
+begin
+ if (@Handler <> nil) then
+ begin
+ SetLength(OnCloseHandlers, System.Length(OnCloseHandlers)+1);
+ OnCloseHandlers[High(OnCloseHandlers)] := @Handler;
+ end;
+end;
+
+procedure TAudioProcessingStream.PerformOnClose();
+var i: integer;
+begin
+ for i := 0 to High(OnCloseHandlers) do
+ begin
+ OnCloseHandlers[i](Self);
+ end;
+end;
+
+
+{ TAudioPlaybackStream }
+
+function TAudioPlaybackStream.GetSourceStream(): TAudioSourceStream;
+begin
+ Result := SourceStream;
+end;
+
+procedure TAudioPlaybackStream.SetSyncSource(SyncSource: TSyncSource);
+begin
+ Self.SyncSource := SyncSource;
+ AvgSyncDiff := -1;
+end;
+
+(*
+ * Results an adjusted size of the input buffer size to keep the stream in sync
+ * with the SyncSource. If no SyncSource was assigned to this stream, the
+ * input buffer size will be returned, so this method will have no effect.
+ *
+ * These are the possible cases:
+ * - Result > BufferSize: stream is behind the sync-source (stream is too slow),
+ * (Result-BufferSize) bytes of the buffer must be skipped.
+ * - Result = BufferSize: stream is in sync,
+ * there is nothing to do.
+ * - Result < BufferSize: stream is ahead of the sync-source (stream is too fast),
+ * (BufferSize-Result) bytes of the buffer must be padded.
+ *)
+function TAudioPlaybackStream.Synchronize(BufferSize: integer; FormatInfo: TAudioFormatInfo): integer;
+var
+ TimeDiff: double;
+ TimeCorrectionFactor: double;
+const
+ AVG_HISTORY_FACTOR = 0.9;
+ SYNC_THRESHOLD = 0.045;
+ MAX_SYNC_DIFF_TIME = 0.002;
+begin
+ Result := BufferSize;
+
+ if (not assigned(SyncSource)) then
+ Exit;
+
+ if (BufferSize <= 0) then
+ Exit;
+
+ // difference between sync-source and stream position
+ // (negative if the music-stream's position is ahead of the master clock)
+ TimeDiff := SyncSource.GetClock() - (Position - GetLatency());
+
+ // calculate average time difference (some sort of weighted mean).
+ // The bigger AVG_HISTORY_FACTOR is, the smoother is the average diff.
+ // This means that older diffs are weighted more with a higher history factor
+ // than with a lower. Do not use a too low history factor. FFmpeg produces
+ // very instable timestamps (pts) for ogg due to some bugs. They may differ
+ // +-50ms from the real stream position. Without filtering those glitches we
+ // would synch without any need, resulting in ugly plopping sounds.
+ if (AvgSyncDiff = -1) then
+ AvgSyncDiff := TimeDiff
+ else
+ AvgSyncDiff := TimeDiff * (1-AVG_HISTORY_FACTOR) +
+ AvgSyncDiff * AVG_HISTORY_FACTOR;
+
+ // check if sync needed
+ if (Abs(AvgSyncDiff) >= SYNC_THRESHOLD) then
+ begin
+ // TODO: use SetPosition if diff is too large (>5s)
+ if (TimeDiff < 1) then
+ TimeCorrectionFactor := Sign(TimeDiff)*TimeDiff*TimeDiff
+ else
+ TimeCorrectionFactor := TimeDiff;
+
+ // calculate adapted buffer size
+ // reduce size of data to fetch if music is ahead, increase otherwise
+ Result := BufferSize + Round(TimeCorrectionFactor * FormatInfo.SampleRate) * FormatInfo.FrameSize;
+ if (Result < 0) then
+ Result := 0;
+
+ // reset average
+ AvgSyncDiff := -1;
+ end;
+
+ (*
+ DebugWriteln('Diff: ' + floattostrf(TimeDiff, ffFixed, 15, 3) +
+ '| SyS: ' + floattostrf(SyncSource.GetClock(), ffFixed, 15, 3) +
+ '| Pos: ' + floattostrf(Position, ffFixed, 15, 3) +
+ '| Avg: ' + floattostrf(AvgSyncDiff, ffFixed, 15, 3));
+ *)
+end;
+
+(*
+ * Fills a buffer with copies of the given frame or with 0 if frame.
+ *)
+procedure TAudioPlaybackStream.FillBufferWithFrame(Buffer: PChar; BufferSize: integer; Frame: PChar; FrameSize: integer);
+var
+ i: integer;
+ FrameCopyCount: integer;
+begin
+ // the buffer must at least contain place for one copy of the frame.
+ if ((Buffer = nil) or (BufferSize <= 0) or (BufferSize < FrameSize)) then
+ Exit;
+
+ // no valid frame -> fill with 0
+ if ((Frame = nil) or (FrameSize <= 0)) then
+ begin
+ FillChar(Buffer[0], BufferSize, 0);
+ Exit;
+ end;
+
+ // number of frames to copy
+ FrameCopyCount := BufferSize div FrameSize;
+ // insert as many copies of frame into the buffer as possible
+ for i := 0 to FrameCopyCount-1 do
+ Move(Frame[0], Buffer[i*FrameSize], FrameSize);
+end;
+
+{ TAudioVoiceStream }
+
+function TAudioVoiceStream.Open(ChannelMap: integer; FormatInfo: TAudioFormatInfo): boolean;
+begin
+ Self.ChannelMap := ChannelMap;
+ Self.FormatInfo := FormatInfo.Copy();
+ // a voice stream is always mono, reassure the the format is correct
+ Self.FormatInfo.Channels := 1;
+ Result := true;
+end;
+
+destructor TAudioVoiceStream.Destroy;
+begin
+ Close();
+ inherited;
+end;
+
+procedure TAudioVoiceStream.Close();
+begin
+ PerformOnClose();
+ FreeAndNil(FormatInfo);
+end;
+
+function TAudioVoiceStream.GetAudioFormatInfo(): TAudioFormatInfo;
+begin
+ Result := FormatInfo;
+end;
+
+function TAudioVoiceStream.GetLength(): real;
+begin
+ Result := -1;
+end;
+
+function TAudioVoiceStream.GetPosition(): real;
+begin
+ Result := -1;
+end;
+
+procedure TAudioVoiceStream.SetPosition(Time: real);
+begin
+end;
+
+function TAudioVoiceStream.GetLoop(): boolean;
+begin
+ Result := false;
+end;
+
+procedure TAudioVoiceStream.SetLoop(Enabled: boolean);
+begin
+end;
+
+
+end.
diff --git a/src/base/UParty.pas b/src/base/UParty.pas
new file mode 100644
index 00000000..01a182b1
--- /dev/null
+++ b/src/base/UParty.pas
@@ -0,0 +1,630 @@
+unit UParty;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE DELPHI}
+{$ENDIF}
+
+{$I switches.inc}
+
+uses UPartyDefs, UCoreModule, UPluginDefs;
+
+type
+ ARounds = Array [0..252] of Integer; //0..252 needed for
+ PARounds = ^ARounds;
+
+ TRoundInfo = record
+ Modi: Cardinal;
+ Winner: Byte;
+ end;
+
+ TeamOrderEntry = record
+ Teamnum: Byte;
+ Score: Byte;
+ end;
+
+ TeamOrderArray = Array[0..5] of Byte;
+
+ TUS_ModiInfoEx = record
+ Info: TUS_ModiInfo;
+ Owner: Integer;
+ TimesPlayed: Byte; //Helper for setting Round Plugins
+ end;
+
+ TPartySession = class (TCoreModule)
+ private
+ bPartyMode: Boolean; //Is this Party or Singleplayer
+ CurRound: Byte;
+
+ Modis: Array of TUS_ModiInfoEx;
+ Teams: TTeamInfo;
+
+ function IsWinner(Player, Winner: Byte): boolean;
+ procedure GenScores;
+ function GetRandomPlugin(TeamMode: Boolean): Cardinal;
+ function GetRandomPlayer(Team: Byte): Byte;
+ public
+ //Teams: TTeamInfo;
+ Rounds: array of TRoundInfo;
+
+ //TCoreModule methods to inherit
+ Constructor Create; override;
+ Procedure Info(const pInfo: PModuleInfo); override;
+ Function Load: Boolean; override;
+ Function Init: Boolean; override;
+ Procedure DeInit; override;
+ Destructor Destroy; override;
+
+ //Register Modi Service
+ Function RegisterModi(nothin: TwParam; pModiInfo: TlParam): integer; //Registers a new Modi. wParam: Pointer to TUS_ModiInfo
+
+ //Start new Party
+ Function StartParty(NumRounds: TwParam; PAofIRounds: TlParam): integer; //Starts new Party Mode. Returns Non Zero on Success
+ Function GetCurModi(wParam: TwParam; lParam: TlParam): integer; //Returns Pointer to Cur. Modis TUS_ModiInfo (to Use with Singscreen)
+ Function StopParty(wParam: TwParam; lParam: TlParam): integer; //Stops Party Mode. Returns 1 If Partymode was enabled before.
+ Function NextRound(wParam: TwParam; lParam: TlParam): integer; //Increases CurRound by 1; Returns num of Round or -1 if last Round is already played
+
+ Function CallModiInit(wParam: TwParam; lParam: TlParam): integer; //Calls CurModis Init Proc. If an Error occurs, Returns Nonzero. In this Case a New Plugin was Selected. Please renew Loading
+ Function CallModiDeInit(wParam: TwParam; lParam: TlParam): integer; //Calls DeInitProc and does the RoundEnding
+
+ Function GetTeamInfo(wParam: TwParam; pTeamInfo: TlParam): integer; //Writes TTeamInfo Record to Pointer at lParam. Returns Zero on Success
+ Function SetTeamInfo(wParam: TwParam; pTeamInfo: TlParam): integer; //Read TTeamInfo Record from Pointer at lParam. Returns Zero on Success
+
+ Function GetTeamOrder(wParam: TwParam; lParam: TlParam): integer; //Returns Team Order. Structure: Bits 1..3: Team at Place1; Bits 4..6: Team at Place2 ...
+ Function GetWinnerString(wParam: TwParam; lParam: TlParam): integer; //wParam is Roundnum. If (Pointer = nil) then Return Length of the String. Otherwise Write the String to Address at lParam
+ end;
+
+const
+ StandardModi = 0; //Modi ID that will be played in non party Mode
+
+implementation
+
+uses UCore, UGraphic, UMain, ULanguage, ULog, SysUtils;
+
+{*********************
+ TPluginLoader
+ Implentation
+*********************}
+
+//-------------
+// Function that gives some Infos about the Module to the Core
+//-------------
+Procedure TPartySession.Info(const pInfo: PModuleInfo);
+begin
+ pInfo^.Name := 'TPartySession';
+ pInfo^.Version := MakeVersion(1,0,0,chr(0));
+ pInfo^.Description := 'Manages Party Modi and Party Game';
+end;
+
+//-------------
+// Just the Constructor
+//-------------
+Constructor TPartySession.Create;
+begin
+ inherited;
+ //UnSet PartyMode
+ bPartyMode := False;
+end;
+
+//-------------
+//Is Called on Loading.
+//In this Method only Events and Services should be created
+//to offer them to other Modules or Plugins during the Init process
+//If False is Returned this will cause a Forced Exit
+//-------------
+Function TPartySession.Load: Boolean;
+begin
+ //Add Register Party Modi Service
+ Result := True;
+ Core.Services.AddService('Party/RegisterModi', nil, Self.RegisterModi);
+ Core.Services.AddService('Party/StartParty', nil, Self.StartParty);
+ Core.Services.AddService('Party/GetCurModi', nil, Self.GetCurModi);
+end;
+
+//-------------
+//Is Called on Init Process
+//In this Method you can Hook some Events and Create + Init
+//your Classes, Variables etc.
+//If False is Returned this will cause a Forced Exit
+//-------------
+Function TPartySession.Init: Boolean;
+begin
+ //Just set Prvate Var to true.
+ Result := true;
+end;
+
+//-------------
+//Is Called if this Module has been Inited and there is a Exit.
+//Deinit is in backwards Initing Order
+//-------------
+Procedure TPartySession.DeInit;
+begin
+ //Force DeInit
+
+end;
+
+//-------------
+//Is Called if this Module will be unloaded and has been created
+//Should be used to Free Memory
+//-------------
+Destructor TPartySession.Destroy;
+begin
+ //Just save some Memory if it wasn't done now..
+ SetLength(Modis, 0);
+ inherited;
+end;
+
+//-------------
+// Registers a new Modi. wParam: Pointer to TUS_ModiInfo
+// Service for Plugins
+//-------------
+Function TPartySession.RegisterModi(nothin: TwParam; pModiInfo: TlParam): integer;
+var
+ Len: Integer;
+ Info: PUS_ModiInfo;
+begin
+ Info := PModiInfo;
+ //Copy Info if cbSize is correct
+ If (Info.cbSize = SizeOf(TUS_ModiInfo)) then
+ begin
+ Len := Length(Modis);
+ SetLength(Modis, Len + 1);
+
+ Modis[Len].Info := Info^;
+ end
+ else
+ Core.ReportError(Integer(PChar('Plugins try to Register Modi with wrong Pointer, or wrong TUS_ModiInfo Record.')), PChar('TPartySession'));
+
+ // FIXME: return a valid result
+ Result := 0;
+end;
+
+//----------
+// Returns a Number of a Random Plugin
+//----------
+Function TPartySession.GetRandomPlugin(TeamMode: Boolean): Cardinal;
+var
+ LowestTP: Byte;
+ NumPwithLTP: Word;
+ I: Integer;
+ R: Word;
+begin
+ Result := StandardModi; //If there are no matching Modis, Play StandardModi
+ LowestTP := high(Byte);
+ NumPwithLTP := 0;
+
+ //Search for Plugins not often played yet
+ For I := 0 to high(Modis) do
+ begin
+ if (Modis[I].TimesPlayed < lowestTP) And (((Modis[I].Info.LoadingSettings AND MLS_TeamOnly) <> 0) = TeamMode) then
+ begin
+ lowestTP := Modis[I].TimesPlayed;
+ NumPwithLTP := 1;
+ end
+ else if (Modis[I].TimesPlayed = lowestTP) And (((Modis[I].Info.LoadingSettings AND MLS_TeamOnly) <> 0) = TeamMode) then
+ begin
+ Inc(NumPwithLTP);
+ end;
+ end;
+
+ //Create Random No
+ R := Random(NumPwithLTP);
+
+ //Search for Random Plugin
+ For I := 0 to high(Modis) do
+ begin
+ if (Modis[I].TimesPlayed = lowestTP) And (((Modis[I].Info.LoadingSettings AND MLS_TeamOnly) <> 0) = TeamMode) then
+ begin
+ //Plugin Found
+ if (R = 0) then
+ begin
+ Result := I;
+ Inc(Modis[I].TimesPlayed);
+ Break;
+ end;
+
+ Dec(R);
+ end;
+ end;
+end;
+
+//----------
+// Starts new Party Mode. Returns Non Zero on Success
+//----------
+Function TPartySession.StartParty(NumRounds: TwParam; PAofIRounds: TlParam): integer;
+var
+ I: Integer;
+ aiRounds: PARounds;
+ TeamMode: Boolean;
+begin
+ Result := 0;
+ If (Teams.NumTeams >= 1) AND (NumRounds < High(Byte)-1) then
+ begin
+ bPartyMode := false;
+ aiRounds := PAofIRounds;
+
+ Try
+ //Is this Teammode(More then one Player per Team) ?
+ TeamMode := True;
+ For I := 0 to Teams.NumTeams-1 do
+ TeamMode := TeamMode AND (Teams.Teaminfo[I].NumPlayers > 1);
+
+ //Set Rounds
+ SetLength(Rounds, NumRounds);
+
+ For I := 0 to High(Rounds) do
+ begin //Set Plugins
+ If (aiRounds[I] = -1) then
+ Rounds[I].Modi := GetRandomPlugin(TeamMode)
+ Else If (aiRounds[I] >= 0) AND (aiRounds[I] <= High(Modis)) AND (TeamMode OR ((Modis[aiRounds[I]].Info.LoadingSettings AND MLS_TeamOnly) = 0)) then
+ Rounds[I].Modi := aiRounds[I]
+ Else
+ Rounds[I].Modi := StandardModi;
+
+ Rounds[I].Winner := High(Byte); //Set Winner to Not Played
+ end;
+
+ CurRound := High(Byte); //Set CurRound to not defined
+
+ //Return teh true and Set PartyMode
+ bPartyMode := True;
+ Result := 1;
+
+ Except
+ Core.ReportError(Integer(PChar('Can''t start PartyMode.')), PChar('TPartySession'));
+ end;
+ end;
+end;
+
+//----------
+// Returns Pointer to Cur. ModiInfoEx (to Use with Singscreen)
+//----------
+Function TPartySession.GetCurModi(wParam: TwParam; lParam: TlParam): integer;
+begin
+ If (bPartyMode) AND (CurRound <= High(Rounds)) then
+ begin //If PartyMode is enabled:
+ //Return the Plugin of the Cur Round
+ Result := Integer(@Modis[Rounds[CurRound].Modi]);
+ end
+ else
+ begin //Return StandardModi
+ Result := Integer(@Modis[StandardModi]);
+ end;
+end;
+
+//----------
+// Stops Party Mode. Returns 1 If Partymode was enabled before. And -1 if Change was not possible
+//----------
+Function TPartySession.StopParty(wParam: TwParam; lParam: TlParam): integer;
+begin
+ Result := -1;
+ If (bPartyMode) then
+ begin
+ // to-do : Whit�: Check here if SingScreen is not Shown atm.
+ bPartyMode := False;
+ Result := 1;
+ end
+ else
+ Result := 0;
+end;
+
+//----------
+//GetRandomPlayer - Gives back a Random Player to Play next Round
+//----------
+function TPartySession.GetRandomPlayer(Team: Byte): Byte;
+var
+ I, R: Integer;
+ lowestTP: Byte;
+ NumPwithLTP: Byte;
+begin
+ LowestTP := high(Byte);
+ NumPwithLTP := 0;
+ Result := 0;
+
+ //Search for Players that have not often played yet
+ For I := 0 to Teams.Teaminfo[Team].NumPlayers-1 do
+ begin
+ if (Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed < lowestTP) then
+ begin
+ lowestTP := Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed;
+ NumPwithLTP := 1;
+ end
+ else if (Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed = lowestTP) then
+ begin
+ Inc(NumPwithLTP);
+ end;
+ end;
+
+ //Create Random No
+ R := Random(NumPwithLTP);
+
+ //Search for Random Player
+ For I := 0 to Teams.Teaminfo[Team].NumPlayers-1 do
+ begin
+ if Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed = lowestTP then
+ begin
+ //Player Found
+ if (R = 0) then
+ begin
+ Result := I;
+ Break;
+ end;
+
+ Dec(R);
+ end;
+ end;
+end;
+
+//----------
+// NextRound - Increases CurRound by 1; Returns num of Round or -1 if last Round is already played
+//----------
+Function TPartySession.NextRound(wParam: TwParam; lParam: TlParam): integer;
+var I: Integer;
+begin
+ If ((CurRound < high(Rounds)) OR (CurRound = high(CurRound))) then
+ begin //everythings OK! -> Start the Round, maaaaan
+ Inc(CurRound);
+
+ //Set Players to play this Round
+ for I := 0 to Teams.NumTeams-1 do
+ Teams.Teaminfo[I].CurPlayer := GetRandomPlayer(I);
+
+ // FIXME: return a valid result
+ Result := 0;
+ end
+ else
+ Result := -1;
+end;
+
+//----------
+//IsWinner - Returns True if the Players Bit is set in the Winner Byte
+//----------
+function TPartySession.IsWinner(Player, Winner: Byte): boolean;
+var
+ Bit: Byte;
+begin
+ Bit := 1 shl Player;
+
+ Result := ((Winner AND Bit) = Bit);
+end;
+
+//----------
+//GenScores - Inc Scores for Cur. Round
+//----------
+procedure TPartySession.GenScores;
+var
+ I: Byte;
+begin
+ for I := 0 to Teams.NumTeams-1 do
+ begin
+ if isWinner(I, Rounds[CurRound].Winner) then
+ Inc(Teams.Teaminfo[I].Score);
+ end;
+end;
+
+//----------
+// CallModiInit - Calls CurModis Init Proc. If an Error occurs, Returns Nonzero. In this Case a New Plugin was Selected. Please renew Loading
+//----------
+Function TPartySession.CallModiInit(wParam: TwParam; lParam: TlParam): integer;
+begin
+ If (not bPartyMode) then
+ begin //Set Rounds if not in PartyMode
+ SetLength(Rounds, 1);
+ Rounds[0].Modi := StandardModi;
+ Rounds[0].Winner := High(Byte);
+ CurRound := 0;
+ end;
+
+ Try
+ //Core.
+ Except
+ on E : Exception do
+ begin
+ Core.ReportError(Integer(PChar('Error starting Modi: ' + Modis[Rounds[CurRound].Modi].Info.Name + ' ErrorStr: ' + E.Message)), PChar('TPartySession'));
+ If (Rounds[CurRound].Modi = StandardModi) then
+ begin
+ Core.ReportError(Integer(PChar('Can''t start StandardModi, will exit now!')), PChar('TPartySession'));
+ Halt;
+ end
+ Else //Select StandardModi
+ begin
+ Rounds[CurRound].Modi := StandardModi
+ end;
+ end;
+ End;
+
+ // FIXME: return a valid result
+ Result := 0;
+end;
+
+//----------
+// CallModiDeInit - Calls DeInitProc and does the RoundEnding
+//----------
+Function TPartySession.CallModiDeInit(wParam: TwParam; lParam: TlParam): integer;
+var
+ I: Integer;
+ MaxScore: Word;
+begin
+ If (bPartyMode) then
+ begin
+ //Get Winner Byte!
+ if (@Modis[Rounds[CurRound].Modi].Info.ModiDeInit <> nil) then //get Winners from Plugin
+ Rounds[CurRound].Winner := Modis[Rounds[CurRound].Modi].Info.ModiDeInit(Modis[Rounds[CurRound].Modi].Info.ID)
+ else
+ begin //Create winners by Score :/
+ Rounds[CurRound].Winner := 0;
+ MaxScore := 0;
+ for I := 0 to Teams.NumTeams-1 do
+ begin
+ // to-do : recode Percentage stuff
+ //PlayerInfo.Playerinfo[I].Percentage := PlayerInfo.Playerinfo[I].Score div 9999;
+ if (Player[I].ScoreTotalInt > MaxScore) then
+ begin
+ MaxScore := Player[I].ScoreTotalInt;
+ Rounds[CurRound].Winner := 1 shl I;
+ end
+ else if (Player[I].ScoreTotalInt = MaxScore) AND (Player[I].ScoreTotalInt <> 0) then
+ begin
+ Rounds[CurRound].Winner := Rounds[CurRound].Winner or (1 shl I);
+ end;
+ end;
+
+
+ //When nobody has Points -> Everybody loose
+ if (MaxScore = 0) then
+ Rounds[CurRound].Winner := 0;
+
+ end;
+
+ //Generate teh Scores
+ GenScores;
+
+ //Inc Players TimesPlayed
+ If ((Modis[Rounds[CurRound-1].Modi].Info.LoadingSettings AND MLS_IncTP) = MLS_IncTP) then
+ begin
+ For I := 0 to Teams.NumTeams-1 do
+ Inc(Teams.TeamInfo[I].Playerinfo[Teams.TeamInfo[I].CurPlayer].TimesPlayed);
+ end;
+ end
+ else if (@Modis[Rounds[CurRound].Modi].Info.ModiDeInit <> nil) then
+ Modis[Rounds[CurRound].Modi].Info.ModiDeInit(Modis[Rounds[CurRound].Modi].Info.ID);
+
+ // FIXME: return a valid result
+ Result := 0;
+end;
+
+//----------
+// GetTeamInfo - Writes TTeamInfo Record to Pointer at lParam. Returns Zero on Success
+//----------
+Function TPartySession.GetTeamInfo(wParam: TwParam; pTeamInfo: TlParam): integer;
+var Info: ^TTeamInfo;
+begin
+ Result := -1;
+ Info := pTeamInfo;
+ If (Info <> nil) then
+ begin
+ Try
+ // to - do : Check Delphi memory management in this case
+ //Not sure if i had to copy PChars to a new address or if delphi manages this o0
+ Info^ := Teams;
+ Result := 0;
+ Except
+ Result := -2;
+ End;
+ end;
+end;
+
+//----------
+// SetTeamInfo - Read TTeamInfo Record from Pointer at lParam. Returns Zero on Success
+//----------
+Function TPartySession.SetTeamInfo(wParam: TwParam; pTeamInfo: TlParam): integer;
+var
+ TeamInfobackup: TTeamInfo;
+ Info: ^TTeamInfo;
+begin
+ Result := -1;
+ Info := pTeamInfo;
+ If (Info <> nil) then
+ begin
+ Try
+ TeamInfoBackup := Teams;
+ // to - do : Check Delphi memory management in this case
+ //Not sure if i had to copy PChars to a new address or if delphi manages this o0
+ Teams := Info^;
+ Result := 0;
+ Except
+ Teams := TeamInfoBackup;
+ Result := -2;
+ End;
+ end;
+end;
+
+//----------
+// GetTeamOrder - Returns Team Order. Structure: Bits 1..3: Team at Place1; Bits 4..6: Team at Place2 ...
+//----------
+Function TPartySession.GetTeamOrder(wParam: TwParam; lParam: TlParam): integer;
+var
+ I, J: Integer;
+ ATeams: array [0..5] of TeamOrderEntry;
+ TempTeam: TeamOrderEntry;
+begin
+ // to-do : PartyMode: Write this in another way, so that teams with the same scire get the same Placing
+ //Fill Team Array
+ For I := 0 to Teams.NumTeams-1 do
+ begin
+ ATeams[I].Teamnum := I;
+ ATeams[I].Score := Teams.Teaminfo[I].Score;
+ end;
+
+ //Sort Teams
+ for J := 0 to Teams.NumTeams-1 do
+ for I := 1 to Teams.NumTeams-1 do
+ if ATeams[I].Score > ATeams[I-1].Score then
+ begin
+ TempTeam := ATeams[I-1];
+ ATeams[I-1] := ATeams[I];
+ ATeams[I] := TempTeam;
+ end;
+
+ //Copy to Result
+ Result := 0;
+ For I := 0 to Teams.NumTeams-1 do
+ Result := Result or (ATeams[I].TeamNum Shl I*3);
+end;
+
+//----------
+// GetWinnerString - wParam is Roundnum. If (Pointer = nil) then Return Length of the String. Otherwise Write the String to Address at lParam
+//----------
+Function TPartySession.GetWinnerString(wParam: TwParam; lParam: TlParam): integer;
+var
+ Winners: Array of String;
+ I: Integer;
+ ResultStr: String;
+ S: ^String;
+begin
+ ResultStr := Language.Translate('PARTY_NOBODY');
+
+ if (wParam <= High(Rounds)) then
+ begin
+ if (Rounds[wParam].Winner <> 0) then
+ begin
+ if (Rounds[wParam].Winner = 255) then
+ begin
+ ResultStr := Language.Translate('PARTY_NOTPLAYEDYET');
+ end
+ else
+ begin
+ SetLength(Winners, 0);
+ for I := 0 to Teams.NumTeams-1 do
+ begin
+ if isWinner(I, Rounds[wParam].Winner) then
+ begin
+ SetLength(Winners, Length(Winners) + 1);
+ Winners[high(Winners)] := Teams.TeamInfo[I].Name;
+ end;
+ end;
+ ResultStr := Language.Implode(Winners);
+ end;
+ end;
+ end;
+
+ //Now Return what we have got
+ If (lParam = nil) then
+ begin //ReturnString Length
+ Result := Length(ResultStr);
+ end
+ Else
+ begin //Return String
+ Try
+ S := lParam;
+ S^ := ResultStr;
+ Result := 0;
+ Except
+ Result := -1;
+
+ End;
+ end;
+end;
+
+end.
diff --git a/src/base/UPlatform.pas b/src/base/UPlatform.pas
new file mode 100644
index 00000000..1dcdb5b9
--- /dev/null
+++ b/src/base/UPlatform.pas
@@ -0,0 +1,174 @@
+unit UPlatform;
+
+// Comment by Eddie:
+// This unit defines an interface for platform specific utility functions.
+// The Interface is implemented in separate files for each platform:
+// UPlatformWindows, UPlatformLinux and UPlatformMacOSX.
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+uses Classes;
+
+type
+ TDirectoryEntry = record
+ Name : WideString;
+ IsDirectory : boolean;
+ IsFile : boolean;
+ end;
+
+ TDirectoryEntryArray = array of TDirectoryEntry;
+
+ TPlatform = class
+ function GetExecutionDir(): string;
+ procedure Init; virtual;
+ function DirectoryFindFiles(Dir, Filter: WideString; ReturnAllSubDirs: boolean): TDirectoryEntryArray; virtual; abstract;
+ function TerminateIfAlreadyRunning(var WndTitle : string): boolean; virtual;
+ function FindSongFile(Dir, Mask: WideString): WideString; virtual;
+ procedure Halt; virtual;
+ function GetLogPath : WideString; virtual; abstract;
+ function GetGameSharedPath : WideString; virtual; abstract;
+ function GetGameUserPath : WideString; virtual; abstract;
+ function CopyFile(const Source, Target: WideString; FailIfExists: boolean): boolean; virtual;
+ end;
+
+ function Platform(): TPlatform;
+
+implementation
+
+uses
+ SysUtils,
+ {$IFDEF MSWINDOWS}
+ UPlatformWindows,
+ {$ENDIF}
+ {$IFDEF LINUX}
+ UPlatformLinux,
+ {$ENDIF}
+ {$IFDEF DARWIN}
+ UPlatformMacOSX,
+ {$ENDIF}
+ ULog;
+
+
+// I have modified it to use the Platform_singleton in this location ( in the implementaiton )
+// so that this variable can NOT be overwritten from anywhere else in the application.
+// the accessor function platform, emulates all previous calls to work the same way.
+var
+ Platform_singleton : TPlatform;
+
+function Platform : TPlatform;
+begin
+ Result := Platform_singleton;
+end;
+
+(**
+ * Default Init() implementation
+ *)
+procedure TPlatform.Init;
+begin
+end;
+
+(**
+ * Default Halt() implementation
+ *)
+procedure TPlatform.Halt;
+begin
+ // Note: Application.terminate is NOT the same
+ System.Halt;
+end;
+
+{**
+ * Returns the directory of the executable
+ *}
+function TPlatform.GetExecutionDir(): string;
+begin
+ Result := ExtractFilePath(ParamStr(0));
+end;
+
+(**
+ * Default TerminateIfAlreadyRunning() implementation
+ *)
+function TPlatform.TerminateIfAlreadyRunning(var WndTitle : string): Boolean;
+begin
+ Result := false;
+end;
+
+(**
+ * Default FindSongFile() implementation
+ *)
+function TPlatform.FindSongFile(Dir, Mask: WideString): WideString;
+var
+ SR: TSearchRec; // for parsing song directory
+begin
+ Result := '';
+ if SysUtils.FindFirst(Dir + Mask, faDirectory, SR) = 0 then
+ begin
+ Result := SR.Name;
+ end;
+ SysUtils.FindClose(SR);
+end;
+
+function TPlatform.CopyFile(const Source, Target: WideString; FailIfExists: boolean): boolean;
+const
+ COPY_BUFFER_SIZE = 4096; // a good tradeoff between speed and memory consumption
+var
+ SourceFile, TargetFile: TFileStream;
+ FileCopyBuffer: array [0..COPY_BUFFER_SIZE-1] of byte; // temporary copy-buffer.
+ NumberOfBytes: integer; // number of bytes read from SourceFile
+begin
+ Result := false;
+ SourceFile := nil;
+ TargetFile := nil;
+
+ // if overwrite is disabled return if the target file already exists
+ if (FailIfExists and FileExists(Target)) then
+ Exit;
+
+ try
+ try
+ // open source and target file (might throw an exception on error)
+ SourceFile := TFileStream.Create(Source, fmOpenRead);
+ TargetFile := TFileStream.Create(Target, fmCreate or fmOpenWrite);
+
+ while true do
+ begin
+ // read a block from the source file and check for errors or EOF
+ NumberOfBytes := SourceFile.Read(FileCopyBuffer, SizeOf(FileCopyBuffer));
+ if (NumberOfBytes <= 0) then
+ Break;
+ // write block to target file and check if everything was written
+ if (TargetFile.Write(FileCopyBuffer, NumberOfBytes) <> NumberOfBytes) then
+ Exit;
+ end;
+ except
+ Exit;
+ end;
+ finally
+ SourceFile.Free;
+ TargetFile.Free;
+ end;
+
+ Result := true;
+end;
+
+
+initialization
+{$IFDEF MSWINDOWS}
+ Platform_singleton := TPlatformWindows.Create;
+{$ENDIF}
+{$IFDEF LINUX}
+ Platform_singleton := TPlatformLinux.Create;
+{$ENDIF}
+{$IFDEF DARWIN}
+ Platform_singleton := TPlatformMacOSX.Create;
+{$ENDIF}
+
+finalization
+ Platform_singleton.Free;
+
+end.
diff --git a/src/base/UPlatformLinux.pas b/src/base/UPlatformLinux.pas
new file mode 100644
index 00000000..3227e4f8
--- /dev/null
+++ b/src/base/UPlatformLinux.pas
@@ -0,0 +1,173 @@
+unit UPlatformLinux;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+uses
+ Classes,
+ UPlatform,
+ UConfig;
+
+type
+ TPlatformLinux = class(TPlatform)
+ private
+ UseLocalDirs: boolean;
+
+ procedure DetectLocalExecution();
+ function GetHomeDir(): string;
+ public
+ procedure Init; override;
+
+ function DirectoryFindFiles(Dir, Filter: WideString; ReturnAllSubDirs: Boolean): TDirectoryEntryArray; override;
+
+ function GetLogPath : WideString; override;
+ function GetGameSharedPath : WideString; override;
+ function GetGameUserPath : WideString; override;
+ end;
+
+implementation
+
+uses
+ UCommandLine,
+ BaseUnix,
+ {$IF FPC_VERSION_INT >= 2002002}
+ pwd,
+ {$IFEND}
+ SysUtils,
+ ULog;
+
+procedure TPlatformLinux.Init;
+begin
+ inherited Init();
+ DetectLocalExecution();
+end;
+
+{**
+ * Detects whether the game was executed locally or globally.
+ * - It is local if it was not installed and directly executed from
+ * within the game folder. In this case resources (themes, language-files)
+ * reside in the directory of the executable.
+ * - It is global if the game was installed (e.g. to /usr/bin) and
+ * the resources are in a separate folder (e.g. /usr/share/ultrastardx)
+ * which name is stored in the INSTALL_DATADIR constant in config-linux.inc.
+ *
+ * Sets UseLocalDirs to true if the game is executed locally, false otherwise.
+ *}
+procedure TPlatformLinux.DetectLocalExecution();
+var
+ LocalDir: string;
+begin
+ LocalDir := GetExecutionDir();
+
+ // we just check if the 'languages' folder exists in the
+ // directory of the executable. If so -> local execution.
+ UseLocalDirs := (DirectoryExists(LocalDir + 'languages'));
+end;
+
+function TPlatformLinux.DirectoryFindFiles(Dir, Filter: WideString; ReturnAllSubDirs: Boolean): TDirectoryEntryArray;
+var
+ i: Integer;
+ TheDir : pDir;
+ ADirent : pDirent;
+ Entry : Longint;
+ lAttrib : integer;
+begin
+ i := 0;
+ Filter := LowerCase(Filter);
+
+ TheDir := FpOpenDir( Dir );
+ if Assigned(TheDir) then
+ begin
+ repeat
+ ADirent := FpReadDir(TheDir^);
+
+ if Assigned(ADirent) and (ADirent^.d_name <> '.') and (ADirent^.d_name <> '..') then
+ begin
+ lAttrib := FileGetAttr(Dir + ADirent^.d_name);
+ if ReturnAllSubDirs and ((lAttrib and faDirectory) <> 0) then
+ begin
+ SetLength( Result, i + 1);
+ Result[i].Name := ADirent^.d_name;
+ Result[i].IsDirectory := true;
+ Result[i].IsFile := false;
+ i := i + 1;
+ end
+ else if (Length(Filter) = 0) or (Pos( Filter, LowerCase(ADirent^.d_name)) > 0) then
+ begin
+ SetLength( Result, i + 1);
+ Result[i].Name := ADirent^.d_name;
+ Result[i].IsDirectory := false;
+ Result[i].IsFile := true;
+ i := i + 1;
+ end;
+ end;
+ until (ADirent = nil);
+
+ FpCloseDir(TheDir^);
+ end;
+end;
+
+function TPlatformLinux.GetLogPath: WideString;
+begin
+ if UseLocalDirs then
+ Result := GetExecutionDir()
+ else
+ Result := GetGameUserPath() + 'logs/';
+
+ // create non-existing directories
+ ForceDirectories(Result);
+end;
+
+function TPlatformLinux.GetGameSharedPath: WideString;
+begin
+ if UseLocalDirs then
+ Result := GetExecutionDir()
+ else
+ Result := IncludeTrailingPathDelimiter(INSTALL_DATADIR);
+end;
+
+function TPlatformLinux.GetGameUserPath: WideString;
+begin
+ if UseLocalDirs then
+ Result := GetExecutionDir()
+ else
+ Result := GetHomeDir() + '.ultrastardx/';
+end;
+
+{**
+ * Returns the user's home directory terminated by a path delimiter
+ *}
+function TPlatformLinux.GetHomeDir(): string;
+{$IF FPC_VERSION_INT >= 2002002}
+var
+ PasswdEntry: PPasswd;
+{$IFEND}
+begin
+ Result := '';
+
+ {$IF FPC_VERSION_INT >= 2002002}
+ // try to retrieve the info from passwd
+ PasswdEntry := FpGetpwuid(FpGetuid());
+ if (PasswdEntry <> nil) then
+ Result := PasswdEntry.pw_dir;
+ {$IFEND}
+ // fallback if passwd does not contain the path
+ if (Result = '') then
+ Result := GetEnvironmentVariable('HOME');
+ // add trailing path delimiter (normally '/')
+ if (Result <> '') then
+ Result := IncludeTrailingPathDelimiter(Result);
+
+ {$IF FPC_VERSION_INT >= 2002002}
+ // GetUserDir() is another function that returns a user path.
+ // It uses env-var HOME or a fallback to a temp-dir.
+ //Result := GetUserDir();
+ {$IFEND}
+end;
+
+end.
diff --git a/src/base/UPlatformMacOSX.pas b/src/base/UPlatformMacOSX.pas
new file mode 100644
index 00000000..2ab2a390
--- /dev/null
+++ b/src/base/UPlatformMacOSX.pas
@@ -0,0 +1,294 @@
+unit UPlatformMacOSX;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+uses
+ Classes,
+ ULog,
+ UPlatform;
+
+type
+ {**
+ * @abstract(Provides Mac OS X specific details.)
+ * @lastmod(August 1, 2008)
+ * The UPlatformMacOSX unit takes care of setting paths to resource folders.
+ *
+ * (Note for non-Maccies: "folder" is the Mac name for directory.)
+ *
+ * Note on the resource folders:
+ * 1. Installation of an application on the mac works as follows: Extract and copy an application
+ * and if you don't like or need the application anymore you move the folder
+ * to the trash - and you're done.
+ * 2. The use folders in the user's home directory is against Apple's guidelines
+ * and strange to an average user.
+ * 3. Even worse is using /usr/local/... since all lowercase folders in / are
+ * not visible to an average user in the Finder, at least not without some "tricks".
+ *
+ * The best way would be to store everything within the application bundle. However, this
+ * requires USDX to offer the handling of the resources. Until this is implemented, the
+ * second best solution is as follows:
+ *
+ * According to Aple guidelines handling of resources and folders should follow these lines:
+ *
+ * Acceptable places for files are folders named UltraStarDeluxe either in
+ * /Library/Application Support/
+ * or
+ * ~/Library/Application Support/
+ *
+ * So
+ * GetGameSharedPath could return
+ * /Library/Application Support/UltraStarDeluxe/Resources/.
+ * GetGameUserPath could return
+ * ~/Library/Application Support/UltraStarDeluxe/Resources/.
+ *
+ * Right now, only $HOME/Library/Application Support/UltraStarDeluxe/Resources
+ * is used. So every user needs the complete set of files and folders.
+ * Future versions may also use shared resources in
+ * /Library/Application Support/UltraStarDeluxe/Resources. However, this is not
+ * treated yet in the code outside this unit.
+ *
+ * USDX checks, whether GetGameUserPath exists. If not, USDX creates it.
+ * The existence of needed files is then checked and if a file is missing
+ * it is copied to there from within the Resources folder in the Application
+ * bundle, which contains the default files. USDX should not delete files or
+ * folders in Application Support/UltraStarDeluxe automatically or without
+ * user confirmation.
+ *}
+ TPlatformMacOSX = class(TPlatform)
+ private
+ {**
+ * GetBundlePath returns the path to the application bundle UltraStarDeluxe.app.
+ *}
+ function GetBundlePath: WideString;
+
+ {**
+ * GetApplicationSupportPath returns the path to
+ * $HOME/Library/Application Support/UltraStarDeluxe/Resources.
+ *}
+ function GetApplicationSupportPath: WideString;
+
+ {**
+ * see the description of @link(Init).
+ *}
+ procedure CreateUserFolders();
+
+ public
+ {**
+ * Init simply calls @link(CreateUserFolders), which in turn scans the folder
+ * UltraStarDeluxe.app/Contents/Resources for all files and folders.
+ * $HOME/Library/Application Support/UltraStarDeluxe/Resources is then checked
+ * for their presence and missing ones are copied.
+ *}
+ procedure Init; override;
+
+ {**
+ * DirectoryFindFiles returns all entries of a folder with names and booleans
+ * about their type, i.e. file or directory.
+ *}
+ function DirectoryFindFiles(Dir, Filter: WideString; ReturnAllSubDirs: boolean): TDirectoryEntryArray; override;
+
+ {**
+ * GetLogPath returns the path for log messages. Currently it is set to
+ * $HOME/Library/Application Support/UltraStarDeluxe/Resources/Log.
+ *}
+ function GetLogPath : WideString; override;
+
+ {**
+ * GetGameSharedPath returns the path for shared resources. Currently it is set to
+ * /Library/Application Support/UltraStarDeluxe/Resources.
+ * However it is not used.
+ *}
+ function GetGameSharedPath : WideString; override;
+
+ {**
+ * GetGameUserPath returns the path for user resources. Currently it is set to
+ * $HOME/Library/Application Support/UltraStarDeluxe/Resources.
+ * This is where a user can add songs, themes, ....
+ *}
+ function GetGameUserPath : WideString; override;
+ end;
+
+implementation
+
+uses
+ SysUtils,
+ BaseUnix;
+
+procedure TPlatformMacOSX.Init;
+begin
+ CreateUserFolders();
+end;
+
+procedure TPlatformMacOSX.CreateUserFolders();
+var
+ RelativePath: string;
+ // BaseDir contains the path to the folder, where a search is performed.
+ // It is set to the entries in @link(DirectoryList) one after the other.
+ BaseDir: string;
+ // OldBaseDir contains the path to the folder, where the search started.
+ // It is used to return to it, when the search is completed in all folders.
+ OldBaseDir: string;
+ // This record contains the result of a file search with FindFirst or FindNext
+ SearchInfo: TSearchRec;
+ // These two lists contain all folder and file names found
+ // within the folder @link(BaseDir).
+ DirectoryList, FileList: TStringList;
+ // DirectoryIsFinished contains the index of the folder in @link(DirectoryList),
+ // which is the last one completely searched. Later folders are still to be
+ // searched for additional files and folders.
+ DirectoryIsFinished: longint;
+ Counter: longint;
+
+ UserPathName: string;
+const
+ // used to construct the @link(UserPathName)
+ PathName: string = '/Library/Application Support/UltraStarDeluxe/Resources';
+begin
+ // Get the current folder and save it in OldBaseDir for returning to it, when
+ // finished.
+ GetDir(0, OldBaseDir);
+
+ // UltraStarDeluxe.app/Contents/Resources contains all the default files and
+ // folders.
+ BaseDir := OldBaseDir + '/UltraStarDeluxe.app/Contents/Resources';
+ ChDir(BaseDir);
+
+ // Right now, only $HOME/Library/Application Support/UltraStarDeluxe/Resources
+ // is used.
+ UserPathName := GetEnvironmentVariable('HOME') + PathName;
+
+ DirectoryIsFinished := 0;
+ DirectoryList := TStringList.Create();
+ FileList := TStringList.Create();
+ DirectoryList.Add('.');
+
+ // create the folder and file lists
+ repeat
+
+ RelativePath := DirectoryList[DirectoryIsFinished];
+ ChDir(BaseDir + '/' + RelativePath);
+ if (FindFirst('*', faAnyFile, SearchInfo) = 0) then
+ begin
+ repeat
+ if DirectoryExists(SearchInfo.Name) then
+ begin
+ if (SearchInfo.Name <> '.') and (SearchInfo.Name <> '..') then
+ DirectoryList.Add(RelativePath + '/' + SearchInfo.Name);
+ end
+ else
+ Filelist.Add(RelativePath + '/' + SearchInfo.Name);
+ until (FindNext(SearchInfo) <> 0);
+ end;
+ FindClose(SearchInfo);
+ Inc(DirectoryIsFinished);
+ until (DirectoryIsFinished = DirectoryList.Count);
+
+ // create missing folders
+ for Counter := 0 to DirectoryList.Count-1 do
+ begin
+ if not ForceDirectories(UserPathName + '/' + DirectoryList[Counter]) then
+ Log.LogError('Failed to create the folder "'+ UserPathName + '/' + DirectoryList[Counter] +'"',
+ 'TPlatformMacOSX.CreateUserFolders');
+ end;
+ DirectoryList.Free();
+
+ // copy missing files
+ for Counter := 0 to Filelist.Count-1 do
+ begin
+ CopyFile(BaseDir + '/' + Filelist[Counter],
+ UserPathName + '/' + Filelist[Counter], true);
+ end;
+ FileList.Free();
+
+ // go back to the initial folder
+ ChDir(OldBaseDir);
+end;
+
+function TPlatformMacOSX.GetBundlePath: WideString;
+var
+ i, pos : integer;
+begin
+ // Mac applications are packaged in folders.
+ // We have to cut the last two folders
+ // to get the application folder.
+
+ Result := GetExecutionDir();
+ for i := 1 to 2 do
+ begin
+ pos := Length(Result);
+ repeat
+ Delete(Result, pos, 1);
+ pos := Length(Result);
+ until (pos = 0) or (Result[pos] = '/');
+ end;
+end;
+
+function TPlatformMacOSX.GetApplicationSupportPath: WideString;
+const
+ PathName : string = '/Library/Application Support/UltraStarDeluxe/Resources';
+begin
+ Result := GetEnvironmentVariable('HOME') + PathName + '/';
+end;
+
+function TPlatformMacOSX.GetLogPath: WideString;
+begin
+ Result := GetApplicationSupportPath + 'Logs';
+end;
+
+function TPlatformMacOSX.GetGameSharedPath: WideString;
+begin
+ Result := GetApplicationSupportPath;
+end;
+
+function TPlatformMacOSX.GetGameUserPath: WideString;
+begin
+ Result := GetApplicationSupportPath;
+end;
+
+function TPlatformMacOSX.DirectoryFindFiles(Dir, Filter: WideString; ReturnAllSubDirs: boolean): TDirectoryEntryArray;
+var
+ i : integer;
+ TheDir : pdir;
+ ADirent : pDirent;
+ lAttrib : integer;
+begin
+ i := 0;
+ Filter := LowerCase(Filter);
+
+ TheDir := FPOpenDir(Dir);
+ if Assigned(TheDir) then
+ repeat
+ ADirent := FPReadDir(TheDir);
+
+ if Assigned(ADirent) and (ADirent^.d_name <> '.') and (ADirent^.d_name <> '..') then
+ begin
+ lAttrib := FileGetAttr(Dir + ADirent^.d_name);
+ if ReturnAllSubDirs and ((lAttrib and faDirectory) <> 0) then
+ begin
+ SetLength(Result, i + 1);
+ Result[i].Name := ADirent^.d_name;
+ Result[i].IsDirectory := true;
+ Result[i].IsFile := false;
+ i := i + 1;
+ end
+ else if (Length(Filter) = 0) or (Pos( Filter, LowerCase(ADirent^.d_name)) > 0) then
+ begin
+ SetLength(Result, i + 1);
+ Result[i].Name := ADirent^.d_name;
+ Result[i].IsDirectory := false;
+ Result[i].IsFile := true;
+ i := i + 1;
+ end;
+ end;
+ until ADirent = nil;
+
+ FPCloseDir(TheDir);
+end;
+
+end.
diff --git a/src/base/UPlatformWindows.pas b/src/base/UPlatformWindows.pas
new file mode 100644
index 00000000..029e8d33
--- /dev/null
+++ b/src/base/UPlatformWindows.pas
@@ -0,0 +1,236 @@
+unit UPlatformWindows;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+// turn off messages for platform specific symbols
+{$WARN SYMBOL_PLATFORM OFF}
+
+uses
+ Classes,
+ UPlatform;
+
+type
+ TPlatformWindows = class(TPlatform)
+ private
+ function GetSpecialPath(CSIDL: integer): WideString;
+ public
+ function DirectoryFindFiles(Dir, Filter: WideString; ReturnAllSubDirs: Boolean): TDirectoryEntryArray; override;
+ function TerminateIfAlreadyRunning(var WndTitle: String): Boolean; override;
+
+ function GetLogPath: WideString; override;
+ function GetGameSharedPath: WideString; override;
+ function GetGameUserPath: WideString; override;
+
+ function CopyFile(const Source, Target: WideString; FailIfExists: boolean): boolean; override;
+ end;
+
+implementation
+
+uses
+ SysUtils,
+ ShlObj,
+ Windows,
+ UConfig;
+
+type
+ TSearchRecW = record
+ Time: Integer;
+ Size: Integer;
+ Attr: Integer;
+ Name: WideString;
+ ExcludeAttr: Integer;
+ FindHandle: THandle;
+ FindData: TWin32FindDataW;
+ end;
+
+function FindFirstW(const Path: WideString; Attr: Integer; var F: TSearchRecW): Integer; forward;
+function FindNextW(var F: TSearchRecW): Integer; forward;
+procedure FindCloseW(var F: TSearchRecW); forward;
+function FindMatchingFileW(var F: TSearchRecW): Integer; forward;
+function DirectoryExistsW(const Directory: widestring): Boolean; forward;
+
+function FindFirstW(const Path: widestring; Attr: Integer; var F: TSearchRecW): Integer;
+const
+ faSpecial = faHidden or faSysFile or faVolumeID or faDirectory;
+begin
+ F.ExcludeAttr := not Attr and faSpecial;
+{$IFDEF Delphi}
+ F.FindHandle := FindFirstFileW(PWideChar(Path), F.FindData);
+{$ELSE}
+ F.FindHandle := FindFirstFileW(PWideChar(Path), @F.FindData);
+{$ENDIF}
+ if F.FindHandle <> INVALID_HANDLE_VALUE then
+ begin
+ Result := FindMatchingFileW(F);
+ if Result <> 0 then FindCloseW(F);
+ end else
+ Result := GetLastError;
+end;
+
+function FindNextW(var F: TSearchRecW): Integer;
+begin
+{$IFDEF Delphi}
+ if FindNextFileW(F.FindHandle, F.FindData) then
+{$ELSE}
+ if FindNextFileW(F.FindHandle, @F.FindData) then
+{$ENDIF}
+ Result := FindMatchingFileW(F)
+ else
+ Result := GetLastError;
+end;
+
+procedure FindCloseW(var F: TSearchRecW);
+begin
+ if F.FindHandle <> INVALID_HANDLE_VALUE then
+ begin
+ Windows.FindClose(F.FindHandle);
+ F.FindHandle := INVALID_HANDLE_VALUE;
+ end;
+end;
+
+function FindMatchingFileW(var F: TSearchRecW): Integer;
+var
+ LocalFileTime: TFileTime;
+begin
+ with F do
+ begin
+ while FindData.dwFileAttributes and ExcludeAttr <> 0 do
+{$IFDEF Delphi}
+ if not FindNextFileW(FindHandle, FindData) then
+{$ELSE}
+ if not FindNextFileW(FindHandle, @FindData) then
+{$ENDIF}
+ begin
+ Result := GetLastError;
+ Exit;
+ end;
+ FileTimeToLocalFileTime(FindData.ftLastWriteTime, LocalFileTime);
+ FileTimeToDosDateTime(LocalFileTime, LongRec(Time).Hi, LongRec(Time).Lo);
+ Size := FindData.nFileSizeLow;
+ Attr := FindData.dwFileAttributes;
+ Name := FindData.cFileName;
+ end;
+ Result := 0;
+end;
+
+function DirectoryExistsW(const Directory: widestring): Boolean;
+var
+ Code: Integer;
+begin
+ Code := GetFileAttributesW(PWideChar(Directory));
+ Result := (Code <> -1) and (FILE_ATTRIBUTE_DIRECTORY and Code <> 0);
+end;
+
+//------------------------------
+//Start more than One Time Prevention
+//------------------------------
+function TPlatformWindows.TerminateIfAlreadyRunning(var WndTitle: String): Boolean;
+var
+ hWnd: THandle;
+ I: Integer;
+begin
+ Result := false;
+ hWnd:= FindWindow(nil, PChar(WndTitle));
+ //Programm already started
+ if (hWnd <> 0) then
+ begin
+ I := Messagebox(0, PChar('Another Instance of Ultrastar is already running. Continue ?'), PChar(WndTitle), MB_ICONWARNING or MB_YESNO);
+ if (I = IDYes) then
+ begin
+ I := 1;
+ repeat
+ Inc(I);
+ hWnd := FindWindow(nil, PChar(WndTitle + ' Instance ' + InttoStr(I)));
+ until (hWnd = 0);
+ WndTitle := WndTitle + ' Instance ' + InttoStr(I);
+ end
+ else
+ Result := true;
+ end;
+end;
+
+function TPlatformWindows.DirectoryFindFiles(Dir, Filter: WideString; ReturnAllSubDirs: Boolean): TDirectoryEntryArray;
+var
+ i : Integer;
+ SR : TSearchRecW;
+ Attrib : Integer;
+begin
+ i := 0;
+ Filter := LowerCase(Filter);
+
+ if FindFirstW(Dir + '*', faAnyFile or faDirectory, SR) = 0 then
+ repeat
+ if (SR.Name <> '.') and (SR.Name <> '..') then
+ begin
+ Attrib := FileGetAttr(Dir + SR.name);
+ if ReturnAllSubDirs and ((Attrib and faDirectory) <> 0) then
+ begin
+ SetLength( Result, i + 1);
+ Result[i].Name := SR.name;
+ Result[i].IsDirectory := true;
+ Result[i].IsFile := false;
+ i := i + 1;
+ end
+ else if (Length(Filter) = 0) or (Pos( Filter, LowerCase(SR.Name)) > 0) then
+ begin
+ SetLength( Result, i + 1);
+ Result[i].Name := SR.Name;
+ Result[i].IsDirectory := false;
+ Result[i].IsFile := true;
+ i := i + 1;
+ end;
+ end;
+ until FindNextW(SR) <> 0;
+ FindCloseW(SR);
+end;
+
+(**
+ * Returns the path of a special folder.
+ *
+ * Some Folder IDs:
+ * CSIDL_APPDATA (e.g. C:\Documents and Settings\username\Application Data)
+ * CSIDL_LOCAL_APPDATA (e.g. C:\Documents and Settings\username\Local Settings\Application Data)
+ * CSIDL_PROFILE (e.g. C:\Documents and Settings\username)
+ * CSIDL_PERSONAL (e.g. C:\Documents and Settings\username\My Documents)
+ * CSIDL_MYMUSIC (e.g. C:\Documents and Settings\username\My Documents\My Music)
+ *)
+function TPlatformWindows.GetSpecialPath(CSIDL: integer): WideString;
+var
+ Buffer: array [0..MAX_PATH-1] of WideChar;
+begin
+{$IF Defined(Delphi) or (FPC_VERSION_INT >= 2002002)} // >= 2.2.2
+ if (SHGetSpecialFolderPathW(0, @Buffer, CSIDL, false)) then
+ Result := Buffer
+ else
+{$IFEND}
+ Result := '';
+end;
+
+function TPlatformWindows.GetLogPath: WideString;
+begin
+ Result := GetExecutionDir();
+end;
+
+function TPlatformWindows.GetGameSharedPath: WideString;
+begin
+ Result := GetExecutionDir();
+end;
+
+function TPlatformWindows.GetGameUserPath: WideString;
+begin
+ //Result := GetSpecialPath(CSIDL_APPDATA) + PathDelim + 'UltraStarDX' + PathDelim;
+ Result := GetExecutionDir();
+end;
+
+function TPlatformWindows.CopyFile(const Source, Target: WideString; FailIfExists: boolean): boolean;
+begin
+ Result := Windows.CopyFileW(PWideChar(Source), PWideChar(Target), FailIfExists);
+end;
+
+end.
diff --git a/src/base/UPlaylist.pas b/src/base/UPlaylist.pas
new file mode 100644
index 00000000..c867c356
--- /dev/null
+++ b/src/base/UPlaylist.pas
@@ -0,0 +1,490 @@
+unit UPlaylist;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+
+uses
+ USong;
+
+type
+ TPlaylistItem = record
+ Artist: String;
+ Title: String;
+ SongID: Integer;
+ end;
+
+ APlaylistItem = array of TPlaylistItem;
+
+ TPlaylist = record
+ Name: String;
+ Filename: String;
+ Items: APlaylistItem;
+ end;
+
+ APlaylist = array of TPlaylist;
+
+ //----------
+ //TPlaylistManager - Class for Managing Playlists (Loading, Displaying, Saving)
+ //----------
+ TPlaylistManager = class
+ private
+
+ public
+ Mode: TSingMode; //Current Playlist Mode for SongScreen
+ CurPlayList: Cardinal;
+ CurItem: Cardinal;
+
+ Playlists: APlaylist;
+
+ constructor Create;
+ Procedure LoadPlayLists;
+ Function LoadPlayList(Index: Cardinal; Filename: String): Boolean;
+ Procedure SavePlayList(Index: Cardinal);
+
+ Procedure SetPlayList(Index: Cardinal);
+
+ Function AddPlaylist(Name: String): Cardinal;
+ Procedure DelPlaylist(const Index: Cardinal);
+
+ Procedure AddItem(const SongID: Cardinal; const iPlaylist: Integer = -1);
+ Procedure DelItem(const iItem: Cardinal; const iPlaylist: Integer = -1);
+
+ Procedure GetNames(var PLNames: array of String);
+ Function GetIndexbySongID(const SongID: Cardinal; const iPlaylist: Integer = -1): Integer;
+ end;
+
+ {Modes:
+ 0: Standard Mode
+ 1: Category Mode
+ 2: PlayList Mode}
+
+ var
+ PlayListMan: TPlaylistManager;
+
+
+implementation
+
+uses USongs,
+ ULog,
+ UMain,
+ //UFiles,
+ UGraphic,
+ UThemes,
+ SysUtils;
+
+//----------
+//Create - Construct Class - Dummy for now
+//----------
+constructor TPlayListManager.Create;
+begin
+ inherited;
+ LoadPlayLists;
+end;
+
+//----------
+//LoadPlayLists - Load list of Playlists from PlayList Folder
+//----------
+Procedure TPlayListManager.LoadPlayLists;
+var
+ SR: TSearchRec;
+ Len: Integer;
+ PlayListBuffer: TPlayList;
+begin
+ SetLength(Playlists, 0);
+
+ if FindFirst(PlayListPath + '*.upl', 0, SR) = 0 then
+ begin
+ repeat
+ Len := Length(Playlists);
+ SetLength(Playlists, Len +1);
+
+ if not LoadPlayList (Len, Sr.Name) then
+ SetLength(Playlists, Len)
+ else
+ begin
+ // Sort the Playlists - Insertion Sort
+ PlayListBuffer := Playlists[Len];
+ Dec(Len);
+ while (Len >= 0) AND (CompareText(Playlists[Len].Name, PlayListBuffer.Name) >= 0) do
+ begin
+ Playlists[Len+1] := Playlists[Len];
+ Dec(Len);
+ end;
+ Playlists[Len+1] := PlayListBuffer;
+ end;
+
+ until FindNext(SR) <> 0;
+ FindClose(SR);
+ end;
+end;
+
+//----------
+//LoadPlayList - Load a Playlist in the Array
+//----------
+Function TPlayListManager.LoadPlayList(Index: Cardinal; Filename: String): Boolean;
+ var
+ F: TextFile;
+ Line: String;
+ PosDelimiter: Integer;
+ SongID: Integer;
+ Len: Integer;
+
+ Function FindSong(Artist, Title: String): Integer;
+ var I: Integer;
+ begin
+ Result := -1;
+
+ For I := low(CatSongs.Song) to high(CatSongs.Song) do
+ begin
+ if (CatSongs.Song[I].Title = Title) AND (CatSongs.Song[I].Artist = Artist) then
+ begin
+ Result := I;
+ Break;
+ end;
+ end;
+ end;
+begin
+ if not FileExists(PlayListPath + Filename) then
+ begin
+ Log.LogError('Could not load Playlist: ' + Filename);
+ Result := False;
+ Exit;
+ end;
+ Result := True;
+
+ //Load File
+ AssignFile(F, PlayListPath + FileName);
+ Reset(F);
+
+ //Set Filename
+ PlayLists[Index].Filename := Filename;
+ PlayLists[Index].Name := '';
+
+ //Read Until End of File
+ While not Eof(F) do
+ begin
+ //Read Curent Line
+ Readln(F, Line);
+
+ if (Length(Line) > 0) then
+ begin
+ PosDelimiter := Pos(':', Line);
+ if (PosDelimiter <> 0) then
+ begin
+ //Comment or Name String
+ if (Line[1] = '#') then
+ begin
+ //Found Name Value
+ if (Uppercase(Trim(copy(Line, 2, PosDelimiter - 2))) = 'NAME') then
+ PlayLists[Index].Name := Trim(copy(Line, PosDelimiter + 1,Length(Line) - PosDelimiter))
+
+ end
+ //Song Entry
+ else
+ begin
+ SongID := FindSong(Trim(copy(Line, 1, PosDelimiter - 1)), Trim(copy(Line, PosDelimiter + 1, Length(Line) - PosDelimiter)));
+ if (SongID <> -1) then
+ begin
+ Len := Length(PlayLists[Index].Items);
+ SetLength(PlayLists[Index].Items, Len + 1);
+
+ PlayLists[Index].Items[Len].SongID := SongID;
+
+ PlayLists[Index].Items[Len].Artist := Trim(copy(Line, 1, PosDelimiter - 1));
+ PlayLists[Index].Items[Len].Title := Trim(copy(Line, PosDelimiter + 1, Length(Line) - PosDelimiter));
+ end
+ else Log.LogError('Could not find Song in Playlist: ' + PlayLists[Index].Filename + ', ' + Line);
+ end;
+ end;
+ end;
+ end;
+
+ //If no special name is given, use Filename
+ if PlayLists[Index].Name = '' then
+ begin
+ PlayLists[Index].Name := ChangeFileExt(FileName, '');
+ end;
+
+ //Finish (Close File)
+ CloseFile(F);
+end;
+
+//----------
+//SavePlayList - Saves the specified Playlist
+//----------
+Procedure TPlayListManager.SavePlayList(Index: Cardinal);
+var
+ F: TextFile;
+ I: Integer;
+begin
+ if (Not FileExists(PlaylistPath + Playlists[Index].Filename)) OR (Not FileisReadOnly(PlaylistPath + Playlists[Index].Filename)) then
+ begin
+
+ //open File for Rewriting
+ AssignFile(F, PlaylistPath + Playlists[Index].Filename);
+ try
+ try
+ Rewrite(F);
+
+ //Write Version (not nessecary but helpful)
+ WriteLn(F, '######################################');
+ WriteLn(F, '#Ultrastar Deluxe Playlist Format v1.0');
+ WriteLn(F, '#Playlist "' + Playlists[Index].Name + '" with ' + InttoStr(Length(Playlists[Index].Items)) + ' Songs.');
+ WriteLn(F, '######################################');
+
+ //Write Name Information
+ WriteLn(F, '#Name: ' + Playlists[Index].Name);
+
+ //Write Song Information
+ WriteLn(F, '#Songs:');
+
+ For I := 0 to high(Playlists[Index].Items) do
+ begin
+ WriteLn(F, Playlists[Index].Items[I].Artist + ' : ' + Playlists[Index].Items[I].Title);
+ end;
+ except
+ log.LogError('Could not write Playlistfile "' + Playlists[Index].Name + '"');
+ end;
+ finally
+ CloseFile(F);
+ end;
+ end;
+end;
+
+//----------
+//SetPlayList - Display a Playlist in CatSongs
+//----------
+Procedure TPlayListManager.SetPlayList(Index: Cardinal);
+var
+ I: Integer;
+begin
+ If (Int(Index) > High(PlayLists)) then
+ exit;
+
+ //Hide all Songs
+ For I := 0 to high(CatSongs.Song) do
+ CatSongs.Song[I].Visible := False;
+
+ //Show Songs in PL
+ For I := 0 to high(PlayLists[Index].Items) do
+ begin
+ CatSongs.Song[PlayLists[Index].Items[I].SongID].Visible := True;
+ end;
+
+ //Set CatSongsMode + Playlist Mode
+ CatSongs.CatNumShow := -3;
+ Mode := smPlayListRandom;
+
+ //Set CurPlaylist
+ CurPlaylist := Index;
+
+ //Show Cat in Topleft:
+ ScreenSong.ShowCatTLCustom(Format(Theme.Playlist.CatText,[Playlists[Index].Name]));
+
+ //Fix SongSelection
+ ScreenSong.Interaction := 0;
+ ScreenSong.SelectNext;
+ ScreenSong.FixSelected;
+
+ //Play correct Music
+ ScreenSong.ChangeMusic;
+end;
+
+//----------
+//AddPlaylist - Adds a Playlist and Returns the Index
+//----------
+Function TPlayListManager.AddPlaylist(Name: String): Cardinal;
+var
+ I: Integer;
+begin
+ Result := Length(Playlists);
+ SetLength(Playlists, Result + 1);
+
+ // Sort the Playlists - Insertion Sort
+ while (Result > 0) AND (CompareText(Playlists[Result - 1].Name, Name) >= 0) do
+ begin
+ Dec(Result);
+ Playlists[Result+1] := Playlists[Result];
+ end;
+ Playlists[Result].Name := Name;
+
+ I := 1;
+ if (not FileExists(PlaylistPath + Name + '.upl')) then
+ Playlists[Result].Filename := Name + '.upl'
+ else
+ begin
+ repeat
+ Inc(I);
+ until not FileExists(PlaylistPath + Name + InttoStr(I) + '.upl');
+ Playlists[Result].Filename := Name + InttoStr(I) + '.upl';
+ end;
+
+ //Save new Playlist
+ SavePlayList(Result);
+end;
+
+//----------
+//DelPlaylist - Deletes a Playlist
+//----------
+Procedure TPlayListManager.DelPlaylist(const Index: Cardinal);
+var
+ I: Integer;
+ Filename: String;
+begin
+ If Int(Index) > High(Playlists) then
+ Exit;
+
+ Filename := PlaylistPath + Playlists[Index].Filename;
+
+ //If not FileExists or File is not Writeable then exit
+ If (Not FileExists(Filename)) OR (FileisReadOnly(Filename)) then
+ Exit;
+
+
+ //Delete Playlist from FileSystem
+ if Not DeleteFile(Filename) then
+ Exit;
+
+ //Delete Playlist from Array
+ //move all PLs to the Hole
+ For I := Index to High(Playlists)-1 do
+ PlayLists[I] := PlayLists[I+1];
+
+ //Delete last Playlist
+ SetLength (Playlists, High(Playlists));
+
+ //If Playlist is Displayed atm
+ //-> Display Songs
+ if (CatSongs.CatNumShow = -3) and (Index = CurPlaylist) then
+ begin
+ ScreenSong.UnLoadDetailedCover;
+ ScreenSong.HideCatTL;
+ CatSongs.SetFilter('', 0);
+ ScreenSong.Interaction := 0;
+ ScreenSong.FixSelected;
+ ScreenSong.ChangeMusic;
+ end;
+end;
+
+//----------
+//AddItem - Adds an Item to a specific Playlist
+//----------
+Procedure TPlayListManager.AddItem(const SongID: Cardinal; const iPlaylist: Integer);
+var
+ P: Cardinal;
+ Len: Cardinal;
+begin
+ if iPlaylist = -1 then
+ P := CurPlaylist
+ else if (iPlaylist >= 0) AND (iPlaylist <= high(Playlists)) then
+ P := iPlaylist
+ else
+ exit;
+
+ if (Int(SongID) <= High(CatSongs.Song)) AND (NOT CatSongs.Song[SongID].Main) then
+ begin
+ Len := Length(Playlists[P].Items);
+ SetLength(Playlists[P].Items, Len + 1);
+
+ Playlists[P].Items[Len].SongID := SongID;
+ Playlists[P].Items[Len].Title := CatSongs.Song[SongID].Title;
+ Playlists[P].Items[Len].Artist := CatSongs.Song[SongID].Artist;
+
+ //Save Changes
+ SavePlayList(P);
+
+ //Correct Display when Editing current Playlist
+ if (CatSongs.CatNumShow = -3) and (P = CurPlaylist) then
+ SetPlaylist(P);
+ end;
+end;
+
+//----------
+//DelItem - Deletes an Item from a specific Playlist
+//----------
+Procedure TPlayListManager.DelItem(const iItem: Cardinal; const iPlaylist: Integer);
+var
+ I: Integer;
+ P: Cardinal;
+begin
+ if iPlaylist = -1 then
+ P := CurPlaylist
+ else if (iPlaylist >= 0) AND (iPlaylist <= high(Playlists)) then
+ P := iPlaylist
+ else
+ exit;
+
+ if (Int(iItem) <= high(Playlists[P].Items)) then
+ begin
+ //Move all entrys behind deleted one to Front
+ For I := iItem to High(Playlists[P].Items) - 1 do
+ Playlists[P].Items[I] := Playlists[P].Items[I + 1];
+
+ //Delete Last Entry
+ SetLength(PlayLists[P].Items, Length(PlayLists[P].Items) - 1);
+
+ //Save Changes
+ SavePlayList(P);
+ end;
+
+ //Delete Playlist if Last Song is deleted
+ if (Length(PlayLists[P].Items) = 0) then
+ begin
+ DelPlaylist(P);
+ end
+ //Correct Display when Editing current Playlist
+ else if (CatSongs.CatNumShow = -3) and (P = CurPlaylist) then
+ SetPlaylist(P);
+end;
+
+//----------
+//GetNames - Writes Playlist Names in a Array
+//----------
+Procedure TPlayListManager.GetNames(var PLNames: array of String);
+var
+ I: Integer;
+ Len: Integer;
+begin
+ Len := High(Playlists);
+
+ if (Length(PLNames) <> Len + 1) then
+ exit;
+
+ For I := 0 to Len do
+ PLNames[I] := Playlists[I].Name;
+end;
+
+//----------
+//GetIndexbySongID - Returns Index in the specified Playlist of the given Song
+//----------
+Function TPlayListManager.GetIndexbySongID(const SongID: Cardinal; const iPlaylist: Integer): Integer;
+var
+ P: Integer;
+ I: Integer;
+begin
+ Result := -1;
+
+ if iPlaylist = -1 then
+ P := CurPlaylist
+ else if (iPlaylist >= 0) AND (iPlaylist <= high(Playlists)) then
+ P := iPlaylist
+ else
+ exit;
+
+ For I := 0 to high(Playlists[P].Items) do
+ begin
+ if (Playlists[P].Items[I].SongID = Int(SongID)) then
+ begin
+ Result := I;
+ Break;
+ end;
+ end;
+end;
+
+end.
diff --git a/src/base/UPluginInterface.pas b/src/base/UPluginInterface.pas
new file mode 100644
index 00000000..77693d0f
--- /dev/null
+++ b/src/base/UPluginInterface.pas
@@ -0,0 +1,156 @@
+unit uPluginInterface;
+{*********************
+ uPluginInterface
+ Unit fills a TPluginInterface Structur with Method Pointers
+ Unit Contains all Functions called directly by Plugins
+*********************}
+
+interface
+
+{$I switches.inc}
+
+uses uPluginDefs;
+
+//---------------
+// Methods for Plugin
+//---------------
+ {******** Hook specific Methods ********}
+ {Function Creates a new Hookable Event and Returns the Handle
+ or 0 on Failure. (Name already exists)}
+ Function CreateHookableEvent (EventName: PChar): THandle; stdcall;
+
+ {Function Destroys an Event and Unhooks all Hooks to this Event.
+ 0 on success, not 0 on Failure}
+ Function DestroyHookableEvent (hEvent: THandle): integer; stdcall;
+
+ {Function start calling the Hook Chain
+ 0 if Chain is called until the End, -1 if Event Handle is not valid
+ otherwise Return Value of the Hook that breaks the Chain}
+ Function NotivyEventHooks (hEvent: THandle; wParam: TwParam; lParam: TlParam): integer; stdcall;
+
+ {Function Hooks an Event by Name.
+ Returns Hook Handle on Success, otherwise 0}
+ Function HookEvent (EventName: PChar; HookProc: TUS_Hook): THandle; stdcall;
+
+ {Function Removes the Hook from the Chain
+ Returns 0 on Success}
+ Function UnHookEvent (hHook: THandle): Integer; stdcall;
+
+ {Function Returns Non Zero if a Event with the given Name Exists,
+ otherwise 0}
+ Function EventExists (EventName: PChar): Integer; stdcall;
+
+ {******** Service specific Methods ********}
+ {Function Creates a new Service and Returns the Services Handle
+ or 0 on Failure. (Name already exists)}
+ Function CreateService (ServiceName: PChar; ServiceProc: TUS_Service): THandle; stdcall;
+
+ {Function Destroys a Service.
+ 0 on success, not 0 on Failure}
+ Function DestroyService (hService: THandle): integer; stdcall;
+
+ {Function Calls a Services Proc
+ Returns Services Return Value or SERVICE_NOT_FOUND on Failure}
+ Function CallService (ServiceName: PChar; wParam: TwParam; lParam: TlParam): integer; stdcall;
+
+ {Function Returns Non Zero if a Service with the given Name Exists,
+ otherwise 0}
+ Function ServiceExists (ServiceName: PChar): Integer; stdcall;
+
+implementation
+uses UCore;
+
+{******** Hook specific Methods ********}
+//---------------
+// Function Creates a new Hookable Event and Returns the Handle
+// or 0 on Failure. (Name already exists)
+//---------------
+Function CreateHookableEvent (EventName: PChar): THandle; stdcall;
+begin
+ Result := Core.Hooks.AddEvent(EventName);
+end;
+
+//---------------
+// Function Destroys an Event and Unhooks all Hooks to this Event.
+// 0 on success, not 0 on Failure
+//---------------
+Function DestroyHookableEvent (hEvent: THandle): integer; stdcall;
+begin
+ Result := Core.Hooks.DelEvent(hEvent);
+end;
+
+//---------------
+// Function start calling the Hook Chain
+// 0 if Chain is called until the End, -1 if Event Handle is not valid
+// otherwise Return Value of the Hook that breaks the Chain
+//---------------
+Function NotivyEventHooks (hEvent: THandle; wParam: TwParam; lParam: TlParam): integer; stdcall;
+begin
+ Result := Core.Hooks.CallEventChain(hEvent, wParam, lParam);
+end;
+
+//---------------
+// Function Hooks an Event by Name.
+// Returns Hook Handle on Success, otherwise 0
+//---------------
+Function HookEvent (EventName: PChar; HookProc: TUS_Hook): THandle; stdcall;
+begin
+ Result := Core.Hooks.AddSubscriber(EventName, HookProc);
+end;
+
+//---------------
+// Function Removes the Hook from the Chain
+// Returns 0 on Success
+//---------------
+Function UnHookEvent (hHook: THandle): Integer; stdcall;
+begin
+ Result := Core.Hooks.DelSubscriber(hHook);
+end;
+
+//---------------
+// Function Returns Non Zero if a Event with the given Name Exists,
+// otherwise 0
+//---------------
+Function EventExists (EventName: PChar): Integer; stdcall;
+begin
+ Result := Core.Hooks.EventExists(EventName);
+end;
+
+ {******** Service specific Methods ********}
+//---------------
+// Function Creates a new Service and Returns the Services Handle
+// or 0 on Failure. (Name already exists)
+//---------------
+Function CreateService (ServiceName: PChar; ServiceProc: TUS_Service): THandle; stdcall;
+begin
+ Result := Core.Services.AddService(ServiceName, ServiceProc);
+end;
+
+//---------------
+// Function Destroys a Service.
+// 0 on success, not 0 on Failure
+//---------------
+Function DestroyService (hService: THandle): integer; stdcall;
+begin
+ Result := Core.Services.DelService(hService);
+end;
+
+//---------------
+// Function Calls a Services Proc
+// Returns Services Return Value or SERVICE_NOT_FOUND on Failure
+//---------------
+Function CallService (ServiceName: PChar; wParam: TwParam; lParam: TlParam): integer; stdcall;
+begin
+ Result := Core.Services.CallService(ServiceName, wParam, lParam);
+end;
+
+//---------------
+// Function Returns Non Zero if a Service with the given Name Exists,
+// otherwise 0
+//---------------
+Function ServiceExists (ServiceName: PChar): Integer; stdcall;
+begin
+ Result := Core.Services.ServiceExists(ServiceName);
+end;
+
+end.
diff --git a/src/base/URecord.pas b/src/base/URecord.pas
new file mode 100644
index 00000000..8a537dc9
--- /dev/null
+++ b/src/base/URecord.pas
@@ -0,0 +1,766 @@
+unit URecord;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+uses Classes,
+ Math,
+ SysUtils,
+ sdl,
+ UCommon,
+ UMusic,
+ UIni;
+
+const
+ BaseToneFreq = 65.4064; // lowest (half-)tone to analyze (C2 = 65.4064 Hz)
+ NumHalftones = 36; // C2-B4 (for Whitney and my high voice)
+
+type
+ TCaptureBuffer = class
+ private
+ VoiceStream: TAudioVoiceStream; // stream for voice passthrough
+ AnalysisBufferLock: PSDL_Mutex;
+
+ function GetToneString: string; // converts a tone to its string represenatation;
+
+ procedure BoostBuffer(Buffer: PChar; Size: Cardinal);
+ procedure ProcessNewBuffer(Buffer: PChar; BufferSize: integer);
+
+ // we call it to analyze sound by checking Autocorrelation
+ procedure AnalyzeByAutocorrelation;
+ // use this to check one frequency by Autocorrelation
+ function AnalyzeAutocorrelationFreq(Freq: real): real;
+ public
+ AnalysisBuffer: array[0..4095] of smallint; // newest 4096 samples
+ AnalysisBufferSize: integer; // number of samples of BufferArray to analyze
+
+ LogBuffer: TMemoryStream; // full buffer
+
+ AudioFormat: TAudioFormatInfo;
+
+ // pitch detection
+ // TODO: remove ToneValid, set Tone/ToneAbs=-1 if invalid instead
+ ToneValid: boolean; // true if Tone contains a valid value (otherwise it contains noise)
+ Tone: integer; // tone relative to one octave (e.g. C2=C3=C4). Range: 0-11
+ ToneAbs: integer; // absolute (full range) tone (e.g. C2<>C3). Range: 0..NumHalftones-1
+
+ // methods
+ constructor Create;
+ destructor Destroy; override;
+
+ procedure Clear;
+
+ // use to analyze sound from buffers to get new pitch
+ procedure AnalyzeBuffer;
+ procedure LockAnalysisBuffer(); {$IFDEF HasInline}inline;{$ENDIF}
+ procedure UnlockAnalysisBuffer(); {$IFDEF HasInline}inline;{$ENDIF}
+
+ function MaxSampleVolume: Single;
+ property ToneString: string READ GetToneString;
+ end;
+
+const
+ DEFAULT_SOURCE_NAME = '[Default]';
+
+type
+ TAudioInputSource = record
+ Name: string;
+ end;
+
+ // soundcard input-devices information
+ TAudioInputDevice = class
+ public
+ CfgIndex: integer; // index of this device in Ini.InputDeviceConfig
+ Name: string; // soundcard name
+ Source: array of TAudioInputSource; // soundcard input-sources
+ SourceRestore: integer; // source-index that will be selected after capturing (-1: not detected)
+ MicSource: integer; // source-index of mic (-1: none detected)
+
+ AudioFormat: TAudioFormatInfo; // capture format info (e.g. 44.1kHz SInt16 stereo)
+ CaptureChannel: array of TCaptureBuffer; // sound-buffer references used for mono or stereo channel's capture data
+
+ destructor Destroy; override;
+
+ procedure LinkCaptureBuffer(ChannelIndex: integer; Sound: TCaptureBuffer);
+
+ // TODO: add Open/Close functions so Start/Stop becomes faster
+ //function Open(): boolean; virtual; abstract;
+ //function Close(): boolean; virtual; abstract;
+ function Start(): boolean; virtual; abstract;
+ function Stop(): boolean; virtual; abstract;
+
+ function GetVolume(): single; virtual; abstract;
+ procedure SetVolume(Volume: single); virtual; abstract;
+ end;
+
+ TAudioInputProcessor = class
+ public
+ Sound: array of TCaptureBuffer; // sound-buffers for every player
+ DeviceList: array of TAudioInputDevice;
+
+ constructor Create;
+ destructor Destroy; override;
+
+ procedure UpdateInputDeviceConfig;
+
+ // handle microphone input
+ procedure HandleMicrophoneData(Buffer: PChar; Size: Cardinal;
+ InputDevice: TAudioInputDevice);
+ end;
+
+ TAudioInputBase = class( TInterfacedObject, IAudioInput )
+ private
+ Started: boolean;
+ protected
+ function UnifyDeviceName(const name: string; deviceIndex: integer): string;
+ public
+ function GetName: String; virtual; abstract;
+ function InitializeRecord: boolean; virtual; abstract;
+ function FinalizeRecord: boolean; virtual;
+
+ procedure CaptureStart;
+ procedure CaptureStop;
+ end;
+
+
+ TSmallIntArray = array [0..(MaxInt div SizeOf(SmallInt))-1] of SmallInt;
+ PSmallIntArray = ^TSmallIntArray;
+
+ function AudioInputProcessor(): TAudioInputProcessor;
+
+implementation
+
+uses
+ ULog,
+ UMain;
+
+var
+ singleton_AudioInputProcessor : TAudioInputProcessor = nil;
+
+
+{ Global }
+
+function AudioInputProcessor(): TAudioInputProcessor;
+begin
+ if singleton_AudioInputProcessor = nil then
+ singleton_AudioInputProcessor := TAudioInputProcessor.create();
+
+ result := singleton_AudioInputProcessor;
+end;
+
+
+{ TAudioInputDevice }
+
+destructor TAudioInputDevice.Destroy;
+begin
+ Stop();
+ Source := nil;
+ CaptureChannel := nil;
+ FreeAndNil(AudioFormat);
+ inherited Destroy;
+end;
+
+procedure TAudioInputDevice.LinkCaptureBuffer(ChannelIndex: integer; Sound: TCaptureBuffer);
+var
+ DeviceCfg: PInputDeviceConfig;
+ OldSound: TCaptureBuffer;
+begin
+ // check bounds
+ if ((ChannelIndex < 0) or (ChannelIndex > High(CaptureChannel))) then
+ Exit;
+
+ // reset previously assigned (old) capture-buffer
+ OldSound := CaptureChannel[ChannelIndex];
+ if (OldSound <> nil) then
+ begin
+ // close voice stream
+ FreeAndNil(OldSound.VoiceStream);
+ // free old audio-format info
+ FreeAndNil(OldSound.AudioFormat);
+ end;
+
+ // set audio-format of new capture-buffer
+ if (Sound <> nil) then
+ begin
+ // copy the input-device audio-format ...
+ Sound.AudioFormat := AudioFormat.Copy;
+ // and adjust it because capture buffers are always mono
+ Sound.AudioFormat.Channels := 1;
+ DeviceCfg := @Ini.InputDeviceConfig[CfgIndex];
+
+ if (Ini.VoicePassthrough = 1) then
+ begin
+ // TODO: map odd players to the left and even players to the right speaker
+ Sound.VoiceStream := AudioPlayback.CreateVoiceStream(CHANNELMAP_FRONT, AudioFormat);
+ end;
+ end;
+
+ // replace old with new buffer (Note: Sound might be nil)
+ CaptureChannel[ChannelIndex] := Sound;
+end;
+
+{ TSound }
+
+constructor TCaptureBuffer.Create;
+begin
+ inherited;
+ LogBuffer := TMemoryStream.Create;
+ AnalysisBufferLock := SDL_CreateMutex();
+ AnalysisBufferSize := Length(AnalysisBuffer);
+end;
+
+destructor TCaptureBuffer.Destroy;
+begin
+ FreeAndNil(LogBuffer);
+ FreeAndNil(VoiceStream);
+ FreeAndNil(AudioFormat);
+ SDL_DestroyMutex(AnalysisBufferLock);
+ inherited;
+end;
+
+procedure TCaptureBuffer.LockAnalysisBuffer();
+begin
+ SDL_mutexP(AnalysisBufferLock);
+end;
+
+procedure TCaptureBuffer.UnlockAnalysisBuffer();
+begin
+ SDL_mutexV(AnalysisBufferLock);
+end;
+
+procedure TCaptureBuffer.Clear;
+begin
+ if assigned(LogBuffer) then
+ LogBuffer.Clear;
+ LockAnalysisBuffer();
+ FillChar(AnalysisBuffer[0], Length(AnalysisBuffer) * SizeOf(SmallInt), 0);
+ UnlockAnalysisBuffer();
+end;
+
+procedure TCaptureBuffer.ProcessNewBuffer(Buffer: PChar; BufferSize: integer);
+var
+ BufferOffset: integer;
+ SampleCount: integer;
+ i: integer;
+begin
+ // apply software boost
+ //BoostBuffer(Buffer, Size);
+
+ // voice passthrough (send data to playback-device)
+ if (assigned(VoiceStream)) then
+ VoiceStream.WriteData(Buffer, BufferSize);
+
+ // we assume that samples are in S16Int format
+ // TODO: support float too
+ if (AudioFormat.Format <> asfS16) then
+ Exit;
+
+ // process BufferArray
+ BufferOffset := 0;
+
+ SampleCount := BufferSize div SizeOf(SmallInt);
+
+ // check if we have more new samples than we can store
+ if (SampleCount > Length(AnalysisBuffer)) then
+ begin
+ // discard the oldest of the new samples
+ BufferOffset := (SampleCount - Length(AnalysisBuffer)) * SizeOf(SmallInt);
+ SampleCount := Length(AnalysisBuffer);
+ end;
+
+
+ LockAnalysisBuffer();
+ try
+
+ // move old samples to the beginning of the array (if necessary)
+ for i := 0 to High(AnalysisBuffer)-SampleCount do
+ AnalysisBuffer[i] := AnalysisBuffer[i+SampleCount];
+
+ // copy new samples to analysis buffer
+ Move(Buffer[BufferOffset], AnalysisBuffer[Length(AnalysisBuffer)-SampleCount],
+ SampleCount * SizeOf(SmallInt));
+
+ finally
+ UnlockAnalysisBuffer();
+ end;
+
+
+ // save capture-data to BufferLong if enabled
+ if (Ini.SavePlayback = 1) then
+ begin
+ // this is just for debugging (approx 15MB per player for a 3min song!!!)
+ // For an in-game replay-mode we need to compress data so we do not
+ // waste that much memory. Maybe ogg-vorbis with voice-preset in fast-mode?
+ // Or we could use a faster but not that efficient lossless compression.
+ LogBuffer.WriteBuffer(Buffer, BufferSize);
+ end;
+end;
+
+procedure TCaptureBuffer.AnalyzeBuffer;
+var
+ Volume: single;
+ MaxVolume: single;
+ SampleIndex: integer;
+ Threshold: single;
+begin
+ ToneValid := false;
+ ToneAbs := -1;
+ Tone := -1;
+
+ LockAnalysisBuffer();
+ try
+
+ // find maximum volume of first 1024 samples
+ MaxVolume := 0;
+ for SampleIndex := 0 to 1023 do
+ begin
+ Volume := Abs(AnalysisBuffer[SampleIndex]) / -Low(Smallint);
+ if Volume > MaxVolume then
+ MaxVolume := Volume;
+ end;
+
+ Threshold := IThresholdVals[Ini.ThresholdIndex];
+
+ // check if signal has an acceptable volume (ignore background-noise)
+ if MaxVolume >= Threshold then
+ begin
+ // analyse the current voice pitch
+ AnalyzeByAutocorrelation;
+ ToneValid := true;
+ end;
+
+ finally
+ UnlockAnalysisBuffer();
+ end;
+end;
+
+procedure TCaptureBuffer.AnalyzeByAutocorrelation;
+var
+ ToneIndex: integer;
+ CurFreq: real;
+ CurWeight: real;
+ MaxWeight: real;
+ MaxTone: integer;
+const
+ HalftoneBase = 1.05946309436; // 2^(1/12) -> HalftoneBase^12 = 2 (one octave)
+begin
+ // prepare to analyze
+ MaxWeight := -1;
+ MaxTone := 0; // this is not needed, but it satifies the compiler
+
+ // analyze halftones
+ // Note: at the lowest tone (~65Hz) and a buffer-size of 4096
+ // at 44.1 (or 48kHz) only 6 (or 5) samples are compared, this might be
+ // too few samples -> use a bigger buffer-size
+ for ToneIndex := 0 to NumHalftones-1 do
+ begin
+ CurFreq := BaseToneFreq * Power(HalftoneBase, ToneIndex);
+ CurWeight := AnalyzeAutocorrelationFreq(CurFreq);
+
+ // TODO: prefer higher frequencies (use >= or use downto)
+ if (CurWeight > MaxWeight) then
+ begin
+ // this frequency has a higher weight
+ MaxWeight := CurWeight;
+ MaxTone := ToneIndex;
+ end;
+ end;
+
+ ToneAbs := MaxTone;
+ Tone := MaxTone mod 12;
+end;
+
+// result medium difference
+function TCaptureBuffer.AnalyzeAutocorrelationFreq(Freq: real): real;
+var
+ Dist: real; // distance (0=equal .. 1=totally different) between correlated samples
+ AccumDist: real; // accumulated distances
+ SampleIndex: integer; // index of sample to analyze
+ CorrelatingSampleIndex: integer; // index of sample one period ahead
+ SamplesPerPeriod: integer; // samples in one period
+begin
+ SampleIndex := 0;
+ SamplesPerPeriod := Round(AudioFormat.SampleRate/Freq);
+ CorrelatingSampleIndex := SampleIndex + SamplesPerPeriod;
+
+ AccumDist := 0;
+
+ // compare correlating samples
+ while (CorrelatingSampleIndex < AnalysisBufferSize) do
+ begin
+ // calc distance (correlation: 1-dist) to corresponding sample in next period
+ Dist := Abs(AnalysisBuffer[SampleIndex] - AnalysisBuffer[CorrelatingSampleIndex]) /
+ High(Word);
+ AccumDist := AccumDist + Dist;
+ Inc(SampleIndex);
+ Inc(CorrelatingSampleIndex);
+ end;
+
+ // return "inverse" average distance (=correlation)
+ Result := 1 - AccumDist / AnalysisBufferSize;
+end;
+
+function TCaptureBuffer.MaxSampleVolume: Single;
+var
+ lSampleIndex: Integer;
+ lMaxVol : Longint;
+begin;
+ LockAnalysisBuffer();
+ try
+ lMaxVol := 0;
+ for lSampleIndex := 0 to High(AnalysisBuffer) do
+ begin
+ if Abs(AnalysisBuffer[lSampleIndex]) > lMaxVol then
+ lMaxVol := Abs(AnalysisBuffer[lSampleIndex]);
+ end;
+ finally
+ UnlockAnalysisBuffer();
+ end;
+
+ result := lMaxVol / -Low(Smallint);
+end;
+
+const
+ ToneStrings: array[0..11] of string = (
+ 'C', 'C#', 'D', 'D#', 'E', 'F', 'F#', 'G', 'G#', 'A', 'A#', 'B'
+ );
+
+function TCaptureBuffer.GetToneString: string;
+begin
+ if (ToneValid) then
+ Result := ToneStrings[Tone] + IntToStr(ToneAbs div 12 + 2)
+ else
+ Result := '-';
+end;
+
+procedure TCaptureBuffer.BoostBuffer(Buffer: PChar; Size: Cardinal);
+var
+ i: integer;
+ Value: Longint;
+ SampleCount: integer;
+ SampleBuffer: PSmallIntArray; // buffer handled as array of samples
+ Boost: byte;
+begin
+ // TODO: set boost per device
+ {
+ case Ini.MicBoost of
+ 0: Boost := 1;
+ 1: Boost := 2;
+ 2: Boost := 4;
+ 3: Boost := 8;
+ else Boost := 1;
+ end;
+ }
+ Boost := 1;
+
+ // at the moment we will boost SInt16 data only
+ if (AudioFormat.Format = asfS16) then
+ begin
+ // interpret buffer as buffer of bytes
+ SampleBuffer := PSmallIntArray(Buffer);
+ SampleCount := Size div AudioFormat.FrameSize;
+
+ // boost buffer
+ for i := 0 to SampleCount-1 do
+ begin
+ Value := SampleBuffer^[i] * Boost;
+
+ // TODO : JB - This will clip the audio... cant we reduce the "Boost" if the data clips ??
+ if Value > High(Smallint) then
+ Value := High(Smallint);
+
+ if Value < Low(Smallint) then
+ Value := Low(Smallint);
+
+ SampleBuffer^[i] := Value;
+ end;
+ end;
+end;
+
+
+{ TAudioInputProcessor }
+
+constructor TAudioInputProcessor.Create;
+var
+ i: integer;
+begin
+ inherited;
+ SetLength(Sound, 6 {max players});//Ini.Players+1);
+ for i := 0 to High(Sound) do
+ Sound[i] := TCaptureBuffer.Create;
+end;
+
+destructor TAudioInputProcessor.Destroy;
+var
+ i: integer;
+begin
+ for i := 0 to High(Sound) do
+ Sound[i].Free;
+ SetLength(Sound, 0);
+ inherited;
+end;
+
+// updates InputDeviceConfig with current input-device information
+// See: TIni.LoadInputDeviceCfg()
+procedure TAudioInputProcessor.UpdateInputDeviceConfig;
+var
+ deviceIndex: integer;
+ newDevice: boolean;
+ deviceIniIndex: integer;
+ deviceCfg: PInputDeviceConfig;
+ device: TAudioInputDevice;
+ channelCount: integer;
+ channelIndex: integer;
+ i: integer;
+begin
+ // Input devices - append detected soundcards
+ for deviceIndex := 0 to High(DeviceList) do
+ begin
+ newDevice := true;
+ //Search for Card in List
+ for deviceIniIndex := 0 to High(Ini.InputDeviceConfig) do
+ begin
+ deviceCfg := @Ini.InputDeviceConfig[deviceIniIndex];
+ device := DeviceList[deviceIndex];
+
+ if (deviceCfg.Name = Trim(device.Name)) then
+ begin
+ newDevice := false;
+
+ // store highest channel index as an offset for the new channels
+ channelIndex := High(deviceCfg.ChannelToPlayerMap);
+ // add missing channels or remove non-existing ones
+ SetLength(deviceCfg.ChannelToPlayerMap, device.AudioFormat.Channels);
+ // initialize added channels to 0
+ for i := channelIndex+1 to High(deviceCfg.ChannelToPlayerMap) do
+ begin
+ deviceCfg.ChannelToPlayerMap[i] := 0;
+ end;
+
+ // associate ini-index with device
+ device.CfgIndex := deviceIniIndex;
+ break;
+ end;
+ end;
+
+ //If not in List -> Add
+ if newDevice then
+ begin
+ // resize list
+ SetLength(Ini.InputDeviceConfig, Length(Ini.InputDeviceConfig)+1);
+ deviceCfg := @Ini.InputDeviceConfig[High(Ini.InputDeviceConfig)];
+ device := DeviceList[deviceIndex];
+
+ // associate ini-index with device
+ device.CfgIndex := High(Ini.InputDeviceConfig);
+
+ deviceCfg.Name := Trim(device.Name);
+ deviceCfg.Input := 0;
+
+ channelCount := device.AudioFormat.Channels;
+ SetLength(deviceCfg.ChannelToPlayerMap, channelCount);
+
+ for channelIndex := 0 to channelCount-1 do
+ begin
+ // set default at first start of USDX (1st device, 1st channel -> player1)
+ if ((channelIndex = 0) and (device.CfgIndex = 0)) then
+ deviceCfg.ChannelToPlayerMap[0] := 1
+ else
+ deviceCfg.ChannelToPlayerMap[channelIndex] := 0;
+ end;
+ end;
+ end;
+end;
+
+{*
+ * Handles captured microphone input data.
+ * Params:
+ * Buffer - buffer of signed 16bit interleaved stereo PCM-samples.
+ * Interleaved means that a right-channel sample follows a left-
+ * channel sample and vice versa (0:left[0],1:right[0],2:left[1],...).
+ * Length - number of bytes in Buffer
+ * Input - Soundcard-Input used for capture
+ *}
+procedure TAudioInputProcessor.HandleMicrophoneData(Buffer: PChar; Size: Cardinal; InputDevice: TAudioInputDevice);
+var
+ MultiChannelBuffer: PChar; // buffer handled as array of bytes (offset relative to channel)
+ SingleChannelBuffer: PChar; // temporary buffer for new samples per channel
+ SingleChannelBufferSize: integer;
+ ChannelIndex: integer;
+ CaptureChannel: TCaptureBuffer;
+ AudioFormat: TAudioFormatInfo;
+ SampleSize: integer;
+ SampleCount: integer;
+ SamplesPerChannel: integer;
+ i: integer;
+begin
+ AudioFormat := InputDevice.AudioFormat;
+ SampleSize := AudioSampleSize[AudioFormat.Format];
+ SampleCount := Size div SampleSize;
+ SamplesPerChannel := Size div AudioFormat.FrameSize;
+
+ SingleChannelBufferSize := SamplesPerChannel * SampleSize;
+ GetMem(SingleChannelBuffer, SingleChannelBufferSize);
+
+ // process channels
+ for ChannelIndex := 0 to High(InputDevice.CaptureChannel) do
+ begin
+ CaptureChannel := InputDevice.CaptureChannel[ChannelIndex];
+ // check if a capture buffer was assigned, otherwise there is nothing to do
+ if (CaptureChannel <> nil) then
+ begin
+ // set offset according to channel index
+ MultiChannelBuffer := @Buffer[ChannelIndex * SampleSize];
+ // seperate channel-data from interleaved multi-channel (e.g. stereo) data
+ for i := 0 to SamplesPerChannel-1 do
+ begin
+ Move(MultiChannelBuffer[i*AudioFormat.FrameSize],
+ SingleChannelBuffer[i*SampleSize],
+ SampleSize);
+ end;
+ CaptureChannel.ProcessNewBuffer(SingleChannelBuffer, SingleChannelBufferSize);
+ end;
+ end;
+
+ FreeMem(SingleChannelBuffer);
+end;
+
+
+{ TAudioInputBase }
+
+function TAudioInputBase.FinalizeRecord: boolean;
+var
+ i: integer;
+begin
+ for i := 0 to High(AudioInputProcessor.DeviceList) do
+ AudioInputProcessor.DeviceList[i].Free();
+ AudioInputProcessor.DeviceList := nil;
+ Result := true;
+end;
+
+{*
+ * Start capturing on all used input-device.
+ *}
+procedure TAudioInputBase.CaptureStart;
+var
+ S: integer;
+ DeviceIndex: integer;
+ ChannelIndex: integer;
+ Device: TAudioInputDevice;
+ DeviceCfg: PInputDeviceConfig;
+ DeviceUsed: boolean;
+ Player: integer;
+begin
+ if (Started) then
+ CaptureStop();
+
+ // reset buffers
+ for S := 0 to High(AudioInputProcessor.Sound) do
+ AudioInputProcessor.Sound[S].Clear;
+
+ // start capturing on each used device
+ for DeviceIndex := 0 to High(AudioInputProcessor.DeviceList) do
+ begin
+ Device := AudioInputProcessor.DeviceList[DeviceIndex];
+ if not assigned(Device) then
+ continue;
+ DeviceCfg := @Ini.InputDeviceConfig[Device.CfgIndex];
+
+ DeviceUsed := false;
+
+ // check if device is used
+ for ChannelIndex := 0 to High(DeviceCfg.ChannelToPlayerMap) do
+ begin
+ Player := DeviceCfg.ChannelToPlayerMap[ChannelIndex]-1;
+ if (Player < 0) or (Player >= PlayersPlay) then
+ begin
+ Device.LinkCaptureBuffer(ChannelIndex, nil);
+ end
+ else
+ begin
+ Device.LinkCaptureBuffer(ChannelIndex, AudioInputProcessor.Sound[Player]);
+ DeviceUsed := true;
+ end;
+ end;
+
+ // start device if used
+ if (DeviceUsed) then
+ begin
+ //Log.BenchmarkStart(2);
+ Device.Start();
+ //Log.BenchmarkEnd(2);
+ //Log.LogBenchmark('Device.Start', 2) ;
+ end;
+ end;
+
+ Started := true;
+end;
+
+{*
+ * Stop input-capturing on all soundcards.
+ *}
+procedure TAudioInputBase.CaptureStop;
+var
+ DeviceIndex: integer;
+ ChannelIndex: integer;
+ Device: TAudioInputDevice;
+ DeviceCfg: PInputDeviceConfig;
+begin
+ for DeviceIndex := 0 to High(AudioInputProcessor.DeviceList) do
+ begin
+ Device := AudioInputProcessor.DeviceList[DeviceIndex];
+ if not assigned(Device) then
+ continue;
+
+ Device.Stop();
+
+ // disconnect capture buffers
+ DeviceCfg := @Ini.InputDeviceConfig[Device.CfgIndex];
+ for ChannelIndex := 0 to High(DeviceCfg.ChannelToPlayerMap) do
+ Device.LinkCaptureBuffer(ChannelIndex, nil);
+ end;
+
+ Started := false;
+end;
+
+function TAudioInputBase.UnifyDeviceName(const name: string; deviceIndex: integer): string;
+var
+ count: integer; // count of devices with this name
+
+ function IsDuplicate(const name: string): boolean;
+ var
+ i: integer;
+ begin
+ Result := False;
+ // search devices with same description
+ For i := 0 to deviceIndex-1 do
+ begin
+ if (AudioInputProcessor.DeviceList[i].Name = name) then
+ begin
+ Result := True;
+ Break;
+ end;
+ end;
+ end;
+begin
+ count := 1;
+ result := name;
+
+ // if there is another device with the same ID, search for an available name
+ while (IsDuplicate(result)) do
+ begin
+ Inc(count);
+ // set description
+ result := name + ' ('+IntToStr(count)+')';
+ end;
+end;
+
+end.
+
+
+
diff --git a/src/base/URingBuffer.pas b/src/base/URingBuffer.pas
new file mode 100644
index 00000000..ce51e209
--- /dev/null
+++ b/src/base/URingBuffer.pas
@@ -0,0 +1,128 @@
+unit URingBuffer;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+uses
+ SysUtils;
+
+type
+ TRingBuffer = class
+ private
+ RingBuffer: PChar;
+ BufferCount: integer;
+ BufferSize: integer;
+ WritePos: integer;
+ ReadPos: integer;
+ public
+ constructor Create(Size: integer);
+ destructor Destroy; override;
+ function Read(Buffer: PChar; Count: integer): integer;
+ function Write(Buffer: PChar; Count: integer): integer;
+ procedure Flush();
+ end;
+
+implementation
+
+uses
+ Math;
+
+constructor TRingBuffer.Create(Size: integer);
+begin
+ BufferSize := Size;
+
+ GetMem(RingBuffer, Size);
+ if (RingBuffer = nil) then
+ raise Exception.Create('No memory');
+end;
+
+destructor TRingBuffer.Destroy;
+begin
+ FreeMem(RingBuffer);
+end;
+
+function TRingBuffer.Read(Buffer: PChar; Count: integer): integer;
+var
+ PartCount: integer;
+begin
+ // adjust output count
+ if (Count > BufferCount) then
+ begin
+ //DebugWriteln('Read too much: ' + inttostr(count) +',count:'+ inttostr(BufferCount) + '/size:' + inttostr(BufferSize));
+ Count := BufferCount;
+ end;
+
+ // check if there is something to do
+ if (Count <= 0) then
+ begin
+ Result := Count;
+ Exit;
+ end;
+
+ // copy data to output buffer
+
+ // first step: copy from the area between the read-position and the end of the buffer
+ PartCount := Min(Count, BufferSize - ReadPos);
+ Move(RingBuffer[ReadPos], Buffer[0], PartCount);
+
+ // second step: if we need more data, copy from the beginning of the buffer
+ if (PartCount < Count) then
+ Move(RingBuffer[0], Buffer[0], Count-PartCount);
+
+ // mark the copied part of the buffer as free
+ BufferCount := BufferCount - Count;
+ ReadPos := (ReadPos + Count) mod BufferSize;
+
+ Result := Count;
+end;
+
+function TRingBuffer.Write(Buffer: PChar; Count: integer): integer;
+var
+ PartCount: integer;
+begin
+ // check for a reasonable request
+ if (Count <= 0) then
+ begin
+ Result := Count;
+ Exit;
+ end;
+
+ // skip input data if the input buffer is bigger than the ring-buffer
+ if (Count > BufferSize) then
+ begin
+ //DebugWriteln('Write skip data:' + inttostr(count) +',count:'+ inttostr(BufferCount) + '/size:' + inttostr(BufferSize));
+ Buffer := @Buffer[Count - BufferSize];
+ Count := BufferSize;
+ end;
+
+ // first step: copy to the area between the write-position and the end of the buffer
+ PartCount := Min(Count, BufferSize - WritePos);
+ Move(Buffer[0], RingBuffer[WritePos], PartCount);
+
+ // second step: copy data to front of buffer
+ if (PartCount < Count) then
+ Move(Buffer[PartCount], RingBuffer[0], Count-PartCount);
+
+ // update info
+ BufferCount := Min(BufferCount + Count, BufferSize);
+ WritePos := (WritePos + Count) mod BufferSize;
+ // if the buffer is full, we have to reposition the read-position
+ if (BufferCount = BufferSize) then
+ ReadPos := WritePos;
+
+ Result := Count;
+end;
+
+procedure TRingBuffer.Flush();
+begin
+ ReadPos := 0;
+ WritePos := 0;
+ BufferCount := 0;
+end;
+
+end.
\ No newline at end of file
diff --git a/src/base/UServices.pas b/src/base/UServices.pas
new file mode 100644
index 00000000..6325444c
--- /dev/null
+++ b/src/base/UServices.pas
@@ -0,0 +1,358 @@
+unit UServices;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+uses uPluginDefs,
+ SysUtils;
+{*********************
+ TServiceManager
+ Class for saving, managing and calling of Services.
+ Saves all Services and their Procs
+*********************}
+
+type
+ TServiceName = String[60];
+ PServiceInfo = ^TServiceInfo;
+ TServiceInfo = record
+ Self: THandle; //Handle of this Service
+ Hash: Integer; //4 Bit Hash of the Services Name
+ Name: TServiceName; //Name of this Service
+
+ Owner: Integer; //If < 0 [-(DLLMan Pluginindex + 1)]; 0 - undefined, On Error Full shutdown, If < 0 [ModuleIndex - 1]
+
+ Next: PServiceInfo; //Pointer to the Next Service in teh list
+
+ //Here is s/t tricky
+ //To avoid writing of Wrapping Functions to offer a Service from a Class
+ //We save a Normal Proc or a Method of a Class
+ Case isClass: boolean of
+ False: (Proc: TUS_Service); //Proc that will be called on Event
+ True: (ProcOfClass: TUS_Service_of_Object);
+ end;
+
+ TServiceManager = class
+ private
+ //Managing Service List
+ FirstService: PServiceInfo;
+ LastService: PServiceInfo;
+
+ //Some Speed improvement by caching the last 4 called Services
+ //Most of the time a Service is called multiple times
+ ServiceCache: Array[0..3] of PServiceInfo;
+ NextCacheItem: Byte;
+
+ //Next Service added gets this Handle:
+ NextHandle: THandle;
+ public
+ Constructor Create;
+
+ Function AddService(const ServiceName: PChar; const Proc: TUS_Service = nil; const ProcofClass: TUS_Service_of_Object = nil): THandle;
+ Function DelService(const hService: THandle): integer;
+
+ Function CallService(const ServiceName: PChar; const wParam: TwParam; lParam: TlParam): integer;
+
+ Function NametoHash(const ServiceName: TServiceName): Integer;
+ Function ServiceExists(const ServiceName: PChar): Integer;
+ end;
+
+var
+ ServiceManager: TServiceManager;
+
+implementation
+uses
+ ULog,
+ UCore;
+
+//------------
+// Create - Creates Class and Set Standard Values
+//------------
+Constructor TServiceManager.Create;
+begin
+ inherited;
+
+ FirstService := nil;
+ LastService := nil;
+
+ ServiceCache[0] := nil;
+ ServiceCache[1] := nil;
+ ServiceCache[2] := nil;
+ ServiceCache[3] := nil;
+
+ NextCacheItem := 0;
+
+ NextHandle := 1;
+
+ {$IFDEF DEBUG}
+ debugWriteln('ServiceManager: Succesful created!');
+ {$ENDIF}
+end;
+
+//------------
+// Function Creates a new Service and Returns the Services Handle,
+// 0 on Failure. (Name already exists)
+//------------
+Function TServiceManager.AddService(const ServiceName: PChar; const Proc: TUS_Service; const ProcofClass: TUS_Service_of_Object): THandle;
+var
+ Cur: PServiceInfo;
+begin
+ Result := 0;
+
+ If (@Proc <> nil) or (@ProcOfClass <> nil) then
+ begin
+ If (ServiceExists(ServiceName) = 0) then
+ begin //There is a Proc and the Service does not already exist
+ //Ok Add it!
+
+ //Get Memory
+ GetMem(Cur, SizeOf(TServiceInfo));
+
+ //Fill it with Data
+ Cur.Next := nil;
+
+ If (@Proc = nil) then
+ begin //Use the ProcofClass Method
+ Cur.isClass := True;
+ Cur.ProcOfClass := ProcofClass;
+ end
+ else //Use the normal Proc
+ begin
+ Cur.isClass := False;
+ Cur.Proc := Proc;
+ end;
+
+ Cur.Self := NextHandle;
+ //Zero Name
+ Cur.Name := #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0;
+ Cur.Name := String(ServiceName);
+ Cur.Hash := NametoHash(Cur.Name);
+
+ //Add Owner to Service
+ Cur.Owner := Core.CurExecuted;
+
+ //Add Service to the List
+ If (FirstService = nil) then
+ FirstService := Cur;
+
+ If (LastService <> nil) then
+ LastService.Next := Cur;
+
+ LastService := Cur;
+
+ {$IFDEF DEBUG}
+ debugWriteln('ServiceManager: Service added: ''' + ServiceName + ''', Handle: ' + InttoStr(Cur.Self));
+ {$ENDIF}
+
+ //Inc Next Handle
+ Inc(NextHandle);
+ end
+ {$IFDEF DEBUG}
+ else debugWriteln('ServiceManager: Try to readd Service: ' + ServiceName);
+ {$ENDIF}
+ end;
+end;
+
+//------------
+// Function Destroys a Service, 0 on success, not 0 on Failure
+//------------
+Function TServiceManager.DelService(const hService: THandle): integer;
+var
+ Last, Cur: PServiceInfo;
+ I: Integer;
+begin
+ Result := -1;
+
+ Last := nil;
+ Cur := FirstService;
+
+ //Search for Service to Delete
+ While (Cur <> nil) do
+ begin
+ If (Cur.Self = hService) then
+ begin //Found Service => Delete it
+
+ //Delete from List
+ If (Last = nil) then //Found first Service
+ FirstService := Cur.Next
+ Else //Service behind the first
+ Last.Next := Cur.Next;
+
+ //IF this is the LastService, correct LastService
+ If (Cur = LastService) then
+ LastService := Last;
+
+ //Search for Service in Cache and delete it if found
+ For I := 0 to High(ServiceCache) do
+ If (ServiceCache[I] = Cur) then
+ begin
+ ServiceCache[I] := nil;
+ end;
+
+ {$IFDEF DEBUG}
+ debugWriteln('ServiceManager: Removed Service succesful: ' + Cur.Name);
+ {$ENDIF}
+
+ //Free Memory
+ Freemem(Cur, SizeOf(TServiceInfo));
+
+ //Break the Loop
+ Break;
+ end;
+
+ //Go to Next Service
+ Last := Cur;
+ Cur := Cur.Next;
+ end;
+end;
+
+//------------
+// Function Calls a Services Proc
+// Returns Services Return Value or SERVICE_NOT_FOUND on Failure
+//------------
+Function TServiceManager.CallService(const ServiceName: PChar; const wParam: TwParam; lParam: TlParam): integer;
+var
+ SExists: Integer;
+ Service: PServiceInfo;
+ CurExecutedBackup: Integer; //backup of Core.CurExecuted Attribute
+begin
+ Result := SERVICE_NOT_FOUND;
+ SExists := ServiceExists(ServiceName);
+ If (SExists <> 0) then
+ begin
+ //Backup CurExecuted
+ CurExecutedBackup := Core.CurExecuted;
+
+ Service := Pointer(SExists);
+
+ If (Service.isClass) then
+ //Use Proc of Class
+ Result := Service.ProcOfClass(wParam, lParam)
+ Else
+ //Use normal Proc
+ Result := Service.Proc(wParam, lParam);
+
+ //Restore CurExecuted
+ Core.CurExecuted := CurExecutedBackup;
+ end;
+
+ {$IFDEF DEBUG}
+ debugWriteln('ServiceManager: Service ''' + ServiceName + ''' called. Result: ' + InttoStr(Result));
+ {$ENDIF}
+end;
+
+//------------
+// Generates the Hash for the given Name
+//------------
+Function TServiceManager.NametoHash(const ServiceName: TServiceName): Integer;
+// FIXME: check if the non-asm version is fast enough and use it by default if so
+{$IF Defined(CPUX86_64)}
+{$IFDEF FPC}
+ {$ASMMODE Intel}
+{$ENDIF}
+asm
+ { CL: Counter; RAX: Result; RDX: Current Memory Address }
+ Mov RCX, 14
+ Mov RDX, ServiceName {Save Address of String that should be "Hashed"}
+ Mov RAX, [RDX]
+ @FoldLoop: ADD RDX, 4 {jump 4 Byte(32 Bit) to the next tile }
+ ADD RAX, [RDX] {Add the Value of the next 4 Byte of the String to the Hash}
+ LOOP @FoldLoop {Fold again if there are Chars Left}
+end;
+{$ELSEIF Defined(CPU386) or Defined(CPUI386)}
+{$IFDEF FPC}
+ {$ASMMODE Intel}
+{$ENDIF}
+asm
+ { CL: Counter; EAX: Result; EDX: Current Memory Address }
+ Mov ECX, 14 {Init Counter, Fold 14 Times to get 4 Bytes out of 60}
+ Mov EDX, ServiceName {Save Address of String that should be "Hashed"}
+ Mov EAX, [EDX]
+ @FoldLoop: ADD EDX, 4 {jump 4 Byte(32 Bit) to the next tile }
+ ADD EAX, [EDX] {Add the Value of the next 4 Byte of the String to the Hash}
+ LOOP @FoldLoop {Fold again if there are Chars Left}
+end;
+{$ELSE}
+var
+ i: integer;
+ ptr: ^integer;
+begin
+ ptr := @ServiceName;
+ Result := 0;
+ for i := 1 to 14 do
+ begin
+ Result := Result + ptr^;
+ Inc(ptr);
+ end;
+end;
+{$IFEND}
+
+
+//------------
+// Function Returns Non Zero if a Service with the given Name Exists, otherwise 0
+//------------
+Function TServiceManager.ServiceExists(const ServiceName: PChar): Integer;
+var
+ Name: TServiceName;
+ Hash: Integer;
+ Cur: PServiceInfo;
+ I: Byte;
+begin
+ Result := 0;
+ // to-do : Write a Metbod (in ASM) to Zero and Add in one turn (faster then this dirty hack ;)
+ //Zero Name:
+ Name := #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0;
+ //Add Service Name
+ Name := String(ServiceName);
+ Hash := NametoHash(Name);
+
+ //First of all Look for the Service in Cache
+ For I := 0 to High(ServiceCache) do
+ begin
+ If (ServiceCache[I] <> nil) AND (ServiceCache[I].Hash = Hash) then
+ begin
+ If (ServiceCache[I].Name = Name) then
+ begin //Found Service in Cache
+ Result := Integer(ServiceCache[I]);
+
+ {$IFDEF DEBUG}
+ debugWriteln('ServiceManager: Found Service in Cache: ''' + ServiceName + '''');
+ {$ENDIF}
+
+ Break;
+ end;
+ end;
+ end;
+
+ If (Result = 0) then
+ begin
+ Cur := FirstService;
+ While (Cur <> nil) do
+ begin
+ If (Cur.Hash = Hash) then
+ begin
+ If (Cur.Name = Name) then
+ begin //Found the Service
+ Result := Integer(Cur);
+
+ {$IFDEF DEBUG}
+ debugWriteln('ServiceManager: Found Service in List: ''' + ServiceName + '''');
+ {$ENDIF}
+
+ //Add to Cache
+ ServiceCache[NextCacheItem] := Cur;
+ NextCacheItem := (NextCacheItem + 1) AND 3;
+ Break;
+ end;
+ end;
+
+ Cur := Cur.Next;
+ end;
+ end;
+end;
+
+end.
diff --git a/src/base/USingNotes.pas b/src/base/USingNotes.pas
new file mode 100644
index 00000000..3b268d10
--- /dev/null
+++ b/src/base/USingNotes.pas
@@ -0,0 +1,13 @@
+unit USingNotes;
+
+interface
+
+{$I switches.inc}
+
+{ Dummy Unit atm
+ For further expantation
+ Placeholder for Class that will handle the Notes Drawing}
+
+implementation
+
+end.
diff --git a/src/base/USingScores.pas b/src/base/USingScores.pas
new file mode 100644
index 00000000..77d40b84
--- /dev/null
+++ b/src/base/USingScores.pas
@@ -0,0 +1,973 @@
+unit USingScores;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+uses UThemes,
+ gl,
+ UTexture;
+
+//////////////////////////////////////////////////////////////
+// ATTENTION: //
+// Enabled Flag does not Work atm. This should cause Popups //
+// Not to Move and Scores to stay until Renenabling. //
+// To use e.g. in Pause Mode //
+// Also InVisible Flag causes Attributes not to change. //
+// This should be fixed after next Draw when Visible = True,//
+// but not testet yet //
+//////////////////////////////////////////////////////////////
+
+//Some constants containing options that could change by time
+const
+ MaxPlayers = 6; //Maximum of Players that could be added
+ MaxPositions = 6; //Maximum of Score Positions that could be added
+
+type
+ //-----------
+ // TScorePlayer - Record Containing Information about a Players Score
+ //-----------
+ TScorePlayer = record
+ Position: Byte; //Index of the Position where the Player should be Drawn
+ Enabled: Boolean; //Is the Score Display Enabled
+ Visible: Boolean; //Is the Score Display Visible
+ Score: Word; //Current Score of the Player
+ ScoreDisplayed: Word; //Score cur. Displayed(for counting up)
+ ScoreBG: TTexture;//Texture of the Players Scores BG
+ Color: TRGB; //Teh Players Color
+ RBPos: Real; //Cur. Percentille of the Rating Bar
+ RBTarget: Real; //Target Position of Rating Bar
+ RBVisible:Boolean; //Is Rating bar Drawn
+ end;
+ aScorePlayer = array[0..MaxPlayers-1] of TScorePlayer;
+
+ //-----------
+ // TScorePosition - Record Containing Information about a Score Position, that can be used
+ //-----------
+ PScorePosition = ^TScorePosition;
+ TScorePosition = record
+ //The Position is Used for Which Playercount
+ PlayerCount: Byte;
+ // 1 - One Player per Screen
+ // 2 - 2 Players per Screen
+ // 4 - 3 Players per Screen
+ // 6 would be 2 and 3 Players per Screen
+
+ BGX: Real; //X Position of the Score BG
+ BGY: Real; //Y Position of the Score BG
+ BGW: Real; //Width of the Score BG
+ BGH: Real; //Height of the Score BG
+
+ RBX: Real; //X Position of the Rating Bar
+ RBY: Real; //Y Position of the Rating Bar
+ RBW: Real; //Width of the Rating Bar
+ RBH: Real; //Height of the Rating Bar
+
+ TextX: Real; //X Position of the Score Text
+ TextY: Real; //Y Position of the Score Text
+ TextFont: Byte; //Font of the Score Text
+ TextSize: Byte; //Size of the Score Text
+
+ PUW: Real; //Width of the LineBonus Popup
+ PUH: Real; //Height of the LineBonus Popup
+ PUFont: Byte; //Font for the PopUps
+ PUFontSize: Byte; //FontSize for the PopUps
+ PUStartX: Real; //X Start Position of the LineBonus Popup
+ PUStartY: Real; //Y Start Position of the LineBonus Popup
+ PUTargetX: Real; //X Target Position of the LineBonus Popup
+ PUTargetY: Real; //Y Target Position of the LineBonus Popup
+ end;
+ aScorePosition = array[0..MaxPositions-1] of TScorePosition;
+
+ //-----------
+ // TScorePopUp - Record Containing Information about a LineBonus Popup
+ // List, Next Item is Saved in Next attribute
+ //-----------
+ PScorePopUp = ^TScorePopUp;
+ TScorePopUp = record
+ Player: Byte; //Index of the PopUps Player
+ TimeStamp: Cardinal; //Timestamp of Popups Spawn
+ Rating: Byte; //0 to 8, Type of Rating (Cool, bad, etc.)
+ ScoreGiven:Word; //Score that has already been given to the Player
+ ScoreDiff: Word; //Difference Between Cur Score at Spawn and Old Score
+ Next: PScorePopUp; //Next Item in List
+ end;
+ aScorePopUp = array of TScorePopUp;
+
+ //-----------
+ // TSingScores - Class containing Scores Positions and Drawing Scores, Rating Bar + Popups
+ //-----------
+ TSingScores = class
+ private
+ Positions: aScorePosition;
+ aPlayers: aScorePlayer;
+ oPositionCount: Byte;
+ oPlayerCount: Byte;
+
+ //Saves the First and Last Popup of the List
+ FirstPopUp: PScorePopUp;
+ LastPopUp: PScorePopUp;
+
+ //Procedure Draws a Popup by Pointer
+ Procedure DrawPopUp(const PopUp: PScorePopUp);
+
+ //Procedure Draws a Score by Playerindex
+ Procedure DrawScore(const Index: Integer);
+
+ //Procedure Draws the RatingBar by Playerindex
+ Procedure DrawRatingBar(const Index: Integer);
+
+ //Procedure Removes a PopUp w/o destroying the List
+ Procedure KillPopUp(const last, cur: PScorePopUp);
+ public
+ Settings: record //Record containing some Displaying Options
+ Phase1Time: Real; //time for Phase 1 to complete (in msecs)
+ //The Plop Up of the PopUp
+ Phase2Time: Real; //time for Phase 2 to complete (in msecs)
+ //The Moving (mainly Upwards) of the Popup
+ Phase3Time: Real; //time for Phase 3 to complete (in msecs)
+ //The Fade out and Score adding
+
+ PopUpTex: Array [0..8] of TTexture; //Textures for every Popup Rating
+
+ RatingBar_BG_Tex: TTexture; //Rating Bar Texs
+ RatingBar_FG_Tex: TTexture;
+ RatingBar_Bar_Tex: TTexture;
+
+ end;
+
+ Visible: Boolean; //Visibility of all Scores
+ Enabled: Boolean; //Scores are changed, PopUps are Moved etc.
+ RBVisible: Boolean; //Visibility of all Rating Bars
+
+ //Propertys for Reading Position and Playercount
+ Property PositionCount: Byte read oPositionCount;
+ Property PlayerCount: Byte read oPlayerCount;
+ Property Players: aScorePlayer read aPlayers;
+
+ //Constructor just sets some standard Settings
+ Constructor Create;
+
+ //Procedure Adds a Position to Array and Increases Position Count
+ Procedure AddPosition(const pPosition: PScorePosition);
+
+ //Procedure Adds a Player to Array and Increases Player Count
+ Procedure AddPlayer(const ScoreBG: TTexture; const Color: TRGB; const Score: Word = 0; const Enabled: Boolean = True; const Visible: Boolean = True);
+
+ //Change a Players Visibility, Enable
+ Procedure ChangePlayerVisibility(const Index: Byte; const pVisible: Boolean);
+ Procedure ChangePlayerEnabled(const Index: Byte; const pEnabled: Boolean);
+
+ //Procedure Deletes all Player Information
+ Procedure ClearPlayers;
+
+ //Procedure Deletes Positions and Playerinformation
+ Procedure Clear;
+
+ //Procedure Loads some Settings and the Positions from Theme
+ Procedure LoadfromTheme;
+
+ //Procedure has to be called after Positions and Players have been added, before first call of Draw
+ //It gives every Player a Score Position
+ Procedure Init;
+
+ //Spawns a new Line Bonus PopUp for the Player
+ Procedure SpawnPopUp(const PlayerIndex: Byte; const Rating: Byte; const Score: Word);
+
+ //Removes all PopUps from Mem
+ Procedure KillAllPopUps;
+
+ //Procedure Draws Scores and Linebonus PopUps
+ Procedure Draw;
+ end;
+
+
+implementation
+
+uses SDL,
+ SysUtils,
+ ULog,
+ UGraphic,
+ TextGL;
+
+//-----------
+//Constructor just sets some standard Settings
+//-----------
+Constructor TSingScores.Create;
+begin
+ inherited;
+
+ //Clear PopupList Pointers
+ FirstPopUp := nil;
+ LastPopUp := nil;
+
+ //Clear Variables
+ Visible := True;
+ Enabled := True;
+ RBVisible := True;
+
+ //Clear Position Index
+ oPositionCount := 0;
+ oPlayerCount := 0;
+
+ Settings.Phase1Time := 350; // plop it up . -> [ ]
+ Settings.Phase2Time := 550; // shift it up ^[ ]^
+ Settings.Phase3Time := 200; // increase score [s++]
+
+ Settings.PopUpTex[0].TexNum := 0;
+ Settings.PopUpTex[1].TexNum := 0;
+ Settings.PopUpTex[2].TexNum := 0;
+ Settings.PopUpTex[3].TexNum := 0;
+ Settings.PopUpTex[4].TexNum := 0;
+ Settings.PopUpTex[5].TexNum := 0;
+ Settings.PopUpTex[6].TexNum := 0;
+ Settings.PopUpTex[7].TexNum := 0;
+ Settings.PopUpTex[8].TexNum := 0;
+
+ Settings.RatingBar_BG_Tex.TexNum := 0;
+ Settings.RatingBar_FG_Tex.TexNum := 0;
+ Settings.RatingBar_Bar_Tex.TexNum := 0;
+end;
+
+//-----------
+//Procedure Adds a Position to Array and Increases Position Count
+//-----------
+Procedure TSingScores.AddPosition(const pPosition: PScorePosition);
+begin
+ if (PositionCount < MaxPositions) then
+ begin
+ Positions[PositionCount] := pPosition^;
+
+ Inc(oPositionCount);
+ end;
+end;
+
+//-----------
+//Procedure Adds a Player to Array and Increases Player Count
+//-----------
+Procedure TSingScores.AddPlayer(const ScoreBG: TTexture; const Color: TRGB; const Score: Word; const Enabled: Boolean; const Visible: Boolean);
+begin
+ if (PlayerCount < MaxPlayers) then
+ begin
+ aPlayers[PlayerCount].Position := High(byte);
+ aPlayers[PlayerCount].Enabled := Enabled;
+ aPlayers[PlayerCount].Visible := Visible;
+ aPlayers[PlayerCount].Score := Score;
+ aPlayers[PlayerCount].ScoreDisplayed := Score;
+ aPlayers[PlayerCount].ScoreBG := ScoreBG;
+ aPlayers[PlayerCount].Color := Color;
+ aPlayers[PlayerCount].RBPos := 0.5;
+ aPlayers[PlayerCount].RBTarget := 0.5;
+ aPlayers[PlayerCount].RBVisible := True;
+
+ Inc(oPlayerCount);
+ end;
+end;
+
+//-----------
+//Change a Players Visibility
+//-----------
+Procedure TSingScores.ChangePlayerVisibility(const Index: Byte; const pVisible: Boolean);
+begin
+ if (Index < MaxPlayers) then
+ aPlayers[Index].Visible := pVisible;
+end;
+
+//-----------
+//Change Player Enabled
+//-----------
+Procedure TSingScores.ChangePlayerEnabled(const Index: Byte; const pEnabled: Boolean);
+begin
+ if (Index < MaxPlayers) then
+ aPlayers[Index].Enabled := pEnabled;
+end;
+
+//-----------
+//Procedure Deletes all Player Information
+//-----------
+Procedure TSingScores.ClearPlayers;
+begin
+ KillAllPopUps;
+ oPlayerCount := 0;
+end;
+
+//-----------
+//Procedure Deletes Positions and Playerinformation
+//-----------
+Procedure TSingScores.Clear;
+begin
+ KillAllPopUps;
+ oPlayerCount := 0;
+ oPositionCount := 0;
+end;
+
+//-----------
+//Procedure Loads some Settings and the Positions from Theme
+//-----------
+Procedure TSingScores.LoadfromTheme;
+var I: Integer;
+ Procedure AddbyStatics(const PC: Byte; const ScoreStatic, SingBarStatic: TThemeStatic; ScoreText: TThemeText);
+ var nPosition: TScorePosition;
+ begin
+ nPosition.PlayerCount := PC; //Only for one Player Playing
+
+ nPosition.BGX := ScoreStatic.X;
+ nPosition.BGY := ScoreStatic.Y;
+ nPosition.BGW := ScoreStatic.W;
+ nPosition.BGH := ScoreStatic.H;
+
+ nPosition.TextX := ScoreText.X;
+ nPosition.TextY := ScoreText.Y;
+ nPosition.TextFont := ScoreText.Font;
+ nPosition.TextSize := ScoreText.Size;
+
+ nPosition.RBX := SingBarStatic.X;
+ nPosition.RBY := SingBarStatic.Y;
+ nPosition.RBW := SingBarStatic.W;
+ nPosition.RBH := SingBarStatic.H;
+
+ nPosition.PUW := nPosition.BGW;
+ nPosition.PUH := nPosition.BGH;
+
+ nPosition.PUFont := 2;
+ nPosition.PUFontSize := 6;
+
+ nPosition.PUStartX := nPosition.BGX;
+ nPosition.PUStartY := nPosition.TextY + 65;
+
+ nPosition.PUTargetX := nPosition.BGX;
+ nPosition.PUTargetY := nPosition.TextY;
+
+ AddPosition(@nPosition);
+ end;
+begin
+ Clear;
+
+ //Set Textures
+ //Popup Tex
+ For I := 0 to 8 do
+ Settings.PopUpTex[I] := Tex_SingLineBonusBack[I];
+
+ //Rating Bar Tex
+ Settings.RatingBar_BG_Tex := Tex_SingBar_Back;
+ Settings.RatingBar_FG_Tex := Tex_SingBar_Front;
+ Settings.RatingBar_Bar_Tex := Tex_SingBar_Bar;
+
+ //Load Positions from Theme
+
+ // Player1:
+ AddByStatics(1, Theme.Sing.StaticP1ScoreBG, Theme.Sing.StaticP1SingBar, Theme.Sing.TextP1Score);
+ AddByStatics(2, Theme.Sing.StaticP1TwoPScoreBG, Theme.Sing.StaticP1TwoPSingBar, Theme.Sing.TextP1TwoPScore);
+ AddByStatics(4, Theme.Sing.StaticP1ThreePScoreBG, Theme.Sing.StaticP1ThreePSingBar, Theme.Sing.TextP1ThreePScore);
+
+ // Player2:
+ AddByStatics(2, Theme.Sing.StaticP2RScoreBG, Theme.Sing.StaticP2RSingBar, Theme.Sing.TextP2RScore);
+ AddByStatics(4, Theme.Sing.StaticP2MScoreBG, Theme.Sing.StaticP2MSingBar, Theme.Sing.TextP2MScore);
+
+ // Player3:
+ AddByStatics(4, Theme.Sing.StaticP3RScoreBG, Theme.Sing.StaticP3RScoreBG, Theme.Sing.TextP3RScore);
+end;
+
+//-----------
+//Spawns a new Line Bonus PopUp for the Player
+//-----------
+Procedure TSingScores.SpawnPopUp(const PlayerIndex: Byte; const Rating: Byte; const Score: Word);
+var Cur: PScorePopUp;
+begin
+ if (PlayerIndex < PlayerCount) then
+ begin
+ //Get Memory and Add Data
+ GetMem(Cur, SizeOf(TScorePopUp));
+
+ Cur.Player := PlayerIndex;
+ Cur.TimeStamp := SDL_GetTicks;
+ Cur.Rating := Rating;
+ Cur.ScoreGiven:= 0;
+ If (Players[PlayerIndex].Score < Score) then
+ begin
+ Cur.ScoreDiff := Score - Players[PlayerIndex].Score;
+ aPlayers[PlayerIndex].Score := Score;
+ end
+ else
+ Cur.ScoreDiff := 0;
+ Cur.Next := nil;
+
+ //Log.LogError('TSingScores.SpawnPopUp| Player: ' + InttoStr(PlayerIndex) + ', Score: ' + InttoStr(Score) + ', ScoreDiff: ' + InttoStr(Cur.ScoreDiff));
+
+ //Add it to the Chain
+ if (FirstPopUp = nil) then
+ //the first PopUp in the List
+ FirstPopUp := Cur
+ else
+ //second or earlier popup
+ LastPopUp.Next := Cur;
+
+ //Set new Popup to Last PopUp in the List
+ LastPopUp := Cur;
+ end
+ else
+ Log.LogError('TSingScores: Try to add PopUp for not existing player');
+end;
+
+//-----------
+// Removes a PopUp w/o destroying the List
+//-----------
+Procedure TSingScores.KillPopUp(const last, cur: PScorePopUp);
+var
+ lTempA ,
+ lTempB : real;
+begin
+ //Give Player the Last Points that missing till now
+ aPlayers[Cur.Player].ScoreDisplayed := aPlayers[Cur.Player].ScoreDisplayed + Cur.ScoreDiff - Cur.ScoreGiven;
+
+ //Change Bars Position
+ lTempA := ( aPlayers[Cur.Player].RBTarget + (Cur.ScoreDiff - Cur.ScoreGiven) );
+ lTempB := ( Cur.ScoreDiff * (Cur.Rating / 20 - 0.26) );
+
+ if ( lTempA > 0 ) AND
+ ( lTempB > 0 ) THEN
+ begin
+ aPlayers[Cur.Player].RBTarget := lTempA / lTempB;
+ end;
+
+ If (aPlayers[Cur.Player].RBTarget > 1) then
+ aPlayers[Cur.Player].RBTarget := 1
+ else
+ If (aPlayers[Cur.Player].RBTarget < 0) then
+ aPlayers[Cur.Player].RBTarget := 0;
+
+ //If this is the First PopUp => Make Next PopUp the First
+ If (Cur = FirstPopUp) then
+ FirstPopUp := Cur.Next
+ //Else => Remove Curent Popup from Chain
+ else
+ Last.Next := Cur.Next;
+
+ //If this is the Last PopUp, Make PopUp before the Last
+ If (Cur = LastPopUp) then
+ LastPopUp := Last;
+
+ //Free the Memory
+ FreeMem(Cur, SizeOf(TScorePopUp));
+end;
+
+//-----------
+//Removes all PopUps from Mem
+//-----------
+Procedure TSingScores.KillAllPopUps;
+var
+ Cur: PScorePopUp;
+ Last: PScorePopUp;
+begin
+ Cur := FirstPopUp;
+
+ //Remove all PopUps:
+ While (Cur <> nil) do
+ begin
+ Last := Cur;
+ Cur := Cur.Next;
+ FreeMem(Last, SizeOf(TScorePopUp));
+ end;
+
+ FirstPopUp := nil;
+ LastPopUp := nil;
+end;
+
+//-----------
+//Init - has to be called after Positions and Players have been added, before first call of Draw
+//It gives every Player a Score Position
+//-----------
+Procedure TSingScores.Init;
+var
+ PlC: Array [0..1] of Byte; //Playercount First Screen and Second Screen
+ I, J: Integer;
+ MaxPlayersperScreen: Byte;
+ CurPlayer: Byte;
+
+ Function GetPositionCountbyPlayerCount(bPlayerCount: Byte): Byte;
+ var I: Integer;
+ begin
+ Result := 0;
+ bPlayerCount := 1 shl (bPlayerCount - 1);
+
+ For I := 0 to PositionCount-1 do
+ begin
+ If ((Positions[I].PlayerCount AND bPlayerCount) <> 0) then
+ Inc(Result);
+ end;
+ end;
+
+ Function GetPositionbyPlayernum(bPlayerCount, bPlayer: Byte): Byte;
+ var I: Integer;
+ begin
+ bPlayerCount := 1 shl (bPlayerCount - 1);
+ Result := High(Byte);
+
+ For I := 0 to PositionCount-1 do
+ begin
+ If ((Positions[I].PlayerCount AND bPlayerCount) <> 0) then
+ begin
+ If (bPlayer = 0) then
+ begin
+ Result := I;
+ Break;
+ end
+ else
+ Dec(bPlayer);
+ end;
+ end;
+ end;
+
+begin
+ MaxPlayersPerScreen := 0;
+
+ For I := 1 to 6 do
+ begin
+ //If there are enough Positions -> Write to MaxPlayers
+ If (GetPositionCountbyPlayerCount(I) = I) then
+ MaxPlayersPerScreen := I
+ else
+ Break;
+ end;
+
+
+ //Split Players to both Screen or Display on One Screen
+ if (Screens = 2) and (MaxPlayersPerScreen < PlayerCount) then
+ begin
+ PlC[0] := PlayerCount div 2 + PlayerCount mod 2;
+ PlC[1] := PlayerCount div 2;
+ end
+ else
+ begin
+ PlC[0] := PlayerCount;
+ PlC[1] := 0;
+ end;
+
+
+ //Check if there are enough Positions for all Players
+ For I := 0 to Screens - 1 do
+ begin
+ if (PlC[I] > MaxPlayersperScreen) then
+ begin
+ PlC[I] := MaxPlayersperScreen;
+ Log.LogError('More Players than available Positions, TSingScores');
+ end;
+ end;
+
+ CurPlayer := 0;
+ //Give every Player a Position
+ For I := 0 to Screens - 1 do
+ For J := 0 to PlC[I]-1 do
+ begin
+ aPlayers[CurPlayer].Position := GetPositionbyPlayernum(PlC[I], J) OR (I shl 7);
+ //Log.LogError('Player ' + InttoStr(CurPlayer) + ' gets Position: ' + InttoStr(aPlayers[CurPlayer].Position));
+ Inc(CurPlayer);
+ end;
+end;
+
+//-----------
+//Procedure Draws Scores and Linebonus PopUps
+//-----------
+Procedure TSingScores.Draw;
+var
+ I: Integer;
+ CurTime: Cardinal;
+ CurPopUp, LastPopUp: PScorePopUp;
+begin
+ CurTime := SDL_GetTicks;
+
+ If Visible then
+ begin
+ //Draw Popups
+ LastPopUp := nil;
+ CurPopUp := FirstPopUp;
+
+ While (CurPopUp <> nil) do
+ begin
+ if (CurTime - CurPopUp.TimeStamp > Settings.Phase1Time + Settings.Phase2Time + Settings.Phase3Time) then
+ begin
+ KillPopUp(LastPopUp, CurPopUp);
+ if (LastPopUp = nil) then
+ CurPopUp := FirstPopUp
+ else
+ CurPopUp := LastPopUp.Next;
+ end
+ else
+ begin
+ DrawPopUp(CurPopUp);
+ LastPopUp := CurPopUp;
+ CurPopUp := LastPopUp.Next;
+ end;
+ end;
+
+
+ IF (RBVisible) then
+ //Draw Players w/ Rating Bar
+ For I := 0 to PlayerCount-1 do
+ begin
+ DrawScore(I);
+ DrawRatingBar(I);
+ end
+ else
+ //Draw Players w/o Rating Bar
+ For I := 0 to PlayerCount-1 do
+ begin
+ DrawScore(I);
+ end;
+
+ end; //eo Visible
+end;
+
+//-----------
+//Procedure Draws a Popup by Pointer
+//-----------
+Procedure TSingScores.DrawPopUp(const PopUp: PScorePopUp);
+var
+ Progress: Real;
+ CurTime: Cardinal;
+ X, Y, W, H, Alpha: Real;
+ FontSize: Byte;
+ TimeDiff: Cardinal;
+ PIndex: Byte;
+ TextLen: Real;
+ ScoretoAdd: Word;
+ PosDiff: Real;
+begin
+ if (PopUp <> nil) then
+ begin
+ //Only Draw if Player has a Position
+ PIndex := Players[PopUp.Player].Position;
+ If PIndex <> high(byte) then
+ begin
+ //Only Draw if Player is on Cur Screen
+ If ((Players[PopUp.Player].Position AND 128) = 0) = (ScreenAct = 1) then
+ begin
+ CurTime := SDL_GetTicks;
+ If Not (Enabled AND Players[PopUp.Player].Enabled) then
+ //Increase Timestamp with TIem where there is no Movement ...
+ begin
+ //Inc(PopUp.TimeStamp, LastRender);
+ end;
+ TimeDiff := CurTime - PopUp.TimeStamp;
+
+ //Get Position of PopUp
+ PIndex := PIndex AND 127;
+
+
+ //Check for Phase ...
+ If (TimeDiff <= Settings.Phase1Time) then
+ begin
+ //Phase 1 - The Ploping up
+ Progress := TimeDiff / Settings.Phase1Time;
+
+
+ W := Positions[PIndex].PUW * Sin(Progress/2*Pi);
+ H := Positions[PIndex].PUH * Sin(Progress/2*Pi);
+
+ X := Positions[PIndex].PUStartX + (Positions[PIndex].PUW - W)/2;
+ Y := Positions[PIndex].PUStartY + (Positions[PIndex].PUH - H)/2;
+
+ FontSize := Round(Progress * Positions[PIndex].PUFontSize);
+ Alpha := 1;
+ end
+
+ Else If (TimeDiff <= Settings.Phase2Time + Settings.Phase1Time) then
+ begin
+ //Phase 2 - The Moving
+ Progress := (TimeDiff - Settings.Phase1Time) / Settings.Phase2Time;
+
+ W := Positions[PIndex].PUW;
+ H := Positions[PIndex].PUH;
+
+ PosDiff := Positions[PIndex].PUTargetX - Positions[PIndex].PUStartX;
+ If PosDiff > 0 then
+ PosDiff := PosDiff + W;
+ X := Positions[PIndex].PUStartX + PosDiff * sqr(Progress);
+
+ PosDiff := Positions[PIndex].PUTargetY - Positions[PIndex].PUStartY;
+ If PosDiff < 0 then
+ PosDiff := PosDiff + Positions[PIndex].BGH;
+ Y := Positions[PIndex].PUStartY + PosDiff * sqr(Progress);
+
+ FontSize := Positions[PIndex].PUFontSize;
+ Alpha := 1 - 0.3 * Progress;
+ end
+
+ else
+ begin
+ //Phase 3 - The Fading out + Score adding
+ Progress := (TimeDiff - Settings.Phase1Time - Settings.Phase2Time) / Settings.Phase3Time;
+
+ If (PopUp.Rating > 0) then
+ begin
+ //Add Scores if Player Enabled
+ If (Enabled AND Players[PopUp.Player].Enabled) then
+ begin
+ ScoreToAdd := Round(PopUp.ScoreDiff * Progress) - PopUp.ScoreGiven;
+ Inc(PopUp.ScoreGiven, ScoreToAdd);
+ aPlayers[PopUp.Player].ScoreDisplayed := Players[PopUp.Player].ScoreDisplayed + ScoreToAdd;
+
+ //Change Bars Position
+ aPlayers[PopUp.Player].RBTarget := aPlayers[PopUp.Player].RBTarget + ScoreToAdd/PopUp.ScoreDiff * (PopUp.Rating / 20 - 0.26);
+ If (aPlayers[PopUp.Player].RBTarget > 1) then
+ aPlayers[PopUp.Player].RBTarget := 1
+ else If (aPlayers[PopUp.Player].RBTarget < 0) then
+ aPlayers[PopUp.Player].RBTarget := 0;
+ end;
+
+ //Set Positions etc.
+ Alpha := 0.7 - 0.7 * Progress;
+
+ W := Positions[PIndex].PUW;
+ H := Positions[PIndex].PUH;
+
+ PosDiff := Positions[PIndex].PUTargetX - Positions[PIndex].PUStartX;
+ If (PosDiff > 0) then
+ PosDiff := W
+ else
+ PosDiff := 0;
+ X := Positions[PIndex].PUTargetX + PosDiff * Progress;
+
+ PosDiff := Positions[PIndex].PUTargetY - Positions[PIndex].PUStartY;
+ If (PosDiff < 0) then
+ PosDiff := -Positions[PIndex].BGH
+ else
+ PosDiff := 0;
+ Y := Positions[PIndex].PUTargetY - PosDiff * (1-Progress);
+
+ FontSize := Positions[PIndex].PUFontSize;
+ end
+ else
+ begin
+ //Here the Effect that Should be shown if a PopUp without Score is Drawn
+ //And or Spawn with the GraphicObjects etc.
+ //Some Work for Blindy to do :P
+
+ //ATM: Just Let it Slide in the Scores just like the Normal PopUp
+ Alpha := 0;
+ end;
+ end;
+
+ //Draw PopUp
+
+ if (Alpha > 0) AND (Players[PopUp.Player].Visible) then
+ begin
+ //Draw BG:
+ glEnable(GL_TEXTURE_2D);
+ glEnable(GL_BLEND);
+ glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
+
+ glColor4f(1,1,1, Alpha);
+ glBindTexture(GL_TEXTURE_2D, Settings.PopUpTex[PopUp.Rating].TexNum);
+
+ glBegin(GL_QUADS);
+ glTexCoord2f(0, 0); glVertex2f(X, Y);
+ glTexCoord2f(0, Settings.PopUpTex[PopUp.Rating].TexH); glVertex2f(X, Y + H);
+ glTexCoord2f(Settings.PopUpTex[PopUp.Rating].TexW, Settings.PopUpTex[PopUp.Rating].TexH); glVertex2f(X + W, Y + H);
+ glTexCoord2f(Settings.PopUpTex[PopUp.Rating].TexW, 0); glVertex2f(X + W, Y);
+ glEnd;
+
+ glDisable(GL_TEXTURE_2D);
+ glDisable(GL_BLEND);
+
+ //Set FontStyle and Size
+ SetFontStyle(Positions[PIndex].PUFont);
+ SetFontItalic(False);
+ SetFontSize(FontSize);
+
+ //Draw Text
+ TextLen := glTextWidth(PChar(Theme.Sing.LineBonusText[PopUp.Rating]));
+
+ //Color and Pos
+ SetFontPos (X + (W - TextLen) / 2, Y + 12);
+ glColor4f(1, 1, 1, Alpha);
+
+ //Draw
+ glPrint(PChar(Theme.Sing.LineBonusText[PopUp.Rating]));
+ end; //eo Alpha check
+ end; //eo Right Screen
+ end; //eo Player has Position
+ end
+ else
+ Log.LogError('TSingScores: Try to Draw a not existing PopUp');
+end;
+
+//-----------
+//Procedure Draws a Score by Playerindex
+//-----------
+Procedure TSingScores.DrawScore(const Index: Integer);
+var
+ Position: PScorePosition;
+ ScoreStr: String;
+begin
+ //Only Draw if Player has a Position
+ If Players[Index].Position <> high(byte) then
+ begin
+ //Only Draw if Player is on Cur Screen
+ If (((Players[Index].Position AND 128) = 0) = (ScreenAct = 1)) AND Players[Index].Visible then
+ begin
+ Position := @Positions[Players[Index].Position and 127];
+
+ //Draw ScoreBG
+ glEnable(GL_TEXTURE_2D);
+ glEnable(GL_BLEND);
+ glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
+
+ glColor4f(1,1,1, 1);
+ glBindTexture(GL_TEXTURE_2D, Players[Index].ScoreBG.TexNum);
+
+ glBegin(GL_QUADS);
+ glTexCoord2f(0, 0); glVertex2f(Position.BGX, Position.BGY);
+ glTexCoord2f(0, Players[Index].ScoreBG.TexH); glVertex2f(Position.BGX, Position.BGY + Position.BGH);
+ glTexCoord2f(Players[Index].ScoreBG.TexW, Players[Index].ScoreBG.TexH); glVertex2f(Position.BGX + Position.BGW, Position.BGY + Position.BGH);
+ glTexCoord2f(Players[Index].ScoreBG.TexW, 0); glVertex2f(Position.BGX + Position.BGW, Position.BGY);
+ glEnd;
+
+ glDisable(GL_TEXTURE_2D);
+ glDisable(GL_BLEND);
+
+ //Draw Score Text
+ SetFontStyle(Position.TextFont);
+ SetFontItalic(False);
+ SetFontSize(Position.TextSize);
+ SetFontPos(Position.TextX, Position.TextY);
+
+ ScoreStr := InttoStr(Players[Index].ScoreDisplayed div 10) + '0';
+ While (Length(ScoreStr) < 5) do
+ ScoreStr := '0' + ScoreStr;
+
+ glPrint(PChar(ScoreStr));
+
+ end; //eo Right Screen
+ end; //eo Player has Position
+end;
+
+
+Procedure TSingScores.DrawRatingBar(const Index: Integer);
+var
+ Position: PScorePosition;
+ R,G,B, Size: Real;
+ Diff: Real;
+begin
+ //Only Draw if Player has a Position
+ if Players[Index].Position <> high(byte) then
+ begin
+ //Only Draw if Player is on Cur Screen
+ if (((Players[Index].Position and 128) = 0) = (ScreenAct = 1) and
+ Players[index].RBVisible and
+ Players[index].Visible) then
+ begin
+ Position := @Positions[Players[Index].Position and 127];
+
+ if (Enabled AND Players[Index].Enabled) then
+ begin
+ //Move Position if Enabled
+ Diff := Players[Index].RBTarget - Players[Index].RBPos;
+ If(Abs(Diff) < 0.02) then
+ aPlayers[Index].RBPos := aPlayers[Index].RBTarget
+ else
+ aPlayers[Index].RBPos := aPlayers[Index].RBPos + Diff*0.1;
+ end;
+
+ //Get Colors for RatingBar
+ if (Players[index].RBPos <= 0.22) then
+ begin
+ R := 1;
+ G := 0;
+ B := 0;
+ end
+ else if (Players[index].RBPos <= 0.42) then
+ begin
+ R := 1;
+ G := Players[index].RBPos*5;
+ B := 0;
+ end
+ else if (Players[index].RBPos <= 0.57) then
+ begin
+ R := 1;
+ G := 1;
+ B := 0;
+ end
+ else if (Players[index].RBPos <= 0.77) then
+ begin
+ R := 1-(Players[index].RBPos-0.57)*5;
+ G := 1;
+ B := 0;
+ end
+ else
+ begin
+ R := 0;
+ G := 1;
+ B := 0;
+ end;
+
+ //Enable all glFuncs Needed
+ glEnable(GL_TEXTURE_2D);
+ glEnable(GL_BLEND);
+ glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
+
+ //Draw RatingBar BG
+ glColor4f(1, 1, 1, 0.8);
+ glBindTexture(GL_TEXTURE_2D, Settings.RatingBar_BG_Tex.TexNum);
+
+ glBegin(GL_QUADS);
+ glTexCoord2f(0, 0);
+ glVertex2f(Position.RBX, Position.RBY);
+
+ glTexCoord2f(0, Settings.RatingBar_BG_Tex.TexH);
+ glVertex2f(Position.RBX, Position.RBY+Position.RBH);
+
+ glTexCoord2f(Settings.RatingBar_BG_Tex.TexW, Settings.RatingBar_BG_Tex.TexH);
+ glVertex2f(Position.RBX+Position.RBW, Position.RBY+Position.RBH);
+
+ glTexCoord2f(Settings.RatingBar_BG_Tex.TexW, 0);
+ glVertex2f(Position.RBX+Position.RBW, Position.RBY);
+ glEnd;
+
+ //Draw Rating bar itself
+ Size := Position.RBX + Position.RBW * Players[Index].RBPos;
+ glColor4f(R, G, B, 1);
+ glBindTexture(GL_TEXTURE_2D, Settings.RatingBar_Bar_Tex.TexNum);
+ glBegin(GL_QUADS);
+ glTexCoord2f(0, 0);
+ glVertex2f(Position.RBX, Position.RBY);
+
+ glTexCoord2f(0, Settings.RatingBar_Bar_Tex.TexH);
+ glVertex2f(Position.RBX, Position.RBY + Position.RBH);
+
+ glTexCoord2f(Settings.RatingBar_Bar_Tex.TexW, Settings.RatingBar_Bar_Tex.TexH);
+ glVertex2f(Size, Position.RBY + Position.RBH);
+
+ glTexCoord2f(Settings.RatingBar_Bar_Tex.TexW, 0);
+ glVertex2f(Size, Position.RBY);
+ glEnd;
+
+ //Draw Ratingbar FG (Teh thing with the 3 lines to get better readability)
+ glColor4f(1, 1, 1, 0.6);
+ glBindTexture(GL_TEXTURE_2D, Settings.RatingBar_FG_Tex.TexNum);
+ glBegin(GL_QUADS);
+ glTexCoord2f(0, 0);
+ glVertex2f(Position.RBX, Position.RBY);
+
+ glTexCoord2f(0, Settings.RatingBar_FG_Tex.TexH);
+ glVertex2f(Position.RBX, Position.RBY + Position.RBH);
+
+ glTexCoord2f(Settings.RatingBar_FG_Tex.TexW, Settings.RatingBar_FG_Tex.TexH);
+ glVertex2f(Position.RBX + Position.RBW, Position.RBY + Position.RBH);
+
+ glTexCoord2f(Settings.RatingBar_FG_Tex.TexW, 0);
+ glVertex2f(Position.RBX + Position.RBW, Position.RBY);
+ glEnd;
+
+ //Disable all Enabled glFuncs
+ glDisable(GL_TEXTURE_2D);
+ glDisable(GL_BLEND);
+ end; //eo Right Screen
+ end; //eo Player has Position
+end;
+
+end.
diff --git a/src/base/USkins.pas b/src/base/USkins.pas
new file mode 100644
index 00000000..88549c9f
--- /dev/null
+++ b/src/base/USkins.pas
@@ -0,0 +1,185 @@
+unit USkins;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+type
+ TSkinTexture = record
+ Name: string;
+ FileName: string;
+ end;
+
+ TSkinEntry = record
+ Theme: string;
+ Name: string;
+ Path: string;
+ FileName: string;
+ Creator: string; // not used yet
+ end;
+
+ TSkin = class
+ Skin: array of TSkinEntry;
+ SkinTexture: array of TSkinTexture;
+ SkinPath: string;
+ Color: integer;
+ constructor Create;
+ procedure LoadList;
+ procedure ParseDir(Dir: string);
+ procedure LoadHeader(FileName: string);
+ procedure LoadSkin(Name: string);
+ function GetTextureFileName(TextureName: string): string;
+ function GetSkinNumber(Name: string): integer;
+ procedure onThemeChange;
+ end;
+
+var
+ Skin: TSkin;
+
+implementation
+
+uses IniFiles,
+ Classes,
+ SysUtils,
+ UMain,
+ ULog,
+ UIni;
+
+constructor TSkin.Create;
+begin
+ inherited;
+ LoadList;
+// LoadSkin('Lisek');
+// SkinColor := Color;
+end;
+
+procedure TSkin.LoadList;
+var
+ SR: TSearchRec;
+begin
+ if FindFirst(SkinsPath+'*', faDirectory, SR) = 0 then begin
+ repeat
+ if (SR.Name <> '.') and (SR.Name <> '..') then
+ ParseDir(SkinsPath + SR.Name + PathDelim);
+ until FindNext(SR) <> 0;
+ end; // if
+ FindClose(SR);
+end;
+
+procedure TSkin.ParseDir(Dir: string);
+var
+ SR: TSearchRec;
+begin
+ if FindFirst(Dir + '*.ini', faAnyFile, SR) = 0 then begin
+ repeat
+
+ if (SR.Name <> '.') and (SR.Name <> '..') then
+ LoadHeader(Dir + SR.Name);
+
+ until FindNext(SR) <> 0;
+ end;
+end;
+
+procedure TSkin.LoadHeader(FileName: string);
+var
+ SkinIni: TMemIniFile;
+ S: integer;
+begin
+ SkinIni := TMemIniFile.Create(FileName);
+
+ S := Length(Skin);
+ SetLength(Skin, S+1);
+
+ Skin[S].Path := IncludeTrailingPathDelimiter(ExtractFileDir(FileName));
+ Skin[S].FileName := ExtractFileName(FileName);
+ Skin[S].Theme := SkinIni.ReadString('Skin', 'Theme', '');
+ Skin[S].Name := SkinIni.ReadString('Skin', 'Name', '');
+ Skin[S].Creator := SkinIni.ReadString('Skin', 'Creator', '');
+
+ SkinIni.Free;
+end;
+
+procedure TSkin.LoadSkin(Name: string);
+var
+ SkinIni: TMemIniFile;
+ SL: TStringList;
+ T: integer;
+ S: integer;
+begin
+ S := GetSkinNumber(Name);
+ SkinPath := Skin[S].Path;
+
+ SkinIni := TMemIniFile.Create(SkinPath + Skin[S].FileName);
+
+ SL := TStringList.Create;
+ SkinIni.ReadSection('Textures', SL);
+
+ SetLength(SkinTexture, SL.Count);
+ for T := 0 to SL.Count-1 do
+ begin
+ SkinTexture[T].Name := SL.Strings[T];
+ SkinTexture[T].FileName := SkinIni.ReadString('Textures', SL.Strings[T], '');
+ end;
+
+ SL.Free;
+ SkinIni.Free;
+end;
+
+function TSkin.GetTextureFileName(TextureName: string): string;
+var
+ T: integer;
+begin
+ Result := '';
+
+ for T := 0 to High(SkinTexture) do
+ begin
+ if ( SkinTexture[T].Name = TextureName ) AND
+ ( SkinTexture[T].FileName <> '' ) then
+ begin
+ Result := SkinPath + SkinTexture[T].FileName;
+ end;
+ end;
+
+ if ( TextureName <> '' ) AND
+ ( Result <> '' ) THEN
+ begin
+ //Log.LogError('', '-----------------------------------------');
+ //Log.LogError(TextureName+' - '+ Result, 'TSkin.GetTextureFileName');
+ end;
+
+{ Result := SkinPath + 'Bar.jpg';
+ if TextureName = 'Ball' then Result := SkinPath + 'Ball.bmp';
+ if Copy(TextureName, 1, 4) = 'Gray' then Result := SkinPath + 'Ball.bmp';
+ if Copy(TextureName, 1, 6) = 'NoteBG' then Result := SkinPath + 'Ball.bmp';}
+end;
+
+function TSkin.GetSkinNumber(Name: string): integer;
+var
+ S: integer;
+begin
+ Result := 0; // set default to the first available skin
+ for S := 0 to High(Skin) do
+ if Skin[S].Name = Name then Result := S;
+end;
+
+procedure TSkin.onThemeChange;
+var
+ S: integer;
+ Name: String;
+begin
+ Ini.SkinNo:=0;
+ SetLength(ISkin, 0);
+ Name := Uppercase(ITheme[Ini.Theme]);
+ for S := 0 to High(Skin) do
+ if Name = Uppercase(Skin[S].Theme) then begin
+ SetLength(ISkin, Length(ISkin)+1);
+ ISkin[High(ISkin)] := Skin[S].Name;
+ end;
+
+end;
+
+end.
diff --git a/src/base/USong.pas b/src/base/USong.pas
new file mode 100644
index 00000000..3517bce6
--- /dev/null
+++ b/src/base/USong.pas
@@ -0,0 +1,1027 @@
+unit USong;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+uses
+ {$IFDEF MSWINDOWS}
+ Windows,
+ {$ELSE}
+ {$IFNDEF DARWIN}
+ syscall,
+ {$ENDIF}
+ baseunix,
+ UnixType,
+ {$ENDIF}
+ SysUtils,
+ Classes,
+ UPlatform,
+ ULog,
+ UTexture,
+ UCommon,
+ {$IFDEF DARWIN}
+ cthreads,
+ {$ENDIF}
+ {$IFDEF USE_PSEUDO_THREAD}
+ PseudoThread,
+ {$ENDIF}
+ UCatCovers,
+ UXMLSong;
+
+type
+
+ TSingMode = ( smNormal, smPartyMode, smPlaylistRandom );
+
+ TBPM = record
+ BPM: real;
+ StartBeat: real;
+ end;
+
+ TScore = record
+ Name: WideString;
+ Score: integer;
+ Length: string;
+ end;
+
+ TSong = class
+ FileLineNo : integer; //Line which is readed at Last, for error reporting
+
+ procedure ParseNote(LineNumber: integer; TypeP: char; StartP, DurationP, NoteP: integer; LyricS: string);
+ procedure NewSentence(LineNumberP: integer; Param1, Param2: integer);
+
+ function ReadTXTHeader( const aFileName : WideString ): boolean;
+ function ReadXMLHeader( const aFileName : WideString ): boolean;
+ public
+ Path: WideString;
+ Folder: WideString; // for sorting by folder
+ fFileName,
+ FileName: WideString;
+
+ // sorting methods
+ Category: array of WideString; // TODO: do we need this?
+ Genre: WideString;
+ Edition: WideString;
+ Language: WideString;
+
+ Title: WideString;
+ Artist: WideString;
+
+ Text: WideString;
+ Creator: WideString;
+
+ Cover: WideString;
+ CoverTex: TTexture;
+ Mp3: WideString;
+ Background: WideString;
+ Video: WideString;
+ VideoGAP: real;
+ VideoLoaded: boolean; // true if the video has been loaded
+ NotesGAP: integer;
+ Start: real; // in seconds
+ Finish: integer; // in miliseconds
+ Relative: boolean;
+ Resolution: integer;
+ BPM: array of TBPM;
+ GAP: real; // in miliseconds
+
+ Score: array[0..2] of array of TScore;
+
+ // these are used when sorting is enabled
+ Visible: boolean; // false if hidden, true if visible
+ Main: boolean; // false for songs, true for category buttons
+ OrderNum: integer; // has a number of category for category buttons and songs
+ OrderTyp: integer; // type of sorting for this button (0=name)
+ CatNumber: integer; // Count of Songs in Category for Cats and Number of Song in Category for Songs
+
+ SongFile: TextFile; // all procedures in this unit operate on this file
+
+ Base : array[0..1] of integer;
+ Rel : array[0..1] of integer;
+ Mult : integer;
+ MultBPM : integer;
+
+ constructor Create (); overload;
+ constructor Create ( const aFileName : WideString ); overload;
+ function LoadSong: boolean;
+ function LoadXMLSong: boolean;
+ function Analyse(): boolean;
+ function AnalyseXML(): boolean;
+ procedure Clear();
+ end;
+
+implementation
+
+uses
+ TextGL,
+ UIni,
+ UMusic, //needed for Lines
+ UMain; //needed for Player
+
+constructor TSong.Create();
+begin
+ inherited;
+end;
+
+constructor TSong.Create( const aFileName : WideString );
+begin
+ inherited Create();
+
+ Mult := 1;
+ MultBPM := 4;
+ fFileName := aFileName;
+
+ if fileexists( aFileName ) then
+ begin
+ self.Path := ExtractFilePath( aFileName );
+ self.Folder := ExtractFilePath( aFileName );
+ self.FileName := ExtractFileName( aFileName );
+ (*
+ if ReadTXTHeader( aFileName ) then
+ begin
+ LoadSong();
+ end
+ else
+ begin
+ Log.LogError('Error Loading SongHeader, abort Song Loading');
+ Exit;
+ end;
+ *)
+ end;
+end;
+
+//Load TXT Song
+function TSong.LoadSong(): boolean;
+
+var
+ TempC: char;
+ Text: string;
+ CP: integer; // Current Player (0 or 1)
+ Count: integer;
+ Both: boolean;
+ Param1: integer;
+ Param2: integer;
+ Param3: integer;
+ ParamS: string;
+ I: integer;
+begin
+ Result := false;
+
+ if not FileExists(Path + PathDelim + FileName) then
+ begin
+ Log.LogError('File not found: "' + Path + PathDelim + FileName + '"', 'TSong.LoadSong()');
+ exit;
+ end;
+
+ MultBPM := 4; // multiply beat-count of note by 4
+ Mult := 1; // accuracy of measurement of note
+ Base[0] := 100; // high number
+ Lines[0].ScoreValue := 0;
+ self.Relative := false;
+ Rel[0] := 0;
+ CP := 0;
+ Both := false;
+
+ if Length(Player) = 2 then
+ Both := true;
+
+ try
+ // Open song file for reading.....
+ FileMode := fmOpenRead;
+ AssignFile(SongFile, fFileName);
+ Reset(SongFile);
+
+ //Clear old Song Header
+ if (self.Path = '') then
+ self.Path := ExtractFilePath(FileName);
+
+ if (self.FileName = '') then
+ self.Filename := ExtractFileName(FileName);
+
+ Result := False;
+
+ Reset(SongFile);
+ FileLineNo := 0;
+ //Search for Note Begining
+ repeat
+ ReadLn(SongFile, Text);
+ Inc(FileLineNo);
+
+ if (EoF(SongFile)) then
+ begin //Song File Corrupted - No Notes
+ CloseFile(SongFile);
+ Log.LogError('Could not load txt File, no Notes found: ' + FileName);
+ Result := False;
+ Exit;
+ end;
+ Read(SongFile, TempC);
+ until ((TempC = ':') or (TempC = 'F') or (TempC = '*'));
+
+ SetLength(Lines, 2);
+ for Count := 0 to High(Lines) do
+ begin
+ SetLength(Lines[Count].Line, 1);
+ Lines[Count].High := 0;
+ Lines[Count].Number := 1;
+ Lines[Count].Current := 0;
+ Lines[Count].Resolution := self.Resolution;
+ Lines[Count].NotesGAP := self.NotesGAP;
+ Lines[Count].Line[0].HighNote := -1;
+ Lines[Count].Line[0].LastLine := False;
+ end;
+
+ // TempC := ':';
+ // TempC := Text[1]; // read from backup variable, don't use default ':' value
+
+ while (TempC <> 'E') AND (not EOF(SongFile)) do
+ begin
+
+ if (TempC = ':') or (TempC = '*') or (TempC = 'F') then
+ begin
+ // read notes
+ Read(SongFile, Param1);
+ Read(SongFile, Param2);
+ Read(SongFile, Param3);
+ Read(SongFile, ParamS);
+
+
+ //Check for ZeroNote
+ if Param2 = 0 then Log.LogError('Found ZeroNote at "'+TempC+' '+IntToStr(Param1)+' '+IntToStr(Param2)+' '+IntToStr(Param3)+ParamS+'" -> Note ignored!') else
+ begin
+ // add notes
+ if not Both then
+ // P1
+ ParseNote(0, TempC, (Param1+Rel[0]) * Mult, Param2 * Mult, Param3, ParamS)
+ else begin
+ // P1 + P2
+ ParseNote(0, TempC, (Param1+Rel[0]) * Mult, Param2 * Mult, Param3, ParamS);
+ ParseNote(1, TempC, (Param1+Rel[1]) * Mult, Param2 * Mult, Param3, ParamS);
+ end;
+ end; //Zeronote check
+ end; // if
+
+ if TempC = '-' then
+ begin
+ // reads sentence
+ Read(SongFile, Param1);
+ if self.Relative then Read(SongFile, Param2); // read one more data for relative system
+
+ // new sentence
+ if not Both then
+ // P1
+ NewSentence(0, (Param1 + Rel[0]) * Mult, Param2)
+ else begin
+ // P1 + P2
+ NewSentence(0, (Param1 + Rel[0]) * Mult, Param2);
+ NewSentence(1, (Param1 + Rel[1]) * Mult, Param2);
+ end;
+ end; // if
+
+ if TempC = 'B' then
+ begin
+ SetLength(self.BPM, Length(self.BPM) + 1);
+ Read(SongFile, self.BPM[High(self.BPM)].StartBeat);
+ self.BPM[High(self.BPM)].StartBeat := self.BPM[High(self.BPM)].StartBeat + Rel[0];
+
+ Read(SongFile, Text);
+ self.BPM[High(self.BPM)].BPM := StrToFloat(Text);
+ self.BPM[High(self.BPM)].BPM := self.BPM[High(self.BPM)].BPM * Mult * MultBPM;
+ end;
+
+
+ if not Both then
+ begin
+ Lines[CP].Line[Lines[CP].High].BaseNote := Base[CP];
+ Lines[CP].Line[Lines[CP].High].LyricWidth := glTextWidth(PChar(Lines[CP].Line[Lines[CP].High].Lyric));
+ //Total Notes Patch
+ Lines[CP].Line[Lines[CP].High].TotalNotes := 0;
+ for I := low(Lines[CP].Line[Lines[CP].High].Note) to high(Lines[CP].Line[Lines[CP].High].Note) do
+ begin
+ if (Lines[CP].Line[Lines[CP].High].Note[I].NoteType = ntGolden) then
+ Lines[CP].Line[Lines[CP].High].TotalNotes := Lines[CP].Line[Lines[CP].High].TotalNotes + Lines[CP].Line[Lines[CP].High].Note[I].Length;
+
+ if (Lines[CP].Line[Lines[CP].High].Note[I].NoteType <> ntFreestyle) then
+ Lines[CP].Line[Lines[CP].High].TotalNotes := Lines[CP].Line[Lines[CP].High].TotalNotes + Lines[CP].Line[Lines[CP].High].Note[I].Length;
+ end;
+ //Total Notes Patch End
+ end else begin
+ for Count := 0 to High(Lines) do
+ begin
+ Lines[Count].Line[Lines[Count].High].BaseNote := Base[Count];
+ Lines[Count].Line[Lines[Count].High].LyricWidth := glTextWidth(PChar(Lines[Count].Line[Lines[Count].High].Lyric));
+ //Total Notes Patch
+ Lines[Count].Line[Lines[Count].High].TotalNotes := 0;
+ for I := low(Lines[Count].Line[Lines[Count].High].Note) to high(Lines[Count].Line[Lines[Count].High].Note) do
+ begin
+ if (Lines[Count].Line[Lines[Count].High].Note[I].NoteType = ntGolden) then
+ Lines[Count].Line[Lines[Count].High].TotalNotes := Lines[Count].Line[Lines[Count].High].TotalNotes + Lines[Count].Line[Lines[Count].High].Note[I].Length;
+ if (Lines[Count].Line[Lines[Count].High].Note[I].NoteType <> ntFreestyle) then
+ Lines[Count].Line[Lines[Count].High].TotalNotes := Lines[Count].Line[Lines[Count].High].TotalNotes + Lines[Count].Line[Lines[Count].High].Note[I].Length;
+ end;
+ //Total Notes Patch End
+ end;
+ end;
+ Read(SongFile, TempC);
+ Inc(FileLineNo);
+ end; // while}
+
+ for Count := 0 to High(Lines) do
+ begin
+ Lines[Count].Line[High(Lines[Count].Line)].LastLine := True;
+ end;
+
+ CloseFile(SongFile);
+ except
+ try
+ CloseFile(SongFile);
+ except
+
+ end;
+
+ Log.LogError('Error Loading File: "' + fFileName + '" in Line ' + inttostr(FileLineNo));
+ exit;
+ end;
+
+ Result := true;
+end;
+
+//Load XML Song
+function TSong.LoadXMLSong(): boolean;
+var
+ //TempC: char;
+ Text: string;
+ CP: integer; // Current Player (0 or 1)
+ Count: integer;
+ Both: boolean;
+ Param1: integer;
+ Param2: integer;
+ Param3: integer;
+ ParamS: string;
+ I,J,X: integer;
+
+ NoteType: Char;
+ SentenceEnd, Rest, Time: Integer;
+ Parser: TParser;
+begin
+ Result := false;
+
+ if not FileExists(Path + PathDelim + FileName) then
+ begin
+ Log.LogError('File not found: "' + Path + PathDelim + FileName + '"', 'TSong.LoadSong()');
+ exit;
+ end;
+
+ MultBPM := 4; // multiply beat-count of note by 4
+ Mult := 1; // accuracy of measurement of note
+ Base[0] := 100; // high number
+ Lines[0].ScoreValue := 0;
+ self.Relative := false;
+ Rel[0] := 0;
+ CP := 0;
+ Both := false;
+
+ if Length(Player) = 2 then
+ Both := true;
+
+ Parser := TParser.Create;
+ Parser.Settings.DashReplacement := '~';
+
+ for Count := 0 to High(Lines) do
+ begin
+ SetLength(Lines[Count].Line, 1);
+ Lines[Count].High := 0;
+ Lines[Count].Number := 1;
+ Lines[Count].Current := 0;
+ Lines[Count].Resolution := self.Resolution;
+ Lines[Count].NotesGAP := self.NotesGAP;
+ Lines[Count].Line[0].HighNote := -1;
+ Lines[Count].Line[0].LastLine := False;
+ end;
+
+//Try to Parse the Song
+
+ if Parser.ParseSong(Path + PathDelim + FileName) then
+ begin
+// Writeln('XML Inputfile Parsed succesful');
+ //Start write parsed information to Song
+ //Notes Part
+ for I := 0 to High(Parser.SongInfo.Sentences) do
+ begin
+ //Add Notes
+ for J := 0 to High(Parser.SongInfo.Sentences[I].Notes) do
+ begin
+ case Parser.SongInfo.Sentences[I].Notes[J].NoteTyp of
+ NT_Normal: NoteType := ':';
+ NT_Golden: NoteType := '*';
+ NT_Freestyle: NoteType := 'F';
+ end;
+
+ Param1:=Parser.SongInfo.Sentences[I].Notes[J].Start; //Note Start
+ Param2:=Parser.SongInfo.Sentences[I].Notes[J].Duration; //Note Duration
+ Param3:=Parser.SongInfo.Sentences[I].Notes[J].Tone; //Note Tone
+ ParamS:=' ' + Parser.SongInfo.Sentences[I].Notes[J].Lyric; //Note Lyric
+
+ if not Both then
+ // P1
+ ParseNote(0, NoteType, (Param1+Rel[0]) * Mult, Param2 * Mult, Param3, ParamS)
+ else
+ begin
+ // P1 + P2
+ ParseNote(0, NoteType, (Param1+Rel[0]) * Mult, Param2 * Mult, Param3, ParamS);
+ ParseNote(1, NoteType, (Param1+Rel[1]) * Mult, Param2 * Mult, Param3, ParamS);
+ end;
+
+ if not Both then
+ begin
+ Lines[CP].Line[Lines[CP].High].BaseNote := Base[CP];
+ Lines[CP].Line[Lines[CP].High].LyricWidth := glTextWidth(PChar(Lines[CP].Line[Lines[CP].High].Lyric));
+ //Total Notes Patch
+ Lines[CP].Line[Lines[CP].High].TotalNotes := 0;
+ for X := low(Lines[CP].Line[Lines[CP].High].Note) to high(Lines[CP].Line[Lines[CP].High].Note) do
+ begin
+ if (Lines[CP].Line[Lines[CP].High].Note[I].NoteType = ntGolden) then
+ Lines[CP].Line[Lines[CP].High].TotalNotes := Lines[CP].Line[Lines[CP].High].TotalNotes + Lines[CP].Line[Lines[CP].High].Note[X].Length;
+
+ if (Lines[CP].Line[Lines[CP].High].Note[I].NoteType <> ntFreestyle) then
+ Lines[CP].Line[Lines[CP].High].TotalNotes := Lines[CP].Line[Lines[CP].High].TotalNotes + Lines[CP].Line[Lines[CP].High].Note[X].Length;
+ end;
+ //Total Notes Patch End
+ end
+ else
+ begin
+ for Count := 0 to High(Lines) do
+ begin
+ Lines[Count].Line[Lines[Count].High].BaseNote := Base[Count];
+ Lines[Count].Line[Lines[Count].High].LyricWidth := glTextWidth(PChar(Lines[Count].Line[Lines[Count].High].Lyric));
+ //Total Notes Patch
+ Lines[Count].Line[Lines[Count].High].TotalNotes := 0;
+ for X := low(Lines[Count].Line[Lines[Count].High].Note) to high(Lines[Count].Line[Lines[Count].High].Note) do
+ begin
+ if (Lines[Count].Line[Lines[Count].High].Note[I].NoteType = ntGolden) then
+ Lines[Count].Line[Lines[Count].High].TotalNotes := Lines[Count].Line[Lines[Count].High].TotalNotes + Lines[Count].Line[Lines[Count].High].Note[X].Length;
+ if (Lines[Count].Line[Lines[Count].High].Note[I].NoteType <> ntFreestyle) then
+ Lines[Count].Line[Lines[Count].High].TotalNotes := Lines[Count].Line[Lines[Count].High].TotalNotes + Lines[Count].Line[Lines[Count].High].Note[X].Length;
+
+ end;
+ //Total Notes Patch End
+ end;
+ end; { end of for loop }
+
+ end; //J Forloop
+
+ //Add Sentence break
+ if (I < High(Parser.SongInfo.Sentences)) then
+ begin
+
+ SentenceEnd := Parser.SongInfo.Sentences[I].Notes[High(Parser.SongInfo.Sentences[I].Notes)].Start + Parser.SongInfo.Sentences[I].Notes[High(Parser.SongInfo.Sentences[I].Notes)].Duration;
+ Rest := Parser.SongInfo.Sentences[I+1].Notes[0].Start - SentenceEnd;
+
+ //Calculate Time
+ case Rest of
+ 0, 1: Time := Parser.SongInfo.Sentences[I+1].Notes[0].Start;
+ 2: Time := Parser.SongInfo.Sentences[I+1].Notes[0].Start - 1;
+ 3: Time := Parser.SongInfo.Sentences[I+1].Notes[0].Start - 2;
+ else
+ if (Rest >= 4) then
+ Time := SentenceEnd + 2
+ else //Sentence overlapping :/
+ Time := Parser.SongInfo.Sentences[I+1].Notes[0].Start;
+ end;
+ // new sentence
+ if not Both then
+ // P1
+ NewSentence(0, (Time + Rel[0]) * Mult, Param2)
+ else
+ begin
+ // P1 + P2
+ NewSentence(0, (Time + Rel[0]) * Mult, Param2);
+ NewSentence(1, (Time + Rel[1]) * Mult, Param2);
+ end;
+
+ end;
+ end;
+ //End write parsed information to Song
+ Parser.Free;
+ end
+ else
+ begin
+ Log.LogError('Could not parse Inputfile: ' + Path + PathDelim + FileName);
+ exit;
+ end;
+
+ for Count := 0 to High(Lines) do
+ begin
+ Lines[Count].Line[High(Lines[Count].Line)].LastLine := True;
+ end;
+
+ Result := true;
+end;
+
+function TSong.ReadXMLHeader(const aFileName : WideString): boolean;
+var
+ Line, Identifier, Value: string;
+ Temp : word;
+ Done : byte;
+ Parser : TParser;
+begin
+ Result := true;
+ Done := 0;
+
+//Parse XML
+ Parser := TParser.Create;
+ Parser.Settings.DashReplacement := '~';
+
+
+ if Parser.ParseSong(self.Path + self.FileName) then
+ begin
+ //-----------
+ //Required Attributes
+ //-----------
+
+ //Title
+ self.Title := Parser.SongInfo.Header.Title;
+
+ //Add Title Flag to Done
+ Done := Done or 1;
+
+ //Artist
+ self.Artist := Parser.SongInfo.Header.Artist;
+
+ //Add Artist Flag to Done
+ Done := Done or 2;
+
+ //MP3 File //Test if Exists
+ self.Mp3 := platform.FindSongFile(Path, '*.mp3');
+ if (FileExists(self.Path + self.Mp3)) then
+ //Add Mp3 Flag to Done
+ Done := Done or 4;
+
+ //Beats per Minute
+ SetLength(self.BPM, 1);
+ self.BPM[0].StartBeat := 0;
+
+ self.BPM[0].BPM := (Parser.SongInfo.Header.BPM * Parser.SongInfo.Header.Resolution/4 ) * Mult * MultBPM;
+
+ if self.BPM[0].BPM <> 0 then
+ //Add BPM Flag to Done
+ Done := Done or 8;
+
+ //---------
+ //Additional Header Information
+ //---------
+
+ // Gap
+ self.GAP := Parser.SongInfo.Header.Gap;
+
+ //Cover Picture
+ self.Cover := platform.FindSongFile(Path, '*[CO].jpg');
+
+ //Background Picture
+ self.Background := platform.FindSongFile(Path, '*[BG].jpg');
+
+ // Video File
+ // self.Video := Value
+
+ // Video Gap
+ // self.VideoGAP := song_StrtoFloat( Value )
+
+ //Genre Sorting
+ self.Genre := Parser.SongInfo.Header.Genre;
+
+ //Edition Sorting
+ self.Edition := Parser.SongInfo.Header.Edition;
+
+ //Year Sorting
+ //Parser.SongInfo.Header.Year
+
+ //Language Sorting
+ self.Language := Parser.SongInfo.Header.Language;
+ end else
+ Log.LogError('File Incomplete or not SingStar XML (A): ' + aFileName);
+
+ Parser.Free;
+
+ //Check if all Required Values are given
+ if (Done <> 15) then
+ begin
+ Result := False;
+ if (Done and 8) = 0 then //No BPM Flag
+ Log.LogError('BPM Tag Missing: ' + self.FileName)
+ else if (Done and 4) = 0 then //No MP3 Flag
+ Log.LogError('MP3 Tag/File Missing: ' + self.FileName)
+ else if (Done and 2) = 0 then //No Artist Flag
+ Log.LogError('Artist Tag Missing: ' + self.FileName)
+ else if (Done and 1) = 0 then //No Title Flag
+ Log.LogError('Title Tag Missing: ' + self.FileName)
+ else //unknown Error
+ Log.LogError('File Incomplete or not SingStar XML (B - '+ inttostr(Done) +'): ' + aFileName);
+ end;
+
+end;
+
+
+function TSong.ReadTXTHeader(const aFileName : WideString): boolean;
+
+ function song_StrtoFloat( aValue : string ) : Extended;
+ var
+ lValue : string;
+// lOldDecimalSeparator : Char; // Auto Removed, Unused Variable
+ begin
+ lValue := aValue;
+
+ if (Pos(',', lValue) <> 0) then
+ lValue[Pos(',', lValue)] := '.';
+
+ Result := StrToFloatDef(lValue, 0);
+ end;
+
+var
+ Line, Identifier, Value: string;
+ Temp : word;
+ Done : byte;
+begin
+ Result := true;
+ Done := 0;
+
+ //Read first Line
+ ReadLn (SongFile, Line);
+
+ if (Length(Line)<=0) then
+ begin
+ Log.LogError('File Starts with Empty Line: ' + aFileName);
+ Result := False;
+ Exit;
+ end;
+
+ //Read Lines while Line starts with # or its empty
+ while ( Length(Line) = 0 ) or
+ ( Line[1] = '#' ) do
+ begin
+ //Increase Line Number
+ Inc (FileLineNo);
+ Temp := Pos(':', Line);
+
+ //Line has a Seperator-> Headerline
+ if (Temp <> 0) then
+ begin
+ //Read Identifier and Value
+ Identifier := Uppercase(Trim(Copy(Line, 2, Temp - 2))); //Uppercase is for Case Insensitive Checks
+ Value := Trim(Copy(Line, Temp + 1,Length(Line) - Temp));
+
+ //Check the Identifier (If Value is given)
+ if (Length(Value) <> 0) then
+ begin
+
+ //-----------
+ //Required Attributes
+ //-----------
+
+ {$IFDEF UTF8_FILENAMES}
+ if ((Identifier = 'MP3') or (Identifier = 'BACKGROUND') or (Identifier = 'COVER') or (Identifier = 'VIDEO')) then
+ Value := Utf8Encode(Value);
+ {$ENDIF}
+
+ //Title
+ if (Identifier = 'TITLE') then
+ begin
+ self.Title := Value;
+
+ //Add Title Flag to Done
+ Done := Done or 1;
+ end
+
+ //Artist
+ else if (Identifier = 'ARTIST') then
+ begin
+ self.Artist := Value;
+
+ //Add Artist Flag to Done
+ Done := Done or 2;
+ end
+
+ //MP3 File //Test if Exists
+ else if (Identifier = 'MP3') AND
+ (FileExists(self.Path + Value)) then
+ begin
+ self.Mp3 := Value;
+
+ //Add Mp3 Flag to Done
+ Done := Done or 4;
+ end
+
+ //Beats per Minute
+ else if (Identifier = 'BPM') then
+ begin
+ SetLength(self.BPM, 1);
+ self.BPM[0].StartBeat := 0;
+
+ self.BPM[0].BPM := song_StrtoFloat( Value ) * Mult * MultBPM;
+
+ if self.BPM[0].BPM <> 0 then
+ begin
+ //Add BPM Flag to Done
+ Done := Done or 8;
+ end;
+ end
+
+ //---------
+ //Additional Header Information
+ //---------
+
+ // Gap
+ else if (Identifier = 'GAP') then
+ self.GAP := song_StrtoFloat( Value )
+
+ //Cover Picture
+ else if (Identifier = 'COVER') then
+ self.Cover := Value
+
+ //Background Picture
+ else if (Identifier = 'BACKGROUND') then
+ self.Background := Value
+
+ // Video File
+ else if (Identifier = 'VIDEO') then
+ begin
+ if (FileExists(self.Path + Value)) then
+ self.Video := Value
+ else
+ Log.LogError('Can''t find Video File in Song: ' + aFileName);
+ end
+
+ // Video Gap
+ else if (Identifier = 'VIDEOGAP') then
+ self.VideoGAP := song_StrtoFloat( Value )
+
+ //Genre Sorting
+ else if (Identifier = 'GENRE') then
+ self.Genre := Value
+
+ //Edition Sorting
+ else if (Identifier = 'EDITION') then
+ self.Edition := Value
+
+ //Creator Tag
+ else if (Identifier = 'CREATOR') then
+ self.Creator := Value
+
+ //Language Sorting
+ else if (Identifier = 'LANGUAGE') then
+ self.Language := Value
+
+ // Song Start
+ else if (Identifier = 'START') then
+ self.Start := song_StrtoFloat( Value )
+
+ // Song Ending
+ else if (Identifier = 'END') then
+ TryStrtoInt(Value, self.Finish)
+
+ // Resolution
+ else if (Identifier = 'RESOLUTION') then
+ TryStrtoInt(Value, self.Resolution)
+
+ // Notes Gap
+ else if (Identifier = 'NOTESGAP') then
+ TryStrtoInt(Value, self.NotesGAP)
+ // Relative Notes
+ else if (Identifier = 'RELATIVE') AND (uppercase(Value) = 'YES') then
+ self.Relative := True;
+
+ end;
+ end;
+
+ if not EOf(SongFile) then
+ ReadLn (SongFile, Line)
+ else
+ begin
+ Result := False;
+ Log.LogError('File Incomplete or not Ultrastar TxT (A): ' + aFileName);
+ break;
+ end;
+
+ end;
+
+ if self.Cover = '' then
+ self.Cover := platform.FindSongFile(Path, '*[CO].jpg');
+
+ //Check if all Required Values are given
+ if (Done <> 15) then
+ begin
+ Result := False;
+ if (Done and 8) = 0 then //No BPM Flag
+ Log.LogError('BPM Tag Missing: ' + self.FileName)
+ else if (Done and 4) = 0 then //No MP3 Flag
+ Log.LogError('MP3 Tag/File Missing: ' + self.FileName)
+ else if (Done and 2) = 0 then //No Artist Flag
+ Log.LogError('Artist Tag Missing: ' + self.FileName)
+ else if (Done and 1) = 0 then //No Title Flag
+ Log.LogError('Title Tag Missing: ' + self.FileName)
+ else //unknown Error
+ Log.LogError('File Incomplete or not Ultrastar TxT (B - '+ inttostr(Done) +'): ' + aFileName);
+ end;
+
+end;
+
+procedure TSong.ParseNote(LineNumber: integer; TypeP: char; StartP, DurationP, NoteP: integer; LyricS: string);
+//var
+// Space: boolean; // Auto Removed, Unused Variable
+begin
+ case Ini.Solmization of
+ 1: // european
+ begin
+ case (NoteP mod 12) of
+ 0..1: LyricS := ' do ';
+ 2..3: LyricS := ' re ';
+ 4: LyricS := ' mi ';
+ 5..6: LyricS := ' fa ';
+ 7..8: LyricS := ' sol ';
+ 9..10: LyricS := ' la ';
+ 11: LyricS := ' si ';
+ end;
+ end;
+ 2: // japanese
+ begin
+ case (NoteP mod 12) of
+ 0..1: LyricS := ' do ';
+ 2..3: LyricS := ' re ';
+ 4: LyricS := ' mi ';
+ 5..6: LyricS := ' fa ';
+ 7..8: LyricS := ' so ';
+ 9..10: LyricS := ' la ';
+ 11: LyricS := ' shi ';
+ end;
+ end;
+ 3: // american
+ begin
+ case (NoteP mod 12) of
+ 0..1: LyricS := ' do ';
+ 2..3: LyricS := ' re ';
+ 4: LyricS := ' mi ';
+ 5..6: LyricS := ' fa ';
+ 7..8: LyricS := ' sol ';
+ 9..10: LyricS := ' la ';
+ 11: LyricS := ' ti ';
+ end;
+ end;
+ end; // case
+
+ with Lines[LineNumber].Line[Lines[LineNumber].High] do
+ begin
+ SetLength(Note, Length(Note) + 1);
+ HighNote := High(Note);
+
+ Note[HighNote].Start := StartP;
+ if HighNote = 0 then
+ begin
+ if Lines[LineNumber].Number = 1 then
+ Start := -100;
+// Start := Note[HighNote].Start;
+ end;
+
+ Note[HighNote].Length := DurationP;
+
+ // back to the normal system with normal, golden and now freestyle notes
+ case TypeP of
+ 'F': Note[HighNote].NoteType := ntFreestyle;
+ ':': Note[HighNote].NoteType := ntNormal;
+ '*': Note[HighNote].NoteType := ntGolden;
+ end;
+
+ if (Note[HighNote].NoteType = ntGolden) then
+ Lines[LineNumber].ScoreValue := Lines[LineNumber].ScoreValue + Note[HighNote].Length;
+
+ if (Note[HighNote].NoteType <> ntFreestyle) then
+ Lines[LineNumber].ScoreValue := Lines[LineNumber].ScoreValue + Note[HighNote].Length;
+
+ Note[HighNote].Tone := NoteP;
+ if Note[HighNote].Tone < Base[LineNumber] then Base[LineNumber] := Note[HighNote].Tone;
+
+ Note[HighNote].Text := Copy(LyricS, 2, 100);
+ Lyric := Lyric + Note[HighNote].Text;
+
+ End_ := Note[HighNote].Start + Note[HighNote].Length;
+ end; // with
+end;
+
+procedure TSong.NewSentence(LineNumberP: integer; Param1, Param2: integer);
+var
+ I: integer;
+begin
+
+ // stara czesc //Alter Satz //Update Old Part
+ Lines[LineNumberP].Line[Lines[LineNumberP].High].BaseNote := Base[LineNumberP];
+ Lines[LineNumberP].Line[Lines[LineNumberP].High].LyricWidth := glTextWidth(PChar(Lines[LineNumberP].Line[Lines[LineNumberP].High].Lyric));
+
+ //Total Notes Patch
+ Lines[LineNumberP].Line[Lines[LineNumberP].High].TotalNotes := 0;
+ for I := low(Lines[LineNumberP].Line[Lines[LineNumberP].High].Note) to high(Lines[LineNumberP].Line[Lines[LineNumberP].High].Note) do
+ begin
+ if (Lines[LineNumberP].Line[Lines[LineNumberP].High].Note[I].NoteType = ntGolden) then
+ Lines[LineNumberP].Line[Lines[LineNumberP].High].TotalNotes := Lines[LineNumberP].Line[Lines[LineNumberP].High].TotalNotes + Lines[LineNumberP].Line[Lines[LineNumberP].High].Note[I].Length;
+
+ if (Lines[LineNumberP].Line[Lines[LineNumberP].High].Note[I].NoteType <> ntFreestyle) then
+ Lines[LineNumberP].Line[Lines[LineNumberP].High].TotalNotes := Lines[LineNumberP].Line[Lines[LineNumberP].High].TotalNotes + Lines[LineNumberP].Line[Lines[LineNumberP].High].Note[I].Length;
+ end;
+ //Total Notes Patch End
+
+
+ // nowa czesc //Neuer Satz //Update New Part
+ SetLength(Lines[LineNumberP].Line, Lines[LineNumberP].Number + 1);
+ Lines[LineNumberP].High := Lines[LineNumberP].High + 1;
+ Lines[LineNumberP].Number := Lines[LineNumberP].Number + 1;
+ Lines[LineNumberP].Line[Lines[LineNumberP].High].HighNote := -1;
+
+ if self.Relative then
+ begin
+ Lines[LineNumberP].Line[Lines[LineNumberP].High].Start := Param1;
+ Rel[LineNumberP] := Rel[LineNumberP] + Param2;
+ end
+ else
+ Lines[LineNumberP].Line[Lines[LineNumberP].High].Start := Param1;
+
+ Lines[LineNumberP].Line[Lines[LineNumberP].High].LastLine := False;
+
+ Base[LineNumberP] := 100; // high number
+end;
+
+procedure TSong.clear();
+begin
+ //Main Information
+ Title := '';
+ Artist := '';
+
+ //Sortings:
+ Genre := 'Unknown';
+ Edition := 'Unknown';
+ Language := 'Unknown'; //Language Patch
+
+ //Required Information
+ Mp3 := '';
+ {$IFDEF FPC}
+ setlength( BPM, 0 );
+ {$ELSE}
+ BPM := nil;
+ {$ENDIF}
+
+ GAP := 0;
+ Start := 0;
+ Finish := 0;
+
+ //Additional Information
+ Background := '';
+ Cover := '';
+ Video := '';
+ VideoGAP := 0;
+ NotesGAP := 0;
+ Resolution := 4;
+ Creator := '';
+
+end;
+
+function TSong.Analyse(): boolean;
+begin
+ Result := False;
+
+ //Reset LineNo
+ FileLineNo := 0;
+
+ //Open File and set File Pointer to the beginning
+ AssignFile(SongFile, self.Path + self.FileName);
+
+ try
+ Reset(SongFile);
+
+ //Clear old Song Header
+ self.clear;
+
+ //Read Header
+ Result := self.ReadTxTHeader( FileName )
+
+ //And Close File
+ finally
+ CloseFile(SongFile);
+ end;
+end;
+
+
+function TSong.AnalyseXML(): boolean;
+begin
+ Result := False;
+
+ //Reset LineNo
+ FileLineNo := 0;
+
+ //Clear old Song Header
+ self.clear;
+
+ //Read Header
+ Result := self.ReadXMLHeader( FileName );
+
+end;
+
+end.
diff --git a/src/base/USongs.pas b/src/base/USongs.pas
new file mode 100644
index 00000000..710cd44f
--- /dev/null
+++ b/src/base/USongs.pas
@@ -0,0 +1,806 @@
+unit USongs;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+{$IFDEF DARWIN}
+ {$IFDEF DEBUG}
+ {$DEFINE USE_PSEUDO_THREAD}
+ {$ENDIF}
+{$ENDIF}
+
+uses
+ {$IFDEF MSWINDOWS}
+ Windows,
+ DirWatch,
+ {$ELSE}
+ {$IFNDEF DARWIN}
+ syscall,
+ {$ENDIF}
+ baseunix,
+ UnixType,
+ {$ENDIF}
+ SysUtils,
+ Classes,
+ UPlatform,
+ ULog,
+ UTexture,
+ UCommon,
+ {$IFDEF DARWIN}
+ cthreads,
+ {$ENDIF}
+ {$IFDEF USE_PSEUDO_THREAD}
+ PseudoThread,
+ {$ENDIF}
+ USong,
+ UCatCovers;
+
+type
+
+ TBPM = record
+ BPM: real;
+ StartBeat: real;
+ end;
+
+ TScore = record
+ Name: widestring;
+ Score: integer;
+ Length: string;
+ end;
+
+ {$IFDEF USE_PSEUDO_THREAD}
+ TSongs = class( TPseudoThread )
+ {$ELSE}
+ TSongs = class( TThread )
+ {$ENDIF}
+ private
+ fNotify, fWatch : longint;
+ fParseSongDirectory : boolean;
+ fProcessing : boolean;
+ {$ifdef MSWINDOWS}
+ fDirWatch : TDirectoryWatch;
+ {$endif}
+ procedure int_LoadSongList;
+ procedure DoDirChanged(Sender: TObject);
+ protected
+ procedure Execute; override;
+ public
+ SongList : TList; // array of songs
+ Selected : integer; // selected song index
+ constructor Create();
+ destructor Destroy(); override;
+
+
+ procedure LoadSongList; // load all songs
+ procedure BrowseDir(Dir: widestring); // should return number of songs in the future
+ procedure BrowseTXTFiles(Dir: widestring);
+ procedure BrowseXMLFiles(Dir: widestring);
+ procedure Sort(Order: integer);
+ function FindSongFile(Dir, Mask: widestring): widestring;
+ property Processing : boolean read fProcessing;
+ end;
+
+
+ TCatSongs = class
+ Song: array of TSong; // array of categories with songs
+ Selected: integer; // selected song index
+ Order: integer; // order type (0=title)
+ CatNumShow: integer; // Category Number being seen
+ CatCount: integer; //Number of Categorys
+
+ procedure SortSongs();
+ procedure Refresh; // refreshes arrays by recreating them from Songs array
+ procedure ShowCategory(Index: integer); // expands all songs in category
+ procedure HideCategory(Index: integer); // hides all songs in category
+ procedure ClickCategoryButton(Index: integer); // uses ShowCategory and HideCategory when needed
+ procedure ShowCategoryList; //Hides all Songs And Show the List of all Categorys
+ function FindNextVisible(SearchFrom:integer): integer; //Find Next visible Song
+ function VisibleSongs: integer; // returns number of visible songs (for tabs)
+ function VisibleIndex(Index: integer): integer; // returns visible song index (skips invisible)
+
+ function SetFilter(FilterStr: string; const fType: Byte): Cardinal;
+ end;
+
+var
+ Songs: TSongs; // all songs
+ CatSongs: TCatSongs; // categorized songs
+
+const
+ IN_ACCESS = $00000001; //* File was accessed */
+ IN_MODIFY = $00000002; //* File was modified */
+ IN_ATTRIB = $00000004; //* Metadata changed */
+ IN_CLOSE_WRITE = $00000008; //* Writtable file was closed */
+ IN_CLOSE_NOWRITE = $00000010; //* Unwrittable file closed */
+ IN_OPEN = $00000020; //* File was opened */
+ IN_MOVED_FROM = $00000040; //* File was moved from X */
+ IN_MOVED_TO = $00000080; //* File was moved to Y */
+ IN_CREATE = $00000100; //* Subfile was created */
+ IN_DELETE = $00000200; //* Subfile was deleted */
+ IN_DELETE_SELF = $00000400; //* Self was deleted */
+
+
+implementation
+
+uses StrUtils,
+ UGraphic,
+ UCovers,
+ UFiles,
+ UMain,
+ UIni;
+
+constructor TSongs.Create();
+begin
+ // do not start thread BEFORE initialization (suspended = true)
+ inherited Create(true);
+ Self.FreeOnTerminate := true;
+
+ SongList := TList.Create();
+
+ // FIXME: threaded loading does not work this way.
+ // It will just cause crashes but nothing else at the moment.
+ (*
+ {$ifdef MSWINDOWS}
+ fDirWatch := TDirectoryWatch.create(nil);
+ fDirWatch.OnChange := DoDirChanged;
+ fDirWatch.Directory := SongPath;
+ fDirWatch.WatchSubDirs := true;
+ fDirWatch.active := true;
+ {$ENDIF}
+
+ // now we can start the thread
+ Resume();
+ *)
+
+ // until it is fixed, simply load the song-list
+ int_LoadSongList();
+end;
+
+destructor TSongs.Destroy();
+begin
+ FreeAndNil( SongList );
+ inherited;
+end;
+
+procedure TSongs.DoDirChanged(Sender: TObject);
+begin
+ LoadSongList();
+end;
+
+procedure TSongs.Execute();
+var
+ fChangeNotify : THandle;
+begin
+{$IFDEF USE_PSEUDO_THREAD}
+ int_LoadSongList();
+{$ELSE}
+ fParseSongDirectory := true;
+
+ while not terminated do
+ begin
+
+ if fParseSongDirectory then
+ begin
+ Log.LogStatus('Calling int_LoadSongList', 'TSongs.Execute');
+ int_LoadSongList();
+ end;
+
+ Suspend();
+ end;
+{$ENDIF}
+end;
+
+procedure TSongs.int_LoadSongList;
+var
+ I: integer;
+begin
+ try
+ fProcessing := true;
+
+ Log.LogStatus('Searching For Songs', 'SongList');
+
+ // browse directories
+ for I := 0 to SongPaths.Count-1 do
+ BrowseDir(SongPaths[I]);
+
+ if assigned( CatSongs ) then
+ CatSongs.Refresh;
+
+ if assigned( CatCovers ) then
+ CatCovers.Load;
+
+ //if assigned( Covers ) then
+ // Covers.Load;
+
+ if assigned(ScreenSong) then
+ begin
+ ScreenSong.GenerateThumbnails();
+ ScreenSong.OnShow; // refresh ScreenSong
+ end;
+
+ finally
+ Log.LogStatus('Search Complete', 'SongList');
+
+ fParseSongDirectory := false;
+ fProcessing := false;
+ end;
+end;
+
+
+procedure TSongs.LoadSongList;
+begin
+ fParseSongDirectory := true;
+ Resume();
+end;
+
+procedure TSongs.BrowseDir(Dir: widestring);
+begin
+ BrowseTXTFiles(Dir);
+ BrowseXMLFiles(Dir);
+end;
+
+procedure TSongs.BrowseTXTFiles(Dir: widestring);
+var
+ i : integer;
+ Files : TDirectoryEntryArray;
+ lSong : TSong;
+begin
+
+ Files := Platform.DirectoryFindFiles( Dir, '.txt', true);
+
+ for i := 0 to Length(Files)-1 do
+ begin
+ if Files[i].IsDirectory then
+ begin
+ BrowseTXTFiles( Dir + Files[i].Name + PathDelim ); //Recursive Call
+ end
+ else
+ begin
+ lSong := TSong.create( Dir + Files[i].Name );
+
+ if lSong.Analyse then
+ SongList.add( lSong )
+ else
+ begin
+ Log.LogError('AnalyseFile failed for "' + Files[i].Name + '".');
+ freeandnil( lSong );
+ end;
+
+ end;
+ end;
+ SetLength( Files, 0);
+
+end;
+
+procedure TSongs.BrowseXMLFiles(Dir: widestring);
+var
+ i : integer;
+ Files : TDirectoryEntryArray;
+ lSong : TSong;
+begin
+
+ Files := Platform.DirectoryFindFiles( Dir, '.xml', true);
+
+ for i := 0 to Length(Files)-1 do
+ begin
+ if Files[i].IsDirectory then
+ begin
+ BrowseXMLFiles( Dir + Files[i].Name + PathDelim ); //Recursive Call
+ end
+ else
+ begin
+ lSong := TSong.create( Dir + Files[i].Name );
+
+ if lSong.AnalyseXML then
+ SongList.add( lSong )
+ else
+ begin
+ Log.LogError('AnalyseFile failed for "' + Files[i].Name + '".');
+ freeandnil( lSong );
+ end;
+
+ end;
+ end;
+ SetLength( Files, 0);
+
+end;
+
+(*
+ * Comparison functions for sorting
+ *)
+
+function CompareByEdition(Song1, Song2: Pointer): integer;
+begin
+ Result := CompareText(TSong(Song1).Edition, TSong(Song2).Edition);
+end;
+
+function CompareByGenre(Song1, Song2: Pointer): integer;
+begin
+ Result := CompareText(TSong(Song1).Genre, TSong(Song2).Genre);
+end;
+
+function CompareByTitle(Song1, Song2: Pointer): integer;
+begin
+ Result := CompareText(TSong(Song1).Title, TSong(Song2).Title);
+end;
+
+function CompareByArtist(Song1, Song2: Pointer): integer;
+begin
+ Result := CompareText(TSong(Song1).Artist, TSong(Song2).Artist);
+end;
+
+function CompareByFolder(Song1, Song2: Pointer): integer;
+begin
+ Result := CompareText(TSong(Song1).Folder, TSong(Song2).Folder);
+end;
+
+function CompareByLanguage(Song1, Song2: Pointer): integer;
+begin
+ Result := CompareText(TSong(Song1).Language, TSong(Song2).Language);
+end;
+
+procedure TSongs.Sort(Order: integer);
+var
+ CompareFunc: TListSortCompare;
+begin
+ // FIXME: what is the difference between artist and artist2, etc.?
+ case Order of
+ sEdition: // by edition
+ CompareFunc := CompareByEdition;
+ sGenre: // by genre
+ CompareFunc := CompareByGenre;
+ sTitle: // by title
+ CompareFunc := CompareByTitle;
+ sArtist: // by artist
+ CompareFunc := CompareByArtist;
+ sFolder: // by folder
+ CompareFunc := CompareByFolder;
+ sTitle2: // by title2
+ CompareFunc := CompareByTitle;
+ sArtist2: // by artist2
+ CompareFunc := CompareByArtist;
+ sLanguage: // by Language
+ CompareFunc := CompareByLanguage;
+ else
+ Log.LogCritical('Unsupported comparison', 'TSongs.Sort');
+ Exit; // suppress warning
+ end; // case
+
+ // Note: Do not use TList.Sort() as it uses QuickSort which is instable.
+ // For example, if a list is sorted by title first and
+ // by artist afterwards, the songs of an artist will not be sorted by title anymore.
+ // The stable MergeSort guarantees to maintain this order.
+ MergeSort(SongList, CompareFunc);
+end;
+
+function TSongs.FindSongFile(Dir, Mask: widestring): widestring;
+var
+ SR: TSearchRec; // for parsing song directory
+begin
+ Result := '';
+ if FindFirst(Dir + Mask, faDirectory, SR) = 0 then
+ begin
+ Result := SR.Name;
+ end; // if
+ FindClose(SR);
+end;
+
+procedure TCatSongs.SortSongs();
+begin
+ case Ini.Sorting of
+ sEdition: begin
+ Songs.Sort(sTitle);
+ Songs.Sort(sArtist);
+ Songs.Sort(sEdition);
+ end;
+ sGenre: begin
+ Songs.Sort(sTitle);
+ Songs.Sort(sArtist);
+ Songs.Sort(sGenre);
+ end;
+ sLanguage: begin
+ Songs.Sort(sTitle);
+ Songs.Sort(sArtist);
+ Songs.Sort(sLanguage);
+ end;
+ sFolder: begin
+ Songs.Sort(sTitle);
+ Songs.Sort(sArtist);
+ Songs.Sort(sFolder);
+ end;
+ sTitle: begin
+ Songs.Sort(sTitle);
+ end;
+ sArtist: begin
+ Songs.Sort(sTitle);
+ Songs.Sort(sArtist);
+ end;
+ sTitle2: begin
+ Songs.Sort(sArtist2);
+ Songs.Sort(sTitle2);
+ end;
+ sArtist2: begin
+ Songs.Sort(sTitle2);
+ Songs.Sort(sArtist2);
+ end;
+ end; // case
+end;
+
+procedure TCatSongs.Refresh;
+var
+ SongIndex: integer;
+ CurSong: TSong;
+ CatIndex: integer; // index of current song in Song
+ Letter: char; // current letter for sorting using letter
+ CurCategory: string; // current edition for sorting using edition, genre etc.
+ Order: integer; // number used for ordernum
+ LetterTmp: char;
+ CatNumber: integer; // Number of Song in Category
+
+ procedure AddCategoryButton(const CategoryName: string);
+ var
+ PrevCatBtnIndex: integer;
+ begin
+ Inc(Order);
+ CatIndex := Length(Song);
+ SetLength(Song, CatIndex+1);
+ Song[CatIndex] := TSong.Create();
+ Song[CatIndex].Artist := '[' + CategoryName + ']';
+ Song[CatIndex].Main := true;
+ Song[CatIndex].OrderTyp := 0;
+ Song[CatIndex].OrderNum := Order;
+ Song[CatIndex].Cover := CatCovers.GetCover(Ini.Sorting, CategoryName);
+ Song[CatIndex].Visible := true;
+
+ // set number of songs in previous category
+ PrevCatBtnIndex := CatIndex - CatNumber - 1;
+ if ((PrevCatBtnIndex >= 0) and Song[PrevCatBtnIndex].Main) then
+ Song[PrevCatBtnIndex].CatNumber := CatNumber;
+
+ CatNumber := 0;
+ end;
+
+begin
+ CatNumShow := -1;
+
+ SortSongs();
+
+ CurCategory := '';
+ Order := 0;
+ CatNumber := 0;
+
+ // Note: do NOT set Letter to ' ', otherwise no category-button will be
+ // created for songs beginning with ' ' if songs of this category exist.
+ // TODO: trim song-properties so ' ' will not occur as first chararcter.
+ Letter := #0;
+
+ // clear song-list
+ for SongIndex := 0 to Songs.SongList.Count-1 do
+ begin
+ // free category buttons
+ // Note: do NOT delete songs, they are just references to Songs.SongList entries
+ CurSong := TSong(Songs.SongList[SongIndex]);
+ if (CurSong.Main) then
+ CurSong.Free;
+ end;
+ SetLength(Song, 0);
+
+ for SongIndex := 0 to Songs.SongList.Count-1 do
+ begin
+ CurSong := TSong(Songs.SongList[SongIndex]);
+ // if tabs are on, add section buttons for each new section
+ if (Ini.Tabs = 1) then
+ begin
+ if (Ini.Sorting = sEdition) and
+ (CompareText(CurCategory, CurSong.Edition) <> 0) then
+ begin
+ CurCategory := CurSong.Edition;
+
+ // TODO: remove this block if it is not needed anymore
+ {
+ if CurSection = 'Singstar Part 2' then CoverName := 'Singstar';
+ if CurSection = 'Singstar German' then CoverName := 'Singstar';
+ if CurSection = 'Singstar Spanish' then CoverName := 'Singstar';
+ if CurSection = 'Singstar Italian' then CoverName := 'Singstar';
+ if CurSection = 'Singstar French' then CoverName := 'Singstar';
+ if CurSection = 'Singstar 80s Polish' then CoverName := 'Singstar 80s';
+ }
+
+ // add Category Button
+ AddCategoryButton(CurCategory);
+ end
+
+ else if (Ini.Sorting = sGenre) and
+ (CompareText(CurCategory, CurSong.Genre) <> 0) then
+ begin
+ CurCategory := CurSong.Genre;
+ // add Genre Button
+ AddCategoryButton(CurCategory);
+ end
+
+ else if (Ini.Sorting = sLanguage) and
+ (CompareText(CurCategory, CurSong.Language) <> 0) then
+ begin
+ CurCategory := CurSong.Language;
+ // add Language Button
+ AddCategoryButton(CurCategory);
+ end
+
+ else if (Ini.Sorting = sTitle) and
+ (Length(CurSong.Title) >= 1) and
+ (Letter <> UpperCase(CurSong.Title)[1]) then
+ begin
+ Letter := Uppercase(CurSong.Title)[1];
+ // add a letter Category Button
+ AddCategoryButton(Letter);
+ end
+
+ else if (Ini.Sorting = sArtist) and
+ (Length(CurSong.Artist) >= 1) and
+ (Letter <> UpperCase(CurSong.Artist)[1]) then
+ begin
+ Letter := UpperCase(CurSong.Artist)[1];
+ // add a letter Category Button
+ AddCategoryButton(Letter);
+ end
+
+ else if (Ini.Sorting = sFolder) and
+ (CompareText(CurCategory, CurSong.Folder) <> 0) then
+ begin
+ CurCategory := CurSong.Folder;
+ // add folder tab
+ AddCategoryButton(CurCategory);
+ end
+
+ else if (Ini.Sorting = sTitle2) and
+ (Length(CurSong.Title) >= 1) then
+ begin
+ // pack all numbers into a category named '#'
+ if (CurSong.Title[1] >= '0') and (CurSong.Title[1] <= '9') then
+ LetterTmp := '#'
+ else
+ LetterTmp := UpperCase(CurSong.Title)[1];
+
+ if (Letter <> LetterTmp) then
+ begin
+ Letter := LetterTmp;
+ // add a letter Category Button
+ AddCategoryButton(Letter);
+ end;
+ end
+
+ else if (Ini.Sorting = sArtist2) and
+ (Length(CurSong.Artist)>=1) then
+ begin
+ // pack all numbers into a category named '#'
+ if (CurSong.Artist[1] >= '0') and (CurSong.Artist[1] <= '9') then
+ LetterTmp := '#'
+ else
+ LetterTmp := UpperCase(CurSong.Artist)[1];
+
+ if (Letter <> LetterTmp) then
+ begin
+ Letter := LetterTmp;
+ // add a letter Category Button
+ AddCategoryButton(Letter);
+ end;
+ end;
+ end;
+
+ CatIndex := Length(Song);
+ SetLength(Song, CatIndex+1);
+
+ Inc(CatNumber); // increase number of songs in category
+
+ // copy reference to current song
+ Song[CatIndex] := CurSong;
+
+ // set song's category info
+ CurSong.OrderNum := Order; // assigns category
+ CurSong.CatNumber := CatNumber;
+
+ if (Ini.Tabs = 0) then
+ CurSong.Visible := true
+ else if (Ini.Tabs = 1) then
+ CurSong.Visible := false;
+
+ {
+ if (Ini.Tabs = 1) and (Order = 1) then
+ begin
+ //open first tab
+ CurSong.Visible := true;
+ end;
+ CurSong.Visible := true;
+ }
+ end;
+
+ // set CatNumber of last category
+ if (Ini.Tabs_at_startup = 1) and (High(Song) >= 1) then
+ begin
+ // set number of songs in previous category
+ SongIndex := CatIndex - CatNumber;
+ if ((SongIndex >= 0) and Song[SongIndex].Main) then
+ Song[SongIndex].CatNumber := CatNumber;
+ end;
+
+ // update number of categories
+ CatCount := Order;
+end;
+
+procedure TCatSongs.ShowCategory(Index: integer);
+var
+ S: integer; // song
+begin
+ CatNumShow := Index;
+ for S := 0 to high(CatSongs.Song) do
+ begin
+{
+ if (CatSongs.Song[S].OrderNum = Index) and (not CatSongs.Song[S].Main) then
+ CatSongs.Song[S].Visible := true
+ else
+ CatSongs.Song[S].Visible := false;
+}
+// KMS: This should be the same, but who knows :-)
+ CatSongs.Song[S].Visible := ( (CatSongs.Song[S].OrderNum = Index) and (not CatSongs.Song[S].Main) );
+ end;
+end;
+
+procedure TCatSongs.HideCategory(Index: integer); // hides all songs in category
+var
+ S: integer; // song
+begin
+ for S := 0 to high(CatSongs.Song) do
+ begin
+ if not CatSongs.Song[S].Main then
+ CatSongs.Song[S].Visible := false // hides all at now
+ end;
+end;
+
+procedure TCatSongs.ClickCategoryButton(Index: integer);
+var
+ Num, S: integer;
+begin
+ Num := CatSongs.Song[Index].OrderNum;
+ if Num <> CatNumShow then
+ begin
+ ShowCategory(Num);
+ end
+ else
+ begin
+ ShowCategoryList;
+ end;
+end;
+
+//Hide Categorys when in Category Hack
+procedure TCatSongs.ShowCategoryList;
+var
+ Num, S: integer;
+begin
+ // Hide All Songs Show All Cats
+ for S := 0 to high(CatSongs.Song) do
+ CatSongs.Song[S].Visible := CatSongs.Song[S].Main;
+ CatSongs.Selected := CatNumShow; //Show last shown Category
+ CatNumShow := -1;
+end;
+//Hide Categorys when in Category Hack End
+
+//Wrong song selected when tabs on bug
+function TCatSongs.FindNextVisible(SearchFrom:integer): integer;//Find next Visible Song
+var
+ I: integer;
+begin
+ Result := -1;
+ I := SearchFrom + 1;
+ while not CatSongs.Song[I].Visible do
+ begin
+ Inc (I);
+ if (I>high(CatSongs.Song)) then
+ I := low(CatSongs.Song);
+ if (I = SearchFrom) then //Make One Round and no song found->quit
+ break;
+ end;
+end;
+//Wrong song selected when tabs on bug End
+
+(**
+ * Returns the number of visible songs.
+ *)
+function TCatSongs.VisibleSongs: integer;
+var
+ SongIndex: integer;
+begin
+ Result := 0;
+ for SongIndex := 0 to High(CatSongs.Song) do
+ begin
+ if (CatSongs.Song[SongIndex].Visible) then
+ Inc(Result);
+ end;
+end;
+
+(**
+ * Returns the index of a song in the subset of all visible songs.
+ * If all songs are visible, the result will be equal to the Index parameter.
+ *)
+function TCatSongs.VisibleIndex(Index: integer): integer;
+var
+ SongIndex: integer;
+begin
+ Result := 0;
+ for SongIndex := 0 to Index-1 do
+ begin
+ if (CatSongs.Song[SongIndex].Visible) then
+ Inc(Result);
+ end;
+end;
+
+function TCatSongs.SetFilter(FilterStr: string; const fType: Byte): Cardinal;
+var
+ I, J: integer;
+ cString: string;
+ SearchStr: array of string;
+begin
+ {fType: 0: All
+ 1: Title
+ 2: Artist}
+ FilterStr := Trim(FilterStr);
+ if FilterStr<>'' then
+ begin
+ Result := 0;
+ //Create Search Array
+ SetLength(SearchStr, 1);
+ I := Pos (' ', FilterStr);
+ while (I <> 0) do
+ begin
+ SetLength (SearchStr, Length(SearchStr) + 1);
+ cString := Copy(FilterStr, 1, I-1);
+ if (cString <> ' ') and (cString <> '') then
+ SearchStr[High(SearchStr)-1] := cString;
+ Delete (FilterStr, 1, I);
+
+ I := Pos (' ', FilterStr);
+ end;
+ //Copy last Word
+ if (FilterStr <> ' ') and (FilterStr <> '') then
+ SearchStr[High(SearchStr)] := FilterStr;
+
+ for I:=0 to High(Song) do
+ begin
+ if not Song[i].Main then
+ begin
+ case fType of
+ 0: cString := Song[I].Artist + ' ' + Song[i].Title + ' ' + Song[i].Folder;
+ 1: cString := Song[I].Title;
+ 2: cString := Song[I].Artist;
+ end;
+ Song[i].Visible:=True;
+ //Look for every Searched Word
+ for J := 0 to High(SearchStr) do
+ begin
+ Song[i].Visible := Song[i].Visible and AnsiContainsText(cString, SearchStr[J])
+ end;
+ if Song[i].Visible then
+ Inc(Result);
+ end
+ else
+ Song[i].Visible:=False;
+ end;
+ CatNumShow := -2;
+ end
+ else
+ begin
+ for i:=0 to High(Song) do
+ begin
+ Song[i].Visible := (Ini.Tabs=1) = Song[i].Main;
+ CatNumShow := -1;
+ end;
+ Result := 0;
+ end;
+end;
+
+// -----------------------------------------------------------------------------
+
+end.
diff --git a/src/base/UTextClasses.pas b/src/base/UTextClasses.pas
new file mode 100644
index 00000000..9a12e1f5
--- /dev/null
+++ b/src/base/UTextClasses.pas
@@ -0,0 +1,60 @@
+unit UTextClasses;
+
+interface
+
+{$I switches.inc}
+
+uses
+ gl,
+ SDL,
+ UTexture,
+ Classes,
+// SDL_ttf,
+ ULog;
+
+{
+// okay i just outline what should be here, so we can create a nice and clean implementation of sdl_ttf
+// based up on this uml: http://jnr.sourceforge.net/fusion_images/www_FRS.png
+// thanks to Bob Pendelton and Koshmaar!
+// (1) let's start with a glyph, this represents one character in a word
+
+type
+ TGlyph = record
+ character : Char; // unsigned char, uchar is something else in delphi
+ glyphsSolid[8] : GlyphTexture; // fast, but not that
+ glyphsBlended[8] : GlyphTexture; // slower than solid, but it look's more pretty
+
+//this class has a method, which should be a deconstructor (mog is on his way to understand the principles of oop :P)
+ deconstructor procedure ReleaseTextures();
+end;
+
+// (2) okay, we now need the stuff that's even beneath this glyph - we're right at the birth of text in here :P
+
+ GlyphTexture = record
+ textureID : GLuint; // we need this for caching the letters, if the texture wasn't created before create it, should be very fast because of this one
+ width,
+ height : Cardinal;
+ charWidth,
+ charHeight : Integer;
+ advance : Integer; // don't know yet for what this one is
+}
+
+{
+// after the glyph is done, we now start to build whole words - this one is pretty important, and does most of the work we need
+ TGlyphsContainer = record
+ glyphs array of TGlyph;
+ FontName array of string;
+ refCount : uChar; // unsigned char, uchar is something else in delphi
+ font : PTTF_font;
+ size,
+ lineSkip : Cardinal; // vertical distance between multi line text output
+ descent : Integer;
+
+
+
+}
+
+
+implementation
+
+end.
diff --git a/src/base/UTexture.pas b/src/base/UTexture.pas
new file mode 100644
index 00000000..4879760a
--- /dev/null
+++ b/src/base/UTexture.pas
@@ -0,0 +1,525 @@
+unit UTexture;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+uses
+ gl,
+ glu,
+ glext,
+ Classes,
+ SysUtils,
+ UCommon,
+ SDL,
+ SDL_Image;
+
+type
+ PTexture = ^TTexture;
+ TTexture = record
+ TexNum: GLuint;
+ X: real;
+ Y: real;
+ Z: real;
+ W: real;
+ H: real;
+ ScaleW: real; // for dynamic scalling while leaving width constant
+ ScaleH: real; // for dynamic scalling while leaving height constant
+ Rot: real; // 0 - 2*pi
+ Int: real; // intensity
+ ColR: real;
+ ColG: real;
+ ColB: real;
+ TexW: real; // percentage of width to use [0..1]
+ TexH: real; // percentage of height to use [0..1]
+ TexX1: real;
+ TexY1: real;
+ TexX2: real;
+ TexY2: real;
+ Alpha: real;
+ Name: string; // experimental for handling cache images. maybe it's useful for dynamic skins
+ end;
+
+type
+ TTextureType = (
+ TEXTURE_TYPE_PLAIN, // Plain (alpha = 1)
+ TEXTURE_TYPE_TRANSPARENT, // Alpha is used
+ TEXTURE_TYPE_COLORIZED // Alpha is used; Hue of the HSV color-model will be replaced by a new value
+ );
+
+const
+ TextureTypeStr: array[TTextureType] of string = (
+ 'Plain',
+ 'Transparent',
+ 'Colorized'
+ );
+
+function TextureTypeToStr(TexType: TTextureType): string;
+function ParseTextureType(const TypeStr: string; Default: TTextureType): TTextureType;
+
+procedure AdjustPixelFormat(var TexSurface: PSDL_Surface; Typ: TTextureType);
+
+type
+ PTextureEntry = ^TTextureEntry;
+ TTextureEntry = record
+ Name: string;
+ Typ: TTextureType;
+ Color: Cardinal;
+
+ // we use normal TTexture, it's easier to implement and if needed - we copy ready data
+ Texture: TTexture; // Full-size texture
+ TextureCache: TTexture; // Thumbnail texture
+ end;
+
+ TTextureDatabase = class
+ private
+ Texture: array of TTextureEntry;
+ public
+ procedure AddTexture(var Tex: TTexture; Typ: TTextureType; Color: Cardinal; Cache: boolean);
+ function FindTexture(const Name: string; Typ: TTextureType; Color: Cardinal): integer;
+ end;
+
+ TTextureUnit = class
+ private
+ TextureDatabase: TTextureDatabase;
+ public
+ Limit: integer;
+
+ procedure AddTexture(var Tex: TTexture; Typ: TTextureType; Cache: boolean = false); overload;
+ procedure AddTexture(var Tex: TTexture; Typ: TTextureType; Color: Cardinal; Cache: boolean = false); overload;
+ function GetTexture(const Name: string; Typ: TTextureType; FromCache: boolean = false): TTexture; overload;
+ function GetTexture(const Name: string; Typ: TTextureType; Col: LongWord; FromCache: boolean = false): TTexture; overload;
+ function LoadTexture(FromRegistry: boolean; const Identifier: string; Typ: TTextureType; Col: LongWord): TTexture; overload;
+ function LoadTexture(const Identifier: string; Typ: TTextureType; Col: LongWord): TTexture; overload;
+ function LoadTexture(const Identifier: string): TTexture; overload;
+ function CreateTexture(Data: PChar; const Name: string; Width, Height: word; BitsPerPixel: byte): TTexture;
+ procedure UnloadTexture(const Name: string; Typ: TTextureType; FromCache: boolean); overload;
+ procedure UnloadTexture(const Name: string; Typ: TTextureType; Col: Cardinal; FromCache: boolean); overload;
+ //procedure FlushTextureDatabase();
+
+ constructor Create;
+ destructor Destroy; override;
+ end;
+
+var
+ Texture: TTextureUnit;
+
+implementation
+
+uses
+ DateUtils,
+ StrUtils,
+ Math,
+ ULog,
+ UCovers,
+ UThemes,
+ UImage;
+
+procedure AdjustPixelFormat(var TexSurface: PSDL_Surface; Typ: TTextureType);
+var
+ TempSurface: PSDL_Surface;
+ NeededPixFmt: PSDL_Pixelformat;
+begin
+ if (Typ = TEXTURE_TYPE_PLAIN) then
+ NeededPixFmt := @PixelFmt_RGB
+ else if (Typ = TEXTURE_TYPE_TRANSPARENT) or
+ (Typ = TEXTURE_TYPE_COLORIZED) then
+ NeededPixFmt := @PixelFmt_RGBA
+ else
+ NeededPixFmt := @PixelFmt_RGB;
+
+ if not PixelformatEquals(TexSurface^.format, NeededPixFmt) then
+ begin
+ TempSurface := TexSurface;
+ TexSurface := SDL_ConvertSurface(TempSurface, NeededPixFmt, SDL_SWSURFACE);
+ SDL_FreeSurface(TempSurface);
+ end;
+end;
+
+{ TTextureDatabase }
+
+procedure TTextureDatabase.AddTexture(var Tex: TTexture; Typ: TTextureType; Color: Cardinal; Cache: boolean);
+var
+ TextureIndex: integer;
+begin
+ TextureIndex := FindTexture(Tex.Name, Typ, Color);
+ if (TextureIndex = -1) then
+ begin
+ TextureIndex := Length(Texture);
+ SetLength(Texture, TextureIndex+1);
+
+ Texture[TextureIndex].Name := Tex.Name;
+ Texture[TextureIndex].Typ := Typ;
+ Texture[TextureIndex].Color := Color;
+ end;
+
+ if (Cache) then
+ Texture[TextureIndex].TextureCache := Tex
+ else
+ Texture[TextureIndex].Texture := Tex;
+end;
+
+function TTextureDatabase.FindTexture(const Name: string; Typ: TTextureType; Color: Cardinal): integer;
+var
+ TextureIndex: integer;
+ CurrentTexture: PTextureEntry;
+begin
+ Result := -1;
+ for TextureIndex := 0 to High(Texture) do
+ begin
+ CurrentTexture := @Texture[TextureIndex];
+ if (CurrentTexture.Name = Name) and
+ (CurrentTexture.Typ = Typ) then
+ begin
+ // colorized textures must match in their color too
+ if (CurrentTexture.Typ <> TEXTURE_TYPE_COLORIZED) or
+ (CurrentTexture.Color = Color) then
+ begin
+ Result := TextureIndex;
+ Break;
+ end;
+ end;
+ end;
+end;
+
+
+{ TTextureUnit }
+
+constructor TTextureUnit.Create;
+begin
+ inherited Create;
+ TextureDatabase := TTextureDatabase.Create;
+end;
+
+destructor TTextureUnit.Destroy;
+begin
+ TextureDatabase.Free;
+ inherited Destroy;
+end;
+
+
+procedure TTextureUnit.AddTexture(var Tex: TTexture; Typ: TTextureType; Cache: boolean);
+begin
+ TextureDatabase.AddTexture(Tex, Typ, 0, Cache);
+end;
+
+procedure TTextureUnit.AddTexture(var Tex: TTexture; Typ: TTextureType; Color: Cardinal; Cache: boolean);
+begin
+ TextureDatabase.AddTexture(Tex, Typ, Color, Cache);
+end;
+
+function TTextureUnit.LoadTexture(FromRegistry: boolean; const Identifier: string; Typ: TTextureType; Col: LongWord): TTexture;
+begin
+ // FIXME: what is the FromRegistry parameter supposed to do?
+ Result := LoadTexture(Identifier, Typ, Col);
+end;
+
+function TTextureUnit.LoadTexture(const Identifier: string): TTexture;
+begin
+ Result := LoadTexture(Identifier, TEXTURE_TYPE_PLAIN, 0);
+end;
+
+function TTextureUnit.LoadTexture(const Identifier: string; Typ: TTextureType; Col: LongWord): TTexture;
+var
+ TexSurface: PSDL_Surface;
+ MipmapSurface: PSDL_Surface;
+ newWidth, newHeight: Cardinal;
+ oldWidth, oldHeight: Cardinal;
+ ActTex: GLuint;
+begin
+ // zero texture data
+ FillChar(Result, SizeOf(Result), 0);
+
+ // load texture data into memory
+ TexSurface := LoadImage(Identifier);
+ if not assigned(TexSurface) then
+ begin
+ Log.LogError('Could not load texture: "' + Identifier +' '+ TextureTypeToStr(Typ) +'"',
+ 'TTextureUnit.LoadTexture');
+ Exit;
+ end;
+
+ // convert pixel format as needed
+ AdjustPixelFormat(TexSurface, Typ);
+
+ // adjust texture size (scale down, if necessary)
+ newWidth := TexSurface.W;
+ newHeight := TexSurface.H;
+
+ if (newWidth > Limit) then
+ newWidth := Limit;
+
+ if (newHeight > Limit) then
+ newHeight := Limit;
+
+ if (TexSurface.W > newWidth) or (TexSurface.H > newHeight) then
+ ScaleImage(TexSurface, newWidth, newHeight);
+
+ // now we might colorize the whole thing
+ if (Typ = TEXTURE_TYPE_COLORIZED) then
+ ColorizeImage(TexSurface, Col);
+
+ // save actual dimensions of our texture
+ oldWidth := newWidth;
+ oldHeight := newHeight;
+
+ // make texture dimensions be powers of 2
+ newWidth := Round(Power(2, Ceil(Log2(newWidth))));
+ newHeight := Round(Power(2, Ceil(Log2(newHeight))));
+ if (newHeight <> oldHeight) or (newWidth <> oldWidth) then
+ FitImage(TexSurface, newWidth, newHeight);
+
+ // at this point we have the image in memory...
+ // scaled to be at most 1024x1024 pixels large
+ // scaled so that dimensions are powers of 2
+ // and converted to either RGB or RGBA
+
+ // if we got a Texture of Type Plain, Transparent or Colorized,
+ // then we're done manipulating it
+ // and could now create our openGL texture from it
+
+ // prepare OpenGL texture
+ glGenTextures(1, @ActTex);
+
+ glBindTexture(GL_TEXTURE_2D, ActTex);
+ glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
+ glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE);
+ glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE);
+
+ // load data into gl texture
+ if (Typ = TEXTURE_TYPE_TRANSPARENT) or
+ (Typ = TEXTURE_TYPE_COLORIZED) then
+ begin
+ glTexImage2D(GL_TEXTURE_2D, 0, 4, newWidth, newHeight, 0, GL_RGBA, GL_UNSIGNED_BYTE, TexSurface.pixels);
+ end
+ else //if Typ = TEXTURE_TYPE_PLAIN then
+ begin
+ glTexImage2D(GL_TEXTURE_2D, 0, 3, newWidth, newHeight, 0, GL_RGB, GL_UNSIGNED_BYTE, TexSurface.pixels);
+ end;
+
+ // setup texture struct
+ with Result do
+ begin
+ X := 0;
+ Y := 0;
+ Z := 0;
+ W := 0;
+ H := 0;
+ ScaleW := 1;
+ ScaleH := 1;
+ Rot := 0;
+ TexNum := ActTex;
+ TexW := oldWidth / newWidth;
+ TexH := oldHeight / newHeight;
+
+ Int := 1;
+ ColR := 1;
+ ColG := 1;
+ ColB := 1;
+ Alpha := 1;
+
+ // new test - default use whole texure, taking TexW and TexH as const and changing these
+ TexX1 := 0;
+ TexY1 := 0;
+ TexX2 := 1;
+ TexY2 := 1;
+
+ Name := Identifier;
+ end;
+
+ SDL_FreeSurface(TexSurface);
+end;
+
+function TTextureUnit.GetTexture(const Name: string; Typ: TTextureType; FromCache: boolean): TTexture;
+begin
+ Result := GetTexture(Name, Typ, 0, FromCache);
+end;
+
+function TTextureUnit.GetTexture(const Name: string; Typ: TTextureType; Col: LongWord; FromCache: boolean): TTexture;
+var
+ TextureIndex: integer;
+ CoverIndex: integer;
+begin
+ if (Name = '') then
+ begin
+ // zero texture data
+ FillChar(Result, SizeOf(Result), 0);
+ Exit;
+ end;
+
+ if (FromCache) then
+ begin
+ (*
+ // use cache texture
+ CoverIndex := Covers.FindCover(Name);
+
+ if TextureDatabase.Texture[TextureIndex].TextureCache.TexNum = 0 then
+ begin
+ // load texture
+ Covers.PrepareData(Name);
+ TextureDatabase.Texture[TextureIndex].TextureCache := CreateTexture(Covers.Data, Name, Covers.Cover[CoverIndex].Width, Covers.Cover[CoverIndex].Height, 24);
+ end;
+ *)
+
+ // use texture
+ TextureIndex := TextureDatabase.FindTexture(Name, Typ, Col);
+ if (TextureIndex > -1) then
+ Result := TextureDatabase.Texture[TextureIndex].TextureCache;
+ Exit;
+ end;
+
+ // find texture entry in database
+ TextureIndex := TextureDatabase.FindTexture(Name, Typ, Col);
+ if (TextureIndex = -1) then
+ begin
+ // create texture entry in database
+ TextureIndex := Length(TextureDatabase.Texture);
+ SetLength(TextureDatabase.Texture, TextureIndex+1);
+
+ TextureDatabase.Texture[TextureIndex].Name := Name;
+ TextureDatabase.Texture[TextureIndex].Typ := Typ;
+ TextureDatabase.Texture[TextureIndex].Color := Col;
+
+ // inform database that no textures have been loaded into memory
+ TextureDatabase.Texture[TextureIndex].Texture.TexNum := 0;
+ TextureDatabase.Texture[TextureIndex].TextureCache.TexNum := 0;
+ end;
+
+ // load full texture
+ if (TextureDatabase.Texture[TextureIndex].Texture.TexNum = 0) then
+ TextureDatabase.Texture[TextureIndex].Texture := LoadTexture(false, Name, Typ, Col);
+
+ // use texture
+ Result := TextureDatabase.Texture[TextureIndex].Texture;
+end;
+
+function TTextureUnit.CreateTexture(Data: PChar; const Name: string; Width, Height: word; BitsPerPixel: byte): TTexture;
+var
+ Error: integer;
+ ActTex: GLuint;
+begin
+ glGenTextures(1, @ActTex); // ActText = new texture number
+ glBindTexture(GL_TEXTURE_2D, ActTex);
+ glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
+ glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE);
+ glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE);
+
+ glTexImage2D(GL_TEXTURE_2D, 0, 3, Width, Height, 0, GL_RGB, GL_UNSIGNED_BYTE, Data);
+
+ {
+ if Mipmapping then
+ begin
+ Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 3, W, H, GL_RGB, GL_UNSIGNED_BYTE, @Data[0]);
+ if Error > 0 then
+ Log.LogError('gluBuild2DMipmaps() failed', 'TTextureUnit.CreateTexture');
+ end;
+ }
+
+ Result.X := 0;
+ Result.Y := 0;
+ Result.Z := 0;
+ Result.W := 0;
+ Result.H := 0;
+ Result.ScaleW := 1;
+ Result.ScaleH := 1;
+ Result.Rot := 0;
+ Result.TexNum := ActTex;
+ Result.TexW := 1;
+ Result.TexH := 1;
+
+ Result.Int := 1;
+ Result.ColR := 1;
+ Result.ColG := 1;
+ Result.ColB := 1;
+ Result.Alpha := 1;
+
+ // new test - default use whole texure, taking TexW and TexH as const and changing these
+ Result.TexX1 := 0;
+ Result.TexY1 := 0;
+ Result.TexX2 := 1;
+ Result.TexY2 := 1;
+
+ Result.Name := Name;
+end;
+
+procedure TTextureUnit.UnloadTexture(const Name: string; Typ: TTextureType; FromCache: boolean);
+begin
+ UnloadTexture(Name, Typ, 0, FromCache);
+end;
+
+procedure TTextureUnit.UnloadTexture(const Name: string; Typ: TTextureType; Col: Cardinal; FromCache: boolean);
+var
+ T: integer;
+ TexNum: GLuint;
+begin
+ T := TextureDatabase.FindTexture(Name, Typ, Col);
+
+ if not FromCache then
+ begin
+ TexNum := TextureDatabase.Texture[T].Texture.TexNum;
+ if TexNum > 0 then
+ begin
+ glDeleteTextures(1, PGLuint(@TexNum));
+ TextureDatabase.Texture[T].Texture.TexNum := 0;
+ //Log.LogError('Unload texture no '+IntToStr(TexNum));
+ end;
+ end
+ else
+ begin
+ TexNum := TextureDatabase.Texture[T].TextureCache.TexNum;
+ if TexNum > 0 then
+ begin
+ glDeleteTextures(1, @TexNum);
+ TextureDatabase.Texture[T].TextureCache.TexNum := 0;
+ //Log.LogError('Unload texture cache no '+IntToStr(TexNum));
+ end;
+ end;
+end;
+
+(* This needs some work
+procedure TTextureUnit.FlushTextureDatabase();
+var
+ i: integer;
+ Tex: ^TTexture;
+begin
+ for i := 0 to High(TextureDatabase.Texture) do
+ begin
+ // only delete non-cached entries
+ if (TextureDatabase.Texture[i].Texture.TexNum > 0) then
+ begin
+ Tex := @TextureDatabase.Texture[i].Texture;
+ glDeleteTextures(1, PGLuint(Tex^.TexNum));
+ Tex^.TexNum := 0;
+ end;
+ end;
+end;
+*)
+
+function TextureTypeToStr(TexType: TTextureType): string;
+begin
+ Result := TextureTypeStr[TexType];
+end;
+
+function ParseTextureType(const TypeStr: string; Default: TTextureType): TTextureType;
+var
+ TexType: TTextureType;
+ UpCaseStr: string;
+begin
+ UpCaseStr := UpperCase(TypeStr);
+ for TexType := Low(TextureTypeStr) to High(TextureTypeStr) do
+ begin
+ if (UpCaseStr = UpperCase(TextureTypeStr[TexType])) then
+ begin
+ Result := TexType;
+ Exit;
+ end;
+ end;
+ Log.LogWarn('Unknown texture-type: "' + TypeStr + '"', 'ParseTextureType');
+ Result := TEXTURE_TYPE_PLAIN;
+end;
+
+end.
diff --git a/src/base/UThemes.pas b/src/base/UThemes.pas
new file mode 100644
index 00000000..fca75c24
--- /dev/null
+++ b/src/base/UThemes.pas
@@ -0,0 +1,2234 @@
+unit UThemes;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+uses
+ ULog,
+ IniFiles,
+ SysUtils,
+ Classes,
+ UTexture;
+
+type
+ TRGB = record
+ R: single;
+ G: single;
+ B: single;
+ end;
+
+ TRGBA = record
+ R, G, B, A: Double;
+ end;
+
+ TThemeBackground = record
+ Tex: string;
+ end;
+
+ TThemeStatic = record
+ X: integer;
+ Y: integer;
+ Z: real;
+ W: integer;
+ H: integer;
+ Color: string;
+ ColR: real;
+ ColG: real;
+ ColB: real;
+ Tex: string;
+ Typ: TTextureType;
+ TexX1: real;
+ TexY1: real;
+ TexX2: real;
+ TexY2: real;
+ //Reflection
+ Reflection: boolean;
+ Reflectionspacing: Real;
+ end;
+ AThemeStatic = array of TThemeStatic;
+
+ TThemeText = record
+ X: integer;
+ Y: integer;
+ W: integer;
+ Z: real;
+ Color: string;
+ ColR: real;
+ ColG: real;
+ ColB: real;
+ Font: integer;
+ Size: integer;
+ Align: integer;
+ Text: string;
+ //Reflection
+ Reflection: boolean;
+ ReflectionSpacing: Real;
+ end;
+ AThemeText = array of TThemeText;
+
+ TThemeButton = record
+ Text: AThemeText;
+ X: integer;
+ Y: integer;
+ Z: Real;
+ W: integer;
+ H: integer;
+ Color: string;
+ ColR: real;
+ ColG: real;
+ ColB: real;
+ Int: real;
+ DColor: string;
+ DColR: real;
+ DColG: real;
+ DColB: real;
+ DInt: real;
+ Tex: string;
+ Typ: TTextureType;
+
+ Visible: Boolean;
+
+ //Reflection Mod
+ Reflection: boolean;
+ Reflectionspacing: Real;
+ //Fade Mod
+ SelectH: integer;
+ SelectW: integer;
+ Fade: boolean;
+ FadeText: boolean;
+ DeSelectReflectionspacing : Real;
+ FadeTex: string;
+ FadeTexPos: integer;
+
+ //Button Collection Mod
+ Parent: Byte; //Number of the Button Collection this Button is assigned to. IF 0: No Assignement
+ end;
+
+ //Button Collection Mod
+ TThemeButtonCollection = record
+ Style: TThemeButton;
+ ChildCount: Byte; //No of assigned Childs
+ FirstChild: Byte; //No of Child on whose Interaction Position the Button should be
+ end;
+
+ AThemeButtonCollection = array of TThemeButtonCollection;
+ PAThemeButtonCollection = ^AThemeButtonCollection;
+
+ TThemeSelectSlide = record
+ Tex: string;
+ TexSBG: string;
+ X: integer;
+ Y: integer;
+ W: integer;
+ H: integer;
+ Z: real;
+
+ TextSize: integer;
+
+ //SBGW Mod
+ SBGW: integer;
+
+ Text: string;
+ ColR, ColG, ColB, Int: real;
+ DColR, DColG, DColB, DInt: real;
+ TColR, TColG, TColB, TInt: real;
+ TDColR, TDColG, TDColB, TDInt: real;
+ SBGColR, SBGColG, SBGColB, SBGInt: real;
+ SBGDColR, SBGDColG, SBGDColB, SBGDInt: real;
+ STColR, STColG, STColB, STInt: real;
+ STDColR, STDColG, STDColB, STDInt: real;
+ SkipX: integer;
+ end;
+
+ PThemeBasic = ^TThemeBasic;
+ TThemeBasic = class
+ Background: TThemeBackground;
+ Text: AThemeText;
+ Static: AThemeStatic;
+
+ //Button Collection Mod
+ ButtonCollection: AThemeButtonCollection;
+ end;
+
+ TThemeLoading = class(TThemeBasic)
+ StaticAnimation: TThemeStatic;
+ TextLoading: TThemeText;
+ end;
+
+ TThemeMain = class(TThemeBasic)
+ ButtonSolo: TThemeButton;
+ ButtonMulti: TThemeButton;
+ ButtonStat: TThemeButton;
+ ButtonEditor: TThemeButton;
+ ButtonOptions: TThemeButton;
+ ButtonExit: TThemeButton;
+
+ TextDescription: TThemeText;
+ TextDescriptionLong: TThemeText;
+ Description: array[0..5] of string;
+ DescriptionLong: array[0..5] of string;
+ end;
+
+ TThemeName = class(TThemeBasic)
+ ButtonPlayer: array[1..6] of TThemeButton;
+ end;
+
+ TThemeLevel = class(TThemeBasic)
+ ButtonEasy: TThemeButton;
+ ButtonMedium: TThemeButton;
+ ButtonHard: TThemeButton;
+ end;
+
+ TThemeSong = class(TThemeBasic)
+ TextArtist: TThemeText;
+ TextTitle: TThemeText;
+ TextNumber: TThemeText;
+
+ //Video Icon Mod
+ VideoIcon: TThemeStatic;
+
+ //Show Cat in TopLeft Mod
+ TextCat: TThemeText;
+ StaticCat: TThemeStatic;
+
+ //Cover Mod
+ Cover: record
+ Reflections: Boolean;
+ X: Integer;
+ Y: Integer;
+ Z: Integer;
+ W: Integer;
+ H: Integer;
+ Style: Integer;
+ end;
+
+ //Equalizer Mod
+ Equalizer: record
+ Visible: Boolean;
+ Direction: Boolean;
+ Alpha: real;
+ X: Integer;
+ Y: Integer;
+ Z: Real;
+ W: Integer;
+ H: Integer;
+ Space: Integer;
+ Bands: Integer;
+ Length: Integer;
+ ColR, ColG, ColB: Real;
+ end;
+
+
+ //Party and Non Party specific Statics and Texts
+ StaticParty: AThemeStatic;
+ TextParty: AThemeText;
+
+ StaticNonParty: AThemeStatic;
+ TextNonParty: AThemeText;
+
+ //Party Mode
+ StaticTeam1Joker1: TThemeStatic;
+ StaticTeam1Joker2: TThemeStatic;
+ StaticTeam1Joker3: TThemeStatic;
+ StaticTeam1Joker4: TThemeStatic;
+ StaticTeam1Joker5: TThemeStatic;
+ StaticTeam2Joker1: TThemeStatic;
+ StaticTeam2Joker2: TThemeStatic;
+ StaticTeam2Joker3: TThemeStatic;
+ StaticTeam2Joker4: TThemeStatic;
+ StaticTeam2Joker5: TThemeStatic;
+ StaticTeam3Joker1: TThemeStatic;
+ StaticTeam3Joker2: TThemeStatic;
+ StaticTeam3Joker3: TThemeStatic;
+ StaticTeam3Joker4: TThemeStatic;
+ StaticTeam3Joker5: TThemeStatic;
+
+
+ end;
+
+ TThemeSing = class(TThemeBasic)
+
+ //TimeBar mod
+ StaticTimeProgress: TThemeStatic;
+ TextTimeText : TThemeText;
+ //eoa TimeBar mod
+
+ StaticP1: TThemeStatic;
+ TextP1: TThemeText;
+ StaticP1ScoreBG: TThemeStatic; //Static for ScoreBG
+ TextP1Score: TThemeText;
+
+ //moveable singbar mod
+ StaticP1SingBar: TThemeStatic;
+ StaticP1ThreePSingBar: TThemeStatic;
+ StaticP1TwoPSingBar: TThemeStatic;
+ StaticP2RSingBar: TThemeStatic;
+ StaticP2MSingBar: TThemeStatic;
+ StaticP3SingBar: TThemeStatic;
+ //eoa moveable singbar
+
+ //added for ps3 skin
+ //game in 2/4 player modi
+ StaticP1TwoP: TThemeStatic;
+ StaticP1TwoPScoreBG: TThemeStatic; //Static for ScoreBG
+ TextP1TwoP: TThemeText;
+ TextP1TwoPScore: TThemeText;
+ //game in 3/6 player modi
+ StaticP1ThreeP: TThemeStatic;
+ StaticP1ThreePScoreBG: TThemeStatic; //Static for ScoreBG
+ TextP1ThreeP: TThemeText;
+ TextP1ThreePScore: TThemeText;
+ //eoa
+
+ StaticP2R: TThemeStatic;
+ StaticP2RScoreBG: TThemeStatic; //Static for ScoreBG
+ TextP2R: TThemeText;
+ TextP2RScore: TThemeText;
+
+ StaticP2M: TThemeStatic;
+ StaticP2MScoreBG: TThemeStatic; //Static for ScoreBG
+ TextP2M: TThemeText;
+ TextP2MScore: TThemeText;
+
+ StaticP3R: TThemeStatic;
+ StaticP3RScoreBG: TThemeStatic; //Static for ScoreBG
+ TextP3R: TThemeText;
+ TextP3RScore: TThemeText;
+
+ //Linebonus Translations
+ LineBonusText: Array [0..8] of String;
+
+ //Pause Popup
+ PausePopUp: TThemeStatic;
+ end;
+
+ TThemeScore = class(TThemeBasic)
+ TextArtist: TThemeText;
+ TextTitle: TThemeText;
+
+ TextArtistTitle: TThemeText;
+
+ PlayerStatic: array[1..6] of AThemeStatic;
+ PlayerTexts: array[1..6] of AThemeText;
+
+ TextName: array[1..6] of TThemeText;
+ TextScore: array[1..6] of TThemeText;
+
+ TextNotes: array[1..6] of TThemeText;
+ TextNotesScore: array[1..6] of TThemeText;
+ TextLineBonus: array[1..6] of TThemeText;
+ TextLineBonusScore: array[1..6] of TThemeText;
+ TextGoldenNotes: array[1..6] of TThemeText;
+ TextGoldenNotesScore: array[1..6] of TThemeText;
+ TextTotal: array[1..6] of TThemeText;
+ TextTotalScore: array[1..6] of TThemeText;
+
+ StaticBoxLightest: array[1..6] of TThemeStatic;
+ StaticBoxLight: array[1..6] of TThemeStatic;
+ StaticBoxDark: array[1..6] of TThemeStatic;
+
+ StaticRatings: array[1..6] of TThemeStatic;
+
+ StaticBackLevel: array[1..6] of TThemeStatic;
+ StaticBackLevelRound: array[1..6] of TThemeStatic;
+ StaticLevel: array[1..6] of TThemeStatic;
+ StaticLevelRound: array[1..6] of TThemeStatic;
+
+// Description: array[0..5] of string;}
+ end;
+
+ TThemeTop5 = class(TThemeBasic)
+ TextLevel: TThemeText;
+ TextArtistTitle: TThemeText;
+
+ StaticNumber: AThemeStatic;
+ TextNumber: AThemeText;
+ TextName: AThemeText;
+ TextScore: AThemeText;
+ end;
+
+ TThemeOptions = class(TThemeBasic)
+ ButtonGame: TThemeButton;
+ ButtonGraphics: TThemeButton;
+ ButtonSound: TThemeButton;
+ ButtonLyrics: TThemeButton;
+ ButtonThemes: TThemeButton;
+ ButtonRecord: TThemeButton;
+ ButtonAdvanced: TThemeButton;
+ ButtonExit: TThemeButton;
+
+ TextDescription: TThemeText;
+ Description: array[0..7] of string;
+ end;
+
+ TThemeOptionsGame = class(TThemeBasic)
+ SelectPlayers: TThemeSelectSlide;
+ SelectDifficulty: TThemeSelectSlide;
+ SelectLanguage: TThemeSelectSlide;
+ SelectTabs: TThemeSelectSlide;
+ SelectSorting: TThemeSelectSlide;
+ SelectDebug: TThemeSelectSlide;
+ ButtonExit: TThemeButton;
+ end;
+
+ TThemeOptionsGraphics = class(TThemeBasic)
+ SelectFullscreen: TThemeSelectSlide;
+ SelectResolution: TThemeSelectSlide;
+ SelectDepth: TThemeSelectSlide;
+ SelectVisualizer: TThemeSelectSlide;
+ SelectOscilloscope: TThemeSelectSlide;
+ SelectLineBonus: TThemeSelectSlide;
+ SelectMovieSize: TThemeSelectSlide;
+ ButtonExit: TThemeButton;
+ end;
+
+ TThemeOptionsSound = class(TThemeBasic)
+ SelectMicBoost: TThemeSelectSlide;
+ SelectBackgroundMusic: TThemeSelectSlide;
+ SelectClickAssist: TThemeSelectSlide;
+ SelectBeatClick: TThemeSelectSlide;
+ SelectThreshold: TThemeSelectSlide;
+ SelectSlidePreviewVolume: TThemeSelectSlide;
+ SelectSlidePreviewFading: TThemeSelectSlide;
+ SelectSlideVoicePassthrough: TThemeSelectSlide;
+ ButtonExit: TThemeButton;
+ end;
+
+ TThemeOptionsLyrics = class(TThemeBasic)
+ SelectLyricsFont: TThemeSelectSlide;
+ SelectLyricsEffect: TThemeSelectSlide;
+// SelectSolmization: TThemeSelectSlide;
+ SelectNoteLines: TThemeSelectSlide;
+ ButtonExit: TThemeButton;
+ end;
+
+ TThemeOptionsThemes = class(TThemeBasic)
+ SelectTheme: TThemeSelectSlide;
+ SelectSkin: TThemeSelectSlide;
+ SelectColor: TThemeSelectSlide;
+ ButtonExit: TThemeButton;
+ end;
+
+ TThemeOptionsRecord = class(TThemeBasic)
+ SelectSlideCard: TThemeSelectSlide;
+ SelectSlideInput: TThemeSelectSlide;
+ SelectSlideChannel: TThemeSelectSlide;
+ ButtonExit: TThemeButton;
+ end;
+
+ TThemeOptionsAdvanced = class(TThemeBasic)
+ SelectLoadAnimation: TThemeSelectSlide;
+ SelectEffectSing: TThemeSelectSlide;
+ SelectScreenFade: TThemeSelectSlide;
+ SelectLineBonus: TThemeSelectSlide;
+ SelectAskbeforeDel: TThemeSelectSlide;
+ SelectOnSongClick: TThemeSelectSlide;
+ SelectPartyPopup: TThemeSelectSlide;
+ ButtonExit: TThemeButton;
+ end;
+
+ //Error- and Check-Popup
+ TThemeError = class(TThemeBasic)
+ Button1: TThemeButton;
+ TextError: TThemeText;
+ end;
+
+ TThemeCheck = class(TThemeBasic)
+ Button1: TThemeButton;
+ Button2: TThemeButton;
+ TextCheck: TThemeText;
+ end;
+
+
+ //ScreenSong Menue
+ TThemeSongMenu = class(TThemeBasic)
+ Button1: TThemeButton;
+ Button2: TThemeButton;
+ Button3: TThemeButton;
+ Button4: TThemeButton;
+
+ SelectSlide3: TThemeSelectSlide;
+
+ TextMenu: TThemeText;
+ end;
+
+ TThemeSongJumpTo = class(TThemeBasic)
+ ButtonSearchText: TThemeButton;
+ SelectSlideType: TThemeSelectSlide;
+ TextFound: TThemeText;
+
+ //Translated Texts
+ Songsfound: String;
+ NoSongsfound: String;
+ CatText: String;
+ IType: array [0..2] of String;
+ end;
+
+ //Party Screens
+ TThemePartyNewRound = class(TThemeBasic)
+ TextRound1: TThemeText;
+ TextRound2: TThemeText;
+ TextRound3: TThemeText;
+ TextRound4: TThemeText;
+ TextRound5: TThemeText;
+ TextRound6: TThemeText;
+ TextRound7: TThemeText;
+ TextWinner1: TThemeText;
+ TextWinner2: TThemeText;
+ TextWinner3: TThemeText;
+ TextWinner4: TThemeText;
+ TextWinner5: TThemeText;
+ TextWinner6: TThemeText;
+ TextWinner7: TThemeText;
+ TextNextRound: TThemeText;
+ TextNextRoundNo: TThemeText;
+ TextNextPlayer1: TThemeText;
+ TextNextPlayer2: TThemeText;
+ TextNextPlayer3: TThemeText;
+
+ StaticRound1: TThemeStatic;
+ StaticRound2: TThemeStatic;
+ StaticRound3: TThemeStatic;
+ StaticRound4: TThemeStatic;
+ StaticRound5: TThemeStatic;
+ StaticRound6: TThemeStatic;
+ StaticRound7: TThemeStatic;
+
+ TextScoreTeam1: TThemeText;
+ TextScoreTeam2: TThemeText;
+ TextScoreTeam3: TThemeText;
+ TextNameTeam1: TThemeText;
+ TextNameTeam2: TThemeText;
+ TextNameTeam3: TThemeText;
+ TextTeam1Players: TThemeText;
+ TextTeam2Players: TThemeText;
+ TextTeam3Players: TThemeText;
+
+ StaticTeam1: TThemeStatic;
+ StaticTeam2: TThemeStatic;
+ StaticTeam3: TThemeStatic;
+ StaticNextPlayer1: TThemeStatic;
+ StaticNextPlayer2: TThemeStatic;
+ StaticNextPlayer3: TThemeStatic;
+ end;
+
+ TThemePartyScore = class(TThemeBasic)
+ TextScoreTeam1: TThemeText;
+ TextScoreTeam2: TThemeText;
+ TextScoreTeam3: TThemeText;
+ TextNameTeam1: TThemeText;
+ TextNameTeam2: TThemeText;
+ TextNameTeam3: TThemeText;
+ StaticTeam1: TThemeStatic;
+ StaticTeam1BG: TThemeStatic;
+ StaticTeam1Deco: TThemeStatic;
+ StaticTeam2: TThemeStatic;
+ StaticTeam2BG: TThemeStatic;
+ StaticTeam2Deco: TThemeStatic;
+ StaticTeam3: TThemeStatic;
+ StaticTeam3BG: TThemeStatic;
+ StaticTeam3Deco: TThemeStatic;
+
+ DecoTextures: record
+ ChangeTextures: Boolean;
+
+ FirstTexture: String;
+ FirstTyp: TTextureType;
+ FirstColor: String;
+
+ SecondTexture: String;
+ SecondTyp: TTextureType;
+ SecondColor: String;
+
+ ThirdTexture: String;
+ ThirdTyp: TTextureType;
+ ThirdColor: String;
+ end;
+
+
+ TextWinner: TThemeText;
+ end;
+
+ TThemePartyWin = class(TThemeBasic)
+ TextScoreTeam1: TThemeText;
+ TextScoreTeam2: TThemeText;
+ TextScoreTeam3: TThemeText;
+ TextNameTeam1: TThemeText;
+ TextNameTeam2: TThemeText;
+ TextNameTeam3: TThemeText;
+ StaticTeam1: TThemeStatic;
+ StaticTeam1BG: TThemeStatic;
+ StaticTeam1Deco: TThemeStatic;
+ StaticTeam2: TThemeStatic;
+ StaticTeam2BG: TThemeStatic;
+ StaticTeam2Deco: TThemeStatic;
+ StaticTeam3: TThemeStatic;
+ StaticTeam3BG: TThemeStatic;
+ StaticTeam3Deco: TThemeStatic;
+
+ TextWinner: TThemeText;
+ end;
+
+ TThemePartyOptions = class(TThemeBasic)
+ SelectLevel: TThemeSelectSlide;
+ SelectPlayList: TThemeSelectSlide;
+ SelectPlayList2: TThemeSelectSlide;
+ SelectRounds: TThemeSelectSlide;
+ SelectTeams: TThemeSelectSlide;
+ SelectPlayers1: TThemeSelectSlide;
+ SelectPlayers2: TThemeSelectSlide;
+ SelectPlayers3: TThemeSelectSlide;
+
+ {ButtonNext: TThemeButton;
+ ButtonPrev: TThemeButton;}
+ end;
+
+ TThemePartyPlayer = class(TThemeBasic)
+ Team1Name: TThemeButton;
+ Player1Name: TThemeButton;
+ Player2Name: TThemeButton;
+ Player3Name: TThemeButton;
+ Player4Name: TThemeButton;
+
+ Team2Name: TThemeButton;
+ Player5Name: TThemeButton;
+ Player6Name: TThemeButton;
+ Player7Name: TThemeButton;
+ Player8Name: TThemeButton;
+
+ Team3Name: TThemeButton;
+ Player9Name: TThemeButton;
+ Player10Name: TThemeButton;
+ Player11Name: TThemeButton;
+ Player12Name: TThemeButton;
+
+ {ButtonNext: TThemeButton;
+ ButtonPrev: TThemeButton;}
+ end;
+
+ //Stats Screens
+ TThemeStatMain = class(TThemeBasic)
+ ButtonScores: TThemeButton;
+ ButtonSingers: TThemeButton;
+ ButtonSongs: TThemeButton;
+ ButtonBands: TThemeButton;
+ ButtonExit: TThemeButton;
+
+ TextOverview: TThemeText;
+ end;
+
+ TThemeStatDetail = class(TThemeBasic)
+ ButtonNext: TThemeButton;
+ ButtonPrev: TThemeButton;
+ ButtonReverse: TThemeButton;
+ ButtonExit: TThemeButton;
+
+ TextDescription: TThemeText;
+ TextPage: TThemeText;
+ TextList: AThemeText;
+
+ Description: array[0..3] of string;
+ DescriptionR: array[0..3] of string;
+ FormatStr: array[0..3] of string;
+ PageStr: String;
+ end;
+
+ //Playlist Translations
+ TThemePlaylist = record
+ CatText: string;
+ end;
+
+ TTheme = class
+ private
+ {$IFDEF THEMESAVE}
+ ThemeIni: TIniFile;
+ {$ELSE}
+ ThemeIni: TMemIniFile;
+ {$ENDIF}
+
+ LastThemeBasic: TThemeBasic;
+ procedure create_theme_objects();
+ public
+
+ Loading: TThemeLoading;
+ Main: TThemeMain;
+ Name: TThemeName;
+ Level: TThemeLevel;
+ Song: TThemeSong;
+ Sing: TThemeSing;
+ Score: TThemeScore;
+ Top5: TThemeTop5;
+ Options: TThemeOptions;
+ OptionsGame: TThemeOptionsGame;
+ OptionsGraphics: TThemeOptionsGraphics;
+ OptionsSound: TThemeOptionsSound;
+ OptionsLyrics: TThemeOptionsLyrics;
+ OptionsThemes: TThemeOptionsThemes;
+ OptionsRecord: TThemeOptionsRecord;
+ OptionsAdvanced: TThemeOptionsAdvanced;
+ //error and check popup
+ ErrorPopup: TThemeError;
+ CheckPopup: TThemeCheck;
+ //ScreenSong extensions
+ SongMenu: TThemeSongMenu;
+ SongJumpto: TThemeSongJumpTo;
+ //Party Screens:
+ PartyNewRound: TThemePartyNewRound;
+ PartyScore: TThemePartyScore;
+ PartyWin: TThemePartyWin;
+ PartyOptions: TThemePartyOptions;
+ PartyPlayer: TThemePartyPlayer;
+
+ //Stats Screens:
+ StatMain: TThemeStatMain;
+ StatDetail: TThemeStatDetail;
+
+ Playlist: TThemePlaylist;
+
+ ILevel: array[0..2] of String;
+
+ constructor Create(FileName: string); overload; // Initialize theme system
+ constructor Create(FileName: string; Color: integer); overload; // Initialize theme system with color
+ function LoadTheme(FileName: string; sColor: integer): boolean; // Load some theme settings from file
+
+ procedure LoadColors;
+
+ procedure ThemeLoadBasic(Theme: TThemeBasic; Name: string);
+ procedure ThemeLoadBackground(var ThemeBackground: TThemeBackground; Name: string);
+ procedure ThemeLoadText(var ThemeText: TThemeText; Name: string);
+ procedure ThemeLoadTexts(var ThemeText: AThemeText; Name: string);
+ procedure ThemeLoadStatic(var ThemeStatic: TThemeStatic; Name: string);
+ procedure ThemeLoadStatics(var ThemeStatic: AThemeStatic; Name: string);
+ procedure ThemeLoadButton(var ThemeButton: TThemeButton; Name: string; const Collections: PAThemeButtonCollection = nil);
+ procedure ThemeLoadButtonCollection(var Collection: TThemeButtonCollection; Name: string);
+ procedure ThemeLoadButtonCollections(var Collections: AThemeButtonCollection; Name: string);
+ procedure ThemeLoadSelectSlide(var ThemeSelectS: TThemeSelectSlide; Name: string);
+
+ procedure ThemeSave(FileName: string);
+ procedure ThemeSaveBasic(Theme: TThemeBasic; Name: string);
+ procedure ThemeSaveBackground(ThemeBackground: TThemeBackground; Name: string);
+ procedure ThemeSaveStatic(ThemeStatic: TThemeStatic; Name: string);
+ procedure ThemeSaveStatics(ThemeStatic: AThemeStatic; Name: string);
+ procedure ThemeSaveText(ThemeText: TThemeText; Name: string);
+ procedure ThemeSaveTexts(ThemeText: AThemeText; Name: string);
+ procedure ThemeSaveButton(ThemeButton: TThemeButton; Name: string);
+
+ end;
+
+ TColor = record
+ Name: string;
+ RGB: TRGB;
+ end;
+
+function ColorExists(Name: string): integer;
+procedure LoadColor(var R, G, B: real; ColorName: string);
+function GetSystemColor(Color: integer): TRGB;
+function ColorSqrt(RGB: TRGB): TRGB;
+
+var
+ //Skin: TSkin;
+ Theme: TTheme;
+ Color: array of TColor;
+
+implementation
+
+uses
+ UCommon,
+ ULanguage,
+ USkins,
+ UIni;
+
+constructor TTheme.Create(FileName: string);
+begin
+ Create(FileName, 0);
+end;
+
+constructor TTheme.Create(FileName: string; Color: integer);
+begin
+ inherited Create();
+
+ Loading := TThemeLoading.Create;
+ Main := TThemeMain.Create;
+ Name := TThemeName.Create;
+ Level := TThemeLevel.Create;
+ Song := TThemeSong.Create;
+ Sing := TThemeSing.Create;
+ Score := TThemeScore.Create;
+ Top5 := TThemeTop5.Create;
+ Options := TThemeOptions.Create;
+ OptionsGame := TThemeOptionsGame.Create;
+ OptionsGraphics := TThemeOptionsGraphics.Create;
+ OptionsSound := TThemeOptionsSound.Create;
+ OptionsLyrics := TThemeOptionsLyrics.Create;
+ OptionsThemes := TThemeOptionsThemes.Create;
+ OptionsRecord := TThemeOptionsRecord.Create;
+ OptionsAdvanced := TThemeOptionsAdvanced.Create;
+
+ ErrorPopup := TThemeError.Create;
+ CheckPopup := TThemeCheck.Create;
+
+ SongMenu := TThemeSongMenu.Create;
+ SongJumpto := TThemeSongJumpto.Create;
+ //Party Screens
+ PartyNewRound := TThemePartyNewRound.Create;
+ PartyWin := TThemePartyWin.Create;
+ PartyScore := TThemePartyScore.Create;
+ PartyOptions := TThemePartyOptions.Create;
+ PartyPlayer := TThemePartyPlayer.Create;
+
+ //Stats Screens:
+ StatMain := TThemeStatMain.Create;
+ StatDetail := TThemeStatDetail.Create;
+
+ LoadTheme(FileName, Color);
+
+end;
+
+
+function TTheme.LoadTheme(FileName: string; sColor: integer): boolean;
+var
+ I: integer;
+ Path: string;
+begin
+ Result := false;
+
+ create_theme_objects();
+
+ Log.LogStatus('Loading: '+ FileName, 'TTheme.LoadTheme');
+
+ FileName := AdaptFilePaths( FileName );
+
+ if not FileExists(FileName) then
+ begin
+ Log.LogError('Theme does not exist ('+ FileName +')', 'TTheme.LoadTheme');
+ end;
+
+ if FileExists(FileName) then
+ begin
+ Result := true;
+
+ {$IFDEF THEMESAVE}
+ ThemeIni := TIniFile.Create(FileName);
+ {$ELSE}
+ ThemeIni := TMemIniFile.Create(FileName);
+ {$ENDIF}
+
+ if ThemeIni.ReadString('Theme', 'Name', '') <> '' then
+ begin
+
+ {Skin.SkinName := ThemeIni.ReadString('Theme', 'Name', 'Singstar');
+ Skin.SkinPath := 'Skins\' + Skin.SkinName + '\';
+ Skin.SkinReg := false; }
+ Skin.Color := sColor;
+
+ Skin.LoadSkin(ISkin[Ini.SkinNo]);
+
+ LoadColors;
+
+// ThemeIni.Free;
+// ThemeIni := TIniFile.Create('Themes\Singstar\Main.ini');
+
+ // Loading
+ ThemeLoadBasic(Loading, 'Loading');
+ ThemeLoadText(Loading.TextLoading, 'LoadingTextLoading');
+ ThemeLoadStatic(Loading.StaticAnimation, 'LoadingStaticAnimation');
+
+ // Main
+ ThemeLoadBasic(Main, 'Main');
+
+ ThemeLoadText(Main.TextDescription, 'MainTextDescription');
+ ThemeLoadText(Main.TextDescriptionLong, 'MainTextDescriptionLong');
+ ThemeLoadButton(Main.ButtonSolo, 'MainButtonSolo');
+ ThemeLoadButton(Main.ButtonMulti, 'MainButtonMulti');
+ ThemeLoadButton(Main.ButtonStat, 'MainButtonStats');
+ ThemeLoadButton(Main.ButtonEditor, 'MainButtonEditor');
+ ThemeLoadButton(Main.ButtonOptions, 'MainButtonOptions');
+ ThemeLoadButton(Main.ButtonExit, 'MainButtonExit');
+
+ //Main Desc Text Translation Start
+
+ Main.Description[0] := Language.Translate('SING_SING');
+ Main.DescriptionLong[0] := Language.Translate('SING_SING_DESC');
+ Main.Description[1] := Language.Translate('SING_MULTI');
+ Main.DescriptionLong[1] := Language.Translate('SING_MULTI_DESC');
+ Main.Description[2] := Language.Translate('SING_STATS');
+ Main.DescriptionLong[2] := Language.Translate('SING_STATS_DESC');
+ Main.Description[3] := Language.Translate('SING_EDITOR');
+ Main.DescriptionLong[3] := Language.Translate('SING_EDITOR_DESC');
+ Main.Description[4] := Language.Translate('SING_GAME_OPTIONS');
+ Main.DescriptionLong[4] := Language.Translate('SING_GAME_OPTIONS_DESC');
+ Main.Description[5] := Language.Translate('SING_EXIT');
+ Main.DescriptionLong[5] := Language.Translate('SING_EXIT_DESC');
+
+ //Main Desc Text Translation End
+
+ Main.TextDescription.Text := Main.Description[0];
+ Main.TextDescriptionLong.Text := Main.DescriptionLong[0];
+
+ // Name
+ ThemeLoadBasic(Name, 'Name');
+
+ for I := 1 to 6 do
+ ThemeLoadButton(Name.ButtonPlayer[I], 'NameButtonPlayer'+IntToStr(I));
+
+ // Level
+ ThemeLoadBasic(Level, 'Level');
+
+ ThemeLoadButton(Level.ButtonEasy, 'LevelButtonEasy');
+ ThemeLoadButton(Level.ButtonMedium, 'LevelButtonMedium');
+ ThemeLoadButton(Level.ButtonHard, 'LevelButtonHard');
+
+
+ // Song
+ ThemeLoadBasic(Song, 'Song');
+
+ ThemeLoadText(Song.TextArtist, 'SongTextArtist');
+ ThemeLoadText(Song.TextTitle, 'SongTextTitle');
+ ThemeLoadText(Song.TextNumber, 'SongTextNumber');
+
+ //Video Icon Mod
+ ThemeLoadStatic(Song.VideoIcon, 'SongVideoIcon');
+
+ //Show Cat in TopLeft Mod
+ ThemeLoadStatic(Song.StaticCat, 'SongStaticCat');
+ ThemeLoadText(Song.TextCat, 'SongTextCat');
+
+ //Load Cover Pos and Size from Theme Mod
+ Song.Cover.X := ThemeIni.ReadInteger('SongCover', 'X', 300);
+ Song.Cover.Y := ThemeIni.ReadInteger('SongCover', 'Y', 190);
+ Song.Cover.W := ThemeIni.ReadInteger('SongCover', 'W', 300);
+ Song.Cover.H := ThemeIni.ReadInteger('SongCover', 'H', 200);
+ Song.Cover.Style := ThemeIni.ReadInteger('SongCover', 'Style', 4);
+ Song.Cover.Reflections := (ThemeIni.ReadInteger('SongCover', 'Reflections', 0) = 1);
+ //Load Cover Pos and Size from Theme Mod End
+
+ //Load Equalizer Pos and Size from Theme Mod
+ Song.Equalizer.Visible := (ThemeIni.ReadInteger('SongEqualizer', 'Visible', 0) = 1);
+ Song.Equalizer.Direction := (ThemeIni.ReadInteger('SongEqualizer', 'Direction', 0) = 1);
+ Song.Equalizer.Alpha := ThemeIni.ReadInteger('SongEqualizer', 'Alpha', 1);
+ Song.Equalizer.Space := ThemeIni.ReadInteger('SongEqualizer', 'Space', 1);
+ Song.Equalizer.X := ThemeIni.ReadInteger('SongEqualizer', 'X', 0);
+ Song.Equalizer.Y := ThemeIni.ReadInteger('SongEqualizer', 'Y', 0);
+ Song.Equalizer.Z := ThemeIni.ReadInteger('SongEqualizer', 'Z', 1);
+ Song.Equalizer.W := ThemeIni.ReadInteger('SongEqualizer', 'PieceW', 8);
+ Song.Equalizer.H := ThemeIni.ReadInteger('SongEqualizer', 'PieceH', 8);
+ Song.Equalizer.Bands := ThemeIni.ReadInteger('SongEqualizer', 'Bands', 5);
+ Song.Equalizer.Length := ThemeIni.ReadInteger('SongEqualizer', 'Length', 12);
+
+ //Color
+ I := ColorExists(ThemeIni.ReadString('SongEqualizer', 'Color', 'Black'));
+ if I >= 0 then begin
+ Song.Equalizer.ColR := Color[I].RGB.R;
+ Song.Equalizer.ColG := Color[I].RGB.G;
+ Song.Equalizer.ColB := Color[I].RGB.B;
+ end
+ else begin
+ Song.Equalizer.ColR := 0;
+ Song.Equalizer.ColG := 0;
+ Song.Equalizer.ColB := 0;
+ end;
+ //Load Equalizer Pos and Size from Theme Mod End
+
+ //Party and Non Party specific Statics and Texts
+ ThemeLoadStatics (Song.StaticParty, 'SongStaticParty');
+ ThemeLoadTexts (Song.TextParty, 'SongTextParty');
+
+ ThemeLoadStatics (Song.StaticNonParty, 'SongStaticNonParty');
+ ThemeLoadTexts (Song.TextNonParty, 'SongTextNonParty');
+
+ //Party Mode
+ ThemeLoadStatic(Song.StaticTeam1Joker1, 'SongStaticTeam1Joker1');
+ ThemeLoadStatic(Song.StaticTeam1Joker2, 'SongStaticTeam1Joker2');
+ ThemeLoadStatic(Song.StaticTeam1Joker3, 'SongStaticTeam1Joker3');
+ ThemeLoadStatic(Song.StaticTeam1Joker4, 'SongStaticTeam1Joker4');
+ ThemeLoadStatic(Song.StaticTeam1Joker5, 'SongStaticTeam1Joker5');
+
+ ThemeLoadStatic(Song.StaticTeam2Joker1, 'SongStaticTeam2Joker1');
+ ThemeLoadStatic(Song.StaticTeam2Joker2, 'SongStaticTeam2Joker2');
+ ThemeLoadStatic(Song.StaticTeam2Joker3, 'SongStaticTeam2Joker3');
+ ThemeLoadStatic(Song.StaticTeam2Joker4, 'SongStaticTeam2Joker4');
+ ThemeLoadStatic(Song.StaticTeam2Joker5, 'SongStaticTeam2Joker5');
+
+ ThemeLoadStatic(Song.StaticTeam3Joker1, 'SongStaticTeam3Joker1');
+ ThemeLoadStatic(Song.StaticTeam3Joker2, 'SongStaticTeam3Joker2');
+ ThemeLoadStatic(Song.StaticTeam3Joker3, 'SongStaticTeam3Joker3');
+ ThemeLoadStatic(Song.StaticTeam3Joker4, 'SongStaticTeam3Joker4');
+ ThemeLoadStatic(Song.StaticTeam3Joker5, 'SongStaticTeam3Joker5');
+
+
+ // Sing
+ ThemeLoadBasic(Sing, 'Sing');
+
+ //TimeBar mod
+ ThemeLoadStatic(Sing.StaticTimeProgress, 'SingTimeProgress');
+ ThemeLoadText(Sing.TextTimeText, 'SingTimeText');
+ //eoa TimeBar mod
+
+ //moveable singbar mod
+ ThemeLoadStatic(Sing.StaticP1SingBar, 'SingP1SingBar');
+ ThemeLoadStatic(Sing.StaticP1TwoPSingBar, 'SingP1TwoPSingBar');
+ ThemeLoadStatic(Sing.StaticP1ThreePSingBar, 'SingP1ThreePSingBar');
+ ThemeLoadStatic(Sing.StaticP2RSingBar, 'SingP2RSingBar');
+ ThemeLoadStatic(Sing.StaticP2MSingBar, 'SingP2MSingBar');
+ ThemeLoadStatic(Sing.StaticP3SingBar, 'SingP3SingBar');
+ //eoa moveable singbar
+
+ ThemeLoadStatic(Sing.StaticP1, 'SingP1Static');
+ ThemeLoadText(Sing.TextP1, 'SingP1Text');
+ ThemeLoadStatic(Sing.StaticP1ScoreBG, 'SingP1Static2');
+ ThemeLoadText(Sing.TextP1Score, 'SingP1TextScore');
+ //Added for ps3 skin
+ //This one is shown in 2/4P mode
+ //if it exists, otherwise the one Player equivaltents are used
+ if (ThemeIni.SectionExists('SingP1TwoPTextScore')) then
+ begin
+ ThemeLoadStatic(Sing.StaticP1TwoP, 'SingP1TwoPStatic');
+ ThemeLoadText(Sing.TextP1TwoP, 'SingP1TwoPText');
+ ThemeLoadStatic(Sing.StaticP1TwoPScoreBG, 'SingP1TwoPStatic2');
+ ThemeLoadText(Sing.TextP1TwoPScore, 'SingP1TwoPTextScore');
+ end
+ else
+ begin
+ Sing.StaticP1TwoP := Sing.StaticP1;
+ Sing.TextP1TwoP := Sing.TextP1;
+ Sing.StaticP1TwoPScoreBG := Sing.StaticP1ScoreBG;
+ Sing.TextP1TwoPScore := Sing.TextP1Score;
+ end;
+
+ //This one is shown in 3/6P mode
+ //if it exists, otherwise the one Player equivaltents are used
+ if (ThemeIni.SectionExists('SingP1TwoPTextScore')) then
+ begin
+ ThemeLoadStatic(Sing.StaticP1ThreeP, 'SingP1ThreePStatic');
+ ThemeLoadText(Sing.TextP1ThreeP, 'SingP1ThreePText');
+ ThemeLoadStatic(Sing.StaticP1ThreePScoreBG, 'SingP1ThreePStatic2');
+ ThemeLoadText(Sing.TextP1ThreePScore, 'SingP1ThreePTextScore');
+ end
+ else
+ begin
+ Sing.StaticP1ThreeP := Sing.StaticP1;
+ Sing.TextP1ThreeP := Sing.TextP1;
+ Sing.StaticP1ThreePScoreBG := Sing.StaticP1ScoreBG;
+ Sing.TextP1ThreePScore := Sing.TextP1Score;
+ end;
+ //eoa
+ ThemeLoadStatic(Sing.StaticP2R, 'SingP2RStatic');
+ ThemeLoadText(Sing.TextP2R, 'SingP2RText');
+ ThemeLoadStatic(Sing.StaticP2RScoreBG, 'SingP2RStatic2');
+ ThemeLoadText(Sing.TextP2RScore, 'SingP2RTextScore');
+
+ ThemeLoadStatic(Sing.StaticP2M, 'SingP2MStatic');
+ ThemeLoadText(Sing.TextP2M, 'SingP2MText');
+ ThemeLoadStatic(Sing.StaticP2MScoreBG, 'SingP2MStatic2');
+ ThemeLoadText(Sing.TextP2MScore, 'SingP2MTextScore');
+
+ ThemeLoadStatic(Sing.StaticP3R, 'SingP3RStatic');
+ ThemeLoadText(Sing.TextP3R, 'SingP3RText');
+ ThemeLoadStatic(Sing.StaticP3RScoreBG, 'SingP3RStatic2');
+ ThemeLoadText(Sing.TextP3RScore, 'SingP3RTextScore');
+
+ //Line Bonus Texts
+ Sing.LineBonusText[0] := Language.Translate('POPUP_AWFUL');
+ Sing.LineBonusText[1] := Sing.LineBonusText[0];
+ Sing.LineBonusText[2] := Language.Translate('POPUP_POOR');
+ Sing.LineBonusText[3] := Language.Translate('POPUP_BAD');
+ Sing.LineBonusText[4] := Language.Translate('POPUP_NOTBAD');
+ Sing.LineBonusText[5] := Language.Translate('POPUP_GOOD');
+ Sing.LineBonusText[6] := Language.Translate('POPUP_GREAT');
+ Sing.LineBonusText[7] := Language.Translate('POPUP_AWESOME');
+ Sing.LineBonusText[8] := Language.Translate('POPUP_PERFECT');
+
+ //PausePopup
+ ThemeLoadStatic(Sing.PausePopUp, 'PausePopUpStatic');
+
+ // Score
+ ThemeLoadBasic(Score, 'Score');
+
+ ThemeLoadText(Score.TextArtist, 'ScoreTextArtist');
+ ThemeLoadText(Score.TextTitle, 'ScoreTextTitle');
+ ThemeLoadText(Score.TextArtistTitle, 'ScoreTextArtistTitle');
+
+ for I := 1 to 6 do begin
+ ThemeLoadStatics(Score.PlayerStatic[I], 'ScorePlayer' + IntToStr(I) + 'Static');
+ ThemeLoadTexts(Score.PlayerTexts[I], 'ScorePlayer' + IntToStr(I) + 'Text');
+
+ ThemeLoadText(Score.TextName[I], 'ScoreTextName' + IntToStr(I));
+ ThemeLoadText(Score.TextScore[I], 'ScoreTextScore' + IntToStr(I));
+ ThemeLoadText(Score.TextNotes[I], 'ScoreTextNotes' + IntToStr(I));
+ ThemeLoadText(Score.TextNotesScore[I], 'ScoreTextNotesScore' + IntToStr(I));
+ ThemeLoadText(Score.TextLineBonus[I], 'ScoreTextLineBonus' + IntToStr(I));
+ ThemeLoadText(Score.TextLineBonusScore[I], 'ScoreTextLineBonusScore' + IntToStr(I));
+ ThemeLoadText(Score.TextGoldenNotes[I], 'ScoreTextGoldenNotes' + IntToStr(I));
+ ThemeLoadText(Score.TextGoldenNotesScore[I], 'ScoreTextGoldenNotesScore' + IntToStr(I));
+ ThemeLoadText(Score.TextTotal[I], 'ScoreTextTotal' + IntToStr(I));
+ ThemeLoadText(Score.TextTotalScore[I], 'ScoreTextTotalScore' + IntToStr(I));
+
+ ThemeLoadStatic(Score.StaticBoxLightest[I], 'ScoreStaticBoxLightest' + IntToStr(I));
+ ThemeLoadStatic(Score.StaticBoxLight[I], 'ScoreStaticBoxLight' + IntToStr(I));
+ ThemeLoadStatic(Score.StaticBoxDark[I], 'ScoreStaticBoxDark' + IntToStr(I));
+
+ ThemeLoadStatic(Score.StaticBackLevel[I], 'ScoreStaticBackLevel' + IntToStr(I));
+ ThemeLoadStatic(Score.StaticBackLevelRound[I], 'ScoreStaticBackLevelRound' + IntToStr(I));
+ ThemeLoadStatic(Score.StaticLevel[I], 'ScoreStaticLevel' + IntToStr(I));
+ ThemeLoadStatic(Score.StaticLevelRound[I], 'ScoreStaticLevelRound' + IntToStr(I));
+
+ ThemeLoadStatic(Score.StaticRatings[I], 'ScoreStaticRatingPicture' + IntToStr(I));
+ end;
+
+ // Top5
+ ThemeLoadBasic(Top5, 'Top5');
+
+ ThemeLoadText(Top5.TextLevel, 'Top5TextLevel');
+ ThemeLoadText(Top5.TextArtistTitle, 'Top5TextArtistTitle');
+ ThemeLoadStatics(Top5.StaticNumber, 'Top5StaticNumber');
+ ThemeLoadTexts(Top5.TextNumber, 'Top5TextNumber');
+ ThemeLoadTexts(Top5.TextName, 'Top5TextName');
+ ThemeLoadTexts(Top5.TextScore, 'Top5TextScore');
+
+ // Options
+ ThemeLoadBasic(Options, 'Options');
+
+ ThemeLoadButton(Options.ButtonGame, 'OptionsButtonGame');
+ ThemeLoadButton(Options.ButtonGraphics, 'OptionsButtonGraphics');
+ ThemeLoadButton(Options.ButtonSound, 'OptionsButtonSound');
+ ThemeLoadButton(Options.ButtonLyrics, 'OptionsButtonLyrics');
+ ThemeLoadButton(Options.ButtonThemes, 'OptionsButtonThemes');
+ ThemeLoadButton(Options.ButtonRecord, 'OptionsButtonRecord');
+ ThemeLoadButton(Options.ButtonAdvanced, 'OptionsButtonAdvanced');
+ ThemeLoadButton(Options.ButtonExit, 'OptionsButtonExit');
+
+ Options.Description[0] := Language.Translate('SING_OPTIONS_GAME_DESC');
+ Options.Description[1] := Language.Translate('SING_OPTIONS_GRAPHICS_DESC');
+ Options.Description[2] := Language.Translate('SING_OPTIONS_SOUND_DESC');
+ Options.Description[3] := Language.Translate('SING_OPTIONS_LYRICS_DESC');
+ Options.Description[4] := Language.Translate('SING_OPTIONS_THEMES_DESC');
+ Options.Description[5] := Language.Translate('SING_OPTIONS_RECORD_DESC');
+ Options.Description[6] := Language.Translate('SING_OPTIONS_ADVANCED_DESC');
+ Options.Description[7] := Language.Translate('SING_OPTIONS_EXIT');
+
+ ThemeLoadText(Options.TextDescription, 'OptionsTextDescription');
+ Options.TextDescription.Text := Options.Description[0];
+
+ // Options Game
+ ThemeLoadBasic(OptionsGame, 'OptionsGame');
+
+ ThemeLoadSelectSlide(OptionsGame.SelectPlayers, 'OptionsGameSelectPlayers');
+ ThemeLoadSelectSlide(OptionsGame.SelectDifficulty, 'OptionsGameSelectDifficulty');
+ ThemeLoadSelectSlide(OptionsGame.SelectLanguage, 'OptionsGameSelectSlideLanguage');
+ ThemeLoadSelectSlide(OptionsGame.SelectTabs, 'OptionsGameSelectTabs');
+ ThemeLoadSelectSlide(OptionsGame.SelectSorting, 'OptionsGameSelectSlideSorting');
+ ThemeLoadSelectSlide(OptionsGame.SelectDebug, 'OptionsGameSelectDebug');
+ ThemeLoadButton(OptionsGame.ButtonExit, 'OptionsGameButtonExit');
+
+ // Options Graphics
+ ThemeLoadBasic(OptionsGraphics, 'OptionsGraphics');
+
+ ThemeLoadSelectSlide(OptionsGraphics.SelectFullscreen, 'OptionsGraphicsSelectFullscreen');
+ ThemeLoadSelectSlide(OptionsGraphics.SelectResolution, 'OptionsGraphicsSelectSlideResolution');
+ ThemeLoadSelectSlide(OptionsGraphics.SelectDepth, 'OptionsGraphicsSelectDepth');
+ ThemeLoadSelectSlide(OptionsGraphics.SelectVisualizer, 'OptionsGraphicsSelectVisualizer');
+ ThemeLoadSelectSlide(OptionsGraphics.SelectOscilloscope, 'OptionsGraphicsSelectOscilloscope');
+ ThemeLoadSelectSlide(OptionsGraphics.SelectLineBonus, 'OptionsGraphicsSelectLineBonus');
+ ThemeLoadSelectSlide(OptionsGraphics.SelectMovieSize, 'OptionsGraphicsSelectMovieSize');
+ ThemeLoadButton(OptionsGraphics.ButtonExit, 'OptionsGraphicsButtonExit');
+
+ // Options Sound
+ ThemeLoadBasic(OptionsSound, 'OptionsSound');
+
+ ThemeLoadSelectSlide(OptionsSound.SelectBackgroundMusic, 'OptionsSoundSelectBackgroundMusic');
+ ThemeLoadSelectSlide(OptionsSound.SelectMicBoost, 'OptionsSoundSelectMicBoost');
+ ThemeLoadSelectSlide(OptionsSound.SelectClickAssist, 'OptionsSoundSelectClickAssist');
+ ThemeLoadSelectSlide(OptionsSound.SelectBeatClick, 'OptionsSoundSelectBeatClick');
+ ThemeLoadSelectSlide(OptionsSound.SelectThreshold, 'OptionsSoundSelectThreshold');
+ //Song Preview
+ ThemeLoadSelectSlide(OptionsSound.SelectSlidePreviewVolume, 'OptionsSoundSelectSlidePreviewVolume');
+ ThemeLoadSelectSlide(OptionsSound.SelectSlidePreviewFading, 'OptionsSoundSelectSlidePreviewFading');
+ ThemeLoadSelectSlide(OptionsSound.SelectSlideVoicePassthrough, 'OptionsSoundSelectVoicePassthrough');
+
+ ThemeLoadButton(OptionsSound.ButtonExit, 'OptionsSoundButtonExit');
+
+ // Options Lyrics
+ ThemeLoadBasic(OptionsLyrics, 'OptionsLyrics');
+
+ ThemeLoadSelectSlide(OptionsLyrics.SelectLyricsFont, 'OptionsLyricsSelectLyricsFont');
+ ThemeLoadSelectSlide(OptionsLyrics.SelectLyricsEffect, 'OptionsLyricsSelectLyricsEffect');
+ //ThemeLoadSelectSlide(OptionsLyrics.SelectSolmization, 'OptionsLyricsSelectSolmization');
+ ThemeLoadSelectSlide(OptionsLyrics.SelectNoteLines, 'OptionsLyricsSelectNoteLines');
+ ThemeLoadButton(OptionsLyrics.ButtonExit, 'OptionsLyricsButtonExit');
+
+ // Options Themes
+ ThemeLoadBasic(OptionsThemes, 'OptionsThemes');
+
+ ThemeLoadSelectSlide(OptionsThemes.SelectTheme, 'OptionsThemesSelectTheme');
+ ThemeLoadSelectSlide(OptionsThemes.SelectSkin, 'OptionsThemesSelectSkin');
+ ThemeLoadSelectSlide(OptionsThemes.SelectColor, 'OptionsThemesSelectColor');
+ ThemeLoadButton(OptionsThemes.ButtonExit, 'OptionsThemesButtonExit');
+
+ // Options Record
+ ThemeLoadBasic(OptionsRecord, 'OptionsRecord');
+
+ ThemeLoadSelectSlide(OptionsRecord.SelectSlideCard, 'OptionsRecordSelectSlideCard');
+ ThemeLoadSelectSlide(OptionsRecord.SelectSlideInput, 'OptionsRecordSelectSlideInput');
+ ThemeLoadSelectSlide(OptionsRecord.SelectSlideChannel, 'OptionsRecordSelectSlideChannel');
+ ThemeLoadButton(OptionsRecord.ButtonExit, 'OptionsRecordButtonExit');
+
+ //Options Advanced
+ ThemeLoadBasic(OptionsAdvanced, 'OptionsAdvanced');
+
+ ThemeLoadSelectSlide(OptionsAdvanced.SelectLoadAnimation, 'OptionsAdvancedSelectLoadAnimation');
+ ThemeLoadSelectSlide(OptionsAdvanced.SelectScreenFade, 'OptionsAdvancedSelectScreenFade');
+ ThemeLoadSelectSlide(OptionsAdvanced.SelectEffectSing, 'OptionsAdvancedSelectEffectSing');
+ ThemeLoadSelectSlide(OptionsAdvanced.SelectLineBonus, 'OptionsAdvancedSelectLineBonus');
+ ThemeLoadSelectSlide(OptionsAdvanced.SelectOnSongClick, 'OptionsAdvancedSelectSlideOnSongClick');
+ ThemeLoadSelectSlide(OptionsAdvanced.SelectAskbeforeDel, 'OptionsAdvancedSelectAskbeforeDel');
+ ThemeLoadSelectSlide(OptionsAdvanced.SelectPartyPopup, 'OptionsAdvancedSelectPartyPopup');
+ ThemeLoadButton (OptionsAdvanced.ButtonExit, 'OptionsAdvancedButtonExit');
+
+ //error and check popup
+ ThemeLoadBasic (ErrorPopup, 'ErrorPopup');
+ ThemeLoadButton(ErrorPopup.Button1, 'ErrorPopupButton1');
+ ThemeLoadText (ErrorPopup.TextError,'ErrorPopupText');
+ ThemeLoadBasic (CheckPopup, 'CheckPopup');
+ ThemeLoadButton(CheckPopup.Button1, 'CheckPopupButton1');
+ ThemeLoadButton(CheckPopup.Button2, 'CheckPopupButton2');
+ ThemeLoadText(CheckPopup.TextCheck , 'CheckPopupText');
+
+ //Song Menu
+ ThemeLoadBasic (SongMenu, 'SongMenu');
+ ThemeLoadButton(SongMenu.Button1, 'SongMenuButton1');
+ ThemeLoadButton(SongMenu.Button2, 'SongMenuButton2');
+ ThemeLoadButton(SongMenu.Button3, 'SongMenuButton3');
+ ThemeLoadButton(SongMenu.Button4, 'SongMenuButton4');
+ ThemeLoadSelectSlide(SongMenu.SelectSlide3, 'SongMenuSelectSlide3');
+
+ ThemeLoadText(SongMenu.TextMenu, 'SongMenuTextMenu');
+
+ //Song Jumpto
+ ThemeLoadBasic (SongJumpto, 'SongJumpto');
+ ThemeLoadButton(SongJumpto.ButtonSearchText, 'SongJumptoButtonSearchText');
+ ThemeLoadSelectSlide(SongJumpto.SelectSlideType, 'SongJumptoSelectSlideType');
+ ThemeLoadText(SongJumpto.TextFound, 'SongJumptoTextFound');
+ //Translations
+ SongJumpto.IType[0] := Language.Translate('SONG_JUMPTO_TYPE1');
+ SongJumpto.IType[1] := Language.Translate('SONG_JUMPTO_TYPE2');
+ SongJumpto.IType[2] := Language.Translate('SONG_JUMPTO_TYPE3');
+ SongJumpto.SongsFound := Language.Translate('SONG_JUMPTO_SONGSFOUND');
+ SongJumpto.NoSongsFound := Language.Translate('SONG_JUMPTO_NOSONGSFOUND');
+ SongJumpto.CatText := Language.Translate('SONG_JUMPTO_CATTEXT');
+
+ //Party Screens:
+ //Party NewRound
+ ThemeLoadBasic(PartyNewRound, 'PartyNewRound');
+
+ ThemeLoadText (PartyNewRound.TextRound1, 'PartyNewRoundTextRound1');
+ ThemeLoadText (PartyNewRound.TextRound2, 'PartyNewRoundTextRound2');
+ ThemeLoadText (PartyNewRound.TextRound3, 'PartyNewRoundTextRound3');
+ ThemeLoadText (PartyNewRound.TextRound4, 'PartyNewRoundTextRound4');
+ ThemeLoadText (PartyNewRound.TextRound5, 'PartyNewRoundTextRound5');
+ ThemeLoadText (PartyNewRound.TextRound6, 'PartyNewRoundTextRound6');
+ ThemeLoadText (PartyNewRound.TextRound7, 'PartyNewRoundTextRound7');
+ ThemeLoadText (PartyNewRound.TextWinner1, 'PartyNewRoundTextWinner1');
+ ThemeLoadText (PartyNewRound.TextWinner2, 'PartyNewRoundTextWinner2');
+ ThemeLoadText (PartyNewRound.TextWinner3, 'PartyNewRoundTextWinner3');
+ ThemeLoadText (PartyNewRound.TextWinner4, 'PartyNewRoundTextWinner4');
+ ThemeLoadText (PartyNewRound.TextWinner5, 'PartyNewRoundTextWinner5');
+ ThemeLoadText (PartyNewRound.TextWinner6, 'PartyNewRoundTextWinner6');
+ ThemeLoadText (PartyNewRound.TextWinner7, 'PartyNewRoundTextWinner7');
+ ThemeLoadText (PartyNewRound.TextNextRound, 'PartyNewRoundTextNextRound');
+ ThemeLoadText (PartyNewRound.TextNextRoundNo, 'PartyNewRoundTextNextRoundNo');
+ ThemeLoadText (PartyNewRound.TextNextPlayer1, 'PartyNewRoundTextNextPlayer1');
+ ThemeLoadText (PartyNewRound.TextNextPlayer2, 'PartyNewRoundTextNextPlayer2');
+ ThemeLoadText (PartyNewRound.TextNextPlayer3, 'PartyNewRoundTextNextPlayer3');
+
+ ThemeLoadStatic (PartyNewRound.StaticRound1, 'PartyNewRoundStaticRound1');
+ ThemeLoadStatic (PartyNewRound.StaticRound2, 'PartyNewRoundStaticRound2');
+ ThemeLoadStatic (PartyNewRound.StaticRound3, 'PartyNewRoundStaticRound3');
+ ThemeLoadStatic (PartyNewRound.StaticRound4, 'PartyNewRoundStaticRound4');
+ ThemeLoadStatic (PartyNewRound.StaticRound5, 'PartyNewRoundStaticRound5');
+ ThemeLoadStatic (PartyNewRound.StaticRound6, 'PartyNewRoundStaticRound6');
+ ThemeLoadStatic (PartyNewRound.StaticRound7, 'PartyNewRoundStaticRound7');
+
+ ThemeLoadText (PartyNewRound.TextScoreTeam1, 'PartyNewRoundTextScoreTeam1');
+ ThemeLoadText (PartyNewRound.TextScoreTeam2, 'PartyNewRoundTextScoreTeam2');
+ ThemeLoadText (PartyNewRound.TextScoreTeam3, 'PartyNewRoundTextScoreTeam3');
+ ThemeLoadText (PartyNewRound.TextNameTeam1, 'PartyNewRoundTextNameTeam1');
+ ThemeLoadText (PartyNewRound.TextNameTeam2, 'PartyNewRoundTextNameTeam2');
+ ThemeLoadText (PartyNewRound.TextNameTeam3, 'PartyNewRoundTextNameTeam3');
+
+ ThemeLoadText (PartyNewRound.TextTeam1Players, 'PartyNewRoundTextTeam1Players');
+ ThemeLoadText (PartyNewRound.TextTeam2Players, 'PartyNewRoundTextTeam2Players');
+ ThemeLoadText (PartyNewRound.TextTeam3Players, 'PartyNewRoundTextTeam3Players');
+
+ ThemeLoadStatic (PartyNewRound.StaticTeam1, 'PartyNewRoundStaticTeam1');
+ ThemeLoadStatic (PartyNewRound.StaticTeam2, 'PartyNewRoundStaticTeam2');
+ ThemeLoadStatic (PartyNewRound.StaticTeam3, 'PartyNewRoundStaticTeam3');
+ ThemeLoadStatic (PartyNewRound.StaticNextPlayer1, 'PartyNewRoundStaticNextPlayer1');
+ ThemeLoadStatic (PartyNewRound.StaticNextPlayer2, 'PartyNewRoundStaticNextPlayer2');
+ ThemeLoadStatic (PartyNewRound.StaticNextPlayer3, 'PartyNewRoundStaticNextPlayer3');
+
+ //Party Score
+ ThemeLoadBasic(PartyScore, 'PartyScore');
+
+ ThemeLoadText (PartyScore.TextScoreTeam1, 'PartyScoreTextScoreTeam1');
+ ThemeLoadText (PartyScore.TextScoreTeam2, 'PartyScoreTextScoreTeam2');
+ ThemeLoadText (PartyScore.TextScoreTeam3, 'PartyScoreTextScoreTeam3');
+ ThemeLoadText (PartyScore.TextNameTeam1, 'PartyScoreTextNameTeam1');
+ ThemeLoadText (PartyScore.TextNameTeam2, 'PartyScoreTextNameTeam2');
+ ThemeLoadText (PartyScore.TextNameTeam3, 'PartyScoreTextNameTeam3');
+
+ ThemeLoadStatic (PartyScore.StaticTeam1, 'PartyScoreStaticTeam1');
+ ThemeLoadStatic (PartyScore.StaticTeam1BG, 'PartyScoreStaticTeam1BG');
+ ThemeLoadStatic (PartyScore.StaticTeam1Deco, 'PartyScoreStaticTeam1Deco');
+ ThemeLoadStatic (PartyScore.StaticTeam2, 'PartyScoreStaticTeam2');
+ ThemeLoadStatic (PartyScore.StaticTeam2BG, 'PartyScoreStaticTeam2BG');
+ ThemeLoadStatic (PartyScore.StaticTeam2Deco, 'PartyScoreStaticTeam2Deco');
+ ThemeLoadStatic (PartyScore.StaticTeam3, 'PartyScoreStaticTeam3');
+ ThemeLoadStatic (PartyScore.StaticTeam3BG, 'PartyScoreStaticTeam3BG');
+ ThemeLoadStatic (PartyScore.StaticTeam3Deco, 'PartyScoreStaticTeam3Deco');
+
+ //Load Party Score DecoTextures Object
+ PartyScore.DecoTextures.ChangeTextures := (ThemeIni.ReadInteger('PartyScoreDecoTextures', 'ChangeTextures', 0) = 1);
+ PartyScore.DecoTextures.FirstTexture := ThemeIni.ReadString('PartyScoreDecoTextures', 'FirstTexture', '');
+ PartyScore.DecoTextures.FirstTyp := ParseTextureType(ThemeIni.ReadString('PartyScoreDecoTextures', 'FirstTyp', ''), TEXTURE_TYPE_COLORIZED);
+ PartyScore.DecoTextures.FirstColor := ThemeIni.ReadString('PartyScoreDecoTextures', 'FirstColor', 'Black');
+
+ PartyScore.DecoTextures.SecondTexture := ThemeIni.ReadString('PartyScoreDecoTextures', 'SecondTexture', '');
+ PartyScore.DecoTextures.SecondTyp := ParseTextureType(ThemeIni.ReadString('PartyScoreDecoTextures', 'SecondTyp', ''), TEXTURE_TYPE_COLORIZED);
+ PartyScore.DecoTextures.SecondColor := ThemeIni.ReadString('PartyScoreDecoTextures', 'SecondColor', 'Black');
+
+ PartyScore.DecoTextures.ThirdTexture := ThemeIni.ReadString('PartyScoreDecoTextures', 'ThirdTexture', '');
+ PartyScore.DecoTextures.ThirdTyp := ParseTextureType(ThemeIni.ReadString('PartyScoreDecoTextures', 'ThirdTyp', ''), TEXTURE_TYPE_COLORIZED);
+ PartyScore.DecoTextures.ThirdColor := ThemeIni.ReadString('PartyScoreDecoTextures', 'ThirdColor', 'Black');
+
+ ThemeLoadText (PartyScore.TextWinner, 'PartyScoreTextWinner');
+
+ //Party Win
+ ThemeLoadBasic(PartyWin, 'PartyWin');
+
+ ThemeLoadText (PartyWin.TextScoreTeam1, 'PartyWinTextScoreTeam1');
+ ThemeLoadText (PartyWin.TextScoreTeam2, 'PartyWinTextScoreTeam2');
+ ThemeLoadText (PartyWin.TextScoreTeam3, 'PartyWinTextScoreTeam3');
+ ThemeLoadText (PartyWin.TextNameTeam1, 'PartyWinTextNameTeam1');
+ ThemeLoadText (PartyWin.TextNameTeam2, 'PartyWinTextNameTeam2');
+ ThemeLoadText (PartyWin.TextNameTeam3, 'PartyWinTextNameTeam3');
+
+ ThemeLoadStatic (PartyWin.StaticTeam1, 'PartyWinStaticTeam1');
+ ThemeLoadStatic (PartyWin.StaticTeam1BG, 'PartyWinStaticTeam1BG');
+ ThemeLoadStatic (PartyWin.StaticTeam1Deco, 'PartyWinStaticTeam1Deco');
+ ThemeLoadStatic (PartyWin.StaticTeam2, 'PartyWinStaticTeam2');
+ ThemeLoadStatic (PartyWin.StaticTeam2BG, 'PartyWinStaticTeam2BG');
+ ThemeLoadStatic (PartyWin.StaticTeam2Deco, 'PartyWinStaticTeam2Deco');
+ ThemeLoadStatic (PartyWin.StaticTeam3, 'PartyWinStaticTeam3');
+ ThemeLoadStatic (PartyWin.StaticTeam3BG, 'PartyWinStaticTeam3BG');
+ ThemeLoadStatic (PartyWin.StaticTeam3Deco, 'PartyWinStaticTeam3Deco');
+
+ ThemeLoadText (PartyWin.TextWinner, 'PartyWinTextWinner');
+
+ //Party Options
+ ThemeLoadBasic(PartyOptions, 'PartyOptions');
+ ThemeLoadSelectSlide(PartyOptions.SelectLevel, 'PartyOptionsSelectLevel');
+ ThemeLoadSelectSlide(PartyOptions.SelectPlayList, 'PartyOptionsSelectPlayList');
+ ThemeLoadSelectSlide(PartyOptions.SelectPlayList2, 'PartyOptionsSelectPlayList2');
+ ThemeLoadSelectSlide(PartyOptions.SelectRounds, 'PartyOptionsSelectRounds');
+ ThemeLoadSelectSlide(PartyOptions.SelectTeams, 'PartyOptionsSelectTeams');
+ ThemeLoadSelectSlide(PartyOptions.SelectPlayers1, 'PartyOptionsSelectPlayers1');
+ ThemeLoadSelectSlide(PartyOptions.SelectPlayers2, 'PartyOptionsSelectPlayers2');
+ ThemeLoadSelectSlide(PartyOptions.SelectPlayers3, 'PartyOptionsSelectPlayers3');
+
+ {ThemeLoadButton (ButtonNext, 'ButtonNext');
+ ThemeLoadButton (ButtonPrev, 'ButtonPrev');}
+
+ //Party Player
+ ThemeLoadBasic(PartyPlayer, 'PartyPlayer');
+ ThemeLoadButton(PartyPlayer.Team1Name, 'PartyPlayerTeam1Name');
+ ThemeLoadButton(PartyPlayer.Player1Name, 'PartyPlayerPlayer1Name');
+ ThemeLoadButton(PartyPlayer.Player2Name, 'PartyPlayerPlayer2Name');
+ ThemeLoadButton(PartyPlayer.Player3Name, 'PartyPlayerPlayer3Name');
+ ThemeLoadButton(PartyPlayer.Player4Name, 'PartyPlayerPlayer4Name');
+
+ ThemeLoadButton(PartyPlayer.Team2Name, 'PartyPlayerTeam2Name');
+ ThemeLoadButton(PartyPlayer.Player5Name, 'PartyPlayerPlayer5Name');
+ ThemeLoadButton(PartyPlayer.Player6Name, 'PartyPlayerPlayer6Name');
+ ThemeLoadButton(PartyPlayer.Player7Name, 'PartyPlayerPlayer7Name');
+ ThemeLoadButton(PartyPlayer.Player8Name, 'PartyPlayerPlayer8Name');
+
+ ThemeLoadButton(PartyPlayer.Team3Name, 'PartyPlayerTeam3Name');
+ ThemeLoadButton(PartyPlayer.Player9Name, 'PartyPlayerPlayer9Name');
+ ThemeLoadButton(PartyPlayer.Player10Name, 'PartyPlayerPlayer10Name');
+ ThemeLoadButton(PartyPlayer.Player11Name, 'PartyPlayerPlayer11Name');
+ ThemeLoadButton(PartyPlayer.Player12Name, 'PartyPlayerPlayer12Name');
+
+ {ThemeLoadButton(ButtonNext, 'PartyPlayerButtonNext');
+ ThemeLoadButton(ButtonPrev, 'PartyPlayerButtonPrev');}
+
+ ThemeLoadBasic(StatMain, 'StatMain');
+
+ ThemeLoadButton(StatMain.ButtonScores, 'StatMainButtonScores');
+ ThemeLoadButton(StatMain.ButtonSingers, 'StatMainButtonSingers');
+ ThemeLoadButton(StatMain.ButtonSongs, 'StatMainButtonSongs');
+ ThemeLoadButton(StatMain.ButtonBands, 'StatMainButtonBands');
+ ThemeLoadButton(StatMain.ButtonExit, 'StatMainButtonExit');
+
+ ThemeLoadText (StatMain.TextOverview, 'StatMainTextOverview');
+
+
+ ThemeLoadBasic(StatDetail, 'StatDetail');
+
+ ThemeLoadButton(StatDetail.ButtonNext, 'StatDetailButtonNext');
+ ThemeLoadButton(StatDetail.ButtonPrev, 'StatDetailButtonPrev');
+ ThemeLoadButton(StatDetail.ButtonReverse, 'StatDetailButtonReverse');
+ ThemeLoadButton(StatDetail.ButtonExit, 'StatDetailButtonExit');
+
+ ThemeLoadText (StatDetail.TextDescription, 'StatDetailTextDescription');
+ ThemeLoadText (StatDetail.TextPage, 'StatDetailTextPage');
+ ThemeLoadTexts(StatDetail.TextList, 'StatDetailTextList');
+
+ //Translate Texts
+ StatDetail.Description[0] := Language.Translate('STAT_DESC_SCORES');
+ StatDetail.Description[1] := Language.Translate('STAT_DESC_SINGERS');
+ StatDetail.Description[2] := Language.Translate('STAT_DESC_SONGS');
+ StatDetail.Description[3] := Language.Translate('STAT_DESC_BANDS');
+
+ StatDetail.DescriptionR[0] := Language.Translate('STAT_DESC_SCORES_REVERSED');
+ StatDetail.DescriptionR[1] := Language.Translate('STAT_DESC_SINGERS_REVERSED');
+ StatDetail.DescriptionR[2] := Language.Translate('STAT_DESC_SONGS_REVERSED');
+ StatDetail.DescriptionR[3] := Language.Translate('STAT_DESC_BANDS_REVERSED');
+
+ StatDetail.FormatStr[0] := Language.Translate('STAT_FORMAT_SCORES');
+ StatDetail.FormatStr[1] := Language.Translate('STAT_FORMAT_SINGERS');
+ StatDetail.FormatStr[2] := Language.Translate('STAT_FORMAT_SONGS');
+ StatDetail.FormatStr[3] := Language.Translate('STAT_FORMAT_BANDS');
+
+ StatDetail.PageStr := Language.Translate('STAT_PAGE');
+
+ //Playlist Translations
+ Playlist.CatText := Language.Translate('PLAYLIST_CATTEXT');
+
+ //Level Translations
+ //Fill ILevel
+ ILevel[0] := Language.Translate('SING_EASY');
+ ILevel[1] := Language.Translate('SING_MEDIUM');
+ ILevel[2] := Language.Translate('SING_HARD');
+ end;
+
+ ThemeIni.Free;
+ end;
+end;
+
+procedure TTheme.ThemeLoadBasic(Theme: TThemeBasic; Name: string);
+begin
+ ThemeLoadBackground(Theme.Background, Name);
+ ThemeLoadTexts(Theme.Text, Name + 'Text');
+ ThemeLoadStatics(Theme.Static, Name + 'Static');
+ ThemeLoadButtonCollections(Theme.ButtonCollection, Name + 'ButtonCollection');
+
+ LastThemeBasic := Theme;
+end;
+
+procedure TTheme.ThemeLoadBackground(var ThemeBackground: TThemeBackground; Name: string);
+begin
+ ThemeBackground.Tex := ThemeIni.ReadString(Name + 'Background', 'Tex', '');
+end;
+
+procedure TTheme.ThemeLoadText(var ThemeText: TThemeText; Name: string);
+var
+ C: integer;
+begin
+ ThemeText.X := ThemeIni.ReadInteger(Name, 'X', 0);
+ ThemeText.Y := ThemeIni.ReadInteger(Name, 'Y', 0);
+ ThemeText.W := ThemeIni.ReadInteger(Name, 'W', 0);
+
+ ThemeText.Z := ThemeIni.ReadFloat(Name, 'Z', 0);
+
+ ThemeText.ColR := ThemeIni.ReadFloat(Name, 'ColR', 0);
+ ThemeText.ColG := ThemeIni.ReadFloat(Name, 'ColG', 0);
+ ThemeText.ColB := ThemeIni.ReadFloat(Name, 'ColB', 0);
+
+ ThemeText.Font := ThemeIni.ReadInteger(Name, 'Font', 0);
+ ThemeText.Size := ThemeIni.ReadInteger(Name, 'Size', 0);
+ ThemeText.Align := ThemeIni.ReadInteger(Name, 'Align', 0);
+
+ ThemeText.Text := Language.Translate(ThemeIni.ReadString(Name, 'Text', ''));
+ ThemeText.Color := ThemeIni.ReadString(Name, 'Color', '');
+
+ //Reflection
+ ThemeText.Reflection := (ThemeIni.ReadInteger(Name, 'Reflection', 0)) = 1;
+ ThemeText.Reflectionspacing := ThemeIni.ReadFloat(Name, 'ReflectionSpacing', 15);
+
+ C := ColorExists(ThemeText.Color);
+ if C >= 0 then begin
+ ThemeText.ColR := Color[C].RGB.R;
+ ThemeText.ColG := Color[C].RGB.G;
+ ThemeText.ColB := Color[C].RGB.B;
+ end;
+end;
+
+procedure TTheme.ThemeLoadTexts(var ThemeText: AThemeText; Name: string);
+var
+ T: integer;
+begin
+ T := 1;
+ while ThemeIni.SectionExists(Name + IntToStr(T)) do begin
+ SetLength(ThemeText, T);
+ ThemeLoadText(ThemeText[T-1], Name + IntToStr(T));
+ Inc(T);
+ end;
+end;
+
+procedure TTheme.ThemeLoadStatic(var ThemeStatic: TThemeStatic; Name: string);
+var
+ C: integer;
+begin
+ ThemeStatic.Tex := ThemeIni.ReadString(Name, 'Tex', '');
+
+ ThemeStatic.X := ThemeIni.ReadInteger(Name, 'X', 0);
+ ThemeStatic.Y := ThemeIni.ReadInteger(Name, 'Y', 0);
+ ThemeStatic.Z := ThemeIni.ReadFloat (Name, 'Z', 0);
+ ThemeStatic.W := ThemeIni.ReadInteger(Name, 'W', 0);
+ ThemeStatic.H := ThemeIni.ReadInteger(Name, 'H', 0);
+
+ ThemeStatic.Typ := ParseTextureType(ThemeIni.ReadString(Name, 'Type', ''), TEXTURE_TYPE_PLAIN);
+ ThemeStatic.Color := ThemeIni.ReadString(Name, 'Color', '');
+
+ C := ColorExists(ThemeStatic.Color);
+ if C >= 0 then begin
+ ThemeStatic.ColR := Color[C].RGB.R;
+ ThemeStatic.ColG := Color[C].RGB.G;
+ ThemeStatic.ColB := Color[C].RGB.B;
+ end;
+
+ ThemeStatic.TexX1 := ThemeIni.ReadFloat(Name, 'TexX1', 0);
+ ThemeStatic.TexY1 := ThemeIni.ReadFloat(Name, 'TexY1', 0);
+ ThemeStatic.TexX2 := ThemeIni.ReadFloat(Name, 'TexX2', 1);
+ ThemeStatic.TexY2 := ThemeIni.ReadFloat(Name, 'TexY2', 1);
+
+ //Reflection Mod
+ ThemeStatic.Reflection := (ThemeIni.ReadInteger(Name, 'Reflection', 0) = 1);
+ ThemeStatic.ReflectionSpacing := ThemeIni.ReadFloat(Name, 'ReflectionSpacing', 15);
+end;
+
+procedure TTheme.ThemeLoadStatics(var ThemeStatic: AThemeStatic; Name: string);
+var
+ S: integer;
+begin
+ S := 1;
+ while ThemeIni.SectionExists(Name + IntToStr(S)) do begin
+ SetLength(ThemeStatic, S);
+ ThemeLoadStatic(ThemeStatic[S-1], Name + IntToStr(S));
+ Inc(S);
+ end;
+end;
+
+//Button Collection Mod
+procedure TTheme.ThemeLoadButtonCollection(var Collection: TThemeButtonCollection; Name: string);
+var T: Integer;
+begin
+ //Load Collection Style
+ ThemeLoadButton(Collection.Style, Name);
+
+ //Load Other Attributes
+ T := ThemeIni.ReadInteger (Name, 'FirstChild', 0);
+ if (T > 0) And (T < 256) then
+ Collection.FirstChild := T
+ else
+ Collection.FirstChild := 0;
+end;
+
+procedure TTheme.ThemeLoadButtonCollections(var Collections: AThemeButtonCollection; Name: string);
+var
+ I: integer;
+begin
+ I := 1;
+ while ThemeIni.SectionExists(Name + IntToStr(I)) do begin
+ SetLength(Collections, I);
+ ThemeLoadButtonCollection(Collections[I-1], Name + IntToStr(I));
+ Inc(I);
+ end;
+end;
+//End Button Collection Mod
+
+procedure TTheme.ThemeLoadButton(var ThemeButton: TThemeButton; Name: string; const Collections: PAThemeButtonCollection);
+var
+ C: integer;
+ TLen: integer;
+ T: integer;
+ Collections2: PAThemeButtonCollection;
+begin
+ if not ThemeIni.SectionExists(Name) then
+ begin
+ ThemeButton.Visible := False;
+ exit;
+ end;
+ ThemeButton.Tex := ThemeIni.ReadString(Name, 'Tex', '');
+ ThemeButton.X := ThemeIni.ReadInteger (Name, 'X', 0);
+ ThemeButton.Y := ThemeIni.ReadInteger (Name, 'Y', 0);
+ ThemeButton.Z := ThemeIni.ReadFloat (Name, 'Z', 0);
+ ThemeButton.W := ThemeIni.ReadInteger (Name, 'W', 0);
+ ThemeButton.H := ThemeIni.ReadInteger (Name, 'H', 0);
+ ThemeButton.Typ := ParseTextureType(ThemeIni.ReadString(Name, 'Type', ''), TEXTURE_TYPE_PLAIN);
+
+ //Reflection Mod
+ ThemeButton.Reflection := (ThemeIni.ReadInteger(Name, 'Reflection', 0) = 1);
+ ThemeButton.ReflectionSpacing := ThemeIni.ReadFloat(Name, 'ReflectionSpacing', 15);
+
+ ThemeButton.ColR := ThemeIni.ReadFloat(Name, 'ColR', 1);
+ ThemeButton.ColG := ThemeIni.ReadFloat(Name, 'ColG', 1);
+ ThemeButton.ColB := ThemeIni.ReadFloat(Name, 'ColB', 1);
+ ThemeButton.Int := ThemeIni.ReadFloat(Name, 'Int', 1);
+ ThemeButton.DColR := ThemeIni.ReadFloat(Name, 'DColR', 1);
+ ThemeButton.DColG := ThemeIni.ReadFloat(Name, 'DColG', 1);
+ ThemeButton.DColB := ThemeIni.ReadFloat(Name, 'DColB', 1);
+ ThemeButton.DInt := ThemeIni.ReadFloat(Name, 'DInt', 1);
+
+ ThemeButton.Color := ThemeIni.ReadString(Name, 'Color', '');
+ C := ColorExists(ThemeButton.Color);
+ if C >= 0 then begin
+ ThemeButton.ColR := Color[C].RGB.R;
+ ThemeButton.ColG := Color[C].RGB.G;
+ ThemeButton.ColB := Color[C].RGB.B;
+ end;
+
+ ThemeButton.DColor := ThemeIni.ReadString(Name, 'DColor', '');
+ C := ColorExists(ThemeButton.DColor);
+ if C >= 0 then begin
+ ThemeButton.DColR := Color[C].RGB.R;
+ ThemeButton.DColG := Color[C].RGB.G;
+ ThemeButton.DColB := Color[C].RGB.B;
+ end;
+
+ ThemeButton.Visible := (ThemeIni.ReadInteger(Name, 'Visible', 1) = 1);
+
+ //Fade Mod
+ ThemeButton.SelectH := ThemeIni.ReadInteger (Name, 'SelectH', ThemeButton.H);
+ ThemeButton.SelectW := ThemeIni.ReadInteger (Name, 'SelectW', ThemeButton.W);
+
+ ThemeButton.DeSelectReflectionspacing := ThemeIni.ReadFloat(Name, 'DeSelectReflectionSpacing', ThemeButton.Reflectionspacing);
+
+ ThemeButton.Fade := (ThemeIni.ReadInteger(Name, 'Fade', 0) = 1);
+ ThemeButton.FadeText := (ThemeIni.ReadInteger(Name, 'FadeText', 0) = 1);
+
+
+ ThemeButton.FadeTex := ThemeIni.ReadString(Name, 'FadeTex', '');
+ ThemeButton.FadeTexPos:= ThemeIni.ReadInteger(Name, 'FadeTexPos', 0);
+ if (ThemeButton.FadeTexPos > 4) Or (ThemeButton.FadeTexPos < 0) then
+ ThemeButton.FadeTexPos := 0;
+
+ //Button Collection Mod
+ T := ThemeIni.ReadInteger(Name, 'Parent', 0);
+
+ //Set Collections to Last Basic Collections if no valid Value
+ if (Collections = nil) then
+ Collections2 := @LastThemeBasic.ButtonCollection
+ else
+ Collections2 := Collections;
+ //Test for valid Value
+ if (Collections2 <> nil) AND (T > 0) AND (T <= Length(Collections2^)) then
+ begin
+ Inc(Collections2^[T-1].ChildCount);
+ ThemeButton.Parent := T;
+ end
+ else
+ ThemeButton.Parent := 0;
+
+ //Read ButtonTexts
+ TLen := ThemeIni.ReadInteger(Name, 'Texts', 0);
+ SetLength(ThemeButton.Text, TLen);
+ for T := 1 to TLen do
+ ThemeLoadText(ThemeButton.Text[T-1], Name + 'Text' + IntToStr(T));
+end;
+
+procedure TTheme.ThemeLoadSelectSlide(var ThemeSelectS: TThemeSelectSlide; Name: string);
+var
+ C: integer;
+begin
+ ThemeSelectS.Text := Language.Translate(ThemeIni.ReadString(Name, 'Text', ''));
+
+ ThemeSelectS.Tex := {Skin.SkinPath + }ThemeIni.ReadString(Name, 'Tex', '');
+ ThemeSelectS.TexSBG := {Skin.SkinPath + }ThemeIni.ReadString(Name, 'TexSBG', '');
+
+ ThemeSelectS.X := ThemeIni.ReadInteger(Name, 'X', 0);
+ ThemeSelectS.Y := ThemeIni.ReadInteger(Name, 'Y', 0);
+ ThemeSelectS.W := ThemeIni.ReadInteger(Name, 'W', 0);
+ ThemeSelectS.H := ThemeIni.ReadInteger(Name, 'H', 0);
+
+ ThemeSelectS.Z := ThemeIni.ReadFloat(Name, 'Z', 0);
+
+ ThemeSelectS.TextSize := ThemeIni.ReadInteger(Name, 'TextSize', 10);
+
+ ThemeSelectS.SkipX := ThemeIni.ReadInteger(Name, 'SkipX', 0);
+
+ ThemeSelectS.SBGW := ThemeIni.ReadInteger(Name, 'SBGW', 450);
+
+ LoadColor(ThemeSelectS.ColR, ThemeSelectS.ColG, ThemeSelectS.ColB, ThemeIni.ReadString(Name, 'Color', ''));
+ ThemeSelectS.Int := ThemeIni.ReadFloat(Name, 'Int', 1);
+ LoadColor(ThemeSelectS.DColR, ThemeSelectS.DColG, ThemeSelectS.DColB, ThemeIni.ReadString(Name, 'DColor', ''));
+ ThemeSelectS.DInt := ThemeIni.ReadFloat(Name, 'DInt', 1);
+
+ LoadColor(ThemeSelectS.TColR, ThemeSelectS.TColG, ThemeSelectS.TColB, ThemeIni.ReadString(Name, 'TColor', ''));
+ ThemeSelectS.TInt := ThemeIni.ReadFloat(Name, 'TInt', 1);
+ LoadColor(ThemeSelectS.TDColR, ThemeSelectS.TDColG, ThemeSelectS.TDColB, ThemeIni.ReadString(Name, 'TDColor', ''));
+ ThemeSelectS.TDInt := ThemeIni.ReadFloat(Name, 'TDInt', 1);
+
+ LoadColor(ThemeSelectS.SBGColR, ThemeSelectS.SBGColG, ThemeSelectS.SBGColB, ThemeIni.ReadString(Name, 'SBGColor', ''));
+ ThemeSelectS.SBGInt := ThemeIni.ReadFloat(Name, 'SBGInt', 1);
+ LoadColor(ThemeSelectS.SBGDColR, ThemeSelectS.SBGDColG, ThemeSelectS.SBGDColB, ThemeIni.ReadString(Name, 'SBGDColor', ''));
+ ThemeSelectS.SBGDInt := ThemeIni.ReadFloat(Name, 'SBGDInt', 1);
+
+ LoadColor(ThemeSelectS.STColR, ThemeSelectS.STColG, ThemeSelectS.STColB, ThemeIni.ReadString(Name, 'STColor', ''));
+ ThemeSelectS.STInt := ThemeIni.ReadFloat(Name, 'STInt', 1);
+ LoadColor(ThemeSelectS.STDColR, ThemeSelectS.STDColG, ThemeSelectS.STDColB, ThemeIni.ReadString(Name, 'STDColor', ''));
+ ThemeSelectS.STDInt := ThemeIni.ReadFloat(Name, 'STDInt', 1);
+end;
+
+procedure TTheme.LoadColors;
+var
+ SL: TStringList;
+ C: integer;
+ S: string;
+ Col: integer;
+ RGB: TRGB;
+begin
+ SL := TStringList.Create;
+ ThemeIni.ReadSection('Colors', SL);
+
+ // normal colors
+ SetLength(Color, SL.Count);
+ for C := 0 to SL.Count-1 do begin
+ Color[C].Name := SL.Strings[C];
+
+ S := ThemeIni.ReadString('Colors', SL.Strings[C], '');
+
+ Color[C].RGB.R := StrToInt(Copy(S, 1, Pos(' ' , S)-1))/255;
+ Delete(S, 1, Pos(' ', S));
+
+ Color[C].RGB.G := StrToInt(Copy(S, 1, Pos(' ' , S)-1))/255;
+ Delete(S, 1, Pos(' ', S));
+
+ Color[C].RGB.B := StrToInt(S)/255;
+ end;
+
+ // skin color
+ SetLength(Color, SL.Count + 3);
+ C := SL.Count;
+ Color[C].Name := 'ColorDark';
+ Color[C].RGB := GetSystemColor(Skin.Color); //Ini.Color);
+
+ C := C+1;
+ Color[C].Name := 'ColorLight';
+ Color[C].RGB := ColorSqrt(Color[C-1].RGB);
+
+ C := C+1;
+ Color[C].Name := 'ColorLightest';
+ Color[C].RGB := ColorSqrt(Color[C-1].RGB);
+
+ // players colors
+ SetLength(Color, Length(Color)+18);
+
+ // P1
+ C := C+1;
+ Color[C].Name := 'P1Dark';
+ Color[C].RGB := GetSystemColor(0); // 0 - blue
+
+ C := C+1;
+ Color[C].Name := 'P1Light';
+ Color[C].RGB := ColorSqrt(Color[C-1].RGB);
+
+ C := C+1;
+ Color[C].Name := 'P1Lightest';
+ Color[C].RGB := ColorSqrt(Color[C-1].RGB);
+
+ // P2
+ C := C+1;
+ Color[C].Name := 'P2Dark';
+ Color[C].RGB := GetSystemColor(3); // 3 - red
+
+ C := C+1;
+ Color[C].Name := 'P2Light';
+ Color[C].RGB := ColorSqrt(Color[C-1].RGB);
+
+ C := C+1;
+ Color[C].Name := 'P2Lightest';
+ Color[C].RGB := ColorSqrt(Color[C-1].RGB);
+
+ // P3
+ C := C+1;
+ Color[C].Name := 'P3Dark';
+ Color[C].RGB := GetSystemColor(1); // 1 - green
+
+ C := C+1;
+ Color[C].Name := 'P3Light';
+ Color[C].RGB := ColorSqrt(Color[C-1].RGB);
+
+ C := C+1;
+ Color[C].Name := 'P3Lightest';
+ Color[C].RGB := ColorSqrt(Color[C-1].RGB);
+
+ // P4
+ C := C+1;
+ Color[C].Name := 'P4Dark';
+ Color[C].RGB := GetSystemColor(4); // 4 - brown
+
+ C := C+1;
+ Color[C].Name := 'P4Light';
+ Color[C].RGB := ColorSqrt(Color[C-1].RGB);
+
+ C := C+1;
+ Color[C].Name := 'P4Lightest';
+ Color[C].RGB := ColorSqrt(Color[C-1].RGB);
+
+ // P5
+ C := C+1;
+ Color[C].Name := 'P5Dark';
+ Color[C].RGB := GetSystemColor(5); // 5 - yellow
+
+ C := C+1;
+ Color[C].Name := 'P5Light';
+ Color[C].RGB := ColorSqrt(Color[C-1].RGB);
+
+ C := C+1;
+ Color[C].Name := 'P5Lightest';
+ Color[C].RGB := ColorSqrt(Color[C-1].RGB);
+
+ // P6
+ C := C+1;
+ Color[C].Name := 'P6Dark';
+ Color[C].RGB := GetSystemColor(6); // 6 - violet
+
+ C := C+1;
+ Color[C].Name := 'P6Light';
+ Color[C].RGB := ColorSqrt(Color[C-1].RGB);
+
+ C := C+1;
+ Color[C].Name := 'P6Lightest';
+ Color[C].RGB := ColorSqrt(Color[C-1].RGB);
+
+
+ SL.Free;
+end;
+
+function ColorExists(Name: string): integer;
+var
+ C: integer;
+begin
+ Result := -1;
+ for C := 0 to High(Color) do
+ if Color[C].Name = Name then Result := C;
+end;
+
+procedure LoadColor(var R, G, B: real; ColorName: string);
+var
+ C: integer;
+begin
+ C := ColorExists(ColorName);
+ if C >= 0 then begin
+ R := Color[C].RGB.R;
+ G := Color[C].RGB.G;
+ B := Color[C].RGB.B;
+ end;
+end;
+
+function GetSystemColor(Color: integer): TRGB;
+begin
+ case Color of
+ 0: begin
+ // blue
+ Result.R := 71/255;
+ Result.G := 175/255;
+ Result.B := 247/255;
+ end;
+ 1: begin
+ // green
+ Result.R := 63/255;
+ Result.G := 191/255;
+ Result.B := 63/255;
+ end;
+ 2: begin
+ // pink
+ Result.R := 255/255;
+{ Result.G := 63/255;
+ Result.B := 192/255;}
+ Result.G := 175/255;
+ Result.B := 247/255;
+ end;
+ 3: begin
+ // red
+ Result.R := 247/255;
+ Result.G := 71/255;
+ Result.B := 71/255;
+ end;
+ //'Violet', 'Orange', 'Yellow', 'Brown', 'Black'
+ //New Theme-Color Patch
+ 4: begin
+ // violet
+ Result.R := 230/255;
+ Result.G := 63/255;
+ Result.B := 230/255;
+ end;
+ 5: begin
+ // orange
+ Result.R := 255/255;
+ Result.G := 144/255;
+ Result.B := 0;
+ end;
+ 6: begin
+ // yellow
+ Result.R := 230/255;
+ Result.G := 230/255;
+ Result.B := 95/255;
+ end;
+ 7: begin
+ // brown
+ Result.R := 192/255;
+ Result.G := 127/255;
+ Result.B := 31/255;
+ end;
+ 8: begin
+ // black
+ Result.R := 0;
+ Result.G := 0;
+ Result.B := 0;
+ end;
+ //New Theme-Color Patch End
+
+ end;
+end;
+
+function ColorSqrt(RGB: TRGB): TRGB;
+begin
+ Result.R := sqrt(RGB.R);
+ Result.G := sqrt(RGB.G);
+ Result.B := sqrt(RGB.B);
+end;
+
+procedure TTheme.ThemeSave(FileName: string);
+var
+ I: integer;
+begin
+ {$IFDEF THEMESAVE}
+ ThemeIni := TIniFile.Create(FileName);
+ {$ELSE}
+ ThemeIni := TMemIniFile.Create(FileName);
+ {$ENDIF}
+
+ ThemeSaveBasic(Loading, 'Loading');
+
+ ThemeSaveBasic(Main, 'Main');
+ ThemeSaveText(Main.TextDescription, 'MainTextDescription');
+ ThemeSaveText(Main.TextDescriptionLong, 'MainTextDescriptionLong');
+ ThemeSaveButton(Main.ButtonSolo, 'MainButtonSolo');
+ ThemeSaveButton(Main.ButtonEditor, 'MainButtonEditor');
+ ThemeSaveButton(Main.ButtonOptions, 'MainButtonOptions');
+ ThemeSaveButton(Main.ButtonExit, 'MainButtonExit');
+
+ ThemeSaveBasic(Name, 'Name');
+ for I := 1 to 6 do
+ ThemeSaveButton(Name.ButtonPlayer[I], 'NameButtonPlayer' + IntToStr(I));
+
+ ThemeSaveBasic(Level, 'Level');
+ ThemeSaveButton(Level.ButtonEasy, 'LevelButtonEasy');
+ ThemeSaveButton(Level.ButtonMedium, 'LevelButtonMedium');
+ ThemeSaveButton(Level.ButtonHard, 'LevelButtonHard');
+
+ ThemeSaveBasic(Song, 'Song');
+ ThemeSaveText(Song.TextArtist, 'SongTextArtist');
+ ThemeSaveText(Song.TextTitle, 'SongTextTitle');
+ ThemeSaveText(Song.TextNumber, 'SongTextNumber');
+
+ //Show CAt in Top Left Mod
+ ThemeSaveText(Song.TextCat, 'SongTextCat');
+ ThemeSaveStatic(Song.StaticCat, 'SongStaticCat');
+
+ ThemeSaveBasic(Sing, 'Sing');
+
+ //TimeBar mod
+ ThemeSaveStatic(Sing.StaticTimeProgress, 'SingTimeProgress');
+ ThemeSaveText(Sing.TextTimeText, 'SingTimeText');
+ //eoa TimeBar mod
+
+ ThemeSaveStatic(Sing.StaticP1, 'SingP1Static');
+ ThemeSaveText(Sing.TextP1, 'SingP1Text');
+ ThemeSaveStatic(Sing.StaticP1ScoreBG, 'SingP1Static2');
+ ThemeSaveText(Sing.TextP1Score, 'SingP1TextScore');
+
+ //moveable singbar mod
+ ThemeSaveStatic(Sing.StaticP1SingBar, 'SingP1SingBar');
+ ThemeSaveStatic(Sing.StaticP1TwoPSingBar, 'SingP1TwoPSingBar');
+ ThemeSaveStatic(Sing.StaticP1ThreePSingBar, 'SingP1ThreePSingBar');
+ ThemeSaveStatic(Sing.StaticP2RSingBar, 'SingP2RSingBar');
+ ThemeSaveStatic(Sing.StaticP2MSingBar, 'SingP2MSingBar');
+ ThemeSaveStatic(Sing.StaticP3SingBar, 'SingP3SingBar');
+ //eoa moveable singbar
+
+ //Added for ps3 skin
+ //This one is shown in 2/4P mode
+ ThemeSaveStatic(Sing.StaticP1TwoP, 'SingP1TwoPStatic');
+ ThemeSaveText(Sing.TextP1TwoP, 'SingP1TwoPText');
+ ThemeSaveStatic(Sing.StaticP1TwoPScoreBG, 'SingP1TwoPStatic2');
+ ThemeSaveText(Sing.TextP1TwoPScore, 'SingP1TwoPTextScore');
+
+ //This one is shown in 3/6P mode
+ ThemeSaveStatic(Sing.StaticP1ThreeP, 'SingP1ThreePStatic');
+ ThemeSaveText(Sing.TextP1ThreeP, 'SingP1ThreePText');
+ ThemeSaveStatic(Sing.StaticP1ThreePScoreBG, 'SingP1ThreePStatic2');
+ ThemeSaveText(Sing.TextP1ThreePScore, 'SingP1ThreePTextScore');
+ //eoa
+
+ ThemeSaveStatic(Sing.StaticP2R, 'SingP2RStatic');
+ ThemeSaveText(Sing.TextP2R, 'SingP2RText');
+ ThemeSaveStatic(Sing.StaticP2RScoreBG, 'SingP2RStatic2');
+ ThemeSaveText(Sing.TextP2RScore, 'SingP2RTextScore');
+
+ ThemeSaveStatic(Sing.StaticP2M, 'SingP2MStatic');
+ ThemeSaveText(Sing.TextP2M, 'SingP2MText');
+ ThemeSaveStatic(Sing.StaticP2MScoreBG, 'SingP2MStatic2');
+ ThemeSaveText(Sing.TextP2MScore, 'SingP2MTextScore');
+
+ ThemeSaveStatic(Sing.StaticP3R, 'SingP3RStatic');
+ ThemeSaveText(Sing.TextP3R, 'SingP3RText');
+ ThemeSaveStatic(Sing.StaticP3RScoreBG, 'SingP3RStatic2');
+ ThemeSaveText(Sing.TextP3RScore, 'SingP3RTextScore');
+
+ ThemeSaveBasic(Score, 'Score');
+ ThemeSaveText(Score.TextArtist, 'ScoreTextArtist');
+ ThemeSaveText(Score.TextTitle, 'ScoreTextTitle');
+
+ for I := 1 to 6 do begin
+ ThemeSaveStatics(Score.PlayerStatic[I], 'ScorePlayer' + IntToStr(I) + 'Static');
+
+ ThemeSaveText(Score.TextName[I], 'ScoreTextName' + IntToStr(I));
+ ThemeSaveText(Score.TextScore[I], 'ScoreTextScore' + IntToStr(I));
+ ThemeSaveText(Score.TextNotes[I], 'ScoreTextNotes' + IntToStr(I));
+ ThemeSaveText(Score.TextNotesScore[I], 'ScoreTextNotesScore' + IntToStr(I));
+ ThemeSaveText(Score.TextLineBonus[I], 'ScoreTextLineBonus' + IntToStr(I));
+ ThemeSaveText(Score.TextLineBonusScore[I], 'ScoreTextLineBonusScore' + IntToStr(I));
+ ThemeSaveText(Score.TextGoldenNotes[I], 'ScoreTextGoldenNotes' + IntToStr(I));
+ ThemeSaveText(Score.TextGoldenNotesScore[I], 'ScoreTextGoldenNotesScore' + IntToStr(I));
+ ThemeSaveText(Score.TextTotal[I], 'ScoreTextTotal' + IntToStr(I));
+ ThemeSaveText(Score.TextTotalScore[I], 'ScoreTextTotalScore' + IntToStr(I));
+
+ ThemeSaveStatic(Score.StaticBackLevel[I], 'ScoreStaticBackLevel' + IntToStr(I));
+ ThemeSaveStatic(Score.StaticBackLevelRound[I], 'ScoreStaticBackLevelRound' + IntToStr(I));
+ ThemeSaveStatic(Score.StaticLevel[I], 'ScoreStaticLevel' + IntToStr(I));
+ ThemeSaveStatic(Score.StaticLevelRound[I], 'ScoreStaticLevelRound' + IntToStr(I));
+ end;
+
+ ThemeSaveBasic(Top5, 'Top5');
+ ThemeSaveText(Top5.TextLevel, 'Top5TextLevel');
+ ThemeSaveText(Top5.TextArtistTitle, 'Top5TextArtistTitle');
+ ThemeSaveStatics(Top5.StaticNumber, 'Top5StaticNumber');
+ ThemeSaveTexts(Top5.TextNumber, 'Top5TextNumber');
+ ThemeSaveTexts(Top5.TextName, 'Top5TextName');
+ ThemeSaveTexts(Top5.TextScore, 'Top5TextScore');
+
+
+ ThemeIni.Free;
+end;
+
+procedure TTheme.ThemeSaveBasic(Theme: TThemeBasic; Name: string);
+begin
+ ThemeIni.WriteInteger(Name, 'Texts', Length(Theme.Text));
+
+ ThemeSaveBackground(Theme.Background, Name + 'Background');
+ ThemeSaveStatics(Theme.Static, Name + 'Static');
+ ThemeSaveTexts(Theme.Text, Name + 'Text');
+end;
+
+procedure TTheme.ThemeSaveBackground(ThemeBackground: TThemeBackground; Name: string);
+begin
+ if ThemeBackground.Tex <> '' then
+ ThemeIni.WriteString(Name, 'Tex', ThemeBackground.Tex)
+ else begin
+ ThemeIni.EraseSection(Name);
+ end;
+end;
+
+procedure TTheme.ThemeSaveStatic(ThemeStatic: TThemeStatic; Name: string);
+begin
+ ThemeIni.WriteInteger(Name, 'X', ThemeStatic.X);
+ ThemeIni.WriteInteger(Name, 'Y', ThemeStatic.Y);
+ ThemeIni.WriteInteger(Name, 'W', ThemeStatic.W);
+ ThemeIni.WriteInteger(Name, 'H', ThemeStatic.H);
+
+ ThemeIni.WriteString(Name, 'Tex', ThemeStatic.Tex);
+ ThemeIni.WriteString(Name, 'Type', TextureTypeToStr(ThemeStatic.Typ));
+ ThemeIni.WriteString(Name, 'Color', ThemeStatic.Color);
+
+ ThemeIni.WriteFloat(Name, 'TexX1', ThemeStatic.TexX1);
+ ThemeIni.WriteFloat(Name, 'TexY1', ThemeStatic.TexY1);
+ ThemeIni.WriteFloat(Name, 'TexX2', ThemeStatic.TexX2);
+ ThemeIni.WriteFloat(Name, 'TexY2', ThemeStatic.TexY2);
+end;
+
+procedure TTheme.ThemeSaveStatics(ThemeStatic: AThemeStatic; Name: string);
+var
+ S: integer;
+begin
+ for S := 0 to Length(ThemeStatic)-1 do
+ ThemeSaveStatic(ThemeStatic[S], Name + {'Static' +} IntToStr(S+1));
+
+ ThemeIni.EraseSection(Name + {'Static' + }IntToStr(S+1));
+end;
+
+procedure TTheme.ThemeSaveText(ThemeText: TThemeText; Name: string);
+begin
+ ThemeIni.WriteInteger(Name, 'X', ThemeText.X);
+ ThemeIni.WriteInteger(Name, 'Y', ThemeText.Y);
+
+ ThemeIni.WriteInteger(Name, 'Font', ThemeText.Font);
+ ThemeIni.WriteInteger(Name, 'Size', ThemeText.Size);
+ ThemeIni.WriteInteger(Name, 'Align', ThemeText.Align);
+
+ ThemeIni.WriteString(Name, 'Text', ThemeText.Text);
+ ThemeIni.WriteString(Name, 'Color', ThemeText.Color);
+
+ ThemeIni.WriteBool(Name, 'Reflection', ThemeText.Reflection);
+ ThemeIni.WriteFloat(Name, 'ReflectionSpacing', ThemeText.ReflectionSpacing);
+end;
+
+procedure TTheme.ThemeSaveTexts(ThemeText: AThemeText; Name: string);
+var
+ T: integer;
+begin
+ for T := 0 to Length(ThemeText)-1 do
+ ThemeSaveText(ThemeText[T], Name + {'Text' + }IntToStr(T+1));
+
+ ThemeIni.EraseSection(Name + {'Text' + }IntToStr(T+1));
+end;
+
+procedure TTheme.ThemeSaveButton(ThemeButton: TThemeButton; Name: string);
+var
+ T: integer;
+begin
+ ThemeIni.WriteString(Name, 'Tex', ThemeButton.Tex);
+ ThemeIni.WriteInteger(Name, 'X', ThemeButton.X);
+ ThemeIni.WriteInteger(Name, 'Y', ThemeButton.Y);
+ ThemeIni.WriteInteger(Name, 'W', ThemeButton.W);
+ ThemeIni.WriteInteger(Name, 'H', ThemeButton.H);
+ ThemeIni.WriteString(Name, 'Type', TextureTypeToStr(ThemeButton.Typ));
+ ThemeIni.WriteInteger(Name, 'Texts', Length(ThemeButton.Text));
+
+ ThemeIni.WriteString(Name, 'Color', ThemeButton.Color);
+
+{ ThemeButton.ColR := ThemeIni.ReadFloat(Name, 'ColR', 1);
+ ThemeButton.ColG := ThemeIni.ReadFloat(Name, 'ColG', 1);
+ ThemeButton.ColB := ThemeIni.ReadFloat(Name, 'ColB', 1);
+ ThemeButton.Int := ThemeIni.ReadFloat(Name, 'Int', 1);
+ ThemeButton.DColR := ThemeIni.ReadFloat(Name, 'DColR', 1);
+ ThemeButton.DColG := ThemeIni.ReadFloat(Name, 'DColG', 1);
+ ThemeButton.DColB := ThemeIni.ReadFloat(Name, 'DColB', 1);
+ ThemeButton.DInt := ThemeIni.ReadFloat(Name, 'DInt', 1);}
+
+{ C := ColorExists(ThemeIni.ReadString(Name, 'Color', ''));
+ if C >= 0 then begin
+ ThemeButton.ColR := Color[C].RGB.R;
+ ThemeButton.ColG := Color[C].RGB.G;
+ ThemeButton.ColB := Color[C].RGB.B;
+ end;
+
+ C := ColorExists(ThemeIni.ReadString(Name, 'DColor', ''));
+ if C >= 0 then begin
+ ThemeButton.DColR := Color[C].RGB.R;
+ ThemeButton.DColG := Color[C].RGB.G;
+ ThemeButton.DColB := Color[C].RGB.B;
+ end;}
+
+ for T := 0 to High(ThemeButton.Text) do
+ ThemeSaveText(ThemeButton.Text[T], Name + 'Text' + IntToStr(T+1));
+end;
+
+procedure TTheme.create_theme_objects();
+begin
+ freeandnil( Loading );
+ Loading := TThemeLoading.Create;
+
+ freeandnil( Main );
+ Main := TThemeMain.Create;
+
+ freeandnil( Name );
+ Name := TThemeName.Create;
+
+ freeandnil( Level );
+ Level := TThemeLevel.Create;
+
+ freeandnil( Song );
+ Song := TThemeSong.Create;
+
+ freeandnil( Sing );
+ Sing := TThemeSing.Create;
+
+ freeandnil( Score );
+ Score := TThemeScore.Create;
+
+ freeandnil( Top5 );
+ Top5 := TThemeTop5.Create;
+
+ freeandnil( Options );
+ Options := TThemeOptions.Create;
+
+ freeandnil( OptionsGame );
+ OptionsGame := TThemeOptionsGame.Create;
+
+ freeandnil( OptionsGraphics );
+ OptionsGraphics := TThemeOptionsGraphics.Create;
+
+ freeandnil( OptionsSound );
+ OptionsSound := TThemeOptionsSound.Create;
+
+ freeandnil( OptionsLyrics );
+ OptionsLyrics := TThemeOptionsLyrics.Create;
+
+ freeandnil( OptionsThemes );
+ OptionsThemes := TThemeOptionsThemes.Create;
+
+ freeandnil( OptionsRecord );
+ OptionsRecord := TThemeOptionsRecord.Create;
+
+ freeandnil( OptionsAdvanced );
+ OptionsAdvanced := TThemeOptionsAdvanced.Create;
+
+
+ freeandnil( ErrorPopup );
+ ErrorPopup := TThemeError.Create;
+
+ freeandnil( CheckPopup );
+ CheckPopup := TThemeCheck.Create;
+
+
+ freeandnil( SongMenu );
+ SongMenu := TThemeSongMenu.Create;
+
+ freeandnil( SongJumpto );
+ SongJumpto := TThemeSongJumpto.Create;
+
+ //Party Screens
+ freeandnil( PartyNewRound );
+ PartyNewRound := TThemePartyNewRound.Create;
+
+ freeandnil( PartyWin );
+ PartyWin := TThemePartyWin.Create;
+
+ freeandnil( PartyScore );
+ PartyScore := TThemePartyScore.Create;
+
+ freeandnil( PartyOptions );
+ PartyOptions := TThemePartyOptions.Create;
+
+ freeandnil( PartyPlayer );
+ PartyPlayer := TThemePartyPlayer.Create;
+
+
+ //Stats Screens:
+ freeandnil( StatMain );
+ StatMain := TThemeStatMain.Create;
+
+ freeandnil( StatDetail );
+ StatDetail := TThemeStatDetail.Create;
+
+ end;
+
+end.
diff --git a/src/base/UTime.pas b/src/base/UTime.pas
new file mode 100644
index 00000000..f8ae91c4
--- /dev/null
+++ b/src/base/UTime.pas
@@ -0,0 +1,185 @@
+unit UTime;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+type
+ TTime = class
+ public
+ constructor Create;
+ function GetTime(): real;
+ end;
+
+ TRelativeTimer = class
+ private
+ AbsoluteTime: int64; // system-clock reference time for calculation of CurrentTime
+ RelativeTimeOffset: real;
+ Paused: boolean;
+ TriggerMode: boolean;
+ public
+ constructor Create(TriggerMode: boolean = false);
+ procedure Pause();
+ procedure Resume();
+ function GetTime(): real;
+ function GetAndResetTime(): real;
+ procedure SetTime(Time: real; Trigger: boolean = true);
+ procedure Reset();
+ end;
+
+procedure CountSkipTimeSet;
+procedure CountSkipTime;
+procedure CountMidTime;
+
+var
+ USTime : TTime;
+ VideoBGTimer: TRelativeTimer;
+
+ TimeNew : int64;
+ TimeOld : int64;
+ TimeSkip : real;
+ TimeMid : real;
+ TimeMidTemp : int64;
+
+implementation
+
+uses
+ sdl,
+ ucommon;
+
+const
+ cSDLCorrectionRatio = 1000;
+
+(*
+BEST Option now ( after discussion with whiteshark ) seems to be to use SDL
+timer functions...
+
+SDL_delay
+SDL_GetTicks
+http://www.gamedev.net/community/forums/topic.asp?topic_id=466145&whichpage=1%EE%8D%B7
+*)
+
+
+procedure CountSkipTimeSet;
+begin
+ TimeNew := SDL_GetTicks();
+end;
+
+procedure CountSkipTime;
+begin
+ TimeOld := TimeNew;
+ TimeNew := SDL_GetTicks();
+ TimeSkip := (TimeNew-TimeOld) / cSDLCorrectionRatio;
+end;
+
+procedure CountMidTime;
+begin
+ TimeMidTemp := SDL_GetTicks();
+ TimeMid := (TimeMidTemp - TimeNew) / cSDLCorrectionRatio;
+end;
+
+{**
+ * TTime
+ **}
+
+constructor TTime.Create;
+begin
+ inherited;
+ CountSkipTimeSet;
+end;
+
+function TTime.GetTime: real;
+begin
+ Result := SDL_GetTicks() / cSDLCorrectionRatio;
+end;
+
+{**
+ * TRelativeTimer
+ **}
+
+(*
+ * Creates a new timer.
+ * If TriggerMode is false (default), the timer
+ * will immediately begin with counting.
+ * If TriggerMode is true, it will wait until Get/SetTime() or Pause() is called
+ * for the first time.
+ *)
+constructor TRelativeTimer.Create(TriggerMode: boolean);
+begin
+ inherited Create();
+ Self.TriggerMode := TriggerMode;
+ Reset();
+ Paused := false;
+end;
+
+procedure TRelativeTimer.Pause();
+begin
+ RelativeTimeOffset := GetTime();
+ Paused := true;
+end;
+
+procedure TRelativeTimer.Resume();
+begin
+ AbsoluteTime := SDL_GetTicks();
+ Paused := false;
+end;
+
+(*
+ * Returns the counter of the timer.
+ * If in TriggerMode it will return 0 and start the counter on the first call.
+ *)
+function TRelativeTimer.GetTime: real;
+begin
+ // initialize absolute time on first call in triggered mode
+ if (TriggerMode and (AbsoluteTime = 0)) then
+ begin
+ AbsoluteTime := SDL_GetTicks();
+ Result := RelativeTimeOffset;
+ Exit;
+ end;
+
+ if Paused then
+ Result := RelativeTimeOffset
+ else
+ Result := RelativeTimeOffset + (SDL_GetTicks() - AbsoluteTime) / cSDLCorrectionRatio;
+end;
+
+(*
+ * Returns the counter of the timer and resets the counter to 0 afterwards.
+ * Note: In TriggerMode the counter will not be stopped as with Reset().
+ *)
+function TRelativeTimer.GetAndResetTime(): real;
+begin
+ Result := GetTime();
+ SetTime(0);
+end;
+
+(*
+ * Sets the timer to the given time. This will trigger in TriggerMode if
+ * Trigger is set to true. Otherwise the counter's state will not change.
+ *)
+procedure TRelativeTimer.SetTime(Time: real; Trigger: boolean);
+begin
+ RelativeTimeOffset := Time;
+ if ((not TriggerMode) or Trigger) then
+ AbsoluteTime := SDL_GetTicks();
+end;
+
+(*
+ * Resets the counter of the timer to 0.
+ * If in TriggerMode the timer will not start counting until it is triggered again.
+ *)
+procedure TRelativeTimer.Reset();
+begin
+ RelativeTimeOffset := 0;
+ if (TriggerMode) then
+ AbsoluteTime := 0
+ else
+ AbsoluteTime := SDL_GetTicks();
+end;
+
+end.
diff --git a/src/base/UVideo.pas b/src/base/UVideo.pas
new file mode 100644
index 00000000..0ab1d350
--- /dev/null
+++ b/src/base/UVideo.pas
@@ -0,0 +1,828 @@
+{##############################################################################
+ # FFmpeg support for UltraStar deluxe #
+ # #
+ # Created by b1indy #
+ # based on 'An ffmpeg and SDL Tutorial' (http://www.dranger.com/ffmpeg/) #
+ # with modifications by Jay Binks <jaybinks@gmail.com> #
+ # #
+ # http://www.mail-archive.com/fpc-pascal@lists.freepascal.org/msg09949.html #
+ # http://www.nabble.com/file/p11795857/mpegpas01.zip #
+ # #
+ ##############################################################################}
+
+unit UVideo;
+
+// uncomment if you want to see the debug stuff
+{.$define DebugDisplay}
+{.$define DebugFrames}
+{.$define VideoBenchmark}
+{.$define Info}
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+// use BGR-format for accelerated colorspace conversion with swscale
+{$IFDEF UseSWScale}
+ {$DEFINE PIXEL_FMT_BGR}
+{$ENDIF}
+
+implementation
+
+uses
+ SDL,
+ textgl,
+ avcodec,
+ avformat,
+ avutil,
+ avio,
+ rational,
+ {$IFDEF UseSWScale}
+ swscale,
+ {$ENDIF}
+ UMediaCore_FFmpeg,
+ math,
+ gl,
+ glext,
+ SysUtils,
+ UCommon,
+ UConfig,
+ ULog,
+ UMusic,
+ UGraphicClasses,
+ UGraphic;
+
+const
+{$IFDEF PIXEL_FMT_BGR}
+ PIXEL_FMT_OPENGL = GL_BGR;
+ PIXEL_FMT_FFMPEG = PIX_FMT_BGR24;
+{$ELSE}
+ PIXEL_FMT_OPENGL = GL_RGB;
+ PIXEL_FMT_FFMPEG = PIX_FMT_RGB24;
+{$ENDIF}
+
+type
+ TVideoPlayback_FFmpeg = class( TInterfacedObject, IVideoPlayback )
+ private
+ fVideoOpened,
+ fVideoPaused: Boolean;
+
+ VideoStream: PAVStream;
+ VideoStreamIndex : Integer;
+ VideoFormatContext: PAVFormatContext;
+ VideoCodecContext: PAVCodecContext;
+ VideoCodec: PAVCodec;
+
+ AVFrame: PAVFrame;
+ AVFrameRGB: PAVFrame;
+ FrameBuffer: PByte;
+
+ {$IFDEF UseSWScale}
+ SoftwareScaleContext: PSwsContext;
+ {$ENDIF}
+
+ fVideoTex: GLuint;
+ TexWidth, TexHeight: Cardinal;
+
+ VideoAspect: Real;
+ VideoTimeBase, VideoTime: Extended;
+ fLoopTime: Extended;
+
+ EOF: boolean;
+ Loop: boolean;
+
+ Initialized: boolean;
+
+ procedure Reset();
+ function DecodeFrame(var AVPacket: TAVPacket; out pts: double): boolean;
+ procedure SynchronizeVideo(Frame: PAVFrame; var pts: double);
+ public
+ function GetName: String;
+
+ function Init(): boolean;
+ function Finalize: boolean;
+
+ function Open(const aFileName : string): boolean; // true if succeed
+ procedure Close;
+
+ procedure Play;
+ procedure Pause;
+ procedure Stop;
+
+ procedure SetPosition(Time: real);
+ function GetPosition: real;
+
+ procedure GetFrame(Time: Extended);
+ procedure DrawGL(Screen: integer);
+ end;
+
+var
+ FFmpegCore: TMediaCore_FFmpeg;
+
+
+// These are called whenever we allocate a frame buffer.
+// We use this to store the global_pts in a frame at the time it is allocated.
+function PtsGetBuffer(CodecCtx: PAVCodecContext; Frame: PAVFrame): integer; cdecl;
+var
+ pts: Pint64;
+ VideoPktPts: Pint64;
+begin
+ Result := avcodec_default_get_buffer(CodecCtx, Frame);
+ VideoPktPts := CodecCtx^.opaque;
+ if (VideoPktPts <> nil) then
+ begin
+ // Note: we must copy the pts instead of passing a pointer, because the packet
+ // (and with it the pts) might change before a frame is returned by av_decode_video.
+ pts := av_malloc(sizeof(int64));
+ pts^ := VideoPktPts^;
+ Frame^.opaque := pts;
+ end;
+end;
+
+procedure PtsReleaseBuffer(CodecCtx: PAVCodecContext; Frame: PAVFrame); cdecl;
+begin
+ if (Frame <> nil) then
+ av_freep(@Frame^.opaque);
+ avcodec_default_release_buffer(CodecCtx, Frame);
+end;
+
+
+{*------------------------------------------------------------------------------
+ * TVideoPlayback_ffmpeg
+ *------------------------------------------------------------------------------}
+
+function TVideoPlayback_FFmpeg.GetName: String;
+begin
+ result := 'FFmpeg_Video';
+end;
+
+function TVideoPlayback_FFmpeg.Init(): boolean;
+begin
+ Result := true;
+
+ if (Initialized) then
+ Exit;
+ Initialized := true;
+
+ FFmpegCore := TMediaCore_FFmpeg.GetInstance();
+
+ Reset();
+ av_register_all();
+ glGenTextures(1, PGLuint(@fVideoTex));
+end;
+
+function TVideoPlayback_FFmpeg.Finalize(): boolean;
+begin
+ Close();
+ glDeleteTextures(1, PGLuint(@fVideoTex));
+ Result := true;
+end;
+
+procedure TVideoPlayback_FFmpeg.Reset();
+begin
+ // close previously opened video
+ Close();
+
+ fVideoOpened := False;
+ fVideoPaused := False;
+ VideoTimeBase := 0;
+ VideoTime := 0;
+ VideoStream := nil;
+ VideoStreamIndex := -1;
+
+ EOF := false;
+
+ // TODO: do we really want this by default?
+ Loop := true;
+ fLoopTime := 0;
+end;
+
+function TVideoPlayback_FFmpeg.Open(const aFileName : string): boolean; // true if succeed
+var
+ errnum: Integer;
+ AudioStreamIndex: integer;
+begin
+ Result := false;
+
+ Reset();
+
+ errnum := av_open_input_file(VideoFormatContext, PChar(aFileName), nil, 0, nil);
+ if (errnum <> 0) then
+ begin
+ Log.LogError('Failed to open file "'+aFileName+'" ('+FFmpegCore.GetErrorString(errnum)+')');
+ Exit;
+ end;
+
+ // update video info
+ if (av_find_stream_info(VideoFormatContext) < 0) then
+ begin
+ Log.LogError('No stream info found', 'TVideoPlayback_ffmpeg.Open');
+ Close();
+ Exit;
+ end;
+ Log.LogInfo('VideoStreamIndex : ' + inttostr(VideoStreamIndex), 'TVideoPlayback_ffmpeg.Open');
+
+ // find video stream
+ FFmpegCore.FindStreamIDs(VideoFormatContext, VideoStreamIndex, AudioStreamIndex);
+ if (VideoStreamIndex < 0) then
+ begin
+ Log.LogError('No video stream found', 'TVideoPlayback_ffmpeg.Open');
+ Close();
+ Exit;
+ end;
+
+ VideoStream := VideoFormatContext^.streams[VideoStreamIndex];
+ VideoCodecContext := VideoStream^.codec;
+
+ VideoCodec := avcodec_find_decoder(VideoCodecContext^.codec_id);
+ if (VideoCodec = nil) then
+ begin
+ Log.LogError('No matching codec found', 'TVideoPlayback_ffmpeg.Open');
+ Close();
+ Exit;
+ end;
+
+ // set debug options
+ VideoCodecContext^.debug_mv := 0;
+ VideoCodecContext^.debug := 0;
+
+ // detect bug-workarounds automatically
+ VideoCodecContext^.workaround_bugs := FF_BUG_AUTODETECT;
+ // error resilience strategy (careful/compliant/agressive/very_aggressive)
+ //VideoCodecContext^.error_resilience := FF_ER_CAREFUL; //FF_ER_COMPLIANT;
+ // allow non spec compliant speedup tricks.
+ //VideoCodecContext^.flags2 := VideoCodecContext^.flags2 or CODEC_FLAG2_FAST;
+
+ // Note: avcodec_open() and avcodec_close() are not thread-safe and will
+ // fail if called concurrently by different threads.
+ FFmpegCore.LockAVCodec();
+ try
+ errnum := avcodec_open(VideoCodecContext, VideoCodec);
+ finally
+ FFmpegCore.UnlockAVCodec();
+ end;
+ if (errnum < 0) then
+ begin
+ Log.LogError('No matching codec found', 'TVideoPlayback_ffmpeg.Open');
+ Close();
+ Exit;
+ end;
+
+ // register custom callbacks for pts-determination
+ VideoCodecContext^.get_buffer := PtsGetBuffer;
+ VideoCodecContext^.release_buffer := PtsReleaseBuffer;
+
+ {$ifdef DebugDisplay}
+ DebugWriteln('Found a matching Codec: '+ VideoCodecContext^.Codec.Name + sLineBreak +
+ sLineBreak +
+ ' Width = '+inttostr(VideoCodecContext^.width) +
+ ', Height='+inttostr(VideoCodecContext^.height) + sLineBreak +
+ ' Aspect : '+inttostr(VideoCodecContext^.sample_aspect_ratio.num) + '/' +
+ inttostr(VideoCodecContext^.sample_aspect_ratio.den) + sLineBreak +
+ ' Framerate : '+inttostr(VideoCodecContext^.time_base.num) + '/' +
+ inttostr(VideoCodecContext^.time_base.den));
+ {$endif}
+
+ // allocate space for decoded frame and rgb frame
+ AVFrame := avcodec_alloc_frame();
+ AVFrameRGB := avcodec_alloc_frame();
+ FrameBuffer := av_malloc(avpicture_get_size(PIXEL_FMT_FFMPEG,
+ VideoCodecContext^.width, VideoCodecContext^.height));
+
+ if ((AVFrame = nil) or (AVFrameRGB = nil) or (FrameBuffer = nil)) then
+ begin
+ Log.LogError('Failed to allocate buffers', 'TVideoPlayback_ffmpeg.Open');
+ Close();
+ Exit;
+ end;
+
+ // TODO: pad data for OpenGL to GL_UNPACK_ALIGNMENT
+ // (otherwise video will be distorted if width/height is not a multiple of the alignment)
+ errnum := avpicture_fill(PAVPicture(AVFrameRGB), FrameBuffer, PIXEL_FMT_FFMPEG,
+ VideoCodecContext^.width, VideoCodecContext^.height);
+ if (errnum < 0) then
+ begin
+ Log.LogError('avpicture_fill failed: ' + FFmpegCore.GetErrorString(errnum), 'TVideoPlayback_ffmpeg.Open');
+ Close();
+ Exit;
+ end;
+
+ // calculate some information for video display
+ VideoAspect := av_q2d(VideoCodecContext^.sample_aspect_ratio);
+ if (VideoAspect = 0) then
+ VideoAspect := VideoCodecContext^.width /
+ VideoCodecContext^.height
+ else
+ VideoAspect := VideoAspect * VideoCodecContext^.width /
+ VideoCodecContext^.height;
+
+ VideoTimeBase := 1/av_q2d(VideoStream^.r_frame_rate);
+
+ // hack to get reasonable timebase (for divx and others)
+ if (VideoTimeBase < 0.02) then // 0.02 <-> 50 fps
+ begin
+ VideoTimeBase := av_q2d(VideoStream^.r_frame_rate);
+ while (VideoTimeBase > 50) do
+ VideoTimeBase := VideoTimeBase/10;
+ VideoTimeBase := 1/VideoTimeBase;
+ end;
+
+ Log.LogInfo('VideoTimeBase: ' + floattostr(VideoTimeBase), 'TVideoPlayback_ffmpeg.Open');
+ Log.LogInfo('Framerate: '+inttostr(floor(1/VideoTimeBase))+'fps', 'TVideoPlayback_ffmpeg.Open');
+
+ {$IFDEF UseSWScale}
+ // if available get a SWScale-context -> faster than the deprecated img_convert().
+ // SWScale has accelerated support for PIX_FMT_RGB32/PIX_FMT_BGR24/PIX_FMT_BGR565/PIX_FMT_BGR555.
+ // Note: PIX_FMT_RGB32 is a BGR- and not an RGB-format (maybe a bug)!!!
+ // The BGR565-formats (GL_UNSIGNED_SHORT_5_6_5) is way too slow because of its
+ // bad OpenGL support. The BGR formats have MMX(2) implementations but no speed-up
+ // could be observed in comparison to the RGB versions.
+ SoftwareScaleContext := sws_getContext(
+ VideoCodecContext^.width, VideoCodecContext^.height,
+ integer(VideoCodecContext^.pix_fmt),
+ VideoCodecContext^.width, VideoCodecContext^.height,
+ integer(PIXEL_FMT_FFMPEG),
+ SWS_FAST_BILINEAR, nil, nil, nil);
+ if (SoftwareScaleContext = nil) then
+ begin
+ Log.LogError('Failed to get swscale context', 'TVideoPlayback_ffmpeg.Open');
+ Close();
+ Exit;
+ end;
+ {$ENDIF}
+
+ TexWidth := Round(Power(2, Ceil(Log2(VideoCodecContext^.width))));
+ TexHeight := Round(Power(2, Ceil(Log2(VideoCodecContext^.height))));
+
+ // we retrieve a texture just once with glTexImage2D and update it with glTexSubImage2D later.
+ // Benefits: glTexSubImage2D is faster and supports non-power-of-two widths/height.
+ glBindTexture(GL_TEXTURE_2D, fVideoTex);
+ glTexEnvi(GL_TEXTURE_2D, GL_TEXTURE_ENV_MODE, GL_REPLACE);
+ glTexImage2D(GL_TEXTURE_2D, 0, 3, TexWidth, TexHeight, 0,
+ PIXEL_FMT_OPENGL, GL_UNSIGNED_BYTE, nil);
+ glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);
+ glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
+
+
+ fVideoOpened := True;
+
+ Result := true;
+end;
+
+procedure TVideoPlayback_FFmpeg.Close;
+begin
+ if (FrameBuffer <> nil) then
+ av_free(FrameBuffer);
+ if (AVFrameRGB <> nil) then
+ av_free(AVFrameRGB);
+ if (AVFrame <> nil) then
+ av_free(AVFrame);
+
+ AVFrame := nil;
+ AVFrameRGB := nil;
+ FrameBuffer := nil;
+
+ if (VideoCodecContext <> nil) then
+ begin
+ // avcodec_close() is not thread-safe
+ FFmpegCore.LockAVCodec();
+ try
+ avcodec_close(VideoCodecContext);
+ finally
+ FFmpegCore.UnlockAVCodec();
+ end;
+ end;
+
+ if (VideoFormatContext <> nil) then
+ av_close_input_file(VideoFormatContext);
+
+ VideoCodecContext := nil;
+ VideoFormatContext := nil;
+
+ fVideoOpened := False;
+end;
+
+procedure TVideoPlayback_FFmpeg.SynchronizeVideo(Frame: PAVFrame; var pts: double);
+var
+ FrameDelay: double;
+begin
+ if (pts <> 0) then
+ begin
+ // if we have pts, set video clock to it
+ VideoTime := pts;
+ end else
+ begin
+ // if we aren't given a pts, set it to the clock
+ pts := VideoTime;
+ end;
+ // update the video clock
+ FrameDelay := av_q2d(VideoCodecContext^.time_base);
+ // if we are repeating a frame, adjust clock accordingly
+ FrameDelay := FrameDelay + Frame^.repeat_pict * (FrameDelay * 0.5);
+ VideoTime := VideoTime + FrameDelay;
+end;
+
+function TVideoPlayback_FFmpeg.DecodeFrame(var AVPacket: TAVPacket; out pts: double): boolean;
+var
+ FrameFinished: Integer;
+ VideoPktPts: int64;
+ pbIOCtx: PByteIOContext;
+ errnum: integer;
+begin
+ Result := false;
+ FrameFinished := 0;
+
+ if EOF then
+ Exit;
+
+ // read packets until we have a finished frame (or there are no more packets)
+ while (FrameFinished = 0) do
+ begin
+ errnum := av_read_frame(VideoFormatContext, AVPacket);
+ if (errnum < 0) then
+ begin
+ // failed to read a frame, check reason
+
+ {$IF (LIBAVFORMAT_VERSION_MAJOR >= 52)}
+ pbIOCtx := VideoFormatContext^.pb;
+ {$ELSE}
+ pbIOCtx := @VideoFormatContext^.pb;
+ {$IFEND}
+
+ // check for end-of-file (eof is not an error)
+ if (url_feof(pbIOCtx) <> 0) then
+ begin
+ EOF := true;
+ Exit;
+ end;
+
+ // check for errors
+ if (url_ferror(pbIOCtx) <> 0) then
+ Exit;
+
+ // url_feof() does not detect an EOF for some mov-files (e.g. deluxe.mov)
+ // so we have to do it this way.
+ if ((VideoFormatContext^.file_size <> 0) and
+ (pbIOCtx^.pos >= VideoFormatContext^.file_size)) then
+ begin
+ EOF := true;
+ Exit;
+ end;
+
+ // no error -> wait for user input
+ SDL_Delay(100);
+ continue;
+ end;
+
+ // if we got a packet from the video stream, then decode it
+ if (AVPacket.stream_index = VideoStreamIndex) then
+ begin
+ // save pts to be stored in pFrame in first call of PtsGetBuffer()
+ VideoPktPts := AVPacket.pts;
+ VideoCodecContext^.opaque := @VideoPktPts;
+
+ // decode packet
+ avcodec_decode_video(VideoCodecContext, AVFrame,
+ frameFinished, AVPacket.data, AVPacket.size);
+
+ // reset opaque data
+ VideoCodecContext^.opaque := nil;
+
+ // update pts
+ if (AVPacket.dts <> AV_NOPTS_VALUE) then
+ begin
+ pts := AVPacket.dts;
+ end
+ else if ((AVFrame^.opaque <> nil) and
+ (Pint64(AVFrame^.opaque)^ <> AV_NOPTS_VALUE)) then
+ begin
+ pts := Pint64(AVFrame^.opaque)^;
+ end
+ else
+ begin
+ pts := 0;
+ end;
+ pts := pts * av_q2d(VideoStream^.time_base);
+
+ // synchronize on each complete frame
+ if (frameFinished <> 0) then
+ SynchronizeVideo(AVFrame, pts);
+ end;
+
+ // free the packet from av_read_frame
+ av_free_packet( @AVPacket );
+ end;
+
+ Result := true;
+end;
+
+procedure TVideoPlayback_FFmpeg.GetFrame(Time: Extended);
+var
+ AVPacket: TAVPacket;
+ errnum: Integer;
+ myTime: Extended;
+ TimeDifference: Extended;
+ DropFrameCount: Integer;
+ pts: double;
+ i: Integer;
+const
+ FRAME_DROPCOUNT = 3;
+begin
+ if not fVideoOpened then
+ Exit;
+
+ if fVideoPaused then
+ Exit;
+
+ // current time, relative to last loop (if any)
+ myTime := Time - fLoopTime;
+ // time since the last frame was returned
+ TimeDifference := myTime - VideoTime;
+
+ {$IFDEF DebugDisplay}
+ DebugWriteln('Time: '+inttostr(floor(Time*1000)) + sLineBreak +
+ 'VideoTime: '+inttostr(floor(VideoTime*1000)) + sLineBreak +
+ 'TimeBase: '+inttostr(floor(VideoTimeBase*1000)) + sLineBreak +
+ 'TimeDiff: '+inttostr(floor(TimeDifference*1000)));
+ {$endif}
+
+ // check if a new frame is needed
+ if (VideoTime <> 0) and (TimeDifference < VideoTimeBase) then
+ begin
+ {$ifdef DebugFrames}
+ // frame delay debug display
+ GoldenRec.Spawn(200,15,1,16,0,-1,ColoredStar,$00ff00);
+ {$endif}
+
+ {$IFDEF DebugDisplay}
+ DebugWriteln('not getting new frame' + sLineBreak +
+ 'Time: '+inttostr(floor(Time*1000)) + sLineBreak +
+ 'VideoTime: '+inttostr(floor(VideoTime*1000)) + sLineBreak +
+ 'TimeBase: '+inttostr(floor(VideoTimeBase*1000)) + sLineBreak +
+ 'TimeDiff: '+inttostr(floor(TimeDifference*1000)));
+ {$endif}
+
+ // we do not need a new frame now
+ Exit;
+ end;
+
+ // update video-time to the next frame
+ VideoTime := VideoTime + VideoTimeBase;
+ TimeDifference := myTime - VideoTime;
+
+ // check if we have to skip frames
+ if (TimeDifference >= FRAME_DROPCOUNT*VideoTimeBase) then
+ begin
+ {$IFDEF DebugFrames}
+ //frame drop debug display
+ GoldenRec.Spawn(200,55,1,16,0,-1,ColoredStar,$ff0000);
+ {$ENDIF}
+ {$IFDEF DebugDisplay}
+ DebugWriteln('skipping frames' + sLineBreak +
+ 'TimeBase: '+inttostr(floor(VideoTimeBase*1000)) + sLineBreak +
+ 'TimeDiff: '+inttostr(floor(TimeDifference*1000)));
+ {$endif}
+
+ // update video-time
+ DropFrameCount := Trunc(TimeDifference / VideoTimeBase);
+ VideoTime := VideoTime + DropFrameCount*VideoTimeBase;
+
+ // skip half of the frames, this is much smoother than to skip all at once
+ for i := 1 to DropFrameCount (*div 2*) do
+ DecodeFrame(AVPacket, pts);
+ end;
+
+ {$IFDEF VideoBenchmark}
+ Log.BenchmarkStart(15);
+ {$ENDIF}
+
+ if (not DecodeFrame(AVPacket, pts)) then
+ begin
+ if Loop then
+ begin
+ // Record the time we looped. This is used to keep the loops in time. otherwise they speed
+ SetPosition(0);
+ fLoopTime := Time;
+ end;
+ Exit;
+ end;
+
+ // TODO: support for pan&scan
+ //if (AVFrame.pan_scan <> nil) then
+ //begin
+ // Writeln(Format('PanScan: %d/%d', [AVFrame.pan_scan.width, AVFrame.pan_scan.height]));
+ //end;
+
+ // otherwise we convert the pixeldata from YUV to RGB
+ {$IFDEF UseSWScale}
+ errnum := sws_scale(SoftwareScaleContext, @(AVFrame.data), @(AVFrame.linesize),
+ 0, VideoCodecContext^.Height,
+ @(AVFrameRGB.data), @(AVFrameRGB.linesize));
+ {$ELSE}
+ errnum := img_convert(PAVPicture(AVFrameRGB), PIXEL_FMT_FFMPEG,
+ PAVPicture(AVFrame), VideoCodecContext^.pix_fmt,
+ VideoCodecContext^.width, VideoCodecContext^.height);
+ {$ENDIF}
+
+ if (errnum < 0) then
+ begin
+ Log.LogError('Image conversion failed', 'TVideoPlayback_ffmpeg.GetFrame');
+ Exit;
+ end;
+
+ {$IFDEF VideoBenchmark}
+ Log.BenchmarkEnd(15);
+ Log.BenchmarkStart(16);
+ {$ENDIF}
+
+ // TODO: data is not padded, so we will need to tell OpenGL.
+ // Or should we add padding with avpicture_fill? (check which one is faster)
+ //glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
+
+ glBindTexture(GL_TEXTURE_2D, fVideoTex);
+ glTexSubImage2D(GL_TEXTURE_2D, 0, 0, 0,
+ VideoCodecContext^.width, VideoCodecContext^.height,
+ PIXEL_FMT_OPENGL, GL_UNSIGNED_BYTE, AVFrameRGB^.data[0]);
+
+ {$ifdef DebugFrames}
+ //frame decode debug display
+ GoldenRec.Spawn(200, 35, 1, 16, 0, -1, ColoredStar, $ffff00);
+ {$endif}
+
+ {$IFDEF VideoBenchmark}
+ Log.BenchmarkEnd(16);
+ Log.LogBenchmark('FFmpeg', 15);
+ Log.LogBenchmark('Texture', 16);
+ {$ENDIF}
+end;
+
+procedure TVideoPlayback_FFmpeg.DrawGL(Screen: integer);
+var
+ TexVideoRightPos, TexVideoLowerPos: Single;
+ ScreenLeftPos, ScreenRightPos: Single;
+ ScreenUpperPos, ScreenLowerPos: Single;
+ ScaledVideoWidth, ScaledVideoHeight: Single;
+ ScreenMidPosX, ScreenMidPosY: Single;
+ ScreenAspect: Single;
+begin
+ // have a nice black background to draw on (even if there were errors opening the vid)
+ if (Screen = 1) then
+ begin
+ glClearColor(0, 0, 0, 0);
+ glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
+ end;
+
+ // exit if there's nothing to draw
+ if (not fVideoOpened) then
+ Exit;
+
+ {$IFDEF VideoBenchmark}
+ Log.BenchmarkStart(15);
+ {$ENDIF}
+
+ // TODO: add a SetAspectCorrectionMode() function so we can switch
+ // aspect correction. The screens video backgrounds look very ugly with aspect
+ // correction because of the white bars at the top and bottom.
+
+ ScreenAspect := ScreenW / ScreenH;
+ ScaledVideoWidth := RenderW;
+ ScaledVideoHeight := RenderH * ScreenAspect/VideoAspect;
+
+ // Note: Scaling the width does not look good because the video might contain
+ // black borders at the top already
+ //ScaledVideoHeight := RenderH;
+ //ScaledVideoWidth := RenderW * VideoAspect/ScreenAspect;
+
+ // center the video
+ ScreenMidPosX := RenderW/2;
+ ScreenMidPosY := RenderH/2;
+ ScreenLeftPos := ScreenMidPosX - ScaledVideoWidth/2;
+ ScreenRightPos := ScreenMidPosX + ScaledVideoWidth/2;
+ ScreenUpperPos := ScreenMidPosY - ScaledVideoHeight/2;
+ ScreenLowerPos := ScreenMidPosY + ScaledVideoHeight/2;
+ // the video-texture contains empty borders because its width and height must be
+ // a power of 2. So we have to determine the texture coords of the video.
+ TexVideoRightPos := VideoCodecContext^.width / TexWidth;
+ TexVideoLowerPos := VideoCodecContext^.height / TexHeight;
+
+ // we could use blending for brightness control, but do we need this?
+ glDisable(GL_BLEND);
+
+ // TODO: disable other stuff like lightning, etc.
+
+ glEnable(GL_TEXTURE_2D);
+ glBindTexture(GL_TEXTURE_2D, fVideoTex);
+ glColor3f(1, 1, 1);
+ glBegin(GL_QUADS);
+ // upper-left coord
+ glTexCoord2f(0, 0);
+ glVertex2f(ScreenLeftPos, ScreenUpperPos);
+ // lower-left coord
+ glTexCoord2f(0, TexVideoLowerPos);
+ glVertex2f(ScreenLeftPos, ScreenLowerPos);
+ // lower-right coord
+ glTexCoord2f(TexVideoRightPos, TexVideoLowerPos);
+ glVertex2f(ScreenRightPos, ScreenLowerPos);
+ // upper-right coord
+ glTexCoord2f(TexVideoRightPos, 0);
+ glVertex2f(ScreenRightPos, ScreenUpperPos);
+ glEnd;
+ glDisable(GL_TEXTURE_2D);
+
+ {$IFDEF VideoBenchmark}
+ Log.BenchmarkEnd(15);
+ Log.LogBenchmark('DrawGL', 15);
+ {$ENDIF}
+
+ {$IFDEF Info}
+ if (fVideoSkipTime+VideoTime+VideoTimeBase < 0) then
+ begin
+ glColor4f(0.7, 1, 0.3, 1);
+ SetFontStyle (1);
+ SetFontItalic(False);
+ SetFontSize(9);
+ SetFontPos (300, 0);
+ glPrint('Delay due to negative VideoGap');
+ glColor4f(1, 1, 1, 1);
+ end;
+ {$ENDIF}
+
+ {$IFDEF DebugFrames}
+ glColor4f(0, 0, 0, 0.2);
+ glbegin(GL_QUADS);
+ glVertex2f(0, 0);
+ glVertex2f(0, 70);
+ glVertex2f(250, 70);
+ glVertex2f(250, 0);
+ glEnd;
+
+ glColor4f(1, 1, 1, 1);
+ SetFontStyle (1);
+ SetFontItalic(False);
+ SetFontSize(9);
+ SetFontPos (5, 0);
+ glPrint('delaying frame');
+ SetFontPos (5, 20);
+ glPrint('fetching frame');
+ SetFontPos (5, 40);
+ glPrint('dropping frame');
+ {$ENDIF}
+end;
+
+procedure TVideoPlayback_FFmpeg.Play;
+begin
+end;
+
+procedure TVideoPlayback_FFmpeg.Pause;
+begin
+ fVideoPaused := not fVideoPaused;
+end;
+
+procedure TVideoPlayback_FFmpeg.Stop;
+begin
+end;
+
+procedure TVideoPlayback_FFmpeg.SetPosition(Time: real);
+var
+ SeekFlags: integer;
+begin
+ if not fVideoOpened then
+ Exit;
+
+ if (Time < 0) then
+ Time := 0;
+
+ // TODO: handle loop-times
+ //Time := Time mod VideoDuration;
+
+ // backward seeking might fail without AVSEEK_FLAG_BACKWARD
+ SeekFlags := AVSEEK_FLAG_ANY;
+ if (Time < VideoTime) then
+ SeekFlags := SeekFlags or AVSEEK_FLAG_BACKWARD;
+
+ VideoTime := Time;
+ EOF := false;
+
+ if (av_seek_frame(VideoFormatContext, VideoStreamIndex, Floor(Time/VideoTimeBase), SeekFlags) < 0) then
+ begin
+ Log.LogError('av_seek_frame() failed', 'TVideoPlayback_ffmpeg.SetPosition');
+ Exit;
+ end;
+
+ avcodec_flush_buffers(VideoCodecContext);
+end;
+
+function TVideoPlayback_FFmpeg.GetPosition: real;
+begin
+ // TODO: return video-position in seconds
+ Result := VideoTime;
+end;
+
+initialization
+ MediaManager.Add(TVideoPlayback_FFmpeg.Create);
+
+end.
diff --git a/src/base/UVisualizer.pas b/src/base/UVisualizer.pas
new file mode 100644
index 00000000..e2125201
--- /dev/null
+++ b/src/base/UVisualizer.pas
@@ -0,0 +1,442 @@
+unit UVisualizer;
+
+(* TODO:
+ * - fix video/visualizer switching
+ * - use GL_EXT_framebuffer_object for rendering to a separate framebuffer,
+ * this will prevent plugins from messing up our render-context
+ * (-> no stack corruption anymore, no need for Save/RestoreOpenGLState()).
+ * - create a generic (C-compatible) interface for visualization plugins
+ * - create a visualization plugin manager
+ * - write a plugin for projectM in C/C++ (so we need no wrapper anymore)
+ *)
+
+{* Note:
+ * It would be easier to create a seperate Render-Context (RC) for projectM
+ * and switch to it when necessary. This can be achieved by pbuffers
+ * (slow and platform specific) or the OpenGL FramebufferObject (FBO) extension
+ * (fast and plattform-independent but not supported by older graphic-cards/drivers).
+ *
+ * See http://oss.sgi.com/projects/ogl-sample/registry/EXT/framebuffer_object.txt
+ *
+ * To support as many cards as possible we will stick to the current dirty
+ * solution for now even if it is a pain to save/restore projectM's state due
+ * to bugs etc.
+ *
+ * This also restricts us to projectM. As other plug-ins might have different
+ * needs and bugs concerning the OpenGL state, USDX's state would probably be
+ * corrupted after the plug-in finshed drawing.
+ *}
+
+interface
+
+{$IFDEF FPC}
+ {$MODE DELPHI}
+{$ENDIF}
+
+{$I switches.inc}
+
+uses
+ SDL,
+ UGraphicClasses,
+ textgl,
+ math,
+ gl,
+ SysUtils,
+ UIni,
+ projectM,
+ UMusic;
+
+implementation
+
+uses
+ UGraphic,
+ UMain,
+ UConfig,
+ ULog;
+
+{$IF PROJECTM_VERSION < 1000000} // < 1.0
+// Initialization data used on projectM 0.9x creation.
+// Since projectM 1.0 this data is passed via the config-file.
+const
+ meshX = 32;
+ meshY = 24;
+ fps = 30;
+ textureSize = 512;
+{$IFEND}
+
+type
+ TVideoPlayback_ProjectM = class( TInterfacedObject, IVideoPlayback, IVideoVisualization )
+ private
+ pm: TProjectM;
+ ProjectMPath : string;
+ Initialized: boolean;
+
+ VisualizerStarted: boolean;
+ VisualizerPaused: boolean;
+
+ VisualTex: GLuint;
+ PCMData: TPCMData;
+ RndPCMcount: integer;
+
+ projMatrix: array[0..3, 0..3] of GLdouble;
+ texMatrix: array[0..3, 0..3] of GLdouble;
+
+ procedure VisualizerStart;
+ procedure VisualizerStop;
+
+ procedure VisualizerTogglePause;
+
+ function GetRandomPCMData(var data: TPCMData): Cardinal;
+
+ procedure SaveOpenGLState();
+ procedure RestoreOpenGLState();
+
+ public
+ function GetName: String;
+
+ function Init(): boolean;
+ function Finalize(): boolean;
+
+ function Open(const aFileName : string): boolean; // true if succeed
+ procedure Close;
+
+ procedure Play;
+ procedure Pause;
+ procedure Stop;
+
+ procedure SetPosition(Time: real);
+ function GetPosition: real;
+
+ procedure GetFrame(Time: Extended);
+ procedure DrawGL(Screen: integer);
+ end;
+
+
+function TVideoPlayback_ProjectM.GetName: String;
+begin
+ Result := 'ProjectM';
+end;
+
+function TVideoPlayback_ProjectM.Init(): boolean;
+begin
+ Result := true;
+
+ if (Initialized) then
+ Exit;
+ Initialized := true;
+
+ RndPCMcount := 0;
+
+ ProjectMPath := ProjectM_DataDir + PathDelim;
+
+ VisualizerStarted := False;
+ VisualizerPaused := False;
+
+ {$IFDEF UseTexture}
+ glGenTextures(1, PglUint(@VisualTex));
+ glBindTexture(GL_TEXTURE_2D, VisualTex);
+
+ glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
+ glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);
+ {$ENDIF}
+end;
+
+function TVideoPlayback_ProjectM.Finalize(): boolean;
+begin
+ VisualizerStop();
+ {$IFDEF UseTexture}
+ glDeleteTextures(1, PglUint(@VisualTex));
+ {$ENDIF}
+ Result := true;
+end;
+
+function TVideoPlayback_ProjectM.Open(const aFileName : string): boolean; // true if succeed
+begin
+ Result := false;
+end;
+
+procedure TVideoPlayback_ProjectM.Close;
+begin
+ VisualizerStop();
+end;
+
+procedure TVideoPlayback_ProjectM.Play;
+begin
+ VisualizerStart();
+end;
+
+procedure TVideoPlayback_ProjectM.Pause;
+begin
+ VisualizerTogglePause();
+end;
+
+procedure TVideoPlayback_ProjectM.Stop;
+begin
+ VisualizerStop();
+end;
+
+procedure TVideoPlayback_ProjectM.SetPosition(Time: real);
+begin
+ if assigned(pm) then
+ pm.RandomPreset();
+end;
+
+function TVideoPlayback_ProjectM.GetPosition: real;
+begin
+ Result := 0;
+end;
+
+{**
+ * Saves the current OpenGL state.
+ * This is necessary to prevent projectM from corrupting USDX's current
+ * OpenGL state.
+ *
+ * The following steps are performed:
+ * - All attributes are pushed to the attribute-stack
+ * - Projection-/Texture-matrices are saved
+ * - Modelview-matrix is pushed to the Modelview-stack
+ * - the OpenGL error-state (glGetError) is cleared
+ *}
+procedure TVideoPlayback_ProjectM.SaveOpenGLState();
+begin
+ // save all OpenGL state-machine attributes
+ glPushAttrib(GL_ALL_ATTRIB_BITS);
+
+ // Note: we do not use glPushMatrix() for the GL_PROJECTION and GL_TEXTURE stacks.
+ // OpenGL specifies the depth of those stacks to be at least 2 but projectM
+ // already uses 2 stack-entries so overflows might be possible on older hardware.
+ // In contrast to this the GL_MODELVIEW stack-size is at least 32, so we can
+ // use glPushMatrix() for this stack.
+
+ // save projection-matrix
+ glMatrixMode(GL_PROJECTION);
+ glGetDoublev(GL_PROJECTION_MATRIX, @projMatrix);
+ {$IF PROJECTM_VERSION = 1000000} // 1.0, 1.01
+ // bugfix: projection-matrix is popped without being pushed first
+ glPushMatrix();
+ {$IFEND}
+
+ // save texture-matrix
+ glMatrixMode(GL_TEXTURE);
+ glGetDoublev(GL_TEXTURE_MATRIX, @texMatrix);
+
+ // save modelview-matrix
+ glMatrixMode(GL_MODELVIEW);
+ glPushMatrix();
+ {$IF PROJECTM_VERSION = 1000000} // 1.0, 1.01
+ // bugfix: modelview-matrix is popped without being pushed first
+ glPushMatrix();
+ {$IFEND}
+
+ // reset OpenGL error-state
+ glGetError();
+end;
+
+{**
+ * Restores the OpenGL state saved by SaveOpenGLState()
+ * and resets the error-state.
+ *}
+procedure TVideoPlayback_ProjectM.RestoreOpenGLState();
+begin
+ // reset OpenGL error-state
+ glGetError();
+
+ // restore projection-matrix
+ glMatrixMode(GL_PROJECTION);
+ glLoadMatrixd(@projMatrix);
+
+ // restore texture-matrix
+ glMatrixMode(GL_TEXTURE);
+ glLoadMatrixd(@texMatrix);
+
+ // restore modelview-matrix
+ glMatrixMode(GL_MODELVIEW);
+ glPopMatrix();
+
+ // restore all OpenGL state-machine attributes
+ glPopAttrib();
+end;
+
+procedure TVideoPlayback_ProjectM.VisualizerStart;
+begin
+ if VisualizerStarted then
+ Exit;
+
+ // the OpenGL state must be saved before
+ SaveOpenGLState();
+ try
+
+ try
+ {$IF PROJECTM_VERSION >= 1000000} // >= 1.0
+ pm := TProjectM.Create(ProjectMPath + 'config.inp');
+ {$ELSE}
+ pm := TProjectM.Create(
+ meshX, meshY, fps, textureSize, ScreenW, ScreenH,
+ ProjectMPath + 'presets', ProjectMPath + 'fonts');
+ {$IFEND}
+ except on E: Exception do
+ begin
+ // Create() might fail if the config-file is not found
+ Log.LogError('TProjectM.Create: ' + E.Message, 'TVideoPlayback_ProjectM.VisualizerStart');
+ Exit;
+ end;
+ end;
+
+ // initialize OpenGL
+ pm.ResetGL(ScreenW, ScreenH);
+ // skip projectM default-preset
+ pm.RandomPreset();
+ // projectM >= 1.0 uses the OpenGL FramebufferObject (FBO) extension.
+ // Unfortunately it does NOT reset the framebuffer-context after
+ // TProjectM.Create. Either glBindFramebufferEXT(GL_FRAMEBUFFER_EXT, 0) for
+ // a manual reset or TProjectM.RenderFrame() must be called.
+ // We use the latter so we do not need to load the FBO extension in USDX.
+ pm.RenderFrame();
+
+ VisualizerStarted := True;
+ finally
+ RestoreOpenGLState();
+ end;
+end;
+
+procedure TVideoPlayback_ProjectM.VisualizerStop;
+begin
+ if VisualizerStarted then
+ begin
+ VisualizerStarted := False;
+ FreeAndNil(pm);
+ end;
+end;
+
+procedure TVideoPlayback_ProjectM.VisualizerTogglePause;
+begin
+ VisualizerPaused := not VisualizerPaused;
+end;
+
+procedure TVideoPlayback_ProjectM.GetFrame(Time: Extended);
+var
+ nSamples: cardinal;
+ stackDepth: Integer;
+begin
+ if not VisualizerStarted then
+ Exit;
+
+ if VisualizerPaused then
+ Exit;
+
+ // get audio data
+ nSamples := AudioPlayback.GetPCMData(PcmData);
+
+ // generate some data if non is available
+ if (nSamples = 0) then
+ nSamples := GetRandomPCMData(PcmData);
+
+ // send audio-data to projectM
+ if (nSamples > 0) then
+ pm.AddPCM16Data(PSmallInt(@PcmData), nSamples);
+
+ // store OpenGL state (might be messed up otherwise)
+ SaveOpenGLState();
+ try
+ // setup projectM's OpenGL state
+ pm.ResetGL(ScreenW, ScreenH);
+
+ // let projectM render a frame
+ pm.RenderFrame();
+
+ {$IFDEF UseTexture}
+ glBindTexture(GL_TEXTURE_2D, VisualTex);
+ glFlush();
+ glCopyTexImage2D(GL_TEXTURE_2D, 0, GL_RGB, 0, 0, VisualWidth, VisualHeight, 0);
+ {$ENDIF}
+ finally
+ // restore USDX OpenGL state
+ RestoreOpenGLState();
+ end;
+
+ // discard projectM's depth buffer information (avoid overlay)
+ glClear(GL_DEPTH_BUFFER_BIT);
+end;
+
+{**
+ * Draws the current frame to screen.
+ * TODO: this is not used yet. Data is directly drawn on GetFrame().
+ *}
+procedure TVideoPlayback_ProjectM.DrawGL(Screen: integer);
+begin
+ {$IFDEF UseTexture}
+ // have a nice black background to draw on
+ if (Screen = 1) then
+ begin
+ glClearColor(0, 0, 0, 0);
+ glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
+ end;
+
+ // exit if there's nothing to draw
+ if not VisualizerStarted then
+ Exit;
+
+ // setup display
+ glMatrixMode(GL_PROJECTION);
+ glPushMatrix();
+ glLoadIdentity();
+ gluOrtho2D(0, 1, 0, 1);
+ glMatrixMode(GL_MODELVIEW);
+ glPushMatrix();
+ glLoadIdentity();
+
+ glEnable(GL_BLEND);
+ glEnable(GL_TEXTURE_2D);
+ glTexEnvf(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE);
+ glBindTexture(GL_TEXTURE_2D, VisualTex);
+ glColor4f(1, 1, 1, 1);
+
+ // draw projectM frame
+ glBegin(GL_QUADS);
+ glTexCoord2f(0, 0); glVertex2f(0, 0);
+ glTexCoord2f(1, 0); glVertex2f(1, 0);
+ glTexCoord2f(1, 1); glVertex2f(1, 1);
+ glTexCoord2f(0, 1); glVertex2f(0, 1);
+ glEnd();
+
+ glDisable(GL_TEXTURE_2D);
+ glDisable(GL_BLEND);
+
+ // restore state
+ glMatrixMode(GL_PROJECTION);
+ glPopMatrix();
+ glMatrixMode(GL_MODELVIEW);
+ glPopMatrix();
+ {$ENDIF}
+end;
+
+{**
+ * Produces random "sound"-data in case no audio-data is available.
+ * Otherwise the visualization will look rather boring.
+ *}
+function TVideoPlayback_ProjectM.GetRandomPCMData(var data: TPCMData): Cardinal;
+var
+ i: integer;
+begin
+ // Produce some fake PCM data
+ if (RndPCMcount mod 500 = 0) then
+ begin
+ FillChar(data, SizeOf(TPCMData), 0);
+ end
+ else
+ begin
+ for i := 0 to 511 do
+ begin
+ data[i][0] := Random(High(Word)+1);
+ data[i][1] := Random(High(Word)+1);
+ end;
+ end;
+ Inc(RndPCMcount);
+ Result := 512;
+end;
+
+
+initialization
+ MediaManager.Add(TVideoPlayback_ProjectM.Create);
+
+end.
diff --git a/src/base/UXMLSong.pas b/src/base/UXMLSong.pas
new file mode 100644
index 00000000..1a1fe6bc
--- /dev/null
+++ b/src/base/UXMLSong.pas
@@ -0,0 +1,573 @@
+unit UXMLSong;
+
+interface
+uses Classes;
+
+type
+ TNote = record
+ Start: Cardinal;
+ Duration: Cardinal;
+ Tone: Integer;
+ NoteTyp: Byte;
+ Lyric: String;
+ end;
+ ANote = Array of TNote;
+
+ TSentence = record
+ Singer: Byte;
+ Duration: Cardinal;
+ Notes: ANote;
+ end;
+ ASentence = Array of TSentence;
+
+ TSongInfo = Record
+ ID: Cardinal;
+ DualChannel: Boolean;
+ Header: Record
+ Artist: String;
+ Title: String;
+ Gap: Cardinal;
+ BPM: Real;
+ Resolution: Byte;
+ Edition: String;
+ Genre: String;
+ Year: String;
+ Language: String;
+ end;
+ CountSentences: Cardinal;
+ Sentences: ASentence;
+ end;
+
+ TParser = class
+ private
+ SSFile: TStringList;
+
+ ParserState: Byte;
+ CurPosinSong: Cardinal; //Cur Beat Pos in the Song
+ CurDuettSinger: Byte; //Who sings this Part?
+ BindLyrics: Boolean; //Should the Lyrics be bind to the last Word (no Space)
+ FirstNote: Boolean; //Is this the First Note found? For Gap calculating
+
+ Function ParseLine(Line: String): Boolean;
+ public
+ SongInfo: TSongInfo;
+ ErrorMessage: String;
+ Edition: String;
+ SingstarVersion: String;
+
+ Settings: Record
+ DashReplacement: Char;
+ end;
+
+ Constructor Create;
+
+ Function ParseConfigforEdition(const Filename: String): String;
+
+ Function ParseSongHeader(const Filename: String): Boolean; //Parse Song Header only
+ Function ParseSong (const Filename: String): Boolean; //Parse whole Song
+ end;
+
+const
+ PS_None = 0;
+ PS_Melody = 1;
+ PS_Sentence = 2;
+
+ NT_Normal = 1;
+ NT_Freestyle = 0;
+ NT_Golden = 2;
+
+ DS_Player1 = 1;
+ DS_Player2 = 2;
+ DS_Both = 3;
+
+implementation
+uses SysUtils, StrUtils;
+
+Constructor TParser.Create;
+begin
+ inherited Create;
+ ErrorMessage := '';
+
+ DecimalSeparator := '.';
+end;
+
+Function TParser.ParseSong (const Filename: String): Boolean;
+var I: Integer;
+begin
+ Result := False;
+ if FileExists(Filename) then
+ begin
+ SSFile := TStringList.Create;
+
+ try
+ ErrorMessage := 'Can''t open melody.xml file';
+ SSFile.LoadFromFile(Filename);
+ ErrorMessage := '';
+ Result := True;
+ I := 0;
+
+ SongInfo.CountSentences := 0;
+ CurDuettSinger := DS_Both; //Both is Singstar Standard
+ CurPosinSong := 0; //Start at Pos 0
+ BindLyrics := True; //Dont start with Space
+ FirstNote := True; //First Note found should be the First Note ;)
+
+ SongInfo.Header.Language := '';
+ SongInfo.Header.Edition := Edition;
+ SongInfo.DualChannel := False;
+
+ ParserState := PS_None;
+
+ SetLength(SongInfo.Sentences, 0);
+
+ While Result And (I < SSFile.Count) do
+ begin
+ Result := ParseLine(SSFile.Strings[I]);
+
+ Inc(I);
+ end;
+
+ finally
+ SSFile.Free;
+ end;
+ end;
+end;
+
+Function TParser.ParseSongHeader (const Filename: String): Boolean;
+var I: Integer;
+begin
+ Result := False;
+ if FileExists(Filename) then
+ begin
+ SSFile := TStringList.Create;
+ SSFile.Clear;
+
+ try
+ SSFile.LoadFromFile(Filename);
+
+ If (SSFile.Count > 0) then
+ begin
+ Result := True;
+ I := 0;
+
+ SongInfo.CountSentences := 0;
+ CurDuettSinger := DS_Both; //Both is Singstar Standard
+ CurPosinSong := 0; //Start at Pos 0
+ BindLyrics := True; //Dont start with Space
+ FirstNote := True; //First Note found should be the First Note ;)
+
+ SongInfo.ID := 0;
+ SongInfo.Header.Language := '';
+ SongInfo.Header.Edition := Edition;
+ SongInfo.DualChannel := False;
+ ParserState := PS_None;
+
+ While (SongInfo.ID < 4) AND Result And (I < SSFile.Count) do
+ begin
+ Result := ParseLine(SSFile.Strings[I]);
+
+ Inc(I);
+ end;
+ end
+ else
+ ErrorMessage := 'Can''t open melody.xml file';
+
+ finally
+ SSFile.Free;
+ end;
+ end
+ else
+ ErrorMessage := 'Can''t find melody.xml file';
+end;
+
+Function TParser.ParseLine(Line: String): Boolean;
+var
+ Tag: String;
+ Values: String;
+ AValues: Array of Record
+ Name: String;
+ Value: String;
+ end;
+ I, J, K: Integer;
+ Duration, Tone: Integer;
+ Lyric: String;
+ NoteType: Byte;
+
+ Procedure MakeValuesArray;
+ var Len, Pos, State, StateChange: Integer;
+ begin
+ Len := -1;
+ SetLength(AValues, Len + 1);
+
+ Pos := 1;
+ State := 0;
+ While (Pos <= Length(Values)) AND (Pos <> 0) do
+ begin
+ Case State of
+
+ 0: begin //Search for ValueName
+ If (Values[Pos] <> ' ') AND (Values[Pos] <> '=') then
+ begin
+ //Found Something
+ State := 1; //State search for '='
+ StateChange := Pos; //Save Pos of Change
+ Pos := PosEx('=', Values, Pos + 1);
+ end
+ else Inc(Pos); //When nothing found then go to next char
+ end;
+
+ 1: begin //Search for Equal Mark
+ //Add New Value
+ Inc(Len);
+ SetLength(AValues, Len + 1);
+
+ AValues[Len].Name := UpperCase(Copy(Values, StateChange, Pos - StateChange));
+
+
+ State := 2; //Now Search for starting '"'
+ StateChange := Pos; //Save Pos of Change
+ Pos := PosEx('"', Values, Pos + 1);
+ end;
+
+ 2: begin //Search for starting '"' or ' ' <- End if there was no "
+ If (Values[Pos] = '"') then
+ begin //Found starting '"'
+ State := 3; //Now Search for ending '"'
+ StateChange := Pos; //Save Pos of Change
+ Pos := PosEx('"', Values, Pos + 1);
+ end
+ else If (Values[Pos] = ' ') then //Found ending Space
+ begin
+ //Save Value to Array
+ AValues[Len].Value := Copy(Values, StateChange + 1, Pos - StateChange - 1);
+
+ //Search for next Valuename
+ State := 0;
+ StateChange := Pos;
+ Inc(Pos);
+ end;
+ end;
+
+ 3: begin //Search for ending '"'
+ //Save Value to Array
+ AValues[Len].Value := Copy(Values, StateChange + 1, Pos - StateChange - 1);
+
+ //Search for next Valuename
+ State := 0;
+ StateChange := Pos;
+ Inc(Pos);
+ end;
+ end;
+
+ If (State >= 2) then
+ begin //Save Last Value
+ AValues[Len].Value := Copy(Values, StateChange + 1, Length(Values) - StateChange);
+ end;
+ end;
+ end;
+begin
+ Result := True;
+
+ Line := Trim(Line);
+ If (Length(Line) > 0) then
+ begin
+ I := Pos('<', Line);
+ J := PosEx(' ', Line, I+1);
+ K := PosEx('>', Line, I+1);
+
+ If (J = 0) then J := K
+ Else If (K < J) AND (K <> 0) then J := K; //Use nearest Tagname End indicator
+ Tag := UpperCase(copy(Line, I + 1, J - I - 1));
+ Values := copy(Line, J + 1, K - J - 1);
+
+ Case ParserState of
+ PS_None: begin//Search for Melody Tag
+ If (Tag = 'MELODY') then
+ begin
+ Inc(SongInfo.ID); //Inc SongID when header Information is added
+ MakeValuesArray;
+ For I := 0 to High(AValues) do
+ begin
+ If (AValues[I].Name = 'TEMPO') then
+ begin
+ SongInfo.Header.BPM := StrtoFloatDef(AValues[I].Value, 0);
+ If (SongInfo.Header.BPM <= 0) then
+ begin
+ Result := False;
+ ErrorMessage := 'Can''t read BPM from Song';
+ end;
+ end
+
+ Else If (AValues[I].Name = 'RESOLUTION') then
+ begin
+ AValues[I].Value := Uppercase(AValues[I].Value);
+ //Ultrastar Resolution is "how often a Beat is split / 4"
+ If (AValues[I].Value = 'HEMIDEMISEMIQUAVER') then
+ SongInfo.Header.Resolution := 64 div 4
+ Else If (AValues[I].Value = 'DEMISEMIQUAVER') then
+ SongInfo.Header.Resolution := 32 div 4
+ Else If (AValues[I].Value = 'SEMIQUAVER') then
+ SongInfo.Header.Resolution := 16 div 4
+ Else If (AValues[I].Value = 'QUAVER') then
+ SongInfo.Header.Resolution := 8 div 4
+ Else If (AValues[I].Value = 'CROTCHET') then
+ SongInfo.Header.Resolution := 4 div 4
+ Else
+ begin //Can't understand teh Resolution :/
+ Result := False;
+ ErrorMessage := 'Can''t read Resolution from Song';
+ end;
+ end
+
+ Else If (AValues[I].Name = 'GENRE') then
+ begin
+ SongInfo.Header.Genre := AValues[I].Value;
+ end
+
+ Else If (AValues[I].Name = 'YEAR') then
+ begin
+ SongInfo.Header.Year := AValues[I].Value;
+ end
+
+ Else If (AValues[I].Name = 'VERSION') then
+ begin
+ SingstarVersion := AValues[I].Value;
+ end;
+ end;
+
+ ParserState := PS_Melody; //In Melody Tag
+ end;
+ end;
+
+
+ PS_Melody: begin //Search for Sentence, Artist/Title Info or eo Melody
+ If (Tag = 'SENTENCE') then
+ begin
+ ParserState := PS_Sentence; //Parse in a Sentence Tag now
+
+ //Increase SentenceCount
+ Inc(SongInfo.CountSentences);
+
+ BindLyrics := True; //Don't let Txts Begin w/ Space
+
+ //Search for Duett Singer Info
+ MakeValuesArray;
+ For I := 0 to High(AValues) do
+ If (AValues[I].Name = 'SINGER') then
+ begin
+ AValues[I].Value := Uppercase(AValues[I].Value);
+ If (AValues[I].Value = 'SOLO 1') then
+ CurDuettSinger := DS_Player1
+ Else If (AValues[I].Value = 'SOLO 2') then
+ CurDuettSinger := DS_Player2
+ Else
+ CurDuettSinger := DS_Both; //In case of "Group" or anything that is not identified use Both
+ end;
+ end
+
+ Else If (Tag = '!--') then
+ begin //Comment, this may be Artist or Title Info
+ I := Pos(':', Values); //Search for Delimiter
+
+ If (I <> 0) then //If Found check for Title or Artist
+ begin
+ //Copy Title or Artist Tag to Tag String
+ Tag := Uppercase(Trim(Copy(Values, 1, I - 1)));
+
+ If (Tag = 'ARTIST') then
+ begin
+ SongInfo.Header.Artist := Trim(Copy(Values, I + 1, Length(Values) - I - 2));
+ Inc(SongInfo.ID); //Inc SongID when header Information is added
+ end
+ Else If (Tag = 'TITLE') then
+ begin
+ SongInfo.Header.Title := Trim(Copy(Values, I + 1, Length(Values) - I - 2));
+ Inc(SongInfo.ID); //Inc SongID when header Information is added
+ end;
+ end;
+ end
+
+ //Parsing for weird "Die toten Hosen" Tags
+ Else If (Tag = '!--ARTIST:') OR (Tag = '!--ARTIST') then
+ begin //Comment, with Artist Info
+ I := Pos(':', Values); //Search for Delimiter
+
+ Inc(SongInfo.ID); //Inc SongID when header Information is added
+
+ SongInfo.Header.Artist := Trim(Copy(Values, I + 1, Length(Values) - I - 2));
+ end
+
+ Else If (Tag = '!--TITLE:') OR (Tag = '!--TITLE') then
+ begin //Comment, with Artist Info
+ I := Pos(':', Values); //Search for Delimiter
+
+ Inc(SongInfo.ID); //Inc SongID when header Information is added
+
+ SongInfo.Header.Title := Trim(Copy(Values, I + 1, Length(Values) - I - 2));
+ end
+
+ Else If (Tag = '/MELODY') then
+ begin
+ ParserState := PS_None;
+ Exit; //Stop Parsing, Melody iTag ended
+ end
+ end;
+
+
+ PS_Sentence: begin //Search for Notes or eo Sentence
+ If (Tag = 'NOTE') then
+ begin //Found Note
+ //Get Values
+ MakeValuesArray;
+
+ NoteType := NT_Normal;
+ For I := 0 to High(AValues) do
+ begin
+ If (AValues[I].Name = 'DURATION') then
+ begin
+ Duration := StrtoIntDef(AValues[I].Value, -1);
+ If (Duration < 0) then
+ begin
+ Result := False;
+ ErrorMessage := 'Can''t read duration from Note in Line: "' + Line + '"';
+ Exit;
+ end;
+ end
+ Else If (AValues[I].Name = 'MIDINOTE') then
+ begin
+ Tone := StrtoIntDef(AValues[I].Value, 0);
+ end
+ Else If (AValues[I].Name = 'BONUS') AND (Uppercase(AValues[I].Value) = 'YES') then
+ begin
+ NoteType := NT_Golden;
+ end
+ Else If (AValues[I].Name = 'FREESTYLE') AND (Uppercase(AValues[I].Value) = 'YES') then
+ begin
+ NoteType := NT_Freestyle;
+ end
+ Else If (AValues[I].Name = 'LYRIC') then
+ begin
+ Lyric := AValues[I].Value;
+
+ If (Length(Lyric) > 0) then
+ begin
+ If (Lyric = '-') then
+ Lyric[1] := Settings.DashReplacement;
+
+ If (not BindLyrics) then
+ Lyric := ' ' + Lyric;
+
+
+ If (Length(Lyric) > 2) AND (Lyric[Length(Lyric)-1] = ' ') AND (Lyric[Length(Lyric)] = '-') then
+ begin //Between this and the next Lyric should be no space
+ BindLyrics := True;
+ SetLength(Lyric, Length(Lyric) - 2);
+ end
+ else
+ BindLyrics := False; //There should be a Space
+ end;
+ end;
+ end;
+
+ //Add Note
+ I := SongInfo.CountSentences - 1;
+
+ If (Length(Lyric) > 0) then
+ begin //Real note, no rest
+ //First Note of Sentence
+ If (Length(SongInfo.Sentences) < SongInfo.CountSentences) then
+ begin
+ SetLength(SongInfo.Sentences, SongInfo.CountSentences);
+ SetLength(SongInfo.Sentences[I].Notes, 0);
+ end;
+
+ //First Note of Song -> Generate Gap
+ If (FirstNote) then
+ begin
+ //Calculate Gap
+ If (SongInfo.Header.Resolution <> 0) AND (SongInfo.Header.BPM <> 0) then
+ SongInfo.Header.Gap := Round(CurPosinSong / (SongInfo.Header.BPM*SongInfo.Header.Resolution) * 60000)
+ Else
+ begin
+ Result := False;
+ ErrorMessage := 'Can''t calculate Gap, no Resolution or BPM present.';
+ Exit;
+ end;
+
+ CurPosinSong := 0; //Start at 0, because Gap goes until here
+ Inc(SongInfo.ID); //Add Header Value therefore Inc
+ FirstNote := False;
+ end;
+
+ J := Length(SongInfo.Sentences[I].Notes);
+ SetLength(SongInfo.Sentences[I].Notes, J + 1);
+ SongInfo.Sentences[I].Notes[J].Start := CurPosinSong;
+ SongInfo.Sentences[I].Notes[J].Duration := Duration;
+ SongInfo.Sentences[I].Notes[J].Tone := Tone;
+ SongInfo.Sentences[I].Notes[J].NoteTyp := NoteType;
+ SongInfo.Sentences[I].Notes[J].Lyric := Lyric;
+
+ //Inc Pos in Song
+ Inc(CurPosInSong, Duration);
+ end
+ else
+ begin
+ //just change pos in Song
+ Inc(CurPosInSong, Duration);
+ end;
+
+
+ end
+ Else If (Tag = '/SENTENCE') then
+ begin //End of Sentence Tag
+ ParserState := PS_Melody;
+
+ //Delete Sentence if no Note is Added
+ If (Length(SongInfo.Sentences) <> SongInfo.CountSentences) then
+ begin
+ SongInfo.CountSentences := Length(SongInfo.Sentences);
+ end;
+ end;
+ end;
+ end;
+
+ end
+ else //Empty Line -> parsed succesful ;)
+ Result := true;
+end;
+
+Function TParser.ParseConfigforEdition(const Filename: String): String;
+var
+ txt: TStringlist;
+ I: Integer;
+ J, K: Integer;
+ S: String;
+begin
+ Result := '';
+ txt := TStringlist.Create;
+ try
+ txt.LoadFromFile(Filename);
+
+ For I := 0 to txt.Count-1 do
+ begin
+ S := Trim(txt.Strings[I]);
+ J := Pos('<PRODUCT_NAME>', S);
+
+ If (J <> 0) then
+ begin
+ Inc(J, 14);
+ K := Pos('</PRODUCT_NAME>', S);
+ If (K<J) then K := Length(S) + 1;
+
+ Result := Copy(S, J, K - J);
+ Break;
+ end;
+ end;
+
+ Edition := Result;
+ finally
+ txt.Free;
+ end;
+end;
+
+end.
diff --git a/src/base/uPluginLoader.pas b/src/base/uPluginLoader.pas
new file mode 100644
index 00000000..b2142702
--- /dev/null
+++ b/src/base/uPluginLoader.pas
@@ -0,0 +1,775 @@
+unit UPluginLoader;
+{*********************
+ UPluginLoader
+ Unit contains to Classes
+ TPluginLoader: Class Searching for and Loading the Plugins
+ TtehPlugins: Class that represents the Plugins in Modules chain
+*********************}
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+uses
+ UPluginDefs,
+ UCoreModule;
+
+type
+ TPluginListItem = record
+ Info: TUS_PluginInfo;
+ State: Byte; //State of this Plugin: 0 - undefined; 1 - Loaded; 2 - Inited / Running; 4 - Unloaded; 254 - Loading aborted by Plugin; 255 - Unloaded because of Error
+ Path: String; //Path to this Plugin
+ NeedsDeInit: Boolean; //If this is Inited correctly this should be true
+ hLib: THandle; //Handle of Loaded Libary
+ Procs: record //Procs offered by Plugin. Don't call this directly use wrappers of TPluginLoader
+ Load: Func_Load;
+ Init: Func_Init;
+ DeInit: Proc_DeInit;
+ end;
+ end;
+ {*********************
+ TPluginLoader
+ Class Searches for Plugins and Manages loading and unloading
+ *********************}
+ PPluginLoader = ^TPluginLoader;
+ TPluginLoader = class (TCoreModule)
+ private
+ LoadingProcessFinished: Boolean;
+ sUnloadPlugin: THandle;
+ sLoadPlugin: THandle;
+ sGetPluginInfo: THandle;
+ sGetPluginState: THandle;
+
+ procedure FreePlugin(Index: Cardinal);
+ public
+ PluginInterface: TUS_PluginInterface;
+ Plugins: array of TPluginListItem;
+
+ //TCoreModule methods to inherit
+ constructor Create; override;
+ procedure Info(const pInfo: PModuleInfo); override;
+ function Load: Boolean; override;
+ function Init: Boolean; override;
+ procedure DeInit; override;
+ Destructor Destroy; override;
+
+ //New Methods
+ procedure BrowseDir(Path: String); //Browses the Path at _Path_ for Plugins
+ function PluginExists(Name: String): integer; //If Plugin Exists: Index of Plugin, else -1
+ procedure AddPlugin(Filename: String);//Adds Plugin to the Array
+
+ function CallLoad(Index: Cardinal): integer;
+ function CallInit(Index: Cardinal): integer;
+ procedure CallDeInit(Index: Cardinal);
+
+ //Services offered
+ function LoadPlugin(wParam: TwParam; lParam: TlParam): integer; //wParam PChar(PluginName/PluginPath) | lParam (if wParam = nil) ID of the Plugin
+ function UnloadPlugin(wParam: TwParam; lParam: TlParam): integer; //wParam PChar(PluginName/PluginPath) | lParam (if wParam = nil) ID of the Plugin
+ function GetPluginInfo(wParam: TwParam; lParam: TlParam): integer; //If wParam = -1 then (If lParam = nil then get length of Moduleinfo Array. If lparam <> nil then write array of TUS_PluginInfo to address at lparam) else (Get PluginInfo of Plugin with Index(wParam) to Address at lParam)
+ function GetPluginState(wParam: TwParam; lParam: TlParam): integer; //If wParam = -1 then (If lParam = nil then get length of Moduleinfo Array. If lparam <> nil then write array of TUS_PluginInfo to address at lparam) else (Return PluginInfo of Plugin with Index(wParam))
+
+ end;
+
+ {*********************
+ TtehPlugins
+ Class Represents the Plugins in Module Chain.
+ It Calls the Plugins Procs and Funcs
+ *********************}
+ TtehPlugins = class (TCoreModule)
+ private
+ PluginLoader: PPluginLoader;
+ public
+ //TCoreModule methods to inherit
+ constructor Create; override;
+
+ procedure Info(const pInfo: PModuleInfo); override;
+ function Load: Boolean; override;
+ function Init: Boolean; override;
+ procedure DeInit; override;
+ end;
+
+const
+ {$IFDEF MSWINDOWS}
+ PluginFileExtension = '.dll';
+ {$ENDIF}
+ {$IFDEF LINUX}
+ PluginFileExtension = '.so';
+ {$ENDIF}
+ {$IFDEF DARWIN}
+ PluginFileExtension = '.dylib';
+ {$ENDIF}
+
+implementation
+
+uses
+ UCore,
+ UPluginInterface,
+{$IFDEF MSWINDOWS}
+ windows,
+{$ELSE}
+ dynlibs,
+{$ENDIF}
+ UMain,
+ SysUtils;
+
+{*********************
+ TPluginLoader
+ Implentation
+*********************}
+
+//-------------
+// function that gives some Infos about the Module to the Core
+//-------------
+procedure TPluginLoader.Info(const pInfo: PModuleInfo);
+begin
+ pInfo^.Name := 'TPluginLoader';
+ pInfo^.Version := MakeVersion(1,0,0,chr(0));
+ pInfo^.Description := 'Searches for Plugins, loads and unloads them';
+end;
+
+//-------------
+// Just the Constructor
+//-------------
+constructor TPluginLoader.Create;
+begin
+ inherited;
+
+ //Init PluginInterface
+ //Using Methods from UPluginInterface
+ PluginInterface.CreateHookableEvent := CreateHookableEvent;
+ PluginInterface.DestroyHookableEvent := DestroyHookableEvent;
+ PluginInterface.NotivyEventHooks := NotivyEventHooks;
+ PluginInterface.HookEvent := HookEvent;
+ PluginInterface.UnHookEvent := UnHookEvent;
+ PluginInterface.EventExists := EventExists;
+
+ PluginInterface.CreateService := @CreateService;
+ PluginInterface.DestroyService := DestroyService;
+ PluginInterface.CallService := CallService;
+ PluginInterface.ServiceExists := ServiceExists;
+
+ //UnSet Private Var
+ LoadingProcessFinished := False;
+end;
+
+//-------------
+//Is Called on Loading.
+//In this Method only Events and Services should be created
+//to offer them to other Modules or Plugins during the Init process
+//If False is Returned this will cause a Forced Exit
+//-------------
+function TPluginLoader.Load: Boolean;
+begin
+ Result := True;
+
+ try
+ //Start Searching for Plugins
+ BrowseDir(PluginPath);
+ except
+ Result := False;
+ Core.ReportError(integer(PChar('Error Browsing and Loading.')), PChar('TPluginLoader'));
+ end;
+end;
+
+//-------------
+//Is Called on Init Process
+//In this Method you can Hook some Events and Create + Init
+//your Classes, Variables etc.
+//If False is Returned this will cause a Forced Exit
+//-------------
+function TPluginLoader.Init: Boolean;
+begin
+ //Just set Prvate Var to true.
+ LoadingProcessFinished := True;
+ Result := True;
+end;
+
+//-------------
+//Is Called if this Module has been Inited and there is a Exit.
+//Deinit is in backwards Initing Order
+//-------------
+procedure TPluginLoader.DeInit;
+var
+ I: integer;
+begin
+ //Force DeInit
+ //If some Plugins aren't DeInited for some Reason o0
+ for I := 0 to High(Plugins) do
+ begin
+ if (Plugins[I].State < 4) then
+ FreePlugin(I);
+ end;
+
+ //Nothing to do here. Core will remove the Hooks
+end;
+
+//-------------
+//Is Called if this Module will be unloaded and has been created
+//Should be used to Free Memory
+//-------------
+Destructor TPluginLoader.Destroy;
+begin
+ //Just save some Memory if it wasn't done now..
+ SetLength(Plugins, 0);
+ inherited;
+end;
+
+//--------------
+// Browses the Path at _Path_ for Plugins
+//--------------
+procedure TPluginLoader.BrowseDir(Path: String);
+var
+ SR: TSearchRec;
+begin
+ //Search for other Dirs to Browse
+ if FindFirst(Path + '*', faDirectory, SR) = 0 then begin
+ repeat
+ if (SR.Name <> '.') and (SR.Name <> '..') then
+ BrowseDir(Path + Sr.Name + PathDelim);
+ until FindNext(SR) <> 0;
+ end;
+ FindClose(SR);
+
+ //Search for Plugins at Path
+ if FindFirst(Path + '*' + PluginFileExtension, 0, SR) = 0 then
+ begin
+ repeat
+ AddPlugin(Path + SR.Name);
+ until FindNext(SR) <> 0;
+ end;
+ FindClose(SR);
+end;
+
+//--------------
+// If Plugin Exists: Index of Plugin, else -1
+//--------------
+function TPluginLoader.PluginExists(Name: String): integer;
+var
+ I: integer;
+begin
+ Result := -1;
+
+ if (Length(Name) <= 32 { =>Length(TUS_PluginInfo.Name)}) then
+ begin
+ for I := 0 to High(Plugins) do
+ if (Plugins[I].Info.Name = Name) then
+ begin //Found the Plugin
+ Result := I;
+ Break;
+ end;
+ end;
+end;
+
+//--------------
+// Adds Plugin to the Array
+//--------------
+procedure TPluginLoader.AddPlugin(Filename: String);
+var
+ hLib: THandle;
+ PInfo: Proc_PluginInfo;
+ Info: TUS_PluginInfo;
+ PluginID: integer;
+begin
+ if (FileExists(Filename)) then
+ begin //Load Libary
+ hLib := LoadLibrary(PChar(Filename));
+ if (hLib <> 0) then
+ begin //Try to get Address of the Info Proc
+ PInfo := GetProcAddress (hLib, PChar('USPlugin_Info'));
+ if (@PInfo <> nil) then
+ begin
+ Info.cbSize := SizeOf(TUS_PluginInfo);
+
+ try //Call Info Proc
+ PInfo(@Info);
+ except
+ Info.Name := '';
+ Core.ReportError(integer(PChar('Error getting Plugin Info: ' + Filename)), PChar('TPluginLoader'));
+ end;
+
+ //Is Name set ?
+ if (Trim(Info.Name) <> '') then
+ begin
+ PluginID := PluginExists(Info.Name);
+
+ if (PluginID > 0) and (Plugins[PluginID].State >=4) then
+ PluginID := -1;
+
+ if (PluginID = -1) then
+ begin
+ //Add new item to array
+ PluginID := Length(Plugins);
+ SetLength(Plugins, PluginID + 1);
+
+ //Fill with Info:
+ Plugins[PluginID].Info := Info;
+ Plugins[PluginID].State := 0;
+ Plugins[PluginID].Path := Filename;
+ Plugins[PluginID].NeedsDeInit := False;
+ Plugins[PluginID].hLib := hLib;
+
+ //Try to get Procs
+ Plugins[PluginID].Procs.Load := GetProcAddress (hLib, PChar('USPlugin_Load'));
+ Plugins[PluginID].Procs.Init := GetProcAddress (hLib, PChar('USPlugin_Init'));
+ Plugins[PluginID].Procs.DeInit := GetProcAddress (hLib, PChar('USPlugin_DeInit'));
+
+ if (@Plugins[PluginID].Procs.Load = nil) OR (@Plugins[PluginID].Procs.Init = nil) OR (@Plugins[PluginID].Procs.DeInit = nil) then
+ begin
+ Plugins[PluginID].State := 255;
+ FreeLibrary(hLib);
+ Core.ReportError(integer(PChar('Can''t get Plugin Procs from Libary: "' + Info.Name + '" ' + Filename)), PChar('TPluginLoader'));
+ end;
+
+ //Emulate loading process if this Plugin is loaded to late
+ if (LoadingProcessFinished) then
+ begin
+ CallLoad(PluginID);
+ CallInit(PluginID);
+ end;
+ end
+ else if (LoadingProcessFinished = False) then
+ begin
+ if (Plugins[PluginID].Info.Version < Info.Version) then
+ begin //Found newer Version of this Plugin
+ Core.ReportDebug(integer(PChar('Found a newer Version of Plugin: ' + String(Info.Name))), PChar('TPluginLoader'));
+
+ //Unload Old Plugin
+ UnloadPlugin(PluginID, nil);
+
+ //Fill with new Info
+ Plugins[PluginID].Info := Info;
+ Plugins[PluginID].State := 0;
+ Plugins[PluginID].Path := Filename;
+ Plugins[PluginID].NeedsDeInit := False;
+ Plugins[PluginID].hLib := hLib;
+
+ //Try to get Procs
+ Plugins[PluginID].Procs.Load := GetProcAddress (hLib, PChar('USPlugin_Load'));
+ Plugins[PluginID].Procs.Init := GetProcAddress (hLib, PChar('USPlugin_Init'));
+ Plugins[PluginID].Procs.DeInit := GetProcAddress (hLib, PChar('USPlugin_DeInit'));
+
+ if (@Plugins[PluginID].Procs.Load = nil) OR (@Plugins[PluginID].Procs.Init = nil) OR (@Plugins[PluginID].Procs.DeInit = nil) then
+ begin
+ FreeLibrary(hLib);
+ Plugins[PluginID].State := 255;
+ Core.ReportError(integer(PChar('Can''t get Plugin Procs from Libary: "' + Info.Name + '" ' + Filename)), PChar('TPluginLoader'));
+ end;
+ end
+ else
+ begin //Newer Version already loaded
+ FreeLibrary(hLib);
+ end;
+ end
+ else
+ begin
+ FreeLibrary(hLib);
+ Core.ReportError(integer(PChar('Plugin with this Name already exists: ' + String(Info.Name))), PChar('TPluginLoader'));
+ end;
+ end
+ else
+ begin
+ FreeLibrary(hLib);
+ Core.ReportError(integer(PChar('No name reported: ' + Filename)), PChar('TPluginLoader'));
+ end;
+ end
+ else
+ begin
+ FreeLibrary(hLib);
+ Core.ReportError(integer(PChar('Can''t find Info procedure: ' + Filename)), PChar('TPluginLoader'));
+ end;
+ end
+ else
+ Core.ReportError(integer(PChar('Can''t load Plugin Libary: ' + Filename)), PChar('TPluginLoader'));
+ end;
+end;
+
+//--------------
+// Calls Load Func of Plugin with the given Index
+//--------------
+function TPluginLoader.CallLoad(Index: Cardinal): integer;
+begin
+ Result := -2;
+ if(Index < Length(Plugins)) then
+ begin
+ if (@Plugins[Index].Procs.Load <> nil) and (Plugins[Index].State = 0) then
+ begin
+ try
+ Result := Plugins[Index].Procs.Load(@PluginInterface);
+ except
+ Result := -3;
+ End;
+
+ if (Result = 0) then
+ Plugins[Index].State := 1
+ else
+ begin
+ FreePlugin(Index);
+ Plugins[Index].State := 255;
+ Core.ReportError(integer(PChar('Error calling Load function from Plugin: ' + String(Plugins[Index].Info.Name))), PChar('TPluginLoader'));
+ end;
+ end;
+ end;
+end;
+
+//--------------
+// Calls Init Func of Plugin with the given Index
+//--------------
+function TPluginLoader.CallInit(Index: Cardinal): integer;
+begin
+ Result := -2;
+ if(Index < Length(Plugins)) then
+ begin
+ if (@Plugins[Index].Procs.Init <> nil) and (Plugins[Index].State = 1) then
+ begin
+ try
+ Result := Plugins[Index].Procs.Init(@PluginInterface);
+ except
+ Result := -3;
+ End;
+
+ if (Result = 0) then
+ begin
+ Plugins[Index].State := 2;
+ Plugins[Index].NeedsDeInit := True;
+ end
+ else
+ begin
+ FreePlugin(Index);
+ Plugins[Index].State := 255;
+ Core.ReportError(integer(PChar('Error calling Init function from Plugin: ' + String(Plugins[Index].Info.Name))), PChar('TPluginLoader'));
+ end;
+ end;
+ end;
+end;
+
+//--------------
+// Calls DeInit Proc of Plugin with the given Index
+//--------------
+procedure TPluginLoader.CallDeInit(Index: Cardinal);
+begin
+ if(Index < Length(Plugins)) then
+ begin
+ if (Plugins[Index].State < 4) then
+ begin
+ if (@Plugins[Index].Procs.DeInit <> nil) and (Plugins[Index].NeedsDeInit) then
+ try
+ Plugins[Index].Procs.DeInit(@PluginInterface);
+ except
+
+ End;
+
+ //Don't forget to remove Services and Subscriptions by this Plugin
+ Core.Hooks.DelbyOwner(-1 - Index);
+
+ FreePlugin(Index);
+ end;
+ end;
+end;
+
+//--------------
+// Frees all Plugin Sources (Procs and Handles) - Helper for Deiniting Functions
+//--------------
+procedure TPluginLoader.FreePlugin(Index: Cardinal);
+begin
+ Plugins[Index].State := 4;
+ Plugins[Index].Procs.Load := nil;
+ Plugins[Index].Procs.Init := nil;
+ Plugins[Index].Procs.DeInit := nil;
+
+ if (Plugins[Index].hLib <> 0) then
+ FreeLibrary(Plugins[Index].hLib);
+end;
+
+
+
+//--------------
+// wParam PChar(PluginName/PluginPath) | wParam (if lParam = nil) ID of the Plugin
+//--------------
+function TPluginLoader.LoadPlugin(wParam: TwParam; lParam: TlParam): integer;
+var
+ Index: integer;
+ sFile: String;
+begin
+ Result := -1;
+ sFile := '';
+ //lParam is ID
+ if (lParam = nil) then
+ begin
+ Index := wParam;
+ end
+ else
+ begin //lParam is PChar
+ try
+ sFile := String(PChar(lParam));
+ Index := PluginExists(sFile);
+ if (Index < 0) And FileExists(sFile) then
+ begin //Is Filename
+ AddPlugin(sFile);
+ Result := Plugins[High(Plugins)].State;
+ end;
+ except
+ Index := -2;
+ end;
+ end;
+
+
+ if (Index >= 0) and (Index < Length(Plugins)) then
+ begin
+ AddPlugin(Plugins[Index].Path);
+ Result := Plugins[Index].State;
+ end;
+end;
+
+//--------------
+// wParam PChar(PluginName/PluginPath) | wParam (if lParam = nil) ID of the Plugin
+//--------------
+function TPluginLoader.UnloadPlugin(wParam: TwParam; lParam: TlParam): integer;
+var
+ Index: integer;
+ sName: String;
+begin
+ Result := -1;
+ //lParam is ID
+ if (lParam = nil) then
+ begin
+ Index := wParam;
+ end
+ else
+ begin //wParam is PChar
+ try
+ sName := String(PChar(lParam));
+ Index := PluginExists(sName);
+ except
+ Index := -2;
+ end;
+ end;
+
+
+ if (Index >= 0) and (Index < Length(Plugins)) then
+ CallDeInit(Index)
+end;
+
+//--------------
+// if wParam = -1 then (if lParam = nil then get length of Moduleinfo Array. if lparam <> nil then write array of TUS_PluginInfo to address at lparam) else (Get PluginInfo of Plugin with Index(wParam) to Address at lParam)
+//--------------
+function TPluginLoader.GetPluginInfo(wParam: TwParam; lParam: TlParam): integer;
+var I: integer;
+begin
+ Result := 0;
+ if (wParam > 0) then
+ begin //Get Info of 1 Plugin
+ if (lParam <> nil) and (wParam < Length(Plugins)) then
+ begin
+ try
+ Result := 1;
+ PUS_PluginInfo(lParam)^ := Plugins[wParam].Info;
+ except
+
+ End;
+ end;
+ end
+ else if (lParam = nil) then
+ begin //Get Length of Plugin (Info) Array
+ Result := Length(Plugins);
+ end
+ else //Write PluginInfo Array to Address in lParam
+ begin
+ try
+ for I := 0 to high(Plugins) do
+ PAUS_PluginInfo(lParam)^[I] := Plugins[I].Info;
+ Result := Length(Plugins);
+ except
+ Core.ReportError(integer(PChar('Could not write PluginInfo Array')), PChar('TPluginLoader'));
+ End;
+ end;
+
+end;
+
+//--------------
+// if wParam = -1 then (if lParam = nil then get length of Plugin State Array. if lparam <> nil then write array of Byte to address at lparam) else (Return State of Plugin with Index(wParam))
+//--------------
+function TPluginLoader.GetPluginState(wParam: TwParam; lParam: TlParam): integer;
+var I: integer;
+begin
+ Result := -1;
+ if (wParam > 0) then
+ begin //Get State of 1 Plugin
+ if (wParam < Length(Plugins)) then
+ begin
+ Result := Plugins[wParam].State;
+ end;
+ end
+ else if (lParam = nil) then
+ begin //Get Length of Plugin (Info) Array
+ Result := Length(Plugins);
+ end
+ else //Write PluginInfo Array to Address in lParam
+ begin
+ try
+ for I := 0 to high(Plugins) do
+ Byte(Pointer(integer(lParam) + I)^) := Plugins[I].State;
+ Result := Length(Plugins);
+ except
+ Core.ReportError(integer(PChar('Could not write PluginState Array')), PChar('TPluginLoader'));
+ End;
+ end;
+end;
+
+
+{*********************
+ TtehPlugins
+ Implentation
+*********************}
+
+//-------------
+// function that gives some Infos about the Module to the Core
+//-------------
+procedure TtehPlugins.Info(const pInfo: PModuleInfo);
+begin
+ pInfo^.Name := 'TtehPlugins';
+ pInfo^.Version := MakeVersion(1,0,0,chr(0));
+ pInfo^.Description := 'Module executing the Plugins!';
+end;
+
+//-------------
+// Just the Constructor
+//-------------
+constructor TtehPlugins.Create;
+begin
+ inherited;
+ PluginLoader := nil;
+end;
+
+//-------------
+//Is Called on Loading.
+//In this Method only Events and Services should be created
+//to offer them to other Modules or Plugins during the Init process
+//If False is Returned this will cause a Forced Exit
+//-------------
+function TtehPlugins.Load: Boolean;
+var
+ i: integer; //Counter
+ CurExecutedBackup: integer; //backup of Core.CurExecuted Attribute
+begin
+ //Get Pointer to PluginLoader
+ PluginLoader := PPluginLoader(Core.GetModulebyName('TPluginLoader'));
+ if (PluginLoader = nil) then
+ begin
+ Result := false;
+ Core.ReportError(integer(PChar('Could not get Pointer to PluginLoader')), PChar('TtehPlugins'));
+ end
+ else
+ begin
+ Result := true;
+
+ //Backup CurExecuted
+ CurExecutedBackup := Core.CurExecuted;
+
+ //Start Loading the Plugins
+ for i := 0 to High(PluginLoader.Plugins) do
+ begin
+ Core.CurExecuted := -1 - i;
+
+ try
+ //Unload Plugin if not correctly Executed
+ if (PluginLoader.CallLoad(i) <> 0) then
+ begin
+ PluginLoader.CallDeInit(i);
+ PluginLoader.Plugins[i].State := 254; //Plugin asks for unload
+ Core.ReportDebug(integer(PChar('Plugin Selfabort during loading process: ' + String(PluginLoader.Plugins[i].Info.Name))), PChar('TtehPlugins'));
+ end
+ else
+ begin
+ Core.ReportDebug(integer(PChar('Plugin loaded succesful: ' + String(PluginLoader.Plugins[i].Info.Name))), PChar('TtehPlugins'));
+ end;
+ except
+ //Plugin could not be loaded.
+ // => Show Error Message, then ShutDown Plugin
+ on E: Exception do
+ begin
+ PluginLoader.CallDeInit(i);
+ PluginLoader.Plugins[i].State := 255; //Plugin causes Error
+ Core.ReportError(integer(PChar('Plugin causes Error during loading process: ' + PluginLoader.Plugins[i].Info.Name + ', ErrorMsg: "' + E.Message + '"')), PChar('TtehPlugins'));
+ end;
+ end;
+ end;
+
+ //Reset CurExecuted
+ Core.CurExecuted := CurExecutedBackup;
+ end;
+end;
+
+//-------------
+//Is Called on Init Process
+//In this Method you can Hook some Events and Create + Init
+//your Classes, Variables etc.
+//If False is Returned this will cause a Forced Exit
+//-------------
+function TtehPlugins.Init: Boolean;
+var
+ i: integer; //Counter
+ CurExecutedBackup: integer; //backup of Core.CurExecuted Attribute
+begin
+ Result := true;
+
+ //Backup CurExecuted
+ CurExecutedBackup := Core.CurExecuted;
+
+ //Start Loading the Plugins
+ for i := 0 to High(PluginLoader.Plugins) do
+ try
+ Core.CurExecuted := -1 - i;
+
+ //Unload Plugin if not correctly Executed
+ if (PluginLoader.CallInit(i) <> 0) then
+ begin
+ PluginLoader.CallDeInit(i);
+ PluginLoader.Plugins[i].State := 254; //Plugin asks for unload
+ Core.ReportDebug(integer(PChar('Plugin Selfabort during init process: ' + String(PluginLoader.Plugins[i].Info.Name))), PChar('TtehPlugins'));
+ end
+ else
+ Core.ReportDebug(integer(PChar('Plugin inited succesful: ' + String(PluginLoader.Plugins[i].Info.Name))), PChar('TtehPlugins'));
+ except
+ //Plugin could not be loaded.
+ // => Show Error Message, then ShutDown Plugin
+ PluginLoader.CallDeInit(i);
+ PluginLoader.Plugins[i].State := 255; //Plugin causes Error
+ Core.ReportError(integer(PChar('Plugin causes Error during init process: ' + String(PluginLoader.Plugins[i].Info.Name))), PChar('TtehPlugins'));
+ end;
+
+ //Reset CurExecuted
+ Core.CurExecuted := CurExecutedBackup;
+end;
+
+//-------------
+//Is Called if this Module has been Inited and there is a Exit.
+//Deinit is in backwards Initing Order
+//-------------
+procedure TtehPlugins.DeInit;
+var
+ i: integer; //Counter
+ CurExecutedBackup: integer; //backup of Core.CurExecuted Attribute
+begin
+ //Backup CurExecuted
+ CurExecutedBackup := Core.CurExecuted;
+
+ //Start Loop
+
+ for i := 0 to High(PluginLoader.Plugins) do
+ begin
+ try
+ //DeInit Plugin
+ PluginLoader.CallDeInit(i);
+ except
+ end;
+ end;
+
+ //Reset CurExecuted
+ Core.CurExecuted := CurExecutedBackup;
+end;
+
+end.
diff --git a/src/classes/TextGL.pas b/src/classes/TextGL.pas
deleted file mode 100644
index f7b3ac95..00000000
--- a/src/classes/TextGL.pas
+++ /dev/null
@@ -1,462 +0,0 @@
-unit TextGL;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses
- gl,
- SDL,
- UTexture,
- Classes,
-// SDL_ttf,
- ULog;
-
-procedure BuildFont; // build our bitmap font
-procedure KillFont; // delete the font
-function glTextWidth(text: PChar): real; // returns text width
-procedure glPrintLetter(letter: char);
-procedure glPrint(text: pchar); // custom GL "Print" routine
-procedure SetFontPos(X, Y: real); // sets X and Y
-procedure SetFontZ(Z: real); // sets Z
-procedure SetFontSize(Size: real);
-procedure SetFontStyle(Style: integer); // sets active font style (normal, bold, etc)
-procedure SetFontItalic(Enable: boolean); // sets italic type letter (works for all fonts)
-procedure SetFontAspectW(Aspect: real);
-procedure SetFontReflection(Enable:boolean;Spacing: real); // enables/disables text reflection
-procedure SetFontBlend(Enable: boolean); // enables/disables blending
-
-//function NextPowerOfTwo(Value: integer): integer;
-// Checks if the ttf exists, if yes then a SDL_ttf is returned
-//function LoadFont(FileName: PAnsiChar; PointSize: integer):PTTF_Font;
-// Does the renderstuff, color is in $ffeecc style
-//function RenderText(font: PTTF_Font; Text:PAnsiChar; Color: Cardinal):PSDL_Surface;
-
-type
- TTextGL = record
- X: real;
- Y: real;
- Z: real;
- Text: string;
- Size: real;
- ColR: real;
- ColG: real;
- ColB: real;
- end;
-
- PFont = ^TFont;
- TFont = record
- Tex: TTexture;
- Width: array[0..255] of byte;
- AspectW: real;
- Centered: boolean;
- Outline: real;
- Italic: boolean;
- Reflection: boolean;
- ReflectionSpacing: real;
- Blend: boolean;
- end;
-
-
-var
- Fonts: array of TFont;
- ActFont: integer;
-
-
-implementation
-
-uses
- UMain,
- UCommon,
- SysUtils,
- UGraphic;
-
-var
- // Colours for the reflection
- TempColor: array[0..3] of GLfloat;
-
-procedure LoadBitmapFontInfo(aID : integer; const aType, aResourceName: string);
-var
- stream: TStream;
-begin
- stream := GetResourceStream(aResourceName, aType);
- if (not assigned(stream)) then
- begin
- Log.LogError('Unknown font['+ inttostr(aID) +': '+aType+']', 'loadfont');
- Exit;
- end;
- try
- stream.Read(Fonts[ aID ].Width, 256);
- except
- Log.LogError('Error while reading font['+ inttostr(aID) +': '+aType+']', 'loadfont');
- end;
- stream.Free;
-end;
-
-// Builds bitmap fonts
-procedure BuildFont;
-var
- Count: integer;
-begin
- ActFont := 0;
-
- SetLength(Fonts, 5);
- Fonts[0].Tex := Texture.LoadTexture(true, 'Font', TEXTURE_TYPE_TRANSPARENT, 0);
- Fonts[0].Tex.H := 30;
- Fonts[0].AspectW := 0.9;
- Fonts[0].Outline := 0;
-
- Fonts[1].Tex := Texture.LoadTexture(true, 'FontB', TEXTURE_TYPE_TRANSPARENT, 0);
- Fonts[1].Tex.H := 30;
- Fonts[1].AspectW := 1;
- Fonts[1].Outline := 0;
-
- Fonts[2].Tex := Texture.LoadTexture(true, 'FontO', TEXTURE_TYPE_TRANSPARENT, 0);
- Fonts[2].Tex.H := 30;
- Fonts[2].AspectW := 0.95;
- Fonts[2].Outline := 5;
-
- Fonts[3].Tex := Texture.LoadTexture(true, 'FontO2', TEXTURE_TYPE_TRANSPARENT, 0);
- Fonts[3].Tex.H := 30;
- Fonts[3].AspectW := 0.95;
- Fonts[3].Outline := 4;
-
-{ Fonts[4].Tex := Texture.LoadTexture('FontO', TEXTURE_TYPE_TRANSPARENT, 0); // for score screen
- Fonts[4].Tex.H := 30;
- Fonts[4].AspectW := 0.95;
- Fonts[4].Done := -1;
- Fonts[4].Outline := 5;}
-
- // load font info
- LoadBitmapFontInfo( 0, 'FNT', 'Font');
- LoadBitmapFontInfo( 1, 'FNT', 'FontB');
- LoadBitmapFontInfo( 2, 'FNT', 'FontO');
- LoadBitmapFontInfo( 3, 'FNT', 'FontO2');
-
- for Count := 0 to 255 do
- Fonts[1].Width[Count] := Fonts[1].Width[Count] div 2;
-
- for Count := 0 to 255 do
- Fonts[2].Width[Count] := Fonts[2].Width[Count] div 2 + 2;
-
- for Count := 0 to 255 do
- Fonts[3].Width[Count] := Fonts[3].Width[Count] + 1;
-
-{ for Count := 0 to 255 do
- Fonts[4].Width[Count] := Fonts[4].Width[Count] div 2 + 2;}
-
- // enable blending by default
- for Count := 0 to High(Fonts) do
- Fonts[Count].Blend := true;
-end;
-
-// Deletes the font
-procedure KillFont;
-begin
- // delete all characters
- //glDeleteLists(..., 256);
-end;
-
-function glTextWidth(text: pchar): real;
-var
- Letter: char;
- i: integer;
-begin
- Result := 0;
- for i := 0 to Length(text) -1 do
- begin
- Letter := Text[i];
- Result := Result + Fonts[ActFont].Width[Ord(Letter)] * Fonts[ActFont].Tex.H / 30 * Fonts[ActFont].AspectW;
- end;
-end;
-
-procedure glPrintLetter(Letter: char);
-var
- TexX, TexY: real;
- TexR, TexB: real;
- TexHeight: real;
- FWidth: real;
- PL, PT: real;
- PR, PB: real;
- XItal: real; // X shift for italic type letter
- ReflectionSpacing: real; // Distance of the reflection
- Font: PFont;
- Tex: PTexture;
-begin
- Font := @Fonts[ActFont];
- Tex := @Font.Tex;
-
- FWidth := Font.Width[Ord(Letter)];
-
- Tex.W := FWidth * (Tex.H/30) * Font.AspectW;
-
- // set texture positions
- TexX := (ord(Letter) mod 16) * 1/16 + 1/32 - FWidth/1024 - Font.Outline/1024;
- TexY := (ord(Letter) div 16) * 1/16 + 2/1024;
- TexR := (ord(Letter) mod 16) * 1/16 + 1/32 + FWidth/1024 + Font.Outline/1024;
- TexB := (1 + ord(Letter) div 16) * 1/16 - 2/1024;
-
- TexHeight := TexB - TexY;
-
- // set vector positions
- PL := Tex.X - Font.Outline * (Tex.H/30) * Font.AspectW /2;
- PT := Tex.Y;
- PR := PL + Tex.W + Font.Outline * (Tex.H/30) * Font.AspectW;
- PB := PT + Tex.H;
-
- if (not Font.Italic) then
- XItal := 0
- else
- XItal := 12;
-
- if (Font.Blend) then
- begin
- glEnable(GL_BLEND);
- glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
- end;
-
- glEnable(GL_TEXTURE_2D);
- glBindTexture(GL_TEXTURE_2D, Tex.TexNum);
-
- glBegin(GL_QUADS);
- glTexCoord2f(TexX, TexY); glVertex2f(PL+XItal, PT);
- glTexCoord2f(TexX, TexB); glVertex2f(PL, PB);
- glTexCoord2f(TexR, TexB); glVertex2f(PR, PB);
- glTexCoord2f(TexR, TexY); glVertex2f(PR+XItal, PT);
- glEnd;
-
- // <mog> Reflection
- // Yes it would make sense to put this in an extra procedure,
- // but this works, doesn't take much lines, and is almost lightweight
- if Font.Reflection then
- begin
- ReflectionSpacing := Font.ReflectionSpacing + Tex.H/2;
-
- glDepthRange(0, 10);
- glDepthFunc(GL_LEQUAL);
- glEnable(GL_DEPTH_TEST);
-
- glBegin(GL_QUADS);
- glColor4f(TempColor[0], TempColor[1], TempColor[2], 0);
- glTexCoord2f(TexX, TexY + TexHeight/2);
- glVertex3f(PL, PB + ReflectionSpacing - Tex.H/2, Tex.z);
-
- glColor4f(TempColor[0], TempColor[1], TempColor[2], Tex.Alpha-0.3);
- glTexCoord2f(TexX, TexB );
- glVertex3f(PL + XItal, PT + ReflectionSpacing, Tex.z);
-
- glTexCoord2f(TexR, TexB );
- glVertex3f(PR + XItal, PT + ReflectionSpacing, Tex.z);
-
- glColor4f(TempColor[0], TempColor[1], TempColor[2], 0);
- glTexCoord2f(TexR, TexY + TexHeight/2);
- glVertex3f(PR, PB + ReflectionSpacing - Tex.H/2, Tex.z);
- glEnd;
-
- glDisable(GL_DEPTH_TEST);
- end; // reflection
-
- glDisable(GL_TEXTURE_2D);
- if (Font.Blend) then
- glDisable(GL_BLEND);
-
- Tex.X := Tex.X + Tex.W;
-
- //write the colour back
- glColor4fv(@TempColor);
-end;
-
-// Custom GL "Print" Routine
-procedure glPrint(Text: PChar);
-var
- Pos: integer;
-begin
- // if there is no text do nothing
- if ((Text = nil) or (Text = '')) then
- Exit;
-
- //Save the actual color and alpha (for reflection)
- glGetFloatv(GL_CURRENT_COLOR, @TempColor);
-
- for Pos := 0 to Length(Text) - 1 do
- begin
- glPrintLetter(Text[Pos]);
- end;
-end;
-
-procedure SetFontPos(X, Y: real);
-begin
- Fonts[ActFont].Tex.X := X;
- Fonts[ActFont].Tex.Y := Y;
-end;
-
-procedure SetFontZ(Z: real);
-begin
- Fonts[ActFont].Tex.Z := Z;
-end;
-
-procedure SetFontSize(Size: real);
-begin
- Fonts[ActFont].Tex.H := 30 * (Size/10);
-end;
-
-procedure SetFontStyle(Style: integer);
-begin
- ActFont := Style;
-end;
-
-procedure SetFontItalic(Enable: boolean);
-begin
- Fonts[ActFont].Italic := Enable;
-end;
-
-procedure SetFontAspectW(Aspect: real);
-begin
- Fonts[ActFont].AspectW := Aspect;
-end;
-
-procedure SetFontReflection(Enable: boolean; Spacing: real);
-begin
- Fonts[ActFont].Reflection := Enable;
- Fonts[ActFont].ReflectionSpacing := Spacing;
-end;
-
-procedure SetFontBlend(Enable: boolean);
-begin
- Fonts[ActFont].Blend := Enable;
-end;
-
-
-
-
-(*
-<mog> I uncommented this, because it was some kind of after hour hack together with blindy
-it's actually just a prove of concept, as it's having some flaws
-- instead nice and clean ttf code should be placed here :)
-
-{$IFDEF FPC}
- {$ASMMODE Intel}
-{$ENDIF}
-
-function NextPowerOfTwo(Value: integer): integer;
-begin
- Result:= 1;
-{$IF Defined(CPUX86_64)}
- asm
- mov rcx, -1
- bsr rcx, Value
- inc rcx
- shl Result, cl
- end;
-{$ELSEIF Defined(CPU386) or Defined(CPUI386)}
- asm
- mov ecx, -1
- bsr ecx, Value
- inc ecx
- shl Result, cl
- end;
-{$ELSE}
- while (Result <= Value) do
- Result := 2 * Result;
-{$IFEND}
-end;
-
-function LoadFont(FileName: PAnsiChar; PointSize: integer):PTTF_Font;
-begin
- if (FileExists(FileName)) then
- begin
- Result := TTF_OpenFont( FileName, PointSize );
- end
- else
- begin
- Log.LogStatus('ERROR Could not find font in ' + FileName , '');
- ShowMessage( 'ERROR Could not find font in ' + FileName );
- Result := nil;
- end;
-end;
-
-function RenderText(font: PTTF_Font; Text:PAnsiChar; Color: Cardinal): PSDL_Surface;
-var
- clr : TSDL_color;
-begin
- clr.r := ((Color and $ff0000) shr 16 ) div 255;
- clr.g := ((Color and $ff00 ) shr 8 ) div 255;
- clr.b := ( Color and $ff ) div 255 ;
-
- result := TTF_RenderText_Blended( font, text, cLr);
-end;
-
-procedure printrandomtext();
-var
- stext,intermediary : PSDL_surface;
- clrFg, clrBG : TSDL_color;
- texture : Gluint;
- font : PTTF_Font;
- w,h : integer;
-begin
-
- font := LoadFont('fonts\comicbd.ttf', 42);
-
- clrFg.r := 255;
- clrFg.g := 255;
- clrFg.b := 255;
- clrFg.unused := 255;
-
- clrBg.r := 255;
- clrbg.g := 0;
- clrbg.b := 255;
- clrbg.unused := 0;
-
- sText := RenderText(font, 'katzeeeeeee', $fe198e);
- //sText := TTF_RenderText_Blended( font, 'huuuuuuuuuund', clrFG);
-
- // Convert the rendered text to a known format
- w := nextpoweroftwo(sText.w);
- h := nextpoweroftwo(sText.h);
-
- intermediary := SDL_CreateRGBSurface(0, w, h, 32,
- $000000ff, $0000ff00, $00ff0000, $ff000000);
-
- SDL_SetAlpha(intermediary, 0, 255);
- SDL_SetAlpha(sText, 0, 255);
- SDL_BlitSurface(sText, nil, intermediary, nil);
-
- glGenTextures(1, @texture);
-
- glBindTexture(GL_TEXTURE_2D, texture);
-
- glTexImage2D(GL_TEXTURE_2D, 0, 4, w, h, 0, GL_RGBA, GL_UNSIGNED_BYTE, intermediary.pixels);
-
- glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
- glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
-
- glEnable(GL_TEXTURE_2D);
- glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
- glEnable(GL_BLEND);
- glBindTexture(GL_TEXTURE_2D, texture);
- glColor4f(1, 0, 1, 1);
-
- glbegin(gl_quads);
- glTexCoord2f(0, 0); glVertex2f(200 , 300 );
- glTexCoord2f(0, sText.h/h); glVertex2f(200 , 300 + sText.h);
- glTexCoord2f(sText.w/w, sText.h/h); glVertex2f(200 + sText.w, 300 + sText.h);
- glTexCoord2f(sText.w/w, 0); glVertex2f(200 + sText.w, 300 );
- glEnd;
- glfinish();
- glDisable(GL_BLEND);
- gldisable(gl_texture_2d);
-
- SDL_FreeSurface(sText);
- SDL_FreeSurface(intermediary);
- glDeleteTextures(1, @texture);
- TTF_CloseFont(font);
-
-end;
-*)
-
-
-end.
diff --git a/src/classes/UAudioConverter.pas b/src/classes/UAudioConverter.pas
deleted file mode 100644
index 5647f27b..00000000
--- a/src/classes/UAudioConverter.pas
+++ /dev/null
@@ -1,458 +0,0 @@
-unit UAudioConverter;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses
- UMusic,
- ULog,
- ctypes,
- {$IFDEF UseSRCResample}
- samplerate,
- {$ENDIF}
- {$IFDEF UseFFmpegResample}
- avcodec,
- {$ENDIF}
- UMediaCore_SDL,
- sdl,
- SysUtils,
- Math;
-
-type
- {*
- * Notes:
- * - 44.1kHz to 48kHz conversion or vice versa is not supported
- * by SDL 1.2 (will be introduced in 1.3).
- * No conversion takes place in this cases.
- * This is because SDL just converts differences in powers of 2.
- * So the result might not be that accurate.
- * This IS audible (voice to high/low) and it needs good synchronization
- * with the video or the lyrics timer.
- * - float<->int16 conversion is not supported (will be part of 1.3) and
- * SDL (<1.3) is not capable of handling floats at all.
- * -> Using FFmpeg or libsamplerate for resampling is preferred.
- * Use SDL for channel and format conversion only.
- *}
- TAudioConverter_SDL = class(TAudioConverter)
- private
- cvt: TSDL_AudioCVT;
- public
- function Init(SrcFormatInfo: TAudioFormatInfo; DstFormatInfo: TAudioFormatInfo): boolean; override;
- destructor Destroy(); override;
-
- function Convert(InputBuffer: PChar; OutputBuffer: PChar; var InputSize: integer): integer; override;
- function GetOutputBufferSize(InputSize: integer): integer; override;
- function GetRatio(): double; override;
- end;
-
- {$IFDEF UseFFmpegResample}
- // Note: FFmpeg seems to be using "kaiser windowed sinc" for resampling, so
- // the quality should be good.
- TAudioConverter_FFmpeg = class(TAudioConverter)
- private
- // TODO: use SDL for multi-channel->stereo and format conversion
- ResampleContext: PReSampleContext;
- Ratio: double;
- public
- function Init(SrcFormatInfo: TAudioFormatInfo; DstFormatInfo: TAudioFormatInfo): boolean; override;
- destructor Destroy(); override;
-
- function Convert(InputBuffer: PChar; OutputBuffer: PChar; var InputSize: integer): integer; override;
- function GetOutputBufferSize(InputSize: integer): integer; override;
- function GetRatio(): double; override;
- end;
- {$ENDIF}
-
- {$IFDEF UseSRCResample}
- TAudioConverter_SRC = class(TAudioConverter)
- private
- ConverterState: PSRC_STATE;
- ConversionData: SRC_DATA;
- FormatConverter: TAudioConverter;
- public
- function Init(SrcFormatInfo: TAudioFormatInfo; DstFormatInfo: TAudioFormatInfo): boolean; override;
- destructor Destroy(); override;
-
- function Convert(InputBuffer: PChar; OutputBuffer: PChar; var InputSize: integer): integer; override;
- function GetOutputBufferSize(InputSize: integer): integer; override;
- function GetRatio(): double; override;
- end;
-
- // Note: SRC (=libsamplerate) provides several converters with different quality
- // speed trade-offs. The SINC-types are slow but offer best quality.
- // The SRC_SINC_* converters are too slow for realtime conversion,
- // (SRC_SINC_FASTEST is approx. ten times slower than SRC_LINEAR) resulting
- // in audible clicks and pops.
- // SRC_LINEAR is very fast and should have a better quality than SRC_ZERO_ORDER_HOLD
- // because it interpolates the samples. Normal "non-audiophile" users should not
- // be able to hear a difference between the SINC_* ones and LINEAR. Especially
- // if people sing along with the song.
- // But FFmpeg might offer a better quality/speed ratio than SRC_LINEAR.
- const
- SRC_CONVERTER_TYPE = SRC_LINEAR;
- {$ENDIF}
-
-implementation
-
-function TAudioConverter_SDL.Init(srcFormatInfo: TAudioFormatInfo; dstFormatInfo: TAudioFormatInfo): boolean;
-var
- srcFormat: UInt16;
- dstFormat: UInt16;
-begin
- inherited Init(SrcFormatInfo, DstFormatInfo);
-
- Result := false;
-
- if (not ConvertAudioFormatToSDL(srcFormatInfo.Format, srcFormat) or
- not ConvertAudioFormatToSDL(dstFormatInfo.Format, dstFormat)) then
- begin
- Log.LogError('Audio-format not supported by SDL', 'TSoftMixerPlaybackStream.InitFormatConversion');
- Exit;
- end;
-
- if (SDL_BuildAudioCVT(@cvt,
- srcFormat, srcFormatInfo.Channels, Round(srcFormatInfo.SampleRate),
- dstFormat, dstFormatInfo.Channels, Round(dstFormatInfo.SampleRate)) = -1) then
- begin
- Log.LogError(SDL_GetError(), 'TSoftMixerPlaybackStream.InitFormatConversion');
- Exit;
- end;
-
- Result := true;
-end;
-
-destructor TAudioConverter_SDL.Destroy();
-begin
- // nothing to be done here
- inherited;
-end;
-
-(*
- * Returns the size of the output buffer. This might be bigger than the actual
- * size of resampled audio data.
- *)
-function TAudioConverter_SDL.GetOutputBufferSize(InputSize: integer): integer;
-begin
- // Note: len_ratio must not be used here. Even if the len_ratio is 1.0, len_mult might be 2.
- // Example: 44.1kHz/mono to 22.05kHz/stereo -> len_ratio=1, len_mult=2
- Result := InputSize * cvt.len_mult;
-end;
-
-function TAudioConverter_SDL.GetRatio(): double;
-begin
- Result := cvt.len_ratio;
-end;
-
-function TAudioConverter_SDL.Convert(InputBuffer: PChar; OutputBuffer: PChar; var InputSize: integer): integer;
-begin
- Result := -1;
-
- if (InputSize <= 0) then
- begin
- // avoid div-by-zero problems
- if (InputSize = 0) then
- Result := 0;
- Exit;
- end;
-
- // OutputBuffer is always bigger than or equal to InputBuffer
- Move(InputBuffer[0], OutputBuffer[0], InputSize);
- cvt.buf := PUint8(OutputBuffer);
- cvt.len := InputSize;
- if (SDL_ConvertAudio(@cvt) = -1) then
- Exit;
-
- Result := cvt.len_cvt;
-end;
-
-
-{$IFDEF UseFFmpegResample}
-
-function TAudioConverter_FFmpeg.Init(SrcFormatInfo: TAudioFormatInfo; DstFormatInfo: TAudioFormatInfo): boolean;
-begin
- inherited Init(SrcFormatInfo, DstFormatInfo);
-
- Result := false;
-
- // Note: ffmpeg does not support resampling for more than 2 input channels
-
- if (srcFormatInfo.Format <> asfS16) then
- begin
- Log.LogError('Unsupported format', 'TAudioConverter_FFmpeg.Init');
- Exit;
- end;
-
- // TODO: use SDL here
- if (srcFormatInfo.Format <> dstFormatInfo.Format) then
- begin
- Log.LogError('Incompatible formats', 'TAudioConverter_FFmpeg.Init');
- Exit;
- end;
-
- ResampleContext := audio_resample_init(
- dstFormatInfo.Channels, srcFormatInfo.Channels,
- Round(dstFormatInfo.SampleRate), Round(srcFormatInfo.SampleRate));
- if (ResampleContext = nil) then
- begin
- Log.LogError('audio_resample_init() failed', 'TAudioConverter_FFmpeg.Init');
- Exit;
- end;
-
- // calculate ratio
- Ratio := (dstFormatInfo.Channels / srcFormatInfo.Channels) *
- (dstFormatInfo.SampleRate / srcFormatInfo.SampleRate);
-
- Result := true;
-end;
-
-destructor TAudioConverter_FFmpeg.Destroy();
-begin
- if (ResampleContext <> nil) then
- audio_resample_close(ResampleContext);
- inherited;
-end;
-
-function TAudioConverter_FFmpeg.Convert(InputBuffer: PChar; OutputBuffer: PChar; var InputSize: integer): integer;
-var
- InputSampleCount: integer;
- OutputSampleCount: integer;
-begin
- Result := -1;
-
- if (InputSize <= 0) then
- begin
- // avoid div-by-zero in audio_resample()
- if (InputSize = 0) then
- Result := 0;
- Exit;
- end;
-
- InputSampleCount := InputSize div SrcFormatInfo.FrameSize;
- OutputSampleCount := audio_resample(
- ResampleContext, PSmallInt(OutputBuffer), PSmallInt(InputBuffer),
- InputSampleCount);
- if (OutputSampleCount = -1) then
- begin
- Log.LogError('audio_resample() failed', 'TAudioConverter_FFmpeg.Convert');
- Exit;
- end;
- Result := OutputSampleCount * DstFormatInfo.FrameSize;
-end;
-
-function TAudioConverter_FFmpeg.GetOutputBufferSize(InputSize: integer): integer;
-begin
- Result := Ceil(InputSize * GetRatio());
-end;
-
-function TAudioConverter_FFmpeg.GetRatio(): double;
-begin
- Result := Ratio;
-end;
-
-{$ENDIF}
-
-
-{$IFDEF UseSRCResample}
-
-function TAudioConverter_SRC.Init(SrcFormatInfo: TAudioFormatInfo; DstFormatInfo: TAudioFormatInfo): boolean;
-var
- error: integer;
- TempSrcFormatInfo: TAudioFormatInfo;
- TempDstFormatInfo: TAudioFormatInfo;
-begin
- inherited Init(SrcFormatInfo, DstFormatInfo);
-
- Result := false;
-
- FormatConverter := nil;
-
- // SRC does not handle channel or format conversion
- if ((SrcFormatInfo.Channels <> DstFormatInfo.Channels) or
- not (SrcFormatInfo.Format in [asfS16, asfFloat])) then
- begin
- // SDL can not convert to float, so we have to convert to SInt16 first
- TempSrcFormatInfo := TAudioFormatInfo.Create(
- SrcFormatInfo.Channels, SrcFormatInfo.SampleRate, SrcFormatInfo.Format);
- TempDstFormatInfo := TAudioFormatInfo.Create(
- DstFormatInfo.Channels, SrcFormatInfo.SampleRate, asfS16);
-
- // init format/channel conversion
- FormatConverter := TAudioConverter_SDL.Create();
- if (not FormatConverter.Init(TempSrcFormatInfo, TempDstFormatInfo)) then
- begin
- Log.LogError('Unsupported input format', 'TAudioConverter_SRC.Init');
- FormatConverter.Free;
- // exit after the format-info is freed
- end;
-
- // this info was copied so we do not need it anymore
- TempSrcFormatInfo.Free;
- TempDstFormatInfo.Free;
-
- // leave if the format is not supported
- if (not assigned(FormatConverter)) then
- Exit;
-
- // adjust our copy of the input audio-format for SRC conversion
- Self.SrcFormatInfo.Channels := DstFormatInfo.Channels;
- Self.SrcFormatInfo.Format := asfS16;
- end;
-
- if ((DstFormatInfo.Format <> asfS16) and
- (DstFormatInfo.Format <> asfFloat)) then
- begin
- Log.LogError('Unsupported output format', 'TAudioConverter_SRC.Init');
- Exit;
- end;
-
- ConversionData.src_ratio := DstFormatInfo.SampleRate / SrcFormatInfo.SampleRate;
- if (src_is_valid_ratio(ConversionData.src_ratio) = 0) then
- begin
- Log.LogError('Invalid samplerate ratio', 'TAudioConverter_SRC.Init');
- Exit;
- end;
-
- ConverterState := src_new(SRC_CONVERTER_TYPE, DstFormatInfo.Channels, @error);
- if (ConverterState = nil) then
- begin
- Log.LogError('src_new() failed: ' + src_strerror(error), 'TAudioConverter_SRC.Init');
- Exit;
- end;
-
- Result := true;
-end;
-
-destructor TAudioConverter_SRC.Destroy();
-begin
- if (ConverterState <> nil) then
- src_delete(ConverterState);
- FormatConverter.Free;
- inherited;
-end;
-
-function TAudioConverter_SRC.Convert(InputBuffer: PChar; OutputBuffer: PChar; var InputSize: integer): integer;
-var
- FloatInputBuffer: PSingle;
- FloatOutputBuffer: PSingle;
- TempBuffer: PChar;
- TempSize: integer;
- NumSamples: integer;
- OutputSize: integer;
- error: integer;
-begin
- Result := -1;
-
- TempBuffer := nil;
-
- // format conversion with external converter (to correct number of channels and format)
- if (assigned(FormatConverter)) then
- begin
- TempSize := FormatConverter.GetOutputBufferSize(InputSize);
- GetMem(TempBuffer, TempSize);
- InputSize := FormatConverter.Convert(InputBuffer, TempBuffer, InputSize);
- InputBuffer := TempBuffer;
- end;
-
- if (InputSize <= 0) then
- begin
- // avoid div-by-zero problems
- if (InputSize = 0) then
- Result := 0;
- if (TempBuffer <> nil) then
- FreeMem(TempBuffer);
- Exit;
- end;
-
- if (SrcFormatInfo.Format = asfFloat) then
- begin
- FloatInputBuffer := PSingle(InputBuffer);
- end else begin
- NumSamples := InputSize div AudioSampleSize[SrcFormatInfo.Format];
- GetMem(FloatInputBuffer, NumSamples * SizeOf(Single));
- src_short_to_float_array(PCshort(InputBuffer), PCfloat(FloatInputBuffer), NumSamples);
- end;
-
- // calculate approx. output size
- OutputSize := Ceil(InputSize * ConversionData.src_ratio);
-
- if (DstFormatInfo.Format = asfFloat) then
- begin
- FloatOutputBuffer := PSingle(OutputBuffer);
- end else begin
- NumSamples := OutputSize div AudioSampleSize[DstFormatInfo.Format];
- GetMem(FloatOutputBuffer, NumSamples * SizeOf(Single));
- end;
-
- with ConversionData do
- begin
- data_in := PCFloat(FloatInputBuffer);
- input_frames := InputSize div SrcFormatInfo.FrameSize;
- data_out := PCFloat(FloatOutputBuffer);
- output_frames := OutputSize div DstFormatInfo.FrameSize;
- // TODO: set this to 1 at end of file-playback
- end_of_input := 0;
- end;
-
- error := src_process(ConverterState, @ConversionData);
- if (error <> 0) then
- begin
- Log.LogError(src_strerror(error), 'TAudioConverter_SRC.Convert');
- if (SrcFormatInfo.Format <> asfFloat) then
- FreeMem(FloatInputBuffer);
- if (DstFormatInfo.Format <> asfFloat) then
- FreeMem(FloatOutputBuffer);
- if (TempBuffer <> nil) then
- FreeMem(TempBuffer);
- Exit;
- end;
-
- if (SrcFormatInfo.Format <> asfFloat) then
- FreeMem(FloatInputBuffer);
-
- if (DstFormatInfo.Format <> asfFloat) then
- begin
- NumSamples := ConversionData.output_frames_gen * DstFormatInfo.Channels;
- src_float_to_short_array(PCfloat(FloatOutputBuffer), PCshort(OutputBuffer), NumSamples);
- FreeMem(FloatOutputBuffer);
- end;
-
- // free format conversion buffer if used
- if (TempBuffer <> nil) then
- FreeMem(TempBuffer);
-
- if (assigned(FormatConverter)) then
- InputSize := ConversionData.input_frames_used * FormatConverter.SrcFormatInfo.FrameSize
- else
- InputSize := ConversionData.input_frames_used * SrcFormatInfo.FrameSize;
-
- // set result to output size according to SRC
- Result := ConversionData.output_frames_gen * DstFormatInfo.FrameSize;
-end;
-
-function TAudioConverter_SRC.GetOutputBufferSize(InputSize: integer): integer;
-begin
- Result := Ceil(InputSize * GetRatio());
-end;
-
-function TAudioConverter_SRC.GetRatio(): double;
-begin
- // if we need additional channel/format conversion, use this ratio
- if (assigned(FormatConverter)) then
- Result := FormatConverter.GetRatio()
- else
- Result := 1.0;
-
- // now the SRC ratio (Note: the format might change from SInt16 to float)
- Result := Result *
- ConversionData.src_ratio *
- (DstFormatInfo.FrameSize / SrcFormatInfo.FrameSize);
-end;
-
-{$ENDIF}
-
-end.
\ No newline at end of file
diff --git a/src/classes/UAudioCore_Bass.pas b/src/classes/UAudioCore_Bass.pas
deleted file mode 100644
index beb2db16..00000000
--- a/src/classes/UAudioCore_Bass.pas
+++ /dev/null
@@ -1,123 +0,0 @@
-unit UAudioCore_Bass;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses
- Classes,
- SysUtils,
- UMusic,
- bass; // (Note: DWORD is defined here)
-
-type
- TAudioCore_Bass = class
- public
- constructor Create();
- class function GetInstance(): TAudioCore_Bass;
- function ErrorGetString(): string; overload;
- function ErrorGetString(errCode: integer): string; overload;
- function ConvertAudioFormatToBASSFlags(Format: TAudioSampleFormat; out Flags: DWORD): boolean;
- function ConvertBASSFlagsToAudioFormat(Flags: DWORD; out Format: TAudioSampleFormat): boolean;
- end;
-
-implementation
-
-uses
- UMain,
- ULog;
-
-var
- Instance: TAudioCore_Bass;
-
-constructor TAudioCore_Bass.Create();
-begin
- inherited;
-end;
-
-class function TAudioCore_Bass.GetInstance(): TAudioCore_Bass;
-begin
- if (not Assigned(Instance)) then
- Instance := TAudioCore_Bass.Create();
- Result := Instance;
-end;
-
-function TAudioCore_Bass.ErrorGetString(): string;
-begin
- Result := ErrorGetString(BASS_ErrorGetCode());
-end;
-
-function TAudioCore_Bass.ErrorGetString(errCode: integer): string;
-begin
- case errCode of
- BASS_OK: result := 'No error';
- BASS_ERROR_MEM: result := 'Insufficient memory';
- BASS_ERROR_FILEOPEN: result := 'File could not be opened';
- BASS_ERROR_DRIVER: result := 'Device driver not available';
- BASS_ERROR_BUFLOST: result := 'Buffer lost';
- BASS_ERROR_HANDLE: result := 'Invalid Handle';
- BASS_ERROR_FORMAT: result := 'Sample-Format not supported';
- BASS_ERROR_POSITION: result := 'Illegal position';
- BASS_ERROR_INIT: result := 'BASS_Init has not been successfully called';
- BASS_ERROR_START: result := 'Paused/stopped';
- BASS_ERROR_ALREADY: result := 'Already created/used';
- BASS_ERROR_NOCHAN: result := 'No free channels';
- BASS_ERROR_ILLTYPE: result := 'Type is invalid';
- BASS_ERROR_ILLPARAM: result := 'Illegal parameter';
- BASS_ERROR_NO3D: result := 'No 3D support';
- BASS_ERROR_NOEAX: result := 'No EAX support';
- BASS_ERROR_DEVICE: result := 'Invalid device number';
- BASS_ERROR_NOPLAY: result := 'Channel not playing';
- BASS_ERROR_FREQ: result := 'Freq out of range';
- BASS_ERROR_NOTFILE: result := 'Not a file stream';
- BASS_ERROR_NOHW: result := 'No hardware support';
- BASS_ERROR_EMPTY: result := 'Is empty';
- BASS_ERROR_NONET: result := 'Network unavailable';
- BASS_ERROR_CREATE: result := 'Creation error';
- BASS_ERROR_NOFX: result := 'DX8 effects unavailable';
- BASS_ERROR_NOTAVAIL: result := 'Not available';
- BASS_ERROR_DECODE: result := 'Is a decoding channel';
- BASS_ERROR_DX: result := 'Insufficient version of DirectX';
- BASS_ERROR_TIMEOUT: result := 'Timeout';
- BASS_ERROR_FILEFORM: result := 'File-Format not recognised/supported';
- BASS_ERROR_SPEAKER: result := 'Requested speaker(s) not support';
- BASS_ERROR_VERSION: result := 'Version error';
- BASS_ERROR_CODEC: result := 'Codec not available/supported';
- BASS_ERROR_ENDED: result := 'The channel/file has ended';
- BASS_ERROR_UNKNOWN: result := 'Unknown error';
- else result := 'Unknown error';
- end;
-end;
-
-function TAudioCore_Bass.ConvertAudioFormatToBASSFlags(Format: TAudioSampleFormat; out Flags: DWORD): boolean;
-begin
- case Format of
- asfS16: Flags := 0;
- asfFloat: Flags := BASS_SAMPLE_FLOAT;
- asfU8: Flags := BASS_SAMPLE_8BITS;
- else begin
- Result := false;
- Exit;
- end;
- end;
-
- Result := true;
-end;
-
-function TAudioCore_Bass.ConvertBASSFlagsToAudioFormat(Flags: DWORD; out Format: TAudioSampleFormat): boolean;
-begin
- if ((Flags and BASS_SAMPLE_FLOAT) <> 0) then
- Format := asfFloat
- else if ((Flags and BASS_SAMPLE_8BITS) <> 0) then
- Format := asfU8
- else
- Format := asfS16;
-
- Result := true;
-end;
-
-end.
diff --git a/src/classes/UAudioCore_Portaudio.pas b/src/classes/UAudioCore_Portaudio.pas
deleted file mode 100644
index bcc8a001..00000000
--- a/src/classes/UAudioCore_Portaudio.pas
+++ /dev/null
@@ -1,257 +0,0 @@
-unit UAudioCore_Portaudio;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I ../switches.inc}
-
-
-uses
- Classes,
- SysUtils,
- portaudio;
-
-type
- TAudioCore_Portaudio = class
- public
- constructor Create();
- class function GetInstance(): TAudioCore_Portaudio;
- function GetPreferredApiIndex(): TPaHostApiIndex;
- function TestDevice(inParams, outParams: PPaStreamParameters; var sampleRate: Double): boolean;
- end;
-
-implementation
-
-uses
- ULog;
-
-{*
- * The default API used by Portaudio is the least common denominator
- * and might lack efficiency. In addition it might not even work.
- * We use an array named ApiPreferenceOrder with which we define the order of
- * preferred APIs to use. The first API-type in the list is tried first.
- * If it is not available the next one is tried and so on ...
- * If none of the preferred APIs was found the default API (detected by
- * portaudio) is used.
- *
- * Pascal does not permit zero-length static arrays, so you must use paDefaultApi
- * as an array's only member if you do not have any preferences.
- * You can also append paDefaultApi to a non-zero length preferences array but
- * this is optional because the default API is always used as a fallback.
- *}
-const
- paDefaultApi = -1;
-const
- ApiPreferenceOrder:
-{$IF Defined(MSWINDOWS)}
- // Note1: Portmixer has no mixer support for paASIO and paWASAPI at the moment
- // Note2: Windows Default-API is MME, but DirectSound is faster
- array[0..0] of TPaHostApiTypeId = ( paDirectSound );
-{$ELSEIF Defined(LINUX)}
- // Note: Portmixer has no mixer support for JACK at the moment
- array[0..2] of TPaHostApiTypeId = ( paALSA, paJACK, paOSS );
-{$ELSEIF Defined(DARWIN)}
- array[0..0] of TPaHostApiTypeId = ( paDefaultApi ); // paCoreAudio
-{$ELSE}
- array[0..0] of TPaHostApiTypeId = ( paDefaultApi );
-{$IFEND}
-
-
-{ TAudioInput_Portaudio }
-
-var
- Instance: TAudioCore_Portaudio;
-
-constructor TAudioCore_Portaudio.Create();
-begin
- inherited;
-end;
-
-class function TAudioCore_Portaudio.GetInstance(): TAudioCore_Portaudio;
-begin
- if not assigned(Instance) then
- Instance := TAudioCore_Portaudio.Create();
- Result := Instance;
-end;
-
-function TAudioCore_Portaudio.GetPreferredApiIndex(): TPaHostApiIndex;
-var
- i: integer;
- apiIndex: TPaHostApiIndex;
- apiInfo: PPaHostApiInfo;
-begin
- result := -1;
-
- // select preferred sound-API
- for i:= 0 to High(ApiPreferenceOrder) do
- begin
- if(ApiPreferenceOrder[i] <> paDefaultApi) then
- begin
- // check if API is available
- apiIndex := Pa_HostApiTypeIdToHostApiIndex(ApiPreferenceOrder[i]);
- if(apiIndex >= 0) then
- begin
- // we found an API but we must check if it works
- // (on linux portaudio might detect OSS but does not provide
- // any devices if ALSA is enabled)
- apiInfo := Pa_GetHostApiInfo(apiIndex);
- if (apiInfo^.deviceCount > 0) then
- begin
- Result := apiIndex;
- break;
- end;
- end;
- end;
- end;
-
- // None of the preferred APIs is available -> use default
- if(result < 0) then
- begin
- result := Pa_GetDefaultHostApi();
- end;
-end;
-
-{*
- * Portaudio test callback used by TestDevice().
- *}
-function TestCallback(input: Pointer; output: Pointer; frameCount: Longword;
- timeInfo: PPaStreamCallbackTimeInfo; statusFlags: TPaStreamCallbackFlags;
- inputDevice: Pointer): Integer; cdecl;
-begin
- // this callback is called only once
- result := paAbort;
-end;
-
-(*
- * Tests if the callback works. Some devices can be opened without
- * an error but the callback is never called. Calling Pa_StopStream() on such
- * a stream freezes USDX then. Probably because the callback-thread is deadlocked
- * due to some bug in portaudio. The blocking Pa_ReadStream() and Pa_WriteStream()
- * block forever too and though can't be used for testing.
- *
- * To avoid freezing Pa_AbortStream (or Pa_CloseStream which calls Pa_AbortStream)
- * can be used to force the stream to stop. But for some reason this stops debugging
- * in gdb with a "no process found" message.
- *
- * Because freezing devices are non-working devices we test the devices here to
- * be able to exclude them from the device-selection list.
- *
- * Portaudio does not provide any test to check this error case (probably because
- * it should not even occur). So we have to open the device, start the stream and
- * check if the callback is called (the stream is stopped if the callback is called
- * for the first time, so we can poll until the stream is stopped).
- *
- * Another error that occurs is that some devices (even the default device) might
- * work at the beginning but stop after a few calls (maybe 50) of the callback.
- * For me this problem occurs with the default output-device. The "dmix" or "front"
- * device must be selected instead. Another problem is that (due to a bug in
- * portaudio or ALSA) the "front" device is not detected every time portaudio
- * is started. Sometimes it needs two or more restarts.
- *
- * There is no reasonable way to test for these errors. For the first error-case
- * we could test if the callback is called 50 times but this can take a second
- * for each device and it can fail in the 51st or even 100th callback call then.
- *
- * The second error-case cannot be tested at all. How should we now that one
- * device is missing if portaudio is not even able to detect it.
- * We could start and terminate Portaudio for several times and see if the device
- * count changes but this is ugly.
- *
- * Conclusion: We are not able to autodetect a working device with
- * portaudio (at least not with the newest v19_20071207) at the moment.
- * So we have to provide the possibility to manually select an output device
- * in the UltraStar options if we want to use portaudio instead of SDL.
- *)
-function TAudioCore_Portaudio.TestDevice(inParams, outParams: PPaStreamParameters; var sampleRate: Double): boolean;
-var
- stream: PPaStream;
- err: TPaError;
- cbWorks: boolean;
- cbPolls: integer;
- i: integer;
-const
- altSampleRates: array[0..1] of Double = (44100, 48000); // alternative sample-rates
-begin
- Result := false;
-
- if (sampleRate <= 0) then
- sampleRate := 44100;
-
- // check if device supports our input-format
- err := Pa_IsFormatSupported(inParams, outParams, sampleRate);
- if(err <> paNoError) then
- begin
- // we cannot fix the error -> exit
- if (err <> paInvalidSampleRate) then
- Exit;
-
- // try alternative sample-rates to the detected one
- sampleRate := 0;
- for i := 0 to High(altSampleRates) do
- begin
- // do not check the detected sample-rate twice
- if (altSampleRates[i] = sampleRate) then
- continue;
- // check alternative
- err := Pa_IsFormatSupported(inParams, outParams, altSampleRates[i]);
- if (err = paNoError) then
- begin
- // sample-rate works
- sampleRate := altSampleRates[i];
- break;
- end;
- end;
- // no working sample-rate found
- if (sampleRate = 0) then
- Exit;
- end;
-
- // FIXME: for some reason gdb stops after a call of Pa_AbortStream()
- // which is implicitely called by Pa_CloseStream().
- // gdb's stops with the message: "ptrace: no process found".
- // Probably because the callback-thread is killed what confuses gdb.
- {$IF Defined(Debug) and Defined(Linux)}
- cbWorks := true;
- {$ELSE}
- // open device for testing
- err := Pa_OpenStream(stream, inParams, outParams, sampleRate,
- paFramesPerBufferUnspecified,
- paNoFlag, @TestCallback, nil);
- if(err <> paNoError) then
- begin
- exit;
- end;
-
- // start the callback
- err := Pa_StartStream(stream);
- if(err <> paNoError) then
- begin
- Pa_CloseStream(stream);
- exit;
- end;
-
- cbWorks := false;
- // check if the callback was called (poll for max. 200ms)
- for cbPolls := 1 to 20 do
- begin
- // if the test-callback was called it should be aborted now
- if (Pa_IsStreamActive(stream) = 0) then
- begin
- cbWorks := true;
- break;
- end;
- // not yet aborted, wait and try (poll) again
- Pa_Sleep(10);
- end;
-
- // finally abort the stream
- Pa_CloseStream(stream);
- {$IFEND}
-
- Result := cbWorks;
-end;
-
-end.
diff --git a/src/classes/UAudioDecoder_Bass.pas b/src/classes/UAudioDecoder_Bass.pas
deleted file mode 100644
index dba1fde4..00000000
--- a/src/classes/UAudioDecoder_Bass.pas
+++ /dev/null
@@ -1,242 +0,0 @@
-unit UAudioDecoder_Bass;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-implementation
-
-uses
- Classes,
- SysUtils,
- UMain,
- UMusic,
- UAudioCore_Bass,
- ULog,
- bass;
-
-type
- TBassDecodeStream = class(TAudioDecodeStream)
- private
- Handle: HSTREAM;
- FormatInfo : TAudioFormatInfo;
- Error: boolean;
- public
- constructor Create(Handle: HSTREAM);
- destructor Destroy(); override;
-
- procedure Close(); override;
-
- function GetLength(): real; override;
- function GetAudioFormatInfo(): TAudioFormatInfo; override;
- function GetPosition: real; override;
- procedure SetPosition(Time: real); override;
- function GetLoop(): boolean; override;
- procedure SetLoop(Enabled: boolean); override;
- function IsEOF(): boolean; override;
- function IsError(): boolean; override;
-
- function ReadData(Buffer: PChar; BufSize: integer): integer; override;
- end;
-
-type
- TAudioDecoder_Bass = class( TInterfacedObject, IAudioDecoder )
- public
- function GetName: string;
-
- function InitializeDecoder(): boolean;
- function FinalizeDecoder(): boolean;
- function Open(const Filename: string): TAudioDecodeStream;
- end;
-
-var
- BassCore: TAudioCore_Bass;
-
-
-{ TBassDecodeStream }
-
-constructor TBassDecodeStream.Create(Handle: HSTREAM);
-var
- ChannelInfo: BASS_CHANNELINFO;
- Format: TAudioSampleFormat;
-begin
- inherited Create();
- Self.Handle := Handle;
-
- // setup format info
- if (not BASS_ChannelGetInfo(Handle, ChannelInfo)) then
- begin
- raise Exception.Create('Failed to open decode-stream');
- end;
- BassCore.ConvertBASSFlagsToAudioFormat(ChannelInfo.flags, Format);
- FormatInfo := TAudioFormatInfo.Create(ChannelInfo.chans, ChannelInfo.freq, format);
-
- Error := false;
-end;
-
-destructor TBassDecodeStream.Destroy();
-begin
- Close();
- inherited;
-end;
-
-procedure TBassDecodeStream.Close();
-begin
- if (Handle <> 0) then
- begin
- BASS_StreamFree(Handle);
- Handle := 0;
- end;
- PerformOnClose();
- FreeAndNil(FormatInfo);
- Error := false;
-end;
-
-function TBassDecodeStream.GetAudioFormatInfo(): TAudioFormatInfo;
-begin
- Result := FormatInfo;
-end;
-
-function TBassDecodeStream.GetLength(): real;
-var
- bytes: QWORD;
-begin
- bytes := BASS_ChannelGetLength(Handle, BASS_POS_BYTE);
- Result := BASS_ChannelBytes2Seconds(Handle, bytes);
-end;
-
-function TBassDecodeStream.GetPosition: real;
-var
- bytes: QWORD;
-begin
- bytes := BASS_ChannelGetPosition(Handle, BASS_POS_BYTE);
- Result := BASS_ChannelBytes2Seconds(Handle, bytes);
-end;
-
-procedure TBassDecodeStream.SetPosition(Time: real);
-var
- bytes: QWORD;
-begin
- bytes := BASS_ChannelSeconds2Bytes(Handle, Time);
- BASS_ChannelSetPosition(Handle, bytes, BASS_POS_BYTE);
-end;
-
-function TBassDecodeStream.GetLoop(): boolean;
-var
- flags: DWORD;
-begin
- // retrieve channel flags
- flags := BASS_ChannelFlags(Handle, 0, 0);
- if (flags = DWORD(-1)) then
- begin
- Log.LogError('BASS_ChannelFlags: ' + BassCore.ErrorGetString(), 'TBassDecodeStream.GetLoop');
- Result := false;
- Exit;
- end;
- Result := (flags and BASS_SAMPLE_LOOP) <> 0;
-end;
-
-procedure TBassDecodeStream.SetLoop(Enabled: boolean);
-var
- flags: DWORD;
-begin
- // set/unset loop-flag
- if (Enabled) then
- flags := BASS_SAMPLE_LOOP
- else
- flags := 0;
-
- // set new flag-bits
- if (BASS_ChannelFlags(Handle, flags, BASS_SAMPLE_LOOP) = DWORD(-1)) then
- begin
- Log.LogError('BASS_ChannelFlags: ' + BassCore.ErrorGetString(), 'TBassDecodeStream.SetLoop');
- Exit;
- end;
-end;
-
-function TBassDecodeStream.IsEOF(): boolean;
-begin
- Result := (BASS_ChannelIsActive(Handle) = BASS_ACTIVE_STOPPED);
-end;
-
-function TBassDecodeStream.IsError(): boolean;
-begin
- Result := Error;
-end;
-
-function TBassDecodeStream.ReadData(Buffer: PChar; BufSize: integer): integer;
-begin
- Result := BASS_ChannelGetData(Handle, Buffer, BufSize);
- // check error state (do not handle EOF as error)
- if ((Result = -1) and (BASS_ErrorGetCode() <> BASS_ERROR_ENDED)) then
- Error := true
- else
- Error := false;
-end;
-
-
-{ TAudioDecoder_Bass }
-
-function TAudioDecoder_Bass.GetName: String;
-begin
- result := 'BASS_Decoder';
-end;
-
-function TAudioDecoder_Bass.InitializeDecoder(): boolean;
-begin
- BassCore := TAudioCore_Bass.GetInstance();
- Result := true;
-end;
-
-function TAudioDecoder_Bass.FinalizeDecoder(): boolean;
-begin
- Result := true;
-end;
-
-function TAudioDecoder_Bass.Open(const Filename: string): TAudioDecodeStream;
-var
- Stream: HSTREAM;
- ChannelInfo: BASS_CHANNELINFO;
- FileExt: string;
-begin
- Result := nil;
-
- // check if BASS was initialized
- // in case the decoder is not used with BASS playback, init the NO_SOUND device
- if ((integer(BASS_GetDevice) = -1) and (BASS_ErrorGetCode() = BASS_ERROR_INIT)) then
- BASS_Init(0, 44100, 0, 0, nil);
-
- // TODO: use BASS_STREAM_PRESCAN for accurate seeking in VBR-files?
- // disadvantage: seeking will slow down.
- Stream := BASS_StreamCreateFile(False, PChar(Filename), 0, 0, BASS_STREAM_DECODE);
- if (Stream = 0) then
- begin
- //Log.LogError(BassCore.ErrorGetString(), 'TAudioDecoder_Bass.Open');
- Exit;
- end;
-
- // check if BASS opened some erroneously recognized file-formats
- if BASS_ChannelGetInfo(Stream, channelInfo) then
- begin
- fileExt := ExtractFileExt(Filename);
- // BASS opens FLV-files (maybe others too) although it cannot handle them.
- // Setting BASS_CONFIG_VERIFY to the max. value (100000) does not help.
- if ((fileExt = '.flv') and (channelInfo.ctype = BASS_CTYPE_STREAM_MP1)) then
- begin
- BASS_StreamFree(Stream);
- Exit;
- end;
- end;
-
- Result := TBassDecodeStream.Create(Stream);
-end;
-
-
-initialization
- MediaManager.Add(TAudioDecoder_Bass.Create);
-
-end.
diff --git a/src/classes/UAudioDecoder_FFmpeg.pas b/src/classes/UAudioDecoder_FFmpeg.pas
deleted file mode 100644
index d9b4c93c..00000000
--- a/src/classes/UAudioDecoder_FFmpeg.pas
+++ /dev/null
@@ -1,1114 +0,0 @@
-unit UAudioDecoder_FFmpeg;
-
-(*******************************************************************************
- *
- * This unit is primarily based upon -
- * http://www.dranger.com/ffmpeg/ffmpegtutorial_all.html
- *
- * and tutorial03.c
- *
- * http://www.inb.uni-luebeck.de/~boehme/using_libavcodec.html
- *
- *******************************************************************************)
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-// show FFmpeg specific debug output
-{.$DEFINE DebugFFmpegDecode}
-
-// FFmpeg is very verbose and shows a bunch of errors.
-// Those errors (they can be considered as warnings by us) can be ignored
-// as they do not give any useful information.
-// There is no solution to fix this except for turning them off.
-{.$DEFINE EnableFFmpegErrorOutput}
-
-implementation
-
-uses
- Classes,
- SysUtils,
- Math,
- UMusic,
- UIni,
- UMain,
- avcodec,
- avformat,
- avutil,
- avio,
- mathematics, // used for av_rescale_q
- rational,
- UMediaCore_FFmpeg,
- SDL,
- ULog,
- UCommon,
- UConfig;
-
-const
- MAX_AUDIOQ_SIZE = (5 * 16 * 1024);
-
-const
- // TODO: The factor 3/2 might not be necessary as we do not need extra
- // space for synchronizing as in the tutorial.
- AUDIO_BUFFER_SIZE = (AVCODEC_MAX_AUDIO_FRAME_SIZE * 3) div 2;
-
-type
- TFFmpegDecodeStream = class(TAudioDecodeStream)
- private
- StateLock: PSDL_Mutex;
-
- EOFState: boolean; // end-of-stream flag (locked by StateLock)
- ErrorState: boolean; // error flag (locked by StateLock)
-
- QuitRequest: boolean; // (locked by StateLock)
- ParserIdleCond: PSDL_Cond;
-
- // parser pause/resume data
- ParserLocked: boolean;
- ParserPauseRequestCount: integer;
- ParserUnlockedCond: PSDL_Cond;
- ParserResumeCond: PSDL_Cond;
-
- SeekRequest: boolean; // (locked by StateLock)
- SeekFlags: integer; // (locked by StateLock)
- SeekPos: double; // stream position to seek for (in secs) (locked by StateLock)
- SeekFlush: boolean; // true if the buffers should be flushed after seeking (locked by StateLock)
- SeekFinishedCond: PSDL_Cond;
-
- Loop: boolean; // (locked by StateLock)
-
- ParseThread: PSDL_Thread;
- PacketQueue: TPacketQueue;
-
- FormatInfo: TAudioFormatInfo;
-
- // FFmpeg specific data
- FormatCtx: PAVFormatContext;
- CodecCtx: PAVCodecContext;
- Codec: PAVCodec;
-
- AudioStreamIndex: integer;
- AudioStream: PAVStream;
- AudioStreamPos: double; // stream position in seconds (locked by DecoderLock)
-
- // decoder pause/resume data
- DecoderLocked: boolean;
- DecoderPauseRequestCount: integer;
- DecoderUnlockedCond: PSDL_Cond;
- DecoderResumeCond: PSDL_Cond;
-
- // state-vars for DecodeFrame (locked by DecoderLock)
- AudioPaket: TAVPacket;
- AudioPaketData: PChar;
- AudioPaketSize: integer;
- AudioPaketSilence: integer; // number of bytes of silence to return
-
- // state-vars for AudioCallback (locked by DecoderLock)
- AudioBufferPos: integer;
- AudioBufferSize: integer;
- AudioBuffer: PChar;
-
- Filename: string;
-
- procedure SetPositionIntern(Time: real; Flush: boolean; Blocking: boolean);
- procedure SetEOF(State: boolean); {$IFDEF HasInline}inline;{$ENDIF}
- procedure SetError(State: boolean); {$IFDEF HasInline}inline;{$ENDIF}
- function IsSeeking(): boolean;
- function IsQuit(): boolean;
-
- procedure Reset();
-
- procedure Parse();
- function ParseLoop(): boolean;
- procedure PauseParser();
- procedure ResumeParser();
-
- function DecodeFrame(Buffer: PChar; BufferSize: integer): integer;
- procedure FlushCodecBuffers();
- procedure PauseDecoder();
- procedure ResumeDecoder();
- public
- constructor Create();
- destructor Destroy(); override;
-
- function Open(const Filename: string): boolean;
- procedure Close(); override;
-
- function GetLength(): real; override;
- function GetAudioFormatInfo(): TAudioFormatInfo; override;
- function GetPosition: real; override;
- procedure SetPosition(Time: real); override;
- function GetLoop(): boolean; override;
- procedure SetLoop(Enabled: boolean); override;
- function IsEOF(): boolean; override;
- function IsError(): boolean; override;
-
- function ReadData(Buffer: PChar; BufferSize: integer): integer; override;
- end;
-
-type
- TAudioDecoder_FFmpeg = class( TInterfacedObject, IAudioDecoder )
- public
- function GetName: string;
-
- function InitializeDecoder(): boolean;
- function FinalizeDecoder(): boolean;
- function Open(const Filename: string): TAudioDecodeStream;
- end;
-
-var
- FFmpegCore: TMediaCore_FFmpeg;
-
-function ParseThreadMain(Data: Pointer): integer; cdecl; forward;
-
-
-{ TFFmpegDecodeStream }
-
-constructor TFFmpegDecodeStream.Create();
-begin
- inherited Create();
-
- StateLock := SDL_CreateMutex();
- ParserUnlockedCond := SDL_CreateCond();
- ParserResumeCond := SDL_CreateCond();
- ParserIdleCond := SDL_CreateCond();
- SeekFinishedCond := SDL_CreateCond();
- DecoderUnlockedCond := SDL_CreateCond();
- DecoderResumeCond := SDL_CreateCond();
-
- // according to the documentation of avcodec_decode_audio(2), sample-data
- // should be aligned on a 16 byte boundary. Otherwise internal calls
- // (e.g. to SSE or Altivec operations) might fail or lack performance on some
- // CPUs. Although GetMem() in Delphi and FPC seems to use a 16 byte or higher
- // alignment for buffers of this size (alignment depends on the size of the
- // requested buffer), we will set the alignment explicitly as the minimum
- // alignment used by Delphi and FPC is on an 8 byte boundary.
- //
- // Note: AudioBuffer was previously defined as a field of type TAudioBuffer
- // (array[0..AUDIO_BUFFER_SIZE-1] of byte) and hence statically allocated.
- // Fields of records are aligned different to memory allocated with GetMem(),
- // aligning depending on the type but will be at least 2 bytes.
- // AudioBuffer was not aligned to a 16 byte boundary. The {$ALIGN x} directive
- // was not applicable as Delphi in contrast to FPC provides at most 8 byte
- // alignment ({$ALIGN 16} is not supported) by this directive.
- AudioBuffer := GetAlignedMem(AUDIO_BUFFER_SIZE, 16);
-
- Reset();
-end;
-
-procedure TFFmpegDecodeStream.Reset();
-begin
- ParseThread := nil;
-
- EOFState := false;
- ErrorState := false;
- Loop := false;
- QuitRequest := false;
-
- AudioPaketData := nil;
- AudioPaketSize := 0;
- AudioPaketSilence := 0;
-
- AudioBufferPos := 0;
- AudioBufferSize := 0;
-
- ParserLocked := false;
- ParserPauseRequestCount := 0;
- DecoderLocked := false;
- DecoderPauseRequestCount := 0;
-
- FillChar(AudioPaket, SizeOf(TAVPacket), 0);
-end;
-
-{*
- * Frees the decode-stream data.
- *}
-destructor TFFmpegDecodeStream.Destroy();
-begin
- Close();
-
- SDL_DestroyMutex(StateLock);
- SDL_DestroyCond(ParserUnlockedCond);
- SDL_DestroyCond(ParserResumeCond);
- SDL_DestroyCond(ParserIdleCond);
- SDL_DestroyCond(SeekFinishedCond);
- SDL_DestroyCond(DecoderUnlockedCond);
- SDL_DestroyCond(DecoderResumeCond);
-
- FreeAlignedMem(AudioBuffer);
-
- inherited;
-end;
-
-function TFFmpegDecodeStream.Open(const Filename: string): boolean;
-var
- SampleFormat: TAudioSampleFormat;
- AVResult: integer;
-begin
- Result := false;
-
- Close();
- Reset();
-
- if (not FileExists(Filename)) then
- begin
- Log.LogError('Audio-file does not exist: "' + Filename + '"', 'UAudio_FFmpeg');
- Exit;
- end;
-
- Self.Filename := Filename;
-
- // open audio file
- if (av_open_input_file(FormatCtx, PChar(Filename), nil, 0, nil) <> 0) then
- begin
- Log.LogError('av_open_input_file failed: "' + Filename + '"', 'UAudio_FFmpeg');
- Exit;
- end;
-
- // generate PTS values if they do not exist
- FormatCtx^.flags := FormatCtx^.flags or AVFMT_FLAG_GENPTS;
-
- // retrieve stream information
- if (av_find_stream_info(FormatCtx) < 0) then
- begin
- Log.LogError('av_find_stream_info failed: "' + Filename + '"', 'UAudio_FFmpeg');
- Close();
- Exit;
- end;
-
- // FIXME: hack used by ffplay. Maybe should not use url_feof() to test for the end
- FormatCtx^.pb.eof_reached := 0;
-
- {$IFDEF DebugFFmpegDecode}
- dump_format(FormatCtx, 0, pchar(Filename), 0);
- {$ENDIF}
-
- AudioStreamIndex := FFmpegCore.FindAudioStreamIndex(FormatCtx);
- if (AudioStreamIndex < 0) then
- begin
- Log.LogError('FindAudioStreamIndex: No Audio-stream found "' + Filename + '"', 'UAudio_FFmpeg');
- Close();
- Exit;
- end;
-
- //Log.LogStatus('AudioStreamIndex is: '+ inttostr(ffmpegStreamID), 'UAudio_FFmpeg');
-
- AudioStream := FormatCtx.streams[AudioStreamIndex];
- CodecCtx := AudioStream^.codec;
-
- // TODO: should we use this or not? Should we allow 5.1 channel audio?
- (*
- {$IF LIBAVCODEC_VERSION >= 51042000}
- if (CodecCtx^.channels > 0) then
- CodecCtx^.request_channels := Min(2, CodecCtx^.channels)
- else
- CodecCtx^.request_channels := 2;
- {$IFEND}
- *)
-
- Codec := avcodec_find_decoder(CodecCtx^.codec_id);
- if (Codec = nil) then
- begin
- Log.LogError('Unsupported codec!', 'UAudio_FFmpeg');
- CodecCtx := nil;
- Close();
- Exit;
- end;
-
- // set debug options
- CodecCtx^.debug_mv := 0;
- CodecCtx^.debug := 0;
-
- // detect bug-workarounds automatically
- CodecCtx^.workaround_bugs := FF_BUG_AUTODETECT;
- // error resilience strategy (careful/compliant/agressive/very_aggressive)
- //CodecCtx^.error_resilience := FF_ER_CAREFUL; //FF_ER_COMPLIANT;
- // allow non spec compliant speedup tricks.
- //CodecCtx^.flags2 := CodecCtx^.flags2 or CODEC_FLAG2_FAST;
-
- // Note: avcodec_open() and avcodec_close() are not thread-safe and will
- // fail if called concurrently by different threads.
- FFmpegCore.LockAVCodec();
- try
- AVResult := avcodec_open(CodecCtx, Codec);
- finally
- FFmpegCore.UnlockAVCodec();
- end;
- if (AVResult < 0) then
- begin
- Log.LogError('avcodec_open failed!', 'UAudio_FFmpeg');
- Close();
- Exit;
- end;
-
- // now initialize the audio-format
-
- if (not FFmpegCore.ConvertFFmpegToAudioFormat(CodecCtx^.sample_fmt, SampleFormat)) then
- begin
- // try standard format
- SampleFormat := asfS16;
- end;
-
- FormatInfo := TAudioFormatInfo.Create(
- CodecCtx^.channels,
- CodecCtx^.sample_rate,
- SampleFormat
- );
-
-
- PacketQueue := TPacketQueue.Create();
-
- // finally start the decode thread
- ParseThread := SDL_CreateThread(@ParseThreadMain, Self);
-
- Result := true;
-end;
-
-procedure TFFmpegDecodeStream.Close();
-var
- ThreadResult: integer;
-begin
- // wake threads waiting for packet-queue data
- // Note: normally, there are no waiting threads. If there were waiting
- // ones, they would block the audio-callback thread.
- if (assigned(PacketQueue)) then
- PacketQueue.Abort();
-
- // send quit request (to parse-thread etc)
- SDL_mutexP(StateLock);
- QuitRequest := true;
- SDL_CondBroadcast(ParserIdleCond);
- SDL_mutexV(StateLock);
-
- // abort parse-thread
- if (ParseThread <> nil) then
- begin
- // and wait until it terminates
- SDL_WaitThread(ParseThread, ThreadResult);
- ParseThread := nil;
- end;
-
- // Close the codec
- if (CodecCtx <> nil) then
- begin
- // avcodec_close() is not thread-safe
- FFmpegCore.LockAVCodec();
- try
- avcodec_close(CodecCtx);
- finally
- FFmpegCore.UnlockAVCodec();
- end;
- CodecCtx := nil;
- end;
-
- // Close the video file
- if (FormatCtx <> nil) then
- begin
- av_close_input_file(FormatCtx);
- FormatCtx := nil;
- end;
-
- PerformOnClose();
-
- FreeAndNil(PacketQueue);
- FreeAndNil(FormatInfo);
-end;
-
-function TFFmpegDecodeStream.GetLength(): real;
-begin
- // do not forget to consider the start_time value here
- Result := (FormatCtx^.start_time + FormatCtx^.duration) / AV_TIME_BASE;
-end;
-
-function TFFmpegDecodeStream.GetAudioFormatInfo(): TAudioFormatInfo;
-begin
- Result := FormatInfo;
-end;
-
-function TFFmpegDecodeStream.IsEOF(): boolean;
-begin
- SDL_mutexP(StateLock);
- Result := EOFState;
- SDL_mutexV(StateLock);
-end;
-
-procedure TFFmpegDecodeStream.SetEOF(State: boolean);
-begin
- SDL_mutexP(StateLock);
- EOFState := State;
- SDL_mutexV(StateLock);
-end;
-
-function TFFmpegDecodeStream.IsError(): boolean;
-begin
- SDL_mutexP(StateLock);
- Result := ErrorState;
- SDL_mutexV(StateLock);
-end;
-
-procedure TFFmpegDecodeStream.SetError(State: boolean);
-begin
- SDL_mutexP(StateLock);
- ErrorState := State;
- SDL_mutexV(StateLock);
-end;
-
-function TFFmpegDecodeStream.IsSeeking(): boolean;
-begin
- SDL_mutexP(StateLock);
- Result := SeekRequest;
- SDL_mutexV(StateLock);
-end;
-
-function TFFmpegDecodeStream.IsQuit(): boolean;
-begin
- SDL_mutexP(StateLock);
- Result := QuitRequest;
- SDL_mutexV(StateLock);
-end;
-
-function TFFmpegDecodeStream.GetPosition(): real;
-var
- BufferSizeSec: double;
-begin
- PauseDecoder();
-
- // ReadData() does not return all of the buffer retrieved by DecodeFrame().
- // Determine the size of the unused part of the decode-buffer.
- BufferSizeSec := (AudioBufferSize - AudioBufferPos) /
- FormatInfo.BytesPerSec;
-
- // subtract the size of unused buffer-data from the audio clock.
- Result := AudioStreamPos - BufferSizeSec;
-
- ResumeDecoder();
-end;
-
-procedure TFFmpegDecodeStream.SetPosition(Time: real);
-begin
- SetPositionIntern(Time, true, true);
-end;
-
-function TFFmpegDecodeStream.GetLoop(): boolean;
-begin
- SDL_mutexP(StateLock);
- Result := Loop;
- SDL_mutexV(StateLock);
-end;
-
-procedure TFFmpegDecodeStream.SetLoop(Enabled: boolean);
-begin
- SDL_mutexP(StateLock);
- Loop := Enabled;
- SDL_mutexV(StateLock);
-end;
-
-
-(********************************************
- * Parser section
- ********************************************)
-
-procedure TFFmpegDecodeStream.PauseParser();
-begin
- if (SDL_ThreadID() = ParseThread.threadid) then
- Exit;
-
- SDL_mutexP(StateLock);
- Inc(ParserPauseRequestCount);
- while (ParserLocked) do
- SDL_CondWait(ParserUnlockedCond, StateLock);
- SDL_mutexV(StateLock);
-end;
-
-procedure TFFmpegDecodeStream.ResumeParser();
-begin
- if (SDL_ThreadID() = ParseThread.threadid) then
- Exit;
-
- SDL_mutexP(StateLock);
- Dec(ParserPauseRequestCount);
- SDL_CondSignal(ParserResumeCond);
- SDL_mutexV(StateLock);
-end;
-
-procedure TFFmpegDecodeStream.SetPositionIntern(Time: real; Flush: boolean; Blocking: boolean);
-begin
- // - Pause the parser first to prevent it from putting obsolete packages
- // into the queue after the queue was flushed and before seeking is done.
- // Otherwise we will hear fragments of old data, if the stream was seeked
- // in stopped mode and resumed afterwards (applies to non-blocking mode only).
- // - Pause the decoder to avoid race-condition that might occur otherwise.
- // - Last lock the state lock because we are manipulating some shared state-vars.
- PauseParser();
- PauseDecoder();
- SDL_mutexP(StateLock);
-
- // configure seek parameters
- SeekPos := Time;
- SeekFlush := Flush;
- SeekFlags := AVSEEK_FLAG_ANY;
- SeekRequest := true;
-
- // Note: the BACKWARD-flag seeks to the first position <= the position
- // searched for. Otherwise e.g. position 0 might not be seeked correct.
- // For some reason ffmpeg sometimes doesn't use position 0 but the key-frame
- // following. In streams with few key-frames (like many flv-files) the next
- // key-frame after 0 might be 5secs ahead.
- if (Time < AudioStreamPos) then
- SeekFlags := SeekFlags or AVSEEK_FLAG_BACKWARD;
-
- EOFState := false;
- ErrorState := false;
-
- // send a reuse signal in case the parser was stopped (e.g. because of an EOF)
- SDL_CondSignal(ParserIdleCond);
-
- SDL_mutexV(StateLock);
- ResumeDecoder();
- ResumeParser();
-
- // in blocking mode, wait until seeking is done
- if (Blocking) then
- begin
- SDL_mutexP(StateLock);
- while (SeekRequest) do
- SDL_CondWait(SeekFinishedCond, StateLock);
- SDL_mutexV(StateLock);
- end;
-end;
-
-function ParseThreadMain(Data: Pointer): integer; cdecl;
-var
- Stream: TFFmpegDecodeStream;
-begin
- Stream := TFFmpegDecodeStream(Data);
- if (Stream <> nil) then
- Stream.Parse();
- Result := 0;
-end;
-
-procedure TFFmpegDecodeStream.Parse();
-begin
- // reuse thread as long as the stream is not terminated
- while (ParseLoop()) do
- begin
- // wait for reuse or destruction of stream
- SDL_mutexP(StateLock);
- while (not (SeekRequest or QuitRequest)) do
- SDL_CondWait(ParserIdleCond, StateLock);
- SDL_mutexV(StateLock);
- end;
-end;
-
-(**
- * Parser main loop.
- * Will not return until parsing of the stream is finished.
- * Reasons for the parser to return are:
- * - the end-of-file is reached
- * - an error occured
- * - the stream was quited (received a quit-request)
- * Returns true if the stream can be resumed or false if the stream has to
- * be terminated.
- *)
-function TFFmpegDecodeStream.ParseLoop(): boolean;
-var
- Packet: TAVPacket;
- StatusPacket: PAVPacket;
- SeekTarget: int64;
- ByteIOCtx: PByteIOContext;
- ErrorCode: integer;
- StartSilence: double; // duration of silence at start of stream
- StartSilencePtr: PDouble; // pointer for the EMPTY status packet
-
- // Note: pthreads wakes threads waiting on a mutex in the order of their
- // priority and not in FIFO order. SDL does not provide any option to
- // control priorities. This might (and already did) starve threads waiting
- // on the mutex (e.g. SetPosition) making usdx look like it was froozen.
- // Instead of simply locking the critical section we set a ParserLocked flag
- // instead and give priority to the threads requesting the parser to pause.
- procedure LockParser();
- begin
- SDL_mutexP(StateLock);
- while (ParserPauseRequestCount > 0) do
- SDL_CondWait(ParserResumeCond, StateLock);
- ParserLocked := true;
- SDL_mutexV(StateLock);
- end;
-
- procedure UnlockParser();
- begin
- SDL_mutexP(StateLock);
- ParserLocked := false;
- SDL_CondBroadcast(ParserUnlockedCond);
- SDL_mutexV(StateLock);
- end;
-
-begin
- Result := true;
-
- while (true) do
- begin
- LockParser();
- try
-
- if (IsQuit()) then
- begin
- Result := false;
- Exit;
- end;
-
- // handle seek-request (Note: no need to lock SeekRequest here)
- if (SeekRequest) then
- begin
- // first try: seek on the audio stream
- SeekTarget := Round(SeekPos / av_q2d(AudioStream^.time_base));
- StartSilence := 0;
- if (SeekTarget < AudioStream^.start_time) then
- StartSilence := (AudioStream^.start_time - SeekTarget) * av_q2d(AudioStream^.time_base);
- ErrorCode := av_seek_frame(FormatCtx, AudioStreamIndex, SeekTarget, SeekFlags);
-
- if (ErrorCode < 0) then
- begin
- // second try: seek on the default stream (necessary for flv-videos and some ogg-files)
- SeekTarget := Round(SeekPos * AV_TIME_BASE);
- StartSilence := 0;
- if (SeekTarget < FormatCtx^.start_time) then
- StartSilence := (FormatCtx^.start_time - SeekTarget) / AV_TIME_BASE;
- ErrorCode := av_seek_frame(FormatCtx, -1, SeekTarget, SeekFlags);
- end;
-
- // pause decoder and lock state (keep the lock-order to avoid deadlocks).
- // Note that the decoder does not block in the packet-queue in seeking state,
- // so locking the decoder here does not cause a dead-lock.
- PauseDecoder();
- SDL_mutexP(StateLock);
- try
- if (ErrorCode < 0) then
- begin
- // seeking failed
- ErrorState := true;
- Log.LogStatus('Seek Error in "'+FormatCtx^.filename+'"', 'UAudioDecoder_FFmpeg');
- end
- else
- begin
- if (SeekFlush) then
- begin
- // flush queue (we will send a Flush-Packet when seeking is finished)
- PacketQueue.Flush();
-
- // flush the decode buffers
- AudioBufferSize := 0;
- AudioBufferPos := 0;
- AudioPaketSize := 0;
- AudioPaketSilence := 0;
- FlushCodecBuffers();
-
- // Set preliminary stream position. The position will be set to
- // the correct value as soon as the first packet is decoded.
- AudioStreamPos := SeekPos;
- end
- else
- begin
- // request avcodec buffer flush
- PacketQueue.PutStatus(PKT_STATUS_FLAG_FLUSH, nil);
- end;
-
- // fill the gap between position 0 and start_time with silence
- // but not if we are in loop mode
- if ((StartSilence > 0) and (not Loop)) then
- begin
- GetMem(StartSilencePtr, SizeOf(StartSilence));
- StartSilencePtr^ := StartSilence;
- PacketQueue.PutStatus(PKT_STATUS_FLAG_EMPTY, StartSilencePtr);
- end;
- end;
-
- SeekRequest := false;
- SDL_CondBroadcast(SeekFinishedCond);
- finally
- SDL_mutexV(StateLock);
- ResumeDecoder();
- end;
- end;
-
- if (PacketQueue.GetSize() > MAX_AUDIOQ_SIZE) then
- begin
- SDL_Delay(10);
- Continue;
- end;
-
- if (av_read_frame(FormatCtx, Packet) < 0) then
- begin
- // failed to read a frame, check reason
- {$IF (LIBAVFORMAT_VERSION_MAJOR >= 52)}
- ByteIOCtx := FormatCtx^.pb;
- {$ELSE}
- ByteIOCtx := @FormatCtx^.pb;
- {$IFEND}
-
- // check for end-of-file (eof is not an error)
- if (url_feof(ByteIOCtx) <> 0) then
- begin
- if (GetLoop()) then
- begin
- // rewind stream (but do not flush)
- SetPositionIntern(0, false, false);
- Continue;
- end
- else
- begin
- // signal end-of-file
- PacketQueue.PutStatus(PKT_STATUS_FLAG_EOF, nil);
- Exit;
- end;
- end;
-
- // check for errors
- if (url_ferror(ByteIOCtx) <> 0) then
- begin
- // an error occured -> abort and wait for repositioning or termination
- PacketQueue.PutStatus(PKT_STATUS_FLAG_ERROR, nil);
- Exit;
- end;
-
- // no error -> wait for user input
- SDL_Delay(100);
- Continue;
- end;
-
- if (Packet.stream_index = AudioStreamIndex) then
- PacketQueue.Put(@Packet)
- else
- av_free_packet(@Packet);
-
- finally
- UnlockParser();
- end;
- end;
-end;
-
-
-(********************************************
- * Decoder section
- ********************************************)
-
-procedure TFFmpegDecodeStream.PauseDecoder();
-begin
- SDL_mutexP(StateLock);
- Inc(DecoderPauseRequestCount);
- while (DecoderLocked) do
- SDL_CondWait(DecoderUnlockedCond, StateLock);
- SDL_mutexV(StateLock);
-end;
-
-procedure TFFmpegDecodeStream.ResumeDecoder();
-begin
- SDL_mutexP(StateLock);
- Dec(DecoderPauseRequestCount);
- SDL_CondSignal(DecoderResumeCond);
- SDL_mutexV(StateLock);
-end;
-
-procedure TFFmpegDecodeStream.FlushCodecBuffers();
-begin
- // if no flush operation is specified, avcodec_flush_buffers will not do anything.
- if (@CodecCtx.codec.flush <> nil) then
- begin
- // flush buffers used by avcodec_decode_audio, etc.
- avcodec_flush_buffers(CodecCtx);
- end
- else
- begin
- // we need a Workaround to avoid plopping noise with ogg-vorbis and
- // mp3 (in older versions of FFmpeg).
- // We will just reopen the codec.
- FFmpegCore.LockAVCodec();
- try
- avcodec_close(CodecCtx);
- avcodec_open(CodecCtx, Codec);
- finally
- FFmpegCore.UnlockAVCodec();
- end;
- end;
-end;
-
-function TFFmpegDecodeStream.DecodeFrame(Buffer: PChar; BufferSize: integer): integer;
-var
- PaketDecodedSize: integer; // size of packet data used for decoding
- DataSize: integer; // size of output data decoded by FFmpeg
- BlockQueue: boolean;
- SilenceDuration: double;
- {$IFDEF DebugFFmpegDecode}
- TmpPos: double;
- {$ENDIF}
-begin
- Result := -1;
-
- if (EOF) then
- Exit;
-
- while(true) do
- begin
- // for titles with start_time > 0 we have to generate silence
- // until we reach the pts of the first data packet.
- if (AudioPaketSilence > 0) then
- begin
- DataSize := Min(AudioPaketSilence, BufferSize);
- FillChar(Buffer[0], DataSize, 0);
- Dec(AudioPaketSilence, DataSize);
- AudioStreamPos := AudioStreamPos + DataSize / FormatInfo.BytesPerSec;
- Result := DataSize;
- Exit;
- end;
-
- // read packet data
- while (AudioPaketSize > 0) do
- begin
- DataSize := BufferSize;
-
- {$IF LIBAVCODEC_VERSION >= 51030000} // 51.30.0
- PaketDecodedSize := avcodec_decode_audio2(CodecCtx, PSmallint(Buffer),
- DataSize, AudioPaketData, AudioPaketSize);
- {$ELSE}
- PaketDecodedSize := avcodec_decode_audio(CodecCtx, PSmallint(Buffer),
- DataSize, AudioPaketData, AudioPaketSize);
- {$IFEND}
-
- if(PaketDecodedSize < 0) then
- begin
- // if error, skip frame
- {$IFDEF DebugFFmpegDecode}
- DebugWriteln('Skip audio frame');
- {$ENDIF}
- AudioPaketSize := 0;
- Break;
- end;
-
- Inc(AudioPaketData, PaketDecodedSize);
- Dec(AudioPaketSize, PaketDecodedSize);
-
- // check if avcodec_decode_audio returned data, otherwise fetch more frames
- if (DataSize <= 0) then
- Continue;
-
- // update stream position by the amount of fetched data
- AudioStreamPos := AudioStreamPos + DataSize / FormatInfo.BytesPerSec;
-
- // we have data, return it and come back for more later
- Result := DataSize;
- Exit;
- end;
-
- // free old packet data
- if (AudioPaket.data <> nil) then
- av_free_packet(@AudioPaket);
-
- // do not block queue on seeking (to avoid deadlocks on the DecoderLock)
- if (IsSeeking()) then
- BlockQueue := false
- else
- BlockQueue := true;
-
- // request a new packet and block if none available.
- // If this fails, the queue was aborted.
- if (PacketQueue.Get(AudioPaket, BlockQueue) <= 0) then
- Exit;
-
- // handle Status-packet
- if (PChar(AudioPaket.data) = STATUS_PACKET) then
- begin
- AudioPaket.data := nil;
- AudioPaketData := nil;
- AudioPaketSize := 0;
-
- case (AudioPaket.flags) of
- PKT_STATUS_FLAG_FLUSH:
- begin
- // just used if SetPositionIntern was called without the flush flag.
- FlushCodecBuffers;
- end;
- PKT_STATUS_FLAG_EOF: // end-of-file
- begin
- // ignore EOF while seeking
- if (not IsSeeking()) then
- SetEOF(true);
- // buffer contains no data -> result = -1
- Exit;
- end;
- PKT_STATUS_FLAG_ERROR:
- begin
- SetError(true);
- Log.LogStatus('I/O Error', 'TFFmpegDecodeStream.DecodeFrame');
- Exit;
- end;
- PKT_STATUS_FLAG_EMPTY:
- begin
- SilenceDuration := PDouble(PacketQueue.GetStatusInfo(AudioPaket))^;
- AudioPaketSilence := Round(SilenceDuration * FormatInfo.SampleRate) * FormatInfo.FrameSize;
- PacketQueue.FreeStatusInfo(AudioPaket);
- end
- else
- begin
- Log.LogStatus('Unknown status', 'TFFmpegDecodeStream.DecodeFrame');
- end;
- end;
-
- Continue;
- end;
-
- AudioPaketData := PChar(AudioPaket.data);
- AudioPaketSize := AudioPaket.size;
-
- // if available, update the stream position to the presentation time of this package
- if(AudioPaket.pts <> AV_NOPTS_VALUE) then
- begin
- {$IFDEF DebugFFmpegDecode}
- TmpPos := AudioStreamPos;
- {$ENDIF}
- AudioStreamPos := av_q2d(AudioStream^.time_base) * AudioPaket.pts;
- {$IFDEF DebugFFmpegDecode}
- DebugWriteln('Timestamp: ' + floattostrf(AudioStreamPos, ffFixed, 15, 3) + ' ' +
- '(Calc: ' + floattostrf(TmpPos, ffFixed, 15, 3) + '), ' +
- 'Diff: ' + floattostrf(AudioStreamPos-TmpPos, ffFixed, 15, 3));
- {$ENDIF}
- end;
- end;
-end;
-
-function TFFmpegDecodeStream.ReadData(Buffer: PChar; BufferSize: integer): integer;
-var
- CopyByteCount: integer; // number of bytes to copy
- RemainByteCount: integer; // number of bytes left (remain) to read
- BufferPos: integer;
-
- // prioritize pause requests
- procedure LockDecoder();
- begin
- SDL_mutexP(StateLock);
- while (DecoderPauseRequestCount > 0) do
- SDL_CondWait(DecoderResumeCond, StateLock);
- DecoderLocked := true;
- SDL_mutexV(StateLock);
- end;
-
- procedure UnlockDecoder();
- begin
- SDL_mutexP(StateLock);
- DecoderLocked := false;
- SDL_CondBroadcast(DecoderUnlockedCond);
- SDL_mutexV(StateLock);
- end;
-
-begin
- Result := -1;
-
- // set number of bytes to copy to the output buffer
- BufferPos := 0;
-
- LockDecoder();
- try
- // leave if end-of-file is reached
- if (EOF) then
- Exit;
-
- // copy data to output buffer
- while (BufferPos < BufferSize) do
- begin
- // check if we need more data
- if (AudioBufferPos >= AudioBufferSize) then
- begin
- AudioBufferPos := 0;
-
- // we have already sent all our data; get more
- AudioBufferSize := DecodeFrame(AudioBuffer, AUDIO_BUFFER_SIZE);
-
- // check for errors or EOF
- if(AudioBufferSize < 0) then
- begin
- Result := BufferPos;
- Exit;
- end;
- end;
-
- // calc number of new bytes in the decode-buffer
- CopyByteCount := AudioBufferSize - AudioBufferPos;
- // resize copy-count if more bytes available than needed (remaining bytes are used the next time)
- RemainByteCount := BufferSize - BufferPos;
- if (CopyByteCount > RemainByteCount) then
- CopyByteCount := RemainByteCount;
-
- Move(AudioBuffer[AudioBufferPos], Buffer[BufferPos], CopyByteCount);
-
- Inc(BufferPos, CopyByteCount);
- Inc(AudioBufferPos, CopyByteCount);
- end;
- finally
- UnlockDecoder();
- end;
-
- Result := BufferSize;
-end;
-
-
-{ TAudioDecoder_FFmpeg }
-
-function TAudioDecoder_FFmpeg.GetName: String;
-begin
- Result := 'FFmpeg_Decoder';
-end;
-
-function TAudioDecoder_FFmpeg.InitializeDecoder: boolean;
-begin
- //Log.LogStatus('InitializeDecoder', 'UAudioDecoder_FFmpeg');
- FFmpegCore := TMediaCore_FFmpeg.GetInstance();
- av_register_all();
-
- // Do not show uninformative error messages by default.
- // FFmpeg prints all error-infos on the console by default what
- // is very confusing as the playback of the files is correct.
- // We consider these errors to be internal to FFMpeg. They can be fixed
- // by the FFmpeg guys only and do not provide any useful information in
- // respect to USDX.
- {$IFNDEF EnableFFmpegErrorOutput}
- {$IF LIBAVUTIL_VERSION_MAJOR >= 50}
- av_log_set_level(AV_LOG_FATAL);
- {$ELSE}
- // FATAL and ERROR share one log-level, so we have to use QUIET
- av_log_set_level(AV_LOG_QUIET);
- {$IFEND}
- {$ENDIF}
-
- Result := true;
-end;
-
-function TAudioDecoder_FFmpeg.FinalizeDecoder(): boolean;
-begin
- Result := true;
-end;
-
-function TAudioDecoder_FFmpeg.Open(const Filename: string): TAudioDecodeStream;
-var
- Stream: TFFmpegDecodeStream;
-begin
- Result := nil;
-
- Stream := TFFmpegDecodeStream.Create();
- if (not Stream.Open(Filename)) then
- begin
- Stream.Free;
- Exit;
- end;
-
- Result := Stream;
-end;
-
-
-initialization
- MediaManager.Add(TAudioDecoder_FFmpeg.Create);
-
-end.
diff --git a/src/classes/UAudioInput_Bass.pas b/src/classes/UAudioInput_Bass.pas
deleted file mode 100644
index 65a4704d..00000000
--- a/src/classes/UAudioInput_Bass.pas
+++ /dev/null
@@ -1,481 +0,0 @@
-unit UAudioInput_Bass;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-
-uses
- Classes,
- SysUtils,
- URecord,
- UMusic;
-
-implementation
-
-uses
- UMain,
- UIni,
- ULog,
- UAudioCore_Bass,
- UCommon, // (Note: for MakeLong on non-windows platforms)
- {$IFDEF MSWINDOWS}
- Windows, // (Note: for MakeLong)
- {$ENDIF}
- bass; // (Note: DWORD is redefined here -> insert after Windows-unit)
-
-type
- TAudioInput_Bass = class(TAudioInputBase)
- private
- function EnumDevices(): boolean;
- public
- function GetName: String; override;
- function InitializeRecord: boolean; override;
- function FinalizeRecord: boolean; override;
- end;
-
- TBassInputDevice = class(TAudioInputDevice)
- private
- RecordStream: HSTREAM;
- BassDeviceID: DWORD; // DeviceID used by BASS
- SingleIn: boolean;
-
- function SetInputSource(SourceIndex: integer): boolean;
- function GetInputSource(): integer;
- public
- function Open(): boolean;
- function Close(): boolean;
- function Start(): boolean; override;
- function Stop(): boolean; override;
-
- function GetVolume(): single; override;
- procedure SetVolume(Volume: single); override;
- end;
-
-var
- BassCore: TAudioCore_Bass;
-
-
-{ Global }
-
-{*
- * Bass input capture callback.
- * Params:
- * stream - BASS input stream
- * buffer - buffer of captured samples
- * len - size of buffer in bytes
- * user - players associated with left/right channels
- *}
-function MicrophoneCallback(stream: HSTREAM; buffer: Pointer;
- len: Cardinal; inputDevice: Pointer): boolean; {$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-begin
- AudioInputProcessor.HandleMicrophoneData(buffer, len, inputDevice);
- Result := true;
-end;
-
-
-{ TBassInputDevice }
-
-function TBassInputDevice.GetInputSource(): integer;
-var
- SourceCnt: integer;
- i: integer;
- flags: DWORD;
-begin
- // get input-source config (subtract virtual device to get BASS indices)
- SourceCnt := Length(Source)-1;
-
- // find source
- Result := -1;
- for i := 0 to SourceCnt-1 do
- begin
- // get input settings
- flags := BASS_RecordGetInput(i, PSingle(nil)^);
- if (flags = DWORD(-1)) then
- begin
- Log.LogError('BASS_RecordGetInput: ' + BassCore.ErrorGetString(), 'TBassInputDevice.GetInputSource');
- Exit;
- end;
-
- // check if current source is selected
- if ((flags and BASS_INPUT_OFF) = 0) then
- begin
- // selected source found
- Result := i;
- Exit;
- end;
- end;
-end;
-
-function TBassInputDevice.SetInputSource(SourceIndex: integer): boolean;
-var
- SourceCnt: integer;
- i: integer;
- flags: DWORD;
-begin
- Result := false;
-
- // check for invalid source index
- if (SourceIndex < 0) then
- Exit;
-
- // get input-source config (subtract virtual device to get BASS indices)
- SourceCnt := Length(Source)-1;
-
- // turn on selected source (turns off the others for single-in devices)
- if (not BASS_RecordSetInput(SourceIndex, BASS_INPUT_ON, -1)) then
- begin
- Log.LogError('BASS_RecordSetInput: ' + BassCore.ErrorGetString(), 'TBassInputDevice.Start');
- Exit;
- end;
-
- // turn off all other sources (not needed for single-in devices)
- if (not SingleIn) then
- begin
- for i := 0 to SourceCnt-1 do
- begin
- if (i = SourceIndex) then
- continue;
- // get input settings
- flags := BASS_RecordGetInput(i, PSingle(nil)^);
- if (flags = DWORD(-1)) then
- begin
- Log.LogError('BASS_RecordGetInput: ' + BassCore.ErrorGetString(), 'TBassInputDevice.GetInputSource');
- Exit;
- end;
- // deselect source if selected
- if ((flags and BASS_INPUT_OFF) = 0) then
- BASS_RecordSetInput(i, BASS_INPUT_OFF, -1);
- end;
- end;
-
- Result := true;
-end;
-
-function TBassInputDevice.Open(): boolean;
-var
- FormatFlags: DWORD;
- SourceIndex: integer;
-const
- latency = 20; // 20ms callback period (= latency)
-begin
- Result := false;
-
- if (not BASS_RecordInit(BassDeviceID)) then
- begin
- Log.LogError('BASS_RecordInit['+Name+']: ' +
- BassCore.ErrorGetString(), 'TBassInputDevice.Open');
- Exit;
- end;
-
- if (not BassCore.ConvertAudioFormatToBASSFlags(AudioFormat.Format, FormatFlags)) then
- begin
- Log.LogError('Unhandled sample-format', 'TBassInputDevice.Open');
- Exit;
- end;
-
- // start capturing in paused state
- RecordStream := BASS_RecordStart(Round(AudioFormat.SampleRate), AudioFormat.Channels,
- MakeLong(FormatFlags or BASS_RECORD_PAUSE, latency),
- @MicrophoneCallback, Self);
- if (RecordStream = 0) then
- begin
- Log.LogError('BASS_RecordStart: ' + BassCore.ErrorGetString(), 'TBassInputDevice.Open');
- BASS_RecordFree;
- Exit;
- end;
-
- // save current source selection and select new source
- SourceIndex := Ini.InputDeviceConfig[CfgIndex].Input-1;
- if (SourceIndex = -1) then
- begin
- // nothing to do if default source is used
- SourceRestore := -1;
- end
- else
- begin
- // store current source-index and select new source
- SourceRestore := GetInputSource();
- SetInputSource(SourceIndex);
- end;
-
- Result := true;
-end;
-
-{* Start input-capturing on this device. *}
-function TBassInputDevice.Start(): boolean;
-begin
- Result := false;
-
- // recording already started -> stop first
- if (RecordStream <> 0) then
- Stop();
-
- // TODO: Do not open the device here (takes too much time).
- if not Open() then
- Exit;
-
- if (not BASS_ChannelPlay(RecordStream, true)) then
- begin
- Log.LogError('BASS_ChannelPlay: ' + BassCore.ErrorGetString(), 'TBassInputDevice.Start');
- Exit;
- end;
-
- Result := true;
-end;
-
-{* Stop input-capturing on this device. *}
-function TBassInputDevice.Stop(): boolean;
-begin
- Result := false;
-
- if (RecordStream = 0) then
- Exit;
- if (not BASS_RecordSetDevice(BassDeviceID)) then
- Exit;
-
- if (not BASS_ChannelStop(RecordStream)) then
- begin
- Log.LogError('BASS_ChannelStop: ' + BassCore.ErrorGetString(), 'TBassInputDevice.Stop');
- end;
-
- // TODO: Do not close the device here (takes too much time).
- Result := Close();
-end;
-
-function TBassInputDevice.Close(): boolean;
-begin
- // restore source selection
- if (SourceRestore >= 0) then
- begin
- SetInputSource(SourceRestore);
- end;
-
- // free data
- if (not BASS_RecordFree()) then
- begin
- Log.LogError('BASS_RecordFree: ' + BassCore.ErrorGetString(), 'TBassInputDevice.Close');
- Result := false;
- end
- else
- begin
- Result := true;
- end;
-
- RecordStream := 0;
-end;
-
-function TBassInputDevice.GetVolume(): single;
-var
- SourceIndex: integer;
- lVolume: Single;
-begin
- Result := 0;
-
- SourceIndex := Ini.InputDeviceConfig[CfgIndex].Input-1;
- if (SourceIndex = -1) then
- begin
- // if default source used find selected source
- SourceIndex := GetInputSource();
- if (SourceIndex = -1) then
- Exit;
- end;
-
- if (BASS_RecordGetInput(SourceIndex, lVolume) = DWORD(-1)) then
- begin
- Log.LogError('BASS_RecordGetInput: ' + BassCore.ErrorGetString() , 'TBassInputDevice.GetVolume');
- Exit;
- end;
- Result := lVolume;
-end;
-
-procedure TBassInputDevice.SetVolume(Volume: single);
-var
- SourceIndex: integer;
-begin
- SourceIndex := Ini.InputDeviceConfig[CfgIndex].Input-1;
- if (SourceIndex = -1) then
- begin
- // if default source used find selected source
- SourceIndex := GetInputSource();
- if (SourceIndex = -1) then
- Exit;
- end;
-
- // clip volume to valid range
- if (Volume > 1.0) then
- Volume := 1.0
- else if (Volume < 0) then
- Volume := 0;
-
- if (not BASS_RecordSetInput(SourceIndex, 0, Volume)) then
- begin
- Log.LogError('BASS_RecordSetInput: ' + BassCore.ErrorGetString() , 'TBassInputDevice.SetVolume');
- end;
-end;
-
-
-{ TAudioInput_Bass }
-
-function TAudioInput_Bass.GetName: String;
-begin
- result := 'BASS_Input';
-end;
-
-function TAudioInput_Bass.EnumDevices(): boolean;
-var
- Descr: PChar;
- SourceName: PChar;
- Flags: integer;
- BassDeviceID: integer;
- BassDevice: TBassInputDevice;
- DeviceIndex: integer;
- DeviceInfo: BASS_DEVICEINFO;
- SourceIndex: integer;
- RecordInfo: BASS_RECORDINFO;
- SelectedSourceIndex: integer;
-begin
- result := false;
-
- DeviceIndex := 0;
- BassDeviceID := 0;
- SetLength(AudioInputProcessor.DeviceList, 0);
-
- // checks for recording devices and puts them into an array
- while true do
- begin
- if (not BASS_RecordGetDeviceInfo(BassDeviceID, DeviceInfo)) then
- break;
-
- // try to initialize the device
- if not BASS_RecordInit(BassDeviceID) then
- begin
- Log.LogStatus('Failed to initialize BASS Capture-Device['+inttostr(BassDeviceID)+']',
- 'TAudioInput_Bass.InitializeRecord');
- end
- else
- begin
- SetLength(AudioInputProcessor.DeviceList, DeviceIndex+1);
-
- // TODO: free object on termination
- BassDevice := TBassInputDevice.Create();
- AudioInputProcessor.DeviceList[DeviceIndex] := BassDevice;
-
- Descr := DeviceInfo.name;
-
- BassDevice.BassDeviceID := BassDeviceID;
- BassDevice.Name := UnifyDeviceName(Descr, DeviceIndex);
-
- // zero info-struct as some fields might not be set (e.g. freq is just set on Vista and MacOSX)
- FillChar(RecordInfo, SizeOf(RecordInfo), 0);
- // retrieve recording device info
- BASS_RecordGetInfo(RecordInfo);
-
- // check if BASS has capture-freq. info
- if (RecordInfo.freq > 0) then
- begin
- // use current input sample rate (available only on Windows Vista and OSX).
- // Recording at this rate will give the best quality and performance, as no resampling is required.
- // FIXME: does BASS use LSB/MSB or system integer values for 16bit?
- BassDevice.AudioFormat := TAudioFormatInfo.Create(2, RecordInfo.freq, asfS16)
- end
- else
- begin
- // BASS does not provide an explizit input channel count (except BASS_RECORDINFO.formats)
- // but it doesn't fail if we use stereo input on a mono device
- // -> use stereo by default
- BassDevice.AudioFormat := TAudioFormatInfo.Create(2, 44100, asfS16)
- end;
-
- // get info if multiple input-sources can be selected at once
- BassDevice.SingleIn := RecordInfo.singlein;
-
- // init list for capture buffers per channel
- SetLength(BassDevice.CaptureChannel, BassDevice.AudioFormat.Channels);
-
- BassDevice.MicSource := -1;
- BassDevice.SourceRestore := -1;
-
- // add a virtual default source (will not change mixer-settings)
- SetLength(BassDevice.Source, 1);
- BassDevice.Source[0].Name := DEFAULT_SOURCE_NAME;
-
- // add real input sources
- SourceIndex := 1;
-
- // process each input
- while true do
- begin
- SourceName := BASS_RecordGetInputName(SourceIndex-1);
-
- {$IFDEF DARWIN}
- // Under MacOSX the SingStar Mics have an empty InputName.
- // So, we have to add a hard coded Workaround for this problem
- // FIXME: - Do we need this anymore? Doesn't the (new) default source already solve this problem?
- // - Normally a nil return value of BASS_RecordGetInputName() means end-of-list, so maybe
- // BASS is not able to detect any mic-sources (the default source will work then).
- // - Does BASS_RecordGetInfo() return true or false? If it returns true in this case
- // we could use this value to check if the device exists.
- // Please check that, eddie.
- // If it returns false, then the source is not detected and it does not make sense to add a second
- // fake device here.
- // What about BASS_RecordGetInput()? Does it return a value <> -1?
- // - Does it even work at all with this fake source-index, now that input switching works?
- // This info was not used before (sources were never switched), so it did not matter what source-index was used.
- // But now BASS_RecordSetInput() will probably fail.
- if ((SourceName = nil) and (SourceIndex = 1) and (Pos('USBMIC Serial#', Descr) > 0)) then
- SourceName := 'Microphone'
- {$ENDIF}
-
- if (SourceName = nil) then
- break;
-
- SetLength(BassDevice.Source, Length(BassDevice.Source)+1);
- BassDevice.Source[SourceIndex].Name := SourceName;
-
- // get input-source info
- Flags := BASS_RecordGetInput(SourceIndex, PSingle(nil)^);
- if (Flags <> -1) then
- begin
- // is the current source a mic-source?
- if ((Flags and BASS_INPUT_TYPE_MIC) <> 0) then
- BassDevice.MicSource := SourceIndex;
- end;
-
- Inc(SourceIndex);
- end;
-
- // FIXME: this call hangs in FPC (windows) every 2nd time USDX is called.
- // Maybe because the sound-device was not released properly?
- BASS_RecordFree;
-
- Inc(DeviceIndex);
- end;
-
- Inc(BassDeviceID);
- end;
-
- result := true;
-end;
-
-function TAudioInput_Bass.InitializeRecord(): boolean;
-begin
- BassCore := TAudioCore_Bass.GetInstance();
- Result := EnumDevices();
-end;
-
-function TAudioInput_Bass.FinalizeRecord(): boolean;
-begin
- CaptureStop;
- Result := inherited FinalizeRecord;
-end;
-
-
-initialization
- MediaManager.Add(TAudioInput_Bass.Create);
-
-end.
diff --git a/src/classes/UAudioInput_Portaudio.pas b/src/classes/UAudioInput_Portaudio.pas
deleted file mode 100644
index 9a1c3e99..00000000
--- a/src/classes/UAudioInput_Portaudio.pas
+++ /dev/null
@@ -1,474 +0,0 @@
-unit UAudioInput_Portaudio;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I ../switches.inc}
-
-
-uses
- Classes,
- SysUtils,
- UMusic;
-
-implementation
-
-uses
- {$IFDEF UsePortmixer}
- portmixer,
- {$ENDIF}
- portaudio,
- UAudioCore_Portaudio,
- URecord,
- UIni,
- ULog,
- UMain;
-
-type
- TAudioInput_Portaudio = class(TAudioInputBase)
- private
- AudioCore: TAudioCore_Portaudio;
- function EnumDevices(): boolean;
- public
- function GetName: String; override;
- function InitializeRecord: boolean; override;
- function FinalizeRecord: boolean; override;
- end;
-
- TPortaudioInputDevice = class(TAudioInputDevice)
- private
- RecordStream: PPaStream;
- {$IFDEF UsePortmixer}
- Mixer: PPxMixer;
- {$ENDIF}
- PaDeviceIndex: TPaDeviceIndex;
- public
- function Open(): boolean;
- function Close(): boolean;
- function Start(): boolean; override;
- function Stop(): boolean; override;
-
- function GetVolume(): single; override;
- procedure SetVolume(Volume: single); override;
- end;
-
-function MicrophoneCallback(input: Pointer; output: Pointer; frameCount: Longword;
- timeInfo: PPaStreamCallbackTimeInfo; statusFlags: TPaStreamCallbackFlags;
- inputDevice: Pointer): Integer; cdecl; forward;
-
-function MicrophoneTestCallback(input: Pointer; output: Pointer; frameCount: Longword;
- timeInfo: PPaStreamCallbackTimeInfo; statusFlags: TPaStreamCallbackFlags;
- inputDevice: Pointer): Integer; cdecl; forward;
-
-
-{ TPortaudioInputDevice }
-
-function TPortaudioInputDevice.Open(): boolean;
-var
- Error: TPaError;
- inputParams: TPaStreamParameters;
- deviceInfo: PPaDeviceInfo;
- SourceIndex: integer;
-begin
- Result := false;
-
- // get input latency info
- deviceInfo := Pa_GetDeviceInfo(PaDeviceIndex);
-
- // set input stream parameters
- with inputParams do
- begin
- device := PaDeviceIndex;
- channelCount := AudioFormat.Channels;
- sampleFormat := paInt16;
- suggestedLatency := deviceInfo^.defaultLowInputLatency;
- hostApiSpecificStreamInfo := nil;
- end;
-
- //Log.LogStatus(deviceInfo^.name, 'Portaudio');
- //Log.LogStatus(floattostr(deviceInfo^.defaultLowInputLatency), 'Portaudio');
-
- // open input stream
- Error := Pa_OpenStream(RecordStream, @inputParams, nil,
- AudioFormat.SampleRate,
- paFramesPerBufferUnspecified, paNoFlag,
- @MicrophoneCallback, Pointer(Self));
- if(Error <> paNoError) then
- begin
- Log.LogError('Error opening stream: ' + Pa_GetErrorText(Error), 'TPortaudioInputDevice.Open');
- Exit;
- end;
-
- {$IFDEF UsePortmixer}
- // open default mixer
- Mixer := Px_OpenMixer(RecordStream, 0);
- if (Mixer = nil) then
- begin
- Log.LogError('Error opening mixer: ' + Pa_GetErrorText(Error), 'TPortaudioInputDevice.Open');
- end
- else
- begin
- // save current source selection and select new source
- SourceIndex := Ini.InputDeviceConfig[CfgIndex].Input-1;
- if (SourceIndex = -1) then
- begin
- // nothing to do if default source is used
- SourceRestore := -1;
- end
- else
- begin
- // store current source-index and select new source
- SourceRestore := Px_GetCurrentInputSource(Mixer); // -1 in error case
- Px_SetCurrentInputSource(Mixer, SourceIndex);
- end;
- end;
- {$ENDIF}
-
- Result := true;
-end;
-
-function TPortaudioInputDevice.Start(): boolean;
-var
- Error: TPaError;
-begin
- Result := false;
-
- // recording already started -> stop first
- if (RecordStream <> nil) then
- Stop();
-
- // TODO: Do not open the device here (takes too much time).
- if (not Open()) then
- Exit;
-
- // start capture
- Error := Pa_StartStream(RecordStream);
- if(Error <> paNoError) then
- begin
- Log.LogError('Error starting stream: ' + Pa_GetErrorText(Error), 'TPortaudioInputDevice.Start');
- Close();
- RecordStream := nil;
- Exit;
- end;
-
- Result := true;
-end;
-
-function TPortaudioInputDevice.Stop(): boolean;
-var
- Error: TPaError;
-begin
- Result := false;
-
- if (RecordStream = nil) then
- Exit;
-
- // Note: do NOT call Pa_StopStream here!
- // It gets stuck on devices with non-working callback as Pa_StopStream
- // waits until all buffers have been handled (which never occurs in that case).
- Error := Pa_AbortStream(RecordStream);
- if (Error <> paNoError) then
- begin
- Log.LogError('Pa_AbortStream: ' + Pa_GetErrorText(Error), 'TPortaudioInputDevice.Stop');
- end;
-
- Result := Close();
-end;
-
-function TPortaudioInputDevice.Close(): boolean;
-var
- Error: TPaError;
-begin
- {$IFDEF UsePortmixer}
- if (Mixer <> nil) then
- begin
- // restore source selection
- if (SourceRestore >= 0) then
- begin
- Px_SetCurrentInputSource(Mixer, SourceRestore);
- end;
-
- // close mixer
- Px_CloseMixer(Mixer);
- Mixer := nil;
- end;
- {$ENDIF}
-
- Error := Pa_CloseStream(RecordStream);
- if (Error <> paNoError) then
- begin
- Log.LogError('Pa_CloseStream: ' + Pa_GetErrorText(Error), 'TPortaudioInputDevice.Close');
- Result := false;
- end
- else
- begin
- Result := true;
- end;
-
- RecordStream := nil;
-end;
-
-function TPortaudioInputDevice.GetVolume(): single;
-begin
- Result := 0;
- {$IFDEF UsePortmixer}
- if (Mixer <> nil) then
- Result := Px_GetInputVolume(Mixer);
- {$ENDIF}
-end;
-
-procedure TPortaudioInputDevice.SetVolume(Volume: single);
-begin
- {$IFDEF UsePortmixer}
- if (Mixer <> nil) then
- begin
- // clip to valid range
- if (Volume > 1.0) then
- Volume := 1.0
- else if (Volume < 0) then
- Volume := 0;
- Px_SetInputVolume(Mixer, Volume);
- end;
- {$ENDIF}
-end;
-
-
-{ TAudioInput_Portaudio }
-
-function TAudioInput_Portaudio.GetName: String;
-begin
- result := 'Portaudio';
-end;
-
-function TAudioInput_Portaudio.EnumDevices(): boolean;
-var
- i: integer;
- paApiIndex: TPaHostApiIndex;
- paApiInfo: PPaHostApiInfo;
- deviceName: string;
- deviceIndex: TPaDeviceIndex;
- deviceInfo: PPaDeviceInfo;
- channelCnt: integer;
- SC: integer; // soundcard
- err: TPaError;
- errMsg: string;
- paDevice: TPortaudioInputDevice;
- inputParams: TPaStreamParameters;
- stream: PPaStream;
- streamInfo: PPaStreamInfo;
- sampleRate: double;
- latency: TPaTime;
- {$IFDEF UsePortmixer}
- mixer: PPxMixer;
- sourceCnt: integer;
- sourceIndex: integer;
- sourceName: string;
- {$ENDIF}
- cbPolls: integer;
- cbWorks: boolean;
-begin
- Result := false;
-
- // choose the best available Audio-API
- paApiIndex := AudioCore.GetPreferredApiIndex();
- if(paApiIndex = -1) then
- begin
- Log.LogError('No working Audio-API found', 'TAudioInput_Portaudio.EnumDevices');
- Exit;
- end;
-
- paApiInfo := Pa_GetHostApiInfo(paApiIndex);
-
- SC := 0;
-
- // init array-size to max. input-devices count
- SetLength(AudioInputProcessor.DeviceList, paApiInfo^.deviceCount);
- for i:= 0 to High(AudioInputProcessor.DeviceList) do
- begin
- // convert API-specific device-index to global index
- deviceIndex := Pa_HostApiDeviceIndexToDeviceIndex(paApiIndex, i);
- deviceInfo := Pa_GetDeviceInfo(deviceIndex);
-
- channelCnt := deviceInfo^.maxInputChannels;
-
- // current device is no input device -> skip
- if (channelCnt <= 0) then
- continue;
-
- // portaudio returns a channel-count of 128 for some devices
- // (e.g. the "default"-device), so we have to detect those
- // fantasy channel counts.
- if (channelCnt > 8) then
- channelCnt := 2;
-
- paDevice := TPortaudioInputDevice.Create();
- AudioInputProcessor.DeviceList[SC] := paDevice;
-
- // retrieve device-name
- deviceName := deviceInfo^.name;
- paDevice.Name := deviceName;
- paDevice.PaDeviceIndex := deviceIndex;
-
- sampleRate := deviceInfo^.defaultSampleRate;
-
- // on vista and xp the defaultLowInputLatency may be set to 0 but it works.
- // TODO: correct too low latencies (what is a too low latency, maybe < 10ms?)
- latency := deviceInfo^.defaultLowInputLatency;
-
- // setup desired input parameters
- // TODO: retry with input-latency set to 20ms (defaultLowInputLatency might
- // not be set correctly in OSS)
- with inputParams do
- begin
- device := deviceIndex;
- channelCount := channelCnt;
- sampleFormat := paInt16;
- suggestedLatency := latency;
- hostApiSpecificStreamInfo := nil;
- end;
-
- // check souncard and adjust sample-rate
- if (not AudioCore.TestDevice(@inputParams, nil, sampleRate)) then
- begin
- // ignore device if it does not work
- Log.LogError('Device "'+paDevice.Name+'" does not work',
- 'TAudioInput_Portaudio.EnumDevices');
- paDevice.Free();
- continue;
- end;
-
- // open device for further info
- err := Pa_OpenStream(stream, @inputParams, nil, sampleRate,
- paFramesPerBufferUnspecified, paNoFlag, @MicrophoneTestCallback, nil);
- if(err <> paNoError) then
- begin
- // unable to open device -> skip
- errMsg := Pa_GetErrorText(err);
- Log.LogError('Device error: "'+ deviceName +'" ('+ errMsg +')',
- 'TAudioInput_Portaudio.EnumDevices');
- paDevice.Free();
- continue;
- end;
-
- // adjust sample-rate (might be changed by portaudio)
- streamInfo := Pa_GetStreamInfo(stream);
- if (streamInfo <> nil) then
- begin
- if (sampleRate <> streamInfo^.sampleRate) then
- begin
- Log.LogStatus('Portaudio changed Samplerate from ' + FloatToStr(sampleRate) +
- ' to ' + FloatToStr(streamInfo^.sampleRate),
- 'TAudioInput_Portaudio.InitializeRecord');
- sampleRate := streamInfo^.sampleRate;
- end;
- end;
-
- // create audio-format info and resize capture-buffer array
- paDevice.AudioFormat := TAudioFormatInfo.Create(
- channelCnt,
- sampleRate,
- asfS16
- );
- SetLength(paDevice.CaptureChannel, paDevice.AudioFormat.Channels);
-
- Log.LogStatus('InputDevice "'+paDevice.Name+'"@' +
- IntToStr(paDevice.AudioFormat.Channels)+'x'+
- FloatToStr(paDevice.AudioFormat.SampleRate)+'Hz ('+
- FloatTostr(inputParams.suggestedLatency)+'sec)' ,
- 'Portaudio.EnumDevices');
-
- // portaudio does not provide a source-type check
- paDevice.MicSource := -1;
- paDevice.SourceRestore := -1;
-
- // add a virtual default source (will not change mixer-settings)
- SetLength(paDevice.Source, 1);
- paDevice.Source[0].Name := DEFAULT_SOURCE_NAME;
-
- {$IFDEF UsePortmixer}
- // use default mixer
- mixer := Px_OpenMixer(stream, 0);
-
- // get input count
- sourceCnt := Px_GetNumInputSources(mixer);
- SetLength(paDevice.Source, sourceCnt+1);
-
- // get input names
- for sourceIndex := 1 to sourceCnt do
- begin
- sourceName := Px_GetInputSourceName(mixer, sourceIndex-1);
- paDevice.Source[sourceIndex].Name := sourceName;
- end;
-
- Px_CloseMixer(mixer);
- {$ENDIF}
-
- // close test-stream
- Pa_CloseStream(stream);
-
- Inc(SC);
- end;
-
- // adjust size to actual input-device count
- SetLength(AudioInputProcessor.DeviceList, SC);
-
- Log.LogStatus('#Input-Devices: ' + inttostr(SC), 'Portaudio');
-
- Result := true;
-end;
-
-function TAudioInput_Portaudio.InitializeRecord(): boolean;
-var
- err: TPaError;
-begin
- AudioCore := TAudioCore_Portaudio.GetInstance();
-
- // initialize portaudio
- err := Pa_Initialize();
- if(err <> paNoError) then
- begin
- Log.LogError(Pa_GetErrorText(err), 'TAudioInput_Portaudio.InitializeRecord');
- Result := false;
- Exit;
- end;
-
- Result := EnumDevices();
-end;
-
-function TAudioInput_Portaudio.FinalizeRecord: boolean;
-begin
- CaptureStop;
- Pa_Terminate();
- Result := inherited FinalizeRecord();
-end;
-
-{*
- * Portaudio input capture callback.
- *}
-function MicrophoneCallback(input: Pointer; output: Pointer; frameCount: Longword;
- timeInfo: PPaStreamCallbackTimeInfo; statusFlags: TPaStreamCallbackFlags;
- inputDevice: Pointer): Integer; cdecl;
-begin
- AudioInputProcessor.HandleMicrophoneData(input, frameCount*4, inputDevice);
- result := paContinue;
-end;
-
-{*
- * Portaudio test capture callback.
- *}
-function MicrophoneTestCallback(input: Pointer; output: Pointer; frameCount: Longword;
- timeInfo: PPaStreamCallbackTimeInfo; statusFlags: TPaStreamCallbackFlags;
- inputDevice: Pointer): Integer; cdecl;
-begin
- // this callback is called only once
- result := paAbort;
-end;
-
-
-initialization
- MediaManager.add(TAudioInput_Portaudio.Create);
-
-end.
diff --git a/src/classes/UAudioPlaybackBase.pas b/src/classes/UAudioPlaybackBase.pas
deleted file mode 100644
index 2337d43f..00000000
--- a/src/classes/UAudioPlaybackBase.pas
+++ /dev/null
@@ -1,292 +0,0 @@
-unit UAudioPlaybackBase;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses
- UMusic;
-
-type
- TAudioPlaybackBase = class(TInterfacedObject, IAudioPlayback)
- protected
- OutputDeviceList: TAudioOutputDeviceList;
- MusicStream: TAudioPlaybackStream;
- function CreatePlaybackStream(): TAudioPlaybackStream; virtual; abstract;
- procedure ClearOutputDeviceList();
- function GetLatency(): double; virtual; abstract;
-
- // open sound or music stream (used by Open() and OpenSound())
- function OpenStream(const Filename: string): TAudioPlaybackStream;
- function OpenDecodeStream(const Filename: string): TAudioDecodeStream;
- public
- function GetName: string; virtual; abstract;
-
- function Open(const Filename: string): boolean; // true if succeed
- procedure Close;
-
- procedure Play;
- procedure Pause;
- procedure Stop;
- procedure FadeIn(Time: real; TargetVolume: single);
-
- procedure SetSyncSource(SyncSource: TSyncSource);
-
- procedure SetPosition(Time: real);
- function GetPosition: real;
-
- function InitializePlayback: boolean; virtual; abstract;
- function FinalizePlayback: boolean; virtual;
-
- //function SetOutputDevice(Device: TAudioOutputDevice): boolean;
- function GetOutputDeviceList(): TAudioOutputDeviceList;
-
- procedure SetAppVolume(Volume: single); virtual; abstract;
- procedure SetVolume(Volume: single);
- procedure SetLoop(Enabled: boolean);
-
- procedure Rewind;
- function Finished: boolean;
- function Length: real;
-
- // Sounds
- function OpenSound(const Filename: string): TAudioPlaybackStream;
- procedure PlaySound(Stream: TAudioPlaybackStream);
- procedure StopSound(Stream: TAudioPlaybackStream);
-
- // Equalizer
- procedure GetFFTData(var Data: TFFTData);
-
- // Interface for Visualizer
- function GetPCMData(var Data: TPCMData): Cardinal;
-
- function CreateVoiceStream(Channel: integer; FormatInfo: TAudioFormatInfo): TAudioVoiceStream; virtual; abstract;
- end;
-
-
-implementation
-
-uses
- ULog,
- SysUtils;
-
-{ TAudioPlaybackBase }
-
-function TAudioPlaybackBase.FinalizePlayback: boolean;
-begin
- FreeAndNil(MusicStream);
- ClearOutputDeviceList();
- Result := true;
-end;
-
-function TAudioPlaybackBase.Open(const Filename: string): boolean;
-begin
- // free old MusicStream
- MusicStream.Free;
-
- MusicStream := OpenStream(Filename);
- if not assigned(MusicStream) then
- begin
- Result := false;
- Exit;
- end;
-
- //MusicStream.AddSoundEffect(TVoiceRemoval.Create());
-
- Result := true;
-end;
-
-procedure TAudioPlaybackBase.Close;
-begin
- FreeAndNil(MusicStream);
-end;
-
-function TAudioPlaybackBase.OpenDecodeStream(const Filename: String): TAudioDecodeStream;
-var
- i: integer;
-begin
- for i := 0 to AudioDecoders.Count-1 do
- begin
- Result := IAudioDecoder(AudioDecoders[i]).Open(Filename);
- if (assigned(Result)) then
- begin
- Log.LogInfo('Using decoder ' + IAudioDecoder(AudioDecoders[i]).GetName() +
- ' for "' + Filename + '"', 'TAudioPlaybackBase.OpenDecodeStream');
- Exit;
- end;
- end;
- Result := nil;
-end;
-
-procedure OnClosePlaybackStream(Stream: TAudioProcessingStream);
-var
- PlaybackStream: TAudioPlaybackStream;
- SourceStream: TAudioSourceStream;
-begin
- PlaybackStream := TAudioPlaybackStream(Stream);
- SourceStream := PlaybackStream.GetSourceStream();
- SourceStream.Free;
-end;
-
-function TAudioPlaybackBase.OpenStream(const Filename: string): TAudioPlaybackStream;
-var
- PlaybackStream: TAudioPlaybackStream;
- DecodeStream: TAudioDecodeStream;
-begin
- Result := nil;
-
- //Log.LogStatus('Loading Sound: "' + Filename + '"', 'TAudioPlayback_Bass.OpenStream');
-
- DecodeStream := OpenDecodeStream(Filename);
- if (not assigned(DecodeStream)) then
- begin
- Log.LogStatus('Could not open "' + Filename + '"', 'TAudioPlayback_Bass.OpenStream');
- Exit;
- end;
-
- // create a matching playback-stream for the decoder
- PlaybackStream := CreatePlaybackStream();
- if (not PlaybackStream.Open(DecodeStream)) then
- begin
- FreeAndNil(PlaybackStream);
- FreeAndNil(DecodeStream);
- Exit;
- end;
-
- PlaybackStream.AddOnCloseHandler(OnClosePlaybackStream);
-
- Result := PlaybackStream;
-end;
-
-procedure TAudioPlaybackBase.Play;
-begin
- if assigned(MusicStream) then
- MusicStream.Play();
-end;
-
-procedure TAudioPlaybackBase.Pause;
-begin
- if assigned(MusicStream) then
- MusicStream.Pause();
-end;
-
-procedure TAudioPlaybackBase.Stop;
-begin
- if assigned(MusicStream) then
- MusicStream.Stop();
-end;
-
-function TAudioPlaybackBase.Length: real;
-begin
- if assigned(MusicStream) then
- Result := MusicStream.Length
- else
- Result := 0;
-end;
-
-function TAudioPlaybackBase.GetPosition: real;
-begin
- if assigned(MusicStream) then
- Result := MusicStream.Position
- else
- Result := 0;
-end;
-
-procedure TAudioPlaybackBase.SetPosition(Time: real);
-begin
- if assigned(MusicStream) then
- MusicStream.Position := Time;
-end;
-
-procedure TAudioPlaybackBase.SetSyncSource(SyncSource: TSyncSource);
-begin
- if assigned(MusicStream) then
- MusicStream.SetSyncSource(SyncSource);
-end;
-
-procedure TAudioPlaybackBase.Rewind;
-begin
- SetPosition(0);
-end;
-
-function TAudioPlaybackBase.Finished: boolean;
-begin
- if assigned(MusicStream) then
- Result := (MusicStream.Status = ssStopped)
- else
- Result := true;
-end;
-
-procedure TAudioPlaybackBase.SetVolume(Volume: single);
-begin
- if assigned(MusicStream) then
- MusicStream.Volume := Volume;
-end;
-
-procedure TAudioPlaybackBase.FadeIn(Time: real; TargetVolume: single);
-begin
- if assigned(MusicStream) then
- MusicStream.FadeIn(Time, TargetVolume);
-end;
-
-procedure TAudioPlaybackBase.SetLoop(Enabled: boolean);
-begin
- if assigned(MusicStream) then
- MusicStream.Loop := Enabled;
-end;
-
-// Equalizer
-procedure TAudioPlaybackBase.GetFFTData(var data: TFFTData);
-begin
- if assigned(MusicStream) then
- MusicStream.GetFFTData(data);
-end;
-
-{*
- * Copies interleaved PCM SInt16 stereo samples into data.
- * Returns the number of frames
- *}
-function TAudioPlaybackBase.GetPCMData(var data: TPCMData): Cardinal;
-begin
- if assigned(MusicStream) then
- Result := MusicStream.GetPCMData(data)
- else
- Result := 0;
-end;
-
-function TAudioPlaybackBase.OpenSound(const Filename: string): TAudioPlaybackStream;
-begin
- Result := OpenStream(Filename);
-end;
-
-procedure TAudioPlaybackBase.PlaySound(stream: TAudioPlaybackStream);
-begin
- if assigned(stream) then
- stream.Play();
-end;
-
-procedure TAudioPlaybackBase.StopSound(stream: TAudioPlaybackStream);
-begin
- if assigned(stream) then
- stream.Stop();
-end;
-
-procedure TAudioPlaybackBase.ClearOutputDeviceList();
-var
- DeviceIndex: integer;
-begin
- for DeviceIndex := 0 to High(OutputDeviceList) do
- OutputDeviceList[DeviceIndex].Free();
- SetLength(OutputDeviceList, 0);
-end;
-
-function TAudioPlaybackBase.GetOutputDeviceList(): TAudioOutputDeviceList;
-begin
- Result := OutputDeviceList;
-end;
-
-end.
diff --git a/src/classes/UAudioPlayback_Bass.pas b/src/classes/UAudioPlayback_Bass.pas
deleted file mode 100644
index 41a91173..00000000
--- a/src/classes/UAudioPlayback_Bass.pas
+++ /dev/null
@@ -1,731 +0,0 @@
-unit UAudioPlayback_Bass;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-implementation
-
-uses
- Classes,
- SysUtils,
- Math,
- UIni,
- UMain,
- UMusic,
- UAudioPlaybackBase,
- UAudioCore_Bass,
- ULog,
- sdl,
- bass;
-
-type
- PHDSP = ^HDSP;
-
-type
- TBassPlaybackStream = class(TAudioPlaybackStream)
- private
- Handle: HSTREAM;
- NeedsRewind: boolean;
- PausedSeek: boolean; // true if a seek was performed in pause state
-
- procedure Reset();
- function IsEOF(): boolean;
- protected
- function GetLatency(): double; override;
- function GetLoop(): boolean; override;
- procedure SetLoop(Enabled: boolean); override;
- function GetLength(): real; override;
- function GetStatus(): TStreamStatus; override;
- function GetVolume(): single; override;
- procedure SetVolume(Volume: single); override;
- function GetPosition: real; override;
- procedure SetPosition(Time: real); override;
- public
- constructor Create();
- destructor Destroy(); override;
-
- function Open(SourceStream: TAudioSourceStream): boolean; override;
- procedure Close(); override;
-
- procedure Play(); override;
- procedure Pause(); override;
- procedure Stop(); override;
- procedure FadeIn(Time: real; TargetVolume: single); override;
-
- procedure AddSoundEffect(Effect: TSoundEffect); override;
- procedure RemoveSoundEffect(Effect: TSoundEffect); override;
-
- procedure GetFFTData(var Data: TFFTData); override;
- function GetPCMData(var Data: TPCMData): Cardinal; override;
-
- function GetAudioFormatInfo(): TAudioFormatInfo; override;
-
- function ReadData(Buffer: PChar; BufferSize: integer): integer;
-
- property EOF: boolean READ IsEOF;
- end;
-
-const
- MAX_VOICE_DELAY = 0.020; // 20ms
-
-type
- TBassVoiceStream = class(TAudioVoiceStream)
- private
- Handle: HSTREAM;
- public
- function Open(ChannelMap: integer; FormatInfo: TAudioFormatInfo): boolean; override;
- procedure Close(); override;
-
- procedure WriteData(Buffer: PChar; BufferSize: integer); override;
- function ReadData(Buffer: PChar; BufferSize: integer): integer; override;
- function IsEOF(): boolean; override;
- function IsError(): boolean; override;
- end;
-
-type
- TAudioPlayback_Bass = class(TAudioPlaybackBase)
- private
- function EnumDevices(): boolean;
- protected
- function GetLatency(): double; override;
- function CreatePlaybackStream(): TAudioPlaybackStream; override;
- public
- function GetName: String; override;
- function InitializePlayback(): boolean; override;
- function FinalizePlayback: boolean; override;
- procedure SetAppVolume(Volume: single); override;
- function CreateVoiceStream(ChannelMap: integer; FormatInfo: TAudioFormatInfo): TAudioVoiceStream; override;
- end;
-
- TBassOutputDevice = class(TAudioOutputDevice)
- private
- BassDeviceID: DWORD; // DeviceID used by BASS
- end;
-
-var
- BassCore: TAudioCore_Bass;
-
-
-{ TBassPlaybackStream }
-
-function PlaybackStreamHandler(handle: HSTREAM; buffer: Pointer; length: DWORD; user: Pointer): DWORD;
-{$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-var
- PlaybackStream: TBassPlaybackStream;
- BytesRead: integer;
-begin
- PlaybackStream := TBassPlaybackStream(user);
- if (not assigned (PlaybackStream)) then
- begin
- Result := BASS_STREAMPROC_END;
- Exit;
- end;
-
- BytesRead := PlaybackStream.ReadData(buffer, length);
- // check for errors
- if (BytesRead < 0) then
- Result := BASS_STREAMPROC_END
- // check for EOF
- else if (PlaybackStream.EOF) then
- Result := BytesRead or BASS_STREAMPROC_END
- // no error/EOF
- else
- Result := BytesRead;
-end;
-
-function TBassPlaybackStream.ReadData(Buffer: PChar; BufferSize: integer): integer;
-var
- AdjustedSize: integer;
- RequestedSourceSize, SourceSize: integer;
- SkipCount: integer;
- SourceFormatInfo: TAudioFormatInfo;
- FrameSize: integer;
- PadFrame: PChar;
- //Info: BASS_INFO;
- //Latency: double;
-begin
- Result := -1;
-
- if (not assigned(SourceStream)) then
- Exit;
-
- // sanity check
- if (BufferSize = 0) then
- begin
- Result := 0;
- Exit;
- end;
-
- SourceFormatInfo := SourceStream.GetAudioFormatInfo();
- FrameSize := SourceFormatInfo.FrameSize;
-
- // check how much data to fetch to be in synch
- AdjustedSize := Synchronize(BufferSize, SourceFormatInfo);
-
- // skip data if we are too far behind
- SkipCount := AdjustedSize - BufferSize;
- while (SkipCount > 0) do
- begin
- RequestedSourceSize := Min(SkipCount, BufferSize);
- SourceSize := SourceStream.ReadData(Buffer, RequestedSourceSize);
- // if an error or EOF occured stop skipping and handle error/EOF with the next ReadData()
- if (SourceSize <= 0) then
- break;
- Dec(SkipCount, SourceSize);
- end;
-
- // get source data (e.g. from a decoder)
- RequestedSourceSize := Min(AdjustedSize, BufferSize);
- SourceSize := SourceStream.ReadData(Buffer, RequestedSourceSize);
- if (SourceSize < 0) then
- Exit;
-
- // set preliminary result
- Result := SourceSize;
-
- // if we are to far ahead, fill output-buffer with last frame of source data
- // Note that AdjustedSize is used instead of SourceSize as the SourceSize might
- // be less than expected because of errors etc.
- if (AdjustedSize < BufferSize) then
- begin
- // use either the last frame for padding or fill with zero
- if (SourceSize >= FrameSize) then
- PadFrame := @Buffer[SourceSize-FrameSize]
- else
- PadFrame := nil;
-
- FillBufferWithFrame(@Buffer[SourceSize], BufferSize - SourceSize,
- PadFrame, FrameSize);
- Result := BufferSize;
- end;
-end;
-
-constructor TBassPlaybackStream.Create();
-begin
- inherited;
- Reset();
-end;
-
-destructor TBassPlaybackStream.Destroy();
-begin
- Close();
- inherited;
-end;
-
-function TBassPlaybackStream.Open(SourceStream: TAudioSourceStream): boolean;
-var
- FormatInfo: TAudioFormatInfo;
- FormatFlags: DWORD;
-begin
- Result := false;
-
- // close previous stream and reset state
- Reset();
-
- // sanity check if stream is valid
- if not assigned(SourceStream) then
- Exit;
-
- Self.SourceStream := SourceStream;
- FormatInfo := SourceStream.GetAudioFormatInfo();
- if (not BassCore.ConvertAudioFormatToBASSFlags(FormatInfo.Format, FormatFlags)) then
- begin
- Log.LogError('Unhandled sample-format', 'TBassPlaybackStream.Open');
- Exit;
- end;
-
- // create matching playback stream
- Handle := BASS_StreamCreate(Round(FormatInfo.SampleRate), FormatInfo.Channels, formatFlags,
- @PlaybackStreamHandler, Self);
- if (Handle = 0) then
- begin
- Log.LogError('BASS_StreamCreate failed: ' + BassCore.ErrorGetString(BASS_ErrorGetCode()),
- 'TBassPlaybackStream.Open');
- Exit;
- end;
-
- Result := true;
-end;
-
-procedure TBassPlaybackStream.Close();
-begin
- // stop and free stream
- if (Handle <> 0) then
- begin
- Bass_StreamFree(Handle);
- Handle := 0;
- end;
-
- // Note: PerformOnClose must be called before SourceStream is invalidated
- PerformOnClose();
- // unset source-stream
- SourceStream := nil;
-end;
-
-procedure TBassPlaybackStream.Reset();
-begin
- Close();
- NeedsRewind := false;
- PausedSeek := false;
-end;
-
-procedure TBassPlaybackStream.Play();
-var
- NeedsFlush: boolean;
-begin
- if (not assigned(SourceStream)) then
- Exit;
-
- NeedsFlush := true;
-
- if (BASS_ChannelIsActive(Handle) = BASS_ACTIVE_PAUSED) then
- begin
- // only paused (and not seeked while paused) streams are not flushed
- if (not PausedSeek) then
- NeedsFlush := false;
- // paused streams do not need a rewind
- NeedsRewind := false;
- end;
-
- // rewind if necessary. Cases that require no rewind are:
- // - stream was created and never played
- // - stream was paused and is resumed now
- // - stream was stopped and set to a new position already
- if (NeedsRewind) then
- SourceStream.Position := 0;
-
- NeedsRewind := true;
- PausedSeek := false;
-
- // start playing and flush buffers on rewind
- BASS_ChannelPlay(Handle, NeedsFlush);
-end;
-
-procedure TBassPlaybackStream.FadeIn(Time: real; TargetVolume: single);
-begin
- // start stream
- Play();
- // start fade-in: slide from fadeStart- to fadeEnd-volume in FadeInTime
- BASS_ChannelSlideAttribute(Handle, BASS_ATTRIB_VOL, TargetVolume, Trunc(Time * 1000));
-end;
-
-procedure TBassPlaybackStream.Pause();
-begin
- BASS_ChannelPause(Handle);
-end;
-
-procedure TBassPlaybackStream.Stop();
-begin
- BASS_ChannelStop(Handle);
-end;
-
-function TBassPlaybackStream.IsEOF(): boolean;
-begin
- if (assigned(SourceStream)) then
- Result := SourceStream.EOF
- else
- Result := true;
-end;
-
-function TBassPlaybackStream.GetLatency(): double;
-begin
- // TODO: should we consider output latency for synching (needs BASS_DEVICE_LATENCY)?
- //if (BASS_GetInfo(Info)) then
- // Latency := Info.latency / 1000
- //else
- // Latency := 0;
- Result := 0;
-end;
-
-function TBassPlaybackStream.GetVolume(): single;
-var
- lVolume: single;
-begin
- if (not BASS_ChannelGetAttribute(Handle, BASS_ATTRIB_VOL, lVolume)) then
- begin
- Log.LogError('BASS_ChannelGetAttribute: ' + BassCore.ErrorGetString(),
- 'TBassPlaybackStream.GetVolume');
- Result := 0;
- Exit;
- end;
- Result := Round(lVolume);
-end;
-
-procedure TBassPlaybackStream.SetVolume(Volume: single);
-begin
- // clamp volume
- if Volume < 0 then
- Volume := 0;
- if Volume > 1.0 then
- Volume := 1.0;
- // set volume
- BASS_ChannelSetAttribute(Handle, BASS_ATTRIB_VOL, Volume);
-end;
-
-function TBassPlaybackStream.GetPosition: real;
-var
- BufferPosByte: QWORD;
- BufferPosSec: double;
-begin
- if assigned(SourceStream) then
- begin
- BufferPosByte := BASS_ChannelGetData(Handle, nil, BASS_DATA_AVAILABLE);
- BufferPosSec := BASS_ChannelBytes2Seconds(Handle, BufferPosByte);
- // decrease the decoding position by the amount buffered (and hence not played)
- // in the BASS playback stream.
- Result := SourceStream.Position - BufferPosSec;
- end
- else
- begin
- Result := -1;
- end;
-end;
-
-procedure TBassPlaybackStream.SetPosition(Time: real);
-var
- ChannelState: DWORD;
-begin
- if assigned(SourceStream) then
- begin
- ChannelState := BASS_ChannelIsActive(Handle);
- if (ChannelState = BASS_ACTIVE_STOPPED) then
- begin
- // if the stream is stopped, do not rewind when the stream is played next time
- NeedsRewind := false
- end
- else if (ChannelState = BASS_ACTIVE_PAUSED) then
- begin
- // buffers must be flushed if in paused state but there is no
- // BASS_ChannelFlush() function so we have to use BASS_ChannelPlay() called in Play().
- PausedSeek := true;
- end;
-
- // set new position
- SourceStream.Position := Time;
- end;
-end;
-
-function TBassPlaybackStream.GetLength(): real;
-begin
- if assigned(SourceStream) then
- Result := SourceStream.Length
- else
- Result := -1;
-end;
-
-function TBassPlaybackStream.GetStatus(): TStreamStatus;
-var
- State: DWORD;
-begin
- State := BASS_ChannelIsActive(Handle);
- case State of
- BASS_ACTIVE_PLAYING,
- BASS_ACTIVE_STALLED:
- Result := ssPlaying;
- BASS_ACTIVE_PAUSED:
- Result := ssPaused;
- BASS_ACTIVE_STOPPED:
- Result := ssStopped;
- else
- begin
- Log.LogError('Unknown status', 'TBassPlaybackStream.GetStatus');
- Result := ssStopped;
- end;
- end;
-end;
-
-function TBassPlaybackStream.GetLoop(): boolean;
-begin
- if assigned(SourceStream) then
- Result := SourceStream.Loop
- else
- Result := false;
-end;
-
-procedure TBassPlaybackStream.SetLoop(Enabled: boolean);
-begin
- if assigned(SourceStream) then
- SourceStream.Loop := Enabled;
-end;
-
-procedure DSPProcHandler(handle: HDSP; channel: DWORD; buffer: Pointer; length: DWORD; user: Pointer);
-{$IFDEF MSWINDOWS}stdcall;{$ELSE}cdecl;{$ENDIF}
-var
- Effect: TSoundEffect;
-begin
- Effect := TSoundEffect(user);
- if assigned(Effect) then
- Effect.Callback(buffer, length);
-end;
-
-procedure TBassPlaybackStream.AddSoundEffect(Effect: TSoundEffect);
-var
- DspHandle: HDSP;
-begin
- if assigned(Effect.engineData) then
- begin
- Log.LogError('TSoundEffect.engineData already set', 'TBassPlaybackStream.AddSoundEffect');
- Exit;
- end;
-
- DspHandle := BASS_ChannelSetDSP(Handle, @DSPProcHandler, Effect, 0);
- if (DspHandle = 0) then
- begin
- Log.LogError(BassCore.ErrorGetString(), 'TBassPlaybackStream.AddSoundEffect');
- Exit;
- end;
-
- GetMem(Effect.EngineData, SizeOf(HDSP));
- PHDSP(Effect.EngineData)^ := DspHandle;
-end;
-
-procedure TBassPlaybackStream.RemoveSoundEffect(Effect: TSoundEffect);
-begin
- if not assigned(Effect.EngineData) then
- begin
- Log.LogError('TSoundEffect.engineData invalid', 'TBassPlaybackStream.RemoveSoundEffect');
- Exit;
- end;
-
- if not BASS_ChannelRemoveDSP(Handle, PHDSP(Effect.EngineData)^) then
- begin
- Log.LogError(BassCore.ErrorGetString(), 'TBassPlaybackStream.RemoveSoundEffect');
- Exit;
- end;
-
- FreeMem(Effect.EngineData);
- Effect.EngineData := nil;
-end;
-
-procedure TBassPlaybackStream.GetFFTData(var Data: TFFTData);
-begin
- // get FFT channel data (Mono, FFT512 -> 256 values)
- BASS_ChannelGetData(Handle, @Data, BASS_DATA_FFT512);
-end;
-
-{*
- * Copies interleaved PCM SInt16 stereo samples into data.
- * Returns the number of frames
- *}
-function TBassPlaybackStream.GetPCMData(var Data: TPCMData): Cardinal;
-var
- Info: BASS_CHANNELINFO;
- nBytes: DWORD;
-begin
- Result := 0;
-
- FillChar(Data, SizeOf(TPCMData), 0);
-
- // no support for non-stereo files at the moment
- BASS_ChannelGetInfo(Handle, Info);
- if (Info.chans <> 2) then
- Exit;
-
- nBytes := BASS_ChannelGetData(Handle, @Data, SizeOf(TPCMData));
- if(nBytes <= 0) then
- Result := 0
- else
- Result := nBytes div SizeOf(TPCMStereoSample);
-end;
-
-function TBassPlaybackStream.GetAudioFormatInfo(): TAudioFormatInfo;
-begin
- if assigned(SourceStream) then
- Result := SourceStream.GetAudioFormatInfo()
- else
- Result := nil;
-end;
-
-
-{ TBassVoiceStream }
-
-function TBassVoiceStream.Open(ChannelMap: integer; FormatInfo: TAudioFormatInfo): boolean;
-var
- Flags: DWORD;
-begin
- Result := false;
-
- Close();
-
- if (not inherited Open(ChannelMap, FormatInfo)) then
- Exit;
-
- // get channel flags
- BassCore.ConvertAudioFormatToBASSFlags(FormatInfo.Format, Flags);
-
- (*
- // distribute the mics equally to both speakers
- if ((ChannelMap and CHANNELMAP_LEFT) <> 0) then
- Flags := Flags or BASS_SPEAKER_FRONTLEFT;
- if ((ChannelMap and CHANNELMAP_RIGHT) <> 0) then
- Flags := Flags or BASS_SPEAKER_FRONTRIGHT;
- *)
-
- // create the channel
- Handle := BASS_StreamCreate(Round(FormatInfo.SampleRate), 1, Flags, STREAMPROC_PUSH, nil);
-
- // start the channel
- BASS_ChannelPlay(Handle, true);
-
- Result := true;
-end;
-
-procedure TBassVoiceStream.Close();
-begin
- if (Handle <> 0) then
- begin
- BASS_ChannelStop(Handle);
- BASS_StreamFree(Handle);
- end;
- inherited Close();
-end;
-
-procedure TBassVoiceStream.WriteData(Buffer: PChar; BufferSize: integer);
-var QueueSize: DWORD;
-begin
- if ((Handle <> 0) and (BufferSize > 0)) then
- begin
- // query the queue size (normally 0)
- QueueSize := BASS_StreamPutData(Handle, nil, 0);
- // flush the buffer if the delay would be too high
- if (QueueSize > MAX_VOICE_DELAY * FormatInfo.BytesPerSec) then
- BASS_ChannelPlay(Handle, true);
- // send new data to playback buffer
- BASS_StreamPutData(Handle, Buffer, BufferSize);
- end;
-end;
-
-// Note: we do not need the read-function for the BASS implementation
-function TBassVoiceStream.ReadData(Buffer: PChar; BufferSize: integer): integer;
-begin
- Result := -1;
-end;
-
-function TBassVoiceStream.IsEOF(): boolean;
-begin
- Result := false;
-end;
-
-function TBassVoiceStream.IsError(): boolean;
-begin
- Result := false;
-end;
-
-
-{ TAudioPlayback_Bass }
-
-function TAudioPlayback_Bass.GetName: String;
-begin
- Result := 'BASS_Playback';
-end;
-
-function TAudioPlayback_Bass.EnumDevices(): boolean;
-var
- BassDeviceID: DWORD;
- DeviceIndex: integer;
- Device: TBassOutputDevice;
- DeviceInfo: BASS_DEVICEINFO;
-begin
- Result := true;
-
- ClearOutputDeviceList();
-
- // skip "no sound"-device (ID = 0)
- BassDeviceID := 1;
-
- while (true) do
- begin
- // check for device
- if (not BASS_GetDeviceInfo(BassDeviceID, DeviceInfo)) then
- Break;
-
- // set device info
- Device := TBassOutputDevice.Create();
- Device.Name := DeviceInfo.name;
- Device.BassDeviceID := BassDeviceID;
-
- // add device to list
- SetLength(OutputDeviceList, BassDeviceID);
- OutputDeviceList[BassDeviceID-1] := Device;
-
- Inc(BassDeviceID);
- end;
-end;
-
-function TAudioPlayback_Bass.InitializePlayback(): boolean;
-begin
- result := false;
-
- BassCore := TAudioCore_Bass.GetInstance();
-
- EnumDevices();
-
- //Log.BenchmarkStart(4);
- //Log.LogStatus('Initializing Playback Subsystem', 'Music Initialize');
-
- // TODO: use BASS_DEVICE_LATENCY to determine the latency
- if not BASS_Init(-1, 44100, 0, 0, nil) then
- begin
- Log.LogError('Could not initialize BASS', 'TAudioPlayback_Bass.InitializePlayback');
- Exit;
- end;
-
- //Log.BenchmarkEnd(4); Log.LogBenchmark('--> Bass Init', 4);
-
- // config playing buffer
- //BASS_SetConfig(BASS_CONFIG_UPDATEPERIOD, 10);
- //BASS_SetConfig(BASS_CONFIG_BUFFER, 100);
-
- result := true;
-end;
-
-function TAudioPlayback_Bass.FinalizePlayback(): boolean;
-begin
- Close;
- BASS_Free;
- inherited FinalizePlayback();
- Result := true;
-end;
-
-function TAudioPlayback_Bass.CreatePlaybackStream(): TAudioPlaybackStream;
-begin
- Result := TBassPlaybackStream.Create();
-end;
-
-procedure TAudioPlayback_Bass.SetAppVolume(Volume: single);
-begin
- // set volume for this application (ranges from 0..10000 since BASS 2.4)
- BASS_SetConfig(BASS_CONFIG_GVOL_STREAM, Round(Volume*10000));
-end;
-
-function TAudioPlayback_Bass.CreateVoiceStream(ChannelMap: integer; FormatInfo: TAudioFormatInfo): TAudioVoiceStream;
-var
- VoiceStream: TAudioVoiceStream;
-begin
- Result := nil;
-
- VoiceStream := TBassVoiceStream.Create();
- if (not VoiceStream.Open(ChannelMap, FormatInfo)) then
- begin
- VoiceStream.Free;
- Exit;
- end;
-
- Result := VoiceStream;
-end;
-
-function TAudioPlayback_Bass.GetLatency(): double;
-begin
- Result := 0;
-end;
-
-
-initialization
- MediaManager.Add(TAudioPlayback_Bass.Create);
-
-end.
diff --git a/src/classes/UAudioPlayback_Portaudio.pas b/src/classes/UAudioPlayback_Portaudio.pas
deleted file mode 100644
index c3717ba6..00000000
--- a/src/classes/UAudioPlayback_Portaudio.pas
+++ /dev/null
@@ -1,361 +0,0 @@
-unit UAudioPlayback_Portaudio;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-
-uses
- Classes,
- SysUtils,
- UMusic;
-
-implementation
-
-uses
- portaudio,
- UAudioCore_Portaudio,
- UAudioPlayback_SoftMixer,
- ULog,
- UIni,
- UMain;
-
-type
- TAudioPlayback_Portaudio = class(TAudioPlayback_SoftMixer)
- private
- paStream: PPaStream;
- AudioCore: TAudioCore_Portaudio;
- Latency: double;
- function OpenDevice(deviceIndex: TPaDeviceIndex): boolean;
- function EnumDevices(): boolean;
- protected
- function InitializeAudioPlaybackEngine(): boolean; override;
- function StartAudioPlaybackEngine(): boolean; override;
- procedure StopAudioPlaybackEngine(); override;
- function FinalizeAudioPlaybackEngine(): boolean; override;
- function GetLatency(): double; override;
- public
- function GetName: String; override;
- end;
-
- TPortaudioOutputDevice = class(TAudioOutputDevice)
- private
- PaDeviceIndex: TPaDeviceIndex;
- end;
-
-
-{ TAudioPlayback_Portaudio }
-
-function PortaudioAudioCallback(input: Pointer; output: Pointer; frameCount: Longword;
- timeInfo: PPaStreamCallbackTimeInfo; statusFlags: TPaStreamCallbackFlags;
- userData: Pointer): Integer; cdecl;
-var
- Engine: TAudioPlayback_Portaudio;
-begin
- Engine := TAudioPlayback_Portaudio(userData);
- // update latency
- Engine.Latency := timeInfo.outputBufferDacTime - timeInfo.currentTime;
- // call superclass callback
- Engine.AudioCallback(output, frameCount * Engine.FormatInfo.FrameSize);
- Result := paContinue;
-end;
-
-function TAudioPlayback_Portaudio.GetName: String;
-begin
- Result := 'Portaudio_Playback';
-end;
-
-function TAudioPlayback_Portaudio.OpenDevice(deviceIndex: TPaDeviceIndex): boolean;
-var
- DeviceInfo : PPaDeviceInfo;
- SampleRate : double;
- OutParams : TPaStreamParameters;
- StreamInfo : PPaStreamInfo;
- err : TPaError;
-begin
- Result := false;
-
- DeviceInfo := Pa_GetDeviceInfo(deviceIndex);
-
- Log.LogInfo('Audio-Output Device: ' + DeviceInfo^.name, 'TAudioPlayback_Portaudio.OpenDevice');
-
- SampleRate := DeviceInfo^.defaultSampleRate;
-
- with OutParams do
- begin
- device := deviceIndex;
- channelCount := 2;
- sampleFormat := paInt16;
- suggestedLatency := DeviceInfo^.defaultLowOutputLatency;
- hostApiSpecificStreamInfo := nil;
- end;
-
- // check souncard and adjust sample-rate
- if not AudioCore.TestDevice(nil, @OutParams, SampleRate) then
- begin
- Log.LogStatus('TestDevice failed!', 'TAudioPlayback_Portaudio.OpenDevice');
- Exit;
- end;
-
- // open output stream
- err := Pa_OpenStream(paStream, nil, @OutParams, SampleRate,
- paFramesPerBufferUnspecified,
- paNoFlag, @PortaudioAudioCallback, Self);
- if(err <> paNoError) then
- begin
- Log.LogStatus(Pa_GetErrorText(err), 'TAudioPlayback_Portaudio.OpenDevice');
- paStream := nil;
- Exit;
- end;
-
- // get estimated latency (will be updated with real latency in the callback)
- StreamInfo := Pa_GetStreamInfo(paStream);
- if (StreamInfo <> nil) then
- Latency := StreamInfo^.outputLatency
- else
- Latency := 0;
-
- FormatInfo := TAudioFormatInfo.Create(
- OutParams.channelCount,
- SampleRate,
- asfS16 // FIXME: is paInt16 system-dependant or -independant?
- );
-
- Result := true;
-end;
-
-function TAudioPlayback_Portaudio.EnumDevices(): boolean;
-var
- i: integer;
- paApiIndex: TPaHostApiIndex;
- paApiInfo: PPaHostApiInfo;
- deviceName: string;
- deviceIndex: TPaDeviceIndex;
- deviceInfo: PPaDeviceInfo;
- channelCnt: integer;
- SC: integer; // soundcard
- err: TPaError;
- errMsg: string;
- paDevice: TPortaudioOutputDevice;
- outputParams: TPaStreamParameters;
- stream: PPaStream;
- streamInfo: PPaStreamInfo;
- sampleRate: double;
- latency: TPaTime;
- cbPolls: integer;
- cbWorks: boolean;
-begin
- Result := false;
-
-(*
- // choose the best available Audio-API
- paApiIndex := AudioCore.GetPreferredApiIndex();
- if(paApiIndex = -1) then
- begin
- Log.LogError('No working Audio-API found', 'TAudioPlayback_Portaudio.EnumDevices');
- Exit;
- end;
-
- paApiInfo := Pa_GetHostApiInfo(paApiIndex);
-
- SC := 0;
-
- // init array-size to max. output-devices count
- SetLength(OutputDeviceList, paApiInfo^.deviceCount);
- for i:= 0 to High(OutputDeviceList) do
- begin
- // convert API-specific device-index to global index
- deviceIndex := Pa_HostApiDeviceIndexToDeviceIndex(paApiIndex, i);
- deviceInfo := Pa_GetDeviceInfo(deviceIndex);
-
- channelCnt := deviceInfo^.maxOutputChannels;
-
- // current device is no output device -> skip
- if (channelCnt <= 0) then
- continue;
-
- // portaudio returns a channel-count of 128 for some devices
- // (e.g. the "default"-device), so we have to detect those
- // fantasy channel counts.
- if (channelCnt > 8) then
- channelCnt := 2;
-
- paDevice := TPortaudioOutputDevice.Create();
- OutputDeviceList[SC] := paDevice;
-
- // retrieve device-name
- deviceName := deviceInfo^.name;
- paDevice.Name := deviceName;
- paDevice.PaDeviceIndex := deviceIndex;
-
- if (deviceInfo^.defaultSampleRate > 0) then
- sampleRate := deviceInfo^.defaultSampleRate
- else
- sampleRate := 44100;
-
- // on vista and xp the defaultLowInputLatency may be set to 0 but it works.
- // TODO: correct too low latencies (what is a too low latency, maybe < 10ms?)
- latency := deviceInfo^.defaultLowInputLatency;
-
- // setup desired output parameters
- // TODO: retry with input-latency set to 20ms (defaultLowOutputLatency might
- // not be set correctly in OSS)
- with outputParams do
- begin
- device := deviceIndex;
- channelCount := channelCnt;
- sampleFormat := paInt16;
- suggestedLatency := latency;
- hostApiSpecificStreamInfo := nil;
- end;
-
- // check if mic-callback works (might not be called on some devices)
- if (not TAudioCore_Portaudio.TestDevice(nil, @outputParams, sampleRate)) then
- begin
- // ignore device if callback did not work
- Log.LogError('Device "'+paDevice.Name+'" does not respond',
- 'TAudioPlayback_Portaudio.InitializeRecord');
- paDevice.Free();
- continue;
- end;
-
- // open device for further info
- err := Pa_OpenStream(stream, nil, @outputParams, sampleRate,
- paFramesPerBufferUnspecified, paNoFlag, @MicrophoneTestCallback, nil);
- if(err <> paNoError) then
- begin
- // unable to open device -> skip
- errMsg := Pa_GetErrorText(err);
- Log.LogError('Device error: "'+ deviceName +'" ('+ errMsg +')',
- 'TAudioPlayback_Portaudio.InitializeRecord');
- paDevice.Free();
- continue;
- end;
-
- // adjust sample-rate (might be changed by portaudio)
- streamInfo := Pa_GetStreamInfo(stream);
- if (streamInfo <> nil) then
- begin
- if (sampleRate <> streamInfo^.sampleRate) then
- begin
- Log.LogStatus('Portaudio changed Samplerate from ' + FloatToStr(sampleRate) +
- ' to ' + FloatToStr(streamInfo^.sampleRate),
- 'TAudioInput_Portaudio.InitializeRecord');
- sampleRate := streamInfo^.sampleRate;
- end;
- end;
-
- // create audio-format info and resize capture-buffer array
- paDevice.AudioFormat := TAudioFormatInfo.Create(
- channelCnt,
- sampleRate,
- asfS16
- );
- SetLength(paDevice.CaptureChannel, paDevice.AudioFormat.Channels);
-
- Log.LogStatus('OutputDevice "'+paDevice.Name+'"@' +
- IntToStr(paDevice.AudioFormat.Channels)+'x'+
- FloatToStr(paDevice.AudioFormat.SampleRate)+'Hz ('+
- FloatTostr(outputParams.suggestedLatency)+'sec)' ,
- 'TAudioInput_Portaudio.InitializeRecord');
-
- // close test-stream
- Pa_CloseStream(stream);
-
- Inc(SC);
- end;
-
- // adjust size to actual input-device count
- SetLength(OutputDeviceList, SC);
-
- Log.LogStatus('#Output-Devices: ' + inttostr(SC), 'Portaudio');
-*)
-
- Result := true;
-end;
-
-function TAudioPlayback_Portaudio.InitializeAudioPlaybackEngine(): boolean;
-var
- paApiIndex : TPaHostApiIndex;
- paApiInfo : PPaHostApiInfo;
- paOutDevice : TPaDeviceIndex;
- err: TPaError;
-begin
- Result := false;
-
- AudioCore := TAudioCore_Portaudio.GetInstance();
-
- // initialize portaudio
- err := Pa_Initialize();
- if(err <> paNoError) then
- begin
- Log.LogError(Pa_GetErrorText(err), 'TAudioInput_Portaudio.InitializeRecord');
- Exit;
- end;
-
- paApiIndex := AudioCore.GetPreferredApiIndex();
- if(paApiIndex = -1) then
- begin
- Log.LogError('No working Audio-API found', 'TAudioPlayback_Portaudio.InitializeAudioPlaybackEngine');
- Exit;
- end;
-
- EnumDevices();
-
- paApiInfo := Pa_GetHostApiInfo(paApiIndex);
- Log.LogInfo('Audio-Output API-Type: ' + paApiInfo^.name, 'TAudioPlayback_Portaudio.OpenDevice');
-
- paOutDevice := paApiInfo^.defaultOutputDevice;
- if (not OpenDevice(paOutDevice)) then
- begin
- Exit;
- end;
-
- Result := true;
-end;
-
-function TAudioPlayback_Portaudio.StartAudioPlaybackEngine(): boolean;
-var
- err: TPaError;
-begin
- Result := false;
-
- if (paStream = nil) then
- Exit;
-
- err := Pa_StartStream(paStream);
- if(err <> paNoError) then
- begin
- Log.LogStatus('Pa_StartStream: '+Pa_GetErrorText(err), 'UAudioPlayback_Portaudio');
- Exit;
- end;
-
- Result := true;
-end;
-
-procedure TAudioPlayback_Portaudio.StopAudioPlaybackEngine();
-begin
- if (paStream <> nil) then
- Pa_StopStream(paStream);
-end;
-
-function TAudioPlayback_Portaudio.FinalizeAudioPlaybackEngine(): boolean;
-begin
- Pa_Terminate();
- Result := true;
-end;
-
-function TAudioPlayback_Portaudio.GetLatency(): double;
-begin
- Result := Latency;
-end;
-
-
-initialization
- MediaManager.Add(TAudioPlayback_Portaudio.Create);
-
-end.
diff --git a/src/classes/UAudioPlayback_SDL.pas b/src/classes/UAudioPlayback_SDL.pas
deleted file mode 100644
index deef91e8..00000000
--- a/src/classes/UAudioPlayback_SDL.pas
+++ /dev/null
@@ -1,160 +0,0 @@
-unit UAudioPlayback_SDL;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-
-uses
- Classes,
- SysUtils,
- UMusic;
-
-implementation
-
-uses
- sdl,
- UAudioPlayback_SoftMixer,
- ULog,
- UIni,
- UMain;
-
-type
- TAudioPlayback_SDL = class(TAudioPlayback_SoftMixer)
- private
- Latency: double;
- function EnumDevices(): boolean;
- protected
- function InitializeAudioPlaybackEngine(): boolean; override;
- function StartAudioPlaybackEngine(): boolean; override;
- procedure StopAudioPlaybackEngine(); override;
- function FinalizeAudioPlaybackEngine(): boolean; override;
- function GetLatency(): double; override;
- public
- function GetName: String; override;
- procedure MixBuffers(dst, src: PChar; size: Cardinal; volume: Single); override;
- end;
-
-
-{ TAudioPlayback_SDL }
-
-procedure SDLAudioCallback(userdata: Pointer; stream: PChar; len: integer); cdecl;
-var
- Engine: TAudioPlayback_SDL;
-begin
- Engine := TAudioPlayback_SDL(userdata);
- Engine.AudioCallback(stream, len);
-end;
-
-function TAudioPlayback_SDL.GetName: String;
-begin
- Result := 'SDL_Playback';
-end;
-
-function TAudioPlayback_SDL.EnumDevices(): boolean;
-begin
- // Note: SDL does not provide Device-Selection capabilities (will be introduced in 1.3)
- ClearOutputDeviceList();
- SetLength(OutputDeviceList, 1);
- OutputDeviceList[0] := TAudioOutputDevice.Create();
- OutputDeviceList[0].Name := '[SDL Default-Device]';
- Result := true;
-end;
-
-function TAudioPlayback_SDL.InitializeAudioPlaybackEngine(): boolean;
-var
- DesiredAudioSpec, ObtainedAudioSpec: TSDL_AudioSpec;
- SampleBufferSize: integer;
-begin
- Result := false;
-
- EnumDevices();
-
- if (SDL_InitSubSystem(SDL_INIT_AUDIO) = -1) then
- begin
- Log.LogError('SDL_InitSubSystem failed!', 'TAudioPlayback_SDL.InitializeAudioPlaybackEngine');
- Exit;
- end;
-
- SampleBufferSize := IAudioOutputBufferSizeVals[Ini.AudioOutputBufferSizeIndex];
- if (SampleBufferSize <= 0) then
- begin
- // Automatic setting default
- // FIXME: too much glitches with 1024 samples
- SampleBufferSize := 2048; //1024;
- end;
-
- FillChar(DesiredAudioSpec, SizeOf(DesiredAudioSpec), 0);
- with DesiredAudioSpec do
- begin
- freq := 44100;
- format := AUDIO_S16SYS;
- channels := 2;
- samples := SampleBufferSize;
- callback := @SDLAudioCallback;
- userdata := Self;
- end;
-
- // Note: always use the "obtained" parameter, otherwise SDL might try to convert
- // the samples itself if the desired format is not available. This might lead
- // to problems if for example ALSA does not support 44100Hz and proposes 48000Hz.
- // Without the obtained parameter, SDL would try to convert 44.1kHz to 48kHz with
- // its crappy (non working) converter resulting in a wrong (too high) pitch.
- if(SDL_OpenAudio(@DesiredAudioSpec, @ObtainedAudioSpec) = -1) then
- begin
- Log.LogStatus('SDL_OpenAudio: ' + SDL_GetError(), 'TAudioPlayback_SDL.InitializeAudioPlaybackEngine');
- Exit;
- end;
-
- FormatInfo := TAudioFormatInfo.Create(
- ObtainedAudioSpec.channels,
- ObtainedAudioSpec.freq,
- asfS16
- );
-
- // Note: SDL does not provide info of the internal buffer state.
- // So we use the average buffer-size.
- Latency := (ObtainedAudioSpec.samples/2) / FormatInfo.SampleRate;
-
- Log.LogStatus('Opened audio device', 'TAudioPlayback_SDL.InitializeAudioPlaybackEngine');
-
- Result := true;
-end;
-
-function TAudioPlayback_SDL.StartAudioPlaybackEngine(): boolean;
-begin
- SDL_PauseAudio(0);
- Result := true;
-end;
-
-procedure TAudioPlayback_SDL.StopAudioPlaybackEngine();
-begin
- SDL_PauseAudio(1);
-end;
-
-function TAudioPlayback_SDL.FinalizeAudioPlaybackEngine(): boolean;
-begin
- SDL_CloseAudio();
- SDL_QuitSubSystem(SDL_INIT_AUDIO);
- Result := true;
-end;
-
-function TAudioPlayback_SDL.GetLatency(): double;
-begin
- Result := Latency;
-end;
-
-procedure TAudioPlayback_SDL.MixBuffers(dst, src: PChar; size: Cardinal; volume: Single);
-begin
- SDL_MixAudio(PUInt8(dst), PUInt8(src), size, Round(volume * SDL_MIX_MAXVOLUME));
-end;
-
-
-initialization
- MediaManager.add(TAudioPlayback_SDL.Create);
-
-end.
diff --git a/src/classes/UAudioPlayback_SoftMixer.pas b/src/classes/UAudioPlayback_SoftMixer.pas
deleted file mode 100644
index 6ddae980..00000000
--- a/src/classes/UAudioPlayback_SoftMixer.pas
+++ /dev/null
@@ -1,1132 +0,0 @@
-unit UAudioPlayback_SoftMixer;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-
-uses
- Classes,
- SysUtils,
- sdl,
- URingBuffer,
- UMusic,
- UAudioPlaybackBase;
-
-type
- TAudioPlayback_SoftMixer = class;
-
- TGenericPlaybackStream = class(TAudioPlaybackStream)
- private
- Engine: TAudioPlayback_SoftMixer;
-
- SampleBuffer: PChar;
- SampleBufferSize: integer;
- SampleBufferCount: integer; // number of available bytes in SampleBuffer
- SampleBufferPos: cardinal;
-
- SourceBuffer: PChar;
- SourceBufferSize: integer;
- SourceBufferCount: integer; // number of available bytes in SourceBuffer
-
- Converter: TAudioConverter;
- Status: TStreamStatus;
- InternalLock: PSDL_Mutex;
- SoundEffects: TList;
- fVolume: single;
-
- FadeInStartTime, FadeInTime: cardinal;
- FadeInStartVolume, FadeInTargetVolume: single;
-
- NeedsRewind: boolean;
-
- procedure Reset();
-
- procedure ApplySoundEffects(Buffer: PChar; BufferSize: integer);
- function InitFormatConversion(): boolean;
- procedure FlushBuffers();
-
- procedure LockSampleBuffer(); {$IFDEF HasInline}inline;{$ENDIF}
- procedure UnlockSampleBuffer(); {$IFDEF HasInline}inline;{$ENDIF}
- protected
- function GetLatency(): double; override;
- function GetStatus(): TStreamStatus; override;
- function GetVolume(): single; override;
- procedure SetVolume(Volume: single); override;
- function GetLength(): real; override;
- function GetLoop(): boolean; override;
- procedure SetLoop(Enabled: boolean); override;
- function GetPosition: real; override;
- procedure SetPosition(Time: real); override;
- public
- constructor Create(Engine: TAudioPlayback_SoftMixer);
- destructor Destroy(); override;
-
- function Open(SourceStream: TAudioSourceStream): boolean; override;
- procedure Close(); override;
-
- procedure Play(); override;
- procedure Pause(); override;
- procedure Stop(); override;
- procedure FadeIn(Time: real; TargetVolume: single); override;
-
- function GetAudioFormatInfo(): TAudioFormatInfo; override;
-
- function ReadData(Buffer: PChar; BufferSize: integer): integer;
-
- function GetPCMData(var Data: TPCMData): Cardinal; override;
- procedure GetFFTData(var Data: TFFTData); override;
-
- procedure AddSoundEffect(Effect: TSoundEffect); override;
- procedure RemoveSoundEffect(Effect: TSoundEffect); override;
- end;
-
- TAudioMixerStream = class
- private
- Engine: TAudioPlayback_SoftMixer;
-
- ActiveStreams: TList;
- MixerBuffer: PChar;
- InternalLock: PSDL_Mutex;
-
- AppVolume: single;
-
- procedure Lock(); {$IFDEF HasInline}inline;{$ENDIF}
- procedure Unlock(); {$IFDEF HasInline}inline;{$ENDIF}
-
- function GetVolume(): single;
- procedure SetVolume(Volume: single);
- public
- constructor Create(Engine: TAudioPlayback_SoftMixer);
- destructor Destroy(); override;
- procedure AddStream(Stream: TAudioPlaybackStream);
- procedure RemoveStream(Stream: TAudioPlaybackStream);
- function ReadData(Buffer: PChar; BufferSize: integer): integer;
-
- property Volume: single read GetVolume write SetVolume;
- end;
-
- TAudioPlayback_SoftMixer = class(TAudioPlaybackBase)
- private
- MixerStream: TAudioMixerStream;
- protected
- FormatInfo: TAudioFormatInfo;
-
- function InitializeAudioPlaybackEngine(): boolean; virtual; abstract;
- function StartAudioPlaybackEngine(): boolean; virtual; abstract;
- procedure StopAudioPlaybackEngine(); virtual; abstract;
- function FinalizeAudioPlaybackEngine(): boolean; virtual; abstract;
- procedure AudioCallback(Buffer: PChar; Size: integer); {$IFDEF HasInline}inline;{$ENDIF}
-
- function CreatePlaybackStream(): TAudioPlaybackStream; override;
- public
- function GetName: String; override; abstract;
- function InitializePlayback(): boolean; override;
- function FinalizePlayback: boolean; override;
-
- procedure SetAppVolume(Volume: single); override;
-
- function CreateVoiceStream(ChannelMap: integer; FormatInfo: TAudioFormatInfo): TAudioVoiceStream; override;
-
- function GetMixer(): TAudioMixerStream; {$IFDEF HasInline}inline;{$ENDIF}
- function GetAudioFormatInfo(): TAudioFormatInfo;
-
- procedure MixBuffers(DstBuffer, SrcBuffer: PChar; Size: Cardinal; Volume: Single); virtual;
- end;
-
-type
- TGenericVoiceStream = class(TAudioVoiceStream)
- private
- VoiceBuffer: TRingBuffer;
- BufferLock: PSDL_Mutex;
- PlaybackStream: TGenericPlaybackStream;
- Engine: TAudioPlayback_SoftMixer;
- public
- constructor Create(Engine: TAudioPlayback_SoftMixer);
-
- function Open(ChannelMap: integer; FormatInfo: TAudioFormatInfo): boolean; override;
- procedure Close(); override;
- procedure WriteData(Buffer: PChar; BufferSize: integer); override;
- function ReadData(Buffer: PChar; BufferSize: integer): integer; override;
- function IsEOF(): boolean; override;
- function IsError(): boolean; override;
- end;
-
-const
- SOURCE_BUFFER_FRAMES = 4096;
-
-const
- MAX_VOICE_DELAY = 0.500; // 20ms
-
-implementation
-
-uses
- Math,
- ULog,
- UIni,
- UFFT,
- UAudioConverter,
- UMain;
-
-{ TAudioMixerStream }
-
-constructor TAudioMixerStream.Create(Engine: TAudioPlayback_SoftMixer);
-begin
- inherited Create();
-
- Self.Engine := Engine;
-
- ActiveStreams := TList.Create;
- InternalLock := SDL_CreateMutex();
- AppVolume := 1.0;
-end;
-
-destructor TAudioMixerStream.Destroy();
-begin
- if assigned(MixerBuffer) then
- Freemem(MixerBuffer);
- ActiveStreams.Free;
- SDL_DestroyMutex(InternalLock);
- inherited;
-end;
-
-procedure TAudioMixerStream.Lock();
-begin
- SDL_mutexP(InternalLock);
-end;
-
-procedure TAudioMixerStream.Unlock();
-begin
- SDL_mutexV(InternalLock);
-end;
-
-function TAudioMixerStream.GetVolume(): single;
-begin
- Lock();
- Result := AppVolume;
- Unlock();
-end;
-
-procedure TAudioMixerStream.SetVolume(Volume: single);
-begin
- Lock();
- AppVolume := Volume;
- Unlock();
-end;
-
-procedure TAudioMixerStream.AddStream(Stream: TAudioPlaybackStream);
-begin
- if not assigned(Stream) then
- Exit;
-
- Lock();
- // check if stream is already in list to avoid duplicates
- if (ActiveStreams.IndexOf(Pointer(Stream)) = -1) then
- ActiveStreams.Add(Pointer(Stream));
- Unlock();
-end;
-
-(*
- * Sets the entry of stream in the ActiveStreams-List to nil
- * but does not remove it from the list (Count is not changed!).
- * Otherwise iterations over the elements might fail due to a
- * changed Count-property.
- * Call ActiveStreams.Pack() to remove the nil-pointers
- * or check for nil-pointers when accessing ActiveStreams.
- *)
-procedure TAudioMixerStream.RemoveStream(Stream: TAudioPlaybackStream);
-var
- Index: integer;
-begin
- Lock();
- Index := activeStreams.IndexOf(Pointer(Stream));
- if (Index <> -1) then
- begin
- // remove entry but do not decrease count-property
- ActiveStreams[Index] := nil;
- end;
- Unlock();
-end;
-
-function TAudioMixerStream.ReadData(Buffer: PChar; BufferSize: integer): integer;
-var
- i: integer;
- Size: integer;
- Stream: TGenericPlaybackStream;
- NeedsPacking: boolean;
-begin
- Result := BufferSize;
-
- // zero target-buffer (silence)
- FillChar(Buffer^, BufferSize, 0);
-
- // resize mixer-buffer if necessary
- ReallocMem(MixerBuffer, BufferSize);
- if not assigned(MixerBuffer) then
- Exit;
-
- Lock();
-
- NeedsPacking := false;
-
- // mix streams to one stream
- for i := 0 to ActiveStreams.Count-1 do
- begin
- if (ActiveStreams[i] = nil) then
- begin
- NeedsPacking := true;
- continue;
- end;
-
- Stream := TGenericPlaybackStream(ActiveStreams[i]);
- // fetch data from current stream
- Size := Stream.ReadData(MixerBuffer, BufferSize);
- if (Size > 0) then
- begin
- // mix stream-data with mixer-buffer
- // Note: use Self.appVolume instead of Self.Volume to prevent recursive locking
- Engine.MixBuffers(Buffer, MixerBuffer, Size, AppVolume * Stream.Volume);
- end;
- end;
-
- // remove nil-pointers from list
- if (NeedsPacking) then
- begin
- ActiveStreams.Pack();
- end;
-
- Unlock();
-end;
-
-
-{ TGenericPlaybackStream }
-
-constructor TGenericPlaybackStream.Create(Engine: TAudioPlayback_SoftMixer);
-begin
- inherited Create();
- Self.Engine := Engine;
- InternalLock := SDL_CreateMutex();
- SoundEffects := TList.Create;
- Status := ssStopped;
- Reset();
-end;
-
-destructor TGenericPlaybackStream.Destroy();
-begin
- Close();
- SDL_DestroyMutex(InternalLock);
- FreeAndNil(SoundEffects);
- inherited;
-end;
-
-procedure TGenericPlaybackStream.Reset();
-begin
- SourceStream := nil;
-
- FreeAndNil(Converter);
-
- FreeMem(SampleBuffer);
- SampleBuffer := nil;
- SampleBufferPos := 0;
- SampleBufferSize := 0;
- SampleBufferCount := 0;
-
- FreeMem(SourceBuffer);
- SourceBuffer := nil;
- SourceBufferSize := 0;
- SourceBufferCount := 0;
-
- NeedsRewind := false;
-
- fVolume := 0;
- SoundEffects.Clear;
- FadeInTime := 0;
-end;
-
-function TGenericPlaybackStream.Open(SourceStream: TAudioSourceStream): boolean;
-begin
- Result := false;
-
- Close();
-
- if (not assigned(SourceStream)) then
- Exit;
- Self.SourceStream := SourceStream;
-
- if (not InitFormatConversion()) then
- begin
- // reset decode-stream so it will not be freed on destruction
- Self.SourceStream := nil;
- Exit;
- end;
-
- SourceBufferSize := SOURCE_BUFFER_FRAMES * SourceStream.GetAudioFormatInfo().FrameSize;
- GetMem(SourceBuffer, SourceBufferSize);
- fVolume := 1.0;
-
- Result := true;
-end;
-
-procedure TGenericPlaybackStream.Close();
-begin
- // stop audio-callback on this stream
- Stop();
-
- // Note: PerformOnClose must be called before SourceStream is invalidated
- PerformOnClose();
- // and free data
- Reset();
-end;
-
-procedure TGenericPlaybackStream.LockSampleBuffer();
-begin
- SDL_mutexP(InternalLock);
-end;
-
-procedure TGenericPlaybackStream.UnlockSampleBuffer();
-begin
- SDL_mutexV(InternalLock);
-end;
-
-function TGenericPlaybackStream.InitFormatConversion(): boolean;
-var
- SrcFormatInfo: TAudioFormatInfo;
- DstFormatInfo: TAudioFormatInfo;
-begin
- Result := false;
-
- SrcFormatInfo := SourceStream.GetAudioFormatInfo();
- DstFormatInfo := GetAudioFormatInfo();
-
- // TODO: selection should not be done here, use a factory (TAudioConverterFactory) instead
- {$IF Defined(UseFFmpegResample)}
- Converter := TAudioConverter_FFmpeg.Create();
- {$ELSEIF Defined(UseSRCResample)}
- Converter := TAudioConverter_SRC.Create();
- {$ELSE}
- Converter := TAudioConverter_SDL.Create();
- {$IFEND}
-
- Result := Converter.Init(SrcFormatInfo, DstFormatInfo);
-end;
-
-procedure TGenericPlaybackStream.Play();
-var
- Mixer: TAudioMixerStream;
-begin
- // only paused streams are not flushed
- if (Status = ssPaused) then
- NeedsRewind := false;
-
- // rewind if necessary. Cases that require no rewind are:
- // - stream was created and never played
- // - stream was paused and is resumed now
- // - stream was stopped and set to a new position already
- if (NeedsRewind) then
- SetPosition(0);
-
- // update status
- Status := ssPlaying;
-
- NeedsRewind := true;
-
- // add this stream to the mixer
- Mixer := Engine.GetMixer();
- if (Mixer <> nil) then
- Mixer.AddStream(Self);
-end;
-
-procedure TGenericPlaybackStream.FadeIn(Time: real; TargetVolume: single);
-begin
- FadeInTime := Trunc(Time * 1000);
- FadeInStartTime := SDL_GetTicks();
- FadeInStartVolume := fVolume;
- FadeInTargetVolume := TargetVolume;
- Play();
-end;
-
-procedure TGenericPlaybackStream.Pause();
-var
- Mixer: TAudioMixerStream;
-begin
- if (Status <> ssPlaying) then
- Exit;
-
- Status := ssPaused;
-
- Mixer := Engine.GetMixer();
- if (Mixer <> nil) then
- Mixer.RemoveStream(Self);
-end;
-
-procedure TGenericPlaybackStream.Stop();
-var
- Mixer: TAudioMixerStream;
-begin
- if (Status = ssStopped) then
- Exit;
-
- Status := ssStopped;
-
- Mixer := Engine.GetMixer();
- if (Mixer <> nil) then
- Mixer.RemoveStream(Self);
-end;
-
-function TGenericPlaybackStream.GetLoop(): boolean;
-begin
- if assigned(SourceStream) then
- Result := SourceStream.Loop
- else
- Result := false;
-end;
-
-procedure TGenericPlaybackStream.SetLoop(Enabled: boolean);
-begin
- if assigned(SourceStream) then
- SourceStream.Loop := Enabled;
-end;
-
-function TGenericPlaybackStream.GetLength(): real;
-begin
- if assigned(SourceStream) then
- Result := SourceStream.Length
- else
- Result := -1;
-end;
-
-function TGenericPlaybackStream.GetLatency(): double;
-begin
- Result := Engine.GetLatency();
-end;
-
-function TGenericPlaybackStream.GetStatus(): TStreamStatus;
-begin
- Result := Status;
-end;
-
-function TGenericPlaybackStream.GetAudioFormatInfo(): TAudioFormatInfo;
-begin
- Result := Engine.GetAudioFormatInfo();
-end;
-
-procedure TGenericPlaybackStream.FlushBuffers();
-begin
- SampleBufferCount := 0;
- SampleBufferPos := 0;
- SourceBufferCount := 0;
-end;
-
-procedure TGenericPlaybackStream.ApplySoundEffects(Buffer: PChar; BufferSize: integer);
-var
- i: integer;
-begin
- for i := 0 to SoundEffects.Count-1 do
- begin
- if (SoundEffects[i] <> nil) then
- begin
- TSoundEffect(SoundEffects[i]).Callback(Buffer, BufferSize);
- end;
- end;
-end;
-
-function TGenericPlaybackStream.ReadData(Buffer: PChar; BufferSize: integer): integer;
-var
- ConversionInputCount: integer;
- ConversionOutputSize: integer; // max. number of converted data (= buffer size)
- ConversionOutputCount: integer; // actual number of converted data
- SourceSize: integer;
- RequestedSourceSize: integer;
- NeededSampleBufferSize: integer;
- BytesNeeded, BytesAvail: integer;
- SourceFormatInfo, OutputFormatInfo: TAudioFormatInfo;
- SourceFrameSize, OutputFrameSize: integer;
- SkipOutputCount: integer; // number of output-data bytes to skip
- SkipSourceCount: integer; // number of source-data bytes to skip
- FillCount: integer; // number of bytes to fill with padding data
- CopyCount: integer;
- PadFrame: PChar;
- i: integer;
-begin
- Result := -1;
-
- // sanity check for the source-stream
- if (not assigned(SourceStream)) then
- Exit;
-
- SkipOutputCount := 0;
- SkipSourceCount := 0;
- FillCount := 0;
-
- SourceFormatInfo := SourceStream.GetAudioFormatInfo();
- SourceFrameSize := SourceFormatInfo.FrameSize;
- OutputFormatInfo := GetAudioFormatInfo();
- OutputFrameSize := OutputFormatInfo.FrameSize;
-
- // synchronize (adjust buffer size)
- BytesNeeded := Synchronize(BufferSize, OutputFormatInfo);
- if (BytesNeeded > BufferSize) then
- begin
- SkipOutputCount := BytesNeeded - BufferSize;
- BytesNeeded := BufferSize;
- end
- else if (BytesNeeded < BufferSize) then
- begin
- FillCount := BufferSize - BytesNeeded;
- end;
-
- // lock access to sample-buffer
- LockSampleBuffer();
- try
-
- // skip sample-buffer data
- SampleBufferPos := SampleBufferPos + SkipOutputCount;
- // size of available bytes in SampleBuffer after skipping
- SampleBufferCount := SampleBufferCount - SampleBufferPos;
- // update byte skip-count
- SkipOutputCount := -SampleBufferCount;
-
- // now that we skipped all buffered data from the last pass, we have to skip
- // data directly after fetching it from the source-stream.
- if (SkipOutputCount > 0) then
- begin
- SampleBufferCount := 0;
- // convert skip-count to source-format units and resize to a multiple of
- // the source frame-size.
- SkipSourceCount := Round((SkipOutputCount * OutputFormatInfo.GetRatio(SourceFormatInfo)) /
- SourceFrameSize) * SourceFrameSize;
- SkipOutputCount := 0;
- end;
-
- // copy data to front of buffer
- if ((SampleBufferCount > 0) and (SampleBufferPos > 0)) then
- Move(SampleBuffer[SampleBufferPos], SampleBuffer[0], SampleBufferCount);
- SampleBufferPos := 0;
-
- // resize buffer to a reasonable size
- if (BufferSize > SampleBufferCount) then
- begin
- // Note: use BufferSize instead of BytesNeeded to minimize the need for resizing
- SampleBufferSize := BufferSize;
- ReallocMem(SampleBuffer, SampleBufferSize);
- if (not assigned(SampleBuffer)) then
- Exit;
- end;
-
- // fill sample-buffer (fetch and convert one block of source data per loop)
- while (SampleBufferCount < BytesNeeded) do
- begin
- // move remaining source data from the previous pass to front of buffer
- if (SourceBufferCount > 0) then
- begin
- Move(SourceBuffer[SourceBufferSize-SourceBufferCount],
- SourceBuffer[0],
- SourceBufferCount);
- end;
-
- SourceSize := SourceStream.ReadData(
- @SourceBuffer[SourceBufferCount], SourceBufferSize-SourceBufferCount);
- // break on error (-1) or if no data is available (0), e.g. while seeking
- if (SourceSize <= 0) then
- begin
- // if we do not have data -> exit
- if (SourceBufferCount = 0) then
- begin
- FlushBuffers();
- Exit;
- end;
- // if we have some data, stop retrieving data from the source stream
- // and use the data we have so far
- Break;
- end;
-
- SourceBufferCount := SourceBufferCount + SourceSize;
-
- // end-of-file reached -> stop playback
- if (SourceStream.EOF) then
- begin
- if (Loop) then
- SourceStream.Position := 0
- else
- Stop();
- end;
-
- if (SkipSourceCount > 0) then
- begin
- // skip data and update source buffer count
- SourceBufferCount := SourceBufferCount - SkipSourceCount;
- SkipSourceCount := -SourceBufferCount;
- // continue with next pass if we skipped all data
- if (SourceBufferCount <= 0) then
- begin
- SourceBufferCount := 0;
- Continue;
- end;
- end;
-
- // calc buffer size (might be bigger than actual resampled byte count)
- ConversionOutputSize := Converter.GetOutputBufferSize(SourceBufferCount);
- NeededSampleBufferSize := SampleBufferCount + ConversionOutputSize;
-
- // resize buffer if necessary
- if (SampleBufferSize < NeededSampleBufferSize) then
- begin
- SampleBufferSize := NeededSampleBufferSize;
- ReallocMem(SampleBuffer, SampleBufferSize);
- if (not assigned(SampleBuffer)) then
- begin
- FlushBuffers();
- Exit;
- end;
- end;
-
- // resample source data (Note: ConversionInputCount might be adjusted by Convert())
- ConversionInputCount := SourceBufferCount;
- ConversionOutputCount := Converter.Convert(
- SourceBuffer, @SampleBuffer[SampleBufferCount], ConversionInputCount);
- if (ConversionOutputCount = -1) then
- begin
- FlushBuffers();
- Exit;
- end;
-
- // adjust sample- and source-buffer count by the number of converted bytes
- SampleBufferCount := SampleBufferCount + ConversionOutputCount;
- SourceBufferCount := SourceBufferCount - ConversionInputCount;
- end;
-
- // apply effects
- ApplySoundEffects(SampleBuffer, SampleBufferCount);
-
- // copy data to result buffer
- CopyCount := Min(BytesNeeded, SampleBufferCount);
- Move(SampleBuffer[0], Buffer[BufferSize - BytesNeeded], CopyCount);
- Dec(BytesNeeded, CopyCount);
- SampleBufferPos := CopyCount;
-
- // release buffer lock
- finally
- UnlockSampleBuffer();
- end;
-
- // pad the buffer with the last frame if we are to fast
- if (FillCount > 0) then
- begin
- if (CopyCount >= OutputFrameSize) then
- PadFrame := @Buffer[CopyCount-OutputFrameSize]
- else
- PadFrame := nil;
- FillBufferWithFrame(@Buffer[CopyCount], FillCount,
- PadFrame, OutputFrameSize);
- end;
-
- // BytesNeeded now contains the number of remaining bytes we were not able to fetch
- Result := BufferSize - BytesNeeded;
-end;
-
-function TGenericPlaybackStream.GetPCMData(var Data: TPCMData): Cardinal;
-var
- ByteCount: integer;
-begin
- Result := 0;
-
- // just SInt16 stereo support for now
- if ((Engine.GetAudioFormatInfo().Format <> asfS16) or
- (Engine.GetAudioFormatInfo().Channels <> 2)) then
- begin
- Exit;
- end;
-
- // zero memory
- FillChar(Data, SizeOf(Data), 0);
-
- // TODO: At the moment just the first samples of the SampleBuffer
- // are returned, even if there is newer data in the upper samples.
-
- LockSampleBuffer();
- ByteCount := Min(SizeOf(Data), SampleBufferCount);
- if (ByteCount > 0) then
- begin
- Move(SampleBuffer[0], Data, ByteCount);
- end;
- UnlockSampleBuffer();
-
- Result := ByteCount div SizeOf(TPCMStereoSample);
-end;
-
-procedure TGenericPlaybackStream.GetFFTData(var Data: TFFTData);
-var
- i: integer;
- Frames: integer;
- DataIn: PSingleArray;
- AudioFormat: TAudioFormatInfo;
-begin
- // only works with SInt16 and Float values at the moment
- AudioFormat := GetAudioFormatInfo();
-
- DataIn := AllocMem(FFTSize * SizeOf(Single));
- if (DataIn = nil) then
- Exit;
-
- LockSampleBuffer();
- // TODO: We just use the first Frames frames, the others are ignored.
- Frames := Min(FFTSize, SampleBufferCount div AudioFormat.FrameSize);
- // use only first channel and convert data to float-values
- case AudioFormat.Format of
- asfS16:
- begin
- for i := 0 to Frames-1 do
- DataIn[i] := PSmallInt(@SampleBuffer[i*AudioFormat.FrameSize])^ / -Low(SmallInt);
- end;
- asfFloat:
- begin
- for i := 0 to Frames-1 do
- DataIn[i] := PSingle(@SampleBuffer[i*AudioFormat.FrameSize])^;
- end;
- end;
- UnlockSampleBuffer();
-
- WindowFunc(fwfHanning, FFTSize, DataIn);
- PowerSpectrum(FFTSize, DataIn, @Data);
- FreeMem(DataIn);
-
- // resize data to a 0..1 range
- for i := 0 to High(TFFTData) do
- begin
- Data[i] := Sqrt(Data[i]) / 100;
- end;
-end;
-
-procedure TGenericPlaybackStream.AddSoundEffect(Effect: TSoundEffect);
-begin
- if (not assigned(Effect)) then
- Exit;
-
- LockSampleBuffer();
- // check if effect is already in list to avoid duplicates
- if (SoundEffects.IndexOf(Pointer(Effect)) = -1) then
- SoundEffects.Add(Pointer(Effect));
- UnlockSampleBuffer();
-end;
-
-procedure TGenericPlaybackStream.RemoveSoundEffect(Effect: TSoundEffect);
-begin
- LockSampleBuffer();
- SoundEffects.Remove(Effect);
- UnlockSampleBuffer();
-end;
-
-function TGenericPlaybackStream.GetPosition: real;
-var
- BufferedTime: double;
-begin
- if assigned(SourceStream) then
- begin
- LockSampleBuffer();
-
- // calc the time of source data that is buffered (in the SampleBuffer and SourceBuffer)
- // but not yet outputed
- BufferedTime := (SampleBufferCount - SampleBufferPos) / Engine.FormatInfo.BytesPerSec +
- SourceBufferCount / SourceStream.GetAudioFormatInfo().BytesPerSec;
- // and subtract it from the source position
- Result := SourceStream.Position - BufferedTime;
-
- UnlockSampleBuffer();
- end
- else
- begin
- Result := -1;
- end;
-end;
-
-procedure TGenericPlaybackStream.SetPosition(Time: real);
-begin
- if assigned(SourceStream) then
- begin
- LockSampleBuffer();
-
- SourceStream.Position := Time;
- if (Status = ssStopped) then
- NeedsRewind := false;
- // do not use outdated data
- FlushBuffers();
-
- AvgSyncDiff := -1;
-
- UnlockSampleBuffer();
- end;
-end;
-
-function TGenericPlaybackStream.GetVolume(): single;
-var
- FadeAmount: Single;
-begin
- LockSampleBuffer();
- // adjust volume if fading is enabled
- if (FadeInTime > 0) then
- begin
- FadeAmount := (SDL_GetTicks() - FadeInStartTime) / FadeInTime;
- // check if fade-target is reached
- if (FadeAmount >= 1) then
- begin
- // target reached -> stop fading
- FadeInTime := 0;
- fVolume := FadeInTargetVolume;
- end
- else
- begin
- // fading in progress
- fVolume := FadeAmount*FadeInTargetVolume + (1-FadeAmount)*FadeInStartVolume;
- end;
- end;
- // return current volume
- Result := fVolume;
- UnlockSampleBuffer();
-end;
-
-procedure TGenericPlaybackStream.SetVolume(Volume: single);
-begin
- LockSampleBuffer();
- // stop fading
- FadeInTime := 0;
- // clamp volume
- if (Volume > 1.0) then
- fVolume := 1.0
- else if (Volume < 0) then
- fVolume := 0
- else
- fVolume := Volume;
- UnlockSampleBuffer();
-end;
-
-
-{ TGenericVoiceStream }
-
-constructor TGenericVoiceStream.Create(Engine: TAudioPlayback_SoftMixer);
-begin
- inherited Create();
- Self.Engine := Engine;
-end;
-
-function TGenericVoiceStream.Open(ChannelMap: integer; FormatInfo: TAudioFormatInfo): boolean;
-var
- BufferSize: integer;
-begin
- Result := false;
-
- Close();
-
- if (not inherited Open(ChannelMap, FormatInfo)) then
- Exit;
-
- // Note:
- // - use Self.FormatInfo instead of FormatInfo as the latter one might have a
- // channel size of 2.
- // - the buffer-size must be a multiple of the FrameSize
- BufferSize := (Ceil(MAX_VOICE_DELAY * Self.FormatInfo.BytesPerSec) div Self.FormatInfo.FrameSize) *
- Self.FormatInfo.FrameSize;
- VoiceBuffer := TRingBuffer.Create(BufferSize);
-
- BufferLock := SDL_CreateMutex();
-
-
- // create a matching playback stream for the voice-stream
- PlaybackStream := TGenericPlaybackStream.Create(Engine);
- // link voice- and playback-stream
- if (not PlaybackStream.Open(Self)) then
- begin
- PlaybackStream.Free;
- Exit;
- end;
-
- // start voice passthrough
- PlaybackStream.Play();
-
- Result := true;
-end;
-
-procedure TGenericVoiceStream.Close();
-begin
- // stop and free the playback stream
- FreeAndNil(PlaybackStream);
-
- // free data
- FreeAndNil(VoiceBuffer);
- if (BufferLock <> nil) then
- SDL_DestroyMutex(BufferLock);
-
- inherited Close();
-end;
-
-procedure TGenericVoiceStream.WriteData(Buffer: PChar; BufferSize: integer);
-begin
- // lock access to buffer
- SDL_mutexP(BufferLock);
- try
- if (VoiceBuffer = nil) then
- Exit;
- VoiceBuffer.Write(Buffer, BufferSize);
- finally
- SDL_mutexV(BufferLock);
- end;
-end;
-
-function TGenericVoiceStream.ReadData(Buffer: PChar; BufferSize: integer): integer;
-begin
- Result := -1;
-
- // lock access to buffer
- SDL_mutexP(BufferLock);
- try
- if (VoiceBuffer = nil) then
- Exit;
- Result := VoiceBuffer.Read(Buffer, BufferSize);
- finally
- SDL_mutexV(BufferLock);
- end;
-end;
-
-function TGenericVoiceStream.IsEOF(): boolean;
-begin
- SDL_mutexP(BufferLock);
- Result := (VoiceBuffer = nil);
- SDL_mutexV(BufferLock);
-end;
-
-function TGenericVoiceStream.IsError(): boolean;
-begin
- Result := false;
-end;
-
-
-{ TAudioPlayback_SoftMixer }
-
-function TAudioPlayback_SoftMixer.InitializePlayback: boolean;
-begin
- Result := false;
-
- //Log.LogStatus('InitializePlayback', 'UAudioPlayback_SoftMixer');
-
- if(not InitializeAudioPlaybackEngine()) then
- Exit;
-
- MixerStream := TAudioMixerStream.Create(Self);
-
- if(not StartAudioPlaybackEngine()) then
- Exit;
-
- Result := true;
-end;
-
-function TAudioPlayback_SoftMixer.FinalizePlayback: boolean;
-begin
- Close;
- StopAudioPlaybackEngine();
-
- FreeAndNil(MixerStream);
- FreeAndNil(FormatInfo);
-
- FinalizeAudioPlaybackEngine();
- inherited FinalizePlayback;
- Result := true;
-end;
-
-procedure TAudioPlayback_SoftMixer.AudioCallback(Buffer: PChar; Size: integer);
-begin
- MixerStream.ReadData(Buffer, Size);
-end;
-
-function TAudioPlayback_SoftMixer.GetMixer(): TAudioMixerStream;
-begin
- Result := MixerStream;
-end;
-
-function TAudioPlayback_SoftMixer.GetAudioFormatInfo(): TAudioFormatInfo;
-begin
- Result := FormatInfo;
-end;
-
-function TAudioPlayback_SoftMixer.CreatePlaybackStream(): TAudioPlaybackStream;
-begin
- Result := TGenericPlaybackStream.Create(Self);
-end;
-
-function TAudioPlayback_SoftMixer.CreateVoiceStream(ChannelMap: integer; FormatInfo: TAudioFormatInfo): TAudioVoiceStream;
-var
- VoiceStream: TGenericVoiceStream;
-begin
- Result := nil;
-
- // create a voice stream
- VoiceStream := TGenericVoiceStream.Create(Self);
- if (not VoiceStream.Open(ChannelMap, FormatInfo)) then
- begin
- VoiceStream.Free;
- Exit;
- end;
-
- Result := VoiceStream;
-end;
-
-procedure TAudioPlayback_SoftMixer.SetAppVolume(Volume: single);
-begin
- // sets volume only for this application
- MixerStream.Volume := Volume;
-end;
-
-procedure TAudioPlayback_SoftMixer.MixBuffers(DstBuffer, SrcBuffer: PChar; Size: Cardinal; Volume: Single);
-var
- SampleIndex: Cardinal;
- SampleInt: Integer;
- SampleFlt: Single;
-begin
- SampleIndex := 0;
- case FormatInfo.Format of
- asfS16:
- begin
- while (SampleIndex < Size) do
- begin
- // apply volume and sum with previous mixer value
- SampleInt := PSmallInt(@DstBuffer[SampleIndex])^ +
- Round(PSmallInt(@SrcBuffer[SampleIndex])^ * Volume);
- // clip result
- if (SampleInt > High(SmallInt)) then
- SampleInt := High(SmallInt)
- else if (SampleInt < Low(SmallInt)) then
- SampleInt := Low(SmallInt);
- // assign result
- PSmallInt(@DstBuffer[SampleIndex])^ := SampleInt;
- // increase index by one sample
- Inc(SampleIndex, SizeOf(SmallInt));
- end;
- end;
- asfFloat:
- begin
- while (SampleIndex < Size) do
- begin
- // apply volume and sum with previous mixer value
- SampleFlt := PSingle(@DstBuffer[SampleIndex])^ +
- PSingle(@SrcBuffer[SampleIndex])^ * Volume;
- // clip result
- if (SampleFlt > 1.0) then
- SampleFlt := 1.0
- else if (SampleFlt < -1.0) then
- SampleFlt := -1.0;
- // assign result
- PSingle(@DstBuffer[SampleIndex])^ := SampleFlt;
- // increase index by one sample
- Inc(SampleIndex, SizeOf(Single));
- end;
- end;
- else
- begin
- Log.LogError('Incompatible format', 'TAudioMixerStream.MixAudio');
- end;
- end;
-end;
-
-end.
diff --git a/src/classes/UCatCovers.pas b/src/classes/UCatCovers.pas
deleted file mode 100644
index d8f6cdb0..00000000
--- a/src/classes/UCatCovers.pas
+++ /dev/null
@@ -1,173 +0,0 @@
-unit UCatCovers;
-/////////////////////////////////////////////////////////////////////////
-// UCatCovers by Whiteshark //
-// Class for listing and managing the Category Covers //
-/////////////////////////////////////////////////////////////////////////
-
-interface
-
-{$I switches.inc}
-
-uses UIni;
-
-type
- TCatCovers = class
- protected
- cNames: array [0..high(ISorting)] of array of string;
- cFiles: array [0..high(ISorting)] of array of string;
- public
- constructor Create;
- procedure Load; //Load Cover aus Cover.ini and Cover Folder
- procedure LoadPath(const CoversPath: string);
- procedure Add(Sorting: integer; Name, Filename: string); //Add a Cover
- function CoverExists(Sorting: integer; Name: string): boolean; //Returns True when a cover with the given Name exists
- function GetCover(Sorting: integer; Name: string): string; //Returns the Filename of a Cover
- end;
-
-var
- CatCovers: TCatCovers;
-
-implementation
-
-uses
- IniFiles,
- SysUtils,
- Classes,
- // UFiles,
- UMain,
- ULog;
-
-constructor TCatCovers.Create;
-begin
- inherited;
- Load;
-end;
-
-procedure TCatCovers.Load;
-var
- I: integer;
-begin
- for I := 0 to CoverPaths.Count-1 do
- LoadPath(CoverPaths[I]);
-end;
-
-(**
- * Load Cover from Cover.ini and Cover Folder
- *)
-procedure TCatCovers.LoadPath(const CoversPath: string);
-var
- Ini: TMemIniFile;
- SR: TSearchRec;
- List: TStringlist;
- I, J: Integer;
- Name, Filename, Temp: string;
-begin
- Ini := nil;
- List := nil;
-
- try
- Ini := TMemIniFile.Create(CoversPath + 'covers.ini');
- List := TStringlist.Create;
-
- //Add every Cover in Covers Ini for Every Sorting option
- for I := 0 to High(ISorting) do
- begin
- Ini.ReadSection(ISorting[I], List);
-
- for J := 0 to List.Count - 1 do
- Add(I, List.Strings[J], CoversPath + Ini.ReadString(ISorting[I], List.Strings[J], 'NoCover.jpg'));
- end;
- finally
- Ini.Free;
- List.Free;
- end;
-
- try
- //Add Covers from Folder
- if (FindFirst (CoversPath + '*.jpg', faAnyFile, SR) = 0) then
- repeat
- //Add Cover if it doesn't exist for every Section
- Name := SR.Name;
- Filename := CoversPath + Name;
- Delete (Name, length(Name) - 3, 4);
-
- for I := 0 to high(ISorting) do
- begin
- Temp := Name;
- if ((I = sTitle) or (I = sTitle2)) and (Pos ('Title', Temp) <> 0) then
- Delete (Temp, Pos ('Title', Temp), 5)
- else if (I = sArtist) or (I = sArtist2) and (Pos ('Artist', Temp) <> 0) then
- Delete (Temp, Pos ('Artist', Temp), 6);
-
- if not CoverExists(I, Temp) then
- Add (I, Temp, Filename);
- end;
- until FindNext (SR) <> 0;
- finally
- FindClose (SR);
- end;
-end;
-
- //Add a Cover
-procedure TCatCovers.Add(Sorting: integer; Name, Filename: string);
-begin
- if FileExists (Filename) then //If Exists -> Add
- begin
- SetLength (CNames[Sorting], Length(CNames[Sorting]) + 1);
- SetLength (CFiles[Sorting], Length(CNames[Sorting]) + 1);
-
- CNames[Sorting][high(cNames[Sorting])] := Uppercase(Name);
- CFiles[Sorting][high(cNames[Sorting])] := FileName;
- end;
-end;
-
- //Returns True when a cover with the given Name exists
-function TCatCovers.CoverExists(Sorting: integer; Name: string): boolean;
-var
- I: Integer;
-begin
- Result := False;
- Name := Uppercase(Name); //Case Insensitiv
-
- for I := 0 to high(cNames[Sorting]) do
- begin
- if (cNames[Sorting][I] = Name) then //Found Name
- begin
- Result := true;
- break; //Break For Loop
- end;
- end;
-end;
-
- //Returns the Filename of a Cover
-function TCatCovers.GetCover(Sorting: integer; Name: string): string;
-var
- I: Integer;
-begin
- Result := '';
- Name := Uppercase(Name);
-
- for I := 0 to high(cNames[Sorting]) do
- begin
- if cNames[Sorting][I] = Name then
- begin
- Result := cFiles[Sorting][I];
- Break;
- end;
- end;
-
- //No Cover
- if (Result = '') then
- begin
- for I := 0 to CoverPaths.Count-1 do
- begin
- if (FileExists(CoverPaths[I] + 'NoCover.jpg')) then
- begin
- Result := CoverPaths[I] + 'NoCover.jpg';
- Break;
- end;
- end;
- end;
-end;
-
-end.
diff --git a/src/classes/UCommandLine.pas b/src/classes/UCommandLine.pas
deleted file mode 100644
index 8bdc4f5a..00000000
--- a/src/classes/UCommandLine.pas
+++ /dev/null
@@ -1,334 +0,0 @@
-unit UCommandLine;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-
-type
- //-----------
- // TCMDParams - Class Reads Infos from ParamStr and set some easy Interface Variables
- //-----------
- TCMDParams = class
- private
- sLanguage: String;
- sResolution: String;
- public
- //Some Boolean Variables Set when Reading Infos
- Debug: Boolean;
- Benchmark: Boolean;
- NoLog: Boolean;
- FullScreen: Boolean;
- Joypad: Boolean;
-
- //Some Value Variables Set when Reading Infos {-1: Not Set, others: Value}
- Depth: Integer;
- Screens: Integer;
-
- //Some Strings Set when Reading Infos {Length=0 Not Set}
- SongPath: String;
- ConfigFile: String;
- ScoreFile: String;
-
- procedure showhelp();
-
- //Pseudo Integer Values
- Function GetLanguage: Integer;
- Property Language: Integer read GetLanguage;
-
- Function GetResolution: Integer;
- Property Resolution: Integer read GetResolution;
-
- //Some Procedures for Reading Infos
- Constructor Create;
-
- Procedure ResetVariables;
- Procedure ReadParamInfo;
- end;
-
-var
- Params: TCMDParams;
-
-const
- cHelp = 'help';
- cDebug = 'debug';
- cMediaInterfaces = 'showinterfaces';
-
-
-implementation
-
-uses SysUtils,
- uPlatform;
-// uINI -- Nasty requirement... ( removed with permission of blindy )
-
-
-//-------------
-// Constructor - Create class, Reset Variables and Read Infos
-//-------------
-Constructor TCMDParams.Create;
-begin
- inherited;
-
- if FindCmdLineSwitch( cHelp ) or FindCmdLineSwitch( 'h' ) then
- showhelp();
-
- ResetVariables;
- ReadParamInfo;
-end;
-
-procedure TCMDParams.showhelp();
-
- function s( aString : String ) : string;
- begin
- result := aString + StringofChar( ' ', 15 - length( aString ) );
- end;
-
-begin
-
- writeln( '' );
- writeln( '**************************************************************' );
- writeln( ' UltraStar Deluxe - Command line switches ' );
- writeln( '**************************************************************' );
- writeln( '' );
- writeln( ' '+s( 'Switch' ) +' : Purpose' );
- writeln( ' ----------------------------------------------------------' );
- writeln( ' '+s( cMediaInterfaces ) + #9 + ' : Show in-use media interfaces' );
- writeln( ' '+s( cDebug ) + #9 + ' : Display Debugging info' );
- writeln( '' );
-
- platform.halt;
-end;
-
-//-------------
-// ResetVariables - Reset Class Variables
-//-------------
-Procedure TCMDParams.ResetVariables;
-begin
- Debug := False;
- Benchmark := False;
- NoLog := False;
- FullScreen := False;
- Joypad := False;
-
- //Some Value Variables Set when Reading Infos {-1: Not Set, others: Value}
- sResolution := '';
- sLanguage := '';
- Depth := -1;
- Screens := -1;
-
- //Some Strings Set when Reading Infos {Length=0 Not Set}
- SongPath := '';
- ConfigFile := '';
- ScoreFile := '';
-end;
-
-//-------------
-// ReadParamInfo - Read Infos from Parameters
-//-------------
-Procedure TCMDParams.ReadParamInfo;
-var
- I: Integer;
- PCount: Integer;
- Command: String;
-begin
- PCount := ParamCount;
- //Log.LogError('ParamCount: ' + Inttostr(PCount));
-
-
- //Check all Parameters
- For I := 1 to PCount do
- begin
- Command := Paramstr(I);
- //Log.LogError('Start parsing Command: ' + Command);
- //Is String Parameter ?
- if (Length(Command) > 1) AND (Command[1] = '-') then
- begin
- //Remove - from Command
- Command := Lowercase(Trim(Copy(Command, 2, Length(Command) - 1)));
- //Log.LogError('Command prepared: ' + Command);
-
- //Check Command
-
- // Boolean Triggers:
- if (Command = 'debug') then
- Debug := True
- else if (Command = 'benchmark') then
- Benchmark := True
- else if (Command = 'nolog') then
- NoLog := True
- else if (Command = 'fullscreen') then
- Fullscreen := True
- else if (Command = 'window') then
- Fullscreen := False
- else if (Command = 'joypad') then
- Joypad := True
-
- //Integer Variables
- else if (Command = 'depth') then
- begin
- //Check if there is another Parameter to get the Value from
- if (PCount > I) then
- begin
- Command := ParamStr(I + 1);
-
- //Check for valid Value
- If (Command = '16') then
- Depth := 0
- Else If (Command = '32') then
- Depth := 1;
- end;
- end
-
- else if (Command = 'screens') then
- begin
- //Check if there is another Parameter to get the Value from
- if (PCount > I) then
- begin
- Command := ParamStr(I + 1);
-
- //Check for valid Value
- If (Command = '1') then
- Screens := 0
- Else If (Command = '2') then
- Screens := 1;
- end;
- end
-
- //Pseudo Integer Values
- else if (Command = 'language') then
- begin
- //Check if there is another Parameter to get the Value from
- if (PCount > I) then
- begin
- //Write Value to String
- sLanguage := Lowercase(ParamStr(I + 1));
- end;
- end
-
- else if (Command = 'resolution') then
- begin
- //Check if there is another Parameter to get the Value from
- if (PCount > I) then
- begin
- //Write Value to String
- sResolution := Lowercase(ParamStr(I + 1));
- end;
- end
-
- //String Values
- else if (Command = 'songpath') then
- begin
- //Check if there is another Parameter to get the Value from
- if (PCount > I) then
- begin
- //Write Value to String
- SongPath := ParamStr(I + 1);
- end;
- end
-
- else if (Command = 'configfile') then
- begin
- //Check if there is another Parameter to get the Value from
- if (PCount > I) then
- begin
- //Write Value to String
- ConfigFile := ParamStr(I + 1);
-
- //is this a relative PAth -> then add Gamepath
- if Not ((Length(ConfigFile) > 2) AND (ConfigFile[2] = ':')) then
- ConfigFile := ExtractFilePath(ParamStr(0)) + Configfile;
- end;
- end
-
- else if (Command = 'scorefile') then
- begin
- //Check if there is another Parameter to get the Value from
- if (PCount > I) then
- begin
- //Write Value to String
- ScoreFile := ParamStr(I + 1);
- end;
- end;
-
- end;
-
- end;
-
-{ Log.LogError('Values: ');
-
- if Debug then
- Log.LogError('Debug');
-
- if Benchmark then
- Log.LogError('Benchmark');
-
- if NoLog then
- Log.LogError('NoLog');
-
- if Fullscreen then
- Log.LogError('FullScreen');
-
- if JoyStick then
- Log.LogError('Joystick');
-
-
- Log.LogError('Screens: ' + Inttostr(Screens));
- Log.LogError('Depth: ' + Inttostr(Depth));
-
- Log.LogError('Resolution: ' + Inttostr(Resolution));
- Log.LogError('Resolution: ' + Inttostr(Language));
-
- Log.LogError('sResolution: ' + sResolution);
- Log.LogError('sLanguage: ' + sLanguage);
-
- Log.LogError('ConfigFile: ' + ConfigFile);
- Log.LogError('SongPath: ' + SongPath);
- Log.LogError('ScoreFile: ' + ScoreFile); }
-
-end;
-
-//-------------
-// GetLanguage - Get Language ID from saved String Information
-//-------------
-Function TCMDParams.GetLanguage: Integer;
-var
- I: integer;
-begin
- Result := -1;
-{* JB - 12sep07 to remove uINI dependency
-
- //Search for Language
- For I := 0 to high(ILanguage) do
- if (LowerCase(ILanguage[I]) = sLanguage) then
- begin
- Result := I;
- Break;
- end;
-*}
-end;
-
-//-------------
-// GetResolution - Get Resolution ID from saved String Information
-//-------------
-Function TCMDParams.GetResolution: Integer;
-var
- I: integer;
-begin
- Result := -1;
-{* JB - 12sep07 to remove uINI dependency
-
- //Search for Resolution
- For I := 0 to high(IResolution) do
- if (LowerCase(IResolution[I]) = sResolution) then
- begin
- Result := I;
- Break;
- end;
-*}
-end;
-
-end.
diff --git a/src/classes/UCommon.pas b/src/classes/UCommon.pas
deleted file mode 100644
index 41e3c1f1..00000000
--- a/src/classes/UCommon.pas
+++ /dev/null
@@ -1,774 +0,0 @@
-unit UCommon;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses
- SysUtils,
- Classes,
- {$IFDEF MSWINDOWS}
- Windows,
- {$ENDIF}
- sdl,
- UConfig,
- ULog;
-
-type
- TMessageType = ( mtInfo, mtError );
-
-procedure ShowMessage( const msg : String; msgType: TMessageType = mtInfo );
-
-procedure ConsoleWriteLn(const msg: string);
-
-function GetResourceStream(const aName, aType : string): TStream;
-function RWopsFromStream(Stream: TStream): PSDL_RWops;
-
-{$IFDEF FPC}
-function RandomRange(aMin: Integer; aMax: Integer) : Integer;
-{$ENDIF}
-
-function StringReplaceW(text : WideString; search, rep: WideChar):WideString;
-function AdaptFilePaths( const aPath : widestring ): widestring;
-
-procedure DisableFloatingPointExceptions();
-procedure SetDefaultNumericLocale();
-procedure RestoreNumericLocale();
-
-{$IFNDEF MSWINDOWS}
- procedure ZeroMemory( Destination: Pointer; Length: DWORD );
- function MakeLong(a, b: Word): Longint;
- (*
- #define LOBYTE(a) (BYTE)(a)
- #define HIBYTE(a) (BYTE)((a)>>8)
- #define LOWORD(a) (WORD)(a)
- #define HIWORD(a) (WORD)((a)>>16)
- #define MAKEWORD(a,b) (WORD)(((a)&0xff)|((b)<<8))
- *)
-{$ENDIF}
-
-function FileExistsInsensitive(var FileName: string): boolean;
-
-(*
- * Character classes
- *)
-
-function IsAlphaChar(ch: WideChar): boolean;
-function IsNumericChar(ch: WideChar): boolean;
-function IsAlphaNumericChar(ch: WideChar): boolean;
-function IsPunctuationChar(ch: WideChar): boolean;
-function IsControlChar(ch: WideChar): boolean;
-
-// A stable alternative to TList.Sort() (use TList.Sort() if applicable, see below)
-procedure MergeSort(List: TList; CompareFunc: TListSortCompare);
-
-function GetAlignedMem(Size: cardinal; Alignment: integer): Pointer;
-procedure FreeAlignedMem(P: Pointer);
-
-
-implementation
-
-uses
- Math,
- {$IFDEF Delphi}
- Dialogs,
- {$ENDIF}
- UMain;
-
-
-// data used by the ...Locale() functions
-{$IFDEF LINUX}
-
-var
- PrevNumLocale: string;
-
-const
- LC_NUMERIC = 1;
-
-function setlocale(category: integer; locale: pchar): pchar; cdecl; external 'c' name 'setlocale';
-
-{$ENDIF}
-
-// In Linux and maybe MacOSX some units (like cwstring) call setlocale(LC_ALL, '')
-// to set the language/country specific locale (e.g. charset) for this application.
-// Unfortunately, LC_NUMERIC is set by this call too.
-// It defines the decimal-separator and other country-specific numeric settings.
-// This parameter is used by the C string-to-float parsing functions atof() and strtod().
-// After changing LC_NUMERIC some external C-based libs (like projectM) are not
-// able to parse strings correctly
-// (e.g. in Germany "0.9" is not recognized as a valid number anymore but "0,9" is).
-// So we reset the numeric settings to the default ('C').
-// Note: The behaviour of Pascal parsing functions (e.g. strtofloat()) is not
-// changed by this because it doesn't use the locale-settings.
-// TODO:
-// - Check if this is needed in MacOSX (at least the locale is set in cwstring)
-// - Find out which libs are concerned by this problem.
-// If only projectM is concerned by this problem set and restore the numeric locale
-// for each call to projectM instead of changing it globally.
-procedure SetDefaultNumericLocale();
-begin
- {$ifdef LINUX}
- PrevNumLocale := setlocale(LC_NUMERIC, nil);
- setlocale(LC_NUMERIC, 'C');
- {$endif}
-end;
-
-procedure RestoreNumericLocale();
-begin
- {$ifdef LINUX}
- setlocale(LC_NUMERIC, PChar(PrevNumLocale));
- {$endif}
-end;
-
-(*
- * If an invalid floating point operation was performed the Floating-point unit (FPU)
- * generates a Floating-point exception (FPE). Dependending on the settings in
- * the FPU's control-register (interrupt mask) the FPE is handled by the FPU itself
- * (we will call this as "FPE disabled" later on) or is passed to the application
- * (FPE enabled).
- * If FPEs are enabled a floating-point division by zero (e.g. 10.0 / 0.0) is
- * considered an error and an exception is thrown. Otherwise the FPU will handle
- * the error and return the result infinity (INF) (10.0 / 0.0 = INF) without
- * throwing an error to the application.
- * The same applies to a division by INF that either raises an exception
- * (FPE enabled) or returns 0.0 (FPE disabled).
- * Normally (as with C-programs), Floating-point exceptions (FPE) are DISABLED
- * on program startup (at least with Intel CPUs), but for some strange reasons
- * they are ENABLED in pascal (both delphi and FPC) by default.
- * Many libs operating with floating-point values rely heavily on the C-specific
- * behaviour. So using them in delphi is a ticking time-bomb because sooner or
- * later they will crash because of an FPE (this problem occurs massively
- * in OpenGL-based libs like projectM). In contrast to this no error will occur
- * if the lib is linked to a C-program.
- *
- * Further info on FPUs:
- * For x86 and x86_64 CPUs we have to consider two FPU instruction sets.
- * The math co-processor i387 (aka 8087 or x87) set introduced with the i386
- * and SSE (Streaming SIMD Extensions) introduced with the Pentium3.
- * Both of them have separate control-registers (x87: FPUControlWord, SSE: MXCSR)
- * to control FPEs. Either has (among others) 6bits to enable/disable several
- * exception types (Invalid,Denormalized,Zero,Overflow,Underflow,Precision).
- * Those exception-types must all be masked (=1) to get the default C behaviour.
- * The control-registers can be set with the asm-ops FLDCW (x87) and LDMXCSR (SSE).
- * Instead of using assembler code, we can use Set8087CW() provided by delphi and
- * FPC to set the x87 control-word. FPC also provides SetSSECSR() for SSE's MXCSR.
- * Note that both Delphi and FPC enable FPEs (e.g. for div-by-zero) on program
- * startup but only FPC enables FPEs (especially div-by-zero) for SSE too.
- * So we have to mask FPEs for x87 in Delphi and FPC and for SSE in FPC only.
- * FPC and Delphi both provide a SetExceptionMask() for control of the FPE
- * mask. SetExceptionMask() sets the masks for x87 in Delphi and for x87 and SSE
- * in FPC (seems as if Delphi [2005] is not SSE aware). So SetExceptionMask()
- * is what we need and it even is plattform and CPU independent.
- *
- * Pascal OpenGL headers (like the Delphi standard ones or JEDI-SDL headers)
- * already call Set8087CW() to disable FPEs but due to some bugs in the JEDI-SDL
- * headers they do not work properly with FPC. I already patched them, so they
- * work at least until they are updated the next time. In addition Set8086CW()
- * does not suffice to disable FPEs because the SSE FPEs are not disabled by this.
- * FPEs with SSE are a big problem with some libs because many linux distributions
- * optimize code for SSE or Pentium3 (for example: int(INF) which convert the
- * double value "infinity" to an integer might be automatically optimized by
- * using SSE's CVTSD2SI instruction). So SSE FPEs must be turned off in any case
- * to make USDX portable.
- *
- * Summary:
- * Call this function on initialization to make sure FPEs are turned off.
- * It will solve a lot of errors with FPEs in external libs.
- *)
-procedure DisableFloatingPointExceptions();
-begin
- (*
- // We will use SetExceptionMask() instead of Set8087CW()/SetSSECSR().
- // Note: Leave these lines for documentation purposes just in case
- // SetExceptionMask() does not work anymore (due to bugs in FPC etc.).
- {$IF Defined(CPU386) or Defined(CPUI386) or Defined(CPUX86_64)}
- Set8087CW($133F);
- {$IFEND}
- {$IF Defined(FPC)}
- if (has_sse_support) then
- SetSSECSR($1F80);
- {$IFEND}
- *)
-
- // disable all of the six FPEs (x87 and SSE) to be compatible with C/C++ and
- // other libs which rely on the standard FPU behaviour (no div-by-zero FPE anymore).
- SetExceptionMask([exInvalidOp, exDenormalized, exZeroDivide,
- exOverflow, exUnderflow, exPrecision]);
-end;
-
-function StringReplaceW(text : WideString; search, rep: WideChar) : WideString;
-var
- iPos : integer;
-// sTemp : WideString;
-begin
-(*
- result := text;
- iPos := Pos(search, result);
- while (iPos > 0) do
- begin
- sTemp := copy(result, iPos + length(search), length(result));
- result := copy(result, 1, iPos - 1) + rep + sTEmp;
- iPos := Pos(search, result);
- end;
-*)
- result := text;
-
- if search = rep then
- exit;
-
- for iPos := 1 to length(result) do
- begin
- if result[iPos] = search then
- result[iPos] := rep;
- end;
-end;
-
-function AdaptFilePaths( const aPath : widestring ): widestring;
-begin
- result := StringReplaceW( aPath, '\', PathDelim );//, [rfReplaceAll] );
-end;
-
-
-{$IFNDEF MSWINDOWS}
-procedure ZeroMemory( Destination: Pointer; Length: DWORD );
-begin
- FillChar( Destination^, Length, 0 );
-end;
-
-function MakeLong(A, B: Word): Longint;
-begin
- Result := (LongInt(B) shl 16) + A;
-end;
-
-(*
-function QueryPerformanceCounter(lpPerformanceCount:TLARGEINTEGER):Bool;
-
- // From http://en.wikipedia.org/wiki/RDTSC
- function RDTSC: Int64; register;
- asm
- rdtsc
- end;
-
-begin
- // Use clock_gettime(CLOCK_REALTIME, ...) here (but not from the libc unit)
- lpPerformanceCount := RDTSC();
- result := true;
-end;
-
-function QueryPerformanceFrequency(lpFrequency:TLARGEINTEGER):Bool;
-begin
- // clock_getres(CLOCK_REALTIME, ...)
- lpFrequency := 0;
- result := true;
-end;
-*)
-{$ENDIF}
-
-// Checks if a regular files or directory with the given name exists.
-// The comparison is case insensitive.
-function FileExistsInsensitive(var FileName: string): boolean;
-var
- FilePath, LocalFileName: string;
- SearchInfo: TSearchRec;
-begin
-{$IFDEF LINUX} // eddie: Changed FPC to LINUX: Windows and Mac OS X dont have case sensitive file systems
- // speed up standard case
- if FileExists(FileName) then
- begin
- Result := true;
- exit;
- end;
-
- Result := false;
-
- FilePath := ExtractFilePath(FileName);
- if (FindFirst(FilePath+'*', faAnyFile, SearchInfo) = 0) then
- begin
- LocalFileName := ExtractFileName(FileName);
- repeat
- if (AnsiSameText(LocalFileName, SearchInfo.Name)) then
- begin
- FileName := FilePath + SearchInfo.Name;
- Result := true;
- break;
- end;
- until (FindNext(SearchInfo) <> 0);
- end;
- FindClose(SearchInfo);
-{$ELSE}
- Result := FileExists(FileName);
-{$ENDIF}
-end;
-
-
-{$IFDEF Unix}
- // include resource-file info (stored in the constant array "resources")
- {$I ../resource.inc}
-{$ENDIF}
-
-function GetResourceStream(const aName, aType: string): TStream;
-{$IFDEF Unix}
-var
- ResIndex: integer;
- Filename: string;
-{$ENDIF}
-begin
- Result := nil;
-
- {$IFDEF Unix}
- for ResIndex := 0 to High(resources) do
- begin
- if (resources[ResIndex][0] = aName ) and
- (resources[ResIndex][1] = aType ) then
- begin
- try
- Filename := ResourcesPath + resources[ResIndex][2];
- Result := TFileStream.Create(Filename, fmOpenRead);
- except
- Log.LogError('Failed to open: "'+ resources[ResIndex][2] +'"', 'GetResourceStream');
- end;
- exit;
- end;
- end;
- {$ELSE}
- try
- Result := TResourceStream.Create(HInstance, aName , PChar(aType));
- except
- Log.LogError('Invalid resource: "'+ aType + ':' + aName +'"', 'GetResourceStream');
- end;
- {$ENDIF}
-end;
-
-// +++++++++++++++++++++ helpers for RWOpsFromStream() +++++++++++++++
- function SdlStreamSeek( context : PSDL_RWops; offset : Integer; whence : Integer ) : integer; cdecl;
- var
- stream : TStream;
- origin : Word;
- begin
- stream := TStream( context.unknown );
- if ( stream = nil ) then
- raise EInvalidContainer.Create( 'SDLStreamSeek on nil' );
- case whence of
- 0 : origin := soFromBeginning; // Offset is from the beginning of the resource. Seek moves to the position Offset. Offset must be >= 0.
- 1 : origin := soFromCurrent; // Offset is from the current position in the resource. Seek moves to Position + Offset.
- 2 : origin := soFromEnd;
- else
- origin := soFromBeginning; // just in case
- end;
- Result := stream.Seek( offset, origin );
- end;
-
- function SdlStreamRead( context : PSDL_RWops; Ptr : Pointer; size : Integer; maxnum: Integer ) : Integer; cdecl;
- var
- stream : TStream;
- begin
- stream := TStream( context.unknown );
- if ( stream = nil ) then
- raise EInvalidContainer.Create( 'SDLStreamRead on nil' );
- try
- Result := stream.read( Ptr^, Size * maxnum ) div size;
- except
- Result := -1;
- end;
- end;
-
- function SDLStreamClose( context : PSDL_RWops ) : Integer; cdecl;
- var
- stream : TStream;
- begin
- stream := TStream( context.unknown );
- if ( stream = nil ) then
- raise EInvalidContainer.Create( 'SDLStreamClose on nil' );
- stream.Free;
- Result := 1;
- end;
-// -----------------------------------------------
-
-(*
- * Creates an SDL_RWops handle from a TStream.
- * The stream and RWops must be freed by the user after usage.
- * Use SDL_FreeRW(...) to free the RWops data-struct.
- *)
-function RWopsFromStream(Stream: TStream): PSDL_RWops;
-begin
- Result := SDL_AllocRW();
- if (Result = nil) then
- Exit;
-
- // set RW-callbacks
- with Result^ do
- begin
- unknown := TUnknown(Stream);
- seek := SDLStreamSeek;
- read := SDLStreamRead;
- write := nil;
- close := SDLStreamClose;
- type_ := 2;
- end;
-end;
-
-
-
-{$IFDEF FPC}
-function RandomRange(aMin: Integer; aMax: Integer) : Integer;
-begin
- RandomRange := Random(aMax-aMin) + aMin ;
-end;
-{$ENDIF}
-
-
-{$IFDEF FPC}
-var
- MessageList: TStringList;
- ConsoleHandler: TThreadID;
- // Note: TRTLCriticalSection is defined in the units System and Libc, use System one
- ConsoleCriticalSection: System.TRTLCriticalSection;
- ConsoleEvent: PRTLEvent;
- ConsoleQuit: boolean;
-{$ENDIF}
-
-(*
- * Write to console if one is available.
- * It checks if a console is available before output so it will not
- * crash on windows if none is available.
- * Do not use this function directly because it is not thread-safe,
- * use ConsoleWriteLn() instead.
- *)
-procedure _ConsoleWriteLn(const aString: string); {$IFDEF HasInline}inline;{$ENDIF}
-begin
- {$IFDEF MSWINDOWS}
- // sanity check to avoid crashes with writeln()
- if (IsConsole) then
- begin
- {$ENDIF}
- Writeln(aString);
- {$IFDEF MSWINDOWS}
- end;
- {$ENDIF}
-end;
-
-{$IFDEF FPC}
-{*
- * The console-handlers main-function.
- * TODO: create a quit-event on closing.
- *}
-function ConsoleHandlerFunc(param: pointer): PtrInt;
-var
- i: integer;
- quit: boolean;
-begin
- quit := false;
- while (not quit) do
- begin
- // wait for new output or quit-request
- RTLeventWaitFor(ConsoleEvent);
-
- System.EnterCriticalSection(ConsoleCriticalSection);
- // output pending messages
- for i := 0 to MessageList.Count-1 do
- begin
- _ConsoleWriteLn(MessageList[i]);
- end;
- MessageList.Clear();
-
- // use local quit-variable to avoid accessing
- // ConsoleQuit outside of the critical section
- if (ConsoleQuit) then
- quit := true;
-
- RTLeventResetEvent(ConsoleEvent);
- System.LeaveCriticalSection(ConsoleCriticalSection);
- end;
- result := 0;
-end;
-{$ENDIF}
-
-procedure InitConsoleOutput();
-begin
- {$IFDEF FPC}
- // init thread-safe output
- MessageList := TStringList.Create();
- System.InitCriticalSection(ConsoleCriticalSection);
- ConsoleEvent := RTLEventCreate();
- ConsoleQuit := false;
- // must be a thread managed by FPC. Otherwise (e.g. SDL-thread)
- // it will crash when using Writeln.
- ConsoleHandler := BeginThread(@ConsoleHandlerFunc);
- {$ENDIF}
-end;
-
-procedure FinalizeConsoleOutput();
-begin
- {$IFDEF FPC}
- // terminate console-handler
- System.EnterCriticalSection(ConsoleCriticalSection);
- ConsoleQuit := true;
- RTLeventSetEvent(ConsoleEvent);
- System.LeaveCriticalSection(ConsoleCriticalSection);
- WaitForThreadTerminate(ConsoleHandler, 0);
- // free data
- System.DoneCriticalsection(ConsoleCriticalSection);
- RTLeventDestroy(ConsoleEvent);
- MessageList.Free();
- {$ENDIF}
-end;
-
-{*
- * With FPC console output is not thread-safe.
- * Using WriteLn() from external threads (like in SDL callbacks)
- * will damage the heap and crash the program.
- * Most probably FPC uses thread-local-data (TLS) to lock a mutex on
- * the console-buffer. This does not work with external lib's threads
- * because these do not have the TLS data and so it crashes while
- * accessing unallocated memory.
- * The solution is to create an FPC-managed thread which has the TLS data
- * and use it to handle the console-output (hence it is called Console-Handler)
- * It should be safe to do so, but maybe FPC requires the main-thread to access
- * the console-buffer only. In this case output should be delegated to it.
- *
- * TODO: - check if it is safe if an FPC-managed thread different than the
- * main-thread accesses the console-buffer in FPC.
- * - check if Delphi's WriteLn is thread-safe.
- * - check if we need to synchronize file-output too
- *}
-procedure ConsoleWriteLn(const msg: string);
-begin
-{$IFDEF CONSOLE}
- {$IFDEF FPC}
- // TODO: check for the main-thread and use a simple _ConsoleWriteLn() then?
- //GetCurrentThreadThreadId();
- System.EnterCriticalSection(ConsoleCriticalSection);
- MessageList.Add(msg);
- RTLeventSetEvent(ConsoleEvent);
- System.LeaveCriticalSection(ConsoleCriticalSection);
- {$ELSE}
- _ConsoleWriteLn(msg);
- {$ENDIF}
-{$ENDIF}
-end;
-
-procedure ShowMessage(const msg: String; msgType: TMessageType);
-{$IFDEF MSWINDOWS}
-var Flags: Cardinal;
-{$ENDIF}
-begin
-{$IF Defined(MSWINDOWS)}
- case msgType of
- mtInfo: Flags := MB_ICONINFORMATION or MB_OK;
- mtError: Flags := MB_ICONERROR or MB_OK;
- else Flags := MB_OK;
- end;
- MessageBox(0, PChar(msg), PChar(USDXVersionStr()), Flags);
-{$ELSE}
- ConsoleWriteln(msg);
-{$IFEND}
-end;
-
-function IsAlphaChar(ch: WideChar): boolean;
-begin
- // TODO: add chars > 255 when unicode-fonts work?
- case ch of
- 'A'..'Z', // A-Z
- 'a'..'z', // a-z
- #170,#181,#186,
- #192..#214,
- #216..#246,
- #248..#255:
- Result := true;
- else
- Result := false;
- end;
-end;
-
-function IsNumericChar(ch: WideChar): boolean;
-begin
- case ch of
- '0'..'9':
- Result := true;
- else
- Result := false;
- end;
-end;
-
-function IsAlphaNumericChar(ch: WideChar): boolean;
-begin
- Result := (IsAlphaChar(ch) or IsNumericChar(ch));
-end;
-
-function IsPunctuationChar(ch: WideChar): boolean;
-begin
- // TODO: add chars outside of Latin1 basic (0..127)?
- case ch of
- ' '..'/',':'..'@','['..'`','{'..'~':
- Result := true;
- else
- Result := false;
- end;
-end;
-
-function IsControlChar(ch: WideChar): boolean;
-begin
- case ch of
- #0..#31,
- #127..#159:
- Result := true;
- else
- Result := false;
- end;
-end;
-
-(*
- * Recursive part of the MergeSort algorithm.
- * OutList will be either InList or TempList and will be swapped in each
- * depth-level of recursion. By doing this it we can directly merge into the
- * output-list. If we only had In- and OutList parameters we had to merge into
- * InList after the recursive calls and copy the data to the OutList afterwards.
- *)
-procedure _MergeSort(InList, TempList, OutList: TList; StartPos, BlockSize: integer;
- CompareFunc: TListSortCompare);
-var
- LeftSize, RightSize: integer; // number of elements in left/right block
- LeftEnd, RightEnd: integer; // Index after last element in left/right block
- MidPos: integer; // index of first element in right block
- Pos: integer; // position in output list
-begin
- LeftSize := BlockSize div 2;
- RightSize := BlockSize - LeftSize;
- MidPos := StartPos + LeftSize;
-
- // sort left and right halves of this block by recursive calls of this function
- if (LeftSize >= 2) then
- _MergeSort(InList, OutList, TempList, StartPos, LeftSize, CompareFunc)
- else
- TempList[StartPos] := InList[StartPos];
- if (RightSize >= 2) then
- _MergeSort(InList, OutList, TempList, MidPos, RightSize, CompareFunc)
- else
- TempList[MidPos] := InList[MidPos];
-
- // merge sorted left and right sub-lists into output-list
- LeftEnd := MidPos;
- RightEnd := StartPos + BlockSize;
- Pos := StartPos;
- while ((StartPos < LeftEnd) and (MidPos < RightEnd)) do
- begin
- if (CompareFunc(TempList[StartPos], TempList[MidPos]) <= 0) then
- begin
- OutList[Pos] := TempList[StartPos];
- Inc(StartPos);
- end
- else
- begin
- OutList[Pos] := TempList[MidPos];
- Inc(MidPos);
- end;
- Inc(Pos);
- end;
-
- // copy remaining elements to output-list
- while (StartPos < LeftEnd) do
- begin
- OutList[Pos] := TempList[StartPos];
- Inc(StartPos);
- Inc(Pos);
- end;
- while (MidPos < RightEnd) do
- begin
- OutList[Pos] := TempList[MidPos];
- Inc(MidPos);
- Inc(Pos);
- end;
-end;
-
-(*
- * Stable alternative to the instable TList.Sort() (uses QuickSort) implementation.
- * A stable sorting algorithm preserves preordered items. E.g. if sorting by
- * songs by title first and artist afterwards, the songs of each artist will
- * be ordered by title. In contrast to this an unstable algorithm (like QuickSort)
- * may destroy an existing order, so the songs of an artist will not be ordered
- * by title anymore after sorting by artist in the previous example.
- * If you do not need a stable algorithm, use TList.Sort() instead.
- *)
-procedure MergeSort(List: TList; CompareFunc: TListSortCompare);
-var
- TempList: TList;
-begin
- TempList := TList.Create();
- TempList.Count := List.Count;
- if (List.Count >= 2) then
- _MergeSort(List, TempList, List, 0, List.Count, CompareFunc);
- TempList.Free;
-end;
-
-
-type
- // stores the unaligned pointer of data allocated by GetAlignedMem()
- PMemAlignHeader = ^TMemAlignHeader;
- TMemAlignHeader = Pointer;
-
-(**
- * Use this function to assure that allocated memory is aligned on a specific
- * byte boundary.
- * Alignment must be a power of 2.
- *
- * Important: Memory allocated with GetAlignedMem() MUST be freed with
- * FreeAlignedMem(), FreeMem() will cause a segmentation fault.
- *
- * Hint: If you do not need dynamic memory, consider to allocate memory
- * statically and use the {$ALIGN x} compiler directive. Note that delphi
- * supports an alignment "x" of up to 8 bytes only whereas FPC supports
- * alignments on 16 and 32 byte boundaries too.
- *)
-{$WARNINGS OFF}
-function GetAlignedMem(Size: cardinal; Alignment: integer): Pointer;
-var
- OrigPtr: Pointer;
-const
- MIN_ALIGNMENT = 16;
-begin
- // Delphi and FPC (tested with 2.2.0) align memory blocks allocated with
- // GetMem() at least on 8 byte boundaries. Delphi uses a minimal alignment
- // of either 8 or 16 bytes depending on the size of the requested block
- // (see System.GetMinimumBlockAlignment). As we do not want to change the
- // boundary for the worse, we align at least on MIN_ALIGN.
- if (Alignment < MIN_ALIGNMENT) then
- Alignment := MIN_ALIGNMENT;
-
- // allocate unaligned memory
- GetMem(OrigPtr, SizeOf(TMemAlignHeader) + Size + Alignment);
- if (OrigPtr = nil) then
- begin
- Result := nil;
- Exit;
- end;
-
- // reserve space for the header
- Result := Pointer(PtrUInt(OrigPtr) + SizeOf(TMemAlignHeader));
- // align memory
- Result := Pointer(PtrUInt(Result) + Alignment - PtrUInt(Result) mod Alignment);
-
- // set header with info on old pointer for FreeMem
- PMemAlignHeader(PtrUInt(Result) - SizeOf(TMemAlignHeader))^ := OrigPtr;
-end;
-{$WARNINGS ON}
-
-{$WARNINGS OFF}
-procedure FreeAlignedMem(P: Pointer);
-begin
- if (P <> nil) then
- FreeMem(PMemAlignHeader(PtrUInt(P) - SizeOf(TMemAlignHeader))^);
-end;
-{$WARNINGS ON}
-
-
-initialization
- InitConsoleOutput();
-
-finalization
- FinalizeConsoleOutput();
-
-end.
diff --git a/src/classes/UConfig.pas b/src/classes/UConfig.pas
deleted file mode 100644
index b77c2a5a..00000000
--- a/src/classes/UConfig.pas
+++ /dev/null
@@ -1,199 +0,0 @@
-unit UConfig;
-
-// -------------------------------------------------------------------
-// Note on version comparison (for developers only):
-// -------------------------------------------------------------------
-// Delphi (in contrast to FPC) DOESN'T support MACROS. So we
-// can't define a macro like VERSION_MAJOR(version) to extract
-// parts of the version-number or to create version numbers for
-// comparison purposes as with a MAKE_VERSION(maj, min, rev) macro.
-// So we have to define constants for every part of the version here.
-//
-// In addition FPC (in contrast to delphi) DOES NOT support floating-
-// point numbers in $IF compiler-directives (e.g. {$IF VERSION > 1.23})
-// It also DOESN'T support arithmetic operations so we aren't able to
-// compare versions this way (brackets aren't supported too):
-// {$IF VERSION > ((VER_MAJ*2)+(VER_MIN*23)+(VER_REL*1))}
-//
-// Hence we have to use fixed numbers in the directives. At least
-// Pascal allows leading 0s so 0005 equals 5 (octals are
-// preceded by & and not by 0 in FPC).
-// We also fix the count of digits for each part of the version number
-// to 3 (aaaiiirrr with aaa=major, iii=minor, rrr=release version)
-//
-// A check for a library with at least a version of 2.5.11 would look
-// like this:
-// {$IF LIB_VERSION >= 002005011}
-//
-// If you just need to check the major version do this:
-// {$IF LIB_VERSION_MAJOR >= 23}
-//
-// IMPORTANT:
-// Because this unit must be included in a uses-section it is
-// not possible to use the version-numbers in this uses-clause.
-// Example:
-// interface
-// uses
-// versions, // include this file
-// {$IF USE_UNIT_XYZ}xyz;{$IFEND} // Error: USE_UNIT_XYZ not defined
-// const
-// {$IF USE_UNIT_XYZ}test = 2;{$IFEND} // OK
-// uses
-// {$IF USE_UNIT_XYZ}xyz;{$IFEND} // OK
-//
-// Even if this file was an include-file no constants could be declared
-// before the interface's uses clause.
-// In FPC macros {$DEFINE VER:= 3} could be used to declare the version-numbers
-// but this is incompatible to Delphi. In addition macros do not allow expand
-// arithmetic expressions. Although you can define
-// {$DEFINE FPC_VER:= FPC_VERSION*1000000+FPC_RELEASE*1000+FPC_PATCH}
-// the following check would fail:
-// {$IF FPC_VERSION_INT >= 002002000}
-// would fail because FPC_VERSION_INT is interpreted as a string.
-//
-// PLEASE consider this if you use version numbers in $IF compiler-
-// directives. Otherwise you might break portability.
-// -------------------------------------------------------------------
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
- {$MACRO ON} // for evaluation of FPC_VERSION/RELEASE/PATCH
-{$ENDIF}
-
-{$I switches.inc}
-
-uses
- Sysutils;
-
-const
- // IMPORTANT:
- // If IncludeConstants is defined, the const-sections
- // of the config-file will be included too.
- // This switch is necessary because it is not possible to
- // include the const-sections in the switches.inc.
- // switches.inc is always included before the first uses-
- // section but at that place no const-section is allowed.
- // So we have to include the config-file in switches.inc
- // with IncludeConstants undefined and in UConfig.pas with
- // IncludeConstants defined (see the note above).
- {$DEFINE IncludeConstants}
-
- // include config-file (defines + constants)
- {$IF Defined(MSWindows)}
- {$I ../config-win.inc}
- {$ELSEIF Defined(Linux)}
- {$I ../config-linux.inc}
- {$ELSEIF Defined(Darwin)}
- {$I ../config-darwin.inc}
- {$ELSE}
- {$MESSAGE Fatal 'Unknown OS'}
- {$IFEND}
-
-{* Libraries *}
-
- VERSION_MAJOR = 1000000;
- VERSION_MINOR = 1000;
- VERSION_RELEASE = 1;
-
- (*
- * Current version of UltraStar Deluxe
- *)
- USDX_VERSION_MAJOR = 1;
- USDX_VERSION_MINOR = 1;
- USDX_VERSION_RELEASE = 0;
- USDX_VERSION_STATE = 'Alpha';
- USDX_STRING = 'UltraStar Deluxe';
-
- (*
- * FPC version numbers are already defined as built-in macros:
- * FPC_VERSION (MAJOR)
- * FPC_RELEASE (MINOR)
- * FPC_PATCH (RELEASE)
- * Since FPC_VERSION is already defined, we will use FPC_VERSION_INT as
- * composed version number.
- *)
- {$IFNDEF FPC}
- // Delphi 7 evaluates every $IF-directive even if it is disabled by a surrounding
- // $IF or $IFDEF so the follwing will give you an error in delphi:
- // {$IFDEF FPC}{$IF (FPC_VERSION > 2)}...{$IFEND}{$ENDIF}
- // The reason for this error is that FPC_VERSION is not a valid constant.
- // To avoid this error, we define dummys here.
- FPC_VERSION = 0;
- FPC_RELEASE = 0;
- FPC_PATCH = 0;
- {$ENDIF}
-
- FPC_VERSION_INT = (FPC_VERSION * VERSION_MAJOR) +
- (FPC_RELEASE * VERSION_MINOR) +
- (FPC_PATCH * VERSION_RELEASE);
-
-
- {$IFDEF HaveFFmpeg}
-
- LIBAVCODEC_VERSION = (LIBAVCODEC_VERSION_MAJOR * VERSION_MAJOR) +
- (LIBAVCODEC_VERSION_MINOR * VERSION_MINOR) +
- (LIBAVCODEC_VERSION_RELEASE * VERSION_RELEASE);
-
- LIBAVFORMAT_VERSION = (LIBAVFORMAT_VERSION_MAJOR * VERSION_MAJOR) +
- (LIBAVFORMAT_VERSION_MINOR * VERSION_MINOR) +
- (LIBAVFORMAT_VERSION_RELEASE * VERSION_RELEASE);
-
- LIBAVUTIL_VERSION = (LIBAVUTIL_VERSION_MAJOR * VERSION_MAJOR) +
- (LIBAVUTIL_VERSION_MINOR * VERSION_MINOR) +
- (LIBAVUTIL_VERSION_RELEASE * VERSION_RELEASE);
-
- {$IFDEF HaveSWScale}
- LIBSWSCALE_VERSION = (LIBSWSCALE_VERSION_MAJOR * VERSION_MAJOR) +
- (LIBSWSCALE_VERSION_MINOR * VERSION_MINOR) +
- (LIBSWSCALE_VERSION_RELEASE * VERSION_RELEASE);
- {$ENDIF}
-
- {$ENDIF}
-
- {$IFDEF HaveProjectM}
- PROJECTM_VERSION = (PROJECTM_VERSION_MAJOR * VERSION_MAJOR) +
- (PROJECTM_VERSION_MINOR * VERSION_MINOR) +
- (PROJECTM_VERSION_RELEASE * VERSION_RELEASE);
- {$ENDIF}
-
- {$IFDEF HavePortaudio}
- PORTAUDIO_VERSION = (PORTAUDIO_VERSION_MAJOR * VERSION_MAJOR) +
- (PORTAUDIO_VERSION_MINOR * VERSION_MINOR) +
- (PORTAUDIO_VERSION_RELEASE * VERSION_RELEASE);
- {$ENDIF}
-
- {$IFDEF HaveLibsamplerate}
- LIBSAMPLERATE_VERSION = (LIBSAMPLERATE_VERSION_MAJOR * VERSION_MAJOR) +
- (LIBSAMPLERATE_VERSION_MINOR * VERSION_MINOR) +
- (LIBSAMPLERATE_VERSION_RELEASE * VERSION_RELEASE);
- {$ENDIF}
-
-function USDXVersionStr(): string;
-function USDXShortVersionStr(): string;
-
-implementation
-
-uses
- StrUtils, Math;
-
-function USDXShortVersionStr(): string;
-begin
- Result :=
- USDX_STRING +
- IfThen(USDX_VERSION_STATE <> '', ' '+USDX_VERSION_STATE);
-end;
-
-function USDXVersionStr(): string;
-begin
- Result :=
- USDX_STRING + ' V ' +
- IntToStr(USDX_VERSION_MAJOR) + '.' +
- IntToStr(USDX_VERSION_MINOR) + '.' +
- IntToStr(USDX_VERSION_RELEASE) +
- IfThen(USDX_VERSION_STATE <> '', ' '+USDX_VERSION_STATE) +
- ' Build';
-end;
-
-end.
diff --git a/src/classes/UCore.pas b/src/classes/UCore.pas
deleted file mode 100644
index fe23a68e..00000000
--- a/src/classes/UCore.pas
+++ /dev/null
@@ -1,525 +0,0 @@
-unit UCore;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses
- uPluginDefs,
- uCoreModule,
- UHooks,
- UServices,
- UModules;
-
-{*********************
- TCore
- Class manages all CoreModules, teh StartUp, teh MainLoop and the shutdown process
- Also it does some Error Handling, and maybe sometime multithreaded Loading ;)
-*********************}
-
-type
- TModuleListItem = record
- Module: TCoreModule; //Instance of the Modules Class
- Info: TModuleInfo; //ModuleInfo returned by Modules Modulinfo Proc
- NeedsDeInit: Boolean; //True if Module was succesful inited
- end;
-
- TCore = class
- private
- //Some Hook Handles. See Plugin SDKs Hooks.txt for Infos
- hLoadingFinished: THandle;
- hMainLoop: THandle;
- hTranslate: THandle;
- hLoadTextures: THandle;
- hExitQuery: THandle;
- hExit: THandle;
- hDebug: THandle;
- hError: THandle;
- sReportError: THandle;
- sReportDebug: THandle;
- sShowMessage: THandle;
- sRetranslate: THandle;
- sReloadTextures: THandle;
- sGetModuleInfo: THandle;
- sGetApplicationHandle: THandle;
-
- Modules: Array [0..High(CORE_MODULES_TO_LOAD)] of TModuleListItem;
-
- //Cur + Last Executed Setting and Getting ;)
- iCurExecuted: Integer;
- iLastExecuted: Integer;
-
- procedure SetCurExecuted(Value: Integer);
-
- //Function Get all Modules and Creates them
- function GetModules: Boolean;
-
- //Loads Core and all Modules
- function Load: Boolean;
-
- //Inits Core and all Modules
- function Init: Boolean;
-
- //DeInits Core and all Modules
- function DeInit: Boolean;
-
- //Load the Core
- function LoadCore: Boolean;
-
- //Init the Core
- function InitCore: Boolean;
-
- //DeInit the Core
- function DeInitCore: Boolean;
-
- //Called one Time per Frame
- function MainLoop: Boolean;
-
- public
- Hooks: THookManager; //Teh Hook Manager ;)
- Services: TServiceManager;//The Service Manager
-
- Name: String; //Name of this Application
- Version: LongWord; //Version of this ". For Info Look PluginDefs Functions
-
- LastErrorReporter:String; //Who Reported the Last Error String
- LastErrorString: String; //Last Error String reported
-
- property CurExecuted: Integer read iCurExecuted write SetCurExecuted; //ID of Plugin or Module curently Executed
- property LastExecuted: Integer read iLastExecuted;
-
- //---------------
- //Main Methods to control the Core:
- //---------------
- constructor Create(const cName: String; const cVersion: LongWord);
-
- //Starts Loading and Init Process. Then Runs MainLoop. DeInits on Shutdown
- procedure Run;
-
- //Method for other Classes to get Pointer to a specific Module
- function GetModulebyName(const Name: String): PCoreModule;
-
- //--------------
- // Hook and Service Procs:
- //--------------
- function ShowMessage(wParam: TwParam; lParam: TlParam): integer; //Shows a Message (lParam: PChar Text, wParam: Symbol)
- function ReportError(wParam: TwParam; lParam: TlParam): integer; //Shows a Message (wParam: Pchar(Message), lParam: PChar(Reportername))
- function ReportDebug(wParam: TwParam; lParam: TlParam): integer; //Shows a Message (wParam: Pchar(Message), lParam: PChar(Reportername))
- function Retranslate(wParam: TwParam; lParam: TlParam): integer; //Calls Translate hook
- function ReloadTextures(wParam: TwParam; lParam: TlParam): integer; //Calls LoadTextures hook
- function GetModuleInfo(wParam: TwParam; lParam: TlParam): integer; //If lParam = nil then get length of Moduleinfo Array. If lparam <> nil then write array of TModuleInfo to address at lparam
- function GetApplicationHandle(wParam: TwParam; lParam: TlParam): integer; //Returns Application Handle
- end;
-
-var
- Core: TCore;
-
-implementation
-
-uses
- {$IFDEF win32}
- Windows,
- {$ENDIF}
- SysUtils;
-
-//-------------
-// Create - Creates Class + Hook and Service Manager
-//-------------
-constructor TCore.Create(const cName: String; const cVersion: LongWord);
-begin
- inherited Create;
-
- Name := cName;
- Version := cVersion;
- iLastExecuted := 0;
- iCurExecuted := 0;
-
- LastErrorReporter := '';
- LastErrorString := '';
-
- Hooks := THookManager.Create(50);
- Services := TServiceManager.Create;
-end;
-
-//-------------
-//Starts Loading and Init Process. Then Runs MainLoop. DeInits on Shutdown
-//-------------
-procedure TCore.Run;
-var
- Success: Boolean;
-
- procedure HandleError(const ErrorMsg: string);
- begin
- if (LastErrorString <> '') then
- Self.ShowMessage(CORE_SM_ERROR, PChar(ErrorMsg + ': ' + LastErrorString))
- else
- Self.ShowMessage(CORE_SM_ERROR, PChar(ErrorMsg));
-
- //DeInit
- DeInit;
- end;
-
-begin
- //Get Modules
- try
- Success := GetModules();
- except
- Success := False;
- end;
-
- if (not Success) then
- begin
- HandleError('Error Getting Modules');
- Exit;
- end;
-
- //Loading
- try
- Success := Load();
- except
- Success := False;
- end;
-
- if (not Success) then
- begin
- HandleError('Error loading Modules');
- Exit;
- end;
-
- //Init
- try
- Success := Init();
- except
- Success := False;
- end;
-
- if (not Success) then
- begin
- HandleError('Error initing Modules');
- Exit;
- end;
-
- //Call Translate Hook
- if (Hooks.CallEventChain(hTranslate, 0, nil) <> 0) then
- begin
- HandleError('Error translating');
- Exit;
- end;
-
- //Calls LoadTextures Hook
- if (Hooks.CallEventChain(hLoadTextures, 0, nil) <> 0) then
- begin
- HandleError('Error loading textures');
- Exit;
- end;
-
- //Calls Loading Finished Hook
- if (Hooks.CallEventChain(hLoadingFinished, 0, nil) <> 0) then
- begin
- HandleError('Error calling LoadingFinished Hook');
- Exit;
- end;
-
- //Start MainLoop
- while Success do
- begin
- Success := MainLoop();
- // to-do : Call Display Draw here
- end;
-end;
-
-//-------------
-//Called one Time per Frame
-//-------------
-function TCore.MainLoop: Boolean;
-begin
- Result := False;
-end;
-
-//-------------
-//Function Get all Modules and Creates them
-//-------------
-function TCore.GetModules: Boolean;
-var
- i: Integer;
-begin
- Result := False;
- for i := 0 to high(Modules) do
- begin
- try
- Modules[i].NeedsDeInit := False;
- Modules[i].Module := CORE_MODULES_TO_LOAD[i].Create;
- Modules[i].Module.Info(@Modules[i].Info);
- except
- ReportError(Integer(PChar('Can''t get module #' + InttoStr(i) + ' "' + Modules[i].Info.Name + '"')), PChar('Core'));
- Exit;
- end;
- end;
- Result := True;
-end;
-
-//-------------
-//Loads Core and all Modules
-//-------------
-function TCore.Load: Boolean;
-var
- i: Integer;
-begin
- Result := LoadCore;
-
- for i := 0 to High(CORE_MODULES_TO_LOAD) do
- begin
- try
- Result := Modules[i].Module.Load;
- except
- Result := False;
- end;
-
- if (not Result) then
- begin
- ReportError(Integer(PChar('Error loading module #' + InttoStr(i) + ' "' + Modules[i].Info.Name + '"')), PChar('Core'));
- break;
- end;
- end;
-end;
-
-//-------------
-//Inits Core and all Modules
-//-------------
-function TCore.Init: Boolean;
-var
- i: Integer;
-begin
- Result := InitCore;
-
- for i := 0 to High(CORE_MODULES_TO_LOAD) do
- begin
- try
- Result := Modules[i].Module.Init;
- except
- Result := False;
- end;
-
- if (not Result) then
- begin
- ReportError(Integer(PChar('Error initing module #' + InttoStr(i) + ' "' + Modules[i].Info.Name + '"')), PChar('Core'));
- break;
- end;
-
- Modules[i].NeedsDeInit := Result;
- end;
-end;
-
-//-------------
-//DeInits Core and all Modules
-//-------------
-function TCore.DeInit: boolean;
-var
- i: integer;
-begin
-
- for i := High(CORE_MODULES_TO_LOAD) downto 0 do
- begin
- try
- if (Modules[i].NeedsDeInit) then
- Modules[i].Module.DeInit;
- except
- end;
- end;
-
- DeInitCore;
-
- Result := true;
-end;
-
-//-------------
-//Load the Core
-//-------------
-function TCore.LoadCore: Boolean;
-begin
- hLoadingFinished := Hooks.AddEvent('Core/LoadingFinished');
- hMainLoop := Hooks.AddEvent('Core/MainLoop');
- hTranslate := Hooks.AddEvent('Core/Translate');
- hLoadTextures := Hooks.AddEvent('Core/LoadTextures');
- hExitQuery := Hooks.AddEvent('Core/ExitQuery');
- hExit := Hooks.AddEvent('Core/Exit');
- hDebug := Hooks.AddEvent('Core/NewDebugInfo');
- hError := Hooks.AddEvent('Core/NewError');
-
- sReportError := Services.AddService('Core/ReportError', nil, Self.ReportError);
- sReportDebug := Services.AddService('Core/ReportDebug', nil, Self.ReportDebug);
- sShowMessage := Services.AddService('Core/ShowMessage', nil, Self.ShowMessage);
- sRetranslate := Services.AddService('Core/Retranslate', nil, Self.Retranslate);
- sReloadTextures := Services.AddService('Core/ReloadTextures', nil, Self.ReloadTextures);
- sGetModuleInfo := Services.AddService('Core/GetModuleInfo', nil, Self.GetModuleInfo);
- sGetApplicationHandle := Services.AddService('Core/GetApplicationHandle', nil, Self.GetApplicationHandle);
-
- //A little Test
- Hooks.AddSubscriber('Core/NewError', HookTest);
-
- result := true;
-end;
-
-//-------------
-//Init the Core
-//-------------
-function TCore.InitCore: Boolean;
-begin
- //Don not init something atm.
- result := true;
-end;
-
-//-------------
-//DeInit the Core
-//-------------
-function TCore.DeInitCore: Boolean;
-begin
- // TODO: write TService-/HookManager.Free and call it here
- Result := true;
-end;
-
-//-------------
-//Method for other classes to get pointer to a specific module
-//-------------
-function TCore.GetModuleByName(const Name: String): PCoreModule;
-var i: Integer;
-begin
- Result := nil;
- for i := 0 to High(Modules) do
- begin
- if (Modules[i].Info.Name = Name) then
- begin
- Result := @Modules[i].Module;
- Break;
- end;
- end;
-end;
-
-//-------------
-// Shows a MessageDialog (lParam: PChar Text, wParam: Symbol)
-//-------------
-function TCore.ShowMessage(wParam: TwParam; lParam: TlParam): integer;
-{$IFDEF MSWINDOWS}
-var Params: Cardinal;
-{$ENDIF}
-begin
- Result := -1;
-
- {$IFDEF MSWINDOWS}
- if (lParam <> nil) then
- begin
- Params := MB_OK;
- case wParam of
- CORE_SM_ERROR: Params := Params or MB_ICONERROR;
- CORE_SM_WARNING: Params := Params or MB_ICONWARNING;
- CORE_SM_INFO: Params := Params or MB_ICONINFORMATION;
- end;
-
- //Show:
- Result := Messagebox(0, lParam, PChar(Name), Params);
- end;
- {$ENDIF}
-
- // TODO: write ShowMessage for other OSes
-end;
-
-//-------------
-// Calls NewError HookChain (wParam: Pchar(Message), lParam: PChar(Reportername))
-//-------------
-function TCore.ReportError(wParam: TwParam; lParam: TlParam): integer;
-begin
- //Update LastErrorReporter and LastErrorString
- LastErrorReporter := String(PChar(lParam));
- LastErrorString := String(PChar(Pointer(wParam)));
-
- Hooks.CallEventChain(hError, wParam, lParam);
-
- // FIXME: return a correct result
- Result := 0;
-end;
-
-//-------------
-// Calls NewDebugInfo HookChain (wParam: Pchar(Message), lParam: PChar(Reportername))
-//-------------
-function TCore.ReportDebug(wParam: TwParam; lParam: TlParam): integer;
-begin
- Hooks.CallEventChain(hDebug, wParam, lParam);
-
- // FIXME: return a correct result
- Result := 0;
-end;
-
-//-------------
-// Calls Translate hook
-//-------------
-function TCore.Retranslate(wParam: TwParam; lParam: TlParam): integer;
-begin
- Hooks.CallEventChain(hTranslate, 1, nil);
-
- // FIXME: return a correct result
- Result := 0;
-end;
-
-//-------------
-// Calls LoadTextures hook
-//-------------
-function TCore.ReloadTextures(wParam: TwParam; lParam: TlParam): integer;
-begin
- Hooks.CallEventChain(hLoadTextures, 1, nil);
-
- // FIXME: return a correct result
- Result := 0;
-end;
-
-//-------------
-// If lParam = nil then get length of Moduleinfo Array. If lparam <> nil then write array of TModuleInfo to address at lparam
-//-------------
-function TCore.GetModuleInfo(wParam: TwParam; lParam: TlParam): integer;
-var
- I: integer;
-begin
- if (Pointer(lParam) = nil) then
- begin
- Result := Length(Modules);
- end
- else
- begin
- try
- for I := 0 to High(Modules) do
- begin
- AModuleInfo(Pointer(lParam))[I].Name := Modules[I].Info.Name;
- AModuleInfo(Pointer(lParam))[I].Version := Modules[I].Info.Version;
- AModuleInfo(Pointer(lParam))[I].Description := Modules[I].Info.Description;
- end;
- Result := Length(Modules);
- except
- Result := -1;
- end;
- end;
-end;
-
-//-------------
-// Returns Application Handle
-//-------------
-function TCore.GetApplicationHandle(wParam: TwParam; lParam: TlParam): integer;
-begin
- Result := hInstance;
-end;
-
-//-------------
-// Called when setting CurExecuted
-//-------------
-procedure TCore.SetCurExecuted(Value: Integer);
-begin
- //Set Last Executed
- iLastExecuted := iCurExecuted;
-
- //Set Cur Executed
- iCurExecuted := Value;
-end;
-
-end.
diff --git a/src/classes/UCoreModule.pas b/src/classes/UCoreModule.pas
deleted file mode 100644
index 031fb04e..00000000
--- a/src/classes/UCoreModule.pas
+++ /dev/null
@@ -1,128 +0,0 @@
-unit UCoreModule;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-{*********************
- TCoreModule
- Dummy Class that has Methods that will be called from Core
- In the Best case every Piece of this Software is a Module
-*********************}
-uses UPluginDefs;
-
-type
- PCoreModule = ^TCoreModule;
- TCoreModule = class
- public
- Constructor Create; virtual;
-
- //Function that gives some Infos about the Module to the Core
- Procedure Info(const pInfo: PModuleInfo); virtual;
-
- //Is Called on Loading.
- //In this Method only Events and Services should be created
- //to offer them to other Modules or Plugins during the Init process
- //If False is Returned this will cause a Forced Exit
- Function Load: Boolean; virtual;
-
- //Is Called on Init Process
- //In this Method you can Hook some Events and Create + Init
- //your Classes, Variables etc.
- //If False is Returned this will cause a Forced Exit
- Function Init: Boolean; virtual;
-
- //Is Called during Mainloop before 'Core/MainLoop' Hook and Drawing
- //If False is Returned this will cause a Forced Exit
- Function MainLoop: Boolean; virtual;
-
- //Is Called if this Module has been Inited and there is a Exit.
- //Deinit is in backwards Initing Order
- //If False is Returned this will cause a Forced Exit
- Procedure DeInit; virtual;
-
- //Is Called if this Module will be unloaded and has been created
- //Should be used to Free Memory
- Destructor Destroy; override;
- end;
- cCoreModule = class of TCoreModule;
-
-implementation
-
-//-------------
-// Just the Constructor
-//-------------
-Constructor TCoreModule.Create;
-begin
- //Dummy maaaan ;)
- inherited;
-end;
-
-//-------------
-// Function that gives some Infos about the Module to the Core
-//-------------
-Procedure TCoreModule.Info(const pInfo: PModuleInfo);
-begin
- pInfo^.Name := 'Not Set';
- pInfo^.Version := 0;
- pInfo^.Description := 'Not Set';
-end;
-
-//-------------
-//Is Called on Loading.
-//In this Method only Events and Services should be created
-//to offer them to other Modules or Plugins during the Init process
-//If False is Returned this will cause a Forced Exit
-//-------------
-Function TCoreModule.Load: Boolean;
-begin
- //Dummy ftw!!
- Result := True;
-end;
-
-//-------------
-//Is Called on Init Process
-//In this Method you can Hook some Events and Create + Init
-//your Classes, Variables etc.
-//If False is Returned this will cause a Forced Exit
-//-------------
-Function TCoreModule.Init: Boolean;
-begin
- //Dummy ftw!!
- Result := True;
-end;
-
-//-------------
-//Is Called during Mainloop before 'Core/MainLoop' Hook and Drawing
-//If False is Returned this will cause a Forced Exit
-//-------------
-Function TCoreModule.MainLoop: Boolean;
-begin
- //Dummy ftw!!
- Result := True;
-end;
-
-//-------------
-//Is Called if this Module has been Inited and there is a Exit.
-//Deinit is in backwards Initing Order
-//-------------
-Procedure TCoreModule.DeInit;
-begin
- //Dummy ftw!!
-end;
-
-//-------------
-//Is Called if this Module will be unloaded and has been created
-//Should be used to Free Memory
-//-------------
-Destructor TCoreModule.Destroy;
-begin
- //Dummy ftw!!
- inherited;
-end;
-
-end.
diff --git a/src/classes/UCovers.pas b/src/classes/UCovers.pas
deleted file mode 100644
index 7bb57b4a..00000000
--- a/src/classes/UCovers.pas
+++ /dev/null
@@ -1,430 +0,0 @@
-unit UCovers;
-
-{
- TODO:
- - adjust database to new song-loading (e.g. use SongIDs)
- - support for deletion of outdated covers
- - support for update of changed covers
- - use paths relative to the song for removable disks support
- (a drive might have a different drive-name the next time it is connected,
- so "H:/songs/..." will not match "I:/songs/...")
-}
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses
- sdl,
- SQLite3,
- SQLiteTable3,
- SysUtils,
- Classes,
- UImage,
- UTexture;
-
-type
- ECoverDBException = class(Exception)
- end;
-
- TCover = class
- private
- ID: int64;
- Filename: WideString;
- public
- constructor Create(ID: int64; Filename: WideString);
- function GetPreviewTexture(): TTexture;
- function GetTexture(): TTexture;
- end;
-
- TThumbnailInfo = record
- CoverWidth: integer; // Original width of cover
- CoverHeight: integer; // Original height of cover
- PixelFormat: TImagePixelFmt; // Pixel-format of thumbnail
- end;
-
- TCoverDatabase = class
- private
- DB: TSQLiteDatabase;
- procedure InitCoverDatabase();
- function CreateThumbnail(const Filename: WideString; var Info: TThumbnailInfo): PSDL_Surface;
- function LoadCover(CoverID: int64): TTexture;
- procedure DeleteCover(CoverID: int64);
- function FindCoverIntern(const Filename: WideString): int64;
- procedure Open();
- function GetVersion(): integer;
- procedure SetVersion(Version: integer);
- public
- constructor Create();
- destructor Destroy; override;
- function AddCover(const Filename: WideString): TCover;
- function FindCover(const Filename: WideString): TCover;
- function CoverExists(const Filename: WideString): boolean;
- function GetMaxCoverSize(): integer;
- procedure SetMaxCoverSize(Size: integer);
- end;
-
- TBlobWrapper = class(TCustomMemoryStream)
- function Write(const Buffer; Count: Integer): Integer; override;
- end;
-
-var
- Covers: TCoverDatabase;
-
-implementation
-
-uses
- UMain,
- ULog,
- UPlatform,
- UIni,
- Math,
- DateUtils;
-
-const
- COVERDB_FILENAME = 'cover.db';
- COVERDB_VERSION = 01; // 0.1
- COVER_TBL = 'Cover';
- COVER_THUMBNAIL_TBL = 'CoverThumbnail';
- COVER_IDX = 'Cover_Filename_IDX';
-
-// Note: DateUtils.DateTimeToUnix() will throw an exception in FPC
-function DateTimeToUnixTime(time: TDateTime): int64;
-begin
- Result := Round((time - UnixDateDelta) * SecsPerDay);
-end;
-
-// Note: DateUtils.UnixToDateTime() will throw an exception in FPC
-function UnixTimeToDateTime(timestamp: int64): TDateTime;
-begin
- Result := timestamp / SecsPerDay + UnixDateDelta;
-end;
-
-
-{ TBlobWrapper }
-
-function TBlobWrapper.Write(const Buffer; Count: Integer): Integer;
-begin
- SetPointer(Pointer(Buffer), Count);
- Result := Count;
-end;
-
-
-{ TCover }
-
-constructor TCover.Create(ID: int64; Filename: WideString);
-begin
- Self.ID := ID;
- Self.Filename := Filename;
-end;
-
-function TCover.GetPreviewTexture(): TTexture;
-begin
- Result := Covers.LoadCover(ID);
-end;
-
-function TCover.GetTexture(): TTexture;
-begin
- Result := Texture.LoadTexture(Filename);
-end;
-
-
-{ TCoverDatabase }
-
-constructor TCoverDatabase.Create();
-begin
- inherited;
-
- Open();
- InitCoverDatabase();
-end;
-
-destructor TCoverDatabase.Destroy;
-begin
- DB.Free;
- inherited;
-end;
-
-function TCoverDatabase.GetVersion(): integer;
-begin
- Result := DB.GetTableValue('PRAGMA user_version');
-end;
-
-procedure TCoverDatabase.SetVersion(Version: integer);
-begin
- DB.ExecSQL(Format('PRAGMA user_version = %d', [Version]));
-end;
-
-function TCoverDatabase.GetMaxCoverSize(): integer;
-begin
- Result := ITextureSizeVals[Ini.TextureSize];
-end;
-
-procedure TCoverDatabase.SetMaxCoverSize(Size: integer);
-var
- I: integer;
-begin
- // search for first valid cover-size > Size
- for I := 0 to Length(ITextureSizeVals)-1 do
- begin
- if (Size <= ITextureSizeVals[I]) then
- begin
- Ini.TextureSize := I;
- Exit;
- end;
- end;
-
- // fall-back to highest size
- Ini.TextureSize := High(ITextureSizeVals);
-end;
-
-procedure TCoverDatabase.Open();
-var
- Version: integer;
- Filename: string;
-begin
- Filename := UTF8Encode(Platform.GetGameUserPath() + COVERDB_FILENAME);
-
- DB := TSQLiteDatabase.Create(Filename);
- Version := GetVersion();
-
- // check version, if version is too old/new, delete database file
- if ((Version <> 0) and (Version <> COVERDB_VERSION)) then
- begin
- Log.LogInfo('Outdated cover-database file found', 'TCoverDatabase.Open');
- // close and delete outdated file
- DB.Free;
- if (not DeleteFile(Filename)) then
- raise ECoverDBException.Create('Could not delete ' + Filename);
- // reopen
- DB := TSQLiteDatabase.Create(Filename);
- Version := 0;
- end;
-
- // set version number after creation
- if (Version = 0) then
- SetVersion(COVERDB_VERSION);
-
- // speed-up disk-writing. The default FULL-synchronous mode is too slow.
- // With this option disk-writing is approx. 4 times faster but the database
- // might be corrupted if the OS crashes, although this is very unlikely.
- DB.ExecSQL('PRAGMA synchronous = OFF;');
-
- // the next line rather gives a slow-down instead of a speed-up, so we do not use it
- //DB.ExecSQL('PRAGMA temp_store = MEMORY;');
-end;
-
-procedure TCoverDatabase.InitCoverDatabase();
-begin
- DB.ExecSQL('CREATE TABLE IF NOT EXISTS ['+COVER_TBL+'] (' +
- '[ID] INTEGER NOT NULL PRIMARY KEY AUTOINCREMENT, ' +
- '[Filename] TEXT UNIQUE NOT NULL, ' +
- '[Date] INTEGER NOT NULL, ' +
- '[Width] INTEGER NOT NULL, ' +
- '[Height] INTEGER NOT NULL ' +
- ')');
-
- DB.ExecSQL('CREATE INDEX IF NOT EXISTS ['+COVER_IDX+'] ON ['+COVER_TBL+'](' +
- '[Filename] ASC' +
- ')');
-
- DB.ExecSQL('CREATE TABLE IF NOT EXISTS ['+COVER_THUMBNAIL_TBL+'] (' +
- '[ID] INTEGER NOT NULL PRIMARY KEY, ' +
- '[Format] INTEGER NOT NULL, ' +
- '[Width] INTEGER NOT NULL, ' +
- '[Height] INTEGER NOT NULL, ' +
- '[Data] BLOB NULL' +
- ')');
-end;
-
-function TCoverDatabase.FindCoverIntern(const Filename: WideString): int64;
-begin
- Result := DB.GetTableValue('SELECT [ID] FROM ['+COVER_TBL+'] ' +
- 'WHERE [Filename] = ?',
- [UTF8Encode(Filename)]);
-end;
-
-function TCoverDatabase.FindCover(const Filename: WideString): TCover;
-var
- CoverID: int64;
-begin
- Result := nil;
- try
- CoverID := FindCoverIntern(Filename);
- if (CoverID > 0) then
- Result := TCover.Create(CoverID, Filename);
- except on E: Exception do
- Log.LogError(E.Message, 'TCoverDatabase.FindCover');
- end;
-end;
-
-function TCoverDatabase.CoverExists(const Filename: WideString): boolean;
-begin
- Result := false;
- try
- Result := (FindCoverIntern(Filename) > 0);
- except on E: Exception do
- Log.LogError(E.Message, 'TCoverDatabase.CoverExists');
- end;
-end;
-
-function TCoverDatabase.AddCover(const Filename: WideString): TCover;
-var
- CoverID: int64;
- Thumbnail: PSDL_Surface;
- CoverData: TBlobWrapper;
- FileDate: TDateTime;
- Info: TThumbnailInfo;
-begin
- Result := nil;
-
- //if (not FileExists(Filename)) then
- // Exit;
-
- // TODO: replace '\' with '/' in filename
- FileDate := Now(); //FileDateToDateTime(FileAge(Filename));
-
- Thumbnail := CreateThumbnail(Filename, Info);
- if (Thumbnail = nil) then
- Exit;
-
- CoverData := TBlobWrapper.Create;
- CoverData.Write(Thumbnail^.pixels, Thumbnail^.h * Thumbnail^.pitch);
-
- try
- // Note: use a transaction to speed-up file-writing.
- // Without data written by the first INSERT might be moved at the second INSERT.
- DB.BeginTransaction();
-
- // add general cover info
- DB.ExecSQL('INSERT INTO ['+COVER_TBL+'] ' +
- '([Filename], [Date], [Width], [Height]) VALUES' +
- '(?, ?, ?, ?)',
- [UTF8Encode(Filename), DateTimeToUnixTime(FileDate),
- Info.CoverWidth, Info.CoverHeight]);
-
- // get auto-generated cover ID
- CoverID := DB.GetLastInsertRowID();
-
- // add thumbnail info
- DB.ExecSQL('INSERT INTO ['+COVER_THUMBNAIL_TBL+'] ' +
- '([ID], [Format], [Width], [Height], [Data]) VALUES' +
- '(?, ?, ?, ?, ?)',
- [CoverID, Ord(Info.PixelFormat),
- Thumbnail^.w, Thumbnail^.h, CoverData]);
-
- Result := TCover.Create(CoverID, Filename);
- except on E: Exception do
- Log.LogError(E.Message, 'TCoverDatabase.AddCover');
- end;
-
- DB.Commit();
- CoverData.Free;
- SDL_FreeSurface(Thumbnail);
-end;
-
-function TCoverDatabase.LoadCover(CoverID: int64): TTexture;
-var
- Width, Height: integer;
- PixelFmt: TImagePixelFmt;
- Data: PChar;
- DataSize: integer;
- Filename: WideString;
- Table: TSQLiteUniTable;
-begin
- Table := nil;
-
- try
- Table := DB.GetUniTable(Format(
- 'SELECT C.[Filename], T.[Format], T.[Width], T.[Height], T.[Data] ' +
- 'FROM ['+COVER_TBL+'] C ' +
- 'INNER JOIN ['+COVER_THUMBNAIL_TBL+'] T ' +
- 'USING(ID) ' +
- 'WHERE [ID] = %d', [CoverID]));
-
- Filename := UTF8Decode(Table.FieldAsString(0));
- PixelFmt := TImagePixelFmt(Table.FieldAsInteger(1));
- Width := Table.FieldAsInteger(2);
- Height := Table.FieldAsInteger(3);
-
- Data := Table.FieldAsBlobPtr(4, DataSize);
- if (Data <> nil) and
- (PixelFmt = ipfRGB) then
- begin
- Result := Texture.CreateTexture(Data, Filename, Width, Height, 24)
- end
- else
- begin
- FillChar(Result, SizeOf(TTexture), 0);
- end;
- except on E: Exception do
- Log.LogError(E.Message, 'TCoverDatabase.LoadCover');
- end;
-
- Table.Free;
-end;
-
-procedure TCoverDatabase.DeleteCover(CoverID: int64);
-begin
- DB.ExecSQL(Format('DELETE FROM ['+COVER_TBL+'] WHERE [ID] = %d', [CoverID]));
- DB.ExecSQL(Format('DELETE FROM ['+COVER_THUMBNAIL_TBL+'] WHERE [ID] = %d', [CoverID]));
-end;
-
-(**
- * Returns a pointer to an array of bytes containing the texture data in the
- * requested size
- *)
-function TCoverDatabase.CreateThumbnail(const Filename: WideString; var Info: TThumbnailInfo): PSDL_Surface;
-var
- TargetAspect, SourceAspect: double;
- //TargetWidth, TargetHeight: integer;
- Thumbnail: PSDL_Surface;
- MaxSize: integer;
-begin
- Result := nil;
-
- MaxSize := GetMaxCoverSize();
-
- Thumbnail := LoadImage(Filename);
- if (not assigned(Thumbnail)) then
- begin
- Log.LogError('Could not load cover: "'+ Filename +'"', 'TCoverDatabase.AddCover');
- Exit;
- end;
-
- // Convert pixel format as needed
- AdjustPixelFormat(Thumbnail, TEXTURE_TYPE_PLAIN);
-
- Info.CoverWidth := Thumbnail^.w;
- Info.CoverHeight := Thumbnail^.h;
- Info.PixelFormat := ipfRGB;
-
- (* TODO: keep aspect ratio
- TargetAspect := Width / Height;
- SourceAspect := TexSurface.w / TexSurface.h;
-
- // Scale texture to covers dimensions (keep aspect)
- if (SourceAspect >= TargetAspect) then
- begin
- TargetWidth := Width;
- TargetHeight := Trunc(Width / SourceAspect);
- end
- else
- begin
- TargetHeight := Height;
- TargetWidth := Trunc(Height * SourceAspect);
- end;
- *)
-
- // TODO: do not scale if image is smaller
- ScaleImage(Thumbnail, MaxSize, MaxSize);
-
- Result := Thumbnail;
-end;
-
-end.
-
diff --git a/src/classes/UDLLManager.pas b/src/classes/UDLLManager.pas
deleted file mode 100644
index 3d32a72a..00000000
--- a/src/classes/UDLLManager.pas
+++ /dev/null
@@ -1,253 +0,0 @@
-unit UDLLManager;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses ModiSDK,
- UFiles;
-
-type
- TDLLMan = class
- private
- hLib: THandle;
- P_Init: fModi_Init;
- P_Draw: fModi_Draw;
- P_Finish: fModi_Finish;
- P_RData: pModi_RData;
- public
- Plugins: array of TPluginInfo;
- PluginPaths: array of String;
- Selected: ^TPluginInfo;
-
- constructor Create;
-
- procedure GetPluginList;
- procedure ClearPluginInfo(No: Cardinal);
- function LoadPluginInfo(Filename: String; No: Cardinal): boolean;
-
- function LoadPlugin(No: Cardinal): boolean;
- procedure UnLoadPlugin;
-
- function PluginInit (const TeamInfo: TTeamInfo; var Playerinfo: TPlayerinfo; const Sentences: TSentences; const LoadTex: fModi_LoadTex; const Print: fModi_Print; LoadSound: fModi_LoadSound; PlaySound: pModi_PlaySound): boolean;
- function PluginDraw (var Playerinfo: TPlayerinfo; const CurSentence: Cardinal): boolean;
- function PluginFinish (var Playerinfo: TPlayerinfo): byte;
- procedure PluginRData (handle: HSTREAM; buffer: Pointer; len: DWORD; user: DWORD);
- end;
-
-var
- DLLMan: TDLLMan;
-
-const
- DLLPath = 'Plugins';
-
- {$IFDEF MSWINDOWS}
- DLLExt = '.dll';
- {$ENDIF}
- {$IFDEF LINUX}
- DLLExt = '.so';
- {$ENDIF}
- {$IFDEF DARWIN}
- DLLExt = '.dylib';
- {$ENDIF}
-
-implementation
-
-uses {$IFDEF MSWINDOWS}
- windows,
- {$ELSE}
- dynlibs,
- {$ENDIF}
- ULog,
- SysUtils;
-
-
-constructor TDLLMan.Create;
-begin
- inherited;
- SetLength(Plugins, 0);
- SetLength(PluginPaths, Length(Plugins));
- GetPluginList;
-end;
-
-procedure TDLLMan.GetPluginList;
-var
- SR: TSearchRec;
-begin
-
- if FindFirst(DLLPath +PathDelim+ '*' + DLLExt, faAnyFile , SR) = 0 then
- begin
- repeat
- SetLength(Plugins, Length(Plugins)+1);
- SetLength(PluginPaths, Length(Plugins));
-
- if LoadPluginInfo(SR.Name, High(Plugins)) then //Loaded succesful
- begin
- PluginPaths[High(PluginPaths)] := SR.Name;
- end
- else //Error Loading
- begin
- SetLength(Plugins, Length(Plugins)-1);
- SetLength(PluginPaths, Length(Plugins));
- end;
-
- until FindNext(SR) <> 0;
- FindClose(SR);
- end;
-end;
-
-procedure TDLLMan.ClearPluginInfo(No: Cardinal);
-begin
- //Set to Party Modi Plugin
- Plugins[No].Typ := 8;
-
- Plugins[No].Name := 'unknown';
- Plugins[No].NumPlayers := 0;
-
- Plugins[No].Creator := 'Nobody';
- Plugins[No].PluginDesc := 'NO_PLUGIN_DESC';
-
- Plugins[No].LoadSong := True;
- Plugins[No].ShowScore := True;
- Plugins[No].ShowBars := False;
- Plugins[No].ShowNotes := True;
- Plugins[No].LoadVideo := True;
- Plugins[No].LoadBack := True;
-
- Plugins[No].TeamModeOnly := False;
- Plugins[No].GetSoundData := False;
- Plugins[No].Dummy := False;
-
-
- Plugins[No].BGShowFull := False;
- Plugins[No].BGShowFull_O := True;
-
- Plugins[No].ShowRateBar:= False;
- Plugins[No].ShowRateBar_O := True;
-
- Plugins[No].EnLineBonus := False;
- Plugins[No].EnLineBonus_O := True;
-end;
-
-function TDLLMan.LoadPluginInfo(Filename: String; No: Cardinal): boolean;
-var
- hLibg: THandle;
- Info: pModi_PluginInfo;
- I: Integer;
-begin
- Result := False;
- //Clear Plugin Info
- ClearPluginInfo(No);
-
- {//Workaround Plugins Loaded 2 Times
- For I := low(PluginPaths) to high(PluginPaths) do
- if (PluginPaths[I] = Filename) then
- exit; }
-
- //Load Libary
- hLibg := LoadLibrary(PChar(DLLPath +PathDelim+ Filename));
- //If Loaded
- if (hLibg <> 0) then
- begin
- //Load Info Procedure
- @Info := GetProcAddress (hLibg, PChar('PluginInfo'));
-
- //If Loaded
- if (@Info <> nil) then
- begin
- //Load PluginInfo
- Info (Plugins[No]);
- Result := True;
- end
- else
- Log.LogError('Could not Load Plugin "' + Filename + '": Info Procedure not Found');
-
- FreeLibrary (hLibg);
- end
- else
- Log.LogError('Could not Load Plugin "' + Filename + '": Libary not Loaded');
-end;
-
-function TDLLMan.LoadPlugin(No: Cardinal): boolean;
-begin
- Result := False;
- //Load Libary
- hLib := LoadLibrary(PChar(DLLPath +PathDelim+ PluginPaths[No]));
- //If Loaded
- if (hLib <> 0) then
- begin
- //Load Info Procedure
- @P_Init := GetProcAddress (hLib, PChar('Init'));
- @P_Draw := GetProcAddress (hLib, PChar('Draw'));
- @P_Finish := GetProcAddress (hLib, PChar('Finish'));
-
- //If Loaded
- if (@P_Init <> nil) And (@P_Draw <> nil) And (@P_Finish <> nil) then
- begin
- Selected := @Plugins[No];
- Result := True;
- end
- else
- begin
- Log.LogError('Could not Load Plugin "' + PluginPaths[No] + '": Procedures not Found');
-
- end;
- end
- else
- Log.LogError('Could not Load Plugin "' + PluginPaths[No] + '": Libary not Loaded');
-end;
-
-procedure TDLLMan.UnLoadPlugin;
-begin
-if (hLib <> 0) then
- FreeLibrary (hLib);
-
-//Selected := nil;
-@P_Init := nil;
-@P_Draw := nil;
-@P_Finish := nil;
-@P_RData := nil;
-end;
-
-function TDLLMan.PluginInit (const TeamInfo: TTeamInfo; var Playerinfo: TPlayerinfo; const Sentences: TSentences; const LoadTex: fModi_LoadTex; const Print: fModi_Print; LoadSound: fModi_LoadSound; PlaySound: pModi_PlaySound): boolean;
-var
- Methods: TMethodRec;
-begin
- Methods.LoadTex := LoadTex;
- Methods.Print := Print;
- Methods.LoadSound := LoadSound;
- Methods.PlaySound := PlaySound;
-
- if (@P_Init <> nil) then
- Result := P_Init (TeamInfo, PlayerInfo, Sentences, Methods)
- else
- Result := False
-end;
-
-function TDLLMan.PluginDraw (var Playerinfo: TPlayerinfo; const CurSentence: Cardinal): boolean;
-begin
-if (@P_Draw <> nil) then
- Result := P_Draw (PlayerInfo, CurSentence)
-else
- Result := False
-end;
-
-function TDLLMan.PluginFinish (var Playerinfo: TPlayerinfo): byte;
-begin
-if (@P_Finish <> nil) then
- Result := P_Finish (PlayerInfo)
-else
- Result := 0;
-end;
-
-procedure TDLLMan.PluginRData (handle: HSTREAM; buffer: Pointer; len: DWORD; user: DWORD);
-begin
-if (@P_RData <> nil) then
- P_RData (handle, buffer, len, user);
-end;
-
-end.
diff --git a/src/classes/UDataBase.pas b/src/classes/UDataBase.pas
deleted file mode 100644
index cd315df3..00000000
--- a/src/classes/UDataBase.pas
+++ /dev/null
@@ -1,533 +0,0 @@
-unit UDataBase;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses USongs,
- USong,
- Classes,
- SQLiteTable3;
-
-//--------------------
-//DataBaseSystem - Class including all DB Methods
-//--------------------
-type
- TStatType = (
- stBestScores, // Best Scores
- stBestSingers, // Best Singers
- stMostSungSong, // Most sung Songs
- stMostPopBand // Most popular Band
- );
-
- // abstract super-class for statistic results
- TStatResult = class
- public
- Typ: TStatType;
- end;
-
- TStatResultBestScores = class(TStatResult)
- public
- Singer: WideString;
- Score: Word;
- Difficulty: Byte;
- SongArtist: WideString;
- SongTitle: WideString;
- end;
-
- TStatResultBestSingers = class(TStatResult)
- public
- Player: WideString;
- AverageScore: Word;
- end;
-
- TStatResultMostSungSong = class(TStatResult)
- public
- Artist: WideString;
- Title: WideString;
- TimesSung: Word;
- end;
-
- TStatResultMostPopBand = class(TStatResult)
- public
- ArtistName: WideString;
- TimesSungTot: Word;
- end;
-
-
- TDataBaseSystem = class
- private
- ScoreDB: TSQLiteDatabase;
- fFilename: string;
-
- function GetVersion(): integer;
- procedure SetVersion(Version: integer);
- public
- property Filename: string read fFilename;
-
- destructor Destroy; override;
-
- procedure Init(const Filename: string);
- procedure ReadScore(Song: TSong);
- procedure AddScore(Song: TSong; Level: integer; const Name: WideString; Score: integer);
- procedure WriteScore(Song: TSong);
-
- function GetStats(Typ: TStatType; Count: Byte; Page: Cardinal; Reversed: Boolean): TList;
- procedure FreeStats(StatList: TList);
- function GetTotalEntrys(Typ: TStatType): Cardinal;
- function GetStatReset: TDateTime;
- end;
-
-var
- DataBase: TDataBaseSystem;
-
-implementation
-
-uses
- ULog,
- DateUtils,
- StrUtils,
- SysUtils;
-
-const
- cDBVersion = 01; // 0.1
- cUS_Scores = 'us_scores';
- cUS_Songs = 'us_songs';
- cUS_Statistics_Info = 'us_statistics_info';
-
-(**
- * Opens Database and Create Tables if not Exist
- *)
-procedure TDataBaseSystem.Init(const Filename: string);
-var
- Version: integer;
-begin
- if Assigned(ScoreDB) then
- Exit;
-
- Log.LogStatus('Initializing database: "'+Filename+'"', 'TDataBaseSystem.Init');
-
- try
-
- // Open Database
- ScoreDB := TSQLiteDatabase.Create(Filename);
- fFilename := Filename;
-
- // Close and delete outdated file
- Version := GetVersion();
- if ((Version <> 0) and (Version <> cDBVersion)) then
- begin
- Log.LogInfo('Outdated cover-database file found', 'TDataBaseSystem.Init');
- // Close and delete outdated file
- ScoreDB.Free;
- if (not DeleteFile(Filename)) then
- raise Exception.Create('Could not delete ' + Filename);
- // Reopen
- ScoreDB := TSQLiteDatabase.Create(Filename);
- Version := 0;
- end;
-
- // Set version number after creation
- if (Version = 0) then
- SetVersion(cDBVersion);
-
-
- // SQLite does not handle VARCHAR(n) or INT(n) as expected.
- // Texts do not have a restricted length, no matter which type is used,
- // so use the native TEXT type. INT(n) is always INTEGER.
- // In addition, SQLiteTable3 will fail if other types than the native SQLite
- // types are used (especially FieldAsInteger). Also take care to write the
- // types in upper-case letters although SQLite does not care about this -
- // SQLiteTable3 is very sensitive in this regard.
-
- ScoreDB.ExecSQL('CREATE TABLE IF NOT EXISTS ['+cUS_Scores+'] (' +
- '[SongID] INTEGER NOT NULL, ' +
- '[Difficulty] INTEGER NOT NULL, ' +
- '[Player] TEXT NOT NULL, ' +
- '[Score] INTEGER NOT NULL' +
- ');');
-
- ScoreDB.ExecSQL('CREATE TABLE IF NOT EXISTS ['+cUS_Songs+'] (' +
- '[ID] INTEGER PRIMARY KEY, ' +
- '[Artist] TEXT NOT NULL, ' +
- '[Title] TEXT NOT NULL, ' +
- '[TimesPlayed] INTEGER NOT NULL' +
- ');');
-
- if not ScoreDB.TableExists(cUS_Statistics_Info) then
- begin
- ScoreDB.ExecSQL('CREATE TABLE IF NOT EXISTS ['+cUS_Statistics_Info+'] (' +
- '[ResetTime] INTEGER' +
- ');');
- // insert creation timestamp
- ScoreDB.ExecSQL(Format('INSERT INTO ['+cUS_Statistics_Info+'] ' +
- '([ResetTime]) VALUES(%d);',
- [DateTimeToUnix(Now())]));
- end;
-
- except
- on E: Exception do
- begin
- Log.LogError(E.Message, 'TDataBaseSystem.Init');
- FreeAndNil(ScoreDB);
- end;
- end;
-
-end;
-
-(**
- * Frees Database
- *)
-destructor TDataBaseSystem.Destroy;
-begin
- Log.LogInfo('TDataBaseSystem.Free', 'TDataBaseSystem.Destroy');
- ScoreDB.Free;
- inherited;
-end;
-
-(**
- * Read Scores into SongArray
- *)
-procedure TDataBaseSystem.ReadScore(Song: TSong);
-var
- TableData: TSQLiteUniTable;
- Difficulty: Integer;
-begin
- if not Assigned(ScoreDB) then
- Exit;
-
- TableData := nil;
-
- try
- // Search Song in DB
- TableData := ScoreDB.GetUniTable(
- 'SELECT [Difficulty], [Player], [Score] FROM ['+cUS_Scores+'] ' +
- 'WHERE [SongID] = (' +
- 'SELECT [ID] FROM ['+cUS_Songs+'] ' +
- 'WHERE [Artist] = ? AND [Title] = ? ' +
- 'LIMIT 1) ' +
- 'ORDER BY [Score] DESC LIMIT 15',
- [UTF8Encode(Song.Artist), UTF8Encode(Song.Title)]);
-
- // Empty Old Scores
- SetLength(Song.Score[0], 0);
- SetLength(Song.Score[1], 0);
- SetLength(Song.Score[2], 0);
-
- // Go through all Entrys
- while (not TableData.EOF) do
- begin
- // Add one Entry to Array
- Difficulty := TableData.FieldAsInteger(TableData.FieldIndex['Difficulty']);
- if ((Difficulty >= 0) and (Difficulty <= 2)) and
- (Length(Song.Score[Difficulty]) < 5) then
- begin
- SetLength(Song.Score[Difficulty], Length(Song.Score[Difficulty]) + 1);
-
- Song.Score[Difficulty, High(Song.Score[Difficulty])].Name :=
- UTF8Decode(TableData.FieldByName['Player']);
- Song.Score[Difficulty, High(Song.Score[Difficulty])].Score :=
- TableData.FieldAsInteger(TableData.FieldIndex['Score']);
- end;
-
- TableData.Next;
- end; // while
-
- except
- for Difficulty := 0 to 2 do
- begin
- SetLength(Song.Score[Difficulty], 1);
- Song.Score[Difficulty, 1].Name := 'Error Reading ScoreDB';
- end;
- end;
-
- TableData.Free;
-end;
-
-(**
- * Adds one new score to DB
- *)
-procedure TDataBaseSystem.AddScore(Song: TSong; Level: integer; const Name: WideString; Score: integer);
-var
- ID: Integer;
- TableData: TSQLiteTable;
-begin
- if not Assigned(ScoreDB) then
- Exit;
-
- // Prevent 0 Scores from being added
- if (Score <= 0) then
- Exit;
-
- TableData := nil;
-
- try
-
- ID := ScoreDB.GetTableValue(
- 'SELECT [ID] FROM ['+cUS_Songs+'] ' +
- 'WHERE [Artist] = ? AND [Title] = ?',
- [UTF8Encode(Song.Artist), UTF8Encode(Song.Title)]);
- if (ID = 0) then
- begin
- // Create song if it does not exist
- ScoreDB.ExecSQL(
- 'INSERT INTO ['+cUS_Songs+'] ' +
- '([ID], [Artist], [Title], [TimesPlayed]) VALUES ' +
- '(NULL, ?, ?, 0);',
- [UTF8Encode(Song.Artist), UTF8Encode(Song.Title)]);
- // Get song-ID
- ID := ScoreDB.GetLastInsertRowID();
- end;
- // Create new entry
- ScoreDB.ExecSQL(
- 'INSERT INTO ['+cUS_Scores+'] ' +
- '([SongID] ,[Difficulty], [Player], [Score]) VALUES ' +
- '(?, ?, ?, ?);',
- [ID, Level, UTF8Encode(Name), Score]);
-
- // Delete last position when there are more than 5 entrys.
- // Fixes crash when there are > 5 ScoreEntrys
- // Note: GetUniTable is not applicable here, as the results are used while
- // table entries are deleted.
- TableData := ScoreDB.GetTable(
- 'SELECT [Player], [Score] FROM ['+cUS_Scores+'] ' +
- 'WHERE [SongID] = ' + InttoStr(ID) + ' AND ' +
- '[Difficulty] = ' + InttoStr(Level) +' ' +
- 'ORDER BY [Score] DESC LIMIT -1 OFFSET 5');
-
- while (not TableData.EOF) do
- begin
- // Note: Score is an int-value, so in contrast to Player, we do not bind
- // this value. Otherwise we had to convert the string to an int to avoid
- // an automatic cast of this field to the TEXT type (although it might even
- // work that way).
- ScoreDB.ExecSQL(
- 'DELETE FROM ['+cUS_Scores+'] ' +
- 'WHERE [SongID] = ' + InttoStr(ID) + ' AND ' +
- '[Difficulty] = ' + InttoStr(Level) +' AND ' +
- '[Player] = ? AND ' +
- '[Score] = ' + TableData.FieldByName['Score'],
- [TableData.FieldByName['Player']]);
-
- TableData.Next;
- end;
-
- except on E: Exception do
- Log.LogError(E.Message, 'TDataBaseSystem.AddScore');
- end;
-
- TableData.Free;
-end;
-
-(**
- * Not needed with new System.
- * Used for increment played count
- *)
-procedure TDataBaseSystem.WriteScore(Song: TSong);
-begin
- if not Assigned(ScoreDB) then
- Exit;
-
- try
- // Increase TimesPlayed
- ScoreDB.ExecSQL(
- 'UPDATE ['+cUS_Songs+'] ' +
- 'SET [TimesPlayed] = [TimesPlayed] + 1 ' +
- 'WHERE [Title] = ? AND [Artist] = ?;',
- [UTF8Encode(Song.Title), UTF8Encode(Song.Artist)]);
- except on E: Exception do
- Log.LogError(E.Message, 'TDataBaseSystem.WriteScore');
- end;
-end;
-
-(**
- * Writes some stats to array.
- * Returns nil if the database is not ready or a list with zero or more statistic
- * entries.
- * Free the result-list with FreeStats() after usage to avoid memory leaks.
- *)
-function TDataBaseSystem.GetStats(Typ: TStatType; Count: Byte; Page: Cardinal; Reversed: Boolean): TList;
-var
- Query: String;
- TableData: TSQLiteUniTable;
- Stat: TStatResult;
-begin
- Result := nil;
-
- if not Assigned(ScoreDB) then
- Exit;
-
- {Todo: Add Prevention that only players with more than 5 scores are selected at type 2}
-
- // Create query
- case Typ of
- stBestScores: begin
- Query := 'SELECT [Player], [Difficulty], [Score], [Artist], [Title] FROM ['+cUS_Scores+'] ' +
- 'INNER JOIN ['+cUS_Songs+'] ON ([SongID] = [ID]) ORDER BY [Score]';
- end;
- stBestSingers: begin
- Query := 'SELECT [Player], ROUND(AVG([Score])) FROM ['+cUS_Scores+'] ' +
- 'GROUP BY [Player] ORDER BY AVG([Score])';
- end;
- stMostSungSong: begin
- Query := 'SELECT [Artist], [Title], [TimesPlayed] FROM ['+cUS_Songs+'] ' +
- 'ORDER BY [TimesPlayed]';
- end;
- stMostPopBand: begin
- Query := 'SELECT [Artist], SUM([TimesPlayed]) FROM ['+cUS_Songs+'] ' +
- 'GROUP BY [Artist] ORDER BY SUM([TimesPlayed])';
- end;
- end;
-
- // Add order direction
- Query := Query + IfThen(Reversed, ' ASC', ' DESC');
-
- // Add limit
- Query := Query + ' LIMIT ' + InttoStr(Count * Page) + ', ' + InttoStr(Count) + ';';
-
- // Execute query
- try
- TableData := ScoreDB.GetUniTable(Query);
- except
- on E: Exception do
- begin
- Log.LogError(E.Message, 'TDataBaseSystem.GetStats');
- Exit;
- end;
- end;
-
- Result := TList.Create;
- Stat := nil;
-
- // Copy result to stats array
- while not TableData.EOF do
- begin
- case Typ of
- stBestScores: begin
- Stat := TStatResultBestScores.Create;
- with TStatResultBestScores(Stat) do
- begin
- Singer := UTF8Decode(TableData.Fields[0]);
- Difficulty := TableData.FieldAsInteger(1);
- Score := TableData.FieldAsInteger(2);
- SongArtist := UTF8Decode(TableData.Fields[3]);
- SongTitle := UTF8Decode(TableData.Fields[4]);
- end;
- end;
- stBestSingers: begin
- Stat := TStatResultBestSingers.Create;
- with TStatResultBestSingers(Stat) do
- begin
- Player := UTF8Decode(TableData.Fields[0]);
- AverageScore := TableData.FieldAsInteger(1);
- end;
- end;
- stMostSungSong: begin
- Stat := TStatResultMostSungSong.Create;
- with TStatResultMostSungSong(Stat) do
- begin
- Artist := UTF8Decode(TableData.Fields[0]);
- Title := UTF8Decode(TableData.Fields[1]);
- TimesSung := TableData.FieldAsInteger(2);
- end;
- end;
- stMostPopBand: begin
- Stat := TStatResultMostPopBand.Create;
- with TStatResultMostPopBand(Stat) do
- begin
- ArtistName := UTF8Decode(TableData.Fields[0]);
- TimesSungTot := TableData.FieldAsInteger(1);
- end;
- end
- else
- Log.LogCritical('Unknown stat-type', 'TDataBaseSystem.GetStats');
- end;
-
- Stat.Typ := Typ;
- Result.Add(Stat);
-
- TableData.Next;
- end;
-
- TableData.Free;
-end;
-
-procedure TDataBaseSystem.FreeStats(StatList: TList);
-var
- I: integer;
-begin
- if (StatList = nil) then
- Exit;
- for I := 0 to StatList.Count-1 do
- TStatResult(StatList[I]).Free;
- StatList.Free;
-end;
-
-(**
- * Gets total number of entrys for a stats query
- *)
-function TDataBaseSystem.GetTotalEntrys(Typ: TStatType): Cardinal;
-var
- Query: String;
-begin
- Result := 0;
-
- if not Assigned(ScoreDB) then
- Exit;
-
- try
- // Create query
- case Typ of
- stBestScores:
- Query := 'SELECT COUNT([SongID]) FROM ['+cUS_Scores+'];';
- stBestSingers:
- Query := 'SELECT COUNT(DISTINCT [Player]) FROM ['+cUS_Scores+'];';
- stMostSungSong:
- Query := 'SELECT COUNT([ID]) FROM ['+cUS_Songs+'];';
- stMostPopBand:
- Query := 'SELECT COUNT(DISTINCT [Artist]) FROM ['+cUS_Songs+'];';
- end;
-
- Result := ScoreDB.GetTableValue(Query);
- except on E: Exception do
- Log.LogError(E.Message, 'TDataBaseSystem.GetTotalEntrys');
- end;
-
-end;
-
-(**
- * Gets reset date of statistic data
- *)
-function TDataBaseSystem.GetStatReset: TDateTime;
-var
- Query: string;
- ResetTime: int64;
-begin
- Result := 0;
-
- if not Assigned(ScoreDB) then
- Exit;
-
- try
- Query := 'SELECT [ResetTime] FROM ['+cUS_Statistics_Info+'];';
- Result := UnixToDateTime(ScoreDB.GetTableValue(Query));
- except on E: Exception do
- Log.LogError(E.Message, 'TDataBaseSystem.GetStatReset');
- end;
-end;
-
-function TDataBaseSystem.GetVersion(): integer;
-begin
- Result := ScoreDB.GetTableValue('PRAGMA user_version');
-end;
-
-procedure TDataBaseSystem.SetVersion(Version: integer);
-begin
- ScoreDB.ExecSQL(Format('PRAGMA user_version = %d', [Version]));
-end;
-
-end.
diff --git a/src/classes/UDraw.pas b/src/classes/UDraw.pas
deleted file mode 100644
index ff0920f5..00000000
--- a/src/classes/UDraw.pas
+++ /dev/null
@@ -1,1390 +0,0 @@
-unit UDraw;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses
- UThemes,
- ModiSDK,
- UGraphicClasses;
-
-procedure SingDraw;
-procedure SingModiDraw (PlayerInfo: TPlayerInfo);
-procedure SingDrawBackground;
-procedure SingDrawOscilloscope(X, Y, W, H: real; NrSound: integer);
-procedure SingDrawNoteLines(Left, Top, Right: real; Space: integer);
-procedure SingDrawLyricHelper(Left, LyricsMid: real);
-procedure SingDrawBeatDelimeters(Left, Top, Right: real; NrLines: integer);
-procedure SingDrawLine(Left, Top, Right: real; NrLines: integer; Space: integer);
-procedure SingDrawPlayerLine(X, Y, W: real; PlayerIndex: integer; Space: integer);
-procedure SingDrawPlayerBGLine(Left, Top, Right: real; NrLines, PlayerIndex: integer; Space: integer);
-
-// TimeBar
-procedure SingDrawTimeBar();
-
-//Draw Editor NoteLines
-procedure EditDrawLine(Left, Top, Right: real; NrLines: integer; Space: integer);
-
-
-type
- TRecR = record
- Top: real;
- Left: real;
- Right: real;
- Bottom: real;
-
- Width: real;
- WMid: real;
- Height: real;
- HMid: real;
-
- Mid: real;
- end;
-
-var
- NotesW: real;
- NotesH: real;
- Starfr: integer;
- StarfrG: integer;
-
- //SingBar
- TickOld: cardinal;
- TickOld2:cardinal;
-
-const
- Przedz = 32;
-
-implementation
-
-uses
- gl,
- UGraphic,
- SysUtils,
- UMusic,
- URecord,
- ULog,
- UScreenSing,
- UScreenSingModi,
- ULyrics,
- UMain,
- TextGL,
- UTexture,
- UDrawTexture,
- UIni,
- Math,
- UDLLManager;
-
-procedure SingDrawBackground;
-var
- Rec: TRecR;
- TexRec: TRecR;
-begin
- if (ScreenSing.Tex_Background.TexNum > 0) then begin
-
- glClearColor (1, 1, 1, 1);
- glColor4f (1, 1, 1, 1);
-
- if (Ini.MovieSize <= 1) then //HalfSize BG
- begin
- (* half screen + gradient *)
- Rec.Top := 110; // 80
- Rec.Bottom := Rec.Top + 20;
- Rec.Left := 0;
- Rec.Right := 800;
-
- TexRec.Top := (Rec.Top / 600) * ScreenSing.Tex_Background.TexH;
- TexRec.Bottom := (Rec.Bottom / 600) * ScreenSing.Tex_Background.TexH;
- TexRec.Left := 0;
- TexRec.Right := ScreenSing.Tex_Background.TexW;
-
- glEnable(GL_TEXTURE_2D);
- glBindTexture(GL_TEXTURE_2D, ScreenSing.Tex_Background.TexNum);
- glEnable(GL_BLEND);
- glBegin(GL_QUADS);
- (* gradient draw *)
- (* top *)
- glColor4f(1, 1, 1, 0);
- glTexCoord2f(TexRec.Right, TexRec.Top); glVertex2f(Rec.Right, Rec.Top);
- glTexCoord2f(TexRec.Left, TexRec.Top); glVertex2f(Rec.Left, Rec.Top);
- glColor4f(1, 1, 1, 1);
- glTexCoord2f(TexRec.Left, TexRec.Bottom); glVertex2f(Rec.Left, Rec.Bottom);
- glTexCoord2f(TexRec.Right, TexRec.Bottom); glVertex2f(Rec.Right, Rec.Bottom);
- (* mid *)
- Rec.Top := Rec.Bottom;
- Rec.Bottom := 490 - 20; // 490 - 20
- TexRec.Top := TexRec.Bottom;
- TexRec.Bottom := (Rec.Bottom / 600) * ScreenSing.Tex_Background.TexH;
- glTexCoord2f(TexRec.Left, TexRec.Top); glVertex2f(Rec.Left, Rec.Top);
- glTexCoord2f(TexRec.Left, TexRec.Bottom); glVertex2f(Rec.Left, Rec.Bottom);
- glTexCoord2f(TexRec.Right, TexRec.Bottom); glVertex2f(Rec.Right, Rec.Bottom);
- glTexCoord2f(TexRec.Right, TexRec.Top); glVertex2f(Rec.Right, Rec.Top);
- (* bottom *)
- Rec.Top := Rec.Bottom;
- Rec.Bottom := 490; // 490
- TexRec.Top := TexRec.Bottom;
- TexRec.Bottom := (Rec.Bottom / 600) * ScreenSing.Tex_Background.TexH;
- glTexCoord2f(TexRec.Right, TexRec.Top); glVertex2f(Rec.Right, Rec.Top);
- glTexCoord2f(TexRec.Left, TexRec.Top); glVertex2f(Rec.Left, Rec.Top);
- glColor4f(1, 1, 1, 0);
- glTexCoord2f(TexRec.Left, TexRec.Bottom); glVertex2f(Rec.Left, Rec.Bottom);
- glTexCoord2f(TexRec.Right, TexRec.Bottom); glVertex2f(Rec.Right, Rec.Bottom);
-
- glEnd;
- glDisable(GL_TEXTURE_2D);
- glDisable(GL_BLEND);
- end
- else //Full Size BG
- begin
- glEnable(GL_TEXTURE_2D);
- glBindTexture(GL_TEXTURE_2D, ScreenSing.Tex_Background.TexNum);
- //glEnable(GL_BLEND);
- glBegin(GL_QUADS);
-
- glTexCoord2f(0, 0); glVertex2f(0, 0);
- glTexCoord2f(0, ScreenSing.Tex_Background.TexH); glVertex2f(0, 600);
- glTexCoord2f( ScreenSing.Tex_Background.TexW, ScreenSing.Tex_Background.TexH); glVertex2f(800, 600);
- glTexCoord2f( ScreenSing.Tex_Background.TexW, 0); glVertex2f(800, 0);
-
- glEnd;
- glDisable(GL_TEXTURE_2D);
- //glDisable(GL_BLEND);
- end;
- end;
-end;
-
-procedure SingDrawOscilloscope(X, Y, W, H: real; NrSound: integer);
-var
- SampleIndex: integer;
- Sound: TCaptureBuffer;
- MaxX, MaxY: real;
-begin;
- Sound := AudioInputProcessor.Sound[NrSound];
-
- // Log.LogStatus('Oscilloscope', 'SingDraw');
- glColor3f(Skin_OscR, Skin_OscG, Skin_OscB);
- {if (ParamStr(1) = '-black') or (ParamStr(1) = '-fsblack') then
- glColor3f(1, 1, 1); }
-
- MaxX := W-1;
- MaxY := (H-1) / 2;
-
- Sound.LockAnalysisBuffer();
-
- glBegin(GL_LINE_STRIP);
- for SampleIndex := 0 to High(Sound.AnalysisBuffer) do
- begin
- glVertex2f(X + MaxX * SampleIndex/High(Sound.AnalysisBuffer),
- Y + MaxY * (1 - Sound.AnalysisBuffer[SampleIndex]/-Low(Smallint)));
- end;
- glEnd;
-
- Sound.UnlockAnalysisBuffer();
-end;
-
-
-
-procedure SingDrawNoteLines(Left, Top, Right: real; Space: integer);
-var
- Count: integer;
-begin
- glEnable(GL_BLEND);
- glColor4f(Skin_P1_LinesR, Skin_P1_LinesG, Skin_P1_LinesB, 0.4);
- glBegin(GL_LINES);
- for Count := 0 to 9 do begin
- glVertex2f(Left, Top + Count * Space);
- glVertex2f(Right, Top + Count * Space);
- end;
- glEnd;
- glDisable(GL_BLEND);
-end;
-
-procedure SingDrawBeatDelimeters(Left, Top, Right: real; NrLines: integer);
-var
- Count: integer;
- TempR: real;
-begin
- TempR := (Right-Left) / (Lines[NrLines].Line[Lines[NrLines].Current].End_ - Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start);
- glEnable(GL_BLEND);
- glBegin(GL_LINES);
- for Count := Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start to Lines[NrLines].Line[Lines[NrLines].Current].End_ do begin
- if (Count mod Lines[NrLines].Resolution) = Lines[NrLines].NotesGAP then
- glColor4f(0, 0, 0, 1)
- else
- glColor4f(0, 0, 0, 0.3);
- glVertex2f(Left + TempR * (Count - Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start), Top);
- glVertex2f(Left + TempR * (Count - Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start), Top + 135);
- end;
- glEnd;
- glDisable(GL_BLEND);
-end;
-
-// draw blank Notebars
-procedure SingDrawLine(Left, Top, Right: real; NrLines: integer; Space: integer);
-var
- Rec: TRecR;
- Count: integer;
- TempR: real;
- R,G,B: real;
-
- PlayerNumber: Integer;
-
- GoldenStarPos : real;
-
- lTmpA ,
- lTmpB : real;
-begin
-// We actually don't have a playernumber in this procedure, it should reside in NrLines - but it's always set to zero
-// So we exploit this behavior a bit - we give NrLines the playernumber, keep it in playernumber - and then we set NrLines to zero
-// This could also come quite in handy when we do the duet mode, cause just the notes for the player that has to sing should be drawn then
-// BUT this is not implemented yet, all notes are drawn! :D
-
- PlayerNumber := NrLines + 1; // Player 1 is 0
- NrLines := 0;
-
-// exploit done
-
- glColor3f(1, 1, 1);
- glEnable(GL_TEXTURE_2D);
- glEnable(GL_BLEND);
- glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
-
- lTmpA := (Right-Left);
- lTmpB := (Lines[NrLines].Line[Lines[NrLines].Current].End_ - Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start);
-
- if ( lTmpA > 0 ) AND
- ( lTmpB > 0 ) THEN
- begin
- TempR := lTmpA / lTmpB;
- end
- else
- begin
- TempR := 0;
- end;
-
-
- with Lines[NrLines].Line[Lines[NrLines].Current] do begin
- for Count := 0 to HighNote do begin
- with Note[Count] do begin
- if NoteType <> ntFreestyle then begin
-
-
- if Ini.EffectSing = 0 then
- // If Golden note Effect of then Change not Color
- begin
- case NoteType of
- ntNormal: glColor4f(1, 1, 1, 1); // We set alpha to 1, cause we can control the transparency through the png itself
- ntGolden: glColor4f(1, 1, 0.3, 1); // no stars, paint yellow -> glColor4f(1, 1, 0.3, 0.85); - we could
- end; // case
- end //Else all Notes same Color
- else
- glColor4f(1, 1, 1, 1); // We set alpha to 1, cause we can control the transparency through the png itself
- // Czesci == teil, element == piece, element | koniec == end / ending
- // lewa czesc - left part
- Rec.Left := (Start-Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start) * TempR + Left + 0.5 + 10*ScreenX;
- Rec.Right := Rec.Left + NotesW;
- Rec.Top := Top - (Tone-BaseNote)*Space/2 - NotesH;
- Rec.Bottom := Rec.Top + 2 * NotesH;
- glBindTexture(GL_TEXTURE_2D, Tex_plain_Left[PlayerNumber].TexNum);
- glBegin(GL_QUADS);
- glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top);
- glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom);
- glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom);
- glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top);
- glEnd;
-
- //We keep the postion of the top left corner b4 it's overwritten
- GoldenStarPos := Rec.Left;
- //done
-
- // srodkowa czesc - middle part
- Rec.Left := Rec.Right;
- Rec.Right := (Start+Length-Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start) * TempR + Left - NotesW - 0.5 + 10*ScreenX; // Dlugosc == length
-
- glBindTexture(GL_TEXTURE_2D, Tex_plain_Mid[PlayerNumber].TexNum);
- glTexParameterf( GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT );
- glTexParameterf( GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT );
- glBegin(GL_QUADS);
- glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top);
- glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom);
- glTexCoord2f(round((Rec.Right-Rec.Left)/32), 1); glVertex2f(Rec.Right, Rec.Bottom);
- glTexCoord2f(round((Rec.Right-Rec.Left)/32), 0); glVertex2f(Rec.Right, Rec.Top);
- glEnd;
-
- // prawa czesc - right part
- Rec.Left := Rec.Right;
- Rec.Right := Rec.Right + NotesW;
-
- glBindTexture(GL_TEXTURE_2D, Tex_plain_Right[PlayerNumber].TexNum);
- glBegin(GL_QUADS);
- glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top);
- glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom);
- glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom);
- glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top);
- glEnd;
-
- // Golden Star Patch
- if (NoteType = ntGolden) AND (Ini.EffectSing=1) then
- begin
- GoldenRec.SaveGoldenStarsRec(GoldenStarPos, Rec.Top, Rec.Right, Rec.Bottom);
- end;
-
- end; // if not FreeStyle
- end; // with
- end; // for
- end; // with
-
- glDisable(GL_BLEND);
- glDisable(GL_TEXTURE_2D);
-end;
-
-
-// draw sung notes
-procedure SingDrawPlayerLine(X, Y, W: real; PlayerIndex: integer; Space: integer);
-var
- TempR: real;
- Rec: TRecR;
- N: integer;
- R, G, B, A: real;
- NotesH2: real;
-begin
- //Log.LogStatus('Player notes', 'SingDraw');
-
- //if NrGracza = 0 then LoadColor(R, G, B, 'P1Light')
- //else LoadColor(R, G, B, 'P2Light');
-
- //R := 71/255;
- //G := 175/255;
- //B := 247/255;
-
- glColor3f(1, 1, 1);
- glEnable(GL_TEXTURE_2D);
- glEnable(GL_BLEND);
- glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
-
- //if Player[NrGracza].LengthNote > 0 then
- begin
- TempR := W / (Lines[0].Line[Lines[0].Current].End_ - Lines[0].Line[Lines[0].Current].Note[0].Start);
- for N := 0 to Player[PlayerIndex].HighNote do
- begin
- with Player[PlayerIndex].Note[N] do
- begin
- // Left part of note
- Rec.Left := X + (Start-Lines[0].Line[Lines[0].Current].Note[0].Start) * TempR + 0.5 + 10*ScreenX;
- Rec.Right := Rec.Left + NotesW;
-
- // Draw it in half size, if not hit
- if Hit then
- begin
- NotesH2 := NotesH
- end
- else
- begin
- NotesH2 := int(NotesH * 0.65);
- end;
-
- Rec.Top := Y - (Tone-Lines[0].Line[Lines[0].Current].BaseNote)*Space/2 - NotesH2;
- Rec.Bottom := Rec.Top + 2 *NotesH2;
-
- // draw the left part
- glColor3f(1, 1, 1);
- glBindTexture(GL_TEXTURE_2D, Tex_Left[PlayerIndex+1].TexNum);
- glBegin(GL_QUADS);
- glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top);
- glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom);
- glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom);
- glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top);
- glEnd;
-
- // Middle part of the note
- Rec.Left := Rec.Right;
- Rec.Right := X + (Start+Length-Lines[0].Line[Lines[0].Current].Note[0].Start) * TempR - NotesW - 0.5 + 10*ScreenX;
-
- // (nowe) - dunno
- if (Start+Length-1 = LyricsState.CurrentBeatD) then
- Rec.Right := Rec.Right - (1-Frac(LyricsState.MidBeatD)) * TempR;
- // the left note is more right than the right note itself, sounds weird - so we fix that xD
- if Rec.Right <= Rec.Left then
- Rec.Right := Rec.Left;
-
- // draw the middle part
- glBindTexture(GL_TEXTURE_2D, Tex_Mid[PlayerIndex+1].TexNum);
- glTexParameterf( GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT );
- glTexParameterf( GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT );
- glBegin(GL_QUADS);
- glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top);
- glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom);
- glTexCoord2f(round((Rec.Right-Rec.Left)/32), 1); glVertex2f(Rec.Right, Rec.Bottom);
- glTexCoord2f(round((Rec.Right-Rec.Left)/32), 0); glVertex2f(Rec.Right, Rec.Top);
- glEnd;
- glColor3f(1, 1, 1);
-
- // the right part of the note
- Rec.Left := Rec.Right;
- Rec.Right := Rec.Right + NotesW;
-
- glBindTexture(GL_TEXTURE_2D, Tex_Right[PlayerIndex+1].TexNum);
- glBegin(GL_QUADS);
- glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top);
- glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom);
- glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom);
- glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top);
- glEnd;
-
- // Perfect note is stored
- if Perfect and (Ini.EffectSing=1) then
- begin
- A := 1 - 2*(LyricsState.GetCurrentTime() - GetTimeFromBeat(Start+Length));
- if not (Start+Length-1 = LyricsState.CurrentBeatD) then
- begin
- //Star animation counter
- //inc(Starfr);
- //Starfr := Starfr mod 128;
- GoldenRec.SavePerfectNotePos(Rec.Left, Rec.Top);
- end;
- end;
- end; // with
- end; // for
-
- // actually we need a comparison here, to determine if the singing process
- // is ahead Rec.Right even if there is no singing
-
- if (Ini.EffectSing = 1) then
- GoldenRec.GoldenNoteTwinkle(Rec.Top,Rec.Bottom,Rec.Right, PlayerIndex);
- end; // if
-end;
-
-//draw Note glow
-procedure SingDrawPlayerBGLine(Left, Top, Right: real; NrLines, PlayerIndex: integer; Space: integer);
-var
- Rec: TRecR;
- Count: integer;
- TempR: real;
- R,G,B: real;
- X1, X2, X3, X4: real;
- W, H: real;
-
- lTmpA ,
- lTmpB : real;
-begin
- if (Player[PlayerIndex].ScoreTotalInt >= 0) then
- begin
- glColor4f(1, 1, 1, sqrt((1+sin( AudioPlayback.Position * 3))/4)/ 2 + 0.5 );
- glEnable(GL_TEXTURE_2D);
- glEnable(GL_BLEND);
- glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
-
- lTmpA := (Right-Left);
- lTmpB := (Lines[NrLines].Line[Lines[NrLines].Current].End_ - Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start);
-
- if ( lTmpA > 0 ) and
- ( lTmpB > 0 ) then
- begin
- TempR := lTmpA / lTmpB;
- end
- else
- begin
- TempR := 0;
- end;
-
- with Lines[NrLines].Line[Lines[NrLines].Current] do
- begin
- for Count := 0 to HighNote do
- begin
- with Note[Count] do
- begin
- if NoteType <> ntFreestyle then
- begin
- // begin: 14, 20
- // easy: 6, 11
- W := NotesW * 2 + 2;
- H := NotesH * 1.5 + 3.5;
-
- X2 := (Start-Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start) * TempR + Left + 0.5 + 10*ScreenX + 4; // wciecie
- X1 := X2-W;
-
- X3 := (Start+Length-Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start) * TempR + Left - 0.5 + 10*ScreenX - 4; // wciecie
- X4 := X3+W;
-
- // left
- Rec.Left := X1;
- Rec.Right := X2;
- Rec.Top := Top - (Tone-BaseNote)*Space/2 - H;
- Rec.Bottom := Rec.Top + 2 * H;
-
- glBindTexture(GL_TEXTURE_2D, Tex_BG_Left[PlayerIndex+1].TexNum);
- glBegin(GL_QUADS);
- glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top);
- glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom);
- glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom);
- glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top);
- glEnd;
-
- // srodkowa czesc
- Rec.Left := X2;
- Rec.Right := X3;
-
- glBindTexture(GL_TEXTURE_2D, Tex_BG_Mid[PlayerIndex+1].TexNum);
- glBegin(GL_QUADS);
- glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top);
- glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom);
- glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom);
- glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top);
- glEnd;
-
- // prawa czesc
- Rec.Left := X3;
- Rec.Right := X4;
-
- glBindTexture(GL_TEXTURE_2D, Tex_BG_Right[PlayerIndex+1].TexNum);
- glBegin(GL_QUADS);
- glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top);
- glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom);
- glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom);
- glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top);
- glEnd;
- end; // if not FreeStyle
- end; // with
- end; // for
- end; // with
-
- glDisable(GL_BLEND);
- glDisable(GL_TEXTURE_2D);
- end;
-end;
-
-(**
- * Draws the lyrics helper bar.
- * Left: position the bar starts at
- * LyricsMid: the middle of the lyrics relative to the position Left
- *)
-procedure SingDrawLyricHelper(Left, LyricsMid: real);
-var
- Bounds: TRecR; // bounds of the lyric help bar
- BarProgress: real; // progress of the lyrics helper
- BarMoveDelta: real; // current beat relative to the beat the bar starts to move at
- BarAlpha: real; // transparency
- CurLine: PLine; // current lyric line (beat specific)
- LineWidth: real; // lyric line width
- FirstNoteBeat: integer; // beat of the first note in the current line
- FirstNoteDelta: integer; // time in beats between the start of the current line and its first note
- MoveStartX: real; // x-pos. the bar starts to move from
- MoveDist: real; // number of pixels the bar will move
- LyricEngine: TLyricEngine;
-const
- BarWidth = 50; // width of the lyric helper bar
- BarHeight = 30; // height of the lyric helper bar
- BarMoveLimit = 40; // max. number of beats remaining before the bar starts to move
-begin
- // get current lyrics line and the time in beats of its first note
- CurLine := @Lines[0].Line[Lines[0].Current];
-
- // FIXME: accessing ScreenSing is not that generic
- LyricEngine := ScreenSing.Lyrics;
-
- // do not draw the lyrics helper if the current line does not contain any note
- if (Length(CurLine.Note) > 0) then
- begin
- // start beat of the first note of this line
- FirstNoteBeat := CurLine.Note[0].Start;
- // time in beats between the start of the current line and its first note
- FirstNoteDelta := FirstNoteBeat - CurLine.Start;
-
- // beats from current beat to the first note of the line
- BarMoveDelta := FirstNoteBeat - LyricsState.MidBeat;
-
- if (FirstNoteDelta > 8) and // if the wait-time is large enough
- (BarMoveDelta > 0) then // and the first note of the line is not reached
- begin
- // let the bar blink to the beat
- BarAlpha := 0.75 + cos(BarMoveDelta/2) * 0.25;
-
- // if the number of beats to the first note is too big,
- // the bar stays on the left side.
- if (BarMoveDelta > BarMoveLimit) then
- BarMoveDelta := BarMoveLimit;
-
- // limit number of beats the bar moves
- if (FirstNoteDelta > BarMoveLimit) then
- FirstNoteDelta := BarMoveLimit;
-
- // calc bar progress
- BarProgress := 1 - BarMoveDelta / FirstNoteDelta;
-
- // retrieve the width of the upper lyrics line on the display
- if (LyricEngine.GetUpperLine() <> nil) then
- LineWidth := LyricEngine.GetUpperLine().Width
- else
- LineWidth := 0;
-
- // distance the bar will move (LyricRec.Left to beginning of text)
- MoveDist := LyricsMid - LineWidth / 2 - BarWidth;
- // if the line is too long the helper might move from right to left
- // so we have to assure the start position is left of the text.
- if (MoveDist >= 0) then
- MoveStartX := Left
- else
- MoveStartX := Left + MoveDist;
-
- // determine lyric help bar position and size
- Bounds.Left := MoveStartX + BarProgress * MoveDist;
- Bounds.Right := Bounds.Left + BarWidth;
- Bounds.Top := Skin_LyricsT + 3;
- Bounds.Bottom := Bounds.Top + BarHeight + 3;
-
- // draw lyric help bar
- glEnable(GL_TEXTURE_2D);
- glEnable(GL_BLEND);
- glColor4f(1, 1, 1, BarAlpha);
- glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
- glBindTexture(GL_TEXTURE_2D, Tex_Lyric_Help_Bar.TexNum);
- glBegin(GL_QUADS);
- glTexCoord2f(0, 0); glVertex2f(Bounds.Left, Bounds.Top);
- glTexCoord2f(0, 1); glVertex2f(Bounds.Left, Bounds.Bottom);
- glTexCoord2f(1, 1); glVertex2f(Bounds.Right, Bounds.Bottom);
- glTexCoord2f(1, 0); glVertex2f(Bounds.Right, Bounds.Top);
- glEnd;
- glDisable(GL_BLEND);
- end;
- end;
-end;
-
-procedure SingDraw;
-var
- NR: TRecR; // lyrics area bounds (NR = NoteRec?)
- LyricEngine: TLyricEngine;
-begin
- // positions
- if Ini.SingWindow = 0 then
- NR.Left := 120
- else
- NR.Left := 20;
-
- NR.Right := 780;
-
- NR.Width := NR.Right - NR.Left;
- NR.WMid := NR.Width / 2;
- NR.Mid := NR.Left + NR.WMid;
-
- // FIXME: accessing ScreenSing is not that generic
- LyricEngine := ScreenSing.Lyrics;
-
- // background //BG Fullsize Mod
- //SingDrawBackground;
-
- // draw time-bar
- SingDrawTimeBar();
-
- // draw note-lines
-
- if (PlayersPlay = 1) and (Ini.NoteLines = 1) then
- SingDrawNoteLines(Nr.Left + 10*ScreenX, Skin_P2_NotesB - 105, Nr.Right + 10*ScreenX, 15);
-
- if ((PlayersPlay = 2) or (PlayersPlay = 4)) and (Ini.NoteLines = 1) then
- begin
- SingDrawNoteLines(Nr.Left + 10*ScreenX, Skin_P1_NotesB - 105, Nr.Right + 10*ScreenX, 15);
- SingDrawNoteLines(Nr.Left + 10*ScreenX, Skin_P2_NotesB - 105, Nr.Right + 10*ScreenX, 15);
- end;
-
- if ((PlayersPlay = 3) or (PlayersPlay = 6)) and (Ini.NoteLines = 1) then begin
- SingDrawNoteLines(Nr.Left + 10*ScreenX, 120, Nr.Right + 10*ScreenX, 12);
- SingDrawNoteLines(Nr.Left + 10*ScreenX, 245, Nr.Right + 10*ScreenX, 12);
- SingDrawNoteLines(Nr.Left + 10*ScreenX, 370, Nr.Right + 10*ScreenX, 12);
- end;
-
- // draw Lyrics
- LyricEngine.Draw(LyricsState.MidBeat);
- SingDrawLyricHelper(NR.Left, NR.WMid);
-
- // oscilloscope
- if Ini.Oscilloscope = 1 then begin
- if PlayersPlay = 1 then
- SingDrawOscilloscope(190 + 10*ScreenX, 55, 180, 40, 0);
-
- if PlayersPlay = 2 then begin
- SingDrawOscilloscope(190 + 10*ScreenX, 55, 180, 40, 0);
- SingDrawOscilloscope(425 + 10*ScreenX, 55, 180, 40, 1);
- end;
-
- if PlayersPlay = 4 then begin
- if ScreenAct = 1 then begin
- SingDrawOscilloscope(190 + 10*ScreenX, 55, 180, 40, 0);
- SingDrawOscilloscope(425 + 10*ScreenX, 55, 180, 40, 1);
- end;
- if ScreenAct = 2 then begin
- SingDrawOscilloscope(190 + 10*ScreenX, 55, 180, 40, 2);
- SingDrawOscilloscope(425 + 10*ScreenX, 55, 180, 40, 3);
- end;
- end;
-
- if PlayersPlay = 3 then begin
- SingDrawOscilloscope(75 + 10*ScreenX, 95, 100, 20, 0);
- SingDrawOscilloscope(370 + 10*ScreenX, 95, 100, 20, 1);
- SingDrawOscilloscope(670 + 10*ScreenX, 95, 100, 20, 2);
- end;
-
- if PlayersPlay = 6 then begin
- if ScreenAct = 1 then begin
- SingDrawOscilloscope( 75 + 10*ScreenX, 95, 100, 20, 0);
- SingDrawOscilloscope(370 + 10*ScreenX, 95, 100, 20, 1);
- SingDrawOscilloscope(670 + 10*ScreenX, 95, 100, 20, 2);
- end;
- if ScreenAct = 2 then begin
- SingDrawOscilloscope( 75 + 10*ScreenX, 95, 100, 20, 3);
- SingDrawOscilloscope(370 + 10*ScreenX, 95, 100, 20, 4);
- SingDrawOscilloscope(670 + 10*ScreenX, 95, 100, 20, 5);
- end;
- end;
-
- end;
-
- // Set the note heights according to the difficulty level
- case Ini.Difficulty of
- 0:
- begin
- NotesH := 11; // 9
- NotesW := 6; // 5
- end;
- 1:
- begin
- NotesH := 8; // 7
- NotesW := 4; // 4
- end;
- 2:
- begin
- NotesH := 5;
- NotesW := 3;
- end;
- end;
-
- // Draw the Notes
- if PlayersPlay = 1 then begin
- SingDrawPlayerBGLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 0, 15); // Background glow - colorized in playercolor
- SingDrawLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 15); // Plain unsung notes - colorized in playercolor
- SingDrawPlayerLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 0, 15); // imho the sung notes
- end;
-
- if (PlayersPlay = 2) then begin
- SingDrawPlayerBGLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 0, 15);
- SingDrawPlayerBGLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 1, 15);
-
- SingDrawLine(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 15);
- SingDrawLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 1, 15);
-
- SingDrawPlayerLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 0, 15);
- SingDrawPlayerLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 1, 15);
- end;
-
- if PlayersPlay = 3 then begin
- NotesW := NotesW * 0.8;
- NotesH := NotesH * 0.8;
-
- SingDrawPlayerBGLine(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 0, 12);
- SingDrawPlayerBGLine(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 1, 12);
- SingDrawPlayerBGLine(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 2, 12);
-
- SingDrawLine(NR.Left + 20, 120+95, NR.Right - 20, 0, 12);
- SingDrawLine(NR.Left + 20, 245+95, NR.Right - 20, 1, 12);
- SingDrawLine(NR.Left + 20, 370+95, NR.Right - 20, 2, 12);
-
- SingDrawPlayerLine(Nr.Left + 20, 120+95, Nr.Width - 40, 0, 12);
- SingDrawPlayerLine(Nr.Left + 20, 245+95, Nr.Width - 40, 1, 12);
- SingDrawPlayerLine(Nr.Left + 20, 370+95, Nr.Width - 40, 2, 12);
- end;
-
- if PlayersPlay = 4 then begin
- if ScreenAct = 1 then begin
- SingDrawPlayerBGLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 0, 15);
- SingDrawPlayerBGLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 1, 15);
- end;
- if ScreenAct = 2 then begin
- SingDrawPlayerBGLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 2, 15);
- SingDrawPlayerBGLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 3, 15);
- end;
-
- if ScreenAct = 1 then begin
- SingDrawLine(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 15);
- SingDrawLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 1, 15);
- end;
- if ScreenAct = 2 then begin
- SingDrawLine(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 2, 15);
- SingDrawLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 3, 15);
- end;
-
- if ScreenAct = 1 then begin
- SingDrawPlayerLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 0, 15);
- SingDrawPlayerLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 1, 15);
- end;
- if ScreenAct = 2 then begin
- SingDrawPlayerLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 2, 15);
- SingDrawPlayerLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 3, 15);
- end;
- end;
-
- if PlayersPlay = 6 then begin
- NotesW := NotesW * 0.8;
- NotesH := NotesH * 0.8;
-
- if ScreenAct = 1 then begin
- SingDrawPlayerBGLine(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 0, 12);
- SingDrawPlayerBGLine(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 1, 12);
- SingDrawPlayerBGLine(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 2, 12);
- end;
- if ScreenAct = 2 then begin
- SingDrawPlayerBGLine(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 3, 12);
- SingDrawPlayerBGLine(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 4, 12);
- SingDrawPlayerBGLine(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 5, 12);
- end;
-
- if ScreenAct = 1 then begin
- SingDrawLine(NR.Left + 20, 120+95, NR.Right - 20, 0, 12);
- SingDrawLine(NR.Left + 20, 245+95, NR.Right - 20, 1, 12);
- SingDrawLine(NR.Left + 20, 370+95, NR.Right - 20, 2, 12);
- end;
- if ScreenAct = 2 then begin
- SingDrawLine(NR.Left + 20, 120+95, NR.Right - 20, 3, 12);
- SingDrawLine(NR.Left + 20, 245+95, NR.Right - 20, 4, 12);
- SingDrawLine(NR.Left + 20, 370+95, NR.Right - 20, 5, 12);
- end;
-
- if ScreenAct = 1 then begin
- SingDrawPlayerLine(Nr.Left + 20, 120+95, Nr.Width - 40, 0, 12);
- SingDrawPlayerLine(Nr.Left + 20, 245+95, Nr.Width - 40, 1, 12);
- SingDrawPlayerLine(Nr.Left + 20, 370+95, Nr.Width - 40, 2, 12);
- end;
- if ScreenAct = 2 then begin
- SingDrawPlayerLine(Nr.Left + 20, 120+95, Nr.Width - 40, 3, 12);
- SingDrawPlayerLine(Nr.Left + 20, 245+95, Nr.Width - 40, 4, 12);
- SingDrawPlayerLine(Nr.Left + 20, 370+95, Nr.Width - 40, 5, 12);
- end;
- end;
- glDisable(GL_BLEND);
- glDisable(GL_TEXTURE_2D);
-end;
-
-// q'n'd for using the game mode dll's
-procedure SingModiDraw (PlayerInfo: TPlayerInfo);
-var
- Count: integer;
- Pet2: integer;
- TempR: real;
- Rec: TRecR;
- TexRec: TRecR;
- NR: TRecR;
- FS: real;
- BarFrom: integer;
- BarAlpha: real;
- BarWspol: real;
- TempCol: real;
- Tekst: string;
- PetCz: integer;
-begin
- // positions
- if Ini.SingWindow = 0 then begin
- NR.Left := 120;
- end else begin
- NR.Left := 20;
- end;
-
- NR.Right := 780;
- NR.Width := NR.Right - NR.Left;
- NR.WMid := NR.Width / 2;
- NR.Mid := NR.Left + NR.WMid;
-
- // time bar
- SingDrawTimeBar();
-
- if DLLMan.Selected.ShowNotes then
- begin
- if PlayersPlay = 1 then
- SingDrawNoteLines(Nr.Left + 10*ScreenX, Skin_P2_NotesB - 105, Nr.Right + 10*ScreenX, 15);
- if (PlayersPlay = 2) or (PlayersPlay = 4) then begin
- SingDrawNoteLines(Nr.Left + 10*ScreenX, Skin_P1_NotesB - 105, Nr.Right + 10*ScreenX, 15);
- SingDrawNoteLines(Nr.Left + 10*ScreenX, Skin_P2_NotesB - 105, Nr.Right + 10*ScreenX, 15);
- end;
-
- if (PlayersPlay = 3) or (PlayersPlay = 6) then begin
- SingDrawNoteLines(Nr.Left + 10*ScreenX, 120, Nr.Right + 10*ScreenX, 12);
- SingDrawNoteLines(Nr.Left + 10*ScreenX, 245, Nr.Right + 10*ScreenX, 12);
- SingDrawNoteLines(Nr.Left + 10*ScreenX, 370, Nr.Right + 10*ScreenX, 12);
- end;
- end;
-
- // Draw Lyrics
- ScreenSingModi.Lyrics.Draw(LyricsState.MidBeat);
-
- // todo: Lyrics
-{ // rysuje pasek, podpowiadajacy poczatek spiwania w scenie
- FS := 1.3;
- BarFrom := Lines[0].Line[Lines[0].Current].StartNote - Lines[0].Line[Lines[0].Current].Start;
- if BarFrom > 40 then BarFrom := 40;
- if (Lines[0].Line[Lines[0].Current].StartNote - Lines[0].Line[Lines[0].Current].Start > 8) and // dluga przerwa //16->12 for more help bars and then 12->8 for even more
- (Lines[0].Line[Lines[0].Current].StartNote - LyricsState.MidBeat > 0) and // przed tekstem
- (Lines[0].Line[Lines[0].Current].StartNote - LyricsState.MidBeat < 40) then begin // ale nie za wczesnie
- BarWspol := (LyricsState.MidBeat - (Lines[0].Line[Lines[0].Current].StartNote - BarFrom)) / BarFrom;
- Rec.Left := NR.Left + BarWspol * (ScreenSingModi.LyricMain.ClientX - NR.Left - 50) + 10*ScreenX;
- Rec.Right := Rec.Left + 50;
- Rec.Top := Skin_LyricsT + 3;
- Rec.Bottom := Rec.Top + 33;//SingScreen.LyricMain.Size * 3;
-
- glEnable(GL_TEXTURE_2D);
- glEnable(GL_BLEND);
- glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
- glBindTexture(GL_TEXTURE_2D, Tex_Lyric_Help_Bar.TexNum);
- glBegin(GL_QUADS);
- glColor4f(1, 1, 1, 0);
- glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top);
- glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom);
- glColor4f(1, 1, 1, 0.5);
- glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom);
- glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top);
- glEnd;
- glDisable(GL_BLEND);
- end;
- }
-
- // oscilloscope | the thing that moves when you yell into your mic (imho)
- if (((Ini.Oscilloscope = 1) AND (DLLMan.Selected.ShowRateBar_O)) AND (NOT DLLMan.Selected.ShowRateBar)) then begin
- if PlayersPlay = 1 then
- if PlayerInfo.Playerinfo[0].Enabled then
- SingDrawOscilloscope(190 + 10*ScreenX, 55, 180, 40, 0);
-
- if PlayersPlay = 2 then begin
- if PlayerInfo.Playerinfo[0].Enabled then
- SingDrawOscilloscope(190 + 10*ScreenX, 55, 180, 40, 0);
- if PlayerInfo.Playerinfo[1].Enabled then
- SingDrawOscilloscope(425 + 10*ScreenX, 55, 180, 40, 1);
- end;
-
- if PlayersPlay = 4 then begin
- if ScreenAct = 1 then begin
- if PlayerInfo.Playerinfo[0].Enabled then
- SingDrawOscilloscope(190 + 10*ScreenX, 55, 180, 40, 0);
- if PlayerInfo.Playerinfo[1].Enabled then
- SingDrawOscilloscope(425 + 10*ScreenX, 55, 180, 40, 1);
- end;
- if ScreenAct = 2 then begin
- if PlayerInfo.Playerinfo[2].Enabled then
- SingDrawOscilloscope(190 + 10*ScreenX, 55, 180, 40, 2);
- if PlayerInfo.Playerinfo[3].Enabled then
- SingDrawOscilloscope(425 + 10*ScreenX, 55, 180, 40, 3);
- end;
- end;
-
- if PlayersPlay = 3 then begin
- if PlayerInfo.Playerinfo[0].Enabled then
- SingDrawOscilloscope(75 + 10*ScreenX, 95, 100, 20, 0);
- if PlayerInfo.Playerinfo[1].Enabled then
- SingDrawOscilloscope(370 + 10*ScreenX, 95, 100, 20, 1);
- if PlayerInfo.Playerinfo[2].Enabled then
- SingDrawOscilloscope(670 + 10*ScreenX, 95, 100, 20, 2);
- end;
-
- if PlayersPlay = 6 then begin
- if ScreenAct = 1 then begin
- if PlayerInfo.Playerinfo[0].Enabled then
- SingDrawOscilloscope( 75 + 10*ScreenX, 95, 100, 20, 0);
- if PlayerInfo.Playerinfo[1].Enabled then
- SingDrawOscilloscope(370 + 10*ScreenX, 95, 100, 20, 1);
- if PlayerInfo.Playerinfo[2].Enabled then
- SingDrawOscilloscope(670 + 10*ScreenX, 95, 100, 20, 2);
- end;
- if ScreenAct = 2 then begin
- if PlayerInfo.Playerinfo[3].Enabled then
- SingDrawOscilloscope( 75 + 10*ScreenX, 95, 100, 20, 3);
- if PlayerInfo.Playerinfo[4].Enabled then
- SingDrawOscilloscope(370 + 10*ScreenX, 95, 100, 20, 4);
- if PlayerInfo.Playerinfo[5].Enabled then
- SingDrawOscilloscope(670 + 10*ScreenX, 95, 100, 20, 5);
- end;
- end;
-
- end;
-
-// resize the notes according to the difficulty level
- case Ini.Difficulty of
- 0:
- begin
- NotesH := 11; // 9
- NotesW := 6; // 5
- end;
- 1:
- begin
- NotesH := 8; // 7
- NotesW := 4; // 4
- end;
- 2:
- begin
- NotesH := 5;
- NotesW := 3;
- end;
- end;
-
- if (DLLMAn.Selected.ShowNotes And DLLMan.Selected.LoadSong) then
- begin
- if (PlayersPlay = 1) And PlayerInfo.Playerinfo[0].Enabled then begin
- SingDrawPlayerBGLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 0, 15);
- SingDrawLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 15);
- SingDrawPlayerLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 0, 15);
- end;
-
- if (PlayersPlay = 2) then begin
- if PlayerInfo.Playerinfo[0].Enabled then
- begin
- SingDrawPlayerBGLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 0, 15);
- SingDrawLine(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 15);
- SingDrawPlayerLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 0, 15);
- end;
- if PlayerInfo.Playerinfo[1].Enabled then
- begin
- SingDrawPlayerBGLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 1, 15);
- SingDrawLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 15);
- SingDrawPlayerLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 1, 15);
- end;
-
- end;
-
- if PlayersPlay = 3 then begin
- NotesW := NotesW * 0.8;
- NotesH := NotesH * 0.8;
-
- if PlayerInfo.Playerinfo[0].Enabled then
- begin
- SingDrawPlayerBGLine(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 0, 12);
- SingDrawLine(NR.Left + 20, 120+95, NR.Right - 20, 0, 12);
- SingDrawPlayerLine(Nr.Left + 20, 120+95, Nr.Width - 40, 0, 12);
- end;
-
- if PlayerInfo.Playerinfo[1].Enabled then
- begin
- SingDrawPlayerBGLine(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 1, 12);
- SingDrawLine(NR.Left + 20, 245+95, NR.Right - 20, 0, 12);
- SingDrawPlayerLine(Nr.Left + 20, 245+95, Nr.Width - 40, 1, 12);
- end;
-
- if PlayerInfo.Playerinfo[2].Enabled then
- begin
- SingDrawPlayerBGLine(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 2, 12);
- SingDrawLine(NR.Left + 20, 370+95, NR.Right - 20, 0, 12);
- SingDrawPlayerLine(Nr.Left + 20, 370+95, Nr.Width - 40, 2, 12);
- end;
- end;
-
- if PlayersPlay = 4 then begin
- if ScreenAct = 1 then begin
- SingDrawPlayerBGLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 0, 15);
- SingDrawPlayerBGLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 1, 15);
- end;
- if ScreenAct = 2 then begin
- SingDrawPlayerBGLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 2, 15);
- SingDrawPlayerBGLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 3, 15);
- end;
-
- SingDrawLine(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 15);
- SingDrawLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 15);
-
- if ScreenAct = 1 then begin
- SingDrawPlayerLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 0, 15);
- SingDrawPlayerLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 1, 15);
- end;
- if ScreenAct = 2 then begin
- SingDrawPlayerLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 2, 15);
- SingDrawPlayerLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 3, 15);
- end;
- end;
-
- if PlayersPlay = 6 then begin
- NotesW := NotesW * 0.8;
- NotesH := NotesH * 0.8;
-
- if ScreenAct = 1 then begin
- SingDrawPlayerBGLine(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 0, 12);
- SingDrawPlayerBGLine(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 1, 12);
- SingDrawPlayerBGLine(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 2, 12);
- end;
- if ScreenAct = 2 then begin
- SingDrawPlayerBGLine(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 3, 12);
- SingDrawPlayerBGLine(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 4, 12);
- SingDrawPlayerBGLine(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 5, 12);
- end;
-
- SingDrawLine(NR.Left + 20, 120+95, NR.Right - 20, 0, 12);
- SingDrawLine(NR.Left + 20, 245+95, NR.Right - 20, 0, 12);
- SingDrawLine(NR.Left + 20, 370+95, NR.Right - 20, 0, 12);
-
- if ScreenAct = 1 then begin
- SingDrawPlayerLine(Nr.Left + 20, 120+95, Nr.Width - 40, 0, 12);
- SingDrawPlayerLine(Nr.Left + 20, 245+95, Nr.Width - 40, 1, 12);
- SingDrawPlayerLine(Nr.Left + 20, 370+95, Nr.Width - 40, 2, 12);
- end;
- if ScreenAct = 2 then begin
- SingDrawPlayerLine(Nr.Left + 20, 120+95, Nr.Width - 40, 3, 12);
- SingDrawPlayerLine(Nr.Left + 20, 245+95, Nr.Width - 40, 4, 12);
- SingDrawPlayerLine(Nr.Left + 20, 370+95, Nr.Width - 40, 5, 12);
- end;
- end;
- end;
-
- glDisable(GL_BLEND);
- glDisable(GL_TEXTURE_2D);
-end;
-
-
-{//SingBar Mod
-procedure SingDrawSingbar(X, Y, W, H: real; Percent: integer);
-var
- R: Real;
- G: Real;
- B: Real;
- A: cardinal;
- I: Integer;
-
-begin;
-
- //SingBar Background
- glColor4f(1, 1, 1, 0.8);
- glEnable(GL_TEXTURE_2D);
- glEnable(GL_BLEND);
- glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
- glBindTexture(GL_TEXTURE_2D, Tex_SingBar_Back.TexNum);
- glBegin(GL_QUADS);
- glTexCoord2f(0, 0); glVertex2f(X, Y);
- glTexCoord2f(0, 1); glVertex2f(X, Y+H);
- glTexCoord2f(1, 1); glVertex2f(X+W, Y+H);
- glTexCoord2f(1, 0); glVertex2f(X+W, Y);
- glEnd;
-
- //SingBar coloured Bar
- Case Percent of
- 0..22: begin
- R := 1;
- G := 0;
- B := 0;
- end;
- 23..42: begin
- R := 1;
- G := ((Percent-23)/100)*5;
- B := 0;
- end;
- 43..57: begin
- R := 1;
- G := 1;
- B := 0;
- end;
- 58..77: begin
- R := 1-(Percent - 58)/100*5;
- G := 1;
- B := 0;
- end;
- 78..99: begin
- R := 0;
- G := 1;
- B := 0;
- end;
- End; //Case
-
- glColor4f(R, G, B, 1);
- glEnable(GL_TEXTURE_2D);
- glEnable(GL_BLEND);
- glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
- glBindTexture(GL_TEXTURE_2D, Tex_SingBar_Bar.TexNum);
- //Size= Player[PlayerNum].ScorePercent of W
- glBegin(GL_QUADS);
- glTexCoord2f(0, 0); glVertex2f(X, Y);
- glTexCoord2f(0, 1); glVertex2f(X, Y+H);
- glTexCoord2f(1, 1); glVertex2f(X+(W/100 * (Percent +1)), Y+H);
- glTexCoord2f(1, 0); glVertex2f(X+(W/100 * (Percent +1)), Y);
- glEnd;
-
- //SingBar Front
- glColor4f(1, 1, 1, 0.6);
- glEnable(GL_TEXTURE_2D);
- glEnable(GL_BLEND);
- glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
- glBindTexture(GL_TEXTURE_2D, Tex_SingBar_Front.TexNum);
- glBegin(GL_QUADS);
- glTexCoord2f(0, 0); glVertex2f(X, Y);
- glTexCoord2f(0, 1); glVertex2f(X, Y+H);
- glTexCoord2f(1, 1); glVertex2f(X+W, Y+H);
- glTexCoord2f(1, 0); glVertex2f(X+W, Y);
- glEnd;
-end;
-//end Singbar Mod
-
-//PhrasenBonus - Line Bonus Pop Up
-procedure SingDrawLineBonus( const X, Y: Single; Color: TRGB; Alpha: Single; Text: string; Age: Integer);
-var
-Length, X2: Real; //Length of Text
-Size: Integer; //Size of Popup
-begin
-if Alpha <> 0 then
-begin
-
-//Set Font Propertys
-SetFontStyle(2); //Font: Outlined1
-if Age < 5 then SetFontSize(Age + 1) else SetFontSize(6);
-SetFontItalic(False);
-
-//Check Font Size
-Length := glTextWidth ( PChar(Text)) + 3; //Little Space for a Better Look ^^
-
-//Text
-SetFontPos (X + 50 - (Length / 2), Y + 12); //Position
-
-
-if Age < 5 then Size := Age * 10 else Size := 50;
-
- //Draw Background
- //glColor4f(Color.R, Color.G, Color.B, Alpha); //Set Color
- glColor4f(1, 1, 1, Alpha);
-
-
- glEnable(GL_TEXTURE_2D);
- glEnable(GL_BLEND);
- //glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
-
-
- //New Method, Not Variable
- glBindTexture(GL_TEXTURE_2D, Tex_SingLineBonusBack[2].TexNum);
-
- glBegin(GL_QUADS);
- glTexCoord2f(0, 0); glVertex2f(X + 50 - Size, Y + 25 - (Size/2));
- glTexCoord2f(0, 1); glVertex2f(X + 50 - Size, Y + 25 + (Size/2));
- glTexCoord2f(1, 1); glVertex2f(X + 50 + Size, Y + 25 + (Size/2));
- glTexCoord2f(1, 0); glVertex2f(X + 50 + Size, Y + 25 - (Size/2));
- glEnd;
-
- glColor4f(1, 1, 1, Alpha); //Set Color
- //Draw Text
- glPrint (PChar(Text));
-end;
-end;
-//PhrasenBonus - Line Bonus Mod}
-
-// Draw Note Bars for Editor
-//There are 11 Resons for a new Procdedure: (nice binary :D )
-// 1. It don't look good when you Draw the Golden Note Star Effect in the Editor
-// 2. You can see the Freestyle Notes in the Editor SemiTransparent
-// 3. Its easier and Faster then changing the old Procedure
-procedure EditDrawLine(Left, Top, Right: real; NrLines: integer; Space: integer);
-var
- Rec: TRecR;
- Count: integer;
- TempR: real;
-begin
- glColor3f(1, 1, 1);
- glEnable(GL_TEXTURE_2D);
- glEnable(GL_BLEND);
- glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
- TempR := (Right-Left) / (Lines[NrLines].Line[Lines[NrLines].Current].End_ - Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start);
- with Lines[NrLines].Line[Lines[NrLines].Current] do begin
- for Count := 0 to HighNote do begin
- with Note[Count] do begin
-
- // Golden Note Patch
- case NoteType of
- ntFreestyle: glColor4f(1, 1, 1, 0.35);
- ntNormal: glColor4f(1, 1, 1, 0.85);
- ntGolden: Glcolor4f(1, 1, 0.3, 0.85);
- end; // case
-
-
-
- // lewa czesc - left part
- Rec.Left := (Start-Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start) * TempR + Left + 0.5 + 10*ScreenX;
- Rec.Right := Rec.Left + NotesW;
- Rec.Top := Top - (Tone-BaseNote)*Space/2 - NotesH;
- Rec.Bottom := Rec.Top + 2 * NotesH;
- glBindTexture(GL_TEXTURE_2D, Tex_Left[Color].TexNum);
- glBegin(GL_QUADS);
- glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top);
- glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom);
- glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom);
- glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top);
- glEnd;
-
- // srodkowa czesc - middle part
- Rec.Left := Rec.Right;
- Rec.Right := (Start+Length-Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start) * TempR + Left - NotesW - 0.5 + 10*ScreenX;
-
- glBindTexture(GL_TEXTURE_2D, Tex_Mid[Color].TexNum);
- glBegin(GL_QUADS);
- glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top);
- glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom);
- glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom);
- glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top);
- glEnd;
-
- // prawa czesc - right part
- Rec.Left := Rec.Right;
- Rec.Right := Rec.Right + NotesW;
-
- glBindTexture(GL_TEXTURE_2D, Tex_Right[Color].TexNum);
- glBegin(GL_QUADS);
- glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top);
- glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom);
- glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom);
- glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top);
- glEnd;
-
- end; // with
- end; // for
- end; // with
-
- glDisable(GL_BLEND);
- glDisable(GL_TEXTURE_2D);
-end;
-
-procedure SingDrawTimeBar();
-var
- x,y: real;
- width, height: real;
- LyricsProgress: real;
- CurLyricsTime: real;
-begin
- x := Theme.Sing.StaticTimeProgress.x;
- y := Theme.Sing.StaticTimeProgress.y;
-
- width := Theme.Sing.StaticTimeProgress.w;
- height := Theme.Sing.StaticTimeProgress.h;
-
- glColor4f(Theme.Sing.StaticTimeProgress.ColR,
- Theme.Sing.StaticTimeProgress.ColG,
- Theme.Sing.StaticTimeProgress.ColB, 1); //Set Color
-
- glEnable(GL_TEXTURE_2D);
- glEnable(GL_BLEND);
-
- glBindTexture(GL_TEXTURE_2D, Tex_TimeProgress.TexNum);
-
- glBegin(GL_QUADS);
- glTexCoord2f(0, 0);
- glVertex2f(x, y);
-
- CurLyricsTime := LyricsState.GetCurrentTime();
- if (CurLyricsTime > 0) and
- (LyricsState.TotalTime > 0) then
- begin
- LyricsProgress := CurLyricsTime / LyricsState.TotalTime;
- glTexCoord2f((width * LyricsProgress) / 8, 0);
- glVertex2f(x + width * LyricsProgress, y);
-
- glTexCoord2f((width * LyricsProgress) / 8, 1);
- glVertex2f(x + width * LyricsProgress, y + height);
- end;
-
- glTexCoord2f(0, 1);
- glVertex2f(x, y + height);
- glEnd;
-
- glDisable(GL_TEXTURE_2D);
- glDisable(GL_BLEND);
- glcolor4f(1, 1, 1, 1);
-end;
-
-end.
-
diff --git a/src/classes/UEditorLyrics.pas b/src/classes/UEditorLyrics.pas
deleted file mode 100644
index 25e8423e..00000000
--- a/src/classes/UEditorLyrics.pas
+++ /dev/null
@@ -1,229 +0,0 @@
-unit UEditorLyrics;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses
- SysUtils,
- gl,
- UMusic,
- UTexture;
-
-type
- TWord = record
- X: real;
- Y: real;
- Size: real;
- Width: real;
- Text: string;
- ColR: real;
- ColG: real;
- ColB: real;
- FontStyle: integer;
- Italic: boolean;
- Selected: boolean;
- end;
-
- TEditorLyrics = class
- private
- AlignI: integer;
- XR: real;
- YR: real;
- SizeR: real;
- SelectedI: integer;
- FontStyleI: integer; // font number
- Word: array of TWord;
-
- procedure SetX(Value: real);
- procedure SetY(Value: real);
- function GetClientX: real;
- procedure SetAlign(Value: integer);
- function GetSize: real;
- procedure SetSize(Value: real);
- procedure SetSelected(Value: integer);
- procedure SetFStyle(Value: integer);
- procedure AddWord(Text: string);
- procedure Refresh;
- public
- ColR: real;
- ColG: real;
- ColB: real;
- ColSR: real;
- ColSG: real;
- ColSB: real;
- Italic: boolean;
-
- constructor Create;
- destructor Destroy; override;
-
- procedure AddLine(NrLine: integer);
-
- procedure Clear;
- procedure Draw;
- published
- property X: real write SetX;
- property Y: real write SetY;
- property ClientX: real read GetClientX;
- property Align: integer write SetAlign;
- property Size: real read GetSize write SetSize;
- property Selected: integer read SelectedI write SetSelected;
- property FontStyle: integer write SetFStyle;
- end;
-
-implementation
-
-uses
- TextGL, UGraphic, UDrawTexture, Math, USkins;
-
-constructor TEditorLyrics.Create;
-begin
- inherited;
-end;
-
-destructor TEditorLyrics.Destroy;
-begin
- SetLength(Word, 0);
- inherited;
-end;
-
-procedure TEditorLyrics.SetX(Value: real);
-begin
- XR := Value;
-end;
-
-procedure TEditorLyrics.SetY(Value: real);
-begin
- YR := Value;
-end;
-
-function TEditorLyrics.GetClientX: real;
-begin
- Result := Word[0].X;
-end;
-
-procedure TEditorLyrics.SetAlign(Value: integer);
-begin
- AlignI := Value;
-end;
-
-function TEditorLyrics.GetSize: real;
-begin
- Result := SizeR;
-end;
-
-procedure TEditorLyrics.SetSize(Value: real);
-begin
- SizeR := Value;
-end;
-
-procedure TEditorLyrics.SetSelected(Value: integer);
-var
- W: integer;
-begin
- if (SelectedI > -1) and (SelectedI <= High(Word)) then
- begin
- Word[SelectedI].Selected := false;
- Word[SelectedI].ColR := ColR;
- Word[SelectedI].ColG := ColG;
- Word[SelectedI].ColB := ColB;
- end;
-
- SelectedI := Value;
- if (Value > -1) and (Value <= High(Word)) then
- begin
- Word[Value].Selected := true;
- Word[Value].ColR := ColSR;
- Word[Value].ColG := ColSG;
- Word[Value].ColB := ColSB;
- end;
-
- Refresh;
-end;
-
-procedure TEditorLyrics.SetFStyle(Value: integer);
-begin
- FontStyleI := Value;
-end;
-
-procedure TEditorLyrics.AddWord(Text: string);
-var
- WordNum: integer;
-begin
- WordNum := Length(Word);
- SetLength(Word, WordNum + 1);
- if WordNum = 0 then begin
- Word[WordNum].X := XR;
- end else begin
- Word[WordNum].X := Word[WordNum - 1].X + Word[WordNum - 1].Width;
- end;
-
- Word[WordNum].Y := YR;
- Word[WordNum].Size := SizeR;
- Word[WordNum].FontStyle := FontStyleI;
- SetFontStyle(FontStyleI);
- SetFontSize(SizeR);
- Word[WordNum].Width := glTextWidth(pchar(Text));
- Word[WordNum].Text := Text;
- Word[WordNum].ColR := ColR;
- Word[WordNum].ColG := ColG;
- Word[WordNum].ColB := ColB;
- Word[WordNum].Italic := Italic;
-
- Refresh;
-end;
-
-procedure TEditorLyrics.AddLine(NrLine: integer);
-var
- N: integer;
-begin
- Clear;
- for N := 0 to Lines[0].Line[NrLine].HighNote do begin
- Italic := Lines[0].Line[NrLine].Note[N].NoteType = ntFreestyle;
- AddWord(Lines[0].Line[NrLine].Note[N].Text);
- end;
- Selected := -1;
-end;
-
-procedure TEditorLyrics.Clear;
-begin
- SetLength(Word, 0);
- SelectedI := -1;
-end;
-
-procedure TEditorLyrics.Refresh;
-var
- W: integer;
- TotWidth: real;
-begin
- if AlignI = 1 then begin
- TotWidth := 0;
- for W := 0 to High(Word) do
- TotWidth := TotWidth + Word[W].Width;
-
- Word[0].X := XR - TotWidth / 2;
- for W := 1 to High(Word) do
- Word[W].X := Word[W - 1].X + Word[W - 1].Width;
- end;
-end;
-
-procedure TEditorLyrics.Draw;
-var
- W: integer;
-begin
- for W := 0 to High(Word) do
- begin
- SetFontStyle(Word[W].FontStyle);
- SetFontPos(Word[W].X+ 10*ScreenX, Word[W].Y);
- SetFontSize(Word[W].Size);
- SetFontItalic(Word[W].Italic);
- glColor3f(Word[W].ColR, Word[W].ColG, Word[W].ColB);
- glPrint(pchar(Word[W].Text));
- end;
-end;
-
-end.
diff --git a/src/classes/UFiles.pas b/src/classes/UFiles.pas
deleted file mode 100644
index ca43bb21..00000000
--- a/src/classes/UFiles.pas
+++ /dev/null
@@ -1,150 +0,0 @@
-unit UFiles;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-{$I switches.inc}
-
-uses SysUtils,
- ULog,
- UMusic,
- USongs,
- USong;
-
-procedure ResetSingTemp;
-function SaveSong(Song: TSong; Lines: TLines; Name: string; Relative: boolean): boolean;
-
-var
- SongFile: TextFile; // all procedures in this unit operates on this file
- FileLineNo: integer; //Line which is readed at Last, for error reporting
-
- // variables available for all procedures
- Base : array[0..1] of integer;
- Rel : array[0..1] of integer;
- Mult : integer = 1;
- MultBPM : integer = 4;
-
-implementation
-
-uses TextGL,
- UIni,
- UPlatform,
- UMain;
-
-//--------------------
-// Resets the temporary Sentence Arrays for each Player and some other Variables
-//--------------------
-procedure ResetSingTemp;
-var
- Count: integer;
-begin
- SetLength(Lines, Length(Player));
- for Count := 0 to High(Player) do begin
- SetLength(Lines[Count].Line, 1);
- SetLength(Lines[Count].Line[0].Note, 0);
- Lines[Count].Line[0].Lyric := '';
- Lines[Count].Line[0].LyricWidth := 0;
- Player[Count].Score := 0;
- Player[Count].LengthNote := 0;
- Player[Count].HighNote := -1;
- end;
-
- (* FIXME
- //Reset Path and Filename Values to Prevent Errors in Editor
- if assigned( CurrentSong ) then
- begin
- SetLength(CurrentSong.BPM, 0);
- CurrentSong.Path := '';
- CurrentSong.FileName := '';
- end;
- *)
-
-// CurrentSong := nil;
-end;
-
-
-//--------------------
-// Saves a Song
-//--------------------
-function SaveSong(Song: TSong; Lines: TLines; Name: string; Relative: boolean): boolean;
-var
- C: integer;
- N: integer;
- S: string;
- B: integer;
- RelativeSubTime: integer;
- NoteState: String;
-
-begin
-// Relative := true; // override (idea - use shift+S to save with relative)
- AssignFile(SongFile, Name);
- Rewrite(SongFile);
-
- Writeln(SongFile, '#TITLE:' + Song.Title + '');
- Writeln(SongFile, '#ARTIST:' + Song.Artist);
-
- if Song.Creator <> '' then Writeln(SongFile, '#CREATOR:' + Song.Creator);
- if Song.Edition <> 'Unknown' then Writeln(SongFile, '#EDITION:' + Song.Edition);
- if Song.Genre <> 'Unknown' then Writeln(SongFile, '#GENRE:' + Song.Genre);
- if Song.Language <> 'Unknown' then Writeln(SongFile, '#LANGUAGE:' + Song.Language);
-
- Writeln(SongFile, '#MP3:' + Song.Mp3);
-
- if Song.Cover <> '' then Writeln(SongFile, '#COVER:' + Song.Cover);
- if Song.Background <> '' then Writeln(SongFile, '#BACKGROUND:' + Song.Background);
- if Song.Video <> '' then Writeln(SongFile, '#VIDEO:' + Song.Video);
- if Song.VideoGAP <> 0 then Writeln(SongFile, '#VIDEOGAP:' + FloatToStr(Song.VideoGAP));
- if Song.Resolution <> 4 then Writeln(SongFile, '#RESOLUTION:' + IntToStr(Song.Resolution));
- if Song.NotesGAP <> 0 then Writeln(SongFile, '#NOTESGAP:' + IntToStr(Song.NotesGAP));
- if Song.Start <> 0 then Writeln(SongFile, '#START:' + FloatToStr(Song.Start));
- if Song.Finish <> 0 then Writeln(SongFile, '#END:' + IntToStr(Song.Finish));
- if Relative then Writeln(SongFile, '#RELATIVE:yes');
-
- Writeln(SongFile, '#BPM:' + FloatToStr(Song.BPM[0].BPM / 4));
- Writeln(SongFile, '#GAP:' + FloatToStr(Song.GAP));
-
- RelativeSubTime := 0;
- for B := 1 to High(CurrentSong.BPM) do
- Writeln(SongFile, 'B ' + FloatToStr(CurrentSong.BPM[B].StartBeat) + ' ' + FloatToStr(CurrentSong.BPM[B].BPM/4));
-
- for C := 0 to Lines.High do begin
- for N := 0 to Lines.Line[C].HighNote do begin
- with Lines.Line[C].Note[N] do begin
-
-
- //Golden + Freestyle Note Patch
- case Lines.Line[C].Note[N].NoteType of
- ntFreestyle: NoteState := 'F ';
- ntNormal: NoteState := ': ';
- ntGolden: NoteState := '* ';
- end; // case
- S := NoteState + IntToStr(Start-RelativeSubTime) + ' ' + IntToStr(Length) + ' ' + IntToStr(Tone) + ' ' + Text;
-
-
- Writeln(SongFile, S);
- end; // with
- end; // N
-
- if C < Lines.High then begin // don't write end of last sentence
- if not Relative then
- S := '- ' + IntToStr(Lines.Line[C+1].Start)
- else begin
- S := '- ' + IntToStr(Lines.Line[C+1].Start - RelativeSubTime) +
- ' ' + IntToStr(Lines.Line[C+1].Start - RelativeSubTime);
- RelativeSubTime := Lines.Line[C+1].Start;
- end;
- Writeln(SongFile, S);
- end;
-
- end; // C
-
-
- Writeln(SongFile, 'E');
- CloseFile(SongFile);
-
- Result := true;
-end;
-
-end.
diff --git a/src/classes/UGraphic.pas b/src/classes/UGraphic.pas
deleted file mode 100644
index 2432503c..00000000
--- a/src/classes/UGraphic.pas
+++ /dev/null
@@ -1,760 +0,0 @@
-unit UGraphic;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses
- SDL,
- gl,
- glext,
- UTexture,
- TextGL,
- ULog,
- SysUtils,
- ULyrics,
- UImage,
- UMusic,
- UScreenLoading,
- UScreenWelcome,
- UScreenMain,
- UScreenName,
- UScreenLevel,
- UScreenOptions,
- UScreenOptionsGame,
- UScreenOptionsGraphics,
- UScreenOptionsSound,
- UScreenOptionsLyrics,
- UScreenOptionsThemes,
- UScreenOptionsRecord,
- UScreenOptionsAdvanced,
- UScreenSong,
- UScreenSing,
- UScreenScore,
- UScreenTop5,
- UScreenEditSub,
- UScreenEdit,
- UScreenEditConvert,
- UScreenEditHeader,
- UScreenOpen,
- UThemes,
- USkins,
- UScreenSongMenu,
- UScreenSongJumpto,
- {Party Screens}
- UScreenSingModi,
- UScreenPartyNewRound,
- UScreenPartyScore,
- UScreenPartyOptions,
- UScreenPartyWin,
- UScreenPartyPlayer,
- {Stats Screens}
- UScreenStatMain,
- UScreenStatDetail,
- {CreditsScreen}
- UScreenCredits,
- {Popup for errors, etc.}
- UScreenPopup;
-
-type
- TRecR = record
- Top: real;
- Left: real;
- Right: real;
- Bottom: real;
- end;
-
-var
- Screen: PSDL_Surface;
- LoadingThread: PSDL_Thread;
- Mutex: PSDL_Mutex;
-
- RenderW: integer;
- RenderH: integer;
- ScreenW: integer;
- ScreenH: integer;
- Screens: integer;
- ScreenAct: integer;
- ScreenX: integer;
-
- ScreenLoading: TScreenLoading;
- ScreenWelcome: TScreenWelcome;
- ScreenMain: TScreenMain;
- ScreenName: TScreenName;
- ScreenLevel: TScreenLevel;
- ScreenSong: TScreenSong;
- ScreenSing: TScreenSing;
- ScreenScore: TScreenScore;
- ScreenTop5: TScreenTop5;
- ScreenOptions: TScreenOptions;
- ScreenOptionsGame: TScreenOptionsGame;
- ScreenOptionsGraphics: TScreenOptionsGraphics;
- ScreenOptionsSound: TScreenOptionsSound;
- ScreenOptionsLyrics: TScreenOptionsLyrics;
- ScreenOptionsThemes: TScreenOptionsThemes;
- ScreenOptionsRecord: TScreenOptionsRecord;
- ScreenOptionsAdvanced: TScreenOptionsAdvanced;
- ScreenEditSub: TScreenEditSub;
- ScreenEdit: TScreenEdit;
- ScreenEditConvert: TScreenEditConvert;
- ScreenEditHeader: TScreenEditHeader;
- ScreenOpen: TScreenOpen;
-
- ScreenSongMenu: TScreenSongMenu;
- ScreenSongJumpto: TScreenSongJumpto;
-
- //Party Screens
- ScreenSingModi: TScreenSingModi;
- ScreenPartyNewRound: TScreenPartyNewRound;
- ScreenPartyScore: TScreenPartyScore;
- ScreenPartyWin: TScreenPartyWin;
- ScreenPartyOptions: TScreenPartyOptions;
- ScreenPartyPlayer: TScreenPartyPlayer;
-
- //StatsScreens
- ScreenStatMain: TScreenStatMain;
- ScreenStatDetail: TScreenStatDetail;
-
- //CreditsScreen
- ScreenCredits: TScreenCredits;
-
- //popup mod
- ScreenPopupCheck: TScreenPopupCheck;
- ScreenPopupError: TScreenPopupError;
-
- //Notes
- Tex_Left: array[0..6] of TTexture; //rename to tex_note_left
- Tex_Mid: array[0..6] of TTexture; //rename to tex_note_mid
- Tex_Right: array[0..6] of TTexture; //rename to tex_note_right
-
- Tex_plain_Left: array[1..6] of TTexture; //rename to tex_notebg_left
- Tex_plain_Mid: array[1..6] of TTexture; //rename to tex_notebg_mid
- Tex_plain_Right: array[1..6] of TTexture; //rename to tex_notebg_right
-
- Tex_BG_Left: array[1..6] of TTexture; //rename to tex_noteglow_left
- Tex_BG_Mid: array[1..6] of TTexture; //rename to tex_noteglow_mid
- Tex_BG_Right: array[1..6] of TTexture; //rename to tex_noteglow_right
-
- Tex_Note_Star: TTexture;
- Tex_Note_Perfect_Star: TTexture;
-
-
- Tex_Ball: TTexture;
- Tex_Lyric_Help_Bar: TTexture;
- FullScreen: boolean;
-
- Tex_TimeProgress: TTexture;
-
- //Sing Bar Mod
- Tex_SingBar_Back: TTexture;
- Tex_SingBar_Bar: TTexture;
- Tex_SingBar_Front: TTexture;
- //end Singbar Mod
-
- //PhrasenBonus - Line Bonus Mod
- Tex_SingLineBonusBack: array[0..8] of TTexture;
- //End PhrasenBonus - Line Bonus Mod
-
- //ScoreBG Texs
- Tex_ScoreBG: array [0..5] of TTexture;
-
- //Score Screen Textures
- Tex_Score_NoteBarLevel_Dark : array [1..6] of TTexture;
- Tex_Score_NoteBarRound_Dark : array [1..6] of TTexture;
-
- Tex_Score_NoteBarLevel_Light : array [1..6] of TTexture;
- Tex_Score_NoteBarRound_Light : array [1..6] of TTexture;
-
- Tex_Score_NoteBarLevel_Lightest : array [1..6] of TTexture;
- Tex_Score_NoteBarRound_Lightest : array [1..6] of TTexture;
-
- Tex_Score_Ratings : array [0..7] of TTexture;
-
-const
- Skin_BGColorR = 1;
- Skin_BGColorG = 1;
- Skin_BGColorB = 1;
-
- Skin_SpectrumR = 0;
- Skin_SpectrumG = 0;
- Skin_SpectrumB = 0;
-
- Skin_Spectograph1R = 0.6;
- Skin_Spectograph1G = 0.8;
- Skin_Spectograph1B = 1;
-
- Skin_Spectograph2R = 0;
- Skin_Spectograph2G = 0;
- Skin_Spectograph2B = 0.2;
-
- Skin_SzczytR = 0.8;
- Skin_SzczytG = 0;
- Skin_SzczytB = 0;
-
- Skin_SzczytLimitR = 0;
- Skin_SzczytLimitG = 0.8;
- Skin_SzczytLimitB = 0;
-
- Skin_FontR = 0;
- Skin_FontG = 0;
- Skin_FontB = 0;
-
- Skin_FontHighlightR = 0.3; // 0.3
- Skin_FontHighlightG = 0.3; // 0.3
- Skin_FontHighlightB = 1; // 1
-
- Skin_TimeR = 0.25; //0,0,0
- Skin_TimeG = 0.25;
- Skin_TimeB = 0.25;
-
- Skin_OscR = 0;
- Skin_OscG = 0;
- Skin_OscB = 0;
-
- Skin_LyricsT = 494; // 500 / 510 / 400
- Skin_SpectrumT = 470;
- Skin_SpectrumBot = 570;
- Skin_SpectrumH = 100;
-
- Skin_P1_LinesR = 0.5; // 0.6 0.6 1
- Skin_P1_LinesG = 0.5;
- Skin_P1_LinesB = 0.5;
-
- Skin_P2_LinesR = 0.5; // 1 0.6 0.6
- Skin_P2_LinesG = 0.5;
- Skin_P2_LinesB = 0.5;
-
- Skin_P1_NotesB = 250;
- Skin_P2_NotesB = 430; // 430 / 300
-
- Skin_P1_ScoreT = 50;
- Skin_P1_ScoreL = 20;
-
- Skin_P2_ScoreT = 50;
- Skin_P2_ScoreL = 640;
-
-procedure Initialize3D (Title: string);
-procedure Reinitialize3D;
-procedure SwapBuffers;
-
-procedure LoadTextures;
-procedure InitializeScreen;
-procedure LoadLoadingScreen;
-procedure LoadScreens;
-procedure UnLoadScreens;
-
-function LoadingThreadFunction: integer;
-
-
-implementation
-
-uses
- UMain,
- UIni,
- UDisplay,
- UCommandLine,
- Classes;
-
-procedure LoadFontTextures;
-begin
- Log.LogStatus('Building Fonts', 'LoadTextures');
- BuildFont;
-end;
-
-procedure LoadTextures;
-
-
-var
- P: integer;
- R, G, B: real;
- Col: integer;
-begin
- // zaladowanie tekstur
- Log.LogStatus('Loading Textures', 'LoadTextures');
-
- Tex_Left[0] := Texture.LoadTexture(Skin.GetTextureFileName('GrayLeft'), TEXTURE_TYPE_TRANSPARENT, 0); //brauch man die noch?
- Tex_Mid[0] := Texture.LoadTexture(Skin.GetTextureFileName('GrayMid'), TEXTURE_TYPE_PLAIN, 0); //brauch man die noch?
- Tex_Right[0] := Texture.LoadTexture(Skin.GetTextureFileName('GrayRight'), TEXTURE_TYPE_TRANSPARENT, 0); //brauch man die noch?
-
- Log.LogStatus('Loading Textures - A', 'LoadTextures');
-
- // P1-6
- // TODO... do it once for each player... this is a bit crappy !!
- // can we make it any better !?
- for P := 1 to 6 do
- begin
- LoadColor(R, G, B, 'P' + IntToStr(P) + 'Light');
- Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255);
-
- Tex_Left[P] := Texture.LoadTexture(Skin.GetTextureFileName('GrayLeft'), TEXTURE_TYPE_COLORIZED, Col);
- Tex_Mid[P] := Texture.LoadTexture(Skin.GetTextureFileName('GrayMid'), TEXTURE_TYPE_COLORIZED, Col);
- Tex_Right[P] := Texture.LoadTexture(Skin.GetTextureFileName('GrayRight'), TEXTURE_TYPE_COLORIZED, Col);
-
- Tex_plain_Left[P] := Texture.LoadTexture(Skin.GetTextureFileName('NotePlainLeft'), TEXTURE_TYPE_COLORIZED, Col);
- Tex_plain_Mid[P] := Texture.LoadTexture(Skin.GetTextureFileName('NotePlainMid'), TEXTURE_TYPE_COLORIZED, Col);
- Tex_plain_Right[P] := Texture.LoadTexture(Skin.GetTextureFileName('NotePlainRight'), TEXTURE_TYPE_COLORIZED, Col);
-
- Tex_BG_Left[P] := Texture.LoadTexture(Skin.GetTextureFileName('NoteBGLeft'), TEXTURE_TYPE_COLORIZED, Col);
- Tex_BG_Mid[P] := Texture.LoadTexture(Skin.GetTextureFileName('NoteBGMid'), TEXTURE_TYPE_COLORIZED, Col);
- Tex_BG_Right[P] := Texture.LoadTexture(Skin.GetTextureFileName('NoteBGRight'), TEXTURE_TYPE_COLORIZED, Col);
- end;
-
- Log.LogStatus('Loading Textures - B', 'LoadTextures');
-
- Tex_Note_Perfect_Star := Texture.LoadTexture(Skin.GetTextureFileName('NotePerfectStar'), TEXTURE_TYPE_TRANSPARENT, 0);
- Tex_Note_Star := Texture.LoadTexture(Skin.GetTextureFileName('NoteStar') , TEXTURE_TYPE_TRANSPARENT, $FFFFFF);
- Tex_Ball := Texture.LoadTexture(Skin.GetTextureFileName('Ball'), TEXTURE_TYPE_TRANSPARENT, $FF00FF);
- Tex_Lyric_Help_Bar := Texture.LoadTexture(Skin.GetTextureFileName('LyricHelpBar'), TEXTURE_TYPE_TRANSPARENT, $FF00FF);
-
-
- //TimeBar mod
- Tex_TimeProgress := Texture.LoadTexture(Skin.GetTextureFileName('TimeBar'));
- //eoa TimeBar mod
-
- //SingBar Mod
- Tex_SingBar_Back := Texture.LoadTexture(Skin.GetTextureFileName('SingBarBack'), TEXTURE_TYPE_PLAIN, 0);
- Tex_SingBar_Bar := Texture.LoadTexture(Skin.GetTextureFileName('SingBarBar'), TEXTURE_TYPE_PLAIN, 0);
- Tex_SingBar_Front := Texture.LoadTexture(Skin.GetTextureFileName('SingBarFront'), TEXTURE_TYPE_PLAIN, 0);
- //end Singbar Mod
-
- Log.LogStatus('Loading Textures - C', 'LoadTextures');
-
- //Line Bonus PopUp
- for P := 0 to 8 do
- begin
- Case P of
- 0: begin
- R := 1;
- G := 0;
- B := 0;
- end;
- 1..3: begin
- R := 1;
- G := (P * 0.25);
- B := 0;
- end;
- 4: begin
- R := 1;
- G := 1;
- B := 0;
- end;
- 5..7: begin
- R := 1-((P-4)*0.25);
- G := 1;
- B := 0;
- end;
- 8: begin
- R := 0;
- G := 1;
- B := 0;
- end;
- End;
-
- Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255);
- Tex_SingLineBonusBack[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('LineBonusBack')), TEXTURE_TYPE_COLORIZED, Col);
- end;
-
-//## backgrounds for the scores ##
- for P := 0 to 5 do begin
- LoadColor(R, G, B, 'P' + IntToStr(P+1) + 'Light');
- Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255);
- Tex_ScoreBG[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreBG')), TEXTURE_TYPE_COLORIZED, Col);
- end;
-
-
- Log.LogStatus('Loading Textures - D', 'LoadTextures');
-
-// ######################
-// Score screen textures
-// ######################
-
-//## the bars that visualize the score ##
- for P := 1 to 6 do begin
-//NoteBar ScoreBar
- LoadColor(R, G, B, 'P' + IntToStr(P) + 'Dark');
- Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255);
- Tex_Score_NoteBarLevel_Dark[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreLevel_Dark')), TEXTURE_TYPE_COLORIZED, Col);
- Tex_Score_NoteBarRound_Dark[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreLevel_Dark_Round')), TEXTURE_TYPE_COLORIZED, Col);
-//LineBonus ScoreBar
- LoadColor(R, G, B, 'P' + IntToStr(P) + 'Light');
- Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255);
- Tex_Score_NoteBarLevel_Light[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreLevel_Light')), TEXTURE_TYPE_COLORIZED, Col);
- Tex_Score_NoteBarRound_Light[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreLevel_Light_Round')), TEXTURE_TYPE_COLORIZED, Col);
-//GoldenNotes ScoreBar
- LoadColor(R, G, B, 'P' + IntToStr(P) + 'Lightest');
- Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255);
- Tex_Score_NoteBarLevel_Lightest[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreLevel_Lightest')), TEXTURE_TYPE_COLORIZED, Col);
- Tex_Score_NoteBarRound_Lightest[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('ScoreLevel_Lightest_Round')), TEXTURE_TYPE_COLORIZED, Col);
- end;
-
-//## rating pictures that show a picture according to your rate ##
- for P := 0 to 7 do begin
- Tex_Score_Ratings[P] := Texture.LoadTexture(pchar(Skin.GetTextureFileName('Rating_'+IntToStr(P))), TEXTURE_TYPE_TRANSPARENT, 0);
- end;
-
- Log.LogStatus('Loading Textures - Done', 'LoadTextures');
-end;
-
-(*
- * Load OpenGL extensions. Must be called after SDL_SetVideoMode() and each
- * time the pixel-format or render-context (RC) changes.
- *)
-procedure LoadOpenGLExtensions;
-begin
- // Load OpenGL 1.2 extensions for OpenGL 1.2 compatibility
- if (not Load_GL_version_1_2()) then
- begin
- Log.LogCritical('Failed loading OpenGL 1.2', 'UGraphic.Initialize3D');
- end;
-
- // Other extensions e.g. OpenGL 1.3-2.0 or Framebuffer-Object might be loaded here
- // ...
- //Load_GL_EXT_framebuffer_object();
-end;
-
-procedure Initialize3D (Title: string);
-var
- Icon: PSDL_Surface;
-begin
- Log.LogStatus('SDL_Init', 'UGraphic.Initialize3D');
- if ( SDL_InitSubSystem(SDL_INIT_VIDEO) = -1 ) then
- begin
- Log.LogError('SDL_Init Failed', 'UGraphic.Initialize3D');
- exit;
- end;
-
- // load icon image (must be 32x32 for win32)
- Icon := LoadImage('WINDOWICON');
- if (Icon <> nil) then
- SDL_WM_SetIcon(Icon, 0);
-
- SDL_WM_SetCaption(PChar(Title), nil);
-
- //Log.BenchmarkStart(2);
-
- InitializeScreen;
-
- //Log.BenchmarkEnd(2);
- //Log.LogBenchmark('--> Setting Screen', 2);
-
- //Log.BenchmarkStart(2);
- Texture := TTextureUnit.Create;
- // FIXME: this does not seem to be correct as Limit is the max. of either
- // width or height.
- Texture.Limit := 1024*1024;
-
- //LoadTextures;
- //Log.BenchmarkEnd(2);
- //Log.LogBenchmark('--> Loading Textures', 2);
-
- {
- Log.BenchmarkStart(2);
- Lyric:= TLyric.Create;
- Log.BenchmarkEnd(2);
- Log.LogBenchmark('--> Loading Fonts', 2);
- }
-
- // Note: do not initialize video modules earlier. They might depend on some
- // SDL video functions or OpenGL extensions initialized in InitializeScreen()
- InitializeVideo();
-
- //Log.BenchmarkStart(2);
-
- Log.LogStatus('TDisplay.Create', 'UGraphic.Initialize3D');
- Display := TDisplay.Create;
-
- //Log.BenchmarkEnd(2); Log.LogBenchmark('====> Creating Display', 2);
-
- //Log.LogStatus('Loading Screens', 'Initialize3D');
- //Log.BenchmarkStart(3);
-
- Log.LogStatus('Loading Font Textures', 'UGraphic.Initialize3D');
- LoadFontTextures();
-
- // Show the Loading Screen -------------
- Log.LogStatus('Loading Loading Screen', 'UGraphic.Initialize3D');
- LoadLoadingScreen;
-
-
- Log.LogStatus(' Loading Textures', 'UGraphic.Initialize3D');
- LoadTextures; // jb
-
-
-
- // now that we have something to display while loading,
- // start thread that loads the rest of ultrastar
- //Mutex := SDL_CreateMutex;
- //SDL_UnLockMutex(Mutex);
-
- // does not work this way because the loading thread tries to access opengl.
- // See comment below
- //LoadingThread := SDL_CreateThread(@LoadingThread, nil);
-
- // this would be run in the loadingthread
- Log.LogStatus(' Loading Screens', 'UGraphic.Initialize3D');
- LoadScreens;
-
-
- // TODO:
- // here should be a loop which
- // * draws the loading screen (form time to time)
- // * controlls the "process of the loading screen
- // * checks if the loadingthread has loaded textures (check mutex) and
- // * load the textures into opengl
- // * tells the loadingthread, that the memory for the texture can be reused
- // to load the netx texture (over another mutex)
- // * runs as long as the loadingthread tells, that everything is loaded and ready (using a third mutex)
- //
- // therefor loadtexture have to be changed, that it, instat of caling some opengl functions
- // for itself, it should change mutex
- // the mainthread have to know somehow what opengl function have to be called with which parameters like
- // texturetype, textureobjekt, textur-buffer-adress, ...
-
- // wait for loading thread to finish
- // currently does not work this way
- // SDL_WaitThread(LoadingThread, I);
- // SDL_DestroyMutex(Mutex);
-
- Display.CurrentScreen^.FadeTo( @ScreenMain );
-
- Log.BenchmarkEnd(2);
- Log.LogBenchmark('--> Loading Screens', 2);
-
- Log.LogStatus('Finish', 'Initialize3D');
-end;
-
-procedure SwapBuffers;
-begin
- SDL_GL_SwapBuffers;
- glMatrixMode(GL_PROJECTION);
- glLoadIdentity;
- glOrtho(0, RenderW, RenderH, 0, -1, 100);
- glMatrixMode(GL_MODELVIEW);
-end;
-
-procedure Reinitialize3D;
-begin
- InitializeScreen;
-end;
-
-procedure InitializeScreen;
-var
- S: string;
- I: integer;
- W, H: integer;
- Depth: Integer;
-begin
- if (Params.Screens <> -1) then
- Screens := Params.Screens + 1
- else
- Screens := Ini.Screens + 1;
-
- SDL_GL_SetAttribute(SDL_GL_RED_SIZE, 5);
- SDL_GL_SetAttribute(SDL_GL_GREEN_SIZE, 5);
- SDL_GL_SetAttribute(SDL_GL_BLUE_SIZE, 5);
- SDL_GL_SetAttribute(SDL_GL_ALPHA_SIZE, 5);
- SDL_GL_SetAttribute(SDL_GL_DEPTH_SIZE, 16); // Z-Buffer depth
- SDL_GL_SetAttribute(SDL_GL_DOUBLEBUFFER, 1);
-
- // VSYNC works for windows only at the moment. SDL_GL_SWAP_CONTROL under
- // linux uses GLX_MESA_swap_control which is not supported by nvidea cards.
- // Maybe use glXSwapIntervalSGI(1) from the GLX_SGI_swap_control extension instead.
- //SDL_GL_SetAttribute(SDL_GL_SWAP_CONTROL, 1); // VSYNC (currently Windows only)
-
- // If there is a resolution in Parameters, use it, else use the Ini value
- I := Params.Resolution;
- if (I <> -1) then
- S := IResolution[I]
- else
- S := IResolution[Ini.Resolution];
-
- I := Pos('x', S);
- W := StrToInt(Copy(S, 1, I-1)) * Screens;
- H := StrToInt(Copy(S, I+1, 1000));
-
- if (Params.Depth <> -1) then
- Depth := Params.Depth
- else
- Depth := Ini.Depth;
-
- Log.LogStatus('SDL_SetVideoMode', 'Initialize3D');
- //SDL_GL_SetAttribute( SDL_GL_DOUBLEBUFFER, 1 );
-
- if (Ini.FullScreen = 0) and (Not Params.FullScreen) then
- begin
- Log.LogStatus('SDL_SetVideoMode', 'Set Video Mode... Windowed');
- screen := SDL_SetVideoMode(W, H, (Depth+1) * 16, SDL_OPENGL or SDL_RESIZABLE)
- end
- else
- begin
- Log.LogStatus('SDL_SetVideoMode', 'Set Video Mode... Full Screen');
- screen := SDL_SetVideoMode(W, H, (Depth+1) * 16, SDL_OPENGL or SDL_FULLSCREEN );
- SDL_ShowCursor(0);
- end;
-
- if (screen = nil) then
- begin
- Log.LogError('SDL_SetVideoMode Failed', 'Initialize3D');
- exit;
- end;
-
- LoadOpenGLExtensions();
-
- // define virtual (Render) and real (Screen) screen size
- RenderW := 800;
- RenderH := 600;
- ScreenW := W;
- ScreenH := H;
-
- // clear screen once window is being shown
- // Note: SwapBuffers uses RenderW/H, so they must be defined before
- glClearColor(1, 1, 1, 1);
- glClear(GL_COLOR_BUFFER_BIT);
- SwapBuffers;
-end;
-
-procedure LoadLoadingScreen;
-begin
- ScreenLoading := TScreenLoading.Create;
- ScreenLoading.onShow;
-
- Display.CurrentScreen := @ScreenLoading;
-
- swapbuffers;
-
- ScreenLoading.Draw;
- Display.Draw;
-
- SwapBuffers;
-end;
-
-procedure LoadScreens;
-begin
-{ ScreenLoading := TScreenLoading.Create;
- ScreenLoading.onShow;
- Display.CurrentScreen := @ScreenLoading;
- ScreenLoading.Draw;
- Display.Draw;
- SwapBuffers;
-}
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Loading', 3); Log.BenchmarkStart(3);
-{ ScreenWelcome := TScreenWelcome.Create; //'BG', 4, 3);
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Welcome', 3); Log.BenchmarkStart(3);}
- ScreenMain := TScreenMain.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Main', 3); Log.BenchmarkStart(3);
- ScreenName := TScreenName.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Name', 3); Log.BenchmarkStart(3);
- ScreenLevel := TScreenLevel.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Level', 3); Log.BenchmarkStart(3);
- ScreenSong := TScreenSong.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Song', 3); Log.BenchmarkStart(3);
- ScreenSongMenu := TScreenSongMenu.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Song Menu', 3); Log.BenchmarkStart(3);
- ScreenSing := TScreenSing.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Sing', 3); Log.BenchmarkStart(3);
- ScreenScore := TScreenScore.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Score', 3); Log.BenchmarkStart(3);
- ScreenTop5 := TScreenTop5.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Top5', 3); Log.BenchmarkStart(3);
- ScreenOptions := TScreenOptions.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options', 3); Log.BenchmarkStart(3);
- ScreenOptionsGame := TScreenOptionsGame.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Game', 3); Log.BenchmarkStart(3);
- ScreenOptionsGraphics := TScreenOptionsGraphics.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Graphics', 3); Log.BenchmarkStart(3);
- ScreenOptionsSound := TScreenOptionsSound.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Sound', 3); Log.BenchmarkStart(3);
- ScreenOptionsLyrics := TScreenOptionsLyrics.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Lyrics', 3); Log.BenchmarkStart(3);
- ScreenOptionsThemes := TScreenOptionsThemes.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Themes', 3); Log.BenchmarkStart(3);
- ScreenOptionsRecord := TScreenOptionsRecord.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Record', 3); Log.BenchmarkStart(3);
- ScreenOptionsAdvanced := TScreenOptionsAdvanced.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Advanced', 3); Log.BenchmarkStart(3);
- ScreenEditSub := TScreenEditSub.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Edit Sub', 3); Log.BenchmarkStart(3);
- ScreenEdit := TScreenEdit.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Edit', 3); Log.BenchmarkStart(3);
- ScreenEditConvert := TScreenEditConvert.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen EditConvert', 3); Log.BenchmarkStart(3);
-// ScreenEditHeader := TScreenEditHeader.Create(Skin.ScoreBG);
-// Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Edit Header', 3); Log.BenchmarkStart(3);
- ScreenOpen := TScreenOpen.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Open', 3); Log.BenchmarkStart(3);
- ScreenSingModi := TScreenSingModi.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Sing with Modi support', 3); Log.BenchmarkStart(3);
- ScreenSongMenu := TScreenSongMenu.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen SongMenu', 3); Log.BenchmarkStart(3);
- ScreenSongJumpto := TScreenSongJumpto.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen SongJumpto', 3); Log.BenchmarkStart(3);
- ScreenPopupCheck := TScreenPopupCheck.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Popup (Check)', 3); Log.BenchmarkStart(3);
- ScreenPopupError := TScreenPopupError.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Popup (Error)', 3); Log.BenchmarkStart(3);
- ScreenPartyNewRound := TScreenPartyNewRound.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyNewRound', 3); Log.BenchmarkStart(3);
- ScreenPartyScore := TScreenPartyScore.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyScore', 3); Log.BenchmarkStart(3);
- ScreenPartyWin := TScreenPartyWin.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyWin', 3); Log.BenchmarkStart(3);
- ScreenPartyOptions := TScreenPartyOptions.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyOptions', 3); Log.BenchmarkStart(3);
- ScreenPartyPlayer := TScreenPartyPlayer.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyPlayer', 3); Log.BenchmarkStart(3);
- ScreenStatMain := TScreenStatMain.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Stat Main', 3); Log.BenchmarkStart(3);
- ScreenStatDetail := TScreenStatDetail.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Stat Detail', 3); Log.BenchmarkStart(3);
- ScreenCredits := TScreenCredits.Create;
- Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Credits', 3); Log.BenchmarkStart(3);
-
-end;
-
-function LoadingThreadFunction: integer;
-begin
- LoadScreens;
- Result:= 1;
-end;
-
-procedure UnLoadScreens;
-begin
- freeandnil( ScreenMain );
- freeandnil( ScreenName );
- freeandnil( ScreenLevel);
- freeandnil( ScreenSong );
- freeandnil( ScreenSongMenu );
- freeandnil( ScreenSing );
- freeandnil( ScreenScore);
- freeandnil( ScreenTop5 );
- freeandnil( ScreenOptions );
- freeandnil( ScreenOptionsGame );
- freeandnil( ScreenOptionsGraphics );
- freeandnil( ScreenOptionsSound );
- freeandnil( ScreenOptionsLyrics );
-// freeandnil( ScreenOptionsThemes );
- freeandnil( ScreenOptionsRecord );
- freeandnil( ScreenOptionsAdvanced );
- freeandnil( ScreenEditSub );
- freeandnil( ScreenEdit );
- freeandnil( ScreenEditConvert );
- freeandnil( ScreenOpen );
- freeandnil( ScreenSingModi );
- freeandnil( ScreenSongMenu );
- freeandnil( ScreenSongJumpto);
- freeandnil( ScreenPopupCheck );
- freeandnil( ScreenPopupError );
- freeandnil( ScreenPartyNewRound );
- freeandnil( ScreenPartyScore );
- freeandnil( ScreenPartyWin );
- freeandnil( ScreenPartyOptions );
- freeandnil( ScreenPartyPlayer );
- freeandnil( ScreenStatMain );
- freeandnil( ScreenStatDetail );
-end;
-
-end.
diff --git a/src/classes/UGraphicClasses.pas b/src/classes/UGraphicClasses.pas
deleted file mode 100644
index b7174991..00000000
--- a/src/classes/UGraphicClasses.pas
+++ /dev/null
@@ -1,673 +0,0 @@
-// notes:
-unit UGraphicClasses;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses UTexture,SDL;
-
-const DelayBetweenFrames : Cardinal = 60;
-type
-
- TParticleType=(GoldenNote, PerfectNote, NoteHitTwinkle, PerfectLineTwinkle, ColoredStar, Flare);
-
- TColour3f = Record
- r, g, b: Real;
- end;
-
- TParticle = Class
- X, Y : Real; //Position
- Screen : Integer;
- W, H : Cardinal; //dimensions of particle
- Col : array of TColour3f; // Colour(s) of particle
- Scale : array of Real; // Scaling factors of particle layers
- Frame : Byte; //act. Frame
- Tex : Cardinal; //Tex num from Textur Manager
- Live : Byte; //How many Cycles before Kill
- RecIndex : Integer; //To which rectangle this particle belongs (only GoldenNote)
- StarType : TParticleType; // GoldenNote | PerfectNote | NoteHitTwinkle | PerfectLineTwinkle
- Alpha : Real; // used for fading...
- mX, mY : Real; // movement-vector for PerfectLineTwinkle
- SizeMod : Real; // experimental size modifier
- SurviveSentenceChange : Boolean;
-
- Constructor Create(cX,cY: Real; cScreen: Integer; cLive: Byte; cFrame : integer; cRecArrayIndex : Integer; cStarType : TParticleType; Player: Cardinal);
- Destructor Destroy(); override;
- procedure Draw;
- procedure LiveOn;
- end;
-
- RectanglePositions = Record
- xTop, yTop, xBottom, yBottom : Real;
- TotalStarCount : Integer;
- CurrentStarCount : Integer;
- Screen : Integer;
- end;
-
- PerfectNotePositions = Record
- xPos, yPos : Real;
- Screen : Integer;
- end;
-
- TEffectManager = Class
- Particle : array of TParticle;
- LastTime : Cardinal;
- RecArray : Array of RectanglePositions;
- TwinkleArray : Array[0..5] of Real; // store x-position of last twinkle for every player
- PerfNoteArray : Array of PerfectNotePositions;
-
- FlareTex: TTexture;
-
- constructor Create;
- destructor Destroy; override;
- procedure Draw;
- function Spawn(X, Y: Real;
- Screen: Integer;
- Live: Byte;
- StartFrame: Integer;
- RecArrayIndex: Integer; // this is only used with GoldenNotes
- StarType: TParticleType;
- Player: Cardinal // for PerfectLineTwinkle
- ): Cardinal;
- procedure SpawnRec();
- procedure Kill(index: Cardinal);
- procedure KillAll();
- procedure SentenceChange();
- procedure SaveGoldenStarsRec(Xtop, Ytop, Xbottom, Ybottom: Real);
- procedure SavePerfectNotePos(Xtop, Ytop: Real);
- procedure GoldenNoteTwinkle(Top,Bottom,Right: Real; Player: Integer);
- procedure SpawnPerfectLineTwinkle();
- end;
-
-var GoldenRec : TEffectManager;
-
-implementation
-
-uses sysutils,
- gl,
- UIni,
- UMain,
- UThemes,
- USkins,
- UGraphic,
- UDrawTexture,
- UCommon,
- math;
-
-//TParticle
-Constructor TParticle.Create(cX,cY: Real; cScreen: Integer; cLive: Byte; cFrame : integer; cRecArrayIndex : Integer; cStarType : TParticleType; Player: Cardinal);
-begin
- inherited Create;
- // in this constructor we set all initial values for our particle
- X := cX;
- Y := cY;
- Screen := cScreen;
- Live := cLive;
- Frame:= cFrame;
- RecIndex := cRecArrayIndex;
- StarType := cStarType;
- Alpha := (-cos((Frame+1)*2*pi/16)+1); // neat fade-in-and-out
- SetLength(Scale,1);
- Scale[0] := 1;
- SurviveSentenceChange := False;
- SizeMod := 1;
- case cStarType of
- GoldenNote:
- begin
- Tex := Tex_Note_Star.TexNum;
- W := 20;
- H := 20;
- SetLength(Scale,4);
- Scale[1]:=0.8;
- Scale[2]:=0.4;
- Scale[3]:=0.3;
- SetLength(Col,4);
- Col[0].r := 1;
- Col[0].g := 0.7;
- Col[0].b := 0.1;
-
- Col[1].r := 1;
- Col[1].g := 1;
- Col[1].b := 0.4;
-
- Col[2].r := 1;
- Col[2].g := 1;
- Col[2].b := 1;
-
- Col[3].r := 1;
- Col[3].g := 1;
- Col[3].b := 1;
- end;
- PerfectNote:
- begin
- Tex := Tex_Note_Perfect_Star.TexNum;
- W := 30;
- H := 30;
- SetLength(Col,1);
- Col[0].r := 1;
- Col[0].g := 1;
- Col[0].b := 0.95;
- end;
- NoteHitTwinkle:
- begin
- Tex := Tex_Note_Star.TexNum;
- Alpha := (Live/16); // linear fade-out
- W := 15;
- H := 15;
- Setlength(Col,1);
- Col[0].r := 1;
- Col[0].g := 1;
- Col[0].b := RandomRange(10*Live,100)/90; //0.9;
- end;
- PerfectLineTwinkle:
- begin
- Tex := Tex_Note_Star.TexNum;
- W := RandomRange(10,20);
- H := W;
- SizeMod := (-cos((Frame+1)*5*2*pi/16)*0.5+1.1);
- SurviveSentenceChange:=True;
- // assign colours according to player given
- SetLength(Scale,3);
- Scale[1]:=0.3;
- Scale[2]:=0.2;
- SetLength(Col,3);
- case Player of
- 0: LoadColor(Col[0].r,Col[0].g,Col[0].b,'P1Light');
- 1: LoadColor(Col[0].r,Col[0].g,Col[0].b,'P2Light');
- 2: LoadColor(Col[0].r,Col[0].g,Col[0].b,'P3Light');
- 3: LoadColor(Col[0].r,Col[0].g,Col[0].b,'P4Light');
- 4: LoadColor(Col[0].r,Col[0].g,Col[0].b,'P5Light');
- 5: LoadColor(Col[0].r,Col[0].g,Col[0].b,'P6Light');
- else LoadColor(Col[0].r,Col[0].g,Col[0].b,'P1Light');
- end;
- Col[1].r := 1;
- Col[1].g := 1;
- Col[1].b := 0.4;
- Col[2].r:=Col[0].r+0.5;
- Col[2].g:=Col[0].g+0.5;
- Col[2].b:=Col[0].b+0.5;
- mX := RandomRange(-5,5);
- mY := RandomRange(-5,5);
- end;
- ColoredStar:
- begin
- Tex := Tex_Note_Star.TexNum;
- W := RandomRange(10,20);
- H := W;
- SizeMod := (-cos((Frame+1)*5*2*pi/16)*0.5+1.1);
- SurviveSentenceChange:=True;
- // assign colours according to player given
- SetLength(Scale,1);
- SetLength(Col,1);
- Col[0].b := (Player and $ff)/255;
- Col[0].g := ((Player shr 8) and $ff)/255;
- Col[0].r := ((Player shr 16) and $ff)/255;
- mX := 0;
- mY := 0;
- end;
- Flare:
- begin
- Tex := Tex_Note_Star.TexNum;
- W := 7;
- H := 7;
- SizeMod := (-cos((Frame+1)*5*2*pi/16)*0.5+1.1);
- mX := RandomRange(-5,5);
- mY := RandomRange(-5,5);
- SetLength(Scale,4);
- Scale[1]:=0.8;
- Scale[2]:=0.4;
- Scale[3]:=0.3;
- SetLength(Col,4);
- Col[0].r := 1;
- Col[0].g := 0.7;
- Col[0].b := 0.1;
-
- Col[1].r := 1;
- Col[1].g := 1;
- Col[1].b := 0.4;
-
- Col[2].r := 1;
- Col[2].g := 1;
- Col[2].b := 1;
-
- Col[3].r := 1;
- Col[3].g := 1;
- Col[3].b := 1;
-
- end;
- else // just some random default values
- begin
- Tex := Tex_Note_Star.TexNum;
- Alpha := 1;
- W := 20;
- H := 20;
- SetLength(Col,1);
- Col[0].r := 1;
- Col[0].g := 1;
- Col[0].b := 1;
- end;
- end;
-end;
-
-Destructor TParticle.Destroy();
-begin
- SetLength(Scale,0);
- SetLength(Col,0);
- inherited;
-end;
-
-procedure TParticle.LiveOn;
-begin
- //Live = 0 => Live forever <blindy> ?? but if this is 0 they would be killed in the Manager at Draw
- if (Live > 0) then
- Dec(Live);
-
- // animate frames
- Frame := ( Frame + 1 ) mod 16;
-
- // make our particles do funny stuff (besides being animated)
- // changes of any particle-values throughout its life are done here
- case StarType of
- GoldenNote:
- begin
- Alpha := (-cos((Frame+1)*2*pi/16)+1); // neat fade-in-and-out
- end;
- PerfectNote:
- begin
- Alpha := (-cos((Frame+1)*2*pi/16)+1); // neat fade-in-and-out
- end;
- NoteHitTwinkle:
- begin
- Alpha := (Live/10); // linear fade-out
- end;
- PerfectLineTwinkle:
- begin
- Alpha := (-cos((Frame+1)*2*pi/16)+1); // neat fade-in-and-out
- SizeMod := (-cos((Frame+1)*5*2*pi/16)*0.5+1.1);
- // move around
- X := X + mX;
- Y := Y + mY;
- end;
- ColoredStar:
- begin
- Alpha := (-cos((Frame+1)*2*pi/16)+1); // neat fade-in-and-out
- end;
- Flare:
- begin
- Alpha := (-cos((Frame+1)/16*1.7*pi+0.3*pi)+1); // neat fade-in-and-out
- SizeMod := (-cos((Frame+1)*5*2*pi/16)*0.5+1.1);
- // move around
- X := X + mX;
- Y := Y + mY;
- mY:=mY+1.8;
-// mX:=mX/2;
- end;
- end;
-end;
-
-procedure TParticle.Draw;
-var L: Cardinal;
-begin
- if ScreenAct = Screen then
- // this draws (multiple) texture(s) of our particle
- for L:=0 to High(Col) do
- begin
- glColor4f(Col[L].r, Col[L].g, Col[L].b, Alpha);
-
- glBindTexture(GL_TEXTURE_2D, Tex);
- glEnable(GL_TEXTURE_2D);
- glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
- glEnable(GL_BLEND);
-
- begin
- glBegin(GL_QUADS);
- glTexCoord2f((1/16) * Frame, 0); glVertex2f(X-W*Scale[L]*SizeMod, Y-H*Scale[L]*SizeMod);
- glTexCoord2f((1/16) * Frame + (1/16), 0); glVertex2f(X-W*Scale[L]*SizeMod, Y+H*Scale[L]*SizeMod);
- glTexCoord2f((1/16) * Frame + (1/16), 1); glVertex2f(X+W*Scale[L]*SizeMod, Y+H*Scale[L]*SizeMod);
- glTexCoord2f((1/16) * Frame, 1); glVertex2f(X+W*Scale[L]*SizeMod, Y-H*Scale[L]*SizeMod);
- glEnd;
- end;
- end;
- glcolor4f(1,1,1,1);
-end;
-// end of TParticle
-
-// TEffectManager
-
-constructor TEffectManager.Create;
-var c: Cardinal;
-begin
- inherited;
- LastTime := SDL_GetTicks();
- for c:=0 to 5 do
- begin
- TwinkleArray[c] := 0;
- end;
-end;
-
-destructor TEffectManager.Destroy;
-begin
- Killall;
- inherited;
-end;
-
-
-procedure TEffectManager.Draw;
-var
- I: Integer;
- CurrentTime: Cardinal;
-//const
-// DelayBetweenFrames : Cardinal = 100;
-begin
-
- CurrentTime := SDL_GetTicks();
- //Manage particle life
- if (CurrentTime - LastTime) > DelayBetweenFrames then
- begin
- LastTime := CurrentTime;
- for I := 0 to high(Particle) do
- Particle[I].LiveOn;
- end;
-
- I := 0;
- //Kill dead particles
- while (I <= High(Particle)) do
- begin
- if (Particle[I].Live <= 0) then
- begin
- kill(I);
- end
- else
- begin
- inc(I);
- end;
- end;
-
- //Draw
- for I := 0 to high(Particle) do
- begin
- Particle[I].Draw;
- end;
-end;
-
-// this method creates just one particle
-function TEffectManager.Spawn(X, Y: Real; Screen: Integer; Live: Byte; StartFrame : Integer; RecArrayIndex : Integer; StarType : TParticleType; Player: Cardinal): Cardinal;
-begin
- Result := Length(Particle);
- SetLength(Particle, (Result + 1));
- Particle[Result] := TParticle.Create(X, Y, Screen, Live, StartFrame, RecArrayIndex, StarType, Player);
-end;
-
-// manage Sparkling of GoldenNote Bars
-procedure TEffectManager.SpawnRec();
-Var
- Xkatze, Ykatze : Real;
- RandomFrame : Integer;
- P : Integer; // P as seen on TV as Positionman
-begin
-//Spawn a random amount of stars within the given coordinates
-//RandomRange(0,14) <- this one starts at a random frame, 16 is our last frame - would be senseless to start a particle with 16, cause it would be dead at the next frame
-for P:= 0 to high(RecArray) do
- begin
- while (RecArray[P].TotalStarCount > RecArray[P].CurrentStarCount) do
- begin
- Xkatze := RandomRange(Ceil(RecArray[P].xTop), Ceil(RecArray[P].xBottom));
- Ykatze := RandomRange(Ceil(RecArray[P].yTop), Ceil(RecArray[P].yBottom));
- RandomFrame := RandomRange(0,14);
- // Spawn a GoldenNote Particle
- Spawn(Xkatze, Ykatze, RecArray[P].Screen, 16 - RandomFrame, RandomFrame, P, GoldenNote, 0);
- inc(RecArray[P].CurrentStarCount);
- end;
- end;
- draw;
-end;
-
-// kill one particle (with given index in our particle array)
-procedure TEffectManager.Kill(Index: Cardinal);
-var
- LastParticleIndex : Integer;
-begin
-// delete particle indexed by Index,
-// overwrite it's place in our particle-array with the particle stored at the last array index,
-// shorten array
- LastParticleIndex := high(Particle);
- if not(LastParticleIndex = -1) then // is there still a particle to delete?
- begin
- if not(Particle[Index].RecIndex = -1) then // if it is a GoldenNote particle...
- dec(RecArray[Particle[Index].RecIndex].CurrentStarCount); // take care of its associated GoldenRec
- // now get rid of that particle
- Particle[Index].Destroy;
- Particle[Index] := Particle[LastParticleIndex];
- SetLength(Particle, LastParticleIndex);
- end;
-end;
-
-// clean up all particles and management structures
-procedure TEffectManager.KillAll();
-var c: Cardinal;
-begin
-//It's the kill all kennies rotuine
- while Length(Particle) > 0 do // kill all existing particles
- Kill(0);
- SetLength(RecArray,0); // remove GoldenRec positions
- SetLength(PerfNoteArray,0); // remove PerfectNote positions
- for c:=0 to 5 do
- begin
- TwinkleArray[c] := 0; // reset GoldenNoteHit memory
- end;
-end;
-
-procedure TEffectManager.SentenceChange();
-var c: Cardinal;
-begin
- c:=0;
- while c <= High(Particle) do
- begin
- if Particle[c].SurviveSentenceChange then
- inc(c)
- else
- Kill(c);
- end;
- SetLength(RecArray,0); // remove GoldenRec positions
- SetLength(PerfNoteArray,0); // remove PerfectNote positions
- for c:=0 to 5 do
- begin
- TwinkleArray[c] := 0; // reset GoldenNoteHit memory
- end;
-end;
-
-procedure TeffectManager.GoldenNoteTwinkle(Top,Bottom,Right: Real; Player: Integer);
-//Twinkle stars while golden note hit
-// this is called from UDraw.pas, SingDrawPlayerCzesc
-var
- C, P, XKatze, YKatze, LKatze: Integer;
- H: Real;
-begin
- // make sure we spawn only one time at one position
- if (TwinkleArray[Player] < Right) then
- For P := 0 to high(RecArray) do // Are we inside a GoldenNoteRectangle?
- begin
- H := (Top+Bottom)/2; // helper...
- with RecArray[P] do
- if ((xBottom >= Right) and (xTop <= Right) and
- (yTop <= H) and (yBottom >= H))
- and (Screen = ScreenAct) then
- begin
- TwinkleArray[Player] := Right; // remember twinkle position for this player
- for C := 1 to 10 do
- begin
- Ykatze := RandomRange(ceil(Top) , ceil(Bottom));
- XKatze := RandomRange(-7,3);
- LKatze := RandomRange(7,13);
- Spawn(Ceil(Right)+XKatze, YKatze, ScreenAct, LKatze, 0, -1, NoteHitTwinkle, 0);
- end;
- for C := 1 to 3 do
- begin
- Ykatze := RandomRange(ceil(Top)-6 , ceil(Top));
- XKatze := RandomRange(-5,1);
- LKatze := RandomRange(4,7);
- Spawn(Ceil(Right)+XKatze, YKatze, ScreenAct, LKatze, 0, -1, NoteHitTwinkle, 0);
- end;
- for C := 1 to 3 do
- begin
- Ykatze := RandomRange(ceil(Bottom), ceil(Bottom)+6);
- XKatze := RandomRange(-5,1);
- LKatze := RandomRange(4,7);
- Spawn(Ceil(Right)+XKatze, YKatze, ScreenAct, LKatze, 0, -1, NoteHitTwinkle, 0);
- end;
- for C := 1 to 3 do
- begin
- Ykatze := RandomRange(ceil(Top)-10 , ceil(Top)-6);
- XKatze := RandomRange(-5,1);
- LKatze := RandomRange(1,4);
- Spawn(Ceil(Right)+XKatze, YKatze, ScreenAct, LKatze, 0, -1, NoteHitTwinkle, 0);
- end;
- for C := 1 to 3 do
- begin
- Ykatze := RandomRange(ceil(Bottom)+6 , ceil(Bottom)+10);
- XKatze := RandomRange(-5,1);
- LKatze := RandomRange(1,4);
- Spawn(Ceil(Right)+XKatze, YKatze, ScreenAct, LKatze, 0, -1, NoteHitTwinkle, 0);
- end;
-
- exit; // found a matching GoldenRec, did spawning stuff... done
- end;
- end;
-end;
-
-procedure TEffectManager.SaveGoldenStarsRec(Xtop, Ytop, Xbottom, Ybottom: Real);
-var
- P : Integer; // P like used in Positions
- NewIndex : Integer;
-begin
- For P := 0 to high(RecArray) do // Do we already have that "new" position?
- begin
- if (ceil(RecArray[P].xTop) = ceil(Xtop)) and
- (ceil(RecArray[P].yTop) = ceil(Ytop)) and
- (ScreenAct = RecArray[p].Screen) then
- exit; // it's already in the array, so we don't have to create a new one
- end;
-
- // we got a new position, add the new positions to our array
- NewIndex := Length(RecArray);
- SetLength(RecArray, NewIndex + 1);
- RecArray[NewIndex].xTop := Xtop;
- RecArray[NewIndex].yTop := Ytop;
- RecArray[NewIndex].xBottom := Xbottom;
- RecArray[NewIndex].yBottom := Ybottom;
- RecArray[NewIndex].TotalStarCount := ceil(Xbottom - Xtop) div 12 + 3;
- RecArray[NewIndex].CurrentStarCount := 0;
- RecArray[NewIndex].Screen := ScreenAct;
-end;
-
-procedure TEffectManager.SavePerfectNotePos(Xtop, Ytop: Real);
-var
- P : Integer; // P like used in Positions
- NewIndex : Integer;
- RandomFrame : Integer;
- Xkatze, Ykatze : Integer;
-begin
- For P := 0 to high(PerfNoteArray) do // Do we already have that "new" position?
- begin
- with PerfNoteArray[P] do
- if (ceil(xPos) = ceil(Xtop)) and (ceil(yPos) = ceil(Ytop)) and
- (Screen = ScreenAct) then
- exit; // it's already in the array, so we don't have to create a new one
- end; //for
-
- // we got a new position, add the new positions to our array
- NewIndex := Length(PerfNoteArray);
- SetLength(PerfNoteArray, NewIndex + 1);
- PerfNoteArray[NewIndex].xPos := Xtop;
- PerfNoteArray[NewIndex].yPos := Ytop;
- PerfNoteArray[NewIndex].Screen := ScreenAct;
-
- for P:= 0 to 2 do
- begin
- Xkatze := RandomRange(ceil(Xtop) - 5 , ceil(Xtop) + 10);
- Ykatze := RandomRange(ceil(Ytop) - 5 , ceil(Ytop) + 10);
- RandomFrame := RandomRange(0,14);
- Spawn(Xkatze, Ykatze, ScreenAct, 16 - RandomFrame, RandomFrame, -1, PerfectNote, 0);
- end; //for
-
-end;
-
-procedure TEffectManager.SpawnPerfectLineTwinkle();
-var
- P,I,Life: Cardinal;
- Left, Right, Top, Bottom: Cardinal;
- cScreen: Integer;
-begin
-// calculation of coordinates done with hardcoded values like in UDraw.pas
-// might need to be adjusted if drawing of SingScreen is modified
-// coordinates may still be a bit weird and need adjustment
- if Ini.SingWindow = 0 then begin
- Left := 130;
- end else begin
- Left := 30;
- end;
- Right := 770;
- // spawn effect for every player with a perfect line
- for P:=0 to PlayersPlay-1 do
- if Player[P].LastSentencePerfect then
- begin
- // calculate area where notes of this player are drawn
- case PlayersPlay of
- 1: begin
- Bottom:=Skin_P2_NotesB+10;
- Top:=Bottom-105;
- cScreen:=1;
- end;
- 2,4: begin
- case P of
- 0,2: begin
- Bottom:=Skin_P1_NotesB+10;
- Top:=Bottom-105;
- end;
- else begin
- Bottom:=Skin_P2_NotesB+10;
- Top:=Bottom-105;
- end;
- end;
- case P of
- 0,1: cScreen:=1;
- else cScreen:=2;
- end;
- end;
- 3,6: begin
- case P of
- 0,3: begin
- Top:=130;
- Bottom:=Top+85;
- end;
- 1,4: begin
- Top:=255;
- Bottom:=Top+85;
- end;
- 2,5: begin
- Top:=380;
- Bottom:=Top+85;
- end;
- end;
- case P of
- 0,1,2: cScreen:=1;
- else cScreen:=2;
- end;
- end;
- end;
- // spawn Sparkling Stars inside calculated coordinates
- for I:= 0 to 80 do
- begin
- Life:=RandomRange(8,16);
- Spawn(RandomRange(Left,Right), RandomRange(Top,Bottom), cScreen, Life, 16-Life, -1, PerfectLineTwinkle, P);
- end;
- end;
-end;
-
-end.
-
diff --git a/src/classes/UHooks.pas b/src/classes/UHooks.pas
deleted file mode 100644
index f0ba3276..00000000
--- a/src/classes/UHooks.pas
+++ /dev/null
@@ -1,434 +0,0 @@
-unit UHooks;
-
-{*********************
- THookManager
- Class for saving, managing and calling of Hooks.
- Saves all hookable events and their subscribers
-*********************}
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses uPluginDefs,
- SysUtils;
-
-type
- //Record that saves info from Subscriber
- PSubscriberInfo = ^TSubscriberInfo;
- TSubscriberInfo = record
- Self: THandle; //ID of this Subscription (First Word: ID of Subscription; 2nd Word: ID of Hook)
- Next: PSubscriberInfo; //Pointer to next Item in HookChain
-
- Owner: Integer; //For Error Handling and Plugin Unloading.
-
- //Here is s/t tricky
- //To avoid writing of Wrapping Functions to Hook an Event with a Class
- //We save a Normal Proc or a Method of a Class
- Case isClass: boolean of
- False: (Proc: TUS_Hook); //Proc that will be called on Event
- True: (ProcOfClass: TUS_Hook_of_Object);
- end;
-
- TEventInfo = record
- Name: String[60]; //Name of Event
- FirstSubscriber: PSubscriberInfo; //First subscriber in chain
- LastSubscriber: PSubscriberInfo; //Last " (for easier subscriber adding
- end;
-
- THookManager = class
- private
- Events: array of TEventInfo;
- SpaceinEvents: Word; //Number of empty Items in Events Array. (e.g. Deleted Items)
-
- Procedure FreeSubscriber(const EventIndex: Word; const Last, Cur: PSubscriberInfo);
- public
- constructor Create(const SpacetoAllocate: Word);
-
- Function AddEvent (const EventName: PChar): THandle;
- Function DelEvent (hEvent: THandle): Integer;
-
- Function AddSubscriber (const EventName: PChar; const Proc: TUS_Hook = nil; const ProcOfClass: TUS_Hook_of_Object = nil): THandle;
- Function DelSubscriber (const hSubscriber: THandle): Integer;
-
- Function CallEventChain (const hEvent: THandle; const wParam: TwParam; lParam: TlParam): Integer;
- Function EventExists (const EventName: PChar): Integer;
-
- Procedure DelbyOwner(const Owner: Integer);
- end;
-
-function HookTest(wParam: TwParam; lParam: TlParam): integer; stdcall;
-
-var
- HookManager: THookManager;
-
-implementation
-uses
- ULog,
- UCore;
-
-//------------
-// Create - Creates Class and Set Standard Values
-//------------
-constructor THookManager.Create(const SpacetoAllocate: Word);
-var I: Integer;
-begin
- inherited Create();
-
- //Get the Space and "Zero" it
- SetLength (Events, SpacetoAllocate);
- For I := 0 to SpacetoAllocate-1 do
- Events[I].Name[1] := chr(0);
-
- SpaceinEvents := SpacetoAllocate;
-
- {$IFDEF DEBUG}
- debugWriteLn('HookManager: Succesful Created.');
- {$ENDIF}
-end;
-
-//------------
-// AddEvent - Adds an Event and return the Events Handle or 0 on Failure
-//------------
-Function THookManager.AddEvent (const EventName: PChar): THandle;
-var I: Integer;
-begin
- Result := 0;
-
- if (EventExists(EventName) = 0) then
- begin
- If (SpaceinEvents > 0) then
- begin
- //There is already Space available
- //Go Search it!
- For I := 0 to High(Events) do
- If (Events[I].Name[1] = chr(0)) then
- begin //Found Space
- Result := I;
- Dec(SpaceinEvents);
- Break;
- end;
-
- {$IFDEF DEBUG}
- debugWriteLn('HookManager: Found Space for Event at Handle: ''' + InttoStr(Result+1) + '');
- {$ENDIF}
- end
- else
- begin //There is no Space => Go make some!
- Result := Length(Events);
- SetLength(Events, Result + 1);
- end;
-
- //Set Events Data
- Events[Result].Name := EventName;
- Events[Result].FirstSubscriber := nil;
- Events[Result].LastSubscriber := nil;
-
- //Handle is Index + 1
- Inc(Result);
-
- {$IFDEF DEBUG}
- debugWriteLn('HookManager: Add Event succesful: ''' + EventName + '');
- {$ENDIF}
- end
- {$IFDEF DEBUG}
- else
- debugWriteLn('HookManager: Trying to ReAdd Event: ''' + EventName + '');
- {$ENDIF}
-end;
-
-//------------
-// DelEvent - Deletes an Event by Handle Returns False on Failure
-//------------
-Function THookManager.DelEvent (hEvent: THandle): Integer;
-var
- Cur, Last: PSubscriberInfo;
-begin
- hEvent := hEvent - 1; //Arrayindex is Handle - 1
- Result := -1;
-
-
- If (Length(Events) > hEvent) AND (Events[hEvent].Name[1] <> chr(0)) then
- begin //Event exists
- //Free the Space for all Subscribers
- Cur := Events[hEvent].FirstSubscriber;
-
- While (Cur <> nil) do
- begin
- Last := Cur;
- Cur := Cur.Next;
- FreeMem(Last, SizeOf(TSubscriberInfo));
- end;
-
- {$IFDEF DEBUG}
- debugWriteLn('HookManager: Removed Event succesful: ''' + Events[hEvent].Name + '');
- {$ENDIF}
-
- //Free the Event
- Events[hEvent].Name[1] := chr(0);
- Inc(SpaceinEvents); //There is one more space for new events
- end
-
- {$IFDEF DEBUG}
- else
- debugWriteLn('HookManager: Try to Remove not Existing Event. Handle: ''' + InttoStr(hEvent) + '');
- {$ENDIF}
-end;
-
-//------------
-// AddSubscriber - Adds an Subscriber to the Event by Name
-// Returns Handle of the Subscribtion or 0 on Failure
-//------------
-Function THookManager.AddSubscriber (const EventName: PChar; const Proc: TUS_Hook; const ProcOfClass: TUS_Hook_of_Object): THandle;
-var
- EventHandle: THandle;
- EventIndex: Cardinal;
- Cur: PSubscriberInfo;
-begin
- Result := 0;
-
- If (@Proc <> nil) or (@ProcOfClass <> nil) then
- begin
- EventHandle := EventExists(EventName);
-
- If (EventHandle <> 0) then
- begin
- EventIndex := EventHandle - 1;
-
- //Get Memory
- GetMem(Cur, SizeOf(TSubscriberInfo));
-
- //Fill it with Data
- Cur.Next := nil;
-
- //Add Owner
- Cur.Owner := Core.CurExecuted;
-
- If (@Proc = nil) then
- begin //Use the ProcofClass Method
- Cur.isClass := True;
- Cur.ProcOfClass := ProcofClass;
- end
- else //Use the normal Proc
- begin
- Cur.isClass := False;
- Cur.Proc := Proc;
- end;
-
- //Create Handle (1st Word: Handle of Event; 2nd Word: unique ID
- If (Events[EventIndex].LastSubscriber = nil) then
- begin
- If (Events[EventIndex].FirstSubscriber = nil) then
- begin
- Result := (EventHandle SHL 16);
- Events[EventIndex].FirstSubscriber := Cur;
- end
- Else
- begin
- Result := Events[EventIndex].FirstSubscriber.Self + 1;
- end;
- end
- Else
- begin
- Result := Events[EventIndex].LastSubscriber.Self + 1;
- Events[EventIndex].LastSubscriber.Next := Cur;
- end;
-
- Cur.Self := Result;
-
- //Add to Chain
- Events[EventIndex].LastSubscriber := Cur;
-
- {$IFDEF DEBUG}
- debugWriteLn('HookManager: Add Subscriber to Event ''' + Events[EventIndex].Name + ''' succesful. Handle: ''' + InttoStr(Result) + ''' Owner: ' + InttoStr(Cur.Owner));
- {$ENDIF}
- end;
- end;
-end;
-
-//------------
-// FreeSubscriber - Helper for DelSubscriber. Prevents Loss of Chain Items. Frees Memory.
-//------------
-Procedure THookManager.FreeSubscriber(const EventIndex: Word; const Last, Cur: PSubscriberInfo);
-begin
- //Delete from Chain
- If (Last <> nil) then
- begin
- Last.Next := Cur.Next;
- end
- else //Was first Popup
- begin
- Events[EventIndex].FirstSubscriber := Cur.Next;
- end;
-
- //Was this Last subscription ?
- If (Cur = Events[EventIndex].LastSubscriber) then
- begin //Change Last Subscriber
- Events[EventIndex].LastSubscriber := Last;
- end;
-
- //Free Space:
- FreeMem(Cur, SizeOf(TSubscriberInfo));
-end;
-
-//------------
-// DelSubscriber - Deletes a Subscribtion by Handle, return non Zero on Failure
-//------------
-Function THookManager.DelSubscriber (const hSubscriber: THandle): Integer;
-var
- EventIndex: Cardinal;
- Cur, Last: PSubscriberInfo;
-begin
- Result := -1;
- EventIndex := ((hSubscriber AND (High(THandle) xor High(Word))) SHR 16) - 1;
-
- //Existing Event ?
- If (EventIndex < Length(Events)) AND (Events[EventIndex].Name[1] <> chr(0)) then
- begin
- Result := -2; //Return -1 on not existing Event, -2 on not existing Subscription
-
- //Search for Subscription
- Cur := Events[EventIndex].FirstSubscriber;
- Last := nil;
-
- //go through the chain ...
- While (Cur <> nil) do
- begin
- If (Cur.Self = hSubscriber) then
- begin //Found Subscription we searched for
- FreeSubscriber(EventIndex, Last, Cur);
-
- {$IFDEF DEBUG}
- debugWriteLn('HookManager: Del Subscriber from Event ''' + Events[EventIndex].Name + ''' succesful. Handle: ''' + InttoStr(hSubscriber) + '');
- {$ENDIF}
-
- //Set Result and Break the Loop
- Result := 0;
- Break;
- end;
-
- Last := Cur;
- Cur := Cur.Next;
- end;
-
- end;
-end;
-
-
-//------------
-// CallEventChain - Calls the Chain of a specified EventHandle
-// Returns: -1: Handle doesn't Exist, 0 Chain is called until the End
-//------------
-Function THookManager.CallEventChain (const hEvent: THandle; const wParam: TwParam; lParam: TlParam): Integer;
-var
- EventIndex: Cardinal;
- Cur: PSubscriberInfo;
- CurExecutedBackup: Integer; //backup of Core.CurExecuted Attribute
-begin
- Result := -1;
- EventIndex := hEvent - 1;
-
- If ((EventIndex <= High(Events)) AND (Events[EventIndex].Name[1] <> chr(0))) then
- begin //Existing Event
- //Backup CurExecuted
- CurExecutedBackup := Core.CurExecuted;
-
- //Start calling the Chain !!!11
- Cur := Events[EventIndex].FirstSubscriber;
- Result := 0;
- //Call Hooks until the Chain is at the End or breaked
- While ((Cur <> nil) AND (Result = 0)) do
- begin
- //Set CurExecuted
- Core.CurExecuted := Cur.Owner;
- if (Cur.isClass) then
- Result := Cur.ProcOfClass(wParam, lParam)
- else
- Result := Cur.Proc(wParam, lParam);
-
- Cur := Cur.Next;
- end;
-
- //Restore CurExecuted
- Core.CurExecuted := CurExecutedBackup;
- end;
-
- {$IFDEF DEBUG}
- debugWriteLn('HookManager: Called Chain from Event ''' + Events[EventIndex].Name + ''' succesful. Result: ''' + InttoStr(Result) + '');
- {$ENDIF}
-end;
-
-//------------
-// EventExists - Returns non Zero if an Event with the given Name exists
-//------------
-Function THookManager.EventExists (const EventName: PChar): Integer;
-var
- I: Integer;
- Name: String[60];
-begin
- Result := 0;
- //If (Length(EventName) <
- Name := String(EventName);
-
- //Sure not to search for empty space
- If (Name[1] <> chr(0)) then
- begin
- //Search for Event
- For I := 0 to High(Events) do
- If (Events[I].Name = Name) then
- begin //Event found
- Result := I + 1;
- Break;
- end;
- end;
-end;
-
-//------------
-// DelbyOwner - Dels all Subscriptions by a specific Owner. (For Clean Plugin/Module unloading)
-//------------
-Procedure THookManager.DelbyOwner(const Owner: Integer);
-var
- I: Integer;
- Cur, Last: PSubscriberInfo;
-begin
- //Search for Owner in all Hooks Chains
- For I := 0 to High(Events) do
- begin
- If (Events[I].Name[1] <> chr(0)) then
- begin
-
- Last := nil;
- Cur := Events[I].FirstSubscriber;
- //Went Through Chain
- While (Cur <> nil) do
- begin
- If (Cur.Owner = Owner) then
- begin //Found Subscription by Owner -> Delete
- FreeSubscriber(I, Last, Cur);
- If (Last <> nil) then
- Cur := Last.Next
- else
- Cur := Events[I].FirstSubscriber;
- end
- Else
- begin
- //Next Item:
- Last := Cur;
- Cur := Cur.Next;
- end;
- end;
- end;
- end;
-end;
-
-
-function HookTest(wParam: TwParam; lParam: TlParam): integer; stdcall;
-begin
- Result := 0; //Don't break the chain
- Core.ShowMessage(CORE_SM_INFO, PChar(String(PChar(Pointer(lParam))) + ': ' + String(PChar(Pointer(wParam)))));
-end;
-
-end.
diff --git a/src/classes/UImage.pas b/src/classes/UImage.pas
deleted file mode 100644
index d33c0d38..00000000
--- a/src/classes/UImage.pas
+++ /dev/null
@@ -1,993 +0,0 @@
-unit UImage;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses
- SDL;
-
-{$DEFINE HavePNG}
-{$DEFINE HaveBMP}
-{$DEFINE HaveJPG}
-
-const
- PixelFmt_RGBA: TSDL_Pixelformat = (
- palette: nil;
- BitsPerPixel: 32;
- BytesPerPixel: 4;
- Rloss: 0;
- Gloss: 0;
- Bloss: 0;
- Aloss: 0;
- Rshift: 0;
- Gshift: 8;
- Bshift: 16;
- Ashift: 24;
- Rmask: $000000ff;
- Gmask: $0000ff00;
- Bmask: $00ff0000;
- Amask: $ff000000;
- ColorKey: 0;
- Alpha: 255
- );
-
- PixelFmt_RGB: TSDL_Pixelformat = (
- palette: nil;
- BitsPerPixel: 24;
- BytesPerPixel: 3;
- Rloss: 0;
- Gloss: 0;
- Bloss: 0;
- Aloss: 0;
- Rshift: 0;
- Gshift: 8;
- Bshift: 16;
- Ashift: 0;
- Rmask: $000000ff;
- Gmask: $0000ff00;
- Bmask: $00ff0000;
- Amask: $00000000;
- ColorKey: 0;
- Alpha: 255
- );
-
- PixelFmt_BGRA: TSDL_Pixelformat = (
- palette: nil;
- BitsPerPixel: 32;
- BytesPerPixel: 4;
- Rloss: 0;
- Gloss: 0;
- Bloss: 0;
- Aloss: 0;
- Rshift: 16;
- Gshift: 8;
- Bshift: 0;
- Ashift: 24;
- Rmask: $00ff0000;
- Gmask: $0000ff00;
- Bmask: $000000ff;
- Amask: $ff000000;
- ColorKey: 0;
- Alpha: 255
- );
-
- PixelFmt_BGR: TSDL_Pixelformat = (
- palette: nil;
- BitsPerPixel: 24;
- BytesPerPixel: 3;
- Rloss: 0;
- Gloss: 0;
- Bloss: 0;
- Aloss: 0;
- Rshift: 16;
- Gshift: 8;
- Bshift: 0;
- Ashift: 0;
- Rmask: $00ff0000;
- Gmask: $0000ff00;
- Bmask: $000000ff;
- Amask: $00000000;
- ColorKey: 0;
- Alpha: 255
- );
-
-type
- TImagePixelFmt = (
- ipfRGBA, ipfRGB, ipfBGRA, ipfBGR
- );
-
-(*******************************************************
- * Image saving
- *******************************************************)
-
-{$IFDEF HavePNG}
-function WritePNGImage(const FileName: string; Surface: PSDL_Surface): boolean;
-{$ENDIF}
-{$IFDEF HaveBMP}
-function WriteBMPImage(const FileName: string; Surface: PSDL_Surface): boolean;
-{$ENDIF}
-{$IFDEF HaveJPG}
-function WriteJPGImage(const FileName: string; Surface: PSDL_Surface; Quality: integer): boolean;
-{$ENDIF}
-
-(*******************************************************
- * Image loading
- *******************************************************)
-
-function LoadImage(const Identifier: string): PSDL_Surface;
-
-(*******************************************************
- * Image manipulation
- *******************************************************)
-
-function PixelFormatEquals(fmt1, fmt2: PSDL_PixelFormat): boolean;
-procedure ScaleImage(var ImgSurface: PSDL_Surface; Width, Height: Cardinal);
-procedure FitImage(var ImgSurface: PSDL_Surface; Width, Height: Cardinal);
-procedure ColorizeImage(ImgSurface: PSDL_Surface; NewColor: Cardinal);
-
-
-implementation
-
-uses
- SysUtils,
- Classes,
- Math,
- {$IFDEF MSWINDOWS}
- Windows,
- {$ENDIF}
- {$IFDEF HaveJPG}
- {$IFDEF Delphi}
- Graphics,
- jpeg,
- {$ELSE}
- jpeglib,
- jerror,
- jcparam,
- jdatadst, jcapimin, jcapistd,
- {$ENDIF}
- {$ENDIF}
- {$IFDEF HavePNG}
- png,
- {$ENDIF}
- zlib,
- sdl_image,
- sdlutils,
- UCommon,
- ULog;
-
-
-function IsRGBSurface(pixelFmt: PSDL_PixelFormat): boolean;
-begin
- Result := (pixelFmt.BitsPerPixel = 24) and
- (pixelFmt.RMask = $0000FF) and
- (pixelFmt.GMask = $00FF00) and
- (pixelFmt.BMask = $FF0000);
-end;
-
-function IsRGBASurface(pixelFmt: PSDL_PixelFormat): boolean;
-begin
- Result := (pixelFmt.BitsPerPixel = 32) and
- (pixelFmt.RMask = $000000FF) and
- (pixelFmt.GMask = $0000FF00) and
- (pixelFmt.BMask = $00FF0000) and
- (pixelFmt.AMask = $FF000000);
-end;
-
-function IsBGRSurface(pixelFmt: PSDL_PixelFormat): boolean;
-begin
- Result := (pixelFmt.BitsPerPixel = 24) and
- (pixelFmt.BMask = $0000FF) and
- (pixelFmt.GMask = $00FF00) and
- (pixelFmt.RMask = $FF0000);
-end;
-
-function IsBGRASurface(pixelFmt: PSDL_PixelFormat): boolean;
-begin
- Result := (pixelFmt.BitsPerPixel = 32) and
- (pixelFmt.BMask = $000000FF) and
- (pixelFmt.GMask = $0000FF00) and
- (pixelFmt.RMask = $00FF0000) and
- (pixelFmt.AMask = $FF000000);
-end;
-
-// Converts alpha-formats to BGRA, non-alpha to BGR, and leaves BGR(A) as is
-// sets converted to true if the surface needed to be converted
-function ConvertToBGR_BGRASurface(Surface: PSDL_Surface; out Converted: boolean): PSDL_Surface;
-var
- pixelFmt: PSDL_PixelFormat;
-begin
- pixelFmt := Surface.format;
- if (IsBGRSurface(pixelFmt) or IsBGRASurface(pixelFmt)) then
- begin
- Converted := false;
- Result := Surface;
- end
- else
- begin
- // invalid format -> needs conversion
- if (pixelFmt.AMask <> 0) then
- Result := SDL_ConvertSurface(Surface, @PixelFmt_BGRA, SDL_SWSURFACE)
- else
- Result := SDL_ConvertSurface(Surface, @PixelFmt_BGR, SDL_SWSURFACE);
- Converted := true;
- end;
-end;
-
-// Converts alpha-formats to RGBA, non-alpha to RGB, and leaves RGB(A) as is
-// sets converted to true if the surface needed to be converted
-function ConvertToRGB_RGBASurface(Surface: PSDL_Surface; out Converted: boolean): PSDL_Surface;
-var
- pixelFmt: PSDL_PixelFormat;
-begin
- pixelFmt := Surface.format;
- if (IsRGBSurface(pixelFmt) or IsRGBASurface(pixelFmt)) then
- begin
- Converted := false;
- Result := Surface;
- end
- else
- begin
- // invalid format -> needs conversion
- if (pixelFmt.AMask <> 0) then
- Result := SDL_ConvertSurface(Surface, @PixelFmt_RGBA, SDL_SWSURFACE)
- else
- Result := SDL_ConvertSurface(Surface, @PixelFmt_RGB, SDL_SWSURFACE);
- Converted := true;
- end;
-end;
-
-
-(*******************************************************
- * Image saving
- *******************************************************)
-
-(***************************
- * PNG section
- *****************************)
-
-{$IFDEF HavePNG}
-
-// delphi does not support setjmp()/longjmp() -> define our own error-handler
-procedure user_error_fn(png_ptr: png_structp; error_msg: png_const_charp); cdecl;
-begin
- raise Exception.Create(error_msg);
-end;
-
-procedure user_read_data(png_ptr: png_structp; data: png_bytep; length: png_size_t); cdecl;
-var
- inFile: TFileStream;
-begin
- inFile := TFileStream(png_get_io_ptr(png_ptr));
- inFile.Read(data^, length);
-end;
-
-procedure user_write_data(png_ptr: png_structp; data: png_bytep; length: png_size_t); cdecl;
-var
- outFile: TFileStream;
-begin
- outFile := TFileStream(png_get_io_ptr(png_ptr));
- outFile.Write(data^, length);
-end;
-
-procedure user_flush_data(png_ptr: png_structp); cdecl;
-//var
-// outFile: TFileStream;
-begin
- // binary files are flushed automatically, Flush() works with Text-files only
- //outFile := TFileStream(png_get_io_ptr(png_ptr));
- //outFile.Flush();
-end;
-
-procedure DateTimeToPngTime(time: TDateTime; var pngTime: png_time);
-var
- year, month, day: word;
- hour, minute, second, msecond: word;
-begin
- DecodeDate(time, year, month, day);
- pngTime.year := year;
- pngTime.month := month;
- pngTime.day := day;
- DecodeTime(time, hour, minute, second, msecond);
- pngTime.hour := hour;
- pngTime.minute := minute;
- pngTime.second := second;
-end;
-
-(*
- * ImageData must be in RGB-format
- *)
-function WritePNGImage(const FileName: string; Surface: PSDL_Surface): boolean;
-var
- png_ptr: png_structp;
- info_ptr: png_infop;
- pngFile: TFileStream;
- row: integer;
- rowData: array of png_bytep;
-// rowStride: integer;
- converted: boolean;
- colorType: integer;
-// time: png_time;
-begin
- Result := false;
-
- // open file for writing
- try
- pngFile := TFileStream.Create(FileName, fmCreate);
- except
- Log.LogError('Could not open file: "' + FileName + '"', 'WritePngImage');
- Exit;
- end;
-
- // only 24bit (RGB) or 32bit (RGBA) data is supported, so convert to it
- Surface := ConvertToRGB_RGBASurface(Surface, converted);
-
- png_ptr := nil;
-
- try
- // initialize png (and enable a user-defined error-handler that throws an exception on error)
- png_ptr := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, @user_error_fn, nil);
- // the error-handler is called if png_create_write_struct() fails, so png_ptr should always be <> nil
- if (png_ptr = nil) then
- begin
- Log.LogError('png_create_write_struct() failed', 'WritePngImage');
- if (converted) then
- SDL_FreeSurface(Surface);
- Exit;
- end;
-
- info_ptr := png_create_info_struct(png_ptr);
-
- if (Surface^.format^.BitsPerPixel = 24) then
- colorType := PNG_COLOR_TYPE_RGB
- else
- colorType := PNG_COLOR_TYPE_RGBA;
-
- // define write IO-functions (POSIX-style FILE-pointers are not available in Delphi)
- png_set_write_fn(png_ptr, pngFile, @user_write_data, @user_flush_data);
- png_set_IHDR(
- png_ptr, info_ptr,
- Surface.w, Surface.h,
- 8,
- colorType,
- PNG_INTERLACE_NONE,
- PNG_COMPRESSION_TYPE_DEFAULT,
- PNG_FILTER_TYPE_DEFAULT
- );
-
- // TODO: do we need the modification time?
- //DateTimeToPngTime(Now, time);
- //png_set_tIME(png_ptr, info_ptr, @time);
-
- if (SDL_MUSTLOCK(Surface)) then
- SDL_LockSurface(Surface);
-
- // setup data
- SetLength(rowData, Surface.h);
- for row := 0 to Surface.h-1 do
- begin
- // set rowData-elements to beginning of each image row
- // Note: the byte-count of a row is pitch (which is not width*bitsPerPixel if the image is aligned)
- rowData[row] := @PChar(Surface.pixels)[(Surface.h-row-1) * Surface.pitch];
- end;
-
- if (SDL_MUSTLOCK(Surface)) then
- SDL_UnlockSurface(Surface);
-
- png_write_info(png_ptr, info_ptr);
- png_write_image(png_ptr, png_bytepp(rowData));
- png_write_end(png_ptr, nil);
-
- Result := true;
- except on E: Exception do
- Log.LogError(E.message, 'WritePngImage');
- end;
-
- // free row-data
- SetLength(rowData, 0);
-
- // free png-resources
- if (png_ptr <> nil) then
- png_destroy_write_struct(@png_ptr, nil);
-
- if (converted) then
- SDL_FreeSurface(Surface);
-
- // close file
- pngFile.Free;
-end;
-
-{$ENDIF}
-
-(***************************
- * BMP section
- *****************************)
-
-{$IFDEF HaveBMP}
-
-{$IFNDEF MSWINDOWS}
-const
- (* constants for the biCompression field *)
- BI_RGB = 0;
- BI_RLE8 = 1;
- BI_RLE4 = 2;
- BI_BITFIELDS = 3;
- BI_JPEG = 4;
- BI_PNG = 5;
-
-type
- BITMAPINFOHEADER = record
- biSize: longword;
- biWidth: longint;
- biHeight: longint;
- biPlanes: word;
- biBitCount: word;
- biCompression: longword;
- biSizeImage: longword;
- biXPelsPerMeter: longint;
- biYPelsPerMeter: longint;
- biClrUsed: longword;
- biClrImportant: longword;
- end;
- LPBITMAPINFOHEADER = ^BITMAPINFOHEADER;
- TBITMAPINFOHEADER = BITMAPINFOHEADER;
- PBITMAPINFOHEADER = ^BITMAPINFOHEADER;
-
- RGBTRIPLE = record
- rgbtBlue: byte;
- rgbtGreen: byte;
- rgbtRed: byte;
- end;
- tagRGBTRIPLE = RGBTRIPLE;
- TRGBTRIPLE = RGBTRIPLE;
- PRGBTRIPLE = ^RGBTRIPLE;
-
- RGBQUAD = record
- rgbBlue: byte;
- rgbGreen: byte;
- rgbRed: byte;
- rgbReserved: byte;
- end;
- tagRGBQUAD = RGBQUAD;
- TRGBQUAD = RGBQUAD;
- PRGBQUAD = ^RGBQUAD;
-
- BITMAPINFO = record
- bmiHeader: BITMAPINFOHEADER;
- bmiColors: array[0..0] of RGBQUAD;
- end;
- LPBITMAPINFO = ^BITMAPINFO;
- PBITMAPINFO = ^BITMAPINFO;
- TBITMAPINFO = BITMAPINFO;
-
- {$PACKRECORDS 2}
- BITMAPFILEHEADER = record
- bfType: word;
- bfSize: longword;
- bfReserved1: word;
- bfReserved2: word;
- bfOffBits: longword;
- end;
- {$PACKRECORDS DEFAULT}
-{$ENDIF}
-
-(*
- * ImageData must be in BGR-format
- *)
-function WriteBMPImage(const FileName: string; Surface: PSDL_Surface): boolean;
-var
- bmpFile: TFileStream;
- FileInfo: BITMAPINFOHEADER;
- FileHeader: BITMAPFILEHEADER;
- Converted: boolean;
- Row: integer;
- RowSize: integer;
-begin
- Result := false;
-
- // open file for writing
- try
- bmpFile := TFileStream.Create(FileName, fmCreate);
- except
- Log.LogError('Could not open file: "' + FileName + '"', 'WriteBMPImage');
- Exit;
- end;
-
- // only 24bit (BGR) or 32bit (BGRA) data is supported, so convert to it
- Surface := ConvertToBGR_BGRASurface(Surface, Converted);
-
- // aligned (4-byte) row-size in bytes
- RowSize := ((Surface.w * Surface.format.BytesPerPixel + 3) div 4) * 4;
-
- // initialize bitmap info
- FillChar(FileInfo, SizeOf(BITMAPINFOHEADER), 0);
- with FileInfo do
- begin
- biSize := SizeOf(BITMAPINFOHEADER);
- biWidth := Surface.w;
- biHeight := Surface.h;
- biPlanes := 1;
- biBitCount := Surface^.format^.BitsPerPixel;
- biCompression := BI_RGB;
- biSizeImage := RowSize * Surface.h;
- end;
-
- // initialize header-data
- FillChar(FileHeader, SizeOf(BITMAPFILEHEADER), 0);
- with FileHeader do
- begin
- bfType := $4D42; // = 'BM'
- bfOffBits := SizeOf(BITMAPFILEHEADER) + SizeOf(BITMAPINFOHEADER);
- bfSize := bfOffBits + FileInfo.biSizeImage;
- end;
-
- // and move the whole stuff into the file ;-)
- try
- // write headers
- bmpFile.Write(FileHeader, SizeOf(BITMAPFILEHEADER));
- bmpFile.Write(FileInfo, SizeOf(BITMAPINFOHEADER));
-
- // write image-data
-
- if (SDL_MUSTLOCK(Surface)) then
- SDL_LockSurface(Surface);
-
- // BMP needs 4-byte alignment
- if (Surface.pitch mod 4 = 0) then
- begin
- // aligned correctly -> write whole image at once
- bmpFile.Write(Surface.pixels^, FileInfo.biSizeImage);
- end
- else
- begin
- // misaligned -> write each line separately
- // Note: for the last line unassigned memory (> last Surface.pixels element)
- // will be copied to the padding area (last bytes of a row),
- // but we do not care because the content of padding data is ignored anyhow.
- for Row := 0 to Surface.h do
- bmpFile.Write(PChar(Surface.pixels)[Row * Surface.pitch], RowSize);
- end;
-
- if (SDL_MUSTLOCK(Surface)) then
- SDL_UnlockSurface(Surface);
-
- Result := true;
- finally
- Log.LogError('Could not write file: "' + FileName + '"', 'WriteBMPImage');
- end;
-
- if (Converted) then
- SDL_FreeSurface(Surface);
-
- // close file
- bmpFile.Free;
-end;
-
-{$ENDIF}
-
-(***************************
- * JPG section
- *****************************)
-
-{$IFDEF HaveJPG}
-
-function WriteJPGImage(const FileName: string; Surface: PSDL_Surface; Quality: integer): boolean;
-var
- {$IFDEF Delphi}
- Bitmap: TBitmap;
- BitmapInfo: TBitmapInfo;
- Jpeg: TJpegImage;
- row: integer;
- {$ELSE}
- cinfo: jpeg_compress_struct;
- jerr : jpeg_error_mgr;
- jpgFile: TFileStream;
- rowPtr: array[0..0] of JSAMPROW;
- {$ENDIF}
- converted: boolean;
-begin
- Result := false;
-
- {$IFDEF Delphi}
- // only 24bit (BGR) data is supported, so convert to it
- if (IsBGRSurface(Surface.format)) then
- converted := false
- else
- begin
- Surface := SDL_ConvertSurface(Surface, @PixelFmt_BGR, SDL_SWSURFACE);
- converted := true;
- end;
-
- // create and setup bitmap
- Bitmap := TBitmap.Create;
- Bitmap.PixelFormat := pf24bit;
- Bitmap.Width := Surface.w;
- Bitmap.Height := Surface.h;
-
- // setup bitmap info on source image (Surface parameter)
- ZeroMemory(@BitmapInfo, SizeOf(BitmapInfo));
- with BitmapInfo.bmiHeader do
- begin
- biSize := SizeOf(BITMAPINFOHEADER);
- biWidth := Surface.w;
- biHeight := Surface.h;
- biPlanes := 1;
- biBitCount := 24;
- biCompression := BI_RGB;
- end;
-
- if (SDL_MUSTLOCK(Surface)) then
- SDL_LockSurface(Surface);
-
- // use fast Win32-API functions to copy data instead of Bitmap.Canvas.Pixels
- if (Surface.pitch mod 4 = 0) then
- begin
- // if the image is aligned (to a 4-byte boundary) -> copy all data at once
- // Note: surfaces created with SDL (e.g. with SDL_ConvertSurface) are aligned
- SetDIBits(0, Bitmap.Handle, 0, Bitmap.Height, Surface.pixels, BitmapInfo, DIB_RGB_COLORS);
- end
- else
- begin
- // wrong alignment -> copy each line separately.
- // Note: for the last line unassigned memory (> last Surface.pixels element)
- // will be copied to the padding area (last bytes of a row),
- // but we do not care because the content of padding data is ignored anyhow.
- for row := 0 to Surface.h do
- begin
- SetDIBits(0, Bitmap.Handle, row, 1, @PChar(Surface.pixels)[row * Surface.pitch],
- BitmapInfo, DIB_RGB_COLORS);
- end;
- end;
-
- if (SDL_MUSTLOCK(Surface)) then
- SDL_UnlockSurface(Surface);
-
- // assign Bitmap to JPEG and store the latter
- Jpeg := TJPEGImage.Create;
- Jpeg.Assign(Bitmap);
- Bitmap.Free;
- Jpeg.CompressionQuality := Quality;
- try
- // compress image (don't forget this line, otherwise it won't be compressed)
- Jpeg.Compress();
- Jpeg.SaveToFile(FileName);
- except
- Log.LogError('Could not save file: "' + FileName + '"', 'WriteJPGImage');
- Exit;
- end;
- Jpeg.Free;
- {$ELSE}
- // based on example.pas in FPC's packages/base/pasjpeg directory
-
- // only 24bit (RGB) data is supported, so convert to it
- if (IsRGBSurface(Surface.format)) then
- converted := false
- else
- begin
- Surface := SDL_ConvertSurface(Surface, @PixelFmt_RGB, SDL_SWSURFACE);
- converted := true;
- end;
-
- // allocate and initialize JPEG compression object
- cinfo.err := jpeg_std_error(jerr);
- // msg_level that will be displayed. (Nomssi)
- //jerr.trace_level := 3;
- // initialize the JPEG compression object
- jpeg_create_compress(@cinfo);
-
- // open file for writing
- try
- jpgFile := TFileStream.Create(FileName, fmCreate);
- except
- Log.LogError('Could not open file: "' + FileName + '"', 'WriteJPGImage');
- Exit;
- end;
-
- // specify data destination
- jpeg_stdio_dest(@cinfo, @jpgFile);
-
- // set parameters for compression
- cinfo.image_width := Surface.w;
- cinfo.image_height := Surface.h;
- cinfo.in_color_space := JCS_RGB;
- cinfo.input_components := 3;
- cinfo.data_precision := 8;
-
- // set default compression parameters
- jpeg_set_defaults(@cinfo);
- jpeg_set_quality(@cinfo, quality, true);
-
- // start compressor
- jpeg_start_compress(@cinfo, true);
-
- if (SDL_MUSTLOCK(Surface)) then
- SDL_LockSurface(Surface);
-
- while (cinfo.next_scanline < cinfo.image_height) do
- begin
- // Note: the byte-count of a row is pitch (which is not width*bitsPerPixel if the image is aligned)
- rowPtr[0] := JSAMPROW(@PChar(Surface.pixels)[(Surface.h-cinfo.next_scanline-1) * Surface.pitch]);
- jpeg_write_scanlines(@cinfo, JSAMPARRAY(@rowPtr), 1);
- end;
-
- if (SDL_MUSTLOCK(Surface)) then
- SDL_UnlockSurface(Surface);
-
- // finish compression
- jpeg_finish_compress(@cinfo);
- // close the output file
- jpgFile.Free;
-
- // release JPEG compression object
- jpeg_destroy_compress(@cinfo);
- {$ENDIF}
-
- if (converted) then
- SDL_FreeSurface(Surface);
-
- Result := true;
-end;
-
-{$ENDIF}
-
-
-(*******************************************************
- * Image loading
- *******************************************************)
-
-
-(*
- * Loads an image from the given file or resource
- *)
-function LoadImage(const Identifier: string): PSDL_Surface;
-var
- TexRWops: PSDL_RWops;
- TexStream: TStream;
- FileName: string;
-begin
- Result := nil;
- TexRWops := nil;
-
- if Identifier = '' then
- exit;
-
- //Log.LogStatus( Identifier, 'LoadImage' );
-
- FileName := Identifier;
-
- if (FileExistsInsensitive(FileName)) then
- begin
- // load from file
- //Log.LogStatus( 'Is File ( Loading : '+FileName+')', ' LoadImage' );
- try
- Result := IMG_Load(PChar(FileName));
- //Log.LogStatus( ' '+inttostr( integer( Result ) ), ' LoadImage' );
- except
- Log.LogError('Could not load from file "'+FileName+'"', 'LoadImage');
- Exit;
- end;
- end
- else
- begin
- //Log.LogStatus( 'IS Resource, because file does not exist.('+Identifier+')', ' LoadImage' );
-
- TexStream := GetResourceStream(Identifier, 'TEX');
- if (not assigned(TexStream)) then
- begin
- Log.LogError( 'Invalid file or resource "'+ Identifier+'"', 'LoadImage');
- Exit;
- end;
-
- TexRWops := RWopsFromStream(TexStream);
- if (TexRWops = nil) then
- begin
- Log.LogError( 'Could not assign resource "'+Identifier+'"', 'LoadImage');
- TexStream.Free();
- Exit;
- end;
-
- //Log.LogStatus( 'resource Assigned....' , Identifier);
- try
- Result := IMG_Load_RW(TexRWops, 0);
- except
- Log.LogError( 'Could not read resource "'+Identifier+'"', 'LoadImage');
- end;
-
- SDL_FreeRW(TexRWops);
- TexStream.Free();
- end;
-end;
-
-
-(*******************************************************
- * Image manipulation
- *******************************************************)
-
-
-function PixelFormatEquals(fmt1, fmt2: PSDL_PixelFormat): boolean;
-begin
- if (fmt1^.BitsPerPixel = fmt2^.BitsPerPixel) and
- (fmt1^.BytesPerPixel = fmt2^.BytesPerPixel) and
- (fmt1^.Rloss = fmt2^.Rloss) and (fmt1^.Gloss = fmt2^.Gloss) and
- (fmt1^.Bloss = fmt2^.Bloss) and (fmt1^.Rmask = fmt2^.Rmask) and
- (fmt1^.Gmask = fmt2^.Gmask) and (fmt1^.Bmask = fmt2^.Bmask) and
- (fmt1^.Rshift = fmt2^.Rshift) and (fmt1^.Gshift = fmt2^.Gshift) and
- (fmt1^.Bshift = fmt2^.Bshift)
- then
- Result := true
- else
- Result := false;
-end;
-
-procedure ScaleImage(var ImgSurface: PSDL_Surface; Width, Height: Cardinal);
-var
- TempSurface: PSDL_Surface;
-begin
- TempSurface := ImgSurface;
- ImgSurface := SDL_ScaleSurfaceRect(TempSurface,
- 0, 0, TempSurface^.W,TempSurface^.H,
- Width, Height);
- SDL_FreeSurface(TempSurface);
-end;
-
-procedure FitImage(var ImgSurface: PSDL_Surface; Width, Height: Cardinal);
-var
- TempSurface: PSDL_Surface;
- ImgFmt: PSDL_PixelFormat;
-begin
- TempSurface := ImgSurface;
-
- // create a new surface with given width and height
- ImgFmt := TempSurface^.format;
- ImgSurface := SDL_CreateRGBSurface(
- SDL_SWSURFACE, Width, Height, ImgFmt^.BitsPerPixel,
- ImgFmt^.RMask, ImgFmt^.GMask, ImgFmt^.BMask, ImgFmt^.AMask);
-
- // copy image from temp- to new surface
- SDL_SetAlpha(ImgSurface, 0, 255);
- SDL_SetAlpha(TempSurface, 0, 255);
- SDL_BlitSurface(TempSurface, nil, ImgSurface, nil);
-
- SDL_FreeSurface(TempSurface);
-end;
-
-(*
-// Old slow floating point version of ColorizeTexture.
-// For an easier understanding of the faster fixed point version below.
-procedure ColorizeTexture(TexSurface: PSDL_Surface; Col: Cardinal);
-var
- clr: array[0..2] of Double; // [0: R, 1: G, 2: B]
- hsv: array[0..2] of Double; // [0: H(ue), 1: S(aturation), 2: V(alue)]
- delta, f, p, q, t: Double;
- max: Double;
-begin
- clr[0] := PixelColors[0]/255;
- clr[1] := PixelColors[1]/255;
- clr[2] := PixelColors[2]/255;
- max := maxvalue(clr);
- delta := max - minvalue(clr);
-
- hsv[0] := DestinationHue; // set H(ue)
- hsv[2] := max; // set V(alue)
- // calc S(aturation)
- if (max = 0.0) then
- hsv[1] := 0.0
- else
- hsv[1] := delta/max;
-
- //ColorizePixel(PByteArray(Pixel), DestinationHue);
- h_int := trunc(hsv[0]); // h_int = |_h_|
- f := hsv[0]-h_int; // f = h-h_int
- p := hsv[2]*(1.0-hsv[1]); // p = v*(1-s)
- q := hsv[2]*(1.0-(hsv[1]*f)); // q = v*(1-s*f)
- t := hsv[2]*(1.0-(hsv[1]*(1.0-f))); // t = v*(1-s*(1-f))
- case h_int of
- 0: begin clr[0] := hsv[2]; clr[1] := t; clr[2] := p; end; // (v,t,p)
- 1: begin clr[0] := q; clr[1] := hsv[2]; clr[2] := p; end; // (q,v,p)
- 2: begin clr[0] := p; clr[1] := hsv[2]; clr[2] := t; end; // (p,v,t)
- 3: begin clr[0] := p; clr[1] := q; clr[2] := hsv[2]; end; // (p,q,v)
- 4: begin clr[0] := t; clr[1] := p; clr[2] := hsv[2]; end; // (t,p,v)
- 5: begin clr[0] := hsv[2]; clr[1] := p; clr[2] := q; end; // (v,p,q)
- end;
-
- // and store new rgb back into the image
- PixelColors[0] := trunc(255*clr[0]);
- PixelColors[1] := trunc(255*clr[1]);
- PixelColors[2] := trunc(255*clr[2]);
-end;
-*)
-
-procedure ColorizeImage(ImgSurface: PSDL_Surface; NewColor: Cardinal);
-
- //returns hue within range [0.0-6.0)
- function col2hue(Color:Cardinal): double;
- var
- clr: array[0..2] of double;
- hue, max, delta: double;
- begin
- clr[0] := ((Color and $ff0000) shr 16)/255; // R
- clr[1] := ((Color and $ff00) shr 8)/255; // G
- clr[2] := (Color and $ff) /255; // B
- max := maxvalue(clr);
- delta := max - minvalue(clr);
- // calc hue
- if (delta = 0.0) then hue := 0
- else if (clr[0] = max) then hue := (clr[1]-clr[2])/delta
- else if (clr[1] = max) then hue := 2.0+(clr[2]-clr[0])/delta
- else if (clr[2] = max) then hue := 4.0+(clr[0]-clr[1])/delta;
- if (hue < 0.0) then
- hue := hue + 6.0;
- Result := hue;
- end;
-
-var
- DestinationHue: Double;
- PixelIndex: Cardinal;
- Pixel: PByte;
- PixelColors: PByteArray;
- clr: array[0..2] of UInt32; // [0: R, 1: G, 2: B]
- hsv: array[0..2] of UInt32; // [0: H(ue), 1: S(aturation), 2: V(alue)]
- dhue: UInt32;
- h_int: Cardinal;
- delta, f, p, q, t: Longint;
- max: Uint32;
-begin
- DestinationHue := col2hue(NewColor);
-
- dhue := Trunc(DestinationHue*1024);
-
- Pixel := ImgSurface^.Pixels;
-
- for PixelIndex := 0 to (ImgSurface^.W * ImgSurface^.H)-1 do
- begin
- PixelColors := PByteArray(Pixel);
- // inlined colorize per pixel
-
- // uses fixed point math
- // get color values
- clr[0] := PixelColors[0] shl 10;
- clr[1] := PixelColors[1] shl 10;
- clr[2] := PixelColors[2] shl 10;
- //calculate luminance and saturation from rgb
-
- max := clr[0];
- if clr[1] > max then max := clr[1];
- if clr[2] > max then max := clr[2];
- delta := clr[0];
- if clr[1] < delta then delta := clr[1];
- if clr[2] < delta then delta := clr[2];
- delta := max-delta;
- hsv[0] := dhue; // shl 8
- hsv[2] := max; // shl 8
- if (max = 0) then
- hsv[1] := 0
- else
- hsv[1] := (delta shl 10) div max; // shl 8
- h_int := hsv[0] and $fffffC00;
- f := hsv[0]-h_int; //shl 10
- p := (hsv[2]*(1024-hsv[1])) shr 10;
- q := (hsv[2]*(1024-(hsv[1]*f) shr 10)) shr 10;
- t := (hsv[2]*(1024-(hsv[1]*(1024-f)) shr 10)) shr 10;
- h_int := h_int shr 10;
- case h_int of
- 0: begin clr[0] := hsv[2]; clr[1] := t; clr[2] := p; end; // (v,t,p)
- 1: begin clr[0] := q; clr[1] := hsv[2]; clr[2] := p; end; // (q,v,p)
- 2: begin clr[0] := p; clr[1] := hsv[2]; clr[2] := t; end; // (p,v,t)
- 3: begin clr[0] := p; clr[1] := q; clr[2] := hsv[2]; end; // (p,q,v)
- 4: begin clr[0] := t; clr[1] := p; clr[2] := hsv[2]; end; // (t,p,v)
- 5: begin clr[0] := hsv[2]; clr[1] := p; clr[2] := q; end; // (v,p,q)
- end;
-
- PixelColors[0] := clr[0] shr 10;
- PixelColors[1] := clr[1] shr 10;
- PixelColors[2] := clr[2] shr 10;
-
- Inc(Pixel, ImgSurface^.format.BytesPerPixel);
- end;
-end;
-
-end.
diff --git a/src/classes/UIni.pas b/src/classes/UIni.pas
deleted file mode 100644
index b286c917..00000000
--- a/src/classes/UIni.pas
+++ /dev/null
@@ -1,928 +0,0 @@
-unit UIni;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses
- Classes,
- IniFiles,
- ULog,
- SysUtils;
-
-type
- // TInputDeviceConfig stores the configuration for an input device.
- // Configurations will be stored in the InputDeviceConfig array.
- // Note that not all devices listed in InputDeviceConfig are active devices.
- // Some might be unplugged and hence unavailable.
- // Available devices are held in TAudioInputProcessor.DeviceList. Each
- // TAudioInputDevice listed there has a CfgIndex field which is the index to
- // its configuration in the InputDeviceConfig array.
- // Name:
- // the name of the input device
- // Input:
- // the index of the input source to use for recording
- // ChannelToPlayerMap:
- // mapping of recording channels to players, e.g. ChannelToPlayerMap[0] = 2
- // maps the channel 0 (left) to player 2. A player index of 0 means that
- // the channel is not assigned to a player.
- PInputDeviceConfig = ^TInputDeviceConfig;
- TInputDeviceConfig = record
- Name: string;
- Input: integer;
- ChannelToPlayerMap: array of integer;
- end;
-
-type
-
-//Options
-
- TVisualizerOption = (voOff, voWhenNoVideo, voOn);
- TBackgroundMusicOption = (bmoOff, bmoOn);
- TIni = class
- private
- function RemoveFileExt(FullName: string): string;
- function ExtractKeyIndex(const Key, Prefix, Suffix: string): integer;
- function GetMaxKeyIndex(Keys: TStringList; const Prefix, Suffix: string): integer;
- function GetArrayIndex(const SearchArray: array of string; Value: string; CaseInsensitiv: Boolean = False): integer;
- function ReadArrayIndex(const SearchArray: array of string; IniFile: TCustomIniFile;
- IniSection: string; IniProperty: string; Default: integer): integer;
-
- procedure LoadInputDeviceCfg(IniFile: TMemIniFile);
- procedure SaveInputDeviceCfg(IniFile: TIniFile);
- procedure LoadThemes(IniFile: TCustomIniFile);
- procedure LoadPaths(IniFile: TCustomIniFile);
- procedure LoadScreenModes(IniFile: TCustomIniFile);
-
- public
- Name: array[0..11] of string;
-
- // Templates for Names Mod
- NameTeam: array[0..2] of string;
- NameTemplate: array[0..11] of string;
-
- //Filename of the opened iniFile
- Filename: string;
-
- // Game
- Players: integer;
- Difficulty: integer;
- Language: integer;
- Tabs: integer;
- Tabs_at_startup:integer; //Tabs at Startup fix
- Sorting: integer;
- Debug: integer;
-
- // Graphics
- Screens: integer;
- Resolution: integer;
- Depth: integer;
- VisualizerOption:integer;
- FullScreen: integer;
- TextureSize: integer;
- SingWindow: integer;
- Oscilloscope: integer;
- Spectrum: integer;
- Spectrograph: integer;
- MovieSize: integer;
-
- // Sound
- MicBoost: integer;
- ClickAssist: integer;
- BeatClick: integer;
- SavePlayback: integer;
- ThresholdIndex: integer;
- AudioOutputBufferSizeIndex:integer;
- VoicePassthrough:integer;
-
- //Song Preview
- PreviewVolume: integer;
- PreviewFading: integer;
-
- // Lyrics
- LyricsFont: integer;
- LyricsEffect: integer;
- Solmization: integer;
- NoteLines: integer;
-
- // Themes
- Theme: integer;
- SkinNo: integer;
- Color: integer;
- BackgroundMusicOption:integer;
-
- // Record
- InputDeviceConfig: array of TInputDeviceConfig;
-
- // Advanced
- LoadAnimation: integer;
- EffectSing: integer;
- ScreenFade: integer;
- AskBeforeDel: integer;
- OnSongClick: integer;
- LineBonus: integer;
- PartyPopup: integer;
-
- // Controller
- Joypad: integer;
-
- procedure Load();
- procedure Save();
- procedure SaveNames;
- procedure SaveLevel;
- end;
-
-var
- Ini: TIni;
- IResolution: array of string;
- ILanguage: array of string;
- ITheme: array of string;
- ISkin: array of string;
-
-
-
-const
- IPlayers: array[0..4] of string = ('1', '2', '3', '4', '6');
- IPlayersVals: array[0..4] of integer = ( 1 , 2 , 3 , 4 , 6 );
-
- IDifficulty: array[0..2] of string = ('Easy', 'Medium', 'Hard');
- ITabs: array[0..1] of string = ('Off', 'On');
-
- ISorting: array[0..7] of string = ('Edition', 'Genre', 'Language', 'Folder', 'Title', 'Artist', 'Title2', 'Artist2');
- sEdition = 0;
- sGenre = 1;
- sLanguage = 2;
- sFolder = 3;
- sTitle = 4;
- sArtist = 5;
- sTitle2 = 6;
- sArtist2 = 7;
-
- IDebug: array[0..1] of string = ('Off', 'On');
-
- IScreens: array[0..1] of string = ('1', '2');
- IFullScreen: array[0..1] of string = ('Off', 'On');
- IDepth: array[0..1] of string = ('16 bit', '32 bit');
- IVisualizer: array[0..2] of string = ('Off', 'WhenNoVideo','On');
-
- IBackgroundMusic: array[0..1] of string = ('Off', 'On');
-
-
- ITextureSize: array[0..2] of string = ('128', '256', '512');
- ITextureSizeVals: array[0..2] of integer = ( 128, 256, 512);
-
- ISingWindow: array[0..1] of string = ('Small', 'Big');
-
- //SingBar Mod
- IOscilloscope: array[0..2] of string = ('Off', 'Osci', 'Bar');
-//IOscilloscope: array[0..1] of string = ('Off', 'On');
-
- ISpectrum: array[0..1] of string = ('Off', 'On');
- ISpectrograph: array[0..1] of string = ('Off', 'On');
- IMovieSize: array[0..2] of string = ('Half', 'Full [Vid]', 'Full [BG+Vid]');
-
- IClickAssist: array[0..1] of string = ('Off', 'On');
- IBeatClick: array[0..1] of string = ('Off', 'On');
- ISavePlayback: array[0..1] of string = ('Off', 'On');
-
- IThreshold: array[0..3] of string = ('5%', '10%', '15%', '20%');
- IThresholdVals: array[0..3] of single = (0.05, 0.10, 0.15, 0.20);
-
- IVoicePassthrough: array[0..1] of string = ('Off', 'On');
-
- IAudioOutputBufferSize: array[0..9] of string = ('Auto', '256', '512', '1024', '2048', '4096', '8192', '16384', '32768', '65536');
- IAudioOutputBufferSizeVals: array[0..9] of integer = ( 0, 256, 512 , 1024 , 2048 , 4096 , 8192 , 16384 , 32768 , 65536 );
-
- IAudioInputBufferSize: array[0..9] of string = ('Auto', '256', '512', '1024', '2048', '4096', '8192', '16384', '32768', '65536');
- IAudioInputBufferSizeVals: array[0..9] of integer = ( 0, 256, 512 , 1024 , 2048 , 4096 , 8192 , 16384 , 32768 , 65536 );
-
- //Song Preview
- IPreviewVolume: array[0..10] of string = ('Off', '10%', '20%', '30%', '40%', '50%', '60%', '70%', '80%', '90%', '100%');
- IPreviewVolumeVals: array[0..10] of single = ( 0, 0.10, 0.20, 0.30, 0.40, 0.50, 0.60, 0.70, 0.80, 0.90, 1.00 );
-
- IPreviewFading: array[0..5] of string = ('Off', '1 Sec', '2 Secs', '3 Secs', '4 Secs', '5 Secs');
- IPreviewFadingVals: array[0..5] of integer = ( 0, 1, 2, 3, 4, 5 );
-
-
- ILyricsFont: array[0..2] of string = ('Plain', 'OLine1', 'OLine2');
- ILyricsEffect: array[0..4] of string = ('Simple', 'Zoom', 'Slide', 'Ball', 'Shift');
- ISolmization: array[0..3] of string = ('Off', 'Euro', 'Jap', 'American');
- INoteLines: array[0..1] of string = ('Off', 'On');
-
- IColor: array[0..8] of string = ('Blue', 'Green', 'Pink', 'Red', 'Violet', 'Orange', 'Yellow', 'Brown', 'Black');
-
- // Advanced
- ILoadAnimation: array[0..1] of string = ('Off', 'On');
- IEffectSing: array[0..1] of string = ('Off', 'On');
- IScreenFade: array[0..1] of string =('Off', 'On');
- IAskbeforeDel: array[0..1] of string = ('Off', 'On');
- IOnSongClick: array[0..2] of string = ('Sing', 'Select Players', 'Open Menu');
- ILineBonus: array[0..2] of string = ('Off', 'At Score', 'At Notes');
- IPartyPopup: array[0..1] of string = ('Off', 'On');
-
- IJoypad: array[0..1] of string = ('Off', 'On');
-
- // Recording options
- IChannelPlayer: array[0..6] of string = ('Off', '1', '2', '3', '4', '5', '6');
- IMicBoost: array[0..3] of string = ('Off', '+6dB', '+12dB', '+18dB');
-
-implementation
-
-uses
- StrUtils,
- UMain,
- SDL,
- ULanguage,
- UPlatform,
- USkins,
- URecord,
- UCommandLine;
-
-(**
- * Returns the filename without its fileextension
- *)
-function TIni.RemoveFileExt(FullName: string): string;
-begin
- Result := ChangeFileExt(FullName, '');
-end;
-
-(**
- * Extracts an index of a key that is surrounded by a Prefix/Suffix pair.
- * Example: ExtractKeyIndex('MyKey[1]', '[', ']') will return 1.
- *)
-function TIni.ExtractKeyIndex(const Key, Prefix, Suffix: string): integer;
-var
- Value: string;
- Start: integer;
-begin
- Result := -1;
-
- if Pos(Prefix, Key) > -1 then
- begin
- Start := Pos(Prefix, Key) + Length(Prefix);
-
- // copy all between prefix and suffix
- Value := Copy(Key, Start, Pos(Suffix, Key)-1 - Start);
- Result := StrToIntDef(Value, -1);
- end;
-end;
-
-(**
- * Finds the maximum key-index in a key-list.
- * The indexes of the list are surrounded by Prefix/Suffix,
- * e.g. MyKey[1] (Prefix='[', Suffix=']')
- *)
-function TIni.GetMaxKeyIndex(Keys: TStringList; const Prefix, Suffix: string): integer;
-var
- i: integer;
- KeyIndex: integer;
-begin
- Result := -1;
-
- for i := 0 to Keys.Count-1 do
- begin
- KeyIndex := ExtractKeyIndex(Keys[i], Prefix, Suffix);
- if (KeyIndex > Result) then
- Result := KeyIndex;
- end;
-end;
-
-(**
- * Returns the index of Value in SearchArray
- * or -1 if Value is not in SearchArray.
- *)
-function TIni.GetArrayIndex(const SearchArray: array of string; Value: string;
- CaseInsensitiv: Boolean = False): integer;
-var
- i: integer;
-begin
- Result := -1;
-
- for i := 0 to High(SearchArray) do
- begin
- if (SearchArray[i] = Value) or
- (CaseInsensitiv and (UpperCase(SearchArray[i]) = UpperCase(Value))) then
- begin
- Result := i;
- Break;
- end;
- end;
-end;
-
-(**
- * Reads the property IniSeaction:IniProperty from IniFile and
- * finds its corresponding index in SearchArray.
- * If SearchArray does not contain the property value, the default value is
- * returned.
- *)
-function TIni.ReadArrayIndex(const SearchArray: array of string; IniFile: TCustomIniFile;
- IniSection: string; IniProperty: string; Default: integer): integer;
-var
- StrValue: string;
-begin
- StrValue := IniFile.ReadString(IniSection, IniProperty, SearchArray[Default]);
- Result := GetArrayIndex(SearchArray, StrValue);
- if (Result = -1) then
- begin
- Result := Default;
- end;
-end;
-
-
-procedure TIni.LoadInputDeviceCfg(IniFile: TMemIniFile);
-var
- DeviceCfg: PInputDeviceConfig;
- DeviceIndex: integer;
- ChannelCount: integer;
- ChannelIndex: integer;
- RecordKeys: TStringList;
- i: integer;
-begin
- RecordKeys := TStringList.Create();
-
- // read all record-keys for filtering
- IniFile.ReadSection('Record', RecordKeys);
-
- SetLength(InputDeviceConfig, 0);
-
- for i := 0 to RecordKeys.Count-1 do
- begin
- // find next device-name
- DeviceIndex := ExtractKeyIndex(RecordKeys[i], 'DeviceName[', ']');
- if (DeviceIndex >= 0) then
- begin
- if not IniFile.ValueExists('Record', Format('DeviceName[%d]', [DeviceIndex])) then
- break;
-
- // resize list
- SetLength(InputDeviceConfig, Length(InputDeviceConfig)+1);
-
- // read an input device's config.
- // Note: All devices are appended to the list whether they exist or not.
- // Otherwise an external device's config will be lost if it is not
- // connected (e.g. singstar mics or USB-Audio devices).
- DeviceCfg := @InputDeviceConfig[High(InputDeviceConfig)];
- DeviceCfg.Name := IniFile.ReadString('Record', Format('DeviceName[%d]', [DeviceIndex]), '');
- DeviceCfg.Input := IniFile.ReadInteger('Record', Format('Input[%d]', [DeviceIndex]), 0);
-
- // find the largest channel-number of the current device in the ini-file
- ChannelCount := GetMaxKeyIndex(RecordKeys, 'Channel', Format('[%d]', [DeviceIndex]));
- if (ChannelCount < 0) then
- ChannelCount := 0;
-
- SetLength(DeviceCfg.ChannelToPlayerMap, ChannelCount);
-
- // read channel-to-player mapping for every channel of the current device
- // or set non-configured channels to no player (=0).
- for ChannelIndex := 0 to High(DeviceCfg.ChannelToPlayerMap) do
- begin
- DeviceCfg.ChannelToPlayerMap[ChannelIndex] :=
- IniFile.ReadInteger('Record', Format('Channel%d[%d]', [ChannelIndex+1, DeviceIndex]), 0);
- end;
- end;
- end;
-
- RecordKeys.Free();
-
- // MicBoost
- //MicBoost := GetArrayIndex(IMicBoost, IniFile.ReadString('Record', 'MicBoost', 'Off'));
- // Threshold
- // ThresholdIndex := GetArrayIndex(IThreshold, IniFile.ReadString('Record', 'Threshold', IThreshold[1]));
-end;
-
-procedure TIni.SaveInputDeviceCfg(IniFile: TIniFile);
-var
- DeviceIndex: integer;
- ChannelIndex: integer;
-begin
- for DeviceIndex := 0 to High(InputDeviceConfig) do
- begin
- // DeviceName and DeviceInput
- IniFile.WriteString('Record', Format('DeviceName[%d]', [DeviceIndex+1]),
- InputDeviceConfig[DeviceIndex].Name);
- IniFile.WriteInteger('Record', Format('Input[%d]', [DeviceIndex+1]),
- InputDeviceConfig[DeviceIndex].Input);
-
- // Channel-to-Player Mapping
- for ChannelIndex := 0 to High(InputDeviceConfig[DeviceIndex].ChannelToPlayerMap) do
- begin
- IniFile.WriteInteger('Record',
- Format('Channel%d[%d]', [ChannelIndex+1, DeviceIndex+1]),
- InputDeviceConfig[DeviceIndex].ChannelToPlayerMap[ChannelIndex]);
- end;
- end;
-
- // MicBoost
- //IniFile.WriteString('Record', 'MicBoost', IMicBoost[MicBoost]);
- // Threshold
- //IniFile.WriteString('Record', 'Threshold', IThreshold[ThresholdIndex]);
-end;
-
-procedure TIni.LoadPaths(IniFile: TCustomIniFile);
-var
- PathStrings: TStringList;
- I: integer;
-begin
- PathStrings := TStringList.Create;
- IniFile.ReadSection('Directories', PathStrings);
-
- // Load song-paths
- for I := 0 to PathStrings.Count-1 do
- begin
- if (AnsiStartsText('SongDir', PathStrings[I])) then
- begin
- AddSongPath(IniFile.ReadString('Directories', PathStrings[I], ''));
- end;
- end;
-
- PathStrings.Free;
-end;
-
-procedure TIni.LoadThemes(IniFile: TCustomIniFile);
-var
- SearchResult: TSearchRec;
- ThemeIni: TMemIniFile;
- ThemeName: string;
- I: integer;
-begin
- // Theme
- SetLength(ITheme, 0);
- Log.LogStatus('Searching for Theme : ' + ThemePath + '*.ini', 'Theme');
-
- FindFirst(ThemePath + '*.ini',faAnyFile, SearchResult);
- Repeat
- Log.LogStatus('Found Theme: ' + SearchResult.Name, 'Theme');
-
- //Read Themename from Theme
- ThemeIni := TMemIniFile.Create(SearchResult.Name);
- ThemeName := UpperCase(ThemeIni.ReadString('Theme','Name', RemoveFileExt(SearchResult.Name)));
- ThemeIni.Free;
-
- //Search for Skins for this Theme
- for I := Low(Skin.Skin) to High(Skin.Skin) do
- begin
- if UpperCase(Skin.Skin[I].Theme) = ThemeName then
- begin
- SetLength(ITheme, Length(ITheme)+1);
- ITheme[High(ITheme)] := RemoveFileExt(SearchResult.Name);
- break;
- end;
- end;
- until FindNext(SearchResult) <> 0;
- FindClose(SearchResult);
-
- // No Theme Found
- if (Length(ITheme) = 0) then
- begin
- Log.CriticalError('Could not find any valid Themes.');
- end;
-
- Theme := GetArrayIndex(ITheme, IniFile.ReadString('Themes', 'Theme', 'DELUXE'), true);
- if (Theme = -1) then
- Theme := 0;
-
- // Skin
- Skin.onThemeChange;
-
- SkinNo := GetArrayIndex(ISkin, IniFile.ReadString('Themes', 'Skin', ISkin[0]));
-end;
-
-procedure TIni.LoadScreenModes(IniFile: TCustomIniFile);
-
- // swap two strings
- procedure swap(var s1, s2: string);
- var
- s3: string;
- begin
- s3 := s1;
- s1 := s2;
- s2 := s3;
- end;
-
-var
- Modes: PPSDL_Rect;
- I: integer;
-begin
- // Screens
- Screens := GetArrayIndex(IScreens, IniFile.ReadString('Graphics', 'Screens', IScreens[0]));
-
- // FullScreen
- FullScreen := GetArrayIndex(IFullScreen, IniFile.ReadString('Graphics', 'FullScreen', 'On'));
-
- // Resolution
- SetLength(IResolution, 0);
-
- // Check if there are any modes available
- // TODO: we should seperate windowed and fullscreen modes. Otherwise it is not
- // possible to select a reasonable fullscreen mode when in windowed mode
- if IFullScreen[FullScreen] = 'On' then
- Modes := SDL_ListModes(nil, SDL_OPENGL or SDL_FULLSCREEN or SDL_RESIZABLE)
- else
- Modes := SDL_ListModes(nil, SDL_OPENGL or SDL_RESIZABLE) ;
-
- if (Modes = nil) then
- begin
- Log.LogStatus( 'No resolutions Found' , 'Video');
- end
- else if (Modes = PPSDL_Rect(-1)) then
- begin
- // Fallback to some standard resolutions
- SetLength(IResolution, 10);
- IResolution[0] := '640x480';
- IResolution[1] := '800x600';
- IResolution[2] := '1024x768';
- IResolution[3] := '1152x864';
- IResolution[4] := '1280x800';
- IResolution[5] := '1280x960';
- IResolution[6] := '1400x1050';
- IResolution[7] := '1440x900';
- IResolution[8] := '1600x1200';
- IResolution[9] := '1680x1050';
-
- Resolution := GetArrayIndex(IResolution, IniFile.ReadString('Graphics', 'Resolution', '800x600'));
- if Resolution = -1 then
- begin
- SetLength(IResolution, Length(IResolution) + 1);
- IResolution[High(IResolution)] := IniFile.ReadString('Graphics', 'Resolution', '800x600');
- Resolution := High(IResolution);
- end;
- end
- else
- begin
- while assigned( Modes^ ) do //this should solve the biggest wine problem | THANKS Linnex (11.11.07)
- begin
- Log.LogStatus( 'Found Video Mode : ' + IntToStr(Modes^.w) + 'x' + IntToStr(Modes^.h) , 'Video');
- SetLength(IResolution, Length(IResolution) + 1);
- IResolution[High(IResolution)] := IntToStr(Modes^.w) + 'x' + IntToStr(Modes^.h);
- Inc(Modes);
- end;
-
- // reverse order
- for I := 0 to (Length(IResolution) div 2) - 1 do
- begin
- swap(IResolution[I], IResolution[High(IResolution)-I]);
- end;
- Resolution := GetArrayIndex(IResolution, IniFile.ReadString('Graphics', 'Resolution', '800x600'));
-
- if Resolution = -1 then
- begin
- Resolution := GetArrayIndex(IResolution, '800x600');
- if Resolution = -1 then
- Resolution := 0;
- end;
- end;
-
- // if no modes were set, then failback to 800x600
- // as per http://sourceforge.net/forum/message.php?msg_id=4544965
- // THANKS : linnex at users.sourceforge.net
- if Length(IResolution) < 1 then
- begin
- Log.LogStatus( 'Found Video Mode : NONE !!! ( Defaulted to 800 x 600 )', 'Video');
- SetLength(IResolution, 1);
- IResolution[0] := '800x600';
- Resolution := 0;
- Log.LogStatus('SDL_ListModes Defaulted Res To : ' + IResolution[0] , 'Graphics - Resolutions');
-
- // Default to fullscreen OFF, in this case !
- FullScreen := 0;
- end;
-
- // Depth
- Depth := GetArrayIndex(IDepth, IniFile.ReadString('Graphics', 'Depth', '32 bit'));
-end;
-
-procedure TIni.Load();
-var
- IniFile: TMemIniFile;
- I: integer;
-begin
- GamePath := Platform.GetGameUserPath;
-
- Log.LogStatus( 'GamePath : ' +GamePath , '' );
-
- if (Params.ConfigFile <> '') then
- try
- FileName := Params.ConfigFile;
- except
- FileName := GamePath + 'config.ini';
- end
- else
- FileName := GamePath + 'config.ini';
-
- Log.LogStatus( 'Using config : ' + FileName , 'Ini');
- IniFile := TMemIniFile.Create( FileName );
-
- // Name
- for I := 0 to 11 do
- Name[I] := IniFile.ReadString('Name', 'P'+IntToStr(I+1), 'Player'+IntToStr(I+1));
-
- // Templates for Names Mod
- for I := 0 to 2 do
- NameTeam[I] := IniFile.ReadString('NameTeam', 'T'+IntToStr(I+1), 'Team'+IntToStr(I+1));
- for I := 0 to 11 do
- NameTemplate[I] := IniFile.ReadString('NameTemplate', 'Name'+IntToStr(I+1), 'Template'+IntToStr(I+1));
-
- // Players
- Players := GetArrayIndex(IPlayers, IniFile.ReadString('Game', 'Players', IPlayers[0]));
-
- // Difficulty
- Difficulty := GetArrayIndex(IDifficulty, IniFile.ReadString('Game', 'Difficulty', 'Easy'));
-
- // Language
- Language := GetArrayIndex(ILanguage, IniFile.ReadString('Game', 'Language', 'English'));
- //Language.ChangeLanguage(ILanguage[Language]);
-
- // Tabs
- Tabs := GetArrayIndex(ITabs, IniFile.ReadString('Game', 'Tabs', ITabs[0]));
- Tabs_at_startup := Tabs; //Tabs at Startup fix
-
- // Song Sorting
- Sorting := GetArrayIndex(ISorting, IniFile.ReadString('Game', 'Sorting', ISorting[0]));
-
- // Debug
- Debug := GetArrayIndex(IDebug, IniFile.ReadString('Game', 'Debug', IDebug[0]));
-
- LoadScreenModes(IniFile);
-
- // TextureSize
- TextureSize := GetArrayIndex(ITextureSize, IniFile.ReadString('Graphics', 'TextureSize', ITextureSize[1]));
-
- // SingWindow
- SingWindow := GetArrayIndex(ISingWindow, IniFile.ReadString('Graphics', 'SingWindow', 'Big'));
-
- // Oscilloscope
- Oscilloscope := GetArrayIndex(IOscilloscope, IniFile.ReadString('Graphics', 'Oscilloscope', 'Bar'));
-
- // Spectrum
- Spectrum := GetArrayIndex(ISpectrum, IniFile.ReadString('Graphics', 'Spectrum', 'Off'));
-
- // Spectrograph
- Spectrograph := GetArrayIndex(ISpectrograph, IniFile.ReadString('Graphics', 'Spectrograph', 'Off'));
-
- // MovieSize
- MovieSize := GetArrayIndex(IMovieSize, IniFile.ReadString('Graphics', 'MovieSize', IMovieSize[2]));
-
- // ClickAssist
- ClickAssist := GetArrayIndex(IClickAssist, IniFile.ReadString('Sound', 'ClickAssist', 'Off'));
-
- // BeatClick
- BeatClick := GetArrayIndex(IBeatClick, IniFile.ReadString('Sound', 'BeatClick', IBeatClick[0]));
-
- // SavePlayback
- SavePlayback := GetArrayIndex(ISavePlayback, IniFile.ReadString('Sound', 'SavePlayback', ISavePlayback[0]));
-
- // AudioOutputBufferSize
- AudioOutputBufferSizeIndex := ReadArrayIndex(IAudioOutputBufferSize, IniFile, 'Sound', 'AudioOutputBufferSize', 0);
-
- //Preview Volume
- PreviewVolume := GetArrayIndex(IPreviewVolume, IniFile.ReadString('Sound', 'PreviewVolume', IPreviewVolume[7]));
-
- //Preview Fading
- PreviewFading := GetArrayIndex(IPreviewFading, IniFile.ReadString('Sound', 'PreviewFading', IPreviewFading[1]));
-
- //AudioRepeat aka VoicePassthrough
- VoicePassthrough := GetArrayIndex(IVoicePassthrough, IniFile.ReadString('Sound', 'VoicePassthrough', IVoicePassthrough[0]));
-
- // Lyrics Font
- LyricsFont := GetArrayIndex(ILyricsFont, IniFile.ReadString('Lyrics', 'LyricsFont', ILyricsFont[1]));
-
- // Lyrics Effect
- LyricsEffect := GetArrayIndex(ILyricsEffect, IniFile.ReadString('Lyrics', 'LyricsEffect', ILyricsEffect[1]));
-
- // Solmization
- Solmization := GetArrayIndex(ISolmization, IniFile.ReadString('Lyrics', 'Solmization', ISolmization[0]));
-
- // NoteLines
- NoteLines := GetArrayIndex(INoteLines, IniFile.ReadString('Lyrics', 'NoteLines', INoteLines[1]));
-
- LoadThemes(IniFile);
-
- // Color
- Color := GetArrayIndex(IColor, IniFile.ReadString('Themes', 'Color', IColor[0]));
-
- LoadInputDeviceCfg(IniFile);
-
- // LoadAnimation
- LoadAnimation := GetArrayIndex(ILoadAnimation, IniFile.ReadString('Advanced', 'LoadAnimation', 'On'));
-
- // ScreenFade
- ScreenFade := GetArrayIndex(IScreenFade, IniFile.ReadString('Advanced', 'ScreenFade', 'On'));
-
- // Visualizations
- // <mog> this could be of use later..
- // VisualizerOption :=
- // TVisualizerOption(GetEnumValue(TypeInfo(TVisualizerOption),
- // IniFile.ReadString('Graphics', 'Visualization', 'Off')));
- // || VisualizerOption := TVisualizerOption(GetArrayIndex(IVisualizer, IniFile.ReadString('Graphics', 'Visualization', 'Off')));
- VisualizerOption := GetArrayIndex(IVisualizer, IniFile.ReadString('Graphics', 'Visualization', 'Off'));
-
-{**
- * Background music
- *}
- BackgroundMusicOption := GetArrayIndex(IBackgroundMusic, IniFile.ReadString('Sound', 'BackgroundMusic', 'Off'));
-
- // EffectSing
- EffectSing := GetArrayIndex(IEffectSing, IniFile.ReadString('Advanced', 'EffectSing', 'On'));
-
- // AskbeforeDel
- AskBeforeDel := GetArrayIndex(IAskbeforeDel, IniFile.ReadString('Advanced', 'AskbeforeDel', 'On'));
-
- // OnSongClick
- OnSongClick := GetArrayIndex(IOnSongClick, IniFile.ReadString('Advanced', 'OnSongClick', 'Sing'));
-
- // Linebonus
- LineBonus := GetArrayIndex(ILineBonus, IniFile.ReadString('Advanced', 'LineBonus', 'At Score'));
-
- // PartyPopup
- PartyPopup := GetArrayIndex(IPartyPopup, IniFile.ReadString('Advanced', 'PartyPopup', 'On'));
-
- // Joypad
- Joypad := GetArrayIndex(IJoypad, IniFile.ReadString('Controller', 'Joypad', IJoypad[0]));
-
- LoadPaths(IniFile);
-
- IniFile.Free;
-end;
-
-procedure TIni.Save;
-var
- IniFile: TIniFile;
-begin
- if (FileExists(Filename) and FileIsReadOnly(Filename)) then
- begin
- Log.LogError('Config-file is read-only', 'TIni.Save');
- Exit;
- end;
-
- IniFile := TIniFile.Create(Filename);
-
- // Players
- IniFile.WriteString('Game', 'Players', IPlayers[Players]);
-
- // Difficulty
- IniFile.WriteString('Game', 'Difficulty', IDifficulty[Difficulty]);
-
- // Language
- IniFile.WriteString('Game', 'Language', ILanguage[Language]);
-
- // Tabs
- IniFile.WriteString('Game', 'Tabs', ITabs[Tabs]);
-
- // Sorting
- IniFile.WriteString('Game', 'Sorting', ISorting[Sorting]);
-
- // Debug
- IniFile.WriteString('Game', 'Debug', IDebug[Debug]);
-
- // Screens
- IniFile.WriteString('Graphics', 'Screens', IScreens[Screens]);
-
- // FullScreen
- IniFile.WriteString('Graphics', 'FullScreen', IFullScreen[FullScreen]);
-
- // Visualization
- IniFile.WriteString('Graphics', 'Visualization', IVisualizer[VisualizerOption]);
-
- // Resolution
- IniFile.WriteString('Graphics', 'Resolution', IResolution[Resolution]);
-
- // Depth
- IniFile.WriteString('Graphics', 'Depth', IDepth[Depth]);
-
- // TextureSize
- IniFile.WriteString('Graphics', 'TextureSize', ITextureSize[TextureSize]);
-
- // Sing Window
- IniFile.WriteString('Graphics', 'SingWindow', ISingWindow[SingWindow]);
-
- // Oscilloscope
- IniFile.WriteString('Graphics', 'Oscilloscope', IOscilloscope[Oscilloscope]);
-
- // Spectrum
- IniFile.WriteString('Graphics', 'Spectrum', ISpectrum[Spectrum]);
-
- // Spectrograph
- IniFile.WriteString('Graphics', 'Spectrograph', ISpectrograph[Spectrograph]);
-
- // Movie Size
- IniFile.WriteString('Graphics', 'MovieSize', IMovieSize[MovieSize]);
-
- // ClickAssist
- IniFile.WriteString('Sound', 'ClickAssist', IClickAssist[ClickAssist]);
-
- // BeatClick
- IniFile.WriteString('Sound', 'BeatClick', IBeatClick[BeatClick]);
-
- // AudioOutputBufferSize
- IniFile.WriteString('Sound', 'AudioOutputBufferSize', IAudioOutputBufferSize[AudioOutputBufferSizeIndex]);
-
- // Background music
- IniFile.WriteString('Sound', 'BackgroundMusic', IBackgroundMusic[BackgroundMusicOption]);
-
- // Song Preview
- IniFile.WriteString('Sound', 'PreviewVolume', IPreviewVolume[PreviewVolume]);
-
- // PreviewFading
- IniFile.WriteString('Sound', 'PreviewFading', IPreviewFading[PreviewFading]);
-
- // SavePlayback
- IniFile.WriteString('Sound', 'SavePlayback', ISavePlayback[SavePlayback]);
-
- // VoicePasstrough
- IniFile.WriteString('Sound', 'VoicePassthrough', IVoicePassthrough[VoicePassthrough]);
-
- // Lyrics Font
- IniFile.WriteString('Lyrics', 'LyricsFont', ILyricsFont[LyricsFont]);
-
- // Lyrics Effect
- IniFile.WriteString('Lyrics', 'LyricsEffect', ILyricsEffect[LyricsEffect]);
-
- // Solmization
- IniFile.WriteString('Lyrics', 'Solmization', ISolmization[Solmization]);
-
- // NoteLines
- IniFile.WriteString('Lyrics', 'NoteLines', INoteLines[NoteLines]);
-
- // Theme
- IniFile.WriteString('Themes', 'Theme', ITheme[Theme]);
-
- // Skin
- IniFile.WriteString('Themes', 'Skin', ISkin[SkinNo]);
-
- // Color
- IniFile.WriteString('Themes', 'Color', IColor[Color]);
-
- SaveInputDeviceCfg(IniFile);
-
- //LoadAnimation
- IniFile.WriteString('Advanced', 'LoadAnimation', ILoadAnimation[LoadAnimation]);
-
- //EffectSing
- IniFile.WriteString('Advanced', 'EffectSing', IEffectSing[EffectSing]);
-
- //ScreenFade
- IniFile.WriteString('Advanced', 'ScreenFade', IScreenFade[ScreenFade]);
-
- //AskbeforeDel
- IniFile.WriteString('Advanced', 'AskbeforeDel', IAskbeforeDel[AskBeforeDel]);
-
- //OnSongClick
- IniFile.WriteString('Advanced', 'OnSongClick', IOnSongClick[OnSongClick]);
-
- //Line Bonus
- IniFile.WriteString('Advanced', 'LineBonus', ILineBonus[LineBonus]);
-
- //Party Popup
- IniFile.WriteString('Advanced', 'PartyPopup', IPartyPopup[PartyPopup]);
-
- // Joypad
- IniFile.WriteString('Controller', 'Joypad', IJoypad[Joypad]);
-
- // Directories (add a template if section is missing)
- if (not IniFile.SectionExists('Directories')) then
- IniFile.WriteString('Directories', 'SongDir1', '');
-
- IniFile.Free;
-end;
-
-procedure TIni.SaveNames;
-var
- IniFile: TIniFile;
- I: integer;
-begin
- if not FileIsReadOnly(Filename) then
- begin
- IniFile := TIniFile.Create(Filename);
-
- //Name Templates for Names Mod
- for I := 1 to 12 do
- IniFile.WriteString('Name', 'P' + IntToStr(I), Name[I-1]);
- for I := 1 to 3 do
- IniFile.WriteString('NameTeam', 'T' + IntToStr(I), NameTeam[I-1]);
- for I := 1 to 12 do
- IniFile.WriteString('NameTemplate', 'Name' + IntToStr(I), NameTemplate[I-1]);
-
- IniFile.Free;
- end;
-end;
-
-procedure TIni.SaveLevel;
-var
- IniFile: TIniFile;
-begin
- if not FileIsReadOnly(Filename) then
- begin
- IniFile := TIniFile.Create(Filename);
-
- // Difficulty
- IniFile.WriteString('Game', 'Difficulty', IDifficulty[Difficulty]);
-
- IniFile.Free;
- end;
-end;
-
-end.
diff --git a/src/classes/UJoystick.pas b/src/classes/UJoystick.pas
deleted file mode 100644
index 0ca7ba09..00000000
--- a/src/classes/UJoystick.pas
+++ /dev/null
@@ -1,282 +0,0 @@
-unit UJoystick;
-
-interface
-
-{$I switches.inc}
-
-
-uses SDL;
-
-type
- TJoyButton = record
- State: integer;
- Enabled: boolean;
- Type_: byte;
- Sym: cardinal;
- end;
-
- TJoyHatState = record
- State: Boolean;
- LastTick: Cardinal;
- Enabled: boolean;
- Type_: byte;
- Sym: cardinal;
- end;
-
- TJoyUnit = record
- Button: array[0..15] of TJoyButton;
- HatState: Array[0..3] of TJoyHatState;
- end;
-
- TJoy = class
- constructor Create;
- procedure Update;
- end;
-
-var
- Joy: TJoy;
- JoyUnit: TJoyUnit;
- SDL_Joy: PSDL_Joystick;
- JoyEvent: TSDL_Event;
-
-implementation
-
-uses SysUtils,
- ULog;
-
-constructor TJoy.Create;
-var
- B, N: integer;
-begin
- inherited;
-
- //Old Corvus5 Method
- {// joystick support
- SDL_JoystickEventState(SDL_IGNORE);
- SDL_InitSubSystem(SDL_INIT_JOYSTICK);
- if SDL_NumJoysticks <> 1 then
- Log.LogStatus('Joystick count <> 1', 'TJoy.Create');
-
- SDL_Joy := SDL_JoystickOpen(0);
- if SDL_Joy = nil then
- Log.LogError('SDL_JoystickOpen failed', 'TJoy.Create');
-
- if SDL_JoystickNumButtons(SDL_Joy) <> 16 then
- Log.LogStatus('Joystick button count <> 16', 'TJoy.Create');
-
-// SDL_JoystickEventState(SDL_ENABLE);
- // Events don't work - thay hang the whole application with SDL_JoystickEventState(SDL_ENABLE)
-
- // clear states
- for B := 0 to 15 do
- JoyUnit.Button[B].State := 1;
-
- // mapping
- JoyUnit.Button[1].Enabled := true;
- JoyUnit.Button[1].Type_ := SDL_KEYDOWN;
- JoyUnit.Button[1].Sym := SDLK_RETURN;
- JoyUnit.Button[2].Enabled := true;
- JoyUnit.Button[2].Type_ := SDL_KEYDOWN;
- JoyUnit.Button[2].Sym := SDLK_ESCAPE;
-
- JoyUnit.Button[12].Enabled := true;
- JoyUnit.Button[12].Type_ := SDL_KEYDOWN;
- JoyUnit.Button[12].Sym := SDLK_LEFT;
- JoyUnit.Button[13].Enabled := true;
- JoyUnit.Button[13].Type_ := SDL_KEYDOWN;
- JoyUnit.Button[13].Sym := SDLK_DOWN;
- JoyUnit.Button[14].Enabled := true;
- JoyUnit.Button[14].Type_ := SDL_KEYDOWN;
- JoyUnit.Button[14].Sym := SDLK_RIGHT;
- JoyUnit.Button[15].Enabled := true;
- JoyUnit.Button[15].Type_ := SDL_KEYDOWN;
- JoyUnit.Button[15].Sym := SDLK_UP;
- }
- //New Sarutas method
- SDL_JoystickEventState(SDL_IGNORE);
- SDL_InitSubSystem(SDL_INIT_JOYSTICK);
- if SDL_NumJoysticks < 1 then
- begin
- Log.LogError('No Joystick found');
- exit;
- end;
-
-
- SDL_Joy := SDL_JoystickOpen(0);
- if SDL_Joy = nil then
- begin
- Log.LogError('Could not Init Joystick');
- exit;
- end;
- N := SDL_JoystickNumButtons(SDL_Joy);
- //if N < 6 then Log.LogStatus('Joystick button count < 6', 'TJoy.Create');
-
- for B := 0 to 5 do begin
- JoyUnit.Button[B].Enabled := true;
- JoyUnit.Button[B].State := 1;
- JoyUnit.Button[B].Type_ := SDL_KEYDOWN;
- end;
-
- JoyUnit.Button[0].Sym := SDLK_Return;
- JoyUnit.Button[1].Sym := SDLK_Escape;
- JoyUnit.Button[2].Sym := SDLK_M;
- JoyUnit.Button[3].Sym := SDLK_R;
-
- JoyUnit.Button[4].Sym := SDLK_RETURN;
- JoyUnit.Button[5].Sym := SDLK_ESCAPE;
-
- //Set HatState
- for B := 0 to 3 do begin
- JoyUnit.HatState[B].Enabled := true;
- JoyUnit.HatState[B].State := False;
- JoyUnit.HatState[B].Type_ := SDL_KEYDOWN;
- end;
-
- JoyUnit.HatState[0].Sym := SDLK_UP;
- JoyUnit.HatState[1].Sym := SDLK_RIGHT;
- JoyUnit.HatState[2].Sym := SDLK_DOWN;
- JoyUnit.HatState[3].Sym := SDLK_LEFT;
-end;
-
-procedure TJoy.Update;
-var
- B: integer;
- State: UInt8;
- Tick: Cardinal;
- Axes: Smallint;
-begin
- SDL_JoystickUpdate;
-
- //Manage Buttons
- for B := 0 to 15 do begin
- if (JoyUnit.Button[B].Enabled) and (JoyUnit.Button[B].State <> SDL_JoystickGetButton(SDL_Joy, B)) and (JoyUnit.Button[B].State = 0) then begin
- JoyEvent.type_ := JoyUnit.Button[B].Type_;
- JoyEvent.key.keysym.sym := JoyUnit.Button[B].Sym;
- SDL_PushEvent(@JoyEvent);
- end;
- end;
-
-
- for B := 0 to 15 do begin
- JoyUnit.Button[B].State := SDL_JoystickGetButton(SDL_Joy, B);
- end;
-
- //Get Tick
- Tick := SDL_GetTicks();
-
- //Get CoolieHat
- if (SDL_JoystickNumHats(SDL_Joy)>=1) then
- State := SDL_JoystickGetHat(SDL_Joy, 0)
- else
- State := 0;
-
- //Get Axis
- if (SDL_JoystickNumAxes(SDL_Joy)>=2) then
- begin
- //Down - Up (X- Axis)
- Axes := SDL_JoystickGetAxis(SDL_Joy, 1);
- If Axes >= 15000 then
- State := State or SDL_HAT_Down
- Else If Axes <= -15000 then
- State := State or SDL_HAT_UP;
-
- //Left - Right (Y- Axis)
- Axes := SDL_JoystickGetAxis(SDL_Joy, 0);
- If Axes >= 15000 then
- State := State or SDL_HAT_Right
- Else If Axes <= -15000 then
- State := State or SDL_HAT_Left;
- end;
-
- //Manage Hat and joystick Events
- if (SDL_JoystickNumHats(SDL_Joy)>=1) OR (SDL_JoystickNumAxes(SDL_Joy)>=2) then
- begin
-
- //Up Button
- If (JoyUnit.HatState[0].Enabled) and ((SDL_HAT_UP AND State) = SDL_HAT_UP) then
- begin //IF Button is newly Pressed or if he is Pressed longer than 500 msecs
- if (JoyUnit.HatState[0].State = False) OR (JoyUnit.HatState[0].Lasttick < Tick) then
- begin
- //Set Tick and State
- if JoyUnit.HatState[0].State then
- JoyUnit.HatState[0].Lasttick := Tick + 200
- else
- JoyUnit.HatState[0].Lasttick := Tick + 500;
-
- JoyUnit.HatState[0].State := True;
-
- JoyEvent.type_ := JoyUnit.HatState[0].Type_;
- JoyEvent.key.keysym.sym := JoyUnit.HatState[0].Sym;
- SDL_PushEvent(@JoyEvent);
- end;
- end
- else
- JoyUnit.HatState[0].State := False;
-
- //Right Button
- If (JoyUnit.HatState[1].Enabled) and ((SDL_HAT_RIGHT AND State) = SDL_HAT_RIGHT) then
- begin //IF Button is newly Pressed or if he is Pressed longer than 500 msecs
- if (JoyUnit.HatState[1].State = False) OR (JoyUnit.HatState[1].Lasttick < Tick) then
- begin
- //Set Tick and State
- if JoyUnit.HatState[1].State then
- JoyUnit.HatState[1].Lasttick := Tick + 200
- else
- JoyUnit.HatState[1].Lasttick := Tick + 500;
-
- JoyUnit.HatState[1].State := True;
-
- JoyEvent.type_ := JoyUnit.HatState[1].Type_;
- JoyEvent.key.keysym.sym := JoyUnit.HatState[1].Sym;
- SDL_PushEvent(@JoyEvent);
- end;
- end
- else
- JoyUnit.HatState[1].State := False;
-
- //Down button
- If (JoyUnit.HatState[2].Enabled) and ((SDL_HAT_DOWN AND State) = SDL_HAT_DOWN) then
- begin //IF Button is newly Pressed or if he is Pressed longer than 230 msecs
- if (JoyUnit.HatState[2].State = False) OR (JoyUnit.HatState[2].Lasttick < Tick) then
- begin
- //Set Tick and State
- if JoyUnit.HatState[2].State then
- JoyUnit.HatState[2].Lasttick := Tick + 200
- else
- JoyUnit.HatState[2].Lasttick := Tick + 500;
-
- JoyUnit.HatState[2].State := True;
-
- JoyEvent.type_ := JoyUnit.HatState[2].Type_;
- JoyEvent.key.keysym.sym := JoyUnit.HatState[2].Sym;
- SDL_PushEvent(@JoyEvent);
- end;
- end
- else
- JoyUnit.HatState[2].State := False;
-
- //Left Button
- If (JoyUnit.HatState[3].Enabled) and ((SDL_HAT_LEFT AND State) = SDL_HAT_LEFT) then
- begin //IF Button is newly Pressed or if he is Pressed longer than 230 msecs
- if (JoyUnit.HatState[3].State = False) OR (JoyUnit.HatState[3].Lasttick < Tick) then
- begin
- //Set Tick and State
- if JoyUnit.HatState[3].State then
- JoyUnit.HatState[3].Lasttick := Tick + 200
- else
- JoyUnit.HatState[3].Lasttick := Tick + 500;
-
- JoyUnit.HatState[3].State := True;
-
- JoyEvent.type_ := JoyUnit.HatState[3].Type_;
- JoyEvent.key.keysym.sym := JoyUnit.HatState[3].Sym;
- SDL_PushEvent(@JoyEvent);
- end;
- end
- else
- JoyUnit.HatState[3].State := False;
- end;
-
-end;
-
-end.
diff --git a/src/classes/ULCD.pas b/src/classes/ULCD.pas
deleted file mode 100644
index 82f7ba2f..00000000
--- a/src/classes/ULCD.pas
+++ /dev/null
@@ -1,304 +0,0 @@
-unit ULCD;
-
-interface
-
-{$I switches.inc}
-
-type
- TLCD = class
- private
- Enabled: boolean;
- Text: array[1..6] of string;
- StartPos: integer;
- LineBR: integer;
- Position: integer;
- procedure WriteCommand(B: byte);
- procedure WriteData(B: byte);
- procedure WriteString(S: string);
- public
- HalfInterface: boolean;
- constructor Create;
- procedure Enable;
- procedure Clear;
- procedure WriteText(Line: integer; S: string);
- procedure MoveCursor(Line, Pos: integer);
- procedure ShowCursor;
- procedure HideCursor;
-
- // for 2x16
- procedure AddTextBR(S: string);
- procedure MoveCursorBR(Pos: integer);
- procedure ScrollUpBR;
- procedure AddTextArray(Line:integer; S: string);
- end;
-
-var
- LCD: TLCD;
-
-const
- Data = $378; // domy�lny adres portu
- Status = Data + 1;
- Control = Data + 2;
-
-implementation
-
-uses
- SysUtils,
- {$IFDEF UseSerialPort}
- zlportio,
- {$ENDIF}
- SDL,
- UTime;
-
-procedure TLCD.WriteCommand(B: Byte);
-// Wysylanie komend sterujacych
-begin
-{$IFDEF UseSerialPort}
- if not HalfInterface then
- begin
- zlioportwrite(Control, 0, $02);
- zlioportwrite(Data, 0, B);
- zlioportwrite(Control, 0, $03);
- end
- else
- begin
- zlioportwrite(Control, 0, $02);
- zlioportwrite(Data, 0, B and $F0);
- zlioportwrite(Control, 0, $03);
-
- SDL_Delay( 100 );
-
- zlioportwrite(Control, 0, $02);
- zlioportwrite(Data, 0, (B * 16) and $F0);
- zlioportwrite(Control, 0, $03);
- end;
-
- if (B=1) or (B=2) then
- Sleep(2)
- else
- SDL_Delay( 100 );
-{$ENDIF}
-end;
-
-procedure TLCD.WriteData(B: Byte);
-// Wysylanie danych
-begin
-{$IFDEF UseSerialPort}
- if not HalfInterface then
- begin
- zlioportwrite(Control, 0, $06);
- zlioportwrite(Data, 0, B);
- zlioportwrite(Control, 0, $07);
- end
- else
- begin
- zlioportwrite(Control, 0, $06);
- zlioportwrite(Data, 0, B and $F0);
- zlioportwrite(Control, 0, $07);
-
- SDL_Delay( 100 );
-
- zlioportwrite(Control, 0, $06);
- zlioportwrite(Data, 0, (B * 16) and $F0);
- zlioportwrite(Control, 0, $07);
- end;
-
- SDL_Delay( 100 );
- Inc(Position);
-{$ENDIF}
-end;
-
-procedure TLCD.WriteString(S: string);
-// Wysylanie slow
-var
- I: integer;
-begin
- for I := 1 to Length(S) do
- WriteData(Ord(S[I]));
-end;
-
-constructor TLCD.Create;
-begin
- inherited;
-end;
-
-procedure TLCD.Enable;
-{var
- A: byte;
- B: byte;}
-begin
- Enabled := true;
- if not HalfInterface then
- WriteCommand($38)
- else begin
- WriteCommand($33);
- WriteCommand($32);
- WriteCommand($28);
- end;
-
-// WriteCommand($06);
-// WriteCommand($0C);
-// sleep(10);
-end;
-
-procedure TLCD.Clear;
-begin
- if Enabled then begin
- WriteCommand(1);
- WriteCommand(2);
- Text[1] := '';
- Text[2] := '';
- Text[3] := '';
- Text[4] := '';
- Text[5] := '';
- Text[6] := '';
- StartPos := 1;
- LineBR := 1;
- end;
-end;
-
-procedure TLCD.WriteText(Line: integer; S: string);
-begin
- if Enabled then begin
- if Line <= 2 then begin
- MoveCursor(Line, 1);
- WriteString(S);
- end;
-
- Text[Line] := '';
- AddTextArray(Line, S);
- end;
-end;
-
-procedure TLCD.MoveCursor(Line, Pos: integer);
-var
- I: integer;
-begin
- if Enabled then begin
- Pos := Pos + (Line-1) * 40;
-
- if Position > Pos then begin
- WriteCommand(2);
- for I := 1 to Pos-1 do
- WriteCommand(20);
- end;
-
- if Position < Pos then
- for I := 1 to Pos - Position do
- WriteCommand(20);
-
- Position := Pos;
- end;
-end;
-
-procedure TLCD.ShowCursor;
-begin
- if Enabled then begin
- WriteCommand(14);
- end;
-end;
-
-procedure TLCD.HideCursor;
-begin
- if Enabled then begin
- WriteCommand(12);
- end;
-end;
-
-procedure TLCD.AddTextBR(S: string);
-var
- Word: string;
-// W: integer;
- P: integer;
- L: integer;
-begin
- if Enabled then begin
- if LineBR <= 6 then begin
- L := LineBR;
- P := Pos(' ', S);
-
- if L <= 2 then
- MoveCursor(L, 1);
-
- while (L <= 6) and (P > 0) do begin
- Word := Copy(S, 1, P);
- if (Length(Text[L]) + Length(Word)-1) > 16 then begin
- L := L + 1;
- if L <= 2 then
- MoveCursor(L, 1);
- end;
-
- if L <= 6 then begin
- if L <= 2 then
- WriteString(Word);
- AddTextArray(L, Word);
- end;
-
- Delete(S, 1, P);
- P := Pos(' ', S)
- end;
-
- LineBR := L + 1;
- end;
- end;
-end;
-
-procedure TLCD.MoveCursorBR(Pos: integer);
-{var
- I: integer;
- L: integer;}
-begin
- if Enabled then begin
- Pos := Pos - (StartPos-1);
- if Pos <= Length(Text[1]) then
- MoveCursor(1, Pos);
-
- if Pos > Length(Text[1]) then begin
- // bez zawijania
-// Pos := Pos - Length(Text[1]);
-// MoveCursor(2, Pos);
-
- // z zawijaniem
- Pos := Pos - Length(Text[1]);
- ScrollUpBR;
- MoveCursor(1, Pos);
- end;
- end;
-end;
-
-procedure TLCD.ScrollUpBR;
-var
- T: array[1..5] of string;
- SP: integer;
- LBR: integer;
-begin
- if Enabled then begin
- T[1] := Text[2];
- T[2] := Text[3];
- T[3] := Text[4];
- T[4] := Text[5];
- T[5] := Text[6];
- SP := StartPos + Length(Text[1]);
- LBR := LineBR;
-
- Clear;
-
- StartPos := SP;
- WriteText(1, T[1]);
- WriteText(2, T[2]);
- WriteText(3, T[3]);
- WriteText(4, T[4]);
- WriteText(5, T[5]);
- LineBR := LBR-1;
- end;
-end;
-
-procedure TLCD.AddTextArray(Line: integer; S: string);
-begin
- if Enabled then begin
- Text[Line] := Text[Line] + S;
- end;
-end;
-
-end.
-
diff --git a/src/classes/ULanguage.pas b/src/classes/ULanguage.pas
deleted file mode 100644
index d534b4e1..00000000
--- a/src/classes/ULanguage.pas
+++ /dev/null
@@ -1,240 +0,0 @@
-unit ULanguage;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-
-type
- TLanguageEntry = record
- ID: string;
- Text: string;
- end;
-
- TLanguageList = record
- Name: string;
- {FileName: string; }
- end;
-
- TLanguage = class
- public
- Entry: array of TLanguageEntry; //Entrys of Chosen Language
- SEntry: array of TLanguageEntry; //Entrys of Standard Language
- CEntry: array of TLanguageEntry; //Constant Entrys e.g. Version
- Implode_Glue1, Implode_Glue2: String;
- public
- List: array of TLanguageList;
-
- constructor Create;
- procedure LoadList;
- function Translate(Text: String): String;
- procedure ChangeLanguage(Language: String);
- procedure AddConst(ID, Text: String);
- procedure ChangeConst(ID, Text: String);
- function Implode(Pieces: Array of String): String;
- end;
-
-var
- Language: TLanguage;
-
-implementation
-
-uses UMain,
- // UFiles,
- UIni,
- IniFiles,
- Classes,
- SysUtils,
- {$IFDEF win32}
- windows,
- {$ENDIF}
- ULog;
-
-//----------
-//Create - Construct Class then LoadList + Standard Language + Set Standard Implode Glues
-//----------
-constructor TLanguage.Create;
-var
- I, J: Integer;
-begin
- inherited;
-
- LoadList;
-
- //Set Implode Glues for Backward Compatibility
- Implode_Glue1 := ', ';
- Implode_Glue2 := ' and ';
-
- if (Length(List) = 0) then //No Language Files Loaded -> Abort Loading
- Log.CriticalError('Could not load any Language File');
-
- //Standard Language (If a Language File is Incomplete)
- //Then use English Language
- for I := 0 to high(List) do //Search for English Language
- begin
- //English Language Found -> Load
- if Uppercase(List[I].Name) = 'ENGLISH' then
- begin
- ChangeLanguage('English');
-
- SetLength(SEntry, Length(Entry));
- for J := low(Entry) to high(Entry) do
- SEntry[J] := Entry[J];
-
- SetLength(Entry, 0);
-
- Break;
- end;
-
- if (I = high(List)) then
- Log.LogError('English Languagefile missing! No standard Translation loaded');
- end;
- //Standard Language END
-
-end;
-
-//----------
-//LoadList - Parse the Language Dir searching Translations
-//----------
-procedure TLanguage.LoadList;
-var
- SR: TSearchRec; // for parsing directory
-begin
- SetLength(List, 0);
- SetLength(ILanguage, 0);
-
- if FindFirst(LanguagesPath + '*.ini', 0, SR) = 0 then begin
- repeat
- SetLength(List, Length(List)+1);
- SetLength(ILanguage, Length(ILanguage)+1);
- SR.Name := ChangeFileExt(SR.Name, '');
-
- List[High(List)].Name := SR.Name;
- ILanguage[High(ILanguage)] := SR.Name;
-
- until FindNext(SR) <> 0;
- SysUtils.FindClose(SR);
- end; // if FindFirst
-end;
-
-//----------
-//ChangeLanguage - Load the specified LanguageFile
-//----------
-procedure TLanguage.ChangeLanguage(Language: String);
-var
- IniFile: TIniFile;
- E: integer; // entry
- S: TStringList;
-begin
- SetLength(Entry, 0);
- IniFile := TIniFile.Create(LanguagesPath + Language + '.ini');
- S := TStringList.Create;
-
- IniFile.ReadSectionValues('Text', S);
- SetLength(Entry, S.Count);
- for E := 0 to high(Entry) do
- begin
- if S.Names[E] = 'IMPLODE_GLUE1' then
- Implode_Glue1 := S.ValueFromIndex[E]+ ' '
- else if S.Names[E] = 'IMPLODE_GLUE2' then
- Implode_Glue2 := ' ' + S.ValueFromIndex[E] + ' ';
-
- Entry[E].ID := S.Names[E];
- Entry[E].Text := S.ValueFromIndex[E];
- end;
-
- S.Free;
- IniFile.Free;
-end;
-
-//----------
-//Translate - Translate the Text
-//----------
-Function TLanguage.Translate(Text: String): String;
-var
- E: integer; // entry
-begin
- Result := Text;
- Text := Uppercase(Result);
-
- //Const Mod
- for E := 0 to high(CEntry) do
- if Text = CEntry[E].ID then
- begin
- Result := CEntry[E].Text;
- exit;
- end;
- //Const Mod End
-
- for E := 0 to high(Entry) do
- if Text = Entry[E].ID then
- begin
- Result := Entry[E].Text;
- exit;
- end;
-
- //Standard Language (If a Language File is Incomplete)
- //Then use Standard Language
- for E := low(SEntry) to high(SEntry) do
- if Text = SEntry[E].ID then
- begin
- Result := SEntry[E].Text;
- Break;
- end;
- //Standard Language END
-end;
-
-//----------
-//AddConst - Add a Constant ID that will be Translated but not Loaded from the LanguageFile
-//----------
-procedure TLanguage.AddConst (ID, Text: String);
-begin
- SetLength (CEntry, Length(CEntry) + 1);
- CEntry[high(CEntry)].ID := ID;
- CEntry[high(CEntry)].Text := Text;
-end;
-
-//----------
-//ChangeConst - Change a Constant Value by ID
-//----------
-procedure TLanguage.ChangeConst(ID, Text: String);
-var
- I: Integer;
-begin
- for I := 0 to high(CEntry) do
- begin
- if CEntry[I].ID = ID then
- begin
- CEntry[I].Text := Text;
- Break;
- end;
- end;
-end;
-
-//----------
-//Implode - Connect an Array of Strings with ' and ' or ', ' to one String
-//----------
-function TLanguage.Implode(Pieces: Array of String): String;
-var
- I: Integer;
-begin
- Result := '';
- //Go through Pieces
- for I := low(Pieces) to high(Pieces) do
- begin
- //Add Value
- Result := Result + Pieces[I];
-
- //Add Glue
- if (I < high(Pieces) - 1) then
- Result := Result + Implode_Glue1
- else if (I < high(Pieces)) then
- Result := Result + Implode_Glue2;
- end;
-end;
-
-end.
diff --git a/src/classes/ULight.pas b/src/classes/ULight.pas
deleted file mode 100644
index a0a399ab..00000000
--- a/src/classes/ULight.pas
+++ /dev/null
@@ -1,145 +0,0 @@
-unit ULight;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-type
- TLight = class
- private
- Enabled: boolean;
- Light: array[0..7] of boolean;
- LightTime: array[0..7] of real; // time to stop, need to call update to change state
- LastTime: real;
- public
- constructor Create;
- procedure Enable;
- procedure SetState(State: integer);
- procedure AutoSetState;
- procedure TurnOn;
- procedure TurnOff;
- procedure LightOne(Number: integer; Time: real);
- procedure Refresh;
- end;
-
-var
- Light: TLight;
-
-const
- Data = $378; // default port address
- Status = Data + 1;
- Control = Data + 2;
-
-implementation
-
-uses
- SysUtils,
- {$IFDEF UseSerialPort}
- zlportio,
- {$ENDIF}
- UTime;
-
-{$IFDEF FPC}
-
- function GetTime: TDateTime;
- var
- SystemTime: TSystemTime;
- begin
- GetLocalTime(SystemTime);
- with SystemTime do
- begin
- {$IFDEF UNIX}
- Result := EncodeTime(Hour, Minute, Second, MilliSecond);
- {$ELSE}
- Result := EncodeTime(wHour, wMinute, wSecond, wMilliSeconds);
- {$ENDIF}
- end;
- end;
-
-{$ENDIF}
-
-
-constructor TLight.Create;
-begin
- inherited;
- Enabled := false;
-end;
-
-procedure TLight.Enable;
-begin
- Enabled := true;
- LastTime := GetTime;
-end;
-
-procedure TLight.SetState(State: integer);
-begin
- {$IFDEF UseSerialPort}
- if Enabled then
- PortWriteB($378, State);
- {$ENDIF}
-end;
-
-procedure TLight.AutoSetState;
-var
- State: integer;
-begin
- if Enabled then begin
- State := 0;
- if Light[0] then State := State + 2;
- if Light[1] then State := State + 1;
- // etc
- SetState(State);
- end;
-end;
-
-procedure TLight.TurnOn;
-begin
- if Enabled then
- SetState(3);
-end;
-
-procedure TLight.TurnOff;
-begin
- if Enabled then
- SetState(0);
-end;
-
-procedure TLight.LightOne(Number: integer; Time: real);
-begin
- if Enabled then begin
- if Light[Number] = false then begin
- Light[Number] := true;
- AutoSetState;
- end;
-
- LightTime[Number] := GetTime + Time/1000; // [s]
- end;
-end;
-
-procedure TLight.Refresh;
-var
- Time: real;
- L: integer;
-begin
- if Enabled then begin
- Time := GetTime;
- for L := 0 to 7 do begin
- if Light[L] = true then begin
- if LightTime[L] > Time then begin
- end else begin
- Light[L] := false;
- end;
- end;
- end;
- LastTime := Time;
- AutoSetState;
- end;
-end;
-
-end.
-
-
diff --git a/src/classes/ULog.pas b/src/classes/ULog.pas
deleted file mode 100644
index a9a2f3c4..00000000
--- a/src/classes/ULog.pas
+++ /dev/null
@@ -1,417 +0,0 @@
-unit ULog;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses
- Classes;
-
-(*
- * LOG_LEVEL_[TYPE] defines the "minimum" index for logs of type TYPE. Each
- * level greater than this BUT less or equal than LOG_LEVEL_[TYPE]_MAX is of this type.
- * This means a level "LOG_LEVEL_ERROR >= Level <= LOG_LEVEL_ERROR_MAX" e.g.
- * "Level := LOG_LEVEL_ERROR+2" is considered an error level.
- * This is nice for debugging if you have more or less important debug messages.
- * For example you can assign LOG_LEVEL_DEBUG+10 for the more important ones and
- * LOG_LEVEL_DEBUG+20 for less important ones and so on. By changing the log-level
- * you can hide the less important ones.
- *)
-const
- LOG_LEVEL_DEBUG_MAX = MaxInt;
- LOG_LEVEL_DEBUG = 50;
- LOG_LEVEL_INFO_MAX = LOG_LEVEL_DEBUG-1;
- LOG_LEVEL_INFO = 40;
- LOG_LEVEL_STATUS_MAX = LOG_LEVEL_INFO-1;
- LOG_LEVEL_STATUS = 30;
- LOG_LEVEL_WARN_MAX = LOG_LEVEL_STATUS-1;
- LOG_LEVEL_WARN = 20;
- LOG_LEVEL_ERROR_MAX = LOG_LEVEL_WARN-1;
- LOG_LEVEL_ERROR = 10;
- LOG_LEVEL_CRITICAL_MAX = LOG_LEVEL_ERROR-1;
- LOG_LEVEL_CRITICAL = 0;
- LOG_LEVEL_NONE = -1;
-
- // define level that Log(File)Level is initialized with
- LOG_LEVEL_DEFAULT = LOG_LEVEL_WARN;
- LOG_FILE_LEVEL_DEFAULT = LOG_LEVEL_ERROR;
-
-type
- TLog = class
- private
- LogFile: TextFile;
- LogFileOpened: boolean;
- BenchmarkFile: TextFile;
- BenchmarkFileOpened: boolean;
-
- LogLevel: integer;
- // level of messages written to the log-file
- LogFileLevel: integer;
-
- procedure LogToFile(const Text: string);
- public
- BenchmarkTimeStart: array[0..31] of real;
- BenchmarkTimeLength: array[0..31] of real;//TDateTime;
-
- Title: String; //Application Title
-
- // Write log message to log-file
- FileOutputEnabled: Boolean;
-
- constructor Create;
-
- // destuctor
- destructor Destroy; override;
-
- // benchmark
- procedure BenchmarkStart(Number: integer);
- procedure BenchmarkEnd(Number: integer);
- procedure LogBenchmark(const Text: string; Number: integer);
-
- procedure SetLogLevel(Level: integer);
- function GetLogLevel(): integer;
-
- procedure LogMsg(const Text: string; Level: integer); overload;
- procedure LogMsg(const Msg, Context: string; Level: integer); overload; {$IFDEF HasInline}inline;{$ENDIF}
- procedure LogDebug(const Msg, Context: string); {$IFDEF HasInline}inline;{$ENDIF}
- procedure LogInfo(const Msg, Context: string); {$IFDEF HasInline}inline;{$ENDIF}
- procedure LogStatus(const Msg, Context: string); {$IFDEF HasInline}inline;{$ENDIF}
- procedure LogWarn(const Msg, Context: string); {$IFDEF HasInline}inline;{$ENDIF}
- procedure LogError(const Text: string); overload; {$IFDEF HasInline}inline;{$ENDIF}
- procedure LogError(const Msg, Context: string); overload; {$IFDEF HasInline}inline;{$ENDIF}
- //Critical Error (Halt + MessageBox)
- procedure LogCritical(const Msg, Context: string); {$IFDEF HasInline}inline;{$ENDIF}
- procedure CriticalError(const Text: string); {$IFDEF HasInline}inline;{$ENDIF}
-
- // voice
- procedure LogVoice(SoundNr: integer);
- // buffer
- procedure LogBuffer(const buf : Pointer; const bufLength : Integer; const filename : string);
- end;
-
-procedure DebugWriteln(const aString: String);
-
-var
- Log: TLog;
-
-implementation
-
-uses
- SysUtils,
- DateUtils,
- URecord,
- UMain,
- UTime,
- UCommon,
- UCommandLine;
-
-(*
- * Write to console if in debug mode (Thread-safe).
- * If debug-mode is disabled nothing is done.
- *)
-procedure DebugWriteln(const aString: string);
-begin
- {$IFNDEF DEBUG}
- if Params.Debug then
- begin
- {$ENDIF}
- ConsoleWriteLn(aString);
- {$IFNDEF DEBUG}
- end;
- {$ENDIF}
-end;
-
-
-constructor TLog.Create;
-begin
- inherited;
- LogLevel := LOG_LEVEL_DEFAULT;
- LogFileLevel := LOG_FILE_LEVEL_DEFAULT;
- FileOutputEnabled := true;
-end;
-
-destructor TLog.Destroy;
-begin
- if BenchmarkFileOpened then
- CloseFile(BenchmarkFile);
- //if AnalyzeFileOpened then
- // CloseFile(AnalyzeFile);
- if LogFileOpened then
- CloseFile(LogFile);
- inherited;
-end;
-
-procedure TLog.BenchmarkStart(Number: integer);
-begin
- BenchmarkTimeStart[Number] := USTime.GetTime; //Time;
-end;
-
-procedure TLog.BenchmarkEnd(Number: integer);
-begin
- BenchmarkTimeLength[Number] := USTime.GetTime {Time} - BenchmarkTimeStart[Number];
-end;
-
-procedure TLog.LogBenchmark(const Text: string; Number: integer);
-var
- Minutes: integer;
- Seconds: integer;
- Miliseconds: integer;
-
- MinutesS: string;
- SecondsS: string;
- MilisecondsS: string;
-
- ValueText: string;
-begin
- if (FileOutputEnabled and Params.Benchmark) then
- begin
- if not BenchmarkFileOpened then
- begin
- BenchmarkFileOpened := true;
- AssignFile(BenchmarkFile, LogPath + 'Benchmark.log');
- {$I-}
- Rewrite(BenchmarkFile);
- if IOResult = 0 then
- BenchmarkFileOpened := true;
- {$I+}
-
- //If File is opened write Date to Benchmark File
- If (BenchmarkFileOpened) then
- begin
- WriteLn(BenchmarkFile, Title + ' Benchmark File');
- WriteLn(BenchmarkFile, 'Date: ' + DatetoStr(Now) + ' Time: ' + TimetoStr(Now));
- WriteLn(BenchmarkFile, '-------------------');
-
- Flush(BenchmarkFile);
- end;
- end;
-
- if BenchmarkFileOpened then
- begin
- Miliseconds := Trunc(Frac(BenchmarkTimeLength[Number]) * 1000);
- Seconds := Trunc(BenchmarkTimeLength[Number]) mod 60;
- Minutes := Trunc((BenchmarkTimeLength[Number] - Seconds) / 60);
- //ValueText := FloatToStr(BenchmarkTimeLength[Number]);
-
- {
- ValueText := FloatToStr(SecondOf(BenchmarkTimeLength[Number]) +
- MilliSecondOf(BenchmarkTimeLength[Number])/1000);
- if MinuteOf(BenchmarkTimeLength[Number]) >= 1 then
- ValueText := IntToStr(MinuteOf(BenchmarkTimeLength[Number])) + ':' + ValueText;
- WriteLn(FileBenchmark, Text + ': ' + ValueText + ' seconds');
- }
-
- if (Minutes = 0) and (Seconds = 0) then begin
- MilisecondsS := IntToStr(Miliseconds);
- ValueText := MilisecondsS + ' miliseconds';
- end;
-
- if (Minutes = 0) and (Seconds >= 1) then begin
- MilisecondsS := IntToStr(Miliseconds);
- while Length(MilisecondsS) < 3 do
- MilisecondsS := '0' + MilisecondsS;
-
- SecondsS := IntToStr(Seconds);
-
- ValueText := SecondsS + ',' + MilisecondsS + ' seconds';
- end;
-
- if Minutes >= 1 then begin
- MilisecondsS := IntToStr(Miliseconds);
- while Length(MilisecondsS) < 3 do
- MilisecondsS := '0' + MilisecondsS;
-
- SecondsS := IntToStr(Seconds);
- while Length(SecondsS) < 2 do
- SecondsS := '0' + SecondsS;
-
- MinutesS := IntToStr(Minutes);
-
- ValueText := MinutesS + ':' + SecondsS + ',' + MilisecondsS + ' minutes';
- end;
-
- WriteLn(BenchmarkFile, Text + ': ' + ValueText);
- Flush(BenchmarkFile);
- end;
- end;
-end;
-
-procedure TLog.LogToFile(const Text: string);
-begin
- if (FileOutputEnabled and not LogFileOpened) then
- begin
- AssignFile(LogFile, LogPath + 'Error.log');
- {$I-}
- Rewrite(LogFile);
- if IOResult = 0 then
- LogFileOpened := true;
- {$I+}
-
- //If File is opened write Date to Error File
- if (LogFileOpened) then
- begin
- WriteLn(LogFile, Title + ' Error Log');
- WriteLn(LogFile, 'Date: ' + DatetoStr(Now) + ' Time: ' + TimetoStr(Now));
- WriteLn(LogFile, '-------------------');
-
- Flush(LogFile);
- end;
- end;
-
- if LogFileOpened then
- begin
- try
- WriteLn(LogFile, Text);
- Flush(LogFile);
- except
- LogFileOpened := false;
- end;
- end;
-end;
-
-procedure TLog.SetLogLevel(Level: integer);
-begin
- LogLevel := Level;
-end;
-
-function TLog.GetLogLevel(): integer;
-begin
- Result := LogLevel;
-end;
-
-procedure TLog.LogMsg(const Text: string; Level: integer);
-var
- LogMsg: string;
-begin
- // TODO: what if (LogFileLevel < LogLevel)? Log to file without printing to
- // console or do not log at all? At the moment nothing is logged.
- if (Level <= LogLevel) then
- begin
- if (Level <= LOG_LEVEL_CRITICAL_MAX) then
- LogMsg := 'CRITICAL: ' + Text
- else if (Level <= LOG_LEVEL_ERROR_MAX) then
- LogMsg := 'ERROR: ' + Text
- else if (Level <= LOG_LEVEL_WARN_MAX) then
- LogMsg := 'WARN: ' + Text
- else if (Level <= LOG_LEVEL_STATUS_MAX) then
- LogMsg := 'STATUS: ' + Text
- else if (Level <= LOG_LEVEL_INFO_MAX) then
- LogMsg := 'INFO: ' + Text
- else
- LogMsg := 'DEBUG: ' + Text;
-
- // output log-message
- if (Level <= LogLevel) then
- begin
- DebugWriteLn(LogMsg);
- end;
-
- // write message to log-file
- if (Level <= LogFileLevel) then
- begin
- LogToFile(LogMsg);
- end;
- end;
-
- // exit application on criticial errors (cannot be turned off)
- if (Level <= LOG_LEVEL_CRITICAL_MAX) then
- begin
- // Show information (window)
- ShowMessage(Text, mtError);
- Halt;
- end;
-end;
-
-procedure TLog.LogMsg(const Msg, Context: string; Level: integer);
-begin
- LogMsg(Msg + ' ['+Context+']', Level);
-end;
-
-procedure TLog.LogDebug(const Msg, Context: string);
-begin
- LogMsg(Msg, Context, LOG_LEVEL_DEBUG);
-end;
-
-procedure TLog.LogInfo(const Msg, Context: string);
-begin
- LogMsg(Msg, Context, LOG_LEVEL_INFO);
-end;
-
-procedure TLog.LogStatus(const Msg, Context: string);
-begin
- LogMsg(Msg, Context, LOG_LEVEL_STATUS);
-end;
-
-procedure TLog.LogWarn(const Msg, Context: string);
-begin
- LogMsg(Msg, Context, LOG_LEVEL_WARN);
-end;
-
-procedure TLog.LogError(const Msg, Context: string);
-begin
- LogMsg(Msg, Context, LOG_LEVEL_ERROR);
-end;
-
-procedure TLog.LogError(const Text: string);
-begin
- LogMsg(Text, LOG_LEVEL_ERROR);
-end;
-
-procedure TLog.CriticalError(const Text: string);
-begin
- LogMsg(Text, LOG_LEVEL_CRITICAL);
-end;
-
-procedure TLog.LogCritical(const Msg, Context: string);
-begin
- LogMsg(Msg, Context, LOG_LEVEL_CRITICAL);
-end;
-
-procedure TLog.LogVoice(SoundNr: integer);
-var
- FS: TFileStream;
- FileName: string;
- Num: integer;
-begin
- for Num := 1 to 9999 do begin
- FileName := IntToStr(Num);
- while Length(FileName) < 4 do
- FileName := '0' + FileName;
- FileName := LogPath + 'Voice' + FileName + '.raw';
- if not FileExists(FileName) then
- break
- end;
-
- FS := TFileStream.Create(FileName, fmCreate);
-
- AudioInputProcessor.Sound[SoundNr].LogBuffer.Seek(0, soBeginning);
- FS.CopyFrom(AudioInputProcessor.Sound[SoundNr].LogBuffer, AudioInputProcessor.Sound[SoundNr].LogBuffer.Size);
-
- FS.Free;
-end;
-
-procedure TLog.LogBuffer(const buf: Pointer; const bufLength: Integer; const filename: string);
-var
- f : TFileStream;
-begin
- f := nil;
-
- try
- f := TFileStream.Create( filename, fmCreate);
- f.Write( buf^, bufLength);
- f.Free;
- except
- on e : Exception do begin
- Log.LogError('TLog.LogBuffer: Failed to log buffer into file "' + filename + '". ErrMsg: ' + e.Message);
- f.Free;
- end;
- end;
-end;
-
-end.
-
-
diff --git a/src/classes/ULyrics.pas b/src/classes/ULyrics.pas
deleted file mode 100644
index 305cb91f..00000000
--- a/src/classes/ULyrics.pas
+++ /dev/null
@@ -1,884 +0,0 @@
-unit ULyrics;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses
- gl,
- glext,
- UTexture,
- UThemes,
- UMusic;
-
-type
- // stores two textures for enabled/disabled states
- TPlayerIconTex = array [0..1] of TTexture;
-
- PLyricWord = ^TLyricWord;
- TLyricWord = record
- X: Real; // left corner
- Width: Real; // width
- Start: Cardinal; // start of the word in quarters (beats)
- Length: Cardinal; // length of the word in quarters
- Text: String; // text
- Freestyle: Boolean; // is freestyle?
- end;
- ALyricWord = array of TLyricWord;
-
- TLyricLine = class
- public
- Text: String; // text
- Tex: glUInt; // texture of the text
- Width: Real; // width
- Size: Byte; // fontsize
- Words: ALyricWord; // words in this line
- CurWord: Integer; // current active word idx (only valid if line is active)
- Start: Integer; // start of this line in quarters (Note: negative start values are possible due to gap)
- StartNote: Integer; // start of the first note of this line in quarters
- Length: Integer; // length in quarters (from start of first to the end of the last note)
- HasFreestyle: Boolean; // one or more word are freestyle?
- CountFreestyle: Integer; // how often there is a change from freestyle to non freestyle in this line
- Players: Byte; // players that should sing that line (bitset, Player1: 1, Player2: 2, Player3: 4)
- LastLine: Boolean; // is this the last line of the song?
-
- constructor Create();
- destructor Destroy(); override;
- procedure Reset();
- end;
-
- TLyricEngine = class
- private
- LastDrawBeat: Real;
- UpperLine: TLyricLine; // first line displayed (top)
- LowerLine: TLyricLine; // second lind displayed (bottom)
- QueueLine: TLyricLine; // third line (will be displayed when lower line is finished)
-
- IndicatorTex: TTexture; // texture for lyric indikator
- BallTex: TTexture; // texture of the ball for the lyric effect
-
- QueueFull: Boolean; // set to true if the queue is full and a line will be replaced with the next AddLine
- LCounter: Word; // line counter
-
- // duet mode - textures for player icons
- // FIXME: do not use a fixed player count, use MAX_PLAYERS instead
- PlayerIconTex: array[0..5] of TPlayerIconTex;
-
- //Some helper Procedures for Lyric Drawing
- procedure DrawLyrics (Beat: Real);
- procedure DrawLyricsLine(X, W, Y: Real; Size: Byte; Line: TLyricLine; Beat: Real);
- procedure DrawPlayerIcon(Player: Byte; Enabled: Boolean; X, Y, Size, Alpha: Real);
- procedure DrawBall(XBall, YBall, Alpha:Real);
-
- public
- // positions, line specific settings
- UpperLineX: Real; //X Start Pos of UpperLine
- UpperLineW: Real; //Width of UpperLine with Icon(s) and Text
- UpperLineY: Real; //Y Start Pos of UpperLine
- UpperLineSize: Byte; //Max Size of Lyrics Text in UpperLine
-
- LowerLineX: Real; //X Start Pos of LowerLine
- LowerLineW: Real; //Width of LowerLine with Icon(s) and Text
- LowerLineY: Real; //Y Start Pos of LowerLine
- LowerLineSize: Byte; //Max Size of Lyrics Text in LowerLine
-
- // display propertys
- LineColor_en: TRGBA; //Color of Words in an Enabled Line
- LineColor_dis: TRGBA; //Color of Words in a Disabled Line
- LineColor_act: TRGBA; //Color of teh active Word
- FontStyle: Byte; //Font for the Lyric Text
- FontReSize: Boolean; //ReSize Lyrics if they don't fit Screen
-
- { // currently not used
- FadeInEffect: Byte; //Effect for Line Fading in: 0: No Effect; 1: Fade Effect; 2: Move Upwards from Bottom to Pos
- FadeOutEffect: Byte; //Effect for Line Fading out: 0: No Effect; 1: Fade Effect; 2: Move Upwards
- }
-
- UseLinearFilter: Boolean; //Should Linear Tex Filter be used
-
- // song specific settings
- BPM: Real;
- Resolution: Integer;
-
- // properties to easily read options of this class
- property IsQueueFull: Boolean read QueueFull; // line in queue?
- property LineCounter: Word read LCounter; // lines that were progressed so far (after last clear)
-
- procedure AddLine(Line: PLine); // adds a line to the queue, if there is space
- procedure Draw (Beat: Real); // draw the current (active at beat) lyrics
-
- // clears all cached song specific information
- procedure Clear(cBPM: Real = 0; cResolution: Integer = 0);
-
- function GetUpperLine(): TLyricLine;
- function GetLowerLine(): TLyricLine;
-
- function GetUpperLineIndex(): Integer;
-
- constructor Create; overload;
- constructor Create(ULX,ULY,ULW,ULS,LLX,LLY,LLW,LLS: Real); overload;
- procedure LoadTextures;
- destructor Destroy; override;
- end;
-
-implementation
-
-uses SysUtils,
- USkins,
- TextGL,
- UGraphic,
- UDisplay,
- ULog,
- math,
- UIni;
-
-//-----------
-//Helper procs to use TRGB in Opengl ...maybe this should be somewhere else
-//-----------
-procedure glColorRGB(Color: TRGB); overload;
-begin
- glColor3f(Color.R, Color.G, Color.B);
-end;
-
-procedure glColorRGB(Color: TRGB; Alpha: Real); overload;
-begin
- glColor4f(Color.R, Color.G, Color.B, Alpha);
-end;
-
-procedure glColorRGB(Color: TRGBA); overload;
-begin
- glColor4f(Color.R, Color.G, Color.B, Color.A);
-end;
-
-procedure glColorRGB(Color: TRGBA; Alpha: Real); overload;
-begin
- glColor4f(Color.R, Color.G, Color.B, Min(Color.A, Alpha));
-end;
-
-{ TLyricLine }
-
-constructor TLyricLine.Create();
-begin
- inherited;
- Reset();
-end;
-
-destructor TLyricLine.Destroy();
-begin
- SetLength(Words, 0);
- inherited;
-end;
-
-procedure TLyricLine.Reset();
-begin
- Start := 0;
- StartNote := 0;
- Length := 0;
- LastLine := False;
-
- Text := '';
- Width := 0;
-
- // duet mode: players of that line (default: all)
- Players := $FF;
-
- SetLength(Words, 0);
- CurWord := -1;
-
- HasFreestyle := False;
- CountFreestyle := 0;
-end;
-
-
-{ TLyricEngine }
-
-//---------------
-// Create - Constructor, just get Memory
-//---------------
-constructor TLyricEngine.Create;
-begin
- inherited;
-
- BPM := 0;
- Resolution := 0;
- LCounter := 0;
- QueueFull := False;
-
- UpperLine := TLyricLine.Create;
- LowerLine := TLyricLine.Create;
- QueueLine := TLyricLine.Create;
-
- UseLinearFilter := True;
- LastDrawBeat := 0;
-end;
-
-constructor TLyricEngine.Create(ULX,ULY,ULW,ULS,LLX,LLY,LLW,LLS:Real);
-begin
- Create;
-
- UpperLineX := ULX;
- UpperLineW := ULW;
- UpperLineY := ULY;
- UpperLineSize := Trunc(ULS);
-
- LowerLineX := LLX;
- LowerLineW := LLW;
- LowerLineY := LLY;
- LowerLineSize := Trunc(LLS);
-
- LoadTextures;
-end;
-
-
-//---------------
-// Destroy - Frees Memory
-//---------------
-destructor TLyricEngine.Destroy;
-begin
- UpperLine.Free;
- LowerLine.Free;
- QueueLine.Free;
- inherited;
-end;
-
-//---------------
-// Clear - Clears all cached Song specific Information
-//---------------
-procedure TLyricEngine.Clear(cBPM: Real; cResolution: Integer);
-begin
- BPM := cBPM;
- Resolution := cResolution;
- LCounter := 0;
- QueueFull := False;
-
- LastDrawBeat:=0;
-end;
-
-
-//---------------
-// LoadTextures - Load Player Textures and Create Lyric Textures
-//---------------
-procedure TLyricEngine.LoadTextures;
-var
- I: Integer;
-
- function CreateLineTex: glUint;
- begin
- // generate and bind Texture
- glGenTextures(1, @Result);
- glBindTexture(GL_TEXTURE_2D, Result);
-
- glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE);
- glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE);
-
- if UseLinearFilter then
- begin
- glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);
- glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
- end;
- end;
-
-begin
-
- // lyric indicator (bar that indicates when the line start)
- IndicatorTex := Texture.LoadTexture(Skin.GetTextureFileName('LyricHelpBar'), TEXTURE_TYPE_TRANSPARENT, $FF00FF);
-
- // ball for current word hover in ball effect
- BallTex := Texture.LoadTexture(Skin.GetTextureFileName('Ball'), TEXTURE_TYPE_TRANSPARENT, 0);
-
- // duet mode: load player icon
- for I := 0 to 5 do
- begin
- PlayerIconTex[I][0] := Texture.LoadTexture(Skin.GetTextureFileName('LyricIcon_P' + InttoStr(I+1)), TEXTURE_TYPE_TRANSPARENT, 0);
- PlayerIconTex[I][1] := Texture.LoadTexture(Skin.GetTextureFileName('LyricIconD_P' + InttoStr(I+1)), TEXTURE_TYPE_TRANSPARENT, 0);
- end;
-
- // create line textures
- UpperLine.Tex := CreateLineTex;
- LowerLine.Tex := CreateLineTex;
- QueueLine.Tex := CreateLineTex;
-end;
-
-
-//---------------
-// AddLine - Adds LyricLine to queue
-// The LyricEngine stores three lines in its queue:
-// UpperLine: the upper line displayed in the lyrics
-// LowerLine: the lower line displayed in the lyrics
-// QueueLine: an offscreen line that precedes LowerLine
-// If the queue is full the next call to AddLine will replace UpperLine with
-// LowerLine, LowerLine with QueueLine and QueueLine with the Line parameter.
-//---------------
-procedure TLyricEngine.AddLine(Line: PLine);
-var
- LyricLine: TLyricLine;
- PosX: Real;
- I: Integer;
- CurWord: PLyricWord;
- RenderPass: Integer;
-
- function CalcWidth(LyricLine: TLyricLine): Real;
- begin
- Result := glTextWidth(PChar(LyricLine.Text));
-
- Result := Result + (LyricLine.CountFreestyle * 10);
-
- // if the line ends with a freestyle not, then leave the place to finish to draw the text italic
- if (LyricLine.Words[High(LyricLine.Words)].Freestyle) then
- Result := Result + 12;
- end;
-
-begin
- // only add lines, if there is space
- if not IsQueueFull then
- begin
- // set LyricLine to line to write to
- if (LineCounter = 0) then
- LyricLine := UpperLine
- else if (LineCounter = 1) then
- LyricLine := LowerLine
- else
- begin
- // now the queue is full
- LyricLine := QueueLine;
- QueueFull := True;
- end;
- end
- else
- begin // rotate lines (round-robin-like)
- LyricLine := UpperLine;
- UpperLine := LowerLine;
- LowerLine := QueueLine;
- QueueLine := LyricLine;
- end;
-
- // reset line state
- LyricLine.Reset();
-
- // check if sentence has notes
- if (Line <> nil) and (Length(Line.Note) > 0) then
- begin
- // copy values from SongLine to LyricLine
- LyricLine.Start := Line.Start;
- LyricLine.StartNote := Line.Note[0].Start;
- LyricLine.Length := Line.Note[High(Line.Note)].Start +
- Line.Note[High(Line.Note)].Length -
- Line.Note[0].Start;
- LyricLine.LastLine := Line.LastLine;
-
- // copy words
- SetLength(LyricLine.Words, Length(Line.Note));
- for I := 0 to High(Line.Note) do
- begin
- LyricLine.Words[I].Start := Line.Note[I].Start;
- LyricLine.Words[I].Length := Line.Note[I].Length;
- LyricLine.Words[I].Text := Line.Note[I].Text;
- LyricLine.Words[I].Freestyle := Line.Note[I].NoteType = ntFreestyle;
-
- LyricLine.HasFreestyle := LyricLine.HasFreestyle or LyricLine.Words[I].Freestyle;
- LyricLine.Text := LyricLine.Text + LyricLine.Words[I].Text;
-
- if (I > 0) and
- LyricLine.Words[I-1].Freestyle and
- not LyricLine.Words[I].Freestyle then
- begin
- Inc(LyricLine.CountFreestyle);
- end;
- end;
-
- // set font params
- SetFontStyle(FontStyle);
- SetFontPos(0, 0);
- LyricLine.Size := UpperLineSize;
- SetFontSize(LyricLine.Size);
- SetFontItalic(False);
- SetFontReflection(False, 0);
- glColor4f(1, 1, 1, 1);
-
- // change fontsize to fit the screen
- LyricLine.Width := CalcWidth(LyricLine);
- while (LyricLine.Width > UpperLineW) do
- begin
- Dec(LyricLine.Size);
-
- if (LyricLine.Size <=1) then
- Break;
-
- SetFontSize(LyricLine.Size);
- LyricLine.Width := CalcWidth(LyricLine);
- end;
-
- // Offscreen rendering of LyricTexture:
- // First we will create a white transparent background to draw on.
- // If the text was simply drawn to the screen with blending, the translucent
- // parts of the text would be merged with the current color of the background.
- // This would result in a texture that partly contains the screen we are
- // drawing on. This will be visible in the fonts outline when the LyricTexture
- // is drawn to the screen later.
- // So we have to draw the text in TWO passes.
- // At the first pass we copy the characters to the back-buffer in such a way
- // that preceding characters are not repainted by following chars (otherwise
- // some characters would be blended twice in the 2nd pass).
- // To achieve this we disable blending and enable the depth-test. The z-buffer
- // is used as a mask or replacement for the missing stencil-buffer. A z-value
- // of 1 means the pixel was not assigned yet, whereas 0 stands for a pixel
- // that was already drawn on. In addition we set the depth-func in such a way
- // that assigned pixels (0) will not be drawn a second time.
- // At the second pass we draw the text with blending and without depth-test.
- // This will blend overlapping characters but not the background as it was
- // repainted in the first pass.
-
- glPushAttrib(GL_VIEWPORT_BIT or GL_DEPTH_BUFFER_BIT);
- glViewPort(0, 0, 800, 600);
- glClearColor(0, 0, 0, 0);
- glDepthRange(0, 1);
- glClearDepth(1);
- glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
-
- SetFontZ(0);
-
- // assure blending is off and the correct depth-func is enabled
- glDisable(GL_BLEND);
- glDepthFunc(GL_LESS);
-
- // we need two passes to draw the font onto the screen.
- for RenderPass := 0 to 1 do
- begin
- if (RenderPass = 0) then
- begin
- // first pass: simply copy each character to the screen without overlapping.
- SetFontBlend(false);
- glEnable(GL_DEPTH_TEST);
- end
- else
- begin
- // second pass: now we will blend overlapping characters.
- SetFontBlend(true);
- glDisable(GL_DEPTH_TEST);
- end;
-
- PosX := 0;
-
- // set word positions and line size and draw the line to the back-buffer
- for I := 0 to High(LyricLine.Words) do
- begin
- CurWord := @LyricLine.Words[I];
-
- SetFontItalic(CurWord.Freestyle);
-
- CurWord.X := PosX;
-
- // Draw Lyrics
- SetFontPos(PosX, 0);
- glPrint(PChar(CurWord.Text));
-
- CurWord.Width := glTextWidth(PChar(CurWord.Text));
- if CurWord.Freestyle then
- begin
- if (I < High(LyricLine.Words)) and not LyricLine.Words[I+1].Freestyle then
- CurWord.Width := CurWord.Width + 10
- else if (I = High(LyricLine.Words)) then
- CurWord.Width := CurWord.Width + 12;
- end;
- PosX := PosX + CurWord.Width;
- end;
- end;
-
- // copy back-buffer to texture
- glBindTexture(GL_TEXTURE_2D, LyricLine.Tex);
- // FIXME: this does not work this way
- glCopyTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, 0, 600-64, 1024, 64, 0);
- if (glGetError() <> GL_NO_ERROR) then
- Log.LogError('Creation of Lyrics-texture failed', 'TLyricEngine.AddLine');
-
- // restore OpenGL state
- glPopAttrib();
-
- // clear buffer (use white to avoid flimmering if no cover/video is available)
- glClearColor(1, 1, 1, 1);
- glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
- end; // if (Line <> nil) and (Length(Line.Note) > 0)
-
- // increase the counter
- Inc(LCounter);
-end;
-
-
-//---------------
-// Draw - Procedure Draws Lyrics; Beat is curent Beat in Quarters
-// Draw just manage the Lyrics, drawing is done by a call of DrawLyrics
-//---------------
-procedure TLyricEngine.Draw(Beat: Real);
-begin
- DrawLyrics(Beat);
- LastDrawBeat := Beat;
-end;
-
-//---------------
-// DrawLyrics(private) - Helper for Draw; main Drawing procedure
-//---------------
-procedure TLyricEngine.DrawLyrics(Beat: Real);
-begin
- DrawLyricsLine(UpperLineX, UpperLineW, UpperlineY, 15, Upperline, Beat);
- DrawLyricsLine(LowerLineX, LowerLineW, LowerlineY, 15, Lowerline, Beat);
-end;
-
-//---------------
-// DrawPlayerIcon(private) - Helper for Draw; Draws a Playericon
-//---------------
-procedure TLyricEngine.DrawPlayerIcon(Player: Byte; Enabled: Boolean; X, Y, Size, Alpha: Real);
-var
- IEnabled: Byte;
-begin
- if Enabled then
- IEnabled := 0
- else
- IEnabled := 1;
-
- glEnable(GL_TEXTURE_2D);
- glEnable(GL_BLEND);
- glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
- glBindTexture(GL_TEXTURE_2D, PlayerIconTex[Player][IEnabled].TexNum);
-
- glColor4f(1, 1, 1, Alpha);
- glBegin(GL_QUADS);
- glTexCoord2f(0, 0); glVertex2f(X, Y);
- glTexCoord2f(0, 1); glVertex2f(X, Y + Size);
- glTexCoord2f(1, 1); glVertex2f(X + Size, Y + Size);
- glTexCoord2f(1, 0); glVertex2f(X + Size, Y);
- glEnd;
-
- glDisable(GL_BLEND);
- glDisable(GL_TEXTURE_2D);
-end;
-
-//---------------
-// DrawBall(private) - Helper for Draw; Draws the Ball over the LyricLine if needed
-//---------------
-procedure TLyricEngine.DrawBall(XBall, YBall, Alpha: Real);
-begin
- glEnable(GL_TEXTURE_2D);
- glEnable(GL_BLEND);
- glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
- glBindTexture(GL_TEXTURE_2D, BallTex.TexNum);
-
- glColor4f(1, 1, 1, Alpha);
- glBegin(GL_QUADS);
- glTexCoord2f(0, 0); glVertex2f(XBall - 10, YBall);
- glTexCoord2f(0, 1); glVertex2f(XBall - 10, YBall + 20);
- glTexCoord2f(1, 1); glVertex2f(XBall + 10, YBall + 20);
- glTexCoord2f(1, 0); glVertex2f(XBall + 10, YBall);
- glEnd;
-
- glDisable(GL_BLEND);
- glDisable(GL_TEXTURE_2D);
-end;
-
-//---------------
-// DrawLyricsLine(private) - Helper for Draw; Draws one LyricLine
-//---------------
-procedure TLyricEngine.DrawLyricsLine(X, W, Y: Real; Size: Byte; Line: TLyricLine; Beat: Real);
-var
- CurWordStart, CurWordEnd: Real; // screen coordinates of current word and the rest of the sentence
- FreestyleDiff: Integer; // difference between top and bottom coordiantes for freestyle lyrics
- Progress: Real; // progress of singing the current word
- LyricX: Real; // left
- LyricX2: Real; // right
- LyricY: Real; // top
- LyricsHeight: Real; // height the lyrics are displayed
- Alpha: Real; // alphalevel to fade out at end
- CurWord, LastWord: PLyricWord; // current word
-
- {// duet mode
- IconSize: Real; // size of player icons
- IconAlpha: Real; // alpha level of player icons
- }
-begin
- // do not draw empty lines
- // Note: lines with no words in it do not have a valid texture
- if (Length(Line.Words) = 0) or
- (Line.Width <= 0) then
- begin
- Exit;
- end;
-
- // this is actually a bit more than the real font size
- // it helps adjusting the "zoom-center"
- LyricsHeight := 30.5 * (Line.Size/10);
-
- {
- // duet mode
- IconSize := (2 * Size);
- IconAlpha := Frac(Beat/(Resolution*4));
-
- DrawPlayerIcon (0, True, X, Y + (42 - IconSize) / 2 , IconSize, IconAlpha);
- DrawPlayerIcon (1, True, X + IconSize + 1, Y + (42 - IconSize) / 2, IconSize, IconAlpha);
- DrawPlayerIcon (2, True, X + (IconSize + 1)*2, Y + (42 - IconSize) / 2, IconSize, IconAlpha);
- }
-
- LyricX := X + W/2 - Line.Width/2;
- LyricX2 := LyricX + Line.Width;
-
- // maybe center smaller lines
- //LyricY := Y;
- LyricY := Y + ((Size / Line.Size - 1) * LyricsHeight) / 2;
-
- Alpha := 1;
-
- // check if this line is active (at least its first note must be active)
- if (Beat >= Line.StartNote) then
- begin
- // if this line just got active, CurWord is -1,
- // this means we should try to make the first word active
- if (Line.CurWord = -1) then
- Line.CurWord := 0;
-
- // check if the current active word is still active.
- // Otherwise proceed to the next word if there is one in this line.
- // Note: the max. value of Line.CurWord is High(Line.Words)
- if (Line.CurWord < High(Line.Words)) and
- (Beat >= Line.Words[Line.CurWord + 1].Start) then
- begin
- Inc(Line.CurWord);
- end;
-
- FreestyleDiff := 0;
-
- // determine current and last word in this line.
- // If the end of the line is reached use the last word as current word.
- LastWord := @Line.Words[High(Line.Words)];
- CurWord := @Line.Words[Line.CurWord];
-
- // calc the progress of the lyrics effect
- Progress := (Beat - CurWord.Start) / CurWord.Length;
- if Progress >= 1 then
- Progress := 1;
- if Progress <= 0 then
- Progress := 0;
-
- // last word of this line finished, but this line did not hide -> fade out
- if Line.LastLine and
- (Beat > LastWord.Start + LastWord.Length) then
- begin
- Alpha := 1 - (Beat - (LastWord.Start + LastWord.Length)) / 15;
- if (Alpha < 0) then
- Alpha := 0;
- end;
-
- // determine the start-/end positions of the fragment of the current word
- CurWordStart := CurWord.X;
- CurWordEnd := CurWord.X + CurWord.Width;
-
- // Slide Effect
- // simply paint the active texture to the current position
- if Ini.LyricsEffect = 2 then
- begin
- CurWordStart := CurWordStart + CurWord.Width * Progress;
- CurWordEnd := CurWordStart;
- end;
-
- if CurWord.Freestyle then
- begin
- if (Line.CurWord < High(Line.Words)) and
- (not Line.Words[Line.CurWord + 1].Freestyle) then
- begin
- FreestyleDiff := 2;
- end
- else
- begin
- FreestyleDiff := 12;
- CurWordStart := CurWordStart - 1;
- CurWordEnd := CurWordEnd - 2;
- end;
- end;
-
- glEnable(GL_BLEND);
- glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
- glEnable(GL_TEXTURE_2D);
- glBindTexture(GL_TEXTURE_2D, Line.Tex);
-
- // draw sentence up to current word
- // type 0: simple lyric effect
- // type 3: ball lyric effect
- // type 4: shift lyric effect
- if (Ini.LyricsEffect in [0, 3, 4]) then
- // ball lyric effect - only highlight current word and not that ones before in this line
- glColorRGB(LineColor_en, Alpha)
- else
- glColorRGB(LineColor_act, Alpha);
-
- glBegin(GL_QUADS);
- glTexCoord2f(0, 1);
- glVertex2f(LyricX, LyricY);
-
- glTexCoord2f(0, 1-LyricsHeight/64);
- glVertex2f(LyricX, LyricY + LyricsHeight);
-
- glTexCoord2f(CurWordStart/1024, 1-LyricsHeight/64);
- glVertex2f(LyricX + CurWordStart, LyricY + LyricsHeight);
-
- glTexCoord2f((CurWordStart + FreestyleDiff)/1024, 1);
- glVertex2f(LyricX + CurWordStart + FreestyleDiff, LyricY);
- glEnd;
-
- // draw rest of sentence
- glColorRGB(LineColor_en, Alpha);
- glBegin(GL_QUADS);
- glTexCoord2f((CurWordEnd + FreestyleDiff)/1024, 1);
- glVertex2f(LyricX + CurWordEnd + FreestyleDiff, LyricY);
-
- glTexCoord2f(CurWordEnd/1024, 1-LyricsHeight/64);
- glVertex2f(LyricX + CurWordEnd, LyricY + LyricsHeight);
-
- glTexCoord2f(Line.Width/1024, 1-LyricsHeight/64);
- glVertex2f(LyricX2, LyricY + LyricsHeight);
-
- glTexCoord2f(Line.Width/1024, 1);
- glVertex2f(LyricX2, LyricY);
- glEnd;
-
- // draw active word:
- // type 0: simple lyric effect
- // type 3: ball lyric effect
- // type 4: shift lyric effect
- // only change the color of the current word
- if (Ini.LyricsEffect in [0, 3, 4]) then
- begin
- if (Ini.LyricsEffect = 4) then
- LyricY := LyricY - 8 * (1-Progress);
-
- glColor4f(LineColor_act.r, LineColor_act.g, LineColor_act.b, Alpha);
- glBegin(GL_QUADS);
- glTexCoord2f((CurWordStart + FreestyleDiff)/1024, 1);
- glVertex2f(LyricX + CurWordStart + FreestyleDiff, LyricY);
-
- glTexCoord2f(CurWordStart/1024, 0);
- glVertex2f(LyricX + CurWordStart, LyricY + 64);
-
- glTexCoord2f(CurWordEnd/1024, 0);
- glVertex2f(LyricX + CurWordEnd, LyricY + 64);
-
- glTexCoord2f((CurWordEnd + FreestyleDiff)/1024, 1);
- glVertex2f(LyricX + CurWordEnd + FreestyleDiff, LyricY);
- glEnd;
-
- if (Ini.LyricsEffect = 4) then
- LyricY := LyricY + 8 * (1-Progress);
- end
-
- // draw active word:
- // type 1: zoom lyric effect
- // change color and zoom current word
- else if Ini.LyricsEffect = 1 then
- begin
- glPushMatrix;
-
- glTranslatef(LyricX + CurWordStart + (CurWordEnd-CurWordStart)/2,
- LyricY + LyricsHeight/2, 0);
-
- // set current zoom factor
- glScalef(1.0 + (1-Progress) * 0.5, 1.0 + (1-Progress) * 0.5, 1.0);
-
- glColor4f(LineColor_act.r, LineColor_act.g, LineColor_act.b, Alpha);
- glBegin(GL_QUADS);
- glTexCoord2f((CurWordStart + FreestyleDiff)/1024, 1);
- glVertex2f(-(CurWordEnd-CurWordStart)/2 + FreestyleDiff, -LyricsHeight/2);
-
- glTexCoord2f(CurWordStart/1024, 1-LyricsHeight/64);
- glVertex2f(-(CurWordEnd-CurWordStart)/2, LyricsHeight/2);
-
- glTexCoord2f(CurWordEnd/1024, 1-LyricsHeight/64);
- glVertex2f((CurWordEnd-CurWordStart)/2, LyricsHeight/2);
-
- glTexCoord2f((CurWordEnd + FreestyleDiff)/1024, 1);
- glVertex2f((CurWordEnd-CurWordStart)/2 + FreestyleDiff, -LyricsHeight/2);
- glEnd;
-
- glPopMatrix;
- end;
-
- glDisable(GL_TEXTURE_2D);
- glDisable(GL_BLEND);
-
- // type 3: ball lyric effect
- if Ini.LyricsEffect = 3 then
- begin
- DrawBall(LyricX + CurWordStart + (CurWordEnd-CurWordStart) * Progress,
- LyricY - 15 - 15*sin(Progress * Pi), Alpha);
- end;
- end
- else
- begin
- // this section is called if the whole line can be drawn at once and no
- // word has to be emphasized.
-
- glEnable(GL_TEXTURE_2D);
- glEnable(GL_BLEND);
- glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
- glBindTexture(GL_TEXTURE_2D, Line.Tex);
-
- // enable the upper, disable the lower line
- if (Line = UpperLine) then
- glColorRGB(LineColor_en)
- else
- glColorRGB(LineColor_dis);
-
- glBegin(GL_QUADS);
- glTexCoord2f(0, 1);
- glVertex2f(LyricX, LyricY);
-
- glTexCoord2f(0, 1-LyricsHeight/64);
- glVertex2f(LyricX, LyricY + LyricsHeight);
-
- glTexCoord2f(Line.Width/1024, 1-LyricsHeight/64);
- glVertex2f(LyricX2, LyricY + LyricsHeight);
-
- glTexCoord2f(Line.Width/1024, 1);
- glVertex2f(LyricX2, LyricY);
- glEnd;
-
- glDisable(GL_BLEND);
- glDisable(GL_TEXTURE_2D);
- end;
-end;
-
-//---------------
-// GetUpperLine() - Returns a reference to the upper line
-//---------------
-function TLyricEngine.GetUpperLine(): TLyricLine;
-begin
- Result := UpperLine;
-end;
-
-//---------------
-// GetLowerLine() - Returns a reference to the lower line
-//---------------
-function TLyricEngine.GetLowerLine(): TLyricLine;
-begin
- Result := LowerLine;
-end;
-
-//---------------
-// GetUpperLineIndex() - Returns the index of the upper line
-//---------------
-function TLyricEngine.GetUpperLineIndex(): Integer;
-const
- QUEUE_SIZE = 3;
-begin
- // no line in queue
- if (LineCounter <= 0) then
- Result := -1
- // no line has been removed from queue yet
- else if (LineCounter <= QUEUE_SIZE) then
- Result := 0
- // lines have been removed from queue already
- else
- Result := LineCounter - QUEUE_SIZE;
-end;
-
-end.
-
diff --git a/src/classes/UMain.pas b/src/classes/UMain.pas
deleted file mode 100644
index 5dacd5f8..00000000
--- a/src/classes/UMain.pas
+++ /dev/null
@@ -1,1107 +0,0 @@
-unit UMain;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses
- SysUtils,
- Classes,
- SDL,
- UMusic,
- URecord,
- UTime,
- UDisplay,
- UIni,
- ULog,
- ULyrics,
- UScreenSing,
- USong,
- gl;
-
-type
- PPLayerNote = ^TPlayerNote;
- TPlayerNote = record
- Start: integer;
- Length: integer;
- Detect: real; // accurate place, detected in the note
- Tone: real;
- Perfect: boolean; // true if the note matches the original one, lit the star
- Hit: boolean; // true if the note Hits the Line
- end;
-
- PPLayer = ^TPlayer;
- TPlayer = record
- Name: string;
-
- // Index in Teaminfo record
- TeamID: Byte;
- PlayerID: Byte;
-
- // Scores
- Score: real;
- ScoreLine: real;
- ScoreGolden: real;
-
- ScoreInt: integer;
- ScoreLineInt: integer;
- ScoreGoldenInt: integer;
- ScoreTotalInt: integer;
-
- // LineBonus
- ScoreLast: Real;//Last Line Score
-
- // PerfectLineTwinkle (effect)
- LastSentencePerfect: Boolean;
-
- HighNote: integer; // index of last note (= High(Note)?)
- LengthNote: integer; // number of notes (= Length(Note)?).
- Note: array of TPlayerNote;
- end;
-
-
-var
- // Absolute Paths
- GamePath: string;
- SoundPath: string;
- SongPaths: TStringList;
- LogPath: string;
- ThemePath: string;
- SkinsPath: string;
- ScreenshotsPath: string;
- CoverPaths: TStringList;
- LanguagesPath: string;
- PluginPath: string;
- VisualsPath: string;
- ResourcesPath: string;
- PlayListPath: string;
-
- Done: Boolean;
- Event: TSDL_event;
- // FIXME: ConversionFileName should not be global
- ConversionFileName: string;
- Restart: boolean;
-
- // player and music info
- Player: array of TPlayer;
- PlayersPlay: integer;
-
- CurrentSong : TSong;
-
-const
- MAX_SONG_SCORE = 10000; // max. achievable points per song
- MAX_SONG_LINE_BONUS = 1000; // max. achievable line bonus per song
-
-function FindPath(out PathResult: string; const RequestedPath: string; NeedsWritePermission: boolean): boolean;
-procedure InitializePaths;
-procedure AddSongPath(const Path: string);
-
-Procedure Main;
-procedure MainLoop;
-procedure CheckEvents;
-procedure Sing(Screen: TScreenSing);
-procedure NewSentence(Screen: TScreenSing);
-procedure NewBeatClick(Screen: TScreenSing); // executed when on then new beat for click
-procedure NewBeatDetect(Screen: TScreenSing); // executed when on then new beat for detection
-procedure NewNote(Screen: TScreenSing); // detect note
-function GetMidBeat(Time: real): real;
-function GetTimeFromBeat(Beat: integer): real;
-procedure ClearScores(PlayerNum: integer);
-
-implementation
-
-uses
- Math,
- StrUtils,
- USongs,
- UJoystick,
- UCommandLine,
- ULanguage,
- //SDL_ttf,
- USkins,
- UCovers,
- UCatCovers,
- UDataBase,
- UPlaylist,
- UDLLManager,
- UParty,
- UConfig,
- UCore,
- UCommon,
- UGraphic,
- UGraphicClasses,
- UPluginDefs,
- UPlatform,
- UThemes;
-
-
-
-
-procedure Main;
-var
- WndTitle: string;
-begin
- try
- WndTitle := USDXVersionStr;
-
- Platform.Init;
-
- if Platform.TerminateIfAlreadyRunning(WndTitle) then
- Exit;
-
- // fix floating-point exceptions (FPE)
- DisableFloatingPointExceptions();
- // fix the locale for string-to-float parsing in C-libs
- SetDefaultNumericLocale();
-
- // setup separators for parsing
- // Note: ThousandSeparator must be set because of a bug in TIniFile.ReadFloat
- ThousandSeparator := ',';
- DecimalSeparator := '.';
-
- //------------------------------
- //StartUp - Create Classes and Load Files
- //------------------------------
-
- // Initialize SDL
- // Without SDL_INIT_TIMER SDL_GetTicks() might return strange values
- SDL_Init(SDL_INIT_VIDEO or SDL_INIT_TIMER);
- SDL_EnableUnicode(1);
-
- USTime := TTime.Create;
- VideoBGTimer := TRelativeTimer.Create;
-
- // Commandline Parameter Parser
- Params := TCMDParams.Create;
-
- // Log + Benchmark
- Log := TLog.Create;
- Log.Title := WndTitle;
- Log.FileOutputEnabled := not Params.NoLog;
- Log.BenchmarkStart(0);
-
- // Language
- Log.BenchmarkStart(1);
- Log.LogStatus('Initialize Paths', 'Initialization');
- InitializePaths;
- Log.LogStatus('Load Language', 'Initialization');
- Language := TLanguage.Create;
-
- // Add Const Values:
- Language.AddConst('US_VERSION', USDXVersionStr);
- Log.BenchmarkEnd(1);
- Log.LogBenchmark('Loading Language', 1);
-
- {
- // SDL_ttf (Not used yet, maybe in version 1.5)
- Log.BenchmarkStart(1);
- Log.LogStatus('Initialize SDL_ttf', 'Initialization');
- TTF_Init();
- Log.BenchmarkEnd(1);
- Log.LogBenchmark('Initializing SDL_ttf', 1);
- }
-
- // Skin
- Log.BenchmarkStart(1);
- Log.LogStatus('Loading Skin List', 'Initialization');
- Skin := TSkin.Create;
- Log.BenchmarkEnd(1);
- Log.LogBenchmark('Loading Skin List', 1);
-
- // Ini + Paths
- Log.BenchmarkStart(1);
- Log.LogStatus('Load Ini', 'Initialization');
- Ini := TIni.Create;
- Ini.Load;
-
- //it's possible that this is the first run, create a .ini file if neccessary
- Log.LogStatus('Write Ini', 'Initialization');
- Ini.Save;
-
- // Load Languagefile
- if (Params.Language <> -1) then
- Language.ChangeLanguage(ILanguage[Params.Language])
- else
- Language.ChangeLanguage(ILanguage[Ini.Language]);
-
- Log.BenchmarkEnd(1);
- Log.LogBenchmark('Loading Ini', 1);
-
- // Sound
- Log.BenchmarkStart(1);
- Log.LogStatus('Initialize Sound', 'Initialization');
- InitializeSound();
- Log.BenchmarkEnd(1);
- Log.LogBenchmark('Initializing Sound', 1);
-
- // Lyrics-engine with media reference timer
- LyricsState := TLyricsState.Create();
-
- // Theme
- Log.BenchmarkStart(1);
- Log.LogStatus('Load Themes', 'Initialization');
- Theme := TTheme.Create(ThemePath + ITheme[Ini.Theme] + '.ini', Ini.Color);
- Log.BenchmarkEnd(1);
- Log.LogBenchmark('Loading Themes', 1);
-
- // Covers Cache
- Log.BenchmarkStart(1);
- Log.LogStatus('Creating Covers Cache', 'Initialization');
- Covers := TCoverDatabase.Create;
- Log.LogBenchmark('Loading Covers Cache Array', 1);
- Log.BenchmarkStart(1);
-
- // Category Covers
- Log.BenchmarkStart(1);
- Log.LogStatus('Creating Category Covers Array', 'Initialization');
- CatCovers:= TCatCovers.Create;
- Log.BenchmarkEnd(1);
- Log.LogBenchmark('Loading Category Covers Array', 1);
-
- // Songs
- //Log.BenchmarkStart(1);
- Log.LogStatus('Creating Song Array', 'Initialization');
- Songs := TSongs.Create;
- //Songs.LoadSongList;
-
- Log.LogStatus('Creating 2nd Song Array', 'Initialization');
- CatSongs := TCatSongs.Create;
-
- Log.BenchmarkEnd(1);
- Log.LogBenchmark('Loading Songs', 1);
-
- // PluginManager
- Log.BenchmarkStart(1);
- Log.LogStatus('PluginManager', 'Initialization');
- DLLMan := TDLLMan.Create; // Load PluginList
- Log.BenchmarkEnd(1);
- Log.LogBenchmark('Loading PluginManager', 1);
-
- {// Party Mode Manager
- Log.BenchmarkStart(1);
- Log.LogStatus('PartySession Manager', 'Initialization');
- PartySession := TPartySession.Create; //Load PartySession
-
- Log.BenchmarkEnd(1);
- Log.LogBenchmark('Loading PartySession Manager', 1); }
-
- // Graphics
- Log.BenchmarkStart(1);
- Log.LogStatus('Initialize 3D', 'Initialization');
- Initialize3D(WndTitle);
- Log.BenchmarkEnd(1);
- Log.LogBenchmark('Initializing 3D', 1);
-
- // Score Saving System
- Log.BenchmarkStart(1);
- Log.LogStatus('DataBase System', 'Initialization');
- DataBase := TDataBaseSystem.Create;
-
- if (Params.ScoreFile = '') then
- DataBase.Init (Platform.GetGameUserPath + 'Ultrastar.db')
- else
- DataBase.Init (Params.ScoreFile);
-
- Log.BenchmarkEnd(1);
- Log.LogBenchmark('Loading DataBase System', 1);
-
- // Playlist Manager
- Log.BenchmarkStart(1);
- Log.LogStatus('Playlist Manager', 'Initialization');
- PlaylistMan := TPlaylistManager.Create;
- Log.BenchmarkEnd(1);
- Log.LogBenchmark('Loading Playlist Manager', 1);
-
- // GoldenStarsTwinkleMod
- Log.BenchmarkStart(1);
- Log.LogStatus('Effect Manager', 'Initialization');
- GoldenRec := TEffectManager.Create;
- Log.BenchmarkEnd(1);
- Log.LogBenchmark('Loading Particle System', 1);
-
- // Joypad
- if (Ini.Joypad = 1) OR (Params.Joypad) then
- begin
- Log.BenchmarkStart(1);
- Log.LogStatus('Initialize Joystick', 'Initialization');
- Joy := TJoy.Create;
- Log.BenchmarkEnd(1);
- Log.LogBenchmark('Initializing Joystick', 1);
- end;
-
- Log.BenchmarkEnd(0);
- Log.LogBenchmark('Loading Time', 0);
-
- Log.LogStatus('Creating Core', 'Initialization');
- {Core := TCore.Create(
- USDXShortVersionStr,
- MakeVersion(USDX_VERSION_MAJOR,
- USDX_VERSION_MINOR,
- USDX_VERSION_RELEASE,
- chr(0))
- ); }
-
- Log.LogStatus('Running Core', 'Initialization');
- //Core.Run;
-
- //------------------------------
- //Start- Mainloop
- //------------------------------
- Log.LogStatus('Main Loop', 'Initialization');
- MainLoop;
-
- finally
- //------------------------------
- //Finish Application
- //------------------------------
-
- // TODO:
- // call an uninitialize routine for every initialize step
- // or at least use the corresponding Free-Methods
-
- FinalizeMedia();
-
- //TTF_Quit();
- SDL_Quit();
-
- if assigned(Log) then
- begin
- Log.LogStatus('Main Loop', 'Finished');
- Log.Free;
- end;
- end;
-end;
-
-procedure MainLoop;
-var
- Delay: integer;
-const
- MAX_FPS = 100;
-begin
- Delay := 0;
- SDL_EnableKeyRepeat(125, 125);
-
- CountSkipTime(); // JB - for some reason this seems to be needed when we use the SDL Timer functions.
- while not Done do
- begin
- // joypad
- if (Ini.Joypad = 1) or (Params.Joypad) then
- Joy.Update;
-
- // keyboard events
- CheckEvents;
-
- // display
- done := not Display.Draw;
- SwapBuffers;
-
- // delay
- CountMidTime;
-
- Delay := Floor(1000 / MAX_FPS - 1000 * TimeMid);
-
- if Delay >= 1 then
- SDL_Delay(Delay); // dynamic, maximum is 100 fps
-
- CountSkipTime;
-
- // reinitialization of graphics
- if Restart then
- begin
- Reinitialize3D;
- Restart := false;
- end;
-
- end;
-End;
-
-procedure CheckEvents;
-begin
- if Assigned(Display.NextScreen) then
- Exit;
-
- while SDL_PollEvent( @event ) = 1 do
- begin
- case Event.type_ of
- SDL_QUITEV:
- begin
- Display.Fade := 0;
- Display.NextScreenWithCheck := nil;
- Display.CheckOK := True;
- end;
- {
- SDL_MOUSEBUTTONDOWN:
- with Event.button Do
- begin
- if State = SDL_BUTTON_LEFT Then
- begin
- //
- end;
- end;
- }
- SDL_VIDEORESIZE:
- begin
- ScreenW := Event.resize.w;
- ScreenH := Event.resize.h;
- // Note: do NOT call SDL_SetVideoMode on Windows and MacOSX here.
- // This would create a new OpenGL render-context and all texture data
- // would be invalidated.
- // On Linux the mode MUST be resetted, otherwise graphics will be corrupted.
- {$IFDEF LINUX}
- if boolean( Ini.FullScreen ) then
- SDL_SetVideoMode(ScreenW, ScreenH, (Ini.Depth+1) * 16, SDL_OPENGL or SDL_FULLSCREEN)
- else
- SDL_SetVideoMode(ScreenW, ScreenH, (Ini.Depth+1) * 16, SDL_OPENGL or SDL_RESIZABLE);
- {$ENDIF}
- end;
- SDL_KEYDOWN:
- begin
- // remap the "keypad enter" key to the "standard enter" key
- if (Event.key.keysym.sym = SDLK_KP_ENTER) then
- Event.key.keysym.sym := SDLK_RETURN;
-
- if (Event.key.keysym.sym = SDLK_F11) or
- ((Event.key.keysym.sym = SDLK_RETURN) and
- ((Event.key.keysym.modifier and KMOD_ALT) <> 0)) then // toggle full screen
- begin
- Ini.FullScreen := integer( not boolean( Ini.FullScreen ) );
-
- // FIXME: SDL_SetVideoMode creates a new OpenGL RC so we have to
- // reload all texture data (-> whitescreen bug).
- // Only Linux is able to handle screen-switching this way.
- {$IFDEF LINUX}
- if boolean( Ini.FullScreen ) then
- begin
- SDL_SetVideoMode(ScreenW, ScreenH, (Ini.Depth+1) * 16, SDL_OPENGL or SDL_FULLSCREEN);
- SDL_ShowCursor(0);
- end
- else
- begin
- SDL_SetVideoMode(ScreenW, ScreenH, (Ini.Depth+1) * 16, SDL_OPENGL or SDL_RESIZABLE);
- SDL_ShowCursor(1);
- end;
-
- glViewPort(0, 0, ScreenW, ScreenH);
- {$ENDIF}
- end
- // if print is pressed -> make screenshot and save to screenshot path
- else if (Event.key.keysym.sym = SDLK_SYSREQ) or (Event.key.keysym.sym = SDLK_PRINT) then
- Display.SaveScreenShot
- // if there is a visible popup then let it handle input instead of underlying screen
- // shoud be done in a way to be sure the topmost popup has preference (maybe error, then check)
- else if (ScreenPopupError <> nil) and (ScreenPopupError.Visible) then
- done := not ScreenPopupError.ParseInput(Event.key.keysym.sym, WideChar(Event.key.keysym.unicode), True)
- else if (ScreenPopupCheck <> nil) and (ScreenPopupCheck.Visible) then
- done := not ScreenPopupCheck.ParseInput(Event.key.keysym.sym, WideChar(Event.key.keysym.unicode), True)
- else
- begin
- // check if screen wants to exit
- done := not Display.CurrentScreen^.ParseInput(Event.key.keysym.sym, WideChar(Event.key.keysym.unicode), True);
-
- // if screen wants to exit
- if done then
- begin
- // if question option is enabled then show exit popup
- if (Ini.AskbeforeDel = 1) then
- begin
- Display.CurrentScreen^.CheckFadeTo(nil,'MSG_QUIT_USDX');
- end
- else // if ask-for-exit is disabled then simply exit
- begin
- Display.Fade := 0;
- Display.NextScreenWithCheck := nil;
- Display.CheckOK := True;
- end;
- end;
-
- end;
- end;
- SDL_JOYAXISMOTION:
- begin
- // not implemented
- end;
- SDL_JOYBUTTONDOWN:
- begin
- // not implemented
- end;
- end; // case
- end; // while
-end;
-
-function GetTimeForBeats(BPM, Beats: real): real;
-begin
- Result := 60 / BPM * Beats;
-end;
-
-function GetBeats(BPM, msTime: real): real;
-begin
- Result := BPM * msTime / 60;
-end;
-
-procedure GetMidBeatSub(BPMNum: integer; var Time: real; var CurBeat: real);
-var
- NewTime: real;
-begin
- if High(CurrentSong.BPM) = BPMNum then
- begin
- // last BPM
- CurBeat := CurrentSong.BPM[BPMNum].StartBeat + GetBeats(CurrentSong.BPM[BPMNum].BPM, Time);
- Time := 0;
- end
- else
- begin
- // not last BPM
- // count how much time is it for start of the new BPM and store it in NewTime
- NewTime := GetTimeForBeats(CurrentSong.BPM[BPMNum].BPM, CurrentSong.BPM[BPMNum+1].StartBeat - CurrentSong.BPM[BPMNum].StartBeat);
-
- // compare it to remaining time
- if (Time - NewTime) > 0 then
- begin
- // there is still remaining time
- CurBeat := CurrentSong.BPM[BPMNum].StartBeat;
- Time := Time - NewTime;
- end
- else
- begin
- // there is no remaining time
- CurBeat := CurrentSong.BPM[BPMNum].StartBeat + GetBeats(CurrentSong.BPM[BPMNum].BPM, Time);
- Time := 0;
- end; // if
- end; // if
-end;
-
-function GetMidBeat(Time: real): real;
-var
- CurBeat: real;
- CurBPM: integer;
-begin
- // static BPM
- if Length(CurrentSong.BPM) = 1 then
- begin
- Result := Time * CurrentSong.BPM[0].BPM / 60;
- end
- // variable BPM
- else if Length(CurrentSong.BPM) > 1 then
- begin
- CurBeat := 0;
- CurBPM := 0;
- while (Time > 0) do
- begin
- GetMidBeatSub(CurBPM, Time, CurBeat);
- Inc(CurBPM);
- end;
-
- Result := CurBeat;
- end
- // invalid BPM
- else
- begin
- Result := 0;
- end;
-end;
-
-function GetTimeFromBeat(Beat: integer): real;
-var
- CurBPM: integer;
-begin
- // static BPM
- if Length(CurrentSong.BPM) = 1 then
- begin
- Result := CurrentSong.GAP / 1000 + Beat * 60 / CurrentSong.BPM[0].BPM;
- end
- // variable BPM
- else if Length(CurrentSong.BPM) > 1 then
- begin
- Result := CurrentSong.GAP / 1000;
- CurBPM := 0;
- while (CurBPM <= High(CurrentSong.BPM)) and
- (Beat > CurrentSong.BPM[CurBPM].StartBeat) do
- begin
- if (CurBPM < High(CurrentSong.BPM)) and
- (Beat >= CurrentSong.BPM[CurBPM+1].StartBeat) then
- begin
- // full range
- Result := Result + (60 / CurrentSong.BPM[CurBPM].BPM) *
- (CurrentSong.BPM[CurBPM+1].StartBeat - CurrentSong.BPM[CurBPM].StartBeat);
- end;
-
- if (CurBPM = High(CurrentSong.BPM)) or
- (Beat < CurrentSong.BPM[CurBPM+1].StartBeat) then
- begin
- // in the middle
- Result := Result + (60 / CurrentSong.BPM[CurBPM].BPM) *
- (Beat - CurrentSong.BPM[CurBPM].StartBeat);
- end;
- Inc(CurBPM);
- end;
-
- {
- while (Time > 0) do
- begin
- GetMidBeatSub(CurBPM, Time, CurBeat);
- Inc(CurBPM);
- end;
- }
- end
- // invalid BPM
- else
- begin
- Result := 0;
- end;
-end;
-
-procedure Sing(Screen: TScreenSing);
-var
- Count: integer;
- CountGr: integer;
- CP: integer;
- Done: real;
- N: integer;
- CurLine: PLine;
- CurNote: PLineFragment;
-begin
- LyricsState.UpdateBeats();
-
- // sentences routines
- for CountGr := 0 to 0 do //High(Lines)
- begin;
- CP := CountGr;
- // old parts
- LyricsState.OldLine := Lines[CP].Current;
-
- // choose current parts
- for Count := 0 to Lines[CP].High do
- begin
- if LyricsState.CurrentBeat >= Lines[CP].Line[Count].Start then
- Lines[CP].Current := Count;
- end;
-
- // clean player note if there is a new line
- // (optimization on halfbeat time)
- if Lines[CP].Current <> LyricsState.OldLine then
- NewSentence(Screen);
-
- end; // for CountGr
-
- // make some operations on clicks
- if {(LyricsState.CurrentBeatC >= 0) and }(LyricsState.OldBeatC <> LyricsState.CurrentBeatC) then
- NewBeatClick(Screen);
-
- // make some operations when detecting new voice pitch
- if (LyricsState.CurrentBeatD >= 0) and (LyricsState.OldBeatD <> LyricsState.CurrentBeatD) then
- NewBeatDetect(Screen);
-
- CurLine := @Lines[0].Line[Lines[0].Current];
-
- // remove moving text
- Done := 1;
- for N := 0 to CurLine.HighNote do
- begin
- CurNote := @CurLine.Note[N];
- if (CurNote.Start <= LyricsState.MidBeat) and
- (CurNote.Start + CurNote.Length >= LyricsState.MidBeat) then
- begin
- Done := (LyricsState.MidBeat - CurNote.Start) / CurNote.Length;
- end;
- end;
-end;
-
-procedure NewSentence(Screen: TScreenSing);
-var
- i: Integer;
-begin
- // clean note of player
- for i := 0 to High(Player) do
- begin
- Player[i].LengthNote := 0;
- Player[i].HighNote := -1;
- SetLength(Player[i].Note, 0);
- end;
-
- // on sentence change...
- Screen.onSentenceChange(Lines[0].Current);
-end;
-
-procedure NewBeatClick;
-var
- Count: integer;
-begin
- // beat click
- if ((Ini.BeatClick = 1) and
- ((LyricsState.CurrentBeatC + Lines[0].Resolution + Lines[0].NotesGAP) mod Lines[0].Resolution = 0)) then
- begin
- AudioPlayback.PlaySound(SoundLib.Click);
- end;
-
- for Count := 0 to Lines[0].Line[Lines[0].Current].HighNote do
- begin
- if (Lines[0].Line[Lines[0].Current].Note[Count].Start = LyricsState.CurrentBeatC) then
- begin
- // click assist
- if Ini.ClickAssist = 1 then
- AudioPlayback.PlaySound(SoundLib.Click);
-
- // drum machine
- (*
- TempBeat := LyricsState.CurrentBeat;// + 2;
- if (TempBeat mod 8 = 0) then Music.PlayDrum;
- if (TempBeat mod 8 = 4) then Music.PlayClap;
- //if (TempBeat mod 4 = 2) then Music.PlayHihat;
- if (TempBeat mod 4 <> 0) then Music.PlayHihat;
- *)
- end;
- end;
-end;
-
-procedure NewBeatDetect(Screen: TScreenSing);
-begin
- NewNote(Screen);
-end;
-
-procedure NewNote(Screen: TScreenSing);
-var
- LineFragmentIndex: integer;
- CurrentLineFragment: PLineFragment;
- PlayerIndex: integer;
- CurrentSound: TCaptureBuffer;
- CurrentPlayer: PPlayer;
- LastPlayerNote: PPLayerNote;
- Line: PLine;
- SentenceIndex: integer;
- SentenceMin: integer;
- SentenceMax: integer;
- SentenceDetected: integer; // sentence of detected note
- NoteAvailable: boolean;
- NewNote: boolean;
- Range: integer;
- NoteHit: boolean;
- MaxSongPoints: integer; // max. points for the song (without line bonus)
- MaxLinePoints: Real; // max. points for the current line
-begin
- // TODO: add duet mode support
- // use Lines[LineSetIndex] with LineSetIndex depending on the current player
-
- // count min and max sentence range for checking (detection is delayed to the notes we see on the screen)
- SentenceMin := Lines[0].Current-1;
- if (SentenceMin < 0) then
- SentenceMin := 0;
- SentenceMax := Lines[0].Current;
-
- // check for an active note at the current time defined in the lyrics
- NoteAvailable := false;
- SentenceDetected := SentenceMin;
- for SentenceIndex := SentenceMin to SentenceMax do
- begin
- Line := @Lines[0].Line[SentenceIndex];
- for LineFragmentIndex := 0 to Line.HighNote do
- begin
- CurrentLineFragment := @Line.Note[LineFragmentIndex];
- // check if line is active
- if ((CurrentLineFragment.Start <= LyricsState.CurrentBeatD) and
- (CurrentLineFragment.Start + CurrentLineFragment.Length-1 >= LyricsState.CurrentBeatD)) and
- (CurrentLineFragment.NoteType <> ntFreestyle) and // but ignore FreeStyle notes
- (CurrentLineFragment.Length > 0) then // and make sure the note lengths is at least 1
- begin
- SentenceDetected := SentenceIndex;
- NoteAvailable := true;
- Break;
- end;
- end;
- // TODO: break here, if NoteAvailable is true? We would then use the first instead
- // of the last note matching the current beat if notes overlap. But notes
- // should not overlap at all.
- //if (NoteAvailable) then
- // Break;
- end;
-
- // analyze player signals
- for PlayerIndex := 0 to PlayersPlay-1 do
- begin
- CurrentPlayer := @Player[PlayerIndex];
- CurrentSound := AudioInputProcessor.Sound[PlayerIndex];
- LastPlayerNote := @CurrentPlayer.Note[CurrentPlayer.HighNote];
-
- // analyze buffer
- CurrentSound.AnalyzeBuffer;
-
- // add some noise
- // TODO: do we need this?
- //LyricsState.Tone := LyricsState.Tone + Round(Random(3)) - 1;
-
- // add note if possible
- if (CurrentSound.ToneValid and NoteAvailable) then
- begin
- Line := @Lines[0].Line[SentenceDetected];
-
- // process until last note
- for LineFragmentIndex := 0 to Line.HighNote do
- begin
- CurrentLineFragment := @Line.Note[LineFragmentIndex];
- if (CurrentLineFragment.Start <= LyricsState.OldBeatD+1) and
- (CurrentLineFragment.Start + CurrentLineFragment.Length > LyricsState.OldBeatD+1) then
- begin
- // compare notes (from song-file and from player)
-
- // move players tone to proper octave
- while (CurrentSound.Tone - CurrentLineFragment.Tone > 6) do
- CurrentSound.Tone := CurrentSound.Tone - 12;
-
- while (CurrentSound.Tone - CurrentLineFragment.Tone < -6) do
- CurrentSound.Tone := CurrentSound.Tone + 12;
-
- // half size notes patch
- NoteHit := false;
-
- //if Ini.Difficulty = 0 then Range := 2;
- //if Ini.Difficulty = 1 then Range := 1;
- //if Ini.Difficulty = 2 then Range := 0;
- Range := 2 - Ini.Difficulty;
-
- // check if the player hit the correct tone within the tolerated range
- if (Abs(CurrentLineFragment.Tone - CurrentSound.Tone) <= Range) then
- begin
- // adjust the players tone to the correct one
- // TODO: do we need to do this?
- CurrentSound.Tone := CurrentLineFragment.Tone;
-
- // half size notes patch
- NoteHit := true;
-
- if (Ini.LineBonus > 0) then
- MaxSongPoints := MAX_SONG_SCORE - MAX_SONG_LINE_BONUS
- else
- MaxSongPoints := MAX_SONG_SCORE;
-
- // Note: ScoreValue is the sum of all note values of the song
- MaxLinePoints := MaxSongPoints / Lines[0].ScoreValue;
-
- // FIXME: is this correct? Why do we add the points for a whole line
- // if just one note is correct?
- case CurrentLineFragment.NoteType of
- ntNormal: CurrentPlayer.Score := CurrentPlayer.Score + MaxLinePoints;
- ntGolden: CurrentPlayer.ScoreGolden := CurrentPlayer.ScoreGolden + MaxLinePoints;
- end;
-
- CurrentPlayer.ScoreInt := Floor(CurrentPlayer.Score / 10) * 10;
- CurrentPlayer.ScoreGoldenInt := Floor(CurrentPlayer.ScoreGolden / 10) * 10;
-
- CurrentPlayer.ScoreTotalInt := CurrentPlayer.ScoreInt +
- CurrentPlayer.ScoreGoldenInt +
- CurrentPlayer.ScoreLineInt;
- end;
-
- end; // operation
- end; // for
-
- // check if we have to add a new note or extend the note's length
- if (SentenceDetected = SentenceMax) then
- begin
- // we will add a new note
- NewNote := true;
- // if last has the same tone
- if ((CurrentPlayer.LengthNote > 0) and
- (LastPlayerNote.Tone = CurrentSound.Tone) and
- ((LastPlayerNote.Start + LastPlayerNote.Length) = LyricsState.CurrentBeatD)) then
- begin
- NewNote := false;
- end;
-
- // if is not as new note to control
- for LineFragmentIndex := 0 to Line.HighNote do
- begin
- if (Line.Note[LineFragmentIndex].Start = LyricsState.CurrentBeatD) then
- NewNote := true;
- end;
-
- // add new note
- if NewNote then
- begin
- // new note
- Inc(CurrentPlayer.LengthNote);
- Inc(CurrentPlayer.HighNote);
- SetLength(CurrentPlayer.Note, CurrentPlayer.LengthNote);
-
- // update player's last note
- LastPlayerNote := @CurrentPlayer.Note[CurrentPlayer.HighNote];
- with LastPlayerNote^ do
- begin
- Start := LyricsState.CurrentBeatD;
- Length := 1;
- Tone := CurrentSound.Tone; // Tone || ToneAbs
- Detect := LyricsState.MidBeat;
- Hit := NoteHit; // half note patch
- end;
- end
- else
- begin
- // extend note length
- Inc(LastPlayerNote.Length);
- end;
-
- // check for perfect note and then lit the star (on Draw)
- for LineFragmentIndex := 0 to Line.HighNote do
- begin
- CurrentLineFragment := @Line.Note[LineFragmentIndex];
- if (CurrentLineFragment.Start = LastPlayerNote.Start) and
- (CurrentLineFragment.Length = LastPlayerNote.Length) and
- (CurrentLineFragment.Tone = LastPlayerNote.Tone) then
- begin
- LastPlayerNote.Perfect := true;
- end;
- end;
- end; // if SentenceDetected = SentenceMax
-
- end; // if Detected
- end; // for PlayerIndex
-
- //Log.LogStatus('EndBeat', 'NewBeat');
-
- // on sentence end -> for LineBonus and display of SingBar (rating pop-up)
- if (SentenceDetected >= Low(Lines[0].Line)) and
- (SentenceDetected <= High(Lines[0].Line)) then
- begin
- Line := @Lines[0].Line[SentenceDetected];
- CurrentLineFragment := @Line.Note[Line.HighNote];
- if ((CurrentLineFragment.Start + CurrentLineFragment.Length - 1) = LyricsState.CurrentBeatD) then
- begin
- if assigned(Screen) then
- Screen.OnSentenceEnd(SentenceDetected);
- end;
- end;
-
-end;
-
-procedure ClearScores(PlayerNum: integer);
-begin
- with Player[PlayerNum] do
- begin
- Score := 0;
- ScoreInt := 0;
- ScoreLine := 0;
- ScoreLineInt := 0;
- ScoreGolden := 0;
- ScoreGoldenInt := 0;
- ScoreTotalInt := 0;
- end;
-end;
-
-procedure AddSpecialPath(var PathList: TStringList; const Path: string);
-var
- I: integer;
- PathAbs, OldPathAbs: string;
-begin
- if (PathList = nil) then
- PathList := TStringList.Create;
-
- if (Path = '') or not DirectoryExists(Path) then
- Exit;
-
- PathAbs := IncludeTrailingPathDelimiter(ExpandFileName(Path));
-
- // check if path or a part of the path was already added
- for I := 0 to PathList.Count-1 do
- begin
- OldPathAbs := IncludeTrailingPathDelimiter(ExpandFileName(PathList[I]));
- // check if the new directory is a sub-directory of a previously added one.
- // This is also true, if both paths point to the same directories.
- if (AnsiStartsText(OldPathAbs, PathAbs)) then
- begin
- // ignore the new path
- Exit;
- end;
-
- // check if a previously added directory is a sub-directory of the new one.
- if (AnsiStartsText(PathAbs, OldPathAbs)) then
- begin
- // replace the old with the new one.
- PathList[I] := PathAbs;
- Exit;
- end;
- end;
-
- PathList.Add(PathAbs);
-end;
-
-procedure AddSongPath(const Path: string);
-begin
- AddSpecialPath(SongPaths, Path);
-end;
-
-procedure AddCoverPath(const Path: string);
-begin
- AddSpecialPath(CoverPaths, Path);
-end;
-
-(**
- * Initialize a path variable
- * After setting paths, make sure that paths exist
- *)
-function FindPath(out PathResult: string; const RequestedPath: string; NeedsWritePermission: boolean): boolean;
-begin
- Result := false;
-
- if (RequestedPath = '') then
- Exit;
-
- // Make sure the directory exists
- if (not ForceDirectories(RequestedPath)) then
- begin
- PathResult := '';
- Exit;
- end;
-
- PathResult := IncludeTrailingPathDelimiter(RequestedPath);
-
- if (NeedsWritePermission) and
- (FileIsReadOnly(RequestedPath)) then
- begin
- Exit;
- end;
-
- Result := true;
-end;
-
-(**
- * Function sets all absolute paths e.g. song path and makes sure the directorys exist
- *)
-procedure InitializePaths;
-begin
- // Log directory (must be writable)
- if (not FindPath(LogPath, Platform.GetLogPath, true)) then
- begin
- Log.FileOutputEnabled := false;
- Log.LogWarn('Log directory "'+ Platform.GetLogPath +'" not available', 'InitializePaths');
- end;
-
- FindPath(SoundPath, Platform.GetGameSharedPath + 'sounds', false);
- FindPath(ThemePath, Platform.GetGameSharedPath + 'themes', false);
- FindPath(SkinsPath, Platform.GetGameSharedPath + 'themes', false);
- FindPath(LanguagesPath, Platform.GetGameSharedPath + 'languages', false);
- FindPath(PluginPath, Platform.GetGameSharedPath + 'plugins', false);
- FindPath(VisualsPath, Platform.GetGameSharedPath + 'visuals', false);
- FindPath(ResourcesPath, Platform.GetGameSharedPath + 'resources', false);
-
- // Playlists are not shared as we need one directory to write too
- FindPath(PlaylistPath, Platform.GetGameUserPath + 'playlists', true);
-
- // Screenshot directory (must be writable)
- if (not FindPath(ScreenshotsPath, Platform.GetGameUserPath + 'screenshots', true)) then
- begin
- Log.LogWarn('Screenshot directory "'+ Platform.GetGameUserPath +'" not available', 'InitializePaths');
- end;
-
- // Add song paths
- AddSongPath(Params.SongPath);
- AddSongPath(Platform.GetGameSharedPath + 'songs');
- AddSongPath(Platform.GetGameUserPath + 'songs');
-
- // Add category cover paths
- AddCoverPath(Platform.GetGameSharedPath + 'covers');
- AddCoverPath(Platform.GetGameUserPath + 'covers');
-end;
-
-end.
diff --git a/src/classes/UMediaCore_FFmpeg.pas b/src/classes/UMediaCore_FFmpeg.pas
deleted file mode 100644
index cdd320ac..00000000
--- a/src/classes/UMediaCore_FFmpeg.pas
+++ /dev/null
@@ -1,405 +0,0 @@
-unit UMediaCore_FFmpeg;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses
- UMusic,
- avcodec,
- avformat,
- avutil,
- ULog,
- sdl;
-
-type
- PPacketQueue = ^TPacketQueue;
- TPacketQueue = class
- private
- FirstListEntry: PAVPacketList;
- LastListEntry: PAVPacketList;
- PacketCount: integer;
- Mutex: PSDL_Mutex;
- Condition: PSDL_Cond;
- Size: integer;
- AbortRequest: boolean;
- public
- constructor Create();
- destructor Destroy(); override;
-
- function Put(Packet : PAVPacket): integer;
- function PutStatus(StatusFlag: integer; StatusInfo: Pointer): integer;
- procedure FreeStatusInfo(var Packet: TAVPacket);
- function GetStatusInfo(var Packet: TAVPacket): Pointer;
- function Get(var Packet: TAVPacket; Blocking: boolean): integer;
- function GetSize(): integer;
- procedure Flush();
- procedure Abort();
- function IsAborted(): boolean;
- end;
-
-const
- STATUS_PACKET: PChar = 'STATUS_PACKET';
-const
- PKT_STATUS_FLAG_EOF = 1; // signal end-of-file
- PKT_STATUS_FLAG_FLUSH = 2; // request the decoder to flush its avcodec decode buffers
- PKT_STATUS_FLAG_ERROR = 3; // signal an error state
- PKT_STATUS_FLAG_EMPTY = 4; // request the decoder to output empty data (silence or black frames)
-
-type
- TMediaCore_FFmpeg = class
- private
- AVCodecLock: PSDL_Mutex;
- public
- constructor Create();
- destructor Destroy(); override;
- class function GetInstance(): TMediaCore_FFmpeg;
-
- function GetErrorString(ErrorNum: integer): string;
- function FindStreamIDs(FormatCtx: PAVFormatContext; out FirstVideoStream, FirstAudioStream: integer ): boolean;
- function FindAudioStreamIndex(FormatCtx: PAVFormatContext): integer;
- function ConvertFFmpegToAudioFormat(FFmpegFormat: TSampleFormat; out Format: TAudioSampleFormat): boolean;
- procedure LockAVCodec();
- procedure UnlockAVCodec();
- end;
-
-implementation
-
-uses
- SysUtils;
-
-var
- Instance: TMediaCore_FFmpeg;
-
-constructor TMediaCore_FFmpeg.Create();
-begin
- inherited;
- AVCodecLock := SDL_CreateMutex();
-end;
-
-destructor TMediaCore_FFmpeg.Destroy();
-begin
- SDL_DestroyMutex(AVCodecLock);
- inherited;
-end;
-
-class function TMediaCore_FFmpeg.GetInstance(): TMediaCore_FFmpeg;
-begin
- if (not Assigned(Instance)) then
- Instance := TMediaCore_FFmpeg.Create();
- Result := Instance;
-end;
-
-procedure TMediaCore_FFmpeg.LockAVCodec();
-begin
- SDL_mutexP(AVCodecLock);
-end;
-
-procedure TMediaCore_FFmpeg.UnlockAVCodec();
-begin
- SDL_mutexV(AVCodecLock);
-end;
-
-function TMediaCore_FFmpeg.GetErrorString(ErrorNum: integer): string;
-begin
- case ErrorNum of
- AVERROR_IO: Result := 'AVERROR_IO';
- AVERROR_NUMEXPECTED: Result := 'AVERROR_NUMEXPECTED';
- AVERROR_INVALIDDATA: Result := 'AVERROR_INVALIDDATA';
- AVERROR_NOMEM: Result := 'AVERROR_NOMEM';
- AVERROR_NOFMT: Result := 'AVERROR_NOFMT';
- AVERROR_NOTSUPP: Result := 'AVERROR_NOTSUPP';
- AVERROR_NOENT: Result := 'AVERROR_NOENT';
- AVERROR_PATCHWELCOME: Result := 'AVERROR_PATCHWELCOME';
- else Result := 'AVERROR_#'+inttostr(ErrorNum);
- end;
-end;
-
-{
- @param(FormatCtx is a PAVFormatContext returned from av_open_input_file )
- @param(FirstVideoStream is an OUT value of type integer, this is the index of the video stream)
- @param(FirstAudioStream is an OUT value of type integer, this is the index of the audio stream)
- @returns(@true on success, @false otherwise)
-}
-function TMediaCore_FFmpeg.FindStreamIDs(FormatCtx: PAVFormatContext; out FirstVideoStream, FirstAudioStream: integer): boolean;
-var
- i: integer;
- Stream: PAVStream;
-begin
- // find the first video stream
- FirstAudioStream := -1;
- FirstVideoStream := -1;
-
- for i := 0 to FormatCtx.nb_streams-1 do
- begin
- Stream := FormatCtx.streams[i];
-
- if (Stream.codec.codec_type = CODEC_TYPE_VIDEO) and
- (FirstVideoStream < 0) then
- begin
- FirstVideoStream := i;
- end;
-
- if (Stream.codec.codec_type = CODEC_TYPE_AUDIO) and
- (FirstAudioStream < 0) then
- begin
- FirstAudioStream := i;
- end;
- end;
-
- // return true if either an audio- or video-stream was found
- Result := (FirstAudioStream > -1) or
- (FirstVideoStream > -1) ;
-end;
-
-function TMediaCore_FFmpeg.FindAudioStreamIndex(FormatCtx: PAVFormatContext): integer;
-var
- i: integer;
- StreamIndex: integer;
- Stream: PAVStream;
-begin
- // find the first audio stream
- StreamIndex := -1;
-
- for i := 0 to FormatCtx^.nb_streams-1 do
- begin
- Stream := FormatCtx^.streams[i];
-
- if (Stream.codec^.codec_type = CODEC_TYPE_AUDIO) then
- begin
- StreamIndex := i;
- Break;
- end;
- end;
-
- Result := StreamIndex;
-end;
-
-function TMediaCore_FFmpeg.ConvertFFmpegToAudioFormat(FFmpegFormat: TSampleFormat; out Format: TAudioSampleFormat): boolean;
-begin
- case FFmpegFormat of
- SAMPLE_FMT_U8: Format := asfU8;
- SAMPLE_FMT_S16: Format := asfS16;
- SAMPLE_FMT_S24: Format := asfS24;
- SAMPLE_FMT_S32: Format := asfS32;
- SAMPLE_FMT_FLT: Format := asfFloat;
- else begin
- Result := false;
- Exit;
- end;
- end;
- Result := true;
-end;
-
-{ TPacketQueue }
-
-constructor TPacketQueue.Create();
-begin
- inherited;
-
- FirstListEntry := nil;
- LastListEntry := nil;
- PacketCount := 0;
- Size := 0;
-
- Mutex := SDL_CreateMutex();
- Condition := SDL_CreateCond();
-end;
-
-destructor TPacketQueue.Destroy();
-begin
- Flush();
- SDL_DestroyMutex(Mutex);
- SDL_DestroyCond(Condition);
- inherited;
-end;
-
-procedure TPacketQueue.Abort();
-begin
- SDL_LockMutex(Mutex);
-
- AbortRequest := true;
-
- SDL_CondBroadcast(Condition);
- SDL_UnlockMutex(Mutex);
-end;
-
-function TPacketQueue.IsAborted(): boolean;
-begin
- SDL_LockMutex(Mutex);
- Result := AbortRequest;
- SDL_UnlockMutex(Mutex);
-end;
-
-function TPacketQueue.Put(Packet : PAVPacket): integer;
-var
- CurrentListEntry : PAVPacketList;
-begin
- Result := -1;
-
- if (Packet = nil) then
- Exit;
-
- if (PChar(Packet^.data) <> STATUS_PACKET) then
- begin
- if (av_dup_packet(Packet) < 0) then
- Exit;
- end;
-
- CurrentListEntry := av_malloc(SizeOf(TAVPacketList));
- if (CurrentListEntry = nil) then
- Exit;
-
- CurrentListEntry^.pkt := Packet^;
- CurrentListEntry^.next := nil;
-
- SDL_LockMutex(Mutex);
- try
- if (LastListEntry = nil) then
- FirstListEntry := CurrentListEntry
- else
- LastListEntry^.next := CurrentListEntry;
-
- LastListEntry := CurrentListEntry;
- Inc(PacketCount);
-
- Size := Size + CurrentListEntry^.pkt.size;
- SDL_CondSignal(Condition);
- finally
- SDL_UnlockMutex(Mutex);
- end;
-
- Result := 0;
-end;
-
-(**
- * Adds a status packet (EOF, Flush, etc.) to the end of the queue.
- * StatusInfo can be used to pass additional information to the decoder.
- * Only assign nil or a valid pointer to data allocated with Getmem() to
- * StatusInfo because the pointer will be disposed with Freemem() on a call
- * to Flush(). If the packet is removed from the queue it is the decoder's
- * responsibility to free the StatusInfo data with FreeStatusInfo().
- *)
-function TPacketQueue.PutStatus(StatusFlag: integer; StatusInfo: Pointer): integer;
-var
- TempPacket: PAVPacket;
-begin
- // create temp. package
- TempPacket := av_malloc(SizeOf(TAVPacket));
- if (TempPacket = nil) then
- begin
- Result := -1;
- Exit;
- end;
- // init package
- av_init_packet(TempPacket^);
- TempPacket^.data := Pointer(STATUS_PACKET);
- TempPacket^.flags := StatusFlag;
- TempPacket^.priv := StatusInfo;
- // put a copy of the package into the queue
- Result := Put(TempPacket);
- // data has been copied -> delete temp. package
- av_free(TempPacket);
-end;
-
-procedure TPacketQueue.FreeStatusInfo(var Packet: TAVPacket);
-begin
- if (Packet.priv <> nil) then
- FreeMem(Packet.priv);
-end;
-
-function TPacketQueue.GetStatusInfo(var Packet: TAVPacket): Pointer;
-begin
- Result := Packet.priv;
-end;
-
-function TPacketQueue.Get(var Packet: TAVPacket; Blocking: boolean): integer;
-var
- CurrentListEntry: PAVPacketList;
-const
- WAIT_TIMEOUT = 10; // timeout in ms
-begin
- Result := -1;
-
- SDL_LockMutex(Mutex);
- try
- while (true) do
- begin
- if (AbortRequest) then
- Exit;
-
- CurrentListEntry := FirstListEntry;
- if (CurrentListEntry <> nil) then
- begin
- FirstListEntry := CurrentListEntry^.next;
- if (FirstListEntry = nil) then
- LastListEntry := nil;
- Dec(PacketCount);
-
- Size := Size - CurrentListEntry^.pkt.size;
- Packet := CurrentListEntry^.pkt;
- av_free(CurrentListEntry);
-
- Result := 1;
- Break;
- end
- else if (not Blocking) then
- begin
- Result := 0;
- Break;
- end
- else
- begin
- // block until a new package arrives,
- // but do not wait till infinity to avoid deadlocks
- if (SDL_CondWaitTimeout(Condition, Mutex, WAIT_TIMEOUT) = SDL_MUTEX_TIMEDOUT) then
- begin
- Result := 0;
- Break;
- end;
- end;
- end;
- finally
- SDL_UnlockMutex(Mutex);
- end;
-end;
-
-function TPacketQueue.GetSize(): integer;
-begin
- SDL_LockMutex(Mutex);
- Result := Size;
- SDL_UnlockMutex(Mutex);
-end;
-
-procedure TPacketQueue.Flush();
-var
- CurrentListEntry, TempListEntry: PAVPacketList;
-begin
- SDL_LockMutex(Mutex);
-
- CurrentListEntry := FirstListEntry;
- while(CurrentListEntry <> nil) do
- begin
- TempListEntry := CurrentListEntry^.next;
- // free status data
- if (PChar(CurrentListEntry^.pkt.data) = STATUS_PACKET) then
- FreeStatusInfo(CurrentListEntry^.pkt);
- // free packet data
- av_free_packet(@CurrentListEntry^.pkt);
- // Note: param must be a pointer to a pointer!
- av_freep(@CurrentListEntry);
- CurrentListEntry := TempListEntry;
- end;
- LastListEntry := nil;
- FirstListEntry := nil;
- PacketCount := 0;
- Size := 0;
-
- SDL_UnlockMutex(Mutex);
-end;
-
-end.
diff --git a/src/classes/UMediaCore_SDL.pas b/src/classes/UMediaCore_SDL.pas
deleted file mode 100644
index 252f72a0..00000000
--- a/src/classes/UMediaCore_SDL.pas
+++ /dev/null
@@ -1,38 +0,0 @@
-unit UMediaCore_SDL;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses
- UMusic,
- sdl;
-
-function ConvertAudioFormatToSDL(Format: TAudioSampleFormat; out SDLFormat: UInt16): boolean;
-
-implementation
-
-function ConvertAudioFormatToSDL(Format: TAudioSampleFormat; out SDLFormat: UInt16): boolean;
-begin
- case Format of
- asfU8: SDLFormat := AUDIO_U8;
- asfS8: SDLFormat := AUDIO_S8;
- asfU16LSB: SDLFormat := AUDIO_U16LSB;
- asfS16LSB: SDLFormat := AUDIO_S16LSB;
- asfU16MSB: SDLFormat := AUDIO_U16MSB;
- asfS16MSB: SDLFormat := AUDIO_S16MSB;
- asfU16: SDLFormat := AUDIO_U16;
- asfS16: SDLFormat := AUDIO_S16;
- else begin
- Result := false;
- Exit;
- end;
- end;
- Result := true;
-end;
-
-end.
diff --git a/src/classes/UMedia_dummy.pas b/src/classes/UMedia_dummy.pas
deleted file mode 100644
index 438b89ab..00000000
--- a/src/classes/UMedia_dummy.pas
+++ /dev/null
@@ -1,243 +0,0 @@
-unit UMedia_dummy;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-implementation
-
-uses
- SysUtils,
- math,
- UMusic;
-
-type
- TMedia_dummy = class( TInterfacedObject, IVideoPlayback, IVideoVisualization, IAudioPlayback, IAudioInput )
- private
- DummyOutputDeviceList: TAudioOutputDeviceList;
- public
- constructor Create();
- function GetName: string;
-
- function Init(): boolean;
- function Finalize(): boolean;
-
- function Open(const aFileName : string): boolean; // true if succeed
- procedure Close;
-
- procedure Play;
- procedure Pause;
- procedure Stop;
-
- procedure SetPosition(Time: real);
- function GetPosition: real;
-
- procedure SetSyncSource(SyncSource: TSyncSource);
-
- procedure GetFrame(Time: Extended);
- procedure DrawGL(Screen: integer);
-
- // IAudioInput
- function InitializeRecord: boolean;
- function FinalizeRecord: boolean;
- procedure CaptureStart;
- procedure CaptureStop;
- procedure GetFFTData(var data: TFFTData);
- function GetPCMData(var data: TPCMData): Cardinal;
-
- // IAudioPlayback
- function InitializePlayback: boolean;
- function FinalizePlayback: boolean;
-
- function GetOutputDeviceList(): TAudioOutputDeviceList;
- procedure FadeIn(Time: real; TargetVolume: single);
- procedure SetAppVolume(Volume: single);
- procedure SetVolume(Volume: single);
- procedure SetLoop(Enabled: boolean);
- procedure Rewind;
-
- function Finished: boolean;
- function Length: real;
-
- function OpenSound(const Filename: string): TAudioPlaybackStream;
- procedure CloseSound(var PlaybackStream: TAudioPlaybackStream);
- procedure PlaySound(stream: TAudioPlaybackStream);
- procedure StopSound(stream: TAudioPlaybackStream);
-
- function CreateVoiceStream(Channel: integer; FormatInfo: TAudioFormatInfo): TAudioVoiceStream;
- procedure CloseVoiceStream(var VoiceStream: TAudioVoiceStream);
- end;
-
-function TMedia_dummy.GetName: string;
-begin
- Result := 'dummy';
-end;
-
-procedure TMedia_dummy.GetFrame(Time: Extended);
-begin
-end;
-
-procedure TMedia_dummy.DrawGL(Screen: integer);
-begin
-end;
-
-constructor TMedia_dummy.Create();
-begin
- inherited;
-end;
-
-function TMedia_dummy.Init(): boolean;
-begin
- Result := true;
-end;
-
-function TMedia_dummy.Finalize(): boolean;
-begin
- Result := true;
-end;
-
-function TMedia_dummy.Open(const aFileName : string): boolean; // true if succeed
-begin
- Result := false;
-end;
-
-procedure TMedia_dummy.Close;
-begin
-end;
-
-procedure TMedia_dummy.Play;
-begin
-end;
-
-procedure TMedia_dummy.Pause;
-begin
-end;
-
-procedure TMedia_dummy.Stop;
-begin
-end;
-
-procedure TMedia_dummy.SetPosition(Time: real);
-begin
-end;
-
-function TMedia_dummy.GetPosition: real;
-begin
- Result := 0;
-end;
-
-procedure TMedia_dummy.SetSyncSource(SyncSource: TSyncSource);
-begin
-end;
-
-// IAudioInput
-function TMedia_dummy.InitializeRecord: boolean;
-begin
- Result := true;
-end;
-
-function TMedia_dummy.FinalizeRecord: boolean;
-begin
- Result := true;
-end;
-
-procedure TMedia_dummy.CaptureStart;
-begin
-end;
-
-procedure TMedia_dummy.CaptureStop;
-begin
-end;
-
-procedure TMedia_dummy.GetFFTData(var data: TFFTData);
-begin
-end;
-
-function TMedia_dummy.GetPCMData(var data: TPCMData): Cardinal;
-begin
- Result := 0;
-end;
-
-// IAudioPlayback
-function TMedia_dummy.InitializePlayback: boolean;
-begin
- SetLength(DummyOutputDeviceList, 1);
- DummyOutputDeviceList[0] := TAudioOutputDevice.Create();
- DummyOutputDeviceList[0].Name := '[Dummy Device]';
- Result := true;
-end;
-
-function TMedia_dummy.FinalizePlayback: boolean;
-begin
- Result := true;
-end;
-
-function TMedia_dummy.GetOutputDeviceList(): TAudioOutputDeviceList;
-begin
- Result := DummyOutputDeviceList;
-end;
-
-procedure TMedia_dummy.SetAppVolume(Volume: single);
-begin
-end;
-
-procedure TMedia_dummy.SetVolume(Volume: single);
-begin
-end;
-
-procedure TMedia_dummy.SetLoop(Enabled: boolean);
-begin
-end;
-
-procedure TMedia_dummy.FadeIn(Time: real; TargetVolume: single);
-begin
-end;
-
-procedure TMedia_dummy.Rewind;
-begin
-end;
-
-function TMedia_dummy.Finished: boolean;
-begin
- Result := false;
-end;
-
-function TMedia_dummy.Length: real;
-begin
- Result := 60;
-end;
-
-function TMedia_dummy.OpenSound(const Filename: string): TAudioPlaybackStream;
-begin
- Result := nil;
-end;
-
-procedure TMedia_dummy.CloseSound(var PlaybackStream: TAudioPlaybackStream);
-begin
-end;
-
-procedure TMedia_dummy.PlaySound(stream: TAudioPlaybackStream);
-begin
-end;
-
-procedure TMedia_dummy.StopSound(stream: TAudioPlaybackStream);
-begin
-end;
-
-function TMedia_dummy.CreateVoiceStream(Channel: integer; FormatInfo: TAudioFormatInfo): TAudioVoiceStream;
-begin
- Result := nil;
-end;
-
-procedure TMedia_dummy.CloseVoiceStream(var VoiceStream: TAudioVoiceStream);
-begin
-end;
-
-initialization
- MediaManager.Add(TMedia_dummy.Create);
-
-end.
diff --git a/src/classes/UModules.pas b/src/classes/UModules.pas
deleted file mode 100644
index 554a24c4..00000000
--- a/src/classes/UModules.pas
+++ /dev/null
@@ -1,26 +0,0 @@
-unit UModules;
-
-interface
-
-{$I switches.inc}
-
-{*********************
- UModules
- Unit Contains all used Modules in its uses clausel
- and a const with an array of all Modules to load
-*********************}
-
-uses
- UCoreModule,
- UPluginLoader;
-
-const
- CORE_MODULES_TO_LOAD: Array[0..2] of cCoreModule = (
- TPluginLoader, //First because it has to look if there are Module replacements (Feature o/t Future)
- TCoreModule, //Remove this later, just a dummy
- TtehPlugins //Represents the Plugins. Last because they may use CoreModules Services etc.
- );
-
-implementation
-
-end.
\ No newline at end of file
diff --git a/src/classes/UMusic.pas b/src/classes/UMusic.pas
deleted file mode 100644
index 6476f629..00000000
--- a/src/classes/UMusic.pas
+++ /dev/null
@@ -1,1233 +0,0 @@
-unit UMusic;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses
- UTime,
- Classes;
-
-type
- TNoteType = (ntFreestyle, ntNormal, ntGolden);
-
- (**
- * TLineFragment represents a fragment of a lyrics line.
- * This is a text-fragment (e.g. a syllable) assigned to a note pitch,
- * represented by a bar in the sing-screen.
- *)
- PLineFragment = ^TLineFragment;
- TLineFragment = record
- Color: integer;
- Start: integer; // beat the fragment starts at
- Length: integer; // length in beats
- Tone: integer; // full range tone
- Text: string; // text assigned to this fragment (a syllable, word, etc.)
- NoteType: TNoteType; // note-type: golden-note/freestyle etc.
- end;
-
- (**
- * TLine represents one lyrics line and consists of multiple
- * notes.
- *)
- PLine = ^TLine;
- TLine = record
- Start: integer; // the start beat of this line (<> start beat of the first note of this line)
- Lyric: string;
- LyricWidth: real; // @deprecated: width of the line in pixels.
- // Do not use this as the width is not correct.
- // Use TLyricsEngine.GetUpperLine().Width instead.
- End_: integer;
- BaseNote: integer;
- HighNote: integer; // index of last note in line (= High(Note)?)
- TotalNotes: integer; // value of all notes in the line
- LastLine: boolean;
- Note: array of TLineFragment;
- end;
-
- (**
- * TLines stores sets of lyric lines and information on them.
- * Normally just one set is defined but in duet mode it might for example
- * contain two sets.
- *)
- TLines = record
- Current: integer; // for drawing of current line
- High: integer; // (= High(Line)?)
- Number: integer;
- Resolution: integer;
- NotesGAP: integer;
- ScoreValue: integer;
- Line: array of TLine;
- end;
-
- (**
- * TLyricsState contains all information concerning the
- * state of the lyrics, e.g. the current beat or duration of the lyrics.
- *)
- TLyricsState = class
- private
- Timer: TRelativeTimer; // keeps track of the current time
- public
- OldBeat: integer; // previous discovered beat
- CurrentBeat: integer; // current beat (rounded)
- MidBeat: real; // current beat (float)
-
- // now we use this for super synchronization!
- // only used when analyzing voice
- // TODO: change ...D to ...Detect(ed)
- OldBeatD: integer; // previous discovered beat
- CurrentBeatD: integer; // current discovered beat (rounded)
- MidBeatD: real; // current discovered beat (float)
-
- // we use this for audible clicks
- // TODO: Change ...C to ...Click
- OldBeatC: integer; // previous discovered beat
- CurrentBeatC: integer;
- MidBeatC: real; // like CurrentBeatC
-
- OldLine: integer; // previous displayed sentence
-
- StartTime: real; // time till start of lyrics (= Gap)
- TotalTime: real; // total song time
-
- constructor Create();
- procedure Pause();
- procedure Resume();
-
- procedure Reset();
- procedure UpdateBeats();
-
- (**
- * current song time (in seconds) used as base-timer for lyrics etc.
- *)
- function GetCurrentTime(): real;
- procedure SetCurrentTime(Time: real);
- end;
-
-
-const
- FFTSize = 512; // size of FFT data (output: FFTSize/2 values)
-type
- TFFTData = array[0..(FFTSize div 2)-1] of Single;
-
-type
- PPCMStereoSample = ^TPCMStereoSample;
- TPCMStereoSample = array[0..1] of SmallInt;
- TPCMData = array[0..511] of TPCMStereoSample;
-
-type
- TStreamStatus = (ssStopped, ssPlaying, ssPaused);
-const
- StreamStatusStr: array[TStreamStatus] of string =
- ('Stopped', 'Playing', 'Paused');
-
-type
- TAudioSampleFormat = (
- asfU8, asfS8, // unsigned/signed 8 bits
- asfU16LSB, asfS16LSB, // unsigned/signed 16 bits (endianness: LSB)
- asfU16MSB, asfS16MSB, // unsigned/signed 16 bits (endianness: MSB)
- asfU16, asfS16, // unsigned/signed 16 bits (endianness: System)
- asfS24, // signed 24 bits (endianness: System)
- asfS32, // signed 32 bits (endianness: System)
- asfFloat // float
- );
-
-const
- // Size of one sample (one channel only) in bytes
- AudioSampleSize: array[TAudioSampleFormat] of integer = (
- 1, 1, // asfU8, asfS8
- 2, 2, // asfU16LSB, asfS16LSB
- 2, 2, // asfU16MSB, asfS16MSB
- 2, 2, // asfU16, asfS16
- 3, // asfS24
- 4, // asfS32
- 4 // asfFloat
- );
-
-const
- CHANNELMAP_LEFT = 1;
- CHANNELMAP_RIGHT = 2;
- CHANNELMAP_FRONT = CHANNELMAP_LEFT or CHANNELMAP_RIGHT;
-
-type
- TAudioFormatInfo = class
- private
- fSampleRate : double;
- fChannels : byte;
- fFormat : TAudioSampleFormat;
- fFrameSize : integer;
-
- procedure SetChannels(Channels: byte);
- procedure SetFormat(Format: TAudioSampleFormat);
- procedure UpdateFrameSize();
- function GetBytesPerSec(): double;
- public
- constructor Create(Channels: byte; SampleRate: double; Format: TAudioSampleFormat);
- function Copy(): TAudioFormatInfo;
-
- (**
- * Returns the inverse ratio of the size of data in this format to its
- * size in a given target format.
- * Example: SrcSize*SrcInfo.GetRatio(TgtInfo) = TgtSize
- *)
- function GetRatio(TargetInfo: TAudioFormatInfo): double;
-
- property SampleRate: double read fSampleRate write fSampleRate;
- property Channels: byte read fChannels write SetChannels;
- property Format: TAudioSampleFormat read fFormat write SetFormat;
- property FrameSize: integer read fFrameSize;
- property BytesPerSec: double read GetBytesPerSec;
- end;
-
-type
- TSoundEffect = class
- public
- EngineData: Pointer; // can be used for engine-specific data
- procedure Callback(Buffer: PChar; BufSize: integer); virtual; abstract;
- end;
-
- TVoiceRemoval = class(TSoundEffect)
- public
- procedure Callback(Buffer: PChar; BufSize: integer); override;
- end;
-
-type
- TSyncSource = class
- function GetClock(): real; virtual; abstract;
- end;
-
- TAudioProcessingStream = class;
- TOnCloseHandler = procedure(Stream: TAudioProcessingStream);
-
- TAudioProcessingStream = class
- protected
- OnCloseHandlers: array of TOnCloseHandler;
-
- function GetLength(): real; virtual; abstract;
- function GetPosition(): real; virtual; abstract;
- procedure SetPosition(Time: real); virtual; abstract;
- function GetLoop(): boolean; virtual; abstract;
- procedure SetLoop(Enabled: boolean); virtual; abstract;
-
- procedure PerformOnClose();
- public
- function GetAudioFormatInfo(): TAudioFormatInfo; virtual; abstract;
- procedure Close(); virtual; abstract;
-
- (**
- * Adds a new OnClose action handler.
- * The handlers are performed in the order they were added.
- * If not stated explicitely, member-variables might have been invalidated
- * already. So do not use any member (variable/method/...) if you are not
- * sure it is valid.
- *)
- procedure AddOnCloseHandler(Handler: TOnCloseHandler);
-
- property Length: real read GetLength;
- property Position: real read GetPosition write SetPosition;
- property Loop: boolean read GetLoop write SetLoop;
- end;
-
- TAudioSourceStream = class(TAudioProcessingStream)
- protected
- function IsEOF(): boolean; virtual; abstract;
- function IsError(): boolean; virtual; abstract;
- public
- function ReadData(Buffer: PChar; BufferSize: integer): integer; virtual; abstract;
-
- property EOF: boolean read IsEOF;
- property Error: boolean read IsError;
- end;
-
- (*
- * State-Chart for playback-stream state transitions
- * []: Transition, (): State
- *
- * /---[Play/FadeIn]--->-\ /-------[Pause]----->-\
- * -[Create]->(Stop) (Play) (Pause)
- * \\-<-[Stop/EOF*/Error]-/ \-<---[Play/FadeIn]--//
- * \-<------------[Stop/EOF*/Error]--------------/
- *
- * *: if not looped, otherwise stream is repeated
- * Note: SetPosition() does not change the state.
- *)
-
- TAudioPlaybackStream = class(TAudioProcessingStream)
- protected
- SyncSource: TSyncSource;
- AvgSyncDiff: double;
- SourceStream: TAudioSourceStream;
-
- function GetLatency(): double; virtual; abstract;
- function GetStatus(): TStreamStatus; virtual; abstract;
- function GetVolume(): single; virtual; abstract;
- procedure SetVolume(Volume: single); virtual; abstract;
- function Synchronize(BufferSize: integer; FormatInfo: TAudioFormatInfo): integer;
- procedure FillBufferWithFrame(Buffer: PChar; BufferSize: integer; Frame: PChar; FrameSize: integer);
- public
- (**
- * Opens a SourceStream for playback.
- * Note that the caller (not the TAudioPlaybackStream) is responsible to
- * free the SourceStream after the Playback-Stream is closed.
- * You may use an OnClose-handler to achieve this. GetSourceStream()
- * guarantees to deliver this method's SourceStream parameter to
- * the OnClose-handler. Freeing SourceStream at OnClose is allowed.
- *)
- function Open(SourceStream: TAudioSourceStream): boolean; virtual; abstract;
-
- procedure Play(); virtual; abstract;
- procedure Pause(); virtual; abstract;
- procedure Stop(); virtual; abstract;
- procedure FadeIn(Time: real; TargetVolume: single); virtual; abstract;
-
- procedure GetFFTData(var data: TFFTData); virtual; abstract;
- function GetPCMData(var data: TPCMData): Cardinal; virtual; abstract;
-
- procedure AddSoundEffect(Effect: TSoundEffect); virtual; abstract;
- procedure RemoveSoundEffect(Effect: TSoundEffect); virtual; abstract;
-
- procedure SetSyncSource(SyncSource: TSyncSource);
- function GetSourceStream(): TAudioSourceStream;
-
- property Status: TStreamStatus read GetStatus;
- property Volume: single read GetVolume write SetVolume;
- end;
-
- TAudioDecodeStream = class(TAudioSourceStream)
- end;
-
- TAudioVoiceStream = class(TAudioSourceStream)
- protected
- FormatInfo: TAudioFormatInfo;
- ChannelMap: integer;
- public
- destructor Destroy; override;
-
- function Open(ChannelMap: integer; FormatInfo: TAudioFormatInfo): boolean; virtual;
- procedure Close(); override;
-
- procedure WriteData(Buffer: PChar; BufferSize: integer); virtual; abstract;
- function GetAudioFormatInfo(): TAudioFormatInfo; override;
-
- function GetLength(): real; override;
- function GetPosition(): real; override;
- procedure SetPosition(Time: real); override;
- function GetLoop(): boolean; override;
- procedure SetLoop(Enabled: boolean); override;
- end;
-
-type
- // soundcard output-devices information
- TAudioOutputDevice = class
- public
- Name: string; // soundcard name
- end;
- TAudioOutputDeviceList = array of TAudioOutputDevice;
-
-type
- IGenericPlayback = Interface
- ['{63A5EBC3-3F4D-4F23-8DFB-B5165FCE33DD}']
- function GetName: String;
-
- function Open(const Filename: string): boolean; // true if succeed
- procedure Close;
-
- procedure Play;
- procedure Pause;
- procedure Stop;
-
- procedure SetPosition(Time: real);
- function GetPosition: real;
-
- property Position: real read GetPosition write SetPosition;
- end;
-
- IVideoPlayback = Interface( IGenericPlayback )
- ['{3574C40C-28AE-4201-B3D1-3D1F0759B131}']
- function Init(): boolean;
- function Finalize: boolean;
-
- procedure GetFrame(Time: Extended); // WANT TO RENAME THESE TO BE MORE GENERIC
- procedure DrawGL(Screen: integer); // WANT TO RENAME THESE TO BE MORE GENERIC
-
- end;
-
- IVideoVisualization = Interface( IVideoPlayback )
- ['{5AC17D60-B34D-478D-B632-EB00D4078017}']
- end;
-
- IAudioPlayback = Interface( IGenericPlayback )
- ['{E4AE0B40-3C21-4DC5-847C-20A87E0DFB96}']
- function InitializePlayback: boolean;
- function FinalizePlayback: boolean;
-
- function GetOutputDeviceList(): TAudioOutputDeviceList;
-
- procedure SetAppVolume(Volume: single);
- procedure SetVolume(Volume: single);
- procedure SetLoop(Enabled: boolean);
-
- procedure FadeIn(Time: real; TargetVolume: single);
- procedure SetSyncSource(SyncSource: TSyncSource);
-
- procedure Rewind;
- function Finished: boolean;
- function Length: real;
-
- // Sounds
- // TODO:
- // add a TMediaDummyPlaybackStream implementation that will
- // be used by the TSoundLib whenever OpenSound() fails, so checking for
- // nil-pointers is not neccessary anymore.
- // PlaySound/StopSound will be removed then, OpenSound will be renamed to
- // CreateSound.
- function OpenSound(const Filename: String): TAudioPlaybackStream;
- procedure PlaySound(Stream: TAudioPlaybackStream);
- procedure StopSound(Stream: TAudioPlaybackStream);
-
- // Equalizer
- procedure GetFFTData(var Data: TFFTData);
-
- // Interface for Visualizer
- function GetPCMData(var Data: TPCMData): Cardinal;
-
- function CreateVoiceStream(ChannelMap: integer; FormatInfo: TAudioFormatInfo): TAudioVoiceStream;
- end;
-
- IGenericDecoder = Interface
- ['{557B0E9A-604D-47E4-B826-13769F3E10B7}']
- function GetName(): String;
- function InitializeDecoder(): boolean;
- function FinalizeDecoder(): boolean;
- //function IsSupported(const Filename: string): boolean;
- end;
-
- (*
- IVideoDecoder = Interface( IGenericDecoder )
- ['{2F184B2B-FE69-44D5-9031-0A2462391DCA}']
- function Open(const Filename: string): TVideoDecodeStream;
- end;
- *)
-
- IAudioDecoder = Interface( IGenericDecoder )
- ['{AB47B1B6-2AA9-4410-BF8C-EC79561B5478}']
- function Open(const Filename: string): TAudioDecodeStream;
- end;
-
- IAudioInput = Interface
- ['{A5C8DA92-2A0C-4AB2-849B-2F7448C6003A}']
- function GetName: String;
- function InitializeRecord: boolean;
- function FinalizeRecord(): boolean;
-
- procedure CaptureStart;
- procedure CaptureStop;
- end;
-
-type
- TAudioConverter = class
- protected
- fSrcFormatInfo: TAudioFormatInfo;
- fDstFormatInfo: TAudioFormatInfo;
- public
- function Init(SrcFormatInfo: TAudioFormatInfo; DstFormatInfo: TAudioFormatInfo): boolean; virtual;
- destructor Destroy(); override;
-
- (**
- * Converts the InputBuffer and stores the result in OutputBuffer.
- * If the result is not -1, InputSize will be set to the actual number of
- * input-buffer bytes used.
- * Returns the number of bytes written to the output-buffer or -1 if an error occured.
- *)
- function Convert(InputBuffer: PChar; OutputBuffer: PChar; var InputSize: integer): integer; virtual; abstract;
-
- (**
- * Destination/Source size ratio
- *)
- function GetRatio(): double; virtual; abstract;
-
- function GetOutputBufferSize(InputSize: integer): integer; virtual; abstract;
- property SrcFormatInfo: TAudioFormatInfo read fSrcFormatInfo;
- property DstFormatInfo: TAudioFormatInfo read fDstFormatInfo;
- end;
-
-(* TODO
-const
- SOUNDID_START = 0;
- SOUNDID_BACK = 1;
- SOUNDID_SWOOSH = 2;
- SOUNDID_CHANGE = 3;
- SOUNDID_OPTION = 4;
- SOUNDID_CLICK = 5;
- LAST_SOUNDID = SOUNDID_CLICK;
-
- BaseSoundFilenames: array[0..LAST_SOUNDID] of string = (
- '%SOUNDPATH%/Common start.mp3', // Start
- '%SOUNDPATH%/Common back.mp3', // Back
- '%SOUNDPATH%/menu swoosh.mp3', // Swoosh
- '%SOUNDPATH%/select music change music 50.mp3', // Change
- '%SOUNDPATH%/option change col.mp3', // Option
- '%SOUNDPATH%/rimshot022b.mp3' // Click
- {
- '%SOUNDPATH%/bassdrumhard076b.mp3', // Drum (unused)
- '%SOUNDPATH%/hihatclosed068b.mp3', // Hihat (unused)
- '%SOUNDPATH%/claps050b.mp3', // Clap (unused)
- '%SOUNDPATH%/Shuffle.mp3' // Shuffle (unused)
- }
- );
-*)
-
-type
- TSoundLibrary = class
- private
- // TODO
- //Sounds: array of TAudioPlaybackStream;
- public
- // TODO: move sounds to the private section
- // and provide IDs instead.
- Start: TAudioPlaybackStream;
- Back: TAudioPlaybackStream;
- Swoosh: TAudioPlaybackStream;
- Change: TAudioPlaybackStream;
- Option: TAudioPlaybackStream;
- Click: TAudioPlaybackStream;
- BGMusic: TAudioPlaybackStream;
-
- constructor Create();
- destructor Destroy(); override;
-
- procedure LoadSounds();
- procedure UnloadSounds();
-
- procedure StartBgMusic();
- procedure PauseBgMusic();
- // TODO
- //function AddSound(Filename: string): integer;
- //procedure RemoveSound(ID: integer);
- //function GetSound(ID: integer): TAudioPlaybackStream;
- //property Sound[ID: integer]: TAudioPlaybackStream read GetSound; default;
- end;
-
-var
- // TODO: JB --- THESE SHOULD NOT BE GLOBAL
- Lines: array of TLines;
- LyricsState: TLyricsState;
- SoundLib: TSoundLibrary;
-
-
-procedure InitializeSound;
-procedure InitializeVideo;
-procedure FinalizeMedia;
-
-function Visualization(): IVideoPlayback;
-function VideoPlayback(): IVideoPlayback;
-function AudioPlayback(): IAudioPlayback;
-function AudioInput(): IAudioInput;
-function AudioDecoders(): TInterfaceList;
-
-function MediaManager: TInterfaceList;
-
-procedure DumpMediaInterfaces();
-
-implementation
-
-uses
- sysutils,
- math,
- UIni,
- UMain,
- UCommandLine,
- URecord,
- ULog;
-
-var
- DefaultVideoPlayback : IVideoPlayback;
- DefaultVisualization : IVideoPlayback;
- DefaultAudioPlayback : IAudioPlayback;
- DefaultAudioInput : IAudioInput;
- AudioDecoderList : TInterfaceList;
- MediaInterfaceList : TInterfaceList;
-
-
-constructor TAudioFormatInfo.Create(Channels: byte; SampleRate: double; Format: TAudioSampleFormat);
-begin
- inherited Create();
- fChannels := Channels;
- fSampleRate := SampleRate;
- fFormat := Format;
- UpdateFrameSize();
-end;
-
-procedure TAudioFormatInfo.SetChannels(Channels: byte);
-begin
- fChannels := Channels;
- UpdateFrameSize();
-end;
-
-procedure TAudioFormatInfo.SetFormat(Format: TAudioSampleFormat);
-begin
- fFormat := Format;
- UpdateFrameSize();
-end;
-
-function TAudioFormatInfo.GetBytesPerSec(): double;
-begin
- Result := FrameSize * SampleRate;
-end;
-
-procedure TAudioFormatInfo.UpdateFrameSize();
-begin
- fFrameSize := AudioSampleSize[fFormat] * fChannels;
-end;
-
-function TAudioFormatInfo.Copy(): TAudioFormatInfo;
-begin
- Result := TAudioFormatInfo.Create(Self.Channels, Self.SampleRate, Self.Format);
-end;
-
-function TAudioFormatInfo.GetRatio(TargetInfo: TAudioFormatInfo): double;
-begin
- Result := (TargetInfo.FrameSize / Self.FrameSize) *
- (TargetInfo.SampleRate / Self.SampleRate)
-end;
-
-
-function MediaManager: TInterfaceList;
-begin
- if (not assigned(MediaInterfaceList)) then
- MediaInterfaceList := TInterfaceList.Create();
- Result := MediaInterfaceList;
-end;
-
-function VideoPlayback(): IVideoPlayback;
-begin
- Result := DefaultVideoPlayback;
-end;
-
-function Visualization(): IVideoPlayback;
-begin
- Result := DefaultVisualization;
-end;
-
-function AudioPlayback(): IAudioPlayback;
-begin
- Result := DefaultAudioPlayback;
-end;
-
-function AudioInput(): IAudioInput;
-begin
- Result := DefaultAudioInput;
-end;
-
-function AudioDecoders(): TInterfaceList;
-begin
- Result := AudioDecoderList;
-end;
-
-procedure FilterInterfaceList(const IID: TGUID; InList, OutList: TInterfaceList);
-var
- i: integer;
- obj: IInterface;
-begin
- if (not assigned(OutList)) then
- Exit;
-
- OutList.Clear;
- for i := 0 to InList.Count-1 do
- begin
- if assigned(InList[i]) then
- begin
- // add object to list if it implements the interface searched for
- if (InList[i].QueryInterface(IID, obj) = 0) then
- OutList.Add(obj);
- end;
- end;
-end;
-
-procedure InitializeSound;
-var
- i: integer;
- InterfaceList: TInterfaceList;
- CurrentAudioDecoder: IAudioDecoder;
- CurrentAudioPlayback: IAudioPlayback;
- CurrentAudioInput: IAudioInput;
-begin
- // create a temporary list for interface enumeration
- InterfaceList := TInterfaceList.Create();
-
- // initialize all audio-decoders first
- FilterInterfaceList(IAudioDecoder, MediaManager, InterfaceList);
- for i := 0 to InterfaceList.Count-1 do
- begin
- CurrentAudioDecoder := IAudioDecoder(InterfaceList[i]);
- if (not CurrentAudioDecoder.InitializeDecoder()) then
- begin
- Log.LogError('Initialize failed, Removing - '+ CurrentAudioDecoder.GetName);
- MediaManager.Remove(CurrentAudioDecoder);
- end;
- end;
-
- // create and setup decoder-list (see AudioDecoders())
- AudioDecoderList := TInterfaceList.Create;
- FilterInterfaceList(IAudioDecoder, MediaManager, AudioDecoders);
-
- // find and initialize playback interface
- DefaultAudioPlayback := nil;
- FilterInterfaceList(IAudioPlayback, MediaManager, InterfaceList);
- for i := 0 to InterfaceList.Count-1 do
- begin
- CurrentAudioPlayback := IAudioPlayback(InterfaceList[i]);
- if (CurrentAudioPlayback.InitializePlayback()) then
- begin
- DefaultAudioPlayback := CurrentAudioPlayback;
- break;
- end;
- Log.LogError('Initialize failed, Removing - '+ CurrentAudioPlayback.GetName);
- MediaManager.Remove(CurrentAudioPlayback);
- end;
-
- // find and initialize input interface
- DefaultAudioInput := nil;
- FilterInterfaceList(IAudioInput, MediaManager, InterfaceList);
- for i := 0 to InterfaceList.Count-1 do
- begin
- CurrentAudioInput := IAudioInput(InterfaceList[i]);
- if (CurrentAudioInput.InitializeRecord()) then
- begin
- DefaultAudioInput := CurrentAudioInput;
- break;
- end;
- Log.LogError('Initialize failed, Removing - '+ CurrentAudioInput.GetName);
- MediaManager.Remove(CurrentAudioInput);
- end;
-
- InterfaceList.Free;
-
- // Update input-device list with registered devices
- AudioInputProcessor.UpdateInputDeviceConfig();
-
- // Load in-game sounds
- SoundLib := TSoundLibrary.Create;
-end;
-
-procedure InitializeVideo();
-var
- i: integer;
- InterfaceList: TInterfaceList;
- VideoInterface: IVideoPlayback;
- VisualInterface: IVideoVisualization;
-begin
- InterfaceList := TInterfaceList.Create;
-
- // initialize and set video-playback singleton
- DefaultVideoPlayback := nil;
- FilterInterfaceList(IVideoPlayback, MediaManager, InterfaceList);
- for i := 0 to InterfaceList.Count-1 do
- begin
- VideoInterface := IVideoPlayback(InterfaceList[i]);
- if (VideoInterface.Init()) then
- begin
- DefaultVideoPlayback := VideoInterface;
- break;
- end;
- Log.LogError('Initialize failed, Removing - '+ VideoInterface.GetName);
- MediaManager.Remove(VideoInterface);
- end;
-
- // initialize and set visualization singleton
- DefaultVisualization := nil;
- FilterInterfaceList(IVideoVisualization, MediaManager, InterfaceList);
- for i := 0 to InterfaceList.Count-1 do
- begin
- VisualInterface := IVideoVisualization(InterfaceList[i]);
- if (VisualInterface.Init()) then
- begin
- DefaultVisualization := VisualInterface;
- break;
- end;
- Log.LogError('Initialize failed, Removing - '+ VisualInterface.GetName);
- MediaManager.Remove(VisualInterface);
- end;
-
- InterfaceList.Free;
-
- // now that we have all interfaces, we can dump them
- // TODO: move this to another place
- if FindCmdLineSwitch( cMediaInterfaces ) then
- begin
- DumpMediaInterfaces();
- halt;
- end;
-end;
-
-procedure UnloadMediaModules;
-var
- i: integer;
- InterfaceList: TInterfaceList;
-begin
- FreeAndNil(AudioDecoderList);
- DefaultAudioPlayback := nil;
- DefaultAudioInput := nil;
- DefaultVideoPlayback := nil;
- DefaultVisualization := nil;
-
- // create temporary interface list
- InterfaceList := TInterfaceList.Create();
-
- // finalize audio playback interfaces (should be done before the decoders)
- FilterInterfaceList(IAudioPlayback, MediaManager, InterfaceList);
- for i := 0 to InterfaceList.Count-1 do
- IAudioPlayback(InterfaceList[i]).FinalizePlayback();
-
- // finalize audio input interfaces
- FilterInterfaceList(IAudioInput, MediaManager, InterfaceList);
- for i := 0 to InterfaceList.Count-1 do
- IAudioInput(InterfaceList[i]).FinalizeRecord();
-
- // finalize audio decoder interfaces
- FilterInterfaceList(IAudioDecoder, MediaManager, InterfaceList);
- for i := 0 to InterfaceList.Count-1 do
- IAudioDecoder(InterfaceList[i]).FinalizeDecoder();
-
- // finalize video interfaces
- FilterInterfaceList(IVideoPlayback, MediaManager, InterfaceList);
- for i := 0 to InterfaceList.Count-1 do
- IVideoPlayback(InterfaceList[i]).Finalize();
-
- // finalize audio decoder interfaces
- FilterInterfaceList(IVideoVisualization, MediaManager, InterfaceList);
- for i := 0 to InterfaceList.Count-1 do
- IVideoVisualization(InterfaceList[i]).Finalize();
-
- InterfaceList.Free;
-
- // finally free interfaces (by removing all references to them)
- FreeAndNil(MediaInterfaceList);
-end;
-
-procedure FinalizeMedia;
-begin
- // stop, close and free sounds
- SoundLib.Free;
-
- // stop and close music stream
- if (AudioPlayback <> nil) then
- AudioPlayback.Close;
-
- // stop any active captures
- if (AudioInput <> nil) then
- AudioInput.CaptureStop;
-
- if (VideoPlayback <> nil) then
- VideoPlayback.Close;
-
- if (Visualization <> nil) then
- Visualization.Close;
-
- UnloadMediaModules();
-end;
-
-procedure DumpMediaInterfaces();
-begin
- writeln( '' );
- writeln( '--------------------------------------------------------------' );
- writeln( ' In-use Media Interfaces ' );
- writeln( '--------------------------------------------------------------' );
- writeln( 'Registered Audio Playback Interface : ' + AudioPlayback.GetName );
- writeln( 'Registered Audio Input Interface : ' + AudioInput.GetName );
- writeln( 'Registered Video Playback Interface : ' + VideoPlayback.GetName );
- writeln( 'Registered Visualization Interface : ' + Visualization.GetName );
- writeln( '--------------------------------------------------------------' );
- writeln( '' );
-end;
-
-
-{ TSoundLibrary }
-
-constructor TSoundLibrary.Create();
-begin
- inherited;
- LoadSounds();
-end;
-
-destructor TSoundLibrary.Destroy();
-begin
- UnloadSounds();
- inherited;
-end;
-
-procedure TSoundLibrary.LoadSounds();
-begin
- UnloadSounds();
-
- Start := AudioPlayback.OpenSound(SoundPath + 'Common start.mp3');
- Back := AudioPlayback.OpenSound(SoundPath + 'Common back.mp3');
- Swoosh := AudioPlayback.OpenSound(SoundPath + 'menu swoosh.mp3');
- Change := AudioPlayback.OpenSound(SoundPath + 'select music change music 50.mp3');
- Option := AudioPlayback.OpenSound(SoundPath + 'option change col.mp3');
- Click := AudioPlayback.OpenSound(SoundPath + 'rimshot022b.mp3');
-
- BGMusic := AudioPlayback.OpenSound(SoundPath + 'Bebeto_-_Loop010.mp3');
-
- if (BGMusic <> nil) then
- BGMusic.Loop := True;
-end;
-
-procedure TSoundLibrary.UnloadSounds();
-begin
- FreeAndNil(Start);
- FreeAndNil(Back);
- FreeAndNil(Swoosh);
- FreeAndNil(Change);
- FreeAndNil(Option);
- FreeAndNil(Click);
- FreeAndNil(BGMusic);
-end;
-
-(* TODO
-function TSoundLibrary.GetSound(ID: integer): TAudioPlaybackStream;
-begin
- if ((ID >= 0) and (ID < Length(Sounds))) then
- Result := Sounds[ID]
- else
- Result := nil;
-end;
-*)
-
-procedure TSoundLibrary.StartBgMusic();
-begin
- if (TBackgroundMusicOption(Ini.BackgroundMusicOption) = bmoOn) and
- (Soundlib.BGMusic <> nil) and not (Soundlib.BGMusic.Status = ssPlaying) then
- begin
- AudioPlayback.PlaySound(Soundlib.BGMusic);
- end;
-end;
-
-procedure TSoundLibrary.PauseBgMusic();
-begin
- If (Soundlib.BGMusic <> nil) then
- begin
- Soundlib.BGMusic.Pause;
- end;
-end;
-
-{ TVoiceRemoval }
-
-procedure TVoiceRemoval.Callback(Buffer: PChar; BufSize: integer);
-var
- FrameIndex, FrameSize: integer;
- Value: integer;
- Sample: PPCMStereoSample;
-begin
- FrameSize := 2 * SizeOf(SmallInt);
- for FrameIndex := 0 to (BufSize div FrameSize)-1 do
- begin
- Sample := PPCMStereoSample(Buffer);
- // channel difference
- Value := Sample[0] - Sample[1];
- // clip
- if (Value > High(SmallInt)) then
- Value := High(SmallInt)
- else if (Value < Low(SmallInt)) then
- Value := Low(SmallInt);
- // assign result
- Sample[0] := Value;
- Sample[1] := Value;
- // increase to next frame
- Inc(Buffer, FrameSize);
- end;
-end;
-
-
-{ TVoiceRemoval }
-
-constructor TLyricsState.Create();
-begin
- // create a triggered timer, so we can Pause() it, set the time
- // and Resume() it afterwards for better synching.
- Timer := TRelativeTimer.Create(true);
-
- // reset state
- Reset();
-end;
-
-procedure TLyricsState.Pause();
-begin
- Timer.Pause();
-end;
-
-procedure TLyricsState.Resume();
-begin
- Timer.Resume();
-end;
-
-procedure TLyricsState.SetCurrentTime(Time: real);
-begin
- // do not start the timer (if not started already),
- // after setting the current time
- Timer.SetTime(Time, false);
-end;
-
-function TLyricsState.GetCurrentTime(): real;
-begin
- Result := Timer.GetTime();
-end;
-
-(**
- * Resets the timer and state of the lyrics.
- * The timer will be stopped afterwards so you have to call Resume()
- * to start the lyrics timer.
- *)
-procedure TLyricsState.Reset();
-begin
- Pause();
- SetCurrentTime(0);
-
- StartTime := 0;
- TotalTime := 0;
-
- OldBeat := -1;
- MidBeat := -1;
- CurrentBeat := -1;
-
- OldBeatC := -1;
- MidBeatC := -1;
- CurrentBeatC := -1;
-
- OldBeatD := -1;
- MidBeatD := -1;
- CurrentBeatD := -1;
-end;
-
-(**
- * Updates the beat information (CurrentBeat/MidBeat/...) according to the
- * current lyric time.
- *)
-procedure TLyricsState.UpdateBeats();
-var
- CurLyricsTime: real;
-begin
- CurLyricsTime := GetCurrentTime();
-
- OldBeat := CurrentBeat;
- MidBeat := GetMidBeat(CurLyricsTime - StartTime / 1000);
- CurrentBeat := Floor(MidBeat);
-
- OldBeatC := CurrentBeatC;
- MidBeatC := GetMidBeat(CurLyricsTime - StartTime / 1000);
- CurrentBeatC := Floor(MidBeatC);
-
- OldBeatD := CurrentBeatD;
- // MidBeatD = MidBeat with additional GAP
- MidBeatD := -0.5 + GetMidBeat(CurLyricsTime - (StartTime + 120 + 20) / 1000);
- CurrentBeatD := Floor(MidBeatD);
-end;
-
-
-{ TAudioConverter }
-
-function TAudioConverter.Init(SrcFormatInfo: TAudioFormatInfo; DstFormatInfo: TAudioFormatInfo): boolean;
-begin
- fSrcFormatInfo := SrcFormatInfo.Copy();
- fDstFormatInfo := DstFormatInfo.Copy();
- Result := true;
-end;
-
-destructor TAudioConverter.Destroy();
-begin
- FreeAndNil(fSrcFormatInfo);
- FreeAndNil(fDstFormatInfo);
-end;
-
-
-{ TAudioProcessingStream }
-
-procedure TAudioProcessingStream.AddOnCloseHandler(Handler: TOnCloseHandler);
-begin
- if (@Handler <> nil) then
- begin
- SetLength(OnCloseHandlers, System.Length(OnCloseHandlers)+1);
- OnCloseHandlers[High(OnCloseHandlers)] := @Handler;
- end;
-end;
-
-procedure TAudioProcessingStream.PerformOnClose();
-var i: integer;
-begin
- for i := 0 to High(OnCloseHandlers) do
- begin
- OnCloseHandlers[i](Self);
- end;
-end;
-
-
-{ TAudioPlaybackStream }
-
-function TAudioPlaybackStream.GetSourceStream(): TAudioSourceStream;
-begin
- Result := SourceStream;
-end;
-
-procedure TAudioPlaybackStream.SetSyncSource(SyncSource: TSyncSource);
-begin
- Self.SyncSource := SyncSource;
- AvgSyncDiff := -1;
-end;
-
-(*
- * Results an adjusted size of the input buffer size to keep the stream in sync
- * with the SyncSource. If no SyncSource was assigned to this stream, the
- * input buffer size will be returned, so this method will have no effect.
- *
- * These are the possible cases:
- * - Result > BufferSize: stream is behind the sync-source (stream is too slow),
- * (Result-BufferSize) bytes of the buffer must be skipped.
- * - Result = BufferSize: stream is in sync,
- * there is nothing to do.
- * - Result < BufferSize: stream is ahead of the sync-source (stream is too fast),
- * (BufferSize-Result) bytes of the buffer must be padded.
- *)
-function TAudioPlaybackStream.Synchronize(BufferSize: integer; FormatInfo: TAudioFormatInfo): integer;
-var
- TimeDiff: double;
- TimeCorrectionFactor: double;
-const
- AVG_HISTORY_FACTOR = 0.9;
- SYNC_THRESHOLD = 0.045;
- MAX_SYNC_DIFF_TIME = 0.002;
-begin
- Result := BufferSize;
-
- if (not assigned(SyncSource)) then
- Exit;
-
- if (BufferSize <= 0) then
- Exit;
-
- // difference between sync-source and stream position
- // (negative if the music-stream's position is ahead of the master clock)
- TimeDiff := SyncSource.GetClock() - (Position - GetLatency());
-
- // calculate average time difference (some sort of weighted mean).
- // The bigger AVG_HISTORY_FACTOR is, the smoother is the average diff.
- // This means that older diffs are weighted more with a higher history factor
- // than with a lower. Do not use a too low history factor. FFmpeg produces
- // very instable timestamps (pts) for ogg due to some bugs. They may differ
- // +-50ms from the real stream position. Without filtering those glitches we
- // would synch without any need, resulting in ugly plopping sounds.
- if (AvgSyncDiff = -1) then
- AvgSyncDiff := TimeDiff
- else
- AvgSyncDiff := TimeDiff * (1-AVG_HISTORY_FACTOR) +
- AvgSyncDiff * AVG_HISTORY_FACTOR;
-
- // check if sync needed
- if (Abs(AvgSyncDiff) >= SYNC_THRESHOLD) then
- begin
- // TODO: use SetPosition if diff is too large (>5s)
- if (TimeDiff < 1) then
- TimeCorrectionFactor := Sign(TimeDiff)*TimeDiff*TimeDiff
- else
- TimeCorrectionFactor := TimeDiff;
-
- // calculate adapted buffer size
- // reduce size of data to fetch if music is ahead, increase otherwise
- Result := BufferSize + Round(TimeCorrectionFactor * FormatInfo.SampleRate) * FormatInfo.FrameSize;
- if (Result < 0) then
- Result := 0;
-
- // reset average
- AvgSyncDiff := -1;
- end;
-
- (*
- DebugWriteln('Diff: ' + floattostrf(TimeDiff, ffFixed, 15, 3) +
- '| SyS: ' + floattostrf(SyncSource.GetClock(), ffFixed, 15, 3) +
- '| Pos: ' + floattostrf(Position, ffFixed, 15, 3) +
- '| Avg: ' + floattostrf(AvgSyncDiff, ffFixed, 15, 3));
- *)
-end;
-
-(*
- * Fills a buffer with copies of the given frame or with 0 if frame.
- *)
-procedure TAudioPlaybackStream.FillBufferWithFrame(Buffer: PChar; BufferSize: integer; Frame: PChar; FrameSize: integer);
-var
- i: integer;
- FrameCopyCount: integer;
-begin
- // the buffer must at least contain place for one copy of the frame.
- if ((Buffer = nil) or (BufferSize <= 0) or (BufferSize < FrameSize)) then
- Exit;
-
- // no valid frame -> fill with 0
- if ((Frame = nil) or (FrameSize <= 0)) then
- begin
- FillChar(Buffer[0], BufferSize, 0);
- Exit;
- end;
-
- // number of frames to copy
- FrameCopyCount := BufferSize div FrameSize;
- // insert as many copies of frame into the buffer as possible
- for i := 0 to FrameCopyCount-1 do
- Move(Frame[0], Buffer[i*FrameSize], FrameSize);
-end;
-
-{ TAudioVoiceStream }
-
-function TAudioVoiceStream.Open(ChannelMap: integer; FormatInfo: TAudioFormatInfo): boolean;
-begin
- Self.ChannelMap := ChannelMap;
- Self.FormatInfo := FormatInfo.Copy();
- // a voice stream is always mono, reassure the the format is correct
- Self.FormatInfo.Channels := 1;
- Result := true;
-end;
-
-destructor TAudioVoiceStream.Destroy;
-begin
- Close();
- inherited;
-end;
-
-procedure TAudioVoiceStream.Close();
-begin
- PerformOnClose();
- FreeAndNil(FormatInfo);
-end;
-
-function TAudioVoiceStream.GetAudioFormatInfo(): TAudioFormatInfo;
-begin
- Result := FormatInfo;
-end;
-
-function TAudioVoiceStream.GetLength(): real;
-begin
- Result := -1;
-end;
-
-function TAudioVoiceStream.GetPosition(): real;
-begin
- Result := -1;
-end;
-
-procedure TAudioVoiceStream.SetPosition(Time: real);
-begin
-end;
-
-function TAudioVoiceStream.GetLoop(): boolean;
-begin
- Result := false;
-end;
-
-procedure TAudioVoiceStream.SetLoop(Enabled: boolean);
-begin
-end;
-
-
-end.
diff --git a/src/classes/UParty.pas b/src/classes/UParty.pas
deleted file mode 100644
index 01a182b1..00000000
--- a/src/classes/UParty.pas
+++ /dev/null
@@ -1,630 +0,0 @@
-unit UParty;
-
-interface
-
-{$IFDEF FPC}
- {$MODE DELPHI}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses UPartyDefs, UCoreModule, UPluginDefs;
-
-type
- ARounds = Array [0..252] of Integer; //0..252 needed for
- PARounds = ^ARounds;
-
- TRoundInfo = record
- Modi: Cardinal;
- Winner: Byte;
- end;
-
- TeamOrderEntry = record
- Teamnum: Byte;
- Score: Byte;
- end;
-
- TeamOrderArray = Array[0..5] of Byte;
-
- TUS_ModiInfoEx = record
- Info: TUS_ModiInfo;
- Owner: Integer;
- TimesPlayed: Byte; //Helper for setting Round Plugins
- end;
-
- TPartySession = class (TCoreModule)
- private
- bPartyMode: Boolean; //Is this Party or Singleplayer
- CurRound: Byte;
-
- Modis: Array of TUS_ModiInfoEx;
- Teams: TTeamInfo;
-
- function IsWinner(Player, Winner: Byte): boolean;
- procedure GenScores;
- function GetRandomPlugin(TeamMode: Boolean): Cardinal;
- function GetRandomPlayer(Team: Byte): Byte;
- public
- //Teams: TTeamInfo;
- Rounds: array of TRoundInfo;
-
- //TCoreModule methods to inherit
- Constructor Create; override;
- Procedure Info(const pInfo: PModuleInfo); override;
- Function Load: Boolean; override;
- Function Init: Boolean; override;
- Procedure DeInit; override;
- Destructor Destroy; override;
-
- //Register Modi Service
- Function RegisterModi(nothin: TwParam; pModiInfo: TlParam): integer; //Registers a new Modi. wParam: Pointer to TUS_ModiInfo
-
- //Start new Party
- Function StartParty(NumRounds: TwParam; PAofIRounds: TlParam): integer; //Starts new Party Mode. Returns Non Zero on Success
- Function GetCurModi(wParam: TwParam; lParam: TlParam): integer; //Returns Pointer to Cur. Modis TUS_ModiInfo (to Use with Singscreen)
- Function StopParty(wParam: TwParam; lParam: TlParam): integer; //Stops Party Mode. Returns 1 If Partymode was enabled before.
- Function NextRound(wParam: TwParam; lParam: TlParam): integer; //Increases CurRound by 1; Returns num of Round or -1 if last Round is already played
-
- Function CallModiInit(wParam: TwParam; lParam: TlParam): integer; //Calls CurModis Init Proc. If an Error occurs, Returns Nonzero. In this Case a New Plugin was Selected. Please renew Loading
- Function CallModiDeInit(wParam: TwParam; lParam: TlParam): integer; //Calls DeInitProc and does the RoundEnding
-
- Function GetTeamInfo(wParam: TwParam; pTeamInfo: TlParam): integer; //Writes TTeamInfo Record to Pointer at lParam. Returns Zero on Success
- Function SetTeamInfo(wParam: TwParam; pTeamInfo: TlParam): integer; //Read TTeamInfo Record from Pointer at lParam. Returns Zero on Success
-
- Function GetTeamOrder(wParam: TwParam; lParam: TlParam): integer; //Returns Team Order. Structure: Bits 1..3: Team at Place1; Bits 4..6: Team at Place2 ...
- Function GetWinnerString(wParam: TwParam; lParam: TlParam): integer; //wParam is Roundnum. If (Pointer = nil) then Return Length of the String. Otherwise Write the String to Address at lParam
- end;
-
-const
- StandardModi = 0; //Modi ID that will be played in non party Mode
-
-implementation
-
-uses UCore, UGraphic, UMain, ULanguage, ULog, SysUtils;
-
-{*********************
- TPluginLoader
- Implentation
-*********************}
-
-//-------------
-// Function that gives some Infos about the Module to the Core
-//-------------
-Procedure TPartySession.Info(const pInfo: PModuleInfo);
-begin
- pInfo^.Name := 'TPartySession';
- pInfo^.Version := MakeVersion(1,0,0,chr(0));
- pInfo^.Description := 'Manages Party Modi and Party Game';
-end;
-
-//-------------
-// Just the Constructor
-//-------------
-Constructor TPartySession.Create;
-begin
- inherited;
- //UnSet PartyMode
- bPartyMode := False;
-end;
-
-//-------------
-//Is Called on Loading.
-//In this Method only Events and Services should be created
-//to offer them to other Modules or Plugins during the Init process
-//If False is Returned this will cause a Forced Exit
-//-------------
-Function TPartySession.Load: Boolean;
-begin
- //Add Register Party Modi Service
- Result := True;
- Core.Services.AddService('Party/RegisterModi', nil, Self.RegisterModi);
- Core.Services.AddService('Party/StartParty', nil, Self.StartParty);
- Core.Services.AddService('Party/GetCurModi', nil, Self.GetCurModi);
-end;
-
-//-------------
-//Is Called on Init Process
-//In this Method you can Hook some Events and Create + Init
-//your Classes, Variables etc.
-//If False is Returned this will cause a Forced Exit
-//-------------
-Function TPartySession.Init: Boolean;
-begin
- //Just set Prvate Var to true.
- Result := true;
-end;
-
-//-------------
-//Is Called if this Module has been Inited and there is a Exit.
-//Deinit is in backwards Initing Order
-//-------------
-Procedure TPartySession.DeInit;
-begin
- //Force DeInit
-
-end;
-
-//-------------
-//Is Called if this Module will be unloaded and has been created
-//Should be used to Free Memory
-//-------------
-Destructor TPartySession.Destroy;
-begin
- //Just save some Memory if it wasn't done now..
- SetLength(Modis, 0);
- inherited;
-end;
-
-//-------------
-// Registers a new Modi. wParam: Pointer to TUS_ModiInfo
-// Service for Plugins
-//-------------
-Function TPartySession.RegisterModi(nothin: TwParam; pModiInfo: TlParam): integer;
-var
- Len: Integer;
- Info: PUS_ModiInfo;
-begin
- Info := PModiInfo;
- //Copy Info if cbSize is correct
- If (Info.cbSize = SizeOf(TUS_ModiInfo)) then
- begin
- Len := Length(Modis);
- SetLength(Modis, Len + 1);
-
- Modis[Len].Info := Info^;
- end
- else
- Core.ReportError(Integer(PChar('Plugins try to Register Modi with wrong Pointer, or wrong TUS_ModiInfo Record.')), PChar('TPartySession'));
-
- // FIXME: return a valid result
- Result := 0;
-end;
-
-//----------
-// Returns a Number of a Random Plugin
-//----------
-Function TPartySession.GetRandomPlugin(TeamMode: Boolean): Cardinal;
-var
- LowestTP: Byte;
- NumPwithLTP: Word;
- I: Integer;
- R: Word;
-begin
- Result := StandardModi; //If there are no matching Modis, Play StandardModi
- LowestTP := high(Byte);
- NumPwithLTP := 0;
-
- //Search for Plugins not often played yet
- For I := 0 to high(Modis) do
- begin
- if (Modis[I].TimesPlayed < lowestTP) And (((Modis[I].Info.LoadingSettings AND MLS_TeamOnly) <> 0) = TeamMode) then
- begin
- lowestTP := Modis[I].TimesPlayed;
- NumPwithLTP := 1;
- end
- else if (Modis[I].TimesPlayed = lowestTP) And (((Modis[I].Info.LoadingSettings AND MLS_TeamOnly) <> 0) = TeamMode) then
- begin
- Inc(NumPwithLTP);
- end;
- end;
-
- //Create Random No
- R := Random(NumPwithLTP);
-
- //Search for Random Plugin
- For I := 0 to high(Modis) do
- begin
- if (Modis[I].TimesPlayed = lowestTP) And (((Modis[I].Info.LoadingSettings AND MLS_TeamOnly) <> 0) = TeamMode) then
- begin
- //Plugin Found
- if (R = 0) then
- begin
- Result := I;
- Inc(Modis[I].TimesPlayed);
- Break;
- end;
-
- Dec(R);
- end;
- end;
-end;
-
-//----------
-// Starts new Party Mode. Returns Non Zero on Success
-//----------
-Function TPartySession.StartParty(NumRounds: TwParam; PAofIRounds: TlParam): integer;
-var
- I: Integer;
- aiRounds: PARounds;
- TeamMode: Boolean;
-begin
- Result := 0;
- If (Teams.NumTeams >= 1) AND (NumRounds < High(Byte)-1) then
- begin
- bPartyMode := false;
- aiRounds := PAofIRounds;
-
- Try
- //Is this Teammode(More then one Player per Team) ?
- TeamMode := True;
- For I := 0 to Teams.NumTeams-1 do
- TeamMode := TeamMode AND (Teams.Teaminfo[I].NumPlayers > 1);
-
- //Set Rounds
- SetLength(Rounds, NumRounds);
-
- For I := 0 to High(Rounds) do
- begin //Set Plugins
- If (aiRounds[I] = -1) then
- Rounds[I].Modi := GetRandomPlugin(TeamMode)
- Else If (aiRounds[I] >= 0) AND (aiRounds[I] <= High(Modis)) AND (TeamMode OR ((Modis[aiRounds[I]].Info.LoadingSettings AND MLS_TeamOnly) = 0)) then
- Rounds[I].Modi := aiRounds[I]
- Else
- Rounds[I].Modi := StandardModi;
-
- Rounds[I].Winner := High(Byte); //Set Winner to Not Played
- end;
-
- CurRound := High(Byte); //Set CurRound to not defined
-
- //Return teh true and Set PartyMode
- bPartyMode := True;
- Result := 1;
-
- Except
- Core.ReportError(Integer(PChar('Can''t start PartyMode.')), PChar('TPartySession'));
- end;
- end;
-end;
-
-//----------
-// Returns Pointer to Cur. ModiInfoEx (to Use with Singscreen)
-//----------
-Function TPartySession.GetCurModi(wParam: TwParam; lParam: TlParam): integer;
-begin
- If (bPartyMode) AND (CurRound <= High(Rounds)) then
- begin //If PartyMode is enabled:
- //Return the Plugin of the Cur Round
- Result := Integer(@Modis[Rounds[CurRound].Modi]);
- end
- else
- begin //Return StandardModi
- Result := Integer(@Modis[StandardModi]);
- end;
-end;
-
-//----------
-// Stops Party Mode. Returns 1 If Partymode was enabled before. And -1 if Change was not possible
-//----------
-Function TPartySession.StopParty(wParam: TwParam; lParam: TlParam): integer;
-begin
- Result := -1;
- If (bPartyMode) then
- begin
- // to-do : Whit�: Check here if SingScreen is not Shown atm.
- bPartyMode := False;
- Result := 1;
- end
- else
- Result := 0;
-end;
-
-//----------
-//GetRandomPlayer - Gives back a Random Player to Play next Round
-//----------
-function TPartySession.GetRandomPlayer(Team: Byte): Byte;
-var
- I, R: Integer;
- lowestTP: Byte;
- NumPwithLTP: Byte;
-begin
- LowestTP := high(Byte);
- NumPwithLTP := 0;
- Result := 0;
-
- //Search for Players that have not often played yet
- For I := 0 to Teams.Teaminfo[Team].NumPlayers-1 do
- begin
- if (Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed < lowestTP) then
- begin
- lowestTP := Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed;
- NumPwithLTP := 1;
- end
- else if (Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed = lowestTP) then
- begin
- Inc(NumPwithLTP);
- end;
- end;
-
- //Create Random No
- R := Random(NumPwithLTP);
-
- //Search for Random Player
- For I := 0 to Teams.Teaminfo[Team].NumPlayers-1 do
- begin
- if Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed = lowestTP then
- begin
- //Player Found
- if (R = 0) then
- begin
- Result := I;
- Break;
- end;
-
- Dec(R);
- end;
- end;
-end;
-
-//----------
-// NextRound - Increases CurRound by 1; Returns num of Round or -1 if last Round is already played
-//----------
-Function TPartySession.NextRound(wParam: TwParam; lParam: TlParam): integer;
-var I: Integer;
-begin
- If ((CurRound < high(Rounds)) OR (CurRound = high(CurRound))) then
- begin //everythings OK! -> Start the Round, maaaaan
- Inc(CurRound);
-
- //Set Players to play this Round
- for I := 0 to Teams.NumTeams-1 do
- Teams.Teaminfo[I].CurPlayer := GetRandomPlayer(I);
-
- // FIXME: return a valid result
- Result := 0;
- end
- else
- Result := -1;
-end;
-
-//----------
-//IsWinner - Returns True if the Players Bit is set in the Winner Byte
-//----------
-function TPartySession.IsWinner(Player, Winner: Byte): boolean;
-var
- Bit: Byte;
-begin
- Bit := 1 shl Player;
-
- Result := ((Winner AND Bit) = Bit);
-end;
-
-//----------
-//GenScores - Inc Scores for Cur. Round
-//----------
-procedure TPartySession.GenScores;
-var
- I: Byte;
-begin
- for I := 0 to Teams.NumTeams-1 do
- begin
- if isWinner(I, Rounds[CurRound].Winner) then
- Inc(Teams.Teaminfo[I].Score);
- end;
-end;
-
-//----------
-// CallModiInit - Calls CurModis Init Proc. If an Error occurs, Returns Nonzero. In this Case a New Plugin was Selected. Please renew Loading
-//----------
-Function TPartySession.CallModiInit(wParam: TwParam; lParam: TlParam): integer;
-begin
- If (not bPartyMode) then
- begin //Set Rounds if not in PartyMode
- SetLength(Rounds, 1);
- Rounds[0].Modi := StandardModi;
- Rounds[0].Winner := High(Byte);
- CurRound := 0;
- end;
-
- Try
- //Core.
- Except
- on E : Exception do
- begin
- Core.ReportError(Integer(PChar('Error starting Modi: ' + Modis[Rounds[CurRound].Modi].Info.Name + ' ErrorStr: ' + E.Message)), PChar('TPartySession'));
- If (Rounds[CurRound].Modi = StandardModi) then
- begin
- Core.ReportError(Integer(PChar('Can''t start StandardModi, will exit now!')), PChar('TPartySession'));
- Halt;
- end
- Else //Select StandardModi
- begin
- Rounds[CurRound].Modi := StandardModi
- end;
- end;
- End;
-
- // FIXME: return a valid result
- Result := 0;
-end;
-
-//----------
-// CallModiDeInit - Calls DeInitProc and does the RoundEnding
-//----------
-Function TPartySession.CallModiDeInit(wParam: TwParam; lParam: TlParam): integer;
-var
- I: Integer;
- MaxScore: Word;
-begin
- If (bPartyMode) then
- begin
- //Get Winner Byte!
- if (@Modis[Rounds[CurRound].Modi].Info.ModiDeInit <> nil) then //get Winners from Plugin
- Rounds[CurRound].Winner := Modis[Rounds[CurRound].Modi].Info.ModiDeInit(Modis[Rounds[CurRound].Modi].Info.ID)
- else
- begin //Create winners by Score :/
- Rounds[CurRound].Winner := 0;
- MaxScore := 0;
- for I := 0 to Teams.NumTeams-1 do
- begin
- // to-do : recode Percentage stuff
- //PlayerInfo.Playerinfo[I].Percentage := PlayerInfo.Playerinfo[I].Score div 9999;
- if (Player[I].ScoreTotalInt > MaxScore) then
- begin
- MaxScore := Player[I].ScoreTotalInt;
- Rounds[CurRound].Winner := 1 shl I;
- end
- else if (Player[I].ScoreTotalInt = MaxScore) AND (Player[I].ScoreTotalInt <> 0) then
- begin
- Rounds[CurRound].Winner := Rounds[CurRound].Winner or (1 shl I);
- end;
- end;
-
-
- //When nobody has Points -> Everybody loose
- if (MaxScore = 0) then
- Rounds[CurRound].Winner := 0;
-
- end;
-
- //Generate teh Scores
- GenScores;
-
- //Inc Players TimesPlayed
- If ((Modis[Rounds[CurRound-1].Modi].Info.LoadingSettings AND MLS_IncTP) = MLS_IncTP) then
- begin
- For I := 0 to Teams.NumTeams-1 do
- Inc(Teams.TeamInfo[I].Playerinfo[Teams.TeamInfo[I].CurPlayer].TimesPlayed);
- end;
- end
- else if (@Modis[Rounds[CurRound].Modi].Info.ModiDeInit <> nil) then
- Modis[Rounds[CurRound].Modi].Info.ModiDeInit(Modis[Rounds[CurRound].Modi].Info.ID);
-
- // FIXME: return a valid result
- Result := 0;
-end;
-
-//----------
-// GetTeamInfo - Writes TTeamInfo Record to Pointer at lParam. Returns Zero on Success
-//----------
-Function TPartySession.GetTeamInfo(wParam: TwParam; pTeamInfo: TlParam): integer;
-var Info: ^TTeamInfo;
-begin
- Result := -1;
- Info := pTeamInfo;
- If (Info <> nil) then
- begin
- Try
- // to - do : Check Delphi memory management in this case
- //Not sure if i had to copy PChars to a new address or if delphi manages this o0
- Info^ := Teams;
- Result := 0;
- Except
- Result := -2;
- End;
- end;
-end;
-
-//----------
-// SetTeamInfo - Read TTeamInfo Record from Pointer at lParam. Returns Zero on Success
-//----------
-Function TPartySession.SetTeamInfo(wParam: TwParam; pTeamInfo: TlParam): integer;
-var
- TeamInfobackup: TTeamInfo;
- Info: ^TTeamInfo;
-begin
- Result := -1;
- Info := pTeamInfo;
- If (Info <> nil) then
- begin
- Try
- TeamInfoBackup := Teams;
- // to - do : Check Delphi memory management in this case
- //Not sure if i had to copy PChars to a new address or if delphi manages this o0
- Teams := Info^;
- Result := 0;
- Except
- Teams := TeamInfoBackup;
- Result := -2;
- End;
- end;
-end;
-
-//----------
-// GetTeamOrder - Returns Team Order. Structure: Bits 1..3: Team at Place1; Bits 4..6: Team at Place2 ...
-//----------
-Function TPartySession.GetTeamOrder(wParam: TwParam; lParam: TlParam): integer;
-var
- I, J: Integer;
- ATeams: array [0..5] of TeamOrderEntry;
- TempTeam: TeamOrderEntry;
-begin
- // to-do : PartyMode: Write this in another way, so that teams with the same scire get the same Placing
- //Fill Team Array
- For I := 0 to Teams.NumTeams-1 do
- begin
- ATeams[I].Teamnum := I;
- ATeams[I].Score := Teams.Teaminfo[I].Score;
- end;
-
- //Sort Teams
- for J := 0 to Teams.NumTeams-1 do
- for I := 1 to Teams.NumTeams-1 do
- if ATeams[I].Score > ATeams[I-1].Score then
- begin
- TempTeam := ATeams[I-1];
- ATeams[I-1] := ATeams[I];
- ATeams[I] := TempTeam;
- end;
-
- //Copy to Result
- Result := 0;
- For I := 0 to Teams.NumTeams-1 do
- Result := Result or (ATeams[I].TeamNum Shl I*3);
-end;
-
-//----------
-// GetWinnerString - wParam is Roundnum. If (Pointer = nil) then Return Length of the String. Otherwise Write the String to Address at lParam
-//----------
-Function TPartySession.GetWinnerString(wParam: TwParam; lParam: TlParam): integer;
-var
- Winners: Array of String;
- I: Integer;
- ResultStr: String;
- S: ^String;
-begin
- ResultStr := Language.Translate('PARTY_NOBODY');
-
- if (wParam <= High(Rounds)) then
- begin
- if (Rounds[wParam].Winner <> 0) then
- begin
- if (Rounds[wParam].Winner = 255) then
- begin
- ResultStr := Language.Translate('PARTY_NOTPLAYEDYET');
- end
- else
- begin
- SetLength(Winners, 0);
- for I := 0 to Teams.NumTeams-1 do
- begin
- if isWinner(I, Rounds[wParam].Winner) then
- begin
- SetLength(Winners, Length(Winners) + 1);
- Winners[high(Winners)] := Teams.TeamInfo[I].Name;
- end;
- end;
- ResultStr := Language.Implode(Winners);
- end;
- end;
- end;
-
- //Now Return what we have got
- If (lParam = nil) then
- begin //ReturnString Length
- Result := Length(ResultStr);
- end
- Else
- begin //Return String
- Try
- S := lParam;
- S^ := ResultStr;
- Result := 0;
- Except
- Result := -1;
-
- End;
- end;
-end;
-
-end.
diff --git a/src/classes/UPlatform.pas b/src/classes/UPlatform.pas
deleted file mode 100644
index 1dcdb5b9..00000000
--- a/src/classes/UPlatform.pas
+++ /dev/null
@@ -1,174 +0,0 @@
-unit UPlatform;
-
-// Comment by Eddie:
-// This unit defines an interface for platform specific utility functions.
-// The Interface is implemented in separate files for each platform:
-// UPlatformWindows, UPlatformLinux and UPlatformMacOSX.
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses Classes;
-
-type
- TDirectoryEntry = record
- Name : WideString;
- IsDirectory : boolean;
- IsFile : boolean;
- end;
-
- TDirectoryEntryArray = array of TDirectoryEntry;
-
- TPlatform = class
- function GetExecutionDir(): string;
- procedure Init; virtual;
- function DirectoryFindFiles(Dir, Filter: WideString; ReturnAllSubDirs: boolean): TDirectoryEntryArray; virtual; abstract;
- function TerminateIfAlreadyRunning(var WndTitle : string): boolean; virtual;
- function FindSongFile(Dir, Mask: WideString): WideString; virtual;
- procedure Halt; virtual;
- function GetLogPath : WideString; virtual; abstract;
- function GetGameSharedPath : WideString; virtual; abstract;
- function GetGameUserPath : WideString; virtual; abstract;
- function CopyFile(const Source, Target: WideString; FailIfExists: boolean): boolean; virtual;
- end;
-
- function Platform(): TPlatform;
-
-implementation
-
-uses
- SysUtils,
- {$IFDEF MSWINDOWS}
- UPlatformWindows,
- {$ENDIF}
- {$IFDEF LINUX}
- UPlatformLinux,
- {$ENDIF}
- {$IFDEF DARWIN}
- UPlatformMacOSX,
- {$ENDIF}
- ULog;
-
-
-// I have modified it to use the Platform_singleton in this location ( in the implementaiton )
-// so that this variable can NOT be overwritten from anywhere else in the application.
-// the accessor function platform, emulates all previous calls to work the same way.
-var
- Platform_singleton : TPlatform;
-
-function Platform : TPlatform;
-begin
- Result := Platform_singleton;
-end;
-
-(**
- * Default Init() implementation
- *)
-procedure TPlatform.Init;
-begin
-end;
-
-(**
- * Default Halt() implementation
- *)
-procedure TPlatform.Halt;
-begin
- // Note: Application.terminate is NOT the same
- System.Halt;
-end;
-
-{**
- * Returns the directory of the executable
- *}
-function TPlatform.GetExecutionDir(): string;
-begin
- Result := ExtractFilePath(ParamStr(0));
-end;
-
-(**
- * Default TerminateIfAlreadyRunning() implementation
- *)
-function TPlatform.TerminateIfAlreadyRunning(var WndTitle : string): Boolean;
-begin
- Result := false;
-end;
-
-(**
- * Default FindSongFile() implementation
- *)
-function TPlatform.FindSongFile(Dir, Mask: WideString): WideString;
-var
- SR: TSearchRec; // for parsing song directory
-begin
- Result := '';
- if SysUtils.FindFirst(Dir + Mask, faDirectory, SR) = 0 then
- begin
- Result := SR.Name;
- end;
- SysUtils.FindClose(SR);
-end;
-
-function TPlatform.CopyFile(const Source, Target: WideString; FailIfExists: boolean): boolean;
-const
- COPY_BUFFER_SIZE = 4096; // a good tradeoff between speed and memory consumption
-var
- SourceFile, TargetFile: TFileStream;
- FileCopyBuffer: array [0..COPY_BUFFER_SIZE-1] of byte; // temporary copy-buffer.
- NumberOfBytes: integer; // number of bytes read from SourceFile
-begin
- Result := false;
- SourceFile := nil;
- TargetFile := nil;
-
- // if overwrite is disabled return if the target file already exists
- if (FailIfExists and FileExists(Target)) then
- Exit;
-
- try
- try
- // open source and target file (might throw an exception on error)
- SourceFile := TFileStream.Create(Source, fmOpenRead);
- TargetFile := TFileStream.Create(Target, fmCreate or fmOpenWrite);
-
- while true do
- begin
- // read a block from the source file and check for errors or EOF
- NumberOfBytes := SourceFile.Read(FileCopyBuffer, SizeOf(FileCopyBuffer));
- if (NumberOfBytes <= 0) then
- Break;
- // write block to target file and check if everything was written
- if (TargetFile.Write(FileCopyBuffer, NumberOfBytes) <> NumberOfBytes) then
- Exit;
- end;
- except
- Exit;
- end;
- finally
- SourceFile.Free;
- TargetFile.Free;
- end;
-
- Result := true;
-end;
-
-
-initialization
-{$IFDEF MSWINDOWS}
- Platform_singleton := TPlatformWindows.Create;
-{$ENDIF}
-{$IFDEF LINUX}
- Platform_singleton := TPlatformLinux.Create;
-{$ENDIF}
-{$IFDEF DARWIN}
- Platform_singleton := TPlatformMacOSX.Create;
-{$ENDIF}
-
-finalization
- Platform_singleton.Free;
-
-end.
diff --git a/src/classes/UPlatformLinux.pas b/src/classes/UPlatformLinux.pas
deleted file mode 100644
index 3227e4f8..00000000
--- a/src/classes/UPlatformLinux.pas
+++ /dev/null
@@ -1,173 +0,0 @@
-unit UPlatformLinux;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses
- Classes,
- UPlatform,
- UConfig;
-
-type
- TPlatformLinux = class(TPlatform)
- private
- UseLocalDirs: boolean;
-
- procedure DetectLocalExecution();
- function GetHomeDir(): string;
- public
- procedure Init; override;
-
- function DirectoryFindFiles(Dir, Filter: WideString; ReturnAllSubDirs: Boolean): TDirectoryEntryArray; override;
-
- function GetLogPath : WideString; override;
- function GetGameSharedPath : WideString; override;
- function GetGameUserPath : WideString; override;
- end;
-
-implementation
-
-uses
- UCommandLine,
- BaseUnix,
- {$IF FPC_VERSION_INT >= 2002002}
- pwd,
- {$IFEND}
- SysUtils,
- ULog;
-
-procedure TPlatformLinux.Init;
-begin
- inherited Init();
- DetectLocalExecution();
-end;
-
-{**
- * Detects whether the game was executed locally or globally.
- * - It is local if it was not installed and directly executed from
- * within the game folder. In this case resources (themes, language-files)
- * reside in the directory of the executable.
- * - It is global if the game was installed (e.g. to /usr/bin) and
- * the resources are in a separate folder (e.g. /usr/share/ultrastardx)
- * which name is stored in the INSTALL_DATADIR constant in config-linux.inc.
- *
- * Sets UseLocalDirs to true if the game is executed locally, false otherwise.
- *}
-procedure TPlatformLinux.DetectLocalExecution();
-var
- LocalDir: string;
-begin
- LocalDir := GetExecutionDir();
-
- // we just check if the 'languages' folder exists in the
- // directory of the executable. If so -> local execution.
- UseLocalDirs := (DirectoryExists(LocalDir + 'languages'));
-end;
-
-function TPlatformLinux.DirectoryFindFiles(Dir, Filter: WideString; ReturnAllSubDirs: Boolean): TDirectoryEntryArray;
-var
- i: Integer;
- TheDir : pDir;
- ADirent : pDirent;
- Entry : Longint;
- lAttrib : integer;
-begin
- i := 0;
- Filter := LowerCase(Filter);
-
- TheDir := FpOpenDir( Dir );
- if Assigned(TheDir) then
- begin
- repeat
- ADirent := FpReadDir(TheDir^);
-
- if Assigned(ADirent) and (ADirent^.d_name <> '.') and (ADirent^.d_name <> '..') then
- begin
- lAttrib := FileGetAttr(Dir + ADirent^.d_name);
- if ReturnAllSubDirs and ((lAttrib and faDirectory) <> 0) then
- begin
- SetLength( Result, i + 1);
- Result[i].Name := ADirent^.d_name;
- Result[i].IsDirectory := true;
- Result[i].IsFile := false;
- i := i + 1;
- end
- else if (Length(Filter) = 0) or (Pos( Filter, LowerCase(ADirent^.d_name)) > 0) then
- begin
- SetLength( Result, i + 1);
- Result[i].Name := ADirent^.d_name;
- Result[i].IsDirectory := false;
- Result[i].IsFile := true;
- i := i + 1;
- end;
- end;
- until (ADirent = nil);
-
- FpCloseDir(TheDir^);
- end;
-end;
-
-function TPlatformLinux.GetLogPath: WideString;
-begin
- if UseLocalDirs then
- Result := GetExecutionDir()
- else
- Result := GetGameUserPath() + 'logs/';
-
- // create non-existing directories
- ForceDirectories(Result);
-end;
-
-function TPlatformLinux.GetGameSharedPath: WideString;
-begin
- if UseLocalDirs then
- Result := GetExecutionDir()
- else
- Result := IncludeTrailingPathDelimiter(INSTALL_DATADIR);
-end;
-
-function TPlatformLinux.GetGameUserPath: WideString;
-begin
- if UseLocalDirs then
- Result := GetExecutionDir()
- else
- Result := GetHomeDir() + '.ultrastardx/';
-end;
-
-{**
- * Returns the user's home directory terminated by a path delimiter
- *}
-function TPlatformLinux.GetHomeDir(): string;
-{$IF FPC_VERSION_INT >= 2002002}
-var
- PasswdEntry: PPasswd;
-{$IFEND}
-begin
- Result := '';
-
- {$IF FPC_VERSION_INT >= 2002002}
- // try to retrieve the info from passwd
- PasswdEntry := FpGetpwuid(FpGetuid());
- if (PasswdEntry <> nil) then
- Result := PasswdEntry.pw_dir;
- {$IFEND}
- // fallback if passwd does not contain the path
- if (Result = '') then
- Result := GetEnvironmentVariable('HOME');
- // add trailing path delimiter (normally '/')
- if (Result <> '') then
- Result := IncludeTrailingPathDelimiter(Result);
-
- {$IF FPC_VERSION_INT >= 2002002}
- // GetUserDir() is another function that returns a user path.
- // It uses env-var HOME or a fallback to a temp-dir.
- //Result := GetUserDir();
- {$IFEND}
-end;
-
-end.
diff --git a/src/classes/UPlatformMacOSX.pas b/src/classes/UPlatformMacOSX.pas
deleted file mode 100644
index 2ab2a390..00000000
--- a/src/classes/UPlatformMacOSX.pas
+++ /dev/null
@@ -1,294 +0,0 @@
-unit UPlatformMacOSX;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses
- Classes,
- ULog,
- UPlatform;
-
-type
- {**
- * @abstract(Provides Mac OS X specific details.)
- * @lastmod(August 1, 2008)
- * The UPlatformMacOSX unit takes care of setting paths to resource folders.
- *
- * (Note for non-Maccies: "folder" is the Mac name for directory.)
- *
- * Note on the resource folders:
- * 1. Installation of an application on the mac works as follows: Extract and copy an application
- * and if you don't like or need the application anymore you move the folder
- * to the trash - and you're done.
- * 2. The use folders in the user's home directory is against Apple's guidelines
- * and strange to an average user.
- * 3. Even worse is using /usr/local/... since all lowercase folders in / are
- * not visible to an average user in the Finder, at least not without some "tricks".
- *
- * The best way would be to store everything within the application bundle. However, this
- * requires USDX to offer the handling of the resources. Until this is implemented, the
- * second best solution is as follows:
- *
- * According to Aple guidelines handling of resources and folders should follow these lines:
- *
- * Acceptable places for files are folders named UltraStarDeluxe either in
- * /Library/Application Support/
- * or
- * ~/Library/Application Support/
- *
- * So
- * GetGameSharedPath could return
- * /Library/Application Support/UltraStarDeluxe/Resources/.
- * GetGameUserPath could return
- * ~/Library/Application Support/UltraStarDeluxe/Resources/.
- *
- * Right now, only $HOME/Library/Application Support/UltraStarDeluxe/Resources
- * is used. So every user needs the complete set of files and folders.
- * Future versions may also use shared resources in
- * /Library/Application Support/UltraStarDeluxe/Resources. However, this is not
- * treated yet in the code outside this unit.
- *
- * USDX checks, whether GetGameUserPath exists. If not, USDX creates it.
- * The existence of needed files is then checked and if a file is missing
- * it is copied to there from within the Resources folder in the Application
- * bundle, which contains the default files. USDX should not delete files or
- * folders in Application Support/UltraStarDeluxe automatically or without
- * user confirmation.
- *}
- TPlatformMacOSX = class(TPlatform)
- private
- {**
- * GetBundlePath returns the path to the application bundle UltraStarDeluxe.app.
- *}
- function GetBundlePath: WideString;
-
- {**
- * GetApplicationSupportPath returns the path to
- * $HOME/Library/Application Support/UltraStarDeluxe/Resources.
- *}
- function GetApplicationSupportPath: WideString;
-
- {**
- * see the description of @link(Init).
- *}
- procedure CreateUserFolders();
-
- public
- {**
- * Init simply calls @link(CreateUserFolders), which in turn scans the folder
- * UltraStarDeluxe.app/Contents/Resources for all files and folders.
- * $HOME/Library/Application Support/UltraStarDeluxe/Resources is then checked
- * for their presence and missing ones are copied.
- *}
- procedure Init; override;
-
- {**
- * DirectoryFindFiles returns all entries of a folder with names and booleans
- * about their type, i.e. file or directory.
- *}
- function DirectoryFindFiles(Dir, Filter: WideString; ReturnAllSubDirs: boolean): TDirectoryEntryArray; override;
-
- {**
- * GetLogPath returns the path for log messages. Currently it is set to
- * $HOME/Library/Application Support/UltraStarDeluxe/Resources/Log.
- *}
- function GetLogPath : WideString; override;
-
- {**
- * GetGameSharedPath returns the path for shared resources. Currently it is set to
- * /Library/Application Support/UltraStarDeluxe/Resources.
- * However it is not used.
- *}
- function GetGameSharedPath : WideString; override;
-
- {**
- * GetGameUserPath returns the path for user resources. Currently it is set to
- * $HOME/Library/Application Support/UltraStarDeluxe/Resources.
- * This is where a user can add songs, themes, ....
- *}
- function GetGameUserPath : WideString; override;
- end;
-
-implementation
-
-uses
- SysUtils,
- BaseUnix;
-
-procedure TPlatformMacOSX.Init;
-begin
- CreateUserFolders();
-end;
-
-procedure TPlatformMacOSX.CreateUserFolders();
-var
- RelativePath: string;
- // BaseDir contains the path to the folder, where a search is performed.
- // It is set to the entries in @link(DirectoryList) one after the other.
- BaseDir: string;
- // OldBaseDir contains the path to the folder, where the search started.
- // It is used to return to it, when the search is completed in all folders.
- OldBaseDir: string;
- // This record contains the result of a file search with FindFirst or FindNext
- SearchInfo: TSearchRec;
- // These two lists contain all folder and file names found
- // within the folder @link(BaseDir).
- DirectoryList, FileList: TStringList;
- // DirectoryIsFinished contains the index of the folder in @link(DirectoryList),
- // which is the last one completely searched. Later folders are still to be
- // searched for additional files and folders.
- DirectoryIsFinished: longint;
- Counter: longint;
-
- UserPathName: string;
-const
- // used to construct the @link(UserPathName)
- PathName: string = '/Library/Application Support/UltraStarDeluxe/Resources';
-begin
- // Get the current folder and save it in OldBaseDir for returning to it, when
- // finished.
- GetDir(0, OldBaseDir);
-
- // UltraStarDeluxe.app/Contents/Resources contains all the default files and
- // folders.
- BaseDir := OldBaseDir + '/UltraStarDeluxe.app/Contents/Resources';
- ChDir(BaseDir);
-
- // Right now, only $HOME/Library/Application Support/UltraStarDeluxe/Resources
- // is used.
- UserPathName := GetEnvironmentVariable('HOME') + PathName;
-
- DirectoryIsFinished := 0;
- DirectoryList := TStringList.Create();
- FileList := TStringList.Create();
- DirectoryList.Add('.');
-
- // create the folder and file lists
- repeat
-
- RelativePath := DirectoryList[DirectoryIsFinished];
- ChDir(BaseDir + '/' + RelativePath);
- if (FindFirst('*', faAnyFile, SearchInfo) = 0) then
- begin
- repeat
- if DirectoryExists(SearchInfo.Name) then
- begin
- if (SearchInfo.Name <> '.') and (SearchInfo.Name <> '..') then
- DirectoryList.Add(RelativePath + '/' + SearchInfo.Name);
- end
- else
- Filelist.Add(RelativePath + '/' + SearchInfo.Name);
- until (FindNext(SearchInfo) <> 0);
- end;
- FindClose(SearchInfo);
- Inc(DirectoryIsFinished);
- until (DirectoryIsFinished = DirectoryList.Count);
-
- // create missing folders
- for Counter := 0 to DirectoryList.Count-1 do
- begin
- if not ForceDirectories(UserPathName + '/' + DirectoryList[Counter]) then
- Log.LogError('Failed to create the folder "'+ UserPathName + '/' + DirectoryList[Counter] +'"',
- 'TPlatformMacOSX.CreateUserFolders');
- end;
- DirectoryList.Free();
-
- // copy missing files
- for Counter := 0 to Filelist.Count-1 do
- begin
- CopyFile(BaseDir + '/' + Filelist[Counter],
- UserPathName + '/' + Filelist[Counter], true);
- end;
- FileList.Free();
-
- // go back to the initial folder
- ChDir(OldBaseDir);
-end;
-
-function TPlatformMacOSX.GetBundlePath: WideString;
-var
- i, pos : integer;
-begin
- // Mac applications are packaged in folders.
- // We have to cut the last two folders
- // to get the application folder.
-
- Result := GetExecutionDir();
- for i := 1 to 2 do
- begin
- pos := Length(Result);
- repeat
- Delete(Result, pos, 1);
- pos := Length(Result);
- until (pos = 0) or (Result[pos] = '/');
- end;
-end;
-
-function TPlatformMacOSX.GetApplicationSupportPath: WideString;
-const
- PathName : string = '/Library/Application Support/UltraStarDeluxe/Resources';
-begin
- Result := GetEnvironmentVariable('HOME') + PathName + '/';
-end;
-
-function TPlatformMacOSX.GetLogPath: WideString;
-begin
- Result := GetApplicationSupportPath + 'Logs';
-end;
-
-function TPlatformMacOSX.GetGameSharedPath: WideString;
-begin
- Result := GetApplicationSupportPath;
-end;
-
-function TPlatformMacOSX.GetGameUserPath: WideString;
-begin
- Result := GetApplicationSupportPath;
-end;
-
-function TPlatformMacOSX.DirectoryFindFiles(Dir, Filter: WideString; ReturnAllSubDirs: boolean): TDirectoryEntryArray;
-var
- i : integer;
- TheDir : pdir;
- ADirent : pDirent;
- lAttrib : integer;
-begin
- i := 0;
- Filter := LowerCase(Filter);
-
- TheDir := FPOpenDir(Dir);
- if Assigned(TheDir) then
- repeat
- ADirent := FPReadDir(TheDir);
-
- if Assigned(ADirent) and (ADirent^.d_name <> '.') and (ADirent^.d_name <> '..') then
- begin
- lAttrib := FileGetAttr(Dir + ADirent^.d_name);
- if ReturnAllSubDirs and ((lAttrib and faDirectory) <> 0) then
- begin
- SetLength(Result, i + 1);
- Result[i].Name := ADirent^.d_name;
- Result[i].IsDirectory := true;
- Result[i].IsFile := false;
- i := i + 1;
- end
- else if (Length(Filter) = 0) or (Pos( Filter, LowerCase(ADirent^.d_name)) > 0) then
- begin
- SetLength(Result, i + 1);
- Result[i].Name := ADirent^.d_name;
- Result[i].IsDirectory := false;
- Result[i].IsFile := true;
- i := i + 1;
- end;
- end;
- until ADirent = nil;
-
- FPCloseDir(TheDir);
-end;
-
-end.
diff --git a/src/classes/UPlatformWindows.pas b/src/classes/UPlatformWindows.pas
deleted file mode 100644
index 029e8d33..00000000
--- a/src/classes/UPlatformWindows.pas
+++ /dev/null
@@ -1,236 +0,0 @@
-unit UPlatformWindows;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-// turn off messages for platform specific symbols
-{$WARN SYMBOL_PLATFORM OFF}
-
-uses
- Classes,
- UPlatform;
-
-type
- TPlatformWindows = class(TPlatform)
- private
- function GetSpecialPath(CSIDL: integer): WideString;
- public
- function DirectoryFindFiles(Dir, Filter: WideString; ReturnAllSubDirs: Boolean): TDirectoryEntryArray; override;
- function TerminateIfAlreadyRunning(var WndTitle: String): Boolean; override;
-
- function GetLogPath: WideString; override;
- function GetGameSharedPath: WideString; override;
- function GetGameUserPath: WideString; override;
-
- function CopyFile(const Source, Target: WideString; FailIfExists: boolean): boolean; override;
- end;
-
-implementation
-
-uses
- SysUtils,
- ShlObj,
- Windows,
- UConfig;
-
-type
- TSearchRecW = record
- Time: Integer;
- Size: Integer;
- Attr: Integer;
- Name: WideString;
- ExcludeAttr: Integer;
- FindHandle: THandle;
- FindData: TWin32FindDataW;
- end;
-
-function FindFirstW(const Path: WideString; Attr: Integer; var F: TSearchRecW): Integer; forward;
-function FindNextW(var F: TSearchRecW): Integer; forward;
-procedure FindCloseW(var F: TSearchRecW); forward;
-function FindMatchingFileW(var F: TSearchRecW): Integer; forward;
-function DirectoryExistsW(const Directory: widestring): Boolean; forward;
-
-function FindFirstW(const Path: widestring; Attr: Integer; var F: TSearchRecW): Integer;
-const
- faSpecial = faHidden or faSysFile or faVolumeID or faDirectory;
-begin
- F.ExcludeAttr := not Attr and faSpecial;
-{$IFDEF Delphi}
- F.FindHandle := FindFirstFileW(PWideChar(Path), F.FindData);
-{$ELSE}
- F.FindHandle := FindFirstFileW(PWideChar(Path), @F.FindData);
-{$ENDIF}
- if F.FindHandle <> INVALID_HANDLE_VALUE then
- begin
- Result := FindMatchingFileW(F);
- if Result <> 0 then FindCloseW(F);
- end else
- Result := GetLastError;
-end;
-
-function FindNextW(var F: TSearchRecW): Integer;
-begin
-{$IFDEF Delphi}
- if FindNextFileW(F.FindHandle, F.FindData) then
-{$ELSE}
- if FindNextFileW(F.FindHandle, @F.FindData) then
-{$ENDIF}
- Result := FindMatchingFileW(F)
- else
- Result := GetLastError;
-end;
-
-procedure FindCloseW(var F: TSearchRecW);
-begin
- if F.FindHandle <> INVALID_HANDLE_VALUE then
- begin
- Windows.FindClose(F.FindHandle);
- F.FindHandle := INVALID_HANDLE_VALUE;
- end;
-end;
-
-function FindMatchingFileW(var F: TSearchRecW): Integer;
-var
- LocalFileTime: TFileTime;
-begin
- with F do
- begin
- while FindData.dwFileAttributes and ExcludeAttr <> 0 do
-{$IFDEF Delphi}
- if not FindNextFileW(FindHandle, FindData) then
-{$ELSE}
- if not FindNextFileW(FindHandle, @FindData) then
-{$ENDIF}
- begin
- Result := GetLastError;
- Exit;
- end;
- FileTimeToLocalFileTime(FindData.ftLastWriteTime, LocalFileTime);
- FileTimeToDosDateTime(LocalFileTime, LongRec(Time).Hi, LongRec(Time).Lo);
- Size := FindData.nFileSizeLow;
- Attr := FindData.dwFileAttributes;
- Name := FindData.cFileName;
- end;
- Result := 0;
-end;
-
-function DirectoryExistsW(const Directory: widestring): Boolean;
-var
- Code: Integer;
-begin
- Code := GetFileAttributesW(PWideChar(Directory));
- Result := (Code <> -1) and (FILE_ATTRIBUTE_DIRECTORY and Code <> 0);
-end;
-
-//------------------------------
-//Start more than One Time Prevention
-//------------------------------
-function TPlatformWindows.TerminateIfAlreadyRunning(var WndTitle: String): Boolean;
-var
- hWnd: THandle;
- I: Integer;
-begin
- Result := false;
- hWnd:= FindWindow(nil, PChar(WndTitle));
- //Programm already started
- if (hWnd <> 0) then
- begin
- I := Messagebox(0, PChar('Another Instance of Ultrastar is already running. Continue ?'), PChar(WndTitle), MB_ICONWARNING or MB_YESNO);
- if (I = IDYes) then
- begin
- I := 1;
- repeat
- Inc(I);
- hWnd := FindWindow(nil, PChar(WndTitle + ' Instance ' + InttoStr(I)));
- until (hWnd = 0);
- WndTitle := WndTitle + ' Instance ' + InttoStr(I);
- end
- else
- Result := true;
- end;
-end;
-
-function TPlatformWindows.DirectoryFindFiles(Dir, Filter: WideString; ReturnAllSubDirs: Boolean): TDirectoryEntryArray;
-var
- i : Integer;
- SR : TSearchRecW;
- Attrib : Integer;
-begin
- i := 0;
- Filter := LowerCase(Filter);
-
- if FindFirstW(Dir + '*', faAnyFile or faDirectory, SR) = 0 then
- repeat
- if (SR.Name <> '.') and (SR.Name <> '..') then
- begin
- Attrib := FileGetAttr(Dir + SR.name);
- if ReturnAllSubDirs and ((Attrib and faDirectory) <> 0) then
- begin
- SetLength( Result, i + 1);
- Result[i].Name := SR.name;
- Result[i].IsDirectory := true;
- Result[i].IsFile := false;
- i := i + 1;
- end
- else if (Length(Filter) = 0) or (Pos( Filter, LowerCase(SR.Name)) > 0) then
- begin
- SetLength( Result, i + 1);
- Result[i].Name := SR.Name;
- Result[i].IsDirectory := false;
- Result[i].IsFile := true;
- i := i + 1;
- end;
- end;
- until FindNextW(SR) <> 0;
- FindCloseW(SR);
-end;
-
-(**
- * Returns the path of a special folder.
- *
- * Some Folder IDs:
- * CSIDL_APPDATA (e.g. C:\Documents and Settings\username\Application Data)
- * CSIDL_LOCAL_APPDATA (e.g. C:\Documents and Settings\username\Local Settings\Application Data)
- * CSIDL_PROFILE (e.g. C:\Documents and Settings\username)
- * CSIDL_PERSONAL (e.g. C:\Documents and Settings\username\My Documents)
- * CSIDL_MYMUSIC (e.g. C:\Documents and Settings\username\My Documents\My Music)
- *)
-function TPlatformWindows.GetSpecialPath(CSIDL: integer): WideString;
-var
- Buffer: array [0..MAX_PATH-1] of WideChar;
-begin
-{$IF Defined(Delphi) or (FPC_VERSION_INT >= 2002002)} // >= 2.2.2
- if (SHGetSpecialFolderPathW(0, @Buffer, CSIDL, false)) then
- Result := Buffer
- else
-{$IFEND}
- Result := '';
-end;
-
-function TPlatformWindows.GetLogPath: WideString;
-begin
- Result := GetExecutionDir();
-end;
-
-function TPlatformWindows.GetGameSharedPath: WideString;
-begin
- Result := GetExecutionDir();
-end;
-
-function TPlatformWindows.GetGameUserPath: WideString;
-begin
- //Result := GetSpecialPath(CSIDL_APPDATA) + PathDelim + 'UltraStarDX' + PathDelim;
- Result := GetExecutionDir();
-end;
-
-function TPlatformWindows.CopyFile(const Source, Target: WideString; FailIfExists: boolean): boolean;
-begin
- Result := Windows.CopyFileW(PWideChar(Source), PWideChar(Target), FailIfExists);
-end;
-
-end.
diff --git a/src/classes/UPlaylist.pas b/src/classes/UPlaylist.pas
deleted file mode 100644
index c867c356..00000000
--- a/src/classes/UPlaylist.pas
+++ /dev/null
@@ -1,490 +0,0 @@
-unit UPlaylist;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-
-uses
- USong;
-
-type
- TPlaylistItem = record
- Artist: String;
- Title: String;
- SongID: Integer;
- end;
-
- APlaylistItem = array of TPlaylistItem;
-
- TPlaylist = record
- Name: String;
- Filename: String;
- Items: APlaylistItem;
- end;
-
- APlaylist = array of TPlaylist;
-
- //----------
- //TPlaylistManager - Class for Managing Playlists (Loading, Displaying, Saving)
- //----------
- TPlaylistManager = class
- private
-
- public
- Mode: TSingMode; //Current Playlist Mode for SongScreen
- CurPlayList: Cardinal;
- CurItem: Cardinal;
-
- Playlists: APlaylist;
-
- constructor Create;
- Procedure LoadPlayLists;
- Function LoadPlayList(Index: Cardinal; Filename: String): Boolean;
- Procedure SavePlayList(Index: Cardinal);
-
- Procedure SetPlayList(Index: Cardinal);
-
- Function AddPlaylist(Name: String): Cardinal;
- Procedure DelPlaylist(const Index: Cardinal);
-
- Procedure AddItem(const SongID: Cardinal; const iPlaylist: Integer = -1);
- Procedure DelItem(const iItem: Cardinal; const iPlaylist: Integer = -1);
-
- Procedure GetNames(var PLNames: array of String);
- Function GetIndexbySongID(const SongID: Cardinal; const iPlaylist: Integer = -1): Integer;
- end;
-
- {Modes:
- 0: Standard Mode
- 1: Category Mode
- 2: PlayList Mode}
-
- var
- PlayListMan: TPlaylistManager;
-
-
-implementation
-
-uses USongs,
- ULog,
- UMain,
- //UFiles,
- UGraphic,
- UThemes,
- SysUtils;
-
-//----------
-//Create - Construct Class - Dummy for now
-//----------
-constructor TPlayListManager.Create;
-begin
- inherited;
- LoadPlayLists;
-end;
-
-//----------
-//LoadPlayLists - Load list of Playlists from PlayList Folder
-//----------
-Procedure TPlayListManager.LoadPlayLists;
-var
- SR: TSearchRec;
- Len: Integer;
- PlayListBuffer: TPlayList;
-begin
- SetLength(Playlists, 0);
-
- if FindFirst(PlayListPath + '*.upl', 0, SR) = 0 then
- begin
- repeat
- Len := Length(Playlists);
- SetLength(Playlists, Len +1);
-
- if not LoadPlayList (Len, Sr.Name) then
- SetLength(Playlists, Len)
- else
- begin
- // Sort the Playlists - Insertion Sort
- PlayListBuffer := Playlists[Len];
- Dec(Len);
- while (Len >= 0) AND (CompareText(Playlists[Len].Name, PlayListBuffer.Name) >= 0) do
- begin
- Playlists[Len+1] := Playlists[Len];
- Dec(Len);
- end;
- Playlists[Len+1] := PlayListBuffer;
- end;
-
- until FindNext(SR) <> 0;
- FindClose(SR);
- end;
-end;
-
-//----------
-//LoadPlayList - Load a Playlist in the Array
-//----------
-Function TPlayListManager.LoadPlayList(Index: Cardinal; Filename: String): Boolean;
- var
- F: TextFile;
- Line: String;
- PosDelimiter: Integer;
- SongID: Integer;
- Len: Integer;
-
- Function FindSong(Artist, Title: String): Integer;
- var I: Integer;
- begin
- Result := -1;
-
- For I := low(CatSongs.Song) to high(CatSongs.Song) do
- begin
- if (CatSongs.Song[I].Title = Title) AND (CatSongs.Song[I].Artist = Artist) then
- begin
- Result := I;
- Break;
- end;
- end;
- end;
-begin
- if not FileExists(PlayListPath + Filename) then
- begin
- Log.LogError('Could not load Playlist: ' + Filename);
- Result := False;
- Exit;
- end;
- Result := True;
-
- //Load File
- AssignFile(F, PlayListPath + FileName);
- Reset(F);
-
- //Set Filename
- PlayLists[Index].Filename := Filename;
- PlayLists[Index].Name := '';
-
- //Read Until End of File
- While not Eof(F) do
- begin
- //Read Curent Line
- Readln(F, Line);
-
- if (Length(Line) > 0) then
- begin
- PosDelimiter := Pos(':', Line);
- if (PosDelimiter <> 0) then
- begin
- //Comment or Name String
- if (Line[1] = '#') then
- begin
- //Found Name Value
- if (Uppercase(Trim(copy(Line, 2, PosDelimiter - 2))) = 'NAME') then
- PlayLists[Index].Name := Trim(copy(Line, PosDelimiter + 1,Length(Line) - PosDelimiter))
-
- end
- //Song Entry
- else
- begin
- SongID := FindSong(Trim(copy(Line, 1, PosDelimiter - 1)), Trim(copy(Line, PosDelimiter + 1, Length(Line) - PosDelimiter)));
- if (SongID <> -1) then
- begin
- Len := Length(PlayLists[Index].Items);
- SetLength(PlayLists[Index].Items, Len + 1);
-
- PlayLists[Index].Items[Len].SongID := SongID;
-
- PlayLists[Index].Items[Len].Artist := Trim(copy(Line, 1, PosDelimiter - 1));
- PlayLists[Index].Items[Len].Title := Trim(copy(Line, PosDelimiter + 1, Length(Line) - PosDelimiter));
- end
- else Log.LogError('Could not find Song in Playlist: ' + PlayLists[Index].Filename + ', ' + Line);
- end;
- end;
- end;
- end;
-
- //If no special name is given, use Filename
- if PlayLists[Index].Name = '' then
- begin
- PlayLists[Index].Name := ChangeFileExt(FileName, '');
- end;
-
- //Finish (Close File)
- CloseFile(F);
-end;
-
-//----------
-//SavePlayList - Saves the specified Playlist
-//----------
-Procedure TPlayListManager.SavePlayList(Index: Cardinal);
-var
- F: TextFile;
- I: Integer;
-begin
- if (Not FileExists(PlaylistPath + Playlists[Index].Filename)) OR (Not FileisReadOnly(PlaylistPath + Playlists[Index].Filename)) then
- begin
-
- //open File for Rewriting
- AssignFile(F, PlaylistPath + Playlists[Index].Filename);
- try
- try
- Rewrite(F);
-
- //Write Version (not nessecary but helpful)
- WriteLn(F, '######################################');
- WriteLn(F, '#Ultrastar Deluxe Playlist Format v1.0');
- WriteLn(F, '#Playlist "' + Playlists[Index].Name + '" with ' + InttoStr(Length(Playlists[Index].Items)) + ' Songs.');
- WriteLn(F, '######################################');
-
- //Write Name Information
- WriteLn(F, '#Name: ' + Playlists[Index].Name);
-
- //Write Song Information
- WriteLn(F, '#Songs:');
-
- For I := 0 to high(Playlists[Index].Items) do
- begin
- WriteLn(F, Playlists[Index].Items[I].Artist + ' : ' + Playlists[Index].Items[I].Title);
- end;
- except
- log.LogError('Could not write Playlistfile "' + Playlists[Index].Name + '"');
- end;
- finally
- CloseFile(F);
- end;
- end;
-end;
-
-//----------
-//SetPlayList - Display a Playlist in CatSongs
-//----------
-Procedure TPlayListManager.SetPlayList(Index: Cardinal);
-var
- I: Integer;
-begin
- If (Int(Index) > High(PlayLists)) then
- exit;
-
- //Hide all Songs
- For I := 0 to high(CatSongs.Song) do
- CatSongs.Song[I].Visible := False;
-
- //Show Songs in PL
- For I := 0 to high(PlayLists[Index].Items) do
- begin
- CatSongs.Song[PlayLists[Index].Items[I].SongID].Visible := True;
- end;
-
- //Set CatSongsMode + Playlist Mode
- CatSongs.CatNumShow := -3;
- Mode := smPlayListRandom;
-
- //Set CurPlaylist
- CurPlaylist := Index;
-
- //Show Cat in Topleft:
- ScreenSong.ShowCatTLCustom(Format(Theme.Playlist.CatText,[Playlists[Index].Name]));
-
- //Fix SongSelection
- ScreenSong.Interaction := 0;
- ScreenSong.SelectNext;
- ScreenSong.FixSelected;
-
- //Play correct Music
- ScreenSong.ChangeMusic;
-end;
-
-//----------
-//AddPlaylist - Adds a Playlist and Returns the Index
-//----------
-Function TPlayListManager.AddPlaylist(Name: String): Cardinal;
-var
- I: Integer;
-begin
- Result := Length(Playlists);
- SetLength(Playlists, Result + 1);
-
- // Sort the Playlists - Insertion Sort
- while (Result > 0) AND (CompareText(Playlists[Result - 1].Name, Name) >= 0) do
- begin
- Dec(Result);
- Playlists[Result+1] := Playlists[Result];
- end;
- Playlists[Result].Name := Name;
-
- I := 1;
- if (not FileExists(PlaylistPath + Name + '.upl')) then
- Playlists[Result].Filename := Name + '.upl'
- else
- begin
- repeat
- Inc(I);
- until not FileExists(PlaylistPath + Name + InttoStr(I) + '.upl');
- Playlists[Result].Filename := Name + InttoStr(I) + '.upl';
- end;
-
- //Save new Playlist
- SavePlayList(Result);
-end;
-
-//----------
-//DelPlaylist - Deletes a Playlist
-//----------
-Procedure TPlayListManager.DelPlaylist(const Index: Cardinal);
-var
- I: Integer;
- Filename: String;
-begin
- If Int(Index) > High(Playlists) then
- Exit;
-
- Filename := PlaylistPath + Playlists[Index].Filename;
-
- //If not FileExists or File is not Writeable then exit
- If (Not FileExists(Filename)) OR (FileisReadOnly(Filename)) then
- Exit;
-
-
- //Delete Playlist from FileSystem
- if Not DeleteFile(Filename) then
- Exit;
-
- //Delete Playlist from Array
- //move all PLs to the Hole
- For I := Index to High(Playlists)-1 do
- PlayLists[I] := PlayLists[I+1];
-
- //Delete last Playlist
- SetLength (Playlists, High(Playlists));
-
- //If Playlist is Displayed atm
- //-> Display Songs
- if (CatSongs.CatNumShow = -3) and (Index = CurPlaylist) then
- begin
- ScreenSong.UnLoadDetailedCover;
- ScreenSong.HideCatTL;
- CatSongs.SetFilter('', 0);
- ScreenSong.Interaction := 0;
- ScreenSong.FixSelected;
- ScreenSong.ChangeMusic;
- end;
-end;
-
-//----------
-//AddItem - Adds an Item to a specific Playlist
-//----------
-Procedure TPlayListManager.AddItem(const SongID: Cardinal; const iPlaylist: Integer);
-var
- P: Cardinal;
- Len: Cardinal;
-begin
- if iPlaylist = -1 then
- P := CurPlaylist
- else if (iPlaylist >= 0) AND (iPlaylist <= high(Playlists)) then
- P := iPlaylist
- else
- exit;
-
- if (Int(SongID) <= High(CatSongs.Song)) AND (NOT CatSongs.Song[SongID].Main) then
- begin
- Len := Length(Playlists[P].Items);
- SetLength(Playlists[P].Items, Len + 1);
-
- Playlists[P].Items[Len].SongID := SongID;
- Playlists[P].Items[Len].Title := CatSongs.Song[SongID].Title;
- Playlists[P].Items[Len].Artist := CatSongs.Song[SongID].Artist;
-
- //Save Changes
- SavePlayList(P);
-
- //Correct Display when Editing current Playlist
- if (CatSongs.CatNumShow = -3) and (P = CurPlaylist) then
- SetPlaylist(P);
- end;
-end;
-
-//----------
-//DelItem - Deletes an Item from a specific Playlist
-//----------
-Procedure TPlayListManager.DelItem(const iItem: Cardinal; const iPlaylist: Integer);
-var
- I: Integer;
- P: Cardinal;
-begin
- if iPlaylist = -1 then
- P := CurPlaylist
- else if (iPlaylist >= 0) AND (iPlaylist <= high(Playlists)) then
- P := iPlaylist
- else
- exit;
-
- if (Int(iItem) <= high(Playlists[P].Items)) then
- begin
- //Move all entrys behind deleted one to Front
- For I := iItem to High(Playlists[P].Items) - 1 do
- Playlists[P].Items[I] := Playlists[P].Items[I + 1];
-
- //Delete Last Entry
- SetLength(PlayLists[P].Items, Length(PlayLists[P].Items) - 1);
-
- //Save Changes
- SavePlayList(P);
- end;
-
- //Delete Playlist if Last Song is deleted
- if (Length(PlayLists[P].Items) = 0) then
- begin
- DelPlaylist(P);
- end
- //Correct Display when Editing current Playlist
- else if (CatSongs.CatNumShow = -3) and (P = CurPlaylist) then
- SetPlaylist(P);
-end;
-
-//----------
-//GetNames - Writes Playlist Names in a Array
-//----------
-Procedure TPlayListManager.GetNames(var PLNames: array of String);
-var
- I: Integer;
- Len: Integer;
-begin
- Len := High(Playlists);
-
- if (Length(PLNames) <> Len + 1) then
- exit;
-
- For I := 0 to Len do
- PLNames[I] := Playlists[I].Name;
-end;
-
-//----------
-//GetIndexbySongID - Returns Index in the specified Playlist of the given Song
-//----------
-Function TPlayListManager.GetIndexbySongID(const SongID: Cardinal; const iPlaylist: Integer): Integer;
-var
- P: Integer;
- I: Integer;
-begin
- Result := -1;
-
- if iPlaylist = -1 then
- P := CurPlaylist
- else if (iPlaylist >= 0) AND (iPlaylist <= high(Playlists)) then
- P := iPlaylist
- else
- exit;
-
- For I := 0 to high(Playlists[P].Items) do
- begin
- if (Playlists[P].Items[I].SongID = Int(SongID)) then
- begin
- Result := I;
- Break;
- end;
- end;
-end;
-
-end.
diff --git a/src/classes/UPluginInterface.pas b/src/classes/UPluginInterface.pas
deleted file mode 100644
index 77693d0f..00000000
--- a/src/classes/UPluginInterface.pas
+++ /dev/null
@@ -1,156 +0,0 @@
-unit uPluginInterface;
-{*********************
- uPluginInterface
- Unit fills a TPluginInterface Structur with Method Pointers
- Unit Contains all Functions called directly by Plugins
-*********************}
-
-interface
-
-{$I switches.inc}
-
-uses uPluginDefs;
-
-//---------------
-// Methods for Plugin
-//---------------
- {******** Hook specific Methods ********}
- {Function Creates a new Hookable Event and Returns the Handle
- or 0 on Failure. (Name already exists)}
- Function CreateHookableEvent (EventName: PChar): THandle; stdcall;
-
- {Function Destroys an Event and Unhooks all Hooks to this Event.
- 0 on success, not 0 on Failure}
- Function DestroyHookableEvent (hEvent: THandle): integer; stdcall;
-
- {Function start calling the Hook Chain
- 0 if Chain is called until the End, -1 if Event Handle is not valid
- otherwise Return Value of the Hook that breaks the Chain}
- Function NotivyEventHooks (hEvent: THandle; wParam: TwParam; lParam: TlParam): integer; stdcall;
-
- {Function Hooks an Event by Name.
- Returns Hook Handle on Success, otherwise 0}
- Function HookEvent (EventName: PChar; HookProc: TUS_Hook): THandle; stdcall;
-
- {Function Removes the Hook from the Chain
- Returns 0 on Success}
- Function UnHookEvent (hHook: THandle): Integer; stdcall;
-
- {Function Returns Non Zero if a Event with the given Name Exists,
- otherwise 0}
- Function EventExists (EventName: PChar): Integer; stdcall;
-
- {******** Service specific Methods ********}
- {Function Creates a new Service and Returns the Services Handle
- or 0 on Failure. (Name already exists)}
- Function CreateService (ServiceName: PChar; ServiceProc: TUS_Service): THandle; stdcall;
-
- {Function Destroys a Service.
- 0 on success, not 0 on Failure}
- Function DestroyService (hService: THandle): integer; stdcall;
-
- {Function Calls a Services Proc
- Returns Services Return Value or SERVICE_NOT_FOUND on Failure}
- Function CallService (ServiceName: PChar; wParam: TwParam; lParam: TlParam): integer; stdcall;
-
- {Function Returns Non Zero if a Service with the given Name Exists,
- otherwise 0}
- Function ServiceExists (ServiceName: PChar): Integer; stdcall;
-
-implementation
-uses UCore;
-
-{******** Hook specific Methods ********}
-//---------------
-// Function Creates a new Hookable Event and Returns the Handle
-// or 0 on Failure. (Name already exists)
-//---------------
-Function CreateHookableEvent (EventName: PChar): THandle; stdcall;
-begin
- Result := Core.Hooks.AddEvent(EventName);
-end;
-
-//---------------
-// Function Destroys an Event and Unhooks all Hooks to this Event.
-// 0 on success, not 0 on Failure
-//---------------
-Function DestroyHookableEvent (hEvent: THandle): integer; stdcall;
-begin
- Result := Core.Hooks.DelEvent(hEvent);
-end;
-
-//---------------
-// Function start calling the Hook Chain
-// 0 if Chain is called until the End, -1 if Event Handle is not valid
-// otherwise Return Value of the Hook that breaks the Chain
-//---------------
-Function NotivyEventHooks (hEvent: THandle; wParam: TwParam; lParam: TlParam): integer; stdcall;
-begin
- Result := Core.Hooks.CallEventChain(hEvent, wParam, lParam);
-end;
-
-//---------------
-// Function Hooks an Event by Name.
-// Returns Hook Handle on Success, otherwise 0
-//---------------
-Function HookEvent (EventName: PChar; HookProc: TUS_Hook): THandle; stdcall;
-begin
- Result := Core.Hooks.AddSubscriber(EventName, HookProc);
-end;
-
-//---------------
-// Function Removes the Hook from the Chain
-// Returns 0 on Success
-//---------------
-Function UnHookEvent (hHook: THandle): Integer; stdcall;
-begin
- Result := Core.Hooks.DelSubscriber(hHook);
-end;
-
-//---------------
-// Function Returns Non Zero if a Event with the given Name Exists,
-// otherwise 0
-//---------------
-Function EventExists (EventName: PChar): Integer; stdcall;
-begin
- Result := Core.Hooks.EventExists(EventName);
-end;
-
- {******** Service specific Methods ********}
-//---------------
-// Function Creates a new Service and Returns the Services Handle
-// or 0 on Failure. (Name already exists)
-//---------------
-Function CreateService (ServiceName: PChar; ServiceProc: TUS_Service): THandle; stdcall;
-begin
- Result := Core.Services.AddService(ServiceName, ServiceProc);
-end;
-
-//---------------
-// Function Destroys a Service.
-// 0 on success, not 0 on Failure
-//---------------
-Function DestroyService (hService: THandle): integer; stdcall;
-begin
- Result := Core.Services.DelService(hService);
-end;
-
-//---------------
-// Function Calls a Services Proc
-// Returns Services Return Value or SERVICE_NOT_FOUND on Failure
-//---------------
-Function CallService (ServiceName: PChar; wParam: TwParam; lParam: TlParam): integer; stdcall;
-begin
- Result := Core.Services.CallService(ServiceName, wParam, lParam);
-end;
-
-//---------------
-// Function Returns Non Zero if a Service with the given Name Exists,
-// otherwise 0
-//---------------
-Function ServiceExists (ServiceName: PChar): Integer; stdcall;
-begin
- Result := Core.Services.ServiceExists(ServiceName);
-end;
-
-end.
diff --git a/src/classes/URecord.pas b/src/classes/URecord.pas
deleted file mode 100644
index 8a537dc9..00000000
--- a/src/classes/URecord.pas
+++ /dev/null
@@ -1,766 +0,0 @@
-unit URecord;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses Classes,
- Math,
- SysUtils,
- sdl,
- UCommon,
- UMusic,
- UIni;
-
-const
- BaseToneFreq = 65.4064; // lowest (half-)tone to analyze (C2 = 65.4064 Hz)
- NumHalftones = 36; // C2-B4 (for Whitney and my high voice)
-
-type
- TCaptureBuffer = class
- private
- VoiceStream: TAudioVoiceStream; // stream for voice passthrough
- AnalysisBufferLock: PSDL_Mutex;
-
- function GetToneString: string; // converts a tone to its string represenatation;
-
- procedure BoostBuffer(Buffer: PChar; Size: Cardinal);
- procedure ProcessNewBuffer(Buffer: PChar; BufferSize: integer);
-
- // we call it to analyze sound by checking Autocorrelation
- procedure AnalyzeByAutocorrelation;
- // use this to check one frequency by Autocorrelation
- function AnalyzeAutocorrelationFreq(Freq: real): real;
- public
- AnalysisBuffer: array[0..4095] of smallint; // newest 4096 samples
- AnalysisBufferSize: integer; // number of samples of BufferArray to analyze
-
- LogBuffer: TMemoryStream; // full buffer
-
- AudioFormat: TAudioFormatInfo;
-
- // pitch detection
- // TODO: remove ToneValid, set Tone/ToneAbs=-1 if invalid instead
- ToneValid: boolean; // true if Tone contains a valid value (otherwise it contains noise)
- Tone: integer; // tone relative to one octave (e.g. C2=C3=C4). Range: 0-11
- ToneAbs: integer; // absolute (full range) tone (e.g. C2<>C3). Range: 0..NumHalftones-1
-
- // methods
- constructor Create;
- destructor Destroy; override;
-
- procedure Clear;
-
- // use to analyze sound from buffers to get new pitch
- procedure AnalyzeBuffer;
- procedure LockAnalysisBuffer(); {$IFDEF HasInline}inline;{$ENDIF}
- procedure UnlockAnalysisBuffer(); {$IFDEF HasInline}inline;{$ENDIF}
-
- function MaxSampleVolume: Single;
- property ToneString: string READ GetToneString;
- end;
-
-const
- DEFAULT_SOURCE_NAME = '[Default]';
-
-type
- TAudioInputSource = record
- Name: string;
- end;
-
- // soundcard input-devices information
- TAudioInputDevice = class
- public
- CfgIndex: integer; // index of this device in Ini.InputDeviceConfig
- Name: string; // soundcard name
- Source: array of TAudioInputSource; // soundcard input-sources
- SourceRestore: integer; // source-index that will be selected after capturing (-1: not detected)
- MicSource: integer; // source-index of mic (-1: none detected)
-
- AudioFormat: TAudioFormatInfo; // capture format info (e.g. 44.1kHz SInt16 stereo)
- CaptureChannel: array of TCaptureBuffer; // sound-buffer references used for mono or stereo channel's capture data
-
- destructor Destroy; override;
-
- procedure LinkCaptureBuffer(ChannelIndex: integer; Sound: TCaptureBuffer);
-
- // TODO: add Open/Close functions so Start/Stop becomes faster
- //function Open(): boolean; virtual; abstract;
- //function Close(): boolean; virtual; abstract;
- function Start(): boolean; virtual; abstract;
- function Stop(): boolean; virtual; abstract;
-
- function GetVolume(): single; virtual; abstract;
- procedure SetVolume(Volume: single); virtual; abstract;
- end;
-
- TAudioInputProcessor = class
- public
- Sound: array of TCaptureBuffer; // sound-buffers for every player
- DeviceList: array of TAudioInputDevice;
-
- constructor Create;
- destructor Destroy; override;
-
- procedure UpdateInputDeviceConfig;
-
- // handle microphone input
- procedure HandleMicrophoneData(Buffer: PChar; Size: Cardinal;
- InputDevice: TAudioInputDevice);
- end;
-
- TAudioInputBase = class( TInterfacedObject, IAudioInput )
- private
- Started: boolean;
- protected
- function UnifyDeviceName(const name: string; deviceIndex: integer): string;
- public
- function GetName: String; virtual; abstract;
- function InitializeRecord: boolean; virtual; abstract;
- function FinalizeRecord: boolean; virtual;
-
- procedure CaptureStart;
- procedure CaptureStop;
- end;
-
-
- TSmallIntArray = array [0..(MaxInt div SizeOf(SmallInt))-1] of SmallInt;
- PSmallIntArray = ^TSmallIntArray;
-
- function AudioInputProcessor(): TAudioInputProcessor;
-
-implementation
-
-uses
- ULog,
- UMain;
-
-var
- singleton_AudioInputProcessor : TAudioInputProcessor = nil;
-
-
-{ Global }
-
-function AudioInputProcessor(): TAudioInputProcessor;
-begin
- if singleton_AudioInputProcessor = nil then
- singleton_AudioInputProcessor := TAudioInputProcessor.create();
-
- result := singleton_AudioInputProcessor;
-end;
-
-
-{ TAudioInputDevice }
-
-destructor TAudioInputDevice.Destroy;
-begin
- Stop();
- Source := nil;
- CaptureChannel := nil;
- FreeAndNil(AudioFormat);
- inherited Destroy;
-end;
-
-procedure TAudioInputDevice.LinkCaptureBuffer(ChannelIndex: integer; Sound: TCaptureBuffer);
-var
- DeviceCfg: PInputDeviceConfig;
- OldSound: TCaptureBuffer;
-begin
- // check bounds
- if ((ChannelIndex < 0) or (ChannelIndex > High(CaptureChannel))) then
- Exit;
-
- // reset previously assigned (old) capture-buffer
- OldSound := CaptureChannel[ChannelIndex];
- if (OldSound <> nil) then
- begin
- // close voice stream
- FreeAndNil(OldSound.VoiceStream);
- // free old audio-format info
- FreeAndNil(OldSound.AudioFormat);
- end;
-
- // set audio-format of new capture-buffer
- if (Sound <> nil) then
- begin
- // copy the input-device audio-format ...
- Sound.AudioFormat := AudioFormat.Copy;
- // and adjust it because capture buffers are always mono
- Sound.AudioFormat.Channels := 1;
- DeviceCfg := @Ini.InputDeviceConfig[CfgIndex];
-
- if (Ini.VoicePassthrough = 1) then
- begin
- // TODO: map odd players to the left and even players to the right speaker
- Sound.VoiceStream := AudioPlayback.CreateVoiceStream(CHANNELMAP_FRONT, AudioFormat);
- end;
- end;
-
- // replace old with new buffer (Note: Sound might be nil)
- CaptureChannel[ChannelIndex] := Sound;
-end;
-
-{ TSound }
-
-constructor TCaptureBuffer.Create;
-begin
- inherited;
- LogBuffer := TMemoryStream.Create;
- AnalysisBufferLock := SDL_CreateMutex();
- AnalysisBufferSize := Length(AnalysisBuffer);
-end;
-
-destructor TCaptureBuffer.Destroy;
-begin
- FreeAndNil(LogBuffer);
- FreeAndNil(VoiceStream);
- FreeAndNil(AudioFormat);
- SDL_DestroyMutex(AnalysisBufferLock);
- inherited;
-end;
-
-procedure TCaptureBuffer.LockAnalysisBuffer();
-begin
- SDL_mutexP(AnalysisBufferLock);
-end;
-
-procedure TCaptureBuffer.UnlockAnalysisBuffer();
-begin
- SDL_mutexV(AnalysisBufferLock);
-end;
-
-procedure TCaptureBuffer.Clear;
-begin
- if assigned(LogBuffer) then
- LogBuffer.Clear;
- LockAnalysisBuffer();
- FillChar(AnalysisBuffer[0], Length(AnalysisBuffer) * SizeOf(SmallInt), 0);
- UnlockAnalysisBuffer();
-end;
-
-procedure TCaptureBuffer.ProcessNewBuffer(Buffer: PChar; BufferSize: integer);
-var
- BufferOffset: integer;
- SampleCount: integer;
- i: integer;
-begin
- // apply software boost
- //BoostBuffer(Buffer, Size);
-
- // voice passthrough (send data to playback-device)
- if (assigned(VoiceStream)) then
- VoiceStream.WriteData(Buffer, BufferSize);
-
- // we assume that samples are in S16Int format
- // TODO: support float too
- if (AudioFormat.Format <> asfS16) then
- Exit;
-
- // process BufferArray
- BufferOffset := 0;
-
- SampleCount := BufferSize div SizeOf(SmallInt);
-
- // check if we have more new samples than we can store
- if (SampleCount > Length(AnalysisBuffer)) then
- begin
- // discard the oldest of the new samples
- BufferOffset := (SampleCount - Length(AnalysisBuffer)) * SizeOf(SmallInt);
- SampleCount := Length(AnalysisBuffer);
- end;
-
-
- LockAnalysisBuffer();
- try
-
- // move old samples to the beginning of the array (if necessary)
- for i := 0 to High(AnalysisBuffer)-SampleCount do
- AnalysisBuffer[i] := AnalysisBuffer[i+SampleCount];
-
- // copy new samples to analysis buffer
- Move(Buffer[BufferOffset], AnalysisBuffer[Length(AnalysisBuffer)-SampleCount],
- SampleCount * SizeOf(SmallInt));
-
- finally
- UnlockAnalysisBuffer();
- end;
-
-
- // save capture-data to BufferLong if enabled
- if (Ini.SavePlayback = 1) then
- begin
- // this is just for debugging (approx 15MB per player for a 3min song!!!)
- // For an in-game replay-mode we need to compress data so we do not
- // waste that much memory. Maybe ogg-vorbis with voice-preset in fast-mode?
- // Or we could use a faster but not that efficient lossless compression.
- LogBuffer.WriteBuffer(Buffer, BufferSize);
- end;
-end;
-
-procedure TCaptureBuffer.AnalyzeBuffer;
-var
- Volume: single;
- MaxVolume: single;
- SampleIndex: integer;
- Threshold: single;
-begin
- ToneValid := false;
- ToneAbs := -1;
- Tone := -1;
-
- LockAnalysisBuffer();
- try
-
- // find maximum volume of first 1024 samples
- MaxVolume := 0;
- for SampleIndex := 0 to 1023 do
- begin
- Volume := Abs(AnalysisBuffer[SampleIndex]) / -Low(Smallint);
- if Volume > MaxVolume then
- MaxVolume := Volume;
- end;
-
- Threshold := IThresholdVals[Ini.ThresholdIndex];
-
- // check if signal has an acceptable volume (ignore background-noise)
- if MaxVolume >= Threshold then
- begin
- // analyse the current voice pitch
- AnalyzeByAutocorrelation;
- ToneValid := true;
- end;
-
- finally
- UnlockAnalysisBuffer();
- end;
-end;
-
-procedure TCaptureBuffer.AnalyzeByAutocorrelation;
-var
- ToneIndex: integer;
- CurFreq: real;
- CurWeight: real;
- MaxWeight: real;
- MaxTone: integer;
-const
- HalftoneBase = 1.05946309436; // 2^(1/12) -> HalftoneBase^12 = 2 (one octave)
-begin
- // prepare to analyze
- MaxWeight := -1;
- MaxTone := 0; // this is not needed, but it satifies the compiler
-
- // analyze halftones
- // Note: at the lowest tone (~65Hz) and a buffer-size of 4096
- // at 44.1 (or 48kHz) only 6 (or 5) samples are compared, this might be
- // too few samples -> use a bigger buffer-size
- for ToneIndex := 0 to NumHalftones-1 do
- begin
- CurFreq := BaseToneFreq * Power(HalftoneBase, ToneIndex);
- CurWeight := AnalyzeAutocorrelationFreq(CurFreq);
-
- // TODO: prefer higher frequencies (use >= or use downto)
- if (CurWeight > MaxWeight) then
- begin
- // this frequency has a higher weight
- MaxWeight := CurWeight;
- MaxTone := ToneIndex;
- end;
- end;
-
- ToneAbs := MaxTone;
- Tone := MaxTone mod 12;
-end;
-
-// result medium difference
-function TCaptureBuffer.AnalyzeAutocorrelationFreq(Freq: real): real;
-var
- Dist: real; // distance (0=equal .. 1=totally different) between correlated samples
- AccumDist: real; // accumulated distances
- SampleIndex: integer; // index of sample to analyze
- CorrelatingSampleIndex: integer; // index of sample one period ahead
- SamplesPerPeriod: integer; // samples in one period
-begin
- SampleIndex := 0;
- SamplesPerPeriod := Round(AudioFormat.SampleRate/Freq);
- CorrelatingSampleIndex := SampleIndex + SamplesPerPeriod;
-
- AccumDist := 0;
-
- // compare correlating samples
- while (CorrelatingSampleIndex < AnalysisBufferSize) do
- begin
- // calc distance (correlation: 1-dist) to corresponding sample in next period
- Dist := Abs(AnalysisBuffer[SampleIndex] - AnalysisBuffer[CorrelatingSampleIndex]) /
- High(Word);
- AccumDist := AccumDist + Dist;
- Inc(SampleIndex);
- Inc(CorrelatingSampleIndex);
- end;
-
- // return "inverse" average distance (=correlation)
- Result := 1 - AccumDist / AnalysisBufferSize;
-end;
-
-function TCaptureBuffer.MaxSampleVolume: Single;
-var
- lSampleIndex: Integer;
- lMaxVol : Longint;
-begin;
- LockAnalysisBuffer();
- try
- lMaxVol := 0;
- for lSampleIndex := 0 to High(AnalysisBuffer) do
- begin
- if Abs(AnalysisBuffer[lSampleIndex]) > lMaxVol then
- lMaxVol := Abs(AnalysisBuffer[lSampleIndex]);
- end;
- finally
- UnlockAnalysisBuffer();
- end;
-
- result := lMaxVol / -Low(Smallint);
-end;
-
-const
- ToneStrings: array[0..11] of string = (
- 'C', 'C#', 'D', 'D#', 'E', 'F', 'F#', 'G', 'G#', 'A', 'A#', 'B'
- );
-
-function TCaptureBuffer.GetToneString: string;
-begin
- if (ToneValid) then
- Result := ToneStrings[Tone] + IntToStr(ToneAbs div 12 + 2)
- else
- Result := '-';
-end;
-
-procedure TCaptureBuffer.BoostBuffer(Buffer: PChar; Size: Cardinal);
-var
- i: integer;
- Value: Longint;
- SampleCount: integer;
- SampleBuffer: PSmallIntArray; // buffer handled as array of samples
- Boost: byte;
-begin
- // TODO: set boost per device
- {
- case Ini.MicBoost of
- 0: Boost := 1;
- 1: Boost := 2;
- 2: Boost := 4;
- 3: Boost := 8;
- else Boost := 1;
- end;
- }
- Boost := 1;
-
- // at the moment we will boost SInt16 data only
- if (AudioFormat.Format = asfS16) then
- begin
- // interpret buffer as buffer of bytes
- SampleBuffer := PSmallIntArray(Buffer);
- SampleCount := Size div AudioFormat.FrameSize;
-
- // boost buffer
- for i := 0 to SampleCount-1 do
- begin
- Value := SampleBuffer^[i] * Boost;
-
- // TODO : JB - This will clip the audio... cant we reduce the "Boost" if the data clips ??
- if Value > High(Smallint) then
- Value := High(Smallint);
-
- if Value < Low(Smallint) then
- Value := Low(Smallint);
-
- SampleBuffer^[i] := Value;
- end;
- end;
-end;
-
-
-{ TAudioInputProcessor }
-
-constructor TAudioInputProcessor.Create;
-var
- i: integer;
-begin
- inherited;
- SetLength(Sound, 6 {max players});//Ini.Players+1);
- for i := 0 to High(Sound) do
- Sound[i] := TCaptureBuffer.Create;
-end;
-
-destructor TAudioInputProcessor.Destroy;
-var
- i: integer;
-begin
- for i := 0 to High(Sound) do
- Sound[i].Free;
- SetLength(Sound, 0);
- inherited;
-end;
-
-// updates InputDeviceConfig with current input-device information
-// See: TIni.LoadInputDeviceCfg()
-procedure TAudioInputProcessor.UpdateInputDeviceConfig;
-var
- deviceIndex: integer;
- newDevice: boolean;
- deviceIniIndex: integer;
- deviceCfg: PInputDeviceConfig;
- device: TAudioInputDevice;
- channelCount: integer;
- channelIndex: integer;
- i: integer;
-begin
- // Input devices - append detected soundcards
- for deviceIndex := 0 to High(DeviceList) do
- begin
- newDevice := true;
- //Search for Card in List
- for deviceIniIndex := 0 to High(Ini.InputDeviceConfig) do
- begin
- deviceCfg := @Ini.InputDeviceConfig[deviceIniIndex];
- device := DeviceList[deviceIndex];
-
- if (deviceCfg.Name = Trim(device.Name)) then
- begin
- newDevice := false;
-
- // store highest channel index as an offset for the new channels
- channelIndex := High(deviceCfg.ChannelToPlayerMap);
- // add missing channels or remove non-existing ones
- SetLength(deviceCfg.ChannelToPlayerMap, device.AudioFormat.Channels);
- // initialize added channels to 0
- for i := channelIndex+1 to High(deviceCfg.ChannelToPlayerMap) do
- begin
- deviceCfg.ChannelToPlayerMap[i] := 0;
- end;
-
- // associate ini-index with device
- device.CfgIndex := deviceIniIndex;
- break;
- end;
- end;
-
- //If not in List -> Add
- if newDevice then
- begin
- // resize list
- SetLength(Ini.InputDeviceConfig, Length(Ini.InputDeviceConfig)+1);
- deviceCfg := @Ini.InputDeviceConfig[High(Ini.InputDeviceConfig)];
- device := DeviceList[deviceIndex];
-
- // associate ini-index with device
- device.CfgIndex := High(Ini.InputDeviceConfig);
-
- deviceCfg.Name := Trim(device.Name);
- deviceCfg.Input := 0;
-
- channelCount := device.AudioFormat.Channels;
- SetLength(deviceCfg.ChannelToPlayerMap, channelCount);
-
- for channelIndex := 0 to channelCount-1 do
- begin
- // set default at first start of USDX (1st device, 1st channel -> player1)
- if ((channelIndex = 0) and (device.CfgIndex = 0)) then
- deviceCfg.ChannelToPlayerMap[0] := 1
- else
- deviceCfg.ChannelToPlayerMap[channelIndex] := 0;
- end;
- end;
- end;
-end;
-
-{*
- * Handles captured microphone input data.
- * Params:
- * Buffer - buffer of signed 16bit interleaved stereo PCM-samples.
- * Interleaved means that a right-channel sample follows a left-
- * channel sample and vice versa (0:left[0],1:right[0],2:left[1],...).
- * Length - number of bytes in Buffer
- * Input - Soundcard-Input used for capture
- *}
-procedure TAudioInputProcessor.HandleMicrophoneData(Buffer: PChar; Size: Cardinal; InputDevice: TAudioInputDevice);
-var
- MultiChannelBuffer: PChar; // buffer handled as array of bytes (offset relative to channel)
- SingleChannelBuffer: PChar; // temporary buffer for new samples per channel
- SingleChannelBufferSize: integer;
- ChannelIndex: integer;
- CaptureChannel: TCaptureBuffer;
- AudioFormat: TAudioFormatInfo;
- SampleSize: integer;
- SampleCount: integer;
- SamplesPerChannel: integer;
- i: integer;
-begin
- AudioFormat := InputDevice.AudioFormat;
- SampleSize := AudioSampleSize[AudioFormat.Format];
- SampleCount := Size div SampleSize;
- SamplesPerChannel := Size div AudioFormat.FrameSize;
-
- SingleChannelBufferSize := SamplesPerChannel * SampleSize;
- GetMem(SingleChannelBuffer, SingleChannelBufferSize);
-
- // process channels
- for ChannelIndex := 0 to High(InputDevice.CaptureChannel) do
- begin
- CaptureChannel := InputDevice.CaptureChannel[ChannelIndex];
- // check if a capture buffer was assigned, otherwise there is nothing to do
- if (CaptureChannel <> nil) then
- begin
- // set offset according to channel index
- MultiChannelBuffer := @Buffer[ChannelIndex * SampleSize];
- // seperate channel-data from interleaved multi-channel (e.g. stereo) data
- for i := 0 to SamplesPerChannel-1 do
- begin
- Move(MultiChannelBuffer[i*AudioFormat.FrameSize],
- SingleChannelBuffer[i*SampleSize],
- SampleSize);
- end;
- CaptureChannel.ProcessNewBuffer(SingleChannelBuffer, SingleChannelBufferSize);
- end;
- end;
-
- FreeMem(SingleChannelBuffer);
-end;
-
-
-{ TAudioInputBase }
-
-function TAudioInputBase.FinalizeRecord: boolean;
-var
- i: integer;
-begin
- for i := 0 to High(AudioInputProcessor.DeviceList) do
- AudioInputProcessor.DeviceList[i].Free();
- AudioInputProcessor.DeviceList := nil;
- Result := true;
-end;
-
-{*
- * Start capturing on all used input-device.
- *}
-procedure TAudioInputBase.CaptureStart;
-var
- S: integer;
- DeviceIndex: integer;
- ChannelIndex: integer;
- Device: TAudioInputDevice;
- DeviceCfg: PInputDeviceConfig;
- DeviceUsed: boolean;
- Player: integer;
-begin
- if (Started) then
- CaptureStop();
-
- // reset buffers
- for S := 0 to High(AudioInputProcessor.Sound) do
- AudioInputProcessor.Sound[S].Clear;
-
- // start capturing on each used device
- for DeviceIndex := 0 to High(AudioInputProcessor.DeviceList) do
- begin
- Device := AudioInputProcessor.DeviceList[DeviceIndex];
- if not assigned(Device) then
- continue;
- DeviceCfg := @Ini.InputDeviceConfig[Device.CfgIndex];
-
- DeviceUsed := false;
-
- // check if device is used
- for ChannelIndex := 0 to High(DeviceCfg.ChannelToPlayerMap) do
- begin
- Player := DeviceCfg.ChannelToPlayerMap[ChannelIndex]-1;
- if (Player < 0) or (Player >= PlayersPlay) then
- begin
- Device.LinkCaptureBuffer(ChannelIndex, nil);
- end
- else
- begin
- Device.LinkCaptureBuffer(ChannelIndex, AudioInputProcessor.Sound[Player]);
- DeviceUsed := true;
- end;
- end;
-
- // start device if used
- if (DeviceUsed) then
- begin
- //Log.BenchmarkStart(2);
- Device.Start();
- //Log.BenchmarkEnd(2);
- //Log.LogBenchmark('Device.Start', 2) ;
- end;
- end;
-
- Started := true;
-end;
-
-{*
- * Stop input-capturing on all soundcards.
- *}
-procedure TAudioInputBase.CaptureStop;
-var
- DeviceIndex: integer;
- ChannelIndex: integer;
- Device: TAudioInputDevice;
- DeviceCfg: PInputDeviceConfig;
-begin
- for DeviceIndex := 0 to High(AudioInputProcessor.DeviceList) do
- begin
- Device := AudioInputProcessor.DeviceList[DeviceIndex];
- if not assigned(Device) then
- continue;
-
- Device.Stop();
-
- // disconnect capture buffers
- DeviceCfg := @Ini.InputDeviceConfig[Device.CfgIndex];
- for ChannelIndex := 0 to High(DeviceCfg.ChannelToPlayerMap) do
- Device.LinkCaptureBuffer(ChannelIndex, nil);
- end;
-
- Started := false;
-end;
-
-function TAudioInputBase.UnifyDeviceName(const name: string; deviceIndex: integer): string;
-var
- count: integer; // count of devices with this name
-
- function IsDuplicate(const name: string): boolean;
- var
- i: integer;
- begin
- Result := False;
- // search devices with same description
- For i := 0 to deviceIndex-1 do
- begin
- if (AudioInputProcessor.DeviceList[i].Name = name) then
- begin
- Result := True;
- Break;
- end;
- end;
- end;
-begin
- count := 1;
- result := name;
-
- // if there is another device with the same ID, search for an available name
- while (IsDuplicate(result)) do
- begin
- Inc(count);
- // set description
- result := name + ' ('+IntToStr(count)+')';
- end;
-end;
-
-end.
-
-
-
diff --git a/src/classes/URingBuffer.pas b/src/classes/URingBuffer.pas
deleted file mode 100644
index ce51e209..00000000
--- a/src/classes/URingBuffer.pas
+++ /dev/null
@@ -1,128 +0,0 @@
-unit URingBuffer;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses
- SysUtils;
-
-type
- TRingBuffer = class
- private
- RingBuffer: PChar;
- BufferCount: integer;
- BufferSize: integer;
- WritePos: integer;
- ReadPos: integer;
- public
- constructor Create(Size: integer);
- destructor Destroy; override;
- function Read(Buffer: PChar; Count: integer): integer;
- function Write(Buffer: PChar; Count: integer): integer;
- procedure Flush();
- end;
-
-implementation
-
-uses
- Math;
-
-constructor TRingBuffer.Create(Size: integer);
-begin
- BufferSize := Size;
-
- GetMem(RingBuffer, Size);
- if (RingBuffer = nil) then
- raise Exception.Create('No memory');
-end;
-
-destructor TRingBuffer.Destroy;
-begin
- FreeMem(RingBuffer);
-end;
-
-function TRingBuffer.Read(Buffer: PChar; Count: integer): integer;
-var
- PartCount: integer;
-begin
- // adjust output count
- if (Count > BufferCount) then
- begin
- //DebugWriteln('Read too much: ' + inttostr(count) +',count:'+ inttostr(BufferCount) + '/size:' + inttostr(BufferSize));
- Count := BufferCount;
- end;
-
- // check if there is something to do
- if (Count <= 0) then
- begin
- Result := Count;
- Exit;
- end;
-
- // copy data to output buffer
-
- // first step: copy from the area between the read-position and the end of the buffer
- PartCount := Min(Count, BufferSize - ReadPos);
- Move(RingBuffer[ReadPos], Buffer[0], PartCount);
-
- // second step: if we need more data, copy from the beginning of the buffer
- if (PartCount < Count) then
- Move(RingBuffer[0], Buffer[0], Count-PartCount);
-
- // mark the copied part of the buffer as free
- BufferCount := BufferCount - Count;
- ReadPos := (ReadPos + Count) mod BufferSize;
-
- Result := Count;
-end;
-
-function TRingBuffer.Write(Buffer: PChar; Count: integer): integer;
-var
- PartCount: integer;
-begin
- // check for a reasonable request
- if (Count <= 0) then
- begin
- Result := Count;
- Exit;
- end;
-
- // skip input data if the input buffer is bigger than the ring-buffer
- if (Count > BufferSize) then
- begin
- //DebugWriteln('Write skip data:' + inttostr(count) +',count:'+ inttostr(BufferCount) + '/size:' + inttostr(BufferSize));
- Buffer := @Buffer[Count - BufferSize];
- Count := BufferSize;
- end;
-
- // first step: copy to the area between the write-position and the end of the buffer
- PartCount := Min(Count, BufferSize - WritePos);
- Move(Buffer[0], RingBuffer[WritePos], PartCount);
-
- // second step: copy data to front of buffer
- if (PartCount < Count) then
- Move(Buffer[PartCount], RingBuffer[0], Count-PartCount);
-
- // update info
- BufferCount := Min(BufferCount + Count, BufferSize);
- WritePos := (WritePos + Count) mod BufferSize;
- // if the buffer is full, we have to reposition the read-position
- if (BufferCount = BufferSize) then
- ReadPos := WritePos;
-
- Result := Count;
-end;
-
-procedure TRingBuffer.Flush();
-begin
- ReadPos := 0;
- WritePos := 0;
- BufferCount := 0;
-end;
-
-end.
\ No newline at end of file
diff --git a/src/classes/UServices.pas b/src/classes/UServices.pas
deleted file mode 100644
index 6325444c..00000000
--- a/src/classes/UServices.pas
+++ /dev/null
@@ -1,358 +0,0 @@
-unit UServices;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses uPluginDefs,
- SysUtils;
-{*********************
- TServiceManager
- Class for saving, managing and calling of Services.
- Saves all Services and their Procs
-*********************}
-
-type
- TServiceName = String[60];
- PServiceInfo = ^TServiceInfo;
- TServiceInfo = record
- Self: THandle; //Handle of this Service
- Hash: Integer; //4 Bit Hash of the Services Name
- Name: TServiceName; //Name of this Service
-
- Owner: Integer; //If < 0 [-(DLLMan Pluginindex + 1)]; 0 - undefined, On Error Full shutdown, If < 0 [ModuleIndex - 1]
-
- Next: PServiceInfo; //Pointer to the Next Service in teh list
-
- //Here is s/t tricky
- //To avoid writing of Wrapping Functions to offer a Service from a Class
- //We save a Normal Proc or a Method of a Class
- Case isClass: boolean of
- False: (Proc: TUS_Service); //Proc that will be called on Event
- True: (ProcOfClass: TUS_Service_of_Object);
- end;
-
- TServiceManager = class
- private
- //Managing Service List
- FirstService: PServiceInfo;
- LastService: PServiceInfo;
-
- //Some Speed improvement by caching the last 4 called Services
- //Most of the time a Service is called multiple times
- ServiceCache: Array[0..3] of PServiceInfo;
- NextCacheItem: Byte;
-
- //Next Service added gets this Handle:
- NextHandle: THandle;
- public
- Constructor Create;
-
- Function AddService(const ServiceName: PChar; const Proc: TUS_Service = nil; const ProcofClass: TUS_Service_of_Object = nil): THandle;
- Function DelService(const hService: THandle): integer;
-
- Function CallService(const ServiceName: PChar; const wParam: TwParam; lParam: TlParam): integer;
-
- Function NametoHash(const ServiceName: TServiceName): Integer;
- Function ServiceExists(const ServiceName: PChar): Integer;
- end;
-
-var
- ServiceManager: TServiceManager;
-
-implementation
-uses
- ULog,
- UCore;
-
-//------------
-// Create - Creates Class and Set Standard Values
-//------------
-Constructor TServiceManager.Create;
-begin
- inherited;
-
- FirstService := nil;
- LastService := nil;
-
- ServiceCache[0] := nil;
- ServiceCache[1] := nil;
- ServiceCache[2] := nil;
- ServiceCache[3] := nil;
-
- NextCacheItem := 0;
-
- NextHandle := 1;
-
- {$IFDEF DEBUG}
- debugWriteln('ServiceManager: Succesful created!');
- {$ENDIF}
-end;
-
-//------------
-// Function Creates a new Service and Returns the Services Handle,
-// 0 on Failure. (Name already exists)
-//------------
-Function TServiceManager.AddService(const ServiceName: PChar; const Proc: TUS_Service; const ProcofClass: TUS_Service_of_Object): THandle;
-var
- Cur: PServiceInfo;
-begin
- Result := 0;
-
- If (@Proc <> nil) or (@ProcOfClass <> nil) then
- begin
- If (ServiceExists(ServiceName) = 0) then
- begin //There is a Proc and the Service does not already exist
- //Ok Add it!
-
- //Get Memory
- GetMem(Cur, SizeOf(TServiceInfo));
-
- //Fill it with Data
- Cur.Next := nil;
-
- If (@Proc = nil) then
- begin //Use the ProcofClass Method
- Cur.isClass := True;
- Cur.ProcOfClass := ProcofClass;
- end
- else //Use the normal Proc
- begin
- Cur.isClass := False;
- Cur.Proc := Proc;
- end;
-
- Cur.Self := NextHandle;
- //Zero Name
- Cur.Name := #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0;
- Cur.Name := String(ServiceName);
- Cur.Hash := NametoHash(Cur.Name);
-
- //Add Owner to Service
- Cur.Owner := Core.CurExecuted;
-
- //Add Service to the List
- If (FirstService = nil) then
- FirstService := Cur;
-
- If (LastService <> nil) then
- LastService.Next := Cur;
-
- LastService := Cur;
-
- {$IFDEF DEBUG}
- debugWriteln('ServiceManager: Service added: ''' + ServiceName + ''', Handle: ' + InttoStr(Cur.Self));
- {$ENDIF}
-
- //Inc Next Handle
- Inc(NextHandle);
- end
- {$IFDEF DEBUG}
- else debugWriteln('ServiceManager: Try to readd Service: ' + ServiceName);
- {$ENDIF}
- end;
-end;
-
-//------------
-// Function Destroys a Service, 0 on success, not 0 on Failure
-//------------
-Function TServiceManager.DelService(const hService: THandle): integer;
-var
- Last, Cur: PServiceInfo;
- I: Integer;
-begin
- Result := -1;
-
- Last := nil;
- Cur := FirstService;
-
- //Search for Service to Delete
- While (Cur <> nil) do
- begin
- If (Cur.Self = hService) then
- begin //Found Service => Delete it
-
- //Delete from List
- If (Last = nil) then //Found first Service
- FirstService := Cur.Next
- Else //Service behind the first
- Last.Next := Cur.Next;
-
- //IF this is the LastService, correct LastService
- If (Cur = LastService) then
- LastService := Last;
-
- //Search for Service in Cache and delete it if found
- For I := 0 to High(ServiceCache) do
- If (ServiceCache[I] = Cur) then
- begin
- ServiceCache[I] := nil;
- end;
-
- {$IFDEF DEBUG}
- debugWriteln('ServiceManager: Removed Service succesful: ' + Cur.Name);
- {$ENDIF}
-
- //Free Memory
- Freemem(Cur, SizeOf(TServiceInfo));
-
- //Break the Loop
- Break;
- end;
-
- //Go to Next Service
- Last := Cur;
- Cur := Cur.Next;
- end;
-end;
-
-//------------
-// Function Calls a Services Proc
-// Returns Services Return Value or SERVICE_NOT_FOUND on Failure
-//------------
-Function TServiceManager.CallService(const ServiceName: PChar; const wParam: TwParam; lParam: TlParam): integer;
-var
- SExists: Integer;
- Service: PServiceInfo;
- CurExecutedBackup: Integer; //backup of Core.CurExecuted Attribute
-begin
- Result := SERVICE_NOT_FOUND;
- SExists := ServiceExists(ServiceName);
- If (SExists <> 0) then
- begin
- //Backup CurExecuted
- CurExecutedBackup := Core.CurExecuted;
-
- Service := Pointer(SExists);
-
- If (Service.isClass) then
- //Use Proc of Class
- Result := Service.ProcOfClass(wParam, lParam)
- Else
- //Use normal Proc
- Result := Service.Proc(wParam, lParam);
-
- //Restore CurExecuted
- Core.CurExecuted := CurExecutedBackup;
- end;
-
- {$IFDEF DEBUG}
- debugWriteln('ServiceManager: Service ''' + ServiceName + ''' called. Result: ' + InttoStr(Result));
- {$ENDIF}
-end;
-
-//------------
-// Generates the Hash for the given Name
-//------------
-Function TServiceManager.NametoHash(const ServiceName: TServiceName): Integer;
-// FIXME: check if the non-asm version is fast enough and use it by default if so
-{$IF Defined(CPUX86_64)}
-{$IFDEF FPC}
- {$ASMMODE Intel}
-{$ENDIF}
-asm
- { CL: Counter; RAX: Result; RDX: Current Memory Address }
- Mov RCX, 14
- Mov RDX, ServiceName {Save Address of String that should be "Hashed"}
- Mov RAX, [RDX]
- @FoldLoop: ADD RDX, 4 {jump 4 Byte(32 Bit) to the next tile }
- ADD RAX, [RDX] {Add the Value of the next 4 Byte of the String to the Hash}
- LOOP @FoldLoop {Fold again if there are Chars Left}
-end;
-{$ELSEIF Defined(CPU386) or Defined(CPUI386)}
-{$IFDEF FPC}
- {$ASMMODE Intel}
-{$ENDIF}
-asm
- { CL: Counter; EAX: Result; EDX: Current Memory Address }
- Mov ECX, 14 {Init Counter, Fold 14 Times to get 4 Bytes out of 60}
- Mov EDX, ServiceName {Save Address of String that should be "Hashed"}
- Mov EAX, [EDX]
- @FoldLoop: ADD EDX, 4 {jump 4 Byte(32 Bit) to the next tile }
- ADD EAX, [EDX] {Add the Value of the next 4 Byte of the String to the Hash}
- LOOP @FoldLoop {Fold again if there are Chars Left}
-end;
-{$ELSE}
-var
- i: integer;
- ptr: ^integer;
-begin
- ptr := @ServiceName;
- Result := 0;
- for i := 1 to 14 do
- begin
- Result := Result + ptr^;
- Inc(ptr);
- end;
-end;
-{$IFEND}
-
-
-//------------
-// Function Returns Non Zero if a Service with the given Name Exists, otherwise 0
-//------------
-Function TServiceManager.ServiceExists(const ServiceName: PChar): Integer;
-var
- Name: TServiceName;
- Hash: Integer;
- Cur: PServiceInfo;
- I: Byte;
-begin
- Result := 0;
- // to-do : Write a Metbod (in ASM) to Zero and Add in one turn (faster then this dirty hack ;)
- //Zero Name:
- Name := #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0 + #0;
- //Add Service Name
- Name := String(ServiceName);
- Hash := NametoHash(Name);
-
- //First of all Look for the Service in Cache
- For I := 0 to High(ServiceCache) do
- begin
- If (ServiceCache[I] <> nil) AND (ServiceCache[I].Hash = Hash) then
- begin
- If (ServiceCache[I].Name = Name) then
- begin //Found Service in Cache
- Result := Integer(ServiceCache[I]);
-
- {$IFDEF DEBUG}
- debugWriteln('ServiceManager: Found Service in Cache: ''' + ServiceName + '''');
- {$ENDIF}
-
- Break;
- end;
- end;
- end;
-
- If (Result = 0) then
- begin
- Cur := FirstService;
- While (Cur <> nil) do
- begin
- If (Cur.Hash = Hash) then
- begin
- If (Cur.Name = Name) then
- begin //Found the Service
- Result := Integer(Cur);
-
- {$IFDEF DEBUG}
- debugWriteln('ServiceManager: Found Service in List: ''' + ServiceName + '''');
- {$ENDIF}
-
- //Add to Cache
- ServiceCache[NextCacheItem] := Cur;
- NextCacheItem := (NextCacheItem + 1) AND 3;
- Break;
- end;
- end;
-
- Cur := Cur.Next;
- end;
- end;
-end;
-
-end.
diff --git a/src/classes/USingNotes.pas b/src/classes/USingNotes.pas
deleted file mode 100644
index 3b268d10..00000000
--- a/src/classes/USingNotes.pas
+++ /dev/null
@@ -1,13 +0,0 @@
-unit USingNotes;
-
-interface
-
-{$I switches.inc}
-
-{ Dummy Unit atm
- For further expantation
- Placeholder for Class that will handle the Notes Drawing}
-
-implementation
-
-end.
diff --git a/src/classes/USingScores.pas b/src/classes/USingScores.pas
deleted file mode 100644
index 77d40b84..00000000
--- a/src/classes/USingScores.pas
+++ /dev/null
@@ -1,973 +0,0 @@
-unit USingScores;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses UThemes,
- gl,
- UTexture;
-
-//////////////////////////////////////////////////////////////
-// ATTENTION: //
-// Enabled Flag does not Work atm. This should cause Popups //
-// Not to Move and Scores to stay until Renenabling. //
-// To use e.g. in Pause Mode //
-// Also InVisible Flag causes Attributes not to change. //
-// This should be fixed after next Draw when Visible = True,//
-// but not testet yet //
-//////////////////////////////////////////////////////////////
-
-//Some constants containing options that could change by time
-const
- MaxPlayers = 6; //Maximum of Players that could be added
- MaxPositions = 6; //Maximum of Score Positions that could be added
-
-type
- //-----------
- // TScorePlayer - Record Containing Information about a Players Score
- //-----------
- TScorePlayer = record
- Position: Byte; //Index of the Position where the Player should be Drawn
- Enabled: Boolean; //Is the Score Display Enabled
- Visible: Boolean; //Is the Score Display Visible
- Score: Word; //Current Score of the Player
- ScoreDisplayed: Word; //Score cur. Displayed(for counting up)
- ScoreBG: TTexture;//Texture of the Players Scores BG
- Color: TRGB; //Teh Players Color
- RBPos: Real; //Cur. Percentille of the Rating Bar
- RBTarget: Real; //Target Position of Rating Bar
- RBVisible:Boolean; //Is Rating bar Drawn
- end;
- aScorePlayer = array[0..MaxPlayers-1] of TScorePlayer;
-
- //-----------
- // TScorePosition - Record Containing Information about a Score Position, that can be used
- //-----------
- PScorePosition = ^TScorePosition;
- TScorePosition = record
- //The Position is Used for Which Playercount
- PlayerCount: Byte;
- // 1 - One Player per Screen
- // 2 - 2 Players per Screen
- // 4 - 3 Players per Screen
- // 6 would be 2 and 3 Players per Screen
-
- BGX: Real; //X Position of the Score BG
- BGY: Real; //Y Position of the Score BG
- BGW: Real; //Width of the Score BG
- BGH: Real; //Height of the Score BG
-
- RBX: Real; //X Position of the Rating Bar
- RBY: Real; //Y Position of the Rating Bar
- RBW: Real; //Width of the Rating Bar
- RBH: Real; //Height of the Rating Bar
-
- TextX: Real; //X Position of the Score Text
- TextY: Real; //Y Position of the Score Text
- TextFont: Byte; //Font of the Score Text
- TextSize: Byte; //Size of the Score Text
-
- PUW: Real; //Width of the LineBonus Popup
- PUH: Real; //Height of the LineBonus Popup
- PUFont: Byte; //Font for the PopUps
- PUFontSize: Byte; //FontSize for the PopUps
- PUStartX: Real; //X Start Position of the LineBonus Popup
- PUStartY: Real; //Y Start Position of the LineBonus Popup
- PUTargetX: Real; //X Target Position of the LineBonus Popup
- PUTargetY: Real; //Y Target Position of the LineBonus Popup
- end;
- aScorePosition = array[0..MaxPositions-1] of TScorePosition;
-
- //-----------
- // TScorePopUp - Record Containing Information about a LineBonus Popup
- // List, Next Item is Saved in Next attribute
- //-----------
- PScorePopUp = ^TScorePopUp;
- TScorePopUp = record
- Player: Byte; //Index of the PopUps Player
- TimeStamp: Cardinal; //Timestamp of Popups Spawn
- Rating: Byte; //0 to 8, Type of Rating (Cool, bad, etc.)
- ScoreGiven:Word; //Score that has already been given to the Player
- ScoreDiff: Word; //Difference Between Cur Score at Spawn and Old Score
- Next: PScorePopUp; //Next Item in List
- end;
- aScorePopUp = array of TScorePopUp;
-
- //-----------
- // TSingScores - Class containing Scores Positions and Drawing Scores, Rating Bar + Popups
- //-----------
- TSingScores = class
- private
- Positions: aScorePosition;
- aPlayers: aScorePlayer;
- oPositionCount: Byte;
- oPlayerCount: Byte;
-
- //Saves the First and Last Popup of the List
- FirstPopUp: PScorePopUp;
- LastPopUp: PScorePopUp;
-
- //Procedure Draws a Popup by Pointer
- Procedure DrawPopUp(const PopUp: PScorePopUp);
-
- //Procedure Draws a Score by Playerindex
- Procedure DrawScore(const Index: Integer);
-
- //Procedure Draws the RatingBar by Playerindex
- Procedure DrawRatingBar(const Index: Integer);
-
- //Procedure Removes a PopUp w/o destroying the List
- Procedure KillPopUp(const last, cur: PScorePopUp);
- public
- Settings: record //Record containing some Displaying Options
- Phase1Time: Real; //time for Phase 1 to complete (in msecs)
- //The Plop Up of the PopUp
- Phase2Time: Real; //time for Phase 2 to complete (in msecs)
- //The Moving (mainly Upwards) of the Popup
- Phase3Time: Real; //time for Phase 3 to complete (in msecs)
- //The Fade out and Score adding
-
- PopUpTex: Array [0..8] of TTexture; //Textures for every Popup Rating
-
- RatingBar_BG_Tex: TTexture; //Rating Bar Texs
- RatingBar_FG_Tex: TTexture;
- RatingBar_Bar_Tex: TTexture;
-
- end;
-
- Visible: Boolean; //Visibility of all Scores
- Enabled: Boolean; //Scores are changed, PopUps are Moved etc.
- RBVisible: Boolean; //Visibility of all Rating Bars
-
- //Propertys for Reading Position and Playercount
- Property PositionCount: Byte read oPositionCount;
- Property PlayerCount: Byte read oPlayerCount;
- Property Players: aScorePlayer read aPlayers;
-
- //Constructor just sets some standard Settings
- Constructor Create;
-
- //Procedure Adds a Position to Array and Increases Position Count
- Procedure AddPosition(const pPosition: PScorePosition);
-
- //Procedure Adds a Player to Array and Increases Player Count
- Procedure AddPlayer(const ScoreBG: TTexture; const Color: TRGB; const Score: Word = 0; const Enabled: Boolean = True; const Visible: Boolean = True);
-
- //Change a Players Visibility, Enable
- Procedure ChangePlayerVisibility(const Index: Byte; const pVisible: Boolean);
- Procedure ChangePlayerEnabled(const Index: Byte; const pEnabled: Boolean);
-
- //Procedure Deletes all Player Information
- Procedure ClearPlayers;
-
- //Procedure Deletes Positions and Playerinformation
- Procedure Clear;
-
- //Procedure Loads some Settings and the Positions from Theme
- Procedure LoadfromTheme;
-
- //Procedure has to be called after Positions and Players have been added, before first call of Draw
- //It gives every Player a Score Position
- Procedure Init;
-
- //Spawns a new Line Bonus PopUp for the Player
- Procedure SpawnPopUp(const PlayerIndex: Byte; const Rating: Byte; const Score: Word);
-
- //Removes all PopUps from Mem
- Procedure KillAllPopUps;
-
- //Procedure Draws Scores and Linebonus PopUps
- Procedure Draw;
- end;
-
-
-implementation
-
-uses SDL,
- SysUtils,
- ULog,
- UGraphic,
- TextGL;
-
-//-----------
-//Constructor just sets some standard Settings
-//-----------
-Constructor TSingScores.Create;
-begin
- inherited;
-
- //Clear PopupList Pointers
- FirstPopUp := nil;
- LastPopUp := nil;
-
- //Clear Variables
- Visible := True;
- Enabled := True;
- RBVisible := True;
-
- //Clear Position Index
- oPositionCount := 0;
- oPlayerCount := 0;
-
- Settings.Phase1Time := 350; // plop it up . -> [ ]
- Settings.Phase2Time := 550; // shift it up ^[ ]^
- Settings.Phase3Time := 200; // increase score [s++]
-
- Settings.PopUpTex[0].TexNum := 0;
- Settings.PopUpTex[1].TexNum := 0;
- Settings.PopUpTex[2].TexNum := 0;
- Settings.PopUpTex[3].TexNum := 0;
- Settings.PopUpTex[4].TexNum := 0;
- Settings.PopUpTex[5].TexNum := 0;
- Settings.PopUpTex[6].TexNum := 0;
- Settings.PopUpTex[7].TexNum := 0;
- Settings.PopUpTex[8].TexNum := 0;
-
- Settings.RatingBar_BG_Tex.TexNum := 0;
- Settings.RatingBar_FG_Tex.TexNum := 0;
- Settings.RatingBar_Bar_Tex.TexNum := 0;
-end;
-
-//-----------
-//Procedure Adds a Position to Array and Increases Position Count
-//-----------
-Procedure TSingScores.AddPosition(const pPosition: PScorePosition);
-begin
- if (PositionCount < MaxPositions) then
- begin
- Positions[PositionCount] := pPosition^;
-
- Inc(oPositionCount);
- end;
-end;
-
-//-----------
-//Procedure Adds a Player to Array and Increases Player Count
-//-----------
-Procedure TSingScores.AddPlayer(const ScoreBG: TTexture; const Color: TRGB; const Score: Word; const Enabled: Boolean; const Visible: Boolean);
-begin
- if (PlayerCount < MaxPlayers) then
- begin
- aPlayers[PlayerCount].Position := High(byte);
- aPlayers[PlayerCount].Enabled := Enabled;
- aPlayers[PlayerCount].Visible := Visible;
- aPlayers[PlayerCount].Score := Score;
- aPlayers[PlayerCount].ScoreDisplayed := Score;
- aPlayers[PlayerCount].ScoreBG := ScoreBG;
- aPlayers[PlayerCount].Color := Color;
- aPlayers[PlayerCount].RBPos := 0.5;
- aPlayers[PlayerCount].RBTarget := 0.5;
- aPlayers[PlayerCount].RBVisible := True;
-
- Inc(oPlayerCount);
- end;
-end;
-
-//-----------
-//Change a Players Visibility
-//-----------
-Procedure TSingScores.ChangePlayerVisibility(const Index: Byte; const pVisible: Boolean);
-begin
- if (Index < MaxPlayers) then
- aPlayers[Index].Visible := pVisible;
-end;
-
-//-----------
-//Change Player Enabled
-//-----------
-Procedure TSingScores.ChangePlayerEnabled(const Index: Byte; const pEnabled: Boolean);
-begin
- if (Index < MaxPlayers) then
- aPlayers[Index].Enabled := pEnabled;
-end;
-
-//-----------
-//Procedure Deletes all Player Information
-//-----------
-Procedure TSingScores.ClearPlayers;
-begin
- KillAllPopUps;
- oPlayerCount := 0;
-end;
-
-//-----------
-//Procedure Deletes Positions and Playerinformation
-//-----------
-Procedure TSingScores.Clear;
-begin
- KillAllPopUps;
- oPlayerCount := 0;
- oPositionCount := 0;
-end;
-
-//-----------
-//Procedure Loads some Settings and the Positions from Theme
-//-----------
-Procedure TSingScores.LoadfromTheme;
-var I: Integer;
- Procedure AddbyStatics(const PC: Byte; const ScoreStatic, SingBarStatic: TThemeStatic; ScoreText: TThemeText);
- var nPosition: TScorePosition;
- begin
- nPosition.PlayerCount := PC; //Only for one Player Playing
-
- nPosition.BGX := ScoreStatic.X;
- nPosition.BGY := ScoreStatic.Y;
- nPosition.BGW := ScoreStatic.W;
- nPosition.BGH := ScoreStatic.H;
-
- nPosition.TextX := ScoreText.X;
- nPosition.TextY := ScoreText.Y;
- nPosition.TextFont := ScoreText.Font;
- nPosition.TextSize := ScoreText.Size;
-
- nPosition.RBX := SingBarStatic.X;
- nPosition.RBY := SingBarStatic.Y;
- nPosition.RBW := SingBarStatic.W;
- nPosition.RBH := SingBarStatic.H;
-
- nPosition.PUW := nPosition.BGW;
- nPosition.PUH := nPosition.BGH;
-
- nPosition.PUFont := 2;
- nPosition.PUFontSize := 6;
-
- nPosition.PUStartX := nPosition.BGX;
- nPosition.PUStartY := nPosition.TextY + 65;
-
- nPosition.PUTargetX := nPosition.BGX;
- nPosition.PUTargetY := nPosition.TextY;
-
- AddPosition(@nPosition);
- end;
-begin
- Clear;
-
- //Set Textures
- //Popup Tex
- For I := 0 to 8 do
- Settings.PopUpTex[I] := Tex_SingLineBonusBack[I];
-
- //Rating Bar Tex
- Settings.RatingBar_BG_Tex := Tex_SingBar_Back;
- Settings.RatingBar_FG_Tex := Tex_SingBar_Front;
- Settings.RatingBar_Bar_Tex := Tex_SingBar_Bar;
-
- //Load Positions from Theme
-
- // Player1:
- AddByStatics(1, Theme.Sing.StaticP1ScoreBG, Theme.Sing.StaticP1SingBar, Theme.Sing.TextP1Score);
- AddByStatics(2, Theme.Sing.StaticP1TwoPScoreBG, Theme.Sing.StaticP1TwoPSingBar, Theme.Sing.TextP1TwoPScore);
- AddByStatics(4, Theme.Sing.StaticP1ThreePScoreBG, Theme.Sing.StaticP1ThreePSingBar, Theme.Sing.TextP1ThreePScore);
-
- // Player2:
- AddByStatics(2, Theme.Sing.StaticP2RScoreBG, Theme.Sing.StaticP2RSingBar, Theme.Sing.TextP2RScore);
- AddByStatics(4, Theme.Sing.StaticP2MScoreBG, Theme.Sing.StaticP2MSingBar, Theme.Sing.TextP2MScore);
-
- // Player3:
- AddByStatics(4, Theme.Sing.StaticP3RScoreBG, Theme.Sing.StaticP3RScoreBG, Theme.Sing.TextP3RScore);
-end;
-
-//-----------
-//Spawns a new Line Bonus PopUp for the Player
-//-----------
-Procedure TSingScores.SpawnPopUp(const PlayerIndex: Byte; const Rating: Byte; const Score: Word);
-var Cur: PScorePopUp;
-begin
- if (PlayerIndex < PlayerCount) then
- begin
- //Get Memory and Add Data
- GetMem(Cur, SizeOf(TScorePopUp));
-
- Cur.Player := PlayerIndex;
- Cur.TimeStamp := SDL_GetTicks;
- Cur.Rating := Rating;
- Cur.ScoreGiven:= 0;
- If (Players[PlayerIndex].Score < Score) then
- begin
- Cur.ScoreDiff := Score - Players[PlayerIndex].Score;
- aPlayers[PlayerIndex].Score := Score;
- end
- else
- Cur.ScoreDiff := 0;
- Cur.Next := nil;
-
- //Log.LogError('TSingScores.SpawnPopUp| Player: ' + InttoStr(PlayerIndex) + ', Score: ' + InttoStr(Score) + ', ScoreDiff: ' + InttoStr(Cur.ScoreDiff));
-
- //Add it to the Chain
- if (FirstPopUp = nil) then
- //the first PopUp in the List
- FirstPopUp := Cur
- else
- //second or earlier popup
- LastPopUp.Next := Cur;
-
- //Set new Popup to Last PopUp in the List
- LastPopUp := Cur;
- end
- else
- Log.LogError('TSingScores: Try to add PopUp for not existing player');
-end;
-
-//-----------
-// Removes a PopUp w/o destroying the List
-//-----------
-Procedure TSingScores.KillPopUp(const last, cur: PScorePopUp);
-var
- lTempA ,
- lTempB : real;
-begin
- //Give Player the Last Points that missing till now
- aPlayers[Cur.Player].ScoreDisplayed := aPlayers[Cur.Player].ScoreDisplayed + Cur.ScoreDiff - Cur.ScoreGiven;
-
- //Change Bars Position
- lTempA := ( aPlayers[Cur.Player].RBTarget + (Cur.ScoreDiff - Cur.ScoreGiven) );
- lTempB := ( Cur.ScoreDiff * (Cur.Rating / 20 - 0.26) );
-
- if ( lTempA > 0 ) AND
- ( lTempB > 0 ) THEN
- begin
- aPlayers[Cur.Player].RBTarget := lTempA / lTempB;
- end;
-
- If (aPlayers[Cur.Player].RBTarget > 1) then
- aPlayers[Cur.Player].RBTarget := 1
- else
- If (aPlayers[Cur.Player].RBTarget < 0) then
- aPlayers[Cur.Player].RBTarget := 0;
-
- //If this is the First PopUp => Make Next PopUp the First
- If (Cur = FirstPopUp) then
- FirstPopUp := Cur.Next
- //Else => Remove Curent Popup from Chain
- else
- Last.Next := Cur.Next;
-
- //If this is the Last PopUp, Make PopUp before the Last
- If (Cur = LastPopUp) then
- LastPopUp := Last;
-
- //Free the Memory
- FreeMem(Cur, SizeOf(TScorePopUp));
-end;
-
-//-----------
-//Removes all PopUps from Mem
-//-----------
-Procedure TSingScores.KillAllPopUps;
-var
- Cur: PScorePopUp;
- Last: PScorePopUp;
-begin
- Cur := FirstPopUp;
-
- //Remove all PopUps:
- While (Cur <> nil) do
- begin
- Last := Cur;
- Cur := Cur.Next;
- FreeMem(Last, SizeOf(TScorePopUp));
- end;
-
- FirstPopUp := nil;
- LastPopUp := nil;
-end;
-
-//-----------
-//Init - has to be called after Positions and Players have been added, before first call of Draw
-//It gives every Player a Score Position
-//-----------
-Procedure TSingScores.Init;
-var
- PlC: Array [0..1] of Byte; //Playercount First Screen and Second Screen
- I, J: Integer;
- MaxPlayersperScreen: Byte;
- CurPlayer: Byte;
-
- Function GetPositionCountbyPlayerCount(bPlayerCount: Byte): Byte;
- var I: Integer;
- begin
- Result := 0;
- bPlayerCount := 1 shl (bPlayerCount - 1);
-
- For I := 0 to PositionCount-1 do
- begin
- If ((Positions[I].PlayerCount AND bPlayerCount) <> 0) then
- Inc(Result);
- end;
- end;
-
- Function GetPositionbyPlayernum(bPlayerCount, bPlayer: Byte): Byte;
- var I: Integer;
- begin
- bPlayerCount := 1 shl (bPlayerCount - 1);
- Result := High(Byte);
-
- For I := 0 to PositionCount-1 do
- begin
- If ((Positions[I].PlayerCount AND bPlayerCount) <> 0) then
- begin
- If (bPlayer = 0) then
- begin
- Result := I;
- Break;
- end
- else
- Dec(bPlayer);
- end;
- end;
- end;
-
-begin
- MaxPlayersPerScreen := 0;
-
- For I := 1 to 6 do
- begin
- //If there are enough Positions -> Write to MaxPlayers
- If (GetPositionCountbyPlayerCount(I) = I) then
- MaxPlayersPerScreen := I
- else
- Break;
- end;
-
-
- //Split Players to both Screen or Display on One Screen
- if (Screens = 2) and (MaxPlayersPerScreen < PlayerCount) then
- begin
- PlC[0] := PlayerCount div 2 + PlayerCount mod 2;
- PlC[1] := PlayerCount div 2;
- end
- else
- begin
- PlC[0] := PlayerCount;
- PlC[1] := 0;
- end;
-
-
- //Check if there are enough Positions for all Players
- For I := 0 to Screens - 1 do
- begin
- if (PlC[I] > MaxPlayersperScreen) then
- begin
- PlC[I] := MaxPlayersperScreen;
- Log.LogError('More Players than available Positions, TSingScores');
- end;
- end;
-
- CurPlayer := 0;
- //Give every Player a Position
- For I := 0 to Screens - 1 do
- For J := 0 to PlC[I]-1 do
- begin
- aPlayers[CurPlayer].Position := GetPositionbyPlayernum(PlC[I], J) OR (I shl 7);
- //Log.LogError('Player ' + InttoStr(CurPlayer) + ' gets Position: ' + InttoStr(aPlayers[CurPlayer].Position));
- Inc(CurPlayer);
- end;
-end;
-
-//-----------
-//Procedure Draws Scores and Linebonus PopUps
-//-----------
-Procedure TSingScores.Draw;
-var
- I: Integer;
- CurTime: Cardinal;
- CurPopUp, LastPopUp: PScorePopUp;
-begin
- CurTime := SDL_GetTicks;
-
- If Visible then
- begin
- //Draw Popups
- LastPopUp := nil;
- CurPopUp := FirstPopUp;
-
- While (CurPopUp <> nil) do
- begin
- if (CurTime - CurPopUp.TimeStamp > Settings.Phase1Time + Settings.Phase2Time + Settings.Phase3Time) then
- begin
- KillPopUp(LastPopUp, CurPopUp);
- if (LastPopUp = nil) then
- CurPopUp := FirstPopUp
- else
- CurPopUp := LastPopUp.Next;
- end
- else
- begin
- DrawPopUp(CurPopUp);
- LastPopUp := CurPopUp;
- CurPopUp := LastPopUp.Next;
- end;
- end;
-
-
- IF (RBVisible) then
- //Draw Players w/ Rating Bar
- For I := 0 to PlayerCount-1 do
- begin
- DrawScore(I);
- DrawRatingBar(I);
- end
- else
- //Draw Players w/o Rating Bar
- For I := 0 to PlayerCount-1 do
- begin
- DrawScore(I);
- end;
-
- end; //eo Visible
-end;
-
-//-----------
-//Procedure Draws a Popup by Pointer
-//-----------
-Procedure TSingScores.DrawPopUp(const PopUp: PScorePopUp);
-var
- Progress: Real;
- CurTime: Cardinal;
- X, Y, W, H, Alpha: Real;
- FontSize: Byte;
- TimeDiff: Cardinal;
- PIndex: Byte;
- TextLen: Real;
- ScoretoAdd: Word;
- PosDiff: Real;
-begin
- if (PopUp <> nil) then
- begin
- //Only Draw if Player has a Position
- PIndex := Players[PopUp.Player].Position;
- If PIndex <> high(byte) then
- begin
- //Only Draw if Player is on Cur Screen
- If ((Players[PopUp.Player].Position AND 128) = 0) = (ScreenAct = 1) then
- begin
- CurTime := SDL_GetTicks;
- If Not (Enabled AND Players[PopUp.Player].Enabled) then
- //Increase Timestamp with TIem where there is no Movement ...
- begin
- //Inc(PopUp.TimeStamp, LastRender);
- end;
- TimeDiff := CurTime - PopUp.TimeStamp;
-
- //Get Position of PopUp
- PIndex := PIndex AND 127;
-
-
- //Check for Phase ...
- If (TimeDiff <= Settings.Phase1Time) then
- begin
- //Phase 1 - The Ploping up
- Progress := TimeDiff / Settings.Phase1Time;
-
-
- W := Positions[PIndex].PUW * Sin(Progress/2*Pi);
- H := Positions[PIndex].PUH * Sin(Progress/2*Pi);
-
- X := Positions[PIndex].PUStartX + (Positions[PIndex].PUW - W)/2;
- Y := Positions[PIndex].PUStartY + (Positions[PIndex].PUH - H)/2;
-
- FontSize := Round(Progress * Positions[PIndex].PUFontSize);
- Alpha := 1;
- end
-
- Else If (TimeDiff <= Settings.Phase2Time + Settings.Phase1Time) then
- begin
- //Phase 2 - The Moving
- Progress := (TimeDiff - Settings.Phase1Time) / Settings.Phase2Time;
-
- W := Positions[PIndex].PUW;
- H := Positions[PIndex].PUH;
-
- PosDiff := Positions[PIndex].PUTargetX - Positions[PIndex].PUStartX;
- If PosDiff > 0 then
- PosDiff := PosDiff + W;
- X := Positions[PIndex].PUStartX + PosDiff * sqr(Progress);
-
- PosDiff := Positions[PIndex].PUTargetY - Positions[PIndex].PUStartY;
- If PosDiff < 0 then
- PosDiff := PosDiff + Positions[PIndex].BGH;
- Y := Positions[PIndex].PUStartY + PosDiff * sqr(Progress);
-
- FontSize := Positions[PIndex].PUFontSize;
- Alpha := 1 - 0.3 * Progress;
- end
-
- else
- begin
- //Phase 3 - The Fading out + Score adding
- Progress := (TimeDiff - Settings.Phase1Time - Settings.Phase2Time) / Settings.Phase3Time;
-
- If (PopUp.Rating > 0) then
- begin
- //Add Scores if Player Enabled
- If (Enabled AND Players[PopUp.Player].Enabled) then
- begin
- ScoreToAdd := Round(PopUp.ScoreDiff * Progress) - PopUp.ScoreGiven;
- Inc(PopUp.ScoreGiven, ScoreToAdd);
- aPlayers[PopUp.Player].ScoreDisplayed := Players[PopUp.Player].ScoreDisplayed + ScoreToAdd;
-
- //Change Bars Position
- aPlayers[PopUp.Player].RBTarget := aPlayers[PopUp.Player].RBTarget + ScoreToAdd/PopUp.ScoreDiff * (PopUp.Rating / 20 - 0.26);
- If (aPlayers[PopUp.Player].RBTarget > 1) then
- aPlayers[PopUp.Player].RBTarget := 1
- else If (aPlayers[PopUp.Player].RBTarget < 0) then
- aPlayers[PopUp.Player].RBTarget := 0;
- end;
-
- //Set Positions etc.
- Alpha := 0.7 - 0.7 * Progress;
-
- W := Positions[PIndex].PUW;
- H := Positions[PIndex].PUH;
-
- PosDiff := Positions[PIndex].PUTargetX - Positions[PIndex].PUStartX;
- If (PosDiff > 0) then
- PosDiff := W
- else
- PosDiff := 0;
- X := Positions[PIndex].PUTargetX + PosDiff * Progress;
-
- PosDiff := Positions[PIndex].PUTargetY - Positions[PIndex].PUStartY;
- If (PosDiff < 0) then
- PosDiff := -Positions[PIndex].BGH
- else
- PosDiff := 0;
- Y := Positions[PIndex].PUTargetY - PosDiff * (1-Progress);
-
- FontSize := Positions[PIndex].PUFontSize;
- end
- else
- begin
- //Here the Effect that Should be shown if a PopUp without Score is Drawn
- //And or Spawn with the GraphicObjects etc.
- //Some Work for Blindy to do :P
-
- //ATM: Just Let it Slide in the Scores just like the Normal PopUp
- Alpha := 0;
- end;
- end;
-
- //Draw PopUp
-
- if (Alpha > 0) AND (Players[PopUp.Player].Visible) then
- begin
- //Draw BG:
- glEnable(GL_TEXTURE_2D);
- glEnable(GL_BLEND);
- glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
-
- glColor4f(1,1,1, Alpha);
- glBindTexture(GL_TEXTURE_2D, Settings.PopUpTex[PopUp.Rating].TexNum);
-
- glBegin(GL_QUADS);
- glTexCoord2f(0, 0); glVertex2f(X, Y);
- glTexCoord2f(0, Settings.PopUpTex[PopUp.Rating].TexH); glVertex2f(X, Y + H);
- glTexCoord2f(Settings.PopUpTex[PopUp.Rating].TexW, Settings.PopUpTex[PopUp.Rating].TexH); glVertex2f(X + W, Y + H);
- glTexCoord2f(Settings.PopUpTex[PopUp.Rating].TexW, 0); glVertex2f(X + W, Y);
- glEnd;
-
- glDisable(GL_TEXTURE_2D);
- glDisable(GL_BLEND);
-
- //Set FontStyle and Size
- SetFontStyle(Positions[PIndex].PUFont);
- SetFontItalic(False);
- SetFontSize(FontSize);
-
- //Draw Text
- TextLen := glTextWidth(PChar(Theme.Sing.LineBonusText[PopUp.Rating]));
-
- //Color and Pos
- SetFontPos (X + (W - TextLen) / 2, Y + 12);
- glColor4f(1, 1, 1, Alpha);
-
- //Draw
- glPrint(PChar(Theme.Sing.LineBonusText[PopUp.Rating]));
- end; //eo Alpha check
- end; //eo Right Screen
- end; //eo Player has Position
- end
- else
- Log.LogError('TSingScores: Try to Draw a not existing PopUp');
-end;
-
-//-----------
-//Procedure Draws a Score by Playerindex
-//-----------
-Procedure TSingScores.DrawScore(const Index: Integer);
-var
- Position: PScorePosition;
- ScoreStr: String;
-begin
- //Only Draw if Player has a Position
- If Players[Index].Position <> high(byte) then
- begin
- //Only Draw if Player is on Cur Screen
- If (((Players[Index].Position AND 128) = 0) = (ScreenAct = 1)) AND Players[Index].Visible then
- begin
- Position := @Positions[Players[Index].Position and 127];
-
- //Draw ScoreBG
- glEnable(GL_TEXTURE_2D);
- glEnable(GL_BLEND);
- glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
-
- glColor4f(1,1,1, 1);
- glBindTexture(GL_TEXTURE_2D, Players[Index].ScoreBG.TexNum);
-
- glBegin(GL_QUADS);
- glTexCoord2f(0, 0); glVertex2f(Position.BGX, Position.BGY);
- glTexCoord2f(0, Players[Index].ScoreBG.TexH); glVertex2f(Position.BGX, Position.BGY + Position.BGH);
- glTexCoord2f(Players[Index].ScoreBG.TexW, Players[Index].ScoreBG.TexH); glVertex2f(Position.BGX + Position.BGW, Position.BGY + Position.BGH);
- glTexCoord2f(Players[Index].ScoreBG.TexW, 0); glVertex2f(Position.BGX + Position.BGW, Position.BGY);
- glEnd;
-
- glDisable(GL_TEXTURE_2D);
- glDisable(GL_BLEND);
-
- //Draw Score Text
- SetFontStyle(Position.TextFont);
- SetFontItalic(False);
- SetFontSize(Position.TextSize);
- SetFontPos(Position.TextX, Position.TextY);
-
- ScoreStr := InttoStr(Players[Index].ScoreDisplayed div 10) + '0';
- While (Length(ScoreStr) < 5) do
- ScoreStr := '0' + ScoreStr;
-
- glPrint(PChar(ScoreStr));
-
- end; //eo Right Screen
- end; //eo Player has Position
-end;
-
-
-Procedure TSingScores.DrawRatingBar(const Index: Integer);
-var
- Position: PScorePosition;
- R,G,B, Size: Real;
- Diff: Real;
-begin
- //Only Draw if Player has a Position
- if Players[Index].Position <> high(byte) then
- begin
- //Only Draw if Player is on Cur Screen
- if (((Players[Index].Position and 128) = 0) = (ScreenAct = 1) and
- Players[index].RBVisible and
- Players[index].Visible) then
- begin
- Position := @Positions[Players[Index].Position and 127];
-
- if (Enabled AND Players[Index].Enabled) then
- begin
- //Move Position if Enabled
- Diff := Players[Index].RBTarget - Players[Index].RBPos;
- If(Abs(Diff) < 0.02) then
- aPlayers[Index].RBPos := aPlayers[Index].RBTarget
- else
- aPlayers[Index].RBPos := aPlayers[Index].RBPos + Diff*0.1;
- end;
-
- //Get Colors for RatingBar
- if (Players[index].RBPos <= 0.22) then
- begin
- R := 1;
- G := 0;
- B := 0;
- end
- else if (Players[index].RBPos <= 0.42) then
- begin
- R := 1;
- G := Players[index].RBPos*5;
- B := 0;
- end
- else if (Players[index].RBPos <= 0.57) then
- begin
- R := 1;
- G := 1;
- B := 0;
- end
- else if (Players[index].RBPos <= 0.77) then
- begin
- R := 1-(Players[index].RBPos-0.57)*5;
- G := 1;
- B := 0;
- end
- else
- begin
- R := 0;
- G := 1;
- B := 0;
- end;
-
- //Enable all glFuncs Needed
- glEnable(GL_TEXTURE_2D);
- glEnable(GL_BLEND);
- glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
-
- //Draw RatingBar BG
- glColor4f(1, 1, 1, 0.8);
- glBindTexture(GL_TEXTURE_2D, Settings.RatingBar_BG_Tex.TexNum);
-
- glBegin(GL_QUADS);
- glTexCoord2f(0, 0);
- glVertex2f(Position.RBX, Position.RBY);
-
- glTexCoord2f(0, Settings.RatingBar_BG_Tex.TexH);
- glVertex2f(Position.RBX, Position.RBY+Position.RBH);
-
- glTexCoord2f(Settings.RatingBar_BG_Tex.TexW, Settings.RatingBar_BG_Tex.TexH);
- glVertex2f(Position.RBX+Position.RBW, Position.RBY+Position.RBH);
-
- glTexCoord2f(Settings.RatingBar_BG_Tex.TexW, 0);
- glVertex2f(Position.RBX+Position.RBW, Position.RBY);
- glEnd;
-
- //Draw Rating bar itself
- Size := Position.RBX + Position.RBW * Players[Index].RBPos;
- glColor4f(R, G, B, 1);
- glBindTexture(GL_TEXTURE_2D, Settings.RatingBar_Bar_Tex.TexNum);
- glBegin(GL_QUADS);
- glTexCoord2f(0, 0);
- glVertex2f(Position.RBX, Position.RBY);
-
- glTexCoord2f(0, Settings.RatingBar_Bar_Tex.TexH);
- glVertex2f(Position.RBX, Position.RBY + Position.RBH);
-
- glTexCoord2f(Settings.RatingBar_Bar_Tex.TexW, Settings.RatingBar_Bar_Tex.TexH);
- glVertex2f(Size, Position.RBY + Position.RBH);
-
- glTexCoord2f(Settings.RatingBar_Bar_Tex.TexW, 0);
- glVertex2f(Size, Position.RBY);
- glEnd;
-
- //Draw Ratingbar FG (Teh thing with the 3 lines to get better readability)
- glColor4f(1, 1, 1, 0.6);
- glBindTexture(GL_TEXTURE_2D, Settings.RatingBar_FG_Tex.TexNum);
- glBegin(GL_QUADS);
- glTexCoord2f(0, 0);
- glVertex2f(Position.RBX, Position.RBY);
-
- glTexCoord2f(0, Settings.RatingBar_FG_Tex.TexH);
- glVertex2f(Position.RBX, Position.RBY + Position.RBH);
-
- glTexCoord2f(Settings.RatingBar_FG_Tex.TexW, Settings.RatingBar_FG_Tex.TexH);
- glVertex2f(Position.RBX + Position.RBW, Position.RBY + Position.RBH);
-
- glTexCoord2f(Settings.RatingBar_FG_Tex.TexW, 0);
- glVertex2f(Position.RBX + Position.RBW, Position.RBY);
- glEnd;
-
- //Disable all Enabled glFuncs
- glDisable(GL_TEXTURE_2D);
- glDisable(GL_BLEND);
- end; //eo Right Screen
- end; //eo Player has Position
-end;
-
-end.
diff --git a/src/classes/USkins.pas b/src/classes/USkins.pas
deleted file mode 100644
index 88549c9f..00000000
--- a/src/classes/USkins.pas
+++ /dev/null
@@ -1,185 +0,0 @@
-unit USkins;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-type
- TSkinTexture = record
- Name: string;
- FileName: string;
- end;
-
- TSkinEntry = record
- Theme: string;
- Name: string;
- Path: string;
- FileName: string;
- Creator: string; // not used yet
- end;
-
- TSkin = class
- Skin: array of TSkinEntry;
- SkinTexture: array of TSkinTexture;
- SkinPath: string;
- Color: integer;
- constructor Create;
- procedure LoadList;
- procedure ParseDir(Dir: string);
- procedure LoadHeader(FileName: string);
- procedure LoadSkin(Name: string);
- function GetTextureFileName(TextureName: string): string;
- function GetSkinNumber(Name: string): integer;
- procedure onThemeChange;
- end;
-
-var
- Skin: TSkin;
-
-implementation
-
-uses IniFiles,
- Classes,
- SysUtils,
- UMain,
- ULog,
- UIni;
-
-constructor TSkin.Create;
-begin
- inherited;
- LoadList;
-// LoadSkin('Lisek');
-// SkinColor := Color;
-end;
-
-procedure TSkin.LoadList;
-var
- SR: TSearchRec;
-begin
- if FindFirst(SkinsPath+'*', faDirectory, SR) = 0 then begin
- repeat
- if (SR.Name <> '.') and (SR.Name <> '..') then
- ParseDir(SkinsPath + SR.Name + PathDelim);
- until FindNext(SR) <> 0;
- end; // if
- FindClose(SR);
-end;
-
-procedure TSkin.ParseDir(Dir: string);
-var
- SR: TSearchRec;
-begin
- if FindFirst(Dir + '*.ini', faAnyFile, SR) = 0 then begin
- repeat
-
- if (SR.Name <> '.') and (SR.Name <> '..') then
- LoadHeader(Dir + SR.Name);
-
- until FindNext(SR) <> 0;
- end;
-end;
-
-procedure TSkin.LoadHeader(FileName: string);
-var
- SkinIni: TMemIniFile;
- S: integer;
-begin
- SkinIni := TMemIniFile.Create(FileName);
-
- S := Length(Skin);
- SetLength(Skin, S+1);
-
- Skin[S].Path := IncludeTrailingPathDelimiter(ExtractFileDir(FileName));
- Skin[S].FileName := ExtractFileName(FileName);
- Skin[S].Theme := SkinIni.ReadString('Skin', 'Theme', '');
- Skin[S].Name := SkinIni.ReadString('Skin', 'Name', '');
- Skin[S].Creator := SkinIni.ReadString('Skin', 'Creator', '');
-
- SkinIni.Free;
-end;
-
-procedure TSkin.LoadSkin(Name: string);
-var
- SkinIni: TMemIniFile;
- SL: TStringList;
- T: integer;
- S: integer;
-begin
- S := GetSkinNumber(Name);
- SkinPath := Skin[S].Path;
-
- SkinIni := TMemIniFile.Create(SkinPath + Skin[S].FileName);
-
- SL := TStringList.Create;
- SkinIni.ReadSection('Textures', SL);
-
- SetLength(SkinTexture, SL.Count);
- for T := 0 to SL.Count-1 do
- begin
- SkinTexture[T].Name := SL.Strings[T];
- SkinTexture[T].FileName := SkinIni.ReadString('Textures', SL.Strings[T], '');
- end;
-
- SL.Free;
- SkinIni.Free;
-end;
-
-function TSkin.GetTextureFileName(TextureName: string): string;
-var
- T: integer;
-begin
- Result := '';
-
- for T := 0 to High(SkinTexture) do
- begin
- if ( SkinTexture[T].Name = TextureName ) AND
- ( SkinTexture[T].FileName <> '' ) then
- begin
- Result := SkinPath + SkinTexture[T].FileName;
- end;
- end;
-
- if ( TextureName <> '' ) AND
- ( Result <> '' ) THEN
- begin
- //Log.LogError('', '-----------------------------------------');
- //Log.LogError(TextureName+' - '+ Result, 'TSkin.GetTextureFileName');
- end;
-
-{ Result := SkinPath + 'Bar.jpg';
- if TextureName = 'Ball' then Result := SkinPath + 'Ball.bmp';
- if Copy(TextureName, 1, 4) = 'Gray' then Result := SkinPath + 'Ball.bmp';
- if Copy(TextureName, 1, 6) = 'NoteBG' then Result := SkinPath + 'Ball.bmp';}
-end;
-
-function TSkin.GetSkinNumber(Name: string): integer;
-var
- S: integer;
-begin
- Result := 0; // set default to the first available skin
- for S := 0 to High(Skin) do
- if Skin[S].Name = Name then Result := S;
-end;
-
-procedure TSkin.onThemeChange;
-var
- S: integer;
- Name: String;
-begin
- Ini.SkinNo:=0;
- SetLength(ISkin, 0);
- Name := Uppercase(ITheme[Ini.Theme]);
- for S := 0 to High(Skin) do
- if Name = Uppercase(Skin[S].Theme) then begin
- SetLength(ISkin, Length(ISkin)+1);
- ISkin[High(ISkin)] := Skin[S].Name;
- end;
-
-end;
-
-end.
diff --git a/src/classes/USong.pas b/src/classes/USong.pas
deleted file mode 100644
index 3517bce6..00000000
--- a/src/classes/USong.pas
+++ /dev/null
@@ -1,1027 +0,0 @@
-unit USong;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses
- {$IFDEF MSWINDOWS}
- Windows,
- {$ELSE}
- {$IFNDEF DARWIN}
- syscall,
- {$ENDIF}
- baseunix,
- UnixType,
- {$ENDIF}
- SysUtils,
- Classes,
- UPlatform,
- ULog,
- UTexture,
- UCommon,
- {$IFDEF DARWIN}
- cthreads,
- {$ENDIF}
- {$IFDEF USE_PSEUDO_THREAD}
- PseudoThread,
- {$ENDIF}
- UCatCovers,
- UXMLSong;
-
-type
-
- TSingMode = ( smNormal, smPartyMode, smPlaylistRandom );
-
- TBPM = record
- BPM: real;
- StartBeat: real;
- end;
-
- TScore = record
- Name: WideString;
- Score: integer;
- Length: string;
- end;
-
- TSong = class
- FileLineNo : integer; //Line which is readed at Last, for error reporting
-
- procedure ParseNote(LineNumber: integer; TypeP: char; StartP, DurationP, NoteP: integer; LyricS: string);
- procedure NewSentence(LineNumberP: integer; Param1, Param2: integer);
-
- function ReadTXTHeader( const aFileName : WideString ): boolean;
- function ReadXMLHeader( const aFileName : WideString ): boolean;
- public
- Path: WideString;
- Folder: WideString; // for sorting by folder
- fFileName,
- FileName: WideString;
-
- // sorting methods
- Category: array of WideString; // TODO: do we need this?
- Genre: WideString;
- Edition: WideString;
- Language: WideString;
-
- Title: WideString;
- Artist: WideString;
-
- Text: WideString;
- Creator: WideString;
-
- Cover: WideString;
- CoverTex: TTexture;
- Mp3: WideString;
- Background: WideString;
- Video: WideString;
- VideoGAP: real;
- VideoLoaded: boolean; // true if the video has been loaded
- NotesGAP: integer;
- Start: real; // in seconds
- Finish: integer; // in miliseconds
- Relative: boolean;
- Resolution: integer;
- BPM: array of TBPM;
- GAP: real; // in miliseconds
-
- Score: array[0..2] of array of TScore;
-
- // these are used when sorting is enabled
- Visible: boolean; // false if hidden, true if visible
- Main: boolean; // false for songs, true for category buttons
- OrderNum: integer; // has a number of category for category buttons and songs
- OrderTyp: integer; // type of sorting for this button (0=name)
- CatNumber: integer; // Count of Songs in Category for Cats and Number of Song in Category for Songs
-
- SongFile: TextFile; // all procedures in this unit operate on this file
-
- Base : array[0..1] of integer;
- Rel : array[0..1] of integer;
- Mult : integer;
- MultBPM : integer;
-
- constructor Create (); overload;
- constructor Create ( const aFileName : WideString ); overload;
- function LoadSong: boolean;
- function LoadXMLSong: boolean;
- function Analyse(): boolean;
- function AnalyseXML(): boolean;
- procedure Clear();
- end;
-
-implementation
-
-uses
- TextGL,
- UIni,
- UMusic, //needed for Lines
- UMain; //needed for Player
-
-constructor TSong.Create();
-begin
- inherited;
-end;
-
-constructor TSong.Create( const aFileName : WideString );
-begin
- inherited Create();
-
- Mult := 1;
- MultBPM := 4;
- fFileName := aFileName;
-
- if fileexists( aFileName ) then
- begin
- self.Path := ExtractFilePath( aFileName );
- self.Folder := ExtractFilePath( aFileName );
- self.FileName := ExtractFileName( aFileName );
- (*
- if ReadTXTHeader( aFileName ) then
- begin
- LoadSong();
- end
- else
- begin
- Log.LogError('Error Loading SongHeader, abort Song Loading');
- Exit;
- end;
- *)
- end;
-end;
-
-//Load TXT Song
-function TSong.LoadSong(): boolean;
-
-var
- TempC: char;
- Text: string;
- CP: integer; // Current Player (0 or 1)
- Count: integer;
- Both: boolean;
- Param1: integer;
- Param2: integer;
- Param3: integer;
- ParamS: string;
- I: integer;
-begin
- Result := false;
-
- if not FileExists(Path + PathDelim + FileName) then
- begin
- Log.LogError('File not found: "' + Path + PathDelim + FileName + '"', 'TSong.LoadSong()');
- exit;
- end;
-
- MultBPM := 4; // multiply beat-count of note by 4
- Mult := 1; // accuracy of measurement of note
- Base[0] := 100; // high number
- Lines[0].ScoreValue := 0;
- self.Relative := false;
- Rel[0] := 0;
- CP := 0;
- Both := false;
-
- if Length(Player) = 2 then
- Both := true;
-
- try
- // Open song file for reading.....
- FileMode := fmOpenRead;
- AssignFile(SongFile, fFileName);
- Reset(SongFile);
-
- //Clear old Song Header
- if (self.Path = '') then
- self.Path := ExtractFilePath(FileName);
-
- if (self.FileName = '') then
- self.Filename := ExtractFileName(FileName);
-
- Result := False;
-
- Reset(SongFile);
- FileLineNo := 0;
- //Search for Note Begining
- repeat
- ReadLn(SongFile, Text);
- Inc(FileLineNo);
-
- if (EoF(SongFile)) then
- begin //Song File Corrupted - No Notes
- CloseFile(SongFile);
- Log.LogError('Could not load txt File, no Notes found: ' + FileName);
- Result := False;
- Exit;
- end;
- Read(SongFile, TempC);
- until ((TempC = ':') or (TempC = 'F') or (TempC = '*'));
-
- SetLength(Lines, 2);
- for Count := 0 to High(Lines) do
- begin
- SetLength(Lines[Count].Line, 1);
- Lines[Count].High := 0;
- Lines[Count].Number := 1;
- Lines[Count].Current := 0;
- Lines[Count].Resolution := self.Resolution;
- Lines[Count].NotesGAP := self.NotesGAP;
- Lines[Count].Line[0].HighNote := -1;
- Lines[Count].Line[0].LastLine := False;
- end;
-
- // TempC := ':';
- // TempC := Text[1]; // read from backup variable, don't use default ':' value
-
- while (TempC <> 'E') AND (not EOF(SongFile)) do
- begin
-
- if (TempC = ':') or (TempC = '*') or (TempC = 'F') then
- begin
- // read notes
- Read(SongFile, Param1);
- Read(SongFile, Param2);
- Read(SongFile, Param3);
- Read(SongFile, ParamS);
-
-
- //Check for ZeroNote
- if Param2 = 0 then Log.LogError('Found ZeroNote at "'+TempC+' '+IntToStr(Param1)+' '+IntToStr(Param2)+' '+IntToStr(Param3)+ParamS+'" -> Note ignored!') else
- begin
- // add notes
- if not Both then
- // P1
- ParseNote(0, TempC, (Param1+Rel[0]) * Mult, Param2 * Mult, Param3, ParamS)
- else begin
- // P1 + P2
- ParseNote(0, TempC, (Param1+Rel[0]) * Mult, Param2 * Mult, Param3, ParamS);
- ParseNote(1, TempC, (Param1+Rel[1]) * Mult, Param2 * Mult, Param3, ParamS);
- end;
- end; //Zeronote check
- end; // if
-
- if TempC = '-' then
- begin
- // reads sentence
- Read(SongFile, Param1);
- if self.Relative then Read(SongFile, Param2); // read one more data for relative system
-
- // new sentence
- if not Both then
- // P1
- NewSentence(0, (Param1 + Rel[0]) * Mult, Param2)
- else begin
- // P1 + P2
- NewSentence(0, (Param1 + Rel[0]) * Mult, Param2);
- NewSentence(1, (Param1 + Rel[1]) * Mult, Param2);
- end;
- end; // if
-
- if TempC = 'B' then
- begin
- SetLength(self.BPM, Length(self.BPM) + 1);
- Read(SongFile, self.BPM[High(self.BPM)].StartBeat);
- self.BPM[High(self.BPM)].StartBeat := self.BPM[High(self.BPM)].StartBeat + Rel[0];
-
- Read(SongFile, Text);
- self.BPM[High(self.BPM)].BPM := StrToFloat(Text);
- self.BPM[High(self.BPM)].BPM := self.BPM[High(self.BPM)].BPM * Mult * MultBPM;
- end;
-
-
- if not Both then
- begin
- Lines[CP].Line[Lines[CP].High].BaseNote := Base[CP];
- Lines[CP].Line[Lines[CP].High].LyricWidth := glTextWidth(PChar(Lines[CP].Line[Lines[CP].High].Lyric));
- //Total Notes Patch
- Lines[CP].Line[Lines[CP].High].TotalNotes := 0;
- for I := low(Lines[CP].Line[Lines[CP].High].Note) to high(Lines[CP].Line[Lines[CP].High].Note) do
- begin
- if (Lines[CP].Line[Lines[CP].High].Note[I].NoteType = ntGolden) then
- Lines[CP].Line[Lines[CP].High].TotalNotes := Lines[CP].Line[Lines[CP].High].TotalNotes + Lines[CP].Line[Lines[CP].High].Note[I].Length;
-
- if (Lines[CP].Line[Lines[CP].High].Note[I].NoteType <> ntFreestyle) then
- Lines[CP].Line[Lines[CP].High].TotalNotes := Lines[CP].Line[Lines[CP].High].TotalNotes + Lines[CP].Line[Lines[CP].High].Note[I].Length;
- end;
- //Total Notes Patch End
- end else begin
- for Count := 0 to High(Lines) do
- begin
- Lines[Count].Line[Lines[Count].High].BaseNote := Base[Count];
- Lines[Count].Line[Lines[Count].High].LyricWidth := glTextWidth(PChar(Lines[Count].Line[Lines[Count].High].Lyric));
- //Total Notes Patch
- Lines[Count].Line[Lines[Count].High].TotalNotes := 0;
- for I := low(Lines[Count].Line[Lines[Count].High].Note) to high(Lines[Count].Line[Lines[Count].High].Note) do
- begin
- if (Lines[Count].Line[Lines[Count].High].Note[I].NoteType = ntGolden) then
- Lines[Count].Line[Lines[Count].High].TotalNotes := Lines[Count].Line[Lines[Count].High].TotalNotes + Lines[Count].Line[Lines[Count].High].Note[I].Length;
- if (Lines[Count].Line[Lines[Count].High].Note[I].NoteType <> ntFreestyle) then
- Lines[Count].Line[Lines[Count].High].TotalNotes := Lines[Count].Line[Lines[Count].High].TotalNotes + Lines[Count].Line[Lines[Count].High].Note[I].Length;
- end;
- //Total Notes Patch End
- end;
- end;
- Read(SongFile, TempC);
- Inc(FileLineNo);
- end; // while}
-
- for Count := 0 to High(Lines) do
- begin
- Lines[Count].Line[High(Lines[Count].Line)].LastLine := True;
- end;
-
- CloseFile(SongFile);
- except
- try
- CloseFile(SongFile);
- except
-
- end;
-
- Log.LogError('Error Loading File: "' + fFileName + '" in Line ' + inttostr(FileLineNo));
- exit;
- end;
-
- Result := true;
-end;
-
-//Load XML Song
-function TSong.LoadXMLSong(): boolean;
-var
- //TempC: char;
- Text: string;
- CP: integer; // Current Player (0 or 1)
- Count: integer;
- Both: boolean;
- Param1: integer;
- Param2: integer;
- Param3: integer;
- ParamS: string;
- I,J,X: integer;
-
- NoteType: Char;
- SentenceEnd, Rest, Time: Integer;
- Parser: TParser;
-begin
- Result := false;
-
- if not FileExists(Path + PathDelim + FileName) then
- begin
- Log.LogError('File not found: "' + Path + PathDelim + FileName + '"', 'TSong.LoadSong()');
- exit;
- end;
-
- MultBPM := 4; // multiply beat-count of note by 4
- Mult := 1; // accuracy of measurement of note
- Base[0] := 100; // high number
- Lines[0].ScoreValue := 0;
- self.Relative := false;
- Rel[0] := 0;
- CP := 0;
- Both := false;
-
- if Length(Player) = 2 then
- Both := true;
-
- Parser := TParser.Create;
- Parser.Settings.DashReplacement := '~';
-
- for Count := 0 to High(Lines) do
- begin
- SetLength(Lines[Count].Line, 1);
- Lines[Count].High := 0;
- Lines[Count].Number := 1;
- Lines[Count].Current := 0;
- Lines[Count].Resolution := self.Resolution;
- Lines[Count].NotesGAP := self.NotesGAP;
- Lines[Count].Line[0].HighNote := -1;
- Lines[Count].Line[0].LastLine := False;
- end;
-
-//Try to Parse the Song
-
- if Parser.ParseSong(Path + PathDelim + FileName) then
- begin
-// Writeln('XML Inputfile Parsed succesful');
- //Start write parsed information to Song
- //Notes Part
- for I := 0 to High(Parser.SongInfo.Sentences) do
- begin
- //Add Notes
- for J := 0 to High(Parser.SongInfo.Sentences[I].Notes) do
- begin
- case Parser.SongInfo.Sentences[I].Notes[J].NoteTyp of
- NT_Normal: NoteType := ':';
- NT_Golden: NoteType := '*';
- NT_Freestyle: NoteType := 'F';
- end;
-
- Param1:=Parser.SongInfo.Sentences[I].Notes[J].Start; //Note Start
- Param2:=Parser.SongInfo.Sentences[I].Notes[J].Duration; //Note Duration
- Param3:=Parser.SongInfo.Sentences[I].Notes[J].Tone; //Note Tone
- ParamS:=' ' + Parser.SongInfo.Sentences[I].Notes[J].Lyric; //Note Lyric
-
- if not Both then
- // P1
- ParseNote(0, NoteType, (Param1+Rel[0]) * Mult, Param2 * Mult, Param3, ParamS)
- else
- begin
- // P1 + P2
- ParseNote(0, NoteType, (Param1+Rel[0]) * Mult, Param2 * Mult, Param3, ParamS);
- ParseNote(1, NoteType, (Param1+Rel[1]) * Mult, Param2 * Mult, Param3, ParamS);
- end;
-
- if not Both then
- begin
- Lines[CP].Line[Lines[CP].High].BaseNote := Base[CP];
- Lines[CP].Line[Lines[CP].High].LyricWidth := glTextWidth(PChar(Lines[CP].Line[Lines[CP].High].Lyric));
- //Total Notes Patch
- Lines[CP].Line[Lines[CP].High].TotalNotes := 0;
- for X := low(Lines[CP].Line[Lines[CP].High].Note) to high(Lines[CP].Line[Lines[CP].High].Note) do
- begin
- if (Lines[CP].Line[Lines[CP].High].Note[I].NoteType = ntGolden) then
- Lines[CP].Line[Lines[CP].High].TotalNotes := Lines[CP].Line[Lines[CP].High].TotalNotes + Lines[CP].Line[Lines[CP].High].Note[X].Length;
-
- if (Lines[CP].Line[Lines[CP].High].Note[I].NoteType <> ntFreestyle) then
- Lines[CP].Line[Lines[CP].High].TotalNotes := Lines[CP].Line[Lines[CP].High].TotalNotes + Lines[CP].Line[Lines[CP].High].Note[X].Length;
- end;
- //Total Notes Patch End
- end
- else
- begin
- for Count := 0 to High(Lines) do
- begin
- Lines[Count].Line[Lines[Count].High].BaseNote := Base[Count];
- Lines[Count].Line[Lines[Count].High].LyricWidth := glTextWidth(PChar(Lines[Count].Line[Lines[Count].High].Lyric));
- //Total Notes Patch
- Lines[Count].Line[Lines[Count].High].TotalNotes := 0;
- for X := low(Lines[Count].Line[Lines[Count].High].Note) to high(Lines[Count].Line[Lines[Count].High].Note) do
- begin
- if (Lines[Count].Line[Lines[Count].High].Note[I].NoteType = ntGolden) then
- Lines[Count].Line[Lines[Count].High].TotalNotes := Lines[Count].Line[Lines[Count].High].TotalNotes + Lines[Count].Line[Lines[Count].High].Note[X].Length;
- if (Lines[Count].Line[Lines[Count].High].Note[I].NoteType <> ntFreestyle) then
- Lines[Count].Line[Lines[Count].High].TotalNotes := Lines[Count].Line[Lines[Count].High].TotalNotes + Lines[Count].Line[Lines[Count].High].Note[X].Length;
-
- end;
- //Total Notes Patch End
- end;
- end; { end of for loop }
-
- end; //J Forloop
-
- //Add Sentence break
- if (I < High(Parser.SongInfo.Sentences)) then
- begin
-
- SentenceEnd := Parser.SongInfo.Sentences[I].Notes[High(Parser.SongInfo.Sentences[I].Notes)].Start + Parser.SongInfo.Sentences[I].Notes[High(Parser.SongInfo.Sentences[I].Notes)].Duration;
- Rest := Parser.SongInfo.Sentences[I+1].Notes[0].Start - SentenceEnd;
-
- //Calculate Time
- case Rest of
- 0, 1: Time := Parser.SongInfo.Sentences[I+1].Notes[0].Start;
- 2: Time := Parser.SongInfo.Sentences[I+1].Notes[0].Start - 1;
- 3: Time := Parser.SongInfo.Sentences[I+1].Notes[0].Start - 2;
- else
- if (Rest >= 4) then
- Time := SentenceEnd + 2
- else //Sentence overlapping :/
- Time := Parser.SongInfo.Sentences[I+1].Notes[0].Start;
- end;
- // new sentence
- if not Both then
- // P1
- NewSentence(0, (Time + Rel[0]) * Mult, Param2)
- else
- begin
- // P1 + P2
- NewSentence(0, (Time + Rel[0]) * Mult, Param2);
- NewSentence(1, (Time + Rel[1]) * Mult, Param2);
- end;
-
- end;
- end;
- //End write parsed information to Song
- Parser.Free;
- end
- else
- begin
- Log.LogError('Could not parse Inputfile: ' + Path + PathDelim + FileName);
- exit;
- end;
-
- for Count := 0 to High(Lines) do
- begin
- Lines[Count].Line[High(Lines[Count].Line)].LastLine := True;
- end;
-
- Result := true;
-end;
-
-function TSong.ReadXMLHeader(const aFileName : WideString): boolean;
-var
- Line, Identifier, Value: string;
- Temp : word;
- Done : byte;
- Parser : TParser;
-begin
- Result := true;
- Done := 0;
-
-//Parse XML
- Parser := TParser.Create;
- Parser.Settings.DashReplacement := '~';
-
-
- if Parser.ParseSong(self.Path + self.FileName) then
- begin
- //-----------
- //Required Attributes
- //-----------
-
- //Title
- self.Title := Parser.SongInfo.Header.Title;
-
- //Add Title Flag to Done
- Done := Done or 1;
-
- //Artist
- self.Artist := Parser.SongInfo.Header.Artist;
-
- //Add Artist Flag to Done
- Done := Done or 2;
-
- //MP3 File //Test if Exists
- self.Mp3 := platform.FindSongFile(Path, '*.mp3');
- if (FileExists(self.Path + self.Mp3)) then
- //Add Mp3 Flag to Done
- Done := Done or 4;
-
- //Beats per Minute
- SetLength(self.BPM, 1);
- self.BPM[0].StartBeat := 0;
-
- self.BPM[0].BPM := (Parser.SongInfo.Header.BPM * Parser.SongInfo.Header.Resolution/4 ) * Mult * MultBPM;
-
- if self.BPM[0].BPM <> 0 then
- //Add BPM Flag to Done
- Done := Done or 8;
-
- //---------
- //Additional Header Information
- //---------
-
- // Gap
- self.GAP := Parser.SongInfo.Header.Gap;
-
- //Cover Picture
- self.Cover := platform.FindSongFile(Path, '*[CO].jpg');
-
- //Background Picture
- self.Background := platform.FindSongFile(Path, '*[BG].jpg');
-
- // Video File
- // self.Video := Value
-
- // Video Gap
- // self.VideoGAP := song_StrtoFloat( Value )
-
- //Genre Sorting
- self.Genre := Parser.SongInfo.Header.Genre;
-
- //Edition Sorting
- self.Edition := Parser.SongInfo.Header.Edition;
-
- //Year Sorting
- //Parser.SongInfo.Header.Year
-
- //Language Sorting
- self.Language := Parser.SongInfo.Header.Language;
- end else
- Log.LogError('File Incomplete or not SingStar XML (A): ' + aFileName);
-
- Parser.Free;
-
- //Check if all Required Values are given
- if (Done <> 15) then
- begin
- Result := False;
- if (Done and 8) = 0 then //No BPM Flag
- Log.LogError('BPM Tag Missing: ' + self.FileName)
- else if (Done and 4) = 0 then //No MP3 Flag
- Log.LogError('MP3 Tag/File Missing: ' + self.FileName)
- else if (Done and 2) = 0 then //No Artist Flag
- Log.LogError('Artist Tag Missing: ' + self.FileName)
- else if (Done and 1) = 0 then //No Title Flag
- Log.LogError('Title Tag Missing: ' + self.FileName)
- else //unknown Error
- Log.LogError('File Incomplete or not SingStar XML (B - '+ inttostr(Done) +'): ' + aFileName);
- end;
-
-end;
-
-
-function TSong.ReadTXTHeader(const aFileName : WideString): boolean;
-
- function song_StrtoFloat( aValue : string ) : Extended;
- var
- lValue : string;
-// lOldDecimalSeparator : Char; // Auto Removed, Unused Variable
- begin
- lValue := aValue;
-
- if (Pos(',', lValue) <> 0) then
- lValue[Pos(',', lValue)] := '.';
-
- Result := StrToFloatDef(lValue, 0);
- end;
-
-var
- Line, Identifier, Value: string;
- Temp : word;
- Done : byte;
-begin
- Result := true;
- Done := 0;
-
- //Read first Line
- ReadLn (SongFile, Line);
-
- if (Length(Line)<=0) then
- begin
- Log.LogError('File Starts with Empty Line: ' + aFileName);
- Result := False;
- Exit;
- end;
-
- //Read Lines while Line starts with # or its empty
- while ( Length(Line) = 0 ) or
- ( Line[1] = '#' ) do
- begin
- //Increase Line Number
- Inc (FileLineNo);
- Temp := Pos(':', Line);
-
- //Line has a Seperator-> Headerline
- if (Temp <> 0) then
- begin
- //Read Identifier and Value
- Identifier := Uppercase(Trim(Copy(Line, 2, Temp - 2))); //Uppercase is for Case Insensitive Checks
- Value := Trim(Copy(Line, Temp + 1,Length(Line) - Temp));
-
- //Check the Identifier (If Value is given)
- if (Length(Value) <> 0) then
- begin
-
- //-----------
- //Required Attributes
- //-----------
-
- {$IFDEF UTF8_FILENAMES}
- if ((Identifier = 'MP3') or (Identifier = 'BACKGROUND') or (Identifier = 'COVER') or (Identifier = 'VIDEO')) then
- Value := Utf8Encode(Value);
- {$ENDIF}
-
- //Title
- if (Identifier = 'TITLE') then
- begin
- self.Title := Value;
-
- //Add Title Flag to Done
- Done := Done or 1;
- end
-
- //Artist
- else if (Identifier = 'ARTIST') then
- begin
- self.Artist := Value;
-
- //Add Artist Flag to Done
- Done := Done or 2;
- end
-
- //MP3 File //Test if Exists
- else if (Identifier = 'MP3') AND
- (FileExists(self.Path + Value)) then
- begin
- self.Mp3 := Value;
-
- //Add Mp3 Flag to Done
- Done := Done or 4;
- end
-
- //Beats per Minute
- else if (Identifier = 'BPM') then
- begin
- SetLength(self.BPM, 1);
- self.BPM[0].StartBeat := 0;
-
- self.BPM[0].BPM := song_StrtoFloat( Value ) * Mult * MultBPM;
-
- if self.BPM[0].BPM <> 0 then
- begin
- //Add BPM Flag to Done
- Done := Done or 8;
- end;
- end
-
- //---------
- //Additional Header Information
- //---------
-
- // Gap
- else if (Identifier = 'GAP') then
- self.GAP := song_StrtoFloat( Value )
-
- //Cover Picture
- else if (Identifier = 'COVER') then
- self.Cover := Value
-
- //Background Picture
- else if (Identifier = 'BACKGROUND') then
- self.Background := Value
-
- // Video File
- else if (Identifier = 'VIDEO') then
- begin
- if (FileExists(self.Path + Value)) then
- self.Video := Value
- else
- Log.LogError('Can''t find Video File in Song: ' + aFileName);
- end
-
- // Video Gap
- else if (Identifier = 'VIDEOGAP') then
- self.VideoGAP := song_StrtoFloat( Value )
-
- //Genre Sorting
- else if (Identifier = 'GENRE') then
- self.Genre := Value
-
- //Edition Sorting
- else if (Identifier = 'EDITION') then
- self.Edition := Value
-
- //Creator Tag
- else if (Identifier = 'CREATOR') then
- self.Creator := Value
-
- //Language Sorting
- else if (Identifier = 'LANGUAGE') then
- self.Language := Value
-
- // Song Start
- else if (Identifier = 'START') then
- self.Start := song_StrtoFloat( Value )
-
- // Song Ending
- else if (Identifier = 'END') then
- TryStrtoInt(Value, self.Finish)
-
- // Resolution
- else if (Identifier = 'RESOLUTION') then
- TryStrtoInt(Value, self.Resolution)
-
- // Notes Gap
- else if (Identifier = 'NOTESGAP') then
- TryStrtoInt(Value, self.NotesGAP)
- // Relative Notes
- else if (Identifier = 'RELATIVE') AND (uppercase(Value) = 'YES') then
- self.Relative := True;
-
- end;
- end;
-
- if not EOf(SongFile) then
- ReadLn (SongFile, Line)
- else
- begin
- Result := False;
- Log.LogError('File Incomplete or not Ultrastar TxT (A): ' + aFileName);
- break;
- end;
-
- end;
-
- if self.Cover = '' then
- self.Cover := platform.FindSongFile(Path, '*[CO].jpg');
-
- //Check if all Required Values are given
- if (Done <> 15) then
- begin
- Result := False;
- if (Done and 8) = 0 then //No BPM Flag
- Log.LogError('BPM Tag Missing: ' + self.FileName)
- else if (Done and 4) = 0 then //No MP3 Flag
- Log.LogError('MP3 Tag/File Missing: ' + self.FileName)
- else if (Done and 2) = 0 then //No Artist Flag
- Log.LogError('Artist Tag Missing: ' + self.FileName)
- else if (Done and 1) = 0 then //No Title Flag
- Log.LogError('Title Tag Missing: ' + self.FileName)
- else //unknown Error
- Log.LogError('File Incomplete or not Ultrastar TxT (B - '+ inttostr(Done) +'): ' + aFileName);
- end;
-
-end;
-
-procedure TSong.ParseNote(LineNumber: integer; TypeP: char; StartP, DurationP, NoteP: integer; LyricS: string);
-//var
-// Space: boolean; // Auto Removed, Unused Variable
-begin
- case Ini.Solmization of
- 1: // european
- begin
- case (NoteP mod 12) of
- 0..1: LyricS := ' do ';
- 2..3: LyricS := ' re ';
- 4: LyricS := ' mi ';
- 5..6: LyricS := ' fa ';
- 7..8: LyricS := ' sol ';
- 9..10: LyricS := ' la ';
- 11: LyricS := ' si ';
- end;
- end;
- 2: // japanese
- begin
- case (NoteP mod 12) of
- 0..1: LyricS := ' do ';
- 2..3: LyricS := ' re ';
- 4: LyricS := ' mi ';
- 5..6: LyricS := ' fa ';
- 7..8: LyricS := ' so ';
- 9..10: LyricS := ' la ';
- 11: LyricS := ' shi ';
- end;
- end;
- 3: // american
- begin
- case (NoteP mod 12) of
- 0..1: LyricS := ' do ';
- 2..3: LyricS := ' re ';
- 4: LyricS := ' mi ';
- 5..6: LyricS := ' fa ';
- 7..8: LyricS := ' sol ';
- 9..10: LyricS := ' la ';
- 11: LyricS := ' ti ';
- end;
- end;
- end; // case
-
- with Lines[LineNumber].Line[Lines[LineNumber].High] do
- begin
- SetLength(Note, Length(Note) + 1);
- HighNote := High(Note);
-
- Note[HighNote].Start := StartP;
- if HighNote = 0 then
- begin
- if Lines[LineNumber].Number = 1 then
- Start := -100;
-// Start := Note[HighNote].Start;
- end;
-
- Note[HighNote].Length := DurationP;
-
- // back to the normal system with normal, golden and now freestyle notes
- case TypeP of
- 'F': Note[HighNote].NoteType := ntFreestyle;
- ':': Note[HighNote].NoteType := ntNormal;
- '*': Note[HighNote].NoteType := ntGolden;
- end;
-
- if (Note[HighNote].NoteType = ntGolden) then
- Lines[LineNumber].ScoreValue := Lines[LineNumber].ScoreValue + Note[HighNote].Length;
-
- if (Note[HighNote].NoteType <> ntFreestyle) then
- Lines[LineNumber].ScoreValue := Lines[LineNumber].ScoreValue + Note[HighNote].Length;
-
- Note[HighNote].Tone := NoteP;
- if Note[HighNote].Tone < Base[LineNumber] then Base[LineNumber] := Note[HighNote].Tone;
-
- Note[HighNote].Text := Copy(LyricS, 2, 100);
- Lyric := Lyric + Note[HighNote].Text;
-
- End_ := Note[HighNote].Start + Note[HighNote].Length;
- end; // with
-end;
-
-procedure TSong.NewSentence(LineNumberP: integer; Param1, Param2: integer);
-var
- I: integer;
-begin
-
- // stara czesc //Alter Satz //Update Old Part
- Lines[LineNumberP].Line[Lines[LineNumberP].High].BaseNote := Base[LineNumberP];
- Lines[LineNumberP].Line[Lines[LineNumberP].High].LyricWidth := glTextWidth(PChar(Lines[LineNumberP].Line[Lines[LineNumberP].High].Lyric));
-
- //Total Notes Patch
- Lines[LineNumberP].Line[Lines[LineNumberP].High].TotalNotes := 0;
- for I := low(Lines[LineNumberP].Line[Lines[LineNumberP].High].Note) to high(Lines[LineNumberP].Line[Lines[LineNumberP].High].Note) do
- begin
- if (Lines[LineNumberP].Line[Lines[LineNumberP].High].Note[I].NoteType = ntGolden) then
- Lines[LineNumberP].Line[Lines[LineNumberP].High].TotalNotes := Lines[LineNumberP].Line[Lines[LineNumberP].High].TotalNotes + Lines[LineNumberP].Line[Lines[LineNumberP].High].Note[I].Length;
-
- if (Lines[LineNumberP].Line[Lines[LineNumberP].High].Note[I].NoteType <> ntFreestyle) then
- Lines[LineNumberP].Line[Lines[LineNumberP].High].TotalNotes := Lines[LineNumberP].Line[Lines[LineNumberP].High].TotalNotes + Lines[LineNumberP].Line[Lines[LineNumberP].High].Note[I].Length;
- end;
- //Total Notes Patch End
-
-
- // nowa czesc //Neuer Satz //Update New Part
- SetLength(Lines[LineNumberP].Line, Lines[LineNumberP].Number + 1);
- Lines[LineNumberP].High := Lines[LineNumberP].High + 1;
- Lines[LineNumberP].Number := Lines[LineNumberP].Number + 1;
- Lines[LineNumberP].Line[Lines[LineNumberP].High].HighNote := -1;
-
- if self.Relative then
- begin
- Lines[LineNumberP].Line[Lines[LineNumberP].High].Start := Param1;
- Rel[LineNumberP] := Rel[LineNumberP] + Param2;
- end
- else
- Lines[LineNumberP].Line[Lines[LineNumberP].High].Start := Param1;
-
- Lines[LineNumberP].Line[Lines[LineNumberP].High].LastLine := False;
-
- Base[LineNumberP] := 100; // high number
-end;
-
-procedure TSong.clear();
-begin
- //Main Information
- Title := '';
- Artist := '';
-
- //Sortings:
- Genre := 'Unknown';
- Edition := 'Unknown';
- Language := 'Unknown'; //Language Patch
-
- //Required Information
- Mp3 := '';
- {$IFDEF FPC}
- setlength( BPM, 0 );
- {$ELSE}
- BPM := nil;
- {$ENDIF}
-
- GAP := 0;
- Start := 0;
- Finish := 0;
-
- //Additional Information
- Background := '';
- Cover := '';
- Video := '';
- VideoGAP := 0;
- NotesGAP := 0;
- Resolution := 4;
- Creator := '';
-
-end;
-
-function TSong.Analyse(): boolean;
-begin
- Result := False;
-
- //Reset LineNo
- FileLineNo := 0;
-
- //Open File and set File Pointer to the beginning
- AssignFile(SongFile, self.Path + self.FileName);
-
- try
- Reset(SongFile);
-
- //Clear old Song Header
- self.clear;
-
- //Read Header
- Result := self.ReadTxTHeader( FileName )
-
- //And Close File
- finally
- CloseFile(SongFile);
- end;
-end;
-
-
-function TSong.AnalyseXML(): boolean;
-begin
- Result := False;
-
- //Reset LineNo
- FileLineNo := 0;
-
- //Clear old Song Header
- self.clear;
-
- //Read Header
- Result := self.ReadXMLHeader( FileName );
-
-end;
-
-end.
diff --git a/src/classes/USongs.pas b/src/classes/USongs.pas
deleted file mode 100644
index 710cd44f..00000000
--- a/src/classes/USongs.pas
+++ /dev/null
@@ -1,806 +0,0 @@
-unit USongs;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-{$IFDEF DARWIN}
- {$IFDEF DEBUG}
- {$DEFINE USE_PSEUDO_THREAD}
- {$ENDIF}
-{$ENDIF}
-
-uses
- {$IFDEF MSWINDOWS}
- Windows,
- DirWatch,
- {$ELSE}
- {$IFNDEF DARWIN}
- syscall,
- {$ENDIF}
- baseunix,
- UnixType,
- {$ENDIF}
- SysUtils,
- Classes,
- UPlatform,
- ULog,
- UTexture,
- UCommon,
- {$IFDEF DARWIN}
- cthreads,
- {$ENDIF}
- {$IFDEF USE_PSEUDO_THREAD}
- PseudoThread,
- {$ENDIF}
- USong,
- UCatCovers;
-
-type
-
- TBPM = record
- BPM: real;
- StartBeat: real;
- end;
-
- TScore = record
- Name: widestring;
- Score: integer;
- Length: string;
- end;
-
- {$IFDEF USE_PSEUDO_THREAD}
- TSongs = class( TPseudoThread )
- {$ELSE}
- TSongs = class( TThread )
- {$ENDIF}
- private
- fNotify, fWatch : longint;
- fParseSongDirectory : boolean;
- fProcessing : boolean;
- {$ifdef MSWINDOWS}
- fDirWatch : TDirectoryWatch;
- {$endif}
- procedure int_LoadSongList;
- procedure DoDirChanged(Sender: TObject);
- protected
- procedure Execute; override;
- public
- SongList : TList; // array of songs
- Selected : integer; // selected song index
- constructor Create();
- destructor Destroy(); override;
-
-
- procedure LoadSongList; // load all songs
- procedure BrowseDir(Dir: widestring); // should return number of songs in the future
- procedure BrowseTXTFiles(Dir: widestring);
- procedure BrowseXMLFiles(Dir: widestring);
- procedure Sort(Order: integer);
- function FindSongFile(Dir, Mask: widestring): widestring;
- property Processing : boolean read fProcessing;
- end;
-
-
- TCatSongs = class
- Song: array of TSong; // array of categories with songs
- Selected: integer; // selected song index
- Order: integer; // order type (0=title)
- CatNumShow: integer; // Category Number being seen
- CatCount: integer; //Number of Categorys
-
- procedure SortSongs();
- procedure Refresh; // refreshes arrays by recreating them from Songs array
- procedure ShowCategory(Index: integer); // expands all songs in category
- procedure HideCategory(Index: integer); // hides all songs in category
- procedure ClickCategoryButton(Index: integer); // uses ShowCategory and HideCategory when needed
- procedure ShowCategoryList; //Hides all Songs And Show the List of all Categorys
- function FindNextVisible(SearchFrom:integer): integer; //Find Next visible Song
- function VisibleSongs: integer; // returns number of visible songs (for tabs)
- function VisibleIndex(Index: integer): integer; // returns visible song index (skips invisible)
-
- function SetFilter(FilterStr: string; const fType: Byte): Cardinal;
- end;
-
-var
- Songs: TSongs; // all songs
- CatSongs: TCatSongs; // categorized songs
-
-const
- IN_ACCESS = $00000001; //* File was accessed */
- IN_MODIFY = $00000002; //* File was modified */
- IN_ATTRIB = $00000004; //* Metadata changed */
- IN_CLOSE_WRITE = $00000008; //* Writtable file was closed */
- IN_CLOSE_NOWRITE = $00000010; //* Unwrittable file closed */
- IN_OPEN = $00000020; //* File was opened */
- IN_MOVED_FROM = $00000040; //* File was moved from X */
- IN_MOVED_TO = $00000080; //* File was moved to Y */
- IN_CREATE = $00000100; //* Subfile was created */
- IN_DELETE = $00000200; //* Subfile was deleted */
- IN_DELETE_SELF = $00000400; //* Self was deleted */
-
-
-implementation
-
-uses StrUtils,
- UGraphic,
- UCovers,
- UFiles,
- UMain,
- UIni;
-
-constructor TSongs.Create();
-begin
- // do not start thread BEFORE initialization (suspended = true)
- inherited Create(true);
- Self.FreeOnTerminate := true;
-
- SongList := TList.Create();
-
- // FIXME: threaded loading does not work this way.
- // It will just cause crashes but nothing else at the moment.
- (*
- {$ifdef MSWINDOWS}
- fDirWatch := TDirectoryWatch.create(nil);
- fDirWatch.OnChange := DoDirChanged;
- fDirWatch.Directory := SongPath;
- fDirWatch.WatchSubDirs := true;
- fDirWatch.active := true;
- {$ENDIF}
-
- // now we can start the thread
- Resume();
- *)
-
- // until it is fixed, simply load the song-list
- int_LoadSongList();
-end;
-
-destructor TSongs.Destroy();
-begin
- FreeAndNil( SongList );
- inherited;
-end;
-
-procedure TSongs.DoDirChanged(Sender: TObject);
-begin
- LoadSongList();
-end;
-
-procedure TSongs.Execute();
-var
- fChangeNotify : THandle;
-begin
-{$IFDEF USE_PSEUDO_THREAD}
- int_LoadSongList();
-{$ELSE}
- fParseSongDirectory := true;
-
- while not terminated do
- begin
-
- if fParseSongDirectory then
- begin
- Log.LogStatus('Calling int_LoadSongList', 'TSongs.Execute');
- int_LoadSongList();
- end;
-
- Suspend();
- end;
-{$ENDIF}
-end;
-
-procedure TSongs.int_LoadSongList;
-var
- I: integer;
-begin
- try
- fProcessing := true;
-
- Log.LogStatus('Searching For Songs', 'SongList');
-
- // browse directories
- for I := 0 to SongPaths.Count-1 do
- BrowseDir(SongPaths[I]);
-
- if assigned( CatSongs ) then
- CatSongs.Refresh;
-
- if assigned( CatCovers ) then
- CatCovers.Load;
-
- //if assigned( Covers ) then
- // Covers.Load;
-
- if assigned(ScreenSong) then
- begin
- ScreenSong.GenerateThumbnails();
- ScreenSong.OnShow; // refresh ScreenSong
- end;
-
- finally
- Log.LogStatus('Search Complete', 'SongList');
-
- fParseSongDirectory := false;
- fProcessing := false;
- end;
-end;
-
-
-procedure TSongs.LoadSongList;
-begin
- fParseSongDirectory := true;
- Resume();
-end;
-
-procedure TSongs.BrowseDir(Dir: widestring);
-begin
- BrowseTXTFiles(Dir);
- BrowseXMLFiles(Dir);
-end;
-
-procedure TSongs.BrowseTXTFiles(Dir: widestring);
-var
- i : integer;
- Files : TDirectoryEntryArray;
- lSong : TSong;
-begin
-
- Files := Platform.DirectoryFindFiles( Dir, '.txt', true);
-
- for i := 0 to Length(Files)-1 do
- begin
- if Files[i].IsDirectory then
- begin
- BrowseTXTFiles( Dir + Files[i].Name + PathDelim ); //Recursive Call
- end
- else
- begin
- lSong := TSong.create( Dir + Files[i].Name );
-
- if lSong.Analyse then
- SongList.add( lSong )
- else
- begin
- Log.LogError('AnalyseFile failed for "' + Files[i].Name + '".');
- freeandnil( lSong );
- end;
-
- end;
- end;
- SetLength( Files, 0);
-
-end;
-
-procedure TSongs.BrowseXMLFiles(Dir: widestring);
-var
- i : integer;
- Files : TDirectoryEntryArray;
- lSong : TSong;
-begin
-
- Files := Platform.DirectoryFindFiles( Dir, '.xml', true);
-
- for i := 0 to Length(Files)-1 do
- begin
- if Files[i].IsDirectory then
- begin
- BrowseXMLFiles( Dir + Files[i].Name + PathDelim ); //Recursive Call
- end
- else
- begin
- lSong := TSong.create( Dir + Files[i].Name );
-
- if lSong.AnalyseXML then
- SongList.add( lSong )
- else
- begin
- Log.LogError('AnalyseFile failed for "' + Files[i].Name + '".');
- freeandnil( lSong );
- end;
-
- end;
- end;
- SetLength( Files, 0);
-
-end;
-
-(*
- * Comparison functions for sorting
- *)
-
-function CompareByEdition(Song1, Song2: Pointer): integer;
-begin
- Result := CompareText(TSong(Song1).Edition, TSong(Song2).Edition);
-end;
-
-function CompareByGenre(Song1, Song2: Pointer): integer;
-begin
- Result := CompareText(TSong(Song1).Genre, TSong(Song2).Genre);
-end;
-
-function CompareByTitle(Song1, Song2: Pointer): integer;
-begin
- Result := CompareText(TSong(Song1).Title, TSong(Song2).Title);
-end;
-
-function CompareByArtist(Song1, Song2: Pointer): integer;
-begin
- Result := CompareText(TSong(Song1).Artist, TSong(Song2).Artist);
-end;
-
-function CompareByFolder(Song1, Song2: Pointer): integer;
-begin
- Result := CompareText(TSong(Song1).Folder, TSong(Song2).Folder);
-end;
-
-function CompareByLanguage(Song1, Song2: Pointer): integer;
-begin
- Result := CompareText(TSong(Song1).Language, TSong(Song2).Language);
-end;
-
-procedure TSongs.Sort(Order: integer);
-var
- CompareFunc: TListSortCompare;
-begin
- // FIXME: what is the difference between artist and artist2, etc.?
- case Order of
- sEdition: // by edition
- CompareFunc := CompareByEdition;
- sGenre: // by genre
- CompareFunc := CompareByGenre;
- sTitle: // by title
- CompareFunc := CompareByTitle;
- sArtist: // by artist
- CompareFunc := CompareByArtist;
- sFolder: // by folder
- CompareFunc := CompareByFolder;
- sTitle2: // by title2
- CompareFunc := CompareByTitle;
- sArtist2: // by artist2
- CompareFunc := CompareByArtist;
- sLanguage: // by Language
- CompareFunc := CompareByLanguage;
- else
- Log.LogCritical('Unsupported comparison', 'TSongs.Sort');
- Exit; // suppress warning
- end; // case
-
- // Note: Do not use TList.Sort() as it uses QuickSort which is instable.
- // For example, if a list is sorted by title first and
- // by artist afterwards, the songs of an artist will not be sorted by title anymore.
- // The stable MergeSort guarantees to maintain this order.
- MergeSort(SongList, CompareFunc);
-end;
-
-function TSongs.FindSongFile(Dir, Mask: widestring): widestring;
-var
- SR: TSearchRec; // for parsing song directory
-begin
- Result := '';
- if FindFirst(Dir + Mask, faDirectory, SR) = 0 then
- begin
- Result := SR.Name;
- end; // if
- FindClose(SR);
-end;
-
-procedure TCatSongs.SortSongs();
-begin
- case Ini.Sorting of
- sEdition: begin
- Songs.Sort(sTitle);
- Songs.Sort(sArtist);
- Songs.Sort(sEdition);
- end;
- sGenre: begin
- Songs.Sort(sTitle);
- Songs.Sort(sArtist);
- Songs.Sort(sGenre);
- end;
- sLanguage: begin
- Songs.Sort(sTitle);
- Songs.Sort(sArtist);
- Songs.Sort(sLanguage);
- end;
- sFolder: begin
- Songs.Sort(sTitle);
- Songs.Sort(sArtist);
- Songs.Sort(sFolder);
- end;
- sTitle: begin
- Songs.Sort(sTitle);
- end;
- sArtist: begin
- Songs.Sort(sTitle);
- Songs.Sort(sArtist);
- end;
- sTitle2: begin
- Songs.Sort(sArtist2);
- Songs.Sort(sTitle2);
- end;
- sArtist2: begin
- Songs.Sort(sTitle2);
- Songs.Sort(sArtist2);
- end;
- end; // case
-end;
-
-procedure TCatSongs.Refresh;
-var
- SongIndex: integer;
- CurSong: TSong;
- CatIndex: integer; // index of current song in Song
- Letter: char; // current letter for sorting using letter
- CurCategory: string; // current edition for sorting using edition, genre etc.
- Order: integer; // number used for ordernum
- LetterTmp: char;
- CatNumber: integer; // Number of Song in Category
-
- procedure AddCategoryButton(const CategoryName: string);
- var
- PrevCatBtnIndex: integer;
- begin
- Inc(Order);
- CatIndex := Length(Song);
- SetLength(Song, CatIndex+1);
- Song[CatIndex] := TSong.Create();
- Song[CatIndex].Artist := '[' + CategoryName + ']';
- Song[CatIndex].Main := true;
- Song[CatIndex].OrderTyp := 0;
- Song[CatIndex].OrderNum := Order;
- Song[CatIndex].Cover := CatCovers.GetCover(Ini.Sorting, CategoryName);
- Song[CatIndex].Visible := true;
-
- // set number of songs in previous category
- PrevCatBtnIndex := CatIndex - CatNumber - 1;
- if ((PrevCatBtnIndex >= 0) and Song[PrevCatBtnIndex].Main) then
- Song[PrevCatBtnIndex].CatNumber := CatNumber;
-
- CatNumber := 0;
- end;
-
-begin
- CatNumShow := -1;
-
- SortSongs();
-
- CurCategory := '';
- Order := 0;
- CatNumber := 0;
-
- // Note: do NOT set Letter to ' ', otherwise no category-button will be
- // created for songs beginning with ' ' if songs of this category exist.
- // TODO: trim song-properties so ' ' will not occur as first chararcter.
- Letter := #0;
-
- // clear song-list
- for SongIndex := 0 to Songs.SongList.Count-1 do
- begin
- // free category buttons
- // Note: do NOT delete songs, they are just references to Songs.SongList entries
- CurSong := TSong(Songs.SongList[SongIndex]);
- if (CurSong.Main) then
- CurSong.Free;
- end;
- SetLength(Song, 0);
-
- for SongIndex := 0 to Songs.SongList.Count-1 do
- begin
- CurSong := TSong(Songs.SongList[SongIndex]);
- // if tabs are on, add section buttons for each new section
- if (Ini.Tabs = 1) then
- begin
- if (Ini.Sorting = sEdition) and
- (CompareText(CurCategory, CurSong.Edition) <> 0) then
- begin
- CurCategory := CurSong.Edition;
-
- // TODO: remove this block if it is not needed anymore
- {
- if CurSection = 'Singstar Part 2' then CoverName := 'Singstar';
- if CurSection = 'Singstar German' then CoverName := 'Singstar';
- if CurSection = 'Singstar Spanish' then CoverName := 'Singstar';
- if CurSection = 'Singstar Italian' then CoverName := 'Singstar';
- if CurSection = 'Singstar French' then CoverName := 'Singstar';
- if CurSection = 'Singstar 80s Polish' then CoverName := 'Singstar 80s';
- }
-
- // add Category Button
- AddCategoryButton(CurCategory);
- end
-
- else if (Ini.Sorting = sGenre) and
- (CompareText(CurCategory, CurSong.Genre) <> 0) then
- begin
- CurCategory := CurSong.Genre;
- // add Genre Button
- AddCategoryButton(CurCategory);
- end
-
- else if (Ini.Sorting = sLanguage) and
- (CompareText(CurCategory, CurSong.Language) <> 0) then
- begin
- CurCategory := CurSong.Language;
- // add Language Button
- AddCategoryButton(CurCategory);
- end
-
- else if (Ini.Sorting = sTitle) and
- (Length(CurSong.Title) >= 1) and
- (Letter <> UpperCase(CurSong.Title)[1]) then
- begin
- Letter := Uppercase(CurSong.Title)[1];
- // add a letter Category Button
- AddCategoryButton(Letter);
- end
-
- else if (Ini.Sorting = sArtist) and
- (Length(CurSong.Artist) >= 1) and
- (Letter <> UpperCase(CurSong.Artist)[1]) then
- begin
- Letter := UpperCase(CurSong.Artist)[1];
- // add a letter Category Button
- AddCategoryButton(Letter);
- end
-
- else if (Ini.Sorting = sFolder) and
- (CompareText(CurCategory, CurSong.Folder) <> 0) then
- begin
- CurCategory := CurSong.Folder;
- // add folder tab
- AddCategoryButton(CurCategory);
- end
-
- else if (Ini.Sorting = sTitle2) and
- (Length(CurSong.Title) >= 1) then
- begin
- // pack all numbers into a category named '#'
- if (CurSong.Title[1] >= '0') and (CurSong.Title[1] <= '9') then
- LetterTmp := '#'
- else
- LetterTmp := UpperCase(CurSong.Title)[1];
-
- if (Letter <> LetterTmp) then
- begin
- Letter := LetterTmp;
- // add a letter Category Button
- AddCategoryButton(Letter);
- end;
- end
-
- else if (Ini.Sorting = sArtist2) and
- (Length(CurSong.Artist)>=1) then
- begin
- // pack all numbers into a category named '#'
- if (CurSong.Artist[1] >= '0') and (CurSong.Artist[1] <= '9') then
- LetterTmp := '#'
- else
- LetterTmp := UpperCase(CurSong.Artist)[1];
-
- if (Letter <> LetterTmp) then
- begin
- Letter := LetterTmp;
- // add a letter Category Button
- AddCategoryButton(Letter);
- end;
- end;
- end;
-
- CatIndex := Length(Song);
- SetLength(Song, CatIndex+1);
-
- Inc(CatNumber); // increase number of songs in category
-
- // copy reference to current song
- Song[CatIndex] := CurSong;
-
- // set song's category info
- CurSong.OrderNum := Order; // assigns category
- CurSong.CatNumber := CatNumber;
-
- if (Ini.Tabs = 0) then
- CurSong.Visible := true
- else if (Ini.Tabs = 1) then
- CurSong.Visible := false;
-
- {
- if (Ini.Tabs = 1) and (Order = 1) then
- begin
- //open first tab
- CurSong.Visible := true;
- end;
- CurSong.Visible := true;
- }
- end;
-
- // set CatNumber of last category
- if (Ini.Tabs_at_startup = 1) and (High(Song) >= 1) then
- begin
- // set number of songs in previous category
- SongIndex := CatIndex - CatNumber;
- if ((SongIndex >= 0) and Song[SongIndex].Main) then
- Song[SongIndex].CatNumber := CatNumber;
- end;
-
- // update number of categories
- CatCount := Order;
-end;
-
-procedure TCatSongs.ShowCategory(Index: integer);
-var
- S: integer; // song
-begin
- CatNumShow := Index;
- for S := 0 to high(CatSongs.Song) do
- begin
-{
- if (CatSongs.Song[S].OrderNum = Index) and (not CatSongs.Song[S].Main) then
- CatSongs.Song[S].Visible := true
- else
- CatSongs.Song[S].Visible := false;
-}
-// KMS: This should be the same, but who knows :-)
- CatSongs.Song[S].Visible := ( (CatSongs.Song[S].OrderNum = Index) and (not CatSongs.Song[S].Main) );
- end;
-end;
-
-procedure TCatSongs.HideCategory(Index: integer); // hides all songs in category
-var
- S: integer; // song
-begin
- for S := 0 to high(CatSongs.Song) do
- begin
- if not CatSongs.Song[S].Main then
- CatSongs.Song[S].Visible := false // hides all at now
- end;
-end;
-
-procedure TCatSongs.ClickCategoryButton(Index: integer);
-var
- Num, S: integer;
-begin
- Num := CatSongs.Song[Index].OrderNum;
- if Num <> CatNumShow then
- begin
- ShowCategory(Num);
- end
- else
- begin
- ShowCategoryList;
- end;
-end;
-
-//Hide Categorys when in Category Hack
-procedure TCatSongs.ShowCategoryList;
-var
- Num, S: integer;
-begin
- // Hide All Songs Show All Cats
- for S := 0 to high(CatSongs.Song) do
- CatSongs.Song[S].Visible := CatSongs.Song[S].Main;
- CatSongs.Selected := CatNumShow; //Show last shown Category
- CatNumShow := -1;
-end;
-//Hide Categorys when in Category Hack End
-
-//Wrong song selected when tabs on bug
-function TCatSongs.FindNextVisible(SearchFrom:integer): integer;//Find next Visible Song
-var
- I: integer;
-begin
- Result := -1;
- I := SearchFrom + 1;
- while not CatSongs.Song[I].Visible do
- begin
- Inc (I);
- if (I>high(CatSongs.Song)) then
- I := low(CatSongs.Song);
- if (I = SearchFrom) then //Make One Round and no song found->quit
- break;
- end;
-end;
-//Wrong song selected when tabs on bug End
-
-(**
- * Returns the number of visible songs.
- *)
-function TCatSongs.VisibleSongs: integer;
-var
- SongIndex: integer;
-begin
- Result := 0;
- for SongIndex := 0 to High(CatSongs.Song) do
- begin
- if (CatSongs.Song[SongIndex].Visible) then
- Inc(Result);
- end;
-end;
-
-(**
- * Returns the index of a song in the subset of all visible songs.
- * If all songs are visible, the result will be equal to the Index parameter.
- *)
-function TCatSongs.VisibleIndex(Index: integer): integer;
-var
- SongIndex: integer;
-begin
- Result := 0;
- for SongIndex := 0 to Index-1 do
- begin
- if (CatSongs.Song[SongIndex].Visible) then
- Inc(Result);
- end;
-end;
-
-function TCatSongs.SetFilter(FilterStr: string; const fType: Byte): Cardinal;
-var
- I, J: integer;
- cString: string;
- SearchStr: array of string;
-begin
- {fType: 0: All
- 1: Title
- 2: Artist}
- FilterStr := Trim(FilterStr);
- if FilterStr<>'' then
- begin
- Result := 0;
- //Create Search Array
- SetLength(SearchStr, 1);
- I := Pos (' ', FilterStr);
- while (I <> 0) do
- begin
- SetLength (SearchStr, Length(SearchStr) + 1);
- cString := Copy(FilterStr, 1, I-1);
- if (cString <> ' ') and (cString <> '') then
- SearchStr[High(SearchStr)-1] := cString;
- Delete (FilterStr, 1, I);
-
- I := Pos (' ', FilterStr);
- end;
- //Copy last Word
- if (FilterStr <> ' ') and (FilterStr <> '') then
- SearchStr[High(SearchStr)] := FilterStr;
-
- for I:=0 to High(Song) do
- begin
- if not Song[i].Main then
- begin
- case fType of
- 0: cString := Song[I].Artist + ' ' + Song[i].Title + ' ' + Song[i].Folder;
- 1: cString := Song[I].Title;
- 2: cString := Song[I].Artist;
- end;
- Song[i].Visible:=True;
- //Look for every Searched Word
- for J := 0 to High(SearchStr) do
- begin
- Song[i].Visible := Song[i].Visible and AnsiContainsText(cString, SearchStr[J])
- end;
- if Song[i].Visible then
- Inc(Result);
- end
- else
- Song[i].Visible:=False;
- end;
- CatNumShow := -2;
- end
- else
- begin
- for i:=0 to High(Song) do
- begin
- Song[i].Visible := (Ini.Tabs=1) = Song[i].Main;
- CatNumShow := -1;
- end;
- Result := 0;
- end;
-end;
-
-// -----------------------------------------------------------------------------
-
-end.
diff --git a/src/classes/UTextClasses.pas b/src/classes/UTextClasses.pas
deleted file mode 100644
index 9a12e1f5..00000000
--- a/src/classes/UTextClasses.pas
+++ /dev/null
@@ -1,60 +0,0 @@
-unit UTextClasses;
-
-interface
-
-{$I switches.inc}
-
-uses
- gl,
- SDL,
- UTexture,
- Classes,
-// SDL_ttf,
- ULog;
-
-{
-// okay i just outline what should be here, so we can create a nice and clean implementation of sdl_ttf
-// based up on this uml: http://jnr.sourceforge.net/fusion_images/www_FRS.png
-// thanks to Bob Pendelton and Koshmaar!
-// (1) let's start with a glyph, this represents one character in a word
-
-type
- TGlyph = record
- character : Char; // unsigned char, uchar is something else in delphi
- glyphsSolid[8] : GlyphTexture; // fast, but not that
- glyphsBlended[8] : GlyphTexture; // slower than solid, but it look's more pretty
-
-//this class has a method, which should be a deconstructor (mog is on his way to understand the principles of oop :P)
- deconstructor procedure ReleaseTextures();
-end;
-
-// (2) okay, we now need the stuff that's even beneath this glyph - we're right at the birth of text in here :P
-
- GlyphTexture = record
- textureID : GLuint; // we need this for caching the letters, if the texture wasn't created before create it, should be very fast because of this one
- width,
- height : Cardinal;
- charWidth,
- charHeight : Integer;
- advance : Integer; // don't know yet for what this one is
-}
-
-{
-// after the glyph is done, we now start to build whole words - this one is pretty important, and does most of the work we need
- TGlyphsContainer = record
- glyphs array of TGlyph;
- FontName array of string;
- refCount : uChar; // unsigned char, uchar is something else in delphi
- font : PTTF_font;
- size,
- lineSkip : Cardinal; // vertical distance between multi line text output
- descent : Integer;
-
-
-
-}
-
-
-implementation
-
-end.
diff --git a/src/classes/UTexture.pas b/src/classes/UTexture.pas
deleted file mode 100644
index 4879760a..00000000
--- a/src/classes/UTexture.pas
+++ /dev/null
@@ -1,525 +0,0 @@
-unit UTexture;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses
- gl,
- glu,
- glext,
- Classes,
- SysUtils,
- UCommon,
- SDL,
- SDL_Image;
-
-type
- PTexture = ^TTexture;
- TTexture = record
- TexNum: GLuint;
- X: real;
- Y: real;
- Z: real;
- W: real;
- H: real;
- ScaleW: real; // for dynamic scalling while leaving width constant
- ScaleH: real; // for dynamic scalling while leaving height constant
- Rot: real; // 0 - 2*pi
- Int: real; // intensity
- ColR: real;
- ColG: real;
- ColB: real;
- TexW: real; // percentage of width to use [0..1]
- TexH: real; // percentage of height to use [0..1]
- TexX1: real;
- TexY1: real;
- TexX2: real;
- TexY2: real;
- Alpha: real;
- Name: string; // experimental for handling cache images. maybe it's useful for dynamic skins
- end;
-
-type
- TTextureType = (
- TEXTURE_TYPE_PLAIN, // Plain (alpha = 1)
- TEXTURE_TYPE_TRANSPARENT, // Alpha is used
- TEXTURE_TYPE_COLORIZED // Alpha is used; Hue of the HSV color-model will be replaced by a new value
- );
-
-const
- TextureTypeStr: array[TTextureType] of string = (
- 'Plain',
- 'Transparent',
- 'Colorized'
- );
-
-function TextureTypeToStr(TexType: TTextureType): string;
-function ParseTextureType(const TypeStr: string; Default: TTextureType): TTextureType;
-
-procedure AdjustPixelFormat(var TexSurface: PSDL_Surface; Typ: TTextureType);
-
-type
- PTextureEntry = ^TTextureEntry;
- TTextureEntry = record
- Name: string;
- Typ: TTextureType;
- Color: Cardinal;
-
- // we use normal TTexture, it's easier to implement and if needed - we copy ready data
- Texture: TTexture; // Full-size texture
- TextureCache: TTexture; // Thumbnail texture
- end;
-
- TTextureDatabase = class
- private
- Texture: array of TTextureEntry;
- public
- procedure AddTexture(var Tex: TTexture; Typ: TTextureType; Color: Cardinal; Cache: boolean);
- function FindTexture(const Name: string; Typ: TTextureType; Color: Cardinal): integer;
- end;
-
- TTextureUnit = class
- private
- TextureDatabase: TTextureDatabase;
- public
- Limit: integer;
-
- procedure AddTexture(var Tex: TTexture; Typ: TTextureType; Cache: boolean = false); overload;
- procedure AddTexture(var Tex: TTexture; Typ: TTextureType; Color: Cardinal; Cache: boolean = false); overload;
- function GetTexture(const Name: string; Typ: TTextureType; FromCache: boolean = false): TTexture; overload;
- function GetTexture(const Name: string; Typ: TTextureType; Col: LongWord; FromCache: boolean = false): TTexture; overload;
- function LoadTexture(FromRegistry: boolean; const Identifier: string; Typ: TTextureType; Col: LongWord): TTexture; overload;
- function LoadTexture(const Identifier: string; Typ: TTextureType; Col: LongWord): TTexture; overload;
- function LoadTexture(const Identifier: string): TTexture; overload;
- function CreateTexture(Data: PChar; const Name: string; Width, Height: word; BitsPerPixel: byte): TTexture;
- procedure UnloadTexture(const Name: string; Typ: TTextureType; FromCache: boolean); overload;
- procedure UnloadTexture(const Name: string; Typ: TTextureType; Col: Cardinal; FromCache: boolean); overload;
- //procedure FlushTextureDatabase();
-
- constructor Create;
- destructor Destroy; override;
- end;
-
-var
- Texture: TTextureUnit;
-
-implementation
-
-uses
- DateUtils,
- StrUtils,
- Math,
- ULog,
- UCovers,
- UThemes,
- UImage;
-
-procedure AdjustPixelFormat(var TexSurface: PSDL_Surface; Typ: TTextureType);
-var
- TempSurface: PSDL_Surface;
- NeededPixFmt: PSDL_Pixelformat;
-begin
- if (Typ = TEXTURE_TYPE_PLAIN) then
- NeededPixFmt := @PixelFmt_RGB
- else if (Typ = TEXTURE_TYPE_TRANSPARENT) or
- (Typ = TEXTURE_TYPE_COLORIZED) then
- NeededPixFmt := @PixelFmt_RGBA
- else
- NeededPixFmt := @PixelFmt_RGB;
-
- if not PixelformatEquals(TexSurface^.format, NeededPixFmt) then
- begin
- TempSurface := TexSurface;
- TexSurface := SDL_ConvertSurface(TempSurface, NeededPixFmt, SDL_SWSURFACE);
- SDL_FreeSurface(TempSurface);
- end;
-end;
-
-{ TTextureDatabase }
-
-procedure TTextureDatabase.AddTexture(var Tex: TTexture; Typ: TTextureType; Color: Cardinal; Cache: boolean);
-var
- TextureIndex: integer;
-begin
- TextureIndex := FindTexture(Tex.Name, Typ, Color);
- if (TextureIndex = -1) then
- begin
- TextureIndex := Length(Texture);
- SetLength(Texture, TextureIndex+1);
-
- Texture[TextureIndex].Name := Tex.Name;
- Texture[TextureIndex].Typ := Typ;
- Texture[TextureIndex].Color := Color;
- end;
-
- if (Cache) then
- Texture[TextureIndex].TextureCache := Tex
- else
- Texture[TextureIndex].Texture := Tex;
-end;
-
-function TTextureDatabase.FindTexture(const Name: string; Typ: TTextureType; Color: Cardinal): integer;
-var
- TextureIndex: integer;
- CurrentTexture: PTextureEntry;
-begin
- Result := -1;
- for TextureIndex := 0 to High(Texture) do
- begin
- CurrentTexture := @Texture[TextureIndex];
- if (CurrentTexture.Name = Name) and
- (CurrentTexture.Typ = Typ) then
- begin
- // colorized textures must match in their color too
- if (CurrentTexture.Typ <> TEXTURE_TYPE_COLORIZED) or
- (CurrentTexture.Color = Color) then
- begin
- Result := TextureIndex;
- Break;
- end;
- end;
- end;
-end;
-
-
-{ TTextureUnit }
-
-constructor TTextureUnit.Create;
-begin
- inherited Create;
- TextureDatabase := TTextureDatabase.Create;
-end;
-
-destructor TTextureUnit.Destroy;
-begin
- TextureDatabase.Free;
- inherited Destroy;
-end;
-
-
-procedure TTextureUnit.AddTexture(var Tex: TTexture; Typ: TTextureType; Cache: boolean);
-begin
- TextureDatabase.AddTexture(Tex, Typ, 0, Cache);
-end;
-
-procedure TTextureUnit.AddTexture(var Tex: TTexture; Typ: TTextureType; Color: Cardinal; Cache: boolean);
-begin
- TextureDatabase.AddTexture(Tex, Typ, Color, Cache);
-end;
-
-function TTextureUnit.LoadTexture(FromRegistry: boolean; const Identifier: string; Typ: TTextureType; Col: LongWord): TTexture;
-begin
- // FIXME: what is the FromRegistry parameter supposed to do?
- Result := LoadTexture(Identifier, Typ, Col);
-end;
-
-function TTextureUnit.LoadTexture(const Identifier: string): TTexture;
-begin
- Result := LoadTexture(Identifier, TEXTURE_TYPE_PLAIN, 0);
-end;
-
-function TTextureUnit.LoadTexture(const Identifier: string; Typ: TTextureType; Col: LongWord): TTexture;
-var
- TexSurface: PSDL_Surface;
- MipmapSurface: PSDL_Surface;
- newWidth, newHeight: Cardinal;
- oldWidth, oldHeight: Cardinal;
- ActTex: GLuint;
-begin
- // zero texture data
- FillChar(Result, SizeOf(Result), 0);
-
- // load texture data into memory
- TexSurface := LoadImage(Identifier);
- if not assigned(TexSurface) then
- begin
- Log.LogError('Could not load texture: "' + Identifier +' '+ TextureTypeToStr(Typ) +'"',
- 'TTextureUnit.LoadTexture');
- Exit;
- end;
-
- // convert pixel format as needed
- AdjustPixelFormat(TexSurface, Typ);
-
- // adjust texture size (scale down, if necessary)
- newWidth := TexSurface.W;
- newHeight := TexSurface.H;
-
- if (newWidth > Limit) then
- newWidth := Limit;
-
- if (newHeight > Limit) then
- newHeight := Limit;
-
- if (TexSurface.W > newWidth) or (TexSurface.H > newHeight) then
- ScaleImage(TexSurface, newWidth, newHeight);
-
- // now we might colorize the whole thing
- if (Typ = TEXTURE_TYPE_COLORIZED) then
- ColorizeImage(TexSurface, Col);
-
- // save actual dimensions of our texture
- oldWidth := newWidth;
- oldHeight := newHeight;
-
- // make texture dimensions be powers of 2
- newWidth := Round(Power(2, Ceil(Log2(newWidth))));
- newHeight := Round(Power(2, Ceil(Log2(newHeight))));
- if (newHeight <> oldHeight) or (newWidth <> oldWidth) then
- FitImage(TexSurface, newWidth, newHeight);
-
- // at this point we have the image in memory...
- // scaled to be at most 1024x1024 pixels large
- // scaled so that dimensions are powers of 2
- // and converted to either RGB or RGBA
-
- // if we got a Texture of Type Plain, Transparent or Colorized,
- // then we're done manipulating it
- // and could now create our openGL texture from it
-
- // prepare OpenGL texture
- glGenTextures(1, @ActTex);
-
- glBindTexture(GL_TEXTURE_2D, ActTex);
- glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
- glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE);
- glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE);
-
- // load data into gl texture
- if (Typ = TEXTURE_TYPE_TRANSPARENT) or
- (Typ = TEXTURE_TYPE_COLORIZED) then
- begin
- glTexImage2D(GL_TEXTURE_2D, 0, 4, newWidth, newHeight, 0, GL_RGBA, GL_UNSIGNED_BYTE, TexSurface.pixels);
- end
- else //if Typ = TEXTURE_TYPE_PLAIN then
- begin
- glTexImage2D(GL_TEXTURE_2D, 0, 3, newWidth, newHeight, 0, GL_RGB, GL_UNSIGNED_BYTE, TexSurface.pixels);
- end;
-
- // setup texture struct
- with Result do
- begin
- X := 0;
- Y := 0;
- Z := 0;
- W := 0;
- H := 0;
- ScaleW := 1;
- ScaleH := 1;
- Rot := 0;
- TexNum := ActTex;
- TexW := oldWidth / newWidth;
- TexH := oldHeight / newHeight;
-
- Int := 1;
- ColR := 1;
- ColG := 1;
- ColB := 1;
- Alpha := 1;
-
- // new test - default use whole texure, taking TexW and TexH as const and changing these
- TexX1 := 0;
- TexY1 := 0;
- TexX2 := 1;
- TexY2 := 1;
-
- Name := Identifier;
- end;
-
- SDL_FreeSurface(TexSurface);
-end;
-
-function TTextureUnit.GetTexture(const Name: string; Typ: TTextureType; FromCache: boolean): TTexture;
-begin
- Result := GetTexture(Name, Typ, 0, FromCache);
-end;
-
-function TTextureUnit.GetTexture(const Name: string; Typ: TTextureType; Col: LongWord; FromCache: boolean): TTexture;
-var
- TextureIndex: integer;
- CoverIndex: integer;
-begin
- if (Name = '') then
- begin
- // zero texture data
- FillChar(Result, SizeOf(Result), 0);
- Exit;
- end;
-
- if (FromCache) then
- begin
- (*
- // use cache texture
- CoverIndex := Covers.FindCover(Name);
-
- if TextureDatabase.Texture[TextureIndex].TextureCache.TexNum = 0 then
- begin
- // load texture
- Covers.PrepareData(Name);
- TextureDatabase.Texture[TextureIndex].TextureCache := CreateTexture(Covers.Data, Name, Covers.Cover[CoverIndex].Width, Covers.Cover[CoverIndex].Height, 24);
- end;
- *)
-
- // use texture
- TextureIndex := TextureDatabase.FindTexture(Name, Typ, Col);
- if (TextureIndex > -1) then
- Result := TextureDatabase.Texture[TextureIndex].TextureCache;
- Exit;
- end;
-
- // find texture entry in database
- TextureIndex := TextureDatabase.FindTexture(Name, Typ, Col);
- if (TextureIndex = -1) then
- begin
- // create texture entry in database
- TextureIndex := Length(TextureDatabase.Texture);
- SetLength(TextureDatabase.Texture, TextureIndex+1);
-
- TextureDatabase.Texture[TextureIndex].Name := Name;
- TextureDatabase.Texture[TextureIndex].Typ := Typ;
- TextureDatabase.Texture[TextureIndex].Color := Col;
-
- // inform database that no textures have been loaded into memory
- TextureDatabase.Texture[TextureIndex].Texture.TexNum := 0;
- TextureDatabase.Texture[TextureIndex].TextureCache.TexNum := 0;
- end;
-
- // load full texture
- if (TextureDatabase.Texture[TextureIndex].Texture.TexNum = 0) then
- TextureDatabase.Texture[TextureIndex].Texture := LoadTexture(false, Name, Typ, Col);
-
- // use texture
- Result := TextureDatabase.Texture[TextureIndex].Texture;
-end;
-
-function TTextureUnit.CreateTexture(Data: PChar; const Name: string; Width, Height: word; BitsPerPixel: byte): TTexture;
-var
- Error: integer;
- ActTex: GLuint;
-begin
- glGenTextures(1, @ActTex); // ActText = new texture number
- glBindTexture(GL_TEXTURE_2D, ActTex);
- glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
- glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE);
- glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE);
-
- glTexImage2D(GL_TEXTURE_2D, 0, 3, Width, Height, 0, GL_RGB, GL_UNSIGNED_BYTE, Data);
-
- {
- if Mipmapping then
- begin
- Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 3, W, H, GL_RGB, GL_UNSIGNED_BYTE, @Data[0]);
- if Error > 0 then
- Log.LogError('gluBuild2DMipmaps() failed', 'TTextureUnit.CreateTexture');
- end;
- }
-
- Result.X := 0;
- Result.Y := 0;
- Result.Z := 0;
- Result.W := 0;
- Result.H := 0;
- Result.ScaleW := 1;
- Result.ScaleH := 1;
- Result.Rot := 0;
- Result.TexNum := ActTex;
- Result.TexW := 1;
- Result.TexH := 1;
-
- Result.Int := 1;
- Result.ColR := 1;
- Result.ColG := 1;
- Result.ColB := 1;
- Result.Alpha := 1;
-
- // new test - default use whole texure, taking TexW and TexH as const and changing these
- Result.TexX1 := 0;
- Result.TexY1 := 0;
- Result.TexX2 := 1;
- Result.TexY2 := 1;
-
- Result.Name := Name;
-end;
-
-procedure TTextureUnit.UnloadTexture(const Name: string; Typ: TTextureType; FromCache: boolean);
-begin
- UnloadTexture(Name, Typ, 0, FromCache);
-end;
-
-procedure TTextureUnit.UnloadTexture(const Name: string; Typ: TTextureType; Col: Cardinal; FromCache: boolean);
-var
- T: integer;
- TexNum: GLuint;
-begin
- T := TextureDatabase.FindTexture(Name, Typ, Col);
-
- if not FromCache then
- begin
- TexNum := TextureDatabase.Texture[T].Texture.TexNum;
- if TexNum > 0 then
- begin
- glDeleteTextures(1, PGLuint(@TexNum));
- TextureDatabase.Texture[T].Texture.TexNum := 0;
- //Log.LogError('Unload texture no '+IntToStr(TexNum));
- end;
- end
- else
- begin
- TexNum := TextureDatabase.Texture[T].TextureCache.TexNum;
- if TexNum > 0 then
- begin
- glDeleteTextures(1, @TexNum);
- TextureDatabase.Texture[T].TextureCache.TexNum := 0;
- //Log.LogError('Unload texture cache no '+IntToStr(TexNum));
- end;
- end;
-end;
-
-(* This needs some work
-procedure TTextureUnit.FlushTextureDatabase();
-var
- i: integer;
- Tex: ^TTexture;
-begin
- for i := 0 to High(TextureDatabase.Texture) do
- begin
- // only delete non-cached entries
- if (TextureDatabase.Texture[i].Texture.TexNum > 0) then
- begin
- Tex := @TextureDatabase.Texture[i].Texture;
- glDeleteTextures(1, PGLuint(Tex^.TexNum));
- Tex^.TexNum := 0;
- end;
- end;
-end;
-*)
-
-function TextureTypeToStr(TexType: TTextureType): string;
-begin
- Result := TextureTypeStr[TexType];
-end;
-
-function ParseTextureType(const TypeStr: string; Default: TTextureType): TTextureType;
-var
- TexType: TTextureType;
- UpCaseStr: string;
-begin
- UpCaseStr := UpperCase(TypeStr);
- for TexType := Low(TextureTypeStr) to High(TextureTypeStr) do
- begin
- if (UpCaseStr = UpperCase(TextureTypeStr[TexType])) then
- begin
- Result := TexType;
- Exit;
- end;
- end;
- Log.LogWarn('Unknown texture-type: "' + TypeStr + '"', 'ParseTextureType');
- Result := TEXTURE_TYPE_PLAIN;
-end;
-
-end.
diff --git a/src/classes/UThemes.pas b/src/classes/UThemes.pas
deleted file mode 100644
index fca75c24..00000000
--- a/src/classes/UThemes.pas
+++ /dev/null
@@ -1,2234 +0,0 @@
-unit UThemes;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses
- ULog,
- IniFiles,
- SysUtils,
- Classes,
- UTexture;
-
-type
- TRGB = record
- R: single;
- G: single;
- B: single;
- end;
-
- TRGBA = record
- R, G, B, A: Double;
- end;
-
- TThemeBackground = record
- Tex: string;
- end;
-
- TThemeStatic = record
- X: integer;
- Y: integer;
- Z: real;
- W: integer;
- H: integer;
- Color: string;
- ColR: real;
- ColG: real;
- ColB: real;
- Tex: string;
- Typ: TTextureType;
- TexX1: real;
- TexY1: real;
- TexX2: real;
- TexY2: real;
- //Reflection
- Reflection: boolean;
- Reflectionspacing: Real;
- end;
- AThemeStatic = array of TThemeStatic;
-
- TThemeText = record
- X: integer;
- Y: integer;
- W: integer;
- Z: real;
- Color: string;
- ColR: real;
- ColG: real;
- ColB: real;
- Font: integer;
- Size: integer;
- Align: integer;
- Text: string;
- //Reflection
- Reflection: boolean;
- ReflectionSpacing: Real;
- end;
- AThemeText = array of TThemeText;
-
- TThemeButton = record
- Text: AThemeText;
- X: integer;
- Y: integer;
- Z: Real;
- W: integer;
- H: integer;
- Color: string;
- ColR: real;
- ColG: real;
- ColB: real;
- Int: real;
- DColor: string;
- DColR: real;
- DColG: real;
- DColB: real;
- DInt: real;
- Tex: string;
- Typ: TTextureType;
-
- Visible: Boolean;
-
- //Reflection Mod
- Reflection: boolean;
- Reflectionspacing: Real;
- //Fade Mod
- SelectH: integer;
- SelectW: integer;
- Fade: boolean;
- FadeText: boolean;
- DeSelectReflectionspacing : Real;
- FadeTex: string;
- FadeTexPos: integer;
-
- //Button Collection Mod
- Parent: Byte; //Number of the Button Collection this Button is assigned to. IF 0: No Assignement
- end;
-
- //Button Collection Mod
- TThemeButtonCollection = record
- Style: TThemeButton;
- ChildCount: Byte; //No of assigned Childs
- FirstChild: Byte; //No of Child on whose Interaction Position the Button should be
- end;
-
- AThemeButtonCollection = array of TThemeButtonCollection;
- PAThemeButtonCollection = ^AThemeButtonCollection;
-
- TThemeSelectSlide = record
- Tex: string;
- TexSBG: string;
- X: integer;
- Y: integer;
- W: integer;
- H: integer;
- Z: real;
-
- TextSize: integer;
-
- //SBGW Mod
- SBGW: integer;
-
- Text: string;
- ColR, ColG, ColB, Int: real;
- DColR, DColG, DColB, DInt: real;
- TColR, TColG, TColB, TInt: real;
- TDColR, TDColG, TDColB, TDInt: real;
- SBGColR, SBGColG, SBGColB, SBGInt: real;
- SBGDColR, SBGDColG, SBGDColB, SBGDInt: real;
- STColR, STColG, STColB, STInt: real;
- STDColR, STDColG, STDColB, STDInt: real;
- SkipX: integer;
- end;
-
- PThemeBasic = ^TThemeBasic;
- TThemeBasic = class
- Background: TThemeBackground;
- Text: AThemeText;
- Static: AThemeStatic;
-
- //Button Collection Mod
- ButtonCollection: AThemeButtonCollection;
- end;
-
- TThemeLoading = class(TThemeBasic)
- StaticAnimation: TThemeStatic;
- TextLoading: TThemeText;
- end;
-
- TThemeMain = class(TThemeBasic)
- ButtonSolo: TThemeButton;
- ButtonMulti: TThemeButton;
- ButtonStat: TThemeButton;
- ButtonEditor: TThemeButton;
- ButtonOptions: TThemeButton;
- ButtonExit: TThemeButton;
-
- TextDescription: TThemeText;
- TextDescriptionLong: TThemeText;
- Description: array[0..5] of string;
- DescriptionLong: array[0..5] of string;
- end;
-
- TThemeName = class(TThemeBasic)
- ButtonPlayer: array[1..6] of TThemeButton;
- end;
-
- TThemeLevel = class(TThemeBasic)
- ButtonEasy: TThemeButton;
- ButtonMedium: TThemeButton;
- ButtonHard: TThemeButton;
- end;
-
- TThemeSong = class(TThemeBasic)
- TextArtist: TThemeText;
- TextTitle: TThemeText;
- TextNumber: TThemeText;
-
- //Video Icon Mod
- VideoIcon: TThemeStatic;
-
- //Show Cat in TopLeft Mod
- TextCat: TThemeText;
- StaticCat: TThemeStatic;
-
- //Cover Mod
- Cover: record
- Reflections: Boolean;
- X: Integer;
- Y: Integer;
- Z: Integer;
- W: Integer;
- H: Integer;
- Style: Integer;
- end;
-
- //Equalizer Mod
- Equalizer: record
- Visible: Boolean;
- Direction: Boolean;
- Alpha: real;
- X: Integer;
- Y: Integer;
- Z: Real;
- W: Integer;
- H: Integer;
- Space: Integer;
- Bands: Integer;
- Length: Integer;
- ColR, ColG, ColB: Real;
- end;
-
-
- //Party and Non Party specific Statics and Texts
- StaticParty: AThemeStatic;
- TextParty: AThemeText;
-
- StaticNonParty: AThemeStatic;
- TextNonParty: AThemeText;
-
- //Party Mode
- StaticTeam1Joker1: TThemeStatic;
- StaticTeam1Joker2: TThemeStatic;
- StaticTeam1Joker3: TThemeStatic;
- StaticTeam1Joker4: TThemeStatic;
- StaticTeam1Joker5: TThemeStatic;
- StaticTeam2Joker1: TThemeStatic;
- StaticTeam2Joker2: TThemeStatic;
- StaticTeam2Joker3: TThemeStatic;
- StaticTeam2Joker4: TThemeStatic;
- StaticTeam2Joker5: TThemeStatic;
- StaticTeam3Joker1: TThemeStatic;
- StaticTeam3Joker2: TThemeStatic;
- StaticTeam3Joker3: TThemeStatic;
- StaticTeam3Joker4: TThemeStatic;
- StaticTeam3Joker5: TThemeStatic;
-
-
- end;
-
- TThemeSing = class(TThemeBasic)
-
- //TimeBar mod
- StaticTimeProgress: TThemeStatic;
- TextTimeText : TThemeText;
- //eoa TimeBar mod
-
- StaticP1: TThemeStatic;
- TextP1: TThemeText;
- StaticP1ScoreBG: TThemeStatic; //Static for ScoreBG
- TextP1Score: TThemeText;
-
- //moveable singbar mod
- StaticP1SingBar: TThemeStatic;
- StaticP1ThreePSingBar: TThemeStatic;
- StaticP1TwoPSingBar: TThemeStatic;
- StaticP2RSingBar: TThemeStatic;
- StaticP2MSingBar: TThemeStatic;
- StaticP3SingBar: TThemeStatic;
- //eoa moveable singbar
-
- //added for ps3 skin
- //game in 2/4 player modi
- StaticP1TwoP: TThemeStatic;
- StaticP1TwoPScoreBG: TThemeStatic; //Static for ScoreBG
- TextP1TwoP: TThemeText;
- TextP1TwoPScore: TThemeText;
- //game in 3/6 player modi
- StaticP1ThreeP: TThemeStatic;
- StaticP1ThreePScoreBG: TThemeStatic; //Static for ScoreBG
- TextP1ThreeP: TThemeText;
- TextP1ThreePScore: TThemeText;
- //eoa
-
- StaticP2R: TThemeStatic;
- StaticP2RScoreBG: TThemeStatic; //Static for ScoreBG
- TextP2R: TThemeText;
- TextP2RScore: TThemeText;
-
- StaticP2M: TThemeStatic;
- StaticP2MScoreBG: TThemeStatic; //Static for ScoreBG
- TextP2M: TThemeText;
- TextP2MScore: TThemeText;
-
- StaticP3R: TThemeStatic;
- StaticP3RScoreBG: TThemeStatic; //Static for ScoreBG
- TextP3R: TThemeText;
- TextP3RScore: TThemeText;
-
- //Linebonus Translations
- LineBonusText: Array [0..8] of String;
-
- //Pause Popup
- PausePopUp: TThemeStatic;
- end;
-
- TThemeScore = class(TThemeBasic)
- TextArtist: TThemeText;
- TextTitle: TThemeText;
-
- TextArtistTitle: TThemeText;
-
- PlayerStatic: array[1..6] of AThemeStatic;
- PlayerTexts: array[1..6] of AThemeText;
-
- TextName: array[1..6] of TThemeText;
- TextScore: array[1..6] of TThemeText;
-
- TextNotes: array[1..6] of TThemeText;
- TextNotesScore: array[1..6] of TThemeText;
- TextLineBonus: array[1..6] of TThemeText;
- TextLineBonusScore: array[1..6] of TThemeText;
- TextGoldenNotes: array[1..6] of TThemeText;
- TextGoldenNotesScore: array[1..6] of TThemeText;
- TextTotal: array[1..6] of TThemeText;
- TextTotalScore: array[1..6] of TThemeText;
-
- StaticBoxLightest: array[1..6] of TThemeStatic;
- StaticBoxLight: array[1..6] of TThemeStatic;
- StaticBoxDark: array[1..6] of TThemeStatic;
-
- StaticRatings: array[1..6] of TThemeStatic;
-
- StaticBackLevel: array[1..6] of TThemeStatic;
- StaticBackLevelRound: array[1..6] of TThemeStatic;
- StaticLevel: array[1..6] of TThemeStatic;
- StaticLevelRound: array[1..6] of TThemeStatic;
-
-// Description: array[0..5] of string;}
- end;
-
- TThemeTop5 = class(TThemeBasic)
- TextLevel: TThemeText;
- TextArtistTitle: TThemeText;
-
- StaticNumber: AThemeStatic;
- TextNumber: AThemeText;
- TextName: AThemeText;
- TextScore: AThemeText;
- end;
-
- TThemeOptions = class(TThemeBasic)
- ButtonGame: TThemeButton;
- ButtonGraphics: TThemeButton;
- ButtonSound: TThemeButton;
- ButtonLyrics: TThemeButton;
- ButtonThemes: TThemeButton;
- ButtonRecord: TThemeButton;
- ButtonAdvanced: TThemeButton;
- ButtonExit: TThemeButton;
-
- TextDescription: TThemeText;
- Description: array[0..7] of string;
- end;
-
- TThemeOptionsGame = class(TThemeBasic)
- SelectPlayers: TThemeSelectSlide;
- SelectDifficulty: TThemeSelectSlide;
- SelectLanguage: TThemeSelectSlide;
- SelectTabs: TThemeSelectSlide;
- SelectSorting: TThemeSelectSlide;
- SelectDebug: TThemeSelectSlide;
- ButtonExit: TThemeButton;
- end;
-
- TThemeOptionsGraphics = class(TThemeBasic)
- SelectFullscreen: TThemeSelectSlide;
- SelectResolution: TThemeSelectSlide;
- SelectDepth: TThemeSelectSlide;
- SelectVisualizer: TThemeSelectSlide;
- SelectOscilloscope: TThemeSelectSlide;
- SelectLineBonus: TThemeSelectSlide;
- SelectMovieSize: TThemeSelectSlide;
- ButtonExit: TThemeButton;
- end;
-
- TThemeOptionsSound = class(TThemeBasic)
- SelectMicBoost: TThemeSelectSlide;
- SelectBackgroundMusic: TThemeSelectSlide;
- SelectClickAssist: TThemeSelectSlide;
- SelectBeatClick: TThemeSelectSlide;
- SelectThreshold: TThemeSelectSlide;
- SelectSlidePreviewVolume: TThemeSelectSlide;
- SelectSlidePreviewFading: TThemeSelectSlide;
- SelectSlideVoicePassthrough: TThemeSelectSlide;
- ButtonExit: TThemeButton;
- end;
-
- TThemeOptionsLyrics = class(TThemeBasic)
- SelectLyricsFont: TThemeSelectSlide;
- SelectLyricsEffect: TThemeSelectSlide;
-// SelectSolmization: TThemeSelectSlide;
- SelectNoteLines: TThemeSelectSlide;
- ButtonExit: TThemeButton;
- end;
-
- TThemeOptionsThemes = class(TThemeBasic)
- SelectTheme: TThemeSelectSlide;
- SelectSkin: TThemeSelectSlide;
- SelectColor: TThemeSelectSlide;
- ButtonExit: TThemeButton;
- end;
-
- TThemeOptionsRecord = class(TThemeBasic)
- SelectSlideCard: TThemeSelectSlide;
- SelectSlideInput: TThemeSelectSlide;
- SelectSlideChannel: TThemeSelectSlide;
- ButtonExit: TThemeButton;
- end;
-
- TThemeOptionsAdvanced = class(TThemeBasic)
- SelectLoadAnimation: TThemeSelectSlide;
- SelectEffectSing: TThemeSelectSlide;
- SelectScreenFade: TThemeSelectSlide;
- SelectLineBonus: TThemeSelectSlide;
- SelectAskbeforeDel: TThemeSelectSlide;
- SelectOnSongClick: TThemeSelectSlide;
- SelectPartyPopup: TThemeSelectSlide;
- ButtonExit: TThemeButton;
- end;
-
- //Error- and Check-Popup
- TThemeError = class(TThemeBasic)
- Button1: TThemeButton;
- TextError: TThemeText;
- end;
-
- TThemeCheck = class(TThemeBasic)
- Button1: TThemeButton;
- Button2: TThemeButton;
- TextCheck: TThemeText;
- end;
-
-
- //ScreenSong Menue
- TThemeSongMenu = class(TThemeBasic)
- Button1: TThemeButton;
- Button2: TThemeButton;
- Button3: TThemeButton;
- Button4: TThemeButton;
-
- SelectSlide3: TThemeSelectSlide;
-
- TextMenu: TThemeText;
- end;
-
- TThemeSongJumpTo = class(TThemeBasic)
- ButtonSearchText: TThemeButton;
- SelectSlideType: TThemeSelectSlide;
- TextFound: TThemeText;
-
- //Translated Texts
- Songsfound: String;
- NoSongsfound: String;
- CatText: String;
- IType: array [0..2] of String;
- end;
-
- //Party Screens
- TThemePartyNewRound = class(TThemeBasic)
- TextRound1: TThemeText;
- TextRound2: TThemeText;
- TextRound3: TThemeText;
- TextRound4: TThemeText;
- TextRound5: TThemeText;
- TextRound6: TThemeText;
- TextRound7: TThemeText;
- TextWinner1: TThemeText;
- TextWinner2: TThemeText;
- TextWinner3: TThemeText;
- TextWinner4: TThemeText;
- TextWinner5: TThemeText;
- TextWinner6: TThemeText;
- TextWinner7: TThemeText;
- TextNextRound: TThemeText;
- TextNextRoundNo: TThemeText;
- TextNextPlayer1: TThemeText;
- TextNextPlayer2: TThemeText;
- TextNextPlayer3: TThemeText;
-
- StaticRound1: TThemeStatic;
- StaticRound2: TThemeStatic;
- StaticRound3: TThemeStatic;
- StaticRound4: TThemeStatic;
- StaticRound5: TThemeStatic;
- StaticRound6: TThemeStatic;
- StaticRound7: TThemeStatic;
-
- TextScoreTeam1: TThemeText;
- TextScoreTeam2: TThemeText;
- TextScoreTeam3: TThemeText;
- TextNameTeam1: TThemeText;
- TextNameTeam2: TThemeText;
- TextNameTeam3: TThemeText;
- TextTeam1Players: TThemeText;
- TextTeam2Players: TThemeText;
- TextTeam3Players: TThemeText;
-
- StaticTeam1: TThemeStatic;
- StaticTeam2: TThemeStatic;
- StaticTeam3: TThemeStatic;
- StaticNextPlayer1: TThemeStatic;
- StaticNextPlayer2: TThemeStatic;
- StaticNextPlayer3: TThemeStatic;
- end;
-
- TThemePartyScore = class(TThemeBasic)
- TextScoreTeam1: TThemeText;
- TextScoreTeam2: TThemeText;
- TextScoreTeam3: TThemeText;
- TextNameTeam1: TThemeText;
- TextNameTeam2: TThemeText;
- TextNameTeam3: TThemeText;
- StaticTeam1: TThemeStatic;
- StaticTeam1BG: TThemeStatic;
- StaticTeam1Deco: TThemeStatic;
- StaticTeam2: TThemeStatic;
- StaticTeam2BG: TThemeStatic;
- StaticTeam2Deco: TThemeStatic;
- StaticTeam3: TThemeStatic;
- StaticTeam3BG: TThemeStatic;
- StaticTeam3Deco: TThemeStatic;
-
- DecoTextures: record
- ChangeTextures: Boolean;
-
- FirstTexture: String;
- FirstTyp: TTextureType;
- FirstColor: String;
-
- SecondTexture: String;
- SecondTyp: TTextureType;
- SecondColor: String;
-
- ThirdTexture: String;
- ThirdTyp: TTextureType;
- ThirdColor: String;
- end;
-
-
- TextWinner: TThemeText;
- end;
-
- TThemePartyWin = class(TThemeBasic)
- TextScoreTeam1: TThemeText;
- TextScoreTeam2: TThemeText;
- TextScoreTeam3: TThemeText;
- TextNameTeam1: TThemeText;
- TextNameTeam2: TThemeText;
- TextNameTeam3: TThemeText;
- StaticTeam1: TThemeStatic;
- StaticTeam1BG: TThemeStatic;
- StaticTeam1Deco: TThemeStatic;
- StaticTeam2: TThemeStatic;
- StaticTeam2BG: TThemeStatic;
- StaticTeam2Deco: TThemeStatic;
- StaticTeam3: TThemeStatic;
- StaticTeam3BG: TThemeStatic;
- StaticTeam3Deco: TThemeStatic;
-
- TextWinner: TThemeText;
- end;
-
- TThemePartyOptions = class(TThemeBasic)
- SelectLevel: TThemeSelectSlide;
- SelectPlayList: TThemeSelectSlide;
- SelectPlayList2: TThemeSelectSlide;
- SelectRounds: TThemeSelectSlide;
- SelectTeams: TThemeSelectSlide;
- SelectPlayers1: TThemeSelectSlide;
- SelectPlayers2: TThemeSelectSlide;
- SelectPlayers3: TThemeSelectSlide;
-
- {ButtonNext: TThemeButton;
- ButtonPrev: TThemeButton;}
- end;
-
- TThemePartyPlayer = class(TThemeBasic)
- Team1Name: TThemeButton;
- Player1Name: TThemeButton;
- Player2Name: TThemeButton;
- Player3Name: TThemeButton;
- Player4Name: TThemeButton;
-
- Team2Name: TThemeButton;
- Player5Name: TThemeButton;
- Player6Name: TThemeButton;
- Player7Name: TThemeButton;
- Player8Name: TThemeButton;
-
- Team3Name: TThemeButton;
- Player9Name: TThemeButton;
- Player10Name: TThemeButton;
- Player11Name: TThemeButton;
- Player12Name: TThemeButton;
-
- {ButtonNext: TThemeButton;
- ButtonPrev: TThemeButton;}
- end;
-
- //Stats Screens
- TThemeStatMain = class(TThemeBasic)
- ButtonScores: TThemeButton;
- ButtonSingers: TThemeButton;
- ButtonSongs: TThemeButton;
- ButtonBands: TThemeButton;
- ButtonExit: TThemeButton;
-
- TextOverview: TThemeText;
- end;
-
- TThemeStatDetail = class(TThemeBasic)
- ButtonNext: TThemeButton;
- ButtonPrev: TThemeButton;
- ButtonReverse: TThemeButton;
- ButtonExit: TThemeButton;
-
- TextDescription: TThemeText;
- TextPage: TThemeText;
- TextList: AThemeText;
-
- Description: array[0..3] of string;
- DescriptionR: array[0..3] of string;
- FormatStr: array[0..3] of string;
- PageStr: String;
- end;
-
- //Playlist Translations
- TThemePlaylist = record
- CatText: string;
- end;
-
- TTheme = class
- private
- {$IFDEF THEMESAVE}
- ThemeIni: TIniFile;
- {$ELSE}
- ThemeIni: TMemIniFile;
- {$ENDIF}
-
- LastThemeBasic: TThemeBasic;
- procedure create_theme_objects();
- public
-
- Loading: TThemeLoading;
- Main: TThemeMain;
- Name: TThemeName;
- Level: TThemeLevel;
- Song: TThemeSong;
- Sing: TThemeSing;
- Score: TThemeScore;
- Top5: TThemeTop5;
- Options: TThemeOptions;
- OptionsGame: TThemeOptionsGame;
- OptionsGraphics: TThemeOptionsGraphics;
- OptionsSound: TThemeOptionsSound;
- OptionsLyrics: TThemeOptionsLyrics;
- OptionsThemes: TThemeOptionsThemes;
- OptionsRecord: TThemeOptionsRecord;
- OptionsAdvanced: TThemeOptionsAdvanced;
- //error and check popup
- ErrorPopup: TThemeError;
- CheckPopup: TThemeCheck;
- //ScreenSong extensions
- SongMenu: TThemeSongMenu;
- SongJumpto: TThemeSongJumpTo;
- //Party Screens:
- PartyNewRound: TThemePartyNewRound;
- PartyScore: TThemePartyScore;
- PartyWin: TThemePartyWin;
- PartyOptions: TThemePartyOptions;
- PartyPlayer: TThemePartyPlayer;
-
- //Stats Screens:
- StatMain: TThemeStatMain;
- StatDetail: TThemeStatDetail;
-
- Playlist: TThemePlaylist;
-
- ILevel: array[0..2] of String;
-
- constructor Create(FileName: string); overload; // Initialize theme system
- constructor Create(FileName: string; Color: integer); overload; // Initialize theme system with color
- function LoadTheme(FileName: string; sColor: integer): boolean; // Load some theme settings from file
-
- procedure LoadColors;
-
- procedure ThemeLoadBasic(Theme: TThemeBasic; Name: string);
- procedure ThemeLoadBackground(var ThemeBackground: TThemeBackground; Name: string);
- procedure ThemeLoadText(var ThemeText: TThemeText; Name: string);
- procedure ThemeLoadTexts(var ThemeText: AThemeText; Name: string);
- procedure ThemeLoadStatic(var ThemeStatic: TThemeStatic; Name: string);
- procedure ThemeLoadStatics(var ThemeStatic: AThemeStatic; Name: string);
- procedure ThemeLoadButton(var ThemeButton: TThemeButton; Name: string; const Collections: PAThemeButtonCollection = nil);
- procedure ThemeLoadButtonCollection(var Collection: TThemeButtonCollection; Name: string);
- procedure ThemeLoadButtonCollections(var Collections: AThemeButtonCollection; Name: string);
- procedure ThemeLoadSelectSlide(var ThemeSelectS: TThemeSelectSlide; Name: string);
-
- procedure ThemeSave(FileName: string);
- procedure ThemeSaveBasic(Theme: TThemeBasic; Name: string);
- procedure ThemeSaveBackground(ThemeBackground: TThemeBackground; Name: string);
- procedure ThemeSaveStatic(ThemeStatic: TThemeStatic; Name: string);
- procedure ThemeSaveStatics(ThemeStatic: AThemeStatic; Name: string);
- procedure ThemeSaveText(ThemeText: TThemeText; Name: string);
- procedure ThemeSaveTexts(ThemeText: AThemeText; Name: string);
- procedure ThemeSaveButton(ThemeButton: TThemeButton; Name: string);
-
- end;
-
- TColor = record
- Name: string;
- RGB: TRGB;
- end;
-
-function ColorExists(Name: string): integer;
-procedure LoadColor(var R, G, B: real; ColorName: string);
-function GetSystemColor(Color: integer): TRGB;
-function ColorSqrt(RGB: TRGB): TRGB;
-
-var
- //Skin: TSkin;
- Theme: TTheme;
- Color: array of TColor;
-
-implementation
-
-uses
- UCommon,
- ULanguage,
- USkins,
- UIni;
-
-constructor TTheme.Create(FileName: string);
-begin
- Create(FileName, 0);
-end;
-
-constructor TTheme.Create(FileName: string; Color: integer);
-begin
- inherited Create();
-
- Loading := TThemeLoading.Create;
- Main := TThemeMain.Create;
- Name := TThemeName.Create;
- Level := TThemeLevel.Create;
- Song := TThemeSong.Create;
- Sing := TThemeSing.Create;
- Score := TThemeScore.Create;
- Top5 := TThemeTop5.Create;
- Options := TThemeOptions.Create;
- OptionsGame := TThemeOptionsGame.Create;
- OptionsGraphics := TThemeOptionsGraphics.Create;
- OptionsSound := TThemeOptionsSound.Create;
- OptionsLyrics := TThemeOptionsLyrics.Create;
- OptionsThemes := TThemeOptionsThemes.Create;
- OptionsRecord := TThemeOptionsRecord.Create;
- OptionsAdvanced := TThemeOptionsAdvanced.Create;
-
- ErrorPopup := TThemeError.Create;
- CheckPopup := TThemeCheck.Create;
-
- SongMenu := TThemeSongMenu.Create;
- SongJumpto := TThemeSongJumpto.Create;
- //Party Screens
- PartyNewRound := TThemePartyNewRound.Create;
- PartyWin := TThemePartyWin.Create;
- PartyScore := TThemePartyScore.Create;
- PartyOptions := TThemePartyOptions.Create;
- PartyPlayer := TThemePartyPlayer.Create;
-
- //Stats Screens:
- StatMain := TThemeStatMain.Create;
- StatDetail := TThemeStatDetail.Create;
-
- LoadTheme(FileName, Color);
-
-end;
-
-
-function TTheme.LoadTheme(FileName: string; sColor: integer): boolean;
-var
- I: integer;
- Path: string;
-begin
- Result := false;
-
- create_theme_objects();
-
- Log.LogStatus('Loading: '+ FileName, 'TTheme.LoadTheme');
-
- FileName := AdaptFilePaths( FileName );
-
- if not FileExists(FileName) then
- begin
- Log.LogError('Theme does not exist ('+ FileName +')', 'TTheme.LoadTheme');
- end;
-
- if FileExists(FileName) then
- begin
- Result := true;
-
- {$IFDEF THEMESAVE}
- ThemeIni := TIniFile.Create(FileName);
- {$ELSE}
- ThemeIni := TMemIniFile.Create(FileName);
- {$ENDIF}
-
- if ThemeIni.ReadString('Theme', 'Name', '') <> '' then
- begin
-
- {Skin.SkinName := ThemeIni.ReadString('Theme', 'Name', 'Singstar');
- Skin.SkinPath := 'Skins\' + Skin.SkinName + '\';
- Skin.SkinReg := false; }
- Skin.Color := sColor;
-
- Skin.LoadSkin(ISkin[Ini.SkinNo]);
-
- LoadColors;
-
-// ThemeIni.Free;
-// ThemeIni := TIniFile.Create('Themes\Singstar\Main.ini');
-
- // Loading
- ThemeLoadBasic(Loading, 'Loading');
- ThemeLoadText(Loading.TextLoading, 'LoadingTextLoading');
- ThemeLoadStatic(Loading.StaticAnimation, 'LoadingStaticAnimation');
-
- // Main
- ThemeLoadBasic(Main, 'Main');
-
- ThemeLoadText(Main.TextDescription, 'MainTextDescription');
- ThemeLoadText(Main.TextDescriptionLong, 'MainTextDescriptionLong');
- ThemeLoadButton(Main.ButtonSolo, 'MainButtonSolo');
- ThemeLoadButton(Main.ButtonMulti, 'MainButtonMulti');
- ThemeLoadButton(Main.ButtonStat, 'MainButtonStats');
- ThemeLoadButton(Main.ButtonEditor, 'MainButtonEditor');
- ThemeLoadButton(Main.ButtonOptions, 'MainButtonOptions');
- ThemeLoadButton(Main.ButtonExit, 'MainButtonExit');
-
- //Main Desc Text Translation Start
-
- Main.Description[0] := Language.Translate('SING_SING');
- Main.DescriptionLong[0] := Language.Translate('SING_SING_DESC');
- Main.Description[1] := Language.Translate('SING_MULTI');
- Main.DescriptionLong[1] := Language.Translate('SING_MULTI_DESC');
- Main.Description[2] := Language.Translate('SING_STATS');
- Main.DescriptionLong[2] := Language.Translate('SING_STATS_DESC');
- Main.Description[3] := Language.Translate('SING_EDITOR');
- Main.DescriptionLong[3] := Language.Translate('SING_EDITOR_DESC');
- Main.Description[4] := Language.Translate('SING_GAME_OPTIONS');
- Main.DescriptionLong[4] := Language.Translate('SING_GAME_OPTIONS_DESC');
- Main.Description[5] := Language.Translate('SING_EXIT');
- Main.DescriptionLong[5] := Language.Translate('SING_EXIT_DESC');
-
- //Main Desc Text Translation End
-
- Main.TextDescription.Text := Main.Description[0];
- Main.TextDescriptionLong.Text := Main.DescriptionLong[0];
-
- // Name
- ThemeLoadBasic(Name, 'Name');
-
- for I := 1 to 6 do
- ThemeLoadButton(Name.ButtonPlayer[I], 'NameButtonPlayer'+IntToStr(I));
-
- // Level
- ThemeLoadBasic(Level, 'Level');
-
- ThemeLoadButton(Level.ButtonEasy, 'LevelButtonEasy');
- ThemeLoadButton(Level.ButtonMedium, 'LevelButtonMedium');
- ThemeLoadButton(Level.ButtonHard, 'LevelButtonHard');
-
-
- // Song
- ThemeLoadBasic(Song, 'Song');
-
- ThemeLoadText(Song.TextArtist, 'SongTextArtist');
- ThemeLoadText(Song.TextTitle, 'SongTextTitle');
- ThemeLoadText(Song.TextNumber, 'SongTextNumber');
-
- //Video Icon Mod
- ThemeLoadStatic(Song.VideoIcon, 'SongVideoIcon');
-
- //Show Cat in TopLeft Mod
- ThemeLoadStatic(Song.StaticCat, 'SongStaticCat');
- ThemeLoadText(Song.TextCat, 'SongTextCat');
-
- //Load Cover Pos and Size from Theme Mod
- Song.Cover.X := ThemeIni.ReadInteger('SongCover', 'X', 300);
- Song.Cover.Y := ThemeIni.ReadInteger('SongCover', 'Y', 190);
- Song.Cover.W := ThemeIni.ReadInteger('SongCover', 'W', 300);
- Song.Cover.H := ThemeIni.ReadInteger('SongCover', 'H', 200);
- Song.Cover.Style := ThemeIni.ReadInteger('SongCover', 'Style', 4);
- Song.Cover.Reflections := (ThemeIni.ReadInteger('SongCover', 'Reflections', 0) = 1);
- //Load Cover Pos and Size from Theme Mod End
-
- //Load Equalizer Pos and Size from Theme Mod
- Song.Equalizer.Visible := (ThemeIni.ReadInteger('SongEqualizer', 'Visible', 0) = 1);
- Song.Equalizer.Direction := (ThemeIni.ReadInteger('SongEqualizer', 'Direction', 0) = 1);
- Song.Equalizer.Alpha := ThemeIni.ReadInteger('SongEqualizer', 'Alpha', 1);
- Song.Equalizer.Space := ThemeIni.ReadInteger('SongEqualizer', 'Space', 1);
- Song.Equalizer.X := ThemeIni.ReadInteger('SongEqualizer', 'X', 0);
- Song.Equalizer.Y := ThemeIni.ReadInteger('SongEqualizer', 'Y', 0);
- Song.Equalizer.Z := ThemeIni.ReadInteger('SongEqualizer', 'Z', 1);
- Song.Equalizer.W := ThemeIni.ReadInteger('SongEqualizer', 'PieceW', 8);
- Song.Equalizer.H := ThemeIni.ReadInteger('SongEqualizer', 'PieceH', 8);
- Song.Equalizer.Bands := ThemeIni.ReadInteger('SongEqualizer', 'Bands', 5);
- Song.Equalizer.Length := ThemeIni.ReadInteger('SongEqualizer', 'Length', 12);
-
- //Color
- I := ColorExists(ThemeIni.ReadString('SongEqualizer', 'Color', 'Black'));
- if I >= 0 then begin
- Song.Equalizer.ColR := Color[I].RGB.R;
- Song.Equalizer.ColG := Color[I].RGB.G;
- Song.Equalizer.ColB := Color[I].RGB.B;
- end
- else begin
- Song.Equalizer.ColR := 0;
- Song.Equalizer.ColG := 0;
- Song.Equalizer.ColB := 0;
- end;
- //Load Equalizer Pos and Size from Theme Mod End
-
- //Party and Non Party specific Statics and Texts
- ThemeLoadStatics (Song.StaticParty, 'SongStaticParty');
- ThemeLoadTexts (Song.TextParty, 'SongTextParty');
-
- ThemeLoadStatics (Song.StaticNonParty, 'SongStaticNonParty');
- ThemeLoadTexts (Song.TextNonParty, 'SongTextNonParty');
-
- //Party Mode
- ThemeLoadStatic(Song.StaticTeam1Joker1, 'SongStaticTeam1Joker1');
- ThemeLoadStatic(Song.StaticTeam1Joker2, 'SongStaticTeam1Joker2');
- ThemeLoadStatic(Song.StaticTeam1Joker3, 'SongStaticTeam1Joker3');
- ThemeLoadStatic(Song.StaticTeam1Joker4, 'SongStaticTeam1Joker4');
- ThemeLoadStatic(Song.StaticTeam1Joker5, 'SongStaticTeam1Joker5');
-
- ThemeLoadStatic(Song.StaticTeam2Joker1, 'SongStaticTeam2Joker1');
- ThemeLoadStatic(Song.StaticTeam2Joker2, 'SongStaticTeam2Joker2');
- ThemeLoadStatic(Song.StaticTeam2Joker3, 'SongStaticTeam2Joker3');
- ThemeLoadStatic(Song.StaticTeam2Joker4, 'SongStaticTeam2Joker4');
- ThemeLoadStatic(Song.StaticTeam2Joker5, 'SongStaticTeam2Joker5');
-
- ThemeLoadStatic(Song.StaticTeam3Joker1, 'SongStaticTeam3Joker1');
- ThemeLoadStatic(Song.StaticTeam3Joker2, 'SongStaticTeam3Joker2');
- ThemeLoadStatic(Song.StaticTeam3Joker3, 'SongStaticTeam3Joker3');
- ThemeLoadStatic(Song.StaticTeam3Joker4, 'SongStaticTeam3Joker4');
- ThemeLoadStatic(Song.StaticTeam3Joker5, 'SongStaticTeam3Joker5');
-
-
- // Sing
- ThemeLoadBasic(Sing, 'Sing');
-
- //TimeBar mod
- ThemeLoadStatic(Sing.StaticTimeProgress, 'SingTimeProgress');
- ThemeLoadText(Sing.TextTimeText, 'SingTimeText');
- //eoa TimeBar mod
-
- //moveable singbar mod
- ThemeLoadStatic(Sing.StaticP1SingBar, 'SingP1SingBar');
- ThemeLoadStatic(Sing.StaticP1TwoPSingBar, 'SingP1TwoPSingBar');
- ThemeLoadStatic(Sing.StaticP1ThreePSingBar, 'SingP1ThreePSingBar');
- ThemeLoadStatic(Sing.StaticP2RSingBar, 'SingP2RSingBar');
- ThemeLoadStatic(Sing.StaticP2MSingBar, 'SingP2MSingBar');
- ThemeLoadStatic(Sing.StaticP3SingBar, 'SingP3SingBar');
- //eoa moveable singbar
-
- ThemeLoadStatic(Sing.StaticP1, 'SingP1Static');
- ThemeLoadText(Sing.TextP1, 'SingP1Text');
- ThemeLoadStatic(Sing.StaticP1ScoreBG, 'SingP1Static2');
- ThemeLoadText(Sing.TextP1Score, 'SingP1TextScore');
- //Added for ps3 skin
- //This one is shown in 2/4P mode
- //if it exists, otherwise the one Player equivaltents are used
- if (ThemeIni.SectionExists('SingP1TwoPTextScore')) then
- begin
- ThemeLoadStatic(Sing.StaticP1TwoP, 'SingP1TwoPStatic');
- ThemeLoadText(Sing.TextP1TwoP, 'SingP1TwoPText');
- ThemeLoadStatic(Sing.StaticP1TwoPScoreBG, 'SingP1TwoPStatic2');
- ThemeLoadText(Sing.TextP1TwoPScore, 'SingP1TwoPTextScore');
- end
- else
- begin
- Sing.StaticP1TwoP := Sing.StaticP1;
- Sing.TextP1TwoP := Sing.TextP1;
- Sing.StaticP1TwoPScoreBG := Sing.StaticP1ScoreBG;
- Sing.TextP1TwoPScore := Sing.TextP1Score;
- end;
-
- //This one is shown in 3/6P mode
- //if it exists, otherwise the one Player equivaltents are used
- if (ThemeIni.SectionExists('SingP1TwoPTextScore')) then
- begin
- ThemeLoadStatic(Sing.StaticP1ThreeP, 'SingP1ThreePStatic');
- ThemeLoadText(Sing.TextP1ThreeP, 'SingP1ThreePText');
- ThemeLoadStatic(Sing.StaticP1ThreePScoreBG, 'SingP1ThreePStatic2');
- ThemeLoadText(Sing.TextP1ThreePScore, 'SingP1ThreePTextScore');
- end
- else
- begin
- Sing.StaticP1ThreeP := Sing.StaticP1;
- Sing.TextP1ThreeP := Sing.TextP1;
- Sing.StaticP1ThreePScoreBG := Sing.StaticP1ScoreBG;
- Sing.TextP1ThreePScore := Sing.TextP1Score;
- end;
- //eoa
- ThemeLoadStatic(Sing.StaticP2R, 'SingP2RStatic');
- ThemeLoadText(Sing.TextP2R, 'SingP2RText');
- ThemeLoadStatic(Sing.StaticP2RScoreBG, 'SingP2RStatic2');
- ThemeLoadText(Sing.TextP2RScore, 'SingP2RTextScore');
-
- ThemeLoadStatic(Sing.StaticP2M, 'SingP2MStatic');
- ThemeLoadText(Sing.TextP2M, 'SingP2MText');
- ThemeLoadStatic(Sing.StaticP2MScoreBG, 'SingP2MStatic2');
- ThemeLoadText(Sing.TextP2MScore, 'SingP2MTextScore');
-
- ThemeLoadStatic(Sing.StaticP3R, 'SingP3RStatic');
- ThemeLoadText(Sing.TextP3R, 'SingP3RText');
- ThemeLoadStatic(Sing.StaticP3RScoreBG, 'SingP3RStatic2');
- ThemeLoadText(Sing.TextP3RScore, 'SingP3RTextScore');
-
- //Line Bonus Texts
- Sing.LineBonusText[0] := Language.Translate('POPUP_AWFUL');
- Sing.LineBonusText[1] := Sing.LineBonusText[0];
- Sing.LineBonusText[2] := Language.Translate('POPUP_POOR');
- Sing.LineBonusText[3] := Language.Translate('POPUP_BAD');
- Sing.LineBonusText[4] := Language.Translate('POPUP_NOTBAD');
- Sing.LineBonusText[5] := Language.Translate('POPUP_GOOD');
- Sing.LineBonusText[6] := Language.Translate('POPUP_GREAT');
- Sing.LineBonusText[7] := Language.Translate('POPUP_AWESOME');
- Sing.LineBonusText[8] := Language.Translate('POPUP_PERFECT');
-
- //PausePopup
- ThemeLoadStatic(Sing.PausePopUp, 'PausePopUpStatic');
-
- // Score
- ThemeLoadBasic(Score, 'Score');
-
- ThemeLoadText(Score.TextArtist, 'ScoreTextArtist');
- ThemeLoadText(Score.TextTitle, 'ScoreTextTitle');
- ThemeLoadText(Score.TextArtistTitle, 'ScoreTextArtistTitle');
-
- for I := 1 to 6 do begin
- ThemeLoadStatics(Score.PlayerStatic[I], 'ScorePlayer' + IntToStr(I) + 'Static');
- ThemeLoadTexts(Score.PlayerTexts[I], 'ScorePlayer' + IntToStr(I) + 'Text');
-
- ThemeLoadText(Score.TextName[I], 'ScoreTextName' + IntToStr(I));
- ThemeLoadText(Score.TextScore[I], 'ScoreTextScore' + IntToStr(I));
- ThemeLoadText(Score.TextNotes[I], 'ScoreTextNotes' + IntToStr(I));
- ThemeLoadText(Score.TextNotesScore[I], 'ScoreTextNotesScore' + IntToStr(I));
- ThemeLoadText(Score.TextLineBonus[I], 'ScoreTextLineBonus' + IntToStr(I));
- ThemeLoadText(Score.TextLineBonusScore[I], 'ScoreTextLineBonusScore' + IntToStr(I));
- ThemeLoadText(Score.TextGoldenNotes[I], 'ScoreTextGoldenNotes' + IntToStr(I));
- ThemeLoadText(Score.TextGoldenNotesScore[I], 'ScoreTextGoldenNotesScore' + IntToStr(I));
- ThemeLoadText(Score.TextTotal[I], 'ScoreTextTotal' + IntToStr(I));
- ThemeLoadText(Score.TextTotalScore[I], 'ScoreTextTotalScore' + IntToStr(I));
-
- ThemeLoadStatic(Score.StaticBoxLightest[I], 'ScoreStaticBoxLightest' + IntToStr(I));
- ThemeLoadStatic(Score.StaticBoxLight[I], 'ScoreStaticBoxLight' + IntToStr(I));
- ThemeLoadStatic(Score.StaticBoxDark[I], 'ScoreStaticBoxDark' + IntToStr(I));
-
- ThemeLoadStatic(Score.StaticBackLevel[I], 'ScoreStaticBackLevel' + IntToStr(I));
- ThemeLoadStatic(Score.StaticBackLevelRound[I], 'ScoreStaticBackLevelRound' + IntToStr(I));
- ThemeLoadStatic(Score.StaticLevel[I], 'ScoreStaticLevel' + IntToStr(I));
- ThemeLoadStatic(Score.StaticLevelRound[I], 'ScoreStaticLevelRound' + IntToStr(I));
-
- ThemeLoadStatic(Score.StaticRatings[I], 'ScoreStaticRatingPicture' + IntToStr(I));
- end;
-
- // Top5
- ThemeLoadBasic(Top5, 'Top5');
-
- ThemeLoadText(Top5.TextLevel, 'Top5TextLevel');
- ThemeLoadText(Top5.TextArtistTitle, 'Top5TextArtistTitle');
- ThemeLoadStatics(Top5.StaticNumber, 'Top5StaticNumber');
- ThemeLoadTexts(Top5.TextNumber, 'Top5TextNumber');
- ThemeLoadTexts(Top5.TextName, 'Top5TextName');
- ThemeLoadTexts(Top5.TextScore, 'Top5TextScore');
-
- // Options
- ThemeLoadBasic(Options, 'Options');
-
- ThemeLoadButton(Options.ButtonGame, 'OptionsButtonGame');
- ThemeLoadButton(Options.ButtonGraphics, 'OptionsButtonGraphics');
- ThemeLoadButton(Options.ButtonSound, 'OptionsButtonSound');
- ThemeLoadButton(Options.ButtonLyrics, 'OptionsButtonLyrics');
- ThemeLoadButton(Options.ButtonThemes, 'OptionsButtonThemes');
- ThemeLoadButton(Options.ButtonRecord, 'OptionsButtonRecord');
- ThemeLoadButton(Options.ButtonAdvanced, 'OptionsButtonAdvanced');
- ThemeLoadButton(Options.ButtonExit, 'OptionsButtonExit');
-
- Options.Description[0] := Language.Translate('SING_OPTIONS_GAME_DESC');
- Options.Description[1] := Language.Translate('SING_OPTIONS_GRAPHICS_DESC');
- Options.Description[2] := Language.Translate('SING_OPTIONS_SOUND_DESC');
- Options.Description[3] := Language.Translate('SING_OPTIONS_LYRICS_DESC');
- Options.Description[4] := Language.Translate('SING_OPTIONS_THEMES_DESC');
- Options.Description[5] := Language.Translate('SING_OPTIONS_RECORD_DESC');
- Options.Description[6] := Language.Translate('SING_OPTIONS_ADVANCED_DESC');
- Options.Description[7] := Language.Translate('SING_OPTIONS_EXIT');
-
- ThemeLoadText(Options.TextDescription, 'OptionsTextDescription');
- Options.TextDescription.Text := Options.Description[0];
-
- // Options Game
- ThemeLoadBasic(OptionsGame, 'OptionsGame');
-
- ThemeLoadSelectSlide(OptionsGame.SelectPlayers, 'OptionsGameSelectPlayers');
- ThemeLoadSelectSlide(OptionsGame.SelectDifficulty, 'OptionsGameSelectDifficulty');
- ThemeLoadSelectSlide(OptionsGame.SelectLanguage, 'OptionsGameSelectSlideLanguage');
- ThemeLoadSelectSlide(OptionsGame.SelectTabs, 'OptionsGameSelectTabs');
- ThemeLoadSelectSlide(OptionsGame.SelectSorting, 'OptionsGameSelectSlideSorting');
- ThemeLoadSelectSlide(OptionsGame.SelectDebug, 'OptionsGameSelectDebug');
- ThemeLoadButton(OptionsGame.ButtonExit, 'OptionsGameButtonExit');
-
- // Options Graphics
- ThemeLoadBasic(OptionsGraphics, 'OptionsGraphics');
-
- ThemeLoadSelectSlide(OptionsGraphics.SelectFullscreen, 'OptionsGraphicsSelectFullscreen');
- ThemeLoadSelectSlide(OptionsGraphics.SelectResolution, 'OptionsGraphicsSelectSlideResolution');
- ThemeLoadSelectSlide(OptionsGraphics.SelectDepth, 'OptionsGraphicsSelectDepth');
- ThemeLoadSelectSlide(OptionsGraphics.SelectVisualizer, 'OptionsGraphicsSelectVisualizer');
- ThemeLoadSelectSlide(OptionsGraphics.SelectOscilloscope, 'OptionsGraphicsSelectOscilloscope');
- ThemeLoadSelectSlide(OptionsGraphics.SelectLineBonus, 'OptionsGraphicsSelectLineBonus');
- ThemeLoadSelectSlide(OptionsGraphics.SelectMovieSize, 'OptionsGraphicsSelectMovieSize');
- ThemeLoadButton(OptionsGraphics.ButtonExit, 'OptionsGraphicsButtonExit');
-
- // Options Sound
- ThemeLoadBasic(OptionsSound, 'OptionsSound');
-
- ThemeLoadSelectSlide(OptionsSound.SelectBackgroundMusic, 'OptionsSoundSelectBackgroundMusic');
- ThemeLoadSelectSlide(OptionsSound.SelectMicBoost, 'OptionsSoundSelectMicBoost');
- ThemeLoadSelectSlide(OptionsSound.SelectClickAssist, 'OptionsSoundSelectClickAssist');
- ThemeLoadSelectSlide(OptionsSound.SelectBeatClick, 'OptionsSoundSelectBeatClick');
- ThemeLoadSelectSlide(OptionsSound.SelectThreshold, 'OptionsSoundSelectThreshold');
- //Song Preview
- ThemeLoadSelectSlide(OptionsSound.SelectSlidePreviewVolume, 'OptionsSoundSelectSlidePreviewVolume');
- ThemeLoadSelectSlide(OptionsSound.SelectSlidePreviewFading, 'OptionsSoundSelectSlidePreviewFading');
- ThemeLoadSelectSlide(OptionsSound.SelectSlideVoicePassthrough, 'OptionsSoundSelectVoicePassthrough');
-
- ThemeLoadButton(OptionsSound.ButtonExit, 'OptionsSoundButtonExit');
-
- // Options Lyrics
- ThemeLoadBasic(OptionsLyrics, 'OptionsLyrics');
-
- ThemeLoadSelectSlide(OptionsLyrics.SelectLyricsFont, 'OptionsLyricsSelectLyricsFont');
- ThemeLoadSelectSlide(OptionsLyrics.SelectLyricsEffect, 'OptionsLyricsSelectLyricsEffect');
- //ThemeLoadSelectSlide(OptionsLyrics.SelectSolmization, 'OptionsLyricsSelectSolmization');
- ThemeLoadSelectSlide(OptionsLyrics.SelectNoteLines, 'OptionsLyricsSelectNoteLines');
- ThemeLoadButton(OptionsLyrics.ButtonExit, 'OptionsLyricsButtonExit');
-
- // Options Themes
- ThemeLoadBasic(OptionsThemes, 'OptionsThemes');
-
- ThemeLoadSelectSlide(OptionsThemes.SelectTheme, 'OptionsThemesSelectTheme');
- ThemeLoadSelectSlide(OptionsThemes.SelectSkin, 'OptionsThemesSelectSkin');
- ThemeLoadSelectSlide(OptionsThemes.SelectColor, 'OptionsThemesSelectColor');
- ThemeLoadButton(OptionsThemes.ButtonExit, 'OptionsThemesButtonExit');
-
- // Options Record
- ThemeLoadBasic(OptionsRecord, 'OptionsRecord');
-
- ThemeLoadSelectSlide(OptionsRecord.SelectSlideCard, 'OptionsRecordSelectSlideCard');
- ThemeLoadSelectSlide(OptionsRecord.SelectSlideInput, 'OptionsRecordSelectSlideInput');
- ThemeLoadSelectSlide(OptionsRecord.SelectSlideChannel, 'OptionsRecordSelectSlideChannel');
- ThemeLoadButton(OptionsRecord.ButtonExit, 'OptionsRecordButtonExit');
-
- //Options Advanced
- ThemeLoadBasic(OptionsAdvanced, 'OptionsAdvanced');
-
- ThemeLoadSelectSlide(OptionsAdvanced.SelectLoadAnimation, 'OptionsAdvancedSelectLoadAnimation');
- ThemeLoadSelectSlide(OptionsAdvanced.SelectScreenFade, 'OptionsAdvancedSelectScreenFade');
- ThemeLoadSelectSlide(OptionsAdvanced.SelectEffectSing, 'OptionsAdvancedSelectEffectSing');
- ThemeLoadSelectSlide(OptionsAdvanced.SelectLineBonus, 'OptionsAdvancedSelectLineBonus');
- ThemeLoadSelectSlide(OptionsAdvanced.SelectOnSongClick, 'OptionsAdvancedSelectSlideOnSongClick');
- ThemeLoadSelectSlide(OptionsAdvanced.SelectAskbeforeDel, 'OptionsAdvancedSelectAskbeforeDel');
- ThemeLoadSelectSlide(OptionsAdvanced.SelectPartyPopup, 'OptionsAdvancedSelectPartyPopup');
- ThemeLoadButton (OptionsAdvanced.ButtonExit, 'OptionsAdvancedButtonExit');
-
- //error and check popup
- ThemeLoadBasic (ErrorPopup, 'ErrorPopup');
- ThemeLoadButton(ErrorPopup.Button1, 'ErrorPopupButton1');
- ThemeLoadText (ErrorPopup.TextError,'ErrorPopupText');
- ThemeLoadBasic (CheckPopup, 'CheckPopup');
- ThemeLoadButton(CheckPopup.Button1, 'CheckPopupButton1');
- ThemeLoadButton(CheckPopup.Button2, 'CheckPopupButton2');
- ThemeLoadText(CheckPopup.TextCheck , 'CheckPopupText');
-
- //Song Menu
- ThemeLoadBasic (SongMenu, 'SongMenu');
- ThemeLoadButton(SongMenu.Button1, 'SongMenuButton1');
- ThemeLoadButton(SongMenu.Button2, 'SongMenuButton2');
- ThemeLoadButton(SongMenu.Button3, 'SongMenuButton3');
- ThemeLoadButton(SongMenu.Button4, 'SongMenuButton4');
- ThemeLoadSelectSlide(SongMenu.SelectSlide3, 'SongMenuSelectSlide3');
-
- ThemeLoadText(SongMenu.TextMenu, 'SongMenuTextMenu');
-
- //Song Jumpto
- ThemeLoadBasic (SongJumpto, 'SongJumpto');
- ThemeLoadButton(SongJumpto.ButtonSearchText, 'SongJumptoButtonSearchText');
- ThemeLoadSelectSlide(SongJumpto.SelectSlideType, 'SongJumptoSelectSlideType');
- ThemeLoadText(SongJumpto.TextFound, 'SongJumptoTextFound');
- //Translations
- SongJumpto.IType[0] := Language.Translate('SONG_JUMPTO_TYPE1');
- SongJumpto.IType[1] := Language.Translate('SONG_JUMPTO_TYPE2');
- SongJumpto.IType[2] := Language.Translate('SONG_JUMPTO_TYPE3');
- SongJumpto.SongsFound := Language.Translate('SONG_JUMPTO_SONGSFOUND');
- SongJumpto.NoSongsFound := Language.Translate('SONG_JUMPTO_NOSONGSFOUND');
- SongJumpto.CatText := Language.Translate('SONG_JUMPTO_CATTEXT');
-
- //Party Screens:
- //Party NewRound
- ThemeLoadBasic(PartyNewRound, 'PartyNewRound');
-
- ThemeLoadText (PartyNewRound.TextRound1, 'PartyNewRoundTextRound1');
- ThemeLoadText (PartyNewRound.TextRound2, 'PartyNewRoundTextRound2');
- ThemeLoadText (PartyNewRound.TextRound3, 'PartyNewRoundTextRound3');
- ThemeLoadText (PartyNewRound.TextRound4, 'PartyNewRoundTextRound4');
- ThemeLoadText (PartyNewRound.TextRound5, 'PartyNewRoundTextRound5');
- ThemeLoadText (PartyNewRound.TextRound6, 'PartyNewRoundTextRound6');
- ThemeLoadText (PartyNewRound.TextRound7, 'PartyNewRoundTextRound7');
- ThemeLoadText (PartyNewRound.TextWinner1, 'PartyNewRoundTextWinner1');
- ThemeLoadText (PartyNewRound.TextWinner2, 'PartyNewRoundTextWinner2');
- ThemeLoadText (PartyNewRound.TextWinner3, 'PartyNewRoundTextWinner3');
- ThemeLoadText (PartyNewRound.TextWinner4, 'PartyNewRoundTextWinner4');
- ThemeLoadText (PartyNewRound.TextWinner5, 'PartyNewRoundTextWinner5');
- ThemeLoadText (PartyNewRound.TextWinner6, 'PartyNewRoundTextWinner6');
- ThemeLoadText (PartyNewRound.TextWinner7, 'PartyNewRoundTextWinner7');
- ThemeLoadText (PartyNewRound.TextNextRound, 'PartyNewRoundTextNextRound');
- ThemeLoadText (PartyNewRound.TextNextRoundNo, 'PartyNewRoundTextNextRoundNo');
- ThemeLoadText (PartyNewRound.TextNextPlayer1, 'PartyNewRoundTextNextPlayer1');
- ThemeLoadText (PartyNewRound.TextNextPlayer2, 'PartyNewRoundTextNextPlayer2');
- ThemeLoadText (PartyNewRound.TextNextPlayer3, 'PartyNewRoundTextNextPlayer3');
-
- ThemeLoadStatic (PartyNewRound.StaticRound1, 'PartyNewRoundStaticRound1');
- ThemeLoadStatic (PartyNewRound.StaticRound2, 'PartyNewRoundStaticRound2');
- ThemeLoadStatic (PartyNewRound.StaticRound3, 'PartyNewRoundStaticRound3');
- ThemeLoadStatic (PartyNewRound.StaticRound4, 'PartyNewRoundStaticRound4');
- ThemeLoadStatic (PartyNewRound.StaticRound5, 'PartyNewRoundStaticRound5');
- ThemeLoadStatic (PartyNewRound.StaticRound6, 'PartyNewRoundStaticRound6');
- ThemeLoadStatic (PartyNewRound.StaticRound7, 'PartyNewRoundStaticRound7');
-
- ThemeLoadText (PartyNewRound.TextScoreTeam1, 'PartyNewRoundTextScoreTeam1');
- ThemeLoadText (PartyNewRound.TextScoreTeam2, 'PartyNewRoundTextScoreTeam2');
- ThemeLoadText (PartyNewRound.TextScoreTeam3, 'PartyNewRoundTextScoreTeam3');
- ThemeLoadText (PartyNewRound.TextNameTeam1, 'PartyNewRoundTextNameTeam1');
- ThemeLoadText (PartyNewRound.TextNameTeam2, 'PartyNewRoundTextNameTeam2');
- ThemeLoadText (PartyNewRound.TextNameTeam3, 'PartyNewRoundTextNameTeam3');
-
- ThemeLoadText (PartyNewRound.TextTeam1Players, 'PartyNewRoundTextTeam1Players');
- ThemeLoadText (PartyNewRound.TextTeam2Players, 'PartyNewRoundTextTeam2Players');
- ThemeLoadText (PartyNewRound.TextTeam3Players, 'PartyNewRoundTextTeam3Players');
-
- ThemeLoadStatic (PartyNewRound.StaticTeam1, 'PartyNewRoundStaticTeam1');
- ThemeLoadStatic (PartyNewRound.StaticTeam2, 'PartyNewRoundStaticTeam2');
- ThemeLoadStatic (PartyNewRound.StaticTeam3, 'PartyNewRoundStaticTeam3');
- ThemeLoadStatic (PartyNewRound.StaticNextPlayer1, 'PartyNewRoundStaticNextPlayer1');
- ThemeLoadStatic (PartyNewRound.StaticNextPlayer2, 'PartyNewRoundStaticNextPlayer2');
- ThemeLoadStatic (PartyNewRound.StaticNextPlayer3, 'PartyNewRoundStaticNextPlayer3');
-
- //Party Score
- ThemeLoadBasic(PartyScore, 'PartyScore');
-
- ThemeLoadText (PartyScore.TextScoreTeam1, 'PartyScoreTextScoreTeam1');
- ThemeLoadText (PartyScore.TextScoreTeam2, 'PartyScoreTextScoreTeam2');
- ThemeLoadText (PartyScore.TextScoreTeam3, 'PartyScoreTextScoreTeam3');
- ThemeLoadText (PartyScore.TextNameTeam1, 'PartyScoreTextNameTeam1');
- ThemeLoadText (PartyScore.TextNameTeam2, 'PartyScoreTextNameTeam2');
- ThemeLoadText (PartyScore.TextNameTeam3, 'PartyScoreTextNameTeam3');
-
- ThemeLoadStatic (PartyScore.StaticTeam1, 'PartyScoreStaticTeam1');
- ThemeLoadStatic (PartyScore.StaticTeam1BG, 'PartyScoreStaticTeam1BG');
- ThemeLoadStatic (PartyScore.StaticTeam1Deco, 'PartyScoreStaticTeam1Deco');
- ThemeLoadStatic (PartyScore.StaticTeam2, 'PartyScoreStaticTeam2');
- ThemeLoadStatic (PartyScore.StaticTeam2BG, 'PartyScoreStaticTeam2BG');
- ThemeLoadStatic (PartyScore.StaticTeam2Deco, 'PartyScoreStaticTeam2Deco');
- ThemeLoadStatic (PartyScore.StaticTeam3, 'PartyScoreStaticTeam3');
- ThemeLoadStatic (PartyScore.StaticTeam3BG, 'PartyScoreStaticTeam3BG');
- ThemeLoadStatic (PartyScore.StaticTeam3Deco, 'PartyScoreStaticTeam3Deco');
-
- //Load Party Score DecoTextures Object
- PartyScore.DecoTextures.ChangeTextures := (ThemeIni.ReadInteger('PartyScoreDecoTextures', 'ChangeTextures', 0) = 1);
- PartyScore.DecoTextures.FirstTexture := ThemeIni.ReadString('PartyScoreDecoTextures', 'FirstTexture', '');
- PartyScore.DecoTextures.FirstTyp := ParseTextureType(ThemeIni.ReadString('PartyScoreDecoTextures', 'FirstTyp', ''), TEXTURE_TYPE_COLORIZED);
- PartyScore.DecoTextures.FirstColor := ThemeIni.ReadString('PartyScoreDecoTextures', 'FirstColor', 'Black');
-
- PartyScore.DecoTextures.SecondTexture := ThemeIni.ReadString('PartyScoreDecoTextures', 'SecondTexture', '');
- PartyScore.DecoTextures.SecondTyp := ParseTextureType(ThemeIni.ReadString('PartyScoreDecoTextures', 'SecondTyp', ''), TEXTURE_TYPE_COLORIZED);
- PartyScore.DecoTextures.SecondColor := ThemeIni.ReadString('PartyScoreDecoTextures', 'SecondColor', 'Black');
-
- PartyScore.DecoTextures.ThirdTexture := ThemeIni.ReadString('PartyScoreDecoTextures', 'ThirdTexture', '');
- PartyScore.DecoTextures.ThirdTyp := ParseTextureType(ThemeIni.ReadString('PartyScoreDecoTextures', 'ThirdTyp', ''), TEXTURE_TYPE_COLORIZED);
- PartyScore.DecoTextures.ThirdColor := ThemeIni.ReadString('PartyScoreDecoTextures', 'ThirdColor', 'Black');
-
- ThemeLoadText (PartyScore.TextWinner, 'PartyScoreTextWinner');
-
- //Party Win
- ThemeLoadBasic(PartyWin, 'PartyWin');
-
- ThemeLoadText (PartyWin.TextScoreTeam1, 'PartyWinTextScoreTeam1');
- ThemeLoadText (PartyWin.TextScoreTeam2, 'PartyWinTextScoreTeam2');
- ThemeLoadText (PartyWin.TextScoreTeam3, 'PartyWinTextScoreTeam3');
- ThemeLoadText (PartyWin.TextNameTeam1, 'PartyWinTextNameTeam1');
- ThemeLoadText (PartyWin.TextNameTeam2, 'PartyWinTextNameTeam2');
- ThemeLoadText (PartyWin.TextNameTeam3, 'PartyWinTextNameTeam3');
-
- ThemeLoadStatic (PartyWin.StaticTeam1, 'PartyWinStaticTeam1');
- ThemeLoadStatic (PartyWin.StaticTeam1BG, 'PartyWinStaticTeam1BG');
- ThemeLoadStatic (PartyWin.StaticTeam1Deco, 'PartyWinStaticTeam1Deco');
- ThemeLoadStatic (PartyWin.StaticTeam2, 'PartyWinStaticTeam2');
- ThemeLoadStatic (PartyWin.StaticTeam2BG, 'PartyWinStaticTeam2BG');
- ThemeLoadStatic (PartyWin.StaticTeam2Deco, 'PartyWinStaticTeam2Deco');
- ThemeLoadStatic (PartyWin.StaticTeam3, 'PartyWinStaticTeam3');
- ThemeLoadStatic (PartyWin.StaticTeam3BG, 'PartyWinStaticTeam3BG');
- ThemeLoadStatic (PartyWin.StaticTeam3Deco, 'PartyWinStaticTeam3Deco');
-
- ThemeLoadText (PartyWin.TextWinner, 'PartyWinTextWinner');
-
- //Party Options
- ThemeLoadBasic(PartyOptions, 'PartyOptions');
- ThemeLoadSelectSlide(PartyOptions.SelectLevel, 'PartyOptionsSelectLevel');
- ThemeLoadSelectSlide(PartyOptions.SelectPlayList, 'PartyOptionsSelectPlayList');
- ThemeLoadSelectSlide(PartyOptions.SelectPlayList2, 'PartyOptionsSelectPlayList2');
- ThemeLoadSelectSlide(PartyOptions.SelectRounds, 'PartyOptionsSelectRounds');
- ThemeLoadSelectSlide(PartyOptions.SelectTeams, 'PartyOptionsSelectTeams');
- ThemeLoadSelectSlide(PartyOptions.SelectPlayers1, 'PartyOptionsSelectPlayers1');
- ThemeLoadSelectSlide(PartyOptions.SelectPlayers2, 'PartyOptionsSelectPlayers2');
- ThemeLoadSelectSlide(PartyOptions.SelectPlayers3, 'PartyOptionsSelectPlayers3');
-
- {ThemeLoadButton (ButtonNext, 'ButtonNext');
- ThemeLoadButton (ButtonPrev, 'ButtonPrev');}
-
- //Party Player
- ThemeLoadBasic(PartyPlayer, 'PartyPlayer');
- ThemeLoadButton(PartyPlayer.Team1Name, 'PartyPlayerTeam1Name');
- ThemeLoadButton(PartyPlayer.Player1Name, 'PartyPlayerPlayer1Name');
- ThemeLoadButton(PartyPlayer.Player2Name, 'PartyPlayerPlayer2Name');
- ThemeLoadButton(PartyPlayer.Player3Name, 'PartyPlayerPlayer3Name');
- ThemeLoadButton(PartyPlayer.Player4Name, 'PartyPlayerPlayer4Name');
-
- ThemeLoadButton(PartyPlayer.Team2Name, 'PartyPlayerTeam2Name');
- ThemeLoadButton(PartyPlayer.Player5Name, 'PartyPlayerPlayer5Name');
- ThemeLoadButton(PartyPlayer.Player6Name, 'PartyPlayerPlayer6Name');
- ThemeLoadButton(PartyPlayer.Player7Name, 'PartyPlayerPlayer7Name');
- ThemeLoadButton(PartyPlayer.Player8Name, 'PartyPlayerPlayer8Name');
-
- ThemeLoadButton(PartyPlayer.Team3Name, 'PartyPlayerTeam3Name');
- ThemeLoadButton(PartyPlayer.Player9Name, 'PartyPlayerPlayer9Name');
- ThemeLoadButton(PartyPlayer.Player10Name, 'PartyPlayerPlayer10Name');
- ThemeLoadButton(PartyPlayer.Player11Name, 'PartyPlayerPlayer11Name');
- ThemeLoadButton(PartyPlayer.Player12Name, 'PartyPlayerPlayer12Name');
-
- {ThemeLoadButton(ButtonNext, 'PartyPlayerButtonNext');
- ThemeLoadButton(ButtonPrev, 'PartyPlayerButtonPrev');}
-
- ThemeLoadBasic(StatMain, 'StatMain');
-
- ThemeLoadButton(StatMain.ButtonScores, 'StatMainButtonScores');
- ThemeLoadButton(StatMain.ButtonSingers, 'StatMainButtonSingers');
- ThemeLoadButton(StatMain.ButtonSongs, 'StatMainButtonSongs');
- ThemeLoadButton(StatMain.ButtonBands, 'StatMainButtonBands');
- ThemeLoadButton(StatMain.ButtonExit, 'StatMainButtonExit');
-
- ThemeLoadText (StatMain.TextOverview, 'StatMainTextOverview');
-
-
- ThemeLoadBasic(StatDetail, 'StatDetail');
-
- ThemeLoadButton(StatDetail.ButtonNext, 'StatDetailButtonNext');
- ThemeLoadButton(StatDetail.ButtonPrev, 'StatDetailButtonPrev');
- ThemeLoadButton(StatDetail.ButtonReverse, 'StatDetailButtonReverse');
- ThemeLoadButton(StatDetail.ButtonExit, 'StatDetailButtonExit');
-
- ThemeLoadText (StatDetail.TextDescription, 'StatDetailTextDescription');
- ThemeLoadText (StatDetail.TextPage, 'StatDetailTextPage');
- ThemeLoadTexts(StatDetail.TextList, 'StatDetailTextList');
-
- //Translate Texts
- StatDetail.Description[0] := Language.Translate('STAT_DESC_SCORES');
- StatDetail.Description[1] := Language.Translate('STAT_DESC_SINGERS');
- StatDetail.Description[2] := Language.Translate('STAT_DESC_SONGS');
- StatDetail.Description[3] := Language.Translate('STAT_DESC_BANDS');
-
- StatDetail.DescriptionR[0] := Language.Translate('STAT_DESC_SCORES_REVERSED');
- StatDetail.DescriptionR[1] := Language.Translate('STAT_DESC_SINGERS_REVERSED');
- StatDetail.DescriptionR[2] := Language.Translate('STAT_DESC_SONGS_REVERSED');
- StatDetail.DescriptionR[3] := Language.Translate('STAT_DESC_BANDS_REVERSED');
-
- StatDetail.FormatStr[0] := Language.Translate('STAT_FORMAT_SCORES');
- StatDetail.FormatStr[1] := Language.Translate('STAT_FORMAT_SINGERS');
- StatDetail.FormatStr[2] := Language.Translate('STAT_FORMAT_SONGS');
- StatDetail.FormatStr[3] := Language.Translate('STAT_FORMAT_BANDS');
-
- StatDetail.PageStr := Language.Translate('STAT_PAGE');
-
- //Playlist Translations
- Playlist.CatText := Language.Translate('PLAYLIST_CATTEXT');
-
- //Level Translations
- //Fill ILevel
- ILevel[0] := Language.Translate('SING_EASY');
- ILevel[1] := Language.Translate('SING_MEDIUM');
- ILevel[2] := Language.Translate('SING_HARD');
- end;
-
- ThemeIni.Free;
- end;
-end;
-
-procedure TTheme.ThemeLoadBasic(Theme: TThemeBasic; Name: string);
-begin
- ThemeLoadBackground(Theme.Background, Name);
- ThemeLoadTexts(Theme.Text, Name + 'Text');
- ThemeLoadStatics(Theme.Static, Name + 'Static');
- ThemeLoadButtonCollections(Theme.ButtonCollection, Name + 'ButtonCollection');
-
- LastThemeBasic := Theme;
-end;
-
-procedure TTheme.ThemeLoadBackground(var ThemeBackground: TThemeBackground; Name: string);
-begin
- ThemeBackground.Tex := ThemeIni.ReadString(Name + 'Background', 'Tex', '');
-end;
-
-procedure TTheme.ThemeLoadText(var ThemeText: TThemeText; Name: string);
-var
- C: integer;
-begin
- ThemeText.X := ThemeIni.ReadInteger(Name, 'X', 0);
- ThemeText.Y := ThemeIni.ReadInteger(Name, 'Y', 0);
- ThemeText.W := ThemeIni.ReadInteger(Name, 'W', 0);
-
- ThemeText.Z := ThemeIni.ReadFloat(Name, 'Z', 0);
-
- ThemeText.ColR := ThemeIni.ReadFloat(Name, 'ColR', 0);
- ThemeText.ColG := ThemeIni.ReadFloat(Name, 'ColG', 0);
- ThemeText.ColB := ThemeIni.ReadFloat(Name, 'ColB', 0);
-
- ThemeText.Font := ThemeIni.ReadInteger(Name, 'Font', 0);
- ThemeText.Size := ThemeIni.ReadInteger(Name, 'Size', 0);
- ThemeText.Align := ThemeIni.ReadInteger(Name, 'Align', 0);
-
- ThemeText.Text := Language.Translate(ThemeIni.ReadString(Name, 'Text', ''));
- ThemeText.Color := ThemeIni.ReadString(Name, 'Color', '');
-
- //Reflection
- ThemeText.Reflection := (ThemeIni.ReadInteger(Name, 'Reflection', 0)) = 1;
- ThemeText.Reflectionspacing := ThemeIni.ReadFloat(Name, 'ReflectionSpacing', 15);
-
- C := ColorExists(ThemeText.Color);
- if C >= 0 then begin
- ThemeText.ColR := Color[C].RGB.R;
- ThemeText.ColG := Color[C].RGB.G;
- ThemeText.ColB := Color[C].RGB.B;
- end;
-end;
-
-procedure TTheme.ThemeLoadTexts(var ThemeText: AThemeText; Name: string);
-var
- T: integer;
-begin
- T := 1;
- while ThemeIni.SectionExists(Name + IntToStr(T)) do begin
- SetLength(ThemeText, T);
- ThemeLoadText(ThemeText[T-1], Name + IntToStr(T));
- Inc(T);
- end;
-end;
-
-procedure TTheme.ThemeLoadStatic(var ThemeStatic: TThemeStatic; Name: string);
-var
- C: integer;
-begin
- ThemeStatic.Tex := ThemeIni.ReadString(Name, 'Tex', '');
-
- ThemeStatic.X := ThemeIni.ReadInteger(Name, 'X', 0);
- ThemeStatic.Y := ThemeIni.ReadInteger(Name, 'Y', 0);
- ThemeStatic.Z := ThemeIni.ReadFloat (Name, 'Z', 0);
- ThemeStatic.W := ThemeIni.ReadInteger(Name, 'W', 0);
- ThemeStatic.H := ThemeIni.ReadInteger(Name, 'H', 0);
-
- ThemeStatic.Typ := ParseTextureType(ThemeIni.ReadString(Name, 'Type', ''), TEXTURE_TYPE_PLAIN);
- ThemeStatic.Color := ThemeIni.ReadString(Name, 'Color', '');
-
- C := ColorExists(ThemeStatic.Color);
- if C >= 0 then begin
- ThemeStatic.ColR := Color[C].RGB.R;
- ThemeStatic.ColG := Color[C].RGB.G;
- ThemeStatic.ColB := Color[C].RGB.B;
- end;
-
- ThemeStatic.TexX1 := ThemeIni.ReadFloat(Name, 'TexX1', 0);
- ThemeStatic.TexY1 := ThemeIni.ReadFloat(Name, 'TexY1', 0);
- ThemeStatic.TexX2 := ThemeIni.ReadFloat(Name, 'TexX2', 1);
- ThemeStatic.TexY2 := ThemeIni.ReadFloat(Name, 'TexY2', 1);
-
- //Reflection Mod
- ThemeStatic.Reflection := (ThemeIni.ReadInteger(Name, 'Reflection', 0) = 1);
- ThemeStatic.ReflectionSpacing := ThemeIni.ReadFloat(Name, 'ReflectionSpacing', 15);
-end;
-
-procedure TTheme.ThemeLoadStatics(var ThemeStatic: AThemeStatic; Name: string);
-var
- S: integer;
-begin
- S := 1;
- while ThemeIni.SectionExists(Name + IntToStr(S)) do begin
- SetLength(ThemeStatic, S);
- ThemeLoadStatic(ThemeStatic[S-1], Name + IntToStr(S));
- Inc(S);
- end;
-end;
-
-//Button Collection Mod
-procedure TTheme.ThemeLoadButtonCollection(var Collection: TThemeButtonCollection; Name: string);
-var T: Integer;
-begin
- //Load Collection Style
- ThemeLoadButton(Collection.Style, Name);
-
- //Load Other Attributes
- T := ThemeIni.ReadInteger (Name, 'FirstChild', 0);
- if (T > 0) And (T < 256) then
- Collection.FirstChild := T
- else
- Collection.FirstChild := 0;
-end;
-
-procedure TTheme.ThemeLoadButtonCollections(var Collections: AThemeButtonCollection; Name: string);
-var
- I: integer;
-begin
- I := 1;
- while ThemeIni.SectionExists(Name + IntToStr(I)) do begin
- SetLength(Collections, I);
- ThemeLoadButtonCollection(Collections[I-1], Name + IntToStr(I));
- Inc(I);
- end;
-end;
-//End Button Collection Mod
-
-procedure TTheme.ThemeLoadButton(var ThemeButton: TThemeButton; Name: string; const Collections: PAThemeButtonCollection);
-var
- C: integer;
- TLen: integer;
- T: integer;
- Collections2: PAThemeButtonCollection;
-begin
- if not ThemeIni.SectionExists(Name) then
- begin
- ThemeButton.Visible := False;
- exit;
- end;
- ThemeButton.Tex := ThemeIni.ReadString(Name, 'Tex', '');
- ThemeButton.X := ThemeIni.ReadInteger (Name, 'X', 0);
- ThemeButton.Y := ThemeIni.ReadInteger (Name, 'Y', 0);
- ThemeButton.Z := ThemeIni.ReadFloat (Name, 'Z', 0);
- ThemeButton.W := ThemeIni.ReadInteger (Name, 'W', 0);
- ThemeButton.H := ThemeIni.ReadInteger (Name, 'H', 0);
- ThemeButton.Typ := ParseTextureType(ThemeIni.ReadString(Name, 'Type', ''), TEXTURE_TYPE_PLAIN);
-
- //Reflection Mod
- ThemeButton.Reflection := (ThemeIni.ReadInteger(Name, 'Reflection', 0) = 1);
- ThemeButton.ReflectionSpacing := ThemeIni.ReadFloat(Name, 'ReflectionSpacing', 15);
-
- ThemeButton.ColR := ThemeIni.ReadFloat(Name, 'ColR', 1);
- ThemeButton.ColG := ThemeIni.ReadFloat(Name, 'ColG', 1);
- ThemeButton.ColB := ThemeIni.ReadFloat(Name, 'ColB', 1);
- ThemeButton.Int := ThemeIni.ReadFloat(Name, 'Int', 1);
- ThemeButton.DColR := ThemeIni.ReadFloat(Name, 'DColR', 1);
- ThemeButton.DColG := ThemeIni.ReadFloat(Name, 'DColG', 1);
- ThemeButton.DColB := ThemeIni.ReadFloat(Name, 'DColB', 1);
- ThemeButton.DInt := ThemeIni.ReadFloat(Name, 'DInt', 1);
-
- ThemeButton.Color := ThemeIni.ReadString(Name, 'Color', '');
- C := ColorExists(ThemeButton.Color);
- if C >= 0 then begin
- ThemeButton.ColR := Color[C].RGB.R;
- ThemeButton.ColG := Color[C].RGB.G;
- ThemeButton.ColB := Color[C].RGB.B;
- end;
-
- ThemeButton.DColor := ThemeIni.ReadString(Name, 'DColor', '');
- C := ColorExists(ThemeButton.DColor);
- if C >= 0 then begin
- ThemeButton.DColR := Color[C].RGB.R;
- ThemeButton.DColG := Color[C].RGB.G;
- ThemeButton.DColB := Color[C].RGB.B;
- end;
-
- ThemeButton.Visible := (ThemeIni.ReadInteger(Name, 'Visible', 1) = 1);
-
- //Fade Mod
- ThemeButton.SelectH := ThemeIni.ReadInteger (Name, 'SelectH', ThemeButton.H);
- ThemeButton.SelectW := ThemeIni.ReadInteger (Name, 'SelectW', ThemeButton.W);
-
- ThemeButton.DeSelectReflectionspacing := ThemeIni.ReadFloat(Name, 'DeSelectReflectionSpacing', ThemeButton.Reflectionspacing);
-
- ThemeButton.Fade := (ThemeIni.ReadInteger(Name, 'Fade', 0) = 1);
- ThemeButton.FadeText := (ThemeIni.ReadInteger(Name, 'FadeText', 0) = 1);
-
-
- ThemeButton.FadeTex := ThemeIni.ReadString(Name, 'FadeTex', '');
- ThemeButton.FadeTexPos:= ThemeIni.ReadInteger(Name, 'FadeTexPos', 0);
- if (ThemeButton.FadeTexPos > 4) Or (ThemeButton.FadeTexPos < 0) then
- ThemeButton.FadeTexPos := 0;
-
- //Button Collection Mod
- T := ThemeIni.ReadInteger(Name, 'Parent', 0);
-
- //Set Collections to Last Basic Collections if no valid Value
- if (Collections = nil) then
- Collections2 := @LastThemeBasic.ButtonCollection
- else
- Collections2 := Collections;
- //Test for valid Value
- if (Collections2 <> nil) AND (T > 0) AND (T <= Length(Collections2^)) then
- begin
- Inc(Collections2^[T-1].ChildCount);
- ThemeButton.Parent := T;
- end
- else
- ThemeButton.Parent := 0;
-
- //Read ButtonTexts
- TLen := ThemeIni.ReadInteger(Name, 'Texts', 0);
- SetLength(ThemeButton.Text, TLen);
- for T := 1 to TLen do
- ThemeLoadText(ThemeButton.Text[T-1], Name + 'Text' + IntToStr(T));
-end;
-
-procedure TTheme.ThemeLoadSelectSlide(var ThemeSelectS: TThemeSelectSlide; Name: string);
-var
- C: integer;
-begin
- ThemeSelectS.Text := Language.Translate(ThemeIni.ReadString(Name, 'Text', ''));
-
- ThemeSelectS.Tex := {Skin.SkinPath + }ThemeIni.ReadString(Name, 'Tex', '');
- ThemeSelectS.TexSBG := {Skin.SkinPath + }ThemeIni.ReadString(Name, 'TexSBG', '');
-
- ThemeSelectS.X := ThemeIni.ReadInteger(Name, 'X', 0);
- ThemeSelectS.Y := ThemeIni.ReadInteger(Name, 'Y', 0);
- ThemeSelectS.W := ThemeIni.ReadInteger(Name, 'W', 0);
- ThemeSelectS.H := ThemeIni.ReadInteger(Name, 'H', 0);
-
- ThemeSelectS.Z := ThemeIni.ReadFloat(Name, 'Z', 0);
-
- ThemeSelectS.TextSize := ThemeIni.ReadInteger(Name, 'TextSize', 10);
-
- ThemeSelectS.SkipX := ThemeIni.ReadInteger(Name, 'SkipX', 0);
-
- ThemeSelectS.SBGW := ThemeIni.ReadInteger(Name, 'SBGW', 450);
-
- LoadColor(ThemeSelectS.ColR, ThemeSelectS.ColG, ThemeSelectS.ColB, ThemeIni.ReadString(Name, 'Color', ''));
- ThemeSelectS.Int := ThemeIni.ReadFloat(Name, 'Int', 1);
- LoadColor(ThemeSelectS.DColR, ThemeSelectS.DColG, ThemeSelectS.DColB, ThemeIni.ReadString(Name, 'DColor', ''));
- ThemeSelectS.DInt := ThemeIni.ReadFloat(Name, 'DInt', 1);
-
- LoadColor(ThemeSelectS.TColR, ThemeSelectS.TColG, ThemeSelectS.TColB, ThemeIni.ReadString(Name, 'TColor', ''));
- ThemeSelectS.TInt := ThemeIni.ReadFloat(Name, 'TInt', 1);
- LoadColor(ThemeSelectS.TDColR, ThemeSelectS.TDColG, ThemeSelectS.TDColB, ThemeIni.ReadString(Name, 'TDColor', ''));
- ThemeSelectS.TDInt := ThemeIni.ReadFloat(Name, 'TDInt', 1);
-
- LoadColor(ThemeSelectS.SBGColR, ThemeSelectS.SBGColG, ThemeSelectS.SBGColB, ThemeIni.ReadString(Name, 'SBGColor', ''));
- ThemeSelectS.SBGInt := ThemeIni.ReadFloat(Name, 'SBGInt', 1);
- LoadColor(ThemeSelectS.SBGDColR, ThemeSelectS.SBGDColG, ThemeSelectS.SBGDColB, ThemeIni.ReadString(Name, 'SBGDColor', ''));
- ThemeSelectS.SBGDInt := ThemeIni.ReadFloat(Name, 'SBGDInt', 1);
-
- LoadColor(ThemeSelectS.STColR, ThemeSelectS.STColG, ThemeSelectS.STColB, ThemeIni.ReadString(Name, 'STColor', ''));
- ThemeSelectS.STInt := ThemeIni.ReadFloat(Name, 'STInt', 1);
- LoadColor(ThemeSelectS.STDColR, ThemeSelectS.STDColG, ThemeSelectS.STDColB, ThemeIni.ReadString(Name, 'STDColor', ''));
- ThemeSelectS.STDInt := ThemeIni.ReadFloat(Name, 'STDInt', 1);
-end;
-
-procedure TTheme.LoadColors;
-var
- SL: TStringList;
- C: integer;
- S: string;
- Col: integer;
- RGB: TRGB;
-begin
- SL := TStringList.Create;
- ThemeIni.ReadSection('Colors', SL);
-
- // normal colors
- SetLength(Color, SL.Count);
- for C := 0 to SL.Count-1 do begin
- Color[C].Name := SL.Strings[C];
-
- S := ThemeIni.ReadString('Colors', SL.Strings[C], '');
-
- Color[C].RGB.R := StrToInt(Copy(S, 1, Pos(' ' , S)-1))/255;
- Delete(S, 1, Pos(' ', S));
-
- Color[C].RGB.G := StrToInt(Copy(S, 1, Pos(' ' , S)-1))/255;
- Delete(S, 1, Pos(' ', S));
-
- Color[C].RGB.B := StrToInt(S)/255;
- end;
-
- // skin color
- SetLength(Color, SL.Count + 3);
- C := SL.Count;
- Color[C].Name := 'ColorDark';
- Color[C].RGB := GetSystemColor(Skin.Color); //Ini.Color);
-
- C := C+1;
- Color[C].Name := 'ColorLight';
- Color[C].RGB := ColorSqrt(Color[C-1].RGB);
-
- C := C+1;
- Color[C].Name := 'ColorLightest';
- Color[C].RGB := ColorSqrt(Color[C-1].RGB);
-
- // players colors
- SetLength(Color, Length(Color)+18);
-
- // P1
- C := C+1;
- Color[C].Name := 'P1Dark';
- Color[C].RGB := GetSystemColor(0); // 0 - blue
-
- C := C+1;
- Color[C].Name := 'P1Light';
- Color[C].RGB := ColorSqrt(Color[C-1].RGB);
-
- C := C+1;
- Color[C].Name := 'P1Lightest';
- Color[C].RGB := ColorSqrt(Color[C-1].RGB);
-
- // P2
- C := C+1;
- Color[C].Name := 'P2Dark';
- Color[C].RGB := GetSystemColor(3); // 3 - red
-
- C := C+1;
- Color[C].Name := 'P2Light';
- Color[C].RGB := ColorSqrt(Color[C-1].RGB);
-
- C := C+1;
- Color[C].Name := 'P2Lightest';
- Color[C].RGB := ColorSqrt(Color[C-1].RGB);
-
- // P3
- C := C+1;
- Color[C].Name := 'P3Dark';
- Color[C].RGB := GetSystemColor(1); // 1 - green
-
- C := C+1;
- Color[C].Name := 'P3Light';
- Color[C].RGB := ColorSqrt(Color[C-1].RGB);
-
- C := C+1;
- Color[C].Name := 'P3Lightest';
- Color[C].RGB := ColorSqrt(Color[C-1].RGB);
-
- // P4
- C := C+1;
- Color[C].Name := 'P4Dark';
- Color[C].RGB := GetSystemColor(4); // 4 - brown
-
- C := C+1;
- Color[C].Name := 'P4Light';
- Color[C].RGB := ColorSqrt(Color[C-1].RGB);
-
- C := C+1;
- Color[C].Name := 'P4Lightest';
- Color[C].RGB := ColorSqrt(Color[C-1].RGB);
-
- // P5
- C := C+1;
- Color[C].Name := 'P5Dark';
- Color[C].RGB := GetSystemColor(5); // 5 - yellow
-
- C := C+1;
- Color[C].Name := 'P5Light';
- Color[C].RGB := ColorSqrt(Color[C-1].RGB);
-
- C := C+1;
- Color[C].Name := 'P5Lightest';
- Color[C].RGB := ColorSqrt(Color[C-1].RGB);
-
- // P6
- C := C+1;
- Color[C].Name := 'P6Dark';
- Color[C].RGB := GetSystemColor(6); // 6 - violet
-
- C := C+1;
- Color[C].Name := 'P6Light';
- Color[C].RGB := ColorSqrt(Color[C-1].RGB);
-
- C := C+1;
- Color[C].Name := 'P6Lightest';
- Color[C].RGB := ColorSqrt(Color[C-1].RGB);
-
-
- SL.Free;
-end;
-
-function ColorExists(Name: string): integer;
-var
- C: integer;
-begin
- Result := -1;
- for C := 0 to High(Color) do
- if Color[C].Name = Name then Result := C;
-end;
-
-procedure LoadColor(var R, G, B: real; ColorName: string);
-var
- C: integer;
-begin
- C := ColorExists(ColorName);
- if C >= 0 then begin
- R := Color[C].RGB.R;
- G := Color[C].RGB.G;
- B := Color[C].RGB.B;
- end;
-end;
-
-function GetSystemColor(Color: integer): TRGB;
-begin
- case Color of
- 0: begin
- // blue
- Result.R := 71/255;
- Result.G := 175/255;
- Result.B := 247/255;
- end;
- 1: begin
- // green
- Result.R := 63/255;
- Result.G := 191/255;
- Result.B := 63/255;
- end;
- 2: begin
- // pink
- Result.R := 255/255;
-{ Result.G := 63/255;
- Result.B := 192/255;}
- Result.G := 175/255;
- Result.B := 247/255;
- end;
- 3: begin
- // red
- Result.R := 247/255;
- Result.G := 71/255;
- Result.B := 71/255;
- end;
- //'Violet', 'Orange', 'Yellow', 'Brown', 'Black'
- //New Theme-Color Patch
- 4: begin
- // violet
- Result.R := 230/255;
- Result.G := 63/255;
- Result.B := 230/255;
- end;
- 5: begin
- // orange
- Result.R := 255/255;
- Result.G := 144/255;
- Result.B := 0;
- end;
- 6: begin
- // yellow
- Result.R := 230/255;
- Result.G := 230/255;
- Result.B := 95/255;
- end;
- 7: begin
- // brown
- Result.R := 192/255;
- Result.G := 127/255;
- Result.B := 31/255;
- end;
- 8: begin
- // black
- Result.R := 0;
- Result.G := 0;
- Result.B := 0;
- end;
- //New Theme-Color Patch End
-
- end;
-end;
-
-function ColorSqrt(RGB: TRGB): TRGB;
-begin
- Result.R := sqrt(RGB.R);
- Result.G := sqrt(RGB.G);
- Result.B := sqrt(RGB.B);
-end;
-
-procedure TTheme.ThemeSave(FileName: string);
-var
- I: integer;
-begin
- {$IFDEF THEMESAVE}
- ThemeIni := TIniFile.Create(FileName);
- {$ELSE}
- ThemeIni := TMemIniFile.Create(FileName);
- {$ENDIF}
-
- ThemeSaveBasic(Loading, 'Loading');
-
- ThemeSaveBasic(Main, 'Main');
- ThemeSaveText(Main.TextDescription, 'MainTextDescription');
- ThemeSaveText(Main.TextDescriptionLong, 'MainTextDescriptionLong');
- ThemeSaveButton(Main.ButtonSolo, 'MainButtonSolo');
- ThemeSaveButton(Main.ButtonEditor, 'MainButtonEditor');
- ThemeSaveButton(Main.ButtonOptions, 'MainButtonOptions');
- ThemeSaveButton(Main.ButtonExit, 'MainButtonExit');
-
- ThemeSaveBasic(Name, 'Name');
- for I := 1 to 6 do
- ThemeSaveButton(Name.ButtonPlayer[I], 'NameButtonPlayer' + IntToStr(I));
-
- ThemeSaveBasic(Level, 'Level');
- ThemeSaveButton(Level.ButtonEasy, 'LevelButtonEasy');
- ThemeSaveButton(Level.ButtonMedium, 'LevelButtonMedium');
- ThemeSaveButton(Level.ButtonHard, 'LevelButtonHard');
-
- ThemeSaveBasic(Song, 'Song');
- ThemeSaveText(Song.TextArtist, 'SongTextArtist');
- ThemeSaveText(Song.TextTitle, 'SongTextTitle');
- ThemeSaveText(Song.TextNumber, 'SongTextNumber');
-
- //Show CAt in Top Left Mod
- ThemeSaveText(Song.TextCat, 'SongTextCat');
- ThemeSaveStatic(Song.StaticCat, 'SongStaticCat');
-
- ThemeSaveBasic(Sing, 'Sing');
-
- //TimeBar mod
- ThemeSaveStatic(Sing.StaticTimeProgress, 'SingTimeProgress');
- ThemeSaveText(Sing.TextTimeText, 'SingTimeText');
- //eoa TimeBar mod
-
- ThemeSaveStatic(Sing.StaticP1, 'SingP1Static');
- ThemeSaveText(Sing.TextP1, 'SingP1Text');
- ThemeSaveStatic(Sing.StaticP1ScoreBG, 'SingP1Static2');
- ThemeSaveText(Sing.TextP1Score, 'SingP1TextScore');
-
- //moveable singbar mod
- ThemeSaveStatic(Sing.StaticP1SingBar, 'SingP1SingBar');
- ThemeSaveStatic(Sing.StaticP1TwoPSingBar, 'SingP1TwoPSingBar');
- ThemeSaveStatic(Sing.StaticP1ThreePSingBar, 'SingP1ThreePSingBar');
- ThemeSaveStatic(Sing.StaticP2RSingBar, 'SingP2RSingBar');
- ThemeSaveStatic(Sing.StaticP2MSingBar, 'SingP2MSingBar');
- ThemeSaveStatic(Sing.StaticP3SingBar, 'SingP3SingBar');
- //eoa moveable singbar
-
- //Added for ps3 skin
- //This one is shown in 2/4P mode
- ThemeSaveStatic(Sing.StaticP1TwoP, 'SingP1TwoPStatic');
- ThemeSaveText(Sing.TextP1TwoP, 'SingP1TwoPText');
- ThemeSaveStatic(Sing.StaticP1TwoPScoreBG, 'SingP1TwoPStatic2');
- ThemeSaveText(Sing.TextP1TwoPScore, 'SingP1TwoPTextScore');
-
- //This one is shown in 3/6P mode
- ThemeSaveStatic(Sing.StaticP1ThreeP, 'SingP1ThreePStatic');
- ThemeSaveText(Sing.TextP1ThreeP, 'SingP1ThreePText');
- ThemeSaveStatic(Sing.StaticP1ThreePScoreBG, 'SingP1ThreePStatic2');
- ThemeSaveText(Sing.TextP1ThreePScore, 'SingP1ThreePTextScore');
- //eoa
-
- ThemeSaveStatic(Sing.StaticP2R, 'SingP2RStatic');
- ThemeSaveText(Sing.TextP2R, 'SingP2RText');
- ThemeSaveStatic(Sing.StaticP2RScoreBG, 'SingP2RStatic2');
- ThemeSaveText(Sing.TextP2RScore, 'SingP2RTextScore');
-
- ThemeSaveStatic(Sing.StaticP2M, 'SingP2MStatic');
- ThemeSaveText(Sing.TextP2M, 'SingP2MText');
- ThemeSaveStatic(Sing.StaticP2MScoreBG, 'SingP2MStatic2');
- ThemeSaveText(Sing.TextP2MScore, 'SingP2MTextScore');
-
- ThemeSaveStatic(Sing.StaticP3R, 'SingP3RStatic');
- ThemeSaveText(Sing.TextP3R, 'SingP3RText');
- ThemeSaveStatic(Sing.StaticP3RScoreBG, 'SingP3RStatic2');
- ThemeSaveText(Sing.TextP3RScore, 'SingP3RTextScore');
-
- ThemeSaveBasic(Score, 'Score');
- ThemeSaveText(Score.TextArtist, 'ScoreTextArtist');
- ThemeSaveText(Score.TextTitle, 'ScoreTextTitle');
-
- for I := 1 to 6 do begin
- ThemeSaveStatics(Score.PlayerStatic[I], 'ScorePlayer' + IntToStr(I) + 'Static');
-
- ThemeSaveText(Score.TextName[I], 'ScoreTextName' + IntToStr(I));
- ThemeSaveText(Score.TextScore[I], 'ScoreTextScore' + IntToStr(I));
- ThemeSaveText(Score.TextNotes[I], 'ScoreTextNotes' + IntToStr(I));
- ThemeSaveText(Score.TextNotesScore[I], 'ScoreTextNotesScore' + IntToStr(I));
- ThemeSaveText(Score.TextLineBonus[I], 'ScoreTextLineBonus' + IntToStr(I));
- ThemeSaveText(Score.TextLineBonusScore[I], 'ScoreTextLineBonusScore' + IntToStr(I));
- ThemeSaveText(Score.TextGoldenNotes[I], 'ScoreTextGoldenNotes' + IntToStr(I));
- ThemeSaveText(Score.TextGoldenNotesScore[I], 'ScoreTextGoldenNotesScore' + IntToStr(I));
- ThemeSaveText(Score.TextTotal[I], 'ScoreTextTotal' + IntToStr(I));
- ThemeSaveText(Score.TextTotalScore[I], 'ScoreTextTotalScore' + IntToStr(I));
-
- ThemeSaveStatic(Score.StaticBackLevel[I], 'ScoreStaticBackLevel' + IntToStr(I));
- ThemeSaveStatic(Score.StaticBackLevelRound[I], 'ScoreStaticBackLevelRound' + IntToStr(I));
- ThemeSaveStatic(Score.StaticLevel[I], 'ScoreStaticLevel' + IntToStr(I));
- ThemeSaveStatic(Score.StaticLevelRound[I], 'ScoreStaticLevelRound' + IntToStr(I));
- end;
-
- ThemeSaveBasic(Top5, 'Top5');
- ThemeSaveText(Top5.TextLevel, 'Top5TextLevel');
- ThemeSaveText(Top5.TextArtistTitle, 'Top5TextArtistTitle');
- ThemeSaveStatics(Top5.StaticNumber, 'Top5StaticNumber');
- ThemeSaveTexts(Top5.TextNumber, 'Top5TextNumber');
- ThemeSaveTexts(Top5.TextName, 'Top5TextName');
- ThemeSaveTexts(Top5.TextScore, 'Top5TextScore');
-
-
- ThemeIni.Free;
-end;
-
-procedure TTheme.ThemeSaveBasic(Theme: TThemeBasic; Name: string);
-begin
- ThemeIni.WriteInteger(Name, 'Texts', Length(Theme.Text));
-
- ThemeSaveBackground(Theme.Background, Name + 'Background');
- ThemeSaveStatics(Theme.Static, Name + 'Static');
- ThemeSaveTexts(Theme.Text, Name + 'Text');
-end;
-
-procedure TTheme.ThemeSaveBackground(ThemeBackground: TThemeBackground; Name: string);
-begin
- if ThemeBackground.Tex <> '' then
- ThemeIni.WriteString(Name, 'Tex', ThemeBackground.Tex)
- else begin
- ThemeIni.EraseSection(Name);
- end;
-end;
-
-procedure TTheme.ThemeSaveStatic(ThemeStatic: TThemeStatic; Name: string);
-begin
- ThemeIni.WriteInteger(Name, 'X', ThemeStatic.X);
- ThemeIni.WriteInteger(Name, 'Y', ThemeStatic.Y);
- ThemeIni.WriteInteger(Name, 'W', ThemeStatic.W);
- ThemeIni.WriteInteger(Name, 'H', ThemeStatic.H);
-
- ThemeIni.WriteString(Name, 'Tex', ThemeStatic.Tex);
- ThemeIni.WriteString(Name, 'Type', TextureTypeToStr(ThemeStatic.Typ));
- ThemeIni.WriteString(Name, 'Color', ThemeStatic.Color);
-
- ThemeIni.WriteFloat(Name, 'TexX1', ThemeStatic.TexX1);
- ThemeIni.WriteFloat(Name, 'TexY1', ThemeStatic.TexY1);
- ThemeIni.WriteFloat(Name, 'TexX2', ThemeStatic.TexX2);
- ThemeIni.WriteFloat(Name, 'TexY2', ThemeStatic.TexY2);
-end;
-
-procedure TTheme.ThemeSaveStatics(ThemeStatic: AThemeStatic; Name: string);
-var
- S: integer;
-begin
- for S := 0 to Length(ThemeStatic)-1 do
- ThemeSaveStatic(ThemeStatic[S], Name + {'Static' +} IntToStr(S+1));
-
- ThemeIni.EraseSection(Name + {'Static' + }IntToStr(S+1));
-end;
-
-procedure TTheme.ThemeSaveText(ThemeText: TThemeText; Name: string);
-begin
- ThemeIni.WriteInteger(Name, 'X', ThemeText.X);
- ThemeIni.WriteInteger(Name, 'Y', ThemeText.Y);
-
- ThemeIni.WriteInteger(Name, 'Font', ThemeText.Font);
- ThemeIni.WriteInteger(Name, 'Size', ThemeText.Size);
- ThemeIni.WriteInteger(Name, 'Align', ThemeText.Align);
-
- ThemeIni.WriteString(Name, 'Text', ThemeText.Text);
- ThemeIni.WriteString(Name, 'Color', ThemeText.Color);
-
- ThemeIni.WriteBool(Name, 'Reflection', ThemeText.Reflection);
- ThemeIni.WriteFloat(Name, 'ReflectionSpacing', ThemeText.ReflectionSpacing);
-end;
-
-procedure TTheme.ThemeSaveTexts(ThemeText: AThemeText; Name: string);
-var
- T: integer;
-begin
- for T := 0 to Length(ThemeText)-1 do
- ThemeSaveText(ThemeText[T], Name + {'Text' + }IntToStr(T+1));
-
- ThemeIni.EraseSection(Name + {'Text' + }IntToStr(T+1));
-end;
-
-procedure TTheme.ThemeSaveButton(ThemeButton: TThemeButton; Name: string);
-var
- T: integer;
-begin
- ThemeIni.WriteString(Name, 'Tex', ThemeButton.Tex);
- ThemeIni.WriteInteger(Name, 'X', ThemeButton.X);
- ThemeIni.WriteInteger(Name, 'Y', ThemeButton.Y);
- ThemeIni.WriteInteger(Name, 'W', ThemeButton.W);
- ThemeIni.WriteInteger(Name, 'H', ThemeButton.H);
- ThemeIni.WriteString(Name, 'Type', TextureTypeToStr(ThemeButton.Typ));
- ThemeIni.WriteInteger(Name, 'Texts', Length(ThemeButton.Text));
-
- ThemeIni.WriteString(Name, 'Color', ThemeButton.Color);
-
-{ ThemeButton.ColR := ThemeIni.ReadFloat(Name, 'ColR', 1);
- ThemeButton.ColG := ThemeIni.ReadFloat(Name, 'ColG', 1);
- ThemeButton.ColB := ThemeIni.ReadFloat(Name, 'ColB', 1);
- ThemeButton.Int := ThemeIni.ReadFloat(Name, 'Int', 1);
- ThemeButton.DColR := ThemeIni.ReadFloat(Name, 'DColR', 1);
- ThemeButton.DColG := ThemeIni.ReadFloat(Name, 'DColG', 1);
- ThemeButton.DColB := ThemeIni.ReadFloat(Name, 'DColB', 1);
- ThemeButton.DInt := ThemeIni.ReadFloat(Name, 'DInt', 1);}
-
-{ C := ColorExists(ThemeIni.ReadString(Name, 'Color', ''));
- if C >= 0 then begin
- ThemeButton.ColR := Color[C].RGB.R;
- ThemeButton.ColG := Color[C].RGB.G;
- ThemeButton.ColB := Color[C].RGB.B;
- end;
-
- C := ColorExists(ThemeIni.ReadString(Name, 'DColor', ''));
- if C >= 0 then begin
- ThemeButton.DColR := Color[C].RGB.R;
- ThemeButton.DColG := Color[C].RGB.G;
- ThemeButton.DColB := Color[C].RGB.B;
- end;}
-
- for T := 0 to High(ThemeButton.Text) do
- ThemeSaveText(ThemeButton.Text[T], Name + 'Text' + IntToStr(T+1));
-end;
-
-procedure TTheme.create_theme_objects();
-begin
- freeandnil( Loading );
- Loading := TThemeLoading.Create;
-
- freeandnil( Main );
- Main := TThemeMain.Create;
-
- freeandnil( Name );
- Name := TThemeName.Create;
-
- freeandnil( Level );
- Level := TThemeLevel.Create;
-
- freeandnil( Song );
- Song := TThemeSong.Create;
-
- freeandnil( Sing );
- Sing := TThemeSing.Create;
-
- freeandnil( Score );
- Score := TThemeScore.Create;
-
- freeandnil( Top5 );
- Top5 := TThemeTop5.Create;
-
- freeandnil( Options );
- Options := TThemeOptions.Create;
-
- freeandnil( OptionsGame );
- OptionsGame := TThemeOptionsGame.Create;
-
- freeandnil( OptionsGraphics );
- OptionsGraphics := TThemeOptionsGraphics.Create;
-
- freeandnil( OptionsSound );
- OptionsSound := TThemeOptionsSound.Create;
-
- freeandnil( OptionsLyrics );
- OptionsLyrics := TThemeOptionsLyrics.Create;
-
- freeandnil( OptionsThemes );
- OptionsThemes := TThemeOptionsThemes.Create;
-
- freeandnil( OptionsRecord );
- OptionsRecord := TThemeOptionsRecord.Create;
-
- freeandnil( OptionsAdvanced );
- OptionsAdvanced := TThemeOptionsAdvanced.Create;
-
-
- freeandnil( ErrorPopup );
- ErrorPopup := TThemeError.Create;
-
- freeandnil( CheckPopup );
- CheckPopup := TThemeCheck.Create;
-
-
- freeandnil( SongMenu );
- SongMenu := TThemeSongMenu.Create;
-
- freeandnil( SongJumpto );
- SongJumpto := TThemeSongJumpto.Create;
-
- //Party Screens
- freeandnil( PartyNewRound );
- PartyNewRound := TThemePartyNewRound.Create;
-
- freeandnil( PartyWin );
- PartyWin := TThemePartyWin.Create;
-
- freeandnil( PartyScore );
- PartyScore := TThemePartyScore.Create;
-
- freeandnil( PartyOptions );
- PartyOptions := TThemePartyOptions.Create;
-
- freeandnil( PartyPlayer );
- PartyPlayer := TThemePartyPlayer.Create;
-
-
- //Stats Screens:
- freeandnil( StatMain );
- StatMain := TThemeStatMain.Create;
-
- freeandnil( StatDetail );
- StatDetail := TThemeStatDetail.Create;
-
- end;
-
-end.
diff --git a/src/classes/UTime.pas b/src/classes/UTime.pas
deleted file mode 100644
index f8ae91c4..00000000
--- a/src/classes/UTime.pas
+++ /dev/null
@@ -1,185 +0,0 @@
-unit UTime;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-type
- TTime = class
- public
- constructor Create;
- function GetTime(): real;
- end;
-
- TRelativeTimer = class
- private
- AbsoluteTime: int64; // system-clock reference time for calculation of CurrentTime
- RelativeTimeOffset: real;
- Paused: boolean;
- TriggerMode: boolean;
- public
- constructor Create(TriggerMode: boolean = false);
- procedure Pause();
- procedure Resume();
- function GetTime(): real;
- function GetAndResetTime(): real;
- procedure SetTime(Time: real; Trigger: boolean = true);
- procedure Reset();
- end;
-
-procedure CountSkipTimeSet;
-procedure CountSkipTime;
-procedure CountMidTime;
-
-var
- USTime : TTime;
- VideoBGTimer: TRelativeTimer;
-
- TimeNew : int64;
- TimeOld : int64;
- TimeSkip : real;
- TimeMid : real;
- TimeMidTemp : int64;
-
-implementation
-
-uses
- sdl,
- ucommon;
-
-const
- cSDLCorrectionRatio = 1000;
-
-(*
-BEST Option now ( after discussion with whiteshark ) seems to be to use SDL
-timer functions...
-
-SDL_delay
-SDL_GetTicks
-http://www.gamedev.net/community/forums/topic.asp?topic_id=466145&whichpage=1%EE%8D%B7
-*)
-
-
-procedure CountSkipTimeSet;
-begin
- TimeNew := SDL_GetTicks();
-end;
-
-procedure CountSkipTime;
-begin
- TimeOld := TimeNew;
- TimeNew := SDL_GetTicks();
- TimeSkip := (TimeNew-TimeOld) / cSDLCorrectionRatio;
-end;
-
-procedure CountMidTime;
-begin
- TimeMidTemp := SDL_GetTicks();
- TimeMid := (TimeMidTemp - TimeNew) / cSDLCorrectionRatio;
-end;
-
-{**
- * TTime
- **}
-
-constructor TTime.Create;
-begin
- inherited;
- CountSkipTimeSet;
-end;
-
-function TTime.GetTime: real;
-begin
- Result := SDL_GetTicks() / cSDLCorrectionRatio;
-end;
-
-{**
- * TRelativeTimer
- **}
-
-(*
- * Creates a new timer.
- * If TriggerMode is false (default), the timer
- * will immediately begin with counting.
- * If TriggerMode is true, it will wait until Get/SetTime() or Pause() is called
- * for the first time.
- *)
-constructor TRelativeTimer.Create(TriggerMode: boolean);
-begin
- inherited Create();
- Self.TriggerMode := TriggerMode;
- Reset();
- Paused := false;
-end;
-
-procedure TRelativeTimer.Pause();
-begin
- RelativeTimeOffset := GetTime();
- Paused := true;
-end;
-
-procedure TRelativeTimer.Resume();
-begin
- AbsoluteTime := SDL_GetTicks();
- Paused := false;
-end;
-
-(*
- * Returns the counter of the timer.
- * If in TriggerMode it will return 0 and start the counter on the first call.
- *)
-function TRelativeTimer.GetTime: real;
-begin
- // initialize absolute time on first call in triggered mode
- if (TriggerMode and (AbsoluteTime = 0)) then
- begin
- AbsoluteTime := SDL_GetTicks();
- Result := RelativeTimeOffset;
- Exit;
- end;
-
- if Paused then
- Result := RelativeTimeOffset
- else
- Result := RelativeTimeOffset + (SDL_GetTicks() - AbsoluteTime) / cSDLCorrectionRatio;
-end;
-
-(*
- * Returns the counter of the timer and resets the counter to 0 afterwards.
- * Note: In TriggerMode the counter will not be stopped as with Reset().
- *)
-function TRelativeTimer.GetAndResetTime(): real;
-begin
- Result := GetTime();
- SetTime(0);
-end;
-
-(*
- * Sets the timer to the given time. This will trigger in TriggerMode if
- * Trigger is set to true. Otherwise the counter's state will not change.
- *)
-procedure TRelativeTimer.SetTime(Time: real; Trigger: boolean);
-begin
- RelativeTimeOffset := Time;
- if ((not TriggerMode) or Trigger) then
- AbsoluteTime := SDL_GetTicks();
-end;
-
-(*
- * Resets the counter of the timer to 0.
- * If in TriggerMode the timer will not start counting until it is triggered again.
- *)
-procedure TRelativeTimer.Reset();
-begin
- RelativeTimeOffset := 0;
- if (TriggerMode) then
- AbsoluteTime := 0
- else
- AbsoluteTime := SDL_GetTicks();
-end;
-
-end.
diff --git a/src/classes/UVideo.pas b/src/classes/UVideo.pas
deleted file mode 100644
index 0ab1d350..00000000
--- a/src/classes/UVideo.pas
+++ /dev/null
@@ -1,828 +0,0 @@
-{##############################################################################
- # FFmpeg support for UltraStar deluxe #
- # #
- # Created by b1indy #
- # based on 'An ffmpeg and SDL Tutorial' (http://www.dranger.com/ffmpeg/) #
- # with modifications by Jay Binks <jaybinks@gmail.com> #
- # #
- # http://www.mail-archive.com/fpc-pascal@lists.freepascal.org/msg09949.html #
- # http://www.nabble.com/file/p11795857/mpegpas01.zip #
- # #
- ##############################################################################}
-
-unit UVideo;
-
-// uncomment if you want to see the debug stuff
-{.$define DebugDisplay}
-{.$define DebugFrames}
-{.$define VideoBenchmark}
-{.$define Info}
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-// use BGR-format for accelerated colorspace conversion with swscale
-{$IFDEF UseSWScale}
- {$DEFINE PIXEL_FMT_BGR}
-{$ENDIF}
-
-implementation
-
-uses
- SDL,
- textgl,
- avcodec,
- avformat,
- avutil,
- avio,
- rational,
- {$IFDEF UseSWScale}
- swscale,
- {$ENDIF}
- UMediaCore_FFmpeg,
- math,
- gl,
- glext,
- SysUtils,
- UCommon,
- UConfig,
- ULog,
- UMusic,
- UGraphicClasses,
- UGraphic;
-
-const
-{$IFDEF PIXEL_FMT_BGR}
- PIXEL_FMT_OPENGL = GL_BGR;
- PIXEL_FMT_FFMPEG = PIX_FMT_BGR24;
-{$ELSE}
- PIXEL_FMT_OPENGL = GL_RGB;
- PIXEL_FMT_FFMPEG = PIX_FMT_RGB24;
-{$ENDIF}
-
-type
- TVideoPlayback_FFmpeg = class( TInterfacedObject, IVideoPlayback )
- private
- fVideoOpened,
- fVideoPaused: Boolean;
-
- VideoStream: PAVStream;
- VideoStreamIndex : Integer;
- VideoFormatContext: PAVFormatContext;
- VideoCodecContext: PAVCodecContext;
- VideoCodec: PAVCodec;
-
- AVFrame: PAVFrame;
- AVFrameRGB: PAVFrame;
- FrameBuffer: PByte;
-
- {$IFDEF UseSWScale}
- SoftwareScaleContext: PSwsContext;
- {$ENDIF}
-
- fVideoTex: GLuint;
- TexWidth, TexHeight: Cardinal;
-
- VideoAspect: Real;
- VideoTimeBase, VideoTime: Extended;
- fLoopTime: Extended;
-
- EOF: boolean;
- Loop: boolean;
-
- Initialized: boolean;
-
- procedure Reset();
- function DecodeFrame(var AVPacket: TAVPacket; out pts: double): boolean;
- procedure SynchronizeVideo(Frame: PAVFrame; var pts: double);
- public
- function GetName: String;
-
- function Init(): boolean;
- function Finalize: boolean;
-
- function Open(const aFileName : string): boolean; // true if succeed
- procedure Close;
-
- procedure Play;
- procedure Pause;
- procedure Stop;
-
- procedure SetPosition(Time: real);
- function GetPosition: real;
-
- procedure GetFrame(Time: Extended);
- procedure DrawGL(Screen: integer);
- end;
-
-var
- FFmpegCore: TMediaCore_FFmpeg;
-
-
-// These are called whenever we allocate a frame buffer.
-// We use this to store the global_pts in a frame at the time it is allocated.
-function PtsGetBuffer(CodecCtx: PAVCodecContext; Frame: PAVFrame): integer; cdecl;
-var
- pts: Pint64;
- VideoPktPts: Pint64;
-begin
- Result := avcodec_default_get_buffer(CodecCtx, Frame);
- VideoPktPts := CodecCtx^.opaque;
- if (VideoPktPts <> nil) then
- begin
- // Note: we must copy the pts instead of passing a pointer, because the packet
- // (and with it the pts) might change before a frame is returned by av_decode_video.
- pts := av_malloc(sizeof(int64));
- pts^ := VideoPktPts^;
- Frame^.opaque := pts;
- end;
-end;
-
-procedure PtsReleaseBuffer(CodecCtx: PAVCodecContext; Frame: PAVFrame); cdecl;
-begin
- if (Frame <> nil) then
- av_freep(@Frame^.opaque);
- avcodec_default_release_buffer(CodecCtx, Frame);
-end;
-
-
-{*------------------------------------------------------------------------------
- * TVideoPlayback_ffmpeg
- *------------------------------------------------------------------------------}
-
-function TVideoPlayback_FFmpeg.GetName: String;
-begin
- result := 'FFmpeg_Video';
-end;
-
-function TVideoPlayback_FFmpeg.Init(): boolean;
-begin
- Result := true;
-
- if (Initialized) then
- Exit;
- Initialized := true;
-
- FFmpegCore := TMediaCore_FFmpeg.GetInstance();
-
- Reset();
- av_register_all();
- glGenTextures(1, PGLuint(@fVideoTex));
-end;
-
-function TVideoPlayback_FFmpeg.Finalize(): boolean;
-begin
- Close();
- glDeleteTextures(1, PGLuint(@fVideoTex));
- Result := true;
-end;
-
-procedure TVideoPlayback_FFmpeg.Reset();
-begin
- // close previously opened video
- Close();
-
- fVideoOpened := False;
- fVideoPaused := False;
- VideoTimeBase := 0;
- VideoTime := 0;
- VideoStream := nil;
- VideoStreamIndex := -1;
-
- EOF := false;
-
- // TODO: do we really want this by default?
- Loop := true;
- fLoopTime := 0;
-end;
-
-function TVideoPlayback_FFmpeg.Open(const aFileName : string): boolean; // true if succeed
-var
- errnum: Integer;
- AudioStreamIndex: integer;
-begin
- Result := false;
-
- Reset();
-
- errnum := av_open_input_file(VideoFormatContext, PChar(aFileName), nil, 0, nil);
- if (errnum <> 0) then
- begin
- Log.LogError('Failed to open file "'+aFileName+'" ('+FFmpegCore.GetErrorString(errnum)+')');
- Exit;
- end;
-
- // update video info
- if (av_find_stream_info(VideoFormatContext) < 0) then
- begin
- Log.LogError('No stream info found', 'TVideoPlayback_ffmpeg.Open');
- Close();
- Exit;
- end;
- Log.LogInfo('VideoStreamIndex : ' + inttostr(VideoStreamIndex), 'TVideoPlayback_ffmpeg.Open');
-
- // find video stream
- FFmpegCore.FindStreamIDs(VideoFormatContext, VideoStreamIndex, AudioStreamIndex);
- if (VideoStreamIndex < 0) then
- begin
- Log.LogError('No video stream found', 'TVideoPlayback_ffmpeg.Open');
- Close();
- Exit;
- end;
-
- VideoStream := VideoFormatContext^.streams[VideoStreamIndex];
- VideoCodecContext := VideoStream^.codec;
-
- VideoCodec := avcodec_find_decoder(VideoCodecContext^.codec_id);
- if (VideoCodec = nil) then
- begin
- Log.LogError('No matching codec found', 'TVideoPlayback_ffmpeg.Open');
- Close();
- Exit;
- end;
-
- // set debug options
- VideoCodecContext^.debug_mv := 0;
- VideoCodecContext^.debug := 0;
-
- // detect bug-workarounds automatically
- VideoCodecContext^.workaround_bugs := FF_BUG_AUTODETECT;
- // error resilience strategy (careful/compliant/agressive/very_aggressive)
- //VideoCodecContext^.error_resilience := FF_ER_CAREFUL; //FF_ER_COMPLIANT;
- // allow non spec compliant speedup tricks.
- //VideoCodecContext^.flags2 := VideoCodecContext^.flags2 or CODEC_FLAG2_FAST;
-
- // Note: avcodec_open() and avcodec_close() are not thread-safe and will
- // fail if called concurrently by different threads.
- FFmpegCore.LockAVCodec();
- try
- errnum := avcodec_open(VideoCodecContext, VideoCodec);
- finally
- FFmpegCore.UnlockAVCodec();
- end;
- if (errnum < 0) then
- begin
- Log.LogError('No matching codec found', 'TVideoPlayback_ffmpeg.Open');
- Close();
- Exit;
- end;
-
- // register custom callbacks for pts-determination
- VideoCodecContext^.get_buffer := PtsGetBuffer;
- VideoCodecContext^.release_buffer := PtsReleaseBuffer;
-
- {$ifdef DebugDisplay}
- DebugWriteln('Found a matching Codec: '+ VideoCodecContext^.Codec.Name + sLineBreak +
- sLineBreak +
- ' Width = '+inttostr(VideoCodecContext^.width) +
- ', Height='+inttostr(VideoCodecContext^.height) + sLineBreak +
- ' Aspect : '+inttostr(VideoCodecContext^.sample_aspect_ratio.num) + '/' +
- inttostr(VideoCodecContext^.sample_aspect_ratio.den) + sLineBreak +
- ' Framerate : '+inttostr(VideoCodecContext^.time_base.num) + '/' +
- inttostr(VideoCodecContext^.time_base.den));
- {$endif}
-
- // allocate space for decoded frame and rgb frame
- AVFrame := avcodec_alloc_frame();
- AVFrameRGB := avcodec_alloc_frame();
- FrameBuffer := av_malloc(avpicture_get_size(PIXEL_FMT_FFMPEG,
- VideoCodecContext^.width, VideoCodecContext^.height));
-
- if ((AVFrame = nil) or (AVFrameRGB = nil) or (FrameBuffer = nil)) then
- begin
- Log.LogError('Failed to allocate buffers', 'TVideoPlayback_ffmpeg.Open');
- Close();
- Exit;
- end;
-
- // TODO: pad data for OpenGL to GL_UNPACK_ALIGNMENT
- // (otherwise video will be distorted if width/height is not a multiple of the alignment)
- errnum := avpicture_fill(PAVPicture(AVFrameRGB), FrameBuffer, PIXEL_FMT_FFMPEG,
- VideoCodecContext^.width, VideoCodecContext^.height);
- if (errnum < 0) then
- begin
- Log.LogError('avpicture_fill failed: ' + FFmpegCore.GetErrorString(errnum), 'TVideoPlayback_ffmpeg.Open');
- Close();
- Exit;
- end;
-
- // calculate some information for video display
- VideoAspect := av_q2d(VideoCodecContext^.sample_aspect_ratio);
- if (VideoAspect = 0) then
- VideoAspect := VideoCodecContext^.width /
- VideoCodecContext^.height
- else
- VideoAspect := VideoAspect * VideoCodecContext^.width /
- VideoCodecContext^.height;
-
- VideoTimeBase := 1/av_q2d(VideoStream^.r_frame_rate);
-
- // hack to get reasonable timebase (for divx and others)
- if (VideoTimeBase < 0.02) then // 0.02 <-> 50 fps
- begin
- VideoTimeBase := av_q2d(VideoStream^.r_frame_rate);
- while (VideoTimeBase > 50) do
- VideoTimeBase := VideoTimeBase/10;
- VideoTimeBase := 1/VideoTimeBase;
- end;
-
- Log.LogInfo('VideoTimeBase: ' + floattostr(VideoTimeBase), 'TVideoPlayback_ffmpeg.Open');
- Log.LogInfo('Framerate: '+inttostr(floor(1/VideoTimeBase))+'fps', 'TVideoPlayback_ffmpeg.Open');
-
- {$IFDEF UseSWScale}
- // if available get a SWScale-context -> faster than the deprecated img_convert().
- // SWScale has accelerated support for PIX_FMT_RGB32/PIX_FMT_BGR24/PIX_FMT_BGR565/PIX_FMT_BGR555.
- // Note: PIX_FMT_RGB32 is a BGR- and not an RGB-format (maybe a bug)!!!
- // The BGR565-formats (GL_UNSIGNED_SHORT_5_6_5) is way too slow because of its
- // bad OpenGL support. The BGR formats have MMX(2) implementations but no speed-up
- // could be observed in comparison to the RGB versions.
- SoftwareScaleContext := sws_getContext(
- VideoCodecContext^.width, VideoCodecContext^.height,
- integer(VideoCodecContext^.pix_fmt),
- VideoCodecContext^.width, VideoCodecContext^.height,
- integer(PIXEL_FMT_FFMPEG),
- SWS_FAST_BILINEAR, nil, nil, nil);
- if (SoftwareScaleContext = nil) then
- begin
- Log.LogError('Failed to get swscale context', 'TVideoPlayback_ffmpeg.Open');
- Close();
- Exit;
- end;
- {$ENDIF}
-
- TexWidth := Round(Power(2, Ceil(Log2(VideoCodecContext^.width))));
- TexHeight := Round(Power(2, Ceil(Log2(VideoCodecContext^.height))));
-
- // we retrieve a texture just once with glTexImage2D and update it with glTexSubImage2D later.
- // Benefits: glTexSubImage2D is faster and supports non-power-of-two widths/height.
- glBindTexture(GL_TEXTURE_2D, fVideoTex);
- glTexEnvi(GL_TEXTURE_2D, GL_TEXTURE_ENV_MODE, GL_REPLACE);
- glTexImage2D(GL_TEXTURE_2D, 0, 3, TexWidth, TexHeight, 0,
- PIXEL_FMT_OPENGL, GL_UNSIGNED_BYTE, nil);
- glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);
- glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
-
-
- fVideoOpened := True;
-
- Result := true;
-end;
-
-procedure TVideoPlayback_FFmpeg.Close;
-begin
- if (FrameBuffer <> nil) then
- av_free(FrameBuffer);
- if (AVFrameRGB <> nil) then
- av_free(AVFrameRGB);
- if (AVFrame <> nil) then
- av_free(AVFrame);
-
- AVFrame := nil;
- AVFrameRGB := nil;
- FrameBuffer := nil;
-
- if (VideoCodecContext <> nil) then
- begin
- // avcodec_close() is not thread-safe
- FFmpegCore.LockAVCodec();
- try
- avcodec_close(VideoCodecContext);
- finally
- FFmpegCore.UnlockAVCodec();
- end;
- end;
-
- if (VideoFormatContext <> nil) then
- av_close_input_file(VideoFormatContext);
-
- VideoCodecContext := nil;
- VideoFormatContext := nil;
-
- fVideoOpened := False;
-end;
-
-procedure TVideoPlayback_FFmpeg.SynchronizeVideo(Frame: PAVFrame; var pts: double);
-var
- FrameDelay: double;
-begin
- if (pts <> 0) then
- begin
- // if we have pts, set video clock to it
- VideoTime := pts;
- end else
- begin
- // if we aren't given a pts, set it to the clock
- pts := VideoTime;
- end;
- // update the video clock
- FrameDelay := av_q2d(VideoCodecContext^.time_base);
- // if we are repeating a frame, adjust clock accordingly
- FrameDelay := FrameDelay + Frame^.repeat_pict * (FrameDelay * 0.5);
- VideoTime := VideoTime + FrameDelay;
-end;
-
-function TVideoPlayback_FFmpeg.DecodeFrame(var AVPacket: TAVPacket; out pts: double): boolean;
-var
- FrameFinished: Integer;
- VideoPktPts: int64;
- pbIOCtx: PByteIOContext;
- errnum: integer;
-begin
- Result := false;
- FrameFinished := 0;
-
- if EOF then
- Exit;
-
- // read packets until we have a finished frame (or there are no more packets)
- while (FrameFinished = 0) do
- begin
- errnum := av_read_frame(VideoFormatContext, AVPacket);
- if (errnum < 0) then
- begin
- // failed to read a frame, check reason
-
- {$IF (LIBAVFORMAT_VERSION_MAJOR >= 52)}
- pbIOCtx := VideoFormatContext^.pb;
- {$ELSE}
- pbIOCtx := @VideoFormatContext^.pb;
- {$IFEND}
-
- // check for end-of-file (eof is not an error)
- if (url_feof(pbIOCtx) <> 0) then
- begin
- EOF := true;
- Exit;
- end;
-
- // check for errors
- if (url_ferror(pbIOCtx) <> 0) then
- Exit;
-
- // url_feof() does not detect an EOF for some mov-files (e.g. deluxe.mov)
- // so we have to do it this way.
- if ((VideoFormatContext^.file_size <> 0) and
- (pbIOCtx^.pos >= VideoFormatContext^.file_size)) then
- begin
- EOF := true;
- Exit;
- end;
-
- // no error -> wait for user input
- SDL_Delay(100);
- continue;
- end;
-
- // if we got a packet from the video stream, then decode it
- if (AVPacket.stream_index = VideoStreamIndex) then
- begin
- // save pts to be stored in pFrame in first call of PtsGetBuffer()
- VideoPktPts := AVPacket.pts;
- VideoCodecContext^.opaque := @VideoPktPts;
-
- // decode packet
- avcodec_decode_video(VideoCodecContext, AVFrame,
- frameFinished, AVPacket.data, AVPacket.size);
-
- // reset opaque data
- VideoCodecContext^.opaque := nil;
-
- // update pts
- if (AVPacket.dts <> AV_NOPTS_VALUE) then
- begin
- pts := AVPacket.dts;
- end
- else if ((AVFrame^.opaque <> nil) and
- (Pint64(AVFrame^.opaque)^ <> AV_NOPTS_VALUE)) then
- begin
- pts := Pint64(AVFrame^.opaque)^;
- end
- else
- begin
- pts := 0;
- end;
- pts := pts * av_q2d(VideoStream^.time_base);
-
- // synchronize on each complete frame
- if (frameFinished <> 0) then
- SynchronizeVideo(AVFrame, pts);
- end;
-
- // free the packet from av_read_frame
- av_free_packet( @AVPacket );
- end;
-
- Result := true;
-end;
-
-procedure TVideoPlayback_FFmpeg.GetFrame(Time: Extended);
-var
- AVPacket: TAVPacket;
- errnum: Integer;
- myTime: Extended;
- TimeDifference: Extended;
- DropFrameCount: Integer;
- pts: double;
- i: Integer;
-const
- FRAME_DROPCOUNT = 3;
-begin
- if not fVideoOpened then
- Exit;
-
- if fVideoPaused then
- Exit;
-
- // current time, relative to last loop (if any)
- myTime := Time - fLoopTime;
- // time since the last frame was returned
- TimeDifference := myTime - VideoTime;
-
- {$IFDEF DebugDisplay}
- DebugWriteln('Time: '+inttostr(floor(Time*1000)) + sLineBreak +
- 'VideoTime: '+inttostr(floor(VideoTime*1000)) + sLineBreak +
- 'TimeBase: '+inttostr(floor(VideoTimeBase*1000)) + sLineBreak +
- 'TimeDiff: '+inttostr(floor(TimeDifference*1000)));
- {$endif}
-
- // check if a new frame is needed
- if (VideoTime <> 0) and (TimeDifference < VideoTimeBase) then
- begin
- {$ifdef DebugFrames}
- // frame delay debug display
- GoldenRec.Spawn(200,15,1,16,0,-1,ColoredStar,$00ff00);
- {$endif}
-
- {$IFDEF DebugDisplay}
- DebugWriteln('not getting new frame' + sLineBreak +
- 'Time: '+inttostr(floor(Time*1000)) + sLineBreak +
- 'VideoTime: '+inttostr(floor(VideoTime*1000)) + sLineBreak +
- 'TimeBase: '+inttostr(floor(VideoTimeBase*1000)) + sLineBreak +
- 'TimeDiff: '+inttostr(floor(TimeDifference*1000)));
- {$endif}
-
- // we do not need a new frame now
- Exit;
- end;
-
- // update video-time to the next frame
- VideoTime := VideoTime + VideoTimeBase;
- TimeDifference := myTime - VideoTime;
-
- // check if we have to skip frames
- if (TimeDifference >= FRAME_DROPCOUNT*VideoTimeBase) then
- begin
- {$IFDEF DebugFrames}
- //frame drop debug display
- GoldenRec.Spawn(200,55,1,16,0,-1,ColoredStar,$ff0000);
- {$ENDIF}
- {$IFDEF DebugDisplay}
- DebugWriteln('skipping frames' + sLineBreak +
- 'TimeBase: '+inttostr(floor(VideoTimeBase*1000)) + sLineBreak +
- 'TimeDiff: '+inttostr(floor(TimeDifference*1000)));
- {$endif}
-
- // update video-time
- DropFrameCount := Trunc(TimeDifference / VideoTimeBase);
- VideoTime := VideoTime + DropFrameCount*VideoTimeBase;
-
- // skip half of the frames, this is much smoother than to skip all at once
- for i := 1 to DropFrameCount (*div 2*) do
- DecodeFrame(AVPacket, pts);
- end;
-
- {$IFDEF VideoBenchmark}
- Log.BenchmarkStart(15);
- {$ENDIF}
-
- if (not DecodeFrame(AVPacket, pts)) then
- begin
- if Loop then
- begin
- // Record the time we looped. This is used to keep the loops in time. otherwise they speed
- SetPosition(0);
- fLoopTime := Time;
- end;
- Exit;
- end;
-
- // TODO: support for pan&scan
- //if (AVFrame.pan_scan <> nil) then
- //begin
- // Writeln(Format('PanScan: %d/%d', [AVFrame.pan_scan.width, AVFrame.pan_scan.height]));
- //end;
-
- // otherwise we convert the pixeldata from YUV to RGB
- {$IFDEF UseSWScale}
- errnum := sws_scale(SoftwareScaleContext, @(AVFrame.data), @(AVFrame.linesize),
- 0, VideoCodecContext^.Height,
- @(AVFrameRGB.data), @(AVFrameRGB.linesize));
- {$ELSE}
- errnum := img_convert(PAVPicture(AVFrameRGB), PIXEL_FMT_FFMPEG,
- PAVPicture(AVFrame), VideoCodecContext^.pix_fmt,
- VideoCodecContext^.width, VideoCodecContext^.height);
- {$ENDIF}
-
- if (errnum < 0) then
- begin
- Log.LogError('Image conversion failed', 'TVideoPlayback_ffmpeg.GetFrame');
- Exit;
- end;
-
- {$IFDEF VideoBenchmark}
- Log.BenchmarkEnd(15);
- Log.BenchmarkStart(16);
- {$ENDIF}
-
- // TODO: data is not padded, so we will need to tell OpenGL.
- // Or should we add padding with avpicture_fill? (check which one is faster)
- //glPixelStorei(GL_UNPACK_ALIGNMENT, 1);
-
- glBindTexture(GL_TEXTURE_2D, fVideoTex);
- glTexSubImage2D(GL_TEXTURE_2D, 0, 0, 0,
- VideoCodecContext^.width, VideoCodecContext^.height,
- PIXEL_FMT_OPENGL, GL_UNSIGNED_BYTE, AVFrameRGB^.data[0]);
-
- {$ifdef DebugFrames}
- //frame decode debug display
- GoldenRec.Spawn(200, 35, 1, 16, 0, -1, ColoredStar, $ffff00);
- {$endif}
-
- {$IFDEF VideoBenchmark}
- Log.BenchmarkEnd(16);
- Log.LogBenchmark('FFmpeg', 15);
- Log.LogBenchmark('Texture', 16);
- {$ENDIF}
-end;
-
-procedure TVideoPlayback_FFmpeg.DrawGL(Screen: integer);
-var
- TexVideoRightPos, TexVideoLowerPos: Single;
- ScreenLeftPos, ScreenRightPos: Single;
- ScreenUpperPos, ScreenLowerPos: Single;
- ScaledVideoWidth, ScaledVideoHeight: Single;
- ScreenMidPosX, ScreenMidPosY: Single;
- ScreenAspect: Single;
-begin
- // have a nice black background to draw on (even if there were errors opening the vid)
- if (Screen = 1) then
- begin
- glClearColor(0, 0, 0, 0);
- glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
- end;
-
- // exit if there's nothing to draw
- if (not fVideoOpened) then
- Exit;
-
- {$IFDEF VideoBenchmark}
- Log.BenchmarkStart(15);
- {$ENDIF}
-
- // TODO: add a SetAspectCorrectionMode() function so we can switch
- // aspect correction. The screens video backgrounds look very ugly with aspect
- // correction because of the white bars at the top and bottom.
-
- ScreenAspect := ScreenW / ScreenH;
- ScaledVideoWidth := RenderW;
- ScaledVideoHeight := RenderH * ScreenAspect/VideoAspect;
-
- // Note: Scaling the width does not look good because the video might contain
- // black borders at the top already
- //ScaledVideoHeight := RenderH;
- //ScaledVideoWidth := RenderW * VideoAspect/ScreenAspect;
-
- // center the video
- ScreenMidPosX := RenderW/2;
- ScreenMidPosY := RenderH/2;
- ScreenLeftPos := ScreenMidPosX - ScaledVideoWidth/2;
- ScreenRightPos := ScreenMidPosX + ScaledVideoWidth/2;
- ScreenUpperPos := ScreenMidPosY - ScaledVideoHeight/2;
- ScreenLowerPos := ScreenMidPosY + ScaledVideoHeight/2;
- // the video-texture contains empty borders because its width and height must be
- // a power of 2. So we have to determine the texture coords of the video.
- TexVideoRightPos := VideoCodecContext^.width / TexWidth;
- TexVideoLowerPos := VideoCodecContext^.height / TexHeight;
-
- // we could use blending for brightness control, but do we need this?
- glDisable(GL_BLEND);
-
- // TODO: disable other stuff like lightning, etc.
-
- glEnable(GL_TEXTURE_2D);
- glBindTexture(GL_TEXTURE_2D, fVideoTex);
- glColor3f(1, 1, 1);
- glBegin(GL_QUADS);
- // upper-left coord
- glTexCoord2f(0, 0);
- glVertex2f(ScreenLeftPos, ScreenUpperPos);
- // lower-left coord
- glTexCoord2f(0, TexVideoLowerPos);
- glVertex2f(ScreenLeftPos, ScreenLowerPos);
- // lower-right coord
- glTexCoord2f(TexVideoRightPos, TexVideoLowerPos);
- glVertex2f(ScreenRightPos, ScreenLowerPos);
- // upper-right coord
- glTexCoord2f(TexVideoRightPos, 0);
- glVertex2f(ScreenRightPos, ScreenUpperPos);
- glEnd;
- glDisable(GL_TEXTURE_2D);
-
- {$IFDEF VideoBenchmark}
- Log.BenchmarkEnd(15);
- Log.LogBenchmark('DrawGL', 15);
- {$ENDIF}
-
- {$IFDEF Info}
- if (fVideoSkipTime+VideoTime+VideoTimeBase < 0) then
- begin
- glColor4f(0.7, 1, 0.3, 1);
- SetFontStyle (1);
- SetFontItalic(False);
- SetFontSize(9);
- SetFontPos (300, 0);
- glPrint('Delay due to negative VideoGap');
- glColor4f(1, 1, 1, 1);
- end;
- {$ENDIF}
-
- {$IFDEF DebugFrames}
- glColor4f(0, 0, 0, 0.2);
- glbegin(GL_QUADS);
- glVertex2f(0, 0);
- glVertex2f(0, 70);
- glVertex2f(250, 70);
- glVertex2f(250, 0);
- glEnd;
-
- glColor4f(1, 1, 1, 1);
- SetFontStyle (1);
- SetFontItalic(False);
- SetFontSize(9);
- SetFontPos (5, 0);
- glPrint('delaying frame');
- SetFontPos (5, 20);
- glPrint('fetching frame');
- SetFontPos (5, 40);
- glPrint('dropping frame');
- {$ENDIF}
-end;
-
-procedure TVideoPlayback_FFmpeg.Play;
-begin
-end;
-
-procedure TVideoPlayback_FFmpeg.Pause;
-begin
- fVideoPaused := not fVideoPaused;
-end;
-
-procedure TVideoPlayback_FFmpeg.Stop;
-begin
-end;
-
-procedure TVideoPlayback_FFmpeg.SetPosition(Time: real);
-var
- SeekFlags: integer;
-begin
- if not fVideoOpened then
- Exit;
-
- if (Time < 0) then
- Time := 0;
-
- // TODO: handle loop-times
- //Time := Time mod VideoDuration;
-
- // backward seeking might fail without AVSEEK_FLAG_BACKWARD
- SeekFlags := AVSEEK_FLAG_ANY;
- if (Time < VideoTime) then
- SeekFlags := SeekFlags or AVSEEK_FLAG_BACKWARD;
-
- VideoTime := Time;
- EOF := false;
-
- if (av_seek_frame(VideoFormatContext, VideoStreamIndex, Floor(Time/VideoTimeBase), SeekFlags) < 0) then
- begin
- Log.LogError('av_seek_frame() failed', 'TVideoPlayback_ffmpeg.SetPosition');
- Exit;
- end;
-
- avcodec_flush_buffers(VideoCodecContext);
-end;
-
-function TVideoPlayback_FFmpeg.GetPosition: real;
-begin
- // TODO: return video-position in seconds
- Result := VideoTime;
-end;
-
-initialization
- MediaManager.Add(TVideoPlayback_FFmpeg.Create);
-
-end.
diff --git a/src/classes/UVisualizer.pas b/src/classes/UVisualizer.pas
deleted file mode 100644
index e2125201..00000000
--- a/src/classes/UVisualizer.pas
+++ /dev/null
@@ -1,442 +0,0 @@
-unit UVisualizer;
-
-(* TODO:
- * - fix video/visualizer switching
- * - use GL_EXT_framebuffer_object for rendering to a separate framebuffer,
- * this will prevent plugins from messing up our render-context
- * (-> no stack corruption anymore, no need for Save/RestoreOpenGLState()).
- * - create a generic (C-compatible) interface for visualization plugins
- * - create a visualization plugin manager
- * - write a plugin for projectM in C/C++ (so we need no wrapper anymore)
- *)
-
-{* Note:
- * It would be easier to create a seperate Render-Context (RC) for projectM
- * and switch to it when necessary. This can be achieved by pbuffers
- * (slow and platform specific) or the OpenGL FramebufferObject (FBO) extension
- * (fast and plattform-independent but not supported by older graphic-cards/drivers).
- *
- * See http://oss.sgi.com/projects/ogl-sample/registry/EXT/framebuffer_object.txt
- *
- * To support as many cards as possible we will stick to the current dirty
- * solution for now even if it is a pain to save/restore projectM's state due
- * to bugs etc.
- *
- * This also restricts us to projectM. As other plug-ins might have different
- * needs and bugs concerning the OpenGL state, USDX's state would probably be
- * corrupted after the plug-in finshed drawing.
- *}
-
-interface
-
-{$IFDEF FPC}
- {$MODE DELPHI}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses
- SDL,
- UGraphicClasses,
- textgl,
- math,
- gl,
- SysUtils,
- UIni,
- projectM,
- UMusic;
-
-implementation
-
-uses
- UGraphic,
- UMain,
- UConfig,
- ULog;
-
-{$IF PROJECTM_VERSION < 1000000} // < 1.0
-// Initialization data used on projectM 0.9x creation.
-// Since projectM 1.0 this data is passed via the config-file.
-const
- meshX = 32;
- meshY = 24;
- fps = 30;
- textureSize = 512;
-{$IFEND}
-
-type
- TVideoPlayback_ProjectM = class( TInterfacedObject, IVideoPlayback, IVideoVisualization )
- private
- pm: TProjectM;
- ProjectMPath : string;
- Initialized: boolean;
-
- VisualizerStarted: boolean;
- VisualizerPaused: boolean;
-
- VisualTex: GLuint;
- PCMData: TPCMData;
- RndPCMcount: integer;
-
- projMatrix: array[0..3, 0..3] of GLdouble;
- texMatrix: array[0..3, 0..3] of GLdouble;
-
- procedure VisualizerStart;
- procedure VisualizerStop;
-
- procedure VisualizerTogglePause;
-
- function GetRandomPCMData(var data: TPCMData): Cardinal;
-
- procedure SaveOpenGLState();
- procedure RestoreOpenGLState();
-
- public
- function GetName: String;
-
- function Init(): boolean;
- function Finalize(): boolean;
-
- function Open(const aFileName : string): boolean; // true if succeed
- procedure Close;
-
- procedure Play;
- procedure Pause;
- procedure Stop;
-
- procedure SetPosition(Time: real);
- function GetPosition: real;
-
- procedure GetFrame(Time: Extended);
- procedure DrawGL(Screen: integer);
- end;
-
-
-function TVideoPlayback_ProjectM.GetName: String;
-begin
- Result := 'ProjectM';
-end;
-
-function TVideoPlayback_ProjectM.Init(): boolean;
-begin
- Result := true;
-
- if (Initialized) then
- Exit;
- Initialized := true;
-
- RndPCMcount := 0;
-
- ProjectMPath := ProjectM_DataDir + PathDelim;
-
- VisualizerStarted := False;
- VisualizerPaused := False;
-
- {$IFDEF UseTexture}
- glGenTextures(1, PglUint(@VisualTex));
- glBindTexture(GL_TEXTURE_2D, VisualTex);
-
- glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
- glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);
- {$ENDIF}
-end;
-
-function TVideoPlayback_ProjectM.Finalize(): boolean;
-begin
- VisualizerStop();
- {$IFDEF UseTexture}
- glDeleteTextures(1, PglUint(@VisualTex));
- {$ENDIF}
- Result := true;
-end;
-
-function TVideoPlayback_ProjectM.Open(const aFileName : string): boolean; // true if succeed
-begin
- Result := false;
-end;
-
-procedure TVideoPlayback_ProjectM.Close;
-begin
- VisualizerStop();
-end;
-
-procedure TVideoPlayback_ProjectM.Play;
-begin
- VisualizerStart();
-end;
-
-procedure TVideoPlayback_ProjectM.Pause;
-begin
- VisualizerTogglePause();
-end;
-
-procedure TVideoPlayback_ProjectM.Stop;
-begin
- VisualizerStop();
-end;
-
-procedure TVideoPlayback_ProjectM.SetPosition(Time: real);
-begin
- if assigned(pm) then
- pm.RandomPreset();
-end;
-
-function TVideoPlayback_ProjectM.GetPosition: real;
-begin
- Result := 0;
-end;
-
-{**
- * Saves the current OpenGL state.
- * This is necessary to prevent projectM from corrupting USDX's current
- * OpenGL state.
- *
- * The following steps are performed:
- * - All attributes are pushed to the attribute-stack
- * - Projection-/Texture-matrices are saved
- * - Modelview-matrix is pushed to the Modelview-stack
- * - the OpenGL error-state (glGetError) is cleared
- *}
-procedure TVideoPlayback_ProjectM.SaveOpenGLState();
-begin
- // save all OpenGL state-machine attributes
- glPushAttrib(GL_ALL_ATTRIB_BITS);
-
- // Note: we do not use glPushMatrix() for the GL_PROJECTION and GL_TEXTURE stacks.
- // OpenGL specifies the depth of those stacks to be at least 2 but projectM
- // already uses 2 stack-entries so overflows might be possible on older hardware.
- // In contrast to this the GL_MODELVIEW stack-size is at least 32, so we can
- // use glPushMatrix() for this stack.
-
- // save projection-matrix
- glMatrixMode(GL_PROJECTION);
- glGetDoublev(GL_PROJECTION_MATRIX, @projMatrix);
- {$IF PROJECTM_VERSION = 1000000} // 1.0, 1.01
- // bugfix: projection-matrix is popped without being pushed first
- glPushMatrix();
- {$IFEND}
-
- // save texture-matrix
- glMatrixMode(GL_TEXTURE);
- glGetDoublev(GL_TEXTURE_MATRIX, @texMatrix);
-
- // save modelview-matrix
- glMatrixMode(GL_MODELVIEW);
- glPushMatrix();
- {$IF PROJECTM_VERSION = 1000000} // 1.0, 1.01
- // bugfix: modelview-matrix is popped without being pushed first
- glPushMatrix();
- {$IFEND}
-
- // reset OpenGL error-state
- glGetError();
-end;
-
-{**
- * Restores the OpenGL state saved by SaveOpenGLState()
- * and resets the error-state.
- *}
-procedure TVideoPlayback_ProjectM.RestoreOpenGLState();
-begin
- // reset OpenGL error-state
- glGetError();
-
- // restore projection-matrix
- glMatrixMode(GL_PROJECTION);
- glLoadMatrixd(@projMatrix);
-
- // restore texture-matrix
- glMatrixMode(GL_TEXTURE);
- glLoadMatrixd(@texMatrix);
-
- // restore modelview-matrix
- glMatrixMode(GL_MODELVIEW);
- glPopMatrix();
-
- // restore all OpenGL state-machine attributes
- glPopAttrib();
-end;
-
-procedure TVideoPlayback_ProjectM.VisualizerStart;
-begin
- if VisualizerStarted then
- Exit;
-
- // the OpenGL state must be saved before
- SaveOpenGLState();
- try
-
- try
- {$IF PROJECTM_VERSION >= 1000000} // >= 1.0
- pm := TProjectM.Create(ProjectMPath + 'config.inp');
- {$ELSE}
- pm := TProjectM.Create(
- meshX, meshY, fps, textureSize, ScreenW, ScreenH,
- ProjectMPath + 'presets', ProjectMPath + 'fonts');
- {$IFEND}
- except on E: Exception do
- begin
- // Create() might fail if the config-file is not found
- Log.LogError('TProjectM.Create: ' + E.Message, 'TVideoPlayback_ProjectM.VisualizerStart');
- Exit;
- end;
- end;
-
- // initialize OpenGL
- pm.ResetGL(ScreenW, ScreenH);
- // skip projectM default-preset
- pm.RandomPreset();
- // projectM >= 1.0 uses the OpenGL FramebufferObject (FBO) extension.
- // Unfortunately it does NOT reset the framebuffer-context after
- // TProjectM.Create. Either glBindFramebufferEXT(GL_FRAMEBUFFER_EXT, 0) for
- // a manual reset or TProjectM.RenderFrame() must be called.
- // We use the latter so we do not need to load the FBO extension in USDX.
- pm.RenderFrame();
-
- VisualizerStarted := True;
- finally
- RestoreOpenGLState();
- end;
-end;
-
-procedure TVideoPlayback_ProjectM.VisualizerStop;
-begin
- if VisualizerStarted then
- begin
- VisualizerStarted := False;
- FreeAndNil(pm);
- end;
-end;
-
-procedure TVideoPlayback_ProjectM.VisualizerTogglePause;
-begin
- VisualizerPaused := not VisualizerPaused;
-end;
-
-procedure TVideoPlayback_ProjectM.GetFrame(Time: Extended);
-var
- nSamples: cardinal;
- stackDepth: Integer;
-begin
- if not VisualizerStarted then
- Exit;
-
- if VisualizerPaused then
- Exit;
-
- // get audio data
- nSamples := AudioPlayback.GetPCMData(PcmData);
-
- // generate some data if non is available
- if (nSamples = 0) then
- nSamples := GetRandomPCMData(PcmData);
-
- // send audio-data to projectM
- if (nSamples > 0) then
- pm.AddPCM16Data(PSmallInt(@PcmData), nSamples);
-
- // store OpenGL state (might be messed up otherwise)
- SaveOpenGLState();
- try
- // setup projectM's OpenGL state
- pm.ResetGL(ScreenW, ScreenH);
-
- // let projectM render a frame
- pm.RenderFrame();
-
- {$IFDEF UseTexture}
- glBindTexture(GL_TEXTURE_2D, VisualTex);
- glFlush();
- glCopyTexImage2D(GL_TEXTURE_2D, 0, GL_RGB, 0, 0, VisualWidth, VisualHeight, 0);
- {$ENDIF}
- finally
- // restore USDX OpenGL state
- RestoreOpenGLState();
- end;
-
- // discard projectM's depth buffer information (avoid overlay)
- glClear(GL_DEPTH_BUFFER_BIT);
-end;
-
-{**
- * Draws the current frame to screen.
- * TODO: this is not used yet. Data is directly drawn on GetFrame().
- *}
-procedure TVideoPlayback_ProjectM.DrawGL(Screen: integer);
-begin
- {$IFDEF UseTexture}
- // have a nice black background to draw on
- if (Screen = 1) then
- begin
- glClearColor(0, 0, 0, 0);
- glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
- end;
-
- // exit if there's nothing to draw
- if not VisualizerStarted then
- Exit;
-
- // setup display
- glMatrixMode(GL_PROJECTION);
- glPushMatrix();
- glLoadIdentity();
- gluOrtho2D(0, 1, 0, 1);
- glMatrixMode(GL_MODELVIEW);
- glPushMatrix();
- glLoadIdentity();
-
- glEnable(GL_BLEND);
- glEnable(GL_TEXTURE_2D);
- glTexEnvf(GL_TEXTURE_ENV, GL_TEXTURE_ENV_MODE, GL_REPLACE);
- glBindTexture(GL_TEXTURE_2D, VisualTex);
- glColor4f(1, 1, 1, 1);
-
- // draw projectM frame
- glBegin(GL_QUADS);
- glTexCoord2f(0, 0); glVertex2f(0, 0);
- glTexCoord2f(1, 0); glVertex2f(1, 0);
- glTexCoord2f(1, 1); glVertex2f(1, 1);
- glTexCoord2f(0, 1); glVertex2f(0, 1);
- glEnd();
-
- glDisable(GL_TEXTURE_2D);
- glDisable(GL_BLEND);
-
- // restore state
- glMatrixMode(GL_PROJECTION);
- glPopMatrix();
- glMatrixMode(GL_MODELVIEW);
- glPopMatrix();
- {$ENDIF}
-end;
-
-{**
- * Produces random "sound"-data in case no audio-data is available.
- * Otherwise the visualization will look rather boring.
- *}
-function TVideoPlayback_ProjectM.GetRandomPCMData(var data: TPCMData): Cardinal;
-var
- i: integer;
-begin
- // Produce some fake PCM data
- if (RndPCMcount mod 500 = 0) then
- begin
- FillChar(data, SizeOf(TPCMData), 0);
- end
- else
- begin
- for i := 0 to 511 do
- begin
- data[i][0] := Random(High(Word)+1);
- data[i][1] := Random(High(Word)+1);
- end;
- end;
- Inc(RndPCMcount);
- Result := 512;
-end;
-
-
-initialization
- MediaManager.Add(TVideoPlayback_ProjectM.Create);
-
-end.
diff --git a/src/classes/UXMLSong.pas b/src/classes/UXMLSong.pas
deleted file mode 100644
index 1a1fe6bc..00000000
--- a/src/classes/UXMLSong.pas
+++ /dev/null
@@ -1,573 +0,0 @@
-unit UXMLSong;
-
-interface
-uses Classes;
-
-type
- TNote = record
- Start: Cardinal;
- Duration: Cardinal;
- Tone: Integer;
- NoteTyp: Byte;
- Lyric: String;
- end;
- ANote = Array of TNote;
-
- TSentence = record
- Singer: Byte;
- Duration: Cardinal;
- Notes: ANote;
- end;
- ASentence = Array of TSentence;
-
- TSongInfo = Record
- ID: Cardinal;
- DualChannel: Boolean;
- Header: Record
- Artist: String;
- Title: String;
- Gap: Cardinal;
- BPM: Real;
- Resolution: Byte;
- Edition: String;
- Genre: String;
- Year: String;
- Language: String;
- end;
- CountSentences: Cardinal;
- Sentences: ASentence;
- end;
-
- TParser = class
- private
- SSFile: TStringList;
-
- ParserState: Byte;
- CurPosinSong: Cardinal; //Cur Beat Pos in the Song
- CurDuettSinger: Byte; //Who sings this Part?
- BindLyrics: Boolean; //Should the Lyrics be bind to the last Word (no Space)
- FirstNote: Boolean; //Is this the First Note found? For Gap calculating
-
- Function ParseLine(Line: String): Boolean;
- public
- SongInfo: TSongInfo;
- ErrorMessage: String;
- Edition: String;
- SingstarVersion: String;
-
- Settings: Record
- DashReplacement: Char;
- end;
-
- Constructor Create;
-
- Function ParseConfigforEdition(const Filename: String): String;
-
- Function ParseSongHeader(const Filename: String): Boolean; //Parse Song Header only
- Function ParseSong (const Filename: String): Boolean; //Parse whole Song
- end;
-
-const
- PS_None = 0;
- PS_Melody = 1;
- PS_Sentence = 2;
-
- NT_Normal = 1;
- NT_Freestyle = 0;
- NT_Golden = 2;
-
- DS_Player1 = 1;
- DS_Player2 = 2;
- DS_Both = 3;
-
-implementation
-uses SysUtils, StrUtils;
-
-Constructor TParser.Create;
-begin
- inherited Create;
- ErrorMessage := '';
-
- DecimalSeparator := '.';
-end;
-
-Function TParser.ParseSong (const Filename: String): Boolean;
-var I: Integer;
-begin
- Result := False;
- if FileExists(Filename) then
- begin
- SSFile := TStringList.Create;
-
- try
- ErrorMessage := 'Can''t open melody.xml file';
- SSFile.LoadFromFile(Filename);
- ErrorMessage := '';
- Result := True;
- I := 0;
-
- SongInfo.CountSentences := 0;
- CurDuettSinger := DS_Both; //Both is Singstar Standard
- CurPosinSong := 0; //Start at Pos 0
- BindLyrics := True; //Dont start with Space
- FirstNote := True; //First Note found should be the First Note ;)
-
- SongInfo.Header.Language := '';
- SongInfo.Header.Edition := Edition;
- SongInfo.DualChannel := False;
-
- ParserState := PS_None;
-
- SetLength(SongInfo.Sentences, 0);
-
- While Result And (I < SSFile.Count) do
- begin
- Result := ParseLine(SSFile.Strings[I]);
-
- Inc(I);
- end;
-
- finally
- SSFile.Free;
- end;
- end;
-end;
-
-Function TParser.ParseSongHeader (const Filename: String): Boolean;
-var I: Integer;
-begin
- Result := False;
- if FileExists(Filename) then
- begin
- SSFile := TStringList.Create;
- SSFile.Clear;
-
- try
- SSFile.LoadFromFile(Filename);
-
- If (SSFile.Count > 0) then
- begin
- Result := True;
- I := 0;
-
- SongInfo.CountSentences := 0;
- CurDuettSinger := DS_Both; //Both is Singstar Standard
- CurPosinSong := 0; //Start at Pos 0
- BindLyrics := True; //Dont start with Space
- FirstNote := True; //First Note found should be the First Note ;)
-
- SongInfo.ID := 0;
- SongInfo.Header.Language := '';
- SongInfo.Header.Edition := Edition;
- SongInfo.DualChannel := False;
- ParserState := PS_None;
-
- While (SongInfo.ID < 4) AND Result And (I < SSFile.Count) do
- begin
- Result := ParseLine(SSFile.Strings[I]);
-
- Inc(I);
- end;
- end
- else
- ErrorMessage := 'Can''t open melody.xml file';
-
- finally
- SSFile.Free;
- end;
- end
- else
- ErrorMessage := 'Can''t find melody.xml file';
-end;
-
-Function TParser.ParseLine(Line: String): Boolean;
-var
- Tag: String;
- Values: String;
- AValues: Array of Record
- Name: String;
- Value: String;
- end;
- I, J, K: Integer;
- Duration, Tone: Integer;
- Lyric: String;
- NoteType: Byte;
-
- Procedure MakeValuesArray;
- var Len, Pos, State, StateChange: Integer;
- begin
- Len := -1;
- SetLength(AValues, Len + 1);
-
- Pos := 1;
- State := 0;
- While (Pos <= Length(Values)) AND (Pos <> 0) do
- begin
- Case State of
-
- 0: begin //Search for ValueName
- If (Values[Pos] <> ' ') AND (Values[Pos] <> '=') then
- begin
- //Found Something
- State := 1; //State search for '='
- StateChange := Pos; //Save Pos of Change
- Pos := PosEx('=', Values, Pos + 1);
- end
- else Inc(Pos); //When nothing found then go to next char
- end;
-
- 1: begin //Search for Equal Mark
- //Add New Value
- Inc(Len);
- SetLength(AValues, Len + 1);
-
- AValues[Len].Name := UpperCase(Copy(Values, StateChange, Pos - StateChange));
-
-
- State := 2; //Now Search for starting '"'
- StateChange := Pos; //Save Pos of Change
- Pos := PosEx('"', Values, Pos + 1);
- end;
-
- 2: begin //Search for starting '"' or ' ' <- End if there was no "
- If (Values[Pos] = '"') then
- begin //Found starting '"'
- State := 3; //Now Search for ending '"'
- StateChange := Pos; //Save Pos of Change
- Pos := PosEx('"', Values, Pos + 1);
- end
- else If (Values[Pos] = ' ') then //Found ending Space
- begin
- //Save Value to Array
- AValues[Len].Value := Copy(Values, StateChange + 1, Pos - StateChange - 1);
-
- //Search for next Valuename
- State := 0;
- StateChange := Pos;
- Inc(Pos);
- end;
- end;
-
- 3: begin //Search for ending '"'
- //Save Value to Array
- AValues[Len].Value := Copy(Values, StateChange + 1, Pos - StateChange - 1);
-
- //Search for next Valuename
- State := 0;
- StateChange := Pos;
- Inc(Pos);
- end;
- end;
-
- If (State >= 2) then
- begin //Save Last Value
- AValues[Len].Value := Copy(Values, StateChange + 1, Length(Values) - StateChange);
- end;
- end;
- end;
-begin
- Result := True;
-
- Line := Trim(Line);
- If (Length(Line) > 0) then
- begin
- I := Pos('<', Line);
- J := PosEx(' ', Line, I+1);
- K := PosEx('>', Line, I+1);
-
- If (J = 0) then J := K
- Else If (K < J) AND (K <> 0) then J := K; //Use nearest Tagname End indicator
- Tag := UpperCase(copy(Line, I + 1, J - I - 1));
- Values := copy(Line, J + 1, K - J - 1);
-
- Case ParserState of
- PS_None: begin//Search for Melody Tag
- If (Tag = 'MELODY') then
- begin
- Inc(SongInfo.ID); //Inc SongID when header Information is added
- MakeValuesArray;
- For I := 0 to High(AValues) do
- begin
- If (AValues[I].Name = 'TEMPO') then
- begin
- SongInfo.Header.BPM := StrtoFloatDef(AValues[I].Value, 0);
- If (SongInfo.Header.BPM <= 0) then
- begin
- Result := False;
- ErrorMessage := 'Can''t read BPM from Song';
- end;
- end
-
- Else If (AValues[I].Name = 'RESOLUTION') then
- begin
- AValues[I].Value := Uppercase(AValues[I].Value);
- //Ultrastar Resolution is "how often a Beat is split / 4"
- If (AValues[I].Value = 'HEMIDEMISEMIQUAVER') then
- SongInfo.Header.Resolution := 64 div 4
- Else If (AValues[I].Value = 'DEMISEMIQUAVER') then
- SongInfo.Header.Resolution := 32 div 4
- Else If (AValues[I].Value = 'SEMIQUAVER') then
- SongInfo.Header.Resolution := 16 div 4
- Else If (AValues[I].Value = 'QUAVER') then
- SongInfo.Header.Resolution := 8 div 4
- Else If (AValues[I].Value = 'CROTCHET') then
- SongInfo.Header.Resolution := 4 div 4
- Else
- begin //Can't understand teh Resolution :/
- Result := False;
- ErrorMessage := 'Can''t read Resolution from Song';
- end;
- end
-
- Else If (AValues[I].Name = 'GENRE') then
- begin
- SongInfo.Header.Genre := AValues[I].Value;
- end
-
- Else If (AValues[I].Name = 'YEAR') then
- begin
- SongInfo.Header.Year := AValues[I].Value;
- end
-
- Else If (AValues[I].Name = 'VERSION') then
- begin
- SingstarVersion := AValues[I].Value;
- end;
- end;
-
- ParserState := PS_Melody; //In Melody Tag
- end;
- end;
-
-
- PS_Melody: begin //Search for Sentence, Artist/Title Info or eo Melody
- If (Tag = 'SENTENCE') then
- begin
- ParserState := PS_Sentence; //Parse in a Sentence Tag now
-
- //Increase SentenceCount
- Inc(SongInfo.CountSentences);
-
- BindLyrics := True; //Don't let Txts Begin w/ Space
-
- //Search for Duett Singer Info
- MakeValuesArray;
- For I := 0 to High(AValues) do
- If (AValues[I].Name = 'SINGER') then
- begin
- AValues[I].Value := Uppercase(AValues[I].Value);
- If (AValues[I].Value = 'SOLO 1') then
- CurDuettSinger := DS_Player1
- Else If (AValues[I].Value = 'SOLO 2') then
- CurDuettSinger := DS_Player2
- Else
- CurDuettSinger := DS_Both; //In case of "Group" or anything that is not identified use Both
- end;
- end
-
- Else If (Tag = '!--') then
- begin //Comment, this may be Artist or Title Info
- I := Pos(':', Values); //Search for Delimiter
-
- If (I <> 0) then //If Found check for Title or Artist
- begin
- //Copy Title or Artist Tag to Tag String
- Tag := Uppercase(Trim(Copy(Values, 1, I - 1)));
-
- If (Tag = 'ARTIST') then
- begin
- SongInfo.Header.Artist := Trim(Copy(Values, I + 1, Length(Values) - I - 2));
- Inc(SongInfo.ID); //Inc SongID when header Information is added
- end
- Else If (Tag = 'TITLE') then
- begin
- SongInfo.Header.Title := Trim(Copy(Values, I + 1, Length(Values) - I - 2));
- Inc(SongInfo.ID); //Inc SongID when header Information is added
- end;
- end;
- end
-
- //Parsing for weird "Die toten Hosen" Tags
- Else If (Tag = '!--ARTIST:') OR (Tag = '!--ARTIST') then
- begin //Comment, with Artist Info
- I := Pos(':', Values); //Search for Delimiter
-
- Inc(SongInfo.ID); //Inc SongID when header Information is added
-
- SongInfo.Header.Artist := Trim(Copy(Values, I + 1, Length(Values) - I - 2));
- end
-
- Else If (Tag = '!--TITLE:') OR (Tag = '!--TITLE') then
- begin //Comment, with Artist Info
- I := Pos(':', Values); //Search for Delimiter
-
- Inc(SongInfo.ID); //Inc SongID when header Information is added
-
- SongInfo.Header.Title := Trim(Copy(Values, I + 1, Length(Values) - I - 2));
- end
-
- Else If (Tag = '/MELODY') then
- begin
- ParserState := PS_None;
- Exit; //Stop Parsing, Melody iTag ended
- end
- end;
-
-
- PS_Sentence: begin //Search for Notes or eo Sentence
- If (Tag = 'NOTE') then
- begin //Found Note
- //Get Values
- MakeValuesArray;
-
- NoteType := NT_Normal;
- For I := 0 to High(AValues) do
- begin
- If (AValues[I].Name = 'DURATION') then
- begin
- Duration := StrtoIntDef(AValues[I].Value, -1);
- If (Duration < 0) then
- begin
- Result := False;
- ErrorMessage := 'Can''t read duration from Note in Line: "' + Line + '"';
- Exit;
- end;
- end
- Else If (AValues[I].Name = 'MIDINOTE') then
- begin
- Tone := StrtoIntDef(AValues[I].Value, 0);
- end
- Else If (AValues[I].Name = 'BONUS') AND (Uppercase(AValues[I].Value) = 'YES') then
- begin
- NoteType := NT_Golden;
- end
- Else If (AValues[I].Name = 'FREESTYLE') AND (Uppercase(AValues[I].Value) = 'YES') then
- begin
- NoteType := NT_Freestyle;
- end
- Else If (AValues[I].Name = 'LYRIC') then
- begin
- Lyric := AValues[I].Value;
-
- If (Length(Lyric) > 0) then
- begin
- If (Lyric = '-') then
- Lyric[1] := Settings.DashReplacement;
-
- If (not BindLyrics) then
- Lyric := ' ' + Lyric;
-
-
- If (Length(Lyric) > 2) AND (Lyric[Length(Lyric)-1] = ' ') AND (Lyric[Length(Lyric)] = '-') then
- begin //Between this and the next Lyric should be no space
- BindLyrics := True;
- SetLength(Lyric, Length(Lyric) - 2);
- end
- else
- BindLyrics := False; //There should be a Space
- end;
- end;
- end;
-
- //Add Note
- I := SongInfo.CountSentences - 1;
-
- If (Length(Lyric) > 0) then
- begin //Real note, no rest
- //First Note of Sentence
- If (Length(SongInfo.Sentences) < SongInfo.CountSentences) then
- begin
- SetLength(SongInfo.Sentences, SongInfo.CountSentences);
- SetLength(SongInfo.Sentences[I].Notes, 0);
- end;
-
- //First Note of Song -> Generate Gap
- If (FirstNote) then
- begin
- //Calculate Gap
- If (SongInfo.Header.Resolution <> 0) AND (SongInfo.Header.BPM <> 0) then
- SongInfo.Header.Gap := Round(CurPosinSong / (SongInfo.Header.BPM*SongInfo.Header.Resolution) * 60000)
- Else
- begin
- Result := False;
- ErrorMessage := 'Can''t calculate Gap, no Resolution or BPM present.';
- Exit;
- end;
-
- CurPosinSong := 0; //Start at 0, because Gap goes until here
- Inc(SongInfo.ID); //Add Header Value therefore Inc
- FirstNote := False;
- end;
-
- J := Length(SongInfo.Sentences[I].Notes);
- SetLength(SongInfo.Sentences[I].Notes, J + 1);
- SongInfo.Sentences[I].Notes[J].Start := CurPosinSong;
- SongInfo.Sentences[I].Notes[J].Duration := Duration;
- SongInfo.Sentences[I].Notes[J].Tone := Tone;
- SongInfo.Sentences[I].Notes[J].NoteTyp := NoteType;
- SongInfo.Sentences[I].Notes[J].Lyric := Lyric;
-
- //Inc Pos in Song
- Inc(CurPosInSong, Duration);
- end
- else
- begin
- //just change pos in Song
- Inc(CurPosInSong, Duration);
- end;
-
-
- end
- Else If (Tag = '/SENTENCE') then
- begin //End of Sentence Tag
- ParserState := PS_Melody;
-
- //Delete Sentence if no Note is Added
- If (Length(SongInfo.Sentences) <> SongInfo.CountSentences) then
- begin
- SongInfo.CountSentences := Length(SongInfo.Sentences);
- end;
- end;
- end;
- end;
-
- end
- else //Empty Line -> parsed succesful ;)
- Result := true;
-end;
-
-Function TParser.ParseConfigforEdition(const Filename: String): String;
-var
- txt: TStringlist;
- I: Integer;
- J, K: Integer;
- S: String;
-begin
- Result := '';
- txt := TStringlist.Create;
- try
- txt.LoadFromFile(Filename);
-
- For I := 0 to txt.Count-1 do
- begin
- S := Trim(txt.Strings[I]);
- J := Pos('<PRODUCT_NAME>', S);
-
- If (J <> 0) then
- begin
- Inc(J, 14);
- K := Pos('</PRODUCT_NAME>', S);
- If (K<J) then K := Length(S) + 1;
-
- Result := Copy(S, J, K - J);
- Break;
- end;
- end;
-
- Edition := Result;
- finally
- txt.Free;
- end;
-end;
-
-end.
diff --git a/src/classes/uPluginLoader.pas b/src/classes/uPluginLoader.pas
deleted file mode 100644
index b2142702..00000000
--- a/src/classes/uPluginLoader.pas
+++ /dev/null
@@ -1,775 +0,0 @@
-unit UPluginLoader;
-{*********************
- UPluginLoader
- Unit contains to Classes
- TPluginLoader: Class Searching for and Loading the Plugins
- TtehPlugins: Class that represents the Plugins in Modules chain
-*********************}
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses
- UPluginDefs,
- UCoreModule;
-
-type
- TPluginListItem = record
- Info: TUS_PluginInfo;
- State: Byte; //State of this Plugin: 0 - undefined; 1 - Loaded; 2 - Inited / Running; 4 - Unloaded; 254 - Loading aborted by Plugin; 255 - Unloaded because of Error
- Path: String; //Path to this Plugin
- NeedsDeInit: Boolean; //If this is Inited correctly this should be true
- hLib: THandle; //Handle of Loaded Libary
- Procs: record //Procs offered by Plugin. Don't call this directly use wrappers of TPluginLoader
- Load: Func_Load;
- Init: Func_Init;
- DeInit: Proc_DeInit;
- end;
- end;
- {*********************
- TPluginLoader
- Class Searches for Plugins and Manages loading and unloading
- *********************}
- PPluginLoader = ^TPluginLoader;
- TPluginLoader = class (TCoreModule)
- private
- LoadingProcessFinished: Boolean;
- sUnloadPlugin: THandle;
- sLoadPlugin: THandle;
- sGetPluginInfo: THandle;
- sGetPluginState: THandle;
-
- procedure FreePlugin(Index: Cardinal);
- public
- PluginInterface: TUS_PluginInterface;
- Plugins: array of TPluginListItem;
-
- //TCoreModule methods to inherit
- constructor Create; override;
- procedure Info(const pInfo: PModuleInfo); override;
- function Load: Boolean; override;
- function Init: Boolean; override;
- procedure DeInit; override;
- Destructor Destroy; override;
-
- //New Methods
- procedure BrowseDir(Path: String); //Browses the Path at _Path_ for Plugins
- function PluginExists(Name: String): integer; //If Plugin Exists: Index of Plugin, else -1
- procedure AddPlugin(Filename: String);//Adds Plugin to the Array
-
- function CallLoad(Index: Cardinal): integer;
- function CallInit(Index: Cardinal): integer;
- procedure CallDeInit(Index: Cardinal);
-
- //Services offered
- function LoadPlugin(wParam: TwParam; lParam: TlParam): integer; //wParam PChar(PluginName/PluginPath) | lParam (if wParam = nil) ID of the Plugin
- function UnloadPlugin(wParam: TwParam; lParam: TlParam): integer; //wParam PChar(PluginName/PluginPath) | lParam (if wParam = nil) ID of the Plugin
- function GetPluginInfo(wParam: TwParam; lParam: TlParam): integer; //If wParam = -1 then (If lParam = nil then get length of Moduleinfo Array. If lparam <> nil then write array of TUS_PluginInfo to address at lparam) else (Get PluginInfo of Plugin with Index(wParam) to Address at lParam)
- function GetPluginState(wParam: TwParam; lParam: TlParam): integer; //If wParam = -1 then (If lParam = nil then get length of Moduleinfo Array. If lparam <> nil then write array of TUS_PluginInfo to address at lparam) else (Return PluginInfo of Plugin with Index(wParam))
-
- end;
-
- {*********************
- TtehPlugins
- Class Represents the Plugins in Module Chain.
- It Calls the Plugins Procs and Funcs
- *********************}
- TtehPlugins = class (TCoreModule)
- private
- PluginLoader: PPluginLoader;
- public
- //TCoreModule methods to inherit
- constructor Create; override;
-
- procedure Info(const pInfo: PModuleInfo); override;
- function Load: Boolean; override;
- function Init: Boolean; override;
- procedure DeInit; override;
- end;
-
-const
- {$IFDEF MSWINDOWS}
- PluginFileExtension = '.dll';
- {$ENDIF}
- {$IFDEF LINUX}
- PluginFileExtension = '.so';
- {$ENDIF}
- {$IFDEF DARWIN}
- PluginFileExtension = '.dylib';
- {$ENDIF}
-
-implementation
-
-uses
- UCore,
- UPluginInterface,
-{$IFDEF MSWINDOWS}
- windows,
-{$ELSE}
- dynlibs,
-{$ENDIF}
- UMain,
- SysUtils;
-
-{*********************
- TPluginLoader
- Implentation
-*********************}
-
-//-------------
-// function that gives some Infos about the Module to the Core
-//-------------
-procedure TPluginLoader.Info(const pInfo: PModuleInfo);
-begin
- pInfo^.Name := 'TPluginLoader';
- pInfo^.Version := MakeVersion(1,0,0,chr(0));
- pInfo^.Description := 'Searches for Plugins, loads and unloads them';
-end;
-
-//-------------
-// Just the Constructor
-//-------------
-constructor TPluginLoader.Create;
-begin
- inherited;
-
- //Init PluginInterface
- //Using Methods from UPluginInterface
- PluginInterface.CreateHookableEvent := CreateHookableEvent;
- PluginInterface.DestroyHookableEvent := DestroyHookableEvent;
- PluginInterface.NotivyEventHooks := NotivyEventHooks;
- PluginInterface.HookEvent := HookEvent;
- PluginInterface.UnHookEvent := UnHookEvent;
- PluginInterface.EventExists := EventExists;
-
- PluginInterface.CreateService := @CreateService;
- PluginInterface.DestroyService := DestroyService;
- PluginInterface.CallService := CallService;
- PluginInterface.ServiceExists := ServiceExists;
-
- //UnSet Private Var
- LoadingProcessFinished := False;
-end;
-
-//-------------
-//Is Called on Loading.
-//In this Method only Events and Services should be created
-//to offer them to other Modules or Plugins during the Init process
-//If False is Returned this will cause a Forced Exit
-//-------------
-function TPluginLoader.Load: Boolean;
-begin
- Result := True;
-
- try
- //Start Searching for Plugins
- BrowseDir(PluginPath);
- except
- Result := False;
- Core.ReportError(integer(PChar('Error Browsing and Loading.')), PChar('TPluginLoader'));
- end;
-end;
-
-//-------------
-//Is Called on Init Process
-//In this Method you can Hook some Events and Create + Init
-//your Classes, Variables etc.
-//If False is Returned this will cause a Forced Exit
-//-------------
-function TPluginLoader.Init: Boolean;
-begin
- //Just set Prvate Var to true.
- LoadingProcessFinished := True;
- Result := True;
-end;
-
-//-------------
-//Is Called if this Module has been Inited and there is a Exit.
-//Deinit is in backwards Initing Order
-//-------------
-procedure TPluginLoader.DeInit;
-var
- I: integer;
-begin
- //Force DeInit
- //If some Plugins aren't DeInited for some Reason o0
- for I := 0 to High(Plugins) do
- begin
- if (Plugins[I].State < 4) then
- FreePlugin(I);
- end;
-
- //Nothing to do here. Core will remove the Hooks
-end;
-
-//-------------
-//Is Called if this Module will be unloaded and has been created
-//Should be used to Free Memory
-//-------------
-Destructor TPluginLoader.Destroy;
-begin
- //Just save some Memory if it wasn't done now..
- SetLength(Plugins, 0);
- inherited;
-end;
-
-//--------------
-// Browses the Path at _Path_ for Plugins
-//--------------
-procedure TPluginLoader.BrowseDir(Path: String);
-var
- SR: TSearchRec;
-begin
- //Search for other Dirs to Browse
- if FindFirst(Path + '*', faDirectory, SR) = 0 then begin
- repeat
- if (SR.Name <> '.') and (SR.Name <> '..') then
- BrowseDir(Path + Sr.Name + PathDelim);
- until FindNext(SR) <> 0;
- end;
- FindClose(SR);
-
- //Search for Plugins at Path
- if FindFirst(Path + '*' + PluginFileExtension, 0, SR) = 0 then
- begin
- repeat
- AddPlugin(Path + SR.Name);
- until FindNext(SR) <> 0;
- end;
- FindClose(SR);
-end;
-
-//--------------
-// If Plugin Exists: Index of Plugin, else -1
-//--------------
-function TPluginLoader.PluginExists(Name: String): integer;
-var
- I: integer;
-begin
- Result := -1;
-
- if (Length(Name) <= 32 { =>Length(TUS_PluginInfo.Name)}) then
- begin
- for I := 0 to High(Plugins) do
- if (Plugins[I].Info.Name = Name) then
- begin //Found the Plugin
- Result := I;
- Break;
- end;
- end;
-end;
-
-//--------------
-// Adds Plugin to the Array
-//--------------
-procedure TPluginLoader.AddPlugin(Filename: String);
-var
- hLib: THandle;
- PInfo: Proc_PluginInfo;
- Info: TUS_PluginInfo;
- PluginID: integer;
-begin
- if (FileExists(Filename)) then
- begin //Load Libary
- hLib := LoadLibrary(PChar(Filename));
- if (hLib <> 0) then
- begin //Try to get Address of the Info Proc
- PInfo := GetProcAddress (hLib, PChar('USPlugin_Info'));
- if (@PInfo <> nil) then
- begin
- Info.cbSize := SizeOf(TUS_PluginInfo);
-
- try //Call Info Proc
- PInfo(@Info);
- except
- Info.Name := '';
- Core.ReportError(integer(PChar('Error getting Plugin Info: ' + Filename)), PChar('TPluginLoader'));
- end;
-
- //Is Name set ?
- if (Trim(Info.Name) <> '') then
- begin
- PluginID := PluginExists(Info.Name);
-
- if (PluginID > 0) and (Plugins[PluginID].State >=4) then
- PluginID := -1;
-
- if (PluginID = -1) then
- begin
- //Add new item to array
- PluginID := Length(Plugins);
- SetLength(Plugins, PluginID + 1);
-
- //Fill with Info:
- Plugins[PluginID].Info := Info;
- Plugins[PluginID].State := 0;
- Plugins[PluginID].Path := Filename;
- Plugins[PluginID].NeedsDeInit := False;
- Plugins[PluginID].hLib := hLib;
-
- //Try to get Procs
- Plugins[PluginID].Procs.Load := GetProcAddress (hLib, PChar('USPlugin_Load'));
- Plugins[PluginID].Procs.Init := GetProcAddress (hLib, PChar('USPlugin_Init'));
- Plugins[PluginID].Procs.DeInit := GetProcAddress (hLib, PChar('USPlugin_DeInit'));
-
- if (@Plugins[PluginID].Procs.Load = nil) OR (@Plugins[PluginID].Procs.Init = nil) OR (@Plugins[PluginID].Procs.DeInit = nil) then
- begin
- Plugins[PluginID].State := 255;
- FreeLibrary(hLib);
- Core.ReportError(integer(PChar('Can''t get Plugin Procs from Libary: "' + Info.Name + '" ' + Filename)), PChar('TPluginLoader'));
- end;
-
- //Emulate loading process if this Plugin is loaded to late
- if (LoadingProcessFinished) then
- begin
- CallLoad(PluginID);
- CallInit(PluginID);
- end;
- end
- else if (LoadingProcessFinished = False) then
- begin
- if (Plugins[PluginID].Info.Version < Info.Version) then
- begin //Found newer Version of this Plugin
- Core.ReportDebug(integer(PChar('Found a newer Version of Plugin: ' + String(Info.Name))), PChar('TPluginLoader'));
-
- //Unload Old Plugin
- UnloadPlugin(PluginID, nil);
-
- //Fill with new Info
- Plugins[PluginID].Info := Info;
- Plugins[PluginID].State := 0;
- Plugins[PluginID].Path := Filename;
- Plugins[PluginID].NeedsDeInit := False;
- Plugins[PluginID].hLib := hLib;
-
- //Try to get Procs
- Plugins[PluginID].Procs.Load := GetProcAddress (hLib, PChar('USPlugin_Load'));
- Plugins[PluginID].Procs.Init := GetProcAddress (hLib, PChar('USPlugin_Init'));
- Plugins[PluginID].Procs.DeInit := GetProcAddress (hLib, PChar('USPlugin_DeInit'));
-
- if (@Plugins[PluginID].Procs.Load = nil) OR (@Plugins[PluginID].Procs.Init = nil) OR (@Plugins[PluginID].Procs.DeInit = nil) then
- begin
- FreeLibrary(hLib);
- Plugins[PluginID].State := 255;
- Core.ReportError(integer(PChar('Can''t get Plugin Procs from Libary: "' + Info.Name + '" ' + Filename)), PChar('TPluginLoader'));
- end;
- end
- else
- begin //Newer Version already loaded
- FreeLibrary(hLib);
- end;
- end
- else
- begin
- FreeLibrary(hLib);
- Core.ReportError(integer(PChar('Plugin with this Name already exists: ' + String(Info.Name))), PChar('TPluginLoader'));
- end;
- end
- else
- begin
- FreeLibrary(hLib);
- Core.ReportError(integer(PChar('No name reported: ' + Filename)), PChar('TPluginLoader'));
- end;
- end
- else
- begin
- FreeLibrary(hLib);
- Core.ReportError(integer(PChar('Can''t find Info procedure: ' + Filename)), PChar('TPluginLoader'));
- end;
- end
- else
- Core.ReportError(integer(PChar('Can''t load Plugin Libary: ' + Filename)), PChar('TPluginLoader'));
- end;
-end;
-
-//--------------
-// Calls Load Func of Plugin with the given Index
-//--------------
-function TPluginLoader.CallLoad(Index: Cardinal): integer;
-begin
- Result := -2;
- if(Index < Length(Plugins)) then
- begin
- if (@Plugins[Index].Procs.Load <> nil) and (Plugins[Index].State = 0) then
- begin
- try
- Result := Plugins[Index].Procs.Load(@PluginInterface);
- except
- Result := -3;
- End;
-
- if (Result = 0) then
- Plugins[Index].State := 1
- else
- begin
- FreePlugin(Index);
- Plugins[Index].State := 255;
- Core.ReportError(integer(PChar('Error calling Load function from Plugin: ' + String(Plugins[Index].Info.Name))), PChar('TPluginLoader'));
- end;
- end;
- end;
-end;
-
-//--------------
-// Calls Init Func of Plugin with the given Index
-//--------------
-function TPluginLoader.CallInit(Index: Cardinal): integer;
-begin
- Result := -2;
- if(Index < Length(Plugins)) then
- begin
- if (@Plugins[Index].Procs.Init <> nil) and (Plugins[Index].State = 1) then
- begin
- try
- Result := Plugins[Index].Procs.Init(@PluginInterface);
- except
- Result := -3;
- End;
-
- if (Result = 0) then
- begin
- Plugins[Index].State := 2;
- Plugins[Index].NeedsDeInit := True;
- end
- else
- begin
- FreePlugin(Index);
- Plugins[Index].State := 255;
- Core.ReportError(integer(PChar('Error calling Init function from Plugin: ' + String(Plugins[Index].Info.Name))), PChar('TPluginLoader'));
- end;
- end;
- end;
-end;
-
-//--------------
-// Calls DeInit Proc of Plugin with the given Index
-//--------------
-procedure TPluginLoader.CallDeInit(Index: Cardinal);
-begin
- if(Index < Length(Plugins)) then
- begin
- if (Plugins[Index].State < 4) then
- begin
- if (@Plugins[Index].Procs.DeInit <> nil) and (Plugins[Index].NeedsDeInit) then
- try
- Plugins[Index].Procs.DeInit(@PluginInterface);
- except
-
- End;
-
- //Don't forget to remove Services and Subscriptions by this Plugin
- Core.Hooks.DelbyOwner(-1 - Index);
-
- FreePlugin(Index);
- end;
- end;
-end;
-
-//--------------
-// Frees all Plugin Sources (Procs and Handles) - Helper for Deiniting Functions
-//--------------
-procedure TPluginLoader.FreePlugin(Index: Cardinal);
-begin
- Plugins[Index].State := 4;
- Plugins[Index].Procs.Load := nil;
- Plugins[Index].Procs.Init := nil;
- Plugins[Index].Procs.DeInit := nil;
-
- if (Plugins[Index].hLib <> 0) then
- FreeLibrary(Plugins[Index].hLib);
-end;
-
-
-
-//--------------
-// wParam PChar(PluginName/PluginPath) | wParam (if lParam = nil) ID of the Plugin
-//--------------
-function TPluginLoader.LoadPlugin(wParam: TwParam; lParam: TlParam): integer;
-var
- Index: integer;
- sFile: String;
-begin
- Result := -1;
- sFile := '';
- //lParam is ID
- if (lParam = nil) then
- begin
- Index := wParam;
- end
- else
- begin //lParam is PChar
- try
- sFile := String(PChar(lParam));
- Index := PluginExists(sFile);
- if (Index < 0) And FileExists(sFile) then
- begin //Is Filename
- AddPlugin(sFile);
- Result := Plugins[High(Plugins)].State;
- end;
- except
- Index := -2;
- end;
- end;
-
-
- if (Index >= 0) and (Index < Length(Plugins)) then
- begin
- AddPlugin(Plugins[Index].Path);
- Result := Plugins[Index].State;
- end;
-end;
-
-//--------------
-// wParam PChar(PluginName/PluginPath) | wParam (if lParam = nil) ID of the Plugin
-//--------------
-function TPluginLoader.UnloadPlugin(wParam: TwParam; lParam: TlParam): integer;
-var
- Index: integer;
- sName: String;
-begin
- Result := -1;
- //lParam is ID
- if (lParam = nil) then
- begin
- Index := wParam;
- end
- else
- begin //wParam is PChar
- try
- sName := String(PChar(lParam));
- Index := PluginExists(sName);
- except
- Index := -2;
- end;
- end;
-
-
- if (Index >= 0) and (Index < Length(Plugins)) then
- CallDeInit(Index)
-end;
-
-//--------------
-// if wParam = -1 then (if lParam = nil then get length of Moduleinfo Array. if lparam <> nil then write array of TUS_PluginInfo to address at lparam) else (Get PluginInfo of Plugin with Index(wParam) to Address at lParam)
-//--------------
-function TPluginLoader.GetPluginInfo(wParam: TwParam; lParam: TlParam): integer;
-var I: integer;
-begin
- Result := 0;
- if (wParam > 0) then
- begin //Get Info of 1 Plugin
- if (lParam <> nil) and (wParam < Length(Plugins)) then
- begin
- try
- Result := 1;
- PUS_PluginInfo(lParam)^ := Plugins[wParam].Info;
- except
-
- End;
- end;
- end
- else if (lParam = nil) then
- begin //Get Length of Plugin (Info) Array
- Result := Length(Plugins);
- end
- else //Write PluginInfo Array to Address in lParam
- begin
- try
- for I := 0 to high(Plugins) do
- PAUS_PluginInfo(lParam)^[I] := Plugins[I].Info;
- Result := Length(Plugins);
- except
- Core.ReportError(integer(PChar('Could not write PluginInfo Array')), PChar('TPluginLoader'));
- End;
- end;
-
-end;
-
-//--------------
-// if wParam = -1 then (if lParam = nil then get length of Plugin State Array. if lparam <> nil then write array of Byte to address at lparam) else (Return State of Plugin with Index(wParam))
-//--------------
-function TPluginLoader.GetPluginState(wParam: TwParam; lParam: TlParam): integer;
-var I: integer;
-begin
- Result := -1;
- if (wParam > 0) then
- begin //Get State of 1 Plugin
- if (wParam < Length(Plugins)) then
- begin
- Result := Plugins[wParam].State;
- end;
- end
- else if (lParam = nil) then
- begin //Get Length of Plugin (Info) Array
- Result := Length(Plugins);
- end
- else //Write PluginInfo Array to Address in lParam
- begin
- try
- for I := 0 to high(Plugins) do
- Byte(Pointer(integer(lParam) + I)^) := Plugins[I].State;
- Result := Length(Plugins);
- except
- Core.ReportError(integer(PChar('Could not write PluginState Array')), PChar('TPluginLoader'));
- End;
- end;
-end;
-
-
-{*********************
- TtehPlugins
- Implentation
-*********************}
-
-//-------------
-// function that gives some Infos about the Module to the Core
-//-------------
-procedure TtehPlugins.Info(const pInfo: PModuleInfo);
-begin
- pInfo^.Name := 'TtehPlugins';
- pInfo^.Version := MakeVersion(1,0,0,chr(0));
- pInfo^.Description := 'Module executing the Plugins!';
-end;
-
-//-------------
-// Just the Constructor
-//-------------
-constructor TtehPlugins.Create;
-begin
- inherited;
- PluginLoader := nil;
-end;
-
-//-------------
-//Is Called on Loading.
-//In this Method only Events and Services should be created
-//to offer them to other Modules or Plugins during the Init process
-//If False is Returned this will cause a Forced Exit
-//-------------
-function TtehPlugins.Load: Boolean;
-var
- i: integer; //Counter
- CurExecutedBackup: integer; //backup of Core.CurExecuted Attribute
-begin
- //Get Pointer to PluginLoader
- PluginLoader := PPluginLoader(Core.GetModulebyName('TPluginLoader'));
- if (PluginLoader = nil) then
- begin
- Result := false;
- Core.ReportError(integer(PChar('Could not get Pointer to PluginLoader')), PChar('TtehPlugins'));
- end
- else
- begin
- Result := true;
-
- //Backup CurExecuted
- CurExecutedBackup := Core.CurExecuted;
-
- //Start Loading the Plugins
- for i := 0 to High(PluginLoader.Plugins) do
- begin
- Core.CurExecuted := -1 - i;
-
- try
- //Unload Plugin if not correctly Executed
- if (PluginLoader.CallLoad(i) <> 0) then
- begin
- PluginLoader.CallDeInit(i);
- PluginLoader.Plugins[i].State := 254; //Plugin asks for unload
- Core.ReportDebug(integer(PChar('Plugin Selfabort during loading process: ' + String(PluginLoader.Plugins[i].Info.Name))), PChar('TtehPlugins'));
- end
- else
- begin
- Core.ReportDebug(integer(PChar('Plugin loaded succesful: ' + String(PluginLoader.Plugins[i].Info.Name))), PChar('TtehPlugins'));
- end;
- except
- //Plugin could not be loaded.
- // => Show Error Message, then ShutDown Plugin
- on E: Exception do
- begin
- PluginLoader.CallDeInit(i);
- PluginLoader.Plugins[i].State := 255; //Plugin causes Error
- Core.ReportError(integer(PChar('Plugin causes Error during loading process: ' + PluginLoader.Plugins[i].Info.Name + ', ErrorMsg: "' + E.Message + '"')), PChar('TtehPlugins'));
- end;
- end;
- end;
-
- //Reset CurExecuted
- Core.CurExecuted := CurExecutedBackup;
- end;
-end;
-
-//-------------
-//Is Called on Init Process
-//In this Method you can Hook some Events and Create + Init
-//your Classes, Variables etc.
-//If False is Returned this will cause a Forced Exit
-//-------------
-function TtehPlugins.Init: Boolean;
-var
- i: integer; //Counter
- CurExecutedBackup: integer; //backup of Core.CurExecuted Attribute
-begin
- Result := true;
-
- //Backup CurExecuted
- CurExecutedBackup := Core.CurExecuted;
-
- //Start Loading the Plugins
- for i := 0 to High(PluginLoader.Plugins) do
- try
- Core.CurExecuted := -1 - i;
-
- //Unload Plugin if not correctly Executed
- if (PluginLoader.CallInit(i) <> 0) then
- begin
- PluginLoader.CallDeInit(i);
- PluginLoader.Plugins[i].State := 254; //Plugin asks for unload
- Core.ReportDebug(integer(PChar('Plugin Selfabort during init process: ' + String(PluginLoader.Plugins[i].Info.Name))), PChar('TtehPlugins'));
- end
- else
- Core.ReportDebug(integer(PChar('Plugin inited succesful: ' + String(PluginLoader.Plugins[i].Info.Name))), PChar('TtehPlugins'));
- except
- //Plugin could not be loaded.
- // => Show Error Message, then ShutDown Plugin
- PluginLoader.CallDeInit(i);
- PluginLoader.Plugins[i].State := 255; //Plugin causes Error
- Core.ReportError(integer(PChar('Plugin causes Error during init process: ' + String(PluginLoader.Plugins[i].Info.Name))), PChar('TtehPlugins'));
- end;
-
- //Reset CurExecuted
- Core.CurExecuted := CurExecutedBackup;
-end;
-
-//-------------
-//Is Called if this Module has been Inited and there is a Exit.
-//Deinit is in backwards Initing Order
-//-------------
-procedure TtehPlugins.DeInit;
-var
- i: integer; //Counter
- CurExecutedBackup: integer; //backup of Core.CurExecuted Attribute
-begin
- //Backup CurExecuted
- CurExecutedBackup := Core.CurExecuted;
-
- //Start Loop
-
- for i := 0 to High(PluginLoader.Plugins) do
- begin
- try
- //DeInit Plugin
- PluginLoader.CallDeInit(i);
- except
- end;
- end;
-
- //Reset CurExecuted
- Core.CurExecuted := CurExecutedBackup;
-end;
-
-end.
diff --git a/src/ultrastardx.dpr b/src/ultrastardx.dpr
index d9d380ab..3cb32279 100644
--- a/src/ultrastardx.dpr
+++ b/src/ultrastardx.dpr
@@ -48,18 +48,18 @@ uses
sdl_image in 'lib\JEDI-SDL\SDL_Image\Pas\sdl_image.pas',
//sdl_ttf in 'lib\JEDI-SDL\SDL_ttf\Pas\sdl_ttf.pas',
sdlutils in 'lib\JEDI-SDL\SDL\Pas\sdlutils.pas',
- UMediaCore_SDL in 'classes\UMediaCore_SDL.pas',
+ UMediaCore_SDL in 'base\UMediaCore_SDL.pas',
zlib in 'lib\zlib\zlib.pas',
png in 'lib\libpng\png.pas',
{$IFDEF UseBass}
bass in 'lib\bass\delphi\bass.pas',
- UAudioCore_Bass in 'classes\UAudioCore_Bass.pas',
+ UAudioCore_Bass in 'base\UAudioCore_Bass.pas',
{$ENDIF}
{$IFDEF UsePortaudio}
portaudio in 'lib\portaudio\portaudio.pas',
- UAudioCore_Portaudio in 'classes\UAudioCore_Portaudio.pas',
+ UAudioCore_Portaudio in 'base\UAudioCore_Portaudio.pas',
{$ENDIF}
{$IFDEF UsePortmixer}
portmixer in 'lib\portmixer\portmixer.pas',
@@ -73,7 +73,7 @@ uses
opt in 'lib\ffmpeg\opt.pas',
avio in 'lib\ffmpeg\avio.pas',
mathematics in 'lib\ffmpeg\mathematics.pas',
- UMediaCore_FFmpeg in 'classes\UMediaCore_FFmpeg.pas',
+ UMediaCore_FFmpeg in 'base\UMediaCore_FFmpeg.pas',
{$IFDEF UseSWScale}
swscale in 'lib\ffmpeg\swscale.pas',
{$ENDIF}
@@ -126,74 +126,74 @@ uses
UMenuButtonCollection in 'menu\UMenuButtonCollection.pas',
//------------------------------
- //Includes - Classes
+ //Includes - base
//------------------------------
- UConfig in 'classes\UConfig.pas',
+ UConfig in 'base\UConfig.pas',
- UCommon in 'classes\UCommon.pas',
- UGraphic in 'classes\UGraphic.pas',
- UTexture in 'classes\UTexture.pas',
- ULanguage in 'classes\ULanguage.pas',
- UMain in 'classes\UMain.pas',
- UDraw in 'classes\UDraw.pas',
- URecord in 'classes\URecord.pas',
- UTime in 'classes\UTime.pas',
- TextGL in 'classes\TextGL.pas',
- USong in 'classes\USong.pas',
- UXMLSong in 'classes\UXMLSong.pas',
- USongs in 'classes\USongs.pas',
- UIni in 'classes\UIni.pas',
- UImage in 'classes\UImage.pas',
- ULyrics in 'classes\ULyrics.pas',
- UEditorLyrics in 'classes\UEditorLyrics.pas',
- USkins in 'classes\USkins.pas',
- UThemes in 'classes\UThemes.pas',
- ULog in 'classes\ULog.pas',
- UJoystick in 'classes\UJoystick.pas',
- UDataBase in 'classes\UDataBase.pas',
- UCovers in 'classes\UCovers.pas',
- UCatCovers in 'classes\UCatCovers.pas',
- UFiles in 'classes\UFiles.pas',
- UGraphicClasses in 'classes\UGraphicClasses.pas',
- UDLLManager in 'classes\UDLLManager.pas',
- UPlaylist in 'classes\UPlaylist.pas',
- UCommandLine in 'classes\UCommandLine.pas',
- URingBuffer in 'classes\URingBuffer.pas',
- UTextClasses in 'classes\UTextClasses.pas',
- USingScores in 'classes\USingScores.pas',
- USingNotes in 'classes\USingNotes.pas',
-
- UModules in 'classes\UModules.pas', //List of Modules to Load
- UHooks in 'classes\UHooks.pas', //Hook Managing
- UServices in 'classes\UServices.pas', //Service Managing
- UCore in 'classes\UCore.pas', //Core, Maybe remove this
- UCoreModule in 'classes\UCoreModule.pas', //^
- UPluginInterface in 'classes\UPluginInterface.pas', //Interface offered by Core to Plugins
- uPluginLoader in 'classes\uPluginLoader.pas', //New Plugin Loader Module
-
- UParty in 'classes\UParty.pas', // TODO: rewrite Party Manager as Module, reomplent ability to offer party Mody by Plugin
- UPlatform in 'classes\UPlatform.pas',
+ UCommon in 'base\UCommon.pas',
+ UGraphic in 'base\UGraphic.pas',
+ UTexture in 'base\UTexture.pas',
+ ULanguage in 'base\ULanguage.pas',
+ UMain in 'base\UMain.pas',
+ UDraw in 'base\UDraw.pas',
+ URecord in 'base\URecord.pas',
+ UTime in 'base\UTime.pas',
+ TextGL in 'base\TextGL.pas',
+ USong in 'base\USong.pas',
+ UXMLSong in 'base\UXMLSong.pas',
+ USongs in 'base\USongs.pas',
+ UIni in 'base\UIni.pas',
+ UImage in 'base\UImage.pas',
+ ULyrics in 'base\ULyrics.pas',
+ UEditorLyrics in 'base\UEditorLyrics.pas',
+ USkins in 'base\USkins.pas',
+ UThemes in 'base\UThemes.pas',
+ ULog in 'base\ULog.pas',
+ UJoystick in 'base\UJoystick.pas',
+ UDataBase in 'base\UDataBase.pas',
+ UCovers in 'base\UCovers.pas',
+ UCatCovers in 'base\UCatCovers.pas',
+ UFiles in 'base\UFiles.pas',
+ UGraphicClasses in 'base\UGraphicClasses.pas',
+ UDLLManager in 'base\UDLLManager.pas',
+ UPlaylist in 'base\UPlaylist.pas',
+ UCommandLine in 'base\UCommandLine.pas',
+ URingBuffer in 'base\URingBuffer.pas',
+ UTextClasses in 'base\UTextClasses.pas',
+ USingScores in 'base\USingScores.pas',
+ USingNotes in 'base\USingNotes.pas',
+
+ UModules in 'base\UModules.pas', //List of Modules to Load
+ UHooks in 'base\UHooks.pas', //Hook Managing
+ UServices in 'base\UServices.pas', //Service Managing
+ UCore in 'base\UCore.pas', //Core, Maybe remove this
+ UCoreModule in 'base\UCoreModule.pas', //^
+ UPluginInterface in 'base\UPluginInterface.pas', //Interface offered by Core to Plugins
+ uPluginLoader in 'base\uPluginLoader.pas', //New Plugin Loader Module
+
+ UParty in 'base\UParty.pas', // TODO: rewrite Party Manager as Module, reomplent ability to offer party Mody by Plugin
+ UPlatform in 'base\UPlatform.pas',
{$IFDEF MSWINDOWS}
- UPlatformWindows in 'classes\UPlatformWindows.pas',
+ UPlatformWindows in 'base\UPlatformWindows.pas',
{$ENDIF}
{$IFDEF LINUX}
- UPlatformLinux in 'classes\UPlatformLinux.pas',
+ UPlatformLinux in 'base\UPlatformLinux.pas',
{$ENDIF}
{$IFDEF DARWIN}
- UPlatformMacOSX in 'classes/UPlatformMacOSX.pas',
+ UPlatformMacOSX in 'base/UPlatformMacOSX.pas',
{$ENDIF}
//------------------------------
//Includes - Media
//------------------------------
- UMusic in 'classes\UMusic.pas',
- UAudioPlaybackBase in 'classes\UAudioPlaybackBase.pas',
+ UMusic in 'base\UMusic.pas',
+ UAudioPlaybackBase in 'base\UAudioPlaybackBase.pas',
{$IF Defined(UsePortaudioPlayback) or Defined(UseSDLPlayback)}
UFFT in 'lib\fft\UFFT.pas',
- UAudioPlayback_Softmixer in 'classes\UAudioPlayback_SoftMixer.pas',
+ UAudioPlayback_Softmixer in 'base\UAudioPlayback_SoftMixer.pas',
{$IFEND}
- UAudioConverter in 'classes\UAudioConverter.pas',
+ UAudioConverter in 'base\UAudioConverter.pas',
//******************************
//Pluggable media modules
@@ -204,36 +204,36 @@ uses
// TODO : these all should be moved to a media folder
{$IFDEF UseFFmpegVideo}
- UVideo in 'classes\UVideo.pas',
+ UVideo in 'base\UVideo.pas',
{$ENDIF}
{$IFDEF UseProjectM}
// must be after UVideo, so it will not be the default video module
- UVisualizer in 'classes\UVisualizer.pas',
+ UVisualizer in 'base\UVisualizer.pas',
{$ENDIF}
{$IFDEF UseBASSInput}
- UAudioInput_Bass in 'classes\UAudioInput_Bass.pas',
+ UAudioInput_Bass in 'base\UAudioInput_Bass.pas',
{$ENDIF}
{$IFDEF UseBASSDecoder}
// prefer Bass to FFmpeg if possible
- UAudioDecoder_Bass in 'classes\UAudioDecoder_Bass.pas',
+ UAudioDecoder_Bass in 'base\UAudioDecoder_Bass.pas',
{$ENDIF}
{$IFDEF UseBASSPlayback}
- UAudioPlayback_Bass in 'classes\UAudioPlayback_Bass.pas',
+ UAudioPlayback_Bass in 'base\UAudioPlayback_Bass.pas',
{$ENDIF}
{$IFDEF UseSDLPlayback}
- UAudioPlayback_SDL in 'classes\UAudioPlayback_SDL.pas',
+ UAudioPlayback_SDL in 'base\UAudioPlayback_SDL.pas',
{$ENDIF}
{$IFDEF UsePortaudioInput}
- UAudioInput_Portaudio in 'classes\UAudioInput_Portaudio.pas',
+ UAudioInput_Portaudio in 'base\UAudioInput_Portaudio.pas',
{$ENDIF}
{$IFDEF UsePortaudioPlayback}
- UAudioPlayback_Portaudio in 'classes\UAudioPlayback_Portaudio.pas',
+ UAudioPlayback_Portaudio in 'base\UAudioPlayback_Portaudio.pas',
{$ENDIF}
{$IFDEF UseFFmpegDecoder}
- UAudioDecoder_FFmpeg in 'classes\UAudioDecoder_FFmpeg.pas',
+ UAudioDecoder_FFmpeg in 'base\UAudioDecoder_FFmpeg.pas',
{$ENDIF}
// fallback dummy, must be last
- UMedia_dummy in 'classes\UMedia_dummy.pas',
+ UMedia_dummy in 'base\UMedia_dummy.pas',
//------------------------------
--
cgit v1.2.3