
DIRECTORY Convert, Draw2d, G2dBasic, G2dContour, G2dVector, Imager, ImagerBackdoor, ImagerPath, ImagerSample, IO, Real, RealFns, Rope, RuntimeError, Vector2;

G2dContourImpl: CEDAR PROGRAM
IMPORTS Convert, Draw2d, G2dBasic, G2dVector, Imager, ImagerBackdoor, ImagerSample, IO, Real, RealFns, Rope, RuntimeError, Vector2
EXPORTS G2dContour

~ BEGIN
OPEN G2dContour;
Error:					PUBLIC SIGNAL [code: ATOM, reason: ROPE] = CODE;
TestProc:					TYPE ~ PROC [p0, p1, p2: Pair] RETURNS [BOOL];

NatList:					TYPE ~ REF NatListRep;
NatListRep:				TYPE ~ RECORD [n: NAT, next: NatList Ź NIL];
NatListSequence:			TYPE ~ REF NatListSequenceRep;
NatListSequenceRep:	TYPE ~ RECORD [element: SEQUENCE length: NAT OF NatList];
FromPairs: PUBLIC PROC [pairs: PairSequence, closed: BOOL Ź FALSE, t: REAL Ź 0.0]
RETURNS [contour: Contour]
~ {
contour Ź NEW[ContourRep Ź [t: t, closed: closed]];
contour.circle Ź FALSE;
contour.pairs Ź pairs;
};

FromIntegerPairs: PUBLIC PROC [
integerPairs: IntegerPairSequence, closed: BOOL Ź FALSE, t: REAL Ź 0.0] RETURNS [Contour]
~ {
pairs: PairSequence Ź NEW[PairSequenceRep[integerPairs.length]];
pairs.length Ź integerPairs.length;
FOR n: NAT IN [0..integerPairs.length) DO
ip: IntegerPair Ź integerPairs[n];
pairs[n] Ź [ip.x, ip.y];
ENDLOOP;
RETURN[FromPairs[pairs, closed, t]];
};
IntegerPairsFromPairs: PUBLIC PROC [pairs: PairSequence]
RETURNS [ints: IntegerPairSequence]
~ {
ints Ź NEW[G2dBasic.IntegerPairSequenceRep[pairs.length]];
ints.length Ź pairs.length;
FOR n: NAT IN [0..ints.length) DO
p: Pair Ź pairs[n];
ints[n] Ź [Real.Round[p.x], Real.Round[p.y]];
ENDLOOP;
};

PairsFromIntegerPairs: PUBLIC PROC [integerPairs: IntegerPairSequence]
RETURNS [pairs: PairSequence]
~ {
pairs Ź NEW[PairSequenceRep[integerPairs.length]];
pairs.length Ź integerPairs.length;
FOR n: NAT IN [0..pairs.length) DO
ip: IntegerPair Ź integerPairs[n];
pairs[n] Ź [ip.x, ip.y];
ENDLOOP;
};

ShiftPairs: PUBLIC PROC [pairs: PairSequence, shift: INTEGER] ~ {
leftShift: NAT Ź IF shift < 0 THEN pairs.length+shift+1 ELSE shift;
save: PairSequence Ź NEW[PairSequenceRep[leftShift]];
stop: INTEGER Ź pairs.length-leftShift;
FOR n: NAT IN [0..leftShift) DO save[n] Ź pairs[n]; ENDLOOP;
FOR n: NAT IN [0..stop) DO pairs[n] Ź pairs[n+leftShift]; ENDLOOP;
FOR n: NAT IN [0..leftShift) DO pairs[n+stop] Ź save[n]; ENDLOOP;
};

Scale: PUBLIC PROC [contour: Contour, scale: Pair] RETURNS [Contour] ~ {
IF contour # NIL AND contour.pairs # NIL THEN FOR n: NAT IN [0..contour.pairs.length) DO
contour.pairs[n] Ź Vector2.MulC[contour.pairs[n], scale];
ENDLOOP;
RETURN[contour];
};
Offset: PUBLIC PROC [contour: Contour, offset: Pair] RETURNS [Contour] ~ {
IF contour # NIL AND contour.pairs # NIL THEN FOR n: NAT IN [0..contour.pairs.length) DO
contour.pairs[n] Ź Vector2.Add[contour.pairs[n], offset];
ENDLOOP;
RETURN[contour];
};
Center: PUBLIC PROC [contour: Contour] RETURNS [Contour] ~ {
RETURN[Offset[contour, Vector2.Neg[Centroid[contour]]]];
};

Orient: PUBLIC PROC [contour: Contour] RETURNS [Contour] ~ {
IF contour # NIL AND contour.pairs # NIL THEN {
shift: NAT Ź 0;
min, max: Pair;
[min, max] Ź MinMax[contour];
DO IF contour.pairs[shift].y = min.y THEN EXIT; shift Ź shift+1; ENDLOOP;
ShiftPairs[contour.pairs, shift];
IF contour.normals # NIL THEN ShiftPairs[contour.normals, shift];
};
RETURN[contour];
};
ContourOK: PUBLIC PROC [contour: Contour] RETURNS [BOOL] ~ {
RETURN[contour # NIL AND contour.pairs # NIL AND contour.pairs.length > 0];
};

MinMax: PUBLIC PROC [contour: Contour] RETURNS [min, max: Pair] ~ {
IF contour # NIL AND contour.pairs # NIL AND contour.pairs.length > 0 THEN {
min Ź [10000.0, 10000.0];
max Ź [-10000.0, -10000.0];
FOR n: NAT IN [0..contour.pairs.length) DO
p: Pair Ź contour.pairs[n];
min Ź [MIN[min.x, p.x], MIN[min.y, p.y]];
max Ź [MAX[max.x, p.x], MAX[max.y, p.y]];
ENDLOOP;
};
};

