
DIRECTORY G2dBasic, G2dVector, Real, RealFns;

G2dVectorImpl: CEDAR PROGRAM
IMPORTS G2dBasic, Real, RealFns
EXPORTS G2dVector

~ BEGIN
Box:					TYPE ~ G2dBasic.Box;
NatPair:				TYPE ~ G2dBasic.NatPair;
NearSegment:		TYPE ~ G2dBasic.NearSegment;
Pair:					TYPE ~ G2dBasic.Pair;
PairSequence:		TYPE ~ G2dBasic.PairSequence;
PairSequenceRep:	TYPE ~ G2dBasic.PairSequenceRep;
Triple:				TYPE ~ G2dBasic.Triple;

PI:						REAL ~ G2dBasic.PI;
Negate: PUBLIC PROC [p: Pair] RETURNS [Pair] ~ {
RETURN[[-p.x, -p.y]];
};

Unit:	PUBLIC PROC [p: Pair] RETURNS [Pair] ~ {
m: REAL ~ RealFns.SqRt[p.x*p.x+p.y*p.y];
RETURN[[p.x/m, p.y/m]]
};
Null: PUBLIC PROC [v: Pair] RETURNS [BOOL] ~ {
RETURN[v.x = 0.0 AND v.y = 0.0];
};
Add: PUBLIC PROC [p1, p2: Pair] RETURNS [Pair] ~ {RETURN[[p1.x+p2.x, p1.y+p2.y]]};
Sub: PUBLIC PROC [p1, p2: Pair] RETURNS [Pair] ~ {RETURN[[p1.x-p2.x, p1.y-p2.y]]};
Mul: PUBLIC PROC [p: Pair, s: REAL] RETURNS [Pair] ~ {RETURN[[s*p.x, s*p.y]]};
Div: PUBLIC PROC [p: Pair, s: REAL] RETURNS [Pair] ~ {RETURN[[p.x/s, p.y/s]]};
Dot: PUBLIC PROC [p1, p2: Pair] RETURNS [REAL] ~ {RETURN[p1.x*p2.x+p1.y*p2.y]};
Cross: PUBLIC PROC [p1, p2: Pair] RETURNS [REAL] ~ {RETURN[p1.x*p2.y-p1.y*p2.x]};

Equal: PUBLIC PROC [v1, v2: Pair, epsilon: REAL м 0.001] RETURNS [BOOL] ~ {
RETURN[ABS[v1.x-v2.x] < epsilon AND ABS[v1.y-v2.y] < epsilon];
};

Midpoint: PUBLIC PROC [v1, v2: Pair] RETURNS [Pair] ~ {
RETURN[[0.5*(v1.x+v2.x), 0.5*(v1.y+v2.y)]];
};
Interp: PUBLIC PROC [t: REAL, v1, v2: Pair] RETURNS [Pair] ~ {
RETURN [[v1.x+t*(v2.x-v1.x), v1.y+t*(v2.y-v1.y)]];
};

Combine: PUBLIC PROC [v1: Pair, s1: REAL, v2: Pair, s2: REAL] RETURNS [Pair] ~ {
RETURN[[s1*v1.x+s2*v2.x, s1*v1.y+s2*v2.y]];
};

MulVectors: PUBLIC PROC [v1, v2: Pair] RETURNS [Pair] ~ {
RETURN[[v1.x*v2.x, v1.y*v2.y]];
};

DivVectors: PUBLIC PROC [v1, v2: Pair] RETURNS [Pair] ~ {
ret: Pair м v1;
IF v2.x # 0.0 THEN ret.x м ret.x/v2.x;
IF v2.y # 0.0 THEN ret.y м ret.x/v2.y;
RETURN[ret];
};
UnitizeSequence: PUBLIC PROC [pairs: PairSequence] ~ {
IF pairs # NIL THEN FOR n: NAT IN [0..pairs.length) DO pairs[n] м Unit[pairs[n]]; ENDLOOP;
};

