79a21e77a0763b1876bb008b7b7ef614e39763c0
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, either version 3 of the License, or
6 * (at your option) any later version.
7 *
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.
12 *
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/>.
15 *)
16 // ////////////////////////////////////////////////////////////////////////// //
17 type
18 THControl = class
19 public
20 type TActionCB = procedure (me: THControl; uinfo: Integer);
22 private
23 mParent: THControl;
24 mX, mY: Integer;
25 mWidth, mHeight: Integer;
26 mFrameWidth, mFrameHeight: Integer;
27 mEnabled: Boolean;
28 mCanFocus: Boolean;
29 mChildren: array of THControl;
30 mFocused: THControl; // valid only for top-level controls
31 mGrab: THControl; // valid only for top-level controls
32 mEscClose: Boolean; // valid only for top-level controls
33 mEatKeys: Boolean;
34 mDrawShadow: Boolean;
36 private
37 scallowed: Boolean;
38 scxywh: array[0..3] of GLint;
40 protected
41 function getEnabled (): Boolean;
42 procedure setEnabled (v: Boolean); inline;
44 function getFocused (): Boolean; inline;
45 procedure setFocused (v: Boolean); inline;
47 function isMyChild (ctl: THControl): Boolean;
49 function findFirstFocus (): THControl;
50 function findLastFocus (): THControl;
52 function findNextFocus (cur: THControl): THControl;
53 function findPrevFocus (cur: THControl): THControl;
55 procedure activated (); virtual;
56 procedure blurred (); virtual;
58 //WARNING! do not call scissor functions outside `.draw*()` API!
59 // reset scissor to whole control
60 procedure resetScissor ();
61 // set scissor to this internal rect (in local coords)
62 procedure setScissor (lx, ly, lw, lh: Integer);
64 // DO NOT USE!
65 procedure setScissorGLInternal (x, y, w, h: Integer);
67 public
68 // return `false` if destination rect is empty
69 // modifies rect0
70 class function intersectRect (var x0, y0, w0, h0: Integer; const x1, y1, w1, h1: Integer): Boolean;
72 public
73 actionCB: TActionCB;
75 public
76 constructor Create (ax, ay, aw, ah: Integer; aparent: THControl=nil);
77 destructor Destroy (); override;
79 // `sx` and `sy` are screen coordinates
80 procedure drawControl (sx, sy: Integer); virtual;
82 // called after all children drawn
83 procedure drawControlPost (sx, sy: Integer); virtual;
85 procedure draw (); virtual;
87 function topLevel (): THControl; inline;
89 // returns `true` if global coords are inside this control
90 function toLocal (var x, y: Integer): Boolean;
91 procedure toGlobal (var x, y: Integer);
93 // x and y are global coords
94 function controlAtXY (x, y: Integer): THControl;
96 function mouseEvent (var ev: THMouseEvent): Boolean; virtual; // returns `true` if event was eaten
97 function keyEvent (var ev: THKeyEvent): Boolean; virtual; // returns `true` if event was eaten
99 function prevSibling (): THControl;
100 function nextSibling (): THControl;
101 function firstChild (): THControl; inline;
102 function lastChild (): THControl; inline;
104 procedure appendChild (ctl: THControl); virtual;
106 public
107 property x0: Integer read mX;
108 property y0: Integer read mY;
109 property height: Integer read mHeight;
110 property width: Integer read mWidth;
111 property enabled: Boolean read getEnabled write setEnabled;
112 property parent: THControl read mParent;
113 property focused: Boolean read getFocused write setFocused;
114 property escClose: Boolean read mEscClose write mEscClose;
115 property eatKeys: Boolean read mEatKeys write mEatKeys;
116 end;
119 THTopWindow = class(THControl)
120 private
121 mTitle: AnsiString;
122 mDragging: Boolean;
123 mDragStartX, mDragStartY: Integer;
124 mWaitingClose: Boolean;
125 mInClose: Boolean;
127 protected
128 procedure blurred (); override;
130 public
131 closeCB: TActionCB; // called after window was removed from ui window list
133 public
134 constructor Create (const atitle: AnsiString; ax, ay: Integer; aw: Integer=-1; ah: Integer=-1);
136 // `sx` and `sy` are screen coordinates
137 procedure drawControl (sx, sy: Integer); override;
138 procedure drawControlPost (sx, sy: Integer); override;
140 function keyEvent (var ev: THKeyEvent): Boolean; override; // returns `true` if event was eaten
141 function mouseEvent (var ev: THMouseEvent): Boolean; override; // returns `true` if event was eaten
142 end;
145 THCtlCBListBox = class(THControl)
146 private
147 type
148 PItem = ^TItem;
149 TItem = record
150 title: AnsiString;
151 varp: PBoolean;
152 actionCB: TActionCB;
153 end;
154 private
155 mItems: array of TItem;
156 mCurIndex: Integer;
158 public
159 constructor Create (ax, ay: Integer; aparent: THControl=nil);
160 destructor Destroy (); override;
162 procedure appendItem (const atext: AnsiString; bv: PBoolean; aaction: TActionCB=nil);
164 procedure drawControl (sx, sy: Integer); override;
166 function mouseEvent (var ev: THMouseEvent): Boolean; override;
167 function keyEvent (var ev: THKeyEvent): Boolean; override;
168 end;
170 // ////////////////////////////////////////////////////////////////////////// //
171 var
172 uiTopList: array of THControl = nil;
175 function uiMouseEvent (var ev: THMouseEvent): Boolean;
176 var
177 f, c: Integer;
178 lx, ly: Integer;
179 ctmp: THControl;
180 begin
181 if (Length(uiTopList) = 0) then result := false else result := uiTopList[High(uiTopList)].mouseEvent(ev);
182 if not result and (ev.kind = ev.Press) then
183 begin
184 for f := High(uiTopList) downto 0 do
185 begin
186 lx := ev.x;
187 ly := ev.y;
188 if uiTopList[f].toLocal(lx, ly) then
189 begin
190 result := true;
191 if uiTopList[f].mEnabled and (f <> High(uiTopList)) then
192 begin
193 uiTopList[High(uiTopList)].blurred();
194 ctmp := uiTopList[f];
195 ctmp.mGrab := nil;
196 for c := f+1 to High(uiTopList) do uiTopList[c-1] := uiTopList[c];
197 uiTopList[High(uiTopList)] := ctmp;
198 ctmp.activated();
199 result := ctmp.mouseEvent(ev);
200 end;
201 exit;
202 end;
203 end;
204 end;
205 end;
208 function uiKeyEvent (var ev: THKeyEvent): Boolean;
209 begin
210 if (Length(uiTopList) = 0) then result := false else result := uiTopList[High(uiTopList)].keyEvent(ev);
211 if (ev.kind = ev.Release) then begin result := true; exit; end;
212 end;
215 procedure uiDraw ();
216 var
217 f: Integer;
218 ctl: THControl;
219 begin
220 for f := 0 to High(uiTopList) do
221 begin
222 ctl := uiTopList[f];
223 ctl.draw();
224 if (f <> High(uiTopList)) then darkenRect(ctl.x0, ctl.y0, ctl.width, ctl.height, 128);
225 end;
226 end;
229 procedure uiAddWindow (ctl: THControl);
230 var
231 f, c: Integer;
232 begin
233 if (ctl = nil) then exit;
234 ctl := ctl.topLevel;
235 for f := 0 to High(uiTopList) do
236 begin
237 if (uiTopList[f] = ctl) then
238 begin
239 if (f <> High(uiTopList)) then
240 begin
241 uiTopList[High(uiTopList)].blurred();
242 for c := f+1 to High(uiTopList) do uiTopList[c-1] := uiTopList[c];
243 uiTopList[High(uiTopList)] := ctl;
244 ctl.activated();
245 end;
246 exit;
247 end;
248 end;
249 if (Length(uiTopList) > 0) then uiTopList[High(uiTopList)].blurred();
250 SetLength(uiTopList, Length(uiTopList)+1);
251 uiTopList[High(uiTopList)] := ctl;
252 ctl.activated();
253 end;
256 // won't free object
257 procedure uiRemoveWindow (ctl: THControl);
258 var
259 f, c: Integer;
260 begin
261 if (ctl = nil) then exit;
262 ctl := ctl.topLevel;
263 for f := 0 to High(uiTopList) do
264 begin
265 if (uiTopList[f] = ctl) then
266 begin
267 ctl.blurred();
268 for c := f+1 to High(uiTopList) do uiTopList[c-1] := uiTopList[c];
269 SetLength(uiTopList, Length(uiTopList)-1);
270 if (ctl is THTopWindow) then
271 begin
272 if assigned(THTopWindow(ctl).closeCB) then THTopWindow(ctl).closeCB(ctl, 0);
273 end;
274 exit;
275 end;
276 end;
277 end;
280 function uiVisibleWindow (ctl: THControl): Boolean;
281 var
282 f: Integer;
283 begin
284 result := false;
285 if (ctl = nil) then exit;
286 ctl := ctl.topLevel;
287 for f := 0 to High(uiTopList) do
288 begin
289 if (uiTopList[f] = ctl) then begin result := true; exit; end;
290 end;
291 end;
294 // ////////////////////////////////////////////////////////////////////////// //
295 constructor THControl.Create (ax, ay, aw, ah: Integer; aparent: THControl=nil);
296 begin
297 mParent := aparent;
298 mX := ax;
299 mY := ay;
300 mWidth := aw;
301 mHeight := ah;
302 mFrameWidth := 0;
303 mFrameHeight := 0;
304 mEnabled := true;
305 mCanFocus := true;
306 mChildren := nil;
307 mFocused := nil;
308 mGrab := nil;
309 mEscClose := false;
310 mEatKeys := false;
311 scallowed := false;
312 mDrawShadow := false;
313 actionCB := nil;
314 end;
317 destructor THControl.Destroy ();
318 var
319 f, c: Integer;
320 begin
321 if (mParent <> nil) then
322 begin
323 setFocused(false);
324 for f := 0 to High(mParent.mChildren) do
325 begin
326 if (mParent.mChildren[f] = self) then
327 begin
328 for c := f+1 to High(mParent.mChildren) do mParent.mChildren[c-1] := mParent.mChildren[c];
329 SetLength(mParent.mChildren, Length(mParent.mChildren)-1);
330 end;
331 end;
332 end;
333 for f := 0 to High(mChildren) do
334 begin
335 mChildren[f].mParent := nil;
336 mChildren[f].Free();
337 end;
338 mChildren := nil;
339 end;
342 procedure THControl.activated ();
343 begin
344 end;
347 procedure THControl.blurred ();
348 begin
349 mGrab := nil;
350 end;
353 function THControl.topLevel (): THControl; inline;
354 begin
355 result := self;
356 while (result.mParent <> nil) do result := result.mParent;
357 end;
360 function THControl.getEnabled (): Boolean;
361 var
362 ctl: THControl;
363 begin
364 result := false;
365 if (not mEnabled) or (mWidth < 1) or (mHeight < 1) then exit;
366 ctl := mParent;
367 while (ctl <> nil) do
368 begin
369 if (not ctl.mEnabled) or (ctl.mWidth < 1) or (ctl.mHeight < 1) then exit;
370 ctl := ctl.mParent;
371 end;
372 result := true;
373 end;
376 procedure THControl.setEnabled (v: Boolean); inline;
377 begin
378 if (mEnabled = v) then exit;
379 mEnabled := v;
380 if not v and focused then setFocused(false);
381 end;
384 function THControl.getFocused (): Boolean; inline;
385 begin
386 if (mParent = nil) then result := (Length(uiTopList) > 0) and (uiTopList[High(uiTopList)] = self) else result := (topLevel.mFocused = self);
387 end;
390 procedure THControl.setFocused (v: Boolean); inline;
391 var
392 tl: THControl;
393 begin
394 tl := topLevel;
395 if not v then
396 begin
397 if (tl.mFocused = self) then
398 begin
399 tl.blurred();
400 tl.mFocused := tl.findNextFocus(self);
401 if (tl.mFocused = self) then tl.mFocused := nil;
402 end;
403 exit;
404 end;
405 if (not mEnabled) or (not mCanFocus) then exit;
406 if (tl.mFocused <> self) then
407 begin
408 tl.mFocused.blurred();
409 tl.mFocused := self;
410 if (tl.mGrab <> self) then tl.mGrab := nil;
411 activated();
412 end;
413 end;
416 function THControl.isMyChild (ctl: THControl): Boolean;
417 begin
418 result := true;
419 while (ctl <> nil) do
420 begin
421 if (ctl.mParent = self) then exit;
422 ctl := ctl.mParent;
423 end;
424 result := false;
425 end;
428 // returns `true` if global coords are inside this control
429 function THControl.toLocal (var x, y: Integer): Boolean;
430 var
431 ctl: THControl;
432 begin
433 ctl := self;
434 while (ctl <> nil) do
435 begin
436 Dec(x, ctl.mX);
437 Dec(y, ctl.mY);
438 ctl := ctl.mParent;
439 end;
440 result := (x >= 0) and (y >= 0) and (x < mWidth) and (y < mHeight);
441 end;
444 procedure THControl.toGlobal (var x, y: Integer);
445 var
446 ctl: THControl;
447 begin
448 ctl := self;
449 while (ctl <> nil) do
450 begin
451 Inc(x, ctl.mX);
452 Inc(y, ctl.mY);
453 ctl := ctl.mParent;
454 end;
455 end;
458 // x and y are global coords
459 function THControl.controlAtXY (x, y: Integer): THControl;
460 var
461 lx, ly: Integer;
462 f: Integer;
463 begin
464 result := nil;
465 if (not mEnabled) or (mWidth < 1) or (mHeight < 1) then exit;
466 lx := x;
467 ly := y;
468 if not toLocal(lx, ly) then exit;
469 for f := High(mChildren) downto 0 do
470 begin
471 result := mChildren[f].controlAtXY(x, y);
472 if (result <> nil) then exit;
473 end;
474 result := self;
475 end;
478 function THControl.prevSibling (): THControl;
479 var
480 f: Integer;
481 begin
482 if (mParent <> nil) then
483 begin
484 for f := 1 to High(mParent.mChildren) do
485 begin
486 if (mParent.mChildren[f] = self) then begin result := mParent.mChildren[f-1]; exit; end;
487 end;
488 end;
489 result := nil;
490 end;
492 function THControl.nextSibling (): THControl;
493 var
494 f: Integer;
495 begin
496 if (mParent <> nil) then
497 begin
498 for f := 0 to High(mParent.mChildren)-1 do
499 begin
500 if (mParent.mChildren[f] = self) then begin result := mParent.mChildren[f+1]; exit; end;
501 end;
502 end;
503 result := nil;
504 end;
506 function THControl.firstChild (): THControl; inline;
507 begin
508 if (Length(mChildren) <> 0) then result := mChildren[0] else result := nil;
509 end;
511 function THControl.lastChild (): THControl; inline;
512 begin
513 if (Length(mChildren) <> 0) then result := mChildren[High(mChildren)] else result := nil;
514 end;
517 function THControl.findFirstFocus (): THControl;
518 var
519 f: Integer;
520 begin
521 result := nil;
522 if enabled then
523 begin
524 for f := 0 to High(mChildren) do
525 begin
526 result := mChildren[f].findFirstFocus();
527 if (result <> nil) then exit;
528 end;
529 if mCanFocus then result := self;
530 end;
531 end;
534 function THControl.findLastFocus (): THControl;
535 var
536 f: Integer;
537 begin
538 result := nil;
539 if enabled then
540 begin
541 for f := High(mChildren) downto 0 do
542 begin
543 result := mChildren[f].findLastFocus();
544 if (result <> nil) then exit;
545 end;
546 if mCanFocus then result := self;
547 end;
548 end;
551 function THControl.findNextFocus (cur: THControl): THControl;
552 begin
553 result := nil;
554 if enabled then
555 begin
556 if not isMyChild(cur) then cur := nil;
557 if (cur = nil) then begin result := findFirstFocus(); exit; end;
558 result := cur.findFirstFocus();
559 if (result <> nil) and (result <> cur) then exit;
560 while true do
561 begin
562 cur := cur.nextSibling;
563 if (cur = nil) then break;
564 result := cur.findFirstFocus();
565 if (result <> nil) then exit;
566 end;
567 result := findFirstFocus();
568 end;
569 end;
572 function THControl.findPrevFocus (cur: THControl): THControl;
573 begin
574 result := nil;
575 if enabled then
576 begin
577 if not isMyChild(cur) then cur := nil;
578 if (cur = nil) then begin result := findLastFocus(); exit; end;
579 //FIXME!
580 result := cur.findLastFocus();
581 if (result <> nil) and (result <> cur) then exit;
582 while true do
583 begin
584 cur := cur.prevSibling;
585 if (cur = nil) then break;
586 result := cur.findLastFocus();
587 if (result <> nil) then exit;
588 end;
589 result := findLastFocus();
590 end;
591 end;
594 procedure THControl.appendChild (ctl: THControl);
595 begin
596 if (ctl = nil) then exit;
597 if (ctl.mParent <> nil) then exit;
598 SetLength(mChildren, Length(mChildren)+1);
599 mChildren[High(mChildren)] := ctl;
600 ctl.mParent := self;
601 Inc(ctl.mX, mFrameWidth);
602 Inc(ctl.mY, mFrameHeight);
603 if (ctl.mWidth > 0) and (ctl.mHeight > 0) and
604 (ctl.mX+ctl.mWidth > mFrameWidth) and (ctl.mY+ctl.mHeight > mFrameHeight) then
605 begin
606 if (mWidth+mFrameWidth < ctl.mX+ctl.mWidth) then mWidth := ctl.mX+ctl.mWidth+mFrameWidth;
607 if (mHeight+mFrameHeight < ctl.mY+ctl.mHeight) then mHeight := ctl.mY+ctl.mHeight+mFrameHeight;
608 end;
609 if (mFocused = nil) and ctl.mEnabled and ctl.mCanFocus and (ctl.mWidth > 0) and (ctl.mHeight > 0) then mFocused := ctl;
610 end;
613 //TODO: overflow checks
614 class function THControl.intersectRect (var x0, y0, w0, h0: Integer; const x1, y1, w1, h1: Integer): Boolean;
615 var
616 ex0, ey0: Integer;
617 begin
618 result := false;
619 if (w0 < 1) or (h0 < 1) or (w1 < 1) or (h1 < 1) then exit;
620 // check for intersection
621 if (x0+w0 <= x1) or (y0+h0 <= y1) or (x1+w1 <= x0) or (y1+h1 <= y0) then exit;
622 if (x0 >= x1+w1) or (y0 >= y1+h1) or (x1 >= x0+h0) or (y1 >= y0+h0) then exit;
623 // ok, intersects
624 ex0 := x0+w0;
625 ey0 := y0+h0;
626 if (x0 < x1) then x0 := x1;
627 if (y0 < y1) then y0 := y1;
628 if (ex0 > x1+w1) then ex0 := x1+w1;
629 if (ey0 > y1+h1) then ey0 := y1+h1;
630 w0 := ex0-x0;
631 h0 := ey0-y0;
632 result := (w0 > 0) and (h0 > 0);
633 end;
636 procedure THControl.setScissorGLInternal (x, y, w, h: Integer);
637 begin
638 if not scallowed then exit;
639 y := gWinSizeY-(y+h);
640 if not intersectRect(x, y, w, h, scxywh[0], scxywh[1], scxywh[2], scxywh[3]) then glScissor(0, 0, 0, 0) else glScissor(x, y, w, h);
641 end;
644 procedure THControl.resetScissor ();
645 var
646 x, y: Integer;
647 begin
648 if not scallowed then exit;
649 x := 0;
650 y := 0;
651 toGlobal(x, y);
652 setScissorGLInternal(x, y, mWidth, mHeight);
653 end;
656 procedure THControl.setScissor (lx, ly, lw, lh: Integer);
657 var
658 x, y: Integer;
659 begin
660 if not scallowed then exit;
661 if not intersectRect(lx, ly, lw, lh, 0, 0, mWidth, mHeight) then begin glScissor(0, 0, 0, 0); exit; end;
662 x := lx;
663 y := ly;
664 toGlobal(x, y);
665 setScissorGLInternal(x, y, lw, lh);
666 end;
669 procedure THControl.draw ();
670 var
671 f: Integer;
672 x, y: Integer;
673 wassc: Boolean;
674 begin
675 if (mWidth < 1) or (mHeight < 1) then exit;
676 x := 0;
677 y := 0;
678 toGlobal(x, y);
679 //conwritefln('[%s]: (%d,%d)-(%d,%d) (%d,%d)', [ClassName, mX, mY, mWidth, mHeight, x, y]);
681 scxywh[0] := 0;
682 scxywh[1] := 0;
683 scxywh[2] := 0;
684 scxywh[3] := 0;
686 wassc := (glIsEnabled(GL_SCISSOR_TEST) <> 0);
687 if wassc then glGetIntegerv(GL_SCISSOR_BOX, @scxywh[0]) else glGetIntegerv(GL_VIEWPORT, @scxywh[0]);
688 //conwritefln('(%d,%d)-(%d,%d)', [scxywh[0], scxywh[1], scxywh[2], scxywh[3]]);
689 glEnable(GL_SCISSOR_TEST);
690 scallowed := true;
692 resetScissor();
693 drawControl(x, y);
694 if (mFrameWidth <> 0) or (mFrameHeight <> 0) then setScissor(mFrameWidth, mFrameHeight, mWidth-mFrameWidth*2, mHeight-mFrameHeight*2);
695 for f := 0 to High(mChildren) do mChildren[f].draw();
696 if (mFrameWidth <> 0) or (mFrameHeight <> 0) then resetScissor();
697 drawControlPost(x, y);
698 glScissor(scxywh[0], scxywh[1], scxywh[2], scxywh[3]);
700 if wassc then glEnable(GL_SCISSOR_TEST) else glDisable(GL_SCISSOR_TEST);
701 scallowed := false;
702 end;
705 procedure THControl.drawControl (sx, sy: Integer);
706 begin
707 if (mParent = nil) then darkenRect(sx, sy, mWidth, mHeight, 64);
708 end;
711 procedure THControl.drawControlPost (sx, sy: Integer);
712 begin
713 if mDrawShadow and (mWidth > 0) and (mHeight > 0) then
714 begin
715 setScissorGLInternal(sx+8, sy+8, mWidth, mHeight);
716 darkenRect(sx+mWidth, sy+8, 8, mHeight, 128);
717 darkenRect(sx+8, sy+mHeight, mWidth-8, 8, 128);
718 end;
719 end;
722 function THControl.mouseEvent (var ev: THMouseEvent): Boolean;
723 var
724 ctl: THControl;
725 begin
726 result := false;
727 if not mEnabled then exit;
728 if (mParent = nil) then
729 begin
730 if (mGrab <> nil) then
731 begin
732 result := mGrab.mouseEvent(ev);
733 if (ev.kind = ev.Release) then mGrab := nil;
734 exit;
735 end;
736 end;
737 if (mWidth < 1) or (mHeight < 1) then exit;
738 ctl := controlAtXY(ev.x, ev.y);
739 if (ctl <> nil) and (ctl <> self) then
740 begin
741 if (ctl <> topLevel.mFocused) then ctl.setFocused(true);
742 result := ctl.mouseEvent(ev);
743 end
744 else if (ctl = self) and assigned(actionCB) then
745 begin
746 actionCB(self, 0);
747 end;
748 end;
751 function THControl.keyEvent (var ev: THKeyEvent): Boolean;
752 var
753 ctl: THControl;
754 begin
755 result := false;
756 if not mEnabled then exit;
757 if (topLevel.mFocused <> self) and isMyChild(topLevel.mFocused) and topLevel.mFocused.mEnabled then result := topLevel.mFocused.keyEvent(ev);
758 if (mParent = nil) then
759 begin
760 if (ev.kstate = THKeyEvent.ModShift) and (ev.scan = SDL_SCANCODE_TAB) then
761 begin
762 result := true;
763 if (ev.kind = ev.Press) then
764 begin
765 ctl := findPrevFocus(mFocused);
766 if (ctl <> mFocused) then
767 begin
768 mGrab := nil;
769 mFocused := ctl;
770 end;
771 end;
772 exit;
773 end;
774 if (ev.kstate = 0) and (ev.scan = SDL_SCANCODE_TAB) then
775 begin
776 result := true;
777 if (ev.kind = ev.Press) then
778 begin
779 ctl := findNextFocus(mFocused);
780 if (ctl <> mFocused) then
781 begin
782 mGrab := nil;
783 mFocused := ctl;
784 end;
785 end;
786 exit;
787 end;
788 if mEscClose and (ev.kind = ev.Press) and (ev.kstate = 0) and (ev.scan = SDL_SCANCODE_ESCAPE) then
789 begin
790 result := true;
791 uiRemoveWindow(self);
792 exit;
793 end;
794 end;
795 if mEatKeys then result := true;
796 end;
799 // ////////////////////////////////////////////////////////////////////////// //
800 constructor THTopWindow.Create (const atitle: AnsiString; ax, ay: Integer; aw: Integer=-1; ah: Integer=-1);
801 begin
802 inherited Create(ax, ay, aw, ah, nil);
803 mFrameWidth := 8;
804 mFrameHeight := 8;
805 mTitle := atitle;
806 if (mWidth < mFrameWidth*2+3*8) then mWidth := mFrameWidth*2+3*8;
807 if (mHeight < mFrameHeight*2) then mHeight := mFrameHeight*2;
808 if (Length(mTitle) > 0) then
809 begin
810 if (mWidth < Length(mTitle)*8+mFrameWidth*2+3*8) then mWidth := Length(mTitle)*8+mFrameWidth*2+3*8;
811 end;
812 mDragging := false;
813 mDrawShadow := true;
814 mWaitingClose := false;
815 mInClose := false;
816 closeCB := nil;
817 end;
820 procedure THTopWindow.drawControl (sx, sy: Integer);
821 begin
822 fillRect(sx, sy, mWidth, mHeight, 0, 0, 128);
823 end;
826 procedure THTopWindow.drawControlPost (sx, sy: Integer);
827 const r = 255;
828 const g = 255;
829 const b = 255;
830 var
831 tx: Integer;
832 begin
833 if mDragging then
834 begin
835 drawRect(mX+4, mY+4, mWidth-8, mHeight-8, r, g, b);
836 end
837 else
838 begin
839 drawRect(mX+3, mY+3, mWidth-6, mHeight-6, r, g, b);
840 drawRect(mX+5, mY+5, mWidth-10, mHeight-10, r, g, b);
841 setScissor(mFrameWidth, 0, 3*8, 8);
842 fillRect(mX+mFrameWidth, mY, 3*8, 8, 0, 0, 128);
843 drawText8(mX+mFrameWidth, mY, '[ ]', r, g, b);
844 if mInClose then drawText8(mX+mFrameWidth+7, mY, '#', 0, 255, 0)
845 else drawText8(mX+mFrameWidth+7, mY, '*', 0, 255, 0);
846 end;
847 if (Length(mTitle) > 0) then
848 begin
849 setScissor(mFrameWidth+3*8, 0, mWidth-mFrameWidth*2-3*8, 8);
850 tx := mX+(mWidth-Length(mTitle)*8) div 2;
851 fillRect(tx-3, mY, Length(mTitle)*8+3+2, 8, 0, 0, 128);
852 drawText8(tx, mY, mTitle, r, g, b);
853 end;
854 inherited drawControlPost(sx, sy);
855 end;
858 procedure THTopWindow.blurred ();
859 begin
860 mDragging := false;
861 mWaitingClose := false;
862 mInClose := false;
863 inherited;
864 end;
867 function THTopWindow.keyEvent (var ev: THKeyEvent): Boolean;
868 begin
869 result := inherited keyEvent(ev);
870 if not getFocused then exit;
871 if (ev.kstate = ev.ModAlt) and (ev.kind = ev.Press) and (ev.scan = SDL_SCANCODE_F3) then
872 begin
873 uiRemoveWindow(self);
874 result := true;
875 exit;
876 end;
877 end;
880 function THTopWindow.mouseEvent (var ev: THMouseEvent): Boolean;
881 var
882 lx, ly: Integer;
883 begin
884 result := false;
885 if not mEnabled then exit;
886 if (mWidth < 1) or (mHeight < 1) then exit;
888 if mDragging then
889 begin
890 mX += ev.x-mDragStartX;
891 mY += ev.y-mDragStartY;
892 mDragStartX := ev.x;
893 mDragStartY := ev.y;
894 if (ev.kind = ev.Release) then mDragging := false;
895 result := true;
896 exit;
897 end;
899 lx := ev.x;
900 ly := ev.y;
901 if toLocal(lx, ly) then
902 begin
903 if (ev.kind = ev.Press) then
904 begin
905 if (ly < 8) then
906 begin
907 if (lx >= mFrameWidth) and (lx < mFrameWidth+3*8) then
908 begin
909 //uiRemoveWindow(self);
910 mWaitingClose := true;
911 mInClose := true;
912 end
913 else
914 begin
915 mDragging := true;
916 mDragStartX := ev.x;
917 mDragStartY := ev.y;
918 end;
919 result := true;
920 exit;
921 end;
922 if (lx < mFrameWidth) or (lx >= mWidth-mFrameWidth) or (ly >= mHeight-mFrameHeight) then
923 begin
924 mDragging := true;
925 mDragStartX := ev.x;
926 mDragStartY := ev.y;
927 result := true;
928 exit;
929 end;
930 end;
932 if (ev.kind = ev.Release) then
933 begin
934 if mWaitingClose and (lx >= mFrameWidth) and (lx < mFrameWidth+3*8) then
935 begin
936 uiRemoveWindow(self);
937 result := true;
938 exit;
939 end;
940 mWaitingClose := false;
941 mInClose := false;
942 end;
944 if (ev.kind = ev.Motion) then
945 begin
946 if mWaitingClose then
947 begin
948 mInClose := (lx >= mFrameWidth) and (lx < mFrameWidth+3*8);
949 result := true;
950 exit;
951 end;
952 end;
953 end
954 else
955 begin
956 mInClose := false;
957 if (ev.kind <> ev.Motion) then mWaitingClose := false;
958 end;
960 result := inherited mouseEvent(ev);
961 end;
964 // ////////////////////////////////////////////////////////////////////////// //
965 constructor THCtlCBListBox.Create (ax, ay: Integer; aparent: THControl=nil);
966 begin
967 mItems := nil;
968 mCurIndex := -1;
969 inherited Create(ax, ay, 4, 4);
970 end;
973 destructor THCtlCBListBox.Destroy ();
974 begin
975 mItems := nil;
976 inherited;
977 end;
980 procedure THCtlCBListBox.appendItem (const atext: AnsiString; bv: PBoolean; aaction: TActionCB=nil);
981 var
982 it: PItem;
983 begin
984 if (Length(atext)*8+3*8+2 > mWidth) then mWidth := Length(atext)*8+3*8+2;
985 SetLength(mItems, Length(mItems)+1);
986 it := @mItems[High(mItems)];
987 it.title := atext;
988 it.varp := bv;
989 it.actionCB := aaction;
990 if (Length(mItems)*8 > mHeight) then mHeight := Length(mItems)*8;
991 if (mCurIndex < 0) then mCurIndex := 0;
992 end;
995 procedure THCtlCBListBox.drawControl (sx, sy: Integer);
996 var
997 f, tx: Integer;
998 it: PItem;
999 begin
1000 for f := 0 to High(mItems) do
1001 begin
1002 it := @mItems[f];
1003 if (mCurIndex = f) then fillRect(sx, sy, mWidth, 8, 0, 128, 0);
1004 if (it.varp <> nil) then
1005 begin
1006 if it.varp^ then drawText8(sx, sy, '[x]', 255, 255, 255) else drawText8(sx, sy, '[ ]', 255, 255, 255);
1007 drawText8(sx+3*8+2, sy, it.title, 255, 255, 0);
1008 end
1009 else if (Length(it.title) > 0) then
1010 begin
1011 tx := sx+(mWidth-Length(it.title)*8) div 2;
1012 if (tx-3 > sx+4) then
1013 begin
1014 drawLine(sx+4, sy+3, tx-3, sy+3, 255, 255, 255);
1015 drawLine(tx+Length(it.title)*8, sy+3, sx+mWidth-4, sy+3, 255, 255, 255);
1016 end;
1017 drawText8(sx+(mWidth-Length(it.title)*8) div 2, sy, it.title, 255, 255, 255);
1018 end
1019 else
1020 begin
1021 drawLine(sx+4, sy+3, sx+mWidth-8, sy+3, 255, 255, 255);
1022 end;
1023 Inc(sy, 8);
1024 end;
1025 end;
1028 function THCtlCBListBox.mouseEvent (var ev: THMouseEvent): Boolean;
1029 var
1030 lx, ly: Integer;
1031 it: PItem;
1032 begin
1033 result := inherited mouseEvent(ev);
1034 lx := ev.x;
1035 ly := ev.y;
1036 if not result and toLocal(lx, ly) then
1037 begin
1038 result := true;
1039 if (ev.kind = ev.Press) then
1040 begin
1041 ly := ly div 8;
1042 if (ly >= 0) and (ly < Length(mItems)) then
1043 begin
1044 it := @mItems[ly];
1045 if (it.varp <> nil) then
1046 begin
1047 mCurIndex := ly;
1048 it.varp^ := not it.varp^;
1049 if assigned(it.actionCB) then it.actionCB(self, Integer(it.varp^));
1050 if assigned(actionCB) then actionCB(self, ly);
1051 end;
1052 end;
1053 end;
1054 end;
1055 end;
1058 function THCtlCBListBox.keyEvent (var ev: THKeyEvent): Boolean;
1059 var
1060 it: PItem;
1061 begin
1062 result := inherited keyEvent(ev);
1063 if not getFocused then exit;
1064 //result := true;
1065 if (ev.kstate = 0) and (ev.kind = ev.Press) then
1066 begin
1067 case ev.scan of
1068 SDL_SCANCODE_HOME,
1069 SDL_SCANCODE_PAGEUP:
1070 begin
1071 result := true;
1072 mCurIndex := 0;
1073 end;
1074 SDL_SCANCODE_END,
1075 SDL_SCANCODE_PAGEDOWN:
1076 begin
1077 result := true;
1078 mCurIndex := High(mItems);
1079 end;
1080 SDL_SCANCODE_UP:
1081 begin
1082 result := true;
1083 if (Length(mItems) > 0) then
1084 begin
1085 if (mCurIndex < 0) then mCurIndex := Length(mItems);
1086 while (mCurIndex > 0) do
1087 begin
1088 Dec(mCurIndex);
1089 if (mItems[mCurIndex].varp <> nil) then break;
1090 end;
1091 end
1092 else
1093 begin
1094 mCurIndex := -1;
1095 end;
1096 end;
1097 SDL_SCANCODE_DOWN:
1098 begin
1099 result := true;
1100 if (Length(mItems) > 0) then
1101 begin
1102 if (mCurIndex < 0) then mCurIndex := -1;
1103 while (mCurIndex < High(mItems)) do
1104 begin
1105 Inc(mCurIndex);
1106 if (mItems[mCurIndex].varp <> nil) then break;
1107 end;
1108 end
1109 else
1110 begin
1111 mCurIndex := -1;
1112 end;
1113 end;
1114 SDL_SCANCODE_SPACE,
1115 SDL_SCANCODE_RETURN:
1116 begin
1117 result := true;
1118 if (mCurIndex >= 0) and (mCurIndex < Length(mItems)) and (mItems[mCurIndex].varp <> nil) then
1119 begin
1120 it := @mItems[mCurIndex];
1121 it.varp^ := not it.varp^;
1122 if assigned(it.actionCB) then it.actionCB(self, Integer(it.varp^));
1123 if assigned(actionCB) then actionCB(self, mCurIndex);
1124 end;
1125 end;
1126 end;
1127 end;
1128 end;