<*PRAGMA LL*>

MODULE PolyRegion;

IMPORT Rect, Region, RegionRep, Point, Interval;

CONST
  Radix = 8;

REVEAL
  Private = BRANDED REF ARRAY OF RECORD
    rgn := Region.Empty;
    count := Radix;
  END;

PROCEDURE JoinRect(VAR pr: T; READONLY rect: Rect.T) =
  VAR carry: Region.T;
  BEGIN
    IF Rect.IsEmpty(rect) THEN RETURN END;
    IF pr.p = NIL THEN
      IF Rect.IsEmpty(pr.r) THEN pr.r := rect; RETURN END;
      pr.p := NEW(Private, 1);
      pr.p[0].rgn := Region.FromRect(pr.r)
    END;
    pr.r := Rect.Join(pr.r, rect);
    WITH el = pr.p[0] DO
      el.rgn := Region.JoinRect(rect, el.rgn);
      DEC(el.count);
      IF el.count # 0 THEN RETURN END;
      el.count := Radix;
      carry := el.rgn;
      el.rgn := Region.Empty
    END;
    FOR i := 1 TO LAST(pr.p^) DO
      WITH el = pr.p[i] DO
        el.rgn := Region.Join(carry, el.rgn);
        DEC(el.count);
        IF el.count # 0 THEN RETURN END;
        el.count := Radix;
        carry := el.rgn;
        el.rgn := Region.Empty
      END
    END;
    pr.p := NEW(Private, NUMBER(pr.p^) + 1);
    WITH el = pr.p[LAST(pr.p^)] DO
      el.rgn := carry;
      DEC(el.count)
    END
  END JoinRect;

PROCEDURE JoinRgn(VAR pr: T; READONLY rgn: Region.T) =
  VAR carry: Region.T;
  BEGIN
    IF Region.IsEmpty(rgn) THEN RETURN END;
    IF pr.p = NIL THEN
      IF Rect.IsEmpty(pr.r) AND Region.IsRect(rgn) THEN
        pr.r := rgn.r;
        RETURN
      END;
      pr.p := NEW(Private, 1);
      pr.p[0].rgn := Region.FromRect(pr.r)
    END;
    pr.r := Rect.Join(pr.r, rgn.r);
    carry := rgn;
    FOR i := 0 TO LAST(pr.p^) DO
      WITH el = pr.p[i] DO
        el.rgn := Region.Join(carry, el.rgn);
        DEC(el.count);
        IF el.count # 0 THEN RETURN END;
        el.count := Radix;
        carry := el.rgn;
        el.rgn := Region.Empty
      END
    END;
    pr.p := NEW(Private, NUMBER(pr.p^) + 1);
    WITH el = pr.p[LAST(pr.p^)] DO
      el.rgn := carry;
      DEC(el.count)
    END
  END JoinRgn;

PROCEDURE ToRegion(READONLY pr: T): Region.T =
  VAR res := Region.Empty;
  BEGIN
    IF pr.p = NIL THEN res.r := pr.r; RETURN res END;
    FOR i := 0 TO LAST(pr.p^) DO
      res := Region.Join(res, pr.p[i].rgn)
    END;
    RETURN res
  END ToRegion;

PROCEDURE OverlapRect(READONLY pr: T; READONLY rect: Rect.T): BOOLEAN =
  BEGIN
    IF pr.p = NIL THEN RETURN Rect.Overlap(pr.r, rect) END;
    IF NOT Rect.Overlap(pr.r, rect) THEN RETURN FALSE END;
    FOR i := 0 TO LAST(pr.p^) DO
      IF Region.OverlapRect(rect, pr.p[i].rgn) THEN RETURN TRUE END
    END;
    RETURN FALSE
  END OverlapRect;

PROCEDURE Complement(READONLY pr: T; READONLY rgn: Region.T): Region.T =
  VAR res := rgn;
  BEGIN
    IF pr.p = NIL THEN
      RETURN Region.Difference(res, Region.FromRect(pr.r))
    END;
    FOR i := 0 TO LAST(pr.p^) DO
      res := Region.Difference(res, pr.p[i].rgn)
    END;
    RETURN res
  END Complement;

PROCEDURE Meet(READONLY pr: T; READONLY rgn: Region.T): Region.T =
  VAR res := Region.Empty;
  BEGIN
    IF pr.p = NIL THEN RETURN Region.MeetRect(pr.r, rgn) END;
    FOR i := 0 TO LAST(pr.p^) DO
      res := Region.Join(res, Region.Meet(rgn, pr.p[i].rgn))
    END;
    RETURN res
  END Meet;