Centroid: PUBLIC PROC [contour: Contour] RETURNS [Pair] ~ {
min, max, centroid: Pair Ź [0.0, 0.0];
IF contour # NIL AND contour.pairs # NIL AND contour.pairs.length > 0 THEN {
[min, max] Ź MinMax[contour];
centroid Ź [0.5*(min.x+max.x), 0.5*(min.y+max.y)];
};
RETURN[centroid];
};

Area: PUBLIC PROC [contour: Contour] RETURNS [REAL] ~ {
area: REAL Ź 0.0;
IF contour # NIL AND contour.pairs # NIL AND contour.closed THEN {
p0: Pair Ź contour.pairs[contour.pairs.length-1];
FOR n: NAT IN [0..contour.pairs.length) DO
p1: Pair Ź contour.pairs[n];
area Ź area+(p1.x-p0.x)*(p0.y+p1.y);
p0 Ź p1;
ENDLOOP;
};
RETURN[0.5*area];
};
SmoothPairs: PUBLIC PROC [src: PairSequence, dst: PairSequence Ź NIL]
RETURNS [PairSequence]
~ {
IF src = NIL THEN RETURN[NIL];
IF dst = NIL OR dst.maxLength < src.length THEN dst Ź NEW[PairSequenceRep[src.length]];
dst.length Ź src.length;
{
p1: Pair Ź dst[0] Ź src[0];
p2: Pair Ź src[1];
FOR n: NAT IN [2..src.length) DO
p0: Pair Ź p1;
p1 Ź p2;
p2 Ź src[n];
dst[n-1] Ź [0.25*(p0.x+p1.x+p1.x+p2.x), 0.25*(p0.y+p1.y+p1.y+p2.y)];
ENDLOOP;
};
RETURN[dst];
};

Smooth: PUBLIC PROC [contour: Contour] RETURNS [Contour] ~ {
IF contour # NIL AND contour.pairs # NIL AND contour.pairs.length > 2 THEN {
nPairs: NAT Ź contour.pairs.length;
start, stop: NAT;
p0, p1, p2: Pair;
IF contour.closed THEN {
start Ź 0;
stop Ź nPairs-1;
p1 Ź contour.pairs[stop];
}
ELSE {
start Ź 1;
stop Ź nPairs-2;
p1 Ź contour.pairs[0];
};
p2 Ź contour.pairs[start];
FOR n: NAT IN [start..stop] DO
p0 Ź p1;
p1 Ź p2;
p2 Ź contour.pairs[(n+1) MOD nPairs];
contour.pairs[n] Ź [0.25*(p0.x+p1.x+p1.x+p2.x), 0.25*(p0.y+p1.y+p1.y+p2.y)];
ENDLOOP;
};
RETURN[contour];
};

Thin: PUBLIC PROC [contour: Contour, epsilon: REAL Ź 3.0] RETURNS [Contour] ~ {
limit: REAL Ź ABS[RealFns.Cos[epsilon]];
ret: Contour Ź Reduce[contour, Thinner];
nPairs0: INTEGER Ź contour.pairs.length;
nPairs1: INTEGER Ź ret.pairs.length;
Thinner: TestProc ~ {RETURN[p0 = p1 OR Dot[p0, p1, p2] > limit]};
WHILE nPairs0 # nPairs1 DO
nPairs0 Ź nPairs1;
nPairs1 Ź (ret Ź Reduce[ret, Thinner]).pairs.length;
ENDLOOP;
RETURN[ret];
};
ResampleNats: PUBLIC PROC [src: NatPairSequence, dstnum: NAT, dst: PairSequence Ź NIL]
RETURNS [PairSequence]
~ {
totSrcLen: REAL Ź 0.;
IF dstnum = 1 THEN RETURN[NIL];
FOR j: NAT IN [1..src.length) DO
totSrcLen Ź totSrcLen+G2dVector.NatPairDistance[src[j-1], src[j]];
ENDLOOP;
{
dDstLen: REAL Ź totSrcLen/(dstnum-1);
srcLen0, dstLen: REAL Ź 0.;
j: NAT Ź 0;
IF dst = NIL OR dst.maxLength < dstnum THEN
dst Ź NEW[G2dBasic.PairSequenceRep[dstnum]];
dst.length Ź dstnum;
FOR i: NAT IN [1..src.length) DO
srcLen1: REAL Ź srcLen0+G2dVector.NatPairDistance[src[i-1], src[i]];
WHILE dstLen < srcLen1 DO
dst[j] Ź G2dVector.NatPairLerp[(dstLen-srcLen0)/(srcLen1-srcLen0), src[i-1], src[i]];
j Ź j+1;
dstLen Ź dstLen+dDstLen;
ENDLOOP;
srcLen0 Ź srcLen1;
ENDLOOP;
dst[dstnum-1] Ź [src[src.length-1].x, src[src.length-1].y];
};
RETURN[dst];
};

ResamplePairs: PUBLIC PROC [src: PairSequence, dstnum: NAT, dst: PairSequence Ź NIL]
RETURNS [PairSequence]
~ {
totSrcLen: REAL Ź 0.;
IF dstnum = 1 THEN RETURN[NIL];
FOR j: NAT IN [1..src.length) DO
totSrcLen Ź totSrcLen+G2dVector.Distance[src[j-1], src[j]];
ENDLOOP;
{
dDstLen: REAL Ź totSrcLen/(dstnum-1);
srcLen0, dstLen: REAL Ź 0.;
j: NAT Ź 0;
IF dst = NIL OR dst.maxLength < dstnum THEN
dst Ź NEW[G2dBasic.PairSequenceRep[dstnum]];
dst.length Ź dstnum;
FOR i: NAT IN [1..src.length) DO
srcLen1: REAL Ź srcLen0+G2dVector.Distance[src[i-1], src[i]];
WHILE dstLen < srcLen1 DO
dst[j] Ź G2dVector.Interp[(dstLen-srcLen0)/(srcLen1-srcLen0), src[i-1], src[i]];
j Ź j+1;
dstLen Ź dstLen+dDstLen;
ENDLOOP;
srcLen0 Ź srcLen1;
ENDLOOP;
dst[dstnum-1] Ź [src[src.length-1].x, src[src.length-1].y];
};
RETURN[dst];
};

