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