src/game/renders/opengl/r_holmes_ol.inc

   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, version 3 of the License ONLY.
   6  *
   7  * This program is distributed in the hope that it will be useful,
   8  * but WITHOUT ANY WARRANTY; without even the implied warranty of
   9  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
  10  * GNU General Public License for more details.
  11  *
  12  * You should have received a copy of the GNU General Public License
  13  * along with this program.  If not, see <http://www.gnu.org/licenses/>.
  14  *)
  15 {.$INCLUDE ../shared/a_modes.inc}
  16 type
  17   TOutliner = class
  18   private
  19     type
  20       TSpan = record
  21         x0, x1: Integer;
  22         next: Integer; // index
  23       end;
  24       PSpan = ^TSpan;
  25
  26   private
  27     mWidth, mHeight: Integer;
  28     spans: array of TSpan;
  29     firstFreeSpan: Integer; // span index or -1
  30     usedSpans: Integer;
  31     lines: array of Integer; // span indicies
  32
  33   private
  34     function allocSpan (ax0, ax1: Integer): Integer; // returns span index
  35     procedure freeSpan (idx: Integer);
  36
  37   public
  38     type
  39       TSpanX = record
  40         x0, x1: Integer;
  41       end;
  42
  43       TSpanEnumerator = record
  44       private
  45         spans: array of TSpan;
  46         cur: Integer;
  47         first: Boolean;
  48       public
  49         constructor Create (master: TOutliner; y: Integer);
  50         function MoveNext (): Boolean; inline;
  51         function getCurrent (): TSpanX; inline;
  52         function GetEnumerator (): TSpanEnumerator; inline;
  53         property Current: TSpanX read getCurrent;
  54       end;
  55
  56       TSpanEdgeEnumerator = record
  57       private
  58         spans: array of TSpan;
  59         spi, usp: Integer;
  60         sx, ex: Integer;
  61         cur: TSpanX;
  62         doSkipUSP: Boolean;
  63       private
  64         procedure nextSPI (); inline;
  65       public
  66         constructor Create (master: TOutliner; y, dy: Integer);
  67         function MoveNext (): Boolean; inline;
  68         function GetEnumerator (): TSpanEdgeEnumerator; inline;
  69         property Current: TSpanX read cur;
  70       end;
  71
  72   public
  73     constructor Create (aw, ah: Integer);
  74     destructor Destroy (); override;
  75
  76     procedure clear ();
  77     procedure setup (aw, ah: Integer);
  78
  79     procedure addSpan (ax0, ax1, y: Integer);
  80     procedure addRect (x, y, w, h: Integer);
  81
  82     function eachSpanAtY (y: Integer): TSpanEnumerator;
  83     function eachSpanEdgeAtY (y, dy: Integer): TSpanEdgeEnumerator;
  84     //function GetEnumerator (): TValEnumerator;
  85
  86   public
  87     property width: Integer read mWidth;
  88     property height: Integer read mHeight;
  89   end;
  90
  91
  92 // ////////////////////////////////////////////////////////////////////////// //
  93 function TOutliner.allocSpan (ax0, ax1: Integer): Integer;
  94 begin
  95   result := firstFreeSpan;
  96   if (result = -1) then
  97   begin
  98     result := usedSpans;
  99     if (usedSpans = Length(spans)) then SetLength(spans, usedSpans+512);
 100     Inc(usedSpans);
 101   end
 102   else
 103   begin
 104     firstFreeSpan := spans[result].next;
 105   end;
 106   with (spans[result]) do
 107   begin
 108     x0 := ax0;
 109     x1 := ax1;
 110     next := -1;
 111   end;
 112 end;
 113
 114
 115 procedure TOutliner.freeSpan (idx: Integer);
 116 begin
 117   if (idx >= 0) and (idx < usedSpans) then
 118   begin
 119     spans[idx].next := firstFreeSpan;
 120     firstFreeSpan := idx;
 121   end;
 122 end;
 123
 124
 125 constructor TOutliner.Create (aw, ah: Integer);
 126 var
 127   f: Integer;
 128 begin
 129   assert(aw > 0);
 130   assert(ah > 0);
 131   mWidth := aw;
 132   mHeight := ah;
 133   SetLength(lines, mHeight);
 134   for f := 0 to High(lines) do lines[f] := -1;
 135   usedSpans := 0;
 136   firstFreeSpan := -1;
 137 end;
 138
 139
 140 destructor TOutliner.Destroy ();
 141 begin
 142   spans := nil;
 143   lines := nil;
 144   inherited;
 145 end;
 146
 147
 148 procedure TOutliner.setup (aw, ah: Integer);
 149 var
 150   f: Integer;
 151 begin
 152   assert(aw > 0);
 153   assert(ah > 0);
 154   if (mWidth <> aw) or (mHeight <> ah) then
 155   begin
 156     mWidth := aw;
 157     mHeight := ah;
 158     SetLength(lines, mHeight);
 159   end;
 160   for f := 0 to High(lines) do lines[f] := -1;
 161   usedSpans := 0;
 162   firstFreeSpan := -1;
 163 end;
 164
 165
 166 procedure TOutliner.clear ();
 167 var
 168   f: Integer;
 169 begin
 170   for f := 0 to High(lines) do lines[f] := -1;
 171   usedSpans := 0;
 172   firstFreeSpan := -1;
 173 end;
 174
 175
 176 procedure TOutliner.addSpan (ax0, ax1, y: Integer);
 177   procedure fixFrom (spi: Integer);
 178   var
 179     sp, sn: PSpan;
 180     spf: Integer;
 181   begin
 182     assert(spi <> -1);
 183     sp := @spans[spi];
 184     while true do
 185     begin
 186       spf := sp.next;
 187       if (spf = -1) then break;
 188       sn := @spans[spf];
 189       // join?
 190       if (sp.x1+1 = sn.x0) then
 191       begin
 192         //conprintfln("JOIN: sp=(%s,%s); sn=(%s,%s)", sp.x0, sp.x1, sn.x0, sn.x1);
 193         sp.x1 := sn.x1;
 194       end
 195       else if (sn.x0 <= sp.x1) then
 196       begin
 197         // overlaps
 198         //conprintfln("OVER: sp=(%s,%s); sn=(%s,%s)", sp.x0, sp.x1, sn.x0, sn.x1);
 199         if (sp.x1 < sn.x1) then sp.x1 := sn.x1;
 200       end
 201       else
 202       begin
 203         break;
 204       end;
 205       sp.next := sn.next;
 206       freeSpan(spf);
 207     end;
 208   end;
 209
 210 var
 211   sprev: Integer = -1;
 212   scur: Integer;
 213   sp: PSpan;
 214 begin
 215   if (ax1 < ax0) then exit;
 216   if (y < 0) or (y >= mHeight) then exit;
 217   if (ax1 < -42) or (ax0 > mWidth+42) then exit;
 218   if (ax0 < -42) then ax0 := -42;
 219   if (ax1 > mWidth+42) then ax1 := mWidth+42;
 220   // new span on empty line?
 221   scur := lines[y];
 222   if (scur = -1) then
 223   begin
 224     lines[y] := allocSpan(ax0, ax1);
 225     exit;
 226   end;
 227   // starts before the first span?
 228   sp := @spans[scur];
 229   if (ax0 < sp.x0) then
 230   begin
 231     // insert new span as the first one
 232     sprev := allocSpan(ax0, ax1);
 233     spans[sprev].next := scur;
 234     lines[y] := sprev;
 235     // fix invalid spans (if any)
 236     fixFrom(sprev);
 237     exit;
 238   end;
 239   // find span to expand
 240   while (scur <> -1) do
 241   begin
 242     sp := @spans[scur];
 243     // join spans?
 244     if (sp.x1+1 = ax0) then
 245     begin
 246       sp.x1 := ax1;
 247       fixFrom(scur);
 248       exit;
 249     end;
 250     // starts in current span?
 251     if (ax0 >= sp.x0) and (ax0 <= sp.x1) then
 252     begin
 253       if (ax1 >= sp.x0) and (ax1 <= sp.x1) then exit; // ends in current span, nothing to do
 254       // extend current span, and fix bad spans
 255       sp.x1 := ax1;
 256       fixFrom(scur);
 257       exit;
 258     end;
 259     // starts after the current span, but before the next span?
 260     if (sp.next <> -1) and (ax0 > sp.x1) and (ax0 < spans[sp.next].x0) then
 261     begin
 262       // insert before next span
 263       sprev := allocSpan(ax0, ax1);
 264       spans[sprev].next := sp.next;
 265       sp.next := sprev;
 266       fixFrom(sp.next);
 267       exit;
 268     end;
 269     // try next span
 270     sprev := scur;
 271     scur := sp.next;
 272   end;
 273   // just append new span
 274   assert(sprev <> -1);
 275   spans[sprev].next := allocSpan(ax0, ax1);
 276 end;
 277
 278
 279 procedure TOutliner.addRect (x, y, w, h: Integer);
 280 begin
 281   if (w < 1) or (h < 1) then exit;
 282   while (h > 0) do
 283   begin
 284     addSpan(x, x+w-1, y);
 285     Inc(y);
 286     Dec(h);
 287   end;
 288 end;
 289
 290
 291 function TOutliner.eachSpanAtY (y: Integer): TSpanEnumerator;
 292 begin
 293   result := TSpanEnumerator.Create(self, y);
 294 end;
 295
 296
 297 function TOutliner.eachSpanEdgeAtY (y, dy: Integer): TSpanEdgeEnumerator;
 298 begin
 299   result := TSpanEdgeEnumerator.Create(self, y, dy);
 300 end;
 301
 302
 303 // ////////////////////////////////////////////////////////////////////////// //
 304 constructor TOutliner.TSpanEnumerator.Create (master: TOutliner; y: Integer);
 305 begin
 306   spans := master.spans;
 307   cur := -1;
 308   first := true;
 309   if (y < 0) or (y >= master.mHeight) then exit;
 310   cur := master.lines[y];
 311 end;
 312
 313 function TOutliner.TSpanEnumerator.MoveNext (): Boolean; inline;
 314 begin
 315        if first then first := false
 316   else if (cur <> -1) then cur := spans[cur].next;
 317   result := (cur <> -1);
 318 end;
 319
 320 function TOutliner.TSpanEnumerator.getCurrent (): TSpanX; inline;
 321 begin
 322   result.x0 := spans[cur].x0;
 323   result.x1 := spans[cur].x1;
 324 end;
 325
 326 function TOutliner.TSpanEnumerator.GetEnumerator (): TSpanEnumerator; inline;
 327 begin
 328   result := self;
 329 end;
 330
 331
 332 // ////////////////////////////////////////////////////////////////////////// //
 333 function TOutliner.TSpanEdgeEnumerator.GetEnumerator (): TSpanEdgeEnumerator; inline;
 334 begin
 335   result := self;
 336 end;
 337
 338 constructor TOutliner.TSpanEdgeEnumerator.Create (master: TOutliner; y, dy: Integer);
 339 begin
 340   doSkipUSP := false;
 341   spans := master.spans;
 342   if (dy = 0) or (y < 0) or (y >= master.mHeight) then begin spi := -1; exit; end;
 343
 344   spi := master.lines[y];
 345   if (spi = -1) then exit;
 346
 347   if (dy < 0) then
 348   begin
 349     if (y < 1) then begin spi := -1; exit; end;
 350     usp := master.lines[y-1];
 351   end
 352   else
 353   begin
 354     if (y+1 >= master.mHeight) then begin spi := -1; exit; end;
 355     usp := master.lines[y+1];
 356   end;
 357
 358   sx := spans[spi].x0;
 359   ex := spans[spi].x1;
 360 end;
 361
 362 procedure TOutliner.TSpanEdgeEnumerator.nextSPI (); inline;
 363 begin
 364   if (spi <> -1) then spi := spans[spi].next;
 365   if (spi <> -1) then
 366   begin
 367     sx := spans[spi].x0;
 368     ex := spans[spi].x1;
 369   end;
 370 end;
 371
 372 function TOutliner.TSpanEdgeEnumerator.MoveNext (): Boolean; inline;
 373 begin
 374   result := false;
 375
 376   while true do
 377   begin
 378     if doSkipUSP then
 379     begin
 380       doSkipUSP := false;
 381       // skip usp (this will draw final dot)
 382       cur.x0 := spans[usp].x1;
 383       cur.x1 := cur.x0;
 384       sx := cur.x1+1;
 385       assert(sx <= ex);
 386       result := true;
 387       exit;
 388     end;
 389
 390     if (spi = -1) then exit;
 391
 392     // skip usp until sx
 393     while (usp <> -1) do
 394     begin
 395       if (spans[usp].x1 < sx) then begin usp := spans[usp].next; continue; end;
 396       break;
 397     end;
 398
 399     // no more usps?
 400     if (usp = -1) then
 401     begin
 402       if (sx <= ex) then
 403       begin
 404         cur.x0 := sx;
 405         cur.x1 := ex;
 406         nextSPI();
 407         result := true;
 408       end
 409       else
 410       begin
 411         nextSPI();
 412         result := (spi <> -1);
 413         if result then
 414         begin
 415           cur.x0 := sx;
 416           cur.x1 := ex;
 417         end;
 418       end;
 419       exit;
 420     end;
 421
 422     // usp covers the whole spi?
 423     if (sx >= spans[usp].x0) and (ex <= spans[usp].x1) then
 424     begin
 425       // yes; next spi
 426       nextSPI();
 427       continue;
 428     end;
 429
 430     // usp starts after ex?
 431     if (ex < spans[usp].x0) then
 432     begin
 433       // yes; draw that part
 434       cur.x0 := sx;
 435       cur.x1 := ex;
 436       // next spi
 437       nextSPI();
 438       result := true;
 439       exit;
 440     end;
 441
 442     // usp starts after sx?
 443     if (sx < spans[usp].x0) then
 444     begin
 445       // yes; draw that part
 446       cur.x0 := sx;
 447       cur.x1 := spans[usp].x0;
 448       // does usp covers what is left?
 449       if (ex <= spans[usp].x1) then
 450       begin
 451         // yes; next spi
 452         nextSPI();
 453       end
 454       else
 455       begin
 456         // no; skip usp
 457         doSkipUSP := true;
 458         //sx := spans[usp].x1+1;
 459         //assert(sx <= ex);
 460       end;
 461       result := true;
 462       exit;
 463     end
 464     else
 465     begin
 466       // usp starts before sx
 467       assert(sx >= spans[usp].x0);
 468       assert(ex > spans[usp].x1);
 469     end;
 470
 471     // skip usp (this will draw final dot)
 472     doSkipUSP := true;
 473   end;
 474 end;