Reimplemented lines and particles rendering with nanoGL

[d2df-sdl.git] / src / engine / e_graphics.pas

diff --git a/src/engine/e_graphics.pas b/src/engine/e_graphics.pas
index ded85939193aaba22a8f569de903b4ed3dd94504..18e4c1a676a81416360fc4c950bd25f4081ae864 100644 (file)
--- a/src/engine/e_graphics.pas
+++ b/src/engine/e_graphics.pas
@@ -1,4 +1,4 @@
-(* Copyright (C)  DooM 2D:Forever Developers
+(* Copyright (C)  Doom 2D: Forever Developers
  *
  * This program is free software: you can redistribute it and/or modify
  * it under the terms of the GNU General Public License as published by
@@ -19,11 +19,16 @@ unit e_graphics;
 interface
 
 uses
-  SysUtils, Classes, Math, e_log, e_texture, SDL2, GL, GLExt, MAPDEF, ImagingTypes, Imaging, ImagingUtility;
+{$IFDEF USE_NANOGL}
+  nanoGL,
+{$ELSE}
+  GL, GLExt,
+{$ENDIF}
+  SysUtils, Classes, Math, e_log, e_texture, SDL2, MAPDEF, ImagingTypes, Imaging, ImagingUtility;
 
 type
-  TMirrorType=(M_NONE, M_HORIZONTAL, M_VERTICAL);
-  TBlending=(B_NONE, B_BLEND, B_FILTER, B_INVERT);
+  TMirrorType=(None, Horizontal, Vertical);
+  TBlending=(None, Blend, Filter, Invert);
 
   TPoint2i = record
     X, Y: Integer;
@@ -60,13 +65,13 @@ procedure e_SetViewPort(X, Y, Width, Height: Word);
 procedure e_ResizeWindow(Width, Height: Integer);
 
 procedure e_Draw(ID: DWORD; X, Y: Integer; Alpha: Byte; AlphaChannel: Boolean;
-                 Blending: Boolean; Mirror: TMirrorType = M_NONE);
+                 Blending: Boolean; Mirror: TMirrorType = TMirrorType.None);
 procedure e_DrawAdv(ID: DWORD; X, Y: Integer; Alpha: Byte; AlphaChannel: Boolean;
-                    Blending: Boolean; Angle: Single; RC: PDFPoint; Mirror: TMirrorType = M_NONE);
+                    Blending: Boolean; Angle: Single; RC: PDFPoint; Mirror: TMirrorType = TMirrorType.None);
 procedure e_DrawSize(ID: DWORD; X, Y: Integer; Alpha: Byte; AlphaChannel: Boolean;
-                     Blending: Boolean; Width, Height: Word; Mirror: TMirrorType = M_NONE);
+                     Blending: Boolean; Width, Height: Word; Mirror: TMirrorType = TMirrorType.None);
 procedure e_DrawSizeMirror(ID: DWORD; X, Y: Integer; Alpha: Byte; AlphaChannel: Boolean;
-                           Blending: Boolean; Width, Height: Word; Mirror: TMirrorType = M_NONE);
+                           Blending: Boolean; Width, Height: Word; Mirror: TMirrorType = TMirrorType.None);
 
 procedure e_DrawFill(ID: DWORD; X, Y: Integer; XCount, YCount: Word; Alpha: Integer;
                      AlphaChannel: Boolean; Blending: Boolean; ambientBlendMode: Boolean=false);
@@ -80,7 +85,7 @@ procedure e_DrawPoint(Size: Byte; X, Y: Integer; Red, Green, Blue: Byte);
 procedure e_DrawLine(Width: Byte; X1, Y1, X2, Y2: Integer; Red, Green, Blue: Byte; Alpha: Byte = 0);
 procedure e_DrawQuad(X1, Y1, X2, Y2: Integer; Red, Green, Blue: Byte; Alpha: Byte = 0);
 procedure e_DrawFillQuad(X1, Y1, X2, Y2: Integer; Red, Green, Blue, Alpha: Byte;
-                         Blending: TBlending = B_NONE);
+                         Blending: TBlending = TBlending.None);
 procedure e_DarkenQuad (x0, y0, x1, y1: Integer; a: Integer);
 procedure e_DarkenQuadWH (x, y, w, h: Integer; a: Integer);
 
