index b0ccd2285e7af84a8ffa1f8e8444a1ebfca45378..bd409d38f9218b6579041ec92f52066b3c18ffd6 100644 (file)
* along with this program. If not, see <http://www.gnu.org/licenses/>.
*)
{$INCLUDE ../shared/a_modes.inc}
+{$DEFINE FUI_TEXT_ICONS}
unit fui_gfx_gl;
interface
function combineClip (constref aclip: TGxRect): TGxRect; // returns previous clip
+ public //HACK!
+ procedure glSetScale (ascale: Single);
+ procedure glSetTrans (ax, ay: Single);
+ procedure glSetScaleTrans (ascale, ax, ay: Single);
+
public
property active: Boolean read mActive;
property color: TGxRGBA read mColor write setColor;
// set active context; `ctx` can be `nil`
procedure gxSetContext (ctx: TGxContext; ascale: Single=1.0);
+procedure gxSetContextNoMatrix (ctx: TGxContext);
// setup 2D OpenGL mode; will be called automatically in `glInit()`
procedure oglSetup2D (winWidth, winHeight: Integer; upsideDown: Boolean=false);
+procedure oglSetup2DState (); // don't modify viewports and matrices
procedure oglDrawCursor ();
procedure oglDrawCursorAt (msX, msY: Integer);
implementation
+uses
+ utils;
+
+
+// ////////////////////////////////////////////////////////////////////////// //
+// returns `false` if the color is transparent
+// returns `false` if the color is transparent
+function setupGLColor (constref clr: TGxRGBA): Boolean;
+begin
+ if (clr.a < 255) then
+ begin
+ 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 := (clr.a <> 0);
+end;
+
+function isScaled (): Boolean;
+var
+ mt: packed array [0..15] of Double;
+begin
+ glGetDoublev(GL_MODELVIEW_MATRIX, @mt[0]);
+ result := (mt[0] <> 1.0) or (mt[1*4+1] <> 1.0);
+end;
+
// ////////////////////////////////////////////////////////////////////////// //
//TODO: OpenGL framebuffers and shaders state
// ////////////////////////////////////////////////////////////////////////// //
// set active context; `ctx` can be `nil`
-procedure gxSetContext (ctx: TGxContext; ascale: Single=1.0);
+procedure gxSetContextInternal (ctx: TGxContext; ascale: Single; domatrix: Boolean);
+var
+ mt: packed array [0..15] of Double;
begin
if (savedGLState.saved) then savedGLState.restore();
begin
ctx.mActive := true;
savedGLState.save();
- oglSetup2D(fuiScrWdt, fuiScrHgt);
- glScalef(ascale, ascale, 1.0);
- ctx.mScaled := (ascale <> 1.0);
- ctx.mScale := ascale;
+ if (domatrix) then
+ begin
+ oglSetup2D(fuiScrWdt, fuiScrHgt);
+ glScalef(ascale, ascale, 1.0);
+ ctx.mScaled := (ascale <> 1.0);
+ ctx.mScale := ascale;
+ end
+ else
+ begin
+ // assume uniform scale
+ glGetDoublev(GL_MODELVIEW_MATRIX, @mt[0]);
+ ctx.mScaled := (mt[0] <> 1.0) or (mt[1*4+1] <> 1.0);
+ ctx.mScale := mt[0];
+ oglSetup2DState();
+ end;
ctx.onActivate();
end;
end;
+procedure gxSetContext (ctx: TGxContext; ascale: Single=1.0); begin gxSetContextInternal(ctx, ascale, true); end;
+procedure gxSetContextNoMatrix (ctx: TGxContext); begin gxSetContextInternal(ctx, 1, false); end;
+
+
// ////////////////////////////////////////////////////////////////////////// //
type
TScissorSave = record
procedure oglCreateTexture ();
procedure oglDestroyTexture ();
+ procedure initDrawText ();
+ procedure doneDrawText ();
+ function drawCharInterim (x, y: Integer; const ch: AnsiChar): Integer; // return width (not including last empty pixel)
+ function drawCharInternal (x, y: Integer; const ch: AnsiChar): Integer; // return width (not including last empty pixel)
function drawTextInternal (x, y: Integer; const s: AnsiString): Integer; // return width (not including last empty pixel)
public
procedure TGxBmpFont.oglCreateTexture ();
begin
- mTexId := createFontTexture(mFontBmp, mFontWdt, (mWidth <= 0));
+ mTexId := createFontTexture(mFontBmp, mFontWdt, mHeight, (mWidth <= 0));
end;
end;
-// return width (not including last empty pixel)
-function TGxBmpFont.drawTextInternal (x, y: Integer; const s: AnsiString): Integer;
-var
- ch: AnsiChar;
- tx, ty: Integer;
+procedure TGxBmpFont.initDrawText ();
begin
- if (Length(s) = 0) then begin result := 0; exit; end;
-
- result := -1;
-
glEnable(GL_ALPHA_TEST);
glAlphaFunc(GL_NOTEQUAL, 0.0);
glEnable(GL_TEXTURE_2D);
glBindTexture(GL_TEXTURE_2D, mTexId);
+end;
- for ch in s do
- begin
- tx := (Integer(ch) mod 16)*8;
- ty := (Integer(ch) div 16)*8;
- glBegin(GL_QUADS);
- glTexCoord2f((tx+0)/128.0, (ty+0)/128.0); glVertex2i(x+0, y+0); // top-left
- glTexCoord2f((tx+8)/128.0, (ty+0)/128.0); glVertex2i(x+8, y+0); // top-right
- glTexCoord2f((tx+8)/128.0, (ty+8)/128.0); glVertex2i(x+8, y+8); // bottom-right
- glTexCoord2f((tx+0)/128.0, (ty+8)/128.0); glVertex2i(x+0, y+8); // bottom-left
- glEnd();
- x += (mFontWdt[Byte(ch)] and $0f)+1;
- result += (mFontWdt[Byte(ch)] and $0f)+1;
- end;
+procedure TGxBmpFont.doneDrawText ();
+begin
glDisable(GL_ALPHA_TEST);
glDisable(GL_TEXTURE_2D);
glBindTexture(GL_TEXTURE_2D, 0);
end;
+function TGxBmpFont.drawCharInterim (x, y: Integer; const ch: AnsiChar): Integer;
+var
+ tx, ty: Integer;
+begin
+ tx := (Integer(ch) mod 16)*8;
+ ty := (Integer(ch) div 16)*16;
+ glBegin(GL_QUADS);
+ glTexCoord2f((tx+0)/128.0, (ty+0)/256.0); glVertex2i(x+0, y+0); // top-left
+ glTexCoord2f((tx+8)/128.0, (ty+0)/256.0); glVertex2i(x+8, y+0); // top-right
+ glTexCoord2f((tx+8)/128.0, (ty+mHeight)/256.0); glVertex2i(x+8, y+mHeight); // bottom-right
+ glTexCoord2f((tx+0)/128.0, (ty+mHeight)/256.0); glVertex2i(x+0, y+mHeight); // bottom-left
+ glEnd();
+ result := (mFontWdt[Byte(ch)] and $0f);
+end;
+
+
+function TGxBmpFont.drawCharInternal (x, y: Integer; const ch: AnsiChar): Integer;
+begin
+ initDrawText();
+ result := drawCharInterim(x, y, ch);
+ doneDrawText();
+end;
+
+
+function TGxBmpFont.drawTextInternal (x, y: Integer; const s: AnsiString): Integer;
+var
+ ch: AnsiChar;
+ wdt: Integer;
+begin
+ if (Length(s) = 0) then begin result := 0; exit; end;
+ result := -1;
+ initDrawText();
+ for ch in s do
+ begin
+ wdt := drawCharInterim(x, y, ch)+1;
+ x += wdt;
+ result += wdt;
+ end;
+ doneDrawText();
+end;
+
+
// ////////////////////////////////////////////////////////////////////////// //
var
fontList: array of TGxBmpFont = nil;
procedure createFonts ();
begin
deleteFonts();
- SetLength(fontList, 4);
+ SetLength(fontList, 10);
fontList[0] := TGxBmpFont.Create('dos', 8, 8, @kgiFont8[0], @kgiFont8PropWidth[0]);
fontList[1] := TGxBmpFont.Create('dos-prop', 0, 8, @kgiFont8[0], @kgiFont8PropWidth[0]);
fontList[2] := TGxBmpFont.Create('msx', 6, 8, @kgiFont6[0], @kgiFont6PropWidth[0]);
fontList[3] := TGxBmpFont.Create('msx-prop', 0, 8, @kgiFont6[0], @kgiFont6PropWidth[0]);
+ fontList[4] := TGxBmpFont.Create('win8', 8, 8, @kgiWFont8[0], @kgiWFont8Wdt[0]);
+ fontList[5] := TGxBmpFont.Create('win8-prop', 0, 8, @kgiWFont8[0], @kgiWFont8Wdt[0]);
+ fontList[6] := TGxBmpFont.Create('win14', 8, 14, @kgiFont14[0], @kgiFont14Wdt[0]);
+ fontList[7] := TGxBmpFont.Create('win14-prop', 0, 14, @kgiFont14[0], @kgiFont14Wdt[0]);
+ fontList[8] := TGxBmpFont.Create('win16', 8, 16, @kgiFont16[0], @kgiFont16Wdt[0]);
+ fontList[9] := TGxBmpFont.Create('win16-prop', 0, 16, @kgiFont16[0], @kgiFont16Wdt[0]);
end;
// ////////////////////////////////////////////////////////////////////////// //
-procedure oglSetup2D (winWidth, winHeight: Integer; upsideDown: Boolean=false);
+procedure oglSetup2DState ();
begin
- glViewport(0, 0, winWidth, winHeight);
-
glDisable(GL_BLEND);
glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
glDisable(GL_LINE_SMOOTH);
glDisable(GL_CULL_FACE);
glDisable(GL_ALPHA_TEST);
+ glClearColor(0, 0, 0, 0);
+ glColor4f(1, 1, 1, 1);
+end;
+
+
+procedure oglSetup2D (winWidth, winHeight: Integer; upsideDown: Boolean=false);
+begin
+ glViewport(0, 0, winWidth, winHeight);
+
+ oglSetup2DState();
+
glMatrixMode(GL_TEXTURE);
glLoadIdentity();
glMatrixMode(GL_MODELVIEW);
glLoadIdentity();
-
- glClearColor(0, 0, 0, 0);
- glColor4f(1, 1, 1, 1);
end;
procedure oglDrawCursor (); begin oglDrawCursorAt(fuiMouseX, fuiMouseY); end;
-// ////////////////////////////////////////////////////////////////////////// //
-// returns `false` if the color is transparent
-// returns `false` if the color is transparent
-function setupGLColor (constref clr: TGxRGBA): Boolean;
-begin
- if (clr.a < 255) then
- begin
- 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 := (clr.a <> 0);
-end;
-
-function mScaled (): Boolean;
-var
- mt: packed array [0..15] of Double;
-begin
- glGetDoublev(GL_MODELVIEW_MATRIX, @mt[0]);
- result := (mt[0] <> 1.0) or (mt[1*4+1] <> 1.0);
-end;
-
-
// ////////////////////////////////////////////////////////////////////////// //
constructor TGxContext.Create ();
begin
glVertex2f(x+len+0.375, y+0.375);
glEnd();
end
- else
+ else if (mScale > 1.0) then
begin
glBegin(GL_QUADS);
glVertex2i(x, y);
glVertex2i(x+len, y+1);
glVertex2i(x, y+1);
glEnd();
+ end
+ else
+ begin
+ glPointSize(1);
+ glBegin(GL_POINTS);
+ while (len > 0) do begin glVertex2i(x, y); Inc(x); Dec(len); end;
+ glEnd();
end;
end;
glVertex2f(x+0.375, y+len+0.375);
glEnd();
end
- else
+ else if (mScale > 1.0) then
begin
glBegin(GL_QUADS);
glVertex2i(x, y);
glVertex2i(x+1, y+len);
glVertex2i(x+1, y);
glEnd();
- end;
-end;
-
-
-procedure TGxContext.rect (x, y, w, h: Integer);
- procedure hlinex (x, y, len: Integer);
+ end
+ else
begin
- if (len < 1) then exit;
- glBegin(GL_QUADS);
- glVertex2i(x, y);
- glVertex2i(x+len, y);
- glVertex2i(x+len, y+1);
- glVertex2i(x, y+1);
+ glPointSize(1);
+ glBegin(GL_POINTS);
+ while (len > 0) do begin glVertex2i(x, y); Inc(y); Dec(len); end;
glEnd();
end;
+end;
- procedure vlinex (x, y, len: Integer);
- begin
- if (len < 1) then exit;
- glBegin(GL_QUADS);
- glVertex2i(x, y);
- glVertex2i(x, y+len);
- glVertex2i(x+1, y+len);
- glVertex2i(x+1, y);
- glEnd();
- end;
+procedure TGxContext.rect (x, y, w, h: Integer);
begin
if (not mActive) or (mClipRect.w < 1) or (mClipRect.h < 1) or (mColor.a = 0) then exit;
if (w < 0) or (h < 0) then exit;
end
else
begin
- hlinex(x, y, w);
- hlinex(x, y+h-1, w);
- vlinex(x, y+1, h-2);
- vlinex(x+w-1, y+1, h-2);
+ hline(x, y, w);
+ hline(x, y+h-1, w);
+ vline(x, y+1, h-2);
+ vline(x+w-1, y+1, h-2);
end;
end;
end;
@@ -917,7 +977,7 @@ function TGxContext.drawChar (x, y: Integer; const ch: AnsiChar): Integer; // re
begin
result := mFont.charWidth(ch);
if (not mActive) or (mClipRect.w < 1) or (mClipRect.h < 1) or (mColor.a = 0) then exit;
- TGxBmpFont(mFont).drawTextInternal(x, y, ch);
+ TGxBmpFont(mFont).drawCharInternal(x, y, ch);
end;
function TGxContext.drawText (x, y: Integer; const s: AnsiString): Integer; // returns text width
end;
-function TGxContext.iconMarkWidth (ic: TMarkIcon): Integer; begin result := 11; end;
-function TGxContext.iconMarkHeight (ic: TMarkIcon): Integer; begin result := 8; end;
+function TGxContext.iconMarkWidth (ic: TMarkIcon): Integer;
+begin
+ {$IFDEF FUI_TEXT_ICONS}
+ case ic of
+ TMarkIcon.Checkbox: result := textWidth('[x]');
+ TMarkIcon.Radiobox: result := textWidth('(*)');
+ else result := textWidth('[x]');
+ end;
+ {$ELSE}
+ result := 11;
+ {$ENDIF}
+end;
+
+function TGxContext.iconMarkHeight (ic: TMarkIcon): Integer;
+begin
+ {$IFDEF FUI_TEXT_ICONS}
+ case ic of
+ TMarkIcon.Checkbox: result := textHeight('[x]');
+ TMarkIcon.Radiobox: result := textHeight('(*)');
+ else result := textHeight('[x]');
+ end;
+ {$ELSE}
+ result := 8;
+ {$ENDIF}
+end;
procedure TGxContext.drawIconMark (ic: TMarkIcon; x, y: Integer; marked: Boolean);
var
+ {$IFDEF FUI_TEXT_ICONS}
+ xstr: AnsiString;
+ {$ELSE}
f: Integer;
+ {$ENDIF}
begin
if (not mActive) or (mClipRect.w < 1) or (mClipRect.h < 1) or (mColor.a = 0) then exit;
+ {$IFDEF FUI_TEXT_ICONS}
+ case ic of
+ TMarkIcon.Checkbox: xstr := '[x]';
+ TMarkIcon.Radiobox: xstr := '(*)';
+ else exit;
+ end;
+ if (marked) then
+ begin
+ drawText(x, y, xstr);
+ end
+ else
+ begin
+ drawChar(x, y, xstr[1]);
+ drawChar(x+textWidth(xstr)-charWidth(xstr[3]), y, xstr[3]);
+ end;
+ {$ELSE}
if (ic = TMarkIcon.Checkbox) then
begin
vline(x, y, 7);
hline(x+4, y+5, 3);
end;
end;
+ {$ENDIF}
end;
-function TGxContext.iconWinWidth (ic: TWinIcon): Integer; begin result := 9; end;
-function TGxContext.iconWinHeight (ic: TWinIcon): Integer; begin result := 8; end;
+function TGxContext.iconWinWidth (ic: TWinIcon): Integer;
+begin
+ {$IFDEF FUI_TEXT_ICONS}
+ case ic of
+ TWinIcon.Close: result := nmax(textWidth('[x]'), textWidth('[#]'));
+ else result := nmax(textWidth('[x]'), textWidth('[#]'));
+ end;
+ {$ELSE}
+ result := 9;
+ {$ENDIF}
+end;
+
+function TGxContext.iconWinHeight (ic: TWinIcon): Integer;
+begin
+ {$IFDEF FUI_TEXT_ICONS}
+ case ic of
+ TWinIcon.Close: result := nmax(textHeight('[x]'), textHeight('[#]'));
+ else result := nmax(textHeight('[x]'), textHeight('[#]'));
+ end;
+ {$ELSE}
+ result := 8;
+ {$ENDIF}
+end;
procedure TGxContext.drawIconWin (ic: TWinIcon; x, y: Integer; pressed: Boolean);
var
+ {$IFDEF FUI_TEXT_ICONS}
+ xstr: AnsiString;
+ wdt: Integer;
+ {$ELSE}
f: Integer;
+ {$ENDIF}
begin
if (not mActive) or (mClipRect.w < 1) or (mClipRect.h < 1) or (mColor.a = 0) then exit;
+ {$IFDEF FUI_TEXT_ICONS}
+ case ic of
+ TWinIcon.Close: if (pressed) then xstr := '[#]' else xstr := '[x]';
+ else exit;
+ end;
+ wdt := nmax(textWidth('[x]'), textWidth('[#]'));
+ drawChar(x, y, xstr[1]);
+ drawChar(x+wdt-charWidth(xstr[3]), y, xstr[3]);
+ drawChar(x+((wdt-charWidth(xstr[2])) div 2), y, xstr[2]);
+ {$ELSE}
if pressed then rect(x, y, 9, 8);
for f := 1 to 5 do
begin
vline(x+1+f, y+f, 1);
vline(x+1+6-f, y+f, 1);
end;
+ {$ENDIF}
+end;
+
+
+procedure TGxContext.glSetScale (ascale: Single);
+begin
+ if (ascale < 0.01) then ascale := 0.01;
+ glLoadIdentity();
+ glScalef(ascale, ascale, 1.0);
+ mScale := ascale;
+ mScaled := (ascale <> 1.0);
+end;
+
+procedure TGxContext.glSetTrans (ax, ay: Single);
+begin
+ glLoadIdentity();
+ glScalef(mScale, mScale, 1.0);
+ glTranslatef(ax, ay, 0);
+end;
+
+
+procedure TGxContext.glSetScaleTrans (ascale, ax, ay: Single);
+begin
+ glSetScale(ascale);
+ glTranslatef(ax, ay, 0);
end;