aboutsummaryrefslogtreecommitdiffstats
path: root/src/menu0
diff options
context:
space:
mode:
Diffstat (limited to 'src/menu0')
-rw-r--r--src/menu0/UDisplay.pas383
-rw-r--r--src/menu0/UDrawTexture.pas105
-rw-r--r--src/menu0/UMenu.pas1432
-rw-r--r--src/menu0/UMenuButton.pas564
-rw-r--r--src/menu0/UMenuButtonCollection.pas71
-rw-r--r--src/menu0/UMenuInteract.pas16
-rw-r--r--src/menu0/UMenuSelectSlide.pas355
-rw-r--r--src/menu0/UMenuStatic.pas85
-rw-r--r--src/menu0/UMenuText.pas350
9 files changed, 0 insertions, 3361 deletions
diff --git a/src/menu0/UDisplay.pas b/src/menu0/UDisplay.pas
deleted file mode 100644
index 2b10b2c6..00000000
--- a/src/menu0/UDisplay.pas
+++ /dev/null
@@ -1,383 +0,0 @@
-unit UDisplay;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses
- ucommon,
- SDL,
- UMenu,
- gl,
- glu,
- SysUtils;
-
-type
- TDisplay = class
- private
- //fade-to-black-hack
- 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
-
- FadeTex: array[1..2] of GLuint;
-
- FPSCounter : Cardinal;
- LastFPS : Cardinal;
- NextFPSSwap : Cardinal;
-
- OSD_LastError : String;
-
- procedure DrawDebugInformation;
- public
- NextScreen : PMenu;
- CurrentScreen : PMenu;
-
- //popup data
- NextScreenWithCheck: Pmenu;
- CheckOK : Boolean;
-
- // FIXME: Fade is set to 0 in UMain and other files but not used here anymore.
- Fade : Real;
-
- constructor Create;
- destructor Destroy; override;
-
- procedure SaveScreenShot;
-
- function Draw: Boolean;
- end;
-
-var
- Display: TDisplay;
-
-implementation
-
-uses
- UImage,
- TextGL,
- ULog,
- UMain,
- UTexture,
- UIni,
- UGraphic,
- UTime,
- UCommandLine;
-
-constructor TDisplay.Create;
-var
- i: integer;
-begin
- inherited Create;
-
- //popup hack
- CheckOK := False;
- NextScreen := nil;
- NextScreenWithCheck := nil;
- BlackScreen := False;
-
- // fade mod
- FadeState := 0;
- FadeEnabled := (Ini.ScreenFade = 1);
- FadeFailed:= false;
-
- glGenTextures(2, @FadeTex);
-
- for i := 1 to 2 do
- begin
- glBindTexture(GL_TEXTURE_2D, FadeTex[i]);
- glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MAG_FILTER, GL_LINEAR);
- glTexParameteri(GL_TEXTURE_2D, GL_TEXTURE_MIN_FILTER, GL_LINEAR);
- end;
-
- //Set LastError for OSD to No Error
- OSD_LastError := 'No Errors';
-end;
-
-destructor TDisplay.Destroy;
-begin
- glDeleteTextures(2, @FadeTex);
- inherited Destroy;
-end;
-
-function TDisplay.Draw: Boolean;
-var
- S: integer;
- FadeStateSquare: Real;
- currentTime: Cardinal;
- glError: glEnum;
-begin
- Result := True;
-
- glClearColor(1, 1, 1 , 0);
- glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
-
- for S := 1 to Screens do
- begin
- ScreenAct := S;
-
- //if Screens = 1 then ScreenX := 0;
- //if (Screens = 2) and (S = 1) then ScreenX := -1;
- //if (Screens = 2) and (S = 2) then ScreenX := 1;
- ScreenX := 0;
-
- glViewPort((S-1) * ScreenW div Screens, 0, ScreenW div Screens, ScreenH);
-
- // popup hack
- // check was successful... move on
- if CheckOK then
- begin
- if assigned(NextScreenWithCheck) then
- begin
- NextScreen := NextScreenWithCheck;
- NextScreenWithCheck := nil;
- CheckOk := False;
- end
- else
- begin
- // on end of game fade to black before exit
- BlackScreen := True;
- end;
- end;
-
- if (not assigned(NextScreen)) and (not BlackScreen) then
- begin
- CurrentScreen.Draw;
-
- //popup mod
- if (ScreenPopupError <> nil) and ScreenPopupError.Visible then
- ScreenPopupError.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
- else if (Ini.ScreenFade = 0) then
- FadeEnabled := False;
- end
- else
- begin
- // disable fading if initialization failed
- if (FadeEnabled and FadeFailed) then
- begin
- FadeEnabled := False;
- end;
-
- if (FadeEnabled and not FadeFailed) then
- begin
- //Create Fading texture if we're just starting
- if FadeState = 0 then
- begin
- // save old viewport and resize to fit texture
- glPushAttrib(GL_VIEWPORT_BIT);
- glViewPort(0, 0, 512, 512);
-
- // draw screen that will be faded
- CurrentScreen.Draw;
-
- // clear OpenGL errors, otherwise fading might be disabled due to some
- // older errors in previous OpenGL calls.
- glGetError();
-
- // copy screen to texture
- glBindTexture(GL_TEXTURE_2D, FadeTex[S]);
- glCopyTexImage2D(GL_TEXTURE_2D, 0, GL_RGBA, 0, 0, 512, 512, 0);
- glError := glGetError();
- if (glError <> GL_NO_ERROR) then
- begin
- FadeFailed := true;
- Log.LogWarn('Fading disabled: ' + gluErrorString(glError), 'TDisplay.Draw');
- end;
-
- // restore viewport
- glPopAttrib();
-
- // blackscreen-hack
- if not BlackScreen then
- NextScreen.onShow;
-
- // update fade state
- LastFadeTime := SDL_GetTicks();
- if (S = 2) or (Screens = 1) then
- FadeState := FadeState + 1;
- end; // end texture creation in first fading step
-
- //do some time-based fading
- currentTime := SDL_GetTicks();
- if (currentTime > LastFadeTime+30) and (S = 1) then
- begin
- FadeState := FadeState + 4;
- LastFadeTime := currentTime;
- end;
-
- // blackscreen-hack
- if not BlackScreen then
- NextScreen.Draw // draw next screen
- else if ScreenAct = 1 then
- begin
- glClearColor(0, 0, 0 , 0);
- glClear(GL_COLOR_BUFFER_BIT or GL_DEPTH_BUFFER_BIT);
- end;
-
- // and draw old screen over it... slowly fading out
-
- FadeStateSquare := (FadeState*FadeState)/10000;
-
- glBindTexture(GL_TEXTURE_2D, FadeTex[S]);
- glColor4f(1, 1, 1, 1-FadeStateSquare);
-
- glEnable(GL_TEXTURE_2D);
- glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
- glEnable(GL_BLEND);
- glBegin(GL_QUADS);
- glTexCoord2f(0+FadeStateSquare, 0+FadeStateSquare); glVertex2f(0, 600);
- glTexCoord2f(0+FadeStateSquare, 1-FadeStateSquare); glVertex2f(0, 0);
- glTexCoord2f(1-FadeStateSquare, 1-FadeStateSquare); glVertex2f(800, 0);
- glTexCoord2f(1-FadeStateSquare, 0+FadeStateSquare); glVertex2f(800, 600);
- glEnd;
- glDisable(GL_BLEND);
- glDisable(GL_TEXTURE_2D);
- end
- // blackscreen hack
- else if not BlackScreen then
- begin
- NextScreen.OnShow;
- end;
-
- if ((FadeState > 40) or (not FadeEnabled) or FadeFailed) and (S = 1) then
- begin
- // fade out complete...
- FadeState := 0;
- CurrentScreen.onHide;
- CurrentScreen.ShowFinish := False;
- CurrentScreen := NextScreen;
- NextScreen := nil;
- if not BlackScreen then
- begin
- CurrentScreen.onShowFinish;
- CurrentScreen.ShowFinish := true;
- end
- else
- begin
- Result := False;
- Break;
- end;
- end;
- end; // if
-
- //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
-end;
-
-procedure TDisplay.SaveScreenShot;
-var
- Num: integer;
- FileName: string;
- ScreenData: PChar;
- Surface: PSDL_Surface;
- Success: boolean;
- Align: integer;
- RowSize: integer;
-begin
- // Exit if Screenshot-path does not exist or read-only
- if (ScreenshotsPath = '') 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
- end;
-
- // we must take the row-alignment (4byte by default) into account
- glGetIntegerv(GL_PACK_ALIGNMENT, @Align);
- // calc aligned row-size
- RowSize := ((ScreenW*3 + (Align-1)) div Align) * Align;
-
- GetMem(ScreenData, RowSize * ScreenH);
- glReadPixels(0, 0, ScreenW, ScreenH, GL_RGB, 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 := WritePNGImage(FileName, Surface);
- if Success then
- ScreenPopupError.ShowPopup('Screenshot saved: ' + ExtractFileName(FileName))
- else
- ScreenPopupError.ShowPopup('Screenshot failed');
-
- SDL_FreeSurface(Surface);
- FreeMem(ScreenData);
-end;
-
-//------------
-// DrawDebugInformation - Procedure draw FPS and some other Informations on Screen
-//------------
-procedure TDisplay.DrawDebugInformation;
-var Ticks: Cardinal;
-begin
- //Some White Background for information
- glEnable(GL_BLEND);
- glDisable(GL_TEXTURE_2D);
- glColor4f(1, 1, 1, 0.5);
- glBegin(GL_QUADS);
- glVertex2f(690, 44);
- glVertex2f(690, 0);
- glVertex2f(800, 0);
- glVertex2f(800, 44);
- glEnd;
- glDisable(GL_BLEND);
-
- //Set Font Specs
- SetFontStyle(0);
- SetFontSize(7);
- SetFontItalic(False);
- glColor4f(0, 0, 0, 1);
-
- //Calculate FPS
- Ticks := SDL_GetTicks();
- if (Ticks >= NextFPSSwap) then
- begin
- LastFPS := FPSCounter * 4;
- FPSCounter := 0;
- NextFPSSwap := Ticks + 250;
- end;
-
- Inc(FPSCounter);
-
- //Draw Text
-
- //FPS
- SetFontPos(695, 0);
- glPrint (PChar('FPS: ' + InttoStr(LastFPS)));
-
- //RSpeed
- SetFontPos(695, 13);
- glPrint (PChar('RSpeed: ' + InttoStr(Round(1000 * TimeMid))));
-
- //LastError
- SetFontPos(695, 26);
- glColor4f(1, 0, 0, 1);
- glPrint (PChar(OSD_LastError));
-
- glColor4f(1, 1, 1, 1);
-end;
-
-end.
diff --git a/src/menu0/UDrawTexture.pas b/src/menu0/UDrawTexture.pas
deleted file mode 100644
index a7dde18f..00000000
--- a/src/menu0/UDrawTexture.pas
+++ /dev/null
@@ -1,105 +0,0 @@
-unit UDrawTexture;
-
-interface
-
-{$I switches.inc}
-
-uses UTexture;
-
-procedure DrawLine(X1, Y1, X2, Y2, ColR, ColG, ColB: real);
-procedure DrawQuad(X, Y, W, H, ColR, ColG, ColB: real);
-procedure DrawTexture(Texture: TTexture);
-
-implementation
-
-uses gl;
-
-procedure DrawLine(X1, Y1, X2, Y2, ColR, ColG, ColB: real);
-begin
- glColor3f(ColR, ColG, ColB);
- glBegin(GL_LINES);
- glVertex2f(x1, y1);
- glVertex2f(x2, y2);
- glEnd;
-end;
-
-procedure DrawQuad(X, Y, W, H, ColR, ColG, ColB: real);
-begin
- glColor3f(ColR, ColG, ColB);
- glBegin(GL_QUADS);
- glVertex2f(x, y);
- glVertex2f(x, y+h);
- glVertex2f(x+w, y+h);
- glVertex2f(x+w, y);
- glEnd;
-end;
-
-procedure DrawTexture(Texture: TTexture);
-var
- x1, x2, x3, x4: real;
- y1, y2, y3, y4: real;
- xt1, xt2, xt3, xt4: real;
- yt1, yt2, yt3, yt4: real;
-begin
- with Texture do begin
- // rysuje paski gracza
- glColor4f(ColR * Int, ColG * Int, ColB * Int, Alpha);
- glEnable(GL_TEXTURE_2D);
- glEnable(GL_BLEND);
- glDepthRange(0, 10);
- glDepthFunc(GL_LEQUAL);
-// glDepthFunc(GL_GEQUAL);
- glEnable(GL_DEPTH_TEST);
- glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
-// glBlendFunc(GL_SRC_COLOR, GL_ZERO);
- glBindTexture(GL_TEXTURE_2D, TexNum);
-
- x1 := x;
- x2 := x;
- x3 := x+w*scaleW;
- x4 := x+w*scaleW;
- y1 := y;
- y2 := y+h*scaleH;
- y3 := y+h*scaleH;
- y4 := y;
- if Rot <> 0 then begin
- xt1 := x1 - (x + w/2);
- xt2 := x2 - (x + w/2);
- xt3 := x3 - (x + w/2);
- xt4 := x4 - (x + w/2);
- yt1 := y1 - (y + h/2);
- yt2 := y2 - (y + h/2);
- yt3 := y3 - (y + h/2);
- yt4 := y4 - (y + h/2);
-
- x1 := (x + w/2) + xt1 * cos(Rot) - yt1 * sin(Rot);
- x2 := (x + w/2) + xt2 * cos(Rot) - yt2 * sin(Rot);
- x3 := (x + w/2) + xt3 * cos(Rot) - yt3 * sin(Rot);
- x4 := (x + w/2) + xt4 * cos(Rot) - yt4 * sin(Rot);
-
- y1 := (y + h/2) + yt1 * cos(Rot) + xt1 * sin(Rot);
- y2 := (y + h/2) + yt2 * cos(Rot) + xt2 * sin(Rot);
- y3 := (y + h/2) + yt3 * cos(Rot) + xt3 * sin(Rot);
- y4 := (y + h/2) + yt4 * cos(Rot) + xt4 * sin(Rot);
-
- end;
-
-{ glBegin(GL_QUADS);
- glTexCoord2f(0, 0); glVertex3f(x1, y1, z);
- glTexCoord2f(0, TexH); glVertex3f(x2, y2, z);
- glTexCoord2f(TexW, TexH); glVertex3f(x3, y3, z);
- glTexCoord2f(TexW, 0); glVertex3f(x4, y4, z);
- glEnd;}
-
- glBegin(GL_QUADS);
- glTexCoord2f(TexX1*TexW, TexY1*TexH); glVertex3f(x1, y1, z);
- glTexCoord2f(TexX1*TexW, TexY2*TexH); glVertex3f(x2, y2, z);
- glTexCoord2f(TexX2*TexW, TexY2*TexH); glVertex3f(x3, y3, z);
- glTexCoord2f(TexX2*TexW, TexY1*TexH); glVertex3f(x4, y4, z);
- glEnd;
- end;
- glDisable(GL_DEPTH_TEST);
- glDisable(GL_TEXTURE_2D);
-end;
-
-end.
diff --git a/src/menu0/UMenu.pas b/src/menu0/UMenu.pas
deleted file mode 100644
index e352febd..00000000
--- a/src/menu0/UMenu.pas
+++ /dev/null
@@ -1,1432 +0,0 @@
-unit UMenu;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses gl, SysUtils, UTexture, UMenuStatic, UMenuText, UMenuButton, UMenuSelectSlide,
- UMenuInteract, UThemes, UMenuButtonCollection, Math, UMusic;
-
-type
-{ Int16 = SmallInt;}
-
- PMenu = ^TMenu;
- TMenu = class
- protected
- ButtonPos: Integer;
-
- Interactions: array of TInteract;
- SelInteraction: integer;
- Button: array of TButton;
- SelectsS: array of TSelectSlide;
- ButtonCollection: array of TButtonCollection;
- BackImg: TTexture;
- BackW: integer;
- BackH: integer;
-
- fFileName : string;
- public
- Text: array of TText;
- Static: array of TStatic;
- mX: integer; // mouse X
- mY: integer; // mouse Y
-
- Fade: integer; // fade type
- ShowFinish: boolean; // true if there is no fade
-
-
- destructor Destroy; override;
- constructor Create; overload; virtual;
- //constructor Create(Back: string); overload; virtual; // Back is a JPG resource name for background
- //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);
- property Interaction: integer read SelInteraction write SetInteraction;
-
- //Procedure Load BG, Texts, Statics and Button Collections from ThemeBasic
- procedure LoadFromTheme(const ThemeBasic: TThemeBasic);
-
- procedure PrepareButtonCollections(const Collections: AThemeButtonCollection);
- procedure AddButtonCollection(const ThemeCollection: TThemeButtonCollection; Const Num: Byte);
-
- // background
- procedure AddBackground(Name: string);
-
- // 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;
-
- // 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;
-
- // 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;
- 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;
-
- // select slide
- function AddSelectSlide(ThemeSelectS: TThemeSelectSlide; var Data: integer; Values: array of string): 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);
-
-// 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);
-
- 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;
-
- procedure SetAnimationProgress(Progress: real); virtual;
-
- function IsSelectable(Int: Cardinal): Boolean;
-
- procedure InteractNext; virtual;
- procedure InteractCustom(CustomSwitch: integer); virtual;
- procedure InteractPrev; virtual;
- procedure InteractInc; virtual;
- procedure InteractDec; virtual;
- procedure InteractNextRow; virtual; // this is for the options screen, so button down makes sense
- procedure InteractPrevRow; virtual; // this is for the options screen, so button up makes sense
- procedure AddBox(X, Y, W, H: real);
- end;
-
-const
- pmMove = 1;
- pmClick = 2;
- pmUnClick = 3;
-
- iButton = 0; // interaction type
- iText = 2;
- iSelectS = 3;
- iBCollectionChild = 5;
-
-// fBlack = 0; // fade type
-// fWhite = 1;
-
-implementation
-
-uses UCommon,
- ULog,
- UMain,
- UDrawTexture,
- UGraphic,
- UDisplay,
- UCovers,
- UTime,
- USkins;
-
-destructor TMenu.Destroy;
-begin
- inherited;
-end;
-
-constructor TMenu.Create;
-begin
- inherited;
-
- Fade := 0;//fWhite;
-
- SetLength(Static, 0);
- SetLength(Button, 0);
-
- BackImg.TexNum := 0;
-
- //Set ButtonPos to Autoset Length
- ButtonPos := -1;
-end;
-{
-constructor TMenu.Create(Back: String);
-begin
- inherited Create;
-
- if Back <> '' then begin
-// BackImg := Texture.GetTexture(true, Back, TEXTURE_TYPE_PLAIN, 0);
- BackImg := Texture.GetTexture(Back, TEXTURE_TYPE_PLAIN, 0); // new theme system
- BackImg.W := 800;//640;
- BackImg.H := 600;//480;
- BackW := 1;
- BackH := 1;
- end else
- BackImg.TexNum := 0;
-
- //Set ButtonPos to Autoset Length
- ButtonPos := -1;
-end;
-
-constructor TMenu.Create(Back: string; W, H: integer);
-begin
- Create(Back);
- BackImg.W := BackImg.W / W;
- BackImg.H := BackImg.H / H;
- BackW := W;
- BackH := H;
-end; }
-
-function RGBFloatToInt(R, G, B: Double): Cardinal;
-begin
- Result := (Trunc(255 * R) shl 16) or
- (Trunc(255 * G) shl 8) or
- Trunc(255 * B);
-end;
-
-procedure TMenu.AddInteraction(Typ, Num: integer);
-var
- IntNum: integer;
-begin
- IntNum := Length(Interactions);
- SetLength(Interactions, IntNum+1);
- Interactions[IntNum].Typ := Typ;
- Interactions[IntNum].Num := Num;
- Interaction := 0;
-end;
-
-procedure TMenu.SetInteraction(Num: integer);
-var
- OldNum, OldTyp: integer;
- NewNum, NewTyp: integer;
-begin
- // set inactive
- OldNum := Interactions[Interaction].Num;
- OldTyp := Interactions[Interaction].Typ;
-
- NewNum := Interactions[Num].Num;
- NewTyp := Interactions[Num].Typ;
-
- case OldTyp of
- iButton: Button[OldNum].Selected := False;
- iText: Text[OldNum].Selected := False;
- iSelectS: SelectsS[OldNum].Selected := False;
- //Button Collection Mod
- iBCollectionChild:
- 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
- ButtonCollection[Button[OldNum].Parent-1].Selected := False;
- end;
- end;
-
- // set active
- SelInteraction := Num;
- case NewTyp of
- iButton: Button[NewNum].Selected := True;
- iText: Text[NewNum].Selected := True;
- iSelectS: SelectsS[NewNum].Selected := True;
-
- //Button Collection Mod
- iBCollectionChild:
- begin
- Button[NewNum].Selected := True;
- ButtonCollection[Button[NewNum].Parent-1].Selected := True;
- end;
- end;
-end;
-
-//----------------------
-//LoadFromTheme - Load BG, Texts, Statics and
-//Button Collections from ThemeBasic
-//----------------------
-procedure TMenu.LoadFromTheme(const ThemeBasic: TThemeBasic);
-var
- I: Integer;
-begin
- //Add Button Collections (Set Button CollectionsLength)
- //Button Collections are Created when the first ChildButton is Created
- PrepareButtonCollections(ThemeBasic.ButtonCollection);
-
- //Add Background
- AddBackground(ThemeBasic.Background.Tex);
-
- //Add Statics and Texts
- for I := 0 to High(ThemeBasic.Static) do
- AddStatic(ThemeBasic.Static[I]);
-
- for I := 0 to High(ThemeBasic.Text) do
- AddText(ThemeBasic.Text[I]);
-end;
-
-procedure TMenu.AddBackground(Name: string);
-//var
-// lFileName : string;
-begin
- if Name <> '' then
- begin
- fFileName := Skin.GetTextureFileName(Name);
- fFileName := AdaptFilePaths( fFileName );
-
- if fileexists( fFileName ) then
- begin
- BackImg := Texture.GetTexture( fFileName , TEXTURE_TYPE_PLAIN);
-
- if ( BackImg.TexNum = 0 ) then
- begin
- if VideoPlayback.Open( fFileName ) then
- begin
- VideoBGTimer.SetTime(0);
- VideoPlayback.Play;
- end;
- end;
-
- BackImg.W := 800;
- BackImg.H := 600;
- BackW := 1;
- BackH := 1;
- end;
- end;
-end;
-
-//----------------------
-//PrepareButtonCollections:
-//Add Button Collections (Set Button CollectionsLength)
-//----------------------
-procedure TMenu.PrepareButtonCollections(const Collections: AThemeButtonCollection);
-var
- I: Integer;
-begin
- SetLength(ButtonCollection, Length(Collections));
- For I := 0 to High(ButtonCollection) do
- AddButtonCollection(Collections[I], I);
-end;
-
-//----------------------
-//AddButtonCollection:
-//Create a Button Collection;
-//----------------------
-procedure TMenu.AddButtonCollection(const ThemeCollection: TThemeButtonCollection; Const Num: Byte);
-var
- BT, BTLen: Integer;
- TempCol, TempDCol: Cardinal;
-
-begin
- if (Num > High(ButtonCollection)) then
- exit;
-
- TempCol := 0;
-
- // colorize hack
- if (ThemeCollection.Style.Typ = TEXTURE_TYPE_COLORIZED) then
- begin
- TempCol := RGBFloatToInt(ThemeCollection.Style.ColR, ThemeCollection.Style.ColG, ThemeCollection.Style.ColB);
- TempDCol := RGBFloatToInt(ThemeCollection.Style.DColR, ThemeCollection.Style.DColG, ThemeCollection.Style.DColB);
- // give encoded color to GetTexture()
- ButtonCollection[Num] := TButtonCollection.Create(
- Texture.GetTexture(Skin.GetTextureFileName(ThemeCollection.Style.Tex), TEXTURE_TYPE_COLORIZED, TempCol),
- Texture.GetTexture(Skin.GetTextureFileName(ThemeCollection.Style.Tex), TEXTURE_TYPE_COLORIZED, TempDCol));
- end
- else
- begin
- ButtonCollection[Num] := TButtonCollection.Create(Texture.GetTexture(
- Skin.GetTextureFileName(ThemeCollection.Style.Tex), ThemeCollection.Style.Typ));
- end;
-
- //Set Parent menu
- ButtonCollection[Num].ScreenButton := @Self.Button;
-
- //Set Attributes
- ButtonCollection[Num].FirstChild := ThemeCollection.FirstChild;
- ButtonCollection[Num].CountChilds := ThemeCollection.ChildCount;
- ButtonCollection[Num].Parent := Num + 1;
-
- //Set Style
- ButtonCollection[Num].X := ThemeCollection.Style.X;
- ButtonCollection[Num].Y := ThemeCollection.Style.Y;
- ButtonCollection[Num].W := ThemeCollection.Style.W;
- ButtonCollection[Num].H := ThemeCollection.Style.H;
- if (ThemeCollection.Style.Typ <> TEXTURE_TYPE_COLORIZED) then begin
- ButtonCollection[Num].SelectColR := ThemeCollection.Style.ColR;
- ButtonCollection[Num].SelectColG := ThemeCollection.Style.ColG;
- ButtonCollection[Num].SelectColB := ThemeCollection.Style.ColB;
- ButtonCollection[Num].DeselectColR := ThemeCollection.Style.DColR;
- ButtonCollection[Num].DeselectColG := ThemeCollection.Style.DColG;
- ButtonCollection[Num].DeselectColB := ThemeCollection.Style.DColB;
- end;
- ButtonCollection[Num].SelectInt := ThemeCollection.Style.Int;
- ButtonCollection[Num].DeselectInt := ThemeCollection.Style.DInt;
- ButtonCollection[Num].Texture.TexX1 := 0;
- ButtonCollection[Num].Texture.TexY1 := 0;
- ButtonCollection[Num].Texture.TexX2 := 1;
- ButtonCollection[Num].Texture.TexY2 := 1;
- ButtonCollection[Num].SetSelect(false);
-
- ButtonCollection[Num].Reflection := ThemeCollection.Style.Reflection;
- ButtonCollection[Num].Reflectionspacing := ThemeCollection.Style.ReflectionSpacing;
- ButtonCollection[Num].DeSelectReflectionspacing := ThemeCollection.Style.DeSelectReflectionSpacing;
-
- ButtonCollection[Num].Z := ThemeCollection.Style.Z;
-
- //Some Things from ButtonFading
- ButtonCollection[Num].SelectH := ThemeCollection.Style.SelectH;
- ButtonCollection[Num].SelectW := ThemeCollection.Style.SelectW;
-
- ButtonCollection[Num].Fade := ThemeCollection.Style.Fade;
- ButtonCollection[Num].FadeText := ThemeCollection.Style.FadeText;
- if (ThemeCollection.Style.Typ = TEXTURE_TYPE_COLORIZED) then
- begin
- ButtonCollection[Num].FadeTex := Texture.GetTexture(
- Skin.GetTextureFileName(ThemeCollection.Style.FadeTex), TEXTURE_TYPE_COLORIZED, TempCol)
- end else begin
- ButtonCollection[Num].FadeTex := Texture.GetTexture(
- Skin.GetTextureFileName(ThemeCollection.Style.FadeTex), ThemeCollection.Style.Typ);
- end;
- ButtonCollection[Num].FadeTexPos := ThemeCollection.Style.FadeTexPos;
-
-
- BTLen := Length(ThemeCollection.Style.Text);
- for BT := 0 to BTLen-1 do begin
- AddButtonText(ButtonCollection[Num], ThemeCollection.Style.Text[BT].X, ThemeCollection.Style.Text[BT].Y,
- ThemeCollection.Style.Text[BT].ColR, ThemeCollection.Style.Text[BT].ColG, ThemeCollection.Style.Text[BT].ColB,
- ThemeCollection.Style.Text[BT].Font, ThemeCollection.Style.Text[BT].Size, ThemeCollection.Style.Text[BT].Align,
- ThemeCollection.Style.Text[BT].Text);
- end;
-end;
-
-function TMenu.AddStatic(ThemeStatic: TThemeStatic): integer;
-begin
- Result := AddStatic(ThemeStatic.X, ThemeStatic.Y, ThemeStatic.W, ThemeStatic.H, ThemeStatic.Z,
- ThemeStatic.ColR, ThemeStatic.ColG, ThemeStatic.ColB,
- ThemeStatic.TexX1, ThemeStatic.TexY1, ThemeStatic.TexX2, ThemeStatic.TexY2,
- Skin.GetTextureFileName(ThemeStatic.Tex),
- ThemeStatic.Typ, $FFFFFF, ThemeStatic.Reflection, ThemeStatic.Reflectionspacing);
-end;
-
-function TMenu.AddStatic(X, Y, W, H: real; const Name: string): integer;
-begin
- Result := AddStatic(X, Y, W, H, Name, TEXTURE_TYPE_PLAIN);
-end;
-
-function TMenu.AddStatic(X, Y, W, H: real; ColR, ColG, ColB: real; const Name: string; Typ: TTextureType): integer;
-begin
- Result := AddStatic(X, Y, W, H, ColR, ColG, ColB, Name, Typ, $FFFFFF);
-end;
-
-function TMenu.AddStatic(X, Y, W, H, Z: real; ColR, ColG, ColB: real; const Name: string; Typ: TTextureType): integer;
-begin
- Result := AddStatic(X, Y, W, H, Z, ColR, ColG, ColB, Name, Typ, $FFFFFF);
-end;
-
-function TMenu.AddStatic(X, Y, W, H: real; const Name: string; 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
-
- // configures static
- Static[StatNum].Texture.X := X;
- Static[StatNum].Texture.Y := Y;
- Static[StatNum].Texture.W := W;
- Static[StatNum].Texture.H := H;
- Static[StatNum].Visible := true;
- Result := StatNum;
-end;
-
-function TMenu.AddStatic(X, Y, W, H: real; ColR, ColG, ColB: real; const Name: string; Typ: TTextureType; Color: integer): integer;
-begin
- Result := AddStatic(X, Y, W, H, 0, ColR, ColG, ColB, Name, Typ, Color);
-end;
-
-function TMenu.AddStatic(X, Y, W, H, Z: real; ColR, ColG, ColB: real; const Name: string; 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);
-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;
-var
- StatNum: integer;
-begin
- // adds static
- StatNum := Length(Static);
- SetLength(Static, StatNum + 1);
-
- // colorize hack
- if (Typ = TEXTURE_TYPE_COLORIZED) then
- begin
- // give encoded color to GetTexture()
- Static[StatNum] := TStatic.Create(Texture.GetTexture(Name, Typ, RGBFloatToInt(ColR, ColG, ColB)));
- end
- else
- begin
- Static[StatNum] := TStatic.Create(Texture.GetTexture(Name, 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;
- Static[StatNum].Texture.Z := Z;
- if (Typ <> TEXTURE_TYPE_COLORIZED) then
- begin
- Static[StatNum].Texture.ColR := ColR;
- Static[StatNum].Texture.ColG := ColG;
- Static[StatNum].Texture.ColB := ColB;
- end;
- Static[StatNum].Texture.TexX1 := TexX1;
- Static[StatNum].Texture.TexY1 := TexY1;
- Static[StatNum].Texture.TexX2 := TexX2;
- Static[StatNum].Texture.TexY2 := TexY2;
- Static[StatNum].Texture.Alpha := 1;
- Static[StatNum].Visible := true;
-
- //ReflectionMod
- Static[StatNum].Reflection := Reflection;
- Static[StatNum].ReflectionSpacing := ReflectionSpacing;
-
- Result := StatNum;
-end;
-
-function TMenu.AddText(ThemeText: TThemeText): integer;
-begin
- Result := AddText(ThemeText.X, ThemeText.Y, ThemeText.W, ThemeText.Font, ThemeText.Size,
- 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;
-var
- TextNum: integer;
-begin
- // adds text
- TextNum := Length(Text);
- SetLength(Text, TextNum + 1);
- Text[TextNum] := TText.Create(X, Y, Text_);
- Result := TextNum;
-end;
-
-function TMenu.AddText(X, Y: real; Style: integer; Size, ColR, ColG, ColB: real; const Text: string): 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;
-var
- TextNum: integer;
-begin
- // adds text
- TextNum := Length(Text);
- SetLength(Text, TextNum + 1);
- Text[TextNum] := TText.Create(X, Y, W, Style, Size, ColR, ColG, ColB, Align, Text_, Reflection_, ReflectionSpacing_, Z);
- Result := TextNum;
-end;
-
-//Function that Set Length of Button Array in one Step instead of register new Memory for every Button
-Procedure TMenu.SetButtonLength(Length: Cardinal);
-begin
- if (ButtonPos = -1) AND (Length > 0) then
- begin
- //Set Length of Button
- SetLength(Button, Length);
-
- //Set ButtonPos to start with 0
- ButtonPos := 0;
- end;
-end;
-
-
-// Method to add a button in our TMenu. It returns the assigned ButtonNumber
-function TMenu.AddButton(ThemeButton: TThemeButton): integer;
-var
- BT: integer;
- BTLen: integer;
-begin
- Result := AddButton(ThemeButton.X, ThemeButton.Y, ThemeButton.W, ThemeButton.H,
- ThemeButton.ColR, ThemeButton.ColG, ThemeButton.ColB, ThemeButton.Int,
- ThemeButton.DColR, ThemeButton.DColG, ThemeButton.DColB, ThemeButton.DInt,
- Skin.GetTextureFileName(ThemeButton.Tex), ThemeButton.Typ,
- ThemeButton.Reflection, ThemeButton.Reflectionspacing, ThemeButton.DeSelectReflectionspacing);
-
- Button[Result].Z := ThemeButton.Z;
-
- //Button Visibility
- Button[Result].Visible := ThemeButton.Visible;
-
- //Some Things from ButtonFading
- Button[Result].SelectH := ThemeButton.SelectH;
- Button[Result].SelectW := ThemeButton.SelectW;
-
- Button[Result].Fade := ThemeButton.Fade;
- Button[Result].FadeText := ThemeButton.FadeText;
- if (ThemeButton.Typ = TEXTURE_TYPE_COLORIZED) then
- begin
- Button[Result].FadeTex := Texture.GetTexture(
- Skin.GetTextureFileName(ThemeButton.FadeTex), TEXTURE_TYPE_COLORIZED,
- RGBFloatToInt(ThemeButton.ColR, ThemeButton.ColG, ThemeButton.ColB));
- end
- else
- begin
- Button[Result].FadeTex := Texture.GetTexture(
- Skin.GetTextureFileName(ThemeButton.FadeTex), ThemeButton.Typ);
- end;
-
- Button[Result].FadeTexPos := ThemeButton.FadeTexPos;
-
- BTLen := Length(ThemeButton.Text);
- for BT := 0 to BTLen-1 do
- begin
- AddButtonText(ThemeButton.Text[BT].X, ThemeButton.Text[BT].Y,
- ThemeButton.Text[BT].ColR, ThemeButton.Text[BT].ColG, ThemeButton.Text[BT].ColB,
- ThemeButton.Text[BT].Font, ThemeButton.Text[BT].Size, ThemeButton.Text[BT].Align,
- ThemeButton.Text[BT].Text);
- end;
-
- //BAutton Collection Mod
- if (ThemeButton.Parent <> 0) then
- begin
- //If Collection Exists then Change Interaction to Child Button
- if (@ButtonCollection[ThemeButton.Parent-1] <> nil) then
- begin
- Interactions[High(Interactions)].Typ := iBCollectionChild;
- Button[Result].Visible := False;
-
- for BT := 0 to BTLen-1 do
- Button[Result].Text[BT].Alpha := 0;
-
- Button[Result].Parent := ThemeButton.Parent;
- if (ButtonCollection[ThemeButton.Parent-1].Fade) then
- Button[Result].Texture.Alpha := 0;
- end;
- end;
- Log.BenchmarkEnd(6);
- Log.LogBenchmark('====> Screen Options32', 6);
-end;
-
-function TMenu.AddButton(X, Y, W, H: real; const Name: String): integer;
-begin
- Result := AddButton(X, Y, W, H, Name, TEXTURE_TYPE_PLAIN, False);
-end;
-
-function TMenu.AddButton(X, Y, W, H: real; const Name: String; 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);
-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;
-begin
- // adds button
- //SetLength is used once to reduce Memory usement
- if (ButtonPos <> -1) then
- begin
- Result := ButtonPos;
- Inc(ButtonPos)
- end
- else //Old Method -> Reserve new Memory for every Button
- begin
- Result := Length(Button);
- SetLength(Button, Result + 1);
- end;
-
- // colorize hack
- 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)));
- end
- else
- begin
- Button[Result] := TButton.Create(Texture.GetTexture(Name, Typ));
- end;
-
- // configures button
- Button[Result].X := X;
- Button[Result].Y := Y;
- Button[Result].W := W;
- Button[Result].H := H;
- if (Typ <> TEXTURE_TYPE_COLORIZED) then
- begin
- Button[Result].SelectColR := ColR;
- Button[Result].SelectColG := ColG;
- Button[Result].SelectColB := ColB;
- Button[Result].DeselectColR := DColR;
- Button[Result].DeselectColG := DColG;
- Button[Result].DeselectColB := DColB;
- end;
- Button[Result].SelectInt := Int;
- Button[Result].DeselectInt := DInt;
- Button[Result].Texture.TexX1 := 0;
- Button[Result].Texture.TexY1 := 0;
- Button[Result].Texture.TexX2 := 1;
- Button[Result].Texture.TexY2 := 1;
- Button[Result].SetSelect(false);
-
- Button[Result].Reflection := Reflection;
- Button[Result].Reflectionspacing := ReflectionSpacing;
- Button[Result].DeSelectReflectionspacing := DeSelectReflectionSpacing;
-
- //Button Collection Mod
- Button[Result].Parent := 0;
-
-
- // adds interaction
- AddInteraction(iButton, Result);
- Interaction := 0;
-end;
-
-procedure TMenu.ClearButtons;
-begin
- Setlength(Button, 0);
-end;
-
-// Method to draw our TMenu and all his child buttons
-function TMenu.DrawBG: boolean;
-begin
- BackImg.ColR := 1;
- BackImg.ColG := 1;
- BackImg.ColB := 1;
- BackImg.TexX1 := 0;
- BackImg.TexY1 := 0;
- BackImg.TexX2 := 1;
- BackImg.TexY2 := 1;
-
- if (BackImg.TexNum > 0) then
- begin
- BackImg.X := 0;
- BackImg.Y := 0;
- BackImg.Z := 0; // todo: eddie: to the opengl experts: please check this! On the mac z is not initialized???
- BackImg.W := 800;
- BackImg.H := 600;
- DrawTexture(BackImg);
- end
- else if (VideoPlayback <> nil) then
- begin
- VideoPlayback.GetFrame(VideoBGTimer.GetTime());
- // FIXME: why do we draw on screen 2? Seems to be wrong.
- VideoPlayback.DrawGL(2);
- end;
-
- Result := true;
-end;
-
-function TMenu.DrawFG: boolean;
-var
- J: Integer;
-begin
- // We don't forget about newly implemented static for nice skin ...
- for J := 0 to Length(Static) - 1 do
- Static[J].Draw;
-
- // ... and slightly implemented menutext unit
- for J := 0 to Length(Text) - 1 do
- Text[J].Draw;
-
- // Draw all ButtonCollections
- for J := 0 to High(ButtonCollection) do
- ButtonCollection[J].Draw;
-
- // Second, we draw all of our buttons
- for J := 0 to Length(Button) - 1 do
- Button[J].Draw;
-
- for J := 0 to Length(SelectsS) - 1 do
- SelectsS[J].Draw;
-
- // Third, we draw all our widgets
- // for J := 0 to Length(WidgetsSrc) - 1 do
- // SDL_BlitSurface(WidgetsSrc[J], nil, ParentBackBuf, WidgetsRect[J]);
- Result := True;
-end;
-
-function TMenu.Draw: boolean;
-begin
- DrawBG;
- DrawFG;
- Result := true;
-end;
-
-{
-function TMenu.GetNextScreen(): PMenu;
-begin
- Result := NextScreen;
-end;
-}
-
-{
-function TMenu.AddWidget(X, Y : UInt16; WidgetSrc : PSDL_Surface): Int16;
-var
- WidgetNum : Int16;
-begin
- if (Assigned(WidgetSrc)) then
- begin
- WidgetNum := Length(WidgetsSrc);
-
- SetLength(WidgetsSrc, WidgetNum + 1);
- SetLength(WidgetsRect, WidgetNum + 1);
-
- WidgetsSrc[WidgetNum] := WidgetSrc;
- WidgetsRect[WidgetNum] := new(PSDL_Rect);
- WidgetsRect[WidgetNum]^.x := X;
- WidgetsRect[WidgetNum]^.y := Y;
- WidgetsRect[WidgetNum]^.w := WidgetSrc^.w;
- WidgetsRect[WidgetNum]^.h := WidgetSrc^.h;
-
- Result := WidgetNum;
- end
- else
- Result := -1;
-end;
-}
-
-{
-procedure TMenu.ClearWidgets(MinNumber : Int16);
-var
- J : Int16;
-begin
- for J := MinNumber to (Length(WidgetsSrc) - 1) do
- begin
- SDL_FreeSurface(WidgetsSrc[J]);
- dispose(WidgetsRect[J]);
- end;
-
- SetLength(WidgetsSrc, MinNumber);
- SetLength(WidgetsRect, MinNumber);
-end;
-}
-
-function TMenu.IsSelectable(Int: Cardinal): Boolean;
-begin
- Result := True;
- case Interactions[Int].Typ of
- //Button
- iButton: Result := Button[Interactions[Int].Num].Visible and Button[Interactions[Int].Num].Selectable;
-
- //Select Slide
- iSelectS: Result := SelectsS[Interactions[Int].Num].Visible;
-
- //ButtonCollection Child
- iBCollectionChild:
- Result := (ButtonCollection[Button[Interactions[Int].Num].Parent - 1].FirstChild - 1 = Int) and ((Interactions[Interaction].Typ <> iBCollectionChild) or (Button[Interactions[Interaction].Num].Parent <> Button[Interactions[Int].Num].Parent));
- end;
-end;
-
-// implemented for the sake of usablility
-// [curser down] picks the button left to the actual atm
-// this behaviour doesn't make sense for two rows of buttons
-procedure TMenu.InteractPrevRow;
-var
- Int: integer;
-begin
-// these two procedures just make sense for at least 5 buttons, because we
-// usually start a second row when there are more than 4 buttons
- Int := Interaction;
-
- 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
-end;
-
-procedure TMenu.InteractNextRow;
-var
- Int: integer;
-begin
- Int := Interaction;
-
- 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
-end;
-
-procedure TMenu.InteractNext;
-var
- Int: integer;
-begin
- Int := Interaction;
-
- // change interaction as long as it's needed
- repeat
- Int := (Int + 1) mod Length(Interactions);
-
- //If no Interaction is Selectable Simply Select Next
- if (Int = Interaction) then Break;
-
- until IsSelectable(Int);
-
- //Set Interaction
- Interaction := Int;
-end;
-
-procedure TMenu.InteractPrev;
-var
- Int: integer;
-begin
- Int := Interaction;
-
- // change interaction as long as it's needed
- repeat
- Int := Int - 1;
- if Int = -1 then Int := High(Interactions);
-
- //If no Interaction is Selectable Simply Select Next
- if (Int = Interaction) then Break;
- until IsSelectable(Int);
-
- //Set Interaction
- Interaction := Int
-end;
-
-
-procedure TMenu.InteractCustom(CustomSwitch: integer);
-{ needed only for below
-var
- Num: integer;
- Typ: integer;
- Again: boolean;
-}
-begin
- //Code Commented atm, because it needs to be Rewritten
- //it doesn't work with Button Collections
- {then begin
- CustomSwitch:= CustomSwitch*(-1);
- Again := true;
- // change interaction as long as it's needed
- while (Again = true) do begin
- Num := SelInteraction - CustomSwitch;
- if Num = -1 then Num := High(Interactions);
- Interaction := Num;
- Again := false; // reset, default to accept changing interaction
-
- // checking newly interacted element
- Num := Interactions[Interaction].Num;
- Typ := Interactions[Interaction].Typ;
- case Typ of
- iButton:
- begin
- if Button[Num].Selectable = false then Again := True;
- end;
- end; // case
- end; // while
- end
- else if num>0 then begin
- Again := true;
- // change interaction as long as it's needed
- while (Again = true) do begin
- Num := (Interaction + CustomSwitch) Mod Length(Interactions);
- Interaction := Num;
- Again := false; // reset, default to accept changing interaction
-
-
- // checking newly interacted element
- Num := Interactions[Interaction].Num;
- Typ := Interactions[Interaction].Typ;
- case Typ of
- iButton:
- begin
- if Button[Num].Selectable = false then Again := True;
- end;
- end; // case
- end; // while
- end }
-end;
-
-
-procedure TMenu.FadeTo(Screen: PMenu);
-begin
- Display.Fade := 0;
- Display.NextScreen := Screen;
-end;
-
-procedure TMenu.FadeTo(Screen: PMenu; aSound: TAudioPlaybackStream);
-begin
- FadeTo( Screen );
- AudioPlayback.PlaySound( aSound );
-end;
-
-
-//popup hack
-procedure TMenu.CheckFadeTo(Screen: PMenu; msg: String);
-begin
- Display.Fade := 0;
- Display.NextScreenWithCheck := Screen;
- Display.CheckOK:=False;
- ScreenPopupCheck.ShowPopup(msg);
-end;
-
-procedure TMenu.AddButtonText(AddX, AddY: real; const AddText: string);
-begin
- AddButtonText(AddX, AddY, 1, 1, 1, AddText);
-end;
-
-procedure TMenu.AddButtonText(AddX, AddY: real; ColR, ColG, ColB: real; const AddText: string);
-var
- Il: integer;
-begin
- with Button[High(Button)] do begin
- Il := Length(Text);
- SetLength(Text, Il+1);
- Text[Il] := TText.Create(X + AddX, Y + AddY, AddText);
- Text[Il].ColR := ColR;
- Text[Il].ColG := ColG;
- Text[Il].ColB := ColB;
- Text[Il].Int := 1;//0.5;
- end;
-end;
-
-procedure TMenu.AddButtonText(AddX, AddY: real; ColR, ColG, ColB: real; Font: integer; Size: integer; Align: integer; const AddText: string);
-var
- Il: integer;
-begin
- with Button[High(Button)] do begin
- Il := Length(Text);
- SetLength(Text, Il+1);
- Text[Il] := TText.Create(X + AddX, Y + AddY, AddText);
- Text[Il].ColR := ColR;
- Text[Il].ColG := ColG;
- Text[Il].ColB := ColB;
- Text[Il].Int := 1;//0.5;
- Text[Il].Style := Font;
- Text[Il].Size := Size;
- Text[Il].Align := Align;
- end;
-end;
-
-procedure TMenu.AddButtonText(CustomButton: TButton; AddX, AddY: real; ColR, ColG, ColB: real; Font: integer; Size: integer; Align: integer; const AddText: string);
-var
- Il: integer;
-begin
- with CustomButton do begin
- Il := Length(Text);
- SetLength(Text, Il+1);
- Text[Il] := TText.Create(X + AddX, Y + AddY, AddText);
- Text[Il].ColR := ColR;
- Text[Il].ColG := ColG;
- Text[Il].ColB := ColB;
- Text[Il].Int := 1;//0.5;
- Text[Il].Style := Font;
- Text[Il].Size := Size;
- Text[Il].Align := Align;
- end;
-end;
-
-
-function TMenu.AddSelectSlide(ThemeSelectS: TThemeSelectSlide; var Data: integer; Values: array of string): integer;
-var
- SO: integer;
-begin
- Result := AddSelectSlide(ThemeSelectS.X, ThemeSelectS.Y, ThemeSelectS.W, ThemeSelectS.H, ThemeSelectS.SkipX, ThemeSelectS.SBGW,
- ThemeSelectS.ColR, ThemeSelectS.ColG, ThemeSelectS.ColB, ThemeSelectS.Int,
- ThemeSelectS.DColR, ThemeSelectS.DColG, ThemeSelectS.DColB, ThemeSelectS.DInt,
- ThemeSelectS.TColR, ThemeSelectS.TColG, ThemeSelectS.TColB, ThemeSelectS.TInt,
- ThemeSelectS.TDColR, ThemeSelectS.TDColG, ThemeSelectS.TDColB, ThemeSelectS.TDInt,
- ThemeSelectS.SBGColR, ThemeSelectS.SBGColG, ThemeSelectS.SBGColB, ThemeSelectS.SBGInt,
- ThemeSelectS.SBGDColR, ThemeSelectS.SBGDColG, ThemeSelectS.SBGDColB, ThemeSelectS.SBGDInt,
- ThemeSelectS.STColR, ThemeSelectS.STColG, ThemeSelectS.STColB, ThemeSelectS.STInt,
- ThemeSelectS.STDColR, ThemeSelectS.STDColG, ThemeSelectS.STDColB, ThemeSelectS.STDInt,
- Skin.GetTextureFileName(ThemeSelectS.Tex), TEXTURE_TYPE_COLORIZED,
- Skin.GetTextureFileName(ThemeSelectS.TexSBG), TEXTURE_TYPE_COLORIZED,
- ThemeSelectS.Text, Data);
- for SO := 0 to High(Values) do
- AddSelectSlideOption(Values[SO]);
-
- SelectsS[High(SelectsS)].Text.Size := ThemeSelectS.TextSize;
-
- SelectsS[High(SelectsS)].Texture.Z := ThemeSelectS.Z;
- SelectsS[High(SelectsS)].TextureSBG.Z := ThemeSelectS.Z;
-
- //Generate Lines
- SelectsS[High(SelectsS)].GenLines;
-
- SelectsS[High(SelectsS)].SelectedOption := SelectsS[High(SelectsS)].SelectOptInt; // refresh
-end;
-
-function TMenu.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;
-var
- S: integer;
- I: integer;
-begin
- S := Length(SelectsS);
- SetLength(SelectsS, S + 1);
- SelectsS[S] := TSelectSlide.Create;
-
- if (Typ = TEXTURE_TYPE_COLORIZED) then
- SelectsS[S].Texture := Texture.GetTexture(Name, Typ, RGBFloatToInt(ColR, ColG, ColB))
- else
- SelectsS[S].Texture := Texture.GetTexture(Name, Typ);
- SelectsS[S].X := X;
- SelectsS[S].Y := Y;
- SelectsS[S].W := W;
- SelectsS[S].H := H;
-
- SelectsS[S].ColR := ColR;
- SelectsS[S].ColG := ColG;
- SelectsS[S].ColB := ColB;
- SelectsS[S].Int := Int;
- SelectsS[S].DColR := DColR;
- SelectsS[S].DColG := DColG;
- SelectsS[S].DColB := DColB;
- SelectsS[S].DInt := DInt;
-
- if (SBGTyp = TEXTURE_TYPE_COLORIZED) then
- SelectsS[S].TextureSBG := Texture.GetTexture(SBGName, SBGTyp, RGBFloatToInt(SBGColR, SBGColG, SBGColB))
- else
- SelectsS[S].TextureSBG := Texture.GetTexture(SBGName, SBGTyp);
- 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;
- SelectsS[S].SBGColG := SBGColG;
- SelectsS[S].SBGColB := SBGColB;
- SelectsS[S].SBGInt := SBGInt;
- SelectsS[S].SBGDColR := SBGDColR;
- SelectsS[S].SBGDColG := SBGDColG;
- SelectsS[S].SBGDColB := SBGDColB;
- SelectsS[S].SBGDInt := SBGDInt;
-
- SelectsS[S].Text.X := X + 20;
- SelectsS[S].Text.Y := Y + (SelectsS[S].TextureSBG.H / 2) - 15;
- SelectsS[S].Text.Text := Caption;
- SelectsS[S].Text.Size := 10;
- SelectsS[S].Text.Visible := true;
- SelectsS[S].TColR := TColR;
- SelectsS[S].TColG := TColG;
- SelectsS[S].TColB := TColB;
- SelectsS[S].TInt := TInt;
- SelectsS[S].TDColR := TDColR;
- SelectsS[S].TDColG := TDColG;
- SelectsS[S].TDColB := TDColB;
- SelectsS[S].TDInt := TDInt;
-
- SelectsS[S].STColR := STColR;
- SelectsS[S].STColG := STColG;
- SelectsS[S].STColB := STColB;
- SelectsS[S].STInt := STInt;
- SelectsS[S].STDColR := STDColR;
- SelectsS[S].STDColG := STDColG;
- SelectsS[S].STDColB := STDColB;
- SelectsS[S].STDInt := STDInt;
-
- // new
- SelectsS[S].Texture.TexX1 := 0;
- SelectsS[S].Texture.TexY1 := 0;
- SelectsS[S].Texture.TexX2 := 1;
- SelectsS[S].Texture.TexY2 := 1;
- SelectsS[S].TextureSBG.TexX1 := 0;
- SelectsS[S].TextureSBG.TexY1 := 0;
- SelectsS[S].TextureSBG.TexX2 := 1;
- SelectsS[S].TextureSBG.TexY2 := 1;
-
- // Sets Data to copy the value of selectops to global value;
- SelectsS[S].PData := @Data;
- // Configures Select options
- {//SelectsS[S].TextOpt[0].Text := IntToStr(I+1);
- SelectsS[S].TextOpt[0].Size := 10;
- SelectsS[S].TextOpt[0].Align := 1;
-
- SelectsS[S].TextOpt[0].ColR := SelectsS[S].STDColR;
- SelectsS[S].TextOpt[0].ColG := SelectsS[S].STDColG;
- SelectsS[S].TextOpt[0].ColB := SelectsS[S].STDColB;
- SelectsS[S].TextOpt[0].Int := SelectsS[S].STDInt;
- SelectsS[S].TextOpt[0].Visible := true; }
-
- // Sets default value of selectopt from Data;
- SelectsS[S].SelectedOption := Data;
-
- // Disables default selection
- SelectsS[S].SetSelect(false);
-
- {// Configures 3 select options
- for I := 0 to 2 do begin
- SelectsS[S].TextOpt[I].X := SelectsS[S].TextureSBG.X + 20 + (50 + 20) + (150 - 20) * I;
- SelectsS[S].TextOpt[I].Y := SelectsS[S].TextureSBG.Y + 20;
- SelectsS[S].TextOpt[I].Text := IntToStr(I+1);
- SelectsS[S].TextOpt[I].Size := 10;
- SelectsS[S].TextOpt[I].Align := 1;
-
-
- SelectsS[S].TextOpt[I].ColR := SelectsS[S].STDColR;
- SelectsS[S].TextOpt[I].ColG := SelectsS[S].STDColG;
- SelectsS[S].TextOpt[I].ColB := SelectsS[S].STDColB;
- SelectsS[S].TextOpt[I].Int := SelectsS[S].STDInt;
- SelectsS[S].TextOpt[I].Visible := true;
- end;}
-
-
- // adds interaction
- AddInteraction(iSelectS, S);
- Result := S;
-end;
-
-procedure TMenu.AddSelectSlideOption(const AddText: string);
-begin
- AddSelectSlideOption(High(SelectsS), AddText);
-end;
-
-procedure TMenu.AddSelectSlideOption(SelectNo: Cardinal; const AddText: string);
-var
- SO: integer;
-begin
- SO := Length(SelectsS[SelectNo].TextOptT);
-
- SetLength(SelectsS[SelectNo].TextOptT, SO + 1);
- SelectsS[SelectNo].TextOptT[SO] := AddText;
-
- //SelectsS[S].SelectedOption := SelectsS[S].SelectOptInt; // refresh
-
- //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);
-var
- SO: integer;
-begin
- SetLength(SelectsS[SelectNum].TextOptT, 0);
- for SO := 0 to High(Values) do
- AddSelectSlideOption(SelectNum, Values[SO]);
-
- SelectsS[SelectNum].GenLines;
-
-// SelectsS[SelectNum].SelectedOption := SelectsS[SelectNum].SelectOptInt; // refresh
-// SelectS[SelectNum].SetSelectOpt(Data);
-// SelectS[SelectNum].SelectedOption := 0;//Data;
-
-// Log.LogError(IntToStr(High(SelectsS[SelectNum].TextOptT)));
-// if 0 <= High(SelectsS[SelectNum].TextOptT) then
-
- SelectsS[SelectNum].PData := @Data;
- SelectsS[SelectNum].SelectedOption := Data;
-end;
-
-procedure TMenu.InteractInc;
-var
- Num: integer;
- Value: integer;
-begin
- case Interactions[Interaction].Typ of
- iSelectS: begin
- Num := Interactions[Interaction].Num;
- Value := SelectsS[Num].SelectedOption;
-// Value := (Value + 1) Mod (Length(SelectsS[Num].TextOptT));
-
- // limit
- Value := Value + 1;
- if Value <= High(SelectsS[Num].TextOptT) then
- SelectsS[Num].SelectedOption := Value;
- end;
- //Button Collection Mod
- iBCollectionChild:
- begin
-
- //Select Next Button in Collection
- For Num := 1 to High(Button) do
- begin
- Value := (Interaction + Num) Mod Length(Button);
- if Value = 0 then
- begin
- InteractNext;
- Break;
- end;
- if (Button[Value].Parent = Button[Interaction].Parent) then
- begin
- Interaction := Value;
- Break;
- end;
- end;
- end;
- //interact Next if there is Nothing to Change
- else InteractNext;
- end;
-end;
-
-procedure TMenu.InteractDec;
-var
- Num: integer;
- Value: integer;
-begin
- case Interactions[Interaction].Typ of
- iSelectS: begin
- Num := Interactions[Interaction].Num;
- Value := SelectsS[Num].SelectedOption;
- Value := Value - 1;
-// if Value = -1 then
-// Value := High(SelectsS[Num].TextOptT);
-
- if Value >= 0 then
- SelectsS[Num].SelectedOption := Value;
- end;
- //Button Collection Mod
- iBCollectionChild:
- begin
- //Select Prev Button in Collection
- For Num := High(Button) downto 1 do
- begin
- Value := (Interaction + Num) Mod Length(Button);
- if Value = High(Button) then
- begin
- InteractPrev;
- Break;
- end;
- if (Button[Value].Parent = Button[Interaction].Parent) then
- begin
- Interaction := Value;
- Break;
- end;
- end;
- end;
- //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
- begin
- //Select Last Child
- For Num := High(Button) downto 1 do
- begin
- Value := (Interaction + Num) Mod Length(Button);
- if (Button[Value].Parent = Button[Interaction].Parent) then
- begin
- Interaction := Value;
- Break;
- end;
- end;
- end;
- end;
- end;
-end;
-
-procedure TMenu.AddBox(X, Y, W, H: real);
-begin
- AddStatic(X, Y, W, H, 0, 0, 0, Skin.GetTextureFileName('MainBar'), TEXTURE_TYPE_COLORIZED);
- AddStatic(X+2, Y+2, W-4, H-4, 1, 1, 1, Skin.GetTextureFileName('MainBar'), TEXTURE_TYPE_COLORIZED);
-end;
-
-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.
- // Second, a video should be stopped if the screen is hidden, but the Video.Stop()
- // method is not implemented by now. This is necessary for theme-switching too.
- // At the moment videos cannot be turned off without restarting USDX.
-
- // check if a background texture was found
- if (BackImg.TexNum = 0) then
- begin
- // try to open an animated background
- // Note: newer versions of ffmpeg are able to open images like jpeg
- // so do not pass an image's filename to VideoPlayback.Open()
- if fileexists( fFileName ) then
- begin
- if VideoPlayback.Open( fFileName ) then
- begin
- VideoBGTimer.SetTime(0);
- VideoPlayback.Play;
- end;
- end;
- end;
-end;
-
-procedure TMenu.onShowFinish;
-begin
- // nothing
-end;
-
-(*
- * Wrapper for WideUpperCase. Needed because some plattforms have problems with
- * unicode support.
- *)
-function TMenu.WideCharUpperCase(wchar: WideChar) : WideString;
-begin
- // On Linux and MacOSX the cwstring unit is necessary for Unicode function-calls.
- // Otherwise you will get an EIntOverflow exception (thrown by unimplementedwidestring()).
- // The Unicode manager cwstring does not work with MacOSX at the moment because
- // of missing references to iconv. So we have to use Ansi... for the moment.
-
- {$IFNDEF DARWIN}
- // 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}
-end;
-
-(*
- * Wrapper for WideUpperCase. Needed because some plattforms have problems with
- * unicode support.
- *)
-function TMenu.WideStringUpperCase(wstring: WideString) : WideString;
-begin
- {$IFNDEF DARWIN}
- Result := WideUpperCase(wstring)
- {$ELSE}
- Result := AnsiUpperCase(wstring);
- {$ENDIF}
-end;
-
-procedure TMenu.onHide;
-begin
- // nothing
-end;
-
-function TMenu.ParseInput(PressedKey: Cardinal; CharCode: WideChar; PressedDown: Boolean): Boolean;
-begin
- // nothing
- Result := true;
-end;
-
-procedure TMenu.SetAnimationProgress(Progress: real);
-begin
- // nothing
-end;
-
-end.
-
diff --git a/src/menu0/UMenuButton.pas b/src/menu0/UMenuButton.pas
deleted file mode 100644
index 60b92b9f..00000000
--- a/src/menu0/UMenuButton.pas
+++ /dev/null
@@ -1,564 +0,0 @@
-unit UMenuButton;
-
-interface
-
-{$I switches.inc}
-
-uses TextGL, UTexture, gl, UMenuText,SDL;
-
-type
- CButton = class of TButton;
-
- TButton = class
- protected
- SelectBool: Boolean;
-
- FadeProgress: Real;
- FadeLastTick: Cardinal;
-
- DeSelectW,
- DeSelectH,
- PosX,
- PosY: Real;
-
- constructor Create(); overload;
-
- public
- Text: Array of TText;
- Texture: TTexture; // Button Screen position and size
- Texture2: TTexture; // second texture only used for fading full resolution covers
-
- Colorized: Boolean;
- DeSelectTexture: TTexture; // texture for colorized hack
-
- FadeTex: TTexture; //Texture for beautiful fading
- FadeTexPos: byte; //Pos of the FadeTexture (0: Top, 1: Left, 2: Bottom, 3: Right)
-
- DeselectType: integer; // not used yet
- Visible: boolean;
-
- Reflection: boolean;
- Reflectionspacing,
- DeSelectReflectionspacing: Real;
-
- Fade,
- FadeText: Boolean;
-
- Selectable: boolean;
-
- //Number of the Parent Collection, 0 if in no Collection
- Parent: Byte;
-
- SelectColR,
- SelectColG,
- SelectColB,
- SelectInt,
- SelectTInt: real;
- //Fade Mod
- SelectW: real;
- SelectH: real;
-
- DeselectColR,
- DeselectColG,
- DeselectColB,
- DeselectInt,
- DeselectTInt: real;
-
- procedure SetY(Value: real);
- procedure SetX(Value: real);
- procedure SetW(Value: real);
- procedure SetH(Value: real);
-
- 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;
-
- procedure Draw; virtual;
-
- constructor Create(Textura: TTexture); overload;
- constructor Create(Textura, DSTexture: TTexture); overload;
- destructor Destroy; override;
- end;
-
-implementation
-
-uses SysUtils,
- UDrawTexture;
-
-procedure TButton.SetX(Value: real);
-{var
- dx: real;
- T: integer; // text}
-begin
- {dY := Value - Texture.y;
-
- Texture.X := Value;
-
- for T := 0 to High(Text) do
- Text[T].X := Text[T].X + dY;}
-
- PosX := Value;
- if (FadeTex.TexNum = 0) then
- Texture.X := Value;
-
-end;
-
-procedure TButton.SetY(Value: real);
-{var
- dY: real;
- T: integer; // text}
-begin
- {dY := Value - PosY;
-
-
- for T := 0 to High(Text) do
- Text[T].Y := Text[T].Y + dY;}
-
- PosY := Value;
- if (FadeTex.TexNum = 0) then
- Texture.y := Value;
-end;
-
-procedure TButton.SetW(Value: real);
-begin
- if SelectW = DeSelectW then
- SelectW := Value;
-
- DeSelectW := Value;
-
- if Not Fade then
- begin
- if SelectBool then
- Texture.W := SelectW
- else
- Texture.W := DeSelectW;
- end;
-end;
-
-procedure TButton.SetH(Value: real);
-begin
- if SelectH = DeSelectH then
- SelectH := Value;
-
- DeSelectH := Value;
-
- if Not Fade then
- begin
- if SelectBool then
- Texture.H := SelectH
- else
- Texture.H := DeSelectH;
- end;
-end;
-
-procedure TButton.SetSelect(Value : Boolean);
-var
- T: integer;
-begin
- SelectBool := Value;
-
- if (Value) then
- begin
- Texture.ColR := SelectColR;
- Texture.ColG := SelectColG;
- Texture.ColB := SelectColB;
- Texture.Int := SelectInt;
-
- Texture2.ColR := SelectColR;
- Texture2.ColG := SelectColG;
- Texture2.ColB := SelectColB;
- Texture2.Int := SelectInt;
-
- for T := 0 to High(Text) do
- Text[T].Int := SelectTInt;
-
- //Fade Mod
- if Fade then
- begin
- if (FadeProgress <= 0) then
- FadeProgress := 0.125;
- end
- else
- begin
- Texture.W := SelectW;
- Texture.H := SelectH;
- end;
- end
- else
- begin
- Texture.ColR := DeselectColR;
- Texture.ColG := DeselectColG;
- Texture.ColB := DeselectColB;
- Texture.Int := DeselectInt;
-
- Texture2.ColR := DeselectColR;
- Texture2.ColG := DeselectColG;
- Texture2.ColB := DeselectColB;
- Texture2.Int := DeselectInt;
-
- for T := 0 to High(Text) do
- Text[T].Int := DeselectTInt;
-
- //Fade Mod
- if Fade then
- begin
- if (FadeProgress >= 1) then
- FadeProgress := 0.875;
- end
- else
- begin
- Texture.W := DeSelectW;
- Texture.H := DeSelectH;
- end;
- 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;
-begin
- if Visible then
- begin
- //Fade Mod
- T:=0;
- if Fade then
- begin
- if (FadeProgress < 1) and (FadeProgress > 0) then
- begin
- Tick := SDL_GetTicks() div 16;
- if (Tick <> FadeLastTick) then
- begin
- FadeLastTick := Tick;
-
- if SelectBool then
- FadeProgress := FadeProgress + 0.125
- else
- FadeProgress := FadeProgress - 0.125;
-
- if (FadeText) then
- begin
- For T := 0 to high(Text) do
- begin
- Text[T].MoveX := (SelectW - DeSelectW) * FadeProgress;
- Text[T].MoveY := (SelectH - DeSelectH) * FadeProgress;
- end;
- end;
-
- end;
- end;
-
- //Method without Fade Texture
- if (FadeTex.TexNum = 0) then
- begin
- Texture.W := DeSelectW + (SelectW - DeSelectW) * FadeProgress;
- Texture.H := DeSelectH + (SelectH - DeSelectH) * FadeProgress;
- DeSelectTexture.W := Texture.W;
- DeSelectTexture.H := Texture.H;
- end
- else //method with Fade Texture
- begin
- Texture.W := DeSelectW;
- Texture.H := DeSelectH;
- DeSelectTexture.W := Texture.W;
- DeSelectTexture.H := Texture.H;
-
- FadeTex.ColR := Texture.ColR;
- FadeTex.ColG := Texture.ColG;
- FadeTex.ColB := Texture.ColB;
- FadeTex.Int := Texture.Int;
-
- FadeTex.Z := Texture.Z;
-
- FadeTex.Alpha := Texture.Alpha;
- FadeTex.TexX1 := 0;
- FadeTex.TexX2 := 1;
- FadeTex.TexY1 := 0;
- FadeTex.TexY2 := 1;
-
- Case FadeTexPos of
- 0: //FadeTex on Top
- begin
- //Standard Texture
- Texture.X := PosX;
- Texture.Y := PosY + (SelectH - DeSelectH) * FadeProgress;
- DeSelectTexture.X := Texture.X;
- DeSelectTexture.Y := Texture.Y;
- //Fade Tex
- FadeTex.X := PosX;
- FadeTex.Y := PosY;
- FadeTex.W := Texture.W;
- FadeTex.H := (SelectH - DeSelectH) * FadeProgress;
- FadeTex.ScaleW := Texture.ScaleW;
- //Some Hack that Fixes a little Space between both Textures
- FadeTex.TexY2 := 0.9;
- end;
- 1: //FadeTex on Left
- begin
- //Standard Texture
- Texture.X := PosX + (SelectW - DeSelectW) * FadeProgress;
- Texture.Y := PosY;
- DeSelectTexture.X := Texture.X;
- DeSelectTexture.Y := Texture.Y;
- //Fade Tex
- FadeTex.X := PosX;
- FadeTex.Y := PosY;
- FadeTex.H := Texture.H;
- FadeTex.W := (SelectW - DeSelectW) * FadeProgress;
- FadeTex.ScaleH := Texture.ScaleH;
- //Some Hack that Fixes a little Space between both Textures
- FadeTex.TexX2 := 0.9;
- end;
- 2: //FadeTex on Bottom
- begin
- //Standard Texture
- Texture.X := PosX;
- Texture.Y := PosY;
- DeSelectTexture.X := Texture.X;
- DeSelectTexture.Y := Texture.Y;
- //Fade Tex
- FadeTex.X := PosX;
- FadeTex.Y := PosY + (SelectH - DeSelectH) * FadeProgress;;
- FadeTex.W := Texture.W;
- FadeTex.H := (SelectH - DeSelectH) * FadeProgress;
- FadeTex.ScaleW := Texture.ScaleW;
- //Some Hack that Fixes a little Space between both Textures
- FadeTex.TexY1 := 0.1;
- end;
- 3: //FadeTex on Right
- begin
- //Standard Texture
- Texture.X := PosX;
- Texture.Y := PosY;
- DeSelectTexture.X := Texture.X;
- DeSelectTexture.Y := Texture.Y;
- //Fade Tex
- FadeTex.X := PosX + (SelectW - DeSelectW) * FadeProgress;
- FadeTex.Y := PosY;
- FadeTex.H := Texture.H;
- FadeTex.W := (SelectW - DeSelectW) * FadeProgress;
- FadeTex.ScaleH := Texture.ScaleH;
- //Some Hack that Fixes a little Space between both Textures
- FadeTex.TexX1 := 0.1;
- end;
- end;
- end;
- end
- else if (FadeText) then
- begin
- Text[T].MoveX := (SelectW - DeSelectW);
- Text[T].MoveY := (SelectH - DeSelectH);
- end;
-
- if SelectBool or (FadeProgress > 0) or not Colorized then
- DrawTexture(Texture)
- else
- begin
- DeSelectTexture.X := Texture.X;
- DeSelectTexture.Y := Texture.Y;
- DeSelectTexture.H := Texture.H;
- DeSelectTexture.W := Texture.W;
- DrawTexture(DeSelectTexture);
- end;
-
- //Draw FadeTex
- if (FadeTex.TexNum > 0) then
- DrawTexture(FadeTex);
-
- if Texture2.Alpha > 0 then
- begin
- Texture2.ScaleW := Texture.ScaleW;
- Texture2.ScaleH := Texture.ScaleH;
-
- Texture2.X := Texture.X;
- Texture2.Y := Texture.Y;
- Texture2.W := Texture.W;
- Texture2.H := Texture.H;
-
- Texture2.ColR := Texture.ColR;
- Texture2.ColG := Texture.ColG;
- Texture2.ColB := Texture.ColB;
- Texture2.Int := Texture.Int;
-
- Texture2.Z := Texture.Z;
-
- DrawTexture(Texture2);
- end;
-
- //Reflection Mod
- if (Reflection) then // Draw Reflections
- begin
- if (FadeProgress <> 0) AND (FadeProgress <> 1) then
- begin
- Spacing := DeSelectReflectionspacing - (DeSelectReflectionspacing - Reflectionspacing) * FadeProgress;
- end
- else if SelectBool then
- Spacing := Reflectionspacing
- else
- Spacing := DeSelectReflectionspacing;
-
- if SelectBool or not Colorized then
- with Texture do
- begin
- //Bind Tex and GL Attributes
- glEnable(GL_TEXTURE_2D);
- glEnable(GL_BLEND);
-
- glDepthRange(0, 10);
- glDepthFunc(GL_LEQUAL);
- glEnable(GL_DEPTH_TEST);
-
- glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
- glBindTexture(GL_TEXTURE_2D, TexNum);
-
- //Draw
- glBegin(GL_QUADS);//Top Left
- glColor4f(ColR * Int, ColG * Int, ColB * Int, Alpha-0.3);
- glTexCoord2f(TexX1*TexW, TexY2*TexH);
- glVertex3f(x, y+h*scaleH+ Spacing, z);
-
- //Bottom Left
- glColor4f(ColR * Int, ColG * Int, ColB * Int, 0);
- glTexCoord2f(TexX1*TexW, TexY1+TexH*0.5);
- glVertex3f(x, y+h*scaleH + h*scaleH/2 + Spacing, z);
-
-
- //Bottom Right
- glColor4f(ColR * Int, ColG * Int, ColB * Int, 0);
- glTexCoord2f(TexX2*TexW, TexY1+TexH*0.5);
- glVertex3f(x+w*scaleW, y+h*scaleH + h*scaleH/2 + Spacing, z);
-
- //Top Right
- glColor4f(ColR * Int, ColG * Int, ColB * Int, Alpha-0.3);
- glTexCoord2f(TexX2*TexW, TexY2*TexH);
- glVertex3f(x+w*scaleW, y+h*scaleH + Spacing, z);
- glEnd;
-
- glDisable(GL_TEXTURE_2D);
- glDisable(GL_DEPTH_TEST);
- glDisable(GL_BLEND);
- end else
- with DeSelectTexture do
- begin
- //Bind Tex and GL Attributes
- glEnable(GL_TEXTURE_2D);
- glEnable(GL_BLEND);
-
- glDepthRange(0, 10);
- glDepthFunc(GL_LEQUAL);
- glEnable(GL_DEPTH_TEST);
-
- glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
- glBindTexture(GL_TEXTURE_2D, TexNum);
-
- //Draw
- glBegin(GL_QUADS);//Top Left
- glColor4f(ColR * Int, ColG * Int, ColB * Int, Alpha-0.3);
- glTexCoord2f(TexX1*TexW, TexY2*TexH);
- glVertex3f(x, y+h*scaleH+ Spacing, z);
-
- //Bottom Left
- glColor4f(ColR * Int, ColG * Int, ColB * Int, 0);
- glTexCoord2f(TexX1*TexW, TexY1+TexH*0.5);
- glVertex3f(x, y+h*scaleH + h*scaleH/2 + Spacing, z);
-
- //Bottom Right
- glColor4f(ColR * Int, ColG * Int, ColB * Int, 0);
- glTexCoord2f(TexX2*TexW, TexY1+TexH*0.5);
- glVertex3f(x+w*scaleW, y+h*scaleH + h*scaleH/2 + Spacing, z);
-
- //Top Right
- glColor4f(ColR * Int, ColG * Int, ColB * Int, Alpha-0.3);
- glTexCoord2f(TexX2*TexW, TexY2*TexH);
- glVertex3f(x+w*scaleW, y+h*scaleH + Spacing, z);
- glEnd;
-
- glDisable(GL_TEXTURE_2D);
- glDisable(GL_DEPTH_TEST);
- glDisable(GL_BLEND);
- end;
- end;
-
- for T := 0 to High(Text) do begin
- Text[T].Draw;
- end;
- end;
-end;
-
-
-destructor TButton.Destroy;
-begin
- inherited;
-end;
-
-constructor TButton.Create(Textura: TTexture);
-begin
- Create();
- Texture := Textura;
- DeSelectTexture := Textura;
- Texture.ColR := 0;
- Texture.ColG := 0.5;
- Texture.ColB := 0;
- Texture.Int := 1;
- Colorized := False;
-end;
-
-// Button has the texture-type "colorized"
-// Two textures are generated, one with Col the other one with DCol
-// Check UMenu.pas line 680 to see the call ( AddButton() )
-constructor TButton.Create(Textura, DSTexture: TTexture);
-begin
- Create();
- Texture := Textura;
- DeSelectTexture := DSTexture;
- Texture.ColR := 1;
- Texture.ColG := 1;
- Texture.ColB := 1;
- Texture.Int := 1;
- Colorized := True;
-end;
-
-end.
diff --git a/src/menu0/UMenuButtonCollection.pas b/src/menu0/UMenuButtonCollection.pas
deleted file mode 100644
index c700c812..00000000
--- a/src/menu0/UMenuButtonCollection.pas
+++ /dev/null
@@ -1,71 +0,0 @@
-unit UMenuButtonCollection;
-
-interface
-
-{$I switches.inc}
-
-uses UMenuButton;
-
-type
- //----------------
- //TButtonCollection
- //No Extra Attributes or Functions ATM
- //----------------
- AButton = Array of TButton;
- PAButton = ^AButton;
- TButtonCollection = class(TButton)
- //num of the First Button, that can be Selected
- FirstChild: Byte;
- CountChilds: Byte;
-
- ScreenButton: PAButton;
-
- procedure SetSelect(Value : Boolean); override;
- procedure Draw; override;
- end;
-
-implementation
-
-procedure TButtonCollection.SetSelect(Value : Boolean);
-var I: 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;
-end;
-
-procedure TButtonCollection.Draw;
-var I, J: Integer;
-begin
- inherited;
- //If fading is activated, Fade Child Buttons
- if (Fade) then
- begin
- 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
- 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
- ScreenButton^[I].Text[J].Alpha := (FadeProgress-0.666)*3;
- end;
- end;
- end;
-end;
-
-
-
-end.
diff --git a/src/menu0/UMenuInteract.pas b/src/menu0/UMenuInteract.pas
deleted file mode 100644
index e0b4fa11..00000000
--- a/src/menu0/UMenuInteract.pas
+++ /dev/null
@@ -1,16 +0,0 @@
-unit UMenuInteract;
-
-interface
-
-{$I switches.inc}
-
-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
- end;
-
-implementation
-
-end.
- \ No newline at end of file
diff --git a/src/menu0/UMenuSelectSlide.pas b/src/menu0/UMenuSelectSlide.pas
deleted file mode 100644
index 76299e80..00000000
--- a/src/menu0/UMenuSelectSlide.pas
+++ /dev/null
@@ -1,355 +0,0 @@
-unit UMenuSelectSlide;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses TextGL,
- UTexture,
- gl,
- UMenuText;
-
-type
- PSelectSlide = ^TSelectSlide;
- TSelectSlide = class
- private
- SelectBool: boolean;
- public
- // 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
-
- 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)
-
- SelectOptInt: integer;
- PData: ^integer;
-
- //For automatically Setting LineCount
- Lines: Byte;
-
- //Visibility
- Visible: Boolean;
-
- // for selection and deselection
- // main static
- ColR: real;
- ColG: real;
- ColB: real;
- Int: real;
- DColR: real;
- DColG: real;
- DColB: real;
- DInt: real;
-
- // main text
- TColR: real;
- TColG: real;
- TColB: real;
- TInt: real;
- TDColR: real;
- TDColG: real;
- TDColB: real;
- TDInt: real;
-
- // selection background static
- SBGColR: real;
- SBGColG: real;
- SBGColB: real;
- SBGInt: real;
- SBGDColR: real;
- SBGDColG: real;
- SBGDColB: real;
- SBGDInt: real;
-
- // selection text
- STColR: real;
- STColG: real;
- STColB: real;
- STInt: real;
- STDColR: real;
- STDColG: real;
- STDColB: real;
- STDInt: real;
-
- // position and size
- property X: real read Texture.x write Texture.x;
- property Y: real read Texture.y write Texture.y;
- property W: real read Texture.w write Texture.w;
- property H: real read Texture.h write Texture.h;
-// property X2: real read Texture2.x write Texture2.x;
-// property Y2: real read Texture2.y write Texture2.y;
-// property W2: real read Texture2.w write Texture2.w;
-// property H2: real read Texture2.h write Texture2.h;
-
- property SBGW: real read TextureSBG.w write TextureSBG.w;
-
- // procedures
- procedure SetSelect(Value: boolean);
- property Selected: Boolean read SelectBool write SetSelect;
- procedure SetSelectOpt(Value: integer);
- property SelectedOption: integer read SelectOptInt write SetSelectOpt;
- procedure Draw;
- constructor Create;
-
- //Automatically Generate Lines (Texts)
- procedure genLines;
- end;
-
-implementation
-uses UDrawTexture, math, ULog, SysUtils;
-
-// ------------ Select
-constructor TSelectSlide.Create;
-begin
- inherited Create;
- 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;}
-end;
-
-procedure TSelectSlide.SetSelect(Value: boolean);
-{var
- SO: integer;
- I: integer;}
-begin
- SelectBool := Value;
- if Value then begin
- Texture.ColR := ColR;
- Texture.ColG := ColG;
- Texture.ColB := ColB;
- Texture.Int := Int;
-
- Text.ColR := TColR;
- Text.ColG := TColG;
- Text.ColB := TColB;
- Text.Int := TInt;
-
- TextureSBG.ColR := SBGColR;
- 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
- Texture.ColR := DColR;
- Texture.ColG := DColG;
- Texture.ColB := DColB;
- Texture.Int := DInt;
-
- Text.ColR := TDColR;
- Text.ColG := TDColG;
- Text.ColB := TDColB;
- Text.Int := TDInt;
-
- TextureSBG.ColR := SBGDColR;
- 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;
- Sel: integer;
- HalfL: integer;
- HalfR: integer;
-
-procedure DoSelection(Sel: Cardinal);
- var I: Integer;
- begin
- 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
- begin
- TextOpt[Sel].ColR := STColR;
- TextOpt[Sel].ColG := STColG;
- TextOpt[Sel].ColB := STColB;
- TextOpt[Sel].Int := STInt;
- end;
- end;
-begin
- SelectOptInt := Value;
- PData^ := Value;
-// SetSelect(true); // reset all colors
-
- if (Length(TextOpt)>0) AND (Length(TextOptT)>0) then
- begin
-
- if (Value <= 0) then
- begin //First Option Selected
- Value := 0;
-
- for SO := low (TextOpt) to high(TextOpt) do
- begin
- 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
- begin
- TextOpt[SO].Text := TextOptT[high(TextOptT)-(Lines-SO-1)];
- end;
- DoSelection(Lines-1);
- end
- 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;
-
- 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
- begin
- TextOpt[SO].Text := TextOptT[high(TextOptT)-(Lines-SO-1)];
- end;
-
- DoSelection (HalfL);
- 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;
-begin
- if Visible then
- begin
- DrawTexture(Texture);
- DrawTexture(TextureSBG);
-
- Text.Draw;
-
- for SO := low(TextOpt) to high(TextOpt) do
- TextOpt[SO].Draw;
- end;
-end;
-
-procedure TSelectSlide.GenLines;
-var
-maxlength: Real;
-I: Integer;
-begin
- SetFontStyle(0{Text.Style});
- SetFontSize(Text.Size);
- maxlength := 0;
-
- for I := low(TextOptT) to high (TextOptT) do
- begin
- if (glTextWidth(PChar(TextOptT[I])) > maxlength) then
- maxlength := glTextWidth(PChar(TextOptT[I]));
- end;
-
- Lines := floor((TextureSBG.W-40) / (maxlength+7));
- if (Lines > Length(TextOptT)) then
- Lines := Length(TextOptT);
-
- if (Lines <= 0) then
- Lines := 1;
-
- //Free old Space used by Texts
- For I := low(TextOpt) to high(TextOpt) do
- TextOpt[I].Free;
-
- setLength (TextOpt, Lines);
-
- 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 / 2) - 1.5 * Text.Size{20};
-
- //Better Look with 2 Options
- if (Lines=2) AND (Length(TextOptT)= 2) then
- TextOpt[I].X := TextureSBG.X + 20 + (TextureSBG.W -40 - glTextWidth(PChar(TextOptT[1]))) * I;
- end;
-end;
-
-end.
diff --git a/src/menu0/UMenuStatic.pas b/src/menu0/UMenuStatic.pas
deleted file mode 100644
index ac8fa2dc..00000000
--- a/src/menu0/UMenuStatic.pas
+++ /dev/null
@@ -1,85 +0,0 @@
-unit UMenuStatic;
-
-interface
-
-{$I switches.inc}
-
-uses UTexture, gl;
-
-type
- TStatic = class
- public
- Texture: TTexture; // Button Screen position and size
- Visible: boolean;
-
- //Reflection Mod
- Reflection: boolean;
- Reflectionspacing: Real;
-
- procedure Draw;
- constructor Create(Textura: TTexture); overload;
- end;
-
-implementation
-uses UDrawTexture;
-
-procedure TStatic.Draw;
-begin
- if Visible then
- begin
- DrawTexture(Texture);
-
- //Reflection Mod
- if (Reflection) then // Draw Reflections
- begin
- with Texture do
- begin
- //Bind Tex and GL Attributes
- glEnable(GL_TEXTURE_2D);
- glEnable(GL_BLEND);
-
- glDepthRange(0, 10);
- glDepthFunc(GL_LEQUAL);
- glEnable(GL_DEPTH_TEST);
-
- glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
- glBindTexture(GL_TEXTURE_2D, TexNum);
-
- //Draw
- glBegin(GL_QUADS);//Top Left
- glColor4f(ColR * Int, ColG * Int, ColB * Int, Alpha-0.3);
- glTexCoord2f(TexX1*TexW, TexY2*TexH);
- glVertex3f(x, y+h*scaleH+ Reflectionspacing, z);
-
- //Bottom Left
- glColor4f(ColR * Int, ColG * Int, ColB * Int, 0);
- glTexCoord2f(TexX1*TexW, 0.5*TexH+TexY1);
- glVertex3f(x, y+h*scaleH + h*scaleH/2 + Reflectionspacing, z);
-
-
- //Bottom Right
- glColor4f(ColR * Int, ColG * Int, ColB * Int, 0);
- glTexCoord2f(TexX2*TexW, 0.5*TexH+TexY1);
- glVertex3f(x+w*scaleW, y+h*scaleH + h*scaleH/2 + Reflectionspacing, z);
-
- //Top Right
- glColor4f(ColR * Int, ColG * Int, ColB * Int, Alpha-0.3);
- glTexCoord2f(TexX2*TexW, TexY2*TexH);
- glVertex3f(x+w*scaleW, y+h*scaleH + Reflectionspacing, z);
- glEnd;
-
- glDisable(GL_TEXTURE_2D);
- glDisable(GL_DEPTH_TEST);
- glDisable(GL_BLEND);
- end;
- end;
- end;
-end;
-
-constructor TStatic.Create(Textura: TTexture);
-begin
- inherited Create;
- Texture := Textura;
-end;
-
-end.
diff --git a/src/menu0/UMenuText.pas b/src/menu0/UMenuText.pas
deleted file mode 100644
index fecf936e..00000000
--- a/src/menu0/UMenuText.pas
+++ /dev/null
@@ -1,350 +0,0 @@
-unit UMenuText;
-
-interface
-
-{$IFDEF FPC}
- {$MODE Delphi}
-{$ENDIF}
-
-{$I switches.inc}
-
-uses TextGL,
- UTexture,
- gl,
- math,
- SysUtils,
- SDL;
-
-type
- TText = class
- private
- SelectBool: boolean;
- TextString: string;
- TextTiles: array of string;
-
- 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
-// H: real;
- Size: real;
- ColR: real;
- ColG: real;
- ColB: real;
- Alpha: real;
- Int: real;
- Style: integer;
- Visible: boolean;
- Align: integer; // 0 = left, 1 = center, 2 = right
-
- //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 DeleteLastL; //Procedure to Delete Last Letter
-
- procedure Draw;
- constructor Create; overload;
- constructor Create(X, Y: real; Tekst: string); overload;
- constructor Create(ParX, ParY, ParW: real; ParStyle: integer; ParSize, ParColR, ParColG, ParColB: real; ParAlign: integer; ParTekst: string; ParReflection: boolean; ParReflectionSpacing: real; ParZ: real); overload;
- end;
-
-implementation
-
-uses UGraphic,
- StrUtils;
-
-procedure TText.SetSelect(Value: boolean);
-begin
- SelectBool := Value;
-
- //Set Cursor Visible
- SelectBlink := True;
- STicks := SDL_GetTicks() div 550;
-end;
-
-procedure TText.SetText(Value: string);
-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
-
- function GetNextPos: boolean;
- var
- T1, T2, T3: Cardinal;
- begin
- LastPos := NextPos;
-
- //Next Space (If Width is given)
- if (W > 0) then
- T1 := PosEx(' ', Value, LastPos + 1)
- else T1 := Length(Value);
-
- {//Next -
- T2 := PosEx('-', Value, LastPos + 1);}
-
- //Next Break
- T3 := PosEx('\n', Value, LastPos + 1);
-
- if T1 = 0 then
- T1 := Length(Value);
- {if T2 = 0 then
- T2 := Length(Value); }
- if T3 = 0 then
- T3 := Length(Value);
-
- //Get Nearest Pos
- NextPos := min(T1, T3{min(T2, T3)});
-
- if (LastPos = Length(Value)) then
- NextPos := 0;
-
- isBreak := (NextPos = T3) AND (NextPos <> Length(Value));
- Result := (NextPos <> 0);
- end;
-
- procedure AddBreak(const From, bTo: Cardinal);
- begin
- if (isBreak) OR (bTo - From >= 1) then
- begin
- Inc(Len);
- SetLength (TextTiles, Len);
- TextTiles[Len-1] := Trim(Copy(Value, From, bTo - From));
-
- if isBreak then
- LastBreak := bTo + 2
- else
- LastBreak := bTo + 1;
- FirstWord := 0;
- end;
- end;
-
-begin
- //Set TExtstring
- TextString := Value;
-
- //Set Cursor Visible
- SelectBlink := True;
- STicks := SDL_GetTicks() div 550;
-
- //Exit if there is no Need to Create Tiles
- if (W <= 0) and (Pos('\n', Value) = 0) then
- begin
- SetLength (TextTiles, 1);
- TextTiles[0] := Value;
- Exit;
- end;
-
- //Create Tiles
- //Reset Text Array
- SetLength (TextTiles, 0);
- Len := 0;
-
- //Reset Counter Vars
- LastPos := 1;
- NextPos := 1;
- LastBreak := 1;
- FirstWord := 1;
-
- if (W > 0) then
- begin
- //Set Font Properties
- SetFontStyle(Style);
- SetFontSize(Size);
- end;
-
- //go Through Text
- while (GetNextPos) do
- begin
- //Break in Text
- if isBreak then
- begin
- //Look for Break before the Break
- if (glTextWidth(PChar(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
- if (FirstWord > 1) then
- begin
- //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
- begin
- //ToDo
- //AddBreak(LastBreak, LastBreak + 155);
- end;
- end;
-
- isBreak := True;
- //Add Break from Text
- AddBreak(LastBreak, NextPos);
- end
- //Text comes out of the Text Area -> CreateBreak
- else if (glTextWidth(PChar(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
- if (FirstWord > 1) then
- begin
- //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
- begin
- //ToDo
- //AddBreak(LastBreak, LastBreak + 155);
- end;
- end;
- //end;
- Inc(FirstWord)
- end;
- //Add Ending
- AddBreak(LastBreak, Length(Value)+1);
-end;
-
-procedure TText.DeleteLastL;
-var
- S: string;
- L: integer;
-begin
- S := TextString;
- L := Length(S);
- if (L > 0) then
- SetLength(S, L-1);
-
- SetText(S);
-end;
-
-procedure TText.Draw;
-var
- X2, Y2: real;
- Text2: string;
- I: integer;
-begin
- if Visible then
- begin
- SetFontStyle(Style);
- SetFontSize(Size);
- SetFontItalic(False);
-
- glColor4f(ColR*Int, ColG*Int, ColB*Int, Alpha);
-
- //Reflection
- if Reflection = true then
- SetFontReflection(true, ReflectionSpacing)
- else
- SetFontReflection(false,0);
-
- //if selected set blink...
- if SelectBool then
- begin
- I := SDL_GetTicks() div 550;
- if I <> STicks then
- begin //Change Visability
- STicks := I;
- SelectBlink := Not SelectBlink;
- end;
- end;
-
- {if (False) then //no width set draw as one long string
- begin
- if not (SelectBool AND SelectBlink) then
- Text2 := Text
- else
- Text2 := Text + '|';
-
- case Align of
- 0: X2 := X;
- 1: X2 := X - glTextWidth(pchar(Text2))/2;
- 2: X2 := X - glTextWidth(pchar(Text2));
- end;
-
- SetFontPos(X2, Y);
- glPrint(PChar(Text2));
- SetFontStyle(0); // reset to default
- end
- else
- begin}
- //now use allways:
- //draw text as many strings
- Y2 := Y + MoveY;
- for I := 0 to high(TextTiles) do
- begin
- 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(pchar(Text2))/2;
- 2: X2 := X + MoveX - glTextWidth(pchar(Text2));
- end;
-
- SetFontPos(X2, Y2);
-
- SetFontZ(Z);
-
- glPrint(PChar(Text2));
-
- {if Size >= 10 then
- Y2 := Y2 + Size * 2.8
- else}
- if (Style = 1) then
- Y2 := Y2 + Size * 2.8
- else
- Y2 := Y2 + Size * 2.15;
- end;
- SetFontStyle(0); // reset to default
-
- //end;
- end;
-end;
-
-constructor TText.Create;
-begin
- Create(0, 0, '');
-end;
-
-constructor TText.Create(X, Y: real; Tekst: string);
-begin
- Create(X, Y, 0, 0, 10, 0, 0, 0, 0, Tekst, false, 0, 0);
-end;
-
-constructor TText.Create(ParX, ParY, ParW: real; ParStyle: integer; ParSize, ParColR, ParColG, ParColB: real; ParAlign: integer; ParTekst: string; ParReflection: boolean; ParReflectionSpacing: real; ParZ:real);
-begin
- inherited Create;
- Alpha := 1;
- X := ParX;
- Y := ParY;
- W := ParW;
- Z := ParZ;
- Style := ParStyle;
- Size := ParSize;
- Text := ParTekst;
- ColR := ParColR;
- ColG := ParColG;
- ColB := ParColB;
- Int := 1;
- Align := ParAlign;
- SelectBool := false;
- Visible := true;
- Reflection:= ParReflection;
- ReflectionSpacing:= ParReflectionSpacing;
-end;
-
-end.
generated by cgit v1.2.3 (git 2.25.1) at 2024-11-06 13:56:23 +0000