--JaMConformal.mesa
--Written by J. Warnock
--Last changed by Maureen Stone October 14, 1982 10:04 am
DIRECTORY
JaMFnsDefs,
CGSpline,
CGOutlines,
ParametricMap,
TJaMGraphics USING [Painter],
RealFns,
Graphics,
GraphicsBasic USING[Vec],
CGCubic USING[Bezier];
JaMConformal: PROGRAM IMPORTS JaMFnsDefs, RealFns, CGOutlines, Graphics, ParametricMap, TJaMGraphics =
BEGIN OPEN JaMFnsDefs,ParametricMap,RealFns,GraphicsBasic,CGCubic;
--AnulusMapper takes wu,wv,r,w,alpha,beta and sets up the conformal mapping proc.
AnulusMapper:PROC=
{beta←GetReal[];
alpha←GetReal[];
w←GetReal[];
r←GetReal[];
wv←GetReal[];
wu←GetReal[];
a←w/wv;
b←r-w;
c←(beta-alpha)/wu;
SetMap[CirMapper];};
DAnulusMapper:PROC=
{beta←GetReal[];
alpha←GetReal[];
w←GetReal[];
r←GetReal[];
wv←GetReal[];
wu←GetReal[];
SetMap[DMapper];};
EQuadrantMapper:PROC=
{SetMap[EMapper]};
SetCubicScale:PROC=
{ywidth←GetReal[];
xwidth←GetReal[];
};
BezierMapper:PROC=
{bz.b3←GetPoint[];
bz.b2←GetPoint[];
bz.b1←GetPoint[];
bz.b0←GetPoint[];
SetMap[BMapper];};
CirMapper:PROC[u:Vec] RETURNS [t:Vec]=
{pr,pt:REAL;
pr←a*u.y+b;
pt←c*u.x+alpha;
t.x←pr*CosDeg[pt];
t.y←pr*SinDeg[pt];
RETURN;};
FromPolar: PROCEDURE [r: REAL, radians: REAL] RETURNS [Vec] = INLINE
{RETURN[[r*RealFns.Cos[radians], r*RealFns.Sin[radians]]]};
Exp: PROCEDURE [a: Vec] RETURNS [Vec] = INLINE
{RETURN[FromPolar[RealFns.Exp[a.x], a.y]]};
BMapper: PROC[u:Vec] RETURNS [v:Vec]=
{pos,dc:Vec;
sccs:BOOLEAN;
t:REAL;
[sccs,t]←GetTforArc[@bz,u.x*xwidth];
[pos,dc]←GetDirCos[t,@bz];
v.x←pos.x-dc.y*ywidth*u.y;
v.y←pos.y+dc.x*ywidth*u.y;
};
CMapper: PROC[u:Vec] RETURNS [v:Vec]=
{RETURN[CGOutlines.GetMappedVec[outref,Vec[u.x*xwidth,u.y*ywidth]]];
};
DMapper:PROC[u:Vec] RETURNS [t:Vec]=
{t ← Exp[[RealFns.Ln[r-w]+(u.y*(beta-alpha)/wv)*3.141593/180, (alpha+u.x*(beta-alpha)/wu)*3.141593/180]]};
EMapper: PROC[u:Vec] RETURNS [t:Vec]=
{x,y: REAL;
x←u.x/10*4-2;
y←u.y/10*4-2;
--[x,y] ← TenPoint.f[x, y];
t ← [x,y];};
path: Graphics.Path ← Graphics.NewPath[];
CMoveTo: PROC = {
t,r: Vec;
move: PROC[dc: Graphics.Context] = {r←MapMoveTo[dc, t]};
t←GetPoint[];
MyPaint[move];
Graphics.MoveTo[path,r.x,r.y,FALSE];
};
CCurveTo: PROC = {
t1,t2,t3: Vec;
Point:PROC[v:Vec]={Graphics.LineTo[path,v.x,v.y];};
t3←GetPoint[];
t2←GetPoint[];
t1←GetPoint[];
MapCurveTo[t1,t2,t3,Point];
};
CLineTo: PROC = {
t: Vec;
point:PROC[v:Vec]={Graphics.LineTo[path,v.x,v.y];};
t←GetPoint[];
MapLineTo[t,point];
};
CDrawStroke: PROC = {
width: REAL ← GetReal[];
drawstroke: PROC[dc: Graphics.Context] = {Graphics.DrawStroke[dc,path,width]};
MyPaint[drawstroke];
Graphics.FlushPath[path];
};
CDrawArea: PROC = {
drawarea: PROC[dc: Graphics.Context] = {Graphics.DrawArea[dc,path]};
MyPaint[drawarea];
Graphics.FlushPath[path];
};
CGetArc:PROC =
{PushReal[ArcLength[@bz]];};
CGetTfromArc:PROC =
{success:BOOLEAN;
t,arclength:REAL;
arclength←GetReal[];
[success,t]←GetTforArc[@bz,arclength];
PushReal[t];
PushBoolean[success];};
JGetDirCos:PROC =
{p,d:Vec;
t:REAL←GetReal[];
[p,d]←GetDirCos[t,@bz];
PushReal[p.x];
PushReal[p.y];
PushReal[d.x];
PushReal[d.y];
};
GetPoint: PROC RETURNS[p: Vec] = {
p.y ← GetReal[];
p.x ← GetReal[];
};
outref:CGOutlines.Ref;
OStartOutline:PROC=
{outref←CGOutlines.New[16];
SetMap[CMapper];
};
OMoveTo:PROC=
{p:Vec←GetPoint[];
CGOutlines.MoveTo[outref,p];};
OLineTo:PROC=
{p:Vec←GetPoint[];
CGOutlines.LineTo[outref,p];};
OCurveTo:PROC=
{v1,v2,v3:Vec;
v3←GetPoint[];
v2←GetPoint[];
v1←GetPoint[];
CGOutlines.CurveTo[outref,v1,v2,v3];};
OClose:PROC=
{CGOutlines.Close[outref];};
MyPaint:PROC[p:PROC[dc:Graphics.Context]]={TJaMGraphics.Painter[p]};
TestMap:PROC=
{p,q:Vec;
p←GetPoint[];
q←CGOutlines.GetMappedVec[outref,p];
PushReal[q.x];
PushReal[q.y];};
OutlineLength:PROC=
{PushReal[outref.sum];};
OLinkLength:PROC=
{i:NAT;
i←ABS[PopInteger[]];
PushReal[CGOutlines.GetLinkLength[outref,i]];
};
OLinkCnt:PROC=
{PushInteger[CGOutlines.GetLinkCount[outref]];
};
bz:Bezier;
wu,wv,r,w,alpha,beta,a,b,c:REAL;
xwidth:REAL←1;
ywidth:REAL←1;
Register[".cmoveto"L,CMoveTo];
Register[".clineto"L,CLineTo];
Register[".ccurveto"L,CCurveTo];
Register[".cdrawarea"L,CDrawArea];
Register[".cdrawstroke"L,CDrawStroke];
Register[".canulus"L,AnulusMapper];
Register[".danulus"L,DAnulusMapper];
Register[".equadrant"L,EQuadrantMapper];
Register[".cubicmapper"L,BezierMapper];
Register[".getdircos"L,JGetDirCos];
Register[".gettforarc"L,CGetTfromArc];
Register[".getarc"L,CGetArc];
Register[".cubicscale"L,SetCubicScale];
Register[".newoutline"L,OStartOutline];
Register[".omoveto"L,OMoveTo];
Register[".olineto"L,OLineTo];
Register[".ocurveto"L,OCurveTo];
Register[".oclose"L,OClose];
Register[".olength"L,OutlineLength];
Register[".osize"L,OLinkCnt];
Register[".olink"L,OLinkLength];
Register[".testmap"L,TestMap];
END.