X-Git-Url: http://deadsoftware.ru/gitweb?a=blobdiff_plain;f=src%2Fgame%2Fg_gui.pas;h=e18b60dd89e837125fbd2bbbaf48d32babf001cd;hb=refs%2Fheads%2Frenders;hp=08ecee3316b007a783f681974e47f58785f7fbe3;hpb=385ab1e1ecb587ed8dfd1425381cd6f1c185e804;p=d2df-sdl.git diff --git a/src/game/g_gui.pas b/src/game/g_gui.pas index 08ecee3..e18b60d 100644 --- a/src/game/g_gui.pas +++ b/src/game/g_gui.pas @@ -1,64 +1,64 @@ +(* Copyright (C) Doom 2D: Forever Developers + * + * 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, version 3 of the License ONLY. + * + * 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. If not, see . + *) +{$INCLUDE ../shared/a_modes.inc} unit g_gui; interface -uses - e_graphics, e_input, g_playermodel, g_basic, MAPSTRUCT, WADEDITOR; + uses + {$IFDEF USE_MEMPOOL} + mempool, + {$ENDIF} + g_base, g_playermodel, MAPDEF, utils + ; const - MAINMENU_HEADER_COLOR: TRGB = (R:255; G:255; B:255); + MAINMENU_ITEMS_COLOR: TRGB = (R:255; G:255; B:255); MAINMENU_UNACTIVEITEMS_COLOR: TRGB = (R:192; G:192; B:192); - MAINMENU_CLICKSOUND = 'MENU_SELECT'; - MAINMENU_CHANGESOUND = 'MENU_CHANGE'; + MAINMENU_HEADER_COLOR: TRGB = (R:255; G:255; B:255); MAINMENU_SPACE = 4; - MAINMENU_MARKER1 = 'MAINMENU_MARKER1'; - MAINMENU_MARKER2 = 'MAINMENU_MARKER2'; MAINMENU_MARKERDELAY = 24; - WINDOW_CLOSESOUND = 'MENU_CLOSE'; - MENU_HEADERCOLOR: TRGB = (R:255; G:255; B:255); + MENU_ITEMSTEXT_COLOR: TRGB = (R:255; G:255; B:255); MENU_UNACTIVEITEMS_COLOR: TRGB = (R:128; G:128; B:128); MENU_ITEMSCTRL_COLOR: TRGB = (R:255; G:0; B:0); MENU_VSPACE = 2; MENU_HSPACE = 32; + MENU_MARKERDELAY = 24; + + MAPPREVIEW_WIDTH = 8; + MAPPREVIEW_HEIGHT = 8; + + KEYREAD_QUERY = '<...>'; + KEYREAD_CLEAR = '???'; + + WINDOW_CLOSESOUND = 'MENU_CLOSE'; + MAINMENU_CLICKSOUND = 'MENU_SELECT'; + MAINMENU_CHANGESOUND = 'MENU_CHANGE'; MENU_CLICKSOUND = 'MENU_SELECT'; MENU_CHANGESOUND = 'MENU_CHANGE'; - MENU_MARKERDELAY = 24; - SCROLL_LEFT = 'SCROLL_LEFT'; - SCROLL_RIGHT = 'SCROLL_RIGHT'; - SCROLL_MIDDLE = 'SCROLL_MIDDLE'; - SCROLL_MARKER = 'SCROLL_MARKER'; SCROLL_ADDSOUND = 'SCROLL_ADD'; SCROLL_SUBSOUND = 'SCROLL_SUB'; - EDIT_LEFT = 'EDIT_LEFT'; - EDIT_RIGHT = 'EDIT_RIGHT'; - EDIT_MIDDLE = 'EDIT_MIDDLE'; - EDIT_CURSORCOLOR: TRGB = (R:200; G:0; B:0); - EDIT_CURSORLEN = 10; - KEYREAD_QUERY = '<...>'; - KEYREAD_CLEAR = '???'; - KEYREAD_TIMEOUT = 24; - MAPPREVIEW_WIDTH = 8; - MAPPREVIEW_HEIGHT = 8; - BOX1 = 'BOX1'; - BOX2 = 'BOX2'; - BOX3 = 'BOX3'; - BOX4 = 'BOX4'; - BOX5 = 'BOX5'; - BOX6 = 'BOX6'; - BOX7 = 'BOX7'; - BOX8 = 'BOX8'; - BOX9 = 'BOX9'; - BSCROLL_UPA = 'BSCROLL_UP_A'; - BSCROLL_UPU = 'BSCROLL_UP_U'; - BSCROLL_DOWNA = 'BSCROLL_DOWN_A'; - BSCROLL_DOWNU = 'BSCROLL_DOWN_U'; - BSCROLL_MIDDLE = 'BSCROLL_MIDDLE'; + WM_KEYDOWN = 101; WM_CHAR = 102; WM_USER = 110; + MESSAGE_DIKEY = WM_USER + 1; + type TMessage = record Msg: DWORD; @@ -66,21 +66,6 @@ type lParam: LongInt; end; - TFontType = (FONT_TEXTURE, FONT_CHAR); - - TFont = class(TObject) - private - ID: DWORD; - FScale: Single; - FFontType: TFontType; - public - constructor Create(FontID: DWORD; FontType: TFontType); - destructor Destroy; override; - procedure Draw(X, Y: Integer; Text: string; R, G, B: Byte); - procedure GetTextSize(Text: string; var w, h: Word); - property Scale: Single read FScale write FScale; - end; - TGUIControl = class; TGUIWindow = class; @@ -92,24 +77,34 @@ type TOnChangeEvent = procedure(Sender: TGUIControl); TOnEnterEvent = procedure(Sender: TGUIControl); - TGUIControl = class + TGUIControl = class{$IFDEF USE_MEMPOOL}(TPoolObject){$ENDIF} private FX, FY: Integer; FEnabled: Boolean; FWindow : TGUIWindow; FName: string; + FUserData: Pointer; + FRightAlign: Boolean; //HACK! this works only for "normal" menus, only for menu text labels, and generally sux. sorry. + FMaxWidth: Integer; //HACK! used for right-aligning labels public constructor Create; procedure OnMessage(var Msg: TMessage); virtual; procedure Update; virtual; - procedure Draw; virtual; + function GetWidth(): Integer; virtual; + function GetHeight(): Integer; virtual; + function WantActivationKey (key: LongInt): Boolean; virtual; property X: Integer read FX write FX; property Y: Integer read FY write FY; property Enabled: Boolean read FEnabled write FEnabled; property Name: string read FName write FName; + property UserData: Pointer read FUserData write FUserData; + property RightAlign: Boolean read FRightAlign write FRightAlign; // for menu + property CMaxWidth: Integer read FMaxWidth; + + property Window: TGUIWindow read FWindow; end; - TGUIWindow = class + TGUIWindow = class{$IFDEF USE_MEMPOOL}(TPoolObject){$ENDIF} private FActiveControl: TGUIControl; FDefControl: string; @@ -129,7 +124,6 @@ type function AddChild(Child: TGUIControl): TGUIControl; procedure OnMessage(var Msg: TMessage); procedure Update; - procedure Draw; procedure SetActive(Control: TGUIControl); function GetControl(Name: string): TGUIControl; property OnKeyDown: TOnKeyDownEvent read FOnKeyDown write FOnKeyDown; @@ -141,28 +135,28 @@ type property BackTexture: string read FBackTexture write FBackTexture; property MainWindow: Boolean read FMainWindow write FMainWindow; property UserData: Pointer read FUserData write FUserData; + + property ActiveControl: TGUIControl read FActiveControl; end; TGUITextButton = class(TGUIControl) private FText: string; FColor: TRGB; - FFont: TFont; + FBigFont: Boolean; FSound: string; FShowWindow: string; public Proc: procedure; - constructor Create(Proc: Pointer; FontID: DWORD; Text: string); + ProcEx: procedure (sender: TGUITextButton); + constructor Create(aProc: Pointer; BigFont: Boolean; Text: string); destructor Destroy(); override; procedure OnMessage(var Msg: TMessage); override; procedure Update(); override; - procedure Draw(); override; - function GetWidth(): Integer; - function GetHeight(): Integer; procedure Click(Silent: Boolean = False); property Caption: string read FText write FText; property Color: TRGB read FColor write FColor; - property Font: TFont read FFont write FFont; + property BigFont: Boolean read FBigFont write FBigFont; property ShowWindow: string read FShowWindow write FShowWindow; end; @@ -170,85 +164,73 @@ type private FText: string; FColor: TRGB; - FFont: TFont; + FBigFont: Boolean; FFixedLen: Word; FOnClickEvent: TOnClickEvent; public - constructor Create(Text: string; FontID: DWORD); + constructor Create(Text: string; BigFont: Boolean); procedure OnMessage(var Msg: TMessage); override; - procedure Draw; override; - function GetWidth: Integer; - function GetHeight: Integer; property OnClick: TOnClickEvent read FOnClickEvent write FOnClickEvent; property FixedLength: Word read FFixedLen write FFixedLen; property Text: string read FText write FText; property Color: TRGB read FColor write FColor; - property Font: TFont read FFont write FFont; + property BigFont: Boolean read FBigFont write FBigFont; end; TGUIScroll = class(TGUIControl) private FValue: Integer; FMax: Word; - FLeftID: DWORD; - FRightID: DWORD; - FMiddleID: DWORD; - FMarkerID: DWORD; FOnChangeEvent: TOnChangeEvent; procedure FSetValue(a: Integer); public constructor Create(); procedure OnMessage(var Msg: TMessage); override; procedure Update; override; - procedure Draw; override; - function GetWidth(): Word; property OnChange: TOnChangeEvent read FOnChangeEvent write FOnChangeEvent; property Max: Word read FMax write FMax; property Value: Integer read FValue write FSetValue; - end; + end; + + TGUIItemsList = array of string; TGUISwitch = class(TGUIControl) private - FFont: TFont; - FItems: array of string; + FBigFont: Boolean; + FItems: TGUIItemsList; FIndex: Integer; FColor: TRGB; FOnChangeEvent: TOnChangeEvent; public - constructor Create(FontID: DWORD); + constructor Create(BigFont: Boolean); procedure OnMessage(var Msg: TMessage); override; procedure AddItem(Item: string); procedure Update; override; - procedure Draw; override; - function GetWidth(): Word; function GetText: string; property ItemIndex: Integer read FIndex write FIndex; property Color: TRGB read FColor write FColor; - property Font: TFont read FFont write FFont; + property BigFont: Boolean read FBigFont write FBigFont; property OnChange: TOnChangeEvent read FOnChangeEvent write FOnChangeEvent; + property Items: TGUIItemsList read FItems; end; TGUIEdit = class(TGUIControl) private - FFont: TFont; + FBigFont: Boolean; FCaretPos: Integer; FMaxLength: Word; FWidth: Word; FText: string; FColor: TRGB; FOnlyDigits: Boolean; - FLeftID: DWORD; - FRightID: DWORD; - FMiddleID: DWORD; FOnChangeEvent: TOnChangeEvent; FOnEnterEvent: TOnEnterEvent; + FInvalid: Boolean; procedure SetText(Text: string); public - constructor Create(FontID: DWORD); + constructor Create(BigFont: Boolean); procedure OnMessage(var Msg: TMessage); override; procedure Update; override; - procedure Draw; override; - function GetWidth(): Word; property OnChange: TOnChangeEvent read FOnChangeEvent write FOnChangeEvent; property OnEnter: TOnEnterEvent read FOnEnterEvent write FOnEnterEvent; property Width: Word read FWidth write FWidth; @@ -256,23 +238,50 @@ type property OnlyDigits: Boolean read FOnlyDigits write FOnlyDigits; property Text: string read FText write SetText; property Color: TRGB read FColor write FColor; - property Font: TFont read FFont write FFont; + property BigFont: Boolean read FBigFont write FBigFont; + property Invalid: Boolean read FInvalid write FInvalid; + + property CaretPos: Integer read FCaretPos; end; TGUIKeyRead = class(TGUIControl) private - FFont: TFont; + FBigFont: Boolean; FColor: TRGB; FKey: Word; FIsQuery: Boolean; public - constructor Create(FontID: DWORD); + constructor Create(BigFont: Boolean); procedure OnMessage(var Msg: TMessage); override; - procedure Draw; override; - function GetWidth(): Word; + function WantActivationKey (key: LongInt): Boolean; override; property Key: Word read FKey write FKey; property Color: TRGB read FColor write FColor; - property Font: TFont read FFont write FFont; + property BigFont: Boolean read FBigFont write FBigFont; + + property IsQuery: Boolean read FIsQuery; + end; + + // can hold two keys + TGUIKeyRead2 = class(TGUIControl) + private + FBigFont: Boolean; + FColor: TRGB; + FKey0, FKey1: Word; // this should be an array. sorry. + FKeyIdx: Integer; + FIsQuery: Boolean; + FMaxKeyNameWdt: Integer; + public + constructor Create(BigFont: Boolean); + procedure OnMessage(var Msg: TMessage); override; + function WantActivationKey (key: LongInt): Boolean; override; + property Key0: Word read FKey0 write FKey0; + property Key1: Word read FKey1 write FKey1; + property Color: TRGB read FColor write FColor; + property BigFont: Boolean read FBigFont write FBigFont; + + property IsQuery: Boolean read FIsQuery; + property MaxKeyNameWdt: Integer read FMaxKeyNameWdt; + property KeyIdx: Integer read FKeyIdx; end; TGUIModelView = class(TGUIControl) @@ -288,7 +297,6 @@ type procedure NextAnim(); procedure NextWeapon(); procedure Update; override; - procedure Draw; override; property Model: TPlayerModel read FModel; end; @@ -297,10 +305,12 @@ type PanelType: Word; end; + TPreviewPanelArray = array of TPreviewPanel; + TGUIMapPreview = class(TGUIControl) private - FMapData: array of TPreviewPanel; - FMapSize: TPoint; + FMapData: TPreviewPanelArray; + FMapSize: TDFPoint; FScale: Single; public constructor Create(); @@ -309,8 +319,11 @@ type procedure SetMap(Res: string); procedure ClearMap(); procedure Update(); override; - procedure Draw(); override; function GetScaleStr: String; + + property MapData: TPreviewPanelArray read FMapData; + property MapSize: TDFPoint read FMapSize; + property Scale: Single read FScale; end; TGUIImage = class(TGUIControl) @@ -324,16 +337,17 @@ type procedure SetImage(Res: string); procedure ClearImage(); procedure Update(); override; - procedure Draw(); override; + property DefaultRes: string read FDefaultRes write FDefaultRes; + property ImageRes: string read FImageRes; end; TGUIListBox = class(TGUIControl) private - FItems: SArray; + FItems: SSArray; FActiveColor: TRGB; FUnActiveColor: TRGB; - FFont: TFont; + FBigFont: Boolean; FStartLine: Integer; FIndex: Integer; FWidth: Word; @@ -343,55 +357,56 @@ type FDrawScroll: Boolean; FOnChangeEvent: TOnChangeEvent; - procedure FSetItems(Items: SArray); + procedure FSetItems(Items: SSArray); procedure FSetIndex(aIndex: Integer); public - constructor Create(FontID: DWORD; Width, Height: Word); + constructor Create(BigFont: Boolean; Width, Height: Word); procedure OnMessage(var Msg: TMessage); override; - procedure Draw(); override; procedure AddItem(Item: String); + function ItemExists (item: String): Boolean; procedure SelectItem(Item: String); procedure Clear(); - function GetWidth(): Word; - function GetHeight(): Word; function SelectedItem(): String; property OnChange: TOnChangeEvent read FOnChangeEvent write FOnChangeEvent; property Sort: Boolean read FSort write FSort; property ItemIndex: Integer read FIndex write FSetIndex; - property Items: SArray read FItems write FSetItems; + property Items: SSArray read FItems write FSetItems; property DrawBack: Boolean read FDrawBack write FDrawBack; property DrawScrollBar: Boolean read FDrawScroll write FDrawScroll; property ActiveColor: TRGB read FActiveColor write FActiveColor; property UnActiveColor: TRGB read FUnActiveColor write FUnActiveColor; - property Font: TFont read FFont write FFont; + property BigFont: Boolean read FBigFont write FBigFont; + + property Width: Word read FWidth; + property Height: Word read FHeight; + property StartLine: Integer read FStartLine; end; - TGUIFileListBox = class (TGUIListBox) + TGUIFileListBox = class(TGUIListBox) private - FBasePath: String; - FPath: String; + FSubPath: String; FFileMask: String; FDirs: Boolean; + FBaseList: SSArray; // highter index have highter priority - procedure OpenDir(path: String); + procedure ScanDirs; public - procedure OnMessage(var Msg: TMessage); override; - procedure SetBase(path: String); + procedure OnMessage (var Msg: TMessage); override; + procedure SetBase (dirs: SSArray; path: String = ''); function SelectedItem(): String; - procedure UpdateFileList(); + procedure UpdateFileList; property Dirs: Boolean read FDirs write FDirs; property FileMask: String read FFileMask write FFileMask; - property Path: String read FPath; end; TGUIMemo = class(TGUIControl) private - FLines: SArray; - FFont: TFont; + FLines: SSArray; + FBigFont: Boolean; FStartLine: Integer; FWidth: Word; FHeight: Word; @@ -399,38 +414,44 @@ type FDrawBack: Boolean; FDrawScroll: Boolean; public - constructor Create(FontID: DWORD; Width, Height: Word); + constructor Create(BigFont: Boolean; Width, Height: Word); procedure OnMessage(var Msg: TMessage); override; - procedure Draw; override; procedure Clear; - function GetWidth(): Word; - function GetHeight(): Word; procedure SetText(Text: string); property DrawBack: Boolean read FDrawBack write FDrawBack; property DrawScrollBar: Boolean read FDrawScroll write FDrawScroll; property Color: TRGB read FColor write FColor; - property Font: TFont read FFont write FFont; + property BigFont: Boolean read FBigFont write FBigFont; + + property Width: Word read FWidth; + property Height: Word read FHeight; + property StartLine: Integer read FStartLine; + property Lines: SSArray read FLines; end; + TGUITextButtonList = array of TGUITextButton; + TGUIMainMenu = class(TGUIControl) private - FButtons: array of TGUITextButton; + FButtons: TGUITextButtonList; FHeader: TGUILabel; FIndex: Integer; - FFontID: DWORD; - FCounter: Byte; - FMarkerID1: DWORD; - FMarkerID2: DWORD; + FBigFont: Boolean; + FCounter: Byte; // !!! update it within render public - constructor Create(FontID: DWORD; Header: string); + constructor Create(BigFont: Boolean; Header: string); destructor Destroy; override; procedure OnMessage(var Msg: TMessage); override; function AddButton(fProc: Pointer; Caption: string; ShowWindow: string = ''): TGUITextButton; - function GetButton(Name: string): TGUITextButton; - procedure EnableButton(Name: string; e: Boolean); + function GetButton(aName: string): TGUITextButton; + procedure EnableButton(aName: string; e: Boolean); procedure AddSpace(); procedure Update; override; - procedure Draw; override; + + property Header: TGUILabel read FHeader; + property Buttons: TGUITextButtonList read FButtons; + property Index: Integer read FIndex; + property Counter: Byte read FCounter; end; TControlType = class of TGUIControl; @@ -441,19 +462,21 @@ type ControlType: TControlType; Control: TGUIControl; end; + TMenuItemList = array of TMenuItem; TGUIMenu = class(TGUIControl) private - FItems: array of TMenuItem; + FItems: TMenuItemList; FHeader: TGUILabel; FIndex: Integer; - FFontID: DWORD; + FBigFont: Boolean; FCounter: Byte; FAlign: Boolean; FLeft: Integer; + FYesNo: Boolean; function NewItem(): Integer; public - constructor Create(HeaderFont, ItemsFont: DWORD; Header: string); + constructor Create(HeaderBigFont, ItemsBigFont: Boolean; Header: string); destructor Destroy; override; procedure OnMessage(var Msg: TMessage); override; procedure AddSpace(); @@ -465,24 +488,31 @@ type function AddSwitch(fText: string): TGUISwitch; function AddEdit(fText: string): TGUIEdit; function AddKeyRead(fText: string): TGUIKeyRead; + function AddKeyRead2(fText: string): TGUIKeyRead2; function AddList(fText: string; Width, Height: Word): TGUIListBox; function AddFileList(fText: string; Width, Height: Word): TGUIFileListBox; function AddMemo(fText: string; Width, Height: Word): TGUIMemo; procedure ReAlign(); - function GetControl(Name: string): TGUIControl; - function GetControlsText(Name: string): TGUILabel; - procedure Draw; override; + function GetControl(aName: string): TGUIControl; + function GetControlsText(aName: string): TGUILabel; procedure Update; override; procedure UpdateIndex(); property Align: Boolean read FAlign write FAlign; property Left: Integer read FLeft write FLeft; + property YesNo: Boolean read FYesNo write FYesNo; + + property Header: TGUILabel read FHeader; + property Counter: Byte read FCounter; + property Index: Integer read FIndex; + property Items: TMenuItemList read FItems; + property BigFont: Boolean read FBigFont; end; var g_GUIWindows: array of TGUIWindow; g_ActiveWindow: TGUIWindow = nil; + g_GUIGrabInput: Boolean = False; -procedure g_GUI_Init(); function g_GUI_AddWindow(Window: TGUIWindow): TGUIWindow; function g_GUI_GetWindow(Name: string): TGUIWindow; procedure g_GUI_ShowWindow(Name: string); @@ -491,28 +521,83 @@ function g_GUI_Destroy(): Boolean; procedure g_GUI_SaveMenuPos(); procedure g_GUI_LoadMenuPos(); + implementation uses - GL, GLExt, g_textures, g_sound, SysUtils, - g_game, Math, StrUtils, g_player, g_options, MAPREADER, - g_map, MAPDEF, g_weapons; + {$IFDEF ENABLE_TOUCH} + g_system, + {$ENDIF} + {$IFDEF ENABLE_RENDER} + r_render, + {$ENDIF} + e_input, e_log, + g_sound, SysUtils, e_res, + g_game, Math, StrUtils, g_player, g_options, + g_map, g_weapons, xdynrec, wadreader; + var - Box: Array [0..8] of DWORD; - Saved_Windows: SArray; + Saved_Windows: SSArray; + +function GetLines (Text: string; BigFont: Boolean; MaxWidth: Word): SSArray; + var i, j, len, lines: Integer; -procedure g_GUI_Init(); + function GetLine (j, i: Integer): String; + begin + result := Copy(text, j, i - j + 1); + end; + + function GetWidth (j, i: Integer): Integer; + {$IFDEF ENABLE_RENDER} + var w, h: Integer; + {$ENDIF} + begin + {$IFDEF ENABLE_RENDER} + r_Render_GetStringSize(BigFont, GetLine(j, i), w, h); + Result := w; + {$ELSE} + Result := 0; + {$ENDIF} + end; + +begin + result := nil; lines := 0; + j := 1; i := 1; len := Length(Text); + // e_LogWritefln('GetLines @%s len=%s [%s]', [MaxWidth, len, Text]); + while j <= len do + begin + (* --- Get longest possible sequence --- *) + while (i + 1 <= len) and (GetWidth(j, i + 1) <= MaxWidth) do Inc(i); + (* --- Do not include part of word --- *) + if (i < len) and (text[i] <> ' ') then + while (i >= j) and (text[i] <> ' ') do Dec(i); + (* --- Do not include spaces --- *) + while (i >= j) and (text[i] = ' ') do Dec(i); + (* --- Add line --- *) + SetLength(result, lines + 1); + result[lines] := GetLine(j, i); + // e_LogWritefln(' -> (%s:%s::%s) [%s]', [j, i, GetWidth(j, i), result[lines]]); + Inc(lines); + (* --- Skip spaces --- *) + while (i <= len) and (text[i] = ' ') do Inc(i); + j := i + 2; + end; +end; + +procedure Sort (var a: SSArray); + var i, j: Integer; s: string; begin - g_Texture_Get(BOX1, Box[0]); - g_Texture_Get(BOX2, Box[1]); - g_Texture_Get(BOX3, Box[2]); - g_Texture_Get(BOX4, Box[3]); - g_Texture_Get(BOX5, Box[4]); - g_Texture_Get(BOX6, Box[5]); - g_Texture_Get(BOX7, Box[6]); - g_Texture_Get(BOX8, Box[7]); - g_Texture_Get(BOX9, Box[8]); + if a = nil then Exit; + + for i := High(a) downto Low(a) do + for j := Low(a) to High(a) - 1 do + if LowerCase(a[j]) > LowerCase(a[j + 1]) then + begin + s := a[j]; + a[j] := a[j + 1]; + a[j + 1] := s; + end; end; function g_GUI_Destroy(): Boolean; @@ -674,41 +759,6 @@ begin end; end; -procedure DrawBox(X, Y: Integer; Width, Height: Word); -begin - e_Draw(Box[0], X, Y, 0, False, False); - e_DrawFill(Box[1], X+4, Y, Width*4, 1, 0, False, False); - e_Draw(Box[2], X+4+Width*16, Y, 0, False, False); - e_DrawFill(Box[3], X, Y+4, 1, Height*4, 0, False, False); - e_DrawFill(Box[4], X+4, Y+4, Width, Height, 0, False, False); - e_DrawFill(Box[5], X+4+Width*16, Y+4, 1, Height*4, 0, False, False); - e_Draw(Box[6], X, Y+4+Height*16, 0, False, False); - e_DrawFill(Box[7], X+4, Y+4+Height*16, Width*4, 1, 0, False, False); - e_Draw(Box[8], X+4+Width*16, Y+4+Height*16, 0, False, False); -end; - -procedure DrawScroll(X, Y: Integer; Height: Word; Up, Down: Boolean); -var - ID: DWORD; -begin - if Height < 3 then Exit; - - if Up then - g_Texture_Get(BSCROLL_UPA, ID) - else - g_Texture_Get(BSCROLL_UPU, ID); - e_Draw(ID, X, Y, 0, False, False); - - if Down then - g_Texture_Get(BSCROLL_DOWNA, ID) - else - g_Texture_Get(BSCROLL_DOWNU, ID); - e_Draw(ID, X, Y+(Height-1)*16, 0, False, False); - - g_Texture_Get(BSCROLL_MIDDLE, ID); - e_DrawFill(ID, X, Y+16, 1, Height-2, 0, False, False); -end; - { TGUIWindow } constructor TGUIWindow.Create(Name: string); @@ -751,21 +801,6 @@ begin if Childs[i] <> nil then Childs[i].Update; end; -procedure TGUIWindow.Draw; -var - i: Integer; - ID: DWORD; -begin - if FBackTexture <> '' then - if g_Texture_Get(FBackTexture, ID) then - e_DrawSize(ID, 0, 0, 0, False, False, gScreenWidth, gScreenHeight) - else - e_Clear(GL_COLOR_BUFFER_BIT, 0.5, 0.5, 0.5); - - for i := 0 to High(Childs) do - if Childs[i] <> nil then Childs[i].Draw; -end; - procedure TGUIWindow.OnMessage(var Msg: TMessage); begin if FActiveControl <> nil then FActiveControl.OnMessage(Msg); @@ -773,11 +808,15 @@ begin if @FOnKeyDownEx <> nil then FOnKeyDownEx(self, Msg.wParam); if Msg.Msg = WM_KEYDOWN then - if Msg.wParam = IK_ESCAPE then - begin - g_GUI_HideWindow; - Exit; - end; + begin + case Msg.wParam of + VK_ESCAPE: + begin + g_GUI_HideWindow; + Exit + end + end + end end; procedure TGUIWindow.SetActive(Control: TGUIControl); @@ -811,6 +850,8 @@ begin FY := 0; FEnabled := True; + FRightAlign := false; + FMaxWidth := -1; end; procedure TGUIControl.OnMessage(var Msg: TMessage); @@ -821,35 +862,57 @@ end; procedure TGUIControl.Update(); begin - end; -procedure TGUIControl.Draw(); +function TGUIControl.WantActivationKey (key: LongInt): Boolean; begin - + result := false; end; + function TGUIControl.GetWidth (): Integer; + {$IFDEF ENABLE_RENDER} + var h: Integer; + {$ENDIF} + begin + {$IFDEF ENABLE_RENDER} + r_Render_GetControlSize(Self, Result, h); + {$ELSE} + Result := 0; + {$ENDIF} + end; + + function TGUIControl.GetHeight (): Integer; + {$IFDEF ENABLE_RENDER} + var w: Integer; + {$ENDIF} + begin + {$IFDEF ENABLE_RENDER} + r_Render_GetControlSize(Self, w, Result); + {$ELSE} + Result := 0; + {$ENDIF} + end; + { TGUITextButton } procedure TGUITextButton.Click(Silent: Boolean = False); begin - if (FSound <> '') and (not Silent) then - g_Sound_PlayEx(FSound); + if (FSound <> '') and (not Silent) then g_Sound_PlayEx(FSound); + + if @Proc <> nil then Proc(); + if @ProcEx <> nil then ProcEx(self); - if @Proc <> nil then - Proc(); - if FShowWindow <> '' then - g_GUI_ShowWindow(FShowWindow); + if FShowWindow <> '' then g_GUI_ShowWindow(FShowWindow); end; -constructor TGUITextButton.Create(Proc: Pointer; FontID: DWORD; Text: string); +constructor TGUITextButton.Create(aProc: Pointer; BigFont: Boolean; Text: string); begin inherited Create(); - Self.Proc := Proc; - - FFont := TFont.Create(FontID, FONT_CHAR); + Self.Proc := aProc; + ProcEx := nil; + FBigFont := BigFont; FText := Text; end; @@ -859,27 +922,6 @@ begin inherited; end; -procedure TGUITextButton.Draw; -begin - FFont.Draw(FX, FY, FText, FColor.R, FColor.G, FColor.B) -end; - -function TGUITextButton.GetHeight: Integer; -var - w, h: Word; -begin - FFont.GetTextSize(FText, w, h); - Result := h; -end; - -function TGUITextButton.GetWidth: Integer; -var - w, h: Word; -begin - FFont.GetTextSize(FText, w, h); - Result := w; -end; - procedure TGUITextButton.OnMessage(var Msg: TMessage); begin if not FEnabled then Exit; @@ -889,7 +931,7 @@ begin case Msg.Msg of WM_KEYDOWN: case Msg.wParam of - IK_RETURN, IK_KPRETURN: Click(); + IK_RETURN, IK_KPRETURN, VK_FIRE, VK_OPEN, JOY0_ATTACK, JOY1_ATTACK, JOY2_ATTACK, JOY3_ATTACK: Click(); end; end; end; @@ -899,55 +941,21 @@ begin inherited; end; -{ TFont } - -constructor TFont.Create(FontID: DWORD; FontType: TFontType); -begin - ID := FontID; - - FScale := 1; - FFontType := FontType; -end; - -destructor TFont.Destroy; -begin - - inherited; -end; - -procedure TFont.Draw(X, Y: Integer; Text: string; R, G, B: Byte); -begin - if FFontType = FONT_CHAR then e_CharFont_PrintEx(ID, X, Y, Text, _RGB(R, G, B), FScale) - else e_TextureFontPrintEx(X, Y, Text, ID, R, G, B, FScale); -end; - -procedure TFont.GetTextSize(Text: string; var w, h: Word); -var - cw, ch: Byte; -begin - if FFontType = FONT_CHAR then e_CharFont_GetSize(ID, Text, w, h) - else - begin - e_TextureFontGetSize(ID, cw, ch); - w := cw*Length(Text); - h := ch; - end; - - w := Round(w*FScale); - h := Round(h*FScale); -end; - { TGUIMainMenu } function TGUIMainMenu.AddButton(fProc: Pointer; Caption: string; ShowWindow: string = ''): TGUITextButton; -var - a, _x: Integer; - h, hh: Word; + var + {$IFDEF ENABLE_RENDER} + lw: Integer; + {$ENDIF} + a, _x: Integer; + h, hh: Word; + lh: Integer; begin FIndex := 0; SetLength(FButtons, Length(FButtons)+1); - FButtons[High(FButtons)] := TGUITextButton.Create(fProc, FFontID, Caption); + FButtons[High(FButtons)] := TGUITextButton.Create(fProc, FBigFont, Caption); FButtons[High(FButtons)].ShowWindow := ShowWindow; with FButtons[High(FButtons)] do begin @@ -962,18 +970,26 @@ begin if FButtons[a] <> nil then _x := Min(_x, (gScreenWidth div 2)-(FButtons[a].GetWidth div 2)); - hh := FHeader.GetHeight; + lw := 0; + lh := 0; + {$IFDEF ENABLE_RENDER} + if FHeader = nil then + r_Render_GetLogoSize(lw, lh); + {$ENDIF} + hh := FButtons[High(FButtons)].GetHeight; - h := hh*(2+Length(FButtons))+MAINMENU_SPACE*(Length(FButtons)-1); - h := (gScreenHeight div 2)-(h div 2); + if FHeader = nil then h := lh + hh * (1 + Length(FButtons)) + MAINMENU_SPACE * (Length(FButtons) - 1) + else h := hh * (2 + Length(FButtons)) + MAINMENU_SPACE * (Length(FButtons) - 1); + h := (gScreenHeight div 2) - (h div 2); - with FHeader do + if FHeader <> nil then with FHeader do begin FX := _x; FY := h; end; - Inc(h, hh*2); + if FHeader = nil then Inc(h, lh) + else Inc(h, hh*2); for a := 0 to High(FButtons) do begin @@ -996,23 +1012,23 @@ begin FButtons[High(FButtons)] := nil; end; -constructor TGUIMainMenu.Create(FontID: DWORD; Header: string); +constructor TGUIMainMenu.Create(BigFont: Boolean; Header: string); begin inherited Create(); FIndex := -1; - FFontID := FontID; + FBigFont := BigFont; FCounter := MAINMENU_MARKERDELAY; - g_Texture_Get(MAINMENU_MARKER1, FMarkerID1); - g_Texture_Get(MAINMENU_MARKER2, FMarkerID2); - - FHeader := TGUILabel.Create(Header, FFontID); - with FHeader do + if Header <> '' then begin - FColor := MAINMENU_HEADER_COLOR; - FX := (gScreenWidth div 2)-(GetWidth div 2); - FY := (gScreenHeight div 2)-(GetHeight div 2); + FHeader := TGUILabel.Create(Header, BigFont); + with FHeader do + begin + FColor := MAINMENU_HEADER_COLOR; + FX := (gScreenWidth div 2)-(GetWidth div 2); + FY := (gScreenHeight div 2)-(GetHeight div 2); + end; end; end; @@ -1029,32 +1045,14 @@ begin inherited; end; -procedure TGUIMainMenu.Draw; -var - a: Integer; -begin - inherited; - - FHeader.Draw; - - if FButtons <> nil then - begin - for a := 0 to High(FButtons) do - if FButtons[a] <> nil then FButtons[a].Draw; - - if FIndex <> -1 then - e_Draw(FMarkerID1, FButtons[FIndex].FX-48, FButtons[FIndex].FY, 0, True, False); - end; -end; - -procedure TGUIMainMenu.EnableButton(Name: string; e: Boolean); +procedure TGUIMainMenu.EnableButton(aName: string; e: Boolean); var a: Integer; begin if FButtons = nil then Exit; for a := 0 to High(FButtons) do - if (FButtons[a] <> nil) and (FButtons[a].Name = Name) then + if (FButtons[a] <> nil) and (FButtons[a].Name = aName) then begin if e then FButtons[a].FColor := MAINMENU_ITEMS_COLOR else FButtons[a].FColor := MAINMENU_UNACTIVEITEMS_COLOR; @@ -1063,7 +1061,7 @@ begin end; end; -function TGUIMainMenu.GetButton(Name: string): TGUITextButton; +function TGUIMainMenu.GetButton(aName: string): TGUITextButton; var a: Integer; begin @@ -1072,7 +1070,7 @@ begin if FButtons = nil then Exit; for a := 0 to High(FButtons) do - if (FButtons[a] <> nil) and (FButtons[a].Name = Name) then + if (FButtons[a] <> nil) and (FButtons[a].Name = aName) then begin Result := FButtons[a]; Break; @@ -1103,7 +1101,7 @@ begin case Msg.Msg of WM_KEYDOWN: case Msg.wParam of - IK_UP, IK_KPUP: + IK_UP, IK_KPUP, VK_UP, JOY0_UP, JOY1_UP, JOY2_UP, JOY3_UP: begin repeat Dec(FIndex); @@ -1112,7 +1110,7 @@ begin g_Sound_PlayEx(MENU_CHANGESOUND); end; - IK_DOWN, IK_KPDOWN: + IK_DOWN, IK_KPDOWN, VK_DOWN, JOY0_DOWN, JOY1_DOWN, JOY2_DOWN, JOY3_DOWN: begin repeat Inc(FIndex); @@ -1121,64 +1119,29 @@ begin g_Sound_PlayEx(MENU_CHANGESOUND); end; - IK_RETURN, IK_KPRETURN: if (FIndex <> -1) and FButtons[FIndex].FEnabled then FButtons[FIndex].Click; + IK_RETURN, IK_KPRETURN, VK_FIRE, VK_OPEN, JOY0_ATTACK, JOY1_ATTACK, JOY2_ATTACK, JOY3_ATTACK: if (FIndex <> -1) and FButtons[FIndex].FEnabled then FButtons[FIndex].Click; end; end; end; procedure TGUIMainMenu.Update; -var - t: DWORD; begin inherited; - - if FCounter = 0 then - begin - t := FMarkerID1; - FMarkerID1 := FMarkerID2; - FMarkerID2 := t; - - FCounter := MAINMENU_MARKERDELAY; - end else Dec(FCounter); + FCounter := (FCounter + 1) MOD (2 * MAINMENU_MARKERDELAY) end; { TGUILabel } -constructor TGUILabel.Create(Text: string; FontID: DWORD); +constructor TGUILabel.Create(Text: string; BigFont: Boolean); begin inherited Create(); - FFont := TFont.Create(FontID, FONT_CHAR); - + FBigFont := BigFont; FText := Text; FFixedLen := 0; FOnClickEvent := nil; end; -procedure TGUILabel.Draw; -begin - FFont.Draw(FX, FY, FText, FColor.R, FColor.G, FColor.B); -end; - -function TGUILabel.GetHeight: Integer; -var - w, h: Word; -begin - FFont.GetTextSize(FText, w, h); - Result := h; -end; - -function TGUILabel.GetWidth: Integer; -var - w, h: Word; -begin - if FFixedLen = 0 then - FFont.GetTextSize(FText, w, h) - else - w := e_CharFont_GetMaxWidth(FFont.ID)*FFixedLen; - Result := w; -end; - procedure TGUILabel.OnMessage(var Msg: TMessage); begin if not FEnabled then Exit; @@ -1188,7 +1151,7 @@ begin case Msg.Msg of WM_KEYDOWN: case Msg.wParam of - IK_RETURN, IK_KPRETURN: if @FOnClickEvent <> nil then FOnClickEvent(); + IK_RETURN, IK_KPRETURN, VK_FIRE, VK_OPEN, JOY0_ATTACK, JOY1_ATTACK, JOY2_ATTACK, JOY3_ATTACK: if @FOnClickEvent <> nil then FOnClickEvent(); end; end; end; @@ -1202,7 +1165,7 @@ begin i := NewItem(); with FItems[i] do begin - Control := TGUITextButton.Create(Proc, FFontID, fText); + Control := TGUITextButton.Create(Proc, FBigFont, fText); with Control as TGUITextButton do begin ShowWindow := _ShowWindow; @@ -1227,7 +1190,7 @@ begin i := NewItem(); with FItems[i] do begin - Text := TGUILabel.Create(fText, FFontID); + Text := TGUILabel.Create(fText, FBigFont); with Text do begin FColor := MENU_ITEMSTEXT_COLOR; @@ -1242,9 +1205,9 @@ end; procedure TGUIMenu.AddText(fText: string; MaxWidth: Word); var a, i: Integer; - l: SArray; + l: SSArray; begin - l := GetLines(fText, FFontID, MaxWidth); + l := GetLines(fText, FBigFont, MaxWidth); if l = nil then Exit; @@ -1253,10 +1216,14 @@ begin i := NewItem(); with FItems[i] do begin - Text := TGUILabel.Create(l[a], FFontID); - with Text do + Text := TGUILabel.Create(l[a], FBigFont); + if FYesNo then + begin + with Text do begin FColor := _RGB(255, 0, 0); end; + end + else begin - FColor := MENU_ITEMSTEXT_COLOR; + with Text do begin FColor := MENU_ITEMSTEXT_COLOR; end; end; Control := nil; @@ -1280,17 +1247,18 @@ begin ReAlign(); end; -constructor TGUIMenu.Create(HeaderFont, ItemsFont: DWORD; Header: string); +constructor TGUIMenu.Create(HeaderBigFont, ItemsBigFont: Boolean; Header: string); begin inherited Create(); FItems := nil; FIndex := -1; - FFontID := ItemsFont; + FBigFont := ItemsBigFont; FCounter := MENU_MARKERDELAY; FAlign := True; + FYesNo := false; - FHeader := TGUILabel.Create(Header, HeaderFont); + FHeader := TGUILabel.Create(Header, HeaderBigFont); with FHeader do begin FX := (gScreenWidth div 2)-(GetWidth div 2); @@ -1318,44 +1286,7 @@ begin inherited; end; -procedure TGUIMenu.Draw; -var - a, x, y: Integer; -begin - inherited; - - if FHeader <> nil then FHeader.Draw; - - if FItems <> nil then - for a := 0 to High(FItems) do - begin - if FItems[a].Text <> nil then FItems[a].Text.Draw; - if FItems[a].Control <> nil then FItems[a].Control.Draw; - end; - - if (FIndex <> -1) and (FCounter > MENU_MARKERDELAY div 2) then - begin - x := 0; - y := 0; - - if FItems[FIndex].Text <> nil then - begin - x := FItems[FIndex].Text.FX; - y := FItems[FIndex].Text.FY; - end - else if FItems[FIndex].Control <> nil then - begin - x := FItems[FIndex].Control.FX; - y := FItems[FIndex].Control.FY; - end; - - x := x-e_CharFont_GetMaxWidth(FFontID); - - e_CharFont_PrintEx(FFontID, x, y, #16, _RGB(255, 0, 0)); - end; -end; - -function TGUIMenu.GetControl(Name: String): TGUIControl; +function TGUIMenu.GetControl(aName: String): TGUIControl; var a: Integer; begin @@ -1364,16 +1295,16 @@ begin if FItems <> nil then for a := 0 to High(FItems) do if FItems[a].Control <> nil then - if LowerCase(FItems[a].Control.Name) = LowerCase(Name) then + if LowerCase(FItems[a].Control.Name) = LowerCase(aName) then begin Result := FItems[a].Control; Break; end; - Assert(Result <> nil, 'GUI control "'+Name+'" not found!'); + Assert(Result <> nil, 'GUI control "'+aName+'" not found!'); end; -function TGUIMenu.GetControlsText(Name: String): TGUILabel; +function TGUIMenu.GetControlsText(aName: String): TGUILabel; var a: Integer; begin @@ -1382,13 +1313,13 @@ begin if FItems <> nil then for a := 0 to High(FItems) do if FItems[a].Control <> nil then - if LowerCase(FItems[a].Control.Name) = LowerCase(Name) then + if LowerCase(FItems[a].Control.Name) = LowerCase(aName) then begin Result := FItems[a].Text; Break; end; - Assert(Result <> nil, 'GUI control''s text "'+Name+'" not found!'); + Assert(Result <> nil, 'GUI control''s text "'+aName+'" not found!'); end; function TGUIMenu.NewItem: Integer; @@ -1418,11 +1349,19 @@ begin if not ok then Exit; + if (Msg.Msg = WM_KEYDOWN) and (FIndex <> -1) and (FItems[FIndex].Control <> nil) and + (FItems[FIndex].Control.WantActivationKey(Msg.wParam)) then + begin + FItems[FIndex].Control.OnMessage(Msg); + g_Sound_PlayEx(MENU_CLICKSOUND); + exit; + end; + case Msg.Msg of WM_KEYDOWN: begin case Msg.wParam of - IK_UP, IK_KPUP: + IK_UP, IK_KPUP, VK_UP,JOY0_UP, JOY1_UP, JOY2_UP, JOY3_UP: begin c := 0; repeat @@ -1443,7 +1382,7 @@ begin g_Sound_PlayEx(MENU_CHANGESOUND); end; - IK_DOWN, IK_KPDOWN: + IK_DOWN, IK_KPDOWN, VK_DOWN, JOY0_DOWN, JOY1_DOWN, JOY2_DOWN, JOY3_DOWN: begin c := 0; repeat @@ -1464,32 +1403,69 @@ begin g_Sound_PlayEx(MENU_CHANGESOUND); end; - IK_LEFT, IK_RIGHT, IK_KPLEFT, IK_KPRIGHT: + IK_LEFT, IK_RIGHT, IK_KPLEFT, IK_KPRIGHT, VK_LEFT, VK_RIGHT, + JOY0_LEFT, JOY1_LEFT, JOY2_LEFT, JOY3_LEFT, + JOY0_RIGHT, JOY1_RIGHT, JOY2_RIGHT, JOY3_RIGHT: begin if FIndex <> -1 then if FItems[FIndex].Control <> nil then FItems[FIndex].Control.OnMessage(Msg); end; - IK_RETURN, IK_KPRETURN: + IK_RETURN, IK_KPRETURN, VK_FIRE, VK_OPEN, JOY0_ATTACK, JOY1_ATTACK, JOY2_ATTACK, JOY3_ATTACK: begin if FIndex <> -1 then - if FItems[FIndex].Control <> nil then - FItems[FIndex].Control.OnMessage(Msg); - + begin + if FItems[FIndex].Control <> nil then FItems[FIndex].Control.OnMessage(Msg); + end; g_Sound_PlayEx(MENU_CLICKSOUND); end; + // dirty hacks + IK_Y: + if FYesNo and (length(FItems) > 1) then + begin + Msg.wParam := IK_RETURN; // to register keypress + FIndex := High(FItems)-1; + if FItems[FIndex].Control <> nil then FItems[FIndex].Control.OnMessage(Msg); + end; + IK_N: + if FYesNo and (length(FItems) > 1) then + begin + Msg.wParam := IK_RETURN; // to register keypress + FIndex := High(FItems); + if FItems[FIndex].Control <> nil then FItems[FIndex].Control.OnMessage(Msg); + end; end; end; end; end; procedure TGUIMenu.ReAlign(); -var - a, tx, cx, w, h: Integer; + var + {$IFDEF ENABLE_RENDER} + fw, fh: Integer; + {$ENDIF} + a, tx, cx, w, h: Integer; + cww: array of Integer; // cached widths + maxcww: Integer; begin if FItems = nil then Exit; - if not FAlign then tx := FLeft else + SetLength(cww, length(FItems)); + maxcww := 0; + for a := 0 to High(FItems) do + begin + if FItems[a].Text <> nil then + begin + cww[a] := FItems[a].Text.GetWidth; + if maxcww < cww[a] then maxcww := cww[a]; + end; + end; + + if not FAlign then + begin + tx := FLeft; + end + else begin tx := gScreenWidth; for a := 0 to High(FItems) do @@ -1499,55 +1475,52 @@ begin if FItems[a].Control <> nil then begin w := w+MENU_HSPACE; - - if FItems[a].ControlType = TGUILabel then - w := w+(FItems[a].Control as TGUILabel).GetWidth - else if FItems[a].ControlType = TGUITextButton then - w := w+(FItems[a].Control as TGUITextButton).GetWidth - else if FItems[a].ControlType = TGUIScroll then - w := w+(FItems[a].Control as TGUIScroll).GetWidth - else if FItems[a].ControlType = TGUISwitch then - w := w+(FItems[a].Control as TGUISwitch).GetWidth - else if FItems[a].ControlType = TGUIEdit then - w := w+(FItems[a].Control as TGUIEdit).GetWidth - else if FItems[a].ControlType = TGUIKeyRead then - w := w+(FItems[a].Control as TGUIKeyRead).GetWidth - else if (FItems[a].ControlType = TGUIListBox) then - w := w+(FItems[a].Control as TGUIListBox).GetWidth - else if (FItems[a].ControlType = TGUIFileListBox) then - w := w+(FItems[a].Control as TGUIFileListBox).GetWidth - else if FItems[a].ControlType = TGUIMemo then - w := w+(FItems[a].Control as TGUIMemo).GetWidth; + if FItems[a].ControlType = TGUILabel then w := w+(FItems[a].Control as TGUILabel).GetWidth + else if FItems[a].ControlType = TGUITextButton then w := w+(FItems[a].Control as TGUITextButton).GetWidth + else if FItems[a].ControlType = TGUIScroll then w := w+(FItems[a].Control as TGUIScroll).GetWidth + else if FItems[a].ControlType = TGUISwitch then w := w+(FItems[a].Control as TGUISwitch).GetWidth + else if FItems[a].ControlType = TGUIEdit then w := w+(FItems[a].Control as TGUIEdit).GetWidth + else if FItems[a].ControlType = TGUIKeyRead then w := w+(FItems[a].Control as TGUIKeyRead).GetWidth + else if FItems[a].ControlType = TGUIKeyRead2 then w := w+(FItems[a].Control as TGUIKeyRead2).GetWidth + else if FItems[a].ControlType = TGUIListBox then w := w+(FItems[a].Control as TGUIListBox).GetWidth + else if FItems[a].ControlType = TGUIFileListBox then w := w+(FItems[a].Control as TGUIFileListBox).GetWidth + else if FItems[a].ControlType = TGUIMemo then w := w+(FItems[a].Control as TGUIMemo).GetWidth; end; - tx := Min(tx, (gScreenWidth div 2)-(w div 2)); end; end; cx := 0; for a := 0 to High(FItems) do + begin with FItems[a] do begin if (Text <> nil) and (Control = nil) then Continue; - w := 0; if Text <> nil then w := tx+Text.GetWidth; - if w > cx then cx := w; end; + end; cx := cx+MENU_HSPACE; h := FHeader.GetHeight*2+MENU_VSPACE*(Length(FItems)-1); for a := 0 to High(FItems) do + begin with FItems[a] do begin if (ControlType = TGUIListBox) or (ControlType = TGUIFileListBox) then h := h+(FItems[a].Control as TGUIListBox).GetHeight() else - h := h+e_CharFont_GetMaxHeight(FFontID); + begin + {$IFDEF ENABLE_RENDER} + r_Render_GetMaxFontSize(FBigFont, fw, fh); + h := h + fh; + {$ENDIF} + end; end; + end; h := (gScreenHeight div 2)-(h div 2); @@ -1560,35 +1533,78 @@ begin end; for a := 0 to High(FItems) do + begin with FItems[a] do begin if Text <> nil then + begin with Text do begin FX := tx; FY := h; end; + //HACK! + if Text.RightAlign and (length(cww) > a) then + begin + //Text.FX := Text.FX+maxcww; + Text.FMaxWidth := maxcww; + end; + end; - if Control <> nil then - with Control do - if Text <> nil then - begin - FX := cx; - FY := h; - end - else - begin - FX := tx; - FY := h; - end; - - if (ControlType = TGUIListBox) or (ControlType = TGUIFileListBox) then - Inc(h, (Control as TGUIListBox).GetHeight+MENU_VSPACE) - else if ControlType = TGUIMemo then - Inc(h, (Control as TGUIMemo).GetHeight+MENU_VSPACE) - else - Inc(h, e_CharFont_GetMaxHeight(FFontID)+MENU_VSPACE); - end; + if Control <> nil then + begin + with Control do + begin + if Text <> nil then + begin + FX := cx; + FY := h; + end + else + begin + FX := tx; + FY := h; + end; + end; + end; + + if (ControlType = TGUIListBox) or (ControlType = TGUIFileListBox) then Inc(h, (Control as TGUIListBox).GetHeight+MENU_VSPACE) + else if ControlType = TGUIMemo then Inc(h, (Control as TGUIMemo).GetHeight+MENU_VSPACE) + else + begin + {$IFDEF ENABLE_RENDER} + r_Render_GetMaxFontSize(FBigFont, fw, fh); + h := h + fh + MENU_VSPACE; + {$ELSE} + h := h + MENU_VSPACE; + {$ENDIF} + end; + end; + end; + + // another ugly hack + if FYesNo and (length(FItems) > 1) then + begin + w := -1; + for a := High(FItems)-1 to High(FItems) do + begin + if (FItems[a].Control <> nil) and (FItems[a].ControlType = TGUITextButton) then + begin + cx := (FItems[a].Control as TGUITextButton).GetWidth; + if cx > w then w := cx; + end; + end; + if w > 0 then + begin + for a := High(FItems)-1 to High(FItems) do + begin + if (FItems[a].Control <> nil) and (FItems[a].ControlType = TGUITextButton) then + begin + FItems[a].Control.FX := (gScreenWidth-w) div 2; + end; + end; + end; + end; end; function TGUIMenu.AddScroll(fText: string): TGUIScroll; @@ -1600,7 +1616,7 @@ begin begin Control := TGUIScroll.Create(); - Text := TGUILabel.Create(fText, FFontID); + Text := TGUILabel.Create(fText, FBigFont); with Text do begin FColor := MENU_ITEMSTEXT_COLOR; @@ -1623,10 +1639,10 @@ begin i := NewItem(); with FItems[i] do begin - Control := TGUISwitch.Create(FFontID); + Control := TGUISwitch.Create(FBigFont); (Control as TGUISwitch).FColor := MENU_ITEMSCTRL_COLOR; - Text := TGUILabel.Create(fText, FFontID); + Text := TGUILabel.Create(fText, FBigFont); with Text do begin FColor := MENU_ITEMSTEXT_COLOR; @@ -1649,7 +1665,7 @@ begin i := NewItem(); with FItems[i] do begin - Control := TGUIEdit.Create(FFontID); + Control := TGUIEdit.Create(FBigFont); with Control as TGUIEdit do begin FWindow := Self.FWindow; @@ -1658,7 +1674,7 @@ begin if fText = '' then Text := nil else begin - Text := TGUILabel.Create(fText, FFontID); + Text := TGUILabel.Create(fText, FBigFont); Text.FColor := MENU_ITEMSTEXT_COLOR; end; @@ -1693,14 +1709,14 @@ begin i := NewItem(); with FItems[i] do begin - Control := TGUIKeyRead.Create(FFontID); + Control := TGUIKeyRead.Create(FBigFont); with Control as TGUIKeyRead do begin FWindow := Self.FWindow; FColor := MENU_ITEMSCTRL_COLOR; end; - Text := TGUILabel.Create(fText, FFontID); + Text := TGUILabel.Create(fText, FBigFont); with Text do begin FColor := MENU_ITEMSTEXT_COLOR; @@ -1716,6 +1732,37 @@ begin ReAlign(); end; +function TGUIMenu.AddKeyRead2(fText: string): TGUIKeyRead2; +var + i: Integer; +begin + i := NewItem(); + with FItems[i] do + begin + Control := TGUIKeyRead2.Create(FBigFont); + with Control as TGUIKeyRead2 do + begin + FWindow := Self.FWindow; + FColor := MENU_ITEMSCTRL_COLOR; + end; + + Text := TGUILabel.Create(fText, FBigFont); + with Text do + begin + FColor := MENU_ITEMSCTRL_COLOR; //MENU_ITEMSTEXT_COLOR; + RightAlign := true; + end; + + ControlType := TGUIKeyRead2; + + Result := (Control as TGUIKeyRead2); + end; + + if FIndex = -1 then FIndex := i; + + ReAlign(); +end; + function TGUIMenu.AddList(fText: string; Width, Height: Word): TGUIListBox; var i: Integer; @@ -1723,7 +1770,7 @@ begin i := NewItem(); with FItems[i] do begin - Control := TGUIListBox.Create(FFontID, Width, Height); + Control := TGUIListBox.Create(FBigFont, Width, Height); with Control as TGUIListBox do begin FWindow := Self.FWindow; @@ -1731,7 +1778,7 @@ begin FUnActiveColor := MENU_ITEMSTEXT_COLOR; end; - Text := TGUILabel.Create(fText, FFontID); + Text := TGUILabel.Create(fText, FBigFont); with Text do begin FColor := MENU_ITEMSTEXT_COLOR; @@ -1754,7 +1801,7 @@ begin i := NewItem(); with FItems[i] do begin - Control := TGUIFileListBox.Create(FFontID, Width, Height); + Control := TGUIFileListBox.Create(FBigFont, Width, Height); with Control as TGUIFileListBox do begin FWindow := Self.FWindow; @@ -1764,7 +1811,7 @@ begin if fText = '' then Text := nil else begin - Text := TGUILabel.Create(fText, FFontID); + Text := TGUILabel.Create(fText, FBigFont); Text.FColor := MENU_ITEMSTEXT_COLOR; end; @@ -1785,14 +1832,14 @@ begin i := NewItem(); with FItems[i] do begin - Control := TGUILabel.Create('', FFontID); + Control := TGUILabel.Create('', FBigFont); with Control as TGUILabel do begin FWindow := Self.FWindow; FColor := MENU_ITEMSCTRL_COLOR; end; - Text := TGUILabel.Create(fText, FFontID); + Text := TGUILabel.Create(fText, FBigFont); with Text do begin FColor := MENU_ITEMSTEXT_COLOR; @@ -1815,7 +1862,7 @@ begin i := NewItem(); with FItems[i] do begin - Control := TGUIMemo.Create(FFontID, Width, Height); + Control := TGUIMemo.Create(FBigFont, Width, Height); with Control as TGUIMemo do begin FWindow := Self.FWindow; @@ -1824,7 +1871,7 @@ begin if fText = '' then Text := nil else begin - Text := TGUILabel.Create(fText, FFontID); + Text := TGUILabel.Create(fText, FBigFont); Text.FColor := MENU_ITEMSTEXT_COLOR; end; @@ -1867,26 +1914,6 @@ begin FMax := 0; FOnChangeEvent := nil; - - g_Texture_Get(SCROLL_LEFT, FLeftID); - g_Texture_Get(SCROLL_RIGHT, FRightID); - g_Texture_Get(SCROLL_MIDDLE, FMiddleID); - g_Texture_Get(SCROLL_MARKER, FMarkerID); -end; - -procedure TGUIScroll.Draw; -var - a: Integer; -begin - inherited; - - e_Draw(FLeftID, FX, FY, 0, True, False); - e_Draw(FRightID, FX+8+(FMax+1)*8, FY, 0, True, False); - - for a := 0 to FMax do - e_Draw(FMiddleID, FX+8+a*8, FY, 0, True, False); - - e_Draw(FMarkerID, FX+8+FValue*8, FY, 0, True, False); end; procedure TGUIScroll.FSetValue(a: Integer); @@ -1894,11 +1921,6 @@ begin if a > FMax then FValue := FMax else FValue := a; end; -function TGUIScroll.GetWidth: Word; -begin - Result := 16+(FMax+1)*8; -end; - procedure TGUIScroll.OnMessage(var Msg: TMessage); begin if not FEnabled then Exit; @@ -1909,14 +1931,14 @@ begin WM_KEYDOWN: begin case Msg.wParam of - IK_LEFT, IK_KPLEFT: + IK_LEFT, IK_KPLEFT, VK_LEFT, JOY0_LEFT, JOY1_LEFT, JOY2_LEFT, JOY3_LEFT: if FValue > 0 then begin Dec(FValue); g_Sound_PlayEx(SCROLL_SUBSOUND); if @FOnChangeEvent <> nil then FOnChangeEvent(Self); end; - IK_RIGHT, IK_KPRIGHT: + IK_RIGHT, IK_KPRIGHT, VK_RIGHT, JOY0_RIGHT, JOY1_RIGHT, JOY2_RIGHT, JOY3_RIGHT: if FValue < FMax then begin Inc(FValue); @@ -1944,20 +1966,13 @@ begin if FIndex = -1 then FIndex := 0; end; -constructor TGUISwitch.Create(FontID: DWORD); +constructor TGUISwitch.Create(BigFont: Boolean); begin inherited Create(); FIndex := -1; - FFont := TFont.Create(FontID, FONT_CHAR); -end; - -procedure TGUISwitch.Draw; -begin - inherited; - - FFont.Draw(FX, FY, FItems[FIndex], FColor.R, FColor.G, FColor.B); + FBigFont := BigFont; end; function TGUISwitch.GetText: string; @@ -1966,22 +1981,6 @@ begin else Result := ''; end; -function TGUISwitch.GetWidth: Word; -var - a: Integer; - w, h: Word; -begin - Result := 0; - - if FItems = nil then Exit; - - for a := 0 to High(FItems) do - begin - FFont.GetTextSize(FItems[a], w, h); - if w > Result then Result := w; - end; -end; - procedure TGUISwitch.OnMessage(var Msg: TMessage); begin if not FEnabled then Exit; @@ -1993,27 +1992,34 @@ begin case Msg.Msg of WM_KEYDOWN: case Msg.wParam of - IK_RETURN, IK_RIGHT, IK_KPRETURN, IK_KPRIGHT: + IK_RETURN, IK_RIGHT, IK_KPRETURN, IK_KPRIGHT, VK_FIRE, VK_OPEN, VK_RIGHT, + JOY0_RIGHT, JOY1_RIGHT, JOY2_RIGHT, JOY3_RIGHT, + JOY0_ATTACK, JOY1_ATTACK, JOY2_ATTACK, JOY3_ATTACK: begin if FIndex < High(FItems) then Inc(FIndex) else FIndex := 0; + g_Sound_PlayEx(SCROLL_ADDSOUND); + if @FOnChangeEvent <> nil then FOnChangeEvent(Self); end; - IK_LEFT, IK_KPLEFT: - begin - if FIndex > 0 then - Dec(FIndex) - else - FIndex := High(FItems); + IK_LEFT, IK_KPLEFT, VK_LEFT, + JOY0_LEFT, JOY1_LEFT, JOY2_LEFT, JOY3_LEFT: + begin + if FIndex > 0 then + Dec(FIndex) + else + FIndex := High(FItems); - if @FOnChangeEvent <> nil then - FOnChangeEvent(Self); - end; + g_Sound_PlayEx(SCROLL_SUBSOUND); + + if @FOnChangeEvent <> nil then + FOnChangeEvent(Self); + end; end; end; end; @@ -2026,46 +2032,14 @@ end; { TGUIEdit } -constructor TGUIEdit.Create(FontID: DWORD); +constructor TGUIEdit.Create(BigFont: Boolean); begin inherited Create(); - FFont := TFont.Create(FontID, FONT_CHAR); - + FBigFont := BigFont; FMaxLength := 0; FWidth := 0; - - g_Texture_Get(EDIT_LEFT, FLeftID); - g_Texture_Get(EDIT_RIGHT, FRightID); - g_Texture_Get(EDIT_MIDDLE, FMiddleID); -end; - -procedure TGUIEdit.Draw; -var - c, w, h: Word; -begin - inherited; - - e_Draw(FLeftID, FX, FY, 0, True, False); - e_Draw(FRightID, FX+8+FWidth*16, FY, 0, True, False); - - for c := 0 to FWidth-1 do - e_Draw(FMiddleID, FX+8+c*16, FY, 0, True, False); - - FFont.Draw(FX+8, FY, FText, FColor.R, FColor.G, FColor.B); - - if FWindow.FActiveControl = Self then - begin - FFont.GetTextSize(Copy(FText, 1, FCaretPos), w, h); - h := e_CharFont_GetMaxHeight(FFont.ID); - e_DrawLine(2, FX+8+w, FY+h-3, FX+8+w+EDIT_CURSORLEN, FY+h-3, - EDIT_CURSORCOLOR.R, EDIT_CURSORCOLOR.G, EDIT_CURSORCOLOR.B); - end; -end; - -function TGUIEdit.GetWidth: Word; -begin - Result := 16+FWidth*16; + FInvalid := false; end; procedure TGUIEdit.OnMessage(var Msg: TMessage); @@ -2105,9 +2079,9 @@ begin IK_DELETE: Delete(FText, FCaretPos + 1, 1); IK_END, IK_KPEND: FCaretPos := Length(FText); IK_HOME, IK_KPHOME: FCaretPos := 0; - IK_LEFT, IK_KPLEFT: if FCaretPos > 0 then Dec(FCaretPos); - IK_RIGHT, IK_KPRIGHT: if FCaretPos < Length(FText) then Inc(FCaretPos); - IK_RETURN, IK_KPRETURN: + IK_LEFT, IK_KPLEFT, VK_LEFT, JOY0_LEFT, JOY1_LEFT, JOY2_LEFT, JOY3_LEFT: if FCaretPos > 0 then Dec(FCaretPos); + IK_RIGHT, IK_KPRIGHT, VK_RIGHT, JOY0_RIGHT, JOY1_RIGHT, JOY2_RIGHT, JOY3_RIGHT: if FCaretPos < Length(FText) then Inc(FCaretPos); + IK_RETURN, IK_KPRETURN, VK_FIRE, VK_OPEN, JOY0_ATTACK, JOY1_ATTACK, JOY2_ATTACK, JOY3_ATTACK: with FWindow do begin if FActiveControl <> Self then @@ -2124,6 +2098,12 @@ begin end; end; end; + + g_GUIGrabInput := (@FOnEnterEvent = nil) and (FWindow.FActiveControl = Self); + + {$IFDEF ENABLE_TOUCH} + sys_ShowKeyboard(g_GUIGrabInput) + {$ENDIF} end; procedure TGUIEdit.SetText(Text: string); @@ -2140,42 +2120,152 @@ end; { TGUIKeyRead } -constructor TGUIKeyRead.Create(FontID: DWORD); +constructor TGUIKeyRead.Create(BigFont: Boolean); begin inherited Create(); + FKey := 0; + FIsQuery := false; + FBigFont := BigFont; +end; - FFont := TFont.Create(FontID, FONT_CHAR); +function TGUIKeyRead.WantActivationKey (key: LongInt): Boolean; +begin + result := + (key = IK_BACKSPACE) or + false; // oops end; -procedure TGUIKeyRead.Draw; +procedure TGUIKeyRead.OnMessage(var Msg: TMessage); + procedure actDefCtl (); + begin + with FWindow do + if FDefControl <> '' then + SetActive(GetControl(FDefControl)) + else + SetActive(nil); + end; + begin inherited; - FFont.Draw(FX, FY, IfThen(FIsQuery, KEYREAD_QUERY, IfThen(FKey <> 0, e_KeyNames[FKey], KEYREAD_CLEAR)), - FColor.R, FColor.G, FColor.B); + if not FEnabled then + Exit; + + with Msg do + case Msg of + WM_KEYDOWN: + case wParam of + VK_ESCAPE: + begin + if FIsQuery then actDefCtl(); + FIsQuery := False; + end; + IK_RETURN, IK_KPRETURN, VK_FIRE, VK_OPEN, JOY0_ATTACK, JOY1_ATTACK, JOY2_ATTACK, JOY3_ATTACK: + begin + if not FIsQuery then + begin + with FWindow do + if FActiveControl <> Self then + SetActive(Self); + + FIsQuery := True; + end + else if (wParam < VK_FIRSTKEY) and (wParam > VK_LASTKEY) then + begin + // FKey := IK_ENTER; // + FKey := wParam; + FIsQuery := False; + actDefCtl(); + end; + end; + IK_BACKSPACE: // clear keybinding if we aren't waiting for a key + begin + if not FIsQuery then + begin + FKey := 0; + actDefCtl(); + end; + end; + end; + + MESSAGE_DIKEY: + begin + if not FIsQuery and (wParam = IK_BACKSPACE) then + begin + FKey := 0; + actDefCtl(); + end + else if FIsQuery then + begin + case wParam of + IK_ENTER, IK_KPRETURN, VK_FIRSTKEY..VK_LASTKEY (*, JOY0_ATTACK, JOY1_ATTACK, JOY2_ATTACK, JOY3_ATTACK*): // Not '' then + FKey := wParam; + FIsQuery := False; + actDefCtl(); + end + end; + end; + end; + + g_GUIGrabInput := FIsQuery end; -function TGUIKeyRead.GetWidth: Word; -var - a: Byte; - w, h: Word; +{ TGUIKeyRead2 } + +constructor TGUIKeyRead2.Create(BigFont: Boolean); + {$IFDEF ENABLE_RENDER} + var a: Byte; w, h: Integer; + {$ENDIF} begin - Result := 0; + inherited Create(); - for a := 0 to 255 do - begin - FFont.GetTextSize(e_KeyNames[a], w, h); - Result := Max(Result, w); - end; + FKey0 := 0; + FKey1 := 0; + FKeyIdx := 0; + FIsQuery := False; - FFont.GetTextSize(KEYREAD_QUERY, w, h); - if w > Result then Result := w; + FBigFont := BigFont; - FFont.GetTextSize(KEYREAD_CLEAR, w, h); - if w > Result then Result := w; + FMaxKeyNameWdt := 0; + + {$IFDEF ENABLE_RENDER} + for a := 0 to 255 do + begin + r_Render_GetStringSize(BigFont, e_KeyNames[a], w, h); + FMaxKeyNameWdt := Max(FMaxKeyNameWdt, w); + end; + FMaxKeyNameWdt := FMaxKeyNameWdt-(FMaxKeyNameWdt div 3); + r_Render_GetStringSize(BigFont, KEYREAD_QUERY, w, h); + if w > FMaxKeyNameWdt then FMaxKeyNameWdt := w; + r_Render_GetStringSize(BigFont, KEYREAD_CLEAR, w, h); + if w > FMaxKeyNameWdt then FMaxKeyNameWdt := w; + {$ENDIF} end; -procedure TGUIKeyRead.OnMessage(var Msg: TMessage); +function TGUIKeyRead2.WantActivationKey (key: LongInt): Boolean; +begin + case key of + IK_BACKSPACE, IK_LEFT, IK_RIGHT, IK_KPLEFT, IK_KPRIGHT, VK_LEFT, VK_RIGHT, + JOY0_LEFT, JOY1_LEFT, JOY2_LEFT, JOY3_LEFT, + JOY0_RIGHT, JOY1_RIGHT, JOY2_RIGHT, JOY3_RIGHT: + result := True + else + result := False + end +end; + +procedure TGUIKeyRead2.OnMessage(var Msg: TMessage); + procedure actDefCtl (); + begin + with FWindow do + if FDefControl <> '' then + SetActive(GetControl(FDefControl)) + else + SetActive(nil); + end; + begin inherited; @@ -2186,18 +2276,12 @@ begin case Msg of WM_KEYDOWN: case wParam of - IK_ESCAPE: + VK_ESCAPE: begin - if FIsQuery then - with FWindow do - if FDefControl <> '' then - SetActive(GetControl(FDefControl)) - else - SetActive(nil); - + if FIsQuery then actDefCtl(); FIsQuery := False; end; - IK_RETURN, IK_KPRETURN: + IK_RETURN, IK_KPRETURN, VK_FIRE, VK_OPEN, JOY0_ATTACK, JOY1_ATTACK, JOY2_ATTACK, JOY3_ATTACK: begin if not FIsQuery then begin @@ -2207,36 +2291,63 @@ begin FIsQuery := True; end - else + else if (wParam < VK_FIRSTKEY) and (wParam > VK_LASTKEY) then begin - FKey := IK_ENTER; // + // if (FKeyIdx = 0) then FKey0 := IK_ENTER else FKey1 := IK_ENTER; // + if (FKeyIdx = 0) then FKey0 := wParam else FKey1 := wParam; FIsQuery := False; - - with FWindow do - if FDefControl <> '' then - SetActive(GetControl(FDefControl)) - else - SetActive(nil); + actDefCtl(); end; end; + IK_BACKSPACE: // clear keybinding if we aren't waiting for a key + begin + if not FIsQuery then + begin + if (FKeyIdx = 0) then FKey0 := 0 else FKey1 := 0; + actDefCtl(); + end; + end; + IK_LEFT, IK_KPLEFT, VK_LEFT, JOY0_LEFT, JOY1_LEFT, JOY2_LEFT, JOY3_LEFT: + if not FIsQuery then + begin + FKeyIdx := 0; + actDefCtl(); + end; + IK_RIGHT, IK_KPRIGHT, VK_RIGHT, JOY0_RIGHT, JOY1_RIGHT, JOY2_RIGHT, JOY3_RIGHT: + if not FIsQuery then + begin + FKeyIdx := 1; + actDefCtl(); + end; end; MESSAGE_DIKEY: - if FIsQuery and (wParam <> IK_ENTER) and (wParam <> IK_KPRETURN) then // Not '' then - FKey := wParam; - FIsQuery := False; - - with FWindow do - if FDefControl <> '' then - SetActive(GetControl(FDefControl)) + if not FIsQuery and (wParam = IK_BACKSPACE) then + begin + if (FKeyIdx = 0) then FKey0 := 0 else FKey1 := 0; + actDefCtl(); + end + else if FIsQuery then + begin + case wParam of + IK_ENTER, IK_KPRETURN, VK_FIRSTKEY..VK_LASTKEY (*, JOY0_ATTACK, JOY1_ATTACK, JOY2_ATTACK, JOY3_ATTACK*): // Not '' then + begin + if (FKeyIdx = 0) then FKey0 := wParam else FKey1 := wParam; + end; + FIsQuery := False; + actDefCtl() + end + end; end; end; + + g_GUIGrabInput := FIsQuery end; + { TGUIModelView } constructor TGUIModelView.Create; @@ -2253,15 +2364,6 @@ begin inherited; end; -procedure TGUIModelView.Draw; -begin - inherited; - - DrawBox(FX, FY, 4, 4); - - if FModel <> nil then FModel.Draw(FX+4, FY+4); -end; - procedure TGUIModelView.NextAnim(); begin if FModel = nil then @@ -2278,7 +2380,7 @@ begin if FModel = nil then Exit; - if FModel.Weapon < WEAPON_SUPERPULEMET then + if FModel.Weapon < WP_LAST then FModel.SetWeapon(FModel.Weapon+1) else FModel.SetWeapon(WEAPON_KASTET); @@ -2326,84 +2428,6 @@ begin inherited; end; -procedure TGUIMapPreview.Draw(); -var - a: Integer; - r, g, b: Byte; -begin - inherited; - - DrawBox(FX, FY, MAPPREVIEW_WIDTH, MAPPREVIEW_HEIGHT); - - if (FMapSize.X <= 0) or (FMapSize.Y <= 0) then - Exit; - - e_DrawFillQuad(FX+4, FY+4, - FX+4 + Trunc(FMapSize.X / FScale) - 1, - FY+4 + Trunc(FMapSize.Y / FScale) - 1, - 32, 32, 32, 0); - - if FMapData <> nil then - for a := 0 to High(FMapData) do - with FMapData[a] do - begin - if X1 > MAPPREVIEW_WIDTH*16 then Continue; - if Y1 > MAPPREVIEW_HEIGHT*16 then Continue; - - if X2 < 0 then Continue; - if Y2 < 0 then Continue; - - if X2 > MAPPREVIEW_WIDTH*16 then X2 := MAPPREVIEW_WIDTH*16; - if Y2 > MAPPREVIEW_HEIGHT*16 then Y2 := MAPPREVIEW_HEIGHT*16; - - if X1 < 0 then X1 := 0; - if Y1 < 0 then Y1 := 0; - - case PanelType of - PANEL_WALL: - begin - r := 255; - g := 255; - b := 255; - end; - PANEL_CLOSEDOOR: - begin - r := 255; - g := 255; - b := 0; - end; - PANEL_WATER: - begin - r := 0; - g := 0; - b := 192; - end; - PANEL_ACID1: - begin - r := 0; - g := 176; - b := 0; - end; - PANEL_ACID2: - begin - r := 176; - g := 0; - b := 0; - end; - else - begin - r := 128; - g := 128; - b := 128; - end; - end; - - if ((X2-X1) > 0) and ((Y2-Y1) > 0) then - e_DrawFillQuad(FX+4 + X1, FY+4 + Y1, - FX+4 + X2 - 1, FY+4 + Y2 - 1, r, g, b, 0); - end; -end; - procedure TGUIMapPreview.OnMessage(var Msg: TMessage); begin inherited; @@ -2412,26 +2436,32 @@ end; procedure TGUIMapPreview.SetMap(Res: string); var - WAD: TWADEditor_1; - MapReader: TMapReader_1; - panels: TPanelsRec1Array; - header: TMapHeaderRec_1; - a: Integer; - FileName, SectionName, ResName: string; + WAD: TWADFile; + panlist: TDynField; + pan: TDynRecord; + //header: TMapHeaderRec_1; + FileName: string; Data: Pointer; Len: Integer; rX, rY: Single; + map: TDynRecord = nil; begin - g_ProcessResourceStr(Res, FileName, SectionName, ResName); + FMapSize.X := 0; + FMapSize.Y := 0; + FScale := 0.0; + FMapData := nil; - WAD := TWADEditor_1.Create(); + FileName := g_ExtractWadName(Res); + + WAD := TWADFile.Create(); if not WAD.ReadFile(FileName) then begin WAD.Free(); Exit; end; - if not WAD.GetResource('', ResName, Data, Len) then + //k8: ignores path again + if not WAD.GetMapResource(g_ExtractFileName(Res), Data, Len) then begin WAD.Free(); Exit; @@ -2439,68 +2469,71 @@ begin WAD.Free(); - MapReader := TMapReader_1.Create(); - - if not MapReader.LoadMap(Data) then - begin + try + map := g_Map_ParseMap(Data, Len); + except FreeMem(Data); - MapReader.Free(); - FMapSize.X := 0; - FMapSize.Y := 0; - FScale := 0.0; - FMapData := nil; - Exit; + map.Free(); + //raise; + exit; end; FreeMem(Data); - panels := MapReader.GetPanels(); - header := MapReader.GetMapHeader(); + if (map = nil) then exit; - FMapSize.X := header.Width div 16; - FMapSize.Y := header.Height div 16; + try + panlist := map.field['panel']; + //header := GetMapHeader(map); - rX := Ceil(header.Width / (MAPPREVIEW_WIDTH*256.0)); - rY := Ceil(header.Height / (MAPPREVIEW_HEIGHT*256.0)); - FScale := max(rX, rY); + FMapSize.X := map.Width div 16; + FMapSize.Y := map.Height div 16; - FMapData := nil; + rX := Ceil(map.Width / (MAPPREVIEW_WIDTH*256.0)); + rY := Ceil(map.Height / (MAPPREVIEW_HEIGHT*256.0)); + FScale := max(rX, rY); + + FMapData := nil; - if panels <> nil then - for a := 0 to High(panels) do - if WordBool(panels[a].PanelType and (PANEL_WALL or PANEL_CLOSEDOOR or - PANEL_STEP or PANEL_WATER or - PANEL_ACID1 or PANEL_ACID2)) then + if (panlist <> nil) then + begin + for pan in panlist do begin - SetLength(FMapData, Length(FMapData)+1); - with FMapData[High(FMapData)] do + if (pan.PanelType and (PANEL_WALL or PANEL_CLOSEDOOR or + PANEL_STEP or PANEL_WATER or + PANEL_ACID1 or PANEL_ACID2)) <> 0 then begin - X1 := panels[a].X div 16; - Y1 := panels[a].Y div 16; + SetLength(FMapData, Length(FMapData)+1); + with FMapData[High(FMapData)] do + begin + X1 := pan.X div 16; + Y1 := pan.Y div 16; - X2 := (panels[a].X + panels[a].Width) div 16; - Y2 := (panels[a].Y + panels[a].Height) div 16; + X2 := (pan.X + pan.Width) div 16; + Y2 := (pan.Y + pan.Height) div 16; - X1 := Trunc(X1/FScale + 0.5); - Y1 := Trunc(Y1/FScale + 0.5); - X2 := Trunc(X2/FScale + 0.5); - Y2 := Trunc(Y2/FScale + 0.5); + X1 := Trunc(X1/FScale + 0.5); + Y1 := Trunc(Y1/FScale + 0.5); + X2 := Trunc(X2/FScale + 0.5); + Y2 := Trunc(Y2/FScale + 0.5); - if (X1 <> X2) or (Y1 <> Y2) then - begin - if X1 = X2 then - X2 := X2 + 1; - if Y1 = Y2 then - Y2 := Y2 + 1; - end; + if (X1 <> X2) or (Y1 <> Y2) then + begin + if X1 = X2 then + X2 := X2 + 1; + if Y1 = Y2 then + Y2 := Y2 + 1; + end; - PanelType := panels[a].PanelType; + PanelType := pan.PanelType; + end; + end; end; - end; - - panels := nil; - - MapReader.Free(); + end; + finally + //writeln('freeing map'); + map.Free(); + end; end; procedure TGUIMapPreview.ClearMap(); @@ -2540,10 +2573,18 @@ begin SetLength(FItems, Length(FItems)+1); FItems[High(FItems)] := Item; - if FSort then g_Basic.Sort(FItems); + if FSort then g_gui.Sort(FItems); end; -procedure TGUIListBox.Clear(); +function TGUIListBox.ItemExists (item: String): Boolean; + var i: Integer; +begin + i := 0; + while (i <= High(FItems)) and (FItems[i] <> item) do Inc(i); + result := i <= High(FItems) +end; + +procedure TGUIListBox.Clear; begin FItems := nil; @@ -2551,12 +2592,11 @@ begin FIndex := -1; end; -constructor TGUIListBox.Create(FontID: DWORD; Width, Height: Word); +constructor TGUIListBox.Create(BigFont: Boolean; Width, Height: Word); begin inherited Create(); - FFont := TFont.Create(FontID, FONT_CHAR); - + FBigFont := BigFont; FWidth := Width; FHeight := Height; FIndex := -1; @@ -2565,48 +2605,6 @@ begin FDrawScroll := True; end; -procedure TGUIListBox.Draw; -var - w2, h2: Word; - a: Integer; - s: string; -begin - inherited; - - if FDrawBack then DrawBox(FX, FY, FWidth+1, FHeight); - if FDrawScroll then - DrawScroll(FX+4+FWidth*16, FY+4, FHeight, (FStartLine > 0) and (FItems <> nil), - (FStartLine+FHeight-1 < High(FItems)) and (FItems <> nil)); - - if FItems <> nil then - for a := FStartLine to Min(High(FItems), FStartLine+FHeight-1) do - begin - s := Items[a]; - - FFont.GetTextSize(s, w2, h2); - while (Length(s) > 0) and (w2 > FWidth*16) do - begin - SetLength(s, Length(s)-1); - FFont.GetTextSize(s, w2, h2); - end; - - if a = FIndex then - FFont.Draw(FX+4, FY+4+(a-FStartLine)*16, s, FActiveColor.R, FActiveColor.G, FActiveColor.B) - else - FFont.Draw(FX+4, FY+4+(a-FStartLine)*16, s, FUnActiveColor.R, FUnActiveColor.G, FUnActiveColor.B); - end; -end; - -function TGUIListBox.GetHeight: Word; -begin - Result := 8+FHeight*16; -end; - -function TGUIListBox.GetWidth: Word; -begin - Result := 8+(FWidth+1)*16; -end; - procedure TGUIListBox.OnMessage(var Msg: TMessage); var a: Integer; @@ -2631,21 +2629,21 @@ begin FIndex := High(FItems); FStartLine := Max(High(FItems)-FHeight+1, 0); end; - IK_UP, IK_LEFT, IK_KPUP, IK_KPLEFT: + IK_UP, IK_LEFT, IK_KPUP, IK_KPLEFT, VK_LEFT, JOY0_LEFT, JOY1_LEFT, JOY2_LEFT, JOY3_LEFT: if FIndex > 0 then begin Dec(FIndex); if FIndex < FStartLine then Dec(FStartLine); if @FOnChangeEvent <> nil then FOnChangeEvent(Self); end; - IK_DOWN, IK_RIGHT, IK_KPDOWN, IK_KPRIGHT: + IK_DOWN, IK_RIGHT, IK_KPDOWN, IK_KPRIGHT, VK_RIGHT, JOY0_RIGHT, JOY1_RIGHT, JOY2_RIGHT, JOY3_RIGHT: if FIndex < High(FItems) then begin Inc(FIndex); if FIndex > FStartLine+FHeight-1 then Inc(FStartLine); if @FOnChangeEvent <> nil then FOnChangeEvent(Self); end; - IK_RETURN, IK_KPRETURN: + IK_RETURN, IK_KPRETURN, VK_FIRE, VK_OPEN, JOY0_ATTACK, JOY1_ATTACK, JOY2_ATTACK, JOY3_ATTACK: with FWindow do begin if FActiveControl <> Self then SetActive(Self) @@ -2677,7 +2675,7 @@ begin Result := FItems[FIndex]; end; -procedure TGUIListBox.FSetItems(Items: SArray); +procedure TGUIListBox.FSetItems(Items: SSArray); begin if FItems <> nil then FItems := nil; @@ -2687,7 +2685,7 @@ begin FStartLine := 0; FIndex := -1; - if FSort then g_Basic.Sort(FItems); + if FSort then g_gui.Sort(FItems); end; procedure TGUIListBox.SelectItem(Item: String); @@ -2733,7 +2731,7 @@ end; procedure TGUIFileListBox.OnMessage(var Msg: TMessage); var - a: Integer; + a, b: Integer; s: AnsiString; begin if not FEnabled then Exit; @@ -2787,7 +2785,7 @@ begin FStartLine := High(FItems)-FHeight+1; end; - IK_UP, IK_LEFT, IK_KPUP, IK_KPLEFT: + IK_UP, IK_LEFT, IK_KPUP, IK_KPLEFT, VK_UP, VK_LEFT, JOY0_LEFT, JOY1_LEFT, JOY2_LEFT, JOY3_LEFT: if FIndex > 0 then begin Dec(FIndex); @@ -2797,7 +2795,7 @@ begin FOnChangeEvent(Self); end; - IK_DOWN, IK_RIGHT, IK_KPDOWN, IK_KPRIGHT: + IK_DOWN, IK_RIGHT, IK_KPDOWN, IK_KPRIGHT, VK_DOWN, VK_RIGHT, JOY0_RIGHT, JOY1_RIGHT, JOY2_RIGHT, JOY3_RIGHT: if FIndex < High(FItems) then begin Inc(FIndex); @@ -2807,7 +2805,7 @@ begin FOnChangeEvent(Self); end; - IK_RETURN, IK_KPRETURN: + IK_RETURN, IK_KPRETURN, VK_FIRE, VK_OPEN, JOY0_ATTACK, JOY1_ATTACK, JOY2_ATTACK, JOY3_ATTACK: with FWindow do begin if FActiveControl <> Self then @@ -2816,7 +2814,18 @@ begin begin if FItems[FIndex][1] = #29 then // Ïàïêà begin - OpenDir(FPath+Copy(FItems[FIndex], 2, 255)); + if FItems[FIndex] = #29 + '..' then + begin + e_LogWritefln('TGUIFileListBox: Upper dir "%s" -> "%s"', [FSubPath, e_UpperDir(FSubPath)]); + FSubPath := e_UpperDir(FSubPath) + end + else + begin + s := Copy(AnsiString(FItems[FIndex]), 2); + e_LogWritefln('TGUIFileListBox: Enter dir "%s" -> "%s"', [FSubPath, e_CatPath(FSubPath, s)]); + FSubPath := e_CatPath(FSubPath, s); + end; + ScanDirs; FIndex := 0; Exit; end; @@ -2830,7 +2839,9 @@ begin end; WM_CHAR: - for a := 0 to High(FItems) do + for b := FIndex + 1 to High(FItems) + FIndex do + begin + a := b mod Length(FItems); if ( (Length(FItems[a]) > 0) and (LowerCase(FItems[a][1]) = LowerCase(Chr(wParam))) ) or ( (Length(FItems[a]) > 1) and @@ -2843,73 +2854,82 @@ begin FOnChangeEvent(Self); Break; end; + end; end; end; -procedure TGUIFileListBox.OpenDir(path: String); -var - SR: TSearchRec; - i: Integer; - sm, sc: string; +procedure TGUIFileListBox.ScanDirs; + var i, j: Integer; path: AnsiString; SR: TSearchRec; sm, sc: String; begin - Clear(); + Clear; - path := IncludeTrailingPathDelimiter(path); - path := ExpandFileName(path); - - // Êàòàëîãè: - if FDirs then + i := High(FBaseList); + while i >= 0 do begin - if FindFirst(path+'*', faDirectory, SR) = 0 then - repeat - if not LongBool(SR.Attr and faDirectory) then - Continue; - if (SR.Name = '.') or - ((SR.Name = '..') and (path = ExpandFileName(FBasePath))) then - Continue; - - AddItem(#1 + SR.Name); - until FindNext(SR) <> 0; - - FindClose(SR); + path := e_CatPath(FBaseList[i], FSubPath); + if FDirs then + begin + if FindFirst(path + '/' + '*', faDirectory, SR) = 0 then + begin + repeat + if LongBool(SR.Attr and faDirectory) then + if (SR.Name <> '.') and ((FSubPath <> '') or (SR.Name <> '..')) then + if Self.ItemExists(#1 + SR.Name) = false then + Self.AddItem(#1 + SR.Name) + until FindNext(SR) <> 0 + end; + FindClose(SR) + end; + Dec(i) end; - // Ôàéëû: - sm := FFileMask; - while sm <> '' do + i := High(FBaseList); + while i >= 0 do begin - i := Pos('|', sm); - if i = 0 then i := length(sm)+1; - sc := Copy(sm, 1, i-1); - Delete(sm, 1, i); - if FindFirst(path+sc, faAnyFile, SR) = 0 then repeat AddItem(SR.Name); until FindNext(SR) <> 0; - FindClose(SR); + path := e_CatPath(FBaseList[i], FSubPath); + sm := FFileMask; + while sm <> '' do + begin + j := Pos('|', sm); + if j = 0 then + j := length(sm) + 1; + sc := Copy(sm, 1, j - 1); + Delete(sm, 1, j); + if FindFirst(path + '/' + sc, faAnyFile, SR) = 0 then + begin + repeat + if Self.ItemExists(SR.Name) = false then + AddItem(SR.Name) + until FindNext(SR) <> 0 + end; + FindClose(SR) + end; + Dec(i) end; for i := 0 to High(FItems) do if FItems[i][1] = #1 then FItems[i][1] := #29; - - FPath := path; end; -procedure TGUIFileListBox.SetBase(path: String); +procedure TGUIFileListBox.SetBase (dirs: SSArray; path: String = ''); begin - FBasePath := path; - OpenDir(FBasePath); + FBaseList := dirs; + FSubPath := path; + ScanDirs end; -function TGUIFileListBox.SelectedItem(): String; +function TGUIFileListBox.SelectedItem (): String; + var s: AnsiString; begin - Result := ''; - - if (FIndex = -1) or (FItems = nil) or - (FIndex > High(FItems)) or - (FItems[FIndex][1] = '/') or - (FItems[FIndex][1] = '\') then - Exit; - - Result := FPath + FItems[FIndex]; + result := ''; + if (FIndex >= 0) and (FIndex <= High(FItems)) and (FItems[FIndex][1] <> '/') and (FItems[FIndex][1] <> '\') then + begin + s := e_CatPath(FSubPath, FItems[FIndex]); + if e_FindResource(FBaseList, s) = true then + result := ExpandFileName(s) + end; + e_LogWritefln('TGUIFileListBox.SelectedItem -> "%s"', [result]); end; procedure TGUIFileListBox.UpdateFileList(); @@ -2924,7 +2944,8 @@ begin else fn := FItems[FIndex]; - OpenDir(FPath); +// OpenDir(FPath); + ScanDirs; if fn <> '' then SelectItem(fn); @@ -2938,44 +2959,17 @@ begin FStartLine := 0; end; -constructor TGUIMemo.Create(FontID: DWORD; Width, Height: Word); +constructor TGUIMemo.Create(BigFont: Boolean; Width, Height: Word); begin inherited Create(); - FFont := TFont.Create(FontID, FONT_CHAR); - + FBigFont := BigFont; FWidth := Width; FHeight := Height; FDrawBack := True; FDrawScroll := True; end; -procedure TGUIMemo.Draw; -var - a: Integer; -begin - inherited; - - if FDrawBack then DrawBox(FX, FY, FWidth+1, FHeight); - if FDrawScroll then - DrawScroll(FX+4+FWidth*16, FY+4, FHeight, (FStartLine > 0) and (FLines <> nil), - (FStartLine+FHeight-1 < High(FLines)) and (FLines <> nil)); - - if FLines <> nil then - for a := FStartLine to Min(High(FLines), FStartLine+FHeight-1) do - FFont.Draw(FX+4, FY+4+(a-FStartLine)*16, FLines[a], FColor.R, FColor.G, FColor.B); -end; - -function TGUIMemo.GetHeight: Word; -begin - Result := 8+FHeight*16; -end; - -function TGUIMemo.GetWidth: Word; -begin - Result := 8+(FWidth+1)*16; -end; - procedure TGUIMemo.OnMessage(var Msg: TMessage); begin if not FEnabled then Exit; @@ -2988,13 +2982,13 @@ begin case Msg of WM_KEYDOWN: case wParam of - IK_UP, IK_LEFT, IK_KPUP, IK_KPLEFT: + IK_UP, IK_LEFT, IK_KPUP, IK_KPLEFT, VK_UP, VK_LEFT, JOY0_LEFT, JOY1_LEFT, JOY2_LEFT, JOY3_LEFT: if FStartLine > 0 then Dec(FStartLine); - IK_DOWN, IK_RIGHT, IK_KPDOWN, IK_KPRIGHT: + IK_DOWN, IK_RIGHT, IK_KPDOWN, IK_KPRIGHT, VK_DOWN, VK_RIGHT, JOY0_RIGHT, JOY1_RIGHT, JOY2_RIGHT, JOY3_RIGHT: if FStartLine < Length(FLines)-FHeight then Inc(FStartLine); - IK_RETURN, IK_KPRETURN: + IK_RETURN, IK_KPRETURN, VK_FIRE, VK_OPEN, JOY0_ATTACK, JOY1_ATTACK, JOY2_ATTACK, JOY3_ATTACK: with FWindow do begin if FActiveControl <> Self then @@ -3013,16 +3007,13 @@ end; procedure TGUIMemo.SetText(Text: string); begin FStartLine := 0; - FLines := GetLines(Text, FFont.ID, FWidth*16); + FLines := GetLines(Text, FBigFont, FWidth * 16); end; { TGUIimage } procedure TGUIimage.ClearImage(); begin - if FImageRes = '' then Exit; - - g_Texture_Delete(FImageRes); FImageRes := ''; end; @@ -3038,20 +3029,6 @@ begin inherited; end; -procedure TGUIimage.Draw(); -var - ID: DWORD; -begin - inherited; - - if FImageRes = '' then - begin - if g_Texture_Get(FDefaultRes, ID) then e_Draw(ID, FX, FY, 0, True, False); - end - else - if g_Texture_Get(FImageRes, ID) then e_Draw(ID, FX, FY, 0, True, False); -end; - procedure TGUIimage.OnMessage(var Msg: TMessage); begin inherited; @@ -3059,9 +3036,7 @@ end; procedure TGUIimage.SetImage(Res: string); begin - ClearImage(); - - if g_Texture_CreateWADEx(Res, Res) then FImageRes := Res; + FImageRes := Res; end; procedure TGUIimage.Update();