Interpolate: PUBLIC PROC [contour0, contour1: Contour, alpha: REAL] RETURNS [Contour] ~ {
IF contour1 = NIL THEN RETURN[contour0];
IF contour0 = NIL THEN RETURN[contour1];
IF alpha = 0.0 THEN RETURN[contour0];
IF alpha = 1.0 THEN RETURN[contour1];
IF contour0.pairs.length < 3 OR contour1.pairs.length < 3
THEN  RETURN[NIL]
ELSE {
nPairs0: NAT Ź contour0.pairs.length;
nPairs1: NAT Ź contour1.pairs.length;
contour: Contour Ź NEW[ContourRep];
contour.t Ź contour0.t+alpha*(contour1.t-contour0.t);
contour.closed Ź contour0.closed AND contour1.closed;
contour.circle Ź contour0.circle AND contour1.circle;
IF contour.circle
THEN {
nPairs: INTEGER Ź Real.Round[nPairs0+alpha*(nPairs1-nPairs0)];
contour.pairs Ź contour.normals Ź CirclePairs[nPairs];
contour.pairs.length Ź contour.pairs.maxLength;
}
ELSE {
n0, n1, nPairs: NAT Ź 0;
pcs, pcs0, pcs1: RealSequence Ź NIL;
IF contour0.percents = NIL THEN contour0.percents Ź Percents[contour0];
IF contour1.percents = NIL THEN contour1.percents Ź Percents[contour1];
pcs Ź contour.percents Ź NEW[RealSequenceRep[nPairs0+nPairs1]];
pcs0 Ź contour0.percents;
pcs1 Ź contour1.percents;
DO
IF n0 = nPairs0 THEN {
FOR n: NAT IN [n1..nPairs1) DO
pcs[nPairs] Ź pcs1[n];
nPairs Ź nPairs+1;
ENDLOOP;
EXIT;
};
IF n1 = nPairs1 THEN {
FOR n: NAT IN [n0..nPairs0) DO
pcs[nPairs] Ź pcs0[n]; 
nPairs Ź nPairs+1;
ENDLOOP;
EXIT;
};
SELECT TRUE FROM
pcs0[n0] < pcs1[n1] => {pcs[nPairs] Ź pcs0[n0]; n0 Ź n0+1};
pcs0[n0] > pcs1[n1] => {pcs[nPairs] Ź pcs1[n1]; n1 Ź n1+1};
ENDCASE => {pcs[nPairs] Ź pcs0[n0]; n0 Ź n0+1; n1 Ź n1+1};
nPairs Ź nPairs+1;
ENDLOOP;
contour.pairs Ź NEW[PairSequenceRep[nPairs]];
contour.pairs.length Ź contour.percents.length Ź nPairs;
FOR n: NAT IN [0..nPairs) DO
p0: Pair Ź PercentPair[contour0, pcs[n]];
p1: Pair Ź PercentPair[contour1, pcs[n]];
contour.pairs[n] Ź [p0.x+alpha*(p1.x-p0.x), p0.y+alpha*(p1.y-p0.y)];
ENDLOOP;
[] Ź Thin[contour];
};
RETURN[contour];
};
};

Sample: PUBLIC PROC [contour: Contour, nPairs: INTEGER] RETURNS [Contour] ~ {
new: Contour Ź NEW[ContourRep Ź contour­];
IF ContourOK[contour] THEN {
IF contour.percents = NIL THEN contour.percents Ź Percents[contour];
new.pairs Ź NEW[PairSequenceRep[nPairs]];
new.pairs.length Ź nPairs;
FOR n: NAT IN [0..nPairs) DO
fraction: REAL Ź REAL[n]/REAL[nPairs];
nContour: INTEGER Ź Real.Round[fraction];
alpha: REAL Ź fraction-nContour;
percent0: REAL Ź contour.percents[nContour];
percent1: REAL Ź contour.percents[(nContour+1) MOD contour.pairs.length];
new.pairs[n] Ź PercentPair[contour, percent0+alpha*(percent1-percent0)];
ENDLOOP;
};
RETURN[new];
};

