From: Ketmar Dark <ketmar@ketmar.no-ip.org>
Date: Thu, 21 Sep 2017 10:22:26 +0000 (+0300)
Subject: holmes: new outliner; it should work in all scales now
X-Git-Url: http://deadsoftware.ru/gitweb?a=commitdiff_plain;h=b9f9f497d3b5de55bcbf70bf33a0b4b466f0d40e;p=d2df-sdl.git

holmes: new outliner; it should work in all scales now
---

diff --git a/src/game/g_game.pas b/src/game/g_game.pas
index fd0daf2..ab843d3 100644
--- a/src/game/g_game.pas
+++ b/src/game/g_game.pas
@@ -3101,15 +3101,21 @@ begin
 
   //glTranslatef(a, b+p.IncCam, 0);
 
-  if (p = gPlayer1) then g_Holmes_plrViewSize(sWidth, sHeight);
+  //if (p = gPlayer1) and (g_dbg_scale >= 1.0) then g_Holmes_plrViewSize(sWidth, sHeight);
 
+  //conwritefln('OLD: (%s,%s)-(%s,%s)', [sX, sY, sWidth, sHeight]);
   fixViewportForScale();
+  //conwritefln('     (%s,%s)-(%s,%s)', [sX, sY, sWidth, sHeight]);
   p.viewPortX := sX;
   p.viewPortY := sY;
   p.viewPortW := sWidth;
   p.viewPortH := sHeight;
 
-  if (p = gPlayer1) then g_Holmes_plrViewPos(sX, sY);
+  if (p = gPlayer1) then
+  begin
+    g_Holmes_plrViewPos(sX, sY);
+    g_Holmes_plrViewSize(sWidth, sHeight);
+  end;
 
   renderMapInternal(-c, -d, true);
 
diff --git a/src/game/g_holmes.pas b/src/game/g_holmes.pas
index 33af326..e64c205 100644
--- a/src/game/g_holmes.pas
+++ b/src/game/g_holmes.pas
@@ -130,6 +130,7 @@ var
 // ////////////////////////////////////////////////////////////////////////// //
 {$INCLUDE g_holmes.inc}
 {$INCLUDE g_holmes_ui.inc}
+{$INCLUDE g_holmes_ol.inc} // outliner
 
 
 // ////////////////////////////////////////////////////////////////////////// //
@@ -697,6 +698,7 @@ begin
 end;
 
 
+{$IFDEF HOLMES_OLD_OUTLINES}
 var
   edgeBmp: array of Byte = nil;
 
@@ -899,6 +901,155 @@ begin
   if g_ol_rlayer_fore then doWallsOld(gRenderForegrounds, PANEL_FORE, 210, 210, 210);
 end;
 
