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; scale: Single);
  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
 687 //TODO: overflow checks
 688 function intersectRect (var x0, y0, w0, h0: Integer; const x1, y1, w1, h1: Integer): Boolean;
 689 var
 690   ex0, ey0: Integer;
 691 begin
 692   result := false;
 693   if (w0 < 1) or (h0 < 1) or (w1 < 1) or (h1 < 1) then exit;
 694   // check for intersection
 695   if (x0+w0 <= x1) or (y0+h0 <= y1) or (x1+w1 <= x0) or (y1+h1 <= y0) then exit;
 696   if (x0 >= x1+w1) or (y0 >= y1+h1) or (x1 >= x0+h0) or (y1 >= y0+h0) then exit;
 697   // ok, intersects
 698   ex0 := x0+w0;
 699   ey0 := y0+h0;
 700   if (x0 < x1) then x0 := x1;
 701   if (y0 < y1) then y0 := y1;
 702   if (ex0 > x1+w1) then ex0 := x1+w1;
 703   if (ey0 > y1+h1) then ey0 := y1+h1;
 704   w0 := ex0-x0;
 705   h0 := ey0-y0;
 706   result := (w0 > 0) and (h0 > 0);
 707 end;
 708
 709
 710 procedure e_DrawFillX (id: DWORD; x, y, wdt, hgt: Integer; alpha: Integer; alphachannel: Boolean; blending: Boolean; scale: Single);
 711 var
 712   x2, y2: Integer;
 713   {
 714   wassc: Boolean;
 715   scxywh: array[0..3] of GLint;
 716   vpxywh: array[0..3] of GLint;
 717   }
 718   w, h, dw, cw, ch: Integer;
 719   u, v, cu, cv: Single;
 720
 721   {
 722   procedure setScissorGLInternal (x, y, w, h: Integer);
 723   begin
 724     //if not scallowed then exit;
 725     x := trunc(x*scale);
 726     y := trunc(y*scale);
 727     w := trunc(w*scale);
 728     h := trunc(h*scale);
 729     y := vpxywh[3]-(y+h);
 730     if not intersectRect(x, y, w, h, scxywh[0], scxywh[1], scxywh[2], scxywh[3]) then
 731     begin
 732       glScissor(0, 0, 0, 0);
 733     end
 734     else
 735     begin
 736       //writeln('  (', x, ',', y, ')-(', w, ',', h, ')');
 737       glScissor(x, y, w, h);
 738     end;
 739   end;
 740   }
 741
 742 begin
 743   if e_NoGraphics then exit;
 744
 745   if (wdt < 1) or (hgt < 1) then exit;
 746
 747   if (wdt mod e_Textures[ID].tx.width = 0) and (hgt mod e_Textures[ID].tx.height = 0) then
 748   begin
 749     e_DrawFill(id, x, y, wdt div e_Textures[ID].tx.width, hgt div e_Textures[ID].tx.height, alpha, alphachannel, blending);
 750     exit;
 751   end;
 752
 753   glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255);
 754
 755   if (Alpha > 0) or AlphaChannel or Blending then
 756     glEnable(GL_BLEND)
 757   else
 758     glDisable(GL_BLEND);
 759
 760   if AlphaChannel or (Alpha > 0) then glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
 761
 762   if (Alpha > 0) then glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255-Alpha);
 763
 764   if Blending then glBlendFunc(GL_SRC_ALPHA, GL_ONE);
 765
 766   glEnable(GL_TEXTURE_2D);
 767   glBindTexture(GL_TEXTURE_2D, e_Textures[ID].tx.id);
 768
 769   x2 := x+wdt;
 770   y2 := y+hgt;
 771
 772   //k8: this SHOULD work... i hope
 773   if (e_Textures[ID].tx.width = e_Textures[ID].tx.glwidth) and (e_Textures[ID].tx.height = e_Textures[ID].tx.glheight) then
 774   begin
 775     glBegin(GL_QUADS);
 776       glTexCoord2f(0, hgt/e_Textures[ID].tx.height); glVertex2i(x,  y);
 777       glTexCoord2f(wdt/e_Textures[ID].tx.width, hgt/e_Textures[ID].tx.height); glVertex2i(x2, y);
 778       glTexCoord2f(wdt/e_Textures[ID].tx.width, 0); glVertex2i(x2, y2);
 779       glTexCoord2f(0, 0); glVertex2i(x, y2);
 780     glEnd();
 781   end
 782   else
 783   begin
 784     // hard day's night; setup scissor
 785     {
 786     glGetIntegerv(GL_VIEWPORT, @vpxywh[0]);
 787     wassc := (glIsEnabled(GL_SCISSOR_TEST) <> 0);
 788     if wassc then glGetIntegerv(GL_SCISSOR_BOX, @scxywh[0]) else glGetIntegerv(GL_VIEWPORT, @scxywh[0]);
 789     //writeln('(', scxywh[0], ',', scxywh[1], ')-(', scxywh[2], ',', scxywh[3], ')');
 790     //glEnable(GL_SCISSOR_TEST);
 791     setScissorGLInternal(x, y, wdt, hgt);
 792     }
 793     // draw quads
 794     u := e_Textures[ID].tx.u;
 795     v := e_Textures[ID].tx.v;
 796     w := e_Textures[ID].tx.width;
 797     h := e_Textures[ID].tx.height;
 798     x2 := x;
 799     glBegin(GL_QUADS);
 800     while (hgt > 0) do
 801     begin
 802       if (hgt >= h) then begin ch := h; cv := v; end else begin ch := hgt; cv := v/(h/hgt) end;
 803       Dec(hgt, h);
 804       dw := wdt;
 805       x := x2;
 806       while (dw > 0) do
 807       begin
 808         if (dw >= w) then begin cw := w; cu := u; end else begin cw := dw; cu := u/(w/dw) end;
 809         Dec(dw, w);
 810         glTexCoord2f(0, cv); glVertex2i(X,   Y);
 811         glTexCoord2f(cu, cv); glVertex2i(X+cw, Y);
 812         glTexCoord2f(cu, 0); glVertex2i(X+cw, Y+ch);
 813         glTexCoord2f(0, 0); glVertex2i(X,   Y+ch);
 814         Inc(X, w);
 815       end;
 816       Inc(Y, h);
 817     end;
 818     glEnd();
 819     //if wassc then glEnable(GL_SCISSOR_TEST) else glDisable(GL_SCISSOR_TEST);
 820   end;
 821
 822   glDisable(GL_BLEND);
 823 end;
 824
 825
 826 procedure e_DrawAdv(ID: DWORD; X, Y: Integer; Alpha: Byte; AlphaChannel: Boolean;
 827                     Blending: Boolean; Angle: Single; RC: PDFPoint; Mirror: TMirrorType = M_NONE);
 828 begin
 829   if e_NoGraphics then Exit;
 830
 831   glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255);
 832
 833   if (Alpha > 0) or (AlphaChannel) or (Blending) then
 834     glEnable(GL_BLEND)
 835   else
 836     glDisable(GL_BLEND);
 837
 838   if (AlphaChannel) or (Alpha > 0) then
 839     glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
 840
 841   if Alpha > 0 then
 842     glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255-Alpha);
 843
 844   if Blending then
 845     glBlendFunc(GL_SRC_ALPHA, GL_ONE);
 846
 847   if (Angle <> 0) and (RC <> nil) then
 848   begin
 849     glPushMatrix();
 850     glTranslatef(X+RC.X, Y+RC.Y, 0);
 851     glRotatef(Angle, 0, 0, 1);
 852     glTranslatef(-(X+RC.X), -(Y+RC.Y), 0);
 853   end;
 854
 855   glEnable(GL_TEXTURE_2D);
 856   glBindTexture(GL_TEXTURE_2D, e_Textures[id].tx.id);
 857   glBegin(GL_QUADS);                           //0-1        1-1
 858                                                //00         10
 859   drawTxQuad(X, Y, e_Textures[id].tx.width, e_Textures[id].tx.height, e_Textures[ID].tx.u, e_Textures[ID].tx.v, Mirror);
 860   glEnd();
 861
 862   if Angle <> 0 then
 863     glPopMatrix();
 864
 865   glDisable(GL_BLEND);
 866 end;
 867
 868 procedure e_DrawPoint(Size: Byte; X, Y: Integer; Red, Green, Blue: Byte);
 869 begin
 870   if e_NoGraphics then Exit;
 871   glDisable(GL_TEXTURE_2D);
 872   glColor3ub(Red, Green, Blue);
 873   glPointSize(Size);
 874
 875   if (Size = 2) or (Size = 4) then
 876     X := X + 1;
 877
 878   glBegin(GL_POINTS);
 879     glVertex2f(X+0.3, Y+1.0);
 880   glEnd();
 881
 882   glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255);
 883 end;
 884
 885 procedure e_LineCorrection(var X1, Y1, X2, Y2: Integer);
 886 begin
 887   // Make lines only top-left/bottom-right and top-right/bottom-left
 888   if Y2 < Y1 then
 889   begin
 890     X1 := X1 xor X2;
 891     X2 := X1 xor X2;
 892     X1 := X1 xor X2;
 893
 894     Y1 := Y1 xor Y2;
 895     Y2 := Y1 xor Y2;
 896     Y1 := Y1 xor Y2;
 897   end;
 898
 899   // Pixel-perfect hack
 900   if X1 < X2 then
 901     Inc(X2)
 902   else
 903     Inc(X1);
 904   Inc(Y2);
 905 end;
 906
 907 procedure e_DrawQuad(X1, Y1, X2, Y2: Integer; Red, Green, Blue: Byte; Alpha: Byte = 0);
 908 var
 909   nX1, nY1, nX2, nY2: Integer;
 910 begin
 911   if e_NoGraphics then Exit;
 912   // Only top-left/bottom-right quad
 913   if X1 > X2 then
 914   begin
 915     X1 := X1 xor X2;
 916     X2 := X1 xor X2;
 917     X1 := X1 xor X2;
 918   end;
 919   if Y1 > Y2 then
 920   begin
 921     Y1 := Y1 xor Y2;
 922     Y2 := Y1 xor Y2;
 923     Y1 := Y1 xor Y2;
 924   end;
 925
 926   if Alpha > 0 then
 927   begin
 928     glEnable(GL_BLEND);
 929     glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
 930   end else
 931     glDisable(GL_BLEND);
 932
 933   glDisable(GL_TEXTURE_2D);
 934   glColor4ub(Red, Green, Blue, 255-Alpha);
 935   glLineWidth(1);
 936
 937   glBegin(GL_LINES);
 938     nX1 := X1; nY1 := Y1;
 939     nX2 := X2; nY2 := Y1;
 940     e_LineCorrection(nX1, nY1, nX2, nY2); // Pixel-perfect lines
 941     glVertex2i(nX1, nY1);
 942     glVertex2i(nX2, nY2);
 943
 944     nX1 := X2; nY1 := Y1;
 945     nX2 := X2; nY2 := Y2;
 946     e_LineCorrection(nX1, nY1, nX2, nY2);
 947     glVertex2i(nX1, nY1);
 948     glVertex2i(nX2, nY2);
 949
 950     nX1 := X2; nY1 := Y2;
 951     nX2 := X1; nY2 := Y2;
 952     e_LineCorrection(nX1, nY1, nX2, nY2);
 953     glVertex2i(nX1, nY1);
 954     glVertex2i(nX2, nY2);
 955
 956     nX1 := X1; nY1 := Y2;
 957     nX2 := X1; nY2 := Y1;
 958     e_LineCorrection(nX1, nY1, nX2, nY2);
 959     glVertex2i(nX1, nY1);
 960     glVertex2i(nX2, nY2);
 961   glEnd();
 962
 963   glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255);
 964
 965   glDisable(GL_BLEND);
 966 end;
 967
 968 procedure e_DrawFillQuad(X1, Y1, X2, Y2: Integer; Red, Green, Blue, Alpha: Byte;
 969                          Blending: TBlending = B_NONE);
 970 begin
 971   if e_NoGraphics then Exit;
 972   if (Alpha > 0) or (Blending <> B_NONE) then
 973     glEnable(GL_BLEND)
 974   else
 975     glDisable(GL_BLEND);
 976
 977   if Blending = B_BLEND then
 978     glBlendFunc(GL_SRC_ALPHA, GL_ONE)
 979   else
 980     if Blending = B_FILTER then
 981       glBlendFunc(GL_DST_COLOR, GL_SRC_COLOR)
 982     else
 983       if Blending = B_INVERT then
 984         glBlendFunc(GL_ONE_MINUS_DST_COLOR, GL_ZERO)
 985       else
 986         if Alpha > 0 then
 987           glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
 988
 989   glDisable(GL_TEXTURE_2D);
 990   glColor4ub(Red, Green, Blue, 255-Alpha);
 991
 992   X2 := X2 + 1;
 993   Y2 := Y2 + 1;
 994
 995   glBegin(GL_QUADS);
 996     glVertex2i(X1, Y1);
 997     glVertex2i(X2, Y1);
 998     glVertex2i(X2, Y2);
 999     glVertex2i(X1, Y2);