Similar: PUBLIC PROC [contour0, contour1: Contour] RETURNS [REAL] ~ {
IF NOT ContourOK[contour0] OR NOT ContourOK[contour1] THEN RETURN[1.0];
IF contour0.pairs.length > contour1.pairs.length
THEN {c: Contour Ź contour0; contour0 Ź contour1; contour1 Ź c};
IF contour0.circle AND contour1.circle
THEN RETURN[
1.0-REAL[contour1.pairs.length-contour0.pairs.length]/REAL[contour1.pairs.length]]
ELSE {
min: REAL Ź 1000.0;
IF contour0.pairs.length > contour1.pairs.length
THEN {c: Contour Ź contour0; contour0 Ź contour1; contour1 Ź c};
CheckPercentsAndNormals[contour0];
CheckPercentsAndNormals[contour1];
FOR n: NAT IN [0..contour0.pairs.length) DO
n0: Pair Ź contour0.normals[n];
n1: Pair Ź PercentNormal[contour1, contour0.percents[n] ! NullNormal => GOTO bad];
IF n0 # [0.0, 0.0] AND n1 # [0.0, 0.0] THEN min Ź MIN[min, Vector2.Dot[n0, n1]];
REPEAT
bad => NULL;
ENDLOOP;
RETURN[0.5*(min+1.0)];
};
};
InsideContour: PUBLIC PROC [p: Pair, pairs: PairSequence] RETURNS [Border] ~ {
zcross: REAL;
odd: BOOL Ź FALSE;
d2: Pair Ź [pairs[pairs.length-1].x-p.x, pairs[pairs.length-1].y-p.y];
FOR n: NAT IN [0..pairs.length) DO
d1: Pair Ź d2;
d2 Ź [pairs[n].x-p.x, pairs[n].y-p.y];
IF (d1.y > 0 AND d2.y > 0) OR (d1.y < 0 AND d2.y < 0) OR (d1.x < 0 AND d2.x < 0)
THEN LOOP;	-- no chance to cross 
IF (zcross Ź d2.y*d1.x-d1.y*d2.x) = 0.0 THEN RETURN[edge];
IF (d1.y > 0 OR d2.y > 0) AND (zcross < 0) # (d1.y-d2.y < 0) THEN odd Ź NOT odd;
ENDLOOP;
RETURN[IF odd THEN inside ELSE outside];
};

CirclePairs: PUBLIC PROC [nPairs: INTEGER] RETURNS [PairSequence] ~ {
RETURN[G2dBasic.CopyPairSequence[IF nPairs <= 0
THEN NIL
ELSE IF nPairs > nCircles
THEN NewCircle[nPairs]
ELSE IF circles[nPairs] = NIL
THEN (circles[nPairs] Ź NewCircle[nPairs])
ELSE circles[nPairs]
]];
};

