DIRECTORY ColorTrixBasics, Contours, Controls, Draw2d, Imager, ImagerBackdoor, ImagerPath, IO, Real, RealFns, Rope, ThreeDIO, Vector2, Vector3d;

ContoursImpl: CEDAR PROGRAM
IMPORTS ColorTrixBasics, Controls, Draw2d, Imager, ImagerBackdoor, IO, Real, RealFns, Rope, ThreeDIO, Vector2, Vector3d
EXPORTS Contours

~ BEGIN
OPEN Contours;
TestProc:					TYPE ~ PROC [p0, p1, p2: Pair] RETURNS [BOOL];

Spot:						TYPE ~ RECORD [x, y: INTEGER];
SpotSequence:			TYPE ~ REF SpotSequenceRep;
SpotSequenceRep:		TYPE ~ RECORD [element: SEQUENCE length: NAT OF Spot];

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];
ShiftPairs: 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;
};

Reduce: PROC [contour: Contour, testProc: TestProc] RETURNS [Contour] ~ {
IF NOT ContourOK[contour] OR contour.pairs.length < 3
THEN RETURN[contour]
ELSE {
n: INT _ 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 [bounds: Rectangle] RETURNS [scale, xOffset, yOffset: REAL] ~ {
scale _ (MIN[bounds.w, bounds.h]-1)/2.0;
xOffset _ bounds.x+scale-1.0;
yOffset _ bounds.y+scale-1.0;
};

SpotsFromPairs: PROC [pairs: PairSequence, rectangle: Rectangle] RETURNS [SpotSequence] ~ {
spots: SpotSequence _ NIL;
IF pairs # NIL THEN {
scale, xOffset, yOffset: REAL;
[scale, xOffset, yOffset] _ ConvertingValues[rectangle];
spots _ NEW[SpotSequenceRep[pairs.length]];
FOR n: NAT IN [0..spots.length) DO
spots[n] _ [Real.RoundI[xOffset+scale*pairs[n].x], Real.RoundI[yOffset-scale*pairs[n].y]];
ENDLOOP;
};
RETURN[spots];
};

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];
};
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 {
minx, miny: REAL _ 10000.0;
maxx, maxy: REAL _ -10000.0;
FOR n: NAT IN [0..contour.pairs.length) DO
p: Pair _ contour.pairs[n];
IF p.x < minx THEN minx _ p.x;
IF p.x > maxx THEN maxx _ p.x;
IF p.y < miny THEN miny _ p.y;
IF p.y > maxy THEN maxy _ p.y;
ENDLOOP;
RETURN[[minx, miny], [maxx, maxy]];
}
ELSE RETURN[[0.0, 0.0], [0.0, 0.0]];
};

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];
};
Scale: PUBLIC PROC [contour: Contour, scale: REAL] RETURNS [Contour] ~ {
IF contour # NIL AND contour.pairs # NIL THEN FOR n: NAT IN [0..contour.pairs.length) DO
contour.pairs[n] _ Vector2.Mul[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];
};

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];
};
CirclePairs: PUBLIC PROC [nPairs: INTEGER] RETURNS [PairSequence] ~ {
RETURN[Vector3d.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[Vector3d.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]];
};
};
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.RoundI[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.RoundI[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)];
};
};
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]~{FOR i:NAT IN[0..nSpots)DO y_MIN[spots[i].y,y];ENDLOOP};
MaxY:PROC RETURNS[y:NAT]~{FOR i:NAT IN[0..nSpots)DO y_MAX[spots[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;
spots: SpotSequence _ SpotsFromPairs[contour.pairs, rectangle];
nSpots: NAT _ contour.pairs.length;
s0: Spot _ spots[nSpots-1];
yMin: NAT _ MinY[];
yListLength: NAT _ MaxY[]-yMin+1;
yLists: NatListSequence _ NEW[NatListSequenceRep[yListLength]];
up0: BOOL _ s0.y < spots[0].y;
skip: BOOL;

FOR n: NAT IN [0..nSpots) DO
s1: Spot _ spots[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];
};

FillSpans: PUBLIC PROC [pm: PixelMap, spans: SpanSequence, color: CARDINAL] ~ {
IF spans # NIL THEN FOR n: NAT IN [0..spans.length) DO 
span: Span _ spans[n];
ColorTrixBasics.PutLine[pm, 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];
};

OutlinePm: PUBLIC PROC [pm: PixelMap, contour: Contour, color: CARDINAL] ~ {
IF contour # NIL AND contour.pairs # NIL THEN {
spots: SpotSequence _
SpotsFromPairs[contour.pairs, [pm.fMin, pm.sMin, pm.fSize, pm.sSize]];
s0, s1, start: Spot _ spots[0];

FOR n: NAT IN [1..contour.pairs.length) DO 
s1 _ spots[n];
ColorTrixBasics.PutLine[pm, s0.x, s0.y, s1.x, s1.y, color];
s0 _ s1;
ENDLOOP;

IF contour.closed THEN ColorTrixBasics.PutLine[pm, s0.x, s0.y, start.x, start.y, color];
};
};

FillPm: PUBLIC PROC [pm: PixelMap, contour: Contour, color: CARDINAL] ~ {
FillSpans[pm, Spans[contour, [pm.fMin, pm.sMin, pm.fSize, pm.sSize]], color];
};
Copy: PUBLIC PROC [contour: Contour] RETURNS [Contour] ~ {
copy: Contour _ NIL;
IF contour # NIL THEN {
copy _ NEW[ContourRep _ contour^];
copy.pairs _ Vector3d.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 ~ {
Xform: PROC [p: Pair] RETURNS [Pair] ~ {RETURN[[wScale*(p.x+1), hScale*(p.y+1)]]};
Draw2d.Clear[context];
IF ContourOK[contour] THEN {
pairs: PairSequence _ contour.pairs;
normals: PairSequence _ contour.normals;
p0, p1: Pair _ Xform[pairs[0]];
IF NOT ContourOK[contour] THEN RETURN;
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];
wScale: REAL _ 0.5*(bounds.w-1.0);
hScale: REAL _ 0.5*(bounds.h-1.0);
Draw2d.DoWithBuffer[context, Action];
};
FromControl: PUBLIC PROC [control: Control, t: REAL _ 0.0] RETURNS [Contour] ~ {
controlPos: Controls.PosSequence;
IF control.type = contour AND (controlPos _ Controls.GetContour[control]) # NIL THEN {
wOffset: REAL _ 0.5*(control.w-1);
hOffset: REAL _ 0.5*(control.h-1);
wScale: REAL _ IF wOffset > 0 THEN 1.0/wOffset ELSE 0.0;
hScale: REAL _ IF hOffset > 0 THEN 1.0/hOffset ELSE 0.0;
contour: Contour _ NEW[ContourRep _ [t: t]];

contour.closed _ Controls.IsContourClosed[control];
contour.circle _ FALSE;
contour.pairs _ NEW[PairSequenceRep[controlPos.length]];
contour.pairs.length _ contour.pairs.maxLength;

FOR n: NAT IN [0..contour.pairs.length) DO
p: Controls.Pos _ controlPos[n];
contour.pairs[n] _ [(p.x-wOffset)*wScale, (p.y-hOffset)*hScale];
ENDLOOP;

RETURN[Thin[contour]];
}
ELSE RETURN[NIL];
};

ToControl: PUBLIC PROC [control: Control, contour: Contour, repaint: BOOL _ TRUE] ~ {
IF control.type # contour THEN RETURN;
IF contour = NIL
THEN Controls.Reset[control]
ELSE {
wScale: REAL _ 0.5*(control.w-1);
hScale: REAL _ 0.5*(control.h-1);
controlPos: Controls.PosSequence_NEW[Controls.PosSequenceRep[contour.pairs.length]];

controlPos.length _ contour.pairs.length;

FOR n: NAT IN [0..contour.pairs.length) DO
p: Pair _ contour.pairs[n];
controlPos[n] _ [Real.RoundI[p.x*wScale+wScale], Real.RoundI[p.y*hScale+hScale]];
ENDLOOP;

Controls.SetContour[control, controlPos, contour.closed, repaint];
};
};
Write: PUBLIC PROC [stream: STREAM, contour: Contour] ~ {
IO.PutF[stream, IF contour.closed THEN "closed\n" ELSE "open\n"];
IO.PutF[stream, IF contour.circle THEN "circle\n" ELSE "notcircle\n"];
IO.PutF[stream, "%g\n", IO.real[contour.t]];
IO.PutF[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: Contour _ NIL;
IF stream # NIL THEN {
contour _ NEW[ContourRep];
contour.closed _ Rope.Equal[ThreeDIO.GetWord[ThreeDIO.GetLine[stream]], "closed"];
contour.circle _ Rope.Equal[ThreeDIO.GetWord[ThreeDIO.GetLine[stream]], "circle"];
contour.t _ ThreeDIO.GetReal[ThreeDIO.GetLine[stream]];
contour.pairs _ NEW[PairSequenceRep[ThreeDIO.GetInteger[ThreeDIO.GetLine[stream]]]];
contour.pairs.length _ contour.pairs.maxLength;
FOR n: NAT IN[0..contour.pairs.length) DO
line: ThreeDIO.Line _ ThreeDIO.GetLine[stream];
contour.pairs[n].x _ ThreeDIO.GetReal[line];
contour.pairs[n].y _ ThreeDIO.GetReal[line];
ENDLOOP;
IO.Close[stream];
};
RETURN[contour];
};

END.


ήContoursImpl.mesa
Copyright c 1985 by Xerox Corporation.  All rights reserved.
Bloomenthal, February 24, 1987 6:13:15 pm PST
Additional Types
Support Procedures
Positive shift is to the left, negative to the right:
Assumes circular PairSequence:
Attributes
Operations


Circles
Normals 
Percents 
Interpolation/ReSampling/Comparing
Spans
This doesn't work now: need to cull out internal, duplicate horizontal pixels.
Filling/Outlining
Copying
Painting
To/From Controls
IO
Κψ˜š
œ™Jšœ
Οm
œ1™<J™-—J˜JšΟk	œRžœ3˜
J˜šΠblœžœ
ž˜Jšžœ<žœ2˜wJšžœ	˜—J˜šœž˜Jšžœ
˜—
headš
Οl™Jš	œ	ž	œžœžœžœ˜<J˜Jšœžœžœžœ˜)Jšœžœžœ˜+Jšœžœžœžœ	žœ
žœ˜HJ˜Jšœ
žœžœ˜#Jš	œžœžœžœžœ˜;Jšœžœžœ˜1Jšœžœžœžœ	žœ
žœ
˜M—š
 ™šΟn
