DIRECTORY 
  HerculesAlgebra USING
     [Se, Value, FunVal, rightArrow, if, true, suchThat, and, skip, comma, semicolon,
      hor, ver, cong, perp, para, ccw, equals, approx, rel, leftPren, Frame, Matrix,
      GetFrameMatrix, InvertMatrix, PointPtr],
  HerculesBody,
  HerculesImage,
  HerculesStorage USING
    [ConstrPtr, HorPtr, VerPtr, CongPtr, ParaPtr, PerpPtr, AtPtr,
     CcwPtr, ActionPtr],
  Atom,
  Rope,
  Convert,
  HerculesGraphics;
          
HerculesBodyImpl: PROGRAM
  IMPORTS
    HerculesAlgebra, Atom, Rope, Convert,
    HerculesGraphics, HerculesImage 
  EXPORTS
    HerculesBody = 
              
BEGIN

OPEN
  Stor: HerculesStorage,
  Gr: HerculesGraphics,
  Im: HerculesImage,
  Alg: HerculesAlgebra;


PointPtr: TYPE = Alg.PointPtr;

EraseAllNames: PUBLIC PROC =

BEGIN
  -- Erases the names of all points in the (pointLpad..pointRpad) list.
  p: PointPtr _ Im.image.points;
  WHILE p # NIL DO
    p.name _ NIL; p _ p.link
   ENDLOOP
END; 
 
NamePoint: PUBLIC PROC [p: PointPtr, i: INT] RETURNS [nam: ATOM]=