Circle: PUBLIC PROC [nPairs: INTEGER] RETURNS [Contour] ~ {
IF nPairs <= 0
THEN RETURN[NIL]
ELSE {
contour: Contour Ź NEW[ContourRep];
contour.closed Ź contour.circle Ź TRUE;
contour.pairs Ź contour.normals Ź CirclePairs[nPairs];
RETURN[contour];
};
};
Normals: PUBLIC PROC [contour: Contour] RETURNS [PairSequence] ~ {
SELECT TRUE FROM
NOT ContourOK[contour] OR contour.pairs.length < 2 => RETURN[NIL];
contour.circle => RETURN[G2dBasic.CopyPairSequence[contour.pairs]];
ENDCASE => {
MakeNormal3: PROC [p0, p1, p2: Pair] RETURNS [Pair] ~ {
v: Pair Ź Vector2.Add[MakeNormal2[p0, p1], MakeNormal2[p1, p2]];
m: REAL ~ RealFns.SqRt[v.x*v.x+v.y*v.y];
RETURN[IF m # 0.0 THEN [v.x/m, v.y/m] ELSE [0.0, 0.0]];
};
MakeNormal2: PROC [p0, p1: Pair] RETURNS [Pair] ~ {
v: Pair Ź Vector2.Sub[p1, p0];
m: REAL ~ RealFns.SqRt[v.x*v.x+v.y*v.y];
RETURN[IF m # 0.0 THEN [-v.y/m, v.x/m] ELSE [0.0, 0.0]];
};
nPairs: INTEGER Ź contour.pairs.length;
normals: PairSequence Ź NEW[PairSequenceRep[nPairs]];
normals.length Ź nPairs;
FOR n: INT IN [0..nPairs) DO
p: Pair Ź contour.pairs[n];
SELECT n FROM
0 => normals[n] Ź IF contour.closed
THEN MakeNormal3[contour.pairs[nPairs-1], p, contour.pairs[n+1]]
ELSE MakeNormal2[p, contour.pairs[n+1]];
nPairs-1 => normals[n] Ź IF contour.closed
THEN MakeNormal3[contour.pairs[n-1], p, contour.pairs[0]]
ELSE MakeNormal2[contour.pairs[n-1], p];
ENDCASE => normals[n] Ź
MakeNormal3[contour.pairs[n-1], contour.pairs[n], contour.pairs[n+1]];
ENDLOOP;
RETURN[normals];
};
};
Percents: PUBLIC PROC [contour: Contour] RETURNS [RealSequence] ~ {
percents: RealSequence Ź NIL;
IF contour # NIL AND contour.pairs # NIL THEN {
pairs: PairSequence Ź contour.pairs;
percents Ź NEW[RealSequenceRep[pairs.length]];
percents.length Ź pairs.length;
percents[0] Ź 0.0;
IF contour.circle
THEN {
FOR n: NAT IN [1..pairs.length) DO
percents[n] Ź REAL[n]/REAL[pairs.length];
ENDLOOP;
}
ELSE {
total: REAL;
FOR n: NAT IN [1..pairs.length) DO
percents[n] Ź percents[n-1]+Vector2.Length[Vector2.Sub[pairs[n-1], pairs[n]]];
ENDLOOP;
total Ź percents[pairs.length-1];
IF contour.closed
THEN total Ź total+Vector2.Length[Vector2.Sub[pairs[pairs.length-1], pairs[0]]]; 
FOR n: NAT IN [1..pairs.length) DO
percents[n] Ź percents[n]/total;
ENDLOOP;
};
};
RETURN[percents];
};

AtPercent: PUBLIC PROC [contour: Contour, percent: REAL] RETURNS [RealIndex] ~ {
IF NOT ContourOK[contour]
THEN RETURN[[0, 0.0]]
ELSE {
pcs: RealSequence Ź contour.percents;
nPairs: INTEGER Ź contour.pairs.length;
IF pcs = NIL THEN pcs Ź contour.percents Ź Percents[contour];

FOR n: NAT IN [0..nPairs) DO
SELECT TRUE FROM
pcs[n] = percent => RETURN[[n, 0.0]];
pcs[n] > percent => RETURN[[n-1, (percent-pcs[n-1])/(pcs[n]-pcs[n-1])]];
ENDCASE;
ENDLOOP;
RETURN[[nPairs-1, (percent-pcs[nPairs-1])/(1.0-pcs[nPairs-1])]];
};
};

PercentPair: PUBLIC PROC [contour: Contour, percent: REAL] RETURNS [Pair] ~ {
IF NOT ContourOK[contour]
THEN RETURN[[0.0, 0.0]]
ELSE RETURN[PercentOfPairSequence[contour.pairs, AtPercent[contour, percent]]];
};

NullNormal: ERROR = CODE;

PercentNormal: PUBLIC PROC [contour: Contour, percent: REAL] RETURNS [Pair] ~ {
IF NOT ContourOK[contour]
THEN RETURN[[0.0, 0.0]]
ELSE {
n: Pair Ź PercentOfPairSequence[contour.normals, AtPercent[contour, percent]];
m: REAL ~ RealFns.SqRt[n.x*n.x+n.y*n.y];
IF m = 0.0 THEN ERROR NullNormal;
RETURN[[n.x/m, n.y/m]];
};
};
Spans: PUBLIC PROC [contour: Contour, rectangle: Rectangle] RETURNS [SpanSequence] ~ {
spans: SpanSequence Ź NIL;
IF contour # NIL AND contour.pairs # NIL AND contour.closed THEN {
MinY: PROC RETURNS [y: NAT Ź LAST[NAT]] ~ {
FOR i: NAT IN [0..nIntegerPairs) DO y Ź MIN[integerPairs[i].y, y]; ENDLOOP;
};
MaxY:PROC RETURNS [y: NAT Ź 0] ~ {
FOR i: NAT IN [0..nIntegerPairs) DO y Ź MAX[integerPairs[i].y, y]; ENDLOOP;
};
PixelProc: Draw2d.PixelProc ~ {
IF skip
THEN skip Ź FALSE
ELSE {
new: NatList Ź NEW[NatListRep Ź [n: x]];
yList: NatList Ź yLists[y-yMin];
IF yList = NIL OR yList.n > x THEN {new.next Ź yList; yLists[y-yMin] Ź new}
ELSE {
WHILE yList.next # NIL AND yList.next.n < x DO yList Ź yList.next; ENDLOOP;
new.next Ź yList.next;
yList.next Ź new;
};
count Ź count+1;
};
};
count: NAT Ź 0;
integerPairs: IntegerPairSequence Ź FitToRectangle[contour.pairs, rectangle];
nIntegerPairs: NAT Ź contour.pairs.length;
s0: IntegerPair Ź integerPairs[nIntegerPairs-1];
yMin: NAT Ź MinY[];
yListLength: NAT Ź MaxY[]-yMin+1;
yLists: NatListSequence Ź NEW[NatListSequenceRep[yListLength]];
up0: BOOL Ź s0.y < integerPairs[0].y;
skip: BOOL;
FOR n: NAT IN [0..nIntegerPairs) DO
s1: IntegerPair Ź integerPairs[n];
up1: BOOL Ź s0.y < s1.y;
skip Ź up0 = up1;
Draw2d.DoWithLine[[s0.x, s0.y], [s1.x, s1.y], PixelProc];
s0 Ź s1;
up0 Ź up1;
ENDLOOP;
FOR n: NAT IN [0..yListLength) DO
seg0a, seg0b, seg1a, seg1b: NatList;
IF (seg0a Ź yLists[n]) = NIL THEN LOOP;
IF (seg0b Ź seg0a.next) = NIL THEN LOOP;
DO
IF (seg1a Ź seg0b.next) = NIL THEN EXIT;
IF (seg1b Ź seg1a.next) = NIL THEN EXIT;
IF seg0b.n = seg1a.n
THEN seg0a.next Ź seg1b
ELSE seg0a Ź seg1a;
seg0b Ź seg1b;
ENDLOOP;
ENDLOOP;
spans Ź NEW[SpanSequenceRep[count]];
FOR n: NAT IN [0..yListLength) DO
yList: NatList Ź yLists[n];
WHILE yList # NIL AND yList.next # NIL DO
spans[spans.length].y Ź yMin+n;
spans[spans.length].x0 Ź yList.n;
yList Ź yList.next;
spans[spans.length].x1 Ź yList.n;
yList Ź yList.next;
spans.length Ź spans.length+1;
ENDLOOP;
ENDLOOP;
};
RETURN[spans];
};

PutBWLine: PROC [map: SampleMap, x0, y0, x1, y1: INTEGER, value: CARDINAL] ~ {
PerPixel: Draw2d.PixelProc~{
ImagerSample.Put[map, [y, x], value ! RuntimeError.BoundsFault => CONTINUE];
};
Draw2d.DoWithLine[[x0, y0], [x1, y1], PerPixel];
};

FillSpans: PUBLIC PROC [map: SampleMap, spans: SpanSequence, color: CARDINAL] ~ {
IF spans # NIL THEN FOR n: NAT IN [0..spans.length) DO 
span: Span Ź spans[n];
PutBWLine[map, span.x0, span.y, span.x1, span.y, color];
ENDLOOP;
};
Fill: PUBLIC PROC [context: Context, contour: Contour, color: Color Ź Imager.black] ~ {
path: Imager.PathProc ~ {Path[context, contour, moveTo, lineTo]};
Imager.SetColor[context, color];
IF ContourOK[contour] THEN Imager.MaskFill[context, path];
};

