From 0b60f71cb853b35e53d0b407493dbcfc098ed40e Mon Sep 17 00:00:00 2001
From: tobigun <tobigun@b956fd51-792f-4845-bead-9b4dfca2ff2c>
Date: Tue, 19 Oct 2010 16:39:31 +0000
Subject: initial commit
git-svn-id: svn://svn.code.sf.net/p/ultrastardx/svn/branches/experimental@2684 b956fd51-792f-4845-bead-9b4dfca2ff2c
---
mediaplugin/src/base/TextGL.pas | 267 +++
mediaplugin/src/base/UBeatTimer.pas | 299 +++
mediaplugin/src/base/UCatCovers.pas | 211 ++
mediaplugin/src/base/UCommandLine.pas | 345 ++++
mediaplugin/src/base/UCommon.pas | 609 ++++++
mediaplugin/src/base/UConfig.pas | 232 +++
mediaplugin/src/base/UCovers.pas | 459 +++++
mediaplugin/src/base/UDataBase.pas | 720 +++++++
mediaplugin/src/base/UDraw.pas | 1163 +++++++++++
mediaplugin/src/base/UEditorLyrics.pas | 260 +++
mediaplugin/src/base/UFiles.pas | 214 ++
mediaplugin/src/base/UFilesystem.pas | 692 +++++++
mediaplugin/src/base/UFont.pas | 3067 +++++++++++++++++++++++++++++
mediaplugin/src/base/UGraphic.pas | 852 ++++++++
mediaplugin/src/base/UGraphicClasses.pas | 720 +++++++
mediaplugin/src/base/UImage.pas | 1131 +++++++++++
mediaplugin/src/base/UIni.pas | 1232 ++++++++++++
mediaplugin/src/base/UJoystick.pas | 312 +++
mediaplugin/src/base/ULanguage.pas | 302 +++
mediaplugin/src/base/ULog.pas | 441 +++++
mediaplugin/src/base/ULyrics.pas | 726 +++++++
mediaplugin/src/base/UMain.pas | 598 ++++++
mediaplugin/src/base/UMusic.pas | 1235 ++++++++++++
mediaplugin/src/base/UNote.pas | 618 ++++++
mediaplugin/src/base/UParty.pas | 1026 ++++++++++
mediaplugin/src/base/UPath.pas | 1427 ++++++++++++++
mediaplugin/src/base/UPathUtils.pas | 201 ++
mediaplugin/src/base/UPlatform.pas | 136 ++
mediaplugin/src/base/UPlatformLinux.pas | 149 ++
mediaplugin/src/base/UPlatformMacOSX.pas | 302 +++
mediaplugin/src/base/UPlatformWindows.pas | 209 ++
mediaplugin/src/base/UPlaylist.pas | 520 +++++
mediaplugin/src/base/URecord.pas | 904 +++++++++
mediaplugin/src/base/URingBuffer.pas | 165 ++
mediaplugin/src/base/USingNotes.pas | 42 +
mediaplugin/src/base/USingScores.pas | 1122 +++++++++++
mediaplugin/src/base/USkins.pas | 248 +++
mediaplugin/src/base/USong.pas | 1303 ++++++++++++
mediaplugin/src/base/USongs.pas | 845 ++++++++
mediaplugin/src/base/UTextEncoding.pas | 248 +++
mediaplugin/src/base/UTexture.pas | 548 ++++++
mediaplugin/src/base/UThemes.pas | 2501 +++++++++++++++++++++++
mediaplugin/src/base/UTime.pas | 246 +++
mediaplugin/src/base/UUnicodeUtils.pas | 670 +++++++
mediaplugin/src/base/UXMLSong.pas | 623 ++++++
45 files changed, 30140 insertions(+)
create mode 100644 mediaplugin/src/base/TextGL.pas
create mode 100644 mediaplugin/src/base/UBeatTimer.pas
create mode 100644 mediaplugin/src/base/UCatCovers.pas
create mode 100644 mediaplugin/src/base/UCommandLine.pas
create mode 100644 mediaplugin/src/base/UCommon.pas
create mode 100644 mediaplugin/src/base/UConfig.pas
create mode 100644 mediaplugin/src/base/UCovers.pas
create mode 100644 mediaplugin/src/base/UDataBase.pas
create mode 100644 mediaplugin/src/base/UDraw.pas
create mode 100644 mediaplugin/src/base/UEditorLyrics.pas
create mode 100644 mediaplugin/src/base/UFiles.pas
create mode 100644 mediaplugin/src/base/UFilesystem.pas
create mode 100644 mediaplugin/src/base/UFont.pas
create mode 100644 mediaplugin/src/base/UGraphic.pas
create mode 100644 mediaplugin/src/base/UGraphicClasses.pas
create mode 100644 mediaplugin/src/base/UImage.pas
create mode 100644 mediaplugin/src/base/UIni.pas
create mode 100644 mediaplugin/src/base/UJoystick.pas
create mode 100644 mediaplugin/src/base/ULanguage.pas
create mode 100644 mediaplugin/src/base/ULog.pas
create mode 100644 mediaplugin/src/base/ULyrics.pas
create mode 100644 mediaplugin/src/base/UMain.pas
create mode 100644 mediaplugin/src/base/UMusic.pas
create mode 100644 mediaplugin/src/base/UNote.pas
create mode 100644 mediaplugin/src/base/UParty.pas
create mode 100644 mediaplugin/src/base/UPath.pas
create mode 100644 mediaplugin/src/base/UPathUtils.pas
create mode 100644 mediaplugin/src/base/UPlatform.pas
create mode 100644 mediaplugin/src/base/UPlatformLinux.pas
create mode 100644 mediaplugin/src/base/UPlatformMacOSX.pas
create mode 100644 mediaplugin/src/base/UPlatformWindows.pas
create mode 100644 mediaplugin/src/base/UPlaylist.pas
create mode 100644 mediaplugin/src/base/URecord.pas
create mode 100644 mediaplugin/src/base/URingBuffer.pas
create mode 100644 mediaplugin/src/base/USingNotes.pas
create mode 100644 mediaplugin/src/base/USingScores.pas
create mode 100644 mediaplugin/src/base/USkins.pas
create mode 100644 mediaplugin/src/base/USong.pas
create mode 100644 mediaplugin/src/base/USongs.pas
create mode 100644 mediaplugin/src/base/UTextEncoding.pas
create mode 100644 mediaplugin/src/base/UTexture.pas
create mode 100644 mediaplugin/src/base/UThemes.pas
create mode 100644 mediaplugin/src/base/UTime.pas
create mode 100644 mediaplugin/src/base/UUnicodeUtils.pas
create mode 100644 mediaplugin/src/base/UXMLSong.pas
(limited to 'mediaplugin/src/base')
diff --git a/mediaplugin/src/base/TextGL.pas b/mediaplugin/src/base/TextGL.pas
new file mode 100644
index 00000000..feca0974
--- /dev/null
+++ b/mediaplugin/src/base/TextGL.pas
@@ -0,0 +1,267 @@
+{* 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;
+ Outlined: boolean;
+ X, Y, Z: real;
+ end;
+
+const
+ ftNormal = 0;
+ ftBold = 1;
+ ftOutline1 = 2;
+ ftOutline2 = 3;
+
+var
+ Fonts: array of TGLFont;
+ ActFont: integer;
+
+procedure BuildFonts; // builds all fonts
+procedure KillFonts; // deletes all font
+function glTextWidth(const text: UTF8String): real; // returns text width
+procedure glPrint(const text: UTF8String); // custom GL "Print" routine
+procedure ResetFont(); // reset font settings of active font
+procedure SetFontPos(X, Y: real); // sets X and Y
+procedure SetFontZ(Z: real); // sets Z
+procedure SetFontSize(Size: real);
+procedure SetFontStyle(Style: integer); // sets active font style (normal, bold, etc)
+procedure SetFontItalic(Enable: boolean); // sets italic type letter (works for all fonts)
+procedure SetFontReflection(Enable:boolean;Spacing: real); // enables/disables text reflection
+
+implementation
+
+uses
+ UTextEncoding,
+ SysUtils,
+ IniFiles,
+ UCommon,
+ UMain,
+ UPathUtils;
+
+{**
+ * Returns either Filename if it is absolute or a path relative to FontPath.
+ *}
+function FindFontFile(const Filename: string): IPath;
+begin
+ Result := FontPath.Append(Filename);
+ // if path does not exist, try as an absolute path
+ if (not Result.IsFile) then
+ Result := Path(Filename);
+end;
+
+procedure AddFontFallbacks(FontIni: TMemIniFile; Font: TFont);
+var
+ FallbackFont: IPath;
+ IdentName: string;
+ I: Integer;
+begin
+ // evaluate the ini-file's 'Fallbacks' section
+ for I := 1 to 10 do
+ begin
+ IdentName := 'File' + IntToStr(I);
+ FallbackFont := FindFontFile(FontIni.ReadString('Fallbacks', IdentName, ''));
+ if (FallbackFont.Equals(PATH_NONE)) then
+ Continue;
+ try
+ Font.AddFallback(FallbackFont);
+ except
+ on E: EFontError do
+ Log.LogError('Setting font fallback ''' + FallbackFont.ToNative() + ''' failed: ' + E.Message);
+ end;
+ end;
+end;
+
+const
+ FONT_NAMES: array [0..3] of string = (
+ 'Normal', 'Bold', 'Outline1', 'Outline2'
+ );
+
+procedure BuildFonts;
+var
+ I: integer;
+ FontIni: TMemIniFile;
+ FontFile: IPath;
+ Outline: single;
+ Embolden: single;
+ OutlineFont: TFTScalableOutlineFont;
+ SectionName: string;
+begin
+ ActFont := 0;
+
+ SetLength(Fonts, Length(FONT_NAMES));
+
+ FontIni := TMemIniFile.Create(FontPath.Append('fonts.ini').ToNative);
+
+ try
+ for I := 0 to High(FONT_NAMES) do
+ begin
+ SectionName := 'Font_'+FONT_NAMES[I];
+
+ FontFile := FindFontFile(FontIni.ReadString(SectionName , 'File', ''));
+
+ // create either outlined or normal font
+ Outline := FontIni.ReadFloat(SectionName, 'Outline', 0.0);
+ if (Outline > 0.0) then
+ begin
+ // outlined font
+ OutlineFont := TFTScalableOutlineFont.Create(FontFile, 64, Outline, True, True);
+ OutlineFont.SetOutlineColor(
+ FontIni.ReadFloat(SectionName, 'OutlineColorR', 0.0),
+ FontIni.ReadFloat(SectionName, 'OutlineColorG', 0.0),
+ FontIni.ReadFloat(SectionName, 'OutlineColorB', 0.0),
+ FontIni.ReadFloat(SectionName, 'OutlineColorA', -1.0)
+ );
+ Fonts[I].Font := OutlineFont;
+ Fonts[I].Outlined := true;
+ end
+ else
+ begin
+ // normal font
+ Embolden := FontIni.ReadFloat(SectionName, 'Embolden', 0.0);
+ Fonts[I].Font := TFTScalableFont.Create(FontFile, 64, Embolden, True, True);
+ Fonts[I].Outlined := false;
+ end;
+
+ Fonts[I].Font.GlyphSpacing := FontIni.ReadFloat(SectionName, 'GlyphSpacing', 0.0);
+ Fonts[I].Font.Stretch := FontIni.ReadFloat(SectionName, 'Stretch', 1.0);
+
+ AddFontFallbacks(FontIni, Fonts[I].Font);
+ end;
+ except
+ on E: EFontError do
+ Log.LogCritical(E.Message, 'BuildFont');
+ end;
+
+ // close ini-file
+ FontIni.Free;
+end;
+
+
+// Deletes the font
+procedure KillFonts;
+var
+ I: integer;
+begin
+ for I := 0 to High(Fonts) do
+ Fonts[I].Font.Free;
+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/mediaplugin/src/base/UBeatTimer.pas b/mediaplugin/src/base/UBeatTimer.pas
new file mode 100644
index 00000000..bc03de76
--- /dev/null
+++ b/mediaplugin/src/base/UBeatTimer.pas
@@ -0,0 +1,299 @@
+{* UltraStar Deluxe - Karaoke Game
+ *
+ * UltraStar Deluxe is the legal property of its developers, whose names
+ * are too numerous to list here. Please refer to the COPYRIGHT
+ * file distributed with this source distribution.
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; see the file COPYING. If not, write to
+ * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+ * Boston, MA 02110-1301, USA.
+ *
+ * $URL$
+ * $Id$
+ *}
+
+unit UBeatTimer;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+uses
+ UTime;
+
+type
+ (**
+ * TLyricsState contains all information concerning the
+ * state of the lyrics, e.g. the current beat or duration of the lyrics.
+ *)
+ TLyricsState = class
+ private
+ fTimer: TRelativeTimer; // keeps track of the current time
+ fSyncSource: TSyncSource;
+ fAvgSyncDiff: real;
+ fLastClock: real; // last master clock value
+ // Note: do not use Timer.GetState() to check if lyrics are paused as
+ // Timer.Pause() is used for synching.
+ fPaused: boolean;
+
+ function Synchronize(LyricTime: real): real;
+ public
+ OldBeat: integer; // previous discovered beat
+ CurrentBeat: integer; // current beat (rounded)
+ MidBeat: real; // current beat (float)
+
+ // now we use this for super synchronization!
+ // only used when analyzing voice
+ // TODO: change ...D to ...Detect(ed)
+ OldBeatD: integer; // previous discovered beat
+ CurrentBeatD: integer; // current discovered beat (rounded)
+ MidBeatD: real; // current discovered beat (float)
+
+ // we use this for audible clicks
+ // TODO: Change ...C to ...Click
+ OldBeatC: integer; // previous discovered beat
+ CurrentBeatC: integer;
+ MidBeatC: real; // like CurrentBeatC
+
+ OldLine: integer; // previous displayed sentence
+
+ StartTime: real; // time till start of lyrics (= Gap)
+ TotalTime: real; // total song time
+
+ constructor Create();
+
+ {**
+ * Resets the LyricsState state.
+ *}
+ procedure Reset();
+
+ procedure UpdateBeats();
+
+ {**
+ * Sets a master clock for this LyricsState. If no sync-source is set
+ * or SyncSource is nil the internal timer is used.
+ *}
+ procedure SetSyncSource(SyncSource: TSyncSource);
+
+ {**
+ * Starts the timer. This is either done
+ * - immediately if WaitForTrigger is false or
+ * - after the first call to GetCurrentTime()/SetCurrentTime() or Start(false)
+ *}
+ procedure Start(WaitForTrigger: boolean = false);
+
+ {**
+ * Pauses the timer.
+ * The counter is preserved and can be resumed by a call to Start().
+ *}
+ procedure Pause();
+
+ {**
+ * Stops the timer.
+ * The counter is reset to 0.
+ *}
+ procedure Stop();
+
+ (**
+ * Returns/Sets the current song time (in seconds) used as base-timer for lyrics etc.
+ * If GetCurrentTime()/SetCurrentTime() if Start() was called
+ *)
+ function GetCurrentTime(): real;
+ procedure SetCurrentTime(Time: real);
+ end;
+
+implementation
+
+uses
+ UNote,
+ ULog,
+ SysUtils,
+ Math;
+
+
+constructor TLyricsState.Create();
+begin
+ // create a triggered timer, so we can Pause() it, set the time
+ // and Resume() it afterwards for better synching.
+ fTimer := TRelativeTimer.Create();
+
+ // reset state
+ Reset();
+end;
+
+procedure TLyricsState.Pause();
+begin
+ fTimer.Pause();
+ fPaused := true;
+end;
+
+procedure TLyricsState.Start(WaitForTrigger: boolean);
+begin
+ fTimer.Start(WaitForTrigger);
+ fPaused := false;
+ fLastClock := -1;
+ fAvgSyncDiff := -1;
+end;
+
+procedure TLyricsState.Stop();
+begin
+ fTimer.Stop();
+ fPaused := false;
+end;
+
+procedure TLyricsState.SetCurrentTime(Time: real);
+begin
+ fTimer.SetTime(Time);
+ fLastClock := -1;
+ fAvgSyncDiff := -1;
+end;
+
+{.$DEFINE LOG_SYNC}
+
+function TLyricsState.Synchronize(LyricTime: real): real;
+var
+ MasterClock: real;
+ TimeDiff: real;
+const
+ AVG_HISTORY_FACTOR = 0.7;
+ PAUSE_THRESHOLD = 0.010; // 10ms
+ FORWARD_THRESHOLD = 0.010; // 10ms
+begin
+ MasterClock := fSyncSource.GetClock();
+ Result := LyricTime;
+
+ // do not sync if lyrics are paused externally or if the timestamp is old
+ if (fPaused or (MasterClock = fLastClock)) then
+ Exit;
+
+ // calculate average time difference (some sort of weighted mean).
+ // The bigger AVG_HISTORY_FACTOR is, the smoother is the average diff.
+ // This is done as some timestamps might be wrong or even lower
+ // than their predecessor.
+ TimeDiff := MasterClock - LyricTime;
+ if (fAvgSyncDiff = -1) then
+ fAvgSyncDiff := TimeDiff
+ else
+ fAvgSyncDiff := TimeDiff * (1-AVG_HISTORY_FACTOR) +
+ fAvgSyncDiff * AVG_HISTORY_FACTOR;
+
+ {$IFDEF LOG_SYNC}
+ //Log.LogError(Format('TimeDiff: %.3f', [TimeDiff]));
+ {$ENDIF}
+
+ // do not go backwards in time as this could mess up the score
+ if (fAvgSyncDiff > FORWARD_THRESHOLD) then
+ begin
+ {$IFDEF LOG_SYNC}
+ Log.LogError('Sync: ' + floatToStr(MasterClock) + ' > ' + floatToStr(LyricTime));
+ {$ENDIF}
+
+ Result := LyricTime + fAvgSyncDiff;
+ fTimer.SetTime(Result);
+ fTimer.Start();
+ fAvgSyncDiff := -1;
+ end
+ else if (fAvgSyncDiff < -PAUSE_THRESHOLD) then
+ begin
+ // wait until timer and master clock are in sync (> 10ms)
+ fTimer.Pause();
+
+ {$IFDEF LOG_SYNC}
+ Log.LogError('Pause: ' + floatToStr(MasterClock) + ' < ' + floatToStr(LyricTime));
+ {$ENDIF}
+ end
+ else if (fTimer.GetState = rtsPaused) and (fAvgSyncDiff >= 0) then
+ begin
+ fTimer.Start();
+
+ {$IFDEF LOG_SYNC}
+ Log.LogError('Unpause: ' + floatToStr(LyricTime));
+ {$ENDIF}
+ end;
+ fLastClock := MasterClock;
+end;
+
+function TLyricsState.GetCurrentTime(): real;
+var
+ LyricTime: real;
+begin
+ LyricTime := fTimer.GetTime();
+ if Assigned(fSyncSource) then
+ Result := Synchronize(LyricTime)
+ else
+ Result := LyricTime;
+end;
+
+procedure TLyricsState.SetSyncSource(SyncSource: TSyncSource);
+begin
+ fSyncSource := SyncSource;
+end;
+
+(**
+ * Resets the timer and state of the lyrics.
+ * The timer will be stopped afterwards so you have to call Resume()
+ * to start the lyrics timer.
+ *)
+procedure TLyricsState.Reset();
+begin
+ Stop();
+ fPaused := false;
+
+ fSyncSource := nil;
+
+ StartTime := 0;
+ TotalTime := 0;
+
+ OldBeat := -1;
+ MidBeat := -1;
+ CurrentBeat := -1;
+
+ OldBeatC := -1;
+ MidBeatC := -1;
+ CurrentBeatC := -1;
+
+ OldBeatD := -1;
+ MidBeatD := -1;
+ CurrentBeatD := -1;
+end;
+
+(**
+ * Updates the beat information (CurrentBeat/MidBeat/...) according to the
+ * current lyric time.
+ *)
+procedure TLyricsState.UpdateBeats();
+var
+ CurLyricsTime: real;
+begin
+ CurLyricsTime := GetCurrentTime();
+
+ OldBeat := CurrentBeat;
+ MidBeat := GetMidBeat(CurLyricsTime - StartTime / 1000);
+ CurrentBeat := Floor(MidBeat);
+
+ OldBeatC := CurrentBeatC;
+ MidBeatC := GetMidBeat(CurLyricsTime - StartTime / 1000);
+ CurrentBeatC := Floor(MidBeatC);
+
+ OldBeatD := CurrentBeatD;
+ // MidBeatD = MidBeat with additional GAP
+ MidBeatD := -0.5 + GetMidBeat(CurLyricsTime - (StartTime + 120 + 20) / 1000);
+ CurrentBeatD := Floor(MidBeatD);
+end;
+
+end.
\ No newline at end of file
diff --git a/mediaplugin/src/base/UCatCovers.pas b/mediaplugin/src/base/UCatCovers.pas
new file mode 100644
index 00000000..85cb850f
--- /dev/null
+++ b/mediaplugin/src/base/UCatCovers.pas
@@ -0,0 +1,211 @@
+{* 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;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+uses
+ UIni,
+ UPath;
+
+type
+ TCatCovers = class
+ protected
+ cNames: array [TSortingType] of array of UTF8String;
+ cFiles: array [TSortingType] of array of IPath;
+ public
+ constructor Create;
+ procedure Load; //Load Cover aus Cover.ini and Cover Folder
+ procedure LoadPath(const CoversPath: IPath);
+ procedure Add(Sorting: TSortingType; const Name: UTF8String; const Filename: IPath); //Add a Cover
+ function CoverExists(Sorting: TSortingType; const Name: UTF8String): boolean; //Returns True when a cover with the given Name exists
+ function GetCover(Sorting: TSortingType; const Name: UTF8String): IPath; //Returns the Filename of a Cover
+ end;
+
+var
+ 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: Integer;
+ SortType: TSortingType;
+ 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 SortType := Low(TSortingType) to High(TSortingType) do
+ begin
+ Ini.ReadSection(ISorting[Ord(SortType)], List);
+
+ for I := 0 to List.Count - 1 do
+ begin
+ CatCover := Path(Ini.ReadString(ISorting[Ord(SortType)], List.Strings[I], 'NoCover.jpg'));
+ Add(SortType, List.Strings[I], CoversPath.Append(CatCover));
+ end;
+ end;
+ finally
+ Ini.Free;
+ List.Free;
+ end;
+
+ //Add Covers from Folder
+ Iter := FileSystem.FileFind(CoversPath.Append('*.jpg'), 0);
+ while Iter.HasNext do
+ begin
+ FileInfo := Iter.Next;
+
+ //Add Cover if it doesn't exist for every Section
+ Filename := CoversPath.Append(FileInfo.Name);
+ Name := FileInfo.Name.SetExtension('').ToUTF8;
+
+ for SortType := Low(TSortingType) to High(TSortingType) do
+ begin
+ TmpName := Name;
+ if (SortType = sTitle) and (UTF8Pos('Title', TmpName) <> 0) then
+ UTF8Delete(TmpName, UTF8Pos('Title', TmpName), 5)
+ else if (SortType = sArtist) and (UTF8Pos('Artist', TmpName) <> 0) then
+ UTF8Delete(TmpName, UTF8Pos('Artist', TmpName), 6);
+
+ if not CoverExists(SortType, TmpName) then
+ Add(SortType, TmpName, Filename);
+ end;
+ end;
+end;
+
+ //Add a Cover
+procedure TCatCovers.Add(Sorting: TSortingType; 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: TSortingType; 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: TSortingType; 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.
\ No newline at end of file
diff --git a/mediaplugin/src/base/UCommandLine.pas b/mediaplugin/src/base/UCommandLine.pas
new file mode 100644
index 00000000..ac0db2c2
--- /dev/null
+++ b/mediaplugin/src/base/UCommandLine.pas
@@ -0,0 +1,345 @@
+{* 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/mediaplugin/src/base/UCommon.pas b/mediaplugin/src/base/UCommon.pas
new file mode 100644
index 00000000..18022337
--- /dev/null
+++ b/mediaplugin/src/base/UCommon.pas
@@ -0,0 +1,609 @@
+{* 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;
+ TUTF8StringDynArray = array of UTF8String;
+
+const
+ SepWhitespace = [#9, #10, #13, ' ']; // tab, lf, cr, space
+
+{**
+ * Splits a string into pieces separated by Separators.
+ * MaxCount specifies the max. number of pieces. If it is <= 0 the number is
+ * not limited. If > 0 the last array element will hold the rest of the string
+ * (with leading separators removed).
+ *
+ * Examples:
+ * SplitString(' split me now ', 0) -> ['split', 'me', 'now']
+ * SplitString(' split me now ', 1) -> ['split', 'me now']
+ *}
+function SplitString(const Str: string; MaxCount: integer = 0; Separators: TSysCharSet = SepWhitespace): TStringDynArray;
+
+
+type
+ TMessageType = (mtInfo, mtError);
+
+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);
+
+function GetArrayIndex(const SearchArray: array of UTF8String; Value: string; CaseInsensitiv: boolean = false): integer;
+
+
+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;
+
+(**
+ * Returns the index of Value in SearchArray
+ * or -1 if Value is not in SearchArray.
+ *)
+function GetArrayIndex(const SearchArray: array of UTF8String; Value: string;
+ CaseInsensitiv: boolean = false): integer;
+var
+ i: integer;
+begin
+ Result := -1;
+
+ for i := 0 to High(SearchArray) do
+ begin
+ if (SearchArray[i] = Value) or
+ (CaseInsensitiv and (CompareText(SearchArray[i], Value) = 0)) then
+ begin
+ Result := i;
+ Break;
+ end;
+ end;
+end;
+
+
+type
+ // stores the unaligned pointer of data allocated by GetAlignedMem()
+ 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/mediaplugin/src/base/UConfig.pas b/mediaplugin/src/base/UConfig.pas
new file mode 100644
index 00000000..e48b5493
--- /dev/null
+++ b/mediaplugin/src/base/UConfig.pas
@@ -0,0 +1,232 @@
+{* 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 = '';
+ 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/mediaplugin/src/base/UCovers.pas b/mediaplugin/src/base/UCovers.pas
new file mode 100644
index 00000000..6c7c9e48
--- /dev/null
+++ b/mediaplugin/src/base/UCovers.pas
@@ -0,0 +1,459 @@
+{* 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/mediaplugin/src/base/UDataBase.pas b/mediaplugin/src/base/UDataBase.pas
new file mode 100644
index 00000000..5cb15182
--- /dev/null
+++ b/mediaplugin/src/base/UDataBase.pas
@@ -0,0 +1,720 @@
+{* 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,
+ UTextEncoding;
+
+//--------------------
+//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 ConvertFrom101To110();
+ 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' +
+ ');');
+
+ //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;
+
+ // add column rating to cUS_Songs
+ // just for users of nightly builds and developers!
+ if not ScoreDB.ContainsColumn(cUS_Songs, 'Rating') then
+ begin
+ Log.LogInfo('Outdated song database found - adding column rating to "' + cUS_Songs + '"', 'TDataBaseSystem.Init');
+ ScoreDB.ExecSQL('ALTER TABLE ' + cUS_Songs + ' ADD COLUMN [Rating] INTEGER NULL');
+ end;
+
+ // convert data from previous versions
+ // part #2 - accomplishment
+ if finalizeConversion then
+ begin
+ //convert data from 1.01 to 1.1
+ if ScoreDB.TableExists('us_scores_101') then
+ ConvertFrom101To110();
+ end;
+
+ except
+ on E: Exception do
+ begin
+ Log.LogError(E.Message, 'TDataBaseSystem.Init');
+ FreeAndNil(ScoreDB);
+ end;
+ end;
+
+end;
+
+(**
+ * Convert Database from 1.01 to 1.1
+ *)
+procedure TDataBaseSystem.ConvertFrom101To110();
+var
+ TableData: TSQLiteUniTable;
+ tempUTF8String: UTF8String;
+begin
+ if not ScoreDB.ContainsColumn('us_scores_101', 'Date') then
+ begin
+ Log.LogInfo(
+ 'Outdated song database found - ' +
+ 'begin conversion from V1.01 to V1.1', 'TDataBaseSystem.Convert101To110');
+
+ // insert old values into new db-schemes (/tables)
+ ScoreDB.ExecSQL(
+ 'INSERT INTO ' + cUS_Scores +
+ ' SELECT SongID, Difficulty, Player, Score, ''NULL'' FROM us_scores_101;');
+ end else
+ begin
+ Log.LogInfo(
+ 'Outdated song database found - ' +
+ 'begin conversion from V1.01 Challenge Mod to V1.1', 'TDataBaseSystem.Convert101To110');
+
+ // insert old values into new db-schemes (/tables)
+ ScoreDB.ExecSQL(
+ 'INSERT INTO ' + cUS_Scores +
+ ' SELECT SongID, Difficulty, Player, Score, Date FROM us_scores_101;');
+ end;
+
+ ScoreDB.ExecSQL(
+ 'INSERT INTO ' + cUS_Songs +
+ ' SELECT ID, Artist, Title, TimesPlayed, ''NULL'' FROM us_songs_101;');
+
+ // now we have to convert all the texts for unicode support:
+
+ // player names
+ TableData := nil;
+ try
+ TableData := ScoreDB.GetUniTable(
+ 'SELECT [rowid], [Player] ' +
+ 'FROM [' + cUS_Scores + '];');
+
+ // Go through all Entrys
+ while (not TableData.EOF) do
+ begin
+ // Convert name into UTF8 and alter all entrys
+ DecodeStringUTF8(TableData.FieldByName['Player'], tempUTF8String, encCP1252);
+ ScoreDB.ExecSQL(
+ 'UPDATE [' + cUS_Scores + '] ' +
+ 'SET [Player] = ? ' +
+ 'WHERE [rowid] = ? ',
+ [tempUTF8String,
+ TableData.FieldAsInteger(TableData.FieldIndex['rowid'])]);
+
+ TableData.Next;
+ end; // while
+
+ except
+ on E: Exception do
+ Log.LogError(E.Message, 'TDataBaseSystem.Convert101To110');
+ end;
+
+ TableData.Free;
+
+ // song artist and song title
+ TableData := nil;
+ try
+ TableData := ScoreDB.GetUniTable(
+ 'SELECT [ID], [Artist], [Title] ' +
+ 'FROM [' + cUS_Songs + '];');
+
+ // Go through all Entrys
+ while (not TableData.EOF) do
+ begin
+ // Convert Artist into UTF8 and alter all entrys
+ DecodeStringUTF8(TableData.FieldByName['Artist'], tempUTF8String, encCP1252);
+ //Log.LogError(TableData.FieldByName['Artist']+' -> '+tempUTF8String+' (encCP1252)');
+ ScoreDB.ExecSQL(
+ 'UPDATE [' + cUS_Songs + '] ' +
+ 'SET [Artist] = ? ' +
+ 'WHERE [ID] = ?',
+ [tempUTF8String,
+ TableData.FieldAsInteger(TableData.FieldIndex['ID'])]);
+
+ // Convert Title into UTF8 and alter all entrys
+ DecodeStringUTF8(TableData.FieldByName['Title'], tempUTF8String, encCP1252);
+ ScoreDB.ExecSQL(
+ 'UPDATE [' + cUS_Songs + '] ' +
+ 'SET [Title] = ? ' +
+ 'WHERE [ID] = ? ',
+ [tempUTF8String,
+ TableData.FieldAsInteger(TableData.FieldIndex['ID'])]);
+
+ TableData.Next;
+ end; // while
+
+ except
+ on E: Exception do
+ Log.LogError(E.Message, 'TDataBaseSystem.Convert101To110');
+ end;
+
+ TableData.Free;
+
+ //now drop old tables
+ ScoreDB.ExecSQL('DROP TABLE us_scores_101;');
+ ScoreDB.ExecSQL('DROP TABLE us_songs_101;');
+end;
+
+(**
+ * Frees Database
+ *)
+destructor TDataBaseSystem.Destroy;
+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/mediaplugin/src/base/UDraw.pas b/mediaplugin/src/base/UDraw.pas
new file mode 100644
index 00000000..5bec3eab
--- /dev/null
+++ b/mediaplugin/src/base/UDraw.pas
@@ -0,0 +1,1163 @@
+{* 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,
+ UGraphicClasses;
+
+procedure SingDraw;
+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,
+ UDrawTexture,
+ UGraphic,
+ UIni,
+ ULog,
+ ULyrics,
+ UNote,
+ UMusic,
+ URecord,
+ UScreenSing,
+ 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
+ if (ScreenSing.settings.NotesVisible and (1 shl NrLines) <> 0) then
+ begin
+
+ 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;
+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 (ScreenSing.settings.NotesVisible and (1 shl PlayerIndex) <> 0) then
+ begin
+ glColor4f(1, 1, 1, sqrt((1+sin( AudioPlayback.Position * 3))/4)/ 2 + 0.5 );
+ glEnable(GL_TEXTURE_2D);
+ 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
+
+ // to-do : needs fix when party mode works w/ 2 screens
+ if (PlayersPlay = 1) and (Ini.NoteLines = 1) and (ScreenSing.settings.NotesVisible and (1) <> 0) then
+ SingDrawNoteLines(NR.Left + 10*ScreenX, Skin_P2_NotesB - 105, NR.Right + 10*ScreenX, 15);
+
+ if ((PlayersPlay = 2) or (PlayersPlay = 4)) and (Ini.NoteLines = 1) then
+ begin
+ if (ScreenSing.settings.NotesVisible and (1 shl 0) <> 0) then
+ SingDrawNoteLines(Nr.Left + 10*ScreenX, Skin_P1_NotesB - 105, Nr.Right + 10*ScreenX, 15);
+ if (ScreenSing.settings.NotesVisible and (1 shl 1) <> 0) then
+ SingDrawNoteLines(Nr.Left + 10*ScreenX, Skin_P2_NotesB - 105, Nr.Right + 10*ScreenX, 15);
+ end;
+
+ if ((PlayersPlay = 3) or (PlayersPlay = 6)) and (Ini.NoteLines = 1) then begin
+ if (ScreenSing.settings.NotesVisible and (1 shl 0) <> 0) then
+ SingDrawNoteLines(Nr.Left + 10*ScreenX, 120, Nr.Right + 10*ScreenX, 12);
+ if (ScreenSing.settings.NotesVisible and (1 shl 1) <> 0) then
+ SingDrawNoteLines(Nr.Left + 10*ScreenX, 245, Nr.Right + 10*ScreenX, 12);
+ if (ScreenSing.settings.NotesVisible and (1 shl 2) <> 0) then
+ SingDrawNoteLines(Nr.Left + 10*ScreenX, 370, Nr.Right + 10*ScreenX, 12);
+ end;
+
+ // draw Lyrics
+ 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;
+
+{//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;
+ // avoid that the bar "overflows" for inaccurate song lengths
+ if (LyricsProgress > 1.0) then
+ LyricsProgress := 1.0;
+ 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/mediaplugin/src/base/UEditorLyrics.pas b/mediaplugin/src/base/UEditorLyrics.pas
new file mode 100644
index 00000000..5030eff5
--- /dev/null
+++ b/mediaplugin/src/base/UEditorLyrics.pas
@@ -0,0 +1,260 @@
+{* 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);
+ SetFontItalic(Italic);
+ 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/mediaplugin/src/base/UFiles.pas b/mediaplugin/src/base/UFiles.pas
new file mode 100644
index 00000000..1a7ca8f8
--- /dev/null
+++ b/mediaplugin/src/base/UFiles.pas
@@ -0,0 +1,214 @@
+{* 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);
+
+ // do not save "auto" encoding tag
+ if (Song.Encoding <> encAuto) then
+ 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/mediaplugin/src/base/UFilesystem.pas b/mediaplugin/src/base/UFilesystem.pas
new file mode 100644
index 00000000..805bcfe5
--- /dev/null
+++ b/mediaplugin/src/base/UFilesystem.pas
@@ -0,0 +1,692 @@
+{* UltraStar Deluxe - Karaoke Game
+ *
+ * UltraStar Deluxe is the legal property of its developers, whose names
+ * are too numerous to list here. Please refer to the COPYRIGHT
+ * file distributed with this source distribution.
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; see the file COPYING. If not, write to
+ * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+ * Boston, MA 02110-1301, USA.
+ *
+ * $URL$
+ * $Id$
+ *}
+
+unit UFilesystem;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+uses
+ SysUtils,
+ Classes,
+ {$IFDEF MSWINDOWS}
+ Windows,
+ TntSysUtils,
+ {$ENDIF}
+ UPath;
+
+type
+ {$IFDEF MSWINDOWS}
+ TSytemSearchRec = TSearchRecW;
+ {$ELSE}
+ TSytemSearchRec = TSearchRec;
+ {$ENDIF}
+
+ TFileInfo = record
+ Time: integer; // timestamp
+ Size: int64; // file size (byte)
+ Attr: integer; // file attributes
+ Name: IPath; // basename with extension
+ end;
+
+ {**
+ * Iterates through the search results retrieved by FileFind().
+ * Example usage:
+ * while(Iter.HasNext()) do
+ * SearchRec := Iter.Next();
+ *}
+ IFileIterator = interface
+ function HasNext(): boolean;
+ function Next(): TFileInfo;
+ end;
+
+ {**
+ * Wrapper for SysUtils file functions.
+ * For documentation and examples, check the SysUtils equivalent.
+ *}
+ IFileSystem = interface
+ function ExpandFileName(const FileName: IPath): IPath;
+ function FileCreate(const FileName: IPath): TFileHandle;
+ function DirectoryCreate(const Dir: IPath): boolean;
+ function FileOpen(const FileName: IPath; Mode: longword): TFileHandle;
+ function FileAge(const FileName: IPath): integer; overload;
+ function FileAge(const FileName: IPath; out FileDateTime: TDateTime): boolean; overload;
+
+ function DirectoryExists(const Name: IPath): boolean;
+
+ {**
+ * On Windows: returns true only for files (not directories)
+ * On Apple/Unix: returns true for all kind of files (even directories)
+ * @seealso SysUtils.FileExists()
+ *}
+ function FileExists(const Name: IPath): boolean;
+
+ function FileGetAttr(const FileName: IPath): Cardinal;
+ function FileSetAttr(const FileName: IPath; Attr: integer): boolean;
+ function FileIsReadOnly(const FileName: IPath): boolean;
+ function FileSetReadOnly(const FileName: IPath; ReadOnly: boolean): boolean;
+ function FileIsAbsolute(const FileName: IPath): boolean;
+ function ForceDirectories(const Dir: IPath): boolean;
+ function RenameFile(const OldName, NewName: IPath): boolean;
+ function DeleteFile(const FileName: IPath): boolean;
+ function RemoveDir(const Dir: IPath): boolean;
+
+ {**
+ * Copies file Source to Target. If FailIfExists is true, the file is not
+ * copied if it already exists.
+ * Returns true if the file was successfully copied.
+ *}
+ function CopyFile(const Source, Target: IPath; FailIfExists: boolean): boolean;
+
+ function ExtractFileDrive(const FileName: IPath): IPath;
+ function ExtractFilePath(const FileName: IPath): IPath;
+ function ExtractFileDir(const FileName: IPath): IPath;
+ function ExtractFileName(const FileName: IPath): IPath;
+ function ExtractFileExt(const FileName: IPath): IPath;
+ function ExtractRelativePath(const BaseName: IPath; const FileName: IPath): IPath;
+
+ function ChangeFileExt(const FileName: IPath; const Extension: IPath): IPath;
+
+ function IncludeTrailingPathDelimiter(const FileName: IPath): IPath;
+ function ExcludeTrailingPathDelimiter(const FileName: IPath): IPath;
+
+ {**
+ * Searches for a file with filename Name in the directories given in DirList.
+ *}
+ function FileSearch(const Name: IPath; DirList: array of IPath): IPath;
+
+ {**
+ * More convenient version of FindFirst/Next/Close with iterator support.
+ *}
+ function FileFind(const FilePattern: IPath; Attr: integer): IFileIterator;
+
+ {**
+ * Old style search functions. Use FileFind() instead.
+ *}
+ function FindFirst(const FilePattern: IPath; Attr: integer; var F: TSytemSearchRec): integer;
+ function FindNext(var F: TSytemSearchRec): integer;
+ procedure FindClose(var F: TSytemSearchRec);
+
+ function GetCurrentDir: IPath;
+ function SetCurrentDir(const Dir: IPath): boolean;
+
+ {**
+ * Returns true if the filesystem is case-sensitive.
+ *}
+ function IsCaseSensitive(): boolean;
+ end;
+
+ function FileSystem(): IFileSystem;
+
+implementation
+
+type
+ TFileSystemImpl = class(TInterfacedObject, IFileSystem)
+ public
+ function ExpandFileName(const FileName: IPath): IPath;
+ function FileCreate(const FileName: IPath): TFileHandle;
+ function DirectoryCreate(const Dir: IPath): boolean;
+ function FileOpen(const FileName: IPath; Mode: longword): TFileHandle;
+ function FileAge(const FileName: IPath): integer; overload;
+ function FileAge(const FileName: IPath; out FileDateTime: TDateTime): boolean; overload;
+ function DirectoryExists(const Name: IPath): boolean;
+ function FileExists(const Name: IPath): boolean;
+ function FileGetAttr(const FileName: IPath): Cardinal;
+ function FileSetAttr(const FileName: IPath; Attr: integer): boolean;
+ function FileIsReadOnly(const FileName: IPath): boolean;
+ function FileSetReadOnly(const FileName: IPath; ReadOnly: boolean): boolean;
+ function FileIsAbsolute(const FileName: IPath): boolean;
+ function ForceDirectories(const Dir: IPath): boolean;
+ function RenameFile(const OldName, NewName: IPath): boolean;
+ function DeleteFile(const FileName: IPath): boolean;
+ function RemoveDir(const Dir: IPath): boolean;
+ function CopyFile(const Source, Target: IPath; FailIfExists: boolean): boolean;
+
+ function ExtractFileDrive(const FileName: IPath): IPath;
+ function ExtractFilePath(const FileName: IPath): IPath;
+ function ExtractFileDir(const FileName: IPath): IPath;
+ function ExtractFileName(const FileName: IPath): IPath;
+ function ExtractFileExt(const FileName: IPath): IPath;
+ function ExtractRelativePath(const BaseName: IPath; const FileName: IPath): IPath;
+ function ChangeFileExt(const FileName: IPath; const Extension: IPath): IPath;
+ function IncludeTrailingPathDelimiter(const FileName: IPath): IPath;
+ function ExcludeTrailingPathDelimiter(const FileName: IPath): IPath;
+
+ function FileSearch(const Name: IPath; DirList: array of IPath): IPath;
+ function FileFind(const FilePattern: IPath; Attr: integer): IFileIterator;
+
+ function FindFirst(const FilePattern: IPath; Attr: integer; var F: TSytemSearchRec): integer;
+ function FindNext(var F: TSytemSearchRec): integer;
+ procedure FindClose(var F: TSytemSearchRec);
+
+ function GetCurrentDir: IPath;
+ function SetCurrentDir(const Dir: IPath): boolean;
+
+ function IsCaseSensitive(): boolean;
+ end;
+
+ TFileIterator = class(TInterfacedObject, IFileIterator)
+ private
+ fHasNext: boolean;
+ fSearchRec: TSytemSearchRec;
+ public
+ constructor Create(const FilePattern: IPath; Attr: integer);
+ destructor Destroy(); override;
+
+ function HasNext(): boolean;
+ function Next(): TFileInfo;
+ end;
+
+
+var
+ FileSystem_Singleton: IFileSystem;
+
+function FileSystem(): IFileSystem;
+begin
+ Result := FileSystem_Singleton;
+end;
+
+function TFileSystemImpl.FileFind(const FilePattern: IPath; Attr: integer): IFileIterator;
+begin
+ Result := TFileIterator.Create(FilePattern, Attr);
+end;
+
+function TFileSystemImpl.IsCaseSensitive(): boolean;
+begin
+ // Windows and Mac OS X do not have case sensitive file systems
+ {$IF Defined(MSWINDOWS) or Defined(DARWIN)}
+ Result := false;
+ {$ELSE}
+ Result := true;
+ {$IFEND}
+end;
+
+function TFileSystemImpl.FileIsAbsolute(const FileName: IPath): boolean;
+var
+ NameStr: UTF8String;
+begin
+ Result := true;
+ NameStr := FileName.ToUTF8();
+
+ {$IFDEF MSWINDOWS}
+ // check if drive is given 'C:...'
+ if (FileName.GetDrive().ToUTF8 <> '') then
+ Exit;
+ // check if path starts with '\\'
+ if (Length(NameStr) >= 2) and
+ (NameStr[1] = PathDelim) and (NameStr[2] = PathDelim) then
+ Exit;
+ {$ELSE} // Unix based systems
+ // check if root dir given '/...'
+ if (Length(NameStr) >= 1) and (NameStr[1] = PathDelim) then
+ Exit;
+ {$ENDIF}
+
+ Result := false;
+end;
+
+{$IFDEF MSWINDOWS}
+
+function TFileSystemImpl.ExpandFileName(const FileName: IPath): IPath;
+begin
+ Result := Path(WideExpandFileName(FileName.ToWide()));
+end;
+
+function TFileSystemImpl.FileCreate(const FileName: IPath): TFileHandle;
+begin
+ Result := WideFileCreate(FileName.ToWide());
+end;
+
+function TFileSystemImpl.DirectoryCreate(const Dir: IPath): boolean;
+begin
+ Result := WideCreateDir(Dir.ToWide());
+end;
+
+function TFileSystemImpl.FileOpen(const FileName: IPath; Mode: longword): TFileHandle;
+begin
+ Result := WideFileOpen(FileName.ToWide(), Mode);
+end;
+
+function TFileSystemImpl.FileAge(const FileName: IPath): integer;
+begin
+ Result := WideFileAge(FileName.ToWide());
+end;
+
+function TFileSystemImpl.FileAge(const FileName: IPath; out FileDateTime: TDateTime): boolean;
+begin
+ Result := WideFileAge(FileName.ToWide(), FileDateTime);
+end;
+
+function TFileSystemImpl.DirectoryExists(const Name: IPath): boolean;
+begin
+ Result := WideDirectoryExists(Name.ToWide());
+end;
+
+function TFileSystemImpl.FileExists(const Name: IPath): boolean;
+begin
+ Result := WideFileExists(Name.ToWide());
+end;
+
+function TFileSystemImpl.FileGetAttr(const FileName: IPath): Cardinal;
+begin
+ Result := WideFileGetAttr(FileName.ToWide());
+end;
+
+function TFileSystemImpl.FileSetAttr(const FileName: IPath; Attr: integer): boolean;
+begin
+ Result := WideFileSetAttr(FileName.ToWide(), Attr);
+end;
+
+function TFileSystemImpl.FileIsReadOnly(const FileName: IPath): boolean;
+begin
+ Result := WideFileIsReadOnly(FileName.ToWide());
+end;
+
+function TFileSystemImpl.FileSetReadOnly(const FileName: IPath; ReadOnly: boolean): boolean;
+begin
+ Result := WideFileSetReadOnly(FileName.ToWide(), ReadOnly);
+end;
+
+function TFileSystemImpl.ForceDirectories(const Dir: IPath): boolean;
+begin
+ Result := WideForceDirectories(Dir.ToWide());
+end;
+
+function TFileSystemImpl.FileSearch(const Name: IPath; DirList: array of IPath): IPath;
+var
+ I: integer;
+ DirListStr: WideString;
+begin
+ DirListStr := '';
+ for I := 0 to High(DirList) do
+ begin
+ if (I > 0) then
+ DirListStr := DirListStr + PathSep;
+ DirListStr := DirListStr + DirList[I].ToWide();
+ end;
+ Result := Path(WideFileSearch(Name.ToWide(), DirListStr));
+end;
+
+function TFileSystemImpl.RenameFile(const OldName, NewName: IPath): boolean;
+begin
+ Result := WideRenameFile(OldName.ToWide(), NewName.ToWide());
+end;
+
+function TFileSystemImpl.DeleteFile(const FileName: IPath): boolean;
+begin
+ Result := WideDeleteFile(FileName.ToWide());
+end;
+
+function TFileSystemImpl.RemoveDir(const Dir: IPath): boolean;
+begin
+ Result := WideRemoveDir(Dir.ToWide());
+end;
+
+function TFileSystemImpl.CopyFile(const Source, Target: IPath; FailIfExists: boolean): boolean;
+begin
+ Result := WideCopyFile(Source.ToWide(), Target.ToWide(), FailIfExists);
+end;
+
+function TFileSystemImpl.ExtractFileDrive(const FileName: IPath): IPath;
+begin
+ Result := Path(WideExtractFileDrive(FileName.ToWide()));
+end;
+
+function TFileSystemImpl.ExtractFilePath(const FileName: IPath): IPath;
+begin
+ Result := Path(WideExtractFilePath(FileName.ToWide()));
+end;
+
+function TFileSystemImpl.ExtractFileDir(const FileName: IPath): IPath;
+begin
+ Result := Path(WideExtractFileDir(FileName.ToWide()));
+end;
+
+function TFileSystemImpl.ExtractFileName(const FileName: IPath): IPath;
+begin
+ Result := Path(WideExtractFileName(FileName.ToWide()));
+end;
+
+function TFileSystemImpl.ExtractFileExt(const FileName: IPath): IPath;
+begin
+ Result := Path(WideExtractFileExt(FileName.ToWide()));
+end;
+
+function TFileSystemImpl.ExtractRelativePath(const BaseName: IPath; const FileName: IPath): IPath;
+begin
+ Result := Path(WideExtractRelativePath(BaseName.ToWide(), FileName.ToWide()));
+end;
+
+function TFileSystemImpl.ChangeFileExt(const FileName: IPath; const Extension: IPath): IPath;
+begin
+ Result := Path(WideChangeFileExt(FileName.ToWide(), Extension.ToWide()));
+end;
+
+function TFileSystemImpl.IncludeTrailingPathDelimiter(const FileName: IPath): IPath;
+begin
+ Result := Path(WideIncludeTrailingPathDelimiter(FileName.ToWide()));
+end;
+
+function TFileSystemImpl.ExcludeTrailingPathDelimiter(const FileName: IPath): IPath;
+begin
+ Result := Path(WideExcludeTrailingPathDelimiter(FileName.ToWide()));
+end;
+
+function TFileSystemImpl.FindFirst(const FilePattern: IPath; Attr: integer; var F: TSytemSearchRec): integer;
+begin
+ Result := WideFindFirst(FilePattern.ToWide(), Attr, F);
+end;
+
+function TFileSystemImpl.FindNext(var F: TSytemSearchRec): integer;
+begin
+ Result := WideFindNext(F);
+end;
+
+procedure TFileSystemImpl.FindClose(var F: TSytemSearchRec);
+begin
+ WideFindClose(F);
+end;
+
+function TFileSystemImpl.GetCurrentDir: IPath;
+begin
+ Result := Path(WideGetCurrentDir());
+end;
+
+function TFileSystemImpl.SetCurrentDir(const Dir: IPath): boolean;
+begin
+ Result := WideSetCurrentDir(Dir.ToWide());
+end;
+
+{$ELSE} // UNIX
+
+function TFileSystemImpl.ExpandFileName(const FileName: IPath): IPath;
+begin
+ Result := Path(SysUtils.ExpandFileName(FileName.ToNative()));
+end;
+
+function TFileSystemImpl.FileCreate(const FileName: IPath): TFileHandle;
+begin
+ Result := SysUtils.FileCreate(FileName.ToNative());
+end;
+
+function TFileSystemImpl.DirectoryCreate(const Dir: IPath): boolean;
+begin
+ Result := SysUtils.CreateDir(Dir.ToNative());
+end;
+
+function TFileSystemImpl.FileOpen(const FileName: IPath; Mode: longword): TFileHandle;
+begin
+ Result := SysUtils.FileOpen(FileName.ToNative(), Mode);
+end;
+
+function TFileSystemImpl.FileAge(const FileName: IPath): integer;
+begin
+ Result := SysUtils.FileAge(FileName.ToNative());
+end;
+
+function TFileSystemImpl.FileAge(const FileName: IPath; out FileDateTime: TDateTime): boolean;
+var
+ FileDate: integer;
+begin
+ FileDate := SysUtils.FileAge(FileName.ToNative());
+ Result := (FileDate <> -1);
+ if (Result) then
+ FileDateTime := FileDateToDateTime(FileDate);
+end;
+
+function TFileSystemImpl.DirectoryExists(const Name: IPath): boolean;
+begin
+ Result := SysUtils.DirectoryExists(Name.ToNative());
+end;
+
+function TFileSystemImpl.FileExists(const Name: IPath): boolean;
+begin
+ Result := SysUtils.FileExists(Name.ToNative());
+end;
+
+function TFileSystemImpl.FileGetAttr(const FileName: IPath): Cardinal;
+begin
+ Result := SysUtils.FileGetAttr(FileName.ToNative());
+end;
+
+function TFileSystemImpl.FileSetAttr(const FileName: IPath; Attr: integer): boolean;
+begin
+ Result := (SysUtils.FileSetAttr(FileName.ToNative(), Attr) = 0);
+end;
+
+function TFileSystemImpl.FileIsReadOnly(const FileName: IPath): boolean;
+begin
+ Result := SysUtils.FileIsReadOnly(FileName.ToNative());
+end;
+
+function TFileSystemImpl.FileSetReadOnly(const FileName: IPath; ReadOnly: boolean): boolean;
+begin
+ Result := (SysUtils.FileSetAttr(FileName.ToNative(), faReadOnly) = 0);
+end;
+
+function TFileSystemImpl.ForceDirectories(const Dir: IPath): boolean;
+begin
+ Result := SysUtils.ForceDirectories(Dir.ToNative());
+end;
+
+function TFileSystemImpl.FileSearch(const Name: IPath; DirList: array of IPath): IPath;
+var
+ I: integer;
+ DirListStr: AnsiString;
+begin
+ DirListStr := '';
+ for I := 0 to High(DirList) do
+ begin
+ if (I > 0) then
+ DirListStr := DirListStr + PathSep;
+ DirListStr := DirListStr + DirList[I].ToNative();
+ end;
+ Result := Path(SysUtils.FileSearch(Name.ToNative(), DirListStr));
+end;
+
+function TFileSystemImpl.RenameFile(const OldName, NewName: IPath): boolean;
+begin
+ Result := SysUtils.RenameFile(OldName.ToNative(), NewName.ToNative());
+end;
+
+function TFileSystemImpl.DeleteFile(const FileName: IPath): boolean;
+begin
+ Result := SysUtils.DeleteFile(FileName.ToNative());
+end;
+
+function TFileSystemImpl.RemoveDir(const Dir: IPath): boolean;
+begin
+ Result := SysUtils.RemoveDir(Dir.ToNative());
+end;
+
+function TFileSystemImpl.CopyFile(const Source, Target: IPath; FailIfExists: boolean): boolean;
+const
+ COPY_BUFFER_SIZE = 4096; // a good tradeoff between speed and memory consumption
+var
+ SourceFile, TargetFile: TFileStream;
+ FileCopyBuffer: array [0..COPY_BUFFER_SIZE-1] of byte; // temporary copy-buffer.
+ NumberOfBytes: integer; // number of bytes read from SourceFile
+begin
+ Result := false;
+ SourceFile := nil;
+ TargetFile := nil;
+
+ // if overwrite is disabled return if the target file already exists
+ if (FailIfExists and FileExists(Target)) then
+ Exit;
+
+ try
+ try
+ // open source and target file (might throw an exception on error)
+ SourceFile := TFileStream.Create(Source.ToNative(), fmOpenRead);
+ TargetFile := TFileStream.Create(Target.ToNative(), fmCreate or fmOpenWrite);
+
+ while true do
+ begin
+ // read a block from the source file and check for errors or EOF
+ NumberOfBytes := SourceFile.Read(FileCopyBuffer, SizeOf(FileCopyBuffer));
+ if (NumberOfBytes <= 0) then
+ Break;
+ // write block to target file and check if everything was written
+ if (TargetFile.Write(FileCopyBuffer, NumberOfBytes) <> NumberOfBytes) then
+ Exit;
+ end;
+ except
+ Exit;
+ end;
+ finally
+ SourceFile.Free;
+ TargetFile.Free;
+ end;
+
+ Result := true;
+end;
+
+function TFileSystemImpl.ExtractFileDrive(const FileName: IPath): IPath;
+begin
+ Result := Path(SysUtils.ExtractFileDrive(FileName.ToNative()));
+end;
+
+function TFileSystemImpl.ExtractFilePath(const FileName: IPath): IPath;
+begin
+ Result := Path(SysUtils.ExtractFilePath(FileName.ToNative()));
+end;
+
+function TFileSystemImpl.ExtractFileDir(const FileName: IPath): IPath;
+begin
+ Result := Path(SysUtils.ExtractFileDir(FileName.ToNative()));
+end;
+
+function TFileSystemImpl.ExtractFileName(const FileName: IPath): IPath;
+begin
+ Result := Path(SysUtils.ExtractFileName(FileName.ToNative()));
+end;
+
+function TFileSystemImpl.ExtractFileExt(const FileName: IPath): IPath;
+begin
+ Result := Path(SysUtils.ExtractFileExt(FileName.ToNative()));
+end;
+
+function TFileSystemImpl.ExtractRelativePath(const BaseName: IPath; const FileName: IPath): IPath;
+begin
+ Result := Path(SysUtils.ExtractRelativePath(BaseName.ToNative(), FileName.ToNative()));
+end;
+
+function TFileSystemImpl.ChangeFileExt(const FileName: IPath; const Extension: IPath): IPath;
+begin
+ Result := Path(SysUtils.ChangeFileExt(FileName.ToNative(), Extension.ToNative()));
+end;
+
+function TFileSystemImpl.IncludeTrailingPathDelimiter(const FileName: IPath): IPath;
+begin
+ Result := Path(SysUtils.IncludeTrailingPathDelimiter(FileName.ToNative()));
+end;
+
+function TFileSystemImpl.ExcludeTrailingPathDelimiter(const FileName: IPath): IPath;
+begin
+ Result := Path(SysUtils.ExcludeTrailingPathDelimiter(FileName.ToNative()));
+end;
+
+function TFileSystemImpl.FindFirst(const FilePattern: IPath; Attr: integer; var F: TSytemSearchRec): integer;
+begin
+ Result := SysUtils.FindFirst(FilePattern.ToNative(), Attr, F);
+end;
+
+function TFileSystemImpl.FindNext(var F: TSytemSearchRec): integer;
+begin
+ Result := SysUtils.FindNext(F);
+end;
+
+procedure TFileSystemImpl.FindClose(var F: TSytemSearchRec);
+begin
+ SysUtils.FindClose(F);
+end;
+
+function TFileSystemImpl.GetCurrentDir: IPath;
+begin
+ Result := Path(SysUtils.GetCurrentDir());
+end;
+
+function TFileSystemImpl.SetCurrentDir(const Dir: IPath): boolean;
+begin
+ Result := SysUtils.SetCurrentDir(Dir.ToNative());
+end;
+
+{$ENDIF}
+
+
+{ TFileIterator }
+
+constructor TFileIterator.Create(const FilePattern: IPath; Attr: integer);
+begin
+ inherited Create();
+ fHasNext := (FileSystem.FindFirst(FilePattern, Attr, fSearchRec) = 0);
+end;
+
+destructor TFileIterator.Destroy();
+begin
+ FileSystem.FindClose(fSearchRec);
+ inherited;
+end;
+
+function TFileIterator.HasNext(): boolean;
+begin
+ Result := fHasNext;
+end;
+
+function TFileIterator.Next(): TFileInfo;
+begin
+ if (not fHasNext) then
+ begin
+ // Note: do not use FillChar() on records with ref-counted fields
+ Result.Time := 0;
+ Result.Size := 0;
+ Result.Attr := 0;
+ Result.Name := nil;
+ Exit;
+ end;
+
+ Result.Time := fSearchRec.Time;
+ Result.Size := fSearchRec.Size;
+ Result.Attr := fSearchRec.Attr;
+ Result.Name := Path(fSearchRec.Name);
+
+ // fetch next entry
+ fHasNext := (FileSystem.FindNext(fSearchRec) = 0);
+end;
+
+
+initialization
+ FileSystem_Singleton := TFileSystemImpl.Create;
+
+finalization
+ FileSystem_Singleton := nil;
+
+end.
diff --git a/mediaplugin/src/base/UFont.pas b/mediaplugin/src/base/UFont.pas
new file mode 100644
index 00000000..e680811b
--- /dev/null
+++ b/mediaplugin/src/base/UFont.pas
@@ -0,0 +1,3067 @@
+{* 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}
+
+// Enables the Freetype font cache
+{$DEFINE ENABLE_FT_FACE_CACHE}
+
+uses
+ FreeType,
+ gl,
+ glext,
+ glu,
+ sdl,
+ Math,
+ Classes,
+ SysUtils,
+ UUnicodeUtils,
+ {$IFDEF BITMAP_FONT}
+ UTexture,
+ {$ENDIF}
+ 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;
+
+ EFontError = class(Exception);
+
+ {**
+ * 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
+ fFilename: IPath;
+ 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(const Filename: IPath);
+ destructor Destroy(); override;
+
+ {**
+ * Prints a text.
+ *}
+ procedure Print(const Text: UCS4String); overload;
+ {** UTF-16 version of @link(Print) }
+ procedure Print(const Text: WideString); overload;
+ {** UTF-8 version of @link(Print) }
+ procedure Print(const Text: 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;
+
+ {**
+ * Adds a new font that is used if the default font misses a glyph
+ * @raises EFontError if the fallback could not be initialized
+ *}
+ procedure AddFallback(const Filename: IPath); virtual; abstract;
+
+ {** Font height }
+ property Height: single read GetHeight;
+ {** Vertical distance from baseline to top of glyph }
+ 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;
+ {** Filename }
+ property Filename: IPath read fFilename;
+ 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
+ fStretch: single; //**< stretch factor for width (Width * fStretch)
+ fBaseFont: TFont; //**< shortcut for fMipmapFonts[0]
+ fUseMipmaps: boolean; //**< true if mipmap fonts are generated
+ /// Mipmap fonts (size[level+1] = size[level]/2)
+ fMipmapFonts: array[0..cMaxMipmapLevel] of TFont;
+
+ procedure Render(const Text: 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 SetStretch(Stretch: single); virtual;
+ function GetStretch(): 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*Stretch), 1.0 by default }
+ property Stretch: single read GetStretch write SetStretch;
+ end;
+
+ {**
+ * Table for storage of max. 256 glyphs.
+ * Used for the second cache level. Indexed by the LSB of the 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(const Filename: IPath);
+ 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 font face class.
+ *}
+ TFTFontFace = class
+ private
+ fFilename: IPath; //**< filename of the font-file
+ fFace: FT_Face; //**< Holds the height of the font
+ fFontUnitScale: TPositionDbl; //**< FT font-units to pixel ratio
+ fSize: integer;
+
+ public
+ {**
+ * @raises EFontError if the glyph could not be initialized
+ *}
+ constructor Create(const Filename: IPath; Size: integer);
+
+ destructor Destroy(); override;
+
+ property Filename: IPath read fFilename;
+ property Data: FT_Face read fFace;
+ property FontUnitScale: TPositionDbl read fFontUnitScale;
+ property Size: integer read fSize;
+ end;
+
+ {**
+ * Loading font faces with freetype is a slow process.
+ * Especially loading a font (e.g. fallback fonts) more than once is a waste
+ * of time. Just cache already loaded faces here.
+ *}
+ TFTFontFaceCache = class
+ private
+ fFaces: array of TFTFontFace;
+ fFacesRefCnt: array of integer;
+ public
+ {**
+ * @raises EFontError if the font could not be initialized
+ *}
+ function LoadFace(const Filename: IPath; Size: integer): TFTFontFace;
+
+ procedure UnloadFace(Face: TFTFontFace);
+ end;
+
+ {**
+ * Freetype glyph.
+ * Each glyph stores a texture with the glyph's image.
+ *}
+ TFTGlyph = class(TGlyph)
+ private
+ fCharCode: UCS4Char; //**< Char code
+ fFace: TFTFontFace; //**< Freetype face used for this glyph
+ fCharIndex: FT_UInt; //**< Freetype specific char-index (<> char-code)
+ fDisplayList: GLuint; //**< Display-list ID
+ fTexture: GLuint; //**< Texture ID
+ 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 EFontError 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;
+
+ {** Freetype face used for this glyph }
+ property Face: TFTFontFace read fFace;
+ end;
+
+ TFontPart = ( fpNone, fpInner, fpOutline );
+ TFTFontFaceArray = array of TFTFontFace;
+
+ {**
+ * Freetype font class.
+ *}
+ TFTFont = class(TCachedFont)
+ private
+ procedure ResetIntern();
+ class function GetFaceCache(): TFTFontFaceCache;
+
+ protected
+ fFace: TFTFontFace; //**< Default font face
+ fSize: integer; //**< Font base size (in pixels)
+ fOutset: single; //**< size of outset extrusion (in pixels)
+ fPreCache: boolean; //**< pre-load base glyphs
+ fLoadFlags: FT_Int32; //**< FT glpyh load-flags
+ fUseDisplayLists: boolean; //**< true: use display-lists, false: direct drawing
+ fPart: TFontPart; //**< indicates the part of an outline font
+ fFallbackFaces: TFTFontFaceArray; //**< available fallback faces, ordered by priority
+
+ {** @seealso TCachedFont.LoadGlyph }
+ function LoadGlyph(ch: 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;
+
+ 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 EFontError if the font-file could not be loaded
+ *}
+ constructor Create(const Filename: IPath;
+ Size: integer; Outset: single = 0.0;
+ PreCache: boolean = true;
+ LoadFlags: FT_Int32 = FT_LOAD_DEFAULT);
+
+ {**
+ * Frees all resources associated with the font.
+ *}
+ destructor Destroy(); override;
+
+ {** @seealso TFont.Reset }
+ procedure Reset(); override;
+
+ procedure AddFallback(const Filename: IPath); override;
+
+ {** Size of the base font }
+ property Size: integer read fSize;
+ {** Outset size }
+ property Outset: single read fOutset;
+ {** The part (inner/outline/none) this font represents in a composite font }
+ property Part: TFontPart read fPart write fPart;
+ {** Freetype face of this font }
+ property DefaultFace: TFTFontFace read fFace;
+ {** Available freetype fallback faces, ordered by priority }
+ property FallbackFaces: TFTFontFaceArray read fFallbackFaces;
+ end;
+
+ TFTScalableFont = class(TScalableFont)
+ 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%).
+ *
+ * The memory size (in bytes) consumed by a scalable font
+ * - with UseMipmaps=false:
+ * mem = size^2 * #cached_glyphs
+ * - with UseMipmaps=true (all mipmap levels):
+ * mem = size^2 * #cached_glyphs * Sum[i=1..cMaxMipmapLevel](1/i^2)
+ * - with UseMipmaps=true (5 <= cMaxMipmapLevel <= 10):
+ * mem ~= size^2 * #cached_glyphs * 1.5
+ *
+ * Examples (for 128 cached glyphs):
+ * - Size: 64 pixels: 768 KB (mipmapped) or 512 KB (non-mipmapped).
+ * - Size 128 pixels: 3 MB (mipmapped) or 2 MB (non-mipmapped)
+ *
+ * Note: once a glyph is cached there will
+ *}
+ constructor Create(const Filename: IPath;
+ Size: integer; OutsetAmount: single = 0.0;
+ UseMipmaps: boolean = true;
+ PreCache: boolean = true);
+
+ procedure AddFallback(const Filename: IPath); override;
+
+ {** @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
+ fSize: integer;
+ fOutset: single;
+ fInnerFont, fOutlineFont: TFTFont;
+ fOutlineColor: TGLColor;
+ fPreCache: boolean;
+
+ 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;
+ PreCache: boolean = true;
+ 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);
+
+ procedure AddFallback(const Filename: IPath); 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;
+
+ {**
+ * 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;
+ PreCache: boolean = true);
+
+ {** @seealso TFTOutlineFont.SetOutlineColor }
+ procedure SetOutlineColor(r, g, b: GLfloat; a: GLfloat = -1.0);
+
+ {** @seealso TGlyphCache.FlushCache }
+ procedure FlushCache(KeepBaseSet: boolean);
+
+ procedure AddFallback(const Filename: IPath); override;
+
+ {** 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 EFontError 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;
+
+ procedure AddFallback(const Filename: IPath); override;
+ end;
+
+{$ENDIF BITMAP_FONT}
+
+ TFreeType = class
+ public
+ {**
+ * Returns a pointer to the freetype library singleton.
+ * If non exists, freetype will be initialized.
+ * @raises EFontError 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(const Filename: IPath);
+begin
+ inherited Create();
+ fFilename := Filename;
+ 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(Font.Filename);
+
+ 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;
+ fStretch := 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 stretch.
+ *
+ * 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, DistSum: 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;
+ DistSum := Dist*Dist + Dist2*Dist2;
+ if (DistSum > 0) then
+ begin
+ WidthScale := cTestSize / Sqrt(DistSum);
+ end;
+
+ // projected height ||(x1, y1) - (x1, y2)||
+ Dist := (WinCoords[0][0] - WinCoords[2][0]);
+ Dist2 := (WinCoords[0][1] - WinCoords[2][1]);
+
+ HeightScale := 1;
+ DistSum := Dist*Dist + Dist2*Dist2;
+ if (DistSum > 0) then
+ begin
+ HeightScale := cTestSize / Sqrt(DistSum);
+ 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 * fStretch, 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 * fStretch;
+ Result.Right := Result.Right * fScale * fStretch;
+ 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.SetStretch(Stretch: single);
+begin
+ fStretch := Stretch;
+end;
+
+function TScalableFont.GetStretch(): single;
+begin
+ Result := fStretch;
+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(const Filename: IPath);
+begin
+ inherited Create(Filename);
+ 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;
+
+{*
+ * TFTFontFaceCache
+ *}
+
+{*
+ * TFTFontFace
+ *}
+
+constructor TFTFontFace.Create(const Filename: IPath; Size: integer);
+begin
+ inherited Create();
+
+ fFilename := Filename;
+ fSize := Size;
+
+ // load font information
+ if (FT_New_Face(TFreeType.GetLibrary(), PChar(Filename.ToNative), 0, fFace) <> 0) then
+ raise EFontError.Create('FT_New_Face: Could not load font ''' + Filename.ToNative + '''');
+
+ // support scalable fonts only
+ if (not FT_IS_SCALABLE(fFace)) then
+ raise EFontError.Create('Font is not scalable');
+
+ if (FT_Set_Pixel_Sizes(fFace, 0, Size) <> 0) then
+ raise EFontError.Create('FT_Set_Pixel_Sizes failes');
+
+ // get scale factor for font-unit to pixel-size transformation
+ fFontUnitScale.X := fFace.size.metrics.x_ppem / fFace.units_per_EM;
+ fFontUnitScale.Y := fFace.size.metrics.y_ppem / fFace.units_per_EM;
+end;
+
+destructor TFTFontFace.Destroy();
+begin
+ // free face data
+ FT_Done_Face(fFace);
+ inherited;
+end;
+
+
+{*
+ * TFTFontFaceCache
+ *}
+
+function TFTFontFaceCache.LoadFace(const Filename: IPath; Size: integer): TFTFontFace;
+var
+ I: Integer;
+ Face: TFTFontFace;
+begin
+ {$IFDEF ENABLE_FT_FACE_CACHE}
+ for I := 0 to High(fFaces) do
+ begin
+ Face := fFaces[I];
+ // check if we have this file in our cache
+ if ((Face.Filename.Equals(Filename)) and (Face.Size = Size)) then
+ begin
+ // true -> return cached face and increment ref-count
+ Inc(fFacesRefCnt[I]);
+ Result := Face;
+ Exit;
+ end;
+ end;
+ {$ENDIF}
+
+ // face not in cache -> load it
+ Face := TFTFontFace.Create(Filename, Size);
+
+ // add face to cache
+ SetLength(fFaces, Length(fFaces)+1);
+ SetLength(fFacesRefCnt, Length(fFaces)+1);
+ fFaces[High(fFaces)] := Face;
+ fFacesRefCnt[High(fFaces)] := 1;
+
+ Result := Face;
+end;
+
+procedure TFTFontFaceCache.UnloadFace(Face: TFTFontFace);
+var
+ I: Integer;
+begin
+ for I := 0 to High(fFaces) do
+ begin
+ // search face in cache
+ if (fFaces[I] = Face) then
+ begin
+ // decrement ref-count and free face if ref-count is 0
+ Dec(fFacesRefCnt[I]);
+ if (fFacesRefCnt[I] <= 0) then
+ fFaces[I].Free;
+ Exit;
+ end;
+ end;
+end;
+
+
+{*
+ * TFTFont
+ *}
+
+constructor TFTFont.Create(
+ const Filename: IPath;
+ Size: integer; Outset: single;
+ PreCache: boolean;
+ LoadFlags: FT_Int32);
+var
+ ch: UCS4Char;
+begin
+ inherited Create(Filename);
+
+ fSize := Size;
+ fOutset := Outset;
+ fPreCache := PreCache;
+ fLoadFlags := LoadFlags;
+ fUseDisplayLists := true;
+ fPart := fpNone;
+
+ fFace := GetFaceCache.LoadFace(Filename, Size);
+
+ ResetIntern();
+
+ // pre-cache some commonly used glyphs (' ' - '~')
+ if (PreCache) then
+ begin
+ for ch := 32 to 126 do
+ fCache.AddGlyph(ch, TFTGlyph.Create(Self, ch, Outset, LoadFlags));
+ end;
+end;
+
+destructor TFTFont.Destroy();
+var
+ I: integer;
+begin
+ // free faces
+ GetFaceCache.UnloadFace(fFace);
+ for I := 0 to High(fFallbackFaces) do
+ GetFaceCache.UnloadFace(fFallbackFaces[I]);
+
+ inherited;
+end;
+
+var
+ FontFaceCache: TFTFontFaceCache = nil;
+
+class function TFTFont.GetFaceCache(): TFTFontFaceCache;
+begin
+ if (FontFaceCache = nil) then
+ FontFaceCache := TFTFontFaceCache.Create;
+ Result := FontFaceCache;
+end;
+
+procedure TFTFont.ResetIntern();
+begin
+ // Note: outset and non outset fonts use same spacing
+ fLineSpacing := fFace.Data.height * fFace.FontUnitScale.Y;
+ fReflectionSpacing := -2*fFace.Data.descender * fFace.FontUnitScale.Y;
+end;
+
+procedure TFTFont.Reset();
+begin
+ inherited;
+ ResetIntern();
+end;
+
+procedure TFTFont.AddFallback(const Filename: IPath);
+var
+ FontFace: TFTFontFace;
+begin
+ FontFace := GetFaceCache.LoadFace(Filename, Size);
+ SetLength(fFallbackFaces, Length(fFallbackFaces) + 1);
+ fFallbackFaces[High(fFallbackFaces)] := FontFace;
+end;
+
+function TFTFont.LoadGlyph(ch: UCS4Char): TGlyph;
+begin
+ Result := TFTGlyph.Create(Self, ch, Outset, fLoadFlags);
+end;
+
+function TFTFont.BBox(const Text: 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.Data) and (PrevGlyph <> nil)) then
+ begin
+ FT_Get_Kerning(fFace.Data, PrevGlyph.CharIndex, Glyph.CharIndex,
+ FT_KERNING_UNSCALED, KernDelta);
+ LineBounds.Right := LineBounds.Right + KernDelta.x * fFace.FontUnitScale.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.Data) and (PrevGlyph <> nil)) then
+ begin
+ FT_Get_Kerning(fFace.Data, PrevGlyph.CharIndex, Glyph.CharIndex,
+ FT_KERNING_UNSCALED, KernDelta);
+ glTranslatef(KernDelta.x * fFace.FontUnitScale.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.Data.ascender * fFace.FontUnitScale.Y + Outset*2;
+end;
+
+function TFTFont.GetDescender(): single;
+begin
+ // Note: outset is not part of the descender as the baseline is lifted
+ Result := fFace.Data.descender * fFace.FontUnitScale.Y;
+end;
+
+function TFTFont.GetUnderlinePosition(): single;
+begin
+ Result := fFace.Data.underline_position * fFace.FontUnitScale.Y - Outset;
+end;
+
+function TFTFont.GetUnderlineThickness(): single;
+begin
+ Result := fFace.Data.underline_thickness * fFace.FontUnitScale.Y + Outset*2;
+end;
+
+
+{*
+ * TFTScalableFont
+ *}
+
+constructor TFTScalableFont.Create(const Filename: IPath;
+ Size: integer; OutsetAmount: single;
+ UseMipmaps: boolean;
+ PreCache: 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, PreCache, 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.Filename,
+ ScaledSize, BaseFont.Outset * Scale,
+ BaseFont.fPreCache,
+ FT_LOAD_DEFAULT or FT_LOAD_NO_HINTING);
+end;
+
+function TFTScalableFont.GetOutset(): single;
+begin
+ Result := TFTFont(fBaseFont).Outset * fScale;
+end;
+
+procedure TFTScalableFont.AddFallback(const Filename: IPath);
+var
+ Level: integer;
+begin
+ for Level := 0 to High(fMipmapFonts) do
+ if (fMipmapFonts[Level] <> nil) then
+ TFTFont(fMipmapFonts[Level]).AddFallback(Filename);
+end;
+
+procedure TFTScalableFont.FlushCache(KeepBaseSet: boolean);
+var
+ Level: integer;
+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;
+ PreCache: boolean;
+ LoadFlags: FT_Int32);
+begin
+ inherited Create(Filename);
+
+ fSize := Size;
+ fOutset := Outset;
+ fPreCache := PreCache;
+ fInnerFont := TFTFont.Create(Filename, Size, 0.0, PreCache, LoadFlags);
+ fInnerFont.Part := fpInner;
+ fOutlineFont := TFTFont.Create(Filename, Size, Outset, PreCache, LoadFlags);
+ fOutlineFont.Part := 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;
+
+procedure TFTOutlineFont.AddFallback(const Filename: IPath);
+begin
+ fOutlineFont.AddFallback(Filename);
+ fInnerFont.AddFallback(Filename);
+end;
+
+function TFTOutlineFont.BBox(const Text: TUCS4StringArray; Advance: boolean): TBoundsDbl;
+begin
+ Result := fOutlineFont.BBox(Text, Advance);
+end;
+
+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;
+ PreCache: 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, PreCache, 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,
+ BaseFont.fPreCache,
+ 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;
+
+procedure TFTScalableOutlineFont.AddFallback(const Filename: IPath);
+var
+ Level: integer;
+begin
+ for Level := 0 to High(fMipmapFonts) do
+ if (fMipmapFonts[Level] <> nil) then
+ TFTOutlineFont(fMipmapFonts[Level]).AddFallback(Filename);
+end;
+
+
+{*
+ * TFTGlyph
+ *}
+
+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.Part = fpInner);
+
+ // we cannot extrude bitmaps, only vector based glyphs.
+ // Check for FT_GLYPH_FORMAT_OUTLINE otherwise a cast to FT_OutlineGlyph is
+ // invalid and FT_Stroker_ParseOutline() will crash
+ if (Glyph.format <> FT_GLYPH_FORMAT_OUTLINE) then
+ Exit;
+
+ Outline := @FT_OutlineGlyph(Glyph).outline;
+
+ OuterBorder := FT_Outline_GetOutsideBorder(Outline);
+ if (OuterBorder = FT_STROKER_BORDER_LEFT) then
+ InnerBorder := FT_STROKER_BORDER_RIGHT
+ else
+ InnerBorder := FT_STROKER_BORDER_LEFT;
+
+ { extrude outer border }
+
+ if (FT_Stroker_New(Glyph.library_, OuterStroker) <> 0) then
+ raise EFontError.Create('FT_Stroker_New failed!');
+ FT_Stroker_Set(
+ OuterStroker,
+ Round(fOutset * 64),
+ FT_STROKER_LINECAP_ROUND,
+ FT_STROKER_LINEJOIN_BEVEL,
+ 0);
+
+ // similar to FT_Glyph_StrokeBorder(inner = FT_FALSE) but it is possible to
+ // use FT_Stroker_ExportBorder() afterwards to combine inner and outer borders
+ if (FT_Stroker_ParseOutline(OuterStroker, Outline, FT_FALSE) <> 0) then
+ raise EFontError.Create('FT_Stroker_ParseOutline failed!');
+
+ 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 EFontError.Create('FT_Stroker_New failed!');
+ FT_Stroker_Set(
+ InnerStroker,
+ 63, // extrude at most one pixel to avoid a black border
+ FT_STROKER_LINECAP_ROUND,
+ FT_STROKER_LINEJOIN_BEVEL,
+ 0);
+
+ if (FT_Stroker_ParseOutline(InnerStroker, Outline, FT_FALSE) <> 0) then
+ raise EFontError.Create('FT_Stroker_ParseOutline failed!');
+
+ FT_Stroker_GetBorderCounts(InnerStroker, InnerBorder, InnerNumPoints, InnerNumContours);
+ end else begin
+ InnerNumPoints := 0;
+ InnerNumContours := 0;
+ end;
+
+ { 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 EFontError.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 EFontError.Create('FT_Stroker_ExportBorder failed!');
+
+ if (InnerStroker <> nil) then
+ FT_Stroker_Done(InnerStroker);
+ if (OuterStroker <> nil) then
+ FT_Stroker_Done(OuterStroker);
+end;
+
+procedure TFTGlyph.CreateTexture(LoadFlags: FT_Int32);
+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
+ // we need vector data for outlined glyphs so do not load bitmaps.
+ // This is necessary for mixed fonts that contain bitmap versions of smaller
+ // glyphs, for example in CJK fonts.
+ if (fOutset > 0) then
+ LoadFlags := LoadFlags or FT_LOAD_NO_BITMAP;
+
+ // load the Glyph for our character
+ if (FT_Load_Glyph(fFace.Data, fCharIndex, LoadFlags) <> 0) then
+ raise EFontError.Create('FT_Load_Glyph failed');
+
+ // move the face's glyph into a Glyph object
+ if (FT_Get_Glyph(fFace.Data^.glyph, Glyph) <> 0) then
+ raise EFontError.Create('FT_Get_Glyph failed');
+
+ if (fOutset > 0) then
+ StrokeBorder(Glyph);
+
+ // store scaled advance width/height in glyph-object
+ fAdvance.X := fFace.Data^.glyph^.advance.x / 64 + fOutset*2;
+ fAdvance.Y := fFace.Data^.glyph^.advance.y / 64 + fOutset*2;
+
+ // get the contour's bounding box (in 1/64th pixels, not font-units)
+ FT_Glyph_Get_CBox(Glyph, FT_GLYPH_BBOX_UNSCALED, CBox);
+ // 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);
+var
+ I: integer;
+begin
+ inherited Create();
+
+ fFont := Font;
+ fOutset := Outset;
+ fCharCode := ch;
+
+ // Note: the default face is also used if no face (neither default nor fallback)
+ // contains a glyph for the given char.
+ fFace := Font.DefaultFace;
+
+ // search the Freetype char-index (use default UNICODE charmap) in the default face
+ fCharIndex := FT_Get_Char_Index(fFace.Data, FT_ULONG(ch));
+ if (fCharIndex = 0) then
+ begin
+ // glyph not in default font, search in fallback font faces
+ for I := 0 to High(Font.FallbackFaces) do
+ begin
+ fCharIndex := FT_Get_Char_Index(Font.FallbackFaces[I].Data, FT_ULONG(ch));
+ if (fCharIndex <> 0) then
+ begin
+ fFace := Font.FallbackFaces[I];
+ Break;
+ end;
+ end;
+ end;
+
+ CreateTexture(LoadFlags);
+end;
+
+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 EFontError.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(Filename);
+
+ 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.AddFallback(const Filename: IPath);
+begin
+ // no support for fallbacks
+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 EFontError.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/mediaplugin/src/base/UGraphic.pas b/mediaplugin/src/base/UGraphic.pas
new file mode 100644
index 00000000..4f0c8c77
--- /dev/null
+++ b/mediaplugin/src/base/UGraphic.pas
@@ -0,0 +1,852 @@
+{* 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,
+ 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}
+ UScreenPartyNewRound,
+ UScreenPartyScore,
+ UScreenPartyOptions,
+ UScreenPartyWin,
+ UScreenPartyPlayer,
+ UScreenPartyRounds,
+ {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;
+ 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;
+ ScreenPartyRounds: TScreenPartyRounds;
+
+ //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;
+
+
+ PboSupported: boolean;
+
+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 Finalize3D;
+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');
+ BuildFonts;
+end;
+
+procedure UnloadFontTextures;
+begin
+ Log.LogStatus('Kill Fonts', 'UnloadFontTextures');
+ KillFonts;
+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();
+
+ // PBO functions are loaded with VBO
+ //PboSupported := Load_GL_ARB_pixel_buffer_object()
+ // and Load_GL_ARB_vertex_buffer_object();
+ //Log.LogWarn('PBOSupported: ' + BoolToStr(PboSupported, true), 'LoadOpenGLExtensions');
+ PboSupported := false;
+end;
+
+const
+ 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);
+
+ { center window }
+ SDL_putenv('SDL_VIDEO_WINDOW_POS=center');
+ { workaround for buggy Intel 3D driver on Linux }
+ SDL_putenv('texture_tiling=false');
+
+ //Log.BenchmarkStart(2);
+
+ InitializeScreen;
+
+ //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 Finalize3D;
+begin
+ // TODO: finalize other stuff
+ UnloadFontTextures;
+ SDL_QuitSubSystem(SDL_INIT_VIDEO);
+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);
+ 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);
+ ScreenPartyRounds := TScreenPartyRounds.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen PartyRounds', 3); Log.BenchmarkStart(3);
+ ScreenStatMain := TScreenStatMain.Create;
+ Log.BenchmarkEnd(3); Log.LogBenchmark('====> Screen Stat Main', 3); Log.BenchmarkStart(3);
+ ScreenStatDetail := TScreenStatDetail.Create;
+ 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.Free;
+ ScreenName.Free;
+ ScreenLevel.Free;
+ ScreenSong.Free;
+ ScreenSing.Free;
+ ScreenScore.Free;
+ ScreenTop5.Free;
+ ScreenOptions.Free;
+ ScreenOptionsGame.Free;
+ ScreenOptionsGraphics.Free;
+ ScreenOptionsSound.Free;
+ ScreenOptionsLyrics.Free;
+// ScreenOptionsThemes.Free;
+ ScreenOptionsRecord.Free;
+ ScreenOptionsAdvanced.Free;
+ ScreenEditSub.Free;
+ ScreenEdit.Free;
+ ScreenEditConvert.Free;
+ ScreenOpen.Free;
+ //ScreenSingModi.Free;
+ ScreenSongMenu.Free;
+ ScreenSongJumpto.Free;
+ ScreenPopupCheck.Free;
+ ScreenPopupError.Free;
+ ScreenPopupInfo.Free;
+ ScreenPartyNewRound.Free;
+ ScreenPartyScore.Free;
+ ScreenPartyWin.Free;
+ ScreenPartyOptions.Free;
+ ScreenPartyPlayer.Free;
+ ScreenPartyRounds.Free;
+ ScreenStatMain.Free;
+ ScreenStatDetail.Free;
+end;
+
+end.
diff --git a/mediaplugin/src/base/UGraphicClasses.pas b/mediaplugin/src/base/UGraphicClasses.pas
new file mode 100644
index 00000000..cdaa238e
--- /dev/null
+++ b/mediaplugin/src/base/UGraphicClasses.pas
@@ -0,0 +1,720 @@
+{* 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 <blindy> ?? but if this is 0 they would be killed in the Manager at Draw
+ if (Live > 0) then
+ Dec(Live);
+
+ // animate frames
+ Frame := ( Frame + 1 ) mod 16;
+
+ // make our particles do funny stuff (besides being animated)
+ // changes of any particle-values throughout its life are done here
+ case StarType of
+ GoldenNote:
+ begin
+ Alpha := (-cos((Frame+1)*2*pi/16)+1); // neat fade-in-and-out
+ end;
+ PerfectNote:
+ begin
+ Alpha := (-cos((Frame+1)*2*pi/16)+1); // neat fade-in-and-out
+ end;
+ NoteHitTwinkle:
+ begin
+ Alpha := (Live/10); // linear fade-out
+ end;
+ PerfectLineTwinkle:
+ begin
+ Alpha := (-cos((Frame+1)*2*pi/16)+1); // neat fade-in-and-out
+ SizeMod := (-cos((Frame+1)*5*2*pi/16)*0.5+1.1);
+ // move around
+ X := X + mX;
+ Y := Y + mY;
+ end;
+ ColoredStar:
+ begin
+ Alpha := (-cos((Frame+1)*2*pi/16)+1); // neat fade-in-and-out
+ end;
+ Flare:
+ begin
+ Alpha := (-cos((Frame+1)/16*1.7*pi+0.3*pi)+1); // neat fade-in-and-out
+ SizeMod := (-cos((Frame+1)*5*2*pi/16)*0.5+1.1);
+ // move around
+ X := X + mX;
+ Y := Y + mY;
+ mY := mY+1.8;
+// mX := mX/2;
+ end;
+ end;
+end;
+
+procedure TParticle.Draw;
+var
+ L: cardinal;
+begin
+ if ScreenAct = Screen then
+ // this draws (multiple) texture(s) of our particle
+ for L := 0 to High(Col) do
+ begin
+ glColor4f(Col[L].r, Col[L].g, Col[L].b, Alpha);
+
+ glBindTexture(GL_TEXTURE_2D, Tex);
+ glEnable(GL_TEXTURE_2D);
+ glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
+ glEnable(GL_BLEND);
+
+ 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/mediaplugin/src/base/UImage.pas b/mediaplugin/src/base/UImage.pas
new file mode 100644
index 00000000..1866316e
--- /dev/null
+++ b/mediaplugin/src/base/UImage.pas
@@ -0,0 +1,1131 @@
+{* 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 UImage;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+uses
+ SDL,
+ UPath;
+
+{$DEFINE HavePNG}
+{$DEFINE HaveBMP}
+{$DEFINE HaveJPG}
+
+const
+ PixelFmt_RGBA: TSDL_Pixelformat = (
+ palette: nil;
+ BitsPerPixel: 32;
+ BytesPerPixel: 4;
+ Rloss: 0;
+ Gloss: 0;
+ Bloss: 0;
+ Aloss: 0;
+ Rshift: 0;
+ Gshift: 8;
+ Bshift: 16;
+ Ashift: 24;
+ Rmask: $000000ff;
+ Gmask: $0000ff00;
+ Bmask: $00ff0000;
+ Amask: $ff000000;
+ ColorKey: 0;
+ Alpha: 255
+ );
+
+ PixelFmt_RGB: TSDL_Pixelformat = (
+ palette: nil;
+ BitsPerPixel: 24;
+ BytesPerPixel: 3;
+ Rloss: 0;
+ Gloss: 0;
+ Bloss: 0;
+ Aloss: 0;
+ Rshift: 0;
+ Gshift: 8;
+ Bshift: 16;
+ Ashift: 0;
+ Rmask: $000000ff;
+ Gmask: $0000ff00;
+ Bmask: $00ff0000;
+ Amask: $00000000;
+ ColorKey: 0;
+ Alpha: 255
+ );
+
+ PixelFmt_BGRA: TSDL_Pixelformat = (
+ palette: nil;
+ BitsPerPixel: 32;
+ BytesPerPixel: 4;
+ Rloss: 0;
+ Gloss: 0;
+ Bloss: 0;
+ Aloss: 0;
+ Rshift: 16;
+ Gshift: 8;
+ Bshift: 0;
+ Ashift: 24;
+ Rmask: $00ff0000;
+ Gmask: $0000ff00;
+ Bmask: $000000ff;
+ Amask: $ff000000;
+ ColorKey: 0;
+ Alpha: 255
+ );
+
+ PixelFmt_BGR: TSDL_Pixelformat = (
+ palette: nil;
+ BitsPerPixel: 24;
+ BytesPerPixel: 3;
+ Rloss: 0;
+ Gloss: 0;
+ Bloss: 0;
+ Aloss: 0;
+ Rshift: 16;
+ Gshift: 8;
+ Bshift: 0;
+ Ashift: 0;
+ Rmask: $00ff0000;
+ Gmask: $0000ff00;
+ Bmask: $000000ff;
+ Amask: $00000000;
+ ColorKey: 0;
+ Alpha: 255
+ );
+
+type
+ TImagePixelFmt = (
+ ipfRGBA, ipfRGB, ipfBGRA, ipfBGR
+ );
+
+(*******************************************************
+ * Image saving
+ *******************************************************)
+
+{$IFDEF HavePNG}
+function WritePNGImage(const FileName: IPath; Surface: PSDL_Surface): boolean;
+{$ENDIF}
+{$IFDEF HaveBMP}
+function WriteBMPImage(const FileName: IPath; Surface: PSDL_Surface): boolean;
+{$ENDIF}
+{$IFDEF HaveJPG}
+function WriteJPGImage(const FileName: IPath; Surface: PSDL_Surface; Quality: integer): boolean;
+{$ENDIF}
+
+(*******************************************************
+ * Image loading
+ *******************************************************)
+
+function LoadImage(const Filename: IPath): PSDL_Surface;
+
+(*******************************************************
+ * Image manipulation
+ *******************************************************)
+
+function PixelFormatEquals(fmt1, fmt2: PSDL_PixelFormat): boolean;
+procedure ScaleImage(var ImgSurface: PSDL_Surface; Width, Height: cardinal);
+procedure FitImage(var ImgSurface: PSDL_Surface; Width, Height: cardinal);
+procedure ColorizeImage(ImgSurface: PSDL_Surface; NewColor: cardinal);
+
+implementation
+
+uses
+ SysUtils,
+ Classes,
+ Math,
+ {$IFDEF MSWINDOWS}
+ Windows,
+ {$ENDIF}
+ {$IFDEF HaveJPG}
+ {$IFDEF Delphi}
+ Graphics,
+ jpeg,
+ {$ELSE}
+ jpeglib,
+ jerror,
+ jcparam,
+ jdatadst, jcapimin, jcapistd,
+ {$ENDIF}
+ {$ENDIF}
+ {$IFDEF HavePNG}
+ png,
+ {$ENDIF}
+ zlib,
+ sdl_image,
+ sdlutils,
+ sdlstreams,
+ UCommon,
+ ULog;
+
+function IsRGBSurface(pixelFmt: PSDL_PixelFormat): boolean;
+begin
+ Result := (pixelFmt.BitsPerPixel = 24) and
+ (pixelFmt.RMask = $0000FF) and
+ (pixelFmt.GMask = $00FF00) and
+ (pixelFmt.BMask = $FF0000);
+end;
+
+function IsRGBASurface(pixelFmt: PSDL_PixelFormat): boolean;
+begin
+ Result := (pixelFmt.BitsPerPixel = 32) and
+ (pixelFmt.RMask = $000000FF) and
+ (pixelFmt.GMask = $0000FF00) and
+ (pixelFmt.BMask = $00FF0000) and
+ (pixelFmt.AMask = $FF000000);
+end;
+
+function IsBGRSurface(pixelFmt: PSDL_PixelFormat): boolean;
+begin
+ Result := (pixelFmt.BitsPerPixel = 24) and
+ (pixelFmt.BMask = $0000FF) and
+ (pixelFmt.GMask = $00FF00) and
+ (pixelFmt.RMask = $FF0000);
+end;
+
+function IsBGRASurface(pixelFmt: PSDL_PixelFormat): boolean;
+begin
+ Result := (pixelFmt.BitsPerPixel = 32) and
+ (pixelFmt.BMask = $000000FF) and
+ (pixelFmt.GMask = $0000FF00) and
+ (pixelFmt.RMask = $00FF0000) and
+ (pixelFmt.AMask = $FF000000);
+end;
+
+// Converts alpha-formats to BGRA, non-alpha to BGR, and leaves BGR(A) as is
+// sets converted to true if the surface needed to be converted
+function ConvertToBGR_BGRASurface(Surface: PSDL_Surface; out Converted: boolean): PSDL_Surface;
+var
+ pixelFmt: PSDL_PixelFormat;
+begin
+ pixelFmt := Surface.format;
+ if (IsBGRSurface(pixelFmt) or IsBGRASurface(pixelFmt)) then
+ begin
+ Converted := false;
+ Result := Surface;
+ end
+ else
+ begin
+ // invalid format -> needs conversion
+ if (pixelFmt.AMask <> 0) then
+ Result := SDL_ConvertSurface(Surface, @PixelFmt_BGRA, SDL_SWSURFACE)
+ else
+ Result := SDL_ConvertSurface(Surface, @PixelFmt_BGR, SDL_SWSURFACE);
+ Converted := true;
+ end;
+end;
+
+// Converts alpha-formats to RGBA, non-alpha to RGB, and leaves RGB(A) as is
+// sets converted to true if the surface needed to be converted
+function ConvertToRGB_RGBASurface(Surface: PSDL_Surface; out Converted: boolean): PSDL_Surface;
+var
+ pixelFmt: PSDL_PixelFormat;
+begin
+ pixelFmt := Surface.format;
+ if (IsRGBSurface(pixelFmt) or IsRGBASurface(pixelFmt)) then
+ begin
+ Converted := false;
+ Result := Surface;
+ end
+ else
+ begin
+ // invalid format -> needs conversion
+ if (pixelFmt.AMask <> 0) then
+ Result := SDL_ConvertSurface(Surface, @PixelFmt_RGBA, SDL_SWSURFACE)
+ else
+ Result := SDL_ConvertSurface(Surface, @PixelFmt_RGB, SDL_SWSURFACE);
+ Converted := true;
+ end;
+end;
+
+(*******************************************************
+ * Image saving
+ *******************************************************)
+
+(***************************
+ * PNG section
+ *****************************)
+
+{$IFDEF HavePNG}
+
+// delphi does not support setjmp()/longjmp() -> define our own error-handler
+procedure user_error_fn(png_ptr: png_structp; error_msg: png_const_charp); cdecl;
+begin
+ raise Exception.Create(error_msg);
+end;
+
+procedure user_read_data(png_ptr: png_structp; data: png_bytep; length: png_size_t); cdecl;
+var
+ inFile: TStream;
+begin
+ inFile := TStream(png_get_io_ptr(png_ptr));
+ inFile.Read(data^, length);
+end;
+
+procedure user_write_data(png_ptr: png_structp; data: png_bytep; length: png_size_t); cdecl;
+var
+ outFile: TStream;
+begin
+ outFile := TStream(png_get_io_ptr(png_ptr));
+ outFile.Write(data^, length);
+end;
+
+procedure user_flush_data(png_ptr: png_structp); cdecl;
+//var
+// outFile: TStream;
+begin
+ // binary files are flushed automatically, Flush() works with Text-files only
+ //outFile := TStream(png_get_io_ptr(png_ptr));
+ //outFile.Flush();
+end;
+
+procedure DateTimeToPngTime(time: TDateTime; var pngTime: png_time);
+var
+ year, month, day: word;
+ hour, minute, second, msecond: word;
+begin
+ DecodeDate(time, year, month, day);
+ pngTime.year := png_uint_16(year);
+ pngTime.month := png_byte(month);
+ pngTime.day := png_byte(day);
+ DecodeTime(time, hour, minute, second, msecond);
+ pngTime.hour := png_byte(hour);
+ pngTime.minute := png_byte(minute);
+ pngTime.second := png_byte(second);
+end;
+
+(*
+ * ImageData must be in RGB-format
+ *)
+function WritePNGImage(const FileName: IPath; Surface: PSDL_Surface): boolean;
+var
+ png_ptr: png_structp;
+ info_ptr: png_infop;
+ pngFile: TStream;
+ row: integer;
+ rowData: array of png_bytep;
+// rowStride: integer;
+ converted: boolean;
+ colorType: integer;
+// time: png_time;
+begin
+ Result := false;
+
+ // open file for writing
+ try
+ pngFile := TBinaryFileStream.Create(FileName, fmCreate);
+ except
+ Log.LogError('Could not open file: "' + FileName.ToNative + '"', 'WritePngImage');
+ Exit;
+ end;
+
+ // only 24bit (RGB) or 32bit (RGBA) data is supported, so convert to it
+ Surface := ConvertToRGB_RGBASurface(Surface, converted);
+
+ png_ptr := nil;
+
+ try
+ // initialize png (and enable a user-defined error-handler that throws an exception on error)
+ png_ptr := png_create_write_struct(PNG_LIBPNG_VER_STRING, nil, @user_error_fn, nil);
+ // the error-handler is called if png_create_write_struct() fails, so png_ptr should always be <> nil
+ if (png_ptr = nil) then
+ begin
+ Log.LogError('png_create_write_struct() failed', 'WritePngImage');
+ if (converted) then
+ SDL_FreeSurface(Surface);
+ Exit;
+ end;
+
+ info_ptr := png_create_info_struct(png_ptr);
+
+ if (Surface^.format^.BitsPerPixel = 24) then
+ colorType := PNG_COLOR_TYPE_RGB
+ else
+ colorType := PNG_COLOR_TYPE_RGBA;
+
+ // define write IO-functions (POSIX-style FILE-pointers are not available in Delphi)
+ png_set_write_fn(png_ptr, pngFile, @user_write_data, @user_flush_data);
+ png_set_IHDR(
+ png_ptr, info_ptr,
+ Surface.w, Surface.h,
+ 8,
+ colorType,
+ PNG_INTERLACE_NONE,
+ PNG_COMPRESSION_TYPE_DEFAULT,
+ PNG_FILTER_TYPE_DEFAULT
+ );
+
+ // TODO: do we need the modification time?
+ //DateTimeToPngTime(Now, time);
+ //png_set_tIME(png_ptr, info_ptr, @time);
+
+ if (SDL_MUSTLOCK(Surface)) then
+ SDL_LockSurface(Surface);
+
+ // setup data
+ SetLength(rowData, Surface.h);
+ for row := 0 to Surface.h-1 do
+ begin
+ // set rowData-elements to beginning of each image row
+ // Note: the byte-count of a row is pitch (which is not width*bitsPerPixel if the image is aligned)
+ rowData[row] := @PChar(Surface.pixels)[(Surface.h-row-1) * Surface.pitch];
+ end;
+
+ if (SDL_MUSTLOCK(Surface)) then
+ SDL_UnlockSurface(Surface);
+
+ png_write_info(png_ptr, info_ptr);
+ png_write_image(png_ptr, png_bytepp(rowData));
+ png_write_end(png_ptr, nil);
+
+ Result := true;
+ except on E: Exception do
+ Log.LogError(E.message, 'WritePngImage');
+ end;
+
+ // free row-data
+ SetLength(rowData, 0);
+
+ // free png-resources
+ if (png_ptr <> nil) then
+ png_destroy_write_struct(@png_ptr, nil);
+
+ if (converted) then
+ SDL_FreeSurface(Surface);
+
+ // close file
+ pngFile.Free;
+end;
+
+{$ENDIF}
+
+(***************************
+ * BMP section
+ *****************************)
+
+{$IFDEF HaveBMP}
+
+{$IFNDEF MSWINDOWS}
+const
+ (* constants for the biCompression field *)
+ BI_RGB = 0;
+ BI_RLE8 = 1;
+ BI_RLE4 = 2;
+ BI_BITFIELDS = 3;
+ BI_JPEG = 4;
+ BI_PNG = 5;
+
+type
+ BITMAPINFOHEADER = record
+ biSize: longword;
+ biWidth: longint;
+ biHeight: longint;
+ biPlanes: word;
+ biBitCount: word;
+ biCompression: longword;
+ biSizeImage: longword;
+ biXPelsPerMeter: longint;
+ biYPelsPerMeter: longint;
+ biClrUsed: longword;
+ biClrImportant: longword;
+ end;
+ LPBITMAPINFOHEADER = ^BITMAPINFOHEADER;
+ TBITMAPINFOHEADER = BITMAPINFOHEADER;
+ PBITMAPINFOHEADER = ^BITMAPINFOHEADER;
+
+ RGBTRIPLE = record
+ rgbtBlue: byte;
+ rgbtGreen: byte;
+ rgbtRed: byte;
+ end;
+ tagRGBTRIPLE = RGBTRIPLE;
+ TRGBTRIPLE = RGBTRIPLE;
+ PRGBTRIPLE = ^RGBTRIPLE;
+
+ RGBQUAD = record
+ rgbBlue: byte;
+ rgbGreen: byte;
+ rgbRed: byte;
+ rgbReserved: byte;
+ end;
+ tagRGBQUAD = RGBQUAD;
+ TRGBQUAD = RGBQUAD;
+ PRGBQUAD = ^RGBQUAD;
+
+ BITMAPINFO = record
+ bmiHeader: BITMAPINFOHEADER;
+ bmiColors: array[0..0] of RGBQUAD;
+ end;
+ LPBITMAPINFO = ^BITMAPINFO;
+ PBITMAPINFO = ^BITMAPINFO;
+ TBITMAPINFO = BITMAPINFO;
+
+ {$PACKRECORDS 2}
+ BITMAPFILEHEADER = record
+ bfType: word;
+ bfSize: longword;
+ bfReserved1: word;
+ bfReserved2: word;
+ bfOffBits: longword;
+ end;
+ {$PACKRECORDS DEFAULT}
+{$ENDIF}
+
+(*
+ * ImageData must be in BGR-format
+ *)
+function WriteBMPImage(const FileName: IPath; Surface: PSDL_Surface): boolean;
+var
+ bmpFile: TStream;
+ FileInfo: BITMAPINFOHEADER;
+ FileHeader: BITMAPFILEHEADER;
+ Converted: boolean;
+ Row: integer;
+ RowSize: integer;
+begin
+ Result := false;
+
+ // open file for writing
+ try
+ bmpFile := TBinaryFileStream.Create(FileName, fmCreate);
+ except
+ Log.LogError('Could not open file: "' + FileName.ToNative + '"', 'WriteBMPImage');
+ Exit;
+ end;
+
+ // only 24bit (BGR) or 32bit (BGRA) data is supported, so convert to it
+ Surface := ConvertToBGR_BGRASurface(Surface, Converted);
+
+ // aligned (4-byte) row-size in bytes
+ RowSize := ((Surface.w * Surface.format.BytesPerPixel + 3) div 4) * 4;
+
+ // initialize bitmap info
+ FillChar(FileInfo, SizeOf(BITMAPINFOHEADER), 0);
+ with FileInfo do
+ begin
+ biSize := SizeOf(BITMAPINFOHEADER);
+ biWidth := Surface.w;
+ biHeight := Surface.h;
+ biPlanes := 1;
+ biBitCount := Surface^.format^.BitsPerPixel;
+ biCompression := BI_RGB;
+ biSizeImage := RowSize * Surface.h;
+ end;
+
+ // initialize header-data
+ FillChar(FileHeader, SizeOf(BITMAPFILEHEADER), 0);
+ with FileHeader do
+ begin
+ bfType := $4D42; // = 'BM'
+ bfOffBits := SizeOf(BITMAPFILEHEADER) + SizeOf(BITMAPINFOHEADER);
+ bfSize := bfOffBits + FileInfo.biSizeImage;
+ end;
+
+ // and move the whole stuff into the file ;-)
+ try
+ // write headers
+ bmpFile.Write(FileHeader, SizeOf(BITMAPFILEHEADER));
+ bmpFile.Write(FileInfo, SizeOf(BITMAPINFOHEADER));
+
+ // write image-data
+
+ if (SDL_MUSTLOCK(Surface)) then
+ SDL_LockSurface(Surface);
+
+ // BMP needs 4-byte alignment
+ if (Surface.pitch mod 4 = 0) then
+ begin
+ // aligned correctly -> write whole image at once
+ bmpFile.Write(Surface.pixels^, FileInfo.biSizeImage);
+ end
+ else
+ begin
+ // misaligned -> write each line separately
+ // Note: for the last line unassigned memory (> last Surface.pixels element)
+ // will be copied to the padding area (last bytes of a row),
+ // but we do not care because the content of padding data is ignored anyhow.
+ for Row := 0 to Surface.h do
+ bmpFile.Write(PChar(Surface.pixels)[Row * Surface.pitch], RowSize);
+ end;
+
+ if (SDL_MUSTLOCK(Surface)) then
+ SDL_UnlockSurface(Surface);
+
+ Result := true;
+ finally
+ Log.LogError('Could not write file: "' + FileName.ToNative + '"', 'WriteBMPImage');
+ end;
+
+ if (Converted) then
+ SDL_FreeSurface(Surface);
+
+ // close file
+ bmpFile.Free;
+end;
+
+{$ENDIF}
+
+(***************************
+ * JPG section
+ *****************************)
+
+{$IFDEF HaveJPG}
+
+function WriteJPGImage(const FileName: IPath; Surface: PSDL_Surface; Quality: integer): boolean;
+var
+ {$IFDEF Delphi}
+ Bitmap: TBitmap;
+ BitmapInfo: TBitmapInfo;
+ Jpeg: TJpegImage;
+ row: integer;
+ FileStream: TBinaryFileStream;
+ {$ELSE}
+ cinfo: jpeg_compress_struct;
+ jerr : jpeg_error_mgr;
+ jpgFile: TBinaryFileStream;
+ rowPtr: array[0..0] of JSAMPROW;
+ {$ENDIF}
+ converted: boolean;
+begin
+ Result := false;
+
+ {$IFDEF Delphi}
+ // only 24bit (BGR) data is supported, so convert to it
+ if (IsBGRSurface(Surface.format)) then
+ converted := false
+ else
+ begin
+ Surface := SDL_ConvertSurface(Surface, @PixelFmt_BGR, SDL_SWSURFACE);
+ converted := true;
+ end;
+
+ // create and setup bitmap
+ Bitmap := TBitmap.Create;
+ Bitmap.PixelFormat := pf24bit;
+ Bitmap.Width := Surface.w;
+ Bitmap.Height := Surface.h;
+
+ // setup bitmap info on source image (Surface parameter)
+ ZeroMemory(@BitmapInfo, SizeOf(BitmapInfo));
+ with BitmapInfo.bmiHeader do
+ begin
+ biSize := SizeOf(BITMAPINFOHEADER);
+ biWidth := Surface.w;
+ biHeight := Surface.h;
+ biPlanes := 1;
+ biBitCount := 24;
+ biCompression := BI_RGB;
+ end;
+
+ if (SDL_MUSTLOCK(Surface)) then
+ SDL_LockSurface(Surface);
+
+ // use fast Win32-API functions to copy data instead of Bitmap.Canvas.Pixels
+ if (Surface.pitch mod 4 = 0) then
+ begin
+ // if the image is aligned (to a 4-byte boundary) -> copy all data at once
+ // Note: surfaces created with SDL (e.g. with SDL_ConvertSurface) are aligned
+ SetDIBits(0, Bitmap.Handle, 0, Bitmap.Height, Surface.pixels, BitmapInfo, DIB_RGB_COLORS);
+ end
+ else
+ begin
+ // wrong alignment -> copy each line separately.
+ // Note: for the last line unassigned memory (> last Surface.pixels element)
+ // will be copied to the padding area (last bytes of a row),
+ // but we do not care because the content of padding data is ignored anyhow.
+ for row := 0 to Surface.h do
+ begin
+ SetDIBits(0, Bitmap.Handle, row, 1, @PChar(Surface.pixels)[row * Surface.pitch],
+ BitmapInfo, DIB_RGB_COLORS);
+ end;
+ end;
+
+ if (SDL_MUSTLOCK(Surface)) then
+ SDL_UnlockSurface(Surface);
+
+ // assign Bitmap to JPEG and store the latter
+ try
+ // init with nil so Free() will not fail if an exception occurs
+ Jpeg := nil;
+ Bitmap := nil;
+ FileStream := nil;
+
+ try
+ Jpeg := TJPEGImage.Create;
+ Jpeg.Assign(Bitmap);
+
+ // compress image (don't forget this line, otherwise it won't be compressed)
+ Jpeg.CompressionQuality := Quality;
+ Jpeg.Compress();
+
+ // Note: FileStream needed for unicode filename support
+ FileStream := TBinaryFileStream.Create(Filename, fmCreate);
+ Jpeg.SaveToStream(FileStream);
+ finally
+ FileStream.Free;
+ Bitmap.Free;
+ Jpeg.Free;
+ end;
+ except
+ Log.LogError('Could not save file: "' + FileName.ToNative + '"', 'WriteJPGImage');
+ Exit;
+ end;
+ {$ELSE}
+ // based on example.pas in FPC's packages/base/pasjpeg directory
+
+ // only 24bit (RGB) data is supported, so convert to it
+ if (IsRGBSurface(Surface.format)) then
+ converted := false
+ else
+ begin
+ Surface := SDL_ConvertSurface(Surface, @PixelFmt_RGB, SDL_SWSURFACE);
+ converted := true;
+ end;
+
+ // allocate and initialize JPEG compression object
+ cinfo.err := jpeg_std_error(jerr);
+ // msg_level that will be displayed. (Nomssi)
+ //jerr.trace_level := 3;
+ // initialize the JPEG compression object
+ jpeg_create_compress(@cinfo);
+
+ // open file for writing
+ try
+ jpgFile := TBinaryFileStream.Create(FileName, fmCreate);
+ except
+ Log.LogError('Could not open file: "' + FileName.ToNative + '"', 'WriteJPGImage');
+ Exit;
+ end;
+
+ // specify data destination
+ jpeg_stdio_dest(@cinfo, @jpgFile);
+
+ // set parameters for compression
+ cinfo.image_width := Surface.w;
+ cinfo.image_height := Surface.h;
+ cinfo.in_color_space := JCS_RGB;
+ cinfo.input_components := 3;
+ cinfo.data_precision := 8;
+
+ // set default compression parameters
+ jpeg_set_defaults(@cinfo);
+ jpeg_set_quality(@cinfo, quality, true);
+
+ // start compressor
+ jpeg_start_compress(@cinfo, true);
+
+ if (SDL_MUSTLOCK(Surface)) then
+ SDL_LockSurface(Surface);
+
+ while (cinfo.next_scanline < cinfo.image_height) do
+ begin
+ // Note: the byte-count of a row is pitch (which is not width*bitsPerPixel if the image is aligned)
+ rowPtr[0] := JSAMPROW(@PChar(Surface.pixels)[(Surface.h-cinfo.next_scanline-1) * Surface.pitch]);
+ jpeg_write_scanlines(@cinfo, JSAMPARRAY(@rowPtr), 1);
+ end;
+
+ if (SDL_MUSTLOCK(Surface)) then
+ SDL_UnlockSurface(Surface);
+
+ // finish compression
+ jpeg_finish_compress(@cinfo);
+ // close the output file
+ jpgFile.Free;
+
+ // release JPEG compression object
+ jpeg_destroy_compress(@cinfo);
+ {$ENDIF}
+
+ if (converted) then
+ SDL_FreeSurface(Surface);
+
+ Result := true;
+end;
+
+{$ENDIF}
+
+(*******************************************************
+ * Image loading
+ *******************************************************)
+
+(*
+ * Loads an image from the given file
+ *)
+function LoadImage(const Filename: IPath): PSDL_Surface;
+var
+ FilenameCaseAdj: IPath;
+ FileStream: TBinaryFileStream;
+ SDLStream: PSDL_RWops;
+begin
+ Result := nil;
+
+ // try to adjust filename's case and check if it exists
+ FilenameCaseAdj := Filename.AdjustCase(false);
+ if (not FilenameCaseAdj.IsFile) then
+ begin
+ Log.LogError('Image-File does not exist "' + FilenameCaseAdj.ToNative + '"', 'LoadImage');
+ Exit;
+ end;
+
+ // load from file
+ try
+ SDLStream := SDLStreamSetup(TBinaryFileStream.Create(FilenameCaseAdj, fmOpenRead));
+ Result := IMG_Load_RW(SDLStream, 1);
+ // Note: TBinaryFileStream is freed by SDLStream. SDLStream by IMG_Load_RW().
+ except
+ Log.LogError('Could not load from file "' + FilenameCaseAdj.ToNative + '"', 'LoadImage');
+ Exit;
+ end;
+end;
+
+(*******************************************************
+ * Image manipulation
+ *******************************************************)
+
+function PixelFormatEquals(fmt1, fmt2: PSDL_PixelFormat): boolean;
+begin
+ Result :=
+ (fmt1^.BitsPerPixel = fmt2^.BitsPerPixel) and
+ (fmt1^.BytesPerPixel = fmt2^.BytesPerPixel) and
+ (fmt1^.Rloss = fmt2^.Rloss) and (fmt1^.Gloss = fmt2^.Gloss) and (fmt1^.Bloss = fmt2^.Bloss) and
+ (fmt1^.Rmask = fmt2^.Rmask) and (fmt1^.Gmask = fmt2^.Gmask) and (fmt1^.Bmask = fmt2^.Bmask) and
+ (fmt1^.Rshift = fmt2^.Rshift) and (fmt1^.Gshift = fmt2^.Gshift) and (fmt1^.Bshift = fmt2^.Bshift)
+ ;
+end;
+
+procedure ScaleImage(var ImgSurface: PSDL_Surface; Width, Height: cardinal);
+var
+ TempSurface: PSDL_Surface;
+begin
+ TempSurface := ImgSurface;
+ ImgSurface := SDL_ScaleSurfaceRect(TempSurface,
+ 0, 0, TempSurface^.W,TempSurface^.H,
+ Width, Height);
+ SDL_FreeSurface(TempSurface);
+end;
+
+procedure FitImage(var ImgSurface: PSDL_Surface; Width, Height: cardinal);
+var
+ TempSurface: PSDL_Surface;
+ ImgFmt: PSDL_PixelFormat;
+begin
+ TempSurface := ImgSurface;
+
+ // create a new surface with given width and height
+ ImgFmt := TempSurface^.format;
+ ImgSurface := SDL_CreateRGBSurface(
+ SDL_SWSURFACE, Width, Height, ImgFmt^.BitsPerPixel,
+ ImgFmt^.RMask, ImgFmt^.GMask, ImgFmt^.BMask, ImgFmt^.AMask);
+
+ // copy image from temp- to new surface
+ SDL_SetAlpha(ImgSurface, 0, 255);
+ SDL_SetAlpha(TempSurface, 0, 255);
+ SDL_BlitSurface(TempSurface, nil, ImgSurface, nil);
+
+ SDL_FreeSurface(TempSurface);
+end;
+
+(*
+// Old slow floating point version of ColorizeTexture.
+// For an easier understanding of the faster fixed point version below.
+procedure ColorizeTexture(TexSurface: PSDL_Surface; Col: cardinal);
+var
+ clr: array[0..2] of double; // [0: R, 1: G, 2: B]
+ hsv: array[0..2] of double; // [0: H(ue), 1: S(aturation), 2: V(alue)]
+ delta, f, p, q, t: double;
+ max: double;
+begin
+ clr[0] := PixelColors[0]/255;
+ clr[1] := PixelColors[1]/255;
+ clr[2] := PixelColors[2]/255;
+ max := maxvalue(clr);
+ delta := max - minvalue(clr);
+
+ hsv[0] := DestinationHue; // set H(ue)
+ hsv[2] := max; // set V(alue)
+ // calc S(aturation)
+ if (max = 0.0) then
+ hsv[1] := 0.0
+ else
+ hsv[1] := delta/max;
+
+ //ColorizePixel(PByteArray(Pixel), DestinationHue);
+ h_int := trunc(hsv[0]); // h_int = |_h_|
+ f := hsv[0]-h_int; // f = h-h_int
+ p := hsv[2]*(1.0-hsv[1]); // p = v*(1-s)
+ q := hsv[2]*(1.0-(hsv[1]*f)); // q = v*(1-s*f)
+ t := hsv[2]*(1.0-(hsv[1]*(1.0-f))); // t = v*(1-s*(1-f))
+ case h_int of
+ 0: begin clr[0] := hsv[2]; clr[1] := t; clr[2] := p; end; // (v,t,p)
+ 1: begin clr[0] := q; clr[1] := hsv[2]; clr[2] := p; end; // (q,v,p)
+ 2: begin clr[0] := p; clr[1] := hsv[2]; clr[2] := t; end; // (p,v,t)
+ 3: begin clr[0] := p; clr[1] := q; clr[2] := hsv[2]; end; // (p,q,v)
+ 4: begin clr[0] := t; clr[1] := p; clr[2] := hsv[2]; end; // (t,p,v)
+ 5: begin clr[0] := hsv[2]; clr[1] := p; clr[2] := q; end; // (v,p,q)
+ end;
+
+ // and store new rgb back into the image
+ PixelColors[0] := trunc(255*clr[0]);
+ PixelColors[1] := trunc(255*clr[1]);
+ PixelColors[2] := trunc(255*clr[2]);
+end;
+*)
+
+procedure ColorizeImage(ImgSurface: PSDL_Surface; NewColor: longword);
+
+ // First, the rgb colors are converted to hsv, second hue is replaced by
+ // the NewColor, saturation and value remain unchanged, finally this
+ // hsv color is converted back to rgb space.
+ // For the conversion algorithms of colors from rgb to hsv space
+ // and back simply check the wikipedia.
+ // In order to speed up starting time of USDX the division of reals is
+ // replaced by division of longints, shifted by 10 bits to keep
+ // digits.
+
+ // The use of longwards leeds to some type size mismatch warnings
+ // whenever differences are formed.
+ // This should not be a problem, since the results should all be positive.
+ // replacing longword by longint would probably resolve this cosmetic fault :-)
+
+ function ColorToHue(const Color: longword): longword;
+ // returns hue within the range [0.0-6.0] but shl 10, ie. times 1024
+ var
+ Red, Green, Blue: longint;
+ Min, Max, Delta: longint;
+ Hue: double;
+ begin
+ // extract the colors
+ // division by 255 is omitted, since it is implicitly done
+ // when deviding by delta
+ Red := ((Color and $ff0000) shr 16); // R
+ Green := ((Color and $ff00) shr 8); // G
+ Blue := (Color and $ff) ; // B
+
+ Min := Red;
+ if Green < Min then Min := Green;
+ if Blue < Min then Min := Blue;
+
+ Max := Red;
+ if Green > Max then Max := Green;
+ if Blue > Max then Max := Blue;
+
+ // calc hue
+ Delta := Max - Min; // This gives a type size mismatch warning, because Delta is longword, ie. >= 0
+ // But the assignments above are easy enough to be sure, that Max - Min is >= 0.
+ if (Delta = 0) then
+ Result := 0
+ else
+ begin
+ // The division by Delta is done separately afterwards.
+ // Necessary because Delphi did not do the type conversion from
+ // longword to double as expected.
+ // After the change to longint, we may not need it, but left for now
+ // Something to check
+ if (Max = Red ) then Hue := Green - Blue
+ else if (Max = Green) then Hue := 2.0*Delta + Blue - Red
+ else if (Max = Blue ) then Hue := 4.0*Delta + Red - Green;
+ Hue := Hue / Delta;
+ if (Hue < 0.0) then
+ Hue := Hue + 6.0;
+ Result := trunc(Hue*1024); // '*1024' is shl 10
+ // if NewColor = $000000 then
+ // Log.LogError ('Hue: ' + FloatToStr(Hue), 'ColorToHue');
+ end;
+ end;
+
+var
+ PixelIndex: longword;
+ Pixel: PByte;
+ PixelColors: PByteArray;
+ Red, Green, Blue: longword;
+ Hue, Sat: longword;
+ Min, Max, Delta: longword;
+ HueInteger: longword;
+ f, p, q, t: longword;
+ GreyReal: real;
+ Grey: byte;
+begin
+
+ Pixel := ImgSurface^.Pixels;
+
+ // check of the size of a pixel in bytes.
+ // It should be always 4, but this
+ // additional safeguard will show,
+ // whether something went wrong up to here.
+
+ if ImgSurface^.format.BytesPerPixel <> 4 then
+ Log.LogError ('ColorizeImage: The pixel size should be 4, but it is '
+ + IntToStr(ImgSurface^.format.BytesPerPixel));
+
+ // Check whether the new color is white, grey or black,
+ // because a greyscale must be created in a different
+ // way.
+
+ Red := ((NewColor and $ff0000) shr 16); // R
+ Green := ((NewColor and $ff00) shr 8); // G
+ Blue := (NewColor and $ff) ; // B
+
+ if (Red = Green) and (Green = Blue) then // greyscale image
+ begin
+ // According to these recommendations (ITU-R BT.709-5)
+ // the conversion parameters for rgb to greyscale are
+ // 0.299, 0.587, 0.114
+ for PixelIndex := 0 to (ImgSurface^.W * ImgSurface^.H)-1 do
+ begin
+ PixelColors := PByteArray(Pixel);
+ {$IFDEF FPC_BIG_ENDIAN}
+ GreyReal := 0.299*PixelColors[3] + 0.587*PixelColors[2] + 0.114*PixelColors[1];
+ // PixelColors[0] is alpha and remains untouched
+ {$ELSE}
+ GreyReal := 0.299*PixelColors[0] + 0.587*PixelColors[1] + 0.114*PixelColors[2];
+ // PixelColors[3] is alpha and remains untouched
+ {$ENDIF}
+ Grey := round(GreyReal);
+ {$IFDEF FPC_BIG_ENDIAN}
+ PixelColors[3] := Grey;
+ PixelColors[2] := Grey;
+ PixelColors[1] := Grey;
+ // PixelColors[0] is alpha and remains untouched
+ {$ELSE}
+ PixelColors[0] := Grey;
+ PixelColors[1] := Grey;
+ PixelColors[2] := Grey;
+ // PixelColors[3] is alpha and remains untouched
+ {$ENDIF}
+ Inc(Pixel, ImgSurface^.format.BytesPerPixel);
+ end;
+ exit; // we are done with a greyscale image.
+ end;
+
+ Hue := ColorToHue(NewColor); // Hue is shl 10
+ f := Hue and $3ff; // f is the dezimal part of hue
+ HueInteger := Hue shr 10;
+
+ for PixelIndex := 0 to (ImgSurface^.W * ImgSurface^.H)-1 do
+ begin
+ PixelColors := PByteArray(Pixel);
+ // inlined colorize per pixel
+
+ // uses fixed point math
+ // shl 10 is used for divisions
+
+ // get color values
+
+ {$IFDEF FPC_BIG_ENDIAN}
+ Red := PixelColors[3];
+ Green := PixelColors[2];
+ Blue := PixelColors[1];
+ // PixelColors[0] is alpha and remains untouched
+ {$ELSE}
+ Red := PixelColors[0];
+ Green := PixelColors[1];
+ Blue := PixelColors[2];
+ // PixelColors[3] is alpha and remains untouched
+ {$ENDIF}
+
+ //calculate luminance and saturation from rgb
+
+ Max := Red;
+ if Green > Max then Max := Green;
+ if Blue > Max then Max := Blue ;
+
+ if (Max = 0) then // the color is black
+ begin
+ {$IFDEF FPC_BIG_ENDIAN}
+ PixelColors[3] := 0;
+ PixelColors[2] := 0;
+ PixelColors[1] := 0;
+ {$ELSE}
+ PixelColors[0] := 0;
+ PixelColors[1] := 0;
+ PixelColors[2] := 0;
+ {$ENDIF}
+ end
+ else
+ begin
+ Min := Red;
+ if Green < Min then Min := Green;
+ if Blue < Min then Min := Blue ;
+
+ if (Min = 255) then // the color is white
+ begin
+ {$IFDEF FPC_BIG_ENDIAN}
+ PixelColors[3] := 255;
+ PixelColors[2] := 255;
+ PixelColors[1] := 255;
+ {$ELSE}
+ PixelColors[0] := 255;
+ PixelColors[1] := 255;
+ PixelColors[2] := 255;
+ {$ENDIF}
+ end
+ else // all colors except black and white
+ begin
+ Delta := Max - Min; // This gives a type size mismatch warning, because Delta is longword, ie. >= 0
+ // But the assignments above are easy enough to be sure, that Max - Min is >= 0.
+ Sat := (Delta shl 10) div Max; // shl 10
+
+ // shr 10 corrects that Sat and f are shl 10
+ // the resulting p, q and t are unshifted
+
+ p := (Max * (1024 - Sat )) shr 10;
+ q := (Max * (1024 - (Sat * f ) shr 10)) shr 10;
+ t := (Max * (1024 - (Sat * (1024 - f)) shr 10)) shr 10;
+
+ // The above 3 lines give type size mismatch warning, but all variables are longword and the ranges should be ok.
+
+ case HueInteger of
+ 0: begin Red := Max; Green := t; Blue := p; end; // (v,t,p)
+ 1: begin Red := q; Green := Max; Blue := p; end; // (q,v,p)
+ 2: begin Red := p; Green := Max; Blue := t; end; // (p,v,t)
+ 3: begin Red := p; Green := q; Blue := Max; end; // (p,q,v)
+ 4: begin Red := t; Green := p; Blue := Max; end; // (t,p,v)
+ 5: begin Red := Max; Green := p; Blue := q; end; // (v,p,q)
+ end;
+
+ {$IFDEF FPC_BIG_ENDIAN}
+ PixelColors[3] := byte(Red);
+ PixelColors[2] := byte(Green);
+ PixelColors[1] := byte(Blue);
+ {$ELSE}
+ PixelColors[0] := byte(Red);
+ PixelColors[1] := byte(Green);
+ PixelColors[2] := byte(Blue);
+ {$ENDIF}
+
+ end;
+ end;
+
+ Inc(Pixel, ImgSurface^.format.BytesPerPixel);
+ end;
+end;
+
+end.
diff --git a/mediaplugin/src/base/UIni.pas b/mediaplugin/src/base/UIni.pas
new file mode 100644
index 00000000..beb9faa8
--- /dev/null
+++ b/mediaplugin/src/base/UIni.pas
@@ -0,0 +1,1232 @@
+{* 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,
+ UCommon,
+ 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.
+ *}
+ PInputDeviceConfig = ^TInputDeviceConfig;
+ TInputDeviceConfig = record
+ Name: string; //**< Name of the input device
+ Input: integer; //**< Index of the input source to use for recording
+ Latency: integer; //**< Latency in ms, or LATENCY_AUTODETECT for default
+
+ {**
+ * Mapping of recording channels to players, e.g. ChannelToPlayerMap[0] = 2
+ * maps the channel 0 (left) to player 2.
+ * A player index of 0 (CHANNEL_OFF) means that the channel is not assigned
+ * to any player (the channel is off).
+ *}
+ ChannelToPlayerMap: array of integer;
+ end;
+
+{* Constants for TInputDeviceConfig *}
+const
+ CHANNEL_OFF = 0; // for field ChannelToPlayerMap
+ LATENCY_AUTODETECT = -1; // for field Latency
+
+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 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;
+ VideoPreview: integer;
+ VideoEnabled: integer;
+
+ // Sound
+ MicBoost: integer;
+ ClickAssist: integer;
+ BeatClick: integer;
+ SavePlayback: integer;
+ ThresholdIndex: integer;
+ AudioOutputBufferSizeIndex: integer;
+ VoicePassthrough: integer;
+
+ SyncTo: integer;
+
+ //Song Preview
+ PreviewVolume: integer;
+ PreviewFading: integer;
+
+ // Lyrics
+ LyricsFont: integer;
+ LyricsEffect: 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;
+
+ // default encoding for texts (lyrics, song-name, ...)
+ DefaultEncoding: TEncoding;
+
+ procedure Load();
+ procedure Save();
+ procedure SaveNames;
+ procedure SaveLevel;
+ end;
+
+var
+ Ini: TIni;
+ IResolution: TUTF8StringDynArray;
+ ILanguage: TUTF8StringDynArray;
+ ITheme: TUTF8StringDynArray;
+ ISkin: TUTF8StringDynArray;
+
+{*
+ * Options
+ *}
+
+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');
+
+const
+ ISorting: array[0..6] of UTF8String = ('Edition', 'Genre', 'Language', 'Folder', 'Title', 'Artist', 'Artist2');
+type
+ TSortingType = (sEdition, sGenre, sLanguage, sFolder, sTitle, sArtist, sArtist2);
+
+const
+ 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]');
+ IVideoPreview: array[0..1] of UTF8String = ('Off', 'On');
+ IVideoEnabled: array[0..1] of UTF8String = ('Off', 'On');
+
+ IClickAssist: array[0..1] of UTF8String = ('Off', 'On');
+ IBeatClick: array[0..1] of UTF8String = ('Off', 'On');
+ ISavePlayback: array[0..1] of UTF8String = ('Off', 'On');
+
+ IThreshold: array[0..3] of 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');
+
+const
+ ISyncTo: array[0..2] of UTF8String = ('Music', 'Lyrics', 'Off');
+type
+ TSyncToType = (stMusic, stLyrics, stOff);
+
+const
+ IAudioOutputBufferSize: array[0..9] of UTF8String = ('Auto', '256', '512', '1024', '2048', '4096', '8192', '16384', '32768', '65536');
+ IAudioOutputBufferSizeVals: array[0..9] of integer = ( 0, 256, 512 , 1024 , 2048 , 4096 , 8192 , 16384 , 32768 , 65536 );
+
+ IAudioInputBufferSize: array[0..9] of 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');
+ 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');
+
+{*
+ * Translated options
+ *}
+
+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]');
+ IVideoPreviewTranslated: array[0..1] of UTF8String = ('Off', 'On');
+ IVideoEnabledTranslated: array[0..1] of UTF8String = ('Off', 'On');
+
+ 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');
+
+ ISyncToTranslated: array[0..2] of UTF8String = ('Music', 'Lyrics', 'Off');
+
+ //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');
+ 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,
+ UThemes,
+ 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');
+
+ IVideoPreviewTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF');
+ IVideoPreviewTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_ON');
+
+ IVideoEnabledTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_OFF');
+ IVideoEnabledTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_ON');
+
+ 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');
+
+ ISyncToTranslated[Ord(stMusic)] := ULanguage.Language.Translate('OPTION_VALUE_MUSIC');
+ ISyncToTranslated[Ord(stLyrics)] := ULanguage.Language.Translate('OPTION_VALUE_LYRICS');
+ ISyncToTranslated[Ord(stOff)] := ULanguage.Language.Translate('OPTION_VALUE_OFF');
+
+ ILyricsFontTranslated[0] := ULanguage.Language.Translate('OPTION_VALUE_PLAIN');
+ ILyricsFontTranslated[1] := ULanguage.Language.Translate('OPTION_VALUE_OLINE1');
+ ILyricsFontTranslated[2] := ULanguage.Language.Translate('OPTION_VALUE_OLINE2');
+
+ 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');
+
+ 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;
+
+(**
+ * 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
+ Continue;
+
+ // 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);
+ DeviceCfg.Latency := IniFile.ReadInteger('Record', Format('Latency[%d]', [DeviceIndex]), LATENCY_AUTODETECT);
+
+ // find the largest channel-number of the current device in the ini-file
+ ChannelCount := GetMaxKeyIndex(RecordKeys, 'Channel', Format('[%d]', [DeviceIndex]));
+ 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]), CHANNEL_OFF);
+ 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);
+ IniFile.WriteInteger('Record', Format('Latency[%d]', [DeviceIndex+1]),
+ InputDeviceConfig[DeviceIndex].Latency);
+
+ // 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);
+begin
+ // 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[UThemes.Theme.Themes[Theme].DefaultSkin]));
+
+ { there may be a not existing skin in the ini file
+ e.g. due to manual edit or corrupted file.
+ in this case we load the first Skin }
+ if SkinNo = -1 then
+ SkinNo := 0;
+
+ // Color
+ Color := GetArrayIndex(IColor, IniFile.ReadString('Themes', 'Color', IColor[Skin.GetDefaultColor(SkinNo)]));
+end;
+
+procedure TIni.LoadScreenModes(IniFile: TCustomIniFile);
+
+ // swap two strings
+ procedure swap(var s1, s2: 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, 18);
+ IResolution[0] := '640x480';
+ IResolution[1] := '800x600';
+ IResolution[2] := '1024x768';
+ IResolution[3] := '1152x666';;
+ IResolution[4] := '1152x864';
+ IResolution[5] := '1280x800';
+ IResolution[6] := '1280x960';
+ IResolution[7] := '1280x1024';
+ IResolution[8] := '1366x768';
+ IResolution[9] := '1400x1050';
+ IResolution[10] := '1440x900';
+ IResolution[11] := '1600x900';
+ IResolution[12] := '1600x1200';
+ IResolution[13] := '1680x1050';
+ IResolution[14] := '1920x1080';
+ IResolution[15] := '1920x1200';
+ IResolution[16] := '2048x1152';
+ IResolution[17] := '2560x1600';
+
+ Resolution := GetArrayIndex(IResolution, IniFile.ReadString('Graphics', 'Resolution', '800x600'));
+ if Resolution = -1 then
+ 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 div (Screens+1)) + '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[Ord(sEdition)]));
+
+ // Debug
+ Debug := GetArrayIndex(IDebug, IniFile.ReadString('Game', 'Debug', IDebug[0]));
+
+ LoadScreenModes(IniFile);
+
+ // TextureSize (aka CachedCoverSize)
+ TextureSize := GetArrayIndex(ITextureSize, IniFile.ReadString('Graphics', 'TextureSize', '256'));
+
+ // 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]));
+
+ // VideoPreview
+ VideoPreview := GetArrayIndex(IVideoPreview, IniFile.ReadString('Graphics', 'VideoPreview', IVideoPreview[1]));
+
+ // VideoEnabled
+ VideoEnabled := GetArrayIndex(IVideoEnabled, IniFile.ReadString('Graphics', 'VideoEnabled', IVideoEnabled[1]));
+
+ // 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[4]));
+
+ // NoteLines
+ NoteLines := GetArrayIndex(INoteLines, IniFile.ReadString('Lyrics', 'NoteLines', INoteLines[1]));
+
+ // DefaultEncoding
+ DefaultEncoding := ParseEncoding(IniFile.ReadString('Lyrics', 'Encoding', ''), encAuto);
+
+ LoadThemes(IniFile);
+
+ LoadInputDeviceCfg(IniFile);
+
+ // LoadAnimation
+ LoadAnimation := GetArrayIndex(ILoadAnimation, IniFile.ReadString('Advanced', 'LoadAnimation', 'On'));
+
+ // ScreenFade
+ ScreenFade := GetArrayIndex(IScreenFade, IniFile.ReadString('Advanced', 'ScreenFade', 'On'));
+
+ // Visualizations
+ // <mog> this could be of use later..
+ // VisualizerOption :=
+ // TVisualizerOption(GetEnumValue(TypeInfo(TVisualizerOption),
+ // IniFile.ReadString('Graphics', 'Visualization', 'Off')));
+ // || VisualizerOption := TVisualizerOption(GetArrayIndex(IVisualizer, IniFile.ReadString('Graphics', 'Visualization', 'Off')));
+ VisualizerOption := GetArrayIndex(IVisualizer, IniFile.ReadString('Graphics', 'Visualization', 'Off'));
+
+{**
+ * Background music
+ *}
+ BackgroundMusicOption := GetArrayIndex(IBackgroundMusic, IniFile.ReadString('Sound', 'BackgroundMusic', 'On'));
+
+ // 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'));
+
+ // SyncTo
+ SyncTo := GetArrayIndex(ISyncTo, IniFile.ReadString('Advanced', 'SyncTo', ISyncTo[Ord(stMusic)]));
+
+ // 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]);
+
+ // VideoPreview
+ IniFile.WriteString('Graphics', 'VideoPreview', IVideoPreview[VideoPreview]);
+
+ // VideoEnabled
+ IniFile.WriteString('Graphics', 'VideoEnabled', IVideoEnabled[VideoEnabled]);
+
+ // 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]);
+
+ // NoteLines
+ IniFile.WriteString('Lyrics', 'NoteLines', INoteLines[NoteLines]);
+
+ //Encoding default
+ IniFile.WriteString('Lyrics', 'Encoding', EncodingName(DefaultEncoding));
+
+ // 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]);
+
+ //SyncTo
+ IniFile.WriteString('Advanced', 'SyncTo', ISyncTo[SyncTo]);
+
+ // 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/mediaplugin/src/base/UJoystick.pas b/mediaplugin/src/base/UJoystick.pas
new file mode 100644
index 00000000..30808812
--- /dev/null
+++ b/mediaplugin/src/base/UJoystick.pas
@@ -0,0 +1,312 @@
+{* 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/mediaplugin/src/base/ULanguage.pas b/mediaplugin/src/base/ULanguage.pas
new file mode 100644
index 00000000..5f8a2692
--- /dev/null
+++ b/mediaplugin/src/base/ULanguage.pas
@@ -0,0 +1,302 @@
+{* 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 ULanguage;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+uses
+ UUnicodeUtils;
+
+type
+ TLanguageEntry = record
+ ID: AnsiString; //**< identifier (ASCII)
+ Text: UTF8String; //**< translation (UTF-8)
+ end;
+
+ TLanguageList = record
+ Name: AnsiString; //**< language name (ASCII)
+ end;
+
+ TLanguageEntryArray = array of TLanguageEntry;
+
+ TLanguage = class
+ private
+ List: array of TLanguageList;
+
+ Entry: TLanguageEntryArray; //**< Entrys of Chosen Language
+ EntryDefault: TLanguageEntryArray; //**< Entrys of Standard Language
+ EntryConst: TLanguageEntryArray; //**< Constant Entrys e.g. Version
+
+ Implode_Glue1, Implode_Glue2: UTF8String;
+
+ procedure LoadList;
+ function FindID(const ID: AnsiString; const EntryList: TLanguageEntryArray): integer;
+
+ public
+ constructor Create;
+ function Translate(const Text: RawByteString): UTF8String;
+ procedure ChangeLanguage(const Language: AnsiString);
+ procedure AddConst(const ID: AnsiString; const Text: UTF8String);
+ procedure ChangeConst(const ID: AnsiString; const Text: UTF8String);
+ function Implode(const Pieces: array of UTF8String): UTF8String;
+ end;
+
+var
+ Language: TLanguage;
+
+implementation
+
+uses
+ UMain,
+ UIni,
+ IniFiles,
+ Classes,
+ SysUtils,
+ ULog,
+ UPath,
+ UFilesystem,
+ UPathUtils;
+
+{**
+ * LoadList, set default language, set standard implode glues
+ *}
+constructor TLanguage.Create;
+var
+ I, J: Integer;
+begin
+ inherited;
+
+ LoadList;
+
+ //Set Implode Glues for Backward Compatibility
+ Implode_Glue1 := ', ';
+ Implode_Glue2 := ' and ';
+
+ if (Length(List) = 0) then //No Language Files Loaded -> Abort Loading
+ Log.CriticalError('Could not load any Language File');
+
+ //Standard Language (If a Language File is Incomplete)
+ //Then use English Language
+ for I := 0 to high(List) do //Search for English Language
+ begin
+ //English Language Found -> Load
+ if Uppercase(List[I].Name) = 'ENGLISH' then
+ begin
+ ChangeLanguage('English');
+
+ SetLength(EntryDefault, Length(Entry));
+ for J := 0 to high(Entry) do
+ EntryDefault[J] := Entry[J];
+
+ SetLength(Entry, 0);
+
+ Break;
+ end;
+
+ if (I = high(List)) then
+ Log.LogError('English Languagefile missing! No standard Translation loaded');
+ end;
+ //Standard Language END
+
+end;
+
+{**
+ * Parse the Language Dir searching Translations
+ *}
+procedure TLanguage.LoadList;
+var
+ Iter: IFileIterator;
+ IniInfo: TFileInfo;
+ LangName: string;
+begin
+ SetLength(List, 0);
+ SetLength(ILanguage, 0);
+
+ Iter := FileSystem.FileFind(LanguagesPath.Append('*.ini'), 0);
+ while(Iter.HasNext) do
+ begin
+ IniInfo := Iter.Next;
+
+ LangName := IniInfo.Name.SetExtension('').ToUTF8;
+
+ SetLength(List, Length(List)+1);
+ List[High(List)].Name := LangName;
+
+ SetLength(ILanguage, Length(ILanguage)+1);
+ ILanguage[High(ILanguage)] := LangName;
+ end;
+end;
+
+{**
+ * Load the specified LanguageFile
+ *}
+procedure TLanguage.ChangeLanguage(const Language: AnsiString);
+var
+ IniFile: TUnicodeMemIniFile;
+ E: integer; // entry
+ S: TStringList;
+begin
+ SetLength(Entry, 0);
+ IniFile := TUnicodeMemIniFile.Create(LanguagesPath.Append(Language + '.ini'));
+ S := TStringList.Create;
+
+ IniFile.ReadSectionValues('Text', S);
+ SetLength(Entry, S.Count);
+ for E := 0 to high(Entry) do
+ begin
+ if S.Names[E] = 'IMPLODE_GLUE1' then
+ Implode_Glue1 := S.ValueFromIndex[E]+ ' '
+ else if S.Names[E] = 'IMPLODE_GLUE2' then
+ Implode_Glue2 := ' ' + S.ValueFromIndex[E] + ' ';
+
+ Entry[E].ID := S.Names[E];
+ Entry[E].Text := S.ValueFromIndex[E];
+ end;
+
+ S.Free;
+ IniFile.Free;
+end;
+
+{**
+ * Find the index of ID an array of language entries.
+ * @returns the index on success, -1 otherwise.
+ *}
+function TLanguage.FindID(const ID: AnsiString; const EntryList: TLanguageEntryArray): integer;
+var
+ Index: integer;
+begin
+ for Index := 0 to High(EntryList) do
+ begin
+ if ID = EntryList[Index].ID then
+ begin
+ Result := Index;
+ Exit;
+ end;
+ end;
+ Result := -1;
+end;
+
+{**
+ * Translate the Text.
+ * If Text is an ID, text will be translated according to the current language
+ * setting. If Text is not a known ID, it will be returned as is.
+ * @param Text either an ID or an UTF-8 encoded string
+ *}
+function TLanguage.Translate(const Text: RawByteString): UTF8String;
+var
+ E: integer; // entry
+ ID: AnsiString;
+ EntryIndex: integer;
+begin
+ // fallback result in case Text is not a known ID
+ Result := Text;
+
+ // normalize ID case
+ ID := UpperCase(Text);
+
+ // Check if ID exists
+
+ //Const Mod
+ EntryIndex := FindID(ID, EntryConst);
+ if (EntryIndex >= 0) then
+ begin
+ Result := EntryConst[EntryIndex].Text;
+ Exit;
+ end;
+
+ EntryIndex := FindID(ID, Entry);
+ if (EntryIndex >= 0) then
+ begin
+ Result := Entry[EntryIndex].Text;
+ Exit;
+ end;
+
+ //Standard Language (If a Language File is Incomplete)
+ //Then use Standard Language
+ EntryIndex := FindID(ID, EntryDefault);
+ if (EntryIndex >= 0) then
+ begin
+ Result := EntryDefault[EntryIndex].Text;
+ Exit;
+ end;
+end;
+
+{**
+ * Add a Constant ID that will be Translated but not Loaded from the LanguageFile
+ *}
+procedure TLanguage.AddConst(const ID: AnsiString; const Text: UTF8String);
+begin
+ SetLength (EntryConst, Length(EntryConst) + 1);
+ EntryConst[high(EntryConst)].ID := ID;
+ EntryConst[high(EntryConst)].Text := Text;
+end;
+
+{**
+ * Change a Constant Value by ID
+ *}
+procedure TLanguage.ChangeConst(const ID: AnsiString; const Text: UTF8String);
+var
+ I: Integer;
+begin
+ for I := 0 to high(EntryConst) do
+ begin
+ if EntryConst[I].ID = ID then
+ begin
+ EntryConst[I].Text := Text;
+ Break;
+ end;
+ end;
+end;
+
+{**
+ * Connect an array of strings with ' and ' or ', ' to one string
+ *}
+function TLanguage.Implode(const Pieces: array of UTF8String): UTF8String;
+var
+ I: Integer;
+begin
+ Result := '';
+ //Go through Pieces
+ for I := 0 to high(Pieces) do
+ begin
+ //Add Value
+ Result := Result + Pieces[I];
+
+ //Add Glue
+ if (I < high(Pieces) - 1) then
+ Result := Result + Implode_Glue1
+ else if (I < high(Pieces)) then
+ Result := Result + Implode_Glue2;
+ end;
+end;
+
+end.
diff --git a/mediaplugin/src/base/ULog.pas b/mediaplugin/src/base/ULog.pas
new file mode 100644
index 00000000..e4ff4862
--- /dev/null
+++ b/mediaplugin/src/base/ULog.pas
@@ -0,0 +1,441 @@
+{* 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/mediaplugin/src/base/ULyrics.pas b/mediaplugin/src/base/ULyrics.pas
new file mode 100644
index 00000000..3f62db9c
--- /dev/null
+++ b/mediaplugin/src/base/ULyrics.pas
@@ -0,0 +1,726 @@
+{* 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/mediaplugin/src/base/UMain.pas b/mediaplugin/src/base/UMain.pas
new file mode 100644
index 00000000..14a543d1
--- /dev/null
+++ b/mediaplugin/src/base/UMain.pas
@@ -0,0 +1,598 @@
+{* 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;
+
+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,
+ UGraphic,
+ UGraphicClasses,
+ UIni,
+ UJoystick,
+ ULanguage,
+ ULog,
+ UPathUtils,
+ UPlaylist,
+ UMusic,
+ URecord,
+ UBeatTimer,
+ UPlatform,
+ USkins,
+ USongs,
+ UThemes,
+ UParty,
+ ULuaCore,
+ UHookableEvent,
+ ULuaGl,
+ ULuaLog,
+ ULuaTexture,
+ ULuaTextGL,
+ ULuaParty,
+ ULuaScreenSing,
+ UTime;
+
+procedure Main;
+var
+ WindowTitle: string;
+ BadPlayer: integer;
+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);
+
+ // create luacore first so other classes can register their events
+ LuaCore := TLuaCore.Create;
+
+
+ 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);
+
+ // Skin
+ Log.BenchmarkStart(1);
+ Log.LogStatus('Loading Skin List', 'Initialization');
+ Skin := TSkin.Create;
+ Log.BenchmarkEnd(1);
+ Log.LogBenchmark('Loading Skin List', 1);
+
+ Log.BenchmarkStart(1);
+ Log.LogStatus('Loading Theme List', 'Initialization');
+ Theme := TTheme.Create;
+ Log.BenchmarkEnd(1);
+ Log.LogBenchmark('Loading Theme List', 1);
+
+ // Ini + Paths
+ Log.BenchmarkStart(1);
+ Log.LogStatus('Load Ini', 'Initialization');
+ 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 Theme', 'Initialization');
+ Theme.LoadTheme(Ini.Theme, Ini.Color);
+ Log.BenchmarkEnd(1);
+ Log.LogBenchmark('Loading Theme', 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);
+
+ // 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;
+
+ // Lua
+ Log.BenchmarkStart(1);
+ Party := TPartyGame.Create;
+ Log.BenchmarkEnd(1);
+ Log.LogBenchmark('Initializing Party Manager', 1);
+
+ Log.BenchmarkStart(1);
+ LuaCore.RegisterModule('Log', ULuaLog_Lib_f);
+ LuaCore.RegisterModule('Gl', ULuaGl_Lib_f);
+ LuaCore.RegisterModule('TextGl', ULuaTextGl_Lib_f);
+ LuaCore.RegisterModule('Party', ULuaParty_Lib_f);
+ LuaCore.RegisterModule('ScreenSing', ULuaScreenSing_Lib_f);
+
+ Log.BenchmarkEnd(1);
+ Log.LogBenchmark('Initializing LuaCore', 1);
+
+ Log.BenchmarkStart(1);
+ LuaCore.LoadPlugins;
+ Log.BenchmarkEnd(1);
+ Log.LogBenchmark('Loading Lua Plugins', 1);
+
+ LuaCore.DumpPlugins;
+
+ Log.BenchmarkEnd(0);
+ Log.LogBenchmark('Loading Time', 0);
+
+ { prepare software cursor }
+ Display.SetCursor;
+
+ {**
+ * Start background music
+ *}
+ SoundLib.StartBgMusic;
+
+ // check microphone settings, goto record options if they are corrupt
+ BadPlayer := AudioInputProcessor.ValidateSettings;
+ if (BadPlayer <> 0) then
+ begin
+ ScreenPopupError.ShowPopup(
+ Format(Language.Translate('ERROR_PLAYER_DEVICE_ASSIGNMENT'),
+ [BadPlayer]));
+ Display.CurrentScreen^.FadeTo( @ScreenOptionsRecord );
+ end;
+
+ //------------------------------
+ // 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
+
+ Log.LogStatus('Finalize Media', 'Finalization');
+ FinalizeMedia();
+
+ Log.LogStatus('Uninitialize 3D', 'Finalization');
+ Finalize3D();
+
+ Log.LogStatus('Finalize SDL', 'Finalization');
+ SDL_Quit();
+
+ Log.LogStatus('Finalize Log', 'Finalization');
+ Log.Free;
+ {$IFNDEF Debug}
+ end;
+ {$ENDIF}
+end;
+
+procedure MainLoop;
+const
+ MAX_FPS = 100;
+var
+ Delay: integer;
+ TicksCurrent: cardinal;
+ TicksBeforeFrame: cardinal;
+ Done: boolean;
+begin
+ SDL_EnableKeyRepeat(125, 125);
+
+ Done := false;
+
+ CountSkipTime(); // JB - for some reason this seems to be needed when we use the SDL Timer functions.
+ repeat
+ TicksBeforeFrame := SDL_GetTicks;
+
+ // joypad
+ if (Ini.Joypad = 1) or (Params.Joypad) then
+ Joy.Update;
+
+ // keyboard events
+ CheckEvents;
+
+ // display
+ Done := not Display.Draw;
+ SwapBuffers;
+
+ // FPS limiter
+ TicksCurrent := SDL_GetTicks;
+ Delay := 1000 div MAX_FPS - (TicksCurrent - TicksBeforeFrame);
+
+ if Delay >= 1 then
+ SDL_Delay(Delay); // dynamic, maximum is 100 fps
+
+ CountSkipTime;
+
+ until Done;
+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;
+ KeepGoing: boolean;
+begin
+ KeepGoing := true;
+ 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 * Screens / ScreenW,
+ Event.button.Y * 600 / ScreenH);
+
+ if not Assigned(Display.NextScreen) then
+ begin //drop input when changing screens
+ if (ScreenPopupError <> nil) and (ScreenPopupError.Visible) then
+ KeepGoing := ScreenPopupError.ParseMouse(mouseBtn, mouseDown, Event.button.x, Event.button.y)
+ else if (ScreenPopupInfo <> nil) and (ScreenPopupInfo.Visible) then
+ KeepGoing := ScreenPopupInfo.ParseMouse(mouseBtn, mouseDown, Event.button.x, Event.button.y)
+ else if (ScreenPopupCheck <> nil) and (ScreenPopupCheck.Visible) then
+ KeepGoing := ScreenPopupCheck.ParseMouse(mouseBtn, mouseDown, Event.button.x, Event.button.y)
+ else
+ begin
+ KeepGoing := Display.CurrentScreen^.ParseMouse(mouseBtn, mouseDown, Event.button.x, Event.button.y);
+
+ // if screen wants to exit
+ if not KeepGoing 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.
+ // Update: It seems to work now without creating a new OpenGL context. At least
+ // with Win7 and SDL 1.2.14. Maybe it generally works now with SDL 1.2.14 and we
+ // can switch it on for windows.
+ // Important: Unless SDL_SetVideoMode() is called (it is not on Windows), Screen.w
+ // and Screen.h are not valid after a resize and still contain the old size. Use
+ // ScreenW and ScreenH instead.
+ {$IF Defined(Linux) or Defined(FreeBSD)}
+ if boolean( Ini.FullScreen ) then
+ SDL_SetVideoMode(ScreenW, ScreenH, (Ini.Depth+1) * 16, SDL_OPENGL or SDL_FULLSCREEN)
+ else
+ SDL_SetVideoMode(ScreenW, ScreenH, (Ini.Depth+1) * 16, SDL_OPENGL or SDL_RESIZABLE);
+ {$ELSE}
+ Screen.W := ScreenW;
+ Screen.H := ScreenH;
+ {$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
+ KeepGoing := ScreenPopupError.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, true)
+ else if (ScreenPopupInfo <> nil) and (ScreenPopupInfo.Visible) then
+ KeepGoing := ScreenPopupInfo.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, true)
+ else if (ScreenPopupCheck <> nil) and (ScreenPopupCheck.Visible) then
+ KeepGoing := ScreenPopupCheck.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, true)
+ else
+ begin
+ // check if screen wants to exit
+ KeepGoing := Display.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, true);
+
+ // if screen wants to exit
+ if not KeepGoing 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/mediaplugin/src/base/UMusic.pas b/mediaplugin/src/base/UMusic.pas
new file mode 100644
index 00000000..c775fd51
--- /dev/null
+++ b/mediaplugin/src/base/UMusic.pas
@@ -0,0 +1,1235 @@
+{* 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);
+
+ {**
+ * acoStretch: Stretch to screen width and height
+ * - ignores aspect
+ * + no borders
+ * + no image data loss
+ * acoCrop: Stretch to screen width or height, crop the other dimension
+ * + keeps aspect
+ * + no borders
+ * - frame borders are cropped (image data loss)
+ * acoLetterBox: Stretch to screen width, add bars at or crop top and bottom
+ * + keeps aspect
+ * - borders at top and bottom
+ * o top/bottom is cropped if width < height (unusual)
+ *}
+ TAspectCorrection = (acoStretch, acoCrop, acoLetterBox);
+
+ TRectCoords = record
+ Left, Right: double;
+ Upper, Lower: double;
+ end;
+
+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
+ 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
+ AvgSyncDiff: double; //** average difference between stream and sync clock
+ SyncSource: TSyncSource;
+ 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: TSyncSource);
+ function GetSourceStream(): TAudioSourceStream;
+
+ property Status: TStreamStatus read GetStatus;
+ property Volume: single read GetVolume write SetVolume;
+ end;
+
+ TAudioDecodeStream = class(TAudioSourceStream)
+ end;
+
+ TAudioVoiceStream = class(TAudioSourceStream)
+ protected
+ FormatInfo: TAudioFormatInfo;
+ ChannelMap: integer;
+ public
+ destructor Destroy; override;
+
+ function Open(ChannelMap: integer; FormatInfo: TAudioFormatInfo): boolean; virtual;
+ procedure Close(); override;
+
+ procedure WriteData(Buffer: 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;
+ end;
+
+ IVideo = interface
+ ['{58DFC674-9168-41EA-B59D-A61307242B80}']
+ procedure Play;
+ procedure Pause;
+ procedure Stop;
+
+ procedure SetLoop(Enable: boolean);
+ function GetLoop(): boolean;
+
+ procedure SetPosition(Time: real);
+ function GetPosition: real;
+
+ procedure SetScreen(Screen: integer);
+ function GetScreen(): integer;
+
+ procedure SetScreenPosition(X, Y: double; Z: double = 0.0);
+ procedure GetScreenPosition(var X, Y, Z: double);
+
+ procedure SetWidth(Width: double);
+ function GetWidth(): double;
+
+ procedure SetHeight(Height: double);
+ function GetHeight(): double;
+
+ {**
+ * Sub-image of the video frame to draw.
+ * This can be used for zooming or similar purposes.
+ *}
+ procedure SetFrameRange(Range: TRectCoords);
+ function GetFrameRange(): TRectCoords;
+
+ function GetFrameAspect(): real;
+
+ procedure SetAspectCorrection(AspectCorrection: TAspectCorrection);
+ function GetAspectCorrection(): TAspectCorrection;
+
+
+ procedure SetAlpha(Alpha: double);
+ function GetAlpha(): double;
+
+ procedure SetReflectionSpacing(Spacing: double);
+ function GetReflectionSpacing(): double;
+
+ procedure GetFrame(Time: Extended);
+ procedure Draw();
+ procedure DrawReflection();
+
+
+ property Screen: integer read GetScreen;
+ property Width: double read GetWidth write SetWidth;
+ property Height: double read GetHeight write SetHeight;
+ property Alpha: double read GetAlpha write SetAlpha;
+ property ReflectionSpacing: double read GetReflectionSpacing write SetReflectionSpacing;
+ property FrameAspect: real read GetFrameAspect;
+ property AspectCorrection: TAspectCorrection read GetAspectCorrection write SetAspectCorrection;
+ property Loop: boolean read GetLoop write SetLoop;
+ property Position: real read GetPosition write SetPosition;
+ end;
+
+ IVideoPlayback = Interface( IGenericPlayback )
+ ['{3574C40C-28AE-4201-B3D1-3D1F0759B131}']
+ function Init(): boolean;
+ function Finalize: boolean;
+
+ function Open(const FileName : IPath): IVideo;
+ end;
+
+ IVideoVisualization = Interface( IVideoPlayback )
+ ['{5AC17D60-B34D-478D-B632-EB00D4078017}']
+ end;
+
+ IAudioPlayback = Interface( IGenericPlayback )
+ ['{E4AE0B40-3C21-4DC5-847C-20A87E0DFB96}']
+ function InitializePlayback: boolean;
+ function FinalizePlayback: boolean;
+
+ function GetOutputDeviceList(): TAudioOutputDeviceList;
+
+ procedure SetAppVolume(Volume: single);
+ procedure SetVolume(Volume: single);
+ procedure SetLoop(Enabled: boolean);
+
+ procedure FadeIn(Time: real; TargetVolume: single);
+ procedure SetSyncSource(SyncSource: TSyncSource);
+
+ procedure Rewind;
+ function Finished: boolean;
+ function Length: real;
+
+ function Open(const Filename: IPath): boolean; // true if succeed
+ procedure Close;
+
+ procedure Play;
+ procedure Pause;
+ procedure Stop;
+
+ procedure SetPosition(Time: real);
+ function GetPosition: real;
+
+ property Position: real read GetPosition write SetPosition;
+
+ // Sounds
+ // TODO:
+ // add a TMediaDummyPlaybackStream implementation that will
+ // 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;
+
+ procedure SetPosition(Time: real);
+ function GetPosition: real;
+
+ procedure UpdateTexture(Texture: glUint);
+
+ property Loop: boolean read GetLoop write SetLoop;
+ property Position: real read GetPosition write SetPosition;
+ 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;
+
+ 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('background track.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(PByte(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: TSyncSource);
+begin
+ Self.SyncSource := SyncSource;
+ AvgSyncDiff := -1;
+end;
+
+{.$DEFINE LOG_SYNC}
+
+(*
+ * Results an adjusted size of the input buffer size to keep the stream in sync
+ * with the SyncSource. If no SyncSource was assigned to this stream, the
+ * 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;
+ FrameDiff: double;
+ FrameSkip: integer;
+ ReqFrames: integer;
+ MasterClock: real;
+ CurPosition: real;
+const
+ AVG_HISTORY_FACTOR = 0.7;
+ SYNC_REPOS_THRESHOLD = 5.000;
+ SYNC_SOFT_THRESHOLD = 0.010;
+begin
+ Result := BufferSize;
+
+ if (not assigned(SyncSource)) then
+ Exit;
+
+ if (BufferSize <= 0) then
+ Exit;
+
+ CurPosition := Position;
+ MasterClock := SyncSource.GetClock();
+
+ // difference between sync-source and stream position
+ // (negative if the music-stream's position is ahead of the master clock)
+ TimeDiff := MasterClock - CurPosition;
+
+ // 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;
+
+ {$IFDEF LOG_SYNC}
+ //Log.LogError(Format('c:%.3f | p:%.3f | d:%.3f | a:%.3f',
+ // [MasterClock, CurPosition, TimeDiff, AvgSyncDiff]), 'Synch');
+ {$ENDIF}
+
+ // check if we are out of sync
+ if (Abs(AvgSyncDiff) >= SYNC_REPOS_THRESHOLD) then
+ begin
+ {$IFDEF LOG_SYNC}
+ Log.LogError(Format('ReposSynch: %.3f > %.3f',
+ [Abs(AvgSyncDiff), SYNC_REPOS_THRESHOLD]), 'Synch');
+ {$ENDIF}
+
+ // diff far is too large -> reposition stream
+ // (resulting position might still be out of sync)
+ SetPosition(CurPosition + AvgSyncDiff);
+
+ // reset sync info
+ AvgSyncDiff := -1;
+ end
+ else if (Abs(AvgSyncDiff) >= SYNC_SOFT_THRESHOLD) then
+ begin
+ {$IFDEF LOG_SYNC}
+ Log.LogError(Format('SoftSynch: %.3f > %.3f',
+ [Abs(AvgSyncDiff), SYNC_SOFT_THRESHOLD]), 'Synch');
+ {$ENDIF}
+
+ // hard sync: directly jump to the current position
+ FrameSkip := Round(AvgSyncDiff * FormatInfo.SampleRate);
+ Result := BufferSize + FrameSkip * FormatInfo.FrameSize;
+ if (Result < 0) then
+ Result := 0;
+
+ // reset sync info
+ AvgSyncDiff := -1;
+ end;
+end;
+
+(*
+ * Fills a buffer with copies of the given Frame or with 0 if Frame is nil.
+ *)
+procedure TAudioPlaybackStream.FillBufferWithFrame(Buffer: PByteArray; BufferSize: integer; Frame: PByteArray; FrameSize: integer);
+var
+ 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/mediaplugin/src/base/UNote.pas b/mediaplugin/src/base/UNote.pas
new file mode 100644
index 00000000..ff9c6b57
--- /dev/null
+++ b/mediaplugin/src/base/UNote.pas
@@ -0,0 +1,618 @@
+{* 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;
+
+{* Player and music info *}
+var
+ {**
+ * Player info and state for each player.
+ * The amount of players is given by PlayersPlay.
+ *}
+ Player: array of TPlayer;
+
+ {**
+ * Number of players or teams playing.
+ * Possible values: 1 - 6
+ *}
+ PlayersPlay: integer;
+
+ {**
+ * Selected song for singing.
+ *}
+ 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,
+ 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);
+ var
+ SentenceEnd: integer;
+ I: cardinal;
+begin
+ NewNote(Screen);
+
+ // check for sentence end
+ // we check all lines here because a new sentence may
+ // have been started even before the old one finishes
+ // due to corrupt lien breaks
+ // checking only current line works to, but may lead to
+ // weird ratings for the song files w/ the mentioned
+ // errors
+ // To-Do Philipp : check current and last line should
+ // do it for most corrupt txt and for lines in
+ // non-corrupt txts that start immediatly after the prev.
+ // line ends
+ if (assigned(Screen)) then
+ begin
+ for I := 0 to Lines[0].High do
+ begin
+ with Lines[0].Line[I] do
+ begin
+ if (HighNote >= 0) then
+ begin
+ SentenceEnd := Note[HighNote].Start + Note[HighNote].Length;
+
+ if (LyricsState.OldBeatD < SentenceEnd) and (LyricsState.CurrentBeatD >= SentenceEnd) then
+ Screen.OnSentenceEnd(I);
+ end;
+ end;
+ end;
+ end;
+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');
+end;
+
+end.
diff --git a/mediaplugin/src/base/UParty.pas b/mediaplugin/src/base/UParty.pas
new file mode 100644
index 00000000..bc485dca
--- /dev/null
+++ b/mediaplugin/src/base/UParty.pas
@@ -0,0 +1,1026 @@
+{* 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
+ ULua;
+
+type
+ { array holds ids of modes or Party_Round_Random
+ its length defines the number of rounds
+ it is used as argument for TPartyGame.StartParty }
+ ARounds = array of integer;
+
+ { element of APartyTeamRanking returned by TPartyGame.GetTeamRanking
+ and parameter for TPartyGame.SetWinner }
+ TParty_TeamRanking = record
+ Team: Integer; //< id of team
+ Rank: Integer; //< 1 to Length(Teams) e.g. 1 is for placed first
+ end;
+ AParty_TeamRanking = array of TParty_TeamRanking; //< returned by TPartyGame.GetTeamRanking
+
+ TParty_RoundList = record
+ Index: integer;
+ Name: UTF8String;
+ end;
+ AParty_ModeList = array of TParty_RoundList;
+
+ { record used by TPartyGame to store round specific data }
+ TParty_Round = record
+ Mode: Integer;
+ AlreadyPlayed: Boolean; //< true if round was already played
+ Ranking: AParty_TeamRanking;
+ RankingSet: Boolean; //< true if Self.Ranking is already set
+ end;
+
+ TParty_ModeInfo = record
+ Name: String; // name of this mode
+ Parent: Integer; // Id of owning plugin
+
+ CanNonParty: Boolean; //< is playable when not in party mode
+ CanParty: Boolean; //< is playable in party mode
+
+ // one bit in the following settings stands for
+ // a player or team count
+ // PlayerCount = 2 or 4 indicates that the mode is playable with 2 and 3 players per team
+ // TeamCount = 1 or 2 or 4 or 8 or 16 or 32 indicates that the mode is playable with 1 to 6 teams
+ PlayerCount: Integer; //< playable with one, two, three etc. players per team
+ TeamCount: Integer; //< playable with one, two, three etc. different teams
+
+
+ Functions: record // lua functions that will be called at specific events
+ BeforeSongSelect: String; // default actions are executed if functions = nil
+ AfterSongSelect: String;
+
+ BeforeSing: String;
+ OnSing: String;
+ AfterSing: String;
+ end;
+ end;
+
+ { used by TPartyGame to store player specific data }
+ TParty_PlayerInfo = record
+ Name: String; //< Playername
+ TimesPlayed: Integer; //< How often this Player has Sung
+ end;
+
+ { used by TPartyGame to store team specific data }
+ TParty_TeamInfo = record
+ Name: String; //< name of the Team
+ Score: Word; //< current score
+ JokersLeft: Integer; //< jokers this team has left
+
+ NextPlayer: Integer; //Id of the player that plays the next (the current) song
+
+ Players: array of TParty_PlayerInfo;
+ end;
+
+ TPartyGame = class
+ private
+ bPartyGame: boolean; //< are we playing party or standard mode
+ CurRound: Integer; //< indicates which of the elements of Rounds is played next (at the moment)
+
+ bPartyStarted: Boolean;
+
+ TimesPlayed: array of Integer; //< times every mode was played in current party game (for random mode calculation)
+
+ procedure GenScores;
+ function GetRandomMode: integer;
+ function GetRandomPlayer(Team: integer): integer;
+
+ { returns true if a mode is playable with current playerconfig }
+ function ModePlayable(I: integer): boolean;
+
+ function CallLua(Parent: Integer; Func: String):Boolean;
+
+ procedure SetRankingByScore;
+ public
+ //Teams: TTeamInfo;
+ Rounds: array of TParty_Round; //< holds info which modes are played in this party game (if started)
+ Teams: array of TParty_TeamInfo; //< holds info of teams playing in current round (private for easy manipulation of lua functions)
+
+ Modes: array of TParty_ModeInfo; //< holds info of registred party modes
+
+ property CurrentRound: Integer read CurRound;
+
+ constructor Create;
+
+ { set the attributes of Info to default values }
+ procedure DefaultModeInfo(var Info: TParty_ModeInfo);
+
+ { registers a new mode, returns true on success
+ (mode name does not already exist) }
+ function RegisterMode(Info: TParty_ModeInfo): Boolean;
+
+ { returns true if modes are available for
+ players and teams that are currently set
+ up. if there are no teams set up it returns
+ if there are any party modes available }
+ function ModesAvailable: Boolean;
+
+ { returns an array with the name of all available modes (that
+ are playable with current player configuration }
+ function GetAvailableModes: AParty_ModeList;
+
+ { clears all party specific data previously stored }
+ procedure Clear;
+
+ { adds a team to the team array, returning its id
+ can only be called when game is not already started }
+ function AddTeam(Name: String): Integer;
+
+ { adds a player to the player array, returning its id
+ can only be called when game is not already started }
+ function AddPlayer(Team: Integer; Name: String): Integer;
+
+ { starts a new PartyGame, returns true on success
+ before a call of this function teams and players
+ has to be added by AddTeam and AddPlayer }
+
+ function StartGame(Rounds: ARounds): Boolean;
+
+ { sets the winner(s) of current round
+ returns true on success }
+ function SetRanking(Ranking: AParty_TeamRanking): Boolean;
+
+ { increases players TimesPlayed value }
+ procedure IncTimesPlayed;
+
+ { increases round counter by 1 and clears all round specific information;
+ returns the number of the current round or -1 if last round has already
+ been played }
+ function NextRound: integer;
+
+ { indicates that current round has already been played }
+ procedure RoundPlayed;
+
+ { true if in a Party Game (not in standard mode) }
+ property PartyGame: Boolean read BPartyGame;
+
+
+ { returns true if last round was already played }
+ function GameFinished: Boolean;
+
+ { call plugins defined function and/or default procedure
+ only default procedure is called when no function is defined by plugin
+ if plugins function returns true then default is called after plugins
+ function was executed}
+ procedure CallBeforeSongSelect;
+ procedure CallAfterSongSelect;
+ procedure CallBeforeSing;
+ procedure CallOnSing;
+ procedure CallAfterSing;
+
+ { returns an array[1..6] of TParty_TeamRanking.
+ the index stands for the placing,
+ team is the team number (in the team array)
+ rank is correct rank if some teams have the
+ same score.
+ }
+ function GetTeamRanking: AParty_TeamRanking;
+
+ { returns a string like "Team 1 (and Team 2) win" }
+ function GetWinnerString(Round: integer): UTF8String;
+
+ destructor Destroy; override;
+ end;
+
+const
+ { minimal amount of teams for party mode }
+ Party_Teams_Min = 2;
+
+ { maximal amount of teams for party mode }
+ Party_Teams_Max = 3;
+
+ { minimal amount of players for party mode }
+ Party_Players_Min = 1;
+
+ { maximal amount of players for party mode }
+ Party_Players_Max = 4;
+
+ { amount of jokers each team gets at the beginning of the game }
+ Party_Count_Jokers = 5;
+
+ { to indicate that element (mode) should set randomly in ARounds array }
+ Party_Round_Random = -1;
+
+ { values for TParty_TeamRanking.Rank }
+ PR_First = 1;
+ PR_Second = 2;
+ PR_Third = 3;
+
+ StandardModus = 0; //Modus Id that will be played in non-party mode
+
+var
+ Party: TPartyGame;
+
+implementation
+
+uses
+ UGraphic,
+ ULanguage,
+ ULog,
+ ULuaCore,
+ UDisplay,
+ USong,
+ UNote,
+ SysUtils;
+
+//-------------
+// Just the constructor
+//-------------
+constructor TPartyGame.Create;
+begin
+ inherited;
+
+ Clear;
+end;
+
+destructor TPartyGame.Destroy;
+begin
+ inherited;
+end;
+
+{ clears all party specific data previously stored }
+procedure TPartyGame.Clear;
+ var
+ I: Integer;
+begin
+ bPartyGame := false; // no party game
+ CurRound := low(integer);
+
+ bPartyStarted := false; //game not startet
+
+ SetLength(Teams, 0); //remove team info
+ SetLength(Rounds, 0); //remove round info
+
+ // clear times played
+ for I := 0 to High(TimesPlayed) do
+ TimesPlayed[I] := 0;
+end;
+
+{ private: some intelligent randomnes for plugins }
+function TPartyGame.GetRandomMode: integer;
+var
+ LowestTP: integer;
+ NumPwithLTP: integer;
+ I: integer;
+ R: integer;
+begin
+ Result := 0; //If there are no matching modes, play first modus
+ LowestTP := high(Integer);
+ NumPwithLTP := 0;
+
+ // search for the plugins less played yet
+ for I := 0 to high(Modes) do
+ begin
+ if (ModePlayable(I)) then
+ begin
+ if (TimesPlayed[I] < lowestTP) then
+ begin
+ lowestTP := TimesPlayed[I];
+ NumPwithLTP := 1;
+ end
+ else if (TimesPlayed[I] = lowestTP) then
+ begin
+ Inc(NumPwithLTP);
+ end;
+ end;
+ end;
+
+ // create random number
+ R := Random(NumPwithLTP);
+
+ // select the random mode from the modes with less timesplayed
+ for I := 0 to high(Modes) do
+ begin
+ if (TimesPlayed[I] = lowestTP) and (ModePlayable(I)) then
+ begin
+ //Plugin found
+ if (R = 0) then
+ begin
+ Result := I;
+ Inc(TimesPlayed[I]);
+ Break;
+ end;
+
+ Dec(R);
+ end;
+ end;
+end;
+
+{ private: GetRandomPlayer - returns a random player
+ that does not play to often ;) }
+function TPartyGame.GetRandomPlayer(Team: integer): integer;
+var
+ I, R: integer;
+ lowestTP: Integer;
+ NumPwithLTP: Integer;
+begin
+ LowestTP := high(Integer);
+ NumPwithLTP := 0;
+ Result := 0;
+
+ // search for players that have less played yet
+ for I := 0 to High(Teams[Team].Players) do
+ begin
+ if (Teams[Team].Players[I].TimesPlayed < lowestTP) then
+ begin
+ lowestTP := Teams[Team].Players[I].TimesPlayed;
+ NumPwithLTP := 1;
+ end
+ else if (Teams[Team].Players[I].TimesPlayed = lowestTP) then
+ begin
+ Inc(NumPwithLTP);
+ end;
+ end;
+
+ // create random number
+ R := Random(NumPwithLTP);
+
+ // search for selected random player
+ for I := 0 to High(Teams[Team].Players) do
+ begin
+ if Teams[Team].Players[I].TimesPlayed = lowestTP then
+ begin
+ if (R = 0) then
+ begin // found selected player
+ Result := I;
+ Break;
+ end;
+
+ Dec(R);
+ end;
+ end;
+end;
+
+//----------
+//GenScores - inc scores for cur. round
+//----------
+procedure TPartyGame.GenScores;
+var
+ I: Integer;
+begin
+ if (Length(Teams) = 2) then
+ begin // score generation for 2 teams, winner gets 1 point
+ for I := 0 to High(Rounds[CurRound].Ranking) do
+ if (Rounds[CurRound].Ranking[I].Rank = PR_First) then
+ Inc(Teams[Rounds[CurRound].Ranking[I].Team].Score);
+ end
+ else if (Length(Teams) = 3) then
+ begin // score generation for 3 teams,
+ // winner gets 3 points 2nd gets 1 point
+ for I := 0 to High(Rounds[CurRound].Ranking) do
+ if (Rounds[CurRound].Ranking[I].Rank = PR_First) then
+ Inc(Teams[Rounds[CurRound].Ranking[I].Team].Score, 3)
+ else if (Rounds[CurRound].Ranking[I].Rank = PR_Second) then
+ Inc(Teams[Rounds[CurRound].Ranking[I].Team].Score);
+ end
+end;
+
+{ set the attributes of Info to default values }
+procedure TPartyGame.DefaultModeInfo(var Info: TParty_ModeInfo);
+begin
+ Info.Name := 'undefined';
+ Info.Parent := -1; //< not loaded by plugin (e.g. Duell)
+ Info.CanNonParty := false;
+ Info.CanParty := false;
+ Info.PlayerCount := High(Integer); //< no restrictions either on player count
+ Info.TeamCount := High(Integer); //< nor on team count
+ Info.Functions.BeforeSongSelect := ''; //< use default functions
+ Info.Functions.AfterSongSelect := '';
+ Info.Functions.BeforeSing := '';
+ Info.Functions.OnSing := '';
+ Info.Functions.AfterSing := '';
+end;
+
+{ registers a new mode, returns true on success
+ (mode name does not already exist) }
+function TPartyGame.RegisterMode(Info: TParty_ModeInfo): Boolean;
+ var
+ Len: integer;
+ LowerName: String;
+ I: integer;
+begin
+ Result := false;
+
+ if (Info.Name <> 'undefined') then
+ begin
+ // search for a plugin w/ same name
+ LowerName := lowercase(Info.Name); // case sensitive search
+ for I := 0 to high(Modes) do
+ if (LowerName = lowercase(Modes[I].Name)) then
+ exit; //< no success (name already exist)
+
+ // add new mode to array and append and clear a new TimesPlayed element
+ Len := Length(Modes);
+ SetLength(Modes, Len + 1);
+ SetLength(TimesPlayed, Len + 1);
+
+ Modes[Len] := Info;
+ TimesPlayed[Len] := 0;
+
+ Result := True;
+ end;
+end;
+
+{ returns true if a mode is playable with current playerconfig }
+function TPartyGame.ModePlayable(I: integer): boolean;
+ var
+ J: integer;
+begin
+ if (Length(Teams) = 0) then
+ Result := true
+ else
+ begin
+ if (Modes[I].TeamCount and (1 shl (Length(Teams) - 1)) <> 0) then
+ begin
+ Result := true;
+
+ for J := 0 to High(Teams) do
+ Result := Result and (Modes[I].PlayerCount and (1 shl (Length(Teams[J].Players) - 1)) <> 0);
+ end
+ else
+ Result := false;
+ end;
+end;
+
+{ returns true if modes are available for
+ players and teams that are currently set
+ up. if there are no teams set up it returns
+ if there are any party modes available }
+function TPartyGame.ModesAvailable: Boolean;
+ var
+ I: integer;
+ CountTeams: integer;
+begin
+ CountTeams := Length(Teams);
+ if CountTeams = 0 then
+ begin
+ Result := (Length(Modes) > 0);
+ end
+ else
+ begin
+ Result := false;
+ for I := 0 to High(Modes) do
+ begin
+ Result := ModePlayable(I);
+
+ if Result then
+ Exit;
+ end;
+ end;
+end;
+
+{ returns an array with the name of all available modes (that
+ are playable with current player configuration }
+function TPartyGame.GetAvailableModes: AParty_ModeList;
+ var
+ I: integer;
+ Len: integer;
+begin
+ Len := 0;
+ SetLength(Result, Len + 1);
+ Result[Len].Index := Party_Round_Random;
+ Result[Len].Name := Language.Translate('MODE_RANDOM_NAME');
+
+ for I := 0 to High(Modes) do
+ if (ModePlayable(I)) then
+ begin
+ Inc(Len);
+ SetLength(Result, Len + 1);
+ Result[Len].Index := I;
+ Result[Len].Name := Language.Translate('MODE_' + Uppercase(Modes[I].Name) + '_NAME');
+ end;
+end;
+
+{ adds a team to the team array, returning its id
+ can only be called when game is not already started }
+function TPartyGame.AddTeam(Name: String): Integer;
+begin
+ Result := -1;
+ if (not bPartyStarted) and (Length(Name) > 0) and (Length(Teams) < Party_Teams_Max) then
+ begin
+ Result := Length(Teams);
+ SetLength(Teams, Result + 1);
+
+ Teams[Result].Name := Name;
+ Teams[Result].Score := 0;
+ Teams[Result].JokersLeft := Party_Count_Jokers;
+ Teams[Result].NextPlayer := -1;
+ end;
+end;
+
+{ adds a player to the player array, returning its id
+ can only be called when game is not already started }
+function TPartyGame.AddPlayer(Team: Integer; Name: String): Integer;
+begin
+ Result := -1;
+
+ if (not bPartyStarted) and (Team >= 0) and (Team <= High(Teams)) and (Length(Teams[Team].Players) < Party_Players_Max) and (Length(Name) > 0) then
+ begin
+ // append element to players array
+ Result := Length(Teams[Team].Players);
+ SetLength(Teams[Team].Players, Result + 1);
+
+ // fill w/ data
+ Teams[Team].Players[Result].Name := Name;
+ Teams[Team].Players[Result].TimesPlayed := 0;
+ end;
+end;
+
+{ starts a new PartyGame, returns true on success
+ before a call of this function teams and players
+ has to be added by AddTeam and AddPlayer }
+function TPartyGame.StartGame(Rounds: ARounds): Boolean;
+ var
+ I: integer;
+begin
+ Result := false;
+
+ if (not bPartyStarted) and (Length(Rounds) > 0) and (Length(Teams) >= Party_Teams_Min) then
+ begin
+ // check teams for minimal player count
+ for I := 0 to High(Teams) do
+ if (Length(Teams[I].Players) < Party_Players_Min) then
+ exit;
+
+ // create rounds array
+ SetLength(Self.Rounds, Length(Rounds));
+
+ for I := 0 to High(Rounds) do
+ begin
+ // copy round or select a random round
+ if (Rounds[I] <> Party_Round_Random) and (Rounds[I] >= 0) and (Rounds[I] <= High(Modes)) then
+ Self.Rounds[I].Mode := Rounds[I]
+ else
+ Self.Rounds[I].Mode := GetRandomMode;
+
+ Self.Rounds[I].AlreadyPlayed := false;
+ Self.Rounds[I].RankingSet := false;
+
+ SetLength(Self.Rounds[I].Ranking, 0);
+ end;
+
+ // get the party started!11
+ bPartyStarted := true;
+ bPartyGame := true;
+ CurRound := low(integer); //< set not to -1 to indicate that party game is not finished
+
+ // first round
+ NextRound;
+
+ Result := True;
+ end;
+end;
+
+{ sets the winner(s) of current round
+ returns true on success }
+function TPartyGame.SetRanking(Ranking: AParty_TeamRanking): Boolean;
+ var
+ I, J: Integer;
+ TeamExists: Integer;
+ Len: Integer;
+ Temp: TParty_TeamRanking;
+begin
+ if (bPartyStarted) and (CurRound >= 0) and (CurRound <= High(Rounds)) then
+ begin
+ Rounds[CurRound].Ranking := Ranking;
+ Result := true;
+
+ // look for teams that don't exist
+ TeamExists := 0;
+ for I := 0 to High(Rounds[CurRound].Ranking) do
+ TeamExists := TeamExists or (1 shl (Rounds[CurRound].Ranking[I].Team-1));
+
+ // create teams that don't exist
+ Len := Length(Rounds[CurRound].Ranking);
+ for I := 0 to High(Teams) do
+ if (TeamExists and (1 shl I) = 0) then
+ begin
+ Inc(Len);
+ SetLength(Rounds[CurRound].Ranking, Len);
+ Rounds[CurRound].Ranking[Len-1].Team := I + 1;
+ Rounds[CurRound].Ranking[Len-1].Rank := Length(Teams);
+ end;
+
+ // we may remove rankings from invalid teams here to
+ // but at the moment this is not necessary, because the
+ // functions this function is called from don't create
+ // invalid rankings
+
+ // bubble sort rankings by team
+ J := High(Rounds[CurRound].Ranking);
+ repeat
+ for I := 0 to J - 1 do
+ if (Rounds[CurRound].Ranking[I].Team > Rounds[CurRound].Ranking[I+1].Team) then
+ begin
+ Temp := Rounds[CurRound].Ranking[I];
+ Rounds[CurRound].Ranking[I] := Rounds[CurRound].Ranking[I+1];
+ Rounds[CurRound].Ranking[I+1] := Temp;
+ end;
+ Dec(J);
+ until J <= 0;
+
+ //set rounds RankingSet to true
+ Rounds[CurRound].RankingSet := true;
+ end
+ else
+ Result := false;
+end;
+
+{ sets ranking of current round by score saved in players array }
+procedure TPartyGame.SetRankingByScore;
+ var
+ I, J: Integer;
+ Rank: Integer;
+ Ranking: AParty_TeamRanking;
+ Scores: array of Integer;
+ TmpRanking: TParty_TeamRanking;
+ TmpScore: Integer;
+begin
+ if (Length(Player) = Length(Teams)) then
+ begin
+ SetLength(Ranking, Length(Teams));
+ SetLength(Scores, Length(Teams));
+
+ // fill ranking array
+ for I := 0 to High(Ranking) do
+ begin
+ Ranking[I].Team := I;
+ Ranking[I].Rank := 0;
+ Scores[I] := Player[I].ScoreTotalInt;
+ end;
+
+ // bubble sort by score
+ J := High(Ranking);
+ repeat
+ for I := 0 to J - 1 do
+ if (Scores[I] < Scores[I+1]) then
+ begin
+ TmpRanking := Ranking[I];
+ Ranking[I] := Ranking[I+1];
+ Ranking[I+1] := TmpRanking;
+
+ TmpScore := Scores[I];
+ Scores[I] := Scores[I+1];
+ Scores[I+1] := TmpScore;
+ end;
+ Dec(J);
+ until J <= 0;
+
+ // set rank field
+ Rank := 1; //first rank has id 1
+ for I := 0 to High(Ranking) do
+ begin
+ Ranking[I].Rank := Rank;
+
+ if (I < High(Ranking)) and (Scores[I] <> Scores[I+1]) then
+ Inc(Rank); // next rank if next team has different score
+ end;
+ end
+ else
+ SetLength(Ranking, 0);
+
+ SetRanking(Ranking);
+end;
+
+{ increases players TimesPlayed value }
+procedure TPartyGame.IncTimesPlayed;
+ var I: Integer;
+begin
+ for I := 0 to High(Teams) do
+ with Teams[I] do
+ Inc(Players[NextPlayer].TimesPlayed);
+end;
+
+{ increases round counter by 1 and clears all round specific information;
+ returns the number of the current round or -1 if last round has already
+ been played }
+function TPartyGame.NextRound: integer;
+ var I: Integer;
+begin
+ // some lines concerning the previous round
+ if (CurRound >= 0) then
+ begin
+ IncTimesPlayed;
+
+ Rounds[CurRound].AlreadyPlayed := true;
+
+ GenScores;
+ end;
+
+ // increase round counter
+ Inc(CurRound);
+ if (CurRound < -1) then // we start first round
+ CurRound := 0;
+
+ if (CurRound > High(Rounds)) then
+ CurRound := -1; //< last round played
+
+ Result := CurRound;
+
+ // some lines concerning the next round
+ if (CurRound >= 0) then
+ begin
+ // select player
+ for I := 0 to High(Teams) do
+ Teams[I].NextPlayer := GetRandomPlayer(I);
+ end;
+end;
+
+{ indicates that current round has already been played }
+procedure TPartyGame.RoundPlayed;
+begin
+ if (bPartyStarted) and (CurRound >= 0) and (CurRound <= High(Rounds)) then
+ begin
+ // set rounds ranking by score if it was not set by plugin
+ if (not Rounds[CurRound].RankingSet) then
+ SetRankingByScore;
+
+ Rounds[CurRound].AlreadyPlayed := True;
+ end;
+end;
+
+{ returns true if last round was already played }
+function TPartyGame.GameFinished: Boolean;
+begin
+ Result := (bPartyStarted and (CurRound = -1));
+end;
+
+{ private: calls the specified function Func from lua plugin Parent
+ if both exist.
+ return true if default function should be called
+ (function or plugin does not exist, or function returns
+ true) }
+function TPartyGame.CallLua(Parent: Integer; Func: String):Boolean;
+ var
+ P: TLuaPlugin;
+begin
+ // call default function by default
+ Result := true;
+
+ // check for core plugin and empty function name
+ if (Parent >= 0) and (Length(Func) > 0) then
+ begin
+ // get plugin that registred the mode
+ P := LuaCore.GetPluginById(Parent);
+
+ if (P <> nil) then
+ begin
+ if (P.CallFunctionByName(Func, 0, 1)) then
+ // check result
+ Result := (lua_toboolean(P.LuaState, 1));
+ end;
+ end;
+end;
+
+{ call plugins defined function and/or default procedure
+ only default procedure is called when no function is defined by plugin
+ if plugins function returns true then default is called after plugins
+ function was executed}
+procedure TPartyGame.CallBeforeSongSelect;
+ var
+ ExecuteDefault: boolean;
+begin
+ if not bPartyStarted then
+ ExecuteDefault := true
+ else if (CurRound >= 0) then
+ begin
+ // we set screen song to party mode
+ // plugin should not have to do this if it
+ // don't want default procedure to be executed
+ ScreenSong.Mode := smPartyMode;
+
+ with Modes[Rounds[CurRound].Mode] do
+ ExecuteDefault := (CallLua(Parent, Functions.BeforeSongSelect));
+ end
+ else
+ ExecuteDefault := true;
+
+ // execute default function:
+ if ExecuteDefault then
+ begin
+ // display song select screen
+ Display.FadeTo(@ScreenSong);
+ end;
+end;
+
+procedure TPartyGame.CallAfterSongSelect;
+ var
+ ExecuteDefault: boolean;
+begin
+ if not bPartyStarted then
+ ExecuteDefault := true
+ else if (CurRound >= 0) then
+ begin
+ with Modes[Rounds[CurRound].Mode] do
+ ExecuteDefault := (CallLua(Parent, Functions.AfterSongSelect));
+ end
+ else
+ ExecuteDefault := true;
+
+ // execute default function:
+ if ExecuteDefault then
+ begin
+ // display sing screen
+ ScreenSong.StartSong;
+ end;
+end;
+
+procedure TPartyGame.CallBeforeSing;
+ var
+ ExecuteDefault: boolean;
+begin
+ if not bPartyStarted then
+ ExecuteDefault := true
+ else if (CurRound >= 0) then
+ begin
+ with Modes[Rounds[CurRound].Mode] do
+ ExecuteDefault := (CallLua(Parent, Functions.BeforeSing));
+ end
+ else
+ ExecuteDefault := true;
+
+ // execute default function:
+ if ExecuteDefault then
+ begin
+ //nothing atm
+ { to-do : compartmentalize TSingScreen.OnShow into
+ functions for init of a specific part of
+ sing screen.
+ these functions should be called here before
+ sing screen is shown, or it should be called
+ by plugin if it wants to define a custom
+ singscreen start up. }
+
+ //set correct playersplay
+ if (bPartyGame) then
+ PlayersPlay := Length(Teams);
+ end;
+end;
+
+procedure TPartyGame.CallOnSing;
+ var
+ ExecuteDefault: boolean;
+begin
+ if not bPartyStarted then
+ ExecuteDefault := true
+ else if (CurRound >= 0) then
+ begin
+ with Modes[Rounds[CurRound].Mode] do
+ ExecuteDefault := (CallLua(Parent, Functions.OnSing));;
+ end
+ else
+ ExecuteDefault := true;
+
+ // execute default function:
+ if ExecuteDefault then
+ begin
+ //nothing atm
+ end;
+end;
+
+procedure TPartyGame.CallAfterSing;
+ var
+ ExecuteDefault: boolean;
+begin
+ if not bPartyStarted then
+ ExecuteDefault := true
+ else if (CurRound >= 0) then
+ begin
+ with Modes[Rounds[CurRound].Mode] do
+ ExecuteDefault := (CallLua(Parent, Functions.AfterSing));
+ end
+ else
+ ExecuteDefault := true;
+
+ // execute default function:
+ if ExecuteDefault then
+ begin
+ if (bPartyGame) then
+ // display party score screen
+ Display.FadeTo(@ScreenPartyScore)
+ else //display standard score screen
+ Display.FadeTo(@ScreenScore);
+ end;
+end;
+
+{ returns an array[1..6] of integer. the index stands for the placing,
+ value is the team number (in the team array) }
+function TPartyGame.GetTeamRanking: AParty_TeamRanking;
+ var
+ I, J: Integer;
+ Temp: TParty_TeamRanking;
+ Rank: Integer;
+begin
+ SetLength(Result, Length(Teams));
+
+ // fill ranking array
+ for I := 0 to High(Result) do
+ begin
+ Result[I].Team := I;
+ Result[I].Rank := 0;
+ end;
+
+ // bubble sort by score
+ J := High(Result);
+ repeat
+ for I := 0 to J - 1 do
+ if (Teams[Result[I].Team].Score < Teams[Result[I+1].Team].Score) then
+ begin
+ Temp := Result[I];
+ Result[I] := Result[I+1];
+ Result[I+1] := Temp;
+ end;
+ Dec(J);
+ until J <= 0;
+
+ // set rank field
+ Rank := 1; //first rank has id 1
+ for I := 0 to High(Result) do
+ begin
+ Result[I].Rank := Rank;
+
+ if (I < High(Result)) and (Teams[Result[I].Team].Score <> Teams[Result[I+1].Team].Score) then
+ Inc(Rank); // next rank if next team has different score
+ end;
+end;
+
+{ returns a string like "Team 1 (and Team 2) win"
+ if Round is in range from 0 to high(Rounds) then
+ result is name of winners of specified round.
+ if Round is -1 the result is name of winners of
+ the whole party game}
+function TPartyGame.GetWinnerString(Round: integer): UTF8String;
+var
+ Winners: array of UTF8String;
+ I: integer;
+ Ranking: AParty_TeamRanking;
+begin
+ Result := '';
+ Ranking := nil;
+
+ if (Round >= 0) and (Round <= High(Rounds)) then
+ begin
+ if (not Rounds[Round].AlreadyPlayed) then
+ Result := Language.Translate('PARTY_NOTPLAYEDYET')
+ else
+ Ranking := Rounds[Round].Ranking;
+ end
+ else if (Round = -1) then
+ Ranking := GetTeamRanking;
+
+
+ if (Ranking <> nil) then
+ begin
+ SetLength(Winners, 0);
+ for I := 0 to High(Ranking) do
+ begin
+ if (Ranking[I].Rank = PR_First) and (Ranking[I].Team >= 0) and (Ranking[I].Team <= High(Teams)) then
+ begin
+ SetLength(Winners, Length(Winners) + 1);
+ Winners[high(Winners)] := UTF8String(Teams[Ranking[I].Team].Name);
+ end;
+ end;
+
+ if (Length(Winners) > 0) then
+ Result := Language.Implode(Winners);
+ end;
+
+ if (Length(Result) = 0) then
+ Result := Language.Translate('PARTY_NOBODY');
+end;
+
+end.
diff --git a/mediaplugin/src/base/UPath.pas b/mediaplugin/src/base/UPath.pas
new file mode 100644
index 00000000..7cb2f649
--- /dev/null
+++ b/mediaplugin/src/base/UPath.pas
@@ -0,0 +1,1427 @@
+{* UltraStar Deluxe - Karaoke Game
+ *
+ * UltraStar Deluxe is the legal property of its developers, whose names
+ * are too numerous to list here. Please refer to the COPYRIGHT
+ * file distributed with this source distribution.
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; see the file COPYING. If not, write to
+ * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+ * Boston, MA 02110-1301, USA.
+ *
+ * $URL$
+ * $Id$
+ *}
+
+unit UPath;
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+interface
+
+uses
+ SysUtils,
+ Classes,
+ IniFiles,
+ {$IFDEF MSWINDOWS}
+ TntClasses,
+ {$ENDIF}
+ UConfig,
+ UUnicodeUtils;
+
+type
+ IPath = interface;
+
+ {$IFDEF FPC}
+ TFileHandle = THandle;
+ {$ELSE}
+ TFileHandle = Longint;
+ {$ENDIF}
+
+ {**
+ * TUnicodeMemoryStream
+ *}
+ TUnicodeMemoryStream = class(TMemoryStream)
+ public
+ procedure LoadFromFile(const FileName: IPath);
+ procedure SaveToFile(const FileName: IPath);
+ end;
+
+ {**
+ * Unicode capable IniFile implementation.
+ * TMemIniFile and TIniFile are not able to handle INI-files with
+ * an UTF-8 BOM. This implementation checks if an UTF-8 BOM exists
+ * and removes it from the internal string-list.
+ * UTF8Encoded is set accordingly.
+ *}
+ TUnicodeMemIniFile = class(TMemIniFile)
+ private
+ FFilename: IPath;
+ FUTF8Encoded: boolean;
+ public
+ constructor Create(const FileName: IPath; UTF8Encoded: boolean = false); reintroduce;
+ procedure UpdateFile; override;
+ property UTF8Encoded: boolean READ FUTF8Encoded WRITE FUTF8Encoded;
+ end;
+
+ {**
+ * TBinaryFileStream (inherited from THandleStream)
+ *}
+ {$IFDEF MSWINDOWS}
+ TBinaryFileStream = class(TTntFileStream)
+ {$ELSE}
+ TBinaryFileStream = class(TFileStream)
+ {$ENDIF}
+ public
+ {**
+ * @seealso TFileStream.Create for valid Mode parameters
+ *}
+ constructor Create(const FileName: IPath; Mode: word);
+ end;
+
+ {**
+ * TTextFileStream
+ *}
+ TTextFileStream = class(TStream)
+ protected
+ fLineBreak: RawByteString;
+ fFilename: IPath;
+ fMode: word;
+
+ function ReadLine(var Success: boolean): RawByteString; overload; virtual; abstract;
+ public
+ constructor Create(Filename: IPath; Mode: word);
+
+ function ReadString(): RawByteString; virtual; abstract;
+ function ReadLine(var Line: UTF8String): boolean; overload;
+ function ReadLine(var Line: AnsiString): boolean; overload;
+
+ procedure WriteString(const Str: RawByteString); virtual;
+ procedure WriteLine(const Line: RawByteString); virtual;
+
+ property LineBreak: RawByteString read fLineBreak write fLineBreak;
+ property Filename: IPath read fFilename;
+ end;
+
+ {**
+ * TMemTextStream
+ *}
+ TMemTextFileStream = class(TTextFileStream)
+ private
+ fStream: TMemoryStream;
+ protected
+ function GetSize: int64; override;
+
+ {**
+ * Copies fStream.Memory from StartPos to EndPos-1 to the result string;
+ *}
+ function CopyMemString(StartPos: int64; EndPos: int64): RawByteString;
+ public
+ constructor Create(Filename: IPath; Mode: word);
+ destructor Destroy(); override;
+
+ function Read(var Buffer; Count: longint): longint; override;
+ function Write(const Buffer; Count: longint): longint; override;
+ function Seek(Offset: longint; Origin: word): longint; override;
+ function Seek(const Offset: int64; Origin: TSeekOrigin): int64; override;
+
+ function ReadLine(var Success: boolean): RawByteString; override;
+ function ReadString(): RawByteString; override;
+ end;
+
+ {**
+ TUnicodeIniStream = class()
+ end;
+ *}
+
+ {**
+ * pdKeep: Keep path as is, neither remove or append a delimiter
+ * pdAppend: Append a delimiter if path does not have a trailing one
+ * pdRemove: Remove a trailing delimiter from the path
+ *}
+ TPathDelimOption = (pdKeep, pdAppend, pdRemove);
+
+ IPathDynArray = array of IPath;
+
+ {**
+ * An IPath represents a filename, a directory or a filesystem path in general.
+ * It hides some of the operating system's specifics like path delimiters
+ * and encodings and provides an easy to use interface to handle them.
+ * Internally all paths are stored with the same path delimiter (PathDelim)
+ * and encoding (UTF-8). The transformation is already done AT THE CREATION of
+ * the IPath and hence calls to e.g. IPath.Equal() will not distinguish between
+ * Unix and Windows style paths.
+ *
+ * Create new paths with one of the Path() functions.
+ * If you need a string representation use IPath.ToNative/ToUTF8/ToWide.
+ * Note that due to the path-delimiter and encoding transformation the string
+ * might have changed. Path('one\test/path').ToUTF8() might return 'one/test/path'.
+ *
+ * It is recommended to use an IPath as long as possible without a string
+ * conversion (IPath.To...()). The whole Delphi (< 2009) and FPC RTL is ANSI
+ * only on Windows. If you would use for example FileExists(MyPath.ToNative)
+ * it would not find a file which contains characters that are not in the
+ * current locale. Same applies to AssignFile(), TFileStream.Create() and
+ * everything else in the RTL that expects a filename.
+ * As a rule of thumb: NEVER use any of the Delphi/FPC RTL filename functions
+ * if the filename parameter is not of a UTF8String or WideString type.
+ *
+ * If you need to open a file use TBinaryStream or TFileStream instead. Many
+ * of the RTL classes offer a LoadFromStream() method so ANSI Open() methods
+ * can be workaround.
+ *
+ * If there is only a ANSI and no IPath/UTF-8/WideString version and you cannot
+ * even pass a stream instead of a filename be aware that even if you know that
+ * a filename is ASCII only, subdirectories in an absolute path might contain
+ * some non-ASCII characters (for example the user's name) and hence might
+ * fail (if the characters are not in the current locale).
+ * It is rare but it happens.
+ *
+ * IMPORTANT:
+ * This interface needs the cwstring unit on Unix (Max OS X / Linux) systems.
+ * Cwstring functions (WideUpperCase, ...) cannot be used by external threads
+ * as FPC uses Thread-Local-Storage for the implementation. As a result do not
+ * call IPath stuff by external threads (e.g. in C callbacks or by SDL-threads).
+ *}
+ IPath = interface
+ ['{686BF103-CE43-4598-B85D-A2C3AF950897}']
+ {**
+ * Returns the path as an UTF8 encoded string.
+ * If UseNativeDelim is set to true, the native path delimiter ('\' on win32)
+ * is used. If it is set to false the (more) portable '/' delimiter will used.
+ *}
+ function ToUTF8(UseNativeDelim: boolean = true): UTF8String;
+
+ {**
+ * Returns the path as an UTF-16 encoded string.
+ * If UseNativeDelim is set to true, the native path delimiter ('\' on win32)
+ * is used. If it is set to false the delimiter will be '/'.
+ *}
+ function ToWide(UseNativeDelim: boolean = true): WideString;
+
+ {**
+ * Returns the path with the system's native encoding and path delimiter.
+ * Win32: ANSI (use the UTF-16 version IPath.ToWide() whenever possible)
+ * Mac: UTF8
+ * Unix: UTF8 or ANSI according to LC_CTYPE
+ *}
+ function ToNative(): RawByteString;
+
+ {**
+ * Note: File must be closed with FileClose(Handle) after usage
+ * @seealso SysUtils.FileOpen()
+ *}
+ function Open(Mode: longword): TFileHandle;
+
+ {** @seealso SysUtils.ExtractFileDrive() *}
+ function GetDrive(): IPath;
+
+ {** @seealso SysUtils.ExtractFilePath() *}
+ function GetPath(): IPath;
+
+ {** @seealso SysUtils.ExtractFileDir() *}
+ function GetDir(): IPath;
+
+ {** @seealso SysUtils.ExtractFileName() *}
+ function GetName(): IPath;
+
+ {** @seealso SysUtils.ExtractFileExtension() *}
+ function GetExtension(): IPath;
+
+ {**
+ * Returns a copy of the path with the extension changed to Extension.
+ * The file itself is not changed, use Rename() for this task.
+ * @seealso SysUtils.ChangeFileExt()
+ *}
+ function SetExtension(const Extension: IPath): IPath; overload;
+ function SetExtension(const Extension: RawByteString): IPath; overload;
+ function SetExtension(const Extension: WideString): IPath; overload;
+
+ {**
+ * Returns the representation of the path relative to Basename.
+ * Note that the basename must be terminated with a path delimiter
+ * otherwise the last path component will be ignored.
+ * @seealso SysUtils.ExtractRelativePath()
+ *}
+ function GetRelativePath(const BaseName: IPath): IPath;
+
+ {** @seealso SysUtils.ExpandFileName() *}
+ function GetAbsolutePath(): IPath;
+
+ {**
+ * Returns the concatenation of this path with Child. If this path does not
+ * end with a path delimiter one is inserted in front of the Child path.
+ * Example: Path('parent').Append(Path('child')) -> Path('parent/child')
+ *}
+ function Append(const Child: IPath; DelimOption: TPathDelimOption = pdKeep): IPath; overload;
+ function Append(const Child: RawByteString; DelimOption: TPathDelimOption = pdKeep): IPath; overload;
+ function Append(const Child: WideString; DelimOption: TPathDelimOption = pdKeep): IPath; overload;
+
+ {**
+ * Splits the path into its components. Path delimiters are not removed from
+ * components.
+ * Example: C:\test\my\dir -> ['C:\', 'test\', 'my\', 'dir']
+ *}
+ function SplitDirs(): IPathDynArray;
+
+ {**
+ * Returns the parent directory or PATH_NONE if none exists.
+ *}
+ function GetParent(): IPath;
+
+ {**
+ * Checks if this path is a subdir of or file inside Parent.
+ * If Direct is true this path must be a direct child.
+ * Example: C:\test\file is a direct child of C:\test and a child of C:\
+ *}
+ function IsChildOf(const Parent: IPath; Direct: boolean): boolean;
+
+ {**
+ * Adjusts the case of the path on case senstitive filesystems.
+ * If the path does not exist or the filesystem is case insensitive
+ * the original path will be returned. Otherwise a corrected copy.
+ *}
+ function AdjustCase(AdjustAllLevels: boolean): IPath;
+
+ {** @seealso SysUtils.IncludeTrailingPathDelimiter() *}
+ function AppendPathDelim(): IPath;
+
+ {** @seealso SysUtils.ExcludeTrailingPathDelimiter() *}
+ function RemovePathDelim(): IPath;
+
+ function Exists(): boolean;
+ function IsFile(): boolean;
+ function IsDirectory(): boolean;
+ function IsAbsolute(): boolean;
+ function GetFileAge(): integer; overload;
+ function GetFileAge(out FileDateTime: TDateTime): boolean; overload;
+ function GetAttr(): cardinal;
+ function SetAttr(Attr: Integer): boolean;
+ function IsReadOnly(): boolean;
+ function SetReadOnly(ReadOnly: boolean): boolean;
+
+ {**
+ * Checks if this path points to nothing, that means the path consists of
+ * the empty string '' and hence equals PATH_NONE.
+ * This is a shortcut for IPath.Equals('') or IPath.Equals(PATH_NONE).
+ * If IsUnset() returns true this path and PATH_NONE are equal but they must
+ * not be identical as the references might point to different objects.
+ *
+ * Example:
+ * Path('').Equals(PATH_EMPTY) -> true
+ * Path('') = PATH_EMPTY -> false
+ *}
+ function IsUnset(): boolean;
+ function IsSet(): boolean;
+
+ {**
+ * Compares this path with Other and returns true if both paths are
+ * equal. Both paths are expanded and trailing slashes excluded before
+ * comparison. If IgnoreCase is true, the case will be ignored on
+ * case-sensitive filesystems.
+ *}
+ function Equals(const Other: IPath; IgnoreCase: boolean = false): boolean; overload;
+ function Equals(const Other: RawByteString; IgnoreCase: boolean = false): boolean; overload;
+ function Equals(const Other: WideString; IgnoreCase: boolean = false): boolean; overload;
+
+ {**
+ * Searches for a file in DirList. The Result is nil if the file was
+ * not found. Use IFileSystem.FileFind() instead if you want to use
+ * wildcards.
+ * @seealso SysUtils.FileSearch()
+ *}
+ function FileSearch(const DirList: IPath): IPath;
+
+ {**
+ * File must be closed with FileClose(Handle) after usage
+ *}
+ function CreateFile(): TFileHandle;
+ function DeleteFile(): boolean;
+ function CreateDirectory(Force: boolean = false): boolean;
+ function DeleteEmptyDir(): boolean;
+ function Rename(const NewName: IPath): boolean;
+ function CopyFile(const Target: IPath; FailIfExists: boolean): boolean;
+
+ // TODO: Dirwatch stuff
+ // AddFileChangeListener(Listener: TFileChangeListener);
+
+ {**
+ * Internal string representation. For debugging only.
+ *}
+ function GetIntern: UTF8String;
+ property Intern: UTF8String READ GetIntern;
+ end;
+
+{**
+ * Creates a new path with the given pathname. PathName can be either in UTF8
+ * or the local encoding.
+ * Notes:
+ * - On Apple only UTF8 is supported
+ * - Same applies to Unix with LC_CTYPE set to UTF8 encoding (default on newer systems)
+ *}
+function Path(const PathName: RawByteString; DelimOption: TPathDelimOption = pdKeep): IPath; overload;
+function Path(PathName: PChar; DelimOption: TPathDelimOption = pdKeep): IPath; overload;
+
+{**
+ * Creates a new path with the given UTF-16 pathname.
+ *}
+function Path(const PathName: WideString; DelimOption: TPathDelimOption = pdKeep): IPath; overload;
+
+{**
+ * Returns a singleton for Path('').
+ *}
+function PATH_NONE(): IPath;
+
+implementation
+
+uses
+ RTLConsts,
+ UTextEncoding,
+ UFilesystem;
+
+{*
+ * Due to a compiler bug in FPC <= 2.2.4 reference counting does not work
+ * properly with interfaces (see http://bugs.freepascal.org/view.php?id=14019).
+ *
+ * There are two (probably more) scenarios causes a program to crash:
+ *
+ * 1. Assume we execute Path('fail').GetParent().ToUTF8(). The compiler will
+ * internally create a temporary variable to hold the result of Path('fail').
+ * This temporary var is then passed as Self to GetParent(). Unfortunately FPC
+ * does already decrement the ref-count of the temporary var at the end of the
+ * call to Path('fail') and the ref-count drops to zero and the temp object
+ * is destroyed as FPC erroneously assumes that the temp is not used anymore.
+ * As a result the Self variable in GetParent() will be invalid, the same
+ * applies to TPathImpl.fName which reference count dropped to zero when the
+ * temp was destroyed. Hence GetParent() will likely crash.
+ * If it does not, ToUTF8() will either return some random string
+ * (e.g. '' or stupid stuff like 'fhwkjehdk') or crash.
+ * Either way the result of ToUTF8() is messed up.
+ * This scenario applies whenever a function (or method) is called that returns
+ * an interfaced object (e.g. an IPath) and the result is used without storing
+ * a reference to it in a (temporary) variable first.
+ *
+ * Tmp := Path('fail'); Tmp2 := Tmp.GetParent(); Tmp2.ToUTF8();
+ *
+ * will not crash but is very impractical and error-prone. Note that Tmp2 cannot
+ * be replaced with Tmp (see scenario 2).
+ *
+ * 2. Another situation this bug will ruin our lives is when a variable to an
+ * interfaced object is used at the left and right side of an assignment as in:
+ * MyPath := MyPath.GetParent()
+ *
+ * Although the bug is already fixed in the FPC development version 2.3.1
+ * it will take quite some time till the next FPC release (> 2.2.4) in which
+ * this issue is fixed.
+ *
+ * To workaround this bug we use some very simple and stupid kind of garbage
+ * collection. New IPaths are stored in an IInterfaceList (call it GarbaegeList)
+ * to artificially increase the ref-count of the newly created object.
+ * This keeps the object alive when FPC's temporary variable comes to the end
+ * of its lifetime and the object's ref-count is decremented
+ * (and is now 1 instead of 0).
+ * Later on, the object is either garbage or referenced by another variable.
+ *
+ * Look at
+ * MyPath := Path('SomeDir/SubDir').GetParent()
+ *
+ * (1) The result of Path('SomeDir/SubDir') is garbage as it is not used anymore.
+ * (2) The result of GetParent() is referenced by MyPath
+ * Object (1) has a reference count of 1 (as it is only referenced by the
+ * GarbageList). Object (2) is referenced twice (MyPath + GarbageList).
+ * When the reference to (2) is finally stored in MyPath we can safely remove
+ * (1) and (2) from the GarbageList so (1) will be freed and the ref-count of
+ * (2) will be decremented to 1.
+ *
+ * As we do not know when it is safe to remove an object from the GarbageList
+ * we assume that there are max. GarbageMaxCount IPath elements created until
+ * the execution of the expression is performed and a reference to the resulting
+ * object is assigned to a variable so all temps can be safely deleted.
+ *
+ * Worst-case scenarios are recursive calls or calls with large call stacks with
+ * functions that return an IPath. Also keep in mind that multiple threads might
+ * be executing such functions at the same time.
+ * A reasonable count might be a max. of 20.000 elements. With an average length
+ * of 40 UTF8 chars (maybe 60 byte with class info, pointer etc.) per IPath
+ * this will consume ~1.2MB.
+ *}
+{$IFDEF FPC}
+{$IF FPC_VERSION_INT <= 002002004} // <= 2.2.4
+ {$DEFINE HAVE_REFCNTBUG}
+{$IFEND}
+{$ENDIF}
+
+{$IFDEF HAVE_REFCNTBUG}
+const
+ // when GarbageList.Count reaches GarbageMaxCount the oldest references in
+ // GarbageList will be deleted until GarbageList.Count equals GarbageAfterCleanCount.
+ GarbageMaxCount = 20000;
+ GarbageAfterCleanCount = GarbageMaxCount-1000;
+
+var
+ GarbageList: IInterfaceList;
+{$ENDIF}
+
+type
+ TPathImpl = class(TInterfacedObject, IPath)
+ private
+ fName: UTF8String; //<** internal filename string, always UTF8 with PathDelim
+
+ {**
+ * Unifies the filename. Path-delimiters are replaced by '/'.
+ *}
+ procedure Unify(DelimOption: TPathDelimOption);
+
+ {**
+ * Returns a copy of fName with path delimiters changed to '/'.
+ *}
+ function GetPortableString(): UTF8String;
+
+ procedure AssertRefCount; {$IFDEF HasInline}inline;{$ENDIF}
+
+ public
+ constructor Create(const Name: UTF8String; DelimOption: TPathDelimOption);
+ destructor Destroy(); override;
+
+ function ToUTF8(UseNativeDelim: boolean): UTF8String;
+ function ToWide(UseNativeDelim: boolean): WideString;
+ function ToNative(): RawByteString;
+
+ function Open(Mode: longword): TFileHandle;
+
+ function GetDrive(): IPath;
+ function GetPath(): IPath;
+ function GetDir(): IPath;
+ function GetName(): IPath;
+ function GetExtension(): IPath;
+
+ function SetExtension(const Extension: IPath): IPath; overload;
+ function SetExtension(const Extension: RawByteString): IPath; overload;
+ function SetExtension(const Extension: WideString): IPath; overload;
+
+ function GetRelativePath(const BaseName: IPath): IPath;
+ function GetAbsolutePath(): IPath;
+ function GetParent(): IPath;
+ function SplitDirs(): IPathDynArray;
+
+ function Append(const Child: IPath; DelimOption: TPathDelimOption): IPath; overload;
+ function Append(const Child: RawByteString; DelimOption: TPathDelimOption): IPath; overload;
+ function Append(const Child: WideString; DelimOption: TPathDelimOption): IPath; overload;
+
+ function Equals(const Other: IPath; IgnoreCase: boolean): boolean; overload;
+ function Equals(const Other: RawByteString; IgnoreCase: boolean): boolean; overload;
+ function Equals(const Other: WideString; IgnoreCase: boolean): boolean; overload;
+
+ function IsChildOf(const Parent: IPath; Direct: boolean): boolean;
+
+ function AdjustCase(AdjustAllLevels: boolean): IPath;
+
+ function AppendPathDelim(): IPath;
+ function RemovePathDelim(): IPath;
+
+ function GetFileAge(): integer; overload;
+ function GetFileAge(out FileDateTime: TDateTime): boolean; overload;
+ function Exists(): boolean;
+ function IsFile(): boolean;
+ function IsDirectory(): boolean;
+ function IsAbsolute(): boolean;
+ function GetAttr(): cardinal;
+ function SetAttr(Attr: Integer): boolean;
+ function IsReadOnly(): boolean;
+ function SetReadOnly(ReadOnly: boolean): boolean;
+
+ function IsUnset(): boolean;
+ function IsSet(): boolean;
+
+ function FileSearch(const DirList: IPath): IPath;
+
+ function CreateFile(): TFileHandle;
+ function DeleteFile(): boolean;
+ function CreateDirectory(Force: boolean): boolean;
+ function DeleteEmptyDir(): boolean;
+ function Rename(const NewName: IPath): boolean;
+ function CopyFile(const Target: IPath; FailIfExists: boolean): boolean;
+
+ function GetIntern(): UTF8String;
+ end;
+
+function Path(const PathName: RawByteString; DelimOption: TPathDelimOption): IPath;
+begin
+ if (IsUTF8String(PathName)) then
+ Result := TPathImpl.Create(PathName, DelimOption)
+ else if (IsNativeUTF8()) then
+ Result := PATH_NONE
+ else
+ Result := TPathImpl.Create(AnsiToUtf8(PathName), DelimOption);
+end;
+
+function Path(PathName: PChar; DelimOption: TPathDelimOption): IPath;
+begin
+ Result := Path(RawByteString(PathName));
+end;
+
+function Path(const PathName: WideString; DelimOption: TPathDelimOption): IPath;
+begin
+ Result := TPathImpl.Create(UTF8Encode(PathName), DelimOption);
+end;
+
+
+
+procedure TPathImpl.AssertRefCount;
+begin
+ {$IFDEF HAVE_REFCNTBUG}
+ if (FRefCount <= 0) then
+ raise Exception.Create('RefCount error: ' + IntToStr(FRefCount));
+ {$ENDIF}
+end;
+
+constructor TPathImpl.Create(const Name: UTF8String; DelimOption: TPathDelimOption);
+begin
+ inherited Create();
+ fName := Name;
+ Unify(DelimOption);
+ {$IFDEF HAVE_REFCNTBUG}
+ GarbageList.Lock;
+ if (GarbageList.Count >= GarbageMaxCount) then
+ begin
+ while (GarbageList.Count > GarbageAfterCleanCount) do
+ GarbageList.Delete(0);
+ end;
+ GarbageList.Add(Self);
+ GarbageList.Unlock;
+ {$ENDIF}
+end;
+
+destructor TPathImpl.Destroy();
+begin
+ inherited;
+end;
+
+procedure TPathImpl.Unify(DelimOption: TPathDelimOption);
+var
+ I: integer;
+begin
+ // convert all path delimiters to native ones
+ for I := 1 to Length(fName) do
+ begin
+ if (fName[I] in ['\', '/']) and (fName[I] <> PathDelim) then
+ fName[I] := PathDelim;
+ end;
+
+ // Include/ExcludeTrailingPathDelimiter need PathDelim as path delimiter
+ case DelimOption of
+ pdAppend: fName := IncludeTrailingPathDelimiter(fName);
+ pdRemove: fName := ExcludeTrailingPathDelimiter(fName);
+ end;
+end;
+
+function TPathImpl.GetPortableString(): UTF8String;
+var
+ I: integer;
+begin
+ Result := fName;
+ if (PathDelim = '/') then
+ Exit;
+
+ for I := 1 to Length(Result) do
+ begin
+ if (Result[I] = PathDelim) then
+ Result[I] := '/';
+ end;
+end;
+
+function TPathImpl.ToUTF8(UseNativeDelim: boolean): UTF8String;
+begin
+ AssertRefCount;
+
+ if (UseNativeDelim) then
+ Result := fName
+ else
+ Result := GetPortableString();
+end;
+
+function TPathImpl.ToWide(UseNativeDelim: boolean): WideString;
+begin
+ if (UseNativeDelim) then
+ Result := UTF8Decode(fName)
+ else
+ Result := UTF8Decode(GetPortableString());
+end;
+
+function TPathImpl.ToNative(): RawByteString;
+begin
+ if (IsNativeUTF8()) then
+ Result := fName
+ else
+ Result := Utf8ToAnsi(fName);
+end;
+
+function TPathImpl.GetDrive(): IPath;
+begin
+ AssertRefCount;
+ Result := FileSystem.ExtractFileDrive(Self);
+end;
+
+function TPathImpl.GetPath(): IPath;
+begin
+ AssertRefCount;
+ Result := FileSystem.ExtractFilePath(Self);
+end;
+
+function TPathImpl.GetDir(): IPath;
+begin
+ AssertRefCount;
+ Result := FileSystem.ExtractFileDir(Self);
+end;
+
+function TPathImpl.GetName(): IPath;
+begin
+ AssertRefCount;
+ Result := FileSystem.ExtractFileName(Self);
+end;
+
+function TPathImpl.GetExtension(): IPath;
+begin
+ AssertRefCount;
+ Result := FileSystem.ExtractFileExt(Self);
+end;
+
+function TPathImpl.SetExtension(const Extension: IPath): IPath;
+begin
+ AssertRefCount;
+ Result := FileSystem.ChangeFileExt(Self, Extension);
+end;
+
+function TPathImpl.SetExtension(const Extension: RawByteString): IPath;
+begin
+ Result := SetExtension(Path(Extension));
+end;
+
+function TPathImpl.SetExtension(const Extension: WideString): IPath;
+begin
+ Result := SetExtension(Path(Extension));
+end;
+
+function TPathImpl.GetRelativePath(const BaseName: IPath): IPath;
+begin
+ AssertRefCount;
+ Result := FileSystem.ExtractRelativePath(BaseName, Self);
+end;
+
+function TPathImpl.GetAbsolutePath(): IPath;
+begin
+ AssertRefCount;
+ Result := FileSystem.ExpandFileName(Self);
+end;
+
+function TPathImpl.GetParent(): IPath;
+var
+ CurPath, ParentPath: IPath;
+begin
+ AssertRefCount;
+
+ Result := PATH_NONE;
+
+ CurPath := Self.RemovePathDelim();
+ // check if current path has a parent (no further '/')
+ if (Pos(PathDelim, CurPath.ToUTF8()) = 0) then
+ Exit;
+
+ // set new path and check if it has changed to avoid endless loops
+ // e.g. with invalid paths like '/C:' (GetPath() uses ':' as delimiter too)
+ // on delphi/win32
+ ParentPath := CurPath.GetPath();
+ if (ParentPath.ToUTF8 = CurPath.ToUTF8) then
+ Exit;
+
+ Result := ParentPath;
+end;
+
+function TPathImpl.SplitDirs(): IPathDynArray;
+var
+ CurPath: IPath;
+ Components: array of IPath;
+ CurPathStr: UTF8String;
+ DelimPos: integer;
+ I: integer;
+begin
+ SetLength(Result, 0);
+
+ if (Length(Self.ToUTF8(true)) = 0) then
+ Exit;
+
+ CurPath := Self;
+ SetLength(Components, 0);
+ repeat
+ SetLength(Components, Length(Components)+1);
+
+ CurPathStr := CurPath.ToUTF8();
+ DelimPos := LastDelimiter(PathDelim, SysUtils.ExcludeTrailingPathDelimiter(CurPathStr));
+ Components[High(Components)] := Path(Copy(CurPathStr, DelimPos+1, Length(CurPathStr)));
+
+ CurPath := CurPath.GetParent();
+ until (CurPath = PATH_NONE);
+
+ // reverse list
+ SetLength(Result, Length(Components));
+ for I := 0 to High(Components) do
+ Result[I] := Components[High(Components)-I];
+end;
+
+function TPathImpl.Append(const Child: IPath; DelimOption: TPathDelimOption): IPath;
+var
+ TmpResult: IPath;
+begin
+ AssertRefCount;
+
+ if (fName = '') then
+ TmpResult := Child
+ else
+ TmpResult := Path(Self.AppendPathDelim().ToUTF8() + Child.ToUTF8());
+
+ case DelimOption of
+ pdKeep: Result := TmpResult;
+ pdAppend: Result := TmpResult.AppendPathDelim;
+ pdRemove: Result := TmpResult.RemovePathDelim;
+ end;
+end;
+
+function TPathImpl.Append(const Child: RawByteString; DelimOption: TPathDelimOption): IPath;
+begin
+ AssertRefCount;
+ Result := Append(Path(Child), DelimOption);
+end;
+
+function TPathImpl.Append(const Child: WideString; DelimOption: TPathDelimOption): IPath;
+begin
+ AssertRefCount;
+ Result := Append(Path(Child), DelimOption);
+end;
+
+function TPathImpl.Equals(const Other: IPath; IgnoreCase: boolean): boolean;
+var
+ SelfPath, OtherPath: UTF8String;
+begin
+ SelfPath := Self.GetAbsolutePath().RemovePathDelim().ToUTF8();
+ OtherPath := Other.GetAbsolutePath().RemovePathDelim().ToUTF8();
+ if (FileSystem.IsCaseSensitive() and not IgnoreCase) then
+ Result := (CompareStr(SelfPath, OtherPath) = 0)
+ else
+ Result := (CompareText(SelfPath, OtherPath) = 0);
+end;
+
+function TPathImpl.Equals(const Other: RawByteString; IgnoreCase: boolean): boolean;
+begin
+ Result := Equals(Path(Other), IgnoreCase);
+end;
+
+function TPathImpl.Equals(const Other: WideString; IgnoreCase: boolean): boolean;
+begin
+ Result := Equals(Path(Other), IgnoreCase);
+end;
+
+function TPathImpl.IsChildOf(const Parent: IPath; Direct: boolean): boolean;
+var
+ SelfPath, ParentPath: UTF8String;
+begin
+ Result := false;
+
+ if (Direct) then
+ begin
+ SelfPath := Self.GetParent().GetAbsolutePath().AppendPathDelim().ToUTF8();
+ ParentPath := Parent.GetAbsolutePath().AppendPathDelim().ToUTF8();
+
+ // simply check if this paths parent path (SelfPath) equals ParentPath
+ Result := (SelfPath = ParentPath);
+ end
+ else
+ begin
+ SelfPath := Self.GetAbsolutePath().AppendPathDelim().ToUTF8();
+ ParentPath := Parent.GetAbsolutePath().AppendPathDelim().ToUTF8();
+
+ if (Length(SelfPath) <= Length(ParentPath)) then
+ Exit;
+
+ // check if ParentPath is a substring of SelfPath
+ if (FileSystem.IsCaseSensitive()) then
+ Result := (StrLComp(PAnsiChar(SelfPath), PAnsiChar(ParentPath), Length(ParentPath)) = 0)
+ else
+ Result := (StrLIComp(PAnsiChar(SelfPath), PAnsiChar(ParentPath), Length(ParentPath)) = 0)
+ end;
+end;
+
+function AdjustCaseRecursive(CurPath: IPath; AdjustAllLevels: boolean): IPath;
+var
+ OldParent, AdjustedParent: IPath;
+ LocalName: IPath;
+ PathFound: IPath;
+ PathWithAdjParent: IPath;
+ SearchInfo: TFileInfo;
+ FileIter: IFileIterator;
+ Pattern: IPath;
+begin
+ // if case-sensitive path exists there is no need to adjust case
+ if (CurPath.Exists()) then
+ begin
+ Result := CurPath;
+ Exit;
+ end;
+
+ LocalName := CurPath.RemovePathDelim().GetName();
+
+ // try to adjust parent
+ OldParent := CurPath.GetParent();
+ if (OldParent <> PATH_NONE) then
+ begin
+ if (not AdjustAllLevels) then
+ begin
+ AdjustedParent := OldParent;
+ end
+ else
+ begin
+ AdjustedParent := AdjustCaseRecursive(OldParent, AdjustAllLevels);
+ if (AdjustedParent = nil) then
+ begin
+ // parent path was not found case-insensitive
+ Result := nil;
+ Exit;
+ end;
+
+ // check if the path with adjusted parent can be found now
+ PathWithAdjParent := AdjustedParent.Append(LocalName);
+ if (PathWithAdjParent.Exists()) then
+ begin
+ Result := PathWithAdjParent;
+ Exit;
+ end;
+ end;
+ Pattern := AdjustedParent.Append(Path('*'));
+ end
+ else // path has no parent
+ begin
+ // the top path can either be absolute or relative
+ if (CurPath.IsAbsolute) then
+ begin
+ // the only absolute directory at Unix without a parent is root ('/')
+ // and hence does not need to be adjusted
+ Result := CurPath;
+ Exit;
+ end;
+ // this is a relative path, search in the current working dir
+ AdjustedParent := nil;
+ Pattern := Path('*');
+ end;
+
+ // compare name with all files in the current directory case-insensitive
+ FileIter := FileSystem.FileFind(Pattern, faAnyFile);
+ while (FileIter.HasNext()) do
+ begin
+ SearchInfo := FileIter.Next();
+ PathFound := SearchInfo.Name;
+ if (CompareText(LocalName.ToUTF8, PathFound.ToUTF8) = 0) then
+ begin
+ if (AdjustedParent <> nil) then
+ Result := AdjustedParent.Append(PathFound)
+ else
+ Result := PathFound;
+ Exit;
+ end;
+ end;
+
+ // no matching file found
+ Result := nil;
+end;
+
+function TPathImpl.AdjustCase(AdjustAllLevels: boolean): IPath;
+begin
+ AssertRefCount;
+
+ Result := Self;
+
+ if (FileSystem.IsCaseSensitive) then
+ begin
+ Result := AdjustCaseRecursive(Self, AdjustAllLevels);
+ if (Result = nil) then
+ Result := Self;
+ end;
+end;
+
+function TPathImpl.AppendPathDelim(): IPath;
+begin
+ AssertRefCount;
+ Result := FileSystem.IncludeTrailingPathDelimiter(Self);
+end;
+
+function TPathImpl.RemovePathDelim(): IPath;
+begin
+ AssertRefCount;
+ Result := FileSystem.ExcludeTrailingPathDelimiter(Self);
+end;
+
+function TPathImpl.CreateFile(): TFileHandle;
+begin
+ Result := FileSystem.FileCreate(Self);
+end;
+
+function TPathImpl.CreateDirectory(Force: boolean): boolean;
+begin
+ if (Force) then
+ Result := FileSystem.ForceDirectories(Self)
+ else
+ Result := FileSystem.DirectoryCreate(Self);
+end;
+
+function TPathImpl.Open(Mode: longword): TFileHandle;
+begin
+ Result := FileSystem.FileOpen(Self, Mode);
+end;
+
+function TPathImpl.GetFileAge(): integer;
+begin
+ Result := FileSystem.FileAge(Self);
+end;
+
+function TPathImpl.GetFileAge(out FileDateTime: TDateTime): boolean;
+begin
+ Result := FileSystem.FileAge(Self, FileDateTime);
+end;
+
+function TPathImpl.Exists(): boolean;
+begin
+ // note the different specifications of FileExists() on Win32 <> Unix
+ {$IFDEF MSWINDOWS}
+ Result := IsFile() or IsDirectory();
+ {$ELSE}
+ Result := FileSystem.FileExists(Self);
+ {$ENDIF}
+end;
+
+function TPathImpl.IsFile(): boolean;
+begin
+ // note the different specifications of FileExists() on Win32 <> Unix
+ {$IFDEF MSWINDOWS}
+ Result := FileSystem.FileExists(Self);
+ {$ELSE}
+ Result := Exists() and not IsDirectory();
+ {$ENDIF}
+end;
+
+function TPathImpl.IsDirectory(): boolean;
+begin
+ Result := FileSystem.DirectoryExists(Self);
+end;
+
+function TPathImpl.IsAbsolute(): boolean;
+begin
+ AssertRefCount;
+ Result := FileSystem.FileIsAbsolute(Self);
+end;
+
+function TPathImpl.GetAttr(): cardinal;
+begin
+ Result := FileSystem.FileGetAttr(Self);
+end;
+
+function TPathImpl.SetAttr(Attr: Integer): boolean;
+begin
+ Result := FileSystem.FileSetAttr(Self, Attr);
+end;
+
+function TPathImpl.IsReadOnly(): boolean;
+begin
+ Result := FileSystem.FileIsReadOnly(Self);
+end;
+
+function TPathImpl.SetReadOnly(ReadOnly: boolean): boolean;
+begin
+ Result := FileSystem.FileSetReadOnly(Self, ReadOnly);
+end;
+
+function TPathImpl.IsUnset(): boolean;
+begin
+ Result := (fName = '');
+end;
+
+function TPathImpl.IsSet(): boolean;
+begin
+ Result := (fName <> '');
+end;
+
+function TPathImpl.FileSearch(const DirList: IPath): IPath;
+begin
+ AssertRefCount;
+ Result := FileSystem.FileSearch(Self, DirList);
+end;
+
+function TPathImpl.Rename(const NewName: IPath): boolean;
+begin
+ Result := FileSystem.RenameFile(Self, NewName);
+end;
+
+function TPathImpl.DeleteFile(): boolean;
+begin
+ Result := FileSystem.DeleteFile(Self);
+end;
+
+function TPathImpl.DeleteEmptyDir(): boolean;
+begin
+ Result := FileSystem.RemoveDir(Self);
+end;
+
+function TPathImpl.CopyFile(const Target: IPath; FailIfExists: boolean): boolean;
+begin
+ Result := FileSystem.CopyFile(Self, Target, FailIfExists);
+end;
+
+function TPathImpl.GetIntern(): UTF8String;
+begin
+ Result := fName;
+end;
+
+
+{ TBinaryFileStream }
+
+constructor TBinaryFileStream.Create(const FileName: IPath; Mode: word);
+begin
+{$IFDEF MSWINDOWS}
+ inherited Create(FileName.ToWide(), Mode);
+{$ELSE}
+ inherited Create(FileName.ToNative(), Mode);
+{$ENDIF}
+end;
+
+{ TTextStream }
+
+constructor TTextFileStream.Create(Filename: IPath; Mode: word);
+begin
+ inherited Create();
+ fMode := Mode;
+ fFilename := Filename;
+ fLineBreak := sLineBreak;
+end;
+
+function TTextFileStream.ReadLine(var Line: UTF8String): boolean;
+begin
+ Line := ReadLine(Result);
+end;
+
+function TTextFileStream.ReadLine(var Line: AnsiString): boolean;
+begin
+ Line := ReadLine(Result);
+end;
+
+procedure TTextFileStream.WriteString(const Str: RawByteString);
+begin
+ WriteBuffer(Str[1], Length(Str));
+end;
+
+procedure TTextFileStream.WriteLine(const Line: RawByteString);
+begin
+ WriteBuffer(Line[1], Length(Line));
+ WriteBuffer(fLineBreak[1], Length(fLineBreak));
+end;
+
+{ TMemTextStream }
+
+constructor TMemTextFileStream.Create(Filename: IPath; Mode: word);
+var
+ FileStream: TBinaryFileStream;
+begin
+ inherited Create(Filename, Mode);
+
+ fStream := TMemoryStream.Create();
+
+ // load data to memory in read mode
+ if ((Mode and 3) in [fmOpenRead, fmOpenReadWrite]) then
+ begin
+ FileStream := TBinaryFileStream.Create(Filename, fmOpenRead);
+ try
+ fStream.LoadFromStream(FileStream);
+ finally
+ FileStream.Free;
+ end;
+ end
+ // check if file exists for write-mode
+ else if ((Mode and 3) = fmOpenWrite) and (not Filename.IsFile) then
+ begin
+ raise EFOpenError.CreateResFmt(@SFOpenError,
+ [FileName.GetAbsolutePath.ToNative]);
+ end;
+end;
+
+destructor TMemTextFileStream.Destroy();
+var
+ FileStream: TBinaryFileStream;
+ SaveMode: word;
+begin
+ // save changes in write mode (= not read-only mode)
+ if ((fMode and 3) <> fmOpenRead) then
+ begin
+ if (fMode = fmCreate) then
+ SaveMode := fmCreate
+ else
+ SaveMode := fmOpenWrite;
+ FileStream := TBinaryFileStream.Create(fFilename, SaveMode);
+ try
+ fStream.SaveToStream(FileStream);
+ finally
+ FileStream.Free;
+ end;
+ end;
+
+ fStream.Free;
+ inherited;
+end;
+
+function TMemTextFileStream.GetSize: int64;
+begin
+ Result := fStream.Size;
+end;
+
+function TMemTextFileStream.Read(var Buffer; Count: longint): longint;
+begin
+ Result := fStream.Read(Buffer, Count);
+end;
+
+function TMemTextFileStream.Write(const Buffer; Count: longint): longint;
+begin
+ Result := fStream.Write(Buffer, Count);
+end;
+
+function TMemTextFileStream.Seek(Offset: longint; Origin: word): longint;
+begin
+ Result := fStream.Seek(Offset, Origin);
+end;
+
+function TMemTextFileStream.Seek(const Offset: int64; Origin: TSeekOrigin): int64;
+begin
+ Result := fStream.Seek(Offset, Origin);
+end;
+
+function TMemTextFileStream.CopyMemString(StartPos: int64; EndPos: int64): RawByteString;
+var
+ LineLength: cardinal;
+ Temp: RawByteString;
+begin
+ LineLength := EndPos - StartPos;
+ if (LineLength > 0) then
+ begin
+ // set string length to line-length (+ zero-terminator)
+ SetLength(Temp, LineLength);
+ StrLCopy(PAnsiChar(Temp),
+ @PAnsiChar(fStream.Memory)[StartPos],
+ LineLength);
+ Result := Temp;
+ end
+ else
+ begin
+ Result := '';
+ end;
+end;
+
+function TMemTextFileStream.ReadString(): RawByteString;
+var
+ TextPtr: PAnsiChar;
+ CurPos, StartPos, FileSize: int64;
+begin
+ TextPtr := PAnsiChar(fStream.Memory);
+ CurPos := Position;
+ FileSize := Size;
+ StartPos := -1;
+
+ while (CurPos < FileSize) do
+ begin
+ // check for whitespace (tab, lf, cr, space)
+ if (TextPtr[CurPos] in [#9, #10, #13, ' ']) then
+ begin
+ // check if we are at the end of a string
+ if (StartPos > -1) then
+ Break;
+ end
+ else if (StartPos = -1) then // start of string found
+ begin
+ StartPos := CurPos;
+ end;
+ Inc(CurPos);
+ end;
+
+ if (StartPos = -1) then
+ Result := ''
+ else
+ begin
+ Result := CopyMemString(StartPos, CurPos);
+ fStream.Position := CurPos;
+ end;
+end;
+
+{*
+ * Implementation of ReadLine(). We need separate versions for UTF8String
+ * and AnsiString as "var" parameter types have to fit exactly.
+ * To avoid a var-parameter here, the internal version the Line parameter is
+ * used as return value.
+ *}
+function TMemTextFileStream.ReadLine(var Success: boolean): RawByteString;
+var
+ TextPtr: PAnsiChar;
+ CurPos, FileSize: int64;
+begin
+ TextPtr := PAnsiChar(fStream.Memory);
+ CurPos := fStream.Position;
+ FileSize := Size;
+
+ // check for EOF
+ if (CurPos >= FileSize) then
+ begin
+ Result := '';
+ Success := false;
+ Exit;
+ end;
+
+ Success := true;
+
+ while (CurPos < FileSize) do
+ begin
+ if (TextPtr[CurPos] in [#10, #13]) then
+ begin
+ // copy text line
+ Result := CopyMemString(fStream.Position, CurPos);
+
+ // handle windows style #13#10 (\r\n) newlines
+ if (TextPtr[CurPos] = #13) and
+ (CurPos+1 < FileSize) and
+ (TextPtr[CurPos+1] = #10) then
+ begin
+ Inc(CurPos);
+ end;
+
+ // update stream pos
+ fStream.Position := CurPos+1;
+
+ Exit;
+ end;
+ Inc(CurPos);
+ end;
+
+ Result := CopyMemString(fStream.Position, CurPos);
+ fStream.Position := FileSize;
+end;
+
+{ TUnicodeMemoryStream }
+
+procedure TUnicodeMemoryStream.LoadFromFile(const FileName: IPath);
+var
+ Stream: TStream;
+begin
+ Stream := TBinaryFileStream.Create(FileName, fmOpenRead or fmShareDenyWrite);
+ try
+ LoadFromStream(Stream);
+ finally
+ Stream.Free;
+ end;
+end;
+
+procedure TUnicodeMemoryStream.SaveToFile(const FileName: IPath);
+var
+ Stream: TStream;
+begin
+ Stream := TBinaryFileStream.Create(FileName, fmCreate);
+ try
+ SaveToStream(Stream);
+ finally
+ Stream.Free;
+ end;
+end;
+
+{ TUnicodeMemIniFile }
+
+constructor TUnicodeMemIniFile.Create(const FileName: IPath; UTF8Encoded: boolean);
+var
+ List: TStringList;
+ Stream: TBinaryFileStream;
+ BOMBuf: array[0..2] of AnsiChar;
+begin
+ inherited Create('');
+ FFilename := FileName;
+ FUTF8Encoded := UTF8Encoded;
+
+ if FileName.Exists() then
+ begin
+ List := nil;
+ Stream := nil;
+ try
+ List := TStringList.Create;
+ Stream := TBinaryFileStream.Create(FileName, fmOpenRead);
+ if (Stream.Read(BOMBuf[0], SizeOf(BOMBuf)) = 3) and
+ (CompareMem(PChar(UTF8_BOM), @BomBuf, Length(UTF8_BOM))) then
+ begin
+ // truncate BOM
+ FUTF8Encoded := true;
+ end
+ else
+ begin
+ // rewind file
+ Stream.Seek(0, soBeginning);
+ end;
+ List.LoadFromStream(Stream);
+ SetStrings(List);
+ finally
+ Stream.Free;
+ List.Free;
+ end;
+ end;
+end;
+
+procedure TUnicodeMemIniFile.UpdateFile;
+var
+ List: TStringList;
+ Stream: TBinaryFileStream;
+begin
+ List := nil;
+ Stream := nil;
+ try
+ List := TStringList.Create;
+ GetStrings(List);
+ Stream := TBinaryFileStream.Create(FFileName, fmCreate);
+ if UTF8Encoded then
+ Stream.Write(UTF8_BOM, Length(UTF8_BOM));
+ List.SaveToStream(Stream);
+ finally
+ List.Free;
+ Stream.Free;
+ end;
+end;
+
+
+var
+ PATH_NONE_Singelton: IPath;
+
+function PATH_NONE(): IPath;
+begin
+ Result := PATH_NONE_Singelton;
+end;
+
+initialization
+ {$IFDEF HAVE_REFCNTBUG}
+ GarbageList := TInterfaceList.Create();
+ GarbageList.Capacity := GarbageMaxCount;
+ {$ENDIF}
+ PATH_NONE_Singelton := Path('');
+
+finalization
+ PATH_NONE_Singelton := nil;
+
+end.
diff --git a/mediaplugin/src/base/UPathUtils.pas b/mediaplugin/src/base/UPathUtils.pas
new file mode 100644
index 00000000..2bfcde42
--- /dev/null
+++ b/mediaplugin/src/base/UPathUtils.pas
@@ -0,0 +1,201 @@
+{* 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);
+{$IF Defined(DARWIN)}
+ AddSongPath(Platform.GetMusicPath);
+ AddSongPath(UserPath.Append('songs'));
+{$ELSE}
+ AddSongPath(SharedPath.Append('songs'));
+ AddSongPath(UserPath.Append('songs'));
+{$IFEND}
+
+ // Add category cover paths
+ AddCoverPath(SharedPath.Append('covers'));
+ AddCoverPath(UserPath.Append('covers'));
+end;
+
+end.
diff --git a/mediaplugin/src/base/UPlatform.pas b/mediaplugin/src/base/UPlatform.pas
new file mode 100644
index 00000000..6d884979
--- /dev/null
+++ b/mediaplugin/src/base/UPlatform.pas
@@ -0,0 +1,136 @@
+{* 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 GetMusicPath: 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/mediaplugin/src/base/UPlatformLinux.pas b/mediaplugin/src/base/UPlatformLinux.pas
new file mode 100644
index 00000000..693facaa
--- /dev/null
+++ b/mediaplugin/src/base/UPlatformLinux.pas
@@ -0,0 +1,149 @@
+{* 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/mediaplugin/src/base/UPlatformMacOSX.pas b/mediaplugin/src/base/UPlatformMacOSX.pas
new file mode 100644
index 00000000..3a3e3f79
--- /dev/null
+++ b/mediaplugin/src/base/UPlatformMacOSX.pas
@@ -0,0 +1,302 @@
+{* 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.
+ *
+ * The log and benchmark files are stored in
+ * $HOME/Library/Log/UltraStar Deluxe/
+ *
+ * Music should go into ~/Music/UltraStar Deluxe/
+ *
+ * ~/Library/Application Support/UltraStarDeluxe/songs is also used.
+ * The idea is to remove this at some time.
+ *
+ *}
+ 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();
+
+ {**
+ * GetHomeDir returns the path to $HOME.
+ *}
+ 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/Logs/UltraStar Deluxe/.
+ *}
+ function GetLogPath: IPath; override;
+
+ {**
+ * GetMusicPath returns the path for music. Currently it is set to
+ * $HOME/Music/UltraStar Deluxe/.
+ *}
+ function GetMusicPath: IPath; override;
+
+ {**
+ * GetGameSharedPath returns the path for shared resources. Currently it
+ * is also set to $HOME/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 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('..')) and
+ (not CurPath.Equals('MacOS')) 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.GetHomeDir: IPath;
+begin
+ Result := Path(GetEnvironmentVariable('HOME'));
+end;
+
+function TPlatformMacOSX.GetApplicationSupportPath: IPath;
+begin
+ Result := GetHomeDir.Append('Library/Application Support/UltraStarDeluxe', pdAppend);
+end;
+
+function TPlatformMacOSX.GetLogPath: IPath;
+begin
+ Result := GetHomeDir.Append('Library/Logs/UltraStar Deluxe', pdAppend);
+end;
+
+function TPlatformMacOSX.GetMusicPath: IPath;
+begin
+ Result := GetHomeDir.Append('Music/UltraStar Deluxe', pdAppend);
+end;
+
+function TPlatformMacOSX.GetGameSharedPath: IPath;
+begin
+ Result := GetApplicationSupportPath;
+end;
+
+function TPlatformMacOSX.GetGameUserPath: IPath;
+begin
+ Result := GetApplicationSupportPath;
+end;
+
+end.
diff --git a/mediaplugin/src/base/UPlatformWindows.pas b/mediaplugin/src/base/UPlatformWindows.pas
new file mode 100644
index 00000000..91d3cce6
--- /dev/null
+++ b/mediaplugin/src/base/UPlatformWindows.pas
@@ -0,0 +1,209 @@
+{* 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
+ UseLocalDirs: boolean;
+
+ function GetSpecialPath(CSIDL: integer): IPath;
+ procedure DetectLocalExecution();
+ public
+ procedure Init; override;
+ 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;
+
+procedure TPlatformWindows.Init;
+begin
+ inherited Init();
+ DetectLocalExecution();
+end;
+
+//------------------------------
+//Start more than One Time Prevention
+//------------------------------
+function TPlatformWindows.TerminateIfAlreadyRunning(var WndTitle: String): Boolean;
+var
+ hWnd: THandle;
+ I: Integer;
+begin
+ Result := false;
+ hWnd:= FindWindow(nil, PChar(WndTitle));
+ //Programm already started
+ if (hWnd <> 0) then
+ begin
+ I := Messagebox(0, PChar('Another Instance of Ultrastar is already running. Continue ?'), PChar(WndTitle), MB_ICONWARNING or MB_YESNO);
+ if (I = IDYes) then
+ begin
+ I := 1;
+ repeat
+ Inc(I);
+ hWnd := FindWindow(nil, PChar(WndTitle + ' Instance ' + InttoStr(I)));
+ until (hWnd = 0);
+ WndTitle := WndTitle + ' Instance ' + InttoStr(I);
+ end
+ else
+ Result := true;
+ end;
+end;
+
+(**
+ * 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;
+
+{**
+ * Detects whether the was executed locally or globally.
+ * - Local mode:
+ * - Condition:
+ * - config.ini is writable or creatable in the directory of the executable.
+ * - Examples:
+ * - The USDX zip-archive has been unpacked to a directory with write.
+ * permissions
+ * - XP: USDX was installed to %ProgramFiles% and the user is an admin.
+ * - USDX is started from an external HD- or flash-drive
+ * - Behavior:
+ * Config files like config.ini or score db reside in the directory of the
+ * executable. This is useful to enable windows users to have a portable
+ * installation e.g. on an external hdd.
+ * This is also the default behaviour of usdx prior to version 1.1
+ * - Global mode:
+ * - Condition:
+ * - config.ini is not writable.
+ * - Examples:
+ * - Vista/7: USDX was installed to %ProgramFiles%.
+ * - XP: USDX was installed to %ProgramFiles% and the user is not an admin.
+ * - USDX is started from CD
+ * - Behavior:
+ * - The config files are in a separate folder (e.g. %APPDATA%\ultrastardx)
+ *
+ * On windows, resources (themes, language-files)
+ * reside in the directory of the executable in any case
+ *
+ * Sets UseLocalDirs to true if the game is executed locally, false otherwise.
+ *}
+procedure TPlatformWindows.DetectLocalExecution();
+var
+ LocalDir, ConfigIni: IPath;
+ Handle: TFileHandle;
+begin
+ LocalDir := GetExecutionDir();
+ ConfigIni := LocalDir.Append('config.ini');
+
+ // check if config.ini is writable or creatable, if so use local dirs
+ UseLocalDirs := false;
+ if (ConfigIni.Exists()) then
+ begin
+ // do not use a read-only config file
+ if (not ConfigIni.IsReadOnly()) then
+ begin
+ // Just open the file in read-write mode to be sure that we have access
+ // rights for it.
+ // Note: Do not use IsReadOnly() as it does not check file privileges, so
+ // a non-read-only file might not be writable for us.
+ Handle := ConfigIni.Open(fmOpenReadWrite);
+ if (Handle <> -1) then
+ begin
+ FileClose(Handle);
+ UseLocalDirs := true;
+ end;
+ end;
+ end
+ else // config.ini does not exist
+ begin
+ // try to create config.ini
+ Handle := ConfigIni.CreateFile();
+ if (Handle <> -1) then
+ begin
+ FileClose(Handle);
+ UseLocalDirs := true;
+ end;
+ end;
+end;
+
+function TPlatformWindows.GetLogPath: IPath;
+begin
+ Result := GetGameUserPath;
+end;
+
+function TPlatformWindows.GetGameSharedPath: IPath;
+begin
+ Result := GetExecutionDir();
+end;
+
+function TPlatformWindows.GetGameUserPath: IPath;
+begin
+ if UseLocalDirs then
+ Result := GetExecutionDir()
+ else
+ Result := GetSpecialPath(CSIDL_APPDATA).Append('ultrastardx', pdAppend);
+end;
+
+end.
diff --git a/mediaplugin/src/base/UPlaylist.pas b/mediaplugin/src/base/UPlaylist.pas
new file mode 100644
index 00000000..f12e06cf
--- /dev/null
+++ b/mediaplugin/src/base/UPlaylist.pas
@@ -0,0 +1,520 @@
+{* 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;
+ 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/mediaplugin/src/base/URecord.pas b/mediaplugin/src/base/URecord.pas
new file mode 100644
index 00000000..5cddcc77
--- /dev/null
+++ b/mediaplugin/src/base/URecord.pas
@@ -0,0 +1,904 @@
+{* 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: UTF8String;
+ end;
+
+ // soundcard input-devices information
+ TAudioInputDevice = class
+ public
+ CfgIndex: integer; // index of this device in Ini.InputDeviceConfig
+ Name: UTF8String; // soundcard name
+ Source: array of TAudioInputSource; // soundcard input-sources
+ SourceRestore: integer; // source-index that will be selected after capturing (-1: not detected)
+ MicSource: integer; // source-index of mic (-1: none detected)
+
+ 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;
+
+ TBooleanDynArray = array of boolean;
+
+ TAudioInputProcessor = class
+ public
+ Sound: array of TCaptureBuffer; // sound-buffers for every player
+ DeviceList: array of TAudioInputDevice;
+
+ constructor Create;
+ destructor Destroy; override;
+
+ procedure UpdateInputDeviceConfig;
+
+ {**
+ * Validates the mic settings.
+ * If a player was assigned to multiple mics a popup will be displayed
+ * with the ID of the player.
+ * The return value is the player number of the first player that is not
+ * configured correctly or 0 if all players are correct.
+ *}
+ function ValidateSettings: integer;
+
+ {**
+ * Checks if players 1 to PlayerCount are configured correctly.
+ * A player is configured if a device's channel is assigned to him.
+ * For each player (up to PlayerCount) the state will be in PlayerState.
+ * If a player's state is true the player is configured, otherwise not.
+ * The return value is the player number of the first player that is not
+ * configured correctly or 0 if all players are correct.
+ * The PlayerState array is zero based (index 0 for player 1).
+ *}
+ function CheckPlayersConfig(PlayerCount: cardinal;
+ var PlayerState: TBooleanDynArray): integer; overload;
+
+ {**
+ * Same as the array version but it does not output a state for each player.
+ *}
+ function CheckPlayersConfig(PlayerCount: cardinal): integer; overload;
+
+ {**
+ * Handle microphone input
+ *}
+ procedure HandleMicrophoneData(Buffer: PByteArray; Size: integer;
+ InputDevice: TAudioInputDevice);
+ end;
+
+ TAudioInputBase = class( TInterfacedObject, IAudioInput )
+ private
+ Started: boolean;
+ protected
+ function UnifyDeviceName(const name: UTF8String; deviceIndex: integer): UTF8String;
+ 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);
+ // assign added channels to no player
+ for i := channelIndex+1 to High(deviceCfg.ChannelToPlayerMap) do
+ begin
+ deviceCfg.ChannelToPlayerMap[i] := CHANNEL_OFF;
+ 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;
+ deviceCfg.Latency := LATENCY_AUTODETECT;
+
+ channelCount := device.AudioFormat.Channels;
+ SetLength(deviceCfg.ChannelToPlayerMap, channelCount);
+
+ for channelIndex := 0 to channelCount-1 do
+ begin
+ // Do not set any default on first start of USDX.
+ // Otherwise most probably the wrong device (internal sound card)
+ // will be selected.
+ // It is better to force the user to configure the mics himself.
+ deviceCfg.ChannelToPlayerMap[channelIndex] := CHANNEL_OFF;
+ end;
+ end;
+ end;
+end;
+
+function TAudioInputProcessor.ValidateSettings: integer;
+const
+ MAX_PLAYER_COUNT = 6; // FIXME: there should be a global variable for this
+var
+ I, J: integer;
+ PlayerID: integer;
+ PlayerMap: array [0 .. MAX_PLAYER_COUNT - 1] of boolean;
+ InputDevice: TAudioInputDevice;
+ InputDeviceCfg: PInputDeviceConfig;
+begin
+ // mark all players as unassigned
+ for I := 0 to High(PlayerMap) do
+ PlayerMap[I] := false;
+
+ // iterate over all active devices
+ for I := 0 to High(DeviceList) do
+ begin
+ InputDevice := DeviceList[I];
+ InputDeviceCfg := @Ini.InputDeviceConfig[InputDevice.CfgIndex];
+ // iterate over all channels of the current devices
+ for J := 0 to High(InputDeviceCfg.ChannelToPlayerMap) do
+ begin
+ // get player that was mapped to the current device channel
+ PlayerID := InputDeviceCfg.ChannelToPlayerMap[J];
+ if (PlayerID <> CHANNEL_OFF) then
+ begin
+ // check if player is already assigned to another device/channel
+ if (PlayerMap[PlayerID - 1]) then
+ begin
+ Result := PlayerID;
+ Exit;
+ end;
+
+ // mark player as assigned to a device
+ PlayerMap[PlayerID - 1] := true;
+ end;
+ end;
+ end;
+ Result := 0;
+end;
+
+function TAudioInputProcessor.CheckPlayersConfig(PlayerCount: cardinal;
+ var PlayerState: TBooleanDynArray): integer;
+var
+ DeviceIndex: integer;
+ ChannelIndex: integer;
+ Device: TAudioInputDevice;
+ DeviceCfg: PInputDeviceConfig;
+ PlayerIndex: integer;
+ I: integer;
+begin
+ SetLength(PlayerState, PlayerCount);
+ // set all entries to "not configured"
+ for I := 0 to High(PlayerState) do
+ begin
+ PlayerState[I] := false;
+ end;
+
+ // check 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];
+
+ // check if device is used
+ for ChannelIndex := 0 to High(DeviceCfg.ChannelToPlayerMap) do
+ begin
+ PlayerIndex := DeviceCfg.ChannelToPlayerMap[ChannelIndex] - 1;
+ if (PlayerIndex >= 0) and (PlayerIndex < PlayerCount) then
+ PlayerState[PlayerIndex] := true;
+ end;
+ end;
+
+ Result := 0;
+ for I := 0 to High(PlayerState) do
+ begin
+ if (PlayerState[I] = false) then
+ begin
+ Result := I + 1;
+ Break;
+ end;
+ end;
+end;
+
+function TAudioInputProcessor.CheckPlayersConfig(PlayerCount: cardinal): integer;
+var
+ PlayerState: TBooleanDynArray;
+begin
+ Result := CheckPlayersConfig(PlayerCount, PlayerState);
+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: UTF8String; deviceIndex: integer): UTF8String;
+var
+ count: integer; // count of devices with this name
+
+ function IsDuplicate(const name: UTF8String): boolean;
+ var
+ i: integer;
+ begin
+ Result := false;
+ // search devices with same description
+ for i := 0 to deviceIndex-1 do
+ begin
+ if (AudioInputProcessor.DeviceList[i] <> nil) then
+ begin
+ if (AudioInputProcessor.DeviceList[i].Name = name) then
+ begin
+ Result := true;
+ Break;
+ end;
+ 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/mediaplugin/src/base/URingBuffer.pas b/mediaplugin/src/base/URingBuffer.pas
new file mode 100644
index 00000000..684c13ee
--- /dev/null
+++ b/mediaplugin/src/base/URingBuffer.pas
@@ -0,0 +1,165 @@
+{* 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 URingBuffer;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+uses
+ SysUtils;
+
+type
+ TRingBuffer = class
+ private
+ RingBuffer: PByteArray;
+ BufferCount: integer;
+ BufferSize: integer;
+ WritePos: integer;
+ ReadPos: integer;
+ public
+ constructor Create(Size: integer);
+ destructor Destroy; override;
+ function Read(Buffer: PByteArray; Count: integer): integer;
+ function Write(Buffer: PByteArray; Count: integer): integer;
+ function Size(): integer;
+ function Available(): integer;
+ procedure Flush();
+ end;
+
+implementation
+
+uses
+ Math;
+
+constructor TRingBuffer.Create(Size: integer);
+begin
+ BufferSize := Size;
+
+ GetMem(RingBuffer, Size);
+ if (RingBuffer = nil) then
+ raise Exception.Create('No memory');
+end;
+
+destructor TRingBuffer.Destroy;
+begin
+ FreeMem(RingBuffer);
+end;
+
+function TRingBuffer.Read(Buffer: PByteArray; Count: integer): integer;
+var
+ PartCount: integer;
+begin
+ // adjust output count
+ if (Count > BufferCount) then
+ begin
+ //DebugWriteln('Read too much: ' + inttostr(count) +',count:'+ inttostr(BufferCount) + '/size:' + inttostr(BufferSize));
+ Count := BufferCount;
+ end;
+
+ // check if there is something to do
+ if (Count <= 0) then
+ begin
+ Result := Count;
+ Exit;
+ end;
+
+ // copy data to output buffer
+
+ // first step: copy from the area between the read-position and the end of the buffer
+ PartCount := Min(Count, BufferSize - ReadPos);
+ Move(RingBuffer[ReadPos], Buffer[0], PartCount);
+
+ // second step: if we need more data, copy from the beginning of the buffer
+ if (PartCount < Count) then
+ Move(RingBuffer[0], Buffer[0], Count-PartCount);
+
+ // mark the copied part of the buffer as free
+ BufferCount := BufferCount - Count;
+ ReadPos := (ReadPos + Count) mod BufferSize;
+
+ Result := Count;
+end;
+
+function TRingBuffer.Write(Buffer: PByteArray; Count: integer): integer;
+var
+ PartCount: integer;
+begin
+ // check for a reasonable request
+ if (Count <= 0) then
+ begin
+ Result := Count;
+ Exit;
+ end;
+
+ // skip input data if the input buffer is bigger than the ring-buffer
+ if (Count > BufferSize) then
+ begin
+ //DebugWriteln('Write skip data:' + inttostr(count) +',count:'+ inttostr(BufferCount) + '/size:' + inttostr(BufferSize));
+ Buffer := @Buffer[Count - BufferSize];
+ Count := BufferSize;
+ end;
+
+ // first step: copy to the area between the write-position and the end of the buffer
+ PartCount := Min(Count, BufferSize - WritePos);
+ Move(Buffer[0], RingBuffer[WritePos], PartCount);
+
+ // second step: copy data to front of buffer
+ if (PartCount < Count) then
+ Move(Buffer[PartCount], RingBuffer[0], Count-PartCount);
+
+ // update info
+ BufferCount := Min(BufferCount + Count, BufferSize);
+ WritePos := (WritePos + Count) mod BufferSize;
+ // if the buffer is full, we have to reposition the read-position
+ if (BufferCount = BufferSize) then
+ ReadPos := WritePos;
+
+ Result := Count;
+end;
+
+function TRingBuffer.Available(): integer;
+begin
+ Result := BufferCount;
+end;
+
+function TRingBuffer.Size(): integer;
+begin
+ Result := BufferSize;
+end;
+
+procedure TRingBuffer.Flush();
+begin
+ ReadPos := 0;
+ WritePos := 0;
+ BufferCount := 0;
+end;
+
+end.
diff --git a/mediaplugin/src/base/USingNotes.pas b/mediaplugin/src/base/USingNotes.pas
new file mode 100644
index 00000000..dcfaff9f
--- /dev/null
+++ b/mediaplugin/src/base/USingNotes.pas
@@ -0,0 +1,42 @@
+{* 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 USingNotes;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+{ Dummy Unit atm
+ For further explanation
+ Placeholder for Class that will handle the Notes Drawing}
+
+implementation
+
+end.
diff --git a/mediaplugin/src/base/USingScores.pas b/mediaplugin/src/base/USingScores.pas
new file mode 100644
index 00000000..26c5dfe8
--- /dev/null
+++ b/mediaplugin/src/base/USingScores.pas
@@ -0,0 +1,1122 @@
+{* 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
+ aPositions: 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;
+ property Positions: aScorePosition read aPositions;
+
+ // 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
+ aPositions[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 := ftOutline1;
+ 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;
+
+ CurPopUp := FirstPopUp;
+ while (CurPopUp <> nil) do
+ begin
+ if (CurPopUp.Player = Index) then
+ begin // add points left "in" popup to result
+ Inc(Result, CurPopUp.ScoreDiff - CurPopUp.ScoreGiven);
+ end;
+ CurPopUp := CurPopUp.Next;
+ end;
+end;
+
+{**
+ * has to be called after positions and players have been added, before first call of draw
+ * it gives each player a score position
+ *}
+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 ((aPositions[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 ((aPositions[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
+ Diff := Round(RoundTo((RaisePerSecond * TimePassed) / 1000, 1));
+
+ { minimal raise per frame = 1 }
+ if Abs(Diff) < 1 then
+ Diff := Sign(S);
+
+ if (Abs(Diff) < Abs(S)) then
+ Inc(aPlayers[Index].ScoreDisplayed, Diff)
+ else
+ Inc(aPlayers[Index].ScoreDisplayed, S);
+ end;
+end;
+
+{**
+ * 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 := aPositions[PIndex].PUW * Sin(Progress/2*Pi);
+ H := aPositions[PIndex].PUH * Sin(Progress/2*Pi);
+
+ X := aPositions[PIndex].PUStartX + (aPositions[PIndex].PUW - W)/2;
+ Y := aPositions[PIndex].PUStartY + (aPositions[PIndex].PUH - H)/2;
+
+ FontSize := Round(Progress * aPositions[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 := aPositions[PIndex].PUW;
+ H := aPositions[PIndex].PUH;
+
+ PosDiff := aPositions[PIndex].PUTargetX - aPositions[PIndex].PUStartX;
+ if PosDiff > 0 then
+ PosDiff := PosDiff + W;
+ X := aPositions[PIndex].PUStartX + PosDiff * sqr(Progress);
+
+ PosDiff := aPositions[PIndex].PUTargetY - aPositions[PIndex].PUStartY;
+ if PosDiff < 0 then
+ PosDiff := PosDiff + aPositions[PIndex].BGH;
+ Y := aPositions[PIndex].PUStartY + PosDiff * sqr(Progress);
+
+ FontSize := aPositions[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 := aPositions[PIndex].PUW;
+ H := aPositions[PIndex].PUH;
+
+ PosDiff := aPositions[PIndex].PUTargetX - aPositions[PIndex].PUStartX;
+ if (PosDiff > 0) then
+ PosDiff := W
+ else
+ PosDiff := 0;
+ X := aPositions[PIndex].PUTargetX + PosDiff * Progress;
+
+ PosDiff := aPositions[PIndex].PUTargetY - aPositions[PIndex].PUStartY;
+ if (PosDiff < 0) then
+ PosDiff := -aPositions[PIndex].BGH
+ else
+ PosDiff := 0;
+ Y := aPositions[PIndex].PUTargetY - PosDiff * (1 - Progress);
+
+ FontSize := aPositions[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(aPositions[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 := @aPositions[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 := @aPositions[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/mediaplugin/src/base/USkins.pas b/mediaplugin/src/base/USkins.pas
new file mode 100644
index 00000000..a909b081
--- /dev/null
+++ b/mediaplugin/src/base/USkins.pas
@@ -0,0 +1,248 @@
+{* 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,
+ UCommon;
+
+type
+ TSkinTexture = record
+ Name: string;
+ FileName: IPath;
+ end;
+
+ TSkinEntry = record
+ Theme: string;
+ Name: string;
+ Path: IPath;
+ FileName: IPath;
+
+ DefaultColor: integer;
+ 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;
+ function GetDefaultColor(SkinNo: integer): integer;
+
+ procedure GetSkinsByTheme(Theme: string; out Skins: TUTF8StringDynArray);
+
+ procedure onThemeChange;
+ end;
+
+var
+ Skin: TSkin;
+
+implementation
+
+uses
+ IniFiles,
+ Classes,
+ SysUtils,
+ Math,
+ 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', '');
+ Skin[S].DefaultColor := Max(0, GetArrayIndex(IColor, SkinIni.ReadString('Skin', 'Color', ''), true));
+
+ 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;
+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 CompareText(Skin[S].Name, Name) = 0 then
+ Result := S;
+end;
+
+procedure TSkin.GetSkinsByTheme(Theme: string; out Skins: TUTF8StringDynArray);
+ var
+ I: Integer;
+ Len: integer;
+begin
+ SetLength(Skins, 0);
+ Len := 0;
+
+ for I := 0 to High(Skin) do
+ if CompareText(Theme, Skin[I].Theme) = 0 then
+ begin
+ SetLength(Skins, Len + 1);
+ Skins[Len] := Skin[I].Name;
+ Inc(Len);
+ end;
+end;
+
+{ returns number of default color for skin with
+ index SkinNo in ISkin (not in the actual skin array) }
+function TSkin.GetDefaultColor(SkinNo: integer): integer;
+ var
+ I: Integer;
+begin
+ Result := 0;
+
+ for I := 0 to High(Skin) do
+ if CompareText(ITheme[Ini.Theme], Skin[I].Theme) = 0 then
+ begin
+ if SkinNo > 0 then
+ Dec(SkinNo)
+ else
+ begin
+ Result := Skin[I].DefaultColor;
+ Break;
+ end;
+ end;
+end;
+
+procedure TSkin.onThemeChange;
+begin
+ Ini.SkinNo:=0;
+ GetSkinsByTheme(ITheme[Ini.Theme], ISkin);
+end;
+
+end.
diff --git a/mediaplugin/src/base/USong.pas b/mediaplugin/src/base/USong.pas
new file mode 100644
index 00000000..e92c5b45
--- /dev/null
+++ b/mediaplugin/src/base/USong.pas
@@ -0,0 +1,1303 @@
+{* 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;
+ 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
+
+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
+ LinePos := OldLinePos;
+ raise EUSDXParseException.Create('Character expected');
+ end
+ else if (Length(Str) > 1) then
+ begin
+ Log.LogWarn(Format('"%s" in line %d: %s',
+ [FileName.ToNative, FileLineNo, 'character expected but found "' + Str + '"']),
+ 'TSong.ParseLyricCharParam');
+ end;
+
+ LinePos := OldLinePos + 1;
+ Result := Str[1];
+end;
+
+{**
+ * 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
+ begin
+ Log.LogWarn(Format('"%s" in line %d: %s',
+ [FileNamePath.ToNative, FileLineNo,
+ 'found note with length zero -> converted to FreeStyle']),
+ 'TSong.LoadSong');
+ //Log.LogError('Found zero-length note at "'+Param0+' '+IntToStr(Param1)+' '+IntToStr(Param2)+' '+IntToStr(Param3)+ParamLyric+'" -> Note ignored!')
+ Param0 := 'F';
+ end;
+
+ // 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 // 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.LogInfo('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, Ini.DefaultEncoding);
+ 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;
+
+procedure TSong.ParseNote(LineNumber: integer; TypeP: char; StartP, DurationP, NoteP: integer; LyricS: UTF8String);
+begin
+ 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 := Ini.DefaultEncoding;
+
+ // 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/mediaplugin/src/base/USongs.pas b/mediaplugin/src/base/USongs.pas
new file mode 100644
index 00000000..cfc32a99
--- /dev/null
+++ b/mediaplugin/src/base/USongs.pas
@@ -0,0 +1,845 @@
+{* 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,
+ UIni,
+ 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: TSortingType);
+ 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,
+ 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: TSortingType);
+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 TSortingType(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(TSortingType(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 (TSortingType(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/mediaplugin/src/base/UTextEncoding.pas b/mediaplugin/src/base/UTextEncoding.pas
new file mode 100644
index 00000000..0c9ba4cc
--- /dev/null
+++ b/mediaplugin/src/base/UTextEncoding.pas
@@ -0,0 +1,248 @@
+{* 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,
+ UCommon,
+ 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/mediaplugin/src/base/UTexture.pas b/mediaplugin/src/base/UTexture.pas
new file mode 100644
index 00000000..c1334dd7
--- /dev/null
+++ b/mediaplugin/src/base/UTexture.pas
@@ -0,0 +1,548 @@
+{* 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.LogInfo('Unknown texture type: "' + TypeStr + '". Using default texture type "'
+ + TextureTypeToStr(Default) + '"', 'UTexture.ParseTextureType');
+ Result := Default;
+end;
+
+end.
diff --git a/mediaplugin/src/base/UThemes.pas b/mediaplugin/src/base/UThemes.pas
new file mode 100644
index 00000000..b385406f
--- /dev/null
+++ b/mediaplugin/src/base/UThemes.pas
@@ -0,0 +1,2501 @@
+{* 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;
+ Typ: TTextureType;
+ TexSBG: string;
+ TypSBG: TTextureType;
+ 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;
+ Statics: 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;
+ StaticPlayerIdBox: 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;
+
+ {ButtonNext: TThemeButton;
+ ButtonPrev: TThemeButton;}
+ end;
+
+ TThemePartyPlayer = class(TThemeBasic)
+ SelectTeams: TThemeSelectSlide;
+ SelectPlayers1: TThemeSelectSlide;
+ SelectPlayers2: TThemeSelectSlide;
+ SelectPlayers3: TThemeSelectSlide;
+
+ 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;
+
+ TThemePartyRounds = class(TThemeBasic)
+ SelectRoundCount: TThemeSelectSlide;
+ SelectRound: array [0..6] of TThemeSelectSlide;
+ 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;
+
+ TThemeEntry = record
+ Name: string;
+ Filename: IPath;
+ DefaultSkin: integer;
+ Creator: string;
+ end;
+
+ TTheme = class
+ private
+ {$IFDEF THEMESAVE}
+ ThemeIni: TIniFile;
+ {$ELSE}
+ ThemeIni: TMemIniFile;
+ {$ENDIF}
+
+ LastThemeBasic: TThemeBasic;
+ procedure CreateThemeObjects();
+ procedure LoadHeader(FileName: IPath);
+ public
+ Themes: array of TThemeEntry;
+ 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;
+ PartyRounds: TThemePartyRounds;
+
+ //Stats Screens:
+ StatMain: TThemeStatMain;
+ StatDetail: TThemeStatDetail;
+
+ Playlist: TThemePlaylist;
+
+ ILevel: array[0..2] of UTF8String;
+
+ constructor Create;
+
+ procedure LoadList;
+
+ function LoadTheme(ThemeNum: integer; 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,
+ UPathUtils,
+ UFileSystem,
+ TextGL,
+ gl,
+ glext,
+ math,
+ StrUtils;
+
+//-----------
+//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;
+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;
+ PartyRounds := TThemePartyRounds.Create;
+
+ //Stats Screens:
+ StatMain := TThemeStatMain.Create;
+ StatDetail := TThemeStatDetail.Create;
+
+ //LoadTheme(FileName, Color);
+ LoadList;
+end;
+
+procedure TTheme.LoadHeader(FileName: IPath);
+ var
+ Entry: TThemeEntry;
+ Ini: TMemIniFile;
+ SkinName: string;
+ SkinsFound: boolean;
+ ThemeVersion: string;
+ I: integer;
+ Len: integer;
+ Skins: TUTF8StringDynArray;
+begin
+ Entry.Filename := ThemePath.Append(FileName);
+ //read info from theme header
+ Ini := TMemIniFile.Create(Entry.Filename.ToNative);
+
+ Entry.Name := Ini.ReadString('Theme', 'Name', FileName.SetExtension('').ToNative);
+ ThemeVersion := Trim(UpperCase(Ini.ReadString('Theme', 'US_Version', 'no version tag')));
+ Entry.Creator := Ini.ReadString('Theme', 'Creator', 'Unknown');
+ SkinName := Ini.ReadString('Theme', 'DefaultSkin', FileName.SetExtension('').ToNative);
+
+ Ini.Free;
+
+ // don't load theme with wrong version tag
+ if ThemeVersion <> 'USD 110' then
+ begin
+ Log.LogWarn('Wrong Version (' + ThemeVersion + ') in Theme : ' + Entry.Name, 'Theme.LoadHeader');
+ end
+ else
+ begin
+ //Search for Skins for this Theme
+ SkinsFound := false;
+ for I := Low(Skin.Skin) to High(Skin.Skin) do
+ begin
+ if (CompareText(Skin.Skin[I].Theme, Entry.Name) = 0) then
+ begin
+ SkinsFound := true;
+ break;
+ end;
+ end;
+
+ if SkinsFound then
+ begin
+ { found a valid Theme }
+ // set correct default skin
+ Skin.GetSkinsByTheme(Entry.Name, Skins);
+ Entry.DefaultSkin := max(0, GetArrayIndex(Skins, SkinName, true));
+
+ Len := Length(Themes);
+ SetLength(Themes, Len + 1);
+ SetLength(ITheme, Len + 1);
+ Themes[Len] := Entry;
+ ITheme[Len] := Entry.Name;
+ end;
+ end;
+end;
+
+procedure TTheme.LoadList;
+ var
+ Iter: IFileIterator;
+ FileInfo: TFileInfo;
+begin
+ Log.LogStatus('Searching for Theme : ' + ThemePath.ToNative + '*.ini', 'Theme.LoadList');
+
+ Iter := FileSystem.FileFind(ThemePath.Append('*.ini'), 0);
+ while (Iter.HasNext) do
+ begin
+ FileInfo := Iter.Next;
+ Log.LogStatus('Found Theme: ' + FileInfo.Name.ToNative, 'Theme.LoadList');
+ LoadHeader(Fileinfo.Name);
+ end;
+end;
+
+function TTheme.LoadTheme(ThemeNum: integer; sColor: integer): boolean;
+var
+ I: integer;
+begin
+ Result := false;
+
+ CreateThemeObjects();
+
+ Log.LogStatus('Loading: '+ Themes[ThemeNum].FileName.ToNative, 'TTheme.LoadTheme');
+
+ if not Themes[ThemeNum].FileName.IsFile() then
+ begin
+ Log.LogError('Theme does not exist ('+ Themes[ThemeNum].FileName.ToNative +')', 'TTheme.LoadTheme');
+ end;
+
+ if Themes[ThemeNum].FileName.IsFile() then
+ begin
+ Result := true;
+
+ {$IFDEF THEMESAVE}
+ ThemeIni := TIniFile.Create(Themes[ThemeNum].FileName.ToNative);
+ {$ELSE}
+ ThemeIni := TMemIniFile.Create(Themes[ThemeNum].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.StaticPlayerIdBox[I], 'ScoreStaticPlayerIdBox' + 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');
+ {ThemeLoadButton (ButtonNext, 'ButtonNext');
+ ThemeLoadButton (ButtonPrev, 'ButtonPrev');}
+
+ //Party Player
+ ThemeLoadBasic(PartyPlayer, 'PartyPlayer');
+
+ ThemeLoadSelectSlide(PartyPlayer.SelectTeams, 'PartyPlayerSelectTeams');
+ ThemeLoadSelectSlide(PartyPlayer.SelectPlayers1, 'PartyPlayerSelectPlayers1');
+ ThemeLoadSelectSlide(PartyPlayer.SelectPlayers2, 'PartyPlayerSelectPlayers2');
+ ThemeLoadSelectSlide(PartyPlayer.SelectPlayers3, 'PartyPlayerSelectPlayers3');
+
+ ThemeLoadButton(PartyPlayer.Team1Name, 'PartyPlayerTeam1Name');
+ ThemeLoadButton(PartyPlayer.Player1Name, 'PartyPlayerPlayer1Name');
+ ThemeLoadButton(PartyPlayer.Player2Name, 'PartyPlayerPlayer2Name');
+ 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');
+
+ // Party Rounds
+ ThemeLoadBasic(PartyRounds, 'PartyRounds');
+
+ ThemeLoadSelectSlide(PartyRounds.SelectRoundCount, 'PartyRoundsSelectRoundCount');
+ for I := 0 to High(PartyRounds.SelectRound) do
+ ThemeLoadSelectSlide(PartyRounds.SelectRound[I], 'PartyRoundsSelectRound' + IntToStr(I + 1));
+
+ {ThemeLoadButton(ButtonNext, 'PartyPlayerButtonNext');
+ ThemeLoadButton(ButtonPrev, 'PartyPlayerButtonPrev');}
+
+ 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.Statics, 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', ftNormal);
+ 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.Typ := ParseTextureType(ThemeIni.ReadString(Name, 'Type', ''), TEXTURE_TYPE_PLAIN);
+ ThemeSelectS.TexSBG := {Skin.SkinPath + }ThemeIni.ReadString(Name, 'TexSBG', '');
+ ThemeSelectS.TypSBG := ParseTextureType(ThemeIni.ReadString(Name, 'TypeSBG', ''), TEXTURE_TYPE_PLAIN);
+
+ ThemeSelectS.X := ThemeIni.ReadInteger(Name, 'X', 0);
+ ThemeSelectS.Y := ThemeIni.ReadInteger(Name, 'Y', 0);
+ 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);
+
+ ThemeSelectS.showArrows := (ThemeIni.ReadInteger(Name, 'ShowArrows', 0) = 1);
+ ThemeSelectS.oneItemOnly := (ThemeIni.ReadInteger(Name, 'OneItemOnly', 0) = 1);
+end;
+
+procedure TTheme.ThemeLoadEqualizer(var ThemeEqualizer: TThemeEqualizer; const Name: string);
+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 := 212/255;
+ Result.G := 71/255;
+ Result.B := 247/255;
+ end;
+ 5: begin
+ // orange
+ Result.R := 247/255;
+ Result.G := 144/255;
+ Result.B := 71/255;
+ 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.Statics, 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/mediaplugin/src/base/UTime.pas b/mediaplugin/src/base/UTime.pas
new file mode 100644
index 00000000..0610ef59
--- /dev/null
+++ b/mediaplugin/src/base/UTime.pas
@@ -0,0 +1,246 @@
+{* 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 UTime;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+type
+ TTime = class
+ public
+ constructor Create;
+ function GetTime(): real;
+ end;
+
+ TRelativeTimerState = (rtsStopped, rtsWait, rtsPaused, rtsRunning);
+
+ TRelativeTimer = class
+ private
+ AbsoluteTime: int64; // system-clock reference time for calculation of CurrentTime
+ RelativeTime: real;
+ TriggerMode: boolean;
+ State: TRelativeTimerState;
+ public
+ constructor Create();
+ procedure Start(WaitForTrigger: boolean = false);
+ procedure Pause();
+ procedure Stop();
+ function GetTime(): real;
+ procedure SetTime(Time: real);
+ function GetState(): TRelativeTimerState;
+ end;
+
+ TSyncSource = class
+ function GetClock(): real; virtual; abstract;
+ end;
+
+procedure CountSkipTimeSet;
+procedure CountSkipTime;
+procedure CountMidTime;
+
+var
+ USTime: TTime;
+ VideoBGTimer: TRelativeTimer;
+
+ TimeNew: int64;
+ TimeOld: int64;
+ TimeSkip: real;
+ TimeMid: real;
+ TimeMidTemp: int64;
+
+implementation
+
+uses
+ sdl,
+ UCommon;
+
+const
+ cSDLCorrectionRatio = 1000;
+
+(*
+BEST Option now ( after discussion with whiteshark ) seems to be to use SDL
+timer functions...
+
+SDL_delay
+SDL_GetTicks
+http://www.gamedev.net/community/forums/topic.asp?topic_id=466145&whichpage=1%EE%8D%B7
+*)
+
+
+procedure CountSkipTimeSet;
+begin
+ TimeNew := SDL_GetTicks();
+end;
+
+procedure CountSkipTime;
+begin
+ TimeOld := TimeNew;
+ TimeNew := SDL_GetTicks();
+ TimeSkip := (TimeNew-TimeOld) / cSDLCorrectionRatio;
+end;
+
+procedure CountMidTime;
+begin
+ TimeMidTemp := SDL_GetTicks();
+ TimeMid := (TimeMidTemp - TimeNew) / cSDLCorrectionRatio;
+end;
+
+{**
+ * TTime
+ **}
+
+constructor TTime.Create;
+begin
+ inherited;
+ CountSkipTimeSet;
+end;
+
+function TTime.GetTime: real;
+begin
+ Result := SDL_GetTicks() / cSDLCorrectionRatio;
+end;
+
+{**
+ * TRelativeTimer
+ **}
+
+(**
+ * Creates a new relative timer.
+ * A relative timer works like a stop-watch. It can be paused and
+ * resumed afterwards, continuing with the counter it had when it was paused.
+ *)
+constructor TRelativeTimer.Create();
+begin
+ State := rtsStopped;
+ AbsoluteTime := 0;
+ RelativeTime := 0;
+end;
+
+(**
+ * Starts the timer.
+ * If WaitForTrigger is false the timer will be started immediately.
+ * If WaitForTrigger is true the timer will be started when a trigger event
+ * occurs. A trigger event is a call of one of the Get-/SetTime() methods.
+ * In addition the timer can be started by calling this method again with
+ * WaitForTrigger set to false.
+ *)
+procedure TRelativeTimer.Start(WaitForTrigger: boolean = false);
+begin
+ case (State) of
+ rtsStopped, rtsPaused: begin
+ if (WaitForTrigger) then
+ begin
+ State := rtsWait;
+ end
+ else
+ begin
+ State := rtsRunning;
+ AbsoluteTime := SDL_GetTicks();
+ end;
+ end;
+
+ rtsWait: begin
+ if (not WaitForTrigger) then
+ begin
+ State := rtsRunning;
+ AbsoluteTime := SDL_GetTicks();
+ RelativeTime := 0;
+ end;
+ end;
+ end;
+end;
+
+(**
+ * Pauses the timer and leaves the counter untouched.
+ *)
+procedure TRelativeTimer.Pause();
+begin
+ if (State = rtsRunning) then
+ begin
+ // Important: GetTime() must be called in running state
+ RelativeTime := GetTime();
+ State := rtsPaused;
+ end;
+end;
+
+(**
+ * Stops the timer and sets its counter to 0.
+ *)
+procedure TRelativeTimer.Stop();
+begin
+ if (State <> rtsStopped) then
+ begin
+ State := rtsStopped;
+ RelativeTime := 0;
+ end;
+end;
+
+(**
+ * Returns the current counter of the timer.
+ * If WaitForTrigger was true in Start() the timer will be started
+ * if it was not already running.
+ *)
+function TRelativeTimer.GetTime(): real;
+begin
+ case (State) of
+ rtsStopped, rtsPaused:
+ Result := RelativeTime;
+ rtsRunning:
+ Result := RelativeTime + (SDL_GetTicks() - AbsoluteTime) / cSDLCorrectionRatio;
+ rtsWait: begin
+ // start triggered
+ State := rtsRunning;
+ AbsoluteTime := SDL_GetTicks();
+ Result := RelativeTime;
+ end;
+ end;
+end;
+
+(**
+ * Sets the counter of the timer.
+ * If WaitForTrigger was true in Start() the timer will be started
+ * if it was not already running.
+ *)
+procedure TRelativeTimer.SetTime(Time: real);
+begin
+ RelativeTime := Time;
+ AbsoluteTime := SDL_GetTicks();
+ // start triggered
+ if (State = rtsWait) then
+ State := rtsRunning;
+end;
+
+function TRelativeTimer.GetState(): TRelativeTimerState;
+begin
+ Result := State;
+end;
+
+end.
diff --git a/mediaplugin/src/base/UUnicodeUtils.pas b/mediaplugin/src/base/UUnicodeUtils.pas
new file mode 100644
index 00000000..37b53a67
--- /dev/null
+++ b/mediaplugin/src/base/UUnicodeUtils.pas
@@ -0,0 +1,670 @@
+{* UltraStar Deluxe - Karaoke Game
+ *
+ * UltraStar Deluxe is the legal property of its developers, whose names
+ * are too numerous to list here. Please refer to the COPYRIGHT
+ * file distributed with this source distribution.
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; see the file COPYING. If not, write to
+ * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+ * Boston, MA 02110-1301, USA.
+ *
+ * $URL$
+ * $Id$
+ *}
+
+unit UUnicodeUtils;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+uses
+{$IFDEF MSWINDOWS}
+ Windows,
+{$ENDIF}
+ StrUtils,
+ SysUtils;
+
+type
+ // String with unknown encoding. Introduced with Delphi 2009 and maybe soon
+ // with FPC.
+ RawByteString = AnsiString;
+
+{**
+ * Returns true if the system uses UTF-8 as default string type
+ * (filesystem or API calls).
+ * This is always true on Mac OS X and always false on Win32. On Unix it depends
+ * on the LC_CTYPE setting.
+ * Do not use AnsiToUTF8() or UTF8ToAnsi() if this function returns true.
+ *}
+function IsNativeUTF8(): boolean;
+
+(*
+ * Character classes
+ *)
+
+function IsAlphaChar(ch: WideChar): boolean; overload;
+function IsAlphaChar(ch: UCS4Char): boolean; overload;
+
+function IsNumericChar(ch: WideChar): boolean; overload;
+function IsNumericChar(ch: UCS4Char): boolean; overload;
+
+function IsAlphaNumericChar(ch: WideChar): boolean; overload;
+function IsAlphaNumericChar(ch: UCS4Char): boolean; overload;
+
+function IsPunctuationChar(ch: WideChar): boolean; overload;
+function IsPunctuationChar(ch: UCS4Char): boolean; overload;
+
+function IsControlChar(ch: WideChar): boolean; overload;
+function IsControlChar(ch: UCS4Char): boolean; overload;
+
+function IsPrintableChar(ch: WideChar): boolean; overload;
+function IsPrintableChar(ch: UCS4Char): boolean; overload;
+
+{**
+ * Checks if the given string is a valid UTF-8 string.
+ * If an ANSI encoded string (with char codes >= 128) is passed, the
+ * function will most probably return false, as most ANSI strings sequences
+ * are illegal in UTF-8.
+ *}
+function IsUTF8String(const str: RawByteString): boolean;
+
+{**
+ * Iterates over an UTF-8 encoded string.
+ * StrPtr will be increased to the beginning of the next character on each
+ * call.
+ * Results true if the given string starts with an UTF-8 encoded char.
+ *}
+function NextCharUTF8(var StrPtr: PAnsiChar; out Ch: UCS4Char): boolean;
+
+{**
+ * Deletes Count chars (not bytes) beginning at char- (not byte-) position Index.
+ * Index values start with 1.
+ *}
+procedure UTF8Delete(var Str: UTF8String; Index: Integer; Count: Integer);
+procedure UCS4Delete(var Str: UCS4String; Index: Integer; Count: Integer);
+
+{**
+ * Checks if the string is composed of ASCII characters.
+ *}
+function IsASCIIString(const str: RawByteString): boolean;
+
+{*
+ * String format conversion
+ *}
+
+function UTF8ToUCS4String(const str: UTF8String): UCS4String;
+function UCS4ToUTF8String(const str: UCS4String): UTF8String; overload;
+function UCS4ToUTF8String(ch: UCS4Char): UTF8String; overload;
+
+{**
+ * Returns the number of characters (not bytes) in string str.
+ *}
+function LengthUTF8(const str: UTF8String): integer;
+
+{**
+ * Returns the length of an UCS4String. Note that Length(UCS4String) returns
+ * the length+1 as UCS4Strings are zero-terminated.
+ *}
+function LengthUCS4(const str: UCS4String): integer;
+
+{** @seealso WideCompareStr *}
+function UTF8CompareStr(const S1, S2: UTF8String): integer;
+{** @seealso WideCompareText *}
+function UTF8CompareText(const S1, S2: UTF8String): integer;
+
+function UTF8StartsText(const SubText, Text: UTF8String): boolean;
+
+function UTF8ContainsStr(const Text, SubText: UTF8String): boolean;
+function UTF8ContainsText(const Text, SubText: UTF8String): boolean;
+
+{** @seealso WideUpperCase *}
+function UTF8UpperCase(const str: UTF8String): UTF8String;
+{** @seealso WideCompareText *}
+function UTF8LowerCase(const str: UTF8String): UTF8String;
+
+{**
+ * Converts a UCS-4 char ch to its upper-case representation.
+ *}
+function UCS4UpperCase(ch: UCS4Char): UCS4Char; overload;
+
+{**
+ * Converts a UCS-4 string str to its upper-case representation.
+ *}
+function UCS4UpperCase(const str: UCS4String): UCS4String; overload;
+
+{**
+ * Converts a UCS4Char to an UCS4String.
+ * Note that UCS4Strings are zero-terminated dynamic arrays.
+ *}
+function UCS4CharToString(ch: UCS4Char): UCS4String;
+
+{**
+ * @seealso System.Pos()
+ *}
+function UTF8Pos(const substr: UTF8String; const str: UTF8String): Integer;
+
+{**
+ * Copies a segment of str starting with Index (1-based) with Count characters (not bytes).
+ *}
+function UTF8Copy(const str: UTF8String; Index: Integer = 1; Count: Integer = -1): UTF8String;
+
+{**
+ * Copies a segment of str starting with Index (0-based) with Count characters.
+ * Note: Do not use Copy() to copy UCS4Strings as the result will not contain
+ * a trailing #0 character and hence is invalid.
+ *}
+function UCS4Copy(const str: UCS4String; Index: Integer = 0; Count: Integer = -1): UCS4String;
+
+(*
+ * Converts a WideString to its upper- or lower-case representation.
+ * Wrapper for WideUpper/LowerCase. Needed because some plattforms have
+ * problems with unicode support.
+ *
+ * Note that characters in UTF-16 might consist of one or two WideChar valus
+ * (see surrogates). So instead of using WideStringUpperCase(ch)[1] for single
+ * character access, convert to UCS-4 where each character is represented by
+ * one UCS4Char.
+ *)
+function WideStringUpperCase(const str: WideString) : WideString; overload;
+function WideStringUpperCase(ch: WideChar): WideString; overload;
+function WideStringLowerCase(const str: WideString): WideString; overload;
+function WideStringLowerCase(ch: WideChar): WideString; overload;
+
+function WideStringReplaceChar(const text: WideString; search, rep: WideChar): WideString;
+
+implementation
+
+{$IFDEF UNIX}
+{$IFNDEF DARWIN}
+const
+ LC_CTYPE = 0;
+
+function setlocale(category: integer; locale: PChar): PChar; cdecl; external 'c';
+{$ENDIF}
+{$ENDIF}
+
+var
+ NativeUTF8: boolean;
+
+procedure InitUnicodeUtils();
+{$IFDEF UNIX}
+{$IFNDEF DARWIN}
+var
+ localeName: PChar;
+{$ENDIF}
+{$ENDIF}
+begin
+ {$IF Defined(DARWIN)}
+ NativeUTF8 := true;
+ {$ELSEIF Defined(MSWindows)}
+ NativeUTF8 := false;
+ {$ELSEIF Defined(UNIX)}
+ // check if locale name contains UTF8 or UTF-8
+ localeName := setlocale(LC_CTYPE, nil);
+ NativeUTF8 := Pos('UTF8', UpperCase(AnsiReplaceStr(localeName, '-', ''))) > 0;
+ {$ELSE}
+ raise Exception.Create('Unknown system');
+ {$IFEND}
+end;
+
+function IsNativeUTF8(): boolean;
+begin
+ Result := NativeUTF8;
+end;
+
+function IsAlphaChar(ch: WideChar): boolean;
+begin
+ {$IFDEF MSWINDOWS}
+ Result := IsCharAlphaW(ch);
+ {$ELSE}
+ // TODO: add chars > 255 (or replace with libxml2 functions?)
+ case ch of
+ 'A'..'Z', // A-Z
+ 'a'..'z', // a-z
+ #170,#181,#186,
+ #192..#214,
+ #216..#246,
+ #248..#255:
+ Result := true;
+ else
+ Result := false;
+ end;
+ {$ENDIF}
+end;
+
+function IsAlphaChar(ch: UCS4Char): boolean;
+begin
+ Result := IsAlphaChar(WideChar(Ord(ch)));
+end;
+
+function IsNumericChar(ch: WideChar): boolean;
+begin
+ // TODO: replace with libxml2 functions?
+ // ignore non-arabic numerals as we do not want to handle them
+ case ch of
+ '0'..'9':
+ Result := true;
+ else
+ Result := false;
+ end;
+end;
+
+function IsNumericChar(ch: UCS4Char): boolean;
+begin
+ Result := IsNumericChar(WideChar(Ord(ch)));
+end;
+
+function IsAlphaNumericChar(ch: WideChar): boolean;
+begin
+ Result := (IsAlphaChar(ch) or IsNumericChar(ch));
+end;
+
+function IsAlphaNumericChar(ch: UCS4Char): boolean;
+begin
+ Result := (IsAlphaChar(ch) or IsNumericChar(ch));
+end;
+
+function IsPunctuationChar(ch: WideChar): boolean;
+begin
+ // TODO: add chars > 255 (or replace with libxml2 functions?)
+ case ch of
+ ' '..'/',':'..'@','['..'`','{'..'~',
+ #160..#191,#215,#247:
+ Result := true;
+ else
+ Result := false;
+ end;
+end;
+
+function IsPunctuationChar(ch: UCS4Char): boolean;
+begin
+ Result := IsPunctuationChar(WideChar(Ord(ch)));
+end;
+
+function IsControlChar(ch: WideChar): boolean;
+begin
+ case ch of
+ #0..#31,
+ #127..#159:
+ Result := true;
+ else
+ Result := false;
+ end;
+end;
+
+function IsControlChar(ch: UCS4Char): boolean;
+begin
+ Result := IsControlChar(WideChar(Ord(ch)));
+end;
+
+function IsPrintableChar(ch: WideChar): boolean;
+begin
+ Result := not IsControlChar(ch);
+end;
+
+function IsPrintableChar(ch: UCS4Char): boolean;
+begin
+ Result := IsPrintableChar(WideChar(Ord(ch)));
+end;
+
+
+function NextCharUTF8(var StrPtr: PAnsiChar; out Ch: UCS4Char): boolean;
+
+ // find the most significant zero bit (Result: [7..-1])
+ function FindZeroMSB(b: byte): integer;
+ var
+ Mask: byte;
+ begin
+ Mask := $80;
+ Result := 7;
+ while (b and Mask <> 0) do
+ begin
+ Mask := Mask shr 1;
+ Dec(Result);
+ end;
+ end;
+
+var
+ ZeroBit: integer;
+ SeqCount: integer; // number of trailing bytes to follow
+const
+ Mask: array[1..3] of byte = ($1F, $0F, $07);
+begin
+ Result := false;
+ SeqCount := 0;
+ Ch := 0;
+
+ while (StrPtr^ <> #0) do
+ begin
+ if (StrPtr^ < #128) then
+ begin
+ // check that no more trailing bytes are expected
+ if (SeqCount = 0) then
+ begin
+ Ch := Ord(StrPtr^);
+ Inc(StrPtr);
+ Result := true;
+ end;
+ Break;
+ end
+ else
+ begin
+ ZeroBit := FindZeroMSB(Ord(StrPtr^));
+ // trailing byte expected
+ if (SeqCount > 0) then
+ begin
+ // check if trailing byte has pattern 10xxxxxx
+ if (ZeroBit <> 6) then
+ begin
+ Inc(StrPtr);
+ Break;
+ end;
+
+ Dec(SeqCount);
+ Ch := (Ch shl 6) or (Ord(StrPtr^) and $3F);
+
+ // check if char is finished
+ if (SeqCount = 0) then
+ begin
+ Inc(StrPtr);
+ Result := true;
+ Break;
+ end;
+ end
+ else // leading byte expected
+ begin
+ // check if pattern is one of 110xxxxx/1110xxxx/11110xxx
+ if (ZeroBit > 5) or (ZeroBit < 3) then
+ begin
+ Inc(StrPtr);
+ Break;
+ end;
+ // calculate number of trailing bytes (1, 2 or 3)
+ SeqCount := 6 - ZeroBit;
+ // extract first part of char
+ Ch := Ord(StrPtr^) and Mask[SeqCount];
+ end;
+ end;
+
+ Inc(StrPtr);
+ end;
+
+ if (not Result) then
+ Ch := Ord('?');
+end;
+
+function IsUTF8String(const str: RawByteString): boolean;
+var
+ Ch: UCS4Char;
+ StrPtr: PAnsiChar;
+begin
+ Result := true;
+ StrPtr := PChar(str);
+ while (StrPtr^ <> #0) do
+ begin
+ if (not NextCharUTF8(StrPtr, Ch)) then
+ begin
+ Result := false;
+ Exit;
+ end;
+ end;
+end;
+
+function IsASCIIString(const str: RawByteString): boolean;
+var
+ I: integer;
+begin
+ for I := 1 to Length(str) do
+ begin
+ if (str[I] >= #128) then
+ begin
+ Result := false;
+ Exit;
+ end;
+ end;
+ Result := true;
+end;
+
+
+function UTF8ToUCS4String(const str: UTF8String): UCS4String;
+begin
+ Result := WideStringToUCS4String(UTF8Decode(str));
+end;
+
+function UCS4ToUTF8String(const str: UCS4String): UTF8String;
+begin
+ Result := UTF8Encode(UCS4StringToWideString(str));
+end;
+
+function UCS4ToUTF8String(ch: UCS4Char): UTF8String;
+begin
+ Result := UCS4ToUTF8String(UCS4CharToString(ch));
+end;
+
+function LengthUTF8(const str: UTF8String): integer;
+begin
+ Result := LengthUCS4(UTF8ToUCS4String(str));
+end;
+
+function LengthUCS4(const str: UCS4String): integer;
+begin
+ Result := High(str);
+ if (Result = -1) then
+ Result := 0;
+end;
+
+function UTF8CompareStr(const S1, S2: UTF8String): integer;
+begin
+ Result := WideCompareStr(UTF8Decode(S1), UTF8Decode(S2));
+end;
+
+function UTF8CompareText(const S1, S2: UTF8String): integer;
+begin
+ Result := WideCompareText(UTF8Decode(S1), UTF8Decode(S2));
+end;
+
+function UTF8StartsStr(const SubText, Text: UTF8String): boolean;
+begin
+ // TODO: use WideSameStr (slower but handles different representations of the same char)?
+ Result := (Pos(SubText, Text) = 1);
+end;
+
+function UTF8StartsText(const SubText, Text: UTF8String): boolean;
+begin
+ // TODO: use WideSameText (slower but handles different representations of the same char)?
+ Result := (Pos(UTF8UpperCase(SubText), UTF8UpperCase(Text)) = 1);
+end;
+
+function UTF8ContainsStr(const Text, SubText: UTF8String): boolean;
+begin
+ Result := Pos(SubText, Text) > 0;
+end;
+
+function UTF8ContainsText(const Text, SubText: UTF8String): boolean;
+begin
+ Result := Pos(UTF8UpperCase(SubText), UTF8UpperCase(Text)) > 0;
+end;
+
+function UTF8UpperCase(const str: UTF8String): UTF8String;
+begin
+ Result := UTF8Encode(WideStringUpperCase(UTF8Decode(str)));
+end;
+
+function UTF8LowerCase(const str: UTF8String): UTF8String;
+begin
+ Result := UTF8Encode(WideStringLowerCase(UTF8Decode(str)));
+end;
+
+function UCS4UpperCase(ch: UCS4Char): UCS4Char;
+begin
+ Result := UCS4UpperCase(UCS4CharToString(ch))[0];
+end;
+
+function UCS4UpperCase(const str: UCS4String): UCS4String;
+begin
+ // convert to upper-case as WideString and convert result back to UCS-4
+ Result := WideStringToUCS4String(
+ WideStringUpperCase(
+ UCS4StringToWideString(str)));
+end;
+
+function UCS4CharToString(ch: UCS4Char): UCS4String;
+begin
+ SetLength(Result, 2);
+ Result[0] := ch;
+ Result[1] := 0;
+end;
+
+function UTF8Pos(const substr: UTF8String; const str: UTF8String): Integer;
+begin
+ Result := Pos(substr, str);
+end;
+
+function UTF8Copy(const str: UTF8String; Index: Integer; Count: Integer): UTF8String;
+begin
+ Result := UCS4ToUTF8String(UCS4Copy(UTF8ToUCS4String(str), Index-1, Count));
+end;
+
+function UCS4Copy(const str: UCS4String; Index: Integer; Count: Integer): UCS4String;
+var
+ I: integer;
+ MaxCount: integer;
+begin
+ // calculate max. copy count
+ MaxCount := LengthUCS4(str)-Index;
+ if (MaxCount < 0) then
+ MaxCount := 0;
+ // adjust copy count
+ if (Count > MaxCount) or (Count < 0) then
+ Count := MaxCount;
+
+ // copy (and add zero terminator)
+ SetLength(Result, Count + 1);
+ for I := 0 to Count-1 do
+ Result[I] := str[Index+I];
+ Result[Count] := 0;
+end;
+
+procedure UTF8Delete(var Str: UTF8String; Index: Integer; Count: Integer);
+var
+ StrUCS4: UCS4String;
+begin
+ StrUCS4 := UTF8ToUCS4String(str);
+ UCS4Delete(StrUCS4, Index-1, Count);
+ Str := UCS4ToUTF8String(StrUCS4);
+end;
+
+procedure UCS4Delete(var Str: UCS4String; Index: Integer; Count: Integer);
+var
+ Len: integer;
+ OldStr: UCS4String;
+ I: integer;
+begin
+ Len := LengthUCS4(Str);
+ if (Count <= 0) or (Index < 0) or (Index >= Len) then
+ Exit;
+ if (Index + Count > Len) then
+ Count := Len-Index;
+
+ OldStr := Str;
+ SetLength(Str, Len-Count+1);
+ for I := 0 to Index-1 do
+ Str[I] := OldStr[I];
+ for I := Index+Count to Len-1 do
+ Str[I-Count] := OldStr[I];
+ Str[High(Str)] := 0;
+end;
+
+function WideStringUpperCase(ch: WideChar): WideString;
+begin
+ // If WideChar #0 is converted to a WideString in Delphi, a string with
+ // length 1 and a single char #0 is returned. In FPC an empty (length=0)
+ // string will be returned. This will crash, if a non printable key was
+ // pressed, its char code (#0) is translated to upper-case and the the first
+ // character is accessed with Result[1].
+ // We cannot catch this error in the WideString parameter variant as the string
+ // has length 0 already.
+
+ // Force min. string length of 1
+ if (ch = #0) then
+ Result := #0
+ else
+ Result := WideStringUpperCase(WideString(ch));
+end;
+
+function WideStringUpperCase(const str: WideString): WideString;
+begin
+ // On Linux and MacOSX the cwstring unit is necessary for Unicode function-calls.
+ // Otherwise you will get an EIntOverflow exception (thrown by unimplementedwidestring()).
+ // The Unicode manager cwstring does not work with MacOSX at the moment because
+ // of missing references to iconv.
+ // Note: Should be fixed now
+
+ {.$IFNDEF DARWIN}
+ {.$IFDEF NOIGNORE}
+ Result := WideUpperCase(str)
+ {.$ELSE}
+ //Result := UTF8Decode(UpperCase(UTF8Encode(str)));
+ {.$ENDIF}
+end;
+
+function WideStringLowerCase(ch: WideChar): WideString;
+begin
+ // see WideStringUpperCase
+ if (ch = #0) then
+ Result := #0
+ else
+ Result := WideStringLowerCase(WideString(ch));
+end;
+
+function WideStringLowerCase(const str: WideString): WideString;
+begin
+ // see WideStringUpperCase
+ Result := WideLowerCase(str)
+end;
+
+function WideStringReplaceChar(const text: WideString; search, rep: WideChar): WideString;
+var
+ iPos : integer;
+// sTemp : WideString;
+begin
+(*
+ result := text;
+ iPos := Pos(search, result);
+ while (iPos > 0) do
+ begin
+ sTemp := copy(result, iPos + length(search), length(result));
+ result := copy(result, 1, iPos - 1) + rep + sTEmp;
+ iPos := Pos(search, result);
+ end;
+*)
+ result := text;
+
+ if search = rep then
+ exit;
+
+ for iPos := 1 to length(result) do
+ begin
+ if result[iPos] = search then
+ result[iPos] := rep;
+ end;
+end;
+
+initialization
+ InitUnicodeUtils;
+
+end.
diff --git a/mediaplugin/src/base/UXMLSong.pas b/mediaplugin/src/base/UXMLSong.pas
new file mode 100644
index 00000000..e9751eba
--- /dev/null
+++ b/mediaplugin/src/base/UXMLSong.pas
@@ -0,0 +1,623 @@
+{* 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('<PRODUCT_NAME>', S);
+
+ If (J <> 0) then
+ begin
+ Inc(J, 14);
+ K := Pos('</PRODUCT_NAME>', S);
+ If (K<J) then K := Length(S) + 1;
+
+ Result := Copy(S, J, K - J);
+ Break;
+ end;
+ end;
+
+ Edition := Result;
+ finally
+ txt.Free;
+ Stream.Free;
+ end;
+end;
+
+end.
--
cgit v1.2.3