JunoBodyImpl.mesa

Coded July 1981 by Greg Nelson
Last edited by GNelson June 13, 1983 5:05 pm
Last edited by Stolfi June 15, 1984 7:36:09 am PDT

This module is concerned with converting selected constraints and actions from the current image into an equivalent Juno S-expression.

DIRECTORY

JunoStorage USING
[Item, Point, Coords, Frame, Cons, GcList, ConstrKind, ProperActionKind,
StatePushingActionKind, ItemKind, nullFrame, ItemArgs],
JunoBody,
JunoUserEvents USING [Blink],
JunoExpressions USING [comma, leftPren, semicolon, hor, ver, para, perp, cong,
at, ccw, rel, print, draw, font, face, size, paint, width, justified, true, skip, suchThat,
if, approx, and, rightArrow],
JunoAlgebra USING [Value, ValueList],
JunoMatrix USING [Matrix, MapCoords, InvertMatrix, GetFrameMatrix, Identity],
Rope USING [ROPE],
JunoImage USING
[EnumPoints, EnumItems, PointVisitProc, ItemVisitProc, ItemIsWound];

JunoBodyImpl: PROGRAM

IMPORTS

JunoStorage,
JunoMatrix,
JunoUserEvents,
JunoExpressions,
JunoImage

EXPORTS JunoBody =

BEGIN OPEN

Rope,
JunoBody,
JunoStorage,
Evs: JunoUserEvents,
Expr: JunoExpressions,
Alg: JunoAlgebra,
Mat: JunoMatrix,
Im: JunoImage;

- - - - IMPORTED TYPES

Value: TYPE = Alg.Value;

ValueList: TYPE = Alg.ValueList;

- - - - PUBLIC PROCEDURES

MakeBody: PUBLIC PROC [frame: Frame] RETURNS [body: Se] =

BEGIN

locals, actions, constraints: Se;
framex: Se;
mInv: REF Mat.Matrix ← NEW[Mat.Matrix];

Gets the frame matrix:

IF frame # nullFrame THEN
{sing: BOOL;
m: REF Mat.Matrix ← NEW[Mat.Matrix];
DO
m ← Mat.GetFrameMatrix[frame, m];
[mInv, sing] ← Mat.InvertMatrix[m, mInv];
IF sing THEN
{Evs.Blink ["given frame is singular; dropping terms."];
IF frame.ver # NIL THEN frame.ver ← NIL
ELSE IF frame.hor # NIL THEN frame.hor ← NIL
ELSE ERROR}
ELSE EXIT;
ENDLOOP;
framex ← MakeFrameExpr[frame]}
ELSE
{mInv ← Mat.Identity[mInv];
framex ← NIL};

Build the expression:

locals ← BuildLocalDeclarations [framex, mInv];
constraints ← BuildConstraints[framex];
actions ← BuildActions[];

IF locals = NIL AND constraints = Expr.true THEN
{RETURN[actions]}
ELSE
{RETURN [LIST[Expr.if,
LIST[Expr.rightArrow, LIST[Expr.suchThat, locals, constraints], actions]]]}

END;

- - - - PRIVATE PROCEDURES

BuildCoordsExpr: PROC [coords: Coords] RETURNS [expr: Se] =

Returns a Juno expression for the given coordinates, of the form
( <leftparen> ( <comma> ^x ^y )).

BEGIN

RETURN[LIST[Expr.leftPren,
LIST[Expr.comma, NEW[REAL ← coords.x], NEW[REAL ← coords.y]]]]

END;

SingularFrame: ERROR = CODE;

BuildLocalDeclarations: PROC [framex: Se, mInv: REF Mat.Matrix] RETURNS [locals: Se] =

Retirns a Juno expression declaring all wound but unmarked points as local variables.

The hint for each 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.

BEGIN

localList: LIST OF Se ← NIL;

DeclarePoint: Im.PointVisitProc =

{IF p.wn # 0 AND NOT p.fixed THEN
{coords: Coords = Mat.MapCoords[p.coords, mInv];
coordex: Se = BuildCoordsExpr[coords];
relex: Se = IF framex = NIL THEN coordex ELSE LIST [Expr.rel, coordex, framex];
decl: Se = LIST[Expr.approx, p.name, relex];
localList ← Cons [decl, localList]}};

Im.EnumPoints[DeclarePoint];

locals ← ReverseAndNest[localList, Expr.comma, NIL];

GcList[localList]

END;

ReverseAndNest: PROC [args: LIST OF Se, op: Se, zero: Se] RETURNS [expr: Se] =

BEGIN

IF args = NIL THEN RETURN [zero];
expr ← args.first;
FOR p: LIST OF Se ← args.rest, p.rest WHILE p # NIL DO
expr ← LIST[op, p.first, expr]
ENDLOOP;
RETURN [expr]

END;

ItemKindToAtom: ARRAY ItemKind OF ATOM = -- operators corresponding to each kind

[

Constraints:

hor: Expr.hor,
ver: Expr.ver,
para: Expr.para,
perp: Expr.perp,
cong: Expr.cong,
at: Expr.at,
ccw: Expr.ccw,

Proper actions:

draw: Expr.draw,
print: Expr.print,
call: NIL,

State-pushing actions:

font: Expr.font,
size: Expr.size,
face: Expr.face,
justified: Expr.justified,
paint: Expr.paint,
width: Expr.width

];

BuildConstraints: PROC [defaultFramex: Se] RETURNS [constraints: Se] =

