--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.