1 (* Copyright (C) Doom 2D: Forever Developers
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.
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.
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/>.
15 {.$INCLUDE ../shared/a_modes.inc}
22 next: Integer; // index
27 mWidth, mHeight: Integer;
28 spans: array of TSpan;
29 firstFreeSpan: Integer; // span index or -1
31 lines: array of Integer; // span indicies
34 function allocSpan (ax0, ax1: Integer): Integer; // returns span index
35 procedure freeSpan (idx: Integer);
43 TSpanEnumerator = record
45 spans: array of TSpan;
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;
56 TSpanEdgeEnumerator = record
58 spans: array of TSpan;
64 procedure nextSPI (); inline;
66 constructor Create (master: TOutliner; y, dy: Integer);
67 function MoveNext (): Boolean; inline;
68 function GetEnumerator (): TSpanEdgeEnumerator; inline;
69 property Current: TSpanX read cur;
73 constructor Create (aw, ah: Integer);
74 destructor Destroy (); override;
77 procedure setup (aw, ah: Integer);
79 procedure addSpan (ax0, ax1, y: Integer);
80 procedure addRect (x, y, w, h: Integer);
82 function eachSpanAtY (y: Integer): TSpanEnumerator;
83 function eachSpanEdgeAtY (y, dy: Integer): TSpanEdgeEnumerator;
84 //function GetEnumerator (): TValEnumerator;
87 property width: Integer read mWidth;
88 property height: Integer read mHeight;
92 // ////////////////////////////////////////////////////////////////////////// //
93 function TOutliner.allocSpan (ax0, ax1: Integer): Integer;
95 result := firstFreeSpan;
99 if (usedSpans = Length(spans)) then SetLength(spans, usedSpans+512);
104 firstFreeSpan := spans[result].next;
106 with (spans[result]) do
115 procedure TOutliner.freeSpan (idx: Integer);
117 if (idx >= 0) and (idx < usedSpans) then
119 spans[idx].next := firstFreeSpan;
120 firstFreeSpan := idx;
125 constructor TOutliner.Create (aw, ah: Integer);
133 SetLength(lines, mHeight);
134 for f := 0 to High(lines) do lines[f] := -1;
140 destructor TOutliner.Destroy ();
148 procedure TOutliner.setup (aw, ah: Integer);
154 if (mWidth <> aw) or (mHeight <> ah) then
158 SetLength(lines, mHeight);
160 for f := 0 to High(lines) do lines[f] := -1;
166 procedure TOutliner.clear ();
170 for f := 0 to High(lines) do lines[f] := -1;
176 procedure TOutliner.addSpan (ax0, ax1, y: Integer);
177 procedure fixFrom (spi: Integer);
187 if (spf = -1) then break;
190 if (sp.x1+1 = sn.x0) then
192 //conprintfln("JOIN: sp=(%s,%s); sn=(%s,%s)", sp.x0, sp.x1, sn.x0, sn.x1);
195 else if (sn.x0 <= sp.x1) then
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;
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?
224 lines[y] := allocSpan(ax0, ax1);
227 // starts before the first span?
229 if (ax0 < sp.x0) then
231 // insert new span as the first one
232 sprev := allocSpan(ax0, ax1);
233 spans[sprev].next := scur;
235 // fix invalid spans (if any)
239 // find span to expand
240 while (scur <> -1) do
244 if (sp.x1+1 = ax0) then
250 // starts in current span?
251 if (ax0 >= sp.x0) and (ax0 <= sp.x1) then
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
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
262 // insert before next span
263 sprev := allocSpan(ax0, ax1);
264 spans[sprev].next := sp.next;
273 // just append new span
275 spans[sprev].next := allocSpan(ax0, ax1);
279 procedure TOutliner.addRect (x, y, w, h: Integer);
281 if (w < 1) or (h < 1) then exit;
284 addSpan(x, x+w-1, y);
291 function TOutliner.eachSpanAtY (y: Integer): TSpanEnumerator;
293 result := TSpanEnumerator.Create(self, y);
297 function TOutliner.eachSpanEdgeAtY (y, dy: Integer): TSpanEdgeEnumerator;
299 result := TSpanEdgeEnumerator.Create(self, y, dy);
303 // ////////////////////////////////////////////////////////////////////////// //
304 constructor TOutliner.TSpanEnumerator.Create (master: TOutliner; y: Integer);
306 spans := master.spans;
309 if (y < 0) or (y >= master.mHeight) then exit;
310 cur := master.lines[y];
313 function TOutliner.TSpanEnumerator.MoveNext (): Boolean; inline;
315 if first then first := false
316 else if (cur <> -1) then cur := spans[cur].next;
317 result := (cur <> -1);
320 function TOutliner.TSpanEnumerator.getCurrent (): TSpanX; inline;
322 result.x0 := spans[cur].x0;
323 result.x1 := spans[cur].x1;
326 function TOutliner.TSpanEnumerator.GetEnumerator (): TSpanEnumerator; inline;
332 // ////////////////////////////////////////////////////////////////////////// //
333 function TOutliner.TSpanEdgeEnumerator.GetEnumerator (): TSpanEdgeEnumerator; inline;
338 constructor TOutliner.TSpanEdgeEnumerator.Create (master: TOutliner; y, dy: Integer);
341 spans := master.spans;
342 if (dy = 0) or (y < 0) or (y >= master.mHeight) then begin spi := -1; exit; end;
344 spi := master.lines[y];
345 if (spi = -1) then exit;
349 if (y < 1) then begin spi := -1; exit; end;
350 usp := master.lines[y-1];
354 if (y+1 >= master.mHeight) then begin spi := -1; exit; end;
355 usp := master.lines[y+1];
362 procedure TOutliner.TSpanEdgeEnumerator.nextSPI (); inline;
364 if (spi <> -1) then spi := spans[spi].next;
372 function TOutliner.TSpanEdgeEnumerator.MoveNext (): Boolean; inline;
381 // skip usp (this will draw final dot)
382 cur.x0 := spans[usp].x1;
390 if (spi = -1) then exit;
395 if (spans[usp].x1 < sx) then begin usp := spans[usp].next; continue; end;
412 result := (spi <> -1);
422 // usp covers the whole spi?
423 if (sx >= spans[usp].x0) and (ex <= spans[usp].x1) then
430 // usp starts after ex?
431 if (ex < spans[usp].x0) then
433 // yes; draw that part
442 // usp starts after sx?
443 if (sx < spans[usp].x0) then
445 // yes; draw that part
447 cur.x1 := spans[usp].x0;
448 // does usp covers what is left?
449 if (ex <= spans[usp].x1) then
458 //sx := spans[usp].x1+1;
466 // usp starts before sx
467 assert(sx >= spans[usp].x0);
468 assert(ex > spans[usp].x1);
471 // skip usp (this will draw final dot)