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, either version 3 of the License, or
6 * (at your option) any later version.
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.
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/>.
16 {.$INCLUDE ../shared/a_modes.inc}
23 next: Integer; // index
28 mWidth, mHeight: Integer;
29 spans: array of TSpan;
30 firstFreeSpan: Integer; // span index or -1
32 lines: array of Integer; // span indicies
35 function allocSpan (ax0, ax1: Integer): Integer; // returns span index
36 procedure freeSpan (idx: Integer);
44 TSpanEnumerator = record
46 spans: array of TSpan;
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;
57 TSpanEdgeEnumerator = record
59 spans: array of TSpan;
65 procedure nextSPI (); inline;
67 constructor Create (master: TOutliner; y, dy: Integer);
68 function MoveNext (): Boolean; inline;
69 function GetEnumerator (): TSpanEdgeEnumerator; inline;
70 property Current: TSpanX read cur;
74 constructor Create (aw, ah: Integer);
75 destructor Destroy (); override;
78 procedure setup (aw, ah: Integer);
80 procedure addSpan (ax0, ax1, y: Integer);
81 procedure addRect (x, y, w, h: Integer);
83 function eachSpanAtY (y: Integer): TSpanEnumerator;
84 function eachSpanEdgeAtY (y, dy: Integer): TSpanEdgeEnumerator;
85 //function GetEnumerator (): TValEnumerator;
88 property width: Integer read mWidth;
89 property height: Integer read mHeight;
93 // ////////////////////////////////////////////////////////////////////////// //
94 function TOutliner.allocSpan (ax0, ax1: Integer): Integer;
96 result := firstFreeSpan;
100 if (usedSpans = Length(spans)) then SetLength(spans, usedSpans+512);
105 firstFreeSpan := spans[result].next;
107 with (spans[result]) do
116 procedure TOutliner.freeSpan (idx: Integer);
118 if (idx >= 0) and (idx < usedSpans) then
120 spans[idx].next := firstFreeSpan;
121 firstFreeSpan := idx;
126 constructor TOutliner.Create (aw, ah: Integer);
134 SetLength(lines, mHeight);
135 for f := 0 to High(lines) do lines[f] := -1;
141 destructor TOutliner.Destroy ();
149 procedure TOutliner.setup (aw, ah: Integer);
155 if (mWidth <> aw) or (mHeight <> ah) then
159 SetLength(lines, mHeight);
161 for f := 0 to High(lines) do lines[f] := -1;
167 procedure TOutliner.clear ();
171 for f := 0 to High(lines) do lines[f] := -1;
177 procedure TOutliner.addSpan (ax0, ax1, y: Integer);
178 procedure fixFrom (spi: Integer);
188 if (spf = -1) then break;
191 if (sp.x1+1 = sn.x0) then
193 //conprintfln("JOIN: sp=(%s,%s); sn=(%s,%s)", sp.x0, sp.x1, sn.x0, sn.x1);
196 else if (sn.x0 <= sp.x1) then
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;
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?
225 lines[y] := allocSpan(ax0, ax1);
228 // starts before the first span?
230 if (ax0 < sp.x0) then
232 // insert new span as the first one
233 sprev := allocSpan(ax0, ax1);
234 spans[sprev].next := scur;
236 // fix invalid spans (if any)
240 // find span to expand
241 while (scur <> -1) do
245 if (sp.x1+1 = ax0) then
251 // starts in current span?
252 if (ax0 >= sp.x0) and (ax0 <= sp.x1) then
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
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
263 // insert before next span
264 sprev := allocSpan(ax0, ax1);
265 spans[sprev].next := sp.next;
274 // just append new span
276 spans[sprev].next := allocSpan(ax0, ax1);
280 procedure TOutliner.addRect (x, y, w, h: Integer);
282 if (w < 1) or (h < 1) then exit;
285 addSpan(x, x+w-1, y);
292 function TOutliner.eachSpanAtY (y: Integer): TSpanEnumerator;
294 result := TSpanEnumerator.Create(self, y);
298 function TOutliner.eachSpanEdgeAtY (y, dy: Integer): TSpanEdgeEnumerator;
300 result := TSpanEdgeEnumerator.Create(self, y, dy);
304 // ////////////////////////////////////////////////////////////////////////// //
305 constructor TOutliner.TSpanEnumerator.Create (master: TOutliner; y: Integer);
307 spans := master.spans;
310 if (y < 0) or (y >= master.mHeight) then exit;
311 cur := master.lines[y];
314 function TOutliner.TSpanEnumerator.MoveNext (): Boolean; inline;
316 if first then first := false
317 else if (cur <> -1) then cur := spans[cur].next;
318 result := (cur <> -1);
321 function TOutliner.TSpanEnumerator.getCurrent (): TSpanX; inline;
323 result.x0 := spans[cur].x0;
324 result.x1 := spans[cur].x1;
327 function TOutliner.TSpanEnumerator.GetEnumerator (): TSpanEnumerator; inline;
333 // ////////////////////////////////////////////////////////////////////////// //
334 function TOutliner.TSpanEdgeEnumerator.GetEnumerator (): TSpanEdgeEnumerator; inline;
339 constructor TOutliner.TSpanEdgeEnumerator.Create (master: TOutliner; y, dy: Integer);
342 spans := master.spans;
343 if (dy = 0) or (y < 0) or (y >= master.mHeight) then begin spi := -1; exit; end;
345 spi := master.lines[y];
346 if (spi = -1) then exit;
350 if (y < 1) then begin spi := -1; exit; end;
351 usp := master.lines[y-1];
355 if (y+1 >= master.mHeight) then begin spi := -1; exit; end;
356 usp := master.lines[y+1];
363 procedure TOutliner.TSpanEdgeEnumerator.nextSPI (); inline;
365 if (spi <> -1) then spi := spans[spi].next;
373 function TOutliner.TSpanEdgeEnumerator.MoveNext (): Boolean; inline;
382 // skip usp (this will draw final dot)
383 cur.x0 := spans[usp].x1;
391 if (spi = -1) then exit;
396 if (spans[usp].x1 < sx) then begin usp := spans[usp].next; continue; end;
413 result := (spi <> -1);
423 // usp covers the whole spi?
424 if (sx >= spans[usp].x0) and (ex <= spans[usp].x1) then
431 // usp starts after ex?
432 if (ex < spans[usp].x0) then
434 // yes; draw that part
443 // usp starts after sx?
444 if (sx < spans[usp].x0) then
446 // yes; draw that part
448 cur.x1 := spans[usp].x0;
449 // does usp covers what is left?
450 if (ex <= spans[usp].x1) then
459 //sx := spans[usp].x1+1;
467 // usp starts before sx
468 assert(sx >= spans[usp].x0);
469 assert(ex > spans[usp].x1);
472 // skip usp (this will draw final dot)