+{$ELSE}
+var
+  oliner: TOutliner = nil;
+
+procedure drawOutlines ();
+var
+  r, g, b: Integer;
+
+  procedure clearOliner ();
+  begin
+    //if (oliner <> nil) and ((oliner.height <> vph+2) or (oliner.width <> vpw+2)) then begin oliner.Free(); oliner := nil; end;
+    if (oliner = nil) then oliner := TOutliner.Create(vpw+2, vph+2) else oliner.setup(vpw+2, vph+2);
+  end;
+
+  procedure drawOutline (ol: TOutliner; sx, sy: Integer);
+    procedure xline (x0, x1, y: Integer);
+    var
+      x: Integer;
+    begin
+      if (g_dbg_scale < 1.0) then
+      begin
+        glBegin(GL_POINTS);
+          for x := x0 to x1 do glVertex2f(sx+x+0.375, sy+y+0.375);
+        glEnd();
+      end
+      else
+      begin
+        glBegin(GL_QUADS);
+          glVertex2f(sx+x0+0, sy+y+0);
+          glVertex2f(sx+x1+1, sy+y+0);
+          glVertex2f(sx+x1+1, sy+y+1);
+          glVertex2f(sx+x0+0, sy+y+1);
+        glEnd();
+      end;
+    end;
+  var
+    y: Integer;
+    sp: TOutliner.TSpanX;
+  begin
+    if (ol = nil) then exit;
+    glPointSize(1);
+    glDisable(GL_POINT_SMOOTH);
+    for y := 0 to ol.height-1 do
+    begin
+      for sp in ol.eachSpanAtY(y) do
+      begin
+        if (g_dbg_scale <= 1.0) then
+        begin
+          glBegin(GL_POINTS);
+            glVertex2f(sx+sp.x0+0.375, sy+y+0.375);
+            glVertex2f(sx+sp.x1+0.375, sy+y+0.375);
+          glEnd();
+        end
+        else
+        begin
+          glBegin(GL_QUADS);
+            glVertex2f(sx+sp.x0+0, sy+y+0);
+            glVertex2f(sx+sp.x0+1, sy+y+0);
+            glVertex2f(sx+sp.x0+1, sy+y+1);
+            glVertex2f(sx+sp.x0+0, sy+y+1);
+
+            glVertex2f(sx+sp.x1+0, sy+y+0);
+            glVertex2f(sx+sp.x1+1, sy+y+0);
+            glVertex2f(sx+sp.x1+1, sy+y+1);
+            glVertex2f(sx+sp.x1+0, sy+y+1);
+          glEnd();
+        end;
+      end;
+      for sp in ol.eachSpanEdgeAtY(y, -1) do
+      begin
+        xline(sp.x0, sp.x1, y);
+        {
+        glBegin(GL_QUADS);
+          glVertex2f(sx+sp.x0+0, sy+y+0);
+          glVertex2f(sx+sp.x1+1, sy+y+0);
+          glVertex2f(sx+sp.x1+1, sy+y+1);
+          glVertex2f(sx+sp.x0+0, sy+y+1);
+        glEnd();
+        }
+      end;
+      for sp in ol.eachSpanEdgeAtY(y, +1) do
+      begin
+        xline(sp.x0, sp.x1, y);
+        {
+        glBegin(GL_QUADS);
+          glVertex2f(sx+sp.x0+0, sy+y+0);
+          glVertex2f(sx+sp.x1+1, sy+y+0);
+          glVertex2f(sx+sp.x1+1, sy+y+1);
+          glVertex2f(sx+sp.x0+0, sy+y+1);
+        glEnd();
+        }
+      end;
+    end;
+  end;
+
+  procedure doWallsOld (parr: array of TPanel; ptype: Word; ar, ag, ab: Integer);
+  var
+    f: Integer;
+    pan: TPanel;
+  begin
+    r := ar;
+    g := ag;
+    b := ab;
+    if g_ol_nice then clearOliner();
+    for f := 0 to High(parr) do
+    begin
+      pan := parr[f];
+      if (pan = nil) or not pan.Enabled or (pan.Width < 1) or (pan.Height < 1) then continue;
+      if ((pan.PanelType and ptype) = 0) then continue;
+      if (pan.X > vpx+vpw+41) or (pan.Y > vpy+vph+41) then continue;
+      if (pan.X+pan.Width < vpx-41) then continue;
+      if (pan.Y+pan.Height < vpy-41) then continue;
+      if g_ol_nice then
+      begin
+        oliner.addRect(pan.X-(vpx+1), pan.Y-(vpy+1), pan.Width, pan.Height);
+      end;
+      if g_ol_fill_walls then
+      begin
+        fillRect(pan.X, pan.Y, pan.Width, pan.Height, r, g, b);
+      end
+      else if not g_ol_nice then
+      begin
+        drawRect(pan.X, pan.Y, pan.Width, pan.Height, r, g, b);
+      end;
+    end;
+    if g_ol_nice then
+    begin
+      glColor4f(r/255.0, g/255.0, b/255.0, 1.0);
+      drawOutline(oliner, vpx+1, vpy+1);
+    end;
+  end;
+
+begin
+  if (vpw < 2) or (vph < 2) then exit;
+  glScissor(0, gScreenHeight-gPlayerScreenSize.Y, gPlayerScreenSize.X, gPlayerScreenSize.Y);
+  glEnable(GL_SCISSOR_TEST);
+  if g_ol_rlayer_back then doWallsOld(gRenderBackgrounds, PANEL_BACK, 255, 127, 0);
+  if g_ol_rlayer_step then doWallsOld(gSteps, PANEL_STEP, 192, 192, 192);
+  if g_ol_rlayer_wall then doWallsOld(gWalls, PANEL_WALL, 255, 255, 255);
+  if g_ol_rlayer_door then doWallsOld(gWalls, PANEL_OPENDOOR or PANEL_CLOSEDOOR, 0, 255, 0);
+  if g_ol_rlayer_acid1 then doWallsOld(gAcid1, PANEL_ACID1, 255, 0, 0);
+  if g_ol_rlayer_acid2 then doWallsOld(gAcid2, PANEL_ACID2, 198, 198, 0);
+  if g_ol_rlayer_water then doWallsOld(gWater, PANEL_WATER, 0, 255, 255);
+  if g_ol_rlayer_fore then doWallsOld(gRenderForegrounds, PANEL_FORE, 210, 210, 210);
+  glScissor(0, 0, gScreenWidth, gScreenHeight);
+  glDisable(GL_SCISSOR_TEST);
+end;
+{$ENDIF}
+
 
 procedure plrDebugDraw ();
   procedure drawTileGrid ();
