From 3260749d369d3466c345d40a8b2189c32c8c1b60 Mon Sep 17 00:00:00 2001 From: Alexander Sulfrian Date: Mon, 7 Nov 2011 15:26:44 +0100 Subject: removed pascal code --- src/base/TextGL.pas | 211 ---- src/base/UBeatTimer.pas | 170 --- src/base/UCatCovers.pas | 214 ---- src/base/UCommandLine.pas | 345 ----- src/base/UCommon.pas | 584 --------- src/base/UConfig.pas | 232 ---- src/base/UCovers.pas | 459 ------- src/base/UDLLManager.pas | 293 ----- src/base/UDataBase.pas | 614 --------- src/base/UDraw.pas | 1408 --------------------- src/base/UEditorLyrics.pas | 259 ---- src/base/UFiles.pas | 212 ---- src/base/UFilesystem.pas | 692 ---------- src/base/UFont.pas | 2798 ----------------------------------------- src/base/UGraphic.pas | 823 ------------ src/base/UGraphicClasses.pas | 720 ----------- src/base/UIni.pas | 1219 ------------------ src/base/UJoystick.pas | 312 ----- src/base/ULog.pas | 441 ------- src/base/ULyrics.pas | 726 ----------- src/base/UMain.pas | 569 --------- src/base/UMusic.pas | 1139 ----------------- src/base/UNote.pas | 591 --------- src/base/UParty.pas | 388 ------ src/base/UPathUtils.pas | 196 --- src/base/UPlatform.pas | 135 -- src/base/UPlatformLinux.pas | 149 --- src/base/UPlatformMacOSX.pas | 279 ---- src/base/UPlatformWindows.pas | 128 -- src/base/UPlaylist.pas | 520 -------- src/base/URecord.pas | 777 ------------ src/base/USingScores.pas | 1122 ----------------- src/base/USkins.pas | 220 ---- src/base/USong.pas | 1348 -------------------- src/base/USongs.pas | 845 ------------- src/base/UTextEncoding.pas | 247 ---- src/base/UTexture.pas | 547 -------- src/base/UThemes.pas | 2397 ----------------------------------- src/base/UUnicodeUtils.pas | 670 ---------- src/base/UXMLSong.pas | 623 --------- 40 files changed, 25622 deletions(-) delete mode 100644 src/base/TextGL.pas delete mode 100644 src/base/UBeatTimer.pas delete mode 100644 src/base/UCatCovers.pas delete mode 100644 src/base/UCommandLine.pas delete mode 100644 src/base/UCommon.pas delete mode 100644 src/base/UConfig.pas delete mode 100644 src/base/UCovers.pas delete mode 100644 src/base/UDLLManager.pas delete mode 100644 src/base/UDataBase.pas delete mode 100644 src/base/UDraw.pas delete mode 100644 src/base/UEditorLyrics.pas delete mode 100644 src/base/UFiles.pas delete mode 100644 src/base/UFilesystem.pas delete mode 100644 src/base/UFont.pas delete mode 100644 src/base/UGraphic.pas delete mode 100644 src/base/UGraphicClasses.pas delete mode 100644 src/base/UIni.pas delete mode 100644 src/base/UJoystick.pas delete mode 100644 src/base/ULog.pas delete mode 100644 src/base/ULyrics.pas delete mode 100644 src/base/UMain.pas delete mode 100644 src/base/UMusic.pas delete mode 100644 src/base/UNote.pas delete mode 100644 src/base/UParty.pas delete mode 100644 src/base/UPathUtils.pas delete mode 100644 src/base/UPlatform.pas delete mode 100644 src/base/UPlatformLinux.pas delete mode 100644 src/base/UPlatformMacOSX.pas delete mode 100644 src/base/UPlatformWindows.pas delete mode 100644 src/base/UPlaylist.pas delete mode 100644 src/base/URecord.pas delete mode 100644 src/base/USingScores.pas delete mode 100644 src/base/USkins.pas delete mode 100644 src/base/USong.pas delete mode 100644 src/base/USongs.pas delete mode 100644 src/base/UTextEncoding.pas delete mode 100644 src/base/UTexture.pas delete mode 100644 src/base/UThemes.pas delete mode 100644 src/base/UUnicodeUtils.pas delete mode 100644 src/base/UXMLSong.pas (limited to 'src/base') diff --git a/src/base/TextGL.pas b/src/base/TextGL.pas deleted file mode 100644 index 7fe98d29..00000000 --- a/src/base/TextGL.pas +++ /dev/null @@ -1,211 +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 TextGL; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses - gl, - glext, - SDL, - Classes, - UTexture, - UFont, - UPath, - 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: 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 SetFontReflection(Enable:boolean;Spacing: real); // enables/disables text reflection - -implementation - -uses - UTextEncoding, - SysUtils, - IniFiles, - UCommon, - UMain, - UPathUtils; - -function FindFontFile(FontIni: TCustomIniFile; Font: string): IPath; -var - Filename: IPath; -begin - Filename := Path(FontIni.ReadString(Font, 'File', '')); - Result := FontPath.Append(Filename); - // if path does not exist, try as an absolute path - if (not Result.IsFile) then - Result := Filename; -end; - -procedure BuildFont; -var - FontIni: TMemIniFile; - FontFile: IPath; -begin - ActFont := 0; - - SetLength(Fonts, 4); - FontIni := TMemIniFile.Create(FontPath.Append('fonts.ini').ToNative); - - 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; - - // 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: UTF8String): real; -var - Bounds: TBoundsDbl; -begin - Bounds := Fonts[ActFont].Font.BBox(Text, true); - Result := Bounds.Right - Bounds.Left; -end; - -// Custom GL "Print" Routine -procedure glPrint(const Text: UTF8String); -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 - GLFont.Font.Print(Text); - 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/src/base/UBeatTimer.pas b/src/base/UBeatTimer.pas deleted file mode 100644 index 310a49cd..00000000 --- a/src/base/UBeatTimer.pas +++ /dev/null @@ -1,170 +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 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 - 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(); -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; - -end. \ No newline at end of file diff --git a/src/base/UCatCovers.pas b/src/base/UCatCovers.pas deleted file mode 100644 index d33bbbe1..00000000 --- a/src/base/UCatCovers.pas +++ /dev/null @@ -1,214 +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 UCatCovers; -///////////////////////////////////////////////////////////////////////// -// UCatCovers by Whiteshark // -// Class for listing and managing the Category Covers // -///////////////////////////////////////////////////////////////////////// - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses - UIni, - UPath; - -type - TCatCovers = class - protected - cNames: array [0..high(ISorting)] of array of UTF8String; - cFiles: array [0..high(ISorting)] of array of IPath; - public - constructor Create; - procedure Load; //Load Cover aus Cover.ini and Cover Folder - procedure LoadPath(const CoversPath: IPath); - procedure Add(Sorting: integer; const Name: UTF8String; const Filename: IPath); //Add a Cover - function CoverExists(Sorting: integer; const Name: UTF8String): boolean; //Returns True when a cover with the given Name exists - function GetCover(Sorting: integer; const Name: UTF8String): IPath; //Returns the Filename of a Cover - end; - -var - CatCovers: TCatCovers; - -implementation - -uses - IniFiles, - SysUtils, - Classes, - UFilesystem, - ULog, - UMain, - UUnicodeUtils, - UPathUtils; - -constructor TCatCovers.Create; -begin - inherited; - Load; -end; - -procedure TCatCovers.Load; -var - I: integer; -begin - for I := 0 to CoverPaths.Count-1 do - LoadPath(CoverPaths[I] as IPath); -end; - -(** - * Load Cover from Cover.ini and Cover Folder - *) -procedure TCatCovers.LoadPath(const CoversPath: IPath); -var - Ini: TMemIniFile; - List: TStringlist; - I, J: Integer; - Filename: IPath; - Name, TmpName: UTF8String; - CatCover: IPath; - Iter: IFileIterator; - FileInfo: TFileInfo; -begin - Ini := nil; - List := nil; - - try - 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 - begin - Ini.ReadSection(ISorting[I], List); - - for J := 0 to List.Count - 1 do - begin - CatCover := Path(Ini.ReadString(ISorting[I], List.Strings[J], 'NoCover.jpg')); - Add(I, List.Strings[J], CoversPath.Append(CatCover)); - end; - end; - finally - Ini.Free; - List.Free; - end; - - //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 I := 0 to high(ISorting) do - begin - TmpName := Name; - if (I = sTitle) and (UTF8Pos('Title', TmpName) <> 0) then - UTF8Delete(TmpName, UTF8Pos('Title', TmpName), 5) - else if (I = sArtist) and (UTF8Pos('Artist', TmpName) <> 0) then - UTF8Delete(TmpName, UTF8Pos('Artist', TmpName), 6); - - if not CoverExists(I, TmpName) then - Add(I, TmpName, Filename); - end; - end; -end; - - //Add a Cover -procedure TCatCovers.Add(Sorting: integer; const Name: UTF8String; const Filename: IPath); -begin - if Filename.IsFile then //If Exists -> Add - begin - SetLength(CNames[Sorting], Length(CNames[Sorting]) + 1); - SetLength(CFiles[Sorting], Length(CNames[Sorting]) + 1); - - 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; const Name: UTF8String): boolean; -var - I: Integer; - UpperName: UTF8String; -begin - Result := False; - UpperName := UTF8Uppercase(Name); //Case Insensitiv - - for I := 0 to high(cNames[Sorting]) do - begin - if (cNames[Sorting][I] = UpperName) then //Found Name - begin - Result := true; - break; //Break For Loop - end; - end; -end; - - //Returns the Filename of a Cover -function TCatCovers.GetCover(Sorting: integer; const Name: UTF8String): IPath; -var - I: Integer; - UpperName: UTF8String; - NoCoverPath: IPath; -begin - Result := PATH_NONE; - UpperName := UTF8Uppercase(Name); - - for I := 0 to high(cNames[Sorting]) do - begin - if cNames[Sorting][I] = UpperName then - begin - Result := cFiles[Sorting][I]; - Break; - end; - end; - - //No Cover - if (Result.IsUnset) then - begin - for I := 0 to CoverPaths.Count-1 do - begin - NoCoverPath := (CoverPaths[I] as IPath).Append('NoCover.jpg'); - if (NoCoverPath.IsFile) then - begin - Result := NoCoverPath; - Break; - end; - end; - end; -end; - -end. diff --git a/src/base/UCommandLine.pas b/src/base/UCommandLine.pas deleted file mode 100644 index ac0db2c2..00000000 --- a/src/base/UCommandLine.pas +++ /dev/null @@ -1,345 +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 UCommandLine; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses - UPath; - -type - TScreenMode = (scmDefault, scmFullscreen, scmWindowed); - - {** - * Reads infos from ParamStr and set some easy interface variables - *} - TCMDParams = class - private - fLanguage: string; - fResolution: string; - - procedure ShowHelp(); - - procedure ReadParamInfo; - procedure ResetVariables; - - function GetLanguage: integer; - function GetResolution: integer; - public - // some boolean variables set when reading infos - Debug: boolean; - Benchmark: boolean; - NoLog: boolean; - ScreenMode: TScreenMode; - Joypad: boolean; - - // some value variables set when reading infos {-1: Not Set, others: Value} - Depth: integer; - Screens: integer; - - // some strings set when reading infos {Length=0: Not Set} - SongPath: IPath; - ConfigFile: IPath; - ScoreFile: IPath; - - // pseudo integer values - property Language: integer read GetLanguage; - property Resolution: integer read GetResolution; - - // some procedures for reading infos - constructor Create; - end; - -var - Params: TCMDParams; - -const - cHelp = 'help'; - cDebug = 'debug'; - cMediaInterfaces = 'showinterfaces'; - - -implementation - -uses SysUtils, - UPlatform; - -{** - * Resets variables and reads info - *} -constructor TCMDParams.Create; -begin - inherited; - - if FindCmdLineSwitch( cHelp ) or FindCmdLineSwitch( 'h' ) then - ShowHelp(); - - ResetVariables; - ReadParamInfo; -end; - -procedure TCMDParams.ShowHelp(); - - function Fmt(aString : string) : string; - begin - Result := Format('%-15s', [aString]); - end; - -begin - writeln; - writeln('**************************************************************'); - writeln(' UltraStar Deluxe - Command line switches '); - writeln('**************************************************************'); - writeln; - writeln(' '+ Fmt('Switch') +' : Purpose'); - writeln(' ----------------------------------------------------------'); - writeln(' '+ Fmt(cMediaInterfaces) +' : Show in-use media interfaces'); - writeln(' '+ Fmt(cDebug) +' : Display Debugging info'); - writeln; - - platform.halt; -end; - -{** - * Reset Class Variables - *} -procedure TCMDParams.ResetVariables; -begin - Debug := False; - Benchmark := False; - NoLog := False; - ScreenMode := scmDefault; - Joypad := False; - - // some value variables set when reading infos {-1: Not Set, others: Value} - fResolution := ''; - fLanguage := ''; - Depth := -1; - Screens := -1; - - // some strings set when reading infos {Length=0 Not Set} - SongPath := PATH_NONE; - ConfigFile := PATH_NONE; - ScoreFile := PATH_NONE; -end; - -{** - * Read command-line parameters - *} -procedure TCMDParams.ReadParamInfo; -var - I: integer; - PCount: integer; - Command: string; -begin - PCount := ParamCount; - //Log.LogError('ParamCount: ' + Inttostr(PCount)); - - // check all parameters - for I := 1 to PCount do - begin - Command := ParamStr(I); - // check if the string is a parameter - if (Length(Command) > 1) and (Command[1] = '-') then - begin - // remove '-' from command - Command := LowerCase(Trim(Copy(Command, 2, Length(Command) - 1))); - //Log.LogError('Command prepared: ' + Command); - - // check command - - // boolean triggers - if (Command = 'debug') then - Debug := True - else if (Command = 'benchmark') then - Benchmark := True - else if (Command = 'nolog') then - NoLog := True - else if (Command = 'fullscreen') then - ScreenMode := scmFullscreen - else if (Command = 'window') then - ScreenMode := scmWindowed - else if (Command = 'joypad') then - Joypad := True - - // integer variables - else if (Command = 'depth') then - begin - // check if there is another Parameter to get the Value from - if (PCount > I) then - begin - Command := ParamStr(I + 1); - - // check for valid value - // FIXME: guessing an array-index of depth is very error prone. - If (Command = '16') then - Depth := 0 - Else If (Command = '32') then - Depth := 1; - end; - end - - else if (Command = 'screens') then - begin - // check if there is another parameter to get the value from - if (PCount > I) then - begin - Command := ParamStr(I + 1); - - // check for valid value - If (Command = '1') then - Screens := 0 - Else If (Command = '2') then - Screens := 1; - end; - end - - // pseudo integer values - else if (Command = 'language') then - begin - // check if there is another parameter to get the value from - if (PCount > I) then - begin - // write value to string - fLanguage := Lowercase(ParamStr(I + 1)); - end; - end - - else if (Command = 'resolution') then - begin - // check if there is another parameter to get the value from - if (PCount > I) then - begin - // write value to string - fResolution := Lowercase(ParamStr(I + 1)); - end; - end - - // string values - else if (Command = 'songpath') then - begin - // check if there is another parameter to get the value from - if (PCount > I) then - begin - // write value to string - SongPath := Path(ParamStr(I + 1)); - end; - end - - else if (Command = 'configfile') then - begin - // check if there is another parameter to get the value from - if (PCount > I) then - begin - // write value to string - ConfigFile := Path(ParamStr(I + 1)); - - // is this a relative path -> then add gamepath - if (not ConfigFile.IsAbsolute) then - ConfigFile := Platform.GetExecutionDir().Append(ConfigFile); - end; - end - - else if (Command = 'scorefile') then - begin - // check if there is another parameter to get the value from - if (PCount > I) then - begin - // write value to string - ScoreFile := Path(ParamStr(I + 1)); - end; - end; - - end; - - end; - -{ - Log.LogInfo('Screens: ' + Inttostr(Screens)); - Log.LogInfo('Depth: ' + Inttostr(Depth)); - - Log.LogInfo('Resolution: ' + Inttostr(Resolution)); - Log.LogInfo('Resolution: ' + Inttostr(Language)); - - Log.LogInfo('sResolution: ' + sResolution); - Log.LogInfo('sLanguage: ' + sLanguage); - - Log.LogInfo('ConfigFile: ' + ConfigFile); - Log.LogInfo('SongPath: ' + SongPath); - Log.LogInfo('ScoreFile: ' + ScoreFile); -} - -end; - -//------------- -// GetLanguage - Get Language ID from saved String Information -//------------- -function TCMDParams.GetLanguage: integer; -{var - I: integer; -} -begin - Result := -1; -{* JB - 12sep07 to remove uINI dependency - - //Search for Language - For I := 0 to high(ILanguage) do - if (LowerCase(ILanguage[I]) = sLanguage) then - begin - Result := I; - Break; - end; -*} -end; - -//------------- -// GetResolution - Get Resolution ID from saved String Information -//------------- -function TCMDParams.GetResolution: integer; -{var - I: integer; -} -begin - Result := -1; -{* JB - 12sep07 to remove uINI dependency - - //Search for Resolution - For I := 0 to high(IResolution) do - if (LowerCase(IResolution[I]) = sResolution) then - begin - Result := I; - Break; - end; -*} -end; - -end. diff --git a/src/base/UCommon.pas b/src/base/UCommon.pas deleted file mode 100644 index fa0faf3c..00000000 --- a/src/base/UCommon.pas +++ /dev/null @@ -1,584 +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 UCommon; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses - SysUtils, - Classes, - {$IFDEF MSWINDOWS} - Windows, - {$ENDIF} - UConfig, - ULog, - UPath; - -type - TStringDynArray = array of string; - -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); - -procedure ShowMessage(const msg: string; msgType: TMessageType = mtInfo); - -procedure ConsoleWriteLn(const msg: string); - -{$IFDEF FPC} -function RandomRange(aMin: integer; aMax: integer): integer; -{$ENDIF} - -procedure DisableFloatingPointExceptions(); -procedure SetDefaultNumericLocale(); -procedure RestoreNumericLocale(); - -{$IFNDEF MSWINDOWS} -procedure ZeroMemory(Destination: pointer; Length: dword); -function MakeLong(a, b: word): longint; -{$ENDIF} - -// A stable alternative to TList.Sort() (use TList.Sort() if applicable, see below) -procedure MergeSort(List: TList; CompareFunc: TListSortCompare); - -function GetAlignedMem(Size: cardinal; Alignment: integer): pointer; -procedure FreeAlignedMem(P: pointer); - - -implementation - -uses - Math, - {$IFDEF Delphi} - Dialogs, - {$ENDIF} - 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)} - -var - PrevNumLocale: string; - -const - LC_NUMERIC = 1; - -function setlocale(category: integer; locale: pchar): pchar; cdecl; external 'c' name 'setlocale'; - -{$IFEND} - -// In Linux and maybe MacOSX some units (like cwstring) call setlocale(LC_ALL, '') -// to set the language/country specific locale (e.g. charset) for this application. -// Unfortunately, LC_NUMERIC is set by this call too. -// It defines the decimal-separator and other country-specific numeric settings. -// This parameter is used by the C string-to-float parsing functions atof() and strtod(). -// After changing LC_NUMERIC some external C-based libs (like projectM) are not -// able to parse strings correctly -// (e.g. in Germany "0.9" is not recognized as a valid number anymore but "0,9" is). -// So we reset the numeric settings to the default ('C'). -// Note: The behaviour of Pascal parsing functions (e.g. strtofloat()) is not -// changed by this because it doesn't use the locale-settings. -// TODO: -// - Check if this is needed in MacOSX (at least the locale is set in cwstring) -// - Find out which libs are concerned by this problem. -// If only projectM is concerned by this problem set and restore the numeric locale -// for each call to projectM instead of changing it globally. -procedure SetDefaultNumericLocale(); -begin - {$IF Defined(LINUX) or Defined(FreeBSD)} - PrevNumLocale := setlocale(LC_NUMERIC, nil); - setlocale(LC_NUMERIC, 'C'); - {$IFEND} -end; - -procedure RestoreNumericLocale(); -begin - {$IF Defined(LINUX) or Defined(FreeBSD)} - setlocale(LC_NUMERIC, PChar(PrevNumLocale)); - {$IFEND} -end; - -(* - * If an invalid floating point operation was performed the Floating-point unit (FPU) - * generates a Floating-point exception (FPE). Dependending on the settings in - * the FPU's control-register (interrupt mask) the FPE is handled by the FPU itself - * (we will call this as "FPE disabled" later on) or is passed to the application - * (FPE enabled). - * If FPEs are enabled a floating-point division by zero (e.g. 10.0 / 0.0) is - * considered an error and an exception is thrown. Otherwise the FPU will handle - * the error and return the result infinity (INF) (10.0 / 0.0 = INF) without - * throwing an error to the application. - * The same applies to a division by INF that either raises an exception - * (FPE enabled) or returns 0.0 (FPE disabled). - * Normally (as with C-programs), Floating-point exceptions (FPE) are DISABLED - * on program startup (at least with Intel CPUs), but for some strange reasons - * they are ENABLED in pascal (both delphi and FPC) by default. - * Many libs operating with floating-point values rely heavily on the C-specific - * behaviour. So using them in delphi is a ticking time-bomb because sooner or - * later they will crash because of an FPE (this problem occurs massively - * in OpenGL-based libs like projectM). In contrast to this no error will occur - * if the lib is linked to a C-program. - * - * Further info on FPUs: - * For x86 and x86_64 CPUs we have to consider two FPU instruction sets. - * The math co-processor i387 (aka 8087 or x87) set introduced with the i386 - * and SSE (Streaming SIMD Extensions) introduced with the Pentium3. - * Both of them have separate control-registers (x87: FPUControlWord, SSE: MXCSR) - * to control FPEs. Either has (among others) 6bits to enable/disable several - * exception types (Invalid,Denormalized,Zero,Overflow,Underflow,Precision). - * Those exception-types must all be masked (=1) to get the default C behaviour. - * The control-registers can be set with the asm-ops FLDCW (x87) and LDMXCSR (SSE). - * Instead of using assembler code, we can use Set8087CW() provided by delphi and - * FPC to set the x87 control-word. FPC also provides SetSSECSR() for SSE's MXCSR. - * Note that both Delphi and FPC enable FPEs (e.g. for div-by-zero) on program - * startup but only FPC enables FPEs (especially div-by-zero) for SSE too. - * So we have to mask FPEs for x87 in Delphi and FPC and for SSE in FPC only. - * FPC and Delphi both provide a SetExceptionMask() for control of the FPE - * mask. SetExceptionMask() sets the masks for x87 in Delphi and for x87 and SSE - * in FPC (seems as if Delphi [2005] is not SSE aware). So SetExceptionMask() - * is what we need and it even is plattform and CPU independent. - * - * Pascal OpenGL headers (like the Delphi standard ones or JEDI-SDL headers) - * already call Set8087CW() to disable FPEs but due to some bugs in the JEDI-SDL - * headers they do not work properly with FPC. I already patched them, so they - * work at least until they are updated the next time. In addition Set8086CW() - * does not suffice to disable FPEs because the SSE FPEs are not disabled by this. - * FPEs with SSE are a big problem with some libs because many linux distributions - * optimize code for SSE or Pentium3 (for example: int(INF) which convert the - * double value "infinity" to an integer might be automatically optimized by - * using SSE's CVTSD2SI instruction). So SSE FPEs must be turned off in any case - * to make USDX portable. - * - * Summary: - * Call this function on initialization to make sure FPEs are turned off. - * It will solve a lot of errors with FPEs in external libs. - *) -procedure DisableFloatingPointExceptions(); -begin - (* - // We will use SetExceptionMask() instead of Set8087CW()/SetSSECSR(). - // Note: Leave these lines for documentation purposes just in case - // SetExceptionMask() does not work anymore (due to bugs in FPC etc.). - {$IF Defined(CPU386) or Defined(CPUI386) or Defined(CPUX86_64)} - Set8087CW($133F); - {$IFEND} - {$IF Defined(FPC)} - if (has_sse_support) then - SetSSECSR($1F80); - {$IFEND} - *) - - // disable all of the six FPEs (x87 and SSE) to be compatible with C/C++ and - // other libs which rely on the standard FPU behaviour (no div-by-zero FPE anymore). - SetExceptionMask([exInvalidOp, exDenormalized, exZeroDivide, - exOverflow, exUnderflow, exPrecision]); -end; - -{$IFNDEF MSWINDOWS} -procedure ZeroMemory(Destination: pointer; Length: dword); -begin - FillChar(Destination^, Length, 0); -end; - -function MakeLong(A, B: word): longint; -begin - Result := (LongInt(B) shl 16) + A; -end; - -{$ENDIF} - -{$IFDEF FPC} -function RandomRange(aMin: integer; aMax: integer): integer; -begin - RandomRange := Random(aMax - aMin) + aMin ; -end; -{$ENDIF} - - -{$IFDEF FPC} -var - MessageList: TStringList; - ConsoleHandler: TThreadID; - // Note: TRTLCriticalSection is defined in the units System and Libc, use System one - ConsoleCriticalSection: System.TRTLCriticalSection; - ConsoleEvent: PRTLEvent; - ConsoleQuit: boolean; -{$ENDIF} - -(* - * Write to console if one is available. - * It checks if a console is available before output so it will not - * crash on windows if none is available. - * Do not use this function directly because it is not thread-safe, - * use ConsoleWriteLn() instead. - *) -procedure _ConsoleWriteLn(const aString: string); {$IFDEF HasInline}inline;{$ENDIF} -begin - {$IFDEF MSWINDOWS} - // sanity check to avoid crashes with writeln() - if (IsConsole) then - begin - {$ENDIF} - Writeln(aString); - {$IFDEF MSWINDOWS} - end; - {$ENDIF} -end; - -{$IFDEF FPC} -{* - * The console-handlers main-function. - * TODO: create a quit-event on closing. - *} -function ConsoleHandlerFunc(param: pointer): PtrInt; -var - i: integer; - quit: boolean; -begin - quit := false; - while (not quit) do - begin - // wait for new output or quit-request - RTLeventWaitFor(ConsoleEvent); - - System.EnterCriticalSection(ConsoleCriticalSection); - // output pending messages - for i := 0 to MessageList.Count - 1 do - begin - _ConsoleWriteLn(MessageList[i]); - end; - MessageList.Clear(); - - // use local quit-variable to avoid accessing - // ConsoleQuit outside of the critical section - if (ConsoleQuit) then - quit := true; - - RTLeventResetEvent(ConsoleEvent); - System.LeaveCriticalSection(ConsoleCriticalSection); - end; - result := 0; -end; -{$ENDIF} - -procedure InitConsoleOutput(); -begin - {$IFDEF FPC} - // init thread-safe output - MessageList := TStringList.Create(); - System.InitCriticalSection(ConsoleCriticalSection); - ConsoleEvent := RTLEventCreate(); - ConsoleQuit := false; - // must be a thread managed by FPC. Otherwise (e.g. SDL-thread) - // it will crash when using Writeln. - ConsoleHandler := BeginThread(@ConsoleHandlerFunc); - {$ENDIF} -end; - -procedure FinalizeConsoleOutput(); -begin - {$IFDEF FPC} - // terminate console-handler - System.EnterCriticalSection(ConsoleCriticalSection); - ConsoleQuit := true; - RTLeventSetEvent(ConsoleEvent); - System.LeaveCriticalSection(ConsoleCriticalSection); - WaitForThreadTerminate(ConsoleHandler, 0); - // free data - System.DoneCriticalsection(ConsoleCriticalSection); - RTLeventDestroy(ConsoleEvent); - MessageList.Free(); - {$ENDIF} -end; - -{* - * FPC uses threadvars (TLS) managed by FPC for console output locking. - * Using WriteLn() from external threads (like in SDL callbacks) - * will crash the program as those threadvars have never been initialized. - * The solution is to create an FPC-managed thread which has the TLS data - * and use it to handle the console-output (hence it is called Console-Handler) - *} -procedure ConsoleWriteLn(const msg: string); -begin -{$IFDEF CONSOLE} - {$IFDEF FPC} - // TODO: check for the main-thread and use a simple _ConsoleWriteLn() then? - //GetCurrentThreadThreadId(); - System.EnterCriticalSection(ConsoleCriticalSection); - MessageList.Add(msg); - RTLeventSetEvent(ConsoleEvent); - System.LeaveCriticalSection(ConsoleCriticalSection); - {$ELSE} - _ConsoleWriteLn(msg); - {$ENDIF} -{$ENDIF} -end; - -procedure ShowMessage(const msg: String; msgType: TMessageType); -{$IFDEF MSWINDOWS} -var Flags: cardinal; -{$ENDIF} -begin -{$IF Defined(MSWINDOWS)} - case msgType of - mtInfo: Flags := MB_ICONINFORMATION or MB_OK; - mtError: Flags := MB_ICONERROR or MB_OK; - else Flags := MB_OK; - end; - MessageBox(0, PChar(msg), PChar(USDXVersionStr()), Flags); -{$ELSE} - ConsoleWriteln(msg); -{$IFEND} -end; - -(* - * Recursive part of the MergeSort algorithm. - * OutList will be either InList or TempList and will be swapped in each - * depth-level of recursion. By doing this it we can directly merge into the - * output-list. If we only had In- and OutList parameters we had to merge into - * InList after the recursive calls and copy the data to the OutList afterwards. - *) -procedure _MergeSort(InList, TempList, OutList: TList; StartPos, BlockSize: integer; - CompareFunc: TListSortCompare); -var - LeftSize, RightSize: integer; // number of elements in left/right block - LeftEnd, RightEnd: integer; // Index after last element in left/right block - MidPos: integer; // index of first element in right block - Pos: integer; // position in output list -begin - LeftSize := BlockSize div 2; - RightSize := BlockSize - LeftSize; - MidPos := StartPos + LeftSize; - - // sort left and right halves of this block by recursive calls of this function - if (LeftSize >= 2) then - _MergeSort(InList, OutList, TempList, StartPos, LeftSize, CompareFunc) - else - TempList[StartPos] := InList[StartPos]; - if (RightSize >= 2) then - _MergeSort(InList, OutList, TempList, MidPos, RightSize, CompareFunc) - else - TempList[MidPos] := InList[MidPos]; - - // merge sorted left and right sub-lists into output-list - LeftEnd := MidPos; - RightEnd := StartPos + BlockSize; - Pos := StartPos; - while ((StartPos < LeftEnd) and (MidPos < RightEnd)) do - begin - if (CompareFunc(TempList[StartPos], TempList[MidPos]) <= 0) then - begin - OutList[Pos] := TempList[StartPos]; - Inc(StartPos); - end - else - begin - OutList[Pos] := TempList[MidPos]; - Inc(MidPos); - end; - Inc(Pos); - end; - - // copy remaining elements to output-list - while (StartPos < LeftEnd) do - begin - OutList[Pos] := TempList[StartPos]; - Inc(StartPos); - Inc(Pos); - end; - while (MidPos < RightEnd) do - begin - OutList[Pos] := TempList[MidPos]; - Inc(MidPos); - Inc(Pos); - end; -end; - -(* - * Stable alternative to the instable TList.Sort() (uses QuickSort) implementation. - * A stable sorting algorithm preserves preordered items. E.g. if sorting by - * songs by title first and artist afterwards, the songs of each artist will - * be ordered by title. In contrast to this an unstable algorithm (like QuickSort) - * may destroy an existing order, so the songs of an artist will not be ordered - * by title anymore after sorting by artist in the previous example. - * If you do not need a stable algorithm, use TList.Sort() instead. - *) -procedure MergeSort(List: TList; CompareFunc: TListSortCompare); -var - TempList: TList; -begin - TempList := TList.Create(); - TempList.Count := List.Count; - if (List.Count >= 2) then - _MergeSort(List, TempList, List, 0, List.Count, CompareFunc); - TempList.Free; -end; - - -type - // stores the unaligned pointer of data allocated by GetAlignedMem() - PMemAlignHeader = ^TMemAlignHeader; - TMemAlignHeader = pointer; - -(** - * Use this function to assure that allocated memory is aligned on a specific - * byte boundary. - * Alignment must be a power of 2. - * - * Important: Memory allocated with GetAlignedMem() MUST be freed with - * FreeAlignedMem(), FreeMem() will cause a segmentation fault. - * - * Hint: If you do not need dynamic memory, consider to allocate memory - * statically and use the {$ALIGN x} compiler directive. Note that delphi - * supports an alignment "x" of up to 8 bytes only whereas FPC supports - * alignments on 16 and 32 byte boundaries too. - *) -{$WARNINGS OFF} -function GetAlignedMem(Size: cardinal; Alignment: integer): pointer; -var - OrigPtr: pointer; -const - MIN_ALIGNMENT = 16; -begin - // Delphi and FPC (tested with 2.2.0) align memory blocks allocated with - // GetMem() at least on 8 byte boundaries. Delphi uses a minimal alignment - // of either 8 or 16 bytes depending on the size of the requested block - // (see System.GetMinimumBlockAlignment). As we do not want to change the - // boundary for the worse, we align at least on MIN_ALIGN. - if (Alignment < MIN_ALIGNMENT) then - Alignment := MIN_ALIGNMENT; - - // allocate unaligned memory - GetMem(OrigPtr, SizeOf(TMemAlignHeader) + Size + Alignment); - if (OrigPtr = nil) then - begin - Result := nil; - Exit; - end; - - // reserve space for the header - Result := pointer(PtrUInt(OrigPtr) + SizeOf(TMemAlignHeader)); - // align memory - Result := pointer(PtrUInt(Result) + Alignment - PtrUInt(Result) mod Alignment); - - // set header with info on old pointer for FreeMem - PMemAlignHeader(PtrUInt(Result) - SizeOf(TMemAlignHeader))^ := OrigPtr; -end; -{$WARNINGS ON} - -{$WARNINGS OFF} -procedure FreeAlignedMem(P: pointer); -begin - if (P <> nil) then - FreeMem(PMemAlignHeader(PtrUInt(P) - SizeOf(TMemAlignHeader))^); -end; -{$WARNINGS ON} - - -initialization - InitConsoleOutput(); - -finalization - FinalizeConsoleOutput(); - -end. diff --git a/src/base/UConfig.pas b/src/base/UConfig.pas deleted file mode 100644 index f6dc69a5..00000000 --- a/src/base/UConfig.pas +++ /dev/null @@ -1,232 +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 UConfig; - -// ------------------------------------------------------------------- -// Note on version comparison (for developers only): -// ------------------------------------------------------------------- -// Delphi (in contrast to FPC) DOESN'T support MACROS. So we -// can't define a macro like VERSION_MAJOR(version) to extract -// parts of the version-number or to create version numbers for -// comparison purposes as with a MAKE_VERSION(maj, min, rev) macro. -// So we have to define constants for every part of the version here. -// -// In addition FPC (in contrast to delphi) DOES NOT support floating- -// point numbers in $IF compiler-directives (e.g. {$IF VERSION > 1.23}) -// It also DOESN'T support arithmetic operations so we aren't able to -// compare versions this way (brackets aren't supported too): -// {$IF VERSION > ((VER_MAJ*2)+(VER_MIN*23)+(VER_REL*1))} -// -// Hence we have to use fixed numbers in the directives. At least -// Pascal allows leading 0s so 0005 equals 5 (octals are -// preceded by & and not by 0 in FPC). -// We also fix the count of digits for each part of the version number -// to 3 (aaaiiirrr with aaa=major, iii=minor, rrr=release version) -// -// A check for a library with at least a version of 2.5.11 would look -// like this: -// {$IF LIB_VERSION >= 002005011} -// -// If you just need to check the major version do this: -// {$IF LIB_VERSION_MAJOR >= 23} -// -// IMPORTANT: -// Because this unit must be included in a uses-section it is -// not possible to use the version-numbers in this uses-clause. -// Example: -// interface -// uses -// versions, // include this file -// {$IF USE_UNIT_XYZ}xyz;{$IFEND} // Error: USE_UNIT_XYZ not defined -// const -// {$IF USE_UNIT_XYZ}test = 2;{$IFEND} // OK -// uses -// {$IF USE_UNIT_XYZ}xyz;{$IFEND} // OK -// -// Even if this file was an include-file no constants could be declared -// before the interface's uses clause. -// In FPC macros {$DEFINE VER:= 3} could be used to declare the version-numbers -// but this is incompatible to Delphi. In addition macros do not allow expand -// arithmetic expressions. Although you can define -// {$DEFINE FPC_VER:= FPC_VERSION*1000000+FPC_RELEASE*1000+FPC_PATCH} -// the following check would fail: -// {$IF FPC_VERSION_INT >= 002002000} -// would fail because FPC_VERSION_INT is interpreted as a string. -// -// PLEASE consider this if you use version numbers in $IF compiler- -// directives. Otherwise you might break portability. -// ------------------------------------------------------------------- - -interface - -{$IFDEF FPC} - {$MODE Delphi} - {$MACRO ON} // for evaluation of FPC_VERSION/RELEASE/PATCH -{$ENDIF} - -{$I switches.inc} - -uses - SysUtils; - -const - // IMPORTANT: - // If IncludeConstants is defined, the const-sections - // of the config-file will be included too. - // This switch is necessary because it is not possible to - // include the const-sections in the switches.inc. - // switches.inc is always included before the first uses- - // section but at that place no const-section is allowed. - // So we have to include the config-file in switches.inc - // with IncludeConstants undefined and in UConfig.pas with - // IncludeConstants defined (see the note above). - {$DEFINE IncludeConstants} - - // include config-file (defines + constants) - {$IF Defined(MSWindows)} - {$I ..\config-win.inc} - {$ELSEIF Defined(Linux)} - {$I ../config-linux.inc} - {$ELSEIF Defined(FreeBSD)} - {$I ../config-freebsd.inc} - {$ELSEIF Defined(Darwin)} - {$I ../config-darwin.inc} - {$ELSE} - {$MESSAGE Fatal 'Unknown OS'} - {$IFEND} - -{* Libraries *} - - VERSION_MAJOR = 1000000; - VERSION_MINOR = 1000; - VERSION_RELEASE = 1; - - (* - * Current version of UltraStar Deluxe - *) - USDX_VERSION_MAJOR = 1; - USDX_VERSION_MINOR = 1; - USDX_VERSION_RELEASE = 0; - USDX_VERSION_STATE = 'Alpha'; - USDX_STRING = 'UltraStar Deluxe'; - - (* - * FPC version numbers are already defined as built-in macros: - * FPC_VERSION (MAJOR) - * FPC_RELEASE (MINOR) - * FPC_PATCH (RELEASE) - * Since FPC_VERSION is already defined, we will use FPC_VERSION_INT as - * composed version number. - *) - {$IFNDEF FPC} - // Delphi 7 evaluates every $IF-directive even if it is disabled by a surrounding - // $IF or $IFDEF so the follwing will give you an error in delphi: - // {$IFDEF FPC}{$IF (FPC_VERSION > 2)}...{$IFEND}{$ENDIF} - // The reason for this error is that FPC_VERSION is not a valid constant. - // To avoid this error, we define dummys here. - FPC_VERSION = 0; - FPC_RELEASE = 0; - FPC_PATCH = 0; - {$ENDIF} - - FPC_VERSION_INT = (FPC_VERSION * VERSION_MAJOR) + - (FPC_RELEASE * VERSION_MINOR) + - (FPC_PATCH * VERSION_RELEASE); - - // 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} - - LIBAVCODEC_VERSION = (LIBAVCODEC_VERSION_MAJOR * VERSION_MAJOR) + - (LIBAVCODEC_VERSION_MINOR * VERSION_MINOR) + - (LIBAVCODEC_VERSION_RELEASE * VERSION_RELEASE); - - LIBAVFORMAT_VERSION = (LIBAVFORMAT_VERSION_MAJOR * VERSION_MAJOR) + - (LIBAVFORMAT_VERSION_MINOR * VERSION_MINOR) + - (LIBAVFORMAT_VERSION_RELEASE * VERSION_RELEASE); - - LIBAVUTIL_VERSION = (LIBAVUTIL_VERSION_MAJOR * VERSION_MAJOR) + - (LIBAVUTIL_VERSION_MINOR * VERSION_MINOR) + - (LIBAVUTIL_VERSION_RELEASE * VERSION_RELEASE); - - {$IFDEF HaveSWScale} - LIBSWSCALE_VERSION = (LIBSWSCALE_VERSION_MAJOR * VERSION_MAJOR) + - (LIBSWSCALE_VERSION_MINOR * VERSION_MINOR) + - (LIBSWSCALE_VERSION_RELEASE * VERSION_RELEASE); - {$ENDIF} - - {$ENDIF} - - {$IFDEF HaveProjectM} - PROJECTM_VERSION = (PROJECTM_VERSION_MAJOR * VERSION_MAJOR) + - (PROJECTM_VERSION_MINOR * VERSION_MINOR) + - (PROJECTM_VERSION_RELEASE * VERSION_RELEASE); - {$ENDIF} - - {$IFDEF HavePortaudio} - PORTAUDIO_VERSION = (PORTAUDIO_VERSION_MAJOR * VERSION_MAJOR) + - (PORTAUDIO_VERSION_MINOR * VERSION_MINOR) + - (PORTAUDIO_VERSION_RELEASE * VERSION_RELEASE); - {$ENDIF} - - {$IFDEF HaveLibsamplerate} - LIBSAMPLERATE_VERSION = (LIBSAMPLERATE_VERSION_MAJOR * VERSION_MAJOR) + - (LIBSAMPLERATE_VERSION_MINOR * VERSION_MINOR) + - (LIBSAMPLERATE_VERSION_RELEASE * VERSION_RELEASE); - {$ENDIF} - -function USDXVersionStr(): string; -function USDXShortVersionStr(): string; - -implementation - -uses - StrUtils, Math; - -function USDXShortVersionStr(): string; -begin - Result := - USDX_STRING + - IfThen(USDX_VERSION_STATE <> '', ' '+USDX_VERSION_STATE); -end; - -function USDXVersionStr(): string; -begin - Result := - USDX_STRING + ' V ' + - IntToStr(USDX_VERSION_MAJOR) + '.' + - IntToStr(USDX_VERSION_MINOR) + '.' + - IntToStr(USDX_VERSION_RELEASE) + - IfThen(USDX_VERSION_STATE <> '', ' '+USDX_VERSION_STATE) + - ' Build'; -end; - -end. diff --git a/src/base/UCovers.pas b/src/base/UCovers.pas deleted file mode 100644 index 6c7c9e48..00000000 --- a/src/base/UCovers.pas +++ /dev/null @@ -1,459 +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 UCovers; - -{ - TODO: - - adjust database to new song-loading (e.g. use SongIDs) - - support for deletion of outdated covers - - support for update of changed covers - - use paths relative to the song for removable disks support - (a drive might have a different drive-name the next time it is connected, - so "H:/songs/..." will not match "I:/songs/...") -} - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses - SDL, - SQLite3, - SQLiteTable3, - SysUtils, - Classes, - UImage, - UTexture, - UPath; - -type - ECoverDBException = class(Exception) - end; - - TCover = class - private - ID: int64; - Filename: IPath; - public - constructor Create(ID: int64; Filename: IPath); - function GetPreviewTexture(): TTexture; - function GetTexture(): TTexture; - end; - - TThumbnailInfo = record - CoverWidth: integer; // Original width of cover - CoverHeight: integer; // Original height of cover - PixelFormat: TImagePixelFmt; // Pixel-format of thumbnail - end; - - TCoverDatabase = class - private - DB: TSQLiteDatabase; - procedure InitCoverDatabase(); - function CreateThumbnail(const Filename: IPath; var Info: TThumbnailInfo): PSDL_Surface; - function LoadCover(CoverID: int64): TTexture; - procedure DeleteCover(CoverID: 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: IPath): TCover; - function FindCover(const Filename: IPath): TCover; - function CoverExists(const Filename: IPath): boolean; - function GetMaxCoverSize(): integer; - procedure SetMaxCoverSize(Size: integer); - end; - - TBlobWrapper = class(TCustomMemoryStream) - function Write(const Buffer; Count: Integer): Integer; override; - end; - -var - Covers: TCoverDatabase; - -implementation - -uses - UMain, - ULog, - UPlatform, - UIni, - Math, - DateUtils; - -const - COVERDB_FILENAME: UTF8String = 'cover.db'; - COVERDB_VERSION = 01; // 0.1 - COVER_TBL = 'Cover'; - COVER_THUMBNAIL_TBL = 'CoverThumbnail'; - COVER_IDX = 'Cover_Filename_IDX'; - -// Note: DateUtils.DateTimeToUnix() will throw an exception in FPC -function DateTimeToUnixTime(time: TDateTime): int64; -begin - Result := Round((time - UnixDateDelta) * SecsPerDay); -end; - -// Note: DateUtils.UnixToDateTime() will throw an exception in FPC -function UnixTimeToDateTime(timestamp: int64): TDateTime; -begin - Result := timestamp / SecsPerDay + UnixDateDelta; -end; - - -{ TBlobWrapper } - -function TBlobWrapper.Write(const Buffer; Count: Integer): Integer; -begin - SetPointer(Pointer(Buffer), Count); - Result := Count; -end; - - -{ TCover } - -constructor TCover.Create(ID: int64; Filename: IPath); -begin - Self.ID := ID; - Self.Filename := Filename; -end; - -function TCover.GetPreviewTexture(): TTexture; -begin - Result := Covers.LoadCover(ID); -end; - -function TCover.GetTexture(): TTexture; -begin - Result := Texture.LoadTexture(Filename); -end; - - -{ TCoverDatabase } - -constructor TCoverDatabase.Create(); -begin - inherited; - - Open(); - InitCoverDatabase(); -end; - -destructor TCoverDatabase.Destroy; -begin - DB.Free; - inherited; -end; - -function TCoverDatabase.GetVersion(): integer; -begin - Result := DB.GetTableValue('PRAGMA user_version'); -end; - -procedure TCoverDatabase.SetVersion(Version: integer); -begin - DB.ExecSQL(Format('PRAGMA user_version = %d', [Version])); -end; - -function TCoverDatabase.GetMaxCoverSize(): integer; -begin - Result := ITextureSizeVals[Ini.TextureSize]; -end; - -procedure TCoverDatabase.SetMaxCoverSize(Size: integer); -var - I: integer; -begin - // search for first valid cover-size > Size - for I := 0 to Length(ITextureSizeVals)-1 do - begin - if (Size <= ITextureSizeVals[I]) then - begin - Ini.TextureSize := I; - Exit; - end; - end; - - // fall-back to highest size - Ini.TextureSize := High(ITextureSizeVals); -end; - -procedure TCoverDatabase.Open(); -var - Version: integer; - Filename: IPath; -begin - Filename := Platform.GetGameUserPath().Append(COVERDB_FILENAME); - - DB := TSQLiteDatabase.Create(Filename.ToUTF8()); - Version := GetVersion(); - - // check version, if version is too old/new, delete database file - if ((Version <> 0) and (Version <> COVERDB_VERSION)) then - begin - Log.LogInfo('Outdated cover-database file found', 'TCoverDatabase.Open'); - // close and delete outdated file - DB.Free; - if (not Filename.DeleteFile()) then - raise ECoverDBException.Create('Could not delete ' + Filename.ToNative); - // reopen - DB := TSQLiteDatabase.Create(Filename.ToUTF8()); - Version := 0; - end; - - // set version number after creation - if (Version = 0) then - SetVersion(COVERDB_VERSION); - - // speed-up disk-writing. The default FULL-synchronous mode is too slow. - // With this option disk-writing is approx. 4 times faster but the database - // might be corrupted if the OS crashes, although this is very unlikely. - DB.ExecSQL('PRAGMA synchronous = OFF;'); - - // the next line rather gives a slow-down instead of a speed-up, so we do not use it - //DB.ExecSQL('PRAGMA temp_store = MEMORY;'); -end; - -procedure TCoverDatabase.InitCoverDatabase(); -begin - DB.ExecSQL('CREATE TABLE IF NOT EXISTS ['+COVER_TBL+'] (' + - '[ID] INTEGER NOT NULL PRIMARY KEY AUTOINCREMENT, ' + - '[Filename] TEXT UNIQUE NOT NULL, ' + - '[Date] INTEGER NOT NULL, ' + - '[Width] INTEGER NOT NULL, ' + - '[Height] INTEGER NOT NULL ' + - ')'); - - DB.ExecSQL('CREATE INDEX IF NOT EXISTS ['+COVER_IDX+'] ON ['+COVER_TBL+'](' + - '[Filename] ASC' + - ')'); - - DB.ExecSQL('CREATE TABLE IF NOT EXISTS ['+COVER_THUMBNAIL_TBL+'] (' + - '[ID] INTEGER NOT NULL PRIMARY KEY, ' + - '[Format] INTEGER NOT NULL, ' + - '[Width] INTEGER NOT NULL, ' + - '[Height] INTEGER NOT NULL, ' + - '[Data] BLOB NULL' + - ')'); -end; - -function TCoverDatabase.FindCoverIntern(const Filename: IPath): int64; -begin - Result := DB.GetTableValue('SELECT [ID] FROM ['+COVER_TBL+'] ' + - 'WHERE [Filename] = ?', - [Filename.ToUTF8]); -end; - -function TCoverDatabase.FindCover(const Filename: IPath): TCover; -var - CoverID: int64; -begin - Result := nil; - try - CoverID := FindCoverIntern(Filename); - if (CoverID > 0) then - Result := TCover.Create(CoverID, Filename); - except on E: Exception do - Log.LogError(E.Message, 'TCoverDatabase.FindCover'); - end; -end; - -function TCoverDatabase.CoverExists(const Filename: IPath): boolean; -begin - Result := false; - try - Result := (FindCoverIntern(Filename) > 0); - except on E: Exception do - Log.LogError(E.Message, 'TCoverDatabase.CoverExists'); - end; -end; - -function TCoverDatabase.AddCover(const Filename: IPath): TCover; -var - CoverID: int64; - Thumbnail: PSDL_Surface; - CoverData: TBlobWrapper; - FileDate: TDateTime; - Info: TThumbnailInfo; -begin - Result := nil; - - //if (not FileExists(Filename)) then - // Exit; - - // TODO: replace '\' with '/' in filename - FileDate := Now(); //FileDateToDateTime(FileAge(Filename)); - - Thumbnail := CreateThumbnail(Filename, Info); - if (Thumbnail = nil) then - Exit; - - CoverData := TBlobWrapper.Create; - CoverData.Write(Thumbnail^.pixels, Thumbnail^.h * Thumbnail^.pitch); - - try - // Note: use a transaction to speed-up file-writing. - // Without data written by the first INSERT might be moved at the second INSERT. - DB.BeginTransaction(); - - // add general cover info - DB.ExecSQL('INSERT INTO ['+COVER_TBL+'] ' + - '([Filename], [Date], [Width], [Height]) VALUES' + - '(?, ?, ?, ?)', - [Filename.ToUTF8, DateTimeToUnixTime(FileDate), - Info.CoverWidth, Info.CoverHeight]); - - // get auto-generated cover ID - CoverID := DB.GetLastInsertRowID(); - - // add thumbnail info - DB.ExecSQL('INSERT INTO ['+COVER_THUMBNAIL_TBL+'] ' + - '([ID], [Format], [Width], [Height], [Data]) VALUES' + - '(?, ?, ?, ?, ?)', - [CoverID, Ord(Info.PixelFormat), - Thumbnail^.w, Thumbnail^.h, CoverData]); - - Result := TCover.Create(CoverID, Filename); - except on E: Exception do - Log.LogError(E.Message, 'TCoverDatabase.AddCover'); - end; - - DB.Commit(); - CoverData.Free; - SDL_FreeSurface(Thumbnail); -end; - -function TCoverDatabase.LoadCover(CoverID: int64): TTexture; -var - Width, Height: integer; - PixelFmt: TImagePixelFmt; - Data: PChar; - DataSize: integer; - Filename: IPath; - Table: TSQLiteUniTable; -begin - Table := nil; - - try - Table := DB.GetUniTable(Format( - 'SELECT C.[Filename], T.[Format], T.[Width], T.[Height], T.[Data] ' + - 'FROM ['+COVER_TBL+'] C ' + - 'INNER JOIN ['+COVER_THUMBNAIL_TBL+'] T ' + - 'USING(ID) ' + - 'WHERE [ID] = %d', [CoverID])); - - Filename := Path(Table.FieldAsString(0)); - PixelFmt := TImagePixelFmt(Table.FieldAsInteger(1)); - Width := Table.FieldAsInteger(2); - Height := Table.FieldAsInteger(3); - - Data := Table.FieldAsBlobPtr(4, DataSize); - if (Data <> nil) and - (PixelFmt = ipfRGB) then - begin - Result := Texture.CreateTexture(Data, Filename, Width, Height, 24) - end - else - begin - // FillChar() 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 - Log.LogError(E.Message, 'TCoverDatabase.LoadCover'); - end; - - Table.Free; -end; - -procedure TCoverDatabase.DeleteCover(CoverID: int64); -begin - DB.ExecSQL(Format('DELETE FROM ['+COVER_TBL+'] WHERE [ID] = %d', [CoverID])); - DB.ExecSQL(Format('DELETE FROM ['+COVER_THUMBNAIL_TBL+'] WHERE [ID] = %d', [CoverID])); -end; - -(** - * Returns a pointer to an array of bytes containing the texture data in the - * requested size - *) -function TCoverDatabase.CreateThumbnail(const Filename: IPath; var Info: TThumbnailInfo): PSDL_Surface; -var - //TargetAspect, SourceAspect: double; - //TargetWidth, TargetHeight: integer; - Thumbnail: PSDL_Surface; - MaxSize: integer; -begin - Result := nil; - - MaxSize := GetMaxCoverSize(); - - Thumbnail := LoadImage(Filename); - if (not assigned(Thumbnail)) then - begin - Log.LogError('Could not load cover: "'+ Filename.ToNative +'"', 'TCoverDatabase.AddCover'); - Exit; - end; - - // Convert pixel format as needed - AdjustPixelFormat(Thumbnail, TEXTURE_TYPE_PLAIN); - - Info.CoverWidth := Thumbnail^.w; - Info.CoverHeight := Thumbnail^.h; - Info.PixelFormat := ipfRGB; - - (* TODO: keep aspect ratio - TargetAspect := Width / Height; - SourceAspect := TexSurface.w / TexSurface.h; - - // Scale texture to covers dimensions (keep aspect) - if (SourceAspect >= TargetAspect) then - begin - TargetWidth := Width; - TargetHeight := Trunc(Width / SourceAspect); - end - else - begin - TargetHeight := Height; - TargetWidth := Trunc(Height * SourceAspect); - end; - *) - - // TODO: do not scale if image is smaller - ScaleImage(Thumbnail, MaxSize, MaxSize); - - Result := Thumbnail; -end; - -end. - diff --git a/src/base/UDLLManager.pas b/src/base/UDLLManager.pas deleted file mode 100644 index d5bb1480..00000000 --- a/src/base/UDLLManager.pas +++ /dev/null @@ -1,293 +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, - UPath, - UFilesystem; - -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 IPath; - Selected: ^TPluginInfo; - - constructor Create; - - procedure GetPluginList; - procedure ClearPluginInfo(No: cardinal); - function LoadPluginInfo(const Filename: IPath; 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} - UPathUtils, - ULog, - SysUtils; - - -constructor TDLLMan.Create; -begin - inherited; - SetLength(Plugins, 0); - SetLength(PluginPaths, Length(Plugins)); - GetPluginList; -end; - -procedure TDLLMan.GetPluginList; -var - Iter: IFileIterator; - FileInfo: TFileInfo; -begin - Iter := FileSystem.FileFind(PluginPath.Append('*' + DLLExt), 0); - while (Iter.HasNext) do - begin - SetLength(Plugins, Length(Plugins)+1); - SetLength(PluginPaths, Length(Plugins)); - - FileInfo := Iter.Next; - - if LoadPluginInfo(FileInfo.Name, High(Plugins)) then // loaded succesful - begin - PluginPaths[High(PluginPaths)] := FileInfo.Name; - end - else // error loading - begin - SetLength(Plugins, Length(Plugins)-1); - SetLength(PluginPaths, Length(Plugins)); - end; - 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(const Filename: IPath; 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.Append(Filename).ToNative)); -// 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.ToNative + '": Info procedure not found'); - - FreeLibrary (hLibg); - end - else - Log.LogError('Could not load plugin "' + Filename.ToNative + '": Libary not loaded'); -end; - -function TDLLMan.LoadPlugin(No: cardinal): boolean; -begin - Result := true; -// load libary - hLib := LoadLibrary(PChar(PluginPath.Append(PluginPaths[No]).ToNative)); -// 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].ToNative + '": Procedures not found'); - end; - end - else - Log.LogError('Could not load plugin "' + PluginPaths[No].ToNative + '": 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/src/base/UDataBase.pas b/src/base/UDataBase.pas deleted file mode 100644 index 85b4b8e8..00000000 --- a/src/base/UDataBase.pas +++ /dev/null @@ -1,614 +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 UDataBase; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses - Classes, - SQLiteTable3, - UPath, - USong, - USongs; - -//-------------------- -//DataBaseSystem - Class including all DB methods -//-------------------- -type - TStatType = ( - stBestScores, // Best scores - stBestSingers, // Best singers - stMostSungSong, // Most sung songs - stMostPopBand // Most popular band - ); - - // abstract super-class for statistic results - TStatResult = class - public - Typ: TStatType; - end; - - TStatResultBestScores = class(TStatResult) - public - Singer: UTF8String; - Score: word; - Difficulty: byte; - SongArtist: UTF8String; - SongTitle: UTF8String; - Date: UTF8String; - end; - - TStatResultBestSingers = class(TStatResult) - public - Player: UTF8String; - AverageScore: word; - end; - - TStatResultMostSungSong = class(TStatResult) - public - Artist: UTF8String; - Title: UTF8String; - TimesSung: word; - end; - - TStatResultMostPopBand = class(TStatResult) - public - ArtistName: UTF8String; - TimesSungTot: word; - end; - - - TDataBaseSystem = class - private - ScoreDB: TSQLiteDatabase; - fFilename: IPath; - - function GetVersion(): integer; - procedure SetVersion(Version: integer); - public - property Filename: IPath read fFilename; - - destructor Destroy; override; - - procedure Init(const Filename: IPath); - procedure ReadScore(Song: TSong); - 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; - procedure FreeStats(StatList: TList); - function GetTotalEntrys(Typ: TStatType): cardinal; - function GetStatReset: TDateTime; - function FormatDate(time_stamp: integer): UTF8String; - end; - -var - DataBase: TDataBaseSystem; - -implementation - -uses - DateUtils, - ULanguage, - StrUtils, - 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'; - -(** - * Open database and create tables if they do not exist - *) -procedure TDataBaseSystem.Init(const Filename: IPath); -var - Version: integer; - finalizeConversion: boolean; -begin - if Assigned(ScoreDB) then - Exit; - - Log.LogStatus('Initializing database: "' + Filename.ToNative + '"', 'TDataBaseSystem.Init'); - - try - - // open database - ScoreDB := TSQLiteDatabase.Create(Filename.ToUTF8); - fFilename := Filename; - - Version := GetVersion(); - - // 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 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, - // so use the native TEXT type. INT(n) is always INTEGER. - // In addition, SQLiteTable3 will fail if other types than the native SQLite - // types are used (especially FieldAsInteger). Also take care to write the - // types in upper-case letters although SQLite does not care about this - - // SQLiteTable3 is very sensitive in this regard. - ScoreDB.ExecSQL('CREATE TABLE IF NOT EXISTS [' + cUS_Scores + '] (' + - '[SongID] INTEGER NOT NULL, ' + - '[Difficulty] INTEGER NOT NULL, ' + - '[Player] TEXT NOT NULL, ' + - '[Score] INTEGER NOT NULL, ' + - '[Date] INTEGER NULL' + - ');'); - - ScoreDB.ExecSQL('CREATE TABLE IF NOT EXISTS [' + cUS_Songs + '] (' + - '[ID] INTEGER PRIMARY KEY, ' + - '[Artist] TEXT NOT NULL, ' + - '[Title] TEXT NOT NULL, ' + - '[TimesPlayed] INTEGER NOT NULL, ' + - '[Rating] INTEGER NULL' + - ');'); - - // convert data from 1.01 to 1.1 - // part #2 - accomplishment - if finalizeConversion then - begin - Log.LogInfo('Outdated song database found - begin conversion from V1.01 to V1.1', 'TDataBaseSystem.Init'); - // insert old values into new db-schemes (/tables) - ScoreDB.ExecSQL('INSERT INTO ' + cUS_Scores + ' SELECT SongID, Difficulty, Player, Score FROM us_scores_101;'); - ScoreDB.ExecSQL('INSERT INTO ' + cUS_Songs + ' SELECT ID, Artist, Title, TimesPlayed, ''NULL'' FROM us_songs_101;'); - //now drop old tables - ScoreDB.ExecSQL('DROP TABLE us_scores_101;'); - ScoreDB.ExecSQL('DROP TABLE us_songs_101;'); - 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; - - - //add column date to cUS-Scores - if not ScoreDB.ContainsColumn(cUS_Scores, 'Date') then - begin - Log.LogInfo('adding column date to "' + cUS_Scores + '"', 'TDataBaseSystem.Init'); - ScoreDB.ExecSQL('ALTER TABLE ' + cUS_Scores + ' ADD COLUMN [Date] INTEGER NULL'); - end; - - except - on E: Exception do - begin - Log.LogError(E.Message, 'TDataBaseSystem.Init'); - FreeAndNil(ScoreDB); - end; - end; - -end; - -(** - * Frees Database - *) -destructor TDataBaseSystem.Destroy; -begin - Log.LogInfo('TDataBaseSystem.Free', 'TDataBaseSystem.Destroy'); - ScoreDB.Free; - inherited; -end; - -(** - * 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; - 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], [Date] FROM [' + cUS_Scores + '] ' + - 'WHERE [SongID] = (' + - 'SELECT [ID] FROM [' + cUS_Songs + '] ' + - 'WHERE [Artist] = ? AND [Title] = ? ' + - 'LIMIT 1) ' + - 'ORDER BY [Score] DESC;', //no LIMIT! see filter below! - [Song.Artist, Song.Title]); - - // Empty Old Scores - 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 - begin - // Add one Entry to Array - Difficulty := TableData.FieldAsInteger(TableData.FieldIndex['Difficulty']); - if ((Difficulty >= 0) and (Difficulty <= 2)) and - (Length(Song.Score[Difficulty]) < 5) then - begin - //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 := - 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; - end; // while - - except - for Difficulty := 0 to 2 do - begin - SetLength(Song.Score[Difficulty], 1); - Song.Score[Difficulty, 1].Name := 'Error Reading ScoreDB'; - end; - end; - - TableData.Free; -end; - -(** - * Adds one new score to DB - *) -procedure TDataBaseSystem.AddScore(Song: TSong; Level: integer; const Name: UTF8String; Score: integer); -var - ID: integer; - TableData: TSQLiteTable; -begin - if not Assigned(ScoreDB) 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 + '] ' + - 'WHERE [Artist] = ? AND [Title] = ?', - [Song.Artist, Song.Title]); - if (ID = 0) then - begin - // Create song if it does not exist - ScoreDB.ExecSQL( - 'INSERT INTO [' + cUS_Songs + '] ' + - '([ID], [Artist], [Title], [TimesPlayed]) VALUES ' + - '(NULL, ?, ?, 0);', - [Song.Artist, Song.Title]); - // Get song-ID - ID := ScoreDB.GetLastInsertRowID(); - end; - // Create new entry - ScoreDB.ExecSQL( - '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'); - end; - - TableData.Free; -end; - -(** - * 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 + '] ' + - 'SET [TimesPlayed] = [TimesPlayed] + 1 ' + - 'WHERE [Title] = ? AND [Artist] = ?;', - [Song.Title, Song.Artist]); - except on E: Exception do - Log.LogError(E.Message, 'TDataBaseSystem.WriteScore'); - end; -end; - -(** - * Writes some stats to array. - * Returns nil if the database is not ready or a list with zero or more statistic - * entries. - * Free the result-list with FreeStats() after usage to avoid memory leaks. - *) -function TDataBaseSystem.GetStats(Typ: TStatType; Count: byte; Page: cardinal; Reversed: boolean): TList; -var - Query: string; - TableData: TSQLiteUniTable; - Stat: TStatResult; -begin - Result := nil; - - if not Assigned(ScoreDB) then - Exit; - - {Todo: Add Prevention that only players with more than 5 scores are selected at type 2} - - // Create query - case Typ of - stBestScores: begin - Query := 'SELECT [Player], [Difficulty], [Score], [Artist], [Title], [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 + '] ' + - 'GROUP BY [Player] ORDER BY AVG([Score])'; - end; - stMostSungSong: begin - Query := 'SELECT [Artist], [Title], [TimesPlayed] FROM [' + cUS_Songs + '] ' + - 'ORDER BY [TimesPlayed]'; - end; - stMostPopBand: begin - Query := 'SELECT [Artist], SUM([TimesPlayed]) FROM [' + cUS_Songs + '] ' + - 'GROUP BY [Artist] ORDER BY SUM([TimesPlayed])'; - end; - end; - - // Add order direction - Query := Query + IfThen(Reversed, ' ASC', ' DESC'); - - // Add limit - Query := Query + ' LIMIT ' + InttoStr(Count * Page) + ', ' + InttoStr(Count) + ';'; - - // Execute query - try - TableData := ScoreDB.GetUniTable(Query); - except - on E: Exception do - begin - Log.LogError(E.Message, 'TDataBaseSystem.GetStats'); - Exit; - end; - end; - - Result := TList.Create; - Stat := nil; - - // Copy result to stats array - while not TableData.EOF do - begin - case Typ of - stBestScores: begin - Stat := TStatResultBestScores.Create; - with TStatResultBestScores(Stat) do - begin - Singer := TableData.Fields[0]; - Difficulty := TableData.FieldAsInteger(1); - Score := TableData.FieldAsInteger(2); - 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 := TableData.Fields[0]; - AverageScore := TableData.FieldAsInteger(1); - end; - end; - stMostSungSong: begin - Stat := TStatResultMostSungSong.Create; - with TStatResultMostSungSong(Stat) do - begin - Artist := TableData.Fields[0]; - Title := TableData.Fields[1]; - TimesSung := TableData.FieldAsInteger(2); - end; - end; - stMostPopBand: begin - Stat := TStatResultMostPopBand.Create; - with TStatResultMostPopBand(Stat) do - begin - ArtistName := TableData.Fields[0]; - TimesSungTot := TableData.FieldAsInteger(1); - end; - end - else - Log.LogCritical('Unknown stat-type', 'TDataBaseSystem.GetStats'); - end; - - Stat.Typ := Typ; - Result.Add(Stat); - - TableData.Next; - end; - - TableData.Free; -end; - -procedure TDataBaseSystem.FreeStats(StatList: TList); -var - Index: integer; -begin - if (StatList = nil) then - Exit; - 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; -var - Query: string; -begin - Result := 0; - - if not Assigned(ScoreDB) then - Exit; - - try - // Create query - case Typ of - stBestScores: - Query := 'SELECT COUNT([SongID]) FROM [' + cUS_Scores + '];'; - stBestSingers: - Query := 'SELECT COUNT(DISTINCT [Player]) FROM [' + cUS_Scores + '];'; - stMostSungSong: - Query := 'SELECT COUNT([ID]) FROM [' + cUS_Songs + '];'; - stMostPopBand: - Query := 'SELECT COUNT(DISTINCT [Artist]) FROM [' + cUS_Songs + '];'; - end; - - Result := ScoreDB.GetTableValue(Query); - except on E: Exception do - Log.LogError(E.Message, 'TDataBaseSystem.GetTotalEntrys'); - end; - -end; - -(** - * Gets reset date of statistic data - *) -function TDataBaseSystem.GetStatReset: TDateTime; -var - Query: string; -begin - Result := 0; - - if not Assigned(ScoreDB) then - Exit; - - try - Query := 'SELECT [ResetTime] FROM [' + cUS_Statistics_Info + '];'; - Result := UnixToDateTime(ScoreDB.GetTableValue(Query)); - except on E: Exception do - Log.LogError(E.Message, 'TDataBaseSystem.GetStatReset'); - end; -end; - -function TDataBaseSystem.GetVersion(): integer; -begin - Result := ScoreDB.GetTableValue('PRAGMA user_version'); -end; - -procedure TDataBaseSystem.SetVersion(Version: integer); -begin - ScoreDB.ExecSQL(Format('PRAGMA user_version = %d', [Version])); -end; - -end. diff --git a/src/base/UDraw.pas b/src/base/UDraw.pas deleted file mode 100644 index 1783986f..00000000 --- a/src/base/UDraw.pas +++ /dev/null @@ -1,1408 +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 UDraw; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses - UThemes, - ModiSDK, - UGraphicClasses; - -procedure SingDraw; -procedure SingModiDraw (PlayerInfo: TPlayerInfo); -procedure SingDrawBackground; -procedure SingDrawOscilloscope(X, Y, W, H: real; NrSound: integer); -procedure SingDrawNoteLines(Left, Top, Right: real; Space: integer); -procedure SingDrawLyricHelper(Left, LyricsMid: real); -procedure SingDrawBeatDelimeters(Left, Top, Right: real; NrLines: integer); -procedure SingDrawLine(Left, Top, Right: real; NrLines: integer; Space: integer); -procedure SingDrawPlayerLine(X, Y, W: real; PlayerIndex: integer; Space: integer); -procedure SingDrawPlayerBGLine(Left, Top, Right: real; NrLines, PlayerIndex: integer; Space: integer); - -// TimeBar -procedure SingDrawTimeBar(); - -//Draw Editor NoteLines -procedure EditDrawLine(Left, Top, Right: real; NrLines: integer; Space: integer); - -type - TRecR = record - Top: real; - Left: real; - Right: real; - Bottom: real; - - Width: real; - WMid: real; - Height: real; - HMid: real; - Mid: real; - end; - -var - NotesW: real; - NotesH: real; - Starfr: integer; - StarfrG: integer; - - //SingBar - TickOld: cardinal; - TickOld2: cardinal; - -implementation - -uses - SysUtils, - Math, - gl, - TextGL, - UDLLManager, - UDrawTexture, - UGraphic, - UIni, - ULog, - ULyrics, - UNote, - UMusic, - URecord, - UScreenSing, - UScreenSingModi, - UTexture; - -procedure SingDrawBackground; -var - Rec: TRecR; - TexRec: TRecR; -begin - if (ScreenSing.Tex_Background.TexNum > 0) then - begin - if (Ini.MovieSize <= 1) then //HalfSize BG - begin - (* half screen + gradient *) - Rec.Top := 110; // 80 - Rec.Bottom := Rec.Top + 20; - Rec.Left := 0; - Rec.Right := 800; - - TexRec.Top := (Rec.Top / 600) * ScreenSing.Tex_Background.TexH; - TexRec.Bottom := (Rec.Bottom / 600) * ScreenSing.Tex_Background.TexH; - TexRec.Left := 0; - TexRec.Right := ScreenSing.Tex_Background.TexW; - - glEnable(GL_TEXTURE_2D); - glBindTexture(GL_TEXTURE_2D, ScreenSing.Tex_Background.TexNum); - glEnable(GL_BLEND); - glBegin(GL_QUADS); - (* gradient draw *) - (* top *) - glColor4f(1, 1, 1, 0); - glTexCoord2f(TexRec.Right, TexRec.Top); glVertex2f(Rec.Right, Rec.Top); - glTexCoord2f(TexRec.Left, TexRec.Top); glVertex2f(Rec.Left, Rec.Top); - glColor4f(1, 1, 1, 1); - glTexCoord2f(TexRec.Left, TexRec.Bottom); glVertex2f(Rec.Left, Rec.Bottom); - glTexCoord2f(TexRec.Right, TexRec.Bottom); glVertex2f(Rec.Right, Rec.Bottom); - (* mid *) - Rec.Top := Rec.Bottom; - Rec.Bottom := 490 - 20; // 490 - 20 - TexRec.Top := TexRec.Bottom; - TexRec.Bottom := (Rec.Bottom / 600) * ScreenSing.Tex_Background.TexH; - glTexCoord2f(TexRec.Left, TexRec.Top); glVertex2f(Rec.Left, Rec.Top); - glTexCoord2f(TexRec.Left, TexRec.Bottom); glVertex2f(Rec.Left, Rec.Bottom); - glTexCoord2f(TexRec.Right, TexRec.Bottom); glVertex2f(Rec.Right, Rec.Bottom); - glTexCoord2f(TexRec.Right, TexRec.Top); glVertex2f(Rec.Right, Rec.Top); - (* bottom *) - Rec.Top := Rec.Bottom; - Rec.Bottom := 490; // 490 - TexRec.Top := TexRec.Bottom; - TexRec.Bottom := (Rec.Bottom / 600) * ScreenSing.Tex_Background.TexH; - glTexCoord2f(TexRec.Right, TexRec.Top); glVertex2f(Rec.Right, Rec.Top); - glTexCoord2f(TexRec.Left, TexRec.Top); glVertex2f(Rec.Left, Rec.Top); - glColor4f(1, 1, 1, 0); - glTexCoord2f(TexRec.Left, TexRec.Bottom); glVertex2f(Rec.Left, Rec.Bottom); - glTexCoord2f(TexRec.Right, TexRec.Bottom); glVertex2f(Rec.Right, Rec.Bottom); - - glEnd; - glDisable(GL_TEXTURE_2D); - glDisable(GL_BLEND); - end - else //Full Size BG - begin - glEnable(GL_TEXTURE_2D); - glBindTexture(GL_TEXTURE_2D, ScreenSing.Tex_Background.TexNum); - //glEnable(GL_BLEND); - glBegin(GL_QUADS); - - glTexCoord2f(0, 0); glVertex2f(0, 0); - glTexCoord2f(0, ScreenSing.Tex_Background.TexH); glVertex2f(0, 600); - glTexCoord2f( ScreenSing.Tex_Background.TexW, ScreenSing.Tex_Background.TexH); glVertex2f(800, 600); - glTexCoord2f( ScreenSing.Tex_Background.TexW, 0); glVertex2f(800, 0); - - glEnd; - glDisable(GL_TEXTURE_2D); - //glDisable(GL_BLEND); - end; - end; -end; - -procedure SingDrawOscilloscope(X, Y, W, H: real; NrSound: integer); -var - SampleIndex: integer; - Sound: TCaptureBuffer; - MaxX, MaxY: real; -begin; - Sound := AudioInputProcessor.Sound[NrSound]; - - // Log.LogStatus('Oscilloscope', 'SingDraw'); - glColor3f(Skin_OscR, Skin_OscG, Skin_OscB); -{ - if (ParamStr(1) = '-black') or (ParamStr(1) = '-fsblack') then - glColor3f(1, 1, 1); -} - MaxX := W-1; - MaxY := (H-1) / 2; - - Sound.LockAnalysisBuffer(); - - glBegin(GL_LINE_STRIP); - for SampleIndex := 0 to High(Sound.AnalysisBuffer) do - begin - glVertex2f(X + MaxX * SampleIndex/High(Sound.AnalysisBuffer), - Y + MaxY * (1 - Sound.AnalysisBuffer[SampleIndex]/-Low(Smallint))); - end; - glEnd; - - Sound.UnlockAnalysisBuffer(); -end; - -procedure SingDrawNoteLines(Left, Top, Right: real; Space: integer); -var - Count: integer; -begin - glEnable(GL_BLEND); - glColor4f(Skin_P1_LinesR, Skin_P1_LinesG, Skin_P1_LinesB, 0.4); - glBegin(GL_LINES); - for Count := 0 to 9 do - begin - glVertex2f(Left, Top + Count * Space); - glVertex2f(Right, Top + Count * Space); - end; - glEnd; - glDisable(GL_BLEND); -end; - -procedure SingDrawBeatDelimeters(Left, Top, Right: real; NrLines: integer); -var - Count: integer; - TempR: real; -begin - TempR := (Right-Left) / (Lines[NrLines].Line[Lines[NrLines].Current].End_ - Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start); - glEnable(GL_BLEND); - glBegin(GL_LINES); - for Count := Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start to Lines[NrLines].Line[Lines[NrLines].Current].End_ do - begin - if (Count mod Lines[NrLines].Resolution) = Lines[NrLines].NotesGAP then - glColor4f(0, 0, 0, 1) - else - glColor4f(0, 0, 0, 0.3); - glVertex2f(Left + TempR * (Count - Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start), Top); - glVertex2f(Left + TempR * (Count - Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start), Top + 135); - end; - glEnd; - glDisable(GL_BLEND); -end; - -// draw blank Notebars -procedure SingDrawLine(Left, Top, Right: real; NrLines: integer; Space: integer); -var - Rec: TRecR; - Count: integer; - TempR: real; - - PlayerNumber: integer; - - GoldenStarPos: real; - - lTmpA, lTmpB : real; -begin -// We actually don't have a playernumber in this procedure, it should reside in NrLines - but it is always set to zero -// So we exploit this behavior a bit - we give NrLines the playernumber, keep it in playernumber - and then we set NrLines to zero -// This could also come quite in handy when we do the duet mode, cause just the notes for the player that has to sing should be drawn then -// BUT this is not implemented yet, all notes are drawn! :D - - PlayerNumber := NrLines + 1; // Player 1 is 0 - NrLines := 0; - -// exploit done - - glColor3f(1, 1, 1); - glEnable(GL_TEXTURE_2D); - glEnable(GL_BLEND); - glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); - - lTmpA := (Right-Left); - lTmpB := (Lines[NrLines].Line[Lines[NrLines].Current].End_ - Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start); - - if ( lTmpA > 0 ) and ( lTmpB > 0 ) then - TempR := lTmpA / lTmpB - else - TempR := 0; - - with Lines[NrLines].Line[Lines[NrLines].Current] do - begin - for Count := 0 to HighNote do - begin - with Note[Count] do - begin - if NoteType <> ntFreestyle then - begin - if Ini.EffectSing = 0 then - // If Golden note Effect of then Change not Color - begin - case NoteType of - ntNormal: glColor4f(1, 1, 1, 1); // We set alpha to 1, cause we can control the transparency through the png itself - ntGolden: glColor4f(1, 1, 0.3, 1); // no stars, paint yellow -> glColor4f(1, 1, 0.3, 0.85); - we could - end; // case - end //Else all Notes same Color - else - glColor4f(1, 1, 1, 1); // We set alpha to 1, cause we can control the transparency through the png itself - - // left part - Rec.Left := (Start-Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start) * TempR + Left + 0.5 + 10*ScreenX; - Rec.Right := Rec.Left + NotesW; - Rec.Top := Top - (Tone-BaseNote)*Space/2 - NotesH; - Rec.Bottom := Rec.Top + 2 * NotesH; - glBindTexture(GL_TEXTURE_2D, Tex_plain_Left[PlayerNumber].TexNum); - glBegin(GL_QUADS); - glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top); - glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom); - glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom); - glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top); - glEnd; - - //We keep the postion of the top left corner b4 it's overwritten - GoldenStarPos := Rec.Left; - //done - - // 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; - - // right part - Rec.Left := Rec.Right; - Rec.Right := Rec.Right + NotesW; - - glBindTexture(GL_TEXTURE_2D, Tex_plain_Right[PlayerNumber].TexNum); - glBegin(GL_QUADS); - glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top); - glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom); - glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom); - glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top); - glEnd; - - // Golden Star Patch - if (NoteType = ntGolden) and (Ini.EffectSing=1) then - begin - GoldenRec.SaveGoldenStarsRec(GoldenStarPos, Rec.Top, Rec.Right, Rec.Bottom); - end; - - end; // if not FreeStyle - end; // with - end; // for - end; // with - - glDisable(GL_BLEND); - glDisable(GL_TEXTURE_2D); -end; - -// draw sung notes -procedure SingDrawPlayerLine(X, Y, W: real; PlayerIndex: integer; Space: integer); -var - TempR: real; - Rec: TRecR; - N: integer; -// R, G, B, A: real; - NotesH2: real; -begin - //Log.LogStatus('Player notes', 'SingDraw'); -{ - if NrGracza = 0 then - LoadColor(R, G, B, 'P1Light') - else - LoadColor(R, G, B, 'P2Light'); -} - //R := 71/255; - //G := 175/255; - //B := 247/255; - - glColor3f(1, 1, 1); - glEnable(GL_TEXTURE_2D); - glEnable(GL_BLEND); - glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); - - //if Player[NrGracza].LengthNote > 0 then - begin - TempR := W / (Lines[0].Line[Lines[0].Current].End_ - Lines[0].Line[Lines[0].Current].Note[0].Start); - for N := 0 to Player[PlayerIndex].HighNote do - begin - with Player[PlayerIndex].Note[N] do - begin - // Left part of note - Rec.Left := X + (Start-Lines[0].Line[Lines[0].Current].Note[0].Start) * TempR + 0.5 + 10*ScreenX; - Rec.Right := Rec.Left + NotesW; - - // Draw it in half size, if not hit - if Hit then - begin - NotesH2 := NotesH - end - else - begin - NotesH2 := int(NotesH * 0.65); - end; - - Rec.Top := Y - (Tone-Lines[0].Line[Lines[0].Current].BaseNote)*Space/2 - NotesH2; - Rec.Bottom := Rec.Top + 2 * NotesH2; - - // draw the left part - glColor3f(1, 1, 1); - glBindTexture(GL_TEXTURE_2D, Tex_Left[PlayerIndex+1].TexNum); - glBegin(GL_QUADS); - glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top); - glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom); - glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom); - glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top); - glEnd; - - // Middle part of the note - Rec.Left := Rec.Right; - Rec.Right := X + (Start+Length-Lines[0].Line[Lines[0].Current].Note[0].Start) * TempR - NotesW - 0.5 + 10*ScreenX; - - // new - if (Start+Length-1 = LyricsState.CurrentBeatD) then - Rec.Right := Rec.Right - (1-Frac(LyricsState.MidBeatD)) * TempR; - // the left note is more right than the right note itself, sounds weird - so we fix that xD - if Rec.Right <= Rec.Left then - Rec.Right := Rec.Left; - - // draw the middle part - glBindTexture(GL_TEXTURE_2D, Tex_Mid[PlayerIndex+1].TexNum); - glTexParameterf( GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_REPEAT ); - glTexParameterf( GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_REPEAT ); - glBegin(GL_QUADS); - glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top); - glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom); - glTexCoord2f(round((Rec.Right-Rec.Left)/32), 1); glVertex2f(Rec.Right, Rec.Bottom); - glTexCoord2f(round((Rec.Right-Rec.Left)/32), 0); glVertex2f(Rec.Right, Rec.Top); - glEnd; - glColor3f(1, 1, 1); - - // the right part of the note - Rec.Left := Rec.Right; - Rec.Right := Rec.Right + NotesW; - - glBindTexture(GL_TEXTURE_2D, Tex_Right[PlayerIndex+1].TexNum); - glBegin(GL_QUADS); - glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top); - glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom); - glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom); - glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top); - glEnd; - - // Perfect note is stored - if Perfect and (Ini.EffectSing=1) then - begin - //A := 1 - 2*(LyricsState.GetCurrentTime() - GetTimeFromBeat(Start+Length)); - if not (Start+Length-1 = LyricsState.CurrentBeatD) then - begin - //Star animation counter - //inc(Starfr); - //Starfr := Starfr mod 128; - GoldenRec.SavePerfectNotePos(Rec.Left, Rec.Top); - end; - end; - end; // with - end; // for - - // actually we need a comparison here, to determine if the singing process - // is ahead Rec.Right even if there is no singing - - if (Ini.EffectSing = 1) then - GoldenRec.GoldenNoteTwinkle(Rec.Top,Rec.Bottom,Rec.Right, PlayerIndex); - end; // if -end; - -//draw Note glow -procedure SingDrawPlayerBGLine(Left, Top, Right: real; NrLines, PlayerIndex: integer; Space: integer); -var - Rec: TRecR; - Count: integer; - TempR: real; - X1, X2, X3, X4: real; - W, H: real; - lTmpA, lTmpB: real; -begin - if (Player[PlayerIndex].ScoreTotalInt >= 0) then - begin - glColor4f(1, 1, 1, sqrt((1+sin( AudioPlayback.Position * 3))/4)/ 2 + 0.5 ); - glEnable(GL_TEXTURE_2D); - glEnable(GL_BLEND); - glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); - - lTmpA := (Right-Left); - lTmpB := (Lines[NrLines].Line[Lines[NrLines].Current].End_ - Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start); - - if ( lTmpA > 0 ) and ( lTmpB > 0 ) then - TempR := lTmpA / lTmpB - else - TempR := 0; - - with Lines[NrLines].Line[Lines[NrLines].Current] do - begin - for Count := 0 to HighNote do - begin - with Note[Count] do - begin - if NoteType <> ntFreestyle then - begin - // begin: 14, 20 - // easy: 6, 11 - W := NotesW * 2 + 2; - H := NotesH * 1.5 + 3.5; - - X2 := (Start-Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start) * TempR + Left + 0.5 + 10*ScreenX + 4; - X1 := X2-W; - - X3 := (Start+Length-Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start) * TempR + Left - 0.5 + 10*ScreenX - 4; - X4 := X3+W; - - // left - Rec.Left := X1; - Rec.Right := X2; - Rec.Top := Top - (Tone-BaseNote)*Space/2 - H; - Rec.Bottom := Rec.Top + 2 * H; - - glBindTexture(GL_TEXTURE_2D, Tex_BG_Left[PlayerIndex+1].TexNum); - glBegin(GL_QUADS); - glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top); - glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom); - glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom); - glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top); - glEnd; - - // middle part - Rec.Left := X2; - Rec.Right := X3; - - glBindTexture(GL_TEXTURE_2D, Tex_BG_Mid[PlayerIndex+1].TexNum); - glBegin(GL_QUADS); - glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top); - glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom); - glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom); - glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top); - glEnd; - - // right part - Rec.Left := X3; - Rec.Right := X4; - - glBindTexture(GL_TEXTURE_2D, Tex_BG_Right[PlayerIndex+1].TexNum); - glBegin(GL_QUADS); - glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top); - glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom); - glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom); - glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top); - glEnd; - end; // if not FreeStyle - end; // with - end; // for - end; // with - - glDisable(GL_BLEND); - glDisable(GL_TEXTURE_2D); - end; -end; - -(** - * Draws the lyrics helper bar. - * Left: position the bar starts at - * LyricsMid: the middle of the lyrics relative to the position Left - *) -procedure SingDrawLyricHelper(Left, LyricsMid: real); -var - Bounds: TRecR; // bounds of the lyric help bar - BarProgress: real; // progress of the lyrics helper - BarMoveDelta: real; // current beat relative to the beat the bar starts to move at - BarAlpha: real; // transparency - CurLine: PLine; // current lyric line (beat specific) - LineWidth: real; // lyric line width - FirstNoteBeat: integer; // beat of the first note in the current line - FirstNoteDelta: integer; // time in beats between the start of the current line and its first note - MoveStartX: real; // x-pos. the bar starts to move from - MoveDist: real; // number of pixels the bar will move - LyricEngine: TLyricEngine; -const - BarWidth = 50; // width of the lyric helper bar - BarHeight = 30; // height of the lyric helper bar - BarMoveLimit = 40; // max. number of beats remaining before the bar starts to move -begin - // get current lyrics line and the time in beats of its first note - CurLine := @Lines[0].Line[Lines[0].Current]; - - // FIXME: accessing ScreenSing is not that generic - LyricEngine := ScreenSing.Lyrics; - - // do not draw the lyrics helper if the current line does not contain any note - if (Length(CurLine.Note) > 0) then - begin - // start beat of the first note of this line - FirstNoteBeat := CurLine.Note[0].Start; - // time in beats between the start of the current line and its first note - FirstNoteDelta := FirstNoteBeat - CurLine.Start; - - // beats from current beat to the first note of the line - BarMoveDelta := FirstNoteBeat - LyricsState.MidBeat; - - if (FirstNoteDelta > 8) and // if the wait-time is large enough - (BarMoveDelta > 0) then // and the first note of the line is not reached - begin - // let the bar blink to the beat - BarAlpha := 0.75 + cos(BarMoveDelta/2) * 0.25; - - // if the number of beats to the first note is too big, - // the bar stays on the left side. - if (BarMoveDelta > BarMoveLimit) then - BarMoveDelta := BarMoveLimit; - - // limit number of beats the bar moves - if (FirstNoteDelta > BarMoveLimit) then - FirstNoteDelta := BarMoveLimit; - - // calc bar progress - BarProgress := 1 - BarMoveDelta / FirstNoteDelta; - - // retrieve the width of the upper lyrics line on the display - if (LyricEngine.GetUpperLine() <> nil) then - LineWidth := LyricEngine.GetUpperLine().Width - else - LineWidth := 0; - - // distance the bar will move (LyricRec.Left to beginning of text) - MoveDist := LyricsMid - LineWidth / 2 - BarWidth; - // if the line is too long the helper might move from right to left - // so we have to assure the start position is left of the text. - if (MoveDist >= 0) then - MoveStartX := Left - else - MoveStartX := Left + MoveDist; - - // determine lyric help bar position and size - Bounds.Left := MoveStartX + BarProgress * MoveDist; - Bounds.Right := Bounds.Left + BarWidth; - Bounds.Top := Theme.LyricBar.IndicatorYOffset + Theme.LyricBar.UpperY ; - Bounds.Bottom := Bounds.Top + BarHeight + 3; - - // draw lyric help bar - glEnable(GL_TEXTURE_2D); - glEnable(GL_BLEND); - glColor4f(1, 1, 1, BarAlpha); - glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); - glBindTexture(GL_TEXTURE_2D, Tex_Lyric_Help_Bar.TexNum); - glBegin(GL_QUADS); - glTexCoord2f(0, 0); glVertex2f(Bounds.Left, Bounds.Top); - glTexCoord2f(0, 1); glVertex2f(Bounds.Left, Bounds.Bottom); - glTexCoord2f(1, 1); glVertex2f(Bounds.Right, Bounds.Bottom); - glTexCoord2f(1, 0); glVertex2f(Bounds.Right, Bounds.Top); - glEnd; - glDisable(GL_BLEND); - end; - end; -end; - -procedure SingDraw; -var - NR: TRecR; // lyrics area bounds (NR = NoteRec?) - LyricEngine: TLyricEngine; -begin - // positions - if Ini.SingWindow = 0 then - NR.Left := 120 - else - NR.Left := 20; - - NR.Right := 780; - - NR.Width := NR.Right - NR.Left; - NR.WMid := NR.Width / 2; - NR.Mid := NR.Left + NR.WMid; - - // FIXME: accessing ScreenSing is not that generic - LyricEngine := ScreenSing.Lyrics; - - // draw time-bar - SingDrawTimeBar(); - - // draw note-lines - - if (PlayersPlay = 1) and (Ini.NoteLines = 1) then - SingDrawNoteLines(NR.Left + 10*ScreenX, Skin_P2_NotesB - 105, NR.Right + 10*ScreenX, 15); - - if ((PlayersPlay = 2) or (PlayersPlay = 4)) and (Ini.NoteLines = 1) then - begin - SingDrawNoteLines(NR.Left + 10*ScreenX, Skin_P1_NotesB - 105, NR.Right + 10*ScreenX, 15); - SingDrawNoteLines(NR.Left + 10*ScreenX, Skin_P2_NotesB - 105, NR.Right + 10*ScreenX, 15); - end; - - if ((PlayersPlay = 3) or (PlayersPlay = 6)) and (Ini.NoteLines = 1) then - begin - SingDrawNoteLines(NR.Left + 10*ScreenX, 120, NR.Right + 10*ScreenX, 12); - SingDrawNoteLines(NR.Left + 10*ScreenX, 245, NR.Right + 10*ScreenX, 12); - SingDrawNoteLines(NR.Left + 10*ScreenX, 370, NR.Right + 10*ScreenX, 12); - end; - - // draw Lyrics - LyricEngine.Draw(LyricsState.MidBeat); - SingDrawLyricHelper(NR.Left, NR.WMid); - - // oscilloscope - if Ini.Oscilloscope = 1 then - begin - if PlayersPlay = 1 then - SingDrawOscilloscope(190 + 10*ScreenX, 55, 180, 40, 0); - - if PlayersPlay = 2 then - begin - SingDrawOscilloscope(190 + 10*ScreenX, 55, 180, 40, 0); - SingDrawOscilloscope(425 + 10*ScreenX, 55, 180, 40, 1); - end; - - if PlayersPlay = 4 then - begin - if ScreenAct = 1 then - begin - SingDrawOscilloscope(190 + 10*ScreenX, 55, 180, 40, 0); - SingDrawOscilloscope(425 + 10*ScreenX, 55, 180, 40, 1); - end; - if ScreenAct = 2 then - begin - SingDrawOscilloscope(190 + 10*ScreenX, 55, 180, 40, 2); - SingDrawOscilloscope(425 + 10*ScreenX, 55, 180, 40, 3); - end; - end; - - if PlayersPlay = 3 then - begin - SingDrawOscilloscope( 75 + 10*ScreenX, 95, 100, 20, 0); - SingDrawOscilloscope(370 + 10*ScreenX, 95, 100, 20, 1); - SingDrawOscilloscope(670 + 10*ScreenX, 95, 100, 20, 2); - end; - - if PlayersPlay = 6 then - begin - if ScreenAct = 1 then - begin - SingDrawOscilloscope( 75 + 10*ScreenX, 95, 100, 20, 0); - SingDrawOscilloscope(370 + 10*ScreenX, 95, 100, 20, 1); - SingDrawOscilloscope(670 + 10*ScreenX, 95, 100, 20, 2); - end; - if ScreenAct = 2 then - begin - SingDrawOscilloscope( 75 + 10*ScreenX, 95, 100, 20, 3); - SingDrawOscilloscope(370 + 10*ScreenX, 95, 100, 20, 4); - SingDrawOscilloscope(670 + 10*ScreenX, 95, 100, 20, 5); - end; - end; - - end; - - // Set the note heights according to the difficulty level - case Ini.Difficulty of - 0: - begin - NotesH := 11; // 9 - NotesW := 6; // 5 - end; - 1: - begin - NotesH := 8; // 7 - NotesW := 4; // 4 - end; - 2: - begin - NotesH := 5; - NotesW := 3; - end; - end; - - // Draw the Notes - if PlayersPlay = 1 then - begin - SingDrawPlayerBGLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 0, 15); // Background glow - colorized in playercolor - SingDrawLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 15); // Plain unsung notes - colorized in playercolor - SingDrawPlayerLine(NR.Left + 20, Skin_P2_NotesB, NR.Width - 40, 0, 15); // imho the sung notes - end; - - if PlayersPlay = 2 then - begin - SingDrawPlayerBGLine(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 0, 15); - SingDrawPlayerBGLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 1, 15); - - SingDrawLine(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 15); - SingDrawLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 1, 15); - - SingDrawPlayerLine(NR.Left + 20, Skin_P1_NotesB, NR.Width - 40, 0, 15); - SingDrawPlayerLine(NR.Left + 20, Skin_P2_NotesB, NR.Width - 40, 1, 15); - end; - - if PlayersPlay = 3 then - begin - NotesW := NotesW * 0.8; - NotesH := NotesH * 0.8; - - SingDrawPlayerBGLine(NR.Left + 20, 120+95, NR.Right - 20, 0, 0, 12); - SingDrawPlayerBGLine(NR.Left + 20, 245+95, NR.Right - 20, 0, 1, 12); - SingDrawPlayerBGLine(NR.Left + 20, 370+95, NR.Right - 20, 0, 2, 12); - - SingDrawLine(NR.Left + 20, 120+95, NR.Right - 20, 0, 12); - SingDrawLine(NR.Left + 20, 245+95, NR.Right - 20, 1, 12); - SingDrawLine(NR.Left + 20, 370+95, NR.Right - 20, 2, 12); - - SingDrawPlayerLine(NR.Left + 20, 120+95, NR.Width - 40, 0, 12); - SingDrawPlayerLine(NR.Left + 20, 245+95, NR.Width - 40, 1, 12); - SingDrawPlayerLine(NR.Left + 20, 370+95, NR.Width - 40, 2, 12); - end; - - if PlayersPlay = 4 then - begin - if ScreenAct = 1 then - begin - SingDrawPlayerBGLine(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 0, 15); - SingDrawPlayerBGLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 1, 15); - end; - if ScreenAct = 2 then - begin - SingDrawPlayerBGLine(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 2, 15); - SingDrawPlayerBGLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 3, 15); - end; - - if ScreenAct = 1 then - begin - SingDrawLine(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 15); - SingDrawLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 1, 15); - end; - if ScreenAct = 2 then - begin - SingDrawLine(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 2, 15); - SingDrawLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 3, 15); - end; - - if ScreenAct = 1 then - begin - SingDrawPlayerLine(NR.Left + 20, Skin_P1_NotesB, NR.Width - 40, 0, 15); - SingDrawPlayerLine(NR.Left + 20, Skin_P2_NotesB, NR.Width - 40, 1, 15); - end; - if ScreenAct = 2 then - begin - SingDrawPlayerLine(NR.Left + 20, Skin_P1_NotesB, NR.Width - 40, 2, 15); - SingDrawPlayerLine(NR.Left + 20, Skin_P2_NotesB, NR.Width - 40, 3, 15); - end; - end; - - if PlayersPlay = 6 then - begin - NotesW := NotesW * 0.8; - NotesH := NotesH * 0.8; - - if ScreenAct = 1 then - begin - SingDrawPlayerBGLine(NR.Left + 20, 120+95, NR.Right - 20, 0, 0, 12); - SingDrawPlayerBGLine(NR.Left + 20, 245+95, NR.Right - 20, 0, 1, 12); - SingDrawPlayerBGLine(NR.Left + 20, 370+95, NR.Right - 20, 0, 2, 12); - end; - if ScreenAct = 2 then - begin - SingDrawPlayerBGLine(NR.Left + 20, 120+95, NR.Right - 20, 0, 3, 12); - SingDrawPlayerBGLine(NR.Left + 20, 245+95, NR.Right - 20, 0, 4, 12); - SingDrawPlayerBGLine(NR.Left + 20, 370+95, NR.Right - 20, 0, 5, 12); - end; - - if ScreenAct = 1 then - begin - SingDrawLine(NR.Left + 20, 120+95, NR.Right - 20, 0, 12); - SingDrawLine(NR.Left + 20, 245+95, NR.Right - 20, 1, 12); - SingDrawLine(NR.Left + 20, 370+95, NR.Right - 20, 2, 12); - end; - if ScreenAct = 2 then - begin - SingDrawLine(NR.Left + 20, 120+95, NR.Right - 20, 3, 12); - SingDrawLine(NR.Left + 20, 245+95, NR.Right - 20, 4, 12); - SingDrawLine(NR.Left + 20, 370+95, NR.Right - 20, 5, 12); - end; - - if ScreenAct = 1 then - begin - SingDrawPlayerLine(NR.Left + 20, 120+95, NR.Width - 40, 0, 12); - SingDrawPlayerLine(NR.Left + 20, 245+95, NR.Width - 40, 1, 12); - SingDrawPlayerLine(NR.Left + 20, 370+95, NR.Width - 40, 2, 12); - end; - if ScreenAct = 2 then - begin - SingDrawPlayerLine(NR.Left + 20, 120+95, NR.Width - 40, 3, 12); - SingDrawPlayerLine(NR.Left + 20, 245+95, NR.Width - 40, 4, 12); - SingDrawPlayerLine(NR.Left + 20, 370+95, NR.Width - 40, 5, 12); - end; - end; - glDisable(GL_BLEND); - glDisable(GL_TEXTURE_2D); -end; - -// q'n'd for using the game mode dll's -procedure SingModiDraw (PlayerInfo: TPlayerInfo); -var - 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 - R: real; - G: real; - B: real; - A: cardinal; - I: integer; - -begin; - - //SingBar Background - glColor4f(1, 1, 1, 0.8); - glEnable(GL_TEXTURE_2D); - glEnable(GL_BLEND); - glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); - glBindTexture(GL_TEXTURE_2D, Tex_SingBar_Back.TexNum); - glBegin(GL_QUADS); - glTexCoord2f(0, 0); glVertex2f(X, Y); - glTexCoord2f(0, 1); glVertex2f(X, Y+H); - glTexCoord2f(1, 1); glVertex2f(X+W, Y+H); - glTexCoord2f(1, 0); glVertex2f(X+W, Y); - glEnd; - - //SingBar coloured Bar - case Percent of - 0..22: begin - R := 1; - G := 0; - B := 0; - end; - 23..42: begin - R := 1; - G := ((Percent-23)/100)*5; - B := 0; - end; - 43..57: begin - R := 1; - G := 1; - B := 0; - end; - 58..77: begin - R := 1-(Percent - 58)/100*5; - G := 1; - B := 0; - end; - 78..99: begin - R := 0; - G := 1; - B := 0; - end; - end; //case - - glColor4f(R, G, B, 1); - glEnable(GL_TEXTURE_2D); - glEnable(GL_BLEND); - glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); - glBindTexture(GL_TEXTURE_2D, Tex_SingBar_Bar.TexNum); - //Size= Player[PlayerNum].ScorePercent of W - glBegin(GL_QUADS); - glTexCoord2f(0, 0); glVertex2f(X, Y); - glTexCoord2f(0, 1); glVertex2f(X, Y+H); - glTexCoord2f(1, 1); glVertex2f(X+(W/100 * (Percent +1)), Y+H); - glTexCoord2f(1, 0); glVertex2f(X+(W/100 * (Percent +1)), Y); - glEnd; - - //SingBar Front - glColor4f(1, 1, 1, 0.6); - glEnable(GL_TEXTURE_2D); - glEnable(GL_BLEND); - glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); - glBindTexture(GL_TEXTURE_2D, Tex_SingBar_Front.TexNum); - glBegin(GL_QUADS); - glTexCoord2f(0, 0); glVertex2f(X, Y); - glTexCoord2f(0, 1); glVertex2f(X, Y+H); - glTexCoord2f(1, 1); glVertex2f(X+W, Y+H); - glTexCoord2f(1, 0); glVertex2f(X+W, Y); - glEnd; -end; -//end Singbar Mod - -//PhrasenBonus - Line Bonus Pop Up -procedure SingDrawLineBonus(const X, Y: Single; Color: TRGB; Alpha: Single; Text: string; Age: integer); -var - Length, X2: real; //Length of Text - Size: integer; //Size of Popup -begin - if Alpha <> 0 then - begin - -//Set Font Propertys - SetFontStyle(2); //Font: Outlined1 - if Age < 5 then - SetFontSize((Age + 1) * 3) - else - SetFontSize(18); - SetFontItalic(False); - -//Check Font Size - Length := glTextWidth (Text) + 3; //Little Space for a Better Look ^^ - -//Text - SetFontPos (X + 50 - (Length / 2), Y + 12); //Position - - if Age < 5 then - Size := Age * 10 - else - Size := 50; - -//Draw Background -// glColor4f(Color.R, Color.G, Color.B, Alpha); //Set Color - glColor4f(1, 1, 1, Alpha); - - glEnable(GL_TEXTURE_2D); - glEnable(GL_BLEND); -// glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); - -//New Method, Not Variable - glBindTexture(GL_TEXTURE_2D, Tex_SingLineBonusBack[2].TexNum); - - glBegin(GL_QUADS); - glTexCoord2f(0, 0); glVertex2f(X + 50 - Size, Y + 25 - (Size/2)); - glTexCoord2f(0, 1); glVertex2f(X + 50 - Size, Y + 25 + (Size/2)); - glTexCoord2f(1, 1); glVertex2f(X + 50 + Size, Y + 25 + (Size/2)); - glTexCoord2f(1, 0); glVertex2f(X + 50 + Size, Y + 25 - (Size/2)); - glEnd; - - glColor4f(1, 1, 1, Alpha); //Set Color -//Draw Text - glPrint (Text); - end; -end; -//PhrasenBonus - Line Bonus Mod} - -// Draw Note Bars for Editor -// There are 11 reasons for a new procedure: (nice binary :D ) -// 1. It does not look good when you draw the golden note star effect in the editor -// 2. You can see the freestyle notes in the editor semitransparent -// 3. It is easier and faster then changing the old procedure -procedure EditDrawLine(Left, Top, Right: real; NrLines: integer; Space: integer); -var - Rec: TRecR; - Count: integer; - TempR: real; -begin - glColor3f(1, 1, 1); - glEnable(GL_TEXTURE_2D); - glEnable(GL_BLEND); - glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); - TempR := (Right-Left) / (Lines[NrLines].Line[Lines[NrLines].Current].End_ - Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start); - with Lines[NrLines].Line[Lines[NrLines].Current] do - begin - for Count := 0 to HighNote do - begin - with Note[Count] do - begin - - // Golden Note Patch - case NoteType of - ntFreestyle: glColor4f(1, 1, 1, 0.35); - ntNormal: glColor4f(1, 1, 1, 0.85); - ntGolden: Glcolor4f(1, 1, 0.3, 0.85); - end; // case - - // left part - Rec.Left := (Start-Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start) * TempR + Left + 0.5 + 10*ScreenX; - Rec.Right := Rec.Left + NotesW; - Rec.Top := Top - (Tone-BaseNote)*Space/2 - NotesH; - Rec.Bottom := Rec.Top + 2 * NotesH; - glBindTexture(GL_TEXTURE_2D, Tex_Left[Color].TexNum); - glBegin(GL_QUADS); - glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top); - glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom); - glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom); - glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top); - glEnd; - - // middle part - Rec.Left := Rec.Right; - Rec.Right := (Start+Length-Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start) * TempR + Left - NotesW - 0.5 + 10*ScreenX; - - glBindTexture(GL_TEXTURE_2D, Tex_Mid[Color].TexNum); - glBegin(GL_QUADS); - glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top); - glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom); - glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom); - glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top); - glEnd; - - // right part - Rec.Left := Rec.Right; - Rec.Right := Rec.Right + NotesW; - - glBindTexture(GL_TEXTURE_2D, Tex_Right[Color].TexNum); - glBegin(GL_QUADS); - glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top); - glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom); - glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom); - glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top); - glEnd; - - end; // with - end; // for - end; // with - - glDisable(GL_BLEND); - glDisable(GL_TEXTURE_2D); -end; - -procedure SingDrawTimeBar(); -var - x, y: real; - width, height: real; - LyricsProgress: real; - CurLyricsTime: real; -begin - x := Theme.Sing.StaticTimeProgress.x; - y := Theme.Sing.StaticTimeProgress.y; - - width := Theme.Sing.StaticTimeProgress.w; - height := Theme.Sing.StaticTimeProgress.h; - - glColor4f(Theme.Sing.StaticTimeProgress.ColR, - Theme.Sing.StaticTimeProgress.ColG, - Theme.Sing.StaticTimeProgress.ColB, 1); //Set Color - - glEnable(GL_TEXTURE_2D); - glEnable(GL_BLEND); - - glBindTexture(GL_TEXTURE_2D, Tex_TimeProgress.TexNum); - - glBegin(GL_QUADS); - glTexCoord2f(0, 0); - glVertex2f(x, y); - - CurLyricsTime := LyricsState.GetCurrentTime(); - if (CurLyricsTime > 0) and - (LyricsState.TotalTime > 0) then - begin - LyricsProgress := CurLyricsTime / LyricsState.TotalTime; - glTexCoord2f((width * LyricsProgress) / 8, 0); - glVertex2f(x + width * LyricsProgress, y); - - glTexCoord2f((width * LyricsProgress) / 8, 1); - glVertex2f(x + width * LyricsProgress, y + height); - end; - - glTexCoord2f(0, 1); - glVertex2f(x, y + height); - glEnd; - - glDisable(GL_TEXTURE_2D); - glDisable(GL_BLEND); - glcolor4f(1, 1, 1, 1); -end; - -end. - diff --git a/src/base/UEditorLyrics.pas b/src/base/UEditorLyrics.pas deleted file mode 100644 index 0eacd1f9..00000000 --- a/src/base/UEditorLyrics.pas +++ /dev/null @@ -1,259 +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 UEditorLyrics; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses - SysUtils, - gl, - UMusic, - UTexture; - -type - TAlignmentType = (atLeft, atCenter, atRight); - - TWord = record - X: real; - Y: real; - Size: real; - Width: real; - Text: string; - ColR: real; - ColG: real; - ColB: real; - FontStyle: integer; - Italic: boolean; - Selected: boolean; - end; - - TEditorLyrics = class - private - AlignI: TAlignmentType; - XR: real; - YR: real; - SizeR: real; - SelectedI: integer; - FontStyleI: integer; // font number - Word: array of TWord; - - procedure SetX(Value: real); - procedure SetY(Value: real); - function GetClientX: real; - procedure SetAlign(Value: TAlignmentType); - function GetSize: real; - procedure SetSize(Value: real); - procedure SetSelected(Value: integer); - procedure SetFontStyle(Value: integer); - procedure AddWord(Text: UTF8String); - procedure Refresh; - public - ColR: real; - ColG: real; - ColB: real; - ColSR: real; - ColSG: real; - ColSB: real; - Italic: boolean; - - constructor Create; - destructor Destroy; override; - - procedure AddLine(NrLine: integer); - - procedure Clear; - procedure Draw; - published - property X: real write SetX; - property Y: real write SetY; - property ClientX: real read GetClientX; - property Align: TAlignmentType write SetAlign; - property Size: real read GetSize write SetSize; - property Selected: integer read SelectedI write SetSelected; - property FontStyle: integer write SetFontStyle; - end; - -implementation - -uses - TextGL, - UGraphic, - UDrawTexture, - Math, - USkins; - -constructor TEditorLyrics.Create; -begin - inherited; -end; - -destructor TEditorLyrics.Destroy; -begin - SetLength(Word, 0); - inherited; -end; - -procedure TEditorLyrics.SetX(Value: real); -begin - XR := Value; -end; - -procedure TEditorLyrics.SetY(Value: real); -begin - YR := Value; -end; - -function TEditorLyrics.GetClientX: real; -begin - Result := Word[0].X; -end; - -procedure TEditorLyrics.SetAlign(Value: TAlignmentType); -begin - AlignI := Value; -end; - -function TEditorLyrics.GetSize: real; -begin - Result := SizeR; -end; - -procedure TEditorLyrics.SetSize(Value: real); -begin - SizeR := Value; -end; - -procedure TEditorLyrics.SetSelected(Value: integer); -begin - if (-1 < SelectedI) and (SelectedI <= High(Word)) then - begin - Word[SelectedI].Selected := false; - Word[SelectedI].ColR := ColR; - Word[SelectedI].ColG := ColG; - Word[SelectedI].ColB := ColB; - end; - - SelectedI := Value; - if (-1 < Value) and (Value <= High(Word)) then - begin - Word[Value].Selected := true; - Word[Value].ColR := ColSR; - Word[Value].ColG := ColSG; - Word[Value].ColB := ColSB; - end; - - Refresh; -end; - -procedure TEditorLyrics.SetFontStyle(Value: integer); -begin - FontStyleI := Value; -end; - -procedure TEditorLyrics.AddWord(Text: UTF8String); -var - WordNum: integer; -begin - WordNum := Length(Word); - SetLength(Word, WordNum + 1); - if WordNum = 0 then - Word[WordNum].X := XR - else - Word[WordNum].X := Word[WordNum - 1].X + Word[WordNum - 1].Width; - - Word[WordNum].Y := YR; - Word[WordNum].Size := SizeR; - Word[WordNum].FontStyle := FontStyleI; - SetFontStyle(FontStyleI); - SetFontSize(SizeR); - Word[WordNum].Width := glTextWidth(Text); - Word[WordNum].Text := Text; - Word[WordNum].ColR := ColR; - Word[WordNum].ColG := ColG; - Word[WordNum].ColB := ColB; - Word[WordNum].Italic := Italic; - - Refresh; -end; - -procedure TEditorLyrics.AddLine(NrLine: integer); -var - NoteIndex: integer; -begin - Clear; - for NoteIndex := 0 to Lines[0].Line[NrLine].HighNote do - begin - Italic := Lines[0].Line[NrLine].Note[NoteIndex].NoteType = ntFreestyle; - AddWord(Lines[0].Line[NrLine].Note[NoteIndex].Text); - end; - Selected := -1; -end; - -procedure TEditorLyrics.Clear; -begin - SetLength(Word, 0); - SelectedI := -1; -end; - -procedure TEditorLyrics.Refresh; -var - WordIndex: integer; - TotalWidth: real; -begin - if AlignI = atCenter then - begin - TotalWidth := 0; - for WordIndex := 0 to High(Word) do - TotalWidth := TotalWidth + Word[WordIndex].Width; - - Word[0].X := XR - TotalWidth / 2; - for WordIndex := 1 to High(Word) do - Word[WordIndex].X := Word[WordIndex - 1].X + Word[WordIndex - 1].Width; - end; -end; - -procedure TEditorLyrics.Draw; -var - WordIndex: integer; -begin - for WordIndex := 0 to High(Word) do - begin - SetFontStyle(Word[WordIndex].FontStyle); - SetFontPos(Word[WordIndex].X + 10*ScreenX, Word[WordIndex].Y); - SetFontSize(Word[WordIndex].Size); - SetFontItalic(Word[WordIndex].Italic); - glColor3f(Word[WordIndex].ColR, Word[WordIndex].ColG, Word[WordIndex].ColB); - glPrint(Word[WordIndex].Text); - end; -end; - -end. diff --git a/src/base/UFiles.pas b/src/base/UFiles.pas deleted file mode 100644 index 5a258e3e..00000000 --- a/src/base/UFiles.pas +++ /dev/null @@ -1,212 +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 UFiles; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} -{$I switches.inc} - -uses - SysUtils, - Classes, - ULog, - UMusic, - USongs, - USong, - UPath; - -procedure ResetSingTemp; - -type - TSaveSongResult = (ssrOK, ssrFileError, ssrEncodingError); - -{** - * 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 - -uses - TextGL, - UIni, - UNote, - UPlatform, - UUnicodeUtils, - UTextEncoding; - -//-------------------- -// Resets the temporary Sentence Arrays for each Player and some other Variables -//-------------------- -procedure ResetSingTemp; -var - Count: integer; -begin - SetLength(Lines, Length(Player)); - for Count := 0 to High(Player) do begin - SetLength(Lines[Count].Line, 1); - SetLength(Lines[Count].Line[0].Note, 0); - Lines[Count].Line[0].Lyric := ''; - Player[Count].Score := 0; - Player[Count].LengthNote := 0; - Player[Count].HighNote := -1; - end; -end; - -//-------------------- -// Saves a Song -//-------------------- -function SaveSong(const Song: TSong; const Lines: TLines; const Name: IPath; Relative: boolean): TSaveSongResult; -var - C: integer; - N: integer; - S: AnsiString; - B: integer; - RelativeSubTime: integer; - NoteState: AnsiString; - SongFile: TTextFileStream; - - function EncodeToken(const Str: UTF8String): RawByteString; - var - Success: boolean; - begin - Success := EncodeStringUTF8(Str, Result, Song.Encoding); - if (not Success) then - SaveSong := ssrEncodingError; - end; - - 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; - - end; - -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/src/base/UFilesystem.pas b/src/base/UFilesystem.pas deleted file mode 100644 index d4972df5..00000000 --- a/src/base/UFilesystem.pas +++ /dev/null @@ -1,692 +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 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): THandle; - function DirectoryCreate(const Dir: IPath): boolean; - function FileOpen(const FileName: IPath; Mode: longword): THandle; - 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): THandle; - function DirectoryCreate(const Dir: IPath): boolean; - function FileOpen(const FileName: IPath; Mode: longword): THandle; - 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): THandle; -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): THandle; -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): THandle; -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): THandle; -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/src/base/UFont.pas b/src/base/UFont.pas deleted file mode 100644 index 191e74d2..00000000 --- a/src/base/UFont.pas +++ /dev/null @@ -1,2798 +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 UFont; - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -interface - -{$IFNDEF FREETYPE_DEMO} - // Flip direction of y-axis. - // Default is a cartesian coordinate system with y-axis in upper direction - // but with USDX the y-axis is in lower direction. - {$DEFINE FLIP_YAXIS} - {$DEFINE BITMAP_FONT} -{$ENDIF} - -uses - FreeType, - gl, - glext, - glu, - sdl, - Math, - Classes, - SysUtils, - UUnicodeUtils, - {$IFDEF BITMAP_FONT} - UTexture, - {$ENDIF} - UPath; - -type - - PGLubyteArray = ^TGLubyteArray; - TGLubyteArray = array[0 .. (MaxInt div SizeOf(GLubyte))-1] of GLubyte; - TGLubyteDynArray = array of GLubyte; - - TUCS4StringArray = array of UCS4String; - - TGLColor = packed record - case byte of - 0: ( vals: array[0..3] of GLfloat; ); - 1: ( r, g, b, a: GLfloat; ); - end; - - TBoundsDbl = record - Left, Right: double; - Bottom, Top: double; - end; - - TPositionDbl = record - X, Y: double; - end; - - TTextureSize = record - Width, Height: integer; - end; - - TBitmapCoords = record - Left, Top: double; - Width, Height: integer; - end; - - {** - * Abstract base class representing a glyph. - *} - TGlyph = class - protected - function GetAdvance(): TPositionDbl; virtual; abstract; - function GetBounds(): TBoundsDbl; virtual; abstract; - public - procedure Render(UseDisplayLists: boolean); virtual; abstract; - procedure RenderReflection(); virtual; abstract; - - {** Distance to next glyph (in pixels) *} - property Advance: TPositionDbl read GetAdvance; - {** Glyph bounding box (in pixels) *} - property Bounds: TBoundsDbl read GetBounds; - end; - - {** - * Font styles used by TFont.Style - *} - TFontStyle = set of (Italic, Underline, Reflect); - - {** - * Base font class. - *} - TFont = class - private - {** Non-virtual reset-method used in Create() and Reset() } - procedure ResetIntern(); - - protected - fStyle: TFontStyle; - fUseKerning: boolean; - fLineSpacing: single; // must be inited by subclass - fReflectionSpacing: single; // must be inited by subclass to -2*Descender - fGlyphSpacing: single; - fReflectionPass: boolean; - - {** - * Splits lines in Text seperated by newline (char-code #13). - * @param Text UCS-4 encoded string - * @param Lines splitted UCS4String lines - *} - procedure SplitLines(const Text: UCS4String; var Lines: TUCS4StringArray); - - {** - * 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: TUCS4StringArray); overload; virtual; - - {** - * Draws an underline. - *} - procedure DrawUnderline(const Text: UCS4String); virtual; - - {** - * Renders (one) line of text. - *} - 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: TUCS4StringArray; Advance: boolean): TBoundsDbl; overload; virtual; abstract; - - {** - * Resets all user settings to default values. - * Override methods should always call the inherited version. - *} - procedure Reset(); virtual; - - function GetHeight(): single; virtual; abstract; - function GetAscender(): single; virtual; abstract; - function GetDescender(): single; virtual; abstract; - procedure SetLineSpacing(Spacing: single); virtual; - function GetLineSpacing(): single; virtual; - procedure SetGlyphSpacing(Spacing: single); virtual; - function GetGlyphSpacing(): single; virtual; - procedure SetReflectionSpacing(Spacing: single); virtual; - function GetReflectionSpacing(): single; virtual; - procedure SetStyle(Style: TFontStyle); virtual; - function GetStyle(): TFontStyle; virtual; - function GetUnderlinePosition(): single; virtual; abstract; - function GetUnderlineThickness(): single; virtual; abstract; - procedure SetUseKerning(Enable: boolean); virtual; - function GetUseKerning(): boolean; virtual; - procedure SetReflectionPass(Enable: boolean); virtual; - - {** Returns true if the current render-pass is used to draw the reflection } - property ReflectionPass: boolean read fReflectionPass write SetReflectionPass; - - public - constructor Create(); - 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: UTF8String); overload; - - {** - * Calculates the bounding box (width and height) around Text. - * Works with Italic and Underline styles but reflections created - * with the Reflect style are not considered. - * Note that the width might differ due to kerning with appended text, - * e.g. Width('VA') <= Width('V') + Width('A'). - * @param Advance if set to true, Result.Right is set to the advance of - * the given text rather than the min. right border. The advance width is - * 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; - - {** Font height } - property Height: single read GetHeight; - {** Vertical distance from baseline to top of glyph } - property Ascender: single read GetAscender; - {** Vertical distance from baseline to bottom of glyph } - property Descender: single read GetDescender; - {** Vertical distance between two baselines } - property LineSpacing: single read GetLineSpacing write SetLineSpacing; - {** Space between end and start of next glyph added to the advance width } - property GlyphSpacing: single read GetGlyphSpacing write SetGlyphSpacing; - {** Distance between normal baseline and baseline of the reflection } - property ReflectionSpacing: single read GetReflectionSpacing write SetReflectionSpacing; - {** Font style (italic/underline/...) } - 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; - end; - -const - //** Max. number of mipmap levels that a TScalableFont can contain - cMaxMipmapLevel = 5; - -type - {** - * Wrapper around TFont to allow font size changes. - * The font is scaled to the requested size by a modelview matrix - * transformation (glScale) and not by rescaling the internal bitmap - * representation. This way changing the size is really fast but the result - * may lack quality on large or small scale factors. - *} - TScalableFont = class(TFont) - private - procedure ResetIntern(); - - protected - fScale: single; //**< current height to base-font height ratio - fAspect: single; //**< width to height aspect - 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: 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. - * Must be defined by the subclass. - * Mipmaps created by this method are managed and freed by TScalableFont. - *} - function CreateMipmap(Level: integer; Scale: single): TFont; virtual; abstract; - - {** - * Returns the mipmap level considering the current scale and projection - * matrix. - *} - function GetMipmapLevel(): integer; - - {** - * Returns the scale applied to the given mipmap font. - * fScale * fBaseFont.Height / fMipmapFont[Level].Height - *} - function GetMipmapScale(Level: integer): single; - - {** - * Chooses the mipmap that looks nicest with current scale and projection - * matrix. - *} - function ChooseMipmapFont(): TFont; - - procedure SetHeight(Height: single); virtual; - function GetHeight(): single; override; - procedure SetAspect(Aspect: single); virtual; - function GetAspect(): single; virtual; - function GetAscender(): single; override; - function GetDescender(): single; override; - procedure SetLineSpacing(Spacing: single); override; - function GetLineSpacing(): single; override; - procedure SetGlyphSpacing(Spacing: single); override; - function GetGlyphSpacing(): single; override; - procedure SetReflectionSpacing(Spacing: single); override; - function GetReflectionSpacing(): single; override; - procedure SetStyle(Style: TFontStyle); override; - function GetStyle(): TFontStyle; override; - function GetUnderlinePosition(): single; override; - function GetUnderlineThickness(): single; override; - procedure SetUseKerning(Enable: boolean); override; - - public - {** - * Creates a wrapper to make the base-font Font scalable. - * If UseMipmaps is set to true smaller fonts are created so that a - * resized (Height property changed) font looks nicer. - * The font passed is managed and freed by TScalableFont. - *} - constructor Create(Font: TFont; UseMipmaps: boolean); overload; - - {** - * Frees memory. The fonts passed on Create() and mipmap creation - * are freed too. - *} - destructor Destroy(); override; - - {** @seealso TFont.Reset } - procedure Reset(); override; - - {** 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; - end; - - {** - * Table for storage of max. 256 glyphs. - * Used for the second cache level. Indexed by the LSB of the UCS4Char - * char-code. - *} - PGlyphTable = ^TGlyphTable; - TGlyphTable = array[0..255] of TGlyph; - - {** - * 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 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. - * The LSB of the char-code of a glyph is the table-offset of that glyph. - *} - TGlyphCache = class - private - fHash: TList; - - {** - * Finds a glyph-table storing cached glyphs with base-code BaseCode - * (= upper char-code bytes) in the hash-list and returns the table and - * its index. - * @param(InsertPos the position of the tyble in the list if it was found, - * otherwise the position the table should be inserted) - *} - function FindGlyphTable(BaseCode: cardinal; out InsertPos: integer): PGlyphTable; - - public - constructor Create(); - destructor Destroy(); override; - - {** - * Add glyph Glyph with char-code ch to the cache. - * @returns @true on success, @false otherwise - *} - function AddGlyph(ch: UCS4Char; const Glyph: TGlyph): boolean; - - {** - * Removes the glyph with char-code ch from the cache. - *} - procedure DeleteGlyph(ch: UCS4Char); - - {** - * Removes the glyph with char-code ch from the cache. - *} - function GetGlyph(ch: UCS4Char): TGlyph; - - {** - * Checks if a glyph with char-code ch is cached. - *} - function HasGlyph(ch: UCS4Char): boolean; - - {** - * Remove and free all cached glyphs. If KeepBaseSet is set to - * true, cached characters in the range 0..255 will not be flushed. - *} - procedure FlushCache(KeepBaseSet: boolean); - end; - - {** - * Entry of a glyph-cache's (TGlyphCache) hash. - * Stores a BaseCode (upper-bytes of a glyph's char-code) and a table - * with all glyphs cached at the moment with that BaseCode. - *} - TGlyphCacheHashEntry = class - private - fBaseCode: cardinal; - public - GlyphTable: TGlyphTable; - - constructor Create(BaseCode: cardinal); - - {** Base-code (upper-bytes) of the glyphs stored in this entry's table } - property BaseCode: cardinal read fBaseCode; - end; - - TCachedFont = class(TFont) - protected - fCache: TGlyphCache; - - {** - * 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: UCS4Char): TGlyph; - - {** - * Callback to create (load) a glyph with char-code ch. - * Implemented by subclasses. - *} - function LoadGlyph(ch: UCS4Char): TGlyph; virtual; abstract; - - public - constructor Create(); - destructor Destroy(); override; - - {** - * Remove and free all cached glyphs. If KeepBaseSet is set to - * true, the base glyphs are not be flushed. - * @seealso TGlyphCache.FlushCache - *} - procedure FlushCache(KeepBaseSet: boolean); - end; - - TFTFont = class; - - {** - * Freetype glyph. - * Each glyph stores a texture with the glyph's image. - *} - TFTGlyph = class(TGlyph) - private - fCharCode: UCS4Char; //**< Char code - fCharIndex: FT_UInt; //**< Freetype specific char-index (<> char-code) - fDisplayList: GLuint; //**< Display-list ID - fTexture: GLuint; //**< Texture ID - fBitmapCoords: TBitmapCoords; //**< Left/Top offset and Width/Height of the bitmap (in pixels) - fTexOffset: TPositionDbl; //**< Right and bottom texture offset for removal of power-of-2 padding - fTexSize: TTextureSize; //**< Texture size in pixels - - fFont: TFTFont; //**< Font associated with this glyph - fAdvance: TPositionDbl; //**< Advance width of this glyph - fBounds: TBoundsDbl; //**< Glyph bounds - fOutset: single; //**< Extrusion outset - - {** - * Extrudes the outline of a glyph's bitmap stored in TexBuffer with size - * fTexSize by Outset pixels. - * This is useful to create bold or outlined fonts. - * TexBuffer must be 2*Ceil(Outset) pixels higher and wider than the - * original glyph bitmap, otherwise the glyph borders cannot be extruded - * correctly. - * The bitmap must be 2* pixels wider and higher than the - * original glyph's bitmap with the latter centered in it. - *} - 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 - *} - procedure CreateTexture(LoadFlags: FT_Int32); - - protected - function GetAdvance(): TPositionDbl; override; - function GetBounds(): TBoundsDbl; override; - - public - {** - * Creates a glyph with char-code ch from font Font. - * @param LoadFlags flags passed to FT_Load_Glyph() - *} - constructor Create(Font: TFTFont; ch: UCS4Char; Outset: single; - LoadFlags: FT_Int32); - destructor Destroy(); override; - - {** Renders the glyph (normal render pass) } - procedure Render(UseDisplayLists: boolean); override; - {** Renders the glyph's reflection } - procedure RenderReflection(); override; - - {** Freetype specific char-index (<> char-code) } - property CharIndex: FT_UInt read fCharIndex; - end; - - TFontPart = ( fpNone, fpInner, fpOutline ); - - {** - * Freetype font class. - *} - TFTFont = class(TCachedFont) - private - procedure ResetIntern(); - - protected - fFilename: IPath; //**< filename of the font-file - 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 - - {** @seealso TCachedFont.LoadGlyph } - function LoadGlyph(ch: UCS4Char): TGlyph; override; - - procedure Render(const Text: UCS4String); override; - function BBox(const Text: TUCS4StringArray; Advance: boolean): TBoundsDbl; override; - - function GetHeight(): single; override; - function GetAscender(): single; override; - function GetDescender(): single; override; - 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 - *} - constructor Create(const Filename: IPath; - Size: integer; Outset: single = 0.0; - LoadFlags: FT_Int32 = FT_LOAD_DEFAULT); - - {** - * Frees all resources associated with the font. - *} - destructor Destroy(); override; - - {** @seealso TFont.Reset } - procedure Reset(); override; - - {** Size of the base font } - property Size: integer read fSize; - {** Outset size } - property Outset: single read fOutset; - end; - - TFTScalableFont = class(TScalableFont) - protected - function GetOutset(): single; virtual; - function CreateMipmap(Level: integer; Scale: single): TFont; override; - - public - {** - * Creates a scalable font of size Size (in pixels) from the file Filename. - * OutsetAmount is the ratio of the glyph extrusion. - * The extrusion in pixels is Size*OutsetAmount - * (0.0 -> no extrusion, 0.1 -> 10%). - *} - constructor Create(const Filename: IPath; - Size: integer; OutsetAmount: single = 0.0; - UseMipmaps: boolean = true); - - {** @seealso TGlyphCache.FlushCache } - procedure FlushCache(KeepBaseSet: boolean); - - {** Outset size (in pixels) of the scaled font } - property Outset: single read GetOutset; - end; - - - {** - * Represents a freetype font with an additional outline around its glyphs. - * The outline size is passed on creation and cannot be changed later. - *} - TFTOutlineFont = class(TFont) - private - fFilename: IPath; - fSize: integer; - fOutset: single; - fInnerFont, fOutlineFont: TFTFont; - fOutlineColor: TGLColor; - - procedure ResetIntern(); - - protected - 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; - function GetDescender(): single; override; - procedure SetLineSpacing(Spacing: single); override; - procedure SetGlyphSpacing(Spacing: single); override; - procedure SetReflectionSpacing(Spacing: single); override; - procedure SetStyle(Style: TFontStyle); override; - function GetStyle(): TFontStyle; override; - function GetUnderlinePosition(): single; override; - function GetUnderlineThickness(): single; override; - procedure SetUseKerning(Enable: boolean); override; - procedure SetReflectionPass(Enable: boolean); override; - - public - constructor Create(const Filename: IPath; - Size: integer; Outset: single; - LoadFlags: FT_Int32 = FT_LOAD_DEFAULT); - destructor Destroy; override; - - {** - * Sets the color of the outline. - * If the alpha component is < 0, OpenGL's current alpha value will be - * used. - *} - procedure SetOutlineColor(r, g, b: GLfloat; a: GLfloat = -1.0); - - {** @seealso TGlyphCache.FlushCache } - procedure FlushCache(KeepBaseSet: boolean); - - {** @seealso TFont.Reset } - procedure Reset(); override; - - {** Size of the base font } - property Size: integer read fSize; - {** Outset size } - property Outset: single read fOutset; - end; - - {** - * Wrapper around TOutlineFont to allow font resizing. - * @seealso TScalableFont - *} - TFTScalableOutlineFont = class(TScalableFont) - protected - function GetOutset(): single; virtual; - function CreateMipmap(Level: integer; Scale: single): TFont; override; - - public - constructor Create(const Filename: IPath; - Size: integer; OutsetAmount: single; - UseMipmaps: boolean = true); - - {** @seealso TFTOutlineFont.SetOutlineColor } - procedure SetOutlineColor(r, g, b: GLfloat; a: GLfloat = -1.0); - - {** @seealso TGlyphCache.FlushCache } - procedure FlushCache(KeepBaseSet: boolean); - - {** Outset size } - property Outset: single read GetOutset; - end; - -{$IFDEF BITMAP_FONT} - - {** - * A bitmapped font loads it's glyphs from a bitmap and stores them in a - * texture. Unicode characters are not supported (but could be by supporting - * multiple textures each storing a subset of unicode glyphs). - * For backward compatibility only. - *} - TBitmapFont = class(TFont) - private - fTex: TTexture; - fTexSize: integer; - fBaseline: integer; - fAscender: integer; - fDescender: integer; - fWidths: array[0..255] of byte; //**< half widths - fOutline: integer; - fTempColor: TGLColor; //**< colours for the reflection - - procedure ResetIntern(); - - 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 - *} - procedure LoadFontInfo(const InfoFile: IPath); - - protected - procedure Render(const Text: UCS4String); override; - function BBox(const Text: TUCS4StringArray; Advance: boolean): TBoundsDbl; override; - - function GetHeight(): single; override; - function GetAscender(): single; override; - function GetDescender(): single; override; - function GetUnderlinePosition(): single; override; - function GetUnderlineThickness(): single; override; - - public - {** - * Creates a bitmapped font from image Filename and font width info - * loaded from the corresponding file with ending .dat. - * @param(Baseline y-coord of the baseline given in cartesian coords - * (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: IPath; Outline: integer; - Baseline, Ascender, Descender: integer); - destructor Destroy(); override; - - {** - * Corrects font widths provided by the info file. - * NewWidth := Width * WidthMult + WidthAdd - *} - procedure CorrectWidths(WidthMult: real; WidthAdd: integer); - - {** @seealso TFont.Reset } - procedure Reset(); override; - end; - -{$ENDIF BITMAP_FONT} - - TFreeType = class - public - {** - * Returns a pointer to the freetype library singleton. - * If non exists, freetype will be initialized. - * @raises Exception if initialization failed - *} - class function GetLibrary(): FT_Library; - class procedure FreeLibrary(); - end; - - -implementation - -uses Types; - -const - //** shear factor used for the italic effect (bigger value -> more bending) - cShearFactor = 0.25; - cShearMatrix: array[0..15] of GLfloat = ( - 1, 0, 0, 0, - cShearFactor, 1, 0, 0, - 0, 0, 1, 0, - 0, 0, 0, 1 - ); - cShearMatrixInv: array[0..15] of GLfloat = ( - 1, 0, 0, 0, - -cShearFactor, 1, 0, 0, - 0, 0, 1, 0, - 0, 0, 0, 1 - ); - -var - LibraryInst: FT_Library; - -function NewGLColor(r, g, b, a: GLfloat): TGLColor; -begin - Result.r := r; - Result.g := g; - Result.b := b; - Result.a := a; -end; - -{** - * Returns the first power of 2 >= Value. - *} -function NextPowerOf2(Value: integer): integer; {$IFDEF HasInline}inline;{$ENDIF} -begin - Result := 1; - while (Result < Value) do - Result := Result shl 1; -end; - - -{* - * TFont - *} - -constructor TFont.Create(); -begin - inherited; - ResetIntern(); -end; - -destructor TFont.Destroy(); -begin - inherited; -end; - -procedure TFont.ResetIntern(); -begin - fStyle := []; - fUseKerning := true; - fGlyphSpacing := 0.0; - fReflectionPass := false; - - // must be set by subclasses - fLineSpacing := 0.0; - fReflectionSpacing := 0.0; -end; - -procedure TFont.Reset(); -begin - ResetIntern(); -end; - -procedure TFont.SplitLines(const Text: UCS4String; var Lines: TUCS4StringArray); -var - CharIndex: integer; - LineStart: integer; - LineLength: integer; - EOT: boolean; // End-Of-Text -begin - // split lines on newline - SetLength(Lines, 0); - EOT := false; - LineStart := 0; - - 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: UCS4String; Advance: boolean): TBoundsDbl; -var - 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(WideStringToUCS4String(Text), Advance); -end; - -procedure TFont.Print(const Text: TUCS4StringArray); -var - LineIndex: integer; -begin - // recursively call this function to draw reflected text - if ((Reflect in Style) and not ReflectionPass) then - begin - ReflectionPass := true; - Print(Text); - ReflectionPass := false; - end; - - // store current color, enable-flags, matrix-mode - glPushAttrib(GL_CURRENT_BIT or GL_ENABLE_BIT or GL_TRANSFORM_BIT); - - // set OpenGL state - glMatrixMode(GL_MODELVIEW); - glDisable(GL_DEPTH_TEST); - glEnable(GL_BLEND); - glEnable(GL_TEXTURE_2D); - glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); - - { - // TODO: just draw texels with alpha > 0 to avoid setting z-buffer for them? - glAlphaFunc(GL_GREATER, 0); - glEnable(GL_ALPHA_TEST); - - //TODO: Do we need depth-testing? - if (ReflectionPass) then - begin - glDepthMask(0); - glEnable(GL_DEPTH_TEST); - end; - } - - {$IFDEF FLIP_YAXIS} - glPushMatrix(); - glScalef(1, -1, 1); - {$ENDIF} - - // display text - for LineIndex := 0 to High(Text) do - begin - glPushMatrix(); - - // move to baseline - glTranslatef(0, -LineSpacing*LineIndex, 0); - - if ((Underline in Style) and not ReflectionPass) then - begin - glDisable(GL_TEXTURE_2D); - DrawUnderline(Text[LineIndex]); - glEnable(GL_TEXTURE_2D); - end; - - // draw reflection - if (ReflectionPass) then - begin - // set reflection spacing - glTranslatef(0, -ReflectionSpacing, 0); - // flip y-axis - glScalef(1, -1, 1); - end; - - // shear for italic effect - if (Italic in Style) then - glMultMatrixf(@cShearMatrix); - - // render text line - Render(Text[LineIndex]); - - glPopMatrix(); - end; - - // restore settings - {$IFDEF FLIP_YAXIS} - glPopMatrix(); - {$ENDIF} - glPopAttrib(); -end; - -procedure TFont.Print(const Text: UCS4String); -var - 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(WideStringToUCS4String(Text)); -end; - -procedure TFont.DrawUnderline(const Text: UCS4String); -var - UnderlineY1, UnderlineY2: single; - Bounds: TBoundsDbl; -begin - UnderlineY1 := GetUnderlinePosition(); - UnderlineY2 := UnderlineY1 + GetUnderlineThickness(); - Bounds := BBox(Text, false); - glRectf(Bounds.Left, UnderlineY1, Bounds.Right, UnderlineY2); -end; - -procedure TFont.SetStyle(Style: TFontStyle); -begin - fStyle := Style; -end; - -function TFont.GetStyle(): TFontStyle; -begin - Result := fStyle; -end; - -procedure TFont.SetLineSpacing(Spacing: single); -begin - fLineSpacing := Spacing; -end; - -function TFont.GetLineSpacing(): single; -begin - Result := fLineSpacing; -end; - -procedure TFont.SetGlyphSpacing(Spacing: single); -begin - fGlyphSpacing := Spacing; -end; - -function TFont.GetGlyphSpacing(): single; -begin - Result := fGlyphSpacing; -end; - -procedure TFont.SetReflectionSpacing(Spacing: single); -begin - fReflectionSpacing := Spacing; -end; - -function TFont.GetReflectionSpacing(): single; -begin - Result := fReflectionSpacing; -end; - -procedure TFont.SetUseKerning(Enable: boolean); -begin - fUseKerning := Enable; -end; - -function TFont.GetUseKerning(): boolean; -begin - Result := fUseKerning; -end; - -procedure TFont.SetReflectionPass(Enable: boolean); -begin - fReflectionPass := Enable; -end; - - -{* - * TScalableFont - *} - -constructor TScalableFont.Create(Font: TFont; UseMipmaps: boolean); -var - MipmapLevel: integer; -begin - inherited Create(); - - fBaseFont := Font; - fMipmapFonts[0] := Font; - fUseMipmaps := UseMipmaps; - ResetIntern(); - - // create mipmap fonts if requested - if (UseMipmaps) then - begin - for MipmapLevel := 1 to cMaxMipmapLevel do - begin - fMipmapFonts[MipmapLevel] := CreateMipmap(MipmapLevel, 1/(1 shl MipmapLevel)); - // stop if no smaller mipmap font is returned - if (fMipmapFonts[MipmapLevel] = nil) then - Break; - end; - end; -end; - -destructor TScalableFont.Destroy(); -var - Level: integer; -begin - for Level := 0 to High(fMipmapFonts) do - fMipmapFonts[Level].Free; - inherited; -end; - -procedure TScalableFont.ResetIntern(); -begin - fScale := 1.0; - fAspect := 1.0; -end; - -procedure TScalableFont.Reset(); -var - Level: integer; -begin - inherited; - ResetIntern(); - for Level := 0 to High(fMipmapFonts) do - if (fMipmapFonts[Level] <> nil) then - fMipmapFonts[Level].Reset(); -end; - -{** - * Returns the mipmap level to use with regard to the current projection - * and modelview matrix, font scale and aspect. - * - * Note: - * - for Freetype fonts, hinting and grid-fitting must be disabled, otherwise - * the glyph widths/heights ratios and advance widths of the mipmap fonts - * do not match as they are adjusted sligthly (e.g. an 'a' at size 12px has - * width 12px, but at size 6px width 8px). - * - returned mipmap-level is used for all glyphs of the current text to print. - * This is faster, much easier to handle, since we just need to create - * multiple sized fonts and select the one we need for the mipmap-level and - * it avoids that neighbored glyphs use different mipmap-level which might - * look odd because one glyph might look blurry and the other sharp. - * - * Motivation: - * We do not use OpenGL for mipmapping as the results are very bad. At least - * with automatic mipmap generation (gluBuildMipmaps) the fonts look rather - * blurry. - * Defining our own mipmaps by creating multiple textures with - * for different mimap levels is a pain, as the font size passed to freetype - * is not the size of the bitmaps created and it does not guarantee that a - * glyph bitmap of a font with font-size s/2 is half the size of the font with - * font-size s. If the bitmap size is just a single pixel bigger than the half - * we might need a texture of the next power-of-2 and the texture would not be - * half of the size of the next bigger mipmap. In addition we use a fixed one - * pixel sized border to smooth the texture (see cTexSmoothBorder) and maybe - * an outset that is added to the font, so creating a glyph mipmap that is - * exactly half the size of the next bigger one is a very difficult task. - * - * Solution: - * Use mipmap textures that are not exactly half the size of the next mipmap - * level. OpenGL does not support this (at least not without extensions). - * The trickiest task is to determine the mipmap to use by calculating the - * amount of minification that is performed in this function. - *} -function TScalableFont.GetMipmapLevel(): integer; -var - ModelMatrix, ProjMatrix: T16dArray; - WinCoords: array[0..2, 0..2] of GLdouble; - ViewPortArray: TViewPortArray; - Dist, Dist2: double; - WidthScale, HeightScale: double; -const - // width/height of square used for determining the scale - cTestSize = 10.0; - // an offset to the mipmap-level to adjust the change-over of two consecutive - // mipmap levels. If for example the bias is 0.1 and unbiased level is 1.9 - // the result level will be 2. A bias of 0.5 is equal to rounding. - // With bias=0.1 we prefer larger mipmaps over smaller ones. - cBias = 0.2; -begin - // 1. retrieve current transformation matrices for gluProject - glGetDoublev(GL_MODELVIEW_MATRIX, @ModelMatrix); - glGetDoublev(GL_PROJECTION_MATRIX, @ProjMatrix); - glGetIntegerv(GL_VIEWPORT, @ViewPortArray); - - // 2. project three of the corner points of a square with size cTestSize - // to window coordinates (the square is just a dummy for a glyph) - - // project point (x1, y1) to window corrdinates - gluProject(0, 0, 0, - ModelMatrix, ProjMatrix, ViewPortArray, - @WinCoords[0][0], @WinCoords[0][1], @WinCoords[0][2]); - // project point (x2, y1) to window corrdinates - gluProject(cTestSize, 0, 0, - ModelMatrix, ProjMatrix, ViewPortArray, - @WinCoords[1][0], @WinCoords[1][1], @WinCoords[1][2]); - // project point (x1, y2) to window corrdinates - gluProject(0, cTestSize, 0, - ModelMatrix, ProjMatrix, ViewPortArray, - @WinCoords[2][0], @WinCoords[2][1], @WinCoords[2][2]); - - // 3. Lets see how much the width and height of the square changed. - // Calculate the width and height as displayed on the screen in window - // coordinates and calculate the ratio to the original coordinates in - // modelview space so the ratio gives us the scale (minification here). - - // projected width ||(x1, y1) - (x2, y1)|| - Dist := (WinCoords[0][0] - WinCoords[1][0]); - Dist2 := (WinCoords[0][1] - WinCoords[1][1]); - - WidthScale := 1; - if (Sqrt(Dist*Dist + Dist2*Dist2) <> 0) then - begin - WidthScale := cTestSize / Sqrt(Dist*Dist + Dist2*Dist2); - end; - - // projected height ||(x1, y1) - (x1, y2)|| - Dist := (WinCoords[0][0] - WinCoords[2][0]); - Dist2 := (WinCoords[0][1] - WinCoords[2][1]); - - HeightScale := 1; - if (Sqrt(Dist*Dist + Dist2*Dist2) <> 0) then - begin - HeightScale := cTestSize / Sqrt(Dist*Dist + Dist2*Dist2); - end; - - //writeln(Format('Scale %f, %f', [WidthScale, HeightScale])); - - // 4. Now that we have got the scale, take the bigger minification scale - // and get it to a logarithmic scale as each mipmap is 1/2 the size of its - // predecessor (Mipmap_size[i] = Mipmap_size[i-1]/2). - // The result is our mipmap-level = the index of the mipmap to use. - - // Level > 0: Minification; < 0: Magnification - Result := Trunc(Log2(Max(WidthScale, HeightScale)) + cBias); - - // clamp to valid range - if (Result < 0) then - Result := 0; - if (Result > High(fMipmapFonts)) then - Result := High(fMipmapFonts); -end; - -function TScalableFont.GetMipmapScale(Level: integer): single; -begin - if (fMipmapFonts[Level] = nil) then - begin - Result := -1; - Exit; - end; - - Result := fScale * fMipmapFonts[0].Height / fMipmapFonts[Level].Height; -end; - -{** - * Returns the correct mipmap font for the current scale and projection - * matrix. The modelview scale is adjusted to the mipmap level, so - * Result.Print() will display the font in the correct size. - *} -function TScalableFont.ChooseMipmapFont(): TFont; -var - DesiredLevel: integer; - Level: integer; - MipmapScale: single; -begin - Result := nil; - DesiredLevel := GetMipmapLevel(); - - // get the smallest mipmap available for the desired level - // as not all levels must be assigned to a font. - for Level := DesiredLevel downto 0 do - begin - if (fMipmapFonts[Level] <> nil) then - begin - Result := fMipmapFonts[Level]; - Break; - end; - end; - - // since the mipmap font (if level > 0) is smaller than the base-font - // we have to scale to get its size right. - MipmapScale := fMipmapFonts[0].Height/Result.Height; - glScalef(MipmapScale, MipmapScale, 0); -end; - -procedure TScalableFont.Print(const Text: TUCS4StringArray); -begin - glPushMatrix(); - - // set scale and stretching - glScalef(fScale * fAspect, fScale, 0); - - // print text - if (fUseMipmaps) then - ChooseMipmapFont().Print(Text) - else - fBaseFont.Print(Text); - - glPopMatrix(); -end; - -procedure TScalableFont.Render(const Text: UCS4String); -begin - Assert(false, 'Unused TScalableFont.Render() was called'); -end; - -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.Top := Result.Top * fScale; - Result.Bottom := Result.Bottom * fScale; -end; - -procedure TScalableFont.SetHeight(Height: single); -begin - fScale := Height / fBaseFont.GetHeight(); -end; - -function TScalableFont.GetHeight(): single; -begin - Result := fBaseFont.GetHeight() * fScale; -end; - -procedure TScalableFont.SetAspect(Aspect: single); -begin - fAspect := Aspect; -end; - -function TScalableFont.GetAspect(): single; -begin - Result := fAspect; -end; - -function TScalableFont.GetAscender(): single; -begin - Result := fBaseFont.GetAscender() * fScale; -end; - -function TScalableFont.GetDescender(): single; -begin - Result := fBaseFont.GetDescender() * fScale; -end; - -procedure TScalableFont.SetLineSpacing(Spacing: single); -var - Level: integer; -begin - for Level := 0 to High(fMipmapFonts) do - if (fMipmapFonts[Level] <> nil) then - fMipmapFonts[Level].SetLineSpacing(Spacing / GetMipmapScale(Level)); -end; - -function TScalableFont.GetLineSpacing(): single; -begin - Result := fBaseFont.GetLineSpacing() * fScale; -end; - -procedure TScalableFont.SetGlyphSpacing(Spacing: single); -var - Level: integer; -begin - for Level := 0 to High(fMipmapFonts) do - if (fMipmapFonts[Level] <> nil) then - fMipmapFonts[Level].SetGlyphSpacing(Spacing / GetMipmapScale(Level)); -end; - -function TScalableFont.GetGlyphSpacing(): single; -begin - Result := fBaseFont.GetGlyphSpacing() * fScale; -end; - -procedure TScalableFont.SetReflectionSpacing(Spacing: single); -var - Level: integer; -begin - for Level := 0 to High(fMipmapFonts) do - if ((fMipmapFonts[Level] <> nil) AND (GetMipmapScale(Level) > 0)) then - fMipmapFonts[Level].SetReflectionSpacing(Spacing / GetMipmapScale(Level)); -end; - -function TScalableFont.GetReflectionSpacing(): single; -begin - Result := fBaseFont.GetLineSpacing() * fScale; -end; - -procedure TScalableFont.SetStyle(Style: TFontStyle); -var - Level: integer; -begin - for Level := 0 to High(fMipmapFonts) do - if (fMipmapFonts[Level] <> nil) then - fMipmapFonts[Level].SetStyle(Style); -end; - -function TScalableFont.GetStyle(): TFontStyle; -begin - Result := fBaseFont.GetStyle(); -end; - -function TScalableFont.GetUnderlinePosition(): single; -begin - Result := fBaseFont.GetUnderlinePosition(); -end; - -function TScalableFont.GetUnderlineThickness(): single; -begin - Result := fBaseFont.GetUnderlinePosition(); -end; - -procedure TScalableFont.SetUseKerning(Enable: boolean); -var - Level: integer; -begin - for Level := 0 to High(fMipmapFonts) do - if (fMipmapFonts[Level] <> nil) then - fMipmapFonts[Level].SetUseKerning(Enable); -end; - - -{* - * TCachedFont - *} - -constructor TCachedFont.Create(); -begin - inherited; - fCache := TGlyphCache.Create(); -end; - -destructor TCachedFont.Destroy(); -begin - fCache.Free; - inherited; -end; - -function TCachedFont.GetGlyph(ch: UCS4Char): TGlyph; -begin - Result := fCache.GetGlyph(ch); - if (Result = nil) then - begin - Result := LoadGlyph(ch); - if (not fCache.AddGlyph(ch, Result)) then - Result.Free; - end; -end; - -procedure TCachedFont.FlushCache(KeepBaseSet: boolean); -begin - fCache.FlushCache(KeepBaseSet); -end; - - -{* - * TFTFont - *} - -constructor TFTFont.Create( - const Filename: IPath; - Size: integer; Outset: single; - LoadFlags: FT_Int32); -var - ch: UCS4Char; -begin - inherited Create(); - - fFilename := Filename; - fSize := Size; - fOutset := Outset; - fLoadFlags := LoadFlags; - fUseDisplayLists := true; - fPart := fpNone; - - // load font information - if (FT_New_Face(TFreeType.GetLibrary(), PChar(Filename.ToNative), 0, fFace) <> 0) then - raise Exception.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'); - - if (FT_Set_Pixel_Sizes(fFace, 0, Size) <> 0) then - raise Exception.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; - - ResetIntern(); - - // pre-cache some commonly used glyphs (' ' - '~') - for ch := 32 to 126 do - fCache.AddGlyph(ch, TFTGlyph.Create(Self, ch, Outset, LoadFlags)); -end; - -destructor TFTFont.Destroy(); -begin - // free face - FT_Done_Face(fFace); - inherited; -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; -end; - -procedure TFTFont.Reset(); -begin - inherited; - ResetIntern(); -end; - -function TFTFont.LoadGlyph(ch: UCS4Char): TGlyph; -begin - Result := TFTGlyph.Create(Self, ch, Outset, fLoadFlags); -end; - -function TFTFont.BBox(const Text: TUCS4StringArray; Advance: boolean): TBoundsDbl; -var - Glyph, PrevGlyph: TFTGlyph; - TextLine: UCS4String; - LineYOffset: single; - LineIndex, CharIndex: integer; - LineBounds: TBoundsDbl; - KernDelta: FT_Vector; - UnderlinePos: double; -begin - // Reset global bounds - Result.Left := Infinity; - Result.Right := 0; - Result.Bottom := Infinity; - Result.Top := 0; - - // reset last glyph - PrevGlyph := nil; - - // display text - for LineIndex := 0 to High(Text) do - begin - // get next text line - TextLine := Text[LineIndex]; - LineYOffset := -LineSpacing * LineIndex; - - // reset line bounds - LineBounds.Left := Infinity; - LineBounds.Right := 0; - LineBounds.Bottom := Infinity; - LineBounds.Top := 0; - - // for each glyph image, compute its bounding box - 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 - begin - FT_Get_Kerning(fFace, PrevGlyph.CharIndex, Glyph.CharIndex, - FT_KERNING_UNSCALED, KernDelta); - LineBounds.Right := LineBounds.Right + KernDelta.x * fFontUnitScale.X; - end; - - // update left bound (must be done before right bound is updated) - if (LineBounds.Right + Glyph.Bounds.Left < LineBounds.Left) then - LineBounds.Left := LineBounds.Right + Glyph.Bounds.Left; - - // update right bound - 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 - end - else - begin - // add glyph's right bound - LineBounds.Right := LineBounds.Right + Glyph.Bounds.Right; - end; - - // update bottom and top bounds - if (Glyph.Bounds.Bottom < LineBounds.Bottom) then - LineBounds.Bottom := Glyph.Bounds.Bottom; - if (Glyph.Bounds.Top > LineBounds.Top) then - LineBounds.Top := Glyph.Bounds.Top; - end; - - PrevGlyph := Glyph; - end; - - // handle italic font style - if (Italic in Style) then - begin - LineBounds.Left := LineBounds.Left + LineBounds.Bottom * cShearFactor; - LineBounds.Right := LineBounds.Right + LineBounds.Top * cShearFactor; - end; - - // handle underlined font style - if (Underline in Style) then - begin - UnderlinePos := GetUnderlinePosition(); - if (UnderlinePos < LineBounds.Bottom) then - LineBounds.Bottom := UnderlinePos; - end; - - // add line offset - LineBounds.Bottom := LineBounds.Bottom + LineYOffset; - LineBounds.Top := LineBounds.Top + LineYOffset; - - // adjust global bounds - if (Result.Left > LineBounds.Left) then - Result.Left := LineBounds.Left; - if (Result.Right < LineBounds.Right) then - Result.Right := LineBounds.Right; - if (Result.Bottom > LineBounds.Bottom) then - Result.Bottom := LineBounds.Bottom; - if (Result.Top < LineBounds.Top) then - Result.Top := LineBounds.Top; - end; - - // if left or bottom bound was not set, set them to 0 - if (IsInfinite(Result.Left)) then - Result.Left := 0.0; - if (IsInfinite(Result.Bottom)) then - Result.Bottom := 0.0; -end; - -procedure TFTFont.Render(const Text: UCS4String); -var - CharIndex: integer; - Glyph, PrevGlyph: TFTGlyph; - KernDelta: FT_Vector; -begin - // reset last glyph - PrevGlyph := nil; - - // draw current line - 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 - begin - FT_Get_Kerning(fFace, PrevGlyph.CharIndex, Glyph.CharIndex, - FT_KERNING_UNSCALED, KernDelta); - glTranslatef(KernDelta.x * fFontUnitScale.X, 0, 0); - end; - - if (ReflectionPass) then - Glyph.RenderReflection() - else - Glyph.Render(fUseDisplayLists); - - glTranslatef(Glyph.Advance.x + fGlyphSpacing, 0, 0); - end; - - PrevGlyph := Glyph; - end; -end; - -function TFTFont.GetHeight(): single; -begin - Result := Ascender - Descender; -end; - -function TFTFont.GetAscender(): single; -begin - Result := fFace.ascender * fFontUnitScale.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; -end; - -function TFTFont.GetUnderlinePosition(): single; -begin - Result := fFace.underline_position * fFontUnitScale.Y - Outset; -end; - -function TFTFont.GetUnderlineThickness(): single; -begin - Result := fFace.underline_thickness * fFontUnitScale.Y + Outset*2; -end; - - -{* - * TFTScalableFont - *} - -constructor TFTScalableFont.Create(const Filename: IPath; - Size: integer; OutsetAmount: single; - UseMipmaps: boolean); -var - LoadFlags: FT_Int32; -begin - LoadFlags := FT_LOAD_DEFAULT; - // Disable hinting and grid-fitting to preserve font outlines at each font - // size, otherwise the font widths/heights do not match resulting in ugly - // text size changes during zooming. - // A drawback is a reduced quality with smaller font sizes but it is not that - // bad with gray-scaled rendering (at least it looks better than OpenGL's - // linear downscaling on minification). - if (UseMipmaps) then - LoadFlags := LoadFlags or FT_LOAD_NO_HINTING; - inherited Create( - TFTFont.Create(Filename, Size, Size * OutsetAmount, LoadFlags), - UseMipmaps); -end; - -function TFTScalableFont.CreateMipmap(Level: integer; Scale: single): TFont; -var - ScaledSize: integer; - BaseFont: TFTFont; -begin - Result := nil; - BaseFont := TFTFont(fBaseFont); - ScaledSize := Round(BaseFont.Size * Scale); - // do not create mipmap fonts < 8 pixels - if (ScaledSize < 8) then - Exit; - Result := TFTFont.Create(BaseFont.fFilename, - ScaledSize, BaseFont.fOutset * Scale, - FT_LOAD_DEFAULT or FT_LOAD_NO_HINTING); -end; - -function TFTScalableFont.GetOutset(): single; -begin - Result := TFTFont(fBaseFont).Outset * fScale; -end; - -procedure TFTScalableFont.FlushCache(KeepBaseSet: boolean); -var - Level: integer; -begin - for Level := 0 to High(fMipmapFonts) do - if (fMipmapFonts[Level] <> nil) then - TFTFont(fMipmapFonts[Level]).FlushCache(KeepBaseSet); -end; - - -{* - * TOutlineFont - *} - -constructor TFTOutlineFont.Create( - const Filename: IPath; - Size: integer; Outset: single; - LoadFlags: FT_Int32); -begin - inherited Create(); - - fFilename := Filename; - fSize := Size; - fOutset := Outset; - - fInnerFont := TFTFont.Create(Filename, Size, 0.0, LoadFlags); - fInnerFont.fPart := fpInner; - fOutlineFont := TFTFont.Create(Filename, Size, Outset, LoadFlags); - fOutlineFont.fPart := fpOutline; - - ResetIntern(); -end; - -destructor TFTOutlineFont.Destroy; -begin - fOutlineFont.Free; - fInnerFont.Free; - inherited; -end; - -procedure TFTOutlineFont.ResetIntern(); -begin - // TODO: maybe swap fInnerFont/fOutlineFont.GlyphSpacing to use the spacing - // of the outline font? - //fInnerFont.GlyphSpacing := fOutset*2; - fOutlineFont.GlyphSpacing := -fOutset*2; - - fLineSpacing := fOutlineFont.LineSpacing; - fReflectionSpacing := fOutlineFont.ReflectionSpacing; - fOutlineColor := NewGLColor(0, 0, 0, -1); -end; - -procedure TFTOutlineFont.Reset(); -begin - inherited; - fInnerFont.Reset(); - fOutlineFont.Reset(); - ResetIntern(); -end; - -procedure TFTOutlineFont.DrawUnderline(const Text: UCS4String); -var - CurrentColor: TGLColor; - OutlineColor: TGLColor; -begin - // save current color - glGetFloatv(GL_CURRENT_COLOR, @CurrentColor.vals); - - // if the outline's alpha component is < 0 use the current alpha - OutlineColor := fOutlineColor; - if (OutlineColor.a < 0) then - OutlineColor.a := CurrentColor.a; - - // draw underline outline (in outline color) - glColor4fv(@OutlineColor.vals); - fOutlineFont.DrawUnderline(Text); - glColor4fv(@CurrentColor.vals); - - // draw underline inner part (in current color) - glPushMatrix(); - glTranslatef(fOutset, 0, 0); - fInnerFont.DrawUnderline(Text); - glPopMatrix(); -end; - -procedure TFTOutlineFont.Render(const Text: UCS4String); -var - CurrentColor: TGLColor; - OutlineColor: TGLColor; -begin - // save current color - glGetFloatv(GL_CURRENT_COLOR, @CurrentColor.vals); - - // if the outline's alpha component is < 0 use the current alpha - OutlineColor := fOutlineColor; - if (OutlineColor.a < 0) then - OutlineColor.a := CurrentColor.a; - - { setup and render outline font } - - glColor4fv(@OutlineColor.vals); - glPushMatrix(); - fOutlineFont.Render(Text); - glPopMatrix(); - glColor4fv(@CurrentColor.vals); - - { setup and render inner font } - - glPushMatrix(); - glTranslatef(fOutset, fOutset, 0); - fInnerFont.Render(Text); - glPopMatrix(); -end; - -procedure TFTOutlineFont.SetOutlineColor(r, g, b: GLfloat; a: GLfloat); -begin - fOutlineColor := NewGLColor(r, g, b, a); -end; - -procedure TFTOutlineFont.FlushCache(KeepBaseSet: boolean); -begin - fOutlineFont.FlushCache(KeepBaseSet); - fInnerFont.FlushCache(KeepBaseSet); -end; - -function TFTOutlineFont.BBox(const Text: TUCS4StringArray; Advance: boolean): TBoundsDbl; -begin - Result := fOutlineFont.BBox(Text, Advance); -end; - -function TFTOutlineFont.GetHeight(): single; -begin - Result := fOutlineFont.Height; -end; - -function TFTOutlineFont.GetAscender(): single; -begin - Result := fOutlineFont.Ascender; -end; - -function TFTOutlineFont.GetDescender(): single; -begin - Result := fOutlineFont.Descender; -end; - -procedure TFTOutlineFont.SetLineSpacing(Spacing: single); -begin - inherited SetLineSpacing(Spacing); - fInnerFont.LineSpacing := Spacing; - fOutlineFont.LineSpacing := Spacing; -end; - -procedure TFTOutlineFont.SetGlyphSpacing(Spacing: single); -begin - inherited SetGlyphSpacing(Spacing); - fInnerFont.GlyphSpacing := Spacing; - fOutlineFont.GlyphSpacing := Spacing - Outset*2; -end; - -procedure TFTOutlineFont.SetReflectionSpacing(Spacing: single); -begin - inherited SetReflectionSpacing(Spacing); - fInnerFont.ReflectionSpacing := Spacing; - fOutlineFont.ReflectionSpacing := Spacing; -end; - -procedure TFTOutlineFont.SetStyle(Style: TFontStyle); -begin - inherited SetStyle(Style); - fInnerFont.Style := Style; - fOutlineFont.Style := Style; -end; - -function TFTOutlineFont.GetStyle(): TFontStyle; -begin - Result := inherited GetStyle(); -end; - -function TFTOutlineFont.GetUnderlinePosition(): single; -begin - Result := fOutlineFont.GetUnderlinePosition(); -end; - -function TFTOutlineFont.GetUnderlineThickness(): single; -begin - Result := fOutlineFont.GetUnderlinePosition(); -end; - -procedure TFTOutlineFont.SetUseKerning(Enable: boolean); -begin - inherited SetUseKerning(Enable); - fInnerFont.fUseKerning := Enable; - fOutlineFont.fUseKerning := Enable; -end; - -procedure TFTOutlineFont.SetReflectionPass(Enable: boolean); -begin - inherited SetReflectionPass(Enable); - fInnerFont.fReflectionPass := Enable; - fOutlineFont.fReflectionPass := Enable; -end; - -{** - * TScalableOutlineFont - *} - -constructor TFTScalableOutlineFont.Create( - const Filename: IPath; - Size: integer; OutsetAmount: single; - UseMipmaps: boolean); -var - LoadFlags: FT_Int32; -begin - LoadFlags := FT_LOAD_DEFAULT; - // Disable hinting and grid-fitting (see TFTScalableFont.Create) - if (UseMipmaps) then - LoadFlags := LoadFlags or FT_LOAD_NO_HINTING; - inherited Create( - TFTOutlineFont.Create(Filename, Size, Size*OutsetAmount, LoadFlags), - UseMipmaps); -end; - -function TFTScalableOutlineFont.CreateMipmap(Level: integer; Scale: single): TFont; -var - ScaledSize: integer; - BaseFont: TFTOutlineFont; -begin - Result := nil; - BaseFont := TFTOutlineFont(fBaseFont); - ScaledSize := Round(BaseFont.Size*Scale); - // do not create mipmap fonts < 8 pixels - if (ScaledSize < 8) then - Exit; - Result := TFTOutlineFont.Create(BaseFont.fFilename, - ScaledSize, BaseFont.fOutset*Scale, - FT_LOAD_DEFAULT or FT_LOAD_NO_HINTING); -end; - -function TFTScalableOutlineFont.GetOutset(): single; -begin - Result := TFTOutlineFont(fBaseFont).Outset * fScale; -end; - -procedure TFTScalableOutlineFont.SetOutlineColor(r, g, b: GLfloat; a: GLfloat); -var - Level: integer; -begin - for Level := 0 to High(fMipmapFonts) do - if (fMipmapFonts[Level] <> nil) then - TFTOutlineFont(fMipmapFonts[Level]).SetOutlineColor(r, g, b, a); -end; - -procedure TFTScalableOutlineFont.FlushCache(KeepBaseSet: boolean); -var - Level: integer; -begin - for Level := 0 to High(fMipmapFonts) do - if (fMipmapFonts[Level] <> nil) then - TFTOutlineFont(fMipmapFonts[Level]).FlushCache(KeepBaseSet); -end; - - -{* - * TFTGlyph - *} - -const - {** - * Size of the transparent border surrounding the glyph image in the texture. - * The border is necessary because OpenGL does not smooth texels at the - * border of a texture with the GL_CLAMP or GL_CLAMP_TO_EDGE styles. - * Without the border, magnified glyph textures look very ugly at their edges. - * It looks edgy, as if some pixels are missing especially on the left edge - * (just set cTexSmoothBorder to 0 to see what is meant by this). - * With the border even the glyphs edges are blended to the border (transparent) - * color and everything looks nice. - * - * Note: - * OpenGL already supports texture border by setting the border parameter - * of glTexImage*D() to 1 and using a texture size of 2^m+2b and setting the - * border pixels to the border color. In some forums it is discouraged to use - * the border parameter as only a few of the more modern graphics cards support - * this feature. On an ATI Radeon 9700 card, the slowed down to 0.5 fps and - * the glyph's background got black. So instead of using this feature we - * handle it on our own. The only drawback is that textures might get bigger - * because the border might require a higher power of 2 size instead of just - * two additional pixels. - *} - cTexSmoothBorder = 1; - -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.fPart = fpInner); - - 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 Exception.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 Exception.Create('FT_Stroker_ParseOutline failed!'); - - FT_Stroker_GetBorderCounts(OuterStroker, OuterBorder, OuterNumPoints, OuterNumContours); - - { extrude inner border (= stencil) } - - if (UseStencil) then - begin - if (FT_Stroker_New(Glyph.library_, InnerStroker) <> 0) then - raise Exception.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 Exception.Create('FT_Stroker_ParseOutline failed!'); - - FT_Stroker_GetBorderCounts(InnerStroker, InnerBorder, InnerNumPoints, InnerNumContours); - end else begin - InnerNumPoints := 0; - InnerNumContours := 0; - end; - - { combine borders (subtract: OuterBorder - InnerBorder) } - - GlyphNumPoints := InnerNumPoints + OuterNumPoints; - GlyphNumContours := InnerNumContours + OuterNumContours; - - // save flags before deletion (TODO: set them on the resulting outline) - OutlineFlags := Outline.flags; - - // 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 Exception.Create('FT_Outline_New failed!'); - - Outline.n_points := 0; - Outline.n_contours := 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 Exception.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); -var - X, Y: integer; - Glyph: FT_Glyph; - BitmapGlyph: FT_BitmapGlyph; - Bitmap: PFT_Bitmap; - BitmapLine: PByteArray; - BitmapBuffer: PByteArray; - TexBuffer: TGLubyteDynArray; - TexLine: PGLubyteArray; - CBox: FT_BBox; -begin - // load the Glyph for our character - if (FT_Load_Glyph(fFont.Face, fCharIndex, LoadFlags) <> 0) then - raise Exception.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 (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; - - // get the contour's bounding box (in 1/64th pixels, not font-units) - FT_Glyph_Get_CBox(Glyph, FT_GLYPH_BBOX_UNSCALED, CBox); - // convert 1/64th values to double values - fBounds.Left := CBox.xMin / 64; - fBounds.Right := CBox.xMax / 64 + fOutset*2; - fBounds.Bottom := CBox.yMin / 64; - fBounds.Top := CBox.yMax / 64 + fOutset*2; - - // convert the glyph to a bitmap (and destroy original glyph image). - // Request 8 bit gray level pixel mode. - FT_Glyph_To_Bitmap(Glyph, FT_RENDER_MODE_NORMAL, nil, 1); - BitmapGlyph := FT_BitmapGlyph(Glyph); - - // get bitmap offsets - fBitmapCoords.Left := BitmapGlyph^.left - cTexSmoothBorder; - // Note: add 1*fOutset for lifting the baseline so outset fonts to not intersect - // with the baseline; Ceil(fOutset) for the outset pixels added to the bitmap. - fBitmapCoords.Top := BitmapGlyph^.top + fOutset+Ceil(fOutset) + cTexSmoothBorder; - - // make accessing the bitmap easier - Bitmap := @BitmapGlyph^.bitmap; - // get bitmap dimensions - fBitmapCoords.Width := Bitmap.width + (Ceil(fOutset) + cTexSmoothBorder)*2; - fBitmapCoords.Height := Bitmap.rows + (Ceil(fOutset) + cTexSmoothBorder)*2; - - // get power-of-2 bitmap widths - fTexSize.Width := - NextPowerOf2(Bitmap.width + (Ceil(fOutset) + cTexSmoothBorder)*2); - fTexSize.Height := - NextPowerOf2(Bitmap.rows + (Ceil(fOutset) + cTexSmoothBorder)*2); - - // texture-widths ignoring empty (power-of-2) padding space - fTexOffset.X := fBitmapCoords.Width / fTexSize.Width; - fTexOffset.Y := fBitmapCoords.Height / fTexSize.Height; - - // allocate memory for texture data - SetLength(TexBuffer, fTexSize.Width * fTexSize.Height); - FillChar(TexBuffer[0], Length(TexBuffer), 0); - - // Freetype stores the bitmap with either upper (pitch is > 0) or lower - // (pitch < 0) glyphs line first. Set the buffer to the upper line. - // See http://freetype.sourceforge.net/freetype2/docs/glyphs/glyphs-7.html - if (Bitmap.pitch > 0) then - BitmapBuffer := @Bitmap.buffer[0] - else - BitmapBuffer := @Bitmap.buffer[(Bitmap.rows-1) * Abs(Bitmap.pitch)]; - - // copy data to texture bitmap (upper line first). - for Y := 0 to Bitmap.rows-1 do - begin - // set pointer to first pixel in line that holds bitmap data. - // Each line starts with a cTexSmoothBorder pixel and multiple outset pixels - // that are added by Extrude() later. - TexLine := @TexBuffer[(Y + cTexSmoothBorder + Ceil(fOutset)) * fTexSize.Width + - cTexSmoothBorder + Ceil(fOutset)]; - // get next lower line offset, use pitch instead of width as it tells - // us the storage direction of the lines. In addition a line might be padded. - BitmapLine := @BitmapBuffer[Y * Bitmap.pitch]; - - // check for pixel mode and copy pixels - // Should be 8 bit gray, but even with FT_RENDER_MODE_NORMAL, freetype - // sometimes (e.g. 16px sized japanese fonts) fallbacks to 1 bit pixels. - case (Bitmap.pixel_mode) of - FT_PIXEL_MODE_GRAY: begin // 8 bit gray - for X := 0 to Bitmap.width-1 do - TexLine[X] := BitmapLine[X]; - end; - FT_PIXEL_MODE_MONO: begin // 1 bit mono - for X := 0 to Bitmap.width-1 do - TexLine[X] := High(GLubyte) * ((BitmapLine[X div 8] shr (7-(X mod 8))) and $1); - end; - else begin - // unhandled pixel format - end; - end; - end; - - // allocate resources for textures and display lists - glGenTextures(1, @fTexture); - - // setup texture parameters - glBindTexture(GL_TEXTURE_2D, fTexture); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); - - glPixelStorei(GL_UNPACK_ALIGNMENT, 1); - // create alpha-map (GL_ALPHA component only). - // TexCoord (0,0) corresponds to the top left pixel of the glyph, - // (1,1) to the bottom right pixel. So the glyph is flipped as OpenGL uses - // a cartesian (y-axis up) coordinate system for textures. - // See the cTexSmoothBorder comment for info on texture borders. - glTexImage2D(GL_TEXTURE_2D, 0, GL_ALPHA, fTexSize.Width, fTexSize.Height, - 0, GL_ALPHA, GL_UNSIGNED_BYTE, @TexBuffer[0]); - - // free expanded data - SetLength(TexBuffer, 0); - - // create the display list - fDisplayList := glGenLists(1); - - // render to display-list - glNewList(fDisplayList, GL_COMPILE); - Render(false); - glEndList(); - - // free glyph data (bitmap, etc.) - FT_Done_Glyph(Glyph); -end; - -constructor TFTGlyph.Create(Font: TFTFont; ch: UCS4Char; Outset: single; - LoadFlags: FT_Int32); -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)); - - CreateTexture(LoadFlags); -end; - -destructor TFTGlyph.Destroy; -begin - if (fDisplayList <> 0) then - glDeleteLists(fDisplayList, 1); - if (fTexture <> 0) then - glDeleteTextures(1, @fTexture); - inherited; -end; - -procedure TFTGlyph.Render(UseDisplayLists: boolean); -begin - // use display-lists if enabled and exit - if (UseDisplayLists) then - begin - glCallList(fDisplayList); - Exit; - end; - - glBindTexture(GL_TEXTURE_2D, fTexture); - glPushMatrix(); - - // move to top left glyph position - glTranslatef(fBitmapCoords.Left, fBitmapCoords.Top, 0); - - // draw glyph texture - glBegin(GL_QUADS); - // top right - glTexCoord2f(fTexOffset.X, 0); - glVertex2f(fBitmapCoords.Width, 0); - - // top left - glTexCoord2f(0, 0); - glVertex2f(0, 0); - - // bottom left - glTexCoord2f(0, fTexOffset.Y); - glVertex2f(0, -fBitmapCoords.Height); - - // bottom right - glTexCoord2f(fTexOffset.X, fTexOffset.Y); - glVertex2f(fBitmapCoords.Width, -fBitmapCoords.Height); - glEnd(); - - glPopMatrix(); -end; - -procedure TFTGlyph.RenderReflection(); -var - Color: TGLColor; - TexUpperPos: single; - TexLowerPos: single; - UpperPos: single; -const - CutOff = 0.6; -begin - glPushMatrix(); - glBindTexture(GL_TEXTURE_2D, fTexture); - glGetFloatv(GL_CURRENT_COLOR, @Color.vals); - - // add extra space to the left of the glyph - glTranslatef(fBitmapCoords.Left, 0, 0); - - // The upper position of the glyph, if CutOff is 1.0, it is fFont.Ascender. - // If CutOff is set to 0.5 only half of the glyph height is displayed. - UpperPos := fFont.Descender + fFont.Height * CutOff; - - // the glyph texture's height is just the height of the glyph but not the font - // height. Setting a color for the upper and lower bounds of the glyph results - // in different color gradients. So we have to set the color values for the - // descender and ascender (as we have a cutoff, for the upper-pos here) as - // these positions are font but not glyph specific. - - // To get the texture positions we have to enhance the texture at the top and - // bottom by the amount from the top to ascender (rather upper-pos here) and - // from the bottom (Height-Top) to descender. Then we have to convert those - // heights to texture coordinates by dividing by the bitmap Height and - // removing the power-of-2 padding space by multiplying with fTexOffset.Y - // (as fBitmapCoords.Height corresponds to fTexOffset.Y and not 1.0). - TexUpperPos := -(UpperPos - fBitmapCoords.Top) / fBitmapCoords.Height * fTexOffset.Y; - TexLowerPos := (-(fFont.Descender + fBitmapCoords.Height - fBitmapCoords.Top) / - fBitmapCoords.Height + 1) * fTexOffset.Y; - - // draw glyph texture - glBegin(GL_QUADS); - // top right - glColor4f(Color.r, Color.g, Color.b, 0); - glTexCoord2f(fTexOffset.X, TexUpperPos); - glVertex2f(fBitmapCoords.Width, UpperPos); - - // top left - glTexCoord2f(0, TexUpperPos); - glVertex2f(0, UpperPos); - - // bottom left - glColor4f(Color.r, Color.g, Color.b, Color.a-0.3); - glTexCoord2f(0, TexLowerPos); - glVertex2f(0, fFont.Descender); - - // bottom right - glTexCoord2f(fTexOffset.X, TexLowerPos); - glVertex2f(fBitmapCoords.Width, fFont.Descender); - glEnd(); - - glPopMatrix(); - - // restore old color - // Note: glPopAttrib(GL_CURRENT_BIT)/glPopAttrib() is much slower then - // glGetFloatv(GL_CURRENT_COLOR, ...)/glColor4fv(...) - glColor4fv(@Color.vals); -end; - -function TFTGlyph.GetAdvance(): TPositionDbl; -begin - Result := fAdvance; -end; - -function TFTGlyph.GetBounds(): TBoundsDbl; -begin - Result := fBounds; -end; - - -{* - * TGlyphCache - *} - -constructor TGlyphCache.Create(); -begin - inherited; - fHash := TList.Create(); -end; - -destructor TGlyphCache.Destroy(); -begin - // free cached glyphs - FlushCache(false); - - // destroy TList - fHash.Free; - - inherited; -end; - -function TGlyphCache.FindGlyphTable(BaseCode: cardinal; out InsertPos: integer): PGlyphTable; -var - I: integer; - Entry: TGlyphCacheHashEntry; -begin - Result := nil; - - for I := 0 to fHash.Count-1 do - begin - Entry := TGlyphCacheHashEntry(fHash[I]); - - if (Entry.BaseCode > BaseCode) then - begin - InsertPos := I; - Exit; - end; - - if (Entry.BaseCode = BaseCode) then - begin - InsertPos := I; - Result := @Entry.GlyphTable; - Exit; - end; - end; - - InsertPos := fHash.Count; -end; - -function TGlyphCache.AddGlyph(ch: UCS4Char; const Glyph: TGlyph): boolean; -var - BaseCode: cardinal; - GlyphCode: integer; - InsertPos: integer; - GlyphTable: PGlyphTable; - Entry: TGlyphCacheHashEntry; -begin - Result := false; - - BaseCode := Ord(ch) shr 8; - GlyphTable := FindGlyphTable(BaseCode, InsertPos); - if (GlyphTable = nil) then - begin - Entry := TGlyphCacheHashEntry.Create(BaseCode); - GlyphTable := @Entry.GlyphTable; - fHash.Insert(InsertPos, Entry); - end; - - // get glyph table offset - GlyphCode := Ord(ch) and $FF; - // insert glyph into table if not present - if (GlyphTable[GlyphCode] = nil) then - begin - GlyphTable[GlyphCode] := Glyph; - Result := true; - end; -end; - -procedure TGlyphCache.DeleteGlyph(ch: UCS4Char); -var - Table: PGlyphTable; - TableIndex, GlyphIndex: integer; - TableEmpty: boolean; -begin - // find table - Table := FindGlyphTable(Ord(ch) shr 8, TableIndex); - if (Table = nil) then - Exit; - - // find glyph - GlyphIndex := Ord(ch) and $FF; - if (Table[GlyphIndex] <> nil) then - begin - // destroy glyph - FreeAndNil(Table[GlyphIndex]); - - // check if table is empty - TableEmpty := true; - for GlyphIndex := 0 to High(Table^) do - begin - if (Table[GlyphIndex] <> nil) then - begin - TableEmpty := false; - Break; - end; - end; - - // free empty table - if (TableEmpty) then - begin - fHash.Delete(TableIndex); - end; - end; -end; - -function TGlyphCache.GetGlyph(ch: UCS4Char): TGlyph; -var - InsertPos: integer; - Table: PGlyphTable; -begin - Table := FindGlyphTable(Ord(ch) shr 8, InsertPos); - if (Table = nil) then - Result := nil - else - Result := Table[Ord(ch) and $FF]; -end; - -function TGlyphCache.HasGlyph(ch: UCS4Char): boolean; -begin - Result := (GetGlyph(ch) <> nil); -end; - -procedure TGlyphCache.FlushCache(KeepBaseSet: boolean); -var - EntryIndex, TableIndex: integer; - Entry: TGlyphCacheHashEntry; -begin - // destroy cached glyphs - for EntryIndex := 0 to fHash.Count-1 do - begin - Entry := TGlyphCacheHashEntry(fHash[EntryIndex]); - - // the base set (0-255) has BaseCode 0 as the upper bytes are 0. - if KeepBaseSet and (Entry.fBaseCode = 0) then - Continue; - - for TableIndex := 0 to High(Entry.GlyphTable) do - begin - if (Entry.GlyphTable[TableIndex] <> nil) then - FreeAndNil(Entry.GlyphTable[TableIndex]); - end; - FreeAndNil(Entry); - end; -end; - - -{* - * TGlyphCacheEntry - *} - -constructor TGlyphCacheHashEntry.Create(BaseCode: cardinal); -begin - inherited Create(); - fBaseCode := BaseCode; -end; - - -{* - * TFreeType - *} - -class function TFreeType.GetLibrary(): FT_Library; -begin - if (LibraryInst = nil) then - begin - // initialize freetype - if (FT_Init_FreeType(LibraryInst) <> 0) then - raise Exception.Create('FT_Init_FreeType failed'); - end; - Result := LibraryInst; -end; - -class procedure TFreeType.FreeLibrary(); -begin - if (LibraryInst <> nil) then - FT_Done_FreeType(LibraryInst); - LibraryInst := nil; -end; - - -{$IFDEF BITMAP_FONT} -{* - * TBitmapFont - *} - -constructor TBitmapFont.Create(const Filename: IPath; Outline: integer; - Baseline, Ascender, Descender: integer); -begin - inherited Create(); - - fTex := Texture.LoadTexture(true, Filename, TEXTURE_TYPE_TRANSPARENT, 0); - fTexSize := 1024; - fOutline := Outline; - fBaseline := Baseline; - fAscender := Ascender; - fDescender := Descender; - - LoadFontInfo(Filename.SetExtension('.dat')); - - ResetIntern(); -end; - -destructor TBitmapFont.Destroy(); -begin - glDeleteTextures(1, @fTex.TexNum); - inherited; -end; - -procedure TBitmapFont.ResetIntern(); -begin - fLineSpacing := Height; -end; - -procedure TBitmapFont.Reset(); -begin - inherited; - ResetIntern(); -end; - -procedure TBitmapFont.CorrectWidths(WidthMult: real; WidthAdd: integer); -var - Count: integer; -begin - for Count := 0 to 255 do - fWidths[Count] := Round(fWidths[Count] * WidthMult) + WidthAdd; -end; - -procedure TBitmapFont.LoadFontInfo(const InfoFile: IPath); -var - Stream: TStream; -begin - FillChar(fWidths[0], Length(fWidths), 0); - - Stream := nil; - try - Stream := TBinaryFileStream.Create(InfoFile, fmOpenRead); - Stream.Read(fWidths, 256); - except - raise Exception.Create('Could not read font info file ''' + InfoFile.ToNative + ''''); - end; - Stream.Free; -end; - -function TBitmapFont.BBox(const Text: TUCS4StringArray; Advance: boolean): TBoundsDbl; -var - LineIndex, CharIndex: integer; - CharCode: cardinal; - Line: UCS4String; - LineWidth: double; -begin - Result.Left := 0; - Result.Right := 0; - Result.Top := Height; - Result.Bottom := 0; - - for LineIndex := 0 to High(Text) do - begin - Line := Text[LineIndex]; - LineWidth := 0; - for CharIndex := 0 to LengthUCS4(Line)-1 do - begin - CharCode := Ord(Line[CharIndex]); - if (CharCode < Length(fWidths)) then - LineWidth := LineWidth + fWidths[CharCode]; - end; - if (LineWidth > Result.Right) then - Result.Right := LineWidth; - end; -end; - -procedure TBitmapFont.RenderChar(ch: UCS4Char; var AdvanceX: real); -var - TexX, TexY: real; - TexR, TexB: real; - GlyphWidth: real; - PL, PT: real; - PR, PB: real; - CharCode: cardinal; -begin - CharCode := Ord(ch); - if (CharCode > High(fWidths)) then - CharCode := 0; - - GlyphWidth := fWidths[CharCode]; - - // set texture positions - TexX := (CharCode mod 16) * 1/16 + 1/32 - (GlyphWidth/2 - fOutline)/fTexSize; - TexY := (CharCode div 16) * 1/16 + {2 texels} 2/fTexSize; - TexR := (CharCode mod 16) * 1/16 + 1/32 + (GlyphWidth/2 + fOutline)/fTexSize; - TexB := (1 + CharCode div 16) * 1/16 - {2 texels} 2/fTexSize; - - // set vector positions - PL := AdvanceX - fOutline; - PR := PL + GlyphWidth + fOutline*2; - PB := -fBaseline; - PT := PB + fTexSize div 16; - - (* - if (Font.Blend) then - begin - glEnable(GL_BLEND); - glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); - end; - *) - - glEnable(GL_TEXTURE_2D); - glBindTexture(GL_TEXTURE_2D, fTex.TexNum); - - if (not ReflectionPass) then - begin - glBegin(GL_QUADS); - glTexCoord2f(TexX, TexY); glVertex2f(PL, PT); - glTexCoord2f(TexX, TexB); glVertex2f(PL, PB); - glTexCoord2f(TexR, TexB); glVertex2f(PR, PB); - glTexCoord2f(TexR, TexY); glVertex2f(PR, PT); - glEnd; - end - else - begin - glDepthRange(0, 10); - glDepthFunc(GL_LEQUAL); - glEnable(GL_DEPTH_TEST); - - glBegin(GL_QUADS); - glTexCoord2f(TexX, TexY); glVertex2f(PL, PT); - glTexCoord2f(TexX, TexB); glVertex2f(PL, PB); - glTexCoord2f(TexR, TexB); glVertex2f(PR, PB); - glTexCoord2f(TexR, TexY); glVertex2f(PR, PT); - glEnd; - - glBegin(GL_QUADS); - glTexCoord2f(TexX, TexY); glVertex2f(PL, PT); - glTexCoord2f(TexX, TexB); glVertex2f(PL, PB); - glTexCoord2f(TexR, TexB); glVertex2f(PR, PB); - glTexCoord2f(TexR, TexY); glVertex2f(PR, PT); - -(* - glColor4f(fTempColor.r, fTempColor.g, fTempColor.b, 0.7); - glTexCoord2f(TexX, TexB); glVertex3f(PL, PB, 0); - glTexCoord2f(TexR, TexB); glVertex3f(PR, PB, 0); - - glColor4f(fTempColor.r, fTempColor.g, fTempColor.b, 0); - glTexCoord2f(TexR, (TexY + TexB)/2); glVertex3f(PR, (PT + PB)/2, 0); - glTexCoord2f(TexX, (TexY + TexB)/2); glVertex3f(PL, (PT + PB)/2, 0); -*) - glEnd; - - //write the colour back - glColor4fv(@fTempColor); - - glDisable(GL_DEPTH_TEST); - end; // reflection - - glDisable(GL_TEXTURE_2D); - (* - if (Font.Blend) then - glDisable(GL_BLEND); - *) - - AdvanceX := AdvanceX + GlyphWidth; -end; - -procedure TBitmapFont.Render(const Text: UCS4String); -var - CharIndex: integer; - AdvanceX: real; -begin - // if there is no text do nothing - 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 := 0 to LengthUCS4(Text)-1 do - begin - RenderChar(Text[CharIndex], AdvanceX); - end; -end; - -function TBitmapFont.GetHeight(): single; -begin - Result := fAscender - fDescender; -end; - -function TBitmapFont.GetAscender(): single; -begin - Result := fAscender; -end; - -function TBitmapFont.GetDescender(): single; -begin - Result := fDescender; -end; - -function TBitmapFont.GetUnderlinePosition(): single; -begin - Result := -2.0; -end; - -function TBitmapFont.GetUnderlineThickness(): single; -begin - Result := 1.0; -end; - -{$ENDIF BITMAP_FONT} - - -initialization - -finalization - TFreeType.FreeLibrary(); - -end. diff --git a/src/base/UGraphic.pas b/src/base/UGraphic.pas deleted file mode 100644 index b0e5a7d8..00000000 --- a/src/base/UGraphic.pas +++ /dev/null @@ -1,823 +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 UGraphic; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses - SDL, - gl, - glext, - UTexture, - TextGL, - ULog, - SysUtils, - ULyrics, - UImage, - UMusic, - UScreenLoading, - UScreenWelcome, - UScreenMain, - UScreenName, - UScreenLevel, - UScreenOptions, - UScreenOptionsGame, - UScreenOptionsGraphics, - UScreenOptionsSound, - UScreenOptionsLyrics, - UScreenOptionsThemes, - UScreenOptionsRecord, - UScreenOptionsAdvanced, - UScreenSong, - UScreenSing, - UScreenScore, - UScreenTop5, - UScreenEditSub, - UScreenEdit, - UScreenEditConvert, - UScreenEditHeader, - UScreenOpen, - UThemes, - USkins, - UScreenSongMenu, - UScreenSongJumpto, - {Party Screens} - UScreenSingModi, - UScreenPartyNewRound, - UScreenPartyScore, - UScreenPartyOptions, - UScreenPartyWin, - UScreenPartyPlayer, - {Stats Screens} - UScreenStatMain, - UScreenStatDetail, - {CreditsScreen} - UScreenCredits, - {Popup for errors, etc.} - UScreenPopup; - -type - TRecR = record - Top: real; - Left: real; - Right: real; - Bottom: real; - end; - -var - Screen: PSDL_Surface; - LoadingThread: PSDL_Thread; - Mutex: PSDL_Mutex; - - RenderW: integer; - RenderH: integer; - ScreenW: integer; - ScreenH: integer; - Screens: integer; - ScreenAct: integer; - ScreenX: integer; - - ScreenLoading: TScreenLoading; - ScreenWelcome: TScreenWelcome; - ScreenMain: TScreenMain; - ScreenName: TScreenName; - ScreenLevel: TScreenLevel; - ScreenSong: TScreenSong; - ScreenSing: TScreenSing; - ScreenScore: TScreenScore; - ScreenTop5: TScreenTop5; - ScreenOptions: TScreenOptions; - ScreenOptionsGame: TScreenOptionsGame; - ScreenOptionsGraphics: TScreenOptionsGraphics; - ScreenOptionsSound: TScreenOptionsSound; - ScreenOptionsLyrics: TScreenOptionsLyrics; - ScreenOptionsThemes: TScreenOptionsThemes; - ScreenOptionsRecord: TScreenOptionsRecord; - ScreenOptionsAdvanced: TScreenOptionsAdvanced; - ScreenEditSub: TScreenEditSub; - ScreenEdit: TScreenEdit; - ScreenEditConvert: TScreenEditConvert; - ScreenEditHeader: TScreenEditHeader; - ScreenOpen: TScreenOpen; - - ScreenSongMenu: TScreenSongMenu; - ScreenSongJumpto: TScreenSongJumpto; - - //Party Screens - ScreenSingModi: TScreenSingModi; - ScreenPartyNewRound: TScreenPartyNewRound; - ScreenPartyScore: TScreenPartyScore; - ScreenPartyWin: TScreenPartyWin; - ScreenPartyOptions: TScreenPartyOptions; - ScreenPartyPlayer: TScreenPartyPlayer; - - //StatsScreens - ScreenStatMain: TScreenStatMain; - ScreenStatDetail: TScreenStatDetail; - - //CreditsScreen - ScreenCredits: TScreenCredits; - - //popup mod - ScreenPopupCheck: TScreenPopupCheck; - ScreenPopupError: TScreenPopupError; - ScreenPopupInfo: TScreenPopupInfo; - - //Notes - 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 - Tex_plain_Right: array[1..6] of TTexture; //rename to tex_notebg_right - - Tex_BG_Left: array[1..6] of TTexture; //rename to tex_noteglow_left - Tex_BG_Mid: array[1..6] of TTexture; //rename to tex_noteglow_mid - Tex_BG_Right: array[1..6] of TTexture; //rename to tex_noteglow_right - - Tex_Note_Star: TTexture; - Tex_Note_Perfect_Star: TTexture; - - - Tex_Ball: TTexture; - Tex_Lyric_Help_Bar: TTexture; - FullScreen: boolean; - - Tex_TimeProgress: TTexture; - - //Sing Bar Mod - Tex_SingBar_Back: TTexture; - Tex_SingBar_Bar: TTexture; - Tex_SingBar_Front: TTexture; - //end Singbar Mod - - //PhrasenBonus - Line Bonus Mod - Tex_SingLineBonusBack: array[0..8] of TTexture; - //End PhrasenBonus - Line Bonus Mod - - //ScoreBG Texs - Tex_ScoreBG: array [0..5] of TTexture; - - //Score Screen Textures - Tex_Score_NoteBarLevel_Dark : array [1..6] of TTexture; - Tex_Score_NoteBarRound_Dark : array [1..6] of TTexture; - - Tex_Score_NoteBarLevel_Light : array [1..6] of TTexture; - Tex_Score_NoteBarRound_Light : array [1..6] of TTexture; - - Tex_Score_NoteBarLevel_Lightest : array [1..6] of TTexture; - Tex_Score_NoteBarRound_Lightest : array [1..6] of TTexture; - - Tex_Score_Ratings : array [0..7] of TTexture; - - // arrows for SelectSlide - Tex_SelectS_ArrowL: TTexture; - Tex_SelectS_ArrowR: TTexture; - - // textures for software mouse cursor - Tex_Cursor_Unpressed: TTexture; - Tex_Cursor_Pressed: TTexture; -const - Skin_BGColorR = 1; - Skin_BGColorG = 1; - Skin_BGColorB = 1; - - Skin_SpectrumR = 0; - Skin_SpectrumG = 0; - Skin_SpectrumB = 0; - - Skin_Spectograph1R = 0.6; - Skin_Spectograph1G = 0.8; - Skin_Spectograph1B = 1; - - Skin_Spectograph2R = 0; - Skin_Spectograph2G = 0; - Skin_Spectograph2B = 0.2; - - Skin_FontR = 0; - Skin_FontG = 0; - Skin_FontB = 0; - - Skin_FontHighlightR = 0.3; // 0.3 - Skin_FontHighlightG = 0.3; // 0.3 - Skin_FontHighlightB = 1; // 1 - - Skin_TimeR = 0.25; //0,0,0 - Skin_TimeG = 0.25; - Skin_TimeB = 0.25; - - Skin_OscR = 0; - Skin_OscG = 0; - Skin_OscB = 0; - - Skin_SpectrumT = 470; - Skin_SpectrumBot = 570; - Skin_SpectrumH = 100; - - Skin_P1_LinesR = 0.5; // 0.6 0.6 1 - Skin_P1_LinesG = 0.5; - Skin_P1_LinesB = 0.5; - - Skin_P2_LinesR = 0.5; // 1 0.6 0.6 - Skin_P2_LinesG = 0.5; - Skin_P2_LinesB = 0.5; - - Skin_P1_NotesB = 250; - Skin_P2_NotesB = 430; // 430 / 300 - - Skin_P1_ScoreT = 50; - Skin_P1_ScoreL = 20; - - Skin_P2_ScoreT = 50; - Skin_P2_ScoreL = 640; - -procedure Initialize3D (Title: string); -procedure Reinitialize3D; -procedure SwapBuffers; - -procedure LoadTextures; -procedure InitializeScreen; -procedure LoadLoadingScreen; -procedure LoadScreens; -procedure UnLoadScreens; - -function LoadingThreadFunction: integer; - - -implementation - -uses - Classes, - UMain, - UIni, - UDisplay, - UCommandLine, - UPathUtils; - -procedure LoadFontTextures; -begin - Log.LogStatus('Building Fonts', 'LoadTextures'); - BuildFont; -end; - -procedure LoadTextures; - -var - P: integer; - R, G, B: real; - Col: integer; -begin - Log.LogStatus('Loading Textures', 'LoadTextures'); - - // P1-6 - // TODO... do it once for each player... this is a bit crappy !! - // can we make it any better !? - for P := 1 to 6 do - begin - LoadColor(R, G, B, 'P' + IntToStr(P) + 'Light'); - Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255); - - { 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); - - Tex_plain_Left[P] := Texture.LoadTexture(Skin.GetTextureFileName('NotePlainLeft'), TEXTURE_TYPE_COLORIZED, Col); - Tex_plain_Mid[P] := Texture.LoadTexture(Skin.GetTextureFileName('NotePlainMid'), TEXTURE_TYPE_COLORIZED, Col); - Tex_plain_Right[P] := Texture.LoadTexture(Skin.GetTextureFileName('NotePlainRight'), TEXTURE_TYPE_COLORIZED, Col); - - Tex_BG_Left[P] := Texture.LoadTexture(Skin.GetTextureFileName('NoteBGLeft'), TEXTURE_TYPE_COLORIZED, Col); - Tex_BG_Mid[P] := Texture.LoadTexture(Skin.GetTextureFileName('NoteBGMid'), TEXTURE_TYPE_COLORIZED, Col); - Tex_BG_Right[P] := Texture.LoadTexture(Skin.GetTextureFileName('NoteBGRight'), TEXTURE_TYPE_COLORIZED, Col); - end; - - Log.LogStatus('Loading Textures - B', 'LoadTextures'); - - Tex_Note_Perfect_Star := Texture.LoadTexture(Skin.GetTextureFileName('NotePerfectStar'), TEXTURE_TYPE_TRANSPARENT, 0); - Tex_Note_Star := Texture.LoadTexture(Skin.GetTextureFileName('NoteStar') , TEXTURE_TYPE_TRANSPARENT, $FFFFFF); - Tex_Ball := Texture.LoadTexture(Skin.GetTextureFileName('Ball'), TEXTURE_TYPE_TRANSPARENT, $FF00FF); - Tex_Lyric_Help_Bar := Texture.LoadTexture(Skin.GetTextureFileName('LyricHelpBar'), TEXTURE_TYPE_TRANSPARENT, $FF00FF); - - Tex_SelectS_ArrowL := Texture.LoadTexture(Skin.GetTextureFileName('Select_ArrowLeft'), TEXTURE_TYPE_TRANSPARENT, 0); - Tex_SelectS_ArrowR := Texture.LoadTexture(Skin.GetTextureFileName('Select_ArrowRight'), TEXTURE_TYPE_TRANSPARENT, 0); - - Tex_Cursor_Unpressed := Texture.LoadTexture(Skin.GetTextureFileName('Cursor'), TEXTURE_TYPE_TRANSPARENT, 0); - - 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; - - //TimeBar mod - Tex_TimeProgress := Texture.LoadTexture(Skin.GetTextureFileName('TimeBar')); - //eoa TimeBar mod - - //SingBar Mod - Tex_SingBar_Back := Texture.LoadTexture(Skin.GetTextureFileName('SingBarBack'), TEXTURE_TYPE_PLAIN, 0); - Tex_SingBar_Bar := Texture.LoadTexture(Skin.GetTextureFileName('SingBarBar'), TEXTURE_TYPE_PLAIN, 0); - Tex_SingBar_Front := Texture.LoadTexture(Skin.GetTextureFileName('SingBarFront'), TEXTURE_TYPE_PLAIN, 0); - //end Singbar Mod - - Log.LogStatus('Loading Textures - C', 'LoadTextures'); - - //Line Bonus PopUp - for P := 0 to 8 do - begin - Case P of - 0: begin - R := 1; - G := 0; - B := 0; - end; - 1..3: begin - R := 1; - G := (P * 0.25); - B := 0; - end; - 4: begin - R := 1; - G := 1; - B := 0; - end; - 5..7: begin - R := 1-((P-4)*0.25); - G := 1; - B := 0; - end; - 8: begin - R := 0; - G := 1; - B := 0; - end; - End; - - Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255); - Tex_SingLineBonusBack[P] := Texture.LoadTexture(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(Skin.GetTextureFileName('ScoreBG'), TEXTURE_TYPE_COLORIZED, Col); - end; - - - Log.LogStatus('Loading Textures - D', 'LoadTextures'); - -// ###################### -// Score screen textures -// ###################### - -//## the bars that visualize the score ## - for P := 1 to 6 do begin -//NoteBar ScoreBar - LoadColor(R, G, B, 'P' + IntToStr(P) + 'Dark'); - Col := $10000 * Round(R*255) + $100 * Round(G*255) + Round(B*255); - Tex_Score_NoteBarLevel_Dark[P] := Texture.LoadTexture(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(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(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(Skin.GetTextureFileName('Rating_'+IntToStr(P)), TEXTURE_TYPE_TRANSPARENT, 0); - end; - - Log.LogStatus('Loading Textures - Done', 'LoadTextures'); -end; - -(* - * Load OpenGL extensions. Must be called after SDL_SetVideoMode() and each - * time the pixel-format or render-context (RC) changes. - *) -procedure LoadOpenGLExtensions; -begin - // Load OpenGL 1.2 extensions for OpenGL 1.2 compatibility - if (not Load_GL_version_1_2()) then - begin - Log.LogCritical('Failed loading OpenGL 1.2', 'UGraphic.Initialize3D'); - end; - - // Other extensions e.g. OpenGL 1.3-2.0 or Framebuffer-Object might be loaded here - // ... - //Load_GL_EXT_framebuffer_object(); -end; - -const - WINDOW_ICON = 'icons/ultrastardx-icon.png'; - -procedure Initialize3D (Title: string); -var - Icon: PSDL_Surface; -begin - Log.LogStatus('SDL_Init', 'UGraphic.Initialize3D'); - if ( SDL_InitSubSystem(SDL_INIT_VIDEO) = -1 ) then - begin - Log.LogCritical('SDL_Init Failed', 'UGraphic.Initialize3D'); - end; - - // load icon image (must be 32x32 for win32) - Icon := LoadImage(ResourcesPath.Append(WINDOW_ICON)); - if (Icon <> nil) then - SDL_WM_SetIcon(Icon, nil); - - SDL_WM_SetCaption(PChar(Title), nil); - - //Log.BenchmarkStart(2); - - InitializeScreen; - - //Log.BenchmarkEnd(2); - //Log.LogBenchmark('--> Setting Screen', 2); - - //Log.BenchmarkStart(2); - Texture := TTextureUnit.Create; - // FIXME: this does not seem to be correct as Limit. - // Is the max. of either width or height. - Texture.Limit := 1024*1024; - - //LoadTextures; - //Log.BenchmarkEnd(2); - //Log.LogBenchmark('--> Loading Textures', 2); - - { - Log.BenchmarkStart(2); - Lyric:= TLyric.Create; - Log.BenchmarkEnd(2); - Log.LogBenchmark('--> Loading Fonts', 2); - } - - // Note: do not initialize video modules earlier. They might depend on some - // SDL video functions or OpenGL extensions initialized in InitializeScreen() - InitializeVideo(); - - //Log.BenchmarkStart(2); - - Log.LogStatus('TDisplay.Create', 'UGraphic.Initialize3D'); - Display := TDisplay.Create; - //Display.SetCursor; - - //Log.BenchmarkEnd(2); Log.LogBenchmark('====> Creating Display', 2); - - //Log.LogStatus('Loading Screens', 'Initialize3D'); - //Log.BenchmarkStart(3); - - Log.LogStatus('Loading Font Textures', 'UGraphic.Initialize3D'); - LoadFontTextures(); - - // Show the Loading Screen ------------- - Log.LogStatus('Loading Loading Screen', 'UGraphic.Initialize3D'); - LoadLoadingScreen; - - - Log.LogStatus(' Loading Textures', 'UGraphic.Initialize3D'); - LoadTextures; // jb - - - - // now that we have something to display while loading, - // start thread that loads the rest of ultrastar - //Mutex := SDL_CreateMutex; - //SDL_UnLockMutex(Mutex); - - // does not work this way because the loading thread tries to access opengl. - // See comment below - //LoadingThread := SDL_CreateThread(@LoadingThread, nil); - - // this would be run in the loadingthread - Log.LogStatus(' Loading Screens', 'UGraphic.Initialize3D'); - LoadScreens; - - - // TODO: - // here should be a loop which - // * draws the loading screen (form time to time) - // * controlls the "process of the loading screen" - // * checks if the loadingthread has loaded textures (check mutex) and - // * load the textures into opengl - // * tells the loadingthread, that the memory for the texture can be reused - // to load the netx texture (over another mutex) - // * runs as long as the loadingthread tells, that everything is loaded and ready (using a third mutex) - // - // therefor loadtexture have to be changed, that it, instat of caling some opengl functions - // for itself, it should change mutex - // the mainthread have to know somehow what opengl function have to be called with which parameters like - // texturetype, textureobjekt, textur-buffer-adress, ... - - // wait for loading thread to finish - // currently does not work this way - // SDL_WaitThread(LoadingThread, I); - // SDL_DestroyMutex(Mutex); - - Display.CurrentScreen^.FadeTo( @ScreenMain ); - - Log.BenchmarkEnd(2); - Log.LogBenchmark('--> Loading Screens', 2); - - Log.LogStatus('Finish', 'Initialize3D'); -end; - -procedure SwapBuffers; -begin - SDL_GL_SwapBuffers; - glMatrixMode(GL_PROJECTION); - glLoadIdentity; - glOrtho(0, RenderW, RenderH, 0, -1, 100); - glMatrixMode(GL_MODELVIEW); -end; - -procedure Reinitialize3D; -begin - InitializeScreen; -end; - -procedure InitializeScreen; -var - S: string; - I: integer; - W, H: integer; - Depth: Integer; - Fullscreen: boolean; -begin - if (Params.Screens <> -1) then - Screens := Params.Screens + 1 - else - Screens := Ini.Screens + 1; - - // Set minimum color component sizes - // Note: do not request an alpha plane with SDL_GL_ALPHA_SIZE here as - // some cards/implementations do not support them (SDL_SetVideoMode fails). - // We do not the alpha plane anymore since offscreen rendering in back-buffer - // was removed. - SDL_GL_SetAttribute(SDL_GL_RED_SIZE, 5); - SDL_GL_SetAttribute(SDL_GL_GREEN_SIZE, 5); - SDL_GL_SetAttribute(SDL_GL_BLUE_SIZE, 5); - - SDL_GL_SetAttribute(SDL_GL_DEPTH_SIZE, 16); // Z-Buffer depth - SDL_GL_SetAttribute(SDL_GL_DOUBLEBUFFER, 1); - - // VSYNC works for windows only at the moment. SDL_GL_SWAP_CONTROL under - // linux uses GLX_MESA_swap_control which is not supported by nvidea cards. - // Maybe use glXSwapIntervalSGI(1) from the GLX_SGI_swap_control extension instead. - //SDL_GL_SetAttribute(SDL_GL_SWAP_CONTROL, 1); // VSYNC (currently Windows only) - - // If there is a resolution in Parameters, use it, else use the Ini value - I := Params.Resolution; - if (I <> -1) then - S := IResolution[I] - else - S := IResolution[Ini.Resolution]; - - I := Pos('x', S); - W := StrToInt(Copy(S, 1, I-1)) * Screens; - H := StrToInt(Copy(S, I+1, 1000)); - - if (Params.Depth <> -1) then - Depth := Params.Depth - else - Depth := Ini.Depth; - - Log.LogStatus('SDL_SetVideoMode', 'Initialize3D'); - - // check whether to start in fullscreen or windowed mode. - // The command-line parameters take precedence over the ini settings. - Fullscreen := ((Ini.FullScreen = 1) or (Params.ScreenMode = scmFullscreen)) and - not (Params.ScreenMode = scmWindowed); - - if Fullscreen then - begin - Log.LogStatus('SDL_SetVideoMode', 'Set Video Mode... Full Screen'); - screen := SDL_SetVideoMode(W, H, (Depth+1) * 16, SDL_OPENGL or SDL_FULLSCREEN ); - end - else - begin - Log.LogStatus('SDL_SetVideoMode', 'Set Video Mode... Windowed'); - screen := SDL_SetVideoMode(W, H, 0, SDL_OPENGL or SDL_RESIZABLE); - end; - - SDL_ShowCursor(0); - - if (screen = nil) then - begin - Log.LogCritical('SDL_SetVideoMode Failed', 'Initialize3D'); - end; - - LoadOpenGLExtensions(); - - // define virtual (Render) and real (Screen) screen size - RenderW := 800; - RenderH := 600; - ScreenW := W; - ScreenH := H; - - // clear screen once window is being shown - // Note: SwapBuffers uses RenderW/H, so they must be defined before - glClearColor(1, 1, 1, 1); - glClear(GL_COLOR_BUFFER_BIT); - SwapBuffers; -end; - -procedure LoadLoadingScreen; -begin - ScreenLoading := TScreenLoading.Create; - ScreenLoading.OnShow; - - Display.CurrentScreen := @ScreenLoading; - - SwapBuffers; - - ScreenLoading.Draw; - Display.Draw; - - SwapBuffers; -end; - -procedure LoadScreens; -begin -{ ScreenLoading := TScreenLoading.Create; - ScreenLoading.OnShow; - Display.CurrentScreen := @ScreenLoading; - ScreenLoading.Draw; - Display.Draw; - SwapBuffers; -} - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Loading', 3); Log.BenchmarkStart(3); -{ ScreenWelcome := TScreenWelcome.Create; //'BG', 4, 3); - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Welcome', 3); Log.BenchmarkStart(3);} - ScreenMain := TScreenMain.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Main', 3); Log.BenchmarkStart(3); - ScreenName := TScreenName.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Name', 3); Log.BenchmarkStart(3); - ScreenLevel := TScreenLevel.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Level', 3); Log.BenchmarkStart(3); - ScreenSong := TScreenSong.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Song', 3); Log.BenchmarkStart(3); - ScreenSongMenu := TScreenSongMenu.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Song Menu', 3); Log.BenchmarkStart(3); - ScreenSing := TScreenSing.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Sing', 3); Log.BenchmarkStart(3); - ScreenScore := TScreenScore.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Score', 3); Log.BenchmarkStart(3); - ScreenTop5 := TScreenTop5.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Top5', 3); Log.BenchmarkStart(3); - ScreenOptions := TScreenOptions.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options', 3); Log.BenchmarkStart(3); - ScreenOptionsGame := TScreenOptionsGame.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Game', 3); Log.BenchmarkStart(3); - ScreenOptionsGraphics := TScreenOptionsGraphics.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Graphics', 3); Log.BenchmarkStart(3); - ScreenOptionsSound := TScreenOptionsSound.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Sound', 3); Log.BenchmarkStart(3); - ScreenOptionsLyrics := TScreenOptionsLyrics.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Lyrics', 3); Log.BenchmarkStart(3); - ScreenOptionsThemes := TScreenOptionsThemes.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Themes', 3); Log.BenchmarkStart(3); - ScreenOptionsRecord := TScreenOptionsRecord.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Record', 3); Log.BenchmarkStart(3); - ScreenOptionsAdvanced := TScreenOptionsAdvanced.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Options Advanced', 3); Log.BenchmarkStart(3); - ScreenEditSub := TScreenEditSub.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Edit Sub', 3); Log.BenchmarkStart(3); - ScreenEdit := TScreenEdit.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Edit', 3); Log.BenchmarkStart(3); - ScreenEditConvert := TScreenEditConvert.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen EditConvert', 3); Log.BenchmarkStart(3); -// ScreenEditHeader := TScreenEditHeader.Create(Skin.ScoreBG); -// Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Edit Header', 3); Log.BenchmarkStart(3); - ScreenOpen := TScreenOpen.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Open', 3); Log.BenchmarkStart(3); - ScreenSingModi := TScreenSingModi.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Sing with Modi support', 3); Log.BenchmarkStart(3); - ScreenSongMenu := TScreenSongMenu.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen SongMenu', 3); Log.BenchmarkStart(3); - ScreenSongJumpto := TScreenSongJumpto.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen SongJumpto', 3); Log.BenchmarkStart(3); - ScreenPopupCheck := TScreenPopupCheck.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Popup (Check)', 3); Log.BenchmarkStart(3); - ScreenPopupError := TScreenPopupError.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Popup (Error)', 3); Log.BenchmarkStart(3); - 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; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyScore', 3); Log.BenchmarkStart(3); - ScreenPartyWin := TScreenPartyWin.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyWin', 3); Log.BenchmarkStart(3); - ScreenPartyOptions := TScreenPartyOptions.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyOptions', 3); Log.BenchmarkStart(3); - ScreenPartyPlayer := TScreenPartyPlayer.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyPlayer', 3); Log.BenchmarkStart(3); - ScreenStatMain := TScreenStatMain.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Stat Main', 3); Log.BenchmarkStart(3); - ScreenStatDetail := TScreenStatDetail.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Stat Detail', 3); Log.BenchmarkStart(3); - ScreenCredits := TScreenCredits.Create; - Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Credits', 3); Log.BenchmarkStart(3); - -end; - -function LoadingThreadFunction: integer; -begin - LoadScreens; - Result:= 1; -end; - -procedure UnLoadScreens; -begin - 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; - ScreenPopupInfo.Destroy; - ScreenPartyNewRound.Destroy; - ScreenPartyScore.Destroy; - ScreenPartyWin.Destroy; - ScreenPartyOptions.Destroy; - ScreenPartyPlayer.Destroy; - ScreenStatMain.Destroy; - ScreenStatDetail.Destroy; -end; - -end. diff --git a/src/base/UGraphicClasses.pas b/src/base/UGraphicClasses.pas deleted file mode 100644 index cdaa238e..00000000 --- a/src/base/UGraphicClasses.pas +++ /dev/null @@ -1,720 +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 UGraphicClasses; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses - UTexture, - SDL; - -const - DelayBetweenFrames : cardinal = 60; - -type - - TParticleType = (GoldenNote, PerfectNote, NoteHitTwinkle, PerfectLineTwinkle, ColoredStar, Flare); - - TColour3f = record - r, g, b: real; - end; - - TParticle = class - X, Y : real; //Position - Screen : integer; - W, H : cardinal; //dimensions of particle - Col : array of TColour3f; // Colour(s) of particle - Scale : array of real; // Scaling factors of particle layers - Frame : byte; //act. Frame - Tex : cardinal; //Tex num from Textur Manager - Live : byte; //How many Cycles before Kill - RecIndex : integer; //To which rectangle this particle belongs (only GoldenNote) - StarType : TParticleType; // GoldenNote | PerfectNote | NoteHitTwinkle | PerfectLineTwinkle - Alpha : real; // used for fading... - mX, mY : real; // movement-vector for PerfectLineTwinkle - SizeMod : real; // experimental size modifier - SurviveSentenceChange : Boolean; - - constructor Create(cX, cY : real; - cScreen : integer; - cLive : byte; - cFrame : integer; - cRecArrayIndex : integer; - cStarType : TParticleType; - Player : cardinal); - destructor Destroy(); override; - procedure Draw; - procedure LiveOn; - end; - - RectanglePositions = record - xTop, yTop, xBottom, yBottom : real; - TotalStarCount : integer; - CurrentStarCount : integer; - Screen : integer; - end; - - PerfectNotePositions = record - xPos, yPos : real; - Screen : integer; - end; - - TEffectManager = class - Particle : array of TParticle; - LastTime : cardinal; - RecArray : array of RectanglePositions; - TwinkleArray : array[0..5] of real; // store x-position of last twinkle for every player - PerfNoteArray : array of PerfectNotePositions; - - FlareTex: TTexture; - - constructor Create; - destructor Destroy; override; - procedure Draw; - function Spawn(X, Y: real; - Screen: integer; - Live: byte; - StartFrame: integer; - RecArrayIndex: integer; // this is only used with GoldenNotes - StarType: TParticleType; - Player: cardinal // for PerfectLineTwinkle - ): cardinal; - procedure SpawnRec(); - procedure Kill(index: cardinal); - procedure KillAll(); - procedure SentenceChange(); - procedure SaveGoldenStarsRec(Xtop, Ytop, Xbottom, Ybottom: real); - procedure SavePerfectNotePos(Xtop, Ytop: real); - procedure GoldenNoteTwinkle(Top, Bottom, Right: real; Player: integer); - procedure SpawnPerfectLineTwinkle(); - end; - -var - GoldenRec : TEffectManager; - -implementation - -uses - SysUtils, - Math, - gl, - UCommon, - UDrawTexture, - UGraphic, - UIni, - UNote, - USkins, - UThemes; - -//TParticle -constructor TParticle.Create(cX, cY : real; - cScreen : integer; - cLive : byte; - cFrame : integer; - cRecArrayIndex : integer; - cStarType : TParticleType; - Player : cardinal); -begin - inherited Create; - // in this constructor we set all initial values for our particle - X := cX; - Y := cY; - Screen := cScreen; - Live := cLive; - Frame := cFrame; - RecIndex := cRecArrayIndex; - StarType := cStarType; - Alpha := (-cos((Frame+1)*2*pi/16)+1); // neat fade-in-and-out - SetLength(Scale,1); - Scale[0] := 1; - SurviveSentenceChange := False; - SizeMod := 1; - case cStarType of - GoldenNote: - begin - Tex := Tex_Note_Star.TexNum; - W := 20; - H := 20; - SetLength(Scale,4); - Scale[1] := 0.8; - Scale[2] := 0.4; - Scale[3] := 0.3; - SetLength(Col,4); - Col[0].r := 1; - Col[0].g := 0.7; - Col[0].b := 0.1; - - Col[1].r := 1; - Col[1].g := 1; - Col[1].b := 0.4; - - Col[2].r := 1; - Col[2].g := 1; - Col[2].b := 1; - - Col[3].r := 1; - Col[3].g := 1; - Col[3].b := 1; - end; - PerfectNote: - begin - Tex := Tex_Note_Perfect_Star.TexNum; - W := 30; - H := 30; - SetLength(Col,1); - Col[0].r := 1; - Col[0].g := 1; - Col[0].b := 0.95; - end; - NoteHitTwinkle: - begin - Tex := Tex_Note_Star.TexNum; - Alpha := (Live/16); // linear fade-out - W := 15; - H := 15; - Setlength(Col,1); - Col[0].r := 1; - Col[0].g := 1; - Col[0].b := RandomRange(10*Live,100)/90; //0.9; - end; - PerfectLineTwinkle: - begin - Tex := Tex_Note_Star.TexNum; - W := RandomRange(10,20); - H := W; - SizeMod := (-cos((Frame+1)*5*2*pi/16)*0.5+1.1); - SurviveSentenceChange := True; - // assign colours according to player given - SetLength(Scale,3); - Scale[1] := 0.3; - Scale[2] := 0.2; - SetLength(Col,3); - case Player of - 0: LoadColor(Col[0].r,Col[0].g,Col[0].b,'P1Light'); - 1: LoadColor(Col[0].r,Col[0].g,Col[0].b,'P2Light'); - 2: LoadColor(Col[0].r,Col[0].g,Col[0].b,'P3Light'); - 3: LoadColor(Col[0].r,Col[0].g,Col[0].b,'P4Light'); - 4: LoadColor(Col[0].r,Col[0].g,Col[0].b,'P5Light'); - 5: LoadColor(Col[0].r,Col[0].g,Col[0].b,'P6Light'); - else LoadColor(Col[0].r,Col[0].g,Col[0].b,'P1Light'); - end; - Col[1].r := 1; - Col[1].g := 1; - Col[1].b := 0.4; - Col[2].r := Col[0].r+0.5; - Col[2].g := Col[0].g+0.5; - Col[2].b := Col[0].b+0.5; - mX := RandomRange(-5,5); - mY := RandomRange(-5,5); - end; - ColoredStar: - begin - Tex := Tex_Note_Star.TexNum; - W := RandomRange(10,20); - H := W; - SizeMod := (-cos((Frame+1)*5*2*pi/16)*0.5+1.1); - SurviveSentenceChange := True; - // assign colours according to player given - SetLength(Scale,1); - SetLength(Col,1); - Col[0].b := (Player and $ff)/255; - Col[0].g := ((Player shr 8) and $ff)/255; - Col[0].r := ((Player shr 16) and $ff)/255; - mX := 0; - mY := 0; - end; - Flare: - begin - Tex := Tex_Note_Star.TexNum; - W := 7; - H := 7; - SizeMod := (-cos((Frame+1)*5*2*pi/16)*0.5+1.1); - mX := RandomRange(-5,5); - mY := RandomRange(-5,5); - SetLength(Scale,4); - Scale[1] := 0.8; - Scale[2] := 0.4; - Scale[3] := 0.3; - SetLength(Col,4); - Col[0].r := 1; - Col[0].g := 0.7; - Col[0].b := 0.1; - - Col[1].r := 1; - Col[1].g := 1; - Col[1].b := 0.4; - - Col[2].r := 1; - Col[2].g := 1; - Col[2].b := 1; - - Col[3].r := 1; - Col[3].g := 1; - Col[3].b := 1; - - end; - else // just some random default values - begin - Tex := Tex_Note_Star.TexNum; - Alpha := 1; - W := 20; - H := 20; - SetLength(Col,1); - Col[0].r := 1; - Col[0].g := 1; - Col[0].b := 1; - end; - end; -end; - -destructor TParticle.Destroy(); -begin - SetLength(Scale,0); - SetLength(Col,0); - inherited; -end; - -procedure TParticle.LiveOn; -begin - //Live = 0 => Live forever ?? but if this is 0 they would be killed in the Manager at Draw - if (Live > 0) then - Dec(Live); - - // animate frames - Frame := ( Frame + 1 ) mod 16; - - // make our particles do funny stuff (besides being animated) - // changes of any particle-values throughout its life are done here - case StarType of - GoldenNote: - begin - Alpha := (-cos((Frame+1)*2*pi/16)+1); // neat fade-in-and-out - end; - PerfectNote: - begin - Alpha := (-cos((Frame+1)*2*pi/16)+1); // neat fade-in-and-out - end; - NoteHitTwinkle: - begin - Alpha := (Live/10); // linear fade-out - end; - PerfectLineTwinkle: - begin - Alpha := (-cos((Frame+1)*2*pi/16)+1); // neat fade-in-and-out - SizeMod := (-cos((Frame+1)*5*2*pi/16)*0.5+1.1); - // move around - X := X + mX; - Y := Y + mY; - end; - ColoredStar: - begin - Alpha := (-cos((Frame+1)*2*pi/16)+1); // neat fade-in-and-out - end; - Flare: - begin - Alpha := (-cos((Frame+1)/16*1.7*pi+0.3*pi)+1); // neat fade-in-and-out - SizeMod := (-cos((Frame+1)*5*2*pi/16)*0.5+1.1); - // move around - X := X + mX; - Y := Y + mY; - mY := mY+1.8; -// mX := mX/2; - end; - end; -end; - -procedure TParticle.Draw; -var - L: cardinal; -begin - if ScreenAct = Screen then - // this draws (multiple) texture(s) of our particle - for L := 0 to High(Col) do - begin - glColor4f(Col[L].r, Col[L].g, Col[L].b, Alpha); - - glBindTexture(GL_TEXTURE_2D, Tex); - glEnable(GL_TEXTURE_2D); - glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); - glEnable(GL_BLEND); - - glBegin(GL_QUADS); - glTexCoord2f((1/16) * Frame, 0); glVertex2f(X-W*Scale[L]*SizeMod, Y-H*Scale[L]*SizeMod); - glTexCoord2f((1/16) * Frame + (1/16), 0); glVertex2f(X-W*Scale[L]*SizeMod, Y+H*Scale[L]*SizeMod); - glTexCoord2f((1/16) * Frame + (1/16), 1); glVertex2f(X+W*Scale[L]*SizeMod, Y+H*Scale[L]*SizeMod); - glTexCoord2f((1/16) * Frame, 1); glVertex2f(X+W*Scale[L]*SizeMod, Y-H*Scale[L]*SizeMod); - glEnd; - end; - glcolor4f(1,1,1,1); -end; -// end of TParticle - -// TEffectManager - -constructor TEffectManager.Create; -var - c: cardinal; -begin - inherited; - LastTime := SDL_GetTicks(); - for c := 0 to 5 do - begin - TwinkleArray[c] := 0; - end; -end; - -destructor TEffectManager.Destroy; -begin - Killall; - inherited; -end; - - -procedure TEffectManager.Draw; -var - I: integer; - CurrentTime: cardinal; -//const -// DelayBetweenFrames : cardinal = 100; -begin - - CurrentTime := SDL_GetTicks(); - //Manage particle life - if (CurrentTime - LastTime) > DelayBetweenFrames then - begin - LastTime := CurrentTime; - for I := 0 to high(Particle) do - Particle[I].LiveOn; - end; - - I := 0; - //Kill dead particles - while (I <= High(Particle)) do - begin - if (Particle[I].Live <= 0) then - begin - kill(I); - end - else - begin - inc(I); - end; - end; - - //Draw - for I := 0 to high(Particle) do - begin - Particle[I].Draw; - end; -end; - -// this method creates just one particle -function TEffectManager.Spawn(X, Y: real; Screen: integer; Live: byte; StartFrame : integer; RecArrayIndex : integer; StarType : TParticleType; Player: cardinal): cardinal; -begin - Result := Length(Particle); - SetLength(Particle, (Result + 1)); - Particle[Result] := TParticle.Create(X, Y, Screen, Live, StartFrame, RecArrayIndex, StarType, Player); -end; - -// manage Sparkling of GoldenNote Bars -procedure TEffectManager.SpawnRec(); -var - Xkatze, Ykatze : real; - RandomFrame : integer; - P : integer; // P as seen on TV as Positionman -begin -//Spawn a random amount of stars within the given coordinates -//RandomRange(0,14) <- this one starts at a random frame, 16 is our last frame - would be senseless to start a particle with 16, cause it would be dead at the next frame - for P := 0 to high(RecArray) do - begin - while (RecArray[P].TotalStarCount > RecArray[P].CurrentStarCount) do - begin - Xkatze := RandomRange(Ceil(RecArray[P].xTop), Ceil(RecArray[P].xBottom)); - Ykatze := RandomRange(Ceil(RecArray[P].yTop), Ceil(RecArray[P].yBottom)); - RandomFrame := RandomRange(0,14); - // Spawn a GoldenNote Particle - Spawn(Xkatze, Ykatze, RecArray[P].Screen, 16 - RandomFrame, RandomFrame, P, GoldenNote, 0); - inc(RecArray[P].CurrentStarCount); - end; - end; - draw; -end; - -// kill one particle (with given index in our particle array) -procedure TEffectManager.Kill(Index: cardinal); -var - LastParticleIndex : integer; -begin -// delete particle indexed by Index, -// overwrite it's place in our particle-array with the particle stored at the last array index, -// shorten array - LastParticleIndex := high(Particle); - if not(LastParticleIndex = -1) then // is there still a particle to delete? - begin - if not(Particle[Index].RecIndex = -1) then // if it is a GoldenNote particle... - dec(RecArray[Particle[Index].RecIndex].CurrentStarCount); // take care of its associated GoldenRec - // now get rid of that particle - Particle[Index].Destroy; - Particle[Index] := Particle[LastParticleIndex]; - SetLength(Particle, LastParticleIndex); - end; -end; - -// clean up all particles and management structures -procedure TEffectManager.KillAll(); -var - c: cardinal; -begin -//It's the kill all kennies rotuine - while Length(Particle) > 0 do // kill all existing particles - Kill(0); - SetLength(RecArray,0); // remove GoldenRec positions - SetLength(PerfNoteArray,0); // remove PerfectNote positions - for c := 0 to 5 do - begin - TwinkleArray[c] := 0; // reset GoldenNoteHit memory - end; -end; - -procedure TEffectManager.SentenceChange(); -var - c: cardinal; -begin - c := 0; - while c <= High(Particle) do - begin - if Particle[c].SurviveSentenceChange then - inc(c) - else - Kill(c); - end; - SetLength(RecArray,0); // remove GoldenRec positions - SetLength(PerfNoteArray,0); // remove PerfectNote positions - for c := 0 to 5 do - begin - TwinkleArray[c] := 0; // reset GoldenNoteHit memory - end; -end; - -procedure TeffectManager.GoldenNoteTwinkle(Top, Bottom, Right: real; Player: integer); -//Twinkle stars while golden note hit -// this is called from UDraw.pas, SingDrawPlayerCzesc -var - C, P, XKatze, YKatze, LKatze: integer; - H: real; -begin - // make sure we spawn only one time at one position - if (TwinkleArray[Player] < Right) then - for P := 0 to high(RecArray) do // Are we inside a GoldenNoteRectangle? - begin - H := (Top+Bottom)/2; // helper... - with RecArray[P] do - if ((xBottom >= Right) and (xTop <= Right) and - (yTop <= H) and (yBottom >= H)) - and (Screen = ScreenAct) then - begin - TwinkleArray[Player] := Right; // remember twinkle position for this player - for C := 1 to 10 do - begin - Ykatze := RandomRange(ceil(Top) , ceil(Bottom)); - XKatze := RandomRange(-7,3); - LKatze := RandomRange(7,13); - Spawn(Ceil(Right)+XKatze, YKatze, ScreenAct, LKatze, 0, -1, NoteHitTwinkle, 0); - end; - for C := 1 to 3 do - begin - Ykatze := RandomRange(ceil(Top)-6 , ceil(Top)); - XKatze := RandomRange(-5,1); - LKatze := RandomRange(4,7); - Spawn(Ceil(Right)+XKatze, YKatze, ScreenAct, LKatze, 0, -1, NoteHitTwinkle, 0); - end; - for C := 1 to 3 do - begin - Ykatze := RandomRange(ceil(Bottom), ceil(Bottom)+6); - XKatze := RandomRange(-5,1); - LKatze := RandomRange(4,7); - Spawn(Ceil(Right)+XKatze, YKatze, ScreenAct, LKatze, 0, -1, NoteHitTwinkle, 0); - end; - for C := 1 to 3 do - begin - Ykatze := RandomRange(ceil(Top)-10 , ceil(Top)-6); - XKatze := RandomRange(-5,1); - LKatze := RandomRange(1,4); - Spawn(Ceil(Right)+XKatze, YKatze, ScreenAct, LKatze, 0, -1, NoteHitTwinkle, 0); - end; - for C := 1 to 3 do - begin - Ykatze := RandomRange(ceil(Bottom)+6 , ceil(Bottom)+10); - XKatze := RandomRange(-5,1); - LKatze := RandomRange(1,4); - Spawn(Ceil(Right)+XKatze, YKatze, ScreenAct, LKatze, 0, -1, NoteHitTwinkle, 0); - end; - - exit; // found a matching GoldenRec, did spawning stuff... done - end; - end; -end; - -procedure TEffectManager.SaveGoldenStarsRec(Xtop, Ytop, Xbottom, Ybottom: real); -var - P : integer; // P like used in Positions - NewIndex : integer; -begin - for P := 0 to high(RecArray) do // Do we already have that "new" position? - begin - if (ceil(RecArray[P].xTop) = ceil(Xtop)) and - (ceil(RecArray[P].yTop) = ceil(Ytop)) and - (ScreenAct = RecArray[p].Screen) then - exit; // it's already in the array, so we don't have to create a new one - end; - - // we got a new position, add the new positions to our array - NewIndex := Length(RecArray); - SetLength(RecArray, NewIndex + 1); - RecArray[NewIndex].xTop := Xtop; - RecArray[NewIndex].yTop := Ytop; - RecArray[NewIndex].xBottom := Xbottom; - RecArray[NewIndex].yBottom := Ybottom; - RecArray[NewIndex].TotalStarCount := ceil(Xbottom - Xtop) div 12 + 3; - RecArray[NewIndex].CurrentStarCount := 0; - RecArray[NewIndex].Screen := ScreenAct; -end; - -procedure TEffectManager.SavePerfectNotePos(Xtop, Ytop: real); -var - P : integer; // P like used in Positions - NewIndex : integer; - RandomFrame : integer; - Xkatze, Ykatze : integer; -begin - for P := 0 to high(PerfNoteArray) do // Do we already have that "new" position? - begin - with PerfNoteArray[P] do - if (ceil(xPos) = ceil(Xtop)) and (ceil(yPos) = ceil(Ytop)) and - (Screen = ScreenAct) then - exit; // it's already in the array, so we don't have to create a new one - end; //for - - // we got a new position, add the new positions to our array - NewIndex := Length(PerfNoteArray); - SetLength(PerfNoteArray, NewIndex + 1); - PerfNoteArray[NewIndex].xPos := Xtop; - PerfNoteArray[NewIndex].yPos := Ytop; - PerfNoteArray[NewIndex].Screen := ScreenAct; - - for P := 0 to 2 do - begin - Xkatze := RandomRange(ceil(Xtop) - 5 , ceil(Xtop) + 10); - Ykatze := RandomRange(ceil(Ytop) - 5 , ceil(Ytop) + 10); - RandomFrame := RandomRange(0,14); - Spawn(Xkatze, Ykatze, ScreenAct, 16 - RandomFrame, RandomFrame, -1, PerfectNote, 0); - end; //for - -end; - -procedure TEffectManager.SpawnPerfectLineTwinkle(); -var - P, I, Life: cardinal; - Left, Right, Top, Bottom: cardinal; - cScreen: integer; -begin -// calculation of coordinates done with hardcoded values like in UDraw.pas -// might need to be adjusted if drawing of SingScreen is modified -// coordinates may still be a bit weird and need adjustment - if Ini.SingWindow = 0 then - begin - Left := 130; - end - else - begin - Left := 30; - end; - Right := 770; - // spawn effect for every player with a perfect line - for P := 0 to PlayersPlay-1 do - if Player[P].LastSentencePerfect then - begin - // calculate area where notes of this player are drawn - case PlayersPlay of - 1: begin - Bottom := Skin_P2_NotesB+10; - Top := Bottom-105; - cScreen := 1; - end; - 2,4: begin - case P of - 0,2: begin - Bottom := Skin_P1_NotesB+10; - Top := Bottom-105; - end; - else begin - Bottom := Skin_P2_NotesB+10; - Top := Bottom-105; - end; - end; - case P of - 0,1: cScreen := 1; - else cScreen := 2; - end; - end; - 3,6: begin - case P of - 0,3: begin - Top := 130; - Bottom := Top+85; - end; - 1,4: begin - Top := 255; - Bottom := Top+85; - end; - 2,5: begin - Top := 380; - Bottom := Top+85; - end; - end; - case P of - 0,1,2: cScreen := 1; - else cScreen := 2; - end; - end; - end; - // spawn Sparkling Stars inside calculated coordinates - for I := 0 to 80 do - begin - Life := RandomRange(8,16); - Spawn(RandomRange(Left,Right), RandomRange(Top,Bottom), cScreen, Life, 16-Life, -1, PerfectLineTwinkle, P); - end; - end; -end; - -end. - diff --git a/src/base/UIni.pas b/src/base/UIni.pas deleted file mode 100644 index 998d19fb..00000000 --- a/src/base/UIni.pas +++ /dev/null @@ -1,1219 +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 UIni; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses - Classes, - IniFiles, - SysUtils, - ULog, - UTextEncoding, - UFilesystem, - UPath; - -type - // TInputDeviceConfig stores the configuration for an input device. - // Configurations will be stored in the InputDeviceConfig array. - // Note that not all devices listed in InputDeviceConfig are active devices. - // Some might be unplugged and hence unavailable. - // Available devices are held in TAudioInputProcessor.DeviceList. Each - // TAudioInputDevice listed there has a CfgIndex field which is the index to - // its configuration in the InputDeviceConfig array. - // Name: - // the name of the input device - // Input: - // the index of the input source to use for recording - // ChannelToPlayerMap: - // mapping of recording channels to players, e.g. ChannelToPlayerMap[0] = 2 - // maps the channel 0 (left) to player 2. A player index of 0 means that - // the channel is not assigned to a player. - PInputDeviceConfig = ^TInputDeviceConfig; - TInputDeviceConfig = record - Name: string; - Input: integer; - ChannelToPlayerMap: array of integer; - end; - -type - -//Options - - TVisualizerOption = (voOff, voWhenNoVideo, voOn); - TBackgroundMusicOption = (bmoOff, bmoOn); - TIni = class - private - function ExtractKeyIndex(const Key, Prefix, Suffix: string): integer; - function GetMaxKeyIndex(Keys: TStringList; const Prefix, Suffix: string): integer; - function GetArrayIndex(const SearchArray: array of UTF8String; Value: string; CaseInsensitiv: boolean = false): integer; - function ReadArrayIndex(const SearchArray: array of UTF8String; IniFile: TCustomIniFile; - IniSection: string; IniProperty: string; Default: integer): integer; - - procedure TranslateOptionValues; - procedure LoadInputDeviceCfg(IniFile: TMemIniFile); - procedure SaveInputDeviceCfg(IniFile: TIniFile); - procedure LoadThemes(IniFile: TCustomIniFile); - procedure LoadPaths(IniFile: TCustomIniFile); - procedure LoadScreenModes(IniFile: TCustomIniFile); - - public - Name: array[0..11] of UTF8String; - - // Templates for Names Mod - NameTeam: array[0..2] of UTF8String; - NameTemplate: array[0..11] of UTF8String; - - //Filename of the opened iniFile - Filename: IPath; - - // Game - Players: integer; - Difficulty: integer; - Language: integer; - Tabs: integer; - TabsAtStartup: integer; //Tabs at Startup fix - Sorting: integer; - Debug: integer; - - // Graphics - Screens: integer; - Resolution: integer; - Depth: integer; - VisualizerOption: integer; - FullScreen: integer; - TextureSize: integer; - SingWindow: integer; - Oscilloscope: integer; - Spectrum: integer; - Spectrograph: integer; - MovieSize: integer; - - // Sound - MicBoost: integer; - ClickAssist: integer; - BeatClick: integer; - SavePlayback: integer; - ThresholdIndex: integer; - AudioOutputBufferSizeIndex: integer; - VoicePassthrough: integer; - - //Song Preview - PreviewVolume: integer; - PreviewFading: integer; - - // Lyrics - LyricsFont: integer; - LyricsEffect: integer; - Solmization: integer; - NoteLines: integer; - - // Themes - Theme: integer; - SkinNo: integer; - Color: integer; - BackgroundMusicOption: integer; - - // Record - InputDeviceConfig: array of TInputDeviceConfig; - - // Advanced - LoadAnimation: integer; - EffectSing: integer; - ScreenFade: integer; - AskBeforeDel: integer; - OnSongClick: integer; - LineBonus: integer; - PartyPopup: integer; - - // Controller - Joypad: integer; - Mouse: integer; - - procedure Load(); - procedure Save(); - procedure SaveNames; - procedure SaveLevel; - end; - -var - Ini: TIni; - IResolution: array of UTF8String; - ILanguage: array of UTF8String; - ITheme: array of UTF8String; - ISkin: array of UTF8String; - -const - 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 UTF8String = ('Easy', 'Medium', 'Hard'); - ITabs: array[0..1] of UTF8String = ('Off', 'On'); - - ISorting: array[0..6] of UTF8String = ('Edition', 'Genre', 'Language', 'Folder', 'Title', 'Artist', 'Artist2'); - sEdition = 0; - sGenre = 1; - sLanguage = 2; - sFolder = 3; - sTitle = 4; - sArtist = 5; - sArtist2 = 6; - - IDebug: array[0..1] of UTF8String = ('Off', '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 UTF8String = ('Off', 'On'); - - 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 UTF8String = ('Small', 'Big'); - - //SingBar Mod - IOscilloscope: array[0..1] of UTF8String = ('Off', 'On'); - - 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 UTF8String = ('Off', 'On'); - IBeatClick: array[0..1] of UTF8String = ('Off', 'On'); - ISavePlayback: array[0..1] of UTF8String = ('Off', 'On'); - - 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 UTF8String = ('Off', 'On'); - - 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 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 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 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 UTF8String = ('Plain', 'OLine1', 'OLine2'); - ILyricsEffect: array[0..4] of UTF8String = ('Simple', 'Zoom', 'Slide', 'Ball', 'Shift'); - ISolmization: array[0..3] of UTF8String = ('Off', 'Euro', 'Jap', 'American'); - INoteLines: array[0..1] of UTF8String = ('Off', 'On'); - - IColor: array[0..8] of UTF8String = ('Blue', 'Green', 'Pink', 'Red', 'Violet', 'Orange', 'Yellow', 'Brown', 'Black'); - - // Advanced - 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 UTF8String = ('Off', 'On'); - IMouse: array[0..2] of UTF8String = ('Off', 'Hardware Cursor', 'Software Cursor'); - - // Recording options - IChannelPlayer: array[0..6] of UTF8String = ('Off', '1', '2', '3', '4', '5', '6'); - IMicBoost: array[0..3] of UTF8String = ('Off', '+6dB', '+12dB', '+18dB'); - -var - ILanguageTranslated: array of UTF8String; - - IDifficultyTranslated: array[0..2] of UTF8String = ('Easy', 'Medium', 'Hard'); - ITabsTranslated: array[0..1] of UTF8String = ('Off', 'On'); - - ISortingTranslated: array[0..6] of UTF8String = ('Edition', 'Genre', 'Language', 'Folder', 'Title', 'Artist', 'Artist2'); - - IDebugTranslated: array[0..1] of UTF8String = ('Off', 'On'); - - 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 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]'); - - IClickAssistTranslated: array[0..1] of UTF8String = ('Off', 'On'); - IBeatClickTranslated: array[0..1] of UTF8String = ('Off', 'On'); - ISavePlaybackTranslated: array[0..1] of UTF8String = ('Off', 'On'); - - IVoicePassthroughTranslated: array[0..1] of UTF8String = ('Off', 'On'); - - //Song Preview - IPreviewVolumeTranslated: array[0..10] of UTF8String = ('Off', '10%', '20%', '30%', '40%', '50%', '60%', '70%', '80%', '90%', '100%'); - - IAudioOutputBufferSizeTranslated: array[0..9] of UTF8String = ('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 UTF8String = ('Off', '1 Sec', '2 Secs', '3 Secs', '4 Secs', '5 Secs'); - - ILyricsFontTranslated: array[0..2] of UTF8String = ('Plain', 'OLine1', 'OLine2'); - ILyricsEffectTranslated: array[0..4] of UTF8String = ('Simple', 'Zoom', 'Slide', 'Ball', 'Shift'); - ISolmizationTranslated: array[0..3] of UTF8String = ('Off', 'Euro', 'Jap', 'American'); - INoteLinesTranslated: array[0..1] of UTF8String = ('Off', 'On'); - - IColorTranslated: array[0..8] of UTF8String = ('Blue', 'Green', 'Pink', 'Red', 'Violet', 'Orange', 'Yellow', 'Brown', 'Black'); - - // Advanced - 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 UTF8String = ('Off', 'On'); - IMouseTranslated: array[0..2] of UTF8String = ('Off', 'Hardware Cursor', 'Software Cursor'); - - // Recording options - 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, - SDL, - UCommandLine, - ULanguage, - UPlatform, - UMain, - URecord, - USkins, - UPathUtils, - UUnicodeUtils; - -(** - * Translate and set the values of options, which need translation. - *) -procedure TIni.TranslateOptionValues; -var - I: integer; -begin - // 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'); - - ITabsTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF'); - ITabsTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_ON'); - - ISortingTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_EDITION'); - ISortingTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_GENRE'); - ISortingTranslated[2] := ULanguage.Language.Translate('OPTION_VALUE_LANGUAGE'); - 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_ARTIST2'); - - IDebugTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF'); - IDebugTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_ON'); - - IFullScreenTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF'); - IFullScreenTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_ON'); - - IVisualizerTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF'); - IVisualizerTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_WHENNOVIDEO'); - IVisualizerTranslated[2] := ULanguage.Language.Translate('OPTION_VALUE_ON'); - - IBackgroundMusicTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF'); - IBackgroundMusicTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_ON'); - - ISingWindowTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_SMALL'); - ISingWindowTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_BIG'); - - IOscilloscopeTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF'); - IOscilloscopeTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_ON'); - - ISpectrumTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF'); - ISpectrumTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_ON'); - - ISpectrographTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF'); - ISpectrographTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_ON'); - - IMovieSizeTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_HALF'); - IMovieSizeTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_FULL_VID'); - IMovieSizeTranslated[2] := ULanguage.Language.Translate('OPTION_VALUE_FULL_VID_BG'); - - IClickAssistTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF'); - IClickAssistTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_ON'); - - IBeatClickTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF'); - IBeatClickTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_ON'); - - ISavePlaybackTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF'); - ISavePlaybackTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_ON'); - - IVoicePassthroughTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF'); - IVoicePassthroughTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_ON'); - - ILyricsFontTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_PLAIN'); - ILyricsFontTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_OLINE1'); - ILyricsFontTranslated[2] := ULanguage.Language.Translate('OPTION_VALUE_OLINE2'); - - ILyricsEffectTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_SIMPLE'); - ILyricsEffectTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_ZOOM'); - ILyricsEffectTranslated[2] := ULanguage.Language.Translate('OPTION_VALUE_SLIDE'); - 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'); - - IColorTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_BLUE'); - IColorTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_GREEN'); - IColorTranslated[2] := ULanguage.Language.Translate('OPTION_VALUE_PINK'); - IColorTranslated[3] := ULanguage.Language.Translate('OPTION_VALUE_RED'); - IColorTranslated[4] := ULanguage.Language.Translate('OPTION_VALUE_VIOLET'); - 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_BLACK'); - - // Advanced - ILoadAnimationTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF'); - ILoadAnimationTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_ON'); - - IEffectSingTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF'); - IEffectSingTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_ON'); - - IScreenFadeTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF'); - IScreenFadeTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_ON'); - - IAskbeforeDelTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF'); - IAskbeforeDelTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_ON'); - - IOnSongClickTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_SING'); - IOnSongClickTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_SELECT_PLAYERS'); - IOnSongClickTranslated[2] := ULanguage.Language.Translate('OPTION_VALUE_OPEN_MENU'); - - ILineBonusTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF'); - ILineBonusTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_ON'); - - IPartyPopupTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF'); - IPartyPopupTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_ON'); - - IJoypadTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF'); - IJoypadTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_ON'); - - IMouseTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF'); - IMouseTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_HARDWARE_CURSOR'); - IMouseTranslated[2] := ULanguage.Language.Translate('OPTION_VALUE_SOFTWARE_CURSOR'); - - IAudioOutputBufferSizeTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_AUTO'); - IAudioOutputBufferSizeTranslated[1] := '256'; - IAudioOutputBufferSizeTranslated[2] := '512'; - IAudioOutputBufferSizeTranslated[3] := '1024'; - IAudioOutputBufferSizeTranslated[4] := '2048'; - IAudioOutputBufferSizeTranslated[5] := '4096'; - IAudioOutputBufferSizeTranslated[6] := '8192'; - IAudioOutputBufferSizeTranslated[7] := '16384'; - IAudioOutputBufferSizeTranslated[8] := '32768'; - IAudioOutputBufferSizeTranslated[9] := '65536'; - - - IAudioInputBufferSizeTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_AUTO'); - IAudioInputBufferSizeTranslated[1] := '256'; - IAudioInputBufferSizeTranslated[2] := '512'; - IAudioInputBufferSizeTranslated[3] := '1024'; - IAudioInputBufferSizeTranslated[4] := '2048'; - IAudioInputBufferSizeTranslated[5] := '4096'; - IAudioInputBufferSizeTranslated[6] := '8192'; - IAudioInputBufferSizeTranslated[7] := '16384'; - IAudioInputBufferSizeTranslated[8] := '32768'; - IAudioInputBufferSizeTranslated[9] := '65536'; - - //Song Preview - IPreviewVolumeTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF'); - IPreviewVolumeTranslated[1] := '10%'; - IPreviewVolumeTranslated[2] := '20%'; - IPreviewVolumeTranslated[3] := '30%'; - IPreviewVolumeTranslated[4] := '40%'; - IPreviewVolumeTranslated[5] := '50%'; - IPreviewVolumeTranslated[6] := '60%'; - IPreviewVolumeTranslated[7] := '70%'; - IPreviewVolumeTranslated[8] := '80%'; - IPreviewVolumeTranslated[9] := '90%'; - IPreviewVolumeTranslated[10] := '100%'; - - - IPreviewFadingTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF'); - IPreviewFadingTranslated[1] := '1 ' + ULanguage.Language.Translate('OPTION_VALUE_SEC'); - IPreviewFadingTranslated[2] := '2 ' + ULanguage.Language.Translate('OPTION_VALUE_SECS'); - IPreviewFadingTranslated[3] := '3 ' + ULanguage.Language.Translate('OPTION_VALUE_SECS'); - IPreviewFadingTranslated[4] := '4 ' + ULanguage.Language.Translate('OPTION_VALUE_SECS'); - IPreviewFadingTranslated[5] := '5 ' + ULanguage.Language.Translate('OPTION_VALUE_SECS'); - - // Recording options - IChannelPlayerTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF'); - IChannelPlayerTranslated[1] := '1'; - IChannelPlayerTranslated[2] := '2'; - IChannelPlayerTranslated[3] := '3'; - IChannelPlayerTranslated[4] := '4'; - IChannelPlayerTranslated[5] := '5'; - IChannelPlayerTranslated[6] := '6'; - - IMicBoostTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF'); - IMicBoostTranslated[1] := '+6dB'; - IMicBoostTranslated[2] := '+12dB'; - IMicBoostTranslated[3] := '+18dB'; - -end; - -(** - * Extracts an index of a key that is surrounded by a Prefix/Suffix pair. - * Example: ExtractKeyIndex('MyKey[1]', '[', ']') will return 1. - *) -function TIni.ExtractKeyIndex(const Key, Prefix, Suffix: string): integer; -var - Value: string; - Start: integer; - PrefixPos, SuffixPos: integer; -begin - Result := -1; - - PrefixPos := Pos(Prefix, Key); - if (PrefixPos <= 0) then - Exit; - SuffixPos := Pos(Suffix, Key); - if (SuffixPos <= 0) then - Exit; - - Start := PrefixPos + Length(Prefix); - - // copy all between prefix and suffix - Value := Copy(Key, Start, SuffixPos - Start); - Result := StrToIntDef(Value, -1); -end; - -(** - * Finds the maximum key-index in a key-list. - * The indexes of the list are surrounded by Prefix/Suffix, - * e.g. MyKey[1] (Prefix='[', Suffix=']') - *) -function TIni.GetMaxKeyIndex(Keys: TStringList; const Prefix, Suffix: string): integer; -var - i: integer; - KeyIndex: integer; -begin - Result := -1; - - for i := 0 to Keys.Count-1 do - begin - KeyIndex := ExtractKeyIndex(Keys[i], Prefix, Suffix); - if (KeyIndex > Result) then - Result := KeyIndex; - end; -end; - -(** - * Returns the index of Value in SearchArray - * or -1 if Value is not in SearchArray. - *) -function TIni.GetArrayIndex(const SearchArray: array of 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 (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 UTF8String; IniFile: TCustomIniFile; - IniSection: string; IniProperty: string; Default: integer): integer; -var - StrValue: string; -begin - StrValue := IniFile.ReadString(IniSection, IniProperty, SearchArray[Default]); - Result := GetArrayIndex(SearchArray, StrValue); - if (Result = -1) then - begin - Result := Default; - end; -end; - -procedure TIni.LoadInputDeviceCfg(IniFile: TMemIniFile); -var - DeviceCfg: PInputDeviceConfig; - DeviceIndex: integer; - ChannelCount: integer; - ChannelIndex: integer; - RecordKeys: TStringList; - i: integer; -begin - RecordKeys := TStringList.Create(); - - // read all record-keys for filtering - IniFile.ReadSection('Record', RecordKeys); - - SetLength(InputDeviceConfig, 0); - - for i := 0 to RecordKeys.Count-1 do - begin - // find next device-name - DeviceIndex := ExtractKeyIndex(RecordKeys[i], 'DeviceName[', ']'); - if (DeviceIndex >= 0) then - begin - if not IniFile.ValueExists('Record', Format('DeviceName[%d]', [DeviceIndex])) then - break; - - // resize list - SetLength(InputDeviceConfig, Length(InputDeviceConfig)+1); - - // read an input device's config. - // Note: All devices are appended to the list whether they exist or not. - // Otherwise an external device's config will be lost if it is not - // connected (e.g. singstar mics or USB-Audio devices). - DeviceCfg := @InputDeviceConfig[High(InputDeviceConfig)]; - DeviceCfg.Name := IniFile.ReadString('Record', Format('DeviceName[%d]', [DeviceIndex]), ''); - DeviceCfg.Input := IniFile.ReadInteger('Record', Format('Input[%d]', [DeviceIndex]), 0); - - // find the largest channel-number of the current device in the ini-file - ChannelCount := GetMaxKeyIndex(RecordKeys, 'Channel', Format('[%d]', [DeviceIndex])); - if (ChannelCount < 0) then - ChannelCount := 0; - - SetLength(DeviceCfg.ChannelToPlayerMap, ChannelCount); - - // read channel-to-player mapping for every channel of the current device - // or set non-configured channels to no player (=0). - for ChannelIndex := 0 to High(DeviceCfg.ChannelToPlayerMap) do - begin - DeviceCfg.ChannelToPlayerMap[ChannelIndex] := - IniFile.ReadInteger('Record', Format('Channel%d[%d]', [ChannelIndex+1, DeviceIndex]), 0); - end; - end; - end; - - RecordKeys.Free(); - - // MicBoost - MicBoost := GetArrayIndex(IMicBoost, IniFile.ReadString('Record', 'MicBoost', 'Off')); - // Threshold - ThresholdIndex := GetArrayIndex(IThreshold, IniFile.ReadString('Record', 'Threshold', IThreshold[1])); -end; - -procedure TIni.SaveInputDeviceCfg(IniFile: TIniFile); -var - DeviceIndex: integer; - ChannelIndex: integer; -begin - for DeviceIndex := 0 to High(InputDeviceConfig) do - begin - // DeviceName and DeviceInput - IniFile.WriteString('Record', Format('DeviceName[%d]', [DeviceIndex+1]), - InputDeviceConfig[DeviceIndex].Name); - IniFile.WriteInteger('Record', Format('Input[%d]', [DeviceIndex+1]), - InputDeviceConfig[DeviceIndex].Input); - - // Channel-to-Player Mapping - for ChannelIndex := 0 to High(InputDeviceConfig[DeviceIndex].ChannelToPlayerMap) do - begin - IniFile.WriteInteger('Record', - Format('Channel%d[%d]', [ChannelIndex+1, DeviceIndex+1]), - InputDeviceConfig[DeviceIndex].ChannelToPlayerMap[ChannelIndex]); - end; - end; - - // MicBoost - IniFile.WriteString('Record', 'MicBoost', IMicBoost[MicBoost]); - // Threshold - IniFile.WriteString('Record', 'Threshold', IThreshold[ThresholdIndex]); -end; - -procedure TIni.LoadPaths(IniFile: TCustomIniFile); -var - PathStrings: TStringList; - I: integer; -begin - PathStrings := TStringList.Create; - IniFile.ReadSection('Directories', PathStrings); - - // Load song-paths - for I := 0 to PathStrings.Count-1 do - begin - if (Pos('SONGDIR', UpperCase(PathStrings[I])) = 1) then - begin - AddSongPath(Path(IniFile.ReadString('Directories', PathStrings[I], ''))); - end; - end; - - PathStrings.Free; -end; - -procedure TIni.LoadThemes(IniFile: TCustomIniFile); -var - SearchResult: TSearchRec; - ThemeIni: TMemIniFile; - ThemeName: string; - I: integer; - Iter: IFileIterator; - FileInfo: TFileInfo; -begin - // Theme - SetLength(ITheme, 0); - Log.LogStatus('Searching for Theme : ' + ThemePath.ToNative + '*.ini', 'Theme'); - - - Iter := FileSystem.FileFind(ThemePath.Append('*.ini'), 0); - while (Iter.HasNext) do - begin - FileInfo := Iter.Next; - Log.LogStatus('Found Theme: ' + FileInfo.Name.ToNative, 'Theme'); - - //Read Themename from Theme - ThemeIni := TMemIniFile.Create(FileInfo.Name.ToNative); - ThemeName := UpperCase(ThemeIni.ReadString('Theme','Name', FileInfo.Name.SetExtension('').ToNative)); - 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)] := FileInfo.Name.SetExtension('').ToNative; - break; - end; - end; - end; - - // No Theme Found - if (Length(ITheme) = 0) then - begin - Log.CriticalError('Could not find any valid Themes.'); - end; - - Theme := GetArrayIndex(ITheme, IniFile.ReadString('Themes', 'Theme', 'DELUXE'), true); - if (Theme = -1) then - Theme := 0; - - // Skin - Skin.onThemeChange; - - SkinNo := GetArrayIndex(ISkin, IniFile.ReadString('Themes', 'Skin', ISkin[0])); -end; - -procedure TIni.LoadScreenModes(IniFile: TCustomIniFile); - - // swap two strings - procedure swap(var s1, s2: UTF8String); - var - s3: string; - begin - s3 := s1; - s1 := s2; - s2 := s3; - end; - -var - Modes: PPSDL_Rect; - I: integer; -begin - // Screens - Screens := GetArrayIndex(IScreens, IniFile.ReadString('Graphics', 'Screens', IScreens[0])); - - // FullScreen - FullScreen := GetArrayIndex(IFullScreen, IniFile.ReadString('Graphics', 'FullScreen', 'On')); - - // Resolution - SetLength(IResolution, 0); - - // Check if there are any modes available - // TODO: we should seperate windowed and fullscreen modes. Otherwise it is not - // possible to select a reasonable fullscreen mode when in windowed mode - if IFullScreen[FullScreen] = 'On' then - Modes := SDL_ListModes(nil, SDL_OPENGL or SDL_FULLSCREEN) - else - Modes := SDL_ListModes(nil, SDL_OPENGL or SDL_RESIZABLE) ; - - if (Modes = nil) then - begin - Log.LogStatus( 'No resolutions Found' , 'Video'); - end - else if (Modes = PPSDL_Rect(-1)) then - begin - // Fallback to some standard resolutions - SetLength(IResolution, 10); - IResolution[0] := '640x480'; - IResolution[1] := '800x600'; - IResolution[2] := '1024x768'; - IResolution[3] := '1152x864'; - IResolution[4] := '1280x800'; - IResolution[5] := '1280x960'; - IResolution[6] := '1400x1050'; - IResolution[7] := '1440x900'; - IResolution[8] := '1600x1200'; - IResolution[9] := '1680x1050'; - - Resolution := GetArrayIndex(IResolution, IniFile.ReadString('Graphics', 'Resolution', '800x600')); - if Resolution = -1 then - begin - SetLength(IResolution, Length(IResolution) + 1); - IResolution[High(IResolution)] := IniFile.ReadString('Graphics', 'Resolution', '800x600'); - Resolution := High(IResolution); - end; - end - else - begin - while assigned( Modes^ ) do //this should solve the biggest wine problem | THANKS Linnex (11.11.07) - begin - Log.LogStatus( 'Found Video Mode : ' + IntToStr(Modes^.w) + 'x' + IntToStr(Modes^.h) , 'Video'); - SetLength(IResolution, Length(IResolution) + 1); - IResolution[High(IResolution)] := IntToStr(Modes^.w) + 'x' + IntToStr(Modes^.h); - Inc(Modes); - end; - - // reverse order - Log.LogStatus( 'Log size of resolution: ' + IntToStr(Length(IResolution)), 'Video'); - for I := 0 to (Length(IResolution) div 2) - 1 do - begin - swap(IResolution[I], IResolution[High(IResolution)-I]); - end; - Resolution := GetArrayIndex(IResolution, IniFile.ReadString('Graphics', 'Resolution', '800x600')); - - if Resolution = -1 then - begin - Resolution := GetArrayIndex(IResolution, '800x600'); - if Resolution = -1 then - Resolution := 0; - end; - end; - - // if no modes were set, then failback to 800x600 - // as per http://sourceforge.net/forum/message.php?msg_id=4544965 - // THANKS : linnex at users.sourceforge.net - if Length(IResolution) < 1 then - begin - Log.LogStatus( 'Found Video Mode : NONE !!! ( Defaulted to 800 x 600 )', 'Video'); - SetLength(IResolution, 1); - IResolution[0] := '800x600'; - Resolution := 0; - Log.LogStatus('SDL_ListModes Defaulted Res To : ' + IResolution[0] , 'Graphics - Resolutions'); - - // Default to fullscreen OFF, in this case ! - FullScreen := 0; - end; - - // Depth - Depth := GetArrayIndex(IDepth, IniFile.ReadString('Graphics', 'Depth', '32 bit')); -end; - -procedure TIni.Load(); -var - IniFile: TMemIniFile; - I: integer; -begin - GamePath := Platform.GetGameUserPath; - - Log.LogStatus( 'GamePath : ' +GamePath.ToNative , '' ); - - if (Params.ConfigFile.IsSet) then - FileName := Params.ConfigFile - else - FileName := GamePath.Append('config.ini'); - - Log.LogStatus('Using config : ' + FileName.ToNative, 'Ini'); - IniFile := TMemIniFile.Create(FileName.ToNative); - - // Name - for I := 0 to 11 do - Name[I] := IniFile.ReadString('Name', 'P'+IntToStr(I+1), 'Player'+IntToStr(I+1)); - - // Templates for Names Mod - for I := 0 to 2 do - NameTeam[I] := IniFile.ReadString('NameTeam', 'T'+IntToStr(I+1), 'Team'+IntToStr(I+1)); - for I := 0 to 11 do - NameTemplate[I] := IniFile.ReadString('NameTemplate', 'Name'+IntToStr(I+1), 'Template'+IntToStr(I+1)); - - // Players - Players := GetArrayIndex(IPlayers, IniFile.ReadString('Game', 'Players', IPlayers[0])); - - // Difficulty - Difficulty := GetArrayIndex(IDifficulty, IniFile.ReadString('Game', 'Difficulty', 'Easy')); - - // Language - Language := GetArrayIndex(ILanguage, IniFile.ReadString('Game', 'Language', 'English')); - - // 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])); - - // Debug - Debug := GetArrayIndex(IDebug, IniFile.ReadString('Game', 'Debug', IDebug[0])); - - LoadScreenModes(IniFile); - - // TextureSize - TextureSize := GetArrayIndex(ITextureSize, IniFile.ReadString('Graphics', 'TextureSize', ITextureSize[1])); - - // SingWindow - SingWindow := GetArrayIndex(ISingWindow, IniFile.ReadString('Graphics', 'SingWindow', 'Big')); - - // Oscilloscope - Oscilloscope := GetArrayIndex(IOscilloscope, IniFile.ReadString('Graphics', 'Oscilloscope', IOscilloscope[0])); - - // Spectrum - Spectrum := GetArrayIndex(ISpectrum, IniFile.ReadString('Graphics', 'Spectrum', 'Off')); - - // Spectrograph - Spectrograph := GetArrayIndex(ISpectrograph, IniFile.ReadString('Graphics', 'Spectrograph', 'Off')); - - // MovieSize - MovieSize := GetArrayIndex(IMovieSize, IniFile.ReadString('Graphics', 'MovieSize', IMovieSize[2])); - - // ClickAssist - ClickAssist := GetArrayIndex(IClickAssist, IniFile.ReadString('Sound', 'ClickAssist', 'Off')); - - // BeatClick - BeatClick := GetArrayIndex(IBeatClick, IniFile.ReadString('Sound', 'BeatClick', IBeatClick[0])); - - // SavePlayback - SavePlayback := GetArrayIndex(ISavePlayback, IniFile.ReadString('Sound', 'SavePlayback', ISavePlayback[0])); - - // AudioOutputBufferSize - AudioOutputBufferSizeIndex := ReadArrayIndex(IAudioOutputBufferSize, IniFile, 'Sound', 'AudioOutputBufferSize', 0); - - //Preview Volume - PreviewVolume := GetArrayIndex(IPreviewVolume, IniFile.ReadString('Sound', 'PreviewVolume', IPreviewVolume[7])); - - //Preview Fading - PreviewFading := GetArrayIndex(IPreviewFading, IniFile.ReadString('Sound', 'PreviewFading', IPreviewFading[3])); - - //AudioRepeat aka VoicePassthrough - VoicePassthrough := GetArrayIndex(IVoicePassthrough, IniFile.ReadString('Sound', 'VoicePassthrough', IVoicePassthrough[0])); - - // Lyrics Font - 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])); - - // NoteLines - NoteLines := GetArrayIndex(INoteLines, IniFile.ReadString('Lyrics', 'NoteLines', INoteLines[1])); - - LoadThemes(IniFile); - - // Color - Color := GetArrayIndex(IColor, IniFile.ReadString('Themes', 'Color', IColor[0])); - - LoadInputDeviceCfg(IniFile); - - // LoadAnimation - LoadAnimation := GetArrayIndex(ILoadAnimation, IniFile.ReadString('Advanced', 'LoadAnimation', 'On')); - - // ScreenFade - ScreenFade := GetArrayIndex(IScreenFade, IniFile.ReadString('Advanced', 'ScreenFade', 'On')); - - // Visualizations - // this could be of use later.. - // VisualizerOption := - // TVisualizerOption(GetEnumValue(TypeInfo(TVisualizerOption), - // IniFile.ReadString('Graphics', 'Visualization', 'Off'))); - // || VisualizerOption := TVisualizerOption(GetArrayIndex(IVisualizer, IniFile.ReadString('Graphics', 'Visualization', 'Off'))); - VisualizerOption := GetArrayIndex(IVisualizer, IniFile.ReadString('Graphics', 'Visualization', 'Off')); - -{** - * Background music - *} - BackgroundMusicOption := GetArrayIndex(IBackgroundMusic, IniFile.ReadString('Sound', 'BackgroundMusic', 'Off')); - - // EffectSing - EffectSing := GetArrayIndex(IEffectSing, IniFile.ReadString('Advanced', 'EffectSing', 'On')); - - // AskbeforeDel - AskBeforeDel := GetArrayIndex(IAskbeforeDel, IniFile.ReadString('Advanced', 'AskbeforeDel', 'On')); - - // OnSongClick - OnSongClick := GetArrayIndex(IOnSongClick, IniFile.ReadString('Advanced', 'OnSongClick', 'Sing')); - - // Linebonus - LineBonus := GetArrayIndex(ILineBonus, IniFile.ReadString('Advanced', 'LineBonus', ILineBonus[1])); - - // PartyPopup - PartyPopup := GetArrayIndex(IPartyPopup, IniFile.ReadString('Advanced', 'PartyPopup', 'On')); - - // Joypad - Joypad := GetArrayIndex(IJoypad, IniFile.ReadString('Controller', 'Joypad', IJoypad[0])); - - // Mouse - Mouse := GetArrayIndex(IMouse, IniFile.ReadString('Controller', 'Mouse', IMouse[2])); - - LoadPaths(IniFile); - - TranslateOptionValues; - - IniFile.Free; -end; - -procedure TIni.Save; -var - IniFile: TIniFile; -begin - if (Filename.IsFile and Filename.IsReadOnly) then - begin - Log.LogError('Config-file is read-only', 'TIni.Save'); - Exit; - end; - - IniFile := TIniFile.Create(Filename.ToNative); - - // Players - IniFile.WriteString('Game', 'Players', IPlayers[Players]); - - // Difficulty - IniFile.WriteString('Game', 'Difficulty', IDifficulty[Difficulty]); - - // Language - IniFile.WriteString('Game', 'Language', ILanguage[Language]); - - // Tabs - IniFile.WriteString('Game', 'Tabs', ITabs[Tabs]); - - // Sorting - IniFile.WriteString('Game', 'Sorting', ISorting[Sorting]); - - // Debug - IniFile.WriteString('Game', 'Debug', IDebug[Debug]); - - // Screens - IniFile.WriteString('Graphics', 'Screens', IScreens[Screens]); - - // FullScreen - IniFile.WriteString('Graphics', 'FullScreen', IFullScreen[FullScreen]); - - // Visualization - IniFile.WriteString('Graphics', 'Visualization', IVisualizer[VisualizerOption]); - - // Resolution - IniFile.WriteString('Graphics', 'Resolution', IResolution[Resolution]); - - // Depth - IniFile.WriteString('Graphics', 'Depth', IDepth[Depth]); - - // TextureSize - IniFile.WriteString('Graphics', 'TextureSize', ITextureSize[TextureSize]); - - // Sing Window - IniFile.WriteString('Graphics', 'SingWindow', ISingWindow[SingWindow]); - - // Oscilloscope - IniFile.WriteString('Graphics', 'Oscilloscope', IOscilloscope[Oscilloscope]); - - // Spectrum - IniFile.WriteString('Graphics', 'Spectrum', ISpectrum[Spectrum]); - - // Spectrograph - IniFile.WriteString('Graphics', 'Spectrograph', ISpectrograph[Spectrograph]); - - // Movie Size - IniFile.WriteString('Graphics', 'MovieSize', IMovieSize[MovieSize]); - - // ClickAssist - IniFile.WriteString('Sound', 'ClickAssist', IClickAssist[ClickAssist]); - - // BeatClick - IniFile.WriteString('Sound', 'BeatClick', IBeatClick[BeatClick]); - - // AudioOutputBufferSize - IniFile.WriteString('Sound', 'AudioOutputBufferSize', IAudioOutputBufferSize[AudioOutputBufferSizeIndex]); - - // Background music - IniFile.WriteString('Sound', 'BackgroundMusic', IBackgroundMusic[BackgroundMusicOption]); - - // Song Preview - IniFile.WriteString('Sound', 'PreviewVolume', IPreviewVolume[PreviewVolume]); - - // PreviewFading - IniFile.WriteString('Sound', 'PreviewFading', IPreviewFading[PreviewFading]); - - // SavePlayback - IniFile.WriteString('Sound', 'SavePlayback', ISavePlayback[SavePlayback]); - - // VoicePasstrough - IniFile.WriteString('Sound', 'VoicePassthrough', IVoicePassthrough[VoicePassthrough]); - - // Lyrics Font - IniFile.WriteString('Lyrics', 'LyricsFont', ILyricsFont[LyricsFont]); - - // Lyrics Effect - IniFile.WriteString('Lyrics', 'LyricsEffect', ILyricsEffect[LyricsEffect]); - - // Solmization - IniFile.WriteString('Lyrics', 'Solmization', ISolmization[Solmization]); - - // NoteLines - IniFile.WriteString('Lyrics', 'NoteLines', INoteLines[NoteLines]); - - // Theme - IniFile.WriteString('Themes', 'Theme', ITheme[Theme]); - - // Skin - IniFile.WriteString('Themes', 'Skin', ISkin[SkinNo]); - - // Color - IniFile.WriteString('Themes', 'Color', IColor[Color]); - - SaveInputDeviceCfg(IniFile); - - //LoadAnimation - IniFile.WriteString('Advanced', 'LoadAnimation', ILoadAnimation[LoadAnimation]); - - //EffectSing - IniFile.WriteString('Advanced', 'EffectSing', IEffectSing[EffectSing]); - - //ScreenFade - IniFile.WriteString('Advanced', 'ScreenFade', IScreenFade[ScreenFade]); - - //AskbeforeDel - IniFile.WriteString('Advanced', 'AskbeforeDel', IAskbeforeDel[AskBeforeDel]); - - //OnSongClick - IniFile.WriteString('Advanced', 'OnSongClick', IOnSongClick[OnSongClick]); - - //Line Bonus - IniFile.WriteString('Advanced', 'LineBonus', ILineBonus[LineBonus]); - - //Party Popup - IniFile.WriteString('Advanced', 'PartyPopup', IPartyPopup[PartyPopup]); - - // Joypad - IniFile.WriteString('Controller', 'Joypad', IJoypad[Joypad]); - - // Mouse - IniFile.WriteString('Controller', 'Mouse', IMouse[Mouse]); - - // Directories (add a template if section is missing) - // Note: Value must be ' ' and not '', otherwise no key is generated on Linux - if (not IniFile.SectionExists('Directories')) then - IniFile.WriteString('Directories', 'SongDir1', ' '); - - IniFile.Free; -end; - -procedure TIni.SaveNames; -var - IniFile: TIniFile; - I: integer; -begin - if not Filename.IsReadOnly() then - begin - IniFile := TIniFile.Create(Filename.ToNative); - - //Name Templates for Names Mod - 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; -end; - -procedure TIni.SaveLevel; -var - IniFile: TIniFile; -begin - if not Filename.IsReadOnly() then - begin - IniFile := TIniFile.Create(Filename.ToNative); - - // Difficulty - IniFile.WriteString('Game', 'Difficulty', IDifficulty[Difficulty]); - - IniFile.Free; - end; -end; - -end. diff --git a/src/base/UJoystick.pas b/src/base/UJoystick.pas deleted file mode 100644 index 30808812..00000000 --- a/src/base/UJoystick.pas +++ /dev/null @@ -1,312 +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 UJoystick; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses - SDL; - -type - TJoyButton = record - State: integer; - Enabled: boolean; - Type_: byte; - Sym: cardinal; - end; - - TJoyHatState = record - State: Boolean; - LastTick: Cardinal; - Enabled: boolean; - Type_: byte; - Sym: cardinal; - end; - - TJoyUnit = record - Button: array[0..15] of TJoyButton; - HatState: Array[0..3] of TJoyHatState; - end; - - TJoy = class - constructor Create; - procedure Update; - end; - -var - Joy: TJoy; - JoyUnit: TJoyUnit; - SDL_Joy: PSDL_Joystick; - JoyEvent: TSDL_Event; - -implementation - -uses SysUtils, - ULog; - -constructor TJoy.Create; -var - B: integer; - //N: integer; -begin - inherited; - - //Old Corvus5 Method - {// joystick support - SDL_JoystickEventState(SDL_IGNORE); - SDL_InitSubSystem(SDL_INIT_JOYSTICK); - if SDL_NumJoysticks <> 1 then - Log.LogStatus('Joystick count <> 1', 'TJoy.Create'); - - SDL_Joy := SDL_JoystickOpen(0); - if SDL_Joy = nil then - Log.LogError('SDL_JoystickOpen failed', 'TJoy.Create'); - - if SDL_JoystickNumButtons(SDL_Joy) <> 16 then - Log.LogStatus('Joystick button count <> 16', 'TJoy.Create'); - -// SDL_JoystickEventState(SDL_ENABLE); - // Events don't work - thay hang the whole application with SDL_JoystickEventState(SDL_ENABLE) - - // clear states - for B := 0 to 15 do - JoyUnit.Button[B].State := 1; - - // mapping - JoyUnit.Button[1].Enabled := true; - JoyUnit.Button[1].Type_ := SDL_KEYDOWN; - JoyUnit.Button[1].Sym := SDLK_RETURN; - JoyUnit.Button[2].Enabled := true; - JoyUnit.Button[2].Type_ := SDL_KEYDOWN; - JoyUnit.Button[2].Sym := SDLK_ESCAPE; - - JoyUnit.Button[12].Enabled := true; - JoyUnit.Button[12].Type_ := SDL_KEYDOWN; - JoyUnit.Button[12].Sym := SDLK_LEFT; - JoyUnit.Button[13].Enabled := true; - JoyUnit.Button[13].Type_ := SDL_KEYDOWN; - JoyUnit.Button[13].Sym := SDLK_DOWN; - JoyUnit.Button[14].Enabled := true; - JoyUnit.Button[14].Type_ := SDL_KEYDOWN; - JoyUnit.Button[14].Sym := SDLK_RIGHT; - JoyUnit.Button[15].Enabled := true; - JoyUnit.Button[15].Type_ := SDL_KEYDOWN; - JoyUnit.Button[15].Sym := SDLK_UP; - } - //New Sarutas method - SDL_JoystickEventState(SDL_IGNORE); - SDL_InitSubSystem(SDL_INIT_JOYSTICK); - if SDL_NumJoysticks < 1 then - begin - Log.LogError('No Joystick found'); - exit; - end; - - - SDL_Joy := SDL_JoystickOpen(0); - if SDL_Joy = nil then - begin - Log.LogError('Could not Init Joystick'); - exit; - end; - //N := SDL_JoystickNumButtons(SDL_Joy); - //if N < 6 then Log.LogStatus('Joystick button count < 6', 'TJoy.Create'); - - for B := 0 to 5 do begin - JoyUnit.Button[B].Enabled := true; - JoyUnit.Button[B].State := 1; - JoyUnit.Button[B].Type_ := SDL_KEYDOWN; - end; - - JoyUnit.Button[0].Sym := SDLK_Return; - JoyUnit.Button[1].Sym := SDLK_Escape; - JoyUnit.Button[2].Sym := SDLK_M; - JoyUnit.Button[3].Sym := SDLK_R; - - JoyUnit.Button[4].Sym := SDLK_RETURN; - JoyUnit.Button[5].Sym := SDLK_ESCAPE; - - //Set HatState - for B := 0 to 3 do begin - JoyUnit.HatState[B].Enabled := true; - JoyUnit.HatState[B].State := False; - JoyUnit.HatState[B].Type_ := SDL_KEYDOWN; - end; - - JoyUnit.HatState[0].Sym := SDLK_UP; - JoyUnit.HatState[1].Sym := SDLK_RIGHT; - JoyUnit.HatState[2].Sym := SDLK_DOWN; - JoyUnit.HatState[3].Sym := SDLK_LEFT; -end; - -procedure TJoy.Update; -var - B: integer; - State: UInt8; - Tick: Cardinal; - Axes: Smallint; -begin - SDL_JoystickUpdate; - - //Manage Buttons - for B := 0 to 15 do begin - if (JoyUnit.Button[B].Enabled) and (JoyUnit.Button[B].State <> SDL_JoystickGetButton(SDL_Joy, B)) and (JoyUnit.Button[B].State = 0) then begin - JoyEvent.type_ := JoyUnit.Button[B].Type_; - JoyEvent.key.keysym.sym := JoyUnit.Button[B].Sym; - SDL_PushEvent(@JoyEvent); - end; - end; - - - for B := 0 to 15 do begin - JoyUnit.Button[B].State := SDL_JoystickGetButton(SDL_Joy, B); - end; - - //Get Tick - Tick := SDL_GetTicks(); - - //Get CoolieHat - if (SDL_JoystickNumHats(SDL_Joy)>=1) then - State := SDL_JoystickGetHat(SDL_Joy, 0) - else - State := 0; - - //Get Axis - if (SDL_JoystickNumAxes(SDL_Joy)>=2) then - begin - //Down - Up (X- Axis) - Axes := SDL_JoystickGetAxis(SDL_Joy, 1); - If Axes >= 15000 then - State := State or SDL_HAT_Down - Else If Axes <= -15000 then - State := State or SDL_HAT_UP; - - //Left - Right (Y- Axis) - Axes := SDL_JoystickGetAxis(SDL_Joy, 0); - If Axes >= 15000 then - State := State or SDL_HAT_Right - Else If Axes <= -15000 then - State := State or SDL_HAT_Left; - end; - - //Manage Hat and joystick Events - if (SDL_JoystickNumHats(SDL_Joy)>=1) OR (SDL_JoystickNumAxes(SDL_Joy)>=2) then - begin - - //Up Button - If (JoyUnit.HatState[0].Enabled) and ((SDL_HAT_UP AND State) = SDL_HAT_UP) then - begin //IF Button is newly Pressed or if he is Pressed longer than 500 msecs - if (JoyUnit.HatState[0].State = False) OR (JoyUnit.HatState[0].Lasttick < Tick) then - begin - //Set Tick and State - if JoyUnit.HatState[0].State then - JoyUnit.HatState[0].Lasttick := Tick + 200 - else - JoyUnit.HatState[0].Lasttick := Tick + 500; - - JoyUnit.HatState[0].State := True; - - JoyEvent.type_ := JoyUnit.HatState[0].Type_; - JoyEvent.key.keysym.sym := JoyUnit.HatState[0].Sym; - SDL_PushEvent(@JoyEvent); - end; - end - else - JoyUnit.HatState[0].State := False; - - //Right Button - If (JoyUnit.HatState[1].Enabled) and ((SDL_HAT_RIGHT AND State) = SDL_HAT_RIGHT) then - begin //IF Button is newly Pressed or if he is Pressed longer than 500 msecs - if (JoyUnit.HatState[1].State = False) OR (JoyUnit.HatState[1].Lasttick < Tick) then - begin - //Set Tick and State - if JoyUnit.HatState[1].State then - JoyUnit.HatState[1].Lasttick := Tick + 200 - else - JoyUnit.HatState[1].Lasttick := Tick + 500; - - JoyUnit.HatState[1].State := True; - - JoyEvent.type_ := JoyUnit.HatState[1].Type_; - JoyEvent.key.keysym.sym := JoyUnit.HatState[1].Sym; - SDL_PushEvent(@JoyEvent); - end; - end - else - JoyUnit.HatState[1].State := False; - - //Down button - If (JoyUnit.HatState[2].Enabled) and ((SDL_HAT_DOWN AND State) = SDL_HAT_DOWN) then - begin //IF Button is newly Pressed or if he is Pressed longer than 230 msecs - if (JoyUnit.HatState[2].State = False) OR (JoyUnit.HatState[2].Lasttick < Tick) then - begin - //Set Tick and State - if JoyUnit.HatState[2].State then - JoyUnit.HatState[2].Lasttick := Tick + 200 - else - JoyUnit.HatState[2].Lasttick := Tick + 500; - - JoyUnit.HatState[2].State := True; - - JoyEvent.type_ := JoyUnit.HatState[2].Type_; - JoyEvent.key.keysym.sym := JoyUnit.HatState[2].Sym; - SDL_PushEvent(@JoyEvent); - end; - end - else - JoyUnit.HatState[2].State := False; - - //Left Button - If (JoyUnit.HatState[3].Enabled) and ((SDL_HAT_LEFT AND State) = SDL_HAT_LEFT) then - begin //IF Button is newly Pressed or if he is Pressed longer than 230 msecs - if (JoyUnit.HatState[3].State = False) OR (JoyUnit.HatState[3].Lasttick < Tick) then - begin - //Set Tick and State - if JoyUnit.HatState[3].State then - JoyUnit.HatState[3].Lasttick := Tick + 200 - else - JoyUnit.HatState[3].Lasttick := Tick + 500; - - JoyUnit.HatState[3].State := True; - - JoyEvent.type_ := JoyUnit.HatState[3].Type_; - JoyEvent.key.keysym.sym := JoyUnit.HatState[3].Sym; - SDL_PushEvent(@JoyEvent); - end; - end - else - JoyUnit.HatState[3].State := False; - end; - -end; - -end. diff --git a/src/base/ULog.pas b/src/base/ULog.pas deleted file mode 100644 index e4ff4862..00000000 --- a/src/base/ULog.pas +++ /dev/null @@ -1,441 +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 ULog; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses - Classes, - UPath; - -(* - * LOG_LEVEL_[TYPE] defines the "minimum" index for logs of type TYPE. Each - * level greater than this BUT less or equal than LOG_LEVEL_[TYPE]_MAX is of this type. - * This means a level "LOG_LEVEL_ERROR >= Level <= LOG_LEVEL_ERROR_MAX" e.g. - * "Level := LOG_LEVEL_ERROR+2" is considered an error level. - * This is nice for debugging if you have more or less important debug messages. - * For example you can assign LOG_LEVEL_DEBUG+10 for the more important ones and - * LOG_LEVEL_DEBUG+20 for less important ones and so on. By changing the log-level - * you can hide the less important ones. - *) -const - LOG_LEVEL_DEBUG_MAX = MaxInt; - LOG_LEVEL_DEBUG = 50; - LOG_LEVEL_INFO_MAX = LOG_LEVEL_DEBUG-1; - LOG_LEVEL_INFO = 40; - LOG_LEVEL_STATUS_MAX = LOG_LEVEL_INFO-1; - LOG_LEVEL_STATUS = 30; - LOG_LEVEL_WARN_MAX = LOG_LEVEL_STATUS-1; - LOG_LEVEL_WARN = 20; - LOG_LEVEL_ERROR_MAX = LOG_LEVEL_WARN-1; - LOG_LEVEL_ERROR = 10; - LOG_LEVEL_CRITICAL_MAX = LOG_LEVEL_ERROR-1; - LOG_LEVEL_CRITICAL = 0; - LOG_LEVEL_NONE = -1; - - // define level that Log(File)Level is initialized with - LOG_LEVEL_DEFAULT = LOG_LEVEL_WARN; - LOG_FILE_LEVEL_DEFAULT = LOG_LEVEL_ERROR; - -type - TLog = class - private - LogFile: TextFile; - LogFileOpened: boolean; - BenchmarkFile: TextFile; - BenchmarkFileOpened: boolean; - - LogLevel: integer; - // level of messages written to the log-file - LogFileLevel: integer; - - procedure LogToFile(const Text: string); - public - BenchmarkTimeStart: array[0..31] of real; - BenchmarkTimeLength: array[0..31] of real;//TDateTime; - - Title: String; //Application Title - - // Write log message to log-file - FileOutputEnabled: Boolean; - - constructor Create; - - // destuctor - destructor Destroy; override; - - // benchmark - procedure BenchmarkStart(Number: integer); - procedure BenchmarkEnd(Number: integer); - procedure LogBenchmark(const Text: string; Number: integer); - - procedure SetLogLevel(Level: integer); - function GetLogLevel(): integer; - - procedure LogMsg(const Text: string; Level: integer); overload; - procedure LogMsg(const Msg, Context: string; Level: integer); overload; {$IFDEF HasInline}inline;{$ENDIF} - procedure LogDebug(const Msg, Context: string); {$IFDEF HasInline}inline;{$ENDIF} - procedure LogInfo(const Msg, Context: string); {$IFDEF HasInline}inline;{$ENDIF} - procedure LogStatus(const Msg, Context: string); {$IFDEF HasInline}inline;{$ENDIF} - procedure LogWarn(const Msg, Context: string); {$IFDEF HasInline}inline;{$ENDIF} - procedure LogError(const Text: string); overload; {$IFDEF HasInline}inline;{$ENDIF} - procedure LogError(const Msg, Context: string); overload; {$IFDEF HasInline}inline;{$ENDIF} - //Critical Error (Halt + MessageBox) - procedure LogCritical(const Msg, Context: string); {$IFDEF HasInline}inline;{$ENDIF} - procedure CriticalError(const Text: string); {$IFDEF HasInline}inline;{$ENDIF} - - // voice - procedure LogVoice(SoundNr: integer); - // buffer - procedure LogBuffer(const buf : Pointer; const bufLength : Integer; const filename : IPath); - end; - -procedure DebugWriteln(const aString: String); - -var - Log: TLog; - -implementation - -uses - SysUtils, - DateUtils, - URecord, - UMain, - UTime, - UCommon, - UCommandLine, - UPathUtils; - -(* - * Write to console if in debug mode (Thread-safe). - * If debug-mode is disabled nothing is done. - *) -procedure DebugWriteln(const aString: string); -begin - {$IFNDEF DEBUG} - if Params.Debug then - begin - {$ENDIF} - ConsoleWriteLn(aString); - {$IFNDEF DEBUG} - end; - {$ENDIF} -end; - - -constructor TLog.Create; -begin - inherited; - LogLevel := LOG_LEVEL_DEFAULT; - LogFileLevel := LOG_FILE_LEVEL_DEFAULT; - FileOutputEnabled := true; -end; - -destructor TLog.Destroy; -begin - if BenchmarkFileOpened then - CloseFile(BenchmarkFile); - //if AnalyzeFileOpened then - // CloseFile(AnalyzeFile); - if LogFileOpened then - CloseFile(LogFile); - inherited; -end; - -procedure TLog.BenchmarkStart(Number: integer); -begin - BenchmarkTimeStart[Number] := USTime.GetTime; //Time; -end; - -procedure TLog.BenchmarkEnd(Number: integer); -begin - BenchmarkTimeLength[Number] := USTime.GetTime {Time} - BenchmarkTimeStart[Number]; -end; - -procedure TLog.LogBenchmark(const Text: string; Number: integer); -var - Minutes: integer; - Seconds: integer; - Miliseconds: integer; - - MinutesS: string; - SecondsS: string; - MilisecondsS: string; - - ValueText: string; -begin - if (FileOutputEnabled and Params.Benchmark) then - begin - if not BenchmarkFileOpened then - begin - BenchmarkFileOpened := true; - AssignFile(BenchmarkFile, LogPath.Append('Benchmark.log').ToNative); - {$I-} - Rewrite(BenchmarkFile); - if IOResult = 0 then - BenchmarkFileOpened := true; - {$I+} - - //If File is opened write Date to Benchmark File - If (BenchmarkFileOpened) then - begin - WriteLn(BenchmarkFile, Title + ' Benchmark File'); - WriteLn(BenchmarkFile, 'Date: ' + DatetoStr(Now) + ' Time: ' + TimetoStr(Now)); - WriteLn(BenchmarkFile, '-------------------'); - - Flush(BenchmarkFile); - end; - end; - - if BenchmarkFileOpened then - begin - Miliseconds := Trunc(Frac(BenchmarkTimeLength[Number]) * 1000); - Seconds := Trunc(BenchmarkTimeLength[Number]) mod 60; - Minutes := Trunc((BenchmarkTimeLength[Number] - Seconds) / 60); - //ValueText := FloatToStr(BenchmarkTimeLength[Number]); - - { - ValueText := FloatToStr(SecondOf(BenchmarkTimeLength[Number]) + - MilliSecondOf(BenchmarkTimeLength[Number])/1000); - if MinuteOf(BenchmarkTimeLength[Number]) >= 1 then - ValueText := IntToStr(MinuteOf(BenchmarkTimeLength[Number])) + ':' + ValueText; - WriteLn(FileBenchmark, Text + ': ' + ValueText + ' seconds'); - } - - if (Minutes = 0) and (Seconds = 0) then begin - MilisecondsS := IntToStr(Miliseconds); - ValueText := MilisecondsS + ' miliseconds'; - end; - - if (Minutes = 0) and (Seconds >= 1) then begin - MilisecondsS := IntToStr(Miliseconds); - while Length(MilisecondsS) < 3 do - MilisecondsS := '0' + MilisecondsS; - - SecondsS := IntToStr(Seconds); - - ValueText := SecondsS + ',' + MilisecondsS + ' seconds'; - end; - - if Minutes >= 1 then begin - MilisecondsS := IntToStr(Miliseconds); - while Length(MilisecondsS) < 3 do - MilisecondsS := '0' + MilisecondsS; - - SecondsS := IntToStr(Seconds); - while Length(SecondsS) < 2 do - SecondsS := '0' + SecondsS; - - MinutesS := IntToStr(Minutes); - - ValueText := MinutesS + ':' + SecondsS + ',' + MilisecondsS + ' minutes'; - end; - - WriteLn(BenchmarkFile, Text + ': ' + ValueText); - Flush(BenchmarkFile); - end; - end; -end; - -procedure TLog.LogToFile(const Text: string); -begin - if (FileOutputEnabled and not LogFileOpened) then - begin - AssignFile(LogFile, LogPath.Append('Error.log').ToNative); - {$I-} - Rewrite(LogFile); - if IOResult = 0 then - LogFileOpened := true; - {$I+} - - //If File is opened write Date to Error File - if (LogFileOpened) then - begin - WriteLn(LogFile, Title + ' Error Log'); - WriteLn(LogFile, 'Date: ' + DatetoStr(Now) + ' Time: ' + TimetoStr(Now)); - WriteLn(LogFile, '-------------------'); - - Flush(LogFile); - end; - end; - - if LogFileOpened then - begin - try - WriteLn(LogFile, Text); - Flush(LogFile); - except - LogFileOpened := false; - end; - end; -end; - -procedure TLog.SetLogLevel(Level: integer); -begin - LogLevel := Level; -end; - -function TLog.GetLogLevel(): integer; -begin - Result := LogLevel; -end; - -procedure TLog.LogMsg(const Text: string; Level: integer); -var - LogMsg: string; -begin - // TODO: what if (LogFileLevel < LogLevel)? Log to file without printing to - // console or do not log at all? At the moment nothing is logged. - if (Level <= LogLevel) then - begin - if (Level <= LOG_LEVEL_CRITICAL_MAX) then - LogMsg := 'CRITICAL: ' + Text - else if (Level <= LOG_LEVEL_ERROR_MAX) then - LogMsg := 'ERROR: ' + Text - else if (Level <= LOG_LEVEL_WARN_MAX) then - LogMsg := 'WARN: ' + Text - else if (Level <= LOG_LEVEL_STATUS_MAX) then - LogMsg := 'STATUS: ' + Text - else if (Level <= LOG_LEVEL_INFO_MAX) then - LogMsg := 'INFO: ' + Text - else - LogMsg := 'DEBUG: ' + Text; - - // output log-message - if (Level <= LogLevel) then - begin - DebugWriteLn(LogMsg); - end; - - // write message to log-file - if (Level <= LogFileLevel) then - begin - LogToFile(LogMsg); - end; - end; - - // exit application on criticial errors (cannot be turned off) - if (Level <= LOG_LEVEL_CRITICAL_MAX) then - begin - // Show information (window) - ShowMessage(Text, mtError); - Halt; - end; -end; - -procedure TLog.LogMsg(const Msg, Context: string; Level: integer); -begin - LogMsg(Msg + ' ['+Context+']', Level); -end; - -procedure TLog.LogDebug(const Msg, Context: string); -begin - LogMsg(Msg, Context, LOG_LEVEL_DEBUG); -end; - -procedure TLog.LogInfo(const Msg, Context: string); -begin - LogMsg(Msg, Context, LOG_LEVEL_INFO); -end; - -procedure TLog.LogStatus(const Msg, Context: string); -begin - LogMsg(Msg, Context, LOG_LEVEL_STATUS); -end; - -procedure TLog.LogWarn(const Msg, Context: string); -begin - LogMsg(Msg, Context, LOG_LEVEL_WARN); -end; - -procedure TLog.LogError(const Msg, Context: string); -begin - LogMsg(Msg, Context, LOG_LEVEL_ERROR); -end; - -procedure TLog.LogError(const Text: string); -begin - LogMsg(Text, LOG_LEVEL_ERROR); -end; - -procedure TLog.CriticalError(const Text: string); -begin - LogMsg(Text, LOG_LEVEL_CRITICAL); -end; - -procedure TLog.LogCritical(const Msg, Context: string); -begin - LogMsg(Msg, Context, LOG_LEVEL_CRITICAL); -end; - -procedure TLog.LogVoice(SoundNr: integer); -var - FS: TBinaryFileStream; - Prefix: string; - FileName: IPath; - Num: integer; -begin - for Num := 1 to 9999 do begin - Prefix := Format('Voice%.4d', [Num]); - FileName := LogPath.Append(Prefix + '.raw'); - if not FileName.Exists() then - break - end; - - FS := TBinaryFileStream.Create(FileName, fmCreate); - - AudioInputProcessor.Sound[SoundNr].LogBuffer.Seek(0, soBeginning); - FS.CopyFrom(AudioInputProcessor.Sound[SoundNr].LogBuffer, AudioInputProcessor.Sound[SoundNr].LogBuffer.Size); - - FS.Free; -end; - -procedure TLog.LogBuffer(const buf: Pointer; const bufLength: Integer; const filename: IPath); -var - f : TBinaryFileStream; -begin - try - 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; - -end. - - diff --git a/src/base/ULyrics.pas b/src/base/ULyrics.pas deleted file mode 100644 index 3f62db9c..00000000 --- a/src/base/ULyrics.pas +++ /dev/null @@ -1,726 +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 ULyrics; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses - gl, - glext, - UTexture, - UThemes, - UMusic; - -type - // stores two textures for enabled/disabled states - TPlayerIconTex = array [0..1] of TTexture; - - TLyricsEffect = (lfxSimple, lfxZoom, lfxSlide, lfxBall, lfxShift); - - PLyricWord = ^TLyricWord; - TLyricWord = record - X: real; // left corner - Width: real; // width - Start: cardinal; // start of the word in quarters (beats) - Length: cardinal; // length of the word in quarters - Text: UTF8String; // text - Freestyle: boolean; // is freestyle? - end; - TLyricWordArray = array of TLyricWord; - - TLyricLine = class - public - Text: UTF8String; // text - Width: real; // width - Height: real; // height - Words: TLyricWordArray; // words in this line - CurWord: integer; // current active word idx (only valid if line is active) - Start: integer; // start of this line in quarters (Note: negative start values are possible due to gap) - StartNote: integer; // start of the first note of this line in quarters - Length: integer; // length in quarters (from start of first to the end of the last note) - Players: byte; // players that should sing that line (bitset, Player1: 1, Player2: 2, Player3: 4) - LastLine: boolean; // is this the last line of the song? - - constructor Create(); - destructor Destroy(); override; - procedure Reset(); - end; - - TLyricEngine = class - private - LastDrawBeat: real; - UpperLine: TLyricLine; // first line displayed (top) - LowerLine: TLyricLine; // second lind displayed (bottom) - QueueLine: TLyricLine; // third line (will be displayed when lower line is finished) - - IndicatorTex: TTexture; // texture for lyric indikator - BallTex: TTexture; // texture of the ball for the lyric effect - - QueueFull: boolean; // set to true if the queue is full and a line will be replaced with the next AddLine - LCounter: integer; // line counter - - // duet mode - textures for player icons - // FIXME: do not use a fixed player count, use MAX_PLAYERS instead - PlayerIconTex: array[0..5] of TPlayerIconTex; - - // Some helper procedures for lyric drawing - procedure DrawLyrics (Beat: real); - procedure UpdateLineMetrics(LyricLine: TLyricLine); - procedure DrawLyricsWords(LyricLine: TLyricLine; X, Y: real; StartWord, EndWord: integer); - procedure DrawLyricsLine(X, W, Y, H: real; Line: TLyricLine; Beat: real); - procedure DrawPlayerIcon(Player: byte; Enabled: boolean; X, Y: real; Size, Alpha: real); - procedure DrawBall(XBall, YBall, Alpha: real); - - public - // positions, line specific settings - UpperLineX: real; // X start-pos of UpperLine - UpperLineW: real; // Width of UpperLine with icon(s) and text - UpperLineY: real; // Y start-pos of UpperLine - UpperLineH: real; // Max. font-size of lyrics text in UpperLine - - LowerLineX: real; // X start-pos of LowerLine - LowerLineW: real; // Width of LowerLine with icon(s) and text - LowerLineY: real; // Y start-pos of LowerLine - LowerLineH: real; // Max. font-size of lyrics text in LowerLine - - // display propertys - LineColor_en: TRGBA; // Color of words in an enabled line - LineColor_dis: TRGBA; // Color of words in a disabled line - LineColor_act: TRGBA; // Color of the active word - FontStyle: byte; // Font for the lyric text - - { // currently not used - FadeInEffect: byte; // Effect for line fading in: 0: No Effect; 1: Fade Effect; 2: Move Upwards from Bottom to Pos - FadeOutEffect: byte; // Effect for line fading out: 0: No Effect; 1: Fade Effect; 2: Move Upwards - } - - // song specific settings - BPM: real; - Resolution: integer; - - // properties to easily read options of this class - property IsQueueFull: boolean read QueueFull; // line in queue? - property LineCounter: integer read LCounter; // lines that were progressed so far (after last clear) - - procedure AddLine(Line: PLine); // adds a line to the queue, if there is space - procedure Draw (Beat: real); // draw the current (active at beat) lyrics - - // clears all cached song specific information - procedure Clear(cBPM: real = 0; cResolution: integer = 0); - - function GetUpperLine(): TLyricLine; - function GetLowerLine(): TLyricLine; - - function GetUpperLineIndex(): integer; - - constructor Create(ULX, ULY, ULW, ULH, LLX, LLY, LLW, LLH: real); - procedure LoadTextures; - destructor Destroy; override; - end; - -implementation - -uses - SysUtils, - USkins, - TextGL, - UGraphic, - UDisplay, - ULog, - math, - UIni; - -{ TLyricLine } - -constructor TLyricLine.Create(); -begin - inherited; - Reset(); -end; - -destructor TLyricLine.Destroy(); -begin - SetLength(Words, 0); - inherited; -end; - -procedure TLyricLine.Reset(); -begin - Start := 0; - StartNote := 0; - Length := 0; - LastLine := False; - - Text := ''; - Width := 0; - - // duet mode: players of that line (default: all) - Players := $FF; - - SetLength(Words, 0); - CurWord := -1; -end; - - -{ TLyricEngine } - -{** - * Initializes the engine. - *} -constructor TLyricEngine.Create(ULX, ULY, ULW, ULH, LLX, LLY, LLW, LLH: real); -begin - inherited Create(); - - BPM := 0; - Resolution := 0; - LCounter := 0; - QueueFull := False; - - UpperLine := TLyricLine.Create; - LowerLine := TLyricLine.Create; - QueueLine := TLyricLine.Create; - - LastDrawBeat := 0; - - UpperLineX := ULX; - UpperLineW := ULW; - UpperLineY := ULY; - UpperLineH := ULH; - - LowerLineX := LLX; - LowerLineW := LLW; - LowerLineY := LLY; - LowerLineH := LLH; - - LoadTextures; -end; - - -{** - * Frees memory. - *} -destructor TLyricEngine.Destroy; -begin - UpperLine.Free; - LowerLine.Free; - QueueLine.Free; - inherited; -end; - -{** - * Clears all cached Song specific Information. - *} -procedure TLyricEngine.Clear(cBPM: real; cResolution: integer); -begin - BPM := cBPM; - Resolution := cResolution; - LCounter := 0; - QueueFull := False; - - LastDrawBeat:=0; -end; - - -{** - * Loads textures needed for the drawing the lyrics, - * player icons, a ball for the ball effect and the lyric indicator. - *} -procedure TLyricEngine.LoadTextures; -var - I: Integer; -begin - // lyric indicator (bar that indicates when the line start) - IndicatorTex := Texture.LoadTexture(Skin.GetTextureFileName('LyricHelpBar'), TEXTURE_TYPE_TRANSPARENT, $FF00FF); - - // ball for current word hover in ball effect - BallTex := Texture.LoadTexture(Skin.GetTextureFileName('Ball'), TEXTURE_TYPE_TRANSPARENT, 0); - - // duet mode: load player icon - for I := 0 to 5 do - begin - PlayerIconTex[I][0] := Texture.LoadTexture(Skin.GetTextureFileName('LyricIcon_P' + InttoStr(I+1)), TEXTURE_TYPE_TRANSPARENT, 0); - PlayerIconTex[I][1] := Texture.LoadTexture(Skin.GetTextureFileName('LyricIconD_P' + InttoStr(I+1)), TEXTURE_TYPE_TRANSPARENT, 0); - end; -end; - -{** - * Adds LyricLine to queue. - * The LyricEngine stores three lines in its queue: - * UpperLine: the upper line displayed in the lyrics - * LowerLine: the lower line displayed in the lyrics - * QueueLine: an offscreen line that precedes LowerLine - * If the queue is full the next call to AddLine will replace UpperLine with - * LowerLine, LowerLine with QueueLine and QueueLine with the Line parameter. - *} -procedure TLyricEngine.AddLine(Line: PLine); -var - LyricLine: TLyricLine; - I: integer; -begin - // only add lines, if there is space - if not IsQueueFull then - begin - // set LyricLine to line to write to - if (LineCounter = 0) then - LyricLine := UpperLine - else if (LineCounter = 1) then - LyricLine := LowerLine - else - begin - // now the queue is full - LyricLine := QueueLine; - QueueFull := True; - end; - end - else - begin // rotate lines (round-robin-like) - LyricLine := UpperLine; - UpperLine := LowerLine; - LowerLine := QueueLine; - QueueLine := LyricLine; - end; - - // reset line state - LyricLine.Reset(); - - // check if sentence has notes - if (Line <> nil) and (Length(Line.Note) > 0) then - begin - // copy values from SongLine to LyricLine - LyricLine.Start := Line.Start; - LyricLine.StartNote := Line.Note[0].Start; - LyricLine.Length := Line.Note[High(Line.Note)].Start + - Line.Note[High(Line.Note)].Length - - Line.Note[0].Start; - LyricLine.LastLine := Line.LastLine; - - // copy words - SetLength(LyricLine.Words, Length(Line.Note)); - for I := 0 to High(Line.Note) do - begin - LyricLine.Words[I].Start := Line.Note[I].Start; - LyricLine.Words[I].Length := Line.Note[I].Length; - LyricLine.Words[I].Text := Line.Note[I].Text; - LyricLine.Words[I].Freestyle := Line.Note[I].NoteType = ntFreestyle; - - LyricLine.Text := LyricLine.Text + LyricLine.Words[I].Text; - end; - - UpdateLineMetrics(LyricLine); - end; - - // increase the counter - Inc(LCounter); -end; - -{** - * Draws Lyrics. - * Draw just manages the Lyrics, drawing is done by a call of DrawLyrics. - * @param Beat: current Beat in Quarters - *} -procedure TLyricEngine.Draw(Beat: real); -begin - DrawLyrics(Beat); - LastDrawBeat := Beat; -end; - -{** - * Main Drawing procedure. - *} -procedure TLyricEngine.DrawLyrics(Beat: real); -begin - DrawLyricsLine(UpperLineX, UpperLineW, UpperLineY, UpperLineH, UpperLine, Beat); - DrawLyricsLine(LowerLineX, LowerLineW, LowerLineY, LowerLineH, LowerLine, Beat); -end; - -{** - * Draws a Player's icon. - *} -procedure TLyricEngine.DrawPlayerIcon(Player: byte; Enabled: boolean; X, Y: real; Size, Alpha: real); -var - IEnabled: byte; -begin - if Enabled then - IEnabled := 0 - else - IEnabled := 1; - - glEnable(GL_TEXTURE_2D); - glEnable(GL_BLEND); - glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); - glBindTexture(GL_TEXTURE_2D, PlayerIconTex[Player][IEnabled].TexNum); - - glColor4f(1, 1, 1, Alpha); - glBegin(GL_QUADS); - glTexCoord2f(0, 0); glVertex2f(X, Y); - glTexCoord2f(0, 1); glVertex2f(X, Y + Size); - glTexCoord2f(1, 1); glVertex2f(X + Size, Y + Size); - glTexCoord2f(1, 0); glVertex2f(X + Size, Y); - glEnd; - - glDisable(GL_BLEND); - glDisable(GL_TEXTURE_2D); -end; - -{** - * Draws the Ball over the LyricLine if needed. - *} -procedure TLyricEngine.DrawBall(XBall, YBall, Alpha: real); -begin - glEnable(GL_TEXTURE_2D); - glEnable(GL_BLEND); - glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); - glBindTexture(GL_TEXTURE_2D, BallTex.TexNum); - - glColor4f(1, 1, 1, Alpha); - glBegin(GL_QUADS); - glTexCoord2f(0, 0); glVertex2f(XBall - 10, YBall); - glTexCoord2f(0, 1); glVertex2f(XBall - 10, YBall + 20); - glTexCoord2f(1, 1); glVertex2f(XBall + 10, YBall + 20); - glTexCoord2f(1, 0); glVertex2f(XBall + 10, YBall); - glEnd; - - glDisable(GL_BLEND); - glDisable(GL_TEXTURE_2D); -end; - -procedure TLyricEngine.DrawLyricsWords(LyricLine: TLyricLine; - X, Y: real; StartWord, EndWord: integer); -var - I: integer; - PosX: real; - CurWord: PLyricWord; -begin - PosX := X; - - // set word positions and line size and draw the line - for I := StartWord to EndWord do - begin - CurWord := @LyricLine.Words[I]; - SetFontItalic(CurWord.Freestyle); - SetFontPos(PosX, Y); - glPrint(CurWord.Text); - PosX := PosX + CurWord.Width; - end; -end; - -procedure TLyricEngine.UpdateLineMetrics(LyricLine: TLyricLine); -var - I: integer; - PosX: real; - CurWord: PLyricWord; - RequestWidth, RequestHeight: real; -begin - PosX := 0; - - // setup font - SetFontStyle(FontStyle); - ResetFont(); - - // check if line is lower or upper line and set sizes accordingly - // Note: at the moment upper and lower lines have same width/height - // and this function is just called by AddLine() but this may change - // so that it is called by DrawLyricsLine(). - //if (LyricLine = LowerLine) then - //begin - // RequestWidth := LowerLineW; - // RequestHeight := LowerLineH; - //end - //else - //begin - RequestWidth := UpperLineW; - RequestHeight := UpperLineH; - //end; - - // set font size to a reasonable value - LyricLine.Height := RequestHeight * 0.9; - SetFontSize(LyricLine.Height); - LyricLine.Width := glTextWidth(LyricLine.Text); - - // change font-size to fit into the lyric bar - if (LyricLine.Width > RequestWidth) then - begin - LyricLine.Height := Trunc(LyricLine.Height * (RequestWidth / LyricLine.Width)); - // the line is very loooong, set font to at least 1px - if (LyricLine.Height < 1) then - LyricLine.Height := 1; - - SetFontSize(LyricLine.Height); - LyricLine.Width := glTextWidth(LyricLine.Text); - end; - - // calc word positions and widths - for I := 0 to High(LyricLine.Words) do - begin - CurWord := @LyricLine.Words[I]; - - // - if current word is italic but not the next word get the width of the - // italic font to avoid overlapping. - // - if two italic words follow each other use the normal style's - // width otherwise the spacing between the words will be too big. - // - if it is the line's last word use normal width - if CurWord.Freestyle and - (I+1 < Length(LyricLine.Words)) and - (not LyricLine.Words[I+1].Freestyle) then - begin - SetFontItalic(true); - end; - - CurWord.X := PosX; - CurWord.Width := glTextWidth(CurWord.Text); - PosX := PosX + CurWord.Width; - SetFontItalic(false); - end; -end; - - -{** - * Draws one LyricLine - *} -procedure TLyricEngine.DrawLyricsLine(X, W, Y, H: real; Line: TLyricLine; Beat: real); -var - CurWord: PLyricWord; // current word - LastWord: PLyricWord; // last word in line - NextWord: PLyricWord; // word following current word - Progress: real; // progress of singing the current word - LyricX, LyricY: real; // left/top lyric position - WordY: real; // word y-position - LyricsEffect: TLyricsEffect; - Alpha: real; // alphalevel to fade out at end - ClipPlaneEq: array[0..3] of GLdouble; // clipping plane for slide effect - {// duet mode - IconSize: real; // size of player icons - IconAlpha: real; // alpha level of player icons - } -begin - // do not draw empty lines - if (Length(Line.Words) = 0) then - Exit; - - { - // duet mode - IconSize := (2 * Height); - IconAlpha := Frac(Beat/(Resolution*4)); - - DrawPlayerIcon (0, True, X, Y + (42 - IconSize) / 2 , IconSize, IconAlpha); - DrawPlayerIcon (1, True, X + IconSize + 1, Y + (42 - IconSize) / 2, IconSize, IconAlpha); - DrawPlayerIcon (2, True, X + (IconSize + 1)*2, Y + (42 - IconSize) / 2, IconSize, IconAlpha); - } - - // set font size and style - SetFontStyle(FontStyle); - ResetFont(); - SetFontSize(Line.Height); - - // center lyrics - LyricX := X + (W - Line.Width) / 2; - LyricY := Y + (H - Line.Height) / 2; - // get lyrics effect - LyricsEffect := TLyricsEffect(Ini.LyricsEffect); - - // TODO: what about alpha in freetype outline fonts? - Alpha := 1; - - // check if this line is active (at least its first note must be active) - if (Beat >= Line.StartNote) then - begin - // if this line just got active, CurWord is -1, - // this means we should try to make the first word active - if (Line.CurWord = -1) then - Line.CurWord := 0; - - // check if the current active word is still active. - // Otherwise proceed to the next word if there is one in this line. - // Note: the max. value of Line.CurWord is High(Line.Words) - if (Line.CurWord < High(Line.Words)) and - (Beat >= Line.Words[Line.CurWord + 1].Start) then - begin - Inc(Line.CurWord); - end; - - // determine current and last word in this line. - // If the end of the line is reached use the last word as current word. - LastWord := @Line.Words[High(Line.Words)]; - CurWord := @Line.Words[Line.CurWord]; - if (Line.CurWord+1 < Length(Line.Words)) then - NextWord := @Line.Words[Line.CurWord+1] - else - NextWord := nil; - - // calc the progress of the lyrics effect - Progress := (Beat - CurWord.Start) / CurWord.Length; - if (Progress >= 1) then - Progress := 1; - if (Progress <= 0) then - Progress := 0; - - // last word of this line finished, but this line did not hide -> fade out - if Line.LastLine and - (Beat > LastWord.Start + LastWord.Length) then - begin - Alpha := 1 - (Beat - (LastWord.Start + LastWord.Length)) / 15; - if (Alpha < 0) then - Alpha := 0; - end; - - // draw sentence before current word - if (LyricsEffect in [lfxSimple, lfxBall, lfxShift]) then - // only highlight current word and not that ones before in this line - glColorRGB(LineColor_en, Alpha) - else - glColorRGB(LineColor_act, Alpha); - DrawLyricsWords(Line, LyricX, LyricY, 0, Line.CurWord-1); - - // draw rest of sentence (without current word) - glColorRGB(LineColor_en, Alpha); - if (NextWord <> nil) then - begin - DrawLyricsWords(Line, LyricX + NextWord.X, LyricY, - Line.CurWord+1, High(Line.Words)); - end; - - // draw current word - if (LyricsEffect in [lfxSimple, lfxBall, lfxShift]) then - begin - if (LyricsEffect = lfxShift) then - WordY := LyricY - 8 * (1-Progress) - else - WordY := LyricY; - - // change the color of the current word - glColor4f(LineColor_act.r, LineColor_act.g, LineColor_act.b, Alpha); - DrawLyricsWords(Line, LyricX + CurWord.X, WordY, Line.CurWord, Line.CurWord); - end - // change color and zoom current word - else if (LyricsEffect = lfxZoom) then - begin - glPushMatrix; - - // zoom at word center - glTranslatef(LyricX + CurWord.X + CurWord.Width/2, - LyricY + Line.Height/2, 0); - glScalef(1.0 + (1-Progress) * 0.5, 1.0 + (1-Progress) * 0.5, 1.0); - - glColor4f(LineColor_act.r, LineColor_act.g, LineColor_act.b, Alpha); - DrawLyricsWords(Line, -CurWord.Width/2, -Line.Height/2, Line.CurWord, Line.CurWord); - - glPopMatrix; - end - // split current word into active and non-active part - else if (LyricsEffect = lfxSlide) then - begin - // enable clipping and set clip equation coefficients to zeros - glEnable(GL_CLIP_PLANE0); - FillChar(ClipPlaneEq[0], SizeOf(ClipPlaneEq), 0); - - glPushMatrix; - glTranslatef(LyricX + CurWord.X, LyricY, 0); - - // clip non-active right part of the current word - ClipPlaneEq[0] := -1; - ClipPlaneEq[3] := CurWord.Width * Progress; - glClipPlane(GL_CLIP_PLANE0, @ClipPlaneEq); - // and draw active left part - glColor4f(LineColor_act.r, LineColor_act.g, LineColor_act.b, Alpha); - DrawLyricsWords(Line, 0, 0, Line.CurWord, Line.CurWord); - - // clip active left part of the current word - ClipPlaneEq[0] := -ClipPlaneEq[0]; - ClipPlaneEq[3] := -ClipPlaneEq[3]; - glClipPlane(GL_CLIP_PLANE0, @ClipPlaneEq); - // and draw non-active right part - glColor4f(LineColor_en.r, LineColor_en.g, LineColor_en.b, Alpha); - DrawLyricsWords(Line, 0, 0, Line.CurWord, Line.CurWord); - - glPopMatrix; - - glDisable(GL_CLIP_PLANE0); - end; - - // draw the ball onto the current word - if (LyricsEffect = lfxBall) then - begin - DrawBall(LyricX + CurWord.X + CurWord.Width * Progress, - LyricY - 15 - 15*sin(Progress * Pi), Alpha); - end; - end - else - begin - // this section is called if the whole line can be drawn at once and no - // word is highlighted. - - // enable the upper, disable the lower line - if (Line = UpperLine) then - glColorRGB(LineColor_en) - else - glColorRGB(LineColor_dis); - - DrawLyricsWords(Line, LyricX, LyricY, 0, High(Line.Words)); - end; -end; - -{** - * @returns a reference to the upper line - *} -function TLyricEngine.GetUpperLine(): TLyricLine; -begin - Result := UpperLine; -end; - -{** - * @returns a reference to the lower line - *} -function TLyricEngine.GetLowerLine(): TLyricLine; -begin - Result := LowerLine; -end; - -{** - * @returns the index of the upper line - *} -function TLyricEngine.GetUpperLineIndex(): integer; -const - QUEUE_SIZE = 3; -begin - // no line in queue - if (LineCounter <= 0) then - Result := -1 - // no line has been removed from queue yet - else if (LineCounter <= QUEUE_SIZE) then - Result := 0 - // lines have been removed from queue already - else - Result := LineCounter - QUEUE_SIZE; -end; - -end. - diff --git a/src/base/UMain.pas b/src/base/UMain.pas deleted file mode 100644 index d5e0ccb3..00000000 --- a/src/base/UMain.pas +++ /dev/null @@ -1,569 +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 UMain; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses - SysUtils, - SDL; - -var - Done: boolean; - Restart: boolean; - -procedure Main; -procedure MainLoop; -procedure CheckEvents; - -type - TMainThreadExecProc = procedure(Data: Pointer); - -const - MAINTHREAD_EXEC_EVENT = SDL_USEREVENT + 2; - -{* - * Delegates execution of procedure Proc to the main thread. - * The Data pointer is passed to the procedure when it is called. - * The main thread is notified by signaling a MAINTHREAD_EXEC_EVENT which - * is handled in CheckEvents. - * Note that Data must not be a pointer to local data. If you want to pass local - * data, use Getmem() or New() or create a temporary object. - *} -procedure MainThreadExec(Proc: TMainThreadExecProc; Data: Pointer); - -implementation - -uses - Math, - gl, - UCatCovers, - UCommandLine, - UCommon, - UConfig, - UCovers, - UDataBase, - UDisplay, - UDLLManager, - UGraphic, - UGraphicClasses, - UIni, - UJoystick, - ULanguage, - ULog, - UPathUtils, - UPlaylist, - UMusic, - UBeatTimer, - UPlatform, - USkins, - USongs, - UThemes, - UParty, - UTime; - -procedure Main; -var - WindowTitle: string; -begin - {$IFNDEF Debug} - try - {$ENDIF} - WindowTitle := USDXVersionStr; - - Platform.Init; - - if Platform.TerminateIfAlreadyRunning(WindowTitle) then - Exit; - - // fix floating-point exceptions (FPE) - DisableFloatingPointExceptions(); - // fix the locale for string-to-float parsing in C-libs - SetDefaultNumericLocale(); - - // setup separators for parsing - // Note: ThousandSeparator must be set because of a bug in TIniFile.ReadFloat - ThousandSeparator := ','; - DecimalSeparator := '.'; - - //------------------------------ - // StartUp - create classes and load files - //------------------------------ - - // initialize SDL - // without SDL_INIT_TIMER SDL_GetTicks() might return strange values - SDL_Init(SDL_INIT_VIDEO or SDL_INIT_TIMER); - SDL_EnableUnicode(1); - - USTime := TTime.Create; - VideoBGTimer := TRelativeTimer.Create; - - // Commandline Parameter Parser - Params := TCMDParams.Create; - - // Log + Benchmark - Log := TLog.Create; - Log.Title := WindowTitle; - Log.FileOutputEnabled := not Params.NoLog; - Log.BenchmarkStart(0); - - // Language - Log.BenchmarkStart(1); - Log.LogStatus('Initialize Paths', 'Initialization'); - InitializePaths; - Log.LogStatus('Load Language', 'Initialization'); - Language := TLanguage.Create; - - // add const values: - Language.AddConst('US_VERSION', USDXVersionStr); - Log.BenchmarkEnd(1); - Log.LogBenchmark('Loading Language', 1); - -{ - // SDL_ttf (Not used yet, maybe in version 1.5) - Log.BenchmarkStart(1); - Log.LogStatus('Initialize SDL_ttf', 'Initialization'); - TTF_Init(); - Log.BenchmarkEnd(1); - Log.LogBenchmark('Initializing SDL_ttf', 1); -} - - // Skin - Log.BenchmarkStart(1); - Log.LogStatus('Loading Skin List', 'Initialization'); - Skin := TSkin.Create; - Log.BenchmarkEnd(1); - Log.LogBenchmark('Loading Skin List', 1); - - // Ini + Paths - Log.BenchmarkStart(1); - Log.LogStatus('Load Ini', 'Initialization'); - Ini := TIni.Create; - Ini.Load; - - // it is possible that this is the first run, create a .ini file if neccessary - Log.LogStatus('Write Ini', 'Initialization'); - Ini.Save; - - Log.BenchmarkEnd(1); - Log.LogBenchmark('Loading Ini', 1); - - // Sound - Log.BenchmarkStart(1); - Log.LogStatus('Initialize Sound', 'Initialization'); - InitializeSound(); - Log.BenchmarkEnd(1); - Log.LogBenchmark('Initializing Sound', 1); - - // Lyrics-engine with media reference timer - LyricsState := TLyricsState.Create(); - - // Theme - Log.BenchmarkStart(1); - Log.LogStatus('Load Themes', 'Initialization'); - Theme := TTheme.Create(ThemePath.Append(ITheme[Ini.Theme] + '.ini'), Ini.Color); - Log.BenchmarkEnd(1); - Log.LogBenchmark('Loading Themes', 1); - - // Covers Cache - Log.BenchmarkStart(1); - Log.LogStatus('Creating Covers Cache', 'Initialization'); - Covers := TCoverDatabase.Create; - Log.LogBenchmark('Loading Covers Cache Array', 1); - Log.BenchmarkStart(1); - - // Category Covers - Log.BenchmarkStart(1); - Log.LogStatus('Creating Category Covers Array', 'Initialization'); - CatCovers:= TCatCovers.Create; - Log.BenchmarkEnd(1); - Log.LogBenchmark('Loading Category Covers Array', 1); - - // Songs - //Log.BenchmarkStart(1); - Log.LogStatus('Creating Song Array', 'Initialization'); - Songs := TSongs.Create; - //Songs.LoadSongList; - - Log.LogStatus('Creating 2nd Song Array', 'Initialization'); - CatSongs := TCatSongs.Create; - - Log.BenchmarkEnd(1); - Log.LogBenchmark('Loading Songs', 1); - - // PluginManager - Log.BenchmarkStart(1); - Log.LogStatus('PluginManager', 'Initialization'); - DLLMan := TDLLMan.Create; // Load PluginList - Log.BenchmarkEnd(1); - Log.LogBenchmark('Loading PluginManager', 1); - - // Party Mode Manager - Log.BenchmarkStart(1); - Log.LogStatus('PartySession Manager', 'Initialization'); - PartySession := TPartySession.Create; //Load PartySession - Log.BenchmarkEnd(1); - Log.LogBenchmark('Loading PartySession Manager', 1); - - // Graphics - Log.BenchmarkStart(1); - Log.LogStatus('Initialize 3D', 'Initialization'); - Initialize3D(WindowTitle); - Log.BenchmarkEnd(1); - Log.LogBenchmark('Initializing 3D', 1); - - // Score Saving System - Log.BenchmarkStart(1); - Log.LogStatus('DataBase System', 'Initialization'); - DataBase := TDataBaseSystem.Create; - - if (Params.ScoreFile.IsUnset) then - DataBase.Init(Platform.GetGameUserPath.Append('Ultrastar.db')) - else - DataBase.Init(Params.ScoreFile); - - Log.BenchmarkEnd(1); - Log.LogBenchmark('Loading DataBase System', 1); - - // Playlist Manager - Log.BenchmarkStart(1); - Log.LogStatus('Playlist Manager', 'Initialization'); - PlaylistMan := TPlaylistManager.Create; - Log.BenchmarkEnd(1); - Log.LogBenchmark('Loading Playlist Manager', 1); - - // GoldenStarsTwinkleMod - Log.BenchmarkStart(1); - Log.LogStatus('Effect Manager', 'Initialization'); - GoldenRec := TEffectManager.Create; - Log.BenchmarkEnd(1); - Log.LogBenchmark('Loading Particle System', 1); - - // Joypad - if (Ini.Joypad = 1) or (Params.Joypad) then - begin - Log.BenchmarkStart(1); - Log.LogStatus('Initialize Joystick', 'Initialization'); - Joy := TJoy.Create; - Log.BenchmarkEnd(1); - Log.LogBenchmark('Initializing Joystick', 1); - end; - - Log.BenchmarkEnd(0); - Log.LogBenchmark('Loading Time', 0); - - Log.LogStatus('Creating Core', 'Initialization'); -{ - Core := TCore.Create( - USDXShortVersionStr, - MakeVersion(USDX_VERSION_MAJOR, - USDX_VERSION_MINOR, - USDX_VERSION_RELEASE, - chr(0)) - ); -} - - Log.LogStatus('Running Core', 'Initialization'); - //Core.Run; - - //------------------------------ - // Start Mainloop - //------------------------------ - Log.LogStatus('Main Loop', 'Initialization'); - MainLoop; - - {$IFNDEF Debug} - finally - {$ENDIF} - //------------------------------ - // Finish Application - //------------------------------ - - // TODO: - // call an uninitialize routine for every initialize step - // or at least use the corresponding Free methods - - FinalizeMedia(); - - //TTF_Quit(); - SDL_Quit(); - - if assigned(Log) then - begin - Log.LogStatus('Main Loop', 'Finished'); - Log.Free; - end; - {$IFNDEF Debug} - end; - {$ENDIF} -end; - -procedure MainLoop; -var - Delay: integer; -const - MAX_FPS = 100; -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 - begin - // joypad - if (Ini.Joypad = 1) or (Params.Joypad) then - Joy.Update; - - // keyboard events - CheckEvents; - - // display - Done := not Display.Draw; - SwapBuffers; - - // delay - CountMidTime; - - Delay := Floor(1000 / MAX_FPS - 1000 * TimeMid); - - if Delay >= 1 then - SDL_Delay(Delay); // dynamic, maximum is 100 fps - - CountSkipTime; - - // reinitialization of graphics - if Restart then - begin - Reinitialize3D; - Restart := false; - end; - - end; -end; - -procedure DoQuit; -begin - // if question option is enabled then show exit popup - if (Ini.AskbeforeDel = 1) then - begin - Display.CurrentScreen^.CheckFadeTo(nil,'MSG_QUIT_USDX'); - end - else // if ask-for-exit is disabled then simply exit - begin - Display.Fade := 0; - Display.NextScreenWithCheck := nil; - Display.CheckOK := true; - end; -end; - -procedure CheckEvents; -var - Event: TSDL_event; - mouseDown: boolean; - mouseBtn: integer; -begin - while (SDL_PollEvent(@Event) <> 0) do - begin - case Event.type_ of - SDL_QUITEV: - begin - Display.Fade := 0; - Display.NextScreenWithCheck := nil; - Display.CheckOK := true; - end; - - SDL_MOUSEMOTION, SDL_MOUSEBUTTONDOWN, SDL_MOUSEBUTTONUP: - begin - if (Ini.Mouse > 0) then - begin - case Event.type_ of - SDL_MOUSEMOTION: - begin - mouseDown := false; - mouseBtn := 0; - end; - SDL_MOUSEBUTTONDOWN: - 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); - - if not Assigned(Display.NextScreen) then - begin //drop input when changing screens - if (ScreenPopupError <> nil) and (ScreenPopupError.Visible) then - done := not ScreenPopupError.ParseMouse(mouseBtn, mouseDown, Event.button.x, Event.button.y) - else if (ScreenPopupInfo <> nil) and (ScreenPopupInfo.Visible) then - done := not ScreenPopupInfo.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; - end; - end; - end; - end; - SDL_VIDEORESIZE: - begin - ScreenW := Event.resize.w; - ScreenH := Event.resize.h; - // Note: do NOT call SDL_SetVideoMode on Windows and MacOSX here. - // This would create a new OpenGL render-context and all texture data - // would be invalidated. - // On Linux the mode MUST be reset, otherwise graphics will be corrupted. - {$IF Defined(Linux) or Defined(FreeBSD)} - if boolean( Ini.FullScreen ) then - SDL_SetVideoMode(ScreenW, ScreenH, (Ini.Depth+1) * 16, SDL_OPENGL or SDL_FULLSCREEN) - else - SDL_SetVideoMode(ScreenW, ScreenH, (Ini.Depth+1) * 16, SDL_OPENGL or SDL_RESIZABLE); - {$IFEND} - 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 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 - 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 - Done := not ScreenPopupError.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, true) - else if (ScreenPopupInfo <> nil) and (ScreenPopupInfo.Visible) then - Done := not ScreenPopupInfo.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, true) - else if (ScreenPopupCheck <> nil) and (ScreenPopupCheck.Visible) then - Done := not ScreenPopupCheck.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, true) - else - begin - // check if screen wants to exit - Done := not Display.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, true); - - // if screen wants to exit - if Done then - DoQuit; - - end; - end; - end; - SDL_JOYAXISMOTION: - begin - // not implemented - end; - SDL_JOYBUTTONDOWN: - begin - // not implemented - end; - MAINTHREAD_EXEC_EVENT: - with Event.user do - begin - TMainThreadExecProc(data1)(data2); - end; - end; // case - end; // while -end; - -procedure MainThreadExec(Proc: TMainThreadExecProc; Data: Pointer); -var - Event: TSDL_Event; -begin - with Event.user do - begin - type_ := MAINTHREAD_EXEC_EVENT; - code := 0; // not used at the moment - data1 := @Proc; - data2 := Data; - end; - SDL_PushEvent(@Event); -end; - -end. diff --git a/src/base/UMusic.pas b/src/base/UMusic.pas deleted file mode 100644 index e1184da8..00000000 --- a/src/base/UMusic.pas +++ /dev/null @@ -1,1139 +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 UMusic; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses - SysUtils, - Classes, - UTime, - UBeatTimer, - UPath; - -type - TNoteType = (ntFreestyle, ntNormal, ntGolden); - -const - // ScoreFactor defines how a notehit of a specified notetype is - // measured in comparison to the other types - // 0 means this notetype is not rated at all - // 2 means a hit of this notetype will be rated w/ twice as much - // points as a hit of a notetype w/ ScoreFactor 1 - ScoreFactor: array[TNoteType] of integer = (0, 1, 2); - -type - (** - * TLineFragment represents a fragment of a lyrics line. - * This is a text-fragment (e.g. a syllable) assigned to a note pitch, - * represented by a bar in the sing-screen. - *) - PLineFragment = ^TLineFragment; - TLineFragment = record - Color: integer; - Start: integer; // beat the fragment starts at - Length: integer; // length in beats - Tone: integer; // full range tone - Text: UTF8String; // text assigned to this fragment (a syllable, word, etc.) - NoteType: TNoteType; // note-type: golden-note/freestyle etc. - end; - - (** - * TLine represents one lyrics line and consists of multiple - * notes. - *) - PLine = ^TLine; - TLine = record - Start: integer; // the start beat of this line (<> start beat of the first note of this line) - Lyric: 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. - End_: integer; - BaseNote: integer; - HighNote: integer; // index of last note in line (= High(Note)?) - TotalNotes: integer; // value of all notes in the line - LastLine: boolean; - Note: array of TLineFragment; - end; - - (** - * TLines stores sets of lyric lines and information on them. - * Normally just one set is defined but in duet mode it might for example - * contain two sets. - *) - TLines = record - Current: integer; // for drawing of current line - High: integer; // = High(Line)! - Number: integer; - Resolution: integer; - NotesGAP: integer; - ScoreValue: integer; - Line: array of TLine; - end; - -const - FFTSize = 512; // size of FFT data (output: FFTSize/2 values) -type - TFFTData = array[0..(FFTSize div 2)-1] of Single; - -type - PPCMStereoSample = ^TPCMStereoSample; - TPCMStereoSample = array[0..1] of SmallInt; - TPCMData = array[0..511] of TPCMStereoSample; - -type - TStreamStatus = (ssStopped, ssPlaying, ssPaused); -const - StreamStatusStr: array[TStreamStatus] of string = - ('Stopped', 'Playing', 'Paused'); - -type - TAudioSampleFormat = ( - asfU8, asfS8, // unsigned/signed 8 bits - asfU16LSB, asfS16LSB, // unsigned/signed 16 bits (endianness: LSB) - asfU16MSB, asfS16MSB, // unsigned/signed 16 bits (endianness: MSB) - asfU16, asfS16, // unsigned/signed 16 bits (endianness: System) - asfS32, // signed 32 bits (endianness: System) - asfFloat, // float - asfDouble // double - ); - -const - // Size of one sample (one channel only) in bytes - AudioSampleSize: array[TAudioSampleFormat] of integer = ( - 1, 1, // asfU8, asfS8 - 2, 2, // asfU16LSB, asfS16LSB - 2, 2, // asfU16MSB, asfS16MSB - 2, 2, // asfU16, asfS16 - 3, // asfS24 - 4, // asfS32 - 4 // asfFloat - ); - -const - CHANNELMAP_LEFT = 1; - CHANNELMAP_RIGHT = 2; - CHANNELMAP_FRONT = CHANNELMAP_LEFT or CHANNELMAP_RIGHT; - -type - TAudioFormatInfo = class - private - fSampleRate : double; - fChannels : byte; - fFormat : TAudioSampleFormat; - fFrameSize : integer; - - procedure SetChannels(Channels: byte); - procedure SetFormat(Format: TAudioSampleFormat); - procedure UpdateFrameSize(); - function GetBytesPerSec(): double; - public - constructor Create(Channels: byte; SampleRate: double; Format: TAudioSampleFormat); - function Copy(): TAudioFormatInfo; - - (** - * Returns the inverse ratio of the size of data in this format to its - * size in a given target format. - * Example: SrcSize*SrcInfo.GetRatio(TgtInfo) = TgtSize - *) - function GetRatio(TargetInfo: TAudioFormatInfo): double; - - property SampleRate: double read fSampleRate write fSampleRate; - property Channels: byte read fChannels write SetChannels; - property Format: TAudioSampleFormat read fFormat write SetFormat; - property FrameSize: integer read fFrameSize; - property BytesPerSec: double read GetBytesPerSec; - end; - -type - TSoundEffect = class - public - EngineData: Pointer; // can be used for engine-specific data - procedure Callback(Buffer: PByteArray; BufSize: integer); virtual; abstract; - end; - - TVoiceRemoval = class(TSoundEffect) - public - procedure Callback(Buffer: PByteArray; BufSize: integer); override; - end; - -type - ISyncSource = interface - function GetClock(): real; - end; - - TAudioProcessingStream = class; - TOnCloseHandler = procedure(Stream: TAudioProcessingStream); - - TAudioProcessingStream = class - protected - OnCloseHandlers: array of TOnCloseHandler; - - function GetLength(): real; virtual; abstract; - function GetPosition(): real; virtual; abstract; - procedure SetPosition(Time: real); virtual; abstract; - function GetLoop(): boolean; virtual; abstract; - procedure SetLoop(Enabled: boolean); virtual; abstract; - - procedure PerformOnClose(); - public - function GetAudioFormatInfo(): TAudioFormatInfo; virtual; abstract; - procedure Close(); virtual; abstract; - - (** - * Adds a new OnClose action handler. - * The handlers are performed in the order they were added. - * If not stated explicitely, member-variables might have been invalidated - * already. So do not use any member (variable/method/...) if you are not - * sure it is valid. - *) - procedure AddOnCloseHandler(Handler: TOnCloseHandler); - - property Length: real read GetLength; - property Position: real read GetPosition write SetPosition; - property Loop: boolean read GetLoop write SetLoop; - end; - - TAudioSourceStream = class(TAudioProcessingStream) - protected - function IsEOF(): boolean; virtual; abstract; - function IsError(): boolean; virtual; abstract; - public - function ReadData(Buffer: PByteArray; BufferSize: integer): integer; virtual; abstract; - - property EOF: boolean read IsEOF; - property Error: boolean read IsError; - end; - - (* - * State-Chart for playback-stream state transitions - * []: Transition, (): State - * - * /---[Play/FadeIn]--->-\ /-------[Pause]----->-\ - * -[Create]->(Stop) (Play) (Pause) - * \\-<-[Stop/EOF*/Error]-/ \-<---[Play/FadeIn]--// - * \-<------------[Stop/EOF*/Error]--------------/ - * - * *: if not looped, otherwise stream is repeated - * Note: SetPosition() does not change the state. - *) - - TAudioPlaybackStream = class(TAudioProcessingStream) - protected - SyncSource: ISyncSource; - AvgSyncDiff: double; - SourceStream: TAudioSourceStream; - - function GetLatency(): double; virtual; abstract; - function GetStatus(): TStreamStatus; virtual; abstract; - function GetVolume(): single; virtual; abstract; - procedure SetVolume(Volume: single); virtual; abstract; - function Synchronize(BufferSize: integer; FormatInfo: TAudioFormatInfo): integer; - procedure FillBufferWithFrame(Buffer: PByteArray; BufferSize: integer; Frame: PByteArray; FrameSize: integer); - public - (** - * Opens a SourceStream for playback. - * Note that the caller (not the TAudioPlaybackStream) is responsible to - * free the SourceStream after the Playback-Stream is closed. - * You may use an OnClose-handler to achieve this. GetSourceStream() - * guarantees to deliver this method's SourceStream parameter to - * the OnClose-handler. Freeing SourceStream at OnClose is allowed. - *) - function Open(SourceStream: TAudioSourceStream): boolean; virtual; abstract; - - procedure Play(); virtual; abstract; - procedure Pause(); virtual; abstract; - procedure Stop(); virtual; abstract; - procedure FadeIn(Time: real; TargetVolume: single); virtual; abstract; - - procedure GetFFTData(var data: TFFTData); virtual; abstract; - function GetPCMData(var data: TPCMData): Cardinal; virtual; abstract; - - procedure AddSoundEffect(Effect: TSoundEffect); virtual; abstract; - procedure RemoveSoundEffect(Effect: TSoundEffect); virtual; abstract; - - procedure SetSyncSource(SyncSource: ISyncSource); - function GetSourceStream(): TAudioSourceStream; - - property Status: TStreamStatus read GetStatus; - property Volume: single read GetVolume write SetVolume; - end; - - TAudioDecodeStream = class(TAudioSourceStream) - end; - - TAudioVoiceStream = class(TAudioSourceStream) - protected - FormatInfo: TAudioFormatInfo; - ChannelMap: integer; - public - destructor Destroy; override; - - function Open(ChannelMap: integer; FormatInfo: TAudioFormatInfo): boolean; virtual; - procedure Close(); override; - - procedure WriteData(Buffer: PByteArray; BufferSize: integer); virtual; abstract; - function GetAudioFormatInfo(): TAudioFormatInfo; override; - - function GetLength(): real; override; - function GetPosition(): real; override; - procedure SetPosition(Time: real); override; - function GetLoop(): boolean; override; - procedure SetLoop(Enabled: boolean); override; - end; - -type - // soundcard output-devices information - TAudioOutputDevice = class - public - Name: UTF8String; // soundcard name - end; - TAudioOutputDeviceList = array of TAudioOutputDevice; - -type - IGenericPlayback = Interface - ['{63A5EBC3-3F4D-4F23-8DFB-B5165FCE33DD}'] - function GetName: String; - - 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; - end; - - IVideoPlayback = Interface( IGenericPlayback ) - ['{3574C40C-28AE-4201-B3D1-3D1F0759B131}'] - function Init(): boolean; - function Finalize: boolean; - - procedure GetFrame(Time: Extended); // WANT TO RENAME THESE TO BE MORE GENERIC - procedure DrawGL(Screen: integer); // WANT TO RENAME THESE TO BE MORE GENERIC - - end; - - IVideoVisualization = Interface( IVideoPlayback ) - ['{5AC17D60-B34D-478D-B632-EB00D4078017}'] - end; - - IAudioPlayback = Interface( IGenericPlayback ) - ['{E4AE0B40-3C21-4DC5-847C-20A87E0DFB96}'] - function InitializePlayback: boolean; - function FinalizePlayback: boolean; - - function GetOutputDeviceList(): TAudioOutputDeviceList; - - procedure SetAppVolume(Volume: single); - procedure SetVolume(Volume: single); - procedure SetLoop(Enabled: boolean); - - procedure FadeIn(Time: real; TargetVolume: single); - procedure SetSyncSource(SyncSource: ISyncSource); - - procedure Rewind; - function Finished: boolean; - function Length: real; - - // Sounds - // TODO: - // add a TMediaDummyPlaybackStream implementation that will - // be used by the TSoundLib whenever OpenSound() fails, so checking for - // nil-pointers is not neccessary anymore. - // PlaySound/StopSound will be removed then, OpenSound will be renamed to - // CreateSound. - function OpenSound(const Filename: IPath): TAudioPlaybackStream; - procedure PlaySound(Stream: TAudioPlaybackStream); - procedure StopSound(Stream: TAudioPlaybackStream); - - // Equalizer - procedure GetFFTData(var Data: TFFTData); - - // Interface for Visualizer - function GetPCMData(var Data: TPCMData): Cardinal; - - function CreateVoiceStream(ChannelMap: integer; FormatInfo: TAudioFormatInfo): TAudioVoiceStream; - end; - - IGenericDecoder = Interface - ['{557B0E9A-604D-47E4-B826-13769F3E10B7}'] - function GetName(): string; - function InitializeDecoder(): boolean; - function FinalizeDecoder(): boolean; - //function IsSupported(const Filename: string): boolean; - end; - - (* - IVideoDecoder = Interface( IGenericDecoder ) - ['{2F184B2B-FE69-44D5-9031-0A2462391DCA}'] - function Open(const Filename: IPath): TVideoDecodeStream; - end; - *) - - IAudioDecoder = Interface( IGenericDecoder ) - ['{AB47B1B6-2AA9-4410-BF8C-EC79561B5478}'] - function Open(const Filename: IPath): TAudioDecodeStream; - end; - - IAudioInput = Interface - ['{A5C8DA92-2A0C-4AB2-849B-2F7448C6003A}'] - function GetName: String; - function InitializeRecord: boolean; - function FinalizeRecord(): boolean; - - procedure CaptureStart; - procedure CaptureStop; - end; - -type - TAudioConverter = class - protected - fSrcFormatInfo: TAudioFormatInfo; - fDstFormatInfo: TAudioFormatInfo; - public - function Init(SrcFormatInfo: TAudioFormatInfo; DstFormatInfo: TAudioFormatInfo): boolean; virtual; - destructor Destroy(); override; - - (** - * Converts the InputBuffer and stores the result in OutputBuffer. - * If the result is not -1, InputSize will be set to the actual number of - * input-buffer bytes used. - * Returns the number of bytes written to the output-buffer or -1 if an error occured. - *) - function Convert(InputBuffer: PByteArray; OutputBuffer: PByteArray; var InputSize: integer): integer; virtual; abstract; - - (** - * Destination/Source size ratio - *) - function GetRatio(): double; virtual; abstract; - - function GetOutputBufferSize(InputSize: integer): integer; virtual; abstract; - property SrcFormatInfo: TAudioFormatInfo read fSrcFormatInfo; - property DstFormatInfo: TAudioFormatInfo read fDstFormatInfo; - end; - -(* TODO -const - SOUNDID_START = 0; - SOUNDID_BACK = 1; - SOUNDID_SWOOSH = 2; - SOUNDID_CHANGE = 3; - SOUNDID_OPTION = 4; - SOUNDID_CLICK = 5; - LAST_SOUNDID = SOUNDID_CLICK; - - BaseSoundFilenames: array[0..LAST_SOUNDID] of IPath = ( - '%SOUNDPATH%/Common start.mp3', // Start - '%SOUNDPATH%/Common back.mp3', // Back - '%SOUNDPATH%/menu swoosh.mp3', // Swoosh - '%SOUNDPATH%/select music change music 50.mp3', // Change - '%SOUNDPATH%/option change col.mp3', // Option - '%SOUNDPATH%/rimshot022b.mp3' // Click - { - '%SOUNDPATH%/bassdrumhard076b.mp3', // Drum (unused) - '%SOUNDPATH%/hihatclosed068b.mp3', // Hihat (unused) - '%SOUNDPATH%/claps050b.mp3', // Clap (unused) - '%SOUNDPATH%/Shuffle.mp3' // Shuffle (unused) - } - ); -*) - -type - TSoundLibrary = class - private - // TODO - //Sounds: array of TAudioPlaybackStream; - public - // TODO: move sounds to the private section - // and provide IDs instead. - Start: TAudioPlaybackStream; - Back: TAudioPlaybackStream; - Swoosh: TAudioPlaybackStream; - Change: TAudioPlaybackStream; - Option: TAudioPlaybackStream; - Click: TAudioPlaybackStream; - BGMusic: TAudioPlaybackStream; - - constructor Create(); - destructor Destroy(); override; - - procedure LoadSounds(); - procedure UnloadSounds(); - - procedure StartBgMusic(); - procedure PauseBgMusic(); - // TODO - //function AddSound(Filename: IPath): integer; - //procedure RemoveSound(ID: integer); - //function GetSound(ID: integer): TAudioPlaybackStream; - //property Sound[ID: integer]: TAudioPlaybackStream read GetSound; default; - end; - -var - // TODO: JB --- THESE SHOULD NOT BE GLOBAL - Lines: array of TLines; - LyricsState: TLyricsState; - SoundLib: TSoundLibrary; - - -procedure InitializeSound; -procedure InitializeVideo; -procedure FinalizeMedia; - -function Visualization(): IVideoPlayback; -function VideoPlayback(): IVideoPlayback; -function AudioPlayback(): IAudioPlayback; -function AudioInput(): IAudioInput; -function AudioDecoders(): TInterfaceList; - -function MediaManager: TInterfaceList; - -procedure DumpMediaInterfaces(); - -implementation - -uses - math, - UIni, - UNote, - UCommandLine, - URecord, - ULog, - UPathUtils; - -var - DefaultVideoPlayback : IVideoPlayback; - DefaultVisualization : IVideoPlayback; - DefaultAudioPlayback : IAudioPlayback; - DefaultAudioInput : IAudioInput; - AudioDecoderList : TInterfaceList; - MediaInterfaceList : TInterfaceList; - - -constructor TAudioFormatInfo.Create(Channels: byte; SampleRate: double; Format: TAudioSampleFormat); -begin - inherited Create(); - fChannels := Channels; - fSampleRate := SampleRate; - fFormat := Format; - UpdateFrameSize(); -end; - -procedure TAudioFormatInfo.SetChannels(Channels: byte); -begin - fChannels := Channels; - UpdateFrameSize(); -end; - -procedure TAudioFormatInfo.SetFormat(Format: TAudioSampleFormat); -begin - fFormat := Format; - UpdateFrameSize(); -end; - -function TAudioFormatInfo.GetBytesPerSec(): double; -begin - Result := FrameSize * SampleRate; -end; - -procedure TAudioFormatInfo.UpdateFrameSize(); -begin - fFrameSize := AudioSampleSize[fFormat] * fChannels; -end; - -function TAudioFormatInfo.Copy(): TAudioFormatInfo; -begin - Result := TAudioFormatInfo.Create(Self.Channels, Self.SampleRate, Self.Format); -end; - -function TAudioFormatInfo.GetRatio(TargetInfo: TAudioFormatInfo): double; -begin - Result := (TargetInfo.FrameSize / Self.FrameSize) * - (TargetInfo.SampleRate / Self.SampleRate) -end; - - -function MediaManager: TInterfaceList; -begin - if (not assigned(MediaInterfaceList)) then - MediaInterfaceList := TInterfaceList.Create(); - Result := MediaInterfaceList; -end; - -function VideoPlayback(): IVideoPlayback; -begin - Result := DefaultVideoPlayback; -end; - -function Visualization(): IVideoPlayback; -begin - Result := DefaultVisualization; -end; - -function AudioPlayback(): IAudioPlayback; -begin - Result := DefaultAudioPlayback; -end; - -function AudioInput(): IAudioInput; -begin - Result := DefaultAudioInput; -end; - -function AudioDecoders(): TInterfaceList; -begin - Result := AudioDecoderList; -end; - -procedure FilterInterfaceList(const IID: TGUID; InList, OutList: TInterfaceList); -var - i: integer; - obj: IInterface; -begin - if (not assigned(OutList)) then - Exit; - - OutList.Clear; - for i := 0 to InList.Count-1 do - begin - if assigned(InList[i]) then - begin - // add object to list if it implements the interface searched for - if (InList[i].QueryInterface(IID, obj) = 0) then - OutList.Add(obj); - end; - end; -end; - -procedure InitializeSound; -var - i: integer; - InterfaceList: TInterfaceList; - CurrentAudioDecoder: IAudioDecoder; - CurrentAudioPlayback: IAudioPlayback; - CurrentAudioInput: IAudioInput; -begin - // create a temporary list for interface enumeration - InterfaceList := TInterfaceList.Create(); - - // initialize all audio-decoders first - FilterInterfaceList(IAudioDecoder, MediaManager, InterfaceList); - for i := 0 to InterfaceList.Count-1 do - begin - CurrentAudioDecoder := InterfaceList[i] as IAudioDecoder; - if (not CurrentAudioDecoder.InitializeDecoder()) then - begin - Log.LogError('Initialize failed, Removing - '+ CurrentAudioDecoder.GetName); - MediaManager.Remove(CurrentAudioDecoder); - end; - end; - - // create and setup decoder-list (see AudioDecoders()) - AudioDecoderList := TInterfaceList.Create; - FilterInterfaceList(IAudioDecoder, MediaManager, AudioDecoders); - - // find and initialize playback interface - DefaultAudioPlayback := nil; - FilterInterfaceList(IAudioPlayback, MediaManager, InterfaceList); - for i := 0 to InterfaceList.Count-1 do - begin - CurrentAudioPlayback := InterfaceList[i] as IAudioPlayback; - if (CurrentAudioPlayback.InitializePlayback()) then - begin - DefaultAudioPlayback := CurrentAudioPlayback; - break; - end; - Log.LogError('Initialize failed, Removing - '+ CurrentAudioPlayback.GetName); - MediaManager.Remove(CurrentAudioPlayback); - end; - - // find and initialize input interface - DefaultAudioInput := nil; - FilterInterfaceList(IAudioInput, MediaManager, InterfaceList); - for i := 0 to InterfaceList.Count-1 do - begin - CurrentAudioInput := InterfaceList[i] as IAudioInput; - if (CurrentAudioInput.InitializeRecord()) then - begin - DefaultAudioInput := CurrentAudioInput; - break; - end; - Log.LogError('Initialize failed, Removing - '+ CurrentAudioInput.GetName); - MediaManager.Remove(CurrentAudioInput); - end; - - InterfaceList.Free; - - // Update input-device list with registered devices - AudioInputProcessor.UpdateInputDeviceConfig(); - - // Load in-game sounds - SoundLib := TSoundLibrary.Create; -end; - -procedure InitializeVideo(); -var - i: integer; - InterfaceList: TInterfaceList; - VideoInterface: IVideoPlayback; - VisualInterface: IVideoVisualization; -begin - InterfaceList := TInterfaceList.Create; - - // initialize and set video-playback singleton - DefaultVideoPlayback := nil; - FilterInterfaceList(IVideoPlayback, MediaManager, InterfaceList); - for i := 0 to InterfaceList.Count-1 do - begin - VideoInterface := InterfaceList[i] as IVideoPlayback; - if (VideoInterface.Init()) then - begin - DefaultVideoPlayback := VideoInterface; - break; - end; - Log.LogError('Initialize failed, Removing - '+ VideoInterface.GetName); - MediaManager.Remove(VideoInterface); - end; - - // initialize and set visualization singleton - DefaultVisualization := nil; - FilterInterfaceList(IVideoVisualization, MediaManager, InterfaceList); - for i := 0 to InterfaceList.Count-1 do - begin - VisualInterface := InterfaceList[i] as IVideoVisualization; - if (VisualInterface.Init()) then - begin - DefaultVisualization := VisualInterface; - break; - end; - Log.LogError('Initialize failed, Removing - '+ VisualInterface.GetName); - MediaManager.Remove(VisualInterface); - end; - - InterfaceList.Free; - - // now that we have all interfaces, we can dump them - // TODO: move this to another place - if FindCmdLineSwitch(cMediaInterfaces) then - begin - DumpMediaInterfaces(); - halt; - end; -end; - -procedure UnloadMediaModules; -var - i: integer; - InterfaceList: TInterfaceList; -begin - FreeAndNil(AudioDecoderList); - DefaultAudioPlayback := nil; - DefaultAudioInput := nil; - DefaultVideoPlayback := nil; - DefaultVisualization := nil; - - // create temporary interface list - InterfaceList := TInterfaceList.Create(); - - // finalize audio playback interfaces (should be done before the decoders) - FilterInterfaceList(IAudioPlayback, MediaManager, InterfaceList); - for i := 0 to InterfaceList.Count-1 do - (InterfaceList[i] as IAudioPlayback).FinalizePlayback(); - - // finalize audio input interfaces - FilterInterfaceList(IAudioInput, MediaManager, InterfaceList); - for i := 0 to InterfaceList.Count-1 do - (InterfaceList[i] as IAudioInput).FinalizeRecord(); - - // finalize audio decoder interfaces - FilterInterfaceList(IAudioDecoder, MediaManager, InterfaceList); - for i := 0 to InterfaceList.Count-1 do - (InterfaceList[i] as IAudioDecoder).FinalizeDecoder(); - - // finalize video interfaces - FilterInterfaceList(IVideoPlayback, MediaManager, InterfaceList); - for i := 0 to InterfaceList.Count-1 do - (InterfaceList[i] as IVideoPlayback).Finalize(); - - // finalize audio decoder interfaces - FilterInterfaceList(IVideoVisualization, MediaManager, InterfaceList); - for i := 0 to InterfaceList.Count-1 do - (InterfaceList[i] as IVideoVisualization).Finalize(); - - InterfaceList.Free; - - // finally free interfaces (by removing all references to them) - FreeAndNil(MediaInterfaceList); -end; - -procedure FinalizeMedia; -begin - // stop, close and free sounds - SoundLib.Free; - - // stop and close music stream - if (AudioPlayback <> nil) then - AudioPlayback.Close; - - // stop any active captures - if (AudioInput <> nil) then - AudioInput.CaptureStop; - - if (VideoPlayback <> nil) then - VideoPlayback.Close; - - if (Visualization <> nil) then - Visualization.Close; - - UnloadMediaModules(); -end; - -procedure DumpMediaInterfaces(); -begin - writeln( '' ); - writeln( '--------------------------------------------------------------' ); - writeln( ' In-use Media Interfaces ' ); - writeln( '--------------------------------------------------------------' ); - writeln( 'Registered Audio Playback Interface : ' + AudioPlayback.GetName ); - writeln( 'Registered Audio Input Interface : ' + AudioInput.GetName ); - writeln( 'Registered Video Playback Interface : ' + VideoPlayback.GetName ); - writeln( 'Registered Visualization Interface : ' + Visualization.GetName ); - writeln( '--------------------------------------------------------------' ); - writeln( '' ); -end; - - -{ TSoundLibrary } - -constructor TSoundLibrary.Create(); -begin - inherited; - LoadSounds(); -end; - -destructor TSoundLibrary.Destroy(); -begin - UnloadSounds(); - inherited; -end; - -procedure TSoundLibrary.LoadSounds(); -begin - UnloadSounds(); - - Start := AudioPlayback.OpenSound(SoundPath.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.Append('Bebeto_-_Loop010.mp3')); - - if (BGMusic <> nil) then - BGMusic.Loop := True; -end; - -procedure TSoundLibrary.UnloadSounds(); -begin - FreeAndNil(Start); - FreeAndNil(Back); - FreeAndNil(Swoosh); - FreeAndNil(Change); - FreeAndNil(Option); - FreeAndNil(Click); - FreeAndNil(BGMusic); -end; - -(* TODO -function TSoundLibrary.GetSound(ID: integer): TAudioPlaybackStream; -begin - if ((ID >= 0) and (ID < Length(Sounds))) then - Result := Sounds[ID] - else - Result := nil; -end; -*) - -procedure TSoundLibrary.StartBgMusic(); -begin - if (TBackgroundMusicOption(Ini.BackgroundMusicOption) = bmoOn) and - (Soundlib.BGMusic <> nil) and not (Soundlib.BGMusic.Status = ssPlaying) then - begin - AudioPlayback.PlaySound(Soundlib.BGMusic); - end; -end; - -procedure TSoundLibrary.PauseBgMusic(); -begin - If (Soundlib.BGMusic <> nil) then - begin - Soundlib.BGMusic.Pause; - end; -end; - -{ TVoiceRemoval } - -procedure TVoiceRemoval.Callback(Buffer: PByteArray; BufSize: integer); -var - FrameIndex, FrameSize: integer; - Value: integer; - Sample: PPCMStereoSample; -begin - FrameSize := 2 * SizeOf(SmallInt); - for FrameIndex := 0 to (BufSize div FrameSize)-1 do - begin - Sample := PPCMStereoSample(Buffer); - // channel difference - Value := Sample[0] - Sample[1]; - // clip - if (Value > High(SmallInt)) then - Value := High(SmallInt) - else if (Value < Low(SmallInt)) then - Value := Low(SmallInt); - // assign result - Sample[0] := Value; - Sample[1] := Value; - // increase to next frame - Inc(Buffer, FrameSize); - end; -end; - -{ TAudioConverter } - -function TAudioConverter.Init(SrcFormatInfo: TAudioFormatInfo; DstFormatInfo: TAudioFormatInfo): boolean; -begin - fSrcFormatInfo := SrcFormatInfo.Copy(); - fDstFormatInfo := DstFormatInfo.Copy(); - Result := true; -end; - -destructor TAudioConverter.Destroy(); -begin - FreeAndNil(fSrcFormatInfo); - FreeAndNil(fDstFormatInfo); -end; - - -{ TAudioProcessingStream } - -procedure TAudioProcessingStream.AddOnCloseHandler(Handler: TOnCloseHandler); -begin - if (@Handler <> nil) then - begin - SetLength(OnCloseHandlers, System.Length(OnCloseHandlers)+1); - OnCloseHandlers[High(OnCloseHandlers)] := @Handler; - end; -end; - -procedure TAudioProcessingStream.PerformOnClose(); -var i: integer; -begin - for i := 0 to High(OnCloseHandlers) do - begin - OnCloseHandlers[i](Self); - end; -end; - - -{ TAudioPlaybackStream } - -function TAudioPlaybackStream.GetSourceStream(): TAudioSourceStream; -begin - Result := SourceStream; -end; - -procedure TAudioPlaybackStream.SetSyncSource(SyncSource: ISyncSource); -begin - Self.SyncSource := SyncSource; - AvgSyncDiff := -1; -end; - -(* - * Results an adjusted size of the input buffer size to keep the stream in sync - * with the SyncSource. If no SyncSource was assigned to this stream, the - * input buffer size will be returned, so this method will have no effect. - * - * These are the possible cases: - * - Result > BufferSize: stream is behind the sync-source (stream is too slow), - * (Result-BufferSize) bytes of the buffer must be skipped. - * - Result = BufferSize: stream is in sync, - * there is nothing to do. - * - Result < BufferSize: stream is ahead of the sync-source (stream is too fast), - * (BufferSize-Result) bytes of the buffer must be padded. - *) -function TAudioPlaybackStream.Synchronize(BufferSize: integer; FormatInfo: TAudioFormatInfo): integer; -var - TimeDiff: double; - TimeCorrectionFactor: double; -const - AVG_HISTORY_FACTOR = 0.9; - SYNC_THRESHOLD = 0.045; - MAX_SYNC_DIFF_TIME = 0.002; -begin - Result := BufferSize; - - if (not assigned(SyncSource)) then - Exit; - - if (BufferSize <= 0) then - Exit; - - // difference between sync-source and stream position - // (negative if the music-stream's position is ahead of the master clock) - TimeDiff := SyncSource.GetClock() - (Position - GetLatency()); - - // calculate average time difference (some sort of weighted mean). - // The bigger AVG_HISTORY_FACTOR is, the smoother is the average diff. - // This means that older diffs are weighted more with a higher history factor - // than with a lower. Do not use a too low history factor. FFmpeg produces - // very instable timestamps (pts) for ogg due to some bugs. They may differ - // +-50ms from the real stream position. Without filtering those glitches we - // would synch without any need, resulting in ugly plopping sounds. - if (AvgSyncDiff = -1) then - AvgSyncDiff := TimeDiff - else - AvgSyncDiff := TimeDiff * (1-AVG_HISTORY_FACTOR) + - AvgSyncDiff * AVG_HISTORY_FACTOR; - - // check if sync needed - if (Abs(AvgSyncDiff) >= SYNC_THRESHOLD) then - begin - // TODO: use SetPosition if diff is too large (>5s) - if (TimeDiff < 1) then - TimeCorrectionFactor := Sign(TimeDiff)*TimeDiff*TimeDiff - else - TimeCorrectionFactor := TimeDiff; - - // calculate adapted buffer size - // reduce size of data to fetch if music is ahead, increase otherwise - Result := BufferSize + Round(TimeCorrectionFactor * FormatInfo.SampleRate) * FormatInfo.FrameSize; - if (Result < 0) then - Result := 0; - - // reset average - AvgSyncDiff := -1; - end; - - (* - DebugWriteln('Diff: ' + floattostrf(TimeDiff, ffFixed, 15, 3) + - '| SyS: ' + floattostrf(SyncSource.GetClock(), ffFixed, 15, 3) + - '| Pos: ' + floattostrf(Position, ffFixed, 15, 3) + - '| Avg: ' + floattostrf(AvgSyncDiff, ffFixed, 15, 3)); - *) -end; - -(* - * Fills a buffer with copies of the given frame or with 0 if frame. - *) -procedure TAudioPlaybackStream.FillBufferWithFrame(Buffer: PByteArray; BufferSize: integer; Frame: PByteArray; FrameSize: integer); -var - i: integer; - FrameCopyCount: integer; -begin - // the buffer must at least contain place for one copy of the frame. - if ((Buffer = nil) or (BufferSize <= 0) or (BufferSize < FrameSize)) then - Exit; - - // no valid frame -> fill with 0 - if ((Frame = nil) or (FrameSize <= 0)) then - begin - FillChar(Buffer[0], BufferSize, 0); - Exit; - end; - - // number of frames to copy - FrameCopyCount := BufferSize div FrameSize; - // insert as many copies of frame into the buffer as possible - for i := 0 to FrameCopyCount-1 do - Move(Frame[0], Buffer[i*FrameSize], FrameSize); -end; - -{ TAudioVoiceStream } - -function TAudioVoiceStream.Open(ChannelMap: integer; FormatInfo: TAudioFormatInfo): boolean; -begin - Self.ChannelMap := ChannelMap; - Self.FormatInfo := FormatInfo.Copy(); - // a voice stream is always mono, reassure the the format is correct - Self.FormatInfo.Channels := 1; - Result := true; -end; - -destructor TAudioVoiceStream.Destroy; -begin - Close(); - inherited; -end; - -procedure TAudioVoiceStream.Close(); -begin - PerformOnClose(); - FreeAndNil(FormatInfo); -end; - -function TAudioVoiceStream.GetAudioFormatInfo(): TAudioFormatInfo; -begin - Result := FormatInfo; -end; - -function TAudioVoiceStream.GetLength(): real; -begin - Result := -1; -end; - -function TAudioVoiceStream.GetPosition(): real; -begin - Result := -1; -end; - -procedure TAudioVoiceStream.SetPosition(Time: real); -begin -end; - -function TAudioVoiceStream.GetLoop(): boolean; -begin - Result := false; -end; - -procedure TAudioVoiceStream.SetLoop(Enabled: boolean); -begin -end; - - -end. diff --git a/src/base/UNote.pas b/src/base/UNote.pas deleted file mode 100644 index 8e5b709a..00000000 --- a/src/base/UNote.pas +++ /dev/null @@ -1,591 +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 UNote; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses - SysUtils, - Classes, - SDL, - UMusic, - URecord, - UTime, - UDisplay, - UIni, - ULog, - ULyrics, - UScreenSing, - USong, - gl; - -type - PPLayerNote = ^TPlayerNote; - TPlayerNote = record - Start: integer; - Length: integer; - Detect: real; // accurate place, detected in the note - Tone: real; - Perfect: boolean; // true if the note matches the original one, light the star - Hit: boolean; // true if the note hits the line - end; - - PPLayer = ^TPlayer; - TPlayer = record - Name: UTF8String; - - // Index in Teaminfo record - TeamID: byte; - PlayerID: byte; - - // Scores - Score: real; - ScoreLine: real; - ScoreGolden: real; - - ScoreInt: integer; - ScoreLineInt: integer; - ScoreGoldenInt: integer; - ScoreTotalInt: integer; - - // LineBonus - ScoreLast: real; // Last Line Score - - // PerfectLineTwinkle (effect) - LastSentencePerfect: boolean; - - HighNote: integer; // index of last note (= High(Note)?) - LengthNote: integer; // number of notes (= Length(Note)?). - Note: array of TPlayerNote; - end; - -var - - // player and music info - Player: array of TPlayer; - PlayersPlay: integer; - - CurrentSong: TSong; - -const - MAX_SONG_SCORE = 10000; // max. achievable points per song - MAX_SONG_LINE_BONUS = 1000; // max. achievable line bonus per song - -procedure Sing(Screen: TScreenSing); -procedure NewSentence(Screen: TScreenSing); -procedure NewBeatClick(Screen: TScreenSing); // executed when on then new beat for click -procedure NewBeatDetect(Screen: TScreenSing); // executed when on then new beat for detection -procedure NewNote(Screen: TScreenSing); // detect note -function GetMidBeat(Time: real): real; -function GetTimeFromBeat(Beat: integer): real; - -implementation - -uses - Math, - StrUtils, - USongs, - UJoystick, - UCommandLine, - ULanguage, - //SDL_ttf, - USkins, - UCovers, - UCatCovers, - UDataBase, - UPlaylist, - UDLLManager, - UParty, - UConfig, - UCommon, - UGraphic, - UGraphicClasses, - UPathUtils, - UPlatform, - UThemes; - -function GetTimeForBeats(BPM, Beats: real): real; -begin - Result := 60 / BPM * Beats; -end; - -function GetBeats(BPM, msTime: real): real; -begin - Result := BPM * msTime / 60; -end; - -procedure GetMidBeatSub(BPMNum: integer; var Time: real; var CurBeat: real); -var - NewTime: real; -begin - if High(CurrentSong.BPM) = BPMNum then - begin - // last BPM - CurBeat := CurrentSong.BPM[BPMNum].StartBeat + GetBeats(CurrentSong.BPM[BPMNum].BPM, Time); - Time := 0; - end - else - begin - // not last BPM - // count how much time is it for start of the new BPM and store it in NewTime - NewTime := GetTimeForBeats(CurrentSong.BPM[BPMNum].BPM, CurrentSong.BPM[BPMNum+1].StartBeat - CurrentSong.BPM[BPMNum].StartBeat); - - // compare it to remaining time - if (Time - NewTime) > 0 then - begin - // there is still remaining time - CurBeat := CurrentSong.BPM[BPMNum].StartBeat; - Time := Time - NewTime; - end - else - begin - // there is no remaining time - CurBeat := CurrentSong.BPM[BPMNum].StartBeat + GetBeats(CurrentSong.BPM[BPMNum].BPM, Time); - Time := 0; - end; // if - end; // if -end; - -function GetMidBeat(Time: real): real; -var - CurBeat: real; - CurBPM: integer; -begin - // static BPM - if Length(CurrentSong.BPM) = 1 then - begin - Result := Time * CurrentSong.BPM[0].BPM / 60; - end - // variable BPM - else if Length(CurrentSong.BPM) > 1 then - begin - CurBeat := 0; - CurBPM := 0; - while (Time > 0) do - begin - GetMidBeatSub(CurBPM, Time, CurBeat); - Inc(CurBPM); - end; - - Result := CurBeat; - end - // invalid BPM - else - begin - Result := 0; - end; -end; - -function GetTimeFromBeat(Beat: integer): real; -var - CurBPM: integer; -begin - // static BPM - if Length(CurrentSong.BPM) = 1 then - begin - Result := CurrentSong.GAP / 1000 + Beat * 60 / CurrentSong.BPM[0].BPM; - end - // variable BPM - else if Length(CurrentSong.BPM) > 1 then - begin - Result := CurrentSong.GAP / 1000; - CurBPM := 0; - while (CurBPM <= High(CurrentSong.BPM)) and - (Beat > CurrentSong.BPM[CurBPM].StartBeat) do - begin - if (CurBPM < High(CurrentSong.BPM)) and - (Beat >= CurrentSong.BPM[CurBPM+1].StartBeat) then - begin - // full range - Result := Result + (60 / CurrentSong.BPM[CurBPM].BPM) * - (CurrentSong.BPM[CurBPM+1].StartBeat - CurrentSong.BPM[CurBPM].StartBeat); - end; - - if (CurBPM = High(CurrentSong.BPM)) or - (Beat < CurrentSong.BPM[CurBPM+1].StartBeat) then - begin - // in the middle - Result := Result + (60 / CurrentSong.BPM[CurBPM].BPM) * - (Beat - CurrentSong.BPM[CurBPM].StartBeat); - end; - Inc(CurBPM); - end; - - { - while (Time > 0) do - begin - GetMidBeatSub(CurBPM, Time, CurBeat); - Inc(CurBPM); - end; - } - end - // invalid BPM - else - begin - Result := 0; - end; -end; - -procedure Sing(Screen: TScreenSing); -var - Count: integer; - CountGr: integer; - CP: integer; -begin - LyricsState.UpdateBeats(); - - // sentences routines - for CountGr := 0 to 0 do //High(Lines) - begin; - CP := CountGr; - // old parts - LyricsState.OldLine := Lines[CP].Current; - - // choose current parts - for Count := 0 to Lines[CP].High do - begin - if LyricsState.CurrentBeat >= Lines[CP].Line[Count].Start then - Lines[CP].Current := Count; - end; - - // clean player note if there is a new line - // (optimization on halfbeat time) - if Lines[CP].Current <> LyricsState.OldLine then - NewSentence(Screen); - - end; // for CountGr - - // make some operations on clicks - if {(LyricsState.CurrentBeatC >= 0) and }(LyricsState.OldBeatC <> LyricsState.CurrentBeatC) then - NewBeatClick(Screen); - - // make some operations when detecting new voice pitch - if (LyricsState.CurrentBeatD >= 0) and (LyricsState.OldBeatD <> LyricsState.CurrentBeatD) then - NewBeatDetect(Screen); -end; - -procedure NewSentence(Screen: TScreenSing); -var - i: integer; -begin - // clean note of player - for i := 0 to High(Player) do - begin - Player[i].LengthNote := 0; - Player[i].HighNote := -1; - SetLength(Player[i].Note, 0); - end; - - // on sentence change... - Screen.onSentenceChange(Lines[0].Current); -end; - -procedure NewBeatClick; -var - Count: integer; -begin - // beat click - if ((Ini.BeatClick = 1) and - ((LyricsState.CurrentBeatC + Lines[0].Resolution + Lines[0].NotesGAP) mod Lines[0].Resolution = 0)) then - begin - AudioPlayback.PlaySound(SoundLib.Click); - end; - - for Count := 0 to Lines[0].Line[Lines[0].Current].HighNote do - begin - if (Lines[0].Line[Lines[0].Current].Note[Count].Start = LyricsState.CurrentBeatC) then - begin - // click assist - if Ini.ClickAssist = 1 then - AudioPlayback.PlaySound(SoundLib.Click); - - // drum machine - (* - TempBeat := LyricsState.CurrentBeat; // + 2; - if (TempBeat mod 8 = 0) then Music.PlayDrum; - if (TempBeat mod 8 = 4) then Music.PlayClap; - //if (TempBeat mod 4 = 2) then Music.PlayHihat; - if (TempBeat mod 4 <> 0) then Music.PlayHihat; - *) - end; - end; -end; - -procedure NewBeatDetect(Screen: TScreenSing); -begin - NewNote(Screen); -end; - -procedure NewNote(Screen: TScreenSing); -var - LineFragmentIndex: integer; - CurrentLineFragment: PLineFragment; - PlayerIndex: integer; - CurrentSound: TCaptureBuffer; - CurrentPlayer: PPlayer; - LastPlayerNote: PPlayerNote; - Line: PLine; - SentenceIndex: integer; - SentenceMin: integer; - SentenceMax: integer; - SentenceDetected: integer; // sentence of detected note - NoteAvailable: boolean; - NewNote: boolean; - Range: integer; - NoteHit: boolean; - MaxSongPoints: integer; // max. points for the song (without line bonus) - CurNotePoints: real; // Points for the cur. Note (PointsperNote * ScoreFactor[CurNote]) -begin - // TODO: add duet mode support - // use Lines[LineSetIndex] with LineSetIndex depending on the current player - - // count min and max sentence range for checking - // (detection is delayed to the notes we see on the screen) - SentenceMin := Lines[0].Current-1; - if (SentenceMin < 0) then - SentenceMin := 0; - SentenceMax := Lines[0].Current; - - // check for an active note at the current time defined in the lyrics - NoteAvailable := false; - SentenceDetected := SentenceMin; - for SentenceIndex := SentenceMin to SentenceMax do - begin - Line := @Lines[0].Line[SentenceIndex]; - for LineFragmentIndex := 0 to Line.HighNote do - begin - CurrentLineFragment := @Line.Note[LineFragmentIndex]; - // check if line is active - if ((CurrentLineFragment.Start <= LyricsState.CurrentBeatD) and - (CurrentLineFragment.Start + CurrentLineFragment.Length-1 >= LyricsState.CurrentBeatD)) and - (CurrentLineFragment.NoteType <> ntFreestyle) and // but ignore FreeStyle notes - (CurrentLineFragment.Length > 0) then // and make sure the note length is at least 1 - begin - SentenceDetected := SentenceIndex; - NoteAvailable := true; - Break; - end; - end; - // TODO: break here, if NoteAvailable is true? We would then use the first instead - // of the last note matching the current beat if notes overlap. But notes - // should not overlap at all. - // if (NoteAvailable) then - // Break; - end; - - // analyze player signals - for PlayerIndex := 0 to PlayersPlay-1 do - begin - CurrentPlayer := @Player[PlayerIndex]; - CurrentSound := AudioInputProcessor.Sound[PlayerIndex]; - - // at the beginning of the song there is no previous note - if (Length(CurrentPlayer.Note) > 0) then - LastPlayerNote := @CurrentPlayer.Note[CurrentPlayer.HighNote] - else - LastPlayerNote := nil; - - // analyze buffer - CurrentSound.AnalyzeBuffer; - - // add some noise - // TODO: do we need this? - //LyricsState.Tone := LyricsState.Tone + Round(Random(3)) - 1; - - // add note if possible - if (CurrentSound.ToneValid and NoteAvailable) then - begin - Line := @Lines[0].Line[SentenceDetected]; - - // process until last note - for LineFragmentIndex := 0 to Line.HighNote do - begin - CurrentLineFragment := @Line.Note[LineFragmentIndex]; - if (CurrentLineFragment.Start <= LyricsState.OldBeatD+1) and - (CurrentLineFragment.Start + CurrentLineFragment.Length > LyricsState.OldBeatD+1) then - begin - // compare notes (from song-file and from player) - - // move players tone to proper octave - while (CurrentSound.Tone - CurrentLineFragment.Tone > 6) do - CurrentSound.Tone := CurrentSound.Tone - 12; - - while (CurrentSound.Tone - CurrentLineFragment.Tone < -6) do - CurrentSound.Tone := CurrentSound.Tone + 12; - - // half size notes patch - NoteHit := false; - - // if Ini.Difficulty = 0 then Range := 2; - // if Ini.Difficulty = 1 then Range := 1; - // if Ini.Difficulty = 2 then Range := 0; - Range := 2 - Ini.Difficulty; - - // check if the player hit the correct tone within the tolerated range - if (Abs(CurrentLineFragment.Tone - CurrentSound.Tone) <= Range) then - begin - // adjust the players tone to the correct one - // TODO: do we need to do this? - // Philipp: I think we do, at least when we draw the notes. - // Otherwise the notehit thing would be shifted to the - // correct unhit note. I think this will look kind of strange. - CurrentSound.Tone := CurrentLineFragment.Tone; - - // half size notes patch - NoteHit := true; - - if (Ini.LineBonus > 0) then - MaxSongPoints := MAX_SONG_SCORE - MAX_SONG_LINE_BONUS - else - MaxSongPoints := MAX_SONG_SCORE; - - // Note: ScoreValue is the sum of all note values of the song - // (MaxSongPoints / ScoreValue) is the points that a player - // gets for a hit of one beat of a normal note - // CurNotePoints is the amount of points that is meassured - // for a hit of the note per full beat - CurNotePoints := (MaxSongPoints / Lines[0].ScoreValue) * ScoreFactor[CurrentLineFragment.NoteType]; - - case CurrentLineFragment.NoteType of - ntNormal: CurrentPlayer.Score := CurrentPlayer.Score + CurNotePoints; - ntGolden: CurrentPlayer.ScoreGolden := CurrentPlayer.ScoreGolden + CurNotePoints; - end; - - // a problem if we use floor instead of round is that a score of - // 10000 points is only possible if the last digit of the total points - // for golden and normal notes is 0. - // if we use round, the max score is 10000 for most songs - // but a score of 10010 is possible if the last digit of the total - // points for golden and normal notes is 5 - // the best solution is to use round for one of these scores - // and round the other score in the opposite direction - // so we assure that the highest possible score is 10000 in every case. - CurrentPlayer.ScoreInt := round(CurrentPlayer.Score / 10) * 10; - - if (CurrentPlayer.ScoreInt < CurrentPlayer.Score) then - //normal score is floored so we have to ceil golden notes score - CurrentPlayer.ScoreGoldenInt := ceil(CurrentPlayer.ScoreGolden / 10) * 10 - else - //normal score is ceiled so we have to floor golden notes score - CurrentPlayer.ScoreGoldenInt := floor(CurrentPlayer.ScoreGolden / 10) * 10; - - - CurrentPlayer.ScoreTotalInt := CurrentPlayer.ScoreInt + - CurrentPlayer.ScoreGoldenInt + - CurrentPlayer.ScoreLineInt; - end; - - end; // operation - end; // for - - // check if we have to add a new note or extend the note's length - if (SentenceDetected = SentenceMax) then - begin - // we will add a new note - NewNote := true; - - // if previous note (if any) was the same, extend previous note - if ((CurrentPlayer.LengthNote > 0) and - (LastPlayerNote <> nil) and - (LastPlayerNote.Tone = CurrentSound.Tone) and - ((LastPlayerNote.Start + LastPlayerNote.Length) = LyricsState.CurrentBeatD)) then - begin - NewNote := false; - end; - - // if is not as new note to control - for LineFragmentIndex := 0 to Line.HighNote do - begin - if (Line.Note[LineFragmentIndex].Start = LyricsState.CurrentBeatD) then - NewNote := true; - end; - - // add new note - if NewNote then - begin - // new note - Inc(CurrentPlayer.LengthNote); - Inc(CurrentPlayer.HighNote); - SetLength(CurrentPlayer.Note, CurrentPlayer.LengthNote); - - // update player's last note - LastPlayerNote := @CurrentPlayer.Note[CurrentPlayer.HighNote]; - with LastPlayerNote^ do - begin - Start := LyricsState.CurrentBeatD; - Length := 1; - Tone := CurrentSound.Tone; // Tone || ToneAbs - Detect := LyricsState.MidBeat; - Hit := NoteHit; // half note patch - end; - end - else - begin - // extend note length - if (LastPlayerNote <> nil) then - Inc(LastPlayerNote.Length); - end; - - // check for perfect note and then light the star (on Draw) - for LineFragmentIndex := 0 to Line.HighNote do - begin - CurrentLineFragment := @Line.Note[LineFragmentIndex]; - if (CurrentLineFragment.Start = LastPlayerNote.Start) and - (CurrentLineFragment.Length = LastPlayerNote.Length) and - (CurrentLineFragment.Tone = LastPlayerNote.Tone) then - begin - LastPlayerNote.Perfect := true; - end; - end; - end; // if SentenceDetected = SentenceMax - - end; // if Detected - end; // for PlayerIndex - - //Log.LogStatus('EndBeat', 'NewBeat'); - - // on sentence end -> for LineBonus and display of SingBar (rating pop-up) - if (SentenceDetected >= Low(Lines[0].Line)) and - (SentenceDetected <= High(Lines[0].Line)) then - begin - Line := @Lines[0].Line[SentenceDetected]; - CurrentLineFragment := @Line.Note[Line.HighNote]; - if ((CurrentLineFragment.Start + CurrentLineFragment.Length - 1) = LyricsState.CurrentBeatD) then - begin - if assigned(Screen) then - Screen.OnSentenceEnd(SentenceDetected); - end; - end; - -end; - -end. diff --git a/src/base/UParty.pas b/src/base/UParty.pas deleted file mode 100644 index 52eb5a05..00000000 --- a/src/base/UParty.pas +++ /dev/null @@ -1,388 +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 UParty; - -interface - -{$IFDEF FPC} - {$MODE DELPHI} -{$ENDIF} - -{$I switches.inc} - -uses - ModiSDK; - -type - TRoundInfo = record - Plugin: word; - Winner: byte; - end; - - TeamOrderEntry = record - TeamNum: byte; - Score: byte; - end; - - TeamOrderArray = array[0..5] of byte; - - TPartyPlugin = record - ID: byte; - TimesPlayed: byte; - end; - - TPartySession = class - private - function GetRandomPlayer(Team: byte): byte; - function GetRandomPlugin(Plugins: array of TPartyPlugin): byte; - function IsWinner(Player, Winner: byte): boolean; - procedure GenScores; - public - Teams: TTeamInfo; - Rounds: array of TRoundInfo; - CurRound: byte; - - constructor Create; - - procedure StartNewParty(NumRounds: byte); - procedure StartRound; - procedure EndRound; - function GetTeamOrder: TeamOrderArray; - function GetWinnerString(Round: byte): UTF8String; - end; - -var - PartySession: TPartySession; - -implementation - -uses - UDLLManager, - UGraphic, - UNote, - ULanguage, - ULog; - -constructor TPartySession.Create; -begin - inherited; -end; - -//---------- -// Returns a number of a random plugin -//---------- -function TPartySession.GetRandomPlugin(Plugins: array of TPartyPlugin): byte; -var - LowestTP: byte; - NumPwithLTP: word; - I: integer; - R: word; -begin - LowestTP := high(byte); - NumPwithLTP := 0; - - //Search for Plugins not often played yet - for I := 0 to high(Plugins) do - begin - if (Plugins[I].TimesPlayed < lowestTP) then - begin - lowestTP := Plugins[I].TimesPlayed; - NumPwithLTP := 1; - end - else if (Plugins[I].TimesPlayed = lowestTP) then - begin - Inc(NumPwithLTP); - end; - end; - - //Create random no - R := Random(NumPwithLTP); - - //Search for random plugin - for I := 0 to high(Plugins) do - begin - if Plugins[I].TimesPlayed = LowestTP then - begin - //Plugin found - if (R = 0) then - begin - Result := Plugins[I].ID; - Inc(Plugins[I].TimesPlayed); - Break; - end; - Dec(R); - end; - end; -end; - -//---------- -//StartNewParty - Reset and prepares for new party -//---------- -procedure TPartySession.StartNewParty(NumRounds: byte); -var - Plugins: array of TPartyPlugin; - TeamMode: boolean; - Len: integer; - I, J: integer; -begin - //Set current round to 1 - CurRound := 255; - - PlayersPlay := Teams.NumTeams; - - //Get team-mode and set joker, also set TimesPlayed - TeamMode := true; - for I := 0 to Teams.NumTeams - 1 do - begin - if Teams.Teaminfo[I].NumPlayers < 2 then - begin - TeamMode := false; - end; - //Set player attributes - for J := 0 to Teams.TeamInfo[I].NumPlayers-1 do - begin - Teams.TeamInfo[I].Playerinfo[J].TimesPlayed := 0; - end; - Teams.Teaminfo[I].Joker := Round(NumRounds * 0.7); - Teams.Teaminfo[I].Score := 0; - end; - - //Fill plugin array - SetLength(Plugins, 0); - for I := 0 to high(DLLMan.Plugins) do - 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; - end; - - //Set rounds - if (Length(Plugins) >= 1) then - begin - SetLength (Rounds, NumRounds); - for I := 0 to NumRounds - 1 do - begin - PartySession.Rounds[I].Plugin := GetRandomPlugin(Plugins); - PartySession.Rounds[I].Winner := 255; - end; - end - else - SetLength (Rounds, 0); -end; - -{** - * Returns a random player to play next round - *} -function TPartySession.GetRandomPlayer(Team: byte): byte; -var - I, R: integer; - LowestTP: byte; - NumPwithLTP: byte; -begin - LowestTP := high(byte); - NumPwithLTP := 0; - Result := 0; - - //Search for players that have not often played yet - for I := 0 to Teams.Teaminfo[Team].NumPlayers - 1 do - begin - if (Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed < lowestTP) then - begin - lowestTP := Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed; - NumPwithLTP := 1; - end - else if (Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed = lowestTP) then - begin - Inc(NumPwithLTP); - end; - end; - - //Create random number - R := Random(NumPwithLTP); - - //Search for random player - for I := 0 to Teams.Teaminfo[Team].NumPlayers - 1 do - begin - if Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed = lowestTP then - begin - //Player found - if (R = 0) then - begin - Result := I; - Break; - end; - - Dec(R); - end; - end; -end; - -{** - * Prepares ScreenSingModi for next round and loads plugin - *} -procedure TPartySession.StartRound; -var - I: integer; -begin - if ((CurRound < high(Rounds)) or (CurRound = high(CurRound))) then - begin - // Increase Current Round but not beyond its limit - // CurRound is set to 255 to begin with! - // Ugly solution if you ask me. - if CurRound < high(CurRound) then - Inc(CurRound) - else - CurRound := 0; - - Rounds[CurRound].Winner := 255; - DllMan.LoadPlugin(Rounds[CurRound].Plugin); - - //Select Players - for I := 0 to Teams.NumTeams - 1 do - Teams.Teaminfo[I].CurPlayer := GetRandomPlayer(I); - - //Set ScreenSingModie Variables - ScreenSingModi.TeamInfo := Teams; - end; -end; - -//---------- -//EndRound - Get Winner from ScreenSingModi and Save Data to RoundArray -//---------- -procedure TPartySession.EndRound; -var - I: Integer; -begin - //Copy Winner - Rounds[CurRound].Winner := ScreenSingModi.Winner; - //Set Scores - GenScores; - - //Increase TimesPlayed 4 all Players - For I := 0 to Teams.NumTeams-1 do - Inc(Teams.Teaminfo[I].Playerinfo[Teams.Teaminfo[I].CurPlayer].TimesPlayed); - -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; -begin - Mask := 1 shl Player; - Result := (Winner and Mask) <> 0; -end; - -//---------- -//GenScores - increase scores for current round -//---------- -procedure TPartySession.GenScores; -var - I: byte; -begin - for I := 0 to Teams.NumTeams - 1 do - begin - if isWinner(I, Rounds[CurRound].Winner) then - Inc(Teams.Teaminfo[I].Score); - end; -end; - -//---------- -//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; -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 - begin - ATeams[I].Teamnum := I; - ATeams[I].Score := Teams.Teaminfo[I].Score; - end; - - //Sort teams - for J := 0 to Teams.NumTeams - 1 do - for I := 1 to Teams.NumTeams - 1 do - if ATeams[I].Score > ATeams[I-1].Score then - begin - TempTeam := ATeams[I-1]; - ATeams[I-1] := ATeams[I]; - ATeams[I] := TempTeam; - end; - - //Copy to Result - for I := 0 to Teams.NumTeams-1 do - Result[I] := ATeams[I].TeamNum; -end; - -//---------- -//GetWinnerString - Get string with WinnerTeam Name, when there is more than one Winner than Connect with and or , -//---------- -function TPartySession.GetWinnerString(Round: byte): UTF8String; -var - Winners: array of UTF8String; - I: integer; -begin - Result := Language.Translate('PARTY_NOBODY'); - - if (Round > High(Rounds)) then - exit; - - if (Rounds[Round].Winner = 0) then - begin - exit; - end; - - 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 - begin - if isWinner(I, Rounds[Round].Winner) then - begin - SetLength(Winners, Length(Winners) + 1); - Winners[high(Winners)] := Teams.TeamInfo[I].Name; - end; - end; - Result := Language.Implode(Winners); -end; - -end. diff --git a/src/base/UPathUtils.pas b/src/base/UPathUtils.pas deleted file mode 100644 index c2bcdd4b..00000000 --- a/src/base/UPathUtils.pas +++ /dev/null @@ -1,196 +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 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/src/base/UPlatform.pas b/src/base/UPlatform.pas deleted file mode 100644 index 11c67fa7..00000000 --- a/src/base/UPlatform.pas +++ /dev/null @@ -1,135 +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 UPlatform; - -// Comment by Eddie: -// This unit defines an interface for platform specific utility functions. -// The Interface is implemented in separate files for each platform: -// UPlatformWindows, UPlatformLinux and UPlatformMacOSX. - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses - Classes, - UPath; - -type - TPlatform = class - function GetExecutionDir(): IPath; - procedure Init; virtual; - - function TerminateIfAlreadyRunning(var WndTitle: string): boolean; virtual; - procedure Halt; virtual; - - function GetLogPath: IPath; virtual; abstract; - function GetGameSharedPath: IPath; virtual; abstract; - function GetGameUserPath: IPath; virtual; abstract; - end; - - function Platform(): TPlatform; - -implementation - -uses - SysUtils, - {$IF Defined(MSWINDOWS)} - UPlatformWindows, - {$ELSEIF Defined(DARWIN)} - UPlatformMacOSX, - {$ELSEIF Defined(UNIX)} - UPlatformLinux, - {$IFEND} - ULog, - UUnicodeUtils, - UFilesystem; - - -// I modified it to use the Platform_singleton in this location (in the implementation) -// so that this variable can NOT be overwritten from anywhere else in the application. -// the accessor function platform, emulates all previous calls to work the same way. -var - Platform_singleton: TPlatform; - -function Platform: TPlatform; -begin - Result := Platform_singleton; -end; - -(** - * Default Init() implementation - *) -procedure TPlatform.Init; -begin -end; - -(** - * Default Halt() implementation - *) -procedure TPlatform.Halt; -begin - // Note: Application.terminate is NOT the same - System.Halt; -end; - -{** - * Returns the directory of the executable - *} -function TPlatform.GetExecutionDir(): IPath; -var - ExecName, ExecDir: IPath; -begin - ExecName := Path(ParamStr(0)); - ExecDir := ExecName.GetPath; - Result := ExecDir.GetAbsolutePath(); -end; - -(** - * Default TerminateIfAlreadyRunning() implementation - *) -function TPlatform.TerminateIfAlreadyRunning(var WndTitle: string): boolean; -begin - Result := false; -end; - -initialization -{$IF Defined(MSWINDOWS)} - Platform_singleton := TPlatformWindows.Create; -{$ELSEIF Defined(DARWIN)} - Platform_singleton := TPlatformMacOSX.Create; -{$ELSEIF Defined(UNIX)} - Platform_singleton := TPlatformLinux.Create; -{$IFEND} - -finalization - Platform_singleton.Free; - -end. diff --git a/src/base/UPlatformLinux.pas b/src/base/UPlatformLinux.pas deleted file mode 100644 index 693facaa..00000000 --- a/src/base/UPlatformLinux.pas +++ /dev/null @@ -1,149 +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 UPlatformLinux; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses - Classes, - UPlatform, - UConfig, - UPath; - -type - TPlatformLinux = class(TPlatform) - private - UseLocalDirs: boolean; - - procedure DetectLocalExecution(); - function GetHomeDir(): IPath; - public - procedure Init; override; - - function GetLogPath : IPath; override; - function GetGameSharedPath : IPath; override; - function GetGameUserPath : IPath; override; - end; - -implementation - -uses - UCommandLine, - BaseUnix, - pwd, - SysUtils, - ULog; - -const - {$I paths.inc} - -procedure TPlatformLinux.Init; -begin - inherited Init(); - DetectLocalExecution(); -end; - -{** - * Detects whether the game was executed locally or globally. - * - It is local if it was not installed and directly executed from - * within the game folder. In this case resources (themes, language-files) - * reside in the directory of the executable. - * - It is global if the game was installed (e.g. to /usr/bin) and - * the resources are in a separate folder (e.g. /usr/share/ultrastardx) - * which name is stored in the INSTALL_DATADIR constant in paths.inc. - * - * Sets UseLocalDirs to true if the game is executed locally, false otherwise. - *} -procedure TPlatformLinux.DetectLocalExecution(); -var - LocalDir, LanguageDir: IPath; -begin - // we just check if the 'languages' folder exists in the - // directory of the executable. If so -> local execution. - LocalDir := GetExecutionDir(); - LanguageDir := LocalDir.Append('languages'); - UseLocalDirs := LanguageDir.IsDirectory; -end; - -function TPlatformLinux.GetLogPath: IPath; -begin - if UseLocalDirs then - Result := GetExecutionDir() - else - Result := GetGameUserPath().Append('logs', pdAppend); - - // create non-existing directories - Result.CreateDirectory(true); -end; - -function TPlatformLinux.GetGameSharedPath: IPath; -begin - if UseLocalDirs then - Result := GetExecutionDir() - else - Result := Path(INSTALL_DATADIR, pdAppend); -end; - -function TPlatformLinux.GetGameUserPath: IPath; -begin - if UseLocalDirs then - Result := GetExecutionDir() - else - Result := GetHomeDir().Append('.ultrastardx', pdAppend); -end; - -{** - * Returns the user's home directory terminated by a path delimiter - *} -function TPlatformLinux.GetHomeDir(): IPath; -var - PasswdEntry: PPasswd; -begin - Result := PATH_NONE; - - // try to retrieve the info from passwd - PasswdEntry := FpGetpwuid(FpGetuid()); - if (PasswdEntry <> nil) then - Result := Path(PasswdEntry.pw_dir); - // fallback if passwd does not contain the path - if (Result.IsUnset) then - Result := Path(GetEnvironmentVariable('HOME')); - // add trailing path delimiter (normally '/') - if (Result.IsSet) then - Result := Result.AppendPathDelim(); - - // GetUserDir() is another function that returns a user path. - // It uses env-var HOME or a fallback to a temp-dir. - //Result := GetUserDir(); -end; - -end. diff --git a/src/base/UPlatformMacOSX.pas b/src/base/UPlatformMacOSX.pas deleted file mode 100644 index 1dc0014a..00000000 --- a/src/base/UPlatformMacOSX.pas +++ /dev/null @@ -1,279 +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 UPlatformMacOSX; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses - Classes, - ULog, - UPlatform, - UFilesystem, - UPath; - -type - {** - * @abstract(Provides Mac OS X specific details.) - * @lastmod(August 1, 2008) - * The UPlatformMacOSX unit takes care of setting paths to resource folders. - * - * (Note for non-Maccies: "folder" is the Mac name for directory.) - * - * Note on the resource folders: - * 1. Installation of an application on the mac works as follows: Extract and - * copy an application and if you don't like or need the application - * anymore you move the folder to the trash - and you're done. - * 2. The use of folders in the user's home directory is against Apple's - * guidelines and strange to an average user. - * 3. Even worse is using /usr/local/... since all lowercase folders in / are - * not visible to an average user in the Finder, at least not without some - * "tricks". - * - * The best way would be to store everything within the application bundle. - * However, this requires USDX to offer the handling of the resources. Until - * this is implemented, the second best solution is as follows: - * - * According to Aple guidelines handling of resources and folders should follow - * these lines: - * - * Acceptable places for files are folders named UltraStarDeluxe either in - * /Library/Application Support/ - * or - * ~/Library/Application Support/ - * - * So - * GetGameSharedPath could return - * /Library/Application Support/UltraStarDeluxe/. - * GetGameUserPath could return - * ~/Library/Application Support/UltraStarDeluxe/. - * - * Right now, only $HOME/Library/Application Support/UltraStarDeluxe - * is used. So every user needs the complete set of files and folders. - * Future versions may also use shared resources in - * /Library/Application Support/UltraStarDeluxe. However, this is - * not treated yet in the code outside this unit. - * - * USDX checks, whether GetGameUserPath exists. If not, USDX creates it. - * The existence of needed files is then checked and if a file is missing - * it is copied to there from within the folder Contents in the Application - * bundle, which contains the default files. USDX should not delete files or - * folders in Application Support/UltraStarDeluxe automatically or without - * user confirmation. - *} - TPlatformMacOSX = class(TPlatform) - private - {** - * GetBundlePath returns the path to the application bundle - * UltraStarDeluxe.app. - *} - function GetBundlePath: IPath; - - {** - * GetApplicationSupportPath returns the path to - * $HOME/Library/Application Support/UltraStarDeluxe. - *} - 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 - * folder UltraStarDeluxe.app/Contents for all files and - * folders. $HOME/Library/Application Support/UltraStarDeluxe - * is then checked for their presence and missing ones are copied. - *} - procedure Init; override; - - {** - * GetLogPath returns the path for log messages. Currently it is set to - * $HOME/Library/Application Support/UltraStarDeluxe/Log. - *} - 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 : 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 : IPath; override; - end; - -implementation - -uses - SysUtils; - -procedure TPlatformMacOSX.Init; -begin - CreateUserFolders(); -end; - -procedure TPlatformMacOSX.CreateUserFolders(); -var - 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: 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: IPath; - Iter: IFileIterator; - FileInfo: TFileInfo; - CurPath: IPath; - // These two lists contain all folder and file names found - // within the folder @link(BaseDir). - 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; - I: longint; - // These three are for creating directories, due to possible symlinks - CreatedDirectory: boolean; - FileAttrs: integer; - DirectoryPath: IPath; - UserPath: IPath; - SrcFile, TgtFile: IPath; -begin - // Get the current folder and save it in OldBaseDir for returning to it, when - // finished. - OldBaseDir := FileSystem.GetCurrentDir(); - - // 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. - UserPath := GetGameUserPath(); - - DirectoryIsFinished := 0; - // replace with IInterfaceList - DirectoryList := TInterfaceList.Create(); - FileList := TInterfaceList.Create(); - DirectoryList.Add(Path('.')); - - // create the folder and file lists - repeat - RelativePath := (DirectoryList[DirectoryIsFinished] as IPath); - FileSystem.SetCurrentDir(BaseDir.Append(RelativePath)); - Iter := FileSystem.FileFind(Path('*'), faAnyFile); - while (Iter.HasNext) do - begin - FileInfo := Iter.Next; - CurPath := FileInfo.Name; - if CurPath.IsDirectory() then - begin - if (not CurPath.Equals('.')) and (not CurPath.Equals('..')) then - DirectoryList.Add(RelativePath.Append(CurPath)); - end - else - Filelist.Add(RelativePath.Append(CurPath)); - end; - Inc(DirectoryIsFinished); - until (DirectoryIsFinished = DirectoryList.Count); - - // create missing folders - UserPath.CreateDirectory(true); // should not be necessary since (UserPathName+'/.') is created. - for I := 0 to DirectoryList.Count-1 do - begin - 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 "'+ DirectoryPath.ToNative +'"', - 'TPlatformMacOSX.CreateUserFolders'); - end; - - // copy missing files - for I := 0 to Filelist.Count-1 do - begin - CurPath := Filelist[I] as IPath; - SrcFile := BaseDir.Append(CurPath); - TgtFile := UserPath.Append(CurPath); - SrcFile.CopyFile(TgtFile, true); - end; - - // go back to the initial folder - FileSystem.SetCurrentDir(OldBaseDir); -end; - -function TPlatformMacOSX.GetBundlePath: IPath; -begin - // Mac applications are packaged in folders. - // Cutting the last two folders yields the application folder. - Result := GetExecutionDir().GetParent().GetParent(); -end; - -function TPlatformMacOSX.GetApplicationSupportPath: IPath; -const - PathName: string = 'Library/Application Support/UltraStarDeluxe'; -begin - Result := GetHomeDir().Append(PathName, pdAppend); -end; - -function TPlatformMacOSX.GetHomeDir(): IPath; -begin - Result := Path(GetEnvironmentVariable('HOME')); -end; - -function TPlatformMacOSX.GetLogPath: IPath; -begin - Result := GetApplicationSupportPath.Append('Logs'); -end; - -function TPlatformMacOSX.GetGameSharedPath: IPath; -begin - Result := GetApplicationSupportPath; -end; - -function TPlatformMacOSX.GetGameUserPath: IPath; -begin - Result := GetApplicationSupportPath; -end; - -end. diff --git a/src/base/UPlatformWindows.pas b/src/base/UPlatformWindows.pas deleted file mode 100644 index a0372dad..00000000 --- a/src/base/UPlatformWindows.pas +++ /dev/null @@ -1,128 +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 UPlatformWindows; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -// turn off messages for platform specific symbols -{$WARN SYMBOL_PLATFORM OFF} - -uses - Classes, - UPlatform, - UPath; - -type - TPlatformWindows = class(TPlatform) - private - function GetSpecialPath(CSIDL: integer): IPath; - public - function TerminateIfAlreadyRunning(var WndTitle: String): Boolean; override; - - function GetLogPath: IPath; override; - function GetGameSharedPath: IPath; override; - function GetGameUserPath: IPath; override; - end; - -implementation - -uses - SysUtils, - ShlObj, - Windows, - UConfig; - -//------------------------------ -//Start more than One Time Prevention -//------------------------------ -function TPlatformWindows.TerminateIfAlreadyRunning(var WndTitle: String): Boolean; -var - hWnd: THandle; - I: Integer; -begin - Result := false; - hWnd:= FindWindow(nil, PChar(WndTitle)); - //Programm already started - if (hWnd <> 0) then - begin - I := Messagebox(0, PChar('Another Instance of Ultrastar is already running. Continue ?'), PChar(WndTitle), MB_ICONWARNING or MB_YESNO); - if (I = IDYes) then - begin - I := 1; - repeat - Inc(I); - hWnd := FindWindow(nil, PChar(WndTitle + ' Instance ' + InttoStr(I))); - until (hWnd = 0); - WndTitle := WndTitle + ' Instance ' + InttoStr(I); - end - else - Result := true; - end; -end; - -(** - * Returns the path of a special folder. - * - * Some Folder IDs: - * CSIDL_APPDATA (e.g. C:\Documents and Settings\username\Application Data) - * CSIDL_LOCAL_APPDATA (e.g. C:\Documents and Settings\username\Local Settings\Application Data) - * CSIDL_PROFILE (e.g. C:\Documents and Settings\username) - * CSIDL_PERSONAL (e.g. C:\Documents and Settings\username\My Documents) - * CSIDL_MYMUSIC (e.g. C:\Documents and Settings\username\My Documents\My Music) - *) -function TPlatformWindows.GetSpecialPath(CSIDL: integer): IPath; -var - Buffer: array [0..MAX_PATH-1] of WideChar; -begin - if (SHGetSpecialFolderPathW(0, @Buffer, CSIDL, false)) then - Result := Path(Buffer) - else - Result := PATH_NONE; -end; - -function TPlatformWindows.GetLogPath: IPath; -begin - Result := GetExecutionDir(); -end; - -function TPlatformWindows.GetGameSharedPath: IPath; -begin - Result := GetExecutionDir(); -end; - -function TPlatformWindows.GetGameUserPath: IPath; -begin - //Result := GetSpecialPath(CSIDL_APPDATA).Append('UltraStarDX', pdAppend); - Result := GetExecutionDir(); -end; - -end. diff --git a/src/base/UPlaylist.pas b/src/base/UPlaylist.pas deleted file mode 100644 index 527eca7b..00000000 --- a/src/base/UPlaylist.pas +++ /dev/null @@ -1,520 +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 UPlaylist; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses - Classes, - USong, - UPath, - UPathUtils; - -type - TPlaylistItem = record - Artist: UTF8String; - Title: UTF8String; - SongID: Integer; - end; - - APlaylistItem = array of TPlaylistItem; - - TPlaylist = record - Name: UTF8String; - Filename: IPath; - Items: APlaylistItem; - end; - - APlaylist = array of TPlaylist; - - //---------- - //TPlaylistManager - Class for Managing Playlists (Loading, Displaying, Saving) - //---------- - TPlaylistManager = class - private - - public - Mode: TSingMode; //Current Playlist Mode for SongScreen - CurPlayList: Cardinal; - CurItem: Cardinal; - - Playlists: APlaylist; - - constructor Create; - procedure LoadPlayLists; - function LoadPlayList(Index: Cardinal; const Filename: IPath): Boolean; - procedure SavePlayList(Index: Cardinal); - - procedure SetPlayList(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 GetNames(var PLNames: array of UTF8String); - function GetIndexbySongID(const SongID: Cardinal; const iPlaylist: Integer = -1): Integer; - end; - - {Modes: - 0: Standard Mode - 1: Category Mode - 2: PlayList Mode} - - var - PlayListMan: TPlaylistManager; - - -implementation - -uses - SysUtils, - USongs, - ULog, - UMain, - UFilesystem, - UGraphic, - UThemes, - UUnicodeUtils; - -//---------- -//Create - Construct Class - Dummy for now -//---------- -constructor TPlayListManager.Create; -begin - inherited; - LoadPlayLists; -end; - -//---------- -//LoadPlayLists - Load list of Playlists from PlayList Folder -//---------- -Procedure TPlayListManager.LoadPlayLists; -var - Len: Integer; - PlayListBuffer: TPlayList; - Iter: IFileIterator; - FileInfo: TFileInfo; -begin - SetLength(Playlists, 0); - - Iter := FileSystem.FileFind(PlayListPath.Append('*.upl'), 0); - while (Iter.HasNext) do - begin - Len := Length(Playlists); - SetLength(Playlists, Len + 1); - - FileInfo := Iter.Next; - - 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 - Playlists[Len+1] := Playlists[Len]; - Dec(Len); - end; - Playlists[Len+1] := PlayListBuffer; - end; - end; -end; - -//---------- -//LoadPlayList - Load a Playlist in the Array -//---------- -function TPlayListManager.LoadPlayList(Index: Cardinal; const Filename: IPath): Boolean; - - 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 - begin - Result := I; - Break; - end; - end; - end; - -var - TextStream: TTextFileStream; - Line: UTF8String; - PosDelimiter: Integer; - SongID: Integer; - Len: Integer; - FilenameAbs: IPath; -begin - //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; - - //Set Filename - Playlists[Index].Filename := Filename; - Playlists[Index].Name := ''; - - //Read Until End of File - while TextStream.ReadLine(Line) do - begin - if (Length(Line) > 0) then - begin - PosDelimiter := UTF8Pos(':', Line); - if (PosDelimiter <> 0) then - begin - //Comment or Name String - if (Line[1] = '#') then - begin - //Found Name Value - if (Uppercase(Trim(copy(Line, 2, PosDelimiter - 2))) = 'NAME') then - PlayLists[Index].Name := Trim(copy(Line, PosDelimiter + 1,Length(Line) - PosDelimiter)) - - end - //Song Entry - else - begin - SongID := FindSong(Trim(copy(Line, 1, PosDelimiter - 1)), Trim(copy(Line, PosDelimiter + 1, Length(Line) - PosDelimiter))); - if (SongID <> -1) then - begin - Len := Length(PlayLists[Index].Items); - SetLength(PlayLists[Index].Items, Len + 1); - - PlayLists[Index].Items[Len].SongID := SongID; - - PlayLists[Index].Items[Len].Artist := Trim(copy(Line, 1, PosDelimiter - 1)); - PlayLists[Index].Items[Len].Title := Trim(copy(Line, PosDelimiter + 1, Length(Line) - PosDelimiter)); - end - else Log.LogError('Could not find Song in Playlist: ' + PlayLists[Index].Filename.ToNative + ', ' + Line); - end; - end; - end; - end; - - //If no special name is given, use Filename - if PlayLists[Index].Name = '' then - begin - PlayLists[Index].Name := FileName.SetExtension('').ToUTF8; - end; - - //Finish (Close File) - TextStream.Free; -end; - -{** - * Saves the specified Playlist - *} -procedure TPlayListManager.SavePlayList(Index: Cardinal); -var - TextStream: TTextFileStream; - PlaylistFile: IPath; - I: Integer; -begin - PlaylistFile := PlaylistPath.Append(Playlists[Index].Filename); - - // cannot update read-only file - if PlaylistFile.IsFile() and PlaylistFile.IsReadOnly() then - Exit; - - // 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 - TextStream.WriteLine('#Name: ' + Playlists[Index].Name); - - // Write song information - TextStream.WriteLine('#Songs:'); - - 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; - -{** - * Display a Playlist in CatSongs - *} -procedure TPlayListManager.SetPlayList(Index: Cardinal); -var - I: Integer; -begin - if (Int(Index) > High(PlayLists)) then - exit; - - //Hide all Songs - for I := 0 to high(CatSongs.Song) do - CatSongs.Song[I].Visible := False; - - //Show Songs in PL - for I := 0 to high(PlayLists[Index].Items) do - begin - CatSongs.Song[PlayLists[Index].Items[I].SongID].Visible := True; - end; - - //Set CatSongsMode + Playlist Mode - CatSongs.CatNumShow := -3; - Mode := smPlayListRandom; - - //Set CurPlaylist - CurPlaylist := Index; - - //Show Cat in Topleft: - ScreenSong.ShowCatTLCustom(Format(Theme.Playlist.CatText,[Playlists[Index].Name])); - - //Fix SongSelection - ScreenSong.Interaction := 0; - ScreenSong.SelectNext(true); - ScreenSong.FixSelected; - - //Play correct Music - ScreenSong.ChangeMusic; -end; - -//---------- -//AddPlaylist - Adds a Playlist and Returns the Index -//---------- -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 - begin - Dec(Result); - Playlists[Result+1] := Playlists[Result]; - end; - Playlists[Result].Name := Name; - - // clear playlist items - SetLength(Playlists[Result].Items, 0); - - I := 1; - PlaylistFile := PlaylistPath.Append(Name + '.upl'); - while (PlaylistFile.Exists) do - begin - Inc(I); - PlaylistFile := PlaylistPath.Append(Name + InttoStr(I) + '.upl'); - end; - Playlists[Result].Filename := PlaylistFile.GetName; - - //Save new Playlist - SavePlayList(Result); -end; - -//---------- -//DelPlaylist - Deletes a Playlist -//---------- -procedure TPlayListManager.DelPlaylist(const Index: Cardinal); -var - I: Integer; - Filename: IPath; -begin - if Int(Index) > High(Playlists) then - Exit; - - Filename := PlaylistPath.Append(Playlists[Index].Filename); - - //If not FileExists or File is not Writeable then exit - if (not Filename.IsFile()) or (Filename.IsReadOnly()) then - Exit; - - - //Delete Playlist from FileSystem - if not Filename.DeleteFile() then - Exit; - - //Delete Playlist from Array - //move all PLs to the Hole - for I := Index to High(Playlists)-1 do - PlayLists[I] := PlayLists[I+1]; - - //Delete last Playlist - SetLength (Playlists, High(Playlists)); - - //If Playlist is Displayed atm - //-> Display Songs - if (CatSongs.CatNumShow = -3) and (Index = CurPlaylist) then - begin - ScreenSong.UnLoadDetailedCover; - ScreenSong.HideCatTL; - CatSongs.SetFilter('', fltAll); - ScreenSong.Interaction := 0; - ScreenSong.FixSelected; - ScreenSong.ChangeMusic; - end; -end; - -//---------- -//AddItem - Adds an Item to a specific Playlist -//---------- -Procedure TPlayListManager.AddItem(const SongID: Cardinal; const iPlaylist: Integer); -var - P: Cardinal; - Len: Cardinal; -begin - if iPlaylist = -1 then - P := CurPlaylist - else if (iPlaylist >= 0) AND (iPlaylist <= high(Playlists)) then - P := iPlaylist - else - exit; - - if (Int(SongID) <= High(CatSongs.Song)) AND (NOT CatSongs.Song[SongID].Main) then - begin - Len := Length(Playlists[P].Items); - SetLength(Playlists[P].Items, Len + 1); - - Playlists[P].Items[Len].SongID := SongID; - Playlists[P].Items[Len].Title := CatSongs.Song[SongID].Title; - Playlists[P].Items[Len].Artist := CatSongs.Song[SongID].Artist; - - //Save Changes - SavePlayList(P); - - //Correct Display when Editing current Playlist - if (CatSongs.CatNumShow = -3) and (P = CurPlaylist) then - SetPlaylist(P); - end; -end; - -//---------- -//DelItem - Deletes an Item from a specific Playlist -//---------- -Procedure TPlayListManager.DelItem(const iItem: Cardinal; const iPlaylist: Integer); -var - I: Integer; - P: Cardinal; -begin - if iPlaylist = -1 then - P := CurPlaylist - else if (iPlaylist >= 0) AND (iPlaylist <= high(Playlists)) then - P := iPlaylist - else - exit; - - if (Int(iItem) <= high(Playlists[P].Items)) then - begin - //Move all entrys behind deleted one to Front - For I := iItem to High(Playlists[P].Items) - 1 do - Playlists[P].Items[I] := Playlists[P].Items[I + 1]; - - //Delete Last Entry - SetLength(PlayLists[P].Items, Length(PlayLists[P].Items) - 1); - - //Save Changes - SavePlayList(P); - end; - - //Delete Playlist if Last Song is deleted - if (Length(PlayLists[P].Items) = 0) then - begin - DelPlaylist(P); - end - //Correct Display when Editing current Playlist - else if (CatSongs.CatNumShow = -3) and (P = CurPlaylist) then - SetPlaylist(P); -end; - -//---------- -//GetNames - Writes Playlist Names in a Array -//---------- -procedure TPlayListManager.GetNames(var PLNames: array of UTF8String); -var - I: Integer; - Len: Integer; -begin - Len := High(Playlists); - - if (Length(PLNames) <> Len + 1) then - exit; - - For I := 0 to Len do - PLNames[I] := Playlists[I].Name; -end; - -//---------- -//GetIndexbySongID - Returns Index in the specified Playlist of the given Song -//---------- -Function TPlayListManager.GetIndexbySongID(const SongID: Cardinal; const iPlaylist: Integer): Integer; -var - P: Integer; - I: Integer; -begin - Result := -1; - - if iPlaylist = -1 then - P := CurPlaylist - else if (iPlaylist >= 0) AND (iPlaylist <= high(Playlists)) then - P := iPlaylist - else - exit; - - For I := 0 to high(Playlists[P].Items) do - begin - if (Playlists[P].Items[I].SongID = Int(SongID)) then - begin - Result := I; - Break; - end; - end; -end; - -end. diff --git a/src/base/URecord.pas b/src/base/URecord.pas deleted file mode 100644 index 2c2093a0..00000000 --- a/src/base/URecord.pas +++ /dev/null @@ -1,777 +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 URecord; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses - Classes, - Math, - sdl, - SysUtils, - UCommon, - UMusic, - UIni; - -const - BaseToneFreq = 65.4064; // lowest (half-)tone to analyze (C2 = 65.4064 Hz) - NumHalftones = 36; // C2-B4 (for Whitney and my high voice) - -type - TCaptureBuffer = class - private - VoiceStream: TAudioVoiceStream; // stream for voice passthrough - AnalysisBufferLock: PSDL_Mutex; - - function GetToneString: string; // converts a tone to its string represenatation; - - procedure BoostBuffer(Buffer: PByteArray; Size: integer); - procedure ProcessNewBuffer(Buffer: PByteArray; BufferSize: integer); - - // we call it to analyze sound by checking Autocorrelation - procedure AnalyzeByAutocorrelation; - // use this to check one frequency by Autocorrelation - function AnalyzeAutocorrelationFreq(Freq: real): real; - public - AnalysisBuffer: array[0..4095] of smallint; // newest 4096 samples - AnalysisBufferSize: integer; // number of samples of BufferArray to analyze - - LogBuffer: TMemoryStream; // full buffer - - AudioFormat: TAudioFormatInfo; - - // pitch detection - // TODO: remove ToneValid, set Tone/ToneAbs=-1 if invalid instead - ToneValid: boolean; // true if Tone contains a valid value (otherwise it contains noise) - Tone: integer; // tone relative to one octave (e.g. C2=C3=C4). Range: 0-11 - ToneAbs: integer; // absolute (full range) tone (e.g. C2<>C3). Range: 0..NumHalftones-1 - - // methods - constructor Create; - destructor Destroy; override; - - procedure Clear; - - // use to analyze sound from buffers to get new pitch - procedure AnalyzeBuffer; - procedure LockAnalysisBuffer(); {$IFDEF HasInline}inline;{$ENDIF} - procedure UnlockAnalysisBuffer(); {$IFDEF HasInline}inline;{$ENDIF} - - function MaxSampleVolume: single; - property ToneString: string READ GetToneString; - end; - -const - DEFAULT_SOURCE_NAME = '[Default]'; - -type - TAudioInputSource = record - Name: string; - end; - - // soundcard input-devices information - TAudioInputDevice = class - public - CfgIndex: integer; // index of this device in Ini.InputDeviceConfig - Name: string; // soundcard name - Source: array of TAudioInputSource; // soundcard input-sources - SourceRestore: integer; // source-index that will be selected after capturing (-1: not detected) - MicSource: integer; // source-index of mic (-1: none detected) - - AudioFormat: TAudioFormatInfo; // capture format info (e.g. 44.1kHz SInt16 stereo) - CaptureChannel: array of TCaptureBuffer; // sound-buffer references used for mono or stereo channel's capture data - - destructor Destroy; override; - - procedure LinkCaptureBuffer(ChannelIndex: integer; Sound: TCaptureBuffer); - - // TODO: add Open/Close functions so Start/Stop becomes faster - //function Open(): boolean; virtual; abstract; - //function Close(): boolean; virtual; abstract; - function Start(): boolean; virtual; abstract; - function Stop(): boolean; virtual; abstract; - - function GetVolume(): single; virtual; abstract; - procedure SetVolume(Volume: single); virtual; abstract; - end; - - TAudioInputProcessor = class - public - Sound: array of TCaptureBuffer; // sound-buffers for every player - DeviceList: array of TAudioInputDevice; - - constructor Create; - destructor Destroy; override; - - procedure UpdateInputDeviceConfig; - - // handle microphone input - procedure HandleMicrophoneData(Buffer: PByteArray; Size: integer; - InputDevice: TAudioInputDevice); - end; - - TAudioInputBase = class( TInterfacedObject, IAudioInput ) - private - Started: boolean; - protected - function UnifyDeviceName(const name: string; deviceIndex: integer): string; - public - function GetName: String; virtual; abstract; - function InitializeRecord: boolean; virtual; abstract; - function FinalizeRecord: boolean; virtual; - - procedure CaptureStart; - procedure CaptureStop; - end; - - TSmallIntArray = array [0..(MaxInt div SizeOf(SmallInt))-1] of SmallInt; - PSmallIntArray = ^TSmallIntArray; - - function AudioInputProcessor(): TAudioInputProcessor; - -implementation - -uses - ULog, - UNote; - -var - singleton_AudioInputProcessor : TAudioInputProcessor = nil; - -{ Global } - -function AudioInputProcessor(): TAudioInputProcessor; -begin - if singleton_AudioInputProcessor = nil then - singleton_AudioInputProcessor := TAudioInputProcessor.create(); - - result := singleton_AudioInputProcessor; -end; - -{ TAudioInputDevice } - -destructor TAudioInputDevice.Destroy; -begin - Stop(); - Source := nil; - CaptureChannel := nil; - FreeAndNil(AudioFormat); - inherited Destroy; -end; - -procedure TAudioInputDevice.LinkCaptureBuffer(ChannelIndex: integer; Sound: TCaptureBuffer); -var - DeviceCfg: PInputDeviceConfig; - OldSound: TCaptureBuffer; -begin - // check bounds - if ((ChannelIndex < 0) or (ChannelIndex > High(CaptureChannel))) then - Exit; - - // reset previously assigned (old) capture-buffer - OldSound := CaptureChannel[ChannelIndex]; - if (OldSound <> nil) then - begin - // close voice stream - FreeAndNil(OldSound.VoiceStream); - // free old audio-format info - FreeAndNil(OldSound.AudioFormat); - end; - - // set audio-format of new capture-buffer - if (Sound <> nil) then - begin - // copy the input-device audio-format ... - Sound.AudioFormat := AudioFormat.Copy; - // and adjust it because capture buffers are always mono - Sound.AudioFormat.Channels := 1; - DeviceCfg := @Ini.InputDeviceConfig[CfgIndex]; - - if (Ini.VoicePassthrough = 1) then - begin - // TODO: map odd players to the left and even players to the right speaker - Sound.VoiceStream := AudioPlayback.CreateVoiceStream(CHANNELMAP_FRONT, AudioFormat); - end; - end; - - // replace old with new buffer (Note: Sound might be nil) - CaptureChannel[ChannelIndex] := Sound; -end; - -{ TSound } - -constructor TCaptureBuffer.Create; -begin - inherited; - LogBuffer := TMemoryStream.Create; - AnalysisBufferLock := SDL_CreateMutex(); - AnalysisBufferSize := Length(AnalysisBuffer); -end; - -destructor TCaptureBuffer.Destroy; -begin - FreeAndNil(LogBuffer); - FreeAndNil(VoiceStream); - FreeAndNil(AudioFormat); - SDL_DestroyMutex(AnalysisBufferLock); - inherited; -end; - -procedure TCaptureBuffer.LockAnalysisBuffer(); -begin - SDL_mutexP(AnalysisBufferLock); -end; - -procedure TCaptureBuffer.UnlockAnalysisBuffer(); -begin - SDL_mutexV(AnalysisBufferLock); -end; - -procedure TCaptureBuffer.Clear; -begin - if assigned(LogBuffer) then - LogBuffer.Clear; - LockAnalysisBuffer(); - FillChar(AnalysisBuffer[0], Length(AnalysisBuffer) * SizeOf(SmallInt), 0); - UnlockAnalysisBuffer(); -end; - -procedure TCaptureBuffer.ProcessNewBuffer(Buffer: PByteArray; BufferSize: integer); -var - BufferOffset: integer; - SampleCount: integer; - i: integer; -begin - // apply software boost - BoostBuffer(Buffer, BufferSize); - - // voice passthrough (send data to playback-device) - if (assigned(VoiceStream)) then - VoiceStream.WriteData(Buffer, BufferSize); - - // we assume that samples are in S16Int format - // TODO: support float too - if (AudioFormat.Format <> asfS16) then - Exit; - - // process BufferArray - BufferOffset := 0; - - SampleCount := BufferSize div SizeOf(SmallInt); - - // check if we have more new samples than we can store - if (SampleCount > Length(AnalysisBuffer)) then - begin - // discard the oldest of the new samples - BufferOffset := (SampleCount - Length(AnalysisBuffer)) * SizeOf(SmallInt); - SampleCount := Length(AnalysisBuffer); - end; - - LockAnalysisBuffer(); - try - - // move old samples to the beginning of the array (if necessary) - for i := 0 to High(AnalysisBuffer)-SampleCount do - AnalysisBuffer[i] := AnalysisBuffer[i+SampleCount]; - - // copy new samples to analysis buffer - Move(Buffer[BufferOffset], AnalysisBuffer[Length(AnalysisBuffer)-SampleCount], - SampleCount * SizeOf(SmallInt)); - - finally - UnlockAnalysisBuffer(); - end; - - // save capture-data to BufferLong if enabled - if (Ini.SavePlayback = 1) then - begin - // this is just for debugging (approx 15MB per player for a 3min song!!!) - // For an in-game replay-mode we need to compress data so we do not - // waste that much memory. Maybe ogg-vorbis with voice-preset in fast-mode? - // Or we could use a faster but not that efficient lossless compression. - LogBuffer.WriteBuffer(Buffer, BufferSize); - end; -end; - -procedure TCaptureBuffer.AnalyzeBuffer; -var - Volume: single; - MaxVolume: single; - SampleIndex: integer; - Threshold: single; -begin - ToneValid := false; - ToneAbs := -1; - Tone := -1; - - LockAnalysisBuffer(); - try - - // find maximum volume of first 1024 samples - MaxVolume := 0; - for SampleIndex := 0 to 1023 do - begin - Volume := Abs(AnalysisBuffer[SampleIndex]) / -Low(Smallint); - if Volume > MaxVolume then - MaxVolume := Volume; - end; - - Threshold := IThresholdVals[Ini.ThresholdIndex]; - - // check if signal has an acceptable volume (ignore background-noise) - if MaxVolume >= Threshold then - begin - // analyse the current voice pitch - AnalyzeByAutocorrelation; - ToneValid := true; - end; - - finally - UnlockAnalysisBuffer(); - end; -end; - -procedure TCaptureBuffer.AnalyzeByAutocorrelation; -var - ToneIndex: integer; - CurFreq: real; - CurWeight: real; - MaxWeight: real; - MaxTone: integer; -const - HalftoneBase = 1.05946309436; // 2^(1/12) -> HalftoneBase^12 = 2 (one octave) -begin - // prepare to analyze - MaxWeight := -1; - MaxTone := 0; // this is not needed, but it satifies the compiler - - // analyze halftones - // Note: at the lowest tone (~65Hz) and a buffer-size of 4096 - // at 44.1 (or 48kHz) only 6 (or 5) samples are compared, this might be - // too few samples -> use a bigger buffer-size - for ToneIndex := 0 to NumHalftones-1 do - begin - CurFreq := BaseToneFreq * Power(HalftoneBase, ToneIndex); - CurWeight := AnalyzeAutocorrelationFreq(CurFreq); - - // TODO: prefer higher frequencies (use >= or use downto) - if (CurWeight > MaxWeight) then - begin - // this frequency has a higher weight - MaxWeight := CurWeight; - MaxTone := ToneIndex; - end; - end; - - ToneAbs := MaxTone; - Tone := MaxTone mod 12; -end; - -// result medium difference -function TCaptureBuffer.AnalyzeAutocorrelationFreq(Freq: real): real; -var - Dist: real; // distance (0=equal .. 1=totally different) between correlated samples - AccumDist: real; // accumulated distances - SampleIndex: integer; // index of sample to analyze - CorrelatingSampleIndex: integer; // index of sample one period ahead - SamplesPerPeriod: integer; // samples in one period -begin - SampleIndex := 0; - SamplesPerPeriod := Round(AudioFormat.SampleRate/Freq); - CorrelatingSampleIndex := SampleIndex + SamplesPerPeriod; - - AccumDist := 0; - - // compare correlating samples - while (CorrelatingSampleIndex < AnalysisBufferSize) do - begin - // calc distance (correlation: 1-dist) to corresponding sample in next period - Dist := Abs(AnalysisBuffer[SampleIndex] - AnalysisBuffer[CorrelatingSampleIndex]) / - High(Word); - AccumDist := AccumDist + Dist; - Inc(SampleIndex); - Inc(CorrelatingSampleIndex); - end; - - // return "inverse" average distance (=correlation) - Result := 1 - AccumDist / AnalysisBufferSize; -end; - -function TCaptureBuffer.MaxSampleVolume: single; -var - lSampleIndex: integer; - lMaxVol: longint; -begin; - LockAnalysisBuffer(); - try - lMaxVol := 0; - for lSampleIndex := 0 to High(AnalysisBuffer) do - begin - if Abs(AnalysisBuffer[lSampleIndex]) > lMaxVol then - lMaxVol := Abs(AnalysisBuffer[lSampleIndex]); - end; - finally - UnlockAnalysisBuffer(); - end; - - result := lMaxVol / -Low(Smallint); -end; - -const - ToneStrings: array[0..11] of string = ( - 'C', 'C#', 'D', 'D#', 'E', 'F', 'F#', 'G', 'G#', 'A', 'A#', 'B' - ); - -function TCaptureBuffer.GetToneString: string; -begin - if (ToneValid) then - Result := ToneStrings[Tone] + IntToStr(ToneAbs div 12 + 2) - else - Result := '-'; -end; - -procedure TCaptureBuffer.BoostBuffer(Buffer: PByteArray; Size: integer); -var - i: integer; - Value: longint; - SampleCount: integer; - SampleBuffer: PSmallIntArray; // buffer handled as array of samples - Boost: byte; -begin - // TODO: set boost per device - case Ini.MicBoost of - 0: Boost := 1; - 1: Boost := 2; - 2: Boost := 4; - 3: Boost := 8; - else Boost := 1; - end; - - // at the moment we will boost SInt16 data only - if (AudioFormat.Format = asfS16) then - begin - // interpret buffer as buffer of bytes - SampleBuffer := PSmallIntArray(Buffer); - SampleCount := Size div AudioFormat.FrameSize; - - // boost buffer - for i := 0 to SampleCount-1 do - begin - Value := SampleBuffer^[i] * Boost; - - if Value > High(Smallint) then - Value := High(Smallint); - - if Value < Low(Smallint) then - Value := Low(Smallint); - - SampleBuffer^[i] := Value; - end; - end; -end; - -{ TAudioInputProcessor } - -constructor TAudioInputProcessor.Create; -var - i: integer; -begin - inherited; - SetLength(Sound, 6 {max players});//Ini.Players+1); - for i := 0 to High(Sound) do - Sound[i] := TCaptureBuffer.Create; -end; - -destructor TAudioInputProcessor.Destroy; -var - i: integer; -begin - for i := 0 to High(Sound) do - Sound[i].Free; - SetLength(Sound, 0); - inherited; -end; - -// updates InputDeviceConfig with current input-device information -// See: TIni.LoadInputDeviceCfg() -procedure TAudioInputProcessor.UpdateInputDeviceConfig; -var - deviceIndex: integer; - newDevice: boolean; - deviceIniIndex: integer; - deviceCfg: PInputDeviceConfig; - device: TAudioInputDevice; - channelCount: integer; - channelIndex: integer; - i: integer; -begin - // Input devices - append detected soundcards - for deviceIndex := 0 to High(DeviceList) do - begin - newDevice := true; - //Search for Card in List - for deviceIniIndex := 0 to High(Ini.InputDeviceConfig) do - begin - deviceCfg := @Ini.InputDeviceConfig[deviceIniIndex]; - device := DeviceList[deviceIndex]; - - if (deviceCfg.Name = Trim(device.Name)) then - begin - newDevice := false; - - // store highest channel index as an offset for the new channels - channelIndex := High(deviceCfg.ChannelToPlayerMap); - // add missing channels or remove non-existing ones - SetLength(deviceCfg.ChannelToPlayerMap, device.AudioFormat.Channels); - // initialize added channels to 0 - for i := channelIndex+1 to High(deviceCfg.ChannelToPlayerMap) do - begin - deviceCfg.ChannelToPlayerMap[i] := 0; - end; - - // associate ini-index with device - device.CfgIndex := deviceIniIndex; - break; - end; - end; - - //If not in List -> Add - if newDevice then - begin - // resize list - SetLength(Ini.InputDeviceConfig, Length(Ini.InputDeviceConfig)+1); - deviceCfg := @Ini.InputDeviceConfig[High(Ini.InputDeviceConfig)]; - device := DeviceList[deviceIndex]; - - // associate ini-index with device - device.CfgIndex := High(Ini.InputDeviceConfig); - - deviceCfg.Name := Trim(device.Name); - deviceCfg.Input := 0; - - channelCount := device.AudioFormat.Channels; - SetLength(deviceCfg.ChannelToPlayerMap, channelCount); - - for channelIndex := 0 to channelCount-1 do - begin - // set default at first start of USDX (1st device, 1st channel -> player1) - if ((channelIndex = 0) and (device.CfgIndex = 0)) then - deviceCfg.ChannelToPlayerMap[0] := 1 - else - deviceCfg.ChannelToPlayerMap[channelIndex] := 0; - end; - end; - end; -end; - -{* - * Handles captured microphone input data. - * Params: - * Buffer - buffer of signed 16bit interleaved stereo PCM-samples. - * Interleaved means that a right-channel sample follows a left- - * channel sample and vice versa (0:left[0],1:right[0],2:left[1],...). - * Length - number of bytes in Buffer - * Input - Soundcard-Input used for capture - *} -procedure TAudioInputProcessor.HandleMicrophoneData(Buffer: PByteArray; Size: integer; InputDevice: TAudioInputDevice); -var - MultiChannelBuffer: PByteArray; // buffer handled as array of bytes (offset relative to channel) - SingleChannelBuffer: PByteArray; // temporary buffer for new samples per channel - SingleChannelBufferSize: integer; - ChannelIndex: integer; - CaptureChannel: TCaptureBuffer; - AudioFormat: TAudioFormatInfo; - SampleSize: integer; - SamplesPerChannel: integer; - i: integer; -begin - AudioFormat := InputDevice.AudioFormat; - SampleSize := AudioSampleSize[AudioFormat.Format]; - SamplesPerChannel := Size div AudioFormat.FrameSize; - - SingleChannelBufferSize := SamplesPerChannel * SampleSize; - GetMem(SingleChannelBuffer, SingleChannelBufferSize); - - // process channels - for ChannelIndex := 0 to High(InputDevice.CaptureChannel) do - begin - CaptureChannel := InputDevice.CaptureChannel[ChannelIndex]; - // check if a capture buffer was assigned, otherwise there is nothing to do - if (CaptureChannel <> nil) then - begin - // set offset according to channel index - MultiChannelBuffer := @Buffer[ChannelIndex * SampleSize]; - // separate channel-data from interleaved multi-channel (e.g. stereo) data - for i := 0 to SamplesPerChannel-1 do - begin - Move(MultiChannelBuffer[i*AudioFormat.FrameSize], - SingleChannelBuffer[i*SampleSize], - SampleSize); - end; - CaptureChannel.ProcessNewBuffer(SingleChannelBuffer, SingleChannelBufferSize); - end; - end; - - FreeMem(SingleChannelBuffer); -end; - -{ TAudioInputBase } - -function TAudioInputBase.FinalizeRecord: boolean; -var - i: integer; -begin - for i := 0 to High(AudioInputProcessor.DeviceList) do - AudioInputProcessor.DeviceList[i].Free(); - AudioInputProcessor.DeviceList := nil; - Result := true; -end; - -{* - * Start capturing on all used input-device. - *} -procedure TAudioInputBase.CaptureStart; -var - S: integer; - DeviceIndex: integer; - ChannelIndex: integer; - Device: TAudioInputDevice; - DeviceCfg: PInputDeviceConfig; - DeviceUsed: boolean; - Player: integer; -begin - if (Started) then - CaptureStop(); - - // reset buffers - for S := 0 to High(AudioInputProcessor.Sound) do - AudioInputProcessor.Sound[S].Clear; - - // start capturing on each used device - for DeviceIndex := 0 to High(AudioInputProcessor.DeviceList) do - begin - Device := AudioInputProcessor.DeviceList[DeviceIndex]; - if not assigned(Device) then - continue; - DeviceCfg := @Ini.InputDeviceConfig[Device.CfgIndex]; - - DeviceUsed := false; - - // check if device is used - for ChannelIndex := 0 to High(DeviceCfg.ChannelToPlayerMap) do - begin - Player := DeviceCfg.ChannelToPlayerMap[ChannelIndex]-1; - if (Player < 0) or (Player >= PlayersPlay) then - begin - Device.LinkCaptureBuffer(ChannelIndex, nil); - end - else - begin - Device.LinkCaptureBuffer(ChannelIndex, AudioInputProcessor.Sound[Player]); - DeviceUsed := true; - end; - end; - - // start device if used - if (DeviceUsed) then - begin - //Log.BenchmarkStart(2); - Device.Start(); - //Log.BenchmarkEnd(2); - //Log.LogBenchmark('Device.Start', 2) ; - end; - end; - - Started := true; -end; - -{* - * Stop input-capturing on all soundcards. - *} -procedure TAudioInputBase.CaptureStop; -var - DeviceIndex: integer; - ChannelIndex: integer; - Device: TAudioInputDevice; - DeviceCfg: PInputDeviceConfig; -begin - for DeviceIndex := 0 to High(AudioInputProcessor.DeviceList) do - begin - Device := AudioInputProcessor.DeviceList[DeviceIndex]; - if not assigned(Device) then - continue; - - Device.Stop(); - - // disconnect capture buffers - DeviceCfg := @Ini.InputDeviceConfig[Device.CfgIndex]; - for ChannelIndex := 0 to High(DeviceCfg.ChannelToPlayerMap) do - Device.LinkCaptureBuffer(ChannelIndex, nil); - end; - - Started := false; -end; - -function TAudioInputBase.UnifyDeviceName(const name: string; deviceIndex: integer): string; -var - count: integer; // count of devices with this name - - function IsDuplicate(const name: string): boolean; - var - i: integer; - begin - Result := false; - // search devices with same description - for i := 0 to deviceIndex-1 do - begin - if (AudioInputProcessor.DeviceList[i].Name = name) then - begin - Result := true; - Break; - end; - end; - end; - -begin - count := 1; - result := name; - - // if there is another device with the same ID, search for an available name - while (IsDuplicate(result)) do - begin - Inc(count); - // set description - result := name + ' ('+IntToStr(count)+')'; - end; -end; - -end. diff --git a/src/base/USingScores.pas b/src/base/USingScores.pas deleted file mode 100644 index f280900e..00000000 --- a/src/base/USingScores.pas +++ /dev/null @@ -1,1122 +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 USingScores; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses - gl, - UThemes, - UTexture; - -////////////////////////////////////////////////////////////// -// ATTENTION: // -// Enabled flag does not work atm. This should cause popups // -// not to move and scores to stay until re-enabling. // -// To use e.g. in pause mode // -// also invisible flag causes attributes not to change. // -// This should be fixed after next draw when visible = true,// -// but not tested yet // -////////////////////////////////////////////////////////////// - -// some constants containing options that could change by time -const - MaxPlayers = 6; // maximum of players that could be added - MaxPositions = 6; // maximum of score positions that could be added - -type - //----------- - // TScorePlayer - record containing information about a players score - //----------- - TScorePlayer = record - Position: byte; // index of the position where the player should be drawn - Enabled: boolean; // is the score display enabled - Visible: boolean; // is the score display visible - Score: word; // current score of the player - ScoreDisplayed: word; // score cur. displayed (for counting up) - ScoreBG: TTexture; // texture of the players scores bg - Color: TRGB; // the players color - RBPos: real; // cur. percentille of the rating bar - RBTarget: real; // target position of rating bar - RBVisible: boolean; // is rating bar drawn - end; - aScorePlayer = array [0..MaxPlayers-1] of TScorePlayer; - - //----------- - // TScorePosition - record containing information about a score position, that can be used - //----------- - PScorePosition = ^TScorePosition; - TScorePosition = record - // the position is used for which playercount - PlayerCount: byte; - // 1 - 1 player per screen - // 2 - 2 players per screen - // 4 - 3 players per screen - // 6 would be 2 and 3 players per screen - - BGX: real; // x position of the score bg - BGY: real; // y position of the score bg - BGW: real; // width of the score bg - BGH: real; // height of the score bg - - RBX: real; // x position of the rating bar - RBY: real; // y position of the rating bar - RBW: real; // width of the rating bar - RBH: real; // height of the rating bar - - TextX: real; // x position of the score text - TextY: real; // y position of the score text - TextFont: byte; // font of the score text - TextSize: integer; // size of the score text - - PUW: real; // width of the line bonus popup - PUH: real; // height of the line bonus popup - PUFont: byte; // font for the popups - PUFontSize: integer; // font size for the popups - PUStartX: real; // x start position of the line bonus popup - PUStartY: real; // y start position of the line bonus popup - PUTargetX: real; // x target position of the line bonus popup - PUTargetY: real; // y target position of the line bonus popup - end; - aScorePosition = array [0..MaxPositions-1] of TScorePosition; - - //----------- - // TScorePopUp - record containing information about a line bonus popup - // list, next item is saved in next attribute - //----------- - PScorePopUp = ^TScorePopUp; - TScorePopUp = record - Player: byte; // index of the popups player - TimeStamp: cardinal; // timestamp of popups spawn - Rating: 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; - - //----------- - // TSingScores - class containing scores positions and drawing scores, rating bar + popups - //----------- - TSingScores = class - private - Positions: aScorePosition; - aPlayers: aScorePlayer; - oPositionCount: byte; - oPlayerCount: byte; - - // saves the first and last popup of the list - FirstPopUp: PScorePopUp; - LastPopUp: PScorePopUp; - - // 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); - - // draws the rating bar by playerindex - procedure DrawRatingBar(const Index: integer); - - // 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) - // the plop up of the popup - Phase2Time: real; // time for phase 2 to complete (in msecs) - // the moving (mainly upwards) of the popup - Phase3Time: real; // time for phase 3 to complete (in msecs) - // the fade out and score adding - - PopUpTex: array [0..8] of TTexture; // textures for every popup rating - - RatingBar_BG_Tex: TTexture; // rating bar texs - RatingBar_FG_Tex: TTexture; - RatingBar_Bar_Tex: TTexture; - - end; - - Visible: boolean; // visibility of all scores - Enabled: boolean; // scores are changed, popups are moved etc. - RBVisible: boolean; // visibility of all rating bars - - // properties for reading position and playercount - property PositionCount: byte read oPositionCount; - property PlayerCount: byte read oPlayerCount; - property Players: aScorePlayer read aPlayers; - - // constructor just sets some standard settings - constructor Create; - - // adds a position to array and increases position count - procedure AddPosition(const pPosition: PScorePosition); - - // adds a player to array and increases player count - procedure AddPlayer(const ScoreBG: TTexture; const Color: TRGB; const Score: word = 0; const Enabled: boolean = true; const Visible: boolean = true); - - // change a players visibility, enable - procedure ChangePlayerVisibility(const Index: byte; const pVisible: boolean); - procedure ChangePlayerEnabled(const Index: byte; const pEnabled: boolean); - - // deletes all player information - procedure ClearPlayers; - - // deletes positions and playerinformation - procedure Clear; - - // loads some settings and the positions from theme - procedure LoadfromTheme; - - // has to be called after positions and players have been added, before first call of draw - // it gives every player a score position - procedure Init; - - // 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: integer; const Score: integer); - - // removes all popups from mem - procedure KillAllPopUps; - - // draws scores and line bonus popups - procedure Draw; - end; - -implementation - -uses - SysUtils, - Math, - SDL, - TextGL, - ULog, - UGraphic; - -{** - * sets some standard settings - *} -constructor TSingScores.Create; -begin - inherited; - - // clear popuplist pointers - FirstPopUp := nil; - LastPopUp := nil; - - // clear variables - Visible := true; - Enabled := true; - RBVisible := true; - - // clear position index - oPositionCount := 0; - oPlayerCount := 0; - - Settings.Phase1Time := 350; // plop it up . -> [ ] - Settings.Phase2Time := 550; // shift it up ^[ ]^ - Settings.Phase3Time := 200; // increase score [s++] - - Settings.PopUpTex[0].TexNum := 0; - Settings.PopUpTex[1].TexNum := 0; - Settings.PopUpTex[2].TexNum := 0; - Settings.PopUpTex[3].TexNum := 0; - Settings.PopUpTex[4].TexNum := 0; - Settings.PopUpTex[5].TexNum := 0; - Settings.PopUpTex[6].TexNum := 0; - Settings.PopUpTex[7].TexNum := 0; - Settings.PopUpTex[8].TexNum := 0; - - Settings.RatingBar_BG_Tex.TexNum := 0; - Settings.RatingBar_FG_Tex.TexNum := 0; - Settings.RatingBar_Bar_Tex.TexNum := 0; -end; - -{** - * adds a position to array and increases position count - *} -procedure TSingScores.AddPosition(const pPosition: PScorePosition); -begin - if (PositionCount < MaxPositions) then - begin - Positions[PositionCount] := pPosition^; - Inc(oPositionCount); - end; -end; - -{** - * adds a player to array and increases player count - *} -procedure TSingScores.AddPlayer(const ScoreBG: TTexture; const Color: TRGB; const Score: word; const Enabled: boolean; const Visible: boolean); -begin - if (PlayerCount < MaxPlayers) then - begin - aPlayers[PlayerCount].Position := High(byte); - aPlayers[PlayerCount].Enabled := Enabled; - aPlayers[PlayerCount].Visible := Visible; - aPlayers[PlayerCount].Score := Score; - aPlayers[PlayerCount].ScoreDisplayed := Score; - aPlayers[PlayerCount].ScoreBG := ScoreBG; - aPlayers[PlayerCount].Color := Color; - aPlayers[PlayerCount].RBPos := 0.5; - aPlayers[PlayerCount].RBTarget := 0.5; - aPlayers[PlayerCount].RBVisible := true; - - Inc(oPlayerCount); - end; -end; - -{** - * change a players visibility - *} -procedure TSingScores.ChangePlayerVisibility(const Index: byte; const pVisible: boolean); -begin - if (Index < MaxPlayers) then - aPlayers[Index].Visible := pVisible; -end; - -{** - * change player enabled - *} -procedure TSingScores.ChangePlayerEnabled(const Index: byte; const pEnabled: boolean); -begin - if (Index < MaxPlayers) then - aPlayers[Index].Enabled := pEnabled; -end; - -{** - * procedure deletes all player information - *} -procedure TSingScores.ClearPlayers; -begin - KillAllPopUps; - oPlayerCount := 0; - TimePassed := 0; -end; - -{** - * procedure deletes positions and playerinformation - *} -procedure TSingScores.Clear; -begin - KillAllPopUps; - oPlayerCount := 0; - oPositionCount := 0; - TimePassed := 0; -end; - -{** - * procedure loads some settings and the positions from theme - *} -procedure TSingScores.LoadfromTheme; -var - I: integer; - procedure AddbyStatics(const PC: byte; const ScoreStatic, SingBarStatic: TThemeStatic; ScoreText: TThemeText); - var - nPosition: TScorePosition; - begin - nPosition.PlayerCount := PC; // only for one player playing - - nPosition.BGX := ScoreStatic.X; - nPosition.BGY := ScoreStatic.Y; - nPosition.BGW := ScoreStatic.W; - nPosition.BGH := ScoreStatic.H; - - nPosition.TextX := ScoreText.X; - nPosition.TextY := ScoreText.Y; - nPosition.TextFont := ScoreText.Font; - nPosition.TextSize := ScoreText.Size; - - nPosition.RBX := SingBarStatic.X; - nPosition.RBY := SingBarStatic.Y; - nPosition.RBW := SingBarStatic.W; - nPosition.RBH := SingBarStatic.H; - - nPosition.PUW := nPosition.BGW; - nPosition.PUH := nPosition.BGH; - - nPosition.PUFont := 2; - nPosition.PUFontSize := 18; - - nPosition.PUStartX := nPosition.BGX; - nPosition.PUStartY := nPosition.TextY + 65; - - nPosition.PUTargetX := nPosition.BGX; - nPosition.PUTargetY := nPosition.TextY; - - AddPosition(@nPosition); - end; -begin - Clear; - - // set textures - // popup tex - for I := 0 to 8 do - Settings.PopUpTex[I] := Tex_SingLineBonusBack[I]; - - // rating bar tex - Settings.RatingBar_BG_Tex := Tex_SingBar_Back; - Settings.RatingBar_FG_Tex := Tex_SingBar_Front; - Settings.RatingBar_Bar_Tex := Tex_SingBar_Bar; - - // load positions from theme - - // player 1: - AddByStatics(1, Theme.Sing.StaticP1ScoreBG, Theme.Sing.StaticP1SingBar, Theme.Sing.TextP1Score); - AddByStatics(2, Theme.Sing.StaticP1TwoPScoreBG, Theme.Sing.StaticP1TwoPSingBar, Theme.Sing.TextP1TwoPScore); - AddByStatics(4, Theme.Sing.StaticP1ThreePScoreBG, Theme.Sing.StaticP1ThreePSingBar, Theme.Sing.TextP1ThreePScore); - - // player 2: - AddByStatics(2, Theme.Sing.StaticP2RScoreBG, Theme.Sing.StaticP2RSingBar, Theme.Sing.TextP2RScore); - AddByStatics(4, Theme.Sing.StaticP2MScoreBG, Theme.Sing.StaticP2MSingBar, Theme.Sing.TextP2MScore); - - // player 3: - AddByStatics(4, Theme.Sing.StaticP3RScoreBG, Theme.Sing.StaticP3SingBar, Theme.Sing.TextP3RScore); -end; - -{** - * raises the score of a specified player to the specified score - *} -procedure TSingScores.RaiseScore(Player: byte; Score: integer); -begin - if (Player <= PlayerCount - 1) then - aPlayers[Player].Score := Score; -end; - -{** - * sets the score of a specified player to the specified score - *} -procedure TSingScores.SetScore(Player: byte; Score: integer); - var - Diff: Integer; -begin - if (Player <= PlayerCount - 1) then - begin - Diff := Score - Players[Player].Score; - aPlayers[Player].Score := Score; - Inc(aPlayers[Player].ScoreDisplayed, Diff); - end; -end; - -{** - * spawns a new line bonus popup for the player - *} -procedure TSingScores.SpawnPopUp(const PlayerIndex: byte; const Rating: integer; const Score: integer); -var - Cur: PScorePopUp; -begin - if (PlayerIndex < PlayerCount) then - begin - // get memory and add data - GetMem(Cur, SizeOf(TScorePopUp)); - - Cur.Player := PlayerIndex; - Cur.TimeStamp := SDL_GetTicks; - - // 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; - - Cur.ScoreGiven:= 0; - if (Players[PlayerIndex].Score < Score) then - begin - Cur.ScoreDiff := Score - Players[PlayerIndex].Score; - aPlayers[PlayerIndex].Score := Score; - end - else - Cur.ScoreDiff := 0; - Cur.Next := nil; - - // Log.LogError('TSingScores.SpawnPopUp| Player: ' + InttoStr(PlayerIndex) + ', Score: ' + InttoStr(Score) + ', ScoreDiff: ' + InttoStr(Cur.ScoreDiff)); - - // add it to the chain - if (FirstPopUp = nil) then - // the first popup in the list - FirstPopUp := Cur - else - // second or earlier popup - LastPopUp.Next := Cur; - - // set new popup to last popup in the list - LastPopUp := Cur; - end - else - Log.LogError('TSingScores: Try to add popup for non-existing player'); -end; - -{** - * removes a popup w/o destroying the list - *} -procedure TSingScores.KillPopUp(const last, cur: PScorePopUp); -begin - // give player the last points that missing till now - aPlayers[Cur.Player].ScoreDisplayed := aPlayers[Cur.Player].ScoreDisplayed + Cur.ScoreDiff - Cur.ScoreGiven; - - // change bars position - if (Cur.ScoreDiff > 0) THEN - begin // popup w/ scorechange -> give missing percentille - aPlayers[Cur.Player].RBTarget := aPlayers[Cur.Player].RBTarget + - (Cur.ScoreDiff - Cur.ScoreGiven) / Cur.ScoreDiff - * (Cur.Rating / 20 - 0.26); - end - else - begin // popup w/o scorechange -> give complete percentille - aPlayers[Cur.Player].RBTarget := aPlayers[Cur.Player].RBTarget + - (Cur.Rating / 20 - 0.26); - end; - - if (aPlayers[Cur.Player].RBTarget > 1) then - aPlayers[Cur.Player].RBTarget := 1 - else - if (aPlayers[Cur.Player].RBTarget < 0) then - aPlayers[Cur.Player].RBTarget := 0; - - // if this is the first popup => make next popup the first - if (Cur = FirstPopUp) then - FirstPopUp := Cur.Next - // else => remove curent popup from chain - else - Last.Next := Cur.Next; - - // if this is the last popup, make popup before the last - if (Cur = LastPopUp) then - LastPopUp := Last; - - // free the memory - FreeMem(Cur, SizeOf(TScorePopUp)); -end; - -{** - * removes all popups from mem - *} -procedure TSingScores.KillAllPopUps; -var - Cur: PScorePopUp; - Last: PScorePopUp; -begin - Cur := FirstPopUp; - - // remove all popups: - while (Cur <> nil) do - begin - Last := Cur; - Cur := Cur.Next; - FreeMem(Last, SizeOf(TScorePopUp)); - end; - - FirstPopUp := nil; - LastPopUp := nil; -end; - -{** - * 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; - - // only check points if there is a difference between actual - // and displayed points - if (Players[Index].Score > Players[Index].ScoreDisplayed) then - begin - 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; -end; - -{** - * has to be called after positions and players have been added, before first call of draw - * it gives each player a score position - *} -procedure TSingScores.Init; -var - PlC: array [0..1] of byte; // playercount first screen and second screen - I, J: integer; - MaxPlayersperScreen: byte; - CurPlayer: byte; - - function GetPositionCountbyPlayerCount(bPlayerCount: byte): byte; - var - I: integer; - begin - Result := 0; - bPlayerCount := 1 shl (bPlayerCount - 1); - - for I := 0 to PositionCount - 1 do - begin - if ((Positions[I].PlayerCount and bPlayerCount) <> 0) then - Inc(Result); - end; - end; - - function GetPositionbyPlayernum(bPlayerCount, bPlayer: byte): byte; - var - I: integer; - begin - bPlayerCount := 1 shl (bPlayerCount - 1); - Result := High(byte); - - for I := 0 to PositionCount - 1 do - begin - if ((Positions[I].PlayerCount and bPlayerCount) <> 0) then - begin - if (bPlayer = 0) then - begin - Result := I; - Break; - end - else - Dec(bPlayer); - end; - end; - end; - -begin - MaxPlayersPerScreen := 0; - - for I := 1 to 6 do - begin - // if there are enough positions -> write to maxplayers - if (GetPositionCountbyPlayerCount(I) = I) then - MaxPlayersPerScreen := I - else - Break; - end; - - // split players to both screens or display on one screen - if (Screens = 2) and (MaxPlayersPerScreen < PlayerCount) then - begin - PlC[0] := PlayerCount div 2 + PlayerCount mod 2; - PlC[1] := PlayerCount div 2; - end - else - begin - PlC[0] := PlayerCount; - PlC[1] := 0; - end; - - // check if there are enough positions for all players - for I := 0 to Screens - 1 do - begin - if (PlC[I] > MaxPlayersperScreen) then - begin - PlC[I] := MaxPlayersperScreen; - Log.LogError('More Players than available Positions, TSingScores'); - end; - end; - - CurPlayer := 0; - // give every player a position - for I := 0 to Screens - 1 do - for J := 0 to PlC[I]-1 do - begin - aPlayers[CurPlayer].Position := GetPositionbyPlayernum(PlC[I], J) or (I shl 7); - // Log.LogError('Player ' + InttoStr(CurPlayer) + ' gets Position: ' + InttoStr(aPlayers[CurPlayer].Position)); - Inc(CurPlayer); - end; -end; - -{** - * draws scores and linebonus popups - *} -procedure TSingScores.Draw; -var - I: integer; - CurTime: cardinal; - CurPopUp, LastPopUp: PScorePopUp; -begin - CurTime := SDL_GetTicks; - if (TimePassed <> 0) then - TimePassed := CurTime - TimePassed; - - if Visible then - begin - // draw popups - LastPopUp := nil; - CurPopUp := FirstPopUp; - - while (CurPopUp <> nil) do - begin - if (CurTime - CurPopUp.TimeStamp > Settings.Phase1Time + Settings.Phase2Time + Settings.Phase3Time) then - begin - KillPopUp(LastPopUp, CurPopUp); - if (LastPopUp = nil) then - CurPopUp := FirstPopUp - else - CurPopUp := LastPopUp.Next; - end - else - begin - DrawPopUp(CurPopUp); - LastPopUp := CurPopUp; - CurPopUp := LastPopUp.Next; - end; - end; - - - if (RBVisible) then - // draw players w/ rating bar - for I := 0 to PlayerCount-1 do - begin - DoRaiseScore(I); - DrawScore(I); - DrawRatingBar(I); - end - else - // 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 - if (S > 0) then - Diff := Min(Round(RoundTo((RaisePerSecond * TimePassed) / 1000, 1)), S) - else - Diff := Max(Round(RoundTo((RaisePerSecond * TimePassed) / 1000, 1)), S); - - Inc(aPlayers[Index].ScoreDisplayed, Diff); - end; -end; - -{** - * draws a popup by pointer - *} -procedure TSingScores.DrawPopUp(const PopUp: PScorePopUp); -var - Progress: real; - CurTime: cardinal; - X, Y, W, H, Alpha: real; - FontSize: integer; - FontOffset: real; - TimeDiff: cardinal; - PIndex: byte; - TextLen: real; - ScoretoAdd: word; - PosDiff: real; -begin - if (PopUp <> nil) then - begin - // only draw if player has a position - PIndex := Players[PopUp.Player].Position; - if PIndex <> High(byte) then - begin - // only draw if player is on cur screen - if ((Players[PopUp.Player].Position and 128) = 0) = (ScreenAct = 1) then - begin - CurTime := SDL_GetTicks; - if not (Enabled and Players[PopUp.Player].Enabled) then - // increase timestamp with tiem where there is no movement ... - begin - // Inc(PopUp.TimeStamp, LastRender); - end; - TimeDiff := CurTime - PopUp.TimeStamp; - - // get position of popup - PIndex := PIndex and 127; - - - // check for phase ... - if (TimeDiff <= Settings.Phase1Time) then - begin - // phase 1 - the ploping up - Progress := TimeDiff / Settings.Phase1Time; - - - W := Positions[PIndex].PUW * Sin(Progress/2*Pi); - H := Positions[PIndex].PUH * Sin(Progress/2*Pi); - - X := Positions[PIndex].PUStartX + (Positions[PIndex].PUW - W)/2; - Y := Positions[PIndex].PUStartY + (Positions[PIndex].PUH - H)/2; - - FontSize := Round(Progress * Positions[PIndex].PUFontSize); - FontOffset := (H - FontSize) / 2; - Alpha := 1; - end - - else if (TimeDiff <= Settings.Phase2Time + Settings.Phase1Time) then - begin - // phase 2 - the moving - Progress := (TimeDiff - Settings.Phase1Time) / Settings.Phase2Time; - - W := Positions[PIndex].PUW; - H := Positions[PIndex].PUH; - - PosDiff := Positions[PIndex].PUTargetX - Positions[PIndex].PUStartX; - if PosDiff > 0 then - PosDiff := PosDiff + W; - X := Positions[PIndex].PUStartX + PosDiff * sqr(Progress); - - PosDiff := Positions[PIndex].PUTargetY - Positions[PIndex].PUStartY; - if PosDiff < 0 then - PosDiff := PosDiff + Positions[PIndex].BGH; - Y := Positions[PIndex].PUStartY + PosDiff * sqr(Progress); - - FontSize := Positions[PIndex].PUFontSize; - FontOffset := (H - FontSize) / 2; - Alpha := 1 - 0.3 * Progress; - end - - else - begin - // phase 3 - the fading out + score adding - Progress := (TimeDiff - Settings.Phase1Time - Settings.Phase2Time) / Settings.Phase3Time; - - if (PopUp.Rating > 0) then - begin - // add scores if player enabled - if (Enabled and Players[PopUp.Player].Enabled) then - begin - ScoreToAdd := Round(PopUp.ScoreDiff * Progress) - PopUp.ScoreGiven; - Inc(PopUp.ScoreGiven, ScoreToAdd); - aPlayers[PopUp.Player].ScoreDisplayed := Players[PopUp.Player].ScoreDisplayed + ScoreToAdd; - - // change bar positions - if PopUp.ScoreDiff = 0 then - Log.LogError('TSingScores.DrawPopUp', 'PopUp.ScoreDiff is 0 and we want to divide by it. No idea how this happens.') - else - aPlayers[PopUp.Player].RBTarget := aPlayers[PopUp.Player].RBTarget + ScoreToAdd/PopUp.ScoreDiff * (PopUp.Rating / 20 - 0.26); - if (aPlayers[PopUp.Player].RBTarget > 1) then - aPlayers[PopUp.Player].RBTarget := 1 - else if (aPlayers[PopUp.Player].RBTarget < 0) then - aPlayers[PopUp.Player].RBTarget := 0; - end; - - // set positions etc. - Alpha := 0.7 - 0.7 * Progress; - - W := Positions[PIndex].PUW; - H := Positions[PIndex].PUH; - - PosDiff := Positions[PIndex].PUTargetX - Positions[PIndex].PUStartX; - if (PosDiff > 0) then - PosDiff := W - else - PosDiff := 0; - X := Positions[PIndex].PUTargetX + PosDiff * Progress; - - PosDiff := Positions[PIndex].PUTargetY - Positions[PIndex].PUStartY; - if (PosDiff < 0) then - PosDiff := -Positions[PIndex].BGH - else - PosDiff := 0; - Y := Positions[PIndex].PUTargetY - PosDiff * (1 - Progress); - - FontSize := Positions[PIndex].PUFontSize; - FontOffset := (H - FontSize) / 2; - end - else - begin - // here the effect that should be shown if a popup without score is drawn - // and or spawn with the graphicobjects etc. - // some work for blindy to do :p - - // atm: just let it slide in the scores just like the normal popup - Alpha := 0; - end; - end; - - // draw popup - - if (Alpha > 0) and (Players[PopUp.Player].Visible) then - begin - // draw bg: - glEnable(GL_TEXTURE_2D); - glEnable(GL_BLEND); - glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); - - glColor4f(1,1,1, Alpha); - glBindTexture(GL_TEXTURE_2D, Settings.PopUpTex[PopUp.Rating].TexNum); - - glBegin(GL_QUADS); - glTexCoord2f(0, 0); glVertex2f(X, Y); - glTexCoord2f(0, Settings.PopUpTex[PopUp.Rating].TexH); glVertex2f(X, Y + H); - glTexCoord2f(Settings.PopUpTex[PopUp.Rating].TexW, Settings.PopUpTex[PopUp.Rating].TexH); glVertex2f(X + W, Y + H); - glTexCoord2f(Settings.PopUpTex[PopUp.Rating].TexW, 0); glVertex2f(X + W, Y); - glEnd; - - glDisable(GL_TEXTURE_2D); - glDisable(GL_BLEND); - - // set font style and size - SetFontStyle(Positions[PIndex].PUFont); - SetFontItalic(false); - SetFontSize(FontSize); - SetFontReflection(false, 0); - - // draw text - TextLen := glTextWidth(Theme.Sing.LineBonusText[PopUp.Rating]); - - // color and pos - SetFontPos (X + (W - TextLen) / 2, Y + FontOffset); - glColor4f(1, 1, 1, Alpha); - - // draw - glPrint(Theme.Sing.LineBonusText[PopUp.Rating]); - end; // eo alpha check - end; // eo right screen - end; // eo player has position - end - else - Log.LogError('TSingScores: Try to draw a non-existing popup'); -end; - -{** - * draws a score by playerindex - *} -procedure TSingScores.DrawScore(const Index: integer); -var - Position: PScorePosition; - ScoreStr: String; -begin - // only draw if player has a position - if Players[Index].Position <> High(byte) then - begin - // only draw if player is on cur screen - if (((Players[Index].Position and 128) = 0) = (ScreenAct = 1)) and Players[Index].Visible then - begin - Position := @Positions[Players[Index].Position and 127]; - - // draw scorebg - glEnable(GL_TEXTURE_2D); - glEnable(GL_BLEND); - glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); - - glColor4f(1,1,1, 1); - glBindTexture(GL_TEXTURE_2D, Players[Index].ScoreBG.TexNum); - - glBegin(GL_QUADS); - glTexCoord2f(0, 0); glVertex2f(Position.BGX, Position.BGY); - glTexCoord2f(0, Players[Index].ScoreBG.TexH); glVertex2f(Position.BGX, Position.BGY + Position.BGH); - glTexCoord2f(Players[Index].ScoreBG.TexW, Players[Index].ScoreBG.TexH); glVertex2f(Position.BGX + Position.BGW, Position.BGY + Position.BGH); - glTexCoord2f(Players[Index].ScoreBG.TexW, 0); glVertex2f(Position.BGX + Position.BGW, Position.BGY); - glEnd; - - glDisable(GL_TEXTURE_2D); - glDisable(GL_BLEND); - - // draw score text - SetFontStyle(Position.TextFont); - SetFontItalic(false); - SetFontSize(Position.TextSize); - SetFontPos(Position.TextX, Position.TextY); - SetFontReflection(false, 0); - - ScoreStr := InttoStr(Players[Index].ScoreDisplayed div 10) + '0'; - while (Length(ScoreStr) < 5) do - ScoreStr := '0' + ScoreStr; - - glPrint(ScoreStr); - - end; // eo right screen - end; // eo player has position -end; - - -procedure TSingScores.DrawRatingBar(const Index: integer); -var - Position: PScorePosition; - R, G, B: real; - Size, Diff: real; -begin - // only draw if player has a position - if Players[Index].Position <> High(byte) then - begin - // only draw if player is on cur screen - if (((Players[Index].Position and 128) = 0) = (ScreenAct = 1) and - Players[index].RBVisible and - Players[index].Visible) then - begin - Position := @Positions[Players[Index].Position and 127]; - - if (Enabled and Players[Index].Enabled) then - begin - // move position if enabled - Diff := Players[Index].RBTarget - Players[Index].RBPos; - if (Abs(Diff) < 0.02) then - aPlayers[Index].RBPos := aPlayers[Index].RBTarget - else - aPlayers[Index].RBPos := aPlayers[Index].RBPos + Diff*0.1; - end; - - // get colors for rating bar - if (Players[index].RBPos <= 0.22) then - begin - R := 1; - G := 0; - B := 0; - end - else if (Players[index].RBPos <= 0.42) then - begin - R := 1; - G := Players[index].RBPos * 5; - B := 0; - end - else if (Players[index].RBPos <= 0.57) then - begin - R := 1; - G := 1; - B := 0; - end - else if (Players[index].RBPos <= 0.77) then - begin - R := 1 - (Players[index].RBPos - 0.57) * 5; - G := 1; - B := 0; - end - else - begin - R := 0; - G := 1; - B := 0; - end; - - // enable all glfuncs needed - glEnable(GL_TEXTURE_2D); - glEnable(GL_BLEND); - glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA); - - // draw rating bar bg - glColor4f(1, 1, 1, 0.8); - glBindTexture(GL_TEXTURE_2D, Settings.RatingBar_BG_Tex.TexNum); - - glBegin(GL_QUADS); - glTexCoord2f(0, 0); - glVertex2f(Position.RBX, Position.RBY); - - glTexCoord2f(0, Settings.RatingBar_BG_Tex.TexH); - glVertex2f(Position.RBX, Position.RBY+Position.RBH); - - glTexCoord2f(Settings.RatingBar_BG_Tex.TexW, Settings.RatingBar_BG_Tex.TexH); - glVertex2f(Position.RBX+Position.RBW, Position.RBY+Position.RBH); - - glTexCoord2f(Settings.RatingBar_BG_Tex.TexW, 0); - glVertex2f(Position.RBX+Position.RBW, Position.RBY); - glEnd; - - // draw rating bar itself - Size := Position.RBX + Position.RBW * Players[Index].RBPos; - glColor4f(R, G, B, 1); - glBindTexture(GL_TEXTURE_2D, Settings.RatingBar_Bar_Tex.TexNum); - glBegin(GL_QUADS); - glTexCoord2f(0, 0); - glVertex2f(Position.RBX, Position.RBY); - - glTexCoord2f(0, Settings.RatingBar_Bar_Tex.TexH); - glVertex2f(Position.RBX, Position.RBY + Position.RBH); - - glTexCoord2f(Settings.RatingBar_Bar_Tex.TexW, Settings.RatingBar_Bar_Tex.TexH); - glVertex2f(Size, Position.RBY + Position.RBH); - - glTexCoord2f(Settings.RatingBar_Bar_Tex.TexW, 0); - glVertex2f(Size, Position.RBY); - glEnd; - - // draw rating bar fg (the thing with the 3 lines to get better readability) - glColor4f(1, 1, 1, 0.6); - glBindTexture(GL_TEXTURE_2D, Settings.RatingBar_FG_Tex.TexNum); - glBegin(GL_QUADS); - glTexCoord2f(0, 0); - glVertex2f(Position.RBX, Position.RBY); - - glTexCoord2f(0, Settings.RatingBar_FG_Tex.TexH); - glVertex2f(Position.RBX, Position.RBY + Position.RBH); - - glTexCoord2f(Settings.RatingBar_FG_Tex.TexW, Settings.RatingBar_FG_Tex.TexH); - glVertex2f(Position.RBX + Position.RBW, Position.RBY + Position.RBH); - - glTexCoord2f(Settings.RatingBar_FG_Tex.TexW, 0); - glVertex2f(Position.RBX + Position.RBW, Position.RBY); - glEnd; - - // disable all enabled glfuncs - glDisable(GL_TEXTURE_2D); - glDisable(GL_BLEND); - end; // eo Right Screen - end; // eo Player has Position -end; - -end. diff --git a/src/base/USkins.pas b/src/base/USkins.pas deleted file mode 100644 index 6ef5c596..00000000 --- a/src/base/USkins.pas +++ /dev/null @@ -1,220 +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 USkins; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses - UPath; - -type - TSkinTexture = record - Name: string; - FileName: IPath; - end; - - TSkinEntry = record - Theme: string; - Name: string; - Path: IPath; - FileName: IPath; - Creator: string; // not used yet - end; - - TSkin = class - Skin: array of TSkinEntry; - SkinTexture: array of TSkinTexture; - SkinPath: IPath; - Color: integer; - constructor Create; - procedure LoadList; - procedure ParseDir(Dir: IPath); - procedure LoadHeader(FileName: IPath); - procedure LoadSkin(Name: string); - function GetTextureFileName(TextureName: string): IPath; - function GetSkinNumber(Name: string): integer; - procedure onThemeChange; - end; - -var - Skin: TSkin; - -implementation - -uses - IniFiles, - Classes, - SysUtils, - UIni, - ULog, - UMain, - UPathUtils, - UFileSystem; - -constructor TSkin.Create; -begin - inherited; - LoadList; -// LoadSkin('...'); -// SkinColor := Color; -end; - -procedure TSkin.LoadList; -var - Iter: IFileIterator; - DirInfo: TFileInfo; -begin - Iter := FileSystem.FileFind(SkinsPath.Append('*'), faDirectory); - while Iter.HasNext do - begin - 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: IPath); -var - Iter: IFileIterator; - IniInfo: TFileInfo; -begin - Iter := FileSystem.FileFind(Dir.Append('*.ini'), 0); - while Iter.HasNext do - begin - IniInfo := Iter.Next; - LoadHeader(Dir.Append(IniInfo.Name)); - end; -end; - -procedure TSkin.LoadHeader(FileName: IPath); -var - SkinIni: TMemIniFile; - S: integer; -begin - SkinIni := TMemIniFile.Create(FileName.ToNative); - - S := Length(Skin); - SetLength(Skin, S+1); - - 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', ''); - - SkinIni.Free; -end; - -procedure TSkin.LoadSkin(Name: string); -var - SkinIni: TMemIniFile; - SL: TStringList; - T: integer; - S: integer; -begin - S := GetSkinNumber(Name); - SkinPath := Skin[S].Path; - - SkinIni := TMemIniFile.Create(SkinPath.Append(Skin[S].FileName).ToNative); - - SL := TStringList.Create; - SkinIni.ReadSection('Textures', SL); - - SetLength(SkinTexture, SL.Count); - for T := 0 to SL.Count-1 do - begin - SkinTexture[T].Name := SL.Strings[T]; - SkinTexture[T].FileName := Path(SkinIni.ReadString('Textures', SL.Strings[T], '')); - end; - - SL.Free; - SkinIni.Free; -end; - -function TSkin.GetTextureFileName(TextureName: string): IPath; -var - T: integer; -begin - Result := PATH_NONE; - - for T := 0 to High(SkinTexture) do - begin - if (SkinTexture[T].Name = TextureName) and - (SkinTexture[T].FileName.IsSet) then - begin - Result := SkinPath.Append(SkinTexture[T].FileName); - end; - end; - - 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; -var - S: integer; -begin - Result := 0; // set default to the first available skin - for S := 0 to High(Skin) do - if Skin[S].Name = Name then - Result := S; -end; - -procedure TSkin.onThemeChange; -var - S: integer; - Name: String; -begin - Ini.SkinNo:=0; - SetLength(ISkin, 0); - Name := Uppercase(ITheme[Ini.Theme]); - for S := 0 to High(Skin) do - if Name = Uppercase(Skin[S].Theme) then - begin - SetLength(ISkin, Length(ISkin)+1); - ISkin[High(ISkin)] := Skin[S].Name; - end; - -end; - -end. diff --git a/src/base/USong.pas b/src/base/USong.pas deleted file mode 100644 index 705206c4..00000000 --- a/src/base/USong.pas +++ /dev/null @@ -1,1348 +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 USong; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses - {$IFDEF MSWINDOWS} - Windows, - {$ELSE} - {$IFNDEF DARWIN} - syscall, - {$ENDIF} - baseunix, - UnixType, - {$ENDIF} - SysUtils, - Classes, - UPlatform, - ULog, - UTexture, - UCommon, - {$IFDEF DARWIN} - cthreads, - {$ENDIF} - {$IFDEF USE_PSEUDO_THREAD} - PseudoThread, - {$ENDIF} - UCatCovers, - UXMLSong, - UUnicodeUtils, - UTextEncoding, - UFilesystem, - UPath; - -type - - TSingMode = ( smNormal, smPartyMode, smPlaylistRandom ); - - TBPM = record - BPM: real; - StartBeat: real; - end; - - TScore = record - Name: UTF8String; - Score: integer; - 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 - - function DecodeFilename(Filename: RawByteString): IPath; - function Solmizate(Note: integer; Type_: integer): string; - procedure ParseNote(LineNumber: integer; TypeP: char; StartP, DurationP, NoteP: integer; LyricS: UTF8String); - procedure NewSentence(LineNumberP: integer; Param1, Param2: integer); - - 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: 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 - Genre: UTF8String; - Edition: UTF8String; - Language: UTF8String; - Year: Integer; - - Title: UTF8String; - Artist: UTF8String; - - Creator: UTF8String; - - CoverTex: TTexture; - - VideoGAP: real; - NotesGAP: integer; - Start: real; // in seconds - Finish: integer; // in miliseconds - Relative: boolean; - Resolution: integer; - 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 - Visible: boolean; // false if hidden, true if visible - Main: boolean; // false for songs, true for category buttons - OrderNum: integer; // has a number of category for category buttons and songs - OrderTyp: integer; // type of sorting for this button (0=name) - CatNumber: integer; // Count of Songs in Category for Cats and Number of Song in Category for Songs - - Base : array[0..1] of integer; - Rel : array[0..1] of integer; - Mult : integer; - MultBPM : integer; - - LastError: AnsiString; - function GetErrorLineNo: integer; - property ErrorLineNo: integer read GetErrorLineNo; - - - constructor Create(); overload; - constructor Create(const aFileName : IPath); overload; - function LoadSong: boolean; - function LoadXMLSong: boolean; - function Analyse(const ReadCustomTags: Boolean = false): boolean; - function AnalyseXML(): boolean; - procedure Clear(); - end; - -implementation - -uses - StrUtils, - TextGL, - UIni, - 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; - -// 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 - begin - CurSongPath := SongPaths[I] as IPath; - if (aFileName.IsChildOf(CurSongPath, false)) then - begin - if (aFileName.IsChildOf(CurSongPath, true)) then - begin - // 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; - - LastError := ''; - - Self.Path := aFileName.GetPath; - Self.FileName := aFileName.GetName; - Self.Folder := GetFolderCategory(aFileName); - - (* - if (aFileName.IsFile) then - begin - if ReadTXTHeader(aFileName) then - begin - LoadSong(); - end - else - 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.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 - { to-do : decide what to do here - usdx < 1.1 does not nead a whitespace after a char param - so we may just write a warning to error.log and use the - first non whitespace character instead of raising an - exception that causes the song not to load. So the more - error resistant code is: - LinePos := OldLinePos + 1; - // raise EUSDXParseException.Create('Character expected'); } - LinePos := OldLinePos; - raise EUSDXParseException.Create('Character expected'); - end; - Result := Str[1]; -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 - CurLine: RawByteString; - LinePos: integer; - Count: integer; - Both: boolean; - - Param0: AnsiChar; - Param1: integer; - Param2: integer; - Param3: integer; - ParamLyric: UTF8String; - - I: integer; - NotesFound: boolean; - SongFile: TTextFileStream; - FileNamePath: IPath; -begin - Result := false; - LastError := ''; - - FileNamePath := Path.Append(FileName); - if not FileNamePath.IsFile() then - begin - LastError := 'ERROR_CORRUPT_SONG_FILE_NOT_FOUND'; - 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; - Both := false; - - if Length(Player) = 2 then - Both := true; - - try - // Open song file for reading..... - 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 (not NotesFound) then - begin //Song File Corrupted - No Notes - Log.LogError('Could not load txt File, no notes found: ' + FileNamePath.ToNative); - LastError := 'ERROR_CORRUPT_SONG_NO_NOTES'; - Exit; - end; - - 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 true do - begin - LinePos := 1; - - 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 - - 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]; - - self.BPM[High(self.BPM)].BPM := ParseLyricFloatParam(CurLine, LinePos); - self.BPM[High(self.BPM)].BPM := self.BPM[High(self.BPM)].BPM * Mult * MultBPM; - end; - - // Read next line in File - if (not SongFile.ReadLine(CurLine)) then - Break; - - Inc(FileLineNo); - end; // while - finally - SongFile.Free; - end; - except - on E: Exception do - begin - Log.LogError(Format('Error loading file: "%s" in line %d,%d: %s', - [FileNamePath.ToNative, FileLineNo, LinePos, E.Message])); - Exit; - end; - end; - - for I := 0 to High(Lines) 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 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; - - 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; -end; - -//Load XML Song -function TSong.LoadXMLSong(): boolean; -var - Count: integer; - Both: boolean; - Param1: integer; - Param2: integer; - Param3: integer; - ParamS: string; - I, J: integer; - NoteIndex: integer; - - NoteType: char; - SentenceEnd, Rest, Time: integer; - Parser: TParser; - FileNamePath: IPath; -begin - Result := false; - LastError := ''; - - FileNamePath := Path.Append(FileName); - if not FileNamePath.IsFile() then - begin - 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 - Lines[0].ScoreValue := 0; - self.Relative := false; - Rel[0] := 0; - Both := false; - - if Length(Player) = 2 then - Both := true; - - Parser := TParser.Create; - Parser.Settings.DashReplacement := '~'; - - 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; - - //Try to Parse the Song - - if Parser.ParseSong(FileNamePath) then - begin - //Writeln('XML Inputfile Parsed succesful'); - - //Start write parsed information to Song - //Notes Part - for I := 0 to High(Parser.SongInfo.Sentences) do - begin - //Add Notes - for J := 0 to High(Parser.SongInfo.Sentences[I].Notes) do - begin - case Parser.SongInfo.Sentences[I].Notes[J].NoteTyp of - NT_Normal: NoteType := ':'; - NT_Golden: NoteType := '*'; - NT_Freestyle: NoteType := 'F'; - end; - - Param1:=Parser.SongInfo.Sentences[I].Notes[J].Start; //Note Start - Param2:=Parser.SongInfo.Sentences[I].Notes[J].Duration; //Note Duration - Param3:=Parser.SongInfo.Sentences[I].Notes[J].Tone; //Note Tone - ParamS:=' ' + Parser.SongInfo.Sentences[I].Notes[J].Lyric; //Note Lyric - - if not Both then - // P1 - ParseNote(0, NoteType, (Param1+Rel[0]) * Mult, Param2 * Mult, Param3, ParamS) - else - begin - // P1 + P2 - ParseNote(0, NoteType, (Param1+Rel[0]) * Mult, Param2 * Mult, Param3, ParamS); - ParseNote(1, NoteType, (Param1+Rel[1]) * Mult, Param2 * Mult, Param3, ParamS); - end; - - end; //J Forloop - - //Add Sentence break - if (I < High(Parser.SongInfo.Sentences)) then - begin - SentenceEnd := Parser.SongInfo.Sentences[I].Notes[High(Parser.SongInfo.Sentences[I].Notes)].Start + Parser.SongInfo.Sentences[I].Notes[High(Parser.SongInfo.Sentences[I].Notes)].Duration; - Rest := Parser.SongInfo.Sentences[I+1].Notes[0].Start - SentenceEnd; - - //Calculate Time - case Rest of - 0, 1: Time := Parser.SongInfo.Sentences[I+1].Notes[0].Start; - 2: Time := Parser.SongInfo.Sentences[I+1].Notes[0].Start - 1; - 3: Time := Parser.SongInfo.Sentences[I+1].Notes[0].Start - 2; - else - if (Rest >= 4) then - Time := SentenceEnd + 2 - else //Sentence overlapping :/ - Time := Parser.SongInfo.Sentences[I+1].Notes[0].Start; - end; - // new sentence - if not Both then // P1 - NewSentence(0, (Time + Rel[0]) * Mult, Param2) - else - begin // P1 + P2 - NewSentence(0, (Time + Rel[0]) * Mult, Param2); - NewSentence(1, (Time + Rel[1]) * Mult, Param2); - end; - - end; - end; - //End write parsed information to Song - Parser.Free; - end - else - begin - Log.LogError('Could not parse inputfile: ' + FileNamePath.ToNative); - exit; - end; - - for Count := 0 to High(Lines) do - begin - Lines[Count].Line[High(Lines[Count].Line)].LastLine := true; - end; - - Result := true; -end; - -function TSong.ReadXMLHeader(const aFileName : IPath): boolean; -var - Done : byte; - Parser : TParser; - FileNamePath: IPath; -begin - Result := true; - Done := 0; - - //Parse XML - Parser := TParser.Create; - Parser.Settings.DashReplacement := '~'; - - FileNamePath := Self.Path.Append(Self.FileName); - if Parser.ParseSong(FileNamePath) then - begin - //----------- - //Required Attributes - //----------- - - //Title - self.Title := Parser.SongInfo.Header.Title; - - //Add Title Flag to Done - Done := Done or 1; - - //Artist - self.Artist := Parser.SongInfo.Header.Artist; - - //Add Artist Flag to Done - Done := Done or 2; - - //MP3 File //Test if Exists - Self.Mp3 := FindSongFile(Self.Path, '*.mp3'); - //Add Mp3 Flag to Done - if (Self.Path.Append(Self.Mp3).IsFile()) then - Done := Done or 4; - - //Beats per Minute - SetLength(self.BPM, 1); - self.BPM[0].StartBeat := 0; - - self.BPM[0].BPM := (Parser.SongInfo.Header.BPM * Parser.SongInfo.Header.Resolution/4 ) * Mult * MultBPM; - - //Add BPM Flag to Done - if self.BPM[0].BPM <> 0 then - Done := Done or 8; - - //--------- - //Additional Header Information - //--------- - - // Gap - self.GAP := Parser.SongInfo.Header.Gap; - - //Cover Picture - self.Cover := FindSongFile(Path, '*[CO].jpg'); - - //Background Picture - self.Background := FindSongFile(Path, '*[BG].jpg'); - - // Video File - // self.Video := Value - - // Video Gap - // self.VideoGAP := StrtoFloatI18n( Value ) - - //Genre Sorting - self.Genre := Parser.SongInfo.Header.Genre; - - //Edition Sorting - self.Edition := Parser.SongInfo.Header.Edition; - - //Year Sorting - //Parser.SongInfo.Header.Year - - //Language Sorting - self.Language := Parser.SongInfo.Header.Language; - end - else - Log.LogError('File incomplete or not SingStar XML (A): ' + aFileName.ToNative); - - Parser.Free; - - //Check if all Required Values are given - if (Done <> 15) then - begin - Result := false; - if (Done and 8) = 0 then //No BPM Flag - Log.LogError('BPM tag missing: ' + self.FileName.ToNative) - else if (Done and 4) = 0 then //No MP3 Flag - 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.ToNative) - else if (Done and 1) = 0 then //No Title Flag - Log.LogError('Title tag missing: ' + self.FileName.ToNative) - else //unknown Error - 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(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 - 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; -begin - Result := true; - Done := 0; - - FullFileName := Path.Append(Filename).ToNative; - - //Read first Line - SongFile.ReadLine(Line); - if (Length(Line) <= 0) then - begin - 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); - SepPos := Pos(':', Line); - - //Line has no Seperator, ignore non header field - if (SepPos = 0) then - begin - AddCustomTag('', Copy(Line, 2, Length(Line) - 1)); - // read next line - if (not SongFile.ReadLine(Line)) then - begin - Result := false; - Log.LogError('File incomplete or not Ultrastar txt (A): ' + FullFileName); - Break; - end; - Continue; - end; - - //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)); - - //Check the Identifier (If Value is given) - if (Length(Value) = 0) then - begin - Log.LogWarn('Empty field "'+Identifier+'" in file ' + FullFileName, - 'TSong.ReadTXTHeader'); - AddCustomTag(Identifier, ''); - end - else - begin - - //----------- - //Required Attributes - //----------- - - if (Identifier = 'TITLE') then - begin - DecodeStringUTF8(Value, Title, Encoding); - //Add Title Flag to Done - Done := Done or 1; - end - - else if (Identifier = 'ARTIST') then - begin - DecodeStringUTF8(Value, Artist, Encoding); - //Add Artist Flag to Done - Done := Done or 2; - end - - //MP3 File - else if (Identifier = 'MP3') then - begin - EncFile := DecodeFilename(Value); - if (Self.Path.Append(EncFile).IsFile) then - begin - self.Mp3 := EncFile; - - //Add Mp3 Flag to Done - Done := Done or 4; - end; - end - - //Beats per Minute - else if (Identifier = 'BPM') then - begin - SetLength(self.BPM, 1); - self.BPM[0].StartBeat := 0; - - self.BPM[0].BPM := StrToFloatI18n( Value ) * Mult * MultBPM; - - if self.BPM[0].BPM <> 0 then - begin - //Add BPM Flag to Done - Done := Done or 8; - end; - end - - //--------- - //Additional Header Information - //--------- - - // Gap - else if (Identifier = 'GAP') then - begin - self.GAP := StrToFloatI18n(Value); - end - - //Cover Picture - else if (Identifier = 'COVER') then - begin - self.Cover := DecodeFilename(Value); - end - - //Background Picture - else if (Identifier = 'BACKGROUND') then - begin - self.Background := DecodeFilename(Value); - end - - // 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 - - // Video Gap - else if (Identifier = 'VIDEOGAP') then - begin - self.VideoGAP := StrToFloatI18n( Value ) - end - - //Genre Sorting - else if (Identifier = 'GENRE') then - begin - DecodeStringUTF8(Value, Genre, Encoding) - end - - //Edition Sorting - else if (Identifier = 'EDITION') then - begin - DecodeStringUTF8(Value, Edition, Encoding) - end - - //Creator Tag - else if (Identifier = 'CREATOR') then - begin - DecodeStringUTF8(Value, Creator, Encoding) - end - - //Language Sorting - else if (Identifier = 'LANGUAGE') then - begin - DecodeStringUTF8(Value, Language, Encoding) - end - - //Language Sorting - else if (Identifier = 'YEAR') then - begin - TryStrtoInt(Value, self.Year) - end - - // Song Start - else if (Identifier = 'START') then - begin - self.Start := StrToFloatI18n( Value ) - end - - // Song Ending - else if (Identifier = 'END') then - begin - TryStrtoInt(Value, self.Finish) - end - - // Resolution - else if (Identifier = 'RESOLUTION') then - begin - TryStrtoInt(Value, self.Resolution) - end - - // Notes Gap - else if (Identifier = 'NOTESGAP') then - begin - TryStrtoInt(Value, self.NotesGAP) - end - - // 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; // 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): ' + FullFileName); - Break; - end; - end; // while - - 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: ' + FullFileName) - else if (Done and 4) = 0 then //No MP3 Flag - Log.LogError('MP3 tag/file missing: ' + FullFileName) - else if (Done and 2) = 0 then //No Artist Flag - Log.LogError('Artist tag missing: ' + FullFileName) - else if (Done and 1) = 0 then //No Title Flag - Log.LogError('Title tag missing: ' + FullFileName) - else //unknown Error - Log.LogError('File incomplete or not Ultrastar txt (B - '+ inttostr(Done) +'): ' + FullFileName); - end; -end; - -function TSong.GetErrorLineNo: integer; -begin - if (LastError='ERROR_CORRUPT_SONG_ERROR_IN_LINE') then - Result := FileLineNo - else - Result := -1; -end; - -function TSong.Solmizate(Note: integer; Type_: integer): string; -begin - case (Type_) of - 1: // european - begin - case (Note mod 12) of - 0..1: Result := ' do '; - 2..3: Result := ' re '; - 4: Result := ' mi '; - 5..6: Result := ' fa '; - 7..8: Result := ' sol '; - 9..10: Result := ' la '; - 11: Result := ' si '; - end; - end; - 2: // japanese - begin - case (Note mod 12) of - 0..1: Result := ' do '; - 2..3: Result := ' re '; - 4: Result := ' mi '; - 5..6: Result := ' fa '; - 7..8: Result := ' so '; - 9..10: Result := ' la '; - 11: Result := ' shi '; - end; - end; - 3: // american - begin - case (Note mod 12) of - 0..1: Result := ' do '; - 2..3: Result := ' re '; - 4: Result := ' mi '; - 5..6: Result := ' fa '; - 7..8: Result := ' sol '; - 9..10: Result := ' la '; - 11: Result := ' ti '; - end; - end; - end; // case -end; - -procedure TSong.ParseNote(LineNumber: integer; TypeP: char; StartP, DurationP, NoteP: integer; LyricS: UTF8String); -begin - if (Ini.Solmization <> 0) then - LyricS := Solmizate(NoteP, Ini.Solmization); - - with Lines[LineNumber].Line[Lines[LineNumber].High] do - begin - SetLength(Note, Length(Note) + 1); - HighNote := High(Note); - - Note[HighNote].Start := StartP; - if HighNote = 0 then - begin - if Lines[LineNumber].Number = 1 then - Start := -100; - //Start := Note[HighNote].Start; - end; - - Note[HighNote].Length := DurationP; - - // back to the normal system with normal, golden and now freestyle notes - case TypeP of - 'F': Note[HighNote].NoteType := ntFreestyle; - ':': Note[HighNote].NoteType := ntNormal; - '*': Note[HighNote].NoteType := ntGolden; - end; - - //add this notes value ("notes length" * "notes scorefactor") to the current songs entire value - Inc(Lines[LineNumber].ScoreValue, Note[HighNote].Length * ScoreFactor[Note[HighNote].NoteType]); - - //and to the current lines entire value - Inc(TotalNotes, Note[HighNote].Length * ScoreFactor[Note[HighNote].NoteType]); - - - Note[HighNote].Tone := NoteP; - - //if a note w/ a deeper pitch then the current basenote is found - //we replace the basenote w/ the current notes pitch - if Note[HighNote].Tone < BaseNote then - BaseNote := Note[HighNote].Tone; - - Note[HighNote].Color := 1; // default color to 1 for editor - - DecodeStringUTF8(LyricS, Note[HighNote].Text, Encoding); - Lyric := Lyric + Note[HighNote].Text; - - End_ := Note[HighNote].Start + Note[HighNote].Length; - end; // with -end; - -procedure TSong.NewSentence(LineNumberP: integer; Param1, Param2: integer); -var - I: integer; -begin - - if (Lines[LineNumberP].Line[Lines[LineNumberP].High].HighNote <> -1) then - begin //create a new line - SetLength(Lines[LineNumberP].Line, Lines[LineNumberP].Number + 1); - Inc(Lines[LineNumberP].High); - Inc(Lines[LineNumberP].Number); - 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.ToNative); - end; - - Lines[LineNumberP].Line[Lines[LineNumberP].High].HighNote := -1; - - //set the current lines value to zero - //it will be incremented w/ the value of every added note - Lines[LineNumberP].Line[Lines[LineNumberP].High].TotalNotes := 0; - - //basenote is the pitch of the deepest note, it is used for note drawing. - //if a note with a less value than the current sentences basenote is found, - //basenote will be set to this notes pitch. Therefore the initial value of - //this field has to be very high. - Lines[LineNumberP].Line[Lines[LineNumberP].High].BaseNote := High(Integer); - - - if self.Relative then - begin - Lines[LineNumberP].Line[Lines[LineNumberP].High].Start := Param1; - Rel[LineNumberP] := Rel[LineNumberP] + Param2; - end - else - Lines[LineNumberP].Line[Lines[LineNumberP].High].Start := Param1; - - Lines[LineNumberP].Line[Lines[LineNumberP].High].LastLine := false; -end; - -procedure TSong.Clear(); -begin - //Main Information - Title := ''; - Artist := ''; - - //Sortings: - Genre := 'Unknown'; - Edition := 'Unknown'; - Language := 'Unknown'; - Year := 0; - - // set to default encoding - Encoding := DEFAULT_ENCODING; - - // clear custom header tags - SetLength(CustomTags, 0); - - //Required Information - Mp3 := PATH_NONE; - SetLength(BPM, 0); - - GAP := 0; - Start := 0; - Finish := 0; - - //Additional Information - Background := PATH_NONE; - Cover := PATH_NONE; - Video := PATH_NONE; - VideoGAP := 0; - NotesGAP := 0; - Resolution := 4; - Creator := ''; - - Relative := false; -end; - -function TSong.Analyse(const ReadCustomTags: Boolean): boolean; -var - SongFile: TTextFileStream; -begin - Result := false; - - //Reset LineNo - FileLineNo := 0; - - //Open File and set File Pointer to the beginning - SongFile := TMemTextFileStream.Create(Self.Path.Append(Self.FileName), fmOpenRead); - try - //Clear old Song Header - Self.clear; - - //Read Header - Result := Self.ReadTxTHeader(SongFile, ReadCustomTags) - finally - SongFile.Free; - end; -end; - - -function TSong.AnalyseXML(): boolean; - -begin - Result := false; - - //Reset LineNo - FileLineNo := 0; - - //Clear old Song Header - self.clear; - - //Read Header - Result := self.ReadXMLHeader( FileName ); - -end; - -end. diff --git a/src/base/USongs.pas b/src/base/USongs.pas deleted file mode 100644 index baeec13a..00000000 --- a/src/base/USongs.pas +++ /dev/null @@ -1,845 +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 USongs; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -{$IFDEF DARWIN} - {$IFDEF DEBUG} - {$DEFINE USE_PSEUDO_THREAD} - {$ENDIF} -{$ENDIF} - -uses - SysUtils, - Classes, - {$IFDEF MSWINDOWS} - Windows, - DirWatch, - {$ELSE} - {$IFNDEF DARWIN} - syscall, - {$ENDIF} - baseunix, - UnixType, - {$ENDIF} - UPlatform, - ULog, - UTexture, - UCommon, - {$IFDEF USE_PSEUDO_THREAD} - PseudoThread, - {$ENDIF} - UPath, - USong, - UCatCovers; - -type - TSongFilter = ( - fltAll, - fltTitle, - fltArtist - ); - - TBPM = record - BPM: real; - StartBeat: real; - end; - - TScore = record - Name: UTF8String; - Score: integer; - Length: string; - end; - - TPathDynArray = array of IPath; - - {$IFDEF USE_PSEUDO_THREAD} - TSongs = class(TPseudoThread) - {$ELSE} - TSongs = class(TThread) - {$ENDIF} - private - fNotify, fWatch: longint; - fParseSongDirectory: boolean; - fProcessing: boolean; - {$ifdef MSWINDOWS} - fDirWatch: TDirectoryWatch; - {$endif} - procedure int_LoadSongList; - procedure DoDirChanged(Sender: TObject); - protected - procedure Execute; override; - public - SongList: TList; // array of songs - Selected: integer; // selected song index - constructor Create(); - destructor Destroy(); override; - - - procedure LoadSongList; // load all songs - procedure 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: integer); - property Processing: boolean read fProcessing; - end; - - - TCatSongs = class - Song: array of TSong; // array of categories with songs - Selected: integer; // selected song index - Order: integer; // order type (0=title) - CatNumShow: integer; // Category Number being seen - CatCount: integer; // Number of Categorys - - procedure SortSongs(); - procedure Refresh; // refreshes arrays by recreating them from Songs array - procedure ShowCategory(Index: integer); // expands all songs in category - procedure HideCategory(Index: integer); // hides all songs in category - procedure ClickCategoryButton(Index: integer); // uses ShowCategory and HideCategory when needed - procedure ShowCategoryList; // Hides all Songs And Show the List of all Categorys - function FindNextVisible(SearchFrom: integer): integer; // Find Next visible Song - function VisibleSongs: integer; // returns number of visible songs (for tabs) - function VisibleIndex(Index: integer): integer; // returns visible song index (skips invisible) - - function SetFilter(FilterStr: UTF8String; Filter: TSongFilter): cardinal; - end; - -var - Songs: TSongs; // all songs - CatSongs: TCatSongs; // categorized songs - -const - IN_ACCESS = $00000001; //* File was accessed */ - IN_MODIFY = $00000002; //* File was modified */ - IN_ATTRIB = $00000004; //* Metadata changed */ - IN_CLOSE_WRITE = $00000008; //* Writtable file was closed */ - IN_CLOSE_NOWRITE = $00000010; //* Unwrittable file closed */ - IN_OPEN = $00000020; //* File was opened */ - IN_MOVED_FROM = $00000040; //* File was moved from X */ - IN_MOVED_TO = $00000080; //* File was moved to Y */ - IN_CREATE = $00000100; //* Subfile was created */ - IN_DELETE = $00000200; //* Subfile was deleted */ - IN_DELETE_SELF = $00000400; //* Self was deleted */ - - -implementation - -uses - StrUtils, - UCovers, - UFiles, - UGraphic, - UMain, - UIni, - UPathUtils, - UNote, - UFilesystem, - UUnicodeUtils; - -constructor TSongs.Create(); -begin - // do not start thread BEFORE initialization (suspended = true) - inherited Create(true); - Self.FreeOnTerminate := true; - - SongList := TList.Create(); - - // FIXME: threaded loading does not work this way. - // It will just cause crashes but nothing else at the moment. -(* - {$ifdef MSWINDOWS} - fDirWatch := TDirectoryWatch.create(nil); - fDirWatch.OnChange := DoDirChanged; - fDirWatch.Directory := SongPath; - fDirWatch.WatchSubDirs := true; - fDirWatch.active := true; - {$ENDIF} - - // now we can start the thread - Resume(); -*) - - // until it is fixed, simply load the song-list - int_LoadSongList(); -end; - -destructor TSongs.Destroy(); -begin - FreeAndNil(SongList); - inherited; -end; - -procedure TSongs.DoDirChanged(Sender: TObject); -begin - LoadSongList(); -end; - -procedure TSongs.Execute(); -var - fChangeNotify: THandle; -begin -{$IFDEF USE_PSEUDO_THREAD} - int_LoadSongList(); -{$ELSE} - fParseSongDirectory := true; - - while not terminated do - begin - - if fParseSongDirectory then - begin - Log.LogStatus('Calling int_LoadSongList', 'TSongs.Execute'); - int_LoadSongList(); - end; - - Suspend(); - end; -{$ENDIF} -end; - -procedure TSongs.int_LoadSongList; -var - I: integer; -begin - try - fProcessing := true; - - Log.LogStatus('Searching For Songs', 'SongList'); - - // browse directories - for I := 0 to SongPaths.Count-1 do - BrowseDir(SongPaths[I] as IPath); - - if assigned(CatSongs) then - CatSongs.Refresh; - - if assigned(CatCovers) then - CatCovers.Load; - - //if assigned(Covers) then - // Covers.Load; - - if assigned(ScreenSong) then - begin - ScreenSong.GenerateThumbnails(); - ScreenSong.OnShow; // refresh ScreenSong - end; - - finally - Log.LogStatus('Search Complete', 'SongList'); - - fParseSongDirectory := false; - fProcessing := false; - end; -end; - - -procedure TSongs.LoadSongList; -begin - fParseSongDirectory := true; - Resume(); -end; - -procedure TSongs.BrowseDir(Dir: IPath); -begin - BrowseTXTFiles(Dir); - BrowseXMLFiles(Dir); -end; - -procedure TSongs.FindFilesByExtension(const Dir: IPath; const Ext: IPath; Recursive: Boolean; var Files: TPathDynArray); -var - Iter: IFileIterator; - FileInfo: TFileInfo; - FileName: IPath; -begin - // search for all files and directories - Iter := FileSystem.FileFind(Dir.Append('*'), faAnyFile); - while (Iter.HasNext) do - begin - FileInfo := Iter.Next; - FileName := FileInfo.Name; - if ((FileInfo.Attr and faDirectory) <> 0) then - begin - if Recursive and (not FileName.Equals('.')) and (not FileName.Equals('..')) then - FindFilesByExtension(Dir.Append(FileName), Ext, true, Files); - end - else - begin - if (Ext.Equals(FileName.GetExtension(), true)) then - begin - SetLength(Files, Length(Files)+1); - Files[High(Files)] := Dir.Append(FileName); - end; - end; - end; -end; - -procedure TSongs.BrowseTXTFiles(Dir: IPath); -var - I: integer; - Files: TPathDynArray; - Song: TSong; - Extension: IPath; -begin - SetLength(Files, 0); - Extension := Path('.txt'); - FindFilesByExtension(Dir, Extension, true, Files); - - for I := 0 to High(Files) do - begin - Song := TSong.Create(Files[I]); - - if Song.Analyse then - SongList.Add(Song) - else - begin - Log.LogError('AnalyseFile failed for "' + Files[I].ToNative + '".'); - FreeAndNil(Song); - end; - 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); -end; - -(* - * Comparison functions for sorting - *) - -function CompareByEdition(Song1, Song2: Pointer): integer; -begin - Result := UTF8CompareText(TSong(Song1).Edition, TSong(Song2).Edition); -end; - -function CompareByGenre(Song1, Song2: Pointer): integer; -begin - Result := UTF8CompareText(TSong(Song1).Genre, TSong(Song2).Genre); -end; - -function CompareByTitle(Song1, Song2: Pointer): integer; -begin - Result := UTF8CompareText(TSong(Song1).Title, TSong(Song2).Title); -end; - -function CompareByArtist(Song1, Song2: Pointer): integer; -begin - Result := UTF8CompareText(TSong(Song1).Artist, TSong(Song2).Artist); -end; - -function CompareByFolder(Song1, Song2: Pointer): integer; -begin - Result := UTF8CompareText(TSong(Song1).Folder, TSong(Song2).Folder); -end; - -function CompareByLanguage(Song1, Song2: Pointer): integer; -begin - Result := UTF8CompareText(TSong(Song1).Language, TSong(Song2).Language); -end; - -procedure TSongs.Sort(Order: integer); -var - CompareFunc: TListSortCompare; -begin - // FIXME: what is the difference between artist and artist2, etc.? - case Order of - sEdition: // by edition - CompareFunc := CompareByEdition; - sGenre: // by genre - CompareFunc := CompareByGenre; - sTitle: // by title - CompareFunc := CompareByTitle; - sArtist: // by artist - CompareFunc := CompareByArtist; - sFolder: // by folder - CompareFunc := CompareByFolder; - sArtist2: // by artist2 - CompareFunc := CompareByArtist; - sLanguage: // by Language - CompareFunc := CompareByLanguage; - else - Log.LogCritical('Unsupported comparison', 'TSongs.Sort'); - Exit; // suppress warning - end; // case - - // Note: Do not use TList.Sort() as it uses QuickSort which is instable. - // For example, if a list is sorted by title first and - // by artist afterwards, the songs of an artist will not be sorted by title anymore. - // The stable MergeSort guarantees to maintain this order. - MergeSort(SongList, CompareFunc); -end; - -procedure TCatSongs.SortSongs(); -begin - case Ini.Sorting of - sEdition: begin - Songs.Sort(sTitle); - Songs.Sort(sArtist); - Songs.Sort(sEdition); - end; - sGenre: begin - Songs.Sort(sTitle); - Songs.Sort(sArtist); - Songs.Sort(sGenre); - end; - sLanguage: begin - Songs.Sort(sTitle); - Songs.Sort(sArtist); - Songs.Sort(sLanguage); - end; - sFolder: begin - Songs.Sort(sTitle); - Songs.Sort(sArtist); - Songs.Sort(sFolder); - end; - sTitle: begin - Songs.Sort(sTitle); - end; - sArtist: begin - Songs.Sort(sTitle); - Songs.Sort(sArtist); - end; - sArtist2: begin - Songs.Sort(sTitle); - Songs.Sort(sArtist2); - end; - end; // case -end; - -procedure TCatSongs.Refresh; -var - SongIndex: integer; - CurSong: TSong; - 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 - Inc(Order); - CatIndex := Length(Song); - SetLength(Song, CatIndex+1); - Song[CatIndex] := TSong.Create(); - Song[CatIndex].Artist := '[' + CategoryName + ']'; - Song[CatIndex].Main := true; - Song[CatIndex].OrderTyp := 0; - Song[CatIndex].OrderNum := Order; - Song[CatIndex].Cover := CatCovers.GetCover(Ini.Sorting, CategoryName); - Song[CatIndex].Visible := true; - - // set number of songs in previous category - PrevCatBtnIndex := CatIndex - CatNumber - 1; - if ((PrevCatBtnIndex >= 0) and Song[PrevCatBtnIndex].Main) then - Song[PrevCatBtnIndex].CatNumber := CatNumber; - - CatNumber := 0; - end; - -begin - CatNumShow := -1; - - SortSongs(); - - CurCategory := ''; - Order := 0; - CatNumber := 0; - - // Note: do NOT set Letter to ' ', otherwise no category-button will be - // created for songs beginning with ' ' if songs of this category exist. - // TODO: trim song-properties so ' ' will not occur as first chararcter. - Letter := 0; - - // clear song-list - for SongIndex := 0 to Songs.SongList.Count - 1 do - begin - // free category buttons - // Note: do NOT delete songs, they are just references to Songs.SongList entries - CurSong := TSong(Songs.SongList[SongIndex]); - if (CurSong.Main) then - CurSong.Free; - end; - SetLength(Song, 0); - - for SongIndex := 0 to Songs.SongList.Count - 1 do - begin - CurSong := TSong(Songs.SongList[SongIndex]); - // if tabs are on, add section buttons for each new section - if (Ini.Tabs = 1) then - begin - case (Ini.Sorting) of - sEdition: begin - if (CompareText(CurCategory, CurSong.Edition) <> 0) then - begin - CurCategory := CurSong.Edition; - - // add Category Button - AddCategoryButton(CurCategory); - end; - end; - - sGenre: begin - if (CompareText(CurCategory, CurSong.Genre) <> 0) then - begin - CurCategory := CurSong.Genre; - // add Genre Button - AddCategoryButton(CurCategory); - end; - end; - - sLanguage: begin - if (CompareText(CurCategory, CurSong.Language) <> 0) then - begin - CurCategory := CurSong.Language; - // add Language Button - AddCategoryButton(CurCategory); - end - end; - - 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; - - 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; - - sFolder: begin - if (UTF8CompareText(CurCategory, CurSong.Folder) <> 0) then - begin - CurCategory := CurSong.Folder; - // add folder tab - AddCategoryButton(CurCategory); - end; - end; - - 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; // case (Ini.Sorting) - end; // if (Ini.Tabs = 1) - - CatIndex := Length(Song); - SetLength(Song, CatIndex+1); - - Inc(CatNumber); // increase number of songs in category - - // copy reference to current song - Song[CatIndex] := CurSong; - - // set song's category info - CurSong.OrderNum := Order; // assigns category - CurSong.CatNumber := CatNumber; - - if (Ini.Tabs = 0) then - CurSong.Visible := true - else if (Ini.Tabs = 1) then - CurSong.Visible := false; -{ - if (Ini.Tabs = 1) and (Order = 1) then - begin - //open first tab - CurSong.Visible := true; - end; - CurSong.Visible := true; -} - end; - - // set CatNumber of last category - if (Ini.TabsAtStartup = 1) and (High(Song) >= 1) then - begin - // set number of songs in previous category - SongIndex := CatIndex - CatNumber; - if ((SongIndex >= 0) and Song[SongIndex].Main) then - Song[SongIndex].CatNumber := CatNumber; - end; - - // update number of categories - CatCount := Order; -end; - -procedure TCatSongs.ShowCategory(Index: integer); -var - S: integer; // song -begin - CatNumShow := Index; - for S := 0 to high(CatSongs.Song) do - begin -{ - if (CatSongs.Song[S].OrderNum = Index) and (not CatSongs.Song[S].Main) then - CatSongs.Song[S].Visible := true - else - CatSongs.Song[S].Visible := false; -} -// KMS: This should be the same, but who knows :-) - CatSongs.Song[S].Visible := ((CatSongs.Song[S].OrderNum = Index) and (not CatSongs.Song[S].Main)); - end; -end; - -procedure TCatSongs.HideCategory(Index: integer); // hides all songs in category -var - S: integer; // song -begin - for S := 0 to high(CatSongs.Song) do - begin - if not CatSongs.Song[S].Main then - CatSongs.Song[S].Visible := false // hides all at now - end; -end; - -procedure TCatSongs.ClickCategoryButton(Index: integer); -var - Num: integer; -begin - Num := CatSongs.Song[Index].OrderNum; - if Num <> CatNumShow then - begin - ShowCategory(Num); - end - else - begin - ShowCategoryList; - end; -end; - -//Hide Categorys when in Category Hack -procedure TCatSongs.ShowCategoryList; -var - S: integer; -begin - // Hide All Songs Show All Cats - for S := 0 to high(CatSongs.Song) do - CatSongs.Song[S].Visible := CatSongs.Song[S].Main; - CatSongs.Selected := CatNumShow; //Show last shown Category - CatNumShow := -1; -end; -//Hide Categorys when in Category Hack End - -// Wrong song selected when tabs on bug -function TCatSongs.FindNextVisible(SearchFrom:integer): integer;// Find next Visible Song -var - I: integer; -begin - Result := -1; - I := SearchFrom; - while (Result = -1) do - begin - Inc (I); - - if (I > High(CatSongs.Song)) then - I := Low(CatSongs.Song); - if (I = SearchFrom) then // Make One Round and no song found->quit - Break; - - if (CatSongs.Song[I].Visible) then - Result := I; - end; -end; -// Wrong song selected when tabs on bug End - -(** - * Returns the number of visible songs. - *) -function TCatSongs.VisibleSongs: integer; -var - SongIndex: integer; -begin - Result := 0; - for SongIndex := 0 to High(CatSongs.Song) do - begin - if (CatSongs.Song[SongIndex].Visible) then - Inc(Result); - end; -end; - -(** - * Returns the index of a song in the subset of all visible songs. - * If all songs are visible, the result will be equal to the Index parameter. - *) -function TCatSongs.VisibleIndex(Index: integer): integer; -var - SongIndex: integer; -begin - Result := 0; - for SongIndex := 0 to Index - 1 do - begin - if (CatSongs.Song[SongIndex].Visible) then - Inc(Result); - end; -end; - -function TCatSongs.SetFilter(FilterStr: UTF8String; Filter: TSongFilter): cardinal; -var - I, J: integer; - TmpString: UTF8String; - WordArray: array of UTF8String; -begin - FilterStr := Trim(FilterStr); - if (FilterStr <> '') then - begin - Result := 0; - - // initialize word array - SetLength(WordArray, 1); - - // Copy words to SearchStr - I := Pos(' ', FilterStr); - while (I <> 0) do - begin - WordArray[High(WordArray)] := Copy(FilterStr, 1, I-1); - SetLength(WordArray, Length(WordArray) + 1); - - FilterStr := TrimLeft(Copy(FilterStr, I+1, Length(FilterStr)-I)); - I := Pos(' ', FilterStr); - end; - - // Copy last word - WordArray[High(WordArray)] := FilterStr; - - for I := 0 to High(Song) do - begin - if not Song[i].Main then - begin - 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(WordArray) do - begin - 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; - end; - CatNumShow := -2; - end - else - begin - for i := 0 to High(Song) do - begin - Song[i].Visible := (Ini.Tabs = 1) = Song[i].Main; - CatNumShow := -1; - end; - Result := 0; - end; -end; - -// ----------------------------------------------------------------------------- - -end. diff --git a/src/base/UTextEncoding.pas b/src/base/UTextEncoding.pas deleted file mode 100644 index 148cd5d4..00000000 --- a/src/base/UTextEncoding.pas +++ /dev/null @@ -1,247 +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 UTextEncoding; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses - SysUtils, - UUnicodeUtils; - -type - 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; - -{** - * 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, - ULog; - -type - 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 - ERROR_CHAR = '?'; - -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 TSingleByteEncoder.Decode(const InStr: RawByteString; out OutStr: UCS4String): boolean; -var - I: integer; -begin - SetLength(OutStr, Length(InStr)+1); - Result := true; - for I := 1 to Length(InStr) do - begin - 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 - Result := Encoding; - Exit; - end; - end; - Result := Default; -end; - -function EncodingName(Encoding: TEncoding): AnsiString; -begin - 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/src/base/UTexture.pas b/src/base/UTexture.pas deleted file mode 100644 index e477dbb1..00000000 --- a/src/base/UTexture.pas +++ /dev/null @@ -1,547 +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 UTexture; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses - gl, - glu, - glext, - Classes, - SysUtils, - UCommon, - UPath, - SDL, - SDL_Image; - -type - PTexture = ^TTexture; - TTexture = record - TexNum: GLuint; - X: real; - Y: real; - Z: real; - W: real; - H: real; - ScaleW: real; // for dynamic scalling while leaving width constant - ScaleH: real; // for dynamic scalling while leaving height constant - Rot: real; // 0 - 2*pi - Int: real; // intensity - ColR: real; - ColG: real; - ColB: real; - TexW: real; // percentage of width to use [0..1] - TexH: real; // percentage of height to use [0..1] - TexX1: real; - TexY1: real; - TexX2: real; - TexY2: real; - Alpha: real; - Name: IPath; // experimental for handling cache images. maybe it's useful for dynamic skins - end; - -type - TTextureType = ( - TEXTURE_TYPE_PLAIN, // Plain (alpha = 1) - TEXTURE_TYPE_TRANSPARENT, // Alpha is used - TEXTURE_TYPE_COLORIZED // Alpha is used; Hue of the HSV color-model will be replaced by a new value - ); - -const - TextureTypeStr: array[TTextureType] of string = ( - 'Plain', - 'Transparent', - 'Colorized' - ); - -function TextureTypeToStr(TexType: TTextureType): string; -function ParseTextureType(const TypeStr: string; Default: TTextureType): TTextureType; - -procedure AdjustPixelFormat(var TexSurface: PSDL_Surface; Typ: TTextureType); - -type - PTextureEntry = ^TTextureEntry; - TTextureEntry = record - Name: IPath; - Typ: TTextureType; - Color: cardinal; - - // we use normal TTexture, it's easier to implement and if needed - we copy ready data - Texture: TTexture; // Full-size texture - TextureCache: TTexture; // Thumbnail texture - end; - - TTextureDatabase = class - private - Texture: array of TTextureEntry; - public - procedure AddTexture(var Tex: TTexture; Typ: TTextureType; Color: cardinal; Cache: boolean); - function FindTexture(const Name: IPath; Typ: TTextureType; Color: cardinal): integer; - end; - - TTextureUnit = class - private - TextureDatabase: TTextureDatabase; - public - Limit: integer; - - procedure AddTexture(var Tex: TTexture; Typ: TTextureType; Cache: boolean = false); overload; - procedure AddTexture(var Tex: TTexture; Typ: TTextureType; Color: cardinal; Cache: boolean = false); overload; - function GetTexture(const Name: 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; - destructor Destroy; override; - end; - -var - Texture: TTextureUnit; - -implementation - -uses - DateUtils, - StrUtils, - Math, - ULog, - UCovers, - UThemes, - UImage; - -procedure AdjustPixelFormat(var TexSurface: PSDL_Surface; Typ: TTextureType); -var - TempSurface: PSDL_Surface; - NeededPixFmt: PSDL_Pixelformat; -begin - if (Typ = TEXTURE_TYPE_PLAIN) then - NeededPixFmt := @PixelFmt_RGB - else if (Typ = TEXTURE_TYPE_TRANSPARENT) or - (Typ = TEXTURE_TYPE_COLORIZED) then - NeededPixFmt := @PixelFmt_RGBA - else - NeededPixFmt := @PixelFmt_RGB; - - if not PixelformatEquals(TexSurface^.format, NeededPixFmt) then - begin - TempSurface := TexSurface; - TexSurface := SDL_ConvertSurface(TempSurface, NeededPixFmt, SDL_SWSURFACE); - SDL_FreeSurface(TempSurface); - end; -end; - -{ TTextureDatabase } - -procedure TTextureDatabase.AddTexture(var Tex: TTexture; Typ: TTextureType; Color: cardinal; Cache: boolean); -var - TextureIndex: integer; -begin - TextureIndex := FindTexture(Tex.Name, Typ, Color); - if (TextureIndex = -1) then - begin - TextureIndex := Length(Texture); - SetLength(Texture, TextureIndex+1); - - Texture[TextureIndex].Name := Tex.Name; - Texture[TextureIndex].Typ := Typ; - Texture[TextureIndex].Color := Color; - end; - - if (Cache) then - Texture[TextureIndex].TextureCache := Tex - else - Texture[TextureIndex].Texture := Tex; -end; - -function TTextureDatabase.FindTexture(const Name: IPath; Typ: TTextureType; Color: cardinal): integer; -var - TextureIndex: integer; - CurrentTexture: PTextureEntry; -begin - Result := -1; - for TextureIndex := 0 to High(Texture) do - begin - CurrentTexture := @Texture[TextureIndex]; - if (CurrentTexture.Name.Equals(Name)) and - (CurrentTexture.Typ = Typ) then - begin - // colorized textures must match in their color too - if (CurrentTexture.Typ <> TEXTURE_TYPE_COLORIZED) or - (CurrentTexture.Color = Color) then - begin - Result := TextureIndex; - Break; - end; - end; - end; -end; - -{ TTextureUnit } - -constructor TTextureUnit.Create; -begin - inherited Create; - TextureDatabase := TTextureDatabase.Create; -end; - -destructor TTextureUnit.Destroy; -begin - TextureDatabase.Free; - inherited Destroy; -end; - -procedure TTextureUnit.AddTexture(var Tex: TTexture; Typ: TTextureType; Cache: boolean); -begin - TextureDatabase.AddTexture(Tex, Typ, 0, Cache); -end; - -procedure TTextureUnit.AddTexture(var Tex: TTexture; Typ: TTextureType; Color: cardinal; Cache: boolean); -begin - TextureDatabase.AddTexture(Tex, Typ, Color, Cache); -end; - -function TTextureUnit.LoadTexture(FromRegistry: boolean; const Identifier: 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: IPath): TTexture; -begin - Result := LoadTexture(Identifier, TEXTURE_TYPE_PLAIN, 0); -end; - -function TTextureUnit.LoadTexture(const Identifier: IPath; Typ: TTextureType; Col: LongWord): TTexture; -var - TexSurface: PSDL_Surface; - newWidth, newHeight: integer; - oldWidth, oldHeight: integer; - ActTex: GLuint; -begin - // zero texture data - FillChar(Result, SizeOf(Result), 0); - - // load texture data into memory - TexSurface := LoadImage(Identifier); - if not assigned(TexSurface) then - begin - Log.LogError('Could not load texture: "' + Identifier.ToNative +'" with type "'+ TextureTypeToStr(Typ) +'"', - 'TTextureUnit.LoadTexture'); - Exit; - end; - - // convert pixel format as needed - AdjustPixelFormat(TexSurface, Typ); - - // adjust texture size (scale down, if necessary) - newWidth := TexSurface.W; - newHeight := TexSurface.H; - - if (newWidth > Limit) then - newWidth := Limit; - - if (newHeight > Limit) then - newHeight := Limit; - - if (TexSurface.W > newWidth) or (TexSurface.H > newHeight) then - ScaleImage(TexSurface, newWidth, newHeight); - - // now we might colorize the whole thing - if (Typ = TEXTURE_TYPE_COLORIZED) then - ColorizeImage(TexSurface, Col); - - // save actual dimensions of our texture - oldWidth := newWidth; - oldHeight := newHeight; - - // make texture dimensions be powers of 2 - newWidth := Round(Power(2, Ceil(Log2(newWidth)))); - newHeight := Round(Power(2, Ceil(Log2(newHeight)))); - if (newHeight <> oldHeight) or (newWidth <> oldWidth) then - FitImage(TexSurface, newWidth, newHeight); - - // at this point we have the image in memory... - // scaled so that dimensions are powers of 2 - // and converted to either RGB or RGBA - - // if we got a Texture of Type Plain, Transparent or Colorized, - // then we're done manipulating it - // and could now create our openGL texture from it - - // prepare OpenGL texture - glGenTextures(1, @ActTex); - - glBindTexture(GL_TEXTURE_2D, ActTex); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE); - - // load data into gl texture - if (Typ = TEXTURE_TYPE_TRANSPARENT) or - (Typ = TEXTURE_TYPE_COLORIZED) then - begin - {$IFDEF FPC_BIG_ENDIAN} - glTexImage2D(GL_TEXTURE_2D, 0, 4, newWidth, newHeight, 0, GL_RGBA, GL_UNSIGNED_INT_8_8_8_8_REV, TexSurface.pixels); - {$ELSE} - glTexImage2D(GL_TEXTURE_2D, 0, 4, newWidth, newHeight, 0, GL_RGBA, GL_UNSIGNED_BYTE, TexSurface.pixels); - {$ENDIF} - end - else //if Typ = TEXTURE_TYPE_PLAIN then - begin - {$IFDEF FPC_BIG_ENDIAN} - glTexImage2D(GL_TEXTURE_2D, 0, 3, newWidth, newHeight, 0, GL_BGR, GL_UNSIGNED_BYTE, TexSurface.pixels); - {$ELSE} - glTexImage2D(GL_TEXTURE_2D, 0, 3, newWidth, newHeight, 0, GL_RGB, GL_UNSIGNED_BYTE, TexSurface.pixels); - {$ENDIF} - end; - - // setup texture struct - with Result do - begin - X := 0; - Y := 0; - Z := 0; - W := oldWidth; - H := oldHeight; - ScaleW := 1; - ScaleH := 1; - Rot := 0; - TexNum := ActTex; - TexW := oldWidth / newWidth; - TexH := oldHeight / newHeight; - - Int := 1; - ColR := 1; - ColG := 1; - ColB := 1; - Alpha := 1; - - // new test - default use whole texure, taking TexW and TexH as const and changing these - TexX1 := 0; - TexY1 := 0; - TexX2 := 1; - TexY2 := 1; - - Name := Identifier; - end; - - SDL_FreeSurface(TexSurface); -end; - -function TTextureUnit.GetTexture(const Name: IPath; Typ: TTextureType; FromCache: boolean): TTexture; -begin - Result := GetTexture(Name, Typ, 0, FromCache); -end; - -function TTextureUnit.GetTexture(const Name: IPath; Typ: TTextureType; Col: LongWord; FromCache: boolean): TTexture; -var - TextureIndex: integer; -begin - if (Name.IsUnset) then - begin - // zero texture data - FillChar(Result, SizeOf(Result), 0); - Exit; - end; - - if (FromCache) then - begin - // use texture - TextureIndex := TextureDatabase.FindTexture(Name, Typ, Col); - if (TextureIndex > -1) then - Result := TextureDatabase.Texture[TextureIndex].TextureCache; - Exit; - end; - - // find texture entry in database - TextureIndex := TextureDatabase.FindTexture(Name, Typ, Col); - if (TextureIndex = -1) then - begin - // create texture entry in database - TextureIndex := Length(TextureDatabase.Texture); - SetLength(TextureDatabase.Texture, TextureIndex+1); - - TextureDatabase.Texture[TextureIndex].Name := Name; - TextureDatabase.Texture[TextureIndex].Typ := Typ; - TextureDatabase.Texture[TextureIndex].Color := Col; - - // inform database that no textures have been loaded into memory - TextureDatabase.Texture[TextureIndex].Texture.TexNum := 0; - TextureDatabase.Texture[TextureIndex].TextureCache.TexNum := 0; - end; - - // load full texture - if (TextureDatabase.Texture[TextureIndex].Texture.TexNum = 0) then - TextureDatabase.Texture[TextureIndex].Texture := LoadTexture(false, Name, Typ, Col); - - // use texture - Result := TextureDatabase.Texture[TextureIndex].Texture; -end; - -function TTextureUnit.CreateTexture(Data: PChar; const Name: IPath; Width, Height: word; BitsPerPixel: byte): TTexture; -var - //Error: integer; - ActTex: GLuint; -begin - glGenTextures(1, @ActTex); // ActText = new texture number - glBindTexture(GL_TEXTURE_2D, ActTex); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_S, GL_CLAMP_TO_EDGE); - glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_WRAP_T, GL_CLAMP_TO_EDGE); - - {$IFDEF FPC_BIG_ENDIAN} - glTexImage2D(GL_TEXTURE_2D, 0, 3, Width, Height, 0, GL_BGR, GL_UNSIGNED_BYTE, Data); - {$ELSE} - glTexImage2D(GL_TEXTURE_2D, 0, 3, Width, Height, 0, GL_RGB, GL_UNSIGNED_BYTE, Data); - {$ENDIF} - -{ - if Mipmapping then - begin - Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 3, W, H, GL_RGB, GL_UNSIGNED_BYTE, @Data[0]); -// FPC_BIG_ENDIAN Error := gluBuild2DMipmaps(GL_TEXTURE_2D, 3, W, H, GL_BGR, GL_UNSIGNED_BYTE, @Data[0]); - if Error > 0 then - Log.LogError('gluBuild2DMipmaps() failed', 'TTextureUnit.CreateTexture'); - end; -} - - Result.X := 0; - Result.Y := 0; - Result.Z := 0; - Result.W := 0; - Result.H := 0; - Result.ScaleW := 1; - Result.ScaleH := 1; - Result.Rot := 0; - Result.TexNum := ActTex; - Result.TexW := 1; - Result.TexH := 1; - - Result.Int := 1; - Result.ColR := 1; - Result.ColG := 1; - Result.ColB := 1; - Result.Alpha := 1; - - // new test - default use whole texure, taking TexW and TexH as const and changing these - Result.TexX1 := 0; - Result.TexY1 := 0; - Result.TexX2 := 1; - Result.TexY2 := 1; - - Result.Name := Name; -end; - -procedure TTextureUnit.UnloadTexture(const Name: IPath; Typ: TTextureType; FromCache: boolean); -begin - UnloadTexture(Name, Typ, 0, FromCache); -end; - -procedure TTextureUnit.UnloadTexture(const Name: IPath; Typ: TTextureType; Col: cardinal; FromCache: boolean); -var - T: integer; - TexNum: GLuint; -begin - T := TextureDatabase.FindTexture(Name, Typ, Col); - - if not FromCache then - begin - TexNum := TextureDatabase.Texture[T].Texture.TexNum; - if TexNum > 0 then - begin - glDeleteTextures(1, PGLuint(@TexNum)); - TextureDatabase.Texture[T].Texture.TexNum := 0; - //Log.LogError('Unload texture no '+IntToStr(TexNum)); - end; - end - else - begin - TexNum := TextureDatabase.Texture[T].TextureCache.TexNum; - if TexNum > 0 then - begin - glDeleteTextures(1, @TexNum); - TextureDatabase.Texture[T].TextureCache.TexNum := 0; - //Log.LogError('Unload texture cache no '+IntToStr(TexNum)); - end; - end; -end; - -(* This needs some work -procedure TTextureUnit.FlushTextureDatabase(); -var - i: integer; - Tex: ^TTexture; -begin - for i := 0 to High(TextureDatabase.Texture) do - begin - // only delete non-cached entries - if (TextureDatabase.Texture[i].Texture.TexNum > 0) then - begin - Tex := @TextureDatabase.Texture[i].Texture; - glDeleteTextures(1, PGLuint(Tex^.TexNum)); - Tex^.TexNum := 0; - end; - end; -end; -*) - -function TextureTypeToStr(TexType: TTextureType): string; -begin - Result := TextureTypeStr[TexType]; -end; - -function ParseTextureType(const TypeStr: string; Default: TTextureType): TTextureType; -var - TextureType: TTextureType; - UpCaseStr: string; -begin - UpCaseStr := UpperCase(TypeStr); - for TextureType := Low(TextureTypeStr) to High(TextureTypeStr) do - begin - if (UpCaseStr = UpperCase(TextureTypeStr[TextureType])) then - begin - Result := TextureType; - Exit; - end; - end; - Log.LogWarn('Unknown texture type: "' + TypeStr + '". Using default texture type "' + TextureTypeToStr(Default) + '"', 'ParseTextureType'); - Result := Default; -end; - -end. diff --git a/src/base/UThemes.pas b/src/base/UThemes.pas deleted file mode 100644 index 4322815e..00000000 --- a/src/base/UThemes.pas +++ /dev/null @@ -1,2397 +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 UThemes; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses - IniFiles, - SysUtils, - Classes, - ULog, - UTexture, - UPath; - -type - TRGB = record - R: single; - G: single; - B: single; - end; - - TRGBA = record - R, G, B, A: double; - end; - -type - TBackgroundType = - (bgtNone, bgtColor, bgtTexture, bgtVideo, bgtFade, bgtAuto); - -const - BGT_Names: array [TBackgroundType] of string = - ('none', 'color', 'texture', 'video', 'fade', 'auto'); - -type - TThemeBackground = record - BGType: TBackgroundType; - Color: TRGB; - Tex: string; - Alpha: real; - end; - -const - //Defaul Background for Screens w/o Theme e.g. editor - DEFAULT_BACKGROUND: TThemeBackground = ( - BGType: bgtColor; - Color: (R:1; G:1; B:1); - Tex: ''; - Alpha: 1.0 - ); - - -type - TThemeStatic = record - X: integer; - Y: integer; - Z: real; - W: integer; - H: integer; - Color: string; - ColR: real; - ColG: real; - ColB: real; - Tex: string; - Typ: TTextureType; - TexX1: real; - TexY1: real; - TexX2: real; - TexY2: real; - //Reflection - Reflection: boolean; - Reflectionspacing: real; - end; - AThemeStatic = array of TThemeStatic; - - TThemeText = record - X: integer; - Y: integer; - W: integer; - Z: real; - Color: string; - ColR: real; - ColG: real; - ColB: real; - Font: integer; - Size: integer; - Align: integer; - Text: UTF8String; - //Reflection - Reflection: boolean; - ReflectionSpacing: real; - end; - AThemeText = array of TThemeText; - - TThemeButton = record - Text: AThemeText; - X: integer; - Y: integer; - Z: real; - W: integer; - H: integer; - Color: string; - ColR: real; - ColG: real; - ColB: real; - Int: real; - DColor: string; - DColR: real; - DColG: real; - DColB: real; - DInt: real; - Tex: string; - Typ: TTextureType; - - Visible: boolean; - - //Reflection Mod - Reflection: boolean; - Reflectionspacing: real; - //Fade Mod - SelectH: integer; - SelectW: integer; - Fade: boolean; - FadeText: boolean; - DeSelectReflectionspacing : real; - FadeTex: string; - FadeTexPos: integer; - - //Button Collection Mod - Parent: byte; //Number of the Button Collection this Button is assigned to. IF 0: No Assignement - end; - - //Button Collection Mod - TThemeButtonCollection = record - Style: TThemeButton; - ChildCount: byte; //No of assigned Childs - FirstChild: byte; //No of Child on whose Interaction Position the Button should be - end; - - AThemeButtonCollection = array of TThemeButtonCollection; - PAThemeButtonCollection = ^AThemeButtonCollection; - - TThemeSelectSlide = record - Tex: string; - TexSBG: string; - X: integer; - Y: integer; - W: integer; - H: integer; - Z: real; - SBGW: integer; - - TextSize: integer; - - showArrows:boolean; - oneItemOnly:boolean; - - Text: UTF8String; - ColR, ColG, ColB, Int: real; - DColR, DColG, DColB, DInt: real; - TColR, TColG, TColB, TInt: real; - TDColR, TDColG, TDColB, TDInt: real; - SBGColR, SBGColG, SBGColB, SBGInt: real; - SBGDColR, SBGDColG, SBGDColB, SBGDInt: real; - STColR, STColG, STColB, STInt: real; - STDColR, STDColG, STDColB, STDInt: real; - SkipX: integer; - end; - - TThemeEqualizer = record - Visible: boolean; - Direction: boolean; - Alpha: real; - X: integer; - Y: integer; - Z: real; - W: integer; - H: integer; - Space: integer; - Bands: integer; - Length: integer; - ColR, ColG, ColB: real; - Reflection: boolean; - Reflectionspacing: real; - end; - - PThemeBasic = ^TThemeBasic; - TThemeBasic = class - Background: TThemeBackground; - Text: AThemeText; - Static: AThemeStatic; - - //Button Collection Mod - ButtonCollection: AThemeButtonCollection; - end; - - TThemeLoading = class(TThemeBasic) - StaticAnimation: TThemeStatic; - TextLoading: TThemeText; - end; - - TThemeMain = class(TThemeBasic) - ButtonSolo: TThemeButton; - ButtonMulti: TThemeButton; - ButtonStat: TThemeButton; - ButtonEditor: TThemeButton; - ButtonOptions: TThemeButton; - ButtonExit: TThemeButton; - - TextDescription: TThemeText; - TextDescriptionLong: TThemeText; - Description: array[0..5] of UTF8String; - DescriptionLong: array[0..5] of UTF8String; - end; - - TThemeName = class(TThemeBasic) - ButtonPlayer: array[1..6] of TThemeButton; - end; - - TThemeLevel = class(TThemeBasic) - ButtonEasy: TThemeButton; - ButtonMedium: TThemeButton; - ButtonHard: TThemeButton; - end; - - TThemeSong = class(TThemeBasic) - TextArtist: TThemeText; - TextTitle: TThemeText; - TextNumber: TThemeText; - - //Video Icon Mod - VideoIcon: TThemeStatic; - - //Show Cat in TopLeft Mod - TextCat: TThemeText; - StaticCat: TThemeStatic; - - //Cover Mod - Cover: record - Reflections: boolean; - X: integer; - Y: integer; - Z: integer; - W: integer; - H: integer; - Style: integer; - end; - - //Equalizer Mod - Equalizer: TThemeEqualizer; - - - //Party and Non Party specific Statics and Texts - StaticParty: AThemeStatic; - TextParty: AThemeText; - - StaticNonParty: AThemeStatic; - TextNonParty: AThemeText; - - //Party Mode - StaticTeam1Joker1: TThemeStatic; - StaticTeam1Joker2: TThemeStatic; - StaticTeam1Joker3: TThemeStatic; - StaticTeam1Joker4: TThemeStatic; - StaticTeam1Joker5: TThemeStatic; - StaticTeam2Joker1: TThemeStatic; - StaticTeam2Joker2: TThemeStatic; - StaticTeam2Joker3: TThemeStatic; - StaticTeam2Joker4: TThemeStatic; - StaticTeam2Joker5: TThemeStatic; - StaticTeam3Joker1: TThemeStatic; - StaticTeam3Joker2: TThemeStatic; - StaticTeam3Joker3: TThemeStatic; - StaticTeam3Joker4: TThemeStatic; - StaticTeam3Joker5: TThemeStatic; - - - end; - - TThemeSing = class(TThemeBasic) - - //TimeBar mod - StaticTimeProgress: TThemeStatic; - TextTimeText : TThemeText; - //eoa TimeBar mod - - StaticP1: TThemeStatic; - TextP1: TThemeText; - StaticP1ScoreBG: TThemeStatic; //Static for ScoreBG - TextP1Score: TThemeText; - - //moveable singbar mod - StaticP1SingBar: TThemeStatic; - StaticP1ThreePSingBar: TThemeStatic; - StaticP1TwoPSingBar: TThemeStatic; - StaticP2RSingBar: TThemeStatic; - StaticP2MSingBar: TThemeStatic; - StaticP3SingBar: TThemeStatic; - //eoa moveable singbar - - //added for ps3 skin - //game in 2/4 player modi - StaticP1TwoP: TThemeStatic; - StaticP1TwoPScoreBG: TThemeStatic; //Static for ScoreBG - TextP1TwoP: TThemeText; - TextP1TwoPScore: TThemeText; - //game in 3/6 player modi - StaticP1ThreeP: TThemeStatic; - StaticP1ThreePScoreBG: TThemeStatic; //Static for ScoreBG - TextP1ThreeP: TThemeText; - TextP1ThreePScore: TThemeText; - //eoa - - StaticP2R: TThemeStatic; - StaticP2RScoreBG: TThemeStatic; //Static for ScoreBG - TextP2R: TThemeText; - TextP2RScore: TThemeText; - - StaticP2M: TThemeStatic; - StaticP2MScoreBG: TThemeStatic; //Static for ScoreBG - TextP2M: TThemeText; - TextP2MScore: TThemeText; - - StaticP3R: TThemeStatic; - StaticP3RScoreBG: TThemeStatic; //Static for ScoreBG - TextP3R: TThemeText; - TextP3RScore: TThemeText; - - //Linebonus Translations - LineBonusText: array [0..8] of UTF8String; - - //Pause Popup - PausePopUp: TThemeStatic; - end; - - TThemeLyricBar = record - IndicatorYOffset, UpperX, UpperW, UpperY, UpperH, - LowerX, LowerW, LowerY, LowerH : integer; - end; - - TThemeScore = class(TThemeBasic) - TextArtist: TThemeText; - TextTitle: TThemeText; - - TextArtistTitle: TThemeText; - - PlayerStatic: array[1..6] of AThemeStatic; - PlayerTexts: array[1..6] of AThemeText; - - TextName: array[1..6] of TThemeText; - TextScore: array[1..6] of TThemeText; - - TextNotes: array[1..6] of TThemeText; - TextNotesScore: array[1..6] of TThemeText; - TextLineBonus: array[1..6] of TThemeText; - TextLineBonusScore: array[1..6] of TThemeText; - TextGoldenNotes: array[1..6] of TThemeText; - TextGoldenNotesScore: array[1..6] of TThemeText; - TextTotal: array[1..6] of TThemeText; - TextTotalScore: array[1..6] of TThemeText; - - StaticBoxLightest: array[1..6] of TThemeStatic; - StaticBoxLight: array[1..6] of TThemeStatic; - StaticBoxDark: array[1..6] of TThemeStatic; - - StaticRatings: array[1..6] of TThemeStatic; - - StaticBackLevel: array[1..6] of TThemeStatic; - StaticBackLevelRound: array[1..6] of TThemeStatic; - StaticLevel: array[1..6] of TThemeStatic; - StaticLevelRound: array[1..6] of TThemeStatic; - -// Description: array[0..5] of string;} - end; - - TThemeTop5 = class(TThemeBasic) - TextLevel: TThemeText; - TextArtistTitle: TThemeText; - - StaticNumber: AThemeStatic; - TextNumber: AThemeText; - TextName: AThemeText; - TextScore: AThemeText; - TextDate: AThemeText; - end; - - TThemeOptions = class(TThemeBasic) - ButtonGame: TThemeButton; - ButtonGraphics: TThemeButton; - ButtonSound: TThemeButton; - ButtonLyrics: TThemeButton; - ButtonThemes: TThemeButton; - ButtonRecord: TThemeButton; - ButtonAdvanced: TThemeButton; - ButtonExit: TThemeButton; - - TextDescription: TThemeText; - Description: array[0..7] of UTF8String; - end; - - TThemeOptionsGame = class(TThemeBasic) - SelectPlayers: TThemeSelectSlide; - SelectDifficulty: TThemeSelectSlide; - SelectLanguage: TThemeSelectSlide; - SelectTabs: TThemeSelectSlide; - SelectSorting: TThemeSelectSlide; - SelectDebug: TThemeSelectSlide; - ButtonExit: TThemeButton; - end; - - TThemeOptionsGraphics = class(TThemeBasic) - SelectFullscreen: TThemeSelectSlide; - SelectResolution: TThemeSelectSlide; - SelectDepth: TThemeSelectSlide; - SelectVisualizer: TThemeSelectSlide; - SelectOscilloscope: TThemeSelectSlide; - SelectLineBonus: TThemeSelectSlide; - SelectMovieSize: TThemeSelectSlide; - ButtonExit: TThemeButton; - end; - - TThemeOptionsSound = class(TThemeBasic) - SelectMicBoost: TThemeSelectSlide; - SelectBackgroundMusic: TThemeSelectSlide; - SelectClickAssist: TThemeSelectSlide; - SelectBeatClick: TThemeSelectSlide; - SelectThreshold: TThemeSelectSlide; - SelectSlidePreviewVolume: TThemeSelectSlide; - SelectSlidePreviewFading: TThemeSelectSlide; - SelectSlideVoicePassthrough: TThemeSelectSlide; - ButtonExit: TThemeButton; - end; - - TThemeOptionsLyrics = class(TThemeBasic) - SelectLyricsFont: TThemeSelectSlide; - SelectLyricsEffect: TThemeSelectSlide; -// SelectSolmization: TThemeSelectSlide; - SelectNoteLines: TThemeSelectSlide; - ButtonExit: TThemeButton; - end; - - TThemeOptionsThemes = class(TThemeBasic) - SelectTheme: TThemeSelectSlide; - SelectSkin: TThemeSelectSlide; - SelectColor: TThemeSelectSlide; - ButtonExit: TThemeButton; - end; - - TThemeOptionsRecord = class(TThemeBasic) - SelectSlideCard: TThemeSelectSlide; - SelectSlideInput: TThemeSelectSlide; - SelectSlideChannel: TThemeSelectSlide; - ButtonExit: TThemeButton; - end; - - TThemeOptionsAdvanced = class(TThemeBasic) - SelectLoadAnimation: TThemeSelectSlide; - SelectEffectSing: TThemeSelectSlide; - SelectScreenFade: TThemeSelectSlide; - SelectLineBonus: TThemeSelectSlide; - SelectAskbeforeDel: TThemeSelectSlide; - SelectOnSongClick: TThemeSelectSlide; - SelectPartyPopup: TThemeSelectSlide; - ButtonExit: TThemeButton; - end; - - TThemeEdit = class(TThemeBasic) - ButtonConvert: TThemeButton; - ButtonExit: TThemeButton; - - TextDescription: TThemeText; - TextDescriptionLong: TThemeText; - Description: array[0..5] of UTF8string; - DescriptionLong: array[0..5] of UTF8string; - end; - - //Error- and Check-Popup - TThemeError = class(TThemeBasic) - Button1: TThemeButton; - TextError: TThemeText; - end; - - TThemeCheck = class(TThemeBasic) - Button1: TThemeButton; - Button2: TThemeButton; - TextCheck: TThemeText; - end; - - - //ScreenSong Menue - TThemeSongMenu = class(TThemeBasic) - Button1: TThemeButton; - Button2: TThemeButton; - Button3: TThemeButton; - Button4: TThemeButton; - - SelectSlide3: TThemeSelectSlide; - - TextMenu: TThemeText; - end; - - TThemeSongJumpTo = class(TThemeBasic) - ButtonSearchText: TThemeButton; - SelectSlideType: TThemeSelectSlide; - TextFound: TThemeText; - - //Translated Texts - Songsfound: UTF8String; - NoSongsfound: UTF8String; - CatText: UTF8String; - IType: array [0..2] of UTF8String; - end; - - //Party Screens - TThemePartyNewRound = class(TThemeBasic) - TextRound1: TThemeText; - TextRound2: TThemeText; - TextRound3: TThemeText; - TextRound4: TThemeText; - TextRound5: TThemeText; - TextRound6: TThemeText; - TextRound7: TThemeText; - TextWinner1: TThemeText; - TextWinner2: TThemeText; - TextWinner3: TThemeText; - TextWinner4: TThemeText; - TextWinner5: TThemeText; - TextWinner6: TThemeText; - TextWinner7: TThemeText; - TextNextRound: TThemeText; - TextNextRoundNo: TThemeText; - TextNextPlayer1: TThemeText; - TextNextPlayer2: TThemeText; - TextNextPlayer3: TThemeText; - - StaticRound1: TThemeStatic; - StaticRound2: TThemeStatic; - StaticRound3: TThemeStatic; - StaticRound4: TThemeStatic; - StaticRound5: TThemeStatic; - StaticRound6: TThemeStatic; - StaticRound7: TThemeStatic; - - TextScoreTeam1: TThemeText; - TextScoreTeam2: TThemeText; - TextScoreTeam3: TThemeText; - TextNameTeam1: TThemeText; - TextNameTeam2: TThemeText; - TextNameTeam3: TThemeText; - TextTeam1Players: TThemeText; - TextTeam2Players: TThemeText; - TextTeam3Players: TThemeText; - - StaticTeam1: TThemeStatic; - StaticTeam2: TThemeStatic; - StaticTeam3: TThemeStatic; - StaticNextPlayer1: TThemeStatic; - StaticNextPlayer2: TThemeStatic; - StaticNextPlayer3: TThemeStatic; - end; - - TThemePartyScore = class(TThemeBasic) - TextScoreTeam1: TThemeText; - TextScoreTeam2: TThemeText; - TextScoreTeam3: TThemeText; - TextNameTeam1: TThemeText; - TextNameTeam2: TThemeText; - TextNameTeam3: TThemeText; - StaticTeam1: TThemeStatic; - StaticTeam1BG: TThemeStatic; - StaticTeam1Deco: TThemeStatic; - StaticTeam2: TThemeStatic; - StaticTeam2BG: TThemeStatic; - StaticTeam2Deco: TThemeStatic; - StaticTeam3: TThemeStatic; - StaticTeam3BG: TThemeStatic; - StaticTeam3Deco: TThemeStatic; - - DecoTextures: record - ChangeTextures: boolean; - - FirstTexture: string; - FirstTyp: TTextureType; - FirstColor: string; - - SecondTexture: string; - SecondTyp: TTextureType; - SecondColor: string; - - ThirdTexture: string; - ThirdTyp: TTextureType; - ThirdColor: string; - end; - - - TextWinner: TThemeText; - end; - - TThemePartyWin = class(TThemeBasic) - TextScoreTeam1: TThemeText; - TextScoreTeam2: TThemeText; - TextScoreTeam3: TThemeText; - TextNameTeam1: TThemeText; - TextNameTeam2: TThemeText; - TextNameTeam3: TThemeText; - StaticTeam1: TThemeStatic; - StaticTeam1BG: TThemeStatic; - StaticTeam1Deco: TThemeStatic; - StaticTeam2: TThemeStatic; - StaticTeam2BG: TThemeStatic; - StaticTeam2Deco: TThemeStatic; - StaticTeam3: TThemeStatic; - StaticTeam3BG: TThemeStatic; - StaticTeam3Deco: TThemeStatic; - - TextWinner: TThemeText; - end; - - TThemePartyOptions = class(TThemeBasic) - SelectLevel: TThemeSelectSlide; - SelectPlayList: TThemeSelectSlide; - SelectPlayList2: TThemeSelectSlide; - SelectRounds: TThemeSelectSlide; - SelectTeams: TThemeSelectSlide; - SelectPlayers1: TThemeSelectSlide; - SelectPlayers2: TThemeSelectSlide; - SelectPlayers3: TThemeSelectSlide; - - {ButtonNext: TThemeButton; - ButtonPrev: TThemeButton;} - end; - - TThemePartyPlayer = class(TThemeBasic) - Team1Name: TThemeButton; - Player1Name: TThemeButton; - Player2Name: TThemeButton; - Player3Name: TThemeButton; - Player4Name: TThemeButton; - - Team2Name: TThemeButton; - Player5Name: TThemeButton; - Player6Name: TThemeButton; - Player7Name: TThemeButton; - Player8Name: TThemeButton; - - Team3Name: TThemeButton; - Player9Name: TThemeButton; - Player10Name: TThemeButton; - Player11Name: TThemeButton; - Player12Name: TThemeButton; - - {ButtonNext: TThemeButton; - ButtonPrev: TThemeButton;} - end; - - //Stats Screens - TThemeStatMain = class(TThemeBasic) - ButtonScores: TThemeButton; - ButtonSingers: TThemeButton; - ButtonSongs: TThemeButton; - ButtonBands: TThemeButton; - ButtonExit: TThemeButton; - - TextOverview: TThemeText; - end; - - TThemeStatDetail = class(TThemeBasic) - ButtonNext: TThemeButton; - ButtonPrev: TThemeButton; - ButtonReverse: TThemeButton; - ButtonExit: TThemeButton; - - TextDescription: TThemeText; - TextPage: TThemeText; - TextList: AThemeText; - - Description: array[0..3] of UTF8String; - DescriptionR: array[0..3] of UTF8String; - FormatStr: array[0..3] of UTF8String; - PageStr: UTF8String; - end; - - //Playlist Translations - TThemePlaylist = record - CatText: UTF8String; - end; - - TTheme = class - private - {$IFDEF THEMESAVE} - ThemeIni: TIniFile; - {$ELSE} - ThemeIni: TMemIniFile; - {$ENDIF} - - LastThemeBasic: TThemeBasic; - procedure CreateThemeObjects(); - - public - Loading: TThemeLoading; - Main: TThemeMain; - Name: TThemeName; - Level: TThemeLevel; - Song: TThemeSong; - Sing: TThemeSing; - LyricBar: TThemeLyricBar; - Score: TThemeScore; - Top5: TThemeTop5; - Options: TThemeOptions; - OptionsGame: TThemeOptionsGame; - OptionsGraphics: TThemeOptionsGraphics; - OptionsSound: TThemeOptionsSound; - OptionsLyrics: TThemeOptionsLyrics; - OptionsThemes: TThemeOptionsThemes; - OptionsRecord: TThemeOptionsRecord; - OptionsAdvanced: TThemeOptionsAdvanced; - //edit - Edit: TThemeEdit; - //error and check popup - ErrorPopup: TThemeError; - CheckPopup: TThemeCheck; - //ScreenSong extensions - SongMenu: TThemeSongMenu; - SongJumpto: TThemeSongJumpTo; - //Party Screens: - PartyNewRound: TThemePartyNewRound; - PartyScore: TThemePartyScore; - PartyWin: TThemePartyWin; - PartyOptions: TThemePartyOptions; - PartyPlayer: TThemePartyPlayer; - - //Stats Screens: - StatMain: TThemeStatMain; - StatDetail: TThemeStatDetail; - - Playlist: TThemePlaylist; - - ILevel: array[0..2] of UTF8String; - - constructor Create(const FileName: IPath); overload; // Initialize theme system - constructor Create(const FileName: IPath; Color: integer); overload; // Initialize theme system with color - function LoadTheme(const FileName: IPath; sColor: integer): boolean; // Load some theme settings from file - - procedure LoadColors; - - procedure ThemeLoadBasic(Theme: TThemeBasic; const Name: string); - procedure ThemeLoadBackground(var ThemeBackground: TThemeBackground; const Name: string); - procedure ThemeLoadText(var ThemeText: TThemeText; const Name: string); - procedure ThemeLoadTexts(var ThemeText: AThemeText; const Name: string); - procedure ThemeLoadStatic(var ThemeStatic: TThemeStatic; const Name: string); - procedure ThemeLoadStatics(var ThemeStatic: AThemeStatic; const Name: string); - procedure ThemeLoadButton(var ThemeButton: TThemeButton; const Name: string; Collections: PAThemeButtonCollection = nil); - procedure ThemeLoadButtonCollection(var Collection: TThemeButtonCollection; const Name: string); - procedure ThemeLoadButtonCollections(var Collections: AThemeButtonCollection; const Name: string); - procedure ThemeLoadSelectSlide(var ThemeSelectS: TThemeSelectSlide; const Name: string); - procedure ThemeLoadEqualizer(var ThemeEqualizer: TThemeEqualizer; const Name: string); - - procedure ThemeSave(const FileName: string); - procedure ThemeSaveBasic(Theme: TThemeBasic; const Name: string); - procedure ThemeSaveBackground(ThemeBackground: TThemeBackground; const Name: string); - procedure ThemeSaveStatic(ThemeStatic: TThemeStatic; const Name: string); - procedure ThemeSaveStatics(ThemeStatic: AThemeStatic; const Name: string); - procedure ThemeSaveText(ThemeText: TThemeText; const Name: string); - procedure ThemeSaveTexts(ThemeText: AThemeText; const Name: string); - procedure ThemeSaveButton(ThemeButton: TThemeButton; const Name: string); - end; - - TColor = record - Name: string; - RGB: TRGB; - end; - -procedure glColorRGB(Color: TRGB); overload; -procedure glColorRGB(Color: TRGB; Alpha: real); overload; -procedure glColorRGB(Color: TRGBA); overload; -procedure glColorRGB(Color: TRGBA; Alpha: real); overload; - -function ColorExists(Name: string): integer; -procedure LoadColor(var R, G, B: real; ColorName: string); -function GetSystemColor(Color: integer): TRGB; -function ColorSqrt(RGB: TRGB): TRGB; - -var - //Skin: TSkin; - Theme: TTheme; - Color: array of TColor; - -implementation - -uses - UCommon, - ULanguage, - USkins, - UIni, - gl, - glext, - math; - -//----------- -//Helper procs to use TRGB in Opengl ...maybe this should be somewhere else -//----------- -procedure glColorRGB(Color: TRGB); overload; -begin - glColor3f(Color.R, Color.G, Color.B); -end; - -procedure glColorRGB(Color: TRGB; Alpha: real); overload; -begin - glColor4f(Color.R, Color.G, Color.B, Alpha); -end; - -procedure glColorRGB(Color: TRGBA); overload; -begin - glColor4f(Color.R, Color.G, Color.B, Color.A); -end; - -procedure glColorRGB(Color: TRGBA; Alpha: real); overload; -begin - glColor4f(Color.R, Color.G, Color.B, Min(Color.A, Alpha)); -end; - -constructor TTheme.Create(const FileName: IPath); -begin - Create(FileName, 0); -end; - -constructor TTheme.Create(const FileName: IPath; Color: integer); -begin - inherited Create(); - - Loading := TThemeLoading.Create; - Main := TThemeMain.Create; - Name := TThemeName.Create; - Level := TThemeLevel.Create; - Song := TThemeSong.Create; - Sing := TThemeSing.Create; - Score := TThemeScore.Create; - Top5 := TThemeTop5.Create; - Options := TThemeOptions.Create; - OptionsGame := TThemeOptionsGame.Create; - OptionsGraphics := TThemeOptionsGraphics.Create; - OptionsSound := TThemeOptionsSound.Create; - OptionsLyrics := TThemeOptionsLyrics.Create; - OptionsThemes := TThemeOptionsThemes.Create; - OptionsRecord := TThemeOptionsRecord.Create; - OptionsAdvanced := TThemeOptionsAdvanced.Create; - - Edit := TThemeEdit.Create; - - ErrorPopup := TThemeError.Create; - CheckPopup := TThemeCheck.Create; - - SongMenu := TThemeSongMenu.Create; - SongJumpto := TThemeSongJumpto.Create; - //Party Screens - PartyNewRound := TThemePartyNewRound.Create; - PartyWin := TThemePartyWin.Create; - PartyScore := TThemePartyScore.Create; - PartyOptions := TThemePartyOptions.Create; - PartyPlayer := TThemePartyPlayer.Create; - - //Stats Screens: - StatMain := TThemeStatMain.Create; - StatDetail := TThemeStatDetail.Create; - - LoadTheme(FileName, Color); - -end; - -function TTheme.LoadTheme(const FileName: IPath; sColor: integer): boolean; -var - I: integer; -begin - Result := false; - - CreateThemeObjects(); - - Log.LogStatus('Loading: '+ FileName.ToNative, 'TTheme.LoadTheme'); - - if not FileName.IsFile() then - begin - Log.LogError('Theme does not exist ('+ FileName.ToNative +')', 'TTheme.LoadTheme'); - end; - - if FileName.IsFile() then - begin - Result := true; - - {$IFDEF THEMESAVE} - ThemeIni := TIniFile.Create(FileName.ToNative); - {$ELSE} - ThemeIni := TMemIniFile.Create(FileName.ToNative); - {$ENDIF} - - if ThemeIni.ReadString('Theme', 'Name', '') <> '' then - begin - - {Skin.SkinName := ThemeIni.ReadString('Theme', 'Name', 'Singstar'); - Skin.SkinPath := 'Skins\' + Skin.SkinName + '\'; - Skin.SkinReg := false; } - Skin.Color := sColor; - - Skin.LoadSkin(ISkin[Ini.SkinNo]); - - LoadColors; - -// ThemeIni.Free; -// ThemeIni := TIniFile.Create('Themes\Singstar\Main.ini'); - - // Loading - ThemeLoadBasic(Loading, 'Loading'); - ThemeLoadText(Loading.TextLoading, 'LoadingTextLoading'); - ThemeLoadStatic(Loading.StaticAnimation, 'LoadingStaticAnimation'); - - // Main - ThemeLoadBasic(Main, 'Main'); - - ThemeLoadText(Main.TextDescription, 'MainTextDescription'); - ThemeLoadText(Main.TextDescriptionLong, 'MainTextDescriptionLong'); - ThemeLoadButton(Main.ButtonSolo, 'MainButtonSolo'); - ThemeLoadButton(Main.ButtonMulti, 'MainButtonMulti'); - ThemeLoadButton(Main.ButtonStat, 'MainButtonStats'); - ThemeLoadButton(Main.ButtonEditor, 'MainButtonEditor'); - ThemeLoadButton(Main.ButtonOptions, 'MainButtonOptions'); - ThemeLoadButton(Main.ButtonExit, 'MainButtonExit'); - - //Main Desc Text Translation Start - - Main.Description[0] := Language.Translate('SING_SING'); - Main.DescriptionLong[0] := Language.Translate('SING_SING_DESC'); - Main.Description[1] := Language.Translate('SING_MULTI'); - Main.DescriptionLong[1] := Language.Translate('SING_MULTI_DESC'); - Main.Description[2] := Language.Translate('SING_STATS'); - Main.DescriptionLong[2] := Language.Translate('SING_STATS_DESC'); - Main.Description[3] := Language.Translate('SING_EDITOR'); - Main.DescriptionLong[3] := Language.Translate('SING_EDITOR_DESC'); - Main.Description[4] := Language.Translate('SING_GAME_OPTIONS'); - Main.DescriptionLong[4] := Language.Translate('SING_GAME_OPTIONS_DESC'); - Main.Description[5] := Language.Translate('SING_EXIT'); - Main.DescriptionLong[5] := Language.Translate('SING_EXIT_DESC'); - - //Main Desc Text Translation End - - Main.TextDescription.Text := Main.Description[0]; - Main.TextDescriptionLong.Text := Main.DescriptionLong[0]; - - // Name - ThemeLoadBasic(Name, 'Name'); - - for I := 1 to 6 do - ThemeLoadButton(Name.ButtonPlayer[I], 'NameButtonPlayer'+IntToStr(I)); - - // Level - ThemeLoadBasic(Level, 'Level'); - - ThemeLoadButton(Level.ButtonEasy, 'LevelButtonEasy'); - ThemeLoadButton(Level.ButtonMedium, 'LevelButtonMedium'); - ThemeLoadButton(Level.ButtonHard, 'LevelButtonHard'); - - - // Song - ThemeLoadBasic(Song, 'Song'); - - ThemeLoadText(Song.TextArtist, 'SongTextArtist'); - ThemeLoadText(Song.TextTitle, 'SongTextTitle'); - ThemeLoadText(Song.TextNumber, 'SongTextNumber'); - - //Video Icon Mod - ThemeLoadStatic(Song.VideoIcon, 'SongVideoIcon'); - - //Show Cat in TopLeft Mod - ThemeLoadStatic(Song.StaticCat, 'SongStaticCat'); - ThemeLoadText(Song.TextCat, 'SongTextCat'); - - //Load Cover Pos and Size from Theme Mod - Song.Cover.X := ThemeIni.ReadInteger('SongCover', 'X', 300); - Song.Cover.Y := ThemeIni.ReadInteger('SongCover', 'Y', 190); - Song.Cover.W := ThemeIni.ReadInteger('SongCover', 'W', 300); - Song.Cover.H := ThemeIni.ReadInteger('SongCover', 'H', 200); - Song.Cover.Style := ThemeIni.ReadInteger('SongCover', 'Style', 4); - Song.Cover.Reflections := (ThemeIni.ReadInteger('SongCover', 'Reflections', 0) = 1); - //Load Cover Pos and Size from Theme Mod End - - ThemeLoadEqualizer(Song.Equalizer, 'SongEqualizer'); - - //Party and Non Party specific Statics and Texts - ThemeLoadStatics (Song.StaticParty, 'SongStaticParty'); - ThemeLoadTexts (Song.TextParty, 'SongTextParty'); - - ThemeLoadStatics (Song.StaticNonParty, 'SongStaticNonParty'); - ThemeLoadTexts (Song.TextNonParty, 'SongTextNonParty'); - - //Party Mode - ThemeLoadStatic(Song.StaticTeam1Joker1, 'SongStaticTeam1Joker1'); - ThemeLoadStatic(Song.StaticTeam1Joker2, 'SongStaticTeam1Joker2'); - ThemeLoadStatic(Song.StaticTeam1Joker3, 'SongStaticTeam1Joker3'); - ThemeLoadStatic(Song.StaticTeam1Joker4, 'SongStaticTeam1Joker4'); - ThemeLoadStatic(Song.StaticTeam1Joker5, 'SongStaticTeam1Joker5'); - - ThemeLoadStatic(Song.StaticTeam2Joker1, 'SongStaticTeam2Joker1'); - ThemeLoadStatic(Song.StaticTeam2Joker2, 'SongStaticTeam2Joker2'); - ThemeLoadStatic(Song.StaticTeam2Joker3, 'SongStaticTeam2Joker3'); - ThemeLoadStatic(Song.StaticTeam2Joker4, 'SongStaticTeam2Joker4'); - ThemeLoadStatic(Song.StaticTeam2Joker5, 'SongStaticTeam2Joker5'); - - ThemeLoadStatic(Song.StaticTeam3Joker1, 'SongStaticTeam3Joker1'); - ThemeLoadStatic(Song.StaticTeam3Joker2, 'SongStaticTeam3Joker2'); - ThemeLoadStatic(Song.StaticTeam3Joker3, 'SongStaticTeam3Joker3'); - ThemeLoadStatic(Song.StaticTeam3Joker4, 'SongStaticTeam3Joker4'); - ThemeLoadStatic(Song.StaticTeam3Joker5, 'SongStaticTeam3Joker5'); - - - //LyricBar asd - LyricBar.UpperX := ThemeIni.ReadInteger('SingLyricsUpperBar', 'X', 0); - LyricBar.UpperW := ThemeIni.ReadInteger('SingLyricsUpperBar', 'W', 0); - LyricBar.UpperY := ThemeIni.ReadInteger('SingLyricsUpperBar', 'Y', 0); - LyricBar.UpperH := ThemeIni.ReadInteger('SingLyricsUpperBar', 'H', 0); - LyricBar.IndicatorYOffset := ThemeIni.ReadInteger('SingLyricsUpperBar', 'IndicatorYOffset', 0); - LyricBar.LowerX := ThemeIni.ReadInteger('SingLyricsLowerBar', 'X', 0); - LyricBar.LowerW := ThemeIni.ReadInteger('SingLyricsLowerBar', 'W', 0); - LyricBar.LowerY := ThemeIni.ReadInteger('SingLyricsLowerBar', 'Y', 0); - LyricBar.LowerH := ThemeIni.ReadInteger('SingLyricsLowerBar', 'H', 0); - - // Sing - ThemeLoadBasic(Sing, 'Sing'); - //TimeBar mod - ThemeLoadStatic(Sing.StaticTimeProgress, 'SingTimeProgress'); - ThemeLoadText(Sing.TextTimeText, 'SingTimeText'); - //eoa TimeBar mod - - //moveable singbar mod - ThemeLoadStatic(Sing.StaticP1SingBar, 'SingP1SingBar'); - ThemeLoadStatic(Sing.StaticP1TwoPSingBar, 'SingP1TwoPSingBar'); - ThemeLoadStatic(Sing.StaticP1ThreePSingBar, 'SingP1ThreePSingBar'); - ThemeLoadStatic(Sing.StaticP2RSingBar, 'SingP2RSingBar'); - ThemeLoadStatic(Sing.StaticP2MSingBar, 'SingP2MSingBar'); - ThemeLoadStatic(Sing.StaticP3SingBar, 'SingP3SingBar'); - //eoa moveable singbar - - ThemeLoadStatic(Sing.StaticP1, 'SingP1Static'); - ThemeLoadText(Sing.TextP1, 'SingP1Text'); - ThemeLoadStatic(Sing.StaticP1ScoreBG, 'SingP1Static2'); - ThemeLoadText(Sing.TextP1Score, 'SingP1TextScore'); - //Added for ps3 skin - //This one is shown in 2/4P mode - //if it exists, otherwise the one Player equivaltents are used - if (ThemeIni.SectionExists('SingP1TwoPTextScore')) then - begin - ThemeLoadStatic(Sing.StaticP1TwoP, 'SingP1TwoPStatic'); - ThemeLoadText(Sing.TextP1TwoP, 'SingP1TwoPText'); - ThemeLoadStatic(Sing.StaticP1TwoPScoreBG, 'SingP1TwoPStatic2'); - ThemeLoadText(Sing.TextP1TwoPScore, 'SingP1TwoPTextScore'); - end - else - begin - Sing.StaticP1TwoP := Sing.StaticP1; - Sing.TextP1TwoP := Sing.TextP1; - Sing.StaticP1TwoPScoreBG := Sing.StaticP1ScoreBG; - Sing.TextP1TwoPScore := Sing.TextP1Score; - end; - - //This one is shown in 3/6P mode - //if it exists, otherwise the one Player equivaltents are used - if (ThemeIni.SectionExists('SingP1TwoPTextScore')) then - begin - ThemeLoadStatic(Sing.StaticP1ThreeP, 'SingP1ThreePStatic'); - ThemeLoadText(Sing.TextP1ThreeP, 'SingP1ThreePText'); - ThemeLoadStatic(Sing.StaticP1ThreePScoreBG, 'SingP1ThreePStatic2'); - ThemeLoadText(Sing.TextP1ThreePScore, 'SingP1ThreePTextScore'); - end - else - begin - Sing.StaticP1ThreeP := Sing.StaticP1; - Sing.TextP1ThreeP := Sing.TextP1; - Sing.StaticP1ThreePScoreBG := Sing.StaticP1ScoreBG; - Sing.TextP1ThreePScore := Sing.TextP1Score; - end; - //eoa - ThemeLoadStatic(Sing.StaticP2R, 'SingP2RStatic'); - ThemeLoadText(Sing.TextP2R, 'SingP2RText'); - ThemeLoadStatic(Sing.StaticP2RScoreBG, 'SingP2RStatic2'); - ThemeLoadText(Sing.TextP2RScore, 'SingP2RTextScore'); - - ThemeLoadStatic(Sing.StaticP2M, 'SingP2MStatic'); - ThemeLoadText(Sing.TextP2M, 'SingP2MText'); - ThemeLoadStatic(Sing.StaticP2MScoreBG, 'SingP2MStatic2'); - ThemeLoadText(Sing.TextP2MScore, 'SingP2MTextScore'); - - ThemeLoadStatic(Sing.StaticP3R, 'SingP3RStatic'); - ThemeLoadText(Sing.TextP3R, 'SingP3RText'); - ThemeLoadStatic(Sing.StaticP3RScoreBG, 'SingP3RStatic2'); - ThemeLoadText(Sing.TextP3RScore, 'SingP3RTextScore'); - - //Line Bonus Texts - Sing.LineBonusText[0] := Language.Translate('POPUP_AWFUL'); - Sing.LineBonusText[1] := Sing.LineBonusText[0]; - Sing.LineBonusText[2] := Language.Translate('POPUP_POOR'); - Sing.LineBonusText[3] := Language.Translate('POPUP_BAD'); - Sing.LineBonusText[4] := Language.Translate('POPUP_NOTBAD'); - Sing.LineBonusText[5] := Language.Translate('POPUP_GOOD'); - Sing.LineBonusText[6] := Language.Translate('POPUP_GREAT'); - Sing.LineBonusText[7] := Language.Translate('POPUP_AWESOME'); - Sing.LineBonusText[8] := Language.Translate('POPUP_PERFECT'); - - //PausePopup - ThemeLoadStatic(Sing.PausePopUp, 'PausePopUpStatic'); - - // Score - ThemeLoadBasic(Score, 'Score'); - - ThemeLoadText(Score.TextArtist, 'ScoreTextArtist'); - ThemeLoadText(Score.TextTitle, 'ScoreTextTitle'); - ThemeLoadText(Score.TextArtistTitle, 'ScoreTextArtistTitle'); - - for I := 1 to 6 do - begin - ThemeLoadStatics(Score.PlayerStatic[I], 'ScorePlayer' + IntToStr(I) + 'Static'); - ThemeLoadTexts(Score.PlayerTexts[I], 'ScorePlayer' + IntToStr(I) + 'Text'); - - ThemeLoadText(Score.TextName[I], 'ScoreTextName' + IntToStr(I)); - ThemeLoadText(Score.TextScore[I], 'ScoreTextScore' + IntToStr(I)); - ThemeLoadText(Score.TextNotes[I], 'ScoreTextNotes' + IntToStr(I)); - ThemeLoadText(Score.TextNotesScore[I], 'ScoreTextNotesScore' + IntToStr(I)); - ThemeLoadText(Score.TextLineBonus[I], 'ScoreTextLineBonus' + IntToStr(I)); - ThemeLoadText(Score.TextLineBonusScore[I], 'ScoreTextLineBonusScore' + IntToStr(I)); - ThemeLoadText(Score.TextGoldenNotes[I], 'ScoreTextGoldenNotes' + IntToStr(I)); - ThemeLoadText(Score.TextGoldenNotesScore[I], 'ScoreTextGoldenNotesScore' + IntToStr(I)); - ThemeLoadText(Score.TextTotal[I], 'ScoreTextTotal' + IntToStr(I)); - ThemeLoadText(Score.TextTotalScore[I], 'ScoreTextTotalScore' + IntToStr(I)); - - ThemeLoadStatic(Score.StaticBoxLightest[I], 'ScoreStaticBoxLightest' + IntToStr(I)); - ThemeLoadStatic(Score.StaticBoxLight[I], 'ScoreStaticBoxLight' + IntToStr(I)); - ThemeLoadStatic(Score.StaticBoxDark[I], 'ScoreStaticBoxDark' + IntToStr(I)); - - ThemeLoadStatic(Score.StaticBackLevel[I], 'ScoreStaticBackLevel' + IntToStr(I)); - ThemeLoadStatic(Score.StaticBackLevelRound[I], 'ScoreStaticBackLevelRound' + IntToStr(I)); - ThemeLoadStatic(Score.StaticLevel[I], 'ScoreStaticLevel' + IntToStr(I)); - ThemeLoadStatic(Score.StaticLevelRound[I], 'ScoreStaticLevelRound' + IntToStr(I)); - - ThemeLoadStatic(Score.StaticRatings[I], 'ScoreStaticRatingPicture' + IntToStr(I)); - end; - - // Top5 - ThemeLoadBasic(Top5, 'Top5'); - - ThemeLoadText(Top5.TextLevel, 'Top5TextLevel'); - ThemeLoadText(Top5.TextArtistTitle, 'Top5TextArtistTitle'); - ThemeLoadStatics(Top5.StaticNumber, 'Top5StaticNumber'); - ThemeLoadTexts(Top5.TextNumber, 'Top5TextNumber'); - ThemeLoadTexts(Top5.TextName, 'Top5TextName'); - ThemeLoadTexts(Top5.TextScore, 'Top5TextScore'); - ThemeLoadTexts(Top5.TextDate, 'Top5TextDate'); - - // Options - ThemeLoadBasic(Options, 'Options'); - - ThemeLoadButton(Options.ButtonGame, 'OptionsButtonGame'); - ThemeLoadButton(Options.ButtonGraphics, 'OptionsButtonGraphics'); - ThemeLoadButton(Options.ButtonSound, 'OptionsButtonSound'); - ThemeLoadButton(Options.ButtonLyrics, 'OptionsButtonLyrics'); - ThemeLoadButton(Options.ButtonThemes, 'OptionsButtonThemes'); - ThemeLoadButton(Options.ButtonRecord, 'OptionsButtonRecord'); - ThemeLoadButton(Options.ButtonAdvanced, 'OptionsButtonAdvanced'); - ThemeLoadButton(Options.ButtonExit, 'OptionsButtonExit'); - - Options.Description[0] := Language.Translate('SING_OPTIONS_GAME_DESC'); - Options.Description[1] := Language.Translate('SING_OPTIONS_GRAPHICS_DESC'); - Options.Description[2] := Language.Translate('SING_OPTIONS_SOUND_DESC'); - Options.Description[3] := Language.Translate('SING_OPTIONS_LYRICS_DESC'); - Options.Description[4] := Language.Translate('SING_OPTIONS_THEMES_DESC'); - Options.Description[5] := Language.Translate('SING_OPTIONS_RECORD_DESC'); - Options.Description[6] := Language.Translate('SING_OPTIONS_ADVANCED_DESC'); - Options.Description[7] := Language.Translate('SING_OPTIONS_EXIT'); - - ThemeLoadText(Options.TextDescription, 'OptionsTextDescription'); - Options.TextDescription.Text := Options.Description[0]; - - // Options Game - ThemeLoadBasic(OptionsGame, 'OptionsGame'); - - ThemeLoadSelectSlide(OptionsGame.SelectPlayers, 'OptionsGameSelectPlayers'); - ThemeLoadSelectSlide(OptionsGame.SelectDifficulty, 'OptionsGameSelectDifficulty'); - ThemeLoadSelectSlide(OptionsGame.SelectLanguage, 'OptionsGameSelectSlideLanguage'); - ThemeLoadSelectSlide(OptionsGame.SelectTabs, 'OptionsGameSelectTabs'); - ThemeLoadSelectSlide(OptionsGame.SelectSorting, 'OptionsGameSelectSlideSorting'); - ThemeLoadSelectSlide(OptionsGame.SelectDebug, 'OptionsGameSelectDebug'); - ThemeLoadButton(OptionsGame.ButtonExit, 'OptionsGameButtonExit'); - - // Options Graphics - ThemeLoadBasic(OptionsGraphics, 'OptionsGraphics'); - - ThemeLoadSelectSlide(OptionsGraphics.SelectFullscreen, 'OptionsGraphicsSelectFullscreen'); - ThemeLoadSelectSlide(OptionsGraphics.SelectResolution, 'OptionsGraphicsSelectSlideResolution'); - ThemeLoadSelectSlide(OptionsGraphics.SelectDepth, 'OptionsGraphicsSelectDepth'); - ThemeLoadSelectSlide(OptionsGraphics.SelectVisualizer, 'OptionsGraphicsSelectVisualizer'); - ThemeLoadSelectSlide(OptionsGraphics.SelectOscilloscope, 'OptionsGraphicsSelectOscilloscope'); - ThemeLoadSelectSlide(OptionsGraphics.SelectLineBonus, 'OptionsGraphicsSelectLineBonus'); - ThemeLoadSelectSlide(OptionsGraphics.SelectMovieSize, 'OptionsGraphicsSelectMovieSize'); - ThemeLoadButton(OptionsGraphics.ButtonExit, 'OptionsGraphicsButtonExit'); - - // Options Sound - ThemeLoadBasic(OptionsSound, 'OptionsSound'); - - ThemeLoadSelectSlide(OptionsSound.SelectBackgroundMusic, 'OptionsSoundSelectBackgroundMusic'); - ThemeLoadSelectSlide(OptionsSound.SelectMicBoost, 'OptionsSoundSelectMicBoost'); - ThemeLoadSelectSlide(OptionsSound.SelectClickAssist, 'OptionsSoundSelectClickAssist'); - ThemeLoadSelectSlide(OptionsSound.SelectBeatClick, 'OptionsSoundSelectBeatClick'); - ThemeLoadSelectSlide(OptionsSound.SelectThreshold, 'OptionsSoundSelectThreshold'); - //Song Preview - ThemeLoadSelectSlide(OptionsSound.SelectSlidePreviewVolume, 'OptionsSoundSelectSlidePreviewVolume'); - ThemeLoadSelectSlide(OptionsSound.SelectSlidePreviewFading, 'OptionsSoundSelectSlidePreviewFading'); - ThemeLoadSelectSlide(OptionsSound.SelectSlideVoicePassthrough, 'OptionsSoundSelectVoicePassthrough'); - - ThemeLoadButton(OptionsSound.ButtonExit, 'OptionsSoundButtonExit'); - - // Options Lyrics - ThemeLoadBasic(OptionsLyrics, 'OptionsLyrics'); - - ThemeLoadSelectSlide(OptionsLyrics.SelectLyricsFont, 'OptionsLyricsSelectLyricsFont'); - ThemeLoadSelectSlide(OptionsLyrics.SelectLyricsEffect, 'OptionsLyricsSelectLyricsEffect'); - //ThemeLoadSelectSlide(OptionsLyrics.SelectSolmization, 'OptionsLyricsSelectSolmization'); - ThemeLoadSelectSlide(OptionsLyrics.SelectNoteLines, 'OptionsLyricsSelectNoteLines'); - ThemeLoadButton(OptionsLyrics.ButtonExit, 'OptionsLyricsButtonExit'); - - // Options Themes - ThemeLoadBasic(OptionsThemes, 'OptionsThemes'); - - ThemeLoadSelectSlide(OptionsThemes.SelectTheme, 'OptionsThemesSelectTheme'); - ThemeLoadSelectSlide(OptionsThemes.SelectSkin, 'OptionsThemesSelectSkin'); - ThemeLoadSelectSlide(OptionsThemes.SelectColor, 'OptionsThemesSelectColor'); - ThemeLoadButton(OptionsThemes.ButtonExit, 'OptionsThemesButtonExit'); - - // Options Record - ThemeLoadBasic(OptionsRecord, 'OptionsRecord'); - - ThemeLoadSelectSlide(OptionsRecord.SelectSlideCard, 'OptionsRecordSelectSlideCard'); - ThemeLoadSelectSlide(OptionsRecord.SelectSlideInput, 'OptionsRecordSelectSlideInput'); - ThemeLoadSelectSlide(OptionsRecord.SelectSlideChannel, 'OptionsRecordSelectSlideChannel'); - ThemeLoadButton(OptionsRecord.ButtonExit, 'OptionsRecordButtonExit'); - - //Options Advanced - ThemeLoadBasic(OptionsAdvanced, 'OptionsAdvanced'); - - ThemeLoadSelectSlide(OptionsAdvanced.SelectLoadAnimation, 'OptionsAdvancedSelectLoadAnimation'); - ThemeLoadSelectSlide(OptionsAdvanced.SelectScreenFade, 'OptionsAdvancedSelectScreenFade'); - ThemeLoadSelectSlide(OptionsAdvanced.SelectEffectSing, 'OptionsAdvancedSelectEffectSing'); - ThemeLoadSelectSlide(OptionsAdvanced.SelectLineBonus, 'OptionsAdvancedSelectLineBonus'); - ThemeLoadSelectSlide(OptionsAdvanced.SelectOnSongClick, 'OptionsAdvancedSelectSlideOnSongClick'); - ThemeLoadSelectSlide(OptionsAdvanced.SelectAskbeforeDel, 'OptionsAdvancedSelectAskbeforeDel'); - ThemeLoadSelectSlide(OptionsAdvanced.SelectPartyPopup, 'OptionsAdvancedSelectPartyPopup'); - ThemeLoadButton (OptionsAdvanced.ButtonExit, 'OptionsAdvancedButtonExit'); - - //Edit Menu - ThemeLoadBasic (Edit, 'Edit'); - - ThemeLoadButton(Edit.ButtonConvert, 'EditButtonConvert'); - ThemeLoadButton(Edit.ButtonExit, 'EditButtonExit'); - - Edit.Description[0] := Language.Translate('SING_EDIT_BUTTON_DESCRIPTION_CONVERT'); - Edit.Description[1] := Language.Translate('SING_EDIT_BUTTON_DESCRIPTION_EXIT'); - - ThemeLoadText(Edit.TextDescription, 'EditTextDescription'); - Edit.TextDescription.Text := Edit.Description[0]; - - //error and check popup - ThemeLoadBasic (ErrorPopup, 'ErrorPopup'); - ThemeLoadButton(ErrorPopup.Button1, 'ErrorPopupButton1'); - ThemeLoadText (ErrorPopup.TextError,'ErrorPopupText'); - ThemeLoadBasic (CheckPopup, 'CheckPopup'); - ThemeLoadButton(CheckPopup.Button1, 'CheckPopupButton1'); - ThemeLoadButton(CheckPopup.Button2, 'CheckPopupButton2'); - ThemeLoadText(CheckPopup.TextCheck , 'CheckPopupText'); - - //Song Menu - ThemeLoadBasic (SongMenu, 'SongMenu'); - ThemeLoadButton(SongMenu.Button1, 'SongMenuButton1'); - ThemeLoadButton(SongMenu.Button2, 'SongMenuButton2'); - ThemeLoadButton(SongMenu.Button3, 'SongMenuButton3'); - ThemeLoadButton(SongMenu.Button4, 'SongMenuButton4'); - ThemeLoadSelectSlide(SongMenu.SelectSlide3, 'SongMenuSelectSlide3'); - - ThemeLoadText(SongMenu.TextMenu, 'SongMenuTextMenu'); - - //Song Jumpto - ThemeLoadBasic (SongJumpto, 'SongJumpto'); - ThemeLoadButton(SongJumpto.ButtonSearchText, 'SongJumptoButtonSearchText'); - ThemeLoadSelectSlide(SongJumpto.SelectSlideType, 'SongJumptoSelectSlideType'); - ThemeLoadText(SongJumpto.TextFound, 'SongJumptoTextFound'); - //Translations - SongJumpto.IType[0] := Language.Translate('SONG_JUMPTO_TYPE1'); - SongJumpto.IType[1] := Language.Translate('SONG_JUMPTO_TYPE2'); - SongJumpto.IType[2] := Language.Translate('SONG_JUMPTO_TYPE3'); - SongJumpto.SongsFound := Language.Translate('SONG_JUMPTO_SONGSFOUND'); - SongJumpto.NoSongsFound := Language.Translate('SONG_JUMPTO_NOSONGSFOUND'); - SongJumpto.CatText := Language.Translate('SONG_JUMPTO_CATTEXT'); - - //Party Screens: - //Party NewRound - ThemeLoadBasic(PartyNewRound, 'PartyNewRound'); - - ThemeLoadText (PartyNewRound.TextRound1, 'PartyNewRoundTextRound1'); - ThemeLoadText (PartyNewRound.TextRound2, 'PartyNewRoundTextRound2'); - ThemeLoadText (PartyNewRound.TextRound3, 'PartyNewRoundTextRound3'); - ThemeLoadText (PartyNewRound.TextRound4, 'PartyNewRoundTextRound4'); - ThemeLoadText (PartyNewRound.TextRound5, 'PartyNewRoundTextRound5'); - ThemeLoadText (PartyNewRound.TextRound6, 'PartyNewRoundTextRound6'); - ThemeLoadText (PartyNewRound.TextRound7, 'PartyNewRoundTextRound7'); - ThemeLoadText (PartyNewRound.TextWinner1, 'PartyNewRoundTextWinner1'); - ThemeLoadText (PartyNewRound.TextWinner2, 'PartyNewRoundTextWinner2'); - ThemeLoadText (PartyNewRound.TextWinner3, 'PartyNewRoundTextWinner3'); - ThemeLoadText (PartyNewRound.TextWinner4, 'PartyNewRoundTextWinner4'); - ThemeLoadText (PartyNewRound.TextWinner5, 'PartyNewRoundTextWinner5'); - ThemeLoadText (PartyNewRound.TextWinner6, 'PartyNewRoundTextWinner6'); - ThemeLoadText (PartyNewRound.TextWinner7, 'PartyNewRoundTextWinner7'); - ThemeLoadText (PartyNewRound.TextNextRound, 'PartyNewRoundTextNextRound'); - ThemeLoadText (PartyNewRound.TextNextRoundNo, 'PartyNewRoundTextNextRoundNo'); - ThemeLoadText (PartyNewRound.TextNextPlayer1, 'PartyNewRoundTextNextPlayer1'); - ThemeLoadText (PartyNewRound.TextNextPlayer2, 'PartyNewRoundTextNextPlayer2'); - ThemeLoadText (PartyNewRound.TextNextPlayer3, 'PartyNewRoundTextNextPlayer3'); - - ThemeLoadStatic (PartyNewRound.StaticRound1, 'PartyNewRoundStaticRound1'); - ThemeLoadStatic (PartyNewRound.StaticRound2, 'PartyNewRoundStaticRound2'); - ThemeLoadStatic (PartyNewRound.StaticRound3, 'PartyNewRoundStaticRound3'); - ThemeLoadStatic (PartyNewRound.StaticRound4, 'PartyNewRoundStaticRound4'); - ThemeLoadStatic (PartyNewRound.StaticRound5, 'PartyNewRoundStaticRound5'); - ThemeLoadStatic (PartyNewRound.StaticRound6, 'PartyNewRoundStaticRound6'); - ThemeLoadStatic (PartyNewRound.StaticRound7, 'PartyNewRoundStaticRound7'); - - ThemeLoadText (PartyNewRound.TextScoreTeam1, 'PartyNewRoundTextScoreTeam1'); - ThemeLoadText (PartyNewRound.TextScoreTeam2, 'PartyNewRoundTextScoreTeam2'); - ThemeLoadText (PartyNewRound.TextScoreTeam3, 'PartyNewRoundTextScoreTeam3'); - ThemeLoadText (PartyNewRound.TextNameTeam1, 'PartyNewRoundTextNameTeam1'); - ThemeLoadText (PartyNewRound.TextNameTeam2, 'PartyNewRoundTextNameTeam2'); - ThemeLoadText (PartyNewRound.TextNameTeam3, 'PartyNewRoundTextNameTeam3'); - - ThemeLoadText (PartyNewRound.TextTeam1Players, 'PartyNewRoundTextTeam1Players'); - ThemeLoadText (PartyNewRound.TextTeam2Players, 'PartyNewRoundTextTeam2Players'); - ThemeLoadText (PartyNewRound.TextTeam3Players, 'PartyNewRoundTextTeam3Players'); - - ThemeLoadStatic (PartyNewRound.StaticTeam1, 'PartyNewRoundStaticTeam1'); - ThemeLoadStatic (PartyNewRound.StaticTeam2, 'PartyNewRoundStaticTeam2'); - ThemeLoadStatic (PartyNewRound.StaticTeam3, 'PartyNewRoundStaticTeam3'); - ThemeLoadStatic (PartyNewRound.StaticNextPlayer1, 'PartyNewRoundStaticNextPlayer1'); - ThemeLoadStatic (PartyNewRound.StaticNextPlayer2, 'PartyNewRoundStaticNextPlayer2'); - ThemeLoadStatic (PartyNewRound.StaticNextPlayer3, 'PartyNewRoundStaticNextPlayer3'); - - //Party Score - ThemeLoadBasic(PartyScore, 'PartyScore'); - - ThemeLoadText (PartyScore.TextScoreTeam1, 'PartyScoreTextScoreTeam1'); - ThemeLoadText (PartyScore.TextScoreTeam2, 'PartyScoreTextScoreTeam2'); - ThemeLoadText (PartyScore.TextScoreTeam3, 'PartyScoreTextScoreTeam3'); - ThemeLoadText (PartyScore.TextNameTeam1, 'PartyScoreTextNameTeam1'); - ThemeLoadText (PartyScore.TextNameTeam2, 'PartyScoreTextNameTeam2'); - ThemeLoadText (PartyScore.TextNameTeam3, 'PartyScoreTextNameTeam3'); - - ThemeLoadStatic (PartyScore.StaticTeam1, 'PartyScoreStaticTeam1'); - ThemeLoadStatic (PartyScore.StaticTeam1BG, 'PartyScoreStaticTeam1BG'); - ThemeLoadStatic (PartyScore.StaticTeam1Deco, 'PartyScoreStaticTeam1Deco'); - ThemeLoadStatic (PartyScore.StaticTeam2, 'PartyScoreStaticTeam2'); - ThemeLoadStatic (PartyScore.StaticTeam2BG, 'PartyScoreStaticTeam2BG'); - ThemeLoadStatic (PartyScore.StaticTeam2Deco, 'PartyScoreStaticTeam2Deco'); - ThemeLoadStatic (PartyScore.StaticTeam3, 'PartyScoreStaticTeam3'); - ThemeLoadStatic (PartyScore.StaticTeam3BG, 'PartyScoreStaticTeam3BG'); - ThemeLoadStatic (PartyScore.StaticTeam3Deco, 'PartyScoreStaticTeam3Deco'); - - //Load Party Score DecoTextures Object - PartyScore.DecoTextures.ChangeTextures := (ThemeIni.ReadInteger('PartyScoreDecoTextures', 'ChangeTextures', 0) = 1); - PartyScore.DecoTextures.FirstTexture := ThemeIni.ReadString('PartyScoreDecoTextures', 'FirstTexture', ''); - PartyScore.DecoTextures.FirstTyp := ParseTextureType(ThemeIni.ReadString('PartyScoreDecoTextures', 'FirstTyp', ''), TEXTURE_TYPE_COLORIZED); - PartyScore.DecoTextures.FirstColor := ThemeIni.ReadString('PartyScoreDecoTextures', 'FirstColor', 'Black'); - - PartyScore.DecoTextures.SecondTexture := ThemeIni.ReadString('PartyScoreDecoTextures', 'SecondTexture', ''); - PartyScore.DecoTextures.SecondTyp := ParseTextureType(ThemeIni.ReadString('PartyScoreDecoTextures', 'SecondTyp', ''), TEXTURE_TYPE_COLORIZED); - PartyScore.DecoTextures.SecondColor := ThemeIni.ReadString('PartyScoreDecoTextures', 'SecondColor', 'Black'); - - PartyScore.DecoTextures.ThirdTexture := ThemeIni.ReadString('PartyScoreDecoTextures', 'ThirdTexture', ''); - PartyScore.DecoTextures.ThirdTyp := ParseTextureType(ThemeIni.ReadString('PartyScoreDecoTextures', 'ThirdTyp', ''), TEXTURE_TYPE_COLORIZED); - PartyScore.DecoTextures.ThirdColor := ThemeIni.ReadString('PartyScoreDecoTextures', 'ThirdColor', 'Black'); - - ThemeLoadText (PartyScore.TextWinner, 'PartyScoreTextWinner'); - - //Party Win - ThemeLoadBasic(PartyWin, 'PartyWin'); - - ThemeLoadText (PartyWin.TextScoreTeam1, 'PartyWinTextScoreTeam1'); - ThemeLoadText (PartyWin.TextScoreTeam2, 'PartyWinTextScoreTeam2'); - ThemeLoadText (PartyWin.TextScoreTeam3, 'PartyWinTextScoreTeam3'); - ThemeLoadText (PartyWin.TextNameTeam1, 'PartyWinTextNameTeam1'); - ThemeLoadText (PartyWin.TextNameTeam2, 'PartyWinTextNameTeam2'); - ThemeLoadText (PartyWin.TextNameTeam3, 'PartyWinTextNameTeam3'); - - ThemeLoadStatic (PartyWin.StaticTeam1, 'PartyWinStaticTeam1'); - ThemeLoadStatic (PartyWin.StaticTeam1BG, 'PartyWinStaticTeam1BG'); - ThemeLoadStatic (PartyWin.StaticTeam1Deco, 'PartyWinStaticTeam1Deco'); - ThemeLoadStatic (PartyWin.StaticTeam2, 'PartyWinStaticTeam2'); - ThemeLoadStatic (PartyWin.StaticTeam2BG, 'PartyWinStaticTeam2BG'); - ThemeLoadStatic (PartyWin.StaticTeam2Deco, 'PartyWinStaticTeam2Deco'); - ThemeLoadStatic (PartyWin.StaticTeam3, 'PartyWinStaticTeam3'); - ThemeLoadStatic (PartyWin.StaticTeam3BG, 'PartyWinStaticTeam3BG'); - ThemeLoadStatic (PartyWin.StaticTeam3Deco, 'PartyWinStaticTeam3Deco'); - - ThemeLoadText (PartyWin.TextWinner, 'PartyWinTextWinner'); - - //Party Options - ThemeLoadBasic(PartyOptions, 'PartyOptions'); - ThemeLoadSelectSlide(PartyOptions.SelectLevel, 'PartyOptionsSelectLevel'); - ThemeLoadSelectSlide(PartyOptions.SelectPlayList, 'PartyOptionsSelectPlayList'); - ThemeLoadSelectSlide(PartyOptions.SelectPlayList2, 'PartyOptionsSelectPlayList2'); - ThemeLoadSelectSlide(PartyOptions.SelectRounds, 'PartyOptionsSelectRounds'); - ThemeLoadSelectSlide(PartyOptions.SelectTeams, 'PartyOptionsSelectTeams'); - ThemeLoadSelectSlide(PartyOptions.SelectPlayers1, 'PartyOptionsSelectPlayers1'); - ThemeLoadSelectSlide(PartyOptions.SelectPlayers2, 'PartyOptionsSelectPlayers2'); - ThemeLoadSelectSlide(PartyOptions.SelectPlayers3, 'PartyOptionsSelectPlayers3'); - - {ThemeLoadButton (ButtonNext, 'ButtonNext'); - ThemeLoadButton (ButtonPrev, 'ButtonPrev');} - - //Party Player - ThemeLoadBasic(PartyPlayer, 'PartyPlayer'); - ThemeLoadButton(PartyPlayer.Team1Name, 'PartyPlayerTeam1Name'); - ThemeLoadButton(PartyPlayer.Player1Name, 'PartyPlayerPlayer1Name'); - ThemeLoadButton(PartyPlayer.Player2Name, 'PartyPlayerPlayer2Name'); - ThemeLoadButton(PartyPlayer.Player3Name, 'PartyPlayerPlayer3Name'); - ThemeLoadButton(PartyPlayer.Player4Name, 'PartyPlayerPlayer4Name'); - - ThemeLoadButton(PartyPlayer.Team2Name, 'PartyPlayerTeam2Name'); - ThemeLoadButton(PartyPlayer.Player5Name, 'PartyPlayerPlayer5Name'); - ThemeLoadButton(PartyPlayer.Player6Name, 'PartyPlayerPlayer6Name'); - ThemeLoadButton(PartyPlayer.Player7Name, 'PartyPlayerPlayer7Name'); - ThemeLoadButton(PartyPlayer.Player8Name, 'PartyPlayerPlayer8Name'); - - ThemeLoadButton(PartyPlayer.Team3Name, 'PartyPlayerTeam3Name'); - ThemeLoadButton(PartyPlayer.Player9Name, 'PartyPlayerPlayer9Name'); - ThemeLoadButton(PartyPlayer.Player10Name, 'PartyPlayerPlayer10Name'); - ThemeLoadButton(PartyPlayer.Player11Name, 'PartyPlayerPlayer11Name'); - ThemeLoadButton(PartyPlayer.Player12Name, 'PartyPlayerPlayer12Name'); - - {ThemeLoadButton(ButtonNext, 'PartyPlayerButtonNext'); - ThemeLoadButton(ButtonPrev, 'PartyPlayerButtonPrev');} - - ThemeLoadBasic(StatMain, 'StatMain'); - - ThemeLoadButton(StatMain.ButtonScores, 'StatMainButtonScores'); - ThemeLoadButton(StatMain.ButtonSingers, 'StatMainButtonSingers'); - ThemeLoadButton(StatMain.ButtonSongs, 'StatMainButtonSongs'); - ThemeLoadButton(StatMain.ButtonBands, 'StatMainButtonBands'); - ThemeLoadButton(StatMain.ButtonExit, 'StatMainButtonExit'); - - ThemeLoadText (StatMain.TextOverview, 'StatMainTextOverview'); - - - ThemeLoadBasic(StatDetail, 'StatDetail'); - - ThemeLoadButton(StatDetail.ButtonNext, 'StatDetailButtonNext'); - ThemeLoadButton(StatDetail.ButtonPrev, 'StatDetailButtonPrev'); - ThemeLoadButton(StatDetail.ButtonReverse, 'StatDetailButtonReverse'); - ThemeLoadButton(StatDetail.ButtonExit, 'StatDetailButtonExit'); - - ThemeLoadText (StatDetail.TextDescription, 'StatDetailTextDescription'); - ThemeLoadText (StatDetail.TextPage, 'StatDetailTextPage'); - ThemeLoadTexts(StatDetail.TextList, 'StatDetailTextList'); - - //Translate Texts - StatDetail.Description[0] := Language.Translate('STAT_DESC_SCORES'); - StatDetail.Description[1] := Language.Translate('STAT_DESC_SINGERS'); - StatDetail.Description[2] := Language.Translate('STAT_DESC_SONGS'); - StatDetail.Description[3] := Language.Translate('STAT_DESC_BANDS'); - - StatDetail.DescriptionR[0] := Language.Translate('STAT_DESC_SCORES_REVERSED'); - StatDetail.DescriptionR[1] := Language.Translate('STAT_DESC_SINGERS_REVERSED'); - StatDetail.DescriptionR[2] := Language.Translate('STAT_DESC_SONGS_REVERSED'); - StatDetail.DescriptionR[3] := Language.Translate('STAT_DESC_BANDS_REVERSED'); - - StatDetail.FormatStr[0] := Language.Translate('STAT_FORMAT_SCORES'); - StatDetail.FormatStr[1] := Language.Translate('STAT_FORMAT_SINGERS'); - StatDetail.FormatStr[2] := Language.Translate('STAT_FORMAT_SONGS'); - StatDetail.FormatStr[3] := Language.Translate('STAT_FORMAT_BANDS'); - - StatDetail.PageStr := Language.Translate('STAT_PAGE'); - - //Playlist Translations - Playlist.CatText := Language.Translate('PLAYLIST_CATTEXT'); - - //Level Translations - //Fill ILevel - ILevel[0] := Language.Translate('SING_EASY'); - ILevel[1] := Language.Translate('SING_MEDIUM'); - ILevel[2] := Language.Translate('SING_HARD'); - end; - - ThemeIni.Free; - end; -end; - -procedure TTheme.ThemeLoadBasic(Theme: TThemeBasic; const Name: string); -begin - ThemeLoadBackground(Theme.Background, Name); - ThemeLoadTexts(Theme.Text, Name + 'Text'); - ThemeLoadStatics(Theme.Static, Name + 'Static'); - ThemeLoadButtonCollections(Theme.ButtonCollection, Name + 'ButtonCollection'); - - LastThemeBasic := Theme; -end; - -procedure TTheme.ThemeLoadBackground(var ThemeBackground: TThemeBackground; const Name: string); -var - BGType: string; - I: TBackgroundType; -begin - BGType := LowerCase(ThemeIni.ReadString(Name + 'Background', 'Type', 'auto')); - - ThemeBackground.BGType := bgtAuto; - for I := Low(BGT_Names) to High(BGT_Names) do - begin - if (BGT_Names[I] = BGType) then - begin - ThemeBackground.BGType := I; - Break; - end; - end; - - ThemeBackground.Tex := ThemeIni.ReadString(Name + 'Background', 'Tex', ''); - ThemeBackground.Color.R := ThemeIni.ReadFloat(Name + 'Background', 'ColR', 1); - ThemeBackground.Color.G := ThemeIni.ReadFloat(Name + 'Background', 'ColG', 1); - ThemeBackground.Color.B := ThemeIni.ReadFloat(Name + 'Background', 'ColB', 1); - ThemeBackground.Alpha := ThemeIni.ReadFloat(Name + 'Background', 'Alpha', 1); -end; - -procedure TTheme.ThemeLoadText(var ThemeText: TThemeText; const Name: string); -var - C: integer; -begin - ThemeText.X := ThemeIni.ReadInteger(Name, 'X', 0); - ThemeText.Y := ThemeIni.ReadInteger(Name, 'Y', 0); - ThemeText.W := ThemeIni.ReadInteger(Name, 'W', 0); - - ThemeText.Z := ThemeIni.ReadFloat(Name, 'Z', 0); - - ThemeText.ColR := ThemeIni.ReadFloat(Name, 'ColR', 0); - ThemeText.ColG := ThemeIni.ReadFloat(Name, 'ColG', 0); - ThemeText.ColB := ThemeIni.ReadFloat(Name, 'ColB', 0); - - ThemeText.Font := ThemeIni.ReadInteger(Name, 'Font', 0); - ThemeText.Size := ThemeIni.ReadInteger(Name, 'Size', 0); - ThemeText.Align := ThemeIni.ReadInteger(Name, 'Align', 0); - - ThemeText.Text := Language.Translate(ThemeIni.ReadString(Name, 'Text', '')); - ThemeText.Color := ThemeIni.ReadString(Name, 'Color', ''); - - //Reflection - ThemeText.Reflection := (ThemeIni.ReadInteger(Name, 'Reflection', 0)) = 1; - ThemeText.Reflectionspacing := ThemeIni.ReadFloat(Name, 'ReflectionSpacing', 15); - - C := ColorExists(ThemeText.Color); - if C >= 0 then - begin - ThemeText.ColR := Color[C].RGB.R; - ThemeText.ColG := Color[C].RGB.G; - ThemeText.ColB := Color[C].RGB.B; - end; -end; - -procedure TTheme.ThemeLoadTexts(var ThemeText: AThemeText; const Name: string); -var - T: integer; -begin - T := 1; - while ThemeIni.SectionExists(Name + IntToStr(T)) do - begin - SetLength(ThemeText, T); - ThemeLoadText(ThemeText[T-1], Name + IntToStr(T)); - Inc(T); - end; -end; - -procedure TTheme.ThemeLoadStatic(var ThemeStatic: TThemeStatic; const Name: string); -var - C: integer; -begin - ThemeStatic.Tex := ThemeIni.ReadString(Name, 'Tex', ''); - - ThemeStatic.X := ThemeIni.ReadInteger(Name, 'X', 0); - ThemeStatic.Y := ThemeIni.ReadInteger(Name, 'Y', 0); - ThemeStatic.Z := ThemeIni.ReadFloat (Name, 'Z', 0); - ThemeStatic.W := ThemeIni.ReadInteger(Name, 'W', 0); - ThemeStatic.H := ThemeIni.ReadInteger(Name, 'H', 0); - - ThemeStatic.Typ := ParseTextureType(ThemeIni.ReadString(Name, 'Type', ''), TEXTURE_TYPE_PLAIN); - ThemeStatic.Color := ThemeIni.ReadString(Name, 'Color', ''); - - C := ColorExists(ThemeStatic.Color); - if C >= 0 then - begin - ThemeStatic.ColR := Color[C].RGB.R; - ThemeStatic.ColG := Color[C].RGB.G; - ThemeStatic.ColB := Color[C].RGB.B; - end; - - ThemeStatic.TexX1 := ThemeIni.ReadFloat(Name, 'TexX1', 0); - ThemeStatic.TexY1 := ThemeIni.ReadFloat(Name, 'TexY1', 0); - ThemeStatic.TexX2 := ThemeIni.ReadFloat(Name, 'TexX2', 1); - ThemeStatic.TexY2 := ThemeIni.ReadFloat(Name, 'TexY2', 1); - - //Reflection Mod - ThemeStatic.Reflection := (ThemeIni.ReadInteger(Name, 'Reflection', 0) = 1); - ThemeStatic.ReflectionSpacing := ThemeIni.ReadFloat(Name, 'ReflectionSpacing', 15); -end; - -procedure TTheme.ThemeLoadStatics(var ThemeStatic: AThemeStatic; const Name: string); -var - S: integer; -begin - S := 1; - while ThemeIni.SectionExists(Name + IntToStr(S)) do - begin - SetLength(ThemeStatic, S); - ThemeLoadStatic(ThemeStatic[S-1], Name + IntToStr(S)); - Inc(S); - end; -end; - -//Button Collection Mod -procedure TTheme.ThemeLoadButtonCollection(var Collection: TThemeButtonCollection; const Name: string); -var T: integer; -begin - //Load Collection Style - ThemeLoadButton(Collection.Style, Name); - - //Load Other Attributes - T := ThemeIni.ReadInteger (Name, 'FirstChild', 0); - if (T > 0) And (T < 256) then - Collection.FirstChild := T - else - Collection.FirstChild := 0; -end; - -procedure TTheme.ThemeLoadButtonCollections(var Collections: AThemeButtonCollection; const Name: string); -var - I: integer; -begin - I := 1; - while ThemeIni.SectionExists(Name + IntToStr(I)) do - begin - SetLength(Collections, I); - ThemeLoadButtonCollection(Collections[I-1], Name + IntToStr(I)); - Inc(I); - end; -end; -//End Button Collection Mod - -procedure TTheme.ThemeLoadButton(var ThemeButton: TThemeButton; const Name: string; Collections: PAThemeButtonCollection); -var - C: integer; - TLen: integer; - T: integer; - Collections2: PAThemeButtonCollection; -begin - if not ThemeIni.SectionExists(Name) then - begin - ThemeButton.Visible := False; - exit; - end; - ThemeButton.Tex := ThemeIni.ReadString(Name, 'Tex', ''); - ThemeButton.X := ThemeIni.ReadInteger (Name, 'X', 0); - ThemeButton.Y := ThemeIni.ReadInteger (Name, 'Y', 0); - ThemeButton.Z := ThemeIni.ReadFloat (Name, 'Z', 0); - ThemeButton.W := ThemeIni.ReadInteger (Name, 'W', 0); - ThemeButton.H := ThemeIni.ReadInteger (Name, 'H', 0); - ThemeButton.Typ := ParseTextureType(ThemeIni.ReadString(Name, 'Type', ''), TEXTURE_TYPE_PLAIN); - - //Reflection Mod - ThemeButton.Reflection := (ThemeIni.ReadInteger(Name, 'Reflection', 0) = 1); - ThemeButton.ReflectionSpacing := ThemeIni.ReadFloat(Name, 'ReflectionSpacing', 15); - - ThemeButton.ColR := ThemeIni.ReadFloat(Name, 'ColR', 1); - ThemeButton.ColG := ThemeIni.ReadFloat(Name, 'ColG', 1); - ThemeButton.ColB := ThemeIni.ReadFloat(Name, 'ColB', 1); - ThemeButton.Int := ThemeIni.ReadFloat(Name, 'Int', 1); - ThemeButton.DColR := ThemeIni.ReadFloat(Name, 'DColR', 1); - ThemeButton.DColG := ThemeIni.ReadFloat(Name, 'DColG', 1); - ThemeButton.DColB := ThemeIni.ReadFloat(Name, 'DColB', 1); - ThemeButton.DInt := ThemeIni.ReadFloat(Name, 'DInt', 1); - - ThemeButton.Color := ThemeIni.ReadString(Name, 'Color', ''); - C := ColorExists(ThemeButton.Color); - if C >= 0 then - begin - ThemeButton.ColR := Color[C].RGB.R; - ThemeButton.ColG := Color[C].RGB.G; - ThemeButton.ColB := Color[C].RGB.B; - end; - - ThemeButton.DColor := ThemeIni.ReadString(Name, 'DColor', ''); - C := ColorExists(ThemeButton.DColor); - if C >= 0 then - begin - ThemeButton.DColR := Color[C].RGB.R; - ThemeButton.DColG := Color[C].RGB.G; - ThemeButton.DColB := Color[C].RGB.B; - end; - - ThemeButton.Visible := (ThemeIni.ReadInteger(Name, 'Visible', 1) = 1); - - //Fade Mod - ThemeButton.SelectH := ThemeIni.ReadInteger (Name, 'SelectH', ThemeButton.H); - ThemeButton.SelectW := ThemeIni.ReadInteger (Name, 'SelectW', ThemeButton.W); - - ThemeButton.DeSelectReflectionspacing := ThemeIni.ReadFloat(Name, 'DeSelectReflectionSpacing', ThemeButton.Reflectionspacing); - - ThemeButton.Fade := (ThemeIni.ReadInteger(Name, 'Fade', 0) = 1); - ThemeButton.FadeText := (ThemeIni.ReadInteger(Name, 'FadeText', 0) = 1); - - - ThemeButton.FadeTex := ThemeIni.ReadString(Name, 'FadeTex', ''); - ThemeButton.FadeTexPos:= ThemeIni.ReadInteger(Name, 'FadeTexPos', 0); - if (ThemeButton.FadeTexPos > 4) Or (ThemeButton.FadeTexPos < 0) then - ThemeButton.FadeTexPos := 0; - - //Button Collection Mod - T := ThemeIni.ReadInteger(Name, 'Parent', 0); - - //Set Collections to Last Basic Collections if no valid Value - if (Collections = nil) then - Collections2 := @LastThemeBasic.ButtonCollection - else - Collections2 := Collections; - //Test for valid Value - if (Collections2 <> nil) AND (T > 0) AND (T <= Length(Collections2^)) then - begin - Inc(Collections2^[T-1].ChildCount); - ThemeButton.Parent := T; - end - else - ThemeButton.Parent := 0; - - //Read ButtonTexts - TLen := ThemeIni.ReadInteger(Name, 'Texts', 0); - SetLength(ThemeButton.Text, TLen); - for T := 1 to TLen do - ThemeLoadText(ThemeButton.Text[T-1], Name + 'Text' + IntToStr(T)); -end; - -procedure TTheme.ThemeLoadSelectSlide(var ThemeSelectS: TThemeSelectSlide; const Name: string); -begin - ThemeSelectS.Text := Language.Translate(ThemeIni.ReadString(Name, 'Text', '')); - - ThemeSelectS.Tex := {Skin.SkinPath + }ThemeIni.ReadString(Name, 'Tex', ''); - ThemeSelectS.TexSBG := {Skin.SkinPath + }ThemeIni.ReadString(Name, 'TexSBG', ''); - - ThemeSelectS.X := ThemeIni.ReadInteger(Name, 'X', 0); - ThemeSelectS.Y := ThemeIni.ReadInteger(Name, 'Y', 0); - ThemeSelectS.W := ThemeIni.ReadInteger(Name, 'W', 0); - ThemeSelectS.H := ThemeIni.ReadInteger(Name, 'H', 0); - - ThemeSelectS.Z := ThemeIni.ReadFloat(Name, 'Z', 0); - - ThemeSelectS.TextSize := ThemeIni.ReadInteger(Name, 'TextSize', 30); - - ThemeSelectS.SkipX := ThemeIni.ReadInteger(Name, 'SkipX', 0); - - ThemeSelectS.SBGW := ThemeIni.ReadInteger(Name, 'SBGW', 400); - - LoadColor(ThemeSelectS.ColR, ThemeSelectS.ColG, ThemeSelectS.ColB, ThemeIni.ReadString(Name, 'Color', '')); - ThemeSelectS.Int := ThemeIni.ReadFloat(Name, 'Int', 1); - LoadColor(ThemeSelectS.DColR, ThemeSelectS.DColG, ThemeSelectS.DColB, ThemeIni.ReadString(Name, 'DColor', '')); - ThemeSelectS.DInt := ThemeIni.ReadFloat(Name, 'DInt', 1); - - LoadColor(ThemeSelectS.TColR, ThemeSelectS.TColG, ThemeSelectS.TColB, ThemeIni.ReadString(Name, 'TColor', '')); - ThemeSelectS.TInt := ThemeIni.ReadFloat(Name, 'TInt', 1); - LoadColor(ThemeSelectS.TDColR, ThemeSelectS.TDColG, ThemeSelectS.TDColB, ThemeIni.ReadString(Name, 'TDColor', '')); - ThemeSelectS.TDInt := ThemeIni.ReadFloat(Name, 'TDInt', 1); - - LoadColor(ThemeSelectS.SBGColR, ThemeSelectS.SBGColG, ThemeSelectS.SBGColB, ThemeIni.ReadString(Name, 'SBGColor', '')); - ThemeSelectS.SBGInt := ThemeIni.ReadFloat(Name, 'SBGInt', 1); - LoadColor(ThemeSelectS.SBGDColR, ThemeSelectS.SBGDColG, ThemeSelectS.SBGDColB, ThemeIni.ReadString(Name, 'SBGDColor', '')); - ThemeSelectS.SBGDInt := ThemeIni.ReadFloat(Name, 'SBGDInt', 1); - - LoadColor(ThemeSelectS.STColR, ThemeSelectS.STColG, ThemeSelectS.STColB, ThemeIni.ReadString(Name, 'STColor', '')); - ThemeSelectS.STInt := ThemeIni.ReadFloat(Name, 'STInt', 1); - LoadColor(ThemeSelectS.STDColR, ThemeSelectS.STDColG, ThemeSelectS.STDColB, ThemeIni.ReadString(Name, 'STDColor', '')); - ThemeSelectS.STDInt := ThemeIni.ReadFloat(Name, 'STDInt', 1); -end; - -procedure TTheme.ThemeLoadEqualizer(var ThemeEqualizer: TThemeEqualizer; const Name: string); -var I: integer; -begin - ThemeEqualizer.Visible := (ThemeIni.ReadInteger(Name, 'Visible', 0) = 1); - ThemeEqualizer.Direction := (ThemeIni.ReadInteger(Name, 'Direction', 0) = 1); - ThemeEqualizer.Alpha := ThemeIni.ReadInteger(Name, 'Alpha', 1); - ThemeEqualizer.Space := ThemeIni.ReadInteger(Name, 'Space', 1); - ThemeEqualizer.X := ThemeIni.ReadInteger(Name, 'X', 0); - ThemeEqualizer.Y := ThemeIni.ReadInteger(Name, 'Y', 0); - ThemeEqualizer.Z := ThemeIni.ReadInteger(Name, 'Z', 1); - ThemeEqualizer.W := ThemeIni.ReadInteger(Name, 'PieceW', 8); - ThemeEqualizer.H := ThemeIni.ReadInteger(Name, 'PieceH', 8); - ThemeEqualizer.Bands := ThemeIni.ReadInteger(Name, 'Bands', 5); - ThemeEqualizer.Length := ThemeIni.ReadInteger(Name, 'Length', 12); - ThemeEqualizer.Reflection := (ThemeIni.ReadInteger(Name, 'Reflection', 0) = 1); - ThemeEqualizer.ReflectionSpacing := ThemeIni.ReadFloat(Name, 'ReflectionSpacing', 15); - - //Color - I := ColorExists(ThemeIni.ReadString(Name, 'Color', 'Black')); - if I >= 0 then - begin - ThemeEqualizer.ColR := Color[I].RGB.R; - ThemeEqualizer.ColG := Color[I].RGB.G; - ThemeEqualizer.ColB := Color[I].RGB.B; - end - else - begin - ThemeEqualizer.ColR := 0; - ThemeEqualizer.ColG := 0; - ThemeEqualizer.ColB := 0; - end; -end; - -procedure TTheme.LoadColors; -var - SL: TStringList; - C: integer; - S: string; -begin - SL := TStringList.Create; - ThemeIni.ReadSection('Colors', SL); - - // normal colors - SetLength(Color, SL.Count); - for C := 0 to SL.Count-1 do - begin - Color[C].Name := SL.Strings[C]; - - S := ThemeIni.ReadString('Colors', SL.Strings[C], ''); - - Color[C].RGB.R := StrToInt(Copy(S, 1, Pos(' ' , S)-1))/255; - Delete(S, 1, Pos(' ', S)); - - Color[C].RGB.G := StrToInt(Copy(S, 1, Pos(' ' , S)-1))/255; - Delete(S, 1, Pos(' ', S)); - - Color[C].RGB.B := StrToInt(S)/255; - end; - - // skin color - SetLength(Color, SL.Count + 3); - C := SL.Count; - Color[C].Name := 'ColorDark'; - Color[C].RGB := GetSystemColor(Skin.Color); //Ini.Color); - - C := C+1; - Color[C].Name := 'ColorLight'; - Color[C].RGB := ColorSqrt(Color[C-1].RGB); - - C := C+1; - Color[C].Name := 'ColorLightest'; - Color[C].RGB := ColorSqrt(Color[C-1].RGB); - - // players colors - SetLength(Color, Length(Color)+18); - - // P1 - C := C+1; - Color[C].Name := 'P1Dark'; - Color[C].RGB := GetSystemColor(0); // 0 - blue - - C := C+1; - Color[C].Name := 'P1Light'; - Color[C].RGB := ColorSqrt(Color[C-1].RGB); - - C := C+1; - Color[C].Name := 'P1Lightest'; - Color[C].RGB := ColorSqrt(Color[C-1].RGB); - - // P2 - C := C+1; - Color[C].Name := 'P2Dark'; - Color[C].RGB := GetSystemColor(3); // 3 - red - - C := C+1; - Color[C].Name := 'P2Light'; - Color[C].RGB := ColorSqrt(Color[C-1].RGB); - - C := C+1; - Color[C].Name := 'P2Lightest'; - Color[C].RGB := ColorSqrt(Color[C-1].RGB); - - // P3 - C := C+1; - Color[C].Name := 'P3Dark'; - Color[C].RGB := GetSystemColor(1); // 1 - green - - C := C+1; - Color[C].Name := 'P3Light'; - Color[C].RGB := ColorSqrt(Color[C-1].RGB); - - C := C+1; - Color[C].Name := 'P3Lightest'; - Color[C].RGB := ColorSqrt(Color[C-1].RGB); - - // P4 - C := C+1; - Color[C].Name := 'P4Dark'; - Color[C].RGB := GetSystemColor(4); // 4 - brown - - C := C+1; - Color[C].Name := 'P4Light'; - Color[C].RGB := ColorSqrt(Color[C-1].RGB); - - C := C+1; - Color[C].Name := 'P4Lightest'; - Color[C].RGB := ColorSqrt(Color[C-1].RGB); - - // P5 - C := C+1; - Color[C].Name := 'P5Dark'; - Color[C].RGB := GetSystemColor(5); // 5 - yellow - - C := C+1; - Color[C].Name := 'P5Light'; - Color[C].RGB := ColorSqrt(Color[C-1].RGB); - - C := C+1; - Color[C].Name := 'P5Lightest'; - Color[C].RGB := ColorSqrt(Color[C-1].RGB); - - // P6 - C := C+1; - Color[C].Name := 'P6Dark'; - Color[C].RGB := GetSystemColor(6); // 6 - violet - - C := C+1; - Color[C].Name := 'P6Light'; - Color[C].RGB := ColorSqrt(Color[C-1].RGB); - - C := C+1; - Color[C].Name := 'P6Lightest'; - Color[C].RGB := ColorSqrt(Color[C-1].RGB); - - - SL.Free; -end; - -function ColorExists(Name: string): integer; -var - C: integer; -begin - Result := -1; - for C := 0 to High(Color) do - if Color[C].Name = Name then - Result := C; -end; - -procedure LoadColor(var R, G, B: real; ColorName: string); -var - C: integer; -begin - C := ColorExists(ColorName); - if C >= 0 then - begin - R := Color[C].RGB.R; - G := Color[C].RGB.G; - B := Color[C].RGB.B; - end; -end; - -function GetSystemColor(Color: integer): TRGB; -begin - case Color of - 0: begin - // blue - Result.R := 71/255; - Result.G := 175/255; - Result.B := 247/255; - end; - 1: begin - // green - Result.R := 63/255; - Result.G := 191/255; - Result.B := 63/255; - end; - 2: begin - // pink - Result.R := 255/255; -{ Result.G := 63/255; - Result.B := 192/255;} - Result.G := 175/255; - Result.B := 247/255; - end; - 3: begin - // red - Result.R := 247/255; - Result.G := 71/255; - Result.B := 71/255; - end; - //'Violet', 'Orange', 'Yellow', 'Brown', 'Black' - //New Theme-Color Patch - 4: begin - // violet - Result.R := 230/255; - Result.G := 63/255; - Result.B := 230/255; - end; - 5: begin - // orange - Result.R := 255/255; - Result.G := 144/255; - Result.B := 0; - end; - 6: begin - // yellow - Result.R := 230/255; - Result.G := 230/255; - Result.B := 95/255; - end; - 7: begin - // brown - Result.R := 192/255; - Result.G := 127/255; - Result.B := 31/255; - end; - 8: begin - // black - Result.R := 0; - Result.G := 0; - Result.B := 0; - end; - //New Theme-Color Patch End - - end; -end; - -function ColorSqrt(RGB: TRGB): TRGB; -begin - Result.R := sqrt(RGB.R); - Result.G := sqrt(RGB.G); - Result.B := sqrt(RGB.B); -end; - -procedure TTheme.ThemeSave(const FileName: string); -var - I: integer; -begin - {$IFDEF THEMESAVE} - ThemeIni := TIniFile.Create(FileName); - {$ELSE} - ThemeIni := TMemIniFile.Create(FileName); - {$ENDIF} - - ThemeSaveBasic(Loading, 'Loading'); - - ThemeSaveBasic(Main, 'Main'); - ThemeSaveText(Main.TextDescription, 'MainTextDescription'); - ThemeSaveText(Main.TextDescriptionLong, 'MainTextDescriptionLong'); - ThemeSaveButton(Main.ButtonSolo, 'MainButtonSolo'); - ThemeSaveButton(Main.ButtonEditor, 'MainButtonEditor'); - ThemeSaveButton(Main.ButtonOptions, 'MainButtonOptions'); - ThemeSaveButton(Main.ButtonExit, 'MainButtonExit'); - - ThemeSaveBasic(Name, 'Name'); - for I := 1 to 6 do - ThemeSaveButton(Name.ButtonPlayer[I], 'NameButtonPlayer' + IntToStr(I)); - - ThemeSaveBasic(Level, 'Level'); - ThemeSaveButton(Level.ButtonEasy, 'LevelButtonEasy'); - ThemeSaveButton(Level.ButtonMedium, 'LevelButtonMedium'); - ThemeSaveButton(Level.ButtonHard, 'LevelButtonHard'); - - ThemeSaveBasic(Song, 'Song'); - ThemeSaveText(Song.TextArtist, 'SongTextArtist'); - ThemeSaveText(Song.TextTitle, 'SongTextTitle'); - ThemeSaveText(Song.TextNumber, 'SongTextNumber'); - - //Show CAt in Top Left Mod - ThemeSaveText(Song.TextCat, 'SongTextCat'); - ThemeSaveStatic(Song.StaticCat, 'SongStaticCat'); - - ThemeSaveBasic(Sing, 'Sing'); - - //TimeBar mod - ThemeSaveStatic(Sing.StaticTimeProgress, 'SingTimeProgress'); - ThemeSaveText(Sing.TextTimeText, 'SingTimeText'); - //eoa TimeBar mod - - ThemeSaveStatic(Sing.StaticP1, 'SingP1Static'); - ThemeSaveText(Sing.TextP1, 'SingP1Text'); - ThemeSaveStatic(Sing.StaticP1ScoreBG, 'SingP1Static2'); - ThemeSaveText(Sing.TextP1Score, 'SingP1TextScore'); - - //moveable singbar mod - ThemeSaveStatic(Sing.StaticP1SingBar, 'SingP1SingBar'); - ThemeSaveStatic(Sing.StaticP1TwoPSingBar, 'SingP1TwoPSingBar'); - ThemeSaveStatic(Sing.StaticP1ThreePSingBar, 'SingP1ThreePSingBar'); - ThemeSaveStatic(Sing.StaticP2RSingBar, 'SingP2RSingBar'); - ThemeSaveStatic(Sing.StaticP2MSingBar, 'SingP2MSingBar'); - ThemeSaveStatic(Sing.StaticP3SingBar, 'SingP3SingBar'); - //eoa moveable singbar - - //Added for ps3 skin - //This one is shown in 2/4P mode - ThemeSaveStatic(Sing.StaticP1TwoP, 'SingP1TwoPStatic'); - ThemeSaveText(Sing.TextP1TwoP, 'SingP1TwoPText'); - ThemeSaveStatic(Sing.StaticP1TwoPScoreBG, 'SingP1TwoPStatic2'); - ThemeSaveText(Sing.TextP1TwoPScore, 'SingP1TwoPTextScore'); - - //This one is shown in 3/6P mode - ThemeSaveStatic(Sing.StaticP1ThreeP, 'SingP1ThreePStatic'); - ThemeSaveText(Sing.TextP1ThreeP, 'SingP1ThreePText'); - ThemeSaveStatic(Sing.StaticP1ThreePScoreBG, 'SingP1ThreePStatic2'); - ThemeSaveText(Sing.TextP1ThreePScore, 'SingP1ThreePTextScore'); - //eoa - - ThemeSaveStatic(Sing.StaticP2R, 'SingP2RStatic'); - ThemeSaveText(Sing.TextP2R, 'SingP2RText'); - ThemeSaveStatic(Sing.StaticP2RScoreBG, 'SingP2RStatic2'); - ThemeSaveText(Sing.TextP2RScore, 'SingP2RTextScore'); - - ThemeSaveStatic(Sing.StaticP2M, 'SingP2MStatic'); - ThemeSaveText(Sing.TextP2M, 'SingP2MText'); - ThemeSaveStatic(Sing.StaticP2MScoreBG, 'SingP2MStatic2'); - ThemeSaveText(Sing.TextP2MScore, 'SingP2MTextScore'); - - ThemeSaveStatic(Sing.StaticP3R, 'SingP3RStatic'); - ThemeSaveText(Sing.TextP3R, 'SingP3RText'); - ThemeSaveStatic(Sing.StaticP3RScoreBG, 'SingP3RStatic2'); - ThemeSaveText(Sing.TextP3RScore, 'SingP3RTextScore'); - - ThemeSaveBasic(Score, 'Score'); - ThemeSaveText(Score.TextArtist, 'ScoreTextArtist'); - ThemeSaveText(Score.TextTitle, 'ScoreTextTitle'); - - for I := 1 to 6 do - begin - ThemeSaveStatics(Score.PlayerStatic[I], 'ScorePlayer' + IntToStr(I) + 'Static'); - - ThemeSaveText(Score.TextName[I], 'ScoreTextName' + IntToStr(I)); - ThemeSaveText(Score.TextScore[I], 'ScoreTextScore' + IntToStr(I)); - ThemeSaveText(Score.TextNotes[I], 'ScoreTextNotes' + IntToStr(I)); - ThemeSaveText(Score.TextNotesScore[I], 'ScoreTextNotesScore' + IntToStr(I)); - ThemeSaveText(Score.TextLineBonus[I], 'ScoreTextLineBonus' + IntToStr(I)); - ThemeSaveText(Score.TextLineBonusScore[I], 'ScoreTextLineBonusScore' + IntToStr(I)); - ThemeSaveText(Score.TextGoldenNotes[I], 'ScoreTextGoldenNotes' + IntToStr(I)); - ThemeSaveText(Score.TextGoldenNotesScore[I], 'ScoreTextGoldenNotesScore' + IntToStr(I)); - ThemeSaveText(Score.TextTotal[I], 'ScoreTextTotal' + IntToStr(I)); - ThemeSaveText(Score.TextTotalScore[I], 'ScoreTextTotalScore' + IntToStr(I)); - - ThemeSaveStatic(Score.StaticBackLevel[I], 'ScoreStaticBackLevel' + IntToStr(I)); - ThemeSaveStatic(Score.StaticBackLevelRound[I], 'ScoreStaticBackLevelRound' + IntToStr(I)); - ThemeSaveStatic(Score.StaticLevel[I], 'ScoreStaticLevel' + IntToStr(I)); - ThemeSaveStatic(Score.StaticLevelRound[I], 'ScoreStaticLevelRound' + IntToStr(I)); - end; - - ThemeSaveBasic(Top5, 'Top5'); - ThemeSaveText(Top5.TextLevel, 'Top5TextLevel'); - ThemeSaveText(Top5.TextArtistTitle, 'Top5TextArtistTitle'); - ThemeSaveStatics(Top5.StaticNumber, 'Top5StaticNumber'); - ThemeSaveTexts(Top5.TextNumber, 'Top5TextNumber'); - ThemeSaveTexts(Top5.TextName, 'Top5TextName'); - ThemeSaveTexts(Top5.TextScore, 'Top5TextScore'); - - - ThemeIni.Free; -end; - -procedure TTheme.ThemeSaveBasic(Theme: TThemeBasic; const Name: string); -begin - ThemeIni.WriteInteger(Name, 'Texts', Length(Theme.Text)); - - ThemeSaveBackground(Theme.Background, Name + 'Background'); - ThemeSaveStatics(Theme.Static, Name + 'Static'); - ThemeSaveTexts(Theme.Text, Name + 'Text'); -end; - -procedure TTheme.ThemeSaveBackground(ThemeBackground: TThemeBackground; const Name: string); -begin - if ThemeBackground.Tex <> '' then - ThemeIni.WriteString(Name, 'Tex', ThemeBackground.Tex) - else - begin - ThemeIni.EraseSection(Name); - end; -end; - -procedure TTheme.ThemeSaveStatic(ThemeStatic: TThemeStatic; const Name: string); -begin - ThemeIni.WriteInteger(Name, 'X', ThemeStatic.X); - ThemeIni.WriteInteger(Name, 'Y', ThemeStatic.Y); - ThemeIni.WriteInteger(Name, 'W', ThemeStatic.W); - ThemeIni.WriteInteger(Name, 'H', ThemeStatic.H); - - ThemeIni.WriteString(Name, 'Tex', ThemeStatic.Tex); - ThemeIni.WriteString(Name, 'Type', TextureTypeToStr(ThemeStatic.Typ)); - ThemeIni.WriteString(Name, 'Color', ThemeStatic.Color); - - ThemeIni.WriteFloat(Name, 'TexX1', ThemeStatic.TexX1); - ThemeIni.WriteFloat(Name, 'TexY1', ThemeStatic.TexY1); - ThemeIni.WriteFloat(Name, 'TexX2', ThemeStatic.TexX2); - ThemeIni.WriteFloat(Name, 'TexY2', ThemeStatic.TexY2); -end; - -procedure TTheme.ThemeSaveStatics(ThemeStatic: AThemeStatic; const Name: string); -var - S: integer; -begin - for S := 0 to Length(ThemeStatic)-1 do - ThemeSaveStatic(ThemeStatic[S], Name + {'Static' +} IntToStr(S+1)); - - ThemeIni.EraseSection(Name + {'Static' + }IntToStr(S+1)); -end; - -procedure TTheme.ThemeSaveText(ThemeText: TThemeText; const Name: string); -begin - ThemeIni.WriteInteger(Name, 'X', ThemeText.X); - ThemeIni.WriteInteger(Name, 'Y', ThemeText.Y); - - ThemeIni.WriteInteger(Name, 'Font', ThemeText.Font); - ThemeIni.WriteInteger(Name, 'Size', ThemeText.Size); - ThemeIni.WriteInteger(Name, 'Align', ThemeText.Align); - - ThemeIni.WriteString(Name, 'Text', ThemeText.Text); - ThemeIni.WriteString(Name, 'Color', ThemeText.Color); - - ThemeIni.WriteBool(Name, 'Reflection', ThemeText.Reflection); - ThemeIni.WriteFloat(Name, 'ReflectionSpacing', ThemeText.ReflectionSpacing); -end; - -procedure TTheme.ThemeSaveTexts(ThemeText: AThemeText; const Name: string); -var - T: integer; -begin - for T := 0 to Length(ThemeText)-1 do - ThemeSaveText(ThemeText[T], Name + {'Text' + }IntToStr(T+1)); - - ThemeIni.EraseSection(Name + {'Text' + }IntToStr(T+1)); -end; - -procedure TTheme.ThemeSaveButton(ThemeButton: TThemeButton; const Name: string); -var - T: integer; -begin - ThemeIni.WriteString(Name, 'Tex', ThemeButton.Tex); - ThemeIni.WriteInteger(Name, 'X', ThemeButton.X); - ThemeIni.WriteInteger(Name, 'Y', ThemeButton.Y); - ThemeIni.WriteInteger(Name, 'W', ThemeButton.W); - ThemeIni.WriteInteger(Name, 'H', ThemeButton.H); - ThemeIni.WriteString(Name, 'Type', TextureTypeToStr(ThemeButton.Typ)); - ThemeIni.WriteInteger(Name, 'Texts', Length(ThemeButton.Text)); - - ThemeIni.WriteString(Name, 'Color', ThemeButton.Color); - -{ ThemeButton.ColR := ThemeIni.ReadFloat(Name, 'ColR', 1); - ThemeButton.ColG := ThemeIni.ReadFloat(Name, 'ColG', 1); - ThemeButton.ColB := ThemeIni.ReadFloat(Name, 'ColB', 1); - ThemeButton.Int := ThemeIni.ReadFloat(Name, 'Int', 1); - ThemeButton.DColR := ThemeIni.ReadFloat(Name, 'DColR', 1); - ThemeButton.DColG := ThemeIni.ReadFloat(Name, 'DColG', 1); - ThemeButton.DColB := ThemeIni.ReadFloat(Name, 'DColB', 1); - ThemeButton.DInt := ThemeIni.ReadFloat(Name, 'DInt', 1);} - -{ C := ColorExists(ThemeIni.ReadString(Name, 'Color', '')); - if C >= 0 then - begin - ThemeButton.ColR := Color[C].RGB.R; - ThemeButton.ColG := Color[C].RGB.G; - ThemeButton.ColB := Color[C].RGB.B; - end; - - C := ColorExists(ThemeIni.ReadString(Name, 'DColor', '')); - if C >= 0 then - begin - ThemeButton.DColR := Color[C].RGB.R; - ThemeButton.DColG := Color[C].RGB.G; - ThemeButton.DColB := Color[C].RGB.B; - end;} - - for T := 0 to High(ThemeButton.Text) do - ThemeSaveText(ThemeButton.Text[T], Name + 'Text' + IntToStr(T+1)); -end; - -procedure TTheme.CreateThemeObjects(); -begin - freeandnil(Loading); - Loading := TThemeLoading.Create; - - freeandnil(Main); - Main := TThemeMain.Create; - - freeandnil(Name); - Name := TThemeName.Create; - - freeandnil(Level); - Level := TThemeLevel.Create; - - freeandnil(Song); - Song := TThemeSong.Create; - - freeandnil(Sing); - Sing := TThemeSing.Create; - - freeandnil(Score); - Score := TThemeScore.Create; - - freeandnil(Top5); - Top5 := TThemeTop5.Create; - - freeandnil(Options); - Options := TThemeOptions.Create; - - freeandnil(OptionsGame); - OptionsGame := TThemeOptionsGame.Create; - - freeandnil(OptionsGraphics); - OptionsGraphics := TThemeOptionsGraphics.Create; - - freeandnil(OptionsSound); - OptionsSound := TThemeOptionsSound.Create; - - freeandnil(OptionsLyrics); - OptionsLyrics := TThemeOptionsLyrics.Create; - - freeandnil(OptionsThemes); - OptionsThemes := TThemeOptionsThemes.Create; - - freeandnil(OptionsRecord); - OptionsRecord := TThemeOptionsRecord.Create; - - freeandnil(OptionsAdvanced); - OptionsAdvanced := TThemeOptionsAdvanced.Create; - - freeandnil(Edit); - Edit := TThemeEdit.Create; - - freeandnil(ErrorPopup); - ErrorPopup := TThemeError.Create; - - freeandnil(CheckPopup); - CheckPopup := TThemeCheck.Create; - - freeandnil(SongMenu); - SongMenu := TThemeSongMenu.Create; - - freeandnil(SongJumpto); - SongJumpto := TThemeSongJumpto.Create; - - //Party Screens - freeandnil(PartyNewRound); - PartyNewRound := TThemePartyNewRound.Create; - - freeandnil(PartyWin); - PartyWin := TThemePartyWin.Create; - - freeandnil(PartyScore); - PartyScore := TThemePartyScore.Create; - - freeandnil(PartyOptions); - PartyOptions := TThemePartyOptions.Create; - - freeandnil(PartyPlayer); - PartyPlayer := TThemePartyPlayer.Create; - - //Stats Screens: - freeandnil(StatMain); - StatMain := TThemeStatMain.Create; - - freeandnil(StatDetail); - StatDetail := TThemeStatDetail.Create; - - end; - -end. diff --git a/src/base/UUnicodeUtils.pas b/src/base/UUnicodeUtils.pas deleted file mode 100644 index 37b53a67..00000000 --- a/src/base/UUnicodeUtils.pas +++ /dev/null @@ -1,670 +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 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/src/base/UXMLSong.pas b/src/base/UXMLSong.pas deleted file mode 100644 index e9751eba..00000000 --- a/src/base/UXMLSong.pas +++ /dev/null @@ -1,623 +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 UXMLSong; - -interface - -{$IFDEF FPC} - {$MODE Delphi} -{$ENDIF} - -{$I switches.inc} - -uses - Classes, - UPath, - UUnicodeUtils; - -type - TNote = record - Start: Cardinal; - Duration: Cardinal; - Tone: Integer; - NoteTyp: Byte; - Lyric: UTF8String; - end; - ANote = array of TNote; - - TSentence = record - Singer: Byte; - Duration: Cardinal; - Notes: ANote; - end; - ASentence = array of TSentence; - - TSongInfo = record - ID: Cardinal; - DualChannel: Boolean; - Header: record - Artist: UTF8String; - Title: UTF8String; - Gap: Cardinal; - BPM: Real; - Resolution: Byte; - Edition: UTF8String; - Genre: UTF8String; - Year: UTF8String; - Language: UTF8String; - end; - CountSentences: Cardinal; - Sentences: ASentence; - end; - - TParser = class - private - SSFile: TStringList; - - ParserState: Byte; - CurPosinSong: Cardinal; //Cur Beat Pos in the Song - CurDuettSinger: Byte; //Who sings this Part? - BindLyrics: Boolean; //Should the Lyrics be bind to the last Word (no Space) - FirstNote: Boolean; //Is this the First Note found? For Gap calculating - - function ParseLine(Line: RawByteString): Boolean; - public - SongInfo: TSongInfo; - ErrorMessage: string; - Edition: UTF8String; - SingstarVersion: string; - - Settings: record - DashReplacement: Char; - end; - - constructor Create; - - function ParseConfigForEdition(const Filename: IPath): String; - - function ParseSongHeader(const Filename: IPath): Boolean; //Parse Song Header only - function ParseSong (const Filename: IPath): Boolean; //Parse whole Song - end; - -const - PS_None = 0; - PS_Melody = 1; - PS_Sentence = 2; - - NT_Normal = 1; - NT_Freestyle = 0; - NT_Golden = 2; - - DS_Player1 = 1; - DS_Player2 = 2; - DS_Both = 3; - -implementation - -uses - SysUtils, - StrUtils; - -constructor TParser.Create; -begin - inherited Create; - ErrorMessage := ''; - - DecimalSeparator := '.'; -end; - -function TParser.ParseSong(const Filename: IPath): Boolean; -var - I: Integer; - FileStream: TBinaryFileStream; -begin - Result := False; - if Filename.IsFile() then - begin - ErrorMessage := 'Can''t open melody.xml file'; - - SSFile := TStringList.Create; - FileStream := TBinaryFileStream.Create(Filename, fmOpenRead); - try - SSFile.LoadFromStream(FileStream); - - ErrorMessage := ''; - Result := True; - - I := 0; - - SongInfo.CountSentences := 0; - CurDuettSinger := DS_Both; //Both is Singstar Standard - CurPosinSong := 0; //Start at Pos 0 - BindLyrics := True; //Dont start with Space - FirstNote := True; //First Note found should be the First Note ;) - - SongInfo.Header.Language := ''; - SongInfo.Header.Edition := Edition; - SongInfo.DualChannel := False; - - ParserState := PS_None; - - SetLength(SongInfo.Sentences, 0); - - while Result and (I < SSFile.Count) do - begin - Result := ParseLine(SSFile.Strings[I]); - - Inc(I); - end; - - finally - SSFile.Free; - FileStream.Free; - end; - end; -end; - -function TParser.ParseSongHeader (const Filename: IPath): Boolean; -var - I: Integer; - Stream: TBinaryFileStream; -begin - Result := False; - - if Filename.IsFile() then - begin - SSFile := TStringList.Create; - Stream := TBinaryFileStream.Create(Filename, fmOpenRead); - try - SSFile.LoadFromStream(Stream); - - If (SSFile.Count > 0) then - begin - Result := True; - I := 0; - - SongInfo.CountSentences := 0; - CurDuettSinger := DS_Both; //Both is Singstar Standard - CurPosinSong := 0; //Start at Pos 0 - BindLyrics := True; //Dont start with Space - FirstNote := True; //First Note found should be the First Note ;) - - SongInfo.ID := 0; - SongInfo.Header.Language := ''; - SongInfo.Header.Edition := Edition; - SongInfo.DualChannel := False; - ParserState := PS_None; - - While (SongInfo.ID < 4) AND Result And (I < SSFile.Count) do - begin - Result := ParseLine(SSFile.Strings[I]); - - Inc(I); - end; - end - else - ErrorMessage := 'Can''t open melody.xml file'; - - finally - SSFile.Free; - Stream.Free; - end; - end - else - ErrorMessage := 'Can''t find melody.xml file'; -end; - -Function TParser.ParseLine(Line: String): Boolean; -var - Tag: String; - Values: String; - AValues: Array of Record - Name: String; - Value: String; - end; - I, J, K: Integer; - Duration, Tone: Integer; - Lyric: String; - NoteType: Byte; - - Procedure MakeValuesArray; - var Len, Pos, State, StateChange: Integer; - begin - Len := -1; - SetLength(AValues, Len + 1); - - Pos := 1; - State := 0; - While (Pos <= Length(Values)) AND (Pos <> 0) do - begin - Case State of - - 0: begin //Search for ValueName - If (Values[Pos] <> ' ') AND (Values[Pos] <> '=') then - begin - //Found Something - State := 1; //State search for '=' - StateChange := Pos; //Save Pos of Change - Pos := PosEx('=', Values, Pos + 1); - end - else Inc(Pos); //When nothing found then go to next char - end; - - 1: begin //Search for Equal Mark - //Add New Value - Inc(Len); - SetLength(AValues, Len + 1); - - AValues[Len].Name := UpperCase(Copy(Values, StateChange, Pos - StateChange)); - - - State := 2; //Now Search for starting '"' - StateChange := Pos; //Save Pos of Change - Pos := PosEx('"', Values, Pos + 1); - end; - - 2: begin //Search for starting '"' or ' ' <- End if there was no " - If (Values[Pos] = '"') then - begin //Found starting '"' - State := 3; //Now Search for ending '"' - StateChange := Pos; //Save Pos of Change - Pos := PosEx('"', Values, Pos + 1); - end - else If (Values[Pos] = ' ') then //Found ending Space - begin - //Save Value to Array - AValues[Len].Value := Copy(Values, StateChange + 1, Pos - StateChange - 1); - - //Search for next Valuename - State := 0; - StateChange := Pos; - Inc(Pos); - end; - end; - - 3: begin //Search for ending '"' - //Save Value to Array - AValues[Len].Value := Copy(Values, StateChange + 1, Pos - StateChange - 1); - - //Search for next Valuename - State := 0; - StateChange := Pos; - Inc(Pos); - end; - end; - - If (State >= 2) then - begin //Save Last Value - AValues[Len].Value := Copy(Values, StateChange + 1, Length(Values) - StateChange); - end; - end; - end; -begin - Result := True; - - Line := Trim(Line); - If (Length(Line) > 0) then - begin - I := Pos('<', Line); - J := PosEx(' ', Line, I+1); - K := PosEx('>', Line, I+1); - - If (J = 0) then J := K - Else If (K < J) AND (K <> 0) then J := K; //Use nearest Tagname End indicator - Tag := UpperCase(copy(Line, I + 1, J - I - 1)); - Values := copy(Line, J + 1, K - J - 1); - - Case ParserState of - PS_None: begin//Search for Melody Tag - If (Tag = 'MELODY') then - begin - Inc(SongInfo.ID); //Inc SongID when header Information is added - MakeValuesArray; - For I := 0 to High(AValues) do - begin - If (AValues[I].Name = 'TEMPO') then - begin - SongInfo.Header.BPM := StrtoFloatDef(AValues[I].Value, 0); - If (SongInfo.Header.BPM <= 0) then - begin - Result := False; - ErrorMessage := 'Can''t read BPM from Song'; - end; - end - - Else If (AValues[I].Name = 'RESOLUTION') then - begin - AValues[I].Value := Uppercase(AValues[I].Value); - //Ultrastar Resolution is "how often a Beat is split / 4" - If (AValues[I].Value = 'HEMIDEMISEMIQUAVER') then - SongInfo.Header.Resolution := 64 div 4 - Else If (AValues[I].Value = 'DEMISEMIQUAVER') then - SongInfo.Header.Resolution := 32 div 4 - Else If (AValues[I].Value = 'SEMIQUAVER') then - SongInfo.Header.Resolution := 16 div 4 - Else If (AValues[I].Value = 'QUAVER') then - SongInfo.Header.Resolution := 8 div 4 - Else If (AValues[I].Value = 'CROTCHET') then - SongInfo.Header.Resolution := 4 div 4 - Else - begin //Can't understand teh Resolution :/ - Result := False; - ErrorMessage := 'Can''t read Resolution from Song'; - end; - end - - Else If (AValues[I].Name = 'GENRE') then - begin - SongInfo.Header.Genre := AValues[I].Value; - end - - Else If (AValues[I].Name = 'YEAR') then - begin - SongInfo.Header.Year := AValues[I].Value; - end - - Else If (AValues[I].Name = 'VERSION') then - begin - SingstarVersion := AValues[I].Value; - end; - end; - - ParserState := PS_Melody; //In Melody Tag - end; - end; - - - PS_Melody: begin //Search for Sentence, Artist/Title Info or eo Melody - If (Tag = 'SENTENCE') then - begin - ParserState := PS_Sentence; //Parse in a Sentence Tag now - - //Increase SentenceCount - Inc(SongInfo.CountSentences); - - BindLyrics := True; //Don't let Txts Begin w/ Space - - //Search for Duett Singer Info - MakeValuesArray; - For I := 0 to High(AValues) do - If (AValues[I].Name = 'SINGER') then - begin - AValues[I].Value := Uppercase(AValues[I].Value); - If (AValues[I].Value = 'SOLO 1') then - CurDuettSinger := DS_Player1 - Else If (AValues[I].Value = 'SOLO 2') then - CurDuettSinger := DS_Player2 - Else - CurDuettSinger := DS_Both; //In case of "Group" or anything that is not identified use Both - end; - end - - Else If (Tag = '!--') then - begin //Comment, this may be Artist or Title Info - I := Pos(':', Values); //Search for Delimiter - - If (I <> 0) then //If Found check for Title or Artist - begin - //Copy Title or Artist Tag to Tag String - Tag := Uppercase(Trim(Copy(Values, 1, I - 1))); - - If (Tag = 'ARTIST') then - begin - SongInfo.Header.Artist := Trim(Copy(Values, I + 1, Length(Values) - I - 2)); - Inc(SongInfo.ID); //Inc SongID when header Information is added - end - Else If (Tag = 'TITLE') then - begin - SongInfo.Header.Title := Trim(Copy(Values, I + 1, Length(Values) - I - 2)); - Inc(SongInfo.ID); //Inc SongID when header Information is added - end; - end; - end - - //Parsing for weird "Die toten Hosen" Tags - Else If (Tag = '!--ARTIST:') OR (Tag = '!--ARTIST') then - begin //Comment, with Artist Info - I := Pos(':', Values); //Search for Delimiter - - Inc(SongInfo.ID); //Inc SongID when header Information is added - - SongInfo.Header.Artist := Trim(Copy(Values, I + 1, Length(Values) - I - 2)); - end - - Else If (Tag = '!--TITLE:') OR (Tag = '!--TITLE') then - begin //Comment, with Artist Info - I := Pos(':', Values); //Search for Delimiter - - Inc(SongInfo.ID); //Inc SongID when header Information is added - - SongInfo.Header.Title := Trim(Copy(Values, I + 1, Length(Values) - I - 2)); - end - - Else If (Tag = '/MELODY') then - begin - ParserState := PS_None; - Exit; //Stop Parsing, Melody iTag ended - end - end; - - - PS_Sentence: begin //Search for Notes or eo Sentence - If (Tag = 'NOTE') then - begin //Found Note - //Get Values - MakeValuesArray; - - NoteType := NT_Normal; - For I := 0 to High(AValues) do - begin - If (AValues[I].Name = 'DURATION') then - begin - Duration := StrtoIntDef(AValues[I].Value, -1); - If (Duration < 0) then - begin - Result := False; - ErrorMessage := 'Can''t read duration from Note in Line: "' + Line + '"'; - Exit; - end; - end - Else If (AValues[I].Name = 'MIDINOTE') then - begin - Tone := StrtoIntDef(AValues[I].Value, 0); - end - Else If (AValues[I].Name = 'BONUS') AND (Uppercase(AValues[I].Value) = 'YES') then - begin - NoteType := NT_Golden; - end - Else If (AValues[I].Name = 'FREESTYLE') AND (Uppercase(AValues[I].Value) = 'YES') then - begin - NoteType := NT_Freestyle; - end - Else If (AValues[I].Name = 'LYRIC') then - begin - Lyric := AValues[I].Value; - - If (Length(Lyric) > 0) then - begin - If (Lyric = '-') then - Lyric[1] := Settings.DashReplacement; - - If (not BindLyrics) then - Lyric := ' ' + Lyric; - - - If (Length(Lyric) > 2) AND (Lyric[Length(Lyric)-1] = ' ') AND (Lyric[Length(Lyric)] = '-') then - begin //Between this and the next Lyric should be no space - BindLyrics := True; - SetLength(Lyric, Length(Lyric) - 2); - end - else - BindLyrics := False; //There should be a Space - end; - end; - end; - - //Add Note - I := SongInfo.CountSentences - 1; - - If (Length(Lyric) > 0) then - begin //Real note, no rest - //First Note of Sentence - If (Length(SongInfo.Sentences) < SongInfo.CountSentences) then - begin - SetLength(SongInfo.Sentences, SongInfo.CountSentences); - SetLength(SongInfo.Sentences[I].Notes, 0); - end; - - //First Note of Song -> Generate Gap - If (FirstNote) then - begin - //Calculate Gap - If (SongInfo.Header.Resolution <> 0) AND (SongInfo.Header.BPM <> 0) then - SongInfo.Header.Gap := Round(CurPosinSong / (SongInfo.Header.BPM*SongInfo.Header.Resolution) * 60000) - Else - begin - Result := False; - ErrorMessage := 'Can''t calculate Gap, no Resolution or BPM present.'; - Exit; - end; - - CurPosinSong := 0; //Start at 0, because Gap goes until here - Inc(SongInfo.ID); //Add Header Value therefore Inc - FirstNote := False; - end; - - J := Length(SongInfo.Sentences[I].Notes); - SetLength(SongInfo.Sentences[I].Notes, J + 1); - SongInfo.Sentences[I].Notes[J].Start := CurPosinSong; - SongInfo.Sentences[I].Notes[J].Duration := Duration; - SongInfo.Sentences[I].Notes[J].Tone := Tone; - SongInfo.Sentences[I].Notes[J].NoteTyp := NoteType; - SongInfo.Sentences[I].Notes[J].Lyric := Lyric; - - //Inc Pos in Song - Inc(CurPosInSong, Duration); - end - else - begin - //just change pos in Song - Inc(CurPosInSong, Duration); - end; - - - end - Else If (Tag = '/SENTENCE') then - begin //End of Sentence Tag - ParserState := PS_Melody; - - //Delete Sentence if no Note is Added - If (Length(SongInfo.Sentences) <> SongInfo.CountSentences) then - begin - SongInfo.CountSentences := Length(SongInfo.Sentences); - end; - end; - end; - end; - - end - else //Empty Line -> parsed succesful ;) - Result := true; -end; - -Function TParser.ParseConfigForEdition(const Filename: IPath): String; -var - txt: TStringlist; - Stream: TBinaryFileStream; - I: Integer; - J, K: Integer; - S: String; -begin - Result := ''; - - 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]); - J := Pos('', S); - - If (J <> 0) then - begin - Inc(J, 14); - K := Pos('', S); - If (K