AverageSequence: PUBLIC PROC [pairs: PairSequence] RETURNS [average: Pair] ~ {
average м [0.0, 0.0];
FOR n: NAT IN [0..pairs.length) DO
average м Add[average, pairs[n]];
ENDLOOP;
IF pairs.length # 0 THEN average м Div[average, pairs.length];
};

MinMaxSequence: PUBLIC PROC [pairs: PairSequence] RETURNS [mm: Box] ~ {
mm.min м [Real.LargestNumber, Real.LargestNumber];
mm.max м [-Real.LargestNumber, -Real.LargestNumber];
FOR n: NAT IN [0..pairs.length) DO
t: Pair ~ pairs[n];
IF t.x < mm.min.x THEN mm.min.x м t.x;
IF t.x > mm.max.x THEN mm.max.x м t.x;
IF t.y < mm.min.y THEN mm.min.y м t.y;
IF t.y > mm.max.y THEN mm.max.y м t.y;
ENDLOOP;
};

NegateSequence: PUBLIC PROC [pairs: PairSequence] ~ {
IF pairs # NIL THEN FOR n: NAT IN [0..pairs.length) DO
pairs[n] м Negate[pairs[n]];
ENDLOOP;
};

ReverseSequence: 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;
IF dst = src
THEN FOR n: NAT IN [0..src.length/2) DO		-- in place
nn: NAT м src.length-n-1;
t: Pair м src[n];
src[n] м src[nn];
src[nn] м t;
ENDLOOP
ELSE FOR n: NAT IN [0..src.length) DO			-- not in place
dst[n] м src[src.length-n-1];
ENDLOOP;
RETURN[dst];
};
Length: PUBLIC PROC [p: Pair] RETURNS [REAL] ~ {
RETURN[RealFns.SqRt[p.x*p.x+p.y*p.y]];
};

Square: PUBLIC PROC [p: Pair] RETURNS [REAL] ~ {RETURN[p.x*p.x+p.y*p.y]};
Distance: PUBLIC PROC [p1, p2: Pair] RETURNS [REAL] ~ {
a: REAL м p2.x-p1.x;
b: REAL м p2.y-p1.y;
RETURN[RealFns.SqRt[a*a+b*b]];
};

SquareDistance: PUBLIC PROC [p1, p2: Pair] RETURNS [REAL] ~ {
RETURN[Square[Sub[p1, p2]]];
};

