<> <> <> <<>> 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 (, then a), 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. <> <<-- 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>> <> <<>> <> <<>> <> <> <<>> <> <> <<>> <> <> <<>> <> <>