[Cyan]<PreISLCedar>Stolfi>Hercules>HerculesStorageImpl.mesa!1

HerculesStorageImpl.mesa (ex JunoStorageImpl.mesa), coded June 81 by Greg Nelson.

Defines data types, allocation and deallocation functions.

To do: Keep constraints in symbolic expression form (February 13, 1984 10:52 pm)

Last Edited by: Stolfi, February 22, 1984 6:40 am

DIRECTORY
HerculesAlgebra USING [Value, Frame, Se, PointRec],
HerculesStorage;

HerculesStorageImpl: PROGRAM
EXPORTS HerculesStorage =
BEGIN OPEN
Alg: HerculesAlgebra,
HerculesStorage;

- - - - POINTS

PointRec: TYPE = Alg.PointRec;

pointAvail: PointPtr ← NIL;

nPoint: INT ← 0;

NewPoint: PUBLIC PROC [x, y:REAL, visible: BOOL ← TRUE] RETURNS [p: PointPtr] =

BEGIN
nPoint ← nPoint + 1;
IF pointAvail = NIL THEN
THROUGH [1..50] DO
pointAvail ← NEW [PointRec ← [link: pointAvail]]
ENDLOOP;
p ← pointAvail;
pointAvail ← pointAvail.link;
p.link ← NIL;
p.x ← x; p.y ← y;
p.visible ← visible
END;

DeletePoint: PUBLIC PROC [p, pAnt: PointPtr, list: PointList] RETURNS [newList: PointList] =

