X-Git-Url: http://deadsoftware.ru/gitweb?a=blobdiff_plain;f=src%2Fengine%2Fe_graphics.pas;h=38154d6f21bbc3004795cd4fa710384123a67b2c;hb=00b8da997231db53bd66d2b10106cffd5e53fcd4;hp=f2afd54004adf64ac075f26888dab9c23298e371;hpb=56fe3537337bec115cae2b73922752488ff298a4;p=d2df-sdl.git

diff --git a/src/engine/e_graphics.pas b/src/engine/e_graphics.pas
index f2afd54..38154d6 100644
--- a/src/engine/e_graphics.pas
+++ b/src/engine/e_graphics.pas
@@ -1,9 +1,10 @@
+{$MODE DELPHI}
 unit e_graphics;
 
 interface
 
 uses
-  SysUtils, Math, e_log, e_textures, SDL2, GL, GLExt, MAPDEF;
+  SysUtils, Classes, Math, e_log, e_textures, SDL2, GL, GLExt, MAPDEF, ImagingTypes, Imaging, ImagingUtility;
 
 type
   TMirrorType=(M_NONE, M_HORIZONTAL, M_VERTICAL);
@@ -62,10 +63,11 @@ procedure e_DrawQuad(X1, Y1, X2, Y2: Integer; Red, Green, Blue: Byte; Alpha: Byt
 procedure e_DrawFillQuad(X1, Y1, X2, Y2: Integer; Red, Green, Blue, Alpha: Byte;
                          Blending: TBlending = B_NONE);
 
+function e_CreateTextureImg (var img: TImageData; var ID: DWORD): Boolean;
 function e_CreateTexture(FileName: string; var ID: DWORD): Boolean;
 function e_CreateTextureEx(FileName: string; var ID: DWORD; fX, fY, fWidth, fHeight: Word): Boolean;
-function e_CreateTextureMem(pData: Pointer; var ID: DWORD): Boolean;
-function e_CreateTextureMemEx(pData: Pointer; var ID: DWORD; fX, fY, fWidth, fHeight: Word): Boolean;
+function e_CreateTextureMem(pData: Pointer; dataSize: LongInt; var ID: DWORD): Boolean;
+function e_CreateTextureMemEx(pData: Pointer; dataSize: LongInt; var ID: DWORD; fX, fY, fWidth, fHeight: Word): Boolean;
 procedure e_GetTextureSize(ID: DWORD; Width, Height: PWord);
 function e_GetTextureSize2(ID: DWORD): TRectWH;
 procedure e_DeleteTexture(ID: DWORD);
@@ -96,6 +98,9 @@ procedure e_TextureFontPrintFmt(X, Y: GLint; Text: string; FontID: DWORD; Shadow
 procedure e_TextureFontGetSize(ID: DWORD; var CharWidth, CharHeight: Byte);
 procedure e_RemoveAllTextureFont();
 
+function e_TextureFontCharWidth (ch: Char; FontID: DWORD): Integer;
+procedure e_TextureFontPrintCharEx (X, Y: Integer; Ch: Char; FontID: DWORD; Shadow: Boolean = False);
+
 procedure e_ReleaseEngine();
 procedure e_BeginRender();
 procedure e_Clear(Mask: TGLbitfield; Red, Green, Blue: Single); overload;
@@ -105,7 +110,7 @@ procedure e_EndRender();
 function e_GetGamma(win: PSDL_Window): Byte;
 procedure e_SetGamma(win: PSDL_Window;Gamma: Byte);
 
-procedure e_MakeScreenshot(FileName: string; Width, Height: Word);
+procedure e_MakeScreenshot(st: TStream; Width, Height: Word);
 
 function _RGB(Red, Green, Blue: Byte): TRGB;
 function _Point(X, Y: Integer): TPoint2i;
@@ -116,54 +121,14 @@ function _TRect(L, T, R, B: LongInt): TRect;
 var
   e_Colors: TRGB;
   e_NoGraphics: Boolean = False;
+  e_FastScreenshots: Boolean = true; // it's REALLY SLOW with `false`
+
 
 implementation
 
-type
-  LONG = LongInt;
-  BITMAPINFOHEADER = record
-       biSize : DWORD;
-       biWidth : LONG;
-       biHeight : LONG;
-       biPlanes : WORD;
-       biBitCount : WORD;
-       biCompression : DWORD;
-       biSizeImage : DWORD;
-       biXPelsPerMeter : LONG;
-       biYPelsPerMeter : LONG;
-       biClrUsed : DWORD;
-       biClrImportant : DWORD;
-    end;
-  LPBITMAPINFOHEADER = ^BITMAPINFOHEADER;
-  TBITMAPINFOHEADER = BITMAPINFOHEADER;
-  PBITMAPINFOHEADER = ^BITMAPINFOHEADER;
-
-  RGBQUAD = record
-       rgbBlue : BYTE;
-       rgbGreen : BYTE;
-       rgbRed : BYTE;
-       rgbReserved : BYTE;
-    end;
-  tagRGBQUAD = RGBQUAD;
-  TRGBQUAD = RGBQUAD;
-  PRGBQUAD = ^RGBQUAD;
+uses
+  paszlib, crc, utils;
 
-  BITMAPINFO = record
-       bmiHeader : BITMAPINFOHEADER;
-       bmiColors : array[0..0] of RGBQUAD;
-    end;
-  LPBITMAPINFO = ^BITMAPINFO;
-  PBITMAPINFO = ^BITMAPINFO;
-  TBITMAPINFO = BITMAPINFO;
-
-  BITMAPFILEHEADER = packed record
-    bfType : Word;
-    bfSize : DWord;
-    bfReserved1 : Word;
-    bfReserved2 : Word;
-    bfOffBits : DWord;
-  end;
-  tagBITMAPFILEHEADER = BITMAPFILEHEADER;
 
 type
   TTexture = record
@@ -333,7 +298,7 @@ begin
  Result := True;
 end;
 
-function e_CreateTextureMem(pData: Pointer; var ID: DWORD): Boolean;
+function e_CreateTextureMem(pData: Pointer; dataSize: LongInt; var ID: DWORD): Boolean;
 var
   find_id: DWORD;
   fmt:     Word;
@@ -342,8 +307,7 @@ begin
 
  find_id := FindTexture;
 
- if not LoadTextureMem(pData, e_Textures[find_id].tx, e_Textures[find_id].Width,
-                   e_Textures[find_id].Height, @fmt) then exit;
+ if not LoadTextureMem(pData, dataSize, e_Textures[find_id].tx, e_Textures[find_id].Width, e_Textures[find_id].Height, @fmt) then exit;
 
  id := find_id;
  e_Textures[id].Fmt := fmt;
@@ -351,7 +315,7 @@ begin
  Result := True;
 end;
 
-function e_CreateTextureMemEx(pData: Pointer; var ID: DWORD; fX, fY, fWidth, fHeight: Word): Boolean;
+function e_CreateTextureMemEx(pData: Pointer; dataSize: LongInt; var ID: DWORD; fX, fY, fWidth, fHeight: Word): Boolean;
 var
   find_id: DWORD;
   fmt:     Word;
@@ -360,7 +324,7 @@ begin
 
  find_id := FindTexture();
 
- if not LoadTextureMemEx(pData, e_Textures[find_id].tx, fX, fY, fWidth, fHeight, @fmt) then exit;
+ if not LoadTextureMemEx(pData, dataSize, e_Textures[find_id].tx, fX, fY, fWidth, fHeight, @fmt) then exit;
 
  e_Textures[find_id].Width := fWidth;
  e_Textures[find_id].Height := fHeight;
@@ -371,6 +335,22 @@ begin
  Result := True;
 end;
 
+function e_CreateTextureImg (var img: TImageData; var ID: DWORD): Boolean;
+var
+  find_id: DWORD;
+  fmt, tw, th: Word;
+begin
+  result := false;
+  find_id := FindTexture();
+  if not LoadTextureImg(img, e_Textures[find_id].tx, tw, th, @fmt) then exit;
+  //writeln(' tw=', tw, '; th=', th);
+  e_Textures[find_id].Width := tw;
+  e_Textures[find_id].Height := th;
+  e_Textures[find_id].Fmt := fmt;
+  ID := find_id;
+  result := True;
+end;
+
 procedure e_GetTextureSize(ID: DWORD; Width, Height: PWord);
 begin
  if Width <> nil then Width^ := e_Textures[ID].Width;
@@ -392,9 +372,9 @@ begin
  Result.X := 0;
  Result.Width := w;
  Result.Height := h;
- 
+
  if e_NoGraphics then Exit;
- 
+
  data := GetMemory(w*h*4);
  glEnable(GL_TEXTURE_2D);
  glBindTexture(GL_TEXTURE_2D, e_Textures[ID].tx.id);
@@ -1011,73 +991,6 @@ begin
   glPopMatrix();
 end;
 
-procedure e_MakeScreenshot(FileName: String; Width, Height: Word);
-type
-  aRGB  = Array [0..1] of TRGB;
-  PaRGB = ^aRGB;
-  TByteArray = Array [0..1] of Byte;
-  PByteArray = ^TByteArray;
-var
-  FILEHEADER: BITMAPFILEHEADER;
-  INFOHEADER: BITMAPINFOHEADER;
-  pixels: PByteArray;
-  tmp:    Byte;
-  i:      Integer;
-  F:      File of Byte;
-begin
-  if e_NoGraphics then Exit;
-
-  if (Width mod 4) > 0 then
-    Width := Width + 4 - (Width mod 4);
-
-  GetMem(pixels, Width*Height*3);
-  glReadPixels(0, 0, Width, Height, GL_RGB, GL_UNSIGNED_BYTE, pixels);
-
-  for i := 0 to Width * Height - 1 do
-    with PaRGB(pixels)[i] do
-    begin
-      tmp := R;
-      R := B;
-      B := tmp;
-    end;
-
-  with FILEHEADER do
-  begin
-    bfType := $4D42; // "BM"
-    bfSize := Width*Height*3 + SizeOf(BITMAPFILEHEADER) + SizeOf(BITMAPINFOHEADER);
-    bfReserved1 := 0;
-    bfReserved2 := 0;
-    bfOffBits := SizeOf(BITMAPFILEHEADER) + SizeOf(BITMAPINFOHEADER);
-  end;
-
-  with INFOHEADER do
-  begin
-    biSize := SizeOf(BITMAPINFOHEADER);
-    biWidth := Width;
-    biHeight := Height;
-    biPlanes := 1;
-    biBitCount := 24;
-    biCompression := 0;
-    biSizeImage := Width*Height*3;
-    biXPelsPerMeter := 0;
-    biYPelsPerMeter := 0;
-    biClrUsed := 0;
-    biClrImportant := 0;
-  end;
-
-  //writeln('shot: ', FileName);
-  AssignFile(F, FileName);
-  Rewrite(F);
-
-  BlockWrite(F, FILEHEADER, SizeOf(FILEHEADER));
-  BlockWrite(F, INFOHEADER, SizeOf(INFOHEADER));
-  BlockWrite(F, pixels[0], Width*Height*3);
-
-  CloseFile(F);
-
-  FreeMem(pixels);
-end;
-
 function e_GetGamma(win: PSDL_Window): Byte;
 var
   ramp: array [0..256*3-1] of Word;
@@ -1577,6 +1490,24 @@ begin
   glPopMatrix;
 end;
 
+procedure e_TextureFontPrintCharEx (X, Y: Integer; Ch: Char; FontID: DWORD; Shadow: Boolean = False);
+begin
+  glBindTexture(GL_TEXTURE_2D, e_TextureFonts[FontID].TextureID);
+  glEnable(GL_TEXTURE_2D);
+  //glListBase(DWORD(Integer(e_TextureFonts[FontID].Base)-32));
+
+  glBlendFunc(GL_SRC_ALPHA, GL_ONE_MINUS_SRC_ALPHA);
+  glEnable(GL_BLEND);
+  e_TextureFontPrintChar(X, Y, Ch, FontID, Shadow);
+  glDisable(GL_TEXTURE_2D);
+  glDisable(GL_BLEND);
+end;
+
+function e_TextureFontCharWidth (ch: Char; FontID: DWORD): Integer;
+begin
+  result := e_TextureFonts[FontID].CharWidth;
+end;
+
 procedure e_TextureFontPrintFmt(X, Y: Integer; Text: string; FontID: DWORD; Shadow: Boolean = False);
 var
   a, TX, TY, len: Integer;
@@ -1762,4 +1693,171 @@ begin
  Result.Bottom := B;
 end;
 
+
+procedure e_MakeScreenshot (st: TStream; Width, Height: Word);
+var
+  pixels, obuf, scln, ps, pd: PByte;
+  obufsize: Integer;
+  dlen: Cardinal;
+  i, x, y, res: Integer;
+  sign: array [0..7] of Byte;
+  hbuf: array [0..12] of Byte;
+  crc: LongWord;
+  img: TImageData;
+  clr: TColor32Rec;
+begin
+  if e_NoGraphics then Exit;
+  obuf := nil;
+
+  // first, extract and pack graphics data
+  if (Width mod 4) > 0 then Width := Width+4-(Width mod 4);
+
+  GetMem(pixels, Width*Height*3);
+  try
+    FillChar(pixels^, Width*Height*3, 0);
+    glReadPixels(0, 0, Width, Height, GL_RGB, GL_UNSIGNED_BYTE, pixels);
+    //e_WriteLog('PNG: pixels read', MSG_NOTIFY);
+
+    if e_FastScreenshots then
+    begin
+      // create scanlines
+      GetMem(scln, (Width*3+1)*Height);
+      try
+        ps := pixels;
+        pd := scln;
+        Inc(ps, (Width*3)*(Height-1));
+        for i := 0 to Height-1 do
+        begin
+          pd^ := 0; // filter
+          Inc(pd);
+          Move(ps^, pd^, Width*3);
+          Dec(ps, Width*3);
+          Inc(pd, Width*3);
+        end;
+      except
+        FreeMem(scln);
+        raise;
+      end;
+      FreeMem(pixels);
+      pixels := scln;
+
+      // pack it
+      obufsize := (Width*3+1)*Height*2;
+      GetMem(obuf, obufsize);
+      try
+        while true do
+        begin
+          dlen := obufsize;
+          res := compress2(Pointer(obuf), dlen, Pointer(pixels), (Width*3+1)*Height, 9);
+          if res = Z_OK then break;
+          if res <> Z_BUF_ERROR then raise Exception.Create('can''t pack data for PNG');
+          obufsize := obufsize*2;
+          FreeMem(obuf);
+          obuf := nil;
+          GetMem(obuf, obufsize);
+        end;
+        //e_WriteLog(Format('PNG: pixels compressed from %d to %d', [Integer(Width*Height*3), Integer(dlen)]), MSG_NOTIFY);
+
+        // now write PNG
+
+        // signature
+        sign[0] := 137;
+        sign[1] := 80;
+        sign[2] := 78;
+        sign[3] := 71;
+        sign[4] := 13;
+        sign[5] := 10;
+        sign[6] := 26;
+        sign[7] := 10;
+        st.writeBuffer(sign, 8);
+        //e_WriteLog('PNG: signature written', MSG_NOTIFY);
+
+        // header
+        writeIntBE(st, LongWord(13));
+        sign[0] := 73;
+        sign[1] := 72;
+        sign[2] := 68;
+        sign[3] := 82;
+        st.writeBuffer(sign, 4);
+        crc := crc32(0, @sign, 4);
+        hbuf[0] := 0;
+        hbuf[1] := 0;
+        hbuf[2] := (Width shr 8) and $ff;
+        hbuf[3] := Width and $ff;
+        hbuf[4] := 0;
+        hbuf[5] := 0;
+        hbuf[6] := (Height shr 8) and $ff;
+        hbuf[7] := Height and $ff;
+        hbuf[8] := 8; // bit depth
+        hbuf[9] := 2; // RGB
+        hbuf[10] := 0; // compression method
+        hbuf[11] := 0; // filter method
+        hbuf[12] := 0; // no interlace
+        crc := crc32(crc, @hbuf, 13);
+        st.writeBuffer(hbuf, 13);
+        writeIntBE(st, crc);
+        //e_WriteLog('PNG: header written', MSG_NOTIFY);
+
+        // image data
+        writeIntBE(st, LongWord(dlen));
+        sign[0] := 73;
+        sign[1] := 68;
+        sign[2] := 65;
+        sign[3] := 84;
+        st.writeBuffer(sign, 4);
+        crc := crc32(0, @sign, 4);
+        crc := crc32(crc, obuf, dlen);
+        st.writeBuffer(obuf^, dlen);
+        writeIntBE(st, crc);
+        //e_WriteLog('PNG: image data written', MSG_NOTIFY);
+
+        // image data end
+        writeIntBE(st, LongWord(0));
+        sign[0] := 73;
+        sign[1] := 69;
+        sign[2] := 78;
+        sign[3] := 68;
+        st.writeBuffer(sign, 4);
+        crc := crc32(0, @sign, 4);
+        writeIntBE(st, crc);
+        //e_WriteLog('PNG: end marker written', MSG_NOTIFY);
+      finally
+        if obuf <> nil then FreeMem(obuf);
+      end;
+    end
+    else
+    begin
+      Imaging.SetOption(ImagingPNGCompressLevel, 9);
+      Imaging.SetOption(ImagingPNGPreFilter, 6);
+      InitImage(img);
+      try
+        NewImage(Width, Height, TImageFormat.ifR8G8B8, img);
+        ps := pixels;
+        //writeln(stderr, 'moving pixels...');
+        for y := Height-1 downto 0 do
+        begin
+          for x := 0 to Width-1 do
+          begin
+            clr.r := ps^; Inc(ps);
+            clr.g := ps^; Inc(ps);
+            clr.b := ps^; Inc(ps);
+            clr.a := 255;
+            SetPixel32(img, x, y, clr);
+          end;
+        end;
+        GlobalMetadata.ClearMetaItems();
+        GlobalMetadata.ClearMetaItemsForSaving();
+        //writeln(stderr, 'compressing image...');
+        if not SaveImageToStream('png', st, img) then raise Exception.Create('screenshot writing error');
+        //writeln(stderr, 'done!');
+      finally
+        FreeImage(img);
+      end;
+    end;
+  finally
+    FreeMem(pixels);
+  end;
+end;
+
+
 end.