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, either version 3 of the License, or
6 * (at your option) any later version.
8 * This program is distributed in the hope that it will be useful,
9 * but WITHOUT ANY WARRANTY; without even the implied warranty of
10 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
11 * GNU General Public License for more details.
13 * You should have received a copy of the GNU General Public License
14 * along with this program. If not, see <http://www.gnu.org/licenses/>.
16 {$INCLUDE ../shared/a_modes.inc}
25 // ////////////////////////////////////////////////////////////////////////// //
26 // call this with SDL2 event; returns `true` if event was eaten
27 function fuiOnSDLEvent (var ev
: TSDL_Event
): Boolean;
30 // ////////////////////////////////////////////////////////////////////////// //
33 winFocusCB
: procedure () = nil; // this will be called when window got focus; `fuiWinActive` already set
34 winBlurCB
: procedure () = nil; // this will be called when window lost focus; `fuiWinActive` already set
36 buildFrameCB
: procedure () = nil; // don't do any rendering here, do it in `renderFrameCB()`
37 renderFrameCB
: procedure () = nil; // no need to call `glSwap()` here
38 exposeFrameCB
: procedure () = nil; // call `glSwap()` here instead; automatically set by standalone
40 prerenderFrameCB
: procedure () = nil;
41 postrenderFrameCB
: procedure () = nil;
42 fuiResizeCB
: procedure () = nil; // `fuiScrWdt` and `fuiScrHgt` are already set
43 oglInitCB
: procedure () = nil; // `fuiScrWdt` and `fuiScrHgt` are already set
44 oglDeinitCB
: procedure () = nil;
49 fuiScrWdt
: Integer = 1024;
50 fuiScrHgt
: Integer = 768;
51 fuiWinActive
: Boolean = false;
52 fuiQuitReceived
: Boolean = false;
55 // ////////////////////////////////////////////////////////////////////////// //
56 function fuiTimeMicro (): UInt64
; inline;
57 function fuiTimeMilli (): UInt64
; inline;
60 // ////////////////////////////////////////////////////////////////////////// //
61 // only for standalone mode
62 function getFUIFPS (): Integer; inline;
63 procedure setFUIFPS (v
: Integer); inline;
65 property fuiFPS
: Integer read getFUIFPS write setFUIFPS
; // default: 30
72 {$INCLUDE ../nogl/noGLuses.inc}
73 {$IF DEFINED(LINUX) OR DEFINED(ANDROID)}
75 {$ELSEIF DEFINED(WINDOWS)}
77 {$ELSEIF DEFINED(HAIKU)}
85 // ////////////////////////////////////////////////////////////////////////// //
87 gEffFPS
: Integer = 30;
89 function getFUIFPS (): Integer; inline; begin result
:= gEffFPS
; end;
90 procedure setFUIFPS (v
: Integer); inline; begin if (v
< 1) then v
:= 1 else if (v
> 60*4) then v
:= 60*4; gEffFPS
:= v
; end;
93 // ////////////////////////////////////////////////////////////////////////// //
95 type THPTimeType
= TTimeSpec
;
97 type THPTimeType
= Int64;
101 mFrequency
: Int64 = 0;
102 mHasHPTimer
: Boolean = false;
104 procedure initTimerIntr ();
108 if (mFrequency
= 0) then
111 if (clock_getres(CLOCK_MONOTONIC
, @r
) <> 0) then raise Exception
.Create('profiler error: cannot get timer resolution');
112 mHasHPTimer
:= (r
.tv_nsec
<> 0);
113 if not mHasHPTimer
then raise Exception
.Create('profiler error: hires timer is not available');
114 mFrequency
:= 1; // just a flag
115 if (r
.tv_nsec
<> 0) then mFrequency
:= 1000000000000000000 div r
.tv_nsec
;
116 {$ELSEIF DEFINED(WINDOWS)}
117 mHasHPTimer
:= QueryPerformanceFrequency(r
);
118 if not mHasHPTimer
then raise Exception
.Create('profiler error: hires timer is not available');
125 function fuiTimeMicro (): UInt64
; inline;
129 //if (mFrequency = 0) then initTimerIntr();
131 clock_gettime(CLOCK_MONOTONIC
, @r
);
132 result
:= UInt64(r
.tv_sec
)*1000000+UInt64(r
.tv_nsec
) div 1000; // microseconds
133 {$ELSEIF DEFINED(WINDOWS)}
134 QueryPerformanceCounter(r
);
135 result
:= UInt64(r
)*1000000 div mFrequency
;
140 function fuiTimeMilli (): UInt64
; inline;
142 result
:= fuiTimeMicro() div 1000;
146 // ////////////////////////////////////////////////////////////////////////// //
148 wc2shitmap
: array[0..65535] of AnsiChar
;
149 wc2shitmapInited
: Boolean = false;
152 // ////////////////////////////////////////////////////////////////////////// //
154 cp1251
: array[0..127] of Word = (
155 $0402,$0403,$201A,$0453,$201E,$2026,$2020,$2021,$20AC,$2030,$0409,$2039,$040A,$040C,$040B,$040F,
156 $0452,$2018,$2019,$201C,$201D,$2022,$2013,$2014,$003F,$2122,$0459,$203A,$045A,$045C,$045B,$045F,
157 $00A0,$040E,$045E,$0408,$00A4,$0490,$00A6,$00A7,$0401,$00A9,$0404,$00AB,$00AC,$00AD,$00AE,$0407,
158 $00B0,$00B1,$0406,$0456,$0491,$00B5,$00B6,$00B7,$0451,$2116,$0454,$00BB,$0458,$0405,$0455,$0457,
159 $0410,$0411,$0412,$0413,$0414,$0415,$0416,$0417,$0418,$0419,$041A,$041B,$041C,$041D,$041E,$041F,
160 $0420,$0421,$0422,$0423,$0424,$0425,$0426,$0427,$0428,$0429,$042A,$042B,$042C,$042D,$042E,$042F,
161 $0430,$0431,$0432,$0433,$0434,$0435,$0436,$0437,$0438,$0439,$043A,$043B,$043C,$043D,$043E,$043F,
162 $0440,$0441,$0442,$0443,$0444,$0445,$0446,$0447,$0448,$0449,$044A,$044B,$044C,$044D,$044E,$044F
166 procedure initShitMap ();
170 for f
:= 0 to High(wc2shitmap
) do wc2shitmap
[f
] := '?';
171 for f
:= 0 to 127 do wc2shitmap
[f
] := AnsiChar(f
);
172 for f
:= 0 to 127 do wc2shitmap
[cp1251
[f
]] := AnsiChar(f
+128);
173 wc2shitmapInited
:= true;
177 function wchar2win (wc
: WideChar
): AnsiChar
; inline;
179 if not wc2shitmapInited
then initShitMap();
180 if (LongWord(wc
) > 65535) then result
:= '?' else result
:= wc2shitmap
[LongWord(wc
)];
184 // ////////////////////////////////////////////////////////////////////////// //
185 function fuiOnSDLEvent (var ev
: TSDL_Event
): Boolean;
191 function buildBut (b
: Byte): Word;
195 SDL_BUTTON_LEFT
: result
:= result
or TFUIEvent
.Left
;
196 SDL_BUTTON_MIDDLE
: result
:= result
or TFUIEvent
.Middle
;
197 SDL_BUTTON_RIGHT
: result
:= result
or TFUIEvent
.Right
;
201 procedure windowEventHandler (constref ev
: TSDL_WindowEvent
);
204 SDL_WINDOWEVENT_MINIMIZED
: if fuiWinActive
then begin fuiResetKMState(true); fuiWinActive
:= false; if assigned(winBlurCB
) then winBlurCB(); end;
205 SDL_WINDOWEVENT_RESIZED
, SDL_WINDOWEVENT_SIZE_CHANGED
:
207 if (ev
.data1
<> fuiScrWdt
) or (ev
.data2
<> fuiScrHgt
) then
209 fuiScrWdt
:= ev
.data1
;
210 fuiScrHgt
:= ev
.data2
;
211 if assigned(fuiResizeCB
) then fuiResizeCB();
214 SDL_WINDOWEVENT_EXPOSED
: if assigned(exposeFrameCB
) then exposeFrameCB();
215 SDL_WINDOWEVENT_FOCUS_GAINED
: if not fuiWinActive
then begin fuiWinActive
:= true; if assigned(winFocusCB
) then winFocusCB(); end;
216 SDL_WINDOWEVENT_FOCUS_LOST
: if fuiWinActive
then begin fuiResetKMState(true); fuiWinActive
:= false; if assigned(winBlurCB
) then winBlurCB(); end;
224 SDL_WINDOWEVENT
: windowEventHandler(ev
.window
);
225 SDL_QUITEV
: fuiQuitReceived
:= true;
227 SDL_KEYDOWN
, SDL_KEYUP
:
229 // fix left/right modifiers
230 if (ev
.type_
= SDL_KEYDOWN
) then
232 fev
:= TFUIEvent
.Create(TFUIEvent
.TType
.Key
, TFUIEvent
.TKind
.Press
);
236 fev
:= TFUIEvent
.Create(TFUIEvent
.TType
.Key
, TFUIEvent
.TKind
.Release
);
238 fev
.scan
:= ev
.key
.keysym
.scancode
;
240 if (fev
.scan
= SDL_SCANCODE_RCTRL
) then fev
.scan
:= SDL_SCANCODE_LCTRL
;
241 if (fev
.scan
= SDL_SCANCODE_RALT
) then fev
.scan
:= SDL_SCANCODE_LALT
;
242 if (fev
.scan
= SDL_SCANCODE_RSHIFT
) then fev
.scan
:= SDL_SCANCODE_LSHIFT
;
243 if (fev
.scan
= SDL_SCANCODE_RGUI
) then fev
.scan
:= SDL_SCANCODE_LGUI
;
247 fev
.bstate
:= fuiButState
;
248 fev
.kstate
:= fuiModState
;
251 SDL_SCANCODE_LCTRL
: if (fev
.press
) then fuiSetModState(fuiModState
or TFUIEvent
.ModCtrl
) else fuiSetModState(fuiModState
and (not TFUIEvent
.ModCtrl
));
252 SDL_SCANCODE_LALT
: if (fev
.press
) then fuiSetModState(fuiModState
or TFUIEvent
.ModAlt
) else fuiSetModState(fuiModState
and (not TFUIEvent
.ModAlt
));
253 SDL_SCANCODE_LSHIFT
: if (fev
.press
) then fuiSetModState(fuiModState
or TFUIEvent
.ModShift
) else fuiSetModState(fuiModState
and (not TFUIEvent
.ModShift
));
256 if (assigned(fuiEventCB
)) then
263 SDL_MOUSEBUTTONDOWN
, SDL_MOUSEBUTTONUP
:
265 if (ev
.type_
= SDL_MOUSEBUTTONDOWN
) then
267 fev
:= TFUIEvent
.Create(TFUIEvent
.TType
.Mouse
, TFUIEvent
.TKind
.Press
);
271 fev
:= TFUIEvent
.Create(TFUIEvent
.TType
.Mouse
, TFUIEvent
.TKind
.Release
);
273 fev
.dx
:= ev
.button
.x
-fuiMouseX
;
274 fev
.dy
:= ev
.button
.y
-fuiMouseY
;
275 fuiSetMouseX(ev
.button
.x
);
276 fuiSetMouseY(ev
.button
.y
);
277 fev
.but
:= buildBut(ev
.button
.button
);
280 fev
.bstate
:= fuiButState
;
281 fev
.kstate
:= fuiModState
;
282 if (fev
.but
<> 0) then
284 // ev.button.clicks: Byte
285 if (ev
.type_
= SDL_MOUSEBUTTONDOWN
) then fuiSetButState(fuiButState
or fev
.but
) else fuiSetButState(fuiButState
and (not fev
.but
));
286 if (assigned(fuiEventCB
)) then
295 if (ev
.wheel
.y
<> 0) then
297 fev
:= TFUIEvent
.Create(TFUIEvent
.TType
.Mouse
, TFUIEvent
.TKind
.Press
);
299 fev
.dy
:= ev
.wheel
.y
;
300 if (ev
.wheel
.y
< 0) then fev
.but
:= TFUIEvent
.WheelUp
else fev
.but
:= TFUIEvent
.WheelDown
;
303 fev
.bstate
:= fuiButState
;
304 fev
.kstate
:= fuiModState
;
305 if (assigned(fuiEventCB
)) then
314 fev
:= TFUIEvent
.Create(TFUIEvent
.TType
.Mouse
, TFUIEvent
.TKind
.Motion
);
315 fev
.dx
:= ev
.button
.x
-fuiMouseX
;
316 fev
.dy
:= ev
.button
.y
-fuiMouseY
;
317 fuiSetMouseX(ev
.button
.x
);
318 fuiSetMouseY(ev
.button
.y
);
322 fev
.bstate
:= fuiButState
;
323 fev
.kstate
:= fuiModState
;
324 if (assigned(fuiEventCB
)) then
332 if ((fuiModState
and (not TFUIEvent
.ModShift
)) = 0) then
334 Utf8ToUnicode(@uc
, PChar(ev
.text.text), 1);
336 if (keychr
> 127) then keychr
:= Word(wchar2win(WideChar(keychr
)));
337 if (keychr
> 0) and (assigned(fuiEventCB
)) then
339 fev
:= TFUIEvent
.Create(TFUIEvent
.TType
.Key
, TFUIEvent
.TKind
.SimpleChar
);
340 fev
.ch
:= AnsiChar(keychr
);
343 fev
.bstate
:= fuiButState
;
344 fev
.kstate
:= fuiModState
;
355 fuiWinActive
:= fuiWinActive
;
356 fuiScrWdt
:= fuiScrWdt
;
357 fuiScrHgt
:= fuiScrHgt
;