Outline: PUBLIC PROC [context: Context, contour: Contour, color: Color Ź Imager.black] ~ {
path: Imager.PathProc ~ {Path[context, contour, moveTo, lineTo]};
Imager.SetColor[context, color];
IF ContourOK[contour] THEN Imager.MaskStroke[context, path];
};

OutlineMap: PUBLIC PROC [map: SampleMap, contour: Contour, color: CARDINAL] ~ {
IF contour # NIL AND contour.pairs # NIL THEN {
integerPairs: IntegerPairSequence Ź
FitToRectangle[contour.pairs, RectangleFromSampleMap[map]];
s0, s1, start: IntegerPair Ź integerPairs[0];
FOR n: NAT IN [1..contour.pairs.length) DO 
s1 Ź integerPairs[n];
PutBWLine[map, s0.x, s0.y, s1.x, s1.y, color];
s0 Ź s1;
ENDLOOP;
IF contour.closed THEN PutBWLine[map, s0.x, s0.y, start.x, start.y, color];
};
};

FillMap: PUBLIC PROC [map: SampleMap, contour: Contour, color: CARDINAL] ~ {
FillSpans[map, Spans[contour, RectangleFromSampleMap[map]], color];
};
Copy: PUBLIC PROC [contour: Contour] RETURNS [Contour] ~ {
copy: Contour Ź NIL;
IF contour # NIL THEN {
copy Ź NEW[ContourRep Ź contour­];
copy.pairs Ź G2dBasic.CopyPairSequence[contour.pairs];
IF copy.circle THEN copy.normals Ź copy.pairs;
};
RETURN[copy];
};

CopySequence: PUBLIC PROC [contour: ContourSequence] RETURNS [ContourSequence] ~ {
copy: ContourSequence Ź NIL;
IF contour # NIL THEN {
copy Ź NEW[ContourSequenceRep[contour.length]];
copy.length Ź contour.length;
FOR n: NAT IN [0..contour.length) DO copy[n] Ź Copy[contour[n]]; ENDLOOP;
};
RETURN[copy];
};
Paint: PUBLIC PROC [contour: Contour, context: Context, paintNormals: BOOL Ź FALSE] ~ {
Action: PROC ~ {
IF ContourOK[contour] THEN {
pairs: PairSequence Ź contour.pairs;
normals: PairSequence Ź contour.normals;
p0, p1: Pair Ź --Xform[--pairs[0]--]--;
Draw2d.Clear[context];
FOR n: NAT IN [1..pairs.length) DO
p1 Ź --Xform[--pairs[n]--]--;
Draw2d.Line[context, p0, p1];
p0 Ź p1;
ENDLOOP;
IF contour.closed THEN Draw2d.Line[context, p1, --Xform[--pairs[0]--]--];
IF paintNormals AND normals # NIL THEN FOR n: NAT IN [0..pairs.length) DO
p: Pair Ź --Xform[--pairs[n]--]--;
Draw2d.Arrow[context, p, Vector2.Add[p, Vector2.Mul[normals[n], 30.0]]];
ENDLOOP;
};
};
bounds: Imager.Rectangle Ź ImagerBackdoor.GetBounds[context];
Draw2d.DoWithBuffer[context, Action, FALSE];
};
Write: PUBLIC PROC [stream: STREAM, contour: Contour] ~ {
IO.PutRope[stream, IF contour.closed THEN "closed\n" ELSE "open\n"];
IO.PutRope[stream, IF contour.circle THEN "circle\n" ELSE "notcircle\n"];
IO.PutF1[stream, "%g\n", IO.real[contour.t]];
IO.PutF1[stream, "%g\n", IO.int[contour.pairs.length]];
FOR n: NAT IN [0..contour.pairs.length) DO
IO.PutF[stream, "%g\t%g\n", IO.real[contour.pairs[n].x], IO.real[contour.pairs[n].y]];
ENDLOOP;
IO.Close[stream];
};

Read: PUBLIC PROC [stream: STREAM] RETURNS [contour: Contour] ~ {
GetFirstWord: PROC RETURNS [word: ROPE] ~ {
line: ROPE Ź IO.GetLineRope[stream];
pos0: INTEGER Ź Rope.SkipOver[line, 0, " \t"];
word Ź Rope.Substr[line, pos0, Rope.SkipTo[line, pos0, " \t"]-pos0];
};
contour: Contour Ź NIL;
IF stream # NIL THEN {
ENABLE Convert.Error => GOTO Bad;
contour Ź NEW[ContourRep];
contour.closed Ź Rope.Equal[GetFirstWord[], "closed"];
contour.circle Ź Rope.Equal[GetFirstWord[], "circle"];
contour.t Ź Convert.RealFromRope[GetFirstWord[]];
contour.pairs Ź NEW[PairSequenceRep[Convert.IntFromRope[GetFirstWord[]]]];
contour.pairs.length Ź contour.pairs.maxLength;
FOR n: NAT IN[0..contour.pairs.length) DO
line: ROPE Ź IO.GetLineRope[stream];
pos0: INTEGER Ź Rope.SkipOver[line, 0, " \t"];
pos1: INTEGER Ź Rope.SkipTo[line, pos0, " \t"];
pos2: INTEGER Ź Rope.SkipOver[line, pos1, " \t"];
pos3: INTEGER Ź Rope.SkipTo[line, pos2, " \t"];
contour.pairs[n].x Ź Convert.RealFromRope[Rope.Substr[line, pos0, pos1-pos0]];
contour.pairs[n].y Ź Convert.RealFromRope[Rope.Substr[line, pos2, pos3-pos2]];
ENDLOOP;
IO.Close[stream];
};
EXITS Bad => NULL;
};
RectangleFromSampleMap: PROC [map: SampleMap] RETURNS [Rectangle] ~ {
b: ImagerSample.Box Ź ImagerSample.GetBox[map];
RETURN[[b.min.f, b.min.s, b.max.f-b.min.f, b.max.s-b.min.s]];
};

