src/engine/e_graphics.pas

   1 (* Copyright (C)  Doom 2D: Forever Developers
   2  *
   3  * This program is free software: you can redistribute it and/or modify
   4  * it under the terms of the GNU General Public License as published by
   5  * the Free Software Foundation, either version 3 of the License, or
   6  * (at your option) any later version.
   7  *
   8  * This program is distributed in the hope that it will be useful,
   9  * but WITHOUT ANY WARRANTY; without even the implied warranty of
  10  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  11  * GNU General Public License for more details.
  12  *
  13  * You should have received a copy of the GNU General Public License
  14  * along with this program.  If not, see <http://www.gnu.org/licenses/>.
  15  *)
  16 {$INCLUDE ../shared/a_modes.inc}
  17 unit e_graphics;
  18
  19 interface
  20
  21 uses
  22 {$IFDEF USE_NANOGL}
  23   nanoGL,
  24 {$ELSE}
  25   GL, GLExt,
  26 {$ENDIF}
  27   SysUtils, Classes, Math, e_log, e_texture, SDL2, MAPDEF, ImagingTypes, Imaging, ImagingUtility;
  28
  29 type
  30   TMirrorType=(None, Horizontal, Vertical);
  31   TBlending=(None, Blend, Filter, Invert);
  32
  33   TPoint2i = record
  34     X, Y: Integer;
  35   end;
  36
  37   TPoint2f = record
  38     X, Y: Double;
  39   end;
  40
  41   TRect = record
  42     Left, Top, Right, Bottom: Integer;
  43   end;
  44
  45   TRectWH = record
  46    X, Y: Integer;
  47    Width, Height: Word;
  48   end;
  49
  50   TRGB = packed record
  51    R, G, B: Byte;
  52   end;
  53
  54   PDFPoint = ^TDFPoint;
  55   PPoint2f = ^TPoint2f;
  56   PRect = ^TRect;
  57   PRectWH = ^TRectWH;
  58
  59
  60 //------------------------------------------------------------------
  61 // ïðîòîòèïû ôóíêöèé
  62 //------------------------------------------------------------------
  63 procedure e_InitGL();
  64 procedure e_SetViewPort(X, Y, Width, Height: Word);
  65 procedure e_ResizeWindow(Width, Height: Integer);
  66
  67 procedure e_Draw(ID: DWORD; X, Y: Integer; Alpha: Byte; AlphaChannel: Boolean;
  68                  Blending: Boolean; Mirror: TMirrorType = TMirrorType.None);
  69 procedure e_DrawAdv(ID: DWORD; X, Y: Integer; Alpha: Byte; AlphaChannel: Boolean;
  70                     Blending: Boolean; Angle: Single; RC: PDFPoint; Mirror: TMirrorType = TMirrorType.None);
  71 procedure e_DrawSize(ID: DWORD; X, Y: Integer; Alpha: Byte; AlphaChannel: Boolean;
  72                      Blending: Boolean; Width, Height: Word; Mirror: TMirrorType = TMirrorType.None);
  73 procedure e_DrawSizeMirror(ID: DWORD; X, Y: Integer; Alpha: Byte; AlphaChannel: Boolean;
  74                            Blending: Boolean; Width, Height: Word; Mirror: TMirrorType = TMirrorType.None);
  75
  76 procedure e_DrawFill(ID: DWORD; X, Y: Integer; XCount, YCount: Word; Alpha: Integer;
  77                      AlphaChannel: Boolean; Blending: Boolean; ambientBlendMode: Boolean=false);
  78
  79 procedure e_DrawFillX (id: DWORD; x, y, wdt, hgt: Integer; alpha: Integer; alphachannel: Boolean;
  80                        blending: Boolean; scale: Single; ambientBlendMode: Boolean=false);
  81
  82 procedure e_AmbientQuad (x, y, w, h: Integer; r, g, b, a: Byte);
  83
  84 procedure e_DrawPoint(Size: Byte; X, Y: Integer; Red, Green, Blue: Byte);
  85 procedure e_DrawLine(Width: Byte; X1, Y1, X2, Y2: Integer; Red, Green, Blue: Byte; Alpha: Byte = 0);
  86 procedure e_DrawQuad(X1, Y1, X2, Y2: Integer; Red, Green, Blue: Byte; Alpha: Byte = 0);
  87 procedure e_DrawFillQuad(X1, Y1, X2, Y2: Integer; Red, Green, Blue, Alpha: Byte;
  88                          Blending: TBlending = TBlending.None);
  89 procedure e_DarkenQuad (x0, y0, x1, y1: Integer; a: Integer);
  90 procedure e_DarkenQuadWH (x, y, w, h: Integer; a: Integer);
  91
  92 function e_CreateTextureImg (var img: TImageData; var ID: DWORD): Boolean;
  93 function e_CreateTexture(FileName: string; var ID: DWORD): Boolean;
  94 function e_CreateTextureEx(FileName: string; var ID: DWORD; fX, fY, fWidth, fHeight: Word): Boolean;
  95 function e_CreateTextureMem(pData: Pointer; dataSize: LongInt; var ID: DWORD): Boolean;
  96 function e_CreateTextureMemEx(pData: Pointer; dataSize: LongInt; var ID: DWORD; fX, fY, fWidth, fHeight: Word): Boolean;
  97 procedure e_GetTextureSize(ID: DWORD; Width, Height: PWord);
  98 function e_GetTextureSize2(ID: DWORD): TRectWH;
  99 procedure e_DeleteTexture(ID: DWORD);
 100 procedure e_RemoveAllTextures();
 101
 102 // CharFont
 103 function e_CharFont_Create(sp: ShortInt=0): DWORD;
 104 procedure e_CharFont_AddChar(FontID: DWORD; Texture: Integer; c: Char; w: Byte);
 105 procedure e_CharFont_Print(FontID: DWORD; X, Y: Integer; Text: string);
 106 procedure e_CharFont_PrintEx(FontID: DWORD; X, Y: Integer; Text: string;
 107                              Color: TRGB; Scale: Single = 1.0);
 108 procedure e_CharFont_PrintFmt(FontID: DWORD; X, Y: Integer; Text: string);
 109 procedure e_CharFont_GetSize(FontID: DWORD; Text: string; var w, h: Word);
 110 procedure e_CharFont_GetSizeFmt(FontID: DWORD; Text: string; var w, h: Word);
 111 function e_CharFont_GetMaxWidth(FontID: DWORD): Word;
 112 function e_CharFont_GetMaxHeight(FontID: DWORD): Word;
 113 procedure e_CharFont_Remove(FontID: DWORD);
 114 procedure e_CharFont_RemoveAll();
 115
 116 // TextureFont
 117 procedure e_TextureFontBuild(Tex: DWORD; var FontID: DWORD; XCount, YCount: Word;
 118                              Space: ShortInt=0);
 119 procedure e_TextureFontKill(FontID: DWORD);
 120 procedure e_TextureFontPrint(X, Y: GLint; Text: string; FontID: DWORD);
 121 procedure e_TextureFontPrintEx(X, Y: GLint; Text: string; FontID: DWORD; Red, Green,
 122                                Blue: Byte; Scale: Single; Shadow: Boolean = False);
 123 procedure e_TextureFontPrintFmt(X, Y: GLint; Text: string; FontID: DWORD; Shadow: Boolean = False);
 124 procedure e_TextureFontGetSize(ID: DWORD; out CharWidth, CharHeight: Byte);
 125 procedure e_RemoveAllTextureFont();
 126
 127 function e_TextureFontCharWidth (ch: Char; FontID: DWORD): Integer;
 128 procedure e_TextureFontPrintCharEx (X, Y: Integer; Ch: Char; FontID: DWORD; Shadow: Boolean = False);
 129
 130 procedure e_ReleaseEngine();
 131 procedure e_BeginRender();
 132 procedure e_Clear(Mask: TGLbitfield; Red, Green, Blue: Single); overload;
 133 procedure e_Clear(); overload;
 134 procedure e_EndRender();
 135
 136 function e_GetGamma(win: PSDL_Window): Byte;
 137 procedure e_SetGamma(win: PSDL_Window;Gamma: Byte);
 138
 139 procedure e_MakeScreenshot(st: TStream; Width, Height: Word);
 140
 141 function _RGB(Red, Green, Blue: Byte): TRGB;
 142 function _Point(X, Y: Integer): TPoint2i;
 143 function _Rect(X, Y: Integer; Width, Height: Word): TRectWH;
 144 function _TRect(L, T, R, B: LongInt): TRect;
 145
 146 //function e_getTextGLId (ID: DWORD): GLuint;
 147
 148 var
 149   e_Colors: TRGB;
 150   e_NoGraphics: Boolean = False;
 151   e_FastScreenshots: Boolean = true; // it's REALLY SLOW with `false`
 152   g_dbg_scale: Single = 1.0;
 153
 154
 155 implementation
 156
 157 uses
 158   paszlib, crc, utils;
 159
 160
 161 type
 162   TTexture = record
 163    tx:     GLTexture;
 164   end;
 165
 166   TTextureFont = record
 167    Texture:     DWORD;
 168    TextureID:   DWORD;
 169    Base:        Uint32;
 170    CharWidth:   Byte;
 171    CharHeight:  Byte;
 172    XC, YC, SPC: Word;
 173   end;
 174
 175   TCharFont = record
 176    Chars: array[0..255] of
 177     record
 178      TextureID: Integer;
 179      Width: Byte;
 180     end;
 181    Space: ShortInt;
 182    Height: ShortInt;
 183    alive: Boolean;
 184   end;
 185
 186   TSavedTexture = record
 187     TexID:  DWORD;
 188     OldID:  DWORD;
 189     Pixels: Pointer;
 190   end;
 191
 192 var
 193   e_Textures: array of TTexture = nil;
 194   e_TextureFonts: array of TTextureFont = nil;
 195   e_CharFonts: array of TCharFont;
 196   //e_SavedTextures: array of TSavedTexture;
 197
 198 //function e_getTextGLId (ID: DWORD): GLuint; begin result := e_Textures[ID].tx.id; end;
 199
 200 //------------------------------------------------------------------
 201 // Èíèöèàëèçèðóåò OpenGL
 202 //------------------------------------------------------------------
 203 procedure e_InitGL();
 204 begin
 205   if e_NoGraphics then
 206   begin
 207     e_DummyTextures := True;
 208     Exit;
 209   end;
 210   e_Colors.R := 255;
 211   e_Colors.G := 255;
 212   e_Colors.B := 255;
 213   glDisable(GL_DEPTH_TEST);
 214   glEnable(GL_SCISSOR_TEST);
 215   glClearColor(0, 0, 0, 0);
 216 end;
 217
 218 procedure e_SetViewPort(X, Y, Width, Height: Word);
 219 var
 220   mat: Array [0..15] of GLDouble;
 221
 222 begin
 223   if e_NoGraphics then Exit;
 224   glLoadIdentity();
 225   glScissor(X, Y, Width, Height);
 226   glViewport(X, Y, Width, Height);
 227   //gluOrtho2D(0, Width, Height, 0);
 228
 229   glMatrixMode(GL_PROJECTION);
 230
 231   mat[ 0] := 2.0 / Width;
 232   mat[ 1] := 0.0;
 233   mat[ 2] := 0.0;
 234   mat[ 3] := 0.0;
 235
 236   mat[ 4] := 0.0;
 237   mat[ 5] := -2.0 / Height;
 238   mat[ 6] := 0.0;
 239   mat[ 7] := 0.0;
 240
 241   mat[ 8] := 0.0;
 242   mat[ 9] := 0.0;
 243   mat[10] := 1.0;
 244   mat[11] := 0.0;
 245
 246   mat[12] := -1.0;
 247   mat[13] := 1.0;
 248   mat[14] := 0.0;
 249   mat[15] := 1.0;
 250
 251   glLoadMatrixd(@mat[0]);
 252
 253   glMatrixMode(GL_MODELVIEW);
 254   glLoadIdentity();
 255 end;
 256
 257 //------------------------------------------------------------------
 258 // Èùåò ñâîáîäíûé ýëåìåíò â ìàññèâå òåêñòóð
 259 //------------------------------------------------------------------
 260 function FindTexture(): DWORD;
 261 var
 262   i: integer;
 263 begin
 264  if e_Textures <> nil then
 265  for i := 0 to High(e_Textures) do
 266   if e_Textures[i].tx.Width = 0 then
 267   begin
 268    Result := i;
 269    Exit;
 270   end;
 271
 272  if e_Textures = nil then
 273  begin
 274   SetLength(e_Textures, 32);
 275   Result := 0;
 276  end
 277   else
 278  begin
 279   Result := High(e_Textures) + 1;
 280   SetLength(e_Textures, Length(e_Textures) + 32);
 281  end;
 282 end;
 283
 284 //------------------------------------------------------------------
 285 // Ñîçäàåò òåêñòóðó
 286 //------------------------------------------------------------------
 287 function e_CreateTexture(FileName: String; var ID: DWORD): Boolean;
 288 var
 289   find_id: DWORD;
 290   fmt:     Word;
 291 begin
 292  Result := False;
 293
 294  e_WriteLog('Loading texture from '+FileName, TMsgType.Notify);
 295
 296  find_id := FindTexture();
 297
 298  if not LoadTexture(FileName, e_Textures[find_id].tx, e_Textures[find_id].tx.Width,
 299                     e_Textures[find_id].tx.Height, @fmt) then Exit;
 300
 301  ID := find_id;
 302
 303  Result := True;
 304 end;
 305
 306 function e_CreateTextureEx(FileName: String; var ID: DWORD; fX, fY, fWidth, fHeight: Word): Boolean;
 307 var
 308   find_id: DWORD;
 309   fmt:     Word;
 310 begin
 311  Result := False;
 312
 313  find_id := FindTexture();
 314
 315  if not LoadTextureEx(FileName, e_Textures[find_id].tx, fX, fY, fWidth, fHeight, @fmt) then exit;
 316
 317  ID := find_id;
 318
 319  Result := True;
 320 end;
 321
 322 function e_CreateTextureMem(pData: Pointer; dataSize: LongInt; var ID: DWORD): Boolean;
 323 var
 324   find_id: DWORD;
 325   fmt:     Word;
 326 begin
 327  Result := False;
 328
 329  find_id := FindTexture;
 330
 331  if not LoadTextureMem(pData, dataSize, e_Textures[find_id].tx, e_Textures[find_id].tx.Width, e_Textures[find_id].tx.Height, @fmt) then exit;
 332
 333  id := find_id;
 334
 335  Result := True;
 336 end;
 337
 338 function e_CreateTextureMemEx(pData: Pointer; dataSize: LongInt; var ID: DWORD; fX, fY, fWidth, fHeight: Word): Boolean;
 339 var
 340   find_id: DWORD;
 341   fmt:     Word;
 342 begin
 343  Result := False;
 344
 345  find_id := FindTexture();
 346
 347  if not LoadTextureMemEx(pData, dataSize, e_Textures[find_id].tx, fX, fY, fWidth, fHeight, @fmt) then exit;
 348
 349  ID := find_id;
 350
 351  Result := True;
 352 end;
 353
 354 function e_CreateTextureImg (var img: TImageData; var ID: DWORD): Boolean;
 355 var
 356   find_id: DWORD;
 357   fmt, tw, th: Word;
 358 begin
 359   result := false;
 360   find_id := FindTexture();
 361   if not LoadTextureImg(img, e_Textures[find_id].tx, tw, th, @fmt) then exit;
 362   ID := find_id;
 363   result := True;
 364 end;
 365
 366 procedure e_GetTextureSize(ID: DWORD; Width, Height: PWord);
 367 begin
 368  if Width <> nil then Width^ := e_Textures[ID].tx.Width;
 369  if Height <> nil then Height^ := e_Textures[ID].tx.Height;
 370 end;
 371
 372 function e_GetTextureSize2(ID: DWORD): TRectWH;
 373 var
 374   data: PChar;
 375   x, y: Integer;
 376   w, h: Word;
 377   a: Boolean;
 378   lastline: Integer;
 379 begin
 380  w := e_Textures[ID].tx.Width;
 381  h := e_Textures[ID].tx.Height;
 382
 383  Result.Y := 0;
 384  Result.X := 0;
 385  Result.Width := w;
 386  Result.Height := h;
 387
 388 {$IFNDEF USE_NANOGL} // FIXIT: nanoGL doesn't support glGetTexImage
 389  if e_NoGraphics then Exit;
 390
 391  data := GetMemory(w*h*4);
 392  glEnable(GL_TEXTURE_2D);
 393  glBindTexture(GL_TEXTURE_2D, e_Textures[ID].tx.id);
 394  glGetTexImage(GL_TEXTURE_2D, 0, GL_RGBA, GL_UNSIGNED_BYTE, data);
 395
 396  for y := h-1 downto 0 do
 397  begin
 398   lastline := y;
 399   a := True;
 400
 401   for x := 1 to w-4 do
 402   begin
 403    a := Byte((data+y*w*4+x*4+3)^) <> 0;
 404    if a then Break;
 405   end;
 406
 407   if a then
 408   begin
 409    Result.Y := h-lastline;
 410    Break;
 411   end;
 412  end;
 413
 414  for y := 0 to h-1 do
 415  begin
 416   lastline := y;
 417   a := True;
 418
 419   for x := 1 to w-4 do
 420   begin
 421    a := Byte((data+y*w*4+x*4+3)^) <> 0;
 422    if a then Break;
 423   end;
 424
 425   if a then
 426   begin
 427    Result.Height := h-lastline-Result.Y;
 428    Break;
 429   end;
 430  end;
 431
 432  for x := 0 to w-1 do
 433  begin
 434   lastline := x;
 435   a := True;
 436
 437   for y := 1 to h-4 do
 438   begin
 439    a := Byte((data+y*w*4+x*4+3)^) <> 0;
 440    if a then Break;
 441   end;
 442
 443   if a then
 444   begin
 445    Result.X := lastline+1;
 446    Break;
 447   end;
 448  end;
 449
 450  for x := w-1 downto 0 do
 451  begin
 452   lastline := x;
 453   a := True;
 454
 455   for y := 1 to h-4 do
 456   begin
 457    a := Byte((data+y*w*4+x*4+3)^) <> 0;
 458    if a then Break;
 459   end;
 460
 461   if a then
 462   begin
 463    Result.Width := lastline-Result.X+1;
 464    Break;
 465   end;
 466  end;
 467
 468  FreeMemory(data);
 469 {$ENDIF}
 470 end;
 471
 472 procedure e_ResizeWindow(Width, Height: Integer);
 473 begin
 474   if Height = 0 then
 475     Height := 1;
 476   e_SetViewPort(0, 0, Width, Height);
 477 end;
 478
 479 procedure drawTxQuad (x0, y0, w, h, tw, th: Integer; u, v: single; Mirror: TMirrorType);
 480 var
 481   x1, y1, tmp: Integer;
 482 begin
 483   if (w < 1) or (h < 1) then exit;
 484   x1 := x0+w;
 485   y1 := y0+h;
 486        if Mirror = TMirrorType.Horizontal then begin tmp := x1; x1 := x0; x0 := tmp; end
 487   else if Mirror = TMirrorType.Vertical then begin tmp := y1; y1 := y0; y0 := tmp; end;
 488   //HACK: make texture one pixel shorter, so it won't wrap
 489   if (g_dbg_scale <> 1.0) then
 490   begin
 491     u := u*tw/(tw+1);
 492     v := v*th/(th+1);
 493   end;
 494   glTexCoord2f(0, v); glVertex2i(x0, y0);
 495   glTexCoord2f(0, 0); glVertex2i(x0, y1);
 496   glTexCoord2f(u, 0); glVertex2i(x1, y1);
 497   glTexCoord2f(u, v); glVertex2i(x1, y0);
 498 end;
 499
 500 procedure e_Draw(ID: DWORD; X, Y: Integer; Alpha: Byte; AlphaChannel: Boolean;
 501                  Blending: Boolean; Mirror: TMirrorType = TMirrorType.None);
 502 begin
 503   if e_NoGraphics then Exit;
 504   glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255);
 505
 506   if (Alpha > 0) or (AlphaChannel) or (Blending) then
 507     glEnable(GL_BLEND)
 508   else
 509     glDisable(GL_BLEND);
 510
 511   if (AlphaChannel) or (Alpha > 0) then
 512     glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
 513
 514   if Alpha > 0 then
 515     glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255-Alpha);
 516
 517   if Blending then
 518     glBlendFunc(GL_SRC_ALPHA, GL_ONE);
 519
 520   glEnable(GL_TEXTURE_2D);
 521   glBindTexture(GL_TEXTURE_2D, e_Textures[ID].tx.id);
 522   glBegin(GL_QUADS);
 523
 524   drawTxQuad(X, Y, e_Textures[id].tx.width, e_Textures[id].tx.height, e_Textures[id].tx.width, e_Textures[id].tx.height, e_Textures[ID].tx.u, e_Textures[ID].tx.v, Mirror);
 525
 526   //u := e_Textures[ID].tx.u;
 527   //v := e_Textures[ID].tx.v;
 528
 529   {
 530   if Mirror = M_NONE then
 531     begin
 532       glTexCoord2f(u,  0); glVertex2i(X + e_Textures[id].tx.Width, Y);
 533       glTexCoord2f(0,  0); glVertex2i(X,                        Y);
 534       glTexCoord2f(0, -v); glVertex2i(X,                        Y + e_Textures[id].tx.Height);
 535       glTexCoord2f(u, -v); glVertex2i(X + e_Textures[id].tx.Width, Y + e_Textures[id].tx.Height);
 536     end
 537   else
 538     if Mirror = M_HORIZONTAL then
 539       begin
 540         glTexCoord2f(u,  0); glVertex2i(X,                        Y);
 541         glTexCoord2f(0,  0); glVertex2i(X + e_Textures[id].tx.Width, Y);
 542         glTexCoord2f(0, -v); glVertex2i(X + e_Textures[id].tx.Width, Y + e_Textures[id].tx.Height);
 543         glTexCoord2f(u, -v); glVertex2i(X,                        Y + e_Textures[id].tx.Height);
 544       end
 545     else
 546       if Mirror = M_VERTICAL then
 547       begin
 548         glTexCoord2f(u, -v); glVertex2i(X + e_Textures[id].tx.Width, Y);
 549         glTexCoord2f(0, -v); glVertex2i(X,                        Y);
 550         glTexCoord2f(0,  0); glVertex2i(X,                        Y + e_Textures[id].tx.Height);
 551         glTexCoord2f(u,  0); glVertex2i(X + e_Textures[id].tx.Width, Y + e_Textures[id].tx.Height);
 552       end;
 553   }
 554
 555   glEnd();
 556
 557   glDisable(GL_BLEND);
 558 end;
 559
 560 procedure e_DrawSize(ID: DWORD; X, Y: Integer; Alpha: Byte; AlphaChannel: Boolean;
 561                      Blending: Boolean; Width, Height: Word; Mirror: TMirrorType = TMirrorType.None);
 562 var
 563   u, v: Single;
 564 begin
 565   if e_NoGraphics then Exit;
 566   glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255);
 567
 568   if (Alpha > 0) or (AlphaChannel) or (Blending) then
 569     glEnable(GL_BLEND)
 570   else
 571     glDisable(GL_BLEND);
 572
 573   if (AlphaChannel) or (Alpha > 0) then
 574     glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
 575
 576   if Alpha > 0 then
 577     glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255-Alpha);
 578
 579   if Blending then
 580     glBlendFunc(GL_SRC_ALPHA, GL_ONE);
 581
 582   glEnable(GL_TEXTURE_2D);
 583   glBindTexture(GL_TEXTURE_2D, e_Textures[ID].tx.id);
 584
 585   u := e_Textures[ID].tx.u;
 586   v := e_Textures[ID].tx.v;
 587
 588   glBegin(GL_QUADS);
 589     glTexCoord2f(0, v); glVertex2i(X,         Y);
 590     glTexCoord2f(u, v); glVertex2i(X + Width, Y);
 591     glTexCoord2f(u, 0); glVertex2i(X + Width, Y + Height);
 592     glTexCoord2f(0, 0); glVertex2i(X,         Y + Height);
 593   glEnd();
 594
 595   glDisable(GL_BLEND);
 596 end;
 597
 598 procedure e_DrawSizeMirror(ID: DWORD; X, Y: Integer; Alpha: Byte; AlphaChannel: Boolean;
 599                            Blending: Boolean; Width, Height: Word; Mirror: TMirrorType = TMirrorType.None);
 600 begin
 601   if e_NoGraphics then Exit;
 602   glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255);
 603
 604   if (Alpha > 0) or (AlphaChannel) or (Blending) then
 605     glEnable(GL_BLEND)
 606   else
 607     glDisable(GL_BLEND);
 608
 609   if (AlphaChannel) or (Alpha > 0) then
 610     glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
 611
 612   if Alpha > 0 then
 613     glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255-Alpha);
 614
 615   if Blending then
 616     glBlendFunc(GL_SRC_ALPHA, GL_ONE);
 617
 618   glEnable(GL_TEXTURE_2D);
 619   glBindTexture(GL_TEXTURE_2D, e_Textures[ID].tx.id);
 620   glBegin(GL_QUADS);
 621   drawTxQuad(X, Y, Width, Height, e_Textures[id].tx.width, e_Textures[id].tx.height, e_Textures[ID].tx.u, e_Textures[ID].tx.v, Mirror);
 622   glEnd();
 623
 624   glDisable(GL_BLEND);
 625 end;
 626
 627 procedure e_DrawFill(ID: DWORD; X, Y: Integer; XCount, YCount: Word; Alpha: Integer;
 628                      AlphaChannel: Boolean; Blending: Boolean; ambientBlendMode: Boolean=false);
 629 var
 630   X2, Y2, dx, w, h: Integer;
 631   u, v: Single;
 632 begin
 633   if e_NoGraphics then Exit;
 634   glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255);
 635   ambientBlendMode := false;
 636
 637   if (Alpha > 0) or AlphaChannel or Blending then
 638   begin
 639     glEnable(GL_BLEND);
 640   end
 641   else
 642   begin
 643     if not ambientBlendMode then glDisable(GL_BLEND);
 644   end;
 645   if AlphaChannel or (Alpha > 0) then glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
 646   if (Alpha > 0) then glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255-Alpha);
 647   if Blending then glBlendFunc(GL_SRC_ALPHA, GL_ONE);
 648
 649   if (XCount = 0) then XCount := 1;
 650   if (YCount = 0) then YCount := 1;
 651
 652   glEnable(GL_TEXTURE_2D);
 653   glBindTexture(GL_TEXTURE_2D, e_Textures[ID].tx.id);
 654
 655   X2 := X+e_Textures[ID].tx.width*XCount;
 656   Y2 := Y+e_Textures[ID].tx.height*YCount;
 657
 658   //k8: this SHOULD work... i hope
 659   if (e_Textures[ID].tx.width = e_Textures[ID].tx.glwidth) and (e_Textures[ID].tx.height = e_Textures[ID].tx.glheight) then
 660   begin
 661     glBegin(GL_QUADS);
 662       glTexCoord2i(0,      YCount); glVertex2i(X,  Y);
 663       glTexCoord2i(XCount, YCount); glVertex2i(X2, Y);
 664       glTexCoord2i(XCount, 0);      glVertex2i(X2, Y2);
 665       glTexCoord2i(0,      0);      glVertex2i(X,  Y2);
 666     glEnd();
 667   end
 668   else
 669   begin
 670     glBegin(GL_QUADS);
 671     // hard day's night
 672     u := e_Textures[ID].tx.u;
 673     v := e_Textures[ID].tx.v;
 674     w := e_Textures[ID].tx.width;
 675     h := e_Textures[ID].tx.height;
 676     while YCount > 0 do
 677     begin
 678       dx := XCount;
 679       x2 := X;
 680       while dx > 0 do
 681       begin
 682         glTexCoord2f(0, v); glVertex2i(X,  Y);
 683         glTexCoord2f(u, v); glVertex2i(X+w, Y);
 684         glTexCoord2f(u, 0); glVertex2i(X+w, Y+h);
 685         glTexCoord2f(0, 0); glVertex2i(X,  Y+h);
 686         Inc(X, w);
 687         Dec(dx);
 688       end;
 689       X := x2;
 690       Inc(Y, h);
 691       Dec(YCount);
 692     end;
 693     glEnd();
 694   end;
 695
 696   glDisable(GL_BLEND);
 697 end;
 698
 699
 700 //TODO: overflow checks
 701 function intersectRect (var x0, y0, w0, h0: Integer; const x1, y1, w1, h1: Integer): Boolean;
 702 var
 703   ex0, ey0: Integer;
 704 begin
 705   result := false;
 706   if (w0 < 1) or (h0 < 1) or (w1 < 1) or (h1 < 1) then exit;
 707   // check for intersection
 708   if (x0+w0 <= x1) or (y0+h0 <= y1) or (x1+w1 <= x0) or (y1+h1 <= y0) then exit;
 709   if (x0 >= x1+w1) or (y0 >= y1+h1) or (x1 >= x0+h0) or (y1 >= y0+h0) then exit;
 710   // ok, intersects
 711   ex0 := x0+w0;
 712   ey0 := y0+h0;
 713   if (x0 < x1) then x0 := x1;
 714   if (y0 < y1) then y0 := y1;
 715   if (ex0 > x1+w1) then ex0 := x1+w1;
 716   if (ey0 > y1+h1) then ey0 := y1+h1;
 717   w0 := ex0-x0;
 718   h0 := ey0-y0;
 719   result := (w0 > 0) and (h0 > 0);
 720 end;
 721
 722
 723 procedure e_DrawFillX (id: DWORD; x, y, wdt, hgt: Integer; alpha: Integer; alphachannel: Boolean;
 724                        blending: Boolean; scale: Single; ambientBlendMode: Boolean=false);
 725 var
 726   x2, y2: Integer;
 727   {
 728   wassc: Boolean;
 729   scxywh: array[0..3] of GLint;
 730   vpxywh: array[0..3] of GLint;
 731   }
 732   w, h, dw, cw, ch, yofs: Integer;
 733   u, v, cu, cv: Single;
 734   onlyOneY: Boolean;
 735
 736   {
 737   procedure setScissorGLInternal (x, y, w, h: Integer);
 738   begin
 739     //if not scallowed then exit;
 740     x := trunc(x*scale);
 741     y := trunc(y*scale);
 742     w := trunc(w*scale);
 743     h := trunc(h*scale);
 744     y := vpxywh[3]-(y+h);
 745     if not intersectRect(x, y, w, h, scxywh[0], scxywh[1], scxywh[2], scxywh[3]) then
 746     begin
 747       glScissor(0, 0, 0, 0);
 748     end
 749     else
 750     begin
 751       //writeln('  (', x, ',', y, ')-(', w, ',', h, ')');
 752       glScissor(x, y, w, h);
 753     end;
 754   end;
 755   }
 756
 757 begin
 758   if e_NoGraphics then exit;
 759   ambientBlendMode := false;
 760
 761   if (wdt < 1) or (hgt < 1) then exit;
 762
 763   if (wdt mod e_Textures[ID].tx.width = 0) and (hgt mod e_Textures[ID].tx.height = 0) then
 764   begin
 765     e_DrawFill(id, x, y, wdt div e_Textures[ID].tx.width, hgt div e_Textures[ID].tx.height, alpha, alphachannel, blending, ambientBlendMode);
 766     exit;
 767   end;
 768
 769   glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255);
 770
 771   if (Alpha > 0) or AlphaChannel or Blending then
 772   begin
 773     glEnable(GL_BLEND);
 774   end
 775   else
 776   begin
 777     if not ambientBlendMode then glDisable(GL_BLEND);
 778   end;
 779   if AlphaChannel or (Alpha > 0) then glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
 780   if (Alpha > 0) then glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255-Alpha);
 781   if Blending then glBlendFunc(GL_SRC_ALPHA, GL_ONE);
 782
 783   glEnable(GL_TEXTURE_2D);
 784   glBindTexture(GL_TEXTURE_2D, e_Textures[ID].tx.id);
 785
 786   x2 := x+wdt;
 787   y2 := y+hgt;
 788
 789   //k8: this SHOULD work... i hope
 790   if {false and} (e_Textures[ID].tx.width = e_Textures[ID].tx.glwidth) and (e_Textures[ID].tx.height = e_Textures[ID].tx.glheight) then
 791   begin
 792     glBegin(GL_QUADS);
 793       glTexCoord2f(0, hgt/e_Textures[ID].tx.height); glVertex2i(x,  y);
 794       glTexCoord2f(wdt/e_Textures[ID].tx.width, hgt/e_Textures[ID].tx.height); glVertex2i(x2, y);
 795       glTexCoord2f(wdt/e_Textures[ID].tx.width, 0); glVertex2i(x2, y2);
 796       glTexCoord2f(0, 0); glVertex2i(x, y2);
 797     glEnd();
 798   end
 799   else
 800   begin
 801     // hard day's night; setup scissor
 802     {
 803     glGetIntegerv(GL_VIEWPORT, @vpxywh[0]);
 804     wassc := (glIsEnabled(GL_SCISSOR_TEST) <> 0);
 805     if wassc then glGetIntegerv(GL_SCISSOR_BOX, @scxywh[0]) else glGetIntegerv(GL_VIEWPORT, @scxywh[0]);
 806     //writeln('(', scxywh[0], ',', scxywh[1], ')-(', scxywh[2], ',', scxywh[3], ')');
 807     //glEnable(GL_SCISSOR_TEST);
 808     setScissorGLInternal(x, y, wdt, hgt);
 809     }
 810     // draw quads
 811     u := e_Textures[ID].tx.u;
 812     v := e_Textures[ID].tx.v;
 813     w := e_Textures[ID].tx.width;
 814     h := e_Textures[ID].tx.height;
 815     x2 := x;
 816     if (hgt > h) then begin y += hgt-h; onlyOneY := false; end else onlyOneY := true;
 817     glBegin(GL_QUADS);
 818     while (hgt > 0) do
 819     begin
 820       if (hgt >= h) then begin ch := h; cv := v; yofs := 0; end else begin ch := hgt; cv := v/(h/hgt); yofs := h-hgt; end;
 821       if onlyOneY then yofs := 0;
 822       Dec(hgt, h);
 823       dw := wdt;
 824       x := x2;
 825       while (dw > 0) do
 826       begin
 827         if (dw >= w) then begin cw := w; cu := u; end else begin cw := dw; cu := u/(w/dw); end;
 828         Dec(dw, w);
 829         glTexCoord2f(0, cv); glVertex2i(X,   Y+yofs);
 830         glTexCoord2f(cu, cv); glVertex2i(X+cw, Y+yofs);
 831         glTexCoord2f(cu, 0); glVertex2i(X+cw, Y+ch+yofs);
 832         glTexCoord2f(0, 0); glVertex2i(X,   Y+ch+yofs);
 833         Inc(X, w);
 834       end;
 835       Dec(Y, h);
 836     end;
 837     glEnd();
 838     //if wassc then glEnable(GL_SCISSOR_TEST) else glDisable(GL_SCISSOR_TEST);
 839   end;
 840
 841   glDisable(GL_BLEND);
 842 end;
 843
 844
 845 procedure e_AmbientQuad (x, y, w, h: Integer; r, g, b, a: Byte);
 846 begin
 847   if e_NoGraphics then exit;
 848   if (w < 1) or (h < 1) then exit;
 849   if (a <> 255) or ((r or g or b) <> 0) then
 850   begin
 851     glEnable(GL_BLEND);
 852     glDisable(GL_TEXTURE_2D);
 853     glColor4ub(r, g, b, a);
 854     if ((r or g or b) <> 0) then
 855     begin
 856       glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
 857       glBegin(GL_QUADS);
 858         glVertex2i(x, y);
 859         glVertex2i(x+w, y);
 860         glVertex2i(x+w, y+h);
 861         glVertex2i(x, y+h);
 862       glEnd();
 863     end;
 864     glBlendFunc(GL_ZERO, GL_SRC_ALPHA);
 865     glBegin(GL_QUADS);
 866       glVertex2i(x, y);
 867       glVertex2i(x+w, y);
 868       glVertex2i(x+w, y+h);
 869       glVertex2i(x, y+h);
 870     glEnd();
 871     glDisable(GL_BLEND);
 872   end;
 873 end;
 874
 875
 876 procedure e_DrawAdv(ID: DWORD; X, Y: Integer; Alpha: Byte; AlphaChannel: Boolean;
 877                     Blending: Boolean; Angle: Single; RC: PDFPoint; Mirror: TMirrorType = TMirrorType.None);
 878 begin
 879   if e_NoGraphics then Exit;
 880
 881   glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255);
 882
 883   if (Alpha > 0) or (AlphaChannel) or (Blending) then
 884     glEnable(GL_BLEND)
 885   else
 886     glDisable(GL_BLEND);
 887
 888   if (AlphaChannel) or (Alpha > 0) then
 889     glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
 890
 891   if Alpha > 0 then
 892     glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255-Alpha);
 893
 894   if Blending then
 895     glBlendFunc(GL_SRC_ALPHA, GL_ONE);
 896
 897   if (Angle <> 0) and (RC <> nil) then
 898   begin
 899     glPushMatrix();
 900     glTranslatef(X+RC.X, Y+RC.Y, 0);
 901     glRotatef(Angle, 0, 0, 1);
 902     glTranslatef(-(X+RC.X), -(Y+RC.Y), 0);
 903   end;
 904
 905   glEnable(GL_TEXTURE_2D);
 906   glBindTexture(GL_TEXTURE_2D, e_Textures[id].tx.id);
 907   glBegin(GL_QUADS);                           //0-1        1-1
 908                                                //00         10
 909   drawTxQuad(X, Y, e_Textures[id].tx.width, e_Textures[id].tx.height, e_Textures[id].tx.width, e_Textures[id].tx.height, e_Textures[ID].tx.u, e_Textures[ID].tx.v, Mirror);
 910   glEnd();
 911
 912   if Angle <> 0 then
 913     glPopMatrix();
 914
 915   glDisable(GL_BLEND);
 916 end;
 917
 918 procedure e_DrawPoint(Size: Byte; X, Y: Integer; Red, Green, Blue: Byte);
 919 begin
 920   if e_NoGraphics then Exit;
 921   glDisable(GL_TEXTURE_2D);
 922   glColor3ub(Red, Green, Blue);
 923   glPointSize(Size);
 924
 925   if (Size = 2) or (Size = 4) then
 926     X := X + 1;
 927
 928   glBegin(GL_POINTS);
 929     glVertex2f(X+0.3, Y+1.0);
 930   glEnd();
 931
 932   glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255);
 933 end;
 934
 935 procedure e_LineCorrection(var X1, Y1, X2, Y2: Integer);
 936 begin
 937   // Make lines only top-left/bottom-right and top-right/bottom-left
 938   if Y2 < Y1 then
 939   begin
 940     X1 := X1 xor X2;
 941     X2 := X1 xor X2;
 942     X1 := X1 xor X2;
 943
 944     Y1 := Y1 xor Y2;
 945     Y2 := Y1 xor Y2;
 946     Y1 := Y1 xor Y2;
 947   end;
 948
 949   // Pixel-perfect hack
 950   if X1 < X2 then
 951     Inc(X2)
 952   else
 953     Inc(X1);
 954   Inc(Y2);
 955 end;
 956
 957 procedure e_DrawQuad(X1, Y1, X2, Y2: Integer; Red, Green, Blue: Byte; Alpha: Byte = 0);
 958 var
 959   nX1, nY1, nX2, nY2: Integer;
 960 begin
 961 {$IFNDEF USE_NANOGL} // FIXIT: nanoGL doesn't support glBegin(GL_LINES)
 962   if e_NoGraphics then Exit;
 963   // Only top-left/bottom-right quad
 964   if X1 > X2 then
 965   begin
 966     X1 := X1 xor X2;
 967     X2 := X1 xor X2;
 968     X1 := X1 xor X2;
 969   end;
 970   if Y1 > Y2 then
 971   begin
 972     Y1 := Y1 xor Y2;
 973     Y2 := Y1 xor Y2;
 974     Y1 := Y1 xor Y2;
 975   end;
 976
 977   if Alpha > 0 then
 978   begin
 979     glEnable(GL_BLEND);
 980     glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
 981   end else
 982     glDisable(GL_BLEND);
 983
 984   glDisable(GL_TEXTURE_2D);
 985   glColor4ub(Red, Green, Blue, 255-Alpha);
 986   glLineWidth(1);
 987
 988   glBegin(GL_LINES);
 989     nX1 := X1; nY1 := Y1;
 990     nX2 := X2; nY2 := Y1;
 991     e_LineCorrection(nX1, nY1, nX2, nY2); // Pixel-perfect lines
 992     glVertex2i(nX1, nY1);
 993     glVertex2i(nX2, nY2);
 994
 995     nX1 := X2; nY1 := Y1;
 996     nX2 := X2; nY2 := Y2;
 997     e_LineCorrection(nX1, nY1, nX2, nY2);
 998     glVertex2i(nX1, nY1);
 999     glVertex2i(nX2, nY2);