diff --git a/src/game/g_holmes_ol.inc b/src/game/g_holmes_ol.inc
new file mode 100644
index 0000000..23949ca
--- /dev/null
+++ b/src/game/g_holmes_ol.inc
@@ -0,0 +1,475 @@
+(* 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
+ * the Free Software Foundation, either version 3 of the License, or
+ * (at your option) any later version.
+ *
+ * This program is distributed in the hope that it will be useful,
+ * but WITHOUT ANY WARRANTY; without even the implied warranty of
+ * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ * GNU General Public License for more details.
+ *
+ * You should have received a copy of the GNU General Public License
+ * along with this program.  If not, see <http://www.gnu.org/licenses/>.
+ *)
+{.$INCLUDE ../shared/a_modes.inc}
+type
+  TOutliner = class
+  private
+    type
+      TSpan = record
+        x0, x1: Integer;
+        next: Integer; // index
+      end;
+      PSpan = ^TSpan;
+
+  private
+    mWidth, mHeight: Integer;
+    spans: array of TSpan;
+    firstFreeSpan: Integer; // span index or -1
+    usedSpans: Integer;
+    lines: array of Integer; // span indicies
+
+  private
+    function allocSpan (ax0, ax1: Integer): Integer; // returns span index
+    procedure freeSpan (idx: Integer);
+
+  public
+    type
+      TSpanX = record
+        x0, x1: Integer;
+      end;
+
+      TSpanEnumerator = record
+      private
+        spans: array of TSpan;
+        cur: Integer;
+        first: Boolean;
+      public
+        constructor Create (master: TOutliner; y: Integer);
+        function MoveNext (): Boolean; inline;
+        function getCurrent (): TSpanX; inline;
+        function GetEnumerator (): TSpanEnumerator; inline;
+        property Current: TSpanX read getCurrent;
+      end;
+
+      TSpanEdgeEnumerator = record
+      private
+        spans: array of TSpan;
+        spi, usp: Integer;
+        sx, ex: Integer;
+        cur: TSpanX;
+        doSkipUSP: Boolean;
+      private
+        procedure nextSPI (); inline;
+      public
+        constructor Create (master: TOutliner; y, dy: Integer);
+        function MoveNext (): Boolean; inline;
+        function GetEnumerator (): TSpanEdgeEnumerator; inline;
+        property Current: TSpanX read cur;
+      end;
+
+  public
+    constructor Create (aw, ah: Integer);
+    destructor Destroy (); override;
+
+    procedure clear ();
+    procedure setup (aw, ah: Integer);
+
+    procedure addSpan (ax0, ax1, y: Integer);
+    procedure addRect (x, y, w, h: Integer);
+
+    function eachSpanAtY (y: Integer): TSpanEnumerator;
+    function eachSpanEdgeAtY (y, dy: Integer): TSpanEdgeEnumerator;
+    //function GetEnumerator (): TValEnumerator;
+
+  public
+    property width: Integer read mWidth;
+    property height: Integer read mHeight;
+  end;
+
+
+// ////////////////////////////////////////////////////////////////////////// //
+function TOutliner.allocSpan (ax0, ax1: Integer): Integer;
+begin
+  result := firstFreeSpan;
+  if (result = -1) then
+  begin
+    result := usedSpans;
+    if (usedSpans = Length(spans)) then SetLength(spans, usedSpans+512);
+    Inc(usedSpans);
+  end
+  else
+  begin
+    firstFreeSpan := spans[result].next;
+  end;
+  with (spans[result]) do
+  begin
+    x0 := ax0;
+    x1 := ax1;
+    next := -1;
+  end;
+end;
+
+
+procedure TOutliner.freeSpan (idx: Integer);
+begin
+  if (idx >= 0) and (idx < usedSpans) then
+  begin
+    spans[idx].next := firstFreeSpan;
+    firstFreeSpan := idx;
+  end;
+end;
+
+
+constructor TOutliner.Create (aw, ah: Integer);
+var
+  f: Integer;
+begin
+  assert(aw > 0);
+  assert(ah > 0);
+  mWidth := aw;
+  mHeight := ah;
+  SetLength(lines, mHeight);
+  for f := 0 to High(lines) do lines[f] := -1;
+  usedSpans := 0;
+  firstFreeSpan := -1;
+end;
+
+
+destructor TOutliner.Destroy ();
+begin
+  spans := nil;
+  lines := nil;
+  inherited;
+end;
+
+
+procedure TOutliner.setup (aw, ah: Integer);
+var
+  f: Integer;
+begin
+  assert(aw > 0);
+  assert(ah > 0);
+  if (mWidth <> aw) or (mHeight <> ah) then
+  begin
+    mWidth := aw;
+    mHeight := ah;
+    SetLength(lines, mHeight);
+  end;
+  for f := 0 to High(lines) do lines[f] := -1;
+  usedSpans := 0;
+  firstFreeSpan := -1;
+end;
+
+
+procedure TOutliner.clear ();
+var
+  f: Integer;
+begin
+  for f := 0 to High(lines) do lines[f] := -1;
+  usedSpans := 0;
+  firstFreeSpan := -1;
+end;
+
+
+procedure TOutliner.addSpan (ax0, ax1, y: Integer);
+  procedure fixFrom (spi: Integer);
+  var
+    sp, sn: PSpan;
+    spf: Integer;
+  begin
+    assert(spi <> -1);
+    sp := @spans[spi];
+    while true do
+    begin
+      spf := sp.next;
+      if (spf = -1) then break;
+      sn := @spans[spf];
+      // join?
+      if (sp.x1+1 = sn.x0) then
+      begin
+        //conprintfln("JOIN: sp=(%s,%s); sn=(%s,%s)", sp.x0, sp.x1, sn.x0, sn.x1);
+        sp.x1 := sn.x1;
+      end
+      else if (sn.x0 <= sp.x1) then
+      begin
+        // overlaps
+        //conprintfln("OVER: sp=(%s,%s); sn=(%s,%s)", sp.x0, sp.x1, sn.x0, sn.x1);
+        if (sp.x1 < sn.x1) then sp.x1 := sn.x1;
+      end
+      else
+      begin
+        break;
+      end;
+      sp.next := sn.next;
+      freeSpan(spf);
+    end;
+  end;
+
+var
+  sprev: Integer = -1;
+  scur: Integer;
+  sp: PSpan;
+begin
+  if (ax1 < ax0) then exit;
+  if (y < 0) or (y >= mHeight) then exit;
+  if (ax1 < -42) or (ax0 > mWidth+42) then exit;
+  if (ax0 < -42) then ax0 := -42;
+  if (ax1 > mWidth+42) then ax1 := mWidth+42;
+  // new span on empty line?
+  scur := lines[y];
+  if (scur = -1) then
+  begin
+    lines[y] := allocSpan(ax0, ax1);
+    exit;
+  end;
+  // starts before the first span?
+  sp := @spans[scur];
+  if (ax0 < sp.x0) then
+  begin
+    // insert new span as the first one
+    sprev := allocSpan(ax0, ax1);
+    spans[sprev].next := scur;
+    lines[y] := sprev;
+    // fix invalid spans (if any)
+    fixFrom(sprev);
+    exit;
+  end;
+  // find span to expand
+  while (scur <> -1) do
+  begin
+    sp := @spans[scur];
+    // join spans?
+    if (sp.x1+1 = ax0) then
+    begin
+      sp.x1 := ax1;
+      fixFrom(scur);
+      exit;
+    end;
+    // starts in current span?
+    if (ax0 >= sp.x0) and (ax0 <= sp.x1) then
+    begin
+      if (ax1 >= sp.x0) and (ax1 <= sp.x1) then exit; // ends in current span, nothing to do
+      // extend current span, and fix bad spans
+      sp.x1 := ax1;
+      fixFrom(scur);
+      exit;
+    end;
+    // starts after the current span, but before the next span?
+    if (sp.next <> -1) and (ax0 > sp.x1) and (ax0 < spans[sp.next].x0) then
+    begin
+      // insert before next span
+      sprev := allocSpan(ax0, ax1);
+      spans[sprev].next := sp.next;
+      sp.next := sprev;
+      fixFrom(sp.next);
+      exit;
+    end;
+    // try next span
+    sprev := scur;
+    scur := sp.next;
+  end;
+  // just append new span
+  assert(sprev <> -1);
+  spans[sprev].next := allocSpan(ax0, ax1);
+end;
+
+
+procedure TOutliner.addRect (x, y, w, h: Integer);
+begin
+  if (w < 1) or (h < 1) then exit;
+  while (h > 0) do
+  begin
+    addSpan(x, x+w-1, y);
+    Inc(y);
+    Dec(h);
+  end;
+end;
+
+
+function TOutliner.eachSpanAtY (y: Integer): TSpanEnumerator;
+begin
+  result := TSpanEnumerator.Create(self, y);
+end;
+
+
+function TOutliner.eachSpanEdgeAtY (y, dy: Integer): TSpanEdgeEnumerator;
+begin
+  result := TSpanEdgeEnumerator.Create(self, y, dy);
+end;
+
+
+// ////////////////////////////////////////////////////////////////////////// //
+constructor TOutliner.TSpanEnumerator.Create (master: TOutliner; y: Integer);
+begin
+  spans := master.spans;
+  cur := -1;
+  first := true;
+  if (y < 0) or (y >= master.mHeight) then exit;
+  cur := master.lines[y];
+end;
+
+function TOutliner.TSpanEnumerator.MoveNext (): Boolean; inline;
+begin
+       if first then first := false
+  else if (cur <> -1) then cur := spans[cur].next;
+  result := (cur <> -1);
+end;
+
+function TOutliner.TSpanEnumerator.getCurrent (): TSpanX; inline;
+begin
+  result.x0 := spans[cur].x0;
+  result.x1 := spans[cur].x1;
+end;
+
+function TOutliner.TSpanEnumerator.GetEnumerator (): TSpanEnumerator; inline;
+begin
+  result := self;
+end;
+
+
+// ////////////////////////////////////////////////////////////////////////// //
+function TOutliner.TSpanEdgeEnumerator.GetEnumerator (): TSpanEdgeEnumerator; inline;
+begin
+  result := self;
+end;
+
+constructor TOutliner.TSpanEdgeEnumerator.Create (master: TOutliner; y, dy: Integer);
+begin
+  doSkipUSP := false;
+  spans := master.spans;
+  if (dy = 0) or (y < 0) or (y >= master.mHeight) then begin spi := -1; exit; end;
+
+  spi := master.lines[y];
+  if (spi = -1) then exit;
+
+  if (dy < 0) then
+  begin
+    if (y < 1) then begin spi := -1; exit; end;
+    usp := master.lines[y-1];
+  end
+  else
+  begin
+    if (y+1 >= master.mHeight) then begin spi := -1; exit; end;
+    usp := master.lines[y+1];
+  end;
+
+  sx := spans[spi].x0;
+  ex := spans[spi].x1;
+end;
+
+procedure TOutliner.TSpanEdgeEnumerator.nextSPI (); inline;
+begin
+  if (spi <> -1) then spi := spans[spi].next;
+  if (spi <> -1) then
+  begin
+    sx := spans[spi].x0;
+    ex := spans[spi].x1;
+  end;
+end;
+
+function TOutliner.TSpanEdgeEnumerator.MoveNext (): Boolean; inline;
+begin
+  result := false;
+
+  while true do
+  begin
+    if doSkipUSP then
+    begin
+      doSkipUSP := false;
+      // skip usp (this will draw final dot)
+      cur.x0 := spans[usp].x1;
+      cur.x1 := cur.x0;
+      sx := cur.x1+1;
+      assert(sx <= ex);
+      result := true;
+      exit;
+    end;
+
+    if (spi = -1) then exit;
+
+    // skip usp until sx
+    while (usp <> -1) do
+    begin
+      if (spans[usp].x1 < sx) then begin usp := spans[usp].next; continue; end;
+      break;
+    end;
+
+    // no more usps?
+    if (usp = -1) then
+    begin
+      if (sx <= ex) then
+      begin
+        cur.x0 := sx;
+        cur.x1 := ex;
+        nextSPI();
+        result := true;
+      end
+      else
+      begin
+        nextSPI();
+        result := (spi <> -1);
+        if result then
+        begin
+          cur.x0 := sx;
+          cur.x1 := ex;
+        end;
+      end;
+      exit;
+    end;
+
+    // usp covers the whole spi?
+    if (sx >= spans[usp].x0) and (ex <= spans[usp].x1) then
+    begin
+      // yes; next spi
+      nextSPI();
+      continue;
+    end;
+
+    // usp starts after ex?
+    if (ex < spans[usp].x0) then
+    begin
+      // yes; draw that part
+      cur.x0 := sx;
+      cur.x1 := ex;
+      // next spi
+      nextSPI();
+      result := true;
+      exit;
+    end;
+
+    // usp starts after sx?
+    if (sx < spans[usp].x0) then
+    begin
+      // yes; draw that part
+      cur.x0 := sx;
+      cur.x1 := spans[usp].x0;
+      // does usp covers what is left?
+      if (ex <= spans[usp].x1) then
+      begin
+        // yes; next spi
+        nextSPI();
+      end
+      else
+      begin
+        // no; skip usp
+        doSkipUSP := true;
+        //sx := spans[usp].x1+1;
+        //assert(sx <= ex);
+      end;
+      result := true;
+      exit;
+    end
+    else
+    begin
+      // usp starts before sx
+      assert(sx >= spans[usp].x0);
+      assert(ex > spans[usp].x1);
+    end;
+
+    // skip usp (this will draw final dot)
+    doSkipUSP := true;
+  end;
+end;