@@ -144,6 +149,7 @@ var
   e_Colors: TRGB;
   e_NoGraphics: Boolean = False;
   e_FastScreenshots: Boolean = true; // it's REALLY SLOW with `false`
+  g_dbg_scale: Single = 1.0;
 
 
 implementation
@@ -285,7 +291,7 @@ var
 begin
  Result := False;
 
- e_WriteLog('Loading texture from '+FileName, MSG_NOTIFY);
+ e_WriteLog('Loading texture from '+FileName, TMsgType.Notify);
 
  find_id := FindTexture();
 
@@ -379,6 +385,7 @@ begin
  Result.Width := w;
  Result.Height := h;
 
+{$IFNDEF USE_NANOGL} // FIXIT: nanoGL doesn't support glGetTexImage
  if e_NoGraphics then Exit;
 
  data := GetMemory(w*h*4);
@@ -459,6 +466,7 @@ begin
  end;
 
  FreeMemory(data);
+{$ENDIF}
 end;
 
 procedure e_ResizeWindow(Width, Height: Integer);
@@ -468,15 +476,21 @@ begin
   e_SetViewPort(0, 0, Width, Height);
 end;
 
-procedure drawTxQuad (x0, y0, w, h: Integer; u, v: single; Mirror: TMirrorType);
+procedure drawTxQuad (x0, y0, w, h, tw, th: Integer; u, v: single; Mirror: TMirrorType);
 var
   x1, y1, tmp: Integer;
 begin
   if (w < 1) or (h < 1) then exit;
   x1 := x0+w;
   y1 := y0+h;
-       if Mirror = M_HORIZONTAL then begin tmp := x1; x1 := x0; x0 := tmp; end
-  else if Mirror = M_VERTICAL then begin tmp := y1; y1 := y0; y0 := tmp; end;
+       if Mirror = TMirrorType.Horizontal then begin tmp := x1; x1 := x0; x0 := tmp; end
+  else if Mirror = TMirrorType.Vertical then begin tmp := y1; y1 := y0; y0 := tmp; end;
+  //HACK: make texture one pixel shorter, so it won't wrap
+  if (g_dbg_scale <> 1.0) then
+  begin
+    u := u*tw/(tw+1);
+    v := v*th/(th+1);
+  end;
   glTexCoord2f(0, v); glVertex2i(x0, y0);
   glTexCoord2f(0, 0); glVertex2i(x0, y1);
   glTexCoord2f(u, 0); glVertex2i(x1, y1);
@@ -484,7 +498,7 @@ begin
 end;
 
 procedure e_Draw(ID: DWORD; X, Y: Integer; Alpha: Byte; AlphaChannel: Boolean;
-                 Blending: Boolean; Mirror: TMirrorType = M_NONE);
+                 Blending: Boolean; Mirror: TMirrorType = TMirrorType.None);
 begin
   if e_NoGraphics then Exit;
   glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255);
@@ -507,7 +521,7 @@ begin
   glBindTexture(GL_TEXTURE_2D, e_Textures[ID].tx.id);
   glBegin(GL_QUADS);
 
-  drawTxQuad(X, Y, e_Textures[id].tx.width, e_Textures[id].tx.height, e_Textures[ID].tx.u, e_Textures[ID].tx.v, Mirror);
+  drawTxQuad(X, Y, e_Textures[id].tx.width, e_Textures[id].tx.height, e_Textures[id].tx.width, e_Textures[id].tx.height, e_Textures[ID].tx.u, e_Textures[ID].tx.v, Mirror);
 
   //u := e_Textures[ID].tx.u;
   //v := e_Textures[ID].tx.v;
@@ -544,7 +558,7 @@ begin
 end;
 
 procedure e_DrawSize(ID: DWORD; X, Y: Integer; Alpha: Byte; AlphaChannel: Boolean;
-                     Blending: Boolean; Width, Height: Word; Mirror: TMirrorType = M_NONE);
+                     Blending: Boolean; Width, Height: Word; Mirror: TMirrorType = TMirrorType.None);
 var
   u, v: Single;
 begin
