<< JunoTop.mesa >> << Coded May 1981 by Greg Nelson >> << Converted to use the Viewers window package by Donna Auguste>> << Last Edited by: Gnelson, January 17, 1984 11:32 am>> << Last Edited by: Maureen Stone January 19, 1984 12:08 pm>> << Merged with JunoGerm.mesa by Jorge Stolfi May 19, 1984 4:12:07 am PDT>> << Last Edited by: Jorge Stolfi June 15, 1984 8:17:25 am PDT>> << This is the top level of an experimental interactive graphics program that allows a user to specify the positions of points by declaring geometrical contraints that the positions are to satisfy. The program solves constraints (which can be viewed as simultaneous polynomial equations) by an n-dimensional version of Newton's method for finding the root of a differentiable function.>> << JunoTop is the exclusive owner of the internal data structure representing the current image (that is, the points, constraints and actions moused in by the user). It handles those through the JunoImage interface.>> << JunoTop is also the only module that removes stuff from the user event queue. Things are placed there by (a) the cursor menu module, (b) the image viewer NotifyProc (see JunoUserEventsImpl), and (c) by the JunoButtons module.>> << TO FIX:>> << Error recovery: Check it out >> << JunoAlgebra.Eval: graphics state-pushing ops (paint, width, etc) should restore graphics state on UNWIND >> DIRECTORY JunoImage, JunoMatrix USING [Matrix, MapCoords, ComputeTransform], JunoBody USING [Se, MakeBody], JunoOldSolver USING [Outcome], JunoStorage USING [Point, Coords, Item, IntCoords, NewPoint, ActionKind, ItemArgs, ConstrKind, Cons, Frame, NewItem], JunoExpressions USING [comma, lambda], JunoAlgebra USING [Value, Call, EvalColor], JunoGraphics USING [Highight, DrawPoint, PointSymbol, DrawRope, SetPaperContext, SetScreenContext, DrawEdge, SetFontName, SetFontFace, SetFontSize, DrawArc, SetJustification, SetColor, black, invert, currentJustification, currentFontSize, SetCaret, caretOn, GetRopeDispl, Whiten, SetWidth, Color], JunoUserEvents USING [bugout, Event, Next, EventCoords, Blink, StartUp, Terminate], IO USING [PutF, real], -- DEBUG JunoGlobalAlist USING [AddDef, StartUp, Terminate, ParseAll], Rope USING [ROPE, FromChar, Cat, IsEmpty, Substr, Length], Convert USING [RopeFromInt, RopeFromReal], Process USING[Detach], Atom USING[GetPName, MakeAtom]; JunoTop: PROGRAM IMPORTS JunoImage, JunoStorage, JunoBody, JunoMatrix, JunoGraphics, JunoExpressions, JunoAlgebra, JunoUserEvents, JunoGlobalAlist, IO, -- DEBUG Rope, Convert, Process, Atom = BEGIN OPEN JunoStorage, Im: JunoImage, Solv: JunoOldSolver, Body: JunoBody, Evs: JunoUserEvents, Gr: JunoGraphics, Expr: JunoExpressions, Alg: JunoAlgebra, Mat: JunoMatrix, Glob: JunoGlobalAlist, Rope; debug1, debug2: BOOL _ FALSE; -- can be set by BugBane to avoid debug output << - - - - ARGUMENT QUEUES >> argMax: INTEGER = 50; -- max num. of arguments in each queue Queue: TYPE = REF QueueRec; QueueRec: TYPE = RECORD [top: [0 .. argMax] _ 0, a: ARRAY [1 .. argMax] OF RECORD [p: Point, sy: Gr.PointSymbol]]; << The symbol used for a point depends on how many points with same rouded coordinates are already there.>> que: Queue = NEW[QueueRec]; << There used to be a secondary queue, but its duties have been taken over by the primary one.>> L1Dist: PROC [p, q: Coords] RETURNS [REAL] = INLINE {RETURN[ABS[p.x-q.x]+ABS[p.y-q.y]]}; HilyteElem: PROC [ix: INTEGER] = <> <> {OPEN que; a[ix].sy _ plus; FOR k: INTEGER DECREASING IN [1..ix) DO IF L1Dist[a[k].p.coords, a[ix].p.coords] < 1 THEN {a[ix].sy _ IF a[k].sy >= box THEN box ELSE SUCC[a[k].sy]; EXIT} ENDLOOP; Gr.Highight[a[ix].p.coords, a[ix].sy]}; Push: PROC [p: Point] = <> <> {OPEN que; IF p=NIL THEN ERROR; top _ top + 1; a[top].p _ p; HilyteElem[top]}; Pop: PROC [] = <> {OPEN que; IF top = 0 THEN ERROR; Gr.Highight[a[1].p.coords, a[1].sy]; FOR i: INTEGER IN [1 .. top) DO Gr.Highight[a[i+1].p.coords, a[i+1].sy]; a[i] _ a[i + 1]; HilyteElem[i] ENDLOOP; top _ top - 1}; RefreshQueue: PROC [] = <> <> {OPEN que; FOR i: INTEGER IN [1..top] DO Gr.Highight[a[i].p.coords, a[i].sy] ENDLOOP}; FlushArgumentQueue: PROC = <> {OPEN que; FOR i: INTEGER IN [1 .. top] DO Gr.Highight[a[i].p.coords, a[i].sy] ENDLOOP; top _ 0}; << - - - - MAIN LOOP>> << The procedures in this section parse the stream of user events (as conditioned by the JunoUserEvents module) and perform the appropriate actions on the current image. >> ev: Evs.Event; -- the user event last returned by Evs.Next Unexpected: SIGNAL = CODE; -- parse/lexer found an event that could't possibly be there EvCoords: PROCEDURE RETURNS [Coords] = INLINE {RETURN[[ev.coords.x, ev.coords.y]]}; << Returns the coordinates of the curent event ev, assuming it is a mouse one (Roll, MouseUp, MouseDown). >> MainLoop: PROC = << Parses and executes each user command. >> BEGIN prevCmd: ATOM _ $Missing; ParseNextCommand: PROC = << Should be called with ev.type = Cursor or Button. Will return with ev.type = End.>> << ABORTED signals are caught here, if they have not been caught by the individual commands. >> BEGIN ENABLE {ABORTED => {GOTO CommandAborted}}; cmd: ATOM = NARROW [ev.value]; << Reset image to a reasonably clean state:>> ClearPoints: Im.PointVisitProc = {p.wn _ 0; p.fixed _ p.frozen; p.mark _ FALSE}; Im.EnumPoints[ClearPoints]; IF prevCmd # cmd THEN {FlushArgumentQueue[]; prevCmd _ cmd}; SELECT cmd FROM $Pencil => {ParseCursorCmdBody [maxPrim: 4, nLeave: 1, Proc: DrawThem]}; $Compass => {ParseCursorCmdBody [maxPrim: 4, nLeave: 2, Proc: CongThem, solve: TRUE]}; $HorTee => {ParseCursorCmdBody [maxPrim: 2, nLeave: 1, Proc: HorThem, solve: TRUE]}; $VerTee => {ParseCursorCmdBody [maxPrim: 2, nLeave: 1, Proc: VerThem, solve: TRUE]}; $Parallels => {ParseCursorCmdBody [maxPrim: 4, nLeave: 2, Proc: ParaThem, solve: TRUE]}; $RightAngle => {ParseCursorCmdBody [maxPrim: 4, nLeave: 2, Proc: PerpThem, solve: TRUE]}; $CallProc => {ParseCursorCmdBody [maxPrim: argMax, Proc: CallProcOnThem, solve: FALSE, refresh: FALSE]}; $MoveArrow => {ParseCursorCmdBody [maxPrim: argMax, baloonSel: TRUE, Proc: MoveThem, solve: TRUE]}; $CopyArrow => {ParseCursorCmdBody [maxPrim: argMax, baloonSel: TRUE, Proc: CopyThem, solve: TRUE]}; $MakeProc => {ParseCursorCmdBody [maxPrim: argMax, baloonSel: TRUE, Proc: MakeProcOfThem, solve: FALSE, refresh: FALSE]}; $Eraser => {ParseCursorCmdBody [maxPrim: argMax, create: FALSE, baloonSel: TRUE, Proc: DeleteThem, solve: TRUE]}; $Snowman => {ParseFreezeCmd []}; $Typewriter => {ParseTypeCmd []}; $Hardcopy => {ParseButtonCmdBody [Proc: DoHardcopy, solve: FALSE, refresh: FALSE]}; $Redraw => {ParseButtonCmdBody [Proc: DoRedraw, solve: FALSE, refresh: TRUE]}; $Solve => {ParseButtonCmdBody [Proc: DoSolve, solve: TRUE]}; $StartOver => {ParseButtonCmdBody [Proc: DoStartOver, solve: FALSE, refresh: TRUE]}; $LoadX => {ParseButtonCmdBody [Proc: DoLoadX, solve: FALSE, refresh: FALSE]}; $Parse => {ParseButtonCmdBody [Proc: DoParse, solve: FALSE, refresh: TRUE]}; $SetFont, $SetFontSize, $SetFontFace, $SetJustification, $SetWidth, $SetColor => {ParseButtonCmdBody [Proc: DoSetOption, solve: FALSE, refresh: FALSE]}; ENDCASE => {ERROR Unexpected}; IF ev.type # End THEN {ERROR Unexpected} -- command didn't get to End EXITS CommandAborted => {Evs.Blink["Command aborted!"]; WHILE ev.type # End DO ev _ Evs.Next[] ENDLOOP; IF Gr.caretOn THEN Gr.SetCaret[on: FALSE]; Refresh[screen: TRUE]} END; << Body of main loop: >> Evs.StartUp[debug: TRUE]; Glob.StartUp[]; DO ev _ Evs.Next[]; IF ev.type = Quit THEN EXIT; ParseNextCommand[! ABORTED => CONTINUE] -- in case ABORTED escapes after all ENDLOOP; Evs.Terminate[]; Glob.Terminate[] END; << - - - - TYPICAL CURSOR COMMANDS>> CursorCommandProc: TYPE = PROC [terminator: ATOM]; << A CursorCommandProc is called by ParseCursorCmdBody to do the actual processing.>> << The arguments to the CursorCommandProc (i.e., the moused points in that segment) will be in the primary argument queue and/or will have wn#0, depending on how they were selected. >> << The CursorCommandProc is called only with terminator = $Escape, $Return, or $Tab. >> ParseCursorCmdBody: PROC [maxPrim, nLeave: INT _ 0, create: BOOL _ TRUE, baloonSel: BOOL _ FALSE, Proc: CursorCommandProc, solve, refresh: BOOL _ FALSE] = << Parses the body of simple commands acording to the syntax End where the are as accepted by ParseMousedPoints.>> << On entry, ev should be Cursor or Button. On exit, it will be End.>> << The nLeave parameter is the number of points to be left on the primary argument queue (eg., nLeave=1 for draw, =2 for cong).>> << If solve = TRUE and the End-ing event is $Escape or $Return, Proc is called, the constraints are solved again, and the image is repainted. Note that the p.fixed and p.frozen bits may be set by Proc to prevent the solver from moving a point p. The p.fixed bit will be reset before the next user command is executed. >> << If solve=FALSE or the End-ing event is $Tab, Proc is called, but the constraints are NOT solved. The image will be repainted (with the current positions of the points) if refresh=TRUE.>> << Finally, if the End-ing event is $Delete or $None, Proc is not called; the argument queues are cleared, and no solving or repainting takes place. >> BEGIN terminator: ATOM; ParseMousedPoints [maxPrim, create, baloonSel]; IF ev.type # End THEN {ERROR Unexpected}; terminator _ NARROW [ev.value]; SELECT terminator FROM $None, $Delete => {FlushArgumentQueue[]}; $Escape, $Tab, $Return => {Proc[terminator]; WHILE que.top > 0 AND que.top # nLeave DO Pop[] ENDLOOP; IF solve AND (terminator = $Escape OR terminator = $Return) THEN {Solve[]; Refresh[screen: TRUE]} ELSE IF refresh THEN {Refresh[screen: TRUE]}}; ENDCASE => {ERROR Unexpected}; END; ParseMousedPoints: PROC [maxPrim: INT _ 0, create: BOOL _ TRUE, baloonSel: BOOL _ FALSE] = << Parses a sequence of mouse clicks that specifies the arguments to a typical command.>> << The parsed sequence consists of zero to maxPrim "primary" points (either new ones created with red clicks, or old ones selected with yellow clicks), plus, if baloonSel=TRUE, any number of "baloon-selected" or "wound" points (old ones selected by circling them with the mouse while the blue button is held down). Multiple blue baloons are cumulative. The two kinds of selections may be freely intermixed and may include the same point(s). The order and multiplicity of the primary arguemnts is important in general.>> << Red clicks (point creation) are allowed only if create=TRUE. All mouse clicks will track the mouse until the button is released.>> << The least recent entries in the primary queue are automatically removed if the length of the latter exceeds maxPrim. Setting maxPrim to zero disables primary selections. >> << Should be called with ev= event before point list (i.e., Cursor or Button). On return, ev is End. Events of type Char, Backspace, Atom, Real, and Rope are flagged and ignored.>> BEGIN DO ev _ Evs.Next[]; SELECT ev.type FROM MouseDown => {SELECT ev.value FROM $Red => {IF create THEN IF maxPrim <= 0 THEN {Evs.Blink ["Primary selections not allowed"]} ELSE {coords: Coords = ParseMousedCoords[]; Push[AddNewPoint [coords, TRUE]]; Evs.bugout.PutF["ParseMousedPoints: new point at [%g, %g]", IO.real[coords.x], IO.real[coords.y]]; -- DEBUG WHILE que.top > maxPrim DO Pop [] ENDLOOP} ELSE {Evs.Blink ["Point creation not allowed"]}}; $Yellow => {IF maxPrim <= 0 THEN {Evs.Blink ["Primary selections not allowed"]} ELSE {p: Point = ParseMouseSelectedPoint[wound: FALSE]; IF p # NIL THEN {Push[p]; Evs.bugout.PutF["ParseMousedPoints: old point at [%g, %g]", IO.real[p.coords.x], IO.real[p.coords.y]]; -- DEBUG WHILE que.top > maxPrim DO Pop[] ENDLOOP}}}; $Blue => {IF baloonSel THEN {TrackBlueBaloon[]; IF NOT Im.AnyWoundPoints[] THEN {Evs.Blink ["Warning - no points selected"]}} ELSE {Evs.Blink ["Baloon selections not allowed"]}}; ENDCASE => {SIGNAL Unexpected}; EatMouseTail}; Char, Atom, Rope, Real, BackSpace => {Evs.Blink ["Invalid input"]}; End => {RETURN}; ENDCASE => {SIGNAL Unexpected}; ENDLOOP; END; << - - - - TYPICAL BUTTON COMMANDS>> ButtonCommandProc: TYPE = PROC [button: ATOM]; << A ButtonCommandProc is called by ParseButtonCmdBody to process the body of a typical Button command.>> << The ButtonCommandProc is called with ev = first button argument (or End if none). It should return with ev=End.>> ParseButtonCmdBody: PROC [Proc: ButtonCommandProc, solve, refresh: BOOL _ FALSE] = << Parses the body of button commands, that obeys the syntax End where the arguments are as accepted by the given ButtonCommandProc.>> << On entry, ev should be Cursor or Button. On exit, ev will be the event following the End (next Cursor or Button).>> << If solve = TRUE, Proc is called, the constraints are solved again, and the image is repainted. Note that the p.fixed and p.frozen bits may be set by the ButtonCommandProc to prevent the solver from moving a point p. The p.fixed bit will be reset before the next user command is executed. >> << If solve=FALSE, Proc is called, but the constraints are NOT solved. The image will be repainted (with the current positions of the points) if refresh=TRUE.>> BEGIN button: ATOM = NARROW[ev.value]; ev _ Evs.Next[]; Proc[button]; IF ev.type # End THEN {ERROR Unexpected}; IF solve THEN {Solve[]}; IF solve OR refresh THEN {Refresh[screen: TRUE]} END; << - - - - MOUSE CLICK PARSING>> EatMouseTail: PROC = << Skips any leftovers from a mouse click, if any. Should be called with ev.type=MouseDown, Roll, or MouseUp; returns with ev.type = MouseUp.>> {WHILE ev.type = Roll OR ev.type = MouseDown DO ev _ Evs.Next[] ENDLOOP; IF ev.type # MouseUp THEN ERROR Unexpected}; ParseMousedCoords: PROC RETURNS [coords: Coords] = << Parses a , returning its coordinates.>> << Does not allocate a new Point, and does not affect the argument queue. Will track the mouse continuously, highlighting its current position, until the button is released. On exit, the point is not highlighted. >> << Should be called with ev=MouseDown. Returns with ev=MouseUp.>> {DO coords _ EvCoords[]; IF ev.type # Roll AND ev.type # MouseDown THEN EXIT; Gr.Highight[coords, plus]; ev _ Evs.Next[]; Gr.Highight[coords, plus]; ENDLOOP; IF ev.type # MouseUp THEN ERROR Unexpected}; ParseMouseSelectedPoint: PROC [wound: BOOL _ FALSE] RETURNS [point: Point _ NIL] = << Parses a , returning the point nearest to the clicked coordinates (or NIL if couldn't find such point).>> << Does not allocate a new Point, and does not affect the argument queue. Will let the selected point track the mouse, highlighting it, until the button is released. The point is not highlighted on exit. >> << If wound = TRUE, considers only points that have wn#0.>> << Should be called with ev=MouseDown. Returns with ev=MouseUp.>> {DO point _ Im.FindPoint[coords: EvCoords[], wound: wound]; IF point = NIL THEN {Evs.Blink ["No point found"]; EatMouseTail[]; RETURN}; IF ev.type # Roll AND ev.type # MouseDown THEN EXIT; Gr.Highight[point.coords, plus]; ev _ Evs.Next[]; Gr.Highight[point.coords, plus] ENDLOOP; IF ev.type # MouseUp THEN ERROR Unexpected}; TrackBlueBaloon: PROCEDURE = << The effect of TrackBlueBaloon is to track the cursor until the Blue button is released, setting the wn (winding number) field for all image points contained in the loop made by the cursor.>> << Should be called with ev.type = $BlueDown. Returns with ev = $BlueUp.>> BEGIN prev: IntCoords; NextBluePoint: Im.NextPointProc = BEGIN -- Waits for the mouse to move far enough, or blue button to go up, -- and returns its coordinates. DO ev _ Evs.Next[]; IF ev.type # Roll AND ev.type # MouseUp THEN {SIGNAL Unexpected; LOOP}; lastPoint _ ev.type = MouseUp; IF lastPoint OR ABS[ev.coords.x - prev.x] > 5 OR ABS[ev.coords.y - prev.y] > 5 THEN {coords _ ev.coords; Gr.DrawPoint[EvCoords[]]; RETURN} ENDLOOP END; prev _ ev.coords; Gr.DrawPoint[EvCoords[]]; Im.BaloonSelect[prev, NextBluePoint] END; << - - - - IMAGE CONSTRUCTION >> pointCount: INTEGER _ 0; -- counts Points created since last StartOver, for debugging AddNewPoint: PUBLIC PROC [coords: Coords, visible: BOOL _ TRUE] RETURNS [p: Point] = BEGIN p _ NewPoint[coords, visible]; pointCount _ pointCount+1; p.name _ NthName[n: pointCount, prefix: "P"]; IF visible THEN Gr.DrawPoint[p.coords]; Im.AddPoint[p] END; AddNewAction: PROC [kind: ActionKind, args: ItemArgs, doIt: BOOL _ FALSE] = BEGIN IF doIt THEN ExecuteAction[kind: kind, args: args ! ABORTED => {GOTO SkipIt}]; Im.AddItem [NewItem [kind: kind, args: args]]; EXITS SkipIt => {} END; AddNewConstr: PROC [kind: ConstrKind, args: ItemArgs, doIt: BOOL _ FALSE] = BEGIN Im.AddItem [NewItem [kind: kind, args: args]]; END; << - - - - CONSTRAINTS>> CongThem: CursorCommandProc = BEGIN IF que.top # 4 THEN {WHILE que.top > 0 DO Pop[] ENDLOOP; RETURN} ELSE {AddNewConstr[kind: cong, args: LIST[que.a[1].p, que.a[2].p, que.a[3].p, que.a[4].p]]} END; ParaThem: CursorCommandProc = BEGIN IF que.top # 4 THEN {WHILE que.top > 0 DO Pop[] ENDLOOP; RETURN} ELSE {AddNewConstr[kind: para, args: LIST[que.a[1].p, que.a[2].p, que.a[3].p, que.a[4].p]]} END; PerpThem: CursorCommandProc = BEGIN IF que.top # 4 THEN {WHILE que.top > 0 DO Pop[] ENDLOOP; RETURN} ELSE {AddNewConstr[kind: perp, args: LIST[que.a[1].p, que.a[2].p, que.a[3].p, que.a[4].p]]} END; HorThem: CursorCommandProc = BEGIN IF que.top # 2 THEN {WHILE que.top > 0 DO Pop[] ENDLOOP; RETURN} ELSE {AddNewConstr[kind: perp, args: LIST[que.a[1].p, que.a[2].p]]} END; VerThem: CursorCommandProc = BEGIN IF que.top # 2 THEN {WHILE que.top > 0 DO Pop[] ENDLOOP; RETURN} ELSE {AddNewConstr[kind: perp, args: LIST[que.a[1].p, que.a[2].p]]} END; << - - - - DRAW COMMAND>> DrawThem: CursorCommandProc = BEGIN IF que.top = 3 OR que.top = 1 THEN Pop[]; IF que.top = 0 THEN {RETURN} ELSE {AddNewAction [kind: draw, args: IF que.top = 2 THEN LIST[que.a[1].p, que.a[2].p] ELSE LIST[que.a[1].p, que.a[2].p, que.a[3].p, que.a[4].p], doIt: TRUE]} END; << - - - - ERASE COMMAND>> DeleteThem: CursorCommandProc = BEGIN FOR i: INTEGER IN [1..que.top] DO que.a[i].p.wn _ 1 ENDLOOP; FlushArgumentQueue[]; Im.DeleteWoundItems[] END; << - - - - CALL PROCEDURE COMMAND>> currentX: ATOM _ $X; DoLoadX: ButtonCommandProc = {currentX _ NARROW[ev.value]; ev _ Evs.Next[]}; DoParse: ButtonCommandProc = {Glob.ParseAll[]}; CallProcOnThem: CursorCommandProc = BEGIN args: ItemArgs _ NIL; FOR i: INTEGER DECREASING IN [1 .. que.top] DO args _ Cons[que.a[i].p, args] ENDLOOP; -- Glob.ParseAll[]; {FixIt: Im.PointVisitProc={p.fixed _ TRUE}; Im.EnumPoints[FixIt]}; AddNewAction [kind: call, args: Cons[currentX, args], doIt: TRUE] END; << - - - - MAKE PROCEDURE COMMAND>> NthName: PROC [n: INTEGER, prefix: ROPE _ NIL] RETURNS [name: ATOM] = <> BEGIN letter: ROPE = Rope.FromChar['a + n MOD 26]; number: ROPE = IF n > 25 THEN Convert.RopeFromInt[n/26, 10, FALSE] ELSE NIL; RETURN[Atom.MakeAtom[Rope.Cat [prefix, letter, number]]] END; procCount: INTEGER _ 0; -- number of procedures created so far MakeProcOfThem: CursorCommandProc = BEGIN np: INTEGER _ 0; -- number of points named so far NamePoint: Im.PointVisitProc = {p.name _ NthName[np]; np _ np+1; Gr.DrawRope[[p.coords.x + 5, p.coords.y + 5], Atom.GetPName[p.name]]}; formals, body, proc: Body.Se; frame: Frame; << Erase all point names, and reset their fixed flag:>> {UnNam: Im.PointVisitProc={p.name_NIL; p.fixed_FALSE}; Im.EnumPoints [UnNam]}; << Name the formal parameters, make a nest of them, and mark them as fixed:>> IF que.top = 0 THEN {formals _ NIL} ELSE {NestEm: PROC [i: INTEGER] RETURNS [f: Body.Se] = {p: Point = que.a[i].p; IF p.name # NIL THEN {Evs.Blink["Repeated formal parameter"]; ERROR}; NamePoint[p]; p.fixed _ TRUE; formals _ IF i=que.top THEN p.name ELSE LIST[Expr.comma, p.name, NestEm[i+1]]}; formals _ NestEm[1]}; << Get reference frame for local hints:>> frame _ [org: IF que.top > 0 THEN que.a[1].p ELSE NIL, hor: IF que.top > 1 THEN que.a[2].p ELSE NIL, ver: IF que.top > 2 THEN que.a[3].p ELSE NIL]; << Name the other points :>> {NameWnd: Im.PointVisitProc = {IF p.wn#0 AND p.name = NIL THEN NamePoint[p]}; Im.EnumPoints [NameWnd]}; << Build the body of the lambda:>> body _ Body.MakeBody[frame]; << Build the lambda and add it to the list:>> proc _ LIST [Expr.lambda, formals, body]; procCount _ procCount+1; currentX _ Atom.MakeAtom[Rope.Cat ["X", Convert.RopeFromInt[procCount, 10, FALSE]]]; Glob.AddDef [name: currentX, value: proc] END; << - - - - FREEZE COMMAND>> ParseFreezeCmd: PROC = BEGIN HilyteIfFrozen: Im.PointVisitProc = {IF p.frozen THEN Gr.Highight[p.coords, diamond]}; Im.EnumPoints[HilyteIfFrozen]; -- Highlight currently frozen points DO ev _ Evs.Next[]; SELECT ev.type FROM MouseDown => {p: Point; SELECT ev.value FROM $Red => {coords: Coords = ParseMousedCoords[]; p _ AddNewPoint [coords, TRUE]}; $Yellow => {p _ ParseMouseSelectedPoint[wound: FALSE]}; $Blue => {Evs.Blink ["Red or yellow button, please"]}; ENDCASE => ERROR Unexpected; IF p # NIL THEN {p.frozen _ NOT(p.frozen); p.fixed _ p.frozen; Gr.Highight[p.coords, diamond]}; EatMouseTail}; Char, BackSpace, Atom, Rope, Real => {Evs.Blink ["Invalid input"]}; End => {IF ev.value = $Escape THEN {Solve[]; Refresh[screen: TRUE]} ELSE IF ev.value # $Tab AND ev.value # $None THEN {Evs.Blink ["Invalid input"]}; EXIT}; ENDCASE => {ERROR Unexpected}; ENDLOOP; Im.EnumPoints[HilyteIfFrozen] -- Erase all highlights END; << - - - - MOVE AND COPY COMMANDS>> MoveThem: CursorCommandProc = BEGIN MoveOrCopyThem[copy: FALSE] END; CopyThem: CursorCommandProc = BEGIN MoveOrCopyThem[copy: TRUE] END; mat: REF Mat.Matrix _ NEW [Mat.Matrix]; -- transform matrix for move/copy commands MoveOrCopyThem: PROC [copy: BOOLEAN] = << A procedure used in both the Move and Copy commands.>> << The primary arguments should come in one or more pairs (from, to). If there are no baloon-selected points, then all "from" points are moved to the corresponding "to" points. If there are blue-selected points, then only these are moved, according to an affine transformation specified by the primary arguments. The latter must come in one to three pairs; the transformation is the one mapping the "from" points into the "to" ones.>> << If copy=TRUE, the points to be moved are first duplicated, and the motion appied to the copies. All constraints and actions that involve only copied points are copied as well. >> << In either case, when a "from" point moves and the corresponding "to" doesn't, the two are replaced by a single point in all actions and constraints where they occurs. >> << The motion occurs irrespective of the frozen/unfrozen status of the selected points. After the motion, the points that were moved will be temporarily fixed in their new positions, till the next command. >> << This procedure assumes all copy links are NIL on entry, all points in the source frame have wn#0, and all points in the destination frame have wn=0.>> BEGIN n: INTEGER = que.top/2; singular: BOOL _ FALSE; baloon: BOOL = Im.AnyWoundPoints[]; MoveIt: PROC [p: Point, c: Coords] = INLINE {p.coords _ c; p.wn _ 0; p.fixed _ TRUE}; IF que.top MOD 2 # 0 OR que.top=0 THEN {Evs.Blink["Please select one or more pairs (from, to)"]; RETURN}; << If there are blue-selected points, then the points on the argument queue must be a pair of interleaved frames specifying a non-singular affine transformation. If not, the "from" points in the queue are automatically blue-selected for copying.>> IF baloon THEN {OPEN que; from, to: Frame _ [NIL, NIL, NIL]; IF top > 6 THEN {Evs.Blink["Reference frames may have at most three pairs of points"]; RETURN}; from.org _ a[1].p; to.org _ a[2].p; IF n>1 THEN {from.hor _ a[3].p; to.hor _ a[4].p}; IF n>2 THEN {from.ver _ a[5].p; to.ver _ a[6].p; [mat, singular] _ Mat.ComputeTransform[from, to, mat]; IF singular THEN {Evs.Blink["Singular transformation"]; RETURN}}} ELSE {FOR i: INTEGER _1, i+2 WHILE i> IF copy THEN BEGIN Im.DuplicateWoundItems[]; << Im.DuplicateWoundItems will a) copy the points with wn#0 (& attached constraints &actions); b) add the copies to the current image, c) set the copy link of the originals to the copies, d) set the copy links of the copies to NIL, e) set the wn's of the copies to the wn's of the originals, f) set the wn's of the originals to zero (i.e. take out the originals from the baloon, and put in the copies).>> << Now replace all "from" points in the queue by their copies>> FOR i: INTEGER _ 1, i+2 WHILE i> {Reset: Im.PointVisitProc = {p.copy _ NIL}; Im.EnumPoints[Reset]}; END; << Forcefully move every "from" point with wn#0 to the corresponding "to" point, and identify the two (unless the "to" point moves, too).>> FOR i: INTEGER _ 1, i+2 WHILE i < que.top DO from: Point = que.a[i].p; to: Point = que.a[i+1].p; IF from.wn#0 THEN {MoveIt[from, to.coords]; IF to.wn = 0 THEN {from.copy _ to}} ENDLOOP; Im.IdentifyPoints[]; << Move the remaining wound points according to the affine transformation.>> IF baloon THEN {Map: Im.PointVisitProc = {IF p.wn#0 THEN MoveIt[p, Mat.MapCoords[p.coords, mat]]}; Im.EnumPoints [Map]; Im.SortPoints[]}; END; << - - - - TYPEIN COMMAND>> oldRope: ROPE _ NIL; -- last type-in, for defaulting refPos: Coords; -- reference coordinates for string currently being parsed refPoint: Point _ NIL; -- if refPos was yellow-selected, this is the selected point, else it is NIL refPosDefined: BOOL _ FALSE; -- if FALSE, refPos is not defined - user must give it ParseTypeCmd: PROC = BEGIN rope: ROPE _ NIL; -- typein collected so far ParseRefPos: PROC = <> <> <> BEGIN SELECT ev.value FROM $Red => {refPos _ ParseMousedCoords[]; Gr.SetCaret [coords: refPos]; refPosDefined _ TRUE}; $Yellow => {p: Point = ParseMouseSelectedPoint[]; IF p # NIL THEN {refPos _ p.coords; refPoint _ p; Gr.SetCaret [coords: refPos]; refPosDefined _ TRUE}}; $Blue => {Evs.Blink ["Red or yellow button, please"]}; ENDCASE => {ERROR Unexpected}; END; ChangeRope: PROC [new: ROPE] = <> BEGIN IF NOT rope.IsEmpty[] THEN {Gr.DrawRope[refPos, rope]}; -- erase old rope rope _ new; Gr.DrawRope[refPos, rope]; -- paint new one IF Gr.currentJustification # $right THEN {-- must move caret vec: Coords _ Gr.GetRopeDispl [rope]; IF Gr.currentJustification = $center THEN {vec _ [0.5*vec.x, 0.5*vec.y]}; Gr.SetCaret [coords: [refPos.x+vec.x, refPos.y+vec.y]]}; END; AddTheRope: PROC = <> BEGIN oldRope _ rope; -- save oldRope in case user just hits ESC next time -- create new point, if needed IF refPoint = NIL THEN {refPoint _ AddNewPoint [coords: refPos, visible: FALSE]}; -- add print action AddNewAction [kind: print, args: LIST [rope, refPoint], doIt: FALSE]; rope _ NIL; refPoint _ NIL; END; << Body of parseTypeCmd:>> BEGIN IF refPosDefined THEN Gr.SetCaret [coords: refPos]; [] _ Gr.SetColor[Gr.invert]; DO ev _ Evs.Next[]; SELECT ev.type FROM Char, Rope, Atom, BackSpace, Real => {IF NOT refPosDefined THEN {Evs.Blink ["Please select reference point"]} ELSE {new: ROPE = SELECT ev.type FROM Char => rope.Cat [FromChar[NARROW[ev.value, REF CHAR]^]], BackSpace => IF rope.IsEmpty THEN rope ELSE rope.Substr [0, rope.Length[] - 1], Rope => NARROW[ev.value, ROPE], Real => Convert.RopeFromReal[NARROW[ev.value, REF REAL]^], Atom => Atom.GetPName[NARROW[ev.value, ATOM]], ENDCASE => ERROR; ChangeRope[new]}}; MouseDown => {IF NOT rope.IsEmpty THEN AddTheRope; ParseRefPos; IF refPosDefined THEN Gr.SetCaret [on: TRUE, coords: refPos]}; End => {IF ev.value = $Delete THEN {ChangeRope[NIL]}; IF rope.IsEmpty[] AND NOT oldRope.IsEmpty[] AND ev.value=$Escape THEN {ChangeRope[oldRope]}; IF NOT rope.IsEmpty THEN AddTheRope; IF Gr.caretOn THEN Gr.SetCaret [on: FALSE]; IF ev.value = $Return THEN {refPos _ [refPos.x, refPos.y - Gr.currentFontSize]; refPosDefined _ TRUE} ELSE IF ev.value # $Delete THEN {refPosDefined _ FALSE}; RETURN}; ENDCASE => {ERROR Unexpected}; ENDLOOP END END; << - - - - CONSTRAINT SOLVING AND IMAGE REFRESH>> Solve: PROC = <> BEGIN SELECT Im.SolveImage[0.1] FROM true => {}; uncertain => {Evs.Blink["The solver didn't converge."]}; false => {Evs.Blink["The solver failed."]}; ENDCASE END; Refresh: PROCEDURE [screen: BOOL _ TRUE] = <> <> <> BEGIN FixIt: Im.PointVisitProc={p.fixed _ TRUE}; DoIt: Im.ItemVisitProc = {IF item.kind IN ActionKind THEN ExecuteAction [item.kind, item.args ! ABORTED => CONTINUE]}; ShowIt: Im.PointVisitProc = {IF p.visible THEN Gr.DrawPoint [p.coords]}; IF screen THEN {Gr.SetScreenContext[]; Gr.Whiten[]}; -- Glob.ParseAll[]; -- -- update global a-list [] _ Gr.SetColor[Gr.black]; Im.EnumPoints[FixIt]; Im.EnumItems[DoIt]; IF screen THEN {Im.EnumPoints[ShowIt]; [] _ Gr.SetColor[Gr.invert]; RefreshQueue[]} END; << - - - - ACTION SEMANTICS>> ExecuteAction: PUBLIC PROC [kind: ActionKind, args: ItemArgs] = << Before calling this procedure, the client must make sure the global ALIst is up-to-date (by calling Glob.ParseAll). >> BEGIN SELECT kind FROM draw => {IF args.rest.rest=NIL THEN {p: Coords = NARROW [args.first, Point].coords; q: Coords = NARROW [args.rest.first, Point].coords; Gr.DrawEdge[p, q, FALSE]} ELSE {p: Coords = NARROW [args.first, Point].coords; r: Coords = NARROW [args.rest.first, Point].coords; s: Coords = NARROW [args.rest.rest.first, Point].coords; q: Coords = NARROW [args.rest.rest.rest.first, Point].coords; Gr.DrawArc[p, r, s, q, FALSE]}}; print => {rope: Rope.ROPE = NARROW[args.first]; p: Point = NARROW[args.rest.first]; Gr.DrawRope [coords: p.coords, rope: rope]}; call => {Alg.Call[func: NARROW[args.first], args: NARROW [args.rest] ! ABORTED => CONTINUE]; Im.SortPoints[]}; font => {font: ROPE = NARROW[args.first]; [] _ Gr.SetFontName[font]}; face => {face: ATOM = NARROW[args.first]; [] _ Gr.SetFontFace[face]}; size => {size: REAL = NARROW[args.first, REF REAL]^; [] _ Gr.SetFontSize[size]}; paint => {color: Gr.Color = Alg.EvalColor[args.first, NIL]; [] _ Gr.SetColor[color]}; width => {width: REAL = NARROW[args.first, REF REAL]^; [] _ Gr.SetWidth[width]}; justified => {justification: ATOM = NARROW[args.first]; [] _ Gr.SetJustification[justification]}; ENDCASE => {ERROR}; END; << - - - - BUTTON PROCEDURES>> << The following procedures are called via PArseButtonCmd.>> DoHardcopy: ButtonCommandProc = << Should be called with solve=FALSE, refresh=FALSE.>> {filename: Rope.ROPE = NARROW [ev.value]; device: ATOM; ev _ Evs.Next[]; IF ev.type # Atom THEN SIGNAL Unexpected; device _ NARROW[ev.value]; ev _ Evs.Next[]; Evs.Blink["creating PD file ", filename, " for ", Atom.GetPName[device]]; Gr.SetPaperContext[device, filename]; Refresh[screen: FALSE]; Evs.Blink["PD file created."]; Gr.SetScreenContext[]}; DoRedraw: ButtonCommandProc = {}; << Should be called with solve=FALSE, refresh=TRUE.>> DoSolve: ButtonCommandProc = {}; << Should be called with solve=TRUE>> DoStartOver: ButtonCommandProc = << Should be called with solve=FALSE, refresh=TRUE.>> {Im.PurgeImage []; [] _ Gr.SetJustification[$left]; oldRope _ NIL}; DoSetOption: ButtonCommandProc = << Used by the buttons SetFontName, SetFontSize, SetFontFace, etc.>> << Should be called with solve=FALSE, refresh=FALSE.>> {kind: ActionKind = SELECT button FROM $SetFont => font, $SetFontSize => size, $SetFontFace => face, $SetJustification => justified, $SetWidth => width, $SetColor => paint, ENDCASE => ERROR; args: ItemArgs = Cons[ev.value, NIL]; ev _ Evs.Next[]; AddNewAction [kind: kind, args: args, doIt: TRUE]}; << - - - - INITIALIZATION:>> Process.Detach[FORK MainLoop[]] END.