1000
1001     nX1 := X2; nY1 := Y2;
1002     nX2 := X1; nY2 := Y2;
1003     e_LineCorrection(nX1, nY1, nX2, nY2);
1004     glVertex2i(nX1, nY1);
1005     glVertex2i(nX2, nY2);
1006
1007     nX1 := X1; nY1 := Y2;
1008     nX2 := X1; nY2 := Y1;
1009     e_LineCorrection(nX1, nY1, nX2, nY2);
1010     glVertex2i(nX1, nY1);
1011     glVertex2i(nX2, nY2);
1012   glEnd();
1013
1014   glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255);
1015
1016   glDisable(GL_BLEND);
1017 {$ENDIF}
1018 end;
1019
1020 procedure e_DrawFillQuad(X1, Y1, X2, Y2: Integer; Red, Green, Blue, Alpha: Byte;
1021                          Blending: TBlending = TBlending.None);
1022 begin
1023   if e_NoGraphics then Exit;
1024   if (Alpha > 0) or (Blending <> TBlending.None) then
1025     glEnable(GL_BLEND)
1026   else
1027     glDisable(GL_BLEND);
1028
1029   if Blending = TBlending.Blend then
1030     glBlendFunc(GL_SRC_ALPHA, GL_ONE)
1031   else
1032     if Blending = TBlending.Filter then
1033       glBlendFunc(GL_DST_COLOR, GL_SRC_COLOR)
1034     else
1035       if Blending = TBlending.Invert then
1036         glBlendFunc(GL_ONE_MINUS_DST_COLOR, GL_ZERO)
1037       else
1038         if Alpha > 0 then
1039           glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
1040
1041   glDisable(GL_TEXTURE_2D);
1042   glColor4ub(Red, Green, Blue, 255-Alpha);
1043
1044   X2 := X2 + 1;
1045   Y2 := Y2 + 1;
1046
1047   glBegin(GL_QUADS);
1048     glVertex2i(X1, Y1);
1049     glVertex2i(X2, Y1);
1050     glVertex2i(X2, Y2);
1051     glVertex2i(X1, Y2);
1052   glEnd();
1053
1054   glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255);
1055
1056   glDisable(GL_BLEND);
1057 end;
1058
1059
1060 // ////////////////////////////////////////////////////////////////////////// //
1061 procedure e_DarkenQuad (x0, y0, x1, y1: Integer; a: Integer);
1062 begin
1063   if (a < 0) then a := 0;
1064   if (a > 255) then a := 255;
1065   glEnable(GL_BLEND);
1066   glBlendFunc(GL_ZERO, GL_SRC_ALPHA);
1067   glDisable(GL_TEXTURE_2D);
1068   glColor4ub(0, 0, 0, Byte(255-a));
1069   glBegin(GL_QUADS);
1070     glVertex2i(x0, y0);
1071     glVertex2i(x1, y0);
1072     glVertex2i(x1, y1);
1073     glVertex2i(x0, y1);
1074   glEnd();
1075   //glRect(x, y, x+w, y+h);
1076   glColor4ub(1, 1, 1, 1);
1077   glDisable(GL_BLEND);
1078   //glBlendEquation(GL_FUNC_ADD);
1079 end;
1080
1081 procedure e_DarkenQuadWH (x, y, w, h: Integer; a: Integer);
1082 begin
1083   if (w > 0) and (h > 0) then e_DarkenQuad(x, y, x+w, y+h, a);
1084 end;
1085
1086
1087 procedure e_DrawLine(Width: Byte; X1, Y1, X2, Y2: Integer; Red, Green, Blue: Byte; Alpha: Byte = 0);
1088 begin
1089 {$IFNDEF USE_NANOGL} // FIXIT: nanoGL doesn't support glBegin(GL_LINES)
1090   if e_NoGraphics then Exit;
1091   // Pixel-perfect lines
1092   if Width = 1 then
1093     e_LineCorrection(X1, Y1, X2, Y2);
1094
1095   if Alpha > 0 then
1096   begin
1097     glEnable(GL_BLEND);
1098     glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
1099   end else
1100     glDisable(GL_BLEND);
1101
1102   glDisable(GL_TEXTURE_2D);
1103   glColor4ub(Red, Green, Blue, 255-Alpha);
1104   glLineWidth(Width);
1105
1106   glBegin(GL_LINES);
1107     glVertex2i(X1, Y1);
1108     glVertex2i(X2, Y2);
1109   glEnd();
1110
1111   glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255);
1112
1113   glDisable(GL_BLEND);
1114 {$ENDIF}
1115 end;
1116
1117 //------------------------------------------------------------------
1118 // Óäàëÿåò òåêñòóðó èç ìàññèâà
1119 //------------------------------------------------------------------
1120 procedure e_DeleteTexture(ID: DWORD);
1121 begin
1122   if not e_NoGraphics then
1123     glDeleteTextures(1, @e_Textures[ID].tx.id);
1124   e_Textures[ID].tx.id := 0;
1125   e_Textures[ID].tx.Width := 0;
1126   e_Textures[ID].tx.Height := 0;
1127 end;
1128
1129 //------------------------------------------------------------------
1130 // Óäàëÿåò âñå òåêñòóðû
1131 //------------------------------------------------------------------
1132 procedure e_RemoveAllTextures();
1133 var
1134   i: integer;
1135 begin
1136  if e_Textures = nil then Exit;
1137
1138  for i := 0 to High(e_Textures) do
1139   if e_Textures[i].tx.Width <> 0 then e_DeleteTexture(i);
1140  e_Textures := nil;
1141 end;
1142
1143 //------------------------------------------------------------------
1144 // Óäàëÿåò äâèæîê
1145 //------------------------------------------------------------------
1146 procedure e_ReleaseEngine();
1147 begin
1148  e_RemoveAllTextures;
1149  e_RemoveAllTextureFont;
1150 end;
1151
1152 procedure e_BeginRender();
1153 begin
1154   if e_NoGraphics then Exit;
1155   glEnable(GL_ALPHA_TEST);
1156   glAlphaFunc(GL_GREATER, 0.0);
1157 end;
1158
1159 procedure e_Clear(Mask: TGLbitfield; Red, Green, Blue: Single); overload;
1160 begin
1161   if e_NoGraphics then Exit;
1162   glClearColor(Red, Green, Blue, 0);
1163   glClear(Mask);
1164 end;
1165
1166 procedure e_Clear(); overload;
1167 begin
1168   if e_NoGraphics then Exit;
1169   glClearColor(0, 0, 0, 0);
1170   glClear(GL_COLOR_BUFFER_BIT);
1171 end;
1172
1173 procedure e_EndRender();
1174 begin
1175   if e_NoGraphics then Exit;
1176   glPopMatrix();
1177 end;
1178
1179 function e_GetGamma(win: PSDL_Window): Byte;
1180 var
1181   ramp: array [0..256*3-1] of Word;
1182   rgb: array [0..2] of Double;
1183   sum: double;
1184   count: integer;
1185   min: integer;
1186   max: integer;
1187   A, B: double;
1188   i, j: integer;
1189 begin
1190  Result := 0;
1191  if e_NoGraphics then Exit;
1192  rgb[0] := 1.0;
1193  rgb[1] := 1.0;
1194  rgb[2] := 1.0;
1195
1196  SDL_GetWindowGammaRamp(win, @ramp[0], @ramp[256], @ramp[512]);
1197
1198  for i := 0 to 2 do
1199  begin
1200   sum := 0;
1201   count := 0;
1202   min := 256 * i;
1203   max := min + 256;
1204
1205   for j := min to max - 1 do
1206   if ramp[j] > 0 then
1207   begin
1208    B := (j mod 256)/256;
1209    A := ramp[j]/65536;
1210    sum := sum + ln(A)/ln(B);
1211    inc(count);
1212   end;
1213   rgb[i] := sum / count;
1214  end;
1215
1216  Result := 100 - Trunc(((rgb[0] + rgb[1] + rgb[2])/3 - 0.23) * 100/(2.7 - 0.23));
1217 end;
1218
1219 procedure e_SetGamma(win: PSDL_Window; Gamma: Byte);
1220 var
1221   ramp: array [0..256*3-1] of Word;
1222   i: integer;
1223   r: double;
1224   g: double;
1225 begin
1226  if e_NoGraphics then Exit;
1227  g := (100 - Gamma)*(2.7 - 0.23)/100 + 0.23;
1228
1229  for i := 0 to 255 do
1230  begin
1231   r := Exp(g * ln(i/256))*65536;
1232   if r < 0 then r := 0
1233    else if r > 65535 then r := 65535;
1234   ramp[i] := trunc(r);
1235   ramp[i + 256] := trunc(r);
1236   ramp[i + 512] := trunc(r);
1237  end;
1238
1239  SDL_SetWindowGammaRamp(win, @ramp[0], @ramp[256], @ramp[512]);
1240 end;
1241
1242 function e_CharFont_Create(sp: ShortInt=0): DWORD;
1243 var
1244   i, id: DWORD;
1245 begin
1246  e_WriteLog('Creating CharFont...', TMsgType.Notify);
1247
1248  id := DWORD(-1);
1249
1250  if e_CharFonts <> nil then
1251  for i := 0 to High(e_CharFonts) do
1252   if not e_CharFonts[i].alive then
1253   begin
1254    id := i;
1255    Break;
1256   end;
1257
1258  if id = DWORD(-1) then
1259  begin
1260   SetLength(e_CharFonts, Length(e_CharFonts) + 1);
1261   id := High(e_CharFonts);
1262  end;
1263
1264  with e_CharFonts[id] do
1265  begin
1266   for i := 0 to High(Chars) do
1267    with Chars[i] do
1268    begin
1269     TextureID := -1;
1270     Width := 0;
1271    end;
1272
1273   Space := sp;
1274   alive := True;
1275  end;
1276
1277  Result := id;
1278 end;
1279
1280 procedure e_CharFont_AddChar(FontID: DWORD; Texture: Integer; c: Char; w: Byte);
1281 begin
1282  with e_CharFonts[FontID].Chars[Ord(c)] do
1283  begin
1284   TextureID := Texture;
1285   Width := w;
1286  end;
1287 end;
1288
1289 procedure e_CharFont_Print(FontID: DWORD; X, Y: Integer; Text: string);
1290 var
1291   a: Integer;
1292 begin
1293  if e_NoGraphics then Exit;
1294  if Text = '' then Exit;
1295  if e_CharFonts = nil then Exit;
1296  if Integer(FontID) > High(e_CharFonts) then Exit;
1297
1298  with e_CharFonts[FontID] do
1299  begin
1300   for a := 1 to Length(Text) do
1301    with Chars[Ord(Text[a])] do
1302    if TextureID <> -1 then
1303    begin
1304     e_Draw(TextureID, X, Y, 0, True, False);
1305     X := X+Width+IfThen(a = Length(Text), 0, Space);
1306    end;
1307  end;
1308 end;
1309
1310 procedure e_CharFont_PrintEx(FontID: DWORD; X, Y: Integer; Text: string;
1311                              Color: TRGB; Scale: Single = 1.0);
1312 var
1313   a: Integer;
1314   c: TRGB;
1315 begin
1316  if e_NoGraphics then Exit;
1317  if Text = '' then Exit;
1318  if e_CharFonts = nil then Exit;
1319  if Integer(FontID) > High(e_CharFonts) then Exit;
1320
1321  with e_CharFonts[FontID] do
1322  begin
1323   for a := 1 to Length(Text) do
1324    with Chars[Ord(Text[a])] do
1325    if TextureID <> -1 then
1326    begin
1327     if Scale <> 1.0 then
1328     begin
1329      glPushMatrix;
1330      glScalef(Scale, Scale, 0);
1331     end;
1332
1333     c := e_Colors;
1334     e_Colors := Color;
1335     e_Draw(TextureID, X, Y, 0, True, False);
1336     e_Colors := c;
1337
1338     if Scale <> 1.0 then glPopMatrix;
1339
1340     X := X+Width+IfThen(a = Length(Text), 0, Space);
1341    end;
1342  end;
1343 end;
1344
1345 procedure e_CharFont_PrintFmt(FontID: DWORD; X, Y: Integer; Text: string);
1346 var
1347   a, TX, TY, len: Integer;
1348   tc, c: TRGB;
1349   w, h: Word;
1350 begin
1351   if e_NoGraphics then Exit;
1352   if Text = '' then Exit;
1353   if e_CharFonts = nil then Exit;
1354   if Integer(FontID) > High(e_CharFonts) then Exit;
1355
1356   c.R := 255;
1357   c.G := 255;
1358   c.B := 255;
1359
1360   TX := X;
1361   TY := Y;
1362   len := Length(Text);
1363
1364   e_CharFont_GetSize(FontID, 'A', w, h);
1365
1366   with e_CharFonts[FontID] do
1367   begin
1368     for a := 1 to len do
1369     begin
1370       case Text[a] of
1371         #10: // line feed
1372         begin
1373           TX := X;
1374           TY := TY + h;
1375           continue;
1376         end;
1377         #1: // black
1378         begin
1379           c.R := 0; c.G := 0; c.B := 0;
1380           continue;
1381         end;
1382         #2: // white
1383         begin
1384           c.R := 255; c.G := 255; c.B := 255;
1385           continue;
1386         end;
1387         #3: // darker
1388         begin
1389           c.R := c.R div 2; c.G := c.G div 2; c.B := c.B div 2;
1390           continue;
1391         end;
1392         #4: // lighter
1393         begin
1394           c.R := Min(c.R * 2, 255); c.G := Min(c.G * 2, 255); c.B := Min(c.B * 2, 255);
1395           continue;
1396         end;
1397         #18: // red
1398         begin
1399           c.R := 255; c.G := 0; c.B := 0;
1400           continue;
1401         end;
1402         #19: // green
1403         begin
1404           c.R := 0; c.G := 255; c.B := 0;
1405           continue;
1406         end;
1407         #20: // blue
1408         begin
1409           c.R := 0; c.G := 0; c.B := 255;
1410           continue;
1411         end;
1412         #21: // yellow
1413         begin
1414           c.R := 255; c.G := 255; c.B := 0;
1415           continue;
1416         end;
1417       end;
1418
1419       with Chars[Ord(Text[a])] do
1420       if TextureID <> -1 then
1421       begin
1422         tc := e_Colors;
1423         e_Colors := c;
1424         e_Draw(TextureID, TX, TY, 0, True, False);
1425         e_Colors := tc;
1426
1427         TX := TX+Width+IfThen(a = Length(Text), 0, Space);
1428       end;
1429     end;
1430   end;
1431 end;
1432
1433 procedure e_CharFont_GetSize(FontID: DWORD; Text: string; var w, h: Word);
1434 var
1435   a: Integer;
1436   h2: Word;
1437 begin
1438  w := 0;
1439  h := 0;
1440
1441  if Text = '' then Exit;
1442  if e_CharFonts = nil then Exit;
1443  if Integer(FontID) > High(e_CharFonts) then Exit;
1444
1445  with e_CharFonts[FontID] do
1446  begin
1447   for a := 1 to Length(Text) do
1448    with Chars[Ord(Text[a])] do
1449    if TextureID <> -1 then
1450    begin
1451     w := w+Width+IfThen(a = Length(Text), 0, Space);
1452     e_GetTextureSize(TextureID, nil, @h2);
1453     if h2 > h then h := h2;
1454    end;
1455  end;
1456 end;
1457
1458 procedure e_CharFont_GetSizeFmt(FontID: DWORD; Text: string; var w, h: Word);
1459 var
1460   a, lines, len: Integer;
1461   h2, w2, tw, th: Word;
1462 begin
1463   w2 := 0;
1464   h2 := 0;
1465   tw := 0;
1466   th := 0;
1467
1468   if Text = '' then Exit;
1469   if e_CharFonts = nil then Exit;
1470   if Integer(FontID) > High(e_CharFonts) then Exit;
1471
1472   lines := 1;
1473   len := Length(Text);
1474
1475   with e_CharFonts[FontID] do
1476   begin
1477     for a := 1 to len do
1478     begin
1479       if Text[a] = #10 then
1480       begin
1481         Inc(lines);
1482         if w2 > tw then tw := w2;
1483         w2 := 0;
1484         continue;
1485       end;
1486
1487       with Chars[Ord(Text[a])] do
1488         if TextureID <> -1 then
1489         begin
1490           w2 := w2 + Width + IfThen(a = len, 0, Space);
1491           e_GetTextureSize(TextureID, nil, @h2);
1492           if h2 > th then th := h2;
1493         end;
1494     end;
1495   end;
1496
1497   if w2 > tw then
1498     tw := w2;
1499
1500   w := tw;
1501   h := th * lines;
1502 end;
1503
1504 function e_CharFont_GetMaxWidth(FontID: DWORD): Word;
1505 var
1506   a: Integer;
1507 begin
1508  Result := 0;
1509
1510  if e_CharFonts = nil then Exit;
1511  if Integer(FontID) > High(e_CharFonts) then Exit;
1512
1513  for a := 0 to High(e_CharFonts[FontID].Chars) do
1514   Result := Max(Result, e_CharFonts[FontID].Chars[a].Width);
1515 end;
1516
1517 function e_CharFont_GetMaxHeight(FontID: DWORD): Word;
1518 var
1519   a: Integer;
1520   h2: Word;
1521 begin
1522  Result := 0;
1523
1524  if e_CharFonts = nil then Exit;
1525  if Integer(FontID) > High(e_CharFonts) then Exit;
1526
1527  for a := 0 to High(e_CharFonts[FontID].Chars) do
1528  begin
1529   if e_CharFonts[FontID].Chars[a].TextureID <> -1 then
1530    e_GetTextureSize(e_CharFonts[FontID].Chars[a].TextureID, nil, @h2)
1531     else h2 := 0;
1532   if h2 > Result then Result := h2;
1533  end;
1534 end;
1535
1536 procedure e_CharFont_Remove(FontID: DWORD);
1537 var
1538   a: Integer;
1539 begin
1540  with e_CharFonts[FontID] do
1541   for a := 0 to High(Chars) do
1542    if Chars[a].TextureID <> -1 then e_DeleteTexture(Chars[a].TextureID);
1543
1544  e_CharFonts[FontID].alive := False;
1545 end;
1546
1547 procedure e_CharFont_RemoveAll();
1548 var
1549   a: Integer;
1550 begin
1551  if e_CharFonts = nil then Exit;
1552
1553  for a := 0 to High(e_CharFonts) do
1554   e_CharFont_Remove(a);
1555
1556  e_CharFonts := nil;
1557 end;
1558
1559 procedure e_TextureFontBuild(Tex: DWORD; var FontID: DWORD; XCount, YCount: Word;
1560                              Space: ShortInt=0);
1561 var
1562   loop1 : GLuint;
1563   cx, cy : real;
1564   i, id: DWORD;
1565 begin
1566  if e_NoGraphics then Exit;
1567  e_WriteLog('Creating texture font...', TMsgType.Notify);
1568
1569  id := DWORD(-1);
1570
1571  if e_TextureFonts <> nil then
1572  for i := 0 to High(e_TextureFonts) do
1573   if e_TextureFonts[i].Base = 0 then
1574   begin
1575    id := i;
1576    Break;
1577   end;
1578
1579  if id = DWORD(-1) then
1580  begin
1581   SetLength(e_TextureFonts, Length(e_TextureFonts) + 1);
1582   id := High(e_TextureFonts);
1583  end;
1584
1585 {$IFNDEF USE_NANOGL} // FIXIT: nanoGL doesn't support gl-lists
1586  with e_TextureFonts[id] do
1587  begin
1588   Base := glGenLists(XCount*YCount);
1589   TextureID := e_Textures[Tex].tx.id;
1590   CharWidth := (e_Textures[Tex].tx.Width div XCount)+Space;
1591   CharHeight := e_Textures[Tex].tx.Height div YCount;
1592   XC := XCount;
1593   YC := YCount;
1594   Texture := Tex;
1595   SPC := Space;
1596  end;
1597
1598  glBindTexture(GL_TEXTURE_2D, e_Textures[Tex].tx.id);
1599  for loop1 := 0 to XCount*YCount-1 do
1600  begin
1601   cx := (loop1 mod XCount)/XCount;
1602   cy := (loop1 div YCount)/YCount;
1603
1604   glNewList(e_TextureFonts[id].Base+loop1, GL_COMPILE);
1605    glBegin(GL_QUADS);
1606     glTexCoord2f(cx, 1.0-cy-1/YCount);
1607     glVertex2i(0, e_Textures[Tex].tx.Height div YCount);
1608
1609     glTexCoord2f(cx+1/XCount, 1.0-cy-1/YCount);
1610     glVertex2i(e_Textures[Tex].tx.Width div XCount, e_Textures[Tex].tx.Height div YCount);
1611
1612     glTexCoord2f(cx+1/XCount, 1.0-cy);
1613     glVertex2i(e_Textures[Tex].tx.Width div XCount, 0);
1614
1615     glTexCoord2f(cx, 1.0-cy);
1616     glVertex2i(0, 0);
1617    glEnd();
1618    glTranslated((e_Textures[Tex].tx.Width div XCount)+Space, 0, 0);
1619   glEndList();
1620  end;
1621 {$ENDIF}
1622
1623  FontID := id;
1624 end;
1625
1626 procedure e_TextureFontKill(FontID: DWORD);
1627 begin
1628   if e_NoGraphics then Exit;
1629 {$IFNDEF USE_NANOGL} // FIXIT: nanoGL doesn't support gl-lists
1630   glDeleteLists(e_TextureFonts[FontID].Base, 256);
1631 {$ENDIF}
1632   e_TextureFonts[FontID].Base := 0;
1633 end;
1634
1635 procedure e_TextureFontPrint(X, Y: GLint; Text: string; FontID: DWORD);
1636 begin
1637 {$IFNDEF USE_NANOGL} // FIXIT: nanoGL doesn't support gl-lists
1638   if e_NoGraphics then Exit;
1639   if Integer(FontID) > High(e_TextureFonts) then Exit;
1640   if Text = '' then Exit;
1641
1642   glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
1643   glEnable(GL_BLEND);
1644
1645   glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255);
1646
1647   glPushMatrix;
1648   glBindTexture(GL_TEXTURE_2D, e_TextureFonts[FontID].TextureID);
1649   glEnable(GL_TEXTURE_2D);
1650   glTranslated(x, y, 0);
1651   glListBase(DWORD(Integer(e_TextureFonts[FontID].Base)-32));
1652   glCallLists(Length(Text), GL_UNSIGNED_BYTE, PChar(Text));
1653   glDisable(GL_TEXTURE_2D);
1654   glPopMatrix;
1655
1656   glDisable(GL_BLEND);
1657 {$ENDIF}
1658 end;
1659
1660 // god forgive me for this, but i cannot figure out how to do it without lists
1661 procedure e_TextureFontPrintChar(X, Y: Integer; Ch: Char; FontID: DWORD; Shadow: Boolean = False);
1662 begin
1663 {$IFNDEF USE_NANOGL} // FIXIT: nanoGL doesn't support gl-lists
1664   if e_NoGraphics then Exit;
1665   glPushMatrix;
1666
1667   if Shadow then
1668   begin
1669    glColor4ub(0, 0, 0, 128);
1670    glTranslated(X+1, Y+1, 0);
1671    glCallLists(1, GL_UNSIGNED_BYTE, @Ch);
1672    glPopMatrix;
1673    glPushMatrix;
1674   end;
1675
1676   glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255);
1677   glTranslated(X, Y, 0);
1678   glCallLists(1, GL_UNSIGNED_BYTE, @Ch);
1679
1680   glPopMatrix;
1681 {$ENDIF}
1682 end;
1683
1684 procedure e_TextureFontPrintCharEx (X, Y: Integer; Ch: Char; FontID: DWORD; Shadow: Boolean = False);
1685 begin
1686   glBindTexture(GL_TEXTURE_2D, e_TextureFonts[FontID].TextureID);
1687   glEnable(GL_TEXTURE_2D);
1688   //glListBase(DWORD(Integer(e_TextureFonts[FontID].Base)-32));
1689
1690   glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
1691   glEnable(GL_BLEND);
1692   e_TextureFontPrintChar(X, Y, Ch, FontID, Shadow);
1693   glDisable(GL_TEXTURE_2D);
1694   glDisable(GL_BLEND);
1695 end;
1696
1697 function e_TextureFontCharWidth (ch: Char; FontID: DWORD): Integer;
1698 begin
1699   result := e_TextureFonts[FontID].CharWidth;
1700 end;
1701
1702 procedure e_TextureFontPrintFmt(X, Y: GLint; Text: string; FontID: DWORD; Shadow: Boolean = False);
1703 var
1704   a, TX, TY, len: Integer;
1705   tc, c: TRGB;
1706   w: Word;
1707 begin
1708 {$IFNDEF USE_NANOGL} // FIXIT: nanoGL doesn't support gl-lists
1709   if e_NoGraphics then Exit;
1710   if Text = '' then Exit;
1711   if e_TextureFonts = nil then Exit;
1712   if Integer(FontID) > High(e_TextureFonts) then Exit;
1713
1714   c.R := 255;
1715   c.G := 255;
1716   c.B := 255;
1717
1718   TX := X;
1719   TY := Y;
1720   len := Length(Text);
1721
1722   w := e_TextureFonts[FontID].CharWidth;
1723
1724   with e_TextureFonts[FontID] do
1725   begin
1726     glBindTexture(GL_TEXTURE_2D, e_TextureFonts[FontID].TextureID);
1727     glEnable(GL_TEXTURE_2D);
1728     glListBase(DWORD(Integer(e_TextureFonts[FontID].Base)-32));
1729
1730     glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
1731     glEnable(GL_BLEND);
1732
1733     for a := 1 to len do
1734     begin
1735       case Text[a] of
1736         {#10: // line feed
1737         begin
1738           TX := X;
1739           TY := TY + h;
1740           continue;
1741         end;}
1742         #1: // black
1743         begin
1744           c.R := 0; c.G := 0; c.B := 0;
1745           continue;
1746         end;
1747         #2: // white
1748         begin
1749           c.R := 255; c.G := 255; c.B := 255;
1750           continue;
1751         end;
1752         #3: // darker
1753         begin
1754           c.R := c.R div 2; c.G := c.G div 2; c.B := c.B  div 2;
1755           continue;
1756         end;
1757         #4: // lighter
1758         begin
1759           c.R := Min(c.R * 2, 255); c.G := Min(c.G * 2, 255); c.B := Min(c.B * 2, 255);
1760           continue;
1761         end;
1762         #18: // red
1763         begin
1764           c.R := 255; c.G := 0; c.B := 0;
1765           continue;
1766         end;
1767         #19: // green
1768         begin
1769           c.R := 0; c.G := 255; c.B := 0;
1770           continue;
1771         end;
1772         #20: // blue
1773         begin
1774           c.R := 0; c.G := 0; c.B := 255;
1775           continue;
1776         end;
1777         #21: // yellow
1778         begin
1779           c.R := 255; c.G := 255; c.B := 0;
1780           continue;
1781         end;
1782       end;
1783
1784       tc := e_Colors;
1785       e_Colors := c;
1786       e_TextureFontPrintChar(TX, TY, Text[a], FontID, Shadow);
1787       e_Colors := tc;
1788
1789       TX := TX+w;
1790     end;
1791     glDisable(GL_TEXTURE_2D);
1792     glDisable(GL_BLEND);
1793   end;
1794 {$ENDIF}
1795 end;
1796
1797 procedure e_TextureFontPrintEx(X, Y: GLint; Text: string; FontID: DWORD; Red, Green,
1798                     Blue: Byte; Scale: Single; Shadow: Boolean = False);
1799 begin
1800 {$IFNDEF USE_NANOGL} // FIXIT: nanoGL doesn't support gl-lists
1801   if e_NoGraphics then Exit;
1802   if Text = '' then Exit;
1803
1804   glPushMatrix;
1805   glBindTexture(GL_TEXTURE_2D, e_TextureFonts[FontID].TextureID);
1806   glEnable(GL_TEXTURE_2D);
1807   glListBase(DWORD(Integer(e_TextureFonts[FontID].Base)-32));
1808
1809   glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
1810   glEnable(GL_BLEND);
1811
1812   if Shadow then
1813   begin
1814    glColor4ub(0, 0, 0, 128);
1815    glTranslated(x+1, y+1, 0);
1816    glScalef(Scale, Scale, 0);
1817    glCallLists(Length(Text), GL_UNSIGNED_BYTE, PChar(Text));
1818    glPopMatrix;
1819    glPushMatrix;
1820   end;
1821
1822   glColor4ub(Red, Green, Blue, 255);
1823   glTranslated(x, y, 0);
1824   glScalef(Scale, Scale, 0);
1825   glCallLists(Length(Text), GL_UNSIGNED_BYTE, PChar(Text));
1826
1827   glDisable(GL_TEXTURE_2D);
1828   glPopMatrix;
1829   glColor3ub(e_Colors.R, e_Colors.G, e_Colors.B);
1830   glDisable(GL_BLEND);
1831 {$ENDIF}
1832 end;
1833
1834 procedure e_TextureFontGetSize(ID: DWORD; out CharWidth, CharHeight: Byte);
1835 begin
1836   CharWidth := 16;
1837   CharHeight := 16;
1838   if e_NoGraphics then Exit;
1839   if Integer(ID) > High(e_TextureFonts) then
1840     Exit;
1841   CharWidth := e_TextureFonts[ID].CharWidth;
1842   CharHeight := e_TextureFonts[ID].CharHeight;
1843 end;
1844
1845 procedure e_RemoveAllTextureFont();
1846 var
1847  i: integer;
1848 begin
1849  if e_NoGraphics then Exit;
1850  if e_TextureFonts = nil then Exit;
1851
1852  for i := 0 to High(e_TextureFonts) do
1853   if e_TextureFonts[i].Base <> 0 then
1854   begin
1855 {$IFNDEF USE_NANOGL} // FIXIT: nanoGL doesn't support gl-lists
1856    glDeleteLists(e_TextureFonts[i].Base, 256);
1857 {$ENDIF}
1858    e_TextureFonts[i].Base := 0;
1859   end;
1860
1861  e_TextureFonts := nil;
1862 end;
1863
1864 function _RGB(Red, Green, Blue: Byte): TRGB;
1865 begin
1866  Result.R := Red;
1867  Result.G := Green;
1868  Result.B := Blue;
1869 end;
1870
1871 function _Point(X, Y: Integer): TPoint2i;
1872 begin
1873  Result.X := X;
1874  Result.Y := Y;
1875 end;
1876
1877 function _Rect(X, Y: Integer; Width, Height: Word): TRectWH;
1878 begin
1879  Result.X := X;
1880  Result.Y := Y;
1881  Result.Width := Width;
1882  Result.Height := Height;
1883 end;
1884
1885 function _TRect(L, T, R, B: LongInt): TRect;
1886 begin
1887  Result.Top := T;
1888  Result.Left := L;
1889  Result.Right := R;
1890  Result.Bottom := B;
1891 end;
1892
1893
1894 procedure e_MakeScreenshot (st: TStream; Width, Height: Word);
1895 var
1896   pixels, obuf, scln, ps, pd: PByte;
1897   obufsize: Integer;
1898   dlen: Cardinal;
1899   i, x, y, res: Integer;
1900   sign: array [0..7] of Byte;
1901   hbuf: array [0..12] of Byte;
1902   crc: LongWord;
1903   img: TImageData;
1904   clr: TColor32Rec;
1905 begin
1906   if e_NoGraphics then Exit;
1907   obuf := nil;
1908
1909   // first, extract and pack graphics data
1910   if (Width mod 4) > 0 then Width := Width+4-(Width mod 4);
1911
1912   GetMem(pixels, Width*Height*3);
1913   try
1914     FillChar(pixels^, Width*Height*3, 0);
1915     glReadPixels(0, 0, Width, Height, GL_RGB, GL_UNSIGNED_BYTE, pixels);
1916     //e_WriteLog('PNG: pixels read', MSG_NOTIFY);
1917
1918     if e_FastScreenshots then
1919     begin
1920       // create scanlines
1921       GetMem(scln, (Width*3+1)*Height);
1922       try
1923         ps := pixels;
1924         pd := scln;
1925         Inc(ps, (Width*3)*(Height-1));
1926         for i := 0 to Height-1 do
1927         begin
1928           pd^ := 0; // filter
1929           Inc(pd);
1930           Move(ps^, pd^, Width*3);
1931           Dec(ps, Width*3);
1932           Inc(pd, Width*3);
1933         end;
1934       except
1935         FreeMem(scln);
1936         raise;
1937       end;
1938       FreeMem(pixels);
1939       pixels := scln;
1940
1941       // pack it
1942       obufsize := (Width*3+1)*Height*2;
1943       GetMem(obuf, obufsize);
1944       try
1945         while true do
1946         begin
1947           dlen := obufsize;
1948           res := compress2(Pointer(obuf), dlen, Pointer(pixels), (Width*3+1)*Height, 9);
1949           if res = Z_OK then break;
1950           if res <> Z_BUF_ERROR then raise Exception.Create('can''t pack data for PNG');
1951           obufsize := obufsize*2;
1952           FreeMem(obuf);
1953           obuf := nil;
1954           GetMem(obuf, obufsize);
1955         end;
1956         //e_WriteLog(Format('PNG: pixels compressed from %d to %d', [Integer(Width*Height*3), Integer(dlen)]), MSG_NOTIFY);
1957
1958         // now write PNG
1959
1960         // signature
1961         sign[0] := 137;
1962         sign[1] := 80;
1963         sign[2] := 78;
1964         sign[3] := 71;
1965         sign[4] := 13;
1966         sign[5] := 10;
1967         sign[6] := 26;
1968         sign[7] := 10;
1969         st.writeBuffer(sign, 8);
1970         //e_WriteLog('PNG: signature written', MSG_NOTIFY);
1971
1972         // header
1973         writeIntBE(st, LongWord(13));
1974         sign[0] := 73;
1975         sign[1] := 72;
1976         sign[2] := 68;
1977         sign[3] := 82;
1978         st.writeBuffer(sign, 4);
1979         crc := crc32(0, @sign[0], 4);
1980         hbuf[0] := 0;
1981         hbuf[1] := 0;
1982         hbuf[2] := (Width shr 8) and $ff;
1983         hbuf[3] := Width and $ff;
1984         hbuf[4] := 0;
1985         hbuf[5] := 0;
1986         hbuf[6] := (Height shr 8) and $ff;
1987         hbuf[7] := Height and $ff;
1988         hbuf[8] := 8; // bit depth
1989         hbuf[9] := 2; // RGB
1990         hbuf[10] := 0; // compression method
1991         hbuf[11] := 0; // filter method
1992         hbuf[12] := 0; // no interlace
1993         crc := crc32(crc, @hbuf[0], 13);
1994         st.writeBuffer(hbuf, 13);
1995         writeIntBE(st, crc);
1996         //e_WriteLog('PNG: header written', MSG_NOTIFY);
1997
1998         // image data
1999         writeIntBE(st, LongWord(dlen));
2000         sign[0] := 73;
2001         sign[1] := 68;
2002         sign[2] := 65;
2003         sign[3] := 84;
2004         st.writeBuffer(sign, 4);
2005         crc := crc32(0, @sign[0], 4);
2006         crc := crc32(crc, obuf, dlen);
2007         st.writeBuffer(obuf^, dlen);
2008         writeIntBE(st, crc);
2009         //e_WriteLog('PNG: image data written', MSG_NOTIFY);
2010
2011         // image data end
2012         writeIntBE(st, LongWord(0));
2013         sign[0] := 73;
2014         sign[1] := 69;
2015         sign[2] := 78;
2016         sign[3] := 68;
2017         st.writeBuffer(sign, 4);
2018         crc := crc32(0, @sign[0], 4);
2019         writeIntBE(st, crc);
2020         //e_WriteLog('PNG: end marker written', MSG_NOTIFY);
2021       finally
2022         if obuf <> nil then FreeMem(obuf);
2023       end;
2024     end
2025     else
2026     begin
2027       Imaging.SetOption(ImagingPNGCompressLevel, 9);
2028       Imaging.SetOption(ImagingPNGPreFilter, 6);
2029       InitImage(img);
2030       try
2031         NewImage(Width, Height, TImageFormat.ifR8G8B8, img);
2032         ps := pixels;
2033         //writeln(stderr, 'moving pixels...');
2034         for y := Height-1 downto 0 do
2035         begin
2036           for x := 0 to Width-1 do
2037           begin
2038             clr.r := ps^; Inc(ps);
2039             clr.g := ps^; Inc(ps);
2040             clr.b := ps^; Inc(ps);
2041             clr.a := 255;
2042             SetPixel32(img, x, y, clr);
2043           end;
2044         end;
2045         GlobalMetadata.ClearMetaItems();
2046         GlobalMetadata.ClearMetaItemsForSaving();
2047         //writeln(stderr, 'compressing image...');
2048         if not SaveImageToStream('png', st, img) then raise Exception.Create('screenshot writing error');
2049         //writeln(stderr, 'done!');
2050       finally
2051         FreeImage(img);
2052       end;
2053     end;
2054   finally
2055     FreeMem(pixels);
2056   end;
2057 end;
2058
2059
2060 end.