@@ -582,7 +596,7 @@ begin
 end;
 
 procedure e_DrawSizeMirror(ID: DWORD; X, Y: Integer; Alpha: Byte; AlphaChannel: Boolean;
-                           Blending: Boolean; Width, Height: Word; Mirror: TMirrorType = M_NONE);
+                           Blending: Boolean; Width, Height: Word; Mirror: TMirrorType = TMirrorType.None);
 begin
   if e_NoGraphics then Exit;
   glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255);
@@ -604,7 +618,7 @@ begin
   glEnable(GL_TEXTURE_2D);
   glBindTexture(GL_TEXTURE_2D, e_Textures[ID].tx.id);
   glBegin(GL_QUADS);
-  drawTxQuad(X, Y, Width, Height, e_Textures[ID].tx.u, e_Textures[ID].tx.v, Mirror);
+  drawTxQuad(X, Y, Width, Height, e_Textures[id].tx.width, e_Textures[id].tx.height, e_Textures[ID].tx.u, e_Textures[ID].tx.v, Mirror);
   glEnd();
 
   glDisable(GL_BLEND);
@@ -860,7 +874,7 @@ end;
 
 
 procedure e_DrawAdv(ID: DWORD; X, Y: Integer; Alpha: Byte; AlphaChannel: Boolean;
-                    Blending: Boolean; Angle: Single; RC: PDFPoint; Mirror: TMirrorType = M_NONE);
+                    Blending: Boolean; Angle: Single; RC: PDFPoint; Mirror: TMirrorType = TMirrorType.None);
 begin
   if e_NoGraphics then Exit;
 
@@ -892,7 +906,7 @@ begin
   glBindTexture(GL_TEXTURE_2D, e_Textures[id].tx.id);
   glBegin(GL_QUADS);                           //0-1        1-1
                                                //00         10
-  drawTxQuad(X, Y, e_Textures[id].tx.width, e_Textures[id].tx.height, e_Textures[ID].tx.u, e_Textures[ID].tx.v, Mirror);
+  drawTxQuad(X, Y, e_Textures[id].tx.width, e_Textures[id].tx.height, e_Textures[id].tx.width, e_Textures[id].tx.height, e_Textures[ID].tx.u, e_Textures[ID].tx.v, Mirror);
   glEnd();
 
   if Angle <> 0 then
@@ -944,6 +958,7 @@ procedure e_DrawQuad(X1, Y1, X2, Y2: Integer; Red, Green, Blue: Byte; Alpha: Byt
 var
   nX1, nY1, nX2, nY2: Integer;
 begin
+{$IFNDEF USE_NANOGL} // FIXIT: nanoGL doesn't support glBegin(GL_LINES)
   if e_NoGraphics then Exit;
   // Only top-left/bottom-right quad
   if X1 > X2 then
@@ -999,24 +1014,25 @@ begin
   glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255);
 
   glDisable(GL_BLEND);
+{$ENDIF}
 end;
 
 procedure e_DrawFillQuad(X1, Y1, X2, Y2: Integer; Red, Green, Blue, Alpha: Byte;
-                         Blending: TBlending = B_NONE);
+                         Blending: TBlending = TBlending.None);
 begin
   if e_NoGraphics then Exit;
-  if (Alpha > 0) or (Blending <> B_NONE) then
+  if (Alpha > 0) or (Blending <> TBlending.None) then
     glEnable(GL_BLEND)
   else
     glDisable(GL_BLEND);
 
-  if Blending = B_BLEND then
+  if Blending = TBlending.Blend then
     glBlendFunc(GL_SRC_ALPHA, GL_ONE)
   else
-    if Blending = B_FILTER then
+    if Blending = TBlending.Filter then
       glBlendFunc(GL_DST_COLOR, GL_SRC_COLOR)
     else
-      if Blending = B_INVERT then
+      if Blending = TBlending.Invert then
         glBlendFunc(GL_ONE_MINUS_DST_COLOR, GL_ZERO)
       else
         if Alpha > 0 then
