diff options
Diffstat (limited to 'cmake/src/base')
43 files changed, 8527 insertions, 4793 deletions
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 @@ -206,6 +244,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 *) destructor TDataBaseSystem.Destroy; @@ -216,33 +363,55 @@ begin 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; {** @@ -431,11 +451,55 @@ 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'); @@ -508,14 +545,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. *) @@ -562,34 +591,12 @@ begin 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 @@ -116,37 +120,30 @@ 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; @@ -400,9 +423,33 @@ begin 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; @@ -513,6 +562,27 @@ begin 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; |