1 (* Copyright (C) Doom 2D: Forever Developers
3 * This program is free software: you can redistribute it and/or modify
4 * it under the terms of the GNU General Public License as published by
5 * the Free Software Foundation, version 3 of the License ONLY.
7 * This program is distributed in the hope that it will be useful,
8 * but WITHOUT ANY WARRANTY; without even the implied warranty of
9 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
10 * GNU General Public License for more details.
12 * You should have received a copy of the GNU General Public License
13 * along with this program. If not, see <http://www.gnu.org/licenses/>.
15 {$INCLUDE ../shared/a_modes.inc}
24 // ////////////////////////////////////////////////////////////////////////// //
25 // call this with SDL2 event; returns `true` if event was eaten
26 function fuiOnSDLEvent (var ev
: TSDL_Event
): Boolean;
29 // ////////////////////////////////////////////////////////////////////////// //
32 winFocusCB
: procedure () = nil; // this will be called when window got focus; `fuiWinActive` already set
33 winBlurCB
: procedure () = nil; // this will be called when window lost focus; `fuiWinActive` already set
35 buildFrameCB
: procedure () = nil; // don't do any rendering here, do it in `renderFrameCB()`
36 renderFrameCB
: procedure () = nil; // no need to call `glSwap()` here
37 exposeFrameCB
: procedure () = nil; // call `glSwap()` here instead; automatically set by standalone
39 prerenderFrameCB
: procedure () = nil;
40 postrenderFrameCB
: procedure () = nil;
41 fuiResizeCB
: procedure () = nil; // `fuiScrWdt` and `fuiScrHgt` are already set
42 oglInitCB
: procedure () = nil; // `fuiScrWdt` and `fuiScrHgt` are already set
43 oglDeinitCB
: procedure () = nil;
48 fuiScrWdt
: Integer = 1024;
49 fuiScrHgt
: Integer = 768;
50 fuiWinActive
: Boolean = false;
51 fuiQuitReceived
: Boolean = false;
54 // ////////////////////////////////////////////////////////////////////////// //
55 function fuiTimeMicro (): UInt64
; inline;
56 function fuiTimeMilli (): UInt64
; inline;
59 // ////////////////////////////////////////////////////////////////////////// //
60 // only for standalone mode
61 function getFUIFPS (): Integer; inline;
62 procedure setFUIFPS (v
: Integer); inline;
64 property fuiFPS
: Integer read getFUIFPS write setFUIFPS
; // default: 30
70 SysUtils
, Classes
, utils
,
71 {$INCLUDE ../nogl/noGLuses.inc}
72 {$IF DEFINED(LINUX) OR DEFINED(ANDROID)}
74 {$ELSEIF DEFINED(WINDOWS)}
76 {$ELSEIF DEFINED(HAIKU) OR DEFINED(UNIX)}
84 // ////////////////////////////////////////////////////////////////////////// //
86 gEffFPS
: Integer = 30;
88 function getFUIFPS (): Integer; inline; begin result
:= gEffFPS
; end;
89 procedure setFUIFPS (v
: Integer); inline; begin if (v
< 1) then v
:= 1 else if (v
> 60*4) then v
:= 60*4; gEffFPS
:= v
; end;
92 // ////////////////////////////////////////////////////////////////////////// //
94 type THPTimeType
= TTimeSpec
;
96 type THPTimeType
= Int64;
100 mFrequency
: Int64 = 0;
101 mHasHPTimer
: Boolean = false;
103 procedure initTimerIntr ();
107 if (mFrequency
= 0) then
110 if (clock_getres(CLOCK_MONOTONIC
, @r
) <> 0) then raise Exception
.Create('profiler error: cannot get timer resolution');
111 mHasHPTimer
:= (r
.tv_nsec
<> 0);
112 if not mHasHPTimer
then raise Exception
.Create('profiler error: hires timer is not available');
113 mFrequency
:= 1; // just a flag
114 if (r
.tv_nsec
<> 0) then mFrequency
:= 1000000000000000000 div r
.tv_nsec
;
115 {$ELSEIF DEFINED(WINDOWS)}
116 mHasHPTimer
:= QueryPerformanceFrequency(r
);
117 if not mHasHPTimer
then raise Exception
.Create('profiler error: hires timer is not available');
124 function fuiTimeMicro (): UInt64
; inline;
128 //if (mFrequency = 0) then initTimerIntr();
130 clock_gettime(CLOCK_MONOTONIC
, @r
);
131 result
:= UInt64(r
.tv_sec
)*1000000+UInt64(r
.tv_nsec
) div 1000; // microseconds
132 {$ELSEIF DEFINED(WINDOWS)}
133 QueryPerformanceCounter(r
);
134 result
:= UInt64(r
)*1000000 div mFrequency
;
139 function fuiTimeMilli (): UInt64
; inline;
141 result
:= fuiTimeMicro() div 1000;
145 // ////////////////////////////////////////////////////////////////////////// //
146 function fuiOnSDLEvent (var ev
: TSDL_Event
): Boolean;
152 function buildBut (b
: Byte): Word;
156 SDL_BUTTON_LEFT
: result
:= result
or TFUIEvent
.Left
;
157 SDL_BUTTON_MIDDLE
: result
:= result
or TFUIEvent
.Middle
;
158 SDL_BUTTON_RIGHT
: result
:= result
or TFUIEvent
.Right
;
162 procedure windowEventHandler (constref ev
: TSDL_WindowEvent
);
165 SDL_WINDOWEVENT_MINIMIZED
: if fuiWinActive
then begin fuiResetKMState(true); fuiWinActive
:= false; if assigned(winBlurCB
) then winBlurCB(); end;
166 SDL_WINDOWEVENT_RESIZED
, SDL_WINDOWEVENT_SIZE_CHANGED
:
168 if (ev
.data1
<> fuiScrWdt
) or (ev
.data2
<> fuiScrHgt
) then
170 fuiScrWdt
:= ev
.data1
;
171 fuiScrHgt
:= ev
.data2
;
172 if assigned(fuiResizeCB
) then fuiResizeCB();
175 SDL_WINDOWEVENT_EXPOSED
: if assigned(exposeFrameCB
) then exposeFrameCB();
176 SDL_WINDOWEVENT_FOCUS_GAINED
: if not fuiWinActive
then begin fuiWinActive
:= true; if assigned(winFocusCB
) then winFocusCB(); end;
177 SDL_WINDOWEVENT_FOCUS_LOST
: if fuiWinActive
then begin fuiResetKMState(true); fuiWinActive
:= false; if assigned(winBlurCB
) then winBlurCB(); end;
185 SDL_WINDOWEVENT
: windowEventHandler(ev
.window
);
186 SDL_QUITEV
: fuiQuitReceived
:= true;
188 SDL_KEYDOWN
, SDL_KEYUP
:
190 // fix left/right modifiers
191 if (ev
.type_
= SDL_KEYDOWN
) then
193 fev
:= TFUIEvent
.Create(TFUIEvent
.TType
.Key
, TFUIEvent
.TKind
.Press
);
197 fev
:= TFUIEvent
.Create(TFUIEvent
.TType
.Key
, TFUIEvent
.TKind
.Release
);
199 fev
.scan
:= ev
.key
.keysym
.scancode
;
201 if (fev
.scan
= SDL_SCANCODE_RCTRL
) then fev
.scan
:= SDL_SCANCODE_LCTRL
;
202 if (fev
.scan
= SDL_SCANCODE_RALT
) then fev
.scan
:= SDL_SCANCODE_LALT
;
203 if (fev
.scan
= SDL_SCANCODE_RSHIFT
) then fev
.scan
:= SDL_SCANCODE_LSHIFT
;
204 if (fev
.scan
= SDL_SCANCODE_RGUI
) then fev
.scan
:= SDL_SCANCODE_LGUI
;
208 fev
.bstate
:= fuiButState
;
209 fev
.kstate
:= fuiModState
;
212 SDL_SCANCODE_LCTRL
: if (fev
.press
) then fuiSetModState(fuiModState
or TFUIEvent
.ModCtrl
) else fuiSetModState(fuiModState
and (not TFUIEvent
.ModCtrl
));
213 SDL_SCANCODE_LALT
: if (fev
.press
) then fuiSetModState(fuiModState
or TFUIEvent
.ModAlt
) else fuiSetModState(fuiModState
and (not TFUIEvent
.ModAlt
));
214 SDL_SCANCODE_LSHIFT
: if (fev
.press
) then fuiSetModState(fuiModState
or TFUIEvent
.ModShift
) else fuiSetModState(fuiModState
and (not TFUIEvent
.ModShift
));
217 if (assigned(fuiEventCB
)) then
224 SDL_MOUSEBUTTONDOWN
, SDL_MOUSEBUTTONUP
:
226 if (ev
.type_
= SDL_MOUSEBUTTONDOWN
) then
228 fev
:= TFUIEvent
.Create(TFUIEvent
.TType
.Mouse
, TFUIEvent
.TKind
.Press
);
232 fev
:= TFUIEvent
.Create(TFUIEvent
.TType
.Mouse
, TFUIEvent
.TKind
.Release
);
234 fev
.dx
:= ev
.button
.x
-fuiMouseX
;
235 fev
.dy
:= ev
.button
.y
-fuiMouseY
;
236 fuiSetMouseX(ev
.button
.x
);
237 fuiSetMouseY(ev
.button
.y
);
238 fev
.but
:= buildBut(ev
.button
.button
);
241 fev
.bstate
:= fuiButState
;
242 fev
.kstate
:= fuiModState
;
243 if (fev
.but
<> 0) then
245 // ev.button.clicks: Byte
246 if (ev
.type_
= SDL_MOUSEBUTTONDOWN
) then fuiSetButState(fuiButState
or fev
.but
) else fuiSetButState(fuiButState
and (not fev
.but
));
247 if (assigned(fuiEventCB
)) then
256 if (ev
.wheel
.y
<> 0) then
258 fev
:= TFUIEvent
.Create(TFUIEvent
.TType
.Mouse
, TFUIEvent
.TKind
.Press
);
260 fev
.dy
:= ev
.wheel
.y
;
261 if (ev
.wheel
.y
< 0) then fev
.but
:= TFUIEvent
.WheelUp
else fev
.but
:= TFUIEvent
.WheelDown
;
264 fev
.bstate
:= fuiButState
;
265 fev
.kstate
:= fuiModState
;
266 if (assigned(fuiEventCB
)) then
275 fev
:= TFUIEvent
.Create(TFUIEvent
.TType
.Mouse
, TFUIEvent
.TKind
.Motion
);
276 fev
.dx
:= ev
.button
.x
-fuiMouseX
;
277 fev
.dy
:= ev
.button
.y
-fuiMouseY
;
278 fuiSetMouseX(ev
.button
.x
);
279 fuiSetMouseY(ev
.button
.y
);
283 fev
.bstate
:= fuiButState
;
284 fev
.kstate
:= fuiModState
;
285 if (assigned(fuiEventCB
)) then
293 if ((fuiModState
and (not TFUIEvent
.ModShift
)) = 0) then
295 Utf8ToUnicode(@uc
, PChar(ev
.text.text), 1);
297 if (keychr
> 127) then keychr
:= Word(wchar2win(WideChar(keychr
)));
298 if (keychr
> 0) and (assigned(fuiEventCB
)) then
300 fev
:= TFUIEvent
.Create(TFUIEvent
.TType
.Key
, TFUIEvent
.TKind
.SimpleChar
);
301 fev
.ch
:= AnsiChar(keychr
);
304 fev
.bstate
:= fuiButState
;
305 fev
.kstate
:= fuiModState
;
316 fuiWinActive
:= fuiWinActive
;
317 fuiScrWdt
:= fuiScrWdt
;
318 fuiScrHgt
:= fuiScrHgt
;