MODULE GfxRegions;
CONST
Winding* = 0;
EvenOdd* = 1;
UBound* = MAX(INTEGER) DIV 2;
LBound* = MIN(INTEGER) DIV 2;
BlockSize = 512;
Enter = 1; Exit = -1;
FirstSlice = 2;
Bottom = MIN(INTEGER); Top = MAX(INTEGER);
TYPE
RegionData = POINTER TO ARRAY OF LONGINT;
Region* = POINTER TO RegionDesc;
RegionDesc* = RECORD
llx*, lly*, urx*, ury*: INTEGER;
mode*: INTEGER;
valid: BOOLEAN;
data: RegionData;
points: LONGINT;
END;
EnumData* = RECORD END;
Enumerator* = PROCEDURE (llx, lly, urx, ury: INTEGER; VAR edata: EnumData);
VAR
Data: RegionData;
DataSize: LONGINT;
RectRegion: Region;
PROCEDURE IncludePoint* (VAR llx, lly, urx, ury: INTEGER; x, y: INTEGER);
BEGIN
IF x < llx THEN llx := x END;
IF x > urx THEN urx := x END;
IF y < lly THEN lly := y END;
IF y > ury THEN ury := y END
END IncludePoint;
PROCEDURE IncludeRect* (VAR llx, lly, urx, ury: INTEGER; illx, illy, iurx, iury: INTEGER);
BEGIN
IF illx < llx THEN llx := illx END;
IF iurx > urx THEN urx := iurx END;
IF illy < lly THEN lly := illy END;
IF iury > ury THEN ury := iury END
END IncludeRect;
PROCEDURE ClipRect* (VAR llx, lly, urx, ury: INTEGER; cllx, clly, curx, cury: INTEGER);
BEGIN
IF cllx > llx THEN llx := cllx END;
IF curx < urx THEN urx := curx END;
IF clly > lly THEN lly := clly END;
IF cury < ury THEN ury := cury END
END ClipRect;
PROCEDURE RectEmpty* (llx, lly, urx, ury: INTEGER): BOOLEAN;
BEGIN
RETURN (llx >= urx) OR (lly >= ury)
END RectEmpty;
PROCEDURE RectInRect* (llx, lly, urx, ury, illx, illy, iurx, iury: INTEGER): BOOLEAN;
BEGIN
RETURN (llx >= illx) & (urx <= iurx) & (lly >= illy) & (ury <= iury)
END RectInRect;
PROCEDURE RectsIntersect* (llx, lly, urx, ury, illx, illy, iurx, iury: INTEGER): BOOLEAN;
BEGIN
RETURN (llx < iurx) & (urx > illx) & (lly < iury) & (ury > illy)
END RectsIntersect;
PROCEDURE PointInRect* (x, y: INTEGER; llx, lly, urx, ury: INTEGER): BOOLEAN;
BEGIN
RETURN (x >= llx) & (x < urx) & (y >= lly) & (y < ury)
END PointInRect;
PROCEDURE Min (x, y: INTEGER): INTEGER;
BEGIN
IF x <= y THEN RETURN x ELSE RETURN y END
END Min;
PROCEDURE Max (x, y: INTEGER): INTEGER;
BEGIN
IF x >= y THEN RETURN x ELSE RETURN y END
END Max;
PROCEDURE Encode (VAR item: LONGINT; u, v, dir: LONGINT);
BEGIN
item := ASH(v, 16) + ASH((u + 4000H) MOD 8000H, 1) + ASH(1 + dir, -1)
END Encode;
PROCEDURE Decode (item: LONGINT; VAR u, v, dir: INTEGER);
BEGIN
v := INTEGER(ASH(item, -16));
u := INTEGER(ASH(item, -1) MOD 8000H - 4000H);
dir := INTEGER(ASH(item MOD 2, 1) - 1)
END Decode;
PROCEDURE CopyPoints (src, dst: RegionData; points: LONGINT);
VAR i: LONGINT;
BEGIN
i := 0;
WHILE i < points DO
dst[i] := src[i];
INC(i)
END
END CopyPoints;
PROCEDURE Append (reg: Region; u, v, dir: INTEGER);
VAR size: LONGINT; data: RegionData;
BEGIN
IF reg.data = NIL THEN
NEW(reg.data, BlockSize)
ELSIF reg.points >= LEN(reg.data^) THEN
size := LEN(reg.data^) + BlockSize;
NEW(data, size);
CopyPoints(reg.data, data, reg.points);
reg.data := data
END;
Encode(reg.data[reg.points], u, v, dir);
INC(reg.points)
END Append;
PROCEDURE CopyData (src, dst: Region);
VAR size: LONGINT;
BEGIN
IF src.points > 0 THEN
IF (dst.data = NIL) OR (LEN(dst.data^) < src.points) THEN
size := src.points + (-src.points) MOD BlockSize;
NEW(dst.data, size)
END;
CopyPoints(src.data, dst.data, src.points)
END;
dst.points := src.points;
dst.llx := src.llx; dst.lly := src.lly;
dst.urx := src.urx; dst.ury := src.ury;
dst.valid := src.valid
END CopyData;
PROCEDURE CalcRect (reg: Region);
VAR data: RegionData; n: LONGINT; u, v, dir, x: INTEGER;
BEGIN
ASSERT(reg.valid);
IF reg.points > 0 THEN
data := reg.data;
n := FirstSlice;
Decode(data[n], u, v, dir);
reg.llx := u; reg.urx := u; reg.lly := v;
REPEAT
reg.ury := v; x := u;
REPEAT
IF (dir = Enter) & (u < reg.llx) THEN
reg.llx := u; x := u
ELSIF (dir = Exit) & (u > reg.urx) & (u > x) THEN
reg.urx := u
END;
INC(n);
Decode(data[n], u, v, dir)
UNTIL v > reg.ury;
UNTIL v = Top
END
END CalcRect;
PROCEDURE SortRange (data: RegionData; lo, hi: LONGINT);
CONST limit = 8;
VAR i, x, j, t: LONGINT;
BEGIN
IF hi - lo < limit THEN
i := lo + 1;
WHILE i <= hi DO
x := data[i];
j := i;
WHILE (j > lo) & (x < data[j - 1]) DO
data[j] := data[j - 1];
DEC(j)
END;
data[j] := x;
INC(i)
END
ELSE
i := lo; j := hi;
x := data[(lo + hi) DIV 2];
REPEAT
WHILE data[i] < x DO INC(i) END;
WHILE data[j] > x DO DEC(j) END;
IF i <= j THEN
t := data[i]; data[i] := data[j]; data[j] := t;
INC(i); DEC(j)
END
UNTIL i > j;
IF lo < j THEN SortRange(data, lo, j) END;
IF i < hi THEN SortRange(data, i, hi) END
END
END SortRange;
PROCEDURE Compact (reg: Region; src: RegionData);
VAR rslice, dslice, sn, rn, dn: LONGINT; dst: RegionData; su, sv, sdir, ru, rv, rdir, sy, ry: INTEGER;
BEGIN
rslice := 0;
dslice := FirstSlice;
sn := FirstSlice;
dst := reg.data;
Decode(src[sn], su, sv, sdir);
REPEAT
rn := rslice; dn := dslice;
Decode(dst[rn], ru, rv, rdir);
sy := sv; ry := rv;
WHILE (sv = sy) & (rv = ry) & (su = ru) & (sdir = rdir) DO
dst[dn] := src[sn];
INC(dn); INC(sn); INC(rn);
Decode(src[sn], su, sv, sdir);
Decode(dst[rn], ru, rv, rdir)
END;
IF (sv = sy) OR (rv = ry) THEN
WHILE sv = sy DO
dst[dn] := src[sn];
INC(dn); INC(sn);
Decode(src[sn], su, sv, sdir)
END;
rslice := dslice;
dslice := dn
END
UNTIL sv = Top;
IF dn = 6 THEN
Decode(dst[FirstSlice], reg.llx, reg.lly, rdir);
Decode(dst[FirstSlice + 1], reg.urx, reg.lly, rdir);
Decode(dst[FirstSlice + 2], ru, reg.ury, rdir);
reg.points := 0
ELSE
Encode(dst[dn], UBound, Top, Exit);
reg.points := dn + 1
END
END Compact;
PROCEDURE Merge (reg: Region; split: LONGINT);
VAR data: RegionData; n, N, m, M, p, tmp: LONGINT; nu, nv, ndir, mu, mv, mdir, sum, u, v, inc, nsum: INTEGER;
BEGIN
data := reg.data;
n := 0; N := split;
Decode(data[n], nu, nv, ndir);
m := split; M := reg.points;
Decode(data[m], mu, mv, mdir);
p := 0;
Append(reg, UBound, Top, Exit);
IF DataSize <= M THEN
DataSize := M - M MOD BlockSize + BlockSize;
NEW(Data, DataSize)
END;
WHILE (n < N) & (m < M) DO
tmp := p;
v := Min(nv, mv);
sum := 0;
REPEAT
IF (nv < mv) OR (nv = mv) & (nu <= mu) THEN
u := nu; inc := ndir;
INC(n);
Decode(data[n], nu, nv, ndir)
ELSE
u := mu; inc := mdir;
INC(m);
Decode(data[m], mu, mv, mdir)
END;
WHILE (nv = v) & (nu = u) DO
INC(inc, ndir); INC(n);
Decode(data[n], nu, nv, ndir)
END;
WHILE (mv = v) & (mu = u) DO
INC(inc, mdir); INC(m);
Decode(data[m], mu, mv, mdir)
END;
IF inc # 0 THEN
nsum := sum + inc;
IF reg.mode = Winding THEN
IF (sum <= 0) & (nsum > 0) THEN
Encode(Data[p], u, v, Enter); INC(p)
ELSIF (sum > 0) & (nsum <= 0) THEN
Encode(Data[p], u, v, Exit); INC(p)
END
ELSIF (reg.mode = EvenOdd) & ((sum > 0) & ODD(sum) # (nsum > 0) & ODD(nsum)) THEN
IF ODD(sum) THEN
Encode(Data[p], u, v, Exit)
ELSE
Encode(Data[p], u, v, Enter)
END;
INC(p)
END;
sum := nsum
END
UNTIL (nv > v) & (mv > v);
IF p = tmp THEN
Encode(Data[p], UBound, v, Enter); INC(p);
Encode(Data[p], UBound, v, Exit); INC(p)
END
END;
WHILE n < N DO
Data[p] := data[n];
INC(p); INC(n)
END;
WHILE m < M DO
Data[p] := data[m];
INC(p); INC(m)
END;
Compact(reg, Data)
END Merge;
PROCEDURE Validate (reg: Region);
VAR data: RegionData; points, rn, wn, tmp: LONGINT; u, v, dir, y, sum, x, inc: INTEGER;
BEGIN
IF ~reg.valid THEN
data := reg.data;
SortRange(data, 0, reg.points - 1);
points := reg.points;
rn := FirstSlice; wn := FirstSlice;
Decode(data[rn], u, v, dir);
REPEAT
tmp := wn;
y := v;
sum := 0;
REPEAT
x := u; inc := 0;
REPEAT
INC(inc, dir); INC(rn);
Decode(data[rn], u, v, dir)
UNTIL (v > y) OR (u > x);
IF x < UBound THEN
IF reg.mode = Winding THEN
IF sum = 0 THEN
Encode(data[wn], x, y, Enter); INC(wn);
INC(x)
END;
INC(sum, inc);
IF sum = 0 THEN
Encode(data[wn], x, y, Exit); INC(wn)
END
ELSIF reg.mode = EvenOdd THEN
IF ~ODD(sum) THEN
Encode(data[wn], x, y, Enter); INC(wn);
INC(x)
END;
INC(sum, inc);
IF ~ODD(sum) THEN
Encode(data[wn], x, y, Exit); INC(wn)
END
END
END
UNTIL v > y;
IF wn = tmp THEN
Encode(data[wn], UBound, y, Enter); INC(wn);
Encode(data[wn], UBound, y, Exit); INC(wn)
ELSIF v > y + 1 THEN
INC(y);
Append(reg, UBound, y, Enter);
Append(reg, UBound, y, Exit)
END
UNTIL v = Top;
Encode(data[wn], UBound, Top, Exit); INC(wn);
IF reg.points > points THEN
IF wn < points THEN
rn := points; points := wn;
REPEAT
data[wn] := reg.data[rn];
INC(wn); INC(rn)
UNTIL rn = reg.points;
reg.data := data;
reg.points := wn
END;
Merge(reg, points)
ELSE
reg.points := wn;
Compact(reg, reg.data)
END;
reg.valid := TRUE
END
END Validate;
PROCEDURE FindUpper (reg: Region; y: INTEGER; VAR n: LONGINT);
VAR item, i, j, m: LONGINT;
BEGIN
item := ASH(LONG(y), 16);
i := 0; j := reg.points;
WHILE i + 1 < j DO
m := (i + j) DIV 2;
IF reg.data[m] < item THEN
i := m
ELSE
j := m
END
END;
n := j
END FindUpper;
PROCEDURE FindLower (reg: Region; y: INTEGER; VAR n: LONGINT);
VAR v: INTEGER;
BEGIN
FindUpper(reg, y, n);
v := INTEGER(ASH(reg.data[n], -16));
IF v > y THEN
DEC(n);
y := INTEGER(ASH(reg.data[n], -16));
REPEAT
DEC(n)
UNTIL (n < 0) OR (ASH(reg.data[n], -16) < y);
INC(n)
END
END FindLower;
PROCEDURE Enum (reg: Region; llx, lly, urx, ury: INTEGER; enum: Enumerator; VAR edata: EnumData; enter: INTEGER);
VAR data: RegionData; n, lo, hi: LONGINT; u, v, dir, y, top, x: INTEGER;
BEGIN
Validate(reg);
ClipRect(llx, lly, urx, ury, LBound, LBound, UBound, UBound);
data := reg.data;
FindLower(reg, lly, n);
Decode(data[n], u, v, dir);
y := lly;
REPEAT
lo := n;
REPEAT
INC(n);
IF u < llx THEN
lo := n
END;
Decode(data[n], u, v, dir)
UNTIL v > y;
hi := n;
top := Min(v, ury);
n := lo;
Decode(data[n], u, v, dir);
x := llx;
WHILE (v <= y) & ((u < urx) OR (dir # enter)) DO
IF u > x THEN
IF dir = enter THEN
x := u
ELSE
enum(x, y, Min(u, urx), top, edata)
END
END;
INC(n);
Decode(data[n], u, v, dir)
END;
IF n < hi THEN
n := hi;
Decode(data[n], u, v, dir)
END;
y := v
UNTIL v >= ury
END Enum;
PROCEDURE MakeData (reg: Region);
BEGIN
IF reg.points = 0 THEN
Append(reg, UBound, Bottom, Enter);
Append(reg, UBound, Bottom, Exit);
IF (reg.llx <= reg.urx) & (reg.lly <= reg.ury) THEN
Append(reg, reg.llx, reg.lly, Enter);
Append(reg, reg.urx, reg.lly, Exit);
Append(reg, UBound, reg.ury, Enter);
Append(reg, UBound, reg.ury, Exit)
END;
Append(reg, UBound, Top, Enter)
END
END MakeData;
PROCEDURE Empty* (reg: Region): BOOLEAN;
BEGIN
RETURN (reg.llx >= reg.urx) OR (reg.lly >= reg.ury)
END Empty;
PROCEDURE IsRect* (reg: Region): BOOLEAN;
BEGIN
Validate(reg);
RETURN reg.points = 0
END IsRect;
PROCEDURE PointInside* (x, y: INTEGER; reg: Region): BOOLEAN;
VAR data: RegionData; n: LONGINT; u, v, dir: INTEGER;
BEGIN
IF ~PointInRect(x, y, reg.llx, reg.lly, reg.urx, reg.ury) THEN
RETURN FALSE
ELSIF IsRect(reg) THEN
RETURN TRUE
END;
data := reg.data;
FindLower(reg, y, n);
Decode(data[n], u, v, dir);
WHILE u < x DO
INC(n);
Decode(data[n], u, v, dir)
END;
RETURN (u = x) & (dir = Enter) OR (u > x) & (dir = Exit)
END PointInside;
PROCEDURE RectInside* (llx, lly, urx, ury: INTEGER; reg: Region): BOOLEAN;
VAR data: RegionData; n: LONGINT; u, v, dir, y: INTEGER;
BEGIN
IF ~RectInRect(llx, lly, urx, ury, reg.llx, reg.lly, reg.urx, reg.ury) THEN
RETURN FALSE
ELSIF IsRect(reg) THEN
RETURN TRUE
END;
data := reg.data;
FindLower(reg, lly, n);
Decode(data[n], u, v, dir);
REPEAT
y := v;
WHILE (v = y) & (u <= llx) DO
INC(n);
Decode(data[n], u, v, dir)
END;
IF (v > y) OR (u < urx) OR (dir = Enter) THEN
RETURN FALSE
END;
WHILE v = y DO
INC(n);
Decode(data[n], u, v, dir)
END
UNTIL v >= ury;
RETURN TRUE
END RectInside;
PROCEDURE RectOverlaps* (llx, lly, urx, ury: INTEGER; reg: Region): BOOLEAN;
VAR data: RegionData; n: LONGINT; u, v, dir, y: INTEGER;
BEGIN
IF ~RectsIntersect(llx, lly, urx, ury, reg.llx, reg.lly, reg.urx, reg.ury) THEN
RETURN FALSE
ELSIF IsRect(reg) THEN
RETURN TRUE
END;
ClipRect(llx, lly, urx, ury, reg.llx, reg.lly, reg.urx, reg.ury);
data := reg.data;
FindLower(reg, lly, n);
Decode(data[n], u, v, dir);
REPEAT
y := v;
WHILE (v = y) & (u <= llx) DO
INC(n);
Decode(data[n], u, v, dir)
END;
IF (v = y) & ((u < urx) OR (dir = Exit)) THEN
RETURN TRUE
END;
WHILE v = y DO
INC(n);
Decode(data[n], u, v, dir)
END
UNTIL v >= ury;
RETURN FALSE
END RectOverlaps;
PROCEDURE RegionInside* (inner, outer: Region): BOOLEAN;
VAR idata, odata: RegionData; in, on, is, os: LONGINT; iu, iv, idir, ou, ov, odir, iy, oy: INTEGER;
BEGIN
IF ~RectInRect(inner.llx, inner.lly, inner.urx, inner.ury, outer.llx, outer.lly, outer.urx, outer.ury) THEN
RETURN FALSE
ELSIF IsRect(outer) THEN
RETURN TRUE
ELSIF IsRect(inner) THEN
RETURN RectInside(inner.llx, inner.lly, inner.urx, inner.ury, outer)
END;
idata := inner.data; odata := outer.data;
in := FirstSlice;
FindLower(outer, inner.lly, on);
Decode(idata[in], iu, iv, idir);
Decode(odata[on], ou, ov, odir);
is := in; os := on;
REPEAT
iy := iv; oy := ov;
WHILE (iv = iy) & (iu = UBound) DO
INC(in);
Decode(idata[in], iu, iv, idir)
END;
WHILE (iv = iy) OR (ov = oy) DO
IF (ov > oy) OR (iv = iy) & (idir = Exit) & (odir = Enter) THEN
RETURN FALSE
END;
IF (iv > iy) OR (ou <= iu) THEN
INC(on);
Decode(odata[on], ou, ov, odir)
ELSE
INC(in);
Decode(idata[in], iu, iv, idir)
END
END;
IF iv > ov THEN
in := is; os := on;
Decode(idata[in], iu, iv, idir)
ELSIF ov > iv THEN
on := os; is := in;
Decode(odata[on], ou, ov, odir)
ELSE
is := in; os := on
END
UNTIL iv = inner.ury;
RETURN TRUE
END RegionInside;
PROCEDURE RegionOverlaps* (reg, arg: Region): BOOLEAN;
VAR rdata, adata: RegionData; bot, top, ru, rv, rdir, au, av, adir, ry, ay: INTEGER; rn, an, rs, as: LONGINT;
BEGIN
IF ~RectsIntersect(reg.llx, reg.lly, reg.urx, reg.ury, arg.llx, arg.lly, arg.urx, arg.ury) THEN
RETURN FALSE
ELSIF IsRect(reg) THEN
RETURN RectOverlaps(reg.llx, reg.lly, reg.urx, reg.ury, arg)
ELSIF IsRect(arg) THEN
RETURN RectOverlaps(arg.llx, arg.lly, arg.urx, arg.ury, reg)
END;
rdata := reg.data; adata := arg.data;
bot := Max(reg.lly, arg.lly);
top := Min(reg.ury, arg.ury);
FindLower(reg, bot, rn);
FindLower(arg, bot, an);
Decode(rdata[rn], ru, rv, rdir);
Decode(adata[an], au, av, adir);
rs := rn; as := an;
REPEAT
ry := rv; ay := av;
WHILE (rv = ry) OR (av = ay) DO
IF (rv = ry) & (av = ay) & (rdir = Exit) & (adir = Exit) THEN
RETURN TRUE
END;
IF (av > ay) OR (rv = ry) & (ru <= au) THEN
INC(rn);
Decode(rdata[rn], ru, rv, rdir)
ELSE
INC(an);
Decode(adata[an], au, av, adir)
END
END;
IF rv > av THEN
rn := rs; as := an;
Decode(rdata[rn], ru, rv, rdir)
ELSIF av > rv THEN
an := as; rs := rn;
Decode(adata[an], au, av, adir)
ELSE
rs := rn; as := an
END
UNTIL (rv = top) OR (av = top);
RETURN FALSE
END RegionOverlaps;
PROCEDURE Enumerate* (reg: Region; llx, lly, urx, ury: INTEGER; enum: Enumerator; VAR edata: EnumData);
BEGIN
IF RectsIntersect(reg.llx, reg.lly, reg.urx, reg.ury, llx, lly, urx, ury) THEN
ClipRect(llx, lly, urx, ury, reg.llx, reg.lly, reg.urx, reg.ury);
IF ~RectEmpty(llx, lly, urx, ury) THEN
IF IsRect(reg) THEN
enum(llx, lly, urx, ury, edata)
ELSE
Enum(reg, llx, lly, urx, ury, enum, edata, Enter)
END
END
END
END Enumerate;
PROCEDURE EnumerateInv* (reg: Region; llx, lly, urx, ury: INTEGER; enum: Enumerator; VAR edata: EnumData);
BEGIN
IF RectsIntersect(reg.llx, reg.lly, reg.urx, reg.ury, llx, lly, urx, ury) THEN
IF IsRect(reg) & RectInRect(reg.llx, reg.lly, reg.urx, reg.ury, llx, lly, urx, ury) THEN
IF lly < reg.lly THEN enum(llx, lly, urx, reg.lly, edata) END;
IF llx < reg.llx THEN enum(llx, reg.lly, reg.llx, reg.ury, edata) END;
IF urx > reg.urx THEN enum(reg.urx, reg.lly, urx, reg.ury, edata) END;
IF ury > reg.ury THEN enum(llx, reg.ury, urx, ury, edata) END
ELSE
Enum(reg, llx, lly, urx, ury, enum, edata, Exit)
END
ELSE
enum(llx, lly, urx, ury, edata)
END
END EnumerateInv;
PROCEDURE Clear* (reg: Region);
BEGIN
reg.llx := UBound; reg.lly := UBound;
reg.urx := LBound; reg.ury := LBound;
reg.valid := TRUE;
reg.points := 0
END Clear;
PROCEDURE SetMode* (reg: Region; mode: INTEGER);
BEGIN
reg.mode := mode
END SetMode;
PROCEDURE Init* (reg: Region; mode: INTEGER);
BEGIN
reg.mode := mode;
reg.data := NIL;
Clear(reg)
END Init;
PROCEDURE SetToRect* (reg: Region; llx, lly, urx, ury: INTEGER);
BEGIN
IF RectEmpty(llx, lly, urx, ury) THEN
Clear(reg)
ELSE
ClipRect(llx, lly, urx, ury, LBound, LBound, UBound, UBound);
reg.llx := llx; reg.lly := lly; reg.urx := urx; reg.ury := ury;
reg.valid := TRUE;
reg.points := 0
END
END SetToRect;
PROCEDURE Shift* (reg: Region; dx, dy: INTEGER);
VAR rdata: RegionData; rn: LONGINT; ru, rv, rdir: INTEGER;
BEGIN
IF (dx # 0) OR (dy # 0) THEN
INC(reg.llx, dx); INC(reg.lly, dy); INC(reg.urx, dx); INC(reg.ury, dy);
IF reg.points > 0 THEN
rdata := reg.data; rn := FirstSlice;
Decode(rdata[rn], ru, rv, rdir);
WHILE rv < Top DO
IF (ru <= LBound) OR (ru + dx <= LBound) THEN ru := LBound
ELSIF (ru >= UBound) OR (ru + dx >= UBound) THEN ru := UBound
ELSE INC(ru, dx)
END;
IF (dy < 0) & (rv < Bottom - dy) THEN rv := Bottom
ELSIF (dy > 0) & (rv > Top - dy) THEN rv := Top
ELSE INC(rv, dy)
END;
Encode(rdata[rn], ru, rv, rdir);
INC(rn);
Decode(rdata[rn], ru, rv, rdir)
END
END
END
END Shift;
PROCEDURE Copy* (from, to: Region);
BEGIN
to.mode := from.mode;
CopyData(from, to)
END Copy;
PROCEDURE Add* (reg, arg: Region);
VAR rdata, adata: RegionData; points, aslice, an, rn, rslice: LONGINT; au, av, adir, ru, rv, rdir, top, ry, ay, y: INTEGER;
BEGIN
IF ~RectEmpty(arg.llx, arg.lly, arg.urx, arg.ury) THEN
IF RectEmpty(reg.llx, reg.lly, reg.urx, reg.ury) THEN
CopyData(arg, reg)
ELSIF IsRect(arg) & RectInside(arg.llx, arg.lly, arg.urx, arg.ury, reg) THEN
ELSIF IsRect(reg) & RectInside(reg.llx, reg.lly, reg.urx, reg.ury, arg) THEN
CopyData(arg, reg)
ELSE
Validate(reg); Validate(arg);
MakeData(reg); MakeData(arg);
rdata := reg.data; adata := arg.data;
points := reg.points;
IF arg.lly < reg.lly THEN
FindUpper(arg, reg.lly, aslice);
an := FirstSlice;
WHILE an < aslice DO
Decode(adata[an], au, av, adir);
Append(reg, au, av, adir);
INC(an)
END;
rn := FirstSlice;
FindLower(arg, reg.lly, an)
ELSE
FindLower(reg, arg.lly, rn);
an := FirstSlice
END;
Decode(rdata[rn], ru, rv, rdir);
Decode(adata[an], au, av, adir);
rslice := rn; aslice := an;
top := Min(reg.ury, arg.ury);
WHILE (av < top) OR (rv < top) DO
ry := rv; ay := av; y := Max(ry, ay);
REPEAT
IF (av > ay) OR (rv = ry) & (ru <= au) THEN
IF rv # y THEN
Append(reg, ru, y, rdir)
END;
INC(rn);
Decode(rdata[rn], ru, rv, rdir)
ELSE
Append(reg, au, y, adir);
INC(an);
Decode(adata[an], au, av, adir)
END
UNTIL (rv > ry) & (av > ay);
IF rv < av THEN
an := aslice; rslice := rn;
Decode(adata[an], au, av, adir)
ELSIF av < rv THEN
rn := rslice; aslice := an;
Decode(rdata[rn], ru, rv, rdir)
ELSE
rslice := rn; aslice := an
END
END;
IF arg.ury > reg.ury THEN
REPEAT
Append(reg, au, av, adir);
INC(an);
Decode(adata[an], au, av, adir)
UNTIL av = Top
END;
Merge(reg, points);
IncludeRect(reg.llx, reg.lly, reg.urx, reg.ury, arg.llx, arg.lly, arg.urx, arg.ury)
END
END
END Add;
PROCEDURE AddRect* (reg: Region; llx, lly, urx, ury: INTEGER);
BEGIN
SetToRect(RectRegion, llx, lly, urx, ury);
Add(reg, RectRegion)
END AddRect;
PROCEDURE Subtract* (reg, arg: Region);
VAR rdata, adata: RegionData; points, rn, an, rslice, aslice: LONGINT; ru, rv, rdir, au, av, adir, top, ry, ay, y: INTEGER;
BEGIN
IF ~RectEmpty(arg.llx, arg.lly, arg.urx, arg.ury) THEN
IF RectEmpty(reg.llx, reg.lly, reg.urx, reg.ury) OR RegionInside(reg, arg) THEN
Clear(reg)
ELSIF RectsIntersect(reg.llx, reg.lly, reg.urx, reg.ury, arg.llx, arg.lly, arg.urx, arg.ury) THEN
Validate(reg); Validate(arg);
MakeData(reg); MakeData(arg);
rdata := reg.data; adata := arg.data;
points := reg.points;
IF reg.lly <= arg.lly THEN
FindLower(reg, arg.lly, rn);
an := FirstSlice
ELSE
rn := FirstSlice;
FindLower(arg, reg.lly, an)
END;
Decode(rdata[rn], ru, rv, rdir);
Decode(adata[an], au, av, adir);
rslice := rn; aslice := an;
top := Min(reg.ury, arg.ury);
WHILE (rv < top) OR (av < top) DO
ry := rv; ay := av; y := Max(ry, ay);
REPEAT
IF (av > ay) OR (rv = ry) & (ru <= au) THEN
IF rv # y THEN
Append(reg, ru, y, rdir)
END;
INC(rn);
Decode(rdata[rn], ru, rv, rdir)
ELSE
Append(reg, au, y, -adir);
INC(an);
Decode(adata[an], au, av, adir)
END
UNTIL (rv > ry) & (av > ay);
IF rv < av THEN
an := aslice; rslice := rn;
Decode(adata[an], au, av, adir)
ELSIF av < rv THEN
rn := rslice; aslice := an;
Decode(rdata[rn], ru, rv, rdir)
ELSE
rslice := rn; aslice := an
END
END;
Merge(reg, points);
CalcRect(reg)
END
END
END Subtract;
PROCEDURE SubtractRect* (reg: Region; llx, lly, urx, ury: INTEGER);
BEGIN
SetToRect(RectRegion, llx, lly, urx, ury);
Subtract(reg, RectRegion)
END SubtractRect;
PROCEDURE Intersect* (reg, arg: Region);
VAR rdata, adata: RegionData; points, rn, an, rslice, aslice: LONGINT; ru, rv, rdir, au, av, adir, ry, ay, y: INTEGER;
BEGIN
IF ~RectsIntersect(reg.llx, reg.lly, reg.urx, reg.ury, arg.llx, arg.lly, arg.urx, arg.ury) THEN
Clear(reg)
ELSIF ~RectInside(reg.llx, reg.lly, reg.urx, reg.ury, arg) THEN
Validate(reg); Validate(arg);
MakeData(reg); MakeData(arg);
rdata := reg.data; adata := arg.data;
points := reg.points;
IF reg.ury > arg.ury THEN
FindUpper(reg, arg.ury, points);
Encode(rdata[points], UBound, arg.ury, Enter); INC(points);
Encode(rdata[points], UBound, arg.ury, Exit); INC(points);
Encode(rdata[points], UBound, Top, Exit); INC(points);
reg.points := points
END;
IF reg.lly < arg.lly THEN
FindLower(reg, arg.lly, rn);
IF rn > FirstSlice THEN
points := FirstSlice;
WHILE rn < reg.points DO
rdata[points] := rdata[rn];
INC(points); INC(rn)
END;
reg.points := points
END;
rn := FirstSlice;
Decode(rdata[rn], ru, rv, rdir);
ry := rv;
REPEAT
Encode(rdata[rn], ru, arg.lly, rdir);
INC(rn);
Decode(rdata[rn], ru, rv, rdir)
UNTIL rv > ry;
rn := FirstSlice; an := FirstSlice
ELSE
rn := FirstSlice;
FindLower(arg, reg.lly, an)
END;
Decode(rdata[rn], ru, rv, rdir);
Decode(adata[an], au, av, adir);
rslice := rn; aslice := an;
WHILE rv < reg.ury DO
ry := rv; ay := av; y := Max(ry, ay);
Append(reg, LBound, y, Exit);
REPEAT
IF (av > ay) OR (rv = ry) & (ru <= au) THEN
IF rv # y THEN
Append(reg, ru, y, rdir)
END;
INC(rn);
Decode(rdata[rn], ru, rv, rdir)
ELSE
Append(reg, au, y, adir);
INC(an);
Decode(adata[an], au, av, adir)
END
UNTIL (rv > ry) & (av > ay);
Append(reg, UBound, y, Enter);
IF rv < av THEN
an := aslice; rslice := rn;
Decode(adata[an], au, av, adir)
ELSIF av < rv THEN
rn := rslice; aslice := an;
Decode(rdata[rn], ru, rv, rdir)
ELSE
rslice := rn; aslice := an
END
END;
Merge(reg, points);
CalcRect(reg)
END
END Intersect;
PROCEDURE IntersectRect* (reg: Region; llx, lly, urx, ury: INTEGER);
BEGIN
SetToRect(RectRegion, llx, lly, urx, ury);
Intersect(reg, RectRegion)
END IntersectRect;
PROCEDURE Invert* (reg: Region);
VAR data: RegionData; points, n: LONGINT; u, v, dir, y: INTEGER;
BEGIN
IF RectEmpty(reg.llx, reg.lly, reg.urx, reg.ury) THEN
SetToRect(reg, LBound, LBound, UBound, UBound)
ELSE
Validate(reg);
MakeData(reg);
data := reg.data;
points := reg.points;
n := FirstSlice;
Decode(data[n], u, v, dir);
IF reg.lly > LBound THEN
Append(reg, LBound, LBound, Enter);
Append(reg, UBound, LBound, Exit)
END;
REPEAT
y := v;
Append(reg, LBound, y, Enter);
REPEAT
Encode(data[n], u, y, -dir);
INC(n);
Decode(data[n], u, y, dir)
UNTIL v > y;
Append(reg, UBound, y, Exit)
UNTIL v >= UBound;
IF y < UBound THEN
Append(reg, LBound, y, Enter);
Append(reg, UBound, y, Exit)
END;
Merge(reg, points);
CalcRect(reg)
END
END Invert;
PROCEDURE AddPoint* (reg: Region; x, y, dy: INTEGER);
BEGIN
IF (dy # 0) & (y >= LBound) & (y <= UBound) THEN
IF x < LBound THEN x := LBound
ELSIF x > UBound THEN x := UBound
END;
MakeData(reg);
IncludePoint(reg.llx, reg.lly, reg.urx, reg.ury, x, y);
Append(reg, x, y + (-dy) DIV 2, dy);
reg.valid := FALSE
END
END AddPoint;
BEGIN
NEW(RectRegion);
Init(RectRegion, Winding)
END GfxRegions.