summary | shortlog | log | commit | commitdiff | tree
raw | patch | inline | side by side (parent: 97ca06f)
raw | patch | inline | side by side (parent: 97ca06f)
| author | Ketmar Dark <ketmar@ketmar.no-ip.org> | |
| Thu, 28 Sep 2017 23:28:23 +0000 (02:28 +0300) | ||
| committer | Ketmar Dark <ketmar@ketmar.no-ip.org> | |
| Thu, 28 Sep 2017 23:30:18 +0000 (02:30 +0300) |
diff --git a/src/game/g_holmes.pas b/src/game/g_holmes.pas
index cf6a2bdbca084623e91ff9c2a06968f4746a6604..79c4349a32a98180e1be54c1ee5524f99d5b2a16 100644 (file)
--- a/src/game/g_holmes.pas
+++ b/src/game/g_holmes.pas
procedure g_Holmes_Draw ();
procedure g_Holmes_DrawUI ();
-function g_Holmes_MouseEvent (var ev: THMouseEvent): Boolean; // returns `true` if event was eaten
-function g_Holmes_KeyEvent (var ev: THKeyEvent): Boolean; // returns `true` if event was eaten
+procedure g_Holmes_MouseEvent (var ev: THMouseEvent);
+procedure g_Holmes_KeyEvent (var ev: THKeyEvent);
// hooks for player
procedure g_Holmes_plrViewPos (viewPortX, viewPortY: Integer);
// ////////////////////////////////////////////////////////////////////////// //
-function g_Holmes_MouseEvent (var ev: THMouseEvent): Boolean;
+procedure g_Holmes_MouseEvent (var ev: THMouseEvent);
var
he: THMouseEvent;
begin
- if g_Game_IsNet then begin result := false; exit; end;
- if not g_holmes_enabled then begin result := false; exit; end;
+ if g_Game_IsNet then exit;
+ if not g_holmes_enabled then exit;
holmesInitCommands();
holmesInitBinds();
- result := true;
msX := ev.x;
msY := ev.y;
msB := ev.bstate;
he := ev;
he.x := he.x;
he.y := he.y;
- if not uiMouseEvent(he) then plrDebugMouse(he);
+ uiMouseEvent(he);
+ if (not he.eaten) then plrDebugMouse(he);
+ ev.eat();
end;
// ////////////////////////////////////////////////////////////////////////// //
-function g_Holmes_KeyEvent (var ev: THKeyEvent): Boolean;
-{$IF DEFINED(D2F_DEBUG)}
+procedure g_Holmes_KeyEvent (var ev: THKeyEvent);
var
+ doeat: Boolean = false;
+{$IF DEFINED(D2F_DEBUG)}
pan: TPanel;
ex, ey: Integer;
dx, dy: Integer;
end;
begin
- if g_Game_IsNet then begin result := false; exit; end;
- if not g_holmes_enabled then begin result := false; exit; end;
+ if g_Game_IsNet then exit;
+ if not g_holmes_enabled then exit;
holmesInitCommands();
holmesInitBinds();
- result := false;
+
msB := ev.bstate;
kbS := ev.kstate;
case ev.scan of
SDL_SCANCODE_LCTRL, SDL_SCANCODE_RCTRL,
SDL_SCANCODE_LALT, SDL_SCANCODE_RALT,
SDL_SCANCODE_LSHIFT, SDL_SCANCODE_RSHIFT:
- result := true;
+ doeat := true;
end;
- if uiKeyEvent(ev) then begin result := true; exit; end;
- if keybindExecute(ev) then begin result := true; exit; end;
+
+ uiKeyEvent(ev);
+ if (ev.eaten) then exit;
+ if keybindExecute(ev) then begin ev.eat(); exit; end;
// press
if (ev.press) then
begin
if ((ev.scan = SDL_SCANCODE_UP) or (ev.scan = SDL_SCANCODE_DOWN) or (ev.scan = SDL_SCANCODE_LEFT) or (ev.scan = SDL_SCANCODE_RIGHT)) and
((ev.kstate and THKeyEvent.ModCtrl) <> 0) then
begin
- result := true;
+ ev.eat();
dx := pmsCurMapX;
dy := pmsCurMapY;
case ev.scan of
end;
{$ENDIF}
end;
+ if (doeat) then ev.eat();
end;
end;
-function onMouseEvent (var ev: THMouseEvent): Boolean;
+procedure onMouseEvent (var ev: THMouseEvent);
begin
- result := g_Holmes_MouseEvent(ev);
+ if not g_holmes_enabled then exit;
+ g_Holmes_MouseEvent(ev);
end;
-function onKeyEvent (var ev: THKeyEvent): Boolean;
+procedure onKeyEvent (var ev: THKeyEvent);
begin
- if not g_holmes_enabled then begin result := false; exit; end;
- result := g_Holmes_keyEvent(ev);
+ if not g_holmes_enabled then exit;
+ g_Holmes_KeyEvent(ev);
end;
diff --git a/src/game/g_main.pas b/src/game/g_main.pas
index 4e10356760d4b2e00a0e23d08083328120139343..94762c9be1f59e69f6716da4afc3def5221cf882 100644 (file)
--- a/src/game/g_main.pas
+++ b/src/game/g_main.pas
interface
-procedure Main();
-procedure Init();
-procedure Release();
-procedure Update();
-procedure Draw();
-procedure KeyPress(K: Word);
-procedure CharPress(C: Char);
+procedure Main ();
+procedure Init ();
+procedure Release ();
+procedure Update ();
+procedure Draw ();
+procedure KeyPress (K: Word);
+procedure CharPress (C: AnsiChar);
var
GameDir: string;
ModelsDir: string;
GameWAD: string;
+
implementation
uses
g_menu, g_language, g_net,
utils, conbuf, envvars;
+
var
- charbuff: Array [0..15] of Char;
+ charbuff: packed array [0..15] of AnsiChar;
procedure Main();
var
procedure Init();
var
- a: Integer;
NoSound: Boolean;
begin
Randomize;
e_WriteLog('Init game', TMsgType.Notify);
g_Game_Init();
- for a := 0 to 15 do charbuff[a] := ' ';
+ FillChar(charbuff, sizeof(charbuff), ' ');
end;
+
procedure Release();
begin
e_WriteLog('Releasing engine', TMsgType.Notify);
end;
end;
-procedure Update();
+
+procedure Update ();
begin
g_Game_Update();
end;
-procedure Draw();
+
+procedure Draw ();
begin
g_Game_Draw();
end;
-function Translit(S: String): String;
+
+function Translit (const S: AnsiString): AnsiString;
var
i: Integer;
begin
Result := S;
for i := 1 to Length(Result) do
+ begin
case Result[i] of
'É': Result[i] := 'Q';
'Ö': Result[i] := 'W';
'Á': Result[i] := ','; //Chr(188);
'Þ': Result[i] := '.'; //Chr(190);
end;
+ end;
end;
end;
-procedure Cheat();
+procedure Cheat ();
const
CHEAT_DAMAGE = 500;
label
g_Sound_PlayEx(s);
end;
-procedure KeyPress(K: Word);
+
+procedure KeyPress (K: Word);
var
Msg: g_gui.TMessage;
begin
case K of
IK_PAUSE: // <Pause/Break>:
begin
- if (g_ActiveWindow = nil) then
- g_Game_Pause(not gPause);
+ if (g_ActiveWindow = nil) then g_Game_Pause(not gPause);
end;
IK_BACKQUOTE: // <`/~/¨/¸>:
end;
if gConsoleShow then
- g_Console_Switch()
- else
- if g_ActiveWindow <> nil then
+ begin
+ g_Console_Switch();
+ end
+ else if (g_ActiveWindow <> nil) then
+ begin
+ Msg.Msg := WM_KEYDOWN;
+ Msg.WParam := IK_ESCAPE;
+ g_ActiveWindow.OnMessage(Msg);
+ end
+ else if (gState <> STATE_FOLD) then
+ begin
+ if gGameOn or (gState = STATE_INTERSINGLE) or (gState = STATE_INTERCUSTOM) then
+ begin
+ g_Game_InGameMenu(True);
+ end
+ else if (gExit = 0) and (gState <> STATE_SLIST) then
+ begin
+ if (gState <> STATE_MENU) then
begin
- Msg.Msg := WM_KEYDOWN;
- Msg.WParam := IK_ESCAPE;
- g_ActiveWindow.OnMessage(Msg);
- end
- else
- if gState <> STATE_FOLD then
- if gGameOn
- or (gState = STATE_INTERSINGLE)
- or (gState = STATE_INTERCUSTOM)
- then
- g_Game_InGameMenu(True)
- else
- if (gExit = 0) and (gState <> STATE_SLIST) then
- begin
- if gState <> STATE_MENU then
- if NetMode <> NET_NONE then
- begin
- g_Game_StopAllSounds(True);
- g_Game_Free;
- gState := STATE_MENU;
- Exit;
- end;
-
- g_GUI_ShowWindow('MainMenu');
- g_Sound_PlayEx('MENU_OPEN');
- end;
+ if (NetMode <> NET_NONE) then
+ begin
+ g_Game_StopAllSounds(True);
+ g_Game_Free;
+ gState := STATE_MENU;
+ Exit;
+ end;
+ end;
+ g_GUI_ShowWindow('MainMenu');
+ g_Sound_PlayEx('MENU_OPEN');
+ end;
+ end;
end;
IK_F2, IK_F3, IK_F4, IK_F5, IK_F6, IK_F7, IK_F10:
begin // <F2> .. <F6> � <F12>
if gGameOn and (not gConsoleShow) and (not gChatShow) then
begin
- while g_ActiveWindow <> nil do
- g_GUI_HideWindow(False);
-
- if (not g_Game_IsNet) then
- g_Game_Pause(True);
-
+ while g_ActiveWindow <> nil do g_GUI_HideWindow(False);
+ if (not g_Game_IsNet) then g_Game_Pause(True);
case K of
- IK_F2:
- g_Menu_Show_SaveMenu();
- IK_F3:
- g_Menu_Show_LoadMenu();
- IK_F4:
- g_Menu_Show_GameSetGame();
- IK_F5:
- g_Menu_Show_OptionsVideo();
- IK_F6:
- g_Menu_Show_OptionsSound();
- IK_F7:
- g_Menu_Show_EndGameMenu();
- IK_F10:
- g_Menu_Show_QuitGameMenu();
+ IK_F2: g_Menu_Show_SaveMenu();
+ IK_F3: g_Menu_Show_LoadMenu();
+ IK_F4: g_Menu_Show_GameSetGame();
+ IK_F5: g_Menu_Show_OptionsVideo();
+ IK_F6: g_Menu_Show_OptionsSound();
+ IK_F7: g_Menu_Show_EndGameMenu();
+ IK_F10: g_Menu_Show_QuitGameMenu();
end;
end;
end;
begin
gJustChatted := False;
if gConsoleShow or gChatShow then
- g_Console_Control(K)
- else
- if g_ActiveWindow <> nil then
- begin
- Msg.Msg := WM_KEYDOWN;
- Msg.WParam := K;
- g_ActiveWindow.OnMessage(Msg);
- end
- else
- begin
- if (gState = STATE_MENU) then
- begin
- g_GUI_ShowWindow('MainMenu');
- g_Sound_PlayEx('MENU_OPEN');
- end;
- end;
+ begin
+ g_Console_Control(K);
+ end
+ else if (g_ActiveWindow <> nil) then
+ begin
+ Msg.Msg := WM_KEYDOWN;
+ Msg.WParam := K;
+ g_ActiveWindow.OnMessage(Msg);
+ end
+ else if (gState = STATE_MENU) then
+ begin
+ g_GUI_ShowWindow('MainMenu');
+ g_Sound_PlayEx('MENU_OPEN');
+ end;
end;
end;
end;
-procedure CharPress(C: Char);
+
+procedure CharPress (C: AnsiChar);
var
Msg: g_gui.TMessage;
a: Integer;
begin
- if (not gChatShow) and ((C = '`') or (C = '~') or (C = '¸') or (C = '¨')) then
- Exit;
+ if (not gChatShow) and ((C = '`') or (C = '~') or (C = '¸') or (C = '¨')) then Exit;
if gConsoleShow or gChatShow then
- g_Console_Char(C)
+ begin
+ g_Console_Char(C);
+ end
+ else if (g_ActiveWindow <> nil) then
+ begin
+ Msg.Msg := WM_CHAR;
+ Msg.WParam := Ord(C);
+ g_ActiveWindow.OnMessage(Msg);
+ end
else
- if g_ActiveWindow <> nil then
- begin
- Msg.Msg := WM_CHAR;
- Msg.WParam := Ord(C);
- g_ActiveWindow.OnMessage(Msg);
- end
- else
- begin
- for a := 0 to 14 do charbuff[a] := charbuff[a+1];
- charbuff[15] := UpCase1251(C);
- Cheat();
- end;
+ begin
+ for a := 0 to 14 do charbuff[a] := charbuff[a+1];
+ charbuff[15] := upcase1251(C);
+ Cheat();
+ end;
end;
+
end.
diff --git a/src/game/g_window.pas b/src/game/g_window.pas
index 12a038f68950f620a4c804e6d7d7078b65b60946..1db0c639efbfe27713abca1491ad2723fc4de1d5 100644 (file)
--- a/src/game/g_window.pas
+++ b/src/game/g_window.pas
Utf8ToUnicode(@uc, PChar(ev.text.text), 1);
keychr := Word(uc);
if (keychr > 127) then keychr := Word(wchar2win(WideChar(keychr)));
- CharPress(AnsiChar(keychr));
+ if (keychr > 0) and (keychr <= 255) then CharPress(AnsiChar(keychr));
end;
// other key presses and joysticks are handled in e_input
diff --git a/src/gx/gh_ui.pas b/src/gx/gh_ui.pas
index be597b0dfbb75b933b1ed816eca27470b6d1eb10..b23362bdb35207813803c6fc5682483ac94fd6de 100644 (file)
--- a/src/gx/gh_ui.pas
+++ b/src/gx/gh_ui.pas
TUIControl = class
public
type TActionCB = procedure (me: TUIControl; uinfo: Integer);
+ type TCloseRequestCB = function (me: TUIControl): Boolean; // top-level windows will call this before closing with icon/keyboard
public
const ClrIdxActive = 0;
mCanFocus: Boolean;
mChildren: array of TUIControl;
mFocused: TUIControl; // valid only for top-level controls
- mGrab: TUIControl; // valid only for top-level controls
mEscClose: Boolean; // valid only for top-level controls
mEatKeys: Boolean;
mDrawShadow: Boolean;
+ mCancel: Boolean;
+ mDefault: Boolean;
// colors
mCtl4Style: AnsiString;
mBackColor: array[0..ClrIdxMax] of TGxRGBA;
function getFocused (): Boolean; inline;
procedure setFocused (v: Boolean); inline;
+ function getCanFocus (): Boolean; inline;
+
function isMyChild (ctl: TUIControl): Boolean;
function findFirstFocus (): TUIControl;
function findNextFocus (cur: TUIControl): TUIControl;
function findPrevFocus (cur: TUIControl): TUIControl;
+ function findCancelControl (): TUIControl;
+ function findDefaulControl (): TUIControl;
+
+ function findControlById (const aid: AnsiString): TUIControl;
+
procedure activated (); virtual;
procedure blurred (); virtual;
public
actionCB: TActionCB;
+ closeRequestCB: TCloseRequestCB;
private
mDefSize: TLaySize; // default size
procedure toGlobal (lx, ly: Integer; out x, y: Integer); inline;
// x and y are global coords
- function controlAtXY (x, y: Integer): TUIControl;
+ function controlAtXY (x, y: Integer; allowDisabled: Boolean=false): TUIControl;
+
+ procedure doAction ();
- function mouseEvent (var ev: THMouseEvent): Boolean; virtual; // returns `true` if event was eaten
- function keyEvent (var ev: THKeyEvent): Boolean; virtual; // returns `true` if event was eaten
+ procedure mouseEvent (var ev: THMouseEvent); virtual; // returns `true` if event was eaten
+ procedure keyEvent (var ev: THKeyEvent); virtual; // returns `true` if event was eaten
function prevSibling (): TUIControl;
function nextSibling (): TUIControl;
procedure appendChild (ctl: TUIControl); virtual;
+ procedure close (); // this closes *top-level* control
+
public
property id: AnsiString read mId;
property styleId: AnsiString read mStyleId;
property focused: Boolean read getFocused write setFocused;
property escClose: Boolean read mEscClose write mEscClose;
property eatKeys: Boolean read mEatKeys write mEatKeys;
+ property cancel: Boolean read mCancel write mCancel;
+ property defctl: Boolean read mDefault write mDefault;
+ property canFocus: Boolean read getCanFocus write mCanFocus;
+ property ctlById[const aid: AnsiString]: TUIControl read findControlById; default;
end;
procedure drawControl (gx, gy: Integer); override;
procedure drawControlPost (gx, gy: Integer); override;
- function keyEvent (var ev: THKeyEvent): Boolean; override; // returns `true` if event was eaten
- function mouseEvent (var ev: THMouseEvent): Boolean; override; // returns `true` if event was eaten
+ procedure keyEvent (var ev: THKeyEvent); override; // returns `true` if event was eaten
+ procedure mouseEvent (var ev: THMouseEvent); override; // returns `true` if event was eaten
public
property freeOnClose: Boolean read mFreeOnClose write mFreeOnClose;
procedure drawControl (gx, gy: Integer); override;
- function mouseEvent (var ev: THMouseEvent): Boolean; override;
- function keyEvent (var ev: THKeyEvent): Boolean; override;
+ procedure mouseEvent (var ev: THMouseEvent); override;
end;
procedure drawControl (gx, gy: Integer); override;
- function mouseEvent (var ev: THMouseEvent): Boolean; override;
- function keyEvent (var ev: THKeyEvent): Boolean; override;
+ procedure mouseEvent (var ev: THMouseEvent); override;
+ procedure keyEvent (var ev: THKeyEvent); override;
end;
// ////////////////////////////////////////////////////////////////////// //
procedure drawControl (gx, gy: Integer); override;
- function mouseEvent (var ev: THMouseEvent): Boolean; override;
- function keyEvent (var ev: THKeyEvent): Boolean; override;
+ procedure mouseEvent (var ev: THMouseEvent); override;
+ procedure keyEvent (var ev: THKeyEvent); override;
end;
TUIHBox = class(TUIBox)
procedure drawControl (gx, gy: Integer); override;
- function mouseEvent (var ev: THMouseEvent): Boolean; override;
- function keyEvent (var ev: THKeyEvent): Boolean; override;
+ procedure mouseEvent (var ev: THMouseEvent); override;
+ end;
+
+ // ////////////////////////////////////////////////////////////////////// //
+ TUIButton = class(TUITextLabel)
+ public
+ constructor Create (const atext: AnsiString);
+
+ procedure AfterConstruction (); override; // so it will be correctly initialized when created from parser
+
+ function parseProperty (const prname: AnsiString; par: TTextParser): Boolean; override;
+
+ procedure drawControl (gx, gy: Integer); override;
+
+ procedure mouseEvent (var ev: THMouseEvent); override;
+ procedure keyEvent (var ev: THKeyEvent); override;
end;
// ////////////////////////////////////////////////////////////////////////// //
-function uiMouseEvent (ev: THMouseEvent): Boolean;
-function uiKeyEvent (ev: THKeyEvent): Boolean;
+procedure uiMouseEvent (var evt: THMouseEvent);
+procedure uiKeyEvent (var evt: THKeyEvent);
procedure uiDraw ();
utils;
+// ////////////////////////////////////////////////////////////////////////// //
+var
+ ctlsToKill: array of TUIControl = nil;
+
+
+procedure scheduleKill (ctl: TUIControl);
+var
+ f: Integer;
+begin
+ if (ctl = nil) then exit;
+ ctl := ctl.topLevel;
+ for f := 0 to High(ctlsToKill) do
+ begin
+ if (ctlsToKill[f] = ctl) then exit;
+ if (ctlsToKill[f] = nil) then begin ctlsToKill[f] := ctl; exit; end;
+ end;
+ SetLength(ctlsToKill, Length(ctlsToKill)+1);
+ ctlsToKill[High(ctlsToKill)] := ctl;
+end;
+
+
+procedure processKills ();
+var
+ f: Integer;
+ ctl: TUIControl;
+begin
+ for f := 0 to High(ctlsToKill) do
+ begin
+ ctl := ctlsToKill[f];
+ if (ctl = nil) then break;
+ ctlsToKill[f] := nil;
+ FreeAndNil(ctl);
+ end;
+ if (Length(ctlsToKill) > 0) then ctlsToKill[0] := nil; // just in case
+end;
+
+
// ////////////////////////////////////////////////////////////////////////// //
var
knownCtlClasses: array of record
// ////////////////////////////////////////////////////////////////////////// //
var
uiTopList: array of TUIControl = nil;
+ uiGrabCtl: TUIControl = nil;
procedure uiUpdateStyles ();
end;
-function uiMouseEvent (ev: THMouseEvent): Boolean;
+procedure uiMouseEvent (var evt: THMouseEvent);
var
+ ev: THMouseEvent;
f, c: Integer;
lx, ly: Integer;
ctmp: TUIControl;
begin
+ processKills();
+ if (evt.eaten) or (evt.cancelled) then exit;
+ ev := evt;
ev.x := trunc(ev.x/gh_ui_scale);
ev.y := trunc(ev.y/gh_ui_scale);
ev.dx := trunc(ev.dx/gh_ui_scale); //FIXME
ev.dy := trunc(ev.dy/gh_ui_scale); //FIXME
- if (Length(uiTopList) = 0) then result := false else result := uiTopList[High(uiTopList)].mouseEvent(ev);
- if not result and (ev.press) then
- begin
- for f := High(uiTopList) downto 0 do
+ try
+ if (uiGrabCtl <> nil) then
begin
- if uiTopList[f].toLocal(ev.x, ev.y, lx, ly) then
+ uiGrabCtl.mouseEvent(ev);
+ if (ev.release) then uiGrabCtl := nil;
+ ev.eat();
+ exit;
+ end;
+ if (Length(uiTopList) > 0) and (uiTopList[High(uiTopList)].mEnabled) then uiTopList[High(uiTopList)].mouseEvent(ev);
+ if (not ev.eaten) and (not ev.cancelled) and (ev.press) then
+ begin
+ for f := High(uiTopList) downto 0 do
begin
- result := true;
- if uiTopList[f].mEnabled and (f <> High(uiTopList)) then
+ if uiTopList[f].toLocal(ev.x, ev.y, lx, ly) then
begin
- uiTopList[High(uiTopList)].blurred();
- ctmp := uiTopList[f];
- ctmp.mGrab := nil;
- for c := f+1 to High(uiTopList) do uiTopList[c-1] := uiTopList[c];
- uiTopList[High(uiTopList)] := ctmp;
- ctmp.activated();
- result := ctmp.mouseEvent(ev);
+ if (uiTopList[f].mEnabled) and (f <> High(uiTopList)) then
+ begin
+ uiTopList[High(uiTopList)].blurred();
+ ctmp := uiTopList[f];
+ uiGrabCtl := nil;
+ for c := f+1 to High(uiTopList) do uiTopList[c-1] := uiTopList[c];
+ uiTopList[High(uiTopList)] := ctmp;
+ ctmp.activated();
+ ctmp.mouseEvent(ev);
+ end;
+ ev.eat();
+ exit;
end;
- exit;
end;
end;
+ finally
+ if (ev.eaten) then evt.eat();
+ if (ev.cancelled) then evt.cancel();
end;
end;
-function uiKeyEvent (ev: THKeyEvent): Boolean;
+procedure uiKeyEvent (var evt: THKeyEvent);
+var
+ ev: THKeyEvent;
begin
+ processKills();
+ if (evt.eaten) or (evt.cancelled) then exit;
+ ev := evt;
ev.x := trunc(ev.x/gh_ui_scale);
ev.y := trunc(ev.y/gh_ui_scale);
- if (Length(uiTopList) = 0) then result := false else result := uiTopList[High(uiTopList)].keyEvent(ev);
- if (ev.release) then begin result := true; exit; end;
+ try
+ if (Length(uiTopList) > 0) and (uiTopList[High(uiTopList)].mEnabled) then uiTopList[High(uiTopList)].keyEvent(ev);
+ //if (ev.release) then begin ev.eat(); exit; end;
+ finally
+ if (ev.eaten) then evt.eat();
+ if (ev.cancelled) then evt.cancel();
+ end;
end;
f, cidx: Integer;
ctl: TUIControl;
begin
+ processKills();
glMatrixMode(GL_MODELVIEW);
glPushMatrix();
try
try
if assigned(TUITopWindow(ctl).closeCB) then TUITopWindow(ctl).closeCB(ctl, 0);
finally
- if (TUITopWindow(ctl).mFreeOnClose) then FreeAndNil(ctl);
+ if (TUITopWindow(ctl).mFreeOnClose) then scheduleKill(ctl);
end;
end;
exit;
mCanFocus := true;
mChildren := nil;
mFocused := nil;
- mGrab := nil;
mEscClose := false;
mEatKeys := false;
scallowed := false;
if (strEquCI1251(prname, 'disabled')) then begin mEnabled := not parseBool(par); exit; end;
if (strEquCI1251(prname, 'escclose')) then begin mEscClose := not parseBool(par); exit; end;
if (strEquCI1251(prname, 'eatkeys')) then begin mEatKeys := not parseBool(par); exit; end;
+ if (strEquCI1251(prname, 'default')) then begin mDefault := true; exit; end;
+ if (strEquCI1251(prname, 'cancel')) then begin mCancel := true; exit; end;
result := false;
end;
procedure TUIControl.blurred ();
begin
- mGrab := nil;
+ if (uiGrabCtl = self) then uiGrabCtl := nil;
end;
ctl: TUIControl;
begin
result := false;
- if (not mEnabled) or (mWidth < 1) or (mHeight < 1) then exit;
+ if (not mEnabled) then exit;
ctl := mParent;
while (ctl <> nil) do
begin
- if (not ctl.mEnabled) or (ctl.mWidth < 1) or (ctl.mHeight < 1) then exit;
+ if (not ctl.mEnabled) then exit;
ctl := ctl.mParent;
end;
result := true;
begin
if (mEnabled = v) then exit;
mEnabled := v;
- if not v and focused then setFocused(false);
+ if (not v) and focused then setFocused(false);
end;
end;
exit;
end;
- if (not mEnabled) or (not mCanFocus) then exit;
+ if (not mEnabled) or (not canFocus) then exit;
if (tl.mFocused <> self) then
begin
- if (tl.mFocused <> nil) then tl.mFocused.blurred();
+ if (tl.mFocused <> nil) and (tl.mFocused <> nil) then tl.mFocused.blurred();
tl.mFocused := self;
- if (tl.mGrab <> self) then tl.mGrab := nil;
+ if (uiGrabCtl <> self) then uiGrabCtl := nil;
activated();
end;
end;
+function TUIControl.getCanFocus (): Boolean; inline;
+begin
+ result := (mCanFocus) and (mWidth > 0) and (mHeight > 0);
+end;
+
+
function TUIControl.isMyChild (ctl: TUIControl): Boolean;
begin
result := true;
// x and y are global coords
-function TUIControl.controlAtXY (x, y: Integer): TUIControl;
+function TUIControl.controlAtXY (x, y: Integer; allowDisabled: Boolean=false): TUIControl;
var
lx, ly: Integer;
f: Integer;
begin
result := nil;
- if (not mEnabled) or (mWidth < 1) or (mHeight < 1) then exit;
+ if (not allowDisabled) and (not mEnabled) then exit;
+ if (mWidth < 1) or (mHeight < 1) then exit;
if not toLocal(x, y, lx, ly) then exit;
for f := High(mChildren) downto 0 do
begin
- result := mChildren[f].controlAtXY(x, y);
+ result := mChildren[f].controlAtXY(x, y, allowDisabled);
if (result <> nil) then exit;
end;
result := self;
result := mChildren[f].findFirstFocus();
if (result <> nil) then exit;
end;
- if mCanFocus then result := self;
+ if canFocus then result := self;
end;
end;
result := mChildren[f].findLastFocus();
if (result <> nil) then exit;
end;
- if mCanFocus then result := self;
+ if canFocus then result := self;
end;
end;
end;
+function TUIControl.findDefaulControl (): TUIControl;
+var
+ ctl: TUIControl;
+begin
+ if mDefault then begin result := self; exit; end;
+ for ctl in mChildren do
+ begin
+ result := ctl.findDefaulControl();
+ if (result <> nil) then exit;
+ end;
+ result := nil;
+end;
+
+function TUIControl.findCancelControl (): TUIControl;
+var
+ ctl: TUIControl;
+begin
+ if mCancel then begin result := self; exit; end;
+ for ctl in mChildren do
+ begin
+ result := ctl.findCancelControl();
+ if (result <> nil) then exit;
+ end;
+ result := nil;
+end;
+
+
+function TUIControl.findControlById (const aid: AnsiString): TUIControl;
+var
+ ctl: TUIControl;
+begin
+ if (strEquCI1251(aid, mId)) then begin result := self; exit; end;
+ for ctl in mChildren do
+ begin
+ result := ctl.findControlById(aid);
+ if (result <> nil) then exit;
+ end;
+ result := nil;
+end;
+
+
procedure TUIControl.appendChild (ctl: TUIControl);
begin
if (ctl = nil) then exit;
if (mWidth+mFrameWidth < ctl.mX+ctl.mWidth) then mWidth := ctl.mX+ctl.mWidth+mFrameWidth;
if (mHeight+mFrameHeight < ctl.mY+ctl.mHeight) then mHeight := ctl.mY+ctl.mHeight+mFrameHeight;
end;
- //if (mFocused = nil) and ctl.mEnabled and ctl.mCanFocus and (ctl.mWidth > 0) and (ctl.mHeight > 0) then mFocused := ctl;
+end;
+
+
+procedure TUIControl.close (); // this closes *top-level* control
+var
+ ctl: TUIControl;
+begin
+ ctl := topLevel;
+ uiRemoveWindow(ctl);
+ if (ctl is TUITopWindow) and (TUITopWindow(ctl).mFreeOnClose) then scheduleKill(ctl); // just in case
+end;
+
+
+procedure TUIControl.doAction ();
+begin
+ if assigned(actionCB) then actionCB(self, 0);
end;
// ////////////////////////////////////////////////////////////////////////// //
-function TUIControl.mouseEvent (var ev: THMouseEvent): Boolean;
+procedure TUIControl.mouseEvent (var ev: THMouseEvent);
var
ctl: TUIControl;
begin
- result := false;
- if not mEnabled then exit;
- if (mParent = nil) then
- begin
- if (mGrab <> nil) then
- begin
- result := mGrab.mouseEvent(ev);
- if (ev.release) then mGrab := nil;
- exit;
- end;
- end;
+ if (not mEnabled) then exit;
if (mWidth < 1) or (mHeight < 1) then exit;
ctl := controlAtXY(ev.x, ev.y);
- if (ctl <> nil) and (ctl <> self) then
+ if (ctl = nil) then exit;
+ if (ctl.canFocus) and (ev.press) then
begin
if (ctl <> topLevel.mFocused) then ctl.setFocused(true);
- result := ctl.mouseEvent(ev);
- end
- else if (ctl = self) and assigned(actionCB) then
- begin
- actionCB(self, 0);
+ uiGrabCtl := ctl;
end;
+ if (ctl <> self) then ctl.mouseEvent(ev);
+ //ev.eat();
end;
-function TUIControl.keyEvent (var ev: THKeyEvent): Boolean;
+procedure TUIControl.keyEvent (var ev: THKeyEvent);
var
ctl: TUIControl;
begin
- result := false;
- if not mEnabled then exit;
- if (topLevel.mFocused <> self) and isMyChild(topLevel.mFocused) and topLevel.mFocused.mEnabled then result := topLevel.mFocused.keyEvent(ev);
- if (mParent = nil) then
+ if (not mEnabled) then exit;
+ // focused control should process keyboard first
+ if (topLevel.mFocused <> self) and isMyChild(topLevel.mFocused) and (topLevel.mFocused.mEnabled) then
+ begin
+ topLevel.mFocused.keyEvent(ev);
+ end;
+ // for top-level controls
+ if (mParent = nil) and (not ev.eaten) and (not ev.cancelled) then
begin
if (ev = 'S-Tab') then
begin
- result := true;
ctl := findPrevFocus(mFocused);
- if (ctl <> mFocused) then
- begin
- mGrab := nil;
- mFocused := ctl;
- end;
+ if (ctl <> mFocused) then ctl.setFocused(true);
+ ev.eat();
exit;
end;
if (ev = 'Tab') then
begin
- result := true;
ctl := findNextFocus(mFocused);
- if (ctl <> mFocused) then
+ if (ctl <> mFocused) then ctl.setFocused(true);
+ ev.eat();
+ exit;
+ end;
+ if (ev = 'Enter') or (ev = 'C-Enter') then
+ begin
+ ctl := findDefaulControl();
+ if (ctl <> nil) then
begin
- mGrab := nil;
- mFocused := ctl;
+ ev.eat();
+ ctl.doAction();
+ exit;
+ end;
+ end;
+ if (ev = 'Escape') then
+ begin
+ ctl := findCancelControl();
+ if (ctl <> nil) then
+ begin
+ ev.eat();
+ ctl.doAction();
+ exit;
end;
- exit;
end;
if mEscClose and (ev = 'Escape') then
begin
- result := true;
- uiRemoveWindow(self);
+ if (not assigned(closeRequestCB)) or (closeRequestCB(self)) then
+ begin
+ uiRemoveWindow(self);
+ end;
+ ev.eat();
exit;
end;
end;
- if mEatKeys then result := true;
+ if mEatKeys then ev.eat();
end;
end;
-function TUITopWindow.keyEvent (var ev: THKeyEvent): Boolean;
+procedure TUITopWindow.keyEvent (var ev: THKeyEvent);
begin
- result := inherited keyEvent(ev);
- if not getFocused then exit;
+ inherited keyEvent(ev);
+ if (ev.eaten) or (ev.cancelled) or (not mEnabled) or (not getFocused) then exit;
if (ev = 'M-F3') then
begin
- uiRemoveWindow(self);
- result := true;
+ if (not assigned(closeRequestCB)) or (closeRequestCB(self)) then
+ begin
+ uiRemoveWindow(self);
+ end;
+ ev.eat();
exit;
end;
end;
-function TUITopWindow.mouseEvent (var ev: THMouseEvent): Boolean;
+procedure TUITopWindow.mouseEvent (var ev: THMouseEvent);
var
lx, ly: Integer;
begin
- result := false;
- if not mEnabled then exit;
+ if (not mEnabled) then exit;
if (mWidth < 1) or (mHeight < 1) then exit;
if mDragging then
mDragStartX := ev.x;
mDragStartY := ev.y;
if (ev.release) then mDragging := false;
- result := true;
+ ev.eat();
exit;
end;
begin
if (ly < 8) then
begin
+ uiGrabCtl := self;
if (lx >= mFrameWidth) and (lx < mFrameWidth+3*8) then
begin
//uiRemoveWindow(self);
mDragStartX := ev.x;
mDragStartY := ev.y;
end;
- result := true;
+ ev.eat();
exit;
end;
if (lx < mFrameWidth) or (lx >= mWidth-mFrameWidth) or (ly >= mHeight-mFrameHeight) then
begin
+ uiGrabCtl := self;
mDragging := true;
mDragStartX := ev.x;
mDragStartY := ev.y;
- result := true;
+ ev.eat();
exit;
end;
end;
if (ev.release) then
begin
- if mWaitingClose and (lx >= mFrameWidth) and (lx < mFrameWidth+3*8) then
+ if mWaitingClose then
begin
- uiRemoveWindow(self);
- result := true;
+ if (lx >= mFrameWidth) and (lx < mFrameWidth+3*8) then
+ begin
+ if (not assigned(closeRequestCB)) or (closeRequestCB(self)) then
+ begin
+ uiRemoveWindow(self);
+ end;
+ end;
+ mWaitingClose := false;
+ mInClose := false;
+ ev.eat();
exit;
end;
- mWaitingClose := false;
- mInClose := false;
end;
if (ev.motion) then
if mWaitingClose then
begin
mInClose := (lx >= mFrameWidth) and (lx < mFrameWidth+3*8);
- result := true;
+ ev.eat();
exit;
end;
end;
+
+ inherited mouseEvent(ev);
end
else
begin
mInClose := false;
- if (not ev.motion) then mWaitingClose := false;
+ if (not ev.motion) and (mWaitingClose) then begin ev.eat(); mWaitingClose := false; exit; end;
end;
-
- result := inherited mouseEvent(ev);
end;
end;
-function TUISimpleText.mouseEvent (var ev: THMouseEvent): Boolean;
+procedure TUISimpleText.mouseEvent (var ev: THMouseEvent);
var
lx, ly: Integer;
begin
- result := inherited mouseEvent(ev);
- if not result and toLocal(ev.x, ev.y, lx, ly) then
+ inherited mouseEvent(ev);
+ if (not ev.eaten) and (not ev.cancelled) and (mEnabled) and toLocal(ev.x, ev.y, lx, ly) then
begin
- result := true;
+ ev.eat();
end;
end;
-function TUISimpleText.keyEvent (var ev: THKeyEvent): Boolean;
-begin
- result := inherited keyEvent(ev);
-end;
-
-
// ////////////////////////////////////////////////////////////////////////// //
constructor TUICBListBox.Create (ax, ay: Integer);
begin
end;
-function TUICBListBox.mouseEvent (var ev: THMouseEvent): Boolean;
+procedure TUICBListBox.mouseEvent (var ev: THMouseEvent);
var
lx, ly: Integer;
it: PItem;
begin
- result := inherited mouseEvent(ev);
- if not result and toLocal(ev.x, ev.y, lx, ly) then
+ inherited mouseEvent(ev);
+ if (not ev.eaten) and (not ev.cancelled) and (mEnabled) and toLocal(ev.x, ev.y, lx, ly) then
begin
- result := true;
+ ev.eat();
if (ev = 'lmb') then
begin
ly := ly div 8;
end;
-function TUICBListBox.keyEvent (var ev: THKeyEvent): Boolean;
+procedure TUICBListBox.keyEvent (var ev: THKeyEvent);
var
it: PItem;
begin
- result := inherited keyEvent(ev);
- if not getFocused then exit;
+ inherited keyEvent(ev);
+ if (ev.eaten) or (ev.cancelled) or (not mEnabled) or (not getFocused) then exit;
//result := true;
if (ev = 'Home') or (ev = 'PageUp') then
begin
- result := true;
+ ev.eat();
mCurIndex := 0;
end;
if (ev = 'End') or (ev = 'PageDown') then
begin
- result := true;
+ ev.eat();
mCurIndex := High(mItems);
end;
if (ev = 'Up') then
begin
- result := true;
+ ev.eat();
if (Length(mItems) > 0) then
begin
if (mCurIndex < 0) then mCurIndex := Length(mItems);
end;
if (ev = 'Down') then
begin
- result := true;
+ ev.eat();
if (Length(mItems) > 0) then
begin
if (mCurIndex < 0) then mCurIndex := -1;
end;
if (ev = 'Space') or (ev = 'Enter') then
begin
- result := true;
+ ev.eat();
if (mCurIndex >= 0) and (mCurIndex < Length(mItems)) and (mItems[mCurIndex].varp <> nil) then
begin
it := @mItems[mCurIndex];
end;
-function TUIBox.mouseEvent (var ev: THMouseEvent): Boolean;
+procedure TUIBox.mouseEvent (var ev: THMouseEvent);
var
lx, ly: Integer;
begin
- result := inherited mouseEvent(ev);
- if not result and toLocal(ev.x, ev.y, lx, ly) then
+ inherited mouseEvent(ev);
+ if (not ev.eaten) and (not ev.cancelled) and (mEnabled) and toLocal(ev.x, ev.y, lx, ly) then
begin
- result := true;
+ ev.eat();
end;
end;
//TODO: navigation with arrow keys, according to box orientation
-function TUIBox.keyEvent (var ev: THKeyEvent): Boolean;
+procedure TUIBox.keyEvent (var ev: THKeyEvent);
begin
- result := inherited keyEvent(ev);
+ inherited keyEvent(ev);
+ if (ev.eaten) or (ev.cancelled) or (not mEnabled) or (not getFocused) then exit;
end;
end;
-function TUITextLabel.mouseEvent (var ev: THMouseEvent): Boolean;
+procedure TUITextLabel.mouseEvent (var ev: THMouseEvent);
var
lx, ly: Integer;
begin
- result := inherited mouseEvent(ev);
- if not result and toLocal(ev.x, ev.y, lx, ly) then
+ inherited mouseEvent(ev);
+ if (not ev.eaten) and (not ev.cancelled) and (mEnabled) and toLocal(ev.x, ev.y, lx, ly) then
begin
- result := true;
+ ev.eat();
end;
end;
-function TUITextLabel.keyEvent (var ev: THKeyEvent): Boolean;
+// ////////////////////////////////////////////////////////////////////////// //
+constructor TUIButton.Create (const atext: AnsiString);
+begin
+ inherited Create(atext);
+end;
+
+
+procedure TUIButton.AfterConstruction ();
begin
- result := inherited keyEvent(ev);
+ inherited AfterConstruction();
+ mHAlign := -1;
+ mVAlign := 0;
+ mCanFocus := true;
+ mDefSize := TLaySize.Create(Length(mText)*8+8, 8);
+ mCtl4Style := 'button';
+end;
+
+
+function TUIButton.parseProperty (const prname: AnsiString; par: TTextParser): Boolean;
+begin
+ result := inherited parseProperty(prname, par);
+ if result then
+ begin
+ mDefSize := TLaySize.Create(Length(mText)*8+8*2, 8);
+ end;
+end;
+
+
+procedure TUIButton.drawControl (gx, gy: Integer);
+var
+ xpos, ypos: Integer;
+ cidx: Integer;
+ lch, rch: AnsiChar;
+begin
+ cidx := getColorIndex;
+ fillRect(gx, gy, mWidth, mHeight, mBackColor[cidx]);
+
+ if (mDefault) then begin lch := '<'; rch := '>'; end
+ else if (mCancel) then begin lch := '{'; rch := '}'; end
+ else begin lch := '['; rch := ']'; end;
+
+ if (mVAlign < 0) then ypos := 0
+ else if (mVAlign > 0) then ypos := mHeight-8
+ else ypos := (mHeight-8) div 2;
+
+ drawText8(gx, gy+ypos, lch, mTextColor[cidx]);
+ drawText8(gx+mWidth-8, gy+ypos, rch, mTextColor[cidx]);
+
+ if (Length(mText) > 0) then
+ begin
+ if (mHAlign < 0) then xpos := 0
+ else if (mHAlign > 0) then xpos := mWidth-Length(mText)*8
+ else xpos := (mWidth-Length(mText)*8) div 2;
+
+ setScissor(8, 0, mWidth-16, mHeight);
+ drawText8(gx+xpos+8, gy+ypos, mText, mTextColor[cidx]);
+ end;
+end;
+
+
+procedure TUIButton.mouseEvent (var ev: THMouseEvent);
+var
+ lx, ly: Integer;
+begin
+ inherited mouseEvent(ev);
+ if (uiGrabCtl = self) then
+ begin
+ ev.eat();
+ if (ev = '-lmb') and focused and toLocal(ev.x, ev.y, lx, ly) then
+ begin
+ doAction();
+ end;
+ exit;
+ end;
+ if (ev.eaten) or (ev.cancelled) or (not mEnabled) or not focused then exit;
+ ev.eat();
+end;
+
+
+procedure TUIButton.keyEvent (var ev: THKeyEvent);
+begin
+ inherited keyEvent(ev);
+ if (not ev.eaten) and (not ev.cancelled) and (mEnabled) then
+ begin
+ if (ev = 'Enter') or (ev = 'Space') then
+ begin
+ ev.eat();
+ doAction();
+ exit;
+ end;
+ end;
end;
registerCtlClass(TUIHLine, 'hline');
registerCtlClass(TUIVLine, 'vline');
registerCtlClass(TUITextLabel, 'label');
+ registerCtlClass(TUIButton, 'button');
end.
diff --git a/src/gx/gh_ui_style.pas b/src/gx/gh_ui_style.pas
index 34e5f508a1c5cedb0ff124109ad3bb19890a1da4..5c77405710ece9e1d8440589004b650eba08ecfe 100644 (file)
--- a/src/gx/gh_ui_style.pas
+++ b/src/gx/gh_ui_style.pas
private
// "text-color#inactive@label"
function getValue (const path: AnsiString): TStyleValue;
- procedure putValue (const path: AnsiString; const val: TStyleValue);
+ procedure setValue (const path: AnsiString; const val: TStyleValue);
public
constructor Create ();
destructor Destroy (); override;
public
- property value[const path: AnsiString]: TStyleValue read getValue write putValue; default;
+ property value[const path: AnsiString]: TStyleValue read getValue write setValue; default;
end;
TUIStyle = class
procedure parse (par: TTextParser);
function getValue (const path: AnsiString): TStyleValue; inline;
- procedure putValue (const path: AnsiString; const val: TStyleValue); inline;
+ procedure setValue (const path: AnsiString; const val: TStyleValue); inline;
public
constructor Create (const aid: AnsiString);
public
property id: AnsiString read mId;
- property value[const path: AnsiString]: TStyleValue read getValue write putValue; default;
+ property value[const path: AnsiString]: TStyleValue read getValue write setValue; default;
end;
result['frame-icon-color'] := TStyleValue.Create(TGxRGBA.Create(0, 255, 0));
// disabled is always inactive too
- result['back-color#disabled'] := TStyleValue.Create(TGxRGBA.Create(0, 0, 128));
+
+ // main colors
+ result['back-color#disabled'] := TStyleValue.Create(TGxRGBA.Create(0, 0, 127));
result['text-color#disabled'] := TStyleValue.Create(TGxRGBA.Create(127, 127, 127));
result['frame-text-color#disabled'] := TStyleValue.Create(TGxRGBA.Create(127, 127, 127));
result['frame-icon-color#disabled'] := TStyleValue.Create(TGxRGBA.Create(0, 127, 0));
result['darken#disabled'] := TStyleValue.Create(128, false); // darken inactive windows, no-inherit
result['darken#inactive'] := TStyleValue.Create(128, false); // darken inactive windows, no-inherit
+ // label
result['text-color@label'] := TStyleValue.Create(TGxRGBA.Create(255, 255, 255));
result['text-color#disabled@label'] := TStyleValue.Create(TGxRGBA.Create(127, 127, 127));
+ // box
result['frame-color@box'] := TStyleValue.Create(TGxRGBA.Create(255, 255, 0));
result['frame-text-color@box'] := TStyleValue.Create(TGxRGBA.Create(255, 255, 0));
result['frame-icon-color@box'] := TStyleValue.Create(TGxRGBA.Create(0, 255, 0));
+ result['frame-color#inactive@box'] := TStyleValue.Create(TGxRGBA.Create(255, 255, 255));
+ result['frame-text-color#inactive@box'] := TStyleValue.Create(TGxRGBA.Create(255, 255, 255));
+ result['frame-icon-color#inactive@box'] := TStyleValue.Create(TGxRGBA.Create(0, 255, 0));
+
result['frame-color#disabled@box'] := TStyleValue.Create(TGxRGBA.Create(127, 127, 127));
result['frame-text-color#disabled@box'] := TStyleValue.Create(TGxRGBA.Create(127, 127, 127));
result['frame-icon-color#disabled@box'] := TStyleValue.Create(TGxRGBA.Create(127, 127, 127));
+
+ // button
+ result['back-color@button'] := TStyleValue.Create(TGxRGBA.Create(0, 96, 255));
+ result['text-color@button'] := TStyleValue.Create(TGxRGBA.Create(255, 255, 255));
+
+ result['back-color#inactive@button'] := TStyleValue.Create(TGxRGBA.Create(0, 0, 127));
+ result['text-color#inactive@button'] := TStyleValue.Create(TGxRGBA.Create(196, 196, 196));
+
+ result['back-color#disabled@button'] := TStyleValue.Create(TGxRGBA.Create(0, 0, 127));
+ result['text-color#disabled@button'] := TStyleValue.Create(TGxRGBA.Create(96, 96, 96));
end;
end;
-procedure TStyleSection.putValue (const path: AnsiString; const val: TStyleValue);
+procedure TStyleSection.setValue (const path: AnsiString; const val: TStyleValue);
var
name, hash, ctl: AnsiString;
sect: TStyleSection = nil;
begin
// create new section
s1 := TStyleSection.Create();
- mHashVals.put(hash, s1);
+ sect.mHashVals.put(hash, s1);
end;
end
else
result := mMain[path];
end;
-procedure TUIStyle.putValue (const path: AnsiString; const val: TStyleValue); inline;
+procedure TUIStyle.setValue (const path: AnsiString; const val: TStyleValue); inline;
begin
- mMain.putValue(path, val);
+ mMain.setValue(path, val);
end;
diff --git a/src/gx/glgfx.pas b/src/gx/glgfx.pas
index 1237550cc98d8b425a42f041810b30681702fe78..d39d2f087bfd1863693c7685aca40a64a243c09f 100644 (file)
--- a/src/gx/glgfx.pas
+++ b/src/gx/glgfx.pas
type
TKind = (Release, Press, Motion);
+ private
+ mEaten: Boolean;
+ mCancelled: Boolean;
+
public
kind: TKind; // motion, press, release
x, y: Integer; // current mouse position
kstate: Word; // keyboard state (see THKeyEvent);
public
+ procedure intrInit (); inline; // init hidden fields
+
function press (): Boolean; inline;
function release (): Boolean; inline;
function motion (): Boolean; inline;
+ procedure eat (); inline;
+ procedure cancel (); inline;
+
+ public
+ property eaten: Boolean read mEaten;
+ property cancelled: Boolean read mCancelled;
end;
THKeyEvent = record
type
TKind = (Release, Press);
+ private
+ mEaten: Boolean;
+ mCancelled: Boolean;
+
public
kind: TKind;
scan: Word; // SDL_SCANCODE_XXX
kstate: Word; // keyboard state BEFORE event (i.e. press/release modifications aren't done yet)
public
+ procedure intrInit (); inline; // init hidden fields
+
function press (): Boolean; inline;
function release (): Boolean; inline;
+ procedure eat (); inline;
+ procedure cancel (); inline;
+
+ public
+ property eaten: Boolean read mEaten;
+ property cancelled: Boolean read mCancelled;
end;
+
// ////////////////////////////////////////////////////////////////////////// //
// setup 2D OpenGL mode; will be called automatically in `glInit()`
procedure oglSetup2D (winWidth, winHeight: Integer; upsideDown: Boolean=false);
@@ -161,8 +186,8 @@ function drawText8PropXC (x, y: Integer; const s: AnsiString; constref clr: TGxR
// ////////////////////////////////////////////////////////////////////////// //
// event handlers
var
- evMouseCB: function (var ev: THMouseEvent): Boolean = nil; // `true`: event eaten
- evKeyCB: function (var ev: THKeyEvent): Boolean = nil; // `true`: event eaten
+ evMouseCB: procedure (var ev: THMouseEvent) = nil;
+ evKeyCB: procedure (var ev: THKeyEvent) = nil;
// ////////////////////////////////////////////////////////////////////////// //
// ////////////////////////////////////////////////////////////////////////// //
+procedure THMouseEvent.intrInit (); inline; begin mEaten := false; mCancelled := false; end;
function THMouseEvent.press (): Boolean; inline; begin result := (kind = TKind.Press); end;
function THMouseEvent.release (): Boolean; inline; begin result := (kind = TKind.Release); end;
function THMouseEvent.motion (): Boolean; inline; begin result := (kind = TKind.Motion); end;
+procedure THMouseEvent.eat (); inline; begin mEaten := true; end;
+procedure THMouseEvent.cancel (); inline; begin mCancelled := true; end;
+procedure THKeyEvent.intrInit (); inline; begin mEaten := false; mCancelled := false; end;
function THKeyEvent.press (): Boolean; inline; begin result := (kind = TKind.Press); end;
function THKeyEvent.release (): Boolean; inline; begin result := (kind = TKind.Release); end;
+procedure THKeyEvent.eat (); inline; begin mEaten := true; end;
+procedure THKeyEvent.cancel (); inline; begin mCancelled := true; end;
// ////////////////////////////////////////////////////////////////////////// //
pos := 1;
//while (pos <= Length(s)) and (s[pos] <= ' ') do Inc(pos);
if (pos < Length(s)) and ((s[pos] = '+') or (s[pos] = '-') or (s[pos] = '*')) then Inc(pos);
- while (pos < Length(s)) do
+ while (pos <= Length(s)) do
begin
- if (Length(s)-pos >= 2) and (s[pos+1] = '-') then
+ if (Length(s)-pos >= 1) and (s[pos+1] = '-') then
begin
case s[pos] of
'C', 'c': begin if (kmods = 255) then kmods := 0; kmods := kmods or THKeyEvent.ModCtrl; Inc(pos, 2); continue; end;
end;
break;
end;
- if (Length(s)-pos >= 4) and ((s[pos+1] = 'M') or (s[pos+1] = 'm')) and ((s[pos+2] = 'B') or (s[pos+1] = 'b')) and (s[pos+3] = '-') then
+ if (Length(s)-pos >= 3) and (s[pos+3] = '-') and ((s[pos+1] = 'M') or (s[pos+1] = 'm')) and ((s[pos+2] = 'B') or (s[pos+2] = 'b')) then
begin
case s[pos] of
'L', 'l': begin if (mbuts = 255) then mbuts := 0; mbuts := mbuts or THMouseEvent.Left; Inc(pos, 4); continue; end;
mbuts: Byte = 255;
kname: AnsiString;
but: Integer = -1;
+ modch: AnsiChar = ' ';
begin
result := false;
if (Length(s) > 0) then
begin
- if (s[1] = '+') then begin if (not ev.press) then exit; end
- else if (s[1] = '-') then begin if (not ev.release) then exit; end
+ if (s[1] = '+') then begin if (not ev.press) then exit; modch := '+'; end
+ else if (s[1] = '-') then begin if (not ev.release) then exit; modch := '-'; end
else if (s[1] = '*') then begin if (not ev.motion) then exit; end
else if (not ev.press) then exit;
end;
if (mbuts = 255) then mbuts := 0;
if (kmods = 255) then kmods := 0;
if (ev.kstate <> kmods) then exit;
+ if (modch = '-') then mbuts := mbuts or but else if (modch = '+') then mbuts := mbuts and (not but);
result := (ev.bstate = mbuts) and (ev.but = but);
end;
// checked each time, 'cause `evMouseCB` can be changed from the handler
if ((curButState and mask) <> 0) and assigned(evMouseCB) then
begin
+ FillChar(mev, sizeof(mev), 0);
+ mev.intrInit();
mev.kind := mev.TKind.Release;
mev.x := curMsX;
mev.y := curMsY;
// checked each time, 'cause `evMouseCB` can be changed from the handler
if ((curModState and mask) <> 0) and assigned(evKeyCB) then
begin
+ FillChar(kev, sizeof(kev), 0);
+ kev.intrInit();
kev.kind := kev.TKind.Release;
case mask of
THKeyEvent.ModCtrl: begin kev.scan := SDL_SCANCODE_LCTRL; kev.sym := SDLK_LCTRL;{arbitrary} end;
SDL_KEYDOWN, SDL_KEYUP:
begin
// fix left/right modifiers
+ FillChar(kev, sizeof(kev), 0);
+ kev.intrInit();
if (ev.type_ = SDL_KEYDOWN) then kev.kind := THKeyEvent.TKind.Press else kev.kind := THKeyEvent.TKind.Release;
kev.scan := ev.key.keysym.scancode;
kev.sym := ev.key.keysym.sym;
SDL_SCANCODE_LSHIFT: if (kev.press) then curModState := curModState or THKeyEvent.ModShift else curModState := curModState and (not THKeyEvent.ModShift);
end;
- if assigned(evKeyCB) then result := evKeyCB(kev);
+ if assigned(evKeyCB) then
+ begin
+ evKeyCB(kev);
+ result := kev.eaten;
+ end;
end;
SDL_MOUSEBUTTONDOWN, SDL_MOUSEBUTTONUP:
begin
+ FillChar(mev, sizeof(mev), 0);
+ mev.intrInit();
+ if (ev.type_ = SDL_MOUSEBUTTONDOWN) then mev.kind := THMouseEvent.TKind.Press else mev.kind := THMouseEvent.TKind.Release;
mev.dx := ev.button.x-curMsX;
mev.dy := ev.button.y-curMsY;
curMsX := ev.button.x;
curMsY := ev.button.y;
- if (ev.type_ = SDL_MOUSEBUTTONDOWN) then mev.kind := THMouseEvent.TKind.Press else mev.kind := THMouseEvent.TKind.Release;
mev.but := buildBut(ev.button.button);
mev.x := curMsX;
mev.y := curMsY;
begin
// ev.button.clicks: Byte
if (ev.type_ = SDL_MOUSEBUTTONDOWN) then curButState := curButState or mev.but else curButState := curButState and (not mev.but);
- if assigned(evMouseCB) then result := evMouseCB(mev);
+ if assigned(evMouseCB) then
+ begin
+ evMouseCB(mev);
+ result := mev.eaten;
+ end;
end;
end;
SDL_MOUSEWHEEL:
begin
if (ev.wheel.y <> 0) then
begin
+ FillChar(mev, sizeof(mev), 0);
+ mev.intrInit();
+ mev.kind := THMouseEvent.TKind.Press;
mev.dx := 0;
mev.dy := ev.wheel.y;
- mev.kind := THMouseEvent.TKind.Press;
if (ev.wheel.y < 0) then mev.but := THMouseEvent.WheelUp else mev.but := THMouseEvent.WheelDown;
mev.x := curMsX;
mev.y := curMsY;
mev.bstate := curButState;
mev.kstate := curModState;
- if assigned(evMouseCB) then result := evMouseCB(mev);
+ if assigned(evMouseCB) then
+ begin
+ evMouseCB(mev);
+ result := mev.eaten;
+ end;
end;
end;
SDL_MOUSEMOTION:
begin
+ FillChar(mev, sizeof(mev), 0);
+ mev.intrInit();
+ mev.kind := THMouseEvent.TKind.Motion;
mev.dx := ev.button.x-curMsX;
mev.dy := ev.button.y-curMsY;
curMsX := ev.button.x;
curMsY := ev.button.y;
- mev.kind := THMouseEvent.TKind.Motion;
mev.but := 0;
mev.x := curMsX;
mev.y := curMsY;
mev.bstate := curButState;
mev.kstate := curModState;
- if assigned(evMouseCB) then result := evMouseCB(mev);
+ if assigned(evMouseCB) then
+ begin
+ evMouseCB(mev);
+ result := mev.eaten;
+ end;
end;
{