Returns a Juno expression describing the conjunction of all constraints affecting only wound points.

BEGIN

terms: LIST OF Se ← NIL; -- a list of the constraint expressions

BuildConstr: PROC [item: Item] RETURNS [cex: Se] =

BEGIN

r1, r2: Se ← NIL;
op: ATOM = ItemKindToAtom[item.kind];
args: ItemArgs = item.args;
framex: Se = IF item.frame # nullFrame
THEN MakeFrameExpr[item.frame] ELSE defaultFramex;

SELECT item.kind FROM

hor =>

{r1 ← Pren2[args.first, args.rest.first]};

ver =>

{r1 ← Pren2[args.first, args.rest.first]};

para =>

{r1 ← Pren2[args.first, args.rest.first];
r2 ← Pren2[args.rest.rest.first, args.rest.rest.rest.first]};

perp =>

{r1 ← Pren2[args.first, args.rest.first];
r2 ← Pren2[args.rest.rest.first, args.rest.rest.rest.first]};

cong =>

{r1 ← Pren2[args.first, args.rest.first];
r2 ← Pren2[args.rest.rest.first, args.rest.rest.rest.first]};

at =>

{p: Point = NARROW[args.first];
x: REF REAL = NARROW[args.rest.first];
y: REF REAL = NARROW[args.rest.rest.first];
r1 ← p.name;
r2 ← BuildCoordsExpr[[x^, y^]]};

ccw =>

{r1 ← Pren3[args.first, args.rest.first, args.rest.rest.first]};

ENDCASE => ERROR;

cex ← IF r2 = NIL THEN LIST[op, r1] ELSE LIST[op, r1, r2];
IF framex # NIL THEN {cex ← LIST[Expr.rel, cex, framex]}

END;

{Proc: Im.ItemVisitProc =
{IF item.kind IN ConstrKind AND Im.ItemIsWound[item] THEN
{terms ← Cons[BuildConstr[item], terms]}};
Im.EnumItems[Proc]};

constraints ← ReverseAndNest [terms, Expr.and, Expr.true];

GcList[terms]

END;

BuildActions: PROC RETURNS [actions: Se] =

BEGIN

steps: LIST OF REF ANY ← NIL; -- list of all actions to be included (in reverse order)

ListEm: Im.ItemVisitProc =

{IF item.kind IN StatePushingActionKind OR
(item.kind IN ProperActionKind AND Im.ItemIsWound[item])
THEN steps ← Cons[item, steps]};

Im.EnumItems[ListEm];

actions ← Expr.skip;

FOR ap: LIST OF REF ANY ← steps, ap.rest WHILE ap # NIL DO

item: Item = NARROW[ap.first];
args: LIST OF REF ANY = item.args;
op: ATOM ← ItemKindToAtom[item.kind];
aex: Se; -- expression for this action

SELECT item.kind FROM

draw, print =>

{aex ← LIST [op, PrenArgs[args]]};

call =>

{vargs: Alg.ValueList = NARROW [args.rest];
op ← NARROW[args.first]; -- procedure name
 aex ← IF vargs=NIL
THEN op
ELSE LIST[Expr.leftPren, op, UnEvalList[vargs]]};

font =>

{font: ROPE = NARROW[args.first]; aex ← font};

face =>

{face: ATOM = NARROW[args.first]; aex ← face};

size =>

{size: REF REAL = NARROW[args.first]; aex ← size};

justified =>

{justification: ATOM = NARROW[args.first]; aex ← justification};

paint =>

{color: ATOM = NARROW[args.first]; aex ← color};

width =>

{width: REF REAL = NARROW[args.first]; aex ← width};

ENDCASE =>

{ERROR};

IF item.kind IN ProperActionKind THEN

{actions ← IF actions=Expr.skip THEN aex ELSE LIST[Expr.semicolon, aex, actions]}

ELSE IF item.kind IN StatePushingActionKind THEN

{actions ← LIST [op, aex, actions]}

ELSE ERROR

ENDLOOP;

GcList[steps]

END;

Nest: PUBLIC PROC [list: LIST OF Se, op, zero: ATOM] RETURNS [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]]]};

UnEval: PROC [arg: Value] RETURNS [expr: Se] =

{WITH arg SELECT FROM
aa: REF INT => RETURN [aa];
aa: REF REAL => RETURN [aa];
aa: ROPE => RETURN [aa];
aa: Point => RETURN [aa.name];
aa: LIST OF Value => RETURN [UnEvalList[aa]];
ENDCASE => ERROR};

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

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

Pren2: PROC [v1, v2: Value] RETURNS [expr: Se] =

{RETURN [LIST[Expr.leftPren, LIST[Expr.comma, UnEval[v1], UnEval[v2]]]]};

Pren3: PROC [v1, v2, v3: Value] RETURNS [expr: Se] =

{RETURN [LIST[Expr.leftPren,
LIST[Expr.comma, UnEval[v1], LIST[Expr.comma, UnEval[v2], UnEval[v3]]]]]};

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

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

MakeFrameExpr: PROC [frame: Frame] RETURNS [expr: Se] =

{RETURN
[IF frame.org =NIL THEN NIL
ELSE IF frame.hor = NIL THEN frame.org.name
ELSE IF frame.ver = NIL THEN Pren2[frame.org, frame.hor]
ELSE Pren3[frame.org, frame.hor, frame.ver]]};

END.