aboutsummaryrefslogtreecommitdiffstats
path: root/unicode/src
diff options
context:
space:
mode:
Diffstat (limited to '')
-rw-r--r--unicode/src/base/TextGL.pas7
-rw-r--r--unicode/src/base/UCatCovers.pas3
-rw-r--r--unicode/src/base/UCore.pas190
-rw-r--r--unicode/src/base/UDraw.pas660
-rw-r--r--unicode/src/base/UEditorLyrics.pas129
-rw-r--r--unicode/src/base/UFiles.pas5
-rw-r--r--unicode/src/base/UGraphic.pas21
-rw-r--r--unicode/src/base/UGraphicClasses.pas14
-rw-r--r--unicode/src/base/UHooks.pas55
-rw-r--r--unicode/src/base/UImage.pas234
-rw-r--r--unicode/src/base/UIni.pas179
-rw-r--r--unicode/src/base/ULanguage.pas3
-rw-r--r--unicode/src/base/ULog.pas3
-rw-r--r--unicode/src/base/UMain.pas783
-rw-r--r--unicode/src/base/UMusic.pas36
-rw-r--r--unicode/src/base/UNote.pas593
-rw-r--r--unicode/src/base/UParty.pas445
-rw-r--r--unicode/src/base/UPath.pas188
-rw-r--r--unicode/src/base/UPlatformMacOSX.pas99
-rw-r--r--unicode/src/base/UPlaylist.pas3
-rw-r--r--unicode/src/base/UPluginLoader.pas140
-rw-r--r--unicode/src/base/URecord.pas135
-rw-r--r--unicode/src/base/URingBuffer.pas24
-rw-r--r--unicode/src/base/USkins.pas87
-rw-r--r--unicode/src/base/USong.pas307
-rw-r--r--unicode/src/base/USongs.pas18
-rw-r--r--unicode/src/base/UTexture.pas48
-rw-r--r--unicode/src/base/UThemes.pas29
-rw-r--r--unicode/src/lib/JEDI-SDL/OpenGL/Pas/gl.pas2
-rw-r--r--unicode/src/lib/JEDI-SDL/OpenGL/Pas/glu.pas2
-rw-r--r--unicode/src/lib/JEDI-SDL/OpenGL/Pas/glx.pas3
-rw-r--r--unicode/src/lib/collections/CollArray.pas183
-rw-r--r--unicode/src/lib/collections/CollHash.pas1497
-rw-r--r--unicode/src/lib/collections/CollLibrary.pas131
-rw-r--r--unicode/src/lib/collections/CollList.pas270
-rw-r--r--unicode/src/lib/collections/CollPArray.pas689
-rw-r--r--unicode/src/lib/collections/CollWrappers.pas876
-rw-r--r--unicode/src/lib/collections/Collections.pas5318
-rw-r--r--unicode/src/lib/collections/readme.txt14
-rw-r--r--unicode/src/lib/ffmpeg/avcodec.pas317
-rw-r--r--unicode/src/lib/ffmpeg/avformat.pas217
-rw-r--r--unicode/src/lib/ffmpeg/avio.pas119
-rw-r--r--unicode/src/lib/ffmpeg/avutil.pas89
-rw-r--r--unicode/src/lib/ffmpeg/mathematics.pas27
-rw-r--r--unicode/src/lib/ffmpeg/opt.pas52
-rw-r--r--unicode/src/lib/ffmpeg/rational.pas52
-rw-r--r--unicode/src/lib/requirements.txt4
-rw-r--r--unicode/src/macosx/PseudoThread.pas7
-rw-r--r--unicode/src/macosx/Windows.pas194
-rw-r--r--unicode/src/media/UAudioConverter.pas14
-rw-r--r--unicode/src/media/UAudioDecoder_Bass.pas6
-rw-r--r--unicode/src/media/UAudioDecoder_FFmpeg.pas26
-rw-r--r--unicode/src/media/UAudioPlayback_Bass.pas18
-rw-r--r--unicode/src/media/UAudioPlayback_SDL.pas14
-rw-r--r--unicode/src/media/UAudioPlayback_SoftMixer.pas38
-rw-r--r--unicode/src/media/UVideo.pas160
-rw-r--r--unicode/src/media/UVisualizer.pas15
-rw-r--r--unicode/src/menu/UDisplay.pas11
-rw-r--r--unicode/src/menu/UDrawTexture.pas1
-rw-r--r--unicode/src/menu/UMenuBackgroundColor.pas6
-rw-r--r--unicode/src/menu/UMenuBackgroundFade.pas10
-rw-r--r--unicode/src/menu/UMenuBackgroundNone.pas6
-rw-r--r--unicode/src/menu/UMenuBackgroundTexture.pas7
-rw-r--r--unicode/src/menu/UMenuBackgroundVideo.pas6
-rw-r--r--unicode/src/menu/UMenuButton.pas63
-rw-r--r--unicode/src/screens/UScreenCredits.pas79
-rw-r--r--unicode/src/screens/UScreenEdit.pas103
-rw-r--r--unicode/src/screens/UScreenEditConvert.pas242
-rw-r--r--unicode/src/screens/UScreenEditHeader.pas133
-rw-r--r--unicode/src/screens/UScreenEditSub.pas313
-rw-r--r--unicode/src/screens/UScreenMain.pas2
-rw-r--r--unicode/src/screens/UScreenName.pas13
-rw-r--r--unicode/src/screens/UScreenOpen.pas65
-rw-r--r--unicode/src/screens/UScreenOptions.pas2
-rw-r--r--unicode/src/screens/UScreenOptionsRecord.pas4
-rw-r--r--unicode/src/screens/UScreenOptionsThemes.pas9
-rw-r--r--unicode/src/screens/UScreenPartyOptions.pas113
-rw-r--r--unicode/src/screens/UScreenScore.pas289
-rw-r--r--unicode/src/screens/UScreenSing.pas352
-rw-r--r--unicode/src/screens/UScreenSingModi.pas119
-rw-r--r--unicode/src/screens/UScreenSong.pas436
-rw-r--r--unicode/src/screens/UScreenSongMenu.pas347
-rw-r--r--unicode/src/screens/UScreenTop5.pas87
-rw-r--r--unicode/src/screens/UScreenWelcome.pas28
-rw-r--r--unicode/src/ultrastardx.dpr3
85 files changed, 13656 insertions, 3985 deletions
diff --git a/unicode/src/base/TextGL.pas b/unicode/src/base/TextGL.pas
index 28c3c6b6..667a224f 100644
--- a/unicode/src/base/TextGL.pas
+++ b/unicode/src/base/TextGL.pas
@@ -68,11 +68,12 @@ procedure SetFontReflection(Enable:boolean;Spacing: real); // enables/disables t
implementation
uses
- UMain,
- UCommon,
UTextEncoding,
SysUtils,
- IniFiles;
+ IniFiles,
+ UCommon,
+ UMain,
+ UPath;
function FindFontFile(FontIni: TCustomIniFile; Font: string): string;
var
diff --git a/unicode/src/base/UCatCovers.pas b/unicode/src/base/UCatCovers.pas
index 4fc54199..6ef81b68 100644
--- a/unicode/src/base/UCatCovers.pas
+++ b/unicode/src/base/UCatCovers.pas
@@ -64,8 +64,9 @@ uses
SysUtils,
Classes,
// UFiles,
+ ULog,
UMain,
- ULog;
+ UPath;
constructor TCatCovers.Create;
begin
diff --git a/unicode/src/base/UCore.pas b/unicode/src/base/UCore.pas
index 901f2f96..a7f9e56e 100644
--- a/unicode/src/base/UCore.pas
+++ b/unicode/src/base/UCore.pas
@@ -42,20 +42,20 @@ uses
{*********************
TCore
- Class manages all CoreModules, teh StartUp, teh MainLoop and the shutdown process
- Also it does some Error Handling, and maybe sometime multithreaded Loading ;)
+ Class manages all CoreModules, the StartUp, the MainLoop and the shutdown process
+ Also, it does some error handling, and maybe sometime multithreaded loading ;)
*********************}
type
TModuleListItem = record
- Module: TCoreModule; //Instance of the Modules Class
- Info: TModuleInfo; //ModuleInfo returned by Modules Modulinfo Proc
- NeedsDeInit: Boolean; //True if Module was succesful inited
+ Module: TCoreModule; // Instance of the modules class
+ Info: TModuleInfo; // ModuleInfo returned by modules modulinfo proc
+ NeedsDeInit: boolean; // True if module was succesful inited
end;
TCore = class
private
- //Some Hook Handles. See Plugin SDKs Hooks.txt for Infos
+ // Some Hook Handles. See Plugin SDKs Hooks.txt for Infos
hLoadingFinished: THandle;
hMainLoop: THandle;
hTranslate: THandle;
@@ -72,71 +72,71 @@ type
sGetModuleInfo: THandle;
sGetApplicationHandle: THandle;
- Modules: Array [0..High(CORE_MODULES_TO_LOAD)] of TModuleListItem;
+ Modules: array [0..High(CORE_MODULES_TO_LOAD)] of TModuleListItem;
- //Cur + Last Executed Setting and Getting ;)
- iCurExecuted: Integer;
- iLastExecuted: Integer;
+ // Cur + Last Executed Setting and Getting ;)
+ iCurExecuted: integer;
+ iLastExecuted: integer;
- procedure SetCurExecuted(Value: Integer);
+ procedure SetCurExecuted(Value: integer);
- //Function Get all Modules and Creates them
- function GetModules: Boolean;
+ // Function Get all Modules and Creates them
+ function GetModules: boolean;
- //Loads Core and all Modules
- function Load: Boolean;
+ // Loads Core and all Modules
+ function Load: boolean;
- //Inits Core and all Modules
- function Init: Boolean;
+ // Inits Core and all Modules
+ function Init: boolean;
- //DeInits Core and all Modules
- function DeInit: Boolean;
+ // DeInits Core and all Modules
+ function DeInit: boolean;
- //Load the Core
- function LoadCore: Boolean;
+ // Load the Core
+ function LoadCore: boolean;
- //Init the Core
- function InitCore: Boolean;
+ // Init the Core
+ function InitCore: boolean;
- //DeInit the Core
- function DeInitCore: Boolean;
+ // DeInit the Core
+ function DeInitCore: boolean;
- //Called one Time per Frame
- function MainLoop: Boolean;
+ // Called one time per frame
+ function MainLoop: boolean;
public
- Hooks: THookManager; //Teh Hook Manager ;)
- Services: TServiceManager;//The Service Manager
+ Hooks: THookManager; // The Hook Manager ;)
+ Services: TServiceManager; // The Service Manager
- Name: String; //Name of this Application
- Version: LongWord; //Version of this ". For Info Look PluginDefs Functions
+ Name: string; // Name of this application
+ Version: LongWord; // Version of this ". For info look plugindefs functions
- LastErrorReporter:String; //Who Reported the Last Error String
- LastErrorString: String; //Last Error String reported
+ LastErrorReporter: string; // Who reported the last error string
+ LastErrorString: string; // Last error string reported
- property CurExecuted: Integer read iCurExecuted write SetCurExecuted; //ID of Plugin or Module curently Executed
- property LastExecuted: Integer read iLastExecuted;
+ property CurExecuted: integer read iCurExecuted write SetCurExecuted; //ID of plugin or module curently executed
+ property LastExecuted: integer read iLastExecuted;
//---------------
- //Main Methods to control the Core:
+ // Main methods to control the core:
//---------------
- constructor Create(const cName: String; const cVersion: LongWord);
+ constructor Create(const cName: string; const cVersion: LongWord);
- //Starts Loading and Init Process. Then Runs MainLoop. DeInits on Shutdown
+ // Starts loading and init process. Then runs MainLoop. DeInits on shutdown
procedure Run;
- //Method for other Classes to get Pointer to a specific Module
- function GetModulebyName(const Name: String): PCoreModule;
+ // Method for other classes to get pointer to a specific module
+ function GetModulebyName(const Name: string): PCoreModule;
//--------------
- // Hook and Service Procs:
+ // Hook and service procs:
//--------------
function ShowMessage(wParam: TwParam; lParam: TlParam): integer; //Shows a Message (lParam: PChar Text, wParam: Symbol)
function ReportError(wParam: TwParam; lParam: TlParam): integer; //Shows a Message (wParam: Pchar(Message), lParam: PChar(Reportername))
function ReportDebug(wParam: TwParam; lParam: TlParam): integer; //Shows a Message (wParam: Pchar(Message), lParam: PChar(Reportername))
function Retranslate(wParam: TwParam; lParam: TlParam): integer; //Calls Translate hook
function ReloadTextures(wParam: TwParam; lParam: TlParam): integer; //Calls LoadTextures hook
- function GetModuleInfo(wParam: TwParam; lParam: TlParam): integer; //If lParam = nil then get length of Moduleinfo Array. If lparam <> nil then write array of TModuleInfo to address at lparam
+ function GetModuleInfo(wParam: TwParam; lParam: TlParam): integer; //If lParam = nil then get length of Moduleinfo array. If lparam <> nil then write array of TModuleInfo to address at lparam
function GetApplicationHandle(wParam: TwParam; lParam: TlParam): integer; //Returns Application Handle
end;
@@ -154,7 +154,7 @@ uses
//-------------
// Create - Creates Class + Hook and Service Manager
//-------------
-constructor TCore.Create(const cName: String; const cVersion: LongWord);
+constructor TCore.Create(const cName: string; const cVersion: LongWord);
begin
inherited Create;
@@ -171,11 +171,11 @@ begin
end;
//-------------
-//Starts Loading and Init Process. Then Runs MainLoop. DeInits on Shutdown
+// Starts Loading and Init process. Then runs MainLoop. DeInits on shutdown
//-------------
procedure TCore.Run;
var
- Success: Boolean;
+ Success: boolean;
procedure HandleError(const ErrorMsg: string);
begin
@@ -184,16 +184,16 @@ var
else
Self.ShowMessage(CORE_SM_ERROR, PChar(ErrorMsg));
- //DeInit
+ // DeInit
DeInit;
end;
begin
- //Get Modules
+ // Get modules
try
Success := GetModules();
except
- Success := False;
+ Success := false;
end;
if (not Success) then
@@ -202,11 +202,11 @@ begin
Exit;
end;
- //Loading
+ // Loading
try
Success := Load();
except
- Success := False;
+ Success := false;
end;
if (not Success) then
@@ -215,11 +215,11 @@ begin
Exit;
end;
- //Init
+ // Init
try
Success := Init();
except
- Success := False;
+ Success := false;
end;
if (not Success) then
@@ -228,28 +228,28 @@ begin
Exit;
end;
- //Call Translate Hook
+ // Call Translate Hook
if (Hooks.CallEventChain(hTranslate, 0, nil) <> 0) then
begin
HandleError('Error translating');
Exit;
end;
- //Calls LoadTextures Hook
+ // Calls LoadTextures Hook
if (Hooks.CallEventChain(hLoadTextures, 0, nil) <> 0) then
begin
HandleError('Error loading textures');
Exit;
end;
- //Calls Loading Finished Hook
+ // Calls Loading Finished Hook
if (Hooks.CallEventChain(hLoadingFinished, 0, nil) <> 0) then
begin
HandleError('Error calling LoadingFinished Hook');
Exit;
end;
- //Start MainLoop
+ // Start MainLoop
while Success do
begin
Success := MainLoop();
@@ -258,41 +258,41 @@ begin
end;
//-------------
-//Called one Time per Frame
+// Called one time per frame
//-------------
-function TCore.MainLoop: Boolean;
+function TCore.MainLoop: boolean;
begin
- Result := False;
+ Result := false;
end;
//-------------
-//Function Get all Modules and Creates them
+// Function get all modules and creates them
//-------------
-function TCore.GetModules: Boolean;
+function TCore.GetModules: boolean;
var
- i: Integer;
+ i: integer;
begin
- Result := False;
+ Result := false;
for i := 0 to high(Modules) do
begin
try
- Modules[i].NeedsDeInit := False;
+ Modules[i].NeedsDeInit := false;
Modules[i].Module := CORE_MODULES_TO_LOAD[i].Create;
Modules[i].Module.Info(@Modules[i].Info);
except
- ReportError(Integer(PChar('Can''t get module #' + InttoStr(i) + ' "' + Modules[i].Info.Name + '"')), PChar('Core'));
+ ReportError(integer(PChar('Can''t get module #' + InttoStr(i) + ' "' + Modules[i].Info.Name + '"')), PChar('Core'));
Exit;
end;
end;
- Result := True;
+ Result := true;
end;
//-------------
-//Loads Core and all Modules
+// Loads core and all modules
//-------------
-function TCore.Load: Boolean;
+function TCore.Load: boolean;
var
- i: Integer;
+ i: integer;
begin
Result := LoadCore;
@@ -301,23 +301,23 @@ begin
try
Result := Modules[i].Module.Load;
except
- Result := False;
+ Result := false;
end;
if (not Result) then
begin
- ReportError(Integer(PChar('Error loading module #' + InttoStr(i) + ' "' + Modules[i].Info.Name + '"')), PChar('Core'));
+ ReportError(integer(PChar('Error loading module #' + InttoStr(i) + ' "' + Modules[i].Info.Name + '"')), PChar('Core'));
break;
end;
end;
end;
//-------------
-//Inits Core and all Modules
+// Inits core and all modules
//-------------
-function TCore.Init: Boolean;
+function TCore.Init: boolean;
var
- i: Integer;
+ i: integer;
begin
Result := InitCore;
@@ -326,12 +326,12 @@ begin
try
Result := Modules[i].Module.Init;
except
- Result := False;
+ Result := false;
end;
if (not Result) then
begin
- ReportError(Integer(PChar('Error initing module #' + InttoStr(i) + ' "' + Modules[i].Info.Name + '"')), PChar('Core'));
+ ReportError(integer(PChar('Error initing module #' + InttoStr(i) + ' "' + Modules[i].Info.Name + '"')), PChar('Core'));
break;
end;
@@ -340,7 +340,7 @@ begin
end;
//-------------
-//DeInits Core and all Modules
+// DeInits core and all modules
//-------------
function TCore.DeInit: boolean;
var
@@ -362,9 +362,9 @@ begin
end;
//-------------
-//Load the Core
+// Load the Core
//-------------
-function TCore.LoadCore: Boolean;
+function TCore.LoadCore: boolean;
begin
hLoadingFinished := Hooks.AddEvent('Core/LoadingFinished');
hMainLoop := Hooks.AddEvent('Core/MainLoop');
@@ -383,35 +383,35 @@ begin
sGetModuleInfo := Services.AddService('Core/GetModuleInfo', nil, Self.GetModuleInfo);
sGetApplicationHandle := Services.AddService('Core/GetApplicationHandle', nil, Self.GetApplicationHandle);
- //A little Test
+ // A little Test
Hooks.AddSubscriber('Core/NewError', HookTest);
result := true;
end;
//-------------
-//Init the Core
+// Init the Core
//-------------
-function TCore.InitCore: Boolean;
+function TCore.InitCore: boolean;
begin
//Don not init something atm.
result := true;
end;
//-------------
-//DeInit the Core
+// DeInit the Core
//-------------
-function TCore.DeInitCore: Boolean;
+function TCore.DeInitCore: boolean;
begin
- // TODO: write TService-/HookManager.Free and call it here
+ // TODO: write TService-/HookManager. Free and call it here
Result := true;
end;
//-------------
-//Method for other classes to get pointer to a specific module
+// Method for other classes to get pointer to a specific module
//-------------
-function TCore.GetModuleByName(const Name: String): PCoreModule;
-var i: Integer;
+function TCore.GetModuleByName(const Name: string): PCoreModule;
+var i: integer;
begin
Result := nil;
for i := 0 to High(Modules) do
@@ -444,7 +444,7 @@ begin
CORE_SM_INFO: Params := Params or MB_ICONINFORMATION;
end;
- //Show:
+ // Show:
Result := Messagebox(0, lParam, PChar(Name), Params);
end;
{$ENDIF}
@@ -458,8 +458,8 @@ end;
function TCore.ReportError(wParam: TwParam; lParam: TlParam): integer;
begin
//Update LastErrorReporter and LastErrorString
- LastErrorReporter := String(PChar(lParam));
- LastErrorString := String(PChar(Pointer(wParam)));
+ LastErrorReporter := string(PChar(lParam));
+ LastErrorString := string(PChar(Pointer(wParam)));
Hooks.CallEventChain(hError, wParam, lParam);
@@ -501,7 +501,7 @@ begin
end;
//-------------
-// If lParam = nil then get length of Moduleinfo Array. If lparam <> nil then write array of TModuleInfo to address at lparam
+// If lParam = nil then get length of Moduleinfo array. If lparam <> nil then write array of TModuleInfo to address at lparam
//-------------
function TCore.GetModuleInfo(wParam: TwParam; lParam: TlParam): integer;
var
@@ -538,12 +538,12 @@ end;
//-------------
// Called when setting CurExecuted
//-------------
-procedure TCore.SetCurExecuted(Value: Integer);
+procedure TCore.SetCurExecuted(Value: integer);
begin
- //Set Last Executed
+ // Set Last Executed
iLastExecuted := iCurExecuted;
- //Set Cur Executed
+ // Set Cur Executed
iCurExecuted := Value;
end;
diff --git a/unicode/src/base/UDraw.pas b/unicode/src/base/UDraw.pas
index d3f19019..8a66d271 100644
--- a/unicode/src/base/UDraw.pas
+++ b/unicode/src/base/UDraw.pas
@@ -55,7 +55,6 @@ procedure SingDrawTimeBar();
//Draw Editor NoteLines
procedure EditDrawLine(Left, Top, Right: real; NrLines: integer; Space: integer);
-
type
TRecR = record
Top: real;
@@ -67,7 +66,6 @@ type
WMid: real;
Height: real;
HMid: real;
-
Mid: real;
end;
@@ -75,51 +73,45 @@ var
NotesW: real;
NotesH: real;
Starfr: integer;
- StarfrG: integer;
+ StarfrG: integer;
//SingBar
- TickOld: cardinal;
- TickOld2:cardinal;
-
-const
- Przedz = 32;
+ TickOld: cardinal;
+ TickOld2: cardinal;
implementation
uses
+ SysUtils,
+ Math,
gl,
+ TextGL,
+ UDLLManager,
+ UDrawTexture,
UGraphic,
- SysUtils,
+ UIni,
+ ULog,
+ ULyrics,
+ UNote,
UMusic,
URecord,
- ULog,
UScreenSing,
UScreenSingModi,
- ULyrics,
- UMain,
- TextGL,
- UTexture,
- UDrawTexture,
- UIni,
- Math,
- UDLLManager;
+ UTexture;
procedure SingDrawBackground;
var
- Rec: TRecR;
- TexRec: TRecR;
+ Rec: TRecR;
+ TexRec: TRecR;
begin
- if (ScreenSing.Tex_Background.TexNum > 0) then begin
-
- glClearColor (1, 1, 1, 1);
- glColor4f (1, 1, 1, 1);
-
+ 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.Left := 0;
Rec.Right := 800;
TexRec.Top := (Rec.Top / 600) * ScreenSing.Tex_Background.TexH;
@@ -185,16 +177,17 @@ end;
procedure SingDrawOscilloscope(X, Y, W, H: real; NrSound: integer);
var
SampleIndex: integer;
- Sound: TCaptureBuffer;
- MaxX, MaxY: real;
+ 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); }
-
+{
+ if (ParamStr(1) = '-black') or (ParamStr(1) = '-fsblack') then
+ glColor3f(1, 1, 1);
+}
MaxX := W-1;
MaxY := (H-1) / 2;
@@ -211,16 +204,15 @@ begin;
Sound.UnlockAnalysisBuffer();
end;
-
-
procedure SingDrawNoteLines(Left, Top, Right: real; Space: integer);
var
- Count: integer;
+ 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
+ for Count := 0 to 9 do
+ begin
glVertex2f(Left, Top + Count * Space);
glVertex2f(Right, Top + Count * Space);
end;
@@ -230,13 +222,14 @@ end;
procedure SingDrawBeatDelimeters(Left, Top, Right: real; NrLines: integer);
var
- Count: integer;
- TempR: real;
+ 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
+ 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
@@ -251,18 +244,17 @@ end;
// draw blank Notebars
procedure SingDrawLine(Left, Top, Right: real; NrLines: integer; Space: integer);
var
- Rec: TRecR;
- Count: integer;
- TempR: real;
+ Rec: TRecR;
+ Count: integer;
+ TempR: real;
- PlayerNumber: Integer;
+ PlayerNumber: integer;
- GoldenStarPos : real;
-
- lTmpA ,
- lTmpB : real;
+ GoldenStarPos: real;
+
+ lTmpA, lTmpB : real;
begin
-// We actually don't have a playernumber in this procedure, it should reside in NrLines - but it's always set to zero
+// 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
@@ -280,23 +272,19 @@ begin
lTmpA := (Right-Left);
lTmpB := (Lines[NrLines].Line[Lines[NrLines].Current].End_ - Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start);
- if ( lTmpA > 0 ) AND
- ( lTmpB > 0 ) THEN
- begin
- TempR := lTmpA / lTmpB;
- end
+ if ( lTmpA > 0 ) and ( lTmpB > 0 ) then
+ TempR := lTmpA / lTmpB
else
- begin
TempR := 0;
- end;
-
-
- with Lines[NrLines].Line[Lines[NrLines].Current] do begin
- for Count := 0 to HighNote do begin
- with Note[Count] do begin
- if NoteType <> ntFreestyle then begin
-
+ 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
@@ -307,9 +295,9 @@ begin
end //Else all Notes same Color
else
glColor4f(1, 1, 1, 1); // We set alpha to 1, cause we can control the transparency through the png itself
- // Czesci == teil, element == piece, element | koniec == end / ending
- // lewa czesc - left part
- Rec.Left := (Start-Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start) * TempR + Left + 0.5 + 10*ScreenX;
+
+ // 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;
@@ -326,8 +314,8 @@ begin
//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; // Dlugosc == length
+ 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 );
@@ -340,7 +328,7 @@ begin
glEnd;
// right part
- Rec.Left := Rec.Right;
+ Rec.Left := Rec.Right;
Rec.Right := Rec.Right + NotesW;
glBindTexture(GL_TEXTURE_2D, Tex_plain_Right[PlayerNumber].TexNum);
@@ -352,7 +340,7 @@ begin
glEnd;
// Golden Star Patch
- if (NoteType = ntGolden) AND (Ini.EffectSing=1) then
+ if (NoteType = ntGolden) and (Ini.EffectSing=1) then
begin
GoldenRec.SaveGoldenStarsRec(GoldenStarPos, Rec.Top, Rec.Right, Rec.Bottom);
end;
@@ -366,22 +354,23 @@ begin
glDisable(GL_TEXTURE_2D);
end;
-
// draw sung notes
procedure SingDrawPlayerLine(X, Y, W: real; PlayerIndex: integer; Space: integer);
var
TempR: real;
Rec: TRecR;
N: integer;
- //R, G, B, A: real;
+// 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;
+{
+ if NrGracza = 0 then
+ LoadColor(R, G, B, 'P1Light')
+ else
+ LoadColor(R, G, B, 'P2Light');
+}
+ //R := 71/255;
//G := 175/255;
//B := 247/255;
@@ -398,7 +387,7 @@ 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.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
@@ -412,7 +401,7 @@ begin
end;
Rec.Top := Y - (Tone-Lines[0].Line[Lines[0].Current].BaseNote)*Space/2 - NotesH2;
- Rec.Bottom := Rec.Top + 2 *NotesH2;
+ Rec.Bottom := Rec.Top + 2 * NotesH2;
// draw the left part
glColor3f(1, 1, 1);
@@ -425,10 +414,10 @@ begin
glEnd;
// Middle part of the note
- Rec.Left := Rec.Right;
+ Rec.Left := Rec.Right;
Rec.Right := X + (Start+Length-Lines[0].Line[Lines[0].Current].Note[0].Start) * TempR - NotesW - 0.5 + 10*ScreenX;
- // (nowe) - dunno
+ // 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
@@ -448,7 +437,7 @@ begin
glColor3f(1, 1, 1);
// the right part of the note
- Rec.Left := Rec.Right;
+ Rec.Left := Rec.Right;
Rec.Right := Rec.Right + NotesW;
glBindTexture(GL_TEXTURE_2D, Tex_Right[PlayerIndex+1].TexNum);
@@ -485,14 +474,12 @@ end;
//draw Note glow
procedure SingDrawPlayerBGLine(Left, Top, Right: real; NrLines, PlayerIndex: integer; Space: integer);
var
- Rec: TRecR;
- Count: integer;
- TempR: real;
+ Rec: TRecR;
+ Count: integer;
+ TempR: real;
X1, X2, X3, X4: real;
- W, H: real;
-
- lTmpA ,
- lTmpB : real;
+ W, H: real;
+ lTmpA, lTmpB: real;
begin
if (Player[PlayerIndex].ScoreTotalInt >= 0) then
begin
@@ -504,15 +491,10 @@ begin
lTmpA := (Right-Left);
lTmpB := (Lines[NrLines].Line[Lines[NrLines].Current].End_ - Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start);
- if ( lTmpA > 0 ) and
- ( lTmpB > 0 ) then
- begin
- TempR := lTmpA / lTmpB;
- end
+ if ( lTmpA > 0 ) and ( lTmpB > 0 ) then
+ TempR := lTmpA / lTmpB
else
- begin
TempR := 0;
- end;
with Lines[NrLines].Line[Lines[NrLines].Current] do
begin
@@ -527,14 +509,14 @@ begin
W := NotesW * 2 + 2;
H := NotesH * 1.5 + 3.5;
- X2 := (Start-Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start) * TempR + Left + 0.5 + 10*ScreenX + 4; // wciecie
+ 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; // wciecie
+ 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.Left := X1;
Rec.Right := X2;
Rec.Top := Top - (Tone-BaseNote)*Space/2 - H;
Rec.Bottom := Rec.Top + 2 * H;
@@ -547,8 +529,8 @@ begin
glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top);
glEnd;
- // srodkowa czesc
- Rec.Left := X2;
+ // middle part
+ Rec.Left := X2;
Rec.Right := X3;
glBindTexture(GL_TEXTURE_2D, Tex_BG_Mid[PlayerIndex+1].TexNum);
@@ -559,8 +541,8 @@ begin
glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top);
glEnd;
- // prawa czesc
- Rec.Left := X3;
+ // right part
+ Rec.Left := X3;
Rec.Right := X4;
glBindTexture(GL_TEXTURE_2D, Tex_BG_Right[PlayerIndex+1].TexNum);
@@ -608,7 +590,7 @@ begin
// 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
@@ -696,27 +678,25 @@ begin
// FIXME: accessing ScreenSing is not that generic
LyricEngine := ScreenSing.Lyrics;
- // background //BG Fullsize Mod
- //SingDrawBackground;
-
// draw time-bar
SingDrawTimeBar();
// draw note-lines
if (PlayersPlay = 1) and (Ini.NoteLines = 1) then
- SingDrawNoteLines(Nr.Left + 10*ScreenX, Skin_P2_NotesB - 105, Nr.Right + 10*ScreenX, 15);
+ SingDrawNoteLines(NR.Left + 10*ScreenX, Skin_P2_NotesB - 105, NR.Right + 10*ScreenX, 15);
if ((PlayersPlay = 2) or (PlayersPlay = 4)) and (Ini.NoteLines = 1) then
begin
- SingDrawNoteLines(Nr.Left + 10*ScreenX, Skin_P1_NotesB - 105, Nr.Right + 10*ScreenX, 15);
- SingDrawNoteLines(Nr.Left + 10*ScreenX, Skin_P2_NotesB - 105, Nr.Right + 10*ScreenX, 15);
+ SingDrawNoteLines(NR.Left + 10*ScreenX, Skin_P1_NotesB - 105, NR.Right + 10*ScreenX, 15);
+ SingDrawNoteLines(NR.Left + 10*ScreenX, Skin_P2_NotesB - 105, NR.Right + 10*ScreenX, 15);
end;
- if ((PlayersPlay = 3) or (PlayersPlay = 6)) and (Ini.NoteLines = 1) then begin
- SingDrawNoteLines(Nr.Left + 10*ScreenX, 120, Nr.Right + 10*ScreenX, 12);
- SingDrawNoteLines(Nr.Left + 10*ScreenX, 245, Nr.Right + 10*ScreenX, 12);
- SingDrawNoteLines(Nr.Left + 10*ScreenX, 370, Nr.Right + 10*ScreenX, 12);
+ if ((PlayersPlay = 3) or (PlayersPlay = 6)) and (Ini.NoteLines = 1) then
+ begin
+ SingDrawNoteLines(NR.Left + 10*ScreenX, 120, NR.Right + 10*ScreenX, 12);
+ SingDrawNoteLines(NR.Left + 10*ScreenX, 245, NR.Right + 10*ScreenX, 12);
+ SingDrawNoteLines(NR.Left + 10*ScreenX, 370, NR.Right + 10*ScreenX, 12);
end;
// draw Lyrics
@@ -724,39 +704,48 @@ begin
SingDrawLyricHelper(NR.Left, NR.WMid);
// oscilloscope
- if Ini.Oscilloscope = 1 then begin
+ if Ini.Oscilloscope = 1 then
+ begin
if PlayersPlay = 1 then
SingDrawOscilloscope(190 + 10*ScreenX, 55, 180, 40, 0);
- if PlayersPlay = 2 then begin
+ 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
+ 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
+ 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);
+ 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
+ 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
+ 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);
@@ -785,104 +774,121 @@ begin
end;
// Draw the Notes
- if PlayersPlay = 1 then begin
+ 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
+ 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);
+ 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);
+ 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
+ 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);
+ 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);
+ 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);
+ 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);
+ 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
+ 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
+ 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);
+ 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);
+ 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
+ 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);
+ 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);
+ 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
+ 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
+ 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);
+ 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);
+ 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);
@@ -892,12 +898,15 @@ end;
// q'n'd for using the game mode dll's
procedure SingModiDraw (PlayerInfo: TPlayerInfo);
var
- NR: TRecR;
+ NR: TRecR;
begin
// positions
- if Ini.SingWindow = 0 then begin
+ if Ini.SingWindow = 0 then
+ begin
NR.Left := 120;
- end else begin
+ end
+ else
+ begin
NR.Left := 20;
end;
@@ -912,16 +921,18 @@ begin
if DLLMan.Selected.ShowNotes then
begin
if PlayersPlay = 1 then
- SingDrawNoteLines(Nr.Left + 10*ScreenX, Skin_P2_NotesB - 105, Nr.Right + 10*ScreenX, 15);
- if (PlayersPlay = 2) or (PlayersPlay = 4) then begin
- SingDrawNoteLines(Nr.Left + 10*ScreenX, Skin_P1_NotesB - 105, Nr.Right + 10*ScreenX, 15);
- SingDrawNoteLines(Nr.Left + 10*ScreenX, Skin_P2_NotesB - 105, Nr.Right + 10*ScreenX, 15);
+ SingDrawNoteLines(NR.Left + 10*ScreenX, Skin_P2_NotesB - 105, NR.Right + 10*ScreenX, 15);
+ if (PlayersPlay = 2) or (PlayersPlay = 4) then
+ begin
+ SingDrawNoteLines(NR.Left + 10*ScreenX, Skin_P1_NotesB - 105, NR.Right + 10*ScreenX, 15);
+ SingDrawNoteLines(NR.Left + 10*ScreenX, Skin_P2_NotesB - 105, NR.Right + 10*ScreenX, 15);
end;
- if (PlayersPlay = 3) or (PlayersPlay = 6) then begin
- SingDrawNoteLines(Nr.Left + 10*ScreenX, 120, Nr.Right + 10*ScreenX, 12);
- SingDrawNoteLines(Nr.Left + 10*ScreenX, 245, Nr.Right + 10*ScreenX, 12);
- SingDrawNoteLines(Nr.Left + 10*ScreenX, 370, Nr.Right + 10*ScreenX, 12);
+ if (PlayersPlay = 3) or (PlayersPlay = 6) then
+ begin
+ SingDrawNoteLines(NR.Left + 10*ScreenX, 120, NR.Right + 10*ScreenX, 12);
+ SingDrawNoteLines(NR.Left + 10*ScreenX, 245, NR.Right + 10*ScreenX, 12);
+ SingDrawNoteLines(NR.Left + 10*ScreenX, 370, NR.Right + 10*ScreenX, 12);
end;
end;
@@ -930,26 +941,31 @@ begin
// TODO: Lyrics helper
// oscilloscope | the thing that moves when you yell into your mic (imho)
- if (((Ini.Oscilloscope = 1) AND (DLLMan.Selected.ShowRateBar_O)) AND (NOT DLLMan.Selected.ShowRateBar)) then begin
+ if (((Ini.Oscilloscope = 1) and (DLLMan.Selected.ShowRateBar_O)) and (not DLLMan.Selected.ShowRateBar)) then
+ begin
if PlayersPlay = 1 then
if PlayerInfo.Playerinfo[0].Enabled then
SingDrawOscilloscope(190 + 10*ScreenX, 55, 180, 40, 0);
- if PlayersPlay = 2 then begin
+ if PlayersPlay = 2 then
+ begin
if PlayerInfo.Playerinfo[0].Enabled then
SingDrawOscilloscope(190 + 10*ScreenX, 55, 180, 40, 0);
if PlayerInfo.Playerinfo[1].Enabled then
SingDrawOscilloscope(425 + 10*ScreenX, 55, 180, 40, 1);
end;
- if PlayersPlay = 4 then begin
- if ScreenAct = 1 then begin
+ if PlayersPlay = 4 then
+ begin
+ if ScreenAct = 1 then
+ begin
if PlayerInfo.Playerinfo[0].Enabled then
SingDrawOscilloscope(190 + 10*ScreenX, 55, 180, 40, 0);
if PlayerInfo.Playerinfo[1].Enabled then
SingDrawOscilloscope(425 + 10*ScreenX, 55, 180, 40, 1);
end;
- if ScreenAct = 2 then begin
+ if ScreenAct = 2 then
+ begin
if PlayerInfo.Playerinfo[2].Enabled then
SingDrawOscilloscope(190 + 10*ScreenX, 55, 180, 40, 2);
if PlayerInfo.Playerinfo[3].Enabled then
@@ -957,17 +973,20 @@ begin
end;
end;
- if PlayersPlay = 3 then begin
+ if PlayersPlay = 3 then
+ begin
if PlayerInfo.Playerinfo[0].Enabled then
- SingDrawOscilloscope(75 + 10*ScreenX, 95, 100, 20, 0);
+ SingDrawOscilloscope( 75 + 10*ScreenX, 95, 100, 20, 0);
if PlayerInfo.Playerinfo[1].Enabled then
SingDrawOscilloscope(370 + 10*ScreenX, 95, 100, 20, 1);
if PlayerInfo.Playerinfo[2].Enabled then
SingDrawOscilloscope(670 + 10*ScreenX, 95, 100, 20, 2);
end;
- if PlayersPlay = 6 then begin
- if ScreenAct = 1 then begin
+ if PlayersPlay = 6 then
+ begin
+ if ScreenAct = 1 then
+ begin
if PlayerInfo.Playerinfo[0].Enabled then
SingDrawOscilloscope( 75 + 10*ScreenX, 95, 100, 20, 0);
if PlayerInfo.Playerinfo[1].Enabled then
@@ -975,7 +994,8 @@ begin
if PlayerInfo.Playerinfo[2].Enabled then
SingDrawOscilloscope(670 + 10*ScreenX, 95, 100, 20, 2);
end;
- if ScreenAct = 2 then begin
+ if ScreenAct = 2 then
+ begin
if PlayerInfo.Playerinfo[3].Enabled then
SingDrawOscilloscope( 75 + 10*ScreenX, 95, 100, 20, 3);
if PlayerInfo.Playerinfo[4].Enabled then
@@ -1006,107 +1026,120 @@ begin
end;
end;
- if (DLLMAn.Selected.ShowNotes And DLLMan.Selected.LoadSong) then
+ if (DLLMAn.Selected.ShowNotes and DLLMan.Selected.LoadSong) then
begin
- if (PlayersPlay = 1) And PlayerInfo.Playerinfo[0].Enabled then begin
+ if (PlayersPlay = 1) and PlayerInfo.Playerinfo[0].Enabled then
+ begin
SingDrawPlayerBGLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 0, 15);
SingDrawLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 15);
- SingDrawPlayerLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 0, 15);
+ SingDrawPlayerLine(NR.Left + 20, Skin_P2_NotesB, NR.Width - 40, 0, 15);
end;
- if (PlayersPlay = 2) then begin
+ if PlayersPlay = 2 then
+ begin
if PlayerInfo.Playerinfo[0].Enabled then
begin
- SingDrawPlayerBGLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 0, 15);
+ SingDrawPlayerBGLine(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 0, 15);
SingDrawLine(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 15);
- SingDrawPlayerLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 0, 15);
+ SingDrawPlayerLine(NR.Left + 20, Skin_P1_NotesB, NR.Width - 40, 0, 15);
end;
if PlayerInfo.Playerinfo[1].Enabled then
begin
- SingDrawPlayerBGLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 1, 15);
+ SingDrawPlayerBGLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 1, 15);
SingDrawLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 15);
- SingDrawPlayerLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 1, 15);
+ SingDrawPlayerLine(NR.Left + 20, Skin_P2_NotesB, NR.Width - 40, 1, 15);
end;
end;
- if PlayersPlay = 3 then begin
+ if PlayersPlay = 3 then
+ begin
NotesW := NotesW * 0.8;
NotesH := NotesH * 0.8;
if PlayerInfo.Playerinfo[0].Enabled then
begin
- SingDrawPlayerBGLine(Nr.Left + 20, 120+95, Nr.Right - 20, 0, 0, 12);
+ SingDrawPlayerBGLine(NR.Left + 20, 120+95, NR.Right - 20, 0, 0, 12);
SingDrawLine(NR.Left + 20, 120+95, NR.Right - 20, 0, 12);
- SingDrawPlayerLine(Nr.Left + 20, 120+95, Nr.Width - 40, 0, 12);
+ SingDrawPlayerLine(NR.Left + 20, 120+95, NR.Width - 40, 0, 12);
end;
if PlayerInfo.Playerinfo[1].Enabled then
begin
- SingDrawPlayerBGLine(Nr.Left + 20, 245+95, Nr.Right - 20, 0, 1, 12);
+ SingDrawPlayerBGLine(NR.Left + 20, 245+95, NR.Right - 20, 0, 1, 12);
SingDrawLine(NR.Left + 20, 245+95, NR.Right - 20, 0, 12);
- SingDrawPlayerLine(Nr.Left + 20, 245+95, Nr.Width - 40, 1, 12);
+ SingDrawPlayerLine(NR.Left + 20, 245+95, NR.Width - 40, 1, 12);
end;
if PlayerInfo.Playerinfo[2].Enabled then
begin
- SingDrawPlayerBGLine(Nr.Left + 20, 370+95, Nr.Right - 20, 0, 2, 12);
+ SingDrawPlayerBGLine(NR.Left + 20, 370+95, NR.Right - 20, 0, 2, 12);
SingDrawLine(NR.Left + 20, 370+95, NR.Right - 20, 0, 12);
- SingDrawPlayerLine(Nr.Left + 20, 370+95, Nr.Width - 40, 2, 12);
+ SingDrawPlayerLine(NR.Left + 20, 370+95, NR.Width - 40, 2, 12);
end;
end;
- if PlayersPlay = 4 then begin
- if ScreenAct = 1 then begin
- SingDrawPlayerBGLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Right - 20, 0, 0, 15);
- SingDrawPlayerBGLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Right - 20, 0, 1, 15);
+ 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);
+ if ScreenAct = 2 then
+ begin
+ SingDrawPlayerBGLine(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 2, 15);
+ SingDrawPlayerBGLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 3, 15);
end;
SingDrawLine(NR.Left + 20, Skin_P1_NotesB, NR.Right - 20, 0, 15);
SingDrawLine(NR.Left + 20, Skin_P2_NotesB, NR.Right - 20, 0, 15);
- if ScreenAct = 1 then begin
- SingDrawPlayerLine(Nr.Left + 20, Skin_P1_NotesB, Nr.Width - 40, 0, 15);
- SingDrawPlayerLine(Nr.Left + 20, Skin_P2_NotesB, Nr.Width - 40, 1, 15);
+ 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);
+ 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
+ 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);
+ 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);
+ if ScreenAct = 2 then
+ begin
+ SingDrawPlayerBGLine(NR.Left + 20, 120+95, NR.Right - 20, 0, 3, 12);
+ SingDrawPlayerBGLine(NR.Left + 20, 245+95, NR.Right - 20, 0, 4, 12);
+ SingDrawPlayerBGLine(NR.Left + 20, 370+95, NR.Right - 20, 0, 5, 12);
end;
SingDrawLine(NR.Left + 20, 120+95, NR.Right - 20, 0, 12);
SingDrawLine(NR.Left + 20, 245+95, NR.Right - 20, 0, 12);
SingDrawLine(NR.Left + 20, 370+95, NR.Right - 20, 0, 12);
- if ScreenAct = 1 then begin
- SingDrawPlayerLine(Nr.Left + 20, 120+95, Nr.Width - 40, 0, 12);
- SingDrawPlayerLine(Nr.Left + 20, 245+95, Nr.Width - 40, 1, 12);
- SingDrawPlayerLine(Nr.Left + 20, 370+95, Nr.Width - 40, 2, 12);
+ 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);
+ if ScreenAct = 2 then
+ begin
+ SingDrawPlayerLine(NR.Left + 20, 120+95, NR.Width - 40, 3, 12);
+ SingDrawPlayerLine(NR.Left + 20, 245+95, NR.Width - 40, 4, 12);
+ SingDrawPlayerLine(NR.Left + 20, 370+95, NR.Width - 40, 5, 12);
end;
end;
end;
@@ -1115,15 +1148,14 @@ begin
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;
+ R: real;
+ G: real;
+ B: real;
+ A: cardinal;
+ I: integer;
begin;
@@ -1141,7 +1173,7 @@ begin;
glEnd;
//SingBar coloured Bar
- Case Percent of
+ case Percent of
0..22: begin
R := 1;
G := 0;
@@ -1167,7 +1199,7 @@ begin;
G := 1;
B := 0;
end;
- End; //Case
+ end; //case
glColor4f(R, G, B, 1);
glEnable(GL_TEXTURE_2D);
@@ -1198,99 +1230,103 @@ end;
//end Singbar Mod
//PhrasenBonus - Line Bonus Pop Up
-procedure SingDrawLineBonus( const X, Y: Single; Color: TRGB; Alpha: Single; Text: string; Age: Integer);
+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
+ 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);
+ 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 ^^
+ Length := glTextWidth (Text) + 3; //Little Space for a Better Look ^^
//Text
-SetFontPos (X + 50 - (Length / 2), Y + 12); //Position
+ SetFontPos (X + 50 - (Length / 2), Y + 12); //Position
+ if Age < 5 then
+ Size := Age * 10
+ else
+ Size := 50;
-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);
-
+//Draw Background
+// glColor4f(Color.R, Color.G, Color.B, Alpha); //Set Color
+ glColor4f(1, 1, 1, Alpha);
- //New Method, Not Variable
- glBindTexture(GL_TEXTURE_2D, Tex_SingLineBonusBack[2].TexNum);
+ glEnable(GL_TEXTURE_2D);
+ glEnable(GL_BLEND);
+// glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
- 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;
+//New Method, Not Variable
+ glBindTexture(GL_TEXTURE_2D, Tex_SingLineBonusBack[2].TexNum);
- glColor4f(1, 1, 1, Alpha); //Set Color
- //Draw Text
- glPrint (Text);
-end;
+ 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 Resons for a new Procdedure: (nice binary :D )
-// 1. It don't look good when you Draw the Golden Note Star Effect in the Editor
-// 2. You can see the Freestyle Notes in the Editor SemiTransparent
-// 3. Its easier and Faster then changing the old Procedure
+// 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;
+ 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
-
+ with Lines[NrLines].Line[Lines[NrLines].Current] do
+ begin
+ for Count := 0 to HighNote do
+ begin
+ with Note[Count] do
+ begin
+ // Golden Note Patch
+ case NoteType of
+ ntFreestyle: glColor4f(1, 1, 1, 0.35);
+ ntNormal: glColor4f(1, 1, 1, 0.85);
+ ntGolden: Glcolor4f(1, 1, 0.3, 0.85);
+ end; // case
- // lewa czesc - left part
- Rec.Left := (Start-Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start) * TempR + Left + 0.5 + 10*ScreenX;
- Rec.Right := Rec.Left + NotesW;
- Rec.Top := Top - (Tone-BaseNote)*Space/2 - NotesH;
- Rec.Bottom := Rec.Top + 2 * NotesH;
- glBindTexture(GL_TEXTURE_2D, Tex_Left[Color].TexNum);
- glBegin(GL_QUADS);
- glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top);
- glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom);
- glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom);
- glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top);
- glEnd;
+ // left part
+ Rec.Left := (Start-Lines[NrLines].Line[Lines[NrLines].Current].Note[0].Start) * TempR + Left + 0.5 + 10*ScreenX;
+ Rec.Right := Rec.Left + NotesW;
+ Rec.Top := Top - (Tone-BaseNote)*Space/2 - NotesH;
+ Rec.Bottom := Rec.Top + 2 * NotesH;
+ glBindTexture(GL_TEXTURE_2D, Tex_Left[Color].TexNum);
+ glBegin(GL_QUADS);
+ glTexCoord2f(0, 0); glVertex2f(Rec.Left, Rec.Top);
+ glTexCoord2f(0, 1); glVertex2f(Rec.Left, Rec.Bottom);
+ glTexCoord2f(1, 1); glVertex2f(Rec.Right, Rec.Bottom);
+ glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top);
+ glEnd;
- // srodkowa czesc - middle part
- Rec.Left := Rec.Right;
+ // 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);
@@ -1301,8 +1337,8 @@ begin
glTexCoord2f(1, 0); glVertex2f(Rec.Right, Rec.Top);
glEnd;
- // prawa czesc - right part
- Rec.Left := Rec.Right;
+ // right part
+ Rec.Left := Rec.Right;
Rec.Right := Rec.Right + NotesW;
glBindTexture(GL_TEXTURE_2D, Tex_Right[Color].TexNum);
@@ -1323,7 +1359,7 @@ end;
procedure SingDrawTimeBar();
var
- x,y: real;
+ x, y: real;
width, height: real;
LyricsProgress: real;
CurLyricsTime: real;
diff --git a/unicode/src/base/UEditorLyrics.pas b/unicode/src/base/UEditorLyrics.pas
index d06fc891..fe8c3ee5 100644
--- a/unicode/src/base/UEditorLyrics.pas
+++ b/unicode/src/base/UEditorLyrics.pas
@@ -40,48 +40,50 @@ uses
UTexture;
type
+ alignment = (left, center, right);
+
TWord = record
- X: real;
- Y: real;
- Size: real;
- Width: real;
- Text: string;
- ColR: real;
- ColG: real;
- ColB: real;
- FontStyle: integer;
- Italic: boolean;
- Selected: boolean;
+ X: real;
+ Y: real;
+ Size: real;
+ Width: real;
+ Text: string;
+ ColR: real;
+ ColG: real;
+ ColB: real;
+ FontStyle: integer;
+ Italic: boolean;
+ Selected: boolean;
end;
TEditorLyrics = class
private
- AlignI: integer;
- XR: real;
- YR: real;
- SizeR: real;
- SelectedI: integer;
- FontStyleI: integer; // font number
- Word: array of TWord;
+ AlignI: alignment;
+ XR: real;
+ YR: real;
+ SizeR: real;
+ SelectedI: integer;
+ FontStyleI: integer; // font number
+ Word: array of TWord;
procedure SetX(Value: real);
procedure SetY(Value: real);
function GetClientX: real;
- procedure SetAlign(Value: integer);
+ procedure SetAlign(Value: alignment);
function GetSize: real;
procedure SetSize(Value: real);
procedure SetSelected(Value: integer);
- procedure SetFStyle(Value: integer);
+ procedure SetFontStyle(Value: integer);
procedure AddWord(Text: string);
procedure Refresh;
public
- ColR: real;
- ColG: real;
- ColB: real;
- ColSR: real;
- ColSG: real;
- ColSB: real;
- Italic: boolean;
+ ColR: real;
+ ColG: real;
+ ColB: real;
+ ColSR: real;
+ ColSG: real;
+ ColSB: real;
+ Italic: boolean;
constructor Create;
destructor Destroy; override;
@@ -94,16 +96,20 @@ type
property X: real write SetX;
property Y: real write SetY;
property ClientX: real read GetClientX;
- property Align: integer write SetAlign;
+ property Align: alignment write SetAlign;
property Size: real read GetSize write SetSize;
property Selected: integer read SelectedI write SetSelected;
- property FontStyle: integer write SetFStyle;
+ property FontStyle: integer write SetFontStyle;
end;
implementation
uses
- TextGL, UGraphic, UDrawTexture, Math, USkins;
+ TextGL,
+ UGraphic,
+ UDrawTexture,
+ Math,
+ USkins;
constructor TEditorLyrics.Create;
begin
@@ -131,7 +137,7 @@ begin
Result := Word[0].X;
end;
-procedure TEditorLyrics.SetAlign(Value: integer);
+procedure TEditorLyrics.SetAlign(Value: alignment);
begin
AlignI := Value;
end;
@@ -148,7 +154,7 @@ end;
procedure TEditorLyrics.SetSelected(Value: integer);
begin
- if (SelectedI > -1) and (SelectedI <= High(Word)) then
+ if (-1 < SelectedI) and (SelectedI <= High(Word)) then
begin
Word[SelectedI].Selected := false;
Word[SelectedI].ColR := ColR;
@@ -157,7 +163,7 @@ begin
end;
SelectedI := Value;
- if (Value > -1) and (Value <= High(Word)) then
+ if (-1 < Value) and (Value <= High(Word)) then
begin
Word[Value].Selected := true;
Word[Value].ColR := ColSR;
@@ -168,22 +174,21 @@ begin
Refresh;
end;
-procedure TEditorLyrics.SetFStyle(Value: integer);
+procedure TEditorLyrics.SetFontStyle(Value: integer);
begin
FontStyleI := Value;
end;
procedure TEditorLyrics.AddWord(Text: string);
var
- WordNum: integer;
+ WordNum: integer;
begin
WordNum := Length(Word);
SetLength(Word, WordNum + 1);
- if WordNum = 0 then begin
- Word[WordNum].X := XR;
- end else begin
+ if WordNum = 0 then
+ Word[WordNum].X := XR
+ else
Word[WordNum].X := Word[WordNum - 1].X + Word[WordNum - 1].Width;
- end;
Word[WordNum].Y := YR;
Word[WordNum].Size := SizeR;
@@ -202,12 +207,13 @@ end;
procedure TEditorLyrics.AddLine(NrLine: integer);
var
- N: integer;
+ NoteIndex: integer;
begin
Clear;
- for N := 0 to Lines[0].Line[NrLine].HighNote do begin
- Italic := Lines[0].Line[NrLine].Note[N].NoteType = ntFreestyle;
- AddWord(Lines[0].Line[NrLine].Note[N].Text);
+ 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;
@@ -220,32 +226,33 @@ end;
procedure TEditorLyrics.Refresh;
var
- W: integer;
- TotWidth: real;
+ WordIndex: integer;
+ TotalWidth: real;
begin
- if AlignI = 1 then begin
- TotWidth := 0;
- for W := 0 to High(Word) do
- TotWidth := TotWidth + Word[W].Width;
-
- Word[0].X := XR - TotWidth / 2;
- for W := 1 to High(Word) do
- Word[W].X := Word[W - 1].X + Word[W - 1].Width;
+ if AlignI = center 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
- W: integer;
+ WordIndex: integer;
begin
- for W := 0 to High(Word) do
+ for WordIndex := 0 to High(Word) do
begin
- SetFontStyle(Word[W].FontStyle);
- SetFontPos(Word[W].X+ 10*ScreenX, Word[W].Y);
- SetFontSize(Word[W].Size);
- SetFontItalic(Word[W].Italic);
- glColor3f(Word[W].ColR, Word[W].ColG, Word[W].ColB);
- glPrint(Word[W].Text);
+ 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;
diff --git a/unicode/src/base/UFiles.pas b/unicode/src/base/UFiles.pas
index 463801c7..ee6f660a 100644
--- a/unicode/src/base/UFiles.pas
+++ b/unicode/src/base/UFiles.pas
@@ -58,8 +58,8 @@ implementation
uses
TextGL,
UIni,
- UPlatform,
- UMain;
+ UNote,
+ UPlatform;
//--------------------
// Resets the temporary Sentence Arrays for each Player and some other Variables
@@ -73,7 +73,6 @@ begin
SetLength(Lines[Count].Line, 1);
SetLength(Lines[Count].Line[0].Note, 0);
Lines[Count].Line[0].Lyric := '';
- Lines[Count].Line[0].LyricWidth := 0;
Player[Count].Score := 0;
Player[Count].LengthNote := 0;
Player[Count].HighNote := -1;
diff --git a/unicode/src/base/UGraphic.pas b/unicode/src/base/UGraphic.pas
index b525c170..17175d02 100644
--- a/unicode/src/base/UGraphic.pas
+++ b/unicode/src/base/UGraphic.pas
@@ -280,11 +280,12 @@ function LoadingThreadFunction: integer;
implementation
uses
+ Classes,
UMain,
UIni,
UDisplay,
UCommandLine,
- Classes;
+ UPath;
procedure LoadFontTextures;
begin
@@ -294,17 +295,19 @@ end;
procedure LoadTextures;
-
var
- P: integer;
- R, G, B: real;
- Col: integer;
+ P: integer;
+ R, G, B: real;
+ Col: integer;
begin
Log.LogStatus('Loading Textures', 'LoadTextures');
-
- Tex_Left[0] := Texture.LoadTexture(Skin.GetTextureFileName('GrayLeft'), TEXTURE_TYPE_TRANSPARENT, 0); //brauch man die noch?
- Tex_Mid[0] := Texture.LoadTexture(Skin.GetTextureFileName('GrayMid'), TEXTURE_TYPE_PLAIN, 0); //brauch man die noch?
- Tex_Right[0] := Texture.LoadTexture(Skin.GetTextureFileName('GrayRight'), TEXTURE_TYPE_TRANSPARENT, 0); //brauch man die noch?
+
+ // FIXME: do we need this? (REMOVE otherwise)
+ Tex_Left[0] := Texture.LoadTexture(Skin.GetTextureFileName('GrayLeft'), TEXTURE_TYPE_TRANSPARENT, 0);
+ // FIXME: do we need this? (REMOVE otherwise)
+ Tex_Mid[0] := Texture.LoadTexture(Skin.GetTextureFileName('GrayMid'), TEXTURE_TYPE_PLAIN, 0);
+ // FIXME: do we need this? (REMOVE otherwise)
+ Tex_Right[0] := Texture.LoadTexture(Skin.GetTextureFileName('GrayRight'), TEXTURE_TYPE_TRANSPARENT, 0);
Log.LogStatus('Loading Textures - A', 'LoadTextures');
diff --git a/unicode/src/base/UGraphicClasses.pas b/unicode/src/base/UGraphicClasses.pas
index 3fbe262f..cdaa238e 100644
--- a/unicode/src/base/UGraphicClasses.pas
+++ b/unicode/src/base/UGraphicClasses.pas
@@ -124,16 +124,16 @@ var
implementation
uses
- sysutils,
+ SysUtils,
+ Math,
gl,
+ UCommon,
+ UDrawTexture,
+ UGraphic,
UIni,
- UMain,
- UThemes,
+ UNote,
USkins,
- UGraphic,
- UDrawTexture,
- UCommon,
- math;
+ UThemes;
//TParticle
constructor TParticle.Create(cX, cY : real;
diff --git a/unicode/src/base/UHooks.pas b/unicode/src/base/UHooks.pas
index ab830090..acf2bba7 100644
--- a/unicode/src/base/UHooks.pas
+++ b/unicode/src/base/UHooks.pas
@@ -46,23 +46,23 @@ type
//Record that saves info from Subscriber
PSubscriberInfo = ^TSubscriberInfo;
TSubscriberInfo = record
- Self: THandle; //ID of this Subscription (First word: ID of Subscription; 2nd word: ID of Hook)
- Next: PSubscriberInfo; //Pointer to next Item in HookChain
+ Self: THandle; // ID of this Subscription (First word: ID of Subscription; 2nd word: ID of Hook)
+ Next: PSubscriberInfo; // Pointer to next Item in HookChain
Owner: integer; //For Error Handling and Plugin Unloading.
- //Here is s/t tricky
- //To avoid writing of Wrapping Functions to Hook an Event with a Class
- //We save a Normal Proc or a Method of a Class
+ // Here is s/t tricky
+ // To avoid writing of Wrapping Functions to Hook an Event with a Class
+ // We save a Normal Proc or a Method of a Class
case isClass: boolean of
- False: (Proc: TUS_Hook); //Proc that will be called on Event
- True: (ProcOfClass: TUS_Hook_of_Object);
+ false: (Proc: TUS_Hook); //Proc that will be called on Event
+ true: (ProcOfClass: TUS_Hook_of_Object);
end;
TEventInfo = record
- Name: string[60]; //Name of Event
- FirstSubscriber: PSubscriberInfo; //First subscriber in chain
- LastSubscriber: PSubscriberInfo; //Last " (for easier subscriber adding
+ Name: string[60]; // Name of Event
+ FirstSubscriber: PSubscriberInfo; // First subscriber in chain
+ LastSubscriber: PSubscriberInfo; // Last " (for easier subscriber adding)
end;
THookManager = class
@@ -101,7 +101,8 @@ uses
// Create - Creates Class and Set Standard Values
//------------
constructor THookManager.Create(const SpacetoAllocate: word);
-var I: integer;
+var
+ I: integer;
begin
inherited Create();
@@ -121,7 +122,8 @@ end;
// AddEvent - Adds an Event and return the Events Handle or 0 on Failure
//------------
function THookManager.AddEvent (const EventName: Pchar): THandle;
-var I: integer;
+var
+ I: integer;
begin
Result := 0;
@@ -177,7 +179,6 @@ begin
hEvent := hEvent - 1; //Arrayindex is Handle - 1
Result := -1;
-
if (Length(Events) > hEvent) and (Events[hEvent].Name[1] <> chr(0)) then
begin //Event exists
//Free the Space for all Subscribers
@@ -212,8 +213,8 @@ end;
function THookManager.AddSubscriber (const EventName: Pchar; const Proc: TUS_Hook; const ProcOfClass: TUS_Hook_of_Object): THandle;
var
EventHandle: THandle;
- EventIndex: Cardinal;
- Cur: PSubscriberInfo;
+ EventIndex: integer;
+ Cur: PSubscriberInfo;
begin
Result := 0;
@@ -224,7 +225,7 @@ begin
if (EventHandle <> 0) then
begin
EventIndex := EventHandle - 1;
-
+
//Get Memory
GetMem(Cur, SizeOf(TSubscriberInfo));
@@ -236,12 +237,12 @@ begin
if (@Proc = nil) then
begin //Use the ProcofClass Method
- Cur.isClass := True;
+ Cur.isClass := true;
Cur.ProcOfClass := ProcofClass;
end
else //Use the normal Proc
begin
- Cur.isClass := False;
+ Cur.isClass := false;
Cur.Proc := Proc;
end;
@@ -306,8 +307,8 @@ end;
//------------
function THookManager.DelSubscriber (const hSubscriber: THandle): integer;
var
- EventIndex: Cardinal;
- Cur, Last: PSubscriberInfo;
+ EventIndex: integer;
+ Cur, Last: PSubscriberInfo;
begin
Result := -1;
EventIndex := ((hSubscriber and (High(THandle) xor High(word))) SHR 16) - 1;
@@ -344,16 +345,15 @@ begin
end;
end;
-
//------------
// CallEventChain - Calls the Chain of a specified EventHandle
// Returns: -1: Handle doesn't Exist, 0 Chain is called until the End
//------------
function THookManager.CallEventChain (const hEvent: THandle; const wParam: TwParam; lParam: TlParam): integer;
var
- EventIndex: Cardinal;
- Cur: PSubscriberInfo;
- CurExecutedBackup: integer; //backup of Core.CurExecuted Attribute
+ EventIndex: integer;
+ Cur: PSubscriberInfo;
+ CurExecutedBackup: integer; // backup of Core.CurExecuted Attribute
begin
Result := -1;
EventIndex := hEvent - 1;
@@ -393,7 +393,7 @@ end;
//------------
function THookManager.EventExists (const EventName: Pchar): integer;
var
- I: integer;
+ I: integer;
Name: string[60];
begin
Result := 0;
@@ -418,7 +418,7 @@ end;
//------------
procedure THookManager.DelbyOwner(const Owner: integer);
var
- I: integer;
+ I: integer;
Cur, Last: PSubscriberInfo;
begin
//Search for Owner in all Hooks Chains
@@ -426,7 +426,7 @@ begin
begin
if (Events[I].Name[1] <> chr(0)) then
begin
-
+
Last := nil;
Cur := Events[I].FirstSubscriber;
//Went Through Chain
@@ -451,7 +451,6 @@ begin
end;
end;
-
function HookTest(wParam: TwParam; lParam: TlParam): integer; stdcall;
begin
Result := 0; //Don't break the chain
diff --git a/unicode/src/base/UImage.pas b/unicode/src/base/UImage.pas
index 18b0035c..8dc38495 100644
--- a/unicode/src/base/UImage.pas
+++ b/unicode/src/base/UImage.pas
@@ -151,10 +151,9 @@ function LoadImage(const Filename: string): PSDL_Surface;
*******************************************************)
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);
-
+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
@@ -185,7 +184,6 @@ uses
UCommon,
ULog;
-
function IsRGBSurface(pixelFmt: PSDL_PixelFormat): boolean;
begin
Result := (pixelFmt.BitsPerPixel = 24) and
@@ -266,7 +264,6 @@ begin
end;
end;
-
(*******************************************************
* Image saving
*******************************************************)
@@ -759,12 +756,10 @@ end;
{$ENDIF}
-
(*******************************************************
* Image loading
*******************************************************)
-
(*
* Loads an image from the given file
*)
@@ -793,12 +788,10 @@ begin
end;
end;
-
(*******************************************************
* Image manipulation
*******************************************************)
-
function PixelFormatEquals(fmt1, fmt2: PSDL_PixelFormat): boolean;
begin
if (fmt1^.BitsPerPixel = fmt2^.BitsPerPixel) and
@@ -814,7 +807,7 @@ begin
Result := false;
end;
-procedure ScaleImage(var ImgSurface: PSDL_Surface; Width, Height: Cardinal);
+procedure ScaleImage(var ImgSurface: PSDL_Surface; Width, Height: cardinal);
var
TempSurface: PSDL_Surface;
begin
@@ -825,10 +818,10 @@ begin
SDL_FreeSurface(TempSurface);
end;
-procedure FitImage(var ImgSurface: PSDL_Surface; Width, Height: Cardinal);
+procedure FitImage(var ImgSurface: PSDL_Surface; Width, Height: cardinal);
var
TempSurface: PSDL_Surface;
- ImgFmt: PSDL_PixelFormat;
+ ImgFmt: PSDL_PixelFormat;
begin
TempSurface := ImgSurface;
@@ -849,12 +842,12 @@ 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);
+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;
+ 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;
@@ -892,90 +885,175 @@ begin
end;
*)
-procedure ColorizeImage(ImgSurface: PSDL_Surface; NewColor: Cardinal);
+procedure ColorizeImage(ImgSurface: PSDL_Surface; NewColor: cardinal);
- //returns hue within range [0.0-6.0)
- function col2hue(Color:Cardinal): double;
+ // 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 longwords, shifted by 10 bits to keep
+ // digits.
+
+ function ColorToHue(const Color: longword): longword;
+ // returns hue within the range [0.0-6.0] but shl 10, ie. times 1024
var
- clr: array[0..2] of double;
- hue, max, delta: double;
+ Red, Green, Blue: longword;
+ Min, Max, Delta: longword;
+ Hue: double;
begin
- clr[0] := ((Color and $ff0000) shr 16)/255; // R
- clr[1] := ((Color and $ff00) shr 8)/255; // G
- clr[2] := (Color and $ff) /255; // B
- max := maxvalue(clr);
- delta := max - minvalue(clr);
+ // 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
- if (delta = 0.0) then hue := 0
- else if (clr[0] = max) then hue := (clr[1]-clr[2])/delta
- else if (clr[1] = max) then hue := 2.0+(clr[2]-clr[0])/delta
- else if (clr[2] = max) then hue := 4.0+(clr[0]-clr[1])/delta;
- if (hue < 0.0) then
- hue := hue + 6.0;
- Result := hue;
+ Delta := Max - Min;
+ 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.
+ 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
+ end;
end;
var
- DestinationHue: Double;
- PixelIndex: Cardinal;
+ PixelIndex: longword;
Pixel: PByte;
PixelColors: PByteArray;
- clr: array[0..2] of UInt32; // [0: R, 1: G, 2: B]
- hsv: array[0..2] of UInt32; // [0: H(ue), 1: S(aturation), 2: V(alue)]
- dhue: UInt32;
- h_int: Cardinal;
- delta, f, p, q, t: Longint;
- max: Uint32;
+ Red, Green, Blue: longword;
+ Hue, Sat: longword;
+ Min, Max, Delta: longword;
+ HueInteger: longword;
+ f, p, q, t: longword;
begin
- DestinationHue := col2hue(NewColor);
-
- dhue := Trunc(DestinationHue*1024);
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));
+
+ 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
- clr[0] := PixelColors[0] shl 10;
- clr[1] := PixelColors[1] shl 10;
- clr[2] := PixelColors[2] shl 10;
+
+ {$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 := clr[0];
- if clr[1] > max then max := clr[1];
- if clr[2] > max then max := clr[2];
- delta := clr[0];
- if clr[1] < delta then delta := clr[1];
- if clr[2] < delta then delta := clr[2];
- delta := max-delta;
- hsv[0] := dhue; // shl 8
- hsv[2] := max; // shl 8
- if (max = 0) then
- hsv[1] := 0
+ 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
- hsv[1] := (delta shl 10) div max; // shl 8
- h_int := hsv[0] and $fffffC00;
- f := hsv[0]-h_int; //shl 10
- p := (hsv[2]*(1024-hsv[1])) shr 10;
- q := (hsv[2]*(1024-(hsv[1]*f) shr 10)) shr 10;
- t := (hsv[2]*(1024-(hsv[1]*(1024-f)) shr 10)) shr 10;
- h_int := h_int shr 10;
- case h_int of
- 0: begin clr[0] := hsv[2]; clr[1] := t; clr[2] := p; end; // (v,t,p)
- 1: begin clr[0] := q; clr[1] := hsv[2]; clr[2] := p; end; // (q,v,p)
- 2: begin clr[0] := p; clr[1] := hsv[2]; clr[2] := t; end; // (p,v,t)
- 3: begin clr[0] := p; clr[1] := q; clr[2] := hsv[2]; end; // (p,q,v)
- 4: begin clr[0] := t; clr[1] := p; clr[2] := hsv[2]; end; // (t,p,v)
- 5: begin clr[0] := hsv[2]; clr[1] := p; clr[2] := q; end; // (v,p,q)
- end;
+ 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;
+ 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;
+
+ 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] := Red;
+ PixelColors[2] := Green;
+ PixelColors[1] := Blue
+ {$ELSE}
+ PixelColors[0] := Red;
+ PixelColors[1] := Green;
+ PixelColors[2] := Blue;
+ {$ENDIF}
- PixelColors[0] := clr[0] shr 10;
- PixelColors[1] := clr[1] shr 10;
- PixelColors[2] := clr[2] shr 10;
+ end;
+ end;
Inc(Pixel, ImgSurface^.format.BytesPerPixel);
end;
diff --git a/unicode/src/base/UIni.pas b/unicode/src/base/UIni.pas
index e90ae31c..241b34e8 100644
--- a/unicode/src/base/UIni.pas
+++ b/unicode/src/base/UIni.pas
@@ -74,7 +74,7 @@ type
function RemoveFileExt(FullName: string): string;
function ExtractKeyIndex(const Key, Prefix, Suffix: string): integer;
function GetMaxKeyIndex(Keys: TStringList; const Prefix, Suffix: string): integer;
- function GetArrayIndex(const SearchArray: array of string; Value: string; CaseInsensitiv: Boolean = False): integer;
+ function GetArrayIndex(const SearchArray: array of string; Value: string; CaseInsensitiv: boolean = false): integer;
function ReadArrayIndex(const SearchArray: array of string; IniFile: TCustomIniFile;
IniSection: string; IniProperty: string; Default: integer): integer;
@@ -99,7 +99,7 @@ type
Difficulty: integer;
Language: integer;
Tabs: integer;
- Tabs_at_startup:integer; //Tabs at Startup fix
+ TabsAtStartup: integer; //Tabs at Startup fix
Sorting: integer;
Debug: integer;
@@ -107,7 +107,7 @@ type
Screens: integer;
Resolution: integer;
Depth: integer;
- VisualizerOption:integer;
+ VisualizerOption: integer;
FullScreen: integer;
TextureSize: integer;
SingWindow: integer;
@@ -122,8 +122,8 @@ type
BeatClick: integer;
SavePlayback: integer;
ThresholdIndex: integer;
- AudioOutputBufferSizeIndex:integer;
- VoicePassthrough:integer;
+ AudioOutputBufferSizeIndex: integer;
+ VoicePassthrough: integer;
//Song Preview
PreviewVolume: integer;
@@ -139,8 +139,8 @@ type
Theme: integer;
SkinNo: integer;
Color: integer;
- BackgroundMusicOption:integer;
-
+ BackgroundMusicOption: integer;
+
// Record
InputDeviceConfig: array of TInputDeviceConfig;
@@ -166,22 +166,20 @@ type
end;
var
- Ini: TIni;
- IResolution: array of string;
- ILanguage: array of string;
- ITheme: array of string;
- ISkin: array of string;
-
-
+ Ini: TIni;
+ IResolution: array of string;
+ ILanguage: array of string;
+ ITheme: array of string;
+ ISkin: array of string;
const
- IPlayers: array[0..4] of string = ('1', '2', '3', '4', '6');
- IPlayersVals: array[0..4] of integer = ( 1 , 2 , 3 , 4 , 6 );
+ IPlayers: array[0..4] of string = ('1', '2', '3', '4', '6');
+ IPlayersVals: array[0..4] of integer = ( 1 , 2 , 3 , 4 , 6 );
- IDifficulty: array[0..2] of string = ('Easy', 'Medium', 'Hard');
- ITabs: array[0..1] of string = ('Off', 'On');
+ IDifficulty: array[0..2] of string = ('Easy', 'Medium', 'Hard');
+ ITabs: array[0..1] of string = ('Off', 'On');
- ISorting: array[0..7] of string = ('Edition', 'Genre', 'Language', 'Folder', 'Title', 'Artist', 'Title2', 'Artist2');
+ ISorting: array[0..7] of string = ('Edition', 'Genre', 'Language', 'Folder', 'Title', 'Artist', 'Title2', 'Artist2');
sEdition = 0;
sGenre = 1;
sLanguage = 2;
@@ -191,51 +189,49 @@ const
sTitle2 = 6;
sArtist2 = 7;
- IDebug: array[0..1] of string = ('Off', 'On');
+ IDebug: array[0..1] of string = ('Off', 'On');
- IScreens: array[0..1] of string = ('1', '2');
- IFullScreen: array[0..1] of string = ('Off', 'On');
- IDepth: array[0..1] of string = ('16 bit', '32 bit');
- IVisualizer: array[0..2] of string = ('Off', 'WhenNoVideo','On');
+ IScreens: array[0..1] of string = ('1', '2');
+ IFullScreen: array[0..1] of string = ('Off', 'On');
+ IDepth: array[0..1] of string = ('16 bit', '32 bit');
+ IVisualizer: array[0..2] of string = ('Off', 'WhenNoVideo','On');
- IBackgroundMusic: array[0..1] of string = ('Off', 'On');
+ IBackgroundMusic: array[0..1] of string = ('Off', 'On');
+ ITextureSize: array[0..2] of string = ('128', '256', '512');
+ ITextureSizeVals: array[0..2] of integer = ( 128, 256, 512);
- ITextureSize: array[0..2] of string = ('128', '256', '512');
- ITextureSizeVals: array[0..2] of integer = ( 128, 256, 512);
-
- ISingWindow: array[0..1] of string = ('Small', 'Big');
+ ISingWindow: array[0..1] of string = ('Small', 'Big');
//SingBar Mod
- IOscilloscope: array[0..2] of string = ('Off', 'Osci', 'Bar');
-//IOscilloscope: array[0..1] of string = ('Off', 'On');
+ IOscilloscope: array[0..2] of string = ('Off', 'Osci', 'Bar');
+//IOscilloscope: array[0..1] of string = ('Off', 'On');
- ISpectrum: array[0..1] of string = ('Off', 'On');
- ISpectrograph: array[0..1] of string = ('Off', 'On');
- IMovieSize: array[0..2] of string = ('Half', 'Full [Vid]', 'Full [BG+Vid]');
+ ISpectrum: array[0..1] of string = ('Off', 'On');
+ ISpectrograph: array[0..1] of string = ('Off', 'On');
+ IMovieSize: array[0..2] of string = ('Half', 'Full [Vid]', 'Full [BG+Vid]');
- IClickAssist: array[0..1] of string = ('Off', 'On');
- IBeatClick: array[0..1] of string = ('Off', 'On');
- ISavePlayback: array[0..1] of string = ('Off', 'On');
+ IClickAssist: array[0..1] of string = ('Off', 'On');
+ IBeatClick: array[0..1] of string = ('Off', 'On');
+ ISavePlayback: array[0..1] of string = ('Off', 'On');
- IThreshold: array[0..3] of string = ('5%', '10%', '15%', '20%');
- IThresholdVals: array[0..3] of single = (0.05, 0.10, 0.15, 0.20);
+ IThreshold: array[0..3] of string = ('5%', '10%', '15%', '20%');
+ IThresholdVals: array[0..3] of single = (0.05, 0.10, 0.15, 0.20);
- IVoicePassthrough: array[0..1] of string = ('Off', 'On');
+ IVoicePassthrough: array[0..1] of string = ('Off', 'On');
IAudioOutputBufferSize: array[0..9] of string = ('Auto', '256', '512', '1024', '2048', '4096', '8192', '16384', '32768', '65536');
IAudioOutputBufferSizeVals: array[0..9] of integer = ( 0, 256, 512 , 1024 , 2048 , 4096 , 8192 , 16384 , 32768 , 65536 );
- IAudioInputBufferSize: array[0..9] of string = ('Auto', '256', '512', '1024', '2048', '4096', '8192', '16384', '32768', '65536');
- IAudioInputBufferSizeVals: array[0..9] of integer = ( 0, 256, 512 , 1024 , 2048 , 4096 , 8192 , 16384 , 32768 , 65536 );
+ IAudioInputBufferSize: array[0..9] of string = ('Auto', '256', '512', '1024', '2048', '4096', '8192', '16384', '32768', '65536');
+ IAudioInputBufferSizeVals: array[0..9] of integer = ( 0, 256, 512 , 1024 , 2048 , 4096 , 8192 , 16384 , 32768 , 65536 );
//Song Preview
- IPreviewVolume: array[0..10] of string = ('Off', '10%', '20%', '30%', '40%', '50%', '60%', '70%', '80%', '90%', '100%');
- IPreviewVolumeVals: array[0..10] of single = ( 0, 0.10, 0.20, 0.30, 0.40, 0.50, 0.60, 0.70, 0.80, 0.90, 1.00 );
-
- IPreviewFading: array[0..5] of string = ('Off', '1 Sec', '2 Secs', '3 Secs', '4 Secs', '5 Secs');
- IPreviewFadingVals: array[0..5] of integer = ( 0, 1, 2, 3, 4, 5 );
+ IPreviewVolume: array[0..10] of string = ('Off', '10%', '20%', '30%', '40%', '50%', '60%', '70%', '80%', '90%', '100%');
+ IPreviewVolumeVals: array[0..10] of single = ( 0, 0.10, 0.20, 0.30, 0.40, 0.50, 0.60, 0.70, 0.80, 0.90, 1.00 );
+ IPreviewFading: array[0..5] of string = ('Off', '1 Sec', '2 Secs', '3 Secs', '4 Secs', '5 Secs');
+ IPreviewFadingVals: array[0..5] of integer = ( 0, 1, 2, 3, 4, 5 );
ILyricsFont: array[0..2] of string = ('Plain', 'OLine1', 'OLine2');
ILyricsEffect: array[0..4] of string = ('Simple', 'Zoom', 'Slide', 'Ball', 'Shift');
@@ -247,7 +243,7 @@ const
// Advanced
ILoadAnimation: array[0..1] of string = ('Off', 'On');
IEffectSing: array[0..1] of string = ('Off', 'On');
- IScreenFade: array[0..1] of string =('Off', 'On');
+ IScreenFade: array[0..1] of string = ('Off', 'On');
IAskbeforeDel: array[0..1] of string = ('Off', 'On');
IOnSongClick: array[0..2] of string = ('Sing', 'Select Players', 'Open Menu');
ILineBonus: array[0..2] of string = ('Off', 'At Score', 'At Notes');
@@ -270,6 +266,7 @@ uses
USkins,
URecord,
UCommandLine,
+ UPath,
UUnicodeUtils;
(**
@@ -288,17 +285,22 @@ function TIni.ExtractKeyIndex(const Key, Prefix, Suffix: string): integer;
var
Value: string;
Start: integer;
+ PrefixPos, SuffixPos: integer;
begin
Result := -1;
- if Pos(Prefix, Key) > -1 then
- begin
- Start := Pos(Prefix, Key) + Length(Prefix);
+ PrefixPos := Pos(Prefix, Key);
+ if (PrefixPos <= 0) then
+ Exit;
+ SuffixPos := Pos(Suffix, Key);
+ if (SuffixPos <= 0) then
+ Exit;
- // copy all between prefix and suffix
- Value := Copy(Key, Start, Pos(Suffix, Key)-1 - Start);
- Result := StrToIntDef(Value, -1);
- end;
+ Start := PrefixPos + Length(Prefix);
+
+ // copy all between prefix and suffix
+ Value := Copy(Key, Start, SuffixPos - Start);
+ Result := StrToIntDef(Value, -1);
end;
(**
@@ -308,7 +310,7 @@ end;
*)
function TIni.GetMaxKeyIndex(Keys: TStringList; const Prefix, Suffix: string): integer;
var
- i: integer;
+ i: integer;
KeyIndex: integer;
begin
Result := -1;
@@ -326,7 +328,7 @@ end;
* or -1 if Value is not in SearchArray.
*)
function TIni.GetArrayIndex(const SearchArray: array of string; Value: string;
- CaseInsensitiv: Boolean = False): integer;
+ CaseInsensitiv: boolean = false): integer;
var
i: integer;
begin
@@ -362,15 +364,14 @@ begin
end;
end;
-
procedure TIni.LoadInputDeviceCfg(IniFile: TMemIniFile);
var
- DeviceCfg: PInputDeviceConfig;
- DeviceIndex: integer;
+ DeviceCfg: PInputDeviceConfig;
+ DeviceIndex: integer;
ChannelCount: integer;
ChannelIndex: integer;
- RecordKeys: TStringList;
- i: integer;
+ RecordKeys: TStringList;
+ i: integer;
begin
RecordKeys := TStringList.Create();
@@ -419,15 +420,15 @@ begin
RecordKeys.Free();
// MicBoost
- //MicBoost := GetArrayIndex(IMicBoost, IniFile.ReadString('Record', 'MicBoost', 'Off'));
+ MicBoost := GetArrayIndex(IMicBoost, IniFile.ReadString('Record', 'MicBoost', 'Off'));
// Threshold
- // ThresholdIndex := GetArrayIndex(IThreshold, IniFile.ReadString('Record', 'Threshold', IThreshold[1]));
+ ThresholdIndex := GetArrayIndex(IThreshold, IniFile.ReadString('Record', 'Threshold', IThreshold[1]));
end;
procedure TIni.SaveInputDeviceCfg(IniFile: TIniFile);
var
- DeviceIndex: integer;
- ChannelIndex: integer;
+ DeviceIndex: integer;
+ ChannelIndex: integer;
begin
for DeviceIndex := 0 to High(InputDeviceConfig) do
begin
@@ -436,7 +437,7 @@ begin
InputDeviceConfig[DeviceIndex].Name);
IniFile.WriteInteger('Record', Format('Input[%d]', [DeviceIndex+1]),
InputDeviceConfig[DeviceIndex].Input);
-
+
// Channel-to-Player Mapping
for ChannelIndex := 0 to High(InputDeviceConfig[DeviceIndex].ChannelToPlayerMap) do
begin
@@ -447,15 +448,15 @@ begin
end;
// MicBoost
- //IniFile.WriteString('Record', 'MicBoost', IMicBoost[MicBoost]);
+ IniFile.WriteString('Record', 'MicBoost', IMicBoost[MicBoost]);
// Threshold
- //IniFile.WriteString('Record', 'Threshold', IThreshold[ThresholdIndex]);
+ IniFile.WriteString('Record', 'Threshold', IThreshold[ThresholdIndex]);
end;
procedure TIni.LoadPaths(IniFile: TCustomIniFile);
var
PathStrings: TStringList;
- I: integer;
+ I: integer;
begin
PathStrings := TStringList.Create;
IniFile.ReadSection('Directories', PathStrings);
@@ -513,7 +514,7 @@ begin
Theme := GetArrayIndex(ITheme, IniFile.ReadString('Themes', 'Theme', 'DELUXE'), true);
if (Theme = -1) then
- Theme := 0;
+ Theme := 0;
// Skin
Skin.onThemeChange;
@@ -535,25 +536,25 @@ procedure TIni.LoadScreenModes(IniFile: TCustomIniFile);
var
Modes: PPSDL_Rect;
- I: integer;
+ 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
+ else
Modes := SDL_ListModes(nil, SDL_OPENGL or SDL_RESIZABLE) ;
-
+
if (Modes = nil) then
begin
Log.LogStatus( 'No resolutions Found' , 'Video');
@@ -572,7 +573,7 @@ begin
IResolution[7] := '1440x900';
IResolution[8] := '1600x1200';
IResolution[9] := '1680x1050';
-
+
Resolution := GetArrayIndex(IResolution, IniFile.ReadString('Graphics', 'Resolution', '800x600'));
if Resolution = -1 then
begin
@@ -628,7 +629,7 @@ end;
procedure TIni.Load();
var
IniFile: TMemIniFile;
- I: integer;
+ I: integer;
begin
GamePath := Platform.GetGameUserPath;
@@ -655,24 +656,24 @@ begin
NameTeam[I] := IniFile.ReadString('NameTeam', 'T'+IntToStr(I+1), 'Team'+IntToStr(I+1));
for I := 0 to 11 do
NameTemplate[I] := IniFile.ReadString('NameTemplate', 'Name'+IntToStr(I+1), 'Template'+IntToStr(I+1));
-
+
// Players
Players := GetArrayIndex(IPlayers, IniFile.ReadString('Game', 'Players', IPlayers[0]));
-
+
// Difficulty
Difficulty := GetArrayIndex(IDifficulty, IniFile.ReadString('Game', 'Difficulty', 'Easy'));
-
+
// Language
Language := GetArrayIndex(ILanguage, IniFile.ReadString('Game', 'Language', 'English'));
//Language.ChangeLanguage(ILanguage[Language]);
-
+
// Tabs
Tabs := GetArrayIndex(ITabs, IniFile.ReadString('Game', 'Tabs', ITabs[0]));
- Tabs_at_startup := Tabs; //Tabs at Startup fix
-
+ TabsAtStartup := Tabs; //Tabs at Startup fix
+
// Song Sorting
Sorting := GetArrayIndex(ISorting, IniFile.ReadString('Game', 'Sorting', ISorting[0]));
-
+
// Debug
Debug := GetArrayIndex(IDebug, IniFile.ReadString('Game', 'Debug', IDebug[0]));
@@ -710,7 +711,7 @@ begin
//Preview Volume
PreviewVolume := GetArrayIndex(IPreviewVolume, IniFile.ReadString('Sound', 'PreviewVolume', IPreviewVolume[7]));
-
+
//Preview Fading
PreviewFading := GetArrayIndex(IPreviewFading, IniFile.ReadString('Sound', 'PreviewFading', IPreviewFading[1]));
@@ -778,13 +779,13 @@ begin
Joypad := GetArrayIndex(IJoypad, IniFile.ReadString('Controller', 'Joypad', IJoypad[0]));
LoadPaths(IniFile);
-
+
IniFile.Free;
end;
procedure TIni.Save;
var
- IniFile: TIniFile;
+ IniFile: TIniFile;
begin
if (FileExists(Filename) and FileIsReadOnly(Filename)) then
begin
@@ -859,7 +860,7 @@ begin
// Song Preview
IniFile.WriteString('Sound', 'PreviewVolume', IPreviewVolume[PreviewVolume]);
-
+
// PreviewFading
IniFile.WriteString('Sound', 'PreviewFading', IPreviewFading[PreviewFading]);
diff --git a/unicode/src/base/ULanguage.pas b/unicode/src/base/ULanguage.pas
index a89ded2d..f79f4165 100644
--- a/unicode/src/base/ULanguage.pas
+++ b/unicode/src/base/ULanguage.pas
@@ -78,7 +78,8 @@ uses
IniFiles,
Classes,
SysUtils,
- ULog;
+ ULog,
+ UPath;
{**
* LoadList, set default language, set standard implode glues
diff --git a/unicode/src/base/ULog.pas b/unicode/src/base/ULog.pas
index 582120bc..a872729a 100644
--- a/unicode/src/base/ULog.pas
+++ b/unicode/src/base/ULog.pas
@@ -132,7 +132,8 @@ uses
UMain,
UTime,
UCommon,
- UCommandLine;
+ UCommandLine,
+ UPath;
(*
* Write to console if in debug mode (Thread-safe).
diff --git a/unicode/src/base/UMain.pas b/unicode/src/base/UMain.pas
index ce25d16e..8d11b91d 100644
--- a/unicode/src/base/UMain.pas
+++ b/unicode/src/base/UMain.pas
@@ -35,109 +35,15 @@ interface
uses
SysUtils,
- Classes,
- SDL,
- UMusic,
- URecord,
- UTime,
- UDisplay,
- UIni,
- ULog,
- ULyrics,
- UScreenSing,
- USong,
- gl;
-
-type
- PPLayerNote = ^TPlayerNote;
- TPlayerNote = record
- Start: integer;
- Length: integer;
- Detect: real; // accurate place, detected in the note
- Tone: real;
- Perfect: boolean; // true if the note matches the original one, lit the star
- Hit: boolean; // true if the note Hits the Line
- end;
-
- PPLayer = ^TPlayer;
- TPlayer = record
- Name: string;
-
- // Index in Teaminfo record
- TeamID: Byte;
- PlayerID: Byte;
-
- // Scores
- Score: real;
- ScoreLine: real;
- ScoreGolden: real;
-
- ScoreInt: integer;
- ScoreLineInt: integer;
- ScoreGoldenInt: integer;
- ScoreTotalInt: integer;
-
- // LineBonus
- ScoreLast: Real;//Last Line Score
-
- // PerfectLineTwinkle (effect)
- LastSentencePerfect: Boolean;
-
- HighNote: integer; // index of last note (= High(Note)?)
- LengthNote: integer; // number of notes (= Length(Note)?).
- Note: array of TPlayerNote;
- end;
-
+ SDL;
var
- // Absolute Paths
- GamePath: string;
- SoundPath: string;
- SongPaths: TStringList;
- LogPath: string;
- ThemePath: string;
- SkinsPath: string;
- ScreenshotsPath: string;
- CoverPaths: TStringList;
- LanguagesPath: string;
- PluginPath: string;
- VisualsPath: string;
- FontPath: string;
- ResourcesPath: string;
- PlayListPath: string;
-
- Done: Boolean;
- // FIXME: ConversionFileName should not be global
- ConversionFileName: string;
- Restart: boolean;
-
- // player and music info
- Player: array of TPlayer;
- PlayersPlay: integer;
-
- CurrentSong : TSong;
-
-const
- MAX_SONG_SCORE = 10000; // max. achievable points per song
- MAX_SONG_LINE_BONUS = 1000; // max. achievable line bonus per song
-
-
-function FindPath(out PathResult: string; const RequestedPath: string; NeedsWritePermission: boolean): boolean;
-procedure InitializePaths;
-procedure AddSongPath(const Path: string);
+ Done: boolean;
+ Restart: boolean;
procedure Main;
procedure MainLoop;
procedure CheckEvents;
-procedure Sing(Screen: TScreenSing);
-procedure NewSentence(Screen: TScreenSing);
-procedure NewBeatClick(Screen: TScreenSing); // executed when on then new beat for click
-procedure NewBeatDetect(Screen: TScreenSing); // executed when on then new beat for detection
-procedure NewNote(Screen: TScreenSing); // detect note
-function GetMidBeat(Time: real): real;
-function GetTimeFromBeat(Beat: integer): real;
-procedure ClearScores(PlayerNum: integer);
-
type
TMainThreadExecProc = procedure(Data: Pointer);
@@ -155,48 +61,51 @@ const
*}
procedure MainThreadExec(Proc: TMainThreadExecProc; Data: Pointer);
-
implementation
uses
Math,
- StrUtils,
- USongs,
- UJoystick,
+ gl,
+{
+ SDL_ttf,
+ UParty,
+ UCore,
+}
+ UCatCovers,
UCommandLine,
- ULanguage,
- //SDL_ttf,
- USkins,
+ UCommon,
+ UConfig,
UCovers,
- UCatCovers,
UDataBase,
- UPlaylist,
+ UDisplay,
UDLLManager,
- UParty,
- UConfig,
- UCore,
- UCommon,
UGraphic,
UGraphicClasses,
- UPluginDefs,
+ UIni,
+ UJoystick,
+ ULanguage,
+ ULog,
+ UPath,
+ UPlaylist,
+ UMusic,
UPlatform,
- UThemes;
-
-
-
+ USkins,
+ USongs,
+ UThemes,
+ UTime;
procedure Main;
var
- WndTitle: string;
+ WindowTitle: string;
begin
{$IFNDEF Debug}
try
{$ENDIF}
- WndTitle := USDXVersionStr;
+ WindowTitle := USDXVersionStr;
Platform.Init;
- if Platform.TerminateIfAlreadyRunning(WndTitle) then
+ if Platform.TerminateIfAlreadyRunning(WindowTitle) then
Exit;
// fix floating-point exceptions (FPE)
@@ -210,11 +119,11 @@ begin
DecimalSeparator := '.';
//------------------------------
- //StartUp - Create Classes and Load Files
+ // StartUp - create classes and load files
//------------------------------
- // Initialize SDL
- // Without SDL_INIT_TIMER SDL_GetTicks() might return strange values
+ // initialize SDL
+ // without SDL_INIT_TIMER SDL_GetTicks() might return strange values
SDL_Init(SDL_INIT_VIDEO or SDL_INIT_TIMER);
SDL_EnableUnicode(1);
@@ -226,7 +135,7 @@ begin
// Log + Benchmark
Log := TLog.Create;
- Log.Title := WndTitle;
+ Log.Title := WindowTitle;
Log.FileOutputEnabled := not Params.NoLog;
Log.BenchmarkStart(0);
@@ -237,19 +146,19 @@ begin
Log.LogStatus('Load Language', 'Initialization');
Language := TLanguage.Create;
- // Add Const Values:
+ // add const values:
Language.AddConst('US_VERSION', USDXVersionStr);
Log.BenchmarkEnd(1);
Log.LogBenchmark('Loading Language', 1);
- {
+{
// SDL_ttf (Not used yet, maybe in version 1.5)
Log.BenchmarkStart(1);
Log.LogStatus('Initialize SDL_ttf', 'Initialization');
TTF_Init();
Log.BenchmarkEnd(1);
Log.LogBenchmark('Initializing SDL_ttf', 1);
- }
+}
// Skin
Log.BenchmarkStart(1);
@@ -264,7 +173,7 @@ begin
Ini := TIni.Create;
Ini.Load;
- //it's possible that this is the first run, create a .ini file if neccessary
+ // it is possible that this is the first run, create a .ini file if neccessary
Log.LogStatus('Write Ini', 'Initialization');
Ini.Save;
@@ -327,18 +236,19 @@ begin
Log.BenchmarkEnd(1);
Log.LogBenchmark('Loading PluginManager', 1);
- {// Party Mode Manager
+{
+ // Party Mode Manager
Log.BenchmarkStart(1);
Log.LogStatus('PartySession Manager', 'Initialization');
PartySession := TPartySession.Create; //Load PartySession
-
Log.BenchmarkEnd(1);
- Log.LogBenchmark('Loading PartySession Manager', 1); }
+ Log.LogBenchmark('Loading PartySession Manager', 1);
+}
// Graphics
Log.BenchmarkStart(1);
Log.LogStatus('Initialize 3D', 'Initialization');
- Initialize3D(WndTitle);
+ Initialize3D(WindowTitle);
Log.BenchmarkEnd(1);
Log.LogBenchmark('Initializing 3D', 1);
@@ -370,7 +280,7 @@ begin
Log.LogBenchmark('Loading Particle System', 1);
// Joypad
- if (Ini.Joypad = 1) OR (Params.Joypad) then
+ if (Ini.Joypad = 1) or (Params.Joypad) then
begin
Log.BenchmarkStart(1);
Log.LogStatus('Initialize Joystick', 'Initialization');
@@ -383,19 +293,21 @@ begin
Log.LogBenchmark('Loading Time', 0);
Log.LogStatus('Creating Core', 'Initialization');
- {Core := TCore.Create(
+{
+ Core := TCore.Create(
USDXShortVersionStr,
MakeVersion(USDX_VERSION_MAJOR,
USDX_VERSION_MINOR,
USDX_VERSION_RELEASE,
chr(0))
- ); }
+ );
+}
Log.LogStatus('Running Core', 'Initialization');
//Core.Run;
//------------------------------
- //Start- Mainloop
+ // Start Mainloop
//------------------------------
Log.LogStatus('Main Loop', 'Initialization');
MainLoop;
@@ -404,12 +316,12 @@ begin
finally
{$ENDIF}
//------------------------------
- //Finish Application
+ // Finish Application
//------------------------------
// TODO:
// call an uninitialize routine for every initialize step
- // or at least use the corresponding Free-Methods
+ // or at least use the corresponding Free methods
FinalizeMedia();
@@ -428,7 +340,7 @@ end;
procedure MainLoop;
var
- Delay: integer;
+ Delay: integer;
const
MAX_FPS = 100;
begin
@@ -445,7 +357,7 @@ begin
CheckEvents;
// display
- done := not Display.Draw;
+ Done := not Display.Draw;
SwapBuffers;
// delay
@@ -466,7 +378,7 @@ begin
end;
end;
-End;
+end;
procedure CheckEvents;
var
@@ -474,7 +386,7 @@ var
begin
if Assigned(Display.NextScreen) then
Exit;
-
+
while (SDL_PollEvent(@Event) <> 0) do
begin
case Event.type_ of
@@ -482,19 +394,19 @@ begin
begin
Display.Fade := 0;
Display.NextScreenWithCheck := nil;
- Display.CheckOK := True;
+ Display.CheckOK := true;
end;
SDL_MOUSEBUTTONDOWN:
begin
- {
+{
with Event.button do
begin
- if State = SDL_BUTTON_LEFT Then
+ if State = SDL_BUTTON_LEFT then
begin
//
end;
end;
- }
+}
end;
SDL_VIDEORESIZE:
begin
@@ -503,7 +415,7 @@ begin
// Note: do NOT call SDL_SetVideoMode on Windows and MacOSX here.
// This would create a new OpenGL render-context and all texture data
// would be invalidated.
- // On Linux the mode MUST be resetted, otherwise graphics will be corrupted.
+ // On Linux the mode MUST be reset, otherwise graphics will be corrupted.
{$IF Defined(Linux) or Defined(FreeBSD)}
if boolean( Ini.FullScreen ) then
SDL_SetVideoMode(ScreenW, ScreenH, (Ini.Depth+1) * 16, SDL_OPENGL or SDL_FULLSCREEN)
@@ -525,7 +437,7 @@ begin
// FIXME: SDL_SetVideoMode creates a new OpenGL RC so we have to
// reload all texture data (-> whitescreen bug).
- // Only Linux (and FreeBSD) is able to handle screen-switching this way.
+ // Only Linux and FreeBSD are able to handle screen-switching this way.
{$IF Defined(Linux) or Defined(FreeBSD)}
if boolean( Ini.FullScreen ) then
begin
@@ -547,16 +459,16 @@ begin
// if there is a visible popup then let it handle input instead of underlying screen
// shoud be done in a way to be sure the topmost popup has preference (maybe error, then check)
else if (ScreenPopupError <> nil) and (ScreenPopupError.Visible) then
- done := not ScreenPopupError.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, True)
+ Done := not ScreenPopupError.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, true)
else if (ScreenPopupCheck <> nil) and (ScreenPopupCheck.Visible) then
- done := not ScreenPopupCheck.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, True)
+ Done := not ScreenPopupCheck.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, true)
else
begin
// check if screen wants to exit
- done := not Display.CurrentScreen^.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, True);
+ Done := not Display.CurrentScreen^.ParseInput(Event.key.keysym.sym, Event.key.keysym.unicode, true);
// if screen wants to exit
- if done then
+ if Done then
begin
// if question option is enabled then show exit popup
if (Ini.AskbeforeDel = 1) then
@@ -567,7 +479,7 @@ begin
begin
Display.Fade := 0;
Display.NextScreenWithCheck := nil;
- Display.CheckOK := True;
+ Display.CheckOK := true;
end;
end;
@@ -604,573 +516,4 @@ begin
SDL_PushEvent(@Event);
end;
-function GetTimeForBeats(BPM, Beats: real): real;
-begin
- Result := 60 / BPM * Beats;
-end;
-
-function GetBeats(BPM, msTime: real): real;
-begin
- Result := BPM * msTime / 60;
-end;
-
-procedure GetMidBeatSub(BPMNum: integer; var Time: real; var CurBeat: real);
-var
- NewTime: real;
-begin
- if High(CurrentSong.BPM) = BPMNum then
- begin
- // last BPM
- CurBeat := CurrentSong.BPM[BPMNum].StartBeat + GetBeats(CurrentSong.BPM[BPMNum].BPM, Time);
- Time := 0;
- end
- else
- begin
- // not last BPM
- // count how much time is it for start of the new BPM and store it in NewTime
- NewTime := GetTimeForBeats(CurrentSong.BPM[BPMNum].BPM, CurrentSong.BPM[BPMNum+1].StartBeat - CurrentSong.BPM[BPMNum].StartBeat);
-
- // compare it to remaining time
- if (Time - NewTime) > 0 then
- begin
- // there is still remaining time
- CurBeat := CurrentSong.BPM[BPMNum].StartBeat;
- Time := Time - NewTime;
- end
- else
- begin
- // there is no remaining time
- CurBeat := CurrentSong.BPM[BPMNum].StartBeat + GetBeats(CurrentSong.BPM[BPMNum].BPM, Time);
- Time := 0;
- end; // if
- end; // if
-end;
-
-function GetMidBeat(Time: real): real;
-var
- CurBeat: real;
- CurBPM: integer;
-begin
- // static BPM
- if Length(CurrentSong.BPM) = 1 then
- begin
- Result := Time * CurrentSong.BPM[0].BPM / 60;
- end
- // variable BPM
- else if Length(CurrentSong.BPM) > 1 then
- begin
- CurBeat := 0;
- CurBPM := 0;
- while (Time > 0) do
- begin
- GetMidBeatSub(CurBPM, Time, CurBeat);
- Inc(CurBPM);
- end;
-
- Result := CurBeat;
- end
- // invalid BPM
- else
- begin
- Result := 0;
- end;
-end;
-
-function GetTimeFromBeat(Beat: integer): real;
-var
- CurBPM: integer;
-begin
- // static BPM
- if Length(CurrentSong.BPM) = 1 then
- begin
- Result := CurrentSong.GAP / 1000 + Beat * 60 / CurrentSong.BPM[0].BPM;
- end
- // variable BPM
- else if Length(CurrentSong.BPM) > 1 then
- begin
- Result := CurrentSong.GAP / 1000;
- CurBPM := 0;
- while (CurBPM <= High(CurrentSong.BPM)) and
- (Beat > CurrentSong.BPM[CurBPM].StartBeat) do
- begin
- if (CurBPM < High(CurrentSong.BPM)) and
- (Beat >= CurrentSong.BPM[CurBPM+1].StartBeat) then
- begin
- // full range
- Result := Result + (60 / CurrentSong.BPM[CurBPM].BPM) *
- (CurrentSong.BPM[CurBPM+1].StartBeat - CurrentSong.BPM[CurBPM].StartBeat);
- end;
-
- if (CurBPM = High(CurrentSong.BPM)) or
- (Beat < CurrentSong.BPM[CurBPM+1].StartBeat) then
- begin
- // in the middle
- Result := Result + (60 / CurrentSong.BPM[CurBPM].BPM) *
- (Beat - CurrentSong.BPM[CurBPM].StartBeat);
- end;
- Inc(CurBPM);
- end;
-
- {
- while (Time > 0) do
- begin
- GetMidBeatSub(CurBPM, Time, CurBeat);
- Inc(CurBPM);
- end;
- }
- end
- // invalid BPM
- else
- begin
- Result := 0;
- end;
-end;
-
-procedure Sing(Screen: TScreenSing);
-var
- Count: integer;
- CountGr: integer;
- CP: integer;
- N: integer;
-begin
- LyricsState.UpdateBeats();
-
- // sentences routines
- for CountGr := 0 to 0 do //High(Lines)
- begin;
- CP := CountGr;
- // old parts
- LyricsState.OldLine := Lines[CP].Current;
-
- // choose current parts
- for Count := 0 to Lines[CP].High do
- begin
- if LyricsState.CurrentBeat >= Lines[CP].Line[Count].Start then
- Lines[CP].Current := Count;
- end;
-
- // clean player note if there is a new line
- // (optimization on halfbeat time)
- if Lines[CP].Current <> LyricsState.OldLine then
- NewSentence(Screen);
-
- end; // for CountGr
-
- // make some operations on clicks
- if {(LyricsState.CurrentBeatC >= 0) and }(LyricsState.OldBeatC <> LyricsState.CurrentBeatC) then
- NewBeatClick(Screen);
-
- // make some operations when detecting new voice pitch
- if (LyricsState.CurrentBeatD >= 0) and (LyricsState.OldBeatD <> LyricsState.CurrentBeatD) then
- NewBeatDetect(Screen);
-end;
-
-procedure NewSentence(Screen: TScreenSing);
-var
- i: Integer;
-begin
- // clean note of player
- for i := 0 to High(Player) do
- begin
- Player[i].LengthNote := 0;
- Player[i].HighNote := -1;
- SetLength(Player[i].Note, 0);
- end;
-
- // on sentence change...
- Screen.onSentenceChange(Lines[0].Current);
-end;
-
-procedure NewBeatClick;
-var
- Count: integer;
-begin
- // beat click
- if ((Ini.BeatClick = 1) and
- ((LyricsState.CurrentBeatC + Lines[0].Resolution + Lines[0].NotesGAP) mod Lines[0].Resolution = 0)) then
- begin
- AudioPlayback.PlaySound(SoundLib.Click);
- end;
-
- for Count := 0 to Lines[0].Line[Lines[0].Current].HighNote do
- begin
- if (Lines[0].Line[Lines[0].Current].Note[Count].Start = LyricsState.CurrentBeatC) then
- begin
- // click assist
- if Ini.ClickAssist = 1 then
- AudioPlayback.PlaySound(SoundLib.Click);
-
- // drum machine
- (*
- TempBeat := LyricsState.CurrentBeat;// + 2;
- if (TempBeat mod 8 = 0) then Music.PlayDrum;
- if (TempBeat mod 8 = 4) then Music.PlayClap;
- //if (TempBeat mod 4 = 2) then Music.PlayHihat;
- if (TempBeat mod 4 <> 0) then Music.PlayHihat;
- *)
- end;
- end;
-end;
-
-procedure NewBeatDetect(Screen: TScreenSing);
-begin
- NewNote(Screen);
-end;
-
-procedure NewNote(Screen: TScreenSing);
-var
- LineFragmentIndex: integer;
- CurrentLineFragment: PLineFragment;
- PlayerIndex: integer;
- CurrentSound: TCaptureBuffer;
- CurrentPlayer: PPlayer;
- LastPlayerNote: PPlayerNote;
- Line: PLine;
- SentenceIndex: integer;
- SentenceMin: integer;
- SentenceMax: integer;
- SentenceDetected: integer; // sentence of detected note
- NoteAvailable: boolean;
- NewNote: boolean;
- Range: integer;
- NoteHit: boolean;
- MaxSongPoints: integer; // max. points for the song (without line bonus)
- MaxLinePoints: Real; // max. points for the current line
-begin
- // TODO: add duet mode support
- // use Lines[LineSetIndex] with LineSetIndex depending on the current player
-
- // count min and max sentence range for checking (detection is delayed to the notes we see on the screen)
- SentenceMin := Lines[0].Current-1;
- if (SentenceMin < 0) then
- SentenceMin := 0;
- SentenceMax := Lines[0].Current;
-
- // check for an active note at the current time defined in the lyrics
- NoteAvailable := false;
- SentenceDetected := SentenceMin;
- for SentenceIndex := SentenceMin to SentenceMax do
- begin
- Line := @Lines[0].Line[SentenceIndex];
- for LineFragmentIndex := 0 to Line.HighNote do
- begin
- CurrentLineFragment := @Line.Note[LineFragmentIndex];
- // check if line is active
- if ((CurrentLineFragment.Start <= LyricsState.CurrentBeatD) and
- (CurrentLineFragment.Start + CurrentLineFragment.Length-1 >= LyricsState.CurrentBeatD)) and
- (CurrentLineFragment.NoteType <> ntFreestyle) and // but ignore FreeStyle notes
- (CurrentLineFragment.Length > 0) then // and make sure the note lengths is at least 1
- begin
- SentenceDetected := SentenceIndex;
- NoteAvailable := true;
- Break;
- end;
- end;
- // TODO: break here, if NoteAvailable is true? We would then use the first instead
- // of the last note matching the current beat if notes overlap. But notes
- // should not overlap at all.
- //if (NoteAvailable) then
- // Break;
- end;
-
- // analyze player signals
- for PlayerIndex := 0 to PlayersPlay-1 do
- begin
- CurrentPlayer := @Player[PlayerIndex];
- CurrentSound := AudioInputProcessor.Sound[PlayerIndex];
-
- // 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?
- CurrentSound.Tone := CurrentLineFragment.Tone;
-
- // half size notes patch
- NoteHit := true;
-
- if (Ini.LineBonus > 0) then
- MaxSongPoints := MAX_SONG_SCORE - MAX_SONG_LINE_BONUS
- else
- MaxSongPoints := MAX_SONG_SCORE;
-
- // Note: ScoreValue is the sum of all note values of the song
- MaxLinePoints := MaxSongPoints / Lines[0].ScoreValue;
-
- // FIXME: is this correct? Why do we add the points for a whole line
- // if just one note is correct?
- case CurrentLineFragment.NoteType of
- ntNormal: CurrentPlayer.Score := CurrentPlayer.Score + MaxLinePoints;
- ntGolden: CurrentPlayer.ScoreGolden := CurrentPlayer.ScoreGolden + MaxLinePoints;
- end;
-
- CurrentPlayer.ScoreInt := Floor(CurrentPlayer.Score / 10) * 10;
- CurrentPlayer.ScoreGoldenInt := Floor(CurrentPlayer.ScoreGolden / 10) * 10;
-
- CurrentPlayer.ScoreTotalInt := CurrentPlayer.ScoreInt +
- CurrentPlayer.ScoreGoldenInt +
- CurrentPlayer.ScoreLineInt;
- end;
-
- end; // operation
- end; // for
-
- // check if we have to add a new note or extend the note's length
- if (SentenceDetected = SentenceMax) then
- begin
- // we will add a new note
- NewNote := true;
-
- // if previous note (if any) was the same, extend prrevious 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 lit the star (on Draw)
- for LineFragmentIndex := 0 to Line.HighNote do
- begin
- CurrentLineFragment := @Line.Note[LineFragmentIndex];
- if (CurrentLineFragment.Start = LastPlayerNote.Start) and
- (CurrentLineFragment.Length = LastPlayerNote.Length) and
- (CurrentLineFragment.Tone = LastPlayerNote.Tone) then
- begin
- LastPlayerNote.Perfect := true;
- end;
- end;
- end; // if SentenceDetected = SentenceMax
-
- end; // if Detected
- end; // for PlayerIndex
-
- //Log.LogStatus('EndBeat', 'NewBeat');
-
- // on sentence end -> for LineBonus and display of SingBar (rating pop-up)
- if (SentenceDetected >= Low(Lines[0].Line)) and
- (SentenceDetected <= High(Lines[0].Line)) then
- begin
- Line := @Lines[0].Line[SentenceDetected];
- CurrentLineFragment := @Line.Note[Line.HighNote];
- if ((CurrentLineFragment.Start + CurrentLineFragment.Length - 1) = LyricsState.CurrentBeatD) then
- begin
- if assigned(Screen) then
- Screen.OnSentenceEnd(SentenceDetected);
- end;
- end;
-
-end;
-
-procedure ClearScores(PlayerNum: integer);
-begin
- with Player[PlayerNum] do
- begin
- Score := 0;
- ScoreLine := 0;
- ScoreGolden := 0;
-
- ScoreInt := 0;
- ScoreLineInt := 0;
- ScoreGoldenInt:= 0;
- ScoreTotalInt := 0;
-
- ScoreLast := 0;
-
- LastSentencePerfect := False;
- end;
-end;
-
-procedure AddSpecialPath(var PathList: TStringList; const Path: string);
-var
- I: integer;
- PathAbs, OldPathAbs: string;
-begin
- if (PathList = nil) then
- PathList := TStringList.Create;
-
- if (Path = '') or not ForceDirectories(Path) then
- Exit;
-
- PathAbs := IncludeTrailingPathDelimiter(ExpandFileName(Path));
-
- // check if path or a part of the path was already added
- for I := 0 to PathList.Count-1 do
- begin
- OldPathAbs := IncludeTrailingPathDelimiter(ExpandFileName(PathList[I]));
- // check if the new directory is a sub-directory of a previously added one.
- // This is also true, if both paths point to the same directories.
- if (AnsiStartsText(OldPathAbs, PathAbs)) then
- begin
- // ignore the new path
- Exit;
- end;
-
- // check if a previously added directory is a sub-directory of the new one.
- if (AnsiStartsText(PathAbs, OldPathAbs)) then
- begin
- // replace the old with the new one.
- PathList[I] := PathAbs;
- Exit;
- end;
- end;
-
- PathList.Add(PathAbs);
-end;
-
-procedure AddSongPath(const Path: string);
-begin
- AddSpecialPath(SongPaths, Path);
-end;
-
-procedure AddCoverPath(const Path: string);
-begin
- AddSpecialPath(CoverPaths, Path);
-end;
-
-(**
- * Initialize a path variable
- * After setting paths, make sure that paths exist
- *)
-function FindPath(out PathResult: string; const RequestedPath: string; NeedsWritePermission: boolean): boolean;
-begin
- Result := false;
-
- if (RequestedPath = '') then
- Exit;
-
- // Make sure the directory exists
- if (not ForceDirectories(RequestedPath)) then
- begin
- PathResult := '';
- Exit;
- end;
-
- PathResult := IncludeTrailingPathDelimiter(RequestedPath);
-
- if (NeedsWritePermission) and
- (FileIsReadOnly(RequestedPath)) then
- begin
- Exit;
- end;
-
- Result := true;
-end;
-
-(**
- * Function sets all absolute paths e.g. song path and makes sure the directorys exist
- *)
-procedure InitializePaths;
-begin
- // Log directory (must be writable)
- if (not FindPath(LogPath, Platform.GetLogPath, true)) then
- begin
- Log.FileOutputEnabled := false;
- Log.LogWarn('Log directory "'+ Platform.GetLogPath +'" not available', 'InitializePaths');
- end;
-
- FindPath(SoundPath, Platform.GetGameSharedPath + 'sounds', false);
- FindPath(ThemePath, Platform.GetGameSharedPath + 'themes', false);
- FindPath(SkinsPath, Platform.GetGameSharedPath + 'themes', false);
- FindPath(LanguagesPath, Platform.GetGameSharedPath + 'languages', false);
- FindPath(PluginPath, Platform.GetGameSharedPath + 'plugins', false);
- FindPath(VisualsPath, Platform.GetGameSharedPath + 'visuals', false);
- FindPath(FontPath, Platform.GetGameSharedPath + 'fonts', false);
- FindPath(ResourcesPath, Platform.GetGameSharedPath + 'resources', false);
-
- // Playlists are not shared as we need one directory to write too
- FindPath(PlaylistPath, Platform.GetGameUserPath + 'playlists', true);
-
- // Screenshot directory (must be writable)
- if (not FindPath(ScreenshotsPath, Platform.GetGameUserPath + 'screenshots', true)) then
- begin
- Log.LogWarn('Screenshot directory "'+ Platform.GetGameUserPath +'" not available', 'InitializePaths');
- end;
-
- // Add song paths
- AddSongPath(Params.SongPath);
- AddSongPath(Platform.GetGameSharedPath + 'songs');
- AddSongPath(Platform.GetGameUserPath + 'songs');
-
- // Add category cover paths
- AddCoverPath(Platform.GetGameSharedPath + 'covers');
- AddCoverPath(Platform.GetGameUserPath + 'covers');
-end;
-
end.
diff --git a/unicode/src/base/UMusic.pas b/unicode/src/base/UMusic.pas
index 70e8d63c..19c3b942 100644
--- a/unicode/src/base/UMusic.pas
+++ b/unicode/src/base/UMusic.pas
@@ -35,11 +35,21 @@ interface
uses
UTime,
+ SysUtils,
Classes;
type
TNoteType = (ntFreestyle, ntNormal, ntGolden);
+const
+ // ScoreFactor defines how a notehit of a specified notetype is
+ // measured in comparison to the other types
+ // 0 means this notetype is not rated at all
+ // 2 means a hit of this notetype will be rated w/ twice as much
+ // points as a hit of a notetype w/ ScoreFactor 1
+ ScoreFactor: array[TNoteType] of integer = (0, 1, 2);
+
+type
(**
* TLineFragment represents a fragment of a lyrics line.
* This is a text-fragment (e.g. a syllable) assigned to a note pitch,
@@ -63,7 +73,7 @@ type
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.
+ //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;
@@ -81,7 +91,7 @@ type
*)
TLines = record
Current: integer; // for drawing of current line
- High: integer; // (= High(Line)?)
+ High: integer; // = High(Line)!
Number: integer;
Resolution: integer;
NotesGAP: integer;
@@ -212,12 +222,12 @@ type
TSoundEffect = class
public
EngineData: Pointer; // can be used for engine-specific data
- procedure Callback(Buffer: PChar; BufSize: integer); virtual; abstract;
+ procedure Callback(Buffer: PByteArray; BufSize: integer); virtual; abstract;
end;
TVoiceRemoval = class(TSoundEffect)
public
- procedure Callback(Buffer: PChar; BufSize: integer); override;
+ procedure Callback(Buffer: PByteArray; BufSize: integer); override;
end;
type
@@ -262,7 +272,7 @@ type
function IsEOF(): boolean; virtual; abstract;
function IsError(): boolean; virtual; abstract;
public
- function ReadData(Buffer: PChar; BufferSize: integer): integer; virtual; abstract;
+ function ReadData(Buffer: PByteArray; BufferSize: integer): integer; virtual; abstract;
property EOF: boolean read IsEOF;
property Error: boolean read IsError;
@@ -292,7 +302,7 @@ type
function GetVolume(): single; virtual; abstract;
procedure SetVolume(Volume: single); virtual; abstract;
function Synchronize(BufferSize: integer; FormatInfo: TAudioFormatInfo): integer;
- procedure FillBufferWithFrame(Buffer: PChar; BufferSize: integer; Frame: PChar; FrameSize: integer);
+ procedure FillBufferWithFrame(Buffer: PByteArray; BufferSize: integer; Frame: PByteArray; FrameSize: integer);
public
(**
* Opens a SourceStream for playback.
@@ -335,7 +345,7 @@ type
function Open(ChannelMap: integer; FormatInfo: TAudioFormatInfo): boolean; virtual;
procedure Close(); override;
- procedure WriteData(Buffer: PChar; BufferSize: integer); virtual; abstract;
+ procedure WriteData(Buffer: PByteArray; BufferSize: integer); virtual; abstract;
function GetAudioFormatInfo(): TAudioFormatInfo; override;
function GetLength(): real; override;
@@ -468,7 +478,7 @@ type
* input-buffer bytes used.
* Returns the number of bytes written to the output-buffer or -1 if an error occured.
*)
- function Convert(InputBuffer: PChar; OutputBuffer: PChar; var InputSize: integer): integer; virtual; abstract;
+ function Convert(InputBuffer: PByteArray; OutputBuffer: PByteArray; var InputSize: integer): integer; virtual; abstract;
(**
* Destination/Source size ratio
@@ -561,13 +571,13 @@ procedure DumpMediaInterfaces();
implementation
uses
- sysutils,
math,
UIni,
- UMain,
+ UNote,
UCommandLine,
URecord,
- ULog;
+ ULog,
+ UPath;
var
DefaultVideoPlayback : IVideoPlayback;
@@ -942,7 +952,7 @@ end;
{ TVoiceRemoval }
-procedure TVoiceRemoval.Callback(Buffer: PChar; BufSize: integer);
+procedure TVoiceRemoval.Callback(Buffer: PByteArray; BufSize: integer);
var
FrameIndex, FrameSize: integer;
Value: integer;
@@ -1180,7 +1190,7 @@ end;
(*
* Fills a buffer with copies of the given frame or with 0 if frame.
*)
-procedure TAudioPlaybackStream.FillBufferWithFrame(Buffer: PChar; BufferSize: integer; Frame: PChar; FrameSize: integer);
+procedure TAudioPlaybackStream.FillBufferWithFrame(Buffer: PByteArray; BufferSize: integer; Frame: PByteArray; FrameSize: integer);
var
i: integer;
FrameCopyCount: integer;
diff --git a/unicode/src/base/UNote.pas b/unicode/src/base/UNote.pas
new file mode 100644
index 00000000..5e70bfe1
--- /dev/null
+++ b/unicode/src/base/UNote.pas
@@ -0,0 +1,593 @@
+{* UltraStar Deluxe - Karaoke Game
+ *
+ * UltraStar Deluxe is the legal property of its developers, whose names
+ * are too numerous to list here. Please refer to the COPYRIGHT
+ * file distributed with this source distribution.
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; see the file COPYING. If not, write to
+ * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+ * Boston, MA 02110-1301, USA.
+ *
+ * $URL: https://ultrastardx.svn.sourceforge.net/svnroot/ultrastardx/trunk/src/base/UNote.pas $
+ * $Id: UNote.pas 1626 2009-03-07 19:53:00Z k-m_schindler $
+ *}
+
+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: string;
+
+ // Index in Teaminfo record
+ TeamID: byte;
+ PlayerID: byte;
+
+ // Scores
+ Score: real;
+ ScoreLine: real;
+ ScoreGolden: real;
+
+ ScoreInt: integer;
+ ScoreLineInt: integer;
+ ScoreGoldenInt: integer;
+ ScoreTotalInt: integer;
+
+ // LineBonus
+ ScoreLast: real; // Last Line Score
+
+ // PerfectLineTwinkle (effect)
+ LastSentencePerfect: boolean;
+
+ HighNote: integer; // index of last note (= High(Note)?)
+ LengthNote: integer; // number of notes (= Length(Note)?).
+ Note: array of TPlayerNote;
+ end;
+
+var
+
+ // player and music info
+ Player: array of TPlayer;
+ PlayersPlay: integer;
+
+ CurrentSong: TSong;
+
+const
+ MAX_SONG_SCORE = 10000; // max. achievable points per song
+ MAX_SONG_LINE_BONUS = 1000; // max. achievable line bonus per song
+
+procedure Sing(Screen: TScreenSing);
+procedure NewSentence(Screen: TScreenSing);
+procedure NewBeatClick(Screen: TScreenSing); // executed when on then new beat for click
+procedure NewBeatDetect(Screen: TScreenSing); // executed when on then new beat for detection
+procedure NewNote(Screen: TScreenSing); // detect note
+function GetMidBeat(Time: real): real;
+function GetTimeFromBeat(Beat: integer): real;
+
+implementation
+
+uses
+ Math,
+ StrUtils,
+ USongs,
+ UJoystick,
+ UCommandLine,
+ ULanguage,
+ //SDL_ttf,
+ USkins,
+ UCovers,
+ UCatCovers,
+ UDataBase,
+ UPlaylist,
+ UDLLManager,
+ UParty,
+ UConfig,
+ UCore,
+ UCommon,
+ UGraphic,
+ UGraphicClasses,
+ UPath,
+ UPluginDefs,
+ UPlatform,
+ UThemes;
+
+function GetTimeForBeats(BPM, Beats: real): real;
+begin
+ Result := 60 / BPM * Beats;
+end;
+
+function GetBeats(BPM, msTime: real): real;
+begin
+ Result := BPM * msTime / 60;
+end;
+
+procedure GetMidBeatSub(BPMNum: integer; var Time: real; var CurBeat: real);
+var
+ NewTime: real;
+begin
+ if High(CurrentSong.BPM) = BPMNum then
+ begin
+ // last BPM
+ CurBeat := CurrentSong.BPM[BPMNum].StartBeat + GetBeats(CurrentSong.BPM[BPMNum].BPM, Time);
+ Time := 0;
+ end
+ else
+ begin
+ // not last BPM
+ // count how much time is it for start of the new BPM and store it in NewTime
+ NewTime := GetTimeForBeats(CurrentSong.BPM[BPMNum].BPM, CurrentSong.BPM[BPMNum+1].StartBeat - CurrentSong.BPM[BPMNum].StartBeat);
+
+ // compare it to remaining time
+ if (Time - NewTime) > 0 then
+ begin
+ // there is still remaining time
+ CurBeat := CurrentSong.BPM[BPMNum].StartBeat;
+ Time := Time - NewTime;
+ end
+ else
+ begin
+ // there is no remaining time
+ CurBeat := CurrentSong.BPM[BPMNum].StartBeat + GetBeats(CurrentSong.BPM[BPMNum].BPM, Time);
+ Time := 0;
+ end; // if
+ end; // if
+end;
+
+function GetMidBeat(Time: real): real;
+var
+ CurBeat: real;
+ CurBPM: integer;
+begin
+ // static BPM
+ if Length(CurrentSong.BPM) = 1 then
+ begin
+ Result := Time * CurrentSong.BPM[0].BPM / 60;
+ end
+ // variable BPM
+ else if Length(CurrentSong.BPM) > 1 then
+ begin
+ CurBeat := 0;
+ CurBPM := 0;
+ while (Time > 0) do
+ begin
+ GetMidBeatSub(CurBPM, Time, CurBeat);
+ Inc(CurBPM);
+ end;
+
+ Result := CurBeat;
+ end
+ // invalid BPM
+ else
+ begin
+ Result := 0;
+ end;
+end;
+
+function GetTimeFromBeat(Beat: integer): real;
+var
+ CurBPM: integer;
+begin
+ // static BPM
+ if Length(CurrentSong.BPM) = 1 then
+ begin
+ Result := CurrentSong.GAP / 1000 + Beat * 60 / CurrentSong.BPM[0].BPM;
+ end
+ // variable BPM
+ else if Length(CurrentSong.BPM) > 1 then
+ begin
+ Result := CurrentSong.GAP / 1000;
+ CurBPM := 0;
+ while (CurBPM <= High(CurrentSong.BPM)) and
+ (Beat > CurrentSong.BPM[CurBPM].StartBeat) do
+ begin
+ if (CurBPM < High(CurrentSong.BPM)) and
+ (Beat >= CurrentSong.BPM[CurBPM+1].StartBeat) then
+ begin
+ // full range
+ Result := Result + (60 / CurrentSong.BPM[CurBPM].BPM) *
+ (CurrentSong.BPM[CurBPM+1].StartBeat - CurrentSong.BPM[CurBPM].StartBeat);
+ end;
+
+ if (CurBPM = High(CurrentSong.BPM)) or
+ (Beat < CurrentSong.BPM[CurBPM+1].StartBeat) then
+ begin
+ // in the middle
+ Result := Result + (60 / CurrentSong.BPM[CurBPM].BPM) *
+ (Beat - CurrentSong.BPM[CurBPM].StartBeat);
+ end;
+ Inc(CurBPM);
+ end;
+
+ {
+ while (Time > 0) do
+ begin
+ GetMidBeatSub(CurBPM, Time, CurBeat);
+ Inc(CurBPM);
+ end;
+ }
+ end
+ // invalid BPM
+ else
+ begin
+ Result := 0;
+ end;
+end;
+
+procedure Sing(Screen: TScreenSing);
+var
+ Count: integer;
+ CountGr: integer;
+ CP: integer;
+begin
+ LyricsState.UpdateBeats();
+
+ // sentences routines
+ for CountGr := 0 to 0 do //High(Lines)
+ begin;
+ CP := CountGr;
+ // old parts
+ LyricsState.OldLine := Lines[CP].Current;
+
+ // choose current parts
+ for Count := 0 to Lines[CP].High do
+ begin
+ if LyricsState.CurrentBeat >= Lines[CP].Line[Count].Start then
+ Lines[CP].Current := Count;
+ end;
+
+ // clean player note if there is a new line
+ // (optimization on halfbeat time)
+ if Lines[CP].Current <> LyricsState.OldLine then
+ NewSentence(Screen);
+
+ end; // for CountGr
+
+ // make some operations on clicks
+ if {(LyricsState.CurrentBeatC >= 0) and }(LyricsState.OldBeatC <> LyricsState.CurrentBeatC) then
+ NewBeatClick(Screen);
+
+ // make some operations when detecting new voice pitch
+ if (LyricsState.CurrentBeatD >= 0) and (LyricsState.OldBeatD <> LyricsState.CurrentBeatD) then
+ NewBeatDetect(Screen);
+end;
+
+procedure NewSentence(Screen: TScreenSing);
+var
+ i: integer;
+begin
+ // clean note of player
+ for i := 0 to High(Player) do
+ begin
+ Player[i].LengthNote := 0;
+ Player[i].HighNote := -1;
+ SetLength(Player[i].Note, 0);
+ end;
+
+ // on sentence change...
+ Screen.onSentenceChange(Lines[0].Current);
+end;
+
+procedure NewBeatClick;
+var
+ Count: integer;
+begin
+ // beat click
+ if ((Ini.BeatClick = 1) and
+ ((LyricsState.CurrentBeatC + Lines[0].Resolution + Lines[0].NotesGAP) mod Lines[0].Resolution = 0)) then
+ begin
+ AudioPlayback.PlaySound(SoundLib.Click);
+ end;
+
+ for Count := 0 to Lines[0].Line[Lines[0].Current].HighNote do
+ begin
+ if (Lines[0].Line[Lines[0].Current].Note[Count].Start = LyricsState.CurrentBeatC) then
+ begin
+ // click assist
+ if Ini.ClickAssist = 1 then
+ AudioPlayback.PlaySound(SoundLib.Click);
+
+ // drum machine
+ (*
+ TempBeat := LyricsState.CurrentBeat; // + 2;
+ if (TempBeat mod 8 = 0) then Music.PlayDrum;
+ if (TempBeat mod 8 = 4) then Music.PlayClap;
+ //if (TempBeat mod 4 = 2) then Music.PlayHihat;
+ if (TempBeat mod 4 <> 0) then Music.PlayHihat;
+ *)
+ end;
+ end;
+end;
+
+procedure NewBeatDetect(Screen: TScreenSing);
+begin
+ NewNote(Screen);
+end;
+
+procedure NewNote(Screen: TScreenSing);
+var
+ LineFragmentIndex: integer;
+ CurrentLineFragment: PLineFragment;
+ PlayerIndex: integer;
+ CurrentSound: TCaptureBuffer;
+ CurrentPlayer: PPlayer;
+ LastPlayerNote: PPlayerNote;
+ Line: PLine;
+ SentenceIndex: integer;
+ SentenceMin: integer;
+ SentenceMax: integer;
+ SentenceDetected: integer; // sentence of detected note
+ NoteAvailable: boolean;
+ NewNote: boolean;
+ Range: integer;
+ NoteHit: boolean;
+ MaxSongPoints: integer; // max. points for the song (without line bonus)
+ CurNotePoints: real; // Points for the cur. Note (PointsperNote * ScoreFactor[CurNote])
+begin
+ // TODO: add duet mode support
+ // use Lines[LineSetIndex] with LineSetIndex depending on the current player
+
+ // count min and max sentence range for checking
+ // (detection is delayed to the notes we see on the screen)
+ SentenceMin := Lines[0].Current-1;
+ if (SentenceMin < 0) then
+ SentenceMin := 0;
+ SentenceMax := Lines[0].Current;
+
+ // check for an active note at the current time defined in the lyrics
+ NoteAvailable := false;
+ SentenceDetected := SentenceMin;
+ for SentenceIndex := SentenceMin to SentenceMax do
+ begin
+ Line := @Lines[0].Line[SentenceIndex];
+ for LineFragmentIndex := 0 to Line.HighNote do
+ begin
+ CurrentLineFragment := @Line.Note[LineFragmentIndex];
+ // check if line is active
+ if ((CurrentLineFragment.Start <= LyricsState.CurrentBeatD) and
+ (CurrentLineFragment.Start + CurrentLineFragment.Length-1 >= LyricsState.CurrentBeatD)) and
+ (CurrentLineFragment.NoteType <> ntFreestyle) and // but ignore FreeStyle notes
+ (CurrentLineFragment.Length > 0) then // and make sure the note length is at least 1
+ begin
+ SentenceDetected := SentenceIndex;
+ NoteAvailable := true;
+ Break;
+ end;
+ end;
+ // TODO: break here, if NoteAvailable is true? We would then use the first instead
+ // of the last note matching the current beat if notes overlap. But notes
+ // should not overlap at all.
+ // if (NoteAvailable) then
+ // Break;
+ end;
+
+ // analyze player signals
+ for PlayerIndex := 0 to PlayersPlay-1 do
+ begin
+ CurrentPlayer := @Player[PlayerIndex];
+ CurrentSound := AudioInputProcessor.Sound[PlayerIndex];
+
+ // at the beginning of the song there is no previous note
+ if (Length(CurrentPlayer.Note) > 0) then
+ LastPlayerNote := @CurrentPlayer.Note[CurrentPlayer.HighNote]
+ else
+ LastPlayerNote := nil;
+
+ // analyze buffer
+ CurrentSound.AnalyzeBuffer;
+
+ // add some noise
+ // TODO: do we need this?
+ //LyricsState.Tone := LyricsState.Tone + Round(Random(3)) - 1;
+
+ // add note if possible
+ if (CurrentSound.ToneValid and NoteAvailable) then
+ begin
+ Line := @Lines[0].Line[SentenceDetected];
+
+ // process until last note
+ for LineFragmentIndex := 0 to Line.HighNote do
+ begin
+ CurrentLineFragment := @Line.Note[LineFragmentIndex];
+ if (CurrentLineFragment.Start <= LyricsState.OldBeatD+1) and
+ (CurrentLineFragment.Start + CurrentLineFragment.Length > LyricsState.OldBeatD+1) then
+ begin
+ // compare notes (from song-file and from player)
+
+ // move players tone to proper octave
+ while (CurrentSound.Tone - CurrentLineFragment.Tone > 6) do
+ CurrentSound.Tone := CurrentSound.Tone - 12;
+
+ while (CurrentSound.Tone - CurrentLineFragment.Tone < -6) do
+ CurrentSound.Tone := CurrentSound.Tone + 12;
+
+ // half size notes patch
+ NoteHit := false;
+
+ // if Ini.Difficulty = 0 then Range := 2;
+ // if Ini.Difficulty = 1 then Range := 1;
+ // if Ini.Difficulty = 2 then Range := 0;
+ Range := 2 - Ini.Difficulty;
+
+ // check if the player hit the correct tone within the tolerated range
+ if (Abs(CurrentLineFragment.Tone - CurrentSound.Tone) <= Range) then
+ begin
+ // adjust the players tone to the correct one
+ // TODO: do we need to do this?
+ // Philipp: I think we do, at least when we draw the notes.
+ // Otherwise the notehit thing would be shifted to the
+ // correct unhit note. I think this will look kind of strange.
+ CurrentSound.Tone := CurrentLineFragment.Tone;
+
+ // half size notes patch
+ NoteHit := true;
+
+ if (Ini.LineBonus > 0) then
+ MaxSongPoints := MAX_SONG_SCORE - MAX_SONG_LINE_BONUS
+ else
+ MaxSongPoints := MAX_SONG_SCORE;
+
+ // Note: ScoreValue is the sum of all note values of the song
+ // (MaxSongPoints / ScoreValue) is the points that a player
+ // gets for a hit of one beat of a normal note
+ // CurNotePoints is the amount of points that is meassured
+ // for a hit of the note per full beat
+ CurNotePoints := (MaxSongPoints / Lines[0].ScoreValue) * ScoreFactor[CurrentLineFragment.NoteType];
+
+ case CurrentLineFragment.NoteType of
+ ntNormal: CurrentPlayer.Score := CurrentPlayer.Score + CurNotePoints;
+ ntGolden: CurrentPlayer.ScoreGolden := CurrentPlayer.ScoreGolden + CurNotePoints;
+ end;
+
+ // a problem if we use floor instead of round is that a score of
+ // 10000 points is only possible if the last digit of the total points
+ // for golden and normal notes is 0.
+ // if we use round, the max score is 10000 for most songs
+ // but a score of 10010 is possible if the last digit of the total
+ // points for golden and normal notes is 5
+ // the best solution is to use round for one of these scores
+ // and round the other score in the opposite direction
+ // so we assure that the highest possible score is 10000 in every case.
+ CurrentPlayer.ScoreInt := round(CurrentPlayer.Score / 10) * 10;
+
+ if (CurrentPlayer.ScoreInt < CurrentPlayer.Score) then
+ //normal score is floored so we have to ceil golden notes score
+ CurrentPlayer.ScoreGoldenInt := ceil(CurrentPlayer.ScoreGolden / 10) * 10
+ else
+ //normal score is ceiled so we have to floor golden notes score
+ CurrentPlayer.ScoreGoldenInt := floor(CurrentPlayer.ScoreGolden / 10) * 10;
+
+
+ CurrentPlayer.ScoreTotalInt := CurrentPlayer.ScoreInt +
+ CurrentPlayer.ScoreGoldenInt +
+ CurrentPlayer.ScoreLineInt;
+ end;
+
+ end; // operation
+ end; // for
+
+ // check if we have to add a new note or extend the note's length
+ if (SentenceDetected = SentenceMax) then
+ begin
+ // we will add a new note
+ NewNote := true;
+
+ // if previous note (if any) was the same, extend previous note
+ if ((CurrentPlayer.LengthNote > 0) and
+ (LastPlayerNote <> nil) and
+ (LastPlayerNote.Tone = CurrentSound.Tone) and
+ ((LastPlayerNote.Start + LastPlayerNote.Length) = LyricsState.CurrentBeatD)) then
+ begin
+ NewNote := false;
+ end;
+
+ // if is not as new note to control
+ for LineFragmentIndex := 0 to Line.HighNote do
+ begin
+ if (Line.Note[LineFragmentIndex].Start = LyricsState.CurrentBeatD) then
+ NewNote := true;
+ end;
+
+ // add new note
+ if NewNote then
+ begin
+ // new note
+ Inc(CurrentPlayer.LengthNote);
+ Inc(CurrentPlayer.HighNote);
+ SetLength(CurrentPlayer.Note, CurrentPlayer.LengthNote);
+
+ // update player's last note
+ LastPlayerNote := @CurrentPlayer.Note[CurrentPlayer.HighNote];
+ with LastPlayerNote^ do
+ begin
+ Start := LyricsState.CurrentBeatD;
+ Length := 1;
+ Tone := CurrentSound.Tone; // Tone || ToneAbs
+ Detect := LyricsState.MidBeat;
+ Hit := NoteHit; // half note patch
+ end;
+ end
+ else
+ begin
+ // extend note length
+ if (LastPlayerNote <> nil) then
+ Inc(LastPlayerNote.Length);
+ end;
+
+ // check for perfect note and then light the star (on Draw)
+ for LineFragmentIndex := 0 to Line.HighNote do
+ begin
+ CurrentLineFragment := @Line.Note[LineFragmentIndex];
+ if (CurrentLineFragment.Start = LastPlayerNote.Start) and
+ (CurrentLineFragment.Length = LastPlayerNote.Length) and
+ (CurrentLineFragment.Tone = LastPlayerNote.Tone) then
+ begin
+ LastPlayerNote.Perfect := true;
+ end;
+ end;
+ end; // if SentenceDetected = SentenceMax
+
+ end; // if Detected
+ end; // for PlayerIndex
+
+ //Log.LogStatus('EndBeat', 'NewBeat');
+
+ // on sentence end -> for LineBonus and display of SingBar (rating pop-up)
+ if (SentenceDetected >= Low(Lines[0].Line)) and
+ (SentenceDetected <= High(Lines[0].Line)) then
+ begin
+ Line := @Lines[0].Line[SentenceDetected];
+ CurrentLineFragment := @Line.Note[Line.HighNote];
+ if ((CurrentLineFragment.Start + CurrentLineFragment.Length - 1) = LyricsState.CurrentBeatD) then
+ begin
+ if assigned(Screen) then
+ Screen.OnSentenceEnd(SentenceDetected);
+ end;
+ end;
+
+end;
+
+end.
diff --git a/unicode/src/base/UParty.pas b/unicode/src/base/UParty.pas
index 36ab33fb..937aab78 100644
--- a/unicode/src/base/UParty.pas
+++ b/unicode/src/base/UParty.pas
@@ -39,76 +39,82 @@ uses
UPluginDefs;
type
- ARounds = Array [0..252] of Integer; //0..252 needed for
+ ARounds = array [0..252] of integer; //0..252 needed for
PARounds = ^ARounds;
TRoundInfo = record
- Modi: Cardinal;
- Winner: Byte;
+ Modi: cardinal;
+ Winner: byte;
end;
TeamOrderEntry = record
- Teamnum: Byte;
- Score: Byte;
+ Teamnum: byte;
+ Score: byte;
end;
- TeamOrderArray = Array[0..5] of Byte;
+ TeamOrderArray = array[0..5] of byte;
TUS_ModiInfoEx = record
- Info: TUS_ModiInfo;
- Owner: Integer;
- TimesPlayed: Byte; //Helper for setting Round Plugins
+ Info: TUS_ModiInfo;
+ Owner: integer;
+ TimesPlayed: byte; //Helper for setting round plugins
end;
TPartySession = class (TCoreModule)
private
- bPartyMode: Boolean; //Is this Party or Singleplayer
- CurRound: Byte;
+ bPartyMode: boolean; //Is this party or single player
+ CurRound: byte;
- Modis: Array of TUS_ModiInfoEx;
+ Modis: array of TUS_ModiInfoEx;
Teams: TTeamInfo;
- function IsWinner(Player, Winner: Byte): boolean;
+ function IsWinner(Player, Winner: byte): boolean;
procedure GenScores;
- function GetRandomPlugin(TeamMode: Boolean): Cardinal;
- function GetRandomPlayer(Team: Byte): Byte;
+ function GetRandomPlugin(TeamMode: boolean): cardinal;
+ function GetRandomPlayer(Team: byte): byte;
public
//Teams: TTeamInfo;
Rounds: array of TRoundInfo;
//TCoreModule methods to inherit
- Constructor Create; override;
- Procedure Info(const pInfo: PModuleInfo); override;
- Function Load: Boolean; override;
- Function Init: Boolean; override;
- Procedure DeInit; override;
- Destructor Destroy; override;
+ constructor Create; override;
+ procedure Info(const pInfo: PModuleInfo); override;
+ function Load: boolean; override;
+ function Init: boolean; override;
+ procedure DeInit; override;
+ destructor Destroy; override;
- //Register Modi Service
- Function RegisterModi(nothin: TwParam; pModiInfo: TlParam): integer; //Registers a new Modi. wParam: Pointer to TUS_ModiInfo
+ //Register modus service
+ function RegisterModi(nothin: TwParam; pModiInfo: TlParam): integer; //Registers a new modus. wParam: Pointer to TUS_ModiInfo
//Start new Party
- Function StartParty(NumRounds: TwParam; PAofIRounds: TlParam): integer; //Starts new Party Mode. Returns Non Zero on Success
- Function GetCurModi(wParam: TwParam; lParam: TlParam): integer; //Returns Pointer to Cur. Modis TUS_ModiInfo (to Use with Singscreen)
- Function StopParty(wParam: TwParam; lParam: TlParam): integer; //Stops Party Mode. Returns 1 If Partymode was enabled before.
- Function NextRound(wParam: TwParam; lParam: TlParam): integer; //Increases CurRound by 1; Returns num of Round or -1 if last Round is already played
+ function StartParty(NumRounds: TwParam; PAofIRounds: TlParam): integer; //Starts new party mode. Returns non zero on success
+ function GetCurModi(wParam: TwParam; lParam: TlParam): integer; //Returns pointer to cur. Modis TUS_ModiInfo (to Use with Singscreen)
+ function StopParty(wParam: TwParam; lParam: TlParam): integer; //Stops party mode. Returns 1 if party mode was enabled before.
+ function NextRound(wParam: TwParam; lParam: TlParam): integer; //Increases curround by 1; Returns num of round or -1 if last round is already played
- Function CallModiInit(wParam: TwParam; lParam: TlParam): integer; //Calls CurModis Init Proc. If an Error occurs, Returns Nonzero. In this Case a New Plugin was Selected. Please renew Loading
- Function CallModiDeInit(wParam: TwParam; lParam: TlParam): integer; //Calls DeInitProc and does the RoundEnding
+ function CallModiInit(wParam: TwParam; lParam: TlParam): integer; //Calls curmodis init proc. If an error occurs, returns nonzero. In this case a new plugin was selected. Please renew loading
+ function CallModiDeInit(wParam: TwParam; lParam: TlParam): integer; //Calls DeInitProc and ends the round
- Function GetTeamInfo(wParam: TwParam; pTeamInfo: TlParam): integer; //Writes TTeamInfo Record to Pointer at lParam. Returns Zero on Success
- Function SetTeamInfo(wParam: TwParam; pTeamInfo: TlParam): integer; //Read TTeamInfo Record from Pointer at lParam. Returns Zero on Success
+ function GetTeamInfo(wParam: TwParam; pTeamInfo: TlParam): integer; //Writes TTeamInfo record to pointer at lParam. Returns zero on success
+ function SetTeamInfo(wParam: TwParam; pTeamInfo: TlParam): integer; //Read TTeamInfo record from pointer at lParam. Returns zero on success
- Function GetTeamOrder(wParam: TwParam; lParam: TlParam): integer; //Returns Team Order. Structure: Bits 1..3: Team at Place1; Bits 4..6: Team at Place2 ...
- Function GetWinnerString(wParam: TwParam; lParam: TlParam): integer; //wParam is Roundnum. If (Pointer = nil) then Return Length of the String. Otherwise Write the String to Address at lParam
+ function GetTeamOrder(wParam: TwParam; lParam: TlParam): integer; //Returns team order. Structure: Bits 1..3: Team at place1; Bits 4..6: Team at place2 ...
+ function GetWinnerString(wParam: TwParam; lParam: TlParam): integer; //wParam is roundnum. If (Pointer = nil) then return length of the string. Otherwise write the string to address at lParam
end;
const
- StandardModi = 0; //Modi ID that will be played in non party Mode
+ StandardModus = 0; //Modus ID that will be played in non-party mode
implementation
-uses UCore, UGraphic, UMain, ULanguage, ULog, SysUtils;
+uses
+ UCore,
+ UGraphic,
+ ULanguage,
+ ULog,
+ UNote,
+ SysUtils;
{*********************
TPluginLoader
@@ -116,85 +122,84 @@ uses UCore, UGraphic, UMain, ULanguage, ULog, SysUtils;
*********************}
//-------------
-// Function that gives some Infos about the Module to the Core
+// function that gives some infos about the module to the core
//-------------
-Procedure TPartySession.Info(const pInfo: PModuleInfo);
+procedure TPartySession.Info(const pInfo: PModuleInfo);
begin
pInfo^.Name := 'TPartySession';
pInfo^.Version := MakeVersion(1,0,0,chr(0));
- pInfo^.Description := 'Manages Party Modi and Party Game';
+ pInfo^.Description := 'Manages party modi and party game';
end;
//-------------
-// Just the Constructor
+// Just the constructor
//-------------
-Constructor TPartySession.Create;
+constructor TPartySession.Create;
begin
inherited;
//UnSet PartyMode
- bPartyMode := False;
+ bPartyMode := false;
end;
//-------------
-//Is Called on Loading.
-//In this Method only Events and Services should be created
-//to offer them to other Modules or Plugins during the Init process
-//If False is Returned this will cause a Forced Exit
+//Is called on loading.
+//In this method only events and services should be created
+//to offer them to other modules or plugins during the init process
+//If false is returned this will cause a forced exit
//-------------
-Function TPartySession.Load: Boolean;
+function TPartySession.Load: boolean;
begin
- //Add Register Party Modi Service
- Result := True;
+ //Add register party modus service
+ Result := true;
Core.Services.AddService('Party/RegisterModi', nil, Self.RegisterModi);
Core.Services.AddService('Party/StartParty', nil, Self.StartParty);
Core.Services.AddService('Party/GetCurModi', nil, Self.GetCurModi);
end;
//-------------
-//Is Called on Init Process
-//In this Method you can Hook some Events and Create + Init
-//your Classes, Variables etc.
-//If False is Returned this will cause a Forced Exit
+//Is called on init process
+//In this method you can hook some events and create + init
+//your classes, variables etc.
+//If false is returned this will cause a forced exit
//-------------
-Function TPartySession.Init: Boolean;
+function TPartySession.Init: boolean;
begin
- //Just set Prvate Var to true.
+ //Just set private var to true.
Result := true;
end;
//-------------
-//Is Called if this Module has been Inited and there is a Exit.
-//Deinit is in backwards Initing Order
+//Is called if this module has been inited and there is an exit.
+//Deinit is in reverse initing order
//-------------
-Procedure TPartySession.DeInit;
+procedure TPartySession.DeInit;
begin
//Force DeInit
-
end;
//-------------
-//Is Called if this Module will be unloaded and has been created
-//Should be used to Free Memory
+//Is called if this module will be unloaded and has been created
+//Should be used to free memory
//-------------
-Destructor TPartySession.Destroy;
+destructor TPartySession.Destroy;
begin
- //Just save some Memory if it wasn't done now..
+ //Just save some memory if it wasn't done now..
SetLength(Modis, 0);
inherited;
end;
//-------------
-// Registers a new Modi. wParam: Pointer to TUS_ModiInfo
-// Service for Plugins
+// Registers a new modus. wParam: Pointer to TUS_ModiInfo
+// Service for plugins
//-------------
-Function TPartySession.RegisterModi(nothin: TwParam; pModiInfo: TlParam): integer;
+function TPartySession.RegisterModi(nothin: TwParam; pModiInfo: TlParam): integer;
var
- Len: Integer;
+ Len: integer;
Info: PUS_ModiInfo;
begin
Info := PModiInfo;
//Copy Info if cbSize is correct
- If (Info.cbSize = SizeOf(TUS_ModiInfo)) then
+ if (Info.cbSize = SizeOf(TUS_ModiInfo)) then
begin
Len := Length(Modis);
SetLength(Modis, Len + 1);
@@ -202,49 +207,49 @@ begin
Modis[Len].Info := Info^;
end
else
- Core.ReportError(Integer(PChar('Plugins try to Register Modi with wrong Pointer, or wrong TUS_ModiInfo Record.')), PChar('TPartySession'));
+ Core.ReportError(integer(PChar('Plugins try to register modus with wrong pointer, or wrong TUS_ModiInfo record.')), PChar('TPartySession'));
// FIXME: return a valid result
Result := 0;
end;
//----------
-// Returns a Number of a Random Plugin
+// Returns a number of a random plugin
//----------
-Function TPartySession.GetRandomPlugin(TeamMode: Boolean): Cardinal;
+function TPartySession.GetRandomPlugin(TeamMode: boolean): cardinal;
var
- LowestTP: Byte;
- NumPwithLTP: Word;
- I: Integer;
- R: Word;
+ LowestTP: byte;
+ NumPwithLTP: word;
+ I: integer;
+ R: word;
begin
- Result := StandardModi; //If there are no matching Modis, Play StandardModi
- LowestTP := high(Byte);
+ Result := StandardModus; //If there are no matching modi, play standard modus
+ LowestTP := high(byte);
NumPwithLTP := 0;
//Search for Plugins not often played yet
- For I := 0 to high(Modis) do
+ for I := 0 to high(Modis) do
begin
- if (Modis[I].TimesPlayed < lowestTP) And (((Modis[I].Info.LoadingSettings AND MLS_TeamOnly) <> 0) = TeamMode) then
+ if (Modis[I].TimesPlayed < lowestTP) and (((Modis[I].Info.LoadingSettings and MLS_TeamOnly) <> 0) = TeamMode) then
begin
lowestTP := Modis[I].TimesPlayed;
NumPwithLTP := 1;
end
- else if (Modis[I].TimesPlayed = lowestTP) And (((Modis[I].Info.LoadingSettings AND MLS_TeamOnly) <> 0) = TeamMode) then
+ else if (Modis[I].TimesPlayed = lowestTP) and (((Modis[I].Info.LoadingSettings and MLS_TeamOnly) <> 0) = TeamMode) then
begin
Inc(NumPwithLTP);
end;
end;
- //Create Random No
+ //Create random no
R := Random(NumPwithLTP);
- //Search for Random Plugin
- For I := 0 to high(Modis) do
+ //Search for random plugin
+ for I := 0 to high(Modis) do
begin
- if (Modis[I].TimesPlayed = lowestTP) And (((Modis[I].Info.LoadingSettings AND MLS_TeamOnly) <> 0) = TeamMode) then
+ if (Modis[I].TimesPlayed = lowestTP) and (((Modis[I].Info.LoadingSettings and MLS_TeamOnly) <> 0) = TeamMode) then
begin
- //Plugin Found
+ //Plugin found
if (R = 0) then
begin
Result := I;
@@ -258,79 +263,79 @@ begin
end;
//----------
-// Starts new Party Mode. Returns Non Zero on Success
+// Starts new party mode. Returns non zero on success
//----------
-Function TPartySession.StartParty(NumRounds: TwParam; PAofIRounds: TlParam): integer;
+function TPartySession.StartParty(NumRounds: TwParam; PAofIRounds: TlParam): integer;
var
- I: Integer;
+ I: integer;
aiRounds: PARounds;
- TeamMode: Boolean;
+ TeamMode: boolean;
begin
Result := 0;
- If (Teams.NumTeams >= 1) AND (NumRounds < High(Byte)-1) then
+ if (Teams.NumTeams >= 1) and (NumRounds < High(byte)-1) then
begin
bPartyMode := false;
aiRounds := PAofIRounds;
- Try
- //Is this Teammode(More then one Player per Team) ?
- TeamMode := True;
- For I := 0 to Teams.NumTeams-1 do
- TeamMode := TeamMode AND (Teams.Teaminfo[I].NumPlayers > 1);
+ try
+ //Is this team mode (More than one player per team) ?
+ TeamMode := true;
+ for I := 0 to Teams.NumTeams-1 do
+ TeamMode := TeamMode and (Teams.Teaminfo[I].NumPlayers > 1);
//Set Rounds
SetLength(Rounds, NumRounds);
- For I := 0 to High(Rounds) do
- begin //Set Plugins
- If (aiRounds[I] = -1) then
+ for I := 0 to High(Rounds) do
+ begin //Set plugins
+ if (aiRounds[I] = -1) then
Rounds[I].Modi := GetRandomPlugin(TeamMode)
- Else If (aiRounds[I] >= 0) AND (aiRounds[I] <= High(Modis)) AND (TeamMode OR ((Modis[aiRounds[I]].Info.LoadingSettings AND MLS_TeamOnly) = 0)) then
+ else if (aiRounds[I] >= 0) and (aiRounds[I] <= High(Modis)) and (TeamMode or ((Modis[aiRounds[I]].Info.LoadingSettings and MLS_TeamOnly) = 0)) then
Rounds[I].Modi := aiRounds[I]
- Else
- Rounds[I].Modi := StandardModi;
+ else
+ Rounds[I].Modi := StandardModus;
- Rounds[I].Winner := High(Byte); //Set Winner to Not Played
+ Rounds[I].Winner := High(byte); //Set winner to not played
end;
- CurRound := High(Byte); //Set CurRound to not defined
+ CurRound := High(byte); //Set CurRound to not defined
- //Return teh true and Set PartyMode
- bPartyMode := True;
+ //Return true and set party mode
+ bPartyMode := true;
Result := 1;
- Except
- Core.ReportError(Integer(PChar('Can''t start PartyMode.')), PChar('TPartySession'));
+ except
+ Core.ReportError(integer(PChar('Can''t start party mode.')), PChar('TPartySession'));
end;
end;
end;
//----------
-// Returns Pointer to Cur. ModiInfoEx (to Use with Singscreen)
+// Returns pointer to Cur. ModiInfoEx (to use with sing screen)
//----------
-Function TPartySession.GetCurModi(wParam: TwParam; lParam: TlParam): integer;
+function TPartySession.GetCurModi(wParam: TwParam; lParam: TlParam): integer;
begin
- If (bPartyMode) AND (CurRound <= High(Rounds)) then
+ if (bPartyMode) and (CurRound <= High(Rounds)) then
begin //If PartyMode is enabled:
//Return the Plugin of the Cur Round
- Result := Integer(@Modis[Rounds[CurRound].Modi]);
+ Result := integer(@Modis[Rounds[CurRound].Modi]);
end
else
- begin //Return StandardModi
- Result := Integer(@Modis[StandardModi]);
+ begin //Return standard modus
+ Result := integer(@Modis[StandardModus]);
end;
end;
//----------
-// Stops Party Mode. Returns 1 If Partymode was enabled before. And -1 if Change was not possible
+// Stops party mode. Returns 1 if party mode was enabled before and -1 if change was not possible
//----------
-Function TPartySession.StopParty(wParam: TwParam; lParam: TlParam): integer;
+function TPartySession.StopParty(wParam: TwParam; lParam: TlParam): integer;
begin
Result := -1;
- If (bPartyMode) then
+ if (bPartyMode) then
begin
- // to-do : Whitü: Check here if SingScreen is not Shown atm.
- bPartyMode := False;
+ // to-do : Whitü: Check here if sing screen is not shown atm.
+ bPartyMode := false;
Result := 1;
end
else
@@ -338,59 +343,60 @@ begin
end;
//----------
-//GetRandomPlayer - Gives back a Random Player to Play next Round
+//GetRandomPlayer - gives back a random player to play next round
//----------
-function TPartySession.GetRandomPlayer(Team: Byte): Byte;
+function TPartySession.GetRandomPlayer(Team: byte): byte;
var
- I, R: Integer;
- lowestTP: Byte;
- NumPwithLTP: Byte;
+ I, R: integer;
+ lowestTP: byte;
+ NumPwithLTP: byte;
begin
- LowestTP := high(Byte);
- NumPwithLTP := 0;
- Result := 0;
+ LowestTP := high(byte);
+ NumPwithLTP := 0;
+ Result := 0;
- //Search for Players that have not often played yet
- For I := 0 to Teams.Teaminfo[Team].NumPlayers-1 do
+ //Search for players that have not often played yet
+ for I := 0 to Teams.Teaminfo[Team].NumPlayers-1 do
+ begin
+ if (Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed < lowestTP) then
begin
- if (Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed < lowestTP) then
- begin
- lowestTP := Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed;
- NumPwithLTP := 1;
- end
- else if (Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed = lowestTP) then
- begin
- Inc(NumPwithLTP);
- end;
+ lowestTP := Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed;
+ NumPwithLTP := 1;
+ end
+ else if (Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed = lowestTP) then
+ begin
+ Inc(NumPwithLTP);
end;
+ end;
- //Create Random No
- R := Random(NumPwithLTP);
+ //Create random no
+ R := Random(NumPwithLTP);
- //Search for Random Player
- For I := 0 to Teams.Teaminfo[Team].NumPlayers-1 do
+ //Search for random player
+ for I := 0 to Teams.Teaminfo[Team].NumPlayers-1 do
+ begin
+ if Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed = lowestTP then
begin
- if Teams.Teaminfo[Team].Playerinfo[I].TimesPlayed = lowestTP then
+ //Player found
+ if (R = 0) then
begin
- //Player Found
- if (R = 0) then
- begin
- Result := I;
- Break;
- end;
-
- Dec(R);
+ Result := I;
+ Break;
end;
+
+ Dec(R);
end;
+ end;
end;
//----------
-// NextRound - Increases CurRound by 1; Returns num of Round or -1 if last Round is already played
+// NextRound - Increases CurRound by 1; Returns num of round or -1 if last round is already played
//----------
-Function TPartySession.NextRound(wParam: TwParam; lParam: TlParam): integer;
-var I: Integer;
+function TPartySession.NextRound(wParam: TwParam; lParam: TlParam): integer;
+var
+ I: integer;
begin
- If ((CurRound < high(Rounds)) OR (CurRound = high(CurRound))) then
+ if ((CurRound < high(Rounds)) or (CurRound = high(CurRound))) then
begin //everythings OK! -> Start the Round, maaaaan
Inc(CurRound);
@@ -406,23 +412,23 @@ begin
end;
//----------
-//IsWinner - Returns True if the Players Bit is set in the Winner Byte
+//IsWinner - returns true if the players bit is set in the winner byte
//----------
-function TPartySession.IsWinner(Player, Winner: Byte): boolean;
+function TPartySession.IsWinner(Player, Winner: byte): boolean;
var
- Bit: Byte;
+ Bit: byte;
begin
Bit := 1 shl Player;
- Result := ((Winner AND Bit) = Bit);
+ Result := ((Winner and Bit) = Bit);
end;
//----------
-//GenScores - Inc Scores for Cur. Round
+//GenScores - inc scores for cur. round
//----------
procedure TPartySession.GenScores;
var
- I: Byte;
+ I: byte;
begin
for I := 0 to Teams.NumTeams-1 do
begin
@@ -432,86 +438,86 @@ begin
end;
//----------
-// CallModiInit - Calls CurModis Init Proc. If an Error occurs, Returns Nonzero. In this Case a New Plugin was Selected. Please renew Loading
+// CallModiInit - calls CurModis Init Proc. If an error occurs, returns nonzero. In this case a new plugin was selected. Please renew loading
//----------
-Function TPartySession.CallModiInit(wParam: TwParam; lParam: TlParam): integer;
+function TPartySession.CallModiInit(wParam: TwParam; lParam: TlParam): integer;
begin
- If (not bPartyMode) then
- begin //Set Rounds if not in PartyMode
+ if (not bPartyMode) then
+ begin //Set rounds if not in party mode
SetLength(Rounds, 1);
- Rounds[0].Modi := StandardModi;
- Rounds[0].Winner := High(Byte);
+ Rounds[0].Modi := StandardModus;
+ Rounds[0].Winner := High(byte);
CurRound := 0;
end;
- Try
+ try
//Core.
- Except
+ except
on E : Exception do
begin
- Core.ReportError(Integer(PChar('Error starting Modi: ' + Modis[Rounds[CurRound].Modi].Info.Name + ' ErrorStr: ' + E.Message)), PChar('TPartySession'));
- If (Rounds[CurRound].Modi = StandardModi) then
+ Core.ReportError(integer(PChar('Error starting modus: ' + Modis[Rounds[CurRound].Modi].Info.Name + ' ErrorStr: ' + E.Message)), PChar('TPartySession'));
+ if (Rounds[CurRound].Modi = StandardModus) then
begin
- Core.ReportError(Integer(PChar('Can''t start StandardModi, will exit now!')), PChar('TPartySession'));
+ Core.ReportError(integer(PChar('Can''t start standard modus, will exit now!')), PChar('TPartySession'));
Halt;
end
- Else //Select StandardModi
+ else //Select standard modus
begin
- Rounds[CurRound].Modi := StandardModi
+ Rounds[CurRound].Modi := StandardModus
end;
end;
- End;
+ end;
// FIXME: return a valid result
Result := 0;
end;
//----------
-// CallModiDeInit - Calls DeInitProc and does the RoundEnding
+// CallModiDeInit - calls DeInitProc and ends the round
//----------
-Function TPartySession.CallModiDeInit(wParam: TwParam; lParam: TlParam): integer;
+function TPartySession.CallModiDeInit(wParam: TwParam; lParam: TlParam): integer;
var
- I: Integer;
- MaxScore: Word;
+ I: integer;
+ MaxScore: word;
begin
- If (bPartyMode) then
+ if (bPartyMode) then
begin
//Get Winner Byte!
- if (@Modis[Rounds[CurRound].Modi].Info.ModiDeInit <> nil) then //get Winners from Plugin
+ if (@Modis[Rounds[CurRound].Modi].Info.ModiDeInit <> nil) then //get winners from plugin
Rounds[CurRound].Winner := Modis[Rounds[CurRound].Modi].Info.ModiDeInit(Modis[Rounds[CurRound].Modi].Info.ID)
else
- begin //Create winners by Score :/
+ begin //Create winners by score :/
Rounds[CurRound].Winner := 0;
MaxScore := 0;
for I := 0 to Teams.NumTeams-1 do
begin
- // to-do : recode Percentage stuff
+ // to-do : recode percentage stuff
//PlayerInfo.Playerinfo[I].Percentage := PlayerInfo.Playerinfo[I].Score div 9999;
if (Player[I].ScoreTotalInt > MaxScore) then
begin
MaxScore := Player[I].ScoreTotalInt;
Rounds[CurRound].Winner := 1 shl I;
end
- else if (Player[I].ScoreTotalInt = MaxScore) AND (Player[I].ScoreTotalInt <> 0) then
+ else if (Player[I].ScoreTotalInt = MaxScore) and (Player[I].ScoreTotalInt <> 0) then
begin
Rounds[CurRound].Winner := Rounds[CurRound].Winner or (1 shl I);
end;
end;
- //When nobody has Points -> Everybody loose
+ //When nobody has points -> everybody looses
if (MaxScore = 0) then
Rounds[CurRound].Winner := 0;
end;
- //Generate teh Scores
+ //Generate the scores
GenScores;
- //Inc Players TimesPlayed
- If ((Modis[Rounds[CurRound-1].Modi].Info.LoadingSettings AND MLS_IncTP) = MLS_IncTP) then
+ //Inc players TimesPlayed
+ if ((Modis[Rounds[CurRound-1].Modi].Info.LoadingSettings and MLS_IncTP) = MLS_IncTP) then
begin
- For I := 0 to Teams.NumTeams-1 do
+ for I := 0 to Teams.NumTeams-1 do
Inc(Teams.TeamInfo[I].Playerinfo[Teams.TeamInfo[I].CurPlayer].TimesPlayed);
end;
end
@@ -523,69 +529,70 @@ begin
end;
//----------
-// GetTeamInfo - Writes TTeamInfo Record to Pointer at lParam. Returns Zero on Success
+// GetTeamInfo - writes TTeamInfo record to pointer at lParam. Returns zero on success
//----------
-Function TPartySession.GetTeamInfo(wParam: TwParam; pTeamInfo: TlParam): integer;
-var Info: ^TTeamInfo;
+function TPartySession.GetTeamInfo(wParam: TwParam; pTeamInfo: TlParam): integer;
+var
+ Info: ^TTeamInfo;
begin
Result := -1;
Info := pTeamInfo;
- If (Info <> nil) then
+ if (Info <> nil) then
begin
- Try
+ try
// to - do : Check Delphi memory management in this case
//Not sure if i had to copy PChars to a new address or if delphi manages this o0
Info^ := Teams;
Result := 0;
- Except
+ except
Result := -2;
- End;
+ end;
end;
end;
//----------
-// SetTeamInfo - Read TTeamInfo Record from Pointer at lParam. Returns Zero on Success
+// SetTeamInfo - read TTeamInfo record from pointer at lParam. Returns zero on success
//----------
-Function TPartySession.SetTeamInfo(wParam: TwParam; pTeamInfo: TlParam): integer;
+function TPartySession.SetTeamInfo(wParam: TwParam; pTeamInfo: TlParam): integer;
var
TeamInfobackup: TTeamInfo;
Info: ^TTeamInfo;
begin
Result := -1;
Info := pTeamInfo;
- If (Info <> nil) then
+ if (Info <> nil) then
begin
- Try
+ try
TeamInfoBackup := Teams;
// to - do : Check Delphi memory management in this case
//Not sure if i had to copy PChars to a new address or if delphi manages this o0
Teams := Info^;
Result := 0;
- Except
+ except
Teams := TeamInfoBackup;
Result := -2;
- End;
+ end;
end;
end;
//----------
-// GetTeamOrder - Returns Team Order. Structure: Bits 1..3: Team at Place1; Bits 4..6: Team at Place2 ...
+// GetTeamOrder - returns team order. Structure: Bits 1..3: Team at place1; Bits 4..6: Team at place2 ...
//----------
-Function TPartySession.GetTeamOrder(wParam: TwParam; lParam: TlParam): integer;
+function TPartySession.GetTeamOrder(wParam: TwParam; lParam: TlParam): integer;
var
- I, J: Integer;
+ I, J: integer;
ATeams: array [0..5] of TeamOrderEntry;
TempTeam: TeamOrderEntry;
begin
- // to-do : PartyMode: Write this in another way, so that teams with the same scire get the same Placing
- //Fill Team Array
- For I := 0 to Teams.NumTeams-1 do
+ // to-do : PartyMode: Write this in another way, so that teams with the same score get the same place
+ //Fill Team array
+ for I := 0 to Teams.NumTeams-1 do
begin
ATeams[I].Teamnum := I;
ATeams[I].Score := Teams.Teaminfo[I].Score;
end;
- //Sort Teams
+ //Sort teams
for J := 0 to Teams.NumTeams-1 do
for I := 1 to Teams.NumTeams-1 do
if ATeams[I].Score > ATeams[I-1].Score then
@@ -597,17 +604,17 @@ begin
//Copy to Result
Result := 0;
- For I := 0 to Teams.NumTeams-1 do
+ for I := 0 to Teams.NumTeams-1 do
Result := Result or (ATeams[I].TeamNum Shl I*3);
end;
//----------
-// GetWinnerString - wParam is Roundnum. If (Pointer = nil) then Return Length of the String. Otherwise Write the String to Address at lParam
+// GetWinnerString - wParam is Roundnum. If (pointer = nil) then return length of the string. Otherwise write the string to address at lParam
//----------
-Function TPartySession.GetWinnerString(wParam: TwParam; lParam: TlParam): integer;
+function TPartySession.GetWinnerString(wParam: TwParam; lParam: TlParam): integer;
var
Winners: array of UTF8String;
- I: Integer;
+ I: integer;
ResultStr: String;
S: ^String;
begin
@@ -637,21 +644,21 @@ begin
end;
end;
- //Now Return what we have got
- If (lParam = nil) then
- begin //ReturnString Length
+ //Now return what we have got
+ if (lParam = nil) then
+ begin //Return string length
Result := Length(ResultStr);
end
- Else
- begin //Return String
- Try
+ else
+ begin //Return string
+ try
S := lParam;
S^ := ResultStr;
Result := 0;
- Except
+ except
Result := -1;
- End;
+ end;
end;
end;
diff --git a/unicode/src/base/UPath.pas b/unicode/src/base/UPath.pas
new file mode 100644
index 00000000..2316ac02
--- /dev/null
+++ b/unicode/src/base/UPath.pas
@@ -0,0 +1,188 @@
+{* UltraStar Deluxe - Karaoke Game
+ *
+ * UltraStar Deluxe is the legal property of its developers, whose names
+ * are too numerous to list here. Please refer to the COPYRIGHT
+ * file distributed with this source distribution.
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; see the file COPYING. If not, write to
+ * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+ * Boston, MA 02110-1301, USA.
+ *
+ * $URL: https://ultrastardx.svn.sourceforge.net/svnroot/ultrastardx/trunk/src/base/UPath.pas $
+ * $Id: UPath.pas 1624 2009-03-06 23:45:10Z k-m_schindler $
+ *}
+
+unit UPath;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+uses
+ SysUtils,
+ Classes;
+
+var
+ // Absolute Paths
+ GamePath: string;
+ SoundPath: string;
+ SongPaths: TStringList;
+ LogPath: string;
+ ThemePath: string;
+ SkinsPath: string;
+ ScreenshotsPath: string;
+ CoverPaths: TStringList;
+ LanguagesPath: string;
+ PluginPath: string;
+ VisualsPath: string;
+ FontPath: string;
+ ResourcesPath: string;
+ PlayListPath: string;
+
+function FindPath(out PathResult: string; const RequestedPath: string; NeedsWritePermission: boolean): boolean;
+procedure InitializePaths;
+procedure AddSongPath(const Path: string);
+
+implementation
+
+uses
+ StrUtils,
+ UPlatform,
+ UCommandLine,
+ ULog;
+
+procedure AddSpecialPath(var PathList: TStringList; const Path: string);
+var
+ Index: integer;
+ PathAbs, OldPathAbs: string;
+begin
+ if (PathList = nil) then
+ PathList := TStringList.Create;
+
+ if (Path = '') or not ForceDirectories(Path) then
+ Exit;
+
+ PathAbs := IncludeTrailingPathDelimiter(ExpandFileName(Path));
+
+ // check if path or a part of the path was already added
+ for Index := 0 to PathList.Count-1 do
+ begin
+ OldPathAbs := IncludeTrailingPathDelimiter(ExpandFileName(PathList[Index]));
+ // check if the new directory is a sub-directory of a previously added one.
+ // This is also true, if both paths point to the same directories.
+ if (AnsiStartsText(OldPathAbs, PathAbs)) then
+ begin
+ // ignore the new path
+ Exit;
+ end;
+
+ // check if a previously added directory is a sub-directory of the new one.
+ if (AnsiStartsText(PathAbs, OldPathAbs)) then
+ begin
+ // replace the old with the new one.
+ PathList[Index] := PathAbs;
+ Exit;
+ end;
+ end;
+
+ PathList.Add(PathAbs);
+end;
+
+procedure AddSongPath(const Path: string);
+begin
+ AddSpecialPath(SongPaths, Path);
+end;
+
+procedure AddCoverPath(const Path: string);
+begin
+ AddSpecialPath(CoverPaths, Path);
+end;
+
+(**
+ * Initialize a path variable
+ * After setting paths, make sure that paths exist
+ *)
+function FindPath(out PathResult: string;
+ const RequestedPath: string;
+ NeedsWritePermission: boolean)
+ : boolean;
+begin
+ Result := false;
+
+ if (RequestedPath = '') then
+ Exit;
+
+ // Make sure the directory exists
+ if (not ForceDirectories(RequestedPath)) then
+ begin
+ PathResult := '';
+ Exit;
+ end;
+
+ PathResult := IncludeTrailingPathDelimiter(RequestedPath);
+
+ if (NeedsWritePermission) and
+ (FileIsReadOnly(RequestedPath)) then
+ begin
+ Exit;
+ end;
+
+ Result := true;
+end;
+
+(**
+ * Function sets all absolute paths e.g. song path and makes sure the directorys exist
+ *)
+procedure InitializePaths;
+begin
+ // Log directory (must be writable)
+ if (not FindPath(LogPath, Platform.GetLogPath, true)) then
+ begin
+ Log.FileOutputEnabled := false;
+ Log.LogWarn('Log directory "'+ Platform.GetLogPath +'" not available', 'InitializePaths');
+ end;
+
+ FindPath(SoundPath, Platform.GetGameSharedPath + 'sounds', false);
+ FindPath(ThemePath, Platform.GetGameSharedPath + 'themes', false);
+ FindPath(SkinsPath, Platform.GetGameSharedPath + 'themes', false);
+ FindPath(LanguagesPath, Platform.GetGameSharedPath + 'languages', false);
+ FindPath(PluginPath, Platform.GetGameSharedPath + 'plugins', false);
+ FindPath(VisualsPath, Platform.GetGameSharedPath + 'visuals', false);
+ FindPath(FontPath, Platform.GetGameSharedPath + 'fonts', false);
+ FindPath(ResourcesPath, Platform.GetGameSharedPath + 'resources', false);
+
+ // Playlists are not shared as we need one directory to write too
+ FindPath(PlaylistPath, Platform.GetGameUserPath + 'playlists', true);
+
+ // Screenshot directory (must be writable)
+ if (not FindPath(ScreenshotsPath, Platform.GetGameUserPath + 'screenshots', true)) then
+ begin
+ Log.LogWarn('Screenshot directory "'+ Platform.GetGameUserPath +'" not available', 'InitializePaths');
+ end;
+
+ // Add song paths
+ AddSongPath(Params.SongPath);
+ AddSongPath(Platform.GetGameSharedPath + 'songs');
+ AddSongPath(Platform.GetGameUserPath + 'songs');
+
+ // Add category cover paths
+ AddCoverPath(Platform.GetGameSharedPath + 'covers');
+ AddCoverPath(Platform.GetGameUserPath + 'covers');
+end;
+
+end.
diff --git a/unicode/src/base/UPlatformMacOSX.pas b/unicode/src/base/UPlatformMacOSX.pas
index 1aa37cd4..96e4bc63 100644
--- a/unicode/src/base/UPlatformMacOSX.pas
+++ b/unicode/src/base/UPlatformMacOSX.pas
@@ -47,19 +47,21 @@ type
* (Note for non-Maccies: "folder" is the Mac name for directory.)
*
* Note on the resource folders:
- * 1. Installation of an application on the mac works as follows: Extract and copy an application
- * and if you don't like or need the application anymore you move the folder
- * to the trash - and you're done.
- * 2. The use folders in the user's home directory is against Apple's guidelines
- * and strange to an average user.
+ * 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".
+ * 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:
+ * 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:
+ * 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/
@@ -68,19 +70,19 @@ type
*
* So
* GetGameSharedPath could return
- * /Library/Application Support/UltraStarDeluxe/Resources/.
+ * /Library/Application Support/UltraStarDeluxe/.
* GetGameUserPath could return
- * ~/Library/Application Support/UltraStarDeluxe/Resources/.
+ * ~/Library/Application Support/UltraStarDeluxe/.
*
- * Right now, only $HOME/Library/Application Support/UltraStarDeluxe/Resources
+ * 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/Resources. However, this is not
- * treated yet in the code outside this unit.
+ * /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 Resources folder in the Application
+ * 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.
@@ -88,13 +90,14 @@ type
TPlatformMacOSX = class(TPlatform)
private
{**
- * GetBundlePath returns the path to the application bundle UltraStarDeluxe.app.
+ * GetBundlePath returns the path to the application bundle
+ * UltraStarDeluxe.app.
*}
function GetBundlePath: WideString;
{**
* GetApplicationSupportPath returns the path to
- * $HOME/Library/Application Support/UltraStarDeluxe/Resources.
+ * $HOME/Library/Application Support/UltraStarDeluxe.
*}
function GetApplicationSupportPath: WideString;
@@ -102,38 +105,38 @@ type
* see the description of @link(Init).
*}
procedure CreateUserFolders();
-
+
public
{**
- * Init simply calls @link(CreateUserFolders), which in turn scans the folder
- * UltraStarDeluxe.app/Contents/Resources for all files and folders.
- * $HOME/Library/Application Support/UltraStarDeluxe/Resources is then checked
- * for their presence and missing ones are copied.
+ * 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;
{**
- * DirectoryFindFiles returns all entries of a folder with names and booleans
- * about their type, i.e. file or directory.
+ * DirectoryFindFiles returns all entries of a folder with names and
+ * booleans about their type, i.e. file or directory.
*}
function DirectoryFindFiles(Dir, Filter: WideString; ReturnAllSubDirs: boolean): TDirectoryEntryArray; override;
{**
* GetLogPath returns the path for log messages. Currently it is set to
- * $HOME/Library/Application Support/UltraStarDeluxe/Resources/Log.
+ * $HOME/Library/Application Support/UltraStarDeluxe/Log.
*}
function GetLogPath : WideString; override;
{**
- * GetGameSharedPath returns the path for shared resources. Currently it is set to
- * /Library/Application Support/UltraStarDeluxe/Resources.
+ * GetGameSharedPath returns the path for shared resources. Currently it
+ * is set to /Library/Application Support/UltraStarDeluxe.
* However it is not used.
*}
function GetGameSharedPath : WideString; override;
{**
- * GetGameUserPath returns the path for user resources. Currently it is set to
- * $HOME/Library/Application Support/UltraStarDeluxe/Resources.
+ * GetGameUserPath returns the path for user resources. Currently it is
+ * set to $HOME/Library/Application Support/UltraStarDeluxe.
* This is where a user can add songs, themes, ....
*}
function GetGameUserPath : WideString; override;
@@ -151,6 +154,9 @@ begin
end;
procedure TPlatformMacOSX.CreateUserFolders();
+const
+ // used to construct the @link(UserPathName)
+ PathName: string = '/Library/Application Support/UltraStarDeluxe';
var
RelativePath: string;
// BaseDir contains the path to the folder, where a search is performed.
@@ -169,22 +175,23 @@ var
// searched for additional files and folders.
DirectoryIsFinished: longint;
Counter: longint;
+ // These three are for creating directories, due to possible symlinks
+ CreatedDirectory: boolean;
+ FileAttrs: integer;
+ DirectoryPath: string;
- UserPathName: string;
-const
- // used to construct the @link(UserPathName)
- PathName: string = '/Library/Application Support/UltraStarDeluxe/Resources';
+ UserPathName: string;
begin
// Get the current folder and save it in OldBaseDir for returning to it, when
// finished.
GetDir(0, OldBaseDir);
- // UltraStarDeluxe.app/Contents/Resources contains all the default files and
+ // UltraStarDeluxe.app/Contents contains all the default files and
// folders.
- BaseDir := OldBaseDir + '/UltraStarDeluxe.app/Contents/Resources';
+ BaseDir := OldBaseDir + '/UltraStarDeluxe.app/Contents';
ChDir(BaseDir);
- // Right now, only $HOME/Library/Application Support/UltraStarDeluxe/Resources
+ // Right now, only $HOME/Library/Application Support/UltraStarDeluxe
// is used.
UserPathName := GetEnvironmentVariable('HOME') + PathName;
@@ -192,7 +199,7 @@ begin
DirectoryList := TStringList.Create();
FileList := TStringList.Create();
DirectoryList.Add('.');
-
+
// create the folder and file lists
repeat
@@ -203,7 +210,7 @@ begin
repeat
if DirectoryExists(SearchInfo.Name) then
begin
- if (SearchInfo.Name <> '.') and (SearchInfo.Name <> '..') then
+ if (SearchInfo.Name <> '.') and (SearchInfo.Name <> '..') then
DirectoryList.Add(RelativePath + '/' + SearchInfo.Name);
end
else
@@ -218,7 +225,12 @@ begin
ForceDirectories(UserPathName); // should not be necessary since (UserPathName+'/.') is created.
for Counter := 0 to DirectoryList.Count-1 do
begin
- if not ForceDirectories(UserPathName + '/' + DirectoryList[Counter]) then
+ DirectoryPath := UserPathName + '/' + DirectoryList[Counter];
+ CreatedDirectory := ForceDirectories(DirectoryPath);
+ FileAttrs := FileGetAttr(DirectoryPath);
+ // Don't know how to analyse the target of the link.
+ // Let's assume the symlink is pointing to an existing directory.
+ if (not CreatedDirectory) and (FileAttrs and faSymLink > 0) then
Log.LogError('Failed to create the folder "'+ UserPathName + '/' + DirectoryList[Counter] +'"',
'TPlatformMacOSX.CreateUserFolders');
end;
@@ -241,8 +253,7 @@ var
i, pos : integer;
begin
// Mac applications are packaged in folders.
- // We have to cut the last two folders
- // to get the application folder.
+ // Cutting the last two folders yields the application folder.
Result := GetExecutionDir();
for i := 1 to 2 do
@@ -257,7 +268,7 @@ end;
function TPlatformMacOSX.GetApplicationSupportPath: WideString;
const
- PathName : string = '/Library/Application Support/UltraStarDeluxe/Resources';
+ PathName : string = '/Library/Application Support/UltraStarDeluxe';
begin
Result := GetEnvironmentVariable('HOME') + PathName + '/';
end;
@@ -287,7 +298,7 @@ begin
i := 0;
Filter := LowerCase(Filter);
- TheDir := FPOpenDir(Dir);
+ TheDir := FPOpenDir(Dir);
if Assigned(TheDir) then
repeat
ADirent := FPReadDir(TheDir);
diff --git a/unicode/src/base/UPlaylist.pas b/unicode/src/base/UPlaylist.pas
index 47ade154..744f4ce8 100644
--- a/unicode/src/base/UPlaylist.pas
+++ b/unicode/src/base/UPlaylist.pas
@@ -34,7 +34,8 @@ interface
{$I switches.inc}
uses
- USong;
+ USong,
+ UPath;
type
TPlaylistItem = record
diff --git a/unicode/src/base/UPluginLoader.pas b/unicode/src/base/UPluginLoader.pas
index 5e581c23..8836cb78 100644
--- a/unicode/src/base/UPluginLoader.pas
+++ b/unicode/src/base/UPluginLoader.pas
@@ -41,14 +41,15 @@ interface
uses
UPluginDefs,
- UCoreModule;
+ UCoreModule,
+ UPath;
type
TPluginListItem = record
Info: TUS_PluginInfo;
- State: Byte; // State of this plugin: 0 - undefined; 1 - loaded; 2 - inited / running; 4 - unloaded; 254 - loading aborted by plugin; 255 - unloaded because of error
- Path: String; // path to this plugin
- NeedsDeInit: Boolean; // if this is inited correctly this should be true
+ State: byte; // State of this plugin: 0 - undefined; 1 - loaded; 2 - inited / running; 4 - unloaded; 254 - loading aborted by plugin; 255 - unloaded because of error
+ Path: string; // path to this plugin
+ NeedsDeInit: boolean; // if this is inited correctly this should be true
hLib: THandle; // handle of loaded libary
Procs: record // procs offered by plugin. Don't call this directly use wrappers of TPluginLoader
Load: Func_Load;
@@ -63,13 +64,13 @@ type
PPluginLoader = ^TPluginLoader;
TPluginLoader = class (TCoreModule)
private
- LoadingProcessFinished: Boolean;
+ LoadingProcessFinished: boolean;
sUnloadPlugin: THandle;
sLoadPlugin: THandle;
sGetPluginInfo: THandle;
sGetPluginState: THandle;
- procedure FreePlugin(Index: Cardinal);
+ procedure FreePlugin(Index: integer);
public
PluginInterface: TUS_PluginInterface;
Plugins: array of TPluginListItem;
@@ -77,19 +78,19 @@ type
// TCoreModule methods to inherit
constructor Create; override;
procedure Info(const pInfo: PModuleInfo); override;
- function Load: Boolean; override;
- function Init: Boolean; override;
+ function Load: boolean; override;
+ function Init: boolean; override;
procedure DeInit; override;
Destructor Destroy; override;
// New methods
- procedure BrowseDir(Path: String); // browses the path at _Path_ for plugins
- function PluginExists(Name: String): integer; // if plugin exists: Index of plugin, else -1
- procedure AddPlugin(Filename: String); // adds plugin to the array
+ procedure BrowseDir(Path: string); // browses the path at _Path_ for plugins
+ function PluginExists(Name: string): integer; // if plugin exists: Index of plugin, else -1
+ procedure AddPlugin(Filename: string); // adds plugin to the array
- function CallLoad(Index: Cardinal): integer;
- function CallInit(Index: Cardinal): integer;
- procedure CallDeInit(Index: Cardinal);
+ function CallLoad(Index: integer): integer;
+ function CallInit(Index: integer): integer;
+ procedure CallDeInit(Index: integer);
//Services offered
function LoadPlugin(wParam: TwParam; lParam: TlParam): integer; //wParam PChar(PluginName/PluginPath) | lParam (if wParam = nil) ID of the Plugin
@@ -110,10 +111,10 @@ type
public
// TCoreModule methods to inherit
constructor Create; override;
-
+
procedure Info(const pInfo: PModuleInfo); override;
- function Load: Boolean; override;
- function Init: Boolean; override;
+ function Load: boolean; override;
+ function Init: boolean; override;
procedure DeInit; override;
end;
@@ -176,7 +177,7 @@ begin
PluginInterface.ServiceExists := ServiceExists;
// UnSet private var
- LoadingProcessFinished := False;
+ LoadingProcessFinished := false;
end;
//-------------
@@ -185,15 +186,15 @@ end;
// to offer them to other modules or plugins during the init process
// if false is returned this will cause a forced exit
//-------------
-function TPluginLoader.Load: Boolean;
+function TPluginLoader.Load: boolean;
begin
- Result := True;
+ Result := true;
try
// Start searching for plugins
BrowseDir(PluginPath);
except
- Result := False;
+ Result := false;
Core.ReportError(integer(PChar('Error browsing and loading.')), PChar('TPluginLoader'));
end;
end;
@@ -204,11 +205,11 @@ end;
// your classes, variables etc.
// If false is returned this will cause a forced exit
//-------------
-function TPluginLoader.Init: Boolean;
+function TPluginLoader.Init: boolean;
begin
// Just set private var to true.
- LoadingProcessFinished := True;
- Result := True;
+ LoadingProcessFinished := true;
+ Result := true;
end;
//-------------
@@ -244,7 +245,7 @@ end;
//--------------
// Browses the path at _Path_ for plugins
//--------------
-procedure TPluginLoader.BrowseDir(Path: String);
+procedure TPluginLoader.BrowseDir(Path: string);
var
SR: TSearchRec;
begin
@@ -256,7 +257,7 @@ begin
until FindNext(SR) <> 0;
end;
FindClose(SR);
-
+
// Search for plugins at path
if FindFirst(Path + '*' + PluginFileExtension, 0, SR) = 0 then
begin
@@ -266,11 +267,11 @@ begin
end;
FindClose(SR);
end;
-
+
//--------------
// If plugin exists: Index of plugin, else -1
//--------------
-function TPluginLoader.PluginExists(Name: String): integer;
+function TPluginLoader.PluginExists(Name: string): integer;
var
I: integer;
begin
@@ -286,11 +287,11 @@ begin
end;
end;
end;
-
+
//--------------
// Adds plugin to the array
//--------------
-procedure TPluginLoader.AddPlugin(Filename: String);
+procedure TPluginLoader.AddPlugin(Filename: string);
var
hLib: THandle;
PInfo: Proc_PluginInfo;
@@ -332,7 +333,7 @@ begin
Plugins[PluginID].Info := Info;
Plugins[PluginID].State := 0;
Plugins[PluginID].Path := Filename;
- Plugins[PluginID].NeedsDeInit := False;
+ Plugins[PluginID].NeedsDeInit := false;
Plugins[PluginID].hLib := hLib;
// Try to get procs
@@ -340,7 +341,7 @@ begin
Plugins[PluginID].Procs.Init := GetProcAddress (hLib, PChar('USPlugin_Init'));
Plugins[PluginID].Procs.DeInit := GetProcAddress (hLib, PChar('USPlugin_DeInit'));
- if (@Plugins[PluginID].Procs.Load = nil) OR (@Plugins[PluginID].Procs.Init = nil) OR (@Plugins[PluginID].Procs.DeInit = nil) then
+ if (@Plugins[PluginID].Procs.Load = nil) or (@Plugins[PluginID].Procs.Init = nil) or (@Plugins[PluginID].Procs.DeInit = nil) then
begin
Plugins[PluginID].State := 255;
FreeLibrary(hLib);
@@ -354,11 +355,11 @@ begin
CallInit(PluginID);
end;
end
- else if (LoadingProcessFinished = False) then
+ else if (LoadingProcessFinished = false) then
begin
if (Plugins[PluginID].Info.Version < Info.Version) then
begin // Found newer version of this plugin
- Core.ReportDebug(integer(PChar('Found a newer version of plugin: ' + String(Info.Name))), PChar('TPluginLoader'));
+ Core.ReportDebug(integer(PChar('Found a newer version of plugin: ' + string(Info.Name))), PChar('TPluginLoader'));
// Unload old plugin
UnloadPlugin(PluginID, nil);
@@ -367,7 +368,7 @@ begin
Plugins[PluginID].Info := Info;
Plugins[PluginID].State := 0;
Plugins[PluginID].Path := Filename;
- Plugins[PluginID].NeedsDeInit := False;
+ Plugins[PluginID].NeedsDeInit := false;
Plugins[PluginID].hLib := hLib;
// Try to get procs
@@ -375,7 +376,7 @@ begin
Plugins[PluginID].Procs.Init := GetProcAddress (hLib, PChar('USPlugin_Init'));
Plugins[PluginID].Procs.DeInit := GetProcAddress (hLib, PChar('USPlugin_DeInit'));
- if (@Plugins[PluginID].Procs.Load = nil) OR (@Plugins[PluginID].Procs.Init = nil) OR (@Plugins[PluginID].Procs.DeInit = nil) then
+ if (@Plugins[PluginID].Procs.Load = nil) or (@Plugins[PluginID].Procs.Init = nil) or (@Plugins[PluginID].Procs.DeInit = nil) then
begin
FreeLibrary(hLib);
Plugins[PluginID].State := 255;
@@ -390,7 +391,7 @@ begin
else
begin
FreeLibrary(hLib);
- Core.ReportError(integer(PChar('Plugin with this name already exists: ' + String(Info.Name))), PChar('TPluginLoader'));
+ Core.ReportError(integer(PChar('Plugin with this name already exists: ' + string(Info.Name))), PChar('TPluginLoader'));
end;
end
else
@@ -413,7 +414,7 @@ end;
//--------------
// Calls load func of plugin with the given index
//--------------
-function TPluginLoader.CallLoad(Index: Cardinal): integer;
+function TPluginLoader.CallLoad(Index: integer): integer;
begin
Result := -2;
if(Index < Length(Plugins)) then
@@ -424,7 +425,7 @@ begin
Result := Plugins[Index].Procs.Load(@PluginInterface);
except
Result := -3;
- End;
+ end;
if (Result = 0) then
Plugins[Index].State := 1
@@ -432,7 +433,7 @@ begin
begin
FreePlugin(Index);
Plugins[Index].State := 255;
- Core.ReportError(integer(PChar('Error calling load function from plugin: ' + String(Plugins[Index].Info.Name))), PChar('TPluginLoader'));
+ Core.ReportError(integer(PChar('Error calling load function from plugin: ' + string(Plugins[Index].Info.Name))), PChar('TPluginLoader'));
end;
end;
end;
@@ -441,7 +442,7 @@ end;
//--------------
// Calls init func of plugin with the given index
//--------------
-function TPluginLoader.CallInit(Index: Cardinal): integer;
+function TPluginLoader.CallInit(Index: integer): integer;
begin
Result := -2;
if(Index < Length(Plugins)) then
@@ -452,18 +453,18 @@ begin
Result := Plugins[Index].Procs.Init(@PluginInterface);
except
Result := -3;
- End;
-
+ end;
+
if (Result = 0) then
begin
Plugins[Index].State := 2;
- Plugins[Index].NeedsDeInit := True;
+ Plugins[Index].NeedsDeInit := true;
end
else
begin
FreePlugin(Index);
Plugins[Index].State := 255;
- Core.ReportError(integer(PChar('Error calling init function from plugin: ' + String(Plugins[Index].Info.Name))), PChar('TPluginLoader'));
+ Core.ReportError(integer(PChar('Error calling init function from plugin: ' + string(Plugins[Index].Info.Name))), PChar('TPluginLoader'));
end;
end;
end;
@@ -472,7 +473,7 @@ end;
//--------------
// Calls deinit proc of plugin with the given index
//--------------
-procedure TPluginLoader.CallDeInit(Index: Cardinal);
+procedure TPluginLoader.CallDeInit(Index: integer);
begin
if(Index < Length(Plugins)) then
begin
@@ -483,7 +484,7 @@ begin
Plugins[Index].Procs.DeInit(@PluginInterface);
except
- End;
+ end;
// Don't forget to remove services and subscriptions by this plugin
Core.Hooks.DelbyOwner(-1 - Index);
@@ -496,7 +497,7 @@ end;
//--------------
// Frees all plugin sources (procs and handles) - helper for deiniting functions
//--------------
-procedure TPluginLoader.FreePlugin(Index: Cardinal);
+procedure TPluginLoader.FreePlugin(Index: integer);
begin
Plugins[Index].State := 4;
Plugins[Index].Procs.Load := nil;
@@ -507,15 +508,13 @@ begin
FreeLibrary(Plugins[Index].hLib);
end;
-
-
//--------------
// wParam PChar(PluginName/PluginPath) | wParam (if lParam = nil) ID of the plugin
//--------------
function TPluginLoader.LoadPlugin(wParam: TwParam; lParam: TlParam): integer;
var
Index: integer;
- sFile: String;
+ sFile: string;
begin
Result := -1;
sFile := '';
@@ -527,9 +526,9 @@ begin
else
begin //lParam is PChar
try
- sFile := String(PChar(lParam));
+ sFile := string(PChar(lParam));
Index := PluginExists(sFile);
- if (Index < 0) And FileExists(sFile) then
+ if (Index < 0) and FileExists(sFile) then
begin // Is filename
AddPlugin(sFile);
Result := Plugins[High(Plugins)].State;
@@ -539,7 +538,6 @@ begin
end;
end;
-
if (Index >= 0) and (Index < Length(Plugins)) then
begin
AddPlugin(Plugins[Index].Path);
@@ -553,7 +551,7 @@ end;
function TPluginLoader.UnloadPlugin(wParam: TwParam; lParam: TlParam): integer;
var
Index: integer;
- sName: String;
+ sName: string;
begin
Result := -1;
// lParam is ID
@@ -564,14 +562,13 @@ begin
else
begin // wParam is PChar
try
- sName := String(PChar(lParam));
+ sName := string(PChar(lParam));
Index := PluginExists(sName);
except
Index := -2;
end;
end;
-
if (Index >= 0) and (Index < Length(Plugins)) then
CallDeInit(Index)
end;
@@ -592,7 +589,7 @@ begin
PUS_PluginInfo(lParam)^ := Plugins[wParam].Info;
except
- End;
+ end;
end;
end
else if (lParam = nil) then
@@ -607,13 +604,13 @@ begin
Result := Length(Plugins);
except
Core.ReportError(integer(PChar('Could not write PluginInfo Array')), PChar('TPluginLoader'));
- End;
+ end;
end;
end;
//--------------
-// if wParam = -1 then (if lParam = nil then get length of plugin state array. if lparam <> nil then write array of Byte to address at lparam) else (return state of plugin with index(wParam))
+// if wParam = -1 then (if lParam = nil then get length of plugin state array. if lparam <> nil then write array of byte to address at lparam) else (return state of plugin with index(wParam))
//--------------
function TPluginLoader.GetPluginState(wParam: TwParam; lParam: TlParam): integer;
var I: integer;
@@ -634,15 +631,14 @@ begin
begin
try
for I := 0 to high(Plugins) do
- Byte(Pointer(integer(lParam) + I)^) := Plugins[I].State;
+ byte(Pointer(integer(lParam) + I)^) := Plugins[I].State;
Result := Length(Plugins);
except
Core.ReportError(integer(PChar('Could not write pluginstate array')), PChar('TPluginLoader'));
- End;
+ end;
end;
end;
-
{*********************
TtehPlugins
Implementation
@@ -673,7 +669,7 @@ end;
// to offer them to other modules or plugins during the init process
// if false is returned this will cause a forced exit
//-------------
-function TtehPlugins.Load: Boolean;
+function TtehPlugins.Load: boolean;
var
i: integer; // Counter
CurExecutedBackup: integer; //backup of Core.CurExecuted Attribute
@@ -703,11 +699,11 @@ begin
begin
PluginLoader.CallDeInit(i);
PluginLoader.Plugins[i].State := 254; // Plugin asks for unload
- Core.ReportDebug(integer(PChar('Plugin selfabort during loading process: ' + String(PluginLoader.Plugins[i].Info.Name))), PChar('TtehPlugins'));
+ Core.ReportDebug(integer(PChar('Plugin selfabort during loading process: ' + string(PluginLoader.Plugins[i].Info.Name))), PChar('TtehPlugins'));
end
else
begin
- Core.ReportDebug(integer(PChar('Plugin loaded succesfully: ' + String(PluginLoader.Plugins[i].Info.Name))), PChar('TtehPlugins'));
+ Core.ReportDebug(integer(PChar('Plugin loaded succesfully: ' + string(PluginLoader.Plugins[i].Info.Name))), PChar('TtehPlugins'));
end;
except
// Plugin could not be loaded.
@@ -721,7 +717,7 @@ begin
end;
end;
- // Reset CurExecuted
+ // Reset CurExecuted
Core.CurExecuted := CurExecutedBackup;
end;
end;
@@ -732,7 +728,7 @@ end;
// your classes, variables etc.
// if false is returned this will cause a forced exit
//-------------
-function TtehPlugins.Init: Boolean;
+function TtehPlugins.Init: boolean;
var
i: integer; // Counter
CurExecutedBackup: integer; // backup of Core.CurExecuted attribute
@@ -752,16 +748,16 @@ begin
begin
PluginLoader.CallDeInit(i);
PluginLoader.Plugins[i].State := 254; //Plugin asks for unload
- Core.ReportDebug(integer(PChar('Plugin selfabort during init process: ' + String(PluginLoader.Plugins[i].Info.Name))), PChar('TtehPlugins'));
+ Core.ReportDebug(integer(PChar('Plugin selfabort during init process: ' + string(PluginLoader.Plugins[i].Info.Name))), PChar('TtehPlugins'));
end
else
- Core.ReportDebug(integer(PChar('Plugin inited succesfully: ' + String(PluginLoader.Plugins[i].Info.Name))), PChar('TtehPlugins'));
+ Core.ReportDebug(integer(PChar('Plugin inited succesfully: ' + string(PluginLoader.Plugins[i].Info.Name))), PChar('TtehPlugins'));
except
// Plugin could not be loaded.
// => Show error message, then shut down plugin
PluginLoader.CallDeInit(i);
PluginLoader.Plugins[i].State := 255; //Plugin causes Error
- Core.ReportError(integer(PChar('Plugin causes error during init process: ' + String(PluginLoader.Plugins[i].Info.Name))), PChar('TtehPlugins'));
+ Core.ReportError(integer(PChar('Plugin causes error during init process: ' + string(PluginLoader.Plugins[i].Info.Name))), PChar('TtehPlugins'));
end;
// Reset CurExecuted
@@ -781,7 +777,7 @@ begin
CurExecutedBackup := Core.CurExecuted;
// Start loop
-
+
for i := 0 to High(PluginLoader.Plugins) do
begin
try
diff --git a/unicode/src/base/URecord.pas b/unicode/src/base/URecord.pas
index 132bafd5..8f37262d 100644
--- a/unicode/src/base/URecord.pas
+++ b/unicode/src/base/URecord.pas
@@ -36,26 +36,26 @@ interface
uses
Classes,
Math,
- SysUtils,
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)
+ NumHalftones = 36; // C2-B4 (for Whitney and my high voice)
type
TCaptureBuffer = class
private
- VoiceStream: TAudioVoiceStream; // stream for voice passthrough
+ VoiceStream: TAudioVoiceStream; // stream for voice passthrough
AnalysisBufferLock: PSDL_Mutex;
function GetToneString: string; // converts a tone to its string represenatation;
- procedure BoostBuffer(Buffer: PChar; Size: Cardinal);
- procedure ProcessNewBuffer(Buffer: PChar; BufferSize: integer);
+ procedure BoostBuffer(Buffer: PByteArray; Size: cardinal);
+ procedure ProcessNewBuffer(Buffer: PByteArray; BufferSize: integer);
// we call it to analyze sound by checking Autocorrelation
procedure AnalyzeByAutocorrelation;
@@ -86,7 +86,7 @@ type
procedure LockAnalysisBuffer(); {$IFDEF HasInline}inline;{$ENDIF}
procedure UnlockAnalysisBuffer(); {$IFDEF HasInline}inline;{$ENDIF}
- function MaxSampleVolume: Single;
+ function MaxSampleVolume: single;
property ToneString: string READ GetToneString;
end;
@@ -95,17 +95,17 @@ const
type
TAudioInputSource = record
- Name: string;
+ Name: string;
end;
// soundcard input-devices information
TAudioInputDevice = class
public
- CfgIndex: integer; // index of this device in Ini.InputDeviceConfig
- Name: string; // soundcard name
- Source: array of TAudioInputSource; // soundcard input-sources
- SourceRestore: integer; // source-index that will be selected after capturing (-1: not detected)
- MicSource: integer; // source-index of mic (-1: none detected)
+ CfgIndex: integer; // index of this device in Ini.InputDeviceConfig
+ Name: string; // soundcard name
+ Source: array of TAudioInputSource; // soundcard input-sources
+ SourceRestore: integer; // source-index that will be selected after capturing (-1: not detected)
+ MicSource: integer; // source-index of mic (-1: none detected)
AudioFormat: TAudioFormatInfo; // capture format info (e.g. 44.1kHz SInt16 stereo)
CaptureChannel: array of TCaptureBuffer; // sound-buffer references used for mono or stereo channel's capture data
@@ -115,10 +115,10 @@ type
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 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;
@@ -135,7 +135,7 @@ type
procedure UpdateInputDeviceConfig;
// handle microphone input
- procedure HandleMicrophoneData(Buffer: PChar; Size: Cardinal;
+ procedure HandleMicrophoneData(Buffer: PByteArray; Size: cardinal;
InputDevice: TAudioInputDevice);
end;
@@ -153,7 +153,6 @@ type
procedure CaptureStop;
end;
-
TSmallIntArray = array [0..(MaxInt div SizeOf(SmallInt))-1] of SmallInt;
PSmallIntArray = ^TSmallIntArray;
@@ -163,12 +162,11 @@ implementation
uses
ULog,
- UMain;
+ UNote;
var
singleton_AudioInputProcessor : TAudioInputProcessor = nil;
-
{ Global }
function AudioInputProcessor(): TAudioInputProcessor;
@@ -179,7 +177,6 @@ begin
result := singleton_AudioInputProcessor;
end;
-
{ TAudioInputDevice }
destructor TAudioInputDevice.Destroy;
@@ -268,11 +265,11 @@ begin
UnlockAnalysisBuffer();
end;
-procedure TCaptureBuffer.ProcessNewBuffer(Buffer: PChar; BufferSize: integer);
+procedure TCaptureBuffer.ProcessNewBuffer(Buffer: PByteArray; BufferSize: integer);
var
BufferOffset: integer;
- SampleCount: integer;
- i: integer;
+ SampleCount: integer;
+ i: integer;
begin
// apply software boost
BoostBuffer(Buffer, BufferSize);
@@ -299,7 +296,6 @@ begin
SampleCount := Length(AnalysisBuffer);
end;
-
LockAnalysisBuffer();
try
@@ -315,7 +311,6 @@ begin
UnlockAnalysisBuffer();
end;
-
// save capture-data to BufferLong if enabled
if (Ini.SavePlayback = 1) then
begin
@@ -329,10 +324,10 @@ end;
procedure TCaptureBuffer.AnalyzeBuffer;
var
- Volume: single;
- MaxVolume: single;
+ Volume: single;
+ MaxVolume: single;
SampleIndex: integer;
- Threshold: single;
+ Threshold: single;
begin
ToneValid := false;
ToneAbs := -1;
@@ -431,10 +426,10 @@ begin
Result := 1 - AccumDist / AnalysisBufferSize;
end;
-function TCaptureBuffer.MaxSampleVolume: Single;
+function TCaptureBuffer.MaxSampleVolume: single;
var
- lSampleIndex: Integer;
- lMaxVol : Longint;
+ lSampleIndex: integer;
+ lMaxVol: longint;
begin;
LockAnalysisBuffer();
try
@@ -464,13 +459,13 @@ begin
Result := '-';
end;
-procedure TCaptureBuffer.BoostBuffer(Buffer: PChar; Size: Cardinal);
+procedure TCaptureBuffer.BoostBuffer(Buffer: PByteArray; Size: cardinal);
var
- i: integer;
- Value: Longint;
- SampleCount: integer;
+ i: integer;
+ Value: longint;
+ SampleCount: integer;
SampleBuffer: PSmallIntArray; // buffer handled as array of samples
- Boost: byte;
+ Boost: byte;
begin
// TODO: set boost per device
case Ini.MicBoost of
@@ -504,7 +499,6 @@ begin
end;
end;
-
{ TAudioInputProcessor }
constructor TAudioInputProcessor.Create;
@@ -531,14 +525,14 @@ end;
// See: TIni.LoadInputDeviceCfg()
procedure TAudioInputProcessor.UpdateInputDeviceConfig;
var
- deviceIndex: integer;
- newDevice: boolean;
+ deviceIndex: integer;
+ newDevice: boolean;
deviceIniIndex: integer;
- deviceCfg: PInputDeviceConfig;
- device: TAudioInputDevice;
- channelCount: integer;
- channelIndex: integer;
- i: integer;
+ deviceCfg: PInputDeviceConfig;
+ device: TAudioInputDevice;
+ channelCount: integer;
+ channelIndex: integer;
+ i: integer;
begin
// Input devices - append detected soundcards
for deviceIndex := 0 to High(DeviceList) do
@@ -608,18 +602,18 @@ end;
* Length - number of bytes in Buffer
* Input - Soundcard-Input used for capture
*}
-procedure TAudioInputProcessor.HandleMicrophoneData(Buffer: PChar; Size: Cardinal; InputDevice: TAudioInputDevice);
+procedure TAudioInputProcessor.HandleMicrophoneData(Buffer: PByteArray; Size: cardinal; InputDevice: TAudioInputDevice);
var
- MultiChannelBuffer: PChar; // buffer handled as array of bytes (offset relative to channel)
- SingleChannelBuffer: PChar; // temporary buffer for new samples per channel
+ 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;
- SampleCount: integer;
- SamplesPerChannel: integer;
- i: integer;
+ ChannelIndex: integer;
+ CaptureChannel: TCaptureBuffer;
+ AudioFormat: TAudioFormatInfo;
+ SampleSize: integer;
+ SampleCount: integer;
+ SamplesPerChannel: integer;
+ i: integer;
begin
AudioFormat := InputDevice.AudioFormat;
SampleSize := AudioSampleSize[AudioFormat.Format];
@@ -638,7 +632,7 @@ begin
begin
// set offset according to channel index
MultiChannelBuffer := @Buffer[ChannelIndex * SampleSize];
- // seperate channel-data from interleaved multi-channel (e.g. stereo) data
+ // separate channel-data from interleaved multi-channel (e.g. stereo) data
for i := 0 to SamplesPerChannel-1 do
begin
Move(MultiChannelBuffer[i*AudioFormat.FrameSize],
@@ -652,7 +646,6 @@ begin
FreeMem(SingleChannelBuffer);
end;
-
{ TAudioInputBase }
function TAudioInputBase.FinalizeRecord: boolean;
@@ -670,13 +663,13 @@ end;
*}
procedure TAudioInputBase.CaptureStart;
var
- S: integer;
- DeviceIndex: integer;
+ S: integer;
+ DeviceIndex: integer;
ChannelIndex: integer;
- Device: TAudioInputDevice;
- DeviceCfg: PInputDeviceConfig;
- DeviceUsed: boolean;
- Player: integer;
+ Device: TAudioInputDevice;
+ DeviceCfg: PInputDeviceConfig;
+ DeviceUsed: boolean;
+ Player: integer;
begin
if (Started) then
CaptureStop();
@@ -728,10 +721,10 @@ end;
*}
procedure TAudioInputBase.CaptureStop;
var
- DeviceIndex: integer;
+ DeviceIndex: integer;
ChannelIndex: integer;
- Device: TAudioInputDevice;
- DeviceCfg: PInputDeviceConfig;
+ Device: TAudioInputDevice;
+ DeviceCfg: PInputDeviceConfig;
begin
for DeviceIndex := 0 to High(AudioInputProcessor.DeviceList) do
begin
@@ -758,17 +751,18 @@ var
var
i: integer;
begin
- Result := False;
+ Result := false;
// search devices with same description
- For i := 0 to deviceIndex-1 do
+ for i := 0 to deviceIndex-1 do
begin
if (AudioInputProcessor.DeviceList[i].Name = name) then
begin
- Result := True;
+ Result := true;
Break;
end;
end;
end;
+
begin
count := 1;
result := name;
@@ -783,6 +777,3 @@ begin
end;
end.
-
-
-
diff --git a/unicode/src/base/URingBuffer.pas b/unicode/src/base/URingBuffer.pas
index 515d0efb..684c13ee 100644
--- a/unicode/src/base/URingBuffer.pas
+++ b/unicode/src/base/URingBuffer.pas
@@ -39,7 +39,7 @@ uses
type
TRingBuffer = class
private
- RingBuffer: PChar;
+ RingBuffer: PByteArray;
BufferCount: integer;
BufferSize: integer;
WritePos: integer;
@@ -47,8 +47,10 @@ type
public
constructor Create(Size: integer);
destructor Destroy; override;
- function Read(Buffer: PChar; Count: integer): integer;
- function Write(Buffer: PChar; Count: integer): integer;
+ function Read(Buffer: PByteArray; Count: integer): integer;
+ function Write(Buffer: PByteArray; Count: integer): integer;
+ function Size(): integer;
+ function Available(): integer;
procedure Flush();
end;
@@ -71,7 +73,7 @@ begin
FreeMem(RingBuffer);
end;
-function TRingBuffer.Read(Buffer: PChar; Count: integer): integer;
+function TRingBuffer.Read(Buffer: PByteArray; Count: integer): integer;
var
PartCount: integer;
begin
@@ -106,7 +108,7 @@ begin
Result := Count;
end;
-function TRingBuffer.Write(Buffer: PChar; Count: integer): integer;
+function TRingBuffer.Write(Buffer: PByteArray; Count: integer): integer;
var
PartCount: integer;
begin
@@ -143,6 +145,16 @@ begin
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;
@@ -150,4 +162,4 @@ begin
BufferCount := 0;
end;
-end. \ No newline at end of file
+end.
diff --git a/unicode/src/base/USkins.pas b/unicode/src/base/USkins.pas
index df736684..a4722d95 100644
--- a/unicode/src/base/USkins.pas
+++ b/unicode/src/base/USkins.pas
@@ -35,23 +35,23 @@ interface
type
TSkinTexture = record
- Name: string;
- FileName: string;
+ Name: string;
+ FileName: string;
end;
TSkinEntry = record
- Theme: string;
- Name: string;
- Path: string;
- FileName: string;
- Creator: string; // not used yet
+ Theme: string;
+ Name: string;
+ Path: string;
+ FileName: string;
+ Creator: string; // not used yet
end;
TSkin = class
- Skin: array of TSkinEntry;
- SkinTexture: array of TSkinTexture;
- SkinPath: string;
- Color: integer;
+ Skin: array of TSkinEntry;
+ SkinTexture: array of TSkinTexture;
+ SkinPath: string;
+ Color: integer;
constructor Create;
procedure LoadList;
procedure ParseDir(Dir: string);
@@ -63,30 +63,33 @@ type
end;
var
- Skin: TSkin;
+ Skin: TSkin;
implementation
-uses IniFiles,
- Classes,
- SysUtils,
- UMain,
- ULog,
- UIni;
+uses
+ IniFiles,
+ Classes,
+ SysUtils,
+ UIni,
+ ULog,
+ UMain,
+ UPath;
constructor TSkin.Create;
begin
inherited;
LoadList;
-// LoadSkin('Lisek');
+// LoadSkin('...');
// SkinColor := Color;
end;
procedure TSkin.LoadList;
var
- SR: TSearchRec;
+ SR: TSearchRec;
begin
- if FindFirst(SkinsPath+'*', faDirectory, SR) = 0 then begin
+ if FindFirst(SkinsPath+'*', faDirectory, SR) = 0 then
+ begin
repeat
if (SR.Name <> '.') and (SR.Name <> '..') then
ParseDir(SkinsPath + SR.Name + PathDelim);
@@ -97,9 +100,10 @@ end;
procedure TSkin.ParseDir(Dir: string);
var
- SR: TSearchRec;
+ SR: TSearchRec;
begin
- if FindFirst(Dir + '*.ini', faAnyFile, SR) = 0 then begin
+ if FindFirst(Dir + '*.ini', faAnyFile, SR) = 0 then
+ begin
repeat
if (SR.Name <> '.') and (SR.Name <> '..') then
@@ -111,8 +115,8 @@ end;
procedure TSkin.LoadHeader(FileName: string);
var
- SkinIni: TMemIniFile;
- S: integer;
+ SkinIni: TMemIniFile;
+ S: integer;
begin
SkinIni := TMemIniFile.Create(FileName);
@@ -130,10 +134,10 @@ end;
procedure TSkin.LoadSkin(Name: string);
var
- SkinIni: TMemIniFile;
- SL: TStringList;
- T: integer;
- S: integer;
+ SkinIni: TMemIniFile;
+ SL: TStringList;
+ T: integer;
+ S: integer;
begin
S := GetSkinNumber(Name);
SkinPath := Skin[S].Path;
@@ -156,39 +160,43 @@ end;
function TSkin.GetTextureFileName(TextureName: string): string;
var
- T: integer;
+ T: integer;
begin
Result := '';
for T := 0 to High(SkinTexture) do
begin
- if ( SkinTexture[T].Name = TextureName ) AND
+ if ( SkinTexture[T].Name = TextureName ) and
( SkinTexture[T].FileName <> '' ) then
begin
Result := SkinPath + SkinTexture[T].FileName;
end;
end;
- if ( TextureName <> '' ) AND
- ( Result <> '' ) THEN
+ if ( TextureName <> '' ) and
+ ( Result <> '' ) then
begin
//Log.LogError('', '-----------------------------------------');
//Log.LogError(TextureName+' - '+ Result, 'TSkin.GetTextureFileName');
end;
{ Result := SkinPath + 'Bar.jpg';
- if TextureName = 'Ball' then Result := SkinPath + 'Ball.bmp';
- if Copy(TextureName, 1, 4) = 'Gray' then Result := SkinPath + 'Ball.bmp';
- if Copy(TextureName, 1, 6) = 'NoteBG' then Result := SkinPath + 'Ball.bmp';}
+ if TextureName = 'Ball' then
+ Result := SkinPath + 'Ball.bmp';
+ if Copy(TextureName, 1, 4) = 'Gray' then
+ Result := SkinPath + 'Ball.bmp';
+ if Copy(TextureName, 1, 6) = 'NoteBG' then
+ Result := SkinPath + 'Ball.bmp';}
end;
function TSkin.GetSkinNumber(Name: string): integer;
var
- S: integer;
+ S: integer;
begin
Result := 0; // set default to the first available skin
for S := 0 to High(Skin) do
- if Skin[S].Name = Name then Result := S;
+ if Skin[S].Name = Name then
+ Result := S;
end;
procedure TSkin.onThemeChange;
@@ -200,7 +208,8 @@ begin
SetLength(ISkin, 0);
Name := Uppercase(ITheme[Ini.Theme]);
for S := 0 to High(Skin) do
- if Name = Uppercase(Skin[S].Theme) then begin
+ if Name = Uppercase(Skin[S].Theme) then
+ begin
SetLength(ISkin, Length(ISkin)+1);
ISkin[High(ISkin)] := Skin[S].Name;
end;
diff --git a/unicode/src/base/USong.pas b/unicode/src/base/USong.pas
index 69c6615d..a547a077 100644
--- a/unicode/src/base/USong.pas
+++ b/unicode/src/base/USong.pas
@@ -74,7 +74,7 @@ type
end;
TSong = class
- FileLineNo : integer; //Line which is readed at Last, for error reporting
+ FileLineNo : integer; // line, which is read last, for error reporting
function EncodeFilename(Filename: string): string;
function Solmizate(Note: integer; Type_: integer): string;
@@ -135,8 +135,8 @@ type
MultBPM : integer;
LastError: AnsiString;
- Function GetErrorLineNo: Integer;
- Property ErrorLineNo: Integer read GetErrorLineNo;
+ function GetErrorLineNo: integer;
+ property ErrorLineNo: integer read GetErrorLineNo;
constructor Create(); overload;
@@ -151,17 +151,54 @@ type
implementation
uses
+ StrUtils,
TextGL,
UIni,
+ UPath,
UMusic, //needed for Lines
- UMain; //needed for Player
+ UNote; //needed for Player
constructor TSong.Create();
begin
inherited;
end;
-constructor TSong.Create( const aFileName : WideString );
+constructor TSong.Create( const aFileName: WideString );
+ // This may be changed, when we rewrite song select code.
+ // it is some kind of dirty, but imho the best possible
+ // solution as we do atm not support nested categorys.
+ // it works like the folder sorting in 1.0.1a
+ // folder is set to the first folder under the songdir
+ // so songs ~/.ultrastardx/songs/punk is in the same
+ // category as songs in shared/ultrastardx/songs are.
+ // note: folder is just the name of a category it has
+ // nothing to do with the path used for file loading
+ function GetFolderCategory: WideString;
+ var
+ I: Integer;
+ P: Integer; //position of next path delimiter
+ begin
+ Result := 'Unknown'; //default folder category, if we can't locate the song dir
+
+ for I := 0 to SongPaths.Count-1 do
+ if (AnsiStartsText(SongPaths.Strings[I], aFilename)) then
+ begin
+ P := PosEx(PathDelim, aFilename, Length(SongPaths.Strings[I]) + 1);
+
+ If (P > 0) then
+ begin
+ // we have found the category name => get it
+ Result := copy(self.Path, Length(SongPaths.Strings[I]) + 1, P - Length(SongPaths.Strings[I]) - 1);
+ end
+ else
+ begin
+ // songs are in the "root" of the songdir => use songdir for the categorys name
+ Result := SongPaths.Strings[I];
+ end;
+
+ Exit;
+ end;
+ end;
begin
inherited Create();
@@ -174,7 +211,7 @@ begin
if fileexists( aFileName ) then
begin
self.Path := ExtractFilePath( aFileName );
- self.Folder := ExtractFilePath( aFileName );
+ self.Folder := GetFolderCategory;
self.FileName := ExtractFileName( aFileName );
(*
if ReadTXTHeader( aFileName ) then
@@ -229,9 +266,6 @@ begin
MultBPM := 4; // multiply beat-count of note by 4
Mult := 1; // accuracy of measurement of note
- Base[0] := 100; // high number
- Lines[0].ScoreValue := 0;
- self.Relative := false;
Rel[0] := 0;
CP := 0;
Both := false;
@@ -271,20 +305,24 @@ begin
SetLength(Lines, 2);
for Count := 0 to High(Lines) do
begin
- SetLength(Lines[Count].Line, 1);
Lines[Count].High := 0;
Lines[Count].Number := 1;
Lines[Count].Current := 0;
Lines[Count].Resolution := self.Resolution;
Lines[Count].NotesGAP := self.NotesGAP;
+ Lines[Count].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].LastLine := false;
+ Lines[Count].Line[0].BaseNote := High(Integer);
+ Lines[Count].Line[0].TotalNotes := 0;
end;
- //TempC := ':';
- //TempC := Text[1]; // read from backup variable, don't use default ':' value
-
- while (TempC <> 'E') AND (not EOF(SongFile)) do
+ while (TempC <> 'E') and (not EOF(SongFile)) do
begin
if (TempC = ':') or (TempC = '*') or (TempC = 'F') then
@@ -296,13 +334,16 @@ begin
Read(SongFile, ParamS);
//Check for ZeroNote
- if Param2 = 0 then Log.LogError('Found ZeroNote at "'+TempC+' '+IntToStr(Param1)+' '+IntToStr(Param2)+' '+IntToStr(Param3)+ParamS+'" -> Note ignored!') else
+ if Param2 = 0 then
+ Log.LogError('Found ZeroNote at "'+TempC+' '+IntToStr(Param1)+' '+IntToStr(Param2)+' '+IntToStr(Param3)+ParamS+'" -> Note ignored!')
+ else
begin
// add notes
if not Both then
// P1
ParseNote(0, TempC, (Param1+Rel[0]) * Mult, Param2 * Mult, Param3, ParamS)
- else begin
+ else
+ begin
// P1 + P2
ParseNote(0, TempC, (Param1+Rel[0]) * Mult, Param2 * Mult, Param3, ParamS);
ParseNote(1, TempC, (Param1+Rel[1]) * Mult, Param2 * Mult, Param3, ParamS);
@@ -310,24 +351,26 @@ begin
end; //Zeronote check
end // if
- Else if TempC = '-' then
+ else if TempC = '-' then
begin
// reads sentence
Read(SongFile, Param1);
- if self.Relative then Read(SongFile, Param2); // read one more data for relative system
+ if self.Relative then
+ Read(SongFile, Param2); // read one more data for relative system
// new sentence
if not Both then
// P1
NewSentence(0, (Param1 + Rel[0]) * Mult, Param2)
- else begin
+ else
+ begin
// P1 + P2
NewSentence(0, (Param1 + Rel[0]) * Mult, Param2);
NewSentence(1, (Param1 + Rel[1]) * Mult, Param2);
end;
end // if
- Else if TempC = 'B' then
+ else if TempC = 'B' then
begin
SetLength(self.BPM, Length(self.BPM) + 1);
Read(SongFile, self.BPM[High(self.BPM)].StartBeat);
@@ -338,42 +381,7 @@ begin
self.BPM[High(self.BPM)].BPM := self.BPM[High(self.BPM)].BPM * Mult * MultBPM;
end;
-
- if not Both then
- begin
- Lines[CP].Line[Lines[CP].High].BaseNote := Base[CP];
- Lines[CP].Line[Lines[CP].High].LyricWidth := glTextWidth(Lines[CP].Line[Lines[CP].High].Lyric);
- //Total Notes Patch
- Lines[CP].Line[Lines[CP].High].TotalNotes := 0;
- for I := low(Lines[CP].Line[Lines[CP].High].Note) to high(Lines[CP].Line[Lines[CP].High].Note) do
- begin
- if (Lines[CP].Line[Lines[CP].High].Note[I].NoteType = ntGolden) then
- Lines[CP].Line[Lines[CP].High].TotalNotes := Lines[CP].Line[Lines[CP].High].TotalNotes + Lines[CP].Line[Lines[CP].High].Note[I].Length;
-
- if (Lines[CP].Line[Lines[CP].High].Note[I].NoteType <> ntFreestyle) then
- Lines[CP].Line[Lines[CP].High].TotalNotes := Lines[CP].Line[Lines[CP].High].TotalNotes + Lines[CP].Line[Lines[CP].High].Note[I].Length;
- end;
- //Total Notes Patch End
- end
- else
- begin
- for Count := 0 to High(Lines) do
- begin
- Lines[Count].Line[Lines[Count].High].BaseNote := Base[Count];
- Lines[Count].Line[Lines[Count].High].LyricWidth := glTextWidth(Lines[Count].Line[Lines[Count].High].Lyric);
- //Total Notes Patch
- Lines[Count].Line[Lines[Count].High].TotalNotes := 0;
- for I := low(Lines[Count].Line[Lines[Count].High].Note) to high(Lines[Count].Line[Lines[Count].High].Note) do
- begin
- if (Lines[Count].Line[Lines[Count].High].Note[I].NoteType = ntGolden) then
- Lines[Count].Line[Lines[Count].High].TotalNotes := Lines[Count].Line[Lines[Count].High].TotalNotes + Lines[Count].Line[Lines[Count].High].Note[I].Length;
- if (Lines[Count].Line[Lines[Count].High].Note[I].NoteType <> ntFreestyle) then
- Lines[Count].Line[Lines[Count].High].TotalNotes := Lines[Count].Line[Lines[Count].High].TotalNotes + Lines[Count].Line[Lines[Count].High].Note[I].Length;
- end;
- //Total Notes Patch End
- end;
- end;
- ReadLn(SongFile); //Jump to next line in File, otherwise the next Read would catch the linebreak(e.g. #13 #10 on win32)
+ ReadLn(SongFile); //Jump to next line in File, otherwise the next Read would catch the linebreak(e.g. #13 #10 on win32)
Read(SongFile, TempC);
Inc(FileLineNo);
@@ -381,18 +389,18 @@ begin
CloseFile(SongFile);
- For I := 0 to High(Lines) do
+ for I := 0 to High(Lines) do
begin
- If ((Both) or (I = 0)) then
+ if ((Both) or (I = 0)) then
begin
- If (Length(Lines[I].Line) < 2) then
+ if (Length(Lines[I].Line) < 2) then
begin
LastError := 'ERROR_CORRUPT_SONG_NO_BREAKS';
Log.LogError('Error Loading File, Can''t find any Linebreaks: "' + fFileName + '"');
exit;
end;
- If (Lines[I].Line[Lines[I].High].HighNote < 0) then
+ 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;
@@ -404,8 +412,8 @@ begin
for Count := 0 to High(Lines) do
begin
- If (High(Lines[Count].Line) >= 0) then
- Lines[Count].Line[High(Lines[Count].Line)].LastLine := True;
+ if (High(Lines[Count].Line) >= 0) then
+ Lines[Count].Line[High(Lines[Count].Line)].LastLine := true;
end;
except
try
@@ -452,7 +460,6 @@ begin
MultBPM := 4; // multiply beat-count of note by 4
Mult := 1; // accuracy of measurement of note
- Base[0] := 100; // high number
Lines[0].ScoreValue := 0;
self.Relative := false;
Rel[0] := 0;
@@ -467,14 +474,21 @@ begin
for Count := 0 to High(Lines) do
begin
- SetLength(Lines[Count].Line, 1);
Lines[Count].High := 0;
- Lines[Count].Number := 1;
- Lines[Count].Current := 0;
- Lines[Count].Resolution := self.Resolution;
- Lines[Count].NotesGAP := self.NotesGAP;
- Lines[Count].Line[0].HighNote := -1;
- Lines[Count].Line[0].LastLine := False;
+ 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
@@ -482,7 +496,7 @@ begin
if Parser.ParseSong(Path + PathDelim + FileName) then
begin
//Writeln('XML Inputfile Parsed succesful');
-
+
//Start write parsed information to Song
//Notes Part
for I := 0 to High(Parser.SongInfo.Sentences) do
@@ -491,8 +505,8 @@ begin
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_Normal: NoteType := ':';
+ NT_Golden: NoteType := '*';
NT_Freestyle: NoteType := 'F';
end;
@@ -511,42 +525,6 @@ begin
ParseNote(1, NoteType, (Param1+Rel[1]) * Mult, Param2 * Mult, Param3, ParamS);
end;
- if not Both then
- begin
- Lines[CP].Line[Lines[CP].High].BaseNote := Base[CP];
- Lines[CP].Line[Lines[CP].High].LyricWidth := glTextWidth(Lines[CP].Line[Lines[CP].High].Lyric);
- //Total Notes Patch
- Lines[CP].Line[Lines[CP].High].TotalNotes := 0;
- for NoteIndex := 0 to high(Lines[CP].Line[Lines[CP].High].Note) do
- begin
- if (Lines[CP].Line[Lines[CP].High].Note[NoteIndex].NoteType = ntGolden) then
- Lines[CP].Line[Lines[CP].High].TotalNotes := Lines[CP].Line[Lines[CP].High].TotalNotes + Lines[CP].Line[Lines[CP].High].Note[NoteIndex].Length;
-
- if (Lines[CP].Line[Lines[CP].High].Note[NoteIndex].NoteType <> ntFreestyle) then
- Lines[CP].Line[Lines[CP].High].TotalNotes := Lines[CP].Line[Lines[CP].High].TotalNotes + Lines[CP].Line[Lines[CP].High].Note[NoteIndex].Length;
- end;
- //Total Notes Patch End
- end
- else
- begin
- for Count := 0 to High(Lines) do
- begin
- Lines[Count].Line[Lines[Count].High].BaseNote := Base[Count];
- Lines[Count].Line[Lines[Count].High].LyricWidth := glTextWidth(Lines[Count].Line[Lines[Count].High].Lyric);
- //Total Notes Patch
- Lines[Count].Line[Lines[Count].High].TotalNotes := 0;
- for NoteIndex := 0 to high(Lines[Count].Line[Lines[Count].High].Note) do
- begin
- if (Lines[Count].Line[Lines[Count].High].Note[NoteIndex].NoteType = ntGolden) then
- Lines[Count].Line[Lines[Count].High].TotalNotes := Lines[Count].Line[Lines[Count].High].TotalNotes + Lines[Count].Line[Lines[Count].High].Note[NoteIndex].Length;
- if (Lines[Count].Line[Lines[Count].High].Note[NoteIndex].NoteType <> ntFreestyle) then
- Lines[Count].Line[Lines[Count].High].TotalNotes := Lines[Count].Line[Lines[Count].High].TotalNotes + Lines[Count].Line[Lines[Count].High].Note[NoteIndex].Length;
-
- end;
- //Total Notes Patch End
- end;
- end; { end of for loop }
-
end; //J Forloop
//Add Sentence break
@@ -558,8 +536,8 @@ begin
//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;
+ 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
@@ -588,7 +566,7 @@ begin
for Count := 0 to High(Lines) do
begin
- Lines[Count].Line[High(Lines[Count].Line)].LastLine := True;
+ Lines[Count].Line[High(Lines[Count].Line)].LastLine := true;
end;
Result := true;
@@ -670,7 +648,8 @@ begin
//Language Sorting
self.Language := Parser.SongInfo.Header.Language;
- end else
+ end
+ else
Log.LogError('File Incomplete or not SingStar XML (A): ' + aFileName);
Parser.Free;
@@ -678,7 +657,7 @@ begin
//Check if all Required Values are given
if (Done <> 15) then
begin
- Result := False;
+ Result := false;
if (Done and 8) = 0 then //No BPM Flag
Log.LogError('BPM Tag Missing: ' + self.FileName)
else if (Done and 4) = 0 then //No MP3 Flag
@@ -700,7 +679,7 @@ function TSong.ReadTXTHeader(const aFileName : WideString): boolean;
* "International" StrToFloat variant. Uses either ',' or '.' as decimal
* separator.
*}
- function StrToFloatI18n(const Value: string): Extended;
+ function StrToFloatI18n(const Value: string): extended;
var
TempValue : string;
begin
@@ -727,7 +706,7 @@ begin
begin
Log.LogError('File Starts with Empty Line: ' + Path + PathDelim + aFileName,
'TSong.ReadTXTHeader');
- Result := False;
+ Result := false;
Exit;
end;
@@ -736,8 +715,7 @@ begin
Encoding := encUTF8;
//Read Lines while Line starts with # or its empty
- while (Length(Line) = 0) or
- (Line[1] = '#') do
+ while (Length(Line) = 0) or (Line[1] = '#') do
begin
//Increase Line Number
Inc (FileLineNo);
@@ -898,7 +876,7 @@ begin
else if (Identifier = 'RELATIVE') then
begin
if (UpperCase(Value) = 'YES') then
- self.Relative := True;
+ self.Relative := true;
end
// File encoding
@@ -912,7 +890,7 @@ begin
// check for end of file
if Eof(SongFile) then
begin
- Result := False;
+ Result := false;
Log.LogError('File Incomplete or not Ultrastar TxT (A): ' + aFileName);
Break;
end;
@@ -927,7 +905,7 @@ begin
//Check if all Required Values are given
if (Done <> 15) then
begin
- Result := False;
+ Result := false;
if (Done and 8) = 0 then //No BPM Flag
Log.LogError('BPM Tag Missing: ' + self.FileName)
else if (Done and 4) = 0 then //No MP3 Flag
@@ -942,11 +920,11 @@ begin
end;
-Function TSong.GetErrorLineNo: Integer;
+function TSong.GetErrorLineNo: integer;
begin
- If (LastError='ERROR_CORRUPT_SONG_ERROR_IN_LINE') then
+ if (LastError='ERROR_CORRUPT_SONG_ERROR_IN_LINE') then
Result := FileLineNo
- Else
+ else
Result := -1;
end;
@@ -1001,7 +979,7 @@ begin
begin
SetLength(Note, Length(Note) + 1);
HighNote := High(Note);
-
+
Note[HighNote].Start := StartP;
if HighNote = 0 then
begin
@@ -1019,18 +997,28 @@ begin
'*': Note[HighNote].NoteType := ntGolden;
end;
- if (Note[HighNote].NoteType = ntGolden) then
- Lines[LineNumber].ScoreValue := Lines[LineNumber].ScoreValue + Note[HighNote].Length;
-
- if (Note[HighNote].NoteType <> ntFreestyle) then
- Lines[LineNumber].ScoreValue := Lines[LineNumber].ScoreValue + Note[HighNote].Length;
+ //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 Note[HighNote].Tone < Base[LineNumber] then Base[LineNumber] := Note[HighNote].Tone;
- Note[HighNote].Text := RecodeStringUTF8(
- Copy(LyricS, 2, Length(LyricS)-1),
- Encoding);
+ //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;
+
+ //delete the space that seperates the notes pitch from its lyrics
+ //it is left in the LyricS string because Read("some ordinal type") will
+ //set the files pointer to the first whitespace character after the
+ //ordinal string. Trim is no solution because it would cut the spaces
+ //that seperate the words of the lyrics, too.
+ Delete(LyricS, 1, 1);
+
+ Note[HighNote].Text := RecodeStringUTF8(LyricS, Encoding);
Lyric := Lyric + Note[HighNote].Text;
End_ := Note[HighNote].Start + Note[HighNote].Length;
@@ -1042,37 +1030,30 @@ var
I: integer;
begin
- If (Lines[LineNumberP].Line[Lines[LineNumberP].High].HighNote <> -1) then
- begin //Update old Sentence if it has notes and create a new sentence
- // stara czesc //Alter Satz //Update Old Part
- Lines[LineNumberP].Line[Lines[LineNumberP].High].BaseNote := Base[LineNumberP];
- Lines[LineNumberP].Line[Lines[LineNumberP].High].LyricWidth := glTextWidth(Lines[LineNumberP].Line[Lines[LineNumberP].High].Lyric);
-
- //Total Notes Patch
- Lines[LineNumberP].Line[Lines[LineNumberP].High].TotalNotes := 0;
- for I := low(Lines[LineNumberP].Line[Lines[LineNumberP].High].Note) to high(Lines[LineNumberP].Line[Lines[LineNumberP].High].Note) do
- begin
- if (Lines[LineNumberP].Line[Lines[LineNumberP].High].Note[I].NoteType = ntGolden) then
- Lines[LineNumberP].Line[Lines[LineNumberP].High].TotalNotes := Lines[LineNumberP].Line[Lines[LineNumberP].High].TotalNotes + Lines[LineNumberP].Line[Lines[LineNumberP].High].Note[I].Length;
-
- if (Lines[LineNumberP].Line[Lines[LineNumberP].High].Note[I].NoteType <> ntFreestyle) then
- Lines[LineNumberP].Line[Lines[LineNumberP].High].TotalNotes := Lines[LineNumberP].Line[Lines[LineNumberP].High].TotalNotes + Lines[LineNumberP].Line[Lines[LineNumberP].High].Note[I].Length;
- end;
- //Total Notes Patch End
-
-
- // nowa czesc //Neuer Satz //Update New Part
+ if (Lines[LineNumberP].Line[Lines[LineNumberP].High].HighNote <> -1) then
+ begin //create a new line
SetLength(Lines[LineNumberP].Line, Lines[LineNumberP].Number + 1);
- Lines[LineNumberP].High := Lines[LineNumberP].High + 1;
- Lines[LineNumberP].Number := Lines[LineNumberP].Number + 1;
+ Inc(Lines[LineNumberP].High);
+ Inc(Lines[LineNumberP].Number);
end
else
- begin //Use old Sentence if it has no notes
+ 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);
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;
@@ -1081,9 +1062,7 @@ begin
else
Lines[LineNumberP].Line[Lines[LineNumberP].High].Start := Param1;
- Lines[LineNumberP].Line[Lines[LineNumberP].High].LastLine := False;
-
- Base[LineNumberP] := 100; // high number
+ Lines[LineNumberP].Line[Lines[LineNumberP].High].LastLine := false;
end;
procedure TSong.clear();
@@ -1122,13 +1101,13 @@ begin
Resolution := 4;
Creator := '';
+ Relative := false;
end;
-
function TSong.Analyse(): boolean;
begin
- Result := False;
+ Result := false;
//Reset LineNo
FileLineNo := 0;
@@ -1155,7 +1134,7 @@ end;
function TSong.AnalyseXML(): boolean;
begin
- Result := False;
+ Result := false;
//Reset LineNo
FileLineNo := 0;
diff --git a/unicode/src/base/USongs.pas b/unicode/src/base/USongs.pas
index ac67eed0..852ccfc4 100644
--- a/unicode/src/base/USongs.pas
+++ b/unicode/src/base/USongs.pas
@@ -158,11 +158,13 @@ implementation
uses
StrUtils,
- UGraphic,
UCovers,
UFiles,
+ UGraphic,
UMain,
UIni,
+ UPath,
+ UNote,
UUnicodeUtils;
constructor TSongs.Create();
@@ -282,7 +284,11 @@ var
lSong : TSong;
begin
- Files := Platform.DirectoryFindFiles( Dir, '.txt', true);
+ try
+ Files := Platform.DirectoryFindFiles( Dir, '.txt', true)
+ except
+ Log.LogError('Couldn''t deal with directory/file: ' + Dir + ' in TSongs.BrowseTXTFiles')
+ end;
for i := 0 to Length(Files)-1 do
begin
@@ -315,7 +321,11 @@ var
lSong : TSong;
begin
- Files := Platform.DirectoryFindFiles( Dir, '.xml', true);
+ try
+ Files := Platform.DirectoryFindFiles( Dir, '.xml', true)
+ except
+ Log.LogError('Couldn''t deal with directory/file: ' + Dir + ' in TSongs.BrowseXMLFiles')
+ end;
for i := 0 to Length(Files)-1 do
begin
@@ -670,7 +680,7 @@ begin
end;
// set CatNumber of last category
- if (Ini.Tabs_at_startup = 1) and (High(Song) >= 1) then
+ if (Ini.TabsAtStartup = 1) and (High(Song) >= 1) then
begin
// set number of songs in previous category
SongIndex := CatIndex - CatNumber;
diff --git a/unicode/src/base/UTexture.pas b/unicode/src/base/UTexture.pas
index 4f33b78a..962bd2b0 100644
--- a/unicode/src/base/UTexture.pas
+++ b/unicode/src/base/UTexture.pas
@@ -93,7 +93,7 @@ type
TTextureEntry = record
Name: string;
Typ: TTextureType;
- Color: Cardinal;
+ Color: cardinal;
// we use normal TTexture, it's easier to implement and if needed - we copy ready data
Texture: TTexture; // Full-size texture
@@ -104,8 +104,8 @@ type
private
Texture: array of TTextureEntry;
public
- procedure AddTexture(var Tex: TTexture; Typ: TTextureType; Color: Cardinal; Cache: boolean);
- function FindTexture(const Name: string; Typ: TTextureType; Color: Cardinal): integer;
+ procedure AddTexture(var Tex: TTexture; Typ: TTextureType; Color: cardinal; Cache: boolean);
+ function FindTexture(const Name: string; Typ: TTextureType; Color: cardinal): integer;
end;
TTextureUnit = class
@@ -115,7 +115,7 @@ type
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;
+ procedure AddTexture(var Tex: TTexture; Typ: TTextureType; Color: cardinal; Cache: boolean = false); overload;
function GetTexture(const Name: string; Typ: TTextureType; FromCache: boolean = false): TTexture; overload;
function GetTexture(const Name: string; Typ: TTextureType; Col: LongWord; FromCache: boolean = false): TTexture; overload;
function LoadTexture(FromRegistry: boolean; const Identifier: string; Typ: TTextureType; Col: LongWord): TTexture; overload;
@@ -123,7 +123,7 @@ type
function LoadTexture(const Identifier: string): TTexture; overload;
function CreateTexture(Data: PChar; const Name: string; Width, Height: word; BitsPerPixel: byte): TTexture;
procedure UnloadTexture(const Name: string; Typ: TTextureType; FromCache: boolean); overload;
- procedure UnloadTexture(const Name: string; Typ: TTextureType; Col: Cardinal; FromCache: boolean); overload;
+ procedure UnloadTexture(const Name: string; Typ: TTextureType; Col: cardinal; FromCache: boolean); overload;
//procedure FlushTextureDatabase();
constructor Create;
@@ -164,10 +164,10 @@ begin
SDL_FreeSurface(TempSurface);
end;
end;
-
+
{ TTextureDatabase }
-procedure TTextureDatabase.AddTexture(var Tex: TTexture; Typ: TTextureType; Color: Cardinal; Cache: boolean);
+procedure TTextureDatabase.AddTexture(var Tex: TTexture; Typ: TTextureType; Color: cardinal; Cache: boolean);
var
TextureIndex: integer;
begin
@@ -188,7 +188,7 @@ begin
Texture[TextureIndex].Texture := Tex;
end;
-function TTextureDatabase.FindTexture(const Name: string; Typ: TTextureType; Color: Cardinal): integer;
+function TTextureDatabase.FindTexture(const Name: string; Typ: TTextureType; Color: cardinal): integer;
var
TextureIndex: integer;
CurrentTexture: PTextureEntry;
@@ -211,7 +211,6 @@ begin
end;
end;
-
{ TTextureUnit }
constructor TTextureUnit.Create;
@@ -226,13 +225,12 @@ begin
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);
+procedure TTextureUnit.AddTexture(var Tex: TTexture; Typ: TTextureType; Color: cardinal; Cache: boolean);
begin
TextureDatabase.AddTexture(Tex, Typ, Color, Cache);
end;
@@ -251,8 +249,8 @@ end;
function TTextureUnit.LoadTexture(const Identifier: string; Typ: TTextureType; Col: LongWord): TTexture;
var
TexSurface: PSDL_Surface;
- newWidth, newHeight: Cardinal;
- oldWidth, oldHeight: Cardinal;
+ newWidth, newHeight: integer;
+ oldWidth, oldHeight: integer;
ActTex: GLuint;
begin
// zero texture data
@@ -431,8 +429,8 @@ begin
{$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]);
@@ -440,8 +438,8 @@ begin
if Error > 0 then
Log.LogError('gluBuild2DMipmaps() failed', 'TTextureUnit.CreateTexture');
end;
- }
-
+}
+
Result.X := 0;
Result.Y := 0;
Result.Z := 0;
@@ -474,14 +472,14 @@ begin
UnloadTexture(Name, Typ, 0, FromCache);
end;
-procedure TTextureUnit.UnloadTexture(const Name: string; Typ: TTextureType; Col: Cardinal; FromCache: boolean);
+procedure TTextureUnit.UnloadTexture(const Name: string; Typ: TTextureType; Col: cardinal; FromCache: boolean);
var
T: integer;
TexNum: GLuint;
begin
T := TextureDatabase.FindTexture(Name, Typ, Col);
- if not FromCache then
+ if not FromCache then
begin
TexNum := TextureDatabase.Texture[T].Texture.TexNum;
if TexNum > 0 then
@@ -529,20 +527,20 @@ end;
function ParseTextureType(const TypeStr: string; Default: TTextureType): TTextureType;
var
- TexType: TTextureType;
+ TextureType: TTextureType;
UpCaseStr: string;
begin
UpCaseStr := UpperCase(TypeStr);
- for TexType := Low(TextureTypeStr) to High(TextureTypeStr) do
+ for TextureType := Low(TextureTypeStr) to High(TextureTypeStr) do
begin
- if (UpCaseStr = UpperCase(TextureTypeStr[TexType])) then
+ if (UpCaseStr = UpperCase(TextureTypeStr[TextureType])) then
begin
- Result := TexType;
+ Result := TextureType;
Exit;
end;
end;
- Log.LogWarn('Unknown texture-type: "' + TypeStr + '"', 'ParseTextureType');
- Result := TEXTURE_TYPE_PLAIN;
+ Log.LogWarn('Unknown texture type: "' + TypeStr + '". Using default texture type "' + TextureTypeToStr(Default) + '"', 'ParseTextureType');
+ Result := Default;
end;
end.
diff --git a/unicode/src/base/UThemes.pas b/unicode/src/base/UThemes.pas
index 361ed87d..9bf858ed 100644
--- a/unicode/src/base/UThemes.pas
+++ b/unicode/src/base/UThemes.pas
@@ -484,6 +484,16 @@ type
ButtonExit: TThemeButton;
end;
+ TThemeEdit = class(TThemeBasic)
+ ButtonConvert: TThemeButton;
+ ButtonExit: TThemeButton;
+
+ TextDescription: TThemeText;
+ TextDescriptionLong: TThemeText;
+ Description: array[0..5] of string;
+ DescriptionLong: array[0..5] of string;
+ end;
+
//Error- and Check-Popup
TThemeError = class(TThemeBasic)
Button1: TThemeButton;
@@ -723,6 +733,8 @@ type
OptionsThemes: TThemeOptionsThemes;
OptionsRecord: TThemeOptionsRecord;
OptionsAdvanced: TThemeOptionsAdvanced;
+ //edit
+ Edit: TThemeEdit;
//error and check popup
ErrorPopup: TThemeError;
CheckPopup: TThemeCheck;
@@ -852,6 +864,8 @@ begin
OptionsRecord := TThemeOptionsRecord.Create;
OptionsAdvanced := TThemeOptionsAdvanced.Create;
+ Edit := TThemeEdit.Create;
+
ErrorPopup := TThemeError.Create;
CheckPopup := TThemeCheck.Create;
@@ -1246,6 +1260,18 @@ begin
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');
@@ -2310,6 +2336,9 @@ begin
freeandnil(OptionsAdvanced);
OptionsAdvanced := TThemeOptionsAdvanced.Create;
+ freeandnil(Edit);
+ Edit := TThemeEdit.Create;
+
freeandnil(ErrorPopup);
ErrorPopup := TThemeError.Create;
diff --git a/unicode/src/lib/JEDI-SDL/OpenGL/Pas/gl.pas b/unicode/src/lib/JEDI-SDL/OpenGL/Pas/gl.pas
index 2dc99df5..d1231cdd 100644
--- a/unicode/src/lib/JEDI-SDL/OpenGL/Pas/gl.pas
+++ b/unicode/src/lib/JEDI-SDL/OpenGL/Pas/gl.pas
@@ -131,7 +131,7 @@ const
{$IFDEF DARWIN}
GLLibName = '/System/Library/Frameworks/OpenGL.framework/Libraries/libGL.dylib';
{$ELSE}
- GLLibName = 'libGL.so';
+ GLLibName = 'libGL.so.1';
{$ENDIF}
{$ENDIF}
diff --git a/unicode/src/lib/JEDI-SDL/OpenGL/Pas/glu.pas b/unicode/src/lib/JEDI-SDL/OpenGL/Pas/glu.pas
index 29647d12..876270ff 100644
--- a/unicode/src/lib/JEDI-SDL/OpenGL/Pas/glu.pas
+++ b/unicode/src/lib/JEDI-SDL/OpenGL/Pas/glu.pas
@@ -140,7 +140,7 @@ const
{$IFDEF DARWIN}
GLuLibName = '/System/Library/Frameworks/OpenGL.framework/Libraries/libGLU.dylib';
{$ELSE}
- GLuLibName = 'libGLU.so';
+ GLuLibName = 'libGLU.so.1';
{$ENDIF}
{$ENDIF}
diff --git a/unicode/src/lib/JEDI-SDL/OpenGL/Pas/glx.pas b/unicode/src/lib/JEDI-SDL/OpenGL/Pas/glx.pas
index f43a4e4c..9f36d2b5 100644
--- a/unicode/src/lib/JEDI-SDL/OpenGL/Pas/glx.pas
+++ b/unicode/src/lib/JEDI-SDL/OpenGL/Pas/glx.pas
@@ -266,8 +266,7 @@ end;
function InitGLX: Boolean;
begin
- Result := InitGLXFromLibrary('libGL.so') or
- InitGLXFromLibrary('libGL.so.1') or
+ Result := InitGLXFromLibrary('libGL.so.1') or
InitGLXFromLibrary('libMesaGL.so') or
InitGLXFromLibrary('libMesaGL.so.3');
end;
diff --git a/unicode/src/lib/collections/CollArray.pas b/unicode/src/lib/collections/CollArray.pas
new file mode 100644
index 00000000..a10ba905
--- /dev/null
+++ b/unicode/src/lib/collections/CollArray.pas
@@ -0,0 +1,183 @@
+unit CollArray;
+
+(*****************************************************************************
+ * Copyright 2003 by Matthew Greet
+ * This library is free software; you can redistribute it and/or modify it
+ * under the terms of the GNU Lesser General Public License as published by the
+ * Free Software Foundation; either version 2.1 of the License, or (at your
+ * option) any later version.
+ *
+ * This library 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 Lesser General Public License for more
+ * details. (http://opensource.org/licenses/lgpl-license.php)
+ *
+ * See http://www.warmachine.u-net.com/delphi_collections for updates and downloads.
+ *
+ * $Version: v1.0.3 $
+ * $Revision: 1.2 $
+ * $Log: D:\QVCS Repositories\Delphi Collections\CollArray.qbt $
+ *
+ * Colllection implementations based on arrays.
+ *
+ * Revision 1.2 by: Matthew Greet Rev date: 12/06/04 20:02:16
+ * Capacity property.
+ *
+ * Revision 1.1 by: Matthew Greet Rev date: 06/04/03 10:30:36
+ * Size property dropped.
+ * Unused abstract functions still implemented.
+ *
+ * Revision 1.0 by: Matthew Greet Rev date: 01/03/03 10:50:02
+ * Initial revision.
+ *
+ * FPC compatibility fixes by: UltraStar Deluxe Team
+ *
+ * $Endlog$
+ *****************************************************************************)
+
+{$IFDEF FPC}
+ {$MODE Delphi}{$H+}
+{$ENDIF}
+
+interface
+
+uses
+ Collections;
+
+type
+ TArray = class(TAbstractList)
+ private
+ FArray: array of ICollectable;
+ protected
+ function TrueGetItem(Index: Integer): ICollectable; override;
+ procedure TrueSetItem(Index: Integer; const Value: ICollectable); override;
+ procedure TrueAppend(const Item: ICollectable); override;
+ procedure TrueClear; override;
+ function TrueDelete(Index: Integer): ICollectable; override;
+ procedure TrueInsert(Index: Integer; const Item: ICollectable); override;
+ public
+ constructor Create(NaturalItemsOnly: Boolean); override;
+ constructor Create(const ItemArray: array of ICollectable; NaturalItemsOnly: Boolean = false); override;
+ constructor Create(Size: Integer; NaturalItemsOnly: Boolean = false); overload; virtual;
+ constructor Create(const Collection: ICollection); override;
+ destructor Destroy; override;
+ function GetCapacity: Integer; override;
+ procedure SetCapacity(Value: Integer); override;
+ function GetFixedSize: Boolean; override;
+ function GetSize: Integer; override;
+ end;
+
+implementation
+
+constructor TArray.Create(NaturalItemsOnly: Boolean);
+begin
+ Create(0, NaturalItemsOnly);
+end;
+
+constructor TArray.Create(Size: Integer; NaturalItemsOnly: Boolean = false);
+begin
+ inherited Create(NaturalItemsOnly);
+ SetLength(FArray, Size);
+end;
+
+constructor TArray.Create(const ItemArray: array of ICollectable; NaturalItemsOnly: Boolean);
+var
+ Item: ICollectable;
+ ItemError: TCollectionError;
+ I: Integer;
+begin
+ inherited Create(ItemArray, NaturalItemsOnly);
+ SetLength(FArray, Length(ItemArray));
+ for I := Low(ItemArray) to High(ItemArray) do
+ begin
+ Item := ItemArray[I];
+ ItemError := ItemAllowed(Item);
+ if ItemError <> ceOK then
+ begin
+ CollectionError(ItemError);
+ end
+ else
+ Items[I] := Item;
+ end;
+end;
+
+constructor TArray.Create(const Collection: ICollection);
+var
+ Iterator: IIterator;
+ I: Integer;
+begin
+ inherited Create(Collection);
+ SetLength(FArray, Collection.GetSize);
+ Iterator := Collection.GetIterator;
+ I := 0;
+ while not Iterator.EOF do
+ begin
+ Items[I] := Iterator.CurrentItem;
+ Inc(I);
+ Iterator.Next;
+ end;
+end;
+
+destructor TArray.Destroy;
+var
+ I: Integer;
+begin
+ // Delete interface references to all items
+ for I := Low(FArray) to High(FArray) do
+ begin
+ FArray[I] := nil;
+ end;
+ inherited Destroy;
+end;
+
+function TArray.TrueGetItem(Index: Integer): ICollectable;
+begin
+ Result := FArray[Index];
+end;
+
+procedure TArray.TrueSetItem(Index: Integer; const Value: ICollectable);
+begin
+ FArray[Index] := Value;
+end;
+
+procedure TArray.TrueAppend(const Item: ICollectable);
+begin
+ // Ignored as collection is fixed size
+end;
+
+procedure TArray.TrueClear;
+begin
+ // Ignored as collection is fixed size
+end;
+
+function TArray.TrueDelete(Index: Integer): ICollectable;
+begin
+ // Ignored as collection is fixed size
+end;
+
+procedure TArray.TrueInsert(Index: Integer; const Item: ICollectable);
+begin
+ // Ignored as collection is fixed size
+end;
+
+function TArray.GetCapacity: Integer;
+begin
+ Result := Size;
+end;
+
+procedure TArray.SetCapacity(Value: Integer);
+begin
+ // Ignored
+end;
+
+function TArray.GetFixedSize: Boolean;
+begin
+ Result := true;
+end;
+
+function TArray.GetSize: Integer;
+begin
+ Result := Length(FArray);
+end;
+
+end.
diff --git a/unicode/src/lib/collections/CollHash.pas b/unicode/src/lib/collections/CollHash.pas
new file mode 100644
index 00000000..796fc740
--- /dev/null
+++ b/unicode/src/lib/collections/CollHash.pas
@@ -0,0 +1,1497 @@
+unit CollHash;
+
+(*****************************************************************************
+ * Copyright 2003 by Matthew Greet
+ * This library is free software; you can redistribute it and/or modify it
+ * under the terms of the GNU Lesser General Public License as published by the
+ * Free Software Foundation; either version 2.1 of the License, or (at your
+ * option) any later version.
+ *
+ * This library 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 Lesser General Public License for more
+ * details. (http://opensource.org/licenses/lgpl-license.php)
+ *
+ * See http://www.warmachine.u-net.com/delphi_collections for updates and downloads.
+ *
+ * $Version: v1.0.3 $
+ * $Revision: 1.1.1.2 $
+ * $Log: D:\QVCS Repositories\Delphi Collections\CollHash.qbt $
+ *
+ * Collection implementations based on hash tables.
+ *
+ * Revision 1.1.1.2 by: Matthew Greet Rev date: 12/06/04 20:04:30
+ * Capacity property.
+ *
+ * Revision 1.1.1.1 by: Matthew Greet Rev date: 24/10/03 16:48:16
+ * v1.0 branch.
+ *
+ * Revision 1.1 by: Matthew Greet Rev date: 06/04/03 10:40:16
+ * Added integer map and string map versions.
+ * THashSet uses its own implementation, not THashMap.
+ * DefaulMaxLoadFactor changed.
+ *
+ * Revision 1.0 by: Matthew Greet Rev date: 01/03/03 10:50:02
+ * Initial revision.
+ *
+ * FPC compatibility fixes by: UltraStar Deluxe Team
+ *
+ * $Endlog$
+ *****************************************************************************)
+
+{$IFDEF FPC}
+ {$MODE Delphi}{$H+}
+{$ENDIF}
+
+interface
+
+uses
+ Classes, Math,
+ Collections;
+
+const
+ DefaultTableSize = 100;
+ MaxLoadFactorMin = 0.01; // Minimum allowed value for MaxLoadFactor property.
+ DefaultMaxLoadFactor = 5.0;
+
+type
+ THashMap = class(TAbstractMap)
+ private
+ FArray: TListArray;
+ FCapacity: Integer;
+ FMaxLoadFactor: Double;
+ FSize: Integer;
+ FTableSize: Integer;
+ protected
+ function GetAssociationIterator: IMapIterator; override;
+ procedure SetMaxLoadFactor(Value: Double); virtual;
+ procedure SetTableSize(Value: Integer); virtual;
+ procedure ChangeCapacity(Value: TListArray); virtual;
+ procedure CheckLoadFactor(AlwaysChangeCapacity: Boolean); virtual;
+ function GetHash(const Key: ICollectable): Integer; virtual;
+ function GetKeyPosition(const Key: ICollectable): TCollectionPosition; override;
+ procedure Rehash;
+ procedure TrueClear; override;
+ function TrueGet(Position: TCollectionPosition): IAssociation; override;
+ function TruePut(Position: TCollectionPosition; const Association: IAssociation): IAssociation; override;
+ function TrueRemove2(Position: TCollectionPosition): IAssociation; override;
+ public
+ constructor Create(NaturalItemsOnly: Boolean; NaturalKeysOnly: Boolean); override;
+ destructor Destroy; override;
+ class function GetAlwaysNaturalKeys: Boolean; override;
+ function GetCapacity: Integer; override;
+ procedure SetCapacity(Value: Integer); override;
+ function GetNaturalKeyIID: TGUID; override;
+ function GetSize: Integer; override;
+ property MaxLoadFactor: Double read FMaxLoadFactor write SetMaxLoadFactor;
+ property TableSize: Integer read FTableSize write SetTableSize;
+ end;
+
+ THashSet = class(TAbstractSet)
+ private
+ FArray: TListArray;
+ FCapacity: Integer;
+ FMaxLoadFactor: Double;
+ FSize: Integer;
+ FTableSize: Integer;
+ protected
+ procedure SetMaxLoadFactor(Value: Double); virtual;
+ procedure SetTableSize(Value: Integer); virtual;
+ procedure ChangeCapacity(Value: TListArray); virtual;
+ procedure CheckLoadFactor(AlwaysChangeCapacity: Boolean); virtual;
+ function GetHash(const Item: ICollectable): Integer; virtual;
+ function GetPosition(const Item: ICollectable): TCollectionPosition; override;
+ procedure Rehash;
+ procedure TrueAdd2(Position: TCollectionPosition; const Item: ICollectable); override;
+ procedure TrueClear; override;
+ function TrueGet(Position: TCollectionPosition): ICollectable; override;
+ procedure TrueRemove2(Position: TCollectionPosition); override;
+ public
+ constructor Create(NaturalItemsOnly: Boolean); override;
+ destructor Destroy; override;
+ class function GetAlwaysNaturalItems: Boolean; override;
+ function GetCapacity: Integer; override;
+ procedure SetCapacity(Value: Integer); override;
+ function GetIterator: IIterator; override;
+ function GetNaturalItemIID: TGUID; override;
+ function GetSize: Integer; override;
+ property MaxLoadFactor: Double read FMaxLoadFactor write SetMaxLoadFactor;
+ property TableSize: Integer read FTableSize write SetTableSize;
+ end;
+
+ THashIntegerMap = class(TAbstractIntegerMap)
+ private
+ FArray: TListArray;
+ FCapacity: Integer;
+ FMaxLoadFactor: Double;
+ FSize: Integer;
+ FTableSize: Integer;
+ protected
+ function GetAssociationIterator: IIntegerMapIterator; override;
+ procedure SetMaxLoadFactor(Value: Double); virtual;
+ procedure SetTableSize(Value: Integer); virtual;
+ procedure ChangeCapacity(Value: TListArray); virtual;
+ procedure CheckLoadFactor(AlwaysChangeCapacity: Boolean); virtual;
+ function GetHash(const Key: Integer): Integer; virtual;
+ function GetKeyPosition(const Key: Integer): TCollectionPosition; override;
+ procedure Rehash;
+ procedure TrueClear; override;
+ function TrueGet(Position: TCollectionPosition): IIntegerAssociation; override;
+ function TruePut(Position: TCollectionPosition; const Association: IIntegerAssociation): IIntegerAssociation; override;
+ function TrueRemove2(Position: TCollectionPosition): IIntegerAssociation; override;
+ public
+ constructor Create; override;
+ constructor Create(NaturalItemsOnly: Boolean); override;
+ constructor Create(NaturalItemsOnly: Boolean; TableSize: Integer; MaxLoadFactor: Double = DefaultMaxLoadFactor); overload; virtual;
+ destructor Destroy; override;
+ function GetCapacity: Integer; override;
+ procedure SetCapacity(Value: Integer); override;
+ function GetSize: Integer; override;
+ property MaxLoadFactor: Double read FMaxLoadFactor write SetMaxLoadFactor;
+ property TableSize: Integer read FTableSize write SetTableSize;
+ end;
+
+ THashStringMap = class(TAbstractStringMap)
+ private
+ FArray: TListArray;
+ FCapacity: Integer;
+ FMaxLoadFactor: Double;
+ FSize: Integer;
+ FTableSize: Integer;
+ protected
+ function GetAssociationIterator: IStringMapIterator; override;
+ procedure SetMaxLoadFactor(Value: Double); virtual;
+ procedure SetTableSize(Value: Integer); virtual;
+ procedure ChangeCapacity(Value: TListArray); virtual;
+ procedure CheckLoadFactor(AlwaysChangeCapacity: Boolean); virtual;
+ function GetHash(const Key: String): Integer; virtual;
+ function GetKeyPosition(const Key: String): TCollectionPosition; override;
+ procedure Rehash;
+ procedure TrueClear; override;
+ function TrueGet(Position: TCollectionPosition): IStringAssociation; override;
+ function TruePut(Position: TCollectionPosition; const Association: IStringAssociation): IStringAssociation; override;
+ function TrueRemove2(Position: TCollectionPosition): IStringAssociation; override;
+ public
+ constructor Create; override;
+ constructor Create(NaturalItemsOnly: Boolean); override;
+ constructor Create(NaturalItemsOnly: Boolean; TableSize: Integer; MaxLoadFactor: Double = DefaultMaxLoadFactor); overload; virtual;
+ destructor Destroy; override;
+ function GetCapacity: Integer; override;
+ procedure SetCapacity(Value: Integer); override;
+ function GetSize: Integer; override;
+ property MaxLoadFactor: Double read FMaxLoadFactor write SetMaxLoadFactor;
+ property TableSize: Integer read FTableSize write SetTableSize;
+ end;
+
+implementation
+
+const
+ (* (sqrt(5) - 1)/2
+ See Introduction to Algorithms in Pascal, 1995, by Thomas W. Parsons,
+ published by John Wiley & Sons, Inc, ISBN 0-471-11600-9
+ *)
+ HashFactor = 0.618033988749894848204586834365638;
+
+type
+ THashIterator = class(TAbstractIterator)
+ private
+ FHashSet: THashSet;
+ FHash: Integer;
+ FChainIndex: Integer;
+ protected
+ constructor Create(HashSet: THashSet);
+ function TrueFirst: ICollectable; override;
+ function TrueNext: ICollectable; override;
+ procedure TrueRemove; override;
+ end;
+
+ THashAssociationIterator = class(TAbstractAssociationIterator)
+ private
+ FHashMap: THashMap;
+ FHash: Integer;
+ FChainIndex: Integer;
+ protected
+ constructor Create(HashMap: THashMap);
+ function TrueFirst: IAssociation; override;
+ function TrueNext: IAssociation; override;
+ procedure TrueRemove; override;
+ end;
+
+ THashIntegerIterator = class(TAbstractIntegerAssociationIterator)
+ private
+ FHashIntegerMap: THashIntegerMap;
+ FHash: Integer;
+ FChainIndex: Integer;
+ protected
+ constructor Create(HashIntegerMap: THashIntegerMap);
+ function TrueFirst: IIntegerAssociation; override;
+ function TrueNext: IIntegerAssociation; override;
+ procedure TrueRemove; override;
+ end;
+
+ THashStringIterator = class(TAbstractStringAssociationIterator)
+ private
+ FHashStringMap: THashStringMap;
+ FHash: Integer;
+ FChainIndex: Integer;
+ protected
+ constructor Create(HashStringMap: THashStringMap);
+ function TrueFirst: IStringAssociation; override;
+ function TrueNext: IStringAssociation; override;
+ procedure TrueRemove; override;
+ end;
+
+ THashPosition = class(TCollectionPosition)
+ private
+ FChain: TList;
+ FIndex: Integer;
+ public
+ constructor Create(Found: Boolean; Chain: TList; Index: Integer);
+ property Chain: TList read FChain;
+ property Index: Integer read FIndex;
+ end;
+
+{ THashMap }
+constructor THashMap.Create(NaturalItemsOnly: Boolean; NaturalKeysOnly: Boolean);
+var
+ I: Integer;
+begin
+ // Force use of natural keys
+ inherited Create(NaturalItemsOnly, true);
+ FTableSize := DefaultTableSize;
+ FMaxLoadFactor := DefaultMaxLoadFactor;
+ SetLength(FArray, FTableSize);
+ for I := Low(FArray) to High(FArray) do
+ FArray[I] := TList.Create;
+ FCapacity := 0;
+ FSize := 0;
+ ChangeCapacity(FArray);
+end;
+
+destructor THashMap.Destroy;
+var
+ I: Integer;
+begin
+ for I := Low(FArray) to High(FArray) do
+ FArray[I].Free;
+ FArray := nil;
+ inherited Destroy;
+end;
+
+class function THashMap.GetAlwaysNaturalKeys: Boolean;
+begin
+ Result := true;
+end;
+
+function THashMap.GetNaturalKeyIID: TGUID;
+begin
+ Result := HashableIID;
+end;
+
+function THashMap.GetAssociationIterator: IMapIterator;
+begin
+ Result := THashAssociationIterator.Create(Self);
+end;
+
+procedure THashMap.SetTableSize(Value: Integer);
+begin
+ if (FTableSize <> Value) and (Value >= 1) then
+ begin
+ FTableSize := Value;
+ Rehash;
+ end;
+end;
+
+procedure THashMap.SetMaxLoadFactor(Value: Double);
+begin
+ if (FMaxLoadFactor <> Value) and (Value >= MaxLoadFactorMin) then
+ begin
+ FMaxLoadFactor := Value;
+ CheckLoadFactor(false);
+ end;
+end;
+
+procedure THashMap.ChangeCapacity(Value: TListArray);
+var
+ Chain: TList;
+ I, Total, ChainCapacity: Integer;
+begin
+ if FCapacity mod FTableSize = 0 then
+ ChainCapacity := Trunc(FCapacity / FTableSize)
+ else
+ ChainCapacity := Trunc(FCapacity / FTableSize) + 1;
+ Total := 0;
+ for I := Low(Value) to High(Value) do
+ begin
+ Chain := Value[I];
+ Chain.Capacity := ChainCapacity;
+ Total := Total + Chain.Capacity;
+ end;
+ FCapacity := Total;
+end;
+
+procedure THashMap.CheckLoadFactor(AlwaysChangeCapacity: Boolean);
+var
+ LoadFactor: Double;
+begin
+ LoadFactor := Capacity / TableSize;
+ if LoadFactor > MaxLoadFactor then
+ TableSize := Trunc(Capacity / Max(MaxLoadFactor, MaxLoadFactorMin))
+ else if AlwaysChangeCapacity then
+ ChangeCapacity(FArray);
+end;
+
+function THashMap.GetHash(const Key: ICollectable): Integer;
+var
+ Hashable: IHashable;
+ HashCode: Cardinal;
+begin
+ Key.QueryInterface(IHashable, Hashable);
+ HashCode := Hashable.HashCode;
+ Result := Trunc(Frac(HashCode * HashFactor) * TableSize);
+end;
+
+function THashMap.GetKeyPosition(const Key: ICollectable): TCollectionPosition;
+var
+ Chain: TList;
+ I: Integer;
+ Success: Boolean;
+begin
+ Chain := FArray[GetHash(Key)];
+ Success := false;
+ for I := 0 to Chain.Count - 1 do
+ begin
+ Success := KeyComparator.Equals(Key, IAssociation(Chain[I]).GetKey);
+ if Success then
+ Break;
+ end;
+ Result := THashPosition.Create(Success, Chain, I);
+end;
+
+procedure THashMap.Rehash;
+var
+ NewArray: TListArray;
+ OldChain, NewChain: TList;
+ Association: IAssociation;
+ Total: Integer;
+ I, J: Integer;
+ Hash: Integer;
+begin
+ // Create new chains
+ SetLength(NewArray, TableSize);
+ for I := Low(NewArray) to High(NewArray) do
+ begin
+ NewChain := TList.Create;
+ NewArray[I] := NewChain;
+ end;
+ ChangeCapacity(NewArray);
+
+ // Transfer from old chains to new and drop old
+ for I := Low(FArray) to High(FArray) do
+ begin
+ OldChain := FArray[I];
+ for J := 0 to OldChain.Count - 1 do
+ begin
+ Association := IAssociation(OldChain[J]);
+ Hash := GetHash(Association.GetKey);
+ NewArray[Hash].Add(Pointer(Association));
+ end;
+ OldChain.Free;
+ end;
+ FArray := NewArray;
+
+ // Find actual, new capacity
+ Total := 0;
+ for I := Low(FArray) to High(FArray) do
+ begin
+ NewChain := FArray[I];
+ Total := Total + NewChain.Capacity;
+ end;
+ FCapacity := Total;
+end;
+
+procedure THashMap.TrueClear;
+var
+ Association: IAssociation;
+ Chain: TList;
+ I, J: Integer;
+begin
+ for I := Low(FArray) to High(FArray) do
+ begin
+ Chain := FArray[I];
+ for J := 0 to Chain.Count - 1 do
+ begin
+ Association := IAssociation(Chain[J]);
+ Chain[J] := nil;
+ // Storing interface reference as a pointer does not update reference
+ // count automatically, so this must be done manually
+ Association._Release;
+ end;
+ Chain.Clear;
+ end;
+ FSize := 0;
+end;
+
+function THashMap.TrueGet(Position: TCollectionPosition): IAssociation;
+var
+ HashPosition: THashPosition;
+begin
+ HashPosition := THashPosition(Position);
+ Result := IAssociation(HashPosition.Chain.Items[HashPosition.Index]);
+end;
+
+function THashMap.TruePut(Position: TCollectionPosition; const Association: IAssociation): IAssociation;
+var
+ HashPosition: THashPosition;
+ OldAssociation: IAssociation;
+begin
+ HashPosition := THashPosition(Position);
+ if HashPosition.Found then
+ begin
+ OldAssociation := IAssociation(HashPosition.Chain.Items[HashPosition.Index]);
+ HashPosition.Chain.Items[HashPosition.Index] := Pointer(Association);
+ Result := OldAssociation;
+ // Storing interface reference as a pointer does not update reference
+ // count automatically, so this must be done manually
+ Association._AddRef;
+ OldAssociation._Release;
+ end
+ else
+ begin
+ HashPosition.Chain.Add(Pointer(Association));
+ Inc(FSize);
+ Result := nil;
+ // Storing interface reference as a pointer does not update reference
+ // count automatically, so this must be done manually
+ Association._AddRef;
+ end;
+end;
+
+function THashMap.TrueRemove2(Position: TCollectionPosition): IAssociation;
+var
+ Association: IAssociation;
+ HashPosition: THashPosition;
+begin
+ HashPosition := THashPosition(Position);
+ Association := IAssociation(TrueGet(Position));
+ HashPosition.Chain.Delete(HashPosition.Index);
+ Dec(FSize);
+ Result := Association;
+ // Storing interface reference as a pointer does not update reference
+ // count automatically, so this must be done manually
+ Association._Release;
+end;
+
+function THashMap.GetCapacity;
+begin
+ Result := FCapacity;
+end;
+
+procedure THashMap.SetCapacity(Value: Integer);
+begin
+ FCapacity := Value;
+ CheckLoadFactor(true);
+end;
+
+function THashMap.GetSize: Integer;
+begin
+ Result := FSize;
+end;
+
+{ THashSet }
+constructor THashSet.Create(NaturalItemsOnly: Boolean);
+var
+ I: Integer;
+begin
+ // Force use of natural items
+ inherited Create(true);
+ FTableSize := DefaultTableSize;
+ FMaxLoadFactor := DefaultMaxLoadFactor;
+ SetLength(FArray, FTableSize);
+ for I := Low(FArray) to High(FArray) do
+ FArray[I] := TList.Create;
+ FSize := 0;
+end;
+
+destructor THashSet.Destroy;
+var
+ I: Integer;
+begin
+ for I := Low(FArray) to High(FArray) do
+ FArray[I].Free;
+ FArray := nil;
+ inherited Destroy;
+end;
+
+procedure THashSet.SetTableSize(Value: Integer);
+begin
+ if (FTableSize <> Value) and (Value >= 1) then
+ begin
+ FTableSize := Value;
+ Rehash;
+ end;
+end;
+
+procedure THashSet.SetMaxLoadFactor(Value: Double);
+begin
+ if (FMaxLoadFactor <> Value) and (Value >= MaxLoadFactorMin) then
+ begin
+ FMaxLoadFactor := Value;
+ CheckLoadFactor(false);
+ end;
+end;
+
+procedure THashSet.ChangeCapacity(Value: TListArray);
+var
+ Chain: TList;
+ I, Total, ChainCapacity: Integer;
+begin
+ if FCapacity mod FTableSize = 0 then
+ ChainCapacity := Trunc(FCapacity / FTableSize)
+ else
+ ChainCapacity := Trunc(FCapacity / FTableSize) + 1;
+ Total := 0;
+ for I := Low(Value) to High(Value) do
+ begin
+ Chain := Value[I];
+ Chain.Capacity := ChainCapacity;
+ Total := Total + Chain.Capacity;
+ end;
+ FCapacity := Total;
+end;
+
+procedure THashSet.CheckLoadFactor(AlwaysChangeCapacity: Boolean);
+var
+ LoadFactor: Double;
+begin
+ LoadFactor := Capacity / TableSize;
+ if LoadFactor > MaxLoadFactor then
+ TableSize := Trunc(Capacity / Max(MaxLoadFactor, MaxLoadFactorMin))
+ else if AlwaysChangeCapacity then
+ ChangeCapacity(FArray);
+end;
+
+function THashSet.GetHash(const Item: ICollectable): Integer;
+var
+ Hashable: IHashable;
+ HashCode: Cardinal;
+begin
+ Item.QueryInterface(IHashable, Hashable);
+ HashCode := Hashable.HashCode;
+ Result := Trunc(Frac(HashCode * HashFactor) * TableSize);
+end;
+
+function THashSet.GetPosition(const Item: ICollectable): TCollectionPosition;
+var
+ Chain: TList;
+ I: Integer;
+ Success: Boolean;
+begin
+ Chain := FArray[GetHash(Item)];
+ Success := false;
+ for I := 0 to Chain.Count - 1 do
+ begin
+ Success := Comparator.Equals(Item, ICollectable(Chain[I]));
+ if Success then
+ Break;
+ end;
+ Result := THashPosition.Create(Success, Chain, I);
+end;
+
+procedure THashSet.Rehash;
+var
+ NewArray: TListArray;
+ OldChain, NewChain: TList;
+ Item: ICollectable;
+ Total: Integer;
+ I, J: Integer;
+ Hash: Integer;
+begin
+ // Create new chains
+ SetLength(NewArray, TableSize);
+ for I := Low(NewArray) to High(NewArray) do
+ begin
+ NewChain := TList.Create;
+ NewArray[I] := NewChain;
+ end;
+ ChangeCapacity(NewArray);
+
+ // Transfer from old chains to new and drop old
+ for I := Low(FArray) to High(FArray) do
+ begin
+ OldChain := FArray[I];
+ for J := 0 to OldChain.Count - 1 do
+ begin
+ Item := ICollectable(OldChain[J]);
+ Hash := GetHash(Item);
+ NewArray[Hash].Add(Pointer(Item));
+ end;
+ OldChain.Free;
+ end;
+ FArray := NewArray;
+
+ // Find actual, new capacity
+ Total := 0;
+ for I := Low(FArray) to High(FArray) do
+ begin
+ NewChain := FArray[I];
+ Total := Total + NewChain.Capacity;
+ end;
+ FCapacity := Total;
+end;
+
+procedure THashSet.TrueAdd2(Position: TCollectionPosition; const Item: ICollectable);
+var
+ HashPosition: THashPosition;
+begin
+ HashPosition := THashPosition(Position);
+ HashPosition.Chain.Add(Pointer(Item));
+ Inc(FSize);
+ // Storing interface reference as a pointer does not update reference
+ // count automatically, so this must be done manually
+ Item._AddRef;
+end;
+
+procedure THashSet.TrueClear;
+var
+ Item: ICollectable;
+ Chain: TList;
+ I, J: Integer;
+begin
+ for I := Low(FArray) to High(FArray) do
+ begin
+ Chain := FArray[I];
+ for J := 0 to Chain.Count - 1 do
+ begin
+ Item := ICollectable(Chain[J]);
+ Chain[J] := nil;
+ // Storing interface reference as a pointer does not update reference
+ // count automatically, so this must be done manually
+ Item._Release;
+ end;
+ Chain.Clear;
+ end;
+ FSize := 0;
+end;
+
+function THashSet.TrueGet(Position: TCollectionPosition): ICollectable;
+var
+ HashPosition: THashPosition;
+begin
+ HashPosition := THashPosition(Position);
+ Result := ICollectable(HashPosition.Chain.Items[HashPosition.Index]);
+end;
+
+procedure THashSet.TrueRemove2(Position: TCollectionPosition);
+var
+ Item: ICollectable;
+ HashPosition: THashPosition;
+begin
+ HashPosition := THashPosition(Position);
+ Item := TrueGet(Position);
+ HashPosition.Chain.Delete(HashPosition.Index);
+ Dec(FSize);
+ // Storing interface reference as a pointer does not update reference
+ // count automatically, so this must be done manually
+ Item._Release;
+end;
+
+class function THashSet.GetAlwaysNaturalItems: Boolean;
+begin
+ Result := true;
+end;
+
+function THashSet.GetIterator: IIterator;
+begin
+ Result := THashIterator.Create(Self);
+end;
+
+function THashSet.GetNaturalItemIID: TGUID;
+begin
+ Result := HashableIID;
+end;
+
+function THashSet.GetCapacity;
+begin
+ Result := FCapacity;
+end;
+
+procedure THashSet.SetCapacity(Value: Integer);
+begin
+ FCapacity := Value;
+ CheckLoadFactor(true);
+end;
+
+function THashSet.GetSize: Integer;
+begin
+ Result := FSize;
+end;
+
+{ THashIntegerMap }
+constructor THashIntegerMap.Create;
+begin
+ Create(false, DefaultTableSize, DefaultMaxLoadFactor);
+end;
+
+constructor THashIntegerMap.Create(NaturalItemsOnly: Boolean);
+begin
+ Create(NaturalItemsOnly, DefaultTableSize, DefaultMaxLoadFactor);
+end;
+
+constructor THashIntegerMap.Create(NaturalItemsOnly: Boolean; TableSize: Integer; MaxLoadFactor: Double = DefaultMaxLoadFactor);
+var
+ I: Integer;
+begin
+ inherited Create(NaturalItemsOnly);
+ SetLength(FArray, TableSize);
+ for I := Low(FArray) to High(FArray) do
+ FArray[I] := TList.Create;
+ FTableSize := TableSize;
+ FMaxLoadFactor := MaxLoadFactor;
+ FSize := 0;
+end;
+
+destructor THashIntegerMap.Destroy;
+var
+ I: Integer;
+begin
+ for I := Low(FArray) to High(FArray) do
+ FArray[I].Free;
+ FArray := nil;
+ inherited Destroy;
+end;
+
+function THashIntegerMap.GetAssociationIterator: IIntegerMapIterator;
+begin
+ Result := THashIntegerIterator.Create(Self);
+end;
+
+procedure THashIntegerMap.SetTableSize(Value: Integer);
+begin
+ if (FTableSize <> Value) and (Value >= 1) then
+ begin
+ FTableSize := Value;
+ Rehash;
+ end;
+end;
+
+procedure THashIntegerMap.SetMaxLoadFactor(Value: Double);
+begin
+ if (FMaxLoadFactor <> Value) and (Value >= MaxLoadFactorMin) then
+ begin
+ FMaxLoadFactor := Value;
+ CheckLoadFactor(false);
+ end;
+end;
+
+procedure THashIntegerMap.ChangeCapacity;
+var
+ Chain: TList;
+ I, Total, ChainCapacity: Integer;
+begin
+ if FCapacity mod FTableSize = 0 then
+ ChainCapacity := Trunc(FCapacity / FTableSize)
+ else
+ ChainCapacity := Trunc(FCapacity / FTableSize) + 1;
+ Total := 0;
+ for I := Low(Value) to High(Value) do
+ begin
+ Chain := Value[I];
+ Chain.Capacity := ChainCapacity;
+ Total := Total + Chain.Capacity;
+ end;
+ FCapacity := Total;
+end;
+
+procedure THashIntegerMap.CheckLoadFactor(AlwaysChangeCapacity: Boolean);
+var
+ LoadFactor: Double;
+begin
+ LoadFactor := Capacity / TableSize;
+ if LoadFactor > MaxLoadFactor then
+ TableSize := Trunc(Capacity / Max(MaxLoadFactor, MaxLoadFactorMin))
+ else if AlwaysChangeCapacity then
+ ChangeCapacity(FArray);
+end;
+
+function THashIntegerMap.GetHash(const Key: Integer): Integer;
+begin
+ Result := Trunc(Frac(Cardinal(Key) * HashFactor) * TableSize);
+end;
+
+function THashIntegerMap.GetKeyPosition(const Key: Integer): TCollectionPosition;
+var
+ Chain: TList;
+ I: Integer;
+ Success: Boolean;
+begin
+ Chain := FArray[GetHash(Key)];
+ Success := false;
+ for I := 0 to Chain.Count - 1 do
+ begin
+ Success := (Key = IIntegerAssociation(Chain[I]).GetKey);
+ if Success then
+ Break;
+ end;
+ Result := THashPosition.Create(Success, Chain, I);
+end;
+
+procedure THashIntegerMap.Rehash;
+var
+ NewArray: TListArray;
+ OldChain, NewChain: TList;
+ Association: IIntegerAssociation;
+ Total: Integer;
+ I, J: Integer;
+ Hash: Integer;
+begin
+ // Create new chains
+ SetLength(NewArray, TableSize);
+ for I := Low(NewArray) to High(NewArray) do
+ begin
+ NewChain := TList.Create;
+ NewArray[I] := NewChain;
+ end;
+ ChangeCapacity(NewArray);
+
+ // Transfer from old chains to new and drop old
+ for I := Low(FArray) to High(FArray) do
+ begin
+ OldChain := FArray[I];
+ for J := 0 to OldChain.Count - 1 do
+ begin
+ Association := IIntegerAssociation(OldChain[J]);
+ Hash := GetHash(Association.GetKey);
+ NewArray[Hash].Add(Pointer(Association));
+ end;
+ OldChain.Free;
+ end;
+ FArray := NewArray;
+
+ // Find actual, new capacity
+ Total := 0;
+ for I := Low(FArray) to High(FArray) do
+ begin
+ NewChain := FArray[I];
+ Total := Total + NewChain.Capacity;
+ end;
+ FCapacity := Total;
+end;
+
+procedure THashIntegerMap.TrueClear;
+var
+ Association: IIntegerAssociation;
+ Chain: TList;
+ I, J: Integer;
+begin
+ for I := Low(FArray) to High(FArray) do
+ begin
+ Chain := FArray[I];
+ for J := 0 to Chain.Count - 1 do
+ begin
+ Association := IIntegerAssociation(Chain[J]);
+ Chain[J] := nil;
+ // Storing interface reference as a pointer does not update reference
+ // count automatically, so this must be done manually
+ Association._Release;
+ end;
+ Chain.Clear;
+ end;
+ FSize := 0;
+end;
+
+function THashIntegerMap.TrueGet(Position: TCollectionPosition): IIntegerAssociation;
+var
+ HashPosition: THashPosition;
+begin
+ HashPosition := THashPosition(Position);
+ Result := IIntegerAssociation(HashPosition.Chain.Items[HashPosition.Index]);
+end;
+
+function THashIntegerMap.TruePut(Position: TCollectionPosition; const Association: IIntegerAssociation): IIntegerAssociation;
+var
+ HashPosition: THashPosition;
+ OldAssociation: IIntegerAssociation;
+begin
+ HashPosition := THashPosition(Position);
+ if HashPosition.Found then
+ begin
+ OldAssociation := IIntegerAssociation(HashPosition.Chain.Items[HashPosition.Index]);
+ HashPosition.Chain.Items[HashPosition.Index] := Pointer(Association);
+ Result := OldAssociation;
+ // Storing interface reference as a pointer does not update reference
+ // count automatically, so this must be done manually
+ Association._AddRef;
+ OldAssociation._Release;
+ end
+ else
+ begin
+ HashPosition.Chain.Add(Pointer(Association));
+ Inc(FSize);
+ Result := nil;
+ // Storing interface reference as a pointer does not update reference
+ // count automatically, so this must be done manually
+ Association._AddRef;
+ end;
+end;
+
+function THashIntegerMap.TrueRemove2(Position: TCollectionPosition): IIntegerAssociation;
+var
+ Association: IIntegerAssociation;
+ HashPosition: THashPosition;
+begin
+ HashPosition := THashPosition(Position);
+ Association := IIntegerAssociation(TrueGet(Position));
+ HashPosition.Chain.Delete(HashPosition.Index);
+ Dec(FSize);
+ Result := Association;
+ // Storing interface reference as a pointer does not update reference
+ // count automatically, so this must be done manually
+ Association._Release;
+end;
+
+function THashIntegerMap.GetCapacity;
+begin
+ Result := FCapacity;
+end;
+
+procedure THashIntegerMap.SetCapacity(Value: Integer);
+begin
+ FCapacity := Value;
+ CheckLoadFactor(true);
+end;
+
+function THashIntegerMap.GetSize: Integer;
+begin
+ Result := FSize;
+end;
+
+{ THashStringMap }
+constructor THashStringMap.Create;
+begin
+ Create(false, DefaultTableSize, DefaultMaxLoadFactor);
+end;
+
+constructor THashStringMap.Create(NaturalItemsOnly: Boolean);
+begin
+ Create(NaturalItemsOnly, DefaultTableSize, DefaultMaxLoadFactor);
+end;
+
+constructor THashStringMap.Create(NaturalItemsOnly: Boolean; TableSize: Integer; MaxLoadFactor: Double = DefaultMaxLoadFactor);
+var
+ I: Integer;
+begin
+ inherited Create(NaturalItemsOnly);
+ SetLength(FArray, TableSize);
+ for I := Low(FArray) to High(FArray) do
+ FArray[I] := TList.Create;
+ FTableSize := TableSize;
+ FMaxLoadFactor := MaxLoadFactor;
+ FSize := 0;
+end;
+
+destructor THashStringMap.Destroy;
+var
+ I: Integer;
+begin
+ for I := Low(FArray) to High(FArray) do
+ FArray[I].Free;
+ FArray := nil;
+ inherited Destroy;
+end;
+
+function THashStringMap.GetAssociationIterator: IStringMapIterator;
+begin
+ Result := THashStringIterator.Create(Self);
+end;
+
+procedure THashStringMap.SetTableSize(Value: Integer);
+begin
+ if (FTableSize <> Value) and (Value >= 1) then
+ begin
+ FTableSize := Value;
+ Rehash;
+ end;
+end;
+
+procedure THashStringMap.SetMaxLoadFactor(Value: Double);
+begin
+ if (FMaxLoadFactor <> Value) and (Value >= MaxLoadFactorMin) then
+ begin
+ FMaxLoadFactor := Value;
+ CheckLoadFactor(false);
+ end;
+end;
+
+procedure THashStringMap.ChangeCapacity;
+var
+ Chain: TList;
+ I, Total, ChainCapacity: Integer;
+begin
+ if FCapacity mod FTableSize = 0 then
+ ChainCapacity := Trunc(FCapacity / FTableSize)
+ else
+ ChainCapacity := Trunc(FCapacity / FTableSize) + 1;
+ Total := 0;
+ for I := Low(Value) to High(Value) do
+ begin
+ Chain := Value[I];
+ Chain.Capacity := ChainCapacity;
+ Total := Total + Chain.Capacity;
+ end;
+ FCapacity := Total;
+end;
+
+procedure THashStringMap.CheckLoadFactor(AlwaysChangeCapacity: Boolean);
+var
+ LoadFactor: Double;
+begin
+ LoadFactor := Capacity / TableSize;
+ if LoadFactor > MaxLoadFactor then
+ TableSize := Trunc(Capacity / Max(MaxLoadFactor, MaxLoadFactorMin))
+ else if AlwaysChangeCapacity then
+ ChangeCapacity(FArray);
+end;
+
+function THashStringMap.GetHash(const Key: String): Integer;
+var
+ HashCode: Cardinal;
+ I: Integer;
+begin
+ HashCode := 0;
+ for I := 1 to Length(Key) do
+ HashCode := (HashCode shl 1) xor Ord(Key[I]);
+ Result := Trunc(Frac(HashCode * HashFactor) * TableSize);
+end;
+
+function THashStringMap.GetKeyPosition(const Key: String): TCollectionPosition;
+var
+ Chain: TList;
+ I: Integer;
+ Success: Boolean;
+begin
+ Chain := FArray[GetHash(Key)];
+ Success := false;
+ for I := 0 to Chain.Count - 1 do
+ begin
+ Success := (Key = IStringAssociation(Chain[I]).GetKey);
+ if Success then
+ Break;
+ end;
+ Result := THashPosition.Create(Success, Chain, I);
+end;
+
+procedure THashStringMap.Rehash;
+var
+ NewArray: TListArray;
+ OldChain, NewChain: TList;
+ Association: IStringAssociation;
+ Total: Integer;
+ I, J: Integer;
+ Hash: Integer;
+begin
+ // Create new chains
+ SetLength(NewArray, TableSize);
+ for I := Low(NewArray) to High(NewArray) do
+ begin
+ NewChain := TList.Create;
+ NewArray[I] := NewChain;
+ end;
+ ChangeCapacity(NewArray);
+
+ // Transfer from old chains to new and drop old
+ for I := Low(FArray) to High(FArray) do
+ begin
+ OldChain := FArray[I];
+ for J := 0 to OldChain.Count - 1 do
+ begin
+ Association := IStringAssociation(OldChain[J]);
+ Hash := GetHash(Association.GetKey);
+ NewArray[Hash].Add(Pointer(Association));
+ end;
+ OldChain.Free;
+ end;
+ FArray := NewArray;
+
+ // Find actual, new capacity
+ Total := 0;
+ for I := Low(FArray) to High(FArray) do
+ begin
+ NewChain := FArray[I];
+ Total := Total + NewChain.Capacity;
+ end;
+ FCapacity := Total;
+end;
+
+procedure THashStringMap.TrueClear;
+var
+ Association: IStringAssociation;
+ Chain: TList;
+ I, J: Integer;
+begin
+ for I := Low(FArray) to High(FArray) do
+ begin
+ Chain := FArray[I];
+ for J := 0 to Chain.Count - 1 do
+ begin
+ Association := IStringAssociation(Chain[J]);
+ Chain[J] := nil;
+ // Storing interface reference as a pointer does not update reference
+ // count automatically, so this must be done manually
+ Association._Release;
+ end;
+ Chain.Clear;
+ end;
+ FSize := 0;
+end;
+
+function THashStringMap.TrueGet(Position: TCollectionPosition): IStringAssociation;
+var
+ HashPosition: THashPosition;
+begin
+ HashPosition := THashPosition(Position);
+ Result := IStringAssociation(HashPosition.Chain.Items[HashPosition.Index]);
+end;
+
+function THashStringMap.TruePut(Position: TCollectionPosition; const Association: IStringAssociation): IStringAssociation;
+var
+ HashPosition: THashPosition;
+ OldAssociation: IStringAssociation;
+begin
+ HashPosition := THashPosition(Position);
+ if HashPosition.Found then
+ begin
+ OldAssociation := IStringAssociation(HashPosition.Chain.Items[HashPosition.Index]);
+ HashPosition.Chain.Items[HashPosition.Index] := Pointer(Association);
+ Result := OldAssociation;
+ // Storing interface reference as a pointer does not update reference
+ // count automatically, so this must be done manually
+ Association._AddRef;
+ OldAssociation._Release;
+ end
+ else
+ begin
+ HashPosition.Chain.Add(Pointer(Association));
+ Inc(FSize);
+ Result := nil;
+ // Storing interface reference as a pointer does not update reference
+ // count automatically, so this must be done manually
+ Association._AddRef;
+ end;
+end;
+
+function THashStringMap.TrueRemove2(Position: TCollectionPosition): IStringAssociation;
+var
+ Association: IStringAssociation;
+ HashPosition: THashPosition;
+begin
+ HashPosition := THashPosition(Position);
+ Association := IStringAssociation(TrueGet(Position));
+ HashPosition.Chain.Delete(HashPosition.Index);
+ Dec(FSize);
+ Result := Association;
+ // Storing interface reference as a pointer does not update reference
+ // count automatically, so this must be done manually
+ Association._Release;
+end;
+
+function THashStringMap.GetCapacity;
+begin
+ Result := FCapacity;
+end;
+
+procedure THashStringMap.SetCapacity(Value: Integer);
+begin
+ FCapacity := Value;
+ CheckLoadFactor(true);
+end;
+
+function THashStringMap.GetSize: Integer;
+begin
+ Result := FSize;
+end;
+
+{ THashPosition }
+constructor THashPosition.Create(Found: Boolean; Chain: TList; Index: Integer);
+begin
+ inherited Create(Found);
+ FChain := Chain;
+ FIndex := Index;
+end;
+
+{ THashIterator }
+constructor THashIterator.Create(HashSet: THashSet);
+begin
+ inherited Create(true);
+ FHashSet := HashSet;
+ First;
+end;
+
+function THashIterator.TrueFirst: ICollectable;
+var
+ Chain: TList;
+ Success: Boolean;
+begin
+ FHash := 0;
+ FChainIndex := 0;
+ Success := false;
+ while FHash < FHashSet.TableSize do
+ begin
+ Chain := FHashSet.FArray[FHash];
+ Success := Chain.Count > 0;
+ if Success then
+ Break;
+ Inc(FHash);
+ end;
+ if Success then
+ Result := ICollectable(FHashSet.FArray[FHash].Items[FChainIndex])
+ else
+ Result := nil;
+end;
+
+function THashIterator.TrueNext: ICollectable;
+var
+ Chain: TList;
+ Success: Boolean;
+begin
+ Success := false;
+ Chain := FHashSet.FArray[FHash];
+ repeat
+ Inc(FChainIndex);
+ if FChainIndex >= Chain.Count then
+ begin
+ Inc(FHash);
+ FChainIndex := -1;
+ if FHash < FHashSet.TableSize then
+ Chain := FHashSet.FArray[FHash];
+ end
+ else
+ Success := true;
+ until Success or (FHash >= FHashSet.TableSize);
+ if Success then
+ Result := ICollectable(FHashSet.FArray[FHash].Items[FChainIndex])
+ else
+ Result := nil;
+end;
+
+procedure THashIterator.TrueRemove;
+var
+ Item: ICollectable;
+begin
+ Item := ICollectable(FHashSet.FArray[FHash].Items[FChainIndex]);
+ FHashSet.FArray[FHash].Delete(FChainIndex);
+ Dec(FChainIndex);
+ Dec(FHashSet.FSize);
+ // Storing interface reference as a pointer does not update reference
+ // count automatically, so this must be done manually
+ Item._Release;
+end;
+
+
+{ THashAssociationIterator }
+constructor THashAssociationIterator.Create(HashMap: THashMap);
+begin
+ inherited Create(true);
+ FHashMap := HashMap;
+ First;
+end;
+
+function THashAssociationIterator.TrueFirst: IAssociation;
+var
+ Chain: TList;
+ Success: Boolean;
+begin
+ FHash := 0;
+ FChainIndex := 0;
+ Success := false;
+ while FHash < FHashMap.TableSize do
+ begin
+ Chain := FHashMap.FArray[FHash];
+ Success := Chain.Count > 0;
+ if Success then
+ Break;
+ Inc(FHash);
+ end;
+ if Success then
+ Result := IAssociation(FHashMap.FArray[FHash].Items[FChainIndex])
+ else
+ Result := nil;
+end;
+
+function THashAssociationIterator.TrueNext: IAssociation;
+var
+ Chain: TList;
+ Success: Boolean;
+begin
+ Success := false;
+ Chain := FHashMap.FArray[FHash];
+ repeat
+ Inc(FChainIndex);
+ if FChainIndex >= Chain.Count then
+ begin
+ Inc(FHash);
+ FChainIndex := -1;
+ if FHash < FHashMap.TableSize then
+ Chain := FHashMap.FArray[FHash];
+ end
+ else
+ Success := true;
+ until Success or (FHash >= FHashMap.TableSize);
+ if Success then
+ Result := IAssociation(FHashMap.FArray[FHash].Items[FChainIndex])
+ else
+ Result := nil;
+end;
+
+procedure THashAssociationIterator.TrueRemove;
+var
+ Association: IAssociation;
+begin
+ Association := IAssociation(FHashMap.FArray[FHash].Items[FChainIndex]);
+ FHashMap.FArray[FHash].Delete(FChainIndex);
+ Dec(FChainIndex);
+ Dec(FHashMap.FSize);
+ // Storing interface reference as a pointer does not update reference
+ // count automatically, so this must be done manually
+ Association._Release;
+end;
+
+
+{ THashIntegerIterator }
+constructor THashIntegerIterator.Create(HashIntegerMap: THashIntegerMap);
+begin
+ inherited Create(true);
+ FHashIntegerMap := HashIntegerMap;
+ First;
+end;
+
+function THashIntegerIterator.TrueFirst: IIntegerAssociation;
+var
+ Chain: TList;
+ Success: Boolean;
+begin
+ FHash := 0;
+ FChainIndex := 0;
+ Success := false;
+ while FHash < FHashIntegerMap.TableSize do
+ begin
+ Chain := FHashIntegerMap.FArray[FHash];
+ Success := Chain.Count > 0;
+ if Success then
+ Break;
+ Inc(FHash);
+ end;
+ if Success then
+ Result := IIntegerAssociation(FHashIntegerMap.FArray[FHash].Items[FChainIndex])
+ else
+ Result := nil;
+end;
+
+function THashIntegerIterator.TrueNext: IIntegerAssociation;
+var
+ Chain: TList;
+ Success: Boolean;
+begin
+ Success := false;
+ Chain := FHashIntegerMap.FArray[FHash];
+ repeat
+ Inc(FChainIndex);
+ if FChainIndex >= Chain.Count then
+ begin
+ Inc(FHash);
+ FChainIndex := -1;
+ if FHash < FHashIntegerMap.TableSize then
+ Chain := FHashIntegerMap.FArray[FHash];
+ end
+ else
+ Success := true;
+ until Success or (FHash >= FHashIntegerMap.TableSize);
+ if Success then
+ Result := IIntegerAssociation(FHashIntegerMap.FArray[FHash].Items[FChainIndex])
+ else
+ Result := nil;
+end;
+
+procedure THashIntegerIterator.TrueRemove;
+var
+ Association: IIntegerAssociation;
+begin
+ Association := IIntegerAssociation(FHashIntegerMap.FArray[FHash].Items[FChainIndex]);
+ FHashIntegerMap.FArray[FHash].Delete(FChainIndex);
+ Dec(FChainIndex);
+ Dec(FHashIntegerMap.FSize);
+ // Storing interface reference as a pointer does not update reference
+ // count automatically, so this must be done manually
+ Association._Release;
+end;
+
+{ THashStringIterator }
+constructor THashStringIterator.Create(HashStringMap: THashStringMap);
+begin
+ inherited Create(true);
+ FHashStringMap := HashStringMap;
+ First;
+end;
+
+function THashStringIterator.TrueFirst: IStringAssociation;
+var
+ Chain: TList;
+ Success: Boolean;
+begin
+ FHash := 0;
+ FChainIndex := 0;
+ Success := false;
+ while FHash < FHashStringMap.TableSize do
+ begin
+ Chain := FHashStringMap.FArray[FHash];
+ Success := Chain.Count > 0;
+ if Success then
+ Break;
+ Inc(FHash);
+ end;
+ if Success then
+ Result := IStringAssociation(FHashStringMap.FArray[FHash].Items[FChainIndex])
+ else
+ Result := nil;
+end;
+
+function THashStringIterator.TrueNext: IStringAssociation;
+var
+ Chain: TList;
+ Success: Boolean;
+begin
+ Success := false;
+ Chain := FHashStringMap.FArray[FHash];
+ repeat
+ Inc(FChainIndex);
+ if FChainIndex >= Chain.Count then
+ begin
+ Inc(FHash);
+ FChainIndex := -1;
+ if FHash < FHashStringMap.TableSize then
+ Chain := FHashStringMap.FArray[FHash];
+ end
+ else
+ Success := true;
+ until Success or (FHash >= FHashStringMap.TableSize);
+ if Success then
+ Result := IStringAssociation(FHashStringMap.FArray[FHash].Items[FChainIndex])
+ else
+ Result := nil;
+end;
+
+procedure THashStringIterator.TrueRemove;
+var
+ Association: IStringAssociation;
+begin
+ Association := IStringAssociation(FHashStringMap.FArray[FHash].Items[FChainIndex]);
+ FHashStringMap.FArray[FHash].Delete(FChainIndex);
+ Dec(FChainIndex);
+ Dec(FHashStringMap.FSize);
+ // Storing interface reference as a pointer does not update reference
+ // count automatically, so this must be done manually
+ Association._Release;
+end;
+
+
+end.
diff --git a/unicode/src/lib/collections/CollLibrary.pas b/unicode/src/lib/collections/CollLibrary.pas
new file mode 100644
index 00000000..b7e3d268
--- /dev/null
+++ b/unicode/src/lib/collections/CollLibrary.pas
@@ -0,0 +1,131 @@
+unit CollLibrary;
+
+(*****************************************************************************
+ * Copyright 2003 by Matthew Greet
+ * This library is free software; you can redistribute it and/or modify it
+ * under the terms of the GNU Lesser General Public License as published by the
+ * Free Software Foundation; either version 2.1 of the License, or (at your
+ * option) any later version.
+ *
+ * This library 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 Lesser General Public License for more
+ * details. (http://opensource.org/licenses/lgpl-license.php)
+ *
+ * See http://www.warmachine.u-net.com/delphi_collections for updates and downloads.
+ *
+ * $Version: v1.0.3 $
+ * $Revision: 1.0.1.1 $
+ * $Log: D:\QVCS Repositories\Delphi Collections\CollLibrary.qbt $
+ *
+ * Initial version.
+ *
+ * Revision 1.0.1.1 by: Matthew Greet Rev date: 24/10/03 16:48:16
+ * v1.0 branch.
+ *
+ * Revision 1.0 by: Matthew Greet Rev date: 06/04/03 10:40:32
+ * Initial revision.
+ *
+ * FPC compatibility fixes by: UltraStar Deluxe Team
+ *
+ * $Endlog$
+ *****************************************************************************)
+
+{$IFDEF FPC}
+ {$MODE Delphi}{$H+}
+{$ENDIF}
+
+interface
+
+uses
+ Collections, CollArray, CollHash, CollList, CollPArray, CollWrappers;
+
+type
+ TMiscCollectionLibrary = class
+ public
+ class function ClassNameToClassType(ClassName: String): TAbstractCollectionClass;
+ class function EqualIID(const IID1, IID2: TGUID): Boolean;
+ class function HashCode(Value: String): Integer;
+ class procedure ShuffleArray(var ItemArray: array of ICollectable);
+ class procedure ShuffleList(const List: IList);
+ end;
+
+implementation
+
+{ TMiscCollectionLibrary }
+class function TMiscCollectionLibrary.ClassNameToClassType(ClassName: String): TAbstractCollectionClass;
+begin
+ if ClassName = 'TArray' then
+ Result := TArray
+ else if ClassName = 'THashSet' then
+ Result := THashSet
+ else if ClassName = 'THashMap' then
+ Result := THashMap
+ else if ClassName = 'THashIntegerMap' then
+ Result := THashIntegerMap
+ else if ClassName = 'THashStringMap' then
+ Result := THashStringMap
+ else if ClassName = 'TListSet' then
+ Result := TListSet
+ else if ClassName = 'TListMap' then
+ Result := TListMap
+ else if ClassName = 'TPArrayBag' then
+ Result := TPArrayBag
+ else if ClassName = 'TPArraySet' then
+ Result := TPArraySet
+ else if ClassName = 'TPArrayList' then
+ Result := TPArrayList
+ else if ClassName = 'TPArrayMap' then
+ Result := TPArrayMap
+ else
+ Result := nil;
+end;
+
+class function TMiscCollectionLibrary.EqualIID(const IID1, IID2: TGUID): Boolean;
+begin
+ Result := (IID1.D1 = IID2.D1) and (IID1.D2 = IID2.D2) and (IID1.D3 = IID2.D3) and
+ (IID1.D4[0] = IID2.D4[0]) and (IID1.D4[1] = IID2.D4[1]) and
+ (IID1.D4[2] = IID2.D4[2]) and (IID1.D4[3] = IID2.D4[3]) and
+ (IID1.D4[4] = IID2.D4[4]) and (IID1.D4[5] = IID2.D4[5]) and
+ (IID1.D4[6] = IID2.D4[6]) and (IID1.D4[7] = IID2.D4[7]);
+end;
+
+class function TMiscCollectionLibrary.HashCode(Value: String): Integer;
+var
+ I: Integer;
+begin
+ Result := 0;
+ for I := 1 to Length(Value) do
+ Result := (Result shl 1) xor Ord(Value[I]);
+end;
+
+class procedure TMiscCollectionLibrary.ShuffleArray(var ItemArray: array of ICollectable);
+var
+ Item: ICollectable;
+ ArraySize, I, Index: Integer;
+begin
+ Randomize;
+ ArraySize := Length(ItemArray);
+ for I := 0 to ArraySize - 1 do
+ begin
+ Index := (I + Random(ArraySize - 1) + 1) mod ArraySize;
+ Item := ItemArray[I];
+ ItemArray[I] := ItemArray[Index];
+ ItemArray[Index] := Item;
+ end;
+end;
+
+class procedure TMiscCollectionLibrary.ShuffleList(const List: IList);
+var
+ ListSize, I: Integer;
+begin
+ Randomize;
+ ListSize := List.GetSize;
+ for I := 0 to ListSize - 1 do
+ begin
+ List.Exchange(I, (I + Random(ListSize - 1) + 1) mod ListSize);
+ end;
+end;
+
+
+end.
diff --git a/unicode/src/lib/collections/CollList.pas b/unicode/src/lib/collections/CollList.pas
new file mode 100644
index 00000000..68aa0d66
--- /dev/null
+++ b/unicode/src/lib/collections/CollList.pas
@@ -0,0 +1,270 @@
+unit CollList;
+
+(*****************************************************************************
+ * Copyright 2003 by Matthew Greet
+ * This library is free software; you can redistribute it and/or modify it
+ * under the terms of the GNU Lesser General Public License as published by the
+ * Free Software Foundation; either version 2.1 of the License, or (at your
+ * option) any later version.
+ *
+ * This library 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 Lesser General Public License for more
+ * details. (http://opensource.org/licenses/lgpl-license.php)
+ *
+ * See http://www.warmachine.u-net.com/delphi_collections for updates and downloads.
+ *
+ * $Version: v1.0.3 $
+ * $Revision: 1.1.1.2 $
+ * $Log: D:\QVCS Repositories\Delphi Collections\CollList.qbt $
+ *
+ * Collection implementations based on sorted TPArrayList instances.
+ *
+ * Revision 1.1.1.2 by: Matthew Greet Rev date: 12/06/04 20:05:54
+ * Capacity property.
+ *
+ * Revision 1.1.1.1 by: Matthew Greet Rev date: 14/02/04 17:45:38
+ * v1.0 branch.
+ *
+ * Revision 1.1 by: Matthew Greet Rev date: 06/04/03 10:41:52
+ * Uses TExposedPArrayList to improve performance.
+ *
+ * Revision 1.0 by: Matthew Greet Rev date: 01/03/03 10:50:02
+ * Initial revision.
+ *
+ * FPC compatibility fixes by: UltraStar Deluxe Team
+ *
+ * $Endlog$
+ *****************************************************************************)
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}{$H+}
+{$ENDIF}
+
+uses
+ Collections, CollPArray;
+
+type
+ TListSet = class(TAbstractSet)
+ private
+ FList: TExposedPArrayList;
+ protected
+ function GetPosition(const Item: ICollectable): TCollectionPosition; override;
+ procedure TrueAdd2(Position: TCollectionPosition; const Item: ICollectable); override;
+ procedure TrueClear; override;
+ function TrueGet(Position: TCollectionPosition): ICollectable; override;
+ procedure TrueRemove2(Position: TCollectionPosition); override;
+ public
+ constructor Create(NaturalItemsOnly: Boolean); override;
+ destructor Destroy; override;
+ function GetCapacity: Integer; override;
+ procedure SetCapacity(Value: Integer); override;
+ function GetIterator: IIterator; override;
+ function GetNaturalItemIID: TGUID; override;
+ function GetSize: Integer; override;
+ end;
+
+ TListMap = class(TAbstractMap)
+ private
+ FList: TExposedPArrayList;
+ protected
+ function GetAssociationIterator: IMapIterator; override;
+ function GetKeyPosition(const Key: ICollectable): TCollectionPosition; override;
+ procedure TrueClear; override;
+ function TrueGet(Position: TCollectionPosition): IAssociation; override;
+ function TruePut(Position: TCollectionPosition; const Association: IAssociation): IAssociation; override;
+ function TrueRemove2(Position: TCollectionPosition): IAssociation; override;
+ public
+ constructor Create(NaturalItemsOnly: Boolean; NaturalKeysOnly: Boolean); override;
+ destructor Destroy; override;
+ function GetCapacity: Integer; override;
+ procedure SetCapacity(Value: Integer); override;
+ procedure SetKeyComparator(const Value: IComparator); override;
+ function GetNaturalKeyIID: TGUID; override;
+ function GetSize: Integer; override;
+ end;
+
+implementation
+
+type
+ TListPosition = class(TCollectionPosition)
+ private
+ FSearchResult: TSearchResult;
+ public
+ constructor Create(Found: Boolean; SearchResult: TSearchResult);
+ property SearchResult: TSearchResult read FSearchResult;
+ end;
+
+constructor TListSet.Create(NaturalItemsOnly: Boolean);
+begin
+ inherited Create(NaturalItemsOnly);
+ FList := TExposedPArrayList.Create(NaturalItemsOnly);
+ FList.Comparator := Comparator;
+ FList.Sort;
+end;
+
+destructor TListSet.Destroy;
+begin
+ FList.Free;
+ inherited Destroy;
+end;
+
+function TListSet.GetPosition(const Item: ICollectable): TCollectionPosition;
+var
+ SearchResult: TSearchResult;
+begin
+ SearchResult := FList.Search(Item);
+ Result := TListPosition.Create((SearchResult.ResultType = srFoundAtIndex), SearchResult);
+end;
+
+procedure TListSet.TrueAdd2(Position: TCollectionPosition; const Item: ICollectable);
+var
+ SearchResult: TSearchResult;
+ Index: Integer;
+begin
+ SearchResult := TListPosition(Position).SearchResult;
+ Index := SearchResult.Index;
+ if SearchResult.ResultType = srBeforeIndex then
+ FList.TrueInsert(Index, Item)
+ else
+ FList.TrueAppend(Item);
+end;
+
+procedure TListSet.TrueClear;
+begin
+ FList.Clear;
+end;
+
+function TListSet.TrueGet(Position: TCollectionPosition): ICollectable;
+begin
+ Result := FList.Items[TListPosition(Position).SearchResult.Index];
+end;
+
+procedure TListSet.TrueRemove2(Position: TCollectionPosition);
+begin
+ FList.Delete(TListPosition(Position).SearchResult.Index);
+end;
+
+function TListSet.GetCapacity: Integer;
+begin
+ Result := FList.Capacity;
+end;
+
+procedure TListSet.SetCapacity(Value: Integer);
+begin
+ FList.Capacity := Value;
+end;
+
+function TListSet.GetIterator: IIterator;
+begin
+ Result := FList.GetIterator;
+end;
+
+function TListSet.GetNaturalItemIID: TGUID;
+begin
+ Result := ComparableIID;
+end;
+
+function TListSet.GetSize: Integer;
+begin
+ Result := FList.Size;
+end;
+
+constructor TListMap.Create(NaturalItemsOnly: Boolean; NaturalKeysOnly: Boolean);
+begin
+ inherited Create(NaturalItemsOnly, NaturalKeysOnly);
+ FList := TExposedPArrayList.Create(false);
+ FList.Comparator := AssociationComparator;
+ FList.Sort;
+end;
+
+destructor TListMap.Destroy;
+begin
+ FList.Free;
+ inherited Destroy;
+end;
+
+function TListMap.GetAssociationIterator: IMapIterator;
+begin
+ Result := TAssociationIterator.Create(FList.GetIterator);
+end;
+
+function TListMap.GetKeyPosition(const Key: ICollectable): TCollectionPosition;
+var
+ Association: IAssociation;
+ SearchResult: TSearchResult;
+begin
+ Association := TAssociation.Create(Key, nil);
+ SearchResult := FList.Search(Association);
+ Result := TListPosition.Create((SearchResult.ResultType = srFoundAtIndex), SearchResult);
+end;
+
+procedure TListMap.TrueClear;
+begin
+ FList.Clear;
+end;
+
+function TListMap.TrueGet(Position: TCollectionPosition): IAssociation;
+begin
+ Result := (FList.Items[TListPosition(Position).SearchResult.Index]) as IAssociation;
+end;
+
+function TListMap.TruePut(Position: TCollectionPosition; const Association: IAssociation): IAssociation;
+var
+ SearchResult: TSearchResult;
+ Index: Integer;
+begin
+ SearchResult := TListPosition(Position).SearchResult;
+ Index := SearchResult.Index;
+ if SearchResult.ResultType = srFoundAtIndex then
+ begin
+ Result := (FList.Items[Index]) as IAssociation;
+ FList.Items[Index] := Association;
+ end
+ else if SearchResult.ResultType = srBeforeIndex then
+ FList.TrueInsert(Index, Association)
+ else
+ FList.TrueAppend(Association);
+end;
+
+function TListMap.TrueRemove2(Position: TCollectionPosition): IAssociation;
+begin
+ Result := (FList.Items[TListPosition(Position).SearchResult.Index]) as IAssociation;
+ FList.Delete(TListPosition(Position).SearchResult.Index);
+end;
+
+procedure TListMap.SetKeyComparator(const Value: IComparator);
+begin
+ inherited SetKeyComparator(Value);
+ FList.Sort;
+end;
+
+function TListMap.GetCapacity: Integer;
+begin
+ Result := FList.Capacity;
+end;
+
+procedure TListMap.SetCapacity(Value: Integer);
+begin
+ FList.Capacity := Value;
+end;
+
+function TListMap.GetNaturalKeyIID: TGUID;
+begin
+ Result := ComparableIID;
+end;
+
+function TListMap.GetSize: Integer;
+begin
+ Result := FList.Size;
+end;
+
+constructor TListPosition.Create(Found: Boolean; SearchResult: TSearchResult);
+begin
+ inherited Create(Found);
+ FSearchResult := SearchResult;
+end;
+
+end.
diff --git a/unicode/src/lib/collections/CollPArray.pas b/unicode/src/lib/collections/CollPArray.pas
new file mode 100644
index 00000000..5ebd534b
--- /dev/null
+++ b/unicode/src/lib/collections/CollPArray.pas
@@ -0,0 +1,689 @@
+unit CollPArray;
+
+(*****************************************************************************
+ * Copyright 2003 by Matthew Greet
+ * This library is free software; you can redistribute it and/or modify it
+ * under the terms of the GNU Lesser General Public License as published by the
+ * Free Software Foundation; either version 2.1 of the License, or (at your
+ * option) any later version.
+ *
+ * This library 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 Lesser General Public License for more
+ * details. (http://opensource.org/licenses/lgpl-license.php)
+ *
+ * See http://www.warmachine.u-net.com/delphi_collections for updates and downloads.
+ *
+ * $Version: v1.0.3 $
+ * $Revision: 1.2.1.2 $
+ * $Log: D:\QVCS Repositories\Delphi Collections\CollPArray.qbt $
+ *
+ * Collection implementations based on TList.
+ *
+ * Revision 1.2.1.2 by: Matthew Greet Rev date: 12/06/04 20:08:30
+ * Capacity property.
+ *
+ * Revision 1.2.1.1 by: Matthew Greet Rev date: 14/02/04 17:46:10
+ * v1.0 branch.
+ *
+ * Revision 1.2 by: Matthew Greet Rev date: 28/04/03 15:07:14
+ * Correctly handles nil items.
+ *
+ * Revision 1.1 by: Matthew Greet Rev date: 06/04/03 10:43:16
+ * Added TPArrayMap and TExposedPArrayList.
+ *
+ * Revision 1.0 by: Matthew Greet Rev date: 01/03/03 10:50:02
+ * Initial revision.
+ *
+ * FPC compatibility fixes by: UltraStar Deluxe Team
+ *
+ * $Endlog$
+ *****************************************************************************)
+
+{$IFDEF FPC}
+ {$MODE Delphi}{$H+}
+{$ENDIF}
+
+interface
+
+uses
+ Classes,
+ Collections;
+
+type
+ TPArrayBag = class(TAbstractBag)
+ private
+ FList: TList;
+ protected
+ function TrueAdd(const Item: ICollectable): Boolean; override;
+ procedure TrueClear; override;
+ function TrueRemove(const Item: ICollectable): ICollectable; override;
+ function TrueRemoveAll(const Item: ICollectable): ICollection; override;
+ public
+ constructor Create(NaturalItemsOnly: Boolean); override;
+ destructor Destroy; override;
+ function GetCapacity: Integer; override;
+ procedure SetCapacity(Value: Integer); override;
+ function GetIterator: IIterator; override;
+ function GetSize: Integer; override;
+ function TrueContains(const Item: ICollectable): Boolean; override;
+ end;
+
+ TPArraySet = class(TAbstractSet)
+ private
+ FList: TList;
+ protected
+ function GetPosition(const Item: ICollectable): TCollectionPosition; override;
+ procedure TrueAdd2(Position: TCollectionPosition; const Item: ICollectable); override;
+ procedure TrueClear; override;
+ function TrueGet(Position: TCollectionPosition): ICollectable; override;
+ procedure TrueRemove2(Position: TCollectionPosition); override;
+ public
+ constructor Create(NaturalItemsOnly: Boolean); override;
+ destructor Destroy; override;
+ function GetCapacity: Integer; override;
+ procedure SetCapacity(Value: Integer); override;
+ function GetIterator: IIterator; override;
+ function GetSize: Integer; override;
+ end;
+
+ TPArrayList = class(TAbstractList)
+ private
+ FList: TList;
+ protected
+ function TrueGetItem(Index: Integer): ICollectable; override;
+ procedure TrueSetItem(Index: Integer; const Item: ICollectable); override;
+ procedure TrueAppend(const Item: ICollectable); override;
+ procedure TrueClear; override;
+ function TrueDelete(Index: Integer): ICollectable; override;
+ procedure TrueInsert(Index: Integer; const Item: ICollectable); override;
+ public
+ constructor Create(NaturalItemsOnly: Boolean); override;
+ destructor Destroy; override;
+ function GetCapacity: Integer; override;
+ procedure SetCapacity(Value: Integer); override;
+ function GetIterator: IIterator; override;
+ function GetSize: Integer; override;
+ end;
+
+ TPArrayMap = class(TAbstractMap)
+ private
+ FList: TList;
+ protected
+ function GetAssociationIterator: IMapIterator; override;
+ function GetKeyPosition(const Key: ICollectable): TCollectionPosition; override;
+ procedure TrueClear; override;
+ function TrueGet(Position: TCollectionPosition): IAssociation; override;
+ function TruePut(Position: TCollectionPosition; const Association: IAssociation): IAssociation; override;
+ function TrueRemove2(Position: TCollectionPosition): IAssociation; override;
+ public
+ constructor Create(NaturalItemsOnly: Boolean; NaturalKeysOnly: Boolean); override;
+ destructor Destroy; override;
+ function GetCapacity: Integer; override;
+ procedure SetCapacity(Value: Integer); override;
+ function GetSize: Integer; override;
+ end;
+
+ // Same as TPArrayList but raises method visibilities so items can be manually
+ // appended or inserted without resetting sort flag.
+ TExposedPArrayList = class(TPArrayList)
+ public
+ procedure TrueAppend(const Item: ICollectable); override;
+ procedure TrueInsert(Index: Integer; const Item: ICollectable); override;
+ end;
+
+
+implementation
+
+type
+ TPArrayIterator = class(TAbstractIterator)
+ private
+ FList: TList;
+ FIndex: Integer;
+ protected
+ constructor Create(List: TList; AllowRemove: Boolean);
+ function TrueFirst: ICollectable; override;
+ function TrueNext: ICollectable; override;
+ procedure TrueRemove; override;
+ end;
+
+ TPArrayAssociationIterator = class(TAbstractAssociationIterator)
+ private
+ FList: TList;
+ FIndex: Integer;
+ protected
+ constructor Create(List: TList; AllowRemove: Boolean);
+ function TrueFirst: IAssociation; override;
+ function TrueNext: IAssociation; override;
+ procedure TrueRemove; override;
+ end;
+
+ TPArrayPosition = class(TCollectionPosition)
+ private
+ FIndex: Integer;
+ public
+ constructor Create(Found: Boolean; Index: Integer);
+ property Index: Integer read FIndex;
+ end;
+
+constructor TPArrayBag.Create(NaturalItemsOnly: Boolean);
+begin
+ inherited Create(NaturalItemsOnly);
+ FList := TList.Create;
+end;
+
+destructor TPArrayBag.Destroy;
+begin
+ FList.Free;
+ inherited Destroy;
+end;
+
+function TPArrayBag.TrueAdd(const Item: ICollectable): Boolean;
+begin
+ FList.Add(Pointer(Item));
+ Result := true;
+ // Storing interface reference as a pointer does not update reference
+ // count automatically, so this must be done manually
+ if Item <> nil then
+ Item._AddRef;
+end;
+
+procedure TPArrayBag.TrueClear;
+var
+ Item: ICollectable;
+ I: Integer;
+begin
+ // Delete all interface references
+ for I := 0 to FList.Count - 1 do
+ begin
+ Item := ICollectable(FList[I]);
+ FList[I] := nil;
+ // Storing interface reference as a pointer does not update reference
+ // count automatically, so this must be done manually
+ if Item <> nil then
+ Item._Release;
+ end;
+ FList.Clear;
+end;
+
+function TPArrayBag.TrueContains(const Item: ICollectable): Boolean;
+var
+ I: Integer;
+ Success: Boolean;
+begin
+ // Sequential search
+ I := 0;
+ Success := false;
+ while (I < FList.Count) and not Success do
+ begin
+ Success := Comparator.Equals(Item, ICollectable(FList[I]));
+ Inc(I);
+ end;
+ Result := Success;
+end;
+
+function TPArrayBag.TrueRemove(const Item: ICollectable): ICollectable;
+var
+ Item2: ICollectable;
+ I: Integer;
+ Found: Boolean;
+begin
+ // Sequential search
+ I := 0;
+ Found := false;
+ Result := nil;
+ while (I < FList.Count) and not Found do
+ begin
+ Item2 := ICollectable(FList[I]);
+ if Comparator.Equals(Item, Item2) then
+ begin
+ Found := true;
+ Result := Item2;
+ FList.Delete(I);
+ // Storing interface reference as a pointer does not update reference
+ // count automatically, so this must be done manually
+ if Item2 <> nil then
+ Item2._Release;
+ end
+ else
+ Inc(I);
+ end;
+end;
+
+function TPArrayBag.TrueRemoveAll(const Item: ICollectable): ICollection;
+var
+ ResultCollection: TPArrayBag;
+ Item2: ICollectable;
+ I: Integer;
+begin
+ // Sequential search
+ I := 0;
+ ResultCollection := TPArrayBag.Create;
+ while I < FList.Count do
+ begin
+ Item2 := ICollectable(FList[I]);
+ if Comparator.Equals(Item, Item2) then
+ begin
+ ResultCollection.Add(Item2);
+ FList.Delete(I);
+ // Storing interface reference as a pointer does not update reference
+ // count automatically, so this must be done manually
+ if Item <> nil then
+ Item._Release;
+ end
+ else
+ Inc(I);
+ end;
+ Result := ResultCollection;
+end;
+
+function TPArrayBag.GetCapacity: Integer;
+begin
+ Result := FList.Capacity;
+end;
+
+procedure TPArrayBag.SetCapacity(Value: Integer);
+begin
+ FList.Capacity := Value;
+end;
+
+function TPArrayBag.GetIterator: IIterator;
+begin
+ Result := TPArrayIterator.Create(FList, true);
+end;
+
+function TPArrayBag.GetSize: Integer;
+begin
+ Result := FList.Count;
+end;
+
+constructor TPArraySet.Create(NaturalItemsOnly: Boolean);
+begin
+ inherited Create(NaturalItemsOnly);
+ FList := TList.Create;
+end;
+
+destructor TPArraySet.Destroy;
+begin
+ FList.Free;
+ inherited Destroy;
+end;
+
+function TPArraySet.GetPosition(const Item: ICollectable): TCollectionPosition;
+var
+ I: Integer;
+ Success: Boolean;
+begin
+ // Sequential search
+ I := 0;
+ Success := false;
+ while (I < FList.Count) do
+ begin
+ Success := Comparator.Equals(Item, ICollectable(FList[I]));
+ if Success then
+ break;
+ Inc(I);
+ end;
+ Result := TPArrayPosition.Create(Success, I);
+end;
+
+procedure TPArraySet.TrueAdd2(Position: TCollectionPosition; const Item: ICollectable);
+begin
+ FList.Add(Pointer(Item));
+ // Storing interface reference as a pointer does not update reference
+ // count automatically, so this must be done manually
+ Item._AddRef;
+end;
+
+procedure TPArraySet.TrueClear;
+var
+ Item: ICollectable;
+ I: Integer;
+begin
+ // Delete all interface references
+ for I := 0 to FList.Count - 1 do
+ begin
+ Item := ICollectable(FList[I]);
+ FList[I] := nil;
+ // Storing interface reference as a pointer does not update reference
+ // count automatically, so this must be done manually
+ Item._Release;
+ end;
+ FList.Clear;
+end;
+
+function TPArraySet.TrueGet(Position: TCollectionPosition): ICollectable;
+begin
+ Result := ICollectable(FList.Items[TPArrayPosition(Position).Index]);
+end;
+
+procedure TPArraySet.TrueRemove2(Position: TCollectionPosition);
+var
+ Item: ICollectable;
+begin
+ Item := ICollectable(FList[TPArrayPosition(Position).Index]);
+ FList.Delete(TPArrayPosition(Position).Index);
+ // Storing interface reference as a pointer does not update reference
+ // count automatically, so this must be done manually
+ Item._Release;
+end;
+
+function TPArraySet.GetCapacity: Integer;
+begin
+ Result := FList.Capacity;
+end;
+
+procedure TPArraySet.SetCapacity(Value: Integer);
+begin
+ FList.Capacity := Value;
+end;
+
+function TPArraySet.GetIterator: IIterator;
+begin
+ Result := TPArrayIterator.Create(FList, true);
+end;
+
+function TPArraySet.GetSize: Integer;
+begin
+ Result := FList.Count;
+end;
+
+constructor TPArrayList.Create(NaturalItemsOnly: Boolean);
+begin
+ inherited Create(NaturalItemsOnly);
+ FList := TList.Create;
+end;
+
+destructor TPArrayList.Destroy;
+begin
+ FList.Free;
+ inherited Destroy;
+end;
+
+function TPArrayList.TrueGetItem(Index: Integer): ICollectable;
+begin
+ Result := ICollectable(FList.Items[Index]);
+end;
+
+procedure TPArrayList.TrueSetItem(Index: Integer; const Item: ICollectable);
+var
+ OldItem: ICollectable;
+begin
+ OldItem := ICollectable(FList[Index]);
+ FList[Index] := Pointer(Item);
+ // Storing interface reference as a pointer does not update reference
+ // count automatically, so this must be done manually
+ if Item <> nil then
+ Item._AddRef;
+ if OldItem <> nil then
+ OldItem._Release;
+end;
+
+procedure TPArrayList.TrueAppend(const Item: ICollectable);
+begin
+ FList.Add(Pointer(Item));
+ // Storing interface reference as a pointer does not update reference
+ // count automatically, so this must be done manually
+ if Item <> nil then
+ Item._AddRef;
+end;
+
+procedure TPArrayList.TrueClear;
+var
+ Item: ICollectable;
+ I: Integer;
+begin
+ // Delete all interface references
+ for I := 0 to FList.Count - 1 do
+ begin
+ Item := ICollectable(FList[I]);
+ FList[I] := nil;
+ // Storing interface reference as a pointer does not update reference
+ // count automatically, so this must be done manually
+ if Item <> nil then
+ Item._Release;
+ end;
+ FList.Clear;
+end;
+
+function TPArrayList.TrueDelete(Index: Integer): ICollectable;
+begin
+ Result := ICollectable(FList[Index]);
+ FList.Delete(Index);
+ // Storing interface reference as a pointer does not update reference
+ // count automatically, so this must be done manually
+ if Result <> nil then
+ Result._Release;
+end;
+
+procedure TPArrayList.TrueInsert(Index: Integer; const Item: ICollectable);
+begin
+ FList.Insert(Index, Pointer(Item));
+ // Storing interface reference as a pointer does not update reference
+ // count automatically, so this must be done manually
+ if Item <> nil then
+ Item._AddRef;
+end;
+
+function TPArrayList.GetCapacity: Integer;
+begin
+ Result := FList.Capacity;
+end;
+
+procedure TPArrayList.SetCapacity(Value: Integer);
+begin
+ FList.Capacity := Value;
+end;
+
+function TPArrayList.GetIterator: IIterator;
+begin
+ Result := TPArrayIterator.Create(FList, true);
+end;
+
+function TPArrayList.GetSize: Integer;
+begin
+ Result := FList.Count;
+end;
+
+constructor TPArrayMap.Create(NaturalItemsOnly: Boolean; NaturalKeysOnly: Boolean);
+begin
+ inherited Create(NaturalItemsOnly, NaturalKeysOnly);
+ FList := TList.Create;
+end;
+
+destructor TPArrayMap.Destroy;
+begin
+ FList.Free;
+ inherited Destroy;
+end;
+
+function TPArrayMap.GetAssociationIterator: IMapIterator;
+begin
+ Result := TPArrayAssociationIterator.Create(FList, true);
+end;
+
+function TPArrayMap.GetKeyPosition(const Key: ICollectable): TCollectionPosition;
+var
+ I: Integer;
+ Success: Boolean;
+begin
+ // Sequential search
+ I := 0;
+ Success := false;
+ while (I < FList.Count) do
+ begin
+ Success := KeyComparator.Equals(Key, IAssociation(FList[I]).GetKey);
+ if Success then
+ break;
+ Inc(I);
+ end;
+ Result := TPArrayPosition.Create(Success, I);
+end;
+
+procedure TPArrayMap.TrueClear;
+var
+ Association: IAssociation;
+ I: Integer;
+begin
+ // Delete all interface references
+ for I := 0 to FList.Count - 1 do
+ begin
+ Association := IAssociation(FList[I]);
+ FList[I] := nil;
+ // Storing interface reference as a pointer does not update reference
+ // count automatically, so this must be done manually
+ Association._Release;
+ end;
+ FList.Clear;
+end;
+
+function TPArrayMap.TrueGet(Position: TCollectionPosition): IAssociation;
+begin
+ Result := IAssociation(FList.Items[TPArrayPosition(Position).Index]);
+end;
+
+function TPArrayMap.TruePut(Position: TCollectionPosition; const Association: IAssociation): IAssociation;
+var
+ OldAssociation: IAssociation;
+ Index: Integer;
+begin
+ if Position.Found then
+ begin
+ Index := (Position as TPArrayPosition).Index;
+ OldAssociation := IAssociation(FList[Index]);
+ FList[Index] := Pointer(Association);
+ end
+ else
+ begin
+ OldAssociation := nil;
+ FList.Add(Pointer(Association));
+ end;
+ Result := OldAssociation;
+ // Storing interface reference as a pointer does not update reference
+ // count automatically, so this must be done manually
+ Association._AddRef;
+ if OldAssociation <> nil then
+ OldAssociation._Release;
+end;
+
+function TPArrayMap.TrueRemove2(Position: TCollectionPosition): IAssociation;
+var
+ OldAssociation: IAssociation;
+begin
+ OldAssociation := IAssociation(FList[TPArrayPosition(Position).Index]);
+ FList.Delete(TPArrayPosition(Position).Index);
+ Result := OldAssociation;
+ // Storing interface reference as a pointer does not update reference
+ // count automatically, so this must be done manually
+ OldAssociation._Release;
+end;
+
+function TPArrayMap.GetCapacity: Integer;
+begin
+ Result := FList.Capacity;
+end;
+
+procedure TPArrayMap.SetCapacity(Value: Integer);
+begin
+ FList.Capacity := Value;
+end;
+
+function TPArrayMap.GetSize: Integer;
+begin
+ Result := FList.Count;
+end;
+
+procedure TExposedPArrayList.TrueAppend(const Item: ICollectable);
+begin
+ inherited TrueAppend(Item);
+end;
+
+procedure TExposedPArrayList.TrueInsert(Index: Integer; const Item: ICollectable);
+begin
+ inherited TrueInsert(Index, Item);
+end;
+
+{ TPArrayIterator }
+constructor TPArrayIterator.Create(List: TList; AllowRemove: Boolean);
+begin
+ inherited Create(AllowRemove);
+ FList := List;
+ FIndex := -1;
+end;
+
+function TPArrayIterator.TrueFirst: ICollectable;
+begin
+ FIndex := 0;
+ if FIndex < FList.Count then
+ Result := ICollectable(FList[FIndex])
+ else
+ Result := nil;
+end;
+
+function TPArrayIterator.TrueNext: ICollectable;
+begin
+ Inc(FIndex);
+ if FIndex < FList.Count then
+ Result := ICollectable(FList[FIndex])
+ else
+ Result := nil;
+end;
+
+procedure TPArrayIterator.TrueRemove;
+var
+ Item: ICollectable;
+begin
+ Item := ICollectable(FList[FIndex]);
+ FList.Delete(FIndex);
+ Dec(FIndex);
+ // Storing interface reference as a pointer does not update reference
+ // count automatically, so this must be done manually
+ Item._Release;
+end;
+
+{ TPArrayAssociationIterator }
+constructor TPArrayAssociationIterator.Create(List: TList; AllowRemove: Boolean);
+begin
+ inherited Create(AllowRemove);
+ FList := List;
+ FIndex := -1;
+end;
+
+function TPArrayAssociationIterator.TrueFirst: IAssociation;
+begin
+ FIndex := 0;
+ if FIndex < FList.Count then
+ Result := IAssociation(FList[FIndex])
+ else
+ Result := nil;
+end;
+
+function TPArrayAssociationIterator.TrueNext: IAssociation;
+begin
+ Inc(FIndex);
+ if FIndex < FList.Count then
+ Result := IAssociation(FList[FIndex])
+ else
+ Result := nil;
+end;
+
+procedure TPArrayAssociationIterator.TrueRemove;
+var
+ Association: IAssociation;
+begin
+ Association := IAssociation(FList[FIndex]);
+ FList.Delete(FIndex);
+ Dec(FIndex);
+ // Storing interface reference as a pointer does not update reference
+ // count automatically, so this must be done manually
+ Association._Release;
+end;
+
+{ TPArrayPosition }
+constructor TPArrayPosition.Create(Found: Boolean; Index: Integer);
+begin
+ inherited Create(Found);
+ FIndex := Index;
+end;
+
+end.
diff --git a/unicode/src/lib/collections/CollWrappers.pas b/unicode/src/lib/collections/CollWrappers.pas
new file mode 100644
index 00000000..513103a2
--- /dev/null
+++ b/unicode/src/lib/collections/CollWrappers.pas
@@ -0,0 +1,876 @@
+unit CollWrappers;
+
+(*****************************************************************************
+ * Copyright 2003 by Matthew Greet
+ * This library is free software; you can redistribute it and/or modify it
+ * under the terms of the GNU Lesser General Public License as published by the
+ * Free Software Foundation; either version 2.1 of the License, or (at your
+ * option) any later version.
+ *
+ * This library 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 Lesser General Public License for more
+ * details. (http://opensource.org/licenses/lgpl-license.php)
+ *
+ * See http://www.warmachine.u-net.com/delphi_collections for updates and downloads.
+ *
+ * $Version: v1.0.3 $
+ * $Revision: 1.1.1.1 $
+ * $Log: D:\QVCS Repositories\Delphi Collections\CollWrappers.qbt $
+ *
+ * Various primitive type wrappers, adapters and abstract base classes for
+ * natural items.
+ *
+ * Revision 1.1.1.1 by: Matthew Greet Rev date: 24/10/03 16:48:16
+ * v1.0 branch.
+ *
+ * Revision 1.1 by: Matthew Greet Rev date: 06/04/03 10:51:04
+ * Primitive type wrapper interfaces added.
+ * Abstract, template classes added.
+ * All classes implement reference counting by descending from
+ * TInterfacedObject.
+ *
+ *
+ * Revision 1.0 by: Matthew Greet Rev date: 01/03/03 10:50:02
+ * Initial revision.
+ *
+ * FPC compatibility fixes by: UltraStar Deluxe Team
+ *
+ * $Endlog$
+ *****************************************************************************)
+
+{$IFDEF FPC}
+ {$MODE Delphi}{$H+}
+{$ENDIF}
+
+interface
+
+uses
+ SysUtils,
+ Collections;
+
+type
+ IAssociationWrapper = interface
+ ['{54DF42E0-64F2-11D7-8120-0002E3165EF8}']
+ function GetAutoDestroy: Boolean;
+ procedure SetAutoDestroy(Value: Boolean);
+ function GetKey: ICollectable;
+ function GetValue: TObject;
+ property AutoDestroy: Boolean read GetAutoDestroy write SetAutoDestroy;
+ property Key: ICollectable read GetKey;
+ property Value: TObject read GetValue;
+ end;
+
+ IBoolean = interface
+ ['{62D1D160-64F2-11D7-8120-0002E3165EF8}']
+ function GetValue: Boolean;
+ property Value: Boolean read GetValue;
+ end;
+
+ ICardinal = interface
+ ['{6AF7B1C0-64F2-11D7-8120-0002E3165EF8}']
+ function GetValue: Cardinal;
+ property Value: Cardinal read GetValue;
+ end;
+
+ IChar = interface
+ ['{73AD00E0-64F2-11D7-8120-0002E3165EF8}']
+ function GetValue: Char;
+ property Value: Char read GetValue;
+ end;
+
+ IClass = interface
+ ['{7A84B660-64F2-11D7-8120-0002E3165EF8}']
+ function GetValue: TClass;
+ property Value: TClass read GetValue;
+ end;
+
+ IDouble = interface
+ ['{815C6BE0-64F2-11D7-8120-0002E3165EF8}']
+ function GetValue: Double;
+ property Value: Double read GetValue;
+ end;
+
+ IInteger = interface
+ ['{88ECC300-64F2-11D7-8120-0002E3165EF8}']
+ function GetValue: Integer;
+ property Value: Integer read GetValue;
+ end;
+
+ IIntegerAssociationWrapper = interface
+ ['{8F582220-64F2-11D7-8120-0002E3165EF8}']
+ function GetAutoDestroy: Boolean;
+ procedure SetAutoDestroy(Value: Boolean);
+ function GetKey: Integer;
+ function GetValue: TObject;
+ property AutoDestroy: Boolean read GetAutoDestroy write SetAutoDestroy;
+ property Key: Integer read GetKey;
+ property Value: TObject read GetValue;
+ end;
+
+ IInterfaceWrapper = interface
+ ['{962E5100-64F2-11D7-8120-0002E3165EF8}']
+ function GetValue: IUnknown;
+ property Value: IUnknown read GetValue;
+ end;
+
+ IObject = interface
+ ['{9C675580-64F2-11D7-8120-0002E3165EF8}']
+ function GetAutoDestroy: Boolean;
+ procedure SetAutoDestroy(Value: Boolean);
+ function GetValue: TObject;
+ property Value: TObject read GetValue;
+ end;
+
+ IString = interface
+ ['{A420DF80-64F2-11D7-8120-0002E3165EF8}']
+ function GetValue: String;
+ property Value: String read GetValue;
+ end;
+
+ IStringAssociationWrapper = interface
+ ['{AB98CCA0-64F2-11D7-8120-0002E3165EF8}']
+ function GetAutoDestroy: Boolean;
+ procedure SetAutoDestroy(Value: Boolean);
+ function GetKey: String;
+ function GetValue: TObject;
+ property AutoDestroy: Boolean read GetAutoDestroy write SetAutoDestroy;
+ property Key: String read GetKey;
+ property Value: TObject read GetValue;
+ end;
+
+ TAbstractItem = class(TInterfacedObject, ICollectable)
+ public
+ function GetInstance: TObject; virtual;
+ end;
+
+ TAbstractIntegerMappable = class(TAbstractItem, IEquatable, IIntegerMappable)
+ private
+ FKey: Integer;
+ protected
+ function MakeKey: Integer; virtual; abstract;
+ public
+ procedure AfterConstruction; override;
+ function Equals(const Item: ICollectable): Boolean; virtual;
+ function GetKey: Integer; virtual;
+ end;
+
+ TAbstractMappable = class(TAbstractItem, IEquatable, IMappable)
+ private
+ FKey: ICollectable;
+ protected
+ function MakeKey: ICollectable; virtual; abstract;
+ public
+ destructor Destroy; override;
+ procedure AfterConstruction; override;
+ function Equals(const Item: ICollectable): Boolean; virtual;
+ function GetKey: ICollectable; virtual;
+ end;
+
+ TAbstractStringMappable = class(TAbstractItem, IEquatable, IStringMappable)
+ private
+ FKey: String;
+ protected
+ function MakeKey: String; virtual; abstract;
+ public
+ procedure AfterConstruction; override;
+ function Equals(const Item: ICollectable): Boolean; virtual;
+ function GetKey: String; virtual;
+ end;
+
+ TAssociationWrapper = class(TAbstractItem, IEquatable, IMappable, IAssociationWrapper)
+ private
+ FAutoDestroy: Boolean;
+ FKey: ICollectable;
+ FValue: TObject;
+ public
+ constructor Create(const Key: ICollectable; Value: TObject); overload;
+ constructor Create(Key: Integer; Value: TObject); overload;
+ constructor Create(Key: String; Value: TObject); overload;
+ constructor Create(Key, Value: TObject; AutoDestroyKey: Boolean = true); overload;
+ destructor Destroy; override;
+ function GetAutoDestroy: Boolean;
+ procedure SetAutoDestroy(Value: Boolean);
+ function GetKey: ICollectable;
+ function GetValue: TObject;
+ function Equals(const Item: ICollectable): Boolean;
+ property AutoDestroy: Boolean read GetAutoDestroy write SetAutoDestroy;
+ property Key: ICollectable read GetKey;
+ property Value: TObject read GetValue;
+ end;
+
+ TBooleanWrapper = class(TAbstractItem, IEquatable, IHashable, IComparable, IBoolean)
+ private
+ FValue: Boolean;
+ public
+ constructor Create(Value: Boolean);
+ function GetValue: Boolean;
+ function CompareTo(const Item: ICollectable): Integer;
+ function Equals(const Item: ICollectable): Boolean;
+ function HashCode: Integer;
+ property Value: Boolean read GetValue;
+ end;
+
+ TCardinalWrapper = class(TAbstractItem, IEquatable, IHashable, IComparable, ICardinal)
+ private
+ FValue: Cardinal;
+ public
+ constructor Create(Value: Cardinal);
+ function GetValue: Cardinal;
+ function Equals(const Item: ICollectable): Boolean;
+ function HashCode: Integer;
+ function CompareTo(const Item: ICollectable): Integer;
+ property Value: Cardinal read GetValue;
+ end;
+
+ TCharWrapper = class(TAbstractItem, IEquatable, IHashable, IComparable, IChar)
+ private
+ FValue: Char;
+ public
+ constructor Create(Value: Char);
+ function GetValue: Char;
+ function Equals(const Item: ICollectable): Boolean;
+ function HashCode: Integer;
+ function CompareTo(const Item: ICollectable): Integer;
+ property Value: Char read GetValue;
+ end;
+
+ TClassWrapper = class(TAbstractItem, IEquatable, IHashable, IClass)
+ private
+ FValue: TClass;
+ public
+ constructor Create(Value: TClass);
+ function GetValue: TClass;
+ function Equals(const Item: ICollectable): Boolean;
+ function HashCode: Integer;
+ property Value: TClass read GetValue;
+ end;
+
+ TDoubleWrapper = class(TAbstractItem, IEquatable, IHashable, IComparable, IDouble)
+ private
+ FValue: Double;
+ public
+ constructor Create(Value: Double);
+ function GetValue: Double;
+ function Equals(const Item: ICollectable): Boolean;
+ function HashCode: Integer;
+ function CompareTo(const Item: ICollectable): Integer;
+ property Value: Double read GetValue;
+ end;
+
+ TIntegerWrapper = class(TAbstractItem, IEquatable, IHashable, IComparable, IInteger)
+ private
+ FValue: Integer;
+ public
+ constructor Create(Value: Integer);
+ function GetValue: Integer;
+ function Equals(const Item: ICollectable): Boolean;
+ function HashCode: Integer;
+ function CompareTo(const Item: ICollectable): Integer;
+ property Value: Integer read GetValue;
+ end;
+
+ TIntegerAssociationWrapper = class(TAbstractItem, IEquatable, IIntegerMappable, IIntegerAssociationWrapper)
+ private
+ FAutoDestroy: Boolean;
+ FKey: Integer;
+ FValue: TObject;
+ public
+ constructor Create(const Key: Integer; Value: TObject); overload;
+ destructor Destroy; override;
+ function Equals(const Item: ICollectable): Boolean;
+ function GetAutoDestroy: Boolean;
+ procedure SetAutoDestroy(Value: Boolean);
+ function GetKey: Integer;
+ function GetValue: TObject;
+ property AutoDestroy: Boolean read GetAutoDestroy write SetAutoDestroy;
+ property Key: Integer read GetKey;
+ property Value: TObject read GetValue;
+ end;
+
+ TInterfaceWrapper = class(TAbstractItem, IHashable, IEquatable, IInterfaceWrapper)
+ private
+ FValue: IUnknown;
+ public
+ constructor Create(const Value: IUnknown);
+ destructor Destroy; override;
+ function GetValue: IUnknown;
+ function Equals(const Item: ICollectable): Boolean;
+ function HashCode: Integer;
+ property Value: IUnknown read GetValue;
+ end;
+
+ TObjectWrapper = class(TAbstractItem, IEquatable, IComparable, IHashable, IObject)
+ private
+ FAutoDestroy: Boolean;
+ FValue: TObject;
+ public
+ constructor Create(Value: TObject); overload;
+ destructor Destroy; override;
+ function GetAutoDestroy: Boolean;
+ procedure SetAutoDestroy(Value: Boolean);
+ function GetValue: TObject;
+ function CompareTo(const Item: ICollectable): Integer;
+ function Equals(const Item: ICollectable): Boolean;
+ function HashCode: Integer;
+ property AutoDestroy: Boolean read FAutoDestroy write FAutoDestroy;
+ property Value: TObject read GetValue;
+ end;
+
+ TStringWrapper = class(TAbstractItem, IEquatable, IHashable, IComparable, IString)
+ private
+ FValue: String;
+ public
+ constructor Create(Value: String);
+ function GetValue: String;
+ function Equals(const Item: ICollectable): Boolean;
+ function HashCode: Integer;
+ function CompareTo(const Item: ICollectable): Integer;
+ property Value: String read FValue;
+ end;
+
+ TStringAssociationWrapper = class(TAbstractItem, IEquatable, IStringMappable, IStringAssociationWrapper)
+ private
+ FAutoDestroy: Boolean;
+ FKey: String;
+ FValue: TObject;
+ public
+ constructor Create(const Key: String; Value: TObject); overload;
+ destructor Destroy; override;
+ function GetAutoDestroy: Boolean;
+ procedure SetAutoDestroy(Value: Boolean);
+ function GetKey: String;
+ function GetValue: TObject;
+ function Equals(const Item: ICollectable): Boolean;
+ property AutoDestroy: Boolean read GetAutoDestroy write SetAutoDestroy;
+ property Key: String read GetKey;
+ property Value: TObject read GetValue;
+ end;
+
+implementation
+
+{ TAbstractItem }
+function TAbstractItem.GetInstance: TObject;
+begin
+ Result := Self;
+end;
+
+
+{ TAbstractIntegerMappable }
+procedure TAbstractIntegerMappable.AfterConstruction;
+begin
+ inherited AfterConstruction;
+ FKey := MakeKey;
+end;
+
+function TAbstractIntegerMappable.Equals(const Item: ICollectable): Boolean;
+begin
+ Result := (Self = Item.GetInstance);
+end;
+
+function TAbstractIntegerMappable.GetKey: Integer;
+begin
+ Result := FKey;
+end;
+
+{ TAbstractMappable }
+destructor TAbstractMappable.Destroy;
+begin
+ FKey := nil;
+ inherited Destroy;
+end;
+
+procedure TAbstractMappable.AfterConstruction;
+begin
+ inherited AfterConstruction;
+ FKey := MakeKey;
+end;
+
+function TAbstractMappable.Equals(const Item: ICollectable): Boolean;
+begin
+ Result := (Self = Item.GetInstance);
+end;
+
+function TAbstractMappable.GetKey: ICollectable;
+begin
+ Result := FKey;
+end;
+
+{ TAbstractStringMappable }
+procedure TAbstractStringMappable.AfterConstruction;
+begin
+ inherited AfterConstruction;
+ FKey := MakeKey;
+end;
+
+function TAbstractStringMappable.Equals(const Item: ICollectable): Boolean;
+begin
+ Result := (Self = Item.GetInstance);
+end;
+
+function TAbstractStringMappable.GetKey: String;
+begin
+ Result := FKey;
+end;
+
+{ TAssociationWrapper }
+constructor TAssociationWrapper.Create(const Key: ICollectable; Value: TObject);
+begin
+ inherited Create;
+ FAutoDestroy := true;
+ FKey := Key;
+ FValue := Value;
+end;
+
+constructor TAssociationWrapper.Create(Key: Integer; Value: TObject);
+begin
+ Create(TIntegerWrapper.Create(Key) as ICollectable, Value);
+end;
+
+constructor TAssociationWrapper.Create(Key: String; Value: TObject);
+begin
+ Create(TStringWrapper.Create(Key) as ICollectable, Value);
+end;
+
+constructor TAssociationWrapper.Create(Key, Value: TObject; AutoDestroyKey: Boolean);
+var
+ KeyWrapper: TObjectWrapper;
+begin
+ KeyWrapper := TObjectWrapper.Create(Key);
+ KeyWrapper.AutoDestroy := AutoDestroyKey;
+ Create(KeyWrapper as ICollectable, Value);
+end;
+
+destructor TAssociationWrapper.Destroy;
+begin
+ if FAutoDestroy then
+ FValue.Free;
+ FKey := nil;
+ inherited Destroy;
+end;
+
+function TAssociationWrapper.GetAutoDestroy: Boolean;
+begin
+ Result := FAutoDestroy;
+end;
+
+procedure TAssociationWrapper.SetAutoDestroy(Value: Boolean);
+begin
+ FAutoDestroy := Value;
+end;
+
+function TAssociationWrapper.GetKey: ICollectable;
+begin
+ Result := FKey;
+end;
+
+function TAssociationWrapper.GetValue: TObject;
+begin
+ Result := FValue;
+end;
+
+function TAssociationWrapper.Equals(const Item: ICollectable): Boolean;
+begin
+ Result := (Self.Value = (Item.GetInstance as TAssociationWrapper).Value)
+end;
+
+{ TCardinalWrapper }
+constructor TCardinalWrapper.Create(Value: Cardinal);
+begin
+ inherited Create;
+ FValue := Value;
+end;
+
+function TCardinalWrapper.GetValue: Cardinal;
+begin
+ Result := FValue;
+end;
+
+function TCardinalWrapper.Equals(const Item: ICollectable): Boolean;
+begin
+ Result := (Self.Value = (Item.GetInstance as TCardinalWrapper).Value)
+end;
+
+function TCardinalWrapper.HashCode: Integer;
+begin
+ Result := FValue;
+end;
+
+function TCardinalWrapper.CompareTo(const Item: ICollectable): Integer;
+var
+ Value2: Cardinal;
+begin
+ Value2 := (Item.GetInstance as TCardinalWrapper).Value;
+ if Value < Value2 then
+ Result := -1
+ else if Value > Value2 then
+ Result := 1
+ else
+ Result := 0;
+end;
+
+{ TBooleanWrapper }
+constructor TBooleanWrapper.Create(Value: Boolean);
+begin
+ inherited Create;
+ FValue := Value;
+end;
+
+function TBooleanWrapper.GetValue: Boolean;
+begin
+ Result := FValue;
+end;
+
+function TBooleanWrapper.Equals(const Item: ICollectable): Boolean;
+begin
+ Result := (Self.Value = (Item.GetInstance as TBooleanWrapper).Value)
+end;
+
+function TBooleanWrapper.HashCode: Integer;
+begin
+ Result := Ord(FValue);
+end;
+
+function TBooleanWrapper.CompareTo(const Item: ICollectable): Integer;
+var
+ Value2: Boolean;
+begin
+ Value2 := (Item.GetInstance as TBooleanWrapper).Value;
+ if not Value and Value2 then
+ Result := -1
+ else if Value and not Value2 then
+ Result := 1
+ else
+ Result := 0;
+end;
+
+{ TCharWrapper }
+constructor TCharWrapper.Create(Value: Char);
+begin
+ inherited Create;
+ FValue := Value;
+end;
+
+function TCharWrapper.GetValue: Char;
+begin
+ Result := FValue;
+end;
+
+function TCharWrapper.Equals(const Item: ICollectable): Boolean;
+begin
+ Result := (Self.Value = (Item.GetInstance as TCharWrapper).Value)
+end;
+
+function TCharWrapper.HashCode: Integer;
+begin
+ Result := Integer(FValue);
+end;
+
+function TCharWrapper.CompareTo(const Item: ICollectable): Integer;
+var
+ Value2: Char;
+begin
+ Value2 := (Item.GetInstance as TCharWrapper).Value;
+ if Value < Value2 then
+ Result := -1
+ else if Value > Value2 then
+ Result := 1
+ else
+ Result := 0;
+end;
+
+{ TClassWrapper }
+constructor TClassWrapper.Create(Value: TClass);
+begin
+ inherited Create;
+ FValue := Value;
+end;
+
+function TClassWrapper.GetValue: TClass;
+begin
+ Result := FValue;
+end;
+
+function TClassWrapper.Equals(const Item: ICollectable): Boolean;
+begin
+ Result := (Self.Value = (Item.GetInstance as TClassWrapper).Value)
+end;
+
+function TClassWrapper.HashCode: Integer;
+begin
+ Result := Integer(FValue.ClassInfo);
+end;
+
+{ TDoubleWrapper }
+constructor TDoubleWrapper.Create(Value: Double);
+begin
+ inherited Create;
+ FValue := Value;
+end;
+
+function TDoubleWrapper.GetValue: Double;
+begin
+ Result := FValue;
+end;
+
+function TDoubleWrapper.Equals(const Item: ICollectable): Boolean;
+begin
+ Result := (Self.Value = (Item.GetInstance as TDoubleWrapper).Value)
+end;
+
+function TDoubleWrapper.HashCode: Integer;
+var
+ DblAsInt: array[0..1] of Integer;
+begin
+ Double(DblAsInt) := Value;
+ Result := DblAsInt[0] xor DblAsInt[1];
+end;
+
+function TDoubleWrapper.CompareTo(const Item: ICollectable): Integer;
+var
+ Value2: Double;
+begin
+ Value2 := (Item.GetInstance as TDoubleWrapper).Value;
+ if Value < Value2 then
+ Result := -1
+ else if Value > Value2 then
+ Result := 1
+ else
+ Result := 0;
+end;
+
+{ TIntegerWrapper }
+constructor TIntegerWrapper.Create(Value: Integer);
+begin
+ inherited Create;
+ FValue := Value;
+end;
+
+function TIntegerWrapper.GetValue: Integer;
+begin
+ Result := FValue;
+end;
+
+function TIntegerWrapper.Equals(const Item: ICollectable): Boolean;
+begin
+ Result := (Self.Value = (Item.GetInstance as TIntegerWrapper).Value)
+end;
+
+function TIntegerWrapper.HashCode: Integer;
+begin
+ Result := FValue;
+end;
+
+function TIntegerWrapper.CompareTo(const Item: ICollectable): Integer;
+var
+ Value2: Integer;
+begin
+ Value2 := (Item.GetInstance as TIntegerWrapper).Value;
+ if Value < Value2 then
+ Result := -1
+ else if Value > Value2 then
+ Result := 1
+ else
+ Result := 0;
+end;
+
+{ TIntegerAssociationWrapper }
+constructor TIntegerAssociationWrapper.Create(const Key: Integer; Value: TObject);
+begin
+ inherited Create;
+ FAutoDestroy := true;
+ FKey := Key;
+ FValue := Value;
+end;
+
+destructor TIntegerAssociationWrapper.Destroy;
+begin
+ if FAutoDestroy then
+ FValue.Free;
+ inherited Destroy;
+end;
+
+function TIntegerAssociationWrapper.GetAutoDestroy: Boolean;
+begin
+ Result := FAutoDestroy;
+end;
+
+procedure TIntegerAssociationWrapper.SetAutoDestroy(Value: Boolean);
+begin
+ FAutoDestroy := Value;
+end;
+
+function TIntegerAssociationWrapper.GetValue: TObject;
+begin
+ Result := FValue;
+end;
+
+function TIntegerAssociationWrapper.Equals(const Item: ICollectable): Boolean;
+begin
+ Result := (Self.Value = (Item.GetInstance as TIntegerAssociationWrapper).Value)
+end;
+
+function TIntegerAssociationWrapper.GetKey: Integer;
+begin
+ Result := FKey;
+end;
+
+{ TStringAssociationWrapper }
+constructor TStringAssociationWrapper.Create(const Key: String; Value: TObject);
+begin
+ inherited Create;
+ FAutoDestroy := true;
+ FKey := Key;
+ FValue := Value;
+end;
+
+destructor TStringAssociationWrapper.Destroy;
+begin
+ if FAutoDestroy then
+ FValue.Free;
+ inherited Destroy;
+end;
+
+function TStringAssociationWrapper.GetAutoDestroy: Boolean;
+begin
+ Result := FAutoDestroy;
+end;
+
+procedure TStringAssociationWrapper.SetAutoDestroy(Value: Boolean);
+begin
+ FAutoDestroy := Value;
+end;
+
+function TStringAssociationWrapper.GetValue: TObject;
+begin
+ Result := FValue;
+end;
+
+function TStringAssociationWrapper.Equals(const Item: ICollectable): Boolean;
+begin
+ Result := (Self.Value = (Item.GetInstance as TStringAssociationWrapper).Value)
+end;
+
+function TStringAssociationWrapper.GetKey: String;
+begin
+ Result := FKey;
+end;
+
+{ TInterfaceWrapper }
+constructor TInterfaceWrapper.Create(const Value: IUnknown);
+begin
+ inherited Create;
+ FValue := Value;
+end;
+
+destructor TInterfaceWrapper.Destroy;
+begin
+ FValue := nil;
+ inherited Destroy;
+end;
+
+function TInterfaceWrapper.GetValue: IUnknown;
+begin
+ Result := FValue;
+end;
+
+function TInterfaceWrapper.Equals(const Item: ICollectable): Boolean;
+begin
+ Result := (Self.Value = (Item.GetInstance as TInterfaceWrapper).Value)
+end;
+
+function TInterfaceWrapper.HashCode: Integer;
+begin
+ Result := Integer(Pointer(FValue));
+end;
+
+{ TObjectWrapper }
+constructor TObjectWrapper.Create(Value: TObject);
+begin
+ inherited Create;
+ FAutoDestroy := true;
+ FValue := Value;
+end;
+
+destructor TObjectWrapper.Destroy;
+begin
+ if FAutoDestroy then
+ FValue.Free;
+ inherited Destroy;
+end;
+
+function TObjectWrapper.GetAutoDestroy: Boolean;
+begin
+ Result := FAutoDestroy;
+end;
+
+procedure TObjectWrapper.SetAutoDestroy(Value: Boolean);
+begin
+ FAutoDestroy := Value;
+end;
+
+function TObjectWrapper.GetValue: TObject;
+begin
+ Result := FValue;
+end;
+
+function TObjectWrapper.CompareTo(const Item: ICollectable): Integer;
+var
+ Value1, Value2: Integer;
+begin
+ Value1 := Integer(Pointer(Self));
+ if Item <> nil then
+ Value2 := Integer(Pointer(Item))
+ else
+ Value2 := Low(Integer);
+ if (Value1 < Value2) then
+ Result := -1
+ else if (Value1 > Value2) then
+ Result := 1
+ else
+ Result := 0;
+end;
+
+function TObjectWrapper.Equals(const Item: ICollectable): Boolean;
+begin
+ Result := (Self.Value = (Item.GetInstance as TObjectWrapper).Value)
+end;
+
+function TObjectWrapper.HashCode: Integer;
+begin
+ Result := Integer(Pointer(FValue));
+end;
+
+{ TStringWrapper }
+constructor TStringWrapper.Create(Value: String);
+begin
+ inherited Create;
+ FValue := Value;
+end;
+
+function TStringWrapper.GetValue: String;
+begin
+ Result := FValue;
+end;
+
+function TStringWrapper.Equals(const Item: ICollectable): Boolean;
+begin
+ Result := (Self.Value = (Item.GetInstance as TStringWrapper).Value)
+end;
+
+function TStringWrapper.HashCode: Integer;
+var
+ I: Integer;
+begin
+ Result := 0;
+ for I := 1 to Length(FValue) do
+ Result := (Result shl 1) xor Ord(FValue[I]);
+end;
+
+function TStringWrapper.CompareTo(const Item: ICollectable): Integer;
+begin
+ Result := CompareStr(Self.Value, (Item.GetInstance as TStringWrapper).Value)
+end;
+
+
+end.
diff --git a/unicode/src/lib/collections/Collections.pas b/unicode/src/lib/collections/Collections.pas
new file mode 100644
index 00000000..0c94173d
--- /dev/null
+++ b/unicode/src/lib/collections/Collections.pas
@@ -0,0 +1,5318 @@
+unit Collections;
+(*****************************************************************************
+ * Copyright 2003 by Matthew Greet
+ * This library is free software; you can redistribute it and/or modify it
+ * under the terms of the GNU Lesser General Public License as published by the
+ * Free Software Foundation; either version 2.1 of the License, or (at your
+ * option) any later version.
+ *
+ * This library 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 Lesser General Public License for more
+ * details. (http://opensource.org/licenses/lgpl-license.php)
+ *
+ * See http://www.warmachine.u-net.com/delphi_collections for updates and downloads.
+ *
+ * $Version: v1.0 $
+ * $Revision: 1.1.1.4 $
+ * $Log: D:\QVCS Repositories\Delphi Collections\Collections.qbt $
+ *
+ * Main unit containing all interface and abstract class definitions.
+ *
+ * Revision 1.1.1.4 by: Matthew Greet Rev date: 14/03/05 23:26:32
+ * Fixed RemoveAll for TAbstractList for sorted lists.
+ *
+ * Revision 1.1.1.3 by: Matthew Greet Rev date: 14/10/04 16:31:18
+ * Fixed memory lean in ContainsKey of TAbstractStringMap and
+ * TAbstractIntegerMap.
+ *
+ * Revision 1.1.1.2 by: Matthew Greet Rev date: 12/06/04 20:03:26
+ * Capacity property.
+ * Memory leak fixed.
+ *
+ * Revision 1.1.1.1 by: Matthew Greet Rev date: 13/02/04 16:12:10
+ * v1.0 branch.
+ *
+ * Revision 1.1 by: Matthew Greet Rev date: 06/04/03 10:36:30
+ * Added integer map and string map collection types with supporting
+ * classes.
+ * Add clone and filter functions with supporting classes.
+ * Added nil not allowed collection error.
+ * Properties appear in collection interfaces as well as abstract
+ * classes.
+ *
+ * Revision 1.0 by: Matthew Greet Rev date: 01/03/03 10:50:02
+ * Initial revision.
+ *
+ * FPC compatibility fixes by: UltraStar Deluxe Team
+ *
+ * $Endlog$
+ *****************************************************************************)
+
+{$IFDEF FPC}
+ {$MODE Delphi}{$H+}
+{$ENDIF}
+
+interface
+
+uses
+ Classes, SysUtils;
+
+const
+ EquatableIID: TGUID = '{EAC823A7-0B90-11D7-8120-0002E3165EF8}';
+ HashableIID: TGUID = '{98998440-4C3E-11D7-8120-0002E3165EF8}';
+ ComparableIID: TGUID = '{9F4C96C0-0CF0-11D7-8120-0002E3165EF8}';
+ MappableIID: TGUID = '{DAEC8CA0-0DBB-11D7-8120-0002E3165EF8}';
+ StringMappableIID: TGUID = '{3CC61F40-5F92-11D7-8120-0002E3165EF8}';
+ IntegerMappableIID: TGUID = '{774FC760-5F92-11D7-8120-0002E3165EF8}';
+
+type
+ TDefaultComparator = class;
+ TNaturalComparator = class;
+ ICollectable = interface;
+
+ TCollectableArray = array of ICollectable;
+ TIntegerArray = array of Integer;
+ TStringArray = array of String;
+ TListArray = array of TList;
+
+ TCollectionError = (ceOK, ceDuplicate, ceDuplicateKey, ceFixedSize, ceNilNotAllowed, ceNotNaturalItem, ceOutOfRange);
+ TCollectionErrors = set of TCollectionError;
+
+ TSearchResultType = (srNotFound, srFoundAtIndex, srBeforeIndex, srAfterEnd);
+
+ TCollectionType = (ctBag, ctSet, ctList, ctMap, ctIntegerMap, ctStringMap);
+
+ TCollectionFilterFunc = function (const Item: ICollectable): Boolean of object;
+ TCollectionCompareFunc = function (const Item1, Item2: ICollectable): Integer of object;
+
+ TSearchResult = record
+ ResultType: TSearchResultType;
+ Index: Integer;
+ end;
+
+ ICollectable = interface
+ ['{98998441-4C3E-11D7-8120-0002E3165EF8}']
+ function GetInstance: TObject;
+ end;
+
+ IEquatable = interface
+ ['{EAC823A7-0B90-11D7-8120-0002E3165EF8}']
+ function GetInstance: TObject;
+ function Equals(const Item: ICollectable): Boolean;
+ end;
+
+ IHashable = interface(IEquatable)
+ ['{98998440-4C3E-11D7-8120-0002E3165EF8}']
+ function HashCode: Integer;
+ end;
+
+ IComparable = interface(IEquatable)
+ ['{9F4C96C0-0CF0-11D7-8120-0002E3165EF8}']
+ function CompareTo(const Item: ICollectable): Integer;
+ end;
+
+ IMappable = interface(IEquatable)
+ ['{DAEC8CA0-0DBB-11D7-8120-0002E3165EF8}']
+ function GetKey: ICollectable;
+ end;
+
+ IStringMappable = interface(IEquatable)
+ ['{3CC61F40-5F92-11D7-8120-0002E3165EF8}']
+ function GetKey: String;
+ end;
+
+ IIntegerMappable = interface(IEquatable)
+ ['{774FC760-5F92-11D7-8120-0002E3165EF8}']
+ function GetKey: Integer;
+ end;
+
+ IComparator = interface
+ ['{1F20CD60-10FE-11D7-8120-0002E3165EF8}']
+ function GetInstance: TObject;
+ function Compare(const Item1, Item2: ICollectable): Integer;
+ function Equals(const Item1, Item2: ICollectable): Boolean; overload;
+ function Equals(const Comparator: IComparator): Boolean; overload;
+ end;
+
+ IFilter = interface
+ ['{27FE44C0-638E-11D7-8120-0002E3165EF8}']
+ function Accept(const Item: ICollectable): Boolean;
+ end;
+
+ IIterator = interface
+ ['{F6930500-1113-11D7-8120-0002E3165EF8}']
+ function GetAllowRemoval: Boolean;
+ function CurrentItem: ICollectable;
+ function EOF: Boolean;
+ function First: ICollectable;
+ function Next: ICollectable;
+ function Remove: Boolean;
+ end;
+
+ IMapIterator = interface(IIterator)
+ ['{848CC0E0-2A31-11D7-8120-0002E3165EF8}']
+ function CurrentKey: ICollectable;
+ end;
+
+ IIntegerMapIterator = interface(IIterator)
+ ['{C7169780-606C-11D7-8120-0002E3165EF8}']
+ function CurrentKey: Integer;
+ end;
+
+ IStringMapIterator = interface(IIterator)
+ ['{1345ED20-5F93-11D7-8120-0002E3165EF8}']
+ function CurrentKey: String;
+ end;
+
+ IAssociation = interface(ICollectable)
+ ['{556CD700-4DB3-11D7-8120-0002E3165EF8}']
+ function GetKey: ICollectable;
+ function GetValue: ICollectable;
+ end;
+
+ IIntegerAssociation = interface(ICollectable)
+ ['{ED954420-5F94-11D7-8120-0002E3165EF8}']
+ function GetKey: Integer;
+ function GetValue: ICollectable;
+ end;
+
+ IStringAssociation = interface(ICollectable)
+ ['{FB87D2A0-5F94-11D7-8120-0002E3165EF8}']
+ function GetKey: String;
+ function GetValue: ICollectable;
+ end;
+
+ IAssociationComparator = interface(IComparator)
+ ['{EA9BE6E0-A852-11D8-B93A-0002E3165EF8}']
+ function GetKeyComparator: IComparator;
+ procedure SetKeyComparator(Value: IComparator);
+ property KeyComparator: IComparator read GetKeyComparator write SetKeyComparator;
+ end;
+
+ IIntegerAssociationComparator = interface(IComparator)
+ ['{EA9BE6E1-A852-11D8-B93A-0002E3165EF8}']
+ end;
+
+ IStringAssociationComparator = interface(IComparator)
+ ['{EA9BE6E2-A852-11D8-B93A-0002E3165EF8}']
+ end;
+
+ ICollection = interface
+ ['{EAC823AC-0B90-11D7-8120-0002E3165EF8}']
+ function GetAsArray: TCollectableArray;
+ function GetCapacity: Integer;
+ procedure SetCapacity(Value: Integer);
+ function GetComparator: IComparator;
+ procedure SetComparator(const Value: IComparator);
+ function GetDuplicates: Boolean;
+ function GetFixedSize: Boolean;
+ function GetIgnoreErrors: TCollectionErrors;
+ procedure SetIgnoreErrors(Value: TCollectionErrors);
+ function GetInstance: TObject;
+ function GetIterator: IIterator; overload;
+ function GetIterator(const Filter: IFilter): IIterator; overload;
+ function GetIterator(FilterFunc: TCollectionFilterFunc): IIterator; overload;
+ function GetNaturalItemIID: TGUID;
+ function GetNaturalItemsOnly: Boolean;
+ function GetSize: Integer;
+ function GetType: TCollectionType;
+ function Add(const Item: ICollectable): Boolean; overload;
+ function Add(const ItemArray: array of ICollectable): Integer; overload;
+ function Add(const Collection: ICollection): Integer; overload;
+ function Clear: Integer;
+ function Clone: ICollection;
+ function Contains(const Item: ICollectable): Boolean; overload;
+ function Contains(const ItemArray: array of ICollectable): Boolean; overload;
+ function Contains(const Collection: ICollection): Boolean; overload;
+ function Equals(const Collection: ICollection): Boolean;
+ function Find(const Filter: IFilter): ICollectable; overload;
+ function Find(FilterFunc: TCollectionFilterFunc): ICollectable; overload;
+ function FindAll(const Filter: IFilter = nil): ICollection; overload;
+ function FindAll(FilterFunc: TCollectionFilterFunc): ICollection; overload;
+ function IsEmpty: Boolean;
+ function IsNaturalItem(const Item: ICollectable): Boolean;
+ function IsNilAllowed: Boolean;
+ function ItemAllowed(const Item: ICollectable): TCollectionError;
+ function ItemCount(const Item: ICollectable): Integer; overload;
+ function ItemCount(const ItemArray: array of ICollectable): Integer; overload;
+ function ItemCount(const Collection: ICollection): Integer; overload;
+ function Matching(const ItemArray: array of ICollectable): ICollection; overload;
+ function Matching(const Collection: ICollection): ICollection; overload;
+ function Remove(const Item: ICollectable): ICollectable; overload;
+ function Remove(const ItemArray: array of ICollectable): ICollection; overload;
+ function Remove(const Collection: ICollection): ICollection; overload;
+ function RemoveAll(const Item: ICollectable): ICollection; overload;
+ function RemoveAll(const ItemArray: array of ICollectable): ICollection; overload;
+ function RemoveAll(const Collection: ICollection): ICollection; overload;
+ function Retain(const ItemArray: array of ICollectable): ICollection; overload;
+ function Retain(const Collection: ICollection): ICollection; overload;
+ property AsArray: TCollectableArray read GetAsArray;
+ property Capacity: Integer read GetCapacity write SetCapacity;
+ property Comparator: IComparator read GetComparator write SetComparator;
+ property FixedSize: Boolean read GetFixedSize;
+ property IgnoreErrors: TCollectionErrors read GetIgnoreErrors write SetIgnoreErrors;
+ property NaturalItemIID: TGUID read GetNaturalItemIID;
+ property NaturalItemsOnly: Boolean read GetNaturalItemsOnly;
+ property Size: Integer read GetSize;
+ end;
+
+ IBag = interface(ICollection)
+ ['{C29C9560-2D59-11D7-8120-0002E3165EF8}']
+ function CloneAsBag: IBag;
+ end;
+
+ ISet = interface(ICollection)
+ ['{DD7888E2-0BB1-11D7-8120-0002E3165EF8}']
+ function CloneAsSet: ISet;
+ function Complement(const Universe: ISet): ISet;
+ function Intersect(const Set2: ISet): ISet;
+ function Union(const Set2: ISet): ISet;
+ end;
+
+ IList = interface(ICollection)
+ ['{EE81AB60-0B9F-11D7-8120-0002E3165EF8}']
+ function GetDuplicates: Boolean;
+ procedure SetDuplicates(Value: Boolean);
+ function GetItem(Index: Integer): ICollectable;
+ procedure SetItem(Index: Integer; const Item: ICollectable);
+ function GetSorted: Boolean;
+ procedure SetSorted(Value: Boolean);
+ function CloneAsList: IList;
+ function Delete(Index: Integer): ICollectable;
+ procedure Exchange(Index1, Index2: Integer);
+ function First: ICollectable;
+ function IndexOf(const Item: ICollectable): Integer;
+ function Insert(Index: Integer; const Item: ICollectable): Boolean; overload;
+ function Insert(Index: Integer; const ItemArray: array of ICollectable): Integer; overload;
+ function Insert(Index: Integer; const Collection: ICollection): Integer; overload;
+ function Last: ICollectable;
+ procedure Sort(const Comparator: IComparator); overload;
+ procedure Sort(CompareFunc: TCollectionCompareFunc); overload;
+ property Duplicates: Boolean read GetDuplicates write SetDuplicates;
+ property Items[Index: Integer]: ICollectable read GetItem write SetItem; default;
+ property Sorted: Boolean read GetSorted write SetSorted;
+ end;
+
+ IMap = interface(ICollection)
+ ['{AD458280-2A6B-11D7-8120-0002E3165EF8}']
+ function GetItem(const Key: ICollectable): ICollectable;
+ procedure SetItem(const Key, Item: ICollectable);
+ function GetKeyComparator: IComparator;
+ procedure SetKeyComparator(const Value: IComparator);
+ function GetKeyIterator: IIterator;
+ function GetKeys: ISet;
+ function GetMapIterator: IMapIterator;
+ function GetMapIteratorByKey(const Filter: IFilter): IMapIterator; overload;
+ function GetMapIteratorByKey(FilterFunc: TCollectionFilterFunc): IMapIterator; overload;
+ function GetNaturalKeyIID: TGUID;
+ function GetNaturalKeysOnly: Boolean;
+ function GetValues: ICollection;
+ function CloneAsMap: IMap;
+ function ContainsKey(const Key: ICollectable): Boolean; overload;
+ function ContainsKey(const KeyArray: array of ICollectable): Boolean; overload;
+ function ContainsKey(const Collection: ICollection): Boolean; overload;
+ function Get(const Key: ICollectable): ICollectable;
+ function IsNaturalKey(const Key: ICollectable): Boolean;
+ function KeyAllowed(const Key: ICollectable): TCollectionError;
+ function MatchingKey(const KeyArray: array of ICollectable): ICollection; overload;
+ function MatchingKey(const Collection: ICollection): ICollection; overload;
+ function Put(const Item: ICollectable): ICollectable; overload;
+ function Put(const Key, Item: ICollectable): ICollectable; overload;
+ function Put(const ItemArray: array of ICollectable): ICollection; overload;
+ function Put(const Collection: ICollection): ICollection; overload;
+ function Put(const Map: IMap): ICollection; overload;
+ function RemoveKey(const Key: ICollectable): ICollectable; overload;
+ function RemoveKey(const KeyArray: array of ICollectable): ICollection; overload;
+ function RemoveKey(const Collection: ICollection): ICollection; overload;
+ function RetainKey(const KeyArray: array of ICollectable): ICollection; overload;
+ function RetainKey(const Collection: ICollection): ICollection; overload;
+ property KeyComparator: IComparator read GetKeyComparator write SetKeyComparator;
+ property Items[const Key: ICollectable]: ICollectable read GetItem write SetItem; default;
+ property NaturalKeyIID: TGUID read GetNaturalKeyIID;
+ property NaturalKeysOnly: Boolean read GetNaturalKeysOnly;
+ end;
+
+ IIntegerMap = interface(ICollection)
+ ['{93DBA9A0-606C-11D7-8120-0002E3165EF8}']
+ function GetItem(const Key: Integer): ICollectable;
+ procedure SetItem(const Key: Integer; const Item: ICollectable);
+ function GetKeys: ISet;
+ function GetMapIterator: IIntegerMapIterator;
+ function GetValues: ICollection;
+ function CloneAsIntegerMap: IIntegerMap;
+ function ContainsKey(const Key: Integer): Boolean; overload;
+ function ContainsKey(const KeyArray: array of Integer): Boolean; overload;
+ function Get(const Key: Integer): ICollectable;
+ function Put(const Item: ICollectable): ICollectable; overload;
+ function Put(const Key: Integer; const Item: ICollectable): ICollectable; overload;
+ function Put(const ItemArray: array of ICollectable): ICollection; overload;
+ function Put(const Collection: ICollection): ICollection; overload;
+ function Put(const Map: IIntegerMap): ICollection; overload;
+ function RemoveKey(const Key: Integer): ICollectable; overload;
+ function RemoveKey(const KeyArray: array of Integer): ICollection; overload;
+ function RetainKey(const KeyArray: array of Integer): ICollection; overload;
+ property Items[const Key: Integer]: ICollectable read GetItem write SetItem; default;
+ end;
+
+ IStringMap = interface(ICollection)
+ ['{20531A20-5F92-11D7-8120-0002E3165EF8}']
+ function GetItem(const Key: String): ICollectable;
+ procedure SetItem(const Key: String; const Item: ICollectable);
+ function GetKeys: ISet;
+ function GetMapIterator: IStringMapIterator;
+ function GetValues: ICollection;
+ function CloneAsStringMap: IStringMap;
+ function ContainsKey(const Key: String): Boolean; overload;
+ function ContainsKey(const KeyArray: array of String): Boolean; overload;
+ function Get(const Key: String): ICollectable;
+ function Put(const Item: ICollectable): ICollectable; overload;
+ function Put(const Key: String; const Item: ICollectable): ICollectable; overload;
+ function Put(const ItemArray: array of ICollectable): ICollection; overload;
+ function Put(const Collection: ICollection): ICollection; overload;
+ function Put(const Map: IStringMap): ICollection; overload;
+ function RemoveKey(const Key: String): ICollectable; overload;
+ function RemoveKey(const KeyArray: array of String): ICollection; overload;
+ function RetainKey(const KeyArray: array of String): ICollection; overload;
+ property Items[const Key: String]: ICollectable read GetItem write SetItem; default;
+ end;
+
+ TCollectionPosition = class
+ private
+ FFound: Boolean;
+ public
+ constructor Create(Found: Boolean);
+ property Found: Boolean read FFound;
+ end;
+
+ TAbstractComparator = class(TInterfacedObject, IComparator)
+ public
+ class function GetDefaultComparator: IComparator;
+ class function GetNaturalComparator: IComparator;
+ class function GetReverseNaturalComparator: IComparator;
+ function GetInstance: TObject;
+ function Compare(const Item1, Item2: ICollectable): Integer; virtual; abstract;
+ function Equals(const Item1, Item2: ICollectable): Boolean; overload; virtual; abstract;
+ function Equals(const Comparator: IComparator): Boolean; overload; virtual;
+ end;
+
+ TDefaultComparator = class(TAbstractComparator)
+ protected
+ constructor Create;
+ public
+ function Compare(const Item1, Item2: ICollectable): Integer; override;
+ function Equals(const Item1, Item2: ICollectable): Boolean; override;
+ end;
+
+ TNaturalComparator = class(TAbstractComparator)
+ protected
+ constructor Create;
+ public
+ function Compare(const Item1, Item2: ICollectable): Integer; override;
+ function Equals(const Item1, Item2: ICollectable): Boolean; override;
+ end;
+
+ TReverseNaturalComparator = class(TAbstractComparator)
+ protected
+ constructor Create;
+ public
+ function Compare(const Item1, Item2: ICollectable): Integer; override;
+ function Equals(const Item1, Item2: ICollectable): Boolean; override;
+ end;
+
+ TAssociation = class(TInterfacedObject, ICollectable, IAssociation)
+ private
+ FKey: ICollectable;
+ FValue: ICollectable;
+ public
+ constructor Create(const Key, Value: ICollectable); virtual;
+ destructor Destroy; override;
+ function GetInstance: TObject; virtual;
+ function GetKey: ICollectable;
+ function GetValue: ICollectable;
+ end;
+
+ TIntegerAssociation = class(TInterfacedObject, ICollectable, IIntegerAssociation)
+ private
+ FKey: Integer;
+ FValue: ICollectable;
+ public
+ constructor Create(const Key: Integer; const Value: ICollectable); virtual;
+ destructor Destroy; override;
+ function GetInstance: TObject; virtual;
+ function GetKey: Integer;
+ function GetValue: ICollectable;
+ end;
+
+ TStringAssociation = class(TInterfacedObject, ICollectable, IStringAssociation)
+ private
+ FKey: String;
+ FValue: ICollectable;
+ public
+ constructor Create(const Key: String; const Value: ICollectable); virtual;
+ destructor Destroy; override;
+ function GetInstance: TObject; virtual;
+ function GetKey: String;
+ function GetValue: ICollectable;
+ end;
+
+ TAssociationComparator = class(TAbstractComparator, IAssociationComparator)
+ private
+ FKeyComparator: IComparator;
+ public
+ constructor Create(NaturalKeys: Boolean = false);
+ destructor Destroy; override;
+ function GetKeyComparator: IComparator;
+ procedure SetKeyComparator(Value: IComparator);
+ function Compare(const Item1, Item2: ICollectable): Integer; override;
+ function Equals(const Item1, Item2: ICollectable): Boolean; override;
+ property KeyComparator: IComparator read GetKeyComparator write SetKeyComparator;
+ end;
+
+ TIntegerAssociationComparator = class(TAbstractComparator, IIntegerAssociationComparator)
+ public
+ constructor Create;
+ destructor Destroy; override;
+ function Compare(const Item1, Item2: ICollectable): Integer; override;
+ function Equals(const Item1, Item2: ICollectable): Boolean; override;
+ end;
+
+ TStringAssociationComparator = class(TAbstractComparator, IStringAssociationComparator)
+ public
+ constructor Create;
+ destructor Destroy; override;
+ function Compare(const Item1, Item2: ICollectable): Integer; override;
+ function Equals(const Item1, Item2: ICollectable): Boolean; override;
+ end;
+
+
+
+ TAbstractCollection = class(TInterfacedObject, ICollection)
+ private
+ FCreated: Boolean; // Required to avoid passing destroyed object reference to exception
+ FComparator: IComparator;
+ FIgnoreErrors: TCollectionErrors;
+ FNaturalItemsOnly: Boolean;
+ protected
+ procedure CollectionError(ErrorType: TCollectionError);
+ procedure InitFrom(const Collection: ICollection); overload; virtual;
+ function TrueAdd(const Item: ICollectable): Boolean; virtual; abstract;
+ procedure TrueClear; virtual; abstract;
+ function TrueContains(const Item: ICollectable): Boolean; virtual; abstract;
+ function TrueItemCount(const Item: ICollectable): Integer; virtual;
+ function TrueRemove(const Item: ICollectable): ICollectable; virtual; abstract;
+ function TrueRemoveAll(const Item: ICollectable): ICollection; virtual; abstract;
+ public
+ constructor Create; overload; virtual;
+ constructor Create(NaturalItemsOnly: Boolean); overload; virtual;
+ constructor Create(const ItemArray: array of ICollectable); overload; virtual;
+ constructor Create(const ItemArray: array of ICollectable; NaturalItemsOnly: Boolean); overload; virtual;
+ constructor Create(const Collection: ICollection); overload; virtual;
+ destructor Destroy; override;
+ class function GetAlwaysNaturalItems: Boolean; virtual;
+ function GetAsArray: TCollectableArray; virtual;
+ function GetCapacity: Integer; virtual; abstract;
+ procedure SetCapacity(Value: Integer); virtual; abstract;
+ function GetComparator: IComparator; virtual;
+ procedure SetComparator(const Value: IComparator); virtual;
+ function GetDuplicates: Boolean; virtual;
+ function GetFixedSize: Boolean; virtual;
+ function GetIgnoreErrors: TCollectionErrors;
+ procedure SetIgnoreErrors(Value: TCollectionErrors);
+ function GetInstance: TObject;
+ function GetIterator: IIterator; overload; virtual; abstract;
+ function GetIterator(const Filter: IFilter): IIterator; overload; virtual;
+ function GetIterator(FilterFunc: TCollectionFilterFunc): IIterator; overload; virtual;
+ function GetNaturalItemIID: TGUID; virtual; abstract;
+ function GetNaturalItemsOnly: Boolean; virtual;
+ function GetSize: Integer; virtual; abstract;
+ function GetType: TCollectionType; virtual; abstract;
+ function Add(const Item: ICollectable): Boolean; overload; virtual;
+ function Add(const ItemArray: array of ICollectable): Integer; overload; virtual;
+ function Add(const Collection: ICollection): Integer; overload; virtual;
+ procedure AfterConstruction; override;
+ procedure BeforeDestruction; override;
+ function Clear: Integer; virtual;
+ function Clone: ICollection; virtual;
+ function Contains(const Item: ICollectable): Boolean; overload; virtual;
+ function Contains(const ItemArray: array of ICollectable): Boolean; overload; virtual;
+ function Contains(const Collection: ICollection): Boolean; overload; virtual;
+ function Equals(const Collection: ICollection): Boolean; virtual;
+ function Find(const Filter: IFilter): ICollectable; overload; virtual;
+ function Find(FilterFunc: TCollectionFilterFunc): ICollectable; overload; virtual;
+ function FindAll(const Filter: IFilter): ICollection; overload; virtual;
+ function FindAll(FilterFunc: TCollectionFilterFunc): ICollection; overload; virtual;
+ function IsEmpty: Boolean; virtual;
+ function IsNaturalItem(const Item: ICollectable): Boolean; virtual;
+ function IsNilAllowed: Boolean; virtual; abstract;
+ function ItemAllowed(const Item: ICollectable): TCollectionError; virtual;
+ function ItemCount(const Item: ICollectable): Integer; overload; virtual;
+ function ItemCount(const ItemArray: array of ICollectable): Integer; overload; virtual;
+ function ItemCount(const Collection: ICollection): Integer; overload; virtual;
+ function Matching(const ItemArray: array of ICollectable): ICollection; overload; virtual;
+ function Matching(const Collection: ICollection): ICollection; overload; virtual;
+ function Remove(const Item: ICollectable): ICollectable; overload; virtual;
+ function Remove(const ItemArray: array of ICollectable): ICollection; overload; virtual;
+ function Remove(const Collection: ICollection): ICollection; overload; virtual;
+ function RemoveAll(const Item: ICollectable): ICollection; overload; virtual;
+ function RemoveAll(const ItemArray: array of ICollectable): ICollection; overload; virtual;
+ function RemoveAll(const Collection: ICollection): ICollection; overload; virtual;
+ function Retain(const ItemArray: array of ICollectable): ICollection; overload; virtual;
+ function Retain(const Collection: ICollection): ICollection; overload; virtual;
+ property AsArray: TCollectableArray read GetAsArray;
+ property Capacity: Integer read GetCapacity write SetCapacity;
+ property Comparator: IComparator read GetComparator write SetComparator;
+ property FixedSize: Boolean read GetFixedSize;
+ property IgnoreErrors: TCollectionErrors read GetIgnoreErrors write SetIgnoreErrors;
+ property NaturalItemIID: TGUID read GetNaturalItemIID;
+ property NaturalItemsOnly: Boolean read GetNaturalItemsOnly;
+ property Size: Integer read GetSize;
+ end;
+
+ TAbstractBag = class(TAbstractCollection, IBag)
+ public
+ function CloneAsBag: IBag; virtual;
+ function GetNaturalItemIID: TGUID; override;
+ function GetType: TCollectionType; override;
+ function IsNilAllowed: Boolean; override;
+ end;
+
+ TAbstractSet = class (TAbstractCollection, ISet)
+ protected
+ function GetPosition(const Item: ICollectable): TCollectionPosition; virtual; abstract;
+ function TrueAdd(const Item: ICollectable): Boolean; override;
+ procedure TrueAdd2(Position: TCollectionPosition; const Item: ICollectable); virtual; abstract;
+ function TrueContains(const Item: ICollectable): Boolean; override;
+ function TrueGet(Position: TCollectionPosition): ICollectable; virtual; abstract;
+ function TrueRemove(const Item: ICollectable): ICollectable; override;
+ procedure TrueRemove2(Position: TCollectionPosition); virtual; abstract;
+ function TrueRemoveAll(const Item: ICollectable): ICollection; override;
+ public
+ function GetDuplicates: Boolean; override;
+ function GetNaturalItemIID: TGUID; override;
+ function GetType: TCollectionType; override;
+ function CloneAsSet: ISet; virtual;
+ function Complement(const Universe: ISet): ISet; overload; virtual;
+ function Intersect(const Set2: ISet): ISet; overload; virtual;
+ function IsNilAllowed: Boolean; override;
+ function Union(const Set2: ISet): ISet; overload; virtual;
+ end;
+
+ TAbstractList = class(TAbstractCollection, IList)
+ private
+ FDuplicates: Boolean;
+ FSorted: Boolean;
+ protected
+ function BinarySearch(const Item: ICollectable): TSearchResult; virtual;
+ procedure InitFrom(const Collection: ICollection); override;
+ procedure QuickSort(Lo, Hi: Integer; const Comparator: IComparator); overload; virtual;
+ procedure QuickSort(Lo, Hi: Integer; CompareFunc: TCollectionCompareFunc); overload; virtual;
+ function SequentialSearch(const Item: ICollectable; const SearchComparator: IComparator = nil): TSearchResult; virtual;
+ function TrueContains(const Item: ICollectable): Boolean; override;
+ function TrueGetItem(Index: Integer): ICollectable; virtual; abstract;
+ procedure TrueSetItem(Index: Integer; const Item: ICollectable); virtual; abstract;
+ function TrueAdd(const Item: ICollectable): Boolean; override;
+ procedure TrueAppend(const Item: ICollectable); virtual; abstract;
+ function TrueDelete(Index: Integer): ICollectable; virtual; abstract;
+ procedure TrueInsert(Index: Integer; const Item: ICollectable); virtual; abstract;
+ function TrueItemCount(const Item: ICollectable): Integer; override;
+ function TrueRemove(const Item: ICollectable): ICollectable; override;
+ function TrueRemoveAll(const Item: ICollectable): ICollection; override;
+ public
+ constructor Create(NaturalItemsOnly: Boolean); override;
+ function GetDuplicates: Boolean; override;
+ procedure SetDuplicates(Value: Boolean); virtual;
+ function GetItem(Index: Integer): ICollectable; virtual;
+ procedure SetItem(Index: Integer; const Item: ICollectable); virtual;
+ function GetIterator: IIterator; override;
+ function GetNaturalItemIID: TGUID; override;
+ function GetSorted: Boolean; virtual;
+ procedure SetSorted(Value: Boolean); virtual;
+ function GetType: TCollectionType; override;
+ function CloneAsList: IList; virtual;
+ function Delete(Index: Integer): ICollectable; virtual;
+ procedure Exchange(Index1, Index2: Integer); virtual;
+ function First: ICollectable; virtual;
+ function IndexOf(const Item: ICollectable): Integer; virtual;
+ function Insert(Index: Integer; const Item: ICollectable): Boolean; overload; virtual;
+ function Insert(Index: Integer; const ItemArray: array of ICollectable): Integer; overload; virtual;
+ function Insert(Index: Integer; const Collection: ICollection): Integer; overload; virtual;
+ function IsNilAllowed: Boolean; override;
+ function Last: ICollectable; virtual;
+ function Search(const Item: ICollectable; const SearchComparator: IComparator = nil): TSearchResult; virtual;
+ procedure Sort(const SortComparator: IComparator = nil); overload; virtual;
+ procedure Sort(CompareFunc: TCollectionCompareFunc); overload; virtual;
+ property Duplicates: Boolean read GetDuplicates write SetDuplicates;
+ property Items[Index: Integer]: ICollectable read GetItem write SetItem; default;
+ property Sorted: Boolean read GetSorted write SetSorted;
+ end;
+
+ TAbstractMap = class(TAbstractCollection, IMap)
+ private
+ FAssociationComparator: IAssociationComparator;
+ FKeyComparator: IComparator;
+ FNaturalKeysOnly: Boolean;
+ protected
+ function GetAssociationIterator: IMapIterator; virtual; abstract;
+ function GetKeyPosition(const Key: ICollectable): TCollectionPosition; virtual; abstract;
+ procedure InitFrom(const Collection: ICollection); override;
+ function TrueAdd(const Item: ICollectable): Boolean; override;
+ function TrueContains(const Item: ICollectable): Boolean; override;
+ function TrueGet(Position: TCollectionPosition): IAssociation; virtual; abstract;
+ function TruePut(Position: TCollectionPosition; const Association: IAssociation): IAssociation; virtual; abstract;
+ function TrueRemove(const Item: ICollectable): ICollectable; override;
+ function TrueRemove2(Position: TCollectionPosition): IAssociation; virtual; abstract;
+ function TrueRemoveAll(const Item: ICollectable): ICollection; override;
+ property AssociationComparator: IAssociationComparator read FAssociationComparator;
+ public
+ constructor Create; override;
+ constructor Create(NaturalItemsOnly: Boolean); override;
+ constructor Create(NaturalItemsOnly: Boolean; NaturalKeysOnly: Boolean); overload; virtual;
+ constructor Create(const ItemArray: array of ICollectable); overload; override;
+ constructor Create(const ItemArray: array of ICollectable; NaturalItemsOnly: Boolean); overload; override;
+ constructor Create(const ItemArray: array of ICollectable; NaturalItemsOnly: Boolean; NaturalKeysOnly: Boolean); overload; virtual;
+ constructor Create(const KeyArray, ItemArray: array of ICollectable); overload; virtual;
+ constructor Create(const KeyArray, ItemArray: array of ICollectable; NaturalItemsOnly: Boolean); overload; virtual;
+ constructor Create(const KeyArray, ItemArray: array of ICollectable; NaturalItemsOnly: Boolean; NaturalKeysOnly: Boolean); overload; virtual;
+// Don't use this parameter signature as it hits a compiler bug in D5.
+// constructor Create(const KeyArray, ItemArray: TCollectableArray; NaturalItemsOnly: Boolean = false; NaturalKeysOnly: Boolean = true); overload; virtual;
+ constructor Create(const Map: IMap); overload; virtual;
+ destructor Destroy; override;
+ class function GetAlwaysNaturalKeys: Boolean; virtual;
+ function GetItem(const Key: ICollectable): ICollectable; virtual;
+ procedure SetItem(const Key, Item: ICollectable); virtual;
+ function GetIterator: IIterator; override;
+ function GetKeyComparator: IComparator; virtual;
+ procedure SetKeyComparator(const Value: IComparator); virtual;
+ function GetKeyIterator: IIterator; virtual;
+ function GetKeys: ISet; virtual;
+ function GetMapIterator: IMapIterator; virtual;
+ function GetMapIteratorByKey(const Filter: IFilter): IMapIterator; overload; virtual;
+ function GetMapIteratorByKey(FilterFunc: TCollectionFilterFunc): IMapIterator; overload; virtual;
+ function GetNaturalItemIID: TGUID; override;
+ function GetNaturalKeyIID: TGUID; virtual;
+ function GetNaturalKeysOnly: Boolean; virtual;
+ function GetType: TCollectionType; override;
+ function GetValues: ICollection; virtual;
+ function Clone: ICollection; override;
+ function CloneAsMap: IMap; virtual;
+ function ContainsKey(const Key: ICollectable): Boolean; overload; virtual;
+ function ContainsKey(const KeyArray: array of ICollectable): Boolean; overload; virtual;
+ function ContainsKey(const Collection: ICollection): Boolean; overload; virtual;
+ function Get(const Key: ICollectable): ICollectable; virtual;
+ function KeyAllowed(const Key: ICollectable): TCollectionError; virtual;
+ function IsNaturalKey(const Key: ICollectable): Boolean; virtual;
+ function IsNilAllowed: Boolean; override;
+ function MatchingKey(const KeyArray: array of ICollectable): ICollection; overload; virtual;
+ function MatchingKey(const Collection: ICollection): ICollection; overload; virtual;
+ function Put(const Item: ICollectable): ICollectable; overload; virtual;
+ function Put(const Key, Item: ICollectable): ICollectable; overload; virtual;
+ function Put(const ItemArray: array of ICollectable): ICollection; overload; virtual;
+ function Put(const Collection: ICollection): ICollection; overload; virtual;
+ function Put(const Map: IMap): ICollection; overload; virtual;
+ function RemoveKey(const Key: ICollectable): ICollectable; overload; virtual;
+ function RemoveKey(const KeyArray: array of ICollectable): ICollection; overload; virtual;
+ function RemoveKey(const Collection: ICollection): ICollection; overload; virtual;
+ function RetainKey(const KeyArray: array of ICollectable): ICollection; overload; virtual;
+ function RetainKey(const Collection: ICollection): ICollection; overload; virtual;
+ property KeyComparator: IComparator read GetKeyComparator write SetKeyComparator;
+ property Items[const Key: ICollectable]: ICollectable read GetItem write SetItem; default;
+ property NaturalKeyIID: TGUID read GetNaturalKeyIID;
+ property NaturalKeysOnly: Boolean read GetNaturalKeysOnly;
+ end;
+
+ TAbstractIntegerMap = class(TAbstractCollection, IIntegerMap)
+ private
+ FAssociationComparator: IIntegerAssociationComparator;
+ protected
+ function GetAssociationIterator: IIntegerMapIterator; virtual; abstract;
+ function GetKeyPosition(const Key: Integer): TCollectionPosition; virtual; abstract;
+ function TrueAdd(const Item: ICollectable): Boolean; override;
+ function TrueContains(const Item: ICollectable): Boolean; override;
+ function TrueGet(Position: TCollectionPosition): IIntegerAssociation; virtual; abstract;
+ function TruePut(Position: TCollectionPosition; const Association: IIntegerAssociation): IIntegerAssociation; virtual; abstract;
+ function TrueRemove(const Item: ICollectable): ICollectable; override;
+ function TrueRemove2(Position: TCollectionPosition): IIntegerAssociation; virtual; abstract;
+ function TrueRemoveAll(const Item: ICollectable): ICollection; override;
+ property AssociationComparator: IIntegerAssociationComparator read FAssociationComparator;
+ public
+ constructor Create(NaturalItemsOnly: Boolean); override;
+ constructor Create(const ItemArray: array of ICollectable); overload; override;
+ constructor Create(const ItemArray: array of ICollectable; NaturalItemsOnly: Boolean); overload; override;
+ constructor Create(const KeyArray: array of Integer; const ItemArray: array of ICollectable); overload; virtual;
+ constructor Create(const KeyArray: array of Integer; const ItemArray: array of ICollectable; NaturalItemsOnly: Boolean); overload; virtual;
+ constructor Create(const Map: IIntegerMap); overload; virtual;
+ destructor Destroy; override;
+ function GetItem(const Key: Integer): ICollectable; virtual;
+ procedure SetItem(const Key: Integer; const Item: ICollectable); virtual;
+ function GetIterator: IIterator; override;
+ function GetKeys: ISet; virtual;
+ function GetMapIterator: IIntegerMapIterator; virtual;
+ function GetNaturalItemIID: TGUID; override;
+ function GetType: TCollectionType; override;
+ function GetValues: ICollection; virtual;
+ function Clone: ICollection; override;
+ function CloneAsIntegerMap: IIntegerMap; virtual;
+ function ContainsKey(const Key: Integer): Boolean; overload; virtual;
+ function ContainsKey(const KeyArray: array of Integer): Boolean; overload; virtual;
+ function Get(const Key: Integer): ICollectable; virtual;
+ function IsNilAllowed: Boolean; override;
+ function Put(const Item: ICollectable): ICollectable; overload; virtual;
+ function Put(const Key: Integer; const Item: ICollectable): ICollectable; overload; virtual;
+ function Put(const ItemArray: array of ICollectable): ICollection; overload; virtual;
+ function Put(const Collection: ICollection): ICollection; overload; virtual;
+ function Put(const Map: IIntegerMap): ICollection; overload; virtual;
+ function RemoveKey(const Key: Integer): ICollectable; overload; virtual;
+ function RemoveKey(const KeyArray: array of Integer): ICollection; overload; virtual;
+ function RetainKey(const KeyArray: array of Integer): ICollection; overload; virtual;
+ property Items[const Key: Integer]: ICollectable read GetItem write SetItem; default;
+ end;
+
+ TAbstractStringMap = class(TAbstractCollection, IStringMap)
+ private
+ FAssociationComparator: IStringAssociationComparator;
+ protected
+ function GetAssociationIterator: IStringMapIterator; virtual; abstract;
+ function GetKeyPosition(const Key: String): TCollectionPosition; virtual; abstract;
+ function TrueAdd(const Item: ICollectable): Boolean; override;
+ function TrueContains(const Item: ICollectable): Boolean; override;
+ function TrueGet(Position: TCollectionPosition): IStringAssociation; virtual; abstract;
+ function TruePut(Position: TCollectionPosition; const Association: IStringAssociation): IStringAssociation; virtual; abstract;
+ function TrueRemove(const Item: ICollectable): ICollectable; override;
+ function TrueRemove2(Position: TCollectionPosition): IStringAssociation; virtual; abstract;
+ function TrueRemoveAll(const Item: ICollectable): ICollection; override;
+ property AssociationComparator: IStringAssociationComparator read FAssociationComparator;
+ public
+ constructor Create(NaturalItemsOnly: Boolean); override;
+ constructor Create(const ItemArray: array of ICollectable); overload; override;
+ constructor Create(const ItemArray: array of ICollectable; NaturalItemsOnly: Boolean); overload; override;
+ constructor Create(const KeyArray: array of String; const ItemArray: array of ICollectable); overload; virtual;
+ constructor Create(const KeyArray: array of String; const ItemArray: array of ICollectable; NaturalItemsOnly: Boolean); overload; virtual;
+ constructor Create(const Map: IStringMap); overload; virtual;
+ destructor Destroy; override;
+ function GetItem(const Key: String): ICollectable; virtual;
+ procedure SetItem(const Key: String; const Item: ICollectable); virtual;
+ function GetIterator: IIterator; override;
+ function GetKeys: ISet; virtual;
+ function GetMapIterator: IStringMapIterator; virtual;
+ function GetNaturalItemIID: TGUID; override;
+ function GetType: TCollectionType; override;
+ function GetValues: ICollection; virtual;
+ function Clone: ICollection; override;
+ function CloneAsStringMap: IStringMap; virtual;
+ function ContainsKey(const Key: String): Boolean; overload; virtual;
+ function ContainsKey(const KeyArray: array of String): Boolean; overload; virtual;
+ function Get(const Key: String): ICollectable; virtual;
+ function IsNilAllowed: Boolean; override;
+ function Put(const Item: ICollectable): ICollectable; overload; virtual;
+ function Put(const Key: String; const Item: ICollectable): ICollectable; overload; virtual;
+ function Put(const ItemArray: array of ICollectable): ICollection; overload; virtual;
+ function Put(const Collection: ICollection): ICollection; overload; virtual;
+ function Put(const Map: IStringMap): ICollection; overload; virtual;
+ function RemoveKey(const Key: String): ICollectable; overload; virtual;
+ function RemoveKey(const KeyArray: array of String): ICollection; overload; virtual;
+ function RetainKey(const KeyArray: array of String): ICollection; overload; virtual;
+ property Items[const Key: String]: ICollectable read GetItem write SetItem; default;
+ end;
+
+ TAbstractCollectionClass = class of TAbstractCollection;
+ TAbstractBagClass = class of TAbstractBag;
+ TAbstractSetClass = class of TAbstractSet;
+ TAbstractListClass = class of TAbstractList;
+ TAbstractMapClass = class of TAbstractMap;
+ TAbstractIntegerMapClass = class of TAbstractIntegerMap;
+ TAbstractStringMapClass = class of TAbstractStringMap;
+
+ TAbstractIterator = class(TInterfacedObject, IIterator)
+ private
+ FAllowRemoval: Boolean;
+ FEOF: Boolean;
+ FItem: ICollectable;
+ protected
+ constructor Create(AllowRemoval: Boolean = true);
+ function TrueFirst: ICollectable; virtual; abstract;
+ function TrueNext: ICollectable; virtual; abstract;
+ procedure TrueRemove; virtual; abstract;
+ public
+ procedure AfterConstruction; override;
+ function GetAllowRemoval: Boolean; virtual;
+ function CurrentItem: ICollectable; virtual;
+ function EOF: Boolean; virtual;
+ function First: ICollectable; virtual;
+ function Next: ICollectable; virtual;
+ function Remove: Boolean; virtual;
+ property AllowRemoval: Boolean read GetAllowRemoval;
+ end;
+
+ TAbstractListIterator = class(TAbstractIterator)
+ private
+ FCollection: TAbstractList;
+ FIndex: Integer;
+ protected
+ constructor Create(Collection: TAbstractList);
+ function TrueFirst: ICollectable; override;
+ function TrueNext: ICollectable; override;
+ procedure TrueRemove; override;
+ end;
+
+ TAbstractMapIterator = class(TAbstractIterator, IMapIterator)
+ public
+ function CurrentKey: ICollectable; virtual; abstract;
+ end;
+
+ TAbstractAssociationIterator = class(TInterfacedObject, IIterator, IMapIterator)
+ private
+ FAllowRemoval: Boolean;
+ FEOF: Boolean;
+ FAssociation: IAssociation;
+ protected
+ constructor Create(AllowRemoval: Boolean = true);
+ function TrueFirst: IAssociation; virtual; abstract;
+ function TrueNext: IAssociation; virtual; abstract;
+ procedure TrueRemove; virtual; abstract;
+ public
+ procedure AfterConstruction; override;
+ function GetAllowRemoval: Boolean; virtual;
+ function CurrentKey: ICollectable; virtual;
+ function CurrentItem: ICollectable; virtual;
+ function EOF: Boolean; virtual;
+ function First: ICollectable; virtual;
+ function Next: ICollectable; virtual;
+ function Remove: Boolean; virtual;
+ property AllowRemoval: Boolean read GetAllowRemoval;
+ end;
+
+ TAbstractIntegerAssociationIterator = class(TInterfacedObject, IIterator, IIntegerMapIterator)
+ private
+ FAllowRemoval: Boolean;
+ FEOF: Boolean;
+ FAssociation: IIntegerAssociation;
+ protected
+ constructor Create(AllowRemoval: Boolean = true);
+ function TrueFirst: IIntegerAssociation; virtual; abstract;
+ function TrueNext: IIntegerAssociation; virtual; abstract;
+ procedure TrueRemove; virtual; abstract;
+ public
+ procedure AfterConstruction; override;
+ function GetAllowRemoval: Boolean; virtual;
+ function CurrentKey: Integer; virtual;
+ function CurrentItem: ICollectable; virtual;
+ function EOF: Boolean; virtual;
+ function First: ICollectable; virtual;
+ function Next: ICollectable; virtual;
+ function Remove: Boolean; virtual;
+ property AllowRemoval: Boolean read GetAllowRemoval;
+ end;
+
+ TAbstractStringAssociationIterator = class(TInterfacedObject, IIterator, IStringMapIterator)
+ private
+ FAllowRemoval: Boolean;
+ FEOF: Boolean;
+ FAssociation: IStringAssociation;
+ protected
+ constructor Create(AllowRemoval: Boolean = true);
+ function TrueFirst: IStringAssociation; virtual; abstract;
+ function TrueNext: IStringAssociation; virtual; abstract;
+ procedure TrueRemove; virtual; abstract;
+ public
+ procedure AfterConstruction; override;
+ function GetAllowRemoval: Boolean; virtual;
+ function CurrentKey: String; virtual;
+ function CurrentItem: ICollectable; virtual;
+ function EOF: Boolean; virtual;
+ function First: ICollectable; virtual;
+ function Next: ICollectable; virtual;
+ function Remove: Boolean; virtual;
+ property AllowRemoval: Boolean read GetAllowRemoval;
+ end;
+
+ TAssociationIterator = class(TAbstractIterator, IMapIterator)
+ private
+ FIterator: IIterator;
+ protected
+ function TrueFirst: ICollectable; override;
+ function TrueNext: ICollectable; override;
+ procedure TrueRemove; override;
+ public
+ constructor Create(const Iterator: IIterator);
+ destructor Destroy; override;
+ function CurrentItem: ICollectable; override;
+ function CurrentKey: ICollectable; virtual;
+ end;
+
+ TAssociationKeyIterator = class(TAbstractIterator)
+ private
+ FIterator: IMapIterator;
+ protected
+ function TrueFirst: ICollectable; override;
+ function TrueNext: ICollectable; override;
+ procedure TrueRemove; override;
+ public
+ constructor Create(const Iterator: IMapIterator);
+ destructor Destroy; override;
+ end;
+
+ TAbstractFilter = class(TInterfacedObject, IFilter)
+ public
+ function Accept(const Item: ICollectable): Boolean; virtual; abstract;
+ end;
+
+ TFilterIterator = class(TAbstractIterator)
+ private
+ FIterator: IIterator;
+ FFilter: IFilter;
+ protected
+ function TrueFirst: ICollectable; override;
+ function TrueNext: ICollectable; override;
+ procedure TrueRemove; override;
+ public
+ constructor Create(const Iterator: IIterator; const Filter: IFilter; AllowRemoval: Boolean = true); virtual;
+ destructor Destroy; override;
+ end;
+
+ TFilterFuncIterator = class(TAbstractIterator)
+ private
+ FIterator: IIterator;
+ FFilterFunc: TCollectionFilterFunc;
+ protected
+ function TrueFirst: ICollectable; override;
+ function TrueNext: ICollectable; override;
+ procedure TrueRemove; override;
+ public
+ constructor Create(const Iterator: IIterator; FilterFunc: TCollectionFilterFunc; AllowRemoval: Boolean = true); virtual;
+ destructor Destroy; override;
+ end;
+
+ TKeyFilterMapIterator = class(TAbstractMapIterator)
+ private
+ FIterator: IMapIterator;
+ FFilter: IFilter;
+ protected
+ function TrueFirst: ICollectable; override;
+ function TrueNext: ICollectable; override;
+ procedure TrueRemove; override;
+ public
+ constructor Create(const Iterator: IMapIterator; const Filter: IFilter; AllowRemoval: Boolean = true); virtual;
+ destructor Destroy; override;
+ function CurrentKey: ICollectable; override;
+ end;
+
+ TKeyFilterFuncMapIterator = class(TAbstractMapIterator)
+ private
+ FIterator: IMapIterator;
+ FFilterFunc: TCollectionFilterFunc;
+ protected
+ function TrueFirst: ICollectable; override;
+ function TrueNext: ICollectable; override;
+ procedure TrueRemove; override;
+ public
+ constructor Create(const Iterator: IMapIterator; FilterFunc: TCollectionFilterFunc; AllowRemoval: Boolean = true); virtual;
+ destructor Destroy; override;
+ function CurrentKey: ICollectable; override;
+ end;
+
+
+ ECollectionError = class(Exception)
+ private
+ FCollection: ICollection;
+ FErrorType: TCollectionError;
+ public
+ constructor Create(const Msg: String; const Collection: ICollection; ErrorType: TCollectionError);
+ property Collection: ICollection read FCollection;
+ property ErrorType: TCollectionError read FErrorType;
+ end;
+
+implementation
+
+uses
+ Math,
+ CollArray, CollHash, CollList, CollPArray, CollWrappers;
+
+var
+ FDefaultComparator: IComparator;
+ FNaturalComparator: IComparator;
+ FReverseNaturalComparator: IComparator;
+
+{ TCollectionPosition }
+constructor TCollectionPosition.Create(Found: Boolean);
+begin
+ FFound := Found;
+end;
+
+{ TAbstractComparator }
+class function TAbstractComparator.GetDefaultComparator: IComparator;
+begin
+ if FDefaultComparator = nil then
+ FDefaultComparator := TDefaultComparator.Create;
+ Result := FDefaultComparator;
+end;
+
+class function TAbstractComparator.GetNaturalComparator: IComparator;
+begin
+ if FNaturalComparator = nil then
+ FNaturalComparator := TNaturalComparator.Create;
+ Result := FNaturalComparator;
+end;
+
+class function TAbstractComparator.GetReverseNaturalComparator: IComparator;
+begin
+ if FReverseNaturalComparator = nil then
+ FReverseNaturalComparator := TReverseNaturalComparator.Create;
+ Result := FReverseNaturalComparator;
+end;
+
+function TAbstractComparator.GetInstance: TObject;
+begin
+ Result := Self;
+end;
+
+function TAbstractComparator.Equals(const Comparator: IComparator): Boolean;
+begin
+ Result := (Self = Comparator.GetInstance);
+end;
+
+{ TDefaultComparator }
+constructor TDefaultComparator.Create;
+begin
+ // Empty
+end;
+
+function TDefaultComparator.Compare(const Item1, Item2: ICollectable): Integer;
+var
+ Value1, Value2: Integer;
+begin
+ if Item1 <> nil then
+ Value1 := Integer(Pointer(Item1))
+ else
+ Value1 := Low(Integer);
+ if Item2 <> nil then
+ Value2 := Integer(Pointer(Item2))
+ else
+ Value2 := Low(Integer);
+ if (Value1 < Value2) then
+ Result := -1
+ else if (Value1 > Value2) then
+ Result := 1
+ else
+ Result := 0;
+end;
+
+function TDefaultComparator.Equals(const Item1, Item2: ICollectable): Boolean;
+begin
+ Result := (Item1 = Item2);
+end;
+
+{ TNaturalComparator }
+constructor TNaturalComparator.Create;
+begin
+ // Empty
+end;
+
+function TNaturalComparator.Compare(const Item1, Item2: ICollectable): Integer;
+begin
+ if (Item1 = nil) and (Item2 <> nil) then
+ Result := -1
+ else if (Item1 <> nil) and (Item2 = nil) then
+ Result := 1
+ else if (Item1 = nil) and (Item2 = nil) then
+ Result := 0
+ else
+ Result := (Item1 as IComparable).CompareTo(Item2);
+end;
+
+function TNaturalComparator.Equals(const Item1, Item2: ICollectable): Boolean;
+begin
+ if (Item1 = nil) or (Item2 = nil) then
+ Result := (Item1 = Item2)
+ else
+ begin
+ Result := (Item1 as IEquatable).Equals(Item2);
+ end;
+end;
+
+{ TReverseNaturalComparator }
+constructor TReverseNaturalComparator.Create;
+begin
+ // Empty
+end;
+
+function TReverseNaturalComparator.Compare(const Item1, Item2: ICollectable): Integer;
+begin
+ if (Item1 = nil) and (Item2 <> nil) then
+ Result := 1
+ else if (Item1 <> nil) and (Item2 = nil) then
+ Result := -1
+ else if (Item1 = nil) and (Item2 = nil) then
+ Result := 0
+ else
+ Result := -(Item1 as IComparable).CompareTo(Item2);
+end;
+
+function TReverseNaturalComparator.Equals(const Item1, Item2: ICollectable): Boolean;
+begin
+ if (Item1 = nil) or (Item2 = nil) then
+ Result := (Item1 = Item2)
+ else
+ Result := (Item1 as IEquatable).Equals(Item2);
+end;
+
+{ TAssociation }
+constructor TAssociation.Create(const Key, Value: ICollectable);
+begin
+ FKey := Key;
+ FValue := Value;
+end;
+
+destructor TAssociation.Destroy;
+begin
+ FKey := nil;
+ FValue := nil;
+ inherited Destroy;
+end;
+
+function TAssociation.GetInstance: TObject;
+begin
+ Result := Self;
+end;
+
+function TAssociation.GetKey: ICollectable;
+begin
+ Result := FKey;
+end;
+
+function TAssociation.GetValue: ICollectable;
+begin
+ Result := FValue;
+end;
+
+
+{ TIntegerAssociation }
+constructor TIntegerAssociation.Create(const Key: Integer; const Value: ICollectable);
+begin
+ FKey := Key;
+ FValue := Value;
+end;
+
+destructor TIntegerAssociation.Destroy;
+begin
+ FValue := nil;
+ inherited Destroy;
+end;
+
+function TIntegerAssociation.GetInstance: TObject;
+begin
+ Result := Self;
+end;
+
+function TIntegerAssociation.GetKey: Integer;
+begin
+ Result := FKey;
+end;
+
+function TIntegerAssociation.GetValue: ICollectable;
+begin
+ Result := FValue;
+end;
+
+
+{ TStringAssociation }
+constructor TStringAssociation.Create(const Key: String; const Value: ICollectable);
+begin
+ FKey := Key;
+ FValue := Value;
+end;
+
+destructor TStringAssociation.Destroy;
+begin
+ FValue := nil;
+ inherited Destroy;
+end;
+
+function TStringAssociation.GetInstance: TObject;
+begin
+ Result := Self;
+end;
+
+function TStringAssociation.GetKey: String;
+begin
+ Result := FKey;
+end;
+
+function TStringAssociation.GetValue: ICollectable;
+begin
+ Result := FValue;
+end;
+
+
+{ TAbstractIterator }
+constructor TAbstractIterator.Create(AllowRemoval: Boolean);
+begin
+ inherited Create;
+ FAllowRemoval := AllowRemoval;
+ FEOF := true;
+ FItem := nil;
+end;
+
+procedure TAbstractIterator.AfterConstruction;
+begin
+ inherited AfterConstruction;
+ First;
+end;
+
+function TAbstractIterator.GetAllowRemoval: Boolean;
+begin
+ Result := FAllowRemoval;
+end;
+
+function TAbstractIterator.CurrentItem: ICollectable;
+begin
+ Result := FItem;
+end;
+
+function TAbstractIterator.EOF: Boolean;
+begin
+ Result := FEOF;
+end;
+
+function TAbstractIterator.First: ICollectable;
+begin
+ FEOF := false;
+ FItem := TrueFirst;
+ if FItem = nil then
+ FEOF := true;
+ Result := FItem;
+end;
+
+function TAbstractIterator.Next: ICollectable;
+begin
+ if not FEOF then
+ begin
+ FItem := TrueNext;
+ if FItem = nil then
+ FEOF := true;
+ end;
+ Result := FItem;
+end;
+
+function TAbstractIterator.Remove: Boolean;
+begin
+ if (FItem <> nil) and FAllowRemoval then
+ begin
+ TrueRemove;
+ FItem := nil;
+ Result := true;
+ end
+ else
+ Result := false;
+end;
+
+{ TAbstractAssociationIterator }
+constructor TAbstractAssociationIterator.Create(AllowRemoval: Boolean);
+begin
+ inherited Create;
+ FAllowRemoval := AllowRemoval;
+ FEOF := true;
+ FAssociation := nil;
+end;
+
+procedure TAbstractAssociationIterator.AfterConstruction;
+begin
+ inherited AfterConstruction;
+ First;
+end;
+
+function TAbstractAssociationIterator.GetAllowRemoval: Boolean;
+begin
+ Result := FAllowRemoval;
+end;
+
+function TAbstractAssociationIterator.CurrentKey: ICollectable;
+begin
+ if FAssociation <> nil then
+ Result := FAssociation.GetKey
+ else
+ Result := nil;
+end;
+
+function TAbstractAssociationIterator.CurrentItem: ICollectable;
+begin
+ if FAssociation <> nil then
+ Result := FAssociation.GetValue
+ else
+ Result := nil;
+end;
+
+function TAbstractAssociationIterator.EOF: Boolean;
+begin
+ Result := FEOF;
+end;
+
+function TAbstractAssociationIterator.First: ICollectable;
+begin
+ FAssociation := TrueFirst;
+ if FAssociation <> nil then
+ begin
+ Result := FAssociation.GetValue;
+ FEOF := false;
+ end
+ else
+ begin
+ Result := nil;
+ FEOF := true;
+ end;
+end;
+
+function TAbstractAssociationIterator.Next: ICollectable;
+begin
+ if not FEOF then
+ begin
+ FAssociation := TrueNext;
+ if FAssociation <> nil then
+ Result := FAssociation.GetValue
+ else
+ begin
+ Result := nil;
+ FEOF := true;
+ end;
+ end;
+end;
+
+function TAbstractAssociationIterator.Remove: Boolean;
+begin
+ if (FAssociation <> nil) and FAllowRemoval then
+ begin
+ TrueRemove;
+ FAssociation := nil;
+ Result := true;
+ end
+ else
+ Result := false;
+end;
+
+{ TAbstractIntegerAssociationIterator }
+constructor TAbstractIntegerAssociationIterator.Create(AllowRemoval: Boolean);
+begin
+ inherited Create;
+ FAllowRemoval := AllowRemoval;
+ FEOF := true;
+ FAssociation := nil;
+end;
+
+procedure TAbstractIntegerAssociationIterator.AfterConstruction;
+begin
+ inherited AfterConstruction;
+ First;
+end;
+
+function TAbstractIntegerAssociationIterator.GetAllowRemoval: Boolean;
+begin
+ Result := FAllowRemoval;
+end;
+
+function TAbstractIntegerAssociationIterator.CurrentKey: Integer;
+begin
+ if FAssociation <> nil then
+ Result := FAssociation.GetKey
+ else
+ Result := 0;
+end;
+
+function TAbstractIntegerAssociationIterator.CurrentItem: ICollectable;
+begin
+ if FAssociation <> nil then
+ Result := FAssociation.GetValue
+ else
+ Result := nil;
+end;
+
+function TAbstractIntegerAssociationIterator.EOF: Boolean;
+begin
+ Result := FEOF;
+end;
+
+function TAbstractIntegerAssociationIterator.First: ICollectable;
+begin
+ FAssociation := TrueFirst;
+ if FAssociation <> nil then
+ begin
+ Result := FAssociation.GetValue;
+ FEOF := false;
+ end
+ else
+ begin
+ Result := nil;
+ FEOF := true;
+ end;
+end;
+
+function TAbstractIntegerAssociationIterator.Next: ICollectable;
+begin
+ if not FEOF then
+ begin
+ FAssociation := TrueNext;
+ if FAssociation <> nil then
+ Result := FAssociation.GetValue
+ else
+ begin
+ Result := nil;
+ FEOF := true;
+ end;
+ end;
+end;
+
+function TAbstractIntegerAssociationIterator.Remove: Boolean;
+begin
+ if (FAssociation <> nil) and FAllowRemoval then
+ begin
+ TrueRemove;
+ FAssociation := nil;
+ Result := true;
+ end
+ else
+ Result := false;
+end;
+
+{ TAbstractStringAssociationIterator }
+constructor TAbstractStringAssociationIterator.Create(AllowRemoval: Boolean);
+begin
+ inherited Create;
+ FAllowRemoval := AllowRemoval;
+ FEOF := true;
+ FAssociation := nil;
+end;
+
+procedure TAbstractStringAssociationIterator.AfterConstruction;
+begin
+ inherited AfterConstruction;
+ First;
+end;
+
+function TAbstractStringAssociationIterator.GetAllowRemoval: Boolean;
+begin
+ Result := FAllowRemoval;
+end;
+
+function TAbstractStringAssociationIterator.CurrentKey: String;
+begin
+ if FAssociation <> nil then
+ Result := FAssociation.GetKey
+ else
+ Result := '';
+end;
+
+function TAbstractStringAssociationIterator.CurrentItem: ICollectable;
+begin
+ if FAssociation <> nil then
+ Result := FAssociation.GetValue
+ else
+ Result := nil;
+end;
+
+function TAbstractStringAssociationIterator.EOF: Boolean;
+begin
+ Result := FEOF;
+end;
+
+function TAbstractStringAssociationIterator.First: ICollectable;
+begin
+ FAssociation := TrueFirst;
+ if FAssociation <> nil then
+ begin
+ Result := FAssociation.GetValue;
+ FEOF := false;
+ end
+ else
+ begin
+ Result := nil;
+ FEOF := true;
+ end;
+end;
+
+function TAbstractStringAssociationIterator.Next: ICollectable;
+begin
+ if not FEOF then
+ begin
+ FAssociation := TrueNext;
+ if FAssociation <> nil then
+ Result := FAssociation.GetValue
+ else
+ begin
+ Result := nil;
+ FEOF := true;
+ end;
+ end;
+end;
+
+function TAbstractStringAssociationIterator.Remove: Boolean;
+begin
+ if (FAssociation <> nil) and FAllowRemoval then
+ begin
+ TrueRemove;
+ FAssociation := nil;
+ Result := true;
+ end
+ else
+ Result := false;
+end;
+
+{ TAssociationIterator }
+constructor TAssociationIterator.Create(const Iterator: IIterator);
+begin
+ inherited Create(Iterator.GetAllowRemoval);
+ FIterator := Iterator;
+end;
+
+destructor TAssociationIterator.Destroy;
+begin
+ FIterator := nil;
+ inherited Destroy;
+end;
+
+function TAssociationIterator.TrueFirst: ICollectable;
+var
+ Association: IAssociation;
+begin
+ Association := FIterator.First as IAssociation;
+ if Association <> nil then
+ Result := Association.GetValue
+ else
+ Result := nil;
+end;
+
+function TAssociationIterator.TrueNext: ICollectable;
+var
+ Association: IAssociation;
+begin
+ Association := (FIterator.Next as IAssociation);
+ if Association <> nil then
+ Result := Association.GetValue
+ else
+ Result := nil;
+end;
+
+procedure TAssociationIterator.TrueRemove;
+begin
+ FIterator.Remove;
+end;
+
+function TAssociationIterator.CurrentItem: ICollectable;
+var
+ Association: IAssociation;
+begin
+ Association := FIterator.CurrentItem as IAssociation;
+ if Association <> nil then
+ Result := Association.GetValue
+ else
+ Result := nil;
+end;
+
+function TAssociationIterator.CurrentKey: ICollectable;
+var
+ Association: IAssociation;
+begin
+ Association := FIterator.CurrentItem as IAssociation;
+ if Association <> nil then
+ Result := Association.GetKey
+ else
+ Result := nil;
+end;
+
+{ TAssociationComparator }
+constructor TAssociationComparator.Create(NaturalKeys: Boolean);
+begin
+ inherited Create;
+ if NaturalKeys then
+ FKeyComparator := TAbstractComparator.GetNaturalComparator
+ else
+ FKeyComparator := TAbstractComparator.GetDefaultComparator;
+end;
+
+destructor TAssociationComparator.Destroy;
+begin
+ FKeyComparator := nil;
+ inherited Destroy;
+end;
+
+function TAssociationComparator.GetKeyComparator: IComparator;
+begin
+ Result := FKeyComparator;
+end;
+
+procedure TAssociationComparator.SetKeyComparator(Value: IComparator);
+begin
+ FKeyComparator := Value;
+end;
+
+function TAssociationComparator.Compare(const Item1, Item2: ICollectable): Integer;
+begin
+ Result := KeyComparator.Compare((Item1 as IAssociation).GetKey, (Item2 as IAssociation).GetKey);
+end;
+
+function TAssociationComparator.Equals(const Item1, Item2: ICollectable): Boolean;
+begin
+ Result := KeyComparator.Equals((Item1 as IAssociation).GetKey, (Item2 as IAssociation).GetKey);
+end;
+
+{ TIntegerAssociationComparator }
+constructor TIntegerAssociationComparator.Create;
+begin
+ inherited Create;
+end;
+
+destructor TIntegerAssociationComparator.Destroy;
+begin
+ inherited Destroy;
+end;
+
+function TIntegerAssociationComparator.Compare(const Item1, Item2: ICollectable): Integer;
+var
+ Key1, Key2: Integer;
+begin
+ Key1 := (Item1 as IIntegerAssociation).GetKey;
+ Key2 := (Item2 as IIntegerAssociation).GetKey;
+ if Key1 < Key2 then
+ Result := -1
+ else if Key1 > Key2 then
+ Result := 1
+ else
+ Result := 0;
+end;
+
+function TIntegerAssociationComparator.Equals(const Item1, Item2: ICollectable): Boolean;
+begin
+ Result := ((Item1 as IIntegerAssociation).GetKey = (Item2 as IIntegerAssociation).GetKey);
+end;
+
+{ TStringAssociationComparator }
+constructor TStringAssociationComparator.Create;
+begin
+ inherited Create;
+end;
+
+destructor TStringAssociationComparator.Destroy;
+begin
+ inherited Destroy;
+end;
+
+function TStringAssociationComparator.Compare(const Item1, Item2: ICollectable): Integer;
+var
+ Key1, Key2: String;
+begin
+ Key1 := (Item1 as IStringAssociation).GetKey;
+ Key2 := (Item2 as IStringAssociation).GetKey;
+ if Key1 < Key2 then
+ Result := -1
+ else if Key1 > Key2 then
+ Result := 1
+ else
+ Result := 0;
+end;
+
+function TStringAssociationComparator.Equals(const Item1, Item2: ICollectable): Boolean;
+begin
+ Result := ((Item1 as IStringAssociation).GetKey = (Item2 as IStringAssociation).GetKey);
+end;
+
+{ TAssociationKeyIterator }
+constructor TAssociationKeyIterator.Create(const Iterator: IMapIterator);
+begin
+ inherited Create(Iterator.GetAllowRemoval);
+ FIterator := Iterator;
+end;
+
+destructor TAssociationKeyIterator.Destroy;
+begin
+ FIterator := nil;
+ inherited Destroy;
+end;
+
+function TAssociationKeyIterator.TrueFirst: ICollectable;
+begin
+ FIterator.First;
+ Result := FIterator.CurrentKey;
+end;
+
+function TAssociationKeyIterator.TrueNext: ICollectable;
+begin
+ FIterator.Next;
+ Result := FIterator.CurrentKey;
+end;
+
+procedure TAssociationKeyIterator.TrueRemove;
+begin
+ FIterator.Remove;
+end;
+
+{ TFilterIterator }
+constructor TFilterIterator.Create(const Iterator: IIterator; const Filter: IFilter; AllowRemoval: Boolean = true);
+begin
+ FIterator := Iterator;
+ FFilter := Filter;
+end;
+
+destructor TFilterIterator.Destroy;
+begin
+ FIterator := nil;
+ FFilter := nil;
+end;
+
+function TFilterIterator.TrueFirst: ICollectable;
+var
+ Item: ICollectable;
+begin
+ Item := FIterator.First;
+ while not FIterator.EOF do
+ begin
+ if FFilter.Accept(Item) then
+ break
+ else
+ Item := FIterator.Next;
+ end;
+ Result := Item;
+end;
+
+function TFilterIterator.TrueNext: ICollectable;
+var
+ Item: ICollectable;
+begin
+ Item := FIterator.Next;
+ while not FIterator.EOF do
+ begin
+ if FFilter.Accept(Item) then
+ break
+ else
+ Item := FIterator.Next;
+ end;
+ Result := Item;
+end;
+
+procedure TFilterIterator.TrueRemove;
+begin
+ FIterator.Remove;
+end;
+
+{ TFilterFuncIterator }
+constructor TFilterFuncIterator.Create(const Iterator: IIterator; FilterFunc: TCollectionFilterFunc; AllowRemoval: Boolean = true);
+begin
+ FIterator := Iterator;
+ FFilterFunc := FilterFunc;
+end;
+
+destructor TFilterFuncIterator.Destroy;
+begin
+ FIterator := nil;
+ FFilterFunc := nil;
+end;
+
+function TFilterFuncIterator.TrueFirst: ICollectable;
+var
+ Item: ICollectable;
+begin
+ Item := FIterator.First;
+ while not FIterator.EOF do
+ begin
+ if FFilterFunc(Item) then
+ break
+ else
+ Item := FIterator.Next;
+ end;
+ Result := Item;
+end;
+
+function TFilterFuncIterator.TrueNext: ICollectable;
+var
+ Item: ICollectable;
+begin
+ Item := FIterator.Next;
+ while not FIterator.EOF do
+ begin
+ if FFilterFunc(Item) then
+ break
+ else
+ Item := FIterator.Next;
+ end;
+ Result := Item;
+end;
+
+procedure TFilterFuncIterator.TrueRemove;
+begin
+ FIterator.Remove;
+end;
+
+{ TKeyFilterMapIterator }
+constructor TKeyFilterMapIterator.Create(const Iterator: IMapIterator; const Filter: IFilter; AllowRemoval: Boolean = true);
+begin
+ FIterator := Iterator;
+ FFilter := Filter;
+end;
+
+destructor TKeyFilterMapIterator.Destroy;
+begin
+ FIterator := nil;
+ FFilter := nil;
+end;
+
+function TKeyFilterMapIterator.TrueFirst: ICollectable;
+var
+ Key, Item: ICollectable;
+begin
+ Item := FIterator.First;
+ while not FIterator.EOF do
+ begin
+ Key := FIterator.CurrentKey;
+ if FFilter.Accept(Key) then
+ break
+ else
+ Item := FIterator.Next;
+ end;
+ Result := Item;
+end;
+
+function TKeyFilterMapIterator.TrueNext: ICollectable;
+var
+ Key, Item: ICollectable;
+begin
+ Item := FIterator.Next;
+ while not FIterator.EOF do
+ begin
+ Key := FIterator.CurrentKey;
+ if FFilter.Accept(Key) then
+ break
+ else
+ Item := FIterator.Next;
+ end;
+ Result := Item;
+end;
+
+procedure TKeyFilterMapIterator.TrueRemove;
+begin
+ FIterator.Remove;
+end;
+
+function TKeyFilterMapIterator.CurrentKey: ICollectable;
+begin
+ Result := FIterator.CurrentKey;
+end;
+
+{ TKeyFilterFuncMapIterator }
+constructor TKeyFilterFuncMapIterator.Create(const Iterator: IMapIterator; FilterFunc: TCollectionFilterFunc; AllowRemoval: Boolean = true);
+begin
+ FIterator := Iterator;
+ FFilterFunc := FilterFunc;
+end;
+
+destructor TKeyFilterFuncMapIterator.Destroy;
+begin
+ FIterator := nil;
+ FFilterFunc := nil;
+end;
+
+function TKeyFilterFuncMapIterator.TrueFirst: ICollectable;
+var
+ Key, Item: ICollectable;
+begin
+ Item := FIterator.First;
+ while not FIterator.EOF do
+ begin
+ Key := FIterator.CurrentKey;
+ if FFilterFunc(Key) then
+ break
+ else
+ Item := FIterator.Next;
+ end;
+ Result := Item;
+end;
+
+function TKeyFilterFuncMapIterator.TrueNext: ICollectable;
+var
+ Key, Item: ICollectable;
+begin
+ Item := FIterator.Next;
+ while not FIterator.EOF do
+ begin
+ Key := FIterator.CurrentKey;
+ if FFilterFunc(Key) then
+ break
+ else
+ Item := FIterator.Next;
+ end;
+ Result := Item;
+end;
+
+procedure TKeyFilterFuncMapIterator.TrueRemove;
+begin
+ FIterator.Remove;
+end;
+
+function TKeyFilterFuncMapIterator.CurrentKey: ICollectable;
+begin
+ Result := FIterator.CurrentKey;
+end;
+
+
+{ TAbstractCollection }
+constructor TAbstractCollection.Create;
+begin
+ Create(false);
+end;
+
+constructor TAbstractCollection.Create(NaturalItemsOnly: Boolean);
+begin
+ FCreated := false;
+ inherited Create;
+ FNaturalItemsOnly := NaturalItemsOnly or GetAlwaysNaturalItems;
+ if FNaturalItemsOnly then
+ FComparator := TAbstractComparator.GetNaturalComparator
+ else
+ FComparator := TAbstractComparator.GetDefaultComparator;
+ FIgnoreErrors := [ceDuplicate];
+end;
+
+constructor TAbstractCollection.Create(const ItemArray: array of ICollectable);
+begin
+ Create(ItemArray, false);
+end;
+
+// Fixed size collections must override this.
+constructor TAbstractCollection.Create(const ItemArray: array of ICollectable; NaturalItemsOnly: Boolean);
+var
+ I: Integer;
+begin
+ Create(NaturalItemsOnly);
+ if not FixedSize then
+ begin
+ Capacity := Length(ItemArray);
+ for I := Low(ItemArray) to High(ItemArray) do
+ begin
+ Add(ItemArray[I]);
+ end;
+ end;
+end;
+
+// Fixed size collections must override this.
+constructor TAbstractCollection.Create(const Collection: ICollection);
+var
+ Iterator: IIterator;
+begin
+ Create(Collection.GetNaturalItemsOnly);
+ InitFrom(Collection);
+ if not FixedSize then
+ begin
+ Capacity := Collection.GetSize;
+ Iterator := Collection.GetIterator;
+ while not Iterator.EOF do
+ begin
+ Add(Iterator.CurrentItem);
+ Iterator.Next;
+ end;
+ end;
+end;
+
+destructor TAbstractCollection.Destroy;
+begin
+ FCreated := false;
+ FComparator := nil;
+ inherited Destroy;
+end;
+
+procedure TAbstractCollection.CollectionError(ErrorType: TCollectionError);
+var
+ Msg: String;
+begin
+ if not (ErrorType in FIgnoreErrors) then
+ begin
+ case ErrorType of
+ ceDuplicate: Msg := 'Collection does not allow duplicates.';
+ ceDuplicateKey: Msg := 'Collection does not allow duplicate keys.';
+ ceFixedSize: Msg := 'Collection has fixed size.';
+ ceNilNotAllowed: Msg := 'Collection does not allow nil.';
+ ceNotNaturalItem: Msg := 'Collection only accepts natural items.';
+ ceOutOfRange: Msg := 'Index out of collection range.';
+ end;
+ // If exception is thrown during construction, collection cannot be
+ // passed to it as destructor is automatically called and this leaves an
+ // interface reference to a destroyed object and crashes.
+ if FCreated then
+ raise ECollectionError.Create(Msg, Self, ErrorType)
+ else
+ raise ECollectionError.Create(Msg, nil, ErrorType);
+ end;
+end;
+
+procedure TAbstractCollection.InitFrom(const Collection: ICollection);
+begin
+ Comparator := Collection.GetComparator;
+ IgnoreErrors := Collection.GetIgnoreErrors;
+end;
+
+// Implementations should override this if possible
+function TAbstractCollection.TrueItemCount(const Item: ICollectable): Integer;
+var
+ Iterator: IIterator;
+ Total: Integer;
+begin
+ Total := 0;
+ Iterator := GetIterator;
+ while not Iterator.EOF do
+ begin
+ if FComparator.Equals(Item, Iterator.CurrentItem) then
+ Inc(Total);
+ Iterator.Next;
+ end;
+ Result := Total;
+end;
+
+class function TAbstractCollection.GetAlwaysNaturalItems: Boolean;
+begin
+ Result := false;
+end;
+
+function TAbstractCollection.GetAsArray: TCollectableArray;
+var
+ Iterator: IIterator;
+ Working: TCollectableArray;
+ I: Integer;
+begin
+ SetLength(Working, Size);
+ I := 0;
+ Iterator := GetIterator;
+ while not Iterator.EOF do
+ begin
+ Working[I] := Iterator.CurrentItem;
+ Inc(I);
+ Iterator.Next;
+ end;
+ Result := Working;
+end;
+
+function TAbstractCollection.GetComparator: IComparator;
+begin
+ Result := FComparator;
+end;
+
+function TAbstractCollection.GetDuplicates: Boolean;
+begin
+ Result := true; // Sets and lists override this.
+end;
+
+procedure TAbstractCollection.SetComparator(const Value: IComparator);
+begin
+ if Value = nil then
+ begin
+ if NaturalItemsOnly then
+ FComparator := TAbstractComparator.GetNaturalComparator
+ else
+ FComparator := TAbstractComparator.GetDefaultComparator;
+ end
+ else
+ FComparator := Value;
+end;
+
+function TAbstractCollection.GetFixedSize: Boolean;
+begin
+ Result := false;
+end;
+
+function TAbstractCollection.GetIgnoreErrors: TCollectionErrors;
+begin
+ Result := FIgnoreErrors;
+end;
+
+procedure TAbstractCollection.SetIgnoreErrors(Value: TCollectionErrors);
+begin
+ FIgnoreErrors := Value;
+end;
+
+function TAbstractCollection.GetInstance: TObject;
+begin
+ Result := Self;
+end;
+
+function TAbstractCollection.GetIterator(const Filter: IFilter): IIterator;
+var
+ Iterator: IIterator;
+begin
+ Iterator := GetIterator;
+ Result := TFilterIterator.Create(Iterator, Filter, Iterator.GetAllowRemoval);
+end;
+
+function TAbstractCollection.GetIterator(FilterFunc: TCollectionFilterFunc): IIterator;
+var
+ Iterator: IIterator;
+begin
+ Iterator := GetIterator;
+ Result := TFilterFuncIterator.Create(Iterator, FilterFunc, Iterator.GetAllowRemoval);
+end;
+
+function TAbstractCollection.GetNaturalItemsOnly: Boolean;
+begin
+ Result := FNaturalItemsOnly;
+end;
+
+function TAbstractCollection.Add(const Item: ICollectable): Boolean;
+var
+ ItemError: TCollectionError;
+ Success: Boolean;
+begin
+ ItemError := ItemAllowed(Item); // Can be natural items only error or nil not allowed error
+ if ItemError <> ceOK then
+ begin
+ CollectionError(ItemError);
+ Success := false;
+ end
+ else if FixedSize then
+ begin
+ CollectionError(ceFixedSize);
+ Success := false;
+ end
+ else
+ begin
+ Success := TrueAdd(Item);
+ end;
+ Result := Success;
+end;
+
+function TAbstractCollection.Add(const ItemArray: array of ICollectable): Integer;
+var
+ Item: ICollectable;
+ ItemError: TCollectionError;
+ I, Count: Integer;
+ Success: Boolean;
+begin
+ Count := 0;
+ if FixedSize then
+ begin
+ CollectionError(ceFixedSize);
+ end
+ else
+ begin
+ for I := Low(ItemArray) to High(ItemArray) do
+ begin
+ Item := ItemArray[I];
+ ItemError := ItemAllowed(Item);
+ if ItemError <> ceOK then
+ begin
+ CollectionError(ItemError);
+ Success := false;
+ end
+ else
+ begin
+ Success := TrueAdd(Item);
+ end;
+ if Success then
+ Inc(Count);
+ end;
+ end;
+ Result := Count;
+end;
+
+function TAbstractCollection.Add(const Collection: ICollection): Integer;
+var
+ Iterator: IIterator;
+ Item: ICollectable;
+ ItemError: TCollectionError;
+ Count: Integer;
+ Success: Boolean;
+begin
+ Count := 0;
+ Iterator := Collection.GetIterator;
+ while not Iterator.EOF do
+ begin
+ Item := Iterator.CurrentItem;
+ ItemError := ItemAllowed(Item);
+ if ItemError <> ceOK then
+ begin
+ CollectionError(ItemError);
+ Success := false;
+ end
+ else if FixedSize then
+ begin
+ CollectionError(ceFixedSize);
+ Success := false;
+ end
+ else
+ begin
+ Success := TrueAdd(Item);
+ end;
+ if Success then
+ Inc(Count);
+ Iterator.Next;
+ end;
+ Result := Count;
+end;
+
+procedure TAbstractCollection.AfterConstruction;
+begin
+ inherited AfterConstruction;
+ FCreated := true;
+end;
+
+procedure TAbstractCollection.BeforeDestruction;
+begin
+ if not FixedSize then
+ TrueClear;
+ inherited BeforeDestruction;
+end;
+
+function TAbstractCollection.Clear: Integer;
+begin
+ if not FixedSize then
+ begin
+ Result := Size;
+ TrueClear;
+ end
+ else
+ begin
+ CollectionError(ceFixedSize);
+ Result := 0;
+ end;
+end;
+
+function TAbstractCollection.Clone: ICollection;
+begin
+ Result := (TAbstractCollectionClass(ClassType)).Create(Self);
+end;
+
+function TAbstractCollection.Contains(const Item: ICollectable): Boolean;
+var
+ ItemError: TCollectionError;
+ Success: Boolean;
+begin
+ ItemError := ItemAllowed(Item);
+ if ItemError <> ceOK then
+ begin
+ CollectionError(ItemError);
+ Success := false;
+ end
+ else
+ begin
+ Success := TrueContains(Item);
+ end;
+ Result := Success;
+end;
+
+function TAbstractCollection.Contains(const ItemArray: array of ICollectable): Boolean;
+var
+ I: Integer;
+ Success: Boolean;
+begin
+ Success := true;
+ for I := Low(ItemArray) to High(ItemArray) do
+ begin
+ Success := Success and Contains(ItemArray[I]);
+ if not Success then
+ break;
+ end;
+ Result := Success;
+end;
+
+function TAbstractCollection.Contains(const Collection: ICollection): Boolean;
+var
+ Iterator: IIterator;
+ Success: Boolean;
+begin
+ Success := true;
+ Iterator := Collection.GetIterator;
+ while not Iterator.EOF do
+ begin
+ Success := Success and Contains(Iterator.CurrentItem);
+ if not Success then
+ break;
+ Iterator.Next;
+ end;
+ Result := Success;
+end;
+
+function TAbstractCollection.Equals(const Collection: ICollection): Boolean;
+var
+ Iterator: IIterator;
+ Success: Boolean;
+begin
+ if Collection.GetType <> GetType then
+ Result := false
+ else if Collection.Size <> Size then
+ Result := false
+ else if not Collection.Comparator.Equals(Comparator) then
+ Result := false
+ else if not Collection.GetDuplicates and not GetDuplicates then
+ begin
+ // Not equal if any item not found in parameter collection
+ Success := true;
+ Iterator := GetIterator;
+ while not Iterator.EOF and Success do
+ begin
+ Success := Collection.Contains(Iterator.CurrentItem);
+ Iterator.Next;
+ end;
+ Result := Success;
+ end
+ else
+ begin
+ // Not equal if any item count not equal to item count in parameter collection
+ Success := true;
+ Iterator := GetIterator;
+ while not Iterator.EOF and Success do
+ begin
+ Success := (ItemCount(Iterator.CurrentItem) = Collection.ItemCount(Iterator.CurrentItem));
+ Iterator.Next;
+ end;
+ Result := Success;
+ end;
+end;
+
+function TAbstractCollection.Find(const Filter: IFilter): ICollectable;
+begin
+ Result := GetIterator(Filter).First;
+end;
+
+function TAbstractCollection.Find(FilterFunc: TCollectionFilterFunc): ICollectable;
+begin
+ Result := GetIterator(FilterFunc).First;
+end;
+
+function TAbstractCollection.FindAll(const Filter: IFilter): ICollection;
+var
+ ResultCollection: ICollection;
+ Iterator: IIterator;
+begin
+ ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
+ Iterator := Self.GetIterator(Filter);
+ while not Iterator.EOF do
+ begin
+ ResultCollection.Add(Iterator.CurrentItem);
+ Iterator.Next;
+ end;
+ Result := ResultCollection;
+end;
+
+function TAbstractCollection.FindAll(FilterFunc: TCollectionFilterFunc): ICollection;
+var
+ ResultCollection: ICollection;
+ Iterator: IIterator;
+begin
+ ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
+ Iterator := Self.GetIterator(FilterFunc);
+ while not Iterator.EOF do
+ begin
+ ResultCollection.Add(Iterator.CurrentItem);
+ Iterator.Next;
+ end;
+ Result := ResultCollection;
+end;
+
+function TAbstractCollection.IsEmpty: Boolean;
+begin
+ Result := (Size = 0);
+end;
+
+function TAbstractCollection.IsNaturalItem(const Item: ICollectable): Boolean;
+var
+ Temp: IUnknown;
+begin
+ if Item <> nil then
+ Result := (Item.QueryInterface(NaturalItemIID, Temp) <> E_NOINTERFACE)
+ else
+ Result := false;
+end;
+
+function TAbstractCollection.ItemAllowed(const Item: ICollectable): TCollectionError;
+begin
+ if NaturalItemsOnly and not IsNaturalItem(Item) then
+ Result := ceNotNaturalItem
+ else if not IsNilAllowed and (Item = nil) then
+ Result := ceNilNotAllowed
+ else
+ Result := ceOK;
+end;
+
+function TAbstractCollection.ItemCount(const Item: ICollectable): Integer;
+var
+ ItemError: TCollectionError;
+begin
+ ItemError := ItemAllowed(Item);
+ if ItemError <> ceOK then
+ begin
+ CollectionError(ItemError);
+ Result := 0;
+ end
+ else if GetDuplicates then
+ begin
+ Result := TrueItemCount(Item);
+ end
+ else
+ begin
+ // Where duplicates are not allowed, TrueContains will be faster than TrueItemCount.
+ if TrueContains(Item) then
+ Result := 1
+ else
+ Result := 0;
+ end;
+end;
+
+function TAbstractCollection.ItemCount(const ItemArray: array of ICollectable): Integer;
+var
+ I: Integer;
+ Total: Integer;
+begin
+ Total := 0;
+ for I := Low(ItemArray) to High(ItemArray) do
+ begin
+ Total := Total + ItemCount(ItemArray[I]);
+ end;
+ Result := Total;
+end;
+
+function TAbstractCollection.ItemCount(const Collection: ICollection): Integer;
+var
+ Iterator: IIterator;
+ Total: Integer;
+begin
+ Total := 0;
+ Iterator := Collection.GetIterator;
+ while not Iterator.EOF do
+ begin
+ Total := Total + ItemCount(Iterator.CurrentItem);
+ Iterator.Next;
+ end;
+ Result := Total;
+end;
+
+function TAbstractCollection.Matching(const ItemArray: array of ICollectable): ICollection;
+var
+ ResultCollection: ICollection;
+ I: Integer;
+begin
+ ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
+ for I := Low(ItemArray) to High(ItemArray) do
+ begin
+ if Contains(ItemArray[I]) then
+ ResultCollection.Add(ItemArray[I]);
+ end;
+ Result := ResultCollection;
+end;
+
+function TAbstractCollection.Matching(const Collection: ICollection): ICollection;
+var
+ ResultCollection: ICollection;
+ Iterator: IIterator;
+begin
+ ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
+ Iterator := Collection.GetIterator;
+ while not Iterator.EOF do
+ begin
+ if Contains(Iterator.CurrentItem) then
+ ResultCollection.Add(Iterator.CurrentItem);
+ Iterator.Next;
+ end;
+ Result := ResultCollection;
+end;
+
+function TAbstractCollection.Remove(const Item: ICollectable): ICollectable;
+var
+ ItemError: TCollectionError;
+begin
+ ItemError := ItemAllowed(Item);
+ if ItemError <> ceOK then
+ begin
+ CollectionError(ItemError);
+ Result := nil;
+ end
+ else if FixedSize then
+ begin
+ CollectionError(ceFixedSize);
+ Result := nil;
+ end
+ else
+ begin
+ Result := TrueRemove(Item);
+ end;
+end;
+
+function TAbstractCollection.Remove(const ItemArray: array of ICollectable): ICollection;
+var
+ ResultCollection: ICollection;
+ I: Integer;
+begin
+ ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
+ for I := Low(ItemArray) to High(ItemArray) do
+ begin
+ ResultCollection.Add(Remove(ItemArray[I]));
+ end;
+ Result := ResultCollection;
+end;
+
+function TAbstractCollection.Remove(const Collection: ICollection): ICollection;
+var
+ ResultCollection: ICollection;
+ Iterator: IIterator;
+begin
+ ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
+ Iterator := Collection.GetIterator;
+ while not Iterator.EOF do
+ begin
+ ResultCollection.Add(Remove(Iterator.CurrentItem));
+ Iterator.Next;
+ end;
+ Result := ResultCollection;
+end;
+
+function TAbstractCollection.RemoveAll(const Item: ICollectable): ICollection;
+var
+ ItemError: TCollectionError;
+begin
+ ItemError := ItemAllowed(Item);
+ if ItemError <> ceOK then
+ begin
+ CollectionError(ItemError);
+ Result := nil;
+ end
+ else if FixedSize then
+ begin
+ CollectionError(ceFixedSize);
+ Result := nil;
+ end
+ else
+ begin
+ Result := TrueRemoveAll(Item);
+ end;
+end;
+
+function TAbstractCollection.RemoveAll(const ItemArray: array of ICollectable): ICollection;
+var
+ ResultCollection: ICollection;
+ I: Integer;
+begin
+ ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
+ for I := Low(ItemArray) to High(ItemArray) do
+ begin
+ ResultCollection.Add(RemoveAll(ItemArray[I]));
+ end;
+ Result := ResultCollection;
+end;
+
+function TAbstractCollection.RemoveAll(const Collection: ICollection): ICollection;
+var
+ ResultCollection: ICollection;
+ Iterator: IIterator;
+begin
+ ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
+ Iterator := Collection.GetIterator;
+ while not Iterator.EOF do
+ begin
+ ResultCollection.Add(RemoveAll(Iterator.CurrentItem));
+ Iterator.Next;
+ end;
+ Result := ResultCollection;
+end;
+
+function TAbstractCollection.Retain(const ItemArray: array of ICollectable): ICollection;
+var
+ ResultCollection: ICollection;
+ Iterator: IIterator;
+ Item: ICollectable;
+ I: Integer;
+ Found, Success: Boolean;
+begin
+ ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
+ Iterator := GetIterator;
+ while not Iterator.EOF do
+ begin
+ // Converting the array to a map would be faster but I don't want to
+ // couple base class code to a complex collection.
+ Found := false;
+ for I := Low(ItemArray) to High(ItemArray) do
+ begin
+ Item := Iterator.CurrentItem;
+ Found := Comparator.Equals(Item, ItemArray[I]);
+ if Found then
+ break;
+ end;
+ if not Found then
+ begin
+ Success := Iterator.Remove;
+ if Success then
+ ResultCollection.Add(Item);
+ end;
+ Iterator.Next;
+ end;
+ Result := ResultCollection;
+end;
+
+function TAbstractCollection.Retain(const Collection: ICollection): ICollection;
+var
+ ResultCollection: ICollection;
+ Iterator: IIterator;
+ Item: ICollectable;
+ Success: Boolean;
+begin
+ ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
+ Iterator := GetIterator;
+ while not Iterator.EOF do
+ begin
+ Item := Iterator.CurrentItem;
+ if not Collection.Contains(Item) then
+ begin
+ Success := Iterator.Remove;
+ if Success then
+ ResultCollection.Add(Item);
+ end;
+ Iterator.Next;
+ end;
+ Result := ResultCollection;
+end;
+
+{ TAbstractBag }
+function TAbstractBag.CloneAsBag: IBag;
+begin
+ Result := (TAbstractBagClass(ClassType)).Create(Self);
+end;
+
+function TAbstractBag.GetNaturalItemIID: TGUID;
+begin
+ Result := EquatableIID;
+end;
+
+function TAbstractBag.GetType: TCollectionType;
+begin
+ Result := ctBag;
+end;
+
+function TAbstractBag.IsNilAllowed: Boolean;
+begin
+ Result := true;
+end;
+
+{ TAbstractSet }
+function TAbstractSet.TrueAdd(const Item: ICollectable): Boolean;
+var
+ Position: TCollectionPosition;
+begin
+ // Adds if not already present otherwise fails
+ Position := GetPosition(Item);
+ try
+ if Position.Found then
+ begin
+ CollectionError(ceDuplicate);
+ Result := false;
+ end
+ else
+ begin
+ TrueAdd2(Position, Item);
+ Result := true;
+ end;
+ finally
+ Position.Free;
+ end;
+end;
+
+function TAbstractSet.TrueContains(const Item: ICollectable): Boolean;
+var
+ Position: TCollectionPosition;
+begin
+ Position := GetPosition(Item);
+ try
+ Result := Position.Found;
+ finally
+ Position.Free;
+ end;
+end;
+
+function TAbstractSet.TrueRemove(const Item: ICollectable): ICollectable;
+var
+ Position: TCollectionPosition;
+begin
+ Position := GetPosition(Item);
+ try
+ if Position.Found then
+ begin
+ Result := TrueGet(Position);
+ TrueRemove2(Position);
+ end
+ else
+ Result := nil;
+ finally
+ Position.Free;
+ end;
+end;
+
+function TAbstractSet.TrueRemoveAll(const Item: ICollectable): ICollection;
+var
+ ResultCollection: ICollection;
+ RemovedItem: ICollectable;
+begin
+ ResultCollection := TPArrayBag.Create;
+ RemovedItem := TrueRemove(Item);
+ if RemovedItem <> nil then
+ ResultCollection.Add(RemovedItem);
+ Result := ResultCollection;
+end;
+
+function TAbstractSet.GetDuplicates: Boolean;
+begin
+ Result := false;
+end;
+
+function TAbstractSet.GetNaturalItemIID: TGUID;
+begin
+ Result := EquatableIID;
+end;
+
+function TAbstractSet.GetType: TCollectionType;
+begin
+ Result := ctSet;
+end;
+
+function TAbstractSet.CloneAsSet: ISet;
+begin
+ Result := (TAbstractSetClass(ClassType)).Create(Self);
+end;
+
+function TAbstractSet.Complement(const Universe: ISet): ISet;
+var
+ ResultSet: ISet;
+ Iterator: IIterator;
+ Item: ICollectable;
+begin
+ // Return items in universe not found in self.
+ ResultSet := TAbstractSetClass(ClassType).Create(NaturalItemsOnly);
+ Iterator := Universe.GetIterator;
+ while not Iterator.EOF do
+ begin
+ Item := Iterator.CurrentItem;
+ if not Contains(Item) then
+ ResultSet.Add(Item);
+ Iterator.Next;
+ end;
+ Result := ResultSet;
+end;
+
+function TAbstractSet.Intersect(const Set2: ISet): ISet;
+var
+ ResultSet: ISet;
+ Iterator: IIterator;
+ Item: ICollectable;
+begin
+ // Return items found in self and parameter.
+ ResultSet := TAbstractSetClass(ClassType).Create(NaturalItemsOnly);
+ Iterator := GetIterator;
+ while not Iterator.EOF do
+ begin
+ Item := Iterator.CurrentItem;
+ if Contains(Item) and Set2.Contains(Item) then
+ ResultSet.Add(Iterator.CurrentItem);
+ Iterator.Next;
+ end;
+ Result := ResultSet;
+end;
+
+function TAbstractSet.IsNilAllowed: Boolean;
+begin
+ Result := false;
+end;
+
+function TAbstractSet.Union(const Set2: ISet): ISet;
+var
+ ResultSet: ISet;
+ Iterator: IIterator;
+ Item: ICollectable;
+begin
+ // Return items found in self or parameter.
+ ResultSet := CloneAsSet;
+ Iterator := Set2.GetIterator;
+ while not Iterator.EOF do
+ begin
+ Item := Iterator.CurrentItem;
+ if not Contains(Item) and Set2.Contains(Item) then
+ ResultSet.Add(Iterator.CurrentItem);
+ Iterator.Next;
+ end;
+ Result := ResultSet;
+end;
+
+{ TAbstractList }
+constructor TAbstractList.Create(NaturalItemsOnly: Boolean);
+begin
+ inherited Create(NaturalItemsOnly);
+ FDuplicates := true;
+ FSorted := false;
+end;
+
+procedure TAbstractList.InitFrom(const Collection: ICollection);
+var
+ List: IList;
+begin
+ inherited InitFrom(Collection);
+ if Collection.QueryInterface(IList, List) = S_OK then
+ begin
+ FDuplicates := List.GetDuplicates;
+ FSorted := List.GetSorted;
+ end;
+end;
+
+function TAbstractList.TrueAdd(const Item: ICollectable): Boolean;
+var
+ SearchResult: TSearchResult;
+begin
+ Result := True;
+ if Sorted then
+ begin
+ // Insert in appropriate place to maintain sort order, unless duplicate
+ // not allowed.
+ SearchResult := BinarySearch(Item);
+ case SearchResult.ResultType of
+ srBeforeIndex: TrueInsert(SearchResult.Index, Item);
+ srFoundAtIndex: begin
+ if Duplicates then
+ TrueInsert(SearchResult.Index, Item)
+ else
+ begin
+ CollectionError(ceDuplicate);
+ Result := false;
+ end;
+ end;
+ srAfterEnd: TrueAppend(Item);
+ end;
+ end
+ else
+ begin
+ // Add to end, unless duplicate not allowed.
+ if not Duplicates and (SequentialSearch(Item, Comparator).ResultType = srFoundAtIndex) then
+ begin
+ CollectionError(ceDuplicate);
+ Result := false;
+ end
+ else
+ TrueAppend(Item);
+ end;
+end;
+
+function TAbstractList.TrueContains(const Item: ICollectable): Boolean;
+begin
+ if Sorted then
+ Result := BinarySearch(Item).ResultType = srFoundAtIndex
+ else
+ Result := SequentialSearch(Item, Comparator).ResultType = srFoundAtIndex
+end;
+
+function TAbstractList.TrueItemCount(const Item: ICollectable): Integer;
+var
+ SearchResult: TSearchResult;
+ Count: Integer;
+begin
+ if Sorted then
+ begin
+ // If sorted, use binary search.
+ Count := 0;
+ SearchResult := BinarySearch(Item);
+ if SearchResult.ResultType = srFoundAtIndex then
+ begin
+ repeat
+ Inc(Count);
+ until not Comparator.Equals(Item, Items[SearchResult.Index]);
+ end;
+ Result := Count;
+ end
+ else
+ // Resort to sequential search for unsorted
+ Result := inherited TrueItemCount(Item);
+end;
+
+function TAbstractList.TrueRemove(const Item: ICollectable): ICollectable;
+var
+ SearchResult: TSearchResult;
+begin
+ Result := nil;
+ if Sorted then
+ begin
+ SearchResult := BinarySearch(Item);
+ if SearchResult.ResultType = srFoundAtIndex then
+ begin
+ Result := TrueDelete(SearchResult.Index);
+ end;
+ end
+ else
+ begin
+ SearchResult := SequentialSearch(Item);
+ if SearchResult.ResultType = srFoundAtIndex then
+ Result := TrueDelete(SearchResult.Index);
+ end;
+end;
+
+function TAbstractList.TrueRemoveAll(const Item: ICollectable): ICollection;
+var
+ ResultCollection: ICollection;
+ SearchResult: TSearchResult;
+ I: Integer;
+begin
+ ResultCollection := TPArrayBag.Create;
+ if Sorted then
+ begin
+ SearchResult := BinarySearch(Item);
+ if SearchResult.ResultType = srFoundAtIndex then
+ begin
+ repeat
+ ResultCollection.Add(TrueDelete(SearchResult.Index));
+ until not Comparator.Equals(Item, Items[SearchResult.Index]);
+ end;
+ end
+ else
+ begin
+ I := 0;
+ while I < Size do
+ begin
+ if Comparator.Equals(Item, Items[I]) then
+ begin
+ ResultCollection.Add(TrueDelete(I));
+ end
+ else
+ Inc(I);
+ end;
+ end;
+ Result := ResultCollection;
+end;
+
+procedure TAbstractList.QuickSort(Lo, Hi: Integer; const Comparator: IComparator);
+var
+ I, J, Mid: Integer;
+begin
+ repeat
+ I := Lo;
+ J := Hi;
+ Mid := (Lo + Hi) div 2;
+ repeat
+ while Comparator.Compare(Items[I], Items[Mid]) < 0 do
+ Inc(I);
+ while Comparator.Compare(Items[J], Items[Mid]) > 0 do
+ Dec(J);
+ if I <= J then
+ begin
+ Exchange(I, J);
+ if Mid = I then
+ Mid := J
+ else if Mid = J then
+ Mid := I;
+ Inc(I);
+ Dec(J);
+ end;
+ until I > J;
+ if Lo < J then
+ QuickSort(Lo, J, Comparator);
+ Lo := I;
+ until I >= Hi;
+end;
+
+procedure TAbstractList.QuickSort(Lo, Hi: Integer; CompareFunc: TCollectionCompareFunc);
+var
+ I, J, Mid: Integer;
+begin
+ repeat
+ I := Lo;
+ J := Hi;
+ Mid := (Lo + Hi) div 2;
+ repeat
+ while CompareFunc(Items[I], Items[Mid]) < 0 do
+ Inc(I);
+ while CompareFunc(Items[J], Items[Mid]) > 0 do
+ Dec(J);
+ if I <= J then
+ begin
+ Exchange(I, J);
+ if Mid = I then
+ Mid := J
+ else if Mid = J then
+ Mid := I;
+ Inc(I);
+ Dec(J);
+ end;
+ until I > J;
+ if Lo < J then
+ QuickSort(Lo, J, CompareFunc);
+ Lo := I;
+ until I >= Hi;
+end;
+
+function TAbstractList.GetDuplicates: Boolean;
+begin
+ Result := FDuplicates;
+end;
+
+procedure TAbstractList.SetDuplicates(Value: Boolean);
+var
+ Iterator: IIterator;
+ Failed: Boolean;
+begin
+ Failed := false;
+ // If trying to set no duplicates, check there are no existing duplicates.
+ if not Value then
+ begin
+ Iterator := GetIterator;
+ while not Iterator.EOF and not Failed do
+ begin
+ Failed := (ItemCount(Iterator.CurrentItem) > 1);
+ Iterator.Next;
+ end;
+ if Failed then
+ CollectionError(ceDuplicate);
+ end;
+ if not Failed then
+ FDuplicates := Value;
+end;
+
+function TAbstractList.GetItem(Index: Integer): ICollectable;
+begin
+ if (Index < 0) or (Index >= Size) then
+ begin
+ CollectionError(ceOutOfRange);
+ Result := nil;
+ end
+ else
+ Result := TrueGetItem(Index);
+end;
+
+procedure TAbstractList.SetItem(Index: Integer; const Item: ICollectable);
+var
+ SearchResult: TSearchResult;
+begin
+ if (Index < 0) or (Index >= Size) then
+ begin
+ CollectionError(ceOutOfRange)
+ end
+ else if not Duplicates then
+ begin
+ // Find any duplicates
+ if Sorted then
+ begin
+ SearchResult := BinarySearch(Item);
+ case SearchResult.ResultType of
+ srBeforeIndex, srAfterEnd: begin // If item is not present
+ FSorted := false;
+ TrueSetItem(Index, Item);
+ end;
+ srFoundAtIndex: begin // If item is already present
+ CollectionError(ceDuplicate);
+ end;
+ end;
+ end
+ else
+ begin
+ // If item is already present
+ if SequentialSearch(Item, Comparator).ResultType = srFoundAtIndex then
+ begin
+ CollectionError(ceDuplicate);
+ end
+ else
+ begin
+ TrueSetItem(Index, Item);
+ end;
+ end;
+ end
+ else
+ begin
+ FSorted := false;
+ TrueSetItem(Index, Item);
+ end;
+end;
+
+function TAbstractList.GetIterator: IIterator;
+begin
+ Result := TAbstractListIterator.Create(Self);
+end;
+
+function TAbstractList.GetNaturalItemIID: TGUID;
+begin
+ Result := ComparableIID;
+end;
+
+function TAbstractList.GetSorted: Boolean;
+begin
+ Result := FSorted;
+end;
+
+procedure TAbstractList.SetSorted(Value: Boolean);
+begin
+ if Value then
+ Sort;
+end;
+
+function TAbstractList.GetType: TCollectionType;
+begin
+ Result := ctList;
+end;
+
+function TAbstractList.BinarySearch(const Item: ICollectable): TSearchResult;
+var
+ Lo, Hi, Mid: Integer;
+ CompareResult: Integer;
+ Success: Boolean;
+begin
+ if Size = 0 then
+ begin
+ Result.ResultType := srAfterEnd;
+ Exit;
+ end;
+ Lo := 0;
+ Hi := Size - 1;
+ Success := false;
+ repeat
+ Mid := (Lo + Hi) div 2;
+ CompareResult := Comparator.Compare(Item, Items[Mid]);
+ if CompareResult = 0 then
+ Success := true
+ else if CompareResult > 0 then
+ Lo := Mid + 1
+ else
+ Hi := Mid - 1;
+ until (Lo > Hi) or Success;
+ if Success then
+ begin
+ // Move index back if in cluster of duplicates
+ while (Mid > 0) and Comparator.Equals(Item, Items[Mid - 1]) do
+ Dec(Mid);
+ Result.ResultType := srFoundAtIndex;
+ Result.Index := Mid;
+ end
+ else if CompareResult < 0 then
+ begin
+ Result.ResultType := srBeforeIndex;
+ Result.Index := Mid;
+ end
+ else if Hi < Size - 1 then
+ begin
+ Result.ResultType := srBeforeIndex;
+ Result.Index := Mid + 1;
+ end
+ else
+ Result.ResultType := srAfterEnd;
+end;
+
+function TAbstractList.CloneAsList: IList;
+begin
+ Result := (TAbstractListClass(ClassType)).Create(Self);
+end;
+
+function TAbstractList.Delete(Index: Integer): ICollectable;
+begin
+ if FixedSize then
+ begin
+ CollectionError(ceFixedSize);
+ Result := nil;
+ end
+ else if (Index < 0) or (Index >= Size) then
+ begin
+ CollectionError(ceOutOfRange);
+ Result := nil;
+ end
+ else
+ begin
+ Result := TrueDelete(Index);
+ end;
+end;
+
+procedure TAbstractList.Exchange(Index1, Index2: Integer);
+var
+ Item: ICollectable;
+begin
+ if (Index1 < 0) or (Index1 >= Size) then
+ CollectionError(ceOutOfRange);
+ if (Index2 < 0) or (Index2 >= Size) then
+ CollectionError(ceOutOfRange);
+ FSorted := false;
+ Item := ICollectable(Items[Index1]);
+ Items[Index1] := Items[Index2];
+ Items[Index2] := Item;
+end;
+
+function TAbstractList.First: ICollectable;
+begin
+ if Size > 0 then
+ Result := Items[0]
+ else
+ Result := nil;
+end;
+
+function TAbstractList.IndexOf(const Item: ICollectable): Integer;
+var
+ SearchResult: TSearchResult;
+begin
+ if Sorted then
+ SearchResult := BinarySearch(Item)
+ else
+ SearchResult := SequentialSearch(Item, Comparator);
+ if SearchResult.ResultType = srFoundAtIndex then
+ Result := SearchResult.Index
+ else
+ Result := -1;
+end;
+
+function TAbstractList.Insert(Index: Integer; const Item: ICollectable): Boolean;
+var
+ ItemError: TCollectionError;
+begin
+ ItemError := ItemAllowed(Item);
+ if ItemError <> ceOK then
+ begin
+ CollectionError(ItemError);
+ Result := false;
+ end
+ else if FixedSize then
+ begin
+ CollectionError(ceFixedSize);
+ Result := false;
+ end
+ else if (Index < 0) or (Index > Size) then
+ begin
+ CollectionError(ceOutOfRange);
+ Result := false;
+ end
+ else
+ begin
+ FSorted := false;
+ if Index = Size then
+ TrueAdd(Item)
+ else
+ TrueInsert(Index, Item);
+ Result := true;
+ end;
+end;
+
+function TAbstractList.Insert(Index: Integer; const ItemArray: array of ICollectable): Integer;
+var
+ Item: ICollectable;
+ ItemError: TCollectionError;
+ I, NewIndex, Count: Integer;
+ Success: Boolean;
+begin
+ Count := 0;
+ if FixedSize then
+ begin
+ CollectionError(ceFixedSize);
+ end
+ else if (Index < 0) or (Index > Size) then
+ begin
+ CollectionError(ceOutOfRange);
+ end
+ else
+ begin
+ // Insert entire array in place in correct order
+ NewIndex := Index;
+ for I := Low(ItemArray) to High(ItemArray) do
+ begin
+ Item := ItemArray[I];
+ ItemError := ItemAllowed(Item);
+ if ItemError <> ceOK then
+ begin
+ CollectionError(ItemError);
+ end
+ else
+ begin
+ Success := Insert(NewIndex, Item);
+ if Success then
+ begin
+ Inc(NewIndex);
+ Inc(Count);
+ end;
+ end;
+ end;
+ end;
+ Result := Count;
+end;
+
+function TAbstractList.Insert(Index: Integer; const Collection: ICollection): Integer;
+var
+ Iterator: IIterator;
+ Item: ICollectable;
+ ItemError: TCollectionError;
+ NewIndex, Count: Integer;
+ Success: Boolean;
+begin
+ Count := 0;
+ if FixedSize then
+ begin
+ CollectionError(ceFixedSize);
+ end
+ else if (Index < 0) or (Index > Size) then
+ begin
+ CollectionError(ceOutOfRange);
+ end
+ else
+ begin
+ // Insert entire collection in place in correct order
+ NewIndex := Index;
+ Iterator := Collection.GetIterator;
+ while not Iterator.EOF do
+ begin
+ Item := Iterator.CurrentItem;
+ ItemError := ItemAllowed(Item);
+ if ItemError <> ceOK then
+ begin
+ CollectionError(ItemError);
+ end
+ else
+ begin
+ Success := Insert(NewIndex, Item);
+ if Success then
+ begin
+ Inc(NewIndex);
+ Inc(Count);
+ end;
+ end;
+ Iterator.Next;
+ end;
+ end;
+ Result := Count;
+end;
+
+function TAbstractList.IsNilAllowed: Boolean;
+begin
+ Result := true;
+end;
+
+function TAbstractList.Last: ICollectable;
+begin
+ if Size > 0 then
+ Result := Items[Size - 1]
+ else
+ Result := nil;
+end;
+
+function TAbstractList.Search(const Item: ICollectable; const SearchComparator: IComparator = nil): TSearchResult;
+begin
+ if Sorted and (SearchComparator = nil) then
+ Result := BinarySearch(Item)
+ else
+ Result := SequentialSearch(Item, SearchComparator);
+end;
+
+function TAbstractList.SequentialSearch(const Item: ICollectable; const SearchComparator: IComparator): TSearchResult;
+var
+ WorkingComparator: IComparator;
+ I: Integer;
+ Success: Boolean;
+begin
+ if SearchComparator = nil then
+ WorkingComparator := Comparator
+ else
+ WorkingComparator := SearchComparator;
+ Result.ResultType := srNotFound;
+ I := 0;
+ Success := false;
+ while (I < Size) and not Success do
+ begin
+ if WorkingComparator.Equals(Item, Items[I]) then
+ begin
+ Result.ResultType := srFoundAtIndex;
+ Result.Index := I;
+ Success := true;
+ end
+ else
+ Inc(I);
+ end;
+end;
+
+procedure TAbstractList.Sort(const SortComparator: IComparator);
+begin
+ if SortComparator = nil then
+ begin
+ if Size > 0 then
+ QuickSort(0, Size - 1, Comparator);
+ FSorted := true;
+ end
+ else
+ begin
+ if Size > 0 then
+ QuickSort(0, Size - 1, SortComparator);
+ FSorted := false;
+ end;
+end;
+
+procedure TAbstractList.Sort(CompareFunc: TCollectionCompareFunc);
+begin
+ if Size > 0 then
+ QuickSort(0, Size - 1, CompareFunc);
+ FSorted := false;
+end;
+
+{ TAbstractMap }
+constructor TAbstractMap.Create;
+begin
+ Create(false, true);
+end;
+
+constructor TAbstractMap.Create(NaturalItemsOnly: Boolean);
+begin
+ Create(NaturalItemsOnly, true);
+end;
+
+constructor TAbstractMap.Create(NaturalItemsOnly: Boolean; NaturalKeysOnly: Boolean);
+begin
+ inherited Create(NaturalItemsOnly);
+ FNaturalKeysOnly := NaturalKeysOnly or GetAlwaysNaturalKeys;
+ FAssociationComparator := TAssociationComparator.Create(FNaturalKeysOnly);
+ if FNaturalKeysOnly then
+ FKeyComparator := TAbstractComparator.GetNaturalComparator
+ else
+ FKeyComparator := TAbstractComparator.GetDefaultComparator;
+end;
+
+constructor TAbstractMap.Create(const ItemArray: array of ICollectable);
+begin
+ Create(ItemArray, true, true);
+end;
+
+constructor TAbstractMap.Create(const ItemArray: array of ICollectable; NaturalItemsOnly: Boolean);
+begin
+ Create(ItemArray, true, true);
+end;
+
+constructor TAbstractMap.Create(const ItemArray: array of ICollectable; NaturalItemsOnly: Boolean; NaturalKeysOnly: Boolean);
+var
+ I: Integer;
+begin
+ Create(true, NaturalKeysOnly);
+ if not FixedSize then
+ begin
+ Capacity := Length(ItemArray);
+ for I := Low(ItemArray) to High(ItemArray) do
+ begin
+ Add(ItemArray[I]);
+ end;
+ end;
+end;
+
+constructor TAbstractMap.Create(const KeyArray, ItemArray: array of ICollectable);
+begin
+ Create(KeyArray, ItemArray, false, true);
+end;
+
+constructor TAbstractMap.Create(const KeyArray, ItemArray: array of ICollectable; NaturalItemsOnly: Boolean);
+begin
+ Create(KeyArray, ItemArray, NaturalItemsOnly, true);
+end;
+
+constructor TAbstractMap.Create(const KeyArray, ItemArray: array of ICollectable; NaturalItemsOnly: Boolean; NaturalKeysOnly: Boolean);
+var
+ I, Lo, Hi: Integer;
+begin
+ Create(NaturalItemsOnly, NaturalKeysOnly);
+ if not FixedSize then
+ begin
+ Capacity := Min(Length(KeyArray), Length(ItemArray));
+ Lo := Max(Low(KeyArray), Low(ItemArray));
+ Hi := Min(High(KeyArray), High(ItemArray));
+ for I := Lo to Hi do
+ begin
+ Put(KeyArray[I], ItemArray[I]);
+ end;
+ end;
+end;
+
+constructor TAbstractMap.Create(const Map: IMap);
+var
+ MapIterator: IMapIterator;
+begin
+ Create(Map.GetNaturalItemsOnly, Map.GetNaturalKeysOnly);
+ InitFrom(Map);
+ if not FixedSize then
+ begin
+ Capacity := Map.GetSize;
+ MapIterator := Map.GetMapIterator;
+ while not MapIterator.EOF do
+ begin
+ Put(MapIterator.CurrentKey, MapIterator.CurrentItem);
+ MapIterator.Next;
+ end;
+ end;
+end;
+
+destructor TAbstractMap.Destroy;
+begin
+ FKeyComparator := nil;
+ FAssociationComparator := nil;
+ inherited Destroy;
+end;
+
+procedure TAbstractMap.InitFrom(const Collection: ICollection);
+var
+ Map: IMap;
+begin
+ inherited InitFrom(Collection);
+ if Collection.QueryInterface(IMap, Map) = S_OK then
+ begin
+ FNaturalKeysOnly := Map.GetNaturalKeysOnly or GetAlwaysNaturalKeys;
+ KeyComparator := Map.GetKeyComparator;
+ end;
+end;
+
+function TAbstractMap.TrueAdd(const Item: ICollectable): Boolean;
+var
+ Position: TCollectionPosition;
+ Mappable: IMappable;
+begin
+ if IsNaturalItem(Item) then
+ begin
+ Mappable := Item as IMappable;
+ Position := GetKeyPosition(Mappable.GetKey);
+ try
+ if Position.Found then
+ begin
+ CollectionError(ceDuplicateKey);
+ Result := false;
+ end
+ else
+ begin
+ TruePut(Position, TAssociation.Create(Mappable.GetKey, Item));
+ Result := true;
+ end;
+ finally
+ Position.Free;
+ end;
+ end
+ else
+ begin
+ CollectionError(ceNotNaturalItem);
+ Result := false;
+ end;
+end;
+
+function TAbstractMap.TrueContains(const Item: ICollectable): Boolean;
+var
+ Item2: ICollectable;
+ Success: Boolean;
+ Iterator: IIterator;
+begin
+ Iterator := GetIterator;
+ Success := false;
+ while not Iterator.EOF and not Success do
+ begin
+ Item2 := Iterator.CurrentItem;
+ if Comparator.Equals(Item, Item2) then
+ Success := true;
+ Iterator.Next;
+ end;
+ Result := Success;
+end;
+
+function TAbstractMap.TrueRemove(const Item: ICollectable): ICollectable;
+var
+ Item2: ICollectable;
+ Iterator: IMapIterator;
+ Found: Boolean;
+begin
+ // Sequential search
+ Found := false;
+ Result := nil;
+ Iterator := GetAssociationIterator;
+ while not Iterator.EOF and not Found do
+ begin
+ Item2 := Iterator.CurrentItem;
+ if Comparator.Equals(Item, Item2) then
+ begin
+ Result := Item2;
+ Iterator.Remove;
+ Found := true;
+ end;
+ Iterator.Next;
+ end;
+end;
+
+function TAbstractMap.TrueRemoveAll(const Item: ICollectable): ICollection;
+var
+ ResultCollection: ICollection;
+ Item2: ICollectable;
+ Iterator: IMapIterator;
+begin
+ // Sequential search
+ ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
+ Iterator := GetAssociationIterator;
+ while not Iterator.EOF do
+ begin
+ Item2 := Iterator.CurrentItem;
+ if Comparator.Equals(Item, Item2) then
+ begin
+ ResultCollection.Add(Item2);
+ Iterator.Remove;
+ end;
+ Iterator.Next;
+ end;
+ Result := ResultCollection;
+end;
+
+class function TAbstractMap.GetAlwaysNaturalKeys: Boolean;
+begin
+ Result := false;
+end;
+
+function TAbstractMap.GetItem(const Key: ICollectable): ICollectable;
+begin
+ Result := Get(Key);
+end;
+
+procedure TAbstractMap.SetItem(const Key, Item: ICollectable);
+begin
+ Put(Key, Item);
+end;
+
+function TAbstractMap.GetIterator: IIterator;
+begin
+ Result := GetAssociationIterator;
+end;
+
+function TAbstractMap.GetKeyComparator: IComparator;
+begin
+ Result := FKeyComparator;
+end;
+
+procedure TAbstractMap.SetKeyComparator(const Value: IComparator);
+begin
+ FKeyComparator := Value;
+ FAssociationComparator.KeyComparator := Value;
+end;
+
+function TAbstractMap.GetKeyIterator: IIterator;
+begin
+ Result := TAssociationKeyIterator.Create(GetAssociationIterator);
+end;
+
+function TAbstractMap.GetKeys: ISet;
+var
+ ResultCollection: TPArraySet;
+ KeyIterator: IIterator;
+begin
+ ResultCollection := TPArraySet.Create(NaturalKeysOnly);
+ ResultCollection.SetComparator(GetKeyComparator);
+ KeyIterator := GetKeyIterator;
+ while not KeyIterator.EOF do
+ begin
+ ResultCollection.Add(KeyIterator.CurrentItem);
+ KeyIterator.Next;
+ end;
+ Result := ResultCollection;
+end;
+
+function TAbstractMap.GetMapIterator: IMapIterator;
+begin
+ Result := GetAssociationIterator;
+end;
+
+function TAbstractMap.GetMapIteratorByKey(const Filter: IFilter): IMapIterator;
+var
+ Iterator: IMapIterator;
+begin
+ Iterator := GetMapIterator;
+ Result := TKeyFilterMapIterator.Create(Iterator, Filter, Iterator.GetAllowRemoval);
+end;
+
+function TAbstractMap.GetMapIteratorByKey(FilterFunc: TCollectionFilterFunc): IMapIterator;
+var
+ Iterator: IMapIterator;
+begin
+ Iterator := GetMapIterator;
+ Result := TKeyFilterFuncMapIterator.Create(Iterator, FilterFunc, Iterator.GetAllowRemoval);
+end;
+
+function TAbstractMap.GetNaturalItemIID: TGUID;
+begin
+ Result := MappableIID;
+end;
+
+function TAbstractMap.GetNaturalKeyIID: TGUID;
+begin
+ Result := EquatableIID;
+end;
+
+function TAbstractMap.GetNaturalKeysOnly: Boolean;
+begin
+ Result := FNaturalKeysOnly;
+end;
+
+function TAbstractMap.GetType: TCollectionType;
+begin
+ Result := ctMap;
+end;
+
+function TAbstractMap.GetValues: ICollection;
+var
+ ResultCollection: ICollection;
+ ValueIterator: IIterator;
+begin
+ ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
+ ValueIterator := GetIterator;
+ while not ValueIterator.EOF do
+ begin
+ ResultCollection.Add(ValueIterator.CurrentItem);
+ ValueIterator.Next;
+ end;
+ Result := ResultCollection;
+end;
+
+// Overrides TAbstractCollection function, otherwise Create(ICollection) is
+// called, which cannot access keys.
+function TAbstractMap.Clone: ICollection;
+begin
+ Result := (TAbstractMapClass(ClassType)).Create(Self);
+end;
+
+function TAbstractMap.CloneAsMap: IMap;
+begin
+ Result := (TAbstractMapClass(ClassType)).Create(Self);
+end;
+
+function TAbstractMap.ContainsKey(const Key: ICollectable): Boolean;
+var
+ Position: TCollectionPosition;
+begin
+ Position := GetKeyPosition(Key);
+ try
+ Result := Position.Found;
+ finally
+ Position.Free;
+ end;
+end;
+
+function TAbstractMap.ContainsKey(const KeyArray: array of ICollectable): Boolean;
+var
+ I: Integer;
+ Success: Boolean;
+begin
+ Success := true;
+ for I := Low(KeyArray) to High(KeyArray) do
+ begin
+ Success := Success and ContainsKey(KeyArray[I]);
+ if not Success then
+ break;
+ end;
+ Result := Success;
+end;
+
+function TAbstractMap.ContainsKey(const Collection: ICollection): Boolean;
+var
+ Iterator: IIterator;
+ Success: Boolean;
+begin
+ Success := true;
+ Iterator := Collection.GetIterator;
+ while not Iterator.EOF do
+ begin
+ Success := Success and ContainsKey(Iterator.CurrentItem);
+ if not Success then
+ break;
+ Iterator.Next;
+ end;
+ Result := Success;
+end;
+
+function TAbstractMap.Get(const Key: ICollectable): ICollectable;
+var
+ KeyError: TCollectionError;
+ Position: TCollectionPosition;
+begin
+ KeyError := KeyAllowed(Key);
+ if KeyError <> ceOK then
+ begin
+ CollectionError(KeyError);
+ Result := nil;
+ end
+ else
+ begin
+ Position := GetKeyPosition(Key);
+ try
+ if Position.Found then
+ Result := TrueGet(Position).GetValue
+ else
+ Result := nil;
+ finally
+ Position.Free;
+ end;
+ end;
+end;
+
+function TAbstractMap.KeyAllowed(const Key: ICollectable): TCollectionError;
+begin
+ if NaturalKeysOnly and not IsNaturalKey(Key) then
+ Result := ceNotNaturalItem
+ else if Key = nil then
+ Result := ceNilNotAllowed
+ else
+ Result := ceOK;
+end;
+
+function TAbstractMap.IsNaturalKey(const Key: ICollectable): Boolean;
+var
+ Temp: IUnknown;
+begin
+ if Key.QueryInterface(NaturalKeyIID, Temp) <> E_NOINTERFACE then
+ Result := true
+ else
+ Result := false;
+end;
+
+function TAbstractMap.IsNilAllowed: Boolean;
+begin
+ Result := true;
+end;
+
+function TAbstractMap.MatchingKey(const KeyArray: array of ICollectable): ICollection;
+var
+ ResultCollection: ICollection;
+ I: Integer;
+begin
+ ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
+ for I := Low(KeyArray) to High(KeyArray) do
+ begin
+ if ContainsKey(KeyArray[I]) then
+ ResultCollection.Add(KeyArray[I]);
+ end;
+ Result := ResultCollection;
+end;
+
+function TAbstractMap.MatchingKey(const Collection: ICollection): ICollection;
+var
+ ResultCollection: ICollection;
+ Iterator: IIterator;
+begin
+ ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
+ Iterator := Collection.GetIterator;
+ while not Iterator.EOF do
+ begin
+ if ContainsKey(Iterator.CurrentItem) then
+ ResultCollection.Add(Iterator.CurrentItem);
+ Iterator.Next;
+ end;
+ Result := ResultCollection;
+end;
+
+function TAbstractMap.Put(const Item: ICollectable): ICollectable;
+var
+ Mappable: IMappable;
+ OldAssociation, NewAssociation: IAssociation;
+ Position: TCollectionPosition;
+begin
+ if not IsNaturalItem(Item) then
+ begin
+ CollectionError(ceNotNaturalItem);
+ Result := nil;
+ end
+ else
+ begin
+ Item.QueryInterface(IMappable, Mappable);
+ Position := GetKeyPosition(Mappable.GetKey);
+ try
+ NewAssociation := TAssociation.Create(Mappable.GetKey, Item);
+ OldAssociation := TruePut(Position, NewAssociation);
+ if OldAssociation <> nil then
+ Result := OldAssociation.GetValue
+ else
+ Result := nil;
+ finally
+ Position.Free;
+ end;
+ end;
+end;
+
+function TAbstractMap.Put(const Key, Item: ICollectable): ICollectable;
+var
+ OldAssociation, NewAssociation: IAssociation;
+ ItemError, KeyError: TCollectionError;
+ Position: TCollectionPosition;
+begin
+ ItemError := ItemAllowed(Item);
+ KeyError := KeyAllowed(Key);
+ if ItemError <> ceOK then
+ begin
+ CollectionError(ItemError);
+ Result := nil;
+ end
+ else if KeyError <> ceOK then
+ begin
+ CollectionError(KeyError);
+ Result := nil;
+ end
+ else
+ begin
+ // Find appropriate place, then place key-item association there
+ Position := GetKeyPosition(Key);
+ try
+ NewAssociation := TAssociation.Create(Key, Item);
+ OldAssociation := TruePut(Position, NewAssociation);
+ if OldAssociation <> nil then
+ Result := OldAssociation.GetValue
+ else
+ Result := nil;
+ finally
+ Position.Free;
+ end;
+ end;
+end;
+
+function TAbstractMap.Put(const ItemArray: array of ICollectable): ICollection;
+var
+ ResultCollection: ICollection;
+ Mappable: IMappable;
+ OldAssociation, NewAssociation: IAssociation;
+ Position: TCollectionPosition;
+ Item: ICollectable;
+ I: Integer;
+begin
+ ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
+ for I := Low(ItemArray) to High(ItemArray) do
+ begin
+ Item := ItemArray[I];
+ if not IsNaturalItem(Item) then
+ begin
+ CollectionError(ceNotNaturalItem);
+ end
+ else
+ begin
+ // Find appropriate place, then place key-item association there
+ Item.QueryInterface(IMappable, Mappable);
+ Position := GetKeyPosition(Mappable.GetKey);
+ try
+ NewAssociation := TAssociation.Create(Mappable.GetKey, Item);
+ OldAssociation := TruePut(Position, NewAssociation);
+ if OldAssociation <> nil then
+ ResultCollection.Add(OldAssociation.GetValue);
+ finally
+ Position.Free;
+ end;
+ end;
+ end;
+ Result := ResultCollection;
+end;
+
+function TAbstractMap.Put(const Collection: ICollection): ICollection;
+var
+ ResultCollection: ICollection;
+ Mappable: IMappable;
+ OldAssociation, NewAssociation: IAssociation;
+ Position: TCollectionPosition;
+ Iterator: IIterator;
+ Item: ICollectable;
+begin
+ ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
+ Iterator := Collection.GetIterator;
+ while not Iterator.EOF do
+ begin
+ Item := Iterator.CurrentItem;;
+ if not IsNaturalItem(Item) then
+ begin
+ CollectionError(ceNotNaturalItem);
+ end
+ else
+ begin
+ // Find appropriate place, then place key-item association there
+ Item.QueryInterface(IMappable, Mappable);
+ Position := GetKeyPosition(Mappable.GetKey);
+ try
+ NewAssociation := TAssociation.Create(Mappable.GetKey, Item);
+ OldAssociation := TruePut(Position, NewAssociation);
+ if OldAssociation <> nil then
+ ResultCollection.Add(OldAssociation.GetValue);
+ finally
+ Position.Free;
+ end;
+ end;
+ Iterator.Next;
+ end;
+ Result := ResultCollection;
+end;
+
+function TAbstractMap.Put(const Map: IMap): ICollection;
+var
+ ResultCollection: ICollection;
+ OldAssociation, NewAssociation: IAssociation;
+ ItemError, KeyError: TCollectionError;
+ Position: TCollectionPosition;
+ MapIterator: IMapIterator;
+ Key, Item: ICollectable;
+begin
+ ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
+ MapIterator := Map.GetMapIterator;
+ while not MapIterator.EOF do
+ begin
+ Key := MapIterator.CurrentKey;
+ Item := MapIterator.CurrentItem;
+
+ ItemError := ItemAllowed(Item);
+ KeyError := KeyAllowed(Key);
+ if ItemError <> ceOK then
+ begin
+ CollectionError(ItemError);
+ end
+ else if KeyError <> ceOK then
+ begin
+ CollectionError(KeyError);
+ end
+ else
+ begin
+ // Find appropriate place, then place key-item association there
+ Position := GetKeyPosition(Key);
+ try
+ NewAssociation := TAssociation.Create(Key, Item);
+ OldAssociation := TruePut(Position, NewAssociation);
+ if OldAssociation <> nil then
+ ResultCollection.Add(OldAssociation.GetValue);
+ finally
+ Position.Free;
+ end;
+ end;
+ MapIterator.Next;
+ end;
+ Result := ResultCollection;
+end;
+
+function TAbstractMap.RemoveKey(const Key: ICollectable): ICollectable;
+var
+ KeyError: TCollectionError;
+ Position: TCollectionPosition;
+ OldAssociation: IAssociation;
+begin
+ KeyError := KeyAllowed(Key);
+ if KeyError <> ceOK then
+ begin
+ CollectionError(KeyError);
+ Result := nil;
+ end
+ else
+ begin
+ Position := GetKeyPosition(Key);
+ try
+ if Position.Found then
+ begin
+ OldAssociation := TrueRemove2(Position);
+ Result := OldAssociation.GetValue
+ end
+ else
+ Result := nil;
+ finally
+ Position.Free;
+ end;
+ end;
+end;
+
+function TAbstractMap.RemoveKey(const KeyArray: array of ICollectable): ICollection;
+var
+ ResultCollection: ICollection;
+ OldAssociation: IAssociation;
+ KeyError: TCollectionError;
+ Position: TCollectionPosition;
+ Key: ICollectable;
+ I: Integer;
+begin
+ ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
+ for I := Low(KeyArray) to High(KeyArray) do
+ begin
+ Key := KeyArray[I];
+ KeyError := KeyAllowed(Key);
+ if KeyError <> ceOK then
+ begin
+ CollectionError(KeyError);
+ end
+ else
+ begin
+ Position := GetKeyPosition(Key);
+ try
+ if Position.Found then
+ begin
+ OldAssociation := TrueRemove2(Position);
+ ResultCollection.Add(OldAssociation.GetValue);
+ end;
+ finally
+ Position.Free;
+ end;
+ end;
+ end;
+ Result := ResultCollection;
+end;
+
+function TAbstractMap.RemoveKey(const Collection: ICollection): ICollection;
+var
+ ResultCollection: ICollection;
+ OldAssociation: IAssociation;
+ KeyError: TCollectionError;
+ Position: TCollectionPosition;
+ Key: ICollectable;
+ Iterator: IIterator;
+begin
+ ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
+ Iterator := Collection.GetIterator;
+ while not Iterator.EOF do
+ begin
+ Key := Iterator.CurrentItem;
+ KeyError := KeyAllowed(Key);
+ if KeyError <> ceOK then
+ begin
+ CollectionError(KeyError);
+ end
+ else
+ begin
+ Position := GetKeyPosition(Key);
+ try
+ if Position.Found then
+ begin
+ OldAssociation := TrueRemove2(Position);
+ ResultCollection.Add(OldAssociation.GetValue);
+ end;
+ finally
+ Position.Free;
+ end;
+ end;
+ Iterator.Next;
+ end;
+ Result := ResultCollection;
+end;
+
+function TAbstractMap.RetainKey(const KeyArray: array of ICollectable): ICollection;
+var
+ ResultCollection: ICollection;
+ MapIterator: IMapIterator;
+ I: Integer;
+ Found: Boolean;
+begin
+ ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
+ if FixedSize then
+ begin
+ CollectionError(ceFixedSize);
+ end
+ else
+ begin
+ MapIterator := GetMapIterator;
+ while not MapIterator.EOF do
+ begin
+ // Converting the array to a map would be faster but I don't want to
+ // couple base class code to a complex collection.
+ Found := false;
+ for I := Low(KeyArray) to High(KeyArray) do
+ begin
+ Found := KeyComparator.Equals(MapIterator.CurrentKey, KeyArray[I]);
+ if Found then
+ break;
+ end;
+ if not Found then
+ begin
+ ResultCollection.Add(MapIterator.CurrentItem);
+ MapIterator.Remove;
+ end;
+ MapIterator.Next;
+ end;
+ Result := ResultCollection;
+ end;
+end;
+
+function TAbstractMap.RetainKey(const Collection: ICollection): ICollection;
+var
+ ResultCollection: ICollection;
+ MapIterator: IMapIterator;
+ Key: ICollectable;
+begin
+ ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
+ if FixedSize then
+ begin
+ CollectionError(ceFixedSize);
+ end
+ else
+ begin
+ MapIterator := GetMapIterator;
+ while not MapIterator.EOF do
+ begin
+ Key := MapIterator.CurrentKey;
+ if not Collection.Contains(Key) then
+ begin
+ ResultCollection.Add(MapIterator.CurrentItem);
+ MapIterator.Remove;
+ end;
+ MapIterator.Next;
+ end;
+ end;
+ Result := ResultCollection;
+end;
+
+
+{ TAbstractIntegerMap }
+constructor TAbstractIntegerMap.Create(NaturalItemsOnly: Boolean);
+begin
+ inherited Create(NaturalItemsOnly);
+ FAssociationComparator := TIntegerAssociationComparator.Create;
+end;
+
+constructor TAbstractIntegerMap.Create(const ItemArray: array of ICollectable);
+begin
+ Create(ItemArray, true);
+end;
+
+constructor TAbstractIntegerMap.Create(const ItemArray: array of ICollectable; NaturalItemsOnly: Boolean);
+begin
+ inherited Create(ItemArray, true);
+end;
+
+constructor TAbstractIntegerMap.Create(const KeyArray: array of Integer; const ItemArray: array of ICollectable);
+begin
+ Create(KeyArray, ItemArray, false);
+end;
+
+constructor TAbstractIntegerMap.Create(const KeyArray: array of Integer; const ItemArray: array of ICollectable; NaturalItemsOnly: Boolean);
+var
+ I, Lo, Hi: Integer;
+begin
+ Create(NaturalItemsOnly);
+ Capacity := Min(Length(KeyArray), Length(ItemArray));
+ if not FixedSize then
+ begin
+ Lo := Max(Low(KeyArray), Low(ItemArray));
+ Hi := Min(High(KeyArray), High(ItemArray));
+ for I := Lo to Hi do
+ begin
+ Put(KeyArray[I], ItemArray[I]);
+ end;
+ end;
+end;
+
+constructor TAbstractIntegerMap.Create(const Map: IIntegerMap);
+var
+ MapIterator: IIntegerMapIterator;
+begin
+ Create(Map.GetNaturalItemsOnly);
+ InitFrom(Map);
+ Capacity := Map.GetSize;
+ if not FixedSize then
+ begin
+ MapIterator := Map.GetMapIterator;
+ while not MapIterator.EOF do
+ begin
+ Put(MapIterator.CurrentKey, MapIterator.CurrentItem);
+ MapIterator.Next;
+ end;
+ end;
+end;
+
+destructor TAbstractIntegerMap.Destroy;
+begin
+ FAssociationComparator := nil;
+ inherited Destroy;
+end;
+
+function TAbstractIntegerMap.TrueAdd(const Item: ICollectable): Boolean;
+var
+ Position: TCollectionPosition;
+ Mappable: IIntegerMappable;
+begin
+ if IsNaturalItem(Item) then
+ begin
+ Mappable := Item as IIntegerMappable;
+ Position := GetKeyPosition(Mappable.GetKey);
+ try
+ if Position.Found then
+ begin
+ CollectionError(ceDuplicateKey);
+ Result := false;
+ end
+ else
+ begin
+ TruePut(Position, TIntegerAssociation.Create(Mappable.GetKey, Item));
+ Result := true;
+ end;
+ finally
+ Position.Free;
+ end;
+ end
+ else
+ begin
+ CollectionError(ceNotNaturalItem);
+ Result := false;
+ end;
+end;
+
+function TAbstractIntegerMap.TrueContains(const Item: ICollectable): Boolean;
+var
+ Item2: ICollectable;
+ Success: Boolean;
+ Iterator: IIterator;
+begin
+ Iterator := GetIterator;
+ Success := false;
+ while not Iterator.EOF and not Success do
+ begin
+ Item2 := Iterator.CurrentItem;
+ if Comparator.Equals(Item, Item2) then
+ Success := true;
+ Iterator.Next;
+ end;
+ Result := Success;
+end;
+
+function TAbstractIntegerMap.TrueRemove(const Item: ICollectable): ICollectable;
+var
+ Item2: ICollectable;
+ Iterator: IIntegerMapIterator;
+ Found: Boolean;
+begin
+ // Sequential search
+ Found := false;
+ Result := nil;
+ Iterator := GetAssociationIterator;
+ while not Iterator.EOF and not Found do
+ begin
+ Item2 := Iterator.CurrentItem;
+ if Comparator.Equals(Item, Item2) then
+ begin
+ Result := Item2;
+ Iterator.Remove;
+ Found := true;
+ end;
+ Iterator.Next;
+ end;
+end;
+
+function TAbstractIntegerMap.TrueRemoveAll(const Item: ICollectable): ICollection;
+var
+ ResultCollection: ICollection;
+ Item2: ICollectable;
+ Iterator: IIntegerMapIterator;
+begin
+ // Sequential search
+ ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
+ Iterator := GetAssociationIterator;
+ while not Iterator.EOF do
+ begin
+ Item2 := Iterator.CurrentItem;
+ if Comparator.Equals(Item, Item2) then
+ begin
+ ResultCollection.Add(Item2);
+ Iterator.Remove;
+ end;
+ Iterator.Next;
+ end;
+ Result := ResultCollection;
+end;
+
+function TAbstractIntegerMap.GetItem(const Key: Integer): ICollectable;
+begin
+ Result := Get(Key);
+end;
+
+procedure TAbstractIntegerMap.SetItem(const Key: Integer; const Item: ICollectable);
+begin
+ Put(Key, Item);
+end;
+
+function TAbstractIntegerMap.GetIterator: IIterator;
+begin
+ Result := GetAssociationIterator;
+end;
+
+function TAbstractIntegerMap.GetKeys: ISet;
+var
+ ResultCollection: TPArraySet;
+ MapIterator: IIntegerMapIterator;
+begin
+ ResultCollection := TPArraySet.Create(true);
+ MapIterator := GetMapIterator;
+ while not MapIterator.EOF do
+ begin
+ ResultCollection.Add(TIntegerWrapper.Create(MapIterator.CurrentKey) as ICollectable);
+ MapIterator.Next;
+ end;
+ Result := ResultCollection;
+end;
+
+function TAbstractIntegerMap.GetMapIterator: IIntegerMapIterator;
+begin
+ Result := GetAssociationIterator;
+end;
+
+function TAbstractIntegerMap.GetNaturalItemIID: TGUID;
+begin
+ Result := IntegerMappableIID;
+end;
+
+function TAbstractIntegerMap.GetType: TCollectionType;
+begin
+ Result := ctIntegerMap;
+end;
+
+function TAbstractIntegerMap.GetValues: ICollection;
+var
+ ResultCollection: ICollection;
+ ValueIterator: IIterator;
+begin
+ ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
+ ValueIterator := GetIterator;
+ while not ValueIterator.EOF do
+ begin
+ ResultCollection.Add(ValueIterator.CurrentItem);
+ ValueIterator.Next;
+ end;
+ Result := ResultCollection;
+end;
+
+// Overrides TAbstractCollection function, otherwise Create(ICollection) is
+// called, which cannot access keys.
+function TAbstractIntegerMap.Clone: ICollection;
+begin
+ Result := (TAbstractIntegerMapClass(ClassType)).Create(Self);
+end;
+
+function TAbstractIntegerMap.CloneAsIntegerMap: IIntegerMap;
+begin
+ Result := (TAbstractIntegerMapClass(ClassType)).Create(Self);
+end;
+
+function TAbstractIntegerMap.ContainsKey(const Key: Integer): Boolean;
+var
+ Position: TCollectionPosition;
+begin
+ Position := GetKeyPosition(Key);
+ try
+ Result := Position.Found;
+ finally
+ Position.Free;
+ end;
+end;
+
+function TAbstractIntegerMap.ContainsKey(const KeyArray: array of Integer): Boolean;
+var
+ I: Integer;
+ Success: Boolean;
+begin
+ Success := true;
+ for I := Low(KeyArray) to High(KeyArray) do
+ begin
+ Success := Success and ContainsKey(KeyArray[I]);
+ if not Success then
+ break;
+ end;
+ Result := Success;
+end;
+
+function TAbstractIntegerMap.Get(const Key: Integer): ICollectable;
+var
+ Position: TCollectionPosition;
+begin
+ Position := GetKeyPosition(Key);
+ try
+ if Position.Found then
+ Result := TrueGet(Position).GetValue
+ else
+ Result := nil;
+ finally
+ Position.Free;
+ end;
+end;
+
+function TAbstractIntegerMap.IsNilAllowed: Boolean;
+begin
+ Result := true;
+end;
+
+function TAbstractIntegerMap.Put(const Item: ICollectable): ICollectable;
+var
+ Mappable: IIntegerMappable;
+ OldAssociation, NewAssociation: IIntegerAssociation;
+ Position: TCollectionPosition;
+begin
+ if not IsNaturalItem(Item) then
+ begin
+ CollectionError(ceNotNaturalItem);
+ Result := nil;
+ end
+ else
+ begin
+ Item.QueryInterface(IIntegerMappable, Mappable);
+ Position := GetKeyPosition(Mappable.GetKey);
+ try
+ NewAssociation := TIntegerAssociation.Create(Mappable.GetKey, Item);
+ OldAssociation := TruePut(Position, NewAssociation);
+ if OldAssociation <> nil then
+ Result := OldAssociation.GetValue
+ else
+ Result := nil;
+ finally
+ Position.Free;
+ end;
+ end;
+end;
+
+function TAbstractIntegerMap.Put(const Key: Integer; const Item: ICollectable): ICollectable;
+var
+ OldAssociation, NewAssociation: IIntegerAssociation;
+ ItemError: TCollectionError;
+ Position: TCollectionPosition;
+begin
+ ItemError := ItemAllowed(Item);
+ if ItemError <> ceOK then
+ begin
+ CollectionError(ItemError);
+ Result := nil;
+ end
+ else
+ begin
+ Position := GetKeyPosition(Key);
+ try
+ NewAssociation := TIntegerAssociation.Create(Key, Item);
+ OldAssociation := TruePut(Position, NewAssociation);
+ if OldAssociation <> nil then
+ Result := OldAssociation.GetValue
+ else
+ Result := nil;
+ finally
+ Position.Free;
+ end;
+ end;
+end;
+
+function TAbstractIntegerMap.Put(const ItemArray: array of ICollectable): ICollection;
+var
+ ResultCollection: ICollection;
+ Mappable: IIntegerMappable;
+ OldAssociation, NewAssociation: IIntegerAssociation;
+ Position: TCollectionPosition;
+ Item: ICollectable;
+ I: Integer;
+begin
+ ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
+ for I := Low(ItemArray) to High(ItemArray) do
+ begin
+ Item := ItemArray[I];
+ if not IsNaturalItem(Item) then
+ begin
+ CollectionError(ceNotNaturalItem);
+ end
+ else
+ begin
+ Item.QueryInterface(IIntegerMappable, Mappable);
+ Position := GetKeyPosition(Mappable.GetKey);
+ try
+ NewAssociation := TIntegerAssociation.Create(Mappable.GetKey, Item);
+ OldAssociation := TruePut(Position, NewAssociation);
+ if OldAssociation <> nil then
+ ResultCollection.Add(OldAssociation.GetValue);
+ finally
+ Position.Free;
+ end;
+ end;
+ end;
+ Result := ResultCollection;
+end;
+
+function TAbstractIntegerMap.Put(const Collection: ICollection): ICollection;
+var
+ ResultCollection: ICollection;
+ Mappable: IIntegerMappable;
+ OldAssociation, NewAssociation: IIntegerAssociation;
+ Position: TCollectionPosition;
+ Iterator: IIterator;
+ Item: ICollectable;
+begin
+ ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
+ Iterator := Collection.GetIterator;
+ while not Iterator.EOF do
+ begin
+ Item := Iterator.CurrentItem;;
+ if not IsNaturalItem(Item) then
+ begin
+ CollectionError(ceNotNaturalItem);
+ end
+ else
+ begin
+ Item.QueryInterface(IIntegerMappable, Mappable);
+ Position := GetKeyPosition(Mappable.GetKey);
+ try
+ NewAssociation := TIntegerAssociation.Create(Mappable.GetKey, Item);
+ OldAssociation := TruePut(Position, NewAssociation);
+ if OldAssociation <> nil then
+ ResultCollection.Add(OldAssociation.GetValue);
+ finally
+ Position.Free;
+ end;
+ end;
+ Iterator.Next;
+ end;
+ Result := ResultCollection;
+end;
+
+function TAbstractIntegerMap.Put(const Map: IIntegerMap): ICollection;
+var
+ ResultCollection: ICollection;
+ OldAssociation, NewAssociation: IIntegerAssociation;
+ ItemError: TCollectionError;
+ Position: TCollectionPosition;
+ MapIterator: IIntegerMapIterator;
+ Item: ICollectable;
+ Key: Integer;
+begin
+ ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
+ MapIterator := Map.GetMapIterator;
+ while not MapIterator.EOF do
+ begin
+ Key := MapIterator.CurrentKey;
+ Item := MapIterator.CurrentItem;
+
+ ItemError := ItemAllowed(Item);
+ if ItemError <> ceOK then
+ begin
+ CollectionError(ItemError);
+ end
+ else
+ begin
+ Position := GetKeyPosition(Key);
+ try
+ NewAssociation := TIntegerAssociation.Create(Key, Item);
+ OldAssociation := TruePut(Position, NewAssociation);
+ if OldAssociation <> nil then
+ ResultCollection.Add(OldAssociation.GetValue);
+ finally
+ Position.Free;
+ end;
+ end;
+ MapIterator.Next;
+ end;
+ Result := ResultCollection;
+end;
+
+function TAbstractIntegerMap.RemoveKey(const Key: Integer): ICollectable;
+var
+ Position: TCollectionPosition;
+ OldAssociation: IIntegerAssociation;
+begin
+ Position := GetKeyPosition(Key);
+ try
+ if Position.Found then
+ begin
+ OldAssociation := TrueRemove2(Position);
+ Result := OldAssociation.GetValue
+ end
+ else
+ Result := nil;
+ finally
+ Position.Free;
+ end;
+end;
+
+function TAbstractIntegerMap.RemoveKey(const KeyArray: array of Integer): ICollection;
+var
+ ResultCollection: ICollection;
+ OldAssociation: IIntegerAssociation;
+ Position: TCollectionPosition;
+ Key: Integer;
+ I: Integer;
+begin
+ ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
+ for I := Low(KeyArray) to High(KeyArray) do
+ begin
+ Key := KeyArray[I];
+ Position := GetKeyPosition(Key);
+ try
+ if Position.Found then
+ begin
+ OldAssociation := TrueRemove2(Position);
+ ResultCollection.Add(OldAssociation.GetValue);
+ end;
+ finally
+ Position.Free;
+ end;
+ end;
+ Result := ResultCollection;
+end;
+
+function TAbstractIntegerMap.RetainKey(const KeyArray: array of Integer): ICollection;
+var
+ ResultCollection: ICollection;
+ MapIterator: IIntegerMapIterator;
+ I: Integer;
+ Found: Boolean;
+begin
+ ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
+ if FixedSize then
+ begin
+ CollectionError(ceFixedSize);
+ end
+ else
+ begin
+ MapIterator := GetMapIterator;
+ while not MapIterator.EOF do
+ begin
+ // Converting the array to a map would be faster but I don't want to
+ // couple base class code to a complex collection.
+ Found := false;
+ for I := Low(KeyArray) to High(KeyArray) do
+ begin
+ Found := (MapIterator.CurrentKey = KeyArray[I]);
+ if Found then
+ break;
+ end;
+ if not Found then
+ begin
+ ResultCollection.Add(MapIterator.CurrentItem);
+ MapIterator.Remove;
+ end;
+ MapIterator.Next;
+ end;
+ Result := ResultCollection;
+ end;
+end;
+
+
+{ TAbstractStringMap }
+constructor TAbstractStringMap.Create(NaturalItemsOnly: Boolean);
+begin
+ inherited Create(NaturalItemsOnly);
+ FAssociationComparator := TStringAssociationComparator.Create;
+end;
+
+constructor TAbstractStringMap.Create(const ItemArray: array of ICollectable);
+begin
+ Create(ItemArray, true);
+end;
+
+constructor TAbstractStringMap.Create(const ItemArray: array of ICollectable; NaturalItemsOnly: Boolean);
+begin
+ inherited Create(ItemArray, true);
+end;
+
+constructor TAbstractStringMap.Create(const KeyArray: array of String; const ItemArray: array of ICollectable);
+begin
+ Create(KeyArray, ItemArray, false);
+end;
+
+constructor TAbstractStringMap.Create(const KeyArray: array of String; const ItemArray: array of ICollectable; NaturalItemsOnly: Boolean);
+var
+ I, Lo, Hi: Integer;
+begin
+ Create(NaturalItemsOnly);
+ Capacity := Min(Length(KeyArray), Length(ItemArray));
+ if not FixedSize then
+ begin
+ Lo := Max(Low(KeyArray), Low(ItemArray));
+ Hi := Min(High(KeyArray), High(ItemArray));
+ for I := Lo to Hi do
+ begin
+ Put(KeyArray[I], ItemArray[I]);
+ end;
+ end;
+end;
+
+constructor TAbstractStringMap.Create(const Map: IStringMap);
+var
+ MapIterator: IStringMapIterator;
+begin
+ Create(Map.GetNaturalItemsOnly);
+ InitFrom(Map);
+ Capacity := Map.GetSize;
+ if not FixedSize then
+ begin
+ MapIterator := Map.GetMapIterator;
+ while not MapIterator.EOF do
+ begin
+ Put(MapIterator.CurrentKey, MapIterator.CurrentItem);
+ MapIterator.Next;
+ end;
+ end;
+end;
+
+destructor TAbstractStringMap.Destroy;
+begin
+ FAssociationComparator := nil;
+ inherited Destroy;
+end;
+
+function TAbstractStringMap.TrueAdd(const Item: ICollectable): Boolean;
+var
+ Position: TCollectionPosition;
+ Mappable: IStringMappable;
+begin
+ if IsNaturalItem(Item) then
+ begin
+ Mappable := Item as IStringMappable;
+ Position := GetKeyPosition(Mappable.GetKey);
+ try
+ if Position.Found then
+ begin
+ CollectionError(ceDuplicateKey);
+ Result := false;
+ end
+ else
+ begin
+ TruePut(Position, TStringAssociation.Create(Mappable.GetKey, Item));
+ Result := true;
+ end;
+ finally
+ Position.Free;
+ end;
+ end
+ else
+ begin
+ CollectionError(ceNotNaturalItem);
+ Result := false;
+ end;
+end;
+
+function TAbstractStringMap.TrueContains(const Item: ICollectable): Boolean;
+var
+ Item2: ICollectable;
+ Success: Boolean;
+ Iterator: IIterator;
+begin
+ Iterator := GetIterator;
+ Success := false;
+ while not Iterator.EOF and not Success do
+ begin
+ Item2 := Iterator.CurrentItem;
+ if Comparator.Equals(Item, Item2) then
+ Success := true;
+ Iterator.Next;
+ end;
+ Result := Success;
+end;
+
+function TAbstractStringMap.TrueRemove(const Item: ICollectable): ICollectable;
+var
+ Item2: ICollectable;
+ Iterator: IStringMapIterator;
+ Found: Boolean;
+begin
+ // Sequential search
+ Found := false;
+ Result := nil;
+ Iterator := GetAssociationIterator;
+ while not Iterator.EOF and not Found do
+ begin
+ Item2 := Iterator.CurrentItem;
+ if Comparator.Equals(Item, Item2) then
+ begin
+ Result := Item2;
+ Iterator.Remove;
+ Found := true;
+ end;
+ Iterator.Next;
+ end;
+end;
+
+function TAbstractStringMap.TrueRemoveAll(const Item: ICollectable): ICollection;
+var
+ ResultCollection: ICollection;
+ Item2: ICollectable;
+ Iterator: IIterator;
+begin
+ // Sequential search
+ ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
+ Iterator := GetAssociationIterator;
+ while not Iterator.EOF do
+ begin
+ Item2 := Iterator.CurrentItem;
+ if Comparator.Equals(Item, Item2) then
+ begin
+ ResultCollection.Add(Item2);
+ Iterator.Remove;
+ end;
+ Iterator.Next;
+ end;
+ Result := ResultCollection;
+end;
+
+function TAbstractStringMap.GetItem(const Key: String): ICollectable;
+begin
+ Result := Get(Key);
+end;
+
+procedure TAbstractStringMap.SetItem(const Key: String; const Item: ICollectable);
+begin
+ Put(Key, Item);
+end;
+
+function TAbstractStringMap.GetIterator: IIterator;
+begin
+ Result := GetAssociationIterator;
+end;
+
+function TAbstractStringMap.GetKeys: ISet;
+var
+ ResultCollection: TPArraySet;
+ MapIterator: IStringMapIterator;
+begin
+ ResultCollection := TPArraySet.Create(true);
+ MapIterator := GetMapIterator;
+ while not MapIterator.EOF do
+ begin
+ ResultCollection.Add(TStringWrapper.Create(MapIterator.CurrentKey) as ICollectable);
+ MapIterator.Next;
+ end;
+ Result := ResultCollection;
+end;
+
+function TAbstractStringMap.GetMapIterator: IStringMapIterator;
+begin
+ Result := GetAssociationIterator;
+end;
+
+function TAbstractStringMap.GetNaturalItemIID: TGUID;
+begin
+ Result := StringMappableIID;
+end;
+
+function TAbstractStringMap.GetType: TCollectionType;
+begin
+ Result := ctStringMap;
+end;
+
+function TAbstractStringMap.GetValues: ICollection;
+var
+ ResultCollection: ICollection;
+ ValueIterator: IIterator;
+begin
+ ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
+ ValueIterator := GetIterator;
+ while not ValueIterator.EOF do
+ begin
+ ResultCollection.Add(ValueIterator.CurrentItem);
+ ValueIterator.Next;
+ end;
+ Result := ResultCollection;
+end;
+
+// Overrides TAbstractCollection function, otherwise Create(ICollection) is
+// called, which cannot access keys.
+function TAbstractStringMap.Clone: ICollection;
+begin
+ Result := (TAbstractStringMapClass(ClassType)).Create(Self);
+end;
+
+function TAbstractStringMap.CloneAsStringMap: IStringMap;
+begin
+ Result := (TAbstractStringMapClass(ClassType)).Create(Self);
+end;
+
+function TAbstractStringMap.ContainsKey(const Key: String): Boolean;
+var
+ Position: TCollectionPosition;
+begin
+ Position := GetKeyPosition(Key);
+ try
+ Result := Position.Found;
+ finally
+ Position.Free;
+ end;
+end;
+
+function TAbstractStringMap.ContainsKey(const KeyArray: array of String): Boolean;
+var
+ I: Integer;
+ Success: Boolean;
+begin
+ Success := true;
+ for I := Low(KeyArray) to High(KeyArray) do
+ begin
+ Success := Success and ContainsKey(KeyArray[I]);
+ if not Success then
+ break;
+ end;
+ Result := Success;
+end;
+
+function TAbstractStringMap.Get(const Key: String): ICollectable;
+var
+ Position: TCollectionPosition;
+begin
+ Position := GetKeyPosition(Key);
+ try
+ if Position.Found then
+ Result := TrueGet(Position).GetValue
+ else
+ Result := nil;
+ finally
+ Position.Free;
+ end;
+end;
+
+function TAbstractStringMap.IsNilAllowed: Boolean;
+begin
+ Result := true;
+end;
+
+function TAbstractStringMap.Put(const Item: ICollectable): ICollectable;
+var
+ Mappable: IStringMappable;
+ OldAssociation, NewAssociation: IStringAssociation;
+ Position: TCollectionPosition;
+begin
+ if not IsNaturalItem(Item) then
+ begin
+ CollectionError(ceNotNaturalItem);
+ Result := nil;
+ end
+ else
+ begin
+ Item.QueryInterface(IStringMappable, Mappable);
+ Position := GetKeyPosition(Mappable.GetKey);
+ try
+ NewAssociation := TStringAssociation.Create(Mappable.GetKey, Item);
+ OldAssociation := TruePut(Position, NewAssociation);
+ if OldAssociation <> nil then
+ Result := OldAssociation.GetValue
+ else
+ Result := nil;
+ finally
+ Position.Free;
+ end;
+ end;
+end;
+
+function TAbstractStringMap.Put(const Key: String; const Item: ICollectable): ICollectable;
+var
+ OldAssociation, NewAssociation: IStringAssociation;
+ ItemError: TCollectionError;
+ Position: TCollectionPosition;
+begin
+ ItemError := ItemAllowed(Item);
+ if ItemError <> ceOK then
+ begin
+ CollectionError(ItemError);
+ Result := nil;
+ end
+ else
+ begin
+ Position := GetKeyPosition(Key);
+ try
+ NewAssociation := TStringAssociation.Create(Key, Item);
+ OldAssociation := TruePut(Position, NewAssociation);
+ if OldAssociation <> nil then
+ Result := OldAssociation.GetValue
+ else
+ Result := nil;
+ finally
+ Position.Free;
+ end;
+ end;
+end;
+
+function TAbstractStringMap.Put(const ItemArray: array of ICollectable): ICollection;
+var
+ ResultCollection: ICollection;
+ Mappable: IStringMappable;
+ OldAssociation, NewAssociation: IStringAssociation;
+ Position: TCollectionPosition;
+ Item: ICollectable;
+ I: Integer;
+begin
+ ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
+ for I := Low(ItemArray) to High(ItemArray) do
+ begin
+ Item := ItemArray[I];
+ if not IsNaturalItem(Item) then
+ begin
+ CollectionError(ceNotNaturalItem);
+ end
+ else
+ begin
+ Item.QueryInterface(IStringMappable, Mappable);
+ Position := GetKeyPosition(Mappable.GetKey);
+ try
+ NewAssociation := TStringAssociation.Create(Mappable.GetKey, Item);
+ OldAssociation := TruePut(Position, NewAssociation);
+ if OldAssociation <> nil then
+ ResultCollection.Add(OldAssociation.GetValue);
+ finally
+ Position.Free;
+ end;
+ end;
+ end;
+ Result := ResultCollection;
+end;
+
+function TAbstractStringMap.Put(const Collection: ICollection): ICollection;
+var
+ ResultCollection: ICollection;
+ Mappable: IStringMappable;
+ OldAssociation, NewAssociation: IStringAssociation;
+ Position: TCollectionPosition;
+ Iterator: IIterator;
+ Item: ICollectable;
+begin
+ ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
+ Iterator := Collection.GetIterator;
+ while not Iterator.EOF do
+ begin
+ Item := Iterator.CurrentItem;;
+ if not IsNaturalItem(Item) then
+ begin
+ CollectionError(ceNotNaturalItem);
+ end
+ else
+ begin
+ Item.QueryInterface(IStringMappable, Mappable);
+ Position := GetKeyPosition(Mappable.GetKey);
+ try
+ NewAssociation := TStringAssociation.Create(Mappable.GetKey, Item);
+ OldAssociation := TruePut(Position, NewAssociation);
+ if OldAssociation <> nil then
+ ResultCollection.Add(OldAssociation.GetValue);
+ finally
+ Position.Free;
+ end;
+ end;
+ Iterator.Next;
+ end;
+ Result := ResultCollection;
+end;
+
+function TAbstractStringMap.Put(const Map: IStringMap): ICollection;
+var
+ ResultCollection: ICollection;
+ OldAssociation, NewAssociation: IStringAssociation;
+ ItemError: TCollectionError;
+ Position: TCollectionPosition;
+ MapIterator: IStringMapIterator;
+ Item: ICollectable;
+ Key: String;
+begin
+ ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
+ MapIterator := Map.GetMapIterator;
+ while not MapIterator.EOF do
+ begin
+ Key := MapIterator.CurrentKey;
+ Item := MapIterator.CurrentItem;
+
+ ItemError := ItemAllowed(Item);
+ if ItemError <> ceOK then
+ begin
+ CollectionError(ItemError);
+ end
+ else
+ begin
+ Position := GetKeyPosition(Key);
+ try
+ NewAssociation := TStringAssociation.Create(Key, Item);
+ OldAssociation := TruePut(Position, NewAssociation);
+ if OldAssociation <> nil then
+ ResultCollection.Add(OldAssociation.GetValue);
+ finally
+ Position.Free;
+ end;
+ end;
+ MapIterator.Next;
+ end;
+ Result := ResultCollection;
+end;
+
+function TAbstractStringMap.RemoveKey(const Key: String): ICollectable;
+var
+ Position: TCollectionPosition;
+ OldAssociation: IStringAssociation;
+begin
+ Position := GetKeyPosition(Key);
+ try
+ if Position.Found then
+ begin
+ OldAssociation := TrueRemove2(Position);
+ Result := OldAssociation.GetValue
+ end
+ else
+ Result := nil;
+ finally
+ Position.Free;
+ end;
+end;
+
+function TAbstractStringMap.RemoveKey(const KeyArray: array of String): ICollection;
+var
+ ResultCollection: ICollection;
+ OldAssociation: IStringAssociation;
+ Position: TCollectionPosition;
+ Key: String;
+ I: Integer;
+begin
+ ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
+ for I := Low(KeyArray) to High(KeyArray) do
+ begin
+ Key := KeyArray[I];
+ Position := GetKeyPosition(Key);
+ try
+ if Position.Found then
+ begin
+ OldAssociation := TrueRemove2(Position);
+ ResultCollection.Add(OldAssociation.GetValue);
+ end;
+ finally
+ Position.Free;
+ end;
+ end;
+ Result := ResultCollection;
+end;
+
+function TAbstractStringMap.RetainKey(const KeyArray: array of String): ICollection;
+var
+ ResultCollection: ICollection;
+ MapIterator: IStringMapIterator;
+ I: Integer;
+ Found: Boolean;
+begin
+ ResultCollection := TPArrayBag.Create(NaturalItemsOnly);
+ if FixedSize then
+ begin
+ CollectionError(ceFixedSize);
+ end
+ else
+ begin
+ MapIterator := GetMapIterator;
+ while not MapIterator.EOF do
+ begin
+ // Converting the array to a map would be faster but I don't want to
+ // couple base class code to a complex collection.
+ Found := false;
+ for I := Low(KeyArray) to High(KeyArray) do
+ begin
+ Found := (MapIterator.CurrentKey = KeyArray[I]);
+ if Found then
+ break;
+ end;
+ if not Found then
+ begin
+ ResultCollection.Add(MapIterator.CurrentItem);
+ MapIterator.Remove;
+ end;
+ MapIterator.Next;
+ end;
+ Result := ResultCollection;
+ end;
+end;
+
+
+{ ECollectionError }
+constructor ECollectionError.Create(const Msg: String; const Collection: ICollection; ErrorType: TCollectionError);
+begin
+ inherited Create(Msg);
+ FCollection := Collection;
+ FErrorType := ErrorType;
+end;
+
+{ TAbstractListIterator }
+constructor TAbstractListIterator.Create(Collection: TAbstractList);
+begin
+ inherited Create(true);
+ FCollection := Collection;
+ First;
+end;
+
+function TAbstractListIterator.TrueFirst: ICollectable;
+begin
+ FIndex := 0;
+ if FIndex < FCollection.GetSize then
+ Result := FCollection.GetItem(FIndex)
+ else
+ Result := nil;
+end;
+
+function TAbstractListIterator.TrueNext: ICollectable;
+begin
+ Inc(FIndex);
+ if FIndex < FCollection.GetSize then
+ Result := FCollection.GetItem(FIndex)
+ else
+ Result := nil;
+end;
+
+procedure TAbstractListIterator.TrueRemove;
+begin
+ FCollection.Delete(FIndex);
+ Dec(FIndex);
+end;
+
+end.
diff --git a/unicode/src/lib/collections/readme.txt b/unicode/src/lib/collections/readme.txt
new file mode 100644
index 00000000..1f6477de
--- /dev/null
+++ b/unicode/src/lib/collections/readme.txt
@@ -0,0 +1,14 @@
+Delphi Collections by Matthew Greet
+http://www.warmachine.u-net.com/delphi_collections/
+
+Help files (MS .hlp format) at
+http://www.warmachine.u-net.com/downloads/delphi_collections_1_0_help.zip
+
+Changes
+=====================
+2008-11-06 FPC compatibility fixes by UltraStar Deluxe Team
+2005-03-14 Maintenance release v1.0.5 - bug fix for sorted lists and functional tests checks unsorted and sorted lists.
+2004-10-14 Maintenance release v1.0.4 - memory leak fixed.
+2004-06-12 Maintenance release v1.0.3 - memory leak fixed, memory leak test, new Capacity property.
+2004-02-13 Maintenance release v1.0.2 - expanded introduction and quick start sections in help file.
+2003-10-25 Maintenance release v1.0.1 - packages and test harness no longer list unused packages. \ No newline at end of file
diff --git a/unicode/src/lib/ffmpeg/avcodec.pas b/unicode/src/lib/ffmpeg/avcodec.pas
index 0954ee06..6039835c 100644
--- a/unicode/src/lib/ffmpeg/avcodec.pas
+++ b/unicode/src/lib/ffmpeg/avcodec.pas
@@ -27,7 +27,7 @@
(*
* Conversion of libavcodec/avcodec.h
* Min. version: 51.16.0, revision 6577, Sat Oct 7 15:30:46 2006 UTC
- * Max. version: 52.0.0, revision 15448, Sun Sep 28 19:11:26 2008 UTC
+ * Max. version: 52.11.0, revision 16912, Sun Feb 1 02:00:19 2009 UTC
*)
unit avcodec;
@@ -51,6 +51,7 @@ uses
avutil,
rational,
opt,
+ SysUtils,
{$IFDEF UNIX}
BaseUnix,
{$ENDIF}
@@ -59,7 +60,7 @@ uses
const
(* Max. supported version by this header *)
LIBAVCODEC_MAX_VERSION_MAJOR = 52;
- LIBAVCODEC_MAX_VERSION_MINOR = 0;
+ LIBAVCODEC_MAX_VERSION_MINOR = 11;
LIBAVCODEC_MAX_VERSION_RELEASE = 0;
LIBAVCODEC_MAX_VERSION = (LIBAVCODEC_MAX_VERSION_MAJOR * VERSION_MAJOR) +
(LIBAVCODEC_MAX_VERSION_MINOR * VERSION_MINOR) +
@@ -231,6 +232,7 @@ type
CODEC_ID_CMV,
CODEC_ID_MOTIONPIXELS,
CODEC_ID_TGV,
+ CODEC_ID_TGQ,
//* various PCM "codecs" */
CODEC_ID_PCM_S16LE= $10000,
@@ -286,6 +288,7 @@ type
CODEC_ID_ADPCM_IMA_EA_EACS,
CODEC_ID_ADPCM_EA_XAS,
CODEC_ID_ADPCM_EA_MAXIS_XA,
+ CODEC_ID_ADPCM_IMA_ISS,
//* AMR */
CODEC_ID_AMR_NB= $12000,
@@ -350,6 +353,7 @@ type
CODEC_ID_ATRAC3P,
CODEC_ID_EAC3,
CODEC_ID_SIPR,
+ CODEC_ID_MP1,
//* subtitle codecs */
CODEC_ID_DVD_SUBTITLE= $17000,
@@ -403,6 +407,43 @@ type
_TSampleFormatArray = array [0 .. MaxInt div SizeOf(TSampleFormat)-1] of TSampleFormat;
PSampleFormatArray = ^_TSampleFormatArray;
+const
+ {* Audio channel masks *}
+ CH_FRONT_LEFT = $00000001;
+ CH_FRONT_RIGHT = $00000002;
+ CH_FRONT_CENTER = $00000004;
+ CH_LOW_FREQUENCY = $00000008;
+ CH_BACK_LEFT = $00000010;
+ CH_BACK_RIGHT = $00000020;
+ CH_FRONT_LEFT_OF_CENTER = $00000040;
+ CH_FRONT_RIGHT_OF_CENTER = $00000080;
+ CH_BACK_CENTER = $00000100;
+ CH_SIDE_LEFT = $00000200;
+ CH_SIDE_RIGHT = $00000400;
+ CH_TOP_CENTER = $00000800;
+ CH_TOP_FRONT_LEFT = $00001000;
+ CH_TOP_FRONT_CENTER = $00002000;
+ CH_TOP_FRONT_RIGHT = $00004000;
+ CH_TOP_BACK_LEFT = $00008000;
+ CH_TOP_BACK_CENTER = $00010000;
+ CH_TOP_BACK_RIGHT = $00020000;
+ CH_STEREO_LEFT = $20000000; ///< Stereo downmix.
+ CH_STEREO_RIGHT = $40000000; ///< See CH_STEREO_LEFT.
+
+ {* Audio channel convenience macros *}
+ CH_LAYOUT_MONO = (CH_FRONT_CENTER);
+ CH_LAYOUT_STEREO = (CH_FRONT_LEFT or CH_FRONT_RIGHT);
+ CH_LAYOUT_SURROUND = (CH_LAYOUT_STEREO or CH_FRONT_CENTER);
+ CH_LAYOUT_QUAD = (CH_LAYOUT_STEREO or CH_BACK_LEFT or CH_BACK_RIGHT);
+ CH_LAYOUT_5POINT0 = (CH_LAYOUT_SURROUND or CH_SIDE_LEFT or CH_SIDE_RIGHT);
+ CH_LAYOUT_5POINT1 = (CH_LAYOUT_5POINT0 or CH_LOW_FREQUENCY);
+ CH_LAYOUT_7POINT1 = (CH_LAYOUT_5POINT1 or CH_BACK_LEFT or CH_BACK_RIGHT);
+ CH_LAYOUT_7POINT1_WIDE = (CH_LAYOUT_SURROUND or CH_LOW_FREQUENCY or
+ CH_BACK_LEFT or CH_BACK_RIGHT or
+ CH_FRONT_LEFT_OF_CENTER or CH_FRONT_RIGHT_OF_CENTER);
+ CH_LAYOUT_STEREO_DOWNMIX = (CH_STEREO_LEFT or CH_STEREO_RIGHT);
+
+
const
{* in bytes *}
AVCODEC_MAX_AUDIO_FRAME_SIZE = 192000; // 1 second of 48khz 32bit audio
@@ -559,6 +600,11 @@ const
*)
CODEC_CAP_SMALL_LAST_FRAME = $0040;
+ (**
+ * Codec can export data for HW decoding (VDPAU).
+ *)
+ CODEC_CAP_HWACCEL_VDPAU = $0080;
+
//the following defines may change, don't expect compatibility if you use them
MB_TYPE_INTRA4x4 = $001;
MB_TYPE_INTRA16x16 = $002; //FIXME h264 specific
@@ -850,6 +896,38 @@ type
*)
bits_per_raw_sample: cint;
{$IFEND}
+
+ {$IF LIBAVCODEC_VERSION >= 52002000} // 52.2.0
+ (**
+ * Audio channel layout.
+ * - encoding: set by user.
+ * - decoding: set by libavcodec.
+ *)
+ channel_layout: cint64;
+
+ (**
+ * Request decoder to use this channel layout if it can (0 for default)
+ * - encoding: unused
+ * - decoding: Set by user.
+ *)
+ request_channel_layout: cint64;
+ {$IFEND}
+
+ {$IF LIBAVCODEC_VERSION >= 52004000} // 52.4.0
+ (**
+ * Ratecontrol attempt to use, at maximum, <value> of what can be used without an underflow.
+ * - encoding: Set by user.
+ * - decoding: unused.
+ *)
+ rc_max_available_vbv_use: cfloat;
+
+ (**
+ * Ratecontrol attempt to use, at least, <value> times the amount needed to prevent a vbv overflow.
+ * - encoding: Set by user.
+ * - decoding: unused.
+ *)
+ rc_min_vbv_overflow_use: cfloat;
+ {$IFEND}
end;
const
@@ -918,21 +996,25 @@ const
FF_IDCT_SIMPLEVIS = 18;
FF_IDCT_WMV2 = 19;
FF_IDCT_FAAN = 20;
+ FF_IDCT_EA = 21;
+ FF_IDCT_SIMPLENEON = 22;
+ FF_IDCT_SIMPLEALPHA = 23;
FF_EC_GUESS_MVS = 1;
FF_EC_DEBLOCK = 2;
- FF_MM_FORCE = $80000000; (* force usage of selected flags (OR) *)
+ FF_MM_FORCE = $80000000; (* force usage of selected flags (OR) *)
(* lower 16 bits - CPU features *)
- FF_MM_MMX = $0001; ///< standard MMX
- FF_MM_3DNOW = $0004; ///< AMD 3DNOW
- FF_MM_MMXEXT = $0002; ///< SSE integer functions or AMD MMX ext
- FF_MM_SSE = $0008; ///< SSE functions
- FF_MM_SSE2 = $0010; ///< PIV SSE2 functions
- FF_MM_3DNOWEXT = $0020; ///< AMD 3DNowExt
+ FF_MM_MMX = $0001; ///< standard MMX
+ FF_MM_3DNOW = $0004; ///< AMD 3DNOW
+ FF_MM_MMXEXT = $0002; ///< SSE integer functions or AMD MMX ext
+ FF_MM_SSE = $0008; ///< SSE functions
+ FF_MM_SSE2 = $0010; ///< PIV SSE2 functions
+ FF_MM_3DNOWEXT = $0020; ///< AMD 3DNowExt
FF_MM_SSE3 = $0040; ///< Prescott SSE3 functions
FF_MM_SSSE3 = $0080; ///< Conroe SSSE3 functions
- FF_MM_IWMMXT = $0100; ///< XScale IWMMXT
+ FF_MM_IWMMXT = $0100; ///< XScale IWMMXT
+ FF_MM_ALTIVEC = $0001; ///< standard AltiVec
FF_PRED_LEFT = 0;
FF_PRED_PLANE = 1;
@@ -1066,13 +1148,13 @@ type
// int (*func)(struct AVCodecContext *c2, void *arg)
TExecuteFunc = function(c2: PAVCodecContext; arg: Pointer): cint; cdecl;
- TAVClass = record {12}
- class_name: pchar;
+ TAVClass = record
+ class_name: PAnsiChar;
(* actually passing a pointer to an AVCodecContext
- or AVFormatContext, which begin with an AVClass.
- Needed because av_log is in libavcodec and has no visibility
- of AVIn/OutputFormat *)
- item_name: function (): pchar; cdecl;
+ or AVFormatContext, which begin with an AVClass.
+ Needed because av_log is in libavcodec and has no visibility
+ of AVIn/OutputFormat *)
+ item_name: function(): PAnsiChar; cdecl;
option: PAVOption;
end;
@@ -1334,7 +1416,7 @@ type
*)
opaque: pointer;
- codec_name: array [0..31] of char;
+ codec_name: array [0..31] of AnsiChar;
codec_type: TCodecType; (* see CODEC_TYPE_xxx *)
codec_id: TCodecID; (* see CODEC_ID_xxx *)
@@ -1451,7 +1533,7 @@ type
* - encoding: Set by libavcodec.
* - decoding: unused
*)
- stats_out: pchar;
+ stats_out: PByteArray;
(**
* pass2 encoding statistics input buffer
@@ -1459,7 +1541,7 @@ type
* - encoding: Allocated/set/freed by user.
* - decoding: unused
*)
- stats_in: pchar;
+ stats_in: PByteArray;
(**
* ratecontrol qmin qmax limiting method
@@ -1485,7 +1567,7 @@ type
* - encoding: Set by user
* - decoding: unused
*)
- rc_eq: {const} pchar;
+ rc_eq: {const} PByteArray;
(**
* maximum bitrate
@@ -1886,7 +1968,7 @@ type
* - encoding: unused
* - decoding: Set by user, will be converted to uppercase by libavcodec during init.
*)
- stream_codec_tag: array [0..3] of char; //cuint;
+ stream_codec_tag: array [0..3] of AnsiChar; //cuint;
(**
* scene change detection threshold
@@ -1994,7 +2076,11 @@ type
* - encoding: Set by libavcodec, user can override.
* - decoding: Set by libavcodec, user can override.
*)
+ {$IF LIBAVCODEC_VERSION < 52004000} // < 52.4.0
execute: function (c: PAVCodecContext; func: TExecuteFunc; arg: PPointer; ret: PCint; count: cint): cint; cdecl;
+ {$ELSE}
+ execute: function (c: PAVCodecContext; func: TExecuteFunc; arg: Pointer; ret: PCint; count: cint; size: cint): cint; cdecl;
+ {$IFEND}
(**
* thread opaque
@@ -2197,7 +2283,7 @@ type
(**
* number of reference frames
* - encoding: Set by user.
- * - decoding: unused
+ * - decoding: Set by lavc.
*)
refs: cint;
@@ -2349,13 +2435,16 @@ type
{$IFEND}
{$IF LIBAVCODEC_VERSION >= 51042000} // 51.42.0
+ {$IF LIBAVCODEC_MAX_VERSION_MAJOR < 53}
(**
* Decoder should decode to this many channels if it can (0 for default)
* - encoding: unused
* - decoding: Set by user.
+ * @deprecated Deprecated in favor of request_channel_layout.
*)
request_channels: cint;
{$IFEND}
+ {$IFEND}
{$IF LIBAVCODEC_VERSION > 51049000} // > 51.49.0
(**
@@ -2382,15 +2471,15 @@ type
* AVCodec.
*)
TAVCodec = record
- name: pchar;
+ name: PAnsiChar;
type_: TCodecType;
id: TCodecID;
priv_data_size: cint;
init: function (avctx: PAVCodecContext): cint; cdecl; (* typo corretion by the Creative CAT *)
- encode: function (avctx: PAVCodecContext; buf: pchar; buf_size: cint; data: pointer): cint; cdecl;
+ encode: function (avctx: PAVCodecContext; buf: PByteArray; buf_size: cint; data: pointer): cint; cdecl;
close: function (avctx: PAVCodecContext): cint; cdecl;
decode: function (avctx: PAVCodecContext; outdata: pointer; var outdata_size: cint;
- buf: {const} pchar; buf_size: cint): cint; cdecl;
+ buf: {const} PByteArray; buf_size: cint): cint; cdecl;
(**
* Codec capabilities.
* see CODEC_CAP_*
@@ -2409,7 +2498,7 @@ type
* Descriptive name for the codec, meant to be more human readable than \p name.
* You \e should use the NULL_IF_CONFIG_SMALL() macro to define it.
*)
- long_name: {const} PChar;
+ long_name: {const} PAnsiChar;
{$IFEND}
{$IF LIBAVCODEC_VERSION >= 51056000} // 51.56.0
supported_samplerates: {const} PCint; ///< array of supported audio samplerates, or NULL if unknown, array is terminated by 0
@@ -2417,6 +2506,9 @@ type
{$IF LIBAVCODEC_VERSION >= 51062000} // 51.62.0
sample_fmts: {const} PSampleFormatArray; ///< array of supported sample formats, or NULL if unknown, array is terminated by -1
{$IFEND}
+ {$IF LIBAVCODEC_VERSION >= 52002000} // 52.2.0
+ channel_layouts: {const} PCint64; ///< array of support channel layouts, or NULL if unknown. array is terminated by 0
+ {$IFEND}
end;
(**
@@ -2425,30 +2517,81 @@ type
*)
PAVPicture = ^TAVPicture;
TAVPicture = record
- data: array [0..3] of pchar;
+ data: array [0..3] of PByteArray;
linesize: array [0..3] of cint; ///< number of bytes per line
end;
type
+ TAVSubtitleType = (
+ SUBTITLE_NONE,
+
+ SUBTITLE_BITMAP, ///< A bitmap, pict will be set
+
+ (**
+ * Plain text, the text field must be set by the decoder and is
+ * authoritative. ass and pict fields may contain approximations.
+ *)
+ SUBTITLE_TEXT,
+
+ (**
+ * Formatted text, the ass field must be set by the decoder and is
+ * authoritative. pict and text fields may contain approximations.
+ *)
+ SUBTITLE_ASS
+ );
+
+type
+ PPAVSubtitleRect = ^PAVSubtitleRect;
PAVSubtitleRect = ^TAVSubtitleRect;
+ {$IF LIBAVCODEC_VERSION < 52010000} // < 52.10.0
TAVSubtitleRect = record
- x: word;
- y: word;
- w: word;
- h: word;
- nb_colors: word;
+ x: cuint16;
+ y: cuint16;
+ w: cuint16;
+ h: cuint16;
+ nb_colors: cuint16;
linesize: cint;
- rgba_palette: PCuint;
- bitmap: pchar;
+ rgba_palette: PCuint32;
+ bitmap: PCuint8;
+ end;
+ {$ELSE}
+ TAVSubtitleRect = record
+ x: cint; ///< top left corner of pict, undefined when pict is not set
+ y: cint; ///< top left corner of pict, undefined when pict is not set
+ w: cint; ///< width of pict, undefined when pict is not set
+ h: cint; ///< height of pict, undefined when pict is not set
+ nb_colors: cint; ///< number of colors in pict, undefined when pict is not set
+
+ (**
+ * data+linesize for the bitmap of this subtitle.
+ * can be set for text/ass as well once they where rendered
+ *)
+ pict: TAVPicture;
+ type_: TAVSubtitleType;
+
+ text: PAnsiChar; ///< 0 terminated plain UTF-8 text
+
+ (**
+ * 0 terminated ASS/SSA compatible event line.
+ * The pressentation of this is unaffected by the other values in this
+ * struct.
+ *)
+ ass: PByteArray;
end;
+ {$IFEND}
+ PPAVSubtitle = ^PAVSubtitle;
PAVSubtitle = ^TAVSubtitle;
- TAVSubtitle = record {20}
- format: word; (* 0 = graphics *)
- start_display_time: cuint; (* relative to packet pts, in ms *)
- end_display_time: cuint; (* relative to packet pts, in ms *)
+ TAVSubtitle = record
+ format: cuint16; (* 0 = graphics *)
+ start_display_time: cuint32; (* relative to packet pts, in ms *)
+ end_display_time: cuint32; (* relative to packet pts, in ms *)
num_rects: cuint;
+ {$IF LIBAVCODEC_VERSION < 52010000} // < 52.10.0
rects: PAVSubtitleRect;
+ {$ELSE}
+ rects: PPAVSubtitleRect;
+ {$IFEND}
end;
@@ -2563,7 +2706,7 @@ function avpicture_fill (picture: PAVPicture; ptr: pointer;
function avpicture_layout (src: {const} PAVPicture; pix_fmt: TAVPixelFormat;
width: cint; height: cint;
- dest: pchar; dest_size: cint): cint;
+ dest: PByteArray; dest_size: cint): cint;
cdecl; external av__codec;
(**
@@ -2581,13 +2724,13 @@ function avpicture_get_size (pix_fmt: TAVPixelFormat; width: cint; height: cint)
procedure avcodec_get_chroma_sub_sample (pix_fmt: TAVPixelFormat; var h_shift: cint; var v_shift: cint);
cdecl; external av__codec;
-function avcodec_get_pix_fmt_name(pix_fmt: TAVPixelFormat): pchar;
+function avcodec_get_pix_fmt_name(pix_fmt: TAVPixelFormat): PAnsiChar;
cdecl; external av__codec;
procedure avcodec_set_dimensions(s: PAVCodecContext; width: cint; height: cint);
cdecl; external av__codec;
-function avcodec_get_pix_fmt(name: {const} pchar): TAVPixelFormat;
+function avcodec_get_pix_fmt(name: {const} PAnsiChar): TAVPixelFormat;
cdecl; external av__codec;
function avcodec_pix_fmt_to_codec_tag(p: TAVPixelFormat): cuint;
@@ -2665,7 +2808,7 @@ function avcodec_find_best_pix_fmt(pix_fmt_mask: cint; src_pix_fmt: TAVPixelForm
* a negative value to print the corresponding header.
* Meaningful values for obtaining a pixel format info vary from 0 to PIX_FMT_NB -1.
*)
-procedure avcodec_pix_fmt_string (buf: PChar; buf_size: cint; pix_fmt: cint);
+procedure avcodec_pix_fmt_string (buf: PAnsiChar; buf_size: cint; pix_fmt: cint);
cdecl; external av__codec;
{$IFEND}
@@ -2734,7 +2877,12 @@ function avcodec_build(): cuint;
procedure avcodec_init();
cdecl; external av__codec;
-procedure register_avcodec(format: PAVCodec);
+(**
+ * Register the codec \p codec and initialize libavcodec.
+ *
+ * @see avcodec_init()
+ *)
+procedure register_avcodec(codec: PAVCodec);
cdecl; external av__codec;
(**
@@ -2752,7 +2900,7 @@ function avcodec_find_encoder(id: TCodecID): PAVCodec;
* @param name name of the requested encoder
* @return An encoder if one was found, NULL otherwise.
*)
-function avcodec_find_encoder_by_name(name: pchar): PAVCodec;
+function avcodec_find_encoder_by_name(name: PAnsiChar): PAVCodec;
cdecl; external av__codec;
(**
@@ -2770,9 +2918,9 @@ function avcodec_find_decoder(id: TCodecID): PAVCodec;
* @param name name of the requested decoder
* @return A decoder if one was found, NULL otherwise.
*)
-function avcodec_find_decoder_by_name(name: pchar): PAVCodec;
+function avcodec_find_decoder_by_name(name: PAnsiChar): PAVCodec;
cdecl; external av__codec;
-procedure avcodec_string(buf: pchar; buf_size: cint; enc: PAVCodecContext; encode: cint);
+procedure avcodec_string(buf: PAnsiChar; buf_size: cint; enc: PAVCodecContext; encode: cint);
cdecl; external av__codec;
(**
@@ -2851,10 +2999,23 @@ function avcodec_thread_init(s: PAVCodecContext; thread_count: cint): cint;
cdecl; external av__codec;
procedure avcodec_thread_free(s: PAVCodecContext);
cdecl; external av__codec;
+
+
+{$IF LIBAVCODEC_VERSION < 52004000} // < 52.4.0
function avcodec_thread_execute(s: PAVCodecContext; func: TExecuteFunc; arg: PPointer; var ret: cint; count: cint): cint;
cdecl; external av__codec;
+{$ELSE}
+function avcodec_thread_execute(s: PAVCodecContext; func: TExecuteFunc; arg: Pointer; var ret: cint; count: cint; size: cint): cint;
+ cdecl; external av__codec;
+{$IFEND}
+
+{$IF LIBAVCODEC_VERSION < 52004000} // < 52.4.0
function avcodec_default_execute(s: PAVCodecContext; func: TExecuteFunc; arg: PPointer; var ret: cint; count: cint): cint;
cdecl; external av__codec;
+{$ELSE}
+function avcodec_default_execute(s: PAVCodecContext; func: TExecuteFunc; arg: Pointer; var ret: cint; count: cint; size: cint): cint;
+ cdecl; external av__codec;
+{$IFEND}
//FIXME func typedef
(**
@@ -2893,7 +3054,7 @@ function avcodec_open(avctx: PAVCodecContext; codec: PAVCodec): cint;
*)
function avcodec_decode_audio(avctx: PAVCodecContext; samples: PSmallint;
var frame_size_ptr: cint;
- buf: {const} pchar; buf_size: cint): cint;
+ buf: {const} PByteArray; buf_size: cint): cint;
cdecl; external av__codec;
{$IFEND}
@@ -2926,6 +3087,9 @@ function avcodec_decode_audio(avctx: PAVCodecContext; samples: PSmallint;
* the linesize is not a multiple of 16 then there's no sense in aligning the
* start of the buffer to 16.
*
+ * @note Some codecs have a delay between input and output, these need to be
+ * feeded with buf=NULL, buf_size=0 at the end to return the remaining frames.
+ *
* @param avctx the codec context
* @param[out] samples the output buffer
* @param[in,out] frame_size_ptr the output buffer size in bytes
@@ -2936,7 +3100,7 @@ function avcodec_decode_audio(avctx: PAVCodecContext; samples: PSmallint;
*)
function avcodec_decode_audio2(avctx: PAVCodecContext; samples: PSmallint;
var frame_size_ptr: cint;
- buf: {const} pchar; buf_size: cint): cint;
+ buf: {const} PByteArray; buf_size: cint): cint;
cdecl; external av__codec;
{$IFEND}
@@ -2973,7 +3137,7 @@ function avcodec_decode_audio2(avctx: PAVCodecContext; samples: PSmallint;
*)
function avcodec_decode_video(avctx: PAVCodecContext; picture: PAVFrame;
var got_picture_ptr: cint;
- buf: {const} PChar; buf_size: cint): cint;
+ buf: {const} PByteArray; buf_size: cint): cint;
cdecl; external av__codec;
(* Decode a subtitle message. Return -1 if error, otherwise return the
@@ -2981,11 +3145,11 @@ function avcodec_decode_video(avctx: PAVCodecContext; picture: PAVFrame;
* got_sub_ptr is zero. Otherwise, the subtitle is stored in *sub. *)
function avcodec_decode_subtitle(avctx: PAVCodecContext; sub: PAVSubtitle;
var got_sub_ptr: cint;
- buf: {const} pchar; buf_size: cint): cint;
+ buf: {const} PByteArray; buf_size: cint): cint;
cdecl; external av__codec;
function avcodec_parse_frame(avctx: PAVCodecContext; pdata: PPointer;
data_size_ptr: PCint;
- buf: pchar; buf_size: cint): cint;
+ buf: PByteArray; buf_size: cint): cint;
cdecl; external av__codec;
(**
@@ -3025,18 +3189,28 @@ function avcodec_encode_audio(avctx: PAVCodecContext; buf: PByte;
* @param[in] buf_size the size of the output buffer in bytes
* @param[in] pict the input picture to encode
* @return On error a negative value is returned, on success zero or the number
- * of bytes used from the input buffer.
+ * of bytes used from the output buffer.
*)
function avcodec_encode_video(avctx: PAVCodecContext; buf: PByte;
buf_size: cint; pict: PAVFrame): cint;
cdecl; external av__codec;
-function avcodec_encode_subtitle(avctx: PAVCodecContext; buf: pchar;
+function avcodec_encode_subtitle(avctx: PAVCodecContext; buf: PByteArray;
buf_size: cint; sub: {const} PAVSubtitle): cint;
cdecl; external av__codec;
function avcodec_close(avctx: PAVCodecContext): cint;
cdecl; external av__codec;
+(**
+ * Register all the codecs, parsers and bitstream filters which were enabled at
+ * configuration time. If you do not call this function you can select exactly
+ * which formats you want to support, by using the individual registration
+ * functions.
+ *
+ * @see register_avcodec
+ * @see av_register_codec_parser
+ * @see av_register_bitstream_filter
+ *)
procedure avcodec_register_all();
cdecl; external av__codec;
@@ -3057,7 +3231,7 @@ procedure avcodec_default_free_buffers(s: PAVCodecContext);
* @param[in] pict_type the picture type
* @return A single character representing the picture type.
*)
-function av_get_pict_type_char(pict_type: cint): char;
+function av_get_pict_type_char(pict_type: cint): AnsiChar;
cdecl; external av__codec;
(**
@@ -3127,9 +3301,9 @@ type
parser_init: function(s: PAVCodecParserContext): cint; cdecl;
parser_parse: function(s: PAVCodecParserContext; avctx: PAVCodecContext;
poutbuf: {const} PPointer; poutbuf_size: PCint;
- buf: {const} pchar; buf_size: cint): cint; cdecl;
+ buf: {const} PByteArray; buf_size: cint): cint; cdecl;
parser_close: procedure(s: PAVCodecParserContext); cdecl;
- split: function(avctx: PAVCodecContext; buf: {const} pchar;
+ split: function(avctx: PAVCodecContext; buf: {const} PByteArray;
buf_size: cint): cint; cdecl;
next: PAVCodecParser;
end;
@@ -3156,13 +3330,13 @@ function av_parser_init(codec_id: cint): PAVCodecParserContext;
function av_parser_parse(s: PAVCodecParserContext;
avctx: PAVCodecContext;
poutbuf: PPointer; poutbuf_size: PCint;
- buf: {const} pchar; buf_size: cint;
+ buf: {const} PByteArray; buf_size: cint;
pts: cint64; dts: cint64): cint;
cdecl; external av__codec;
function av_parser_change(s: PAVCodecParserContext;
avctx: PAVCodecContext;
poutbuf: PPointer; poutbuf_size: PCint;
- buf: {const} pchar; buf_size: cint; keyframe: cint): cint;
+ buf: {const} PByteArray; buf_size: cint; keyframe: cint): cint;
cdecl; external av__codec;
procedure av_parser_close(s: PAVCodecParserContext);
cdecl; external av__codec;
@@ -3179,10 +3353,10 @@ type
end;
TAVBitStreamFilter = record
- name: pchar;
+ name: PAnsiChar;
priv_data_size: cint;
filter: function(bsfc: PAVBitStreamFilterContext;
- avctx: PAVCodecContext; args: pchar;
+ avctx: PAVCodecContext; args: PByteArray;
poutbuf: PPointer; poutbuf_size: PCint;
buf: PByte; buf_size: cint; keyframe: cint): cint; cdecl;
{$IF LIBAVCODEC_VERSION >= 51043000} // 51.43.0
@@ -3194,11 +3368,11 @@ type
procedure av_register_bitstream_filter(bsf: PAVBitStreamFilter);
cdecl; external av__codec;
-function av_bitstream_filter_init(name: pchar): PAVBitStreamFilterContext;
+function av_bitstream_filter_init(name: PAnsiChar): PAVBitStreamFilterContext;
cdecl; external av__codec;
function av_bitstream_filter_filter(bsfc: PAVBitStreamFilterContext;
- avctx: PAVCodecContext; args: pchar;
+ avctx: PAVCodecContext; args: PByteArray;
poutbuf: PPointer; poutbuf_size: PCint;
buf: PByte; buf_size: cint; keyframe: cint): cint;
cdecl; external av__codec;
@@ -3317,7 +3491,7 @@ function av_xiphlacing(s: PByte; v: cuint): cuint;
* @param[in,out] height_ptr pointer to the variable which will contain the detected
* frame height value
*)
-function av_parse_video_frame_size(width_ptr: PCint; height_ptr: PCint; str: {const} PChar): cint;
+function av_parse_video_frame_size(width_ptr: PCint; height_ptr: PCint; str: {const} PAnsiChar): cint;
cdecl; external av__codec;
(**
@@ -3329,22 +3503,7 @@ function av_parse_video_frame_size(width_ptr: PCint; height_ptr: PCint; str: {co
* @param[in,out] frame_rate pointer to the AVRational which will contain the detected
* frame rate
*)
-function av_parse_video_frame_rate(frame_rate: PAVRational; str: {const} PChar): cint;
- cdecl; external av__codec;
-{$IFEND}
-
-{$IF LIBAVCODEC_VERSION >= 51064000} // 51.64.0
-(**
- * Logs a generic warning message about a missing feature.
- * @param[in] avc a pointer to an arbitrary struct of which the first field is
- * a pointer to an AVClass struct
- * @param[in] feature string containing the name of the missing feature
- * @param[in] want_sample indicates if samples are wanted which exhibit this feature.
- * If \p want_sample is non-zero, additional verbage will be added to the log
- * message which tells the user how to report samples to the development
- * mailing list.
- *)
-procedure av_log_missing_feature(avc: Pointer; feature: {const} PChar; want_sample: cint);
+function av_parse_video_frame_rate(frame_rate: PAVRational; str: {const} PAnsiChar): cint;
cdecl; external av__codec;
{$IFEND}
diff --git a/unicode/src/lib/ffmpeg/avformat.pas b/unicode/src/lib/ffmpeg/avformat.pas
index c516aea0..62df8a83 100644
--- a/unicode/src/lib/ffmpeg/avformat.pas
+++ b/unicode/src/lib/ffmpeg/avformat.pas
@@ -27,7 +27,7 @@
(*
* Conversion of libavformat/avformat.h
* Min. version: 50.5.0 , revision 6577, Sat Oct 7 15:30:46 2006 UTC
- * Max. version: 52.22.1, revision 15441, Sat Sep 27 20:05:12 2008 UTC
+ * Max. version: 52.25.0, revision 16986, Wed Feb 4 05:56:39 2009 UTC
*)
unit avformat;
@@ -54,13 +54,14 @@ uses
avutil,
avio,
rational,
+ SysUtils,
UConfig;
const
(* Max. supported version by this header *)
LIBAVFORMAT_MAX_VERSION_MAJOR = 52;
- LIBAVFORMAT_MAX_VERSION_MINOR = 22;
- LIBAVFORMAT_MAX_VERSION_RELEASE = 1;
+ LIBAVFORMAT_MAX_VERSION_MINOR = 25;
+ LIBAVFORMAT_MAX_VERSION_RELEASE = 0;
LIBAVFORMAT_MAX_VERSION = (LIBAVFORMAT_MAX_VERSION_MAJOR * VERSION_MAJOR) +
(LIBAVFORMAT_MAX_VERSION_MINOR * VERSION_MINOR) +
(LIBAVFORMAT_MAX_VERSION_RELEASE * VERSION_RELEASE);
@@ -95,6 +96,68 @@ function avformat_version(): cuint;
type
PAVFile = Pointer;
+(*
+ * Public Metadata API.
+ * !!WARNING!! This is a work in progress. Don't use outside FFmpeg for now.
+ * The metadata API allows libavformat to export metadata tags to a client
+ * application using a sequence of key/value pairs.
+ * Important concepts to keep in mind:
+ * 1. Keys are unique; there can never be 2 tags with the same key. This is
+ * also meant semantically, i.e., a demuxer should not knowingly produce
+ * several keys that are literally different but semantically identical.
+ * E.g., key=Author5, key=Author6. In this example, all authors must be
+ * placed in the same tag.
+ * 2. Metadata is flat, not hierarchical; there are no subtags. If you
+ * want to store, e.g., the email address of the child of producer Alice
+ * and actor Bob, that could have key=alice_and_bobs_childs_email_address.
+ * 3. A tag whose value is localized for a particular language is appended
+ * with a dash character ('-') and the ISO 639 3-letter language code.
+ * For example: Author-ger=Michael, Author-eng=Mike
+ * The original/default language is in the unqualified "Author" tag.
+ * A demuxer should set a default if it sets any translated tag.
+ *)
+const
+ AV_METADATA_MATCH_CASE = 1;
+ AV_METADATA_IGNORE_SUFFIX = 2;
+
+type
+ PAVMetadataTag = ^TAVMetadataTag;
+ TAVMetadataTag = record
+ key: PAnsiChar;
+ value: PAnsiChar;
+ end;
+
+ PAVMetadata = Pointer;
+
+{$IF LIBAVFORMAT_VERSION > 52024001} // > 52.24.1
+
+(**
+ * gets a metadata element with matching key.
+ * @param prev set to the previous matching element to find the next.
+ * @param flags allows case as well as suffix insensitive comparisons.
+ * @return found tag or NULL, changing key or value leads to undefined behavior.
+ *)
+function av_metadata_get(m: PAVMetadata; key: {const} PAnsiChar;
+ prev: {const} PAVMetadataTag ; flags: cint): PAVMetadataTag;
+ cdecl; external av__format;
+
+(**
+ * sets the given tag in m, overwriting an existing tag.
+ * @param key tag key to add to m (will be av_strduped).
+ * @param value tag value to add to m (will be av_strduped).
+ * @return >= 0 if success otherwise error code that is <0.
+ *)
+function av_metadata_set(var pm: PAVMetadata; key: {const} PAnsiChar; value: {const} PAnsiChar): cint;
+ cdecl; external av__format;
+
+(**
+ * Free all the memory allocated for an AVMetadata struct.
+ *)
+procedure av_metadata_free(var m: PAVMetadata);
+ cdecl; external av__format;
+
+{$IFEND}
+
(* packet functions *)
type
@@ -117,7 +180,7 @@ type
* Can be AV_NOPTS_VALUE if it is not stored in the file.
*)
dts: cint64;
- data: PChar;
+ data: PByteArray;
size: cint;
stream_index: cint;
flags: cint;
@@ -126,7 +189,7 @@ type
* Equals next_pts - this_pts in presentation order.
*)
duration: cint;
- destruct: procedure (p: PAVPacket); cdecl;
+ destruct: procedure (p: PAVPacket); cdecl;
priv: pointer;
pos: cint64; ///< byte position in stream, -1 if unknown
@@ -220,7 +283,7 @@ type
PAVFrac = ^TAVFrac;
TAVFrac = record
val, num, den: cint64;
- end; {deprecated}
+ end;
(*************************************************)
(* input/output formats *)
@@ -228,8 +291,8 @@ type
type
(** This structure contains the data a format has to probe a file. *)
TAVProbeData = record
- filename: pchar;
- buf: pchar;
+ filename: PAnsiChar;
+ buf: PByteArray;
buf_size: cint;
end;
@@ -309,7 +372,10 @@ type
id: cint; ///< unique ID to identify the chapter
time_base: TAVRational; ///< time base in which the start/end timestamps are specified
start, end_: cint64; ///< chapter start/end time in time_base units
- title: PChar; ///< chapter title
+ title: PAnsiChar; ///< chapter title
+ {$IF LIBAVFORMAT_VERSION >= 52024001} // 52.24.1
+ metadata: PAVMetadata;
+ {$IFEND}
end;
TAVChapterArray = array[0..(MaxInt div SizeOf(TAVChapter))-1] of TAVChapter;
PAVChapterArray = ^TAVChapterArray;
@@ -326,9 +392,9 @@ type
{$IFEND}
channel: cint; (**< Used to select DV channel. *)
{$IF LIBAVFORMAT_VERSION_MAJOR < 52}
- device: pchar; (* video, audio or DV device, if LIBAVFORMAT_VERSION_INT < (52<<16) *)
+ device: PAnsiChar; (* video, audio or DV device, if LIBAVFORMAT_VERSION_INT < (52<<16) *)
{$IFEND}
- standard: pchar; (**< TV standard, NTSC, PAL, SECAM *)
+ standard: PAnsiChar; (**< TV standard, NTSC, PAL, SECAM *)
{ Delphi does not support bit fields -> use bf_flags instead
unsigned int mpeg2ts_raw:1; (**< Force raw MPEG-2 transport stream output, if possible. *)
unsigned int mpeg2ts_compute_pcr:1; (**< Compute exact PCR for each transport
@@ -346,15 +412,15 @@ type
end;
TAVOutputFormat = record
- name: pchar;
+ name: PAnsiChar;
(**
* Descriptive name for the format, meant to be more human-readable
* than \p name. You \e should use the NULL_IF_CONFIG_SMALL() macro
* to define it.
*)
- long_name: pchar;
- mime_type: pchar;
- extensions: pchar; (**< comma-separated filename extensions *)
+ long_name: PAnsiChar;
+ mime_type: PAnsiChar;
+ extensions: PAnsiChar; (**< comma-separated filename extensions *)
(** Size of private data so that it can be allocated in the wrapper. *)
priv_data_size: cint;
(* output support *)
@@ -387,13 +453,13 @@ type
end;
TAVInputFormat = record
- name: pchar;
+ name: PAnsiChar;
(**
* Descriptive name for the format, meant to be more human-readable
* than \p name. You \e should use the NULL_IF_CONFIG_SMALL() macro
* to define it.
*)
- long_name: pchar;
+ long_name: PAnsiChar;
(** Size of private data so that it can be allocated in the wrapper. *)
priv_data_size: cint;
(**
@@ -435,7 +501,7 @@ type
(** If extensions are defined, then no probe is done. You should
usually not use extension format guessing because it is not
reliable enough *)
- extensions: pchar;
+ extensions: PAnsiChar;
(** General purpose read-only value that the format can use. *)
value: cint;
@@ -533,7 +599,7 @@ type
*)
duration: cint64;
- language: array [0..3] of char; (* ISO 639 3-letter language code (empty string if undefined) *)
+ language: array [0..3] of PAnsiChar; (* ISO 639 3-letter language code (empty string if undefined) *)
(* av_read_frame() support *)
need_parsing: TAVStreamParseType;
@@ -555,7 +621,7 @@ type
{$IFEND}
{$IF LIBAVFORMAT_VERSION >= 52006000} // 52.6.0
- filename: PChar; (**< source filename of the stream *)
+ filename: PAnsiChar; (**< source filename of the stream *)
{$IFEND}
{$IF LIBAVFORMAT_VERSION >= 52008000} // 52.8.0
@@ -576,6 +642,17 @@ type
*)
sample_aspect_ratio: TAVRational;
{$IFEND}
+
+ {$IF LIBAVFORMAT_VERSION >= 52024001} // 52.24.1
+ metadata: PAVMetadata;
+ {$IFEND}
+
+ {$IF LIBAVFORMAT_VERSION > 52024001} // > 52.24.1
+ {* av_read_frame() support *}
+ cur_ptr: {const} PCuint8;
+ cur_len: cint;
+ cur_pkt: TAVPacket;
+ {$IFEND}
end;
(**
@@ -600,17 +677,17 @@ type
nb_streams: cuint;
streams: array [0..MAX_STREAMS - 1] of PAVStream;
- filename: array [0..1023] of char; (* input or output filename *)
+ filename: array [0..1023] of AnsiChar; (* input or output filename *)
(* stream info *)
timestamp: cint64;
- title: array [0..511] of char;
- author: array [0..511] of char;
- copyright: array [0..511] of char;
- comment: array [0..511] of char;
- album: array [0..511] of char;
+ title: array [0..511] of AnsiChar;
+ author: array [0..511] of AnsiChar;
+ copyright: array [0..511] of AnsiChar;
+ comment: array [0..511] of AnsiChar;
+ album: array [0..511] of AnsiChar;
year: cint; (**< ID3 year, 0 if none *)
track: cint; (**< track number, 0 if none *)
- genre: array [0..31] of char; (**< ID3 genre *)
+ genre: array [0..31] of AnsiChar; (**< ID3 genre *)
ctx_flags: cint; (**< Format-specific flags, see AVFMTCTX_xx *)
(* private data for pts handling (do not modify directly). *)
@@ -636,9 +713,11 @@ type
(* av_read_frame() support *)
cur_st: PAVStream;
- cur_ptr: pbyte;
- cur_len: cint;
- cur_pkt: TAVPacket;
+ {$IF LIBAVFORMAT_VERSION_MAJOR < 53}
+ cur_ptr_deprecated: pbyte;
+ cur_len_deprecated: cint;
+ cur_pkt_deprecated: TAVPacket;
+ {$IFEND}
(* av_seek_frame() support *)
data_offset: cint64; (* offset of the first packet *)
@@ -740,6 +819,10 @@ type
packet_buffer_end: PAVPacketList;
{$IFEND}
+
+ {$IF LIBAVFORMAT_VERSION >= 52024001} // 52.24.1
+ metadata: PAVMetadata;
+ {$IFEND}
end;
(**
@@ -750,14 +833,17 @@ type
*)
TAVProgram = record
id : cint;
- provider_name : PChar; ///< network name for DVB streams
- name : PChar; ///< service name for DVB streams
+ provider_name : PAnsiChar; ///< network name for DVB streams
+ name : PAnsiChar; ///< service name for DVB streams
flags : cint;
discard : TAVDiscard; ///< selects which program to discard and which to feed to the caller
{$IF LIBAVFORMAT_VERSION >= 51016000} // 51.16.0
stream_index : PCardinal;
nb_stream_indexes : PCardinal;
{$IFEND}
+ {$IF LIBAVFORMAT_VERSION >= 52024001} // 52.24.1
+ metadata: PAVMetadata;
+ {$IFEND}
end;
TAVPacketList = record
@@ -779,8 +865,8 @@ type
end; {deprecated}
TAVImageFormat = record
- name: pchar;
- extensions: pchar;
+ name: PAnsiChar;
+ extensions: PAnsiChar;
(* tell if a given file has a chance of being parsing by this format *)
img_probe: function (d: PAVProbeData): cint; cdecl;
(* read a whole image. 'alloc_cb' is called when the image size is
@@ -801,10 +887,10 @@ procedure av_register_image_format(img_fmt: PAVImageFormat);
function av_probe_image_format(pd: PAVProbeData): PAVImageFormat;
cdecl; external av__format; deprecated;
-function guess_image_format(filename: pchar): PAVImageFormat;
+function guess_image_format(filename: PAnsiChar): PAVImageFormat;
cdecl; external av__format; deprecated;
-function av_read_image(pb: PByteIOContext; filename: pchar;
+function av_read_image(pb: PByteIOContext; filename: PAnsiChar;
fmt: PAVImageFormat;
alloc_cb: pointer; opaque: pointer): cint;
cdecl; external av__format; deprecated;
@@ -828,7 +914,7 @@ function av_oformat_next(f: PAVOutputFormat): PAVOutputFormat;
cdecl; external av__format;
{$IFEND}
-function av_guess_image2_codec(filename: {const} PChar): TCodecID;
+function av_guess_image2_codec(filename: {const} PAnsiChar): TCodecID;
cdecl; external av__format;
(* XXX: use automatic init with either ELF sections or C file parser *)
@@ -841,21 +927,21 @@ procedure av_register_input_format(format: PAVInputFormat);
procedure av_register_output_format(format: PAVOutputFormat);
cdecl; external av__format;
-function guess_stream_format(short_name: pchar;
- filename: pchar;
- mime_type: pchar): PAVOutputFormat;
+function guess_stream_format(short_name: PAnsiChar;
+ filename: PAnsiChar;
+ mime_type: PAnsiChar): PAVOutputFormat;
cdecl; external av__format;
-function guess_format(short_name: pchar;
- filename: pchar;
- mime_type: pchar): PAVOutputFormat;
+function guess_format(short_name: PAnsiChar;
+ filename: PAnsiChar;
+ mime_type: PAnsiChar): PAVOutputFormat;
cdecl; external av__format;
(**
* Guesses the codec ID based upon muxer and filename.
*)
-function av_guess_codec(fmt: PAVOutputFormat; short_name: pchar;
- filename: pchar; mime_type: pchar;
+function av_guess_codec(fmt: PAVOutputFormat; short_name: PAnsiChar;
+ filename: PAnsiChar; mime_type: PAnsiChar;
type_: TCodecType): TCodecID;
cdecl; external av__format;
@@ -868,7 +954,7 @@ function av_guess_codec(fmt: PAVOutputFormat; short_name: pchar;
*
* @see av_hex_dump_log, av_pkt_dump, av_pkt_dump_log
*)
-procedure av_hex_dump(f: PAVFile; buf: pchar; size: cint);
+procedure av_hex_dump(f: PAVFile; buf: PByteArray; size: cint);
cdecl; external av__format;
{$IF LIBAVFORMAT_VERSION >= 51011000} // 51.11.0
@@ -884,7 +970,7 @@ procedure av_hex_dump(f: PAVFile; buf: pchar; size: cint);
*
* @see av_hex_dump, av_pkt_dump, av_pkt_dump_log
*)
-procedure av_hex_dump_log(avcl: Pointer; level: cint; buf: PChar; size: cint);
+procedure av_hex_dump_log(avcl: Pointer; level: cint; buf: PByteArray; size: cint);
cdecl; external av__format;
{$IFEND}
@@ -913,6 +999,15 @@ procedure av_pkt_dump_log(avcl: Pointer; level: cint; pkt: PAVPacket; dump_paylo
cdecl; external av__format;
{$IFEND}
+(**
+ * Initialize libavformat and register all the muxers, demuxers and
+ * protocols. If you do not call this function, then you can select
+ * exactly which formats you want to support.
+ *
+ * @see av_register_input_format()
+ * @see av_register_output_format()
+ * @see register_protocol()
+ *)
procedure av_register_all();
cdecl; external av__format;
@@ -929,7 +1024,7 @@ function av_codec_get_tag(var tags: PAVCodecTag; id: TCodecID): cuint;
(**
* Finds AVInputFormat based on the short name of the input format.
*)
-function av_find_input_format(short_name: pchar): PAVInputFormat;
+function av_find_input_format(short_name: PAnsiChar): PAVInputFormat;
cdecl; external av__format;
(**
@@ -946,7 +1041,7 @@ function av_probe_input_format(pd: PAVProbeData; is_opened: cint): PAVInputForma
* This does not open the needed codecs for decoding the stream[s].
*)
function av_open_input_stream(ic_ptr: PAVFormatContext;
- pb: PByteIOContext; filename: pchar;
+ pb: PByteIOContext; filename: PAnsiChar;
fmt: PAVInputFormat; ap: PAVFormatParameters): cint;
cdecl; external av__format;
@@ -962,7 +1057,7 @@ function av_open_input_stream(ic_ptr: PAVFormatContext;
* (NULL if default).
* @return 0 if OK, AVERROR_xxx otherwise
*)
-function av_open_input_file(var ic_ptr: PAVFormatContext; filename: pchar;
+function av_open_input_file(var ic_ptr: PAVFormatContext; filename: PAnsiChar;
fmt: PAVInputFormat; buf_size: cint;
ap: PAVFormatParameters): cint;
cdecl; external av__format;
@@ -1105,7 +1200,7 @@ function av_new_program(s: PAVFormatContext; id: cint): PAVProgram;
* @return AVChapter or NULL on error
*)
function ff_new_chapter(s: PAVFormatContext; id: cint; time_base: TAVRational;
- start, end_: cint64; title: {const} Pchar): PAVChapter;
+ start, end_: cint64; title: {const} PAnsiChar): PAVChapter;
cdecl; external av__format;
{$IFEND}
@@ -1287,7 +1382,7 @@ function av_interleave_packet_per_dts(s: PAVFormatContext; _out: PAVPacket;
function av_write_trailer(s: pAVFormatContext): cint;
cdecl; external av__format;
-procedure dump_format(ic: PAVFormatContext; index: cint; url: pchar;
+procedure dump_format(ic: PAVFormatContext; index: cint; url: PAnsiChar;
is_output: cint);
cdecl; external av__format;
@@ -1296,16 +1391,18 @@ procedure dump_format(ic: PAVFormatContext; index: cint; url: pchar;
* @deprecated Use av_parse_video_frame_size instead.
*)
function parse_image_size(width_ptr: PCint; height_ptr: PCint;
- str: pchar): cint;
+ str: PAnsiChar): cint;
cdecl; external av__format; deprecated;
+{$IF LIBAVFORMAT_VERSION_MAJOR < 53}
(**
* Converts frame rate from string to a fraction.
* @deprecated Use av_parse_video_frame_rate instead.
*)
function parse_frame_rate(frame_rate: PCint; frame_rate_base: PCint;
- arg: pchar): cint;
+ arg: PByteArray): cint;
cdecl; external av__format; deprecated;
+{$IFEND}
(**
* Parses \p datestr and returns a corresponding number of microseconds.
@@ -1333,7 +1430,7 @@ function parse_frame_rate(frame_rate: PCint; frame_rate_base: PCint;
* not zero \p datestr is interpreted as a duration, otherwise as a
* date.
*)
-function parse_date(datestr: pchar; duration: cint): cint64;
+function parse_date(datestr: PAnsiChar; duration: cint): cint64;
cdecl; external av__format;
(** Gets the current time in microseconds. *)
@@ -1359,7 +1456,7 @@ procedure ffm_set_write_index(s: PAVFormatContext; pos: cint64; file_size: cint6
* syntax: '?tag1=val1&tag2=val2...'. Little URL decoding is done.
* Return 1 if found.
*)
-function find_info_tag(arg: pchar; arg_size: cint; tag1: pchar; info: pchar): cint;
+function find_info_tag(arg: PAnsiChar; arg_size: cint; tag1: PAnsiChar; info: PAnsiChar): cint;
cdecl; external av__format;
(**
@@ -1374,8 +1471,8 @@ function find_info_tag(arg: pchar; arg_size: cint; tag1: pchar; info: pchar): ci
* @param number frame number
* @return 0 if OK, -1 on format error
*)
-function av_get_frame_filename(buf: pchar; buf_size: cint;
- path: pchar; number: cint): cint;
+function av_get_frame_filename(buf: PAnsiChar; buf_size: cint;
+ path: PAnsiChar; number: cint): cint;
cdecl; external av__format
{$IF LIBAVFORMAT_VERSION <= 50006000} // 50.6.0
name 'get_frame_filename'
@@ -1387,7 +1484,7 @@ function av_get_frame_filename(buf: pchar; buf_size: cint;
* @param filename possible numbered sequence string
* @return 1 if a valid numbered sequence string, 0 otherwise
*)
-function av_filename_number_test(filename: pchar): cint;
+function av_filename_number_test(filename: PAnsiChar): cint;
cdecl; external av__format
{$IF LIBAVFORMAT_VERSION <= 50006000} // 50.6.0
name 'filename_number_test'
@@ -1408,7 +1505,7 @@ function av_filename_number_test(filename: pchar): cint;
* @param size the size of the buffer
* @return 0 if OK, AVERROR_xxx on error
*)
-function avf_sdp_create(ac: PPAVFormatContext; n_files: cint; buff: PChar; size: cint): cint;
+function avf_sdp_create(ac: PPAVFormatContext; n_files: cint; buff: PByteArray; size: cint): cint;
cdecl; external av__format;
{$IFEND}
diff --git a/unicode/src/lib/ffmpeg/avio.pas b/unicode/src/lib/ffmpeg/avio.pas
index 5107a9fb..33778206 100644
--- a/unicode/src/lib/ffmpeg/avio.pas
+++ b/unicode/src/lib/ffmpeg/avio.pas
@@ -27,7 +27,7 @@
(*
* Conversion of libavformat/avio.h
- * revision 15120, Sun Aug 31 07:39:47 2008 UTC
+ * revision 16100, Sat Dec 13 13:39:13 2008 UTC
*)
unit avio;
@@ -48,13 +48,9 @@ uses
ctypes,
avutil,
avcodec,
+ SysUtils,
UConfig;
-(* output byte stream handling *)
-
-type
- TOffset = cint64;
-
(* unbuffered I/O *)
const
@@ -92,7 +88,7 @@ type
is_streamed: cint; (**< true if streamed (no seek possible), default = false *)
max_packet_size: cint; (**< if non zero, the stream is packetized with this max packet size *)
priv_data: pointer;
- filename: PChar; (**< specified filename *)
+ filename: PAnsiChar; (**< specified filename *)
end;
PPURLContext = ^PURLContext;
@@ -104,11 +100,11 @@ type
end;
TURLProtocol = record
- name: PChar;
- url_open: function (h: PURLContext; filename: {const} PChar; flags: cint): cint; cdecl;
- url_read: function (h: PURLContext; buf: PChar; size: cint): cint; cdecl;
- url_write: function (h: PURLContext; buf: PChar; size: cint): cint; cdecl;
- url_seek: function (h: PURLContext; pos: TOffset; whence: cint): TOffset; cdecl;
+ name: PAnsiChar;
+ url_open: function (h: PURLContext; filename: {const} PAnsiChar; flags: cint): cint; cdecl;
+ url_read: function (h: PURLContext; buf: PByteArray; size: cint): cint; cdecl;
+ url_write: function (h: PURLContext; buf: PByteArray; size: cint): cint; cdecl;
+ url_seek: function (h: PURLContext; pos: cint64; whence: cint): cint64; cdecl;
url_close: function (h: PURLContext): cint; cdecl;
next: PURLProtocol;
{$IF (LIBAVFORMAT_VERSION >= 52001000) and (LIBAVFORMAT_VERSION < 52004000)} // 52.1.0 .. 52.4.0
@@ -119,8 +115,8 @@ type
url_read_pause: function (h: PURLContext; pause: cint): cint; cdecl;
{$IFEND}
{$IF LIBAVFORMAT_VERSION >= 52001000} // 52.1.0
- url_read_seek: function (h: PURLContext;
- stream_index: cint; timestamp: cint64; flags: cint): TOffset; cdecl;
+ url_read_seek: function (h: PURLContext; stream_index: cint;
+ timestamp: cint64; flags: cint): cint64; cdecl;
{$IFEND}
end;
@@ -133,23 +129,23 @@ type
*)
PByteIOContext = ^TByteIOContext;
TByteIOContext = record
- buffer: PChar;
+ buffer: PByteArray;
buffer_size: cint;
- buf_ptr: PChar;
- buf_end: PChar;
+ buf_ptr: PByteArray;
+ buf_end: PByteArray;
opaque: pointer;
- read_packet: function (opaque: pointer; buf: PChar; buf_size: cint): cint; cdecl;
- write_packet: function (opaque: pointer; buf: PChar; buf_size: cint): cint; cdecl;
- seek: function (opaque: pointer; offset: TOffset; whence: cint): TOffset; cdecl;
- pos: TOffset; (* position in the file of the current buffer *)
+ read_packet: function (opaque: pointer; buf: PByteArray; buf_size: cint): cint; cdecl;
+ write_packet: function (opaque: pointer; buf: PByteArray; buf_size: cint): cint; cdecl;
+ seek: function (opaque: pointer; offset: cint64; whence: cint): cint64; cdecl;
+ pos: cint64; (* position in the file of the current buffer *)
must_flush: cint; (* true if the next seek should flush *)
eof_reached: cint; (* true if eof reached *)
write_flag: cint; (* true if open for writing *)
is_streamed: cint;
max_packet_size: cint;
checksum: culong;
- checksum_ptr: PCuchar;
- update_checksum: function (checksum: culong; buf: {const} PChar; size: cuint): culong; cdecl;
+ checksum_ptr: PByteArray;
+ update_checksum: function (checksum: culong; buf: {const} PByteArray; size: cuint): culong; cdecl;
error: cint; ///< contains the error code or 0 if no error happened
{$IF (LIBAVFORMAT_VERSION >= 52001000) and (LIBAVFORMAT_VERSION < 52004000)} // 52.1.0 .. 52.4.0
read_play: function(opaque: Pointer): cint; cdecl;
@@ -159,30 +155,30 @@ type
read_pause: function(opaque: Pointer; pause: cint): cint; cdecl;
{$IFEND}
{$IF LIBAVFORMAT_VERSION >= 52001000} // 52.1.0
- read_seek: function(opaque: Pointer;
- stream_index: cint; timestamp: cint64; flags: cint): TOffset; cdecl;
+ read_seek: function(opaque: Pointer; stream_index: cint;
+ timestamp: cint64; flags: cint): cint64; cdecl;
{$IFEND}
end;
{$IF LIBAVFORMAT_VERSION >= 52021000} // 52.21.0
function url_open_protocol(puc: PPURLContext; up: PURLProtocol;
- filename: {const} PChar; flags: cint): cint;
+ filename: {const} PAnsiChar; flags: cint): cint;
cdecl; external av__format;
{$IFEND}
-function url_open(h: PPointer; filename: {const} PChar; flags: cint): cint;
+function url_open(h: PPointer; filename: {const} PAnsiChar; flags: cint): cint;
cdecl; external av__format;
-function url_read (h: PURLContext; buf: PChar; size: cint): cint;
+function url_read (h: PURLContext; buf: PByteArray; size: cint): cint;
cdecl; external av__format;
-function url_write (h: PURLContext; buf: PChar; size: cint): cint;
+function url_write (h: PURLContext; buf: PByteArray; size: cint): cint;
cdecl; external av__format;
-function url_seek (h: PURLContext; pos: TOffset; whence: cint): TOffset;
+function url_seek (h: PURLContext; pos: cint64; whence: cint): cint64;
cdecl; external av__format;
function url_close (h: PURLContext): cint;
cdecl; external av__format;
-function url_exist(filename: {const} PChar): cint;
+function url_exist(filename: {const} PAnsiChar): cint;
cdecl; external av__format;
-function url_filesize (h: PURLContext): TOffset;
+function url_filesize (h: PURLContext): cint64;
cdecl; external av__format;
(**
@@ -195,7 +191,7 @@ function url_filesize (h: PURLContext): TOffset;
*)
function url_get_max_packet_size(h: PURLContext): cint;
cdecl; external av__format;
-procedure url_get_filename(h: PURLContext; buf: PChar; buf_size: cint);
+procedure url_get_filename(h: PURLContext; buf: PAnsiChar; buf_size: cint);
cdecl; external av__format;
(**
@@ -239,8 +235,8 @@ function av_url_read_pause(h: PURLContext; pause: cint): cint;
* @return >= 0 on success
* @see AVInputFormat::read_seek
*)
-function av_url_read_seek(h: PURLContext;
- stream_index: cint; timestamp: cint64; flags: cint): TOffset;
+function av_url_read_seek(h: PURLContext; stream_index: cint;
+ timestamp: cint64; flags: cint): cint64;
cdecl; external av__format;
{$IFEND}
@@ -259,11 +255,11 @@ function register_protocol (protocol: PURLProtocol): cint;
cdecl; external av__format;
type
- TReadWriteFunc = function (opaque: Pointer; buf: PChar; buf_size: cint): cint; cdecl;
- TSeekFunc = function (opaque: Pointer; offset: TOffset; whence: cint): TOffset; cdecl;
+ TReadWriteFunc = function (opaque: Pointer; buf: PByteArray; buf_size: cint): cint; cdecl;
+ TSeekFunc = function (opaque: Pointer; offset: cint64; whence: cint): cint64; cdecl;
function init_put_byte(s: PByteIOContext;
- buffer: PChar;
+ buffer: PByteArray;
buffer_size: cint; write_flag: cint;
opaque: pointer;
read_packet: TReadWriteFunc;
@@ -272,7 +268,7 @@ function init_put_byte(s: PByteIOContext;
cdecl; external av__format;
{$IF LIBAVFORMAT_VERSION >= 52004000} // 52.4.0
function av_alloc_put_byte(
- buffer: PChar;
+ buffer: PByteArray;
buffer_size: cint;
write_flag: cint;
opaque: Pointer;
@@ -284,7 +280,7 @@ function av_alloc_put_byte(
procedure put_byte(s: PByteIOContext; b: cint);
cdecl; external av__format;
-procedure put_buffer (s: PByteIOContext; buf: {const} PChar; size: cint);
+procedure put_buffer (s: PByteIOContext; buf: {const} PByteArray; size: cint);
cdecl; external av__format;
procedure put_le64(s: PByteIOContext; val: cuint64);
cdecl; external av__format;
@@ -302,38 +298,38 @@ procedure put_le16(s: PByteIOContext; val: cuint);
cdecl; external av__format;
procedure put_be16(s: PByteIOContext; val: cuint);
cdecl; external av__format;
-procedure put_tag(s: PByteIOContext; tag: {const} PChar);
+procedure put_tag(s: PByteIOContext; tag: {const} PAnsiChar);
cdecl; external av__format;
-procedure put_strz(s: PByteIOContext; buf: {const} PChar);
+procedure put_strz(s: PByteIOContext; buf: {const} PAnsiChar);
cdecl; external av__format;
(**
* fseek() equivalent for ByteIOContext.
* @return new position or AVERROR.
*)
-function url_fseek(s: PByteIOContext; offset: TOffset; whence: cint): TOffset;
+function url_fseek(s: PByteIOContext; offset: cint64; whence: cint): cint64;
cdecl; external av__format;
(**
* Skip given number of bytes forward.
* @param offset number of bytes
*)
-procedure url_fskip(s: PByteIOContext; offset: TOffset);
+procedure url_fskip(s: PByteIOContext; offset: cint64);
cdecl; external av__format;
(**
* ftell() equivalent for ByteIOContext.
* @return position or AVERROR.
*)
-function url_ftell(s: PByteIOContext): TOffset;
+function url_ftell(s: PByteIOContext): cint64;
cdecl; external av__format;
(**
* Gets the filesize.
* @return filesize or AVERROR
*)
-function url_fsize(s: PByteIOContext): TOffset;
+function url_fsize(s: PByteIOContext): cint64;
cdecl; external av__format;
(**
@@ -351,8 +347,8 @@ function av_url_read_fpause(h: PByteIOContext; pause: cint): cint;
cdecl; external av__format;
{$IFEND}
{$IF LIBAVFORMAT_VERSION >= 52001000} // 52.1.0
-function av_url_read_fseek(h: PByteIOContext;
- stream_index: cint; timestamp: cint64; flags: cint): TOffset;
+function av_url_read_fseek(h: PByteIOContext; stream_index: cint;
+ timestamp: cint64; flags: cint): cint64;
cdecl; external av__format;
{$IFEND}
@@ -363,12 +359,12 @@ function url_fgetc(s: PByteIOContext): cint;
cdecl; external av__format;
(** @warning currently size is limited *)
-function url_fprintf(s: PByteIOContext; fmt: {const} PChar; args: array of const): cint;
+function url_fprintf(s: PByteIOContext; fmt: {const} PAnsiChar; args: array of const): cint;
cdecl; external av__format;
(** @note unlike fgets, the EOL character is not returned and a whole
line is parsed. return NULL if first char read was EOF *)
-function url_fgets(s: PByteIOContext; buf: PChar; buf_size: cint): PChar;
+function url_fgets(s: PByteIOContext; buf: PAnsiChar; buf_size: cint): PAnsiChar;
cdecl; external av__format;
procedure put_flush_packet (s: PByteIOContext);
@@ -379,7 +375,7 @@ procedure put_flush_packet (s: PByteIOContext);
* Reads size bytes from ByteIOContext into buf.
* @returns number of bytes read or AVERROR
*)
-function get_buffer(s: PByteIOContext; buf: PChar; size: cint): cint;
+function get_buffer(s: PByteIOContext; buf: PByteArray; size: cint): cint;
cdecl; external av__format;
(**
@@ -388,7 +384,7 @@ function get_buffer(s: PByteIOContext; buf: PChar; size: cint): cint;
* returned.
* @returns number of bytes read or AVERROR
*)
-function get_partial_buffer(s: PByteIOContext; buf: PChar; size: cint): cint;
+function get_partial_buffer(s: PByteIOContext; buf: PByteArray; size: cint): cint;
cdecl; external av__format;
(** @note return 0 if EOF, so you cannot use it if EOF handling is
@@ -404,7 +400,7 @@ function get_le64(s: PByteIOContext): cuint64;
function get_le16(s: PByteIOContext): cuint;
cdecl; external av__format;
-function get_strz(s: PByteIOContext; buf: PChar; maxlen: cint): PChar;
+function get_strz(s: PByteIOContext; buf: PAnsiChar; maxlen: cint): PAnsiChar;
cdecl; external av__format;
function get_be16(s: PByteIOContext): cuint;
cdecl; external av__format;
@@ -447,9 +443,9 @@ function url_resetbuf(s: PByteIOContext; flags: cint): cint;
(** @note when opened as read/write, the buffers are only used for
writing *)
{$IF LIBAVFORMAT_VERSION >= 52000000} // 52.0.0
-function url_fopen(var s: PByteIOContext; filename: {const} PChar; flags: cint): cint;
+function url_fopen(var s: PByteIOContext; filename: {const} PAnsiChar; flags: cint): cint;
{$ELSE}
-function url_fopen(s: PByteIOContext; filename: {const} PChar; flags: cint): cint;
+function url_fopen(s: PByteIOContext; filename: {const} PAnsiChar; flags: cint): cint;
{$IFEND}
cdecl; external av__format;
function url_fclose(s: PByteIOContext): cint;
@@ -469,9 +465,9 @@ function url_fget_max_packet_size (s: PByteIOContext): cint;
cdecl; external av__format;
{$IF LIBAVFORMAT_VERSION >= 52000000} // 52.0.0
-function url_open_buf(var s: PByteIOContext; buf: PChar; buf_size: cint; flags: cint): cint;
+function url_open_buf(var s: PByteIOContext; buf: PAnsiChar; buf_size: cint; flags: cint): cint;
{$ELSE}
-function url_open_buf(s: PByteIOContext; buf: PChar; buf_size: cint; flags: cint): cint;
+function url_open_buf(s: PByteIOContext; buf: PAnsiChar; buf_size: cint; flags: cint): cint;
{$IFEND}
cdecl; external av__format;
@@ -519,16 +515,19 @@ function url_close_dyn_buf(s: PByteIOContext; pbuffer:PPointer): cint;
cdecl; external av__format;
{$IF LIBAVFORMAT_VERSION >= 51017001} // 51.17.1
-function ff_crc04C11DB7_update(checksum: culong; buf: {const} PChar; len: cuint): culong;
+function ff_crc04C11DB7_update(checksum: culong; buf: {const} PByteArray;
+ len: cuint): culong;
cdecl; external av__format;
{$IFEND}
function get_checksum(s: PByteIOContext): culong;
cdecl; external av__format;
-procedure init_checksum (s: PByteIOContext; update_checksum: pointer; checksum: culong);
+procedure init_checksum(s: PByteIOContext;
+ update_checksum: pointer;
+ checksum: culong);
cdecl; external av__format;
(* udp.c *)
-function udp_set_remote_url(h: PURLContext; uri: {const} PChar): cint;
+function udp_set_remote_url(h: PURLContext; uri: {const} PAnsiChar): cint;
cdecl; external av__format;
function udp_get_local_port(h: PURLContext): cint;
cdecl; external av__format;
diff --git a/unicode/src/lib/ffmpeg/avutil.pas b/unicode/src/lib/ffmpeg/avutil.pas
index b4fae422..6de35f1b 100644
--- a/unicode/src/lib/ffmpeg/avutil.pas
+++ b/unicode/src/lib/ffmpeg/avutil.pas
@@ -29,13 +29,13 @@
*
* libavutil/avutil.h:
* Min. version: 49.0.1, revision 6577, Sat Oct 7 15:30:46 2006 UTC
- * Max. version: 49.11.0, revision 15415, Thu Sep 25 19:23:13 2008 UTC
+ * Max. version: 49.14.0, revision 16912, Sun Feb 1 02:00:19 2009 UTC
*
* libavutil/mem.h:
- * revision 15120, Sun Aug 31 07:39:47 2008 UTC
+ * revision 16590, Tue Jan 13 23:44:16 2009 UTC
*
* libavutil/log.h:
- * revision 15120, Sun Aug 31 07:39:47 2008 UTC
+ * revision 16571, Tue Jan 13 00:14:43 2009 UTC
*)
unit avutil;
@@ -63,7 +63,7 @@ uses
const
(* Max. supported version by this header *)
LIBAVUTIL_MAX_VERSION_MAJOR = 49;
- LIBAVUTIL_MAX_VERSION_MINOR = 11;
+ LIBAVUTIL_MAX_VERSION_MINOR = 14;
LIBAVUTIL_MAX_VERSION_RELEASE = 0;
LIBAVUTIL_MAX_VERSION = (LIBAVUTIL_MAX_VERSION_MAJOR * VERSION_MAJOR) +
(LIBAVUTIL_MAX_VERSION_MINOR * VERSION_MINOR) +
@@ -98,15 +98,15 @@ type
(**
* Pixel format. Notes:
*
- * PIX_FMT_RGB32 is handled in an endian-specific manner. A RGBA
+ * PIX_FMT_RGB32 is handled in an endian-specific manner. An RGBA
* color is put together as:
* (A << 24) | (R << 16) | (G << 8) | B
- * This is stored as BGRA on little endian CPU architectures and ARGB on
- * big endian CPUs.
+ * This is stored as BGRA on little-endian CPU architectures and ARGB on
+ * big-endian CPUs.
*
* When the pixel format is palettized RGB (PIX_FMT_PAL8), the palettized
* image data is stored in AVFrame.data[0]. The palette is transported in
- * AVFrame.data[1] and, is 1024 bytes long (256 4-byte entries) and is
+ * AVFrame.data[1], is 1024 bytes long (256 4-byte entries) and is
* formatted the same as in PIX_FMT_RGB32 described above (i.e., it is
* also endian-specific). Note also that the individual RGB palette
* components stored in AVFrame.data[1] should be in the range 0..255.
@@ -117,48 +117,53 @@ type
PAVPixelFormat = ^TAVPixelFormat;
TAVPixelFormat = (
PIX_FMT_NONE= -1,
- PIX_FMT_YUV420P, ///< Planar YUV 4:2:0, 12bpp, (1 Cr & Cb sample per 2x2 Y samples)
- PIX_FMT_YUYV422, ///< Packed YUV 4:2:2, 16bpp, Y0 Cb Y1 Cr
- PIX_FMT_RGB24, ///< Packed RGB 8:8:8, 24bpp, RGBRGB...
- PIX_FMT_BGR24, ///< Packed RGB 8:8:8, 24bpp, BGRBGR...
- PIX_FMT_YUV422P, ///< Planar YUV 4:2:2, 16bpp, (1 Cr & Cb sample per 2x1 Y samples)
- PIX_FMT_YUV444P, ///< Planar YUV 4:4:4, 24bpp, (1 Cr & Cb sample per 1x1 Y samples)
- PIX_FMT_RGB32, ///< Packed RGB 8:8:8, 32bpp, (msb)8A 8R 8G 8B(lsb), in cpu endianness
- PIX_FMT_YUV410P, ///< Planar YUV 4:1:0, 9bpp, (1 Cr & Cb sample per 4x4 Y samples)
- PIX_FMT_YUV411P, ///< Planar YUV 4:1:1, 12bpp, (1 Cr & Cb sample per 4x1 Y samples)
- PIX_FMT_RGB565, ///< Packed RGB 5:6:5, 16bpp, (msb) 5R 6G 5B(lsb), in cpu endianness
- PIX_FMT_RGB555, ///< Packed RGB 5:5:5, 16bpp, (msb)1A 5R 5G 5B(lsb), in cpu endianness most significant bit to 1
+ PIX_FMT_YUV420P, ///< planar YUV 4:2:0, 12bpp, (1 Cr & Cb sample per 2x2 Y samples)
+ PIX_FMT_YUYV422, ///< packed YUV 4:2:2, 16bpp, Y0 Cb Y1 Cr
+ PIX_FMT_RGB24, ///< packed RGB 8:8:8, 24bpp, RGBRGB...
+ PIX_FMT_BGR24, ///< packed RGB 8:8:8, 24bpp, BGRBGR...
+ PIX_FMT_YUV422P, ///< planar YUV 4:2:2, 16bpp, (1 Cr & Cb sample per 2x1 Y samples)
+ PIX_FMT_YUV444P, ///< planar YUV 4:4:4, 24bpp, (1 Cr & Cb sample per 1x1 Y samples)
+ PIX_FMT_RGB32, ///< packed RGB 8:8:8, 32bpp, (msb)8A 8R 8G 8B(lsb), in CPU endianness
+ PIX_FMT_YUV410P, ///< planar YUV 4:1:0, 9bpp, (1 Cr & Cb sample per 4x4 Y samples)
+ PIX_FMT_YUV411P, ///< planar YUV 4:1:1, 12bpp, (1 Cr & Cb sample per 4x1 Y samples)
+ PIX_FMT_RGB565, ///< packed RGB 5:6:5, 16bpp, (msb) 5R 6G 5B(lsb), in CPU endianness
+ PIX_FMT_RGB555, ///< packed RGB 5:5:5, 16bpp, (msb)1A 5R 5G 5B(lsb), in CPU endianness, most significant bit to 0
PIX_FMT_GRAY8, ///< Y , 8bpp
PIX_FMT_MONOWHITE, ///< Y , 1bpp, 0 is white, 1 is black
PIX_FMT_MONOBLACK, ///< Y , 1bpp, 0 is black, 1 is white
PIX_FMT_PAL8, ///< 8 bit with PIX_FMT_RGB32 palette
- PIX_FMT_YUVJ420P, ///< Planar YUV 4:2:0, 12bpp, full scale (jpeg)
- PIX_FMT_YUVJ422P, ///< Planar YUV 4:2:2, 16bpp, full scale (jpeg)
- PIX_FMT_YUVJ444P, ///< Planar YUV 4:4:4, 24bpp, full scale (jpeg)
+ PIX_FMT_YUVJ420P, ///< planar YUV 4:2:0, 12bpp, full scale (JPEG)
+ PIX_FMT_YUVJ422P, ///< planar YUV 4:2:2, 16bpp, full scale (JPEG)
+ PIX_FMT_YUVJ444P, ///< planar YUV 4:4:4, 24bpp, full scale (JPEG)
PIX_FMT_XVMC_MPEG2_MC,///< XVideo Motion Acceleration via common packet passing(xvmc_render.h)
PIX_FMT_XVMC_MPEG2_IDCT,
- PIX_FMT_UYVY422, ///< Packed YUV 4:2:2, 16bpp, Cb Y0 Cr Y1
- PIX_FMT_UYYVYY411, ///< Packed YUV 4:1:1, 12bpp, Cb Y0 Y1 Cr Y2 Y3
- PIX_FMT_BGR32, ///< Packed RGB 8:8:8, 32bpp, (msb)8A 8B 8G 8R(lsb), in cpu endianness
- PIX_FMT_BGR565, ///< Packed RGB 5:6:5, 16bpp, (msb) 5B 6G 5R(lsb), in cpu endianness
- PIX_FMT_BGR555, ///< Packed RGB 5:5:5, 16bpp, (msb)1A 5B 5G 5R(lsb), in cpu endianness most significant bit to 1
- PIX_FMT_BGR8, ///< Packed RGB 3:3:2, 8bpp, (msb)2B 3G 3R(lsb)
- PIX_FMT_BGR4, ///< Packed RGB 1:2:1, 4bpp, (msb)1B 2G 1R(lsb)
- PIX_FMT_BGR4_BYTE, ///< Packed RGB 1:2:1, 8bpp, (msb)1B 2G 1R(lsb)
- PIX_FMT_RGB8, ///< Packed RGB 3:3:2, 8bpp, (msb)2R 3G 3B(lsb)
- PIX_FMT_RGB4, ///< Packed RGB 1:2:1, 4bpp, (msb)1R 2G 1B(lsb)
- PIX_FMT_RGB4_BYTE, ///< Packed RGB 1:2:1, 8bpp, (msb)1R 2G 1B(lsb)
- PIX_FMT_NV12, ///< Planar YUV 4:2:0, 12bpp, 1 plane for Y and 1 for UV
+ PIX_FMT_UYVY422, ///< packed YUV 4:2:2, 16bpp, Cb Y0 Cr Y1
+ PIX_FMT_UYYVYY411, ///< packed YUV 4:1:1, 12bpp, Cb Y0 Y1 Cr Y2 Y3
+ PIX_FMT_BGR32, ///< packed RGB 8:8:8, 32bpp, (msb)8A 8B 8G 8R(lsb), in CPU endianness
+ PIX_FMT_BGR565, ///< packed RGB 5:6:5, 16bpp, (msb) 5B 6G 5R(lsb), in CPU endianness
+ PIX_FMT_BGR555, ///< packed RGB 5:5:5, 16bpp, (msb)1A 5B 5G 5R(lsb), in CPU endianness, most significant bit to 1
+ PIX_FMT_BGR8, ///< packed RGB 3:3:2, 8bpp, (msb)2B 3G 3R(lsb)
+ PIX_FMT_BGR4, ///< packed RGB 1:2:1, 4bpp, (msb)1B 2G 1R(lsb)
+ PIX_FMT_BGR4_BYTE, ///< packed RGB 1:2:1, 8bpp, (msb)1B 2G 1R(lsb)
+ PIX_FMT_RGB8, ///< packed RGB 3:3:2, 8bpp, (msb)2R 3G 3B(lsb)
+ PIX_FMT_RGB4, ///< packed RGB 1:2:1, 4bpp, (msb)1R 2G 1B(lsb)
+ PIX_FMT_RGB4_BYTE, ///< packed RGB 1:2:1, 8bpp, (msb)1R 2G 1B(lsb)
+ PIX_FMT_NV12, ///< planar YUV 4:2:0, 12bpp, 1 plane for Y and 1 for UV
PIX_FMT_NV21, ///< as above, but U and V bytes are swapped
- PIX_FMT_RGB32_1, ///< Packed RGB 8:8:8, 32bpp, (msb)8R 8G 8B 8A(lsb), in cpu endianness
- PIX_FMT_BGR32_1, ///< Packed RGB 8:8:8, 32bpp, (msb)8B 8G 8R 8A(lsb), in cpu endianness
+ PIX_FMT_RGB32_1, ///< packed RGB 8:8:8, 32bpp, (msb)8R 8G 8B 8A(lsb), in CPU endianness
+ PIX_FMT_BGR32_1, ///< packed RGB 8:8:8, 32bpp, (msb)8B 8G 8R 8A(lsb), in CPU endianness
PIX_FMT_GRAY16BE, ///< Y , 16bpp, big-endian
PIX_FMT_GRAY16LE, ///< Y , 16bpp, little-endian
- PIX_FMT_YUV440P, ///< Planar YUV 4:4:0 (1 Cr & Cb sample per 1x2 Y samples)
- PIX_FMT_YUVJ440P, ///< Planar YUV 4:4:0 full scale (jpeg)
- PIX_FMT_YUVA420P, ///< Planar YUV 4:2:0, 20bpp, (1 Cr & Cb sample per 2x2 Y & A samples)
+ PIX_FMT_YUV440P, ///< planar YUV 4:4:0 (1 Cr & Cb sample per 1x2 Y samples)
+ PIX_FMT_YUVJ440P, ///< planar YUV 4:4:0 full scale (JPEG)
+ PIX_FMT_YUVA420P, ///< planar YUV 4:2:0, 20bpp, (1 Cr & Cb sample per 2x2 Y & A samples)
+ PIX_FMT_VDPAU_H264,///< H.264 HW decoding with VDPAU, data[0] contains a vdpau_render_state struct which contains the bitstream of the slices as well as various fields extracted from headers
+ PIX_FMT_VDPAU_MPEG1,///< MPEG-1 HW decoding with VDPAU, data[0] contains a vdpau_render_state struct which contains the bitstream of the slices as well as various fields extracted from headers
+ PIX_FMT_VDPAU_MPEG2,///< MPEG-2 HW decoding with VDPAU, data[0] contains a vdpau_render_state struct which contains the bitstream of the slices as well as various fields extracted from headers
+ PIX_FMT_VDPAU_WMV3,///< WMV3 HW decoding with VDPAU, data[0] contains a vdpau_render_state struct which contains the bitstream of the slices as well as various fields extracted from headers
+ PIX_FMT_VDPAU_VC1, ///< VC-1 HW decoding with VDPAU, data[0] contains a vdpau_render_state struct which contains the bitstream of the slices as well as various fields extracted from headers
PIX_FMT_NB ///< number of pixel formats, DO NOT USE THIS if you want to link with shared libav* because the number of formats might differ between versions
);
@@ -185,7 +190,7 @@ const
(* common.h *)
-function MKTAG(a,b,c,d: char): integer;
+function MKTAG(a,b,c,d: AnsiChar): integer;
(* mem.h *)
@@ -244,7 +249,7 @@ function av_mallocz(size: cuint): pointer;
* @return Pointer to a newly allocated string containing a
* copy of \p s or NULL if it cannot be allocated.
*)
-function av_strdup({const} s: PChar): PChar;
+function av_strdup({const} s: PAnsiChar): PAnsiChar;
cdecl; external av__util; {av_malloc_attrib}
(**
@@ -312,7 +317,7 @@ procedure av_log_set_level(level: cint);
implementation
-function MKTAG(a,b,c,d: char): integer;
+function MKTAG(a,b,c,d: AnsiChar): integer;
begin
Result := (ord(a) or (ord(b) shl 8) or (ord(c) shl 16) or (ord(d) shl 24));
end;
diff --git a/unicode/src/lib/ffmpeg/mathematics.pas b/unicode/src/lib/ffmpeg/mathematics.pas
index 606d9189..fb57ccea 100644
--- a/unicode/src/lib/ffmpeg/mathematics.pas
+++ b/unicode/src/lib/ffmpeg/mathematics.pas
@@ -26,7 +26,7 @@
(*
* Conversion of libavutil/mathematics.h
- * revision 15120, Sun Aug 31 07:39:47 2008 UTC
+ * revision 16844, Wed Jan 28 08:50:10 2009 UTC
*)
unit mathematics;
@@ -55,29 +55,34 @@ const
type
TAVRounding = (
- AV_ROUND_ZERO = 0, ///< round toward zero
- AV_ROUND_INF = 1, ///< round away from zero
- AV_ROUND_DOWN = 2, ///< round toward -infinity
- AV_ROUND_UP = 3, ///< round toward +infinity
- AV_ROUND_NEAR_INF = 5 ///< round to nearest and halfway cases away from zero
+ AV_ROUND_ZERO = 0, ///< Round toward zero
+ AV_ROUND_INF = 1, ///< Round away from zero
+ AV_ROUND_DOWN = 2, ///< Round toward -infinity
+ AV_ROUND_UP = 3, ///< Round toward +infinity
+ AV_ROUND_NEAR_INF = 5 ///< Round to nearest and halfway cases away from zero
);
+{$IF LIBAVUTIL_VERSION >= 49013000} // 49.13.0
+function av_gcd(a: cint64; b: cint64): cint64;
+ cdecl; external av__util; {av_const}
+{$IFEND}
+
(**
- * rescale a 64bit integer with rounding to nearest.
- * a simple a*b/c isn't possible as it can overflow
+ * Rescales a 64-bit integer with rounding to nearest.
+ * A simple a*b/c isn't possible as it can overflow.
*)
function av_rescale (a, b, c: cint64): cint64;
cdecl; external av__util; {av_const}
(**
- * rescale a 64bit integer with specified rounding.
- * a simple a*b/c isn't possible as it can overflow
+ * Rescales a 64-bit integer with specified rounding.
+ * A simple a*b/c isn't possible as it can overflow.
*)
function av_rescale_rnd (a, b, c: cint64; enum: TAVRounding): cint64;
cdecl; external av__util; {av_const}
(**
- * rescale a 64bit integer by 2 rational numbers.
+ * Rescales a 64-bit integer by 2 rational numbers.
*)
function av_rescale_q (a: cint64; bq, cq: TAVRational): cint64;
cdecl; external av__util; {av_const}
diff --git a/unicode/src/lib/ffmpeg/opt.pas b/unicode/src/lib/ffmpeg/opt.pas
index e734aa9f..833dc247 100644
--- a/unicode/src/lib/ffmpeg/opt.pas
+++ b/unicode/src/lib/ffmpeg/opt.pas
@@ -27,7 +27,7 @@
(*
* Conversion of libavcodec/opt.h
- * revision 15120, Sun Aug 31 07:39:47 2008 UTC
+ * revision 16912, Sun Feb 1 02:00:19 2009 UTC
*)
unit opt;
@@ -74,13 +74,13 @@ type
*)
PAVOption = ^TAVOption;
TAVOption = record
- name: {const} PChar;
+ name: {const} PAnsiChar;
(**
* short English help text
* @todo What about other languages?
*)
- help: {const} PChar;
+ help: {const} PAnsiChar;
(**
* The offset relative to the context structure where the option
@@ -104,7 +104,7 @@ type
* options and corresponding named constants share the same
* unit. May be NULL.
*)
- unit_: {const} PChar;
+ unit_: {const} PAnsiChar;
end;
{$IF LIBAVCODEC_VERSION >= 51039000} // 51.39.0
@@ -114,24 +114,39 @@ type
* for which it is the case that opt->flags & mask == flags).
*
* @param[in] obj a pointer to a struct whose first element is a
- * pointer to an #AVClass
+ * pointer to an AVClass
* @param[in] name the name of the option to look for
* @param[in] unit the unit of the option to look for, or any if NULL
* @return a pointer to the option found, or NULL if no option
* has been found
*)
-function av_find_opt(obj: Pointer; {const} name: {const} PChar; {const} unit_: PChar; mask: cint; flags: cint): {const} PAVOption;
+function av_find_opt(obj: Pointer; {const} name: {const} PAnsiChar; {const} unit_: PAnsiChar; mask: cint; flags: cint): {const} PAVOption;
cdecl; external av__codec;
{$IFEND}
+{$IF LIBAVCODEC_VERSION_MAJOR < 53}
+
(**
* @see av_set_string2()
*)
-function av_set_string(obj: pointer; name: {const} pchar; val: {const} pchar): {const} PAVOption;
+function av_set_string(obj: pointer; name: {const} PAnsiChar; val: {const} PAnsiChar): {const} PAVOption;
cdecl; external av__codec; deprecated;
{$IF LIBAVCODEC_VERSION >= 51059000} // 51.59.0
(**
+ * @return a pointer to the AVOption corresponding to the field set or
+ * NULL if no matching AVOption exists, or if the value \p val is not
+ * valid
+ * @see av_set_string3()
+ *)
+function av_set_string2(obj: Pointer; name: {const} PAnsiChar; val: {const} PAnsiChar; alloc: cint): {const} PAVOption;
+ cdecl; external av__codec; deprecated;
+{$IFEND}
+
+{$IFEND}
+
+{$IF LIBAVCODEC_VERSION >= 52007000} // 52.7.0
+(**
* Sets the field of obj with the given name to value.
*
* @param[in] obj A struct whose first element is a pointer to an
@@ -147,36 +162,37 @@ function av_set_string(obj: pointer; name: {const} pchar; val: {const} pchar): {
* scalars or named flags separated by '+' or '-'. Prefixing a flag
* with '+' causes it to be set without affecting the other flags;
* similarly, '-' unsets a flag.
- * @return a pointer to the AVOption corresponding to the field set or
- * NULL if no matching AVOption exists, or if the value \p val is not
- * valid
+ * @param[out] o_out if non-NULL put here a pointer to the AVOption
+ * found
* @param alloc when 1 then the old value will be av_freed() and the
* new av_strduped()
* when 0 then no av_free() nor av_strdup() will be used
+ * @return 0 if the value has been set, an AVERROR* error code if no
+ * matching option exists, or if the value \p val is not valid
*)
-function av_set_string2(obj: Pointer; name: {const} PChar; val: {const} PChar; alloc: cint): {const} PAVOption;
+function av_set_string3(obj: Pointer; name: {const} PAnsiChar; val: {const} PAnsiChar; alloc: cint; out o_out: {const} PAVOption): cint;
cdecl; external av__codec;
{$IFEND}
-function av_set_double(obj: pointer; name: {const} pchar; n: cdouble): PAVOption;
+function av_set_double(obj: pointer; name: {const} PAnsiChar; n: cdouble): PAVOption;
cdecl; external av__codec;
-function av_set_q(obj: pointer; name: {const} pchar; n: TAVRational): PAVOption;
+function av_set_q(obj: pointer; name: {const} PAnsiChar; n: TAVRational): PAVOption;
cdecl; external av__codec;
-function av_set_int(obj: pointer; name: {const} pchar; n: cint64): PAVOption;
+function av_set_int(obj: pointer; name: {const} PAnsiChar; n: cint64): PAVOption;
cdecl; external av__codec;
-function av_get_double(obj: pointer; name: {const} pchar; var o_out: PAVOption): cdouble;
+function av_get_double(obj: pointer; name: {const} PAnsiChar; var o_out: PAVOption): cdouble;
cdecl; external av__codec;
-function av_get_q(obj: pointer; name: {const} pchar; var o_out: PAVOption): TAVRational;
+function av_get_q(obj: pointer; name: {const} PAnsiChar; var o_out: PAVOption): TAVRational;
cdecl; external av__codec;
-function av_get_int(obj: pointer; name: {const} pchar; var o_out: {const} PAVOption): cint64;
+function av_get_int(obj: pointer; name: {const} PAnsiChar; var o_out: {const} PAVOption): cint64;
cdecl; external av__codec;
-function av_get_string(obj: pointer; name: {const} pchar; var o_out: {const} PAVOption; buf: pchar; buf_len: cint): pchar;
+function av_get_string(obj: pointer; name: {const} PAnsiChar; var o_out: {const} PAVOption; buf: PAnsiChar; buf_len: cint): PAnsiChar;
cdecl; external av__codec;
function av_next_option(obj: pointer; last: {const} PAVOption): PAVOption;
diff --git a/unicode/src/lib/ffmpeg/rational.pas b/unicode/src/lib/ffmpeg/rational.pas
index 02d594ff..6762aa26 100644
--- a/unicode/src/lib/ffmpeg/rational.pas
+++ b/unicode/src/lib/ffmpeg/rational.pas
@@ -1,5 +1,5 @@
(*
- * Rational numbers
+ * rational numbers
* Copyright (c) 2003 Michael Niedermayer <michaelni@gmx.at>
*
* This library is free software; you can redistribute it and/or
@@ -27,7 +27,7 @@
(*
* Conversion of libavutil/rational.h
- * revision 15415, Thu Sep 25 19:23:13 2008 UTC
+ * revision 16912, Sun Feb 1 02:00:19 2009 UTC
*)
unit rational;
@@ -49,9 +49,9 @@ uses
UConfig;
type
-(*
- * Rational number num/den.
- *)
+ (*
+ * rational number numerator/denominator
+ *)
PAVRational = ^TAVRational;
TAVRational = record
num: cint; ///< numerator
@@ -62,65 +62,65 @@ type
PAVRationalArray = ^TAVRationalArray;
(**
- * Compare two rationals.
+ * Compares two rationals.
* @param a first rational
* @param b second rational
- * @return 0 if a==b, 1 if a>b and -1 if a<b.
+ * @return 0 if a==b, 1 if a>b and -1 if a<b
*)
function av_cmp_q(a: TAVRational; b: TAVRational): cint; {$IFDEF HasInline}inline;{$ENDIF}
(**
- * Rational to double conversion.
+ * Converts rational to double.
* @param a rational to convert
* @return (double) a
*)
function av_q2d(a: TAVRational): cdouble; {$IFDEF HasInline}inline;{$ENDIF}
(**
- * Reduce a fraction.
+ * Reduces a fraction.
* This is useful for framerate calculations.
- * @param dst_nom destination numerator
+ * @param dst_num destination numerator
* @param dst_den destination denominator
- * @param nom source numerator
+ * @param num source numerator
* @param den source denominator
- * @param max the maximum allowed for dst_nom & dst_den
+ * @param max the maximum allowed for dst_num & dst_den
* @return 1 if exact, 0 otherwise
*)
-function av_reduce(dst_nom: PCint; dst_den: PCint; nom: cint64; den: cint64; max: cint64): cint;
+function av_reduce(dst_num: PCint; dst_den: PCint; num: cint64; den: cint64; max: cint64): cint;
cdecl; external av__util;
(**
* Multiplies two rationals.
- * @param b first rational.
- * @param c second rational.
- * @return b*c.
+ * @param b first rational
+ * @param c second rational
+ * @return b*c
*)
function av_mul_q(b: TAVRational; c: TAVRational): TAVRational;
cdecl; external av__util; {av_const}
(**
* Divides one rational by another.
- * @param b first rational.
- * @param c second rational.
- * @return b/c.
+ * @param b first rational
+ * @param c second rational
+ * @return b/c
*)
function av_div_q(b: TAVRational; c: TAVRational): TAVRational;
cdecl; external av__util; {av_const}
(**
* Adds two rationals.
- * @param b first rational.
- * @param c second rational.
- * @return b+c.
+ * @param b first rational
+ * @param c second rational
+ * @return b+c
*)
function av_add_q(b: TAVRational; c: TAVRational): TAVRational;
cdecl; external av__util; {av_const}
(**
* Subtracts one rational from another.
- * @param b first rational.
- * @param c second rational.
- * @return b-c.
+ * @param b first rational
+ * @param c second rational
+ * @return b-c
*)
function av_sub_q(b: TAVRational; c: TAVRational): TAVRational;
cdecl; external av__util; {av_const}
@@ -129,7 +129,7 @@ function av_sub_q(b: TAVRational; c: TAVRational): TAVRational;
* Converts a double precision floating point number to a rational.
* @param d double to convert
* @param max the maximum allowed numerator and denominator
- * @return (AVRational) d.
+ * @return (AVRational) d
*)
function av_d2q(d: cdouble; max: cint): TAVRational;
cdecl; external av__util; {av_const}
diff --git a/unicode/src/lib/requirements.txt b/unicode/src/lib/requirements.txt
index ace3165a..d3955585 100644
--- a/unicode/src/lib/requirements.txt
+++ b/unicode/src/lib/requirements.txt
@@ -44,5 +44,5 @@ Install the FreePascal compiler (version 2.2.2 or later) using fink or a package
Install these libs and their dependences using fink:
- fink install pkgconfig ffmpeg libavcodec-dev libavformat-dev libavutil-dev libswscale-dev libtheora0
- fink install portaudio2 SDL SDL-image SDL-ttf libpng3 imlib2 sqlite3-dev \ No newline at end of file
+ fink install pkgconfig libavcodec-dev libavformat-dev libavutil-dev libswscale-dev
+ fink install portaudio2 SDL SDL-image libpng3 sqlite3-dev \ No newline at end of file
diff --git a/unicode/src/macosx/PseudoThread.pas b/unicode/src/macosx/PseudoThread.pas
index 5764395d..d74285f7 100644
--- a/unicode/src/macosx/PseudoThread.pas
+++ b/unicode/src/macosx/PseudoThread.pas
@@ -37,23 +37,24 @@ type
// Debugging threads with XCode doesn't seem to work.
// We use PseudoThread in Debug mode to get proper debugging.
+
TPseudoThread = class(TObject)
private
protected
Terminated,
- FreeOnTerminate : Boolean;
+ FreeOnTerminate: boolean;
procedure Execute; virtual; abstract;
procedure Resume;
procedure Suspend;
public
- constructor Create(const suspended : Boolean);
+ constructor Create(const suspended : boolean);
end;
implementation
{ TPseudoThread }
-constructor TPseudoThread.Create(const suspended : Boolean);
+constructor TPseudoThread.Create(const suspended: boolean);
begin
if not suspended then
begin
diff --git a/unicode/src/macosx/Windows.pas b/unicode/src/macosx/Windows.pas
deleted file mode 100644
index 28b5c99f..00000000
--- a/unicode/src/macosx/Windows.pas
+++ /dev/null
@@ -1,194 +0,0 @@
-{* UltraStar Deluxe - Karaoke Game
- *
- * UltraStar Deluxe is the legal property of its developers, whose names
- * are too numerous to list here. Please refer to the COPYRIGHT
- * file distributed with this source distribution.
- *
- * This program is free software; you can redistribute it and/or
- * modify it under the terms of the GNU General Public License
- * as published by the Free Software Foundation; either version 2
- * of the License, or (at your option) any later version.
- *
- * This program is distributed in the hope that it will be useful,
- * but WITHOUT ANY WARRANTY; without even the implied warranty of
- * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
- * GNU General Public License for more details.
- *
- * You should have received a copy of the GNU General Public License
- * along with this program; see the file COPYING. If not, write to
- * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
- * Boston, MA 02110-1301, USA.
- *
- * $URL$
- * $Id$
- *}
-
-unit Windows;
-
-{$I switches.inc}
-
-interface
-
-uses
- Types;
-
-const
- opengl32 = 'OpenGL';
- MAX_PATH = 260;
-
-type
-
- DWORD = Types.DWORD;
- {$EXTERNALSYM DWORD}
- BOOL = LongBool;
- {$EXTERNALSYM BOOL}
- PBOOL = ^BOOL;
- {$EXTERNALSYM PBOOL}
- PByte = Types.PByte;
- PINT = ^Integer;
- {$EXTERNALSYM PINT}
- PSingle = ^Single;
- PWORD = ^Word;
- {$EXTERNALSYM PWORD}
- PDWORD = ^DWORD;
- {$EXTERNALSYM PDWORD}
- LPDWORD = PDWORD;
- {$EXTERNALSYM LPDWORD}
- HDC = type LongWord;
- {$EXTERNALSYM HDC}
- HGLRC = type LongWord;
- {$EXTERNALSYM HGLRC}
- TLargeInteger = Int64;
- HFONT = type LongWord;
- {$EXTERNALSYM HFONT}
- HWND = type LongWord;
- {$EXTERNALSYM HWND}
-
- PPaletteEntry = ^TPaletteEntry;
- {$EXTERNALSYM tagPALETTEENTRY}
- tagPALETTEENTRY = packed record
- peRed: Byte;
- peGreen: Byte;
- peBlue: Byte;
- peFlags: Byte;
- end;
- TPaletteEntry = tagPALETTEENTRY;
- {$EXTERNALSYM PALETTEENTRY}
- PALETTEENTRY = tagPALETTEENTRY;
-
- PRGBQuad = ^TRGBQuad;
- {$EXTERNALSYM tagRGBQUAD}
- tagRGBQUAD = packed record
- rgbBlue: Byte;
- rgbGreen: Byte;
- rgbRed: Byte;
- rgbReserved: Byte;
- end;
- TRGBQuad = tagRGBQUAD;
- {$EXTERNALSYM RGBQUAD}
- RGBQUAD = tagRGBQUAD;
-
- PBitmapInfoHeader = ^TBitmapInfoHeader;
- {$EXTERNALSYM tagBITMAPINFOHEADER}
- tagBITMAPINFOHEADER = packed record
- biSize: DWORD;
- biWidth: Longint;
- biHeight: Longint;
- biPlanes: Word;
- biBitCount: Word;
- biCompression: DWORD;
- biSizeImage: DWORD;
- biXPelsPerMeter: Longint;
- biYPelsPerMeter: Longint;
- biClrUsed: DWORD;
- biClrImportant: DWORD;
- end;
- TBitmapInfoHeader = tagBITMAPINFOHEADER;
- {$EXTERNALSYM BITMAPINFOHEADER}
- BITMAPINFOHEADER = tagBITMAPINFOHEADER;
-
- PBitmapInfo = ^TBitmapInfo;
- {$EXTERNALSYM tagBITMAPINFO}
- tagBITMAPINFO = packed record
- bmiHeader: TBitmapInfoHeader;
- bmiColors: array[0..0] of TRGBQuad;
- end;
- TBitmapInfo = tagBITMAPINFO;
- {$EXTERNALSYM BITMAPINFO}
- BITMAPINFO = tagBITMAPINFO;
-
- PBitmapFileHeader = ^TBitmapFileHeader;
- {$EXTERNALSYM tagBITMAPFILEHEADER}
- tagBITMAPFILEHEADER = packed record
- bfType: Word;
- bfSize: DWORD;
- bfReserved1: Word;
- bfReserved2: Word;
- bfOffBits: DWORD;
- end;
- TBitmapFileHeader = tagBITMAPFILEHEADER;
- {$EXTERNALSYM BITMAPFILEHEADER}
- BITMAPFILEHEADER = tagBITMAPFILEHEADER;
-
-
-function MakeLong(a, b: Word): Longint;
-procedure ZeroMemory(Destination: Pointer; Length: DWORD);
-function QueryPerformanceFrequency(var lpFrequency: TLargeInteger): BOOL;
-function QueryPerformanceCounter(var lpPerformanceCount: TLargeInteger): BOOL;
-function GetTickCount : Cardinal;
-Procedure ShowMessage(msg : String);
-procedure CopyMemory(Destination: Pointer; Source: Pointer; Length: DWORD);
-
-implementation
-
-uses
- SDL;
-
-procedure CopyMemory(Destination: Pointer; Source: Pointer; Length: DWORD);
-begin
- Move(Source^, Destination^, Length);
-end;
-
-procedure ShowMessage(msg : String);
-begin
- // to be implemented
-end;
-
-function MakeLong(A, B: Word): Longint;
-begin
- Result := (LongInt(B) shl 16) + A;
-end;
-
-procedure ZeroMemory(Destination: Pointer; Length: DWORD);
-begin
- FillChar( Destination^, Length, 0);
-end;
-
-function QueryPerformanceFrequency(var lpFrequency: TLargeInteger): BOOL;
-begin
-{$IFDEF MSWINDOWS}
- Result := Windows.QueryPerformanceFrequency(lpFrequency);
-{$ENDIF}
-{$IFDEF MACOS}
- Result := true;
- lpFrequency := 1000;
-{$ENDIF}
-end;
-
-function QueryPerformanceCounter(var lpPerformanceCount: TLargeInteger): BOOL;
-begin
-{$IFDEF MSWINDOWS}
- Result := Windows.QueryPerformanceCounter(lpPerformanceCount);
-{$ENDIF}
-{$IFDEF MACOS}
- Result := true;
- lpPerformanceCount := SDL_GetTicks;
-{$ENDIF}
-end;
-
-function GetTickCount : Cardinal;
-begin
- Result := SDL_GetTicks;
-end;
-
-end.
diff --git a/unicode/src/media/UAudioConverter.pas b/unicode/src/media/UAudioConverter.pas
index 24131b16..657b80dd 100644
--- a/unicode/src/media/UAudioConverter.pas
+++ b/unicode/src/media/UAudioConverter.pas
@@ -70,7 +70,7 @@ type
function Init(SrcFormatInfo: TAudioFormatInfo; DstFormatInfo: TAudioFormatInfo): boolean; override;
destructor Destroy(); override;
- function Convert(InputBuffer: PChar; OutputBuffer: PChar; var InputSize: integer): integer; override;
+ function Convert(InputBuffer: PByteArray; OutputBuffer: PByteArray; var InputSize: integer): integer; override;
function GetOutputBufferSize(InputSize: integer): integer; override;
function GetRatio(): double; override;
end;
@@ -87,7 +87,7 @@ type
function Init(SrcFormatInfo: TAudioFormatInfo; DstFormatInfo: TAudioFormatInfo): boolean; override;
destructor Destroy(); override;
- function Convert(InputBuffer: PChar; OutputBuffer: PChar; var InputSize: integer): integer; override;
+ function Convert(InputBuffer: PByteArray; OutputBuffer: PByteArray; var InputSize: integer): integer; override;
function GetOutputBufferSize(InputSize: integer): integer; override;
function GetRatio(): double; override;
end;
@@ -103,7 +103,7 @@ type
function Init(SrcFormatInfo: TAudioFormatInfo; DstFormatInfo: TAudioFormatInfo): boolean; override;
destructor Destroy(); override;
- function Convert(InputBuffer: PChar; OutputBuffer: PChar; var InputSize: integer): integer; override;
+ function Convert(InputBuffer: PByteArray; OutputBuffer: PByteArray; var InputSize: integer): integer; override;
function GetOutputBufferSize(InputSize: integer): integer; override;
function GetRatio(): double; override;
end;
@@ -173,7 +173,7 @@ begin
Result := cvt.len_ratio;
end;
-function TAudioConverter_SDL.Convert(InputBuffer: PChar; OutputBuffer: PChar; var InputSize: integer): integer;
+function TAudioConverter_SDL.Convert(InputBuffer: PByteArray; OutputBuffer: PByteArray; var InputSize: integer): integer;
begin
Result := -1;
@@ -242,7 +242,7 @@ begin
inherited;
end;
-function TAudioConverter_FFmpeg.Convert(InputBuffer: PChar; OutputBuffer: PChar; var InputSize: integer): integer;
+function TAudioConverter_FFmpeg.Convert(InputBuffer: PByteArray; OutputBuffer: PByteArray; var InputSize: integer): integer;
var
InputSampleCount: integer;
OutputSampleCount: integer;
@@ -360,11 +360,11 @@ begin
inherited;
end;
-function TAudioConverter_SRC.Convert(InputBuffer: PChar; OutputBuffer: PChar; var InputSize: integer): integer;
+function TAudioConverter_SRC.Convert(InputBuffer: PByteArray; OutputBuffer: PByteArray; var InputSize: integer): integer;
var
FloatInputBuffer: PSingle;
FloatOutputBuffer: PSingle;
- TempBuffer: PChar;
+ TempBuffer: PByteArray;
TempSize: integer;
NumSamples: integer;
OutputSize: integer;
diff --git a/unicode/src/media/UAudioDecoder_Bass.pas b/unicode/src/media/UAudioDecoder_Bass.pas
index 3c31175d..6bbdaeaa 100644
--- a/unicode/src/media/UAudioDecoder_Bass.pas
+++ b/unicode/src/media/UAudioDecoder_Bass.pas
@@ -65,7 +65,7 @@ type
function IsEOF(): boolean; override;
function IsError(): boolean; override;
- function ReadData(Buffer: PChar; BufSize: integer): integer; override;
+ function ReadData(Buffer: PByteArray; BufSize: integer): integer; override;
end;
type
@@ -193,7 +193,7 @@ begin
Result := Error;
end;
-function TBassDecodeStream.ReadData(Buffer: PChar; BufSize: integer): integer;
+function TBassDecodeStream.ReadData(Buffer: PByteArray; BufSize: integer): integer;
begin
Result := BASS_ChannelGetData(Handle, Buffer, BufSize);
// check error state (do not handle EOF as error)
@@ -237,7 +237,7 @@ begin
// TODO: use BASS_STREAM_PRESCAN for accurate seeking in VBR-files?
// disadvantage: seeking will slow down.
- Stream := BASS_StreamCreateFile(False, PChar(Filename), 0, 0, BASS_STREAM_DECODE);
+ Stream := BASS_StreamCreateFile(False, PAnsiChar(Filename), 0, 0, BASS_STREAM_DECODE);
if (Stream = 0) then
begin
//Log.LogError(BassCore.ErrorGetString(), 'TAudioDecoder_Bass.Open');
diff --git a/unicode/src/media/UAudioDecoder_FFmpeg.pas b/unicode/src/media/UAudioDecoder_FFmpeg.pas
index 399c2f52..2d221f40 100644
--- a/unicode/src/media/UAudioDecoder_FFmpeg.pas
+++ b/unicode/src/media/UAudioDecoder_FFmpeg.pas
@@ -57,7 +57,6 @@ implementation
uses
Classes,
- SysUtils,
Math,
UMusic,
UIni,
@@ -68,8 +67,9 @@ uses
avio,
mathematics, // used for av_rescale_q
rational,
- UMediaCore_FFmpeg,
SDL,
+ SysUtils,
+ UMediaCore_FFmpeg,
ULog,
UCommon,
UConfig;
@@ -129,14 +129,14 @@ type
// state-vars for DecodeFrame (locked by DecoderLock)
AudioPaket: TAVPacket;
- AudioPaketData: PChar;
+ AudioPaketData: PByteArray;
AudioPaketSize: integer;
AudioPaketSilence: integer; // number of bytes of silence to return
// state-vars for AudioCallback (locked by DecoderLock)
AudioBufferPos: integer;
AudioBufferSize: integer;
- AudioBuffer: PChar;
+ AudioBuffer: PByteArray;
Filename: string;
@@ -153,7 +153,7 @@ type
procedure PauseParser();
procedure ResumeParser();
- function DecodeFrame(Buffer: PChar; BufferSize: integer): integer;
+ function DecodeFrame(Buffer: PByteArray; BufferSize: integer): integer;
procedure FlushCodecBuffers();
procedure PauseDecoder();
procedure ResumeDecoder();
@@ -173,11 +173,11 @@ type
function IsEOF(): boolean; override;
function IsError(): boolean; override;
- function ReadData(Buffer: PChar; BufferSize: integer): integer; override;
+ function ReadData(Buffer: PByteArray; BufferSize: integer): integer; override;
end;
type
- TAudioDecoder_FFmpeg = class( TInterfacedObject, IAudioDecoder )
+ TAudioDecoder_FFmpeg = class(TInterfacedObject, IAudioDecoder)
public
function GetName: string;
@@ -289,7 +289,7 @@ begin
Self.Filename := Filename;
// open audio file
- if (av_open_input_file(FormatCtx, PChar(Filename), nil, 0, nil) <> 0) then
+ if (av_open_input_file(FormatCtx, PAnsiChar(Filename), nil, 0, nil) <> 0) then
begin
Log.LogError('av_open_input_file failed: "' + Filename + '"', 'UAudio_FFmpeg');
Exit;
@@ -310,7 +310,7 @@ begin
FormatCtx^.pb.eof_reached := 0;
{$IFDEF DebugFFmpegDecode}
- dump_format(FormatCtx, 0, pchar(Filename), 0);
+ dump_format(FormatCtx, 0, PAnsiChar(Filename), 0);
{$ENDIF}
AudioStreamIndex := FFmpegCore.FindAudioStreamIndex(FormatCtx);
@@ -862,7 +862,7 @@ begin
end;
end;
-function TFFmpegDecodeStream.DecodeFrame(Buffer: PChar; BufferSize: integer): integer;
+function TFFmpegDecodeStream.DecodeFrame(Buffer: PByteArray; BufferSize: integer): integer;
var
PaketDecodedSize: integer; // size of packet data used for decoding
DataSize: integer; // size of output data decoded by FFmpeg
@@ -945,7 +945,7 @@ begin
Exit;
// handle Status-packet
- if (PChar(AudioPaket.data) = STATUS_PACKET) then
+ if (PAnsiChar(AudioPaket.data) = STATUS_PACKET) then
begin
AudioPaket.data := nil;
AudioPaketData := nil;
@@ -986,7 +986,7 @@ begin
Continue;
end;
- AudioPaketData := PChar(AudioPaket.data);
+ AudioPaketData := AudioPaket.data;
AudioPaketSize := AudioPaket.size;
// if available, update the stream position to the presentation time of this package
@@ -1005,7 +1005,7 @@ begin
end;
end;
-function TFFmpegDecodeStream.ReadData(Buffer: PChar; BufferSize: integer): integer;
+function TFFmpegDecodeStream.ReadData(Buffer: PByteArray; BufferSize: integer): integer;
var
CopyByteCount: integer; // number of bytes to copy
RemainByteCount: integer; // number of bytes left (remain) to read
diff --git a/unicode/src/media/UAudioPlayback_Bass.pas b/unicode/src/media/UAudioPlayback_Bass.pas
index d68ac1d4..923c1d7b 100644
--- a/unicode/src/media/UAudioPlayback_Bass.pas
+++ b/unicode/src/media/UAudioPlayback_Bass.pas
@@ -37,7 +37,6 @@ implementation
uses
Classes,
- SysUtils,
Math,
UIni,
UMain,
@@ -46,7 +45,8 @@ uses
UAudioCore_Bass,
ULog,
sdl,
- bass;
+ bass,
+ SysUtils;
type
PHDSP = ^HDSP;
@@ -90,7 +90,7 @@ type
function GetAudioFormatInfo(): TAudioFormatInfo; override;
- function ReadData(Buffer: PChar; BufferSize: integer): integer;
+ function ReadData(Buffer: PByteArray; BufferSize: integer): integer;
property EOF: boolean READ IsEOF;
end;
@@ -106,8 +106,8 @@ type
function Open(ChannelMap: integer; FormatInfo: TAudioFormatInfo): boolean; override;
procedure Close(); override;
- procedure WriteData(Buffer: PChar; BufferSize: integer); override;
- function ReadData(Buffer: PChar; BufferSize: integer): integer; override;
+ procedure WriteData(Buffer: PByteArray; BufferSize: integer); override;
+ function ReadData(Buffer: PByteArray; BufferSize: integer): integer; override;
function IsEOF(): boolean; override;
function IsError(): boolean; override;
end;
@@ -163,14 +163,14 @@ begin
Result := BytesRead;
end;
-function TBassPlaybackStream.ReadData(Buffer: PChar; BufferSize: integer): integer;
+function TBassPlaybackStream.ReadData(Buffer: PByteArray; BufferSize: integer): integer;
var
AdjustedSize: integer;
RequestedSourceSize, SourceSize: integer;
SkipCount: integer;
SourceFormatInfo: TAudioFormatInfo;
FrameSize: integer;
- PadFrame: PChar;
+ PadFrame: PByteArray;
//Info: BASS_INFO;
//Latency: double;
begin
@@ -610,7 +610,7 @@ begin
inherited Close();
end;
-procedure TBassVoiceStream.WriteData(Buffer: PChar; BufferSize: integer);
+procedure TBassVoiceStream.WriteData(Buffer: PByteArray; BufferSize: integer);
var QueueSize: DWORD;
begin
if ((Handle <> 0) and (BufferSize > 0)) then
@@ -626,7 +626,7 @@ begin
end;
// Note: we do not need the read-function for the BASS implementation
-function TBassVoiceStream.ReadData(Buffer: PChar; BufferSize: integer): integer;
+function TBassVoiceStream.ReadData(Buffer: PByteArray; BufferSize: integer): integer;
begin
Result := -1;
end;
diff --git a/unicode/src/media/UAudioPlayback_SDL.pas b/unicode/src/media/UAudioPlayback_SDL.pas
index b0887676..8403ef03 100644
--- a/unicode/src/media/UAudioPlayback_SDL.pas
+++ b/unicode/src/media/UAudioPlayback_SDL.pas
@@ -33,16 +33,14 @@ interface
{$I switches.inc}
-uses
- Classes,
- SysUtils,
- UMusic;
-
implementation
uses
+ Classes,
sdl,
+ SysUtils,
UAudioPlayback_SoftMixer,
+ UMusic,
ULog,
UIni,
UMain;
@@ -60,13 +58,13 @@ type
function GetLatency(): double; override;
public
function GetName: String; override;
- procedure MixBuffers(dst, src: PChar; size: Cardinal; volume: Single); override;
+ procedure MixBuffers(dst, src: PByteArray; size: Cardinal; volume: Single); override;
end;
{ TAudioPlayback_SDL }
-procedure SDLAudioCallback(userdata: Pointer; stream: PChar; len: integer); cdecl;
+procedure SDLAudioCallback(userdata: Pointer; stream: PByteArray; len: integer); cdecl;
var
Engine: TAudioPlayback_SDL;
begin
@@ -172,7 +170,7 @@ begin
Result := Latency;
end;
-procedure TAudioPlayback_SDL.MixBuffers(dst, src: PChar; size: Cardinal; volume: Single);
+procedure TAudioPlayback_SDL.MixBuffers(dst, src: PByteArray; size: Cardinal; volume: Single);
begin
SDL_MixAudio(PUInt8(dst), PUInt8(src), size, Round(volume * SDL_MIX_MAXVOLUME));
end;
diff --git a/unicode/src/media/UAudioPlayback_SoftMixer.pas b/unicode/src/media/UAudioPlayback_SoftMixer.pas
index f3797dd6..c8da6bcd 100644
--- a/unicode/src/media/UAudioPlayback_SoftMixer.pas
+++ b/unicode/src/media/UAudioPlayback_SoftMixer.pas
@@ -35,8 +35,8 @@ interface
uses
Classes,
- SysUtils,
sdl,
+ SysUtils,
URingBuffer,
UMusic,
UAudioPlaybackBase;
@@ -48,12 +48,12 @@ type
private
Engine: TAudioPlayback_SoftMixer;
- SampleBuffer: PChar;
+ SampleBuffer: PByteArray;
SampleBufferSize: integer;
SampleBufferCount: integer; // number of available bytes in SampleBuffer
SampleBufferPos: cardinal;
- SourceBuffer: PChar;
+ SourceBuffer: PByteArray;
SourceBufferSize: integer;
SourceBufferCount: integer; // number of available bytes in SourceBuffer
@@ -70,7 +70,7 @@ type
procedure Reset();
- procedure ApplySoundEffects(Buffer: PChar; BufferSize: integer);
+ procedure ApplySoundEffects(Buffer: PByteArray; BufferSize: integer);
function InitFormatConversion(): boolean;
procedure FlushBuffers();
@@ -100,7 +100,7 @@ type
function GetAudioFormatInfo(): TAudioFormatInfo; override;
- function ReadData(Buffer: PChar; BufferSize: integer): integer;
+ function ReadData(Buffer: PByteArray; BufferSize: integer): integer;
function GetPCMData(var Data: TPCMData): Cardinal; override;
procedure GetFFTData(var Data: TFFTData); override;
@@ -114,7 +114,7 @@ type
Engine: TAudioPlayback_SoftMixer;
ActiveStreams: TList;
- MixerBuffer: PChar;
+ MixerBuffer: PByteArray;
InternalLock: PSDL_Mutex;
AppVolume: single;
@@ -129,7 +129,7 @@ type
destructor Destroy(); override;
procedure AddStream(Stream: TAudioPlaybackStream);
procedure RemoveStream(Stream: TAudioPlaybackStream);
- function ReadData(Buffer: PChar; BufferSize: integer): integer;
+ function ReadData(Buffer: PByteArray; BufferSize: integer): integer;
property Volume: single read GetVolume write SetVolume;
end;
@@ -144,7 +144,7 @@ type
function StartAudioPlaybackEngine(): boolean; virtual; abstract;
procedure StopAudioPlaybackEngine(); virtual; abstract;
function FinalizeAudioPlaybackEngine(): boolean; virtual; abstract;
- procedure AudioCallback(Buffer: PChar; Size: integer); {$IFDEF HasInline}inline;{$ENDIF}
+ procedure AudioCallback(Buffer: PByteArray; Size: integer); {$IFDEF HasInline}inline;{$ENDIF}
function CreatePlaybackStream(): TAudioPlaybackStream; override;
public
@@ -159,7 +159,7 @@ type
function GetMixer(): TAudioMixerStream; {$IFDEF HasInline}inline;{$ENDIF}
function GetAudioFormatInfo(): TAudioFormatInfo;
- procedure MixBuffers(DstBuffer, SrcBuffer: PChar; Size: Cardinal; Volume: Single); virtual;
+ procedure MixBuffers(DstBuffer, SrcBuffer: PByteArray; Size: Cardinal; Volume: Single); virtual;
end;
type
@@ -174,8 +174,8 @@ type
function Open(ChannelMap: integer; FormatInfo: TAudioFormatInfo): boolean; override;
procedure Close(); override;
- procedure WriteData(Buffer: PChar; BufferSize: integer); override;
- function ReadData(Buffer: PChar; BufferSize: integer): integer; override;
+ procedure WriteData(Buffer: PByteArray; BufferSize: integer); override;
+ function ReadData(Buffer: PByteArray; BufferSize: integer): integer; override;
function IsEOF(): boolean; override;
function IsError(): boolean; override;
end;
@@ -276,7 +276,7 @@ begin
Unlock();
end;
-function TAudioMixerStream.ReadData(Buffer: PChar; BufferSize: integer): integer;
+function TAudioMixerStream.ReadData(Buffer: PByteArray; BufferSize: integer): integer;
var
i: integer;
Size: integer;
@@ -545,7 +545,7 @@ begin
SourceBufferCount := 0;
end;
-procedure TGenericPlaybackStream.ApplySoundEffects(Buffer: PChar; BufferSize: integer);
+procedure TGenericPlaybackStream.ApplySoundEffects(Buffer: PByteArray; BufferSize: integer);
var
i: integer;
begin
@@ -558,7 +558,7 @@ begin
end;
end;
-function TGenericPlaybackStream.ReadData(Buffer: PChar; BufferSize: integer): integer;
+function TGenericPlaybackStream.ReadData(Buffer: PByteArray; BufferSize: integer): integer;
var
ConversionInputCount: integer;
ConversionOutputSize: integer; // max. number of converted data (= buffer size)
@@ -573,7 +573,7 @@ var
SkipSourceCount: integer; // number of source-data bytes to skip
FillCount: integer; // number of bytes to fill with padding data
CopyCount: integer;
- PadFrame: PChar;
+ PadFrame: PByteArray;
i: integer;
begin
Result := -1;
@@ -986,7 +986,7 @@ begin
inherited Close();
end;
-procedure TGenericVoiceStream.WriteData(Buffer: PChar; BufferSize: integer);
+procedure TGenericVoiceStream.WriteData(Buffer: PByteArray; BufferSize: integer);
begin
// lock access to buffer
SDL_mutexP(BufferLock);
@@ -999,7 +999,7 @@ begin
end;
end;
-function TGenericVoiceStream.ReadData(Buffer: PChar; BufferSize: integer): integer;
+function TGenericVoiceStream.ReadData(Buffer: PByteArray; BufferSize: integer): integer;
begin
Result := -1;
@@ -1059,7 +1059,7 @@ begin
Result := true;
end;
-procedure TAudioPlayback_SoftMixer.AudioCallback(Buffer: PChar; Size: integer);
+procedure TAudioPlayback_SoftMixer.AudioCallback(Buffer: PByteArray; Size: integer);
begin
MixerStream.ReadData(Buffer, Size);
end;
@@ -1102,7 +1102,7 @@ begin
MixerStream.Volume := Volume;
end;
-procedure TAudioPlayback_SoftMixer.MixBuffers(DstBuffer, SrcBuffer: PChar; Size: Cardinal; Volume: Single);
+procedure TAudioPlayback_SoftMixer.MixBuffers(DstBuffer, SrcBuffer: PByteArray; Size: Cardinal; Volume: Single);
var
SampleIndex: Cardinal;
SampleInt: Integer;
diff --git a/unicode/src/media/UVideo.pas b/unicode/src/media/UVideo.pas
index 06577d9e..35f8ab4d 100644
--- a/unicode/src/media/UVideo.pas
+++ b/unicode/src/media/UVideo.pas
@@ -126,6 +126,7 @@ type
fFrameBuffer: PByte; //**< stores a FFmpeg video frame
fFrameTex: GLuint; //**< OpenGL texture for FrameBuffer
+ fFrameTexValid: boolean; //**< if true, fFrameTex contains the current frame
fTexWidth, fTexHeight: cardinal;
{$IFDEF UseSWScale}
@@ -137,11 +138,11 @@ type
fTimeBase: extended; //**< FFmpeg time base per time unit
fTime: extended; //**< video time position (absolute)
- fLoopTime: extended; //**< video time position (relative to current loop)
+ fLoopTime: extended; //**< start time of the current loop
procedure Reset();
- function DecodeFrame(var AVPacket: TAVPacket; out pts: double): boolean;
- procedure SynchronizeVideo(Frame: PAVFrame; var pts: double);
+ function DecodeFrame(): boolean;
+ procedure SynchronizeTime(Frame: PAVFrame; var pts: double);
procedure GetVideoRect(var ScreenRect, TexRect: TRectCoords);
@@ -240,6 +241,7 @@ begin
fTime := 0;
fStream := nil;
fStreamIndex := -1;
+ fFrameTexValid := false;
fEOF := false;
@@ -453,7 +455,7 @@ begin
fOpened := False;
end;
-procedure TVideoPlayback_FFmpeg.SynchronizeVideo(Frame: PAVFrame; var pts: double);
+procedure TVideoPlayback_FFmpeg.SynchronizeTime(Frame: PAVFrame; var pts: double);
var
FrameDelay: double;
begin
@@ -473,12 +475,21 @@ begin
fTime := fTime + FrameDelay;
end;
-function TVideoPlayback_FFmpeg.DecodeFrame(var AVPacket: TAVPacket; out pts: double): boolean;
+{**
+ * Decode a new frame from the video stream.
+ * The decoded frame is stored in fAVFrame. fTime is updated to the new frame's
+ * time.
+ * @param pts will be updated to the presentation time of the decoded frame.
+ * returns true if a frame could be decoded. False if an error or EOF occured.
+ *}
+function TVideoPlayback_FFmpeg.DecodeFrame(): boolean;
var
FrameFinished: Integer;
VideoPktPts: int64;
pbIOCtx: PByteIOContext;
errnum: integer;
+ AVPacket: TAVPacket;
+ pts: double;
begin
Result := false;
FrameFinished := 0;
@@ -521,8 +532,17 @@ begin
end;
// no error -> wait for user input
- SDL_Delay(100);
+{
+ SDL_Delay(100); // initial version, left for documentation
continue;
+}
+
+ // Patch by Hawkear:
+ // Why should this function loop in an endless loop if there is an error?
+ // This runs in the main thread, so it halts the whole program
+ // Therefore, it is better to exit when an error occurs
+ Exit;
+
end;
// if we got a packet from the video stream, then decode it
@@ -555,9 +575,9 @@ begin
end;
pts := pts * av_q2d(fStream^.time_base);
- // synchronize on each complete frame
+ // synchronize time on each complete frame
if (frameFinished <> 0) then
- SynchronizeVideo(fAVFrame, pts);
+ SynchronizeTime(fAVFrame, pts);
end;
// free the packet from av_read_frame
@@ -569,13 +589,12 @@ end;
procedure TVideoPlayback_FFmpeg.GetFrame(Time: Extended);
var
- AVPacket: TAVPacket;
errnum: Integer;
- myTime: Extended;
+ NewTime: Extended;
TimeDifference: Extended;
DropFrameCount: Integer;
- pts: double;
i: Integer;
+ Success: boolean;
const
FRAME_DROPCOUNT = 3;
begin
@@ -585,41 +604,50 @@ begin
if fPaused then
Exit;
- // current time, relative to last fLoop (if any)
- myTime := Time - fLoopTime;
- // time since the last frame was returned
- TimeDifference := myTime - fTime;
+ // requested stream position (relative to the last loop's start)
+ NewTime := Time - fLoopTime;
- {$IFDEF DebugDisplay}
- DebugWriteln('Time: '+inttostr(floor(Time*1000)) + sLineBreak +
- 'VideoTime: '+inttostr(floor(fTime*1000)) + sLineBreak +
- 'TimeBase: '+inttostr(floor(fTimeBase*1000)) + sLineBreak +
- 'TimeDiff: '+inttostr(floor(TimeDifference*1000)));
- {$endif}
-
- // check if a new frame is needed
- if (fTime <> 0) and (TimeDifference < fTimeBase) then
+ // check if current texture still contains the active frame
+ if (fFrameTexValid) then
begin
- {$ifdef DebugFrames}
- // frame delay debug display
- GoldenRec.Spawn(200,15,1,16,0,-1,ColoredStar,$00ff00);
- {$endif}
+ // time since the last frame was returned
+ TimeDifference := NewTime - fTime;
{$IFDEF DebugDisplay}
- DebugWriteln('not getting new frame' + sLineBreak +
- 'Time: '+inttostr(floor(Time*1000)) + sLineBreak +
- 'VideoTime: '+inttostr(floor(fTime*1000)) + sLineBreak +
- 'TimeBase: '+inttostr(floor(fTimeBase*1000)) + sLineBreak +
- 'TimeDiff: '+inttostr(floor(TimeDifference*1000)));
+ DebugWriteln('Time: '+inttostr(floor(Time*1000)) + sLineBreak +
+ 'VideoTime: '+inttostr(floor(fTime*1000)) + sLineBreak +
+ 'TimeBase: '+inttostr(floor(fTimeBase*1000)) + sLineBreak +
+ 'TimeDiff: '+inttostr(floor(TimeDifference*1000)));
{$endif}
- // we do not need a new frame now
- Exit;
+ // check if last time is more than one frame in the past
+ if (TimeDifference < fTimeBase) then
+ begin
+ {$ifdef DebugFrames}
+ // frame delay debug display
+ GoldenRec.Spawn(200,15,1,16,0,-1,ColoredStar,$00ff00);
+ {$endif}
+
+ {$IFDEF DebugDisplay}
+ DebugWriteln('not getting new frame' + sLineBreak +
+ 'Time: '+inttostr(floor(Time*1000)) + sLineBreak +
+ 'VideoTime: '+inttostr(floor(fTime*1000)) + sLineBreak +
+ 'TimeBase: '+inttostr(floor(fTimeBase*1000)) + sLineBreak +
+ 'TimeDiff: '+inttostr(floor(TimeDifference*1000)));
+ {$endif}
+
+ // we do not need a new frame now
+ Exit;
+ end;
end;
- // update video-time to the next frame
- fTime := fTime + fTimeBase;
- TimeDifference := myTime - fTime;
+ {$IFDEF VideoBenchmark}
+ Log.BenchmarkStart(15);
+ {$ENDIF}
+
+ // fetch new frame (updates fTime)
+ Success := DecodeFrame();
+ TimeDifference := NewTime - fTime;
// check if we have to skip frames
if (TimeDifference >= FRAME_DROPCOUNT*fTimeBase) then
@@ -640,19 +668,18 @@ begin
// skip half of the frames, this is much smoother than to skip all at once
for i := 1 to DropFrameCount (*div 2*) do
- DecodeFrame(AVPacket, pts);
+ Success := DecodeFrame();
end;
- {$IFDEF VideoBenchmark}
- Log.BenchmarkStart(15);
- {$ENDIF}
-
- if (not DecodeFrame(AVPacket, pts)) then
+ // check if we got an EOF or error
+ if (not Success) then
begin
if fLoop then
begin
- // Record the time we looped. This is used to keep the loops in time. otherwise they speed
+ // we have to loop, so rewind
SetPosition(0);
+ // record the start-time of the current loop, so we can
+ // determine the position in the stream (fTime-fLoopTime) later.
fLoopTime := Time;
end;
Exit;
@@ -695,6 +722,9 @@ begin
fCodecContext^.width, fCodecContext^.height,
PIXEL_FMT_OPENGL, GL_UNSIGNED_BYTE, fAVFrameRGB^.data[0]);
+ if (not fFrameTexValid) then
+ fFrameTexValid := true;
+
{$ifdef DebugFrames}
//frame decode debug display
GoldenRec.Spawn(200, 35, 1, 16, 0, -1, ColoredStar, $ffff00);
@@ -738,7 +768,9 @@ begin
acoLetterBox: begin
ScaledVideoWidth := RenderW;
ScaledVideoHeight := RenderH * ScreenAspect/fAspect;
- end;
+ end
+ else
+ raise Exception.Create('Unhandled aspect correction!');
end;
// center video
@@ -762,8 +794,18 @@ var
begin
// have a nice black background to draw on
// (even if there were errors opening the vid)
- glClearColor(0, 0, 0, 0);
- glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
+ // TODO: Philipp: IMO TVideoPlayback should not clear the screen at
+ // all, because clearing is already done by the background class
+ // at this moment.
+ if (Screen = 1) then
+ begin
+ // It is important that we just clear once before we start
+ // drawing the first screen otherwise the first screen
+ // would be cleared by the drawgl called when the second
+ // screen is drawn
+ glClearColor(0, 0, 0, 0);
+ glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
+ end;
// exit if there's nothing to draw
if (not fOpened) then
@@ -858,6 +900,14 @@ procedure TVideoPlayback_FFmpeg.Stop;
begin
end;
+{**
+ * Sets the stream's position.
+ * The stream is set to the first keyframe with timestamp <= Time.
+ * Note that fTime is set to Time no matter if the actual position seeked to is
+ * at Time or the time of a preceding keyframe. fTime will be updated to the
+ * actual frame time when GetFrame() is called the next time.
+ * @param Time new position in seconds
+ *}
procedure TVideoPlayback_FFmpeg.SetPosition(Time: real);
var
SeekFlags: integer;
@@ -871,13 +921,18 @@ begin
// TODO: handle fLoop-times
//Time := Time mod VideoDuration;
- // backward seeking might fail without AVSEEK_FLAG_BACKWARD
- SeekFlags := AVSEEK_FLAG_ANY;
- if (Time < fTime) then
- SeekFlags := SeekFlags or AVSEEK_FLAG_BACKWARD;
+ // Do not use the AVSEEK_FLAG_ANY here. It will seek to any frame, even
+ // non keyframes (P-/B-frames). It will produce corrupted video frames as
+ // FFmpeg does not use the information of the preceding I-frame.
+ // The picture might be gray or green until the next keyframe occurs.
+ // Instead seek the first keyframe smaller than the requested time
+ // (AVSEEK_FLAG_BACKWARD). As this can be some seconds earlier than the
+ // requested time, let the sync in GetFrame() do its job.
+ SeekFlags := AVSEEK_FLAG_BACKWARD;
fTime := Time;
fEOF := false;
+ fFrameTexValid := false;
if (av_seek_frame(fFormatContext, fStreamIndex, Floor(Time/fTimeBase), SeekFlags) < 0) then
begin
@@ -890,7 +945,6 @@ end;
function TVideoPlayback_FFmpeg.GetPosition: real;
begin
- // TODO: return video-position in seconds
Result := fTime;
end;
diff --git a/unicode/src/media/UVisualizer.pas b/unicode/src/media/UVisualizer.pas
index 9af6d8c2..37e0268a 100644
--- a/unicode/src/media/UVisualizer.pas
+++ b/unicode/src/media/UVisualizer.pas
@@ -484,7 +484,11 @@ begin
glMatrixMode(GL_PROJECTION);
glPushMatrix();
glLoadIdentity();
- gluOrtho2D(0, 1, 0, 1);
+ // Use count of screens instead of 1 for the right corner
+ // otherwise we would draw the visualization streched over both screens
+ // another point is that we draw over the at this time drawn first
+ // screen, if Screen = 2
+ gluOrtho2D(0, Screens, 0, 1);
glMatrixMode(GL_MODELVIEW);
glPushMatrix();
glLoadIdentity();
@@ -496,11 +500,12 @@ begin
glColor4f(1, 1, 1, 1);
// draw projectM frame
+ // Screen is 1 to 2. So current screen is from (Screen - 1) to (Screen)
glBegin(GL_QUADS);
- glTexCoord2f(0, 0); glVertex2f(0, 0);
- glTexCoord2f(1, 0); glVertex2f(1, 0);
- glTexCoord2f(1, 1); glVertex2f(1, 1);
- glTexCoord2f(0, 1); glVertex2f(0, 1);
+ glTexCoord2f(0, 0); glVertex2f((Screen - 1), 0);
+ glTexCoord2f(1, 0); glVertex2f(Screen, 0);
+ glTexCoord2f(1, 1); glVertex2f(Screen, 1);
+ glTexCoord2f(0, 1); glVertex2f((Screen - 1), 1);
glEnd();
glDisable(GL_TEXTURE_2D);
diff --git a/unicode/src/menu/UDisplay.pas b/unicode/src/menu/UDisplay.pas
index f4cca4a5..3e653183 100644
--- a/unicode/src/menu/UDisplay.pas
+++ b/unicode/src/menu/UDisplay.pas
@@ -34,7 +34,7 @@ interface
{$I switches.inc}
uses
- ucommon,
+ UCommon,
SDL,
UMenu,
gl,
@@ -86,15 +86,16 @@ var
implementation
uses
- UImage,
TextGL,
+ UCommandLine,
+ UGraphic,
+ UIni,
+ UImage,
ULog,
UMain,
UTexture,
- UIni,
- UGraphic,
UTime,
- UCommandLine;
+ UPath;
constructor TDisplay.Create;
var
diff --git a/unicode/src/menu/UDrawTexture.pas b/unicode/src/menu/UDrawTexture.pas
index 33082765..bc136f11 100644
--- a/unicode/src/menu/UDrawTexture.pas
+++ b/unicode/src/menu/UDrawTexture.pas
@@ -74,7 +74,6 @@ var
begin
with Texture do
begin
- // rysuje paski gracza
glColor4f(ColR * Int, ColG * Int, ColB * Int, Alpha);
glEnable(GL_TEXTURE_2D);
glEnable(GL_BLEND);
diff --git a/unicode/src/menu/UMenuBackgroundColor.pas b/unicode/src/menu/UMenuBackgroundColor.pas
index 68cf2de4..a5c2a70a 100644
--- a/unicode/src/menu/UMenuBackgroundColor.pas
+++ b/unicode/src/menu/UMenuBackgroundColor.pas
@@ -52,7 +52,8 @@ type
implementation
uses
gl,
- glext;
+ glext,
+ UGraphic;
constructor TMenuBackgroundColor.Create(const ThemedSettings: TThemeBackground);
begin
@@ -62,8 +63,11 @@ end;
procedure TMenuBackgroundColor.Draw;
begin
+ if (ScreenAct = 1) then
+ begin //just clear once, even when using two screens
glClearColor(Color.R, Color.G, Color.B, 0);
glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
+ end;
end;
end. \ No newline at end of file
diff --git a/unicode/src/menu/UMenuBackgroundFade.pas b/unicode/src/menu/UMenuBackgroundFade.pas
index b6174738..dc37da45 100644
--- a/unicode/src/menu/UMenuBackgroundFade.pas
+++ b/unicode/src/menu/UMenuBackgroundFade.pas
@@ -66,7 +66,8 @@ uses sdl,
gl,
glext,
USkins,
- UCommon;
+ UCommon,
+ UGraphic;
constructor TMenuBackgroundFade.Create(const ThemedSettings: TThemeBackground);
var texFilename: string;
@@ -121,7 +122,8 @@ begin
if (UseTexture) then
begin //Draw Texture to Screen
- glClear(GL_DEPTH_BUFFER_BIT);
+ If (ScreenAct = 1) then //Clear just once when in dual screen mode
+ glClear(GL_DEPTH_BUFFER_BIT);
glEnable(GL_TEXTURE_2D);
glEnable(GL_BLEND);
@@ -149,7 +151,9 @@ begin
end
else
begin //Clear Screen w/ progress Alpha + Color
- glClear(GL_DEPTH_BUFFER_BIT);
+ If (ScreenAct = 1) then //Clear just once when in dual screen mode
+ glClear(GL_DEPTH_BUFFER_BIT);
+
glDisable(GL_TEXTURE_2D);
glEnable(GL_BLEND);
glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
diff --git a/unicode/src/menu/UMenuBackgroundNone.pas b/unicode/src/menu/UMenuBackgroundNone.pas
index 6b63742a..1fccc007 100644
--- a/unicode/src/menu/UMenuBackgroundNone.pas
+++ b/unicode/src/menu/UMenuBackgroundNone.pas
@@ -52,7 +52,8 @@ type
implementation
uses
gl,
- glext;
+ glext,
+ UGraphic;
constructor TMenuBackgroundNone.Create(const ThemedSettings: TThemeBackground);
begin
@@ -62,7 +63,8 @@ end;
procedure TMenuBackgroundNone.Draw;
begin
//Do just nothing in here!
- glClear(GL_DEPTH_BUFFER_BIT);
+ If (ScreenAct = 1) then //Clear just once when in dual screen mode
+ glClear(GL_DEPTH_BUFFER_BIT);
end;
end. \ No newline at end of file
diff --git a/unicode/src/menu/UMenuBackgroundTexture.pas b/unicode/src/menu/UMenuBackgroundTexture.pas
index e8678fc5..a1b9e88a 100644
--- a/unicode/src/menu/UMenuBackgroundTexture.pas
+++ b/unicode/src/menu/UMenuBackgroundTexture.pas
@@ -61,7 +61,8 @@ uses
UCommon,
SysUtils,
gl,
- glext;
+ glext,
+ UGraphic;
constructor TMenuBackgroundTexture.Create(const ThemedSettings: TThemeBackground);
var texFilename: string;
@@ -92,7 +93,9 @@ end;
procedure TMenuBackgroundTexture.Draw;
begin
- glClear(GL_DEPTH_BUFFER_BIT);
+ If (ScreenAct = 1) then //Clear just once when in dual screen mode
+ glClear(GL_DEPTH_BUFFER_BIT);
+
glColorRGB(Color);
glEnable(GL_TEXTURE_2D);
diff --git a/unicode/src/menu/UMenuBackgroundVideo.pas b/unicode/src/menu/UMenuBackgroundVideo.pas
index 377c2170..d1ce0f09 100644
--- a/unicode/src/menu/UMenuBackgroundVideo.pas
+++ b/unicode/src/menu/UMenuBackgroundVideo.pas
@@ -105,7 +105,8 @@ uses
SysUtils,
UTime,
USkins,
- UCommon;
+ UCommon,
+ UGraphic;
constructor TMenuBackgroundVideo.Create(const ThemedSettings: TThemeBackground);
begin
@@ -146,7 +147,8 @@ end;
procedure TMenuBackgroundVideo.Draw;
begin
- glClear(GL_DEPTH_BUFFER_BIT);
+ If (ScreenAct = 1) then //Clear just once when in dual screen mode
+ glClear(GL_DEPTH_BUFFER_BIT);
VideoPlayback.GetFrame(VideoBGTimer.GetTime());
// FIXME: why do we draw on screen 2? Seems to be wrong.
diff --git a/unicode/src/menu/UMenuButton.pas b/unicode/src/menu/UMenuButton.pas
index a0cdaeef..c6ff8ab7 100644
--- a/unicode/src/menu/UMenuButton.pas
+++ b/unicode/src/menu/UMenuButton.pas
@@ -45,24 +45,24 @@ type
TButton = class
protected
- SelectBool: Boolean;
+ SelectBool: boolean;
- FadeProgress: Real;
- FadeLastTick: Cardinal;
+ FadeProgress: real;
+ FadeLastTick: cardinal;
DeSelectW,
DeSelectH,
PosX,
- PosY: Real;
+ PosY: real;
constructor Create(); overload;
public
- Text: Array of TText;
+ Text: array of TText;
Texture: TTexture; // Button Screen position and size
Texture2: TTexture; // second texture only used for fading full resolution covers
- Colorized: Boolean;
+ Colorized: boolean;
DeSelectTexture: TTexture; // texture for colorized hack
FadeTex: TTexture; //Texture for beautiful fading
@@ -73,15 +73,15 @@ type
Reflection: boolean;
Reflectionspacing,
- DeSelectReflectionspacing: Real;
+ DeSelectReflectionspacing: real;
Fade,
- FadeText: Boolean;
+ FadeText: boolean;
Selectable: boolean;
//Number of the Parent Collection, 0 if in no Collection
- Parent: Byte;
+ Parent: byte;
SelectColR,
SelectColG,
@@ -103,13 +103,13 @@ type
procedure SetW(Value: real);
procedure SetH(Value: real);
- procedure SetSelect(Value: Boolean); virtual;
+ procedure SetSelect(Value: boolean); virtual;
property X: real read PosX write SetX;
property Y: real read PosY write SetY;
property Z: real read Texture.z write Texture.z;
property W: real read DeSelectW write SetW;
property H: real read DeSelectH write SetH;
- property Selected: Boolean read SelectBool write SetSelect;
+ property Selected: boolean read SelectBool write SetSelect;
procedure Draw; virtual;
@@ -120,8 +120,9 @@ type
implementation
-uses SysUtils,
- UDrawTexture;
+uses
+ SysUtils,
+ UDrawTexture;
procedure TButton.SetX(Value: real);
{var
@@ -143,8 +144,8 @@ end;
procedure TButton.SetY(Value: real);
{var
- dY: real;
- T: integer; // text}
+ dY: real;
+ T: integer; // text}
begin
{dY := Value - PosY;
@@ -164,7 +165,7 @@ begin
DeSelectW := Value;
- if Not Fade then
+ if not Fade then
begin
if SelectBool then
Texture.W := SelectW
@@ -180,7 +181,7 @@ begin
DeSelectH := Value;
- if Not Fade then
+ if not Fade then
begin
if SelectBool then
Texture.H := SelectH
@@ -189,9 +190,9 @@ begin
end;
end;
-procedure TButton.SetSelect(Value : Boolean);
+procedure TButton.SetSelect(Value : boolean);
var
- T: integer;
+ T: integer;
begin
SelectBool := Value;
@@ -291,9 +292,9 @@ end;
procedure TButton.Draw;
var
- T: integer;
- Tick: Cardinal;
- Spacing: Real;
+ T: integer;
+ Tick: cardinal;
+ Spacing: real;
begin
if Visible then
begin
@@ -315,7 +316,7 @@ begin
if (FadeText) then
begin
- For T := 0 to high(Text) do
+ for T := 0 to high(Text) do
begin
Text[T].MoveX := (SelectW - DeSelectW) * FadeProgress;
Text[T].MoveY := (SelectH - DeSelectH) * FadeProgress;
@@ -353,7 +354,7 @@ begin
FadeTex.TexY1 := 0;
FadeTex.TexY2 := 1;
- Case FadeTexPos of
+ case FadeTexPos of
0: //FadeTex on Top
begin
//Standard Texture
@@ -465,7 +466,7 @@ begin
//Reflection Mod
if (Reflection) then // Draw Reflections
begin
- if (FadeProgress <> 0) AND (FadeProgress <> 1) then
+ if (FadeProgress <> 0) and (FadeProgress <> 1) then
begin
Spacing := DeSelectReflectionspacing - (DeSelectReflectionspacing - Reflectionspacing) * FadeProgress;
end
@@ -514,9 +515,10 @@ begin
glDisable(GL_TEXTURE_2D);
glDisable(GL_DEPTH_TEST);
glDisable(GL_BLEND);
- end else
+ end
+ else
with DeSelectTexture do
- begin
+ begin
//Bind Tex and GL Attributes
glEnable(GL_TEXTURE_2D);
glEnable(GL_BLEND);
@@ -556,7 +558,8 @@ begin
end;
end;
- for T := 0 to High(Text) do begin
+ for T := 0 to High(Text) do
+ begin
Text[T].Draw;
end;
end;
@@ -577,7 +580,7 @@ begin
Texture.ColG := 0.5;
Texture.ColB := 0;
Texture.Int := 1;
- Colorized := False;
+ Colorized := false;
end;
// Button has the texture-type "colorized"
@@ -592,7 +595,7 @@ begin
Texture.ColG := 1;
Texture.ColB := 1;
Texture.Int := 1;
- Colorized := True;
+ Colorized := true;
end;
end.
diff --git a/unicode/src/screens/UScreenCredits.pas b/unicode/src/screens/UScreenCredits.pas
index de559cc6..25fa96df 100644
--- a/unicode/src/screens/UScreenCredits.pas
+++ b/unicode/src/screens/UScreenCredits.pas
@@ -34,6 +34,7 @@ interface
{$I switches.inc}
uses
+ SysUtils,
UMenu,
SDL,
SDL_Image,
@@ -42,7 +43,6 @@ uses
gl,
UMusic,
UFiles,
- SysUtils,
UThemes,
UGraphicClasses;
@@ -167,16 +167,16 @@ const
implementation
uses
- ULog,
- UGraphic,
- UMain,
- UIni,
- USongs,
- Textgl,
- ULanguage,
- UCommon,
- Math;
-
+ Math,
+ ULog,
+ UGraphic,
+ UMain,
+ UIni,
+ USongs,
+ Textgl,
+ ULanguage,
+ UCommon,
+ UPath;
function TScreenCredits.ParseInput(PressedKey: Cardinal; CharCode: UCS4Char; PressedDown: Boolean): Boolean;
begin
@@ -246,63 +246,6 @@ begin
Draw:=true;
end;
-function pixfmt_eq(fmt1,fmt2: TSDL_Pixelformat): boolean;
-begin
- if (fmt1.BitsPerPixel = fmt2.BitsPerPixel) and
- (fmt1.BytesPerPixel = fmt2.BytesPerPixel) and
- (fmt1.Rloss = fmt2.Rloss) and
- (fmt1.Gloss = fmt2.Gloss) and
- (fmt1.Bloss = fmt2.Bloss) and
- (fmt1.Rmask = fmt2.Rmask) and
- (fmt1.Gmask = fmt2.Gmask) and
- (fmt1.Bmask = fmt2.Bmask) and
- (fmt1.Rshift = fmt2.Rshift) and
- (fmt1.Gshift = fmt2.Gshift) and
- (fmt1.Bshift = fmt2.Bshift)
- then
- pixfmt_eq:=True
- else
- pixfmt_eq:=False;
-end;
-
-function inttohexstr(i: cardinal):pchar;
-var helper, i2, c:cardinal;
- tmpstr: string;
-begin
- helper:=0;
- i2:=i;
- tmpstr:='';
- for c:=1 to 8 do
- begin
- helper:=(helper shl 4) or (i2 and $f);
- i2:=i2 shr 4;
- end;
- for c:=1 to 8 do
- begin
- i2:=helper and $f;
- helper := helper shr 4;
- case i2 of
- 0: tmpstr:=tmpstr+'0';
- 1: tmpstr:=tmpstr+'1';
- 2: tmpstr:=tmpstr+'2';
- 3: tmpstr:=tmpstr+'3';
- 4: tmpstr:=tmpstr+'4';
- 5: tmpstr:=tmpstr+'5';
- 6: tmpstr:=tmpstr+'6';
- 7: tmpstr:=tmpstr+'7';
- 8: tmpstr:=tmpstr+'8';
- 9: tmpstr:=tmpstr+'9';
- 10: tmpstr:=tmpstr+'a';
- 11: tmpstr:=tmpstr+'b';
- 12: tmpstr:=tmpstr+'c';
- 13: tmpstr:=tmpstr+'d';
- 14: tmpstr:=tmpstr+'e';
- 15: tmpstr:=tmpstr+'f';
- end;
- end;
- inttohexstr:=pchar(tmpstr);
-end;
-
procedure TScreenCredits.onShow;
begin
inherited;
diff --git a/unicode/src/screens/UScreenEdit.pas b/unicode/src/screens/UScreenEdit.pas
index 3be9308e..2111adef 100644
--- a/unicode/src/screens/UScreenEdit.pas
+++ b/unicode/src/screens/UScreenEdit.pas
@@ -33,20 +33,24 @@ interface
{$I switches.inc}
-uses UMenu, SDL, UThemes;
+uses
+ UMenu,
+ SDL,
+ UThemes;
type
TScreenEdit = class(TMenu)
public
-{ Tex_Background: TTexture;
- FadeOut: boolean;
- Path: string;
- FileName: string;}
+ TextDescription: integer;
+ TextDescriptionLong: integer;
+
constructor Create; override;
- procedure onShow; override;
- function ParseInput(PressedKey: Cardinal; CharCode: UCS4Char; PressedDown: Boolean): Boolean; override;
-{ function Draw: boolean; override;
- procedure Finish;}
+ function ParseInput(PressedKey: cardinal; CharCode: UCS4Char; PressedDown: boolean): boolean; override;
+ procedure InteractNext; override;
+ procedure InteractPrev; override;
+ procedure InteractInc; override;
+ procedure InteractDec; override;
+ procedure SetAnimationProgress(Progress: real); override;
end;
implementation
@@ -58,12 +62,18 @@ uses
UUnicodeUtils,
SysUtils;
-function TScreenEdit.ParseInput(PressedKey: Cardinal; CharCode: UCS4Char; PressedDown: Boolean): Boolean;
+function TScreenEdit.ParseInput(PressedKey: cardinal; CharCode: UCS4Char; PressedDown: boolean): boolean;
+var
+ SDL_ModState: word;
begin
Result := true;
- If (PressedDown) Then
+
+ SDL_ModState := SDL_GetModState and (KMOD_LSHIFT + KMOD_RSHIFT +
+ KMOD_LCTRL + KMOD_RCTRL + KMOD_LALT + KMOD_RALT);
+
+ if (PressedDown) then
begin // Key Down
- // check normal keys
+ // check normal keys
case UCS4UpperCase(CharCode) of
Ord('Q'):
begin
@@ -79,7 +89,6 @@ begin
begin
AudioPlayback.PlaySound(SoundLib.Back);
FadeTo(@ScreenMain);
-// Result := false;
end;
SDLK_RETURN:
begin
@@ -88,10 +97,6 @@ begin
AudioPlayback.PlaySound(SoundLib.Start);
FadeTo(@ScreenEditConvert);
end;
-// if Interaction = 1 then begin
-// Music.PlayStart;
-// FadeTo(@ScreenEditHeader);
-// end;
if Interaction = 1 then
begin
@@ -100,14 +105,10 @@ begin
end;
end;
- SDLK_DOWN:
- begin
- InteractNext;
- end;
- SDLK_UP:
- begin
- InteractPrev;
- end;
+ SDLK_DOWN: InteractInc;
+ SDLK_UP: InteractDec;
+ SDLK_RIGHT: InteractNext;
+ SDLK_LEFT: InteractPrev;
end;
end;
end;
@@ -115,41 +116,49 @@ end;
constructor TScreenEdit.Create;
begin
inherited Create;
- AddButton(400-200, 100 + 0*70, 400, 40, Skin.GetTextureFileName('ButtonF'));
- AddButtonText(10, 5, 0, 0, 0, 'Convert Midi to Txt');
-// Button[High(Button)].Text[0].Size := 11;
-// AddButton(400-200, 100 + 1*60, 400, 40, 'ButtonF');
-// AddButtonText(10, 5, 0, 0, 0, 'Edit Headers');
+ TextDescription := AddText(Theme.Edit.TextDescription);
-// AddButton(400-200, 100 + 2*60, 400, 40, 'ButtonF');
-// AddButtonText(10, 5, 0, 0, 0, 'Set GAP');
+ LoadFromTheme(Theme.Edit);
- AddButton(400-200, 100 + 3*60, 400, 40, Skin.GetTextureFileName('ButtonF'));
- AddButtonText(10, 5, 0, 0, 0, 'Exit');
+ AddButton(Theme.Edit.ButtonConvert);
+{ Some ideas for more:
+ AddButton(Theme.Edit.ButtonEditHeaders);
+ AddButton(Theme.Edit.ButtonAdjustGap);
+}
+ AddButton(Theme.Edit.ButtonExit);
+ Interaction := 0;
end;
-procedure TScreenEdit.onShow;
+procedure TScreenEdit.InteractNext;
begin
- inherited;
+ inherited InteractNext;
+ Text[TextDescription].Text := Theme.Edit.Description[Interaction];
+end;
-// Interaction := 0;
+procedure TScreenEdit.InteractPrev;
+begin
+ inherited InteractPrev;
+ Text[TextDescription].Text := Theme.Edit.Description[Interaction];
end;
-(*function TScreenEdit.Draw: boolean;
-var
- Min: integer;
- Sec: integer;
- Tekst: string;
- Pet: integer;
- AktBeat: integer;
+procedure TScreenEdit.InteractDec;
begin
+ inherited InteractDec;
+ Text[TextDescription].Text := Theme.Edit.Description[Interaction];
end;
-procedure TScreenEdit.Finish;
+procedure TScreenEdit.InteractInc;
begin
-//
-end;*)
+ inherited InteractInc;
+ Text[TextDescription].Text := Theme.Edit.Description[Interaction];
+end;
+
+procedure TScreenEdit.SetAnimationProgress(Progress: real);
+begin
+ Static[0].Texture.ScaleW := Progress;
+ Static[0].Texture.ScaleH := Progress;
+end;
end.
diff --git a/unicode/src/screens/UScreenEditConvert.pas b/unicode/src/screens/UScreenEditConvert.pas
index 328398aa..835590ed 100644
--- a/unicode/src/screens/UScreenEditConvert.pas
+++ b/unicode/src/screens/UScreenEditConvert.pas
@@ -48,21 +48,21 @@ uses
type
TNote = record
- Event: integer;
- EventType: integer;
- Channel: integer;
- Start: real;
- Len: real;
- Data1: integer;
- Data2: integer;
- Str: string;
+ Event: integer;
+ EventType: integer;
+ Channel: integer;
+ Start: real;
+ Len: real;
+ Data1: integer;
+ Data2: integer;
+ Str: string;
end;
TTrack = record
- Note: array of TNote;
- Name: string;
- Hear: boolean;
- Status: byte; // 0 - none, 1 - notes, 2 - lyrics, 3 - notes + lyrics
+ Note: array of TNote;
+ Name: string;
+ Hear: boolean;
+ Status: set of (notes, lyrics);
end;
TNuta = record
@@ -77,29 +77,29 @@ type
TScreenEditConvert = class(TMenu)
public
- ATrack: TArrayTrack; // actual track
-// Track: TArrayTrack;
- Channel: TArrayTrack;
- ColR: array[0..100] of real;
- ColG: array[0..100] of real;
- ColB: array[0..100] of real;
- Len: real;
- Sel: integer;
- Selected: boolean;
-// FileName: string;
+ ATrack: TArrayTrack; // actual track
+// Track: TArrayTrack;
+ Channel: TArrayTrack;
+ ColR: array[0..100] of real;
+ ColG: array[0..100] of real;
+ ColB: array[0..100] of real;
+ Len: real;
+ Sel: integer;
+ Selected: boolean;
+// FileName: string;
{$IFDEF UseMIDIPort}
- MidiFile: TMidiFile;
- MidiTrack: TMidiTrack;
- MidiEvent: pMidiEvent;
- MidiOut: TMidiOutput;
+ MidiFile: TMidiFile;
+ MidiTrack: TMidiTrack;
+ MidiEvent: pMidiEvent;
+ MidiOut: TMidiOutput;
{$ENDIF}
- Song: TSong;
- Lines: TLines;
- BPM: real;
- Ticks: real;
- Note: array of TNuta;
+ Song: TSong;
+ Lines: TLines;
+ BPM: real;
+ Ticks: real;
+ Note: array of TNuta;
procedure AddLyric(Start: integer; Text: string);
procedure Extract;
@@ -111,26 +111,30 @@ type
function SelectedNumber: integer;
constructor Create; override;
procedure onShow; override;
- function ParseInput(PressedKey: Cardinal; CharCode: UCS4Char; PressedDown: Boolean): Boolean; override;
+ function ParseInput(PressedKey: cardinal; CharCode: UCS4Char; PressedDown: boolean): boolean; override;
function Draw: boolean; override;
procedure onHide; override;
end;
+var
+ ConversionFileName: string;
+
implementation
uses
SysUtils,
+ TextGL,
gl,
- UGraphic,
UDrawTexture,
- TextGL,
UFiles,
- UMain,
+ UGraphic,
UIni,
+ UMain,
+ UPath,
USkins,
UUnicodeUtils;
-function TScreenEditConvert.ParseInput(PressedKey: Cardinal; CharCode: UCS4Char; PressedDown: Boolean): Boolean;
+function TScreenEditConvert.ParseInput(PressedKey: cardinal; CharCode: UCS4Char; PressedDown: boolean): boolean;
begin
Result := true;
If (PressedDown) Then
@@ -175,13 +179,16 @@ begin
{$ENDIF}
end;
- if Interaction = 2 then begin
+ if Interaction = 2 then
+ begin
Selected := true;
{$IFDEF UseMIDIPort}
MidiFile.OnMidiEvent := nil;
{$ENDIF}
- {for T := 0 to High(ATrack) do begin
- if ATrack[T].Hear then begin
+ {for T := 0 to High(ATrack) do
+ begin
+ if ATrack[T].Hear then
+ begin
MidiTrack := MidiFile.GetTrack(T);
MidiTrack.OnMidiEvent := MidiFile1MidiEvent;
end;
@@ -189,8 +196,10 @@ begin
MidiFile.StartPlaying;//}
end;
- if Interaction = 3 then begin
- if SelectedNumber > 0 then begin
+ if Interaction = 3 then
+ begin
+ if SelectedNumber > 0 then
+ begin
Extract;
SaveSong(Song, Lines, ChangeFileExt(ConversionFileName, '.txt'), false);
end;
@@ -201,9 +210,19 @@ begin
SDLK_SPACE:
begin
// ATrack[Sel].Hear := not ATrack[Sel].Hear;
- ATrack[Sel].Status := (ATrack[Sel].Status + 1) mod 4;
-
-{ if Selected then begin
+ if Notes in ATrack[Sel].Status then
+ begin
+ ATrack[Sel].Status := ATrack[Sel].Status - [Notes];
+ if Lyrics in ATrack[Sel].Status then
+ ATrack[Sel].Status := ATrack[Sel].Status - [Lyrics]
+ else
+ ATrack[Sel].Status := ATrack[Sel].Status + [Lyrics];
+ end
+ else
+ ATrack[Sel].Status := ATrack[Sel].Status + [Notes];
+
+{ if Selected then
+ begin
MidiTrack := MidiFile.GetTrack(Sel);
if Track[Sel].Hear then
MidiTrack.OnMidiEvent := MidiFile1MidiEvent
@@ -225,12 +244,14 @@ begin
SDLK_DOWN:
begin
Inc(Sel);
- if Sel > High(ATrack) then Sel := 0;
+ if Sel > High(ATrack) then
+ Sel := 0;
end;
SDLK_UP:
begin
Dec(Sel);
- if Sel < 0 then Sel := High(ATrack);
+ if Sel < 0 then
+ Sel := High(ATrack);
end;
end;
end;
@@ -240,11 +261,15 @@ procedure TScreenEditConvert.AddLyric(Start: integer; Text: string);
var
N: integer;
begin
- for N := 0 to High(Note) do begin
- if Note[N].Start = Start then begin
+ for N := 0 to High(Note) do
+ begin
+ if Note[N].Start = Start then
+ begin
// check for new sentece
- if Copy(Text, 1, 1) = '\' then Delete(Text, 1, 1);
- if Copy(Text, 1, 1) = '/' then begin
+ if Copy(Text, 1, 1) = '\' then
+ Delete(Text, 1, 1);
+ if Copy(Text, 1, 1) = '/' then
+ begin
Delete(Text, 1, 1);
Note[N].NewSentence := true;
end;
@@ -279,11 +304,16 @@ begin
SetLength(Note, 0);
// extract notes
- for T := 0 to High(ATrack) do begin
-// if ATrack[T].Hear then begin
- if ((ATrack[T].Status div 1) and 1) = 1 then begin
- for N := 0 to High(ATrack[T].Note) do begin
- if (ATrack[T].Note[N].EventType = 9) and (ATrack[T].Note[N].Data2 > 0) then begin
+ for T := 0 to High(ATrack) do
+ begin
+// if ATrack[T].Hear then
+// begin
+ if Notes in ATrack[T].Status then
+ begin
+ for N := 0 to High(ATrack[T].Note) do
+ begin
+ if (ATrack[T].Note[N].EventType = 9) and (ATrack[T].Note[N].Data2 > 0) then
+ begin
Nu := Length(Note);
SetLength(Note, Nu + 1);
Note[Nu].Start := Round(ATrack[T].Note[N].Start / Ticks);
@@ -296,11 +326,16 @@ begin
end;
// extract lyrics
- for T := 0 to High(ATrack) do begin
-// if ATrack[T].Hear then begin
- if ((ATrack[T].Status div 2) and 1) = 1 then begin
- for N := 0 to High(ATrack[T].Note) do begin
- if (ATrack[T].Note[N].EventType = 15) then begin
+ for T := 0 to High(ATrack) do
+ begin
+// if ATrack[T].Hear then
+// begin
+ if Lyrics in ATrack[T].Status then
+ begin
+ for N := 0 to High(ATrack[T].Note) do
+ begin
+ if (ATrack[T].Note[N].EventType = 15) then
+ begin
// Log.LogStatus('<' + Track[T].Note[N].Str + '>', 'MIDI');
AddLyric(Round(ATrack[T].Note[N].Start / Ticks), ATrack[T].Note[N].Str);
end;
@@ -311,7 +346,8 @@ begin
// sort notes
for N := 0 to High(Note) do
for Nu := 0 to High(Note)-1 do
- if Note[Nu].Start > Note[Nu+1].Start then begin
+ if Note[Nu].Start > Note[Nu+1].Start then
+ begin
NoteTemp := Note[Nu];
Note[Nu] := Note[Nu+1];
Note[Nu+1] := NoteTemp;
@@ -331,8 +367,10 @@ begin
N := 0;
Lines.Line[C].HighNote := -1;
- for Nu := 0 to High(Note) do begin
- if Note[Nu].NewSentence then begin // nowa linijka
+ for Nu := 0 to High(Note) do
+ begin
+ if Note[Nu].NewSentence then // new line
+ begin
SetLength(Lines.Line, Length(Lines.Line)+1);
Lines.Number := Lines.Number + 1;
Lines.High := Lines.High + 1;
@@ -363,10 +401,10 @@ begin
end;
end;
- // tworzy miejsce na nowa nute
+ // create space for new note
SetLength(Lines.Line[C].Note, Length(Lines.Line[C].Note)+1);
- // dopisuje
+ // initialize note
Lines.Line[C].Note[N].Start := Note[Nu].Start;
Lines.Line[C].Note[N].Length := Note[Nu].Len;
Lines.Line[C].Note[N].Tone := Note[Nu].Tone;
@@ -383,8 +421,10 @@ var
begin
Result := 0;
for T := 0 to High(ATrack) do
-// if ATrack[T].Hear then Inc(Result);
- if ((ATrack[T].Status div 1) and 1) = 1 then Inc(Result);
+// if ATrack[T].Hear then
+// Inc(Result);
+ if Notes in ATrack[T].Status then
+ Inc(Result);
end;
{$IFDEF UseMIDIPort}
@@ -428,7 +468,8 @@ begin
MidiFile := TMidiFile.Create(nil);
{$ENDIF}
- for P := 0 to 100 do begin
+ for P := 0 to 100 do
+ begin
ColR[P] := Random(10)/10;
ColG[P] := Random(10)/10;
ColB[P] := Random(10)/10;
@@ -464,13 +505,15 @@ begin
BPM := MidiFile.Bpm;
Ticks := MidiFile.TicksPerQuarter / 4;
-{ for T := 0 to MidiFile.NumberOfTracks-1 do begin
+{ for T := 0 to MidiFile.NumberOfTracks-1 do
+ begin
SetLength(Track, Length(Track)+1);
MidiTrack := MidiFile.GetTrack(T);
MidiTrack.OnMidiEvent := MidiFile1MidiEvent;
Track[T].Name := MidiTrack.getName;
- for N := 0 to MidiTrack.getEventCount-1 do begin
+ for N := 0 to MidiTrack.getEventCount-1 do
+ begin
SetLength(Track[T].Note, Length(Track[T].Note)+1);
MidiEvent := MidiTrack.GetEvent(N);
Track[T].Note[N].Start := MidiEvent.time;
@@ -487,20 +530,21 @@ begin
end;
end;}
-
SetLength(Channel, 16);
for T := 0 to 15 do
begin
Channel[T].Name := IntToStr(T+1);
SetLength(Channel[T].Note, 0);
- Channel[T].Status := 0;
+ Channel[T].Status := [];
end;
- for T := 0 to MidiFile.NumberOfTracks-1 do begin
+ for T := 0 to MidiFile.NumberOfTracks-1 do
+ begin
MidiTrack := MidiFile.GetTrack(T);
MidiTrack.OnMidiEvent := MidiFile1MidiEvent;
- for N := 0 to MidiTrack.getEventCount-1 do begin
+ for N := 0 to MidiTrack.getEventCount-1 do
+ begin
MidiEvent := MidiTrack.GetEvent(N);
C := MidiEvent.event and 15;
@@ -530,8 +574,8 @@ end;
function TScreenEditConvert.Draw: boolean;
var
- Pet: integer;
- Pet2: integer;
+ Count: integer;
+ Count2: integer;
Bottom: real;
X: real;
Y: real;
@@ -544,7 +588,8 @@ begin
Y := 100;
H := Length(ATrack)*40;
- if H > 480 then H := 480;
+ if H > 480 then
+ H := 480;
Bottom := Y + H;
YSkip := H / Length(ATrack);
@@ -553,18 +598,21 @@ begin
DrawQuad(10, Y+Sel*YSkip, 780, YSkip, 0.8, 0.8, 0.8);
// selected - now me use Status System
- for Pet := 0 to High(ATrack) do
- if ATrack[Pet].Hear then
- DrawQuad(10, Y+Pet*YSkip, 50, YSkip, 0.8, 0.3, 0.3);
+ for Count := 0 to High(ATrack) do
+ if ATrack[Count].Hear then
+ DrawQuad(10, Y+Count*YSkip, 50, YSkip, 0.8, 0.3, 0.3);
glColor3f(0, 0, 0);
- for Pet := 0 to High(ATrack) do begin
- if ((ATrack[Pet].Status div 1) and 1) = 1 then begin
- SetFontPos(25, Y + Pet*YSkip + 10);
+ for Count := 0 to High(ATrack) do
+ begin
+ if Notes in ATrack[Count].Status then
+ begin
+ SetFontPos(25, Y + Count*YSkip + 10);
SetFontSize(15);
glPrint('N');
end;
- if ((ATrack[Pet].Status div 2) and 1) = 1 then begin
- SetFontPos(40, Y + Pet*YSkip + 10);
+ if Lyrics in ATrack[Count].Status then
+ begin
+ SetFontPos(40, Y + Count*YSkip + 10);
SetFontSize(15);
glPrint('L');
end;
@@ -574,21 +622,23 @@ begin
DrawLine(60, Y, 60, Bottom, 0, 0, 0);
DrawLine(790, Y, 790, Bottom, 0, 0, 0);
- for Pet := 0 to Length(ATrack) do
- DrawLine(10, Y+Pet*YSkip, 790, Y+Pet*YSkip, 0, 0, 0);
+ for Count := 0 to Length(ATrack) do
+ DrawLine(10, Y+Count*YSkip, 790, Y+Count*YSkip, 0, 0, 0);
- for Pet := 0 to High(ATrack) do begin
- SetFontPos(11, Y + 10 + Pet*YSkip);
+ for Count := 0 to High(ATrack) do
+ begin
+ SetFontPos(11, Y + 10 + Count*YSkip);
SetFontSize(15);
- glPrint(ATrack[Pet].Name);
+ glPrint(ATrack[Count].Name);
end;
- for Pet := 0 to High(ATrack) do
- for Pet2 := 0 to High(ATrack[Pet].Note) do begin
- if ATrack[Pet].Note[Pet2].EventType = 9 then
- DrawQuad(60 + ATrack[Pet].Note[Pet2].Start/Len * 725, Y + (Pet+1)*YSkip - ATrack[Pet].Note[Pet2].Data1*35/127, 3, 3, ColR[Pet], ColG[Pet], ColB[Pet]);
- if ATrack[Pet].Note[Pet2].EventType = 15 then
- DrawLine(60 + ATrack[Pet].Note[Pet2].Start/Len * 725, Y + 0.75 * YSkip + Pet*YSkip, 60 + ATrack[Pet].Note[Pet2].Start/Len * 725, Y + YSkip + Pet*YSkip, ColR[Pet], ColG[Pet], ColB[Pet]);
+ for Count := 0 to High(ATrack) do
+ for Count2 := 0 to High(ATrack[Count].Note) do
+ begin
+ if ATrack[Count].Note[Count2].EventType = 9 then
+ DrawQuad(60 + ATrack[Count].Note[Count2].Start/Len * 725, Y + (Count+1)*YSkip - ATrack[Count].Note[Count2].Data1*35/127, 3, 3, ColR[Count], ColG[Count], ColB[Count]);
+ if ATrack[Count].Note[Count2].EventType = 15 then
+ DrawLine(60 + ATrack[Count].Note[Count2].Start/Len * 725, Y + 0.75 * YSkip + Count*YSkip, 60 + ATrack[Count].Note[Count2].Start/Len * 725, Y + YSkip + Count*YSkip, ColR[Count], ColG[Count], ColB[Count]);
end;
// playing line
diff --git a/unicode/src/screens/UScreenEditHeader.pas b/unicode/src/screens/UScreenEditHeader.pas
index 10480299..2548069d 100644
--- a/unicode/src/screens/UScreenEditHeader.pas
+++ b/unicode/src/screens/UScreenEditHeader.pas
@@ -73,7 +73,7 @@ type
constructor Create; override;
procedure onShow; override;
- function ParseInput(PressedKey: Cardinal; CharCode: UCS4Char; PressedDown: Boolean): Boolean; override;
+ function ParseInput(PressedKey: cardinal; CharCode: UCS4Char; PressedDown: boolean): boolean; override;
{ function Draw: boolean; override;
procedure Finish;}
end;
@@ -89,13 +89,13 @@ uses
UTexture,
UUnicodeUtils;
-function TScreenEditHeader.ParseInput(PressedKey: Cardinal; CharCode: UCS4Char; PressedDown: Boolean): Boolean;
+function TScreenEditHeader.ParseInput(PressedKey: cardinal; CharCode: UCS4Char; PressedDown: boolean): boolean;
var
T: integer;
begin
Result := true;
- If (PressedDown) Then begin // Key Down
- // check normal keys
+ if (PressedDown) then // Key Down
+ begin // check normal keys
case UCS4UpperCase(CharCode) of
Ord('Q'):
begin
@@ -115,7 +115,8 @@ begin
SDLK_RETURN:
begin
- if Interaction = 1 then begin
+ if Interaction = 1 then
+ begin
// Save;
end;
end;
@@ -124,14 +125,14 @@ begin
begin
case Interaction of
0..0: InteractNext;
- 1: Interaction := 0;
+ 1: Interaction := 0;
end;
end;
SDLK_LEFT:
begin
case Interaction of
- 0: Interaction := 1;
+ 0: Interaction := 1;
1..1: InteractPrev;
end;
end;
@@ -139,25 +140,26 @@ begin
SDLK_DOWN:
begin
case Interaction of
- 0..1: Interaction := 2;
- 2..12: InteractNext;
- 13: Interaction := 0;
+ 0..1: Interaction := 2;
+ 2..12: InteractNext;
+ 13: Interaction := 0;
end;
end;
SDLK_UP:
begin
case Interaction of
- 0..1: Interaction := 13;
- 2: Interaction := 0;
- 3..13: InteractPrev;
+ 0..1: Interaction := 13;
+ 2: Interaction := 0;
+ 3..13: InteractPrev;
end;
end;
SDLK_BACKSPACE:
begin
T := Interaction - 2 + TextTitle;
- if (Interaction >= 2) and (Interaction <= 13) and (Length(Text[T].Text) >= 1) then begin
+ if (Interaction >= 2) and (Interaction <= 13) and (Length(Text[T].Text) >= 1) then
+ begin
Text[T].DeleteLastLetter;
SetRoundButtons;
end;
@@ -167,7 +169,8 @@ begin
case CharCode of
32..255:
begin
- if (Interaction >= 2) and (Interaction <= 13) then begin
+ if (Interaction >= 2) and (Interaction <= 13) then
+ begin
Text[Interaction - 2 + TextTitle].Text :=
Text[Interaction - 2 + TextTitle].Text + UCS4ToUTF8String(CharCode);
SetRoundButtons;
@@ -252,7 +255,8 @@ procedure TScreenEditHeader.onShow;
begin
inherited;
-{ if FileExists(FileName) then begin // load file
+{ if FileExists(FileName) then // load file
+ begin
CurrentSong.FileName := FileName;
SkanujPlik(CurrentSong);
@@ -281,29 +285,33 @@ end;
(*function TScreenEdit.Draw: boolean;
var
- Min: integer;
- Sec: integer;
- Tekst: string;
- Pet: integer;
- AktBeat: integer;
+ Min: integer;
+ Sec: integer;
+ Count: integer;
+ AktBeat: integer;
begin
{ glClearColor(1,1,1,1);
// control music
- if PlaySentence then begin
+ if PlaySentence then
+ begin
// stop the music
- if (Music.Position > PlayStopTime) then begin
+ if (Music.Position > PlayStopTime) then
+ begin
Music.Stop;
PlaySentence := false;
end;
// click
- if (Click) and (PlaySentence) then begin
+ if (Click) and (PlaySentence) then
+ begin
AktBeat := Floor(CurrentSong.BPM[0].BPM * (Music.Position - CurrentSong.GAP / 1000) / 60);
Text[TextDebug].Text := IntToStr(AktBeat);
- if AktBeat <> LastClick then begin
- for Pet := 0 to Czesci[0].Czesc[Czesci[0].Akt].HighNut do
- if (Czesci[0].Czesc[Czesci[0].Akt].Nuta[Pet].Start = AktBeat) then begin
+ if AktBeat <> LastClick then
+ begin
+ for Count := 0 to Czesci[0].Czesc[Czesci[0].Akt].HighNut do
+ if (Czesci[0].Czesc[Czesci[0].Akt].Nuta[Count].Start = AktBeat) then
+ begin
Music.PlayClick;
LastClick := AktBeat;
end;
@@ -322,7 +330,7 @@ begin
Text[TextNStart].Text := IntToStr(Czesci[0].Czesc[Czesci[0].Akt].Nuta[AktNuta].Start);
Text[TextNDlugosc].Text := IntToStr(Czesci[0].Czesc[Czesci[0].Akt].Nuta[AktNuta].Dlugosc);
Text[TextNTon].Text := IntToStr(Czesci[0].Czesc[Czesci[0].Akt].Nuta[AktNuta].Ton);
- Text[TextNText].Text := Czesci[0].Czesc[Czesci[0].Akt].Nuta[AktNuta].Tekst;
+ Text[TextNText].Text := Czesci[0].Czesc[Czesci[0].Akt].Nuta[AktNuta].Text;
// draw static menu
inherited Draw;
@@ -339,37 +347,52 @@ end;*)
procedure TScreenEditHeader.SetRoundButtons;
begin
- if Length(Text[TextTitle].Text) > 0 then Static[StaticTitle].Visible := true
- else Static[StaticTitle].Visible := false;
-
- if Length(Text[TextArtist].Text) > 0 then Static[StaticArtist].Visible := true
- else Static[StaticArtist].Visible := false;
-
- if Length(Text[TextMp3].Text) > 0 then Static[StaticMp3].Visible := true
- else Static[StaticMp3].Visible := false;
-
- if Length(Text[TextBackground].Text) > 0 then Static[StaticBackground].Visible := true
- else Static[StaticBackground].Visible := false;
-
- if Length(Text[TextVideo].Text) > 0 then Static[StaticVideo].Visible := true
- else Static[StaticVideo].Visible := false;
+ if Length(Text[TextTitle].Text) > 0 then
+ Static[StaticTitle].Visible := true
+ else
+ Static[StaticTitle].Visible := false;
+
+ if Length(Text[TextArtist].Text) > 0 then
+ Static[StaticArtist].Visible := true
+ else
+ Static[StaticArtist].Visible := false;
+
+ if Length(Text[TextMp3].Text) > 0 then
+ Static[StaticMp3].Visible := true
+ else
+ Static[StaticMp3].Visible := false;
+
+ if Length(Text[TextBackground].Text) > 0 then
+ Static[StaticBackground].Visible := true
+ else
+ Static[StaticBackground].Visible := false;
+
+ if Length(Text[TextVideo].Text) > 0 then
+ Static[StaticVideo].Visible := true
+ else
+ Static[StaticVideo].Visible := false;
try
StrToFloat(Text[TextVideoGAP].Text);
- if StrToFloat(Text[TextVideoGAP].Text)<> 0 then Static[StaticVideoGAP].Visible := true
- else Static[StaticVideoGAP].Visible := false;
+ if StrToFloat(Text[TextVideoGAP].Text)<> 0 then
+ Static[StaticVideoGAP].Visible := true
+ else
+ Static[StaticVideoGAP].Visible := false;
except
Static[StaticVideoGAP].Visible := false;
end;
- if LowerCase(Text[TextRelative].Text) = 'yes' then Static[StaticRelative].Visible := true
- else Static[StaticRelative].Visible := false;
+ if LowerCase(Text[TextRelative].Text) = 'yes' then
+ Static[StaticRelative].Visible := true
+ else
+ Static[StaticRelative].Visible := false;
try
StrToInt(Text[TextResolution].Text);
- if (StrToInt(Text[TextResolution].Text) <> 0) and (StrToInt(Text[TextResolution].Text) >= 1)
- then Static[StaticResolution].Visible := true
- else Static[StaticResolution].Visible := false;
+ if (StrToInt(Text[TextResolution].Text) <> 0) and (StrToInt(Text[TextResolution].Text) >= 1) then
+ Static[StaticResolution].Visible := true
+ else
+ Static[StaticResolution].Visible := false;
except
Static[StaticResolution].Visible := false;
end;
@@ -384,8 +407,10 @@ begin
// start
try
StrToFloat(Text[TextStart].Text);
- if (StrToFloat(Text[TextStart].Text) > 0) then Static[StaticStart].Visible := true
- else Static[StaticStart].Visible := false;
+ if (StrToFloat(Text[TextStart].Text) > 0) then
+ Static[StaticStart].Visible := true
+ else
+ Static[StaticStart].Visible := false;
except
Static[StaticStart].Visible := false;
end;
@@ -401,8 +426,10 @@ begin
// BPM
try
StrToFloat(Text[TextBPM].Text);
- if (StrToFloat(Text[TextBPM].Text) > 0) then Static[StaticBPM].Visible := true
- else Static[StaticBPM].Visible := false;
+ if (StrToFloat(Text[TextBPM].Text) > 0) then
+ Static[StaticBPM].Visible := true
+ else
+ Static[StaticBPM].Visible := false;
except
Static[StaticBPM].Visible := false;
end;
diff --git a/unicode/src/screens/UScreenEditSub.pas b/unicode/src/screens/UScreenEditSub.pas
index e3adeaf8..a892651a 100644
--- a/unicode/src/screens/UScreenEditSub.pas
+++ b/unicode/src/screens/UScreenEditSub.pas
@@ -57,7 +57,7 @@ type
TScreenEditSub = class(TMenu)
private
//Variable is True if no Song is loaded
- Error: Boolean;
+ Error: boolean;
TextNote: integer;
TextSentence: integer;
@@ -80,18 +80,18 @@ type
CopySrc: integer;
{$IFDEF UseMIDIPort}
- MidiOut: TMidiOutput;
+ MidiOut: TMidiOutput;
{$endif}
- MidiStart: real;
- MidiStop: real;
- MidiTime: real;
- MidiPos: real;
- MidiLastNote: integer;
+ MidiStart: real;
+ MidiStop: real;
+ MidiTime: real;
+ MidiPos: real;
+ MidiLastNote: integer;
- TextEditMode: boolean;
+ TextEditMode: boolean;
- Lyric: TEditorLyrics;
+ Lyric: TEditorLyrics;
procedure DivideBPM;
procedure MultiplyBPM;
@@ -111,14 +111,14 @@ type
procedure CopySentence(Src, Dst: integer);
procedure CopySentences(Src, Dst, Num: integer);
//Note Name Mod
- function GetNoteName(Note: Integer): String;
+ function GetNoteName(Note: integer): string;
public
Tex_Background: TTexture;
FadeOut: boolean;
constructor Create; override;
procedure onShow; override;
- function ParseInput(PressedKey: Cardinal; CharCode: UCS4Char; PressedDown: Boolean): Boolean; override;
- function ParseInputEditText(PressedKey: Cardinal; CharCode: UCS4Char; PressedDown: Boolean): Boolean;
+ function ParseInput(PressedKey: cardinal; CharCode: UCS4Char; PressedDown: boolean): boolean; override;
+ function ParseInputEditText(PressedKey: cardinal; CharCode: UCS4Char; PressedDown: boolean): boolean;
function Draw: boolean; override;
procedure onHide; override;
end;
@@ -128,29 +128,32 @@ implementation
uses
UGraphic,
UDraw,
- UMain,
+ UNote,
USkins,
ULanguage,
UUnicodeUtils;
// Method for input parsing. If False is returned, GetNextWindow
// should be checked to know the next window to load;
-function TScreenEditSub.ParseInput(PressedKey: Cardinal; CharCode: UCS4Char; PressedDown: Boolean): Boolean;
+function TScreenEditSub.ParseInput(PressedKey: cardinal; CharCode: UCS4Char; PressedDown: boolean): boolean;
var
SDL_ModState: Word;
R: real;
begin
Result := true;
- if TextEditMode then begin
+ if TextEditMode then
+ begin
Result := ParseInputEditText(PressedKey, CharCode, PressedDown);
- end else begin
+ end
+ else
+ begin
SDL_ModState := SDL_GetModState and (KMOD_LSHIFT + KMOD_RSHIFT
+ KMOD_LCTRL + KMOD_RCTRL + KMOD_LALT + KMOD_RALT {+ KMOD_CAPS});
- If (PressedDown) then begin // Key Down
- // check normal keys
+ if (PressedDown) then // Key Down
+ begin // check normal keys
case UCS4UpperCase(CharCode) of
Ord('Q'):
begin
@@ -202,14 +205,16 @@ begin
Ord('V'):
begin
// Paste text
- if SDL_ModState = KMOD_LCTRL then begin
+ if SDL_ModState = KMOD_LCTRL then
+ begin
if Lines[0].Line[Lines[0].Current].HighNote >= Lines[0].Line[CopySrc].HighNote then
PasteText
else
Log.LogStatus('PasteText: invalid range', 'TScreenEditSub.ParseInput');
end;
- if SDL_ModState = KMOD_LCTRL + KMOD_LSHIFT then begin
+ if SDL_ModState = KMOD_LCTRL + KMOD_LSHIFT then
+ begin
CopySentence(CopySrc, Lines[0].Current);
end;
end;
@@ -328,20 +333,23 @@ begin
SDLK_4:
begin
- if SDL_ModState = KMOD_LCTRL + KMOD_LSHIFT then begin
+ if SDL_ModState = KMOD_LCTRL + KMOD_LSHIFT then
+ begin
CopySentence(CopySrc, Lines[0].Current);
CopySentence(CopySrc+1, Lines[0].Current+1);
CopySentence(CopySrc+2, Lines[0].Current+2);
CopySentence(CopySrc+3, Lines[0].Current+3);
end;
- if SDL_ModState = KMOD_LCTRL + KMOD_LSHIFT + KMOD_LALT then begin
+ if SDL_ModState = KMOD_LCTRL + KMOD_LSHIFT + KMOD_LALT then
+ begin
CopySentences(CopySrc, Lines[0].Current, 4);
end;
end;
SDLK_5:
begin
- if SDL_ModState = KMOD_LCTRL + KMOD_LSHIFT then begin
+ if SDL_ModState = KMOD_LCTRL + KMOD_LSHIFT then
+ begin
CopySentence(CopySrc, Lines[0].Current);
CopySentence(CopySrc+1, Lines[0].Current+1);
CopySentence(CopySrc+2, Lines[0].Current+2);
@@ -349,7 +357,8 @@ begin
CopySentence(CopySrc+4, Lines[0].Current+4);
end;
- if SDL_ModState = KMOD_LCTRL + KMOD_LSHIFT + KMOD_LALT then begin
+ if SDL_ModState = KMOD_LCTRL + KMOD_LSHIFT + KMOD_LALT then
+ begin
CopySentences(CopySrc, Lines[0].Current, 5);
end;
end;
@@ -391,19 +400,22 @@ begin
SDLK_SLASH:
begin
- if SDL_ModState = 0 then begin
+ if SDL_ModState = 0 then
+ begin
// Insert start of sentece
if CurrentNote > 0 then
DivideSentence;
end;
- if SDL_ModState = KMOD_LSHIFT then begin
+ if SDL_ModState = KMOD_LSHIFT then
+ begin
// Join next sentence with current
- if Lines[0].Current < Lines[0].High then
+ if Lines[0].Current < Lines[0].High then
JoinSentence;
end;
- if SDL_ModState = KMOD_LCTRL then begin
+ if SDL_ModState = KMOD_LCTRL then
+ begin
// divide note
DivideNote;
end;
@@ -435,13 +447,10 @@ begin
begin
end;
- SDLK_LCTRL:
- begin
- end;
-
SDLK_DELETE:
begin
- if SDL_ModState = KMOD_LCTRL then begin
+ if SDL_ModState = KMOD_LCTRL then
+ begin
// moves text to right in current sentence
DeleteNote;
end;
@@ -456,29 +465,36 @@ begin
SDLK_RIGHT:
begin
// right
- if SDL_ModState = 0 then begin
+ if SDL_ModState = 0 then
+ begin
Lines[0].Line[Lines[0].Current].Note[CurrentNote].Color := 0;
Inc(CurrentNote);
- if CurrentNote > Lines[0].Line[Lines[0].Current].HighNote then CurrentNote := 0;
+ if CurrentNote > Lines[0].Line[Lines[0].Current].HighNote then
+ CurrentNote := 0;
Lines[0].Line[Lines[0].Current].Note[CurrentNote].Color := 1;
Lyric.Selected := CurrentNote;
end;
// ctrl + right
- if SDL_ModState = KMOD_LCTRL then begin
- if Lines[0].Line[Lines[0].Current].Note[CurrentNote].Length > 1 then begin
+ if SDL_ModState = KMOD_LCTRL then
+ begin
+ if Lines[0].Line[Lines[0].Current].Note[CurrentNote].Length > 1 then
+ begin
Dec(Lines[0].Line[Lines[0].Current].Note[CurrentNote].Length);
Inc(Lines[0].Line[Lines[0].Current].Note[CurrentNote].Start);
- if CurrentNote = 0 then begin
+ if CurrentNote = 0 then
+ begin
Inc(Lines[0].Line[Lines[0].Current].Start);
end;
end;
end;
// shift + right
- if SDL_ModState = KMOD_LSHIFT then begin
+ if SDL_ModState = KMOD_LSHIFT then
+ begin
Inc(Lines[0].Line[Lines[0].Current].Note[CurrentNote].Start);
- if CurrentNote = 0 then begin
+ if CurrentNote = 0 then
+ begin
Inc(Lines[0].Line[Lines[0].Current].Start);
end;
if CurrentNote = Lines[0].Line[Lines[0].Current].HighNote then
@@ -486,14 +502,16 @@ begin
end;
// alt + right
- if SDL_ModState = KMOD_LALT then begin
+ if SDL_ModState = KMOD_LALT then
+ begin
Inc(Lines[0].Line[Lines[0].Current].Note[CurrentNote].Length);
if CurrentNote = Lines[0].Line[Lines[0].Current].HighNote then
Inc(Lines[0].Line[Lines[0].Current].End_);
end;
// alt + ctrl + shift + right = move all from cursor to right
- if SDL_ModState = KMOD_LALT + KMOD_LCTRL + KMOD_LSHIFT then begin
+ if SDL_ModState = KMOD_LALT + KMOD_LCTRL + KMOD_LSHIFT then
+ begin
MoveAllToEnd(1);
end;
@@ -502,29 +520,35 @@ begin
SDLK_LEFT:
begin
// left
- if SDL_ModState = 0 then begin
+ if SDL_ModState = 0 then
+ begin
Lines[0].Line[Lines[0].Current].Note[CurrentNote].Color := 0;
Dec(CurrentNote);
- if CurrentNote = -1 then CurrentNote := Lines[0].Line[Lines[0].Current].HighNote;
+ if CurrentNote = -1 then
+ CurrentNote := Lines[0].Line[Lines[0].Current].HighNote;
Lines[0].Line[Lines[0].Current].Note[CurrentNote].Color := 1;
Lyric.Selected := CurrentNote;
end;
// ctrl + left
- if SDL_ModState = KMOD_LCTRL then begin
+ if SDL_ModState = KMOD_LCTRL then
+ begin
Dec(Lines[0].Line[Lines[0].Current].Note[CurrentNote].Start);
Inc(Lines[0].Line[Lines[0].Current].Note[CurrentNote].Length);
- if CurrentNote = 0 then begin
+ if CurrentNote = 0 then
+ begin
Dec(Lines[0].Line[Lines[0].Current].Start);
end;
end;
// shift + left
- if SDL_ModState = KMOD_LSHIFT then begin
+ if SDL_ModState = KMOD_LSHIFT then
+ begin
Dec(Lines[0].Line[Lines[0].Current].Note[CurrentNote].Start);
// resizing sentences
- if CurrentNote = 0 then begin
+ if CurrentNote = 0 then
+ begin
Dec(Lines[0].Line[Lines[0].Current].Start);
end;
@@ -534,8 +558,10 @@ begin
end;
// alt + left
- if SDL_ModState = KMOD_LALT then begin
- if Lines[0].Line[Lines[0].Current].Note[CurrentNote].Length > 1 then begin
+ if SDL_ModState = KMOD_LALT then
+ begin
+ if Lines[0].Line[Lines[0].Current].Note[CurrentNote].Length > 1 then
+ begin
Dec(Lines[0].Line[Lines[0].Current].Note[CurrentNote].Length);
if CurrentNote = Lines[0].Line[Lines[0].Current].HighNote then
Dec(Lines[0].Line[Lines[0].Current].End_);
@@ -543,7 +569,8 @@ begin
end;
// alt + ctrl + shift + right = move all from cursor to left
- if SDL_ModState = KMOD_LALT + KMOD_LCTRL + KMOD_LSHIFT then begin
+ if SDL_ModState = KMOD_LALT + KMOD_LCTRL + KMOD_LSHIFT then
+ begin
MoveAllToEnd(-1);
end;
@@ -553,7 +580,8 @@ begin
begin
// skip to next sentence
- if SDL_ModState = 0 then begin {$IFDEF UseMIDIPort}
+ if SDL_ModState = 0 then
+ begin {$IFDEF UseMIDIPort}
MidiOut.PutShort($81, Lines[0].Line[Lines[0].Current].Note[MidiLastNote].Tone + 60, 127);
PlaySentenceMidi := false;
{$endif}
@@ -561,7 +589,8 @@ begin
Lines[0].Line[Lines[0].Current].Note[CurrentNote].Color := 0;
Inc(Lines[0].Current);
CurrentNote := 0;
- if Lines[0].Current > Lines[0].High then Lines[0].Current := 0;
+ if Lines[0].Current > Lines[0].High then
+ Lines[0].Current := 0;
Lines[0].Line[Lines[0].Current].Note[CurrentNote].Color := 1;
Lyric.AddLine(Lines[0].Current);
@@ -571,7 +600,8 @@ begin
end;
// decrease tone
- if SDL_ModState = KMOD_LCTRL then begin
+ if SDL_ModState = KMOD_LCTRL then
+ begin
TransposeNote(-1);
end;
@@ -581,7 +611,8 @@ begin
begin
// skip to previous sentence
- if SDL_ModState = 0 then begin
+ if SDL_ModState = 0 then
+ begin
{$IFDEF UseMIDIPort}
MidiOut.PutShort($81, Lines[0].Line[Lines[0].Current].Note[MidiLastNote].Tone + 60, 127);
PlaySentenceMidi := false;
@@ -590,7 +621,8 @@ begin
Lines[0].Line[Lines[0].Current].Note[CurrentNote].Color := 0;
Dec(Lines[0].Current);
CurrentNote := 0;
- if Lines[0].Current = -1 then Lines[0].Current := Lines[0].High;
+ if Lines[0].Current = -1 then
+ Lines[0].Current := Lines[0].High;
Lines[0].Line[Lines[0].Current].Note[CurrentNote].Color := 1;
Lyric.AddLine(Lines[0].Current);
@@ -600,7 +632,8 @@ begin
end;
// increase tone
- if SDL_ModState = KMOD_LCTRL then begin
+ if SDL_ModState = KMOD_LCTRL then
+ begin
TransposeNote(1);
end;
end;
@@ -610,7 +643,7 @@ begin
end; // if
end;
-function TScreenEditSub.ParseInputEditText(PressedKey: Cardinal; CharCode: UCS4Char; PressedDown: Boolean): Boolean;
+function TScreenEditSub.ParseInputEditText(PressedKey: cardinal; CharCode: UCS4Char; PressedDown: boolean): boolean;
var
SDL_ModState: Word;
begin
@@ -620,7 +653,7 @@ begin
SDL_ModState := SDL_GetModState and (KMOD_LSHIFT + KMOD_RSHIFT
+ KMOD_LCTRL + KMOD_RCTRL + KMOD_LALT + KMOD_RALT {+ KMOD_CAPS});
- If (PressedDown) Then
+ if (PressedDown) then
begin // Key Down
case PressedKey of
@@ -648,10 +681,12 @@ begin
SDLK_RIGHT:
begin
// right
- if SDL_ModState = 0 then begin
+ if SDL_ModState = 0 then
+ begin
Lines[0].Line[Lines[0].Current].Note[CurrentNote].Color := 0;
Inc(CurrentNote);
- if CurrentNote > Lines[0].Line[Lines[0].Current].HighNote then CurrentNote := 0;
+ if CurrentNote > Lines[0].Line[Lines[0].Current].HighNote then
+ CurrentNote := 0;
Lines[0].Line[Lines[0].Current].Note[CurrentNote].Color := 1;
Lyric.Selected := CurrentNote;
end;
@@ -659,10 +694,12 @@ begin
SDLK_LEFT:
begin
// left
- if SDL_ModState = 0 then begin
+ if SDL_ModState = 0 then
+ begin
Lines[0].Line[Lines[0].Current].Note[CurrentNote].Color := 0;
Dec(CurrentNote);
- if CurrentNote = -1 then CurrentNote := Lines[0].Line[Lines[0].Current].HighNote;
+ if CurrentNote = -1 then
+ CurrentNote := Lines[0].Line[Lines[0].Current].HighNote;
Lines[0].Line[Lines[0].Current].Note[CurrentNote].Color := 1;
Lyric.Selected := CurrentNote;
end;
@@ -687,11 +724,13 @@ var
N: integer;
begin
CurrentSong.BPM[0].BPM := CurrentSong.BPM[0].BPM / 2;
- for C := 0 to Lines[0].High do begin
- Lines[0].Line[C].Start := Lines[0].Line[C].Start div 2;
- Lines[0].Line[C].End_ := Lines[0].Line[C].End_ div 2;
- for N := 0 to Lines[0].Line[C].HighNote do begin
- Lines[0].Line[C].Note[N].Start := Lines[0].Line[C].Note[N].Start div 2;
+ for C := 0 to Lines[0].High do
+ begin
+ Lines[0].Line[C].Start := Lines[0].Line[C].Start div 2;
+ Lines[0].Line[C].End_ := Lines[0].Line[C].End_ div 2;
+ for N := 0 to Lines[0].Line[C].HighNote do
+ begin
+ Lines[0].Line[C].Note[N].Start := Lines[0].Line[C].Note[N].Start div 2;
Lines[0].Line[C].Note[N].Length := Round(Lines[0].Line[C].Note[N].Length / 2);
end; // N
end; // C
@@ -703,11 +742,13 @@ var
N: integer;
begin
CurrentSong.BPM[0].BPM := CurrentSong.BPM[0].BPM * 2;
- for C := 0 to Lines[0].High do begin
- Lines[0].Line[C].Start := Lines[0].Line[C].Start * 2;
- Lines[0].Line[C].End_ := Lines[0].Line[C].End_ * 2;
- for N := 0 to Lines[0].Line[C].HighNote do begin
- Lines[0].Line[C].Note[N].Start := Lines[0].Line[C].Note[N].Start * 2;
+ for C := 0 to Lines[0].High do
+ begin
+ Lines[0].Line[C].Start := Lines[0].Line[C].Start * 2;
+ Lines[0].Line[C].End_ := Lines[0].Line[C].End_ * 2;
+ for N := 0 to Lines[0].Line[C].HighNote do
+ begin
+ Lines[0].Line[C].Note[N].Start := Lines[0].Line[C].Note[N].Start * 2;
Lines[0].Line[C].Note[N].Length := Lines[0].Line[C].Note[N].Length * 2;
end; // N
end; // C
@@ -724,7 +765,8 @@ begin
for N := 0 to Lines[0].Line[C].HighNut do
Lines[0].Line[C].Note[N].Text := UTF8LowerCase(Lines[0].Line[C].Note[N].Text);}
- for C := 0 to Lines[0].High do begin
+ for C := 0 to Lines[0].High do
+ begin
S := AnsiUpperCase(Copy(Lines[0].Line[C].Note[0].Text, 1, 1));
S := S + Copy(Lines[0].Line[C].Note[0].Text, 2, Length(Lines[0].Line[C].Note[0].Text)-1);
Lines[0].Line[C].Note[0].Text := S;
@@ -736,33 +778,39 @@ var
C: integer;
N: integer;
begin
- for C := 0 to Lines[0].High do begin
+ for C := 0 to Lines[0].High do
+ begin
// correct starting spaces in the first word
while Copy(Lines[0].Line[C].Note[0].Text, 1, 1) = ' ' do
Lines[0].Line[C].Note[0].Text := Copy(Lines[0].Line[C].Note[0].Text, 2, 100);
// move spaces on the start to the end of the previous note
- for N := 1 to Lines[0].Line[C].HighNote do begin
- while (Copy(Lines[0].Line[C].Note[N].Text, 1, 1) = ' ') do begin
+ for N := 1 to Lines[0].Line[C].HighNote do
+ begin
+ while (Copy(Lines[0].Line[C].Note[N].Text, 1, 1) = ' ') do
+ begin
Lines[0].Line[C].Note[N].Text := Copy(Lines[0].Line[C].Note[N].Text, 2, 100);
Lines[0].Line[C].Note[N-1].Text := Lines[0].Line[C].Note[N-1].Text + ' ';
end;
end; // N
// correct '-' to '- '
- for N := 0 to Lines[0].Line[C].HighNote do begin
+ for N := 0 to Lines[0].Line[C].HighNote do
+ begin
if Lines[0].Line[C].Note[N].Text = '-' then
Lines[0].Line[C].Note[N].Text := '- ';
end; // N
// add space to the previous note when the current word is '- '
- for N := 1 to Lines[0].Line[C].HighNote do begin
+ for N := 1 to Lines[0].Line[C].HighNote do
+ begin
if Lines[0].Line[C].Note[N].Text = '- ' then
Lines[0].Line[C].Note[N-1].Text := Lines[0].Line[C].Note[N-1].Text + ' ';
end; // N
// correct too many spaces at the end of note
- for N := 0 to Lines[0].Line[C].HighNote do begin
+ for N := 0 to Lines[0].Line[C].HighNote do
+ begin
while Copy(Lines[0].Line[C].Note[N].Text, Length(Lines[0].Line[C].Note[N].Text)-1, 2) = ' ' do
Lines[0].Line[C].Note[N].Text := Copy(Lines[0].Line[C].Note[N].Text, 1, Length(Lines[0].Line[C].Note[N].Text)-1);
end; // N
@@ -782,8 +830,10 @@ var
Min: integer;
Max: integer;
begin
- for C := 1 to Lines[0].High do begin
- with Lines[0].Line[C-1] do begin
+ for C := 1 to Lines[0].High do
+ begin
+ with Lines[0].Line[C-1] do
+ begin
Min := Note[HighNote].Start + Note[HighNote].Length;
Max := Lines[0].Line[C].Note[0].Start;
case (Max - Min) of
@@ -829,15 +879,15 @@ begin
NStart := CurrentNote;
Lines[0].Line[CNew].Start := Lines[0].Line[CStart].Note[NStart].Start;
Lines[0].Line[CNew].Lyric := '';
- Lines[0].Line[CNew].LyricWidth := 0;
Lines[0].Line[CNew].End_ := 0;
- Lines[0].Line[CNew].BaseNote := 0; // 0.5.0: we modify it later in this procedure
+ Lines[0].Line[CNew].BaseNote := 0;//High(Integer); // TODO: High (Integer) will causes a memory exception later in this procedure. Weird!
Lines[0].Line[CNew].HighNote := -1;
SetLength(Lines[0].Line[CNew].Note, 0);
// move right notes to new sentences
NHigh := Lines[0].Line[CStart].HighNote;
- for N := NStart to NHigh do begin
+ for N := NStart to NHigh do
+ begin
// increase sentence counters
with Lines[0].Line[CNew] do
begin
@@ -857,6 +907,16 @@ begin
Lines[0].Line[CStart].Note[NStart-1].Length;
SetLength(Lines[0].Line[CStart].Note, Lines[0].Line[CStart].HighNote + 1);
+ //recalculate BaseNote of the divided Sentence
+ with Lines[0].Line[CStart] do
+ begin
+ BaseNote := High(Integer);
+
+ For N := 0 to HighNote do
+ if Note[N].Tone < BaseNote then
+ BaseNote := Note[N].Tone;
+ end;
+
Lines[0].Current := Lines[0].Current + 1;
CurrentNote := 0;
Lines[0].Line[Lines[0].Current].Note[CurrentNote].Color := 1;
@@ -878,7 +938,8 @@ begin
SetLength(Lines[0].Line[C].Note, Lines[0].Line[C].HighNote + 1);
// move right notes to new sentences
- for N := 0 to Lines[0].Line[C+1].HighNote do begin
+ for N := 0 to Lines[0].Line[C+1].HighNote do
+ begin
NDst := NStart + N;
Lines[0].Line[C].Note[NDst] := Lines[0].Line[C+1].Note[N];
end;
@@ -911,7 +972,8 @@ begin
SetLength(Note, HighNote + 1);
// we copy all notes including selected one
- for N := HighNote downto CurrentNote+1 do begin
+ for N := HighNote downto CurrentNote+1 do
+ begin
Note[N] := Note[N-1];
end;
@@ -936,7 +998,8 @@ begin
begin
// we copy all notes from the next to the selected one
- for N := CurrentNote+1 to Lines[0].Line[C].HighNote do begin
+ for N := CurrentNote+1 to Lines[0].Line[C].HighNote do
+ begin
Lines[0].Line[C].Note[N-1] := Lines[0].Line[C].Note[N];
end;
@@ -984,7 +1047,8 @@ var
C: integer;
N: integer;
begin
- for C := 0 to Lines[0].High do begin
+ for C := 0 to Lines[0].High do
+ begin
Lines[0].Line[C].BaseNote := Lines[0].Line[C].BaseNote + Tone;
for N := 0 to Lines[0].Line[C].HighNote do
Lines[0].Line[C].Note[N].Tone := Lines[0].Line[C].Note[N].Tone + Tone;
@@ -997,13 +1061,17 @@ var
N: integer;
NStart: integer;
begin
- for C := Lines[0].Current to Lines[0].High do begin
+ for C := Lines[0].Current to Lines[0].High do
+ begin
NStart := 0;
- if C = Lines[0].Current then NStart := CurrentNote;
- for N := NStart to Lines[0].Line[C].HighNote do begin
+ if C = Lines[0].Current then
+ NStart := CurrentNote;
+ for N := NStart to Lines[0].Line[C].HighNote do
+ begin
Inc(Lines[0].Line[C].Note[N].Start, Move); // move note start
- if N = 0 then begin // fix beginning
+ if N = 0 then
+ begin // fix beginning
Inc(Lines[0].Line[C].Start, Move);
end;
@@ -1022,7 +1090,8 @@ var
begin
{ C := Lines[0].Current;
- for N := Lines[0].Line[C].HighNut downto 1 do begin
+ for N := Lines[0].Line[C].HighNut downto 1 do
+ begin
Lines[0].Line[C].Note[N].Text := Lines[0].Line[C].Note[N-1].Text;
end; // for
@@ -1035,7 +1104,8 @@ begin
Lines[0].Line[C].Note[NHigh].Text := Lines[0].Line[C].Note[NHigh-1].Text + Lines[0].Line[C].Note[NHigh].Text;
// other words
- for N := NHigh - 1 downto CurrentNote + 1 do begin
+ for N := NHigh - 1 downto CurrentNote + 1 do
+ begin
Lines[0].Line[C].Note[N].Text := Lines[0].Line[C].Note[N-1].Text;
end; // for
Lines[0].Line[C].Note[CurrentNote].Text := '- ';
@@ -1059,10 +1129,10 @@ end;
procedure TScreenEditSub.CopySentence(Src, Dst: integer);
var
- N: integer;
- Time1: integer;
- Time2: integer;
- TD: integer;
+ N: integer;
+ Time1: integer;
+ Time2: integer;
+ TD: integer;
begin
Time1 := Lines[0].Line[Src].Note[0].Start;
Time2 := Lines[0].Line[Dst].Note[0].Start;
@@ -1070,7 +1140,8 @@ begin
SetLength(Lines[0].Line[Dst].Note, Lines[0].Line[Src].HighNote + 1);
Lines[0].Line[Dst].HighNote := Lines[0].Line[Src].HighNote;
- for N := 0 to Lines[0].Line[Src].HighNote do begin
+ for N := 0 to Lines[0].Line[Src].HighNote do
+ begin
Lines[0].Line[Dst].Note[N].Text := Lines[0].Line[Src].Note[N].Text;
Lines[0].Line[Dst].Note[N].Length := Lines[0].Line[Src].Note[N].Length;
Lines[0].Line[Dst].Note[N].Tone := Lines[0].Line[Src].Note[N].Tone;
@@ -1088,12 +1159,14 @@ begin
SetLength(Lines[0].Line, Lines[0].Number + Num - 1);
// moves sentences next to the destination
- for C := Lines[0].High downto Dst + 1 do begin
+ for C := Lines[0].High downto Dst + 1 do
+ begin
Lines[0].Line[C + Num - 1] := Lines[0].Line[C];
end;
// prepares new sentences: sets sentence start and create first note
- for C := 1 to Num-1 do begin
+ for C := 1 to Num-1 do
+ begin
Lines[0].Line[Dst + C].Start := Lines[0].Line[Dst + C - 1].Note[0].Start +
(Lines[0].Line[Src + C].Note[0].Start - Lines[0].Line[Src + C - 1].Note[0].Start);
SetLength(Lines[0].Line[Dst + C].Note, 1);
@@ -1175,9 +1248,10 @@ begin
try
//Check if File is XML
- if copy(CurrentSong.FileName,length(CurrentSong.FileName)-3,4) = '.xml'
- then Error := not CurrentSong.LoadXMLSong()
- else Error := not CurrentSong.LoadSong();
+ if copy(CurrentSong.FileName,length(CurrentSong.FileName)-3,4) = '.xml' then
+ Error := not CurrentSong.LoadXMLSong()
+ else
+ Error := not CurrentSong.LoadSong();
except
Error := True;
end;
@@ -1189,7 +1263,8 @@ begin
ScreenPopupError.ShowPopup (Language.Translate('ERROR_CORRUPT_SONG'));
Exit;
end
- else begin
+ else
+ begin
{$IFDEF UseMIDIPort}
MidiOut := TMidiOutput.Create(nil);
if Ini.Debug = 1 then
@@ -1210,7 +1285,7 @@ begin
Lyric.Clear;
Lyric.X := 400;
Lyric.Y := 500;
- Lyric.Align := 1;
+ Lyric.Align := center;
Lyric.Size := 42;
Lyric.ColR := 0;
Lyric.ColG := 0;
@@ -1238,13 +1313,15 @@ begin
glClearColor(1,1,1,1);
// midi music
- if PlaySentenceMidi then begin
+ if PlaySentenceMidi then
+ begin
{$IFDEF UseMIDIPort}
MidiPos := USTime.GetTime - MidiTime + MidiStart;
// stop the music
- if (MidiPos > MidiStop) then begin
+ if (MidiPos > MidiStop) then
+ begin
MidiOut.PutShort($81, Lines[0].Line[Lines[0].Current].Note[MidiLastNote].Tone + 60, 127);
PlaySentenceMidi := false;
end;
@@ -1254,7 +1331,8 @@ begin
AktBeat := Floor(GetMidBeat(MidiPos - CurrentSong.GAP / 1000));
Text[TextDebug].Text := IntToStr(AktBeat);
- if AktBeat <> LastClick then begin
+ if AktBeat <> LastClick then
+ begin
for Pet := 0 to Lines[0].Line[Lines[0].Current].HighNote do
if (Lines[0].Line[Lines[0].Current].Note[Pet].Start = AktBeat) then
begin
@@ -1273,7 +1351,8 @@ begin
end; // if PlaySentenceMidi
// mp3 music
- if PlaySentence then begin
+ if PlaySentence then
+ begin
// stop the music
if (AudioPlayback.Position > PlayStopTime) then
begin
@@ -1282,11 +1361,13 @@ begin
end;
// click
- if (Click) and (PlaySentence) then begin
+ if (Click) and (PlaySentence) then
+ begin
// AktBeat := Floor(CurrentSong.BPM[0].BPM * (Music.Position - CurrentSong.GAP / 1000) / 60);
AktBeat := Floor(GetMidBeat(AudioPlayback.Position - CurrentSong.GAP / 1000));
Text[TextDebug].Text := IntToStr(AktBeat);
- if AktBeat <> LastClick then begin
+ if AktBeat <> LastClick then
+ begin
for Pet := 0 to Lines[0].Line[Lines[0].Current].HighNote do
if (Lines[0].Line[Lines[0].Current].Note[Pet].Start = AktBeat) then
begin
@@ -1347,8 +1428,8 @@ begin
//Music.SetVolume(1.0);
end;
-function TScreenEditSub.GetNoteName(Note: Integer): String;
-var N1, N2: Integer;
+function TScreenEditSub.GetNoteName(Note: integer): string;
+var N1, N2: integer;
begin
if (Note > 0) then
begin
@@ -1361,8 +1442,6 @@ begin
N2 := -1;
end;
-
-
case N1 of
0: Result := 'c';
1: Result := 'c#';
diff --git a/unicode/src/screens/UScreenMain.pas b/unicode/src/screens/UScreenMain.pas
index 0909fc8b..eb2e051e 100644
--- a/unicode/src/screens/UScreenMain.pas
+++ b/unicode/src/screens/UScreenMain.pas
@@ -63,7 +63,7 @@ implementation
uses
UGraphic,
- UMain,
+ UNote,
UIni,
UTexture,
USongs,
diff --git a/unicode/src/screens/UScreenName.pas b/unicode/src/screens/UScreenName.pas
index 244a559d..64e90cc9 100644
--- a/unicode/src/screens/UScreenName.pas
+++ b/unicode/src/screens/UScreenName.pas
@@ -34,12 +34,12 @@ interface
{$I switches.inc}
uses
- UMenu,
+ SysUtils,
+ SDL,
UDisplay,
- UMusic,
UFiles,
- SDL,
- SysUtils,
+ UMenu,
+ UMusic,
UThemes;
type
@@ -55,9 +55,10 @@ type
implementation
uses
- UGraphic,
- UMain,
+ UCommon,
+ UGraphic,
UIni,
+ UNote,
UTexture,
UUnicodeUtils;
diff --git a/unicode/src/screens/UScreenOpen.pas b/unicode/src/screens/UScreenOpen.pas
index ac524f4c..fa65a1df 100644
--- a/unicode/src/screens/UScreenOpen.pas
+++ b/unicode/src/screens/UScreenOpen.pas
@@ -34,12 +34,10 @@ interface
{$I switches.inc}
uses
- SDL,
- SysUtils,
- Math,
- gl,
UMenu,
UMusic,
+ SDL,
+ SysUtils,
UFiles,
UTime,
USongs,
@@ -48,22 +46,24 @@ uses
UTexture,
UMenuText,
ULyrics,
+ Math,
+ gl,
UThemes;
type
TScreenOpen = class(TMenu)
private
- TextF: array[0..1] of integer;
- TextN: integer;
+ TextF: array[0..1] of integer;
+ TextN: integer;
public
- Tex_Background: TTexture;
- FadeOut: boolean;
- Path: string;
- BackScreen: pointer;
+ Tex_Background: TTexture;
+ FadeOut: boolean;
+ Path: string;
+ BackScreen: pointer;
procedure AddBox(X, Y, W, H: real);
constructor Create; override;
procedure onShow; override;
- function ParseInput(PressedKey: Cardinal; CharCode: UCS4Char; PressedDown: Boolean): Boolean; override;
+ function ParseInput(PressedKey: cardinal; CharCode: UCS4Char; PressedDown: boolean): boolean; override;
// function Draw: boolean; override;
// procedure Finish;
end;
@@ -74,14 +74,16 @@ uses
UGraphic,
UDraw,
UMain,
+ UScreenEditConvert,
USkins,
UUnicodeUtils;
-function TScreenOpen.ParseInput(PressedKey: Cardinal; CharCode: UCS4Char; PressedDown: Boolean): Boolean;
+function TScreenOpen.ParseInput(PressedKey: cardinal; CharCode: UCS4Char; PressedDown: boolean): boolean;
begin
Result := true;
- if (PressedDown) then begin // Key Down
+ if (PressedDown) then // Key Down
+ begin
// check normal keys
case CharCode of
Ord('0')..Ord('9'),
@@ -89,7 +91,8 @@ begin
Ord('A')..Ord('Z'),
Ord(' '), Ord('-'), Ord('.'), Ord(':'), Ord('\'):
begin
- if Interaction = 0 then begin
+ if Interaction = 0 then
+ begin
Text[TextN].Text := Text[TextN].Text + UCS4ToUTF8String(CharCode);
end;
end;
@@ -103,24 +106,24 @@ begin
end;
8: // del
begin
- if Interaction = 0 then
- begin
- Text[TextN].DeleteLastLetter;
- end;
+ if Interaction = 0 then
+ begin
+ Text[TextN].DeleteLastLetter;
+ end;
end;
-
- SDLK_ESCAPE :
+ SDLK_ESCAPE:
begin
//Empty Filename and go to last Screen
- ConversionFileName := '';
- AudioPlayback.PlaySound(SoundLib.Back);
- FadeTo(BackScreen);
+ ConversionFileName := '';
+ AudioPlayback.PlaySound(SoundLib.Back);
+ FadeTo(BackScreen);
end;
SDLK_RETURN:
begin
- if (Interaction = 2) then begin
+ if (Interaction = 2) then
+ begin
//Update Filename and go to last Screen
ConversionFileName := Text[TextN].Text;
AudioPlayback.PlaySound(SoundLib.Back);
@@ -166,9 +169,9 @@ constructor TScreenOpen.Create;
begin
inherited Create;
- // linijka
+ // line
{ AddStatic(20, 10, 80, 30, 0, 0, 0, 'MainBar', 'JPG', TEXTURE_TYPE_COLORIZED);
- AddText(35, 17, 1, 18, 1, 1, 1, 'Linijka');
+ AddText(35, 17, 1, 18, 1, 1, 1, 'line');
TextSentence := AddText(120, 14, 1, 24, 0, 0, 0, '0 / 0');}
// file list
@@ -195,7 +198,6 @@ begin
AddButton(670, 540, 100, 40, Skin.GetTextureFileName('ButtonF'));
AddButtonText(30, 5, 0, 0, 0, 'OK');
-
end;
procedure TScreenOpen.onShow;
@@ -207,11 +209,9 @@ end;
(*function TScreenEditSub.Draw: boolean;
var
- Min: integer;
- Sec: integer;
- Tekst: string;
- Pet: integer;
- AktBeat: integer;
+ Min: integer;
+ Sec: integer;
+ AktBeat: integer;
begin
end;
@@ -222,4 +222,3 @@ begin
end;*)
end.
-
diff --git a/unicode/src/screens/UScreenOptions.pas b/unicode/src/screens/UScreenOptions.pas
index ab49c49c..ff2a3fe2 100644
--- a/unicode/src/screens/UScreenOptions.pas
+++ b/unicode/src/screens/UScreenOptions.pas
@@ -82,7 +82,7 @@ begin
SDLK_ESCAPE,
SDLK_BACKSPACE :
begin
-// Ini.Save;
+ Ini.Save;
AudioPlayback.PlaySound(SoundLib.Back);
FadeTo(@ScreenMain);
end;
diff --git a/unicode/src/screens/UScreenOptionsRecord.pas b/unicode/src/screens/UScreenOptionsRecord.pas
index 391c2090..0cf9eb37 100644
--- a/unicode/src/screens/UScreenOptionsRecord.pas
+++ b/unicode/src/screens/UScreenOptionsRecord.pas
@@ -167,8 +167,8 @@ begin
SDLK_ESCAPE,
SDLK_BACKSPACE:
begin
- // Escape -> save nothing - just leave this screen
-
+ // TODO: Show Save/Abort screen
+ Ini.Save;
AudioPlayback.PlaySound(SoundLib.Back);
FadeTo(@ScreenOptions);
end;
diff --git a/unicode/src/screens/UScreenOptionsThemes.pas b/unicode/src/screens/UScreenOptionsThemes.pas
index dcd870ca..64816d34 100644
--- a/unicode/src/screens/UScreenOptionsThemes.pas
+++ b/unicode/src/screens/UScreenOptionsThemes.pas
@@ -57,12 +57,13 @@ type
implementation
-uses
- UMain,
+uses
+ SysUtils,
UGraphic,
- USkins,
+ UMain,
+ UPath,
UUnicodeUtils,
- SysUtils;
+ USkins;
function TScreenOptionsThemes.ParseInput(PressedKey: Cardinal; CharCode: UCS4Char; PressedDown: Boolean): Boolean;
begin
diff --git a/unicode/src/screens/UScreenPartyOptions.pas b/unicode/src/screens/UScreenPartyOptions.pas
index b484144b..74c51b15 100644
--- a/unicode/src/screens/UScreenPartyOptions.pas
+++ b/unicode/src/screens/UScreenPartyOptions.pas
@@ -34,46 +34,47 @@ interface
{$I switches.inc}
uses
- SDL,
- SysUtils,
UMenu,
+ SDL,
UDisplay,
UMusic,
UFiles,
+ SysUtils,
UThemes;
type
TScreenPartyOptions = class(TMenu)
public
- SelectLevel: Cardinal;
- SelectPlayList: Cardinal;
- SelectPlayList2: Cardinal;
- SelectRounds: Cardinal;
- SelectTeams: Cardinal;
- SelectPlayers1: Cardinal;
- SelectPlayers2: Cardinal;
- SelectPlayers3: Cardinal;
-
- PlayList: Integer;
- PlayList2: Integer;
- Rounds: Integer;
- NumTeams: Integer;
- NumPlayer1, NumPlayer2, NumPlayer3: Integer;
-
+ SelectLevel: cardinal;
+ SelectPlayList: cardinal;
+ SelectPlayList2: cardinal;
+ SelectRounds: cardinal;
+ SelectTeams: cardinal;
+ SelectPlayers1: cardinal;
+ SelectPlayers2: cardinal;
+ SelectPlayers3: cardinal;
+
+ PlayList: integer;
+ PlayList2: integer;
+ Rounds: integer;
+ NumTeams: integer;
+ NumPlayer1, NumPlayer2, NumPlayer3: integer;
+
constructor Create; override;
- function ParseInput(PressedKey: Cardinal; CharCode: UCS4Char; PressedDown: Boolean): Boolean; override;
+ function ParseInput(PressedKey: cardinal; CharCode: UCS4Char; PressedDown: boolean): boolean; override;
procedure onShow; override;
procedure SetAnimationProgress(Progress: real); override;
procedure SetPlaylist2;
end;
var
- IPlaylist: array[0..2] of String;
- IPlaylist2: array of String;
-const
- ITeams: array[0..1] of String =('2', '3');
- IPlayers: array[0..3] of String =('1', '2', '3', '4');
- IRounds: array[0..5] of String = ('2', '3', '4', '5', '6', '7');
+ IPlaylist: array[0..2] of string;
+ IPlaylist2: array of string;
+
+ const
+ ITeams: array[0..1] of string = ('2', '3');
+ IPlayers: array[0..3] of string = ('1', '2', '3', '4');
+ IRounds: array[0..5] of string = ('2', '3', '4', '5', '6', '7');
implementation
@@ -90,13 +91,13 @@ uses
USongs,
UUnicodeUtils;
-function TScreenPartyOptions.ParseInput(PressedKey: Cardinal; CharCode: UCS4Char; PressedDown: Boolean): Boolean;
- var
- I, J: Integer;
- OnlyMultiPlayer: boolean;
+function TScreenPartyOptions.ParseInput(PressedKey: cardinal; CharCode: UCS4Char; PressedDown: boolean): boolean;
+var
+ I, J: integer;
+ OnlyMultiPlayer: boolean;
begin
Result := true;
- If (PressedDown) Then
+ if (PressedDown) then
begin // Key Down
// check normal keys
case UCS4UpperCase(CharCode) of
@@ -119,14 +120,16 @@ begin
SDLK_RETURN:
begin
//Don'T start when Playlist is Selected and there are no Playlists
- If (Playlist = 2) and (Length(PlaylistMan.Playlists) = 0) then
+ if (Playlist = 2) and (Length(PlaylistMan.Playlists) = 0) then
Exit;
// Don't start when SinglePlayer Teams but only Multiplayer Plugins available
- OnlyMultiPlayer:=true;
- for I := 0 to High(DLLMan.Plugins) do begin
- OnlyMultiPlayer := (OnlyMultiPlayer AND DLLMan.Plugins[I].TeamModeOnly);
+ OnlyMultiPlayer := true;
+ for I := 0 to High(DLLMan.Plugins) do
+ begin
+ OnlyMultiPlayer := (OnlyMultiPlayer and DLLMan.Plugins[I].TeamModeOnly);
end;
- if (OnlyMultiPlayer) AND ((NumPlayer1 = 0) OR (NumPlayer2 = 0) OR ((NumPlayer3 = 0) AND (NumTeams = 1))) then begin
+ if (OnlyMultiPlayer) and ((NumPlayer1 = 0) or (NumPlayer2 = 0) or ((NumPlayer3 = 0) and (NumTeams = 1))) then
+ begin
ScreenPopupError.ShowPopup(Language.Translate('ERROR_NO_PLUGINS'));
Exit;
end;
@@ -143,12 +146,12 @@ begin
//Save Playlist
PlaylistMan.Mode := TSingMode( Playlist );
- PlaylistMan.CurPlayList := High(Cardinal);
- //If Category Selected Search Category ID
+ PlaylistMan.CurPlayList := High(cardinal);
+ //if Category Selected Search Category ID
if Playlist = 1 then
begin
J := -1;
- For I := 0 to high(CatSongs.Song) do
+ for I := 0 to high(CatSongs.Song) do
begin
if CatSongs.Song[I].Main then
Inc(J);
@@ -161,7 +164,7 @@ begin
end;
//No Categorys or Invalid Entry
- If PlaylistMan.CurPlayList = High(Cardinal) then
+ if PlaylistMan.CurPlayList = High(cardinal) then
Exit;
end
else
@@ -187,11 +190,11 @@ begin
InteractInc;
//Change Playlist2 if Playlist is Changed
- If (Interaction = 1) then
+ if (Interaction = 1) then
begin
SetPlaylist2;
end //Change Team3 Players visibility
- Else If (Interaction = 4) then
+ else if (Interaction = 4) then
begin
SelectsS[7].Visible := (NumTeams = 1);
end;
@@ -202,11 +205,11 @@ begin
InteractDec;
//Change Playlist2 if Playlist is Changed
- If (Interaction = 1) then
+ if (Interaction = 1) then
begin
SetPlaylist2;
end //Change Team3 Players visibility
- Else If (Interaction = 4) then
+ else if (Interaction = 4) then
begin
SelectsS[7].Visible := (NumTeams = 1);
end;
@@ -239,25 +242,25 @@ begin
//Load Screen From Theme
LoadFromTheme(Theme.PartyOptions);
- SelectLevel := AddSelectSlide (Theme.PartyOptions.SelectLevel, Ini.Difficulty, Theme.ILevel);
- SelectPlayList := AddSelectSlide (Theme.PartyOptions.SelectPlayList, PlayList, IPlaylist);
+ SelectLevel := AddSelectSlide (Theme.PartyOptions.SelectLevel, Ini.Difficulty, Theme.ILevel);
+ SelectPlayList := AddSelectSlide (Theme.PartyOptions.SelectPlayList, PlayList, IPlaylist);
SelectPlayList2 := AddSelectSlide (Theme.PartyOptions.SelectPlayList2, PlayList2, IPlaylist2);
- SelectRounds := AddSelectSlide (Theme.PartyOptions.SelectRounds, Rounds, IRounds);
- SelectTeams := AddSelectSlide (Theme.PartyOptions.SelectTeams, NumTeams, ITeams);
- SelectPlayers1 := AddSelectSlide (Theme.PartyOptions.SelectPlayers1, NumPlayer1, IPlayers);
- SelectPlayers2 := AddSelectSlide (Theme.PartyOptions.SelectPlayers2, NumPlayer2, IPlayers);
- SelectPlayers3 := AddSelectSlide (Theme.PartyOptions.SelectPlayers3, NumPlayer3, IPlayers);
+ SelectRounds := AddSelectSlide (Theme.PartyOptions.SelectRounds, Rounds, IRounds);
+ SelectTeams := AddSelectSlide (Theme.PartyOptions.SelectTeams, NumTeams, ITeams);
+ SelectPlayers1 := AddSelectSlide (Theme.PartyOptions.SelectPlayers1, NumPlayer1, IPlayers);
+ SelectPlayers2 := AddSelectSlide (Theme.PartyOptions.SelectPlayers2, NumPlayer2, IPlayers);
+ SelectPlayers3 := AddSelectSlide (Theme.PartyOptions.SelectPlayers3, NumPlayer3, IPlayers);
Interaction := 0;
//Hide Team3 Players
- SelectsS[7].Visible := False;
+ SelectsS[7].Visible := false;
end;
procedure TScreenPartyOptions.SetPlaylist2;
-var I: Integer;
+var I: integer;
begin
- Case Playlist of
+ case Playlist of
0:
begin
SetLength(IPlaylist2, 1);
@@ -266,16 +269,16 @@ begin
1:
begin
SetLength(IPlaylist2, 0);
- For I := 0 to high(CatSongs.Song) do
+ for I := 0 to high(CatSongs.Song) do
begin
- If (CatSongs.Song[I].Main) then
+ if (CatSongs.Song[I].Main) then
begin
SetLength(IPlaylist2, Length(IPlaylist2) + 1);
IPlaylist2[high(IPlaylist2)] := CatSongs.Song[I].Artist;
end;
end;
- If (Length(IPlaylist2) = 0) then
+ if (Length(IPlaylist2) = 0) then
begin
SetLength(IPlaylist2, 1);
IPlaylist2[0] := 'No Categories found';
diff --git a/unicode/src/screens/UScreenScore.pas b/unicode/src/screens/UScreenScore.pas
index e807f8d8..5c312938 100644
--- a/unicode/src/screens/UScreenScore.pas
+++ b/unicode/src/screens/UScreenScore.pas
@@ -46,56 +46,56 @@ uses
UTexture;
const
- ZBars : real = 0.8; // Z value for the bars
- ZRatingPic : real = 0.8; // Z value for the rating pictures
+ ZBars: real = 0.8; // Z value for the bars
+ ZRatingPic: real = 0.8; // Z value for the rating pictures
- EaseOut_MaxSteps : real = 10; // that's the speed of the bars (10 is fast | 100 is slower)
+ EaseOut_MaxSteps: real = 10; // that's the speed of the bars (10 is fast | 100 is slower)
- BarRaiseSpeed : cardinal = 0; // Time for raising the bar one step higher (in ms)
+ BarRaiseSpeed: cardinal = 0; // Time for raising the bar one step higher (in ms)
type
TPlayerScoreScreenTexture = record // holds all colorized textures for up to 6 players
//Bar textures
- Score_NoteBarLevel_Dark : TTexture; // Note
- Score_NoteBarRound_Dark : TTexture; // that's the round thing on top
+ Score_NoteBarLevel_Dark: TTexture; // Note
+ Score_NoteBarRound_Dark: TTexture; // that's the round thing on top
- Score_NoteBarLevel_Light : TTexture; // LineBonus | Phrasebonus
- Score_NoteBarRound_Light : TTexture;
+ Score_NoteBarLevel_Light: TTexture; // LineBonus | Phrasebonus
+ Score_NoteBarRound_Light: TTexture;
- Score_NoteBarLevel_Lightest : TTexture; // GoldenNotes
- Score_NoteBarRound_Lightest : TTexture;
+ Score_NoteBarLevel_Lightest: TTexture; // GoldenNotes
+ Score_NoteBarRound_Lightest: TTexture;
end;
TPlayerScoreScreenData = record // holds the positions and other data
- Bar_Y :Real;
- Bar_Actual_Height : Real; // this one holds the actual height of the bar, while we animate it
- BarScore_ActualHeight : Real;
- BarLine_ActualHeight : Real;
- BarGolden_ActualHeight : Real;
+ Bar_Y: real;
+ Bar_Actual_Height: real; // this one holds the actual height of the bar, while we animate it
+ BarScore_ActualHeight: real;
+ BarLine_ActualHeight: real;
+ BarGolden_ActualHeight: real;
end;
TPlayerScoreRatingPics = record // a fine array of the rating pictures
- RateEaseStep : Integer;
- RateEaseValue: Real;
+ RateEaseStep: integer;
+ RateEaseValue: real;
end;
TScreenScore = class(TMenu)
private
- BarTime : Cardinal;
- ArrayStartModifier : integer;
+ BarTime: cardinal;
+ ArrayStartModifier: integer;
public
- aPlayerScoreScreenTextures : array[1..6] of TPlayerScoreScreenTexture;
- aPlayerScoreScreenDatas : array[1..6] of TPlayerScoreScreenData;
- aPlayerScoreScreenRatings : array[1..6] of TPlayerScoreRatingPics;
+ aPlayerScoreScreenTextures: array[1..6] of TPlayerScoreScreenTexture;
+ aPlayerScoreScreenDatas: array[1..6] of TPlayerScoreScreenData;
+ aPlayerScoreScreenRatings: array[1..6] of TPlayerScoreRatingPics;
- BarScore_EaseOut_Step : real;
- BarPhrase_EaseOut_Step : real;
- BarGolden_EaseOut_Step : real;
+ BarScore_EaseOut_Step: real;
+ BarPhrase_EaseOut_Step: real;
+ BarGolden_EaseOut_Step: real;
- TextArtist: integer;
- TextTitle: integer;
+ TextArtist: integer;
+ TextTitle: integer;
- TextArtistTitle : integer;
+ TextArtistTitle: integer;
TextName: array[1..6] of integer;
TextScore: array[1..6] of integer;
@@ -110,65 +110,62 @@ type
TextTotalScore: array[1..6] of integer;
PlayerStatic: array[1..6] of array of integer;
- PlayerTexts : array[1..6] of array of integer;
-
+ PlayerTexts: array[1..6] of array of integer;
StaticBoxLightest: array[1..6] of integer;
StaticBoxLight: array[1..6] of integer;
StaticBoxDark: array[1..6] of integer;
- StaticBackLevel: array[1..6] of integer;
- StaticBackLevelRound: array[1..6] of integer;
- StaticLevel: array[1..6] of integer;
- StaticLevelRound: array[1..6] of integer;
-
- Animation: real;
-
- TextScore_ActualValue : array[1..6] of integer;
- TextPhrase_ActualValue : array[1..6] of integer;
- TextGolden_ActualValue : array[1..6] of integer;
+ StaticBackLevel: array[1..6] of integer;
+ StaticBackLevelRound: array[1..6] of integer;
+ StaticLevel: array[1..6] of integer;
+ StaticLevelRound: array[1..6] of integer;
+ Animation: real;
+ TextScore_ActualValue: array[1..6] of integer;
+ TextPhrase_ActualValue: array[1..6] of integer;
+ TextGolden_ActualValue: array[1..6] of integer;
constructor Create; override;
- function ParseInput(PressedKey: Cardinal; CharCode: UCS4Char; PressedDown: Boolean): Boolean; override;
+ function ParseInput(PressedKey: cardinal; CharCode: UCS4Char; PressedDown: boolean): boolean; override;
procedure onShow; override;
procedure onShowFinish; override;
function Draw: boolean; override;
procedure FillPlayer(Item, P: integer);
- procedure EaseBarIn(PlayerNumber : Integer; BarType: String);
- procedure EaseScoreIn(PlayerNumber : Integer; ScoreType: String);
-
- procedure FillPlayerItems(PlayerNumber : Integer; ScoreType: String);
+ procedure EaseBarIn(PlayerNumber: integer; BarType: string);
+ procedure EaseScoreIn(PlayerNumber: integer; ScoreType: string);
+ procedure FillPlayerItems(PlayerNumber: integer; ScoreType: string);
- procedure DrawBar(BarType:string; PlayerNumber: integer; BarStartPosY: single; NewHeight: real);
+ procedure DrawBar(BarType: string; PlayerNumber: integer; BarStartPosY: single; NewHeight: real);
//Rating Picture
procedure ShowRating(PlayerNumber: integer);
- function CalculateBouncing(PlayerNumber : Integer): real;
- procedure DrawRating(PlayerNumber:integer;Rating:integer);
+ function CalculateBouncing(PlayerNumber: integer): real;
+ procedure DrawRating(PlayerNumber: integer; Rating: integer);
end;
implementation
-
uses
UGraphic,
UScreenSong,
UMenuStatic,
UTime,
- UMain,
UIni,
ULog,
ULanguage,
+ UNote,
UUnicodeUtils;
-function TScreenScore.ParseInput(PressedKey: Cardinal; CharCode: UCS4Char; PressedDown: Boolean): Boolean;
+
+function TScreenScore.ParseInput(PressedKey: cardinal; CharCode: UCS4Char; PressedDown: boolean): boolean;
begin
Result := true;
- If (PressedDown) Then begin
+ if (PressedDown) then
+ begin
// check normal keys
case UCS4UpperCase(CharCode) of
Ord('Q'):
@@ -258,9 +255,9 @@ end;
procedure TScreenScore.onShow;
var
- P: integer; // player
- I: integer;
- V: array[1..6] of boolean; // visibility array
+ P: integer; // player
+ I: integer;
+ V: array[1..6] of boolean; // visibility array
begin
@@ -297,7 +294,6 @@ begin
aPlayerScoreScreenRatings[P].RateEaseValue := 20;
end;
-
Text[TextArtist].Text := CurrentSong.Artist;
Text[TextTitle].Text := CurrentSong.Title;
Text[TextArtistTitle].Text := CurrentSong.Artist + ' - ' + CurrentSong.Title;
@@ -349,7 +345,6 @@ begin
Static[StaticBoxLight[P]].Texture.Alpha := 0;
Static[StaticBoxDark[P]].Texture.Alpha := 0;
-
Text[TextNotes[P]].Visible := V[P];
Text[TextNotesScore[P]].Visible := V[P];
Text[TextLineBonus[P]].Visible := V[P];
@@ -379,14 +374,14 @@ end;
procedure TScreenScore.onShowFinish;
var
- index : integer;
+ index: integer;
begin
for index := 1 to (PlayersPlay) do
- begin
- TextScore_ActualValue[index] := 0;
- TextPhrase_ActualValue[index] := 0;
- TextGolden_ActualValue[index] := 0;
- end;
+ begin
+ TextScore_ActualValue[index] := 0;
+ TextPhrase_ActualValue[index] := 0;
+ TextGolden_ActualValue[index] := 0;
+ end;
BarScore_EaseOut_Step := 1;
BarPhrase_EaseOut_Step := 1;
@@ -395,11 +390,11 @@ end;
function TScreenScore.Draw: boolean;
var
- CurrentTime : Cardinal;
- PlayerCounter : integer;
+ CurrentTime: cardinal;
+ PlayerCounter: integer;
+ PStart: integer;
+ PHigh: integer;
begin
-
- inherited Draw;
{*
player[0].ScoreInt := 7000;
player[0].ScoreLineInt := 2000;
@@ -411,13 +406,38 @@ begin
player[1].ScoreGoldenInt := 900;
player[1].ScoreTotalInt := 4500;
*}
+
+ //Draw the Background
+ DrawBG;
+
+ //Calculate first and last Player on this Screen
+ if (PlayersPlay > 3) then
+ begin
+ case PlayersPlay of
+ 4: begin
+ PStart := 1 + ((ScreenAct-1) * 2);
+ PHigh := 2 + ((ScreenAct-1) * 2);
+ end;
+
+ 6: begin
+ PStart := 1 + ((ScreenAct-1) * 3);
+ PHigh := 3 + ((ScreenAct-1) * 3);
+ end;
+ end;
+ end
+ else
+ begin
+ PStart := 1;
+ PHigh := PlayersPlay;
+ end;
+
// Let's start to arise the bars
CurrentTime := SDL_GetTicks();
- if((CurrentTime >= BarTime) AND ShowFinish) then
+ if((CurrentTime >= BarTime) and ShowFinish) then
begin
BarTime := CurrentTime + BarRaiseSpeed;
- for PlayerCounter := 1 to PlayersPlay do
+ for PlayerCounter := PStart to PHigh do
begin
// We actually arise them in the right order, but we have to draw them in reverse order (golden -> phrase -> mainscore)
if (BarScore_EaseOut_Step < EaseOut_MaxSteps * 10) then
@@ -429,7 +449,6 @@ begin
if (BarPhrase_EaseOut_Step < EaseOut_MaxSteps * 10) then
BarPhrase_EaseOut_Step := BarPhrase_EaseOut_Step + 1;
-
// GoldenNotebonus
if (BarPhrase_EaseOut_Step >= (EaseOut_MaxSteps * 10)) then
begin
@@ -450,12 +469,25 @@ begin
EaseBarIn(PlayerCounter, 'Note');
EaseScoreIn(PlayerCounter,'Note');
-
- FillPlayerItems(PlayerCounter,'Funky');
+ if (PlayersPlay <= 3) then
+ //If we play w/ 3 or less players they fit in one screen
+ //so we don't have to swap the values of themeobjects
+ //on every draw
+ FillPlayerItems(PlayerCounter,'Funky');
end;
end;
+ if (PlayersPlay > 3) then
+ //more then 3 players don't fit the screen
+ //so we have to swap the themeobjects values on every draw
+ for PlayerCounter := PStart to PHigh do
+ begin
+ FillPlayerItems(PlayerCounter,'Funky');
+ end;
+
+ //Draw Theme Objects
+ DrawFG;
(*
//todo: i need a clever method to draw statics with their z value
@@ -468,7 +500,7 @@ begin
Result := true;
end;
-procedure TscreenScore.FillPlayerItems(PlayerNumber : Integer; ScoreType: String);
+procedure TscreenScore.FillPlayerItems(PlayerNumber: integer; ScoreType: string);
var
ThemeIndex: integer;
begin
@@ -476,7 +508,13 @@ begin
Text[TextName[PlayerNumber + ArrayStartModifier]].Text := Ini.Name[PlayerNumber - 1];
// end todo
- ThemeIndex := PlayerNumber + ArrayStartModifier;
+ // We have to do this here because we use the same Theme Object
+ // for players on the first and second screen
+ case PlayersPlay of
+ 1, 2, 3: ThemeIndex := PlayerNumber + ArrayStartModifier;
+ 4: ThemeIndex := ((PlayerNumber-1) mod 2) + 1 + ArrayStartModifier;
+ 6: ThemeIndex := ((PlayerNumber-1) mod 3) + 1 + ArrayStartModifier;
+ end;
//golden
Text[TextGoldenNotesScore[ThemeIndex]].Text := IntToStr(TextGolden_ActualValue[PlayerNumber]);
@@ -513,14 +551,19 @@ begin
end;
end;
-
procedure TScreenScore.ShowRating(PlayerNumber: integer);
var
- Rating : integer;
- ThemeIndex : integer;
+ Rating: integer;
+ ThemeIndex: integer;
begin
- ThemeIndex := PlayerNumber + ArrayStartModifier;
+ // We have to do this here because we use the same Theme Object
+ // for players on the first and second screen
+ case PlayersPlay of
+ 1, 2, 3: ThemeIndex := PlayerNumber + ArrayStartModifier;
+ 4: ThemeIndex := ((PlayerNumber-1) mod 2) + 1 + ArrayStartModifier;
+ 6: ThemeIndex := ((PlayerNumber-1) mod 3) + 1 + ArrayStartModifier;
+ end;
case (Player[PlayerNumber-1].ScoreTotalInt) of
0..2009:
@@ -568,7 +611,7 @@ begin
end;
//todo: this could break if the width is not given, for instance when there's a skin with no picture for ratings
- if ( Theme.Score.StaticRatings[ThemeIndex].W > 0 ) AND ( aPlayerScoreScreenRatings[PlayerNumber].RateEaseValue > 0 ) then
+ if ( Theme.Score.StaticRatings[ThemeIndex].W > 0 ) and ( aPlayerScoreScreenRatings[PlayerNumber].RateEaseValue > 0 ) then
begin
Text[TextScore[ThemeIndex]].Alpha := aPlayerScoreScreenRatings[PlayerNumber].RateEaseValue / Theme.Score.StaticRatings[ThemeIndex].W;
end;
@@ -577,11 +620,11 @@ begin
DrawRating(PlayerNumber, Rating);
end;
-procedure TscreenScore.DrawRating(PlayerNumber:integer;Rating:integer);
+procedure TscreenScore.DrawRating(PlayerNumber: integer; Rating: integer);
var
- Posx : real;
- Posy : real;
- Width :real;
+ Posx: real;
+ Posy: real;
+ Width: real;
begin
CalculateBouncing(PlayerNumber);
@@ -608,56 +651,53 @@ begin
glDisable(GL_TEXTURE_2d);
end;
-
-
-function TscreenScore.CalculateBouncing(PlayerNumber : Integer): real;
+function TscreenScore.CalculateBouncing(PlayerNumber: integer): real;
var
- ReturnValue : real;
- p, s : real;
+ ReturnValue: real;
+ p, s: real;
- RaiseStep, MaxVal : real;
- EaseOut_Step : integer;
+ RaiseStep, MaxVal: real;
+ EaseOut_Step: integer;
begin
EaseOut_Step := aPlayerScoreScreenRatings[PlayerNumber].RateEaseStep;
MaxVal := Theme.Score.StaticRatings[PlayerNumber + ArrayStartModifier].W;
RaiseStep := EaseOut_Step;
- if (MaxVal > 0) AND (RaiseStep > 0) then
+ if (MaxVal > 0) and (RaiseStep > 0) then
RaiseStep := RaiseStep / MaxVal;
- if (RaiseStep = 1) then
- begin
- ReturnValue := MaxVal;
- end
- else
- begin
- p := MaxVal * 0.4;
+ if (RaiseStep = 1) then
+ begin
+ ReturnValue := MaxVal;
+ end
+ else
+ begin
+ p := MaxVal * 0.4;
- s := p/(2*PI) * arcsin (1);
- ReturnValue := MaxVal * power(2,-5 * RaiseStep) * sin( (RaiseStep * MaxVal - s) * (2 * PI) / p) + MaxVal;
+ s := p/(2*PI) * arcsin (1);
+ ReturnValue := MaxVal * power(2,-5 * RaiseStep) * sin( (RaiseStep * MaxVal - s) * (2 * PI) / p) + MaxVal;
- inc(aPlayerScoreScreenRatings[PlayerNumber].RateEaseStep);
- aPlayerScoreScreenRatings[PlayerNumber].RateEaseValue := ReturnValue;
- end;
+ inc(aPlayerScoreScreenRatings[PlayerNumber].RateEaseStep);
+ aPlayerScoreScreenRatings[PlayerNumber].RateEaseValue := ReturnValue;
+ end;
Result := ReturnValue;
end;
-
-procedure TscreenScore.EaseBarIn(PlayerNumber : Integer; BarType: String);
+procedure TscreenScore.EaseBarIn(PlayerNumber: integer; BarType: string);
const
- RaiseSmoothness : integer = 100;
+ RaiseSmoothness: integer = 100;
var
- MaxHeight : real;
- NewHeight : real;
+ MaxHeight: real;
+ NewHeight: real;
- Height2Reach : real;
- RaiseStep : real;
- BarStartPosY : single;
+ Height2Reach: real;
+ RaiseStep: real;
+ BarStartPosY: single;
- lTmp : real;
- Score : integer;
+ lTmp: real;
+ Score: integer;
begin
MaxHeight := Theme.Score.StaticBackLevel[PlayerNumber + ArrayStartModifier].H;
@@ -718,10 +758,10 @@ begin
aPlayerScoreScreenDatas[PlayerNumber].BarGolden_ActualHeight := NewHeight;
end;
-procedure TscreenScore.DrawBar(BarType:string; PlayerNumber: integer; BarStartPosY: single; NewHeight: real);
+procedure TscreenScore.DrawBar(BarType: string; PlayerNumber: integer; BarStartPosY: single; NewHeight: real);
var
- Width:real;
- BarStartPosX:real;
+ Width: real;
+ BarStartPosX: real;
begin
// this is solely for better readability of the drawing
Width := Theme.Score.StaticBackLevel[PlayerNumber + ArrayStartModifier].W;
@@ -775,15 +815,15 @@ begin
glDisable(GL_TEXTURE_2d);
end;
-procedure TScreenScore.EaseScoreIn(PlayerNumber: integer; ScoreType : String);
+procedure TScreenScore.EaseScoreIn(PlayerNumber: integer; ScoreType: string);
const
- RaiseSmoothness : integer = 100;
+ RaiseSmoothness: integer = 100;
var
- RaiseStep : Real;
- lTmpA : Real;
- ScoreReached :Integer;
- EaseOut_Step :Real;
- ActualScoreValue:integer;
+ RaiseStep: real;
+ lTmpA: real;
+ ScoreReached: integer;
+ EaseOut_Step: real;
+ ActualScoreValue: integer;
begin
if (ScoreType = 'Note') then
begin
@@ -815,7 +855,7 @@ begin
// quadratic easing out - decelerating to zero velocity
// -end_position * current_time * ( current_time - 2 ) + start_postion
lTmpA := (-ScoreReached * RaiseStep * (RaiseStep - 20));
- if ( lTmpA > 0 ) AND
+ if ( lTmpA > 0 ) and
( RaiseSmoothness > 0 ) then
begin
if (ScoreType = 'Note') then
@@ -869,7 +909,6 @@ begin
Text[TextGoldenNotesScore[Item]].Text := S;
//end of fix
-
end;
end.
diff --git a/unicode/src/screens/UScreenSing.pas b/unicode/src/screens/UScreenSing.pas
index 94d2b550..05683c83 100644
--- a/unicode/src/screens/UScreenSing.pas
+++ b/unicode/src/screens/UScreenSing.pas
@@ -33,24 +33,23 @@ interface
{$I switches.inc}
-
uses
- SDL,
SysUtils,
+ SDL,
+ TextGL,
gl,
- UMenu,
- UMusic,
UFiles,
- UTime,
- USongs,
+ UGraphicClasses,
UIni,
ULog,
- UTexture,
ULyrics,
- TextGL,
+ UMenu,
+ UMusic,
+ USingScores,
+ USongs,
+ UTexture,
UThemes,
- UGraphicClasses,
- USingScores;
+ UTime;
type
TLyricsSyncSource = class(TSyncSource)
@@ -62,22 +61,22 @@ type
private
VideoLoaded: boolean;
protected
- Paused: boolean; //Pause Mod
+ Paused: boolean; // pause mod
LyricsSync: TLyricsSyncSource;
NumEmptySentences: integer;
public
- // TimeBar fields
+ // timebar fields
StaticTimeProgress: integer;
TextTimeText: integer;
StaticP1: integer;
TextP1: integer;
- //shown when game is in 2/4 player modus
+ // shown when game is in 2/4 player modus
StaticP1TwoP: integer;
TextP1TwoP: integer;
- //shown when game is in 3/6 player modus
+ // shown when game is in 3/6 player modus
StaticP1ThreeP: integer;
TextP1ThreeP: integer;
@@ -96,7 +95,7 @@ type
FadeOut: boolean;
Lyrics: TLyricEngine;
- //Score Manager:
+ // score manager:
Scores: TSingScores;
fShowVisualization: boolean;
@@ -106,16 +105,16 @@ type
procedure onShow; override;
procedure onShowFinish; override;
procedure onHide; override;
-
+
function ParseInput(PressedKey: cardinal; CharCode: UCS4Char;
PressedDown: boolean): boolean; override;
function Draw: boolean; override;
procedure Finish; virtual;
- procedure Pause; // Toggle Pause
+ procedure Pause; // toggle pause
- procedure OnSentenceEnd(SentenceIndex: cardinal); // for LineBonus + Singbar
- procedure OnSentenceChange(SentenceIndex: cardinal); // for Golden Notes
+ procedure OnSentenceEnd(SentenceIndex: cardinal); // for linebonus + singbar
+ procedure OnSentenceChange(SentenceIndex: cardinal); // for golden notes
end;
implementation
@@ -123,37 +122,38 @@ implementation
uses
Classes,
Math,
- UGraphic,
UDraw,
- UMain,
- USong,
- URecord,
+ UGraphic,
ULanguage,
+ UNote,
+ URecord,
+ USong,
UUnicodeUtils;
- // Method for input parsing. If False is returned, GetNextWindow
- // should be checked to know the next window to load;
+// method for input parsing. if false is returned, getnextwindow
+// should be checked to know the next window to load;
+
function TScreenSing.ParseInput(PressedKey: Cardinal; CharCode: UCS4Char;
PressedDown: boolean): boolean;
begin
- Result := True;
+ Result := true;
if (PressedDown) then
- begin // Key Down
- // check normal keys
+ begin // key down
+ // check normal keys
case UCS4UpperCase(CharCode) of
Ord('Q'):
begin
- //When not ask before Exit then Finish now
+ // when not ask before exit then finish now
if (Ini.AskbeforeDel <> 1) then
Finish
- //else just Pause and let the Popup make the Work
+ // else just pause and let the popup make the work
else if not Paused then
Pause;
- Result := False;
+ Result := false;
Exit;
end;
- Ord('V'): //Show Visualization
+ Ord('V'): // show visualization
begin
fShowVisualization := not fShowVisualization;
@@ -179,7 +179,7 @@ begin
SDLK_ESCAPE,
SDLK_BACKSPACE:
begin
- //Record Sound Hack:
+ // record sound hack:
//Sound[0].BufferLong
Finish;
@@ -192,7 +192,7 @@ begin
Pause;
end;
- SDLK_TAB: //Change Visualization Preset
+ SDLK_TAB: // change visualization preset
begin
if fShowVisualization then
fCurrentVideoPlaybackEngine.Position := now; // move to a random position
@@ -202,8 +202,8 @@ begin
begin
end;
- // Up and Down could be done at the same time,
- // but I don't want to declare variables inside
+ // up and down could be done at the same time,
+ // but i don't want to declare variables inside
// functions like this one, called so many times
SDLK_DOWN:
begin
@@ -215,57 +215,57 @@ begin
end;
end;
-//Pause Mod
+// pause mod
procedure TScreenSing.Pause;
begin
- if (not Paused) then //enable Pause
+ if (not Paused) then // enable pause
begin
- // pause Time
- Paused := True;
+ // pause time
+ Paused := true;
LyricsState.Pause();
- // pause Music
+ // pause music
AudioPlayback.Pause;
- // pause Video
+ // pause video
if (CurrentSong.Video <> '') and FileExists(CurrentSong.Path +
CurrentSong.Video) then
fCurrentVideoPlaybackEngine.Pause;
end
- else //disable Pause
+ else // disable pause
begin
LyricsState.Resume();
- // Play Music
+ // play music
AudioPlayback.Play;
- // Video
+ // video
if (CurrentSong.Video <> '') and FileExists(CurrentSong.Path +
CurrentSong.Video) then
fCurrentVideoPlaybackEngine.Pause;
- Paused := False;
+ Paused := false;
end;
end;
-//Pause Mod End
+// pause mod end
constructor TScreenSing.Create;
begin
inherited Create;
- fShowVisualization := False;
+ fShowVisualization := false;
fCurrentVideoPlaybackEngine := VideoPlayback;
- //Create Score Class
+ // create score class
Scores := TSingScores.Create;
Scores.LoadfromTheme;
LoadFromTheme(Theme.Sing);
- //TimeBar
+ // timebar
StaticTimeProgress := AddStatic(Theme.Sing.StaticTimeProgress);
TextTimeText := AddText(Theme.Sing.TextTimeText);
@@ -277,7 +277,7 @@ begin
StaticP1TwoP := AddStatic(Theme.Sing.StaticP1TwoP);
TextP1TwoP := AddText(Theme.Sing.TextP1TwoP);
- // | P2
+ // | P2
StaticP2R := AddStatic(Theme.Sing.StaticP2R);
TextP2R := AddText(Theme.Sing.TextP2R);
@@ -285,18 +285,18 @@ begin
StaticP1ThreeP := AddStatic(Theme.Sing.StaticP1ThreeP);
TextP1ThreeP := AddText(Theme.Sing.TextP1ThreeP);
- // | P2
+ // | P2
StaticP2M := AddStatic(Theme.Sing.StaticP2M);
TextP2M := AddText(Theme.Sing.TextP2M);
- // | P3
+ // | P3
StaticP3R := AddStatic(Theme.Sing.StaticP3R);
TextP3R := AddText(Theme.Sing.TextP3R);
StaticPausePopup := AddStatic(Theme.Sing.PausePopUp);
- //<note>Pausepopup is not visibile at the beginning</note>
- Static[StaticPausePopup].Visible := False;
+ // <note> pausepopup is not visibile at the beginning </note>
+ Static[StaticPausePopup].Visible := false;
Lyrics := TLyricEngine.Create(
Skin_LyricsUpperX, Skin_LyricsUpperY, Skin_LyricsUpperW, Skin_LyricsUpperH,
@@ -307,10 +307,10 @@ end;
procedure TScreenSing.onShow;
var
- P: integer;
+ Index: integer;
V1: boolean;
- V1TwoP: boolean; //Position of ScoreBox in two-player mode
- V1ThreeP: boolean; //Position of ScoreBox in three-player mode
+ V1TwoP: boolean; // position of score box in two player mode
+ V1ThreeP: boolean; // position of score box in three player mode
V2R: boolean;
V2M: boolean;
V3R: boolean;
@@ -321,9 +321,9 @@ begin
inherited;
Log.LogStatus('Begin', 'onShow');
- FadeOut := False;
+ FadeOut := false;
- // reset video playback engine, to play Video Clip...
+ // reset video playback engine, to play video clip ...
fCurrentVideoPlaybackEngine := VideoPlayback;
// setup score manager
@@ -333,12 +333,12 @@ begin
Color.B := 0; // dummy atm <- \(O.o)/? B like bummy?
// add new players
- for P := 0 to PlayersPlay - 1 do
+ for Index := 0 to PlayersPlay - 1 do
begin
- Scores.AddPlayer(Tex_ScoreBG[P], Color);
+ Scores.AddPlayer(Tex_ScoreBG[Index], Color);
end;
- Scores.Init; //Get Positions for Players
+ Scores.Init; // get positions for players
// prepare players
SetLength(Player, PlayersPlay);
@@ -346,92 +346,87 @@ begin
case PlayersPlay of
1:
begin
- V1 := True;
- V1TwoP := False;
- V1ThreeP := False;
- V2R := False;
- V2M := False;
- V3R := False;
+ V1 := true;
+ V1TwoP := false;
+ V1ThreeP := false;
+ V2R := false;
+ V2M := false;
+ V3R := false;
end;
2:
begin
- V1 := False;
- V1TwoP := True;
- V1ThreeP := False;
- V2R := True;
- V2M := False;
- V3R := False;
+ V1 := false;
+ V1TwoP := true;
+ V1ThreeP := false;
+ V2R := true;
+ V2M := false;
+ V3R := false;
end;
3:
begin
- V1 := False;
- V1TwoP := False;
- V1ThreeP := True;
- V2R := False;
- V2M := True;
- V3R := True;
+ V1 := false;
+ V1TwoP := false;
+ V1ThreeP := true;
+ V2R := false;
+ V2M := true;
+ V3R := true;
end;
4:
begin // double screen
- V1 := False;
- V1TwoP := True;
- V1ThreeP := False;
- V2R := True;
- V2M := False;
- V3R := False;
+ V1 := false;
+ V1TwoP := true;
+ V1ThreeP := false;
+ V2R := true;
+ V2M := false;
+ V3R := false;
end;
6:
begin // double screen
- V1 := False;
- V1TwoP := False;
- V1ThreeP := True;
- V2R := False;
- V2M := True;
- V3R := True;
+ V1 := false;
+ V1TwoP := false;
+ V1ThreeP := true;
+ V2R := false;
+ V2M := true;
+ V3R := true;
end;
end;
- //This one is shown in 1P mode
+ // this one is shown in 1P mode
Static[StaticP1].Visible := V1;
Text[TextP1].Visible := V1;
-
- //This one is shown in 2/4P mode
+ // this one is shown in 2/4P mode
Static[StaticP1TwoP].Visible := V1TwoP;
Text[TextP1TwoP].Visible := V1TwoP;
Static[StaticP2R].Visible := V2R;
Text[TextP2R].Visible := V2R;
-
- //This one is shown in 3/6P mode
+ // this one is shown in 3/6P mode
Static[StaticP1ThreeP].Visible := V1ThreeP;
Text[TextP1ThreeP].Visible := V1ThreeP;
-
Static[StaticP2M].Visible := V2M;
Text[TextP2M].Visible := V2M;
-
Static[StaticP3R].Visible := V3R;
Text[TextP3R].Visible := V3R;
-
- // FIXME: sets Path and Filename to ''
+ // FIXME: sets path and filename to ''
ResetSingTemp;
CurrentSong := CatSongs.Song[CatSongs.Selected];
- // FIXME: bad style, put the try-except into LoadSong() and not here
+ // FIXME: bad style, put the try-except into loadsong() and not here
try
- // Check if file is XML
+ // check if file is xml
if copy(CurrentSong.FileName, length(CurrentSong.FileName) - 3, 4) = '.xml' then
success := CurrentSong.LoadXMLSong()
else
success := CurrentSong.LoadSong();
except
- success := False;
+ success := false;
end;
if (not success) then
@@ -450,7 +445,7 @@ begin
Exit;
end;
- // reset video playback engine, to play video clip...
+ // reset video playback engine, to play video clip ...
fCurrentVideoPlaybackEngine.Close;
fCurrentVideoPlaybackEngine := VideoPlayback;
@@ -460,32 +455,32 @@ begin
* + Blank : Nothing has been set, this is our fallback
* + Picture : Picture has been set, and exists - otherwise we fallback
* + Video : Video has been set, and exists - otherwise we fallback
- * + Visualization: + Off : No Visialization
- * + WhenNoVideo: Overwrites Blank and Picture
- * + On : Overwrites Blank, Picture and Video
+ * + Visualization: + Off : No visualization
+ * + WhenNoVideo: Overwrites blank and picture
+ * + On : Overwrites blank, picture and video
*}
{*
* set background to: video
*}
- VideoLoaded := False;
- fShowVisualization := False;
+ VideoLoaded := false;
+ fShowVisualization := false;
if (CurrentSong.Video <> '') and FileExists(CurrentSong.Path + CurrentSong.Video) then
begin
if (fCurrentVideoPlaybackEngine.Open(CurrentSong.Path + CurrentSong.Video)) then
begin
- fShowVisualization := False;
+ fShowVisualization := false;
fCurrentVideoPlaybackEngine := VideoPlayback;
fCurrentVideoPlaybackEngine.Position := CurrentSong.VideoGAP + CurrentSong.Start;
fCurrentVideoPlaybackEngine.Play;
- VideoLoaded := True;
+ VideoLoaded := true;
end;
end;
{*
* set background to: picture
*}
- if (CurrentSong.Background <> '') and (VideoLoaded = False)
+ if (CurrentSong.Background <> '') and (VideoLoaded = false)
and (TVisualizerOption(Ini.VisualizerOption) = voOff) then
try
Tex_Background := Texture.LoadTexture(CurrentSong.Path + CurrentSong.Background);
@@ -504,7 +499,7 @@ begin
*}
if (TVisualizerOption(Ini.VisualizerOption) in [voOn]) then
begin
- fShowVisualization := True;
+ fShowVisualization := true;
fCurrentVideoPlaybackEngine := Visualization;
if (fCurrentVideoPlaybackEngine <> nil) then
fCurrentVideoPlaybackEngine.Play;
@@ -514,9 +509,9 @@ begin
* set background to: visualization (Videos are still shown)
*}
if ((TVisualizerOption(Ini.VisualizerOption) in [voWhenNoVideo]) and
- (VideoLoaded = False)) then
+ (VideoLoaded = false)) then
begin
- fShowVisualization := True;
+ fShowVisualization := true;
fCurrentVideoPlaybackEngine := Visualization;
if (fCurrentVideoPlaybackEngine <> nil) then
fCurrentVideoPlaybackEngine.Play;
@@ -541,8 +536,24 @@ begin
// prepare and start voice-capture
AudioInput.CaptureStart;
- for P := 0 to High(Player) do
- ClearScores(P);
+ // clear the scores of all players
+
+ for Index := 0 to High(Player) do
+ with Player[Index] do
+ begin
+ Score := 0;
+ ScoreLine := 0;
+ ScoreGolden := 0;
+
+ ScoreInt := 0;
+ ScoreLineInt := 0;
+ ScoreGoldenInt := 0;
+ ScoreTotalInt := 0;
+
+ ScoreLast := 0;
+
+ LastSentencePerfect := false;
+ end;
// main text
Lyrics.Clear(CurrentSong.BPM[0].BPM, CurrentSong.Resolution);
@@ -589,24 +600,24 @@ begin
end;
end; // case
- // Initialize lyrics by filling its queue
+ // initialize lyrics by filling its queue
while (not Lyrics.IsQueueFull) and
(Lyrics.LineCounter <= High(Lines[0].Line)) do
begin
Lyrics.AddLine(@Lines[0].Line[Lyrics.LineCounter]);
end;
- // Deactivate pause
- Paused := False;
+ // deactivate pause
+ Paused := false;
- // Kill all stars not killed yet (GoldenStarsTwinkle Mod)
+ // kill all stars not killed yet (goldenstarstwinkle mod)
GoldenRec.SentenceChange;
- // set Position of Line Bonus - Line Bonus end
- // set number of empty sentences for Line Bonus
+ // set position of line bonus - line bonus end
+ // set number of empty sentences for line bonus
NumEmptySentences := 0;
- for P := Low(Lines[0].Line) to High(Lines[0].Line) do
- if Lines[0].Line[P].TotalNotes = 0 then
+ for Index := Low(Lines[0].Line) to High(Lines[0].Line) do
+ if Lines[0].Line[Index].TotalNotes = 0 then
Inc(NumEmptySentences);
Log.LogStatus('End', 'onShow');
@@ -626,7 +637,7 @@ end;
procedure TScreenSing.onHide;
begin
- // Unload background texture
+ // background texture
if (Tex_Background.TexNum > 0) then
begin
glDeleteTextures(1, PGLuint(@Tex_Background.TexNum));
@@ -643,10 +654,15 @@ var
T: integer;
CurLyricsTime: real;
begin
-
Background.Draw;
- // set player names (for 2 screens and only Singstar skin)
+ // draw background picture (if any, and if no visualizations)
+ // when we don't check for visualizations the visualizations would
+ // be overdrawn by the picture when {UNDEFINED UseTexture} in UVisualizer
+ if (not fShowVisualization) then
+ SingDrawBackground;
+
+ // set player names (for 2 screens and only singstar skin)
if ScreenAct = 1 then
begin
Text[TextP1].Text := 'P1';
@@ -674,7 +690,6 @@ begin
end; // case
end; // if
-
////
// dual screen, part 1
////////////////////////
@@ -683,29 +698,26 @@ begin
// will move the statics and texts to the correct screen here.
// FIXME: clean up this weird stuff. Commenting this stuff out, nothing
// was missing on screen w/ 6 players - so do we even need this stuff?
- Static[StaticP1].Texture.X := Static[StaticP1].Texture.X + 10 * ScreenX;
+ {Static[StaticP1].Texture.X := Static[StaticP1].Texture.X + 10 * ScreenX;
- Text[TextP1].X := Text[TextP1].X + 10 * ScreenX;
+ Text[TextP1].X := Text[TextP1].X + 10 * ScreenX; }
{Static[StaticP1ScoreBG].Texture.X := Static[StaticP1ScoreBG].Texture.X + 10*ScreenX;
Text[TextP1Score].X := Text[TextP1Score].X + 10*ScreenX;}
+ {Static[StaticP2R].Texture.X := Static[StaticP2R].Texture.X + 10 * ScreenX;
- Static[StaticP2R].Texture.X := Static[StaticP2R].Texture.X + 10 * ScreenX;
-
- Text[TextP2R].X := Text[TextP2R].X + 10 * ScreenX;
+ Text[TextP2R].X := Text[TextP2R].X + 10 * ScreenX; }
{Static[StaticP2RScoreBG].Texture.X := Static[StaticP2RScoreBG].Texture.X + 10*ScreenX;
Text[TextP2RScore].X := Text[TextP2RScore].X + 10*ScreenX;}
// end of weird stuff
+ {
+ Static[1].Texture.X := Static[1].Texture.X + 10 * ScreenX; }
- Static[1].Texture.X := Static[1].Texture.X + 10 * ScreenX;
-
- for T := 0 to 1 do
- Text[T].X := Text[T].X + 10 * ScreenX;
-
-
+ { for T := 0 to 1 do
+ Text[T].X := Text[T].X + 10 * ScreenX; }
// retrieve current lyrics time, we have to store the value to avoid
// that min- and sec-values do not match
@@ -726,15 +738,17 @@ begin
// Note: there is no menu and the animated background brakes the video playback
//DrawBG;
- // Draw Background
- SingDrawBackground;
-
// update and draw movie
if (ShowFinish and (VideoLoaded or fShowVisualization)) then
begin
if assigned(fCurrentVideoPlaybackEngine) then
begin
- fCurrentVideoPlaybackEngine.GetFrame(LyricsState.GetCurrentTime());
+ // Just call this once
+ // when Screens = 2
+ If (ScreenAct = 1) then
+ fCurrentVideoPlaybackEngine.GetFrame(CurrentSong.VideoGAP + LyricsState.GetCurrentTime());
+
+
fCurrentVideoPlaybackEngine.DrawGL(ScreenAct);
end;
end;
@@ -758,7 +772,7 @@ begin
if (not FadeOut) then
begin
Finish;
- FadeOut := True;
+ FadeOut := true;
FadeTo(@ScreenScore);
end;
end;
@@ -767,10 +781,10 @@ begin
// always draw custom items
SingDraw;
- //GoldenNoteStarsTwinkle
+ // goldennotestarstwinkle
GoldenRec.SpawnRec;
- //Draw Scores
+ // draw scores
Scores.Draw;
////
@@ -781,30 +795,30 @@ begin
// will move the statics and texts to the correct screen here.
// FIXME: clean up this weird stuff
- Static[StaticP1].Texture.X := Static[StaticP1].Texture.X - 10 * ScreenX;
+ {Static[StaticP1].Texture.X := Static[StaticP1].Texture.X - 10 * ScreenX;
Text[TextP1].X := Text[TextP1].X - 10 * ScreenX;
Static[StaticP2R].Texture.X := Static[StaticP2R].Texture.X - 10 * ScreenX;
Text[TextP2R].X := Text[TextP2R].X - 10 * ScreenX;
- //end of weird
+ // end of weird
Static[1].Texture.X := Static[1].Texture.X - 10 * ScreenX;
for T := 0 to 1 do
- Text[T].X := Text[T].X - 10 * ScreenX;
+ Text[T].X := Text[T].X - 10 * ScreenX; }
- // Draw Pausepopup
- // FIXME: this is a workaround that the Static is drawn over the Lyrics, Lines, Scores and Effects
+ // draw pausepopup
+ // FIXME: this is a workaround that the static is drawn over the lyrics, lines, scores and effects
// maybe someone could find a better solution
if Paused then
begin
- Static[StaticPausePopup].Visible := True;
+ Static[StaticPausePopup].Visible := true;
Static[StaticPausePopup].Draw;
- Static[StaticPausePopup].Visible := False;
+ Static[StaticPausePopup].Visible := false;
end;
- Result := True;
+ Result := true;
end;
procedure TScreenSing.Finish;
@@ -820,11 +834,11 @@ begin
Visualization.Close;
// to prevent drawing closed video
- VideoLoaded := False;
+ VideoLoaded := false;
- //Kill all Stars and Effects
+ // kill all stars and effects
GoldenRec.KillAll;
-
+
if (Ini.SavePlayback = 1) then
begin
Log.BenchmarkStart(0);
@@ -835,7 +849,7 @@ begin
Log.LogBenchmark('Creating files', 0);
end;
- SetFontItalic(False);
+ SetFontItalic(false);
end;
procedure TScreenSing.OnSentenceEnd(SentenceIndex: cardinal);
@@ -874,14 +888,14 @@ begin
CurrentPlayer := @Player[PlayerIndex];
CurrentScore := CurrentPlayer.Score + CurrentPlayer.ScoreGolden;
- // Line Bonus
+ // line bonus
// points for this line
LineScore := CurrentScore - CurrentPlayer.ScoreLast;
// determine LinePerfection
// Note: the "+2" extra points are a little bonus so the player does not
- // have to be that perfect to reach the bonus steps.
+ // have to be that perfect to reach the bonus steps.
LinePerfection := (LineScore + 2) / MaxLineScore;
// clamp LinePerfection to range [0..1]
@@ -899,7 +913,7 @@ begin
// apply line-bonus
CurrentPlayer.ScoreLine :=
CurrentPlayer.ScoreLine + LineBonus * LinePerfection;
- CurrentPlayer.ScoreLineInt := Round(CurrentPlayer.ScoreLine / 10) * 10;
+ CurrentPlayer.ScoreLineInt := Floor(CurrentPlayer.ScoreLine / 10) * 10;
// update total score
CurrentPlayer.ScoreTotalInt :=
CurrentPlayer.ScoreInt +
@@ -911,7 +925,7 @@ begin
Scores.SpawnPopUp(PlayerIndex, Rating, CurrentPlayer.ScoreTotalInt);
end;
- // PerfectLineTwinkle (effect), Part 1
+ // PerfectLineTwinkle (effect), part 1
if (Ini.EffectSing = 1) then
CurrentPlayer.LastSentencePerfect := (LinePerfection >= 1);
@@ -919,7 +933,7 @@ begin
CurrentPlayer.ScoreLast := CurrentScore;
end;
- // PerfectLineTwinkle (effect), Part 2
+ // PerfectLineTwinkle (effect), part 2
if (Ini.EffectSing = 1) then
GoldenRec.SpawnPerfectLineTwinkle;
end;
@@ -928,14 +942,14 @@ end;
// SentenceIndex: index of the new active sentence
procedure TScreenSing.OnSentenceChange(SentenceIndex: cardinal);
begin
- //GoldenStarsTwinkle
+ // goldenstarstwinkle
GoldenRec.SentenceChange;
- // Fill lyrics queue and set upper line to the current sentence
+ // fill lyrics queue and set upper line to the current sentence
while (Lyrics.GetUpperLineIndex() < SentenceIndex) or
(not Lyrics.IsQueueFull) do
begin
- // Add the next line to the queue or a dummy if no more lines are available
+ // add the next line to the queue or a dummy if no more lines are available
if (Lyrics.LineCounter <= High(Lines[0].Line)) then
Lyrics.AddLine(@Lines[0].Line[Lyrics.LineCounter])
else
diff --git a/unicode/src/screens/UScreenSingModi.pas b/unicode/src/screens/UScreenSingModi.pas
index 5230d33a..b9c9365d 100644
--- a/unicode/src/screens/UScreenSingModi.pas
+++ b/unicode/src/screens/UScreenSingModi.pas
@@ -119,7 +119,19 @@ procedure PlaySound (const Index: Cardinal); stdcall; //Plays a Custom Sou
function ToSentences(Const Lines: TLines): TSentences;
implementation
-uses UGraphic, UDraw, UMain, Classes, URecord, ULanguage, math, UDLLManager, USkins, UGraphicClasses;
+
+uses
+ Classes,
+ Math,
+ UDLLManager,
+ UDraw,
+ UGraphic,
+ UGraphicClasses,
+ ULanguage,
+ UNote,
+ UPath,
+ URecord,
+ USkins;
// Method for input parsing. If False is returned, GetNextWindow
// should be checked to know the next window to load;
@@ -167,7 +179,6 @@ begin
Result.Sentence[I].Start := Lines.Line[I].Start;
Result.Sentence[I].StartNote := Lines.Line[I].Note[0].Start;
Result.Sentence[I].Lyric := Lines.Line[I].Lyric;
- Result.Sentence[I].LyricWidth := Lines.Line[I].LyricWidth;
Result.Sentence[I].End_ := Lines.Line[I].End_;
Result.Sentence[I].BaseNote := Lines.Line[I].BaseNote;
Result.Sentence[I].HighNote := Lines.Line[I].HighNote;
@@ -180,7 +191,7 @@ begin
Result.Sentence[I].Note[J].Start := Lines.Line[I].Note[J].Start;
Result.Sentence[I].Note[J].Length := Lines.Line[I].Note[J].Length;
Result.Sentence[I].Note[J].Tone := Lines.Line[I].Note[J].Tone;
- //Result.Sentence[I].Note[J].Text := Lines.Line[I].Note[J].Tekst;
+ //Result.Sentence[I].Note[J].Text := Lines.Line[I].Note[J].Text;
Result.Sentence[I].Note[J].FreeStyle := (Lines.Line[I].Note[J].NoteType = ntFreestyle);
end;
end;
@@ -299,7 +310,7 @@ function TScreenSingModi.Draw: boolean;
var
Min: integer;
Sec: integer;
- Tekst: string;
+ TextStr: string;
S, I: integer;
T: integer;
CurLyricsTime: real;
@@ -445,82 +456,82 @@ begin
// .. and scores
{if PlayersPlay = 1 then begin
- Tekst := IntToStr(Player[0].ScoreTotalI);
- while Length(Tekst) < 5 do Tekst := '0' + Tekst;
- Text[TextP1Score].Text := Tekst;
+ TextStr := IntToStr(Player[0].ScoreTotalI);
+ while Length(TextStr) < 5 do TextStr := '0' + TextStr;
+ Text[TextP1Score].Text := TextStr;
end;
if PlayersPlay = 2 then begin
- Tekst := IntToStr(Player[0].ScoreTotalI);
- while Length(Tekst) < 5 do Tekst := '0' + Tekst;
- Text[TextP1TwoPScore].Text := Tekst;
+ TextStr := IntToStr(Player[0].ScoreTotalI);
+ while Length(TextStr) < 5 do TextStr := '0' + TextStr;
+ Text[TextP1TwoPScore].Text := TextStr;
- Tekst := IntToStr(Player[1].ScoreTotalI);
- while Length(Tekst) < 5 do Tekst := '0' + Tekst;
- Text[TextP2RScore].Text := Tekst;
+ TextStr := IntToStr(Player[1].ScoreTotalI);
+ while Length(TextStr) < 5 do TextStr := '0' + TextStr;
+ Text[TextP2RScore].Text := TextStr;
end;
if PlayersPlay = 3 then begin
- Tekst := IntToStr(Player[0].ScoreTotalI);
- while Length(Tekst) < 5 do Tekst := '0' + Tekst;
- Text[TextP1ThreePScore].Text := Tekst;
+ TextStr := IntToStr(Player[0].ScoreTotalI);
+ while Length(TextStr) < 5 do TextStr := '0' + TextStr;
+ Text[TextP1ThreePScore].Text := TextStr;
- Tekst := IntToStr(Player[1].ScoreTotalI);
- while Length(Tekst) < 5 do Tekst := '0' + Tekst;
- Text[TextP2MScore].Text := Tekst;
+ TextStr := IntToStr(Player[1].ScoreTotalI);
+ while Length(TextStr) < 5 do TextStr := '0' + TextStr;
+ Text[TextP2MScore].Text := TextStr;
- Tekst := IntToStr(Player[2].ScoreTotalI);
- while Length(Tekst) < 5 do Tekst := '0' + Tekst;
- Text[TextP3RScore].Text := Tekst;
+ TextStr := IntToStr(Player[2].ScoreTotalI);
+ while Length(TextStr) < 5 do TextStr := '0' + TextStr;
+ Text[TextP3RScore].Text := TextStr;
end;
if PlayersPlay = 4 then begin
if ScreenAct = 1 then begin
- Tekst := IntToStr(Player[0].ScoreTotalI);
- while Length(Tekst) < 5 do Tekst := '0' + Tekst;
- Text[TextP1TwoPScore].Text := Tekst;
+ TextStr := IntToStr(Player[0].ScoreTotalI);
+ while Length(TextStr) < 5 do TextStr := '0' + TextStr;
+ Text[TextP1TwoPScore].Text := TextStr;
- Tekst := IntToStr(Player[1].ScoreTotalI);
- while Length(Tekst) < 5 do Tekst := '0' + Tekst;
- Text[TextP2RScore].Text := Tekst;
+ TextStr := IntToStr(Player[1].ScoreTotalI);
+ while Length(TextStr) < 5 do TextStr := '0' + TextStr;
+ Text[TextP2RScore].Text := TextStr;
end;
if ScreenAct = 2 then begin
- Tekst := IntToStr(Player[2].ScoreTotalI);
- while Length(Tekst) < 5 do Tekst := '0' + Tekst;
- Text[TextP1TwoPScore].Text := Tekst;
+ TextStr := IntToStr(Player[2].ScoreTotalI);
+ while Length(TextStr) < 5 do TextStr := '0' + TextStr;
+ Text[TextP1TwoPScore].Text := TextStr;
- Tekst := IntToStr(Player[3].ScoreTotalI);
- while Length(Tekst) < 5 do Tekst := '0' + Tekst;
- Text[TextP2RScore].Text := Tekst;
+ TextStr := IntToStr(Player[3].ScoreTotalI);
+ while Length(TextStr) < 5 do TextStr := '0' + TextStr;
+ Text[TextP2RScore].Text := TextStr;
end;
end;
if PlayersPlay = 6 then begin
if ScreenAct = 1 then begin
- Tekst := IntToStr(Player[0].ScoreTotalI);
- while Length(Tekst) < 5 do Tekst := '0' + Tekst;
- Text[TextP1ThreePScore].Text := Tekst;
+ TextStr := IntToStr(Player[0].ScoreTotalI);
+ while Length(TextStr) < 5 do TextStr := '0' + TextStr;
+ Text[TextP1ThreePScore].Text := TextStr;
- Tekst := IntToStr(Player[1].ScoreTotalI);
- while Length(Tekst) < 5 do Tekst := '0' + Tekst;
- Text[TextP2MScore].Text := Tekst;
+ TextStr := IntToStr(Player[1].ScoreTotalI);
+ while Length(TextStr) < 5 do TextStr := '0' + TextStr;
+ Text[TextP2MScore].Text := TextStr;
- Tekst := IntToStr(Player[2].ScoreTotalI);
- while Length(Tekst) < 5 do Tekst := '0' + Tekst;
- Text[TextP3RScore].Text := Tekst;
+ TextStr := IntToStr(Player[2].ScoreTotalI);
+ while Length(TextStr) < 5 do TextStr := '0' + TextStr;
+ Text[TextP3RScore].Text := TextStr;
end;
if ScreenAct = 2 then begin
- Tekst := IntToStr(Player[3].ScoreTotalI);
- while Length(Tekst) < 5 do Tekst := '0' + Tekst;
- Text[TextP1ThreePScore].Text := Tekst;
+ TextStr := IntToStr(Player[3].ScoreTotalI);
+ while Length(TextStr) < 5 do TextStr := '0' + TextStr;
+ Text[TextP1ThreePScore].Text := TextStr;
- Tekst := IntToStr(Player[4].ScoreTotalI);
- while Length(Tekst) < 5 do Tekst := '0' + Tekst;
- Text[TextP2MScore].Text := Tekst;
+ TextStr := IntToStr(Player[4].ScoreTotalI);
+ while Length(TextStr) < 5 do TextStr := '0' + TextStr;
+ Text[TextP2MScore].Text := TextStr;
- Tekst := IntToStr(Player[5].ScoreTotalI);
- while Length(Tekst) < 5 do Tekst := '0' + Tekst;
- Text[TextP3RScore].Text := Tekst;
+ TextStr := IntToStr(Player[5].ScoreTotalI);
+ while Length(TextStr) < 5 do TextStr := '0' + TextStr;
+ Text[TextP3RScore].Text := TextStr;
end;
end; }
@@ -553,9 +564,7 @@ begin
if (DllMan.Selected.LoadSong) AND (DllMan.Selected.LoadBack) then
SingDrawBackground;
- // comment by blindy: wo zum henker wird denn in diesem screen ein video abgespielt?
// update and draw movie
- // <mog> wie wo wadd? also in der selben funktion in der uscreensing kommt des video in der zeile 995, oder was wollteste wissen? :X
{ if ShowFinish and CurrentSong.VideoLoaded AND DllMan.Selected.LoadVideo then begin
UpdateSmpeg; // this only draws
end;}
@@ -688,7 +697,7 @@ begin
SetFontStyle(Style and 7);
// FIXME: FONTSIZE
// used by Hold_The_Line / TeamDuell
- SetFontSize(Size * 3);
+ SetFontSize(Size);
SetFontPos (X, Y);
glPrint (Language.Translate(String(Text)));
end;
diff --git a/unicode/src/screens/UScreenSong.pas b/unicode/src/screens/UScreenSong.pas
index ac1ee194..da725a59 100644
--- a/unicode/src/screens/UScreenSong.pas
+++ b/unicode/src/screens/UScreenSong.pas
@@ -65,7 +65,7 @@ type
TextNumber: integer;
//Video Icon Mod
- VideoIcon: Cardinal;
+ VideoIcon: cardinal;
TextCat: integer;
StaticCat: integer;
@@ -88,28 +88,28 @@ type
Mode: TSingMode;
//party Statics (Joker)
- StaticTeam1Joker1: Cardinal;
- StaticTeam1Joker2: Cardinal;
- StaticTeam1Joker3: Cardinal;
- StaticTeam1Joker4: Cardinal;
- StaticTeam1Joker5: Cardinal;
-
- StaticTeam2Joker1: Cardinal;
- StaticTeam2Joker2: Cardinal;
- StaticTeam2Joker3: Cardinal;
- StaticTeam2Joker4: Cardinal;
- StaticTeam2Joker5: Cardinal;
-
- StaticTeam3Joker1: Cardinal;
- StaticTeam3Joker2: Cardinal;
- StaticTeam3Joker3: Cardinal;
- StaticTeam3Joker4: Cardinal;
- StaticTeam3Joker5: Cardinal;
-
- StaticParty: array of Cardinal;
- TextParty: array of Cardinal;
- StaticNonParty: array of Cardinal;
- TextNonParty: array of Cardinal;
+ StaticTeam1Joker1: cardinal;
+ StaticTeam1Joker2: cardinal;
+ StaticTeam1Joker3: cardinal;
+ StaticTeam1Joker4: cardinal;
+ StaticTeam1Joker5: cardinal;
+
+ StaticTeam2Joker1: cardinal;
+ StaticTeam2Joker2: cardinal;
+ StaticTeam2Joker3: cardinal;
+ StaticTeam2Joker4: cardinal;
+ StaticTeam2Joker5: cardinal;
+
+ StaticTeam3Joker1: cardinal;
+ StaticTeam3Joker2: cardinal;
+ StaticTeam3Joker3: cardinal;
+ StaticTeam3Joker4: cardinal;
+ StaticTeam3Joker5: cardinal;
+
+ StaticParty: array of cardinal;
+ TextParty: array of cardinal;
+ StaticNonParty: array of cardinal;
+ TextNonParty: array of cardinal;
constructor Create; override;
@@ -120,18 +120,18 @@ type
procedure SetScroll4;
procedure SetScroll5;
procedure SetScroll6;
- function ParseInput(PressedKey: Cardinal; CharCode: UCS4Char; PressedDown: Boolean): Boolean; override;
+ function ParseInput(PressedKey: cardinal; CharCode: UCS4Char; PressedDown: boolean): boolean; override;
function Draw: boolean; override;
procedure GenerateThumbnails();
procedure onShow; override;
procedure onHide; override;
procedure SelectNext;
procedure SelectPrev;
- procedure SkipTo(Target: Cardinal);
+ procedure SkipTo(Target: cardinal);
procedure FixSelected; //Show Wrong Song when Tabs on Fix
procedure FixSelected2; //Show Wrong Song when Tabs on Fix
- procedure ShowCatTL(Cat: Integer);// Show Cat in Top left
- procedure ShowCatTLCustom(Caption: String);// Show Custom Text in Top left
+ procedure ShowCatTL(Cat: integer);// Show Cat in Top left
+ procedure ShowCatTLCustom(Caption: string);// Show Custom Text in Top left
procedure HideCatTL;// Show Cat in Tob left
procedure Refresh; //Refresh Song Sorting
procedure ChangeMusic;
@@ -154,24 +154,26 @@ type
implementation
uses
- UGraphic,
- UMain,
- UCovers,
- math,
+ Math,
gl,
- USkins,
+ UCovers,
UDLLManager,
+ UGraphic,
+ UMain,
+ UMenuButton,
+ UNote,
UParty,
UPlaylist,
- UMenuButton,
- UUnicodeUtils,
- UScreenSongMenu;
+ UScreenSongMenu,
+ USkins,
+ UUnicodeUtils;
// ***** Public methods ****** //
//Show Wrong Song when Tabs on Fix
procedure TScreenSong.FixSelected;
-var I, I2: Integer;
+var
+ I, I2: integer;
begin
if CatSongs.VisibleSongs > 0 then
begin
@@ -191,7 +193,8 @@ begin
end;
procedure TScreenSong.FixSelected2;
-var I, I2: Integer;
+var
+ I, I2: integer;
begin
if CatSongs.VisibleSongs > 0 then
begin
@@ -210,15 +213,15 @@ begin
end;
//Show Wrong Song when Tabs on Fix End
-procedure TScreenSong.ShowCatTLCustom(Caption: String);// Show Custom Text in Top left
+procedure TScreenSong.ShowCatTLCustom(Caption: string);// Show Custom Text in Top left
begin
Text[TextCat].Text := Caption;
Text[TextCat].Visible := true;
- Static[StaticCat].Visible := False;
+ Static[StaticCat].Visible := false;
end;
//Show Cat in Top Left Mod
-procedure TScreenSong.ShowCatTL(Cat: Integer);
+procedure TScreenSong.ShowCatTL(Cat: integer);
begin
//Change
Text[TextCat].Text := CatSongs.Song[Cat].Artist;
@@ -226,7 +229,7 @@ begin
//Show
Text[TextCat].Visible := true;
- Static[StaticCat].Visible := True;
+ Static[StaticCat].Visible := true;
end;
procedure TScreenSong.HideCatTL;
@@ -235,7 +238,7 @@ begin
//Text[TextCat].Visible := false;
Static[StaticCat].Visible := false;
//New -> Show Text specified in Theme
- Text[TextCat].Visible := True;
+ Text[TextCat].Visible := true;
Text[TextCat].Text := Theme.Song.TextCat.Text;
end;
//Show Cat in Top Left Mod End
@@ -243,7 +246,7 @@ end;
// Method for input parsing. If False is returned, GetNextWindow
// should be checked to know the next window to load;
-function TScreenSong.ParseInput(PressedKey: Cardinal; CharCode: UCS4Char; PressedDown: Boolean): Boolean;
+function TScreenSong.ParseInput(PressedKey: cardinal; CharCode: UCS4Char; PressedDown: boolean): boolean;
var
I: integer;
I2: integer;
@@ -388,7 +391,7 @@ begin
begin
if (Songs.SongList.Count > 0) and (Mode = smNormal) then
begin
- ScreenSongJumpto.Visible := True;
+ ScreenSongJumpto.Visible := true;
end;
Exit;
end;
@@ -401,21 +404,22 @@ begin
Ord('R'):
begin
- if (Songs.SongList.Count > 0) and (Mode = smNormal) then
+ if (Songs.SongList.Count > 0) and
+ (Mode = smNormal) then
begin
- if (SDL_ModState = KMOD_LSHIFT) and (Ini.Tabs_at_startup = 1) then //Random Category
+ if (SDL_ModState = KMOD_LSHIFT) and (Ini.TabsAtStartup = 1) then //Random Category
begin
I2 := 0; //Count Cats
- for I:= low(CatSongs.Song) to high (CatSongs.Song) do
+ for I:= 0 to high(CatSongs.Song) do
begin
if CatSongs.Song[I].Main then
Inc(I2);
end;
- I2 := Random (I2)+1; //Zufall
+ I2 := Random(I2)+1; //Zufall
//Find Cat:
- for I:= low(CatSongs.Song) to high (CatSongs.Song) do
+ for I:= 0 to high(CatSongs.Song) do
begin
if CatSongs.Song[I].Main then
Dec(I2);
@@ -434,14 +438,14 @@ begin
end;
end;
end
- else if (SDL_ModState = KMOD_LCTRL) and (Ini.Tabs_at_startup = 1) then //random in All Categorys
+ else if (SDL_ModState = KMOD_LCTRL) and (Ini.TabsAtStartup = 1) then //random in All Categorys
begin
repeat
- I2 := Random(high(CatSongs.Song)+1) - low(CatSongs.Song)+1;
- until CatSongs.Song[I2].Main = false;
+ I2 := Random(high(CatSongs.Song)+1) + 1;
+ until (not CatSongs.Song[I2].Main);
//Search Cat
- for I := I2 downto low(CatSongs.Song) do
+ for I := I2 downto 0 do
begin
if CatSongs.Song[I].Main then
break;
@@ -459,7 +463,8 @@ begin
SelectNext;
//Fix: Not Existing Song selected:
- //if (I+1=I2) then Inc(I2);
+ //if (I+1=I2) then
+ Inc(I2);
//Choose Song
SkipTo(I2-I);
@@ -485,20 +490,20 @@ begin
if (Mode = smNormal) then
begin
//On Escape goto Cat-List Hack
- if (Ini.Tabs_at_startup = 1) and (CatSongs.CatNumShow <> -1) then
+ if (Ini.TabsAtStartup = 1) and (CatSongs.CatNumShow <> -1) then
begin
//Find Category
I := Interaction;
- while not catsongs.Song[I].Main do
- begin
- Dec (I);
- if (I < low(catsongs.Song)) then
+ while (not CatSongs.Song[I].Main) do
+ begin
+ Dec(I);
+ if (I < 0) then
break;
- end;
- if (I<= 1) then
- Interaction := high(catsongs.Song)
+ end;
+ if (I <= 1) then
+ Interaction := high(CatSongs.Song)
else
- Interaction := I - 1;
+ Interaction := I - 1;
//Stop Music
StopMusicPreview();
@@ -513,7 +518,7 @@ begin
SelectNext;
FixSelected;
//SelectPrev;
- //CatSongs.Song[0].Visible := False;
+ //CatSongs.Song[0].Visible := false;
end
else
begin
@@ -553,7 +558,7 @@ begin
end;
SDLK_RETURN:
begin
- if Songs.SongList.Count > 0 then
+ if (Songs.SongList.Count > 0) then
begin
if CatSongs.Song[Interaction].Main then
begin // clicked on Category Button
@@ -610,10 +615,11 @@ begin
if (CatSongs.CatNumShow > -2) then
begin
//Cat Change Hack
- if Ini.Tabs_at_startup = 1 then
+ if Ini.TabsAtStartup = 1 then
begin
I := Interaction;
- if I <= 0 then I := 1;
+ if I <= 0 then
+ I := 1;
while not catsongs.Song[I].Main do
begin
@@ -650,11 +656,12 @@ begin
if (CatSongs.CatNumShow > -2) then
begin
//Cat Change Hack
- if Ini.Tabs_at_startup = 1 then
+ if Ini.TabsAtStartup = 1 then
begin
I := Interaction;
I2 := 0;
- if I <= 0 then I := 1;
+ if I <= 0 then
+ I := 1;
while not catsongs.Song[I].Main or (I2 = 0) do
begin
@@ -740,7 +747,7 @@ begin
end; }
end;
end;
- end;
+ end; // if (PressedDown)
end;
constructor TScreenSong.Create;
@@ -816,7 +823,7 @@ end;
procedure TScreenSong.GenerateThumbnails();
var
- I: Integer;
+ I: integer;
CoverButtonIndex: integer;
CoverButton: TButton;
CoverName: string;
@@ -877,7 +884,7 @@ end;
procedure TScreenSong.SetScroll;
var
- VS, B: Integer;
+ VS, B: integer;
begin
VS := CatSongs.VisibleSongs;
if VS > 0 then
@@ -901,7 +908,7 @@ begin
// Set texts
Text[TextArtist].Text := CatSongs.Song[Interaction].Artist;
Text[TextTitle].Text := CatSongs.Song[Interaction].Title;
- if (Ini.Tabs_at_startup = 1) and (CatSongs.CatNumShow = -1) then
+ if (Ini.TabsAtStartup = 1) and (CatSongs.CatNumShow = -1) then
begin
Text[TextNumber].Text := IntToStr(CatSongs.Song[Interaction].OrderNum) + '/' + IntToStr(CatSongs.CatCount);
Text[TextTitle].Text := '(' + IntToStr(CatSongs.Song[Interaction].CatNumber) + ' ' + Language.Translate('SING_SONGS_IN_CAT') + ')';
@@ -910,7 +917,7 @@ begin
Text[TextNumber].Text := IntToStr(CatSongs.VisibleIndex(Interaction)+1) + '/' + IntToStr(VS)
else if (CatSongs.CatNumShow = -3) then
Text[TextNumber].Text := IntToStr(CatSongs.VisibleIndex(Interaction)+1) + '/' + IntToStr(VS)
- else if (Ini.Tabs_at_startup = 1) then
+ else if (Ini.TabsAtStartup = 1) then
Text[TextNumber].Text := IntToStr(CatSongs.Song[Interaction].CatNumber) + '/' + IntToStr(CatSongs.Song[Interaction - CatSongs.Song[Interaction].CatNumber].CatNumber)
else
Text[TextNumber].Text := IntToStr(Interaction+1) + '/' + IntToStr(Length(CatSongs.Song));
@@ -921,7 +928,7 @@ begin
Text[TextArtist].Text := '';
Text[TextTitle].Text := '';
for B := 0 to High(Button) do
- Button[B].Visible := False;
+ Button[B].Visible := false;
end;
end;
@@ -951,29 +958,37 @@ begin
VisCount := 0;
for B := 0 to High(Button) do
- if CatSongs.Song[B].Visible then Inc(VisCount);
+ if CatSongs.Song[B].Visible then
+ Inc(VisCount);
VisInt := 0;
for B := 0 to Interaction-1 do
- if CatSongs.Song[B].Visible then Inc(VisInt);
+ if CatSongs.Song[B].Visible then
+ Inc(VisInt);
- if VisCount <= 6 then begin
+ if VisCount <= 6 then
+ begin
Typ := 0;
- end else begin
- if VisInt <= 3 then begin
+ end
+ else
+ begin
+ if VisInt <= 3 then
+ begin
Typ := 1;
Count := 7;
Ready := true;
end;
- if (VisCount - VisInt) <= 3 then begin
+ if (VisCount - VisInt) <= 3 then
+ begin
Typ := 2;
Count := 7;
Ready := true;
end;
- if not Ready then begin
+ if not Ready then
+ begin
Typ := 3;
Src := Interaction;
end;
@@ -982,13 +997,15 @@ begin
// hide all buttons
- for B := 0 to High(Button) do begin
+ for B := 0 to High(Button) do
+ begin
Button[B].Visible := false;
Button[B].Selectable := CatSongs.Song[B].Visible;
end;
{
- for B := Src to Dst do begin
+ for B := Src to Dst do
+ begin
//Button[B].Visible := true;
Button[B].Visible := CatSongs.Song[B].Visible;
Button[B].Selectable := Button[B].Visible;
@@ -997,9 +1014,12 @@ begin
}
- if Typ = 0 then begin
- for B := 0 to High(Button) do begin
- if CatSongs.Song[B].Visible then begin
+ if Typ = 0 then
+ begin
+ for B := 0 to High(Button) do
+ begin
+ if CatSongs.Song[B].Visible then
+ begin
Button[B].Visible := true;
Button[B].Y := 140 + (Placed) * 60;
Inc(Placed);
@@ -1007,10 +1027,13 @@ begin
end;
end;
- if Typ = 1 then begin
+ if Typ = 1 then
+ begin
B := 0;
- while (Count > 0) do begin
- if CatSongs.Song[B].Visible then begin
+ while (Count > 0) do
+ begin
+ if CatSongs.Song[B].Visible then
+ begin
Button[B].Visible := true;
Button[B].Y := 140 + (Placed) * 60;
Inc(Placed);
@@ -1020,10 +1043,13 @@ begin
end;
end;
- if Typ = 2 then begin
+ if Typ = 2 then
+ begin
B := High(Button);
- while (Count > 0) do begin
- if CatSongs.Song[B].Visible then begin
+ while (Count > 0) do
+ begin
+ if CatSongs.Song[B].Visible then
+ begin
Button[B].Visible := true;
Button[B].Y := 140 + (6-Placed) * 60;
Inc(Placed);
@@ -1033,11 +1059,14 @@ begin
end;
end;
- if Typ = 3 then begin
+ if Typ = 3 then
+ begin
B := Src;
Count := 4;
- while (Count > 0) do begin
- if CatSongs.Song[B].Visible then begin
+ while (Count > 0) do
+ begin
+ if CatSongs.Song[B].Visible then
+ begin
Button[B].Visible := true;
Button[B].Y := 140 + (3+Placed) * 60;
Inc(Placed);
@@ -1049,8 +1078,10 @@ begin
B := Src-1;
Placed := 0;
Count := 3;
- while (Count > 0) do begin
- if CatSongs.Song[B].Visible then begin
+ while (Count > 0) do
+ begin
+ if CatSongs.Song[B].Visible then
+ begin
Button[B].Visible := true;
Button[B].Y := 140 + (2-Placed) * 60;
Inc(Placed);
@@ -1068,14 +1099,15 @@ end;
procedure TScreenSong.SetScroll2;
var
B: integer;
- //Wsp: integer; // wspolczynnik przesuniecia wzgledem srodka ekranu
- //Wsp2: real;
+ //Factor: integer; // factor of position relative to center of screen
+ //Factor2: real;
begin
- // liniowe
+ // line
for B := 0 to High(Button) do
Button[B].X := 300 + (B - Interaction) * 260;
- if Length(Button) >= 3 then begin
+ if Length(Button) >= 3 then
+ begin
if Interaction = 0 then
Button[High(Button)].X := 300 - 260;
@@ -1083,12 +1115,13 @@ begin
Button[0].X := 300 + 260;
end;
- // kolowe
+ // circle
{
- for B := 0 to High(Button) do begin
- Wsp := (B - Interaction); // 0 dla srodka, -1 dla lewego, +1 dla prawego itd.
- Wsp2 := Wsp / Length(Button);
- Button[B].X := 300 + 10000 * sin(2*pi*Wsp2);
+ for B := 0 to High(Button) do
+ begin
+ Factor := (B - Interaction); // 0 to center, -1: to left, +1 to right
+ Factor2 := Factor / Length(Button);
+ Button[B].X := 300 + 10000 * sin(2*pi*Factor2);
//Button[B].Y := 140 + 50 * ;
end;
}
@@ -1098,23 +1131,24 @@ end;
procedure TScreenSong.SetScroll3; // with slide
var
B: integer;
- //Wsp: integer; // wspolczynnik przesuniecia wzgledem srodka ekranu
- //Wsp2: real;
+ //Factor: integer; // factor of position relative to center of screen
+ //Factor2: real;
begin
SongTarget := Interaction;
- // liniowe
+ // line
for B := 0 to High(Button) do
begin
Button[B].X := 300 + (B - SongCurrent) * 260;
if (Button[B].X < -Button[B].W) or (Button[B].X > 800) then
- Button[B].Visible := False
+ Button[B].Visible := false
else
- Button[B].Visible := True;
+ Button[B].Visible := true;
end;
{
- if Length(Button) >= 3 then begin
+ if Length(Button) >= 3 then
+ begin
if Interaction = 0 then
Button[High(Button)].X := 300 - 260;
@@ -1123,12 +1157,13 @@ begin
end;
}
- // kolowe
+ // circle
{
- for B := 0 to High(Button) do begin
- Wsp := (B - Interaction); // 0 dla srodka, -1 dla lewego, +1 dla prawego itd.
- Wsp2 := Wsp / Length(Button);
- Button[B].X := 300 + 10000 * sin(2*pi*Wsp2);
+ for B := 0 to High(Button) do
+ begin
+ Factor := (B - Interaction); // 0 to center, -1: to left, +1 to right
+ Factor2 := Factor / Length(Button);
+ Button[B].X := 300 + 10000 * sin(2*pi*Factor2);
//Button[B].Y := 140 + 50 * ;
end;
}
@@ -1182,10 +1217,10 @@ procedure TScreenSong.SetScroll5;
var
B: integer;
Angle: real;
- Pos: Real;
+ Pos: real;
VS: integer;
Padding: real;
- X: Real;
+ X: real;
{
Theme.Song.CoverW: circle radius
Theme.Song.CoverX: x-pos. of the left edge of the selected cover
@@ -1257,37 +1292,38 @@ end;
procedure TScreenSong.SetScroll6; // rotate (slotmachine style)
var
B: integer;
- Angle: real;
- Pos: Real;
+ Angle: real;
+ Pos: real;
VS: integer;
- diff: real;
- X: Real;
- Wsp: real;
- Z, Z2: real;
+ diff: real;
+ X: real;
+ Factor: real;
+ Z, Z2: real;
begin
VS := CatSongs.VisibleSongs;
if VS <= 5 then
begin
- // kolowe
+ // circle
for B := 0 to High(Button) do
begin
- Button[B].Visible := CatSongs.Song[B].Visible; // nowe
- if Button[B].Visible then begin // optimization for 1000 songs - updates only visible songs, hiding in tabs becomes useful for maintaing good speed
+ Button[B].Visible := CatSongs.Song[B].Visible;
+ if Button[B].Visible then // optimization for 1000 songs - updates only visible songs, hiding in tabs becomes useful for maintaing good speed
+ begin
+
+ Factor := 2 * pi * (CatSongs.VisibleIndex(B) - SongCurrent) / VS {CatSongs.VisibleSongs};// 0.5.0 (II): takes another 16ms
- Wsp := 2 * pi * (CatSongs.VisibleIndex(B) - SongCurrent) / VS {CatSongs.VisibleSongs};// 0.5.0 (II): takes another 16ms
+ Z := (1 + cos(Factor)) / 2;
+ Z2 := (1 + 2*Z) / 3;
- Z := (1 + cos(Wsp)) / 2;
- Z2 := (1 + 2*Z) / 3;
+ Button[B].Y := Theme.Song.Cover.Y + (0.185 * Theme.Song.Cover.H * VS * sin(Factor)) * Z2 - ((Button[B].H - Theme.Song.Cover.H)/2); // 0.5.0 (I): 2 times faster by not calling CatSongs.VisibleSongs
+ Button[B].Z := Z / 2 + 0.3;
- Button[B].Y := Theme.Song.Cover.Y + (0.185 * Theme.Song.Cover.H * VS * sin(Wsp)) * Z2 - ((Button[B].H - Theme.Song.Cover.H)/2); // 0.5.0 (I): 2 times faster by not calling CatSongs.VisibleSongs
- Button[B].Z := Z / 2 + 0.3;
+ Button[B].W := Theme.Song.Cover.H * Z2;
- Button[B].W := Theme.Song.Cover.H * Z2;
-
- //Button[B].Y := {50 +} 140 + 50 - 50 * Z2;
- Button[B].X := Theme.Song.Cover.X + (Theme.Song.Cover.H - Abs(Button[B].H)) * 0.7 ;
- Button[B].H := Button[B].W;
+ //Button[B].Y := {50 +} 140 + 50 - 50 * Z2;
+ Button[B].X := Theme.Song.Cover.X + (Theme.Song.Cover.H - Abs(Button[B].H)) * 0.7 ;
+ Button[B].H := Button[B].W;
end;
end;
end
@@ -1295,10 +1331,10 @@ begin
begin
//Change Pos of all Buttons
for B := low(Button) to high(Button) do
- begin
- Button[B].Visible := CatSongs.Song[B].Visible; //Adjust Visibility
+ begin
+ Button[B].Visible := CatSongs.Song[B].Visible; //Adjust Visibility
if Button[B].Visible then //Only Change Pos for Visible Buttons
- begin
+ begin
Pos := (CatSongs.VisibleIndex(B) - SongCurrent);
if (Pos < -VS/2) then
Pos := Pos + VS
@@ -1308,7 +1344,7 @@ begin
if (Abs(Pos) < 2.5) then {fixed Positions}
begin
Angle := Pi * (Pos / 5);
- //Button[B].Visible := False;
+ //Button[B].Visible := false;
Button[B].H := Abs(Theme.Song.Cover.H * cos(Angle*0.8));//Power(Z2, 3);
@@ -1331,8 +1367,10 @@ begin
begin {Behind the Front Covers}
// limit-bg-covers hack
- if (abs(VS/2-abs(Pos))>10) then Button[B].Visible:=False;
- if VS > 25 then VS:=25;
+ if (abs(VS/2-abs(Pos))>10) then
+ Button[B].Visible := false;
+ if VS > 25 then
+ VS:=25;
// end of limit-bg-covers hack
if Pos < 0 then
@@ -1375,7 +1413,7 @@ begin
if Ini.Players = 4 then PlayersPlay := 6;
//Cat Mod etc
- if (Ini.Tabs_at_startup = 1) and (CatSongs.CatNumShow = -1) then
+ if (Ini.TabsAtStartup = 1) and (CatSongs.CatNumShow = -1) then
begin
CatSongs.ShowCategoryList;
FixSelected;
@@ -1450,9 +1488,9 @@ end;
function TScreenSong.Draw: boolean;
var
- dx: real;
- dt: real;
- I: Integer;
+ dx: real;
+ dt: real;
+ I: integer;
begin
dx := SongTarget-SongCurrent;
dt := TimeSkip * 7;
@@ -1463,7 +1501,8 @@ begin
SongCurrent := SongCurrent + dx*dt;
{
- if SongCurrent > Catsongs.VisibleSongs then begin
+ if SongCurrent > Catsongs.VisibleSongs then
+ begin
SongCurrent := SongCurrent - Catsongs.VisibleSongs;
SongTarget := SongTarget - Catsongs.VisibleSongs;
end;
@@ -1529,8 +1568,8 @@ end;
procedure TScreenSong.SelectNext;
var
- Skip: integer;
- VS: Integer;
+ Skip: integer;
+ VS: integer;
begin
VS := CatSongs.VisibleSongs;
@@ -1549,22 +1588,23 @@ begin
Interaction := (Interaction + Skip) mod Length(Interactions);
// try to keep all at the beginning
- if SongTarget > VS-1 then begin
+ if SongTarget > VS-1 then
+ begin
SongTarget := SongTarget - VS;
SongCurrent := SongCurrent - VS;
end;
end;
- // Interaction -> Button, ktorego okladke przeczytamy
+ // Interaction -> Button, load cover
// show uncached texture
//Button[Interaction].Texture := Texture.GetTexture(Button[Interaction].Texture.Name, TEXTURE_TYPE_PLAIN, false);
end;
procedure TScreenSong.SelectPrev;
var
- Skip: integer;
- VS: Integer;
+ Skip: integer;
+ VS: integer;
begin
VS := CatSongs.VisibleSongs;
@@ -1574,13 +1614,15 @@ begin
Skip := 1;
- while (not CatSongs.Song[(Interaction - Skip + Length(Interactions)) mod Length(Interactions)].Visible) do Inc(Skip);
+ while (not CatSongs.Song[(Interaction - Skip + Length(Interactions)) mod Length(Interactions)].Visible) do
+ Inc(Skip);
SongTarget := SongTarget - 1;//Skip;
Interaction := (Interaction - Skip + Length(Interactions)) mod Length(Interactions);
// try to keep all at the beginning
- if SongTarget < 0 then begin
+ if SongTarget < 0 then
+ begin
SongTarget := SongTarget + CatSongs.VisibleSongs;
SongCurrent := SongCurrent + CatSongs.VisibleSongs;
end;
@@ -1660,9 +1702,9 @@ begin
end;
end;
-procedure TScreenSong.SkipTo(Target: Cardinal);
+procedure TScreenSong.SkipTo(Target: cardinal);
var
- i: integer;
+ i: integer;
begin
UnLoadDetailedCover;
@@ -1677,13 +1719,13 @@ end;
procedure TScreenSong.SelectRandomSong;
var
- I, I2: Integer;
+ I, I2: integer;
begin
case PlaylistMan.Mode of
smNormal: //All Songs Just Select Random Song
begin
//When Tabs are activated then use Tab Method
- if (Ini.Tabs_at_startup = 1) then
+ if (Ini.TabsAtStartup = 1) then
begin
repeat
I2 := Random(high(CatSongs.Song)+1) - low(CatSongs.Song)+1;
@@ -1756,11 +1798,11 @@ begin
end
else
begin
- Static[StaticTeam1Joker1].Visible := False;
- Static[StaticTeam1Joker2].Visible := False;
- Static[StaticTeam1Joker3].Visible := False;
- Static[StaticTeam1Joker4].Visible := False;
- Static[StaticTeam1Joker5].Visible := False;
+ Static[StaticTeam1Joker1].Visible := false;
+ Static[StaticTeam1Joker2].Visible := false;
+ Static[StaticTeam1Joker3].Visible := false;
+ Static[StaticTeam1Joker4].Visible := false;
+ Static[StaticTeam1Joker5].Visible := false;
end;
if (PartySession.Teams.NumTeams >= 2) then
@@ -1773,11 +1815,11 @@ begin
end
else
begin
- Static[StaticTeam2Joker1].Visible := False;
- Static[StaticTeam2Joker2].Visible := False;
- Static[StaticTeam2Joker3].Visible := False;
- Static[StaticTeam2Joker4].Visible := False;
- Static[StaticTeam2Joker5].Visible := False;
+ Static[StaticTeam2Joker1].Visible := false;
+ Static[StaticTeam2Joker2].Visible := false;
+ Static[StaticTeam2Joker3].Visible := false;
+ Static[StaticTeam2Joker4].Visible := false;
+ Static[StaticTeam2Joker5].Visible := false;
end;
if (PartySession.Teams.NumTeams >= 3) then
@@ -1790,40 +1832,40 @@ begin
end
else
begin
- Static[StaticTeam3Joker1].Visible := False;
- Static[StaticTeam3Joker2].Visible := False;
- Static[StaticTeam3Joker3].Visible := False;
- Static[StaticTeam3Joker4].Visible := False;
- Static[StaticTeam3Joker5].Visible := False;
+ Static[StaticTeam3Joker1].Visible := false;
+ Static[StaticTeam3Joker2].Visible := false;
+ Static[StaticTeam3Joker3].Visible := false;
+ Static[StaticTeam3Joker4].Visible := false;
+ Static[StaticTeam3Joker5].Visible := false;
end;
*)
end
else
begin //Hide all
- Static[StaticTeam1Joker1].Visible := False;
- Static[StaticTeam1Joker2].Visible := False;
- Static[StaticTeam1Joker3].Visible := False;
- Static[StaticTeam1Joker4].Visible := False;
- Static[StaticTeam1Joker5].Visible := False;
-
- Static[StaticTeam2Joker1].Visible := False;
- Static[StaticTeam2Joker2].Visible := False;
- Static[StaticTeam2Joker3].Visible := False;
- Static[StaticTeam2Joker4].Visible := False;
- Static[StaticTeam2Joker5].Visible := False;
-
- Static[StaticTeam3Joker1].Visible := False;
- Static[StaticTeam3Joker2].Visible := False;
- Static[StaticTeam3Joker3].Visible := False;
- Static[StaticTeam3Joker4].Visible := False;
- Static[StaticTeam3Joker5].Visible := False;
+ Static[StaticTeam1Joker1].Visible := false;
+ Static[StaticTeam1Joker2].Visible := false;
+ Static[StaticTeam1Joker3].Visible := false;
+ Static[StaticTeam1Joker4].Visible := false;
+ Static[StaticTeam1Joker5].Visible := false;
+
+ Static[StaticTeam2Joker1].Visible := false;
+ Static[StaticTeam2Joker2].Visible := false;
+ Static[StaticTeam2Joker3].Visible := false;
+ Static[StaticTeam2Joker4].Visible := false;
+ Static[StaticTeam2Joker5].Visible := false;
+
+ Static[StaticTeam3Joker1].Visible := false;
+ Static[StaticTeam3Joker2].Visible := false;
+ Static[StaticTeam3Joker3].Visible := false;
+ Static[StaticTeam3Joker4].Visible := false;
+ Static[StaticTeam3Joker5].Visible := false;
end;
end;
procedure TScreenSong.SetStatics;
var
- I: Integer;
- Visible: Boolean;
+ I: integer;
+ Visible: boolean;
begin
//Set Visibility of Party Statics and Text
Visible := (Mode = smPartyMode);
@@ -1867,7 +1909,7 @@ begin
CatSongs.Selected := Interaction;
StopMusicPreview();
- ScreenName.Goto_SingScreen := True;
+ ScreenName.Goto_SingScreen := true;
FadeTo(@ScreenName);
end;
diff --git a/unicode/src/screens/UScreenSongMenu.pas b/unicode/src/screens/UScreenSongMenu.pas
index 8098548c..b8720b86 100644
--- a/unicode/src/screens/UScreenSongMenu.pas
+++ b/unicode/src/screens/UScreenSongMenu.pas
@@ -45,38 +45,36 @@ uses
type
TScreenSongMenu = class(TMenu)
private
- CurMenu: Byte; //Num of the cur. Shown Menu
+ CurMenu: byte; // num of the cur. shown menu
public
- Visible: Boolean; //Whether the Menu should be Drawn
+ Visible: boolean; // whether the menu should be drawn
constructor Create; override;
- function ParseInput(PressedKey: Cardinal; CharCode: UCS4Char; PressedDown: Boolean): Boolean; override;
+ function ParseInput(PressedKey: cardinal; CharCode: UCS4Char; PressedDown: boolean): boolean; override;
procedure onShow; override;
function Draw: boolean; override;
- procedure MenuShow(sMenu: Byte);
+ procedure MenuShow(sMenu: byte);
procedure HandleReturn;
end;
const
SM_Main = 1;
-
- SM_PlayList = 64 or 1;
- SM_Playlist_Add = 64 or 2;
- SM_Playlist_New = 64 or 3;
- SM_Playlist_DelItem = 64 or 5;
+ SM_PlayList = 64 or 1;
+ SM_Playlist_Add = 64 or 2;
+ SM_Playlist_New = 64 or 3;
- SM_Playlist_Load = 64 or 8 or 1;
- SM_Playlist_Del = 64 or 8 or 5;
+ SM_Playlist_DelItem = 64 or 5;
+ SM_Playlist_Load = 64 or 8 or 1;
+ SM_Playlist_Del = 64 or 8 or 5;
- SM_Party_Main = 128 or 1;
- SM_Party_Joker = 128 or 2;
+ SM_Party_Main = 128 or 1;
+ SM_Party_Joker = 128 or 2;
var
- ISelections: Array of string;
- SelectValue: Integer;
-
+ ISelections: array of string;
+ SelectValue: integer;
implementation
@@ -91,12 +89,12 @@ uses
USongs,
UUnicodeUtils;
-function TScreenSongMenu.ParseInput(PressedKey: Cardinal; CharCode: UCS4Char; PressedDown: Boolean): Boolean;
+function TScreenSongMenu.ParseInput(PressedKey: cardinal; CharCode: UCS4Char; PressedDown: boolean): boolean;
begin
Result := true;
if (PressedDown) then
- begin // Key Down
- if (CurMenu = SM_Playlist_New) AND (Interaction=0) then
+ begin // key down
+ if (CurMenu = SM_Playlist_New) and (Interaction=0) then
begin
// check normal keys
if IsAlphaNumericChar(CharCode) or
@@ -131,10 +129,10 @@ begin
// check special keys
case PressedKey of
SDLK_ESCAPE,
- SDLK_BACKSPACE :
+ SDLK_BACKSPACE:
begin
AudioPlayback.PlaySound(SoundLib.Back);
- Visible := False;
+ Visible := false;
end;
SDLK_RETURN:
@@ -142,8 +140,8 @@ begin
HandleReturn;
end;
- SDLK_DOWN: InteractNext;
- SDLK_UP: InteractPrev;
+ SDLK_DOWN: InteractNext;
+ SDLK_UP: InteractPrev;
SDLK_RIGHT:
begin
@@ -157,8 +155,8 @@ begin
end;
SDLK_1:
- begin //Jocker
- //Use Joker
+ begin // jocker
+ // use joker
case CurMenu of
SM_Party_Main:
begin
@@ -167,8 +165,8 @@ begin
end;
end;
SDLK_2:
- begin //Jocker
- //Use Joker
+ begin // jocker
+ // use joker
case CurMenu of
SM_Party_Main:
begin
@@ -177,8 +175,8 @@ begin
end;
end;
SDLK_3:
- begin //Jocker
- //Use Joker
+ begin // jocker
+ // use joker
case CurMenu of
SM_Party_Main:
begin
@@ -193,12 +191,12 @@ end;
constructor TScreenSongMenu.Create;
begin
inherited Create;
-
- //Create Dummy SelectSlide Entrys
+
+ // create dummy selectslide entrys
SetLength(ISelections, 1);
ISelections[0] := 'Dummy';
-
+
AddText(Theme.SongMenu.TextMenu);
LoadFromTheme(Theme.SongMenu);
@@ -221,7 +219,6 @@ begin
if (Length(Button[3].Text) = 0) then
AddButtonText(14, 20, 'Button 4');
-
Interaction := 0;
end;
@@ -233,24 +230,23 @@ end;
procedure TScreenSongMenu.onShow;
begin
inherited;
-
end;
-procedure TScreenSongMenu.MenuShow(sMenu: Byte);
+procedure TScreenSongMenu.MenuShow(sMenu: byte);
begin
- Interaction := 0; //Reset Interaction
- Visible := True; //Set Visible
- Case sMenu of
+ Interaction := 0; // reset interaction
+ Visible := true; // set visible
+ case sMenu of
SM_Main:
begin
CurMenu := sMenu;
Text[0].Text := Language.Translate('SONG_MENU_NAME_MAIN');
- Button[0].Visible := True;
- Button[1].Visible := True;
- Button[2].Visible := True;
- Button[3].Visible := True;
- SelectsS[0].Visible := False;
+ Button[0].Visible := true;
+ Button[1].Visible := true;
+ Button[2].Visible := true;
+ Button[3].Visible := true;
+ SelectsS[0].Visible := false;
Button[0].Text[0].Text := Language.Translate('SONG_MENU_PLAY');
Button[1].Text[0].Text := Language.Translate('SONG_MENU_CHANGEPLAYERS');
@@ -263,11 +259,11 @@ begin
CurMenu := sMenu;
Text[0].Text := Language.Translate('SONG_MENU_NAME_PLAYLIST');
- Button[0].Visible := True;
- Button[1].Visible := True;
- Button[2].Visible := True;
- Button[3].Visible := True;
- SelectsS[0].Visible := False;
+ Button[0].Visible := true;
+ Button[1].Visible := true;
+ Button[2].Visible := true;
+ Button[3].Visible := true;
+ SelectsS[0].Visible := false;
Button[0].Text[0].Text := Language.Translate('SONG_MENU_PLAY');
Button[1].Text[0].Text := Language.Translate('SONG_MENU_CHANGEPLAYERS');
@@ -280,11 +276,11 @@ begin
CurMenu := sMenu;
Text[0].Text := Language.Translate('SONG_MENU_NAME_PLAYLIST_ADD');
- Button[0].Visible := True;
- Button[1].Visible := False;
- Button[2].Visible := False;
- Button[3].Visible := True;
- SelectsS[0].Visible := True;
+ Button[0].Visible := true;
+ Button[1].Visible := false;
+ Button[2].Visible := false;
+ Button[3].Visible := true;
+ SelectsS[0].Visible := true;
Button[0].Text[0].Text := Language.Translate('SONG_MENU_PLAYLIST_ADD_NEW');
Button[3].Text[0].Text := Language.Translate('SONG_MENU_PLAYLIST_ADD_EXISTING');
@@ -298,9 +294,9 @@ begin
end
else
begin
- Button[3].Visible := False;
- SelectsS[0].Visible := False;
- Button[2].Visible := True;
+ Button[3].Visible := false;
+ SelectsS[0].Visible := false;
+ Button[2].Visible := true;
Button[2].Text[0].Text := Language.Translate('SONG_MENU_PLAYLIST_NOEXISTING');
end;
end;
@@ -310,11 +306,11 @@ begin
CurMenu := sMenu;
Text[0].Text := Language.Translate('SONG_MENU_NAME_PLAYLIST_NEW');
- Button[0].Visible := True;
- Button[1].Visible := False;
- Button[2].Visible := True;
- Button[3].Visible := True;
- SelectsS[0].Visible := False;
+ Button[0].Visible := true;
+ Button[1].Visible := false;
+ Button[2].Visible := true;
+ Button[3].Visible := true;
+ SelectsS[0].Visible := false;
Button[0].Text[0].Text := Language.Translate('SONG_MENU_PLAYLIST_NEW_UNNAMED');
Button[2].Text[0].Text := Language.Translate('SONG_MENU_PLAYLIST_NEW_CREATE');
@@ -326,11 +322,11 @@ begin
CurMenu := sMenu;
Text[0].Text := Language.Translate('SONG_MENU_NAME_PLAYLIST_DELITEM');
- Button[0].Visible := True;
- Button[1].Visible := False;
- Button[2].Visible := False;
- Button[3].Visible := True;
- SelectsS[0].Visible := False;
+ Button[0].Visible := true;
+ Button[1].Visible := false;
+ Button[2].Visible := false;
+ Button[3].Visible := true;
+ SelectsS[0].Visible := false;
Button[0].Text[0].Text := Language.Translate('SONG_MENU_YES');
Button[3].Text[0].Text := Language.Translate('SONG_MENU_CANCEL');
@@ -341,13 +337,13 @@ begin
CurMenu := sMenu;
Text[0].Text := Language.Translate('SONG_MENU_NAME_PLAYLIST_LOAD');
- //Show Delete Curent Playlist Button when Playlist is opened
+ // show delete curent playlist button when playlist is opened
Button[0].Visible := (CatSongs.CatNumShow = -3);
- Button[1].Visible := False;
- Button[2].Visible := False;
- Button[3].Visible := True;
- SelectsS[0].Visible := True;
+ Button[1].Visible := false;
+ Button[2].Visible := false;
+ Button[3].Visible := true;
+ SelectsS[0].Visible := true;
Button[0].Text[0].Text := Language.Translate('SONG_MENU_PLAYLIST_DELCURRENT');
Button[3].Text[0].Text := Language.Translate('SONG_MENU_PLAYLIST_LOAD');
@@ -362,9 +358,9 @@ begin
end
else
begin
- Button[3].Visible := False;
- SelectsS[0].Visible := False;
- Button[2].Visible := True;
+ Button[3].Visible := false;
+ SelectsS[0].Visible := false;
+ Button[2].Visible := true;
Button[2].Text[0].Text := Language.Translate('SONG_MENU_PLAYLIST_NOEXISTING');
Interaction := 2;
end;
@@ -375,27 +371,26 @@ begin
CurMenu := sMenu;
Text[0].Text := Language.Translate('SONG_MENU_NAME_PLAYLIST_DEL');
- Button[0].Visible := True;
- Button[1].Visible := False;
- Button[2].Visible := False;
- Button[3].Visible := True;
- SelectsS[0].Visible := False;
+ Button[0].Visible := true;
+ Button[1].Visible := false;
+ Button[2].Visible := false;
+ Button[3].Visible := true;
+ SelectsS[0].Visible := false;
Button[0].Text[0].Text := Language.Translate('SONG_MENU_YES');
Button[3].Text[0].Text := Language.Translate('SONG_MENU_CANCEL');
end;
-
SM_Party_Main:
begin
CurMenu := sMenu;
Text[0].Text := Language.Translate('SONG_MENU_NAME_PARTY_MAIN');
- Button[0].Visible := True;
- Button[1].Visible := False;
- Button[2].Visible := False;
- Button[3].Visible := True;
- SelectsS[0].Visible := False;
+ Button[0].Visible := true;
+ Button[1].Visible := false;
+ Button[2].Visible := false;
+ Button[3].Visible := true;
+ SelectsS[0].Visible := false;
Button[0].Text[0].Text := Language.Translate('SONG_MENU_PLAY');
//Button[1].Text[0].Text := Language.Translate('SONG_MENU_JOKER');
@@ -408,172 +403,175 @@ begin
CurMenu := sMenu;
Text[0].Text := Language.Translate('SONG_MENU_NAME_PARTY_JOKER');
// to-do : Party
- {Button[0].Visible := (PartySession.Teams.NumTeams >= 1) AND (PartySession.Teams.Teaminfo[0].Joker > 0);
- Button[1].Visible := (PartySession.Teams.NumTeams >= 2) AND (PartySession.Teams.Teaminfo[1].Joker > 0);
- Button[2].Visible := (PartySession.Teams.NumTeams >= 3) AND (PartySession.Teams.Teaminfo[2].Joker > 0);}
- Button[3].Visible := True;
- SelectsS[0].Visible := False;
-
- {Button[0].Text[0].Text := String(PartySession.Teams.Teaminfo[0].Name);
+{
+ Button[0].Visible := (PartySession.Teams.NumTeams >= 1) and (PartySession.Teams.Teaminfo[0].Joker > 0);
+ Button[1].Visible := (PartySession.Teams.NumTeams >= 2) and (PartySession.Teams.Teaminfo[1].Joker > 0);
+ Button[2].Visible := (PartySession.Teams.NumTeams >= 3) and (PartySession.Teams.Teaminfo[2].Joker > 0);
+}
+ Button[3].Visible := true;
+ SelectsS[0].Visible := false;
+{
+ Button[0].Text[0].Text := String(PartySession.Teams.Teaminfo[0].Name);
Button[1].Text[0].Text := String(PartySession.Teams.Teaminfo[1].Name);
- Button[2].Text[0].Text := String(PartySession.Teams.Teaminfo[2].Name);}
+ Button[2].Text[0].Text := String(PartySession.Teams.Teaminfo[2].Name);
+}
Button[3].Text[0].Text := Language.Translate('SONG_MENU_CANCEL');
- //Set right Interaction
+ // set right interaction
if (not Button[0].Visible) then
begin
if (not Button[1].Visible) then
begin
if (not Button[2].Visible) then
- begin
- Interaction := 4;
- end
- else Interaction := 2;
+ Interaction := 4
+ else
+ Interaction := 2;
end
- else Interaction := 1;
+ else
+ Interaction := 1;
end;
-
+
end;
end;
end;
procedure TScreenSongMenu.HandleReturn;
begin
- Case CurMenu of
+ case CurMenu of
SM_Main:
begin
- Case Interaction of
- 0: //Button 1
+ case Interaction of
+ 0: // button 1
begin
ScreenSong.StartSong;
- Visible := False;
+ Visible := false;
end;
- 1: //Button 2
+ 1: // button 2
begin
- //Select New Players then Sing:
+ // select new players then sing:
ScreenSong.SelectPlayers;
- Visible := False;
+ Visible := false;
end;
- 2: //Button 3
+ 2: // button 3
begin
- //Show add to Playlist Menu
+ // show add to playlist menu
MenuShow(SM_Playlist_Add);
end;
- 3: //SelectSlide 3
+ 3: // selectslide 3
begin
//Dummy
end;
- 4: //Button 4
+ 4: // button 4
begin
ScreenSong.OpenEditor;
- Visible := False;
+ Visible := false;
end;
end;
end;
SM_PlayList:
begin
- Visible := False;
- Case Interaction of
- 0: //Button 1
+ Visible := false;
+ case Interaction of
+ 0: // button 1
begin
ScreenSong.StartSong;
- Visible := False;
+ Visible := false;
end;
- 1: //Button 2
+ 1: // button 2
begin
- //Select New Players then Sing:
+ // select new players then sing:
ScreenSong.SelectPlayers;
- Visible := False;
+ Visible := false;
end;
- 2: //Button 3
+ 2: // button 3
begin
- //Show add to Playlist Menu
+ // show add to playlist menu
MenuShow(SM_Playlist_DelItem);
end;
- 3: //SelectSlide 3
+ 3: // selectslide 3
begin
- //Dummy
+ // dummy
end;
- 4: //Button 4
+ 4: // button 4
begin
ScreenSong.OpenEditor;
- Visible := False;
+ Visible := false;
end;
end;
end;
SM_Playlist_Add:
begin
- Case Interaction of
- 0: //Button 1
+ case Interaction of
+ 0: // button 1
begin
MenuShow(SM_Playlist_New);
end;
- 3: //SelectSlide 3
+ 3: // selectslide 3
begin
- //Dummy
+ // dummy
end;
- 4: //Button 4
+ 4: // button 4
begin
PlaylistMan.AddItem(ScreenSong.Interaction, SelectValue);
- Visible := False;
+ Visible := false;
end;
end;
end;
SM_Playlist_New:
begin
- Case Interaction of
- 0: //Button 1
+ case Interaction of
+ 0: // button 1
begin
- //Nothing, Button for Entering Name
+ // nothing, button for entering name
end;
- 2: //Button 3
+ 2: // button 3
begin
- //Create Playlist and Add Song
+ // create playlist and add song
PlaylistMan.AddItem(
ScreenSong.Interaction,
PlaylistMan.AddPlaylist(Button[0].Text[0].Text));
- Visible := False;
+ Visible := false;
end;
- 3: //SelectSlide 3
+ 3: // selectslide 3
begin
- //Cancel -> Go back to Add screen
+ // cancel -> go back to add screen
MenuShow(SM_Playlist_Add);
end;
- 4: //Button 4
+ 4: // button 4
begin
- Visible := False;
+ Visible := false;
end;
end;
end;
SM_Playlist_DelItem:
begin
- Visible := False;
- Case Interaction of
- 0: //Button 1
+ Visible := false;
+ case Interaction of
+ 0: // button 1
begin
- //Delete
+ // delete
PlayListMan.DelItem(PlayListMan.GetIndexbySongID(ScreenSong.Interaction));
- Visible := False;
+ Visible := false;
end;
- 4: //Button 4
+ 4: // button 4
begin
MenuShow(SM_Playlist);
end;
@@ -582,32 +580,32 @@ begin
SM_Playlist_Load:
begin
- Case Interaction of
- 0: //Button 1 (Delete Playlist)
+ case Interaction of
+ 0: // button 1 (Delete playlist)
begin
MenuShow(SM_Playlist_Del);
end;
- 4: //Button 4
+ 4: // button 4
begin
- //Load Playlist
+ // load playlist
PlaylistMan.SetPlayList(SelectValue);
- Visible := False;
+ Visible := false;
end;
end;
end;
SM_Playlist_Del:
begin
- Visible := False;
- Case Interaction of
- 0: //Button 1
+ Visible := false;
+ case Interaction of
+ 0: // button 1
begin
- //Delete
+ // delete
PlayListMan.DelPlaylist(PlaylistMan.CurPlayList);
- Visible := False;
+ Visible := false;
end;
- 4: //Button 4
+ 4: // button 4
begin
MenuShow(SM_Playlist_Load);
end;
@@ -616,17 +614,17 @@ begin
SM_Party_Main:
begin
- Case Interaction of
- 0: //Button 1
+ case Interaction of
+ 0: // button 1
begin
- //Start Singing
+ // start singing
ScreenSong.StartSong;
- Visible := False;
+ Visible := false;
end;
- 4: //Button 4
+ 4: // button 4
begin
- //Joker
+ // joker
MenuShow(SM_Party_Joker);
end;
end;
@@ -634,29 +632,29 @@ begin
SM_Party_Joker:
begin
- Visible := False;
- Case Interaction of
- 0: //Button 1
+ Visible := false;
+ case Interaction of
+ 0: // button 1
begin
- //Joker Team 1
+ // joker team 1
ScreenSong.DoJoker(0);
end;
- 1: //Button 2
+ 1: // button 2
begin
- //Joker Team 2
+ // joker team 2
ScreenSong.DoJoker(1);
end;
- 2: //Button 3
+ 2: // button 3
begin
- //Joker Team 3
+ // joker team 3
ScreenSong.DoJoker(2);
end;
- 4: //Button 4
+ 4: // button 4
begin
- //Cancel... (Fo back to old Menu)
+ // cancel... (go back to old menu)
MenuShow(SM_Party_Main);
end;
end;
@@ -665,4 +663,3 @@ begin
end;
end.
-
diff --git a/unicode/src/screens/UScreenTop5.pas b/unicode/src/screens/UScreenTop5.pas
index ba990dc6..eaa90ab1 100644
--- a/unicode/src/screens/UScreenTop5.pas
+++ b/unicode/src/screens/UScreenTop5.pas
@@ -34,10 +34,10 @@ interface
{$I switches.inc}
uses
- SDL,
SysUtils,
- UMenu,
+ SDL,
UDisplay,
+ UMenu,
UMusic,
USongs,
UThemes;
@@ -45,17 +45,18 @@ uses
type
TScreenTop5 = class(TMenu)
public
- TextLevel: integer;
- TextArtistTitle: integer;
+ TextLevel: integer;
+ TextArtistTitle: integer;
- StaticNumber: array[1..5] of integer;
- TextNumber: array[1..5] of integer;
- TextName: array[1..5] of integer;
- TextScore: array[1..5] of integer;
+ StaticNumber: array[1..5] of integer;
+ TextNumber: array[1..5] of integer;
+ TextName: array[1..5] of integer;
+ TextScore: array[1..5] of integer;
+
+ Fadeout: boolean;
- Fadeout: boolean;
constructor Create; override;
- function ParseInput(PressedKey: Cardinal; CharCode: UCS4Char; PressedDown: Boolean): Boolean; override;
+ function ParseInput(PressedKey: cardinal; CharCode: UCS4Char; PressedDown: boolean): boolean; override;
procedure onShow; override;
function Draw: boolean; override;
end;
@@ -63,16 +64,18 @@ type
implementation
uses
- UGraphic,
UDataBase,
+ UGraphic,
UMain,
UIni,
+ UNote,
UUnicodeUtils;
-function TScreenTop5.ParseInput(PressedKey: Cardinal; CharCode: UCS4Char; PressedDown: Boolean): Boolean;
+function TScreenTop5.ParseInput(PressedKey: cardinal; CharCode: UCS4Char; PressedDown: boolean): boolean;
begin
Result := true;
- If (PressedDown) Then begin
+ if (PressedDown) then
+ begin
// check normal keys
case UCS4UpperCase(CharCode) of
Ord('Q'):
@@ -81,14 +84,15 @@ begin
Exit;
end;
end;
-
+
// check special keys
case PressedKey of
SDLK_ESCAPE,
SDLK_BACKSPACE,
SDLK_RETURN:
begin
- if (not Fadeout) then begin
+ if (not Fadeout) then
+ begin
FadeTo(@ScreenSong);
Fadeout := true;
end;
@@ -103,7 +107,7 @@ end;
constructor TScreenTop5.Create;
var
- I: integer;
+ I: integer;
begin
inherited Create;
@@ -127,8 +131,8 @@ end;
procedure TScreenTop5.onShow;
var
- I: integer;
- PMax: integer;
+ I: integer;
+ PMax: integer;
begin
inherited;
@@ -147,7 +151,8 @@ begin
Text[TextArtistTitle].Text := CurrentSong.Artist + ' - ' + CurrentSong.Title;
- for I := 1 to Length(CurrentSong.Score[Ini.Difficulty]) do begin
+ for I := 1 to Length(CurrentSong.Score[Ini.Difficulty]) do
+ begin
Static[StaticNumber[I]].Visible := true;
Text[TextNumber[I]].Visible := true;
Text[TextName[I]].Visible := true;
@@ -157,7 +162,8 @@ begin
Text[TextScore[I]].Text := IntToStr(CurrentSong.Score[Ini.Difficulty, I-1].Score);
end;
- for I := Length(CurrentSong.Score[Ini.Difficulty])+1 to 5 do begin
+ for I := Length(CurrentSong.Score[Ini.Difficulty])+1 to 5 do
+ begin
Static[StaticNumber[I]].Visible := false;
Text[TextNumber[I]].Visible := false;
Text[TextName[I]].Visible := false;
@@ -169,25 +175,30 @@ end;
function TScreenTop5.Draw: boolean;
//var
-{ Min: real;
- Max: real;
- Wsp: real;
- Wsp2: real;
- Pet: integer;}
-
-{ Item: integer;
- P: integer;
- C: integer;}
+{
+ Min: real;
+ Max: real;
+ Factor: real;
+ Factor2: real;
+
+ Item: integer;
+ P: integer;
+ C: integer;
+}
begin
// Singstar - let it be...... with 6 statics
-(* if PlayersPlay = 6 then begin
- for Item := 4 to 6 do begin
+(*
+ if PlayersPlay = 6 then
+ begin
+ for Item := 4 to 6 do
+ begin
if ScreenAct = 1 then P := Item-4;
if ScreenAct = 2 then P := Item-1;
FillPlayer(Item, P);
-
-{ if ScreenAct = 1 then begin
+{
+ if ScreenAct = 1 then
+ begin
LoadColor(
Static[StaticBoxLightest[Item]].Texture.ColR,
Static[StaticBoxLightest[Item]].Texture.ColG,
@@ -195,16 +206,18 @@ begin
'P1Dark');
end;
- if ScreenAct = 2 then begin
+ if ScreenAct = 2 then
+ begin
LoadColor(
Static[StaticBoxLightest[Item]].Texture.ColR,
Static[StaticBoxLightest[Item]].Texture.ColG,
Static[StaticBoxLightest[Item]].Texture.ColB,
'P4Dark');
- end; }
-
+ end;
+}
end;
- end; *)
+ end;
+*)
Result := inherited Draw;
end;
diff --git a/unicode/src/screens/UScreenWelcome.pas b/unicode/src/screens/UScreenWelcome.pas
index ead30c10..4df2b6f7 100644
--- a/unicode/src/screens/UScreenWelcome.pas
+++ b/unicode/src/screens/UScreenWelcome.pas
@@ -94,8 +94,8 @@ function TScreenWelcome.Draw: boolean;
var
Min: real;
Max: real;
- Wsp: real;
- Pet: integer;
+ Factor: real;
+ Count: integer;
begin
// star animation
Animation := Animation + TimeSkip*1000;
@@ -108,34 +108,34 @@ begin
// popup
Min := 1000; Max := 1120;
if (Animation >= Min) and (Animation < Max) then begin
- Wsp := (Animation - Min) / (Max - Min);
+ Factor := (Animation - Min) / (Max - Min);
Static[0].Texture.X := 600;
- Static[0].Texture.Y := 600 - Wsp * 230;
+ Static[0].Texture.Y := 600 - Factor * 230;
Static[0].Texture.W := 200;
- Static[0].Texture.H := Wsp * 230;
+ Static[0].Texture.H := Factor * 230;
end;
// bounce
Min := 1120; Max := 1200;
if (Animation >= Min) and (Animation < Max) then begin
- Wsp := (Animation - Min) / (Max - Min);
- Static[0].Texture.Y := 370 + Wsp * 50;
- Static[0].Texture.H := 230 - Wsp * 50;
+ Factor := (Animation - Min) / (Max - Min);
+ Static[0].Texture.Y := 370 + Factor * 50;
+ Static[0].Texture.H := 230 - Factor * 50;
end;
// run
Min := 1500; Max := 3500;
if (Animation >= Min) and (Animation < Max) then begin
- Wsp := (Animation - Min) / (Max - Min);
+ Factor := (Animation - Min) / (Max - Min);
- Static[0].Texture.X := 600 - Wsp * 1400;
+ Static[0].Texture.X := 600 - Factor * 1400;
Static[0].Texture.H := 180;
- for Pet := 1 to 5 do begin
- Static[Pet].Texture.X := 770 - Wsp * 1400;
- Static[Pet].Texture.W := 150 + Wsp * 200;
- Static[Pet].Texture.Alpha := Wsp * 0.5;
+ for Count := 1 to 5 do begin
+ Static[Count].Texture.X := 770 - Factor * 1400;
+ Static[Count].Texture.W := 150 + Factor * 200;
+ Static[Count].Texture.Alpha := Factor * 0.5;
end;
end;
diff --git a/unicode/src/ultrastardx.dpr b/unicode/src/ultrastardx.dpr
index d4664cfc..f48e9ada 100644
--- a/unicode/src/ultrastardx.dpr
+++ b/unicode/src/ultrastardx.dpr
@@ -35,7 +35,6 @@ program ultrastardx;
{$I switches.inc}
-// TODO: check if this is needed for MacOSX too
{$IFDEF MSWINDOWS}
// Set global application-type (GUI/CONSOLE) switch for Windows.
// CONSOLE is the default for FPC, GUI for Delphi, so we have
@@ -193,6 +192,8 @@ uses
URingBuffer in 'base\URingBuffer.pas',
USingScores in 'base\USingScores.pas',
USingNotes in 'base\USingNotes.pas',
+ UPath in 'base\UPath.pas',
+ UNote in 'base\UNote.pas',
TextGL in 'base\TextGL.pas',
UUnicodeUtils in 'base\UUnicodeUtils.pas',