PROCEDURE Factor(READONLY t: Region.T; READONLY r: Rect.T;
  READONLY delta: Point.T; VAR rl: REF ARRAY OF Rect.T): CARDINAL RAISES {} =
  VAR
    res, prevrow, currow: CARDINAL := 0;
    lo, hi, i, j, k, prevedge: INTEGER;
    h: RegionRep.HList; tp: RegionRep.VList;
    rvext, rhext, vext, hext: Interval.T;
    dh := (delta.h <= 0); dv := (delta.v <= 0);
  BEGIN
    IF NOT Rect.Overlap(r, t.r) THEN RETURN 0 END;
    tp := t.p;
    IF t.p = NIL THEN
      IF (rl = NIL) OR (NUMBER(rl^) = 0) THEN
        rl := NEW(REF ARRAY OF Rect.T, 1)
      END;
      rl[0] := Rect.Meet(r, t.r);
      RETURN 1
    END;
    rvext.lo := r.north;
    rvext.hi := r.south;
    rhext.lo := r.west;
    rhext.hi := r.east;
    IF dv THEN
      lo := 0;
      hi := NUMBER(tp^);
      WHILE lo # hi DO
        i := (lo + hi) DIV 2;
        IF tp[i].v.hi > rvext.lo THEN hi := i ELSE lo := i + 1 END
      END
    ELSE
      lo := -1;
      hi := LAST(tp^);
      WHILE lo # hi DO
        i := (lo + hi + 1) DIV 2;
        IF rvext.hi > tp[i].v.lo THEN lo := i ELSE hi := i - 1 END
      END
    END;
    j := lo;
    WHILE (j >= 0) AND (j < NUMBER(tp^)) AND Overlaps(rvext, tp[j].v, dv) DO
      vext := Interval.Meet(tp[j].v, rvext);
      h := tp[j].h;
      IF dh THEN
        lo := 0;
        hi := NUMBER(h^);
        WHILE lo # hi DO
          i := (lo + hi) DIV 2;
          IF h[i].hi > rhext.lo THEN hi := i ELSE lo := i + 1 END
        END
      ELSE
        lo := -1;
        hi := LAST(h^);
        WHILE lo # hi DO
          i := (lo + hi + 1) DIV 2;
          IF rhext.hi > h[i].lo THEN lo := i ELSE hi := i - 1 END
        END
      END;
      i := lo;
      WHILE (i >= 0) AND (i < NUMBER(h^)) AND Overlaps(rhext, h[i], dh) DO
        hext := Interval.Meet(h[i], rhext);
        IF (rl = NIL) OR (res = NUMBER(rl^)) THEN Extend(rl) END;
        rl[res] := Rect.FromIntervals(hext, vext);
        INC(res);
        Advance(i, dh);
      END;
      IF (res # currow) AND (res - currow = currow - prevrow) AND
         (prevedge = TrailEdge(vext, dv)) THEN
         k := prevrow;
         i := currow;
         WHILE (k # currow) AND (rl[k].west = rl[i].west) AND
           (rl[k].east = rl[i].east) DO
           INC(i);
           INC(k)
         END;
         IF k = currow THEN
           FOR k := prevrow TO currow - 1 DO Merge(rl[k], vext, dv) END;
           res := currow;
           currow := prevrow
         END
      END;
      prevrow := currow;
      currow := res;
      prevedge := LeadEdge(vext, dv);
      Advance(j, dv)
    END;
    RETURN res
  END Factor;

PROCEDURE Extend(VAR rl: REF ARRAY OF Rect.T) =
  VAR new: REF ARRAY OF Rect.T;
  BEGIN
    IF (rl = NIL) OR (NUMBER(rl^) = 0) THEN
      rl := NEW(REF ARRAY OF Rect.T, 4)
    ELSE
      new := NEW(REF ARRAY OF Rect.T, 2*NUMBER(rl^));
      FOR i := 0 TO LAST(rl^) DO
        new[i] := rl[i]
      END;
      rl := new
    END
  END Extend;

<*INLINE*> PROCEDURE Overlaps(READONLY i, j: Interval.T; d: BOOLEAN): BOOLEAN =
  BEGIN
    IF d THEN
      RETURN i.hi > j.lo
    ELSE
      RETURN j.hi > i.lo
    END
  END Overlaps;

<*INLINE*> PROCEDURE LeadEdge(READONLY i: Interval.T; dv: BOOLEAN): INTEGER =
  BEGIN
    IF dv THEN RETURN i.hi ELSE RETURN i.lo END
  END LeadEdge;

<*INLINE*> PROCEDURE TrailEdge(READONLY i: Interval.T; dv: BOOLEAN): INTEGER =
  BEGIN
    IF dv THEN RETURN i.lo ELSE RETURN i.hi END
  END TrailEdge;

<*INLINE*> PROCEDURE Advance(VAR i: INTEGER; d: BOOLEAN) =
  BEGIN
    IF d THEN INC(i) ELSE DEC(i) END
  END Advance;

<*INLINE*> PROCEDURE Merge(VAR r: Rect.T; READONLY vext: Interval.T;
    dv: BOOLEAN) =
  BEGIN
    IF dv THEN
      r.south := vext.hi
    ELSE
      r.north := vext.lo
    END
  END Merge;

BEGIN
END PolyRegion.