Reduce: PROC [contour: Contour, testProc: TestProc] RETURNS [Contour] ~ {
IF NOT ContourOK[contour] OR contour.pairs.length < 3
THEN RETURN[contour]
ELSE {
n: CARDINAL Ź 0;
noMore: ERROR = CODE;
Store: PROC [p: Pair] ~ {
new.pairs[new.pairs.length] Ź p;
new.pairs.length Ź new.pairs.length+1;
};
NewPair: PROC RETURNS [Pair] ~ {
IF (n Ź n+1) > contour.pairs.length THEN ERROR noMore;
RETURN[contour.pairs[n-1]];
};
new: Contour Ź NEW[ContourRep Ź contour­];
p0: Pair Ź NewPair[];
p1: Pair Ź NewPair[];
p2: Pair Ź NewPair[];
new.pairs Ź NEW[PairSequenceRep[contour.pairs.length]];
DO
Store[p0];
IF testProc[p0, p1, p2]
THEN {	
p0 Ź p2;
p1 Ź NewPair[! noMore => {Store[p0]; EXIT}];
p2 Ź NewPair[! noMore => {Store[p0]; Store[p1]; EXIT}];
}
ELSE {
p0 Ź p1;
p1 Ź p2;
p2 Ź NewPair[! noMore => {Store[p0]; Store[p1]; EXIT}];
};
ENDLOOP;
RETURN[new];
};
};

Dot: PROC [p0, p1, p2: Pair] RETURNS [REAL] ~ {
RETURN[IF p0 = p1 OR p1 = p2
THEN 0.0
ELSE ABS[Vector2.Dot[
Vector2.Unit[Vector2.Sub[p1, p0]], Vector2.Unit[Vector2.Sub[p2, p1]]]]];
};

ConvertingValues: PROC [rectangle: Rectangle] RETURNS [scale, xOffset, yOffset: REAL] ~ {
scale Ź (MIN[rectangle.w, rectangle.h]-1)/2.0;
xOffset Ź rectangle.x+scale-1.0;
yOffset Ź rectangle.y+scale-1.0;
};

FitToRectangle: PROC [pairs: PairSequence, rectangle: Rectangle]
RETURNS [i: IntegerPairSequence]
~ {
IF pairs # NIL THEN {
scale, xOffset, yOffset: REAL;
[scale, xOffset, yOffset] Ź ConvertingValues[rectangle];
i Ź NEW[IntegerPairSequenceRep[pairs.length]];
FOR n: NAT IN [0..i.length) DO
i[n] Ź [Real.Round[xOffset+scale*pairs[n].x], Real.Round[yOffset-scale*pairs[n].y]];
ENDLOOP;
};
};

Path: PROC [
context: Context,
contour: Contour,
moveTo: ImagerPath.MoveToProc,
lineTo: ImagerPath.LineToProc]
~ {
IF contour # NIL AND contour.pairs # NIL THEN {
start: Pair;
scale, xOffset, yOffset: REAL;
[scale, xOffset, yOffset] Ź ConvertingValues[ImagerBackdoor.GetBounds[context]];
moveTo[start Ź [xOffset+scale*contour.pairs[0].x, yOffset+scale*contour.pairs[0].y]];
FOR n: NAT IN [1..contour.pairs.length) DO
lineTo[[xOffset+scale*contour.pairs[n].x, yOffset+scale*contour.pairs[n].y]];
ENDLOOP;
IF contour.closed THEN lineTo[start];
};
};

CheckPercentsAndNormals: PROC [contour: Contour] ~ {
IF NOT ContourOK[contour] THEN RETURN;
IF contour.normals = NIL THEN contour.normals Ź Normals[contour];
IF contour.percents = NIL THEN contour.percents Ź Percents[contour];
};

PercentOfPairSequence: PROC [pairs: PairSequence, index: RealIndex] RETURNS [Pair] ~ {
IF index.alpha = 0.0
THEN RETURN[pairs[index.n]]
ELSE {
p0: Pair Ź pairs[index.n];
p1: Pair Ź pairs[(index.n+1) MOD pairs.length];
RETURN[[p0.x+index.alpha*(p1.x-p0.x), p0.y+index.alpha*(p1.y-p0.y)]];
};
};

nCircles: INTEGER ~ 40;
circles: ARRAY [1..nCircles] OF PairSequence Ź ALL[NIL];

NewCircle: PROC [nPairs: INTEGER] RETURNS [PairSequence] ~ {
rad: REAL Ź 0.0;
drad: REAL Ź 2.0*3.1415926535/REAL[nPairs];
circle: PairSequence Ź NEW[PairSequenceRep[nPairs]];
circle.length Ź nPairs;
FOR i: NAT IN[0..circle.length Ź nPairs) DO
circle[i] Ź [RealFns.Cos[rad], RealFns.Sin[rad]];
rad Ź rad-drad;											-- clockwise
ENDLOOP;
RETURN[circle];
};

END.

  x  
G2dContourImpl.mesa
Copyright Ó 1985, 1988, 1992 by Xerox Corporation.  All rights reserved.
Bloomenthal, July 2, 1992 5:13 pm PDT
Errors
Types
Contour Creation
General Operations
Positive shift is to the left, negative to the right:


