DEADSOFTWARE

utils: more useless APIs
[d2df-sdl.git] / src / flexui / sdlcarcass.pas
1 (* Copyright (C) Doom 2D: Forever Developers
2 *
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.
6 *
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.
11 *
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/>.
14 *)
15 {$INCLUDE ../shared/a_modes.inc}
16 unit sdlcarcass;
18 interface
20 uses
21 SDL2, fui_events;
24 // ////////////////////////////////////////////////////////////////////////// //
25 // call this with SDL2 event; returns `true` if event was eaten
26 function fuiOnSDLEvent (var ev: TSDL_Event): Boolean;
29 // ////////////////////////////////////////////////////////////////////////// //
30 // event handlers
31 var
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
34 // for standalone
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
38 //
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;
46 var
47 // default size
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
67 implementation
69 uses
70 SysUtils, Classes,
71 {$INCLUDE ../nogl/noGLuses.inc}
72 {$IF DEFINED(LINUX) OR DEFINED(ANDROID)}
73 unixtype, linux
74 {$ELSEIF DEFINED(WINDOWS)}
75 Windows
76 {$ELSEIF DEFINED(HAIKU)}
77 unixtype
78 {$ELSE}
79 {$WARNING You suck!}
80 {$ENDIF}
81 ;
84 // ////////////////////////////////////////////////////////////////////////// //
85 var
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 // ////////////////////////////////////////////////////////////////////////// //
93 {$IF DEFINED(LINUX)}
94 type THPTimeType = TTimeSpec;
95 {$ELSE}
96 type THPTimeType = Int64;
97 {$ENDIF}
99 var
100 mFrequency: Int64 = 0;
101 mHasHPTimer: Boolean = false;
103 procedure initTimerIntr ();
104 var
105 r: THPTimeType;
106 begin
107 if (mFrequency = 0) then
108 begin
109 {$IF DEFINED(LINUX)}
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');
118 mFrequency := r;
119 {$ENDIF}
120 end;
121 end;
124 function fuiTimeMicro (): UInt64; inline;
125 var
126 r: THPTimeType;
127 begin
128 //if (mFrequency = 0) then initTimerIntr();
129 {$IF DEFINED(LINUX)}
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;
135 {$ENDIF}
136 end;
139 function fuiTimeMilli (): UInt64; inline;
140 begin
141 result := fuiTimeMicro() div 1000;
142 end;
145 // ////////////////////////////////////////////////////////////////////////// //
146 var
147 wc2shitmap: array[0..65535] of AnsiChar;
148 wc2shitmapInited: Boolean = false;
151 // ////////////////////////////////////////////////////////////////////////// //
152 const
153 cp1251: array[0..127] of Word = (
154 $0402,$0403,$201A,$0453,$201E,$2026,$2020,$2021,$20AC,$2030,$0409,$2039,$040A,$040C,$040B,$040F,
155 $0452,$2018,$2019,$201C,$201D,$2022,$2013,$2014,$003F,$2122,$0459,$203A,$045A,$045C,$045B,$045F,
156 $00A0,$040E,$045E,$0408,$00A4,$0490,$00A6,$00A7,$0401,$00A9,$0404,$00AB,$00AC,$00AD,$00AE,$0407,
157 $00B0,$00B1,$0406,$0456,$0491,$00B5,$00B6,$00B7,$0451,$2116,$0454,$00BB,$0458,$0405,$0455,$0457,
158 $0410,$0411,$0412,$0413,$0414,$0415,$0416,$0417,$0418,$0419,$041A,$041B,$041C,$041D,$041E,$041F,
159 $0420,$0421,$0422,$0423,$0424,$0425,$0426,$0427,$0428,$0429,$042A,$042B,$042C,$042D,$042E,$042F,
160 $0430,$0431,$0432,$0433,$0434,$0435,$0436,$0437,$0438,$0439,$043A,$043B,$043C,$043D,$043E,$043F,
161 $0440,$0441,$0442,$0443,$0444,$0445,$0446,$0447,$0448,$0449,$044A,$044B,$044C,$044D,$044E,$044F
162 );
165 procedure initShitMap ();
166 var
167 f: Integer;
168 begin
169 for f := 0 to High(wc2shitmap) do wc2shitmap[f] := '?';
170 for f := 0 to 127 do wc2shitmap[f] := AnsiChar(f);
171 for f := 0 to 127 do wc2shitmap[cp1251[f]] := AnsiChar(f+128);
172 wc2shitmapInited := true;
173 end;
176 function wchar2win (wc: WideChar): AnsiChar; inline;
177 begin
178 if not wc2shitmapInited then initShitMap();
179 if (LongWord(wc) > 65535) then result := '?' else result := wc2shitmap[LongWord(wc)];
180 end;
183 // ////////////////////////////////////////////////////////////////////////// //
184 function fuiOnSDLEvent (var ev: TSDL_Event): Boolean;
185 var
186 fev: TFUIEvent;
187 uc: UnicodeChar;
188 keychr: Word;
190 function buildBut (b: Byte): Word;
191 begin
192 result := 0;
193 case b of
194 SDL_BUTTON_LEFT: result := result or TFUIEvent.Left;
195 SDL_BUTTON_MIDDLE: result := result or TFUIEvent.Middle;
196 SDL_BUTTON_RIGHT: result := result or TFUIEvent.Right;
197 end;
198 end;
200 procedure windowEventHandler (constref ev: TSDL_WindowEvent);
201 begin
202 case ev.event of
203 SDL_WINDOWEVENT_MINIMIZED: if fuiWinActive then begin fuiResetKMState(true); fuiWinActive := false; if assigned(winBlurCB) then winBlurCB(); end;
204 SDL_WINDOWEVENT_RESIZED, SDL_WINDOWEVENT_SIZE_CHANGED:
205 begin
206 if (ev.data1 <> fuiScrWdt) or (ev.data2 <> fuiScrHgt) then
207 begin
208 fuiScrWdt := ev.data1;
209 fuiScrHgt := ev.data2;
210 if assigned(fuiResizeCB) then fuiResizeCB();
211 end;
212 end;
213 SDL_WINDOWEVENT_EXPOSED: if assigned(exposeFrameCB) then exposeFrameCB();
214 SDL_WINDOWEVENT_FOCUS_GAINED: if not fuiWinActive then begin fuiWinActive := true; if assigned(winFocusCB) then winFocusCB(); end;
215 SDL_WINDOWEVENT_FOCUS_LOST: if fuiWinActive then begin fuiResetKMState(true); fuiWinActive := false; if assigned(winBlurCB) then winBlurCB(); end;
216 end;
217 end;
219 begin
220 result := false;
222 case ev.type_ of
223 SDL_WINDOWEVENT: windowEventHandler(ev.window);
224 SDL_QUITEV: fuiQuitReceived := true;
226 SDL_KEYDOWN, SDL_KEYUP:
227 begin
228 // fix left/right modifiers
229 if (ev.type_ = SDL_KEYDOWN) then
230 begin
231 fev := TFUIEvent.Create(TFUIEvent.TType.Key, TFUIEvent.TKind.Press);
232 end
233 else
234 begin
235 fev := TFUIEvent.Create(TFUIEvent.TType.Key, TFUIEvent.TKind.Release);
236 end;
237 fev.scan := ev.key.keysym.scancode;
239 if (fev.scan = SDL_SCANCODE_RCTRL) then fev.scan := SDL_SCANCODE_LCTRL;
240 if (fev.scan = SDL_SCANCODE_RALT) then fev.scan := SDL_SCANCODE_LALT;
241 if (fev.scan = SDL_SCANCODE_RSHIFT) then fev.scan := SDL_SCANCODE_LSHIFT;
242 if (fev.scan = SDL_SCANCODE_RGUI) then fev.scan := SDL_SCANCODE_LGUI;
244 fev.x := fuiMouseX;
245 fev.y := fuiMouseY;
246 fev.bstate := fuiButState;
247 fev.kstate := fuiModState;
249 case fev.scan of
250 SDL_SCANCODE_LCTRL: if (fev.press) then fuiSetModState(fuiModState or TFUIEvent.ModCtrl) else fuiSetModState(fuiModState and (not TFUIEvent.ModCtrl));
251 SDL_SCANCODE_LALT: if (fev.press) then fuiSetModState(fuiModState or TFUIEvent.ModAlt) else fuiSetModState(fuiModState and (not TFUIEvent.ModAlt));
252 SDL_SCANCODE_LSHIFT: if (fev.press) then fuiSetModState(fuiModState or TFUIEvent.ModShift) else fuiSetModState(fuiModState and (not TFUIEvent.ModShift));
253 end;
255 if (assigned(fuiEventCB)) then
256 begin
257 fuiEventCB(fev);
258 result := fev.eaten;
259 end;
260 end;
262 SDL_MOUSEBUTTONDOWN, SDL_MOUSEBUTTONUP:
263 begin
264 if (ev.type_ = SDL_MOUSEBUTTONDOWN) then
265 begin
266 fev := TFUIEvent.Create(TFUIEvent.TType.Mouse, TFUIEvent.TKind.Press);
267 end
268 else
269 begin
270 fev := TFUIEvent.Create(TFUIEvent.TType.Mouse, TFUIEvent.TKind.Release);
271 end;
272 fev.dx := ev.button.x-fuiMouseX;
273 fev.dy := ev.button.y-fuiMouseY;
274 fuiSetMouseX(ev.button.x);
275 fuiSetMouseY(ev.button.y);
276 fev.but := buildBut(ev.button.button);
277 fev.x := fuiMouseX;
278 fev.y := fuiMouseY;
279 fev.bstate := fuiButState;
280 fev.kstate := fuiModState;
281 if (fev.but <> 0) then
282 begin
283 // ev.button.clicks: Byte
284 if (ev.type_ = SDL_MOUSEBUTTONDOWN) then fuiSetButState(fuiButState or fev.but) else fuiSetButState(fuiButState and (not fev.but));
285 if (assigned(fuiEventCB)) then
286 begin
287 fuiEventCB(fev);
288 result := fev.eaten;
289 end;
290 end;
291 end;
292 SDL_MOUSEWHEEL:
293 begin
294 if (ev.wheel.y <> 0) then
295 begin
296 fev := TFUIEvent.Create(TFUIEvent.TType.Mouse, TFUIEvent.TKind.Press);
297 fev.dx := 0;
298 fev.dy := ev.wheel.y;
299 if (ev.wheel.y < 0) then fev.but := TFUIEvent.WheelUp else fev.but := TFUIEvent.WheelDown;
300 fev.x := fuiMouseX;
301 fev.y := fuiMouseY;
302 fev.bstate := fuiButState;
303 fev.kstate := fuiModState;
304 if (assigned(fuiEventCB)) then
305 begin
306 fuiEventCB(fev);
307 result := fev.eaten;
308 end;
309 end;
310 end;
311 SDL_MOUSEMOTION:
312 begin
313 fev := TFUIEvent.Create(TFUIEvent.TType.Mouse, TFUIEvent.TKind.Motion);
314 fev.dx := ev.button.x-fuiMouseX;
315 fev.dy := ev.button.y-fuiMouseY;
316 fuiSetMouseX(ev.button.x);
317 fuiSetMouseY(ev.button.y);
318 fev.but := 0;
319 fev.x := fuiMouseX;
320 fev.y := fuiMouseY;
321 fev.bstate := fuiButState;
322 fev.kstate := fuiModState;
323 if (assigned(fuiEventCB)) then
324 begin
325 fuiEventCB(fev);
326 result := fev.eaten;
327 end;
328 end;
330 SDL_TEXTINPUT:
331 if ((fuiModState and (not TFUIEvent.ModShift)) = 0) then
332 begin
333 Utf8ToUnicode(@uc, PChar(ev.text.text), 1);
334 keychr := Word(uc);
335 if (keychr > 127) then keychr := Word(wchar2win(WideChar(keychr)));
336 if (keychr > 0) and (assigned(fuiEventCB)) then
337 begin
338 fev := TFUIEvent.Create(TFUIEvent.TType.Key, TFUIEvent.TKind.SimpleChar);
339 fev.ch := AnsiChar(keychr);
340 fev.x := fuiMouseX;
341 fev.y := fuiMouseY;
342 fev.bstate := fuiButState;
343 fev.kstate := fuiModState;
344 fuiEventCB(fev);
345 result := fev.eaten;
346 end;
347 end;
348 end;
349 end;
352 begin
353 initTimerIntr();
354 fuiWinActive := fuiWinActive;
355 fuiScrWdt := fuiScrWdt;
356 fuiScrHgt := fuiScrHgt;
357 end.