From 678cc132f942ff4d84a803550eedf96acc543bca Mon Sep 17 00:00:00 2001
From: tobigun <tobigun@b956fd51-792f-4845-bead-9b4dfca2ff2c>
Date: Sun, 23 May 2010 09:07:15 +0000
Subject: update to trunk rev. 2391
git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/branches/experimental@2401 b956fd51-792f-4845-bead-9b4dfca2ff2c
---
cmake/src/base/TextGL.pas | 393 +++------
cmake/src/base/TextGLFreetype.pas | 222 -----
cmake/src/base/UBeatTimer.pas | 459 ++++++----
cmake/src/base/UCatCovers.pas | 131 +--
cmake/src/base/UCommandLine.pas | 25 +-
cmake/src/base/UCommon.pas | 346 +++-----
cmake/src/base/UConfig.pas | 30 +-
cmake/src/base/UCovers.pas | 56 +-
cmake/src/base/UDLLManager.pas | 292 -------
cmake/src/base/UDataBase.pas | 458 ++++++----
cmake/src/base/UDraw.pas | 374 ++------
cmake/src/base/UEditorLyrics.pas | 4 +-
cmake/src/base/UFiles.pas | 221 +++--
cmake/src/base/UFilesystem.pas | 692 +++++++++++++++
cmake/src/base/UFont.pas | 849 ++++++++++++------
cmake/src/base/UGraphic.pas | 186 ++--
cmake/src/base/UImage.pas | 194 +++--
cmake/src/base/UIni.pas | 451 +++++-----
cmake/src/base/ULanguage.pas | 220 +++--
cmake/src/base/ULog.pas | 44 +-
cmake/src/base/ULyrics.pas | 4 +-
cmake/src/base/UMain.pas | 302 ++++---
cmake/src/base/UMusic.pas | 178 ++--
cmake/src/base/UNote.pas | 9 +-
cmake/src/base/UParty.pas | 1057 ++++++++++++++++++-----
cmake/src/base/UPath.pas | 1615 +++++++++++++++++++++++++++++++----
cmake/src/base/UPathUtils.pas | 196 +++++
cmake/src/base/UPlatform.pas | 95 +--
cmake/src/base/UPlatformLinux.pas | 102 +--
cmake/src/base/UPlatformMacOSX.pas | 198 ++---
cmake/src/base/UPlatformWindows.pas | 232 ++---
cmake/src/base/UPlaylist.pas | 261 +++---
cmake/src/base/URecord.pas | 67 +-
cmake/src/base/USingScores.pas | 175 +++-
cmake/src/base/USkins.pas | 145 ++--
cmake/src/base/USong.pas | 1101 ++++++++++++++----------
cmake/src/base/USongs.pas | 455 +++++-----
cmake/src/base/UTextEncoding.pas | 279 ++++--
cmake/src/base/UTexture.pas | 50 +-
cmake/src/base/UThemes.pas | 227 +++--
cmake/src/base/UTime.pas | 158 ++--
cmake/src/base/UUnicodeUtils.pas | 670 +++++++++++++++
cmake/src/base/UXMLSong.pas | 97 ++-
43 files changed, 8527 insertions(+), 4793 deletions(-)
delete mode 100644 cmake/src/base/TextGLFreetype.pas
delete mode 100644 cmake/src/base/UDLLManager.pas
create mode 100644 cmake/src/base/UFilesystem.pas
create mode 100644 cmake/src/base/UPathUtils.pas
create mode 100644 cmake/src/base/UUnicodeUtils.pas
(limited to 'cmake/src/base')
diff --git a/cmake/src/base/TextGL.pas b/cmake/src/base/TextGL.pas
index c8de4e28..c354a500 100644
--- a/cmake/src/base/TextGL.pas
+++ b/cmake/src/base/TextGL.pas
@@ -33,304 +33,189 @@ interface
{$I switches.inc}
-// as long as the transition to freetype is not finished
-// use the old implementation
-{$IFDEF UseFreetype}
- {$INCLUDE TextGLFreetype.pas}
-{$ELSE}
uses
gl,
+ glext,
SDL,
+ Classes,
UTexture,
+ UFont,
+ UPath,
ULog;
-procedure BuildFont; // build our bitmap font
-procedure KillFont; // delete the font
-function glTextWidth(const text: string): real; // returns text width
-procedure glPrint(const text: string); // custom GL "Print" routine
+type
+ PGLFont = ^TGLFont;
+ TGLFont = record
+ Font: TScalableFont;
+ Outlined: boolean;
+ X, Y, Z: real;
+ end;
+
+const
+ ftNormal = 0;
+ ftBold = 1;
+ ftOutline1 = 2;
+ ftOutline2 = 3;
+
+var
+ Fonts: array of TGLFont;
+ ActFont: integer;
+
+procedure BuildFonts; // builds all fonts
+procedure KillFonts; // deletes all font
+function glTextWidth(const text: UTF8String): real; // returns text width
+procedure glPrint(const text: UTF8String); // custom GL "Print" routine
procedure ResetFont(); // reset font settings of active font
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
-//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;
- end;
-
-
-var
- Fonts: array of TFont;
- ActFont: integer;
-
-
implementation
uses
- Classes,
+ UTextEncoding,
SysUtils,
IniFiles,
UCommon,
- UGraphic,
UMain,
- UPath;
-
-var
- // Colours for the reflection
- TempColor: array[0..3] of GLfloat;
+ UPathUtils;
{**
- * Load font info.
- * FontFile is the name of the image (.png) not the data (.dat) file
+ * Returns either Filename if it is absolute or a path relative to FontPath.
*}
-procedure LoadFontInfo(FontID: integer; const FontFile: string);
-var
- Stream: TFileStream;
- DatFile: string;
+function FindFontFile(const Filename: string): IPath;
begin
- DatFile := ChangeFileExt(FontFile, '.dat');
- FillChar(Fonts[FontID].Width[0], Length(Fonts[FontID].Width), 0);
+ Result := FontPath.Append(Filename);
+ // if path does not exist, try as an absolute path
+ if (not Result.IsFile) then
+ Result := Path(Filename);
+end;
- Stream := nil;
- try
- Stream := TFileStream.Create(DatFile, fmOpenRead);
- Stream.Read(Fonts[FontID].Width, 256);
- except
- Log.LogError('Error while reading font['+ inttostr(FontID) +']', 'LoadFontInfo');
+procedure AddFontFallbacks(FontIni: TMemIniFile; Font: TFont);
+var
+ FallbackFont: IPath;
+ IdentName: string;
+ I: Integer;
+begin
+ // evaluate the ini-file's 'Fallbacks' section
+ for I := 1 to 10 do
+ begin
+ IdentName := 'File' + IntToStr(I);
+ FallbackFont := FindFontFile(FontIni.ReadString('Fallbacks', IdentName, ''));
+ if (FallbackFont.Equals(PATH_NONE)) then
+ Continue;
+ try
+ Font.AddFallback(FallbackFont);
+ except
+ on E: EFontError do
+ Log.LogError('Setting font fallback ''' + FallbackFont.ToNative() + ''' failed: ' + E.Message);
+ end;
end;
- Stream.Free;
end;
-// Builds bitmap fonts
-procedure BuildFont;
+const
+ FONT_NAMES: array [0..3] of string = (
+ 'Normal', 'Bold', 'Outline1', 'Outline2'
+ );
+
+procedure BuildFonts;
var
- Count: integer;
+ I: integer;
FontIni: TMemIniFile;
- FontFile: string; // filename of the image (with .png/... ending)
+ FontFile: IPath;
+ Outline: single;
+ Embolden: single;
+ OutlineFont: TFTScalableOutlineFont;
+ SectionName: string;
begin
ActFont := 0;
- SetLength(Fonts, 4);
- FontIni := TMemIniFile.Create(FontPath + 'fonts.ini');
-
- // Normal
-
- FontFile := FontPath + FontIni.ReadString('Normal', 'File', '');
-
- Fonts[0].Tex := Texture.LoadTexture(true, FontFile, TEXTURE_TYPE_TRANSPARENT, 0);
- Fonts[0].Tex.H := 30;
- Fonts[0].AspectW := 0.9;
- Fonts[0].Outline := 0;
-
- LoadFontInfo(0, FontFile);
-
- // Bold
-
- FontFile := FontPath + FontIni.ReadString('Bold', 'File', '');
-
- Fonts[1].Tex := Texture.LoadTexture(true, FontFile, TEXTURE_TYPE_TRANSPARENT, 0);
- Fonts[1].Tex.H := 30;
- Fonts[1].AspectW := 1;
- Fonts[1].Outline := 0;
-
- LoadFontInfo(1, FontFile);
- for Count := 0 to 255 do
- Fonts[1].Width[Count] := Fonts[1].Width[Count] div 2;
-
- // Outline1
-
- FontFile := FontPath + FontIni.ReadString('Outline1', 'File', '');
-
- Fonts[2].Tex := Texture.LoadTexture(true, FontFile, TEXTURE_TYPE_TRANSPARENT, 0);
- Fonts[2].Tex.H := 30;
- Fonts[2].AspectW := 0.95;
- Fonts[2].Outline := 5;
-
- LoadFontInfo(2, FontFile);
- for Count := 0 to 255 do
- Fonts[2].Width[Count] := Fonts[2].Width[Count] div 2 + 2;
-
- // Outline2
+ SetLength(Fonts, Length(FONT_NAMES));
- FontFile := FontPath + FontIni.ReadString('Outline2', 'File', '');
-
- Fonts[3].Tex := Texture.LoadTexture(true, FontFile, TEXTURE_TYPE_TRANSPARENT, 0);
- Fonts[3].Tex.H := 30;
- Fonts[3].AspectW := 0.95;
- Fonts[3].Outline := 4;
-
- LoadFontInfo(3, FontFile);
- for Count := 0 to 255 do
- Fonts[3].Width[Count] := Fonts[3].Width[Count] + 1;
+ FontIni := TMemIniFile.Create(FontPath.Append('fonts.ini').ToNative);
+ try
+ for I := 0 to High(FONT_NAMES) do
+ begin
+ SectionName := 'Font_'+FONT_NAMES[I];
+
+ FontFile := FindFontFile(FontIni.ReadString(SectionName , 'File', ''));
+
+ // create either outlined or normal font
+ Outline := FontIni.ReadFloat(SectionName, 'Outline', 0.0);
+ if (Outline > 0.0) then
+ begin
+ // outlined font
+ OutlineFont := TFTScalableOutlineFont.Create(FontFile, 64, Outline);
+ OutlineFont.SetOutlineColor(
+ FontIni.ReadFloat(SectionName, 'OutlineColorR', 0.0),
+ FontIni.ReadFloat(SectionName, 'OutlineColorG', 0.0),
+ FontIni.ReadFloat(SectionName, 'OutlineColorB', 0.0),
+ FontIni.ReadFloat(SectionName, 'OutlineColorA', -1.0)
+ );
+ Fonts[I].Font := OutlineFont;
+ Fonts[I].Outlined := true;
+ end
+ else
+ begin
+ // normal font
+ Embolden := FontIni.ReadFloat(SectionName, 'Embolden', 0.0);
+ Fonts[I].Font := TFTScalableFont.Create(FontFile, 64, Embolden);
+ Fonts[I].Outlined := false;
+ end;
+
+ Fonts[I].Font.GlyphSpacing := FontIni.ReadFloat(SectionName, 'GlyphSpacing', 0.0);
+ Fonts[I].Font.Stretch := FontIni.ReadFloat(SectionName, 'Stretch', 1.0);
+
+ AddFontFallbacks(FontIni, Fonts[I].Font);
+ end;
+ except
+ on E: EFontError do
+ Log.LogCritical(E.Message, 'BuildFont');
+ end;
// close ini-file
FontIni.Free;
end;
-// Deletes the font
-procedure KillFont;
-begin
- // delete all characters
- //glDeleteLists(..., 256);
-end;
-function glTextWidth(const text: string): real;
+// Deletes the font
+procedure KillFonts;
var
- Letter: char;
- i: integer;
- Font: PFont;
+ I: integer;
begin
- Result := 0;
- Font := @Fonts[ActFont];
-
- for i := 1 to Length(text) do
- begin
- Letter := Text[i];
- Result := Result + Font.Width[Ord(Letter)] * Font.Tex.H / 30 * Font.AspectW;
- end;
-
- if ((Result > 0) and Font.Italic) then
- Result := Result + 12 * Font.Tex.H / 60 * Font.AspectW;
+ for I := 0 to High(Fonts) do
+ Fonts[I].Font.Free;
end;
-procedure glPrintLetter(Letter: char);
+function glTextWidth(const text: UTF8String): real;
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;
+ Bounds: TBoundsDbl;
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;
-
- glEnable(GL_BLEND);
- glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
-
- 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);
- glDisable(GL_BLEND);
-
- Tex.X := Tex.X + Tex.W;
-
- //write the colour back
- glColor4fv(@TempColor);
+ Bounds := Fonts[ActFont].Font.BBox(Text, true);
+ Result := Bounds.Right - Bounds.Left;
end;
// Custom GL "Print" Routine
-procedure glPrint(const Text: string);
+procedure glPrint(const Text: UTF8String);
var
- Pos: integer;
+ GLFont: PGLFont;
begin
// if there is no text do nothing
if (Text = '') then
Exit;
- //Save the actual color and alpha (for reflection)
- glGetFloatv(GL_CURRENT_COLOR, @TempColor);
+ GLFont := @Fonts[ActFont];
- for Pos := 1 to Length(Text) do
- begin
- glPrintLetter(Text[Pos]);
- end;
+ glPushMatrix();
+ // set font position
+ glTranslatef(GLFont.X, GLFont.Y + GLFont.Font.Ascender, GLFont.Z);
+ // draw string
+ GLFont.Font.Print(Text);
+ glPopMatrix();
end;
procedure ResetFont();
@@ -343,18 +228,18 @@ end;
procedure SetFontPos(X, Y: real);
begin
- Fonts[ActFont].Tex.X := X;
- Fonts[ActFont].Tex.Y := Y;
+ Fonts[ActFont].X := X;
+ Fonts[ActFont].Y := Y;
end;
procedure SetFontZ(Z: real);
begin
- Fonts[ActFont].Tex.Z := Z;
+ Fonts[ActFont].Z := Z;
end;
procedure SetFontSize(Size: real);
begin
- Fonts[ActFont].Tex.H := Size;
+ Fonts[ActFont].Font.Height := Size;
end;
procedure SetFontStyle(Style: integer);
@@ -364,21 +249,19 @@ end;
procedure SetFontItalic(Enable: boolean);
begin
- Fonts[ActFont].Italic := Enable;
-end;
-
-procedure SetFontAspectW(Aspect: real);
-begin
- Fonts[ActFont].AspectW := Aspect;
+ if (Enable) then
+ Fonts[ActFont].Font.Style := Fonts[ActFont].Font.Style + [Italic]
+ else
+ Fonts[ActFont].Font.Style := Fonts[ActFont].Font.Style - [Italic]
end;
procedure SetFontReflection(Enable: boolean; Spacing: real);
begin
- Fonts[ActFont].Reflection := Enable;
- Fonts[ActFont].ReflectionSpacing := Spacing;
+ if (Enable) then
+ Fonts[ActFont].Font.Style := Fonts[ActFont].Font.Style + [Reflect]
+ else
+ Fonts[ActFont].Font.Style := Fonts[ActFont].Font.Style - [Reflect];
+ Fonts[ActFont].Font.ReflectionSpacing := Spacing - Fonts[ActFont].Font.Descender;
end;
end.
-
-{$ENDIF}
-
diff --git a/cmake/src/base/TextGLFreetype.pas b/cmake/src/base/TextGLFreetype.pas
deleted file mode 100644
index 61b26693..00000000
--- a/cmake/src/base/TextGLFreetype.pas
+++ /dev/null
@@ -1,222 +0,0 @@
-{* UltraStar Deluxe - Karaoke Game
- *
- * UltraStar Deluxe is the legal property of its developers, whose names
- * are too numerous to list here. Please refer to the COPYRIGHT
- * file distributed with this source distribution.
- *
- * This program is free software; you can redistribute it and/or
- * modify it under the terms of the GNU General Public License
- * as published by the Free Software Foundation; either version 2
- * of the License, or (at your option) any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- * GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License
- * along with this program; see the file COPYING. If not, write to
- * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
- * Boston, MA 02110-1301, USA.
- *
- * $URL: https://ultrastardx.svn.sourceforge.net/svnroot/ultrastardx/trunk/src/base/TextGL.pas $
- * $Id: TextGL.pas 1483 2008-10-28 19:01:20Z tobigun $
- *}
-
-(*
-unit TextGL;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-*)
-
-uses
- gl,
- glext,
- SDL,
- UTexture,
- UFont,
- Classes,
- ULog;
-
-type
- PGLFont = ^TGLFont;
- TGLFont = record
- Font: TScalableFont;
- X, Y, Z: real;
- end;
-
-var
- Fonts: array of TGLFont;
- ActFont: integer;
-
-procedure BuildFont; // build our bitmap font
-procedure KillFont; // delete the font
-function glTextWidth(const text: string): real; // returns text width
-procedure glPrint(const text: string); // custom GL "Print" routine
-procedure ResetFont(); // reset font settings of active font
-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 SetFontReflection(Enable:boolean;Spacing: real); // enables/disables text reflection
-
-implementation
-
-uses
- UMain,
- UCommon,
- UTextEncoding,
- SysUtils,
- IniFiles;
-
-function FindFontFile(FontIni: TCustomIniFile; Font: string): string;
-var
- Filename: string;
-begin
- Filename := FontIni.ReadString(Font, 'File', '');
- Result := FontPath + Filename;
- // if path does not exist, try as an absolute path
- if (not FileExists(Result)) then
- Result := Filename;
-end;
-
-procedure BuildFont;
-var
- FontIni: TMemIniFile;
- //BitmapFont: TBitmapFont;
- FontFile: string;
-begin
- ActFont := 0;
-
- SetLength(Fonts, 4);
- FontIni := TMemIniFile.Create(FontPath + 'fontsTTF.ini');
- //FontIni := TMemIniFile.Create(FontPath + 'fonts.ini');
-
- try
-
- // Normal
- FontFile := FindFontFile(FontIni, 'Normal');
- Fonts[0].Font := TFTScalableFont.Create(FontFile, 64);
- //Fonts[0].Font.GlyphSpacing := 1.4;
- //Fonts[0].Font.Aspect := 1.2;
-
- {
- BitmapFont := TBitmapFont.Create(FontFile, 0, 19, 35, -10);
- BitmapFont.CorrectWidths(2, 0);
- Fonts[0].Font := TScalableFont.Create(BitmapFont, false);
- }
-
- //Fonts[0].Font.Aspect := 0.9;
-
- // Bold
- FontFile := FindFontFile(FontIni, 'Bold');
- Fonts[1].Font := TFTScalableFont.Create(FontFile, 64);
-
- // Outline1
- FontFile := FindFontFile(FontIni, 'Outline1');
- Fonts[2].Font := TFTScalableOutlineFont.Create(FontFile, 64, 0.06);
- //TFTScalableOutlineFont(Fonts[2].Font).SetOutlineColor(0.3, 0.3, 0.3);
-
- // Outline2
- FontFile := FindFontFile(FontIni, 'Outline2');
- Fonts[3].Font := TFTScalableOutlineFont.Create(FontFile, 64, 0.08);
-
- except on E: Exception do
- Log.LogCritical(E.Message, 'BuildFont');
- end;
-
- // close ini-file
- FontIni.Free;
-end;
-
-
-// Deletes the font
-procedure KillFont;
-begin
- // delete all characters
- //glDeleteLists(..., 256);
-end;
-
-function glTextWidth(const text: string): real;
-var
- Bounds: TBoundsDbl;
-begin
- // FIXME: remove conversion
- Bounds := Fonts[ActFont].Font.BBox(RecodeString(Text, encCP1252), true);
- Result := Bounds.Right - Bounds.Left;
-end;
-
-// Custom GL "Print" Routine
-procedure glPrint(const Text: string);
-var
- GLFont: PGLFont;
-begin
- // if there is no text do nothing
- if (Text = '') then
- Exit;
-
- GLFont := @Fonts[ActFont];
-
- glPushMatrix();
- // set font position
- glTranslatef(GLFont.X, GLFont.Y + GLFont.Font.Ascender, GLFont.Z);
- // draw string
- // FIXME: remove conversion
- GLFont.Font.Print(RecodeString(Text, encCP1252));
- glPopMatrix();
-end;
-
-procedure ResetFont();
-begin
- SetFontPos(0, 0);
- SetFontZ(0);
- SetFontItalic(False);
- SetFontReflection(False, 0);
-end;
-
-procedure SetFontPos(X, Y: real);
-begin
- Fonts[ActFont].X := X;
- Fonts[ActFont].Y := Y;
-end;
-
-procedure SetFontZ(Z: real);
-begin
- Fonts[ActFont].Z := Z;
-end;
-
-procedure SetFontSize(Size: real);
-begin
- Fonts[ActFont].Font.Height := Size;
-end;
-
-procedure SetFontStyle(Style: integer);
-begin
- ActFont := Style;
-end;
-
-procedure SetFontItalic(Enable: boolean);
-begin
- if (Enable) then
- Fonts[ActFont].Font.Style := Fonts[ActFont].Font.Style + [Italic]
- else
- Fonts[ActFont].Font.Style := Fonts[ActFont].Font.Style - [Italic]
-end;
-
-procedure SetFontReflection(Enable: boolean; Spacing: real);
-begin
- if (Enable) then
- Fonts[ActFont].Font.Style := Fonts[ActFont].Font.Style + [Reflect]
- else
- Fonts[ActFont].Font.Style := Fonts[ActFont].Font.Style - [Reflect];
- Fonts[ActFont].Font.ReflectionSpacing := Spacing - Fonts[ActFont].Font.Descender;
-end;
-
-end.
diff --git a/cmake/src/base/UBeatTimer.pas b/cmake/src/base/UBeatTimer.pas
index a47a06f9..bc03de76 100644
--- a/cmake/src/base/UBeatTimer.pas
+++ b/cmake/src/base/UBeatTimer.pas
@@ -1,170 +1,299 @@
- {* UltraStar Deluxe - Karaoke Game
- *
- * UltraStar Deluxe is the legal property of its developers, whose names
- * are too numerous to list here. Please refer to the COPYRIGHT
- * file distributed with this source distribution.
- *
- * This program is free software; you can redistribute it and/or
- * modify it under the terms of the GNU General Public License
- * as published by the Free Software Foundation; either version 2
- * of the License, or (at your option) any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- * GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License
- * along with this program; see the file COPYING. If not, write to
- * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
- * Boston, MA 02110-1301, USA.
- *
- * $URL: https://ultrastardx.svn.sourceforge.net/svnroot/ultrastardx/trunk/src/base/USingNotes.pas $
- * $Id: USingNotes.pas 1406 2008-09-23 21:43:52Z k-m_schindler $
- *}
+{* UltraStar Deluxe - Karaoke Game
+ *
+ * UltraStar Deluxe is the legal property of its developers, whose names
+ * are too numerous to list here. Please refer to the COPYRIGHT
+ * file distributed with this source distribution.
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; see the file COPYING. If not, write to
+ * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+ * Boston, MA 02110-1301, USA.
+ *
+ * $URL$
+ * $Id$
+ *}
+
+unit UBeatTimer;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+uses
+ UTime;
+
+type
+ (**
+ * TLyricsState contains all information concerning the
+ * state of the lyrics, e.g. the current beat or duration of the lyrics.
+ *)
+ TLyricsState = class
+ private
+ fTimer: TRelativeTimer; // keeps track of the current time
+ fSyncSource: TSyncSource;
+ fAvgSyncDiff: real;
+ fLastClock: real; // last master clock value
+ // Note: do not use Timer.GetState() to check if lyrics are paused as
+ // Timer.Pause() is used for synching.
+ fPaused: boolean;
+
+ function Synchronize(LyricTime: real): real;
+ 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();
+
+ {**
+ * Resets the LyricsState state.
+ *}
+ procedure Reset();
+
+ procedure UpdateBeats();
+
+ {**
+ * Sets a master clock for this LyricsState. If no sync-source is set
+ * or SyncSource is nil the internal timer is used.
+ *}
+ procedure SetSyncSource(SyncSource: TSyncSource);
+
+ {**
+ * Starts the timer. This is either done
+ * - immediately if WaitForTrigger is false or
+ * - after the first call to GetCurrentTime()/SetCurrentTime() or Start(false)
+ *}
+ procedure Start(WaitForTrigger: boolean = false);
+
+ {**
+ * Pauses the timer.
+ * The counter is preserved and can be resumed by a call to Start().
+ *}
+ procedure Pause();
+
+ {**
+ * Stops the timer.
+ * The counter is reset to 0.
+ *}
+ procedure Stop();
+
+ (**
+ * Returns/Sets the current song time (in seconds) used as base-timer for lyrics etc.
+ * If GetCurrentTime()/SetCurrentTime() if Start() was called
+ *)
+ function GetCurrentTime(): real;
+ procedure SetCurrentTime(Time: real);
+ end;
+
+implementation
+
+uses
+ UNote,
+ ULog,
+ SysUtils,
+ Math;
+
+
+constructor TLyricsState.Create();
+begin
+ // create a triggered timer, so we can Pause() it, set the time
+ // and Resume() it afterwards for better synching.
+ fTimer := TRelativeTimer.Create();
+
+ // reset state
+ Reset();
+end;
+
+procedure TLyricsState.Pause();
+begin
+ fTimer.Pause();
+ fPaused := true;
+end;
+
+procedure TLyricsState.Start(WaitForTrigger: boolean);
+begin
+ fTimer.Start(WaitForTrigger);
+ fPaused := false;
+ fLastClock := -1;
+ fAvgSyncDiff := -1;
+end;
+
+procedure TLyricsState.Stop();
+begin
+ fTimer.Stop();
+ fPaused := false;
+end;
+
+procedure TLyricsState.SetCurrentTime(Time: real);
+begin
+ fTimer.SetTime(Time);
+ fLastClock := -1;
+ fAvgSyncDiff := -1;
+end;
+
+{.$DEFINE LOG_SYNC}
+
+function TLyricsState.Synchronize(LyricTime: real): real;
+var
+ MasterClock: real;
+ TimeDiff: real;
+const
+ AVG_HISTORY_FACTOR = 0.7;
+ PAUSE_THRESHOLD = 0.010; // 10ms
+ FORWARD_THRESHOLD = 0.010; // 10ms
+begin
+ MasterClock := fSyncSource.GetClock();
+ Result := LyricTime;
-unit UBeatTimer;
+ // do not sync if lyrics are paused externally or if the timestamp is old
+ if (fPaused or (MasterClock = fLastClock)) then
+ Exit;
+
+ // calculate average time difference (some sort of weighted mean).
+ // The bigger AVG_HISTORY_FACTOR is, the smoother is the average diff.
+ // This is done as some timestamps might be wrong or even lower
+ // than their predecessor.
+ TimeDiff := MasterClock - LyricTime;
+ if (fAvgSyncDiff = -1) then
+ fAvgSyncDiff := TimeDiff
+ else
+ fAvgSyncDiff := TimeDiff * (1-AVG_HISTORY_FACTOR) +
+ fAvgSyncDiff * AVG_HISTORY_FACTOR;
-interface
+ {$IFDEF LOG_SYNC}
+ //Log.LogError(Format('TimeDiff: %.3f', [TimeDiff]));
+ {$ENDIF}
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses
- UTime;
-
-type
- (**
- * 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;
-
-implementation
-uses UNote, Math;
-
-
-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();
+ // do not go backwards in time as this could mess up the score
+ if (fAvgSyncDiff > FORWARD_THRESHOLD) then
+ begin
+ {$IFDEF LOG_SYNC}
+ Log.LogError('Sync: ' + floatToStr(MasterClock) + ' > ' + floatToStr(LyricTime));
+ {$ENDIF}
+
+ Result := LyricTime + fAvgSyncDiff;
+ fTimer.SetTime(Result);
+ fTimer.Start();
+ fAvgSyncDiff := -1;
+ end
+ else if (fAvgSyncDiff < -PAUSE_THRESHOLD) then
+ begin
+ // wait until timer and master clock are in sync (> 10ms)
+ fTimer.Pause();
+
+ {$IFDEF LOG_SYNC}
+ Log.LogError('Pause: ' + floatToStr(MasterClock) + ' < ' + floatToStr(LyricTime));
+ {$ENDIF}
+ end
+ else if (fTimer.GetState = rtsPaused) and (fAvgSyncDiff >= 0) then
+ begin
+ fTimer.Start();
+
+ {$IFDEF LOG_SYNC}
+ Log.LogError('Unpause: ' + floatToStr(LyricTime));
+ {$ENDIF}
+ end;
+ fLastClock := MasterClock;
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;
-
+
+function TLyricsState.GetCurrentTime(): real;
+var
+ LyricTime: real;
+begin
+ LyricTime := fTimer.GetTime();
+ if Assigned(fSyncSource) then
+ Result := Synchronize(LyricTime)
+ else
+ Result := LyricTime;
+end;
+
+procedure TLyricsState.SetSyncSource(SyncSource: TSyncSource);
+begin
+ fSyncSource := SyncSource;
+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
+ Stop();
+ fPaused := false;
+
+ fSyncSource := nil;
+
+ 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;
+
end.
\ No newline at end of file
diff --git a/cmake/src/base/UCatCovers.pas b/cmake/src/base/UCatCovers.pas
index 6ef81b68..85cb850f 100644
--- a/cmake/src/base/UCatCovers.pas
+++ b/cmake/src/base/UCatCovers.pas
@@ -24,10 +24,6 @@
*}
unit UCatCovers;
-/////////////////////////////////////////////////////////////////////////
-// UCatCovers by Whiteshark //
-// Class for listing and managing the Category Covers //
-/////////////////////////////////////////////////////////////////////////
interface
@@ -38,20 +34,21 @@ interface
{$I switches.inc}
uses
- UIni;
+ UIni,
+ UPath;
type
TCatCovers = class
protected
- cNames: array [0..high(ISorting)] of array of string;
- cFiles: array [0..high(ISorting)] of array of string;
+ cNames: array [TSortingType] of array of UTF8String;
+ cFiles: array [TSortingType] of array of IPath;
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
+ procedure LoadPath(const CoversPath: IPath);
+ procedure Add(Sorting: TSortingType; const Name: UTF8String; const Filename: IPath); //Add a Cover
+ function CoverExists(Sorting: TSortingType; const Name: UTF8String): boolean; //Returns True when a cover with the given Name exists
+ function GetCover(Sorting: TSortingType; const Name: UTF8String): IPath; //Returns the Filename of a Cover
end;
var
@@ -63,10 +60,11 @@ uses
IniFiles,
SysUtils,
Classes,
- // UFiles,
+ UFilesystem,
ULog,
UMain,
- UPath;
+ UUnicodeUtils,
+ UPathUtils;
constructor TCatCovers.Create;
begin
@@ -79,90 +77,96 @@ var
I: integer;
begin
for I := 0 to CoverPaths.Count-1 do
- LoadPath(CoverPaths[I]);
+ LoadPath(CoverPaths[I] as IPath);
end;
(**
* Load Cover from Cover.ini and Cover Folder
*)
-procedure TCatCovers.LoadPath(const CoversPath: string);
+procedure TCatCovers.LoadPath(const CoversPath: IPath);
var
Ini: TMemIniFile;
- SR: TSearchRec;
List: TStringlist;
- I, J: Integer;
- Name, Filename, Temp: string;
+ I: Integer;
+ SortType: TSortingType;
+ Filename: IPath;
+ Name, TmpName: UTF8String;
+ CatCover: IPath;
+ Iter: IFileIterator;
+ FileInfo: TFileInfo;
begin
Ini := nil;
List := nil;
try
- Ini := TMemIniFile.Create(CoversPath + 'covers.ini');
+ Ini := TMemIniFile.Create(CoversPath.Append('covers.ini').ToNative);
List := TStringlist.Create;
//Add every Cover in Covers Ini for Every Sorting option
- for I := 0 to High(ISorting) do
+ for SortType := Low(TSortingType) to High(TSortingType) do
begin
- Ini.ReadSection(ISorting[I], List);
+ Ini.ReadSection(ISorting[Ord(SortType)], List);
- for J := 0 to List.Count - 1 do
- Add(I, List.Strings[J], CoversPath + Ini.ReadString(ISorting[I], List.Strings[J], 'NoCover.jpg'));
+ for I := 0 to List.Count - 1 do
+ begin
+ CatCover := Path(Ini.ReadString(ISorting[Ord(SortType)], List.Strings[I], 'NoCover.jpg'));
+ Add(SortType, List.Strings[I], CoversPath.Append(CatCover));
+ end;
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);
+ //Add Covers from Folder
+ Iter := FileSystem.FileFind(CoversPath.Append('*.jpg'), 0);
+ while Iter.HasNext do
+ begin
+ FileInfo := Iter.Next;
+
+ //Add Cover if it doesn't exist for every Section
+ Filename := CoversPath.Append(FileInfo.Name);
+ Name := FileInfo.Name.SetExtension('').ToUTF8;
+
+ for SortType := Low(TSortingType) to High(TSortingType) do
+ begin
+ TmpName := Name;
+ if (SortType = sTitle) and (UTF8Pos('Title', TmpName) <> 0) then
+ UTF8Delete(TmpName, UTF8Pos('Title', TmpName), 5)
+ else if (SortType = sArtist) and (UTF8Pos('Artist', TmpName) <> 0) then
+ UTF8Delete(TmpName, UTF8Pos('Artist', TmpName), 6);
+
+ if not CoverExists(SortType, TmpName) then
+ Add(SortType, TmpName, Filename);
+ end;
end;
end;
//Add a Cover
-procedure TCatCovers.Add(Sorting: integer; Name, Filename: string);
+procedure TCatCovers.Add(Sorting: TSortingType; const Name: UTF8String; const Filename: IPath);
begin
- if FileExists (Filename) then //If Exists -> Add
+ if Filename.IsFile then //If Exists -> Add
begin
- SetLength (CNames[Sorting], Length(CNames[Sorting]) + 1);
- SetLength (CFiles[Sorting], Length(CNames[Sorting]) + 1);
+ SetLength(CNames[Sorting], Length(CNames[Sorting]) + 1);
+ SetLength(CFiles[Sorting], Length(CNames[Sorting]) + 1);
- CNames[Sorting][high(cNames[Sorting])] := Uppercase(Name);
+ CNames[Sorting][high(cNames[Sorting])] := UTF8Uppercase(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;
+function TCatCovers.CoverExists(Sorting: TSortingType; const Name: UTF8String): boolean;
var
I: Integer;
+ UpperName: UTF8String;
begin
Result := False;
- Name := Uppercase(Name); //Case Insensitiv
+ UpperName := UTF8Uppercase(Name); //Case Insensitiv
for I := 0 to high(cNames[Sorting]) do
begin
- if (cNames[Sorting][I] = Name) then //Found Name
+ if (cNames[Sorting][I] = UpperName) then //Found Name
begin
Result := true;
break; //Break For Loop
@@ -171,16 +175,18 @@ begin
end;
//Returns the Filename of a Cover
-function TCatCovers.GetCover(Sorting: integer; Name: string): string;
+function TCatCovers.GetCover(Sorting: TSortingType; const Name: UTF8String): IPath;
var
I: Integer;
+ UpperName: UTF8String;
+ NoCoverPath: IPath;
begin
- Result := '';
- Name := Uppercase(Name);
+ Result := PATH_NONE;
+ UpperName := UTF8Uppercase(Name);
for I := 0 to high(cNames[Sorting]) do
begin
- if cNames[Sorting][I] = Name then
+ if cNames[Sorting][I] = UpperName then
begin
Result := cFiles[Sorting][I];
Break;
@@ -188,17 +194,18 @@ begin
end;
//No Cover
- if (Result = '') then
+ if (Result.IsUnset) then
begin
for I := 0 to CoverPaths.Count-1 do
begin
- if (FileExists(CoverPaths[I] + 'NoCover.jpg')) then
+ NoCoverPath := (CoverPaths[I] as IPath).Append('NoCover.jpg');
+ if (NoCoverPath.IsFile) then
begin
- Result := CoverPaths[I] + 'NoCover.jpg';
+ Result := NoCoverPath;
Break;
end;
end;
end;
end;
-end.
+end.
\ No newline at end of file
diff --git a/cmake/src/base/UCommandLine.pas b/cmake/src/base/UCommandLine.pas
index 281a480d..ac0db2c2 100644
--- a/cmake/src/base/UCommandLine.pas
+++ b/cmake/src/base/UCommandLine.pas
@@ -33,6 +33,9 @@ interface
{$I switches.inc}
+uses
+ UPath;
+
type
TScreenMode = (scmDefault, scmFullscreen, scmWindowed);
@@ -64,9 +67,9 @@ type
Screens: integer;
// some strings set when reading infos {Length=0: Not Set}
- SongPath: string;
- ConfigFile: string;
- ScoreFile: string;
+ SongPath: IPath;
+ ConfigFile: IPath;
+ ScoreFile: IPath;
// pseudo integer values
property Language: integer read GetLanguage;
@@ -144,9 +147,9 @@ begin
Screens := -1;
// some strings set when reading infos {Length=0 Not Set}
- SongPath := '';
- ConfigFile := '';
- ScoreFile := '';
+ SongPath := PATH_NONE;
+ ConfigFile := PATH_NONE;
+ ScoreFile := PATH_NONE;
end;
{**
@@ -248,7 +251,7 @@ begin
if (PCount > I) then
begin
// write value to string
- SongPath := ParamStr(I + 1);
+ SongPath := Path(ParamStr(I + 1));
end;
end
@@ -258,11 +261,11 @@ begin
if (PCount > I) then
begin
// write value to string
- ConfigFile := ParamStr(I + 1);
+ ConfigFile := Path(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;
+ if (not ConfigFile.IsAbsolute) then
+ ConfigFile := Platform.GetExecutionDir().Append(ConfigFile);
end;
end
@@ -272,7 +275,7 @@ begin
if (PCount > I) then
begin
// write value to string
- ScoreFile := ParamStr(I + 1);
+ ScoreFile := Path(ParamStr(I + 1));
end;
end;
diff --git a/cmake/src/base/UCommon.pas b/cmake/src/base/UCommon.pas
index d729b6dd..18022337 100644
--- a/cmake/src/base/UCommon.pas
+++ b/cmake/src/base/UCommon.pas
@@ -39,9 +39,29 @@ uses
{$IFDEF MSWINDOWS}
Windows,
{$ENDIF}
- sdl,
UConfig,
- ULog;
+ ULog,
+ UPath;
+
+type
+ TStringDynArray = array of string;
+ TUTF8StringDynArray = array of UTF8String;
+
+const
+ SepWhitespace = [#9, #10, #13, ' ']; // tab, lf, cr, space
+
+{**
+ * Splits a string into pieces separated by Separators.
+ * MaxCount specifies the max. number of pieces. If it is <= 0 the number is
+ * not limited. If > 0 the last array element will hold the rest of the string
+ * (with leading separators removed).
+ *
+ * Examples:
+ * SplitString(' split me now ', 0) -> ['split', 'me', 'now']
+ * SplitString(' split me now ', 1) -> ['split', 'me now']
+ *}
+function SplitString(const Str: string; MaxCount: integer = 0; Separators: TSysCharSet = SepWhitespace): TStringDynArray;
+
type
TMessageType = (mtInfo, mtError);
@@ -50,49 +70,27 @@ procedure ShowMessage(const msg: string; msgType: TMessageType = mtInfo);
procedure ConsoleWriteLn(const msg: string);
-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))
- *)
+procedure ZeroMemory(Destination: pointer; Length: dword);
+function MakeLong(a, b: word): longint;
{$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);
+function GetArrayIndex(const SearchArray: array of UTF8String; Value: string; CaseInsensitiv: boolean = false): integer;
+
implementation
@@ -101,8 +99,63 @@ uses
{$IFDEF Delphi}
Dialogs,
{$ENDIF}
- UMain;
+ sdl,
+ UFilesystem,
+ UMain,
+ UUnicodeUtils;
+function SplitString(const Str: string; MaxCount: integer; Separators: TSysCharSet): TStringDynArray;
+
+ {*
+ * Adds Str[StartPos..Endpos-1] to the result array.
+ *}
+ procedure AddSplit(StartPos, EndPos: integer);
+ begin
+ SetLength(Result, Length(Result)+1);
+ Result[High(Result)] := Copy(Str, StartPos, EndPos-StartPos);
+ end;
+
+var
+ I: integer;
+ Start: integer;
+ Last: integer;
+begin
+ Start := 0;
+ SetLength(Result, 0);
+
+ for I := 1 to Length(Str) do
+ begin
+ if (Str[I] in Separators) then
+ begin
+ // end of component found
+ if (Start > 0) then
+ begin
+ AddSplit(Start, I);
+ Start := 0;
+ end;
+ end
+ else if (Start = 0) then
+ begin
+ // mark beginning of component
+ Start := I;
+ // check if this is the last component
+ if (Length(Result) = MaxCount-1) then
+ begin
+ // find last non-separator char
+ Last := Length(Str);
+ while (Str[Last] in Separators) do
+ Dec(Last);
+ // add component up to last non-separator
+ AddSplit(Start, Last);
+ Exit;
+ end;
+ end;
+ end;
+
+ // last component
+ if (Start > 0) then
+ AddSplit(Start, Length(Str)+1);
+end;
// data used by the ...Locale() functions
{$IF Defined(Linux) or Defined(FreeBSD)}
@@ -224,39 +277,6 @@ begin
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
@@ -268,135 +288,8 @@ 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
-{$IF Defined(Linux) or Defined(FreeBSD)}
- // 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}
- // Windows and Mac OS X do not have case sensitive file systems
- Result := FileExists(FileName);
-{$IFEND}
-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
@@ -541,59 +434,6 @@ begin
{$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
@@ -677,6 +517,28 @@ begin
TempList.Free;
end;
+(**
+ * Returns the index of Value in SearchArray
+ * or -1 if Value is not in SearchArray.
+ *)
+function GetArrayIndex(const SearchArray: array of UTF8String; 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 (CompareText(SearchArray[i], Value) = 0)) then
+ begin
+ Result := i;
+ Break;
+ end;
+ end;
+end;
+
type
// stores the unaligned pointer of data allocated by GetAlignedMem()
diff --git a/cmake/src/base/UConfig.pas b/cmake/src/base/UConfig.pas
index dfb51d54..c0980de4 100644
--- a/cmake/src/base/UConfig.pas
+++ b/cmake/src/base/UConfig.pas
@@ -58,7 +58,7 @@ unit UConfig;
// not possible to use the version-numbers in this uses-clause.
// Example:
// interface
-// uses
+// uses
// versions, // include this file
// {$IF USE_UNIT_XYZ}xyz;{$IFEND} // Error: USE_UNIT_XYZ not defined
// const
@@ -68,13 +68,13 @@ unit UConfig;
//
// 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
+// 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
+// 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.
+// 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.
@@ -88,9 +88,9 @@ interface
{$ENDIF}
{$I switches.inc}
-
+
uses
- Sysutils;
+ SysUtils;
const
// IMPORTANT:
@@ -107,7 +107,7 @@ const
// include config-file (defines + constants)
{$IF Defined(MSWindows)}
- {$I config-win.inc}
+ {$I ..\config-win.inc}
{$ELSEIF Defined(Linux)}
{$I config-linux.inc}
{$ELSEIF Defined(FreeBSD)}
@@ -130,7 +130,7 @@ const
USDX_VERSION_MAJOR = 1;
USDX_VERSION_MINOR = 1;
USDX_VERSION_RELEASE = 0;
- USDX_VERSION_STATE = 'Alpha';
+ USDX_VERSION_STATE = 'Beta';
USDX_STRING = 'UltraStar Deluxe';
(*
@@ -151,11 +151,17 @@ const
FPC_RELEASE = 0;
FPC_PATCH = 0;
{$ENDIF}
-
+
FPC_VERSION_INT = (FPC_VERSION * VERSION_MAJOR) +
(FPC_RELEASE * VERSION_MINOR) +
(FPC_PATCH * VERSION_RELEASE);
+ // FPC 2.2.0 unicode support is very buggy. The cwstring unit for example
+ // always crashes whenever UTF8ToAnsi() is called on a non UTF8 encoded string
+ // what is fixed in 2.2.2.
+ {$IF Defined(FPC) and (FPC_VERSION_INT < 2002002)} // < 2.2.2
+ {$MESSAGE FATAL 'FPC >= 2.2.2 required!'}
+ {$IFEND}
{$IFDEF HaveFFmpeg}
@@ -179,13 +185,13 @@ const
{$ENDIF}
- {$IFDEF HaveProjectM}
+ {$IFDEF HaveProjectM}
PROJECTM_VERSION = (PROJECTM_VERSION_MAJOR * VERSION_MAJOR) +
(PROJECTM_VERSION_MINOR * VERSION_MINOR) +
(PROJECTM_VERSION_RELEASE * VERSION_RELEASE);
{$ENDIF}
- {$IFDEF HavePortaudio}
+ {$IFDEF HavePortaudio}
PORTAUDIO_VERSION = (PORTAUDIO_VERSION_MAJOR * VERSION_MAJOR) +
(PORTAUDIO_VERSION_MINOR * VERSION_MINOR) +
(PORTAUDIO_VERSION_RELEASE * VERSION_RELEASE);
@@ -223,4 +229,4 @@ begin
' Build';
end;
-end.
+end.
\ No newline at end of file
diff --git a/cmake/src/base/UCovers.pas b/cmake/src/base/UCovers.pas
index a1705674..6c7c9e48 100644
--- a/cmake/src/base/UCovers.pas
+++ b/cmake/src/base/UCovers.pas
@@ -50,7 +50,8 @@ uses
SysUtils,
Classes,
UImage,
- UTexture;
+ UTexture,
+ UPath;
type
ECoverDBException = class(Exception)
@@ -59,9 +60,9 @@ type
TCover = class
private
ID: int64;
- Filename: WideString;
+ Filename: IPath;
public
- constructor Create(ID: int64; Filename: WideString);
+ constructor Create(ID: int64; Filename: IPath);
function GetPreviewTexture(): TTexture;
function GetTexture(): TTexture;
end;
@@ -76,19 +77,19 @@ type
private
DB: TSQLiteDatabase;
procedure InitCoverDatabase();
- function CreateThumbnail(const Filename: WideString; var Info: TThumbnailInfo): PSDL_Surface;
+ function CreateThumbnail(const Filename: IPath; var Info: TThumbnailInfo): PSDL_Surface;
function LoadCover(CoverID: int64): TTexture;
procedure DeleteCover(CoverID: int64);
- function FindCoverIntern(const Filename: WideString): int64;
+ function FindCoverIntern(const Filename: IPath): 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 AddCover(const Filename: IPath): TCover;
+ function FindCover(const Filename: IPath): TCover;
+ function CoverExists(const Filename: IPath): boolean;
function GetMaxCoverSize(): integer;
procedure SetMaxCoverSize(Size: integer);
end;
@@ -111,7 +112,7 @@ uses
DateUtils;
const
- COVERDB_FILENAME = 'cover.db';
+ COVERDB_FILENAME: UTF8String = 'cover.db';
COVERDB_VERSION = 01; // 0.1
COVER_TBL = 'Cover';
COVER_THUMBNAIL_TBL = 'CoverThumbnail';
@@ -141,7 +142,7 @@ end;
{ TCover }
-constructor TCover.Create(ID: int64; Filename: WideString);
+constructor TCover.Create(ID: int64; Filename: IPath);
begin
Self.ID := ID;
Self.Filename := Filename;
@@ -210,11 +211,11 @@ end;
procedure TCoverDatabase.Open();
var
Version: integer;
- Filename: string;
+ Filename: IPath;
begin
- Filename := UTF8Encode(Platform.GetGameUserPath() + COVERDB_FILENAME);
+ Filename := Platform.GetGameUserPath().Append(COVERDB_FILENAME);
- DB := TSQLiteDatabase.Create(Filename);
+ DB := TSQLiteDatabase.Create(Filename.ToUTF8());
Version := GetVersion();
// check version, if version is too old/new, delete database file
@@ -223,10 +224,10 @@ 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);
+ if (not Filename.DeleteFile()) then
+ raise ECoverDBException.Create('Could not delete ' + Filename.ToNative);
// reopen
- DB := TSQLiteDatabase.Create(Filename);
+ DB := TSQLiteDatabase.Create(Filename.ToUTF8());
Version := 0;
end;
@@ -266,14 +267,14 @@ begin
')');
end;
-function TCoverDatabase.FindCoverIntern(const Filename: WideString): int64;
+function TCoverDatabase.FindCoverIntern(const Filename: IPath): int64;
begin
Result := DB.GetTableValue('SELECT [ID] FROM ['+COVER_TBL+'] ' +
'WHERE [Filename] = ?',
- [UTF8Encode(Filename)]);
+ [Filename.ToUTF8]);
end;
-function TCoverDatabase.FindCover(const Filename: WideString): TCover;
+function TCoverDatabase.FindCover(const Filename: IPath): TCover;
var
CoverID: int64;
begin
@@ -287,7 +288,7 @@ begin
end;
end;
-function TCoverDatabase.CoverExists(const Filename: WideString): boolean;
+function TCoverDatabase.CoverExists(const Filename: IPath): boolean;
begin
Result := false;
try
@@ -297,7 +298,7 @@ begin
end;
end;
-function TCoverDatabase.AddCover(const Filename: WideString): TCover;
+function TCoverDatabase.AddCover(const Filename: IPath): TCover;
var
CoverID: int64;
Thumbnail: PSDL_Surface;
@@ -329,7 +330,7 @@ begin
DB.ExecSQL('INSERT INTO ['+COVER_TBL+'] ' +
'([Filename], [Date], [Width], [Height]) VALUES' +
'(?, ?, ?, ?)',
- [UTF8Encode(Filename), DateTimeToUnixTime(FileDate),
+ [Filename.ToUTF8, DateTimeToUnixTime(FileDate),
Info.CoverWidth, Info.CoverHeight]);
// get auto-generated cover ID
@@ -358,7 +359,7 @@ var
PixelFmt: TImagePixelFmt;
Data: PChar;
DataSize: integer;
- Filename: WideString;
+ Filename: IPath;
Table: TSQLiteUniTable;
begin
Table := nil;
@@ -371,7 +372,7 @@ begin
'USING(ID) ' +
'WHERE [ID] = %d', [CoverID]));
- Filename := UTF8Decode(Table.FieldAsString(0));
+ Filename := Path(Table.FieldAsString(0));
PixelFmt := TImagePixelFmt(Table.FieldAsInteger(1));
Width := Table.FieldAsInteger(2);
Height := Table.FieldAsInteger(3);
@@ -384,6 +385,9 @@ begin
end
else
begin
+ // FillChar() does not decrement the ref-count of ref-counted fields
+ // -> reset Name field manually
+ Result.Name := nil;
FillChar(Result, SizeOf(TTexture), 0);
end;
except on E: Exception do
@@ -403,7 +407,7 @@ 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;
+function TCoverDatabase.CreateThumbnail(const Filename: IPath; var Info: TThumbnailInfo): PSDL_Surface;
var
//TargetAspect, SourceAspect: double;
//TargetWidth, TargetHeight: integer;
@@ -417,7 +421,7 @@ begin
Thumbnail := LoadImage(Filename);
if (not assigned(Thumbnail)) then
begin
- Log.LogError('Could not load cover: "'+ Filename +'"', 'TCoverDatabase.AddCover');
+ Log.LogError('Could not load cover: "'+ Filename.ToNative +'"', 'TCoverDatabase.AddCover');
Exit;
end;
diff --git a/cmake/src/base/UDLLManager.pas b/cmake/src/base/UDLLManager.pas
deleted file mode 100644
index 3faa15bf..00000000
--- a/cmake/src/base/UDLLManager.pas
+++ /dev/null
@@ -1,292 +0,0 @@
-{* UltraStar Deluxe - Karaoke Game
- *
- * UltraStar Deluxe is the legal property of its developers, whose names
- * are too numerous to list here. Please refer to the COPYRIGHT
- * file distributed with this source distribution.
- *
- * This program is free software; you can redistribute it and/or
- * modify it under the terms of the GNU General Public License
- * as published by the Free Software Foundation; either version 2
- * of the License, or (at your option) any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- * GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License
- * along with this program; see the file COPYING. If not, write to
- * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
- * Boston, MA 02110-1301, USA.
- *
- * $URL$
- * $Id$
- *}
-
-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
-{$IF Defined(MSWINDOWS)}
- DLLExt = '.dll';
-{$ELSEIF Defined(DARWIN)}
- DLLExt = '.dylib';
-{$ELSEIF Defined(UNIX)}
- DLLExt = '.so';
-{$IFEND}
-
-implementation
-
-uses
- {$IFDEF MSWINDOWS}
- windows,
- {$ELSE}
- dynlibs,
- {$ENDIF}
- UPath,
- ULog,
- SysUtils;
-
-
-constructor TDLLMan.Create;
-begin
- inherited;
- SetLength(Plugins, 0);
- SetLength(PluginPaths, Length(Plugins));
- GetPluginList;
-end;
-
-procedure TDLLMan.GetPluginList;
-var
- SearchRecord: TSearchRec;
-begin
-
- if FindFirst(PluginPath + '*' + DLLExt, faAnyFile, SearchRecord) = 0 then
- begin
- repeat
- SetLength(Plugins, Length(Plugins)+1);
- SetLength(PluginPaths, Length(Plugins));
-
- if LoadPluginInfo(SearchRecord.Name, High(Plugins)) then // loaded succesful
- begin
- PluginPaths[High(PluginPaths)] := SearchRecord.Name;
- end
- else // error loading
- begin
- SetLength(Plugins, Length(Plugins)-1);
- SetLength(PluginPaths, Length(Plugins));
- end;
-
- until FindNext(SearchRecord) <> 0;
- FindClose(SearchRecord);
- 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 := true;
- Plugins[No].ShowNotes := true;
- Plugins[No].LoadVideo := true;
- Plugins[No].LoadBack := true;
-
- Plugins[No].TeamModeOnly := true;
- Plugins[No].GetSoundData := true;
- Plugins[No].Dummy := true;
-
-
- Plugins[No].BGShowFull := true;
- Plugins[No].BGShowFull_O := true;
-
- Plugins[No].ShowRateBar := true;
- Plugins[No].ShowRateBar_O := true;
-
- Plugins[No].EnLineBonus := true;
- Plugins[No].EnLineBonus_O := true;
-end;
-
-function TDLLMan.LoadPluginInfo(Filename: string; No: cardinal): boolean;
-var
- hLibg: THandle;
- Info: pModi_PluginInfo;
-// I: integer;
-begin
- Result := true;
-// 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(PluginPath + 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 := true;
-// load libary
- hLib := LoadLibrary(PChar(PluginPath + PluginPaths[No]));
-// if loaded
- if (hLib <> 0) then
- begin
-// load info procedure
- @P_Init := GetProcAddress (hLib, 'Init');
- @P_Draw := GetProcAddress (hLib, 'Draw');
- @P_Finish := GetProcAddress (hLib, '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 := true
-end;
-
-function TDLLMan.PluginDraw (var Playerinfo: TPlayerinfo; const CurSentence: cardinal): boolean;
-begin
- if (@P_Draw <> nil) then
- Result := P_Draw (PlayerInfo, CurSentence)
- else
- Result := true
-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/cmake/src/base/UDataBase.pas b/cmake/src/base/UDataBase.pas
index 0f9d88a7..cccedc69 100644
--- a/cmake/src/base/UDataBase.pas
+++ b/cmake/src/base/UDataBase.pas
@@ -34,20 +34,22 @@ interface
{$I switches.inc}
uses
- USongs,
- USong,
Classes,
- SQLiteTable3;
+ SQLiteTable3,
+ UPath,
+ USong,
+ USongs,
+ UTextEncoding;
//--------------------
-//DataBaseSystem - Class including all DB Methods
+//DataBaseSystem - Class including all DB methods
//--------------------
type
TStatType = (
- stBestScores, // Best Scores
- stBestSingers, // Best Singers
- stMostSungSong, // Most sung Songs
- stMostPopBand // Most popular Band
+ stBestScores, // Best scores
+ stBestSingers, // Best singers
+ stMostSungSong, // Most sung songs
+ stMostPopBand // Most popular band
);
// abstract super-class for statistic results
@@ -58,54 +60,57 @@ type
TStatResultBestScores = class(TStatResult)
public
- Singer: WideString;
- Score: Word;
- Difficulty: Byte;
- SongArtist: WideString;
- SongTitle: WideString;
+ Singer: UTF8String;
+ Score: word;
+ Difficulty: byte;
+ SongArtist: UTF8String;
+ SongTitle: UTF8String;
+ Date: UTF8String;
end;
TStatResultBestSingers = class(TStatResult)
public
- Player: WideString;
- AverageScore: Word;
+ Player: UTF8String;
+ AverageScore: word;
end;
TStatResultMostSungSong = class(TStatResult)
public
- Artist: WideString;
- Title: WideString;
- TimesSung: Word;
+ Artist: UTF8String;
+ Title: UTF8String;
+ TimesSung: word;
end;
TStatResultMostPopBand = class(TStatResult)
public
- ArtistName: WideString;
- TimesSungTot: Word;
+ ArtistName: UTF8String;
+ TimesSungTot: word;
end;
-
+
TDataBaseSystem = class
private
- ScoreDB: TSQLiteDatabase;
- fFilename: string;
+ ScoreDB: TSQLiteDatabase;
+ fFilename: IPath;
function GetVersion(): integer;
procedure SetVersion(Version: integer);
public
- property Filename: string read fFilename;
+ property Filename: IPath read fFilename;
destructor Destroy; override;
- procedure Init(const Filename: string);
+ procedure Init(const Filename: IPath);
+ procedure ConvertFrom101To110();
procedure ReadScore(Song: TSong);
- procedure AddScore(Song: TSong; Level: integer; const Name: WideString; Score: integer);
+ procedure AddScore(Song: TSong; Level: integer; const Name: UTF8String; Score: integer);
procedure WriteScore(Song: TSong);
- function GetStats(Typ: TStatType; Count: Byte; Page: Cardinal; Reversed: Boolean): TList;
+ function GetStats(Typ: TStatType; Count: byte; Page: cardinal; Reversed: boolean): TList;
procedure FreeStats(StatList: TList);
- function GetTotalEntrys(Typ: TStatType): Cardinal;
+ function GetTotalEntrys(Typ: TStatType): cardinal;
function GetStatReset: TDateTime;
+ function FormatDate(time_stamp: integer): UTF8String;
end;
var
@@ -114,53 +119,72 @@ var
implementation
uses
- ULog,
DateUtils,
+ ULanguage,
StrUtils,
- SysUtils;
-
+ SysUtils,
+ ULog;
+
+{
+ cDBVersion - history
+ 0 = USDX 1.01 or no Database
+ 01 = USDX 1.1
+}
const
cDBVersion = 01; // 0.1
cUS_Scores = 'us_scores';
cUS_Songs = 'us_songs';
- cUS_Statistics_Info = 'us_statistics_info';
+ cUS_Statistics_Info = 'us_statistics_info';
(**
- * Opens Database and Create Tables if not Exist
+ * Open database and create tables if they do not exist
*)
-procedure TDataBaseSystem.Init(const Filename: string);
+procedure TDataBaseSystem.Init(const Filename: IPath);
var
- Version: integer;
+ Version: integer;
+ finalizeConversion: boolean;
begin
if Assigned(ScoreDB) then
Exit;
- Log.LogStatus('Initializing database: "'+Filename+'"', 'TDataBaseSystem.Init');
+ Log.LogStatus('Initializing database: "' + Filename.ToNative + '"', 'TDataBaseSystem.Init');
try
-
- // Open Database
- ScoreDB := TSQLiteDatabase.Create(Filename);
+
+ // open database
+ ScoreDB := TSQLiteDatabase.Create(Filename.ToUTF8);
fFilename := Filename;
- // Close and delete outdated file
Version := GetVersion();
- if ((Version <> 0) and (Version <> cDBVersion)) then
+
+ // add Table cUS_Statistics_Info
+ // needed in the conversion from 1.01 to 1.1
+ if not ScoreDB.TableExists(cUS_Statistics_Info) 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;
+ Log.LogInfo('Outdated song database found - missing table"' + cUS_Statistics_Info + '"', 'TDataBaseSystem.Init');
+ 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;
-
+
+ // convert data from 1.01 to 1.1
+ // part #1 - prearrangement
+ finalizeConversion := false;
+ if (Version = 0) AND ScoreDB.TableExists('US_Scores') then
+ begin
+ // rename old tables - to be able to insert new table structures
+ ScoreDB.ExecSQL('ALTER TABLE US_Scores RENAME TO us_scores_101;');
+ ScoreDB.ExecSQL('ALTER TABLE US_Songs RENAME TO us_songs_101;');
+ finalizeConversion := true; // means: conversion has to be done!
+ 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,
@@ -169,30 +193,44 @@ begin
// 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+'] (' +
+ 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' +
+ '[Score] INTEGER NOT NULL, ' +
+ '[Date] INTEGER NULL' +
');');
- ScoreDB.ExecSQL('CREATE TABLE IF NOT EXISTS ['+cUS_Songs+'] (' +
+ 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' +
+ '[TimesPlayed] INTEGER NOT NULL, ' +
+ '[Rating] INTEGER NULL' +
');');
- if not ScoreDB.TableExists(cUS_Statistics_Info) then
+ //add column date to cUS-Scores
+ if not ScoreDB.ContainsColumn(cUS_Scores, 'Date') 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())]));
+ Log.LogInfo('adding column date to "' + cUS_Scores + '"', 'TDataBaseSystem.Init');
+ ScoreDB.ExecSQL('ALTER TABLE ' + cUS_Scores + ' ADD COLUMN [Date] INTEGER NULL');
+ end;
+
+ // add column rating to cUS_Songs
+ // just for users of nightly builds and developers!
+ if not ScoreDB.ContainsColumn(cUS_Songs, 'Rating') then
+ begin
+ Log.LogInfo('Outdated song database found - adding column rating to "' + cUS_Songs + '"', 'TDataBaseSystem.Init');
+ ScoreDB.ExecSQL('ALTER TABLE ' + cUS_Songs + ' ADD COLUMN [Rating] INTEGER NULL');
+ end;
+
+ // convert data from previous versions
+ // part #2 - accomplishment
+ if finalizeConversion then
+ begin
+ //convert data from 1.01 to 1.1
+ if ScoreDB.TableExists('us_scores_101') then
+ ConvertFrom101To110();
end;
except
@@ -205,6 +243,115 @@ begin
end;
+(**
+ * Convert Database from 1.01 to 1.1
+ *)
+procedure TDataBaseSystem.ConvertFrom101To110();
+var
+ TableData: TSQLiteUniTable;
+ tempUTF8String: UTF8String;
+begin
+ if not ScoreDB.ContainsColumn('us_scores_101', 'Date') then
+ begin
+ Log.LogInfo(
+ 'Outdated song database found - ' +
+ 'begin conversion from V1.01 to V1.1', 'TDataBaseSystem.Convert101To110');
+
+ // insert old values into new db-schemes (/tables)
+ ScoreDB.ExecSQL(
+ 'INSERT INTO ' + cUS_Scores +
+ ' SELECT SongID, Difficulty, Player, Score FROM us_scores_101;');
+ end else
+ begin
+ Log.LogInfo(
+ 'Outdated song database found - ' +
+ 'begin conversion from V1.01 Challenge Mod to V1.1', 'TDataBaseSystem.Convert101To110');
+
+ // insert old values into new db-schemes (/tables)
+ ScoreDB.ExecSQL(
+ 'INSERT INTO ' + cUS_Scores +
+ ' SELECT SongID, Difficulty, Player, Score, Date FROM us_scores_101;');
+ end;
+
+ ScoreDB.ExecSQL(
+ 'INSERT INTO ' + cUS_Songs +
+ ' SELECT ID, Artist, Title, TimesPlayed, ''NULL'' FROM us_songs_101;');
+
+ // now we have to convert all the texts for unicode support:
+
+ // player names
+ TableData := nil;
+ try
+ TableData := ScoreDB.GetUniTable(
+ 'SELECT [rowid], [Player] ' +
+ 'FROM [' + cUS_Scores + '];');
+
+ // Go through all Entrys
+ while (not TableData.EOF) do
+ begin
+ // Convert name into UTF8 and alter all entrys
+ DecodeStringUTF8(TableData.FieldByName['Player'], tempUTF8String, encCP1252);
+ ScoreDB.ExecSQL(
+ 'UPDATE [' + cUS_Scores + '] ' +
+ 'SET [Player] = ? ' +
+ 'WHERE [rowid] = ? ',
+ [tempUTF8String,
+ TableData.FieldAsInteger(TableData.FieldIndex['rowid'])]);
+
+ TableData.Next;
+ end; // while
+
+ except
+ on E: Exception do
+ Log.LogError(E.Message, 'TDataBaseSystem.Convert101To110');
+ end;
+
+ TableData.Free;
+
+ // song artist and song title
+ TableData := nil;
+ try
+ TableData := ScoreDB.GetUniTable(
+ 'SELECT [ID], [Artist], [Title] ' +
+ 'FROM [' + cUS_Songs + '];');
+
+ // Go through all Entrys
+ while (not TableData.EOF) do
+ begin
+ // Convert Artist into UTF8 and alter all entrys
+ DecodeStringUTF8(TableData.FieldByName['Artist'], tempUTF8String, encCP1252);
+ //Log.LogError(TableData.FieldByName['Artist']+' -> '+tempUTF8String+' (encCP1252)');
+ ScoreDB.ExecSQL(
+ 'UPDATE [' + cUS_Songs + '] ' +
+ 'SET [Artist] = ? ' +
+ 'WHERE [ID] = ?',
+ [tempUTF8String,
+ TableData.FieldAsInteger(TableData.FieldIndex['ID'])]);
+
+ // Convert Title into UTF8 and alter all entrys
+ DecodeStringUTF8(TableData.FieldByName['Title'], tempUTF8String, encCP1252);
+ ScoreDB.ExecSQL(
+ 'UPDATE [' + cUS_Songs + '] ' +
+ 'SET [Title] = ? ' +
+ 'WHERE [ID] = ? ',
+ [tempUTF8String,
+ TableData.FieldAsInteger(TableData.FieldIndex['ID'])]);
+
+ TableData.Next;
+ end; // while
+
+ except
+ on E: Exception do
+ Log.LogError(E.Message, 'TDataBaseSystem.Convert101To110');
+ end;
+
+ TableData.Free;
+
+ //now drop old tables
+ ScoreDB.ExecSQL('DROP TABLE us_scores_101;');
+ ScoreDB.ExecSQL('DROP TABLE us_songs_101;');
+end;
+
(**
* Frees Database
*)
@@ -215,34 +362,56 @@ begin
inherited;
end;
+(**
+ * Format a UNIX-Timestamp into DATE (If 0 then '')
+ *)
+function TDataBaseSystem.FormatDate(time_stamp: integer): UTF8String;
+var
+ Year, Month, Day: word;
+begin
+ Result:='';
+ try
+ if time_stamp<>0 then
+ begin
+ DecodeDate(UnixToDateTime(time_stamp), Year, Month, Day);
+ Result := Format(Language.Translate('STAT_FORMAT_DATE'), [Day, Month, Year]);
+ end;
+ except
+ on E: EConvertError do
+ Log.LogError('Error Parsing FormatString "STAT_FORMAT_DATE": ' + E.Message);
+ end;
+end;
+
+
(**
* Read Scores into SongArray
*)
procedure TDataBaseSystem.ReadScore(Song: TSong);
var
- TableData: TSQLiteUniTable;
- Difficulty: Integer;
+ TableData: TSQLiteUniTable;
+ Difficulty: integer;
+ I: integer;
+ PlayerListed: boolean;
begin
if not Assigned(ScoreDB) then
Exit;
TableData := nil;
-
try
// Search Song in DB
TableData := ScoreDB.GetUniTable(
- 'SELECT [Difficulty], [Player], [Score] FROM ['+cUS_Scores+'] ' +
+ 'SELECT [Difficulty], [Player], [Score], [Date] FROM [' + cUS_Scores + '] ' +
'WHERE [SongID] = (' +
- 'SELECT [ID] FROM ['+cUS_Songs+'] ' +
+ 'SELECT [ID] FROM [' + cUS_Songs + '] ' +
'WHERE [Artist] = ? AND [Title] = ? ' +
'LIMIT 1) ' +
- 'ORDER BY [Score] DESC LIMIT 15',
- [UTF8Encode(Song.Artist), UTF8Encode(Song.Title)]);
+ 'ORDER BY [Score] DESC;', //no LIMIT! see filter below!
+ [Song.Artist, Song.Title]);
// Empty Old Scores
- SetLength(Song.Score[0], 0);
- SetLength(Song.Score[1], 0);
- SetLength(Song.Score[2], 0);
+ SetLength(Song.Score[0], 0); //easy
+ SetLength(Song.Score[1], 0); //medium
+ SetLength(Song.Score[2], 0); //hard
// Go through all Entrys
while (not TableData.EOF) do
@@ -252,12 +421,31 @@ begin
if ((Difficulty >= 0) and (Difficulty <= 2)) and
(Length(Song.Score[Difficulty]) < 5) then
begin
- SetLength(Song.Score[Difficulty], Length(Song.Score[Difficulty]) + 1);
+ //filter player
+ PlayerListed:=false;
+ if (Length(Song.Score[Difficulty])>0) then
+ begin
+ for I := 0 to Length(Song.Score[Difficulty]) - 1 do
+ begin
+ if (Song.Score[Difficulty, I].Name = TableData.FieldByName['Player']) then
+ begin
+ PlayerListed:=true;
+ break;
+ end;
+ end;
+ end;
+
+ if not PlayerListed 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 :=
+ Song.Score[Difficulty, High(Song.Score[Difficulty])].Name :=
+ TableData.FieldByName['Player'];
+ Song.Score[Difficulty, High(Song.Score[Difficulty])].Score :=
TableData.FieldAsInteger(TableData.FieldIndex['Score']);
+ Song.Score[Difficulty, High(Song.Score[Difficulty])].Date :=
+ FormatDate(TableData.FieldAsInteger(TableData.FieldIndex['Date']));
+ end;
end;
TableData.Next;
@@ -277,70 +465,43 @@ end;
(**
* Adds one new score to DB
*)
-procedure TDataBaseSystem.AddScore(Song: TSong; Level: integer; const Name: WideString; Score: integer);
+procedure TDataBaseSystem.AddScore(Song: TSong; Level: integer; const Name: UTF8String; Score: integer);
var
- ID: Integer;
+ ID: integer;
TableData: TSQLiteTable;
begin
if not Assigned(ScoreDB) then
Exit;
- // Prevent 0 Scores from being added
- if (Score <= 0) then
- Exit;
+ // Prevent 0 Scores from being added EDIT: ==> UScreenTop5.pas!
+ //if (Score <= 0) then
+ // Exit;
TableData := nil;
try
ID := ScoreDB.GetTableValue(
- 'SELECT [ID] FROM ['+cUS_Songs+'] ' +
+ 'SELECT [ID] FROM [' + cUS_Songs + '] ' +
'WHERE [Artist] = ? AND [Title] = ?',
- [UTF8Encode(Song.Artist), UTF8Encode(Song.Title)]);
+ [Song.Artist, Song.Title]);
if (ID = 0) then
begin
// Create song if it does not exist
ScoreDB.ExecSQL(
- 'INSERT INTO ['+cUS_Songs+'] ' +
+ 'INSERT INTO [' + cUS_Songs + '] ' +
'([ID], [Artist], [Title], [TimesPlayed]) VALUES ' +
'(NULL, ?, ?, 0);',
- [UTF8Encode(Song.Artist), UTF8Encode(Song.Title)]);
+ [Song.Artist, 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;
+ 'INSERT INTO [' + cUS_Scores + '] ' +
+ '([SongID] ,[Difficulty], [Player], [Score], [Date]) VALUES ' +
+ '(?, ?, ?, ?, ?);',
+ [ID, Level, Name, Score, DateTimeToUnix(Now())]);
except on E: Exception do
Log.LogError(E.Message, 'TDataBaseSystem.AddScore');
@@ -350,21 +511,21 @@ begin
end;
(**
- * Not needed with new System.
- * Used for increment played count
+ * Not needed with new system.
+ * Used to increment played count
*)
procedure TDataBaseSystem.WriteScore(Song: TSong);
begin
if not Assigned(ScoreDB) then
Exit;
-
+
try
// Increase TimesPlayed
ScoreDB.ExecSQL(
- 'UPDATE ['+cUS_Songs+'] ' +
+ 'UPDATE [' + cUS_Songs + '] ' +
'SET [TimesPlayed] = [TimesPlayed] + 1 ' +
'WHERE [Title] = ? AND [Artist] = ?;',
- [UTF8Encode(Song.Title), UTF8Encode(Song.Artist)]);
+ [Song.Title, Song.Artist]);
except on E: Exception do
Log.LogError(E.Message, 'TDataBaseSystem.WriteScore');
end;
@@ -376,11 +537,11 @@ end;
* 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;
+function TDataBaseSystem.GetStats(Typ: TStatType; Count: byte; Page: cardinal; Reversed: boolean): TList;
var
- Query: String;
+ Query: string;
TableData: TSQLiteUniTable;
- Stat: TStatResult;
+ Stat: TStatResult;
begin
Result := nil;
@@ -392,19 +553,19 @@ begin
// 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]';
+ Query := 'SELECT [Player], [Difficulty], [Score], [Artist], [Title], [Date] 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+'] ' +
+ 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+'] ' +
+ Query := 'SELECT [Artist], [Title], [TimesPlayed] FROM [' + cUS_Songs + '] ' +
'ORDER BY [TimesPlayed]';
end;
stMostPopBand: begin
- Query := 'SELECT [Artist], SUM([TimesPlayed]) FROM ['+cUS_Songs+'] ' +
+ Query := 'SELECT [Artist], SUM([TimesPlayed]) FROM [' + cUS_Songs + '] ' +
'GROUP BY [Artist] ORDER BY SUM([TimesPlayed])';
end;
end;
@@ -437,18 +598,19 @@ begin
Stat := TStatResultBestScores.Create;
with TStatResultBestScores(Stat) do
begin
- Singer := UTF8Decode(TableData.Fields[0]);
+ Singer := TableData.Fields[0];
Difficulty := TableData.FieldAsInteger(1);
Score := TableData.FieldAsInteger(2);
- SongArtist := UTF8Decode(TableData.Fields[3]);
- SongTitle := UTF8Decode(TableData.Fields[4]);
+ SongArtist := TableData.Fields[3];
+ SongTitle := TableData.Fields[4];
+ Date := FormatDate(TableData.FieldAsInteger(5));
end;
end;
stBestSingers: begin
Stat := TStatResultBestSingers.Create;
with TStatResultBestSingers(Stat) do
begin
- Player := UTF8Decode(TableData.Fields[0]);
+ Player := TableData.Fields[0];
AverageScore := TableData.FieldAsInteger(1);
end;
end;
@@ -456,8 +618,8 @@ begin
Stat := TStatResultMostSungSong.Create;
with TStatResultMostSungSong(Stat) do
begin
- Artist := UTF8Decode(TableData.Fields[0]);
- Title := UTF8Decode(TableData.Fields[1]);
+ Artist := TableData.Fields[0];
+ Title := TableData.Fields[1];
TimesSung := TableData.FieldAsInteger(2);
end;
end;
@@ -465,7 +627,7 @@ begin
Stat := TStatResultMostPopBand.Create;
with TStatResultMostPopBand(Stat) do
begin
- ArtistName := UTF8Decode(TableData.Fields[0]);
+ ArtistName := TableData.Fields[0];
TimesSungTot := TableData.FieldAsInteger(1);
end;
end
@@ -484,21 +646,21 @@ end;
procedure TDataBaseSystem.FreeStats(StatList: TList);
var
- I: integer;
+ Index: integer;
begin
if (StatList = nil) then
Exit;
- for I := 0 to StatList.Count-1 do
- TStatResult(StatList[I]).Free;
+ for Index := 0 to StatList.Count-1 do
+ TStatResult(StatList[Index]).Free;
StatList.Free;
end;
(**
* Gets total number of entrys for a stats query
*)
-function TDataBaseSystem.GetTotalEntrys(Typ: TStatType): Cardinal;
+function TDataBaseSystem.GetTotalEntrys(Typ: TStatType): cardinal;
var
- Query: String;
+ Query: string;
begin
Result := 0;
@@ -509,13 +671,13 @@ begin
// Create query
case Typ of
stBestScores:
- Query := 'SELECT COUNT([SongID]) FROM ['+cUS_Scores+'];';
+ Query := 'SELECT COUNT([SongID]) FROM [' + cUS_Scores + '];';
stBestSingers:
- Query := 'SELECT COUNT(DISTINCT [Player]) FROM ['+cUS_Scores+'];';
+ Query := 'SELECT COUNT(DISTINCT [Player]) FROM [' + cUS_Scores + '];';
stMostSungSong:
- Query := 'SELECT COUNT([ID]) FROM ['+cUS_Songs+'];';
+ Query := 'SELECT COUNT([ID]) FROM [' + cUS_Songs + '];';
stMostPopBand:
- Query := 'SELECT COUNT(DISTINCT [Artist]) FROM ['+cUS_Songs+'];';
+ Query := 'SELECT COUNT(DISTINCT [Artist]) FROM [' + cUS_Songs + '];';
end;
Result := ScoreDB.GetTableValue(Query);
@@ -538,7 +700,7 @@ begin
Exit;
try
- Query := 'SELECT [ResetTime] FROM ['+cUS_Statistics_Info+'];';
+ Query := 'SELECT [ResetTime] FROM [' + cUS_Statistics_Info + '];';
Result := UnixToDateTime(ScoreDB.GetTableValue(Query));
except on E: Exception do
Log.LogError(E.Message, 'TDataBaseSystem.GetStatReset');
diff --git a/cmake/src/base/UDraw.pas b/cmake/src/base/UDraw.pas
index 1783986f..308526b8 100644
--- a/cmake/src/base/UDraw.pas
+++ b/cmake/src/base/UDraw.pas
@@ -35,11 +35,9 @@ interface
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);
@@ -86,7 +84,6 @@ uses
Math,
gl,
TextGL,
- UDLLManager,
UDrawTexture,
UGraphic,
UIni,
@@ -96,7 +93,6 @@ uses
UMusic,
URecord,
UScreenSing,
- UScreenSingModi,
UTexture;
procedure SingDrawBackground;
@@ -258,19 +254,21 @@ begin
// 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
+ if (ScreenSing.settings.NotesVisible and (1 shl NrLines) <> 0) then
+ begin
- PlayerNumber := NrLines + 1; // Player 1 is 0
- NrLines := 0;
+ PlayerNumber := NrLines + 1; // Player 1 is 0
+ NrLines := 0;
-// exploit done
+ // exploit done
- glColor3f(1, 1, 1);
- glEnable(GL_TEXTURE_2D);
- glEnable(GL_BLEND);
- glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
+ 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);
+ 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
TempR := lTmpA / lTmpB
@@ -285,16 +283,17 @@ begin
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
+
+ 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
+ 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
// left part
Rec.Left := (Start-Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start) * TempR + Left + 0.5 + 10*ScreenX;
@@ -309,35 +308,35 @@ begin
glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top);
glEnd;
- //We keep the postion of the top left corner b4 it's overwritten
+ //We keep the postion of the top left corner b4 it's overwritten
GoldenStarPos := Rec.Left;
- //done
+ //done
- // 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;
+ // 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_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;
+ 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;
// 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;
+ 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
@@ -345,13 +344,14 @@ begin
GoldenRec.SaveGoldenStarsRec(GoldenStarPos, Rec.Top, Rec.Right, Rec.Bottom);
end;
- end; // if not FreeStyle
- end; // with
- end; // for
- end; // with
+ end; // if not FreeStyle
+ end; // with
+ end; // for
+ end; // with
- glDisable(GL_BLEND);
- glDisable(GL_TEXTURE_2D);
+ glDisable(GL_BLEND);
+ glDisable(GL_TEXTURE_2D);
+ end;
end;
// draw sung notes
@@ -481,7 +481,7 @@ var
W, H: real;
lTmpA, lTmpB: real;
begin
- if (Player[PlayerIndex].ScoreTotalInt >= 0) then
+ if (ScreenSing.settings.NotesVisible and (1 shl PlayerIndex) <> 0) then
begin
glColor4f(1, 1, 1, sqrt((1+sin( AudioPlayback.Position * 3))/4)/ 2 + 0.5 );
glEnable(GL_TEXTURE_2D);
@@ -683,20 +683,25 @@ begin
// draw note-lines
- if (PlayersPlay = 1) and (Ini.NoteLines = 1) then
+ // to-do : needs fix when party mode works w/ 2 screens
+ if (PlayersPlay = 1) and (Ini.NoteLines = 1) and (ScreenSing.settings.NotesVisible and (1) <> 0) 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);
+ if (ScreenSing.settings.NotesVisible and (1 shl 0) <> 0) then
+ SingDrawNoteLines(Nr.Left + 10*ScreenX, Skin_P1_NotesB - 105, Nr.Right + 10*ScreenX, 15);
+ if (ScreenSing.settings.NotesVisible and (1 shl 1) <> 0) then
+ 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);
+ if ((PlayersPlay = 3) or (PlayersPlay = 6)) and (Ini.NoteLines = 1) then begin
+ if (ScreenSing.settings.NotesVisible and (1 shl 0) <> 0) then
+ SingDrawNoteLines(Nr.Left + 10*ScreenX, 120, Nr.Right + 10*ScreenX, 12);
+ if (ScreenSing.settings.NotesVisible and (1 shl 1) <> 0) then
+ SingDrawNoteLines(Nr.Left + 10*ScreenX, 245, Nr.Right + 10*ScreenX, 12);
+ if (ScreenSing.settings.NotesVisible and (1 shl 2) <> 0) then
+ SingDrawNoteLines(Nr.Left + 10*ScreenX, 370, Nr.Right + 10*ScreenX, 12);
end;
// draw Lyrics
@@ -895,259 +900,6 @@ begin
glDisable(GL_TEXTURE_2D);
end;
-// q'n'd for using the game mode dll's
-procedure SingModiDraw (PlayerInfo: TPlayerInfo);
-var
- NR: TRecR;
-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 helper
-
- // 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
diff --git a/cmake/src/base/UEditorLyrics.pas b/cmake/src/base/UEditorLyrics.pas
index ef9d8dd6..0eacd1f9 100644
--- a/cmake/src/base/UEditorLyrics.pas
+++ b/cmake/src/base/UEditorLyrics.pas
@@ -74,7 +74,7 @@ type
procedure SetSize(Value: real);
procedure SetSelected(Value: integer);
procedure SetFontStyle(Value: integer);
- procedure AddWord(Text: string);
+ procedure AddWord(Text: UTF8String);
procedure Refresh;
public
ColR: real;
@@ -179,7 +179,7 @@ begin
FontStyleI := Value;
end;
-procedure TEditorLyrics.AddWord(Text: string);
+procedure TEditorLyrics.AddWord(Text: UTF8String);
var
WordNum: integer;
begin
diff --git a/cmake/src/base/UFiles.pas b/cmake/src/base/UFiles.pas
index 0495dfbb..5a258e3e 100644
--- a/cmake/src/base/UFiles.pas
+++ b/cmake/src/base/UFiles.pas
@@ -34,24 +34,23 @@ interface
uses
SysUtils,
+ Classes,
ULog,
UMusic,
USongs,
- USong;
+ USong,
+ UPath;
procedure ResetSingTemp;
-function SaveSong(Song: TSong; Lines: TLines; Name: string; Relative: boolean): boolean;
+type
+ TSaveSongResult = (ssrOK, ssrFileError, ssrEncodingError);
-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;
+{**
+ * Throws a TEncodingException if the song's fields cannot be encoded in the
+ * requested encoding.
+ *}
+function SaveSong(const Song: TSong; const Lines: TLines; const Name: IPath; Relative: boolean): TSaveSongResult;
implementation
@@ -59,7 +58,9 @@ uses
TextGL,
UIni,
UNote,
- UPlatform;
+ UPlatform,
+ UUnicodeUtils,
+ UTextEncoding;
//--------------------
// Resets the temporary Sentence Arrays for each Player and some other Variables
@@ -77,101 +78,135 @@ begin
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;
+function SaveSong(const Song: TSong; const Lines: TLines; const Name: IPath; Relative: boolean): TSaveSongResult;
var
C: integer;
N: integer;
- S: string;
+ S: AnsiString;
B: integer;
- RelativeSubTime: integer;
- NoteState: String;
+ RelativeSubTime: integer;
+ NoteState: AnsiString;
+ SongFile: TTextFileStream;
-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;
+ function EncodeToken(const Str: UTF8String): RawByteString;
+ var
+ Success: boolean;
+ begin
+ Success := EncodeStringUTF8(Str, Result, Song.Encoding);
+ if (not Success) then
+ SaveSong := ssrEncodingError;
+ end;
- end; // C
+ procedure WriteCustomTags;
+ var
+ I: integer;
+ Line: RawByteString;
+ begin
+ for I := 0 to High(Song.CustomTags) do
+ begin
+ Line := EncodeToken(Song.CustomTags[I].Content);
+ if (Length(Song.CustomTags[I].Tag) > 0) then
+ Line := EncodeToken(Song.CustomTags[I].Tag) + ':' + Line;
+ SongFile.WriteLine('#' + Line);
+ end;
- Writeln(SongFile, 'E');
- CloseFile(SongFile);
+ end;
- Result := true;
+begin
+ // Relative := true; // override (idea - use shift+S to save with relative)
+ Result := ssrOK;
+
+ try
+ SongFile := TMemTextFileStream.Create(Name, fmCreate);
+ try
+ // to-do: should we really write the BOM?
+ // it causes problems w/ older versions
+ // e.g. usdx 1.0.1a or ultrastar < 0.7.0
+ if (Song.Encoding = encUTF8) then
+ SongFile.WriteString(UTF8_BOM);
+
+ SongFile.WriteLine('#ENCODING:' + EncodingName(Song.Encoding));
+ SongFile.WriteLine('#TITLE:' + EncodeToken(Song.Title));
+ SongFile.WriteLine('#ARTIST:' + EncodeToken(Song.Artist));
+
+ if Song.Creator <> '' then SongFile.WriteLine('#CREATOR:' + EncodeToken(Song.Creator));
+ if Song.Edition <> 'Unknown' then SongFile.WriteLine('#EDITION:' + EncodeToken(Song.Edition));
+ if Song.Genre <> 'Unknown' then SongFile.WriteLine('#GENRE:' + EncodeToken(Song.Genre));
+ if Song.Language <> 'Unknown' then SongFile.WriteLine('#LANGUAGE:' + EncodeToken(Song.Language));
+ if Song.Year <> 0 then SongFile.WriteLine('#YEAR:' + IntToStr(Song.Year));
+
+ SongFile.WriteLine('#MP3:' + EncodeToken(Song.Mp3.ToUTF8));
+ if Song.Cover.IsSet then SongFile.WriteLine('#COVER:' + EncodeToken(Song.Cover.ToUTF8));
+ if Song.Background.IsSet then SongFile.WriteLine('#BACKGROUND:' + EncodeToken(Song.Background.ToUTF8));
+ if Song.Video.IsSet then SongFile.WriteLine('#VIDEO:' + EncodeToken(Song.Video.ToUTF8));
+
+ if Song.VideoGAP <> 0 then SongFile.WriteLine('#VIDEOGAP:' + FloatToStr(Song.VideoGAP));
+ if Song.Resolution <> 4 then SongFile.WriteLine('#RESOLUTION:' + IntToStr(Song.Resolution));
+ if Song.NotesGAP <> 0 then SongFile.WriteLine('#NOTESGAP:' + IntToStr(Song.NotesGAP));
+ if Song.Start <> 0 then SongFile.WriteLine('#START:' + FloatToStr(Song.Start));
+ if Song.Finish <> 0 then SongFile.WriteLine('#END:' + IntToStr(Song.Finish));
+ if Relative then SongFile.WriteLine('#RELATIVE:yes');
+
+ SongFile.WriteLine('#BPM:' + FloatToStr(Song.BPM[0].BPM / 4));
+ SongFile.WriteLine('#GAP:' + FloatToStr(Song.GAP));
+
+ // write custom header tags
+ WriteCustomTags;
+
+ RelativeSubTime := 0;
+ for B := 1 to High(Song.BPM) do
+ SongFile.WriteLine('B ' + FloatToStr(Song.BPM[B].StartBeat) + ' '
+ + FloatToStr(Song.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) + ' '
+ + EncodeToken(Text);
+
+ SongFile.WriteLine(S);
+ end; // with
+ end; // N
+
+ if C < Lines.High then // don't write end of last sentence
+ begin
+ 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;
+ SongFile.WriteLine(S);
+ end;
+ end; // C
+
+ SongFile.WriteLine('E');
+ finally
+ SongFile.Free;
+ end;
+ except
+ Result := ssrFileError;
+ end;
end;
end.
+
diff --git a/cmake/src/base/UFilesystem.pas b/cmake/src/base/UFilesystem.pas
new file mode 100644
index 00000000..805bcfe5
--- /dev/null
+++ b/cmake/src/base/UFilesystem.pas
@@ -0,0 +1,692 @@
+{* UltraStar Deluxe - Karaoke Game
+ *
+ * UltraStar Deluxe is the legal property of its developers, whose names
+ * are too numerous to list here. Please refer to the COPYRIGHT
+ * file distributed with this source distribution.
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; see the file COPYING. If not, write to
+ * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+ * Boston, MA 02110-1301, USA.
+ *
+ * $URL$
+ * $Id$
+ *}
+
+unit UFilesystem;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+uses
+ SysUtils,
+ Classes,
+ {$IFDEF MSWINDOWS}
+ Windows,
+ TntSysUtils,
+ {$ENDIF}
+ UPath;
+
+type
+ {$IFDEF MSWINDOWS}
+ TSytemSearchRec = TSearchRecW;
+ {$ELSE}
+ TSytemSearchRec = TSearchRec;
+ {$ENDIF}
+
+ TFileInfo = record
+ Time: integer; // timestamp
+ Size: int64; // file size (byte)
+ Attr: integer; // file attributes
+ Name: IPath; // basename with extension
+ end;
+
+ {**
+ * Iterates through the search results retrieved by FileFind().
+ * Example usage:
+ * while(Iter.HasNext()) do
+ * SearchRec := Iter.Next();
+ *}
+ IFileIterator = interface
+ function HasNext(): boolean;
+ function Next(): TFileInfo;
+ end;
+
+ {**
+ * Wrapper for SysUtils file functions.
+ * For documentation and examples, check the SysUtils equivalent.
+ *}
+ IFileSystem = interface
+ function ExpandFileName(const FileName: IPath): IPath;
+ function FileCreate(const FileName: IPath): TFileHandle;
+ function DirectoryCreate(const Dir: IPath): boolean;
+ function FileOpen(const FileName: IPath; Mode: longword): TFileHandle;
+ function FileAge(const FileName: IPath): integer; overload;
+ function FileAge(const FileName: IPath; out FileDateTime: TDateTime): boolean; overload;
+
+ function DirectoryExists(const Name: IPath): boolean;
+
+ {**
+ * On Windows: returns true only for files (not directories)
+ * On Apple/Unix: returns true for all kind of files (even directories)
+ * @seealso SysUtils.FileExists()
+ *}
+ function FileExists(const Name: IPath): boolean;
+
+ function FileGetAttr(const FileName: IPath): Cardinal;
+ function FileSetAttr(const FileName: IPath; Attr: integer): boolean;
+ function FileIsReadOnly(const FileName: IPath): boolean;
+ function FileSetReadOnly(const FileName: IPath; ReadOnly: boolean): boolean;
+ function FileIsAbsolute(const FileName: IPath): boolean;
+ function ForceDirectories(const Dir: IPath): boolean;
+ function RenameFile(const OldName, NewName: IPath): boolean;
+ function DeleteFile(const FileName: IPath): boolean;
+ function RemoveDir(const Dir: IPath): boolean;
+
+ {**
+ * Copies file Source to Target. If FailIfExists is true, the file is not
+ * copied if it already exists.
+ * Returns true if the file was successfully copied.
+ *}
+ function CopyFile(const Source, Target: IPath; FailIfExists: boolean): boolean;
+
+ function ExtractFileDrive(const FileName: IPath): IPath;
+ function ExtractFilePath(const FileName: IPath): IPath;
+ function ExtractFileDir(const FileName: IPath): IPath;
+ function ExtractFileName(const FileName: IPath): IPath;
+ function ExtractFileExt(const FileName: IPath): IPath;
+ function ExtractRelativePath(const BaseName: IPath; const FileName: IPath): IPath;
+
+ function ChangeFileExt(const FileName: IPath; const Extension: IPath): IPath;
+
+ function IncludeTrailingPathDelimiter(const FileName: IPath): IPath;
+ function ExcludeTrailingPathDelimiter(const FileName: IPath): IPath;
+
+ {**
+ * Searches for a file with filename Name in the directories given in DirList.
+ *}
+ function FileSearch(const Name: IPath; DirList: array of IPath): IPath;
+
+ {**
+ * More convenient version of FindFirst/Next/Close with iterator support.
+ *}
+ function FileFind(const FilePattern: IPath; Attr: integer): IFileIterator;
+
+ {**
+ * Old style search functions. Use FileFind() instead.
+ *}
+ function FindFirst(const FilePattern: IPath; Attr: integer; var F: TSytemSearchRec): integer;
+ function FindNext(var F: TSytemSearchRec): integer;
+ procedure FindClose(var F: TSytemSearchRec);
+
+ function GetCurrentDir: IPath;
+ function SetCurrentDir(const Dir: IPath): boolean;
+
+ {**
+ * Returns true if the filesystem is case-sensitive.
+ *}
+ function IsCaseSensitive(): boolean;
+ end;
+
+ function FileSystem(): IFileSystem;
+
+implementation
+
+type
+ TFileSystemImpl = class(TInterfacedObject, IFileSystem)
+ public
+ function ExpandFileName(const FileName: IPath): IPath;
+ function FileCreate(const FileName: IPath): TFileHandle;
+ function DirectoryCreate(const Dir: IPath): boolean;
+ function FileOpen(const FileName: IPath; Mode: longword): TFileHandle;
+ function FileAge(const FileName: IPath): integer; overload;
+ function FileAge(const FileName: IPath; out FileDateTime: TDateTime): boolean; overload;
+ function DirectoryExists(const Name: IPath): boolean;
+ function FileExists(const Name: IPath): boolean;
+ function FileGetAttr(const FileName: IPath): Cardinal;
+ function FileSetAttr(const FileName: IPath; Attr: integer): boolean;
+ function FileIsReadOnly(const FileName: IPath): boolean;
+ function FileSetReadOnly(const FileName: IPath; ReadOnly: boolean): boolean;
+ function FileIsAbsolute(const FileName: IPath): boolean;
+ function ForceDirectories(const Dir: IPath): boolean;
+ function RenameFile(const OldName, NewName: IPath): boolean;
+ function DeleteFile(const FileName: IPath): boolean;
+ function RemoveDir(const Dir: IPath): boolean;
+ function CopyFile(const Source, Target: IPath; FailIfExists: boolean): boolean;
+
+ function ExtractFileDrive(const FileName: IPath): IPath;
+ function ExtractFilePath(const FileName: IPath): IPath;
+ function ExtractFileDir(const FileName: IPath): IPath;
+ function ExtractFileName(const FileName: IPath): IPath;
+ function ExtractFileExt(const FileName: IPath): IPath;
+ function ExtractRelativePath(const BaseName: IPath; const FileName: IPath): IPath;
+ function ChangeFileExt(const FileName: IPath; const Extension: IPath): IPath;
+ function IncludeTrailingPathDelimiter(const FileName: IPath): IPath;
+ function ExcludeTrailingPathDelimiter(const FileName: IPath): IPath;
+
+ function FileSearch(const Name: IPath; DirList: array of IPath): IPath;
+ function FileFind(const FilePattern: IPath; Attr: integer): IFileIterator;
+
+ function FindFirst(const FilePattern: IPath; Attr: integer; var F: TSytemSearchRec): integer;
+ function FindNext(var F: TSytemSearchRec): integer;
+ procedure FindClose(var F: TSytemSearchRec);
+
+ function GetCurrentDir: IPath;
+ function SetCurrentDir(const Dir: IPath): boolean;
+
+ function IsCaseSensitive(): boolean;
+ end;
+
+ TFileIterator = class(TInterfacedObject, IFileIterator)
+ private
+ fHasNext: boolean;
+ fSearchRec: TSytemSearchRec;
+ public
+ constructor Create(const FilePattern: IPath; Attr: integer);
+ destructor Destroy(); override;
+
+ function HasNext(): boolean;
+ function Next(): TFileInfo;
+ end;
+
+
+var
+ FileSystem_Singleton: IFileSystem;
+
+function FileSystem(): IFileSystem;
+begin
+ Result := FileSystem_Singleton;
+end;
+
+function TFileSystemImpl.FileFind(const FilePattern: IPath; Attr: integer): IFileIterator;
+begin
+ Result := TFileIterator.Create(FilePattern, Attr);
+end;
+
+function TFileSystemImpl.IsCaseSensitive(): boolean;
+begin
+ // Windows and Mac OS X do not have case sensitive file systems
+ {$IF Defined(MSWINDOWS) or Defined(DARWIN)}
+ Result := false;
+ {$ELSE}
+ Result := true;
+ {$IFEND}
+end;
+
+function TFileSystemImpl.FileIsAbsolute(const FileName: IPath): boolean;
+var
+ NameStr: UTF8String;
+begin
+ Result := true;
+ NameStr := FileName.ToUTF8();
+
+ {$IFDEF MSWINDOWS}
+ // check if drive is given 'C:...'
+ if (FileName.GetDrive().ToUTF8 <> '') then
+ Exit;
+ // check if path starts with '\\'
+ if (Length(NameStr) >= 2) and
+ (NameStr[1] = PathDelim) and (NameStr[2] = PathDelim) then
+ Exit;
+ {$ELSE} // Unix based systems
+ // check if root dir given '/...'
+ if (Length(NameStr) >= 1) and (NameStr[1] = PathDelim) then
+ Exit;
+ {$ENDIF}
+
+ Result := false;
+end;
+
+{$IFDEF MSWINDOWS}
+
+function TFileSystemImpl.ExpandFileName(const FileName: IPath): IPath;
+begin
+ Result := Path(WideExpandFileName(FileName.ToWide()));
+end;
+
+function TFileSystemImpl.FileCreate(const FileName: IPath): TFileHandle;
+begin
+ Result := WideFileCreate(FileName.ToWide());
+end;
+
+function TFileSystemImpl.DirectoryCreate(const Dir: IPath): boolean;
+begin
+ Result := WideCreateDir(Dir.ToWide());
+end;
+
+function TFileSystemImpl.FileOpen(const FileName: IPath; Mode: longword): TFileHandle;
+begin
+ Result := WideFileOpen(FileName.ToWide(), Mode);
+end;
+
+function TFileSystemImpl.FileAge(const FileName: IPath): integer;
+begin
+ Result := WideFileAge(FileName.ToWide());
+end;
+
+function TFileSystemImpl.FileAge(const FileName: IPath; out FileDateTime: TDateTime): boolean;
+begin
+ Result := WideFileAge(FileName.ToWide(), FileDateTime);
+end;
+
+function TFileSystemImpl.DirectoryExists(const Name: IPath): boolean;
+begin
+ Result := WideDirectoryExists(Name.ToWide());
+end;
+
+function TFileSystemImpl.FileExists(const Name: IPath): boolean;
+begin
+ Result := WideFileExists(Name.ToWide());
+end;
+
+function TFileSystemImpl.FileGetAttr(const FileName: IPath): Cardinal;
+begin
+ Result := WideFileGetAttr(FileName.ToWide());
+end;
+
+function TFileSystemImpl.FileSetAttr(const FileName: IPath; Attr: integer): boolean;
+begin
+ Result := WideFileSetAttr(FileName.ToWide(), Attr);
+end;
+
+function TFileSystemImpl.FileIsReadOnly(const FileName: IPath): boolean;
+begin
+ Result := WideFileIsReadOnly(FileName.ToWide());
+end;
+
+function TFileSystemImpl.FileSetReadOnly(const FileName: IPath; ReadOnly: boolean): boolean;
+begin
+ Result := WideFileSetReadOnly(FileName.ToWide(), ReadOnly);
+end;
+
+function TFileSystemImpl.ForceDirectories(const Dir: IPath): boolean;
+begin
+ Result := WideForceDirectories(Dir.ToWide());
+end;
+
+function TFileSystemImpl.FileSearch(const Name: IPath; DirList: array of IPath): IPath;
+var
+ I: integer;
+ DirListStr: WideString;
+begin
+ DirListStr := '';
+ for I := 0 to High(DirList) do
+ begin
+ if (I > 0) then
+ DirListStr := DirListStr + PathSep;
+ DirListStr := DirListStr + DirList[I].ToWide();
+ end;
+ Result := Path(WideFileSearch(Name.ToWide(), DirListStr));
+end;
+
+function TFileSystemImpl.RenameFile(const OldName, NewName: IPath): boolean;
+begin
+ Result := WideRenameFile(OldName.ToWide(), NewName.ToWide());
+end;
+
+function TFileSystemImpl.DeleteFile(const FileName: IPath): boolean;
+begin
+ Result := WideDeleteFile(FileName.ToWide());
+end;
+
+function TFileSystemImpl.RemoveDir(const Dir: IPath): boolean;
+begin
+ Result := WideRemoveDir(Dir.ToWide());
+end;
+
+function TFileSystemImpl.CopyFile(const Source, Target: IPath; FailIfExists: boolean): boolean;
+begin
+ Result := WideCopyFile(Source.ToWide(), Target.ToWide(), FailIfExists);
+end;
+
+function TFileSystemImpl.ExtractFileDrive(const FileName: IPath): IPath;
+begin
+ Result := Path(WideExtractFileDrive(FileName.ToWide()));
+end;
+
+function TFileSystemImpl.ExtractFilePath(const FileName: IPath): IPath;
+begin
+ Result := Path(WideExtractFilePath(FileName.ToWide()));
+end;
+
+function TFileSystemImpl.ExtractFileDir(const FileName: IPath): IPath;
+begin
+ Result := Path(WideExtractFileDir(FileName.ToWide()));
+end;
+
+function TFileSystemImpl.ExtractFileName(const FileName: IPath): IPath;
+begin
+ Result := Path(WideExtractFileName(FileName.ToWide()));
+end;
+
+function TFileSystemImpl.ExtractFileExt(const FileName: IPath): IPath;
+begin
+ Result := Path(WideExtractFileExt(FileName.ToWide()));
+end;
+
+function TFileSystemImpl.ExtractRelativePath(const BaseName: IPath; const FileName: IPath): IPath;
+begin
+ Result := Path(WideExtractRelativePath(BaseName.ToWide(), FileName.ToWide()));
+end;
+
+function TFileSystemImpl.ChangeFileExt(const FileName: IPath; const Extension: IPath): IPath;
+begin
+ Result := Path(WideChangeFileExt(FileName.ToWide(), Extension.ToWide()));
+end;
+
+function TFileSystemImpl.IncludeTrailingPathDelimiter(const FileName: IPath): IPath;
+begin
+ Result := Path(WideIncludeTrailingPathDelimiter(FileName.ToWide()));
+end;
+
+function TFileSystemImpl.ExcludeTrailingPathDelimiter(const FileName: IPath): IPath;
+begin
+ Result := Path(WideExcludeTrailingPathDelimiter(FileName.ToWide()));
+end;
+
+function TFileSystemImpl.FindFirst(const FilePattern: IPath; Attr: integer; var F: TSytemSearchRec): integer;
+begin
+ Result := WideFindFirst(FilePattern.ToWide(), Attr, F);
+end;
+
+function TFileSystemImpl.FindNext(var F: TSytemSearchRec): integer;
+begin
+ Result := WideFindNext(F);
+end;
+
+procedure TFileSystemImpl.FindClose(var F: TSytemSearchRec);
+begin
+ WideFindClose(F);
+end;
+
+function TFileSystemImpl.GetCurrentDir: IPath;
+begin
+ Result := Path(WideGetCurrentDir());
+end;
+
+function TFileSystemImpl.SetCurrentDir(const Dir: IPath): boolean;
+begin
+ Result := WideSetCurrentDir(Dir.ToWide());
+end;
+
+{$ELSE} // UNIX
+
+function TFileSystemImpl.ExpandFileName(const FileName: IPath): IPath;
+begin
+ Result := Path(SysUtils.ExpandFileName(FileName.ToNative()));
+end;
+
+function TFileSystemImpl.FileCreate(const FileName: IPath): TFileHandle;
+begin
+ Result := SysUtils.FileCreate(FileName.ToNative());
+end;
+
+function TFileSystemImpl.DirectoryCreate(const Dir: IPath): boolean;
+begin
+ Result := SysUtils.CreateDir(Dir.ToNative());
+end;
+
+function TFileSystemImpl.FileOpen(const FileName: IPath; Mode: longword): TFileHandle;
+begin
+ Result := SysUtils.FileOpen(FileName.ToNative(), Mode);
+end;
+
+function TFileSystemImpl.FileAge(const FileName: IPath): integer;
+begin
+ Result := SysUtils.FileAge(FileName.ToNative());
+end;
+
+function TFileSystemImpl.FileAge(const FileName: IPath; out FileDateTime: TDateTime): boolean;
+var
+ FileDate: integer;
+begin
+ FileDate := SysUtils.FileAge(FileName.ToNative());
+ Result := (FileDate <> -1);
+ if (Result) then
+ FileDateTime := FileDateToDateTime(FileDate);
+end;
+
+function TFileSystemImpl.DirectoryExists(const Name: IPath): boolean;
+begin
+ Result := SysUtils.DirectoryExists(Name.ToNative());
+end;
+
+function TFileSystemImpl.FileExists(const Name: IPath): boolean;
+begin
+ Result := SysUtils.FileExists(Name.ToNative());
+end;
+
+function TFileSystemImpl.FileGetAttr(const FileName: IPath): Cardinal;
+begin
+ Result := SysUtils.FileGetAttr(FileName.ToNative());
+end;
+
+function TFileSystemImpl.FileSetAttr(const FileName: IPath; Attr: integer): boolean;
+begin
+ Result := (SysUtils.FileSetAttr(FileName.ToNative(), Attr) = 0);
+end;
+
+function TFileSystemImpl.FileIsReadOnly(const FileName: IPath): boolean;
+begin
+ Result := SysUtils.FileIsReadOnly(FileName.ToNative());
+end;
+
+function TFileSystemImpl.FileSetReadOnly(const FileName: IPath; ReadOnly: boolean): boolean;
+begin
+ Result := (SysUtils.FileSetAttr(FileName.ToNative(), faReadOnly) = 0);
+end;
+
+function TFileSystemImpl.ForceDirectories(const Dir: IPath): boolean;
+begin
+ Result := SysUtils.ForceDirectories(Dir.ToNative());
+end;
+
+function TFileSystemImpl.FileSearch(const Name: IPath; DirList: array of IPath): IPath;
+var
+ I: integer;
+ DirListStr: AnsiString;
+begin
+ DirListStr := '';
+ for I := 0 to High(DirList) do
+ begin
+ if (I > 0) then
+ DirListStr := DirListStr + PathSep;
+ DirListStr := DirListStr + DirList[I].ToNative();
+ end;
+ Result := Path(SysUtils.FileSearch(Name.ToNative(), DirListStr));
+end;
+
+function TFileSystemImpl.RenameFile(const OldName, NewName: IPath): boolean;
+begin
+ Result := SysUtils.RenameFile(OldName.ToNative(), NewName.ToNative());
+end;
+
+function TFileSystemImpl.DeleteFile(const FileName: IPath): boolean;
+begin
+ Result := SysUtils.DeleteFile(FileName.ToNative());
+end;
+
+function TFileSystemImpl.RemoveDir(const Dir: IPath): boolean;
+begin
+ Result := SysUtils.RemoveDir(Dir.ToNative());
+end;
+
+function TFileSystemImpl.CopyFile(const Source, Target: IPath; 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.ToNative(), fmOpenRead);
+ TargetFile := TFileStream.Create(Target.ToNative(), 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;
+
+function TFileSystemImpl.ExtractFileDrive(const FileName: IPath): IPath;
+begin
+ Result := Path(SysUtils.ExtractFileDrive(FileName.ToNative()));
+end;
+
+function TFileSystemImpl.ExtractFilePath(const FileName: IPath): IPath;
+begin
+ Result := Path(SysUtils.ExtractFilePath(FileName.ToNative()));
+end;
+
+function TFileSystemImpl.ExtractFileDir(const FileName: IPath): IPath;
+begin
+ Result := Path(SysUtils.ExtractFileDir(FileName.ToNative()));
+end;
+
+function TFileSystemImpl.ExtractFileName(const FileName: IPath): IPath;
+begin
+ Result := Path(SysUtils.ExtractFileName(FileName.ToNative()));
+end;
+
+function TFileSystemImpl.ExtractFileExt(const FileName: IPath): IPath;
+begin
+ Result := Path(SysUtils.ExtractFileExt(FileName.ToNative()));
+end;
+
+function TFileSystemImpl.ExtractRelativePath(const BaseName: IPath; const FileName: IPath): IPath;
+begin
+ Result := Path(SysUtils.ExtractRelativePath(BaseName.ToNative(), FileName.ToNative()));
+end;
+
+function TFileSystemImpl.ChangeFileExt(const FileName: IPath; const Extension: IPath): IPath;
+begin
+ Result := Path(SysUtils.ChangeFileExt(FileName.ToNative(), Extension.ToNative()));
+end;
+
+function TFileSystemImpl.IncludeTrailingPathDelimiter(const FileName: IPath): IPath;
+begin
+ Result := Path(SysUtils.IncludeTrailingPathDelimiter(FileName.ToNative()));
+end;
+
+function TFileSystemImpl.ExcludeTrailingPathDelimiter(const FileName: IPath): IPath;
+begin
+ Result := Path(SysUtils.ExcludeTrailingPathDelimiter(FileName.ToNative()));
+end;
+
+function TFileSystemImpl.FindFirst(const FilePattern: IPath; Attr: integer; var F: TSytemSearchRec): integer;
+begin
+ Result := SysUtils.FindFirst(FilePattern.ToNative(), Attr, F);
+end;
+
+function TFileSystemImpl.FindNext(var F: TSytemSearchRec): integer;
+begin
+ Result := SysUtils.FindNext(F);
+end;
+
+procedure TFileSystemImpl.FindClose(var F: TSytemSearchRec);
+begin
+ SysUtils.FindClose(F);
+end;
+
+function TFileSystemImpl.GetCurrentDir: IPath;
+begin
+ Result := Path(SysUtils.GetCurrentDir());
+end;
+
+function TFileSystemImpl.SetCurrentDir(const Dir: IPath): boolean;
+begin
+ Result := SysUtils.SetCurrentDir(Dir.ToNative());
+end;
+
+{$ENDIF}
+
+
+{ TFileIterator }
+
+constructor TFileIterator.Create(const FilePattern: IPath; Attr: integer);
+begin
+ inherited Create();
+ fHasNext := (FileSystem.FindFirst(FilePattern, Attr, fSearchRec) = 0);
+end;
+
+destructor TFileIterator.Destroy();
+begin
+ FileSystem.FindClose(fSearchRec);
+ inherited;
+end;
+
+function TFileIterator.HasNext(): boolean;
+begin
+ Result := fHasNext;
+end;
+
+function TFileIterator.Next(): TFileInfo;
+begin
+ if (not fHasNext) then
+ begin
+ // Note: do not use FillChar() on records with ref-counted fields
+ Result.Time := 0;
+ Result.Size := 0;
+ Result.Attr := 0;
+ Result.Name := nil;
+ Exit;
+ end;
+
+ Result.Time := fSearchRec.Time;
+ Result.Size := fSearchRec.Size;
+ Result.Attr := fSearchRec.Attr;
+ Result.Name := Path(fSearchRec.Name);
+
+ // fetch next entry
+ fHasNext := (FileSystem.FindNext(fSearchRec) = 0);
+end;
+
+
+initialization
+ FileSystem_Singleton := TFileSystemImpl.Create;
+
+finalization
+ FileSystem_Singleton := nil;
+
+end.
diff --git a/cmake/src/base/UFont.pas b/cmake/src/base/UFont.pas
index a72bca21..49a19a1a 100644
--- a/cmake/src/base/UFont.pas
+++ b/cmake/src/base/UFont.pas
@@ -41,18 +41,23 @@ interface
{$DEFINE BITMAP_FONT}
{$ENDIF}
+// Enables the Freetype font cache
+{$DEFINE ENABLE_FT_FACE_CACHE}
+
uses
FreeType,
gl,
glext,
glu,
sdl,
+ Math,
+ Classes,
+ SysUtils,
+ UUnicodeUtils,
{$IFDEF BITMAP_FONT}
UTexture,
{$ENDIF}
- Math,
- Classes,
- SysUtils;
+ UPath;
type
@@ -60,7 +65,7 @@ type
TGLubyteArray = array[0 .. (MaxInt div SizeOf(GLubyte))-1] of GLubyte;
TGLubyteDynArray = array of GLubyte;
- TWideStringArray = array of WideString;
+ TUCS4StringArray = array of UCS4String;
TGLColor = packed record
case byte of
@@ -86,6 +91,8 @@ type
Width, Height: integer;
end;
+ EFontError = class(Exception);
+
{**
* Abstract base class representing a glyph.
*}
@@ -117,6 +124,7 @@ type
procedure ResetIntern();
protected
+ fFilename: IPath;
fStyle: TFontStyle;
fUseKerning: boolean;
fLineSpacing: single; // must be inited by subclass
@@ -126,34 +134,34 @@ type
{**
* Splits lines in Text seperated by newline (char-code #13).
- * @param Text UTF-8 encoded string
- * @param Lines splitted WideString lines
+ * @param Text UCS-4 encoded string
+ * @param Lines splitted UCS4String lines
*}
- procedure SplitLines(const Text: UTF8String; var Lines: TWideStringArray);
+ procedure SplitLines(const Text: UCS4String; var Lines: TUCS4StringArray);
{**
- * Print an array of WideStrings. Each array-item is a line of text.
+ * Print an array of UCS4Strings. Each array-item is a line of text.
* Lines of text are seperated by the line-spacing.
* This is the base function for all text drawing.
*}
- procedure Print(const Text: TWideStringArray); overload; virtual;
+ procedure Print(const Text: TUCS4StringArray); overload; virtual;
{**
* Draws an underline.
*}
- procedure DrawUnderline(const Text: WideString); virtual;
+ procedure DrawUnderline(const Text: UCS4String); virtual;
{**
* Renders (one) line of text.
*}
- procedure Render(const Text: WideString); virtual; abstract;
+ procedure Render(const Text: UCS4String); virtual; abstract;
{**
* Returns the bounds of text-lines contained in Text.
* @param(Advance if true the right bound is set to the advance instead
* of the minimal right bound.)
*}
- function BBox(const Text: TWideStringArray; Advance: boolean): TBoundsDbl; overload; virtual; abstract;
+ function BBox(const Text: TUCS4StringArray; Advance: boolean): TBoundsDbl; overload; virtual; abstract;
{**
* Resets all user settings to default values.
@@ -182,15 +190,17 @@ type
property ReflectionPass: boolean read fReflectionPass write SetReflectionPass;
public
- constructor Create();
+ constructor Create(const Filename: IPath);
destructor Destroy(); override;
{**
* Prints a text.
*}
+ procedure Print(const Text: UCS4String); overload;
+ {** UTF-16 version of @link(Print) }
procedure Print(const Text: WideString); overload;
{** UTF-8 version of @link(Print) }
- procedure Print(const Text: string); overload;
+ procedure Print(const Text: UTF8String); overload;
{**
* Calculates the bounding box (width and height) around Text.
@@ -203,10 +213,18 @@ type
* bigger than the text's width as it additionally contains the advance
* and glyph-spacing of the last character.
*}
+ function BBox(const Text: UCS4String; Advance: boolean = true): TBoundsDbl; overload;
+ {** UTF-16 version of @link(BBox) }
function BBox(const Text: WideString; Advance: boolean = true): TBoundsDbl; overload;
{** UTF-8 version of @link(BBox) }
function BBox(const Text: UTF8String; Advance: boolean = true): TBoundsDbl; overload;
+ {**
+ * Adds a new font that is used if the default font misses a glyph
+ * @raises EFontError if the fallback could not be initialized
+ *}
+ procedure AddFallback(const Filename: IPath); virtual; abstract;
+
{** Font height }
property Height: single read GetHeight;
{** Vertical distance from baseline to top of glyph }
@@ -223,6 +241,8 @@ type
property Style: TFontStyle read GetStyle write SetStyle;
{** If set to true (default) kerning will be used if available }
property UseKerning: boolean read GetUseKerning write SetUseKerning;
+ {** Filename }
+ property Filename: IPath read fFilename;
end;
const
@@ -242,16 +262,16 @@ type
procedure ResetIntern();
protected
- fScale: single; //**< current height to base-font height ratio
- fAspect: single; //**< width to height aspect
+ fScale: single; //**< current height to base-font height ratio
+ fStretch: single; //**< stretch factor for width (Width * fStretch)
fBaseFont: TFont; //**< shortcut for fMipmapFonts[0]
fUseMipmaps: boolean; //**< true if mipmap fonts are generated
/// Mipmap fonts (size[level+1] = size[level]/2)
fMipmapFonts: array[0..cMaxMipmapLevel] of TFont;
- procedure Render(const Text: WideString); override;
- procedure Print(const Text: TWideStringArray); override;
- function BBox(const Text: TWideStringArray; Advance: boolean): TBoundsDbl; override;
+ procedure Render(const Text: UCS4String); override;
+ procedure Print(const Text: TUCS4StringArray); override;
+ function BBox(const Text: TUCS4StringArray; Advance: boolean): TBoundsDbl; override;
{**
* Callback called for creation of each mipmap font.
@@ -280,8 +300,8 @@ type
procedure SetHeight(Height: single); virtual;
function GetHeight(): single; override;
- procedure SetAspect(Aspect: single); virtual;
- function GetAspect(): single; virtual;
+ procedure SetStretch(Stretch: single); virtual;
+ function GetStretch(): single; virtual;
function GetAscender(): single; override;
function GetDescender(): single; override;
procedure SetLineSpacing(Spacing: single); override;
@@ -316,13 +336,13 @@ type
{** Font height }
property Height: single read GetHeight write SetHeight;
- {** Factor for font stretching (NewWidth = Width*Aspect), 1.0 by default }
- property Aspect: single read GetAspect write SetAspect;
+ {** Factor for font stretching (NewWidth = Width*Stretch), 1.0 by default }
+ property Stretch: single read GetStretch write SetStretch;
end;
{**
* Table for storage of max. 256 glyphs.
- * Used for the second cache level. Indexed by the LSB of the WideChar
+ * Used for the second cache level. Indexed by the LSB of the UCS4Char
* char-code.
*}
PGlyphTable = ^TGlyphTable;
@@ -332,7 +352,7 @@ type
* Cache for glyphs of a single font.
* The cached glyphs are stored inside a hash-list.
* Hashing is performed in two steps:
- * 1. the least significant byte (LSB) of the WideChar character code
+ * 1. the least significant byte (LSB) of the UCS4Char character code
* is removed (shr 8) and the result (we call it BaseCode here) looked up in
* the hash-list.
* 2. Each entry of the hash-list contains a table with max. 256 entries.
@@ -359,22 +379,22 @@ type
* Add glyph Glyph with char-code ch to the cache.
* @returns @true on success, @false otherwise
*}
- function AddGlyph(ch: WideChar; const Glyph: TGlyph): boolean;
+ function AddGlyph(ch: UCS4Char; const Glyph: TGlyph): boolean;
{**
* Removes the glyph with char-code ch from the cache.
*}
- procedure DeleteGlyph(ch: WideChar);
+ procedure DeleteGlyph(ch: UCS4Char);
{**
* Removes the glyph with char-code ch from the cache.
*}
- function GetGlyph(ch: WideChar): TGlyph;
+ function GetGlyph(ch: UCS4Char): TGlyph;
{**
* Checks if a glyph with char-code ch is cached.
*}
- function HasGlyph(ch: WideChar): boolean;
+ function HasGlyph(ch: UCS4Char): boolean;
{**
* Remove and free all cached glyphs. If KeepBaseSet is set to
@@ -408,16 +428,16 @@ type
* Retrieves a cached glyph with char-code ch from cache.
* If the glyph is not already cached, it is loaded with LoadGlyph().
*}
- function GetGlyph(ch: WideChar): TGlyph;
+ function GetGlyph(ch: UCS4Char): TGlyph;
{**
* Callback to create (load) a glyph with char-code ch.
* Implemented by subclasses.
*}
- function LoadGlyph(ch: WideChar): TGlyph; virtual; abstract;
+ function LoadGlyph(ch: UCS4Char): TGlyph; virtual; abstract;
public
- constructor Create();
+ constructor Create(const Filename: IPath);
destructor Destroy(); override;
{**
@@ -430,12 +450,56 @@ type
TFTFont = class;
+ {**
+ * Freetype font face class.
+ *}
+ TFTFontFace = class
+ private
+ fFilename: IPath; //**< filename of the font-file
+ fFace: FT_Face; //**< Holds the height of the font
+ fFontUnitScale: TPositionDbl; //**< FT font-units to pixel ratio
+ fSize: integer;
+
+ public
+ {**
+ * @raises EFontError if the glyph could not be initialized
+ *}
+ constructor Create(const Filename: IPath; Size: integer);
+
+ destructor Destroy(); override;
+
+ property Filename: IPath read fFilename;
+ property Data: FT_Face read fFace;
+ property FontUnitScale: TPositionDbl read fFontUnitScale;
+ property Size: integer read fSize;
+ end;
+
+ {**
+ * Loading font faces with freetype is a slow process.
+ * Especially loading a font (e.g. fallback fonts) more than once is a waste
+ * of time. Just cache already loaded faces here.
+ *}
+ TFTFontFaceCache = class
+ private
+ fFaces: array of TFTFontFace;
+ fFacesRefCnt: array of integer;
+ public
+ {**
+ * @raises EFontError if the font could not be initialized
+ *}
+ function LoadFace(const Filename: IPath; Size: integer): TFTFontFace;
+
+ procedure UnloadFace(Face: TFTFontFace);
+ end;
+
{**
* Freetype glyph.
* Each glyph stores a texture with the glyph's image.
*}
TFTGlyph = class(TGlyph)
private
+ fCharCode: UCS4Char; //**< Char code
+ fFace: TFTFontFace; //**< Freetype face used for this glyph
fCharIndex: FT_UInt; //**< Freetype specific char-index (<> char-code)
fDisplayList: GLuint; //**< Display-list ID
fTexture: GLuint; //**< Texture ID
@@ -458,13 +522,13 @@ type
* The bitmap must be 2* pixels wider and higher than the
* original glyph's bitmap with the latter centered in it.
*}
- procedure Extrude(var TexBuffer: TGLubyteDynArray; Outset: single);
+ procedure StrokeBorder(var Glyph: FT_Glyph);
{**
* Creates an OpenGL texture (and display list) for the glyph.
* The glyph's and bitmap's metrics are set correspondingly.
* @param LoadFlags flags passed to FT_Load_Glyph()
- * @raises Exception if the glyph could not be initialized
+ * @raises EFontError if the glyph could not be initialized
*}
procedure CreateTexture(LoadFlags: FT_Int32);
@@ -477,7 +541,7 @@ type
* Creates a glyph with char-code ch from font Font.
* @param LoadFlags flags passed to FT_Load_Glyph()
*}
- constructor Create(Font: TFTFont; ch: WideChar; Outset: single;
+ constructor Create(Font: TFTFont; ch: UCS4Char; Outset: single;
LoadFlags: FT_Int32);
destructor Destroy(); override;
@@ -488,29 +552,36 @@ type
{** Freetype specific char-index (<> char-code) }
property CharIndex: FT_UInt read fCharIndex;
+
+ {** Freetype face used for this glyph }
+ property Face: TFTFontFace read fFace;
end;
+ TFontPart = ( fpNone, fpInner, fpOutline );
+ TFTFontFaceArray = array of TFTFontFace;
+
{**
* Freetype font class.
*}
TFTFont = class(TCachedFont)
private
procedure ResetIntern();
+ class function GetFaceCache(): TFTFontFaceCache;
protected
- fFilename: string; //**< filename of the font-file
+ fFace: TFTFontFace; //**< Default font face
fSize: integer; //**< Font base size (in pixels)
fOutset: single; //**< size of outset extrusion (in pixels)
- fFace: FT_Face; //**< Holds the height of the font
fLoadFlags: FT_Int32; //**< FT glpyh load-flags
- fFontUnitScale: TPositionDbl; //**< FT font-units to pixel ratio
fUseDisplayLists: boolean; //**< true: use display-lists, false: direct drawing
+ fPart: TFontPart; //**< indicates the part of an outline font
+ fFallbackFaces: TFTFontFaceArray; //**< available fallback faces, ordered by priority
{** @seealso TCachedFont.LoadGlyph }
- function LoadGlyph(ch: WideChar): TGlyph; override;
+ function LoadGlyph(ch: UCS4Char): TGlyph; override;
- procedure Render(const Text: WideString); override;
- function BBox(const Text: TWideStringArray; Advance: boolean): TBoundsDbl; override;
+ procedure Render(const Text: UCS4String); override;
+ function BBox(const Text: TUCS4StringArray; Advance: boolean): TBoundsDbl; override;
function GetHeight(): single; override;
function GetAscender(): single; override;
@@ -518,17 +589,15 @@ type
function GetUnderlinePosition(): single; override;
function GetUnderlineThickness(): single; override;
- property Face: FT_Face read fFace;
-
public
{**
* Creates a font of size Size (in pixels) from the file Filename.
* If Outset (in pixels) is set to a value > 0 the glyphs will be extruded
* at their borders. Use it for e.g. a bold effect.
* @param LoadFlags flags passed to FT_Load_Glyph()
- * @raises Exception if the font-file could not be loaded
+ * @raises EFontError if the font-file could not be loaded
*}
- constructor Create(const Filename: string;
+ constructor Create(const Filename: IPath;
Size: integer; Outset: single = 0.0;
LoadFlags: FT_Int32 = FT_LOAD_DEFAULT);
@@ -539,11 +608,19 @@ type
{** @seealso TFont.Reset }
procedure Reset(); override;
-
+
+ procedure AddFallback(const Filename: IPath); override;
+
{** Size of the base font }
property Size: integer read fSize;
{** Outset size }
property Outset: single read fOutset;
+ {** The part (inner/outline/none) this font represents in a composite font }
+ property Part: TFontPart read fPart write fPart;
+ {** Freetype face of this font }
+ property DefaultFace: TFTFontFace read fFace;
+ {** Available freetype fallback faces, ordered by priority }
+ property FallbackFaces: TFTFontFaceArray read fFallbackFaces;
end;
TFTScalableFont = class(TScalableFont)
@@ -557,11 +634,27 @@ type
* OutsetAmount is the ratio of the glyph extrusion.
* The extrusion in pixels is Size*OutsetAmount
* (0.0 -> no extrusion, 0.1 -> 10%).
+ *
+ * The memory size (in bytes) consumed by a scalable font
+ * - with UseMipmaps=false:
+ * mem = size^2 * #cached_glyphs
+ * - with UseMipmaps=true (all mipmap levels):
+ * mem = size^2 * #cached_glyphs * Sum[i=1..cMaxMipmapLevel](1/i^2)
+ * - with UseMipmaps=true (5 <= cMaxMipmapLevel <= 10):
+ * mem ~= size^2 * #cached_glyphs * 1.5
+ *
+ * Examples (for 128 cached glyphs):
+ * - Size: 64 pixels: 768 KB (mipmapped) or 512 KB (non-mipmapped).
+ * - Size 128 pixels: 3 MB (mipmapped) or 2 MB (non-mipmapped)
+ *
+ * Note: once a glyph is cached there will
*}
- constructor Create(const Filename: string;
+ constructor Create(const Filename: IPath;
Size: integer; OutsetAmount: single = 0.0;
UseMipmaps: boolean = true);
+ procedure AddFallback(const Filename: IPath); override;
+
{** @seealso TGlyphCache.FlushCache }
procedure FlushCache(KeepBaseSet: boolean);
@@ -576,7 +669,6 @@ type
*}
TFTOutlineFont = class(TFont)
private
- fFilename: string;
fSize: integer;
fOutset: single;
fInnerFont, fOutlineFont: TFTFont;
@@ -585,9 +677,9 @@ type
procedure ResetIntern();
protected
- procedure DrawUnderline(const Text: WideString); override;
- procedure Render(const Text: WideString); override;
- function BBox(const Text: TWideStringArray; Advance: boolean): TBoundsDbl; override;
+ procedure DrawUnderline(const Text: UCS4String); override;
+ procedure Render(const Text: UCS4String); override;
+ function BBox(const Text: TUCS4StringArray; Advance: boolean): TBoundsDbl; override;
function GetHeight(): single; override;
function GetAscender(): single; override;
@@ -603,7 +695,7 @@ type
procedure SetReflectionPass(Enable: boolean); override;
public
- constructor Create(const Filename: string;
+ constructor Create(const Filename: IPath;
Size: integer; Outset: single;
LoadFlags: FT_Int32 = FT_LOAD_DEFAULT);
destructor Destroy; override;
@@ -618,6 +710,8 @@ type
{** @seealso TGlyphCache.FlushCache }
procedure FlushCache(KeepBaseSet: boolean);
+ procedure AddFallback(const Filename: IPath); override;
+
{** @seealso TFont.Reset }
procedure Reset(); override;
@@ -637,7 +731,7 @@ type
function CreateMipmap(Level: integer; Scale: single): TFont; override;
public
- constructor Create(const Filename: string;
+ constructor Create(const Filename: IPath;
Size: integer; OutsetAmount: single;
UseMipmaps: boolean = true);
@@ -647,6 +741,8 @@ type
{** @seealso TGlyphCache.FlushCache }
procedure FlushCache(KeepBaseSet: boolean);
+ procedure AddFallback(const Filename: IPath); override;
+
{** Outset size }
property Outset: single read GetOutset;
end;
@@ -672,18 +768,18 @@ type
procedure ResetIntern();
- procedure RenderChar(ch: WideChar; var AdvanceX: real);
+ procedure RenderChar(ch: UCS4Char; var AdvanceX: real);
{**
* Load font widths from an info file.
* @param InfoFile the name of the info (.dat) file
- * @raises Exception if the file is corrupted
+ * @raises EFontError if the file is corrupted
*}
- procedure LoadFontInfo(const InfoFile: string);
+ procedure LoadFontInfo(const InfoFile: IPath);
protected
- procedure Render(const Text: WideString); override;
- function BBox(const Text: TWideStringArray; Advance: boolean): TBoundsDbl; override;
+ procedure Render(const Text: UCS4String); override;
+ function BBox(const Text: TUCS4StringArray; Advance: boolean): TBoundsDbl; override;
function GetHeight(): single; override;
function GetAscender(): single; override;
@@ -699,7 +795,7 @@ type
* (y-axis up) and from the lower edge of the glyphs bounding box)
* @param(Ascender pixels from baseline to top of highest glyph)
*}
- constructor Create(const Filename: string; Outline: integer;
+ constructor Create(const Filename: IPath; Outline: integer;
Baseline, Ascender, Descender: integer);
destructor Destroy(); override;
@@ -711,6 +807,8 @@ type
{** @seealso TFont.Reset }
procedure Reset(); override;
+
+ procedure AddFallback(const Filename: IPath); override;
end;
{$ENDIF BITMAP_FONT}
@@ -720,7 +818,7 @@ type
{**
* Returns a pointer to the freetype library singleton.
* If non exists, freetype will be initialized.
- * @raises Exception if initialization failed
+ * @raises EFontError if initialization failed
*}
class function GetLibrary(): FT_Library;
class procedure FreeLibrary();
@@ -773,9 +871,10 @@ end;
* TFont
*}
-constructor TFont.Create();
+constructor TFont.Create(const Filename: IPath);
begin
- inherited;
+ inherited Create();
+ fFilename := Filename;
ResetIntern();
end;
@@ -801,37 +900,61 @@ begin
ResetIntern();
end;
-procedure TFont.SplitLines(const Text: UTF8String; var Lines: TWideStringArray);
+procedure TFont.SplitLines(const Text: UCS4String; var Lines: TUCS4StringArray);
var
- LineList: TStringList;
- LineIndex: integer;
+ CharIndex: integer;
+ LineStart: integer;
+ LineLength: integer;
+ EOT: boolean; // End-Of-Text
begin
- // split lines on newline (there is no WideString version of ExtractStrings)
- LineList := TStringList.Create();
- ExtractStrings([#13], [], PChar(Text), LineList);
+ // split lines on newline
+ SetLength(Lines, 0);
+ EOT := false;
+ LineStart := 0;
- // create an array of WideStrins from the UTF-8 string-list
- SetLength(Lines, LineList.Count);
- for LineIndex := 0 to LineList.Count-1 do
- Lines[LineIndex] := UTF8Decode(LineList[LineIndex]);
- LineList.Free();
+ for CharIndex := 0 to High(Text) do
+ begin
+ // check for end of text (UCS4Strings are zero-terminated)
+ if (CharIndex = High(Text)) then
+ EOT := true;
+
+ // check for newline (carriage return (#13)) or end of text
+ if (Text[CharIndex] = 13) or EOT then
+ begin
+ LineLength := CharIndex - LineStart;
+ // check if last character was a newline
+ if (EOT and (LineLength = 0)) then
+ Break;
+
+ // copy line (even if LineLength is 0)
+ SetLength(Lines, Length(Lines)+1);
+ Lines[High(Lines)] := UCS4Copy(Text, LineStart, LineLength);
+
+ LineStart := CharIndex+1;
+ end;
+ end;
end;
-function TFont.BBox(const Text: UTF8String; Advance: boolean): TBoundsDbl;
+function TFont.BBox(const Text: UCS4String; Advance: boolean): TBoundsDbl;
var
- LineArray: TWideStringArray;
+ LineArray: TUCS4StringArray;
begin
SplitLines(Text, LineArray);
Result := BBox(LineArray, Advance);
SetLength(LineArray, 0);
end;
+function TFont.BBox(const Text: UTF8String; Advance: boolean): TBoundsDbl;
+begin
+ Result := BBox(UTF8Decode(Text), Advance);
+end;
+
function TFont.BBox(const Text: WideString; Advance: boolean): TBoundsDbl;
begin
- Result := BBox(UTF8Encode(Text), Advance);
+ Result := BBox(WideStringToUCS4String(Text), Advance);
end;
-procedure TFont.Print(const Text: TWideStringArray);
+procedure TFont.Print(const Text: TUCS4StringArray);
var
LineIndex: integer;
begin
@@ -912,21 +1035,26 @@ begin
glPopAttrib();
end;
-procedure TFont.Print(const Text: string);
+procedure TFont.Print(const Text: UCS4String);
var
- LineArray: TWideStringArray;
+ LineArray: TUCS4StringArray;
begin
SplitLines(Text, LineArray);
Print(LineArray);
SetLength(LineArray, 0);
end;
+procedure TFont.Print(const Text: UTF8String);
+begin
+ Print(UTF8Decode(Text));
+end;
+
procedure TFont.Print(const Text: WideString);
begin
- Print(UTF8Encode(Text));
+ Print(WideStringToUCS4String(Text));
end;
-procedure TFont.DrawUnderline(const Text: WideString);
+procedure TFont.DrawUnderline(const Text: UCS4String);
var
UnderlineY1, UnderlineY2: single;
Bounds: TBoundsDbl;
@@ -1001,7 +1129,7 @@ constructor TScalableFont.Create(Font: TFont; UseMipmaps: boolean);
var
MipmapLevel: integer;
begin
- inherited Create();
+ inherited Create(Font.Filename);
fBaseFont := Font;
fMipmapFonts[0] := Font;
@@ -1033,7 +1161,7 @@ end;
procedure TScalableFont.ResetIntern();
begin
fScale := 1.0;
- fAspect := 1.0;
+ fStretch := 1.0;
end;
procedure TScalableFont.Reset();
@@ -1049,7 +1177,7 @@ end;
{**
* Returns the mipmap level to use with regard to the current projection
- * and modelview matrix, font scale and aspect.
+ * and modelview matrix, font scale and stretch.
*
* Note:
* - for Freetype fonts, hinting and grid-fitting must be disabled, otherwise
@@ -1088,7 +1216,7 @@ var
ModelMatrix, ProjMatrix: T16dArray;
WinCoords: array[0..2, 0..2] of GLdouble;
ViewPortArray: TViewPortArray;
- Dist, Dist2: double;
+ Dist, Dist2, DistSum: double;
WidthScale, HeightScale: double;
const
// width/height of square used for determining the scale
@@ -1128,12 +1256,24 @@ begin
// projected width ||(x1, y1) - (x2, y1)||
Dist := (WinCoords[0][0] - WinCoords[1][0]);
Dist2 := (WinCoords[0][1] - WinCoords[1][1]);
- WidthScale := cTestSize / Sqrt(Dist*Dist + Dist2*Dist2);
+
+ WidthScale := 1;
+ DistSum := Dist*Dist + Dist2*Dist2;
+ if (DistSum > 0) then
+ begin
+ WidthScale := cTestSize / Sqrt(DistSum);
+ end;
// projected height ||(x1, y1) - (x1, y2)||
Dist := (WinCoords[0][0] - WinCoords[2][0]);
Dist2 := (WinCoords[0][1] - WinCoords[2][1]);
- HeightScale := cTestSize / Sqrt(Dist*Dist + Dist2*Dist2);
+
+ HeightScale := 1;
+ DistSum := Dist*Dist + Dist2*Dist2;
+ if (DistSum > 0) then
+ begin
+ HeightScale := cTestSize / Sqrt(DistSum);
+ end;
//writeln(Format('Scale %f, %f', [WidthScale, HeightScale]));
@@ -1194,12 +1334,12 @@ begin
glScalef(MipmapScale, MipmapScale, 0);
end;
-procedure TScalableFont.Print(const Text: TWideStringArray);
+procedure TScalableFont.Print(const Text: TUCS4StringArray);
begin
glPushMatrix();
// set scale and stretching
- glScalef(fScale * fAspect, fScale, 0);
+ glScalef(fScale * fStretch, fScale, 0);
// print text
if (fUseMipmaps) then
@@ -1210,16 +1350,16 @@ begin
glPopMatrix();
end;
-procedure TScalableFont.Render(const Text: WideString);
+procedure TScalableFont.Render(const Text: UCS4String);
begin
Assert(false, 'Unused TScalableFont.Render() was called');
end;
-function TScalableFont.BBox(const Text: TWideStringArray; Advance: boolean): TBoundsDbl;
+function TScalableFont.BBox(const Text: TUCS4StringArray; Advance: boolean): TBoundsDbl;
begin
Result := fBaseFont.BBox(Text, Advance);
- Result.Left := Result.Left * fScale * fAspect;
- Result.Right := Result.Right * fScale * fAspect;
+ Result.Left := Result.Left * fScale * fStretch;
+ Result.Right := Result.Right * fScale * fStretch;
Result.Top := Result.Top * fScale;
Result.Bottom := Result.Bottom * fScale;
end;
@@ -1234,14 +1374,14 @@ begin
Result := fBaseFont.GetHeight() * fScale;
end;
-procedure TScalableFont.SetAspect(Aspect: single);
+procedure TScalableFont.SetStretch(Stretch: single);
begin
- fAspect := Aspect;
+ fStretch := Stretch;
end;
-function TScalableFont.GetAspect(): single;
+function TScalableFont.GetStretch(): single;
begin
- Result := fAspect;
+ Result := fStretch;
end;
function TScalableFont.GetAscender(): single;
@@ -1287,7 +1427,7 @@ var
Level: integer;
begin
for Level := 0 to High(fMipmapFonts) do
- if (fMipmapFonts[Level] <> nil) then
+ if ((fMipmapFonts[Level] <> nil) AND (GetMipmapScale(Level) > 0)) then
fMipmapFonts[Level].SetReflectionSpacing(Spacing / GetMipmapScale(Level));
end;
@@ -1334,9 +1474,9 @@ end;
* TCachedFont
*}
-constructor TCachedFont.Create();
+constructor TCachedFont.Create(const Filename: IPath);
begin
- inherited;
+ inherited Create(Filename);
fCache := TGlyphCache.Create();
end;
@@ -1346,7 +1486,7 @@ begin
inherited;
end;
-function TCachedFont.GetGlyph(ch: WideChar): TGlyph;
+function TCachedFont.GetGlyph(ch: UCS4Char): TGlyph;
begin
Result := fCache.GetGlyph(ch);
if (Result = nil) then
@@ -1362,60 +1502,155 @@ begin
fCache.FlushCache(KeepBaseSet);
end;
+{*
+ * TFTFontFaceCache
+ *}
{*
- * TFTFont
+ * TFTFontFace
*}
-constructor TFTFont.Create(
- const Filename: string;
- Size: integer; Outset: single;
- LoadFlags: FT_Int32);
-var
- i: WideChar;
+constructor TFTFontFace.Create(const Filename: IPath; Size: integer);
begin
inherited Create();
fFilename := Filename;
fSize := Size;
- fOutset := Outset;
- fLoadFlags := LoadFlags;
- fUseDisplayLists := true;
// load font information
- if (FT_New_Face(TFreeType.GetLibrary(), PChar(Filename), 0, fFace) <> 0) then
- raise Exception.Create('FT_New_Face: Could not load font ''' + Filename + '''');
+ if (FT_New_Face(TFreeType.GetLibrary(), PChar(Filename.ToNative), 0, fFace) <> 0) then
+ raise EFontError.Create('FT_New_Face: Could not load font ''' + Filename.ToNative + '''');
// support scalable fonts only
if (not FT_IS_SCALABLE(fFace)) then
- raise Exception.Create('Font is not scalable');
+ raise EFontError.Create('Font is not scalable');
if (FT_Set_Pixel_Sizes(fFace, 0, Size) <> 0) then
- raise Exception.Create('FT_Set_Pixel_Sizes failes');
+ raise EFontError.Create('FT_Set_Pixel_Sizes failes');
// get scale factor for font-unit to pixel-size transformation
fFontUnitScale.X := fFace.size.metrics.x_ppem / fFace.units_per_EM;
fFontUnitScale.Y := fFace.size.metrics.y_ppem / fFace.units_per_EM;
+end;
+
+destructor TFTFontFace.Destroy();
+begin
+ // free face data
+ FT_Done_Face(fFace);
+ inherited;
+end;
+
+
+{*
+ * TFTFontFaceCache
+ *}
+
+function TFTFontFaceCache.LoadFace(const Filename: IPath; Size: integer): TFTFontFace;
+var
+ I: Integer;
+ Face: TFTFontFace;
+begin
+ {$IFDEF ENABLE_FT_FACE_CACHE}
+ for I := 0 to High(fFaces) do
+ begin
+ Face := fFaces[I];
+ // check if we have this file in our cache
+ if ((Face.Filename.Equals(Filename)) and (Face.Size = Size)) then
+ begin
+ // true -> return cached face and increment ref-count
+ Inc(fFacesRefCnt[I]);
+ Result := Face;
+ Exit;
+ end;
+ end;
+ {$ENDIF}
+
+ // face not in cache -> load it
+ Face := TFTFontFace.Create(Filename, Size);
+
+ // add face to cache
+ SetLength(fFaces, Length(fFaces)+1);
+ SetLength(fFacesRefCnt, Length(fFaces)+1);
+ fFaces[High(fFaces)] := Face;
+ fFacesRefCnt[High(fFaces)] := 1;
+
+ Result := Face;
+end;
+
+procedure TFTFontFaceCache.UnloadFace(Face: TFTFontFace);
+var
+ I: Integer;
+begin
+ for I := 0 to High(fFaces) do
+ begin
+ // search face in cache
+ if (fFaces[I] = Face) then
+ begin
+ // decrement ref-count and free face if ref-count is 0
+ Dec(fFacesRefCnt[I]);
+ if (fFacesRefCnt[I] <= 0) then
+ fFaces[I].Free;
+ Exit;
+ end;
+ end;
+end;
+
+
+{*
+ * TFTFont
+ *}
+
+constructor TFTFont.Create(
+ const Filename: IPath;
+ Size: integer; Outset: single;
+ LoadFlags: FT_Int32);
+var
+ ch: UCS4Char;
+begin
+ inherited Create(Filename);
+
+ fSize := Size;
+ fOutset := Outset;
+ fLoadFlags := LoadFlags;
+ fUseDisplayLists := true;
+ fPart := fpNone;
+
+ fFace := GetFaceCache.LoadFace(Filename, Size);
ResetIntern();
// pre-cache some commonly used glyphs (' ' - '~')
- for i := #32 to #126 do
- fCache.AddGlyph(i, TFTGlyph.Create(Self, i, Outset, LoadFlags));
+ for ch := 32 to 126 do
+ fCache.AddGlyph(ch, TFTGlyph.Create(Self, ch, Outset, LoadFlags));
end;
destructor TFTFont.Destroy();
+var
+ I: integer;
begin
- // free face
- FT_Done_Face(fFace);
+ // free faces
+ GetFaceCache.UnloadFace(fFace);
+ for I := 0 to High(fFallbackFaces) do
+ GetFaceCache.UnloadFace(fFallbackFaces[I]);
+
inherited;
end;
+var
+ FontFaceCache: TFTFontFaceCache = nil;
+
+class function TFTFont.GetFaceCache(): TFTFontFaceCache;
+begin
+ if (FontFaceCache = nil) then
+ FontFaceCache := TFTFontFaceCache.Create;
+ Result := FontFaceCache;
+end;
+
procedure TFTFont.ResetIntern();
begin
// Note: outset and non outset fonts use same spacing
- fLineSpacing := fFace.height * fFontUnitScale.Y;
- fReflectionSpacing := -2*fFace.descender * fFontUnitScale.Y;
+ fLineSpacing := fFace.Data.height * fFace.FontUnitScale.Y;
+ fReflectionSpacing := -2*fFace.Data.descender * fFace.FontUnitScale.Y;
end;
procedure TFTFont.Reset();
@@ -1424,15 +1659,24 @@ begin
ResetIntern();
end;
-function TFTFont.LoadGlyph(ch: WideChar): TGlyph;
+procedure TFTFont.AddFallback(const Filename: IPath);
+var
+ FontFace: TFTFontFace;
+begin
+ FontFace := GetFaceCache.LoadFace(Filename, Size);
+ SetLength(fFallbackFaces, Length(fFallbackFaces) + 1);
+ fFallbackFaces[High(fFallbackFaces)] := FontFace;
+end;
+
+function TFTFont.LoadGlyph(ch: UCS4Char): TGlyph;
begin
Result := TFTGlyph.Create(Self, ch, Outset, fLoadFlags);
end;
-function TFTFont.BBox(const Text: TWideStringArray; Advance: boolean): TBoundsDbl;
+function TFTFont.BBox(const Text: TUCS4StringArray; Advance: boolean): TBoundsDbl;
var
Glyph, PrevGlyph: TFTGlyph;
- TextLine: WideString;
+ TextLine: UCS4String;
LineYOffset: single;
LineIndex, CharIndex: integer;
LineBounds: TBoundsDbl;
@@ -1462,17 +1706,17 @@ begin
LineBounds.Top := 0;
// for each glyph image, compute its bounding box
- for CharIndex := 1 to Length(TextLine) do
+ for CharIndex := 0 to LengthUCS4(TextLine)-1 do
begin
Glyph := TFTGlyph(GetGlyph(TextLine[CharIndex]));
if (Glyph <> nil) then
begin
// get kerning
- if (fUseKerning and FT_HAS_KERNING(fFace) and (PrevGlyph <> nil)) then
+ if (fUseKerning and FT_HAS_KERNING(fFace.Data) and (PrevGlyph <> nil)) then
begin
- FT_Get_Kerning(fFace, PrevGlyph.CharIndex, Glyph.CharIndex,
+ FT_Get_Kerning(fFace.Data, PrevGlyph.CharIndex, Glyph.CharIndex,
FT_KERNING_UNSCALED, KernDelta);
- LineBounds.Right := LineBounds.Right + KernDelta.x * fFontUnitScale.X;
+ LineBounds.Right := LineBounds.Right + KernDelta.x * fFace.FontUnitScale.X;
end;
// update left bound (must be done before right bound is updated)
@@ -1480,9 +1724,9 @@ begin
LineBounds.Left := LineBounds.Right + Glyph.Bounds.Left;
// update right bound
- if (CharIndex < Length(TextLine)) or // not the last character
- (TextLine[CharIndex] = ' ') or // on space char (Bounds.Right = 0)
- Advance then // or in advance mode
+ if (CharIndex < LengthUCS4(TextLine)-1) or // not the last character
+ (TextLine[CharIndex] = Ord(' ')) or // on space char (Bounds.Right = 0)
+ Advance then // or in advance mode
begin
// add advance and glyph spacing
LineBounds.Right := LineBounds.Right + Glyph.Advance.x + GlyphSpacing
@@ -1534,13 +1778,13 @@ begin
end;
// if left or bottom bound was not set, set them to 0
- if (Result.Left = Infinity) then
+ if (IsInfinite(Result.Left)) then
Result.Left := 0.0;
- if (Result.Bottom = Infinity) then
+ if (IsInfinite(Result.Bottom)) then
Result.Bottom := 0.0;
end;
-procedure TFTFont.Render(const Text: WideString);
+procedure TFTFont.Render(const Text: UCS4String);
var
CharIndex: integer;
Glyph, PrevGlyph: TFTGlyph;
@@ -1550,17 +1794,17 @@ begin
PrevGlyph := nil;
// draw current line
- for CharIndex := 1 to Length(Text) do
+ for CharIndex := 0 to LengthUCS4(Text)-1 do
begin
Glyph := TFTGlyph(GetGlyph(Text[CharIndex]));
if (Assigned(Glyph)) then
begin
// get kerning
- if (fUseKerning and FT_HAS_KERNING(fFace) and (PrevGlyph <> nil)) then
+ if (fUseKerning and FT_HAS_KERNING(fFace.Data) and (PrevGlyph <> nil)) then
begin
- FT_Get_Kerning(fFace, PrevGlyph.CharIndex, Glyph.CharIndex,
+ FT_Get_Kerning(fFace.Data, PrevGlyph.CharIndex, Glyph.CharIndex,
FT_KERNING_UNSCALED, KernDelta);
- glTranslatef(KernDelta.x * fFontUnitScale.X, 0, 0);
+ glTranslatef(KernDelta.x * fFace.FontUnitScale.X, 0, 0);
end;
if (ReflectionPass) then
@@ -1582,23 +1826,23 @@ end;
function TFTFont.GetAscender(): single;
begin
- Result := fFace.ascender * fFontUnitScale.Y + Outset*2;
+ Result := fFace.Data.ascender * fFace.FontUnitScale.Y + Outset*2;
end;
function TFTFont.GetDescender(): single;
begin
// Note: outset is not part of the descender as the baseline is lifted
- Result := fFace.descender * fFontUnitScale.Y;
+ Result := fFace.Data.descender * fFace.FontUnitScale.Y;
end;
function TFTFont.GetUnderlinePosition(): single;
begin
- Result := fFace.underline_position * fFontUnitScale.Y - Outset;
+ Result := fFace.Data.underline_position * fFace.FontUnitScale.Y - Outset;
end;
function TFTFont.GetUnderlineThickness(): single;
begin
- Result := fFace.underline_thickness * fFontUnitScale.Y + Outset*2;
+ Result := fFace.Data.underline_thickness * fFace.FontUnitScale.Y + Outset*2;
end;
@@ -1606,7 +1850,7 @@ end;
* TFTScalableFont
*}
-constructor TFTScalableFont.Create(const Filename: string;
+constructor TFTScalableFont.Create(const Filename: IPath;
Size: integer; OutsetAmount: single;
UseMipmaps: boolean);
var
@@ -1637,8 +1881,8 @@ begin
// do not create mipmap fonts < 8 pixels
if (ScaledSize < 8) then
Exit;
- Result := TFTFont.Create(BaseFont.fFilename,
- ScaledSize, BaseFont.fOutset * Scale,
+ Result := TFTFont.Create(BaseFont.Filename,
+ ScaledSize, BaseFont.Outset * Scale,
FT_LOAD_DEFAULT or FT_LOAD_NO_HINTING);
end;
@@ -1647,6 +1891,15 @@ begin
Result := TFTFont(fBaseFont).Outset * fScale;
end;
+procedure TFTScalableFont.AddFallback(const Filename: IPath);
+var
+ Level: integer;
+begin
+ for Level := 0 to High(fMipmapFonts) do
+ if (fMipmapFonts[Level] <> nil) then
+ TFTFont(fMipmapFonts[Level]).AddFallback(Filename);
+end;
+
procedure TFTScalableFont.FlushCache(KeepBaseSet: boolean);
var
Level: integer;
@@ -1662,18 +1915,19 @@ end;
*}
constructor TFTOutlineFont.Create(
- const Filename: string;
+ const Filename: IPath;
Size: integer; Outset: single;
LoadFlags: FT_Int32);
begin
- inherited Create();
+ inherited Create(Filename);
- fFilename := Filename;
fSize := Size;
fOutset := Outset;
fInnerFont := TFTFont.Create(Filename, Size, 0.0, LoadFlags);
+ fInnerFont.Part := fpInner;
fOutlineFont := TFTFont.Create(Filename, Size, Outset, LoadFlags);
+ fOutlineFont.Part := fpOutline;
ResetIntern();
end;
@@ -1705,7 +1959,7 @@ begin
ResetIntern();
end;
-procedure TFTOutlineFont.DrawUnderline(const Text: WideString);
+procedure TFTOutlineFont.DrawUnderline(const Text: UCS4String);
var
CurrentColor: TGLColor;
OutlineColor: TGLColor;
@@ -1730,7 +1984,7 @@ begin
glPopMatrix();
end;
-procedure TFTOutlineFont.Render(const Text: WideString);
+procedure TFTOutlineFont.Render(const Text: UCS4String);
var
CurrentColor: TGLColor;
OutlineColor: TGLColor;
@@ -1770,7 +2024,13 @@ begin
fInnerFont.FlushCache(KeepBaseSet);
end;
-function TFTOutlineFont.BBox(const Text: TWideStringArray; Advance: boolean): TBoundsDbl;
+procedure TFTOutlineFont.AddFallback(const Filename: IPath);
+begin
+ fOutlineFont.AddFallback(Filename);
+ fInnerFont.AddFallback(Filename);
+end;
+
+function TFTOutlineFont.BBox(const Text: TUCS4StringArray; Advance: boolean): TBoundsDbl;
begin
Result := fOutlineFont.BBox(Text, Advance);
end;
@@ -1852,7 +2112,7 @@ end;
*}
constructor TFTScalableOutlineFont.Create(
- const Filename: string;
+ const Filename: IPath;
Size: integer; OutsetAmount: single;
UseMipmaps: boolean);
var
@@ -1906,6 +2166,15 @@ begin
TFTOutlineFont(fMipmapFonts[Level]).FlushCache(KeepBaseSet);
end;
+procedure TFTScalableOutlineFont.AddFallback(const Filename: IPath);
+var
+ Level: integer;
+begin
+ for Level := 0 to High(fMipmapFonts) do
+ if (fMipmapFonts[Level] <> nil) then
+ TFTOutlineFont(fMipmapFonts[Level]).AddFallback(Filename);
+end;
+
{*
* TFTGlyph
@@ -1935,82 +2204,119 @@ const
*}
cTexSmoothBorder = 1;
-procedure TFTGlyph.Extrude(var TexBuffer: TGLubyteDynArray; Outset: single);
+procedure TFTGlyph.StrokeBorder(var Glyph: FT_Glyph);
+var
+ Outline: PFT_Outline;
+ OuterStroker, InnerStroker: FT_Stroker;
+ OuterNumPoints, InnerNumPoints, GlyphNumPoints: FT_UInt;
+ OuterNumContours, InnerNumContours, GlyphNumContours: FT_UInt;
+ OuterBorder, InnerBorder: FT_StrokerBorder;
+ OutlineFlags: FT_Int;
+ UseStencil: boolean;
+begin
+ // It is possible to extrude the borders of a glyph with FT_Glyph_Stroke
+ // but it will extrude the border to the outside and the inside of a glyph
+ // although we just want to extrude to the outside.
+ // FT_Glyph_StrokeBorder extrudes to the outside but also fills the interior
+ // (this is what we need for bold fonts).
+ // In both cases the inner font and outline font (border) will overlap.
+ // Normally this does not matter but it does if alpha blending is active.
+ // In this case if e.g. the inner color is set to white, the outline to red
+ // and alpha to 0.5 the inner part will not be white it will be pink.
+
+ InnerStroker := nil;
+ OuterStroker := nil;
+
+ // If we are to create the interior of an outlined font (fInner = true)
+ // we have to create two borders:
+ // - one extruded to the outside by fOutset pixels and
+ // - one extruded to the inside by almost 0 zero pixels.
+ // The second one is used as a stencil for the first one, clearing the
+ // interiour of the glyph.
+ // The stencil is not needed to create bold fonts.
+ UseStencil := (fFont.Part = fpInner);
+
+ // we cannot extrude bitmaps, only vector based glyphs.
+ // Check for FT_GLYPH_FORMAT_OUTLINE otherwise a cast to FT_OutlineGlyph is
+ // invalid and FT_Stroker_ParseOutline() will crash
+ if (Glyph.format <> FT_GLYPH_FORMAT_OUTLINE) then
+ Exit;
+
+ Outline := @FT_OutlineGlyph(Glyph).outline;
+
+ OuterBorder := FT_Outline_GetOutsideBorder(Outline);
+ if (OuterBorder = FT_STROKER_BORDER_LEFT) then
+ InnerBorder := FT_STROKER_BORDER_RIGHT
+ else
+ InnerBorder := FT_STROKER_BORDER_LEFT;
+
+ { extrude outer border }
+
+ if (FT_Stroker_New(Glyph.library_, OuterStroker) <> 0) then
+ raise EFontError.Create('FT_Stroker_New failed!');
+ FT_Stroker_Set(
+ OuterStroker,
+ Round(fOutset * 64),
+ FT_STROKER_LINECAP_ROUND,
+ FT_STROKER_LINEJOIN_BEVEL,
+ 0);
+
+ // similar to FT_Glyph_StrokeBorder(inner = FT_FALSE) but it is possible to
+ // use FT_Stroker_ExportBorder() afterwards to combine inner and outer borders
+ if (FT_Stroker_ParseOutline(OuterStroker, Outline, FT_FALSE) <> 0) then
+ raise EFontError.Create('FT_Stroker_ParseOutline failed!');
- procedure SetToMax(var Val1: GLubyte; Val2: GLubyte); {$IFDEF HasInline}inline;{$ENDIF}
+ FT_Stroker_GetBorderCounts(OuterStroker, OuterBorder, OuterNumPoints, OuterNumContours);
+
+ { extrude inner border (= stencil) }
+
+ if (UseStencil) then
begin
- if (Val1 < Val2) then
- Val1 := Val2;
+ if (FT_Stroker_New(Glyph.library_, InnerStroker) <> 0) then
+ raise EFontError.Create('FT_Stroker_New failed!');
+ FT_Stroker_Set(
+ InnerStroker,
+ 63, // extrude at most one pixel to avoid a black border
+ FT_STROKER_LINECAP_ROUND,
+ FT_STROKER_LINEJOIN_BEVEL,
+ 0);
+
+ if (FT_Stroker_ParseOutline(InnerStroker, Outline, FT_FALSE) <> 0) then
+ raise EFontError.Create('FT_Stroker_ParseOutline failed!');
+
+ FT_Stroker_GetBorderCounts(InnerStroker, InnerBorder, InnerNumPoints, InnerNumContours);
+ end else begin
+ InnerNumPoints := 0;
+ InnerNumContours := 0;
end;
-var
- I, X, Y: integer;
- SrcBuffer,TmpBuffer: TGLubyteDynArray;
- TexLine, TexLinePrev, TexLineNext: PGLubyteArray;
- SrcLine: PGLubyteArray;
- AlphaScale: single;
- Value, ValueNeigh, ValueDiag: GLubyte;
-const
- // square-root of 2 used for diagonal neighbor pixels
- cSqrt2 = 1.4142;
- // number of ignored pixels on each edge of the bitmap. Consists of:
- // - border used for font smoothing and
- // - outer (extruded) bitmap pixel (because it is just written but never read)
- cBorder = cTexSmoothBorder + 1;
-begin
- // allocate memory for temporary buffer
- SetLength(SrcBuffer, Length(TexBuffer));
- FillChar(SrcBuffer[0], Length(TexBuffer), 0);
-
- // extrude pixel by pixel
- for I := 1 to Ceil(Outset) do
- begin
- // swap arrays
- TmpBuffer := TexBuffer;
- TexBuffer := SrcBuffer;
- SrcBuffer := TmpBuffer;
-
- // as long as we add an entire pixel of outset, use a solid color.
- // If the fractional part is reached blend, e.g. outline=3.2 -> 3 solid
- // pixels and one blended with alpha=0.2.
- // For the fractional part I = Ceil(Outset) is always true.
- if (I <= Outset) then
- AlphaScale := 1
- else
- AlphaScale := Outset - Trunc(Outset);
-
- // copy data to the expanded bitmap.
- for Y := cBorder to fTexSize.Height - 2*cBorder do
- begin
- TexLine := @TexBuffer[Y*fTexSize.Width];
- TexLinePrev := @TexBuffer[(Y-1)*fTexSize.Width];
- TexLineNext := @TexBuffer[(Y+1)*fTexSize.Width];
- SrcLine := @SrcBuffer[Y*fTexSize.Width];
+ { combine borders (subtract: OuterBorder - InnerBorder) }
- // expand current line's pixels
- for X := cBorder to fTexSize.Width - 2*cBorder do
- begin
- Value := SrcLine[X];
- ValueNeigh := Round(Value * AlphaScale);
- ValueDiag := Round(ValueNeigh / cSqrt2);
+ GlyphNumPoints := InnerNumPoints + OuterNumPoints;
+ GlyphNumContours := InnerNumContours + OuterNumContours;
- SetToMax(TexLine[X], Value);
- SetToMax(TexLine[X-1], ValueNeigh);
- SetToMax(TexLine[X+1], ValueNeigh);
+ // save flags before deletion (TODO: set them on the resulting outline)
+ OutlineFlags := Outline.flags;
- SetToMax(TexLinePrev[X], ValueNeigh);
- SetToMax(TexLinePrev[X-1], ValueDiag);
- SetToMax(TexLinePrev[X+1], ValueDiag);
+ // resize glyph outline to hold inner and outer border
+ FT_Outline_Done(Glyph.Library_, Outline);
+ if (FT_Outline_New(Glyph.Library_, GlyphNumPoints, GlyphNumContours, Outline) <> 0) then
+ raise EFontError.Create('FT_Outline_New failed!');
- SetToMax(TexLineNext[X], ValueNeigh);
- SetToMax(TexLineNext[X-1], ValueDiag);
- SetToMax(TexLineNext[X+1], ValueDiag);
- end;
- end;
- end;
+ Outline.n_points := 0;
+ Outline.n_contours := 0;
- TmpBuffer := nil;
- SetLength(SrcBuffer, 0);
+ // add points to outline. The inner-border is used as a stencil.
+ FT_Stroker_ExportBorder(OuterStroker, OuterBorder, Outline);
+ if (UseStencil) then
+ FT_Stroker_ExportBorder(InnerStroker, InnerBorder, Outline);
+ if (FT_Outline_Check(outline) <> 0) then
+ raise EFontError.Create('FT_Stroker_ExportBorder failed!');
+
+ if (InnerStroker <> nil) then
+ FT_Stroker_Done(InnerStroker);
+ if (OuterStroker <> nil) then
+ FT_Stroker_Done(OuterStroker);
end;
procedure TFTGlyph.CreateTexture(LoadFlags: FT_Int32);
@@ -2025,17 +2331,26 @@ var
TexLine: PGLubyteArray;
CBox: FT_BBox;
begin
+ // we need vector data for outlined glyphs so do not load bitmaps.
+ // This is necessary for mixed fonts that contain bitmap versions of smaller
+ // glyphs, for example in CJK fonts.
+ if (fOutset > 0) then
+ LoadFlags := LoadFlags or FT_LOAD_NO_BITMAP;
+
// load the Glyph for our character
- if (FT_Load_Glyph(fFont.Face, fCharIndex, LoadFlags) <> 0) then
- raise Exception.Create('FT_Load_Glyph failed');
+ if (FT_Load_Glyph(fFace.Data, fCharIndex, LoadFlags) <> 0) then
+ raise EFontError.Create('FT_Load_Glyph failed');
// move the face's glyph into a Glyph object
- if (FT_Get_Glyph(fFont.Face^.glyph, Glyph) <> 0) then
- raise Exception.Create('FT_Get_Glyph failed');
+ if (FT_Get_Glyph(fFace.Data^.glyph, Glyph) <> 0) then
+ raise EFontError.Create('FT_Get_Glyph failed');
+
+ if (fOutset > 0) then
+ StrokeBorder(Glyph);
// store scaled advance width/height in glyph-object
- fAdvance.X := fFont.Face^.glyph^.advance.x / 64 + fOutset*2;
- fAdvance.Y := fFont.Face^.glyph^.advance.y / 64 + fOutset*2;
+ fAdvance.X := fFace.Data^.glyph^.advance.x / 64 + fOutset*2;
+ fAdvance.Y := fFace.Data^.glyph^.advance.y / 64 + fOutset*2;
// get the contour's bounding box (in 1/64th pixels, not font-units)
FT_Glyph_Get_CBox(Glyph, FT_GLYPH_BBOX_UNSCALED, CBox);
@@ -2114,9 +2429,6 @@ begin
end;
end;
- if (fOutset > 0) then
- Extrude(TexBuffer, fOutset);
-
// allocate resources for textures and display lists
glGenTextures(1, @fTexture);
@@ -2151,16 +2463,36 @@ begin
FT_Done_Glyph(Glyph);
end;
-constructor TFTGlyph.Create(Font: TFTFont; ch: WideChar; Outset: single;
+constructor TFTGlyph.Create(Font: TFTFont; ch: UCS4Char; Outset: single;
LoadFlags: FT_Int32);
+var
+ I: integer;
begin
inherited Create();
fFont := Font;
fOutset := Outset;
+ fCharCode := ch;
- // get the Freetype char-index (use default UNICODE charmap)
- fCharIndex := FT_Get_Char_Index(Font.fFace, FT_ULONG(ch));
+ // Note: the default face is also used if no face (neither default nor fallback)
+ // contains a glyph for the given char.
+ fFace := Font.DefaultFace;
+
+ // search the Freetype char-index (use default UNICODE charmap) in the default face
+ fCharIndex := FT_Get_Char_Index(fFace.Data, FT_ULONG(ch));
+ if (fCharIndex = 0) then
+ begin
+ // glyph not in default font, search in fallback font faces
+ for I := 0 to High(Font.FallbackFaces) do
+ begin
+ fCharIndex := FT_Get_Char_Index(Font.FallbackFaces[I].Data, FT_ULONG(ch));
+ if (fCharIndex <> 0) then
+ begin
+ fFace := Font.FallbackFaces[I];
+ Break;
+ end;
+ end;
+ end;
CreateTexture(LoadFlags);
end;
@@ -2336,7 +2668,7 @@ begin
InsertPos := fHash.Count;
end;
-function TGlyphCache.AddGlyph(ch: WideChar; const Glyph: TGlyph): boolean;
+function TGlyphCache.AddGlyph(ch: UCS4Char; const Glyph: TGlyph): boolean;
var
BaseCode: cardinal;
GlyphCode: integer;
@@ -2346,7 +2678,7 @@ var
begin
Result := false;
- BaseCode := cardinal(ch) shr 8;
+ BaseCode := Ord(ch) shr 8;
GlyphTable := FindGlyphTable(BaseCode, InsertPos);
if (GlyphTable = nil) then
begin
@@ -2356,7 +2688,7 @@ begin
end;
// get glyph table offset
- GlyphCode := cardinal(ch) and $FF;
+ GlyphCode := Ord(ch) and $FF;
// insert glyph into table if not present
if (GlyphTable[GlyphCode] = nil) then
begin
@@ -2365,19 +2697,19 @@ begin
end;
end;
-procedure TGlyphCache.DeleteGlyph(ch: WideChar);
+procedure TGlyphCache.DeleteGlyph(ch: UCS4Char);
var
Table: PGlyphTable;
TableIndex, GlyphIndex: integer;
TableEmpty: boolean;
begin
// find table
- Table := FindGlyphTable(cardinal(ch) shr 8, TableIndex);
+ Table := FindGlyphTable(Ord(ch) shr 8, TableIndex);
if (Table = nil) then
Exit;
// find glyph
- GlyphIndex := cardinal(ch) and $FF;
+ GlyphIndex := Ord(ch) and $FF;
if (Table[GlyphIndex] <> nil) then
begin
// destroy glyph
@@ -2402,19 +2734,19 @@ begin
end;
end;
-function TGlyphCache.GetGlyph(ch: WideChar): TGlyph;
+function TGlyphCache.GetGlyph(ch: UCS4Char): TGlyph;
var
InsertPos: integer;
Table: PGlyphTable;
begin
- Table := FindGlyphTable(cardinal(ch) shr 8, InsertPos);
+ Table := FindGlyphTable(Ord(ch) shr 8, InsertPos);
if (Table = nil) then
Result := nil
else
- Result := Table[cardinal(ch) and $FF];
+ Result := Table[Ord(ch) and $FF];
end;
-function TGlyphCache.HasGlyph(ch: WideChar): boolean;
+function TGlyphCache.HasGlyph(ch: UCS4Char): boolean;
begin
Result := (GetGlyph(ch) <> nil);
end;
@@ -2464,7 +2796,7 @@ begin
begin
// initialize freetype
if (FT_Init_FreeType(LibraryInst) <> 0) then
- raise Exception.Create('FT_Init_FreeType failed');
+ raise EFontError.Create('FT_Init_FreeType failed');
end;
Result := LibraryInst;
end;
@@ -2482,10 +2814,10 @@ end;
* TBitmapFont
*}
-constructor TBitmapFont.Create(const Filename: string; Outline: integer;
+constructor TBitmapFont.Create(const Filename: IPath; Outline: integer;
Baseline, Ascender, Descender: integer);
begin
- inherited Create();
+ inherited Create(Filename);
fTex := Texture.LoadTexture(true, Filename, TEXTURE_TYPE_TRANSPARENT, 0);
fTexSize := 1024;
@@ -2494,7 +2826,7 @@ begin
fAscender := Ascender;
fDescender := Descender;
- LoadFontInfo(ChangeFileExt(Filename, '.dat'));
+ LoadFontInfo(Filename.SetExtension('.dat'));
ResetIntern();
end;
@@ -2516,6 +2848,11 @@ begin
ResetIntern();
end;
+procedure TBitmapFont.AddFallback(const Filename: IPath);
+begin
+ // no support for fallbacks
+end;
+
procedure TBitmapFont.CorrectWidths(WidthMult: real; WidthAdd: integer);
var
Count: integer;
@@ -2524,27 +2861,27 @@ begin
fWidths[Count] := Round(fWidths[Count] * WidthMult) + WidthAdd;
end;
-procedure TBitmapFont.LoadFontInfo(const InfoFile: string);
+procedure TBitmapFont.LoadFontInfo(const InfoFile: IPath);
var
- Stream: TFileStream;
+ Stream: TStream;
begin
FillChar(fWidths[0], Length(fWidths), 0);
Stream := nil;
try
- Stream := TFileStream.Create(InfoFile, fmOpenRead);
+ Stream := TBinaryFileStream.Create(InfoFile, fmOpenRead);
Stream.Read(fWidths, 256);
except
- raise Exception.Create('Could not read font info file ''' + InfoFile + '''');
+ raise EFontError.Create('Could not read font info file ''' + InfoFile.ToNative + '''');
end;
Stream.Free;
end;
-function TBitmapFont.BBox(const Text: TWideStringArray; Advance: boolean): TBoundsDbl;
+function TBitmapFont.BBox(const Text: TUCS4StringArray; Advance: boolean): TBoundsDbl;
var
LineIndex, CharIndex: integer;
CharCode: cardinal;
- Line: WideString;
+ Line: UCS4String;
LineWidth: double;
begin
Result.Left := 0;
@@ -2556,7 +2893,7 @@ begin
begin
Line := Text[LineIndex];
LineWidth := 0;
- for CharIndex := 1 to Length(Line) do
+ for CharIndex := 0 to LengthUCS4(Line)-1 do
begin
CharCode := Ord(Line[CharIndex]);
if (CharCode < Length(fWidths)) then
@@ -2567,7 +2904,7 @@ begin
end;
end;
-procedure TBitmapFont.RenderChar(ch: WideChar; var AdvanceX: real);
+procedure TBitmapFont.RenderChar(ch: UCS4Char; var AdvanceX: real);
var
TexX, TexY: real;
TexR, TexB: real;
@@ -2659,20 +2996,20 @@ begin
AdvanceX := AdvanceX + GlyphWidth;
end;
-procedure TBitmapFont.Render(const Text: WideString);
+procedure TBitmapFont.Render(const Text: UCS4String);
var
CharIndex: integer;
AdvanceX: real;
begin
// if there is no text do nothing
- if (Text = '') then
+ if (Text = nil) or (Text[0] = 0) then
Exit;
//Save the current color and alpha (for reflection)
glGetFloatv(GL_CURRENT_COLOR, @fTempColor);
AdvanceX := 0;
- for CharIndex := 1 to Length(Text) do
+ for CharIndex := 0 to LengthUCS4(Text)-1 do
begin
RenderChar(Text[CharIndex], AdvanceX);
end;
diff --git a/cmake/src/base/UGraphic.pas b/cmake/src/base/UGraphic.pas
index 818e49aa..4f0c8c77 100644
--- a/cmake/src/base/UGraphic.pas
+++ b/cmake/src/base/UGraphic.pas
@@ -45,7 +45,6 @@ uses
UImage,
UMusic,
UScreenLoading,
- UScreenWelcome,
UScreenMain,
UScreenName,
UScreenLevel,
@@ -71,12 +70,12 @@ uses
UScreenSongMenu,
UScreenSongJumpto,
{Party Screens}
- UScreenSingModi,
UScreenPartyNewRound,
UScreenPartyScore,
UScreenPartyOptions,
UScreenPartyWin,
UScreenPartyPlayer,
+ UScreenPartyRounds,
{Stats Screens}
UScreenStatMain,
UScreenStatDetail,
@@ -107,7 +106,6 @@ var
ScreenX: integer;
ScreenLoading: TScreenLoading;
- ScreenWelcome: TScreenWelcome;
ScreenMain: TScreenMain;
ScreenName: TScreenName;
ScreenLevel: TScreenLevel;
@@ -133,12 +131,13 @@ var
ScreenSongJumpto: TScreenSongJumpto;
//Party Screens
- ScreenSingModi: TScreenSingModi;
+ //ScreenSingModi: TScreenSingModi;
ScreenPartyNewRound: TScreenPartyNewRound;
ScreenPartyScore: TScreenPartyScore;
ScreenPartyWin: TScreenPartyWin;
ScreenPartyOptions: TScreenPartyOptions;
ScreenPartyPlayer: TScreenPartyPlayer;
+ ScreenPartyRounds: TScreenPartyRounds;
//StatsScreens
ScreenStatMain: TScreenStatMain;
@@ -150,11 +149,12 @@ var
//popup mod
ScreenPopupCheck: TScreenPopupCheck;
ScreenPopupError: TScreenPopupError;
+ ScreenPopupInfo: TScreenPopupInfo;
//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_Left: array[1..6] of TTexture; //rename to tex_note_left
+ Tex_Mid: array[1..6] of TTexture; //rename to tex_note_mid
+ Tex_Right: array[1..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
@@ -206,6 +206,10 @@ var
// textures for software mouse cursor
Tex_Cursor_Unpressed: TTexture;
Tex_Cursor_Pressed: TTexture;
+
+
+ PboSupported: boolean;
+
const
Skin_BGColorR = 1;
Skin_BGColorG = 1;
@@ -261,6 +265,7 @@ const
Skin_P2_ScoreL = 640;
procedure Initialize3D (Title: string);
+procedure Finalize3D;
procedure Reinitialize3D;
procedure SwapBuffers;
@@ -268,7 +273,7 @@ procedure LoadTextures;
procedure InitializeScreen;
procedure LoadLoadingScreen;
procedure LoadScreens;
-procedure UnLoadScreens;
+procedure UnloadScreens;
function LoadingThreadFunction: integer;
@@ -281,12 +286,18 @@ uses
UIni,
UDisplay,
UCommandLine,
- UPath;
+ UPathUtils;
procedure LoadFontTextures;
begin
Log.LogStatus('Building Fonts', 'LoadTextures');
- BuildFont;
+ BuildFonts;
+end;
+
+procedure UnloadFontTextures;
+begin
+ Log.LogStatus('Kill Fonts', 'UnloadFontTextures');
+ KillFonts;
end;
procedure LoadTextures;
@@ -298,15 +309,6 @@ var
begin
Log.LogStatus('Loading Textures', 'LoadTextures');
- // FIXME: do we need this? (REMOVE otherwise)
- Tex_Left[0] := Texture.LoadTexture(Skin.GetTextureFileName('GrayLeft'), TEXTURE_TYPE_TRANSPARENT, 0);
- // FIXME: do we need this? (REMOVE otherwise)
- Tex_Mid[0] := Texture.LoadTexture(Skin.GetTextureFileName('GrayMid'), TEXTURE_TYPE_PLAIN, 0);
- // FIXME: do we need this? (REMOVE otherwise)
- Tex_Right[0] := Texture.LoadTexture(Skin.GetTextureFileName('GrayRight'), TEXTURE_TYPE_TRANSPARENT, 0);
-
- 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 !?
@@ -314,7 +316,29 @@ begin
begin
LoadColor(R, G, B, 'P' + IntToStr(P) + 'Light');
Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255);
-
+
+ { some colors for tests
+ Col := $10000 * Round(0.02*255) + $100 * Round(0.6 *255) + Round(0.8 *255); //blue
+ Col := $10000 * Round(0.8 *255) ; //red
+ Col := $100 * Round(0.85*255) ; //green
+ Col := $10000 * 255 + $100 * Round(0.52*255) ; //orange
+ Col := $10000 * 255 + $100 * 255 ; //yellow
+ Col := $10000 * Round(0.82*255) + 255 ; //purple
+ Col := $10000 * Round(0.22*255) + $100 * Round(0.39*255) + Round(0.64*255); //dark blue
+ Col := $10000 * Round(0 *255) + $100 * Round(0 *255) + Round(0 *255); //black
+ Col := $10000 * Round(1.0 *255) + $100 * Round(0.43*255) + Round(0.70*255); //pink
+ Col := 0; //black
+ Col := $FFFFFF; //white
+ Col := $FF0000; //red
+ Col := $00FF00; //green
+ Col := $002200; //light green
+ Col := $002222; //light greenblue
+ Col := $222200; //light yellow
+ Col := $340000; //red
+ Col := $FF6EB4; //pink
+ Col := $333333; //grey
+ }
+
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);
@@ -340,7 +364,7 @@ begin
Tex_Cursor_Unpressed := Texture.LoadTexture(Skin.GetTextureFileName('Cursor'), TEXTURE_TYPE_TRANSPARENT, 0);
- if (Skin.GetTextureFileName('Cursor_Pressed') <> '') then
+ if (Skin.GetTextureFileName('Cursor_Pressed').IsSet) then
Tex_Cursor_Pressed := Texture.LoadTexture(Skin.GetTextureFileName('Cursor_Pressed'), TEXTURE_TYPE_TRANSPARENT, 0)
else
Tex_Cursor_Pressed.TexNum := 0;
@@ -389,14 +413,14 @@ begin
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);
+ Tex_SingLineBonusBack[P] := Texture.LoadTexture(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);
+ Tex_ScoreBG[P] := Texture.LoadTexture(Skin.GetTextureFileName('ScoreBG'), TEXTURE_TYPE_COLORIZED, Col);
end;
@@ -411,23 +435,23 @@ 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);
+ Tex_Score_NoteBarLevel_Dark[P] := Texture.LoadTexture(Skin.GetTextureFileName('ScoreLevel_Dark'), TEXTURE_TYPE_COLORIZED, Col);
+ Tex_Score_NoteBarRound_Dark[P] := Texture.LoadTexture(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);
+ Tex_Score_NoteBarLevel_Light[P] := Texture.LoadTexture(Skin.GetTextureFileName('ScoreLevel_Light'), TEXTURE_TYPE_COLORIZED, Col);
+ Tex_Score_NoteBarRound_Light[P] := Texture.LoadTexture(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);
+ Tex_Score_NoteBarLevel_Lightest[P] := Texture.LoadTexture(Skin.GetTextureFileName('ScoreLevel_Lightest'), TEXTURE_TYPE_COLORIZED, Col);
+ Tex_Score_NoteBarRound_Lightest[P] := Texture.LoadTexture(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);
+ Tex_Score_Ratings[P] := Texture.LoadTexture(Skin.GetTextureFileName('Rating_'+IntToStr(P)), TEXTURE_TYPE_TRANSPARENT, 0);
end;
Log.LogStatus('Loading Textures - Done', 'LoadTextures');
@@ -448,6 +472,12 @@ begin
// Other extensions e.g. OpenGL 1.3-2.0 or Framebuffer-Object might be loaded here
// ...
//Load_GL_EXT_framebuffer_object();
+
+ // PBO functions are loaded with VBO
+ //PboSupported := Load_GL_ARB_pixel_buffer_object()
+ // and Load_GL_ARB_vertex_buffer_object();
+ //Log.LogWarn('PBOSupported: ' + BoolToStr(PboSupported, true), 'LoadOpenGLExtensions');
+ PboSupported := false;
end;
const
@@ -464,12 +494,17 @@ begin
end;
// load icon image (must be 32x32 for win32)
- Icon := LoadImage(ResourcesPath + WINDOW_ICON);
+ Icon := LoadImage(ResourcesPath.Append(WINDOW_ICON));
if (Icon <> nil) then
- SDL_WM_SetIcon(Icon, 0);
+ SDL_WM_SetIcon(Icon, nil);
SDL_WM_SetCaption(PChar(Title), nil);
+ { center window }
+ SDL_putenv('SDL_VIDEO_WINDOW_POS=center');
+ { workaround for buggy Intel 3D driver on Linux }
+ SDL_putenv('texture_tiling=false');
+
//Log.BenchmarkStart(2);
InitializeScreen;
@@ -573,6 +608,13 @@ begin
glMatrixMode(GL_MODELVIEW);
end;
+procedure Finalize3D;
+begin
+ // TODO: finalize other stuff
+ UnloadFontTextures;
+ SDL_QuitSubSystem(SDL_INIT_VIDEO);
+end;
+
procedure Reinitialize3D;
begin
InitializeScreen;
@@ -667,7 +709,7 @@ end;
procedure LoadLoadingScreen;
begin
ScreenLoading := TScreenLoading.Create;
- ScreenLoading.onShow;
+ ScreenLoading.OnShow;
Display.CurrentScreen := @ScreenLoading;
@@ -682,15 +724,13 @@ end;
procedure LoadScreens;
begin
{ ScreenLoading := TScreenLoading.Create;
- ScreenLoading.onShow;
+ 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;
@@ -733,8 +773,8 @@ begin
// 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);
+ //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;
@@ -743,6 +783,8 @@ begin
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);
+ ScreenPopupInfo := TScreenPopupInfo.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Popup (Info)', 3); Log.BenchmarkStart(3);
ScreenPartyNewRound := TScreenPartyNewRound.Create;
Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyNewRound', 3); Log.BenchmarkStart(3);
ScreenPartyScore := TScreenPartyScore.Create;
@@ -753,6 +795,8 @@ begin
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);
+ ScreenPartyRounds := TScreenPartyRounds.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyRounds', 3); Log.BenchmarkStart(3);
ScreenStatMain := TScreenStatMain.Create;
Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Stat Main', 3); Log.BenchmarkStart(3);
ScreenStatDetail := TScreenStatDetail.Create;
@@ -768,39 +812,41 @@ begin
Result:= 1;
end;
-procedure UnLoadScreens;
+procedure UnloadScreens;
begin
- ScreenMain.Destroy;
- ScreenName.Destroy;
- ScreenLevel.Destroy;
- ScreenSong.Destroy;
- ScreenSing.Destroy;
- ScreenScore.Destroy;
- ScreenTop5.Destroy;
- ScreenOptions.Destroy;
- ScreenOptionsGame.Destroy;
- ScreenOptionsGraphics.Destroy;
- ScreenOptionsSound.Destroy;
- ScreenOptionsLyrics.Destroy;
-// ScreenOptionsThemes.Destroy;
- ScreenOptionsRecord.Destroy;
- ScreenOptionsAdvanced.Destroy;
- ScreenEditSub.Destroy;
- ScreenEdit.Destroy;
- ScreenEditConvert.Destroy;
- ScreenOpen.Destroy;
- ScreenSingModi.Destroy;
- ScreenSongMenu.Destroy;
- ScreenSongJumpto.Destroy;
- ScreenPopupCheck.Destroy;
- ScreenPopupError.Destroy;
- ScreenPartyNewRound.Destroy;
- ScreenPartyScore.Destroy;
- ScreenPartyWin.Destroy;
- ScreenPartyOptions.Destroy;
- ScreenPartyPlayer.Destroy;
- ScreenStatMain.Destroy;
- ScreenStatDetail.Destroy;
+ ScreenMain.Free;
+ ScreenName.Free;
+ ScreenLevel.Free;
+ ScreenSong.Free;
+ ScreenSing.Free;
+ ScreenScore.Free;
+ ScreenTop5.Free;
+ ScreenOptions.Free;
+ ScreenOptionsGame.Free;
+ ScreenOptionsGraphics.Free;
+ ScreenOptionsSound.Free;
+ ScreenOptionsLyrics.Free;
+// ScreenOptionsThemes.Free;
+ ScreenOptionsRecord.Free;
+ ScreenOptionsAdvanced.Free;
+ ScreenEditSub.Free;
+ ScreenEdit.Free;
+ ScreenEditConvert.Free;
+ ScreenOpen.Free;
+ //ScreenSingModi.Free;
+ ScreenSongMenu.Free;
+ ScreenSongJumpto.Free;
+ ScreenPopupCheck.Free;
+ ScreenPopupError.Free;
+ ScreenPopupInfo.Free;
+ ScreenPartyNewRound.Free;
+ ScreenPartyScore.Free;
+ ScreenPartyWin.Free;
+ ScreenPartyOptions.Free;
+ ScreenPartyPlayer.Free;
+ ScreenPartyRounds.Free;
+ ScreenStatMain.Free;
+ ScreenStatDetail.Free;
end;
end.
diff --git a/cmake/src/base/UImage.pas b/cmake/src/base/UImage.pas
index 60b0a3a2..1866316e 100644
--- a/cmake/src/base/UImage.pas
+++ b/cmake/src/base/UImage.pas
@@ -34,7 +34,8 @@ interface
{$I switches.inc}
uses
- SDL;
+ SDL,
+ UPath;
{$DEFINE HavePNG}
{$DEFINE HaveBMP}
@@ -131,20 +132,20 @@ type
*******************************************************)
{$IFDEF HavePNG}
-function WritePNGImage(const FileName: string; Surface: PSDL_Surface): boolean;
+function WritePNGImage(const FileName: IPath; Surface: PSDL_Surface): boolean;
{$ENDIF}
{$IFDEF HaveBMP}
-function WriteBMPImage(const FileName: string; Surface: PSDL_Surface): boolean;
+function WriteBMPImage(const FileName: IPath; Surface: PSDL_Surface): boolean;
{$ENDIF}
{$IFDEF HaveJPG}
-function WriteJPGImage(const FileName: string; Surface: PSDL_Surface; Quality: integer): boolean;
+function WriteJPGImage(const FileName: IPath; Surface: PSDL_Surface; Quality: integer): boolean;
{$ENDIF}
(*******************************************************
* Image loading
*******************************************************)
-function LoadImage(const Filename: string): PSDL_Surface;
+function LoadImage(const Filename: IPath): PSDL_Surface;
(*******************************************************
* Image manipulation
@@ -181,6 +182,7 @@ uses
zlib,
sdl_image,
sdlutils,
+ sdlstreams,
UCommon,
ULog;
@@ -282,26 +284,26 @@ end;
procedure user_read_data(png_ptr: png_structp; data: png_bytep; length: png_size_t); cdecl;
var
- inFile: TFileStream;
+ inFile: TStream;
begin
- inFile := TFileStream(png_get_io_ptr(png_ptr));
+ inFile := TStream(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;
+ outFile: TStream;
begin
- outFile := TFileStream(png_get_io_ptr(png_ptr));
+ outFile := TStream(png_get_io_ptr(png_ptr));
outFile.Write(data^, length);
end;
procedure user_flush_data(png_ptr: png_structp); cdecl;
//var
-// outFile: TFileStream;
+// outFile: TStream;
begin
// binary files are flushed automatically, Flush() works with Text-files only
- //outFile := TFileStream(png_get_io_ptr(png_ptr));
+ //outFile := TStream(png_get_io_ptr(png_ptr));
//outFile.Flush();
end;
@@ -323,11 +325,11 @@ end;
(*
* ImageData must be in RGB-format
*)
-function WritePNGImage(const FileName: string; Surface: PSDL_Surface): boolean;
+function WritePNGImage(const FileName: IPath; Surface: PSDL_Surface): boolean;
var
png_ptr: png_structp;
info_ptr: png_infop;
- pngFile: TFileStream;
+ pngFile: TStream;
row: integer;
rowData: array of png_bytep;
// rowStride: integer;
@@ -339,9 +341,9 @@ begin
// open file for writing
try
- pngFile := TFileStream.Create(FileName, fmCreate);
+ pngFile := TBinaryFileStream.Create(FileName, fmCreate);
except
- Log.LogError('Could not open file: "' + FileName + '"', 'WritePngImage');
+ Log.LogError('Could not open file: "' + FileName.ToNative + '"', 'WritePngImage');
Exit;
end;
@@ -500,9 +502,9 @@ type
(*
* ImageData must be in BGR-format
*)
-function WriteBMPImage(const FileName: string; Surface: PSDL_Surface): boolean;
+function WriteBMPImage(const FileName: IPath; Surface: PSDL_Surface): boolean;
var
- bmpFile: TFileStream;
+ bmpFile: TStream;
FileInfo: BITMAPINFOHEADER;
FileHeader: BITMAPFILEHEADER;
Converted: boolean;
@@ -513,9 +515,9 @@ begin
// open file for writing
try
- bmpFile := TFileStream.Create(FileName, fmCreate);
+ bmpFile := TBinaryFileStream.Create(FileName, fmCreate);
except
- Log.LogError('Could not open file: "' + FileName + '"', 'WriteBMPImage');
+ Log.LogError('Could not open file: "' + FileName.ToNative + '"', 'WriteBMPImage');
Exit;
end;
@@ -579,7 +581,7 @@ begin
Result := true;
finally
- Log.LogError('Could not write file: "' + FileName + '"', 'WriteBMPImage');
+ Log.LogError('Could not write file: "' + FileName.ToNative + '"', 'WriteBMPImage');
end;
if (Converted) then
@@ -597,20 +599,21 @@ end;
{$IFDEF HaveJPG}
-function WriteJPGImage(const FileName: string; Surface: PSDL_Surface; Quality: integer): boolean;
+function WriteJPGImage(const FileName: IPath; Surface: PSDL_Surface; Quality: integer): boolean;
var
{$IFDEF Delphi}
- Bitmap: TBitmap;
+ Bitmap: TBitmap;
BitmapInfo: TBitmapInfo;
- Jpeg: TJpegImage;
- row: integer;
+ Jpeg: TJpegImage;
+ row: integer;
+ FileStream: TBinaryFileStream;
{$ELSE}
cinfo: jpeg_compress_struct;
jerr : jpeg_error_mgr;
- jpgFile: TFileStream;
+ jpgFile: TBinaryFileStream;
rowPtr: array[0..0] of JSAMPROW;
{$ENDIF}
- converted: boolean;
+ converted: boolean;
begin
Result := false;
@@ -669,19 +672,32 @@ begin
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);
+ // init with nil so Free() will not fail if an exception occurs
+ Jpeg := nil;
+ Bitmap := nil;
+ FileStream := nil;
+
+ try
+ Jpeg := TJPEGImage.Create;
+ Jpeg.Assign(Bitmap);
+
+ // compress image (don't forget this line, otherwise it won't be compressed)
+ Jpeg.CompressionQuality := Quality;
+ Jpeg.Compress();
+
+ // Note: FileStream needed for unicode filename support
+ FileStream := TBinaryFileStream.Create(Filename, fmCreate);
+ Jpeg.SaveToStream(FileStream);
+ finally
+ FileStream.Free;
+ Bitmap.Free;
+ Jpeg.Free;
+ end;
except
- Log.LogError('Could not save file: "' + FileName + '"', 'WriteJPGImage');
+ Log.LogError('Could not save file: "' + FileName.ToNative + '"', 'WriteJPGImage');
Exit;
end;
- Jpeg.Free;
{$ELSE}
// based on example.pas in FPC's packages/base/pasjpeg directory
@@ -703,9 +719,9 @@ begin
// open file for writing
try
- jpgFile := TFileStream.Create(FileName, fmCreate);
+ jpgFile := TBinaryFileStream.Create(FileName, fmCreate);
except
- Log.LogError('Could not open file: "' + FileName + '"', 'WriteJPGImage');
+ Log.LogError('Could not open file: "' + FileName.ToNative + '"', 'WriteJPGImage');
Exit;
end;
@@ -763,27 +779,29 @@ end;
(*
* Loads an image from the given file
*)
-function LoadImage(const Filename: string): PSDL_Surface;
+function LoadImage(const Filename: IPath): PSDL_Surface;
var
- FilenameFound: string;
+ FilenameCaseAdj: IPath;
+ FileStream: TBinaryFileStream;
+ SDLStream: PSDL_RWops;
begin
- Result := nil;
+ Result := nil;
- // FileExistsInsensitive() requires a var-arg
- FilenameFound := Filename;
-
- // try to find the file case insensitive
- if (not FileExistsInsensitive(FilenameFound)) then
+ // try to adjust filename's case and check if it exists
+ FilenameCaseAdj := Filename.AdjustCase(false);
+ if (not FilenameCaseAdj.IsFile) then
begin
- Log.LogError('Image-File does not exist "'+FilenameFound+'"', 'LoadImage');
+ Log.LogError('Image-File does not exist "' + FilenameCaseAdj.ToNative + '"', 'LoadImage');
Exit;
end;
// load from file
try
- Result := IMG_Load(PChar(FilenameFound));
+ SDLStream := SDLStreamSetup(TBinaryFileStream.Create(FilenameCaseAdj, fmOpenRead));
+ Result := IMG_Load_RW(SDLStream, 1);
+ // Note: TBinaryFileStream is freed by SDLStream. SDLStream by IMG_Load_RW().
except
- Log.LogError('Could not load from file "'+FilenameFound+'"', 'LoadImage');
+ Log.LogError('Could not load from file "' + FilenameCaseAdj.ToNative + '"', 'LoadImage');
Exit;
end;
end;
@@ -794,17 +812,13 @@ end;
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;
+ Result :=
+ (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)
+ ;
end;
procedure ScaleImage(var ImgSurface: PSDL_Surface; Width, Height: cardinal);
@@ -885,7 +899,7 @@ begin
end;
*)
-procedure ColorizeImage(ImgSurface: PSDL_Surface; NewColor: cardinal);
+procedure ColorizeImage(ImgSurface: PSDL_Surface; NewColor: longword);
// First, the rgb colors are converted to hsv, second hue is replaced by
// the NewColor, saturation and value remain unchanged, finally this
@@ -893,7 +907,7 @@ procedure ColorizeImage(ImgSurface: PSDL_Surface; NewColor: cardinal);
// For the conversion algorithms of colors from rgb to hsv space
// and back simply check the wikipedia.
// In order to speed up starting time of USDX the division of reals is
- // replaced by division of longwords, shifted by 10 bits to keep
+ // replaced by division of longints, shifted by 10 bits to keep
// digits.
// The use of longwards leeds to some type size mismatch warnings
@@ -904,8 +918,8 @@ procedure ColorizeImage(ImgSurface: PSDL_Surface; NewColor: cardinal);
function ColorToHue(const Color: longword): longword;
// returns hue within the range [0.0-6.0] but shl 10, ie. times 1024
var
- Red, Green, Blue: longword;
- Min, Max, Delta: longword;
+ Red, Green, Blue: longint;
+ Min, Max, Delta: longint;
Hue: double;
begin
// extract the colors
@@ -933,6 +947,8 @@ procedure ColorizeImage(ImgSurface: PSDL_Surface; NewColor: cardinal);
// The division by Delta is done separately afterwards.
// Necessary because Delphi did not do the type conversion from
// longword to double as expected.
+ // After the change to longint, we may not need it, but left for now
+ // Something to check
if (Max = Red ) then Hue := Green - Blue
else if (Max = Green) then Hue := 2.0*Delta + Blue - Red
else if (Max = Blue ) then Hue := 4.0*Delta + Red - Green;
@@ -940,6 +956,8 @@ procedure ColorizeImage(ImgSurface: PSDL_Surface; NewColor: cardinal);
if (Hue < 0.0) then
Hue := Hue + 6.0;
Result := trunc(Hue*1024); // '*1024' is shl 10
+ // if NewColor = $000000 then
+ // Log.LogError ('Hue: ' + FloatToStr(Hue), 'ColorToHue');
end;
end;
@@ -952,6 +970,8 @@ var
Min, Max, Delta: longword;
HueInteger: longword;
f, p, q, t: longword;
+ GreyReal: real;
+ Grey: byte;
begin
Pixel := ImgSurface^.Pixels;
@@ -965,8 +985,48 @@ begin
Log.LogError ('ColorizeImage: The pixel size should be 4, but it is '
+ IntToStr(ImgSurface^.format.BytesPerPixel));
+ // Check whether the new color is white, grey or black,
+ // because a greyscale must be created in a different
+ // way.
+
+ Red := ((NewColor and $ff0000) shr 16); // R
+ Green := ((NewColor and $ff00) shr 8); // G
+ Blue := (NewColor and $ff) ; // B
+
+ if (Red = Green) and (Green = Blue) then // greyscale image
+ begin
+ // According to these recommendations (ITU-R BT.709-5)
+ // the conversion parameters for rgb to greyscale are
+ // 0.299, 0.587, 0.114
+ for PixelIndex := 0 to (ImgSurface^.W * ImgSurface^.H)-1 do
+ begin
+ PixelColors := PByteArray(Pixel);
+ {$IFDEF FPC_BIG_ENDIAN}
+ GreyReal := 0.299*PixelColors[3] + 0.587*PixelColors[2] + 0.114*PixelColors[1];
+ // PixelColors[0] is alpha and remains untouched
+ {$ELSE}
+ GreyReal := 0.299*PixelColors[0] + 0.587*PixelColors[1] + 0.114*PixelColors[2];
+ // PixelColors[3] is alpha and remains untouched
+ {$ENDIF}
+ Grey := round(GreyReal);
+ {$IFDEF FPC_BIG_ENDIAN}
+ PixelColors[3] := Grey;
+ PixelColors[2] := Grey;
+ PixelColors[1] := Grey;
+ // PixelColors[0] is alpha and remains untouched
+ {$ELSE}
+ PixelColors[0] := Grey;
+ PixelColors[1] := Grey;
+ PixelColors[2] := Grey;
+ // PixelColors[3] is alpha and remains untouched
+ {$ENDIF}
+ Inc(Pixel, ImgSurface^.format.BytesPerPixel);
+ end;
+ exit; // we are done with a greyscale image.
+ end;
+
Hue := ColorToHue(NewColor); // Hue is shl 10
- f := Hue and $3ff; // f is the dezimal part of hue
+ f := Hue and $3ff; // f is the dezimal part of hue
HueInteger := Hue shr 10;
for PixelIndex := 0 to (ImgSurface^.W * ImgSurface^.H)-1 do
@@ -1036,9 +1096,9 @@ begin
// shr 10 corrects that Sat and f are shl 10
// the resulting p, q and t are unshifted
- p := (Max*(1024-Sat)) shr 10;
- q := (Max*(1024-(Sat*f) shr 10)) shr 10;
- t := (Max*(1024-(Sat*(1024-f)) shr 10)) shr 10;
+ p := (Max * (1024 - Sat )) shr 10;
+ q := (Max * (1024 - (Sat * f ) shr 10)) shr 10;
+ t := (Max * (1024 - (Sat * (1024 - f)) shr 10)) shr 10;
// The above 3 lines give type size mismatch warning, but all variables are longword and the ranges should be ok.
diff --git a/cmake/src/base/UIni.pas b/cmake/src/base/UIni.pas
index 2bcc7305..a4c85a3b 100644
--- a/cmake/src/base/UIni.pas
+++ b/cmake/src/base/UIni.pas
@@ -36,8 +36,12 @@ interface
uses
Classes,
IniFiles,
+ SysUtils,
+ UCommon,
ULog,
- SysUtils;
+ UTextEncoding,
+ UFilesystem,
+ UPath;
type
// TInputDeviceConfig stores the configuration for an input device.
@@ -59,9 +63,13 @@ type
TInputDeviceConfig = record
Name: string;
Input: integer;
+ Latency: integer; //**< latency in ms, or LATENCY_AUTODETECT for default
ChannelToPlayerMap: array of integer;
end;
+const
+ LATENCY_AUTODETECT = -1;
+
type
//Options
@@ -70,11 +78,9 @@ type
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;
+ function ReadArrayIndex(const SearchArray: array of UTF8String; IniFile: TCustomIniFile;
IniSection: string; IniProperty: string; Default: integer): integer;
procedure TranslateOptionValues;
@@ -85,14 +91,14 @@ type
procedure LoadScreenModes(IniFile: TCustomIniFile);
public
- Name: array[0..11] of string;
+ Name: array[0..11] of UTF8String;
// Templates for Names Mod
- NameTeam: array[0..2] of string;
- NameTemplate: array[0..11] of string;
+ NameTeam: array[0..2] of UTF8String;
+ NameTemplate: array[0..11] of UTF8String;
//Filename of the opened iniFile
- Filename: string;
+ Filename: IPath;
// Game
Players: integer;
@@ -125,6 +131,8 @@ type
AudioOutputBufferSizeIndex: integer;
VoicePassthrough: integer;
+ SyncTo: integer;
+
//Song Preview
PreviewVolume: integer;
PreviewFading: integer;
@@ -132,7 +140,6 @@ type
// Lyrics
LyricsFont: integer;
LyricsEffect: integer;
- Solmization: integer;
NoteLines: integer;
// Themes
@@ -165,173 +172,205 @@ type
var
Ini: TIni;
- IResolution: array of string;
- ILanguage: array of string;
- ITheme: array of string;
- ISkin: array of string;
+ IResolution: TUTF8StringDynArray;
+ ILanguage: TUTF8StringDynArray;
+ ITheme: TUTF8StringDynArray;
+ ISkin: TUTF8StringDynArray;
+
+{*
+ * Options
+ *}
const
- IPlayers: array[0..4] of string = ('1', '2', '3', '4', '6');
- IPlayersVals: array[0..4] of integer = ( 1 , 2 , 3 , 4 , 6 );
+ IPlayers: array[0..4] of UTF8String = ('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');
+ IDifficulty: array[0..2] of UTF8String = ('Easy', 'Medium', 'Hard');
+ ITabs: array[0..1] of UTF8String = ('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;
+const
+ ISorting: array[0..6] of UTF8String = ('Edition', 'Genre', 'Language', 'Folder', 'Title', 'Artist', 'Artist2');
+type
+ TSortingType = (sEdition, sGenre, sLanguage, sFolder, sTitle, sArtist, sArtist2);
- IDebug: array[0..1] of string = ('Off', 'On');
+const
+ IDebug: array[0..1] of UTF8String = ('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');
+ IScreens: array[0..1] of UTF8String = ('1', '2');
+ IFullScreen: array[0..1] of UTF8String = ('Off', 'On');
+ IDepth: array[0..1] of UTF8String = ('16 bit', '32 bit');
+ IVisualizer: array[0..2] of UTF8String = ('Off', 'WhenNoVideo','On');
- IBackgroundMusic: array[0..1] of string = ('Off', 'On');
+ IBackgroundMusic: array[0..1] of UTF8String = ('Off', 'On');
- ITextureSize: array[0..3] of string = ('64', '128', '256', '512');
- ITextureSizeVals: array[0..3] of integer = ( 64, 128, 256, 512);
+ ITextureSize: array[0..3] of UTF8String = ('64', '128', '256', '512');
+ ITextureSizeVals: array[0..3] of integer = ( 64, 128, 256, 512);
- ISingWindow: array[0..1] of string = ('Small', 'Big');
+ ISingWindow: array[0..1] of UTF8String = ('Small', 'Big');
//SingBar Mod
- IOscilloscope: array[0..1] of string = ('Off', 'On');
+ IOscilloscope: array[0..1] of UTF8String = ('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]');
+ ISpectrum: array[0..1] of UTF8String = ('Off', 'On');
+ ISpectrograph: array[0..1] of UTF8String = ('Off', 'On');
+ IMovieSize: array[0..2] of UTF8String = ('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');
+ IClickAssist: array[0..1] of UTF8String = ('Off', 'On');
+ IBeatClick: array[0..1] of UTF8String = ('Off', 'On');
+ ISavePlayback: array[0..1] of UTF8String = ('Off', 'On');
- IThreshold: array[0..3] of string = ('5%', '10%', '15%', '20%');
+ IThreshold: array[0..3] of UTF8String = ('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');
+ IVoicePassthrough: array[0..1] of UTF8String = ('Off', 'On');
+
+const
+ ISyncTo: array[0..2] of UTF8String = ('Music', 'Lyrics', 'Off');
+type
+ TSyncToType = (stMusic, stLyrics, stOff);
- 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 );
+const
+ IAudioOutputBufferSize: array[0..9] of UTF8String = ('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 );
+ IAudioInputBufferSize: array[0..9] of UTF8String = ('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 );
+ IPreviewVolume: array[0..10] of UTF8String = ('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 );
+ IPreviewFading: array[0..5] of UTF8String = ('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');
+ ILyricsFont: array[0..2] of UTF8String = ('Plain', 'OLine1', 'OLine2');
+ ILyricsEffect: array[0..4] of UTF8String = ('Simple', 'Zoom', 'Slide', 'Ball', 'Shift');
+ INoteLines: array[0..1] of UTF8String = ('Off', 'On');
- IColor: array[0..8] of string = ('Blue', 'Green', 'Pink', 'Red', 'Violet', 'Orange', 'Yellow', 'Brown', 'Black');
+ IColor: array[0..8] of UTF8String = ('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..1] of string = ('Off', 'On');
- IPartyPopup: array[0..1] of string = ('Off', 'On');
+ ILoadAnimation: array[0..1] of UTF8String = ('Off', 'On');
+ IEffectSing: array[0..1] of UTF8String = ('Off', 'On');
+ IScreenFade: array[0..1] of UTF8String = ('Off', 'On');
+ IAskbeforeDel: array[0..1] of UTF8String = ('Off', 'On');
+ IOnSongClick: array[0..2] of UTF8String = ('Sing', 'Select Players', 'Open Menu');
+ sStartSing = 0;
+ sSelectPlayer = 1;
+ sOpenMenu = 2;
+
+ ILineBonus: array[0..1] of UTF8String = ('Off', 'On');
+ IPartyPopup: array[0..1] of UTF8String = ('Off', 'On');
- IJoypad: array[0..1] of string = ('Off', 'On');
- IMouse: array[0..2] of string = ('Off', 'Hardware Cursor', 'Software Cursor');
+ IJoypad: array[0..1] of UTF8String = ('Off', 'On');
+ IMouse: array[0..2] of UTF8String = ('Off', 'Hardware Cursor', 'Software Cursor');
// 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');
+ IChannelPlayer: array[0..6] of UTF8String = ('Off', '1', '2', '3', '4', '5', '6');
+ IMicBoost: array[0..3] of UTF8String = ('Off', '+6dB', '+12dB', '+18dB');
+
+{*
+ * Translated options
+ *}
var
- IDifficultyTranslated: array[0..2] of string = ('Easy', 'Medium', 'Hard');
- ITabsTranslated: array[0..1] of string = ('Off', 'On');
+ ILanguageTranslated: array of UTF8String;
- ISortingTranslated: array[0..7] of string = ('Edition', 'Genre', 'Language', 'Folder', 'Title', 'Artist', 'Title2', 'Artist2');
+ IDifficultyTranslated: array[0..2] of UTF8String = ('Easy', 'Medium', 'Hard');
+ ITabsTranslated: array[0..1] of UTF8String = ('Off', 'On');
- IDebugTranslated: array[0..1] of string = ('Off', 'On');
+ ISortingTranslated: array[0..6] of UTF8String = ('Edition', 'Genre', 'Language', 'Folder', 'Title', 'Artist', 'Artist2');
- IFullScreenTranslated: array[0..1] of string = ('Off', 'On');
- IVisualizerTranslated: array[0..2] of string = ('Off', 'WhenNoVideo','On');
+ IDebugTranslated: array[0..1] of UTF8String = ('Off', 'On');
- IBackgroundMusicTranslated: array[0..1] of string = ('Off', 'On');
- ISingWindowTranslated: array[0..1] of string = ('Small', 'Big');
+ IFullScreenTranslated: array[0..1] of UTF8String = ('Off', 'On');
+ IVisualizerTranslated: array[0..2] of UTF8String = ('Off', 'WhenNoVideo','On');
+
+ IBackgroundMusicTranslated: array[0..1] of UTF8String = ('Off', 'On');
+ ISingWindowTranslated: array[0..1] of UTF8String = ('Small', 'Big');
//SingBar Mod
- IOscilloscopeTranslated: array[0..1] of string = ('Off', 'On');
+ IOscilloscopeTranslated: array[0..1] of UTF8String = ('Off', 'On');
+
+ ISpectrumTranslated: array[0..1] of UTF8String = ('Off', 'On');
+ ISpectrographTranslated: array[0..1] of UTF8String = ('Off', 'On');
+ IMovieSizeTranslated: array[0..2] of UTF8String = ('Half', 'Full [Vid]', 'Full [BG+Vid]');
- ISpectrumTranslated: array[0..1] of string = ('Off', 'On');
- ISpectrographTranslated: array[0..1] of string = ('Off', 'On');
- IMovieSizeTranslated: array[0..2] of string = ('Half', 'Full [Vid]', 'Full [BG+Vid]');
+ IClickAssistTranslated: array[0..1] of UTF8String = ('Off', 'On');
+ IBeatClickTranslated: array[0..1] of UTF8String = ('Off', 'On');
+ ISavePlaybackTranslated: array[0..1] of UTF8String = ('Off', 'On');
- IClickAssistTranslated: array[0..1] of string = ('Off', 'On');
- IBeatClickTranslated: array[0..1] of string = ('Off', 'On');
- ISavePlaybackTranslated: array[0..1] of string = ('Off', 'On');
+ IVoicePassthroughTranslated: array[0..1] of UTF8String = ('Off', 'On');
- IVoicePassthroughTranslated: array[0..1] of string = ('Off', 'On');
+ ISyncToTranslated: array[0..2] of UTF8String = ('Music', 'Lyrics', 'Off');
//Song Preview
- IPreviewVolumeTranslated: array[0..10] of string = ('Off', '10%', '20%', '30%', '40%', '50%', '60%', '70%', '80%', '90%', '100%');
+ IPreviewVolumeTranslated: array[0..10] of UTF8String = ('Off', '10%', '20%', '30%', '40%', '50%', '60%', '70%', '80%', '90%', '100%');
- IAudioOutputBufferSizeTranslated: array[0..9] of string = ('Auto', '256', '512', '1024', '2048', '4096', '8192', '16384', '32768', '65536');
+ IAudioOutputBufferSizeTranslated: array[0..9] of UTF8String = ('Auto', '256', '512', '1024', '2048', '4096', '8192', '16384', '32768', '65536');
- IAudioInputBufferSizeTranslated: array[0..9] of string = ('Auto', '256', '512', '1024', '2048', '4096', '8192', '16384', '32768', '65536');
+ IAudioInputBufferSizeTranslated: array[0..9] of UTF8String = ('Auto', '256', '512', '1024', '2048', '4096', '8192', '16384', '32768', '65536');
- IPreviewFadingTranslated: array[0..5] of string = ('Off', '1 Sec', '2 Secs', '3 Secs', '4 Secs', '5 Secs');
+ IPreviewFadingTranslated: array[0..5] of UTF8String = ('Off', '1 Sec', '2 Secs', '3 Secs', '4 Secs', '5 Secs');
- ILyricsFontTranslated: array[0..2] of string = ('Plain', 'OLine1', 'OLine2');
- ILyricsEffectTranslated: array[0..4] of string = ('Simple', 'Zoom', 'Slide', 'Ball', 'Shift');
- ISolmizationTranslated: array[0..3] of string = ('Off', 'Euro', 'Jap', 'American');
- INoteLinesTranslated: array[0..1] of string = ('Off', 'On');
+ ILyricsFontTranslated: array[0..2] of UTF8String = ('Plain', 'OLine1', 'OLine2');
+ ILyricsEffectTranslated: array[0..4] of UTF8String = ('Simple', 'Zoom', 'Slide', 'Ball', 'Shift');
+ INoteLinesTranslated: array[0..1] of UTF8String = ('Off', 'On');
- IColorTranslated: array[0..8] of string = ('Blue', 'Green', 'Pink', 'Red', 'Violet', 'Orange', 'Yellow', 'Brown', 'Black');
+ IColorTranslated: array[0..8] of UTF8String = ('Blue', 'Green', 'Pink', 'Red', 'Violet', 'Orange', 'Yellow', 'Brown', 'Black');
// Advanced
- ILoadAnimationTranslated: array[0..1] of string = ('Off', 'On');
- IEffectSingTranslated: array[0..1] of string = ('Off', 'On');
- IScreenFadeTranslated: array[0..1] of string = ('Off', 'On');
- IAskbeforeDelTranslated: array[0..1] of string = ('Off', 'On');
- IOnSongClickTranslated: array[0..2] of string = ('Sing', 'Select Players', 'Open Menu');
- ILineBonusTranslated: array[0..1] of string = ('Off', 'On');
- IPartyPopupTranslated: array[0..1] of string = ('Off', 'On');
+ ILoadAnimationTranslated: array[0..1] of UTF8String = ('Off', 'On');
+ IEffectSingTranslated: array[0..1] of UTF8String = ('Off', 'On');
+ IScreenFadeTranslated: array[0..1] of UTF8String = ('Off', 'On');
+ IAskbeforeDelTranslated: array[0..1] of UTF8String = ('Off', 'On');
+ IOnSongClickTranslated: array[0..2] of UTF8String = ('Sing', 'Select Players', 'Open Menu');
+ ILineBonusTranslated: array[0..1] of UTF8String = ('Off', 'On');
+ IPartyPopupTranslated: array[0..1] of UTF8String = ('Off', 'On');
- IJoypadTranslated: array[0..1] of string = ('Off', 'On');
- IMouseTranslated: array[0..2] of string = ('Off', 'Hardware Cursor', 'Software Cursor');
+ IJoypadTranslated: array[0..1] of UTF8String = ('Off', 'On');
+ IMouseTranslated: array[0..2] of UTF8String = ('Off', 'Hardware Cursor', 'Software Cursor');
// Recording options
- IChannelPlayerTranslated: array[0..6] of string = ('Off', '1', '2', '3', '4', '5', '6');
- IMicBoostTranslated: array[0..3] of string = ('Off', '+6dB', '+12dB', '+18dB');
+ IChannelPlayerTranslated: array[0..6] of UTF8String = ('Off', '1', '2', '3', '4', '5', '6');
+ IMicBoostTranslated: array[0..3] of UTF8String = ('Off', '+6dB', '+12dB', '+18dB');
implementation
uses
StrUtils,
- UMain,
SDL,
+ UCommandLine,
ULanguage,
UPlatform,
- USkins,
+ UMain,
URecord,
- UCommandLine,
- UPath;
+ USkins,
+ UThemes,
+ UPathUtils,
+ UUnicodeUtils;
(**
* Translate and set the values of options, which need translation.
*)
procedure TIni.TranslateOptionValues;
+var
+ I: integer;
begin
- ULanguage.Language.ChangeLanguage(ILanguage[Language]);
-
+ // Load Languagefile
+ if (Params.Language <> -1) then
+ ULanguage.Language.ChangeLanguage(ILanguage[Params.Language])
+ else
+ ULanguage.Language.ChangeLanguage(ILanguage[Ini.Language]);
+
+ SetLength(ILanguageTranslated, Length(ILanguage));
+ for I := 0 to High(ILanguage) do
+ begin
+ ILanguageTranslated[I] := ULanguage.Language.Translate(
+ 'OPTION_VALUE_' + UpperCase(ILanguage[I])
+ );
+ end;
+
IDifficultyTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_EASY');
IDifficultyTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_MEDIUM');
IDifficultyTranslated[2] := ULanguage.Language.Translate('OPTION_VALUE_HARD');
@@ -345,8 +384,7 @@ begin
ISortingTranslated[3] := ULanguage.Language.Translate('OPTION_VALUE_FOLDER');
ISortingTranslated[4] := ULanguage.Language.Translate('OPTION_VALUE_TITLE');
ISortingTranslated[5] := ULanguage.Language.Translate('OPTION_VALUE_ARTIST');
- ISortingTranslated[6] := ULanguage.Language.Translate('OPTION_VALUE_TITLE2');
- ISortingTranslated[7] := ULanguage.Language.Translate('OPTION_VALUE_ARTIST2');
+ ISortingTranslated[6] := ULanguage.Language.Translate('OPTION_VALUE_ARTIST2');
IDebugTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF');
IDebugTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_ON');
@@ -389,6 +427,10 @@ begin
IVoicePassthroughTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF');
IVoicePassthroughTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_ON');
+ ISyncToTranslated[Ord(stMusic)] := ULanguage.Language.Translate('OPTION_VALUE_MUSIC');
+ ISyncToTranslated[Ord(stLyrics)] := ULanguage.Language.Translate('OPTION_VALUE_LYRICS');
+ ISyncToTranslated[Ord(stOff)] := ULanguage.Language.Translate('OPTION_VALUE_OFF');
+
ILyricsFontTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_PLAIN');
ILyricsFontTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_OLINE1');
ILyricsFontTranslated[2] := ULanguage.Language.Translate('OPTION_VALUE_OLINE2');
@@ -399,11 +441,6 @@ begin
ILyricsEffectTranslated[3] := ULanguage.Language.Translate('OPTION_VALUE_BALL');
ILyricsEffectTranslated[4] := ULanguage.Language.Translate('OPTION_VALUE_SHIFT');
- ISolmizationTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF');
- ISolmizationTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_EURO');
- ISolmizationTranslated[2] := ULanguage.Language.Translate('OPTION_VALUE_JAPAN');
- ISolmizationTranslated[3] := ULanguage.Language.Translate('OPTION_VALUE_AMERICAN');
-
INoteLinesTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF');
INoteLinesTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_ON');
@@ -415,7 +452,7 @@ begin
IColorTranslated[5] := ULanguage.Language.Translate('OPTION_VALUE_ORANGE');
IColorTranslated[6] := ULanguage.Language.Translate('OPTION_VALUE_YELLOW');
IColorTranslated[7] := ULanguage.Language.Translate('OPTION_VALUE_BROWN');
- IColorTranslated[8] := ULanguage.Language.Translate('OPTION_VALUE_BALCK');
+ IColorTranslated[8] := ULanguage.Language.Translate('OPTION_VALUE_BLACK');
// Advanced
ILoadAnimationTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF');
@@ -507,14 +544,6 @@ begin
end;
-(**
- * 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.
@@ -561,35 +590,13 @@ begin
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;
+function TIni.ReadArrayIndex(const SearchArray: array of UTF8String; IniFile: TCustomIniFile;
IniSection: string; IniProperty: string; Default: integer): integer;
var
StrValue: string;
@@ -625,7 +632,7 @@ begin
if (DeviceIndex >= 0) then
begin
if not IniFile.ValueExists('Record', Format('DeviceName[%d]', [DeviceIndex])) then
- break;
+ Continue;
// resize list
SetLength(InputDeviceConfig, Length(InputDeviceConfig)+1);
@@ -637,6 +644,7 @@ begin
DeviceCfg := @InputDeviceConfig[High(InputDeviceConfig)];
DeviceCfg.Name := IniFile.ReadString('Record', Format('DeviceName[%d]', [DeviceIndex]), '');
DeviceCfg.Input := IniFile.ReadInteger('Record', Format('Input[%d]', [DeviceIndex]), 0);
+ DeviceCfg.Latency := IniFile.ReadInteger('Record', Format('Latency[%d]', [DeviceIndex]), LATENCY_AUTODETECT);
// find the largest channel-number of the current device in the ini-file
ChannelCount := GetMaxKeyIndex(RecordKeys, 'Channel', Format('[%d]', [DeviceIndex]));
@@ -675,6 +683,8 @@ begin
InputDeviceConfig[DeviceIndex].Name);
IniFile.WriteInteger('Record', Format('Input[%d]', [DeviceIndex+1]),
InputDeviceConfig[DeviceIndex].Input);
+ IniFile.WriteInteger('Record', Format('Latency[%d]', [DeviceIndex+1]),
+ InputDeviceConfig[DeviceIndex].Latency);
// Channel-to-Player Mapping
for ChannelIndex := 0 to High(InputDeviceConfig[DeviceIndex].ChannelToPlayerMap) do
@@ -702,9 +712,9 @@ begin
// Load song-paths
for I := 0 to PathStrings.Count-1 do
begin
- if (AnsiStartsText('SongDir', PathStrings[I])) then
+ if (Pos('SONGDIR', UpperCase(PathStrings[I])) = 1) then
begin
- AddSongPath(IniFile.ReadString('Directories', PathStrings[I], ''));
+ AddSongPath(Path(IniFile.ReadString('Directories', PathStrings[I], '')));
end;
end;
@@ -712,38 +722,7 @@ begin
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
@@ -757,13 +736,22 @@ begin
// Skin
Skin.onThemeChange;
- SkinNo := GetArrayIndex(ISkin, IniFile.ReadString('Themes', 'Skin', ISkin[0]));
+ SkinNo := GetArrayIndex(ISkin, IniFile.ReadString('Themes', 'Skin', ISkin[UThemes.Theme.Themes[Theme].DefaultSkin]));
+
+ { there may be a not existing skin in the ini file
+ e.g. due to manual edit or corrupted file.
+ in this case we load the first Skin }
+ if SkinNo = -1 then
+ SkinNo := 0;
+
+ // Color
+ Color := GetArrayIndex(IColor, IniFile.ReadString('Themes', 'Color', IColor[Skin.GetDefaultColor(SkinNo)]));
end;
procedure TIni.LoadScreenModes(IniFile: TCustomIniFile);
// swap two strings
- procedure swap(var s1, s2: string);
+ procedure swap(var s1, s2: UTF8String);
var
s3: string;
begin
@@ -800,17 +788,25 @@ begin
else if (Modes = PPSDL_Rect(-1)) then
begin
// Fallback to some standard resolutions
- SetLength(IResolution, 10);
+ SetLength(IResolution, 18);
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';
+ IResolution[3] := '1152x666';;
+ IResolution[4] := '1152x864';
+ IResolution[5] := '1280x800';
+ IResolution[6] := '1280x960';
+ IResolution[7] := '1280x1024';
+ IResolution[8] := '1366x768';
+ IResolution[9] := '1400x1050';
+ IResolution[10] := '1440x900';
+ IResolution[11] := '1600x900';
+ IResolution[12] := '1600x1200';
+ IResolution[13] := '1680x1050';
+ IResolution[14] := '1920x1080';
+ IResolution[15] := '1920x1200';
+ IResolution[16] := '2048x1152';
+ IResolution[17] := '2560x1600';
Resolution := GetArrayIndex(IResolution, IniFile.ReadString('Graphics', 'Resolution', '800x600'));
if Resolution = -1 then
@@ -872,19 +868,15 @@ var
begin
GamePath := Platform.GetGameUserPath;
- Log.LogStatus( 'GamePath : ' +GamePath , '' );
+ Log.LogStatus( 'GamePath : ' +GamePath.ToNative , '' );
- if (Params.ConfigFile <> '') then
- try
- FileName := Params.ConfigFile;
- except
- FileName := GamePath + 'config.ini';
- end
+ if (Params.ConfigFile.IsSet) then
+ FileName := Params.ConfigFile
else
- FileName := GamePath + 'config.ini';
+ FileName := GamePath.Append('config.ini');
- Log.LogStatus( 'Using config : ' + FileName , 'Ini');
- IniFile := TMemIniFile.Create( FileName );
+ Log.LogStatus('Using config : ' + FileName.ToNative, 'Ini');
+ IniFile := TMemIniFile.Create(FileName.ToNative);
// Name
for I := 0 to 11 do
@@ -904,22 +896,24 @@ begin
// Language
Language := GetArrayIndex(ILanguage, IniFile.ReadString('Game', 'Language', 'English'));
- //Language.ChangeLanguage(ILanguage[Language]);
// Tabs
Tabs := GetArrayIndex(ITabs, IniFile.ReadString('Game', 'Tabs', ITabs[0]));
TabsAtStartup := Tabs; //Tabs at Startup fix
// Song Sorting
- Sorting := GetArrayIndex(ISorting, IniFile.ReadString('Game', 'Sorting', ISorting[0]));
+ Sorting := GetArrayIndex(ISorting, IniFile.ReadString('Game', 'Sorting', ISorting[Ord(sEdition)]));
// Debug
Debug := GetArrayIndex(IDebug, IniFile.ReadString('Game', 'Debug', IDebug[0]));
LoadScreenModes(IniFile);
- // TextureSize
- TextureSize := GetArrayIndex(ITextureSize, IniFile.ReadString('Graphics', 'TextureSize', ITextureSize[1]));
+ // TextureSize (aka CachedCoverSize)
+ // Note: a default cached cover size of 128 pixels is big enough,
+ // 256 pixels are already noticeably slow with 180 covers in the song-screen
+ // displayed at once. In additon the covers.db will be too big.
+ TextureSize := GetArrayIndex(ITextureSize, IniFile.ReadString('Graphics', 'TextureSize', '128'));
// SingWindow
SingWindow := GetArrayIndex(ISingWindow, IniFile.ReadString('Graphics', 'SingWindow', 'Big'));
@@ -961,19 +955,13 @@ begin
LyricsFont := GetArrayIndex(ILyricsFont, IniFile.ReadString('Lyrics', 'LyricsFont', ILyricsFont[0]));
// Lyrics Effect
- LyricsEffect := GetArrayIndex(ILyricsEffect, IniFile.ReadString('Lyrics', 'LyricsEffect', ILyricsEffect[2]));
-
- // Solmization
- Solmization := GetArrayIndex(ISolmization, IniFile.ReadString('Lyrics', 'Solmization', ISolmization[0]));
+ LyricsEffect := GetArrayIndex(ILyricsEffect, IniFile.ReadString('Lyrics', 'LyricsEffect', ILyricsEffect[4]));
// 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
@@ -993,7 +981,7 @@ begin
{**
* Background music
*}
- BackgroundMusicOption := GetArrayIndex(IBackgroundMusic, IniFile.ReadString('Sound', 'BackgroundMusic', 'Off'));
+ BackgroundMusicOption := GetArrayIndex(IBackgroundMusic, IniFile.ReadString('Sound', 'BackgroundMusic', 'On'));
// EffectSing
EffectSing := GetArrayIndex(IEffectSing, IniFile.ReadString('Advanced', 'EffectSing', 'On'));
@@ -1010,6 +998,9 @@ begin
// PartyPopup
PartyPopup := GetArrayIndex(IPartyPopup, IniFile.ReadString('Advanced', 'PartyPopup', 'On'));
+ // SyncTo
+ SyncTo := GetArrayIndex(ISyncTo, IniFile.ReadString('Advanced', 'SyncTo', ISyncTo[Ord(stMusic)]));
+
// Joypad
Joypad := GetArrayIndex(IJoypad, IniFile.ReadString('Controller', 'Joypad', IJoypad[0]));
@@ -1027,13 +1018,13 @@ procedure TIni.Save;
var
IniFile: TIniFile;
begin
- if (FileExists(Filename) and FileIsReadOnly(Filename)) then
+ if (Filename.IsFile and Filename.IsReadOnly) then
begin
Log.LogError('Config-file is read-only', 'TIni.Save');
Exit;
end;
- IniFile := TIniFile.Create(Filename);
+ IniFile := TIniFile.Create(Filename.ToNative);
// Players
IniFile.WriteString('Game', 'Players', IPlayers[Players]);
@@ -1116,9 +1107,6 @@ begin
// Lyrics Effect
IniFile.WriteString('Lyrics', 'LyricsEffect', ILyricsEffect[LyricsEffect]);
- // Solmization
- IniFile.WriteString('Lyrics', 'Solmization', ISolmization[Solmization]);
-
// NoteLines
IniFile.WriteString('Lyrics', 'NoteLines', INoteLines[NoteLines]);
@@ -1154,6 +1142,9 @@ begin
//Party Popup
IniFile.WriteString('Advanced', 'PartyPopup', IPartyPopup[PartyPopup]);
+ //SyncTo
+ IniFile.WriteString('Advanced', 'SyncTo', ISyncTo[SyncTo]);
+
// Joypad
IniFile.WriteString('Controller', 'Joypad', IJoypad[Joypad]);
@@ -1173,17 +1164,17 @@ var
IniFile: TIniFile;
I: integer;
begin
- if not FileIsReadOnly(Filename) then
+ if not Filename.IsReadOnly() then
begin
- IniFile := TIniFile.Create(Filename);
+ IniFile := TIniFile.Create(Filename.ToNative);
//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]);
+ for I := 0 to High(Name) do
+ IniFile.WriteString('Name', 'P' + IntToStr(I+1), Name[I]);
+ for I := 0 to High(NameTeam) do
+ IniFile.WriteString('NameTeam', 'T' + IntToStr(I+1), NameTeam[I]);
+ for I := 0 to High(NameTemplate) do
+ IniFile.WriteString('NameTemplate', 'Name' + IntToStr(I+1), NameTemplate[I]);
IniFile.Free;
end;
@@ -1193,9 +1184,9 @@ procedure TIni.SaveLevel;
var
IniFile: TIniFile;
begin
- if not FileIsReadOnly(Filename) then
+ if not Filename.IsReadOnly() then
begin
- IniFile := TIniFile.Create(Filename);
+ IniFile := TIniFile.Create(Filename.ToNative);
// Difficulty
IniFile.WriteString('Game', 'Difficulty', IDifficulty[Difficulty]);
diff --git a/cmake/src/base/ULanguage.pas b/cmake/src/base/ULanguage.pas
index 02cd7712..5f8a2692 100644
--- a/cmake/src/base/ULanguage.pas
+++ b/cmake/src/base/ULanguage.pas
@@ -33,33 +33,41 @@ interface
{$I switches.inc}
+uses
+ UUnicodeUtils;
+
type
TLanguageEntry = record
- ID: string;
- Text: string;
+ ID: AnsiString; //**< identifier (ASCII)
+ Text: UTF8String; //**< translation (UTF-8)
end;
TLanguageList = record
- Name: string;
- {FileName: string; }
+ Name: AnsiString; //**< language name (ASCII)
end;
+ TLanguageEntryArray = array of TLanguageEntry;
+
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
+ private
List: array of TLanguageList;
- constructor Create;
+ Entry: TLanguageEntryArray; //**< Entrys of Chosen Language
+ EntryDefault: TLanguageEntryArray; //**< Entrys of Standard Language
+ EntryConst: TLanguageEntryArray; //**< Constant Entrys e.g. Version
+
+ Implode_Glue1, Implode_Glue2: UTF8String;
+
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;
+ function FindID(const ID: AnsiString; const EntryList: TLanguageEntryArray): integer;
+
+ public
+ constructor Create;
+ function Translate(const Text: RawByteString): UTF8String;
+ procedure ChangeLanguage(const Language: AnsiString);
+ procedure AddConst(const ID: AnsiString; const Text: UTF8String);
+ procedure ChangeConst(const ID: AnsiString; const Text: UTF8String);
+ function Implode(const Pieces: array of UTF8String): UTF8String;
end;
var
@@ -69,20 +77,18 @@ implementation
uses
UMain,
- // UFiles,
UIni,
IniFiles,
Classes,
SysUtils,
- {$IFDEF win32}
- Windows,
- {$ENDIF}
ULog,
- UPath;
+ UPath,
+ UFilesystem,
+ UPathUtils;
-//----------
-//Create - Construct Class then LoadList + Standard Language + Set Standard Implode Glues
-//----------
+{**
+ * LoadList, set default language, set standard implode glues
+ *}
constructor TLanguage.Create;
var
I, J: Integer;
@@ -107,9 +113,9 @@ begin
begin
ChangeLanguage('English');
- SetLength(SEntry, Length(Entry));
- for J := low(Entry) to high(Entry) do
- SEntry[J] := Entry[J];
+ SetLength(EntryDefault, Length(Entry));
+ for J := 0 to high(Entry) do
+ EntryDefault[J] := Entry[J];
SetLength(Entry, 0);
@@ -123,41 +129,44 @@ begin
end;
-//----------
-//LoadList - Parse the Language Dir searching Translations
-//----------
+{**
+ * Parse the Language Dir searching Translations
+ *}
procedure TLanguage.LoadList;
var
- SR: TSearchRec; // for parsing directory
+ Iter: IFileIterator;
+ IniInfo: TFileInfo;
+ LangName: string;
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, '');
+ Iter := FileSystem.FileFind(LanguagesPath.Append('*.ini'), 0);
+ while(Iter.HasNext) do
+ begin
+ IniInfo := Iter.Next;
+
+ LangName := IniInfo.Name.SetExtension('').ToUTF8;
- List[High(List)].Name := SR.Name;
- ILanguage[High(ILanguage)] := SR.Name;
+ SetLength(List, Length(List)+1);
+ List[High(List)].Name := LangName;
- until FindNext(SR) <> 0;
- SysUtils.FindClose(SR);
- end; // if FindFirst
+ SetLength(ILanguage, Length(ILanguage)+1);
+ ILanguage[High(ILanguage)] := LangName;
+ end;
end;
-//----------
-//ChangeLanguage - Load the specified LanguageFile
-//----------
-procedure TLanguage.ChangeLanguage(Language: String);
+{**
+ * Load the specified LanguageFile
+ *}
+procedure TLanguage.ChangeLanguage(const Language: AnsiString);
var
- IniFile: TIniFile;
+ IniFile: TUnicodeMemIniFile;
E: integer; // entry
S: TStringList;
begin
SetLength(Entry, 0);
- IniFile := TIniFile.Create(LanguagesPath + Language + '.ini');
+ IniFile := TUnicodeMemIniFile.Create(LanguagesPath.Append(Language + '.ini'));
S := TStringList.Create;
IniFile.ReadSectionValues('Text', S);
@@ -177,80 +186,107 @@ begin
IniFile.Free;
end;
-//----------
-//Translate - Translate the Text
-//----------
-Function TLanguage.Translate(Text: String): String;
+{**
+ * Find the index of ID an array of language entries.
+ * @returns the index on success, -1 otherwise.
+ *}
+function TLanguage.FindID(const ID: AnsiString; const EntryList: TLanguageEntryArray): integer;
+var
+ Index: integer;
+begin
+ for Index := 0 to High(EntryList) do
+ begin
+ if ID = EntryList[Index].ID then
+ begin
+ Result := Index;
+ Exit;
+ end;
+ end;
+ Result := -1;
+end;
+
+{**
+ * Translate the Text.
+ * If Text is an ID, text will be translated according to the current language
+ * setting. If Text is not a known ID, it will be returned as is.
+ * @param Text either an ID or an UTF-8 encoded string
+ *}
+function TLanguage.Translate(const Text: RawByteString): UTF8String;
var
- E: integer; // entry
+ E: integer; // entry
+ ID: AnsiString;
+ EntryIndex: integer;
begin
+ // fallback result in case Text is not a known ID
Result := Text;
- Text := Uppercase(Result);
+
+ // normalize ID case
+ ID := UpperCase(Text);
+
+ // Check if ID exists
//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
+ EntryIndex := FindID(ID, EntryConst);
+ if (EntryIndex >= 0) then
+ begin
+ Result := EntryConst[EntryIndex].Text;
+ Exit;
+ end;
- for E := 0 to high(Entry) do
- if Text = Entry[E].ID then
- begin
- Result := Entry[E].Text;
- exit;
- end;
+ EntryIndex := FindID(ID, Entry);
+ if (EntryIndex >= 0) then
+ begin
+ Result := Entry[EntryIndex].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
+ EntryIndex := FindID(ID, EntryDefault);
+ if (EntryIndex >= 0) then
+ begin
+ Result := EntryDefault[EntryIndex].Text;
+ Exit;
+ end;
end;
-//----------
-//AddConst - Add a Constant ID that will be Translated but not Loaded from the LanguageFile
-//----------
-procedure TLanguage.AddConst (ID, Text: String);
+{**
+ * Add a Constant ID that will be Translated but not Loaded from the LanguageFile
+ *}
+procedure TLanguage.AddConst(const ID: AnsiString; const Text: UTF8String);
begin
- SetLength (CEntry, Length(CEntry) + 1);
- CEntry[high(CEntry)].ID := ID;
- CEntry[high(CEntry)].Text := Text;
+ SetLength (EntryConst, Length(EntryConst) + 1);
+ EntryConst[high(EntryConst)].ID := ID;
+ EntryConst[high(EntryConst)].Text := Text;
end;
-//----------
-//ChangeConst - Change a Constant Value by ID
-//----------
-procedure TLanguage.ChangeConst(ID, Text: String);
+{**
+ * Change a Constant Value by ID
+ *}
+procedure TLanguage.ChangeConst(const ID: AnsiString; const Text: UTF8String);
var
I: Integer;
begin
- for I := 0 to high(CEntry) do
+ for I := 0 to high(EntryConst) do
begin
- if CEntry[I].ID = ID then
+ if EntryConst[I].ID = ID then
begin
- CEntry[I].Text := Text;
+ EntryConst[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;
+{**
+ * Connect an array of strings with ' and ' or ', ' to one string
+ *}
+function TLanguage.Implode(const Pieces: array of UTF8String): UTF8String;
var
I: Integer;
begin
Result := '';
//Go through Pieces
- for I := low(Pieces) to high(Pieces) do
+ for I := 0 to high(Pieces) do
begin
//Add Value
Result := Result + Pieces[I];
diff --git a/cmake/src/base/ULog.pas b/cmake/src/base/ULog.pas
index a872729a..e4ff4862 100644
--- a/cmake/src/base/ULog.pas
+++ b/cmake/src/base/ULog.pas
@@ -34,7 +34,8 @@ interface
{$I switches.inc}
uses
- Classes;
+ Classes,
+ UPath;
(*
* LOG_LEVEL_[TYPE] defines the "minimum" index for logs of type TYPE. Each
@@ -115,7 +116,7 @@ type
// voice
procedure LogVoice(SoundNr: integer);
// buffer
- procedure LogBuffer(const buf : Pointer; const bufLength : Integer; const filename : string);
+ procedure LogBuffer(const buf : Pointer; const bufLength : Integer; const filename : IPath);
end;
procedure DebugWriteln(const aString: String);
@@ -133,7 +134,7 @@ uses
UTime,
UCommon,
UCommandLine,
- UPath;
+ UPathUtils;
(*
* Write to console if in debug mode (Thread-safe).
@@ -198,7 +199,7 @@ begin
if not BenchmarkFileOpened then
begin
BenchmarkFileOpened := true;
- AssignFile(BenchmarkFile, LogPath + 'Benchmark.log');
+ AssignFile(BenchmarkFile, LogPath.Append('Benchmark.log').ToNative);
{$I-}
Rewrite(BenchmarkFile);
if IOResult = 0 then
@@ -270,7 +271,7 @@ procedure TLog.LogToFile(const Text: string);
begin
if (FileOutputEnabled and not LogFileOpened) then
begin
- AssignFile(LogFile, LogPath + 'Error.log');
+ AssignFile(LogFile, LogPath.Append('Error.log').ToNative);
{$I-}
Rewrite(LogFile);
if IOResult = 0 then
@@ -399,20 +400,19 @@ end;
procedure TLog.LogVoice(SoundNr: integer);
var
- FS: TFileStream;
- FileName: string;
+ FS: TBinaryFileStream;
+ Prefix: string;
+ FileName: IPath;
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
+ Prefix := Format('Voice%.4d', [Num]);
+ FileName := LogPath.Append(Prefix + '.raw');
+ if not FileName.Exists() then
break
end;
- FS := TFileStream.Create(FileName, fmCreate);
+ FS := TBinaryFileStream.Create(FileName, fmCreate);
AudioInputProcessor.Sound[SoundNr].LogBuffer.Seek(0, soBeginning);
FS.CopyFrom(AudioInputProcessor.Sound[SoundNr].LogBuffer, AudioInputProcessor.Sound[SoundNr].LogBuffer.Size);
@@ -420,21 +420,19 @@ begin
FS.Free;
end;
-procedure TLog.LogBuffer(const buf: Pointer; const bufLength: Integer; const filename: string);
+procedure TLog.LogBuffer(const buf: Pointer; const bufLength: Integer; const filename: IPath);
var
- f : TFileStream;
+ f : TBinaryFileStream;
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 := TBinaryFileStream.Create( filename, fmCreate);
+ try
+ f.Write( buf^, bufLength);
+ finally
f.Free;
end;
+ except on e : Exception do
+ Log.LogError('TLog.LogBuffer: Failed to log buffer into file "' + filename.ToNative + '". ErrMsg: ' + e.Message);
end;
end;
diff --git a/cmake/src/base/ULyrics.pas b/cmake/src/base/ULyrics.pas
index 82982981..3f62db9c 100644
--- a/cmake/src/base/ULyrics.pas
+++ b/cmake/src/base/ULyrics.pas
@@ -52,14 +52,14 @@ type
Width: real; // width
Start: cardinal; // start of the word in quarters (beats)
Length: cardinal; // length of the word in quarters
- Text: string; // text
+ Text: UTF8String; // text
Freestyle: boolean; // is freestyle?
end;
TLyricWordArray = array of TLyricWord;
TLyricLine = class
public
- Text: string; // text
+ Text: UTF8String; // text
Width: real; // width
Height: real; // height
Words: TLyricWordArray; // words in this line
diff --git a/cmake/src/base/UMain.pas b/cmake/src/base/UMain.pas
index 275510fc..0d479420 100644
--- a/cmake/src/base/UMain.pas
+++ b/cmake/src/base/UMain.pas
@@ -37,13 +37,9 @@ uses
SysUtils,
SDL;
-var
- Done: boolean;
- Restart: boolean;
-
procedure Main;
procedure MainLoop;
-procedure CheckEvents;
+function CheckEvents: boolean;
type
TMainThreadExecProc = procedure(Data: Pointer);
@@ -73,22 +69,30 @@ uses
UCovers,
UDataBase,
UDisplay,
- UDLLManager,
UGraphic,
UGraphicClasses,
UIni,
UJoystick,
ULanguage,
ULog,
- UPath,
+ UPathUtils,
UPlaylist,
UMusic,
+ URecord,
UBeatTimer,
UPlatform,
USkins,
USongs,
UThemes,
UParty,
+ ULuaCore,
+ UHookableEvent,
+ ULuaGl,
+ ULuaLog,
+ ULuaTexture,
+ ULuaTextGL,
+ ULuaParty,
+ ULuaScreenSing,
UTime;
procedure Main;
@@ -124,6 +128,10 @@ begin
SDL_Init(SDL_INIT_VIDEO or SDL_INIT_TIMER);
SDL_EnableUnicode(1);
+ // create luacore first so other classes can register their events
+ LuaCore := TLuaCore.Create;
+
+
USTime := TTime.Create;
VideoBGTimer := TRelativeTimer.Create;
@@ -148,15 +156,6 @@ begin
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');
@@ -164,6 +163,12 @@ begin
Log.BenchmarkEnd(1);
Log.LogBenchmark('Loading Skin List', 1);
+ Log.BenchmarkStart(1);
+ Log.LogStatus('Loading Theme List', 'Initialization');
+ Theme := TTheme.Create;
+ Log.BenchmarkEnd(1);
+ Log.LogBenchmark('Loading Theme List', 1);
+
// Ini + Paths
Log.BenchmarkStart(1);
Log.LogStatus('Load Ini', 'Initialization');
@@ -174,12 +179,6 @@ begin
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);
@@ -195,10 +194,10 @@ begin
// Theme
Log.BenchmarkStart(1);
- Log.LogStatus('Load Themes', 'Initialization');
- Theme := TTheme.Create(ThemePath + ITheme[Ini.Theme] + '.ini', Ini.Color);
+ Log.LogStatus('Load Theme', 'Initialization');
+ Theme.LoadTheme(Ini.Theme, Ini.Color);
Log.BenchmarkEnd(1);
- Log.LogBenchmark('Loading Themes', 1);
+ Log.LogBenchmark('Loading Theme', 1);
// Covers Cache
Log.BenchmarkStart(1);
@@ -226,20 +225,6 @@ begin
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');
@@ -252,10 +237,10 @@ begin
Log.LogStatus('DataBase System', 'Initialization');
DataBase := TDataBaseSystem.Create;
- if (Params.ScoreFile = '') then
- DataBase.Init (Platform.GetGameUserPath + 'Ultrastar.db')
+ if (Params.ScoreFile.IsUnset) then
+ DataBase.Init(Platform.GetGameUserPath.Append('Ultrastar.db'))
else
- DataBase.Init (Params.ScoreFile);
+ DataBase.Init(Params.ScoreFile);
Log.BenchmarkEnd(1);
Log.LogBenchmark('Loading DataBase System', 1);
@@ -284,22 +269,43 @@ begin
Log.LogBenchmark('Initializing Joystick', 1);
end;
+ // Lua
+ Log.BenchmarkStart(1);
+ Party := TPartyGame.Create;
+ Log.BenchmarkEnd(1);
+ Log.LogBenchmark('Initializing Party Manager', 1);
+
+ Log.BenchmarkStart(1);
+ LuaCore.RegisterModule('Log', ULuaLog_Lib_f);
+ LuaCore.RegisterModule('Gl', ULuaGl_Lib_f);
+ LuaCore.RegisterModule('TextGl', ULuaTextGl_Lib_f);
+ LuaCore.RegisterModule('Party', ULuaParty_Lib_f);
+ LuaCore.RegisterModule('ScreenSing', ULuaScreenSing_Lib_f);
+
+ Log.BenchmarkEnd(1);
+ Log.LogBenchmark('Initializing LuaCore', 1);
+
+ Log.BenchmarkStart(1);
+ LuaCore.LoadPlugins;
+ Log.BenchmarkEnd(1);
+ Log.LogBenchmark('Loading Lua Plugins', 1);
+
+ LuaCore.DumpPlugins;
+
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))
- );
-}
+ { prepare software cursor }
+ Display.SetCursor;
+
+ {**
+ * Start background music
+ *}
+ SoundLib.StartBgMusic;
- Log.LogStatus('Running Core', 'Initialization');
- //Core.Run;
+ // check microphone settings, goto record options if they are corrupt
+ if (not AudioInputProcessor.ValidateSettings) then
+ Display.CurrentScreen^.FadeTo( @ScreenOptionsRecord );
//------------------------------
// Start Mainloop
@@ -318,62 +324,58 @@ begin
// call an uninitialize routine for every initialize step
// or at least use the corresponding Free methods
+ Log.LogStatus('Finalize Media', 'Finalization');
FinalizeMedia();
- //TTF_Quit();
+ Log.LogStatus('Uninitialize 3D', 'Finalization');
+ Finalize3D();
+
+ Log.LogStatus('Finalize SDL', 'Finalization');
SDL_Quit();
- if assigned(Log) then
- begin
- Log.LogStatus('Main Loop', 'Finished');
- Log.Free;
- end;
+ Log.LogStatus('Finalize Log', 'Finalization');
+ Log.Free;
{$IFNDEF Debug}
end;
{$ENDIF}
end;
procedure MainLoop;
-var
- Delay: integer;
const
MAX_FPS = 100;
+var
+ Delay: integer;
+ TicksCurrent: cardinal;
+ TicksBeforeFrame: cardinal;
+ Continue: boolean;
begin
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
+ while Continue do
begin
+ TicksBeforeFrame := SDL_GetTicks;
+
// joypad
if (Ini.Joypad = 1) or (Params.Joypad) then
Joy.Update;
// keyboard events
- CheckEvents;
+ Continue := CheckEvents;
// display
- Done := not Display.Draw;
+ Continue := Display.Draw;
SwapBuffers;
- // delay
- CountMidTime;
-
- Delay := Floor(1000 / MAX_FPS - 1000 * TimeMid);
- Log.LogError ('MainLoop', 'Delay: ' + intToStr(Delay));
+ // FPS limiter
+ TicksCurrent := SDL_GetTicks;
+ Delay := 1000 div MAX_FPS - (TicksCurrent - TicksBeforeFrame);
if Delay >= 1 then
SDL_Delay(Delay); // dynamic, maximum is 100 fps
- Log.LogError ('MainLoop', 'Delay: ok ' + intToStr(Delay));
CountSkipTime;
- // reinitialization of graphics
- if Restart then
- begin
- Reinitialize3D;
- Restart := false;
- end;
-
end;
end;
@@ -392,15 +394,13 @@ begin
end;
end;
-procedure CheckEvents;
+function CheckEvents: boolean;
var
Event: TSDL_event;
mouseDown: boolean;
mouseBtn: integer;
begin
- if Assigned(Display.NextScreen) then
- Exit;
-
+ Result := true;
while (SDL_PollEvent(@Event) <> 0) do
begin
case Event.type_ of
@@ -425,29 +425,39 @@ begin
begin
mouseDown := true;
mouseBtn := Event.button.button;
+
+ if (mouseBtn = SDL_BUTTON_LEFT) or (mouseBtn = SDL_BUTTON_RIGHT) then
+ Display.OnMouseButton(true);
end;
SDL_MOUSEBUTTONUP:
begin
mouseDown := false;
mouseBtn := Event.button.button;
+
+ if (mouseBtn = SDL_BUTTON_LEFT) or (mouseBtn = SDL_BUTTON_RIGHT) then
+ Display.OnMouseButton(false);
end;
end;
- Display.MoveCursor(Event.button.X * 800 / Screen.w,
- Event.button.Y * 600 / Screen.h,
- mouseDown and ((mouseBtn <> SDL_BUTTON_WHEELDOWN) or (mouseBtn <> SDL_BUTTON_WHEELUP)));
-
- if (ScreenPopupError <> nil) and (ScreenPopupError.Visible) then
- done := not ScreenPopupError.ParseMouse(mouseBtn, mouseDown, Event.button.x, Event.button.y)
- else if (ScreenPopupCheck <> nil) and (ScreenPopupCheck.Visible) then
- done := not ScreenPopupCheck.ParseMouse(mouseBtn, mouseDown, Event.button.x, Event.button.y)
- else
- begin
- done := not Display.CurrentScreen^.ParseMouse(mouseBtn, mouseDown, Event.button.x, Event.button.y);
-
- // if screen wants to exit
- if done then
- DoQuit;
+ Display.MoveCursor(Event.button.X * 800 * Screens / ScreenW,
+ Event.button.Y * 600 / ScreenH);
+
+ if not Assigned(Display.NextScreen) then
+ begin //drop input when changing screens
+ if (ScreenPopupError <> nil) and (ScreenPopupError.Visible) then
+ Result := ScreenPopupError.ParseMouse(mouseBtn, mouseDown, Event.button.x, Event.button.y)
+ else if (ScreenPopupInfo <> nil) and (ScreenPopupInfo.Visible) then
+ Result := ScreenPopupInfo.ParseMouse(mouseBtn, mouseDown, Event.button.x, Event.button.y)
+ else if (ScreenPopupCheck <> nil) and (ScreenPopupCheck.Visible) then
+ Result := ScreenPopupCheck.ParseMouse(mouseBtn, mouseDown, Event.button.x, Event.button.y)
+ else
+ begin
+ Result := Display.CurrentScreen^.ParseMouse(mouseBtn, mouseDown, Event.button.x, Event.button.y);
+
+ // if screen wants to exit
+ if not Result then
+ DoQuit;
+ end;
end;
end;
end;
@@ -459,6 +469,12 @@ begin
// This would create a new OpenGL render-context and all texture data
// would be invalidated.
// On Linux the mode MUST be reset, otherwise graphics will be corrupted.
+ // Update: It seems to work now without creating a new OpenGL context. At least
+ // with Win7 and SDL 1.2.14. Maybe it generally works now with SDL 1.2.14 and we
+ // can switch it on for windows.
+ // Important: Unless SDL_SetVideoMode() is called (it is not on Windows), Screen.w
+ // and Screen.h are not valid after a resize and still contain the old size. Use
+ // ScreenW and ScreenH instead.
{$IF Defined(Linux) or Defined(FreeBSD)}
if boolean( Ini.FullScreen ) then
SDL_SetVideoMode(ScreenW, ScreenH, (Ini.Depth+1) * 16, SDL_OPENGL or SDL_FULLSCREEN)
@@ -468,52 +484,72 @@ begin
end;
SDL_KEYDOWN:
begin
+ // translate CTRL-A (ASCII 1) - CTRL-Z (ASCII 26) to correct charcodes.
+ // keysyms (SDLK_A, ...) could be used instead but they ignore the
+ // current key mapping (if 'a' is pressed on a French keyboard the
+ // .unicode field will be 'a' and .sym SDLK_Q).
+ // IMPORTANT: if CTRL is pressed with a key different than 'A'-'Z' SDL
+ // will set .unicode to 0. There is no possibility to obtain a
+ // translated charcode. Use keysyms instead.
+ //if (Event.key.keysym.unicode in [1 .. 26]) then
+ // Event.key.keysym.unicode := Ord('A') + Event.key.keysym.unicode - 1;
+
// 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 and FreeBSD are able to handle screen-switching this way.
- {$IF Defined(Linux) or Defined(FreeBSD)}
- if boolean( Ini.FullScreen ) then
+ if not Assigned(Display.NextScreen) then
+ begin //drop input when changing screens
+ { to-do : F11 was used for fullscreen toggle, too here
+ but we also use the key in screenname and some other
+ screens. It is droped although fullscreen toggle doesn't
+ even work on windows.
+ should we add (Event.key.keysym.sym = SDLK_F11) here
+ anyway? }
+ if ((Event.key.keysym.sym = SDLK_RETURN) and
+ ((Event.key.keysym.modifier and KMOD_ALT) <> 0)) then // toggle full screen
begin
- SDL_SetVideoMode(ScreenW, ScreenH, (Ini.Depth+1) * 16, SDL_OPENGL or SDL_FULLSCREEN);
+ 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 and FreeBSD are able to handle screen-switching this way.
+ {$IF Defined(Linux) or Defined(FreeBSD)}
+ if boolean( Ini.FullScreen ) then
+ begin
+ SDL_SetVideoMode(ScreenW, ScreenH, (Ini.Depth+1) * 16, SDL_OPENGL or SDL_FULLSCREEN);
+ end
+ else
+ begin
+ SDL_SetVideoMode(ScreenW, ScreenH, (Ini.Depth+1) * 16, SDL_OPENGL or SDL_RESIZABLE);
+ end;
+
+ Display.SetCursor;
+
+ glViewPort(0, 0, ScreenW, ScreenH);
+ {$IFEND}
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
+ Result := ScreenPopupError.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, true)
+ else if (ScreenPopupInfo <> nil) and (ScreenPopupInfo.Visible) then
+ Result := ScreenPopupInfo.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, true)
+ else if (ScreenPopupCheck <> nil) and (ScreenPopupCheck.Visible) then
+ Result := ScreenPopupCheck.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, true)
else
begin
- SDL_SetVideoMode(ScreenW, ScreenH, (Ini.Depth+1) * 16, SDL_OPENGL or SDL_RESIZABLE);
- end;
+ // check if screen wants to exit
+ Result := Display.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, true);
- Display.SetCursor;
-
- glViewPort(0, 0, ScreenW, ScreenH);
- {$IFEND}
- 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
- DoQuit;
+ // if screen wants to exit
+ if not Result then
+ DoQuit;
+ end;
end;
end;
SDL_JOYAXISMOTION:
diff --git a/cmake/src/base/UMusic.pas b/cmake/src/base/UMusic.pas
index 19c54bee..7f2b3e30 100644
--- a/cmake/src/base/UMusic.pas
+++ b/cmake/src/base/UMusic.pas
@@ -34,10 +34,11 @@ interface
{$I switches.inc}
uses
- UTime,
SysUtils,
Classes,
- UBeatTimer;
+ UTime,
+ UBeatTimer,
+ UPath;
type
TNoteType = (ntFreestyle, ntNormal, ntGolden);
@@ -62,7 +63,7 @@ type
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.)
+ Text: UTF8String; // text assigned to this fragment (a syllable, word, etc.)
NoteType: TNoteType; // note-type: golden-note/freestyle etc.
end;
@@ -73,7 +74,7 @@ type
PLine = ^TLine;
TLine = record
Start: integer; // the start beat of this line (<> start beat of the first note of this line)
- Lyric: string;
+ Lyric: UTF8String;
//LyricWidth: real; // @deprecated: width of the line in pixels.
// Do not use this as the width is not correct.
// Use TLyricsEngine.GetUpperLine().Width instead.
@@ -187,10 +188,6 @@ type
end;
type
- TSyncSource = class
- function GetClock(): real; virtual; abstract;
- end;
-
TAudioProcessingStream = class;
TOnCloseHandler = procedure(Stream: TAudioProcessingStream);
@@ -249,8 +246,8 @@ type
TAudioPlaybackStream = class(TAudioProcessingStream)
protected
+ AvgSyncDiff: double; //** average difference between stream and sync clock
SyncSource: TSyncSource;
- AvgSyncDiff: double;
SourceStream: TAudioSourceStream;
function GetLatency(): double; virtual; abstract;
@@ -259,7 +256,7 @@ type
procedure SetVolume(Volume: single); virtual; abstract;
function Synchronize(BufferSize: integer; FormatInfo: TAudioFormatInfo): integer;
procedure FillBufferWithFrame(Buffer: PByteArray; BufferSize: integer; Frame: PByteArray; FrameSize: integer);
- public
+ public
(**
* Opens a SourceStream for playback.
* Note that the caller (not the TAudioPlaybackStream) is responsible to
@@ -315,7 +312,7 @@ type
// soundcard output-devices information
TAudioOutputDevice = class
public
- Name: string; // soundcard name
+ Name: UTF8String; // soundcard name
end;
TAudioOutputDeviceList = array of TAudioOutputDevice;
@@ -323,28 +320,33 @@ type
IGenericPlayback = Interface
['{63A5EBC3-3F4D-4F23-8DFB-B5165FCE33DD}']
function GetName: String;
+ end;
- function Open(const Filename: string): boolean; // true if succeed
- procedure Close;
-
+ IVideo = interface
+ ['{58DFC674-9168-41EA-B59D-A61307242B80}']
procedure Play;
procedure Pause;
procedure Stop;
+ procedure SetLoop(Enable: boolean);
+ function GetLoop(): boolean;
+
procedure SetPosition(Time: real);
function GetPosition: real;
+ procedure GetFrame(Time: Extended);
+ procedure DrawGL(Screen: integer);
+
+ property Loop: boolean read GetLoop write SetLoop;
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
+ function Init(): boolean;
+ function Finalize: boolean;
+ function Open(const FileName : IPath): IVideo;
end;
IVideoVisualization = Interface( IVideoPlayback )
@@ -369,6 +371,18 @@ type
function Finished: boolean;
function Length: real;
+ function Open(const Filename: IPath): 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;
+
// Sounds
// TODO:
// add a TMediaDummyPlaybackStream implementation that will
@@ -376,7 +390,7 @@ type
// nil-pointers is not neccessary anymore.
// PlaySound/StopSound will be removed then, OpenSound will be renamed to
// CreateSound.
- function OpenSound(const Filename: String): TAudioPlaybackStream;
+ function OpenSound(const Filename: IPath): TAudioPlaybackStream;
procedure PlaySound(Stream: TAudioPlaybackStream);
procedure StopSound(Stream: TAudioPlaybackStream);
@@ -391,7 +405,7 @@ type
IGenericDecoder = Interface
['{557B0E9A-604D-47E4-B826-13769F3E10B7}']
- function GetName(): String;
+ function GetName(): string;
function InitializeDecoder(): boolean;
function FinalizeDecoder(): boolean;
//function IsSupported(const Filename: string): boolean;
@@ -400,13 +414,13 @@ type
(*
IVideoDecoder = Interface( IGenericDecoder )
['{2F184B2B-FE69-44D5-9031-0A2462391DCA}']
- function Open(const Filename: string): TVideoDecodeStream;
+ function Open(const Filename: IPath): TVideoDecodeStream;
end;
*)
IAudioDecoder = Interface( IGenericDecoder )
['{AB47B1B6-2AA9-4410-BF8C-EC79561B5478}']
- function Open(const Filename: string): TAudioDecodeStream;
+ function Open(const Filename: IPath): TAudioDecodeStream;
end;
IAudioInput = Interface
@@ -456,7 +470,7 @@ const
SOUNDID_CLICK = 5;
LAST_SOUNDID = SOUNDID_CLICK;
- BaseSoundFilenames: array[0..LAST_SOUNDID] of string = (
+ BaseSoundFilenames: array[0..LAST_SOUNDID] of IPath = (
'%SOUNDPATH%/Common start.mp3', // Start
'%SOUNDPATH%/Common back.mp3', // Back
'%SOUNDPATH%/menu swoosh.mp3', // Swoosh
@@ -497,7 +511,7 @@ type
procedure StartBgMusic();
procedure PauseBgMusic();
// TODO
- //function AddSound(Filename: string): integer;
+ //function AddSound(Filename: IPath): integer;
//procedure RemoveSound(ID: integer);
//function GetSound(ID: integer): TAudioPlaybackStream;
//property Sound[ID: integer]: TAudioPlaybackStream read GetSound; default;
@@ -533,7 +547,7 @@ uses
UCommandLine,
URecord,
ULog,
- UPath;
+ UPathUtils;
var
DefaultVideoPlayback : IVideoPlayback;
@@ -654,7 +668,7 @@ begin
FilterInterfaceList(IAudioDecoder, MediaManager, InterfaceList);
for i := 0 to InterfaceList.Count-1 do
begin
- CurrentAudioDecoder := IAudioDecoder(InterfaceList[i]);
+ CurrentAudioDecoder := InterfaceList[i] as IAudioDecoder;
if (not CurrentAudioDecoder.InitializeDecoder()) then
begin
Log.LogError('Initialize failed, Removing - '+ CurrentAudioDecoder.GetName);
@@ -671,7 +685,7 @@ begin
FilterInterfaceList(IAudioPlayback, MediaManager, InterfaceList);
for i := 0 to InterfaceList.Count-1 do
begin
- CurrentAudioPlayback := IAudioPlayback(InterfaceList[i]);
+ CurrentAudioPlayback := InterfaceList[i] as IAudioPlayback;
if (CurrentAudioPlayback.InitializePlayback()) then
begin
DefaultAudioPlayback := CurrentAudioPlayback;
@@ -686,7 +700,7 @@ begin
FilterInterfaceList(IAudioInput, MediaManager, InterfaceList);
for i := 0 to InterfaceList.Count-1 do
begin
- CurrentAudioInput := IAudioInput(InterfaceList[i]);
+ CurrentAudioInput := InterfaceList[i] as IAudioInput;
if (CurrentAudioInput.InitializeRecord()) then
begin
DefaultAudioInput := CurrentAudioInput;
@@ -719,7 +733,7 @@ begin
FilterInterfaceList(IVideoPlayback, MediaManager, InterfaceList);
for i := 0 to InterfaceList.Count-1 do
begin
- VideoInterface := IVideoPlayback(InterfaceList[i]);
+ VideoInterface := InterfaceList[i] as IVideoPlayback;
if (VideoInterface.Init()) then
begin
DefaultVideoPlayback := VideoInterface;
@@ -734,7 +748,7 @@ begin
FilterInterfaceList(IVideoVisualization, MediaManager, InterfaceList);
for i := 0 to InterfaceList.Count-1 do
begin
- VisualInterface := IVideoVisualization(InterfaceList[i]);
+ VisualInterface := InterfaceList[i] as IVideoVisualization;
if (VisualInterface.Init()) then
begin
DefaultVisualization := VisualInterface;
@@ -748,7 +762,7 @@ begin
// now that we have all interfaces, we can dump them
// TODO: move this to another place
- if FindCmdLineSwitch( cMediaInterfaces ) then
+ if FindCmdLineSwitch(cMediaInterfaces) then
begin
DumpMediaInterfaces();
halt;
@@ -772,27 +786,27 @@ begin
// 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();
+ (InterfaceList[i] as IAudioPlayback).FinalizePlayback();
// finalize audio input interfaces
FilterInterfaceList(IAudioInput, MediaManager, InterfaceList);
for i := 0 to InterfaceList.Count-1 do
- IAudioInput(InterfaceList[i]).FinalizeRecord();
+ (InterfaceList[i] as IAudioInput).FinalizeRecord();
// finalize audio decoder interfaces
FilterInterfaceList(IAudioDecoder, MediaManager, InterfaceList);
for i := 0 to InterfaceList.Count-1 do
- IAudioDecoder(InterfaceList[i]).FinalizeDecoder();
+ (InterfaceList[i] as IAudioDecoder).FinalizeDecoder();
// finalize video interfaces
FilterInterfaceList(IVideoPlayback, MediaManager, InterfaceList);
for i := 0 to InterfaceList.Count-1 do
- IVideoPlayback(InterfaceList[i]).Finalize();
+ (InterfaceList[i] as IVideoPlayback).Finalize();
// finalize audio decoder interfaces
FilterInterfaceList(IVideoVisualization, MediaManager, InterfaceList);
for i := 0 to InterfaceList.Count-1 do
- IVideoVisualization(InterfaceList[i]).Finalize();
+ (InterfaceList[i] as IVideoVisualization).Finalize();
InterfaceList.Free;
@@ -813,12 +827,6 @@ begin
if (AudioInput <> nil) then
AudioInput.CaptureStop;
- if (VideoPlayback <> nil) then
- VideoPlayback.Close;
-
- if (Visualization <> nil) then
- Visualization.Close;
-
UnloadMediaModules();
end;
@@ -855,14 +863,14 @@ 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');
+ Start := AudioPlayback.OpenSound(SoundPath.Append('Common start.mp3'));
+ Back := AudioPlayback.OpenSound(SoundPath.Append('Common back.mp3'));
+ Swoosh := AudioPlayback.OpenSound(SoundPath.Append('menu swoosh.mp3'));
+ Change := AudioPlayback.OpenSound(SoundPath.Append('select music change music 50.mp3'));
+ Option := AudioPlayback.OpenSound(SoundPath.Append('option change col.mp3'));
+ Click := AudioPlayback.OpenSound(SoundPath.Append('rimshot022b.mp3'));
- BGMusic := AudioPlayback.OpenSound(SoundPath + 'Bebeto_-_Loop010.mp3');
+ BGMusic := AudioPlayback.OpenSound(SoundPath.Append('Bebeto_-_Loop010.mp3'));
if (BGMusic <> nil) then
BGMusic.Loop := True;
@@ -983,6 +991,8 @@ begin
AvgSyncDiff := -1;
end;
+{.$DEFINE LOG_SYNC}
+
(*
* 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
@@ -999,11 +1009,15 @@ end;
function TAudioPlaybackStream.Synchronize(BufferSize: integer; FormatInfo: TAudioFormatInfo): integer;
var
TimeDiff: double;
- TimeCorrectionFactor: double;
+ FrameDiff: double;
+ FrameSkip: integer;
+ ReqFrames: integer;
+ MasterClock: real;
+ CurPosition: real;
const
- AVG_HISTORY_FACTOR = 0.9;
- SYNC_THRESHOLD = 0.045;
- MAX_SYNC_DIFF_TIME = 0.002;
+ AVG_HISTORY_FACTOR = 0.7;
+ SYNC_REPOS_THRESHOLD = 5.000;
+ SYNC_SOFT_THRESHOLD = 0.010;
begin
Result := BufferSize;
@@ -1013,9 +1027,12 @@ begin
if (BufferSize <= 0) then
Exit;
+ CurPosition := Position;
+ MasterClock := SyncSource.GetClock();
+
// 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());
+ TimeDiff := MasterClock - CurPosition;
// calculate average time difference (some sort of weighted mean).
// The bigger AVG_HISTORY_FACTOR is, the smoother is the average diff.
@@ -1030,35 +1047,46 @@ begin
AvgSyncDiff := TimeDiff * (1-AVG_HISTORY_FACTOR) +
AvgSyncDiff * AVG_HISTORY_FACTOR;
- // check if sync needed
- if (Abs(AvgSyncDiff) >= SYNC_THRESHOLD) then
+ {$IFDEF LOG_SYNC}
+ //Log.LogError(Format('c:%.3f | p:%.3f | d:%.3f | a:%.3f',
+ // [MasterClock, CurPosition, TimeDiff, AvgSyncDiff]), 'Synch');
+ {$ENDIF}
+
+ // check if we are out of sync
+ if (Abs(AvgSyncDiff) >= SYNC_REPOS_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;
+ {$IFDEF LOG_SYNC}
+ Log.LogError(Format('ReposSynch: %.3f > %.3f',
+ [Abs(AvgSyncDiff), SYNC_REPOS_THRESHOLD]), 'Synch');
+ {$ENDIF}
+
+ // diff far is too large -> reposition stream
+ // (resulting position might still be out of sync)
+ SetPosition(CurPosition + AvgSyncDiff);
+
+ // reset sync info
+ AvgSyncDiff := -1;
+ end
+ else if (Abs(AvgSyncDiff) >= SYNC_SOFT_THRESHOLD) then
+ begin
+ {$IFDEF LOG_SYNC}
+ Log.LogError(Format('SoftSynch: %.3f > %.3f',
+ [Abs(AvgSyncDiff), SYNC_SOFT_THRESHOLD]), 'Synch');
+ {$ENDIF}
+
+ // hard sync: directly jump to the current position
+ FrameSkip := Round(AvgSyncDiff * FormatInfo.SampleRate);
+ Result := BufferSize + FrameSkip * FormatInfo.FrameSize;
if (Result < 0) then
Result := 0;
- // reset average
+ // reset sync info
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.
+ * Fills a buffer with copies of the given Frame or with 0 if Frame is nil.
*)
procedure TAudioPlaybackStream.FillBufferWithFrame(Buffer: PByteArray; BufferSize: integer; Frame: PByteArray; FrameSize: integer);
var
diff --git a/cmake/src/base/UNote.pas b/cmake/src/base/UNote.pas
index 6da4cf07..6eb99df9 100644
--- a/cmake/src/base/UNote.pas
+++ b/cmake/src/base/UNote.pas
@@ -19,8 +19,8 @@
* the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
* Boston, MA 02110-1301, USA.
*
- * $URL: https://ultrastardx.svn.sourceforge.net/svnroot/ultrastardx/trunk/src/base/UNote.pas $
- * $Id: UNote.pas 1626 2009-03-07 19:53:00Z k-m_schindler $
+ * $URL$
+ * $Id$
*}
unit UNote;
@@ -61,7 +61,7 @@ type
PPLayer = ^TPlayer;
TPlayer = record
- Name: string;
+ Name: UTF8String;
// Index in Teaminfo record
TeamID: byte;
@@ -123,13 +123,12 @@ uses
UCatCovers,
UDataBase,
UPlaylist,
- UDLLManager,
UParty,
UConfig,
UCommon,
UGraphic,
UGraphicClasses,
- UPath,
+ UPathUtils,
UPlatform,
UThemes;
diff --git a/cmake/src/base/UParty.pas b/cmake/src/base/UParty.pas
index e29b977c..2f89afd6 100644
--- a/cmake/src/base/UParty.pas
+++ b/cmake/src/base/UParty.pas
@@ -34,350 +34,979 @@ interface
{$I switches.inc}
uses
- ModiSDK;
+ ULua;
type
- TRoundInfo = record
- Plugin: word;
- Winner: byte;
+ { array holds ids of modes or Party_Round_Random
+ its length defines the number of rounds
+ it is used as argument for TPartyGame.StartParty }
+ ARounds = array of integer;
+
+ { element of APartyTeamRanking returned by TPartyGame.GetTeamRanking
+ and parameter for TPartyGame.SetWinner }
+ TParty_TeamRanking = record
+ Team: Integer; //< id of team
+ Rank: Integer; //< 1 to Length(Teams) e.g. 1 is for placed first
end;
+ AParty_TeamRanking = array of TParty_TeamRanking; //< returned by TPartyGame.GetTeamRanking
- TeamOrderEntry = record
- TeamNum: byte;
- Score: byte;
+ TParty_RoundList = record
+ Index: integer;
+ Name: UTF8String;
end;
+ AParty_ModeList = array of TParty_RoundList;
+
+ { record used by TPartyGame to store round specific data }
+ TParty_Round = record
+ Mode: Integer;
+ AlreadyPlayed: Boolean; //< true if round was already played
+ Ranking: AParty_TeamRanking;
+ RankingSet: Boolean; //< true if Self.Ranking is already set
+ end;
+
+ TParty_ModeInfo = record
+ Name: String; // name of this mode
+ Parent: Integer; // Id of owning plugin
+
+ CanNonParty: Boolean; //< is playable when not in party mode
+ CanParty: Boolean; //< is playable in party mode
+
+ // one bit in the following settings stands for
+ // a player or team count
+ // PlayerCount = 2 or 4 indicates that the mode is playable with 2 and 3 players per team
+ // TeamCount = 1 or 2 or 4 or 8 or 16 or 32 indicates that the mode is playable with 1 to 6 teams
+ PlayerCount: Integer; //< playable with one, two, three etc. players per team
+ TeamCount: Integer; //< playable with one, two, three etc. different teams
+
+
+ Functions: record // lua functions that will be called at specific events
+ BeforeSongSelect: String; // default actions are executed if functions = nil
+ AfterSongSelect: String;
+
+ BeforeSing: String;
+ OnSing: String;
+ AfterSing: String;
+ end;
+ end;
+
+ { used by TPartyGame to store player specific data }
+ TParty_PlayerInfo = record
+ Name: String; //< Playername
+ TimesPlayed: Integer; //< How often this Player has Sung
+ end;
+
+ { used by TPartyGame to store team specific data }
+ TParty_TeamInfo = record
+ Name: String; //< name of the Team
+ Score: Word; //< current score
+ JokersLeft: Integer; //< jokers this team has left
- TeamOrderArray = array[0..5] of byte;
+ NextPlayer: Integer; //Id of the player that plays the next (the current) song
- TPartyPlugin = record
- ID: byte;
- TimesPlayed: byte;
+ Players: array of TParty_PlayerInfo;
end;
- TPartySession = class
+ TPartyGame = class
private
- function GetRandomPlayer(Team: byte): byte;
- function GetRandomPlugin(Plugins: array of TPartyPlugin): byte;
- function IsWinner(Player, Winner: byte): boolean;
+ bPartyGame: boolean; //< are we playing party or standard mode
+ CurRound: Integer; //< indicates which of the elements of Rounds is played next (at the moment)
+
+ bPartyStarted: Boolean;
+
+ TimesPlayed: array of Integer; //< times every mode was played in current party game (for random mode calculation)
+
procedure GenScores;
+ function GetRandomMode: integer;
+ function GetRandomPlayer(Team: integer): integer;
+
+ { returns true if a mode is playable with current playerconfig }
+ function ModePlayable(I: integer): boolean;
+
+ function CallLua(Parent: Integer; Func: String):Boolean;
+
+ procedure SetRankingByScore;
public
- Teams: TTeamInfo;
- Rounds: array of TRoundInfo;
- CurRound: byte;
+ //Teams: TTeamInfo;
+ Rounds: array of TParty_Round; //< holds info which modes are played in this party game (if started)
+ Teams: array of TParty_TeamInfo; //< holds info of teams playing in current round (private for easy manipulation of lua functions)
+
+ Modes: array of TParty_ModeInfo; //< holds info of registred party modes
+
+ property CurrentRound: Integer read CurRound;
constructor Create;
- procedure StartNewParty(NumRounds: byte);
- procedure StartRound;
- procedure EndRound;
- function GetTeamOrder: TeamOrderArray;
- function GetWinnerString(Round: byte): string;
+ { set the attributes of Info to default values }
+ procedure DefaultModeInfo(var Info: TParty_ModeInfo);
+
+ { registers a new mode, returns true on success
+ (mode name does not already exist) }
+ function RegisterMode(Info: TParty_ModeInfo): Boolean;
+
+ { returns true if modes are available for
+ players and teams that are currently set
+ up. if there are no teams set up it returns
+ if there are any party modes available }
+ function ModesAvailable: Boolean;
+
+ { returns an array with the name of all available modes (that
+ are playable with current player configuration }
+ function GetAvailableModes: AParty_ModeList;
+
+ { clears all party specific data previously stored }
+ procedure Clear;
+
+ { adds a team to the team array, returning its id
+ can only be called when game is not already started }
+ function AddTeam(Name: String): Integer;
+
+ { adds a player to the player array, returning its id
+ can only be called when game is not already started }
+ function AddPlayer(Team: Integer; Name: String): Integer;
+
+ { starts a new PartyGame, returns true on success
+ before a call of this function teams and players
+ has to be added by AddTeam and AddPlayer }
+
+ function StartGame(Rounds: ARounds): Boolean;
+
+ { sets the winner(s) of current round
+ returns true on success }
+ function SetRanking(Ranking: AParty_TeamRanking): Boolean;
+
+ { increases round counter by 1 and clears all round specific information;
+ returns the number of the current round or -1 if last round has already
+ been played }
+ function NextRound: integer;
+
+ { indicates that current round has already been played }
+ procedure RoundPlayed;
+
+ { true if in a Party Game (not in standard mode) }
+ property PartyGame: Boolean read BPartyGame;
+
+
+ { returns true if last round was already played }
+ function GameFinished: Boolean;
+
+ { call plugins defined function and/or default procedure
+ only default procedure is called when no function is defined by plugin
+ if plugins function returns true then default is called after plugins
+ function was executed}
+ procedure CallBeforeSongSelect;
+ procedure CallAfterSongSelect;
+ procedure CallBeforeSing;
+ procedure CallOnSing;
+ procedure CallAfterSing;
+
+ { returns an array[1..6] of TParty_TeamRanking.
+ the index stands for the placing,
+ team is the team number (in the team array)
+ rank is correct rank if some teams have the
+ same score.
+ }
+ function GetTeamRanking: AParty_TeamRanking;
+
+ { returns a string like "Team 1 (and Team 2) win" }
+ function GetWinnerString(Round: integer): UTF8String;
+
+ destructor Destroy;
end;
+const
+ { minimal amount of teams for party mode }
+ Party_Teams_Min = 2;
+
+ { maximal amount of teams for party mode }
+ Party_Teams_Max = 3;
+
+ { minimal amount of players for party mode }
+ Party_Players_Min = 1;
+
+ { maximal amount of players for party mode }
+ Party_Players_Max = 4;
+
+ { amount of jokers each team gets at the beginning of the game }
+ Party_Count_Jokers = 5;
+
+ { to indicate that element (mode) should set randomly in ARounds array }
+ Party_Round_Random = -1;
+
+ { values for TParty_TeamRanking.Rank }
+ PR_First = 1;
+ PR_Second = 2;
+ PR_Third = 3;
+
+ StandardModus = 0; //Modus Id that will be played in non-party mode
+
var
- PartySession: TPartySession;
+ Party: TPartyGame;
implementation
uses
- UDLLManager,
UGraphic,
- UNote,
ULanguage,
- ULog;
+ ULog,
+ ULuaCore,
+ UDisplay,
+ USong,
+ UNote,
+ SysUtils;
-constructor TPartySession.Create;
+//-------------
+// Just the constructor
+//-------------
+constructor TPartyGame.Create;
begin
inherited;
+
+ Clear;
end;
-//----------
-// Returns a number of a random plugin
-//----------
-function TPartySession.GetRandomPlugin(Plugins: array of TPartyPlugin): byte;
+destructor TPartyGame.Destroy;
+begin
+ inherited;
+end;
+
+{ clears all party specific data previously stored }
+procedure TPartyGame.Clear;
+ var
+ I: Integer;
+begin
+ bPartyGame := false; // no party game
+ CurRound := low(integer);
+
+ bPartyStarted := false; //game not startet
+
+ SetLength(Teams, 0); //remove team info
+ SetLength(Rounds, 0); //remove round info
+
+ // clear times played
+ for I := 0 to High(TimesPlayed) do
+ TimesPlayed[I] := 0;
+end;
+
+{ private: some intelligent randomnes for plugins }
+function TPartyGame.GetRandomMode: integer;
+var
+ LowestTP: integer;
+ NumPwithLTP: integer;
+ I: integer;
+ R: integer;
+begin
+ Result := 0; //If there are no matching modes, play first modus
+ LowestTP := high(Integer);
+ NumPwithLTP := 0;
+
+ // search for the plugins less played yet
+ for I := 0 to high(Modes) do
+ begin
+ if (ModePlayable(I)) then
+ begin
+ if (TimesPlayed[I] < lowestTP) then
+ begin
+ lowestTP := TimesPlayed[I];
+ NumPwithLTP := 1;
+ end
+ else if (TimesPlayed[I] = lowestTP) then
+ begin
+ Inc(NumPwithLTP);
+ end;
+ end;
+ end;
+
+ // create random number
+ R := Random(NumPwithLTP);
+
+ // select the random mode from the modes with less timesplayed
+ for I := 0 to high(Modes) do
+ begin
+ if (TimesPlayed[I] = lowestTP) and (ModePlayable(I)) then
+ begin
+ //Plugin found
+ if (R = 0) then
+ begin
+ Result := I;
+ Inc(TimesPlayed[I]);
+ Break;
+ end;
+
+ Dec(R);
+ end;
+ end;
+end;
+
+{ private: GetRandomPlayer - returns a random player
+ that does not play to often ;) }
+function TPartyGame.GetRandomPlayer(Team: integer): integer;
var
- LowestTP: byte;
- NumPwithLTP: word;
- I: integer;
- R: word;
+ I, R: integer;
+ lowestTP: Integer;
+ NumPwithLTP: Integer;
begin
- LowestTP := high(byte);
+ LowestTP := high(Integer);
NumPwithLTP := 0;
+ Result := 0;
- //Search for Plugins not often played yet
- for I := 0 to high(Plugins) do
+ // search for players that have less played yet
+ for I := 0 to High(Teams[Team].Players) do
begin
- if (Plugins[I].TimesPlayed < lowestTP) then
+ if (Teams[Team].Players[I].TimesPlayed < lowestTP) then
begin
- lowestTP := Plugins[I].TimesPlayed;
+ lowestTP := Teams[Team].Players[I].TimesPlayed;
NumPwithLTP := 1;
end
- else if (Plugins[I].TimesPlayed = lowestTP) then
+ else if (Teams[Team].Players[I].TimesPlayed = lowestTP) then
begin
Inc(NumPwithLTP);
end;
end;
- //Create random no
+ // create random number
R := Random(NumPwithLTP);
- //Search for random plugin
- for I := 0 to high(Plugins) do
+ // search for selected random player
+ for I := 0 to High(Teams[Team].Players) do
begin
- if Plugins[I].TimesPlayed = LowestTP then
+ if Teams[Team].Players[I].TimesPlayed = lowestTP then
begin
- //Plugin found
if (R = 0) then
- begin
- Result := Plugins[I].ID;
- Inc(Plugins[I].TimesPlayed);
+ begin // found selected player
+ Result := I;
Break;
end;
+
Dec(R);
end;
end;
end;
//----------
-//StartNewParty - Reset and prepares for new party
+//GenScores - inc scores for cur. round
//----------
-procedure TPartySession.StartNewParty(NumRounds: byte);
+procedure TPartyGame.GenScores;
var
- Plugins: array of TPartyPlugin;
- TeamMode: boolean;
- Len: integer;
- I, J: integer;
+ I: Integer;
+begin
+ if (Length(Teams) = 2) then
+ begin // score generation for 2 teams, winner gets 1 point
+ for I := 0 to High(Rounds[CurRound].Ranking) do
+ if (Rounds[CurRound].Ranking[I].Rank = PR_First) then
+ Inc(Teams[Rounds[CurRound].Ranking[I].Team].Score);
+ end
+ else if (Length(Teams) = 3) then
+ begin // score generation for 3 teams,
+ // winner gets 3 points 2nd gets 1 point
+ for I := 0 to High(Rounds[CurRound].Ranking) do
+ if (Rounds[CurRound].Ranking[I].Rank = PR_First) then
+ Inc(Teams[Rounds[CurRound].Ranking[I].Team].Score, 3)
+ else if (Rounds[CurRound].Ranking[I].Rank = PR_Second) then
+ Inc(Teams[Rounds[CurRound].Ranking[I].Team].Score);
+ end
+end;
+
+{ set the attributes of Info to default values }
+procedure TPartyGame.DefaultModeInfo(var Info: TParty_ModeInfo);
+begin
+ Info.Name := 'undefined';
+ Info.Parent := -1; //< not loaded by plugin (e.g. Duell)
+ Info.CanNonParty := false;
+ Info.CanParty := false;
+ Info.PlayerCount := High(Integer); //< no restrictions either on player count
+ Info.TeamCount := High(Integer); //< nor on team count
+ Info.Functions.BeforeSongSelect := ''; //< use default functions
+ Info.Functions.AfterSongSelect := '';
+ Info.Functions.BeforeSing := '';
+ Info.Functions.OnSing := '';
+ Info.Functions.AfterSing := '';
+end;
+
+{ registers a new mode, returns true on success
+ (mode name does not already exist) }
+function TPartyGame.RegisterMode(Info: TParty_ModeInfo): Boolean;
+ var
+ Len: integer;
+ LowerName: String;
+ I: integer;
+begin
+ Result := false;
+
+ if (Info.Name <> 'undefined') then
+ begin
+ // search for a plugin w/ same name
+ LowerName := lowercase(Info.Name); // case sensitive search
+ for I := 0 to high(Modes) do
+ if (LowerName = lowercase(Modes[I].Name)) then
+ exit; //< no success (name already exist)
+
+ // add new mode to array and append and clear a new TimesPlayed element
+ Len := Length(Modes);
+ SetLength(Modes, Len + 1);
+ SetLength(TimesPlayed, Len + 1);
+
+ Modes[Len] := Info;
+ TimesPlayed[Len] := 0;
+
+ Result := True;
+ end;
+end;
+
+{ returns true if a mode is playable with current playerconfig }
+function TPartyGame.ModePlayable(I: integer): boolean;
+ var
+ J: integer;
begin
- //Set current round to 1
- CurRound := 255;
+ if (Length(Teams) = 0) then
+ Result := true
+ else
+ begin
+ if (Modes[I].TeamCount and (1 shl (Length(Teams) - 1)) <> 0) then
+ begin
+ Result := true;
- PlayersPlay := Teams.NumTeams;
+ for J := 0 to High(Teams) do
+ Result := Result and (Modes[I].PlayerCount and (1 shl (Length(Teams[J].Players) - 1)) <> 0);
+ end
+ else
+ Result := false;
+ end;
+end;
- //Get team-mode and set joker, also set TimesPlayed
- TeamMode := true;
- for I := 0 to Teams.NumTeams - 1 do
+{ returns true if modes are available for
+ players and teams that are currently set
+ up. if there are no teams set up it returns
+ if there are any party modes available }
+function TPartyGame.ModesAvailable: Boolean;
+ var
+ I: integer;
+ CountTeams: integer;
+begin
+ CountTeams := Length(Teams);
+ if CountTeams = 0 then
+ begin
+ Result := (Length(Modes) > 0);
+ end
+ else
begin
- if Teams.Teaminfo[I].NumPlayers < 2 then
+ Result := false;
+ for I := 0 to High(Modes) do
begin
- TeamMode := false;
+ Result := ModePlayable(I);
+
+ if Result then
+ Exit;
end;
- //Set player attributes
- for J := 0 to Teams.TeamInfo[I].NumPlayers-1 do
+ end;
+end;
+
+{ returns an array with the name of all available modes (that
+ are playable with current player configuration }
+function TPartyGame.GetAvailableModes: AParty_ModeList;
+ var
+ I: integer;
+ Len: integer;
+begin
+ Len := 0;
+ SetLength(Result, Len + 1);
+ Result[Len].Index := Party_Round_Random;
+ Result[Len].Name := Language.Translate('MODE_RANDOM_NAME');
+
+ for I := 0 to High(Modes) do
+ if (ModePlayable(I)) then
begin
- Teams.TeamInfo[I].Playerinfo[J].TimesPlayed := 0;
+ Inc(Len);
+ SetLength(Result, Len + 1);
+ Result[Len].Index := I;
+ Result[Len].Name := Language.Translate('MODE_' + Uppercase(Modes[I].Name) + '_NAME');
end;
- Teams.Teaminfo[I].Joker := Round(NumRounds * 0.7);
- Teams.Teaminfo[I].Score := 0;
+end;
+
+{ adds a team to the team array, returning its id
+ can only be called when game is not already started }
+function TPartyGame.AddTeam(Name: String): Integer;
+begin
+ Result := -1;
+ if (not bPartyStarted) and (Length(Name) > 0) and (Length(Teams) < Party_Teams_Max) then
+ begin
+ Result := Length(Teams);
+ SetLength(Teams, Result + 1);
+
+ Teams[Result].Name := Name;
+ Teams[Result].Score := 0;
+ Teams[Result].JokersLeft := Party_Count_Jokers;
+ Teams[Result].NextPlayer := -1;
end;
+end;
- //Fill plugin array
- SetLength(Plugins, 0);
- for I := 0 to high(DLLMan.Plugins) do
+{ adds a player to the player array, returning its id
+ can only be called when game is not already started }
+function TPartyGame.AddPlayer(Team: Integer; Name: String): Integer;
+begin
+ Result := -1;
+
+ if (not bPartyStarted) and (Team >= 0) and (Team <= High(Teams)) and (Length(Teams[Team].Players) < Party_Players_Max) and (Length(Name) > 0) then
begin
- if TeamMode or (not DLLMan.Plugins[I].TeamModeOnly) then
- begin
- //Add only those plugins playable with current PlayerConfiguration
- Len := Length(Plugins);
- SetLength(Plugins, Len + 1);
- Plugins[Len].ID := I;
- Plugins[Len].TimesPlayed := 0;
- end;
+ // append element to players array
+ Result := Length(Teams[Team].Players);
+ SetLength(Teams[Team].Players, Result + 1);
+
+ // fill w/ data
+ Teams[Team].Players[Result].Name := Name;
+ Teams[Team].Players[Result].TimesPlayed := 0;
end;
+end;
+
+{ starts a new PartyGame, returns true on success
+ before a call of this function teams and players
+ has to be added by AddTeam and AddPlayer }
+function TPartyGame.StartGame(Rounds: ARounds): Boolean;
+ var
+ I: integer;
+begin
+ Result := false;
- //Set rounds
- if (Length(Plugins) >= 1) then
+ if (not bPartyStarted) and (Length(Rounds) > 0) and (Length(Teams) >= Party_Teams_Min) then
begin
- SetLength (Rounds, NumRounds);
- for I := 0 to NumRounds - 1 do
+ // check teams for minimal player count
+ for I := 0 to High(Teams) do
+ if (Length(Teams[I].Players) < Party_Players_Min) then
+ exit;
+
+ // create rounds array
+ SetLength(Self.Rounds, Length(Rounds));
+
+ for I := 0 to High(Rounds) do
begin
- PartySession.Rounds[I].Plugin := GetRandomPlugin(Plugins);
- PartySession.Rounds[I].Winner := 255;
+ // copy round or select a random round
+ if (Rounds[I] <> Party_Round_Random) and (Rounds[I] >= 0) and (Rounds[I] <= High(Modes)) then
+ Self.Rounds[I].Mode := Rounds[I]
+ else
+ Self.Rounds[I].Mode := GetRandomMode;
+
+ Self.Rounds[I].AlreadyPlayed := false;
+ Self.Rounds[I].RankingSet := false;
+
+ SetLength(Self.Rounds[I].Ranking, 0);
end;
+
+ // get the party started!11
+ bPartyStarted := true;
+ bPartyGame := true;
+ CurRound := low(integer); //< set not to -1 to indicate that party game is not finished
+
+ // first round
+ NextRound;
+
+ Result := True;
+ end;
+end;
+
+{ sets the winner(s) of current round
+ returns true on success }
+function TPartyGame.SetRanking(Ranking: AParty_TeamRanking): Boolean;
+ var
+ I, J: Integer;
+ TeamExists: Integer;
+ Len: Integer;
+ Temp: TParty_TeamRanking;
+begin
+ if (bPartyStarted) and (CurRound >= 0) and (CurRound <= High(Rounds)) then
+ begin
+ Rounds[CurRound].Ranking := Ranking;
+ Result := true;
+
+ // look for teams that don't exist
+ TeamExists := 0;
+ for I := 0 to High(Rounds[CurRound].Ranking) do
+ TeamExists := TeamExists or (1 shl (Rounds[CurRound].Ranking[I].Team-1));
+
+ // create teams that don't exist
+ Len := Length(Rounds[CurRound].Ranking);
+ for I := 0 to High(Teams) do
+ if (TeamExists and (1 shl I) = 0) then
+ begin
+ Inc(Len);
+ SetLength(Rounds[CurRound].Ranking, Len);
+ Rounds[CurRound].Ranking[Len-1].Team := I + 1;
+ Rounds[CurRound].Ranking[Len-1].Rank := Length(Teams);
+ end;
+
+ // we may remove rankings from invalid teams here to
+ // but at the moment this is not necessary, because the
+ // functions this function is called from don't create
+ // invalid rankings
+
+ // bubble sort rankings by team
+ J := High(Rounds[CurRound].Ranking);
+ repeat
+ for I := 0 to J - 1 do
+ if (Rounds[CurRound].Ranking[I].Team > Rounds[CurRound].Ranking[I+1].Team) then
+ begin
+ Temp := Rounds[CurRound].Ranking[I];
+ Rounds[CurRound].Ranking[I] := Rounds[CurRound].Ranking[I+1];
+ Rounds[CurRound].Ranking[I+1] := Temp;
+ end;
+ Dec(J);
+ until J <= 0;
+
+ //set rounds RankingSet to true
+ Rounds[CurRound].RankingSet := true;
end
else
- SetLength (Rounds, 0);
+ Result := false;
end;
-{**
- * Returns a random player to play next round
- *}
-function TPartySession.GetRandomPlayer(Team: byte): byte;
-var
- I, R: integer;
- LowestTP: byte;
- NumPwithLTP: byte;
+{ sets ranking of current round by score saved in players array }
+procedure TPartyGame.SetRankingByScore;
+ var
+ I, J: Integer;
+ Rank: Integer;
+ Ranking: AParty_TeamRanking;
+ Scores: array of Integer;
+ TmpRanking: TParty_TeamRanking;
+ TmpScore: Integer;
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
+ if (Length(Player) = Length(Teams)) then
begin
- if (Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed < lowestTP) then
+ SetLength(Ranking, Length(Teams));
+ SetLength(Scores, Length(Teams));
+
+ // fill ranking array
+ for I := 0 to High(Ranking) do
begin
- lowestTP := Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed;
- NumPwithLTP := 1;
- end
- else if (Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed = lowestTP) then
+ Ranking[I].Team := I;
+ Ranking[I].Rank := 0;
+ Scores[I] := Player[I].ScoreTotalInt;
+ end;
+
+ // bubble sort by score
+ J := High(Ranking);
+ repeat
+ for I := 0 to J - 1 do
+ if (Scores[I] < Scores[I+1]) then
+ begin
+ TmpRanking := Ranking[I];
+ Ranking[I] := Ranking[I+1];
+ Ranking[I+1] := TmpRanking;
+
+ TmpScore := Scores[I];
+ Scores[I] := Scores[I+1];
+ Scores[I+1] := TmpScore;
+ end;
+ Dec(J);
+ until J <= 0;
+
+ // set rank field
+ Rank := 1; //first rank has id 1
+ for I := 0 to High(Ranking) do
begin
- Inc(NumPwithLTP);
+ Ranking[I].Rank := Rank;
+
+ if (I < High(Ranking)) and (Scores[I] <> Scores[I+1]) then
+ Inc(Rank); // next rank if next team has different score
end;
+ end
+ else
+ SetLength(Ranking, 0);
+
+ SetRanking(Ranking);
+end;
+
+{ increases round counter by 1 and clears all round specific information;
+ returns the number of the current round or -1 if last round has already
+ been played }
+function TPartyGame.NextRound: integer;
+ var I: Integer;
+begin
+ // some lines concerning the previous round
+ if (CurRound >= 0) then
+ begin
+ Rounds[CurRound].AlreadyPlayed := true;
+
+ GenScores;
end;
- //Create random number
- R := Random(NumPwithLTP);
+ // increase round counter
+ Inc(CurRound);
+ if (CurRound < -1) then // we start first round
+ CurRound := 0;
+
+ if (CurRound > High(Rounds)) then
+ CurRound := -1; //< last round played
+
+ Result := CurRound;
- //Search for random player
- for I := 0 to Teams.Teaminfo[Team].NumPlayers - 1 do
+ // some lines concerning the next round
+ if (CurRound >= 0) then
begin
- if Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed = lowestTP then
+ // select player
+ for I := 0 to High(Teams) do
+ Teams[I].NextPlayer := GetRandomPlayer(I);
+ end;
+end;
+
+{ indicates that current round has already been played }
+procedure TPartyGame.RoundPlayed;
+begin
+ if (bPartyStarted) and (CurRound >= 0) and (CurRound <= High(Rounds)) then
+ begin
+ // set rounds ranking by score if it was not set by plugin
+ if (not Rounds[CurRound].RankingSet) then
+ SetRankingByScore;
+
+ Rounds[CurRound].AlreadyPlayed := True;
+ end;
+end;
+
+{ returns true if last round was already played }
+function TPartyGame.GameFinished: Boolean;
+begin
+ Result := (bPartyStarted and (CurRound = -1));
+end;
+
+{ private: calls the specified function Func from lua plugin Parent
+ if both exist.
+ return true if default function should be called
+ (function or plugin does not exist, or function returns
+ true) }
+function TPartyGame.CallLua(Parent: Integer; Func: String):Boolean;
+ var
+ P: TLuaPlugin;
+begin
+ // call default function by default
+ Result := true;
+
+ // check for core plugin and empty function name
+ if (Parent >= 0) and (Length(Func) > 0) then
+ begin
+ // get plugin that registred the mode
+ P := LuaCore.GetPluginById(Parent);
+
+ if (P <> nil) then
begin
- //Player found
- if (R = 0) then
- begin
- Result := I;
- Break;
- end;
-
- Dec(R);
+ if (P.CallFunctionByName(Func, 0, 1)) then
+ // check result
+ Result := (lua_toboolean(P.LuaState, 1));
end;
end;
end;
-{**
- * Prepares ScreenSingModi for next round and loads plugin
- *}
-procedure TPartySession.StartRound;
-var
- I: integer;
+{ call plugins defined function and/or default procedure
+ only default procedure is called when no function is defined by plugin
+ if plugins function returns true then default is called after plugins
+ function was executed}
+procedure TPartyGame.CallBeforeSongSelect;
+ var
+ ExecuteDefault: boolean;
begin
- if ((CurRound < high(Rounds)) or (CurRound = high(CurRound))) then
+ if not bPartyStarted then
+ ExecuteDefault := true
+ else if (CurRound >= 0) then
begin
- //Increase Current Round
- Inc(CurRound);
-
- Rounds[CurRound].Winner := 255;
- DllMan.LoadPlugin(Rounds[CurRound].Plugin);
+ // we set screen song to party mode
+ // plugin should not have to do this if it
+ // don't want default procedure to be executed
+ ScreenSong.Mode := smPartyMode;
- //Select Players
- for I := 0 to Teams.NumTeams - 1 do
- Teams.Teaminfo[I].CurPlayer := GetRandomPlayer(I);
+ with Modes[Rounds[CurRound].Mode] do
+ ExecuteDefault := (CallLua(Parent, Functions.BeforeSongSelect));
+ end
+ else
+ ExecuteDefault := true;
- //Set ScreenSingModie Variables
- ScreenSingModi.TeamInfo := Teams;
+ // execute default function:
+ if ExecuteDefault then
+ begin
+ // display song select screen
+ Display.FadeTo(@ScreenSong);
end;
end;
-//----------
-//EndRound - Get Winner from ScreenSingModi and Save Data to RoundArray
-//----------
-procedure TPartySession.EndRound;
-var
- I: Integer;
+procedure TPartyGame.CallAfterSongSelect;
+ var
+ ExecuteDefault: boolean;
begin
- //Copy Winner
- Rounds[CurRound].Winner := ScreenSingModi.Winner;
- //Set Scores
- GenScores;
+ if not bPartyStarted then
+ ExecuteDefault := true
+ else if (CurRound >= 0) then
+ begin
+ with Modes[Rounds[CurRound].Mode] do
+ ExecuteDefault := (CallLua(Parent, Functions.AfterSongSelect));
+ end
+ else
+ ExecuteDefault := true;
+
+ // execute default function:
+ if ExecuteDefault then
+ begin
+ // display sing screen
+ ScreenSong.StartSong;
+ end;
+end;
- //Increase TimesPlayed 4 all Players
- For I := 0 to Teams.NumTeams-1 do
- Inc(Teams.Teaminfo[I].Playerinfo[Teams.Teaminfo[I].CurPlayer].TimesPlayed);
+procedure TPartyGame.CallBeforeSing;
+ var
+ ExecuteDefault: boolean;
+begin
+ if not bPartyStarted then
+ ExecuteDefault := true
+ else if (CurRound >= 0) then
+ begin
+ with Modes[Rounds[CurRound].Mode] do
+ ExecuteDefault := (CallLua(Parent, Functions.BeforeSing));
+ end
+ else
+ ExecuteDefault := true;
+ // execute default function:
+ if ExecuteDefault then
+ begin
+ //nothing atm
+ { to-do : compartmentalize TSingScreen.OnShow into
+ functions for init of a specific part of
+ sing screen.
+ these functions should be called here before
+ sing screen is shown, or it should be called
+ by plugin if it wants to define a custom
+ singscreen start up. }
+
+ //set correct playersplay
+ if (bPartyGame) then
+ PlayersPlay := Length(Teams);
+ end;
end;
-//----------
-//IsWinner - returns true if the player's bit is set in the winner byte
-//----------
-function TPartySession.IsWinner(Player, Winner: byte): boolean;
-var
- Mask: byte;
+procedure TPartyGame.CallOnSing;
+ var
+ ExecuteDefault: boolean;
begin
- Mask := 1 shl Player;
- Result := (Winner and Mask) <> 0;
+ if not bPartyStarted then
+ ExecuteDefault := true
+ else if (CurRound >= 0) then
+ begin
+ with Modes[Rounds[CurRound].Mode] do
+ ExecuteDefault := (CallLua(Parent, Functions.OnSing));;
+ end
+ else
+ ExecuteDefault := true;
+
+ // execute default function:
+ if ExecuteDefault then
+ begin
+ //nothing atm
+ end;
end;
-//----------
-//GenScores - increase scores for current round
-//----------
-procedure TPartySession.GenScores;
-var
- I: byte;
+procedure TPartyGame.CallAfterSing;
+ var
+ ExecuteDefault: boolean;
begin
- for I := 0 to Teams.NumTeams - 1 do
+ if not bPartyStarted then
+ ExecuteDefault := true
+ else if (CurRound >= 0) then
+ begin
+ with Modes[Rounds[CurRound].Mode] do
+ ExecuteDefault := (CallLua(Parent, Functions.AfterSing));
+ end
+ else
+ ExecuteDefault := true;
+
+ // execute default function:
+ if ExecuteDefault then
begin
- if isWinner(I, Rounds[CurRound].Winner) then
- Inc(Teams.Teaminfo[I].Score);
+ if (bPartyGame) then
+ // display party score screen
+ Display.FadeTo(@ScreenPartyScore)
+ else //display standard score screen
+ Display.FadeTo(@ScreenScore);
end;
end;
-//----------
-//GetTeamOrder - returns the placement of each Team [First Position of Array is Teamnum of first placed Team, ...]
-//----------
-function TPartySession.GetTeamOrder: TeamOrderArray;
-var
- I, J: integer;
- ATeams: array [0..5] of TeamOrderEntry;
- TempTeam: TeamOrderEntry;
+{ returns an array[1..6] of integer. the index stands for the placing,
+ value is the team number (in the team array) }
+function TPartyGame.GetTeamRanking: AParty_TeamRanking;
+ var
+ I, J: Integer;
+ Temp: TParty_TeamRanking;
+ Rank: Integer;
begin
- // TODO: PartyMode: Write this in another way, so that teams with the same score get the same place
- //Fill Team array
- for I := 0 to Teams.NumTeams - 1 do
+ SetLength(Result, Length(Teams));
+
+ // fill ranking array
+ for I := 0 to High(Result) do
begin
- ATeams[I].Teamnum := I;
- ATeams[I].Score := Teams.Teaminfo[I].Score;
+ Result[I].Team := I;
+ Result[I].Rank := 0;
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
+ // bubble sort by score
+ J := High(Result);
+ repeat
+ for I := 0 to J - 1 do
+ if (Teams[Result[I].Team].Score < Teams[Result[I+1].Team].Score) then
begin
- TempTeam := ATeams[I-1];
- ATeams[I-1] := ATeams[I];
- ATeams[I] := TempTeam;
+ Temp := Result[I];
+ Result[I] := Result[I+1];
+ Result[I+1] := Temp;
end;
+ Dec(J);
+ until J <= 0;
+
+ // set rank field
+ Rank := 1; //first rank has id 1
+ for I := 0 to High(Result) do
+ begin
+ Result[I].Rank := Rank;
- //Copy to Result
- for I := 0 to Teams.NumTeams-1 do
- Result[I] := ATeams[I].TeamNum;
+ if (I < High(Result)) and (Teams[Result[I].Team].Score <> Teams[Result[I+1].Team].Score) then
+ Inc(Rank); // next rank if next team has different score
+ end;
end;
-//----------
-//GetWinnerString - Get string with WinnerTeam Name, when there is more than one Winner than Connect with and or ,
-//----------
-function TPartySession.GetWinnerString(Round: byte): string;
+{ returns a string like "Team 1 (and Team 2) win"
+ if Round is in range from 0 to high(Rounds) then
+ result is name of winners of specified round.
+ if Round is -1 the result is name of winners of
+ the whole party game}
+function TPartyGame.GetWinnerString(Round: integer): UTF8String;
var
- Winners: array of string;
- I: integer;
+ Winners: array of UTF8String;
+ I: integer;
+ Ranking: AParty_TeamRanking;
begin
- Result := Language.Translate('PARTY_NOBODY');
+ Result := '';
+ Ranking := nil;
- if (Round > High(Rounds)) then
- exit;
-
- if (Rounds[Round].Winner = 0) then
+ if (Round >= 0) and (Round <= High(Rounds)) then
begin
- exit;
- end;
+ if (not Rounds[Round].AlreadyPlayed) then
+ Result := Language.Translate('PARTY_NOTPLAYEDYET')
+ else
+ Ranking := Rounds[Round].Ranking;
+ end
+ else if (Round = -1) then
+ Ranking := GetTeamRanking;
- if (Rounds[Round].Winner = 255) then
- begin
- Result := Language.Translate('PARTY_NOTPLAYEDYET');
- exit;
- end;
- SetLength(Winners, 0);
- for I := 0 to Teams.NumTeams - 1 do
+ if (Ranking <> nil) then
begin
- if isWinner(I, Rounds[Round].Winner) then
+ SetLength(Winners, 0);
+ for I := 0 to High(Ranking) do
begin
- SetLength(Winners, Length(Winners) + 1);
- Winners[high(Winners)] := Teams.TeamInfo[I].Name;
+ if (Ranking[I].Rank = PR_First) and (Ranking[I].Team >= 0) and (Ranking[I].Team <= High(Teams)) then
+ begin
+ SetLength(Winners, Length(Winners) + 1);
+ Winners[high(Winners)] := UTF8String(Teams[Ranking[I].Team].Name);
+ end;
end;
+
+ if (Length(Winners) > 0) then
+ Result := Language.Implode(Winners);
end;
- Result := Language.Implode(Winners);
+
+ if (Length(Result) = 0) then
+ Result := Language.Translate('PARTY_NOBODY');
end;
end.
diff --git a/cmake/src/base/UPath.pas b/cmake/src/base/UPath.pas
index 2316ac02..7c00e7b1 100644
--- a/cmake/src/base/UPath.pas
+++ b/cmake/src/base/UPath.pas
@@ -1,188 +1,1427 @@
-{* UltraStar Deluxe - Karaoke Game
- *
- * UltraStar Deluxe is the legal property of its developers, whose names
- * are too numerous to list here. Please refer to the COPYRIGHT
- * file distributed with this source distribution.
- *
- * This program is free software; you can redistribute it and/or
- * modify it under the terms of the GNU General Public License
- * as published by the Free Software Foundation; either version 2
- * of the License, or (at your option) any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- * GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License
- * along with this program; see the file COPYING. If not, write to
- * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
- * Boston, MA 02110-1301, USA.
- *
- * $URL: https://ultrastardx.svn.sourceforge.net/svnroot/ultrastardx/trunk/src/base/UPath.pas $
- * $Id: UPath.pas 1624 2009-03-06 23:45:10Z k-m_schindler $
- *}
-
-unit UPath;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses
- SysUtils,
- Classes;
-
-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;
- FontPath: string;
- ResourcesPath: string;
- PlayListPath: string;
-
-function FindPath(out PathResult: string; const RequestedPath: string; NeedsWritePermission: boolean): boolean;
-procedure InitializePaths;
-procedure AddSongPath(const Path: string);
-
-implementation
-
-uses
- StrUtils,
- UPlatform,
- UCommandLine,
- ULog;
-
-procedure AddSpecialPath(var PathList: TStringList; const Path: string);
-var
- Index: integer;
- PathAbs, OldPathAbs: string;
-begin
- if (PathList = nil) then
- PathList := TStringList.Create;
-
- if (Path = '') or not ForceDirectories(Path) then
- Exit;
-
- PathAbs := IncludeTrailingPathDelimiter(ExpandFileName(Path));
-
- // check if path or a part of the path was already added
- for Index := 0 to PathList.Count-1 do
- begin
- OldPathAbs := IncludeTrailingPathDelimiter(ExpandFileName(PathList[Index]));
- // 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[Index] := 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(FontPath, Platform.GetGameSharedPath + 'fonts', 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.
+{* UltraStar Deluxe - Karaoke Game
+ *
+ * UltraStar Deluxe is the legal property of its developers, whose names
+ * are too numerous to list here. Please refer to the COPYRIGHT
+ * file distributed with this source distribution.
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; see the file COPYING. If not, write to
+ * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+ * Boston, MA 02110-1301, USA.
+ *
+ * $URL$
+ * $Id$
+ *}
+
+unit UPath;
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+interface
+
+uses
+ SysUtils,
+ Classes,
+ IniFiles,
+ {$IFDEF MSWINDOWS}
+ TntClasses,
+ {$ENDIF}
+ UConfig,
+ UUnicodeUtils;
+
+type
+ IPath = interface;
+
+ {$IFDEF FPC}
+ TFileHandle = THandle;
+ {$ELSE}
+ TFileHandle = Longint;
+ {$ENDIF}
+
+ {**
+ * TUnicodeMemoryStream
+ *}
+ TUnicodeMemoryStream = class(TMemoryStream)
+ public
+ procedure LoadFromFile(const FileName: IPath);
+ procedure SaveToFile(const FileName: IPath);
+ end;
+
+ {**
+ * Unicode capable IniFile implementation.
+ * TMemIniFile and TIniFile are not able to handle INI-files with
+ * an UTF-8 BOM. This implementation checks if an UTF-8 BOM exists
+ * and removes it from the internal string-list.
+ * UTF8Encoded is set accordingly.
+ *}
+ TUnicodeMemIniFile = class(TMemIniFile)
+ private
+ FFilename: IPath;
+ FUTF8Encoded: boolean;
+ public
+ constructor Create(const FileName: IPath; UTF8Encoded: boolean = false); reintroduce;
+ procedure UpdateFile; override;
+ property UTF8Encoded: boolean READ FUTF8Encoded WRITE FUTF8Encoded;
+ end;
+
+ {**
+ * TBinaryFileStream (inherited from THandleStream)
+ *}
+ {$IFDEF MSWINDOWS}
+ TBinaryFileStream = class(TTntFileStream)
+ {$ELSE}
+ TBinaryFileStream = class(TFileStream)
+ {$ENDIF}
+ public
+ {**
+ * @seealso TFileStream.Create for valid Mode parameters
+ *}
+ constructor Create(const FileName: IPath; Mode: word);
+ end;
+
+ {**
+ * TTextFileStream
+ *}
+ TTextFileStream = class(TStream)
+ protected
+ fLineBreak: RawByteString;
+ fFilename: IPath;
+ fMode: word;
+
+ function ReadLine(var Success: boolean): RawByteString; overload; virtual; abstract;
+ public
+ constructor Create(Filename: IPath; Mode: word);
+
+ function ReadString(): RawByteString; virtual; abstract;
+ function ReadLine(var Line: UTF8String): boolean; overload;
+ function ReadLine(var Line: AnsiString): boolean; overload;
+
+ procedure WriteString(const Str: RawByteString); virtual;
+ procedure WriteLine(const Line: RawByteString); virtual;
+
+ property LineBreak: RawByteString read fLineBreak write fLineBreak;
+ property Filename: IPath read fFilename;
+ end;
+
+ {**
+ * TMemTextStream
+ *}
+ TMemTextFileStream = class(TTextFileStream)
+ private
+ fStream: TMemoryStream;
+ protected
+ function GetSize: int64; override;
+
+ {**
+ * Copies fStream.Memory from StartPos to EndPos-1 to the result string;
+ *}
+ function CopyMemString(StartPos: int64; EndPos: int64): RawByteString;
+ public
+ constructor Create(Filename: IPath; Mode: word);
+ destructor Destroy(); override;
+
+ function Read(var Buffer; Count: longint): longint; override;
+ function Write(const Buffer; Count: longint): longint; override;
+ function Seek(Offset: longint; Origin: word): longint; override;
+ function Seek(const Offset: int64; Origin: TSeekOrigin): int64; override;
+
+ function ReadLine(var Success: boolean): RawByteString; override;
+ function ReadString(): RawByteString; override;
+ end;
+
+ {**
+ TUnicodeIniStream = class()
+ end;
+ *}
+
+ {**
+ * pdKeep: Keep path as is, neither remove or append a delimiter
+ * pdAppend: Append a delimiter if path does not have a trailing one
+ * pdRemove: Remove a trailing delimiter from the path
+ *}
+ TPathDelimOption = (pdKeep, pdAppend, pdRemove);
+
+ IPathDynArray = array of IPath;
+
+ {**
+ * An IPath represents a filename, a directory or a filesystem path in general.
+ * It hides some of the operating system's specifics like path delimiters
+ * and encodings and provides an easy to use interface to handle them.
+ * Internally all paths are stored with the same path delimiter (PathDelim)
+ * and encoding (UTF-8). The transformation is already done AT THE CREATION of
+ * the IPath and hence calls to e.g. IPath.Equal() will not distinguish between
+ * Unix and Windows style paths.
+ *
+ * Create new paths with one of the Path() functions.
+ * If you need a string representation use IPath.ToNative/ToUTF8/ToWide.
+ * Note that due to the path-delimiter and encoding transformation the string
+ * might have changed. Path('one\test/path').ToUTF8() might return 'one/test/path'.
+ *
+ * It is recommended to use an IPath as long as possible without a string
+ * conversion (IPath.To...()). The whole Delphi (< 2009) and FPC RTL is ANSI
+ * only on Windows. If you would use for example FileExists(MyPath.ToNative)
+ * it would not find a file which contains characters that are not in the
+ * current locale. Same applies to AssignFile(), TFileStream.Create() and
+ * everything else in the RTL that expects a filename.
+ * As a rule of thumb: NEVER use any of the Delphi/FPC RTL filename functions
+ * if the filename parameter is not of a UTF8String or WideString type.
+ *
+ * If you need to open a file use TBinaryStream or TFileStream instead. Many
+ * of the RTL classes offer a LoadFromStream() method so ANSI Open() methods
+ * can be workaround.
+ *
+ * If there is only a ANSI and no IPath/UTF-8/WideString version and you cannot
+ * even pass a stream instead of a filename be aware that even if you know that
+ * a filename is ASCII only, subdirectories in an absolute path might contain
+ * some non-ASCII characters (for example the user's name) and hence might
+ * fail (if the characters are not in the current locale).
+ * It is rare but it happens.
+ *
+ * IMPORTANT:
+ * This interface needs the cwstring unit on Unix (Max OS X / Linux) systems.
+ * Cwstring functions (WideUpperCase, ...) cannot be used by external threads
+ * as FPC uses Thread-Local-Storage for the implementation. As a result do not
+ * call IPath stuff by external threads (e.g. in C callbacks or by SDL-threads).
+ *}
+ IPath = interface
+ ['{686BF103-CE43-4598-B85D-A2C3AF950897}']
+ {**
+ * Returns the path as an UTF8 encoded string.
+ * If UseNativeDelim is set to true, the native path delimiter ('\' on win32)
+ * is used. If it is set to false the (more) portable '/' delimiter will used.
+ *}
+ function ToUTF8(UseNativeDelim: boolean = true): UTF8String;
+
+ {**
+ * Returns the path as an UTF-16 encoded string.
+ * If UseNativeDelim is set to true, the native path delimiter ('\' on win32)
+ * is used. If it is set to false the delimiter will be '/'.
+ *}
+ function ToWide(UseNativeDelim: boolean = true): WideString;
+
+ {**
+ * Returns the path with the system's native encoding and path delimiter.
+ * Win32: ANSI (use the UTF-16 version IPath.ToWide() whenever possible)
+ * Mac: UTF8
+ * Unix: UTF8 or ANSI according to LC_CTYPE
+ *}
+ function ToNative(): RawByteString;
+
+ {**
+ * Note: File must be closed with FileClose(Handle) after usage
+ * @seealso SysUtils.FileOpen()
+ *}
+ function Open(Mode: longword): TFileHandle;
+
+ {** @seealso SysUtils.ExtractFileDrive() *}
+ function GetDrive(): IPath;
+
+ {** @seealso SysUtils.ExtractFilePath() *}
+ function GetPath(): IPath;
+
+ {** @seealso SysUtils.ExtractFileDir() *}
+ function GetDir(): IPath;
+
+ {** @seealso SysUtils.ExtractFileName() *}
+ function GetName(): IPath;
+
+ {** @seealso SysUtils.ExtractFileExtension() *}
+ function GetExtension(): IPath;
+
+ {**
+ * Returns a copy of the path with the extension changed to Extension.
+ * The file itself is not changed, use Rename() for this task.
+ * @seealso SysUtils.ChangeFileExt()
+ *}
+ function SetExtension(const Extension: IPath): IPath; overload;
+ function SetExtension(const Extension: RawByteString): IPath; overload;
+ function SetExtension(const Extension: WideString): IPath; overload;
+
+ {**
+ * Returns the representation of the path relative to Basename.
+ * Note that the basename must be terminated with a path delimiter
+ * otherwise the last path component will be ignored.
+ * @seealso SysUtils.ExtractRelativePath()
+ *}
+ function GetRelativePath(const BaseName: IPath): IPath;
+
+ {** @seealso SysUtils.ExpandFileName() *}
+ function GetAbsolutePath(): IPath;
+
+ {**
+ * Returns the concatenation of this path with Child. If this path does not
+ * end with a path delimiter one is inserted in front of the Child path.
+ * Example: Path('parent').Append(Path('child')) -> Path('parent/child')
+ *}
+ function Append(const Child: IPath; DelimOption: TPathDelimOption = pdKeep): IPath; overload;
+ function Append(const Child: RawByteString; DelimOption: TPathDelimOption = pdKeep): IPath; overload;
+ function Append(const Child: WideString; DelimOption: TPathDelimOption = pdKeep): IPath; overload;
+
+ {**
+ * Splits the path into its components. Path delimiters are not removed from
+ * components.
+ * Example: C:\test\my\dir -> ['C:\', 'test\', 'my\', 'dir']
+ *}
+ function SplitDirs(): IPathDynArray;
+
+ {**
+ * Returns the parent directory or PATH_NONE if none exists.
+ *}
+ function GetParent(): IPath;
+
+ {**
+ * Checks if this path is a subdir of or file inside Parent.
+ * If Direct is true this path must be a direct child.
+ * Example: C:\test\file is a direct child of C:\test and a child of C:\
+ *}
+ function IsChildOf(const Parent: IPath; Direct: boolean): boolean;
+
+ {**
+ * Adjusts the case of the path on case senstitive filesystems.
+ * If the path does not exist or the filesystem is case insensitive
+ * the original path will be returned. Otherwise a corrected copy.
+ *}
+ function AdjustCase(AdjustAllLevels: boolean): IPath;
+
+ {** @seealso SysUtils.IncludeTrailingPathDelimiter() *}
+ function AppendPathDelim(): IPath;
+
+ {** @seealso SysUtils.ExcludeTrailingPathDelimiter() *}
+ function RemovePathDelim(): IPath;
+
+ function Exists(): boolean;
+ function IsFile(): boolean;
+ function IsDirectory(): boolean;
+ function IsAbsolute(): boolean;
+ function GetFileAge(): integer; overload;
+ function GetFileAge(out FileDateTime: TDateTime): boolean; overload;
+ function GetAttr(): cardinal;
+ function SetAttr(Attr: Integer): boolean;
+ function IsReadOnly(): boolean;
+ function SetReadOnly(ReadOnly: boolean): boolean;
+
+ {**
+ * Checks if this path points to nothing, that means the path consists of
+ * the empty string '' and hence equals PATH_NONE.
+ * This is a shortcut for IPath.Equals('') or IPath.Equals(PATH_NONE).
+ * If IsUnset() returns true this path and PATH_NONE are equal but they must
+ * not be identical as the references might point to different objects.
+ *
+ * Example:
+ * Path('').Equals(PATH_EMPTY) -> true
+ * Path('') = PATH_EMPTY -> false
+ *}
+ function IsUnset(): boolean;
+ function IsSet(): boolean;
+
+ {**
+ * Compares this path with Other and returns true if both paths are
+ * equal. Both paths are expanded and trailing slashes excluded before
+ * comparison. If IgnoreCase is true, the case will be ignored on
+ * case-sensitive filesystems.
+ *}
+ function Equals(const Other: IPath; IgnoreCase: boolean = false): boolean; overload;
+ function Equals(const Other: RawByteString; IgnoreCase: boolean = false): boolean; overload;
+ function Equals(const Other: WideString; IgnoreCase: boolean = false): boolean; overload;
+
+ {**
+ * Searches for a file in DirList. The Result is nil if the file was
+ * not found. Use IFileSystem.FileFind() instead if you want to use
+ * wildcards.
+ * @seealso SysUtils.FileSearch()
+ *}
+ function FileSearch(const DirList: IPath): IPath;
+
+ {**
+ * File must be closed with FileClose(Handle) after usage
+ *}
+ function CreateFile(): TFileHandle;
+ function DeleteFile(): boolean;
+ function CreateDirectory(Force: boolean = false): boolean;
+ function DeleteEmptyDir(): boolean;
+ function Rename(const NewName: IPath): boolean;
+ function CopyFile(const Target: IPath; FailIfExists: boolean): boolean;
+
+ // TODO: Dirwatch stuff
+ // AddFileChangeListener(Listener: TFileChangeListener);
+
+ {**
+ * Internal string representation. For debugging only.
+ *}
+ function GetIntern: UTF8String;
+ property Intern: UTF8String READ GetIntern;
+ end;
+
+{**
+ * Creates a new path with the given pathname. PathName can be either in UTF8
+ * or the local encoding.
+ * Notes:
+ * - On Apple only UTF8 is supported
+ * - Same applies to Unix with LC_CTYPE set to UTF8 encoding (default on newer systems)
+ *}
+function Path(const PathName: RawByteString; DelimOption: TPathDelimOption = pdKeep): IPath; overload;
+function Path(PathName: PChar; DelimOption: TPathDelimOption = pdKeep): IPath; overload;
+
+{**
+ * Creates a new path with the given UTF-16 pathname.
+ *}
+function Path(const PathName: WideString; DelimOption: TPathDelimOption = pdKeep): IPath; overload;
+
+{**
+ * Returns a singleton for Path('').
+ *}
+function PATH_NONE(): IPath;
+
+implementation
+
+uses
+ RTLConsts,
+ UTextEncoding,
+ UFilesystem;
+
+{*
+ * Due to a compiler bug in FPC <= 2.2.4 reference counting does not work
+ * properly with interfaces (see http://bugs.freepascal.org/view.php?id=14019).
+ *
+ * There are two (probably more) scenarios causes a program to crash:
+ *
+ * 1. Assume we execute Path('fail').GetParent().ToUTF8(). The compiler will
+ * internally create a temporary variable to hold the result of Path('fail').
+ * This temporary var is then passed as Self to GetParent(). Unfortunately FPC
+ * does already decrement the ref-count of the temporary var at the end of the
+ * call to Path('fail') and the ref-count drops to zero and the temp object
+ * is destroyed as FPC erroneously assumes that the temp is not used anymore.
+ * As a result the Self variable in GetParent() will be invalid, the same
+ * applies to TPathImpl.fName which reference count dropped to zero when the
+ * temp was destroyed. Hence GetParent() will likely crash.
+ * If it does not, ToUTF8() will either return some random string
+ * (e.g. '' or stupid stuff like 'fhwkjehdk') or crash.
+ * Either way the result of ToUTF8() is messed up.
+ * This scenario applies whenever a function (or method) is called that returns
+ * an interfaced object (e.g. an IPath) and the result is used without storing
+ * a reference to it in a (temporary) variable first.
+ *
+ * Tmp := Path('fail'); Tmp2 := Tmp.GetParent(); Tmp2.ToUTF8();
+ *
+ * will not crash but is very impractical and error-prone. Note that Tmp2 cannot
+ * be replaced with Tmp (see scenario 2).
+ *
+ * 2. Another situation this bug will ruin our lives is when a variable to an
+ * interfaced object is used at the left and right side of an assignment as in:
+ * MyPath := MyPath.GetParent()
+ *
+ * Although the bug is already fixed in the FPC development version 2.3.1
+ * it will take quite some time till the next FPC release (> 2.2.4) in which
+ * this issue is fixed.
+ *
+ * To workaround this bug we use some very simple and stupid kind of garbage
+ * collection. New IPaths are stored in an IInterfaceList (call it GarbaegeList)
+ * to artificially increase the ref-count of the newly created object.
+ * This keeps the object alive when FPC's temporary variable comes to the end
+ * of its lifetime and the object's ref-count is decremented
+ * (and is now 1 instead of 0).
+ * Later on, the object is either garbage or referenced by another variable.
+ *
+ * Look at
+ * MyPath := Path('SomeDir/SubDir').GetParent()
+ *
+ * (1) The result of Path('SomeDir/SubDir') is garbage as it is not used anymore.
+ * (2) The result of GetParent() is referenced by MyPath
+ * Object (1) has a reference count of 1 (as it is only referenced by the
+ * GarbageList). Object (2) is referenced twice (MyPath + GarbageList).
+ * When the reference to (2) is finally stored in MyPath we can safely remove
+ * (1) and (2) from the GarbageList so (1) will be freed and the ref-count of
+ * (2) will be decremented to 1.
+ *
+ * As we do not know when it is safe to remove an object from the GarbageList
+ * we assume that there are max. GarbageMaxCount IPath elements created until
+ * the execution of the expression is performed and a reference to the resulting
+ * object is assigned to a variable so all temps can be safely deleted.
+ *
+ * Worst-case scenarios are recursive calls or calls with large call stacks with
+ * functions that return an IPath. Also keep in mind that multiple threads might
+ * be executing such functions at the same time.
+ * A reasonable count might be a max. of 20.000 elements. With an average length
+ * of 40 UTF8 chars (maybe 60 byte with class info, pointer etc.) per IPath
+ * this will consume ~1.2MB.
+ *}
+{$IFDEF FPC}
+{$IF FPC_VERSION_INT <= 002002004} // <= 2.2.4
+ {$DEFINE HAVE_REFCNTBUG}
+{$IFEND}
+{$ENDIF}
+
+{$IFDEF HAVE_REFCNTBUG}
+const
+ // when GarbageList.Count reaches GarbageMaxCount the oldest references in
+ // GarbageList will be deleted until GarbageList.Count equals GarbageAfterCleanCount.
+ GarbageMaxCount = 20000;
+ GarbageAfterCleanCount = GarbageMaxCount-1000;
+
+var
+ GarbageList: IInterfaceList;
+{$ENDIF}
+
+type
+ TPathImpl = class(TInterfacedObject, IPath)
+ private
+ fName: UTF8String; //<** internal filename string, always UTF8 with PathDelim
+
+ {**
+ * Unifies the filename. Path-delimiters are replaced by '/'.
+ *}
+ procedure Unify(DelimOption: TPathDelimOption);
+
+ {**
+ * Returns a copy of fName with path delimiters changed to '/'.
+ *}
+ function GetPortableString(): UTF8String;
+
+ procedure AssertRefCount; {$IFDEF HasInline}inline;{$ENDIF}
+
+ public
+ constructor Create(const Name: UTF8String; DelimOption: TPathDelimOption);
+ destructor Destroy(); override;
+
+ function ToUTF8(UseNativeDelim: boolean): UTF8String;
+ function ToWide(UseNativeDelim: boolean): WideString;
+ function ToNative(): RawByteString;
+
+ function Open(Mode: longword): TFileHandle;
+
+ function GetDrive(): IPath;
+ function GetPath(): IPath;
+ function GetDir(): IPath;
+ function GetName(): IPath;
+ function GetExtension(): IPath;
+
+ function SetExtension(const Extension: IPath): IPath; overload;
+ function SetExtension(const Extension: RawByteString): IPath; overload;
+ function SetExtension(const Extension: WideString): IPath; overload;
+
+ function GetRelativePath(const BaseName: IPath): IPath;
+ function GetAbsolutePath(): IPath;
+ function GetParent(): IPath;
+ function SplitDirs(): IPathDynArray;
+
+ function Append(const Child: IPath; DelimOption: TPathDelimOption): IPath; overload;
+ function Append(const Child: RawByteString; DelimOption: TPathDelimOption): IPath; overload;
+ function Append(const Child: WideString; DelimOption: TPathDelimOption): IPath; overload;
+
+ function Equals(const Other: IPath; IgnoreCase: boolean): boolean; overload;
+ function Equals(const Other: RawByteString; IgnoreCase: boolean): boolean; overload;
+ function Equals(const Other: WideString; IgnoreCase: boolean): boolean; overload;
+
+ function IsChildOf(const Parent: IPath; Direct: boolean): boolean;
+
+ function AdjustCase(AdjustAllLevels: boolean): IPath;
+
+ function AppendPathDelim(): IPath;
+ function RemovePathDelim(): IPath;
+
+ function GetFileAge(): integer; overload;
+ function GetFileAge(out FileDateTime: TDateTime): boolean; overload;
+ function Exists(): boolean;
+ function IsFile(): boolean;
+ function IsDirectory(): boolean;
+ function IsAbsolute(): boolean;
+ function GetAttr(): cardinal;
+ function SetAttr(Attr: Integer): boolean;
+ function IsReadOnly(): boolean;
+ function SetReadOnly(ReadOnly: boolean): boolean;
+
+ function IsUnset(): boolean;
+ function IsSet(): boolean;
+
+ function FileSearch(const DirList: IPath): IPath;
+
+ function CreateFile(): TFileHandle;
+ function DeleteFile(): boolean;
+ function CreateDirectory(Force: boolean): boolean;
+ function DeleteEmptyDir(): boolean;
+ function Rename(const NewName: IPath): boolean;
+ function CopyFile(const Target: IPath; FailIfExists: boolean): boolean;
+
+ function GetIntern(): UTF8String;
+ end;
+
+function Path(const PathName: RawByteString; DelimOption: TPathDelimOption): IPath;
+begin
+ if (IsUTF8String(PathName)) then
+ Result := TPathImpl.Create(PathName, DelimOption)
+ else if (IsNativeUTF8()) then
+ Result := PATH_NONE
+ else
+ Result := TPathImpl.Create(AnsiToUtf8(PathName), DelimOption);
+end;
+
+function Path(PathName: PChar; DelimOption: TPathDelimOption): IPath;
+begin
+ Result := Path(RawByteString(PathName));
+end;
+
+function Path(const PathName: WideString; DelimOption: TPathDelimOption): IPath;
+begin
+ Result := TPathImpl.Create(UTF8Encode(PathName), DelimOption);
+end;
+
+
+
+procedure TPathImpl.AssertRefCount;
+begin
+ {$IFDEF HAVE_REFCNTBUG}
+ if (FRefCount <= 0) then
+ raise Exception.Create('RefCount error: ' + IntToStr(FRefCount));
+ {$ENDIF}
+end;
+
+constructor TPathImpl.Create(const Name: UTF8String; DelimOption: TPathDelimOption);
+begin
+ inherited Create();
+ fName := Name;
+ Unify(DelimOption);
+ {$IFDEF HAVE_REFCNTBUG}
+ GarbageList.Lock;
+ if (GarbageList.Count >= GarbageMaxCount) then
+ begin
+ while (GarbageList.Count > GarbageAfterCleanCount) do
+ GarbageList.Delete(0);
+ end;
+ GarbageList.Add(Self);
+ GarbageList.Unlock;
+ {$ENDIF}
+end;
+
+destructor TPathImpl.Destroy();
+begin
+ inherited;
+end;
+
+procedure TPathImpl.Unify(DelimOption: TPathDelimOption);
+var
+ I: integer;
+begin
+ // convert all path delimiters to native ones
+ for I := 1 to Length(fName) do
+ begin
+ if (fName[I] in ['\', '/']) and (fName[I] <> PathDelim) then
+ fName[I] := PathDelim;
+ end;
+
+ // Include/ExcludeTrailingPathDelimiter need PathDelim as path delimiter
+ case DelimOption of
+ pdAppend: fName := IncludeTrailingPathDelimiter(fName);
+ pdRemove: fName := ExcludeTrailingPathDelimiter(fName);
+ end;
+end;
+
+function TPathImpl.GetPortableString(): UTF8String;
+var
+ I: integer;
+begin
+ Result := fName;
+ if (PathDelim = '/') then
+ Exit;
+
+ for I := 1 to Length(Result) do
+ begin
+ if (Result[I] = PathDelim) then
+ Result[I] := '/';
+ end;
+end;
+
+function TPathImpl.ToUTF8(UseNativeDelim: boolean): UTF8String;
+begin
+ AssertRefCount;
+
+ if (UseNativeDelim) then
+ Result := fName
+ else
+ Result := GetPortableString();
+end;
+
+function TPathImpl.ToWide(UseNativeDelim: boolean): WideString;
+begin
+ if (UseNativeDelim) then
+ Result := UTF8Decode(fName)
+ else
+ Result := UTF8Decode(GetPortableString());
+end;
+
+function TPathImpl.ToNative(): RawByteString;
+begin
+ if (IsNativeUTF8()) then
+ Result := fName
+ else
+ Result := Utf8ToAnsi(fName);
+end;
+
+function TPathImpl.GetDrive(): IPath;
+begin
+ AssertRefCount;
+ Result := FileSystem.ExtractFileDrive(Self);
+end;
+
+function TPathImpl.GetPath(): IPath;
+begin
+ AssertRefCount;
+ Result := FileSystem.ExtractFilePath(Self);
+end;
+
+function TPathImpl.GetDir(): IPath;
+begin
+ AssertRefCount;
+ Result := FileSystem.ExtractFileDir(Self);
+end;
+
+function TPathImpl.GetName(): IPath;
+begin
+ AssertRefCount;
+ Result := FileSystem.ExtractFileName(Self);
+end;
+
+function TPathImpl.GetExtension(): IPath;
+begin
+ AssertRefCount;
+ Result := FileSystem.ExtractFileExt(Self);
+end;
+
+function TPathImpl.SetExtension(const Extension: IPath): IPath;
+begin
+ AssertRefCount;
+ Result := FileSystem.ChangeFileExt(Self, Extension);
+end;
+
+function TPathImpl.SetExtension(const Extension: RawByteString): IPath;
+begin
+ Result := SetExtension(Path(Extension));
+end;
+
+function TPathImpl.SetExtension(const Extension: WideString): IPath;
+begin
+ Result := SetExtension(Path(Extension));
+end;
+
+function TPathImpl.GetRelativePath(const BaseName: IPath): IPath;
+begin
+ AssertRefCount;
+ Result := FileSystem.ExtractRelativePath(BaseName, Self);
+end;
+
+function TPathImpl.GetAbsolutePath(): IPath;
+begin
+ AssertRefCount;
+ Result := FileSystem.ExpandFileName(Self);
+end;
+
+function TPathImpl.GetParent(): IPath;
+var
+ CurPath, ParentPath: IPath;
+begin
+ AssertRefCount;
+
+ Result := PATH_NONE;
+
+ CurPath := Self.RemovePathDelim();
+ // check if current path has a parent (no further '/')
+ if (Pos(PathDelim, CurPath.ToUTF8()) = 0) then
+ Exit;
+
+ // set new path and check if it has changed to avoid endless loops
+ // e.g. with invalid paths like '/C:' (GetPath() uses ':' as delimiter too)
+ // on delphi/win32
+ ParentPath := CurPath.GetPath();
+ if (ParentPath.ToUTF8 = CurPath.ToUTF8) then
+ Exit;
+
+ Result := ParentPath;
+end;
+
+function TPathImpl.SplitDirs(): IPathDynArray;
+var
+ CurPath: IPath;
+ Components: array of IPath;
+ CurPathStr: UTF8String;
+ DelimPos: integer;
+ I: integer;
+begin
+ SetLength(Result, 0);
+
+ if (Length(Self.ToUTF8(true)) = 0) then
+ Exit;
+
+ CurPath := Self;
+ SetLength(Components, 0);
+ repeat
+ SetLength(Components, Length(Components)+1);
+
+ CurPathStr := CurPath.ToUTF8();
+ DelimPos := LastDelimiter(PathDelim, SysUtils.ExcludeTrailingPathDelimiter(CurPathStr));
+ Components[High(Components)] := Path(Copy(CurPathStr, DelimPos+1, Length(CurPathStr)));
+
+ CurPath := CurPath.GetParent();
+ until (CurPath = PATH_NONE);
+
+ // reverse list
+ SetLength(Result, Length(Components));
+ for I := 0 to High(Components) do
+ Result[I] := Components[High(Components)-I];
+end;
+
+function TPathImpl.Append(const Child: IPath; DelimOption: TPathDelimOption): IPath;
+var
+ TmpResult: IPath;
+begin
+ AssertRefCount;
+
+ if (fName = '') then
+ TmpResult := Child
+ else
+ TmpResult := Path(Self.AppendPathDelim().ToUTF8() + Child.ToUTF8());
+
+ case DelimOption of
+ pdKeep: Result := TmpResult;
+ pdAppend: Result := TmpResult.AppendPathDelim;
+ pdRemove: Result := TmpResult.RemovePathDelim;
+ end;
+end;
+
+function TPathImpl.Append(const Child: RawByteString; DelimOption: TPathDelimOption): IPath;
+begin
+ AssertRefCount;
+ Result := Append(Path(Child), DelimOption);
+end;
+
+function TPathImpl.Append(const Child: WideString; DelimOption: TPathDelimOption): IPath;
+begin
+ AssertRefCount;
+ Result := Append(Path(Child), DelimOption);
+end;
+
+function TPathImpl.Equals(const Other: IPath; IgnoreCase: boolean): boolean;
+var
+ SelfPath, OtherPath: UTF8String;
+begin
+ SelfPath := Self.GetAbsolutePath().RemovePathDelim().ToUTF8();
+ OtherPath := Other.GetAbsolutePath().RemovePathDelim().ToUTF8();
+ if (FileSystem.IsCaseSensitive() and not IgnoreCase) then
+ Result := (CompareStr(SelfPath, OtherPath) = 0)
+ else
+ Result := (CompareText(SelfPath, OtherPath) = 0);
+end;
+
+function TPathImpl.Equals(const Other: RawByteString; IgnoreCase: boolean): boolean;
+begin
+ Result := Equals(Path(Other), IgnoreCase);
+end;
+
+function TPathImpl.Equals(const Other: WideString; IgnoreCase: boolean): boolean;
+begin
+ Result := Equals(Path(Other), IgnoreCase);
+end;
+
+function TPathImpl.IsChildOf(const Parent: IPath; Direct: boolean): boolean;
+var
+ SelfPath, ParentPath: UTF8String;
+begin
+ Result := false;
+
+ if (Direct) then
+ begin
+ SelfPath := Self.GetParent().GetAbsolutePath().AppendPathDelim().ToUTF8();
+ ParentPath := Parent.GetAbsolutePath().AppendPathDelim().ToUTF8();
+
+ // simply check if this paths parent path (SelfPath) equals ParentPath
+ Result := (SelfPath = ParentPath);
+ end
+ else
+ begin
+ SelfPath := Self.GetAbsolutePath().AppendPathDelim().ToUTF8();
+ ParentPath := Parent.GetAbsolutePath().AppendPathDelim().ToUTF8();
+
+ if (Length(SelfPath) <= Length(ParentPath)) then
+ Exit;
+
+ // check if ParentPath is a substring of SelfPath
+ if (FileSystem.IsCaseSensitive()) then
+ Result := (StrLComp(PAnsiChar(SelfPath), PAnsiChar(ParentPath), Length(ParentPath)) = 0)
+ else
+ Result := (StrLIComp(PAnsiChar(SelfPath), PAnsiChar(ParentPath), Length(ParentPath)) = 0)
+ end;
+end;
+
+function AdjustCaseRecursive(CurPath: IPath; AdjustAllLevels: boolean): IPath;
+var
+ OldParent, AdjustedParent: IPath;
+ LocalName: IPath;
+ PathFound: IPath;
+ PathWithAdjParent: IPath;
+ SearchInfo: TFileInfo;
+ FileIter: IFileIterator;
+ Pattern: IPath;
+begin
+ // if case-sensitive path exists there is no need to adjust case
+ if (CurPath.Exists()) then
+ begin
+ Result := CurPath;
+ Exit;
+ end;
+
+ LocalName := CurPath.RemovePathDelim().GetName();
+
+ // try to adjust parent
+ OldParent := CurPath.GetParent();
+ if (OldParent <> PATH_NONE) then
+ begin
+ if (not AdjustAllLevels) then
+ begin
+ AdjustedParent := OldParent;
+ end
+ else
+ begin
+ AdjustedParent := AdjustCaseRecursive(OldParent, AdjustAllLevels);
+ if (AdjustedParent = nil) then
+ begin
+ // parent path was not found case-insensitive
+ Result := nil;
+ Exit;
+ end;
+
+ // check if the path with adjusted parent can be found now
+ PathWithAdjParent := AdjustedParent.Append(LocalName);
+ if (PathWithAdjParent.Exists()) then
+ begin
+ Result := PathWithAdjParent;
+ Exit;
+ end;
+ end;
+ Pattern := AdjustedParent.Append(Path('*'));
+ end
+ else // path has no parent
+ begin
+ // the top path can either be absolute or relative
+ if (CurPath.IsAbsolute) then
+ begin
+ // the only absolute directory at Unix without a parent is root ('/')
+ // and hence does not need to be adjusted
+ Result := CurPath;
+ Exit;
+ end;
+ // this is a relative path, search in the current working dir
+ AdjustedParent := nil;
+ Pattern := Path('*');
+ end;
+
+ // compare name with all files in the current directory case-insensitive
+ FileIter := FileSystem.FileFind(Pattern, faAnyFile);
+ while (FileIter.HasNext()) do
+ begin
+ SearchInfo := FileIter.Next();
+ PathFound := SearchInfo.Name;
+ if (CompareText(LocalName.ToUTF8, PathFound.ToUTF8) = 0) then
+ begin
+ if (AdjustedParent <> nil) then
+ Result := AdjustedParent.Append(PathFound)
+ else
+ Result := PathFound;
+ Exit;
+ end;
+ end;
+
+ // no matching file found
+ Result := nil;
+end;
+
+function TPathImpl.AdjustCase(AdjustAllLevels: boolean): IPath;
+begin
+ AssertRefCount;
+
+ Result := Self;
+
+ if (FileSystem.IsCaseSensitive) then
+ begin
+ Result := AdjustCaseRecursive(Self, AdjustAllLevels);
+ if (Result = nil) then
+ Result := Self;
+ end;
+end;
+
+function TPathImpl.AppendPathDelim(): IPath;
+begin
+ AssertRefCount;
+ Result := FileSystem.IncludeTrailingPathDelimiter(Self);
+end;
+
+function TPathImpl.RemovePathDelim(): IPath;
+begin
+ AssertRefCount;
+ Result := FileSystem.ExcludeTrailingPathDelimiter(Self);
+end;
+
+function TPathImpl.CreateFile(): TFileHandle;
+begin
+ Result := FileSystem.FileCreate(Self);
+end;
+
+function TPathImpl.CreateDirectory(Force: boolean): boolean;
+begin
+ if (Force) then
+ Result := FileSystem.ForceDirectories(Self)
+ else
+ Result := FileSystem.DirectoryCreate(Self);
+end;
+
+function TPathImpl.Open(Mode: longword): TFileHandle;
+begin
+ Result := FileSystem.FileOpen(Self, Mode);
+end;
+
+function TPathImpl.GetFileAge(): integer;
+begin
+ Result := FileSystem.FileAge(Self);
+end;
+
+function TPathImpl.GetFileAge(out FileDateTime: TDateTime): boolean;
+begin
+ Result := FileSystem.FileAge(Self, FileDateTime);
+end;
+
+function TPathImpl.Exists(): boolean;
+begin
+ // note the different specifications of FileExists() on Win32 <> Unix
+ {$IFDEF MSWINDOWS}
+ Result := IsFile() or IsDirectory();
+ {$ELSE}
+ Result := FileSystem.FileExists(Self);
+ {$ENDIF}
+end;
+
+function TPathImpl.IsFile(): boolean;
+begin
+ // note the different specifications of FileExists() on Win32 <> Unix
+ {$IFDEF MSWINDOWS}
+ Result := FileSystem.FileExists(Self);
+ {$ELSE}
+ Result := Exists() and not IsDirectory();
+ {$ENDIF}
+end;
+
+function TPathImpl.IsDirectory(): boolean;
+begin
+ Result := FileSystem.DirectoryExists(Self);
+end;
+
+function TPathImpl.IsAbsolute(): boolean;
+begin
+ AssertRefCount;
+ Result := FileSystem.FileIsReadOnly(Self);
+end;
+
+function TPathImpl.GetAttr(): cardinal;
+begin
+ Result := FileSystem.FileGetAttr(Self);
+end;
+
+function TPathImpl.SetAttr(Attr: Integer): boolean;
+begin
+ Result := FileSystem.FileSetAttr(Self, Attr);
+end;
+
+function TPathImpl.IsReadOnly(): boolean;
+begin
+ Result := FileSystem.FileIsReadOnly(Self);
+end;
+
+function TPathImpl.SetReadOnly(ReadOnly: boolean): boolean;
+begin
+ Result := FileSystem.FileSetReadOnly(Self, ReadOnly);
+end;
+
+function TPathImpl.IsUnset(): boolean;
+begin
+ Result := (fName = '');
+end;
+
+function TPathImpl.IsSet(): boolean;
+begin
+ Result := (fName <> '');
+end;
+
+function TPathImpl.FileSearch(const DirList: IPath): IPath;
+begin
+ AssertRefCount;
+ Result := FileSystem.FileSearch(Self, DirList);
+end;
+
+function TPathImpl.Rename(const NewName: IPath): boolean;
+begin
+ Result := FileSystem.RenameFile(Self, NewName);
+end;
+
+function TPathImpl.DeleteFile(): boolean;
+begin
+ Result := FileSystem.DeleteFile(Self);
+end;
+
+function TPathImpl.DeleteEmptyDir(): boolean;
+begin
+ Result := FileSystem.RemoveDir(Self);
+end;
+
+function TPathImpl.CopyFile(const Target: IPath; FailIfExists: boolean): boolean;
+begin
+ Result := FileSystem.CopyFile(Self, Target, FailIfExists);
+end;
+
+function TPathImpl.GetIntern(): UTF8String;
+begin
+ Result := fName;
+end;
+
+
+{ TBinaryFileStream }
+
+constructor TBinaryFileStream.Create(const FileName: IPath; Mode: word);
+begin
+{$IFDEF MSWINDOWS}
+ inherited Create(FileName.ToWide(), Mode);
+{$ELSE}
+ inherited Create(FileName.ToNative(), Mode);
+{$ENDIF}
+end;
+
+{ TTextStream }
+
+constructor TTextFileStream.Create(Filename: IPath; Mode: word);
+begin
+ inherited Create();
+ fMode := Mode;
+ fFilename := Filename;
+ fLineBreak := sLineBreak;
+end;
+
+function TTextFileStream.ReadLine(var Line: UTF8String): boolean;
+begin
+ Line := ReadLine(Result);
+end;
+
+function TTextFileStream.ReadLine(var Line: AnsiString): boolean;
+begin
+ Line := ReadLine(Result);
+end;
+
+procedure TTextFileStream.WriteString(const Str: RawByteString);
+begin
+ WriteBuffer(Str[1], Length(Str));
+end;
+
+procedure TTextFileStream.WriteLine(const Line: RawByteString);
+begin
+ WriteBuffer(Line[1], Length(Line));
+ WriteBuffer(fLineBreak[1], Length(fLineBreak));
+end;
+
+{ TMemTextStream }
+
+constructor TMemTextFileStream.Create(Filename: IPath; Mode: word);
+var
+ FileStream: TBinaryFileStream;
+begin
+ inherited Create(Filename, Mode);
+
+ fStream := TMemoryStream.Create();
+
+ // load data to memory in read mode
+ if ((Mode and 3) in [fmOpenRead, fmOpenReadWrite]) then
+ begin
+ FileStream := TBinaryFileStream.Create(Filename, fmOpenRead);
+ try
+ fStream.LoadFromStream(FileStream);
+ finally
+ FileStream.Free;
+ end;
+ end
+ // check if file exists for write-mode
+ else if ((Mode and 3) = fmOpenWrite) and (not Filename.IsFile) then
+ begin
+ raise EFOpenError.CreateResFmt(@SFOpenError,
+ [FileName.GetAbsolutePath.ToNative]);
+ end;
+end;
+
+destructor TMemTextFileStream.Destroy();
+var
+ FileStream: TBinaryFileStream;
+ SaveMode: word;
+begin
+ // save changes in write mode (= not read-only mode)
+ if ((fMode and 3) <> fmOpenRead) then
+ begin
+ if (fMode = fmCreate) then
+ SaveMode := fmCreate
+ else
+ SaveMode := fmOpenWrite;
+ FileStream := TBinaryFileStream.Create(fFilename, SaveMode);
+ try
+ fStream.SaveToStream(FileStream);
+ finally
+ FileStream.Free;
+ end;
+ end;
+
+ fStream.Free;
+ inherited;
+end;
+
+function TMemTextFileStream.GetSize: int64;
+begin
+ Result := fStream.Size;
+end;
+
+function TMemTextFileStream.Read(var Buffer; Count: longint): longint;
+begin
+ Result := fStream.Read(Buffer, Count);
+end;
+
+function TMemTextFileStream.Write(const Buffer; Count: longint): longint;
+begin
+ Result := fStream.Write(Buffer, Count);
+end;
+
+function TMemTextFileStream.Seek(Offset: longint; Origin: word): longint;
+begin
+ Result := fStream.Seek(Offset, Origin);
+end;
+
+function TMemTextFileStream.Seek(const Offset: int64; Origin: TSeekOrigin): int64;
+begin
+ Result := fStream.Seek(Offset, Origin);
+end;
+
+function TMemTextFileStream.CopyMemString(StartPos: int64; EndPos: int64): RawByteString;
+var
+ LineLength: cardinal;
+ Temp: RawByteString;
+begin
+ LineLength := EndPos - StartPos;
+ if (LineLength > 0) then
+ begin
+ // set string length to line-length (+ zero-terminator)
+ SetLength(Temp, LineLength);
+ StrLCopy(PAnsiChar(Temp),
+ @PAnsiChar(fStream.Memory)[StartPos],
+ LineLength);
+ Result := Temp;
+ end
+ else
+ begin
+ Result := '';
+ end;
+end;
+
+function TMemTextFileStream.ReadString(): RawByteString;
+var
+ TextPtr: PAnsiChar;
+ CurPos, StartPos, FileSize: int64;
+begin
+ TextPtr := PAnsiChar(fStream.Memory);
+ CurPos := Position;
+ FileSize := Size;
+ StartPos := -1;
+
+ while (CurPos < FileSize) do
+ begin
+ // check for whitespace (tab, lf, cr, space)
+ if (TextPtr[CurPos] in [#9, #10, #13, ' ']) then
+ begin
+ // check if we are at the end of a string
+ if (StartPos > -1) then
+ Break;
+ end
+ else if (StartPos = -1) then // start of string found
+ begin
+ StartPos := CurPos;
+ end;
+ Inc(CurPos);
+ end;
+
+ if (StartPos = -1) then
+ Result := ''
+ else
+ begin
+ Result := CopyMemString(StartPos, CurPos);
+ fStream.Position := CurPos;
+ end;
+end;
+
+{*
+ * Implementation of ReadLine(). We need separate versions for UTF8String
+ * and AnsiString as "var" parameter types have to fit exactly.
+ * To avoid a var-parameter here, the internal version the Line parameter is
+ * used as return value.
+ *}
+function TMemTextFileStream.ReadLine(var Success: boolean): RawByteString;
+var
+ TextPtr: PAnsiChar;
+ CurPos, FileSize: int64;
+begin
+ TextPtr := PAnsiChar(fStream.Memory);
+ CurPos := fStream.Position;
+ FileSize := Size;
+
+ // check for EOF
+ if (CurPos >= FileSize) then
+ begin
+ Result := '';
+ Success := false;
+ Exit;
+ end;
+
+ Success := true;
+
+ while (CurPos < FileSize) do
+ begin
+ if (TextPtr[CurPos] in [#10, #13]) then
+ begin
+ // copy text line
+ Result := CopyMemString(fStream.Position, CurPos);
+
+ // handle windows style #13#10 (\r\n) newlines
+ if (TextPtr[CurPos] = #13) and
+ (CurPos+1 < FileSize) and
+ (TextPtr[CurPos+1] = #10) then
+ begin
+ Inc(CurPos);
+ end;
+
+ // update stream pos
+ fStream.Position := CurPos+1;
+
+ Exit;
+ end;
+ Inc(CurPos);
+ end;
+
+ Result := CopyMemString(fStream.Position, CurPos);
+ fStream.Position := FileSize;
+end;
+
+{ TUnicodeMemoryStream }
+
+procedure TUnicodeMemoryStream.LoadFromFile(const FileName: IPath);
+var
+ Stream: TStream;
+begin
+ Stream := TBinaryFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
+ try
+ LoadFromStream(Stream);
+ finally
+ Stream.Free;
+ end;
+end;
+
+procedure TUnicodeMemoryStream.SaveToFile(const FileName: IPath);
+var
+ Stream: TStream;
+begin
+ Stream := TBinaryFileStream.Create(FileName, fmCreate);
+ try
+ SaveToStream(Stream);
+ finally
+ Stream.Free;
+ end;
+end;
+
+{ TUnicodeMemIniFile }
+
+constructor TUnicodeMemIniFile.Create(const FileName: IPath; UTF8Encoded: boolean);
+var
+ List: TStringList;
+ Stream: TBinaryFileStream;
+ BOMBuf: array[0..2] of AnsiChar;
+begin
+ inherited Create('');
+ FFilename := FileName;
+ FUTF8Encoded := UTF8Encoded;
+
+ if FileName.Exists() then
+ begin
+ List := nil;
+ Stream := nil;
+ try
+ List := TStringList.Create;
+ Stream := TBinaryFileStream.Create(FileName, fmOpenRead);
+ if (Stream.Read(BOMBuf[0], SizeOf(BOMBuf)) = 3) and
+ (CompareMem(PChar(UTF8_BOM), @BomBuf, Length(UTF8_BOM))) then
+ begin
+ // truncate BOM
+ FUTF8Encoded := true;
+ end
+ else
+ begin
+ // rewind file
+ Stream.Seek(0, soBeginning);
+ end;
+ List.LoadFromStream(Stream);
+ SetStrings(List);
+ finally
+ Stream.Free;
+ List.Free;
+ end;
+ end;
+end;
+
+procedure TUnicodeMemIniFile.UpdateFile;
+var
+ List: TStringList;
+ Stream: TBinaryFileStream;
+begin
+ List := nil;
+ Stream := nil;
+ try
+ List := TStringList.Create;
+ GetStrings(List);
+ Stream := TBinaryFileStream.Create(FFileName, fmCreate);
+ if UTF8Encoded then
+ Stream.Write(UTF8_BOM, Length(UTF8_BOM));
+ List.SaveToStream(Stream);
+ finally
+ List.Free;
+ Stream.Free;
+ end;
+end;
+
+
+var
+ PATH_NONE_Singelton: IPath;
+
+function PATH_NONE(): IPath;
+begin
+ Result := PATH_NONE_Singelton;
+end;
+
+initialization
+ {$IFDEF HAVE_REFCNTBUG}
+ GarbageList := TInterfaceList.Create();
+ GarbageList.Capacity := GarbageMaxCount;
+ {$ENDIF}
+ PATH_NONE_Singelton := Path('');
+
+finalization
+ PATH_NONE_Singelton := nil;
+
+end.
diff --git a/cmake/src/base/UPathUtils.pas b/cmake/src/base/UPathUtils.pas
new file mode 100644
index 00000000..c2bcdd4b
--- /dev/null
+++ b/cmake/src/base/UPathUtils.pas
@@ -0,0 +1,196 @@
+{* UltraStar Deluxe - Karaoke Game
+ *
+ * UltraStar Deluxe is the legal property of its developers, whose names
+ * are too numerous to list here. Please refer to the COPYRIGHT
+ * file distributed with this source distribution.
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; see the file COPYING. If not, write to
+ * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+ * Boston, MA 02110-1301, USA.
+ *
+ * $URL$
+ * $Id$
+ *}
+
+unit UPathUtils;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+uses
+ SysUtils,
+ Classes,
+ UPath;
+
+var
+ // Absolute Paths
+ GamePath: IPath;
+ SoundPath: IPath;
+ SongPaths: IInterfaceList;
+ LogPath: IPath;
+ ThemePath: IPath;
+ SkinsPath: IPath;
+ ScreenshotsPath: IPath;
+ CoverPaths: IInterfaceList;
+ LanguagesPath: IPath;
+ PluginPath: IPath;
+ VisualsPath: IPath;
+ FontPath: IPath;
+ ResourcesPath: IPath;
+ PlaylistPath: IPath;
+
+function FindPath(out PathResult: IPath; const RequestedPath: IPath; NeedsWritePermission: boolean): boolean;
+procedure InitializePaths;
+procedure AddSongPath(const Path: IPath);
+
+implementation
+
+uses
+ StrUtils,
+ UPlatform,
+ UCommandLine,
+ ULog;
+
+procedure AddSpecialPath(var PathList: IInterfaceList; const Path: IPath);
+var
+ Index: integer;
+ PathAbs, PathTmp: IPath;
+ OldPath, OldPathAbs, OldPathTmp: IPath;
+begin
+ if (PathList = nil) then
+ PathList := TInterfaceList.Create;
+
+ if Path.Equals(PATH_NONE) or not Path.CreateDirectory(true) then
+ Exit;
+
+ PathTmp := Path.GetAbsolutePath();
+ PathAbs := PathTmp.AppendPathDelim();
+
+ // check if path or a part of the path was already added
+ for Index := 0 to PathList.Count-1 do
+ begin
+ OldPath := PathList[Index] as IPath;
+ OldPathTmp := OldPath.GetAbsolutePath();
+ OldPathAbs := OldPathTmp.AppendPathDelim();
+
+ // 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 (OldPathAbs.IsChildOf(PathAbs, false) or OldPathAbs.Equals(PathAbs)) then
+ begin
+ // ignore the new path
+ Exit;
+ end;
+
+ // check if a previously added directory is a sub-directory of the new one.
+ if (PathAbs.IsChildOf(OldPathAbs, false)) then
+ begin
+ // replace the old with the new one.
+ PathList[Index] := PathAbs;
+ Exit;
+ end;
+ end;
+
+ PathList.Add(PathAbs);
+end;
+
+procedure AddSongPath(const Path: IPath);
+begin
+ AddSpecialPath(SongPaths, Path);
+end;
+
+procedure AddCoverPath(const Path: IPath);
+begin
+ AddSpecialPath(CoverPaths, Path);
+end;
+
+(**
+ * Initialize a path variable
+ * After setting paths, make sure that paths exist
+ *)
+function FindPath(
+ out PathResult: IPath;
+ const RequestedPath: IPath;
+ NeedsWritePermission: boolean): boolean;
+begin
+ Result := false;
+
+ if (RequestedPath.Equals(PATH_NONE)) then
+ Exit;
+
+ // Make sure the directory exists
+ if (not RequestedPath.CreateDirectory(true)) then
+ begin
+ PathResult := PATH_NONE;
+ Exit;
+ end;
+
+ PathResult := RequestedPath.AppendPathDelim();
+
+ if (NeedsWritePermission) and RequestedPath.IsReadOnly() then
+ Exit;
+
+ Result := true;
+end;
+
+(**
+ * Function sets all absolute paths e.g. song path and makes sure the directorys exist
+ *)
+procedure InitializePaths;
+var
+ SharedPath, UserPath: IPath;
+begin
+ // Log directory (must be writable)
+ if (not FindPath(LogPath, Platform.GetLogPath, true)) then
+ begin
+ Log.FileOutputEnabled := false;
+ Log.LogWarn('Log directory "'+ Platform.GetLogPath.ToNative +'" not available', 'InitializePaths');
+ end;
+
+ SharedPath := Platform.GetGameSharedPath;
+ UserPath := Platform.GetGameUserPath;
+
+ FindPath(SoundPath, SharedPath.Append('sounds'), false);
+ FindPath(ThemePath, SharedPath.Append('themes'), false);
+ FindPath(SkinsPath, SharedPath.Append('themes'), false);
+ FindPath(LanguagesPath, SharedPath.Append('languages'), false);
+ FindPath(PluginPath, SharedPath.Append('plugins'), false);
+ FindPath(VisualsPath, SharedPath.Append('visuals'), false);
+ FindPath(FontPath, SharedPath.Append('fonts'), false);
+ FindPath(ResourcesPath, SharedPath.Append('resources'), false);
+
+ // Playlists are not shared as we need one directory to write too
+ FindPath(PlaylistPath, UserPath.Append('playlists'), true);
+
+ // Screenshot directory (must be writable)
+ if (not FindPath(ScreenshotsPath, UserPath.Append('screenshots'), true)) then
+ begin
+ Log.LogWarn('Screenshot directory "'+ UserPath.ToNative +'" not available', 'InitializePaths');
+ end;
+
+ // Add song paths
+ AddSongPath(Params.SongPath);
+ AddSongPath(SharedPath.Append('songs'));
+ AddSongPath(UserPath.Append('songs'));
+
+ // Add category cover paths
+ AddCoverPath(SharedPath.Append('covers'));
+ AddCoverPath(UserPath.Append('covers'));
+end;
+
+end.
diff --git a/cmake/src/base/UPlatform.pas b/cmake/src/base/UPlatform.pas
index 6f13481c..11c67fa7 100644
--- a/cmake/src/base/UPlatform.pas
+++ b/cmake/src/base/UPlatform.pas
@@ -39,28 +39,20 @@ interface
{$I switches.inc}
uses
- Classes;
+ Classes,
+ UPath;
type
- TDirectoryEntry = record
- Name: WideString;
- IsDirectory: boolean;
- IsFile: boolean;
- end;
-
- TDirectoryEntryArray = array of TDirectoryEntry;
-
TPlatform = class
- function GetExecutionDir(): string;
+ function GetExecutionDir(): IPath;
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;
+
+ function GetLogPath: IPath; virtual; abstract;
+ function GetGameSharedPath: IPath; virtual; abstract;
+ function GetGameUserPath: IPath; virtual; abstract;
end;
function Platform(): TPlatform;
@@ -76,7 +68,9 @@ uses
{$ELSEIF Defined(UNIX)}
UPlatformLinux,
{$IFEND}
- ULog;
+ ULog,
+ UUnicodeUtils,
+ UFilesystem;
// I modified it to use the Platform_singleton in this location (in the implementation)
@@ -109,9 +103,13 @@ end;
{**
* Returns the directory of the executable
*}
-function TPlatform.GetExecutionDir(): string;
+function TPlatform.GetExecutionDir(): IPath;
+var
+ ExecName, ExecDir: IPath;
begin
- Result := ExpandFileName(ExtractFilePath(ParamStr(0)));
+ ExecName := Path(ParamStr(0));
+ ExecDir := ExecName.GetPath;
+ Result := ExecDir.GetAbsolutePath();
end;
(**
@@ -122,65 +120,6 @@ 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
{$IF Defined(MSWINDOWS)}
Platform_singleton := TPlatformWindows.Create;
diff --git a/cmake/src/base/UPlatformLinux.pas b/cmake/src/base/UPlatformLinux.pas
index 30499a97..693facaa 100644
--- a/cmake/src/base/UPlatformLinux.pas
+++ b/cmake/src/base/UPlatformLinux.pas
@@ -36,7 +36,8 @@ interface
uses
Classes,
UPlatform,
- UConfig;
+ UConfig,
+ UPath;
type
TPlatformLinux = class(TPlatform)
@@ -44,15 +45,13 @@ type
UseLocalDirs: boolean;
procedure DetectLocalExecution();
- function GetHomeDir(): string;
+ function GetHomeDir(): IPath;
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;
+
+ function GetLogPath : IPath; override;
+ function GetGameSharedPath : IPath; override;
+ function GetGameUserPath : IPath; override;
end;
implementation
@@ -60,9 +59,7 @@ implementation
uses
UCommandLine,
BaseUnix,
- {$IF FPC_VERSION_INT >= 2002002}
pwd,
- {$IFEND}
SysUtils,
ULog;
@@ -88,114 +85,65 @@ end;
*}
procedure TPlatformLinux.DetectLocalExecution();
var
- LocalDir: string;
+ LocalDir, LanguageDir: IPath;
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;
+ LocalDir := GetExecutionDir();
+ LanguageDir := LocalDir.Append('languages');
+ UseLocalDirs := LanguageDir.IsDirectory;
end;
-function TPlatformLinux.GetLogPath: WideString;
+function TPlatformLinux.GetLogPath: IPath;
begin
if UseLocalDirs then
Result := GetExecutionDir()
else
- Result := GetGameUserPath() + 'logs/';
+ Result := GetGameUserPath().Append('logs', pdAppend);
// create non-existing directories
- ForceDirectories(Result);
+ Result.CreateDirectory(true);
end;
-function TPlatformLinux.GetGameSharedPath: WideString;
+function TPlatformLinux.GetGameSharedPath: IPath;
begin
if UseLocalDirs then
Result := GetExecutionDir()
else
- Result := IncludeTrailingPathDelimiter(INSTALL_DATADIR);
+ Result := Path(INSTALL_DATADIR, pdAppend);
end;
-function TPlatformLinux.GetGameUserPath: WideString;
+function TPlatformLinux.GetGameUserPath: IPath;
begin
if UseLocalDirs then
Result := GetExecutionDir()
else
- Result := GetHomeDir() + '.ultrastardx/';
+ Result := GetHomeDir().Append('.ultrastardx', pdAppend);
end;
{**
* Returns the user's home directory terminated by a path delimiter
*}
-function TPlatformLinux.GetHomeDir(): string;
-{$IF FPC_VERSION_INT >= 2002002}
+function TPlatformLinux.GetHomeDir(): IPath;
var
PasswdEntry: PPasswd;
-{$IFEND}
begin
- Result := '';
+ Result := PATH_NONE;
- {$IF FPC_VERSION_INT >= 2002002}
// try to retrieve the info from passwd
PasswdEntry := FpGetpwuid(FpGetuid());
if (PasswdEntry <> nil) then
- Result := PasswdEntry.pw_dir;
- {$IFEND}
+ Result := Path(PasswdEntry.pw_dir);
// fallback if passwd does not contain the path
- if (Result = '') then
- Result := GetEnvironmentVariable('HOME');
+ if (Result.IsUnset) then
+ Result := Path(GetEnvironmentVariable('HOME'));
// add trailing path delimiter (normally '/')
- if (Result <> '') then
- Result := IncludeTrailingPathDelimiter(Result);
+ if (Result.IsSet) then
+ Result := Result.AppendPathDelim();
- {$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/cmake/src/base/UPlatformMacOSX.pas b/cmake/src/base/UPlatformMacOSX.pas
index 96e4bc63..d55e8bea 100644
--- a/cmake/src/base/UPlatformMacOSX.pas
+++ b/cmake/src/base/UPlatformMacOSX.pas
@@ -36,7 +36,9 @@ interface
uses
Classes,
ULog,
- UPlatform;
+ UPlatform,
+ UFilesystem,
+ UPath;
type
{**
@@ -93,19 +95,21 @@ type
* GetBundlePath returns the path to the application bundle
* UltraStarDeluxe.app.
*}
- function GetBundlePath: WideString;
+ function GetBundlePath: IPath;
{**
* GetApplicationSupportPath returns the path to
* $HOME/Library/Application Support/UltraStarDeluxe.
*}
- function GetApplicationSupportPath: WideString;
+ function GetApplicationSupportPath: IPath;
{**
* see the description of @link(Init).
*}
procedure CreateUserFolders();
+ function GetHomeDir(): IPath;
+
public
{**
* Init simply calls @link(CreateUserFolders), which in turn scans the
@@ -115,38 +119,31 @@ type
*}
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/Log.
+ * $HOME/Library/Application Support/UltraStarDeluxe/log.
*}
- function GetLogPath : WideString; override;
+ function GetLogPath: IPath; override;
{**
* GetGameSharedPath returns the path for shared resources. Currently it
* is set to /Library/Application Support/UltraStarDeluxe.
* However it is not used.
*}
- function GetGameSharedPath : WideString; override;
+ function GetGameSharedPath: IPath; override;
{**
* GetGameUserPath returns the path for user resources. Currently it is
* set to $HOME/Library/Application Support/UltraStarDeluxe.
* This is where a user can add songs, themes, ....
*}
- function GetGameUserPath : WideString; override;
+ function GetGameUserPath: IPath; override;
end;
implementation
uses
- SysUtils,
- BaseUnix;
+ SysUtils;
procedure TPlatformMacOSX.Init;
begin
@@ -154,178 +151,131 @@ begin
end;
procedure TPlatformMacOSX.CreateUserFolders();
-const
- // used to construct the @link(UserPathName)
- PathName: string = '/Library/Application Support/UltraStarDeluxe';
var
- RelativePath: string;
+ RelativePath: IPath;
// 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;
+ BaseDir: IPath;
// 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;
+ OldBaseDir: IPath;
+ Iter: IFileIterator;
+ FileInfo: TFileInfo;
+ CurPath: IPath;
// These two lists contain all folder and file names found
// within the folder @link(BaseDir).
- DirectoryList, FileList: TStringList;
+ DirectoryList, FileList: IInterfaceList;
// 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;
+ I: longint;
// These three are for creating directories, due to possible symlinks
CreatedDirectory: boolean;
FileAttrs: integer;
- DirectoryPath: string;
-
- UserPathName: string;
+ DirectoryPath: IPath;
+ UserPath: IPath;
+ SrcFile, TgtFile: IPath;
begin
// Get the current folder and save it in OldBaseDir for returning to it, when
// finished.
- GetDir(0, OldBaseDir);
+ OldBaseDir := FileSystem.GetCurrentDir();
- // UltraStarDeluxe.app/Contents contains all the default files and
- // folders.
- BaseDir := OldBaseDir + '/UltraStarDeluxe.app/Contents';
- ChDir(BaseDir);
+ // UltraStarDeluxe.app/Contents contains all the default files and folders.
+ BaseDir := OldBaseDir.Append('UltraStarDeluxe.app/Contents');
+ FileSystem.SetCurrentDir(BaseDir);
- // Right now, only $HOME/Library/Application Support/UltraStarDeluxe
- // is used.
- UserPathName := GetEnvironmentVariable('HOME') + PathName;
+ // Right now, only $HOME/Library/Application Support/UltraStarDeluxe is used.
+ UserPath := GetGameUserPath();
DirectoryIsFinished := 0;
- DirectoryList := TStringList.Create();
- FileList := TStringList.Create();
- DirectoryList.Add('.');
+ // replace with IInterfaceList
+ DirectoryList := TInterfaceList.Create();
+ FileList := TInterfaceList.Create();
+ DirectoryList.Add(Path('.'));
// create the folder and file lists
repeat
-
- RelativePath := DirectoryList[DirectoryIsFinished];
- ChDir(BaseDir + '/' + RelativePath);
- if (FindFirst('*', faAnyFile, SearchInfo) = 0) then
+ RelativePath := (DirectoryList[DirectoryIsFinished] as IPath);
+ FileSystem.SetCurrentDir(BaseDir.Append(RelativePath));
+ Iter := FileSystem.FileFind(Path('*'), faAnyFile);
+ while (Iter.HasNext) do
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);
+ FileInfo := Iter.Next;
+ CurPath := FileInfo.Name;
+ if CurPath.IsDirectory() then
+ begin
+ if (not CurPath.Equals('.')) and
+ (not CurPath.Equals('..')) and
+ (not CurPath.Equals('MacOS')) then
+ DirectoryList.Add(RelativePath.Append(CurPath));
+ end
+ else
+ Filelist.Add(RelativePath.Append(CurPath));
end;
- FindClose(SearchInfo);
Inc(DirectoryIsFinished);
until (DirectoryIsFinished = DirectoryList.Count);
// create missing folders
- ForceDirectories(UserPathName); // should not be necessary since (UserPathName+'/.') is created.
- for Counter := 0 to DirectoryList.Count-1 do
+ UserPath.CreateDirectory(true); // should not be necessary since (UserPathName+'/.') is created.
+ for I := 0 to DirectoryList.Count-1 do
begin
- DirectoryPath := UserPathName + '/' + DirectoryList[Counter];
- CreatedDirectory := ForceDirectories(DirectoryPath);
- FileAttrs := FileGetAttr(DirectoryPath);
- // Don't know how to analyse the target of the link.
+ CurPath := DirectoryList[I] as IPath;
+ DirectoryPath := UserPath.Append(CurPath);
+ CreatedDirectory := DirectoryPath.CreateDirectory();
+ FileAttrs := DirectoryPath.GetAttr();
+ // Maybe analyse the target of the link with FpReadlink().
// Let's assume the symlink is pointing to an existing directory.
if (not CreatedDirectory) and (FileAttrs and faSymLink > 0) then
- Log.LogError('Failed to create the folder "'+ UserPathName + '/' + DirectoryList[Counter] +'"',
+ Log.LogError('Failed to create the folder "'+ DirectoryPath.ToNative +'"',
'TPlatformMacOSX.CreateUserFolders');
end;
- DirectoryList.Free();
// copy missing files
- for Counter := 0 to Filelist.Count-1 do
+ for I := 0 to Filelist.Count-1 do
begin
- CopyFile(BaseDir + '/' + Filelist[Counter],
- UserPathName + '/' + Filelist[Counter], true);
+ CurPath := Filelist[I] as IPath;
+ SrcFile := BaseDir.Append(CurPath);
+ TgtFile := UserPath.Append(CurPath);
+ SrcFile.CopyFile(TgtFile, true);
end;
- FileList.Free();
// go back to the initial folder
- ChDir(OldBaseDir);
+ FileSystem.SetCurrentDir(OldBaseDir);
end;
-function TPlatformMacOSX.GetBundlePath: WideString;
-var
- i, pos : integer;
+function TPlatformMacOSX.GetBundlePath: IPath;
begin
// Mac applications are packaged in folders.
// Cutting the last two folders yields 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;
+ Result := GetExecutionDir().GetParent().GetParent();
end;
-function TPlatformMacOSX.GetApplicationSupportPath: WideString;
+function TPlatformMacOSX.GetApplicationSupportPath: IPath;
const
- PathName : string = '/Library/Application Support/UltraStarDeluxe';
+ PathName: string = 'Library/Application Support/UltraStarDeluxe';
begin
- Result := GetEnvironmentVariable('HOME') + PathName + '/';
+ Result := GetHomeDir().Append(PathName, pdAppend);
end;
-function TPlatformMacOSX.GetLogPath: WideString;
+function TPlatformMacOSX.GetHomeDir(): IPath;
begin
- Result := GetApplicationSupportPath + 'Logs';
+ Result := Path(GetEnvironmentVariable('HOME'));
end;
-function TPlatformMacOSX.GetGameSharedPath: WideString;
+function TPlatformMacOSX.GetLogPath: IPath;
begin
- Result := GetApplicationSupportPath;
+ Result := GetApplicationSupportPath.Append('logs');
end;
-function TPlatformMacOSX.GetGameUserPath: WideString;
+function TPlatformMacOSX.GetGameSharedPath: IPath;
begin
Result := GetApplicationSupportPath;
end;
-function TPlatformMacOSX.DirectoryFindFiles(Dir, Filter: WideString; ReturnAllSubDirs: boolean): TDirectoryEntryArray;
-var
- i : integer;
- TheDir : pdir;
- ADirent : pDirent;
- lAttrib : integer;
+function TPlatformMacOSX.GetGameUserPath: IPath;
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);
+ Result := GetApplicationSupportPath;
end;
end.
diff --git a/cmake/src/base/UPlatformWindows.pas b/cmake/src/base/UPlatformWindows.pas
index e198958a..91d3cce6 100644
--- a/cmake/src/base/UPlatformWindows.pas
+++ b/cmake/src/base/UPlatformWindows.pas
@@ -38,21 +38,23 @@ interface
uses
Classes,
- UPlatform;
+ UPlatform,
+ UPath;
type
TPlatformWindows = class(TPlatform)
private
- function GetSpecialPath(CSIDL: integer): WideString;
+ UseLocalDirs: boolean;
+
+ function GetSpecialPath(CSIDL: integer): IPath;
+ procedure DetectLocalExecution();
public
- function DirectoryFindFiles(Dir, Filter: WideString; ReturnAllSubDirs: Boolean): TDirectoryEntryArray; override;
+ procedure Init; 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;
+ function GetLogPath: IPath; override;
+ function GetGameSharedPath: IPath; override;
+ function GetGameUserPath: IPath; override;
end;
implementation
@@ -63,93 +65,10 @@ uses
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;
+procedure TPlatformWindows.Init;
begin
- Code := GetFileAttributesW(PWideChar(Directory));
- Result := (Code <> -1) and (FILE_ATTRIBUTE_DIRECTORY and Code <> 0);
+ inherited Init();
+ DetectLocalExecution();
end;
//------------------------------
@@ -180,41 +99,6 @@ begin
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.
*
@@ -225,37 +109,101 @@ end;
* 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;
+function TPlatformWindows.GetSpecialPath(CSIDL: integer): IPath;
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
+ Result := Path(Buffer)
else
-{$IFEND}
- Result := '';
+ Result := PATH_NONE;
end;
-function TPlatformWindows.GetLogPath: WideString;
+{**
+ * Detects whether the was executed locally or globally.
+ * - Local mode:
+ * - Condition:
+ * - config.ini is writable or creatable in the directory of the executable.
+ * - Examples:
+ * - The USDX zip-archive has been unpacked to a directory with write.
+ * permissions
+ * - XP: USDX was installed to %ProgramFiles% and the user is an admin.
+ * - USDX is started from an external HD- or flash-drive
+ * - Behavior:
+ * Config files like config.ini or score db reside in the directory of the
+ * executable. This is useful to enable windows users to have a portable
+ * installation e.g. on an external hdd.
+ * This is also the default behaviour of usdx prior to version 1.1
+ * - Global mode:
+ * - Condition:
+ * - config.ini is not writable.
+ * - Examples:
+ * - Vista/7: USDX was installed to %ProgramFiles%.
+ * - XP: USDX was installed to %ProgramFiles% and the user is not an admin.
+ * - USDX is started from CD
+ * - Behavior:
+ * - The config files are in a separate folder (e.g. %APPDATA%\ultrastardx)
+ *
+ * On windows, resources (themes, language-files)
+ * reside in the directory of the executable in any case
+ *
+ * Sets UseLocalDirs to true if the game is executed locally, false otherwise.
+ *}
+procedure TPlatformWindows.DetectLocalExecution();
+var
+ LocalDir, ConfigIni: IPath;
+ Handle: TFileHandle;
begin
- Result := GetExecutionDir();
+ LocalDir := GetExecutionDir();
+ ConfigIni := LocalDir.Append('config.ini');
+
+ // check if config.ini is writable or creatable, if so use local dirs
+ UseLocalDirs := false;
+ if (ConfigIni.Exists()) then
+ begin
+ // do not use a read-only config file
+ if (not ConfigIni.IsReadOnly()) then
+ begin
+ // Just open the file in read-write mode to be sure that we have access
+ // rights for it.
+ // Note: Do not use IsReadOnly() as it does not check file privileges, so
+ // a non-read-only file might not be writable for us.
+ Handle := ConfigIni.Open(fmOpenReadWrite);
+ if (Handle <> -1) then
+ begin
+ FileClose(Handle);
+ UseLocalDirs := true;
+ end;
+ end;
+ end
+ else // config.ini does not exist
+ begin
+ // try to create config.ini
+ Handle := ConfigIni.CreateFile();
+ if (Handle <> -1) then
+ begin
+ FileClose(Handle);
+ UseLocalDirs := true;
+ end;
+ end;
end;
-function TPlatformWindows.GetGameSharedPath: WideString;
+function TPlatformWindows.GetLogPath: IPath;
begin
- Result := GetExecutionDir();
+ Result := GetGameUserPath;
end;
-function TPlatformWindows.GetGameUserPath: WideString;
+function TPlatformWindows.GetGameSharedPath: IPath;
begin
- //Result := GetSpecialPath(CSIDL_APPDATA) + PathDelim + 'UltraStarDX' + PathDelim;
Result := GetExecutionDir();
end;
-function TPlatformWindows.CopyFile(const Source, Target: WideString; FailIfExists: boolean): boolean;
+function TPlatformWindows.GetGameUserPath: IPath;
begin
- Result := Windows.CopyFileW(PWideChar(Source), PWideChar(Target), FailIfExists);
+ if UseLocalDirs then
+ Result := GetExecutionDir()
+ else
+ Result := GetSpecialPath(CSIDL_APPDATA).Append('ultrastardx', pdAppend);
end;
end.
diff --git a/cmake/src/base/UPlaylist.pas b/cmake/src/base/UPlaylist.pas
index 419ce687..f12e06cf 100644
--- a/cmake/src/base/UPlaylist.pas
+++ b/cmake/src/base/UPlaylist.pas
@@ -34,21 +34,23 @@ interface
{$I switches.inc}
uses
+ Classes,
USong,
- UPath;
+ UPath,
+ UPathUtils;
type
TPlaylistItem = record
- Artist: String;
- Title: String;
+ Artist: UTF8String;
+ Title: UTF8String;
SongID: Integer;
end;
APlaylistItem = array of TPlaylistItem;
TPlaylist = record
- Name: String;
- Filename: String;
+ Name: UTF8String;
+ Filename: IPath;
Items: APlaylistItem;
end;
@@ -68,20 +70,20 @@ type
Playlists: APlaylist;
constructor Create;
- Procedure LoadPlayLists;
- Function LoadPlayList(Index: Cardinal; Filename: String): Boolean;
- Procedure SavePlayList(Index: Cardinal);
+ procedure LoadPlayLists;
+ function LoadPlayList(Index: Cardinal; const Filename: IPath): Boolean;
+ procedure SavePlayList(Index: Cardinal);
- Procedure SetPlayList(Index: Cardinal);
+ procedure SetPlayList(Index: Cardinal);
- Function AddPlaylist(Name: String): Cardinal;
- Procedure DelPlaylist(const Index: Cardinal);
+ function AddPlaylist(const Name: UTF8String): 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 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;
+ procedure GetNames(var PLNames: array of UTF8String);
+ function GetIndexbySongID(const SongID: Cardinal; const iPlaylist: Integer = -1): Integer;
end;
{Modes:
@@ -95,13 +97,15 @@ type
implementation
-uses USongs,
- ULog,
- UMain,
- //UFiles,
- UGraphic,
- UThemes,
- SysUtils;
+uses
+ SysUtils,
+ USongs,
+ ULog,
+ UMain,
+ UFilesystem,
+ UGraphic,
+ UThemes,
+ UUnicodeUtils;
//----------
//Create - Construct Class - Dummy for now
@@ -117,90 +121,90 @@ end;
//----------
Procedure TPlayListManager.LoadPlayLists;
var
- SR: TSearchRec;
Len: Integer;
PlayListBuffer: TPlayList;
+ Iter: IFileIterator;
+ FileInfo: TFileInfo;
begin
SetLength(Playlists, 0);
- if FindFirst(PlayListPath + '*.upl', 0, SR) = 0 then
+ Iter := FileSystem.FileFind(PlayListPath.Append('*.upl'), 0);
+ while (Iter.HasNext) do
begin
- repeat
- Len := Length(Playlists);
- SetLength(Playlists, Len +1);
+ Len := Length(Playlists);
+ SetLength(Playlists, Len + 1);
+
+ FileInfo := Iter.Next;
- if not LoadPlayList (Len, Sr.Name) then
- SetLength(Playlists, Len)
- else
+ if not LoadPlayList(Len, FileInfo.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
- // 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;
+ Playlists[Len+1] := Playlists[Len];
+ Dec(Len);
end;
-
- until FindNext(SR) <> 0;
- FindClose(SR);
- end;
+ Playlists[Len+1] := PlayListBuffer;
+ end;
+ 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 TPlayListManager.LoadPlayList(Index: Cardinal; const Filename: IPath): Boolean;
- Function FindSong(Artist, Title: String): Integer;
+ function FindSong(Artist, Title: UTF8String): 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
+ if (CatSongs.Song[I].Title = Title) and (CatSongs.Song[I].Artist = Artist) then
begin
Result := I;
Break;
end;
end;
end;
+
+var
+ TextStream: TTextFileStream;
+ Line: UTF8String;
+ PosDelimiter: Integer;
+ SongID: Integer;
+ Len: Integer;
+ FilenameAbs: IPath;
begin
- if not FileExists(PlayListPath + Filename) then
- begin
- Log.LogError('Could not load Playlist: ' + Filename);
- Result := False;
- Exit;
+ //Load File
+ try
+ FilenameAbs := PlaylistPath.Append(Filename);
+ TextStream := TMemTextFileStream.Create(FilenameAbs, fmOpenRead);
+ except
+ begin
+ Log.LogError('Could not load Playlist: ' + FilenameAbs.ToNative);
+ Result := False;
+ Exit;
+ end;
end;
Result := True;
- //Load File
- AssignFile(F, PlayListPath + FileName);
- Reset(F);
-
//Set Filename
- PlayLists[Index].Filename := Filename;
- PlayLists[Index].Name := '';
+ Playlists[Index].Filename := Filename;
+ Playlists[Index].Name := '';
//Read Until End of File
- While not Eof(F) do
+ while TextStream.ReadLine(Line) do
begin
- //Read Curent Line
- Readln(F, Line);
-
if (Length(Line) > 0) then
begin
- PosDelimiter := Pos(':', Line);
- if (PosDelimiter <> 0) then
+ PosDelimiter := UTF8Pos(':', Line);
+ if (PosDelimiter <> 0) then
begin
//Comment or Name String
if (Line[1] = '#') then
@@ -224,7 +228,7 @@ begin
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);
+ else Log.LogError('Could not find Song in Playlist: ' + PlayLists[Index].Filename.ToNative + ', ' + Line);
end;
end;
end;
@@ -233,71 +237,70 @@ begin
//If no special name is given, use Filename
if PlayLists[Index].Name = '' then
begin
- PlayLists[Index].Name := ChangeFileExt(FileName, '');
+ PlayLists[Index].Name := FileName.SetExtension('').ToUTF8;
end;
//Finish (Close File)
- CloseFile(F);
+ TextStream.Free;
end;
-//----------
-//SavePlayList - Saves the specified Playlist
-//----------
-Procedure TPlayListManager.SavePlayList(Index: Cardinal);
+{**
+ * Saves the specified Playlist
+ *}
+procedure TPlayListManager.SavePlayList(Index: Cardinal);
var
- F: TextFile;
+ TextStream: TTextFileStream;
+ PlaylistFile: IPath;
I: Integer;
begin
- if (Not FileExists(PlaylistPath + Playlists[Index].Filename)) OR (Not FileisReadOnly(PlaylistPath + Playlists[Index].Filename)) then
- begin
+ PlaylistFile := PlaylistPath.Append(Playlists[Index].Filename);
- //open File for Rewriting
- AssignFile(F, PlaylistPath + Playlists[Index].Filename);
- try
- try
- Rewrite(F);
+ // cannot update read-only file
+ if PlaylistFile.IsFile() and PlaylistFile.IsReadOnly() then
+ Exit;
- //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, '######################################');
+ // open file for rewriting
+ TextStream := TMemTextFileStream.Create(PlaylistFile, fmCreate);
+ try
+ // Write version (not nessecary but helpful)
+ TextStream.WriteLine('######################################');
+ TextStream.WriteLine('#Ultrastar Deluxe Playlist Format v1.0');
+ TextStream.WriteLine(Format('#Playlist %s with %d Songs.',
+ [ Playlists[Index].Name, Length(Playlists[Index].Items) ]));
+ TextStream.WriteLine('######################################');
- //Write Name Information
- WriteLn(F, '#Name: ' + Playlists[Index].Name);
+ // Write name information
+ TextStream.WriteLine('#Name: ' + Playlists[Index].Name);
- //Write Song Information
- WriteLn(F, '#Songs:');
+ // Write song information
+ TextStream.WriteLine('#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);
+ for I := 0 to high(Playlists[Index].Items) do
+ begin
+ TextStream.WriteLine(Playlists[Index].Items[I].Artist + ' : ' + Playlists[Index].Items[I].Title);
end;
+ except
+ Log.LogError('Could not write Playlistfile "' + Playlists[Index].Name + '"');
end;
+ TextStream.Free;
end;
-//----------
-//SetPlayList - Display a Playlist in CatSongs
-//----------
-Procedure TPlayListManager.SetPlayList(Index: Cardinal);
+{**
+ * Display a Playlist in CatSongs
+ *}
+procedure TPlayListManager.SetPlayList(Index: Cardinal);
var
I: Integer;
begin
- If (Int(Index) > High(PlayLists)) then
+ if (Int(Index) > High(PlayLists)) then
exit;
//Hide all Songs
- For I := 0 to high(CatSongs.Song) do
+ 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
+ for I := 0 to high(PlayLists[Index].Items) do
begin
CatSongs.Song[PlayLists[Index].Items[I].SongID].Visible := True;
end;
@@ -324,31 +327,33 @@ end;
//----------
//AddPlaylist - Adds a Playlist and Returns the Index
//----------
-Function TPlayListManager.AddPlaylist(Name: String): Cardinal;
+function TPlayListManager.AddPlaylist(const Name: UTF8String): cardinal;
var
I: Integer;
+ PlaylistFile: IPath;
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
+ 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;
+ Playlists[Result].Name := Name;
+
+ // clear playlist items
+ SetLength(Playlists[Result].Items, 0);
I := 1;
- if (not FileExists(PlaylistPath + Name + '.upl')) then
- Playlists[Result].Filename := Name + '.upl'
- else
+ PlaylistFile := PlaylistPath.Append(Name + '.upl');
+ while (PlaylistFile.Exists) do
begin
- repeat
- Inc(I);
- until not FileExists(PlaylistPath + Name + InttoStr(I) + '.upl');
- Playlists[Result].Filename := Name + InttoStr(I) + '.upl';
+ Inc(I);
+ PlaylistFile := PlaylistPath.Append(Name + InttoStr(I) + '.upl');
end;
+ Playlists[Result].Filename := PlaylistFile.GetName;
//Save new Playlist
SavePlayList(Result);
@@ -357,28 +362,28 @@ end;
//----------
//DelPlaylist - Deletes a Playlist
//----------
-Procedure TPlayListManager.DelPlaylist(const Index: Cardinal);
+procedure TPlayListManager.DelPlaylist(const Index: Cardinal);
var
I: Integer;
- Filename: String;
+ Filename: IPath;
begin
- If Int(Index) > High(Playlists) then
+ if Int(Index) > High(Playlists) then
Exit;
- Filename := PlaylistPath + Playlists[Index].Filename;
+ Filename := PlaylistPath.Append(Playlists[Index].Filename);
//If not FileExists or File is not Writeable then exit
- If (Not FileExists(Filename)) OR (FileisReadOnly(Filename)) then
+ if (not Filename.IsFile()) or (Filename.IsReadOnly()) then
Exit;
//Delete Playlist from FileSystem
- if Not DeleteFile(Filename) then
+ if not Filename.DeleteFile() then
Exit;
//Delete Playlist from Array
//move all PLs to the Hole
- For I := Index to High(Playlists)-1 do
+ for I := Index to High(Playlists)-1 do
PlayLists[I] := PlayLists[I+1];
//Delete last Playlist
@@ -390,7 +395,7 @@ begin
begin
ScreenSong.UnLoadDetailedCover;
ScreenSong.HideCatTL;
- CatSongs.SetFilter('', 0);
+ CatSongs.SetFilter('', fltAll);
ScreenSong.Interaction := 0;
ScreenSong.FixSelected;
ScreenSong.ChangeMusic;
@@ -471,7 +476,7 @@ end;
//----------
//GetNames - Writes Playlist Names in a Array
//----------
-Procedure TPlayListManager.GetNames(var PLNames: array of String);
+procedure TPlayListManager.GetNames(var PLNames: array of UTF8String);
var
I: Integer;
Len: Integer;
diff --git a/cmake/src/base/URecord.pas b/cmake/src/base/URecord.pas
index 2c2093a0..c183875c 100644
--- a/cmake/src/base/URecord.pas
+++ b/cmake/src/base/URecord.pas
@@ -95,14 +95,14 @@ const
type
TAudioInputSource = record
- Name: string;
+ Name: UTF8String;
end;
// soundcard input-devices information
TAudioInputDevice = class
public
CfgIndex: integer; // index of this device in Ini.InputDeviceConfig
- Name: string; // soundcard name
+ Name: UTF8String; // 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)
@@ -133,6 +133,7 @@ type
destructor Destroy; override;
procedure UpdateInputDeviceConfig;
+ function ValidateSettings: boolean;
// handle microphone input
procedure HandleMicrophoneData(Buffer: PByteArray; Size: integer;
@@ -143,7 +144,7 @@ type
private
Started: boolean;
protected
- function UnifyDeviceName(const name: string; deviceIndex: integer): string;
+ function UnifyDeviceName(const name: UTF8String; deviceIndex: integer): UTF8String;
public
function GetName: String; virtual; abstract;
function InitializeRecord: boolean; virtual; abstract;
@@ -162,6 +163,8 @@ implementation
uses
ULog,
+ UGraphic,
+ ULanguage,
UNote;
var
@@ -577,6 +580,7 @@ begin
deviceCfg.Name := Trim(device.Name);
deviceCfg.Input := 0;
+ deviceCfg.Latency := LATENCY_AUTODETECT;
channelCount := device.AudioFormat.Channels;
SetLength(deviceCfg.ChannelToPlayerMap, channelCount);
@@ -593,6 +597,50 @@ begin
end;
end;
+function TAudioInputProcessor.ValidateSettings: boolean;
+const
+ MAX_PLAYER_COUNT = 6; // FIXME: there should be a global variable for this
+var
+ I, J: integer;
+ PlayerID: integer;
+ PlayerMap: array [0 .. MAX_PLAYER_COUNT] of boolean;
+ InputDevice: TAudioInputDevice;
+ InputDeviceCfg: PInputDeviceConfig;
+begin
+ // mark all players as unassigned
+ for I := 0 to High(PlayerMap) do
+ PlayerMap[I] := false;
+
+ // iterate over all active devices
+ for I := 0 to High(DeviceList) do
+ begin
+ InputDevice := DeviceList[I];
+ InputDeviceCfg := @Ini.InputDeviceConfig[InputDevice.CfgIndex];
+ // iterate over all channels of the current devices
+ for J := 0 to High(InputDeviceCfg.ChannelToPlayerMap) do
+ begin
+ // get player that was mapped to the current device channel
+ PlayerID := InputDeviceCfg.ChannelToPlayerMap[J];
+ if (PlayerID <> 0) then
+ begin
+ // check if player is already assigned to another device/channel
+ if (PlayerMap[PlayerID]) then
+ begin
+ ScreenPopupError.ShowPopup(
+ Format(Language.Translate('ERROR_PLAYER_DEVICE_ASSIGNMENT'),
+ [PlayerID]));
+ Result := false;
+ Exit;
+ end;
+
+ // mark player as assigned to a device
+ PlayerMap[PlayerID] := true;
+ end;
+ end;
+ end;
+ Result := true;
+end;
+
{*
* Handles captured microphone input data.
* Params:
@@ -741,11 +789,11 @@ begin
Started := false;
end;
-function TAudioInputBase.UnifyDeviceName(const name: string; deviceIndex: integer): string;
+function TAudioInputBase.UnifyDeviceName(const name: UTF8String; deviceIndex: integer): UTF8String;
var
count: integer; // count of devices with this name
- function IsDuplicate(const name: string): boolean;
+ function IsDuplicate(const name: UTF8String): boolean;
var
i: integer;
begin
@@ -753,10 +801,13 @@ var
// search devices with same description
for i := 0 to deviceIndex-1 do
begin
- if (AudioInputProcessor.DeviceList[i].Name = name) then
+ if (AudioInputProcessor.DeviceList[i] <> nil) then
begin
- Result := true;
- Break;
+ if (AudioInputProcessor.DeviceList[i].Name = name) then
+ begin
+ Result := true;
+ Break;
+ end;
end;
end;
end;
diff --git a/cmake/src/base/USingScores.pas b/cmake/src/base/USingScores.pas
index 89896d2d..26c5dfe8 100644
--- a/cmake/src/base/USingScores.pas
+++ b/cmake/src/base/USingScores.pas
@@ -117,9 +117,9 @@ type
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
+ Rating: integer; // 0 to 8, type of rating (cool, bad, etc.)
+ ScoreGiven: integer; // score that has already been given to the player
+ ScoreDiff: integer; // difference between cur score at spawn and old score
Next: PScorePopUp; // next item in list
end;
aScorePopUp = array of TScorePopUp;
@@ -129,7 +129,7 @@ type
//-----------
TSingScores = class
private
- Positions: aScorePosition;
+ aPositions: aScorePosition;
aPlayers: aScorePlayer;
oPositionCount: byte;
oPlayerCount: byte;
@@ -138,9 +138,18 @@ type
FirstPopUp: PScorePopUp;
LastPopUp: PScorePopUp;
+ // only defined during draw, time passed between
+ // current and previous call of draw
+ TimePassed: Cardinal;
+
// draws a popup by pointer
procedure DrawPopUp(const PopUp: PScorePopUp);
+ // raises players score if RaiseScore was called
+ // has to be called after DrawPopUp and before
+ // DrawScore
+ procedure DoRaiseScore(const Index: integer);
+
// draws a score by playerindex
procedure DrawScore(const Index: integer);
@@ -149,6 +158,10 @@ type
// removes a popup w/o destroying the list
procedure KillPopUp(const last, cur: PScorePopUp);
+
+ // calculate the amount of points for a player that is
+ // still in popups and therfore not displayed
+ function GetPopUpPoints(const Index: integer): integer;
public
Settings: record // Record containing some Displaying Options
Phase1Time: real; // time for phase 1 to complete (in msecs)
@@ -174,6 +187,7 @@ type
property PositionCount: byte read oPositionCount;
property PlayerCount: byte read oPlayerCount;
property Players: aScorePlayer read aPlayers;
+ property Positions: aScorePosition read aPositions;
// constructor just sets some standard settings
constructor Create;
@@ -201,8 +215,14 @@ type
// it gives every player a score position
procedure Init;
+ // raises the score of a specified player to the specified score
+ procedure RaiseScore(Player: byte; Score: integer);
+
+ // sets the score of a specified player to the specified score
+ procedure SetScore(Player: byte; Score: integer);
+
// spawns a new line bonus popup for the player
- procedure SpawnPopUp(const PlayerIndex: byte; const Rating: byte; const Score: word);
+ procedure SpawnPopUp(const PlayerIndex: byte; const Rating: integer; const Score: integer);
// removes all popups from mem
procedure KillAllPopUps;
@@ -215,6 +235,7 @@ implementation
uses
SysUtils,
+ Math,
SDL,
TextGL,
ULog,
@@ -266,7 +287,7 @@ procedure TSingScores.AddPosition(const pPosition: PScorePosition);
begin
if (PositionCount < MaxPositions) then
begin
- Positions[PositionCount] := pPosition^;
+ aPositions[PositionCount] := pPosition^;
Inc(oPositionCount);
end;
end;
@@ -318,6 +339,7 @@ procedure TSingScores.ClearPlayers;
begin
KillAllPopUps;
oPlayerCount := 0;
+ TimePassed := 0;
end;
{**
@@ -328,6 +350,7 @@ begin
KillAllPopUps;
oPlayerCount := 0;
oPositionCount := 0;
+ TimePassed := 0;
end;
{**
@@ -360,7 +383,7 @@ var
nPosition.PUW := nPosition.BGW;
nPosition.PUH := nPosition.BGH;
- nPosition.PUFont := 2;
+ nPosition.PUFont := ftOutline1;
nPosition.PUFontSize := 18;
nPosition.PUStartX := nPosition.BGX;
@@ -399,10 +422,34 @@ begin
AddByStatics(4, Theme.Sing.StaticP3RScoreBG, Theme.Sing.StaticP3SingBar, Theme.Sing.TextP3RScore);
end;
+{**
+ * raises the score of a specified player to the specified score
+ *}
+procedure TSingScores.RaiseScore(Player: byte; Score: integer);
+begin
+ if (Player <= PlayerCount - 1) then
+ aPlayers[Player].Score := Score;
+end;
+
+{**
+ * sets the score of a specified player to the specified score
+ *}
+procedure TSingScores.SetScore(Player: byte; Score: integer);
+ var
+ Diff: Integer;
+begin
+ if (Player <= PlayerCount - 1) then
+ begin
+ Diff := Score - Players[Player].Score;
+ aPlayers[Player].Score := Score;
+ Inc(aPlayers[Player].ScoreDisplayed, Diff);
+ end;
+end;
+
{**
* spawns a new line bonus popup for the player
*}
-procedure TSingScores.SpawnPopUp(const PlayerIndex: byte; const Rating: byte; const Score: word);
+procedure TSingScores.SpawnPopUp(const PlayerIndex: byte; const Rating: integer; const Score: integer);
var
Cur: PScorePopUp;
begin
@@ -414,10 +461,12 @@ begin
Cur.Player := PlayerIndex;
Cur.TimeStamp := SDL_GetTicks;
- // limit rating value to 8
+ // limit rating value to 0..8
// a higher value would cause a crash when selecting the bg texture
if (Rating > 8) then
Cur.Rating := 8
+ else if (Rating < 0) then
+ Cur.Rating := 0
else
Cur.Rating := Rating;
@@ -512,6 +561,27 @@ begin
LastPopUp := nil;
end;
+{**
+ * calculate the amount of points for a player that is
+ * still in popups and therfore not displayed
+ *}
+function TSingScores.GetPopUpPoints(const Index: integer): integer;
+ var
+ CurPopUp: PScorePopUp;
+begin
+ Result := 0;
+
+ CurPopUp := FirstPopUp;
+ while (CurPopUp <> nil) do
+ begin
+ if (CurPopUp.Player = Index) then
+ begin // add points left "in" popup to result
+ Inc(Result, CurPopUp.ScoreDiff - CurPopUp.ScoreGiven);
+ end;
+ CurPopUp := CurPopUp.Next;
+ end;
+end;
+
{**
* has to be called after positions and players have been added, before first call of draw
* it gives each player a score position
@@ -532,7 +602,7 @@ var
for I := 0 to PositionCount - 1 do
begin
- if ((Positions[I].PlayerCount and bPlayerCount) <> 0) then
+ if ((aPositions[I].PlayerCount and bPlayerCount) <> 0) then
Inc(Result);
end;
end;
@@ -546,7 +616,7 @@ var
for I := 0 to PositionCount - 1 do
begin
- if ((Positions[I].PlayerCount and bPlayerCount) <> 0) then
+ if ((aPositions[I].PlayerCount and bPlayerCount) <> 0) then
begin
if (bPlayer = 0) then
begin
@@ -614,6 +684,8 @@ var
CurPopUp, LastPopUp: PScorePopUp;
begin
CurTime := SDL_GetTicks;
+ if (TimePassed <> 0) then
+ TimePassed := CurTime - TimePassed;
if Visible then
begin
@@ -644,6 +716,7 @@ begin
// draw players w/ rating bar
for I := 0 to PlayerCount-1 do
begin
+ DoRaiseScore(I);
DrawScore(I);
DrawRatingBar(I);
end
@@ -651,10 +724,42 @@ begin
// draw players w/o rating bar
for I := 0 to PlayerCount-1 do
begin
+ DoRaiseScore(I);
DrawScore(I);
end;
end; // eo visible
+
+ TimePassed := CurTime;
+end;
+
+{**
+ * raises players score if RaiseScore was called
+ * has to be called after DrawPopUp and before
+ * DrawScore
+ *}
+procedure TSingScores.DoRaiseScore(const Index: integer);
+ var
+ S: integer;
+ Diff: integer;
+ const
+ RaisePerSecond = 500;
+begin
+ S := (Players[Index].Score - (Players[Index].ScoreDisplayed + GetPopUpPoints(Index)));
+
+ if (S <> 0) then
+ begin
+ Diff := Round(RoundTo((RaisePerSecond * TimePassed) / 1000, 1));
+
+ { minimal raise per frame = 1 }
+ if Abs(Diff) < 1 then
+ Diff := Sign(S);
+
+ if (Abs(Diff) < Abs(S)) then
+ Inc(aPlayers[Index].ScoreDisplayed, Diff)
+ else
+ Inc(aPlayers[Index].ScoreDisplayed, S);
+ end;
end;
{**
@@ -701,13 +806,13 @@ begin
Progress := TimeDiff / Settings.Phase1Time;
- W := Positions[PIndex].PUW * Sin(Progress/2*Pi);
- H := Positions[PIndex].PUH * Sin(Progress/2*Pi);
+ W := aPositions[PIndex].PUW * Sin(Progress/2*Pi);
+ H := aPositions[PIndex].PUH * Sin(Progress/2*Pi);
- X := Positions[PIndex].PUStartX + (Positions[PIndex].PUW - W)/2;
- Y := Positions[PIndex].PUStartY + (Positions[PIndex].PUH - H)/2;
+ X := aPositions[PIndex].PUStartX + (aPositions[PIndex].PUW - W)/2;
+ Y := aPositions[PIndex].PUStartY + (aPositions[PIndex].PUH - H)/2;
- FontSize := Round(Progress * Positions[PIndex].PUFontSize);
+ FontSize := Round(Progress * aPositions[PIndex].PUFontSize);
FontOffset := (H - FontSize) / 2;
Alpha := 1;
end
@@ -717,20 +822,20 @@ begin
// phase 2 - the moving
Progress := (TimeDiff - Settings.Phase1Time) / Settings.Phase2Time;
- W := Positions[PIndex].PUW;
- H := Positions[PIndex].PUH;
+ W := aPositions[PIndex].PUW;
+ H := aPositions[PIndex].PUH;
- PosDiff := Positions[PIndex].PUTargetX - Positions[PIndex].PUStartX;
+ PosDiff := aPositions[PIndex].PUTargetX - aPositions[PIndex].PUStartX;
if PosDiff > 0 then
PosDiff := PosDiff + W;
- X := Positions[PIndex].PUStartX + PosDiff * sqr(Progress);
+ X := aPositions[PIndex].PUStartX + PosDiff * sqr(Progress);
- PosDiff := Positions[PIndex].PUTargetY - Positions[PIndex].PUStartY;
+ PosDiff := aPositions[PIndex].PUTargetY - aPositions[PIndex].PUStartY;
if PosDiff < 0 then
- PosDiff := PosDiff + Positions[PIndex].BGH;
- Y := Positions[PIndex].PUStartY + PosDiff * sqr(Progress);
+ PosDiff := PosDiff + aPositions[PIndex].BGH;
+ Y := aPositions[PIndex].PUStartY + PosDiff * sqr(Progress);
- FontSize := Positions[PIndex].PUFontSize;
+ FontSize := aPositions[PIndex].PUFontSize;
FontOffset := (H - FontSize) / 2;
Alpha := 1 - 0.3 * Progress;
end
@@ -763,24 +868,24 @@ begin
// set positions etc.
Alpha := 0.7 - 0.7 * Progress;
- W := Positions[PIndex].PUW;
- H := Positions[PIndex].PUH;
+ W := aPositions[PIndex].PUW;
+ H := aPositions[PIndex].PUH;
- PosDiff := Positions[PIndex].PUTargetX - Positions[PIndex].PUStartX;
+ PosDiff := aPositions[PIndex].PUTargetX - aPositions[PIndex].PUStartX;
if (PosDiff > 0) then
PosDiff := W
else
PosDiff := 0;
- X := Positions[PIndex].PUTargetX + PosDiff * Progress;
+ X := aPositions[PIndex].PUTargetX + PosDiff * Progress;
- PosDiff := Positions[PIndex].PUTargetY - Positions[PIndex].PUStartY;
+ PosDiff := aPositions[PIndex].PUTargetY - aPositions[PIndex].PUStartY;
if (PosDiff < 0) then
- PosDiff := -Positions[PIndex].BGH
+ PosDiff := -aPositions[PIndex].BGH
else
PosDiff := 0;
- Y := Positions[PIndex].PUTargetY - PosDiff * (1 - Progress);
+ Y := aPositions[PIndex].PUTargetY - PosDiff * (1 - Progress);
- FontSize := Positions[PIndex].PUFontSize;
+ FontSize := aPositions[PIndex].PUFontSize;
FontOffset := (H - FontSize) / 2;
end
else
@@ -817,7 +922,7 @@ begin
glDisable(GL_BLEND);
// set font style and size
- SetFontStyle(Positions[PIndex].PUFont);
+ SetFontStyle(aPositions[PIndex].PUFont);
SetFontItalic(false);
SetFontSize(FontSize);
SetFontReflection(false, 0);
@@ -853,7 +958,7 @@ 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];
+ Position := @aPositions[Players[Index].Position and 127];
// draw scorebg
glEnable(GL_TEXTURE_2D);
@@ -905,7 +1010,7 @@ begin
Players[index].RBVisible and
Players[index].Visible) then
begin
- Position := @Positions[Players[Index].Position and 127];
+ Position := @aPositions[Players[Index].Position and 127];
if (Enabled and Players[Index].Enabled) then
begin
diff --git a/cmake/src/base/USkins.pas b/cmake/src/base/USkins.pas
index a4722d95..a909b081 100644
--- a/cmake/src/base/USkins.pas
+++ b/cmake/src/base/USkins.pas
@@ -33,32 +33,42 @@ interface
{$I switches.inc}
+uses
+ UPath,
+ UCommon;
+
type
TSkinTexture = record
Name: string;
- FileName: string;
+ FileName: IPath;
end;
TSkinEntry = record
Theme: string;
Name: string;
- Path: string;
- FileName: string;
+ Path: IPath;
+ FileName: IPath;
+
+ DefaultColor: integer;
Creator: string; // not used yet
end;
TSkin = class
Skin: array of TSkinEntry;
SkinTexture: array of TSkinTexture;
- SkinPath: string;
+ SkinPath: IPath;
Color: integer;
constructor Create;
procedure LoadList;
- procedure ParseDir(Dir: string);
- procedure LoadHeader(FileName: string);
+ procedure ParseDir(Dir: IPath);
+ procedure LoadHeader(FileName: IPath);
procedure LoadSkin(Name: string);
- function GetTextureFileName(TextureName: string): string;
+ function GetTextureFileName(TextureName: string): IPath;
function GetSkinNumber(Name: string): integer;
+ function GetDefaultColor(SkinNo: integer): integer;
+
+ procedure GetSkinsByTheme(Theme: string; out Skins: TUTF8StringDynArray);
+
procedure onThemeChange;
end;
@@ -71,10 +81,12 @@ uses
IniFiles,
Classes,
SysUtils,
+ Math,
UIni,
ULog,
UMain,
- UPath;
+ UPathUtils,
+ UFileSystem;
constructor TSkin.Create;
begin
@@ -86,48 +98,47 @@ end;
procedure TSkin.LoadList;
var
- SR: TSearchRec;
+ Iter: IFileIterator;
+ DirInfo: TFileInfo;
begin
- if FindFirst(SkinsPath+'*', faDirectory, SR) = 0 then
+ Iter := FileSystem.FileFind(SkinsPath.Append('*'), faDirectory);
+ while Iter.HasNext do
begin
- repeat
- if (SR.Name <> '.') and (SR.Name <> '..') then
- ParseDir(SkinsPath + SR.Name + PathDelim);
- until FindNext(SR) <> 0;
- end; // if
- FindClose(SR);
+ DirInfo := Iter.Next();
+ if (not DirInfo.Name.Equals('.')) and (not DirInfo.Name.Equals('..')) then
+ ParseDir(SkinsPath.Append(DirInfo.Name, pdAppend));
+ end;
end;
-procedure TSkin.ParseDir(Dir: string);
+procedure TSkin.ParseDir(Dir: IPath);
var
- SR: TSearchRec;
+ Iter: IFileIterator;
+ IniInfo: TFileInfo;
begin
- if FindFirst(Dir + '*.ini', faAnyFile, SR) = 0 then
+ Iter := FileSystem.FileFind(Dir.Append('*.ini'), 0);
+ while Iter.HasNext do
begin
- repeat
-
- if (SR.Name <> '.') and (SR.Name <> '..') then
- LoadHeader(Dir + SR.Name);
-
- until FindNext(SR) <> 0;
+ IniInfo := Iter.Next;
+ LoadHeader(Dir.Append(IniInfo.Name));
end;
end;
-procedure TSkin.LoadHeader(FileName: string);
+procedure TSkin.LoadHeader(FileName: IPath);
var
SkinIni: TMemIniFile;
S: integer;
begin
- SkinIni := TMemIniFile.Create(FileName);
+ SkinIni := TMemIniFile.Create(FileName.ToNative);
S := Length(Skin);
SetLength(Skin, S+1);
- Skin[S].Path := IncludeTrailingPathDelimiter(ExtractFileDir(FileName));
- Skin[S].FileName := ExtractFileName(FileName);
+ Skin[S].Path := FileName.GetPath;
+ Skin[S].FileName := FileName.GetName;
Skin[S].Theme := SkinIni.ReadString('Skin', 'Theme', '');
Skin[S].Name := SkinIni.ReadString('Skin', 'Name', '');
Skin[S].Creator := SkinIni.ReadString('Skin', 'Creator', '');
+ Skin[S].DefaultColor := Max(0, GetArrayIndex(IColor, SkinIni.ReadString('Skin', 'Color', ''), true));
SkinIni.Free;
end;
@@ -142,7 +153,7 @@ begin
S := GetSkinNumber(Name);
SkinPath := Skin[S].Path;
- SkinIni := TMemIniFile.Create(SkinPath + Skin[S].FileName);
+ SkinIni := TMemIniFile.Create(SkinPath.Append(Skin[S].FileName).ToNative);
SL := TStringList.Create;
SkinIni.ReadSection('Textures', SL);
@@ -151,42 +162,33 @@ begin
for T := 0 to SL.Count-1 do
begin
SkinTexture[T].Name := SL.Strings[T];
- SkinTexture[T].FileName := SkinIni.ReadString('Textures', SL.Strings[T], '');
+ SkinTexture[T].FileName := Path(SkinIni.ReadString('Textures', SL.Strings[T], ''));
end;
SL.Free;
SkinIni.Free;
end;
-function TSkin.GetTextureFileName(TextureName: string): string;
+function TSkin.GetTextureFileName(TextureName: string): IPath;
var
T: integer;
begin
- Result := '';
+ Result := PATH_NONE;
for T := 0 to High(SkinTexture) do
begin
- if ( SkinTexture[T].Name = TextureName ) and
- ( SkinTexture[T].FileName <> '' ) then
+ if (SkinTexture[T].Name = TextureName) and
+ (SkinTexture[T].FileName.IsSet) then
begin
- Result := SkinPath + SkinTexture[T].FileName;
+ Result := SkinPath.Append(SkinTexture[T].FileName);
end;
end;
- if ( TextureName <> '' ) and
- ( Result <> '' ) then
+ if (TextureName <> '') and (Result.IsSet) 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;
@@ -195,25 +197,52 @@ var
begin
Result := 0; // set default to the first available skin
for S := 0 to High(Skin) do
- if Skin[S].Name = Name then
+ if CompareText(Skin[S].Name, Name) = 0 then
Result := S;
end;
-procedure TSkin.onThemeChange;
-var
- S: integer;
- Name: String;
+procedure TSkin.GetSkinsByTheme(Theme: string; out Skins: TUTF8StringDynArray);
+ var
+ I: Integer;
+ Len: integer;
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
+ SetLength(Skins, 0);
+ Len := 0;
+
+ for I := 0 to High(Skin) do
+ if CompareText(Theme, Skin[I].Theme) = 0 then
begin
- SetLength(ISkin, Length(ISkin)+1);
- ISkin[High(ISkin)] := Skin[S].Name;
+ SetLength(Skins, Len + 1);
+ Skins[Len] := Skin[I].Name;
+ Inc(Len);
end;
+end;
+
+{ returns number of default color for skin with
+ index SkinNo in ISkin (not in the actual skin array) }
+function TSkin.GetDefaultColor(SkinNo: integer): integer;
+ var
+ I: Integer;
+begin
+ Result := 0;
+ for I := 0 to High(Skin) do
+ if CompareText(ITheme[Ini.Theme], Skin[I].Theme) = 0 then
+ begin
+ if SkinNo > 0 then
+ Dec(SkinNo)
+ else
+ begin
+ Result := Skin[I].DefaultColor;
+ Break;
+ end;
+ end;
+end;
+
+procedure TSkin.onThemeChange;
+begin
+ Ini.SkinNo:=0;
+ GetSkinsByTheme(ITheme[Ini.Theme], ISkin);
end;
end.
diff --git a/cmake/src/base/USong.pas b/cmake/src/base/USong.pas
index 57f78a27..a441fe40 100644
--- a/cmake/src/base/USong.pas
+++ b/cmake/src/base/USong.pas
@@ -56,7 +56,11 @@ uses
PseudoThread,
{$ENDIF}
UCatCovers,
- UXMLSong;
+ UXMLSong,
+ UUnicodeUtils,
+ UTextEncoding,
+ UFilesystem,
+ UPath;
type
@@ -68,42 +72,62 @@ type
end;
TScore = record
- Name: WideString;
+ Name: UTF8String;
Score: integer;
- Length: string;
+ Date: UTF8String;
+ end;
+
+ { used to hold header tags that are not supported by this version of
+ usdx (e.g. some tags from ultrastar 0.7.0) when songs are loaded in
+ songeditor. They will be written the end of the song header }
+ TCustomHeaderTag = record
+ Tag: UTF8String;
+ Content: UTF8String;
end;
TSong = class
+ private
FileLineNo : integer; // line, which is read last, for error reporting
- procedure ParseNote(LineNumber: integer; TypeP: char; StartP, DurationP, NoteP: integer; LyricS: string);
+ function DecodeFilename(Filename: RawByteString): IPath;
+ procedure ParseNote(LineNumber: integer; TypeP: char; StartP, DurationP, NoteP: integer; LyricS: UTF8String);
procedure NewSentence(LineNumberP: integer; Param1, Param2: integer);
- function ReadTXTHeader( const aFileName : WideString ): boolean;
- function ReadXMLHeader( const aFileName : WideString ): boolean;
+ function ParseLyricStringParam(const Line: RawByteString; var LinePos: integer): RawByteString;
+ function ParseLyricIntParam(const Line: RawByteString; var LinePos: integer): integer;
+ function ParseLyricFloatParam(const Line: RawByteString; var LinePos: integer): extended;
+ function ParseLyricCharParam(const Line: RawByteString; var LinePos: integer): AnsiChar;
+ function ParseLyricText(const Line: RawByteString; var LinePos: integer): RawByteString;
+
+ function ReadTXTHeader(SongFile: TTextFileStream; ReadCustomTags: Boolean): boolean;
+ function ReadXMLHeader(const aFileName: IPath): boolean;
+
+ function GetFolderCategory(const aFileName: IPath): UTF8String;
+ function FindSongFile(Dir: IPath; Mask: UTF8String): IPath;
public
- Path: WideString;
- Folder: WideString; // for sorting by folder
- fFileName,
- FileName: WideString;
+ Path: IPath; // kust path component of file (only set if file was found)
+ Folder: UTF8String; // for sorting by folder (only set if file was found)
+ FileName: IPath; // just name component of file (only set if file was found)
+
+ // filenames
+ Cover: IPath;
+ Mp3: IPath;
+ Background: IPath;
+ Video: IPath;
// sorting methods
- //Category: array of WideString; // TODO: do we need this?
- Genre: WideString;
- Edition: WideString;
- Language: WideString;
+ Genre: UTF8String;
+ Edition: UTF8String;
+ Language: UTF8String;
+ Year: Integer;
- Title: WideString;
- Artist: WideString;
+ Title: UTF8String;
+ Artist: UTF8String;
- Text: WideString;
- Creator: WideString;
+ Creator: UTF8String;
- Cover: WideString;
CoverTex: TTexture;
- Mp3: WideString;
- Background: WideString;
- Video: WideString;
+
VideoGAP: real;
NotesGAP: integer;
Start: real; // in seconds
@@ -113,6 +137,10 @@ type
BPM: array of TBPM;
GAP: real; // in miliseconds
+ Encoding: TEncoding;
+
+ CustomTags: array of TCustomHeaderTag;
+
Score: array[0..2] of array of TScore;
// these are used when sorting is enabled
@@ -122,23 +150,21 @@ type
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;
- LastError: String;
+ LastError: AnsiString;
function GetErrorLineNo: integer;
property ErrorLineNo: integer read GetErrorLineNo;
- constructor Create (); overload;
- constructor Create ( const aFileName : WideString ); overload;
+ constructor Create(); overload;
+ constructor Create(const aFileName : IPath); overload;
function LoadSong: boolean;
function LoadXMLSong: boolean;
- function Analyse(): boolean;
+ function Analyse(const ReadCustomTags: Boolean = false): boolean;
function AnalyseXML(): boolean;
procedure Clear();
end;
@@ -149,67 +175,82 @@ uses
StrUtils,
TextGL,
UIni,
- UPath,
+ UPathUtils,
UMusic, //needed for Lines
UNote; //needed for Player
+const
+ DEFAULT_ENCODING = encAuto;
+
constructor TSong.Create();
begin
inherited;
+
+ // to-do : special create for category "songs"
+ //dirty fix to fix folders=on
+ Self.Path := PATH_NONE();
+ Self.FileName := PATH_NONE();
+ Self.Cover := PATH_NONE();
+ Self.Mp3 := PATH_NONE();
+ Self.Background:= PATH_NONE();
+ Self.Video := PATH_NONE();
end;
-constructor TSong.Create( const aFileName: WideString );
- // This may be changed, when we rewrite song select code.
- // it is some kind of dirty, but imho the best possible
- // solution as we do atm not support nested categorys.
- // it works like the folder sorting in 1.0.1a
- // folder is set to the first folder under the songdir
- // so songs ~/.ultrastardx/songs/punk is in the same
- // category as songs in shared/ultrastardx/songs are.
- // note: folder is just the name of a category it has
- // nothing to do with the path used for file loading
- function GetFolderCategory: WideString;
- var
- I: Integer;
- P: Integer; //position of next path delimiter
- begin
- Result := 'Unknown'; //default folder category, if we can't locate the song dir
+// This may be changed, when we rewrite song select code.
+// it is some kind of dirty, but imho the best possible
+// solution as we do atm not support nested categorys.
+// it works like the folder sorting in 1.0.1a
+// folder is set to the first folder under the songdir
+// so songs ~/.ultrastardx/songs/punk is in the same
+// category as songs in shared/ultrastardx/songs are.
+// note: folder is just the name of a category it has
+// nothing to do with the path used for file loading
+function TSong.GetFolderCategory(const aFileName: IPath): UTF8String;
+var
+ I: Integer;
+ CurSongPath: IPath;
+ CurSongPathRel: IPath;
+begin
+ Result := 'Unknown'; //default folder category, if we can't locate the song dir
- for I := 0 to SongPaths.Count-1 do
- if (AnsiStartsText(SongPaths.Strings[I], aFilename)) then
+ for I := 0 to SongPaths.Count-1 do
+ begin
+ CurSongPath := SongPaths[I] as IPath;
+ if (aFileName.IsChildOf(CurSongPath, false)) then
+ begin
+ if (aFileName.IsChildOf(CurSongPath, true)) then
begin
- P := PosEx(PathDelim, aFilename, Length(SongPaths.Strings[I]) + 1);
-
- If (P > 0) then
- begin
- // we have found the category name => get it
- Result := copy(self.Path, Length(SongPaths.Strings[I]) + 1, P - Length(SongPaths.Strings[I]) - 1);
- end
- else
- begin
- // songs are in the "root" of the songdir => use songdir for the categorys name
- Result := SongPaths.Strings[I];
- end;
-
- Exit;
+ // songs are in the "root" of the songdir => use songdir for the categorys name
+ Result := CurSongPath.RemovePathDelim.ToUTF8;
+ end
+ else
+ begin
+ // use the first subdirectory below CurSongPath as the category name
+ CurSongPathRel := aFileName.GetRelativePath(CurSongPath.AppendPathDelim);
+ Result := CurSongPathRel.SplitDirs[0].RemovePathDelim.ToUTF8;
end;
+ Exit;
+ end;
end;
+end;
+
+constructor TSong.Create(const aFileName: IPath);
begin
inherited Create();
Mult := 1;
MultBPM := 4;
- fFileName := aFileName;
LastError := '';
- if fileexists( aFileName ) then
+ Self.Path := aFileName.GetPath;
+ Self.FileName := aFileName.GetName;
+ Self.Folder := GetFolderCategory(aFileName);
+
+ (*
+ if (aFileName.IsFile) then
begin
- self.Path := ExtractFilePath( aFileName );
- self.Folder := GetFolderCategory;
- self.FileName := ExtractFileName( aFileName );
- (*
- if ReadTXTHeader( aFileName ) then
+ if ReadTXTHeader(aFileName) then
begin
LoadSong();
end
@@ -218,45 +259,189 @@ begin
Log.LogError('Error Loading SongHeader, abort Song Loading');
Exit;
end;
- *)
+ end;
+ *)
+end;
+
+function TSong.FindSongFile(Dir: IPath; Mask: UTF8String): IPath;
+var
+ Iter: IFileIterator;
+ FileInfo: TFileInfo;
+ FileName: IPath;
+begin
+ Iter := FileSystem.FileFind(Dir.Append(Mask), faDirectory);
+ if (Iter.HasNext) then
+ Result := Iter.Next.Name
+ else
+ Result := PATH_NONE;
+end;
+
+function TSong.DecodeFilename(Filename: RawByteString): IPath;
+begin
+ Result := UPath.Path(DecodeStringUTF8(Filename, Encoding));
+end;
+
+type
+ EUSDXParseException = class(Exception);
+
+{**
+ * Parses the Line string starting from LinePos for a parameter.
+ * Leading whitespace is trimmed, same applies to the first trailing whitespace.
+ * After the call LinePos will point to the position after the first trailing
+ * whitespace.
+ *
+ * Raises an EUSDXParseException if no string was found.
+ *
+ * Example:
+ * ParseLyricParam(Line:'Param0 Param1 Param2', LinePos:8, ...)
+ * -> Param:'Param1', LinePos:16 (= start of 'Param2')
+ *}
+function TSong.ParseLyricStringParam(const Line: RawByteString; var LinePos: integer): RawByteString;
+var
+ Start: integer;
+ OldLinePos: integer;
+const
+ Whitespace = [#9, ' '];
+begin
+ OldLinePos := LinePos;
+
+ Start := 0;
+ while (LinePos <= Length(Line)) do
+ begin
+ if (Line[LinePos] in Whitespace) then
+ begin
+ // check for end of param
+ if (Start > 0) then
+ Break;
+ end
+ // check for beginning of param
+ else if (Start = 0) then
+ begin
+ Start := LinePos;
+ end;
+ Inc(LinePos);
+ end;
+
+ // check if param was found
+ if (Start = 0) then
+ begin
+ LinePos := OldLinePos;
+ raise EUSDXParseException.Create('String expected');
+ end
+ else
+ begin
+ // copy param without trailing whitespace
+ Result := Copy(Line, Start, LinePos-Start);
+ // skip first trailing whitespace (if not at EOL)
+ if (LinePos <= Length(Line)) then
+ Inc(LinePos);
+ end;
+end;
+
+function TSong.ParseLyricIntParam(const Line: RawByteString; var LinePos: integer): integer;
+var
+ Str: RawByteString;
+ OldLinePos: integer;
+begin
+ OldLinePos := LinePos;
+ Str := ParseLyricStringParam(Line, LinePos);
+
+ if not TryStrToInt(Str, Result) then
+ begin // on convert error
+ Result := 0;
+ LinePos := OldLinePos;
+ raise EUSDXParseException.Create('Integer expected');
+ end;
+end;
+
+function TSong.ParseLyricFloatParam(const Line: RawByteString; var LinePos: integer): extended;
+var
+ Str: RawByteString;
+ OldLinePos: integer;
+begin
+ OldLinePos := LinePos;
+ Str := ParseLyricStringParam(Line, LinePos);
+
+ if not TryStrToFloat(Str, Result) then
+ begin // on convert error
+ Result := 0;
+ LinePos := OldLinePos;
+ raise EUSDXParseException.Create('Float expected');
end;
end;
-{function TSong.LoadSong(): boolean;
+function TSong.ParseLyricCharParam(const Line: RawByteString; var LinePos: integer): AnsiChar;
+var
+ Str: RawByteString;
+ OldLinePos: integer;
begin
+ OldLinePos := LinePos;
+ Str := ParseLyricStringParam(Line, LinePos);
+
+ if (Length(Str) < 1) then
+ begin
+ LinePos := OldLinePos;
+ raise EUSDXParseException.Create('Character expected');
+ end
+ else if (Length(Str) > 1) then
+ begin
+ Log.LogWarn(Format('"%s" in line %d: %s',
+ [FileName.ToNative, FileLineNo, 'character expected but found "' + Str + '"']),
+ 'TSong.ParseLyricCharParam');
+ end;
+
+ LinePos := OldLinePos + 1;
+ Result := Str[1];
+end;
-end; }
+{**
+ * Returns the rest of the line from LinePos as lyric text.
+ * Leading and trailing whitespace is not trimmed.
+ *}
+function TSong.ParseLyricText(const Line: RawByteString; var LinePos: integer): RawByteString;
+begin
+ if (LinePos > Length(Line)) then
+ Result := ''
+ else
+ begin
+ Result := Copy(Line, LinePos, Length(Line)-LinePos+1);
+ LinePos := Length(Line)+1;
+ end;
+end;
//Load TXT Song
function TSong.LoadSong(): boolean;
-
var
- TempC: char;
- Text: string;
- CP: integer; // Current Player (0 or 1)
+ CurLine: RawByteString;
+ LinePos: integer;
Count: integer;
Both: boolean;
- Param1: integer;
- Param2: integer;
- Param3: integer;
- ParamS: string;
- I: integer;
+ Param0: AnsiChar;
+ Param1: integer;
+ Param2: integer;
+ Param3: integer;
+ ParamLyric: UTF8String;
+
+ I: integer;
+ NotesFound: boolean;
+ SongFile: TTextFileStream;
+ FileNamePath: IPath;
begin
Result := false;
LastError := '';
- if not FileExists(Path + PathDelim + FileName) then
+ FileNamePath := Path.Append(FileName);
+ if not FileNamePath.IsFile() then
begin
LastError := 'ERROR_CORRUPT_SONG_FILE_NOT_FOUND';
- Log.LogError('File not found: "' + Path + PathDelim + FileName + '"', 'TSong.LoadSong()');
- exit;
+ Log.LogError('File not found: "' + FileNamePath.ToNative + '"', 'TSong.LoadSong()');
+ Exit;
end;
MultBPM := 4; // multiply beat-count of note by 4
Mult := 1; // accuracy of measurement of note
Rel[0] := 0;
- CP := 0;
Both := false;
if Length(Player) = 2 then
@@ -264,156 +449,157 @@ begin
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);
-
- FileLineNo := 0;
- //Search for Note Begining
- repeat
- ReadLn(SongFile, Text);
- Inc(FileLineNo);
+ SongFile := TMemTextFileStream.Create(FileNamePath, fmOpenRead);
+ try
+ //Search for Note Beginning
+ FileLineNo := 0;
+ NotesFound := false;
+ while (SongFile.ReadLine(CurLine)) do
+ begin
+ Inc(FileLineNo);
+ if (Length(CurLine) > 0) and (CurLine[1] in [':', 'F', '*']) then
+ begin
+ NotesFound := true;
+ Break;
+ end;
+ end;
- if (EoF(SongFile)) then
+ if (not NotesFound) then
begin //Song File Corrupted - No Notes
- CloseFile(SongFile);
- Log.LogError('Could not load txt File, no Notes found: ' + FileName);
+ Log.LogError('Could not load txt File, no notes found: ' + FileNamePath.ToNative);
LastError := 'ERROR_CORRUPT_SONG_NO_NOTES';
Exit;
end;
- Read(SongFile, TempC);
- until ((TempC = ':') or (TempC = 'F') or (TempC = '*'));
- SetLength(Lines, 2);
- for Count := 0 to High(Lines) do
- begin
- Lines[Count].High := 0;
- Lines[Count].Number := 1;
- Lines[Count].Current := 0;
- Lines[Count].Resolution := self.Resolution;
- Lines[Count].NotesGAP := self.NotesGAP;
- Lines[Count].ScoreValue := 0;
-
- //Add first line and set some standard values to fields
- //see procedure NewSentence for further explantation
- //concerning most of these values
- SetLength(Lines[Count].Line, 1);
- Lines[Count].Line[0].HighNote := -1;
- Lines[Count].Line[0].LastLine := false;
- Lines[Count].Line[0].BaseNote := High(Integer);
- Lines[Count].Line[0].TotalNotes := 0;
- end;
-
- 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
-
- else if TempC = '-' then
+ SetLength(Lines, 2);
+ for Count := 0 to High(Lines) do
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
+ Lines[Count].High := 0;
+ Lines[Count].Number := 1;
+ Lines[Count].Current := 0;
+ Lines[Count].Resolution := self.Resolution;
+ Lines[Count].NotesGAP := self.NotesGAP;
+ Lines[Count].ScoreValue := 0;
+
+ //Add first line and set some standard values to fields
+ //see procedure NewSentence for further explantation
+ //concerning most of these values
+ SetLength(Lines[Count].Line, 1);
+ Lines[Count].Line[0].HighNote := -1;
+ Lines[Count].Line[0].LastLine := false;
+ Lines[Count].Line[0].BaseNote := High(Integer);
+ Lines[Count].Line[0].TotalNotes := 0;
+ end;
- else if TempC = 'B' then
+ while true do
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];
+ LinePos := 1;
- 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;
+ Param0 := ParseLyricCharParam(CurLine, LinePos);
+ if (Param0 = 'E') then
+ begin
+ Break
+ end
+ else if (Param0 in [':', '*', 'F']) then
+ begin
+ // read notes
+ Param1 := ParseLyricIntParam(CurLine, LinePos);
+ Param2 := ParseLyricIntParam(CurLine, LinePos);
+ Param3 := ParseLyricIntParam(CurLine, LinePos);
+ ParamLyric := ParseLyricText(CurLine, LinePos);
+
+ //Check for ZeroNote
+ if Param2 = 0 then
+ Log.LogWarn(Format('"%s" in line %d: %s',
+ [FileNamePath.ToNative, FileLineNo, 'found note with length zero -> note ignored']), 'TSong.LoadSong')
+ //Log.LogError('Found zero-length note at "'+Param0+' '+IntToStr(Param1)+' '+IntToStr(Param2)+' '+IntToStr(Param3)+ParamLyric+'" -> Note ignored!')
+ else
+ begin
+ // add notes
+ if not Both then
+ // P1
+ ParseNote(0, Param0, (Param1+Rel[0]) * Mult, Param2 * Mult, Param3, ParamLyric)
+ else
+ begin
+ // P1 + P2
+ ParseNote(0, Param0, (Param1+Rel[0]) * Mult, Param2 * Mult, Param3, ParamLyric);
+ ParseNote(1, Param0, (Param1+Rel[1]) * Mult, Param2 * Mult, Param3, ParamLyric);
+ end;
+ end; //Zeronote check
+ end // if
+
+ else if Param0 = '-' then
+ begin
+ // reads sentence
+ Param1 := ParseLyricIntParam(CurLine, LinePos);
+ if self.Relative then
+ Param2 := ParseLyricIntParam(CurLine, LinePos); // 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
- ReadLn(SongFile); //Jump to next line in File, otherwise the next Read would catch the linebreak(e.g. #13 #10 on win32)
+ else if Param0 = 'B' then
+ begin
+ SetLength(self.BPM, Length(self.BPM) + 1);
+ self.BPM[High(self.BPM)].StartBeat := ParseLyricFloatParam(CurLine, LinePos);
+ self.BPM[High(self.BPM)].StartBeat := self.BPM[High(self.BPM)].StartBeat + Rel[0];
- Read(SongFile, TempC);
- Inc(FileLineNo);
- end; // while}
+ self.BPM[High(self.BPM)].BPM := ParseLyricFloatParam(CurLine, LinePos);
+ self.BPM[High(self.BPM)].BPM := self.BPM[High(self.BPM)].BPM * Mult * MultBPM;
+ end;
- CloseFile(SongFile);
+ // Read next line in File
+ if (not SongFile.ReadLine(CurLine)) then
+ Break;
- for I := 0 to High(Lines) do
+ Inc(FileLineNo);
+ end; // while
+ finally
+ SongFile.Free;
+ end;
+ except
+ on E: Exception do
begin
- if ((Both) or (I = 0)) then
- begin
- if (Length(Lines[I].Line) < 2) then
- begin
- LastError := 'ERROR_CORRUPT_SONG_NO_BREAKS';
- Log.LogError('Error Loading File, Can''t find any Linebreaks: "' + fFileName + '"');
- exit;
- end;
-
- if (Lines[I].Line[Lines[I].High].HighNote < 0) then
- begin
- SetLength(Lines[I].Line, Lines[I].Number - 1);
- Lines[I].High := Lines[I].High - 1;
- Lines[I].Number := Lines[I].Number - 1;
- Log.LogError('Error loading Song, sentence w/o note found in last line before E: ' + Filename);
- end;
- end;
+ Log.LogError(Format('Error loading file: "%s" in line %d,%d: %s',
+ [FileNamePath.ToNative, FileLineNo, LinePos, E.Message]));
+ Exit;
end;
+ end;
- for Count := 0 to High(Lines) do
+ for I := 0 to High(Lines) do
+ begin
+ if ((Both) or (I = 0)) then
begin
- if (High(Lines[Count].Line) >= 0) then
- Lines[Count].Line[High(Lines[Count].Line)].LastLine := true;
- end;
- except
- try
- CloseFile(SongFile);
- except
+ if (Length(Lines[I].Line) < 2) then
+ begin
+ LastError := 'ERROR_CORRUPT_SONG_NO_BREAKS';
+ Log.LogError('Error loading file: Can''t find any linebreaks in "' + FileNamePath.ToNative + '"');
+ exit;
+ end;
+ if (Lines[I].Line[Lines[I].High].HighNote < 0) then
+ begin
+ SetLength(Lines[I].Line, Lines[I].Number - 1);
+ Lines[I].High := Lines[I].High - 1;
+ Lines[I].Number := Lines[I].Number - 1;
+ Log.LogError('Error loading Song, sentence w/o note found in last line before E: ' + FileNamePath.ToNative);
+ end;
end;
+ end;
- LastError := 'ERROR_CORRUPT_SONG_ERROR_IN_LINE';
- Log.LogError('Error Loading File: "' + fFileName + '" in Line ' + inttostr(FileLineNo));
- exit;
+ for Count := 0 to High(Lines) do
+ begin
+ if (High(Lines[Count].Line) >= 0) then
+ Lines[Count].Line[High(Lines[Count].Line)].LastLine := true;
end;
Result := true;
@@ -421,11 +607,7 @@ 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;
@@ -438,14 +620,15 @@ var
NoteType: char;
SentenceEnd, Rest, Time: integer;
Parser: TParser;
-
+ FileNamePath: IPath;
begin
Result := false;
LastError := '';
- if not FileExists(Path + PathDelim + FileName) then
+ FileNamePath := Path.Append(FileName);
+ if not FileNamePath.IsFile() then
begin
- Log.LogError('File not found: "' + Path + PathDelim + FileName + '"', 'TSong.LoadSong()');
+ Log.LogError('File not found: "' + FileNamePath.ToNative + '"', 'TSong.LoadSong()');
exit;
end;
@@ -454,7 +637,6 @@ begin
Lines[0].ScoreValue := 0;
self.Relative := false;
Rel[0] := 0;
- CP := 0;
Both := false;
if Length(Player) = 2 then
@@ -484,7 +666,7 @@ begin
//Try to Parse the Song
- if Parser.ParseSong(Path + PathDelim + FileName) then
+ if Parser.ParseSong(FileNamePath) then
begin
//Writeln('XML Inputfile Parsed succesful');
@@ -551,7 +733,7 @@ begin
end
else
begin
- Log.LogError('Could not parse Inputfile: ' + Path + PathDelim + FileName);
+ Log.LogError('Could not parse inputfile: ' + FileNamePath.ToNative);
exit;
end;
@@ -563,14 +745,11 @@ begin
Result := true;
end;
-function TSong.ReadXMLHeader(const aFileName : WideString): boolean;
-
+function TSong.ReadXMLHeader(const aFileName : IPath): boolean;
var
- //Line, Identifier, Value: string;
- //Temp : word;
Done : byte;
Parser : TParser;
-
+ FileNamePath: IPath;
begin
Result := true;
Done := 0;
@@ -579,7 +758,8 @@ begin
Parser := TParser.Create;
Parser.Settings.DashReplacement := '~';
- if Parser.ParseSong(self.Path + self.FileName) then
+ FileNamePath := Self.Path.Append(Self.FileName);
+ if Parser.ParseSong(FileNamePath) then
begin
//-----------
//Required Attributes
@@ -598,9 +778,9 @@ begin
Done := Done or 2;
//MP3 File //Test if Exists
- self.Mp3 := platform.FindSongFile(Path, '*.mp3');
+ Self.Mp3 := FindSongFile(Self.Path, '*.mp3');
//Add Mp3 Flag to Done
- if (FileExists(self.Path + self.Mp3)) then
+ if (Self.Path.Append(Self.Mp3).IsFile()) then
Done := Done or 4;
//Beats per Minute
@@ -621,16 +801,16 @@ begin
self.GAP := Parser.SongInfo.Header.Gap;
//Cover Picture
- self.Cover := platform.FindSongFile(Path, '*[CO].jpg');
+ self.Cover := FindSongFile(Path, '*[CO].jpg');
//Background Picture
- self.Background := platform.FindSongFile(Path, '*[BG].jpg');
+ self.Background := FindSongFile(Path, '*[BG].jpg');
// Video File
// self.Video := Value
// Video Gap
- // self.VideoGAP := song_StrtoFloat( Value )
+ // self.VideoGAP := StrtoFloatI18n( Value )
//Genre Sorting
self.Genre := Parser.SongInfo.Header.Genre;
@@ -645,7 +825,7 @@ begin
self.Language := Parser.SongInfo.Header.Language;
end
else
- Log.LogError('File Incomplete or not SingStar XML (A): ' + aFileName);
+ Log.LogError('File incomplete or not SingStar XML (A): ' + aFileName.ToNative);
Parser.Free;
@@ -654,220 +834,297 @@ begin
begin
Result := false;
if (Done and 8) = 0 then //No BPM Flag
- Log.LogError('BPM Tag Missing: ' + self.FileName)
+ Log.LogError('BPM tag missing: ' + self.FileName.ToNative)
else if (Done and 4) = 0 then //No MP3 Flag
- Log.LogError('MP3 Tag/File Missing: ' + self.FileName)
+ Log.LogError('MP3 tag/file missing: ' + self.FileName.ToNative)
else if (Done and 2) = 0 then //No Artist Flag
- Log.LogError('Artist Tag Missing: ' + self.FileName)
+ Log.LogError('Artist tag missing: ' + self.FileName.ToNative)
else if (Done and 1) = 0 then //No Title Flag
- Log.LogError('Title Tag Missing: ' + self.FileName)
+ Log.LogError('Title tag missing: ' + self.FileName.ToNative)
else //unknown Error
- Log.LogError('File Incomplete or not SingStar XML (B - '+ inttostr(Done) +'): ' + aFileName);
+ Log.LogError('File incomplete or not SingStar XML (B - '+ inttostr(Done) +'): ' + aFileName.ToNative);
end;
end;
+{**
+ * "International" StrToFloat variant. Uses either ',' or '.' as decimal
+ * separator.
+ *}
+function StrToFloatI18n(const Value: string): extended;
+var
+ TempValue : string;
+begin
+ TempValue := Value;
+ if (Pos(',', TempValue) <> 0) then
+ TempValue[Pos(',', TempValue)] := '.';
+ Result := StrToFloatDef(TempValue, 0);
+end;
-function TSong.ReadTXTHeader(const aFileName : WideString): boolean;
-
- function song_StrtoFloat( aValue : string ) : extended;
-
- var
- lValue : string;
-
+function TSong.ReadTXTHeader(SongFile: TTextFileStream; ReadCustomTags: Boolean): boolean;
+var
+ Line, Identifier: string;
+ Value: string;
+ SepPos: integer; // separator position
+ Done: byte; // bit-vector of mandatory fields
+ EncFile: IPath; // encoded filename
+ FullFileName: string;
+
+ { adds a custom header tag to the song
+ if there is no ':' in the read line, Tag should be empty
+ and the whole line should be in Content }
+ procedure AddCustomTag(const Tag, Content: String);
+ var Len: Integer;
begin
- lValue := aValue;
-
- if (Pos(',', lValue) <> 0) then
- lValue[Pos(',', lValue)] := '.';
-
- Result := StrToFloatDef(lValue, 0);
+ if ReadCustomTags then
+ begin
+ Len := Length(CustomTags);
+ SetLength(CustomTags, Len + 1);
+ CustomTags[Len].Tag := DecodeStringUTF8(Tag, Encoding);
+ CustomTags[Len].Content := DecodeStringUTF8(Content, Encoding);
+ end;
end;
-
-var
- Line, Identifier, Value: string;
- Temp : word;
- Done : byte;
-
begin
Result := true;
Done := 0;
- //Read first Line
- ReadLn (SongFile, Line);
+ FullFileName := Path.Append(Filename).ToNative;
+ //Read first Line
+ SongFile.ReadLine(Line);
if (Length(Line) <= 0) then
begin
- Log.LogError('File Starts with Empty Line: ' + aFileName);
+ Log.LogError('File starts with empty line: ' + FullFileName,
+ 'TSong.ReadTXTHeader');
Result := false;
Exit;
end;
+ // check if file begins with a UTF-8 BOM, if so set encoding to UTF-8
+ if (CheckReplaceUTF8BOM(Line)) then
+ Encoding := encUTF8;
+
//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);
+ SepPos := Pos(':', Line);
- //Line has a Seperator-> Headerline
- if (Temp <> 0) then
+ //Line has no Seperator, ignore non header field
+ if (SepPos = 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
+ AddCustomTag('', Copy(Line, 2, Length(Line) - 1));
+ // read next line
+ if (not SongFile.ReadLine(Line)) then
begin
- //-----------
- //Required Attributes
- //-----------
+ Result := false;
+ Log.LogError('File incomplete or not Ultrastar txt (A): ' + FullFileName);
+ Break;
+ end;
+ Continue;
+ end;
- {$IFDEF UTF8_FILENAMES}
- if ((Identifier = 'MP3') or (Identifier = 'BACKGROUND') or (Identifier = 'COVER') or (Identifier = 'VIDEO')) then
- Value := Utf8Encode(Value);
- {$ENDIF}
+ //Read Identifier and Value
+ Identifier := UpperCase(Trim(Copy(Line, 2, SepPos - 2))); //Uppercase is for Case Insensitive Checks
+ Value := Trim(Copy(Line, SepPos + 1, Length(Line) - SepPos));
- //Title
- if (Identifier = 'TITLE') then
- begin
- self.Title := Value;
+ //Check the Identifier (If Value is given)
+ if (Length(Value) = 0) then
+ begin
+ Log.LogInfo('Empty field "'+Identifier+'" in file ' + FullFileName,
+ 'TSong.ReadTXTHeader');
+ AddCustomTag(Identifier, '');
+ end
+ else
+ begin
- //Add Title Flag to Done
- Done := Done or 1;
- end
+ //-----------
+ //Required Attributes
+ //-----------
- //Artist
- else if (Identifier = 'ARTIST') then
- begin
- self.Artist := Value;
+ if (Identifier = 'TITLE') then
+ begin
+ DecodeStringUTF8(Value, Title, Encoding);
+ //Add Title Flag to Done
+ Done := Done or 1;
+ end
- //Add Artist Flag to Done
- Done := Done or 2;
- end
+ else if (Identifier = 'ARTIST') then
+ begin
+ DecodeStringUTF8(Value, Artist, Encoding);
+ //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
+ //MP3 File
+ else if (Identifier = 'MP3') then
+ begin
+ EncFile := DecodeFilename(Value);
+ if (Self.Path.Append(EncFile).IsFile) then
begin
- self.Mp3 := Value;
+ self.Mp3 := EncFile;
//Add Mp3 Flag to Done
Done := Done or 4;
- end
+ end;
+ end
+
+ //Beats per Minute
+ else if (Identifier = 'BPM') then
+ begin
+ SetLength(self.BPM, 1);
+ self.BPM[0].StartBeat := 0;
- //Beats per Minute
- else if (Identifier = 'BPM') then
+ self.BPM[0].BPM := StrToFloatI18n( Value ) * Mult * MultBPM;
+
+ if self.BPM[0].BPM <> 0 then
begin
- SetLength(self.BPM, 1);
- self.BPM[0].StartBeat := 0;
+ //Add BPM Flag to Done
+ Done := Done or 8;
+ end;
+ end
- self.BPM[0].BPM := song_StrtoFloat( Value ) * Mult * MultBPM;
+ //---------
+ //Additional Header Information
+ //---------
- if self.BPM[0].BPM <> 0 then
- begin
- //Add BPM Flag to Done
- Done := Done or 8;
- end;
- end
+ // Gap
+ else if (Identifier = 'GAP') then
+ begin
+ self.GAP := StrToFloatI18n(Value);
+ end
- //---------
- //Additional Header Information
- //---------
+ //Cover Picture
+ else if (Identifier = 'COVER') then
+ begin
+ self.Cover := DecodeFilename(Value);
+ end
- // Gap
- else if (Identifier = 'GAP') then
- self.GAP := song_StrtoFloat( Value )
+ //Background Picture
+ else if (Identifier = 'BACKGROUND') then
+ begin
+ self.Background := DecodeFilename(Value);
+ end
- //Cover Picture
- else if (Identifier = 'COVER') then
- self.Cover := Value
+ // Video File
+ else if (Identifier = 'VIDEO') then
+ begin
+ EncFile := DecodeFilename(Value);
+ if (self.Path.Append(EncFile).IsFile) then
+ self.Video := EncFile
+ else
+ Log.LogError('Can''t find video file in song: ' + FullFileName);
+ end
- //Background Picture
- else if (Identifier = 'BACKGROUND') then
- self.Background := Value
+ // Video Gap
+ else if (Identifier = 'VIDEOGAP') then
+ begin
+ self.VideoGAP := StrToFloatI18n( Value )
+ end
- // 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
+ //Genre Sorting
+ else if (Identifier = 'GENRE') then
+ begin
+ DecodeStringUTF8(Value, Genre, Encoding)
+ end
- // Video Gap
- else if (Identifier = 'VIDEOGAP') then
- self.VideoGAP := song_StrtoFloat( Value )
+ //Edition Sorting
+ else if (Identifier = 'EDITION') then
+ begin
+ DecodeStringUTF8(Value, Edition, Encoding)
+ end
- //Genre Sorting
- else if (Identifier = 'GENRE') then
- self.Genre := Value
+ //Creator Tag
+ else if (Identifier = 'CREATOR') then
+ begin
+ DecodeStringUTF8(Value, Creator, Encoding)
+ end
- //Edition Sorting
- else if (Identifier = 'EDITION') then
- self.Edition := Value
+ //Language Sorting
+ else if (Identifier = 'LANGUAGE') then
+ begin
+ DecodeStringUTF8(Value, Language, Encoding)
+ end
- //Creator Tag
- else if (Identifier = 'CREATOR') then
- self.Creator := Value
+ //Language Sorting
+ else if (Identifier = 'YEAR') then
+ begin
+ TryStrtoInt(Value, self.Year)
+ end
- //Language Sorting
- else if (Identifier = 'LANGUAGE') then
- self.Language := Value
+ // Song Start
+ else if (Identifier = 'START') then
+ begin
+ self.Start := StrToFloatI18n( Value )
+ end
- // Song Start
- else if (Identifier = 'START') then
- self.Start := song_StrtoFloat( Value )
+ // Song Ending
+ else if (Identifier = 'END') then
+ begin
+ TryStrtoInt(Value, self.Finish)
+ end
- // Song Ending
- else if (Identifier = 'END') then
- TryStrtoInt(Value, self.Finish)
+ // Resolution
+ else if (Identifier = 'RESOLUTION') then
+ begin
+ TryStrtoInt(Value, self.Resolution)
+ end
- // Resolution
- else if (Identifier = 'RESOLUTION') then
- TryStrtoInt(Value, self.Resolution)
+ // Notes Gap
+ else if (Identifier = 'NOTESGAP') then
+ begin
+ TryStrtoInt(Value, self.NotesGAP)
+ end
- // Notes Gap
- else if (Identifier = 'NOTESGAP') then
- TryStrtoInt(Value, self.NotesGAP)
- // Relative Notes
- else if (Identifier = 'RELATIVE') and (uppercase(Value) = 'YES') then
+ // Relative Notes
+ else if (Identifier = 'RELATIVE') then
+ begin
+ if (UpperCase(Value) = 'YES') then
self.Relative := true;
+ end
+ // File encoding
+ else if (Identifier = 'ENCODING') then
+ begin
+ self.Encoding := ParseEncoding(Value, DEFAULT_ENCODING);
+ end
+
+ // unsupported tag
+ else
+ begin
+ AddCustomTag(Identifier, Value);
end;
- end;
- if not EOF(SongFile) then
- ReadLn (SongFile, Line)
- else
+ end; // End check for non-empty Value
+
+ // read next line
+ if (not SongFile.ReadLine(Line)) then
begin
Result := false;
- Log.LogError('File Incomplete or not Ultrastar TxT (A): ' + aFileName);
- break;
+ Log.LogError('File incomplete or not Ultrastar txt (A): ' + FullFileName);
+ Break;
end;
+ end; // while
- end;
-
- if self.Cover = '' then
- self.Cover := platform.FindSongFile(Path, '*[CO].jpg');
+ if self.Cover.IsUnset then
+ self.Cover := 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)
+ Log.LogError('BPM tag missing: ' + FullFileName)
else if (Done and 4) = 0 then //No MP3 Flag
- Log.LogError('MP3 Tag/File Missing: ' + self.FileName)
+ Log.LogError('MP3 tag/file missing: ' + FullFileName)
else if (Done and 2) = 0 then //No Artist Flag
- Log.LogError('Artist Tag Missing: ' + self.FileName)
+ Log.LogError('Artist tag missing: ' + FullFileName)
else if (Done and 1) = 0 then //No Title Flag
- Log.LogError('Title Tag Missing: ' + self.FileName)
+ Log.LogError('Title tag missing: ' + FullFileName)
else //unknown Error
- Log.LogError('File Incomplete or not Ultrastar TxT (B - '+ inttostr(Done) +'): ' + aFileName);
+ Log.LogError('File incomplete or not Ultrastar txt (B - '+ inttostr(Done) +'): ' + FullFileName);
end;
-
end;
function TSong.GetErrorLineNo: integer;
@@ -878,48 +1135,8 @@ begin
Result := -1;
end;
-procedure TSong.ParseNote(LineNumber: integer; TypeP: char; StartP, DurationP, NoteP: integer; LyricS: string);
-
+procedure TSong.ParseNote(LineNumber: integer; TypeP: char; StartP, DurationP, NoteP: integer; LyricS: UTF8String);
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);
@@ -956,14 +1173,9 @@ begin
if Note[HighNote].Tone < BaseNote then
BaseNote := Note[HighNote].Tone;
- //delete the space that seperates the notes pitch from its lyrics
- //it is left in the LyricS string because Read("some ordinal type") will
- //set the files pointer to the first whitespace character after the
- //ordinal string. Trim is no solution because it would cut the spaces
- //that seperate the words of the lyrics, too.
- Delete(LyricS, 1, 1);
+ Note[HighNote].Color := 1; // default color to 1 for editor
- Note[HighNote].Text := LyricS;
+ DecodeStringUTF8(LyricS, Note[HighNote].Text, Encoding);
Lyric := Lyric + Note[HighNote].Text;
End_ := Note[HighNote].Start + Note[HighNote].Length;
@@ -971,10 +1183,8 @@ begin
end;
procedure TSong.NewSentence(LineNumberP: integer; Param1, Param2: integer);
-
var
I: integer;
-
begin
if (Lines[LineNumberP].Line[Lines[LineNumberP].High].HighNote <> -1) then
@@ -985,7 +1195,8 @@ begin
end
else
begin //use old line if it there were no notes added since last call of NewSentence
- Log.LogError('Error loading Song, sentence w/o note found in line ' + InttoStr(FileLineNo) + ': ' + Filename);
+ Log.LogError('Error loading Song, sentence w/o note found in line ' +
+ InttoStr(FileLineNo) + ': ' + Filename.ToNative);
end;
Lines[LineNumberP].Line[Lines[LineNumberP].High].HighNote := -1;
@@ -1012,8 +1223,7 @@ begin
Lines[LineNumberP].Line[Lines[LineNumberP].High].LastLine := false;
end;
-procedure TSong.clear();
-
+procedure TSong.Clear();
begin
//Main Information
Title := '';
@@ -1022,24 +1232,27 @@ begin
//Sortings:
Genre := 'Unknown';
Edition := 'Unknown';
- Language := 'Unknown'; //Language Patch
+ Language := 'Unknown';
+ Year := 0;
+
+ // set to default encoding
+ Encoding := DEFAULT_ENCODING;
+
+ // clear custom header tags
+ SetLength(CustomTags, 0);
//Required Information
- Mp3 := '';
- {$IFDEF FPC}
- setlength( BPM, 0 );
- {$ELSE}
- BPM := nil;
- {$ENDIF}
+ Mp3 := PATH_NONE;
+ SetLength(BPM, 0);
GAP := 0;
Start := 0;
Finish := 0;
//Additional Information
- Background := '';
- Cover := '';
- Video := '';
+ Background := PATH_NONE;
+ Cover := PATH_NONE;
+ Video := PATH_NONE;
VideoGAP := 0;
NotesGAP := 0;
Resolution := 4;
@@ -1048,8 +1261,9 @@ begin
Relative := false;
end;
-function TSong.Analyse(): boolean;
-
+function TSong.Analyse(const ReadCustomTags: Boolean): boolean;
+var
+ SongFile: TTextFileStream;
begin
Result := false;
@@ -1057,20 +1271,15 @@ begin
FileLineNo := 0;
//Open File and set File Pointer to the beginning
- AssignFile(SongFile, self.Path + self.FileName);
-
+ SongFile := TMemTextFileStream.Create(Self.Path.Append(Self.FileName), fmOpenRead);
try
- Reset(SongFile);
-
//Clear old Song Header
- self.clear;
+ Self.clear;
//Read Header
- Result := self.ReadTxTHeader( FileName )
-
- //And Close File
+ Result := Self.ReadTxTHeader(SongFile, ReadCustomTags)
finally
- CloseFile(SongFile);
+ SongFile.Free;
end;
end;
diff --git a/cmake/src/base/USongs.pas b/cmake/src/base/USongs.pas
index a7231cb3..cfc32a99 100644
--- a/cmake/src/base/USongs.pas
+++ b/cmake/src/base/USongs.pas
@@ -40,32 +40,36 @@ interface
{$ENDIF}
uses
+ SysUtils,
+ Classes,
{$IFDEF MSWINDOWS}
Windows,
DirWatch,
{$ELSE}
{$IFNDEF DARWIN}
- syscall,
+ syscall,
{$ENDIF}
baseunix,
UnixType,
{$ENDIF}
- SysUtils,
- Classes,
UPlatform,
ULog,
UTexture,
UCommon,
- {$IFDEF DARWIN}
- cthreads,
- {$ENDIF}
{$IFDEF USE_PSEUDO_THREAD}
- PseudoThread,
+ PseudoThread,
{$ENDIF}
+ UPath,
USong,
+ UIni,
UCatCovers;
type
+ TSongFilter = (
+ fltAll,
+ fltTitle,
+ fltArtist
+ );
TBPM = record
BPM: real;
@@ -73,11 +77,13 @@ type
end;
TScore = record
- Name: widestring;
+ Name: UTF8String;
Score: integer;
Length: string;
end;
+ TPathDynArray = array of IPath;
+
{$IFDEF USE_PSEUDO_THREAD}
TSongs = class(TPseudoThread)
{$ELSE}
@@ -102,11 +108,11 @@ type
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;
+ procedure FindFilesByExtension(const Dir: IPath; const Ext: IPath; Recursive: Boolean; var Files: TPathDynArray);
+ procedure BrowseDir(Dir: IPath); // should return number of songs in the future
+ procedure BrowseTXTFiles(Dir: IPath);
+ procedure BrowseXMLFiles(Dir: IPath);
+ procedure Sort(Order: TSortingType);
property Processing: boolean read fProcessing;
end;
@@ -128,7 +134,7 @@ type
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;
+ function SetFilter(FilterStr: UTF8String; Filter: TSongFilter): cardinal;
end;
var
@@ -156,9 +162,11 @@ uses
UCovers,
UFiles,
UGraphic,
- UIni,
- UPath,
- UNote;
+ UMain,
+ UPathUtils,
+ UNote,
+ UFilesystem,
+ UUnicodeUtils;
constructor TSongs.Create();
begin
@@ -232,7 +240,7 @@ begin
// browse directories
for I := 0 to SongPaths.Count-1 do
- BrowseDir(SongPaths[I]);
+ BrowseDir(SongPaths[I] as IPath);
if assigned(CatSongs) then
CatSongs.Refresh;
@@ -264,84 +272,92 @@ begin
Resume();
end;
-procedure TSongs.BrowseDir(Dir: widestring);
+procedure TSongs.BrowseDir(Dir: IPath);
begin
BrowseTXTFiles(Dir);
BrowseXMLFiles(Dir);
end;
-procedure TSongs.BrowseTXTFiles(Dir: widestring);
+procedure TSongs.FindFilesByExtension(const Dir: IPath; const Ext: IPath; Recursive: Boolean; var Files: TPathDynArray);
var
- i: integer;
- Files: TDirectoryEntryArray;
- lSong: TSong;
+ Iter: IFileIterator;
+ FileInfo: TFileInfo;
+ FileName: IPath;
begin
-
- try
- Files := Platform.DirectoryFindFiles(Dir, '.txt', true)
- except
- Log.LogError('Couldn''t deal with directory/file: ' + Dir + ' in TSongs.BrowseTXTFiles')
- end;
-
- for i := 0 to Length(Files) - 1 do
+ // search for all files and directories
+ Iter := FileSystem.FileFind(Dir.Append('*'), faAnyFile);
+ while (Iter.HasNext) do
begin
- if Files[i].IsDirectory then
+ FileInfo := Iter.Next;
+ FileName := FileInfo.Name;
+ if ((FileInfo.Attr and faDirectory) <> 0) then
begin
- BrowseTXTFiles(Dir + Files[i].Name + PathDelim); //Recursive Call
+ if Recursive and (not FileName.Equals('.')) and (not FileName.Equals('..')) then
+ FindFilesByExtension(Dir.Append(FileName), Ext, true, Files);
end
else
begin
- lSong := TSong.create(Dir + Files[i].Name);
-
- if lSong.Analyse then
- SongList.add(lSong)
- else
+ if (Ext.Equals(FileName.GetExtension(), true)) then
begin
- Log.LogError('AnalyseFile failed for "' + Files[i].Name + '".');
- freeandnil(lSong);
+ SetLength(Files, Length(Files)+1);
+ Files[High(Files)] := Dir.Append(FileName);
end;
-
end;
end;
- SetLength(Files, 0);
-
end;
-procedure TSongs.BrowseXMLFiles(Dir: widestring);
+procedure TSongs.BrowseTXTFiles(Dir: IPath);
var
- i: integer;
- Files: TDirectoryEntryArray;
- lSong: TSong;
+ I: integer;
+ Files: TPathDynArray;
+ Song: TSong;
+ Extension: IPath;
begin
+ SetLength(Files, 0);
+ Extension := Path('.txt');
+ FindFilesByExtension(Dir, Extension, true, Files);
- try
- Files := Platform.DirectoryFindFiles(Dir, '.xml', true)
- except
- Log.LogError('Couldn''t deal with directory/file: ' + Dir + ' in TSongs.BrowseXMLFiles')
- end;
-
- for i := 0 to Length(Files) - 1 do
+ for I := 0 to High(Files) do
begin
- if Files[i].IsDirectory then
- begin
- BrowseXMLFiles(Dir + Files[i].Name + PathDelim); // Recursive Call
- end
+ Song := TSong.Create(Files[I]);
+
+ if Song.Analyse then
+ SongList.Add(Song)
else
begin
- lSong := TSong.create(Dir + Files[i].Name);
+ Log.LogError('AnalyseFile failed for "' + Files[I].ToNative + '".');
+ FreeAndNil(Song);
+ end;
+ end;
- if lSong.AnalyseXML then
- SongList.add(lSong)
- else
- begin
- Log.LogError('AnalyseFile failed for "' + Files[i].Name + '".');
- freeandnil(lSong);
- end;
+ SetLength(Files, 0);
+end;
+procedure TSongs.BrowseXMLFiles(Dir: IPath);
+var
+ I: integer;
+ Files: TPathDynArray;
+ Song: TSong;
+ Extension: IPath;
+begin
+ SetLength(Files, 0);
+ Extension := Path('.xml');
+ FindFilesByExtension(Dir, Extension, true, Files);
+
+ for I := 0 to High(Files) do
+ begin
+ Song := TSong.Create(Files[I]);
+
+ if Song.AnalyseXML then
+ SongList.Add(Song)
+ else
+ begin
+ Log.LogError('AnalyseFile failed for "' + Files[I].ToNative + '".');
+ FreeAndNil(Song);
end;
end;
- SetLength(Files, 0);
+ SetLength(Files, 0);
end;
(*
@@ -350,35 +366,35 @@ end;
function CompareByEdition(Song1, Song2: Pointer): integer;
begin
- Result := CompareText(TSong(Song1).Edition, TSong(Song2).Edition);
+ Result := UTF8CompareText(TSong(Song1).Edition, TSong(Song2).Edition);
end;
function CompareByGenre(Song1, Song2: Pointer): integer;
begin
- Result := CompareText(TSong(Song1).Genre, TSong(Song2).Genre);
+ Result := UTF8CompareText(TSong(Song1).Genre, TSong(Song2).Genre);
end;
function CompareByTitle(Song1, Song2: Pointer): integer;
begin
- Result := CompareText(TSong(Song1).Title, TSong(Song2).Title);
+ Result := UTF8CompareText(TSong(Song1).Title, TSong(Song2).Title);
end;
function CompareByArtist(Song1, Song2: Pointer): integer;
begin
- Result := CompareText(TSong(Song1).Artist, TSong(Song2).Artist);
+ Result := UTF8CompareText(TSong(Song1).Artist, TSong(Song2).Artist);
end;
function CompareByFolder(Song1, Song2: Pointer): integer;
begin
- Result := CompareText(TSong(Song1).Folder, TSong(Song2).Folder);
+ Result := UTF8CompareText(TSong(Song1).Folder, TSong(Song2).Folder);
end;
function CompareByLanguage(Song1, Song2: Pointer): integer;
begin
- Result := CompareText(TSong(Song1).Language, TSong(Song2).Language);
+ Result := UTF8CompareText(TSong(Song1).Language, TSong(Song2).Language);
end;
-procedure TSongs.Sort(Order: integer);
+procedure TSongs.Sort(Order: TSortingType);
var
CompareFunc: TListSortCompare;
begin
@@ -394,8 +410,6 @@ begin
CompareFunc := CompareByArtist;
sFolder: // by folder
CompareFunc := CompareByFolder;
- sTitle2: // by title2
- CompareFunc := CompareByTitle;
sArtist2: // by artist2
CompareFunc := CompareByArtist;
sLanguage: // by Language
@@ -412,21 +426,9 @@ begin
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
+ case TSortingType(Ini.Sorting) of
sEdition: begin
Songs.Sort(sTitle);
Songs.Sort(sArtist);
@@ -454,12 +456,8 @@ begin
Songs.Sort(sTitle);
Songs.Sort(sArtist);
end;
- sTitle2: begin
- Songs.Sort(sArtist2);
- Songs.Sort(sTitle2);
- end;
sArtist2: begin
- Songs.Sort(sTitle2);
+ Songs.Sort(sTitle);
Songs.Sort(sArtist2);
end;
end; // case
@@ -469,14 +467,14 @@ 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);
+ CatIndex: integer; // index of current song in Song
+ Letter: UCS4Char; // current letter for sorting using letter
+ CurCategory: UTF8String; // current edition for sorting using edition, genre etc.
+ Order: integer; // number used for ordernum
+ LetterTmp: UCS4Char;
+ CatNumber: integer; // Number of Song in Category
+
+ procedure AddCategoryButton(const CategoryName: UTF8String);
var
PrevCatBtnIndex: integer;
begin
@@ -488,7 +486,7 @@ var
Song[CatIndex].Main := true;
Song[CatIndex].OrderTyp := 0;
Song[CatIndex].OrderNum := Order;
- Song[CatIndex].Cover := CatCovers.GetCover(Ini.Sorting, CategoryName);
+ Song[CatIndex].Cover := CatCovers.GetCover(TSortingType(Ini.Sorting), CategoryName);
Song[CatIndex].Visible := true;
// set number of songs in previous category
@@ -511,7 +509,7 @@ begin
// 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;
+ Letter := 0;
// clear song-list
for SongIndex := 0 to Songs.SongList.Count - 1 do
@@ -530,101 +528,102 @@ begin
// 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
+ case (TSortingType(Ini.Sorting)) of
+ sEdition: begin
+ if (CompareText(CurCategory, CurSong.Edition) <> 0) then
+ begin
+ CurCategory := CurSong.Edition;
+
+ // add Category Button
+ AddCategoryButton(CurCategory);
+ end;
+ 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
+ sGenre: begin
+ if (CompareText(CurCategory, CurSong.Genre) <> 0) then
+ begin
+ CurCategory := CurSong.Genre;
+ // add Genre Button
+ AddCategoryButton(CurCategory);
+ end;
+ end;
- else if (Ini.Sorting = sFolder) and
- (CompareText(CurCategory, CurSong.Folder) <> 0) then
- begin
- CurCategory := CurSong.Folder;
- // add folder tab
- AddCategoryButton(CurCategory);
- end
+ sLanguage: begin
+ if (CompareText(CurCategory, CurSong.Language) <> 0) then
+ begin
+ CurCategory := CurSong.Language;
+ // add Language Button
+ AddCategoryButton(CurCategory);
+ end
+ 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];
+ sTitle: begin
+ if (Length(CurSong.Title) >= 1) then
+ begin
+ LetterTmp := UCS4UpperCase(UTF8ToUCS4String(CurSong.Title)[0]);
+ { all numbers and some punctuation chars are put into a
+ category named '#'
+ we can't put the other punctuation chars into this category
+ because they are not in order, so there will be two different
+ categories named '#' }
+ if (LetterTmp in [Ord('!') .. Ord('?')]) then
+ LetterTmp := Ord('#')
+ else
+ LetterTmp := UCS4UpperCase(LetterTmp);
+ if (Letter <> LetterTmp) then
+ begin
+ Letter := LetterTmp;
+ // add a letter Category Button
+ AddCategoryButton(UCS4ToUTF8String(Letter));
+ end;
+ end;
+ end;
- if (Letter <> LetterTmp) then
- begin
- Letter := LetterTmp;
- // add a letter Category Button
- AddCategoryButton(Letter);
+ sArtist: begin
+ if (Length(CurSong.Artist) >= 1) then
+ begin
+ LetterTmp := UCS4UpperCase(UTF8ToUCS4String(CurSong.Artist)[0]);
+ { all numbers and some punctuation chars are put into a
+ category named '#'
+ we can't put the other punctuation chars into this category
+ because they are not in order, so there will be two different
+ categories named '#' }
+ if (LetterTmp in [Ord('!') .. Ord('?')]) then
+ LetterTmp := Ord('#')
+ else
+ LetterTmp := UCS4UpperCase(LetterTmp);
+
+ if (Letter <> LetterTmp) then
+ begin
+ Letter := LetterTmp;
+ // add a letter Category Button
+ AddCategoryButton(UCS4ToUTF8String(Letter));
+ end;
+ end;
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];
+ sFolder: begin
+ if (UTF8CompareText(CurCategory, CurSong.Folder) <> 0) then
+ begin
+ CurCategory := CurSong.Folder;
+ // add folder tab
+ AddCategoryButton(CurCategory);
+ end;
+ end;
- if (Letter <> LetterTmp) then
- begin
- Letter := LetterTmp;
- // add a letter Category Button
- AddCategoryButton(Letter);
+ sArtist2: begin
+ { this new sorting puts all songs by the same artist into
+ a single category }
+ if (UTF8CompareText(CurCategory, CurSong.Artist) <> 0) then
+ begin
+ CurCategory := CurSong.Artist;
+ // add folder tab
+ AddCategoryButton(CurCategory);
+ end;
end;
- end;
- end;
+
+ end; // case (Ini.Sorting)
+ end; // if (Ini.Tabs = 1)
CatIndex := Length(Song);
SetLength(Song, CatIndex+1);
@@ -728,14 +727,18 @@ var
I: integer;
begin
Result := -1;
- I := SearchFrom + 1;
- while not CatSongs.Song[I].Visible do
+ I := SearchFrom;
+ while (Result = -1) do
begin
Inc (I);
- if (I>high(CatSongs.Song)) then
- I := low(CatSongs.Song);
+
+ if (I > High(CatSongs.Song)) then
+ I := Low(CatSongs.Song);
if (I = SearchFrom) then // Make One Round and no song found->quit
- break;
+ Break;
+
+ if (CatSongs.Song[I].Visible) then
+ Result := I;
end;
end;
// Wrong song selected when tabs on bug End
@@ -771,58 +774,58 @@ begin
end;
end;
-function TCatSongs.SetFilter(FilterStr: string; const fType: byte): cardinal;
+function TCatSongs.SetFilter(FilterStr: UTF8String; Filter: TSongFilter): cardinal;
var
I, J: integer;
- cString: string;
- SearchStr: array of string;
+ TmpString: UTF8String;
+ WordArray: array of UTF8String;
begin
-{
- fType: 0: All
- 1: Title
- 2: Artist
-}
FilterStr := Trim(FilterStr);
- if FilterStr<>'' then
+ if (FilterStr <> '') then
begin
Result := 0;
- // Create Search Array
- SetLength(SearchStr, 1);
+
+ // initialize word array
+ SetLength(WordArray, 1);
+
+ // Copy words to SearchStr
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);
+ WordArray[High(WordArray)] := Copy(FilterStr, 1, I-1);
+ SetLength(WordArray, Length(WordArray) + 1);
- I := Pos (' ', FilterStr);
+ FilterStr := TrimLeft(Copy(FilterStr, I+1, Length(FilterStr)-I));
+ I := Pos(' ', FilterStr);
end;
- // Copy last Word
- if (FilterStr <> ' ') and (FilterStr <> '') then
- SearchStr[High(SearchStr)] := FilterStr;
+
+ // Copy last word
+ WordArray[High(WordArray)] := 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;
+ case Filter of
+ fltAll:
+ TmpString := Song[I].Artist + ' ' + Song[i].Title + ' ' + Song[i].Folder;
+ fltTitle:
+ TmpString := Song[I].Title;
+ fltArtist:
+ TmpString := Song[I].Artist;
end;
- Song[i].Visible:=true;
- // Look for every Searched Word
- for J := 0 to High(SearchStr) do
+ Song[i].Visible := true;
+ // Look for every searched word
+ for J := 0 to High(WordArray) do
begin
- Song[i].Visible := Song[i].Visible and AnsiContainsText(cString, SearchStr[J])
+ Song[i].Visible := Song[i].Visible and
+ UTF8ContainsText(TmpString, WordArray[J])
end;
if Song[i].Visible then
Inc(Result);
end
else
- Song[i].Visible:=false;
+ Song[i].Visible := false;
end;
CatNumShow := -2;
end
@@ -830,7 +833,7 @@ begin
begin
for i := 0 to High(Song) do
begin
- Song[i].Visible := (Ini.Tabs=1) = Song[i].Main;
+ Song[i].Visible := (Ini.Tabs = 1) = Song[i].Main;
CatNumShow := -1;
end;
Result := 0;
diff --git a/cmake/src/base/UTextEncoding.pas b/cmake/src/base/UTextEncoding.pas
index 6eec8eec..0c9ba4cc 100644
--- a/cmake/src/base/UTextEncoding.pas
+++ b/cmake/src/base/UTextEncoding.pas
@@ -19,8 +19,8 @@
* the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
* Boston, MA 02110-1301, USA.
*
- * $URL: https://ultrastardx.svn.sourceforge.net/svnroot/ultrastardx/trunk/src/menu/UMenuText.pas $
- * $Id: UMenuText.pas 1485 2008-10-28 20:16:05Z tobigun $
+ * $URL$
+ * $Id$
*}
unit UTextEncoding;
@@ -34,114 +34,215 @@ interface
{$I switches.inc}
uses
- SysUtils;
+ SysUtils,
+ UUnicodeUtils;
type
- TEncoding = (encCP1250, encCP1252, encUTF8, encNative);
+ TEncoding = (
+ encLocale, // current locale (needs cwstring on linux)
+ encUTF8, // UTF-8
+ encCP1250, // Windows-1250 Central/Eastern Europe (used by Ultrastar)
+ encCP1252, // Windows-1252 Western Europe (used by UltraStar Deluxe < 1.1)
+ encAuto // try to match the w3c regex and decode as unicode on match
+ // and as fallback if not match
+ );
+
+const
+ UTF8_BOM: UTF8String = #$EF#$BB#$BF;
+
+{**
+ * Decodes Src encoded in SrcEncoding to a UTF-16 or UTF-8 encoded Dst string.
+ * Returns true if the conversion was successful.
+ *}
+function DecodeString(const Src: RawByteString; out Dst: WideString; SrcEncoding: TEncoding): boolean; overload;
+function DecodeString(const Src: RawByteString; SrcEncoding: TEncoding): WideString; overload;
+function DecodeStringUTF8(const Src: RawByteString; out Dst: UTF8String; SrcEncoding: TEncoding): boolean; overload;
+function DecodeStringUTF8(const Src: RawByteString; SrcEncoding: TEncoding): UTF8String; overload;
+
+{**
+ * Encodes the UTF-16 or UTF-8 encoded Src string to Dst using DstEncoding
+ * Returns true if the conversion was successful.
+ *}
+function EncodeString(const Src: WideString; out Dst: RawByteString; DstEncoding: TEncoding): boolean; overload;
+function EncodeString(const Src: WideString; DstEncoding: TEncoding): RawByteString; overload;
+function EncodeStringUTF8(const Src: UTF8String; out Dst: RawByteString; DstEncoding: TEncoding): boolean; overload;
+function EncodeStringUTF8(const Src: UTF8String; DstEncoding: TEncoding): RawByteString; overload;
+
+{**
+ * If Text starts with an UTF-8 BOM, the BOM is removed and true will
+ * be returned.
+ *}
+function CheckReplaceUTF8BOM(var Text: RawByteString): boolean;
-function RecodeString(const Src: string; SrcEncoding: TEncoding): WideString;
+{**
+ * Parses an encoding string to its TEncoding equivalent.
+ * Surrounding whitespace and dashes ('-') are removed, the upper-cased
+ * resulting value is then compared with TEncodingNames.
+ * If the encoding was not found, the result is set to the Default encoding.
+ *}
+function ParseEncoding(const EncodingStr: AnsiString; Default: TEncoding): TEncoding;
+
+{**
+ * Returns the name of an encoding.
+ *}
+function EncodingName(Encoding: TEncoding): AnsiString;
implementation
+uses
+ StrUtils,
+ pcre,
+ UCommon,
+ ULog;
+
type
- TConversionTable = array[0..127] of WideChar;
+ IEncoder = interface
+ function GetName(): AnsiString;
+ function Encode(const InStr: UCS4String; out OutStr: RawByteString): boolean;
+ function Decode(const InStr: RawByteString; out OutStr: UCS4String): boolean;
+ end;
+
+ TEncoder = class(TInterfacedObject, IEncoder)
+ public
+ function GetName(): AnsiString; virtual; abstract;
+ function Encode(const InStr: UCS4String; out OutStr: RawByteString): boolean; virtual; abstract;
+ function Decode(const InStr: RawByteString; out OutStr: UCS4String): boolean; virtual; abstract;
+ end;
+
+ TSingleByteEncoder = class(TEncoder)
+ public
+ function Encode(const InStr: UCS4String; out OutStr: RawByteString): boolean; override;
+ function Decode(const InStr: RawByteString; out OutStr: UCS4String): boolean; override;
+ function DecodeChar(InChr: AnsiChar; out OutChr: UCS4Char): boolean; virtual; abstract;
+ function EncodeChar(InChr: UCS4Char; out OutChr: AnsiChar): boolean; virtual; abstract;
+ end;
const
- // Windows-1250 Central/Eastern Europe (used by Ultrastar)
- CP1250Table: TConversionTable = (
- { $80 }
- #$20AC, #0, #$201A, #0, #$201E, #$2026, #$2020, #$2021,
- #0, #$2030, #$0160, #$2039, #$015A, #$0164, #$017D, #$0179,
- { $90 }
- #0, #$2018, #$2019, #$201C, #$201D, #$2022, #$2013, #$2014,
- #0, #$2122, #$0161, #$203A, #$015B, #$0165, #$017E, #$017A,
- { $A0 }
- #$00A0, #$02C7, #$02D8, #$0141, #$00A4, #$0104, #$00A6, #$00A7,
- #$00A8, #$00A9, #$015E, #$00AB, #$00AC, #$00AD, #$00AE, #$017B,
- { $B0 }
- #$00B0, #$00B1, #$02DB, #$0142, #$00B4, #$00B5, #$00B6, #$00B7,
- #$00B8, #$0105, #$015F, #$00BB, #$013D, #$02DD, #$013E, #$017C,
- { $C0 }
- #$0154, #$00C1, #$00C2, #$0102, #$00C4, #$0139, #$0106, #$00C7,
- #$010C, #$00C9, #$0118, #$00CB, #$011A, #$00CD, #$00CE, #$010E,
- { $D0 }
- #$0110, #$0143, #$0147, #$00D3, #$00D4, #$0150, #$00D6, #$00D7,
- #$0158, #$016E, #$00DA, #$0170, #$00DC, #$00DD, #$0162, #$00DF,
- { $E0 }
- #$0155, #$00E1, #$00E2, #$0103, #$00E4, #$013A, #$0107, #$00E7,
- #$010D, #$00E9, #$0119, #$00EB, #$011B, #$00ED, #$00EE, #$010F,
- { $F0 }
- #$0111, #$0144, #$0148, #$00F3, #$00F4, #$0151, #$00F6, #$00F7,
- #$0159, #$016F, #$00FA, #$0171, #$00FC, #$00FD, #$0163, #$02D9
- );
+ ERROR_CHAR = '?';
- // Windows-1252 Western Europe (used by UltraStar Deluxe < 1.1)
- CP1252Table: TConversionTable = (
- { $80 }
- #$20AC, #0, #$201A, #$0192, #$201E, #$2026, #$2020, #$2021,
- #$02C6, #$2030, #$0160, #$2039, #$0152, #0, #$017D, #0,
- { $90 }
- #0, #$2018, #$2019, #$201C, #$201D, #$2022, #$2013, #$2014,
- #$02DC, #$2122, #$0161, #$203A, #$0153, #0, #$017E, #$0178,
- { $A0 }
- #$00A0, #$00A1, #$00A2, #$00A3, #$00A4, #$00A5, #$00A6, #$00A7,
- #$00A8, #$00A9, #$00AA, #$00AB, #$00AC, #$00AD, #$00AE, #$00AF,
- { $B0 }
- #$00B0, #$00B1, #$00B2, #$00B3, #$00B4, #$00B5, #$00B6, #$00B7,
- #$00B8, #$00B9, #$00BA, #$00BB, #$00BC, #$00BD, #$00BE, #$00BF,
- { $C0 }
- #$00C0, #$00C1, #$00C2, #$00C3, #$00C4, #$00C5, #$00C6, #$00C7,
- #$00C8, #$00C9, #$00CA, #$00CB, #$00CC, #$00CD, #$00CE, #$00CF,
- { $D0 }
- #$00D0, #$00D1, #$00D2, #$00D3, #$00D4, #$00D5, #$00D6, #$00D7,
- #$00D8, #$00D9, #$00DA, #$00DB, #$00DC, #$00DD, #$00DE, #$00DF,
- { $E0 }
- #$00E0, #$00E1, #$00E2, #$00E3, #$00E4, #$00E5, #$00E6, #$00E7,
- #$00E8, #$00E9, #$00EA, #$00EB, #$00EC, #$00ED, #$00EE, #$00EF,
- { $F0 }
- #$00F0, #$00F1, #$00F2, #$00F3, #$00F4, #$00F5, #$00F6, #$00F7,
- #$00F8, #$00F9, #$00FA, #$00FB, #$00FC, #$00FD, #$00FE, #$00FF
- );
+var
+ Encoders: array[TEncoding] of IEncoder;
+function TSingleByteEncoder.Encode(const InStr: UCS4String; out OutStr: RawByteString): boolean;
+var
+ I: integer;
+begin
+ SetLength(OutStr, LengthUCS4(InStr));
+ Result := true;
+ for I := 1 to Length(OutStr) do
+ begin
+ if (not EncodeChar(InStr[I-1], OutStr[I])) then
+ Result := false;
+ end;
+end;
-function Convert(const Src: string; const Table: TConversionTable): WideString;
+function TSingleByteEncoder.Decode(const InStr: RawByteString; out OutStr: UCS4String): boolean;
var
- SrcPos, DstPos: integer;
+ I: integer;
begin
- SetLength(Result, Length(Src));
- DstPos := 1;
- for SrcPos := 1 to Length(Src) do
+ SetLength(OutStr, Length(InStr)+1);
+ Result := true;
+ for I := 1 to Length(InStr) do
begin
- if (Src[SrcPos] < #128) then
- begin
- // copy ASCII char
- Result[DstPos] := Src[SrcPos];
- Inc(DstPos);
- end
- else
+ if (not DecodeChar(InStr[I], OutStr[I-1])) then
+ Result := false;
+ end;
+ OutStr[High(OutStr)] := 0;
+end;
+
+function DecodeString(const Src: RawByteString; out Dst: WideString; SrcEncoding: TEncoding): boolean;
+var
+ DstUCS4: UCS4String;
+begin
+ Result := Encoders[SrcEncoding].Decode(Src, DstUCS4);
+ Dst := UCS4StringToWideString(DstUCS4);
+end;
+
+function DecodeString(const Src: RawByteString; SrcEncoding: TEncoding): WideString;
+begin
+ DecodeString(Src, Result, SrcEncoding);
+end;
+
+function DecodeStringUTF8(const Src: RawByteString; out Dst: UTF8String; SrcEncoding: TEncoding): boolean;
+var
+ DstUCS4: UCS4String;
+begin
+ Result := Encoders[SrcEncoding].Decode(Src, DstUCS4);
+ Dst := UCS4ToUTF8String(DstUCS4);
+end;
+
+function DecodeStringUTF8(const Src: RawByteString; SrcEncoding: TEncoding): UTF8String;
+begin
+ DecodeStringUTF8(Src, Result, SrcEncoding);
+end;
+
+function EncodeString(const Src: WideString; out Dst: RawByteString; DstEncoding: TEncoding): boolean;
+begin
+ Result := Encoders[DstEncoding].Encode(WideStringToUCS4String(Src), Dst);
+end;
+
+function EncodeString(const Src: WideString; DstEncoding: TEncoding): RawByteString;
+begin
+ EncodeString(Src, Result, DstEncoding);
+end;
+
+function EncodeStringUTF8(const Src: UTF8String; out Dst: RawByteString; DstEncoding: TEncoding): boolean;
+begin
+ Result := Encoders[DstEncoding].Encode(UTF8ToUCS4String(Src), Dst);
+end;
+
+function EncodeStringUTF8(const Src: UTF8String; DstEncoding: TEncoding): RawByteString;
+begin
+ EncodeStringUTF8(Src, Result, DstEncoding);
+end;
+
+function CheckReplaceUTF8BOM(var Text: RawByteString): boolean;
+begin
+ if AnsiStartsStr(UTF8_BOM, Text) then
+ begin
+ Text := Copy(Text, Length(UTF8_BOM)+1, Length(Text)-Length(UTF8_BOM));
+ Result := true;
+ Exit;
+ end;
+ Result := false;
+end;
+
+function ParseEncoding(const EncodingStr: AnsiString; Default: TEncoding): TEncoding;
+var
+ PrepStr: AnsiString; // prepared encoding string
+ Encoding: TEncoding;
+begin
+ // remove surrounding whitespace, replace dashes, to upper case
+ PrepStr := UpperCase(AnsiReplaceStr(Trim(EncodingStr), '-', ''));
+ for Encoding := Low(TEncoding) to High(TEncoding) do
+ begin
+ if (Encoders[Encoding].GetName() = PrepStr) then
begin
- // look-up char
- Result[DstPos] := Table[Ord(Src[SrcPos]) - 128];
- // ignore invalid characters
- if (Result[DstPos] <> #0) then
- Inc(DstPos);
+ Result := Encoding;
+ Exit;
end;
end;
- SetLength(Result, DstPos-1);
+ Result := Default;
end;
-function RecodeString(const Src: string; SrcEncoding: TEncoding): WideString;
+function EncodingName(Encoding: TEncoding): AnsiString;
begin
- case SrcEncoding of
- encCP1250:
- Result := Convert(Src, CP1250Table);
- encCP1252:
- Result := Convert(Src, CP1252Table);
- encUTF8:
- Result := UTF8Decode(Src);
- encNative:
- Result := UTF8Decode(AnsiToUtf8(Src));
- end;
+ Result := Encoders[Encoding].GetName();
end;
+{$I ..\\encoding\\Locale.inc}
+{$I ..\\encoding\\UTF8.inc}
+{$I ..\\encoding\\CP1250.inc}
+{$I ..\\encoding\\CP1252.inc}
+{$I ..\\encoding\\Auto.inc}
+
+initialization
+ Encoders[encLocale] := TEncoderLocale.Create;
+ Encoders[encUTF8] := TEncoderUTF8.Create;
+ Encoders[encCP1250] := TEncoderCP1250.Create;
+ Encoders[encCP1252] := TEncoderCP1252.Create;
+
+ // use USDX < 1.1 encoding for backward compatibility (encCP1252)
+ Encoders[encAuto] := TEncoderAuto.Create(Encoders[encUTF8], Encoders[encCP1252]);
+
end.
diff --git a/cmake/src/base/UTexture.pas b/cmake/src/base/UTexture.pas
index 97f244fe..c1334dd7 100644
--- a/cmake/src/base/UTexture.pas
+++ b/cmake/src/base/UTexture.pas
@@ -40,6 +40,7 @@ uses
Classes,
SysUtils,
UCommon,
+ UPath,
SDL,
SDL_Image;
@@ -66,7 +67,7 @@ type
TexX2: real;
TexY2: real;
Alpha: real;
- Name: string; // experimental for handling cache images. maybe it's useful for dynamic skins
+ Name: IPath; // experimental for handling cache images. maybe it's useful for dynamic skins
end;
type
@@ -91,7 +92,7 @@ procedure AdjustPixelFormat(var TexSurface: PSDL_Surface; Typ: TTextureType);
type
PTextureEntry = ^TTextureEntry;
TTextureEntry = record
- Name: string;
+ Name: IPath;
Typ: TTextureType;
Color: cardinal;
@@ -105,7 +106,7 @@ type
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;
+ function FindTexture(const Name: IPath; Typ: TTextureType; Color: cardinal): integer;
end;
TTextureUnit = class
@@ -116,14 +117,14 @@ type
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;
+ function GetTexture(const Name: IPath; Typ: TTextureType; FromCache: boolean = false): TTexture; overload;
+ function GetTexture(const Name: IPath; Typ: TTextureType; Col: LongWord; FromCache: boolean = false): TTexture; overload;
+ function LoadTexture(FromRegistry: boolean; const Identifier: IPath; Typ: TTextureType; Col: LongWord): TTexture; overload;
+ function LoadTexture(const Identifier: IPath; Typ: TTextureType; Col: LongWord): TTexture; overload;
+ function LoadTexture(const Identifier: IPath): TTexture; overload;
+ function CreateTexture(Data: PChar; const Name: IPath; Width, Height: word; BitsPerPixel: byte): TTexture;
+ procedure UnloadTexture(const Name: IPath; Typ: TTextureType; FromCache: boolean); overload;
+ procedure UnloadTexture(const Name: IPath; Typ: TTextureType; Col: cardinal; FromCache: boolean); overload;
//procedure FlushTextureDatabase();
constructor Create;
@@ -188,7 +189,7 @@ begin
Texture[TextureIndex].Texture := Tex;
end;
-function TTextureDatabase.FindTexture(const Name: string; Typ: TTextureType; Color: cardinal): integer;
+function TTextureDatabase.FindTexture(const Name: IPath; Typ: TTextureType; Color: cardinal): integer;
var
TextureIndex: integer;
CurrentTexture: PTextureEntry;
@@ -197,7 +198,7 @@ begin
for TextureIndex := 0 to High(Texture) do
begin
CurrentTexture := @Texture[TextureIndex];
- if (CurrentTexture.Name = Name) and
+ if (CurrentTexture.Name.Equals(Name)) and
(CurrentTexture.Typ = Typ) then
begin
// colorized textures must match in their color too
@@ -235,18 +236,18 @@ begin
TextureDatabase.AddTexture(Tex, Typ, Color, Cache);
end;
-function TTextureUnit.LoadTexture(FromRegistry: boolean; const Identifier: string; Typ: TTextureType; Col: LongWord): TTexture;
+function TTextureUnit.LoadTexture(FromRegistry: boolean; const Identifier: IPath; 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;
+function TTextureUnit.LoadTexture(const Identifier: IPath): TTexture;
begin
Result := LoadTexture(Identifier, TEXTURE_TYPE_PLAIN, 0);
end;
-function TTextureUnit.LoadTexture(const Identifier: string; Typ: TTextureType; Col: LongWord): TTexture;
+function TTextureUnit.LoadTexture(const Identifier: IPath; Typ: TTextureType; Col: LongWord): TTexture;
var
TexSurface: PSDL_Surface;
newWidth, newHeight: integer;
@@ -260,7 +261,7 @@ begin
TexSurface := LoadImage(Identifier);
if not assigned(TexSurface) then
begin
- Log.LogError('Could not load texture: "' + Identifier +'" with type "'+ TextureTypeToStr(Typ) +'"',
+ Log.LogError('Could not load texture: "' + Identifier.ToNative +'" with type "'+ TextureTypeToStr(Typ) +'"',
'TTextureUnit.LoadTexture');
Exit;
end;
@@ -363,16 +364,16 @@ begin
SDL_FreeSurface(TexSurface);
end;
-function TTextureUnit.GetTexture(const Name: string; Typ: TTextureType; FromCache: boolean): TTexture;
+function TTextureUnit.GetTexture(const Name: IPath; 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;
+function TTextureUnit.GetTexture(const Name: IPath; Typ: TTextureType; Col: LongWord; FromCache: boolean): TTexture;
var
TextureIndex: integer;
begin
- if (Name = '') then
+ if (Name.IsUnset) then
begin
// zero texture data
FillChar(Result, SizeOf(Result), 0);
@@ -413,7 +414,7 @@ begin
Result := TextureDatabase.Texture[TextureIndex].Texture;
end;
-function TTextureUnit.CreateTexture(Data: PChar; const Name: string; Width, Height: word; BitsPerPixel: byte): TTexture;
+function TTextureUnit.CreateTexture(Data: PChar; const Name: IPath; Width, Height: word; BitsPerPixel: byte): TTexture;
var
//Error: integer;
ActTex: GLuint;
@@ -467,12 +468,12 @@ begin
Result.Name := Name;
end;
-procedure TTextureUnit.UnloadTexture(const Name: string; Typ: TTextureType; FromCache: boolean);
+procedure TTextureUnit.UnloadTexture(const Name: IPath; Typ: TTextureType; FromCache: boolean);
begin
UnloadTexture(Name, Typ, 0, FromCache);
end;
-procedure TTextureUnit.UnloadTexture(const Name: string; Typ: TTextureType; Col: cardinal; FromCache: boolean);
+procedure TTextureUnit.UnloadTexture(const Name: IPath; Typ: TTextureType; Col: cardinal; FromCache: boolean);
var
T: integer;
TexNum: GLuint;
@@ -539,7 +540,8 @@ begin
Exit;
end;
end;
- Log.LogWarn('Unknown texture type: "' + TypeStr + '". Using default texture type "' + TextureTypeToStr(Default) + '"', 'ParseTextureType');
+ Log.LogInfo('Unknown texture type: "' + TypeStr + '". Using default texture type "'
+ + TextureTypeToStr(Default) + '"', 'UTexture.ParseTextureType');
Result := Default;
end;
diff --git a/cmake/src/base/UThemes.pas b/cmake/src/base/UThemes.pas
index 3fd77853..b385406f 100644
--- a/cmake/src/base/UThemes.pas
+++ b/cmake/src/base/UThemes.pas
@@ -34,11 +34,12 @@ interface
{$I switches.inc}
uses
- ULog,
IniFiles,
SysUtils,
Classes,
- UTexture;
+ ULog,
+ UTexture,
+ UPath;
type
TRGB = record
@@ -112,7 +113,7 @@ type
Font: integer;
Size: integer;
Align: integer;
- Text: string;
+ Text: UTF8String;
//Reflection
Reflection: boolean;
ReflectionSpacing: real;
@@ -169,7 +170,9 @@ type
TThemeSelectSlide = record
Tex: string;
+ Typ: TTextureType;
TexSBG: string;
+ TypSBG: TTextureType;
X: integer;
Y: integer;
W: integer;
@@ -182,7 +185,7 @@ type
showArrows:boolean;
oneItemOnly:boolean;
- Text: string;
+ Text: UTF8String;
ColR, ColG, ColB, Int: real;
DColR, DColG, DColB, DInt: real;
TColR, TColG, TColB, TInt: real;
@@ -215,7 +218,7 @@ type
TThemeBasic = class
Background: TThemeBackground;
Text: AThemeText;
- Static: AThemeStatic;
+ Statics: AThemeStatic;
//Button Collection Mod
ButtonCollection: AThemeButtonCollection;
@@ -236,8 +239,8 @@ type
TextDescription: TThemeText;
TextDescriptionLong: TThemeText;
- Description: array[0..5] of string;
- DescriptionLong: array[0..5] of string;
+ Description: array[0..5] of UTF8String;
+ DescriptionLong: array[0..5] of UTF8String;
end;
TThemeName = class(TThemeBasic)
@@ -354,7 +357,7 @@ type
TextP3RScore: TThemeText;
//Linebonus Translations
- LineBonusText: array [0..8] of string;
+ LineBonusText: array [0..8] of UTF8String;
//Pause Popup
PausePopUp: TThemeStatic;
@@ -396,6 +399,7 @@ type
StaticBackLevelRound: array[1..6] of TThemeStatic;
StaticLevel: array[1..6] of TThemeStatic;
StaticLevelRound: array[1..6] of TThemeStatic;
+ StaticPlayerIdBox: array[1..6] of TThemeStatic;
// Description: array[0..5] of string;}
end;
@@ -408,6 +412,7 @@ type
TextNumber: AThemeText;
TextName: AThemeText;
TextScore: AThemeText;
+ TextDate: AThemeText;
end;
TThemeOptions = class(TThemeBasic)
@@ -421,7 +426,7 @@ type
ButtonExit: TThemeButton;
TextDescription: TThemeText;
- Description: array[0..7] of string;
+ Description: array[0..7] of UTF8String;
end;
TThemeOptionsGame = class(TThemeBasic)
@@ -496,8 +501,8 @@ type
TextDescription: TThemeText;
TextDescriptionLong: TThemeText;
- Description: array[0..5] of string;
- DescriptionLong: array[0..5] of string;
+ Description: array[0..5] of UTF8string;
+ DescriptionLong: array[0..5] of UTF8string;
end;
//Error- and Check-Popup
@@ -531,10 +536,10 @@ type
TextFound: TThemeText;
//Translated Texts
- Songsfound: string;
- NoSongsfound: string;
- CatText: string;
- IType: array [0..2] of string;
+ Songsfound: UTF8String;
+ NoSongsfound: UTF8String;
+ CatText: UTF8String;
+ IType: array [0..2] of UTF8String;
end;
//Party Screens
@@ -646,17 +651,17 @@ type
SelectLevel: TThemeSelectSlide;
SelectPlayList: TThemeSelectSlide;
SelectPlayList2: TThemeSelectSlide;
- SelectRounds: TThemeSelectSlide;
- SelectTeams: TThemeSelectSlide;
- SelectPlayers1: TThemeSelectSlide;
- SelectPlayers2: TThemeSelectSlide;
- SelectPlayers3: TThemeSelectSlide;
{ButtonNext: TThemeButton;
ButtonPrev: TThemeButton;}
end;
TThemePartyPlayer = class(TThemeBasic)
+ SelectTeams: TThemeSelectSlide;
+ SelectPlayers1: TThemeSelectSlide;
+ SelectPlayers2: TThemeSelectSlide;
+ SelectPlayers3: TThemeSelectSlide;
+
Team1Name: TThemeButton;
Player1Name: TThemeButton;
Player2Name: TThemeButton;
@@ -679,6 +684,11 @@ type
ButtonPrev: TThemeButton;}
end;
+ TThemePartyRounds = class(TThemeBasic)
+ SelectRoundCount: TThemeSelectSlide;
+ SelectRound: array [0..6] of TThemeSelectSlide;
+ end;
+
//Stats Screens
TThemeStatMain = class(TThemeBasic)
ButtonScores: TThemeButton;
@@ -700,15 +710,22 @@ type
TextPage: TThemeText;
TextList: AThemeText;
- Description: array[0..3] of string;
- DescriptionR: array[0..3] of string;
- FormatStr: array[0..3] of string;
- PageStr: string;
+ Description: array[0..3] of UTF8String;
+ DescriptionR: array[0..3] of UTF8String;
+ FormatStr: array[0..3] of UTF8String;
+ PageStr: UTF8String;
end;
//Playlist Translations
TThemePlaylist = record
- CatText: string;
+ CatText: UTF8String;
+ end;
+
+ TThemeEntry = record
+ Name: string;
+ Filename: IPath;
+ DefaultSkin: integer;
+ Creator: string;
end;
TTheme = class
@@ -721,8 +738,9 @@ type
LastThemeBasic: TThemeBasic;
procedure CreateThemeObjects();
-
+ procedure LoadHeader(FileName: IPath);
public
+ Themes: array of TThemeEntry;
Loading: TThemeLoading;
Main: TThemeMain;
Name: TThemeName;
@@ -754,6 +772,7 @@ type
PartyWin: TThemePartyWin;
PartyOptions: TThemePartyOptions;
PartyPlayer: TThemePartyPlayer;
+ PartyRounds: TThemePartyRounds;
//Stats Screens:
StatMain: TThemeStatMain;
@@ -761,11 +780,13 @@ type
Playlist: TThemePlaylist;
- ILevel: array[0..2] of string;
+ ILevel: array[0..2] of UTF8String;
+
+ constructor Create;
- constructor Create(const FileName: string); overload; // Initialize theme system
- constructor Create(const FileName: string; Color: integer); overload; // Initialize theme system with color
- function LoadTheme(FileName: string; sColor: integer): boolean; // Load some theme settings from file
+ procedure LoadList;
+
+ function LoadTheme(ThemeNum: integer; sColor: integer): boolean; // Load some theme settings from file
procedure LoadColors;
@@ -818,9 +839,13 @@ uses
ULanguage,
USkins,
UIni,
+ UPathUtils,
+ UFileSystem,
+ TextGL,
gl,
glext,
- math;
+ math,
+ StrUtils;
//-----------
//Helper procs to use TRGB in Opengl ...maybe this should be somewhere else
@@ -845,12 +870,7 @@ begin
glColor4f(Color.R, Color.G, Color.B, Min(Color.A, Alpha));
end;
-constructor TTheme.Create(const FileName: string);
-begin
- Create(FileName, 0);
-end;
-
-constructor TTheme.Create(const FileName: string; Color: integer);
+constructor TTheme.Create;
begin
inherited Create();
@@ -884,16 +904,89 @@ begin
PartyScore := TThemePartyScore.Create;
PartyOptions := TThemePartyOptions.Create;
PartyPlayer := TThemePartyPlayer.Create;
+ PartyRounds := TThemePartyRounds.Create;
//Stats Screens:
StatMain := TThemeStatMain.Create;
StatDetail := TThemeStatDetail.Create;
- LoadTheme(FileName, Color);
+ //LoadTheme(FileName, Color);
+ LoadList;
+end;
+
+procedure TTheme.LoadHeader(FileName: IPath);
+ var
+ Entry: TThemeEntry;
+ Ini: TMemIniFile;
+ SkinName: string;
+ SkinsFound: boolean;
+ ThemeVersion: string;
+ I: integer;
+ Len: integer;
+ Skins: TUTF8StringDynArray;
+begin
+ Entry.Filename := ThemePath.Append(FileName);
+ //read info from theme header
+ Ini := TMemIniFile.Create(Entry.Filename.ToNative);
+
+ Entry.Name := Ini.ReadString('Theme', 'Name', FileName.SetExtension('').ToNative);
+ ThemeVersion := Trim(UpperCase(Ini.ReadString('Theme', 'US_Version', 'no version tag')));
+ Entry.Creator := Ini.ReadString('Theme', 'Creator', 'Unknown');
+ SkinName := Ini.ReadString('Theme', 'DefaultSkin', FileName.SetExtension('').ToNative);
+
+ Ini.Free;
+
+ // don't load theme with wrong version tag
+ if ThemeVersion <> 'USD 110' then
+ begin
+ Log.LogWarn('Wrong Version (' + ThemeVersion + ') in Theme : ' + Entry.Name, 'Theme.LoadHeader');
+ end
+ else
+ begin
+ //Search for Skins for this Theme
+ SkinsFound := false;
+ for I := Low(Skin.Skin) to High(Skin.Skin) do
+ begin
+ if (CompareText(Skin.Skin[I].Theme, Entry.Name) = 0) then
+ begin
+ SkinsFound := true;
+ break;
+ end;
+ end;
+
+ if SkinsFound then
+ begin
+ { found a valid Theme }
+ // set correct default skin
+ Skin.GetSkinsByTheme(Entry.Name, Skins);
+ Entry.DefaultSkin := max(0, GetArrayIndex(Skins, SkinName, true));
+
+ Len := Length(Themes);
+ SetLength(Themes, Len + 1);
+ SetLength(ITheme, Len + 1);
+ Themes[Len] := Entry;
+ ITheme[Len] := Entry.Name;
+ end;
+ end;
+end;
+procedure TTheme.LoadList;
+ var
+ Iter: IFileIterator;
+ FileInfo: TFileInfo;
+begin
+ Log.LogStatus('Searching for Theme : ' + ThemePath.ToNative + '*.ini', 'Theme.LoadList');
+
+ Iter := FileSystem.FileFind(ThemePath.Append('*.ini'), 0);
+ while (Iter.HasNext) do
+ begin
+ FileInfo := Iter.Next;
+ Log.LogStatus('Found Theme: ' + FileInfo.Name.ToNative, 'Theme.LoadList');
+ LoadHeader(Fileinfo.Name);
+ end;
end;
-function TTheme.LoadTheme(FileName: string; sColor: integer): boolean;
+function TTheme.LoadTheme(ThemeNum: integer; sColor: integer): boolean;
var
I: integer;
begin
@@ -901,23 +994,21 @@ begin
CreateThemeObjects();
- Log.LogStatus('Loading: '+ FileName, 'TTheme.LoadTheme');
+ Log.LogStatus('Loading: '+ Themes[ThemeNum].FileName.ToNative, 'TTheme.LoadTheme');
- FileName := AdaptFilePaths(FileName);
-
- if not FileExists(FileName) then
+ if not Themes[ThemeNum].FileName.IsFile() then
begin
- Log.LogError('Theme does not exist ('+ FileName +')', 'TTheme.LoadTheme');
+ Log.LogError('Theme does not exist ('+ Themes[ThemeNum].FileName.ToNative +')', 'TTheme.LoadTheme');
end;
- if FileExists(FileName) then
+ if Themes[ThemeNum].FileName.IsFile() then
begin
Result := true;
{$IFDEF THEMESAVE}
- ThemeIni := TIniFile.Create(FileName);
+ ThemeIni := TIniFile.Create(Themes[ThemeNum].FileName.ToNative);
{$ELSE}
- ThemeIni := TMemIniFile.Create(FileName);
+ ThemeIni := TMemIniFile.Create(Themes[ThemeNum].FileName.ToNative);
{$ENDIF}
if ThemeIni.ReadString('Theme', 'Name', '') <> '' then
@@ -1164,6 +1255,7 @@ begin
ThemeLoadStatic(Score.StaticBackLevelRound[I], 'ScoreStaticBackLevelRound' + IntToStr(I));
ThemeLoadStatic(Score.StaticLevel[I], 'ScoreStaticLevel' + IntToStr(I));
ThemeLoadStatic(Score.StaticLevelRound[I], 'ScoreStaticLevelRound' + IntToStr(I));
+ ThemeLoadStatic(Score.StaticPlayerIdBox[I], 'ScoreStaticPlayerIdBox' + IntToStr(I));
ThemeLoadStatic(Score.StaticRatings[I], 'ScoreStaticRatingPicture' + IntToStr(I));
end;
@@ -1177,6 +1269,7 @@ begin
ThemeLoadTexts(Top5.TextNumber, 'Top5TextNumber');
ThemeLoadTexts(Top5.TextName, 'Top5TextName');
ThemeLoadTexts(Top5.TextScore, 'Top5TextScore');
+ ThemeLoadTexts(Top5.TextDate, 'Top5TextDate');
// Options
ThemeLoadBasic(Options, 'Options');
@@ -1434,17 +1527,17 @@ begin
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');
+
+ ThemeLoadSelectSlide(PartyPlayer.SelectTeams, 'PartyPlayerSelectTeams');
+ ThemeLoadSelectSlide(PartyPlayer.SelectPlayers1, 'PartyPlayerSelectPlayers1');
+ ThemeLoadSelectSlide(PartyPlayer.SelectPlayers2, 'PartyPlayerSelectPlayers2');
+ ThemeLoadSelectSlide(PartyPlayer.SelectPlayers3, 'PartyPlayerSelectPlayers3');
+
ThemeLoadButton(PartyPlayer.Team1Name, 'PartyPlayerTeam1Name');
ThemeLoadButton(PartyPlayer.Player1Name, 'PartyPlayerPlayer1Name');
ThemeLoadButton(PartyPlayer.Player2Name, 'PartyPlayerPlayer2Name');
@@ -1463,6 +1556,13 @@ begin
ThemeLoadButton(PartyPlayer.Player11Name, 'PartyPlayerPlayer11Name');
ThemeLoadButton(PartyPlayer.Player12Name, 'PartyPlayerPlayer12Name');
+ // Party Rounds
+ ThemeLoadBasic(PartyRounds, 'PartyRounds');
+
+ ThemeLoadSelectSlide(PartyRounds.SelectRoundCount, 'PartyRoundsSelectRoundCount');
+ for I := 0 to High(PartyRounds.SelectRound) do
+ ThemeLoadSelectSlide(PartyRounds.SelectRound[I], 'PartyRoundsSelectRound' + IntToStr(I + 1));
+
{ThemeLoadButton(ButtonNext, 'PartyPlayerButtonNext');
ThemeLoadButton(ButtonPrev, 'PartyPlayerButtonPrev');}
@@ -1524,7 +1624,7 @@ procedure TTheme.ThemeLoadBasic(Theme: TThemeBasic; const Name: string);
begin
ThemeLoadBackground(Theme.Background, Name);
ThemeLoadTexts(Theme.Text, Name + 'Text');
- ThemeLoadStatics(Theme.Static, Name + 'Static');
+ ThemeLoadStatics(Theme.Statics, Name + 'Static');
ThemeLoadButtonCollections(Theme.ButtonCollection, Name + 'ButtonCollection');
LastThemeBasic := Theme;
@@ -1568,7 +1668,7 @@ begin
ThemeText.ColG := ThemeIni.ReadFloat(Name, 'ColG', 0);
ThemeText.ColB := ThemeIni.ReadFloat(Name, 'ColB', 0);
- ThemeText.Font := ThemeIni.ReadInteger(Name, 'Font', 0);
+ ThemeText.Font := ThemeIni.ReadInteger(Name, 'Font', ftNormal);
ThemeText.Size := ThemeIni.ReadInteger(Name, 'Size', 0);
ThemeText.Align := ThemeIni.ReadInteger(Name, 'Align', 0);
@@ -1773,7 +1873,9 @@ begin
ThemeSelectS.Text := Language.Translate(ThemeIni.ReadString(Name, 'Text', ''));
ThemeSelectS.Tex := {Skin.SkinPath + }ThemeIni.ReadString(Name, 'Tex', '');
+ ThemeSelectS.Typ := ParseTextureType(ThemeIni.ReadString(Name, 'Type', ''), TEXTURE_TYPE_PLAIN);
ThemeSelectS.TexSBG := {Skin.SkinPath + }ThemeIni.ReadString(Name, 'TexSBG', '');
+ ThemeSelectS.TypSBG := ParseTextureType(ThemeIni.ReadString(Name, 'TypeSBG', ''), TEXTURE_TYPE_PLAIN);
ThemeSelectS.X := ThemeIni.ReadInteger(Name, 'X', 0);
ThemeSelectS.Y := ThemeIni.ReadInteger(Name, 'Y', 0);
@@ -1807,6 +1909,9 @@ begin
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);
+
+ ThemeSelectS.showArrows := (ThemeIni.ReadInteger(Name, 'ShowArrows', 0) = 1);
+ ThemeSelectS.oneItemOnly := (ThemeIni.ReadInteger(Name, 'OneItemOnly', 0) = 1);
end;
procedure TTheme.ThemeLoadEqualizer(var ThemeEqualizer: TThemeEqualizer; const Name: string);
@@ -2023,15 +2128,15 @@ begin
//New Theme-Color Patch
4: begin
// violet
- Result.R := 230/255;
- Result.G := 63/255;
- Result.B := 230/255;
+ Result.R := 212/255;
+ Result.G := 71/255;
+ Result.B := 247/255;
end;
5: begin
// orange
- Result.R := 255/255;
+ Result.R := 247/255;
Result.G := 144/255;
- Result.B := 0;
+ Result.B := 71/255;
end;
6: begin
// yellow
@@ -2193,7 +2298,7 @@ begin
ThemeIni.WriteInteger(Name, 'Texts', Length(Theme.Text));
ThemeSaveBackground(Theme.Background, Name + 'Background');
- ThemeSaveStatics(Theme.Static, Name + 'Static');
+ ThemeSaveStatics(Theme.Statics, Name + 'Static');
ThemeSaveTexts(Theme.Text, Name + 'Text');
end;
diff --git a/cmake/src/base/UTime.pas b/cmake/src/base/UTime.pas
index 83844cb5..0610ef59 100644
--- a/cmake/src/base/UTime.pas
+++ b/cmake/src/base/UTime.pas
@@ -40,20 +40,26 @@ type
function GetTime(): real;
end;
+ TRelativeTimerState = (rtsStopped, rtsWait, rtsPaused, rtsRunning);
+
TRelativeTimer = class
private
AbsoluteTime: int64; // system-clock reference time for calculation of CurrentTime
- RelativeTimeOffset: real;
- Paused: boolean;
+ RelativeTime: real;
TriggerMode: boolean;
+ State: TRelativeTimerState;
public
- constructor Create(TriggerMode: boolean = false);
+ constructor Create();
+ procedure Start(WaitForTrigger: boolean = false);
procedure Pause();
- procedure Resume();
+ procedure Stop();
function GetTime(): real;
- function GetAndResetTime(): real;
- procedure SetTime(Time: real; Trigger: boolean = true);
- procedure Reset();
+ procedure SetTime(Time: real);
+ function GetState(): TRelativeTimerState;
+ end;
+
+ TSyncSource = class
+ function GetClock(): real; virtual; abstract;
end;
procedure CountSkipTimeSet;
@@ -126,85 +132,115 @@ 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.
+(**
+ * Creates a new relative timer.
+ * A relative timer works like a stop-watch. It can be paused and
+ * resumed afterwards, continuing with the counter it had when it was paused.
*)
-constructor TRelativeTimer.Create(TriggerMode: boolean);
+constructor TRelativeTimer.Create();
begin
- inherited Create();
- Self.TriggerMode := TriggerMode;
- Reset();
- Paused := false;
+ State := rtsStopped;
+ AbsoluteTime := 0;
+ RelativeTime := 0;
end;
-procedure TRelativeTimer.Pause();
+(**
+ * Starts the timer.
+ * If WaitForTrigger is false the timer will be started immediately.
+ * If WaitForTrigger is true the timer will be started when a trigger event
+ * occurs. A trigger event is a call of one of the Get-/SetTime() methods.
+ * In addition the timer can be started by calling this method again with
+ * WaitForTrigger set to false.
+ *)
+procedure TRelativeTimer.Start(WaitForTrigger: boolean = false);
begin
- RelativeTimeOffset := GetTime();
- Paused := true;
+ case (State) of
+ rtsStopped, rtsPaused: begin
+ if (WaitForTrigger) then
+ begin
+ State := rtsWait;
+ end
+ else
+ begin
+ State := rtsRunning;
+ AbsoluteTime := SDL_GetTicks();
+ end;
+ end;
+
+ rtsWait: begin
+ if (not WaitForTrigger) then
+ begin
+ State := rtsRunning;
+ AbsoluteTime := SDL_GetTicks();
+ RelativeTime := 0;
+ end;
+ end;
+ end;
end;
-procedure TRelativeTimer.Resume();
+(**
+ * Pauses the timer and leaves the counter untouched.
+ *)
+procedure TRelativeTimer.Pause();
begin
- AbsoluteTime := SDL_GetTicks();
- Paused := false;
+ if (State = rtsRunning) then
+ begin
+ // Important: GetTime() must be called in running state
+ RelativeTime := GetTime();
+ State := rtsPaused;
+ end;
end;
-(*
- * Returns the counter of the timer.
- * If in TriggerMode it will return 0 and start the counter on the first call.
+(**
+ * Stops the timer and sets its counter to 0.
*)
-function TRelativeTimer.GetTime: real;
+procedure TRelativeTimer.Stop();
begin
- // initialize absolute time on first call in triggered mode
- if (TriggerMode and (AbsoluteTime = 0)) then
+ if (State <> rtsStopped) then
begin
- AbsoluteTime := SDL_GetTicks();
- Result := RelativeTimeOffset;
- Exit;
+ State := rtsStopped;
+ RelativeTime := 0;
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().
+(**
+ * Returns the current counter of the timer.
+ * If WaitForTrigger was true in Start() the timer will be started
+ * if it was not already running.
*)
-function TRelativeTimer.GetAndResetTime(): real;
+function TRelativeTimer.GetTime(): real;
begin
- Result := GetTime();
- SetTime(0);
+ case (State) of
+ rtsStopped, rtsPaused:
+ Result := RelativeTime;
+ rtsRunning:
+ Result := RelativeTime + (SDL_GetTicks() - AbsoluteTime) / cSDLCorrectionRatio;
+ rtsWait: begin
+ // start triggered
+ State := rtsRunning;
+ AbsoluteTime := SDL_GetTicks();
+ Result := RelativeTime;
+ end;
+ end;
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.
+(**
+ * Sets the counter of the timer.
+ * If WaitForTrigger was true in Start() the timer will be started
+ * if it was not already running.
*)
-procedure TRelativeTimer.SetTime(Time: real; Trigger: boolean);
+procedure TRelativeTimer.SetTime(Time: real);
begin
- RelativeTimeOffset := Time;
- if ((not TriggerMode) or Trigger) then
- AbsoluteTime := SDL_GetTicks();
+ RelativeTime := Time;
+ AbsoluteTime := SDL_GetTicks();
+ // start triggered
+ if (State = rtsWait) then
+ State := rtsRunning;
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();
+function TRelativeTimer.GetState(): TRelativeTimerState;
begin
- RelativeTimeOffset := 0;
- if (TriggerMode) then
- AbsoluteTime := 0
- else
- AbsoluteTime := SDL_GetTicks();
+ Result := State;
end;
end.
diff --git a/cmake/src/base/UUnicodeUtils.pas b/cmake/src/base/UUnicodeUtils.pas
new file mode 100644
index 00000000..37b53a67
--- /dev/null
+++ b/cmake/src/base/UUnicodeUtils.pas
@@ -0,0 +1,670 @@
+{* UltraStar Deluxe - Karaoke Game
+ *
+ * UltraStar Deluxe is the legal property of its developers, whose names
+ * are too numerous to list here. Please refer to the COPYRIGHT
+ * file distributed with this source distribution.
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; see the file COPYING. If not, write to
+ * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+ * Boston, MA 02110-1301, USA.
+ *
+ * $URL$
+ * $Id$
+ *}
+
+unit UUnicodeUtils;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+uses
+{$IFDEF MSWINDOWS}
+ Windows,
+{$ENDIF}
+ StrUtils,
+ SysUtils;
+
+type
+ // String with unknown encoding. Introduced with Delphi 2009 and maybe soon
+ // with FPC.
+ RawByteString = AnsiString;
+
+{**
+ * Returns true if the system uses UTF-8 as default string type
+ * (filesystem or API calls).
+ * This is always true on Mac OS X and always false on Win32. On Unix it depends
+ * on the LC_CTYPE setting.
+ * Do not use AnsiToUTF8() or UTF8ToAnsi() if this function returns true.
+ *}
+function IsNativeUTF8(): boolean;
+
+(*
+ * Character classes
+ *)
+
+function IsAlphaChar(ch: WideChar): boolean; overload;
+function IsAlphaChar(ch: UCS4Char): boolean; overload;
+
+function IsNumericChar(ch: WideChar): boolean; overload;
+function IsNumericChar(ch: UCS4Char): boolean; overload;
+
+function IsAlphaNumericChar(ch: WideChar): boolean; overload;
+function IsAlphaNumericChar(ch: UCS4Char): boolean; overload;
+
+function IsPunctuationChar(ch: WideChar): boolean; overload;
+function IsPunctuationChar(ch: UCS4Char): boolean; overload;
+
+function IsControlChar(ch: WideChar): boolean; overload;
+function IsControlChar(ch: UCS4Char): boolean; overload;
+
+function IsPrintableChar(ch: WideChar): boolean; overload;
+function IsPrintableChar(ch: UCS4Char): boolean; overload;
+
+{**
+ * Checks if the given string is a valid UTF-8 string.
+ * If an ANSI encoded string (with char codes >= 128) is passed, the
+ * function will most probably return false, as most ANSI strings sequences
+ * are illegal in UTF-8.
+ *}
+function IsUTF8String(const str: RawByteString): boolean;
+
+{**
+ * Iterates over an UTF-8 encoded string.
+ * StrPtr will be increased to the beginning of the next character on each
+ * call.
+ * Results true if the given string starts with an UTF-8 encoded char.
+ *}
+function NextCharUTF8(var StrPtr: PAnsiChar; out Ch: UCS4Char): boolean;
+
+{**
+ * Deletes Count chars (not bytes) beginning at char- (not byte-) position Index.
+ * Index values start with 1.
+ *}
+procedure UTF8Delete(var Str: UTF8String; Index: Integer; Count: Integer);
+procedure UCS4Delete(var Str: UCS4String; Index: Integer; Count: Integer);
+
+{**
+ * Checks if the string is composed of ASCII characters.
+ *}
+function IsASCIIString(const str: RawByteString): boolean;
+
+{*
+ * String format conversion
+ *}
+
+function UTF8ToUCS4String(const str: UTF8String): UCS4String;
+function UCS4ToUTF8String(const str: UCS4String): UTF8String; overload;
+function UCS4ToUTF8String(ch: UCS4Char): UTF8String; overload;
+
+{**
+ * Returns the number of characters (not bytes) in string str.
+ *}
+function LengthUTF8(const str: UTF8String): integer;
+
+{**
+ * Returns the length of an UCS4String. Note that Length(UCS4String) returns
+ * the length+1 as UCS4Strings are zero-terminated.
+ *}
+function LengthUCS4(const str: UCS4String): integer;
+
+{** @seealso WideCompareStr *}
+function UTF8CompareStr(const S1, S2: UTF8String): integer;
+{** @seealso WideCompareText *}
+function UTF8CompareText(const S1, S2: UTF8String): integer;
+
+function UTF8StartsText(const SubText, Text: UTF8String): boolean;
+
+function UTF8ContainsStr(const Text, SubText: UTF8String): boolean;
+function UTF8ContainsText(const Text, SubText: UTF8String): boolean;
+
+{** @seealso WideUpperCase *}
+function UTF8UpperCase(const str: UTF8String): UTF8String;
+{** @seealso WideCompareText *}
+function UTF8LowerCase(const str: UTF8String): UTF8String;
+
+{**
+ * Converts a UCS-4 char ch to its upper-case representation.
+ *}
+function UCS4UpperCase(ch: UCS4Char): UCS4Char; overload;
+
+{**
+ * Converts a UCS-4 string str to its upper-case representation.
+ *}
+function UCS4UpperCase(const str: UCS4String): UCS4String; overload;
+
+{**
+ * Converts a UCS4Char to an UCS4String.
+ * Note that UCS4Strings are zero-terminated dynamic arrays.
+ *}
+function UCS4CharToString(ch: UCS4Char): UCS4String;
+
+{**
+ * @seealso System.Pos()
+ *}
+function UTF8Pos(const substr: UTF8String; const str: UTF8String): Integer;
+
+{**
+ * Copies a segment of str starting with Index (1-based) with Count characters (not bytes).
+ *}
+function UTF8Copy(const str: UTF8String; Index: Integer = 1; Count: Integer = -1): UTF8String;
+
+{**
+ * Copies a segment of str starting with Index (0-based) with Count characters.
+ * Note: Do not use Copy() to copy UCS4Strings as the result will not contain
+ * a trailing #0 character and hence is invalid.
+ *}
+function UCS4Copy(const str: UCS4String; Index: Integer = 0; Count: Integer = -1): UCS4String;
+
+(*
+ * Converts a WideString to its upper- or lower-case representation.
+ * Wrapper for WideUpper/LowerCase. Needed because some plattforms have
+ * problems with unicode support.
+ *
+ * Note that characters in UTF-16 might consist of one or two WideChar valus
+ * (see surrogates). So instead of using WideStringUpperCase(ch)[1] for single
+ * character access, convert to UCS-4 where each character is represented by
+ * one UCS4Char.
+ *)
+function WideStringUpperCase(const str: WideString) : WideString; overload;
+function WideStringUpperCase(ch: WideChar): WideString; overload;
+function WideStringLowerCase(const str: WideString): WideString; overload;
+function WideStringLowerCase(ch: WideChar): WideString; overload;
+
+function WideStringReplaceChar(const text: WideString; search, rep: WideChar): WideString;
+
+implementation
+
+{$IFDEF UNIX}
+{$IFNDEF DARWIN}
+const
+ LC_CTYPE = 0;
+
+function setlocale(category: integer; locale: PChar): PChar; cdecl; external 'c';
+{$ENDIF}
+{$ENDIF}
+
+var
+ NativeUTF8: boolean;
+
+procedure InitUnicodeUtils();
+{$IFDEF UNIX}
+{$IFNDEF DARWIN}
+var
+ localeName: PChar;
+{$ENDIF}
+{$ENDIF}
+begin
+ {$IF Defined(DARWIN)}
+ NativeUTF8 := true;
+ {$ELSEIF Defined(MSWindows)}
+ NativeUTF8 := false;
+ {$ELSEIF Defined(UNIX)}
+ // check if locale name contains UTF8 or UTF-8
+ localeName := setlocale(LC_CTYPE, nil);
+ NativeUTF8 := Pos('UTF8', UpperCase(AnsiReplaceStr(localeName, '-', ''))) > 0;
+ {$ELSE}
+ raise Exception.Create('Unknown system');
+ {$IFEND}
+end;
+
+function IsNativeUTF8(): boolean;
+begin
+ Result := NativeUTF8;
+end;
+
+function IsAlphaChar(ch: WideChar): boolean;
+begin
+ {$IFDEF MSWINDOWS}
+ Result := IsCharAlphaW(ch);
+ {$ELSE}
+ // TODO: add chars > 255 (or replace with libxml2 functions?)
+ 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;
+ {$ENDIF}
+end;
+
+function IsAlphaChar(ch: UCS4Char): boolean;
+begin
+ Result := IsAlphaChar(WideChar(Ord(ch)));
+end;
+
+function IsNumericChar(ch: WideChar): boolean;
+begin
+ // TODO: replace with libxml2 functions?
+ // ignore non-arabic numerals as we do not want to handle them
+ case ch of
+ '0'..'9':
+ Result := true;
+ else
+ Result := false;
+ end;
+end;
+
+function IsNumericChar(ch: UCS4Char): boolean;
+begin
+ Result := IsNumericChar(WideChar(Ord(ch)));
+end;
+
+function IsAlphaNumericChar(ch: WideChar): boolean;
+begin
+ Result := (IsAlphaChar(ch) or IsNumericChar(ch));
+end;
+
+function IsAlphaNumericChar(ch: UCS4Char): boolean;
+begin
+ Result := (IsAlphaChar(ch) or IsNumericChar(ch));
+end;
+
+function IsPunctuationChar(ch: WideChar): boolean;
+begin
+ // TODO: add chars > 255 (or replace with libxml2 functions?)
+ case ch of
+ ' '..'/',':'..'@','['..'`','{'..'~',
+ #160..#191,#215,#247:
+ Result := true;
+ else
+ Result := false;
+ end;
+end;
+
+function IsPunctuationChar(ch: UCS4Char): boolean;
+begin
+ Result := IsPunctuationChar(WideChar(Ord(ch)));
+end;
+
+function IsControlChar(ch: WideChar): boolean;
+begin
+ case ch of
+ #0..#31,
+ #127..#159:
+ Result := true;
+ else
+ Result := false;
+ end;
+end;
+
+function IsControlChar(ch: UCS4Char): boolean;
+begin
+ Result := IsControlChar(WideChar(Ord(ch)));
+end;
+
+function IsPrintableChar(ch: WideChar): boolean;
+begin
+ Result := not IsControlChar(ch);
+end;
+
+function IsPrintableChar(ch: UCS4Char): boolean;
+begin
+ Result := IsPrintableChar(WideChar(Ord(ch)));
+end;
+
+
+function NextCharUTF8(var StrPtr: PAnsiChar; out Ch: UCS4Char): boolean;
+
+ // find the most significant zero bit (Result: [7..-1])
+ function FindZeroMSB(b: byte): integer;
+ var
+ Mask: byte;
+ begin
+ Mask := $80;
+ Result := 7;
+ while (b and Mask <> 0) do
+ begin
+ Mask := Mask shr 1;
+ Dec(Result);
+ end;
+ end;
+
+var
+ ZeroBit: integer;
+ SeqCount: integer; // number of trailing bytes to follow
+const
+ Mask: array[1..3] of byte = ($1F, $0F, $07);
+begin
+ Result := false;
+ SeqCount := 0;
+ Ch := 0;
+
+ while (StrPtr^ <> #0) do
+ begin
+ if (StrPtr^ < #128) then
+ begin
+ // check that no more trailing bytes are expected
+ if (SeqCount = 0) then
+ begin
+ Ch := Ord(StrPtr^);
+ Inc(StrPtr);
+ Result := true;
+ end;
+ Break;
+ end
+ else
+ begin
+ ZeroBit := FindZeroMSB(Ord(StrPtr^));
+ // trailing byte expected
+ if (SeqCount > 0) then
+ begin
+ // check if trailing byte has pattern 10xxxxxx
+ if (ZeroBit <> 6) then
+ begin
+ Inc(StrPtr);
+ Break;
+ end;
+
+ Dec(SeqCount);
+ Ch := (Ch shl 6) or (Ord(StrPtr^) and $3F);
+
+ // check if char is finished
+ if (SeqCount = 0) then
+ begin
+ Inc(StrPtr);
+ Result := true;
+ Break;
+ end;
+ end
+ else // leading byte expected
+ begin
+ // check if pattern is one of 110xxxxx/1110xxxx/11110xxx
+ if (ZeroBit > 5) or (ZeroBit < 3) then
+ begin
+ Inc(StrPtr);
+ Break;
+ end;
+ // calculate number of trailing bytes (1, 2 or 3)
+ SeqCount := 6 - ZeroBit;
+ // extract first part of char
+ Ch := Ord(StrPtr^) and Mask[SeqCount];
+ end;
+ end;
+
+ Inc(StrPtr);
+ end;
+
+ if (not Result) then
+ Ch := Ord('?');
+end;
+
+function IsUTF8String(const str: RawByteString): boolean;
+var
+ Ch: UCS4Char;
+ StrPtr: PAnsiChar;
+begin
+ Result := true;
+ StrPtr := PChar(str);
+ while (StrPtr^ <> #0) do
+ begin
+ if (not NextCharUTF8(StrPtr, Ch)) then
+ begin
+ Result := false;
+ Exit;
+ end;
+ end;
+end;
+
+function IsASCIIString(const str: RawByteString): boolean;
+var
+ I: integer;
+begin
+ for I := 1 to Length(str) do
+ begin
+ if (str[I] >= #128) then
+ begin
+ Result := false;
+ Exit;
+ end;
+ end;
+ Result := true;
+end;
+
+
+function UTF8ToUCS4String(const str: UTF8String): UCS4String;
+begin
+ Result := WideStringToUCS4String(UTF8Decode(str));
+end;
+
+function UCS4ToUTF8String(const str: UCS4String): UTF8String;
+begin
+ Result := UTF8Encode(UCS4StringToWideString(str));
+end;
+
+function UCS4ToUTF8String(ch: UCS4Char): UTF8String;
+begin
+ Result := UCS4ToUTF8String(UCS4CharToString(ch));
+end;
+
+function LengthUTF8(const str: UTF8String): integer;
+begin
+ Result := LengthUCS4(UTF8ToUCS4String(str));
+end;
+
+function LengthUCS4(const str: UCS4String): integer;
+begin
+ Result := High(str);
+ if (Result = -1) then
+ Result := 0;
+end;
+
+function UTF8CompareStr(const S1, S2: UTF8String): integer;
+begin
+ Result := WideCompareStr(UTF8Decode(S1), UTF8Decode(S2));
+end;
+
+function UTF8CompareText(const S1, S2: UTF8String): integer;
+begin
+ Result := WideCompareText(UTF8Decode(S1), UTF8Decode(S2));
+end;
+
+function UTF8StartsStr(const SubText, Text: UTF8String): boolean;
+begin
+ // TODO: use WideSameStr (slower but handles different representations of the same char)?
+ Result := (Pos(SubText, Text) = 1);
+end;
+
+function UTF8StartsText(const SubText, Text: UTF8String): boolean;
+begin
+ // TODO: use WideSameText (slower but handles different representations of the same char)?
+ Result := (Pos(UTF8UpperCase(SubText), UTF8UpperCase(Text)) = 1);
+end;
+
+function UTF8ContainsStr(const Text, SubText: UTF8String): boolean;
+begin
+ Result := Pos(SubText, Text) > 0;
+end;
+
+function UTF8ContainsText(const Text, SubText: UTF8String): boolean;
+begin
+ Result := Pos(UTF8UpperCase(SubText), UTF8UpperCase(Text)) > 0;
+end;
+
+function UTF8UpperCase(const str: UTF8String): UTF8String;
+begin
+ Result := UTF8Encode(WideStringUpperCase(UTF8Decode(str)));
+end;
+
+function UTF8LowerCase(const str: UTF8String): UTF8String;
+begin
+ Result := UTF8Encode(WideStringLowerCase(UTF8Decode(str)));
+end;
+
+function UCS4UpperCase(ch: UCS4Char): UCS4Char;
+begin
+ Result := UCS4UpperCase(UCS4CharToString(ch))[0];
+end;
+
+function UCS4UpperCase(const str: UCS4String): UCS4String;
+begin
+ // convert to upper-case as WideString and convert result back to UCS-4
+ Result := WideStringToUCS4String(
+ WideStringUpperCase(
+ UCS4StringToWideString(str)));
+end;
+
+function UCS4CharToString(ch: UCS4Char): UCS4String;
+begin
+ SetLength(Result, 2);
+ Result[0] := ch;
+ Result[1] := 0;
+end;
+
+function UTF8Pos(const substr: UTF8String; const str: UTF8String): Integer;
+begin
+ Result := Pos(substr, str);
+end;
+
+function UTF8Copy(const str: UTF8String; Index: Integer; Count: Integer): UTF8String;
+begin
+ Result := UCS4ToUTF8String(UCS4Copy(UTF8ToUCS4String(str), Index-1, Count));
+end;
+
+function UCS4Copy(const str: UCS4String; Index: Integer; Count: Integer): UCS4String;
+var
+ I: integer;
+ MaxCount: integer;
+begin
+ // calculate max. copy count
+ MaxCount := LengthUCS4(str)-Index;
+ if (MaxCount < 0) then
+ MaxCount := 0;
+ // adjust copy count
+ if (Count > MaxCount) or (Count < 0) then
+ Count := MaxCount;
+
+ // copy (and add zero terminator)
+ SetLength(Result, Count + 1);
+ for I := 0 to Count-1 do
+ Result[I] := str[Index+I];
+ Result[Count] := 0;
+end;
+
+procedure UTF8Delete(var Str: UTF8String; Index: Integer; Count: Integer);
+var
+ StrUCS4: UCS4String;
+begin
+ StrUCS4 := UTF8ToUCS4String(str);
+ UCS4Delete(StrUCS4, Index-1, Count);
+ Str := UCS4ToUTF8String(StrUCS4);
+end;
+
+procedure UCS4Delete(var Str: UCS4String; Index: Integer; Count: Integer);
+var
+ Len: integer;
+ OldStr: UCS4String;
+ I: integer;
+begin
+ Len := LengthUCS4(Str);
+ if (Count <= 0) or (Index < 0) or (Index >= Len) then
+ Exit;
+ if (Index + Count > Len) then
+ Count := Len-Index;
+
+ OldStr := Str;
+ SetLength(Str, Len-Count+1);
+ for I := 0 to Index-1 do
+ Str[I] := OldStr[I];
+ for I := Index+Count to Len-1 do
+ Str[I-Count] := OldStr[I];
+ Str[High(Str)] := 0;
+end;
+
+function WideStringUpperCase(ch: WideChar): WideString;
+begin
+ // If WideChar #0 is converted to a WideString in Delphi, a string with
+ // length 1 and a single char #0 is returned. In FPC an empty (length=0)
+ // string will be returned. This will crash, if a non printable key was
+ // pressed, its char code (#0) is translated to upper-case and the the first
+ // character is accessed with Result[1].
+ // We cannot catch this error in the WideString parameter variant as the string
+ // has length 0 already.
+
+ // Force min. string length of 1
+ if (ch = #0) then
+ Result := #0
+ else
+ Result := WideStringUpperCase(WideString(ch));
+end;
+
+function WideStringUpperCase(const str: WideString): WideString;
+begin
+ // On Linux and MacOSX the cwstring unit is necessary for Unicode function-calls.
+ // Otherwise you will get an EIntOverflow exception (thrown by unimplementedwidestring()).
+ // The Unicode manager cwstring does not work with MacOSX at the moment because
+ // of missing references to iconv.
+ // Note: Should be fixed now
+
+ {.$IFNDEF DARWIN}
+ {.$IFDEF NOIGNORE}
+ Result := WideUpperCase(str)
+ {.$ELSE}
+ //Result := UTF8Decode(UpperCase(UTF8Encode(str)));
+ {.$ENDIF}
+end;
+
+function WideStringLowerCase(ch: WideChar): WideString;
+begin
+ // see WideStringUpperCase
+ if (ch = #0) then
+ Result := #0
+ else
+ Result := WideStringLowerCase(WideString(ch));
+end;
+
+function WideStringLowerCase(const str: WideString): WideString;
+begin
+ // see WideStringUpperCase
+ Result := WideLowerCase(str)
+end;
+
+function WideStringReplaceChar(const 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;
+
+initialization
+ InitUnicodeUtils;
+
+end.
diff --git a/cmake/src/base/UXMLSong.pas b/cmake/src/base/UXMLSong.pas
index 58b48789..e9751eba 100644
--- a/cmake/src/base/UXMLSong.pas
+++ b/cmake/src/base/UXMLSong.pas
@@ -34,7 +34,9 @@ interface
{$I switches.inc}
uses
- Classes;
+ Classes,
+ UPath,
+ UUnicodeUtils;
type
TNote = record
@@ -42,30 +44,30 @@ type
Duration: Cardinal;
Tone: Integer;
NoteTyp: Byte;
- Lyric: String;
+ Lyric: UTF8String;
end;
- ANote = Array of TNote;
+ ANote = array of TNote;
TSentence = record
Singer: Byte;
Duration: Cardinal;
Notes: ANote;
end;
- ASentence = Array of TSentence;
+ ASentence = array of TSentence;
- TSongInfo = Record
+ TSongInfo = record
ID: Cardinal;
DualChannel: Boolean;
- Header: Record
- Artist: String;
- Title: String;
+ Header: record
+ Artist: UTF8String;
+ Title: UTF8String;
Gap: Cardinal;
BPM: Real;
Resolution: Byte;
- Edition: String;
- Genre: String;
- Year: String;
- Language: String;
+ Edition: UTF8String;
+ Genre: UTF8String;
+ Year: UTF8String;
+ Language: UTF8String;
end;
CountSentences: Cardinal;
Sentences: ASentence;
@@ -81,23 +83,23 @@ type
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;
+ function ParseLine(Line: RawByteString): Boolean;
public
SongInfo: TSongInfo;
- ErrorMessage: String;
- Edition: String;
- SingstarVersion: String;
+ ErrorMessage: string;
+ Edition: UTF8String;
+ SingstarVersion: string;
- Settings: Record
+ Settings: record
DashReplacement: Char;
end;
- Constructor Create;
+ constructor Create;
- Function ParseConfigforEdition(const Filename: String): String;
+ function ParseConfigForEdition(const Filename: IPath): String;
- Function ParseSongHeader(const Filename: String): Boolean; //Parse Song Header only
- Function ParseSong (const Filename: String): Boolean; //Parse whole Song
+ function ParseSongHeader(const Filename: IPath): Boolean; //Parse Song Header only
+ function ParseSong (const Filename: IPath): Boolean; //Parse whole Song
end;
const
@@ -114,9 +116,12 @@ const
DS_Both = 3;
implementation
-uses SysUtils, StrUtils;
-Constructor TParser.Create;
+uses
+ SysUtils,
+ StrUtils;
+
+constructor TParser.Create;
begin
inherited Create;
ErrorMessage := '';
@@ -124,19 +129,24 @@ begin
DecimalSeparator := '.';
end;
-Function TParser.ParseSong (const Filename: String): Boolean;
-var I: Integer;
+function TParser.ParseSong(const Filename: IPath): Boolean;
+var
+ I: Integer;
+ FileStream: TBinaryFileStream;
begin
Result := False;
- if FileExists(Filename) then
+ if Filename.IsFile() then
begin
- SSFile := TStringList.Create;
+ ErrorMessage := 'Can''t open melody.xml file';
+ SSFile := TStringList.Create;
+ FileStream := TBinaryFileStream.Create(Filename, fmOpenRead);
try
- ErrorMessage := 'Can''t open melody.xml file';
- SSFile.LoadFromFile(Filename);
+ SSFile.LoadFromStream(FileStream);
+
ErrorMessage := '';
Result := True;
+
I := 0;
SongInfo.CountSentences := 0;
@@ -153,7 +163,7 @@ begin
SetLength(SongInfo.Sentences, 0);
- While Result And (I < SSFile.Count) do
+ while Result and (I < SSFile.Count) do
begin
Result := ParseLine(SSFile.Strings[I]);
@@ -162,21 +172,24 @@ begin
finally
SSFile.Free;
+ FileStream.Free;
end;
end;
end;
-Function TParser.ParseSongHeader (const Filename: String): Boolean;
-var I: Integer;
+function TParser.ParseSongHeader (const Filename: IPath): Boolean;
+var
+ I: Integer;
+ Stream: TBinaryFileStream;
begin
Result := False;
- if FileExists(Filename) then
+
+ if Filename.IsFile() then
begin
SSFile := TStringList.Create;
- SSFile.Clear;
-
+ Stream := TBinaryFileStream.Create(Filename, fmOpenRead);
try
- SSFile.LoadFromFile(Filename);
+ SSFile.LoadFromStream(Stream);
If (SSFile.Count > 0) then
begin
@@ -207,6 +220,7 @@ begin
finally
SSFile.Free;
+ Stream.Free;
end;
end
else
@@ -569,18 +583,20 @@ begin
Result := true;
end;
-Function TParser.ParseConfigforEdition(const Filename: String): String;
+Function TParser.ParseConfigForEdition(const Filename: IPath): String;
var
txt: TStringlist;
+ Stream: TBinaryFileStream;
I: Integer;
J, K: Integer;
S: String;
begin
Result := '';
- txt := TStringlist.Create;
- try
- txt.LoadFromFile(Filename);
+ Stream := TBinaryFileStream.Create(Filename, fmOpenRead);
+ try
+ txt := TStringlist.Create;
+ txt.LoadFromStream(Stream);
For I := 0 to txt.Count-1 do
begin
S := Trim(txt.Strings[I]);
@@ -600,6 +616,7 @@ begin
Edition := Result;
finally
txt.Free;
+ Stream.Free;
end;
end;
--
cgit v1.2.3