Attributes
Smoothing and Thinning 
Interpolation/Resampling/Comparing
Resample src curve to have dstnum (approx) equally spaced points; nats in, reals out
copy last point; sometimes roundoff will cause it to be copied above as well
Resample src curve to have dstnum (approx) equally spaced points; reals in, reals out
copy last point; sometimes roundoff will cause it to be copied above as well
Inside/Outside Test
Based on code from Pat Hanrahan:
InsideContour: PUBLIC PROC [p: Pair, pairs: PairSequence] RETURNS [Border] ~ {
Based on code from Pat Hanrahan:
odd: BOOL _ FALSE;
dx1, dy1, zcross: REAL;
dx2: REAL _ pairs[pairs.length-1].x-p.x;
dy2: REAL _ pairs[pairs.length-1].y-p.y;
FOR n: NAT IN [0..pairs.length) DO
dx1 _ dx2;
dy1 _ dy2;
dx2 _ pairs[n].x-p.x;  
dy2 _ pairs[n].y-p.y;  
IF (dy1>0 AND dy2>0) OR
(dy1<0 AND dy2<0) OR
(dx1<0 AND dx2<0) THEN LOOP;	-- no chance to cross 
zcross _ dy2*dx1-dy1*dx2;  
IF zcross = 0.0 THEN RETURN[edge];  
IF (dy1>0 OR dy2>0) AND (zcross<0) # (dy1-dy2<0) THEN odd _ NOT odd;
ENDLOOP;
RETURN[IF odd THEN inside ELSE outside];
};
Circles
Normals 
Percents 
Spans
This doesn't work now: need to cull out internal, duplicate horizontal pixels.
Filling/Outlining
Copying
Painting
Xform: PROC [p: Pair] RETURNS [Pair] ~ {RETURN[[bounds.w*p.x, bounds.h*p.y]]};
wScale: REAL _ 0.5*(bounds.w-1.0);
hScale: REAL _ 0.5*(bounds.h-1.0);
IO
Support
Assumes circular PairSequence:
 Ę!H  "cedarcode" styleNewlineDelimiter
 J
Ďe=HJ%J JĎk	e-J ĐblJM,JJ JheadĎlJĎn
; 			<J J
#J	;J1J	
M Ą	QJJJ
&3JJJJ ĄJ	+
YJJ'@J#)J"JJJ$J Ą8J#JJ0:J!JJ-JJJ Ą$FJJJ'2J#"J"JJJJ Ą
AJ5J	CJ5J'J
<J
 BJ
AJJ Ą!HXJ9JJ
JJ Ą"JXJ9JJ
JJ Ą<J28JJ Ą<
/JJJJ
 IJ!J$AJJ
J 

Ą	<J
KJJ ĄCLJJ*JJ)J)JJJJ Ą;J&LJJ2JJJJ 
Ą7JBJ1*JJ$JJJJJ Ą)EJJJ
J
WJJJ JJJJDJJJJJ Ą<LJ#JJJ
JJJJ
JJJJJJJ	%JLJJJ
JJ 
ĄOJ(J(J	(J	$JĄ	AJJ4JJJ ""Ą VJJJTJJ JBJJ	%JJ+J#,J J	7DJUJJJJJJLJ;JJJJ ĄTJJJUJJ J;JJ	%JJ+J#,J J	0=JPJJJJJJLJ;JJJJ 
Ą&YJ(J(J%J%9JJ	%J	%J#J5J!5J!5J/>J6J/JJJ $J(GJ(GJ#?JJJJJJJJJJJJJ;J;J3:JJJ-J8J)J)JDJJJJ
JJJ 
ĄMJ*J&DJ)JJ
	&J
)J J
,J
!IJHJJJJJ 
ĄEJG.0J<@&J.RJ
.0J<@J""J"+JJHRJPJJJJJ Ą NJ JJJF"JJ&

PJĎc!J&:J
 PJJ
(JJ Ą NJ JJJ(J("J
J
JJJJ˘3JJ	$J
DJJ
(J Ą
E/JJ&*JJJJ 
Ą
;JJ#J"'J6J
JJ ĄBJBJ+CĄ7J@J!(J	7JĄ3JJ!(J	8JJ'J5JJ#J<@J$(*J59J$(JFFJJ
JJ 		ĄCJ
/J$J .JJ"J)JJJ"JNJJ!JMQ"J JJJJJJ 
Ą	PJ
J%J'J,=J J%J.HJJJ:@JJJ ĄMJJDOJJ Ą
J ĄOJJNJ!(J	!JJJ Ą*VJBĄ+JKJĄ	"JKJĎb	JNJJ(J J	)KJ
KJJJJJJJJMJ*J0J
J!J"?J%J#J"JJJ9JJ
J!J$J'J(J(J(JJJJJJ$!J		)JJ!JJ!JJJJJJJJ Ą	"	NĄJA	LJJ0JJ Ą	.Q	7JJ88JJ ĄFWJAJ J :JJ ĄFZJAJ J"<JJ Ą
+O
/#J;;J-+JJ..JJJ5KJJJ Ą+LJCCJ Ą:JJ"J6J.JJJJ ĄRJJ%/JJ
IJJJ 
Ą4WĄJĄ NJ$J(J˘
˘'J"J˘
˘JJJJ˘
˘IIJ
˘
˘"JHHJJJJ=J"J"J%,J Ą
9JDJIJ-J7*JVJJJJ 
Ą
AĄ+J$J!.JDJJ
J!J
J6J6J1J7JJ/)J$J!.J"/J$1J"/JNJNJJJJJ ĄEJ/J7=JJ Ą(I5J	JJĄJ J&JĄ J"6JJJ*JJJJ(7J
JJ%,J07JJJJ07JJJJJJ Ą/	JJHHJJ ĄYJ".J J JJ Ą,@J J	JJ8J'.JTJJJJ ĐbnJJJJJ
/JJJPJU*JMMJJ%JJJ Ą4J&J$AJ&DJJ Ą)VJJJJ/J?EJJJ J
		8J ¤	
<JJ	+J4J+J1J˘&JJ	JJ JJ      bL    