BEGIN
IF p = list THEN
{IF pAnt # NIL THEN ERROR;
newList ← p.link}
ELSE
{IF pAnt = NIL THEN
{pAnt ← list;
WHILE pAnt.link # p DO pAnt ← pAnt.link ENDLOOP}
ELSE
{IF pAnt.link # p THEN ERROR};
pAnt.link ← p.link;
newList ← list};
p.link ← NIL
END;

InsertPoint: PUBLIC PROC [p, pAnt: PointPtr, list: PointList] RETURNS [newList: PointList] =

BEGIN
IF pAnt = NIL THEN
{p.link ← list;
newList ← p}
ELSE
{p.link ← pAnt.link;
pAnt.link ← p;
newList ← list}
END;

GcPoint: PUBLIC PROC [p: PointPtr] =

BEGIN
nPoint ← nPoint - 1;
p.link ← pointAvail;
pointAvail ← p
END;

- - - - CONSTRAINTS

constrAvail: ARRAY ConstrKind OF ConstrPtr ← ALL[NIL];

nConstr: PUBLIC ARRAY ConstrKind OF INT ← ALL[0];

NewConstr: PROC [kind: ConstrKind] RETURNS [cp: ConstrPtr] =

BEGIN
nConstr[kind] ← nConstr[kind] + 1;
IF constrAvail[kind] = NIL THEN

BEGIN -- Create a bunch of new records
t: ConstrPtr;
THROUGH [1..50] DO
t ← constrAvail[kind];
constrAvail[kind] ←
SELECT kind FROM
ver => NEW[ver ConstrRec],
ccw => NEW[ccw ConstrRec],
para => NEW[para ConstrRec],
perp => NEW[perp ConstrRec],
cong => NEW[cong ConstrRec],
at => NEW[at ConstrRec],
hor => NEW[hor ConstrRec],
ENDCASE => ERROR;
constrAvail[kind].link ← t
ENDLOOP
END;

cp ← constrAvail[kind];
constrAvail[kind] ← constrAvail[kind].link;
cp.link ← NIL
END;

DeleteConstr: PUBLIC PROC [c, cAnt: ConstrPtr, list: ConstrList] RETURNS [newList: ConstrList] =

BEGIN
IF c = list THEN
{IF cAnt # NIL THEN ERROR;
newList ← c.link}
ELSE
{IF cAnt = NIL THEN
{cAnt ← list;
WHILE cAnt.link # c DO cAnt ← cAnt.link ENDLOOP}
ELSE
{IF cAnt.link # c THEN ERROR};
cAnt.link ← c.link;
newList ← list};
c.link ← NIL
END;

InsertConstr: PUBLIC PROC [c, cAnt: ConstrPtr, list: ConstrList] RETURNS [newList: ConstrList] =

BEGIN
IF cAnt = NIL THEN
{c.link ← list;
newList ← c}
ELSE
{c.link ← cAnt.link;
cAnt.link ← c;
newList ← list}
END;

GcConstr: PUBLIC PROC [cp: ConstrPtr] =

BEGIN
nConstr[cp.kind] ← nConstr[cp.kind] - 1;
cp.link ← constrAvail[cp.kind];
constrAvail[cp.kind] ← cp
END;

NewHor: PUBLIC PROC [i,j: PointPtr]
RETURNS [cp: HorPtr] =

BEGIN
IF i = NIL OR j = NIL THEN ERROR;
cp ← NARROW [NewConstr[hor]];
cp.i ← i;
cp.j ← j
END;

NewVer: PUBLIC PROC [i,j: PointPtr]
RETURNS [cp: VerPtr] =

BEGIN
IF i = NIL OR j = NIL THEN ERROR;
cp ← NARROW [NewConstr[ver]];
cp.i ← i;
cp.j ← j;
END;

NewPara: PUBLIC PROC [i,j,k,l: PointPtr]
RETURNS [cp: ParaPtr] =

BEGIN
IF i = NIL OR j = NIL OR k = NIL OR l=NIL THEN ERROR;
cp ← NARROW [NewConstr[para]];
cp.i ← i;
cp.j ← j;
cp.k ← k;
cp.l ← l
END;

NewPerp: PUBLIC PROC [i,j,k,l: PointPtr, frame: Alg.Frame ← [NIL, NIL, NIL]]
RETURNS [cp: PerpPtr] =

BEGIN
IF i = NIL OR j = NIL OR k = NIL OR l=NIL THEN ERROR;
cp ← NARROW [NewConstr[perp]];
cp.i ← i;
cp.j ← j;
cp.k ← k;
cp.l ← l;
cp.frame ← frame
END;

NewCong: PUBLIC PROC [i,j,k,l: PointPtr, frame: Alg.Frame ← [NIL, NIL, NIL]]
RETURNS [cp: CongPtr] =

BEGIN
IF i = NIL OR j = NIL OR k = NIL OR l=NIL THEN ERROR;
cp ← NARROW [NewConstr[cong]];
cp.i ← i;
cp.j ← j;
cp.k ← k;
cp.l ← l;
cp.frame ← frame
END;

NewAt: PUBLIC PROC [p: PointPtr, x,y: REAL, frame: Alg.Frame ← [NIL, NIL, NIL]]
RETURNS [cp: AtPtr] =

BEGIN
IF p = NIL THEN ERROR;
cp ← NARROW [NewConstr[at]];
cp.p ← p;
cp.x ← x;
cp.y ← y;
cp.frame ← frame
END;

NewCcw: PUBLIC PROC [i,j,k: PointPtr, frame: Alg.Frame ← [NIL,NIL, NIL]]
RETURNS [cp: CcwPtr] =

BEGIN
IF i = NIL OR j = NIL OR k = NIL THEN ERROR;
cp ← NARROW [NewConstr[ccw]];
cp.i ← i;
cp.j ← j;
cp.k ← k;
cp.frame ← frame;
END;

- - - - ACTIONS

actionAvail: ActionPtr ← NIL;

nAction: PUBLIC INT ← 0;

NewAction: PUBLIC PROC [op: Alg.Se, arg: Alg.Value] RETURNS [ap: ActionPtr] =

BEGIN
nAction ← nAction + 1;
IF actionAvail = NIL THEN

BEGIN
t: ActionPtr;
THROUGH [1..50] DO
t ← actionAvail;
actionAvail ← NEW[ActionRec];
actionAvail.link ← t
ENDLOOP
END;

ap ← actionAvail;
actionAvail ← actionAvail.link;
ap.link ← NIL
END;

DeleteAction: PUBLIC PROC [a, aAnt: ActionPtr, list: ActionList] RETURNS [newList: ActionList] =

BEGIN
IF a = list.first THEN
{IF aAnt # NIL THEN ERROR;
newList.first ← a.link}
ELSE
{IF aAnt = NIL THEN
{aAnt ← list.first;
WHILE aAnt.link # a DO aAnt ← aAnt.link ENDLOOP}
ELSE
{IF aAnt.link # a THEN ERROR};
aAnt.link ← a.link};
newList.last ← IF a = list.last THEN aAnt ELSE list.last;
a.link ← NIL
END;

InsertAction: PUBLIC PROC [a, aAnt: ActionPtr, list: ActionList] RETURNS [newList: ActionList] =

BEGIN
IF aAnt = NIL THEN
{a.link ← list.first;
newList.first ← a}
ELSE
{a.link ← aAnt.link;
aAnt.link ← a;
newList.first ← list.first};
newList.last ← IF a.link = NIL THEN a ELSE list.last
END;

GcAction: PUBLIC PROC [ap: ActionPtr] =

BEGIN
nAction ← nAction - 1;
ap.link ← actionAvail;
actionAvail ← ap
END;

- - - - INITIALIZATION

InitStorage: PUBLIC PROC =

BEGIN
GcPoint[NewPoint[0, 0]];
FOR kind: ConstrKind IN ConstrKind DO
GcConstr[NewConstr[kind]]
ENDLOOP;
GcAction[NewAction[NIL, NIL]]
END;

InitStorage[]

END.

Edited on January 25, 1984 1:36 am, by Stolfi

-- Added Tioga formatting

-- Infinitesimal bug: GcLine had + instead of -

-- Made all actions and predicated into variants of Item

-- replaced explicit enumerations by FOR loops.

-- Replaced constructionList by the general itemLpad, itemRpad mechanism.

-- Added frame field to constraints.

changes to: everything!

Edited on January 27, 1984 0:05 am, by Stolfi

-- Added perp and $= constraints

-- Added relativized constraints

changes to: NewPerp, NewEquals, AddPerp, AddEquals (new), AddHor, AddVer, AdPara, AddCong, AddCC (added frame parameter), GcHor, GcVer, GcPara, GcCong, GcEdge, GcArc, GcString, GcX (deleted - use GcItem!), NewItem (added perp and equals), MakeFrameRec (new), InsertItem (added frame parameter)

Edited on January 28, 1984 3:20 am, by Stolfi

changes to: NewTv, GcTV, TangentVector, TvRec, Basis, BasisRec, NewBasis, GcBasis, tvAvail, basisAvail, XTv, XBasis (deleted), AddPara, AddHor, AddVer, InsertItem (removed frame parameter) , AddCong, AddPerp, AddCC, AddEquals (set frame parameter), MakeFrameRec (added option to check whether the frame points are fixed; computes matrices if option is true (crock. This should be done outside)), GetFrameMatrix, InvertMatrix, MultiplyMatrix, ComputeTransform, ComputeSomeTransform, TransformPoint (moved here from JunoBodyImpl (via HerculesMatrixImpl))

Edited on February 1, 1984 3:55 pm, by Stolfi

changes to: MakeFrameRec (removed option to check whether the frame points are fixed; removed matrix computation)

Edited on February 4, 1984 2:16 am, by Stolfi

-- ItemRec split into records of various types again; removed link field (use LISTs!)
-- Moved lists of points, constraints and actions on current (unnamed) image to HerculesTop
-- Moved all Addxxx procedures to HerculesTop
-- Moved dictionary of procedures to HerculesTop
-- Moved PushState, PopState, ResetJunoStorage to HerculesTop

changes to: ItemKind (made local to Impl), ConstrPtr, ConstrRec ActionPtr, and ActionRec (replace ItemPtr, ItemRec; changed field names of edge, string, and arc variants; removed right endpoint of string, width, height; replaced pointer to frame by frame record itself), itemLpad, itemRpad, pointLpad, pointRpad (moved to HerculesTop), AtPtr (new name of EqualsPtr), ApplPtr (new name of ApplyPtr), NewConstr, NewAction (replace NewItem; made private; set link to NIL; include old XItem) NewAppl (renamed from NewX), AddPara, AddCong, AddPerp, AddEquals, AddHor, AddVer, AddCcw, AddEdge, AddArc, AddString, AddX, lambdaAlist, HasDef, GetBody, GetLocals, AddDef, PushState, PopState, ResetJunoStorage, SaveStateRec (moved to HerculesTop), NewAt (replaces NewEquals), XPoint (folded into NewPoint), GcConstr, GcAction (replace GcItem), Frame (replaces FrameRec), FramePtr (deleted), MakeFrame (replaces MakeFrameRec), InitStorage (does not initialize current image), XItem (folded into NewConstr, NewAction), FindPoint (takes list of points as parameter), NewPoint, NewHor, NewVer, NewPerp, NewPara, NewCong, NewAt, NewCcw, NewEdge, NewArc, NewString, NewAppl (field setup folded here from AddHor, etc), NewPoint (added visible parameter) FindPoint (moved to JunoTop)

Edited on February 7, 1984 1:17 am, by Stolfi

-- Constraint- and Action-creating procedures (NewHor, NewEdge, etc) complain
-- if any of the arguments are NIL.

changes to: NewHor, NewVer, NewPerp, NewPara, NewCong, NewAt, NewCcw, NewEdge, NewArc, NewString, NewAppl (complain if any of the arguments are NIL) , InitStorage (made private, called on startup)

Edited on February 8, 1984 6:25 pm, by Stolfi

changes to: Se (moved here from HerculesAlgebra), DeletePoint, InsertPoint, DeleteConstr, InsertConstr, DeleteAction, InsertAction, Image (moved here from HerculesImage), GetFrameMatrix, ComputeTransform, ComputeSomeTransform (parameters changed to Frame), NewAppl (args are list of Value)

Edited on February 10, 1984 6:25 am, by Stolfi

changes to: MakeFrame (moved to HerculesAlgebra)

Edited on February 13, 1984 11:01 pm, by Stolfi

changes to: NewEdge, NewString, NewArc, NewAppl (deleted), nAction, actionAvail, NewAction, InitStorage (eliminated variants; now all actions are applications of a Se to a Value)

Edited on February 22, 1984 5:36 am, by Stolfi

changes to: Frames and transformation matrices: moved to HerculesAlgebraImplB