œžœžœ˜:J™5Jš	œžœžœžœžœ˜CJšœžœ˜5Jšœžœ˜'Jš
žœžœ
žœžœžœ
˜<Jš
žœžœ
žœžœ žœ
˜BJš
žœžœ
žœžœžœ
˜AJš
œ˜—J˜š‘œžœ(žœ˜Išžœ
žœžœ˜5Jšžœ
žœ	˜šžœ˜Jšœžœ˜Jšœžœžœ
˜š‘œžœ˜J˜ J˜&J˜—š‘œžœ
žœ˜ Jšžœ"žœ
žœ˜6Jšžœ˜J˜—Jšœžœ˜*Jš
œ˜Jš
œ˜Jš
œ˜J˜Jšœžœ(˜7J˜š
ž˜J˜
šžœ˜šžœ˜Jš
œ˜Jšœ%žœ˜,Jšœ0žœ˜7J˜
—šžœ˜J˜J˜Jšœ0žœ˜7J˜——Jšžœ
˜—Jšžœ˜J˜——J˜J˜—š‘œžœžœžœ˜/šžœ
žœ	žœ˜Jšžœ˜šžœ
žœ
˜Jš
œH˜H——J˜J˜—š‘œžœžœžœ˜VJšœžœ˜(Jš
œ˜Jš
œ˜J˜J˜—š‘œžœ-žœ˜[Jšœžœ
˜šžœ	žœ
žœ˜Jšœžœ
˜J˜8Jšœžœ ˜+šžœžœ
žœž˜"Jš
œZ˜ZJšžœ
˜—J˜—Jšžœ˜J˜J˜—šΠbnœžœ˜Jš
œ˜Jš
œ˜Jš
œ˜Jš
œ˜Jš
œ˜š
žœžœ
žœžœ
žœ˜/Jš
œ˜Jšœžœ
˜J˜PJš
œU˜Ušžœžœ
žœž˜*Jš
œM˜MJšžœ
˜—Jšžœžœ˜%J˜—J˜J˜—š‘œžœ˜4Jšžœ
žœžœ
žœ
˜&Jšžœžœ
žœ$˜AJšžœžœ
žœ&˜DJ˜J˜—š‘œžœ)žœ˜VJ™šžœ˜Jšžœ
žœ˜šžœ˜Jš
œ˜Jšœžœ˜/Jšžœ?˜EJ˜——J˜J˜—Jšœ
žœ˜Jš	œ	žœžœžœ
žœ˜8J˜š’	œžœ
žœžœ˜<Jšœžœ˜Jšœžœžœ	˜+Jšœžœ˜4Jš
œ˜šžœžœ
žœž˜+J˜1JšœΟc˜&Jšžœ
˜—Jšžœ	˜J˜——š
 
™
š‘	œžœžœžœ˜<Jš
žœžœ
žœžœ
žœ˜KJ˜J˜—š‘œžœ
žœžœ˜Cš
žœžœ
žœžœ
žœ˜Ešžœ˜Jšœžœ˜Jšœžœ˜šžœžœ
žœž˜*J˜Jšžœžœ˜Jšžœžœ˜Jšžœžœ˜Jšžœžœ˜Jšžœ
˜—Jšžœ˜#J˜
—Jšžœ
žœ˜$—J˜J˜—š‘œžœ
žœžœ˜;J˜&šžœžœ
žœžœ
žœžœ˜LJ˜Jš
œ2˜2J˜—Jšžœ˜J˜J˜—š
‘œžœ
žœžœžœ˜7Jšœžœ˜šžœžœ
žœžœ
žœžœ˜BJ˜1šžœžœ
žœž˜*J˜J˜$J˜Jšžœ
˜—J˜—Jšžœ˜J˜——š
 
™
š
‘œžœ
žœžœžœ˜Hšžœžœ
žœžœ
žœ
žœžœ
žœž˜XJ˜8Jšžœ
˜—Jšžœ
˜J˜J™—š‘œžœ
žœ"žœ˜Jšžœžœ
žœžœ
žœ
žœžœ
žœž˜XJš
œ9˜9Jšžœ
˜—Jšžœ
˜J˜J™—š‘œžœ
žœžœ˜<Jšžœ2˜8J˜J˜—š‘œžœ
žœžœ˜<š
žœžœ
žœžœ
žœ˜/Jšœžœ˜J˜J˜Jš
žœ
žœ žœ
žœžœ
˜IJ˜!Jšžœžœ
žœ$˜AJ˜—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˜——š
 ™
codeš‘œžœ
žœžœ˜Ešžœžœ˜/Jšžœ
ž˜šžœ
žœ˜šžœ˜šžœ
žœž˜Jšžœ&˜*Jšžœ˜——J˜——L˜L˜—š
‘œžœ
žœ
žœžœ˜;šžœ˜Lšžœ
žœ
žœ
˜šžœ˜Lšœžœ
˜#Lšœ"žœ
˜'L˜6Lšžœ
˜L˜——J˜——š
 ™š‘œžœ
žœžœ˜Bšžœ
žœ
ž˜Jšžœžœžœ
žœ˜BJšœžœ+˜Cšžœ˜š‘œžœžœ˜7J˜@Lšœžœ!˜(Lšžœ
žœ	žœžœ
˜7J˜—š‘œžœžœ˜3J˜Lšœžœ!˜(Lšžœ
žœ	žœžœ
˜8J˜—Jšœžœ˜'Jšœžœ˜5J˜J˜šžœžœ
žœ
ž˜J˜šžœž˜
šœžœ˜#Jšžœ<˜@Jšžœ$˜(—šœžœ˜*Jšžœ5˜9Jšžœ$˜(—šžœ˜Jš
œF˜F——Jšžœ
˜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š‘
œžœžœ
˜J˜š‘
œžœžœ
žœ˜Ošžœ
žœ˜Jšžœ
žœ˜šžœ˜J˜NJšœžœ!˜(Jšžœ	žœ
žœ˜!Jšžœ˜J˜——J˜——š
 "™"š
‘œžœ
žœ&žœžœ˜YJšžœžœ
žœ
žœ˜(Jšžœžœ
žœ
žœ˜(Jšžœ
žœ
žœ˜%Jšžœ
žœ
žœ˜%šžœžœ˜9Jšžœžœ
žœ
˜šžœ˜Jšœ	žœ˜%Jšœ	žœ˜%Jšœžœ
˜#J˜Jš
œ5˜5Jšœ!žœ˜5Jšœ!žœ˜5J˜šžœ˜šžœ˜Jšœžœ0˜?Jš
œ6˜6J˜/J˜
—šžœ˜Jšœžœ˜Jšœ žœ
˜$J˜Jšžœžœ
žœ(˜GJšžœžœ
žœ(˜GJ˜Jšœžœ#˜?J˜J˜J˜š
ž˜šžœžœ˜šžœžœ
žœž˜Jš
œ˜Jš
œ˜Jšžœ
˜—Jšžœ
˜J˜—šžœžœ˜šžœžœ
žœž˜Jšœž
˜Jš
œ˜Jšžœ
˜—Jšžœ
˜J˜—šžœ
žœ
ž˜J˜;J˜;Jšžœ3˜:—J˜Jšžœ
˜—J˜Jšœžœ˜-J˜8J˜šžœžœ
žœž˜J˜)J˜)J˜DJšžœ
˜J˜—Jš
œ˜J˜—Jšžœ
˜—J˜——J˜J˜—š
‘œžœ
žœžœžœ˜MJšœžœ˜*šžœžœ˜Jšžœžœ
žœ&˜DJšœžœ˜)J˜šžœžœ
žœ
ž˜Jšœ
žœžœžœ	˜&Jšœ
žœ˜*Jšœžœ˜ Jšœ
žœ˜,Jšœ
žœ!žœ˜IJš
œH˜HJšžœ
˜—J˜—Jšžœ˜J˜J˜—š
‘œžœ
žœžœžœ˜EJšžœ
žœžœ
žœžœ
žœ˜Gšžœ.˜0Jšžœ<˜@—šžœžœ˜&šžœ
žœ
˜Jšœžœ.žœ˜R—šžœ˜Jšœžœ
˜šžœ.˜0Jšžœ<˜@—Jš
œ"˜"J˜"šžœžœ
žœž˜+Jš
œ˜JšœHžœ˜RJšžœžœžœžœ˜Pš
ž˜Jšœžœ
˜—Jšžœ
˜—Jšžœ˜J˜——J˜——š
 ™š‘œžœ
žœ*žœ˜VJšœžœ
˜šžœžœ
žœžœ
žœžœ˜BJš‘œ
žœ
žœžœžœžœ
žœžœžœžœ˜QJš‘œ
žœ
žœžœžœžœ
žœžœžœžœ˜QšΟb	œ˜J™Nšžœ˜Jšžœž˜šžœ˜Jšœžœ˜(J˜ Jšžœ	žœ
žœ
žœ)˜Kšžœ˜Jš
žœžœ
žœžœžœ
˜KJ˜J˜J˜—J˜J˜——J˜—J˜Jšœžœ˜J˜?Jšœžœ˜#Jš
œ˜Jšœžœ
˜Jšœ
žœ˜!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šžœ
˜—J˜—Jšžœ˜J˜J˜—š‘	œžœ
žœ,žœ˜Ošžœ	žœ
žœ
žœžœ
žœžœ
˜7J˜J˜EJšžœ
˜—J˜——š
 ™š‘œžœ
žœF˜WJ˜AJ˜ Jšžœžœ ˜:J˜J˜—š‘œžœ
žœF˜ZJ˜AJ˜ Jšžœžœ"˜<J˜—J˜š‘	œžœ
žœ)žœ˜Lš
žœžœ
žœžœ
žœ˜/˜J˜F—Jš
œ˜J˜šžœžœ
žœžœ
˜+Jš
œ˜J˜;Jš
œ˜Jšžœ
˜—J˜JšžœžœB˜XJ˜—J˜J˜—š‘œžœ
žœ)žœ˜IJ˜MJ˜——š
 ™š‘œžœ
žœžœ˜:Jšœžœ
˜šžœžœ
žœ˜Jšœžœ˜"J˜6Jšžœ
žœ˜.J˜—Jšžœ˜
Jš
œ˜J˜—š‘œžœžœ˜RLšœžœ
˜šžœžœ
žœ˜Lšœžœ%˜/Lš
œ˜Lš
žœžœ
žœžœžœ
˜IL˜—Lšžœ˜
L˜——š
 ™š
‘œžœ
žœ4žœžœ˜Wš‘œžœ˜Jš‘œžœžœžœ$˜RJ˜šžœžœ˜J˜$J˜(J˜Jšžœ
žœžœ
žœ
˜&šžœžœ
žœž˜"J˜J˜J˜Jšžœ
˜—Jšžœžœ+˜Ašžœžœžœ
žœ
žœžœ
žœž˜IJ˜Jš
œH˜HJšžœ
˜—J˜—J˜—J˜=Lšœžœ˜"Lšœžœ˜"Jš
œ%˜%Jš
œ˜——š
 ™š
‘œžœ
žœžœžœ˜PJš
œ!˜!šžœžœ/žœ
žœ˜VLšœ	žœ˜"Lšœ	žœ˜"Lš	œžœžœ
žœ
žœ˜8Lš	œžœžœ
žœ
žœ˜8Lšœžœ˜,L˜L˜3Lšœžœ
˜Lšœžœ%˜8Lš
œ/˜/L˜šžœžœ
žœž˜*Lš
œ ˜ L˜@Lšžœ
˜L˜—Lšžœ˜L˜
—Lšžœ
žœ
žœ˜J˜J˜—š
‘	œžœ
žœ/žœžœ˜UJšžœžœ
žœ
˜&šžœž˜Jšžœ˜šžœ˜Lšœžœ˜!Lšœžœ˜!Lšœ!žœ0˜TL˜Lš
œ)˜)L˜šžœžœ
žœž˜*Lš
œ˜Lš
œQ˜QLšžœ
˜L˜—Lš
œB˜BL˜——J˜——š
 ™š‘œžœ
žœ
žœ˜9Jšžœžœžœžœ˜AJšžœžœžœžœ˜FJšžœžœ˜,Jšžœžœ˜6šžœžœ
žœž˜*Jšžœžœžœ˜VJšžœ
˜—Jšžœ˜J˜J˜—š
‘œžœ
žœ
žœžœ
˜8Lšœžœ
˜šžœ
žœ
žœ˜Lšœ
žœ
˜Lš
œR˜RLš
œR˜RLš
œ7˜7LšœžœA˜TL˜/šžœžœ
žœž˜)L˜/L˜,L˜,Lšžœ
˜—Jšžœ˜J˜—Jšžœ
˜Jš
œ˜J˜——Jšžœ
˜J˜—…—VZu0