BEGIN
  -- Assigns the ith standard name to the point p, and returns the chosen name.
  -- Also paints the name on the viewer. Complains if p already named.
  IF p.name # NIL THEN ERROR;
  nam _ Atom.MakeAtom[IF i > 25 
    THEN Rope.Cat["a", Convert.RopeFromInt[i - 26, 10, FALSE]]  
    ELSE Rope.FromChar['a + i - 1]];
  p.name _ nam;
  Gr.DrawRope[Atom.GetPName[nam], p.x + 5, p.y + 5];
  Gr.viewerChanged _ TRUE
END;

MakeFrameExpr: PROC[frame: Alg.Frame] RETURNS [frameExpr: Alg.Se] =

BEGIN
  --  Returns the Juno expression for the frame determined by
  --    the three points frame.org, frame.xP, frame.yP
  --   (the last one or two of which may be NIL).    
  temp: REF = IF frame.xP = NIL THEN frame.org.name
     ELSE IF frame.yP = NIL THEN LIST[Alg.comma, frame.org.name, frame.xP.name]
     ELSE LIST[Alg.comma, frame.org.name, LIST[Alg.comma, frame.xP.name, frame.yP.name]];
  RETURN[LIST[Alg.leftPren, temp]]
END;

m: REF Alg.Matrix _ NEW[Alg.Matrix];
mInv: REF Alg.Matrix _ NEW[Alg.Matrix];

MakeBody: PUBLIC PROC[frame: Alg.Frame, nParms: INT] RETURNS [body: Alg.Se] =
 
BEGIN
  -- Creates a procedure body describing all wound points in the current image, plus
  --   associated constraints and actions.
  -- Assumes nParms of those points are parameters, whose name field has already been set.
  -- The remaining points are local variables. The hints for each of these will be its
  --   current position, relative to the given frame.    
  locals, actions, constrs: Alg.Se;
  sing: BOOL;
  m _ Alg.GetFrameMatrix[frame, m];
  [mInv, sing] _ Alg.InvertMatrix[m, mInv];
  IF sing THEN ERROR;
  locals _ BuildLocalList [frame, mInv, nParms];
  actions _ BuildActionList[];
  constrs _ BuildConstrList[];
  IF locals = NIL THEN
    {IF constrs # Alg.true OR actions # Alg.skip THEN ERROR;
     RETURN[actions]}
  ELSE
    {RETURN [LIST[Alg.if,
        LIST[Alg.rightArrow, LIST[Alg.suchThat, locals, constrs],  actions]]]}
END;
    
BuildLocalList: PROC [frame: Alg.Frame, mInv: REF Alg.Matrix, nParms: INT]
  RETURNS [locals: Alg.Se] =

BEGIN
 -- Assign names to all points in the image list that have nonzero winding numbers.
 -- Points that already
 --    have names are ignored (they are assumed to be input parameters).
 -- Also returns a Juno expression declaring the newly named points.
 -- The hints for each new point will be its current position, relative to the
 --   given frame;
 --   mInv should be the matrix of the viewer's frame relative to the given one.
 -- Uses standard names (<letters>, then a<number>), but assumes nParms
 --   of those have already been assigned to the input parameters.
 i: INT _ nParms+1;
 p: PointPtr _ Im.image.points;
 x, y: REAL;
 nam: ATOM;
 localList: LIST OF Alg.Se _ NIL;
 frameExpr: Alg.Se _ MakeFrameExpr[frame];
 -- Is it OK for all hints to share the same frame expression?
 UNTIL p = NIL DO
    IF p.wn # 0 AND p.name = NIL THEN
      {nam _ NamePoint[p, i];
        i _ i + 1;
        x _ p.x * mInv^[1][1] + p.y * mInv^[1][2] + mInv^[1][3];
        y _ p.x * mInv^[2][1] + p.y * mInv^[2][2] + mInv^[2][3];
        localList _ CONS [
          LIST[Alg.approx,
                nam,
                LIST[Alg.rel,
                      LIST[Alg.leftPren, LIST[Alg.comma, NEW[REAL _ x], NEW[REAL _ y]]],
                      frameExpr]],
          localList]};
    p _ p.link
  ENDLOOP;
 RETURN [ReverseAndNest[localList, Alg.comma, NIL]]
END;
 
ReverseAndNest: PROC [args: LIST OF REF, op: REF, zero: REF] RETURNS [expr: REF] =

BEGIN
  IF args = NIL THEN RETURN [zero];
  expr _ args.first; args _ args.rest;
  WHILE args # NIL DO
     expr _ LIST[op, args.first, expr];
     args _ args.rest
    ENDLOOP;
  RETURN [expr]
END;

BuildConstrList: PROC  RETURNS [constrs: Alg.Se] =

BEGIN

   cExprList: LIST OF Alg.Se _ NIL;

   AddConstrExpr: PROC[op: ATOM, r1, r2: Alg.Se _ NIL, frame: Alg.Frame] = 
      {pred: Alg.Se _ IF r2 = NIL THEN LIST[op, r1] ELSE LIST[op, r1, r2];
       IF frame # [NIL, NIL, NIL] THEN
           {pred _ LIST[Alg.rel, pred, MakeFrameExpr[frame]];
       cExprList _ CONS[pred, cExprList]}};

   c: Stor.ConstrPtr _ Im.image.constrs;
   WHILE c # NIL DO
     IF Im.ConstrIsWound[c] THEN
       {WITH c SELECT FROM
          cc: Stor.HorPtr =>
             {AddConstrExpr
                     [Alg.hor,
                      PrenArgs[LIST[cc.i, cc.j]], NIL, [NIL, NIL, NIL]]};
          cc: Stor.VerPtr =>
             {AddConstrExpr
                     [Alg.ver,
                      PrenArgs[LIST[cc.i, cc.j]], NIL, [NIL, NIL, NIL]]};
          cc: Stor.CongPtr =>
             {AddConstrExpr
                     [Alg.cong,
                      PrenArgs[LIST[cc.i, cc.j]],
                      PrenArgs[LIST[cc.k, cc.l]], cc.frame]};
          cc: Stor.ParaPtr =>
             {AddConstrExpr
                     [Alg.para,
                      PrenArgs[LIST[cc.i, cc.j]],
                      PrenArgs[LIST[cc.k, cc.l]], [NIL, NIL, NIL]]};
          cc: Stor.PerpPtr =>
             {AddConstrExpr
                     [Alg.perp,
                      PrenArgs[LIST[cc.i, cc.j]],
                      PrenArgs[LIST[cc.k, cc.l]], cc.frame]};
          cc: Stor.AtPtr =>
             {AddConstrExpr
                 [Alg.equals,
                  PrenArgs[LIST[cc.p]],
                  LIST[Alg.leftPren,
                       LIST[Alg.comma, NEW[REAL _ cc.x], NEW[REAL _ cc.y]]], cc.frame]};
          cc: Stor.CcwPtr =>
             {AddConstrExpr
                [Alg.ccw,
                 PrenArgs[LIST[cc.i, cc.j, cc.k]], NIL, cc.frame]};
         ENDCASE => ERROR};
     c _ c.link
    ENDLOOP;

   constrs _ ReverseAndNest [cExprList, Alg.and, Alg.true]
END;

BuildActionList: PROC  RETURNS [actions: Alg.Se] =

BEGIN
   actionList: LIST OF Alg.Se _ NIL;
   a: Stor.ActionPtr _ Im.image.actions.first;

   WHILE a # NIL DO
     IF Im.ActionIsWound[a] THEN
       {actionList _ CONS
            [LIST [Alg.leftPren, a.op, UnEval[a.arg]],
             actionList]};
     a _ a.link
    ENDLOOP;

   actions _ ReverseAndNest [actionList, Alg.semicolon, Alg.skip]
END;

Nest: PUBLIC PROC [list: LIST OF Alg.Se, op, zero: ATOM] RETURNS [Alg.Se] =

  {IF list = NIL THEN RETURN [zero]
  ELSE IF list.rest = NIL THEN RETURN [list.first] 
  ELSE RETURN [LIST[op, list.first, Nest[list.rest, op, zero]]]};
   
NestAtoms: PUBLIC PROC [list: LIST OF ATOM, op, zero: ATOM] RETURNS [Alg.Se] =

  {IF list = NIL THEN RETURN [zero]
  ELSE IF list.rest = NIL THEN RETURN [list.first] 
  ELSE RETURN [LIST[op, list.first, NestAtoms[list.rest, op, zero]]]};
   
UnEval: PROC [arg: Alg.Value] RETURNS [expr: Alg.Se] =

{WITH arg SELECT FROM
     aa: REF INT => RETURN [aa];
     aa: REF REAL => RETURN [aa];
     aa: Rope.ROPE => RETURN [aa];
     aa: PointPtr => RETURN [aa.name];
     aa: Alg.FunVal => ERROR; -- Alg.GetName[aa, globals]
     aa: LIST OF Alg.Value => RETURN [UnEvalList[aa]];
    ENDCASE => ERROR};

UnEvalList: PROC [list: LIST OF Alg.Value] RETURNS [expr: Alg.Se] =

{IF list.rest = NIL 
       THEN RETURN [UnEval[ list.first]]
       ELSE RETURN [LIST[Alg.comma, UnEval[list.first], UnEvalList[list.rest]] ]};

PrenArgs: PROC [arg: LIST OF Alg.Value] RETURNS [expr: Alg.Se] =

  {RETURN [LIST[Alg.leftPren, UnEvalList[arg]]]};
  
END.

‚program HerculesBodyImpl.mesa (ex JunoBodyImpl.mesa), coded July 1981 by Greg Nelson

Procedures for creating a symbolic procedure out of the current image.

Last Edited by: Stolfi, February 22, 1984 7:17 am

These matrices are used as work areas by MakeBody:

Edited on January 24, 1984 3:28 am, by Stolfi
-- Added Tioga formatting.
-- Extended MakeDefBody for more than two arguments.
-- Infinitesimal bug: stringFont was not being copied in ScanLists
-- Cleaned up matrix operations in preparation for relative constraints
changes to: GetFrameMatrix(new), InvertMatrix(new), MultiplyMatrix(new), ComputeTransform (parameter change), ComputeSomeTransform(replaces a piece of JunoTop.MoveStep), TransformPoint (new), EraseAllNames (new), true, and, skip, comma (new), MakeFrameExpr (new), MakeBody (new, replaces MakeDefBody and OtherMakeDefBody), BuildLocalList (substantial parameter changes), Nest (parameter changes; handles empty lists too), BuildActionAndPredLists (parameter changes), ScanLists (cleanup and parameter changes), AddAction, AddPred (made local to ScanLists), TransformPoints (replaces PerformTransform)

changes to: ScanLists (Replaced references to GcEdge, GcArc, etc by GcItem; added handling of  perp and $= constraints; added frame parameters to calls of AddPred, AddHor, etc (even though they currently are always NIL); dismembered and distributed into Copy, Delete, Identify, and BuildActionsAndPredLists), BuildLocalLists (Changed to reflect new priorirties of $== and $rel), PointNames (replaces Args), PointOrValueNames (replaces NewArgs), ArgName (made local to PointOrValueNames), GetFrameMatrix, InvertMatrix, MultiplyMatrix, ComputeTransform, ComputeSomeTransform, TransformPoint (moved to HerculesMatrixImpl), Fix (deleted), Nest (replaces Fix)

Edited on January 28, 1984 2:40 am, by Stolfi
changes to:  TransformPoints (to account for changes in TransformPoint parameters)

Edited on February 7, 1984 3:50 am, by Stolfi
changes to:  Delete, TransformPoint, Copy, copiedPoints, Identify (moved to HerculesImage), FindSelectedPoint, SortPoints (moved to HerculesTop), ItemOperation, EnumerateItems, (moved to HerculesImage) copiedPoints (deleted), ListOfCopies, AllHaveCopies, Copy, TransformPoints, Identify, SetCopiesToNil, Delete, DeleteOriginals (moved to HerculesImageImpl), MakeFrameExpr (parameter is Frame), MakeBody (parameter is Frame), BuildLocalList (considers only wound points; shares frame expression), ReverseAndNest (new - replaces Nest), BuildActionsAndPresdsLists (replaced by BuildConstrList, BuildActionsList), BuildConstrList (considers only wound constraints), BuildActionsList (considers only wound actions; preserves chronological order)

Edited on February 10, 1984 4:10 am, by Stolfi
changes to:  UnEval, UnEvalList (replace PointNames, PointOrValueNames), 

Edited on February 14, 1984 0:11 am, by Stolfi
changes to:  BuildActionList (actions now are always applications), 
�Ê„˜Jš
œU™UJš
œG™GJ™1J™JšÏk	œ�œ¨˜ÊJšœ�œ�œR�œ#˜Ÿ
Jš�œ
˜Jš�œ`˜dJšœ
�œ˜šÏn
œ�œ
�œ˜Jš�œ
ÏcHœ#�œ�œ
�œ�œ�œ
�œ˜±
—šž	œ�œ
�œ�œ�œ�œ˜BJš�œŸNœŸEœ�œ
�œ
�œ
�œ�œ
�œ/�œ	�œw�œ
�œ˜¦—šž
œ�œ�œ˜DJš$�œŸUœŸ7œ�œ�œ�œ
�œ�œ
�œ�œ
�œ
�œ0�œ
�œ�œ.�œ
�œ�œ˜·—Jšœ)Ïrœ™3Jšœ�œ�œ
˜$Jšœ�œ�œ˜(š
žœ�œ
�œ�œ�œ˜OJš,�œŸ‹
œŸ'œŸ®
œ,�œT�œ�œ
�œs�œ
�œ
�œ�œ�œ�œ
�œ�œ
�œ�œ�œ�œ�œ.�œ˜Ü—š
žœ�œ�œ�œ�œ˜hJš>�œŸ«œŸ@œŸDœ�œ4�œ�œ�œ
�œ
�œ.Ÿ>œ
�œ�œ
�œ�œ
�œ
�œ
�œÈ
�œ
�œ2�œ �œ�œ�œ
�œ�œ
�œT�œ�œ'�œ�œ˜Ò
—šžœ�œ�œ
�œ
�œ�œ�œ�œ�œ˜SJš�œ�œ�œ
�œ
�œ2�œ�œ
�œ
�œ2�œ�œ�œ˜Ç
—šžœ�œ�œ˜2Jš�œ�œ
�œ
�œ
˜+Jš#œž
œ�œ�œ�œ-�œ�œ
�œ
�œ	�œ
�œ�œ
�œ�œ�œ�œ�œ:�œ˜¨JšEœ-�œ�œ
�œ�œ�œ	�œ�œ
�œx�œ�œ�œ{�œ�œ�œ}�œ.�œ”
�œ.�œ�œ}�œ.�œŒ
�œ�œ&�œ�œ
�œ
�œ
�œ…
�œ�œ�œ�œ�œ>�œ˜°—šžœ�œ�œ˜2Jš�œ�œ
�œ
�œ5�œ�œ
�œ�œ�œ�œ�œ
�œ-�œ#�œE�œ˜â—šžœ�œ
�œ�œ
�œ�œ�œ˜LJšœ�œ�œ
�œ
�œ
�œ
�œ
�œ
�œ
�œ�œ
�œ�œ2˜�
—šž	œ�œ
�œ�œ
�œ
�œ�œ�œ˜OJšœ�œ�œ
�œ
�œ
�œ
�œ
�œ
�œ
�œ�œ
�œ�œ7˜¢
—šžœ�œ�œ˜6Jš'œ�œ�œ
�œ
�œ
�œ�œ�œ
�œ�œ�œ�œ�œ#�œ
Ÿœ	�œ
�œ�œ�œ�œ˜¬—š
ž
œ�œ�œ
�œ�œ˜CJšœ�œ
�œ	�œ
�œ�œ
�œ�œ;˜’
—š
žœ�œ�œ
�œ�œ˜AJšœ�œ�œ%˜4—Jš�œ˜™-J™Jšœ œ 
™4J™BJ™GJš!œ œ œ œ œ œ& œ œ œ œ 
œ1 œ  œ- œ œ  œ œ™×—J™Jš=œ 
œ œ œ œ œ œ œ- œ$ œ œ œ œ œ' œ œ 
œ œ
 œ œ œ œ
 œ œ œ œ œ œ  œ œ œ
™ŽJ™™-Jšœ
 œ œ™R—J™™-Jš5œ
 4œ 
œ œ 
œ œS œ 
œ œ œ œ œ œ œ œ 
œ œ œ œ œ9 œ œ œ œ œ œ% œ>™ä—J™™.Jšœ
 œ
 œ™I—J™™.Jšœ
 œ(™D——…— h3n