--December 7, 1982 11:38 am
-- JunoStorageImpl.mesa, coded June 81 by Greg Nelson.  
-- Defines record types, allocation and deallocation functions.

DIRECTORY JunoStorage, RealFns, Rope, Graphics, List, JunoButtons;

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.