<< JunoBodyImpl.mesa>> << >> <> <> <> << 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 ( ( ^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.