@@ -1069,6 +1085,10 @@ end;
 
 
 procedure e_DrawLine(Width: Byte; X1, Y1, X2, Y2: Integer; Red, Green, Blue: Byte; Alpha: Byte = 0);
+{$IFDEF USE_NANOGL}
+  var
+    v: array [0..3] of GLfloat;
+{$ENDIF}
 begin
   if e_NoGraphics then Exit;
   // Pixel-perfect lines
@@ -1086,10 +1106,20 @@ begin
   glColor4ub(Red, Green, Blue, 255-Alpha);
   glLineWidth(Width);
 
+{$IFDEF USE_NANOGL}
+  v[0] := X1; v[1] := Y1; v[2] := X2; v[3] := Y2;
+  glVertexPointer(2, GL_FLOAT, 0, @v[0]);
+  glEnableClientState(GL_VERTEX_ARRAY);
+  glDisableClientState(GL_COLOR_ARRAY);
+  glDisableClientState(GL_NORMAL_ARRAY);
+  glDisableClientState(GL_TEXTURE_COORD_ARRAY);
+  glDrawArrays(GL_LINES, 0, 4);
+{$ELSE}
   glBegin(GL_LINES);
     glVertex2i(X1, Y1);
     glVertex2i(X2, Y2);
   glEnd();
+{$ENDIF}
 
   glColor4ub(e_Colors.R, e_Colors.G, e_Colors.B, 255);
 
@@ -1225,7 +1255,7 @@ function e_CharFont_Create(sp: ShortInt=0): DWORD;
 var
   i, id: DWORD;
 begin
- e_WriteLog('Creating CharFont...', MSG_NOTIFY);
+ e_WriteLog('Creating CharFont...', TMsgType.Notify);
 
  id := DWORD(-1);
 
@@ -1440,11 +1470,12 @@ end;
 procedure e_CharFont_GetSizeFmt(FontID: DWORD; Text: string; var w, h: Word);
 var
   a, lines, len: Integer;
-  h2, w2: Word;
+  h2, w2, tw, th: Word;
 begin
   w2 := 0;
-  w := 0;
-  h := 0;
+  h2 := 0;
+  tw := 0;
+  th := 0;
 
   if Text = '' then Exit;
   if e_CharFonts = nil then Exit;
@@ -1460,29 +1491,26 @@ begin
       if Text[a] = #10 then
       begin
         Inc(lines);
