<> <> <> <> <<>> 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. <> <<-- 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. >> <> <<>> <> <<-- Added perp and $= constraints>> <<-- Added relativized constraints>> <> <<>> <> <> <<>> <> <> <<>> <> << -- 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 >> <> <<>> <> << -- Constraint- and Action-creating procedures (NewHor, NewEdge, etc) complain -- if any of the arguments are NIL. >> <> <<>> <> <> <<>> <> <> <<>> <> <> <<>> <> <> <<>>