SameLength: PUBLIC PROC [v1, v2: Pair] RETURNS [Pair] ~ {
lengthV2: REAL м Length[v2];
RETURN[IF lengthV2 # 0.0 THEN Mul[v2, Length[v1]/lengthV2] ELSE v2];
};

SetVectorLength: PUBLIC PROC [v: Pair, length: REAL] RETURNS [Pair] ~ {
sqLength: REAL м v.x*v.x+v.y*v.y;
IF sqLength = 0.0 THEN RETURN[v];
IF sqLength # 1.0 THEN length м length/RealFns.SqRt[sqLength];
RETURN[[v.x*length, v.y*length]];
};
GetNear2dAccelerator: PUBLIC PROC [p0, p1: Pair] RETURNS [n: Triple] ~ {
n.x м p1.x-p0.x;
n.y м p1.y-p0.y;
n.z м n.x*n.x+n.y*n.y;
IF n.z = 0.0 THEN RETURN;
n.x м n.x/n.z;
n.y м n.y/n.z;
};

NearestToSegment: PUBLIC PROC [p0, p1, q: Pair, acc: Triple м [0, 0, 0]]
RETURNS [nearest: NearSegment]
~ {
IF acc # [0.0, 0.0, 0.0]
THEN {
alpha: REAL м (q.x-p0.x)*acc.x+(q.y-p0.y)*acc.y;
SELECT alpha FROM
<= 0.0 => {
nearest.inside м FALSE;
nearest.point м p0;
nearest.w0 м 1.0;
nearest.w1 м 0.0;
};
>= 1.0 => {
nearest.inside м FALSE;
nearest.point м p1;
nearest.w0 м 0.0;
nearest.w1 м 1.0;
};
ENDCASE => {
nearest.inside м TRUE;
nearest.w1 м alpha;
nearest.w0 м 1.0-alpha;
alpha м alpha*acc.z;
nearest.point м [p0.x+alpha*acc.x, p0.y+alpha*acc.y];
};
}
ELSE {
delta: Pair м [p1.x-p0.x, p1.y-p0.y];
nearest.point м p0;
IF delta = [0.0, 0.0]
THEN RETURN
ELSE {
ua: Pair ~ [q.x-p0.x, q.y-p0.y];
deltaSq: REAL ~ delta.x*delta.x+delta.y*delta.y;
alpha: REAL м (ua.x*delta.x+ua.y*delta.y)/deltaSq;
nearest.w1 м alpha;
nearest.w0 м 1.0-alpha;
nearest.point м [p0.x+alpha*delta.x, p0.y+alpha*delta.y];
};
};
};

NearestToSequence: PUBLIC PROC [p: Pair, points: PairSequence] RETURNS [index: NAT м 0] ~ {
minSqDist: REAL м Real.LargestNumber;
IF points # NIL THEN FOR n: NAT IN [0..points.length) DO
sqDist: REAL м SquareDistance[p, points[n]];
IF sqDist < minSqDist THEN {index м n; minSqDist м sqDist};
ENDLOOP;
};
Line: PUBLIC PROC [p0, p1: Pair] RETURNS [line: Triple] ~ {
line.x м p0.y-p1.y;
line.y м p1.x-p0.x;
line.z м p0.x*p1.y-p1.x*p0.y;
};

DistanceToLine: PUBLIC PROC [p: Pair, line2d: Triple] RETURNS [REAL] ~ {
RETURN[p.x*line2d.x+p.y*line2d.y+line2d.z];
};

IntersectTwoLines: PUBLIC PROC [line0, line1: Triple] RETURNS [Pair] ~ {
cross: Triple м [line0.y*line1.z-line0.z*line1.y,line0.z*line1.x-line0.x*line1.z,line0.x*line1.y-line0.y*line1.x];
IF cross.z = 0.0 THEN ERROR;
RETURN[[cross.x/cross.z, cross.y/cross.z]];
};

TriangleArea: PUBLIC PROC [p0, p1, p2: Pair] RETURNS [a: REAL] ~ {
a м ABS[(p1.x-p0.x)*(p2.y-p1.y)-(p1.y-p0.y)*(p2.x-p1.x)];
};
NatPairLerp: PUBLIC PROC [t: REAL, a, b: NatPair] RETURNS [Pair] ~ {
RETURN [[a.x+t*(b.x-a.x), a.y+t*(b.y-a.y)]];
};

NatPairDistance: PUBLIC PROC [a, b: NatPair] RETURNS [REAL] ~ {
dx: INT16 м a.x-b.x;
dy: INT16 м a.y-b.y;
RETURN[RealFns.SqRt[dx*dx+dy*dy]];
};
AnglesAgree: PUBLIC PROC [a0, a1: REAL] RETURNS [REAL] ~ {
aa0: REAL м G2dBasic.RealMod[a0, 2.0*PI];
aa1: REAL м G2dBasic.RealMod[a1, 2.0*PI];
dAngle: REAL м ABS[aa1-aa0];
IF dAngle > PI THEN {
IF aa0 > PI THEN aa0 м aa0-2.0*PI;
IF aa1 > PI THEN aa1 м aa1-2.0*PI;
dAngle м ABS[aa1-aa0];
};
RETURN[1.0-(1.0/PI)*dAngle];
};

AngleFromVector: PUBLIC PROC [v: Pair, degrees: BOOL м FALSE] RETURNS [a: REAL] ~ {
sd: REAL м v.x*v.x+v.y*v.y;
IF sd # 1.0 THEN v.x м v.x/RealFns.SqRt[sd];	-- let it die if v = [0, 0]
a м G2dBasic.ArcCos[v.x];
IF v.y < 0.0 THEN a м 2.0*PI-a;
IF degrees THEN a м a*(180.0/PI);
};

END.


   м  
G2dVectorImpl.mesa
Copyright ╙ 1988, 1992 by Xerox Corporation.  All rights reserved.
Bloomenthal, July 1, 1992 7:03 pm PDT
Type Declarations
Basic Operations on a Single Pairtor

Basic Operations on Two Vectors


Basic Operations on Sequence of Vectors
Length and Distance Operations

Nearness Operations
NOTE: If delta is specified as a unit length pairtor, then nearest.point is clipped to within the p0p1 segment and nearest.w0 and nearest.w1 are clipped to [0..1]; nearest.inside is set.  If delta is not specified, then nearest.point is not clipped; it will lie on the line through p0 and p1, but not necessarily within the segment; also, nearest.w0, nearest.w1, and nearest.inside will not be set.
Line and Triangle Operations
If cross.z = 0, then the lines meet at infinity in the (cross.x, cross.y) direction;
otherwise, the lines meet at (cross.x/cross.z, cross.y/cross.z);
NatPair Operations
Miscellaneous Operations
 Э╩
°  ХNewlineDelimiter
Ц"cedarcode" styleЩ ЪЬЩJЪЬ	╧eЬ6ЩBJЩ%JШ JЪ╧k	Ь$Ш-JШ ЧЪ╤blnЬЮЬЮШJЪЮЬШJЪЮЬ
ШJШ ЧJЪЬЮШheadЪ╧lЩJЪЬ	ЮЬШJЪЬЮЬШ$JЪЬЮЬШ*JЪЬ
ЮЬШJЪЬЮЬШ,JЪЬЮЬШ1ЪЬЮЬШ"JШ ЧJЪЮЬЮЬЮЬШЧЪа$Щ$Ъ╧nЬЮЬЮЬЮЬШ0JЪЮЬШJШJШ ЧЪбЬЮЬЮЬЮЬШ.JЪЬЮЬ!Ш(JЪЮЬШJШJЩ ЧЪ
бЬЮЬЮЬЮЬЮЬШ.JЪЮЬЮЬШ JШЧЧЪаЩЪ
бЬЮЬЮЬЮЬЮЬШRJЩ ЧЪ
бЬЮЬЮЬЮЬЮЬШRJЩ ЧЪбЬЮЬЮЬЮЬЮЬЮЬШNJЩ ЧЪбЬЮЬЮЬЮЬЮЬЮЬШNJЩ ЧЪбЬЮЬЮЬЮЬЮЬЮЬШOJЩ ЧЪбЬЮЬЮЬЮЬЮЬЮЬШQJШ ЧЪбЬЮЬЮЬЮЬ
ЮЬЮЬШKJЪЮЬЮЬЮЬЮЬШ>JШJШ ЧЪ╨bnЬЮЬЮЬЮЬШ7JЪЮЬ%Ш+JШJЩ ЧЪ
бЬЮЬЮЬЮЬЮЬШ>JЪЮЬ,Ш2JШJШ ЧЪвЬЮЬЮЬЮЬЮЬЮЬШPJЪЮЬ%Ш+JШJШ ЧЪб
ЬЮЬЮЬЮЬШ9JЪЮЬШJШJШ ЧЪб
ЬЮЬЮЬЮЬШ9JШJЪЮЬЮЬШ&JЪЮЬЮЬШ&JЪЮЬШJШЧЧЪа'Щ'ЪбЬЮЬЮЬШ6JЪЮЬ	ЮЬЮЬЮЬЮЬЮЬЮЬЮЬШZJШJШ ЧЪбЬЮЬЮЬЮЬШNJШЪЮЬЮЬЮЬЮШ"JШ!JЪЮЬШЧJЪЮЬЮЬ&Ш>JШJШ ЧЪбЬЮЬЮЬЮЬШGJШ2JШ4ЪЮЬЮЬЮЬЮШ"JШJЪЮЬЮЬШ&JЪЮЬЮЬШ&JЪЮЬЮЬШ&JЪЮЬЮЬШ&JЪЮЬШЧJШJШ ЧЪбЬЮЬЮЬШ5ЪЮЬ	ЮЬЮЬЮЬЮЬЮЬЮШ6JШJЪЮЬШЧJШJШ ЧЪбЬЮЬЮЬ)ЮЬШIJЪЮЬ╧sЬШJЪ
ЮЬЮЬЮЬЮЬЮЬШJЪ
ЮЬЮЬЮЬЮЬЮЬШWJШЪЮЬ
ШЪЮЬЮЬЮЬЮЬЮЬ╧cШ4JЪЬЮЬШJШJШJШJЪЮШЧЪЮЬЮЬЮЬЮЬЮЬдШ7JШJЪЮЬШЧЧJЪЮЬШJШЧЧЪаЩЪ
бЬЮЬЮЬЮЬЮЬШ0JЪЮЬ Ш&JШJШ ЧЪ
бЬЮЬЮЬЮЬЮЬШIJЩ ЧЪ
бЬЮЬЮЬЮЬЮЬШ7JЪЬЮЬШJЪЬЮЬШJЪЮЬШJШJШ ЧЪ
бЬЮЬЮЬЮЬЮЬШ=JЪЮЬШJШJШ ЧЪб
ЬЮЬЮЬЮЬШ9JЪЬ
ЮЬШJЪЮЬЮЬЮЬЮЬШDJШJШ ЧЪ
бЬЮЬЮЬЮЬЮЬШGJЪЬ
ЮЬШ!JЪЮЬЮЬЮЬШ!JЪЮЬЮЬ(Ш>JЪЮЬШ!JШЧЧЪаЩЪбЬЮЬЮЬЮЬШHJШJШJШJЪЮЬЮЬЮЬШJШJШJШJШ ЧЪбЬЮЬЮЬ+ШHJЪЮЬШJШJЪ╨bk╧bЬИЩОЪЮЬШЪЮЬШJЪЬЮЬ%Ш0ЪЮЬЮШШJЪЬЮЬШJШJШJШJШЧШJЪЬЮЬШJШJШJШJШЧЪЮЬШJЪЬЮЬШJШJШJШJШ5JШЧЧJШЧЪЮЬШJШ%JШЪЮЬШJЪЮЬЮШЪЮЬШJШ JЪЬ	ЮЬ#Ш0JЪЬЮЬ'Ш2JШJШJШ9JШЧЧJШЧЧJШJШ ЧЪбЬгЮгЮгЬгЬгЬгЬгЮгЬгЮЬгЬШ[JЪЬЮЬШ%ЪЮЬ
ЮЬЮЬЮЬЮЬЮЬЮШ8JЪЬЮЬ Ш,JЪЮЬЮЬ!Ш;JЪЮЬШЧJШЧЧЪаЩЪбЬЮЬЮЬЮЬШ;JШJШJШJШJШ ЧЪ
бЬЮЬЮЬЮЬЮЬШHJЪЮЬ%Ш+JШJШ ЧЪбЬЮЬЮЬЮЬШHJЩTJЩ@JЪЬгbШrJЪЮЬЮЬЮЬШJЪЮЬ%Ш+JШJШ ЧЪ
бЬЮЬЮЬЮЬЮЬШBJЪЬЮЬ2Ш9JШЧЧЪаЩЪ
бЬЮЬЮЬЮЬЮЬШDJЪЮЬ&Ш,JШJШ ЧЪ
бЬЮЬЮЬЮЬЮЬШ?JЪЬЮЬШJЪЬЮЬШJЪЮЬШ"JШЧЧЪаЩЪ
бЬЮЬ
ЮЬЮЬЮЬШ:JЪЬЮЬЮЬШ)JЪЬЮЬЮЬШ)JЪЬЮЬЮЬ
ШЪЮЬ
ЮЬЮЬШJЪЮЬЮЬЮЬЮЬШ"JЪЮЬЮЬЮЬЮЬШ"JЪЬ	ЮЬ
ШJШЧJЪЮЬ
ЮЬ
ШJШJШ ЧЪбЬЮЬЮЬЮЬЮЬЮЬЮЬШSJЪЬЮЬШJЪЮЬ
ЮЬдШHJШJЪЮЬЮЬ	ЮЬШJЪЮЬ	ЮЬЮЬШ!JШЧЧJШ JЪЮЬШJШ JШ Ч ЕЧ    ╥  *v  