diff --git a/src/gx/glgfx.pas b/src/gx/glgfx.pas
index fb7e593847e1f33009cefe780c7569fe6960fc58..1237550cc98d8b425a42f041810b30681702fe78 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;
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
procedure restore ();
// set new scissor rect, bounded by the saved scissor rect
- procedure setRect (x, y, w, h: Integer);
+ procedure combineRect (x, y, w, h: Integer);
end;
@@ -112,28 +133,29 @@ 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;
// ////////////////////////////////////////////////////////////////////////// //
@@ -219,6 +241,45 @@ function THKeyEvent.press (): Boolean; inline; begin result := (kind = TKind.Pre
function THKeyEvent.release (): Boolean; inline; begin result := (kind = TKind.Release); 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;
wassc := (glIsEnabled(GL_SCISSOR_TEST) <> 0);
if wassc then glGetIntegerv(GL_SCISSOR_BOX, @scxywh[0]) else glGetIntegerv(GL_VIEWPORT, @scxywh[0]);
//conwritefln('(%d,%d)-(%d,%d)', [scxywh[0], scxywh[1], scxywh[2], scxywh[3]]);
- if enableScissoring then glEnable(GL_SCISSOR_TEST);
+ if enableScissoring and (not wassc) then glEnable(GL_SCISSOR_TEST);
end;
procedure TScissorSave.restore ();
if wassc then glEnable(GL_SCISSOR_TEST) else glDisable(GL_SCISSOR_TEST);
end;
-procedure TScissorSave.setRect (x, y, w, h: Integer);
+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);
- if not intersectRect(x, y, w, h, scxywh[0], scxywh[1], scxywh[2], scxywh[3]) then glScissor(0, 0, 0, 0) else glScissor(x, y, w, h);
+ //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
+ //writeln('oops: COMBINE: old=(', ox, ',', oy, ')-(', ox+ow-1, ',', oy+oh-1, '); sci: (', scxywh[0], ',', scxywh[1], ')-(', scxywh[0]+scxywh[2]-1, ',', scxywh[1]+scxywh[3]-1, ')');
+ //writeln('oops: COMBINE: oldx=<', ox, '-', ox+ow-1, '>; oldy=<', oy, ',', oy+oh-1, '> : scix=<', scxywh[0], '-', scxywh[0]+scxywh[2]-1, '>; sciy=<', scxywh[1], '-', scxywh[1]+scxywh[3]-1, '>');
+ glScissor(0, 0, 0, 0);
+ end
+ else
+ begin
+ glScissor(x, y, w, h);
+ 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;
+ if (w0 < 1) or (h0 < 1) or (w1 < 1) or (h1 < 1) then exit; // at least one rect is null
// check for intersection
- if (x0+w0 <= x1) or (y0+h0 <= y1) or (x1+w1 <= x0) or (y1+h1 <= y0) then exit;
- if (x0 >= x1+w1) or (y0 >= y1+h1) or (x1 >= x0+h0) or (y1 >= y0+h0) then exit;
- // ok, intersects
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 > x1+w1) then ex0 := x1+w1;
- if (ey0 > y1+h1) then ey0 := y1+h1;
+ if (ex0 > ex1) then ex0 := ex1;
+ if (ey0 > ey1) then ey0 := ey1;
w0 := ex0-x0;
h0 := ey0-y0;
result := (w0 > 0) and (h0 > 0);
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;