diff --git a/src/gx/glgfx.pas b/src/gx/glgfx.pas
index 5fa57e737cd43880e78b30966723f54301b9acbc..d39d2f087bfd1863693c7685aca40a64a243c09f 100644 (file)
--- a/src/gx/glgfx.pas
+++ b/src/gx/glgfx.pas
-(* Copyright (C) DooM 2D:Forever Developers
+(* coded by Ketmar // Invisible Vector <ketmar@ketmar.no-ip.org>
+ * 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
* 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 <http://www.gnu.org/licenses/>.
+ * along with this program. If not, see <http://www.gnu.org/licenses/>.
*)
{$INCLUDE ../shared/a_modes.inc}
unit glgfx;
type
TKind = (Release, Press, Motion);
+ private
+ mEaten: Boolean;
+ mCancelled: Boolean;
+
public
kind: TKind; // motion, press, release
x, y: Integer; // current mouse position
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
type
TKind = (Release, Press);
+ private
+ mEaten: Boolean;
+ mCancelled: Boolean;
+
public
kind: TKind;
scan: Word; // SDL_SCANCODE_XXX
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;
+
+ public
+ property eaten: Boolean read mEaten;
+ property cancelled: Boolean read mCancelled;
end;
+
// ////////////////////////////////////////////////////////////////////////// //
// setup 2D OpenGL mode; will be called automatically in `glInit()`
procedure oglSetup2D (winWidth, winHeight: Integer; upsideDown: Boolean=false);
@@ -132,35 +158,36 @@ function intersectRect (var x0, y0, w0, h0: Integer; const x1, y1, w1, h1: Integ
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;
function textWidth6 (const s: AnsiString): Integer;
function textWidth8 (const s: AnsiString): Integer;
// return width (including last empty pixel)
-function drawTextInternal (wdt, x, y: Integer; const s: AnsiString; r, g, b: Integer; a: Integer; tid: GLuint; constref fontwdt: array of Byte; prop: Boolean): Integer;
-procedure drawLine (x1, y1, x2, y2: Integer; r, g, b: Integer; a: Integer=255);
-procedure drawVLine (x, y, len: Integer; r, g, b: Integer; a: Integer=255);
-procedure drawHLine (x, y, len: Integer; r, g, b: Integer; a: Integer=255);
-procedure drawRect (x, y, w, h: Integer; r, g, b: Integer; a: Integer=255);
-procedure drawRectUI (x, y, w, h: Integer; r, g, b: Integer; a: Integer=255);
+function drawTextInternal (wdt, x, y: Integer; const s: AnsiString; constref clr: TGxRGBA; tid: GLuint; constref fontwdt: array of Byte; prop: Boolean): Integer;
+procedure drawLine (x1, y1, x2, y2: Integer; constref clr: TGxRGBA);
+procedure drawVLine (x, y, len: Integer; constref clr: TGxRGBA);
+procedure drawHLine (x, y, len: Integer; constref clr: TGxRGBA);
+procedure drawRect (x, y, w, h: Integer; constref clr: TGxRGBA);
+procedure drawRectUI (x, y, w, h: Integer; constref clr: TGxRGBA);
procedure darkenRect (x, y, w, h: Integer; a: Integer);
-procedure fillRect (x, y, w, h: Integer; r, g, b: Integer; a: Integer=255);
-function drawText6 (x, y: Integer; const s: AnsiString; r, g, b: Integer; a: Integer=255): Integer;
-function drawText8 (x, y: Integer; const s: AnsiString; r, g, b: Integer; a: Integer=255): Integer;
-function drawText6Prop (x, y: Integer; const s: AnsiString; r, g, b: Integer; a: Integer=255): Integer;
-function drawText8Prop (x, y: Integer; const s: AnsiString; r, g, b: Integer; a: Integer=255): Integer;
+procedure fillRect (x, y, w, h: Integer; constref clr: TGxRGBA);
+function drawText6 (x, y: Integer; const s: AnsiString; constref clr: TGxRGBA): Integer;
+function drawText8 (x, y: Integer; const s: AnsiString; constref clr: TGxRGBA): Integer;
+function drawText6Prop (x, y: Integer; const s: AnsiString; constref clr: TGxRGBA): Integer;
+function drawText8Prop (x, y: Integer; const s: AnsiString; constref clr: TGxRGBA): Integer;
// x-centered at `x`
-function drawText6XC (x, y: Integer; const s: AnsiString; r, g, b: Integer; a: Integer=255): Integer;
-function drawText8XC (x, y: Integer; const s: AnsiString; r, g, b: Integer; a: Integer=255): Integer;
-function drawText6PropXC (x, y: Integer; const s: AnsiString; r, g, b: Integer; a: Integer=255): Integer;
-function drawText8PropXC (x, y: Integer; const s: AnsiString; r, g, b: Integer; a: Integer=255): Integer;
+function drawText6XC (x, y: Integer; const s: AnsiString; constref clr: TGxRGBA): Integer;
+function drawText8XC (x, y: Integer; const s: AnsiString; constref clr: TGxRGBA): Integer;
+function drawText6PropXC (x, y: Integer; const s: AnsiString; constref clr: TGxRGBA): Integer;
+function drawText8PropXC (x, y: Integer; const s: AnsiString; constref clr: TGxRGBA): Integer;
// ////////////////////////////////////////////////////////////////////////// //
// event handlers
var
- evMouseCB: function (var ev: THMouseEvent): Boolean = nil; // `true`: event eaten
- evKeyCB: function (var ev: THKeyEvent): Boolean = nil; // `true`: event eaten
+ evMouseCB: procedure (var ev: THMouseEvent) = nil;
+ evKeyCB: procedure (var ev: THKeyEvent) = nil;
// ////////////////////////////////////////////////////////////////////////// //
// ////////////////////////////////////////////////////////////////////////// //
+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;
// ////////////////////////////////////////////////////////////////////////// //
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
+ while (pos <= Length(s)) do
begin
- if (Length(s)-pos >= 2) and (s[pos+1] = '-') then
+ 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;
end;
break;
end;
- if (Length(s)-pos >= 4) and ((s[pos+1] = 'M') or (s[pos+1] = 'm')) and ((s[pos+2] = 'B') or (s[pos+1] = 'b')) and (s[pos+3] = '-') then
+ 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;
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; end
- else if (s[1] = '-') then begin if (not ev.release) then exit; end
+ 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;
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;
// 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;
// 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;
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;
SDL_SCANCODE_LSHIFT: if (kev.press) then curModState := curModState or THKeyEvent.ModShift else curModState := curModState and (not THKeyEvent.ModShift);
end;
- if assigned(evKeyCB) then result := evKeyCB(kev);
+ 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;
- if (ev.type_ = SDL_MOUSEBUTTONDOWN) then mev.kind := THMouseEvent.TKind.Press else mev.kind := THMouseEvent.TKind.Release;
mev.but := buildBut(ev.button.button);
mev.x := curMsX;
mev.y := curMsY;
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 result := evMouseCB(mev);
+ 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;
- mev.kind := THMouseEvent.TKind.Press;
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 result := evMouseCB(mev);
+ 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.kind := THMouseEvent.TKind.Motion;
mev.but := 0;
mev.x := curMsX;
mev.y := curMsY;
mev.bstate := curButState;
mev.kstate := curModState;
- if assigned(evMouseCB) then result := evMouseCB(mev);
+ if assigned(evMouseCB) then
+ begin
+ evMouseCB(mev);
+ result := mev.eaten;
+ end;
end;
{
result := true;
end;
+// returns `false` if the color is transparent
+function setupGLColor (constref clr: TGxRGBA): Boolean;
+begin
+ if (clr.a < 255) then
+ begin
+ if (clr.a = 0) then begin result := false; exit; end;
+ glEnable(GL_BLEND);
+ glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
+ end
+ else
+ begin
+ glDisable(GL_BLEND);
+ end;
+ glColor4ub(clr.r, clr.g, clr.b, clr.a);
+ result := true;
+end;
+
function isScaled (): Boolean;
var
mt: packed array [0..15] of Double;
// return width (including last empty pixel)
-function drawTextInternal (wdt, x, y: Integer; const s: AnsiString; r, g, b: Integer; a: Integer; tid: GLuint; constref fontwdt: array of Byte; prop: Boolean): Integer;
+function drawTextInternal (wdt, x, y: Integer; const s: AnsiString; constref clr: TGxRGBA; tid: GLuint; constref fontwdt: array of Byte; prop: Boolean): Integer;
var
f, c: Integer;
tx, ty: Integer;
begin
result := 0;
if (Length(s) = 0) then exit;
- if not setupGLColor(r, g, b, a) then exit;
+ if not setupGLColor(clr) then exit;
glEnable(GL_ALPHA_TEST);
glAlphaFunc(GL_NOTEQUAL, 0.0);
// ////////////////////////////////////////////////////////////////////////// //
-procedure drawHLine (x, y, len: Integer; r, g, b: Integer; a: Integer=255);
+procedure drawHLine (x, y, len: Integer; constref clr: TGxRGBA);
begin
if (len < 1) then exit;
- if not setupGLColor(r, g, b, a) then exit;
+ if not setupGLColor(clr) then exit;
glDisable(GL_TEXTURE_2D);
if (not isScaled) then
begin
+ glLineWidth(1);
glBegin(GL_LINES);
glVertex2f(x+0.375, y+0.375);
glVertex2f(x+len+0.375, y+0.375);
end;
-procedure drawVLine (x, y, len: Integer; r, g, b: Integer; a: Integer=255);
+procedure drawVLine (x, y, len: Integer; constref clr: TGxRGBA);
begin
if (len < 1) then exit;
- if not setupGLColor(r, g, b, a) then exit;
+ if not setupGLColor(clr) then exit;
glDisable(GL_TEXTURE_2D);
if (not isScaled) then
begin
+ glLineWidth(1);
glBegin(GL_LINES);
glVertex2f(x+0.375, y+0.375);
glVertex2f(x+0.375, y+len+0.375);
end;
-procedure drawLine (x1, y1, x2, y2: Integer; r, g, b: Integer; a: Integer=255);
+procedure drawLine (x1, y1, x2, y2: Integer; constref clr: TGxRGBA);
begin
- if not setupGLColor(r, g, b, a) then exit;
+ if not setupGLColor(clr) then exit;
glDisable(GL_TEXTURE_2D);
if (not isScaled) then
begin
+ glLineWidth(1);
glBegin(GL_LINES);
glVertex2f(x1+0.375, y1+0.375);
glVertex2f(x2+0.375, y2+0.375);
end
else
begin
+ glLineWidth(1);
glBegin(GL_LINES);
glVertex2i(x1, y1);
glVertex2i(x2, y2);
end;
-procedure drawRect (x, y, w, h: Integer; r, g, b: Integer; a: Integer=255);
+procedure drawRect (x, y, w, h: Integer; constref clr: TGxRGBA);
begin
if (w < 0) or (h < 0) then exit;
- if not setupGLColor(r, g, b, a) then exit;
+ if not setupGLColor(clr) then exit;
glDisable(GL_TEXTURE_2D);
glLineWidth(1);
glDisable(GL_LINE_SMOOTH);
end
else
begin
+ glLineWidth(1);
glBegin(GL_LINES);
glVertex2i(x, y); glVertex2i(x+w, y); // top
glVertex2i(x, y+h-1); glVertex2i(x+w, y+h-1); // bottom
end;
-procedure drawRectUI (x, y, w, h: Integer; r, g, b: Integer; a: Integer=255);
+procedure drawRectUI (x, y, w, h: Integer; constref clr: TGxRGBA);
procedure hline (x, y, len: Integer);
begin
if (len < 1) then exit;
scaled: Boolean;
begin
if (w < 0) or (h < 0) then exit;
- if not setupGLColor(r, g, b, a) then exit;
+ if not setupGLColor(clr) then exit;
glDisable(GL_TEXTURE_2D);
glLineWidth(1);
glDisable(GL_LINE_SMOOTH);
begin
if not scaled then
begin
+ glLineWidth(1);
glBegin(GL_LINES);
glVertex2i(x, y); glVertex2i(x+w, y); // top
glVertex2i(x, y+h-1); glVertex2i(x+w, y+h-1); // bottom
end;
-procedure fillRect (x, y, w, h: Integer; r, g, b: Integer; a: Integer=255);
+procedure fillRect (x, y, w, h: Integer; constref clr: TGxRGBA);
begin
if (w < 0) or (h < 0) then exit;
- if not setupGLColor(r, g, b, a) then exit;
+ if not setupGLColor(clr) then exit;
glDisable(GL_LINE_SMOOTH);
glDisable(GL_POLYGON_SMOOTH);
glDisable(GL_TEXTURE_2D);
// ////////////////////////////////////////////////////////////////////////// //
-function drawText6 (x, y: Integer; const s: AnsiString; r, g, b: Integer; a: Integer=255): Integer;
+function drawText6 (x, y: Integer; const s: AnsiString; constref clr: TGxRGBA): Integer;
begin
if (font6texid = 0) then createFonts();
- drawTextInternal(6, x, y, s, r, g, b, a, font6texid, kgiFont6PropWidth, false);
+ drawTextInternal(6, x, y, s, clr, font6texid, kgiFont6PropWidth, false);
result := Length(s)*6;
end;
-function drawText8 (x, y: Integer; const s: AnsiString; r, g, b: Integer; a: Integer=255): Integer;
+function drawText8 (x, y: Integer; const s: AnsiString; constref clr: TGxRGBA): Integer;
begin
if (font8texid = 0) then createFonts();
- drawTextInternal(8, x, y, s, r, g, b, a, font8texid, kgiFont8PropWidth, false);
+ drawTextInternal(8, x, y, s, clr, font8texid, kgiFont8PropWidth, false);
result := Length(s)*8;
end;
-function drawText6Prop (x, y: Integer; const s: AnsiString; r, g, b: Integer; a: Integer=255): Integer;
+function drawText6Prop (x, y: Integer; const s: AnsiString; constref clr: TGxRGBA): Integer;
begin
if (prfont6texid = 0) then createFonts();
- result := drawTextInternal(6, x, y, s, r, g, b, a, prfont6texid, kgiFont6PropWidth, true);
+ result := drawTextInternal(6, x, y, s, clr, prfont6texid, kgiFont6PropWidth, true);
end;
-function drawText8Prop (x, y: Integer; const s: AnsiString; r, g, b: Integer; a: Integer=255): Integer;
+function drawText8Prop (x, y: Integer; const s: AnsiString; constref clr: TGxRGBA): Integer;
begin
if (prfont8texid = 0) then createFonts();
- result := drawTextInternal(8, x, y, s, r, g, b, a, prfont8texid, kgiFont8PropWidth, true);
+ result := drawTextInternal(8, x, y, s, clr, prfont8texid, kgiFont8PropWidth, true);
end;
// ////////////////////////////////////////////////////////////////////////// //
// x-centered at `x`
-function drawText6XC (x, y: Integer; const s: AnsiString; r, g, b: Integer; a: Integer=255): Integer;
+function drawText6XC (x, y: Integer; const s: AnsiString; constref clr: TGxRGBA): Integer;
begin
if (font6texid = 0) then createFonts();
x -= Length(s)*6 div 2;
- drawTextInternal(6, x, y, s, r, g, b, a, font6texid, kgiFont6PropWidth, false);
+ drawTextInternal(6, x, y, s, clr, font6texid, kgiFont6PropWidth, false);
result := Length(s)*6;
end;
-function drawText8XC (x, y: Integer; const s: AnsiString; r, g, b: Integer; a: Integer=255): Integer;
+function drawText8XC (x, y: Integer; const s: AnsiString; constref clr: TGxRGBA): Integer;
begin
if (font8texid = 0) then createFonts();
x -= Length(s)*8 div 2;
- drawTextInternal(8, x, y, s, r, g, b, a, font8texid, kgiFont8PropWidth, false);
+ drawTextInternal(8, x, y, s, clr, font8texid, kgiFont8PropWidth, false);
result := Length(s)*8;
end;
-function drawText6PropXC (x, y: Integer; const s: AnsiString; r, g, b: Integer; a: Integer=255): Integer;
+function drawText6PropXC (x, y: Integer; const s: AnsiString; constref clr: TGxRGBA): Integer;
begin
if (prfont6texid = 0) then createFonts();
x -= textWidth6(s) div 2;
- result := drawTextInternal(6, x, y, s, r, g, b, a, prfont6texid, kgiFont6PropWidth, true);
+ result := drawTextInternal(6, x, y, s, clr, prfont6texid, kgiFont6PropWidth, true);
end;
-function drawText8PropXC (x, y: Integer; const s: AnsiString; r, g, b: Integer; a: Integer=255): Integer;
+function drawText8PropXC (x, y: Integer; const s: AnsiString; constref clr: TGxRGBA): Integer;
begin
if (prfont8texid = 0) then createFonts();
x -= textWidth8(s) div 2;
- result := drawTextInternal(8, x, y, s, r, g, b, a, prfont8texid, kgiFont8PropWidth, true);
+ result := drawTextInternal(8, x, y, s, clr, prfont8texid, kgiFont8PropWidth, true);
end;