--January 19, 1984 1:52 pm
-- JunoStorageImpl.mesa, coded June 81 by Greg Nelson.
-- Defines record types, allocation and deallocation functions.
DIRECTORY JunoStorage, RealFns, Rope, Graphics, List;
JunoStorageImpl: PROGRAM
IMPORTS RealFns, List
EXPORTS JunoStorage =
BEGIN OPEN JunoStorage, List;
GetBody: PUBLIC PROC [name: REF ANY] RETURNS [REF ANY] =
{deflist : LIST OF REF ANY ← lambdaAlist;
WHILE deflist # NIL AND deflist.first # name DO deflist ← deflist.rest.rest.rest ENDLOOP;
IF deflist # NIL THEN RETURN [Car[Cddr[deflist]]] ELSE RETURN [NIL]};
GetLocals: PUBLIC PROC [name: REF ANY] RETURNS [REF ANY] =
{deflist : LIST OF REF ANY ← lambdaAlist;
WHILE deflist # NIL AND deflist.first # name DO deflist ← deflist.rest.rest.rest ENDLOOP;
IF deflist = NIL THEN RETURN [NIL] ELSE RETURN [Cadr[deflist]] };
AddDef: PUBLIC PROC [name, locals, body: REF ANY] =
{lambdaAlist ← CONS[name, CONS[locals, CONS[body, lambdaAlist]]]};
lambdaAlist: PUBLIC LIST OF REF ANY;
constructionList: PUBLIC LIST OF ApplyRecord;
AddX: PUBLIC PROC [f: REF ANY, args:LIST OF PointPtr] =
{constructionList ← CONS[[f, args], constructionList]};
pointAvail: PointPtr ← NIL;
edgeAvail: EdgePtr ← NIL;
arcAvail: ArcPtr ← NIL;
lineAvail: LinPtr ← NIL;
congAvail: CongPtr ← NIL;
horAvail: HorPtr ← NIL;
verAvail: VerPtr ← NIL;
ccAvail: CCPtr ← NIL;
tvAvail: TangentVector ← NIL;
basisAvail: Basis ← NIL;
stringAvail: StringPtr ← NIL;
saveStateList: LIST OF SaveStateRec ← NIL;
-- saveStateList: LIST OF REF ANY ← NIL;
npoint, nedge, narc, nline, nstring: PUBLIC INTEGER ← 0;
ncong, nhor, nver, ntv, nbasis, ncc: PUBLIC INTEGER ← 0;
PushState: PUBLIC PROCEDURE =
BEGIN
saveStateList ←
CONS[ [savePointLpad: pointLpad.link,
saveEdgeLpad: edgeLpad.link,
saveArcLpad: arcLpad.link,
saveLineLpad: lineLpad.link,
saveCongLpad: congLpad.link,
saveHorLpad: horLpad.link,
saveVerLpad: verLpad.link,
saveStringLpad: stringLpad.link,
saveCCLpad: ccLpad.link ],
saveStateList] ;
ResetJunoStorage[];
END;
PopState: PUBLIC PROCEDURE =
BEGIN
ResetJunoStorage[];
pointLpad.link ← saveStateList.first.savePointLpad;
edgeLpad.link ← saveStateList.first.saveEdgeLpad;
arcLpad.link ← saveStateList.first.saveArcLpad;
lineLpad.link ← saveStateList.first.saveLineLpad;
congLpad.link ← saveStateList.first.saveCongLpad;
horLpad.link ← saveStateList.first.saveHorLpad;
verLpad.link ← saveStateList.first.saveVerLpad;
stringLpad.link ← saveStateList.first.saveStringLpad;
ccLpad.link ← saveStateList.first.saveCCLpad;
saveStateList ← saveStateList.rest;
END;
NewPoint: PUBLIC PROCEDURE RETURNS [r: PointPtr] =
BEGIN
npoint ← npoint + 1;
IF pointAvail = NIL THEN XPoint[];
r ← pointAvail;
pointAvail ← pointAvail.link;
r.fixed ← FALSE;
r.visible ← TRUE;
r.wn ← 0;
r.copy ← NIL;
END;
NewEdge: PUBLIC PROCEDURE RETURNS [r: EdgePtr] =
BEGIN nedge ← nedge + 1;
IF edgeAvail = NIL THEN XEdge[]; r ← edgeAvail; edgeAvail ← edgeAvail.link END;
NewArc: PUBLIC PROCEDURE RETURNS [r: ArcPtr] =
BEGIN narc ← narc + 1;
IF arcAvail = NIL THEN XArc[]; r ← arcAvail; arcAvail ← arcAvail.link END;
NewLine: PUBLIC PROCEDURE RETURNS [r: LinPtr] =
BEGIN nline ← nline + 1;
IF lineAvail = NIL THEN XLine[]; r ← lineAvail; lineAvail ← lineAvail.link END;
NewCong: PUBLIC PROCEDURE RETURNS [r: CongPtr] =
BEGIN ncong ← ncong + 1;
IF congAvail = NIL THEN XCong[]; r ← congAvail; congAvail ← congAvail.link END;
NewHor: PUBLIC PROCEDURE RETURNS [r: HorPtr] =
BEGIN nhor ← nhor + 1;
IF horAvail = NIL THEN XHor[]; r ← horAvail; horAvail ← horAvail.link END;
NewVer: PUBLIC PROCEDURE RETURNS [r: VerPtr] =
BEGIN nver ← nver + 1;
IF verAvail = NIL THEN XVer[]; r ← verAvail; verAvail ← verAvail.link END;
NewCC: PUBLIC PROCEDURE RETURNS [r: CCPtr] =
{ncc ← ncc + 1; IF ccAvail = NIL THEN XCC[]; r ← ccAvail; ccAvail ← ccAvail.link};
NewTv: PUBLIC PROCEDURE RETURNS[r:TangentVector] =
{ntv ← ntv + 1; IF tvAvail = NIL THEN XTv[]; r ← tvAvail; tvAvail ← tvAvail.tail};
NewBasis: PUBLIC PROCEDURE RETURNS[r:Basis] =
{nbasis ← nbasis + 1;
IF basisAvail = NIL THEN XBasis[]; r ← basisAvail; basisAvail ← basisAvail.tail};
NewString : PUBLIC PROCEDURE RETURNS [r: StringPtr] =
BEGIN nstring ← nstring + 1;
IF stringAvail = NIL THEN XString[];
r ← stringAvail;
stringAvail ← stringAvail.link END;
GcPoint: PUBLIC PROCEDURE[p:PointPtr] =
BEGIN npoint ← npoint - 1; p.link ← pointAvail; pointAvail ← p END;
GcEdge: PUBLIC PROCEDURE[p:EdgePtr] =
BEGIN nedge ← nedge - 1; p.link ← edgeAvail; edgeAvail ← p END;
GcArc: PUBLIC PROCEDURE[p:ArcPtr] =
BEGIN narc ← narc - 1; p.link ← arcAvail; arcAvail ← p END;
GcLine: PUBLIC PROCEDURE[p:LinPtr] =
BEGIN nline ← nline + 1; p.link ← lineAvail; lineAvail ← p END;
GcString: PUBLIC PROCEDURE [p: StringPtr] =
BEGIN nstring ← nstring + 1; p.link ← stringAvail; stringAvail ← p END;
GcCong: PUBLIC PROCEDURE[p:CongPtr] =
BEGIN ncong ← ncong - 1; p.link ← congAvail; congAvail ← p END;
GcHor: PUBLIC PROCEDURE[p:HorPtr] =
BEGIN nhor ← nhor - 1; p.link ← horAvail; horAvail ← p END;
GcVer: PUBLIC PROCEDURE[p:VerPtr] =
BEGIN nver ← nver - 1; p.link ← verAvail; verAvail ← p END;
GcCC: PUBLIC PROC[p: CCPtr] = {ncc ← ncc - 1; p.link ← ccAvail; ccAvail ← p};
GcTv: PUBLIC PROC[t:TangentVector] = {ntv ← ntv - 1; t.tail ← tvAvail; tvAvail ← t};
GcBasis: PUBLIC PROC[b:Basis] = {nbasis ← nbasis - 1; b.tail ← basisAvail; basisAvail ← b};
XPoint: PROC =
{THROUGH [1..50] DO pointAvail ← NEW[Point ← [link: pointAvail]] ENDLOOP};
XEdge: PROC =
{THROUGH [1..50] DO edgeAvail ← NEW[Edge ← [link: edgeAvail]] ENDLOOP};
XArc: PROC =
{THROUGH [1..50] DO arcAvail ← NEW[Arc ← [link: arcAvail]] ENDLOOP};
XLine: PROC = {THROUGH [1..50] DO lineAvail ← NEW[LineConstraint ← [link:lineAvail]] ENDLOOP};
XCong: PROC =
{THROUGH [1..50] DO congAvail ← NEW[CongruenceConstraint ← [link:congAvail]] ENDLOOP};
XHor: PROC =
{THROUGH [1..50] DO horAvail ← NEW[HorizontalConstraint ← [link:horAvail]] ENDLOOP};
XVer: PROC =
{THROUGH [1..50] DO verAvail ← NEW[VerticalConstraint ← [link:verAvail]] ENDLOOP};
XCC: PROC =
{THROUGH [1..50] DO ccAvail ← NEW[CCConstraint ← [link:ccAvail]] ENDLOOP};
XTv: PROC =
{THROUGH [1..50] DO tvAvail ← NEW[TvRec ← [tail:tvAvail]] ENDLOOP};
XBasis: PROC =
{THROUGH [1..50] DO basisAvail ← NEW[BasisRec ← [tail:basisAvail]] ENDLOOP};
XString : PROC =
{ THROUGH [1..50] DO stringAvail ← NEW [String ← [link: stringAvail]]
ENDLOOP};
AddPoint: PUBLIC PROCEDURE[x,y:REAL] RETURNS [PointPtr] =
BEGIN
p: PointPtr ← NewPoint[];
p.x ← x; p.y ← y;
p.link ← pointLpad.link;
pointLpad.link ← p;
RETURN [p];
END;
Distance: PROC[a,b,c,d:REAL] RETURNS [REAL] = INLINE
{RETURN[RealFns.SqRt[(a-c)*(a-c)+(b-d)*(b-d)]]};
FindPoint: PUBLIC PROCEDURE[x,y:REAL] RETURNS [PointPtr] =
BEGIN
-- This procedure finds the point closest to the current mouse coordinates.
p: PointPtr ← pointLpad.link;
champdistance, pdistance: REAL;
champ: PointPtr;
IF p = pointRpad THEN RETURN[NIL]; -- no points.
champ ← p;
champdistance ← Distance[p.x, p.y, x, y];
p ← p.link;
WHILE p # pointRpad DO
pdistance ← Distance[p.x, p.y, x, y];
IF pdistance < champdistance THEN BEGIN champ ← p; champdistance ← pdistance END;
p ← p.link;
ENDLOOP;
RETURN [champ];
END;
AddEdge: PUBLIC PROCEDURE[a,b:PointPtr] =
BEGIN
p: EdgePtr;
IF a = NIL OR b = NIL THEN RETURN;
-- why reversed a & b assignments?
p ← NewEdge[]; p.b1 ← b; p.b2 ← a; p.link ← edgeLpad.link;
edgeLpad.link ← p;
END;
AddArc: PUBLIC PROCEDURE[a,b,c,d:PointPtr] =
BEGIN
p: ArcPtr;
IF a = NIL OR b = NIL OR c = NIL OR d = NIL THEN RETURN;
p ← NewArc[]; p.b1 ← a; p.b2 ← b; p.b3 ← c; p.b4 ← d; p.link ← arcLpad.link;
arcLpad.link ← p;
END;
AddHor: PUBLIC PROCEDURE[a,b:PointPtr] =
BEGIN
p: HorPtr;
IF a = NIL OR b = NIL THEN RETURN;
p ← NewHor[];
p.i ← a;
p.j ← b;
p.link ← horLpad.link;
horLpad.link ← p;
END;
AddVer: PUBLIC PROCEDURE[a,b:PointPtr] =
BEGIN
p: VerPtr;
IF a = NIL OR b = NIL THEN RETURN;
p ← NewVer[];
p.i ← b;
p.j ← a;
p.link ← verLpad.link;
verLpad.link ← p;
END;
AddCong: PUBLIC PROCEDURE[a,b,c,d:PointPtr] =
BEGIN
p: CongPtr;
IF d = NIL OR c = NIL OR b = NIL OR a = NIL THEN RETURN;
p ← NewCong[];
p.i ← c;
p.j ← d;
p.k ← a;
p.l ← b;
p.link ← congLpad.link;
congLpad.link ← p;
END;
AddLin: PUBLIC PROCEDURE[a,b,c,d:PointPtr] =
BEGIN
p: LinPtr;
IF a = NIL OR b = NIL OR c = NIL THEN RETURN;
p ← NewLine[];
p.i ← a;
p.j ← b;
p.k ← c;
p.l ← d;
p.link ← lineLpad.link;
lineLpad.link ← p;
END;
AddCC: PUBLIC PROC[a, b, c: PointPtr] =
{p: CCPtr;
IF a = NIL OR b = NIL OR c = NIL THEN ERROR;
p ← NewCC[];
p.i ← a;
p.j ← b;
p.k ← c;
p.link ← ccLpad.link;
ccLpad.link ← p};
AddString: PUBLIC PROCEDURE
[c,d: PointPtr, h, w, dep : REAL,
stringText: Rope.ROPE, stringFont: Graphics.FontRef,
fontName: Rope.ROPE, fontSize: INT, bold, italic: BOOL] =
BEGIN
p : StringPtr;
IF c = NIL OR d = NIL THEN RETURN;
p ← NewString[ ];
p.b3 ← c;
p.b4 ← d;
p.height ← h;
p.width ← w;
p.depth ← dep;
p.stringText ← stringText;
p.stringFont ← stringFont;
p.fontName ←fontName;
p.fontSize ← fontSize;
p.bold ← bold;
p.italic ← italic;
p.link ← stringLpad.link; stringLpad.link ← p;
END;
InitJunoStorage: PUBLIC PROCEDURE =
BEGIN
pointRpad ← NewPoint[]; pointRpad.x ← 32767;
pointLpad ← NewPoint[]; pointLpad.x ← -32767; -- for some reason -32768 won't work
pointLpad.link ← pointRpad;
pointLpad.slink ← pointRpad;
edgeLpad ← NewEdge[];
edgeRpad ← NewEdge[];
edgeLpad.link ← edgeRpad;
arcLpad ← NewArc[];
arcRpad ← NewArc[];
arcLpad.link ← arcRpad;
lineLpad ← NewLine[];
lineRpad ← NewLine[];
lineLpad.link ← lineRpad;
congLpad ← NewCong[];
congRpad ← NewCong[];
congLpad.link ← congRpad;
horLpad ← NewHor[];
horRpad ← NewHor[];
horLpad.link ← horRpad;
verLpad ← NewVer[];
verRpad ← NewVer[];
verLpad.link ← verRpad;
ccLpad ← NewCC[];
ccRpad ← NewCC[];
ccLpad.link ← ccRpad;
stringLpad ← NewString[ ];
stringRpad ← NewString[ ];
stringLpad.link ← stringRpad;
END;
ResetJunoStorage: PUBLIC PROC =
-- test the cedar collector:
{pointLpad.link ← pointRpad;
pointLpad.slink ← pointRpad;
edgeLpad.link ← edgeRpad;
arcLpad.link ← arcRpad;
lineLpad.link ← lineRpad;
congLpad.link ← congRpad;
horLpad.link ← horRpad;
verLpad.link ← verRpad;
ccLpad.link ← ccRpad;
stringLpad.link ← stringRpad;
};
pointLpad, pointRpad: PUBLIC PointPtr; -- The lists of points, edges, arcs
edgeLpad, edgeRpad:PUBLIC EdgePtr; -- line constraints, and cong. constraints
arcLpad, arcRpad: PUBLIC ArcPtr; -- are padded on both sides.
lineLpad, lineRpad: PUBLIC LinPtr;
congLpad, congRpad:PUBLIC CongPtr;
horLpad, horRpad: PUBLIC HorPtr;
verLpad, verRpad: PUBLIC VerPtr;
ccLpad, ccRpad: PUBLIC CCPtr;
stringLpad, stringRpad: PUBLIC StringPtr;
END.