-        if w2 > w then
-        begin
-          w := w2;
-          w2 := 0;
-        end;
-        continue;
-      end
-      else if Text[a] in [#1, #2, #3, #4, #18, #19, #20, #21] then
+        if w2 > tw then tw := w2;
+        w2 := 0;
         continue;
+      end;
 
       with Chars[Ord(Text[a])] do
-      if TextureID <> -1 then
-      begin
-        w2 := w2 + Width + IfThen(a = len, 0, Space);
-        e_GetTextureSize(TextureID, nil, @h2);
-        if h2 > h then h := h2;
-      end;
+        if TextureID <> -1 then
+        begin
+          w2 := w2 + Width + IfThen(a = len, 0, Space);
+          e_GetTextureSize(TextureID, nil, @h2);
+          if h2 > th then th := h2;
+        end;
     end;
   end;
 
-  if w2 > w then
-    w := w2;
-  h := h * lines;
+  if w2 > tw then
+    tw := w2;
+
+  w := tw;
+  h := th * lines;
 end;
 
 function e_CharFont_GetMaxWidth(FontID: DWORD): Word;
@@ -1548,7 +1576,7 @@ var
   i, id: DWORD;
 begin
  if e_NoGraphics then Exit;
- e_WriteLog('Creating texture font...', MSG_NOTIFY);
+ e_WriteLog('Creating texture font...', TMsgType.Notify);
 
  id := DWORD(-1);
 
@@ -1566,6 +1594,7 @@ begin
   id := High(e_TextureFonts);
  end;
 
+{$IFNDEF USE_NANOGL} // FIXIT: nanoGL doesn't support gl-lists
  with e_TextureFonts[id] do
  begin
   Base := glGenLists(XCount*YCount);
@@ -1601,6 +1630,7 @@ begin
    glTranslated((e_Textures[Tex].tx.Width div XCount)+Space, 0, 0);
   glEndList();
  end;
+{$ENDIF}
 
  FontID := id;
 end;
@@ -1608,12 +1638,15 @@ end;
 procedure e_TextureFontKill(FontID: DWORD);
 begin
   if e_NoGraphics then Exit;
+{$IFNDEF USE_NANOGL} // FIXIT: nanoGL doesn't support gl-lists
   glDeleteLists(e_TextureFonts[FontID].Base, 256);
+{$ENDIF}
   e_TextureFonts[FontID].Base := 0;
 end;
 
 procedure e_TextureFontPrint(X, Y: GLint; Text: string; FontID: DWORD);
 begin
+{$IFNDEF USE_NANOGL} // FIXIT: nanoGL doesn't support gl-lists
   if e_NoGraphics then Exit;
   if Integer(FontID) > High(e_TextureFonts) then Exit;
   if Text = '' then Exit;
@@ -1633,11 +1666,13 @@ begin
   glPopMatrix;
 
   glDisable(GL_BLEND);
+{$ENDIF}
 end;
 
 // god forgive me for this, but i cannot figure out how to do it without lists
 procedure e_TextureFontPrintChar(X, Y: Integer; Ch: Char; FontID: DWORD; Shadow: Boolean = False);
 begin
+{$IFNDEF USE_NANOGL} // FIXIT: nanoGL doesn't support gl-lists
   if e_NoGraphics then Exit;
   glPushMatrix;
 
@@ -1655,6 +1690,7 @@ begin
   glCallLists(1, GL_UNSIGNED_BYTE, @Ch);
 
   glPopMatrix;
+{$ENDIF}
 end;
 
 procedure e_TextureFontPrintCharEx (X, Y: Integer; Ch: Char; FontID: DWORD; Shadow: Boolean = False);
@@ -1675,12 +1711,13 @@ begin
   result := e_TextureFonts[FontID].CharWidth;
 end;
 
-procedure e_TextureFontPrintFmt(X, Y: Integer; Text: string; FontID: DWORD; Shadow: Boolean = False);
+procedure e_TextureFontPrintFmt(X, Y: GLint; Text: string; FontID: DWORD; Shadow: Boolean = False);
 var
   a, TX, TY, len: Integer;
   tc, c: TRGB;
   w: Word;
 begin
+{$IFNDEF USE_NANOGL} // FIXIT: nanoGL doesn't support gl-lists
   if e_NoGraphics then Exit;
   if Text = '' then Exit;
   if e_TextureFonts = nil then Exit;
@@ -1766,11 +1803,13 @@ begin
     glDisable(GL_TEXTURE_2D);
     glDisable(GL_BLEND);
   end;
+{$ENDIF}
 end;
 
 procedure e_TextureFontPrintEx(X, Y: GLint; Text: string; FontID: DWORD; Red, Green,
                     Blue: Byte; Scale: Single; Shadow: Boolean = False);
 begin
+{$IFNDEF USE_NANOGL} // FIXIT: nanoGL doesn't support gl-lists
   if e_NoGraphics then Exit;
   if Text = '' then Exit;
 
@@ -1801,6 +1840,7 @@ begin
   glPopMatrix;
   glColor3ub(e_Colors.R, e_Colors.G, e_Colors.B);
   glDisable(GL_BLEND);
+{$ENDIF}
 end;
 
 procedure e_TextureFontGetSize(ID: DWORD; out CharWidth, CharHeight: Byte);
@@ -1824,7 +1864,9 @@ begin
  for i := 0 to High(e_TextureFonts) do
   if e_TextureFonts[i].Base <> 0 then
   begin
+{$IFNDEF USE_NANOGL} // FIXIT: nanoGL doesn't support gl-lists
    glDeleteLists(e_TextureFonts[i].Base, 256);
+{$ENDIF}
    e_TextureFonts[i].Base := 0;
   end;