1000   glEnd();
1001
1002   glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255);
1003
1004   glDisable(GL_BLEND);
1005 end;
1006
1007
1008 // ////////////////////////////////////////////////////////////////////////// //
1009 procedure e_DarkenQuad (x0, y0, x1, y1: Integer; a: Integer);
1010 begin
1011   if (a < 0) then a := 0;
1012   if (a > 255) then a := 255;
1013   glEnable(GL_BLEND);
1014   glBlendFunc(GL_ZERO, GL_SRC_ALPHA);
1015   glDisable(GL_TEXTURE_2D);
1016   glColor4ub(0, 0, 0, Byte(255-a));
1017   glBegin(GL_QUADS);
1018     glVertex2i(x0, y0);
1019     glVertex2i(x1, y0);
1020     glVertex2i(x1, y1);
1021     glVertex2i(x0, y1);
1022   glEnd();
1023   //glRect(x, y, x+w, y+h);
1024   glColor4ub(1, 1, 1, 1);
1025   glDisable(GL_BLEND);
1026   //glBlendEquation(GL_FUNC_ADD);
1027 end;
1028
1029 procedure e_DarkenQuadWH (x, y, w, h: Integer; a: Integer);
1030 begin
1031   if (w > 0) and (h > 0) then e_DarkenQuad(x, y, x+w, y+h, a);
1032 end;
1033
1034
1035 procedure e_DrawLine(Width: Byte; X1, Y1, X2, Y2: Integer; Red, Green, Blue: Byte; Alpha: Byte = 0);
1036 begin
1037   if e_NoGraphics then Exit;
1038   // Pixel-perfect lines
1039   if Width = 1 then
1040     e_LineCorrection(X1, Y1, X2, Y2);
1041
1042   if Alpha > 0 then
1043   begin
1044     glEnable(GL_BLEND);
1045     glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
1046   end else
1047     glDisable(GL_BLEND);
1048
1049   glDisable(GL_TEXTURE_2D);
1050   glColor4ub(Red, Green, Blue, 255-Alpha);
1051   glLineWidth(Width);
1052
1053   glBegin(GL_LINES);
1054     glVertex2i(X1, Y1);
1055     glVertex2i(X2, Y2);
1056   glEnd();
1057
1058   glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255);
1059
1060   glDisable(GL_BLEND);
1061 end;
1062
1063 //------------------------------------------------------------------
1064 // Óäàëÿåò òåêñòóðó èç ìàññèâà
1065 //------------------------------------------------------------------
1066 procedure e_DeleteTexture(ID: DWORD);
1067 begin
1068   if not e_NoGraphics then
1069     glDeleteTextures(1, @e_Textures[ID].tx.id);
1070   e_Textures[ID].tx.id := 0;
1071   e_Textures[ID].tx.Width := 0;
1072   e_Textures[ID].tx.Height := 0;
1073 end;
1074
1075 //------------------------------------------------------------------
1076 // Óäàëÿåò âñå òåêñòóðû
1077 //------------------------------------------------------------------
1078 procedure e_RemoveAllTextures();
1079 var
1080   i: integer;
1081 begin
1082  if e_Textures = nil then Exit;
1083
1084  for i := 0 to High(e_Textures) do
1085   if e_Textures[i].tx.Width <> 0 then e_DeleteTexture(i);
1086  e_Textures := nil;
1087 end;
1088
1089 //------------------------------------------------------------------
1090 // Óäàëÿåò äâèæîê
1091 //------------------------------------------------------------------
1092 procedure e_ReleaseEngine();
1093 begin
1094  e_RemoveAllTextures;
1095  e_RemoveAllTextureFont;
1096 end;
1097
1098 procedure e_BeginRender();
1099 begin
1100   if e_NoGraphics then Exit;
1101   glEnable(GL_ALPHA_TEST);
1102   glAlphaFunc(GL_GREATER, 0.0);
1103 end;
1104
1105 procedure e_Clear(Mask: TGLbitfield; Red, Green, Blue: Single); overload;
1106 begin
1107   if e_NoGraphics then Exit;
1108   glClearColor(Red, Green, Blue, 0);
1109   glClear(Mask);
1110 end;
1111
1112 procedure e_Clear(); overload;
1113 begin
1114   if e_NoGraphics then Exit;
1115   glClearColor(0, 0, 0, 0);
1116   glClear(GL_COLOR_BUFFER_BIT);
1117 end;
1118
1119 procedure e_EndRender();
1120 begin
1121   if e_NoGraphics then Exit;
1122   glPopMatrix();
1123 end;
1124
1125 function e_GetGamma(win: PSDL_Window): Byte;
1126 var
1127   ramp: array [0..256*3-1] of Word;
1128   rgb: array [0..2] of Double;
1129   sum: double;
1130   count: integer;
1131   min: integer;
1132   max: integer;
1133   A, B: double;
1134   i, j: integer;
1135 begin
1136  Result := 0;
1137  if e_NoGraphics then Exit;
1138  rgb[0] := 1.0;
1139  rgb[1] := 1.0;
1140  rgb[2] := 1.0;
1141
1142  SDL_GetWindowGammaRamp(win, @ramp[0], @ramp[256], @ramp[512]);
1143
1144  for i := 0 to 2 do
1145  begin
1146   sum := 0;
1147   count := 0;
1148   min := 256 * i;
1149   max := min + 256;
1150
1151   for j := min to max - 1 do
1152   if ramp[j] > 0 then
1153   begin
1154    B := (j mod 256)/256;
1155    A := ramp[j]/65536;
1156    sum := sum + ln(A)/ln(B);
1157    inc(count);
1158   end;
1159   rgb[i] := sum / count;
1160  end;
1161
1162  Result := 100 - Trunc(((rgb[0] + rgb[1] + rgb[2])/3 - 0.23) * 100/(2.7 - 0.23));
1163 end;
1164
1165 procedure e_SetGamma(win: PSDL_Window; Gamma: Byte);
1166 var
1167   ramp: array [0..256*3-1] of Word;
1168   i: integer;
1169   r: double;
1170   g: double;
1171 begin
1172  if e_NoGraphics then Exit;
1173  g := (100 - Gamma)*(2.7 - 0.23)/100 + 0.23;
1174
1175  for i := 0 to 255 do
1176  begin
1177   r := Exp(g * ln(i/256))*65536;
1178   if r < 0 then r := 0
1179    else if r > 65535 then r := 65535;
1180   ramp[i] := trunc(r);
1181   ramp[i + 256] := trunc(r);
1182   ramp[i + 512] := trunc(r);
1183  end;
1184
1185  SDL_SetWindowGammaRamp(win, @ramp[0], @ramp[256], @ramp[512]);
1186 end;
1187
1188 function e_CharFont_Create(sp: ShortInt=0): DWORD;
1189 var
1190   i, id: DWORD;
1191 begin
1192  e_WriteLog('Creating CharFont...', MSG_NOTIFY);
1193
1194  id := DWORD(-1);
1195
1196  if e_CharFonts <> nil then
1197  for i := 0 to High(e_CharFonts) do
1198   if not e_CharFonts[i].alive then
1199   begin
1200    id := i;
1201    Break;
1202   end;
1203
1204  if id = DWORD(-1) then
1205  begin
1206   SetLength(e_CharFonts, Length(e_CharFonts) + 1);
1207   id := High(e_CharFonts);
1208  end;
1209
1210  with e_CharFonts[id] do
1211  begin
1212   for i := 0 to High(Chars) do
1213    with Chars[i] do
1214    begin
1215     TextureID := -1;
1216     Width := 0;
1217    end;
1218
1219   Space := sp;
1220   alive := True;
1221  end;
1222
1223  Result := id;
1224 end;
1225
1226 procedure e_CharFont_AddChar(FontID: DWORD; Texture: Integer; c: Char; w: Byte);
1227 begin
1228  with e_CharFonts[FontID].Chars[Ord(c)] do
1229  begin
1230   TextureID := Texture;
1231   Width := w;
1232  end;
1233 end;
1234
1235 procedure e_CharFont_Print(FontID: DWORD; X, Y: Integer; Text: string);
1236 var
1237   a: Integer;
1238 begin
1239  if e_NoGraphics then Exit;
1240  if Text = '' then Exit;
1241  if e_CharFonts = nil then Exit;
1242  if Integer(FontID) > High(e_CharFonts) then Exit;
1243
1244  with e_CharFonts[FontID] do
1245  begin
1246   for a := 1 to Length(Text) do
1247    with Chars[Ord(Text[a])] do
1248    if TextureID <> -1 then
1249    begin
1250     e_Draw(TextureID, X, Y, 0, True, False);
1251     X := X+Width+IfThen(a = Length(Text), 0, Space);
1252    end;
1253  end;
1254 end;
1255
1256 procedure e_CharFont_PrintEx(FontID: DWORD; X, Y: Integer; Text: string;
1257                              Color: TRGB; Scale: Single = 1.0);
1258 var
1259   a: Integer;
1260   c: TRGB;
1261 begin
1262  if e_NoGraphics then Exit;
1263  if Text = '' then Exit;
1264  if e_CharFonts = nil then Exit;
1265  if Integer(FontID) > High(e_CharFonts) then Exit;
1266
1267  with e_CharFonts[FontID] do
1268  begin
1269   for a := 1 to Length(Text) do
1270    with Chars[Ord(Text[a])] do
1271    if TextureID <> -1 then
1272    begin
1273     if Scale <> 1.0 then
1274     begin
1275      glPushMatrix;
1276      glScalef(Scale, Scale, 0);
1277     end;
1278
1279     c := e_Colors;
1280     e_Colors := Color;
1281     e_Draw(TextureID, X, Y, 0, True, False);
1282     e_Colors := c;
1283
1284     if Scale <> 1.0 then glPopMatrix;
1285
1286     X := X+Width+IfThen(a = Length(Text), 0, Space);
1287    end;
1288  end;
1289 end;
1290
1291 procedure e_CharFont_PrintFmt(FontID: DWORD; X, Y: Integer; Text: string);
1292 var
1293   a, TX, TY, len: Integer;
1294   tc, c: TRGB;
1295   w, h: Word;
1296 begin
1297   if e_NoGraphics then Exit;
1298   if Text = '' then Exit;
1299   if e_CharFonts = nil then Exit;
1300   if Integer(FontID) > High(e_CharFonts) then Exit;
1301
1302   c.R := 255;
1303   c.G := 255;
1304   c.B := 255;
1305
1306   TX := X;
1307   TY := Y;
1308   len := Length(Text);
1309
1310   e_CharFont_GetSize(FontID, 'A', w, h);
1311
1312   with e_CharFonts[FontID] do
1313   begin
1314     for a := 1 to len do
1315     begin
1316       case Text[a] of
1317         #10: // line feed
1318         begin
1319           TX := X;
1320           TY := TY + h;
1321           continue;
1322         end;
1323         #1: // black
1324         begin
1325           c.R := 0; c.G := 0; c.B := 0;
1326           continue;
1327         end;
1328         #2: // white
1329         begin
1330           c.R := 255; c.G := 255; c.B := 255;
1331           continue;
1332         end;
1333         #3: // darker
1334         begin
1335           c.R := c.R div 2; c.G := c.G div 2; c.B := c.B div 2;
1336           continue;
1337         end;
1338         #4: // lighter
1339         begin
1340           c.R := Min(c.R * 2, 255); c.G := Min(c.G * 2, 255); c.B := Min(c.B * 2, 255);
1341           continue;
1342         end;
1343         #18: // red
1344         begin
1345           c.R := 255; c.G := 0; c.B := 0;
1346           continue;
1347         end;
1348         #19: // green
1349         begin
1350           c.R := 0; c.G := 255; c.B := 0;
1351           continue;
1352         end;
1353         #20: // blue
1354         begin
1355           c.R := 0; c.G := 0; c.B := 255;
1356           continue;
1357         end;
1358         #21: // yellow
1359         begin
1360           c.R := 255; c.G := 255; c.B := 0;
1361           continue;
1362         end;
1363       end;
1364
1365       with Chars[Ord(Text[a])] do
1366       if TextureID <> -1 then
1367       begin
1368         tc := e_Colors;
1369         e_Colors := c;
1370         e_Draw(TextureID, TX, TY, 0, True, False);
1371         e_Colors := tc;
1372
1373         TX := TX+Width+IfThen(a = Length(Text), 0, Space);
1374       end;
1375     end;
1376   end;
1377 end;
1378
1379 procedure e_CharFont_GetSize(FontID: DWORD; Text: string; var w, h: Word);
1380 var
1381   a: Integer;
1382   h2: Word;
1383 begin
1384  w := 0;
1385  h := 0;
1386
1387  if Text = '' then Exit;
1388  if e_CharFonts = nil then Exit;
1389  if Integer(FontID) > High(e_CharFonts) then Exit;
1390
1391  with e_CharFonts[FontID] do
1392  begin
1393   for a := 1 to Length(Text) do
1394    with Chars[Ord(Text[a])] do
1395    if TextureID <> -1 then
1396    begin
1397     w := w+Width+IfThen(a = Length(Text), 0, Space);
1398     e_GetTextureSize(TextureID, nil, @h2);
1399     if h2 > h then h := h2;
1400    end;
1401  end;
1402 end;
1403
1404 procedure e_CharFont_GetSizeFmt(FontID: DWORD; Text: string; var w, h: Word);
1405 var
1406   a, lines, len: Integer;
1407   h2, w2: Word;
1408 begin
1409   w2 := 0;
1410   w := 0;
1411   h := 0;
1412
1413   if Text = '' then Exit;
1414   if e_CharFonts = nil then Exit;
1415   if Integer(FontID) > High(e_CharFonts) then Exit;
1416
1417   lines := 1;
1418   len := Length(Text);
1419
1420   with e_CharFonts[FontID] do
1421   begin
1422     for a := 1 to len do
1423     begin
1424       if Text[a] = #10 then
1425       begin
1426         Inc(lines);
1427         if w2 > w then
1428         begin
1429           w := w2;
1430           w2 := 0;
1431         end;
1432         continue;
1433       end
1434       else if Text[a] in [#1, #2, #3, #4, #18, #19, #20, #21] then
1435         continue;
1436
1437       with Chars[Ord(Text[a])] do
1438       if TextureID <> -1 then
1439       begin
1440         w2 := w2 + Width + IfThen(a = len, 0, Space);
1441         e_GetTextureSize(TextureID, nil, @h2);
1442         if h2 > h then h := h2;
1443       end;
1444     end;
1445   end;
1446
1447   if w2 > w then
1448     w := w2;
1449   h := h * lines;
1450 end;
1451
1452 function e_CharFont_GetMaxWidth(FontID: DWORD): Word;
1453 var
1454   a: Integer;
1455 begin
1456  Result := 0;
1457
1458  if e_CharFonts = nil then Exit;
1459  if Integer(FontID) > High(e_CharFonts) then Exit;
1460
1461  for a := 0 to High(e_CharFonts[FontID].Chars) do
1462   Result := Max(Result, e_CharFonts[FontID].Chars[a].Width);
1463 end;
1464
1465 function e_CharFont_GetMaxHeight(FontID: DWORD): Word;
1466 var
1467   a: Integer;
1468   h2: Word;
1469 begin
1470  Result := 0;
1471
1472  if e_CharFonts = nil then Exit;
1473  if Integer(FontID) > High(e_CharFonts) then Exit;
1474
1475  for a := 0 to High(e_CharFonts[FontID].Chars) do
1476  begin
1477   if e_CharFonts[FontID].Chars[a].TextureID <> -1 then
1478    e_GetTextureSize(e_CharFonts[FontID].Chars[a].TextureID, nil, @h2)
1479     else h2 := 0;
1480   if h2 > Result then Result := h2;
1481  end;
1482 end;
1483
1484 procedure e_CharFont_Remove(FontID: DWORD);
1485 var
1486   a: Integer;
1487 begin
1488  with e_CharFonts[FontID] do
1489   for a := 0 to High(Chars) do
1490    if Chars[a].TextureID <> -1 then e_DeleteTexture(Chars[a].TextureID);
1491
1492  e_CharFonts[FontID].alive := False;
1493 end;
1494
1495 procedure e_CharFont_RemoveAll();
1496 var
1497   a: Integer;
1498 begin
1499  if e_CharFonts = nil then Exit;
1500
1501  for a := 0 to High(e_CharFonts) do
1502   e_CharFont_Remove(a);
1503
1504  e_CharFonts := nil;
1505 end;
1506
1507 procedure e_TextureFontBuild(Tex: DWORD; var FontID: DWORD; XCount, YCount: Word;
1508                              Space: ShortInt=0);
1509 var
1510   loop1 : GLuint;
1511   cx, cy : real;
1512   i, id: DWORD;
1513 begin
1514  if e_NoGraphics then Exit;
1515  e_WriteLog('Creating texture font...', MSG_NOTIFY);
1516
1517  id := DWORD(-1);
1518
1519  if e_TextureFonts <> nil then
1520  for i := 0 to High(e_TextureFonts) do
1521   if e_TextureFonts[i].Base = 0 then
1522   begin
1523    id := i;
1524    Break;
1525   end;
1526
1527  if id = DWORD(-1) then
1528  begin
1529   SetLength(e_TextureFonts, Length(e_TextureFonts) + 1);
1530   id := High(e_TextureFonts);
1531  end;
1532
1533  with e_TextureFonts[id] do
1534  begin
1535   Base := glGenLists(XCount*YCount);
1536   TextureID := e_Textures[Tex].tx.id;
1537   CharWidth := (e_Textures[Tex].tx.Width div XCount)+Space;
1538   CharHeight := e_Textures[Tex].tx.Height div YCount;
1539   XC := XCount;
1540   YC := YCount;
1541   Texture := Tex;
1542   SPC := Space;
1543  end;
1544
1545  glBindTexture(GL_TEXTURE_2D, e_Textures[Tex].tx.id);
1546  for loop1 := 0 to XCount*YCount-1 do
1547  begin
1548   cx := (loop1 mod XCount)/XCount;
1549   cy := (loop1 div YCount)/YCount;
1550
1551   glNewList(e_TextureFonts[id].Base+loop1, GL_COMPILE);
1552    glBegin(GL_QUADS);
1553     glTexCoord2f(cx, 1.0-cy-1/YCount);
1554     glVertex2i(0, e_Textures[Tex].tx.Height div YCount);
1555
1556     glTexCoord2f(cx+1/XCount, 1.0-cy-1/YCount);
1557     glVertex2i(e_Textures[Tex].tx.Width div XCount, e_Textures[Tex].tx.Height div YCount);
1558
1559     glTexCoord2f(cx+1/XCount, 1.0-cy);
1560     glVertex2i(e_Textures[Tex].tx.Width div XCount, 0);
1561
1562     glTexCoord2f(cx, 1.0-cy);
1563     glVertex2i(0, 0);
1564    glEnd();
1565    glTranslated((e_Textures[Tex].tx.Width div XCount)+Space, 0, 0);
1566   glEndList();
1567  end;
1568
1569  FontID := id;
1570 end;
1571
1572 procedure e_TextureFontKill(FontID: DWORD);
1573 begin
1574   if e_NoGraphics then Exit;
1575   glDeleteLists(e_TextureFonts[FontID].Base, 256);
1576   e_TextureFonts[FontID].Base := 0;
1577 end;
1578
1579 procedure e_TextureFontPrint(X, Y: GLint; Text: string; FontID: DWORD);
1580 begin
1581   if e_NoGraphics then Exit;
1582   if Integer(FontID) > High(e_TextureFonts) then Exit;
1583   if Text = '' then Exit;
1584
1585   glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
1586   glEnable(GL_BLEND);
1587
1588   glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255);
1589
1590   glPushMatrix;
1591   glBindTexture(GL_TEXTURE_2D, e_TextureFonts[FontID].TextureID);
1592   glEnable(GL_TEXTURE_2D);
1593   glTranslated(x, y, 0);
1594   glListBase(DWORD(Integer(e_TextureFonts[FontID].Base)-32));
1595   glCallLists(Length(Text), GL_UNSIGNED_BYTE, PChar(Text));
1596   glDisable(GL_TEXTURE_2D);
1597   glPopMatrix;
1598
1599   glDisable(GL_BLEND);
1600 end;
1601
1602 // god forgive me for this, but i cannot figure out how to do it without lists
1603 procedure e_TextureFontPrintChar(X, Y: Integer; Ch: Char; FontID: DWORD; Shadow: Boolean = False);
1604 begin
1605   if e_NoGraphics then Exit;
1606   glPushMatrix;
1607
1608   if Shadow then
1609   begin
1610    glColor4ub(0, 0, 0, 128);
1611    glTranslated(X+1, Y+1, 0);
1612    glCallLists(1, GL_UNSIGNED_BYTE, @Ch);
1613    glPopMatrix;
1614    glPushMatrix;
1615   end;
1616
1617   glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255);
1618   glTranslated(X, Y, 0);
1619   glCallLists(1, GL_UNSIGNED_BYTE, @Ch);
1620
1621   glPopMatrix;
1622 end;
1623
1624 procedure e_TextureFontPrintCharEx (X, Y: Integer; Ch: Char; FontID: DWORD; Shadow: Boolean = False);
1625 begin
1626   glBindTexture(GL_TEXTURE_2D, e_TextureFonts[FontID].TextureID);
1627   glEnable(GL_TEXTURE_2D);
1628   //glListBase(DWORD(Integer(e_TextureFonts[FontID].Base)-32));
1629
1630   glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
1631   glEnable(GL_BLEND);
1632   e_TextureFontPrintChar(X, Y, Ch, FontID, Shadow);
1633   glDisable(GL_TEXTURE_2D);
1634   glDisable(GL_BLEND);
1635 end;
1636
1637 function e_TextureFontCharWidth (ch: Char; FontID: DWORD): Integer;
1638 begin
1639   result := e_TextureFonts[FontID].CharWidth;
1640 end;
1641
1642 procedure e_TextureFontPrintFmt(X, Y: Integer; Text: string; FontID: DWORD; Shadow: Boolean = False);
1643 var
1644   a, TX, TY, len: Integer;
1645   tc, c: TRGB;
1646   w: Word;
1647 begin
1648   if e_NoGraphics then Exit;
1649   if Text = '' then Exit;
1650   if e_TextureFonts = nil then Exit;
1651   if Integer(FontID) > High(e_TextureFonts) then Exit;
1652
1653   c.R := 255;
1654   c.G := 255;
1655   c.B := 255;
1656
1657   TX := X;
1658   TY := Y;
1659   len := Length(Text);
1660
1661   w := e_TextureFonts[FontID].CharWidth;
1662
1663   with e_TextureFonts[FontID] do
1664   begin
1665     glBindTexture(GL_TEXTURE_2D, e_TextureFonts[FontID].TextureID);
1666     glEnable(GL_TEXTURE_2D);
1667     glListBase(DWORD(Integer(e_TextureFonts[FontID].Base)-32));
1668
1669     glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
1670     glEnable(GL_BLEND);
1671
1672     for a := 1 to len do
1673     begin
1674       case Text[a] of
1675         {#10: // line feed
1676         begin
1677           TX := X;
1678           TY := TY + h;
1679           continue;
1680         end;}
1681         #1: // black
1682         begin
1683           c.R := 0; c.G := 0; c.B := 0;
1684           continue;
1685         end;
1686         #2: // white
1687         begin
1688           c.R := 255; c.G := 255; c.B := 255;
1689           continue;
1690         end;
1691         #3: // darker
1692         begin
1693           c.R := c.R div 2; c.G := c.G div 2; c.B := c.B  div 2;
1694           continue;
1695         end;
1696         #4: // lighter
1697         begin
1698           c.R := Min(c.R * 2, 255); c.G := Min(c.G * 2, 255); c.B := Min(c.B * 2, 255);
1699           continue;
1700         end;
1701         #18: // red
1702         begin
1703           c.R := 255; c.G := 0; c.B := 0;
1704           continue;
1705         end;
1706         #19: // green
1707         begin
1708           c.R := 0; c.G := 255; c.B := 0;
1709           continue;
1710         end;
1711         #20: // blue
1712         begin
1713           c.R := 0; c.G := 0; c.B := 255;
1714           continue;
1715         end;
1716         #21: // yellow
1717         begin
1718           c.R := 255; c.G := 255; c.B := 0;
1719           continue;
1720         end;
1721       end;
1722
1723       tc := e_Colors;
1724       e_Colors := c;
1725       e_TextureFontPrintChar(TX, TY, Text[a], FontID, Shadow);
1726       e_Colors := tc;
1727
1728       TX := TX+w;
1729     end;
1730     glDisable(GL_TEXTURE_2D);
1731     glDisable(GL_BLEND);
1732   end;
1733 end;
1734
1735 procedure e_TextureFontPrintEx(X, Y: GLint; Text: string; FontID: DWORD; Red, Green,
1736                     Blue: Byte; Scale: Single; Shadow: Boolean = False);
1737 begin
1738   if e_NoGraphics then Exit;
1739   if Text = '' then Exit;
1740
1741   glPushMatrix;
1742   glBindTexture(GL_TEXTURE_2D, e_TextureFonts[FontID].TextureID);
1743   glEnable(GL_TEXTURE_2D);
1744   glListBase(DWORD(Integer(e_TextureFonts[FontID].Base)-32));
1745
1746   glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
1747   glEnable(GL_BLEND);
1748
1749   if Shadow then
1750   begin
1751    glColor4ub(0, 0, 0, 128);
1752    glTranslated(x+1, y+1, 0);
1753    glScalef(Scale, Scale, 0);
1754    glCallLists(Length(Text), GL_UNSIGNED_BYTE, PChar(Text));
1755    glPopMatrix;
1756    glPushMatrix;
1757   end;
1758
1759   glColor4ub(Red, Green, Blue, 255);
1760   glTranslated(x, y, 0);
1761   glScalef(Scale, Scale, 0);
1762   glCallLists(Length(Text), GL_UNSIGNED_BYTE, PChar(Text));
1763
1764   glDisable(GL_TEXTURE_2D);
1765   glPopMatrix;
1766   glColor3ub(e_Colors.R, e_Colors.G, e_Colors.B);
1767   glDisable(GL_BLEND);
1768 end;
1769
1770 procedure e_TextureFontGetSize(ID: DWORD; out CharWidth, CharHeight: Byte);
1771 begin
1772   CharWidth := 16;
1773   CharHeight := 16;
1774   if e_NoGraphics then Exit;
1775   if Integer(ID) > High(e_TextureFonts) then
1776     Exit;
1777   CharWidth := e_TextureFonts[ID].CharWidth;
1778   CharHeight := e_TextureFonts[ID].CharHeight;
1779 end;
1780
1781 procedure e_RemoveAllTextureFont();
1782 var
1783  i: integer;
1784 begin
1785  if e_NoGraphics then Exit;
1786  if e_TextureFonts = nil then Exit;
1787
1788  for i := 0 to High(e_TextureFonts) do
1789   if e_TextureFonts[i].Base <> 0 then
1790   begin
1791    glDeleteLists(e_TextureFonts[i].Base, 256);
1792    e_TextureFonts[i].Base := 0;
1793   end;
1794
1795  e_TextureFonts := nil;
1796 end;
1797
1798 function _RGB(Red, Green, Blue: Byte): TRGB;
1799 begin
1800  Result.R := Red;
1801  Result.G := Green;
1802  Result.B := Blue;
1803 end;
1804
1805 function _Point(X, Y: Integer): TPoint2i;
1806 begin
1807  Result.X := X;
1808  Result.Y := Y;
1809 end;
1810
1811 function _Rect(X, Y: Integer; Width, Height: Word): TRectWH;
1812 begin
1813  Result.X := X;
1814  Result.Y := Y;
1815  Result.Width := Width;
1816  Result.Height := Height;
1817 end;
1818
1819 function _TRect(L, T, R, B: LongInt): TRect;
1820 begin
1821  Result.Top := T;
1822  Result.Left := L;
1823  Result.Right := R;
1824  Result.Bottom := B;
1825 end;
1826
1827
1828 procedure e_MakeScreenshot (st: TStream; Width, Height: Word);
1829 var
1830   pixels, obuf, scln, ps, pd: PByte;
1831   obufsize: Integer;
1832   dlen: Cardinal;
1833   i, x, y, res: Integer;
1834   sign: array [0..7] of Byte;
1835   hbuf: array [0..12] of Byte;
1836   crc: LongWord;
1837   img: TImageData;
1838   clr: TColor32Rec;
1839 begin
1840   if e_NoGraphics then Exit;
1841   obuf := nil;
1842
1843   // first, extract and pack graphics data
1844   if (Width mod 4) > 0 then Width := Width+4-(Width mod 4);
1845
1846   GetMem(pixels, Width*Height*3);
1847   try
1848     FillChar(pixels^, Width*Height*3, 0);
1849     glReadPixels(0, 0, Width, Height, GL_RGB, GL_UNSIGNED_BYTE, pixels);
1850     //e_WriteLog('PNG: pixels read', MSG_NOTIFY);
1851
1852     if e_FastScreenshots then
1853     begin
1854       // create scanlines
1855       GetMem(scln, (Width*3+1)*Height);
1856       try
1857         ps := pixels;
1858         pd := scln;
1859         Inc(ps, (Width*3)*(Height-1));
1860         for i := 0 to Height-1 do
1861         begin
1862           pd^ := 0; // filter
1863           Inc(pd);
1864           Move(ps^, pd^, Width*3);
1865           Dec(ps, Width*3);
1866           Inc(pd, Width*3);
1867         end;
1868       except
1869         FreeMem(scln);
1870         raise;
1871       end;
1872       FreeMem(pixels);
1873       pixels := scln;
1874
1875       // pack it
1876       obufsize := (Width*3+1)*Height*2;
1877       GetMem(obuf, obufsize);
1878       try
1879         while true do
1880         begin
1881           dlen := obufsize;
1882           res := compress2(Pointer(obuf), dlen, Pointer(pixels), (Width*3+1)*Height, 9);
1883           if res = Z_OK then break;
1884           if res <> Z_BUF_ERROR then raise Exception.Create('can''t pack data for PNG');
1885           obufsize := obufsize*2;
1886           FreeMem(obuf);
1887           obuf := nil;
1888           GetMem(obuf, obufsize);
1889         end;
1890         //e_WriteLog(Format('PNG: pixels compressed from %d to %d', [Integer(Width*Height*3), Integer(dlen)]), MSG_NOTIFY);
1891
1892         // now write PNG
1893
1894         // signature
1895         sign[0] := 137;
1896         sign[1] := 80;
1897         sign[2] := 78;
1898         sign[3] := 71;
1899         sign[4] := 13;
1900         sign[5] := 10;
1901         sign[6] := 26;
1902         sign[7] := 10;
1903         st.writeBuffer(sign, 8);
1904         //e_WriteLog('PNG: signature written', MSG_NOTIFY);
1905
1906         // header
1907         writeIntBE(st, LongWord(13));
1908         sign[0] := 73;
1909         sign[1] := 72;
1910         sign[2] := 68;
1911         sign[3] := 82;
1912         st.writeBuffer(sign, 4);
1913         crc := crc32(0, @sign[0], 4);
1914         hbuf[0] := 0;
1915         hbuf[1] := 0;
1916         hbuf[2] := (Width shr 8) and $ff;
1917         hbuf[3] := Width and $ff;
1918         hbuf[4] := 0;
1919         hbuf[5] := 0;
1920         hbuf[6] := (Height shr 8) and $ff;
1921         hbuf[7] := Height and $ff;
1922         hbuf[8] := 8; // bit depth
1923         hbuf[9] := 2; // RGB
1924         hbuf[10] := 0; // compression method
1925         hbuf[11] := 0; // filter method
1926         hbuf[12] := 0; // no interlace
1927         crc := crc32(crc, @hbuf[0], 13);
1928         st.writeBuffer(hbuf, 13);
1929         writeIntBE(st, crc);
1930         //e_WriteLog('PNG: header written', MSG_NOTIFY);
1931
1932         // image data
1933         writeIntBE(st, LongWord(dlen));
1934         sign[0] := 73;
1935         sign[1] := 68;
1936         sign[2] := 65;
1937         sign[3] := 84;
1938         st.writeBuffer(sign, 4);
1939         crc := crc32(0, @sign[0], 4);
1940         crc := crc32(crc, obuf, dlen);
1941         st.writeBuffer(obuf^, dlen);
1942         writeIntBE(st, crc);
1943         //e_WriteLog('PNG: image data written', MSG_NOTIFY);
1944
1945         // image data end
1946         writeIntBE(st, LongWord(0));
1947         sign[0] := 73;
1948         sign[1] := 69;
1949         sign[2] := 78;
1950         sign[3] := 68;
1951         st.writeBuffer(sign, 4);
1952         crc := crc32(0, @sign[0], 4);
1953         writeIntBE(st, crc);
1954         //e_WriteLog('PNG: end marker written', MSG_NOTIFY);
1955       finally
1956         if obuf <> nil then FreeMem(obuf);
1957       end;
1958     end
1959     else
1960     begin
1961       Imaging.SetOption(ImagingPNGCompressLevel, 9);
1962       Imaging.SetOption(ImagingPNGPreFilter, 6);
1963       InitImage(img);
1964       try
1965         NewImage(Width, Height, TImageFormat.ifR8G8B8, img);
1966         ps := pixels;
1967         //writeln(stderr, 'moving pixels...');
1968         for y := Height-1 downto 0 do
1969         begin
1970           for x := 0 to Width-1 do
1971           begin
1972             clr.r := ps^; Inc(ps);
1973             clr.g := ps^; Inc(ps);
1974             clr.b := ps^; Inc(ps);
1975             clr.a := 255;
1976             SetPixel32(img, x, y, clr);
1977           end;
1978         end;
1979         GlobalMetadata.ClearMetaItems();
1980         GlobalMetadata.ClearMetaItemsForSaving();
1981         //writeln(stderr, 'compressing image...');
1982         if not SaveImageToStream('png', st, img) then raise Exception.Create('screenshot writing error');
1983         //writeln(stderr, 'done!');
1984       finally
1985         FreeImage(img);
1986       end;
1987     end;
1988   finally
1989     FreeMem(pixels);
1990   end;
1991 end;
1992
1993
1994 end.