DIRECTORY HerculesAlgebra USING [Value, Frame, Se, PointRec], HerculesStorage; HerculesStorageImpl: PROGRAM EXPORTS HerculesStorage = BEGIN OPEN Alg: HerculesAlgebra, HerculesStorage; 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; 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; 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; 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. ^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 - - - - POINTS - - - - CONSTRAINTS - - - - ACTIONS - - - - INITIALIZATION 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 Ê Õ˜JšœR™RJšœ;™;JšÏbœK™QJ™1J™JšÏk œžœ1˜QJš œžœžœžœžœ.˜rJ™Jšœ˜J˜Jšœžœ˜Jšœžœ˜J˜š Ïnœž œžœ žœžœžœ˜OJšœžœžœžœžœžœ žœžœ)žœEžœ2žœ˜¢—šŸ œžœžœ&žœ˜\Jš)œžœžœ žœžœžœžœžœžœžœžœžœ$žœžœžœ žœ žœžœžœAžœžœ˜È—šŸ œžœžœ&žœ˜\Jš œžœžœžœžœ+žœIžœ˜™—šŸœžœžœ˜$JšœžœFžœ˜Q—J™J™Jš œ žœ žœ žœžœ˜7Jš œ žœžœ žœžœžœ˜2šŸ œžœžœ˜>šœžœ(žœžœž˜MJš#œžœÏc!œžœ žœ=žœžœžœ$žœ%žœ&žœ&žœ$žœ#žœžœžœ$žœžœ˜ú—JšœUžœžœ˜^—šŸ œžœžœ(žœ˜`Jš)œžœžœ žœžœžœžœžœžœžœžœžœ$žœžœžœ žœ žœžœžœAžœžœ˜Ä—šŸ œžœžœ(žœ˜`Jš œžœžœžœžœ+žœIžœ˜™—šŸœžœžœ˜'Jšžœpžœ˜z—šŸœžœžœžœ˜