aboutsummaryrefslogtreecommitdiffstats
path: root/Lua/src/menu
diff options
context:
space:
mode:
Diffstat (limited to 'Lua/src/menu')
-rw-r--r--Lua/src/menu/UDisplay.pas380
-rw-r--r--Lua/src/menu/UMenu.pas583
-rw-r--r--Lua/src/menu/UMenuBackground.pas166
-rw-r--r--Lua/src/menu/UMenuBackgroundColor.pas140
-rw-r--r--Lua/src/menu/UMenuBackgroundFade.pas346
-rw-r--r--Lua/src/menu/UMenuBackgroundNone.pas136
-rw-r--r--Lua/src/menu/UMenuBackgroundTexture.pas248
-rw-r--r--Lua/src/menu/UMenuBackgroundVideo.pas405
-rw-r--r--Lua/src/menu/UMenuButton.pas185
-rw-r--r--Lua/src/menu/UMenuButtonCollection.pas32
-rw-r--r--Lua/src/menu/UMenuEqualizer.pas145
-rw-r--r--Lua/src/menu/UMenuInteract.pas13
-rw-r--r--Lua/src/menu/UMenuSelectSlide.pas301
-rw-r--r--Lua/src/menu/UMenuStatic.pas11
-rw-r--r--Lua/src/menu/UMenuText.pas205
15 files changed, 1926 insertions, 1370 deletions
diff --git a/Lua/src/menu/UDisplay.pas b/Lua/src/menu/UDisplay.pas
index 525b73a9..f8f9c43f 100644
--- a/Lua/src/menu/UDisplay.pas
+++ b/Lua/src/menu/UDisplay.pas
@@ -34,78 +34,116 @@ interface
{$I switches.inc}
uses
- ucommon,
+ UCommon,
SDL,
- UMenu,
gl,
glu,
SysUtils,
+ UMenu,
+ UPath,
UMusic,
UHookableEvent;
type
TDisplay = class
private
+ ePreDraw: THookableEvent;
+ eDraw: THookableEvent;
+
//fade-to-black-hack
- BlackScreen: Boolean;
+ BlackScreen: boolean;
- FadeEnabled: Boolean; // true if fading is enabled
- FadeFailed: Boolean; // true if fading is possible (enough memory, etc.)
- FadeState: integer; // fading state, 0 means that the fade texture must be initialized
- LastFadeTime: Cardinal; // last fade update time
+ FadeEnabled: boolean; // true if fading is enabled
+ FadeFailed: boolean; // true if fading is possible (enough memory, etc.)
+ FadeState: integer; // fading state, 0 means that the fade texture must be initialized
+ LastFadeTime: cardinal; // last fade update time
- FadeTex: array[1..2] of GLuint;
+ FadeTex: array[1..2] of GLuint;
+
+ FPSCounter: cardinal;
+ LastFPS: cardinal;
+ NextFPSSwap: cardinal;
- FPSCounter : Cardinal;
- LastFPS : Cardinal;
- NextFPSSwap : Cardinal;
+ OSD_LastError: string;
- OSD_LastError : String;
+ { software cursor data }
+ Cursor_X: double;
+ Cursor_Y: double;
+ Cursor_Pressed: boolean;
+ Cursor_HiddenByScreen: boolean; // hides software cursor and deactivate auto fade in
- ePreDraw: THookableEvent;
- eDraw: THookableEvent;
+ // used for cursor fade out when there is no movement
+ Cursor_Visible: boolean;
+ Cursor_LastMove: cardinal;
+ Cursor_Fade: boolean;
procedure DrawDebugInformation;
+
+ { called by MoveCursor and OnMouseButton to update last move and start fade in }
+ procedure UpdateCursorFade;
public
- NextScreen : PMenu;
- CurrentScreen : PMenu;
+ NextScreen: PMenu;
+ CurrentScreen: PMenu;
//popup data
NextScreenWithCheck: Pmenu;
- CheckOK : Boolean;
+ CheckOK: boolean;
// FIXME: Fade is set to 0 in UMain and other files but not used here anymore.
- Fade : Real;
+ Fade: real;
constructor Create;
destructor Destroy; override;
procedure SaveScreenShot;
+ function Draw: boolean;
+
+ { calls ParseInput of cur or next Screen if assigned }
+ function ParseInput(PressedKey: cardinal; CharCode: UCS4Char; PressedDown : boolean): boolean;
+
+ { sets SDL_ShowCursor depending on options set in Ini }
+ procedure SetCursor;
+
+ { called when cursor moves, positioning of software cursor }
+ procedure MoveCursor(X, Y: double);
+
+ { called when left or right mousebutton is pressed or released }
+ procedure OnMouseButton(Pressed: boolean);
{ fades to specific screen (playing specified sound) }
function FadeTo(Screen: PMenu; const aSound: TAudioPlaybackStream = nil): PMenu;
{ abort fading to the current screen, may be used in OnShow, or during fade process }
procedure AbortScreenChange;
- function Draw: Boolean;
+ { draws software cursor }
+ procedure DrawCursor;
end;
var
- Display: TDisplay;
+ Display: TDisplay;
+
+const
+ { constants for software cursor effects
+ time in milliseconds }
+ Cursor_FadeIn_Time = 500; // seconds the fade in effect lasts
+ Cursor_FadeOut_Time = 2000; // seconds the fade out effect lasts
+ Cursor_AutoHide_Time = 5000; // seconds until auto fade out starts if there is no mouse movement
implementation
uses
- UImage,
TextGL,
+ UCommandLine,
+ UGraphic,
+ UIni,
+ UImage,
ULog,
UMain,
UTexture,
- UIni,
- UGraphic,
UTime,
- UCommandLine;
+ ULanguage,
+ UPathUtils;
constructor TDisplay.Create;
var
@@ -113,16 +151,20 @@ var
begin
inherited Create;
+ // create events for plugins
+ ePreDraw := THookableEvent.Create('Display.PreDraw');
+ eDraw := THookableEvent.Create('Display.Draw');
+
//popup hack
- CheckOK := False;
+ CheckOK := false;
NextScreen := nil;
NextScreenWithCheck := nil;
- BlackScreen := False;
+ BlackScreen := false;
// fade mod
- FadeState := 0;
+ FadeState := 0;
FadeEnabled := (Ini.ScreenFade = 1);
- FadeFailed:= false;
+ FadeFailed := false;
glGenTextures(2, @FadeTex);
@@ -136,9 +178,14 @@ begin
//Set LastError for OSD to No Error
OSD_LastError := 'No Errors';
- // create events for plugins
- ePreDraw := THookableEvent.Create('Display.PreDraw');
- eDraw := THookableEvent.Create('Display.Draw');
+ // software cursor default values
+ Cursor_LastMove := 0;
+ Cursor_Visible := false;
+ Cursor_Pressed := false;
+ Cursor_X := -1;
+ Cursor_Y := -1;
+ Cursor_Fade := false;
+ Cursor_HiddenByScreen := true;
end;
destructor TDisplay.Destroy;
@@ -147,14 +194,14 @@ begin
inherited Destroy;
end;
-function TDisplay.Draw: Boolean;
+function TDisplay.Draw: boolean;
var
- S: integer;
- FadeStateSquare: Real;
- currentTime: Cardinal;
- glError: glEnum;
+ S: integer;
+ FadeStateSquare: real;
+ currentTime: cardinal;
+ glError: glEnum;
begin
- Result := True;
+ Result := true;
//We don't need this here anymore,
//Because the background care about cleaning the buffers
@@ -180,12 +227,12 @@ begin
begin
NextScreen := NextScreenWithCheck;
NextScreenWithCheck := nil;
- CheckOk := False;
+ CheckOk := false;
end
else
begin
// on end of game fade to black before exit
- BlackScreen := True;
+ BlackScreen := true;
end;
end;
@@ -197,15 +244,17 @@ begin
//popup mod
if (ScreenPopupError <> nil) and ScreenPopupError.Visible then
ScreenPopupError.Draw
+ else if (ScreenPopupInfo <> nil) and ScreenPopupInfo.Visible then
+ ScreenPopupInfo.Draw
else if (ScreenPopupCheck <> nil) and ScreenPopupCheck.Visible then
ScreenPopupCheck.Draw;
// fade mod
FadeState := 0;
if ((Ini.ScreenFade = 1) and (not FadeFailed)) then
- FadeEnabled := True
+ FadeEnabled := true
else if (Ini.ScreenFade = 0) then
- FadeEnabled := False;
+ FadeEnabled := false;
eDraw.CallHookChain(false);
end
@@ -214,7 +263,7 @@ begin
// disable fading if initialization failed
if (FadeEnabled and FadeFailed) then
begin
- FadeEnabled := False;
+ FadeEnabled := false;
end;
if (FadeEnabled and not FadeFailed) then
@@ -251,7 +300,7 @@ begin
// blackscreen-hack
if not BlackScreen then
- NextScreen.onShow;
+ NextScreen.OnShow;
// update fade state
LastFadeTime := SDL_GetTicks();
@@ -299,7 +348,7 @@ begin
glDisable(GL_BLEND);
glDisable(GL_TEXTURE_2D);
end
- // blackscreen hack
+// blackscreen hack
else if not BlackScreen then
begin
NextScreen.OnShow;
@@ -310,26 +359,208 @@ begin
// fade out complete...
FadeState := 0;
CurrentScreen.onHide;
- CurrentScreen.ShowFinish := False;
+ CurrentScreen.ShowFinish := false;
CurrentScreen := NextScreen;
NextScreen := nil;
if not BlackScreen then
begin
- CurrentScreen.onShowFinish;
+ CurrentScreen.OnShowFinish;
CurrentScreen.ShowFinish := true;
end
else
begin
- Result := False;
+ Result := false;
Break;
end;
end;
end; // if
- //Draw OSD only on first Screen if Debug Mode is enabled
+// Draw OSD only on first Screen if Debug Mode is enabled
if ((Ini.Debug = 1) or (Params.Debug)) and (S = 1) then
DrawDebugInformation;
end; // for
+
+ if not BlackScreen then
+ DrawCursor;
+end;
+
+{ sets SDL_ShowCursor depending on options set in Ini }
+procedure TDisplay.SetCursor;
+var
+ Cursor: Integer;
+begin
+ Cursor := 0;
+
+ if (CurrentScreen <> @ScreenSing) or (Cursor_HiddenByScreen) then
+ begin // hide cursor on singscreen
+ if (Ini.Mouse = 0) and (Ini.FullScreen = 0) then
+ // show sdl (os) cursor in window mode even when mouse support is off
+ Cursor := 1
+ else if (Ini.Mouse = 1) then
+ // show sdl (os) cursor when hardware cursor is selected
+ Cursor := 1;
+
+ if (Ini.Mouse <> 2) then
+ Cursor_HiddenByScreen := false;
+ end
+ else if (Ini.Mouse <> 2) then
+ Cursor_HiddenByScreen := true;
+
+
+ SDL_ShowCursor(Cursor);
+
+ if (Ini.Mouse = 2) then
+ begin
+ if Cursor_HiddenByScreen then
+ begin
+ // show software cursor
+ Cursor_HiddenByScreen := false;
+ Cursor_Visible := false;
+ Cursor_Fade := false;
+ end
+ else if (CurrentScreen = @ScreenSing) then
+ begin
+ // hide software cursor in singscreen
+ Cursor_HiddenByScreen := true;
+ Cursor_Visible := false;
+ Cursor_Fade := false;
+ end;
+ end;
+end;
+
+{ called by MoveCursor and OnMouseButton to update last move and start fade in }
+procedure TDisplay.UpdateCursorFade;
+var
+ Ticks: cardinal;
+begin
+ Ticks := SDL_GetTicks;
+
+ { fade in on movement (or button press) if not first movement }
+ if (not Cursor_Visible) and (Cursor_LastMove <> 0) then
+ begin
+ if Cursor_Fade then // we use a trick here to consider progress of fade out
+ Cursor_LastMove := Ticks - round(Cursor_FadeIn_Time * (1 - (Ticks - Cursor_LastMove)/Cursor_FadeOut_Time))
+ else
+ Cursor_LastMove := Ticks;
+
+ Cursor_Visible := true;
+ Cursor_Fade := true;
+ end
+ else if not Cursor_Fade then
+ begin
+ Cursor_LastMove := Ticks;
+ end;
+end;
+
+{ called when cursor moves, positioning of software cursor }
+procedure TDisplay.MoveCursor(X, Y: double);
+begin
+ if (Ini.Mouse = 2) and
+ ((X <> Cursor_X) or (Y <> Cursor_Y)) then
+ begin
+ Cursor_X := X;
+ Cursor_Y := Y;
+
+ UpdateCursorFade;
+ end;
+end;
+
+{ called when left or right mousebutton is pressed or released }
+procedure TDisplay.OnMouseButton(Pressed: boolean);
+begin
+ if (Ini.Mouse = 2) then
+ begin
+ Cursor_Pressed := Pressed;
+
+ UpdateCursorFade;
+ end;
+end;
+
+{ draws software cursor }
+procedure TDisplay.DrawCursor;
+var
+ Alpha: single;
+ Ticks: cardinal;
+begin
+ if (Ini.Mouse = 2) then
+ begin // draw software cursor
+ Ticks := SDL_GetTicks;
+
+ if (Cursor_Visible) and (Cursor_LastMove + Cursor_AutoHide_Time <= Ticks) then
+ begin // start fade out after 5 secs w/o activity
+ Cursor_Visible := false;
+ Cursor_LastMove := Ticks;
+ Cursor_Fade := true;
+ end;
+
+ // fading
+ if Cursor_Fade then
+ begin
+ if Cursor_Visible then
+ begin // fade in
+ if (Cursor_LastMove + Cursor_FadeIn_Time <= Ticks) then
+ Cursor_Fade := false
+ else
+ Alpha := sin((Ticks - Cursor_LastMove) * 0.5 * pi / Cursor_FadeIn_Time) * 0.7;
+ end
+ else
+ begin //fade out
+ if (Cursor_LastMove + Cursor_FadeOut_Time <= Ticks) then
+ Cursor_Fade := false
+ else
+ Alpha := cos((Ticks - Cursor_LastMove) * 0.5 * pi / Cursor_FadeOut_Time) * 0.7;
+ end;
+ end;
+
+ // no else if here because we may turn off fade in if block
+ if not Cursor_Fade then
+ begin
+ if Cursor_Visible then
+ Alpha := 0.7 // alpha when cursor visible and not fading
+ else
+ Alpha := 0; // alpha when cursor is hidden
+ end;
+
+ if (Alpha > 0) and (not Cursor_HiddenByScreen) then
+ begin
+ glColor4f(1, 1, 1, Alpha);
+ glEnable(GL_TEXTURE_2D);
+ glEnable(GL_BLEND);
+ glDisable(GL_DEPTH_TEST);
+
+ if (Cursor_Pressed) and (Tex_Cursor_Pressed.TexNum > 0) then
+ glBindTexture(GL_TEXTURE_2D, Tex_Cursor_Pressed.TexNum)
+ else
+ glBindTexture(GL_TEXTURE_2D, Tex_Cursor_Unpressed.TexNum);
+
+ glBegin(GL_QUADS);
+ glTexCoord2f(0, 0);
+ glVertex2f(Cursor_X, Cursor_Y);
+
+ glTexCoord2f(0, 1);
+ glVertex2f(Cursor_X, Cursor_Y + 32);
+
+ glTexCoord2f(1, 1);
+ glVertex2f(Cursor_X + 32, Cursor_Y + 32);
+
+ glTexCoord2f(1, 0);
+ glVertex2f(Cursor_X + 32, Cursor_Y);
+ glEnd;
+
+ glDisable(GL_BLEND);
+ glDisable(GL_TEXTURE_2D);
+ end;
+ end;
+end;
+
+function TDisplay.ParseInput(PressedKey: cardinal; CharCode: UCS4Char; PressedDown : boolean): boolean;
+begin
+ if (assigned(NextScreen)) then
+ Result := NextScreen^.ParseInput(PressedKey, CharCode, PressedDown)
+ else if (assigned(CurrentScreen)) then
+ Result := CurrentScreen^.ParseInput(PressedKey, CharCode, PressedDown)
+ else
+ Result := True;
end;
{ abort fading to the next screen, may be used in OnShow, or during fade process }
@@ -374,7 +605,8 @@ end;
procedure TDisplay.SaveScreenShot;
var
Num: integer;
- FileName: string;
+ FileName: IPath;
+ Prefix: UTF8String;
ScreenData: PChar;
Surface: PSDL_Surface;
Success: boolean;
@@ -382,17 +614,16 @@ var
RowSize: integer;
begin
// Exit if Screenshot-path does not exist or read-only
- if (ScreenshotsPath = '') then
+ if (ScreenshotsPath.IsUnset) then
Exit;
for Num := 1 to 9999 do
begin
- FileName := IntToStr(Num);
- while Length(FileName) < 4 do
- FileName := '0' + FileName;
- FileName := ScreenshotsPath + 'screenshot' + FileName + '.png';
- if not FileExists(FileName) then
- break
+ // fill prefix to 4 digits with leading '0', e.g. '0001'
+ Prefix := Format('screenshot%.4d', [Num]);
+ FileName := ScreenshotsPath.Append(Prefix + '.png');
+ if not FileName.Exists() then
+ break;
end;
// we must take the row-alignment (4byte by default) into account
@@ -402,33 +633,34 @@ begin
GetMem(ScreenData, RowSize * ScreenH);
glReadPixels(0, 0, ScreenW, ScreenH, GL_RGB, GL_UNSIGNED_BYTE, ScreenData);
-// on big endian machines (powerpc) this may need to be changed to
-// Needs to be tests. KaMiSchi Sept 2008
-// in this case one may have to add " glext, " to the list of used units
-// glReadPixels(0, 0, ScreenW, ScreenH, GL_BGR, GL_UNSIGNED_BYTE, ScreenData);
+ // on big endian machines (powerpc) this may need to be changed to
+ // Needs to be tests. KaMiSchi Sept 2008
+ // in this case one may have to add " glext, " to the list of used units
+ // glReadPixels(0, 0, ScreenW, ScreenH, GL_BGR, GL_UNSIGNED_BYTE, ScreenData);
Surface := SDL_CreateRGBSurfaceFrom(
ScreenData, ScreenW, ScreenH, 24, RowSize,
$0000FF, $00FF00, $FF0000, 0);
- //Success := WriteJPGImage(FileName, Surface, 95);
- //Success := WriteBMPImage(FileName, Surface);
+ // Success := WriteJPGImage(FileName, Surface, 95);
+ // Success := WriteBMPImage(FileName, Surface);
Success := WritePNGImage(FileName, Surface);
if Success then
- ScreenPopupError.ShowPopup('Screenshot saved: ' + ExtractFileName(FileName))
+ ScreenPopupInfo.ShowPopup(Format(Language.Translate('SCREENSHOT_SAVED'), [FileName.GetName.ToUTF8()]))
else
- ScreenPopupError.ShowPopup('Screenshot failed');
+ ScreenPopupError.ShowPopup(Language.Translate('SCREENSHOT_FAILED'));
SDL_FreeSurface(Surface);
FreeMem(ScreenData);
end;
//------------
-// DrawDebugInformation - Procedure draw FPS and some other Informations on Screen
+// DrawDebugInformation - procedure draw fps and some other informations on screen
//------------
procedure TDisplay.DrawDebugInformation;
-var Ticks: Cardinal;
+var
+ Ticks: cardinal;
begin
- //Some White Background for information
+ // Some White Background for information
glEnable(GL_BLEND);
glDisable(GL_TEXTURE_2D);
glColor4f(1, 1, 1, 0.5);
@@ -440,13 +672,13 @@ begin
glEnd;
glDisable(GL_BLEND);
- //Set Font Specs
+ // set font specs
SetFontStyle(0);
SetFontSize(21);
- SetFontItalic(False);
+ SetFontItalic(false);
glColor4f(0, 0, 0, 1);
- //Calculate FPS
+ // calculate fps
Ticks := SDL_GetTicks();
if (Ticks >= NextFPSSwap) then
begin
@@ -457,17 +689,17 @@ begin
Inc(FPSCounter);
- //Draw Text
+ // draw text
- //FPS
+ // fps
SetFontPos(695, 0);
glPrint ('FPS: ' + InttoStr(LastFPS));
- //RSpeed
+ // rspeed
SetFontPos(695, 13);
glPrint ('RSpeed: ' + InttoStr(Round(1000 * TimeMid)));
- //LastError
+ // lasterror
SetFontPos(695, 26);
glColor4f(1, 0, 0, 1);
glPrint (OSD_LastError);
diff --git a/Lua/src/menu/UMenu.pas b/Lua/src/menu/UMenu.pas
index 16ecc658..3ac487de 100644
--- a/Lua/src/menu/UMenu.pas
+++ b/Lua/src/menu/UMenu.pas
@@ -34,19 +34,21 @@ interface
{$I switches.inc}
uses
- gl,
SysUtils,
- UTexture,
- UMenuStatic,
- UMenuText,
- UMenuButton,
- UMenuSelectSlide,
- UMenuInteract,
+ Math,
+ gl,
+ SDL,
+ UPath,
UMenuBackground,
- UThemes,
+ UMenuButton,
UMenuButtonCollection,
- Math,
- UMusic;
+ UMenuInteract,
+ UMenuSelectSlide,
+ UMenuStatic,
+ UMenuText,
+ UMusic,
+ UTexture,
+ UThemes;
type
{ Int16 = SmallInt;}
@@ -54,15 +56,15 @@ type
PMenu = ^TMenu;
TMenu = class
protected
- Background: TMenuBackground;
+ Background: TMenuBackground;
- Interactions: array of TInteract;
- SelInteraction: integer;
+ Interactions: array of TInteract;
+ SelInteraction: integer;
- ButtonPos: integer;
- Button: array of TButton;
-
- SelectsS: array of TSelectSlide;
+ ButtonPos: integer;
+ Button: array of TButton;
+
+ SelectsS: array of TSelectSlide;
ButtonCollection: array of TButtonCollection;
public
Text: array of TText;
@@ -72,6 +74,7 @@ type
Fade: integer; // fade type
ShowFinish: boolean; // true if there is no fade
+ RightMbESC: boolean; // true to simulate ESC keypress when RMB is pressed
destructor Destroy; override;
constructor Create; overload; virtual;
@@ -79,13 +82,11 @@ type
//constructor Create(Back: string; W, H: integer); overload; virtual; // W and H are the number of overlaps
// interaction
- function WideCharUpperCase(wchar: WideChar) : WideString;
- function WideStringUpperCase(wstring: WideString) : WideString;
procedure AddInteraction(Typ, Num: integer);
- procedure SetInteraction(Num: integer);
+ procedure SetInteraction(Num: integer); virtual;
property Interaction: integer read SelInteraction write SetInteraction;
- //Procedure Load BG, Texts, Statics and Button Collections from ThemeBasic
+ // procedure load bg, texts, statics and button collections from themebasic
procedure LoadFromTheme(const ThemeBasic: TThemeBasic);
procedure PrepareButtonCollections(const Collections: AThemeButtonCollection);
@@ -96,61 +97,62 @@ type
// static
function AddStatic(ThemeStatic: TThemeStatic): integer; overload;
- function AddStatic(X, Y, W, H: real; const Name: string): integer; overload;
- function AddStatic(X, Y, W, H: real; const Name: string; Typ: TTextureType): integer; overload;
- function AddStatic(X, Y, W, H: real; ColR, ColG, ColB: real; const Name: string; Typ: TTextureType): integer; overload;
- function AddStatic(X, Y, W, H, Z: real; ColR, ColG, ColB: real; const Name: string; Typ: TTextureType): integer; overload;
- function AddStatic(X, Y, W, H: real; ColR, ColG, ColB: real; const Name: string; Typ: TTextureType; Color: integer): integer; overload;
- function AddStatic(X, Y, W, H, Z: real; ColR, ColG, ColB: real; const Name: string; Typ: TTextureType; Color: integer): integer; overload;
- function AddStatic(X, Y, W, H, Z: real; ColR, ColG, ColB: real; TexX1, TexY1, TexX2, TexY2: real; const Name: string; Typ: TTextureType; Color: integer; Reflection: boolean; ReflectionSpacing: real): integer; overload;
+ function AddStatic(X, Y, W, H: real; const TexName: IPath): integer; overload;
+ function AddStatic(X, Y, W, H: real; const TexName: IPath; Typ: TTextureType): integer; overload;
+ function AddStatic(X, Y, W, H: real; ColR, ColG, ColB: real; const TexName: IPath; Typ: TTextureType): integer; overload;
+ function AddStatic(X, Y, W, H, Z: real; ColR, ColG, ColB: real; const TexName: IPath; Typ: TTextureType): integer; overload;
+ function AddStatic(X, Y, W, H: real; ColR, ColG, ColB: real; const TexName: IPath; Typ: TTextureType; Color: integer): integer; overload;
+ function AddStatic(X, Y, W, H, Z: real; ColR, ColG, ColB: real; const TexName: IPath; Typ: TTextureType; Color: integer): integer; overload;
+ function AddStatic(X, Y, W, H, Z: real; ColR, ColG, ColB: real; TexX1, TexY1, TexX2, TexY2: real; const TexName: IPath; Typ: TTextureType; Color: integer; Reflection: boolean; ReflectionSpacing: real): integer; overload;
// text
function AddText(ThemeText: TThemeText): integer; overload;
- function AddText(X, Y: real; const Text_: string): integer; overload;
- function AddText(X, Y: real; Style: integer; Size, ColR, ColG, ColB: real; const Text: string): integer; overload;
- function AddText(X, Y, W: real; Style: integer; Size, ColR, ColG, ColB: real; Align: integer; const Text_: string; Reflection_: boolean; ReflectionSpacing_: real; Z : real): integer; overload;
+ function AddText(X, Y: real; const Text_: UTF8String): integer; overload;
+ function AddText(X, Y: real; Style: integer; Size, ColR, ColG, ColB: real; const Text: UTF8String): integer; overload;
+ function AddText(X, Y, W: real; Style: integer; Size, ColR, ColG, ColB: real; Align: integer; const Text_: UTF8String; Reflection_: boolean; ReflectionSpacing_: real; Z : real): integer; overload;
// button
- Procedure SetButtonLength(Length: cardinal); //Function that Set Length of Button Array in one Step instead of register new Memory for every Button
+ procedure SetButtonLength(Length: cardinal); //Function that Set Length of Button Array in one Step instead of register new Memory for every Button
function AddButton(ThemeButton: TThemeButton): integer; overload;
- function AddButton(X, Y, W, H: real; const Name: string): integer; overload;
- function AddButton(X, Y, W, H: real; const Name: string; Typ: TTextureType; Reflection: boolean): integer; overload;
- function AddButton(X, Y, W, H, ColR, ColG, ColB, Int, DColR, DColG, DColB, DInt: real; const Name: string; Typ: TTextureType; Reflection: boolean; ReflectionSpacing, DeSelectReflectionSpacing: real): integer; overload;
+ function AddButton(X, Y, W, H: real; const TexName: IPath): integer; overload;
+ function AddButton(X, Y, W, H: real; const TexName: IPath; Typ: TTextureType; Reflection: boolean): integer; overload;
+ function AddButton(X, Y, W, H, ColR, ColG, ColB, Int, DColR, DColG, DColB, DInt: real; const TexName: IPath; Typ: TTextureType; Reflection: boolean; ReflectionSpacing, DeSelectReflectionSpacing: real): integer; overload;
procedure ClearButtons;
- procedure AddButtonText(AddX, AddY: real; const AddText: string); overload;
- procedure AddButtonText(AddX, AddY: real; ColR, ColG, ColB: real; const AddText: string); overload;
- procedure AddButtonText(AddX, AddY: real; ColR, ColG, ColB: real; Font: integer; Size: integer; Align: integer; const AddText: string); overload;
- procedure AddButtonText(CustomButton: TButton; AddX, AddY: real; ColR, ColG, ColB: real; Font: integer; Size: integer; Align: integer; const AddText: string); overload;
+ procedure AddButtonText(AddX, AddY: real; const AddText: UTF8String); overload;
+ procedure AddButtonText(AddX, AddY: real; ColR, ColG, ColB: real; const AddText: UTF8String); overload;
+ procedure AddButtonText(AddX, AddY: real; ColR, ColG, ColB: real; Font: integer; Size: integer; Align: integer; const AddText: UTF8String); overload;
+ procedure AddButtonText(CustomButton: TButton; AddX, AddY: real; ColR, ColG, ColB: real; Font: integer; Size: integer; Align: integer; const AddText: UTF8String); overload;
// select slide
- function AddSelectSlide(ThemeSelectS: TThemeSelectSlide; var Data: integer; Values: array of string): integer; overload;
+ function AddSelectSlide(ThemeSelectS: TThemeSelectSlide; var Data: integer; const Values: array of UTF8String): integer; overload;
function AddSelectSlide(X, Y, W, H, SkipX, SBGW, ColR, ColG, ColB, Int, DColR, DColG, DColB, DInt,
TColR, TColG, TColB, TInt, TDColR, TDColG, TDColB, TDInt,
SBGColR, SBGColG, SBGColB, SBGInt, SBGDColR, SBGDColG, SBGDColB, SBGDInt,
STColR, STColG, STColB, STInt, STDColR, STDColG, STDColB, STDInt: real;
- const Name: string; Typ: TTextureType; const SBGName: string; SBGTyp: TTextureType;
- const Caption: string; var Data: integer): integer; overload;
- procedure AddSelectSlideOption(const AddText: string); overload;
- procedure AddSelectSlideOption(SelectNo: cardinal; const AddText: string); overload;
- procedure UpdateSelectSlideOptions(ThemeSelectSlide: TThemeSelectSlide; SelectNum: integer; Values: array of string; var Data: integer);
+ const TexName: IPath; Typ: TTextureType; const SBGName: IPath; SBGTyp: TTextureType;
+ const Caption: UTF8String; var Data: integer): integer; overload;
+ procedure AddSelectSlideOption(const AddText: UTF8String); overload;
+ procedure AddSelectSlideOption(SelectNo: cardinal; const AddText: UTF8String); overload;
+ procedure UpdateSelectSlideOptions(ThemeSelectSlide: TThemeSelectSlide; SelectNum: integer; const Values: array of UTF8String; var Data: integer);
// function AddWidget(X, Y : UInt16; WidgetSrc : PSDL_Surface): Int16;
// procedure ClearWidgets(MinNumber : Int16);
procedure FadeTo(Screen: PMenu); overload;
procedure FadeTo(Screen: PMenu; aSound: TAudioPlaybackStream); overload;
//popup hack
- procedure CheckFadeTo(Screen: PMenu; msg: string);
+ procedure CheckFadeTo(Screen: PMenu; Msg: UTF8String);
function DrawBG: boolean; virtual;
function DrawFG: boolean; virtual;
function Draw: boolean; virtual;
- function ParseInput(PressedKey: cardinal; CharCode: WideChar; PressedDown : boolean): boolean; virtual;
- // FIXME: ParseMouse is not implemented in any subclass and not even used anywhere in the code
- // -> do this before activation of this method
- //function ParseMouse(Typ: integer; X: integer; Y: integer): boolean; virtual; abstract;
- procedure onShow; virtual;
- procedure onShowFinish; virtual;
- procedure onHide; virtual;
+ function ParseInput(PressedKey: cardinal; CharCode: UCS4Char; PressedDown : boolean): boolean; virtual;
+ function ParseMouse(MouseButton: integer; BtnDown: boolean; X, Y: integer): boolean; virtual;
+ function InRegion(X, Y: real; A: TMouseOverRect): boolean;
+ function InteractAt(X, Y: real): integer;
+ function CollectionAt(X, Y: real): integer;
+ procedure OnShow; virtual;
+ procedure OnShowFinish; virtual;
+ procedure OnHide; virtual;
procedure SetAnimationProgress(Progress: real); virtual;
@@ -167,13 +169,16 @@ type
end;
const
- pmMove = 1;
- pmClick = 2;
+ MENU_MDOWN = 8;
+ MENU_MUP = 0;
+
+ pmMove = 1;
+ pmClick = 2;
pmUnClick = 3;
- iButton = 0; // interaction type
- iText = 2;
- iSelectS = 3;
+ iButton = 0; // interaction type
+ iText = 2;
+ iSelectS = 3;
iBCollectionChild = 5;
// fBlack = 0; // fade type
@@ -181,21 +186,22 @@ const
implementation
-uses UCommon,
- ULog,
- UMain,
- UDrawTexture,
- UGraphic,
- UDisplay,
- UCovers,
- UTime,
- USkins,
- //Background types
- UMenuBackgroundNone,
- UMenuBackgroundColor,
- UMenuBackgroundTexture,
- UMenuBackgroundVideo,
- UMenuBackgroundFade;
+uses
+ UCommon,
+ UCovers,
+ UDisplay,
+ UDrawTexture,
+ UGraphic,
+ ULog,
+ UMain,
+ USkins,
+ UTime,
+ //Background types
+ UMenuBackgroundNone,
+ UMenuBackgroundColor,
+ UMenuBackgroundTexture,
+ UMenuBackgroundVideo,
+ UMenuBackgroundFade;
destructor TMenu.Destroy;
begin
@@ -220,6 +226,8 @@ begin
ButtonPos := -1;
Background := nil;
+
+ RightMbESC := true;
end;
{
constructor TMenu.Create(Back: string);
@@ -251,7 +259,7 @@ begin
BackH := H;
end; }
-function RGBFloatToInt(R, G, B: Double): cardinal;
+function RGBFloatToInt(R, G, B: double): cardinal;
begin
Result := (Trunc(255 * R) shl 16) or
(Trunc(255 * G) shl 8) or
@@ -290,8 +298,8 @@ begin
begin
Button[OldNum].Selected := false;
- //Deselect Collection if Next Button is Not from Collection
- if (NewTyp <> iButton) Or (Button[NewNum].Parent <> Button[OldNum].Parent) then
+ // deselect collection if next button is not from collection
+ if (NewTyp <> iButton) or (Button[NewNum].Parent <> Button[OldNum].Parent) then
ButtonCollection[Button[OldNum].Parent-1].Selected := false;
end;
end;
@@ -339,8 +347,9 @@ procedure TMenu.AddBackground(ThemedSettings: TThemeBackground);
var
FileExt: string;
- Function IsInArray(const Piece: string; const A: array of string): boolean;
- var I: integer;
+ function IsInArray(const Piece: string; const A: array of string): boolean;
+ var
+ I: integer;
begin
Result := false;
@@ -352,7 +361,7 @@ procedure TMenu.AddBackground(ThemedSettings: TThemeBackground);
end;
end;
- Function TryBGCreate(Typ: cMenuBackground): boolean;
+ function TryBGCreate(Typ: cMenuBackground): boolean;
begin
Result := true;
@@ -374,14 +383,14 @@ begin
Background := nil;
end;
- Case ThemedSettings.BGType of
+ case ThemedSettings.BGType of
bgtAuto: begin //Automaticly choose one out of BGT_Texture, BGT_Video or BGT_Color
if (Length(ThemedSettings.Tex) > 0) then
begin
//At first some intelligent try to decide which BG to load
- FileExt := lowercase(ExtractFileExt(Skin.GetTextureFileName(ThemedSettings.Tex)));
+ FileExt := LowerCase(Skin.GetTextureFileName(ThemedSettings.Tex).GetExtension.ToUTF8);
if IsInArray(FileExt, SUPPORTED_EXTS_BACKGROUNDTEXTURE) then
TryBGCreate(TMenuBackgroundTexture)
@@ -491,7 +500,7 @@ end;
//----------------------
procedure TMenu.AddButtonCollection(const ThemeCollection: TThemeButtonCollection; const Num: byte);
var
- BT, BTLen: integer;
+ BT, BTLen: integer;
TempCol, TempDCol: cardinal;
begin
@@ -589,29 +598,37 @@ begin
ThemeStatic.Typ, $FFFFFF, ThemeStatic.Reflection, ThemeStatic.Reflectionspacing);
end;
-function TMenu.AddStatic(X, Y, W, H: real; const Name: string): integer;
+function TMenu.AddStatic(X, Y, W, H: real; const TexName: IPath): integer;
begin
- Result := AddStatic(X, Y, W, H, Name, TEXTURE_TYPE_PLAIN);
+ Result := AddStatic(X, Y, W, H, TexName, TEXTURE_TYPE_PLAIN);
end;
-function TMenu.AddStatic(X, Y, W, H: real; ColR, ColG, ColB: real; const Name: string; Typ: TTextureType): integer;
+function TMenu.AddStatic(X, Y, W, H: real;
+ ColR, ColG, ColB: real;
+ const TexName: IPath;
+ Typ: TTextureType): integer;
begin
- Result := AddStatic(X, Y, W, H, ColR, ColG, ColB, Name, Typ, $FFFFFF);
+ Result := AddStatic(X, Y, W, H, ColR, ColG, ColB, TexName, Typ, $FFFFFF);
end;
-function TMenu.AddStatic(X, Y, W, H, Z: real; ColR, ColG, ColB: real; const Name: string; Typ: TTextureType): integer;
+function TMenu.AddStatic(X, Y, W, H, Z: real;
+ ColR, ColG, ColB: real;
+ const TexName: IPath;
+ Typ: TTextureType): integer;
begin
- Result := AddStatic(X, Y, W, H, Z, ColR, ColG, ColB, Name, Typ, $FFFFFF);
+ Result := AddStatic(X, Y, W, H, Z, ColR, ColG, ColB, TexName, Typ, $FFFFFF);
end;
-function TMenu.AddStatic(X, Y, W, H: real; const Name: string; Typ: TTextureType): integer;
+function TMenu.AddStatic(X, Y, W, H: real;
+ const TexName: IPath;
+ Typ: TTextureType): integer;
var
StatNum: integer;
begin
// adds static
StatNum := Length(Static);
SetLength(Static, StatNum + 1);
- Static[StatNum] := TStatic.Create(Texture.GetTexture(Name, Typ, $FF00FF)); // new skin
+ Static[StatNum] := TStatic.Create(Texture.GetTexture(TexName, Typ, $FF00FF)); // new skin
// configures static
Static[StatNum].Texture.X := X;
@@ -622,17 +639,32 @@ begin
Result := StatNum;
end;
-function TMenu.AddStatic(X, Y, W, H: real; ColR, ColG, ColB: real; const Name: string; Typ: TTextureType; Color: integer): integer;
+function TMenu.AddStatic(X, Y, W, H: real;
+ ColR, ColG, ColB: real;
+ const TexName: IPath;
+ Typ: TTextureType;
+ Color: integer): integer;
begin
- Result := AddStatic(X, Y, W, H, 0, ColR, ColG, ColB, Name, Typ, Color);
+ Result := AddStatic(X, Y, W, H, 0, ColR, ColG, ColB, TexName, Typ, Color);
end;
-function TMenu.AddStatic(X, Y, W, H, Z: real; ColR, ColG, ColB: real; const Name: string; Typ: TTextureType; Color: integer): integer;
+function TMenu.AddStatic(X, Y, W, H, Z: real;
+ ColR, ColG, ColB: real;
+ const TexName: IPath;
+ Typ: TTextureType;
+ Color: integer): integer;
begin
- Result := AddStatic(X, Y, W, H, Z, ColR, ColG, ColB, 0, 0, 1, 1, Name, Typ, Color, false, 0);
+ Result := AddStatic(X, Y, W, H, Z, ColR, ColG, ColB, 0, 0, 1, 1, TexName, Typ, Color, false, 0);
end;
-function TMenu.AddStatic(X, Y, W, H, Z: real; ColR, ColG, ColB: real; TexX1, TexY1, TexX2, TexY2: real; const Name: string; Typ: TTextureType; Color: integer; Reflection: boolean; ReflectionSpacing: real): integer;
+function TMenu.AddStatic(X, Y, W, H, Z: real;
+ ColR, ColG, ColB: real;
+ TexX1, TexY1, TexX2, TexY2: real;
+ const TexName: IPath;
+ Typ: TTextureType;
+ Color: integer;
+ Reflection: boolean;
+ ReflectionSpacing: real): integer;
var
StatNum: integer;
begin
@@ -644,18 +676,28 @@ begin
if (Typ = TEXTURE_TYPE_COLORIZED) then
begin
// give encoded color to GetTexture()
- Static[StatNum] := TStatic.Create(Texture.GetTexture(Name, Typ, RGBFloatToInt(ColR, ColG, ColB)));
+ Static[StatNum] := TStatic.Create(Texture.GetTexture(TexName, Typ, RGBFloatToInt(ColR, ColG, ColB)));
end
else
begin
- Static[StatNum] := TStatic.Create(Texture.GetTexture(Name, Typ, Color)); // new skin
+ Static[StatNum] := TStatic.Create(Texture.GetTexture(TexName, Typ, Color)); // new skin
end;
-
+
// configures static
Static[StatNum].Texture.X := X;
Static[StatNum].Texture.Y := Y;
- Static[StatNum].Texture.W := W;
- Static[StatNum].Texture.H := H;
+
+ //Set height and width via sprite size if omitted
+ if(H = 0) then
+ Static[StatNum].Texture.H := Static[StatNum].Texture.H
+ else
+ Static[StatNum].Texture.H := H;
+
+ if(W = 0) then
+ Static[StatNum].Texture.W := Static[StatNum].Texture.W
+ else
+ Static[StatNum].Texture.W := W;
+
Static[StatNum].Texture.Z := Z;
if (Typ <> TEXTURE_TYPE_COLORIZED) then
begin
@@ -683,7 +725,7 @@ begin
ThemeText.ColR, ThemeText.ColG, ThemeText.ColB, ThemeText.Align, ThemeText.Text, ThemeText.Reflection, ThemeText.ReflectionSpacing, ThemeText.Z);
end;
-function TMenu.AddText(X, Y: real; const Text_: string): integer;
+function TMenu.AddText(X, Y: real; const Text_: UTF8String): integer;
var
TextNum: integer;
begin
@@ -694,12 +736,22 @@ begin
Result := TextNum;
end;
-function TMenu.AddText(X, Y: real; Style: integer; Size, ColR, ColG, ColB: real; const Text: string): integer;
+function TMenu.AddText(X, Y: real;
+ Style: integer;
+ Size, ColR, ColG, ColB: real;
+ const Text: UTF8String): integer;
begin
Result := AddText(X, Y, 0, Style, Size, ColR, ColG, ColB, 0, Text, false, 0, 0);
end;
-function TMenu.AddText(X, Y, W: real; Style: integer; Size, ColR, ColG, ColB: real; Align: integer; const Text_: string; Reflection_: boolean; ReflectionSpacing_: real; Z : real): integer;
+function TMenu.AddText(X, Y, W: real;
+ Style: integer;
+ Size, ColR, ColG, ColB: real;
+ Align: integer;
+ const Text_: UTF8String;
+ Reflection_: boolean;
+ ReflectionSpacing_: real;
+ Z : real): integer;
var
TextNum: integer;
begin
@@ -711,9 +763,9 @@ begin
end;
//Function that Set Length of Button boolean in one Step instead of register new Memory for every Button
-Procedure TMenu.SetButtonLength(Length: cardinal);
+procedure TMenu.SetButtonLength(Length: cardinal);
begin
- if (ButtonPos = -1) AND (Length > 0) then
+ if (ButtonPos = -1) and (Length > 0) then
begin
//Set Length of Button
SetLength(Button, Length);
@@ -769,10 +821,10 @@ begin
ThemeButton.Text[BT].Text);
end;
- //BAutton Collection Mod
+ // bautton collection mod
if (ThemeButton.Parent <> 0) then
begin
- //If Collection Exists then Change Interaction to Child Button
+ // if collection exists then change interaction to child button
if (@ButtonCollection[ThemeButton.Parent-1] <> nil) then
begin
Interactions[High(Interactions)].Typ := iBCollectionChild;
@@ -790,19 +842,21 @@ begin
Log.LogBenchmark('====> Screen Options32', 6);
end;
-function TMenu.AddButton(X, Y, W, H: real; const Name: string): integer;
+function TMenu.AddButton(X, Y, W, H: real; const TexName: IPath): integer;
begin
- Result := AddButton(X, Y, W, H, Name, TEXTURE_TYPE_PLAIN, false);
+ Result := AddButton(X, Y, W, H, TexName, TEXTURE_TYPE_PLAIN, false);
end;
-function TMenu.AddButton(X, Y, W, H: real; const Name: string; Typ: TTextureType; Reflection: boolean): integer;
+function TMenu.AddButton(X, Y, W, H: real; const TexName: IPath; Typ: TTextureType; Reflection: boolean): integer;
begin
- Result := AddButton(X, Y, W, H, 1, 1, 1, 1, 1, 1, 1, 0.5, Name, TEXTURE_TYPE_PLAIN, Reflection, 15, 15);
+ Result := AddButton(X, Y, W, H, 1, 1, 1, 1, 1, 1, 1, 0.5, TexName, TEXTURE_TYPE_PLAIN, Reflection, 15, 15);
end;
function TMenu.AddButton(X, Y, W, H, ColR, ColG, ColB, Int, DColR, DColG, DColB, DInt: real;
- const Name: string; Typ: TTextureType;
- Reflection: boolean; ReflectionSpacing, DeSelectReflectionSpacing: real): integer;
+ const TexName: IPath;
+ Typ: TTextureType;
+ Reflection: boolean;
+ ReflectionSpacing, DeSelectReflectionSpacing: real): integer;
begin
// adds button
//SetLength is used once to reduce Memory usement
@@ -821,12 +875,12 @@ begin
if (Typ = TEXTURE_TYPE_COLORIZED) then
begin
// give encoded color to GetTexture()
- Button[Result] := TButton.Create(Texture.GetTexture(Name, Typ, RGBFloatToInt(ColR, ColG, ColB)),
- Texture.GetTexture(Name, Typ, RGBFloatToInt(DColR, DColG, DColB)));
+ Button[Result] := TButton.Create(Texture.GetTexture(TexName, Typ, RGBFloatToInt(ColR, ColG, ColB)),
+ Texture.GetTexture(TexName, Typ, RGBFloatToInt(DColR, DColG, DColB)));
end
else
begin
- Button[Result] := TButton.Create(Texture.GetTexture(Name, Typ));
+ Button[Result] := TButton.Create(Texture.GetTexture(TexName, Typ));
end;
// configures button
@@ -855,7 +909,7 @@ begin
Button[Result].Reflectionspacing := ReflectionSpacing;
Button[Result].DeSelectReflectionspacing := DeSelectReflectionSpacing;
- //Button Collection Mod
+ // button collection mod
Button[Result].Parent := 0;
// adds interaction
@@ -868,11 +922,10 @@ begin
Setlength(Button, 0);
end;
-// Method to draw our TMenu and all his child buttons
+// method to draw our tmenu and all his child buttons
function TMenu.DrawBG: boolean;
begin
Background.Draw;
-
Result := true;
end;
@@ -881,11 +934,11 @@ var
J: integer;
begin
// We don't forget about newly implemented static for nice skin ...
- for J := 0 to Length(Static) - 1 do
+ for J := 0 to High(Static) do
Static[J].Draw;
// ... and slightly implemented menutext unit
- for J := 0 to Length(Text) - 1 do
+ for J := 0 to High(Text) do
Text[J].Draw;
// Draw all ButtonCollections
@@ -893,10 +946,10 @@ begin
ButtonCollection[J].Draw;
// Second, we draw all of our buttons
- for J := 0 to Length(Button) - 1 do
+ for J := 0 to High(Button) do
Button[J].Draw;
- for J := 0 to Length(SelectsS) - 1 do
+ for J := 0 to High(SelectsS) do
SelectsS[J].Draw;
// Third, we draw all our widgets
@@ -920,9 +973,9 @@ end;
}
{
-function TMenu.AddWidget(X, Y : UInt16; WidgetSrc : PSDL_Surface): Int16;
+function TMenu.AddWidget(X, Y: UInt16; WidgetSrc: PSDL_Surface): Int16;
var
- WidgetNum : Int16;
+ WidgetNum: Int16;
begin
if (Assigned(WidgetSrc)) then
begin
@@ -946,9 +999,9 @@ end;
}
{
-procedure TMenu.ClearWidgets(MinNumber : Int16);
+procedure TMenu.ClearWidgets(MinNumber: Int16);
var
- J : Int16;
+ J: Int16;
begin
for J := MinNumber to (Length(WidgetsSrc) - 1) do
begin
@@ -991,9 +1044,10 @@ begin
Int := Int - ceil(Length(Interactions) / 2);
//Set Interaction
- if ((Int < 0) or (Int > Length(Interactions) - 1))
- then Int := Interaction //nonvalid button, keep current one
- else Interaction := Int; //select row above
+ if ((Int < 0) or (Int > Length(Interactions) - 1)) then
+ Int := Interaction // invalid button, keep current one
+ else
+ Interaction := Int; // select row above
end;
procedure TMenu.InteractNextRow;
@@ -1005,9 +1059,10 @@ begin
Int := Int + ceil(Length(Interactions) / 2);
//Set Interaction
- if ((Int < 0) or (Int > Length(Interactions) - 1))
- then Int := Interaction //nonvalid button, keep current one
- else Interaction := Int; //select row above
+ if ((Int < 0) or (Int > Length(Interactions) - 1)) then
+ Int := Interaction // invalid button, keep current one
+ else
+ Interaction := Int; // select row above
end;
procedure TMenu.InteractNext;
@@ -1021,7 +1076,8 @@ begin
Int := (Int + 1) mod Length(Interactions);
//If no Interaction is Selectable Simply Select Next
- if (Int = Interaction) then Break;
+ if (Int = Interaction) then
+ Break;
until IsSelectable(Int);
@@ -1038,10 +1094,12 @@ begin
// change interaction as long as it's needed
repeat
Int := Int - 1;
- if Int = -1 then Int := High(Interactions);
+ if Int = -1 then
+ Int := High(Interactions);
//If no Interaction is Selectable Simply Select Next
- if (Int = Interaction) then Break;
+ if (Int = Interaction) then
+ Break;
until IsSelectable(Int);
//Set Interaction
@@ -1066,7 +1124,8 @@ begin
while (Again = true) do
begin
Num := SelInteraction - CustomSwitch;
- if Num = -1 then Num := High(Interactions);
+ if Num = -1 then
+ Num := High(Interactions);
Interaction := Num;
Again := false; // reset, default to accept changing interaction
@@ -1118,21 +1177,41 @@ begin
AudioPlayback.PlaySound( aSound );
end;
+procedure OnSaveEncodingError(Value: boolean; Data: Pointer);
+begin
+ Display.CheckOK := Value;
+ if (Value) then
+ begin
+ //Hack to Finish Singscreen correct on Exit with Q Shortcut
+ if (Display.NextScreenWithCheck = nil) then
+ begin
+ if (Display.CurrentScreen = @ScreenSing) then
+ ScreenSing.Finish
+ {else if (Display.CurrentScreen = @ScreenSingModi) then
+ ScreenSingModi.Finish;}
+ end;
+ end
+ else
+ begin
+ Display.NextScreenWithCheck := nil;
+ end;
+end;
+
//popup hack
-procedure TMenu.CheckFadeTo(Screen: PMenu; msg: string);
+procedure TMenu.CheckFadeTo(Screen: PMenu; Msg: UTF8String);
begin
Display.Fade := 0;
Display.NextScreenWithCheck := Screen;
Display.CheckOK := false;
- ScreenPopupCheck.ShowPopup(msg);
+ ScreenPopupCheck.ShowPopup(msg, OnSaveEncodingError, nil, false);
end;
-procedure TMenu.AddButtonText(AddX, AddY: real; const AddText: string);
+procedure TMenu.AddButtonText(AddX, AddY: real; const AddText: UTF8String);
begin
AddButtonText(AddX, AddY, 1, 1, 1, AddText);
end;
-procedure TMenu.AddButtonText(AddX, AddY: real; ColR, ColG, ColB: real; const AddText: string);
+procedure TMenu.AddButtonText(AddX, AddY: real; ColR, ColG, ColB: real; const AddText: UTF8String);
var
Il: integer;
begin
@@ -1148,7 +1227,7 @@ begin
end;
end;
-procedure TMenu.AddButtonText(AddX, AddY: real; ColR, ColG, ColB: real; Font: integer; Size: integer; Align: integer; const AddText: string);
+procedure TMenu.AddButtonText(AddX, AddY: real; ColR, ColG, ColB: real; Font: integer; Size: integer; Align: integer; const AddText: UTF8String);
var
Il: integer;
begin
@@ -1167,7 +1246,7 @@ begin
end;
end;
-procedure TMenu.AddButtonText(CustomButton: TButton; AddX, AddY: real; ColR, ColG, ColB: real; Font: integer; Size: integer; Align: integer; const AddText: string);
+procedure TMenu.AddButtonText(CustomButton: TButton; AddX, AddY: real; ColR, ColG, ColB: real; Font: integer; Size: integer; Align: integer; const AddText: UTF8String);
var
Il: integer;
begin
@@ -1186,7 +1265,7 @@ begin
end;
end;
-function TMenu.AddSelectSlide(ThemeSelectS: TThemeSelectSlide; var Data: integer; Values: array of string): integer;
+function TMenu.AddSelectSlide(ThemeSelectS: TThemeSelectSlide; var Data: integer; const Values: array of UTF8String): integer;
var
SO: integer;
begin
@@ -1210,6 +1289,9 @@ begin
SelectsS[High(SelectsS)].Texture.Z := ThemeSelectS.Z;
SelectsS[High(SelectsS)].TextureSBG.Z := ThemeSelectS.Z;
+ SelectsS[High(SelectsS)].showArrows := ThemeSelectS.showArrows;
+ SelectsS[High(SelectsS)].oneItemOnly := ThemeSelectS.oneItemOnly;
+
//Generate Lines
SelectsS[High(SelectsS)].GenLines;
@@ -1220,8 +1302,8 @@ function TMenu.AddSelectSlide(X, Y, W, H, SkipX, SBGW, ColR, ColG, ColB, Int, DC
TColR, TColG, TColB, TInt, TDColR, TDColG, TDColB, TDInt,
SBGColR, SBGColG, SBGColB, SBGInt, SBGDColR, SBGDColG, SBGDColB, SBGDInt,
STColR, STColG, STColB, STInt, STDColR, STDColG, STDColB, STDInt: real;
- const Name: string; Typ: TTextureType; const SBGName: string; SBGTyp: TTextureType;
- const Caption: string; var Data: integer): integer;
+ const TexName: IPath; Typ: TTextureType; const SBGName: IPath; SBGTyp: TTextureType;
+ const Caption: UTF8String; var Data: integer): integer;
var
S: integer;
I: integer;
@@ -1231,9 +1313,9 @@ begin
SelectsS[S] := TSelectSlide.Create;
if (Typ = TEXTURE_TYPE_COLORIZED) then
- SelectsS[S].Texture := Texture.GetTexture(Name, Typ, RGBFloatToInt(ColR, ColG, ColB))
+ SelectsS[S].Texture := Texture.GetTexture(TexName, Typ, RGBFloatToInt(ColR, ColG, ColB))
else
- SelectsS[S].Texture := Texture.GetTexture(Name, Typ);
+ SelectsS[S].Texture := Texture.GetTexture(TexName, Typ);
SelectsS[S].X := X;
SelectsS[S].Y := Y;
SelectsS[S].W := W;
@@ -1252,9 +1334,21 @@ begin
SelectsS[S].TextureSBG := Texture.GetTexture(SBGName, SBGTyp, RGBFloatToInt(SBGColR, SBGColG, SBGColB))
else
SelectsS[S].TextureSBG := Texture.GetTexture(SBGName, SBGTyp);
+
+ SelectsS[High(SelectsS)].Tex_SelectS_ArrowL := Tex_SelectS_ArrowL;
+ SelectsS[High(SelectsS)].Tex_SelectS_ArrowL.X := X + W + SkipX;
+ SelectsS[High(SelectsS)].Tex_SelectS_ArrowL.Y := Y;
+ SelectsS[High(SelectsS)].Tex_SelectS_ArrowL.W := Tex_SelectS_ArrowL.W;
+ SelectsS[High(SelectsS)].Tex_SelectS_ArrowL.H := Tex_SelectS_ArrowL.H;
+
+ SelectsS[High(SelectsS)].Tex_SelectS_ArrowR := Tex_SelectS_ArrowR;
+ SelectsS[High(SelectsS)].Tex_SelectS_ArrowR.X := X + W + SkipX + SBGW - Tex_SelectS_ArrowR.W;
+ SelectsS[High(SelectsS)].Tex_SelectS_ArrowR.Y := Y;
+ SelectsS[High(SelectsS)].Tex_SelectS_ArrowR.W := Tex_SelectS_ArrowR.W;
+ SelectsS[High(SelectsS)].Tex_SelectS_ArrowR.H := Tex_SelectS_ArrowR.H;
+
SelectsS[S].TextureSBG.X := X + W + SkipX;
SelectsS[S].TextureSBG.Y := Y;
- //SelectsS[S].TextureSBG.W := 450;
SelectsS[S].SBGW := SBGW;
SelectsS[S].TextureSBG.H := H;
SelectsS[S].SBGColR := SBGColR;
@@ -1339,12 +1433,12 @@ begin
Result := S;
end;
-procedure TMenu.AddSelectSlideOption(const AddText: string);
+procedure TMenu.AddSelectSlideOption(const AddText: UTF8String);
begin
AddSelectSlideOption(High(SelectsS), AddText);
end;
-procedure TMenu.AddSelectSlideOption(SelectNo: cardinal; const AddText: string);
+procedure TMenu.AddSelectSlideOption(SelectNo: cardinal; const AddText: UTF8String);
var
SO: integer;
begin
@@ -1352,13 +1446,16 @@ begin
SetLength(SelectsS[SelectNo].TextOptT, SO + 1);
SelectsS[SelectNo].TextOptT[SO] := AddText;
+{
+ SelectsS[S].SelectedOption := SelectsS[S].SelectOptInt; // refresh
- //SelectsS[S].SelectedOption := SelectsS[S].SelectOptInt; // refresh
-
- //if SO = Selects[S].PData^ then Selects[S].SelectedOption := SO;
+ if SO = Selects[S].PData^ then
+ Selects[S].SelectedOption := SO;
+}
end;
-procedure TMenu.UpdateSelectSlideOptions(ThemeSelectSlide: TThemeSelectSlide; SelectNum: integer; Values: array of string; var Data: integer);
+procedure TMenu.UpdateSelectSlideOptions(ThemeSelectSlide: TThemeSelectSlide;
+ SelectNum: integer; const Values: array of UTF8String; var Data: integer);
var
SO: integer;
begin
@@ -1455,12 +1552,12 @@ begin
end;
end;
end;
- //interact Prev if there is Nothing to Change
+ // interact prev if there is nothing to change
else
begin
InteractPrev;
- //If ButtonCollection with more than 1 Entry then Select Last Entry
- if (Button[Interactions[Interaction].Num].Parent <> 0) AND (ButtonCollection[Button[Interactions[Interaction].Num].Parent-1].CountChilds > 1) then
+ // if buttoncollection with more than 1 entry then select last entry
+ if (Button[Interactions[Interaction].Num].Parent <> 0) and (ButtonCollection[Button[Interactions[Interaction].Num].Parent-1].CountChilds > 1) then
begin
//Select Last Child
for Num := High(Button) downto 1 do
@@ -1483,7 +1580,7 @@ begin
AddStatic(X+2, Y+2, W-4, H-4, 1, 1, 1, Skin.GetTextureFileName('MainBar'), TEXTURE_TYPE_COLORIZED);
end;
-procedure TMenu.onShow;
+procedure TMenu.OnShow;
begin
// FIXME: this needs some work. First, there should be a variable like
// VideoBackground so we can check whether a video-background is enabled or not.
@@ -1512,60 +1609,149 @@ begin
Background.OnShow;
end;
-procedure TMenu.onShowFinish;
+procedure TMenu.OnShowFinish;
+begin
+ // nothing
+end;
+
+procedure TMenu.OnHide;
begin
// nothing
+ Background.OnFinish;
end;
-(*
- * Wrapper for WideUpperCase. Needed because some plattforms have problems with
- * unicode support.
- *)
-function TMenu.WideCharUpperCase(wchar: WideChar) : WideString;
+function TMenu.ParseInput(PressedKey: Cardinal; CharCode: UCS4Char; PressedDown: boolean): boolean;
begin
- // On Linux and MacOSX the cwstring unit is necessary for Unicode function-calls.
- // Otherwise you will get an EIntOverflow exception (thrown by unimplementedwidestring()).
- // The Unicode manager cwstring does not work with MacOSX at the moment because
- // of missing references to iconv. So we have to use Ansi... for the moment.
+ // nothing
+ Result := true;
+end;
- // cwstring crashes in FPC 2.2.2 so do not use the cwstring stuff
- {.$IFNDEF DARWIN}
- {$IFDEF NOIGNORE}
- // The FPC implementation of WideUpperCase returns nil if wchar is #0 (e.g. if an arrow key is pressed)
- if (wchar <> #0) then
- Result := WideUpperCase(wchar)
- else
- Result := #0;
- {$ELSE}
- Result := AnsiUpperCase(wchar)
- {$ENDIF}
+function TMenu.ParseMouse(MouseButton: integer; BtnDown: boolean; X, Y: integer): boolean;
+var
+ nBut: integer;
+ Action: TMouseClickAction;
+begin
+ //default mouse parsing: clicking generates return keypress,
+ // mousewheel selects in select slide
+ //override ParseMouse to customize
+ Result := true;
+
+ if RightMbESC and (MouseButton = SDL_BUTTON_RIGHT) and BtnDown then
+ begin
+ //if RightMbESC is set, send ESC keypress
+ Result:=ParseInput(SDLK_ESCAPE, 0, true);
+ end;
+
+ nBut := InteractAt(X, Y);
+ if nBut >= 0 then
+ begin
+ //select on mouse-over
+ if nBut <> Interaction then
+ SetInteraction(nBut);
+
+ Action := maNone;
+
+ if (BtnDown) then
+ begin
+ if (MouseButton = SDL_BUTTON_LEFT) then
+ begin
+ //click button or SelectS
+ if (Interactions[nBut].Typ = iSelectS) then
+ Action := SelectsS[Interactions[nBut].Num].OnClick((X / Screen.w) * RenderW, (Y / Screen.h) * RenderH)
+ else
+ Action := maReturn;
+ end
+ else if (MouseButton = SDL_BUTTON_WHEELDOWN) then
+ begin //forward on select slide with mousewheel
+ if (Interactions[nBut].Typ = iSelectS) then
+ Action := maRight;
+ end
+ else if (MouseButton = SDL_BUTTON_WHEELUP) then
+ begin //backward on select slide with mousewheel
+ if (Interactions[nBut].Typ = iSelectS) then
+ Action := maLeft;
+ end;
+ end;
+
+ // do the action we have to do ;)
+ case Action of
+ maReturn: Result := ParseInput(SDLK_RETURN, 0, true);
+ maLeft: Result := ParseInput(SDLK_LEFT, 0, true);
+ maRight: Result := ParseInput(SDLK_RIGHT, 0, true);
+ end;
+ end
+ else
+ begin
+ nBut := CollectionAt(X, Y);
+ if (nBut >= 0) and (not ButtonCollection[nBut].Selected) then
+ begin
+ // if over button collection, that is not already selected
+ // -> select first child but don't allow click
+ nBut := ButtonCollection[nBut].FirstChild - 1;
+ if nBut <> Interaction then
+ SetInteraction(nBut);
+ end;
+ end;
end;
-(*
- * Wrapper for WideUpperCase. Needed because some plattforms have problems with
- * unicode support.
- *)
-function TMenu.WideStringUpperCase(wstring: WideString) : WideString;
+function TMenu.InRegion(X, Y: real; A: TMouseOverRect): boolean;
begin
- // cwstring crashes in FPC 2.2.2 so do not use the cwstring stuff
- {.$IFNDEF DARWIN}
- {$IFDEF NOIGNORE}
- Result := WideUpperCase(wstring)
- {$ELSE}
- Result := AnsiUpperCase(wstring);
- {$ENDIF}
+ // transfer mousecords to the 800x600 raster we use to draw
+ X := (X / Screen.w) * RenderW;
+ Y := (Y / Screen.h) * RenderH;
+
+ // check whether A contains X and Y
+ Result := (X >= A.X) and (X <= A.X + A.W) and (Y >= A.Y) and (Y <= A.Y + A.H);
end;
-procedure TMenu.onHide;
+//takes x,y coordinates and returns the interaction number
+//of the control at this position
+function TMenu.InteractAt(X, Y: real): integer;
+var
+ i, nBut: integer;
begin
- // nothing
- Background.OnFinish;
+ Result := -1;
+ for i := Low(Interactions) to High(Interactions) do
+ begin
+ case Interactions[i].Typ of
+ iButton:
+ if InRegion(X, Y, Button[Interactions[i].Num].GetMouseOverArea) and
+ Button[Interactions[i].Num].Visible then
+ begin
+ Result:=i;
+ exit;
+ end;
+ iBCollectionChild:
+ if InRegion(X, Y, Button[Interactions[i].Num].GetMouseOverArea) then
+ begin
+ Result:=i;
+ exit;
+ end;
+ iSelectS:
+ if InRegion(X, Y, SelectSs[Interactions[i].Num].GetMouseOverArea) then
+ begin
+ Result:=i;
+ exit;
+ end;
+ end;
+ end;
end;
-function TMenu.ParseInput(PressedKey: cardinal; CharCode: WideChar; PressedDown: boolean): boolean;
+//takes x,y coordinates and returns the button collection id
+function TMenu.CollectionAt(X, Y: real): integer;
+var
+ i, nBut: integer;
begin
- // nothing
- Result := true;
+ Result := -1;
+ for i:= Low(ButtonCollection) to High(ButtonCollection) do
+ begin
+ if InRegion(X, Y, ButtonCollection[i].GetMouseOverArea) and
+ ButtonCollection[i].Visible then
+ begin
+ Result:=i;
+ exit;
+ end;
+ end;
end;
procedure TMenu.SetAnimationProgress(Progress: real);
@@ -1574,4 +1760,3 @@ begin
end;
end.
-
diff --git a/Lua/src/menu/UMenuBackground.pas b/Lua/src/menu/UMenuBackground.pas
index c85f0806..0e2e63a6 100644
--- a/Lua/src/menu/UMenuBackground.pas
+++ b/Lua/src/menu/UMenuBackground.pas
@@ -1,83 +1,83 @@
-{* 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 UMenuBackground;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses
- SysUtils,
- UThemes;
-
-//TMenuBackground - abstraction class for MenuBackgrounds
-//this is a class, not an interface because of the constructors
-//and destructors
-//--------
-
-type
- EMenuBackgroundError = class(Exception);
- TMenuBackground = class
- constructor Create(const ThemedSettings: TThemeBackground); virtual;
- procedure OnShow; virtual;
- procedure Draw; virtual;
- procedure OnFinish; virtual;
- destructor Destroy; override;
- end;
- cMenuBackground = class of TMenuBackground;
-
-implementation
-
-constructor TMenuBackground.Create(const ThemedSettings: TThemeBackground);
-begin
- inherited Create;
-end;
-
-destructor TMenuBackground.Destroy;
-begin
- inherited;
-end;
-
-procedure TMenuBackground.OnShow;
-begin
-
-end;
-
-procedure TMenuBackground.OnFinish;
-begin
-
-end;
-
-procedure TMenuBackground.Draw;
-begin
-
-end;
-
-end.
+{* UltraStar Deluxe - Karaoke Game
+ *
+ * UltraStar Deluxe is the legal property of its developers, whose names
+ * are too numerous to list here. Please refer to the COPYRIGHT
+ * file distributed with this source distribution.
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; see the file COPYING. If not, write to
+ * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+ * Boston, MA 02110-1301, USA.
+ *
+ * $URL$
+ * $Id$
+ *}
+
+unit UMenuBackground;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+uses
+ SysUtils,
+ UThemes;
+
+//TMenuBackground - abstraction class for MenuBackgrounds
+//this is a class, not an interface because of the constructors
+//and destructors
+//--------
+
+type
+ EMenuBackgroundError = class(Exception);
+ TMenuBackground = class
+ constructor Create(const ThemedSettings: TThemeBackground); virtual;
+ procedure OnShow; virtual;
+ procedure Draw; virtual;
+ procedure OnFinish; virtual;
+ destructor Destroy; override;
+ end;
+ cMenuBackground = class of TMenuBackground;
+
+implementation
+
+constructor TMenuBackground.Create(const ThemedSettings: TThemeBackground);
+begin
+ inherited Create;
+end;
+
+destructor TMenuBackground.Destroy;
+begin
+ inherited;
+end;
+
+procedure TMenuBackground.OnShow;
+begin
+
+end;
+
+procedure TMenuBackground.OnFinish;
+begin
+
+end;
+
+procedure TMenuBackground.Draw;
+begin
+
+end;
+
+end.
diff --git a/Lua/src/menu/UMenuBackgroundColor.pas b/Lua/src/menu/UMenuBackgroundColor.pas
index 68cf2de4..45b58c1e 100644
--- a/Lua/src/menu/UMenuBackgroundColor.pas
+++ b/Lua/src/menu/UMenuBackgroundColor.pas
@@ -1,69 +1,73 @@
-{* 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 UMenuBackgroundColor;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses
- UThemes,
- UMenuBackground;
-
-//TMenuBackgroundColor - Background Color
-//--------
-
-type
- TMenuBackgroundColor = class (TMenuBackground)
- private
- Color: TRGB;
- public
- constructor Create(const ThemedSettings: TThemeBackground); override;
- procedure Draw; override;
- end;
-
-implementation
-uses
- gl,
- glext;
-
-constructor TMenuBackgroundColor.Create(const ThemedSettings: TThemeBackground);
-begin
- inherited;
- Color := ThemedSettings.Color;
-end;
-
-procedure TMenuBackgroundColor.Draw;
-begin
- glClearColor(Color.R, Color.G, Color.B, 0);
- glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
-end;
-
+{* UltraStar Deluxe - Karaoke Game
+ *
+ * UltraStar Deluxe is the legal property of its developers, whose names
+ * are too numerous to list here. Please refer to the COPYRIGHT
+ * file distributed with this source distribution.
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; see the file COPYING. If not, write to
+ * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+ * Boston, MA 02110-1301, USA.
+ *
+ * $URL$
+ * $Id$
+ *}
+
+unit UMenuBackgroundColor;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+uses
+ UThemes,
+ UMenuBackground;
+
+//TMenuBackgroundColor - Background Color
+//--------
+
+type
+ TMenuBackgroundColor = class (TMenuBackground)
+ private
+ Color: TRGB;
+ public
+ constructor Create(const ThemedSettings: TThemeBackground); override;
+ procedure Draw; override;
+ end;
+
+implementation
+uses
+ gl,
+ glext,
+ UGraphic;
+
+constructor TMenuBackgroundColor.Create(const ThemedSettings: TThemeBackground);
+begin
+ inherited;
+ Color := ThemedSettings.Color;
+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/Lua/src/menu/UMenuBackgroundFade.pas b/Lua/src/menu/UMenuBackgroundFade.pas
index b6174738..6d877baa 100644
--- a/Lua/src/menu/UMenuBackgroundFade.pas
+++ b/Lua/src/menu/UMenuBackgroundFade.pas
@@ -1,170 +1,176 @@
-{* 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 UMenuBackgroundFade;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses
- UThemes,
- UTexture,
- UMenuBackground;
-
-//TMenuBackgroundFade - Background Fade In for Overlay screens
-//--------
-
-type
- TMenuBackgroundFade = class (TMenuBackground)
- private
- Tex: TTexture;
- Color: TRGB;
- Alpha: real;
-
- useTexture: boolean;
-
- FadeTime: cardinal;
- public
- constructor Create(const ThemedSettings: TThemeBackground); override;
- procedure OnShow; override;
- procedure Draw; override;
- destructor Destroy; override;
- end;
-
-const
- FADEINTIME = 1500; //Time the bg fades in
-
-implementation
-uses sdl,
- gl,
- glext,
- USkins,
- UCommon;
-
-constructor TMenuBackgroundFade.Create(const ThemedSettings: TThemeBackground);
-var texFilename: string;
-begin
- inherited;
- FadeTime := 0;
-
- Color := ThemedSettings.Color;
- Alpha := ThemedSettings.Alpha;
- if (Length(ThemedSettings.Tex) > 0) then
- begin
- texFilename := Skin.GetTextureFileName(ThemedSettings.Tex);
- texFilename := AdaptFilePaths(texFilename);
- Tex := Texture.GetTexture(texFilename, TEXTURE_TYPE_PLAIN);
-
- UseTexture := (Tex.TexNum <> 0);
- end
- else
- UseTexture := false;
-
- if (not UseTexture) then
- FreeandNil(Tex);
-end;
-
-destructor TMenuBackgroundFade.Destroy;
-begin
- //Why isn't there any Tex.free method?
- {if UseTexture then
- FreeandNil(Tex); }
- inherited;
-end;
-
-procedure TMenuBackgroundFade.OnShow;
-begin
- FadeTime := SDL_GetTicks;
-end;
-
-procedure TMenuBackgroundFade.Draw;
-var
- Progress: real;
-begin
- if FadeTime = 0 then
- Progress := Alpha
- else
- Progress := Alpha * (SDL_GetTicks - FadeTime) / FADEINTIME;
-
- if Progress > Alpha then
- begin
- FadeTime := 0;
- Progress := Alpha;
- end;
-
- if (UseTexture) then
- begin //Draw Texture to Screen
- glClear(GL_DEPTH_BUFFER_BIT);
-
- glEnable(GL_TEXTURE_2D);
- glEnable(GL_BLEND);
- glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
-
- glColorRGB(Color, Progress);
- glBindTexture(GL_TEXTURE_2D, Tex.TexNum);
-
- glBegin(GL_QUADS);
- glTexCoord2f(Tex.TexX1*Tex.TexW, Tex.TexY1*Tex.TexH);
- glVertex2f(0, 0);
-
- glTexCoord2f(Tex.TexX1*Tex.TexW, Tex.TexY2*Tex.TexH);
- glVertex2f(0, 600);
-
- glTexCoord2f(Tex.TexX2*Tex.TexW, Tex.TexY2*Tex.TexH);
- glVertex2f(800, 600);
-
- glTexCoord2f(Tex.TexX2*Tex.TexW, Tex.TexY1*Tex.TexH);
- glVertex2f(800, 0);
- glEnd;
-
- glDisable(GL_BLEND);
- glDisable(GL_TEXTURE_2D);
- end
- else
- begin //Clear Screen w/ progress Alpha + Color
- glClear(GL_DEPTH_BUFFER_BIT);
- glDisable(GL_TEXTURE_2D);
- glEnable(GL_BLEND);
- glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
-
- glColorRGB(Color, Progress);
-
- glBegin(GL_QUADS);
- glVertex2f(0, 0);
- glVertex2f(0, 600);
- glVertex2f(800, 600);
- glVertex2f(800, 0);
- glEnd;
-
- glDisable(GL_BLEND);
- end;
-end;
-
-end.
+{* UltraStar Deluxe - Karaoke Game
+ *
+ * UltraStar Deluxe is the legal property of its developers, whose names
+ * are too numerous to list here. Please refer to the COPYRIGHT
+ * file distributed with this source distribution.
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; see the file COPYING. If not, write to
+ * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+ * Boston, MA 02110-1301, USA.
+ *
+ * $URL$
+ * $Id$
+ *}
+
+unit UMenuBackgroundFade;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+uses
+ UThemes,
+ UTexture,
+ UMenuBackground,
+ UPath;
+
+//TMenuBackgroundFade - Background Fade In for Overlay screens
+//--------
+
+type
+ TMenuBackgroundFade = class (TMenuBackground)
+ private
+ Tex: TTexture;
+ Color: TRGB;
+ Alpha: real;
+
+ useTexture: boolean;
+
+ FadeTime: cardinal;
+ public
+ constructor Create(const ThemedSettings: TThemeBackground); override;
+ procedure OnShow; override;
+ procedure Draw; override;
+ destructor Destroy; override;
+ end;
+
+const
+ FADEINTIME = 1500; //Time the bg fades in
+
+implementation
+uses
+ sdl,
+ gl,
+ glext,
+ USkins,
+ UCommon,
+ UGraphic;
+
+constructor TMenuBackgroundFade.Create(const ThemedSettings: TThemeBackground);
+var
+ texFilename: IPath;
+begin
+ inherited;
+ FadeTime := 0;
+
+ Color := ThemedSettings.Color;
+ Alpha := ThemedSettings.Alpha;
+ if (Length(ThemedSettings.Tex) > 0) then
+ begin
+ texFilename := Skin.GetTextureFileName(ThemedSettings.Tex);
+ Tex := Texture.GetTexture(texFilename, TEXTURE_TYPE_PLAIN);
+
+ UseTexture := (Tex.TexNum <> 0);
+ end
+ else
+ UseTexture := false;
+
+ if (not UseTexture) then
+ FreeandNil(Tex);
+end;
+
+destructor TMenuBackgroundFade.Destroy;
+begin
+ //Why isn't there any Tex.free method?
+ {if UseTexture then
+ FreeandNil(Tex); }
+ inherited;
+end;
+
+procedure TMenuBackgroundFade.OnShow;
+begin
+ FadeTime := SDL_GetTicks;
+end;
+
+procedure TMenuBackgroundFade.Draw;
+var
+ Progress: real;
+begin
+ if FadeTime = 0 then
+ Progress := Alpha
+ else
+ Progress := Alpha * (SDL_GetTicks - FadeTime) / FADEINTIME;
+
+ if Progress > Alpha then
+ begin
+ FadeTime := 0;
+ Progress := Alpha;
+ end;
+
+ if (UseTexture) then
+ begin //Draw Texture to Screen
+ if (ScreenAct = 1) then //Clear just once when in dual screen mode
+ glClear(GL_DEPTH_BUFFER_BIT);
+
+ glEnable(GL_TEXTURE_2D);
+ glEnable(GL_BLEND);
+ glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
+
+ glColorRGB(Color, Progress);
+ glBindTexture(GL_TEXTURE_2D, Tex.TexNum);
+
+ glBegin(GL_QUADS);
+ glTexCoord2f(Tex.TexX1*Tex.TexW, Tex.TexY1*Tex.TexH);
+ glVertex2f(0, 0);
+
+ glTexCoord2f(Tex.TexX1*Tex.TexW, Tex.TexY2*Tex.TexH);
+ glVertex2f(0, 600);
+
+ glTexCoord2f(Tex.TexX2*Tex.TexW, Tex.TexY2*Tex.TexH);
+ glVertex2f(800, 600);
+
+ glTexCoord2f(Tex.TexX2*Tex.TexW, Tex.TexY1*Tex.TexH);
+ glVertex2f(800, 0);
+ glEnd;
+
+ glDisable(GL_BLEND);
+ glDisable(GL_TEXTURE_2D);
+ end
+ else
+ begin //Clear Screen w/ progress Alpha + Color
+ 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);
+
+ glColorRGB(Color, Progress);
+
+ glBegin(GL_QUADS);
+ glVertex2f(0, 0);
+ glVertex2f(0, 600);
+ glVertex2f(800, 600);
+ glVertex2f(800, 0);
+ glEnd;
+
+ glDisable(GL_BLEND);
+ end;
+end;
+
+end.
diff --git a/Lua/src/menu/UMenuBackgroundNone.pas b/Lua/src/menu/UMenuBackgroundNone.pas
index 6b63742a..c64f3023 100644
--- a/Lua/src/menu/UMenuBackgroundNone.pas
+++ b/Lua/src/menu/UMenuBackgroundNone.pas
@@ -1,68 +1,70 @@
-{* 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 UMenuBackgroundNone;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses
- UThemes,
- UMenuBackground;
-
-//TMenuBackgroundNone - Just no Background (e.g. for Overlays)
-//--------
-
-type
- TMenuBackgroundNone = class (TMenuBackground)
- private
-
- public
- constructor Create(const ThemedSettings: TThemeBackground); override;
- procedure Draw; override;
- end;
-
-implementation
-uses
- gl,
- glext;
-
-constructor TMenuBackgroundNone.Create(const ThemedSettings: TThemeBackground);
-begin
- inherited;
-end;
-
-procedure TMenuBackgroundNone.Draw;
-begin
- //Do just nothing in here!
- glClear(GL_DEPTH_BUFFER_BIT);
-end;
-
+{* UltraStar Deluxe - Karaoke Game
+ *
+ * UltraStar Deluxe is the legal property of its developers, whose names
+ * are too numerous to list here. Please refer to the COPYRIGHT
+ * file distributed with this source distribution.
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; see the file COPYING. If not, write to
+ * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+ * Boston, MA 02110-1301, USA.
+ *
+ * $URL$
+ * $Id$
+ *}
+
+unit UMenuBackgroundNone;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+uses
+ UThemes,
+ UMenuBackground;
+
+//TMenuBackgroundNone - Just no Background (e.g. for Overlays)
+//--------
+
+type
+ TMenuBackgroundNone = class (TMenuBackground)
+ private
+
+ public
+ constructor Create(const ThemedSettings: TThemeBackground); override;
+ procedure Draw; override;
+ end;
+
+implementation
+uses
+ gl,
+ glext,
+ UGraphic;
+
+constructor TMenuBackgroundNone.Create(const ThemedSettings: TThemeBackground);
+begin
+ inherited;
+end;
+
+procedure TMenuBackgroundNone.Draw;
+begin
+ //Do just nothing in here!
+ 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/Lua/src/menu/UMenuBackgroundTexture.pas b/Lua/src/menu/UMenuBackgroundTexture.pas
index e8678fc5..f71637ff 100644
--- a/Lua/src/menu/UMenuBackgroundTexture.pas
+++ b/Lua/src/menu/UMenuBackgroundTexture.pas
@@ -1,122 +1,126 @@
-{* 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 UMenuBackgroundTexture;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses
- UThemes,
- UTexture,
- UMenuBackground;
-
-//TMenuBackgroundColor - Background Color
-//--------
-
-type
- TMenuBackgroundTexture = class (TMenuBackground)
- private
- Tex: TTexture;
- Color: TRGB;
- public
- constructor Create(const ThemedSettings: TThemeBackground); override;
- procedure Draw; override;
- destructor Destroy; override;
- end;
-
-const
- SUPPORTED_EXTS_BACKGROUNDTEXTURE: array[0..13] of string = ('.png', '.bmp', '.jpg', '.jpeg', '.gif', '.pnm', '.ppm', '.pgm', '.pbm', '.xpm', '.lbm', '.pcx', '.tga', '.tiff');
-
-implementation
-uses
- USkins,
- UCommon,
- SysUtils,
- gl,
- glext;
-
-constructor TMenuBackgroundTexture.Create(const ThemedSettings: TThemeBackground);
-var texFilename: string;
-begin
- inherited;
-
- if (Length(ThemedSettings.Tex) = 0) then
- raise EMenuBackgroundError.Create('TMenuBackgroundTexture: No texture filename present');
-
- Color := ThemedSettings.Color;
-
- texFilename := Skin.GetTextureFileName(ThemedSettings.Tex);
- texFilename := AdaptFilePaths(texFilename);
- Tex := Texture.GetTexture(texFilename, TEXTURE_TYPE_PLAIN);
-
- if (Tex.TexNum = 0) then
- begin
- freeandnil(Tex);
- raise EMenuBackgroundError.Create('TMenuBackgroundTexture: Can''t load texture');
- end;
-end;
-
-destructor TMenuBackgroundTexture.Destroy;
-begin
- //freeandnil(Tex); <- this causes an Access Violation o0
- inherited;
-end;
-
-procedure TMenuBackgroundTexture.Draw;
-begin
- glClear(GL_DEPTH_BUFFER_BIT);
- glColorRGB(Color);
-
- glEnable(GL_TEXTURE_2D);
- glEnable(GL_BLEND);
- glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
-
- glBindTexture(GL_TEXTURE_2D, Tex.TexNum);
-
- glBegin(GL_QUADS);
- glTexCoord2f(Tex.TexX1*Tex.TexW, Tex.TexY1*Tex.TexH);
- glVertex2f(0, 0);
-
- glTexCoord2f(Tex.TexX1*Tex.TexW, Tex.TexY2*Tex.TexH);
- glVertex2f(0, 600);
-
- glTexCoord2f(Tex.TexX2*Tex.TexW, Tex.TexY2*Tex.TexH);
- glVertex2f(800, 600);
-
- glTexCoord2f(Tex.TexX2*Tex.TexW, Tex.TexY1*Tex.TexH);
- glVertex2f(800, 0);
- glEnd;
-
- glDisable(GL_BLEND);
- glDisable(GL_TEXTURE_2D);
-end;
-
-end.
+{* UltraStar Deluxe - Karaoke Game
+ *
+ * UltraStar Deluxe is the legal property of its developers, whose names
+ * are too numerous to list here. Please refer to the COPYRIGHT
+ * file distributed with this source distribution.
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; see the file COPYING. If not, write to
+ * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+ * Boston, MA 02110-1301, USA.
+ *
+ * $URL$
+ * $Id$
+ *}
+
+unit UMenuBackgroundTexture;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+uses
+ UThemes,
+ UTexture,
+ UMenuBackground,
+ UPath;
+
+//TMenuBackgroundColor - Background Color
+//--------
+
+type
+ TMenuBackgroundTexture = class (TMenuBackground)
+ private
+ Tex: TTexture;
+ Color: TRGB;
+ public
+ constructor Create(const ThemedSettings: TThemeBackground); override;
+ procedure Draw; override;
+ destructor Destroy; override;
+ end;
+
+const
+ SUPPORTED_EXTS_BACKGROUNDTEXTURE: array[0..13] of string = ('.png', '.bmp', '.jpg', '.jpeg', '.gif', '.pnm', '.ppm', '.pgm', '.pbm', '.xpm', '.lbm', '.pcx', '.tga', '.tiff');
+
+implementation
+uses
+ USkins,
+ UCommon,
+ SysUtils,
+ gl,
+ glext,
+ UGraphic;
+
+constructor TMenuBackgroundTexture.Create(const ThemedSettings: TThemeBackground);
+var
+ texFilename: IPath;
+begin
+ inherited;
+
+ if (Length(ThemedSettings.Tex) = 0) then
+ raise EMenuBackgroundError.Create('TMenuBackgroundTexture: No texture filename present');
+
+ Color := ThemedSettings.Color;
+
+ texFilename := Skin.GetTextureFileName(ThemedSettings.Tex);
+ Tex := Texture.GetTexture(texFilename, TEXTURE_TYPE_PLAIN);
+
+ if (Tex.TexNum = 0) then
+ begin
+ freeandnil(Tex);
+ raise EMenuBackgroundError.Create('TMenuBackgroundTexture: Can''t load texture');
+ end;
+end;
+
+destructor TMenuBackgroundTexture.Destroy;
+begin
+ //freeandnil(Tex); <- this causes an Access Violation o0
+ inherited;
+end;
+
+procedure TMenuBackgroundTexture.Draw;
+begin
+ If (ScreenAct = 1) then //Clear just once when in dual screen mode
+ glClear(GL_DEPTH_BUFFER_BIT);
+
+ glColorRGB(Color);
+
+ glEnable(GL_TEXTURE_2D);
+ glEnable(GL_BLEND);
+ glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
+
+ glBindTexture(GL_TEXTURE_2D, Tex.TexNum);
+
+ glBegin(GL_QUADS);
+ glTexCoord2f(Tex.TexX1*Tex.TexW, Tex.TexY1*Tex.TexH);
+ glVertex2f(0, 0);
+
+ glTexCoord2f(Tex.TexX1*Tex.TexW, Tex.TexY2*Tex.TexH);
+ glVertex2f(0, 600);
+
+ glTexCoord2f(Tex.TexX2*Tex.TexW, Tex.TexY2*Tex.TexH);
+ glVertex2f(800, 600);
+
+ glTexCoord2f(Tex.TexX2*Tex.TexW, Tex.TexY1*Tex.TexH);
+ glVertex2f(800, 0);
+ glEnd;
+
+ glDisable(GL_BLEND);
+ glDisable(GL_TEXTURE_2D);
+end;
+
+end.
diff --git a/Lua/src/menu/UMenuBackgroundVideo.pas b/Lua/src/menu/UMenuBackgroundVideo.pas
index 377c2170..9d265764 100644
--- a/Lua/src/menu/UMenuBackgroundVideo.pas
+++ b/Lua/src/menu/UMenuBackgroundVideo.pas
@@ -1,202 +1,203 @@
-{* 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 UMenuBackgroundVideo;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses
- UThemes,
- UMenuBackground,
- UVideo;
-
-//TMenuBackgroundColor - Background Color
-//--------
-
-type
- //DefaultBGVideoPlayback = TVideoPlayback_FFmpeg;
-
-{type
- TBGVideoPool = class;
-
- PBGVideoPoolItem = ^TBGVideoPoolItem;
- TBGVideoPoolItem = record
- Parent: TBGVideoPool;
- VideoPlayback = IVideoPlayback;
- ReferenceCounter: cardinal; //Number of Creations
- end;
-
- TBGVideo = class
- private
- myItem: PBGVideoPoolItem;
- public
- constructor Create(Item: PBGVideoPoolItem); override;
-
- function GetVideoPlayback: IVideoPlayback;
- procedure Draw;
-
- destructor Destroy;
- end;
-
- TBGVideoPool = class
- private
- Items: PBGVideoPoolItem;
- public
- constructor Create;
-
- function GetBGVideo(filename: string): TBGVideo;
- procedure RemoveItem(
- procedure FreeAllItems;
-
- destructor Destroy;
- end;
-
-type }
- TMenuBackgroundVideo = class (TMenuBackground)
- private
- fFilename: string;
- public
- constructor Create(const ThemedSettings: TThemeBackground); override;
- procedure OnShow; override;
- procedure Draw; override;
- procedure OnFinish; override;
- destructor Destroy; override;
- end;
-
-{var
- BGVideoPool: TBGVideoPool; }
-const
- SUPPORTED_EXTS_BACKGROUNDVIDEO: array[0..6] of string = ('.avi', '.mov', '.divx', '.mpg', '.mp4', '.mpeg', '.m2v');
-
-implementation
-
-uses
- gl,
- glext,
- UMusic,
- SysUtils,
- UTime,
- USkins,
- UCommon;
-
-constructor TMenuBackgroundVideo.Create(const ThemedSettings: TThemeBackground);
-begin
- inherited;
- if (Length(ThemedSettings.Tex) = 0) then
- raise EMenuBackgroundError.Create('TMenuBackgroundVideo: No video filename present');
-
- fFileName := Skin.GetTextureFileName(ThemedSettings.Tex);
- fFileName := AdaptFilePaths( fFileName );
-
- if fileexists(fFilename) AND VideoPlayback.Open( fFileName ) then
- begin
- VideoBGTimer.SetTime(0);
- VideoPlayback.Play;
- end
- else
- raise EMenuBackgroundError.Create('TMenuBackgroundVideo: Can''t load background video: ' + fFilename);
-end;
-
-destructor TMenuBackgroundVideo.Destroy;
-begin
-
-end;
-
-procedure TMenuBackgroundVideo.OnShow;
-begin
- if VideoPlayback.Open( fFileName ) then
- begin
- VideoBGTimer.SetTime(0);
- VideoPlayback.Play;
- end;
-end;
-
-procedure TMenuBackgroundVideo.OnFinish;
-begin
-
-end;
-
-procedure TMenuBackgroundVideo.Draw;
-begin
- glClear(GL_DEPTH_BUFFER_BIT);
-
- VideoPlayback.GetFrame(VideoBGTimer.GetTime());
- // FIXME: why do we draw on screen 2? Seems to be wrong.
- VideoPlayback.DrawGL(2);
-end;
-
-// Implementation of TBGVideo
-//--------
-{constructor TBGVideo.Create(Item: PBGVideoPoolItem);
-begin
- myItem := PBGVideoPoolItem;
- Inc(myItem.ReferenceCounter);
-end;
-
-destructor TBGVideo.Destroy;
-begin
- Dec(myItem.ReferenceCounter);
-end;
-
-function TBGVideo.GetVideoPlayback: IVideoPlayback;
-begin
-
-end;
-
-procedure TBGVideo.Draw;
-begin
-
-end;
-
-// Implementation of TBGVideoPool
-//--------
-
-constructor TBGVideoPool.Create;
-begin
-
-end;
-
-destructor TBGVideoPool.Destroy;
-begin
-
-end;
-
-function TBGVideoPool.GetBGVideo(filename: string): TBGVideo;
-begin
-
-end;
-
-procedure TBGVideoPool.FreeAllItems;
-begin
-
-end; }
-
-end.
+{* UltraStar Deluxe - Karaoke Game
+ *
+ * UltraStar Deluxe is the legal property of its developers, whose names
+ * are too numerous to list here. Please refer to the COPYRIGHT
+ * file distributed with this source distribution.
+ *
+ * This program is free software; you can redistribute it and/or
+ * modify it under the terms of the GNU General Public License
+ * as published by the Free Software Foundation; either version 2
+ * of the License, or (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program; see the file COPYING. If not, write to
+ * the Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
+ * Boston, MA 02110-1301, USA.
+ *
+ * $URL$
+ * $Id$
+ *}
+
+unit UMenuBackgroundVideo;
+
+interface
+
+{$IFDEF FPC}
+ {$MODE Delphi}
+{$ENDIF}
+
+{$I switches.inc}
+
+uses
+ UThemes,
+ UMenuBackground,
+ UVideo,
+ UPath;
+
+//TMenuBackgroundColor - Background Color
+//--------
+
+type
+ //DefaultBGVideoPlayback = TVideoPlayback_FFmpeg;
+
+{type
+ TBGVideoPool = class;
+
+ PBGVideoPoolItem = ^TBGVideoPoolItem;
+ TBGVideoPoolItem = record
+ Parent: TBGVideoPool;
+ VideoPlayback = IVideoPlayback;
+ ReferenceCounter: cardinal; //Number of Creations
+ end;
+
+ TBGVideo = class
+ private
+ myItem: PBGVideoPoolItem;
+ public
+ constructor Create(Item: PBGVideoPoolItem); override;
+
+ function GetVideoPlayback: IVideoPlayback;
+ procedure Draw;
+
+ destructor Destroy;
+ end;
+
+ TBGVideoPool = class
+ private
+ Items: PBGVideoPoolItem;
+ public
+ constructor Create;
+
+ function GetBGVideo(filename: IPath): TBGVideo;
+ procedure RemoveItem(
+ procedure FreeAllItems;
+
+ destructor Destroy;
+ end;
+
+type }
+ TMenuBackgroundVideo = class (TMenuBackground)
+ private
+ fFilename: IPath;
+ public
+ constructor Create(const ThemedSettings: TThemeBackground); override;
+ procedure OnShow; override;
+ procedure Draw; override;
+ procedure OnFinish; override;
+ destructor Destroy; override;
+ end;
+
+{var
+ BGVideoPool: TBGVideoPool; }
+const
+ SUPPORTED_EXTS_BACKGROUNDVIDEO: array[0..6] of string = ('.avi', '.mov', '.divx', '.mpg', '.mp4', '.mpeg', '.m2v');
+
+implementation
+
+uses
+ gl,
+ glext,
+ UMusic,
+ SysUtils,
+ UTime,
+ USkins,
+ UCommon,
+ UGraphic;
+
+constructor TMenuBackgroundVideo.Create(const ThemedSettings: TThemeBackground);
+begin
+ inherited;
+ if (Length(ThemedSettings.Tex) = 0) then
+ raise EMenuBackgroundError.Create('TMenuBackgroundVideo: No video filename present');
+
+ fFileName := Skin.GetTextureFileName(ThemedSettings.Tex);
+ if fFilename.IsFile and VideoPlayback.Open(fFileName) then
+ begin
+ VideoBGTimer.SetTime(0);
+ VideoPlayback.Play;
+ end
+ else
+ raise EMenuBackgroundError.Create('TMenuBackgroundVideo: Can''t load background video: ' + fFilename.ToNative);
+end;
+
+destructor TMenuBackgroundVideo.Destroy;
+begin
+
+end;
+
+procedure TMenuBackgroundVideo.OnShow;
+begin
+ if VideoPlayback.Open( fFileName ) then
+ begin
+ VideoBGTimer.SetTime(0);
+ VideoPlayback.Play;
+ end;
+end;
+
+procedure TMenuBackgroundVideo.OnFinish;
+begin
+
+end;
+
+procedure TMenuBackgroundVideo.Draw;
+begin
+ 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.
+ VideoPlayback.DrawGL(2);
+end;
+
+// Implementation of TBGVideo
+//--------
+{constructor TBGVideo.Create(Item: PBGVideoPoolItem);
+begin
+ myItem := PBGVideoPoolItem;
+ Inc(myItem.ReferenceCounter);
+end;
+
+destructor TBGVideo.Destroy;
+begin
+ Dec(myItem.ReferenceCounter);
+end;
+
+function TBGVideo.GetVideoPlayback: IVideoPlayback;
+begin
+
+end;
+
+procedure TBGVideo.Draw;
+begin
+
+end;
+
+// Implementation of TBGVideoPool
+//--------
+
+constructor TBGVideoPool.Create;
+begin
+
+end;
+
+destructor TBGVideoPool.Destroy;
+begin
+
+end;
+
+function TBGVideoPool.GetBGVideo(filename: IPath): TBGVideo;
+begin
+
+end;
+
+procedure TBGVideoPool.FreeAllItems;
+begin
+
+end; }
+
+end.
diff --git a/Lua/src/menu/UMenuButton.pas b/Lua/src/menu/UMenuButton.pas
index a0cdaeef..868a86f3 100644
--- a/Lua/src/menu/UMenuButton.pas
+++ b/Lua/src/menu/UMenuButton.pas
@@ -38,31 +38,31 @@ uses
UTexture,
gl,
UMenuText,
- SDL;
+ SDL,
+ UMenuInteract;
type
CButton = class of TButton;
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,25 +103,29 @@ 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;
+ constructor Create(); overload;
constructor Create(Textura: TTexture); overload;
constructor Create(Textura, DSTexture: TTexture); overload;
destructor Destroy; override;
+
+ function GetMouseOverArea: TMouseOverRect;
end;
implementation
-uses SysUtils,
- UDrawTexture;
+uses
+ SysUtils,
+ UDrawTexture;
procedure TButton.SetX(Value: real);
{var
@@ -143,8 +147,8 @@ end;
procedure TButton.SetY(Value: real);
{var
- dY: real;
- T: integer; // text}
+ dY: real;
+ T: integer; // text}
begin
{dY := Value - PosY;
@@ -164,7 +168,7 @@ begin
DeSelectW := Value;
- if Not Fade then
+ if not Fade then
begin
if SelectBool then
Texture.W := SelectW
@@ -180,7 +184,7 @@ begin
DeSelectH := Value;
- if Not Fade then
+ if not Fade then
begin
if SelectBool then
Texture.H := SelectH
@@ -189,9 +193,9 @@ begin
end;
end;
-procedure TButton.SetSelect(Value : Boolean);
+procedure TButton.SetSelect(Value : boolean);
var
- T: integer;
+ T: integer;
begin
SelectBool := Value;
@@ -251,49 +255,13 @@ begin
end;
end;
-constructor TButton.Create();
-begin
- inherited Create;
- // We initialize all to 0, nil or false
- Visible := true;
- SelectBool := false;
- DeselectType := 0;
- Selectable := true;
- Reflection := false;
- Colorized := false;
-
- SelectColR := 1;
- SelectColG := 1;
- SelectColB := 1;
- SelectInt := 1;
- SelectTInt := 1;
-
- DeselectColR := 1;
- DeselectColG := 1;
- DeselectColB := 1;
- DeselectInt := 0.5;
- DeselectTInt := 1;
-
- Fade := false;
- FadeTex.TexNum := 0;
- FadeProgress := 0;
- FadeText := false;
- SelectW := DeSelectW;
- SelectH := DeSelectH;
-
- PosX := 0;
- PosY := 0;
-
- Parent := 0;
-end;
-
// ***** Public methods ****** //
procedure TButton.Draw;
var
- T: integer;
- Tick: Cardinal;
- Spacing: Real;
+ T: integer;
+ Tick: cardinal;
+ Spacing: real;
begin
if Visible then
begin
@@ -315,7 +283,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 +321,7 @@ begin
FadeTex.TexY1 := 0;
FadeTex.TexY2 := 1;
- Case FadeTexPos of
+ case FadeTexPos of
0: //FadeTex on Top
begin
//Standard Texture
@@ -465,7 +433,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 +482,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,18 +525,98 @@ begin
end;
end;
- for T := 0 to High(Text) do begin
+ for T := 0 to High(Text) do
+ begin
Text[T].Draw;
end;
end;
end;
+function TButton.GetMouseOverArea: TMouseOverRect;
+begin
+ if (FadeTex.TexNum = 0) then
+ begin
+ Result.X := Texture.X;
+ Result.Y := Texture.Y;
+ Result.W := Texture.W;
+ Result.H := Texture.H;
+ end
+ else
+ begin
+ case FadeTexPos of
+ 0: begin // fade tex on top
+ Result.X := Texture.X;
+ Result.Y := FadeTex.Y;
+ Result.W := Texture.W;
+ Result.H := FadeTex.H + Texture.H;
+ end;
+
+ 1: begin // fade tex on left side
+ Result.X := FadeTex.X;
+ Result.Y := Texture.Y;
+ Result.W := FadeTex.W + Texture.W;
+ Result.H := Texture.H;
+ end;
+
+ 2: begin // fade tex on bottom
+ Result.X := Texture.X;
+ Result.Y := Texture.Y;
+ Result.W := Texture.W;
+ Result.H := FadeTex.H + Texture.H;
+ end;
+
+ 3: begin // fade tex on right side
+ Result.X := Texture.X;
+ Result.Y := Texture.Y;
+ Result.W := FadeTex.W + Texture.W;
+ Result.H := Texture.H;
+ end;
+ end;
+ end;
+end;
+
destructor TButton.Destroy;
begin
inherited;
end;
+constructor TButton.Create();
+begin
+ inherited Create;
+ // We initialize all to 0, nil or false
+ Visible := true;
+ SelectBool := false;
+ DeselectType := 0;
+ Selectable := true;
+ Reflection := false;
+ Colorized := false;
+
+ SelectColR := 1;
+ SelectColG := 1;
+ SelectColB := 1;
+ SelectInt := 1;
+ SelectTInt := 1;
+
+ DeselectColR := 1;
+ DeselectColG := 1;
+ DeselectColB := 1;
+ DeselectInt := 0.5;
+ DeselectTInt := 1;
+
+ Fade := false;
+ FadeTex.TexNum := 0;
+ FadeProgress := 0;
+ FadeText := false;
+ SelectW := DeSelectW;
+ SelectH := DeSelectH;
+
+ PosX := 0;
+ PosY := 0;
+
+ Parent := 0;
+end;
+
constructor TButton.Create(Textura: TTexture);
begin
Create();
@@ -577,7 +626,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 +641,7 @@ begin
Texture.ColG := 1;
Texture.ColB := 1;
Texture.Int := 1;
- Colorized := True;
+ Colorized := true;
end;
end.
diff --git a/Lua/src/menu/UMenuButtonCollection.pas b/Lua/src/menu/UMenuButtonCollection.pas
index c6c6dd81..8b7a1c3f 100644
--- a/Lua/src/menu/UMenuButtonCollection.pas
+++ b/Lua/src/menu/UMenuButtonCollection.pas
@@ -41,61 +41,61 @@ type
//TButtonCollection
//No Extra Attributes or Functions ATM
//----------------
- AButton = Array of TButton;
+ AButton = array of TButton;
PAButton = ^AButton;
TButtonCollection = class(TButton)
//num of the First Button, that can be Selected
- FirstChild: Byte;
- CountChilds: Byte;
+ FirstChild: byte;
+ CountChilds: byte;
ScreenButton: PAButton;
- procedure SetSelect(Value : Boolean); override;
+ procedure SetSelect(Value : boolean); override;
procedure Draw; override;
end;
implementation
-procedure TButtonCollection.SetSelect(Value : Boolean);
-var I: Integer;
+procedure TButtonCollection.SetSelect(Value : boolean);
+var
+ Index: integer;
begin
inherited;
//Set Visible for Every Button that is a Child of this ButtonCollection
- if (Not Fade) then
- For I := 0 to High(ScreenButton^) do
- if (ScreenButton^[I].Parent = Parent) then
- ScreenButton^[I].Visible := Value;
+ if (not Fade) then
+ for Index := 0 to High(ScreenButton^) do
+ if (ScreenButton^[Index].Parent = Parent) then
+ ScreenButton^[Index].Visible := Value;
end;
procedure TButtonCollection.Draw;
-var I, J: Integer;
+var
+ I, J: integer;
begin
inherited;
//If fading is activated, Fade Child Buttons
if (Fade) then
begin
- For I := 0 to High(ScreenButton^) do
+ for I := 0 to High(ScreenButton^) do
if (ScreenButton^[I].Parent = Parent) then
begin
if (FadeProgress < 0.5) then
begin
ScreenButton^[I].Visible := SelectBool;
- For J := 0 to High(ScreenButton^[I].Text) do
+ for J := 0 to High(ScreenButton^[I].Text) do
ScreenButton^[I].Text[J].Visible := SelectBool;
end
else
begin
ScreenButton^[I].Texture.Alpha := (FadeProgress-0.666)*3;
- For J := 0 to High(ScreenButton^[I].Text) do
+ for J := 0 to High(ScreenButton^[I].Text) do
ScreenButton^[I].Text[J].Alpha := (FadeProgress-0.666)*3;
end;
end;
end;
end;
-
-
end.
diff --git a/Lua/src/menu/UMenuEqualizer.pas b/Lua/src/menu/UMenuEqualizer.pas
index 6d77721c..8f57e44a 100644
--- a/Lua/src/menu/UMenuEqualizer.pas
+++ b/Lua/src/menu/UMenuEqualizer.pas
@@ -45,69 +45,71 @@ type
Tms_Equalizer = class(TObject)
private
FFTData: TFFTData; // moved here to avoid stack overflows
- BandData: array of Byte;
- RefreshTime: Cardinal;
+ BandData: array of byte;
+ RefreshTime: cardinal;
Source: IAudioPlayback;
- Procedure Analyse;
+ procedure Analyse;
public
- X: Integer;
- Y: Integer;
- Z: Real;
+ X: integer;
+ Y: integer;
+ Z: real;
- W: Integer;
- H: Integer;
- Space: Integer;
+ W: integer;
+ H: integer;
+ Space: integer;
- Visible: Boolean;
- Alpha: real;
- Color: TRGB;
+ Visible: boolean;
+ Alpha: real;
+ Color: TRGB;
- Direction: Boolean;
+ Direction: boolean;
+ BandLength: integer;
- BandLength: Integer;
-
- Reflection: boolean;
- Reflectionspacing: Real;
+ Reflection: boolean;
+ Reflectionspacing: real;
constructor Create(Source: IAudioPlayback; mySkin: TThemeEqualizer);
procedure Draw;
-
- Procedure SetBands(Value: Byte);
- Function GetBands: Byte;
- Property Bands: Byte read GetBands write SetBands;
+ procedure SetBands(Value: byte);
+ function GetBands: byte;
+ property Bands: byte read GetBands write SetBands;
procedure SetSource(newSource: IAudioPlayback);
end;
implementation
-uses math, SDL, gl, glext;
-
+uses
+ math,
+ SDL,
+ gl,
+ glext;
constructor Tms_Equalizer.Create(Source: IAudioPlayback; mySkin: TThemeEqualizer);
-var I: Integer;
+var
+ I: integer;
begin
- If (Source <> nil) then
+ if (Source <> nil) then
begin
- X := mySkin.X;
- Y := mySkin.Y;
- W := mySkin.W;
- H := mySkin.H;
- Z := mySkin.Z;
+ X := mySkin.X;
+ Y := mySkin.Y;
+ W := mySkin.W;
+ H := mySkin.H;
+ Z := mySkin.Z;
- Space := mySkin.Space;
+ Space := mySkin.Space;
- Visible := mySkin.Visible;
- Alpha := mySkin.Alpha;
- Color.R := mySkin.ColR;
- Color.G := mySkin.ColG;
- Color.B := mySkin.ColB;
+ Visible := mySkin.Visible;
+ Alpha := mySkin.Alpha;
+ Color.R := mySkin.ColR;
+ Color.G := mySkin.ColG;
+ Color.B := mySkin.ColB;
- Direction := mySkin.Direction;
- Bands := mySkin.Bands;
- BandLength := mySkin.Length;
+ Direction := mySkin.Direction;
+ Bands := mySkin.Bands;
+ BandLength := mySkin.Length;
Reflection := mySkin.Reflection;
Reflectionspacing := mySkin.Reflectionspacing;
@@ -116,31 +118,31 @@ begin
//Check if Visible
- If (Bands <= 0) OR
- (BandLength <= 0) OR
- (W <= 0) OR
- (H <= 0) OR
+ if (Bands <= 0) or
+ (BandLength <= 0) or
+ (W <= 0) or
+ (H <= 0) or
(Alpha <= 0) then
- Visible := False;
+ Visible := false;
//ClearArray
- For I := low(BandData) to high(BandData) do
+ for I := low(BandData) to high(BandData) do
BandData[I] := 3;
end
else
- Visible := False;
+ Visible := false;
end;
//--------
// evaluate FFT-Data
//--------
-Procedure Tms_Equalizer.Analyse;
- var
- I: Integer;
- ChansPerBand: byte; // channels per band
- MaxChannel: Integer;
- Pos: Real;
- CurBand: Integer;
+procedure Tms_Equalizer.Analyse;
+var
+ I: integer;
+ ChansPerBand: byte; // channels per band
+ MaxChannel: integer;
+ Pos: real;
+ CurBand: integer;
begin
Source.GetFFTData(FFTData);
@@ -188,25 +190,26 @@ end;
// Draw SpectrumAnalyser, Call Analyse
//--------
procedure Tms_Equalizer.Draw;
- var
- CurTime: Cardinal;
- PosX, PosY: Real;
- I, J: Integer;
- Diff: Real;
+var
+ CurTime: cardinal;
+ PosX, PosY: real;
+ I, J: integer;
+ Diff: real;
- Function GetAlpha(Diff: Single): Single;
+ function GetAlpha(Diff: single): single;
begin
- If Direction then
- Result := (Alpha * 0.6) *(0.5 - Diff/(BandLength * (H + Space)))
+ if Direction then
+ Result := (Alpha * 0.6) * (0.5 - Diff/(BandLength * (H + Space)))
else
- Result := (Alpha * 0.6) *(0.5 - Diff/(Bands * (H + Space)));
+ Result := (Alpha * 0.6) * (0.5 - Diff/(Bands * (H + Space)));
end;
+
begin
- If (Visible) AND not (AudioPlayback.Finished) then
+ if (Visible) and not (AudioPlayback.Finished) then
begin
//Call Analyse if necessary
CurTime := SDL_GetTicks();
- If (CurTime > RefreshTime) then
+ if (CurTime > RefreshTime) then
begin
Analyse;
@@ -244,12 +247,12 @@ begin
glVertex3f(PosX+W, PosY, Z);
glEnd;
- If (Reflection) AND (J <= BandLength div 2) then
+ if (Reflection) and (J <= BandLength div 2) then
begin
Diff := (Y-PosY) + H;
//Draw Reflection
- If Direction then
+ if Direction then
begin
glBegin(GL_QUADS);
glColorRGB(Color, GetAlpha(Diff));
@@ -298,22 +301,20 @@ begin
end;
end;
-Procedure Tms_Equalizer.SetBands(Value: Byte);
+procedure Tms_Equalizer.SetBands(Value: byte);
begin
SetLength(BandData, Value);
end;
-Function Tms_Equalizer.GetBands: Byte;
+function Tms_Equalizer.GetBands: byte;
begin
Result := Length(BandData);
end;
-Procedure Tms_Equalizer.SetSource(newSource: IAudioPlayback);
+procedure Tms_Equalizer.SetSource(newSource: IAudioPlayback);
begin
- If (newSource <> nil) then
+ if (newSource <> nil) then
Source := newSource;
end;
-
-
end. \ No newline at end of file
diff --git a/Lua/src/menu/UMenuInteract.pas b/Lua/src/menu/UMenuInteract.pas
index 4c2d4e86..7cb92025 100644
--- a/Lua/src/menu/UMenuInteract.pas
+++ b/Lua/src/menu/UMenuInteract.pas
@@ -35,10 +35,19 @@ interface
type
TInteract = record // for moving thru menu
- Typ: integer; // 0 - button, 1 - select, 2 - Text, 3 - Select SLide, 5 - ButtonCollection Child
- Num: integer; // number of this item in proper list like buttons, selects
+ Typ: integer; // 0 - button, 1 - select, 2 - Text, 3 - Select SLide, 5 - ButtonCollection Child
+ Num: integer; // number of this item in proper list like buttons, selects
end;
+ { to handle the area where the mouse is over a control }
+ TMouseOverRect = record
+ X, Y: Real;
+ W, H: Real;
+ end;
+
+ { to handle the on click action }
+ TMouseClickAction = (maNone, maReturn, maLeft, maRight);
+
implementation
end.
diff --git a/Lua/src/menu/UMenuSelectSlide.pas b/Lua/src/menu/UMenuSelectSlide.pas
index 1a0fa725..11be4c2a 100644
--- a/Lua/src/menu/UMenuSelectSlide.pas
+++ b/Lua/src/menu/UMenuSelectSlide.pas
@@ -34,10 +34,11 @@ interface
{$I switches.inc}
uses
+ gl,
TextGL,
+ UMenuText,
UTexture,
- gl,
- UMenuText;
+ UMenuInteract;
type
PSelectSlide = ^TSelectSlide;
@@ -48,23 +49,29 @@ type
// objects
Text: TText; // Main text describing option
TextOpt: array of TText; // 3 texts in the position of possible options
- TextOptT: array of string; // array of names for possible options
+ TextOptT: array of UTF8String; // array of names for possible options
Texture: TTexture; // Select Texture
TextureSBG: TTexture; // Background Selections Texture
// TextureS: array of TTexture; // Selections Texture (not used)
-// TextureArrowL: TTexture; // Texture for left arrow (not used yet)
-// TextureArrowR: TTexture; // Texture for right arrow (not used yet)
+ Tex_SelectS_ArrowL: TTexture; // Texture for left arrow
+ Tex_SelectS_ArrowR: TTexture; // Texture for right arrow
SelectOptInt: integer;
PData: ^integer;
//For automatically Setting LineCount
- Lines: Byte;
+ Lines: byte;
+
+ //Arrows on/off
+ showArrows: boolean; //default is false
+
+ //whether to show one item or all that fit into the select
+ oneItemOnly: boolean; //default is false
//Visibility
- Visible: Boolean;
+ Visible: boolean;
// for selection and deselection
// main static
@@ -121,7 +128,7 @@ type
// procedures
procedure SetSelect(Value: boolean);
- property Selected: Boolean read SelectBool write SetSelect;
+ property Selected: boolean read SelectBool write SetSelect;
procedure SetSelectOpt(Value: integer);
property SelectedOption: integer read SelectOptInt write SetSelectOpt;
procedure Draw;
@@ -129,10 +136,18 @@ type
//Automatically Generate Lines (Texts)
procedure genLines;
+
+ function GetMouseOverArea: TMouseOverRect;
+ function OnClick(X, Y: Real): TMouseClickAction;
end;
implementation
-uses UDrawTexture, math, ULog, SysUtils;
+
+uses
+ math,
+ SysUtils,
+ UDrawTexture,
+ ULog;
// ------------ Select
constructor TSelectSlide.Create;
@@ -141,24 +156,17 @@ begin
Text := TText.Create;
SetLength(TextOpt, 1);
TextOpt[0] := TText.Create;
-
- //Set Standard Width for Selections Background
- SBGW := 450;
-
- Visible := True;
- {SetLength(TextOpt, 3);
- TextOpt[0] := TText.Create;
- TextOpt[1] := TText.Create;
- TextOpt[2] := TText.Create;}
+ Visible := true;
end;
procedure TSelectSlide.SetSelect(Value: boolean);
{var
- SO: integer;
- I: integer;}
+ SO: integer;
+ I: integer;}
begin
SelectBool := Value;
- if Value then begin
+ if Value then
+ begin
Texture.ColR := ColR;
Texture.ColG := ColG;
Texture.ColB := ColB;
@@ -173,15 +181,9 @@ begin
TextureSBG.ColG := SBGColG;
TextureSBG.ColB := SBGColB;
TextureSBG.Int := SBGInt;
-
-{ for I := 0 to High(TextOpt) do begin
- TextOpt[I].ColR := STColR;
- TextOpt[I].ColG := STColG;
- TextOpt[I].ColB := STColB;
- TextOpt[I].Int := STInt;
- end;}
-
- end else begin
+ end
+ else
+ begin
Texture.ColR := DColR;
Texture.ColG := DColG;
Texture.ColB := DColB;
@@ -196,185 +198,242 @@ begin
TextureSBG.ColG := SBGDColG;
TextureSBG.ColB := SBGDColB;
TextureSBG.Int := SBGDInt;
-
-{ for I := 0 to High(TextOpt) do begin
- TextOpt[I].ColR := STDColR;
- TextOpt[I].ColG := STDColG;
- TextOpt[I].ColB := STDColB;
- TextOpt[I].Int := STDInt;
- end;}
end;
end;
procedure TSelectSlide.SetSelectOpt(Value: integer);
var
- SO: integer;
- HalfL: integer;
- HalfR: integer;
+ SO: integer;
+ HalfL: integer;
+ HalfR: integer;
-procedure DoSelection(Sel: Cardinal);
- var I: Integer;
+ procedure DoSelection(Sel: cardinal);
+ var
+ I: integer;
begin
- for I := low(TextOpt) to high(TextOpt) do
+ for I := Low(TextOpt) to High(TextOpt) do
begin
TextOpt[I].ColR := STDColR;
TextOpt[I].ColG := STDColG;
TextOpt[I].ColB := STDColB;
TextOpt[I].Int := STDInt;
end;
- if (integer(Sel) <= high(TextOpt)) then
+
+ if (integer(Sel) <= High(TextOpt)) then
begin
TextOpt[Sel].ColR := STColR;
TextOpt[Sel].ColG := STColG;
TextOpt[Sel].ColB := STColB;
TextOpt[Sel].Int := STInt;
+ end;
end;
- end;
+
begin
SelectOptInt := Value;
PData^ := Value;
-// SetSelect(true); // reset all colors
- if (Length(TextOpt)>0) AND (Length(TextOptT)>0) then
+ if (Length(TextOpt) > 0) and (Length(TextOptT) > 0) then
begin
+ //First option selected
if (Value <= 0) then
- begin //First Option Selected
+ begin
Value := 0;
- for SO := low (TextOpt) to high(TextOpt) do
+ Tex_SelectS_ArrowL.alpha := 0;
+ Tex_SelectS_ArrowR.alpha := 1;
+
+ for SO := Low(TextOpt) to High(TextOpt) do
begin
- TextOpt[SO].Text := TextOptT[SO];
+ TextOpt[SO].Text := TextOptT[SO];
end;
DoSelection(0);
end
- else if (Value >= high(TextOptT)) then
- begin //Last Option Selected
- Value := high(TextOptT);
- for SO := high(TextOpt) downto low (TextOpt) do
+ //Last option selected
+ else if (Value >= High(TextOptT)) then
+ begin
+ Value := High(TextOptT);
+
+ Tex_SelectS_ArrowL.alpha := 1;
+ Tex_SelectS_ArrowR.alpha := 0;
+
+ for SO := High(TextOpt) downto Low(TextOpt) do
begin
- TextOpt[SO].Text := TextOptT[high(TextOptT)-(Lines-SO-1)];
+ TextOpt[SO].Text := TextOptT[High(TextOptT) - (Lines - SO - 1)];
end;
- DoSelection(Lines-1);
+ DoSelection(Lines - 1);
end
+
+ //in between first and last
else
begin
- HalfL := Ceil((Lines-1)/2);
- HalfR := Lines-1-HalfL;
-
- if (Value <= HalfL) then
- begin //Selected Option is near to the left side
- {HalfL := Value;
- HalfR := Lines-1-HalfL;}
- //Change Texts
- for SO := low (TextOpt) to high(TextOpt) do
- begin
- TextOpt[SO].Text := TextOptT[SO];
- end;
+ Tex_SelectS_ArrowL.alpha := 1;
+ Tex_SelectS_ArrowR.alpha := 1;
- DoSelection(Value);
- end
- else if (Value > High(TextOptT)-HalfR) then
- begin //Selected is too near to the right border
- HalfR := high(TextOptT) - Value;
- HalfL := Lines-1-HalfR;
- //Change Texts
- for SO := high(TextOpt) downto low (TextOpt) do
+ HalfL := Ceil((Lines - 1) / 2);
+ HalfR := Lines - 1 - HalfL;
+
+ //Selected option is near to the left side
+ if (Value <= HalfL) then
begin
- TextOpt[SO].Text := TextOptT[high(TextOptT)-(Lines-SO-1)];
- end;
+ //Change texts
+ for SO := Low(TextOpt) to High(TextOpt) do
+ begin
+ TextOpt[SO].Text := TextOptT[SO];
+ end;
- DoSelection (HalfL);
- end
- else
- begin
- //Change Texts
- for SO := low (TextOpt) to high(TextOpt) do
+ DoSelection(Value);
+ end
+
+ //Selected option is near to the right side
+ else if (Value > High(TextOptT) - HalfR) then
begin
- TextOpt[SO].Text := TextOptT[Value - HalfL + SO];
- end;
+ HalfR := High(TextOptT) - Value;
+ HalfL := Lines - 1 - HalfR;
+ //Change texts
+ for SO := High(TextOpt) downto Low(TextOpt) do
+ begin
+ TextOpt[SO].Text := TextOptT[High(TextOptT) - (Lines - SO - 1)];
+ end;
- DoSelection(HalfL);
- end;
+ DoSelection (HalfL);
+ end
- end;
+ else
+ begin
+ //Change Texts
+ for SO := Low(TextOpt) to High(TextOpt) do
+ begin
+ TextOpt[SO].Text := TextOptT[Value - HalfL + SO];
+ end;
+ DoSelection(HalfL);
+ end;
+ end;
end;
-
end;
procedure TSelectSlide.Draw;
var
- SO: integer;
+ SO: integer;
begin
if Visible then
begin
DrawTexture(Texture);
DrawTexture(TextureSBG);
+ if showArrows then
+ begin
+ DrawTexture(Tex_SelectS_ArrowL);
+ DrawTexture(Tex_SelectS_ArrowR);
+ end;
+
Text.Draw;
- for SO := low(TextOpt) to high(TextOpt) do
+ for SO := Low(TextOpt) to High(TextOpt) do
TextOpt[SO].Draw;
end;
end;
procedure TSelectSlide.GenLines;
var
-maxlength: Real;
-I: Integer;
+ maxlength: real;
+ I: integer;
begin
SetFontStyle(0{Text.Style});
SetFontSize(Text.Size);
maxlength := 0;
- for I := low(TextOptT) to high (TextOptT) do
+ for I := Low(TextOptT) to High(TextOptT) do
begin
if (glTextWidth(TextOptT[I]) > maxlength) then
maxlength := glTextWidth(TextOptT[I]);
end;
- Lines := floor((TextureSBG.W-40) / (maxlength+7));
- if (Lines > Length(TextOptT)) then
- Lines := Length(TextOptT);
- if (Lines <= 0) then
+ if (oneItemOnly = false) then
+ begin
+ //show all items
+ Lines := floor((TextureSBG.W-40) / (maxlength+7));
+ if (Lines > Length(TextOptT)) then
+ Lines := Length(TextOptT);
+
+ if (Lines <= 0) then
+ Lines := 1;
+ end
+ else
+ begin
+ //show one item only
Lines := 1;
+ end;
//Free old Space used by Texts
- For I := low(TextOpt) to high(TextOpt) do
+ for I := Low(TextOpt) to High(TextOpt) do
TextOpt[I].Free;
setLength (TextOpt, Lines);
- for I := low(TextOpt) to high(TextOpt) do
+ for I := Low(TextOpt) to High(TextOpt) do
+ begin
+ TextOpt[I] := TText.Create;
+ TextOpt[I].Size := Text.Size;
+ //TextOpt[I].Align := 1;
+ TextOpt[I].Align := 0;
+ TextOpt[I].Visible := true;
+
+ TextOpt[I].ColR := STDColR;
+ TextOpt[I].ColG := STDColG;
+ TextOpt[I].ColB := STDColB;
+ TextOpt[I].Int := STDInt;
+
+ //Generate Positions
+ //TextOpt[I].X := TextureSBG.X + 20 + (TextureSBG.W / Lines) * (I + 0.5);
+ if (I <> High(TextOpt)) or (High(TextOpt) = 0) or (Length(TextOptT) = Lines) then
+ TextOpt[I].X := TextureSBG.X + 20 + (TextureSBG.W / Lines) * I
+ else
+ TextOpt[I].X := TextureSBG.X + TextureSBG.W - maxlength;
+
+ TextOpt[I].Y := TextureSBG.Y + (TextureSBG.H - Text.Size) / 2;
+
+ //Better Look with 2 Options
+ if (Lines = 2) and (Length(TextOptT) = 2) then
+ TextOpt[I].X := TextureSBG.X + 20 + (TextureSBG.W -40 - glTextWidth(TextOptT[1])) * I;
+
+ if (Lines = 1) then
begin
- TextOpt[I] := TText.Create;
- TextOpt[I].Size := Text.Size;
- //TextOpt[I].Align := 1;
- TextOpt[I].Align := 0;
- TextOpt[I].Visible := True;
+ TextOpt[I].Align := 1; //center text
+ TextOpt[I].X := TextureSBG.X + (TextureSBG.W / 2);
+ end;
+ end;
+end;
- TextOpt[I].ColR := STDColR;
- TextOpt[I].ColG := STDColG;
- TextOpt[I].ColB := STDColB;
- TextOpt[I].Int := STDInt;
+function TSelectSlide.GetMouseOverArea: TMouseOverRect;
+begin
+ Result.X := Texture.X;
+ Result.Y := Texture.Y;
+ Result.W := (TextureSBG.X + TextureSBG.W) - Result.X;
+ Result.H := Max(Texture.H, TextureSBG.H);
+end;
- //Generate Positions
- //TextOpt[I].X := TextureSBG.X + 20 + (TextureSBG.W / Lines) * (I + 0.5);
- if (I <> High(TextOpt)) OR (High(TextOpt) = 0) OR (Length(TextOptT) = Lines) then
- TextOpt[I].X := TextureSBG.X + 20 + (TextureSBG.W / Lines) * I
- else
- TextOpt[I].X := TextureSBG.X + TextureSBG.W - maxlength;
+function TSelectSlide.OnClick(X, Y: Real): TMouseClickAction;
+ var
+ AreaW: Real;
+begin
+ // default: press return on click
+ Result := maReturn;
- TextOpt[I].Y := TextureSBG.Y + (TextureSBG.H - Text.Size) / 2;
+ // use left sides to inc or dec selection by click
+ AreaW := TextureSbg.W / 20;
- //Better Look with 2 Options
- if (Lines=2) AND (Length(TextOptT)= 2) then
- TextOpt[I].X := TextureSBG.X + 20 + (TextureSBG.W -40 - glTextWidth(TextOptT[1])) * I;
- end;
+ if (Y >= TextureSBG.Y) and (Y <= TextureSBG.Y + TextureSBG.H) then
+ begin
+ if (X >= TextureSBG.X) and (X <= TextureSBG.X + AreaW) then
+ Result := maLeft // hit left area
+ else if (X >= TextureSBG.X + TextureSBG.W - AreaW) and (X <= TextureSBG.X + TextureSBG.W) then
+ Result := maRight; // hit right area
+ end;
end;
end.
diff --git a/Lua/src/menu/UMenuStatic.pas b/Lua/src/menu/UMenuStatic.pas
index 9a10fade..72f4eb36 100644
--- a/Lua/src/menu/UMenuStatic.pas
+++ b/Lua/src/menu/UMenuStatic.pas
@@ -40,19 +40,20 @@ uses
type
TStatic = class
public
- Texture: TTexture; // Button Screen position and size
- Visible: boolean;
+ Texture: TTexture; // Button Screen position and size
+ Visible: boolean;
//Reflection Mod
- Reflection: boolean;
- Reflectionspacing: Real;
+ Reflection: boolean;
+ Reflectionspacing: real;
procedure Draw;
constructor Create(Textura: TTexture); overload;
end;
implementation
-uses UDrawTexture;
+uses
+ UDrawTexture;
procedure TStatic.Draw;
begin
diff --git a/Lua/src/menu/UMenuText.pas b/Lua/src/menu/UMenuText.pas
index a3d13834..276f961b 100644
--- a/Lua/src/menu/UMenuText.pas
+++ b/Lua/src/menu/UMenuText.pas
@@ -34,29 +34,29 @@ interface
{$I switches.inc}
uses
- TextGL,
- UTexture,
- gl,
math,
SysUtils,
- SDL;
+ gl,
+ SDL,
+ TextGL,
+ UTexture;
type
TText = class
private
- SelectBool: boolean;
- TextString: string;
- TextTiles: array of string;
+ SelectBool: boolean;
+ TextString: UTF8String;
+ TextTiles: array of UTF8String;
- STicks: Cardinal;
- SelectBlink: boolean;
+ STicks: cardinal;
+ SelectBlink: boolean;
public
X: real;
Y: real;
Z: real;
- MoveX: real; //Some Modifier for X - Position that don't affect the real Y
- MoveY: real; //Some Modifier for Y - Position that don't affect the real Y
- W: real; //text wider than W is broken
+ MoveX: real; // some modifier for x - position that don't affect the real Y
+ MoveY: real; // some modifier for y - position that don't affect the real Y
+ W: real; // text wider than W is broken
// H: real;
Size: real;
ColR: real;
@@ -64,66 +64,69 @@ type
ColB: real;
Alpha: real;
Int: real;
- Style: integer;
- Visible: boolean;
- Align: integer; // 0 = left, 1 = center, 2 = right
+ Style: integer;
+ Visible: boolean;
+ Align: integer; // 0 = left, 1 = center, 2 = right
- //Reflection
- Reflection: boolean;
- ReflectionSpacing: real;
+ // reflection
+ Reflection: boolean;
+ ReflectionSpacing: real;
procedure SetSelect(Value: boolean);
property Selected: boolean read SelectBool write SetSelect;
- procedure SetText(Value: string);
- property Text: string read TextString write SetText;
+ procedure SetText(Value: UTF8String);
+ property Text: UTF8String read TextString write SetText;
- procedure DeleteLastL; //Procedure to Delete Last Letter
+ procedure DeleteLastLetter; //< Deletes the rightmost letter
procedure Draw;
constructor Create; overload;
- constructor Create(X, Y: real; Text: string); overload;
- constructor Create(ParX, ParY, ParW: real; ParStyle: integer; ParSize, ParColR, ParColG, ParColB: real; ParAlign: integer; ParText: string; ParReflection: boolean; ParReflectionSpacing: real; ParZ: real); overload;
+ constructor Create(X, Y: real; const Text: UTF8String); overload;
+ constructor Create(ParX, ParY, ParW: real; ParStyle: integer; ParSize, ParColR, ParColG, ParColB: real; ParAlign: integer; const ParText: UTF8String; ParReflection: boolean; ParReflectionSpacing: real; ParZ: real); overload;
end;
implementation
-uses UGraphic,
- StrUtils;
+uses
+ UGraphic,
+ UUnicodeUtils,
+ StrUtils;
procedure TText.SetSelect(Value: boolean);
begin
SelectBool := Value;
- //Set Cursor Visible
- SelectBlink := True;
+ // set cursor visible
+ SelectBlink := true;
STicks := SDL_GetTicks() div 550;
end;
-procedure TText.SetText(Value: string);
+procedure TText.SetText(Value: UTF8String);
var
- NextPos: Cardinal; //NextPos of a Space etc.
- LastPos: Cardinal; //LastPos "
- LastBreak: Cardinal; //Last Break
- isBreak: boolean; //True if the Break is not Caused because the Text is out of the area
- FirstWord: Word; //Is First Word after Break?
- Len: Word; //Length of the Tiles Array
+ NextPos: cardinal; // next pos of a space etc.
+ LastPos: cardinal; // last pos "
+ LastBreak: cardinal; // last break
+ isBreak: boolean; // true if the break is not caused because the text is out of the area
+ FirstWord: word; // is first word after break?
+ Len: word; // length of the tiles array
function GetNextPos: boolean;
var
- T1, {T2,} T3: Cardinal;
+ T1, {T2,} T3: cardinal;
begin
LastPos := NextPos;
- //Next Space (If Width is given)
+ // next space (if width is given)
if (W > 0) then
T1 := PosEx(' ', Value, LastPos + 1)
- else T1 := Length(Value);
+ else
+ T1 := Length(Value);
- {//Next -
+ {// next -
T2 := PosEx('-', Value, LastPos + 1);}
- //Next Break
+ // next break
T3 := PosEx('\n', Value, LastPos + 1);
if T1 = 0 then
@@ -133,19 +136,19 @@ var
if T3 = 0 then
T3 := Length(Value);
- //Get Nearest Pos
+ // get nearest pos
NextPos := min(T1, T3{min(T2, T3)});
- if (LastPos = Length(Value)) then
+ if (LastPos = cardinal(Length(Value))) then
NextPos := 0;
- isBreak := (NextPos = T3) AND (NextPos <> Length(Value));
+ isBreak := (NextPos = T3) and (NextPos <> cardinal(Length(Value)));
Result := (NextPos <> 0);
end;
- procedure AddBreak(const From, bTo: Cardinal);
+ procedure AddBreak(const From, bTo: cardinal);
begin
- if (isBreak) OR (bTo - From >= 1) then
+ if (isBreak) or (bTo - From >= 1) then
begin
Inc(Len);
SetLength (TextTiles, Len);
@@ -160,14 +163,14 @@ var
end;
begin
- //Set TExtstring
+ // set TextString
TextString := Value;
- //Set Cursor Visible
- SelectBlink := True;
+ // set cursor visible
+ SelectBlink := true;
STicks := SDL_GetTicks() div 550;
- //Exit if there is no Need to Create Tiles
+ // exit if there is no need to create tiles
if (W <= 0) and (Pos('\n', Value) = 0) then
begin
SetLength (TextTiles, 1);
@@ -175,12 +178,12 @@ begin
Exit;
end;
- //Create Tiles
- //Reset Text Array
+ // create tiles
+ // reset text array
SetLength (TextTiles, 0);
Len := 0;
- //Reset Counter Vars
+ // reset counter vars
LastPos := 1;
NextPos := 1;
LastBreak := 1;
@@ -188,105 +191,98 @@ begin
if (W > 0) then
begin
- //Set Font Properties
+ // set font properties
SetFontStyle(Style);
SetFontSize(Size);
end;
- //go Through Text
+ // go through text
while (GetNextPos) do
begin
- //Break in Text
+ // break in text
if isBreak then
begin
- //Look for Break before the Break
+ // look for break before the break
if (glTextWidth(Copy(Value, LastBreak, NextPos - LastBreak + 1)) > W) AND (NextPos-LastPos > 1) then
begin
- isBreak := False;
- //Not the First word after Break, so we don't have to break within a word
+ isBreak := false;
+ // not the first word after break, so we don't have to break within a word
if (FirstWord > 1) then
begin
- //Add Break before actual Position, because there the Text fits the Area
+ // add break before actual position, because there the text fits the area
AddBreak(LastBreak, LastPos);
end
- else //First Word after Break Break within the Word
+ else // first word after break break within the word
begin
- //ToDo
- //AddBreak(LastBreak, LastBreak + 155);
+ // to do
+ // AddBreak(LastBreak, LastBreak + 155);
end;
end;
- isBreak := True;
- //Add Break from Text
+ isBreak := true;
+ // add break from text
AddBreak(LastBreak, NextPos);
end
- //Text comes out of the Text Area -> CreateBreak
+ // text comes out of the text area -> createbreak
else if (glTextWidth(Copy(Value, LastBreak, NextPos - LastBreak + 1)) > W) then
begin
- //Not the First word after Break, so we don't have to break within a word
+ // not the first word after break, so we don't have to break within a word
if (FirstWord > 1) then
begin
- //Add Break before actual Position, because there the Text fits the Area
+ // add break before actual position, because there the text fits the area
AddBreak(LastBreak, LastPos);
end
- else //First Word after Break -> Break within the Word
+ else // first word after break -> break within the word
begin
- //ToDo
- //AddBreak(LastBreak, LastBreak + 155);
+ // to do
+ // AddBreak(LastBreak, LastBreak + 155);
end;
end;
//end;
Inc(FirstWord)
end;
- //Add Ending
+ // add ending
AddBreak(LastBreak, Length(Value)+1);
end;
-procedure TText.DeleteLastL;
-var
- S: string;
- L: integer;
+procedure TText.DeleteLastLetter;
begin
- S := TextString;
- L := Length(S);
- if (L > 0) then
- SetLength(S, L-1);
-
- SetText(S);
+ SetText(UTF8Copy(TextString, 1, LengthUTF8(TextString)-1));
end;
procedure TText.Draw;
var
X2, Y2: real;
- Text2: string;
+ Text2: UTF8String;
I: integer;
+ Ticks: cardinal;
begin
if Visible then
begin
SetFontStyle(Style);
SetFontSize(Size);
- SetFontItalic(False);
+ SetFontItalic(false);
glColor4f(ColR*Int, ColG*Int, ColB*Int, Alpha);
- //Reflection
- if Reflection = true then
+ // reflection
+ if Reflection then
SetFontReflection(true, ReflectionSpacing)
else
SetFontReflection(false,0);
- //if selected set blink...
+ // if selected set blink...
if SelectBool then
begin
- I := SDL_GetTicks() div 550;
- if I <> STicks then
- begin //Change Visability
- STicks := I;
+ Ticks := SDL_GetTicks() div 550;
+ if Ticks <> STicks then
+ begin // change visability
+ STicks := Ticks;
SelectBlink := Not SelectBlink;
end;
end;
- {if (False) then //no width set draw as one long string
+ {if (false) then // no width set draw as one long string
begin
if not (SelectBool AND SelectBlink) then
Text2 := Text
@@ -305,20 +301,20 @@ begin
end
else
begin}
- //now use allways:
- //draw text as many strings
+ // now use always:
+ // draw text as many strings
Y2 := Y + MoveY;
- for I := 0 to high(TextTiles) do
+ for I := 0 to High(TextTiles) do
begin
- if (not (SelectBool and SelectBlink)) or (I <> high(TextTiles)) then
+ if (not (SelectBool and SelectBlink)) or (I <> High(TextTiles)) then
Text2 := TextTiles[I]
else
Text2 := TextTiles[I] + '|';
case Align of
- 0: X2 := X + MoveX;
- 1: X2 := X + MoveX - glTextWidth(Text2)/2;
- 2: X2 := X + MoveX - glTextWidth(Text2);
+ 1: X2 := X + MoveX - glTextWidth(Text2)/2; { centered }
+ 2: X2 := X + MoveX - glTextWidth(Text2); { right aligned }
+ else X2 := X + MoveX; { left aligned (default) }
end;
SetFontPos(X2, Y2);
@@ -346,12 +342,19 @@ begin
Create(0, 0, '');
end;
-constructor TText.Create(X, Y: real; Text: string);
+constructor TText.Create(X, Y: real; const Text: UTF8String);
begin
Create(X, Y, 0, 0, 30, 0, 0, 0, 0, Text, false, 0, 0);
end;
-constructor TText.Create(ParX, ParY, ParW: real; ParStyle: integer; ParSize, ParColR, ParColG, ParColB: real; ParAlign: integer; ParText: string; ParReflection: boolean; ParReflectionSpacing: real; ParZ:real);
+constructor TText.Create(ParX, ParY, ParW: real;
+ ParStyle: integer;
+ ParSize, ParColR, ParColG, ParColB: real;
+ ParAlign: integer;
+ const ParText: UTF8String;
+ ParReflection: boolean;
+ ParReflectionSpacing: real;
+ ParZ: real);
begin
inherited Create;
Alpha := 1;
@@ -369,8 +372,8 @@ begin
Align := ParAlign;
SelectBool := false;
Visible := true;
- Reflection:= ParReflection;
- ReflectionSpacing:= ParReflectionSpacing;
+ Reflection := ParReflection;
+ ReflectionSpacing := ParReflectionSpacing;
end;
end.