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