From: Ketmar Dark Date: Mon, 2 Oct 2017 17:00:03 +0000 (+0300) Subject: FlexUI: module renamings; moved standalone sdl carcass augemntation to FlexUI X-Git-Url: http://deadsoftware.ru/gitweb?a=commitdiff_plain;h=26290d9816334b8377531cf8b3e58643444f4d04;p=d2df-sdl.git FlexUI: module renamings; moved standalone sdl carcass augemntation to FlexUI --- diff --git a/src/flexui/fui_common.pas b/src/flexui/fui_common.pas new file mode 100644 index 0000000..76354c3 --- /dev/null +++ b/src/flexui/fui_common.pas @@ -0,0 +1,213 @@ +(* coded by Ketmar // Invisible Vector + * Understanding is not required. Only obedience. + * + * This program is free software: you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation, either version 3 of the License, or + * (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program. If not, see . + *) +{$INCLUDE ../shared/a_modes.inc} +unit fui_common; + +interface + + +// ////////////////////////////////////////////////////////////////////////// // +type + TLaySize = record + public + w, h: Integer; + + private + function getIdx (idx: Integer): Integer; inline; + procedure setIdx (idx, v: Integer); inline; + + public + constructor Create (aw, ah: Integer); + + function toString (): AnsiString; + + function equals (constref a: TLaySize): Boolean; inline; + public + property item[idx: Integer]: Integer read getIdx write setIdx; default; + end; + + TLayPos = record + public + x, y: Integer; + + private + function getIdx (idx: Integer): Integer; inline; + procedure setIdx (idx, v: Integer); inline; + + public + constructor Create (ax, ay: Integer); + + function toString (): AnsiString; + + function equals (constref a: TLayPos): Boolean; inline; + + public + property item[idx: Integer]: Integer read getIdx write setIdx; default; + end; + + TLayMargins = record + public + top, right, bottom, left: Integer; + + public + constructor Create (atop, aright, abottom, aleft: Integer); + + function toString (): AnsiString; + + function horiz (): Integer; inline; + function vert (): Integer; inline; + end; + + +// ////////////////////////////////////////////////////////////////////////// // +type + TGxRGBA = packed record + public + r, g, b, a: Byte; + + public + constructor Create (ar, ag, ab: Integer; aa: Integer=255); + + function asUInt (): LongWord; inline; + function isOpaque (): Boolean; inline; + function isTransparent (): Boolean; inline; + + // WARNING! This function does blending in RGB space, and RGB space is not linear! + // alpha value of `self` doesn't matter + // `aa` means: 255 for replace color, 0 for keep `self` + function blend (ar, ag, ab, aa: Integer): TGxRGBA; inline; + end; + + +// ////////////////////////////////////////////////////////////////////////// // +// return `false` if destination rect is empty +// modifies rect0 +function intersectRect (var x0, y0, w0, h0: Integer; const x1, y1, w1, h1: Integer): Boolean; inline; +procedure normRGBA (var r, g, b, a: Integer); inline; + + +implementation + +uses + utils; + + +// ////////////////////////////////////////////////////////////////////////// // +constructor TLaySize.Create (aw, ah: Integer); begin w := aw; h := ah; end; +function TLaySize.getIdx (idx: Integer): Integer; inline; begin if (idx = 0) then result := w else if (idx = 1) then result := h else result := -1; end; +procedure TLaySize.setIdx (idx, v: Integer); inline; begin if (idx = 0) then w := v else if (idx = 1) then h := v; end; +function TLaySize.toString (): AnsiString; begin result := formatstrf('[%d,%d]', [w, h]); end; +function TLaySize.equals (constref a: TLaySize): Boolean; inline; begin result := (w = a.w) and (h = a.h); end; + +constructor TLayPos.Create (ax, ay: Integer); begin x := ax; y := ay; end; +function TLayPos.getIdx (idx: Integer): Integer; inline; begin if (idx = 0) then result := x else if (idx = 1) then result := y else result := -1; end; +procedure TLayPos.setIdx (idx, v: Integer); inline; begin if (idx = 0) then x := v else if (idx = 1) then y := v; end; +function TLayPos.toString (): AnsiString; begin result := formatstrf('(%d,%d)', [x, y]); end; +function TLayPos.equals (constref a: TLayPos): Boolean; inline; begin result := (x = a.x) and (y = a.y); end; + +constructor TLayMargins.Create (atop, aright, abottom, aleft: Integer); +begin + if (atop < 0) then atop := 0; + if (aright < 0) then aright := 0; + if (abottom < 0) then abottom := 0; + if (aleft < 0) then aleft := 0; + left := aleft; + right := aright; + top := atop; + bottom := abottom; +end; +function TLayMargins.toString (): AnsiString; begin result := formatstrf('(%s,%s,%s,%s)', [top, right, bottom, left]); end; +function TLayMargins.horiz (): Integer; inline; begin result := left+right; end; +function TLayMargins.vert (): Integer; inline; begin result := top+bottom; end; + + +// ////////////////////////////////////////////////////////////////////////// // +constructor TGxRGBA.Create (ar, ag, ab: Integer; aa: Integer=255); +begin + if (ar < 0) then r := 0 else if (ar > 255) then r := 255 else r := Byte(ar); + if (ag < 0) then g := 0 else if (ag > 255) then g := 255 else g := Byte(ag); + if (ab < 0) then b := 0 else if (ab > 255) then b := 255 else b := Byte(ab); + if (aa < 0) then a := 0 else if (aa > 255) then a := 255 else a := Byte(aa); +end; + +function TGxRGBA.asUInt (): LongWord; inline; begin result := LongWord(r) or (LongWord(g) shl 8) or (LongWord(b) shl 16) or (LongWord(a) shl 24); end; + +function TGxRGBA.isOpaque (): Boolean; inline; begin result := (a = 255); end; +function TGxRGBA.isTransparent (): Boolean; inline; begin result := (a = 0); end; + +function TGxRGBA.blend (ar, ag, ab, aa: Integer): TGxRGBA; inline; +var + me, it, a_tmp_, dc_tmp_, srb_tmp_, sg_tmp_, drb_tmp_, dg_tmp_, orb_tmp_, og_tmp_: LongWord; +begin + if (aa <= 0) then begin result := self; exit; end; + result := TGxRGBA.Create(ar, ag, ab, aa); + if (aa >= 255) then begin result.a := a; exit; end; + me := asUInt; + it := result.asUInt; + a_tmp_ := (256-(255-(it shr 24))) and (-(1-(((255-(it shr 24))+1) shr 8))); // to not loose bits, but 255 should become 0 + dc_tmp_ := me and $ffffff; + srb_tmp_ := (it and $ff00ff); + sg_tmp_ := (it and $00ff00); + drb_tmp_ := (dc_tmp_ and $ff00ff); + dg_tmp_ := (dc_tmp_ and $00ff00); + orb_tmp_ := (drb_tmp_+(((srb_tmp_-drb_tmp_)*a_tmp_+$800080) shr 8)) and $ff00ff; + og_tmp_ := (dg_tmp_+(((sg_tmp_-dg_tmp_)*a_tmp_+$008000) shr 8)) and $00ff00; + me := (orb_tmp_ or og_tmp_); // or $ff000000; /* and $ffffff;*/ + result.r := Byte(me and $ff); + result.g := Byte((me shr 8) and $ff); + result.b := Byte((me shr 16) and $ff); + result.a := a; +end; + + +// ////////////////////////////////////////////////////////////////////////// // +//TODO: overflow checks +function intersectRect (var x0, y0, w0, h0: Integer; const x1, y1, w1, h1: Integer): Boolean; inline; +var + ex0, ey0: Integer; + ex1, ey1: Integer; +begin + result := false; + if (w0 < 1) or (h0 < 1) or (w1 < 1) or (h1 < 1) then exit; // at least one rect is null + // check for intersection + ex0 := x0+w0; + ey0 := y0+h0; + ex1 := x1+w1; + ey1 := y1+h1; + if (ex0 <= x1) or (ey0 <= y1) or (ex1 <= x0) or (ey1 <= y0) then exit; + if (x0 >= ex1) or (y0 >= ey1) or (x1 >= ex0) or (y1 >= ey0) then exit; + // ok, intersects + if (x0 < x1) then x0 := x1; + if (y0 < y1) then y0 := y1; + if (ex0 > ex1) then ex0 := ex1; + if (ey0 > ey1) then ey0 := ey1; + w0 := ex0-x0; + h0 := ey0-y0; + result := (w0 > 0) and (h0 > 0); +end; + + +procedure normRGBA (var r, g, b, a: Integer); inline; +begin + if (a < 0) then a := 0 else if (a > 255) then a := 255; + if (r < 0) then r := 0 else if (r > 255) then r := 255; + if (g < 0) then g := 0 else if (g > 255) then g := 255; + if (b < 0) then b := 0 else if (b > 255) then b := 255; +end; + + +end. diff --git a/src/gx/gh_ui.pas b/src/flexui/fui_ctls.pas similarity index 99% rename from src/gx/gh_ui.pas rename to src/flexui/fui_ctls.pas index 16281c6..8c3834e 100644 --- a/src/gx/gh_ui.pas +++ b/src/flexui/fui_ctls.pas @@ -16,16 +16,16 @@ *) {$INCLUDE ../shared/a_modes.inc} {$M+} -unit gh_ui; +unit fui_ctls; interface uses SysUtils, Classes, SDL2, - gh_ui_common, - gh_ui_style, - sdlcarcass, glgfx, + sdlcarcass, + fui_common, fui_events, fui_style, + fui_gfx_gl, xparser; @@ -550,13 +550,13 @@ procedure uiLayoutCtl (ctl: TUIControl); // ////////////////////////////////////////////////////////////////////////// // var - gh_ui_scale: Single = 1.0; + fuiRenderScale: Single = 1.0; implementation uses - gh_flexlay, + fui_flexlay, utils; @@ -712,10 +712,10 @@ 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 + ev.x := trunc(ev.x/fuiRenderScale); + ev.y := trunc(ev.y/fuiRenderScale); + ev.dx := trunc(ev.dx/fuiRenderScale); //FIXME + ev.dy := trunc(ev.dy/fuiRenderScale); //FIXME try if (uiGrabCtl <> nil) then begin @@ -760,8 +760,8 @@ 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.x := trunc(ev.x/fuiRenderScale); + ev.y := trunc(ev.y/fuiRenderScale); try if (Length(uiTopList) > 0) and (uiTopList[High(uiTopList)].enabled) then uiTopList[High(uiTopList)].keyEvent(ev); //if (ev.release) then begin ev.eat(); exit; end; @@ -778,7 +778,7 @@ var ctl: TUIControl; begin processKills(); - gxBeginUIDraw(gh_ui_scale); + gxBeginUIDraw(fuiRenderScale); try for f := 0 to High(uiTopList) do begin @@ -1812,10 +1812,10 @@ end; procedure TUIControl.setScissorGLInternal (x, y, w, h: Integer); begin if not scallowed then exit; - x := trunc(x*gh_ui_scale); - y := trunc(y*gh_ui_scale); - w := trunc(w*gh_ui_scale); - h := trunc(h*gh_ui_scale); + x := trunc(x*fuiRenderScale); + y := trunc(y*fuiRenderScale); + w := trunc(w*fuiRenderScale); + h := trunc(h*fuiRenderScale); scis.combineRect(x, y, w, h); end; @@ -2079,7 +2079,7 @@ procedure TUITopWindow.flFitToScreen (); var nsz: TLaySize; begin - nsz := TLaySize.Create(trunc(gxScreenWidth/gh_ui_scale)-mFrameWidth*2-6, trunc(gxScreenHeight/gh_ui_scale)-mFrameHeight*2-6); + nsz := TLaySize.Create(trunc(fuiScrWdt/fuiRenderScale)-mFrameWidth*2-6, trunc(fuiScrHgt/fuiRenderScale)-mFrameHeight*2-6); if (mMaxSize.w < 1) then mMaxSize.w := nsz.w; if (mMaxSize.h < 1) then mMaxSize.h := nsz.h; end; @@ -2089,8 +2089,8 @@ procedure TUITopWindow.centerInScreen (); begin if (mWidth > 0) and (mHeight > 0) then begin - mX := trunc((gScrWidth/gh_ui_scale-mWidth)/2); - mY := trunc((gScrHeight/gh_ui_scale-mHeight)/2); + mX := trunc((fuiScrWdt/fuiRenderScale-mWidth)/2); + mY := trunc((fuiScrHgt/fuiRenderScale-mHeight)/2); end; end; @@ -2469,7 +2469,6 @@ procedure TUIVBox.AfterConstruction (); begin inherited; mHoriz := false; - writeln('VBOX: ', canFocus, ':', enabled); end; diff --git a/src/flexui/fui_events.pas b/src/flexui/fui_events.pas new file mode 100644 index 0000000..a5fa386 --- /dev/null +++ b/src/flexui/fui_events.pas @@ -0,0 +1,461 @@ +(* coded by Ketmar // Invisible Vector + * Understanding is not required. Only obedience. + * + * This program is free software: you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation, either version 3 of the License, or + * (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program. If not, see . + *) +{$INCLUDE ../shared/a_modes.inc} +unit fui_events; + +interface + +uses + SysUtils, Classes, + SDL2; + + +// ////////////////////////////////////////////////////////////////////////// // +type + THMouseEvent = record + public + const + // both for but and for bstate + None = 0; + Left = $0001; + Right = $0002; + Middle = $0004; + WheelUp = $0008; + WheelDown = $0010; + + // event types + type + TKind = (Release, Press, Motion); + + private + mEaten: Boolean; + mCancelled: Boolean; + + public + kind: TKind; // motion, press, release + x, y: Integer; // current mouse position + dx, dy: Integer; // for wheel this is wheel motion, otherwise this is relative mouse motion + but: Word; // current pressed/released button, or 0 for motion + bstate: Word; // button state BEFORE event (i.e. press/release modifications aren't done yet) + 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 + public + const + // modifiers + ModCtrl = $0001; + ModAlt = $0002; + ModShift = $0004; + ModHyper = $0008; + + // event types + type + TKind = (Release, Press); + + private + mEaten: Boolean; + mCancelled: Boolean; + + public + kind: TKind; + scan: Word; // SDL_SCANCODE_XXX + //sym: LongWord; // SDLK_XXX + ch: AnsiChar; // converted to 1251; can be #0 + x, y: Integer; // current mouse position + bstate: Word; // button state + 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; + + function isHot (c: AnsiChar): Boolean; + + public + property eaten: Boolean read mEaten; + property cancelled: Boolean read mCancelled; + end; + + +// ////////////////////////////////////////////////////////////////////////// // +// call this on window deactivation, for example +procedure fuiResetKMState (sendEvents: Boolean=true); + + +// ////////////////////////////////////////////////////////////////////////// // +// event handlers +var + evMouseCB: procedure (var ev: THMouseEvent) = nil; + evKeyCB: procedure (var ev: THKeyEvent) = nil; + + +// ////////////////////////////////////////////////////////////////////////// // +function fuiMouseX (): Integer; inline; +function fuiMouseY (): Integer; inline; +function fuiButState (): Word; inline; +function fuiModState (): Word; inline; + +procedure fuiSetMouseX (v: Integer); inline; +procedure fuiSetMouseY (v: Integer); inline; +procedure fuiSetButState (v: Word); inline; +procedure fuiSetModState (v: Word); inline; + + +// ////////////////////////////////////////////////////////////////////////// // +// any mods = 255: nothing was defined +function parseModKeys (const s: AnsiString; out kmods: Byte; out mbuts: Byte): AnsiString; + +operator = (constref ev: THKeyEvent; const s: AnsiString): Boolean; +operator = (const s: AnsiString; constref ev: THKeyEvent): Boolean; + +operator = (constref ev: THMouseEvent; const s: AnsiString): Boolean; +operator = (const s: AnsiString; constref ev: THMouseEvent): Boolean; + + +implementation + +var + curButState: Word = 0; + curModState: Word = 0; + curMsX: Integer = 0; + curMsY: Integer = 0; + + +// ////////////////////////////////////////////////////////////////////////// // +function strEquCI (const s0, s1: AnsiString): Boolean; +var + f: Integer; + c0, c1: AnsiChar; +begin + result := (Length(s0) = Length(s1)); + if result then + begin + for f := 1 to Length(s0) do + begin + c0 := s0[f]; + if (c0 >= 'a') and (c0 <= 'z') then Dec(c0, 32); // poor man's `toupper()` + c1 := s1[f]; + if (c1 >= 'a') and (c1 <= 'z') then Dec(c1, 32); // poor man's `toupper()` + if (c0 <> c1) then begin result := false; exit; end; + end; + end; +end; + + +// ////////////////////////////////////////////////////////////////////////// // +function fuiMouseX (): Integer; inline; begin result := curMsX; end; +function fuiMouseY (): Integer; inline; begin result := curMsY; end; +function fuiButState (): Word; inline; begin result := curButState; end; +function fuiModState (): Word; inline; begin result := curModState; end; + +procedure fuiSetMouseX (v: Integer); inline; begin curMsX := v; end; +procedure fuiSetMouseY (v: Integer); inline; begin curMsY := v; end; +procedure fuiSetButState (v: Word); inline; begin curButState := v; end; +procedure fuiSetModState (v: Word); inline; begin curModState := v; end; + + +// ////////////////////////////////////////////////////////////////////////// // +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; + +function THKeyEvent.isHot (c: AnsiChar): Boolean; +begin + if (c = #0) or (scan = 0) or (scan = $FFFF) then begin result := false; exit; end; + case scan of + SDL_SCANCODE_A: result := (c = 'A') or (c = 'a') or (c = 'Ô') or (c = 'ô'); + SDL_SCANCODE_B: result := (c = 'B') or (c = 'b') or (c = 'È') or (c = 'è'); + SDL_SCANCODE_C: result := (c = 'C') or (c = 'c') or (c = 'Ñ') or (c = 'ñ'); + SDL_SCANCODE_D: result := (c = 'D') or (c = 'd') or (c = 'Â') or (c = 'â'); + SDL_SCANCODE_E: result := (c = 'E') or (c = 'e') or (c = 'Ó') or (c = 'ó'); + SDL_SCANCODE_F: result := (c = 'F') or (c = 'f') or (c = 'À') or (c = 'à'); + SDL_SCANCODE_G: result := (c = 'G') or (c = 'g') or (c = 'Ï') or (c = 'ï'); + SDL_SCANCODE_H: result := (c = 'H') or (c = 'h') or (c = 'Ð') or (c = 'ð'); + SDL_SCANCODE_I: result := (c = 'I') or (c = 'i') or (c = 'Ø') or (c = 'ø'); + SDL_SCANCODE_J: result := (c = 'J') or (c = 'j') or (c = 'Î') or (c = 'î'); + SDL_SCANCODE_K: result := (c = 'K') or (c = 'k') or (c = 'Ë') or (c = 'ë'); + SDL_SCANCODE_L: result := (c = 'L') or (c = 'l') or (c = 'Ä') or (c = 'ä'); + SDL_SCANCODE_M: result := (c = 'M') or (c = 'm') or (c = 'Ü') or (c = 'ü'); + SDL_SCANCODE_N: result := (c = 'N') or (c = 'n') or (c = 'Ò') or (c = 'ò'); + SDL_SCANCODE_O: result := (c = 'O') or (c = 'o') or (c = 'Ù') or (c = 'ù'); + SDL_SCANCODE_P: result := (c = 'P') or (c = 'p') or (c = 'Ç') or (c = 'ç'); + SDL_SCANCODE_Q: result := (c = 'Q') or (c = 'q') or (c = 'É') or (c = 'é'); + SDL_SCANCODE_R: result := (c = 'R') or (c = 'r') or (c = 'Ê') or (c = 'ê'); + SDL_SCANCODE_S: result := (c = 'S') or (c = 's') or (c = 'Û') or (c = 'û'); + SDL_SCANCODE_T: result := (c = 'T') or (c = 't') or (c = 'Å') or (c = 'å'); + SDL_SCANCODE_U: result := (c = 'U') or (c = 'u') or (c = 'Ã') or (c = 'ã'); + SDL_SCANCODE_V: result := (c = 'V') or (c = 'v') or (c = 'Ì') or (c = 'ì'); + SDL_SCANCODE_W: result := (c = 'W') or (c = 'w') or (c = 'Ö') or (c = 'ö'); + SDL_SCANCODE_X: result := (c = 'X') or (c = 'x') or (c = '×') or (c = '÷'); + SDL_SCANCODE_Y: result := (c = 'Y') or (c = 'y') or (c = 'Í') or (c = 'í'); + SDL_SCANCODE_Z: result := (c = 'Z') or (c = 'z') or (c = 'ß') or (c = 'ÿ'); + + SDL_SCANCODE_1: result := (c = '1') or (c = '!'); + SDL_SCANCODE_2: result := (c = '2') or (c = '@'); + SDL_SCANCODE_3: result := (c = '3') or (c = '#'); + SDL_SCANCODE_4: result := (c = '4') or (c = '$'); + SDL_SCANCODE_5: result := (c = '5') or (c = '%'); + SDL_SCANCODE_6: result := (c = '6') or (c = '^'); + SDL_SCANCODE_7: result := (c = '7') or (c = '&'); + SDL_SCANCODE_8: result := (c = '8') or (c = '*'); + SDL_SCANCODE_9: result := (c = '9') or (c = '('); + SDL_SCANCODE_0: result := (c = '0') or (c = ')'); + + SDL_SCANCODE_RETURN: result := (c = #13) or (c = #10); + SDL_SCANCODE_ESCAPE: result := (c = #27); + SDL_SCANCODE_BACKSPACE: result := (c = #8); + SDL_SCANCODE_TAB: result := (c = #9); + SDL_SCANCODE_SPACE: result := (c = ' '); + + SDL_SCANCODE_MINUS: result := (c = '-'); + SDL_SCANCODE_EQUALS: result := (c = '='); + SDL_SCANCODE_LEFTBRACKET: result := (c = '[') or (c = '{'); + SDL_SCANCODE_RIGHTBRACKET: result := (c = ']') or (c = '}'); + SDL_SCANCODE_BACKSLASH, SDL_SCANCODE_NONUSHASH: result := (c = '\') or (c = '|'); + SDL_SCANCODE_SEMICOLON: result := (c = ';') or (c = ':'); + SDL_SCANCODE_APOSTROPHE: result := (c = '''') or (c = '"'); + SDL_SCANCODE_GRAVE: result := (c = '`') or (c = '~'); + SDL_SCANCODE_COMMA: result := (c = ',') or (c = '<'); + SDL_SCANCODE_PERIOD: result := (c = '.') or (c = '>'); + SDL_SCANCODE_SLASH: result := (c = '/') or (c = '?'); + + else result := false; + end; +end; + + +// ////////////////////////////////////////////////////////////////////////// // +// any mods = 255: nothing was defined +function parseModKeys (const s: AnsiString; out kmods: Byte; out mbuts: Byte): AnsiString; +var + pos, epos: Integer; +begin + kmods := 255; + mbuts := 255; + 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 + begin + 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; + 'M', 'm': begin if (kmods = 255) then kmods := 0; kmods := kmods or THKeyEvent.ModAlt; Inc(pos, 2); continue; end; + 'S', 's': begin if (kmods = 255) then kmods := 0; kmods := kmods or THKeyEvent.ModShift; Inc(pos, 2); continue; end; + end; + break; + end; + 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; + 'R', 'r': begin if (mbuts = 255) then mbuts := 0; mbuts := mbuts or THMouseEvent.Right; Inc(pos, 4); continue; end; + 'M', 'm': begin if (mbuts = 255) then mbuts := 0; mbuts := mbuts or THMouseEvent.Middle; Inc(pos, 4); continue; end; + end; + break; + end; + break; + end; + epos := Length(s)+1; + while (epos > pos) and (s[epos-1] <= ' ') do Dec(epos); + if (epos > pos) then result := Copy(s, pos, epos-pos) else result := ''; +end; + + +operator = (constref ev: THKeyEvent; const s: AnsiString): Boolean; +var + f: Integer; + kmods: Byte = 255; + mbuts: Byte = 255; + kname: AnsiString; +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 + else if (s[1] = '*') then begin end + else if (not ev.press) then exit; + end; + kname := parseModKeys(s, kmods, mbuts); + if (kmods = 255) then kmods := 0; + if (ev.kstate <> kmods) then exit; + if (mbuts <> 255) and (ev.bstate <> mbuts) then exit; + + if (strEquCI(kname, 'Enter')) then kname := 'RETURN'; + + for f := 0 to SDL_NUM_SCANCODES-1 do + begin + if strEquCI(kname, SDL_GetScancodeName(f)) then + begin + result := (ev.scan = f); + exit; + end; + end; +end; + + +operator = (const s: AnsiString; constref ev: THKeyEvent): Boolean; +begin + result := (ev = s); +end; + + +operator = (constref ev: THMouseEvent; const s: AnsiString): Boolean; +var + kmods: Byte = 255; + 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; 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; + + kname := parseModKeys(s, kmods, mbuts); + if strEquCI(kname, 'LMB') then but := THMouseEvent.Left + else if strEquCI(kname, 'RMB') then but := THMouseEvent.Right + else if strEquCI(kname, 'MMB') then but := THMouseEvent.Middle + else if strEquCI(kname, 'WheelUp') or strEquCI(kname, 'WUP') then but := THMouseEvent.WheelUp + else if strEquCI(kname, 'WheelDown') or strEquCI(kname, 'WDN') or strEquCI(kname, 'WDOWN') then but := THMouseEvent.WheelDown + else if strEquCI(kname, 'None') then but := 0 + else exit; + + 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; + + +operator = (const s: AnsiString; constref ev: THMouseEvent): Boolean; +begin + result := (ev = s); +end; + + +// ////////////////////////////////////////////////////////////////////////// // +procedure fuiResetKMState (sendEvents: Boolean=true); +var + mask: Word; + mev: THMouseEvent; + kev: THKeyEvent; +begin + // generate mouse release events + if (curButState <> 0) then + begin + if sendEvents then + begin + mask := 1; + while (mask <> 0) do + begin + // 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; + mev.dx := 0; + mev.dy := 0; + mev.but := mask; + mev.bstate := curButState; + mev.kstate := curModState; + curButState := curButState and (not mask); + evMouseCB(mev); + end; + mask := mask shl 1; + end; + end; + curButState := 0; + end; + + // generate modifier release events + if (curModState <> 0) then + begin + if sendEvents then + begin + mask := 1; + while (mask <= 8) do + begin + // 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; + THKeyEvent.ModAlt: begin kev.scan := SDL_SCANCODE_LALT; {kev.sym := SDLK_LALT;}{arbitrary} end; + THKeyEvent.ModShift: begin kev.scan := SDL_SCANCODE_LSHIFT; {kev.sym := SDLK_LSHIFT;}{arbitrary} end; + THKeyEvent.ModHyper: begin kev.scan := SDL_SCANCODE_LGUI; {kev.sym := SDLK_LGUI;}{arbitrary} end; + else assert(false); + end; + kev.x := curMsX; + kev.y := curMsY; + mev.bstate := 0{curMsButState}; // anyway + mev.kstate := curModState; + curModState := curModState and (not mask); + evKeyCB(kev); + end; + mask := mask shl 1; + end; + end; + curModState := 0; + end; +end; + + +end. diff --git a/src/gx/gh_flexlay.pas b/src/flexui/fui_flexlay.pas similarity index 99% rename from src/gx/gh_flexlay.pas rename to src/flexui/fui_flexlay.pas index c6da6b3..99db4fe 100644 --- a/src/gx/gh_flexlay.pas +++ b/src/flexui/fui_flexlay.pas @@ -15,7 +15,7 @@ * along with this program. If not, see . *) {$INCLUDE ../shared/a_modes.inc} -unit gh_flexlay; +unit fui_flexlay; (* control default size will be increased by margins negative margins are ignored @@ -40,7 +40,7 @@ ControlT: interface uses - gh_ui_common; + fui_common; // ////////////////////////////////////////////////////////////////////////// // diff --git a/src/gx/glgfx.pas b/src/flexui/fui_gfx_gl.pas similarity index 64% rename from src/gx/glgfx.pas rename to src/flexui/fui_gfx_gl.pas index 9345bb7..4a2e5bf 100644 --- a/src/gx/glgfx.pas +++ b/src/flexui/fui_gfx_gl.pas @@ -15,119 +15,15 @@ * along with this program. If not, see . *) {$INCLUDE ../shared/a_modes.inc} -unit glgfx; +unit fui_gfx_gl; interface uses SysUtils, Classes, GL, GLExt, SDL2, - sdlcarcass; - - -// ////////////////////////////////////////////////////////////////////////// // -type - TGxRGBA = packed record - public - r, g, b, a: Byte; - - public - constructor Create (ar, ag, ab: Integer; aa: Integer=255); - - function asUInt (): LongWord; inline; - function isOpaque (): Boolean; inline; - function isTransparent (): Boolean; inline; - - // WARNING! This function does blending in RGB space, and RGB space is not linear! - // alpha value of `self` doesn't matter - // `aa` means: 255 for replace color, 0 for keep `self` - function blend (ar, ag, ab, aa: Integer): TGxRGBA; inline; - end; - - -// ////////////////////////////////////////////////////////////////////////// // -type - THMouseEvent = record - public - const - // both for but and for bstate - None = 0; - Left = $0001; - Right = $0002; - Middle = $0004; - WheelUp = $0008; - WheelDown = $0010; - - // event types - type - TKind = (Release, Press, Motion); - - private - mEaten: Boolean; - mCancelled: Boolean; - - public - kind: TKind; // motion, press, release - x, y: Integer; // current mouse position - dx, dy: Integer; // for wheel this is wheel motion, otherwise this is relative mouse motion - but: Word; // current pressed/released button, or 0 for motion - bstate: Word; // button state BEFORE event (i.e. press/release modifications aren't done yet) - 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 - public - const - // modifiers - ModCtrl = $0001; - ModAlt = $0002; - ModShift = $0004; - ModHyper = $0008; - - // event types - type - TKind = (Release, Press); - - private - mEaten: Boolean; - mCancelled: Boolean; - - public - kind: TKind; - scan: Word; // SDL_SCANCODE_XXX - sym: LongWord; // SDLK_XXX - x, y: Integer; // current mouse position - bstate: Word; // button state - 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; - - function isHot (ch: AnsiChar): Boolean; - - public - property eaten: Boolean read mEaten; - property cancelled: Boolean read mCancelled; - end; - + sdlcarcass, + fui_common, fui_events; // ////////////////////////////////////////////////////////////////////////// // @@ -159,11 +55,6 @@ type procedure oglDrawCursor (); procedure oglDrawCursorAt (msX, msY: Integer); -// return `false` if destination rect is empty -// modifies rect0 -function intersectRect (var x0, y0, w0, h0: Integer; const x1, y1, w1, h1: Integer): Boolean; - -procedure normRGBA (var r, g, b, a: Integer); inline; function setupGLColor (r, g, b, a: Integer): Boolean; function setupGLColor (constref clr: TGxRGBA): Boolean; function isScaled (): Boolean; @@ -191,533 +82,13 @@ function drawText8PropXC (x, y: Integer; const s: AnsiString; constref clr: TGxR // ////////////////////////////////////////////////////////////////////////// // -// event handlers -var - evMouseCB: procedure (var ev: THMouseEvent) = nil; - evKeyCB: procedure (var ev: THKeyEvent) = nil; - - -// ////////////////////////////////////////////////////////////////////////// // -function getMouseX (): Integer; inline; -function getMouseY (): Integer; inline; -function getButState (): Word; inline; -function getModState (): Word; inline; - -function gxScreenWidth (): Integer; inline; -function gxScreenHeight (): Integer; inline; - - -// ////////////////////////////////////////////////////////////////////////// // -property - gMouseX: Integer read getMouseX; - gMouseY: Integer read getMouseY; - gButState: Word read getButState; - gModState: Word read getModState; - var gGfxDoClear: Boolean = true; -// ////////////////////////////////////////////////////////////////////////// // -// any mods = 255: nothing was defined -function parseModKeys (const s: AnsiString; out kmods: Byte; out mbuts: Byte): AnsiString; - -operator = (constref ev: THKeyEvent; const s: AnsiString): Boolean; -operator = (const s: AnsiString; constref ev: THKeyEvent): Boolean; - -operator = (constref ev: THMouseEvent; const s: AnsiString): Boolean; -operator = (const s: AnsiString; constref ev: THMouseEvent): Boolean; - - implementation -var - curButState: Word = 0; - curModState: Word = 0; - curMsX: Integer = 0; - curMsY: Integer = 0; - - -// ////////////////////////////////////////////////////////////////////////// // -function gxScreenWidth (): Integer; inline; begin result := gScrWidth; end; -function gxScreenHeight (): Integer; inline; begin result := gScrHeight; end; - - -// ////////////////////////////////////////////////////////////////////////// // -function strEquCI (const s0, s1: AnsiString): Boolean; -var - f: Integer; - c0, c1: AnsiChar; -begin - result := (Length(s0) = Length(s1)); - if result then - begin - for f := 1 to Length(s0) do - begin - c0 := s0[f]; - if (c0 >= 'a') and (c0 <= 'z') then Dec(c0, 32); // poor man's `toupper()` - c1 := s1[f]; - if (c1 >= 'a') and (c1 <= 'z') then Dec(c1, 32); // poor man's `toupper()` - if (c0 <> c1) then begin result := false; exit; end; - end; - end; -end; - - -// ////////////////////////////////////////////////////////////////////////// // -function getMouseX (): Integer; inline; begin result := curMsX; end; -function getMouseY (): Integer; inline; begin result := curMsY; end; -function getButState (): Word; inline; begin result := curButState; end; -function getModState (): Word; inline; begin result := curModState; end; - - -// ////////////////////////////////////////////////////////////////////////// // -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; - -function THKeyEvent.isHot (ch: AnsiChar): Boolean; -begin - case scan of - SDL_SCANCODE_A: result := (ch = 'A') or (ch = 'a') or (ch = 'Ô') or (ch = 'ô'); - SDL_SCANCODE_B: result := (ch = 'B') or (ch = 'b') or (ch = 'È') or (ch = 'è'); - SDL_SCANCODE_C: result := (ch = 'C') or (ch = 'c') or (ch = 'Ñ') or (ch = 'ñ'); - SDL_SCANCODE_D: result := (ch = 'D') or (ch = 'd') or (ch = 'Â') or (ch = 'â'); - SDL_SCANCODE_E: result := (ch = 'E') or (ch = 'e') or (ch = 'Ó') or (ch = 'ó'); - SDL_SCANCODE_F: result := (ch = 'F') or (ch = 'f') or (ch = 'À') or (ch = 'à'); - SDL_SCANCODE_G: result := (ch = 'G') or (ch = 'g') or (ch = 'Ï') or (ch = 'ï'); - SDL_SCANCODE_H: result := (ch = 'H') or (ch = 'h') or (ch = 'Ð') or (ch = 'ð'); - SDL_SCANCODE_I: result := (ch = 'I') or (ch = 'i') or (ch = 'Ø') or (ch = 'ø'); - SDL_SCANCODE_J: result := (ch = 'J') or (ch = 'j') or (ch = 'Î') or (ch = 'î'); - SDL_SCANCODE_K: result := (ch = 'K') or (ch = 'k') or (ch = 'Ë') or (ch = 'ë'); - SDL_SCANCODE_L: result := (ch = 'L') or (ch = 'l') or (ch = 'Ä') or (ch = 'ä'); - SDL_SCANCODE_M: result := (ch = 'M') or (ch = 'm') or (ch = 'Ü') or (ch = 'ü'); - SDL_SCANCODE_N: result := (ch = 'N') or (ch = 'n') or (ch = 'Ò') or (ch = 'ò'); - SDL_SCANCODE_O: result := (ch = 'O') or (ch = 'o') or (ch = 'Ù') or (ch = 'ù'); - SDL_SCANCODE_P: result := (ch = 'P') or (ch = 'p') or (ch = 'Ç') or (ch = 'ç'); - SDL_SCANCODE_Q: result := (ch = 'Q') or (ch = 'q') or (ch = 'É') or (ch = 'é'); - SDL_SCANCODE_R: result := (ch = 'R') or (ch = 'r') or (ch = 'Ê') or (ch = 'ê'); - SDL_SCANCODE_S: result := (ch = 'S') or (ch = 's') or (ch = 'Û') or (ch = 'û'); - SDL_SCANCODE_T: result := (ch = 'T') or (ch = 't') or (ch = 'Å') or (ch = 'å'); - SDL_SCANCODE_U: result := (ch = 'U') or (ch = 'u') or (ch = 'Ã') or (ch = 'ã'); - SDL_SCANCODE_V: result := (ch = 'V') or (ch = 'v') or (ch = 'Ì') or (ch = 'ì'); - SDL_SCANCODE_W: result := (ch = 'W') or (ch = 'w') or (ch = 'Ö') or (ch = 'ö'); - SDL_SCANCODE_X: result := (ch = 'X') or (ch = 'x') or (ch = '×') or (ch = '÷'); - SDL_SCANCODE_Y: result := (ch = 'Y') or (ch = 'y') or (ch = 'Í') or (ch = 'í'); - SDL_SCANCODE_Z: result := (ch = 'Z') or (ch = 'z') or (ch = 'ß') or (ch = 'ÿ'); - - SDL_SCANCODE_1: result := (ch = '1') or (ch = '!'); - SDL_SCANCODE_2: result := (ch = '2') or (ch = '@'); - SDL_SCANCODE_3: result := (ch = '3') or (ch = '#'); - SDL_SCANCODE_4: result := (ch = '4') or (ch = '$'); - SDL_SCANCODE_5: result := (ch = '5') or (ch = '%'); - SDL_SCANCODE_6: result := (ch = '6') or (ch = '^'); - SDL_SCANCODE_7: result := (ch = '7') or (ch = '&'); - SDL_SCANCODE_8: result := (ch = '8') or (ch = '*'); - SDL_SCANCODE_9: result := (ch = '9') or (ch = '('); - SDL_SCANCODE_0: result := (ch = '0') or (ch = ')'); - - SDL_SCANCODE_RETURN: result := (ch = #13) or (ch = #10); - SDL_SCANCODE_ESCAPE: result := (ch = #27); - SDL_SCANCODE_BACKSPACE: result := (ch = #8); - SDL_SCANCODE_TAB: result := (ch = #9); - SDL_SCANCODE_SPACE: result := (ch = ' '); - - SDL_SCANCODE_MINUS: result := (ch = '-'); - SDL_SCANCODE_EQUALS: result := (ch = '='); - SDL_SCANCODE_LEFTBRACKET: result := (ch = '[') or (ch = '{'); - SDL_SCANCODE_RIGHTBRACKET: result := (ch = ']') or (ch = '}'); - SDL_SCANCODE_BACKSLASH, SDL_SCANCODE_NONUSHASH: result := (ch = '\') or (ch = '|'); - SDL_SCANCODE_SEMICOLON: result := (ch = ';') or (ch = ':'); - SDL_SCANCODE_APOSTROPHE: result := (ch = '''') or (ch = '"'); - SDL_SCANCODE_GRAVE: result := (ch = '`') or (ch = '~'); - SDL_SCANCODE_COMMA: result := (ch = ',') or (ch = '<'); - SDL_SCANCODE_PERIOD: result := (ch = '.') or (ch = '>'); - SDL_SCANCODE_SLASH: result := (ch = '/') or (ch = '?'); - - else result := false; - end; -end; - - -// ////////////////////////////////////////////////////////////////////////// // -constructor TGxRGBA.Create (ar, ag, ab: Integer; aa: Integer=255); -begin - if (ar < 0) then r := 0 else if (ar > 255) then r := 255 else r := Byte(ar); - if (ag < 0) then g := 0 else if (ag > 255) then g := 255 else g := Byte(ag); - if (ab < 0) then b := 0 else if (ab > 255) then b := 255 else b := Byte(ab); - if (aa < 0) then a := 0 else if (aa > 255) then a := 255 else a := Byte(aa); -end; - -function TGxRGBA.asUInt (): LongWord; inline; begin result := LongWord(r) or (LongWord(g) shl 8) or (LongWord(b) shl 16) or (LongWord(a) shl 24); end; - -function TGxRGBA.isOpaque (): Boolean; inline; begin result := (a = 255); end; -function TGxRGBA.isTransparent (): Boolean; inline; begin result := (a = 0); end; - -function TGxRGBA.blend (ar, ag, ab, aa: Integer): TGxRGBA; inline; -var - me, it, a_tmp_, dc_tmp_, srb_tmp_, sg_tmp_, drb_tmp_, dg_tmp_, orb_tmp_, og_tmp_: LongWord; -begin - if (aa <= 0) then begin result := self; exit; end; - result := TGxRGBA.Create(ar, ag, ab, aa); - if (aa >= 255) then begin result.a := a; exit; end; - me := asUInt; - it := result.asUInt; - a_tmp_ := (256-(255-(it shr 24))) and (-(1-(((255-(it shr 24))+1) shr 8))); // to not loose bits, but 255 should become 0 - dc_tmp_ := me and $ffffff; - srb_tmp_ := (it and $ff00ff); - sg_tmp_ := (it and $00ff00); - drb_tmp_ := (dc_tmp_ and $ff00ff); - dg_tmp_ := (dc_tmp_ and $00ff00); - orb_tmp_ := (drb_tmp_+(((srb_tmp_-drb_tmp_)*a_tmp_+$800080) shr 8)) and $ff00ff; - og_tmp_ := (dg_tmp_+(((sg_tmp_-dg_tmp_)*a_tmp_+$008000) shr 8)) and $00ff00; - me := (orb_tmp_ or og_tmp_); // or $ff000000; /* and $ffffff;*/ - result.r := Byte(me and $ff); - result.g := Byte((me shr 8) and $ff); - result.b := Byte((me shr 16) and $ff); - result.a := a; -end; - - -// ////////////////////////////////////////////////////////////////////////// // -// any mods = 255: nothing was defined -function parseModKeys (const s: AnsiString; out kmods: Byte; out mbuts: Byte): AnsiString; -var - pos, epos: Integer; -begin - kmods := 255; - mbuts := 255; - 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 - begin - 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; - 'M', 'm': begin if (kmods = 255) then kmods := 0; kmods := kmods or THKeyEvent.ModAlt; Inc(pos, 2); continue; end; - 'S', 's': begin if (kmods = 255) then kmods := 0; kmods := kmods or THKeyEvent.ModShift; Inc(pos, 2); continue; end; - end; - break; - end; - 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; - 'R', 'r': begin if (mbuts = 255) then mbuts := 0; mbuts := mbuts or THMouseEvent.Right; Inc(pos, 4); continue; end; - 'M', 'm': begin if (mbuts = 255) then mbuts := 0; mbuts := mbuts or THMouseEvent.Middle; Inc(pos, 4); continue; end; - end; - break; - end; - break; - end; - epos := Length(s)+1; - while (epos > pos) and (s[epos-1] <= ' ') do Dec(epos); - if (epos > pos) then result := Copy(s, pos, epos-pos) else result := ''; -end; - - -operator = (constref ev: THKeyEvent; const s: AnsiString): Boolean; -var - f: Integer; - kmods: Byte = 255; - mbuts: Byte = 255; - kname: AnsiString; -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 - else if (s[1] = '*') then begin end - else if (not ev.press) then exit; - end; - kname := parseModKeys(s, kmods, mbuts); - if (kmods = 255) then kmods := 0; - if (ev.kstate <> kmods) then exit; - if (mbuts <> 255) and (ev.bstate <> mbuts) then exit; - - if (strEquCI(kname, 'Enter')) then kname := 'RETURN'; - - for f := 0 to SDL_NUM_SCANCODES-1 do - begin - if strEquCI(kname, SDL_GetScancodeName(f)) then - begin - result := (ev.scan = f); - exit; - end; - end; -end; - - -operator = (const s: AnsiString; constref ev: THKeyEvent): Boolean; -begin - result := (ev = s); -end; - - -operator = (constref ev: THMouseEvent; const s: AnsiString): Boolean; -var - kmods: Byte = 255; - 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; 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; - - kname := parseModKeys(s, kmods, mbuts); - if strEquCI(kname, 'LMB') then but := THMouseEvent.Left - else if strEquCI(kname, 'RMB') then but := THMouseEvent.Right - else if strEquCI(kname, 'MMB') then but := THMouseEvent.Middle - else if strEquCI(kname, 'WheelUp') or strEquCI(kname, 'WUP') then but := THMouseEvent.WheelUp - else if strEquCI(kname, 'WheelDown') or strEquCI(kname, 'WDN') or strEquCI(kname, 'WDOWN') then but := THMouseEvent.WheelDown - else if strEquCI(kname, 'None') then but := 0 - else exit; - - 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; - - -operator = (const s: AnsiString; constref ev: THMouseEvent): Boolean; -begin - result := (ev = s); -end; - - -// ////////////////////////////////////////////////////////////////////////// // -procedure resetKMState (sendEvents: Boolean=true); -var - mask: Word; - mev: THMouseEvent; - kev: THKeyEvent; -begin - // generate mouse release events - if (curButState <> 0) then - begin - if sendEvents then - begin - mask := 1; - while (mask <> 0) do - begin - // 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; - mev.dx := 0; - mev.dy := 0; - mev.but := mask; - mev.bstate := curButState; - mev.kstate := curModState; - curButState := curButState and (not mask); - evMouseCB(mev); - end; - mask := mask shl 1; - end; - end; - curButState := 0; - end; - - // generate modifier release events - if (curModState <> 0) then - begin - if sendEvents then - begin - mask := 1; - while (mask <= 8) do - begin - // 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; - THKeyEvent.ModAlt: begin kev.scan := SDL_SCANCODE_LALT; kev.sym := SDLK_LALT;{arbitrary} end; - THKeyEvent.ModShift: begin kev.scan := SDL_SCANCODE_LSHIFT; kev.sym := SDLK_LSHIFT;{arbitrary} end; - THKeyEvent.ModHyper: begin kev.scan := SDL_SCANCODE_LGUI; kev.sym := SDLK_LGUI;{arbitrary} end; - else assert(false); - end; - kev.x := curMsX; - kev.y := curMsY; - mev.bstate := 0{curMsButState}; // anyway - mev.kstate := curModState; - curModState := curModState and (not mask); - evKeyCB(kev); - end; - mask := mask shl 1; - end; - end; - curModState := 0; - end; -end; - - -function onSDLEvent (var ev: TSDL_Event): Boolean; -var - mev: THMouseEvent; - kev: THKeyEvent; - - function buildBut (b: Byte): Word; - begin - result := 0; - case b of - SDL_BUTTON_LEFT: result := result or THMouseEvent.Left; - SDL_BUTTON_MIDDLE: result := result or THMouseEvent.Middle; - SDL_BUTTON_RIGHT: result := result or THMouseEvent.Right; - end; - end; - -begin - result := false; - - case ev.type_ of - 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; - - if (kev.scan = SDL_SCANCODE_RCTRL) then kev.scan := SDL_SCANCODE_LCTRL; - if (kev.scan = SDL_SCANCODE_RALT) then kev.scan := SDL_SCANCODE_LALT; - if (kev.scan = SDL_SCANCODE_RSHIFT) then kev.scan := SDL_SCANCODE_LSHIFT; - if (kev.scan = SDL_SCANCODE_RGUI) then kev.scan := SDL_SCANCODE_LGUI; - - if (kev.sym = SDLK_RCTRL) then kev.sym := SDLK_LCTRL; - if (kev.sym = SDLK_RALT) then kev.sym := SDLK_LALT; - if (kev.sym = SDLK_RSHIFT) then kev.sym := SDLK_LSHIFT; - if (kev.sym = SDLK_RGUI) then kev.sym := SDLK_LGUI; - - kev.x := curMsX; - kev.y := curMsY; - kev.bstate := curButState; - kev.kstate := curModState; - - case kev.scan of - SDL_SCANCODE_LCTRL: if (kev.press) then curModState := curModState or THKeyEvent.ModCtrl else curModState := curModState and (not THKeyEvent.ModCtrl); - SDL_SCANCODE_LALT: if (kev.press) then curModState := curModState or THKeyEvent.ModAlt else curModState := curModState and (not THKeyEvent.ModAlt); - SDL_SCANCODE_LSHIFT: if (kev.press) then curModState := curModState or THKeyEvent.ModShift else curModState := curModState and (not THKeyEvent.ModShift); - end; - - 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; - mev.but := buildBut(ev.button.button); - mev.x := curMsX; - mev.y := curMsY; - mev.bstate := curButState; - mev.kstate := curModState; - if (mev.but <> 0) then - 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 - 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; - 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 - 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.but := 0; - mev.x := curMsX; - mev.y := curMsY; - mev.bstate := curButState; - mev.kstate := curModState; - if assigned(evMouseCB) then - begin - evMouseCB(mev); - result := mev.eaten; - end; - end; - - { - SDL_TEXTINPUT: - begin - Utf8ToUnicode(@uc, PChar(ev.text.text), 1); - keychr := Word(uc); - if (keychr > 127) then keychr := Word(wchar2win(WideChar(keychr))); - CharPress(AnsiChar(keychr)); - end; - } - end; -end; - - // ////////////////////////////////////////////////////////////////////////// // procedure oglSetup2D (winWidth, winHeight: Integer; upsideDown: Boolean=false); begin @@ -915,7 +286,7 @@ begin glBindTexture(GL_TEXTURE_2D, 0); end; -procedure oglDrawCursor (); begin oglDrawCursorAt(curMsX, curMsY); end; +procedure oglDrawCursor (); begin oglDrawCursorAt(fuiMouseX, fuiMouseY); end; // ////////////////////////////////////////////////////////////////////////// // @@ -1232,7 +603,7 @@ procedure TScissorSave.combineRect (x, y, w, h: Integer); //var ox, oy, ow, oh: Integer; begin if (w < 1) or (h < 1) then begin glScissor(0, 0, 0, 0); exit; end; - y := gScrHeight-(y+h); + y := fuiScrHgt-(y+h); //ox := x; oy := y; ow := w; oh := h; if not intersectRect(x, y, w, h, scxywh[0], scxywh[1], scxywh[2], scxywh[3]) then begin @@ -1246,41 +617,8 @@ begin end; end; -//TODO: overflow checks -function intersectRect (var x0, y0, w0, h0: Integer; const x1, y1, w1, h1: Integer): Boolean; -var - ex0, ey0: Integer; - ex1, ey1: Integer; -begin - result := false; - if (w0 < 1) or (h0 < 1) or (w1 < 1) or (h1 < 1) then exit; // at least one rect is null - // check for intersection - ex0 := x0+w0; - ey0 := y0+h0; - ex1 := x1+w1; - ey1 := y1+h1; - if (ex0 <= x1) or (ey0 <= y1) or (ex1 <= x0) or (ey1 <= y0) then exit; - if (x0 >= ex1) or (y0 >= ey1) or (x1 >= ex0) or (y1 >= ey0) then exit; - // ok, intersects - if (x0 < x1) then x0 := x1; - if (y0 < y1) then y0 := y1; - if (ex0 > ex1) then ex0 := ex1; - if (ey0 > ey1) then ey0 := ey1; - w0 := ex0-x0; - h0 := ey0-y0; - result := (w0 > 0) and (h0 > 0); -end; - // ////////////////////////////////////////////////////////////////////////// // -procedure normRGBA (var r, g, b, a: Integer); inline; -begin - if (a < 0) then a := 0 else if (a > 255) then a := 255; - if (r < 0) then r := 0 else if (r > 255) then r := 255; - if (g < 0) then g := 0 else if (g > 255) then g := 255; - if (b < 0) then b := 0 else if (b > 255) then b := 255; -end; - // returns `false` if the color is transparent function setupGLColor (r, g, b, a: Integer): Boolean; begin @@ -1685,8 +1023,8 @@ end; // ////////////////////////////////////////////////////////////////////////// // procedure oglRestoreMode (doClear: Boolean); begin - oglSetup2D(gScrWidth, gScrHeight); - glScissor(0, 0, gScrWidth, gScrHeight); + oglSetup2D(fuiScrWdt, fuiScrHgt); + glScissor(0, 0, fuiScrWdt, fuiScrHgt); glBindTexture(GL_TEXTURE_2D, 0); glDisable(GL_BLEND); @@ -1715,9 +1053,8 @@ begin end; -procedure onWinFocus (); begin end; - -procedure onWinBlur (); begin resetKMState(true); end; +//procedure onWinFocus (); begin end; +//procedure onWinBlur (); begin fuiResetKMState(true); end; procedure onPreRender (); begin oglRestoreMode(gGfxDoClear); end; @@ -1725,7 +1062,7 @@ procedure onPostRender (); begin oglRestoreMode(false); oglDrawCursor(); end; procedure onInit (); begin - oglSetup2D(gScrWidth, gScrHeight); + oglSetup2D(fuiScrWdt, fuiScrHgt); createCursorTexture(); createFonts(); @@ -1733,22 +1070,21 @@ end; procedure onDeinit (); begin - resetKMState(false); + fuiResetKMState(false); if (curtexid <> 0) then glDeleteTextures(1, @curtexid); curtexid := 0; deleteFonts(); - curButState := 0; - curModState := 0; - curMsX := 0; - curMsY := 0; + fuiSetButState(0); + fuiSetModState(0); + fuiSetMouseX(0); + fuiSetMouseY(0); end; // ////////////////////////////////////////////////////////////////////////// // begin - evSDLCB := onSDLEvent; - winFocusCB := onWinFocus; - winBlurCB := onWinBlur; + //winFocusCB := onWinFocus; + //winBlurCB := onWinBlur; prerenderFrameCB := onPreRender; postrenderFrameCB := onPostRender; oglInitCB := onInit; diff --git a/src/gx/gh_ui_style.pas b/src/flexui/fui_style.pas similarity index 99% rename from src/gx/gh_ui_style.pas rename to src/flexui/fui_style.pas index 3b55797..6392b9f 100644 --- a/src/gx/gh_ui_style.pas +++ b/src/flexui/fui_style.pas @@ -16,13 +16,13 @@ *) {$INCLUDE ../../shared/a_modes.inc} {.$DEFINE UI_STYLE_DEBUG_SEARCH} -unit gh_ui_style; +unit fui_style; interface uses SysUtils, Classes, - glgfx, + fui_common, // for TGxRGBA xstreams, xparser, utils, hashtable; diff --git a/src/flexui/sdlcarcass.pas b/src/flexui/sdlcarcass.pas new file mode 100644 index 0000000..3b019a2 --- /dev/null +++ b/src/flexui/sdlcarcass.pas @@ -0,0 +1,310 @@ +(* Copyright (C) DooM 2D:Forever Developers + * + * This program is free software: you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation, either version 3 of the License, or + * (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program. If not, see . + *) +{$INCLUDE ../shared/a_modes.inc} +unit sdlcarcass; + +interface + +uses + SDL2, fui_events; + + +// ////////////////////////////////////////////////////////////////////////// // +// call this with SDL2 event; returns `true` if event was eaten +function fuiOnSDLEvent (var ev: TSDL_Event): Boolean; + + +// ////////////////////////////////////////////////////////////////////////// // +// event handlers +var + winFocusCB: procedure () = nil; // this will be called when window got focus; `fuiWinActive` already set + winBlurCB: procedure () = nil; // this will be called when window lost focus; `fuiWinActive` already set + // for standalone + buildFrameCB: procedure () = nil; // don't do any rendering here, do it in `renderFrameCB()` + renderFrameCB: procedure () = nil; // no need to call `glSwap()` here + exposeFrameCB: procedure () = nil; // call `glSwap()` here instead; automatically set by standalone + // + prerenderFrameCB: procedure () = nil; + postrenderFrameCB: procedure () = nil; + fuiResizeCB: procedure () = nil; // `fuiScrWdt` and `fuiScrHgt` are already set + oglInitCB: procedure () = nil; // `fuiScrWdt` and `fuiScrHgt` are already set + oglDeinitCB: procedure () = nil; + + +var + // default size + fuiScrWdt: Integer = 1024; + fuiScrHgt: Integer = 768; + fuiWinActive: Boolean = false; + fuiQuitReceived: Boolean = false; + + +// ////////////////////////////////////////////////////////////////////////// // +function fuiTimeMicro (): UInt64; inline; +function fuiTimeMilli (): UInt64; inline; + + +// ////////////////////////////////////////////////////////////////////////// // +// only for standalone mode +function getFUIFPS (): Integer; inline; +procedure setFUIFPS (v: Integer); inline; + +property fuiFPS: Integer read getFUIFPS write setFUIFPS; // default: 30 + + +implementation + +uses + SysUtils, Classes, + GL, GLExt, + {$IF DEFINED(LINUX)} + unixtype, linux + {$ELSEIF DEFINED(WINDOWS)} + Windows + {$ELSE} + {$WARNING You suck!} + {$ENDIF} + ; + + +// ////////////////////////////////////////////////////////////////////////// // +var + gEffFPS: Integer = 30; + +function getFUIFPS (): Integer; inline; begin result := gEffFPS; end; +procedure setFUIFPS (v: Integer); inline; begin if (v < 1) then v := 1 else if (v > 60*4) then v := 60*4; gEffFPS := v; end; + + +// ////////////////////////////////////////////////////////////////////////// // +{$IF DEFINED(LINUX)} +type THPTimeType = TTimeSpec; +{$ELSE} +type THPTimeType = Int64; +{$ENDIF} + +var + mFrequency: Int64 = 0; + mHasHPTimer: Boolean = false; + +procedure initTimerIntr (); +var + r: THPTimeType; +begin + if (mFrequency = 0) then + begin +{$IF DEFINED(LINUX)} + if (clock_getres(CLOCK_MONOTONIC, @r) <> 0) then raise Exception.Create('profiler error: cannot get timer resolution'); + mHasHPTimer := (r.tv_nsec <> 0); + if not mHasHPTimer then raise Exception.Create('profiler error: hires timer is not available'); + mFrequency := 1; // just a flag + if (r.tv_nsec <> 0) then mFrequency := 1000000000000000000 div r.tv_nsec; +{$ELSE} + mHasHPTimer := QueryPerformanceFrequency(r); + if not mHasHPTimer then raise Exception.Create('profiler error: hires timer is not available'); + mFrequency := r; +{$ENDIF} + end; +end; + + +function fuiTimeMicro (): UInt64; inline; +var + r: THPTimeType; +begin + //if (mFrequency = 0) then initTimerIntr(); + {$IF DEFINED(LINUX)} + clock_gettime(CLOCK_MONOTONIC, @r); + result := UInt64(r.tv_sec)*1000000+UInt64(r.tv_nsec) div 1000; // microseconds + {$ELSE} + QueryPerformanceCounter(r); + result := UInt64(r)*1000000 div mFrequency; + {$ENDIF} +end; + + +function fuiTimeMilli (): UInt64; inline; +begin + result := fuiTimeMicro() div 1000; +end; + + +// ////////////////////////////////////////////////////////////////////////// // +function fuiOnSDLEvent (var ev: TSDL_Event): Boolean; +var + mev: THMouseEvent; + kev: THKeyEvent; + + function buildBut (b: Byte): Word; + begin + result := 0; + case b of + SDL_BUTTON_LEFT: result := result or THMouseEvent.Left; + SDL_BUTTON_MIDDLE: result := result or THMouseEvent.Middle; + SDL_BUTTON_RIGHT: result := result or THMouseEvent.Right; + end; + end; + + procedure windowEventHandler (constref ev: TSDL_WindowEvent); + begin + case ev.event of + SDL_WINDOWEVENT_MINIMIZED: if fuiWinActive then begin fuiResetKMState(true); fuiWinActive := false; if assigned(winBlurCB) then winBlurCB(); end; + SDL_WINDOWEVENT_RESIZED, SDL_WINDOWEVENT_SIZE_CHANGED: + begin + if (ev.data1 <> fuiScrWdt) or (ev.data2 <> fuiScrHgt) then + begin + fuiScrWdt := ev.data1; + fuiScrHgt := ev.data2; + if assigned(fuiResizeCB) then fuiResizeCB(); + end; + end; + SDL_WINDOWEVENT_EXPOSED: if assigned(exposeFrameCB) then exposeFrameCB(); + SDL_WINDOWEVENT_FOCUS_GAINED: if not fuiWinActive then begin fuiWinActive := true; if assigned(winFocusCB) then winFocusCB(); end; + SDL_WINDOWEVENT_FOCUS_LOST: if fuiWinActive then begin fuiResetKMState(true); fuiWinActive := false; if assigned(winBlurCB) then winBlurCB(); end; + end; + end; + +begin + result := false; + + case ev.type_ of + SDL_WINDOWEVENT: windowEventHandler(ev.window); + SDL_QUITEV: fuiQuitReceived := true; + + 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; + + if (kev.scan = SDL_SCANCODE_RCTRL) then kev.scan := SDL_SCANCODE_LCTRL; + if (kev.scan = SDL_SCANCODE_RALT) then kev.scan := SDL_SCANCODE_LALT; + if (kev.scan = SDL_SCANCODE_RSHIFT) then kev.scan := SDL_SCANCODE_LSHIFT; + if (kev.scan = SDL_SCANCODE_RGUI) then kev.scan := SDL_SCANCODE_LGUI; + + { + if (kev.sym = SDLK_RCTRL) then kev.sym := SDLK_LCTRL; + if (kev.sym = SDLK_RALT) then kev.sym := SDLK_LALT; + if (kev.sym = SDLK_RSHIFT) then kev.sym := SDLK_LSHIFT; + if (kev.sym = SDLK_RGUI) then kev.sym := SDLK_LGUI; + } + + kev.x := fuiMouseX; + kev.y := fuiMouseY; + kev.bstate := fuiButState; + kev.kstate := fuiModState; + + case kev.scan of + SDL_SCANCODE_LCTRL: if (kev.press) then fuiSetModState(fuiModState or THKeyEvent.ModCtrl) else fuiSetModState(fuiModState and (not THKeyEvent.ModCtrl)); + SDL_SCANCODE_LALT: if (kev.press) then fuiSetModState(fuiModState or THKeyEvent.ModAlt) else fuiSetModState(fuiModState and (not THKeyEvent.ModAlt)); + SDL_SCANCODE_LSHIFT: if (kev.press) then fuiSetModState(fuiModState or THKeyEvent.ModShift) else fuiSetModState(fuiModState and (not THKeyEvent.ModShift)); + end; + + 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-fuiMouseX; + mev.dy := ev.button.y-fuiMouseY; + fuiSetMouseX(ev.button.x); + fuiSetMouseY(ev.button.y); + mev.but := buildBut(ev.button.button); + mev.x := fuiMouseX; + mev.y := fuiMouseY; + mev.bstate := fuiButState; + mev.kstate := fuiModState; + if (mev.but <> 0) then + begin + // ev.button.clicks: Byte + if (ev.type_ = SDL_MOUSEBUTTONDOWN) then fuiSetButState(fuiButState or mev.but) else fuiSetButState(fuiButState and (not mev.but)); + 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; + if (ev.wheel.y < 0) then mev.but := THMouseEvent.WheelUp else mev.but := THMouseEvent.WheelDown; + mev.x := fuiMouseX; + mev.y := fuiMouseY; + mev.bstate := fuiButState; + mev.kstate := fuiModState; + 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-fuiMouseX; + mev.dy := ev.button.y-fuiMouseY; + fuiSetMouseX(ev.button.x); + fuiSetMouseY(ev.button.y); + mev.but := 0; + mev.x := fuiMouseX; + mev.y := fuiMouseY; + mev.bstate := fuiButState; + mev.kstate := fuiModState; + if assigned(evMouseCB) then + begin + evMouseCB(mev); + result := mev.eaten; + end; + end; + + { + SDL_TEXTINPUT: + begin + Utf8ToUnicode(@uc, PChar(ev.text.text), 1); + keychr := Word(uc); + if (keychr > 127) then keychr := Word(wchar2win(WideChar(keychr))); + CharPress(AnsiChar(keychr)); + end; + } + end; +end; + + +begin + initTimerIntr(); + fuiWinActive := fuiWinActive; + fuiScrWdt := fuiScrWdt; + fuiScrHgt := fuiScrHgt; +end. diff --git a/src/flexui/sdlstandalone.pas b/src/flexui/sdlstandalone.pas new file mode 100644 index 0000000..11f5210 --- /dev/null +++ b/src/flexui/sdlstandalone.pas @@ -0,0 +1,230 @@ +(* Copyright (C) DooM 2D:Forever Developers + * + * This program is free software: you can redistribute it and/or modify + * it under the terms of the GNU General Public License as published by + * the Free Software Foundation, either version 3 of the License, or + * (at your option) any later version. + * + * This program is distributed in the hope that it will be useful, + * but WITHOUT ANY WARRANTY; without even the implied warranty of + * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the + * GNU General Public License for more details. + * + * You should have received a copy of the GNU General Public License + * along with this program. If not, see . + *) +{$INCLUDE ../shared/a_modes.inc} +unit sdlstandalone; + +interface + +uses + SDL2, + sdlcarcass; + + +// ////////////////////////////////////////////////////////////////////////// // +// initialize OpenGL; set `gScreenWidth` and `gScreenHeight` before calling this +function glInit (const winTitle: AnsiString='SDL TEST'): Boolean; +procedure glDeinit (); +// call this to show built frame +procedure glSwap (); +// call this to push "quit" event into queue +procedure pushQuitEvent (); +// call this to process queued messages; result is `true` if quit event was received +function processMessages (): Boolean; + +// run main loop, call `buildFrameCB()` and `renderFrameCB()`, maintain the given FPS +procedure mainLoop (); + + +implementation + +uses + SysUtils; + + +var + gWinH: PSDL_Window = nil; + gGLContext: TSDL_GLContext = nil; + lastFrameTime: UInt64 = 0; + + +// ////////////////////////////////////////////////////////////////////////// // +procedure onExposeFrame (); +begin + glSwap(); +end; + + +// ////////////////////////////////////////////////////////////////////////// // +function sdlInit (): Boolean; +var + sdlflags: LongWord; +begin + result := false; + + sdlflags := SDL_INIT_TIMER or SDL_INIT_VIDEO; + if SDL_Init(sdlflags) < 0 then exit; //raise Exception.Create('SDL: Init failed: ' + SDL_GetError()); + + //SDL_Quit(); + result := true; + fuiWinActive := fuiWinActive; +end; + + +procedure glSwap (); +begin + if (gWinH = nil) then exit; + SDL_GL_SwapWindow(gWinH); +end; + + +procedure killGLWindow (); +begin + if (gWinH <> nil) then SDL_DestroyWindow(gWinH); + if (gGLContext <> nil) then SDL_GL_DeleteContext(gGLContext); + gWinH := nil; + gGLContext := nil; +end; + + +procedure pushQuitEvent (); +var + ev: TSDL_Event; +begin + ev.type_ := SDL_QUITEV; + SDL_PushEvent(@ev); +end; + + +// ////////////////////////////////////////////////////////////////////////// // +// true: quit +function processMessages (): Boolean; +var + ev: TSDL_Event; +begin + result := false; + FillChar(ev, sizeof(ev), 0); + while (SDL_PollEvent(@ev) > 0) do + begin + if fuiOnSDLEvent(ev) then result := true; + //if (ev.type_ = SDL_QUITEV) then exit; + end; +end; + + +// ////////////////////////////////////////////////////////////////////////// // +procedure glDeinit (); +begin + if (gWinH <> nil) and assigned(oglDeinitCB) then oglDeinitCB(); + killGLWindow(); +end; + + +function glInit (const winTitle: AnsiString='SDL TEST'): Boolean; +var + wFlags: LongWord = 0; + v: Byte = 0; +begin + result := false; + + wFlags := SDL_WINDOW_OPENGL or SDL_WINDOW_RESIZABLE; + //if gFullscreen then wFlags := wFlags or SDL_WINDOW_FULLSCREEN; + //if gWinMaximized then wFlags := wFlags or SDL_WINDOW_MAXIMIZED; + + glDeinit(); + + //if VSync then v := 1 else v := 0; + SDL_GL_SetAttribute(SDL_GL_CONTEXT_MAJOR_VERSION, 2); + SDL_GL_SetAttribute(SDL_GL_CONTEXT_MINOR_VERSION, 1); + SDL_GL_SetAttribute(SDL_GL_RED_SIZE, 8); + SDL_GL_SetAttribute(SDL_GL_GREEN_SIZE, 8); + SDL_GL_SetAttribute(SDL_GL_BLUE_SIZE, 8); + SDL_GL_SetAttribute(SDL_GL_DEPTH_SIZE, 16); + SDL_GL_SetAttribute(SDL_GL_DOUBLEBUFFER, 1); + SDL_GL_SetAttribute(SDL_GL_STENCIL_SIZE, 1); // lights; it is enough to have 1-bit stencil buffer for lighting + SDL_GL_SetSwapInterval(v); + + { + if gFullscreen then + begin + mode.w := gScreenWidth; + mode.h := gScreenHeight; + mode.format := 0; + mode.refresh_rate := 0; + mode.driverdata := nil; + if SDL_GetClosestDisplayMode(0, @mode, @cmode) = nil then + begin + gScreenWidth := 800; + gScreenHeight := 600; + end + else + begin + gScreenWidth := cmode.w; + gScreenHeight := cmode.h; + end; + end; + } + + gWinH := SDL_CreateWindow(PAnsiChar(winTitle), -1, -1, fuiScrWdt, fuiScrHgt, wFlags); + if (gWinH = nil) then exit; + + gGLContext := SDL_GL_CreateContext(gWinH); + if (gGLContext = nil) then begin SDL_DestroyWindow(gWinH); gWinH := nil; exit; end; + + SDL_GL_MakeCurrent(gWinH, gGLContext); + SDL_ShowCursor(SDL_DISABLE); + + if assigned(oglInitCB) then oglInitCB(); + + result := true; +end; + + +// run main loop, call `buildFrameCB()` and `renderFrameCB()`, maintain the given FPS +procedure mainLoop (); +var + nft, ctt: UInt64; + wt: Integer; +begin + if assigned(buildFrameCB) then buildFrameCB(); + if assigned(prerenderFrameCB) then prerenderFrameCB(); + if assigned(renderFrameCB) then renderFrameCB(); + if assigned(postrenderFrameCB) then postrenderFrameCB(); + glSwap(); + lastFrameTime := fuiTimeMilli(); + while true do + begin + // calculate time to build and render next frame + nft := lastFrameTime+(1000 div fuiFPS); + ctt := fuiTimeMilli(); + if (ctt >= nft) then + begin + // time to build next frame + if assigned(buildFrameCB) then buildFrameCB(); + if assigned(prerenderFrameCB) then prerenderFrameCB(); + if assigned(renderFrameCB) then renderFrameCB(); + if assigned(postrenderFrameCB) then postrenderFrameCB(); + glSwap(); + lastFrameTime := ctt; // ignore frame processing time + end + else + begin + // has to wait for some time + if (nft-ctt > 1000) then wt := 1000 else wt := Integer(nft-ctt); + SDL_WaitEventTimeout(nil, wt); + end; + if processMessages() then break; // just in case + end; +end; + + +initialization + exposeFrameCB := onExposeFrame(); + + if not sdlInit() then raise Exception.Create('cannot initialize SDL'); +finalization + glDeinit(); + SDL_Quit(); +end. diff --git a/src/game/Doom2DF.dpr b/src/game/Doom2DF.dpr index 41c7aac..daf5f46 100644 --- a/src/game/Doom2DF.dpr +++ b/src/game/Doom2DF.dpr @@ -108,15 +108,20 @@ uses envvars in '../shared/envvars.pas', g_panel in 'g_panel.pas', g_language in 'g_language.pas', + + sdlcarcass in '../flexui/sdlcarcass.pas', + //sdlstandalone in '../flexui/sdlstandalone.pas', + + fui_common in '../flexui/fui_common.pas', + fui_gfx_gl in '../flexui/fui_gfx_gl.pas', + fui_events in '../flexui/fui_events.pas', + fui_style in '../flexui/fui_style.pas', + fui_flexlay in '../flexui/fui_flexlay.pas', + fui_ctls in '../flexui/fui_ctls.pas', + ImagingTypes, Imaging, - ImagingUtility, - sdlcarcass in '../gx/sdlcarcass.pas', - glgfx in '../gx/glgfx.pas', - gh_ui_common in '../gx/gh_ui_common.pas', - gh_ui_style in '../gx/gh_ui_style.pas', - gh_ui in '../gx/gh_ui.pas', - gh_flexlay in '../gx/gh_flexlay.pas'; + ImagingUtility; {$IFDEF WINDOWS} {$R *.res} diff --git a/src/game/g_holmes.pas b/src/game/g_holmes.pas index e23c435..0ded9ee 100644 --- a/src/game/g_holmes.pas +++ b/src/game/g_holmes.pas @@ -24,7 +24,9 @@ uses g_textures, g_basic, e_graphics, g_phys, g_grid, g_player, g_monsters, g_window, g_map, g_triggers, g_items, g_game, g_panel, g_console, g_gfx, xprofiler, - sdlcarcass, glgfx, gh_ui_common, gh_ui; + sdlcarcass, + fui_common, fui_events, fui_ctls, + fui_gfx_gl; procedure g_Holmes_Draw (); @@ -1676,5 +1678,5 @@ begin evMouseCB := onMouseEvent; evKeyCB := onKeyEvent; - conRegVar('hlm_ui_scale', @gh_ui_scale, 0.01, 5.0, 'Holmes UI scale', '', false); + conRegVar('hlm_ui_scale', @fuiRenderScale, 0.01, 5.0, 'Holmes UI scale', '', false); end. diff --git a/src/game/g_window.pas b/src/game/g_window.pas index 1db0c63..258b489 100644 --- a/src/game/g_window.pas +++ b/src/game/g_window.pas @@ -57,7 +57,7 @@ uses g_console, e_input, g_options, g_game, g_basic, g_textures, e_sound, g_sound, g_menu, ENet, g_net, g_map, g_gfx, g_monsters, g_holmes, xprofiler, - sdlcarcass, gh_ui; + sdlcarcass, fui_ctls; const @@ -410,7 +410,7 @@ begin key := ev.key.keysym.scancode; down := (ev.type_ = SDL_KEYDOWN); {$IF not DEFINED(HEADLESS)} - if evSDLCB(ev) then + if fuiOnSDLEvent(ev) then begin // event eaten, but... if not down then e_KeyUpDown(key, false); @@ -423,7 +423,7 @@ begin {$IF not DEFINED(HEADLESS)} SDL_MOUSEBUTTONDOWN, SDL_MOUSEBUTTONUP, SDL_MOUSEWHEEL, SDL_MOUSEMOTION: - evSDLCB(ev); + fuiOnSDLEvent(ev); {$ENDIF} SDL_TEXTINPUT: @@ -803,7 +803,7 @@ begin begin if (idx <= ParamCount) then begin - if not conParseFloat(gh_ui_scale, ParamStr(idx)) then gh_ui_scale := 1.0; + if not conParseFloat(fuiRenderScale, ParamStr(idx)) then fuiRenderScale := 1.0; Inc(idx); end; end; diff --git a/src/gx/gh_ui_common.pas b/src/gx/gh_ui_common.pas deleted file mode 100644 index de719d9..0000000 --- a/src/gx/gh_ui_common.pas +++ /dev/null @@ -1,111 +0,0 @@ -(* coded by Ketmar // Invisible Vector - * Understanding is not required. Only obedience. - * - * This program is free software: you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation, either version 3 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program. If not, see . - *) -{$INCLUDE ../shared/a_modes.inc} -unit gh_ui_common; - -interface - - -// ////////////////////////////////////////////////////////////////////////// // -type - TLaySize = record - public - w, h: Integer; - - private - function getIdx (idx: Integer): Integer; inline; - procedure setIdx (idx, v: Integer); inline; - - public - constructor Create (aw, ah: Integer); - - function toString (): AnsiString; - - function equals (constref a: TLaySize): Boolean; inline; - public - property item[idx: Integer]: Integer read getIdx write setIdx; default; - end; - - TLayPos = record - public - x, y: Integer; - - private - function getIdx (idx: Integer): Integer; inline; - procedure setIdx (idx, v: Integer); inline; - - public - constructor Create (ax, ay: Integer); - - function toString (): AnsiString; - - function equals (constref a: TLayPos): Boolean; inline; - - public - property item[idx: Integer]: Integer read getIdx write setIdx; default; - end; - - TLayMargins = record - public - top, right, bottom, left: Integer; - - public - constructor Create (atop, aright, abottom, aleft: Integer); - - function toString (): AnsiString; - - function horiz (): Integer; inline; - function vert (): Integer; inline; - end; - - -implementation - -uses - utils; - - -// ////////////////////////////////////////////////////////////////////////// // -constructor TLaySize.Create (aw, ah: Integer); begin w := aw; h := ah; end; -function TLaySize.getIdx (idx: Integer): Integer; inline; begin if (idx = 0) then result := w else if (idx = 1) then result := h else result := -1; end; -procedure TLaySize.setIdx (idx, v: Integer); inline; begin if (idx = 0) then w := v else if (idx = 1) then h := v; end; -function TLaySize.toString (): AnsiString; begin result := formatstrf('[%d,%d]', [w, h]); end; -function TLaySize.equals (constref a: TLaySize): Boolean; inline; begin result := (w = a.w) and (h = a.h); end; - -constructor TLayPos.Create (ax, ay: Integer); begin x := ax; y := ay; end; -function TLayPos.getIdx (idx: Integer): Integer; inline; begin if (idx = 0) then result := x else if (idx = 1) then result := y else result := -1; end; -procedure TLayPos.setIdx (idx, v: Integer); inline; begin if (idx = 0) then x := v else if (idx = 1) then y := v; end; -function TLayPos.toString (): AnsiString; begin result := formatstrf('(%d,%d)', [x, y]); end; -function TLayPos.equals (constref a: TLayPos): Boolean; inline; begin result := (x = a.x) and (y = a.y); end; - -constructor TLayMargins.Create (atop, aright, abottom, aleft: Integer); -begin - if (atop < 0) then atop := 0; - if (aright < 0) then aright := 0; - if (abottom < 0) then abottom := 0; - if (aleft < 0) then aleft := 0; - left := aleft; - right := aright; - top := atop; - bottom := abottom; -end; -function TLayMargins.toString (): AnsiString; begin result := formatstrf('(%s,%s,%s,%s)', [top, right, bottom, left]); end; -function TLayMargins.horiz (): Integer; inline; begin result := left+right; end; -function TLayMargins.vert (): Integer; inline; begin result := top+bottom; end; - - -end. diff --git a/src/gx/sdlcarcass.pas b/src/gx/sdlcarcass.pas deleted file mode 100644 index 29c1c3f..0000000 --- a/src/gx/sdlcarcass.pas +++ /dev/null @@ -1,57 +0,0 @@ -(* Copyright (C) DooM 2D:Forever Developers - * - * This program is free software: you can redistribute it and/or modify - * it under the terms of the GNU General Public License as published by - * the Free Software Foundation, either version 3 of the License, or - * (at your option) any later version. - * - * This program is distributed in the hope that it will be useful, - * but WITHOUT ANY WARRANTY; without even the implied warranty of - * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the - * GNU General Public License for more details. - * - * You should have received a copy of the GNU General Public License - * along with this program. If not, see . - *) -{$INCLUDE ../shared/a_modes.inc} -unit sdlcarcass; - -interface - -uses - SDL2; - - -// ////////////////////////////////////////////////////////////////////////// // -// event handlers -var - evSDLCB: function (var ev: TSDL_Event): Boolean = nil; - winFocusCB: procedure () = nil; - winBlurCB: procedure () = nil; - //buildFrameCB: procedure () = nil; - //renderFrameCB: procedure () = nil; // no need to call `glSwap()` here - prerenderFrameCB: procedure () = nil; - postrenderFrameCB: procedure () = nil; - oglInitCB: procedure () = nil; - oglDeinitCB: procedure () = nil; - - -function getScrWdt (): Integer; inline; -function getScrHgt (): Integer; inline; - -property - gScrWidth: Integer read getScrWdt; - gScrHeight: Integer read getScrHgt; - - -implementation - -uses - g_options; - - -function getScrWdt (): Integer; inline; begin result := gScreenWidth; end; -function getScrHgt (): Integer; inline; begin result := gScreenHeight; end; - - -end.