<* PRAGMA LL *>
<* PRAGMA SPEC *>

MODULE Drawing;

IMPORT CurrCmd, View, JunoError, JunoBuild, Drag, PSImpl, JunoPt;
IMPORT   Editor, ToolBox, JunoConfig;
IMPORT JunoAST, JunoASTUtils, JunoCompileErr;
IMPORT JunoValue, JunoRT;
IMPORT TextEditVBT, KeyTrans;
IMPORT VBT, VBTClass, PaintOp, Point, Region, Rect, Path;
IMPORT   Axis, Filter, Pixmap, DblBufferVBT;
IMPORT KeyboardKey, Latin1Key;
IMPORT Atom, Text, Real, Fmt;
IMPORT RTCollector;

CONST
  DummyXY = JunoPt.T{0.0, 0.0};		 (* dummy point location *)

REVEAL
  View.Drawing = Drag.T BRANDED "View.Drawing" OBJECT
    (* General state *)
    tool: ArgTool := NIL;
    lastTool: Tool := NIL;
    usingTempTool := FALSE;
    freezeTool, dragTool: Tool := NIL; (* CONST after initialization *)
    labelStyle: [0..2] := 2;
    pointCount := 0;
    continuousUnparse := TRUE;
    hasMouseFocus: BOOLEAN;
    prevStackSize: CARDINAL := 0;
    (* "Click" args *)
    goodDownClick: BOOLEAN;
    (* "Text" arg *)
    txt: TEXT;        (* "txt # NIL" <=> user typing text argument *)
    (* Grid state *)
    toolBox: ToolBox.T;
    gridMode := FALSE;
    grid0, grid1: JunoPt.T;		 (* grid origin and unix X vector *)
    grid0nm, grid1nm: JunoAST.QId;
    gridOn, gridOff: Tool;
  OVERRIDES
    init := InitDrawing;
    update := Update;
  END;

The values for d.labelStyle are: 0 for no labels, 1 for crosses, and 2 for point-name labels.

The value d.pointCount is the number of the next potential point. The drawing view maps cardinals into point names. When a new point is created, it searches for an available point name starting with the one designated by d.pointCount. Since point names can only be deleted by editing the source view, d.pointCount need only be reset whenever the drawing view is updated.

The value d.hasMouseFocus is true if d was delivered a transition of type FirstDown, but not the matching transition of type LastUp. Drawings ignore transitions of type LastUp if they do not have the mouse focus.

The field d.goodDownClick is relevant when the current argument of d.tool has type ArgType.Click. It is true if the most recent FirstDown mouse transition or down transition of the space key successfully selected an argument point in the drawing.

The field d.txt is relevant when the current argument of d.tool has type argType.Text. In this case, d.tool must be a ProcTool. The field d.txt contains the text typed by the user so far (modulo backspaces), but not containing a trailing vertical bar character.

REVEAL
  ChildWriteOnly = ChildPublic BRANDED "Drawing.ChildWO" OBJECT
    originVal: JunoConfig.Origin
  OVERRIDES
    init := InitWriteOnly;
    getOrigin := ChildGetOrigin;
    setOrigin := ChildSetOrigin;
    <* LL.sup = VBT.mu.SELF *>
    rescreen := RescreenWriteOnly;
    reshape := ReshapeWriteOnly;
  END;
  Child = ChildWriteOnly BRANDED "Drawing.Child" OBJECT
    hasFocus := FALSE
  OVERRIDES
    <* LL.sup = VBT.mu *>
    mouse := Mouse;
    position := Position;
    key := Key;
    misc := Misc;
    <* LL.sup = VBT.mu.SELF *>
    reshape := Reshape;
    repaint := Repaint;
  END;

REVEAL
  ArgTool = Drag.ArgTool BRANDED "Drawing.ArgTool" OBJECT OVERRIDES
    setup := SetupNoop;
  END;

  PredTool = ArgTool BRANDED "Drawing.PredTool" OBJECT OVERRIDES
    apply := ApplyPred
  END;

  FuncTool = ArgTool BRANDED "Drawing.FuncTool" OBJECT OVERRIDES
    apply := ApplyFunc
  END;

  ProcTool = ProcToolPublic BRANDED "Drawing.ProcTool" OBJECT
    txt: JunoAST.Text := NIL;
    call: JunoAST.Save
  OVERRIDES
    setup := SetupProc;
    apply := ApplyProc;
    text := TextProc
  END;

  (* "txt # NIL => call # NIL"; "txt" will be the last argument of "call" *)

  SetTool = Tool BRANDED "Drawing.SetTool" OBJECT
    cmd: JunoAST.ProcCall
  OVERRIDES
    setup := SetupNoop;
    apply := ApplySetTool
  END;

PROCEDURE SetupNoop(<*UNUSED*> tl: Tool; <*UNUSED*> d: T;
  <*UNUSED*> time: VBT.TimeStamp) =
  BEGIN END SetupNoop;

VAR (*CONST*)
  Red             := PaintOp.FromRGB(1.0, 0.0, 0.0);
  PathColor       := Red;
  SelectColor     := Red;
  FrozenColor     := PaintOp.FromRGB(0.0, 0.35, 1.0);
  LabelColor      := PaintOp.BgFg;

PROCEDURE InitDrawing(d: T; ch: ChildPublic; root: View.Root): PSImpl.T =
  BEGIN
    EVAL PSImpl.T.init(d, ch, root);
    d.freezeTool := NewFreezeTool();
    d.dragTool := Drag.NewTool();
    RETURN d
  END InitDrawing;

PROCEDURE InitWriteOnly(ch: ChildWriteOnly; origin: JunoConfig.Origin): Child =
  BEGIN
    ch.originVal := origin;
    RETURN ch
  END InitWriteOnly;

PROCEDURE SetLabelStyle(d: T; style: [0..2]) =
  BEGIN
    IF style # d.labelStyle THEN
      d.labelStyle := style;
      d.root.dTrue := FALSE;
      d.update()
    END
  END SetLabelStyle;

PROCEDURE AcquireKBFocus(ch: Child; time: VBT.TimeStamp) =

Acquire the keyboard focus if Juno doesn't have it already.

  BEGIN
    IF NOT ch.hasFocus THEN
      TRY
    	VBT.Acquire(ch, VBT.KBFocus, time);
    	ch.hasFocus := TRUE
      EXCEPT VBT.Error => (* SKIP *)
      END
    END
  END AcquireKBFocus;

PROCEDURE Misc(ch: Child; READONLY cd: VBT.MiscRec) =
  <* LL.sup = VBT.mu *>
  BEGIN
    IF cd.type = VBT.Lost AND cd.selection = VBT.KBFocus THEN
      ch.hasFocus := FALSE;
      EVAL FinishTextTool(VBT.Parent(ch))
    END
  END Misc;

PROCEDURE DragModeFromModifiers(mods: VBT.Modifiers): Drag.DragMode =

Return the drag mode appropriate for the modifier keys mods.

  BEGIN
    IF VBT.Modifier.Shift IN mods THEN
      RETURN Drag.DragMode.Hor
    ELSIF VBT.Modifier.Option IN mods OR VBT.Modifier.Control IN mods THEN
      RETURN Drag.DragMode.Ver
    ELSE
      RETURN Drag.DragMode.Unconstrained
    END
  END DragModeFromModifiers;

PROCEDURE Mouse(ch: Child; READONLY cd: VBT.MouseRec) =
  <* LL.sup = VBT.mu *>
  VAR d: T := VBT.Parent(ch); BEGIN
    (* Ignore "LastUp" events if "d" does not have the mouse focus. *)
    IF NOT d.hasMouseFocus AND cd.clickType = VBT.ClickType.LastUp THEN
      RETURN
    END;
    IF cd.clickType = VBT.ClickType.FirstDown THEN
      AcquireKBFocus(ch, cd.time)
    END;
    (* Don't allow manipulations to drawing unless the AST is up to date
       and we are not in the process of entering text. *)
    IF NOT d.root.astTrue THEN
      JunoError.Display(ch, "Oops! You forgot to click Run.");
      RETURN
    ELSIF d.txt # NIL THEN
      RETURN
    END;
    (* Check for use of "freeze" or "drag" tool shortcut *)
    IF cd.clickType = VBT.ClickType.FirstDown AND d.stackSize = 0 THEN
      CASE cd.whatChanged OF
        VBT.Modifier.MouseM =>
          d.usingTempTool := TRUE; d.lastTool := d.tool; d.tool := d.dragTool
      | VBT.Modifier.MouseR =>
          d.usingTempTool := TRUE; d.lastTool := d.tool; d.tool := d.freezeTool
      ELSE (* SKIP *)
      END
    END;
    (* Don't proceed  unless a tool has been selected; ignore errant
       middle- and right-mouse clicks. *)
    IF d.tool = NIL THEN
      JunoError.Display(ch, "Oops! You need to choose a tool.");
      RETURN
    ELSIF cd.whatChanged # VBT.Modifier.MouseL AND NOT d.usingTempTool THEN
      RETURN
    END;
    (* Process the mouse click based on the type of the current argument for
       the current drawing tool. *)
    CASE d.tool.argType[d.stackSize] OF <* NOWARN *>
      ArgType.Click =>
        CASE cd.clickType OF
          VBT.ClickType.FirstDown =>
	    d.hasMouseFocus := TRUE;
	    VAR arg: Arg; BEGIN
	      IF VBT.Modifier.Shift IN cd.modifiers THEN
		arg := ClickNewPt(d, cd.cp.pt, ch.xform,
                  frozen := VBT.Modifier.Option IN cd.modifiers);
		SourceUntrue(d, View.ModKind.ImplicitConsistent);
	      ELSIF NOT FindArg(d, JunoPt.FromHV(cd.cp.pt, ch.xform), arg) THEN
		d.goodDownClick := FALSE;
		RETURN
	      END;
	      Push(d, arg);
	      PaintStackTop(d, select := TRUE)
	    END;
	    d.goodDownClick := TRUE;
        | VBT.ClickType.LastUp =>
	    d.hasMouseFocus := FALSE;
	    IF d.goodDownClick THEN
	      PaintStackTop(d, select := FALSE);
	      ApplyIfReady(d, cd.time)
	    END
        ELSE
          RETURN
        END
    | ArgType.CreateClick =>
        CASE cd.clickType OF
          VBT.ClickType.FirstDown =>
	    d.hasMouseFocus := TRUE;
	    VAR arg: Arg; BEGIN
              arg := ClickNewPt(d, cd.cp.pt, ch.xform,
                frozen := VBT.Modifier.Option IN cd.modifiers);
	      SourceUntrue(d, View.ModKind.ImplicitConsistent);
	      Push(d, arg)
	    END;
	    PaintStackTop(d, select := TRUE)
        | VBT.ClickType.LastUp =>
	    d.hasMouseFocus := FALSE;
	    PaintStackTop(d, select := FALSE);
	    ApplyIfReady(d, cd.time)
        ELSE
          RETURN
        END
    | ArgType.Drag =>
        CASE cd.clickType OF
          VBT.ClickType.FirstDown =>
	    d.hasMouseFocus := TRUE;
	    WITH arg = d.stack[d.stackSize] DO
	      IF FindArg(d, JunoPt.FromHV(cd.cp.pt, ch.xform), arg) THEN
		VBT.SetCage(ch, VBT.CageFromPosition(cd.cp));
		d.dragging := TRUE;
		d.dragger := cd.cp.pt;
		d.draggee := JunoPt.ToHV(arg.loc, ch.xform);
		d.dragName := Atom.ToText(arg.name.id1);
                d.dragMode := DragModeFromModifiers(cd.modifiers);
		(* d.root.marquee.putArg(d.dragName); *)
		TRY d.tool.pre(d, cd, d.stackSize) EXCEPT Drag.Aborted =>
                  (* perform same actions as mouse up-click *)
                  UpDrag(d, ch, VBT.MouseRec{whatChanged:=VBT.Modifier.MouseL,
                    time := cd.time, cp := cd.cp, modifiers := cd.modifiers,
                    clickType := VBT.ClickType.LastUp, clickCount := 1});
                  (* set cage so "Position" won't be called again this drag *)
                  VBT.SetCage(ch, VBT.EverywhereCage)
                END
	      END
	    END
        | VBT.ClickType.LastUp =>
            (* drag completed successfully *)
	    d.hasMouseFocus := FALSE;
	    IF d.dragging THEN UpDrag(d, ch, cd) END
        ELSE
          RETURN
        END
    END;
    (* undo the "freeze" or "drag" tool shortcut *)
    IF d.usingTempTool AND cd.clickType = VBT.ClickType.LastUp THEN
      d.tool := d.lastTool; d.lastTool := NIL; d.usingTempTool := FALSE
    END;
    Sync(ch)
  END Mouse;

PROCEDURE Position(ch: Child; READONLY cd: VBT.PositionRec) =
  <* LL.sup = VBT.mu *>
  VAR d: T := VBT.Parent(ch); BEGIN
    IF NOT d.dragging THEN
      VBT.SetCage(ch, VBT.EverywhereCage)
    ELSIF cd.cp.gone THEN
      VBT.SetCage(ch, VBT.GoneCage)
    ELSE
      TRY
    	VAR delta := Point.Sub(cd.cp.pt, d.dragger); BEGIN
    	  d.dragger := cd.cp.pt;
    	  d.draggee := d.tool.during(d, delta, d.stackSize);
    	END;
    	VBT.SetCage(ch, VBT.CageFromPosition(cd.cp))
      EXCEPT
    	Drag.Aborted =>
    	  (* perform same actions as mouse up-click *)
    	  UpDrag(d, ch, VBT.MouseRec{whatChanged := VBT.Modifier.MouseL,
    	    time := cd.time, cp := cd.cp, modifiers := cd.modifiers,
    	    clickType := VBT.ClickType.LastUp, clickCount := 1});
    	  (* set cage so "Position" won't be called again this drag *)
    	  VBT.SetCage(ch, VBT.EverywhereCage)
      END
    END
  END Position;

PROCEDURE UpDrag(d: T; ch: Child; READONLY cd: VBT.MouseRec) =

Perform the action associated with up-clicking at the end of a drag arg. This can happen when the user explicitly up-clicks while dragging, if a compilation error occurred at the start of the drag, or if a Juno run-time error occurs while dragging.

  <* LL.sup = VBT.mu *>
  BEGIN
    d.dragging := FALSE;
    d.stack[d.stackSize].locUp := JunoPt.FromHV(d.draggee, ch.xform);
    d.tool.post(d, cd, d.stackSize);
    ApplyIfReady(d, cd.time);
  END UpDrag;

TYPE ArgSet = SET OF ArgType;

VAR collecting := TRUE;

PROCEDURE Key(ch: Child; READONLY cd: VBT.KeyRec) =
  <* LL.sup = VBT.mu *>
  CONST
    ClickArgs = ArgSet{ArgType.Click, ArgType.CreateClick};
    NoModifiers = VBT.Modifiers{};
  VAR d: T := VBT.Parent(ch);  BEGIN
    IF d.dragging THEN RETURN END;
    IF d.txt # NIL THEN
      (* user is typing a text argument *)
      WITH tool = NARROW(d.tool, ProcTool) DO
      	IF cd.wentDown THEN
      	  IF cd.whatChanged = KeyboardKey.BackSpace OR
      	     cd.whatChanged = KeyboardKey.Delete THEN
      	    IF Text.Length(d.txt) > 0 THEN
      	      d.txt := Text.Sub(d.txt, 0, Text.Length(d.txt) - 1);
      	      tool.text(d, d.txt)
      	    END
      	  ELSIF cd.whatChanged = KeyboardKey.Return AND
      		cd.modifiers = NoModifiers THEN
      	    d.stack[d.stackSize].text := d.txt;
      	    d.txt := NIL;
      	    ApplyIfReady(d, cd.time)
      	  ELSE
      	    VAR ch := KeyTrans.TTY(cd); BEGIN
      	      IF ch # KeyTrans.NullKey THEN
      		d.txt := d.txt & Text.FromChar(ch);
      		tool.text(d, d.txt)
      	      END
      	    END
      	  END;
      	END
      END
    ELSE
      (* user is not typing a text argument *)
      IF cd.whatChanged = Latin1Key.space THEN
	IF cd.wentDown THEN
	  IF d.tool = NIL OR (d.stackSize >= d.prevStackSize) THEN
	    JunoError.Display(d, "No previous argument to copy");
	    d.goodDownClick := FALSE;
	    RETURN
	  ELSIF d.tool.argType[d.stackSize] IN ClickArgs THEN
	    d.root.marquee.putArg(Atom.ToText(d.stack[d.stackSize].name.id1));
	    PaintStackTop(d, select := TRUE);
	    d.goodDownClick := TRUE
	  END
	ELSIF d.goodDownClick AND d.tool # NIL
            AND d.stackSize < d.prevStackSize
	    AND d.tool.argType[d.stackSize] IN ClickArgs THEN
          PaintStackTop(d, select := FALSE);
          ApplyIfReady(d, cd.time)
	END
      ELSIF cd.wentDown THEN
	IF cd.whatChanged = Latin1Key.g OR cd.whatChanged = Latin1Key.G THEN
          (* do a garbage collection now *)
          RTCollector.Collect()
	ELSIF cd.whatChanged = Latin1Key.o OR cd.whatChanged = Latin1Key.O THEN
          (* toggle whether collection is on or off *)
          IF collecting
            THEN RTCollector.Disable()
            ELSE RTCollector.Enable()
          END;
          collecting := NOT collecting
	ELSIF cd.whatChanged = Latin1Key.u OR cd.whatChanged = Latin1Key.U THEN
	  IF d.stackSize > 0 THEN
	    d.root.marquee.remArg();
	    DEC(d.stackSize)
	  END
	ELSIF cd.whatChanged = Latin1Key.c OR cd.whatChanged = Latin1Key.C THEN
	  d.continuousUnparse := NOT d.continuousUnparse;
	  IF d.continuousUnparse AND NOT d.root.sTrue THEN
	    d.root.source.update()
	  END
	END
      END
    END;
    Sync(ch)
  END Key;

PROCEDURE ClickNewPt(
    d: T;
    READONLY hvPt: Point.T;
    READONLY xform: JunoPt.Transform;
    frozen: BOOLEAN)
  : Arg =

Create a new point in d at Trestle coordinate hvPt and update d's source to contain it. The frozen parameter determines whether the new point is frozen or not.

  <* LL.sup = VBT.mu *>
  VAR xyPt := JunoPt.FromHV(hvPt, xform); BEGIN
    RETURN CreatePoint(d, xyPt, frozen)
  END ClickNewPt;

PROCEDURE CreatePoint(d: T; READONLY xyPt: JunoPt.T; frozen: BOOLEAN): Arg =
  <* LL.sup = VBT.mu *>
  VAR res: Arg; atom: Atom.T; BEGIN
    REPEAT
      VAR
        letter := VAL(ORD('a') + d.pointCount MOD 26, CHAR);
        digit := (d.pointCount DIV 26) - 1;
        name := Text.FromChar(letter);
      BEGIN
        IF digit >= 0 THEN name := name & Fmt.Int(digit) END;
        atom := Atom.FromText(name);
        INC(d.pointCount)
      END
    UNTIL CurrCmd.GetVariable(CurrCmd.GetAST(d.root.ccmd), atom) = NIL;
    VAR hint: JunoAST.Expr; BEGIN
      res.name := IdToQId(atom);
      IF GridActive(d) THEN
        VAR x, y: JunoValue.Real; BEGIN
          EVAL JunoPt.RelVal(xyPt.x, xyPt.y, d.grid0.x, d.grid0.y,
            d.grid1.x, d.grid1.y, x, y);
          x := FLOAT(ROUND(x), JunoValue.Real);
          y := FLOAT(ROUND(y), JunoValue.Real);
          hint := NEW(JunoAST.Rel,
            e1 := JunoASTUtils.NewPoint(x, y),
            e2 := NEW(JunoAST.Pair, e1 := d.grid0nm, e2 := d.grid1nm));
          res.loc := EvalRel(x, y, d.grid0, d.grid1);
          CurrCmd.AddVariable(d.root.ccmd, atom, res.loc, hint, frozen := TRUE)
        END
      ELSE
        res.loc := xyPt;
        hint := JunoPt.ToASTPair(xyPt);
        CurrCmd.AddVariable(d.root.ccmd, atom, xyPt, hint, frozen := frozen);
      END;
      res.locUp := DummyXY;
      RETURN res
    END
  END CreatePoint;

PROCEDURE FindArg(d: T; READONLY pt: JunoPt.T; VAR (*OUT*) arg: Arg): BOOLEAN =
  VAR nm := FindPoint(d, pt); BEGIN
    IF nm = NIL THEN RETURN FALSE END;
    VAR px, py: JunoValue.Real; BEGIN
      EVAL CurrCmd.PointLocation(d.root.ccmd, nm, px, py);
      arg := Arg{IdToQId(nm), JunoPt.T{px, py}, DummyXY};
      RETURN TRUE
    END
  END FindArg;

PROCEDURE FindPoint(d: T; READONLY pt0: JunoPt.T): JunoAST.Id =
  <* LL.sup <= VBT.mu *>
  VAR
    best := Real.MaxFinite;
    bestatom: Atom.T := NIL;
  PROCEDURE P(n: Atom.T; READONLY pt1: JunoPt.T) =
    VAR dx := pt1.x - pt0.x; dy := pt1.y - pt0.y; d := dx*dx + dy*dy; BEGIN
      IF d < best THEN best := d; bestatom := n END
    END P;
  BEGIN
    CurrCmd.ForAllPoints(d.root.ccmd, P);
    RETURN bestatom
  END FindPoint;

PROCEDURE Push(m: T; READONLY arg: Arg) =
  BEGIN
    m.stack[m.stackSize] := arg
    (* ; m.root.marquee.putArg(Atom.ToText(arg.name.id1)) *)
  END Push;

<* SPEC ApplyIfReady REQUIRES sup(LL) = VBT.mu *>

PROCEDURE ApplyIfReady(d: T; time: VBT.TimeStamp) =

Increment the stack pointer, and apply d.tool if there are enough arguments. If the most recent argument was not the last one and the current argument has type ArgType.Text, initialize state in d for the next argument.

This procedure changes the drawing without doing a Sync.

  BEGIN
    INC(d.stackSize);
    IF d.stackSize = NUMBER(d.tool.argType^) THEN
      d.tool.apply(d, SUBARRAY(d.stack, 0, d.stackSize));
      (* d.root.marquee.newline(); *)
      ClearStack(d, time)
    ELSIF d.tool.argType[d.stackSize] = ArgType.Text THEN
      d.txt := "";
      NARROW(d.tool, ProcTool).text(d, d.txt)
    END;
  END ApplyIfReady;

PROCEDURE ClearStack(d: T; time: VBT.TimeStamp; tl: Tool := NIL) =

Clear d's stack, and call the setup method of the tool tl. If tl is defaulted, then use the current ArgTool of d if one is selected.

  BEGIN
    IF d.stackSize # 0 THEN d.prevStackSize := d.stackSize END;
    d.stackSize := 0;
    (* d.root.marquee.erase(); *)
    IF tl = NIL THEN tl := d.tool END;
    IF tl # NIL THEN
      tl.setup(d, time);
      (* ; d.root.marquee.putName(tl.label) *)
      (* invoke "text" method of 1-arg text tool *)
      TYPECASE tl OF
        ProcTool (pt) =>
       	  IF NUMBER(pt.argType^) = 1 AND pt.argType[0] = ArgType.Text THEN
    	    d.txt := "";      (* indicate we are typing a text arg *)
    	    pt.text(d, d.txt);
    	    AcquireKBFocus(Filter.Child(d), time)
       	  END
      ELSE (*SKIP*)
      END
    END
  END ClearStack;

PROCEDURE RescreenWriteOnly(ch: ChildWriteOnly; READONLY cd: VBT.RescreenRec) =
  <* LL.sup = VBT.mu.ch *>
  CONST MMPerPoint = 25.4(*mm/in*) /  72.0(*pt/in*); BEGIN
    IF cd.st # NIL THEN
      ch.xform.xScale := VBT.MMToPixels(ch, MMPerPoint, Axis.T.Hor);
      ch.xform.yScale := VBT.MMToPixels(ch, MMPerPoint, Axis.T.Ver);
      ch.xform.widthScale := (ch.xform.xScale + ch.xform.yScale) / 2.0
    END
  END RescreenWriteOnly;

PROCEDURE ReshapeWriteOnly(ch: ChildWriteOnly; READONLY cd: VBT.ReshapeRec) =
  <* LL.sup = VBT.mu.ch *>
  BEGIN
    IF cd.new # Rect.Empty THEN
      CASE ch.originVal OF
        JunoConfig.Origin.SW => ch.xform.origin := Rect.SouthWest(cd.new)
      | JunoConfig.Origin.Center => ch.xform.origin := Rect.Middle(cd.new)
      END;
      ch.repaint(Region.Full)
    END
  END ReshapeWriteOnly;

PROCEDURE Reshape(ch: Child; READONLY cd: VBT.ReshapeRec) =
  <* LL.sup = VBT.mu.ch *>
  BEGIN
    IF cd.new # Rect.Empty THEN
      VAR d: T := VBT.Parent(ch); BEGIN
  	d.root.dTrue := FALSE
      END
    END;
    ChildWriteOnly.reshape(ch, cd)
  END Reshape;

PROCEDURE Repaint(ch: Child; <*UNUSED*> READONLY rgn: Region.T) =
  <* LL.sup = VBT.mu.ch *>
  VAR d: T := VBT.Parent(ch); BEGIN
    DisplayError(d, Exec(d));
    Sync(ch)
  END Repaint;

PROCEDURE Exec(d: T): TEXT =
  VAR res: TEXT := NIL; BEGIN
    IF NOT d.root.dTrue THEN
      res := ExecCurrCmd(d, d.root.skipify); Annotations(d);
      IF res = NIL THEN d.root.dTrue := TRUE END
    END;
    RETURN res
  END Exec;

PROCEDURE ExecCurrCmd(d: T; skipify: BOOLEAN): TEXT =
  VAR ch: Child := Filter.Child(d); BEGIN
    (* prepare drawing *)
    PSImpl.Reset(d, inExec := FALSE);
    VBT.PaintTint(ch, Rect.Full, PaintOp.Bg);
    DblBufferVBT.ClearSaved(ch);
    (* run current command *)
    TRY
      IF CurrCmd.Run(d.root.ccmd, skipify) THEN
        SourceUntrue(d, View.ModKind.ImplicitConsistent)
      END
    EXCEPT
      CurrCmd.CompileError (msg) => RETURN msg
    | CurrCmd.RuntimeError (rec) => RETURN rec.errorMsg
    END;
    RETURN NIL
  END ExecCurrCmd;

PROCEDURE Annotations(d: T) =

Draw annotations after running the current command

  BEGIN
    PaintPath(d);
    PaintGrid(d);
    PaintBBox(d);
    PaintPoints(d);
  END Annotations;

PROCEDURE Sync(v: VBT.T) =
  BEGIN VBT.Sync(v) END Sync;

PROCEDURE PaintPath(d: T) =
  VAR ch: Child := Filter.Child(d); BEGIN
    WITH path = d.ps.path DO
      VBT.Stroke(ch, Rect.Full, path, width := 3, end := VBT.EndStyle.Square,
        join := VBT.JoinStyle.Bevel, op := PaintOp.Bg);
      VBT.Stroke(ch, Rect.Full, path, op := PathColor)
    END
  END PaintPath;

PROCEDURE GridActive(d: T): BOOLEAN =
  BEGIN
    RETURN d.gridMode AND
      1.0 <= ABS(d.grid1.x - d.grid0.x) + ABS(d.grid1.y - d.grid0.y)
  END GridActive;

PROCEDURE AdjustGridPoints(d: T) =

Update the values of d.grid0 and d.grid1 from the current command. If either of the points d.grid0nm or d.grid1nm is not defined in the current command, then reset d.gridMode.

  PROCEDURE UpdatePoint(nm: JunoAST.Id; VAR (*OUT*) pt: JunoPt.T) =
    VAR x, y: JunoValue.Real; BEGIN
      IF CurrCmd.PointLocation(d.root.ccmd, nm, x, y)
        THEN pt := JunoPt.T{x, y}
        ELSE d.gridMode := FALSE
      END
    END UpdatePoint;
  BEGIN
    IF d.gridMode THEN
      UpdatePoint(d.grid0nm.id1, d.grid0);
      UpdatePoint(d.grid1nm.id1, d.grid1);
      (* turn off grid tool if grid is no longer active *)
      IF NOT d.gridMode THEN
        ToolBox.SwapButton(d.toolBox, d.gridOff, d.gridOn, "Grid On")
      END
    END
  END AdjustGridPoints;

PROCEDURE ToGridCoords(d: T; ch: Child; hvPt: Point.T): JunoPt.T =
  VAR res: JunoPt.T; xyPt := JunoPt.FromHV(hvPt, ch.xform); BEGIN
    EVAL JunoPt.RelVal(xyPt.x, xyPt.y, d.grid0.x, d.grid0.y,
      d.grid1.x, d.grid1.y, res.x, res.y);
    RETURN res
  END ToGridCoords;

PROCEDURE PaintGrid(d: T) =
  BEGIN
    AdjustGridPoints(d);
    IF GridActive(d) THEN
      VAR
	ch: Child := Filter.Child(d);
	dom := VBT.Domain(d);
	nw := ToGridCoords(d, ch, Rect.NorthWest(dom));
	ne := ToGridCoords(d, ch, Rect.NorthEast(dom));
	se := ToGridCoords(d, ch, Rect.SouthEast(dom));
	sw := ToGridCoords(d, ch, Rect.SouthWest(dom));
	mini := MIN(MIN(FLOOR(nw.x), FLOOR(ne.x)),
		    MIN(FLOOR(se.x), FLOOR(sw.x)));
	maxi := MAX(MAX(CEILING(nw.x), CEILING(ne.x)),
		    MAX(CEILING(se.x), CEILING(sw.x)));
	minj := MIN(MIN(FLOOR(nw.y), FLOOR(ne.y)),
		    MIN(FLOOR(se.y), FLOOR(sw.y)));
	maxj := MAX(MAX(CEILING(nw.y), CEILING(ne.y)),
		    MAX(CEILING(se.y), CEILING(sw.y)));
      BEGIN
	FOR i := mini TO maxi DO
	  FOR j := minj TO maxj DO
	    VBT.PaintTint(ch, Rect.FromPoint(
	      JunoPt.ToHV(
                EvalRel(
                  FLOAT(i, JunoValue.Real), FLOAT(j, JunoValue.Real),
		  d.grid0, d.grid1),
		ch.xform)),
	      PaintOp.Fg)
	  END
	END
      END
    END
  END PaintGrid;

PROCEDURE PaintBBox(d: T) =
  VAR ch: Child := Filter.Child(d);
  PROCEDURE HVPoint(x, y: JunoValue.Real): Point.T =
    BEGIN RETURN JunoPt.ToHV(JunoPt.T{x, y}, ch.xform) END HVPoint;
  VAR path := NEW(Path.T); BEGIN
    WITH bbox = d.ps.bbox DO
      Path.MoveTo(path, HVPoint(bbox.west, bbox.south));
      Path.LineTo(path, HVPoint(bbox.east, bbox.south));
      Path.LineTo(path, HVPoint(bbox.east, bbox.north));
      Path.LineTo(path, HVPoint(bbox.west, bbox.north));
      Path.Close(path)
    END;
    VBT.Stroke(ch, Rect.Full, path, width := 1, end := VBT.EndStyle.Butt,
      join := VBT.JoinStyle.Miter, src := Pixmap.Gray)
  END PaintBBox;

PROCEDURE PaintPoints(d: T) =
  VAR
    ccmd := d.root.ccmd;
    ch: Child := Filter.Child(d);
  PROCEDURE P(atom: Atom.T; READONLY pt: JunoPt.T) =
    VAR op: PaintOp.T; BEGIN
      IF CurrCmd.IsFrozen(ccmd, atom)
        THEN op := FrozenColor
        ELSE op := LabelColor
      END;
      PaintPoint(ch, Atom.ToText(atom), op,
        pt := JunoPt.ToHV(pt, ch.xform))
    END P;
  BEGIN
    IF d.labelStyle > 0 THEN
      CurrCmd.ForAllPoints(ccmd, P)
    END
  END PaintPoints;

PROCEDURE PaintStackTop(d: T; select: BOOLEAN) =

Paint the label on the top of d's stack. If select is true, then paint the label in SelectColor; otherwise, paint it in LabelColor or FrozenColor based on whether the point is frozen or not.

  VAR
    arg := d.stack[d.stackSize];
    ch: Child := Filter.Child(d);
    op: PaintOp.T;
  BEGIN
    IF select THEN
      op := SelectColor
    ELSE
      IF CurrCmd.IsFrozen(d.root.ccmd, arg.name.id1)
        THEN op := FrozenColor
        ELSE op := LabelColor
      END;
    END;
    PaintPoint(ch, Atom.ToText(arg.name.id1), op := op,
      pt := JunoPt.ToHV(arg.loc, ch.xform))
  END PaintStackTop;

PROCEDURE PaintPoint(ch: Child; name: TEXT; op: PaintOp.T; pt: Point.T) =
  VAR m: T := VBT.Parent(ch); BEGIN
    CASE m.labelStyle OF
      0 => (* SKIP *)
    | 1 =>
        VAR delta := Point.Sub(pt, Rect.Middle(JunoConfig.cross.r)); BEGIN
          JunoConfig.crossBdry := Region.Add(JunoConfig.crossBdry, delta);
          JunoConfig.cross := Region.Add(JunoConfig.cross, delta);
          VBT.PaintRegion(ch, JunoConfig.crossBdry, PaintOp.Bg);
          VBT.PaintRegion(ch, JunoConfig.cross, op)
        END
    | 2 =>
        VAR
          delta := Point.Sub(pt, Rect.Middle(JunoConfig.dot.r));
          rect := VBT.BoundingBox(ch, name, JunoConfig.labelFont);
        BEGIN
	  JunoConfig.dot := Region.Add(JunoConfig.dot, delta);
	  VBT.PaintText(ch, t := name, op := op, fnt := JunoConfig.labelFont,
	    pt := Point.Sub(pt, Rect.NorthEast(rect)), clip := Rect.Full);
	  VBT.PaintRegion(ch, JunoConfig.dot, op)
        END
    END
  END PaintPoint;

PROCEDURE Update(d: T) =
  <* LL.sup <= VBT.mu *>
  BEGIN
    d.pointCount := 0;
    d.txt := NIL;
    ClearStack(d, 0);
    DisplayError(d, Exec(d));
    Sync(Filter.Child(d))
  END Update;

PROCEDURE ChildGetOrigin(ch: ChildWriteOnly): JunoConfig.Origin =
  BEGIN RETURN ch.originVal END ChildGetOrigin;

PROCEDURE ChildSetOrigin(ch: ChildWriteOnly; origin: JunoConfig.Origin) =
  BEGIN ch.originVal := origin END ChildSetOrigin;

PROCEDURE FinishTextTool(d: T): BOOLEAN =
  VAR res := d.txt # NIL; BEGIN
    IF res THEN ToolBox.Unselect(d.root) END;
    RETURN res
  END FinishTextTool;

PROCEDURE Make(d: T; skipify: BOOLEAN) =
  BEGIN
    d.pointCount := 0;
    d.txt := NIL;
    ClearStack(d, 0);
    VAR err := ExecCurrCmd(d, skipify); BEGIN
      Annotations(d);
      IF err = NIL
        THEN d.root.dTrue := TRUE
        ELSE DisplayError(d, err)
      END
    END;
    Sync(Filter.Child(d))
  END Make;

PROCEDURE ArrayToList(READONLY arg: ARRAY OF Arg; byVal := FALSE):
    JunoAST.ExprList =

Return a list of expressions in arg, where the ith expression in the list corresponds to arg[i]. If arg[i].text # NIL, then the ith expression is the text string arg[i].text. Otherwise, if byVal, then the ith expression is the value arg[i].loc; if not, then it is the name of the point arg[i].name.

  VAR res: JunoAST.ExprList; expr: JunoAST.Expr; BEGIN
    IF byVal
      THEN res := NEW(JunoAST.ExprList, bp := JunoAST.End)
      ELSE res := NEW(JunoAST.QIdList, bp := JunoAST.End)
    END;
    FOR i := LAST(arg) TO FIRST(arg) BY -1 DO
      IF arg[i].text # NIL THEN
        expr := ToASTText(arg[i].text)
      ELSIF byVal THEN
        expr := JunoPt.ToASTPair(arg[i].loc)
      ELSE
        <* ASSERT arg[i].name # NIL *>
        expr := arg[i].name
      END;
      res.head := NEW(JunoAST.ExprLink, expr := expr, next := res.head);
      INC(res.size)
    END;
    RETURN res
  END ArrayToList;

PROCEDURE FindBreak(t: TEXT): CARDINAL =

Return the index of the character after the last run of newlines not counting a run of newlines that terminates t, or 0 if t contains no non-terminal newlines.

  VAR i := Text.Length(t) - 1; BEGIN
    WHILE i >= 0 AND Text.GetChar(t, i) = '\n' DO DEC(i) END;
    RETURN Text.FindCharR(t, '\n', start := i) + 1
  END FindBreak;

PROCEDURE ToASTText(t: TEXT): JunoAST.Expr =

Return an expression equivalent to the text t. If t contains newline characters, the result will be a concatenation of text literals.

  VAR i := FindBreak(t); res: JunoAST.Expr; BEGIN
    res := NEW(JunoAST.Text, val := Text.Sub(t, i), bp := JunoAST.End);
    IF i # 0 THEN
      res := NEW(JunoAST.Concat, bp := JunoAST.End,
        e1 := ToASTText(Text.Sub(t, 0, i)), e2 := res)
    END;
    RETURN res
  END ToASTText;

PROCEDURE MakeConstraint(tl: PredTool; READONLY arg: ARRAY OF Arg):
    JunoAST.Formula =
  BEGIN
    IF tl.name.id0 = JunoAST.NilId THEN
      IF tl.name.id1 = CongToolSym THEN
	RETURN NEW(JunoAST.Cong, bp := JunoAST.End,
	  e1 := MakePair(arg[0].name, arg[1].name),
	  e2 := MakePair(arg[2].name, arg[3].name))
      ELSIF tl.name.id1 = ParaToolSym THEN
	RETURN NEW(JunoAST.Para, bp := JunoAST.End,
	  e1 := MakePair(arg[0].name, arg[1].name),
	  e2 := MakePair(arg[2].name, arg[3].name))
      ELSIF tl.name.id1 = HorToolSym THEN
	RETURN NEW(JunoAST.Hor, bp := JunoAST.End,
          e1 := arg[0].name, e2 := arg[1].name)
      ELSIF tl.name.id1 = VerToolSym THEN
	RETURN NEW(JunoAST.Ver, bp := JunoAST.End,
          e1 := arg[0].name, e2 := arg[1].name)
      END
    END;
    RETURN NEW(JunoAST.Call, inouts := JunoAST.EmptyExprList,
      name := tl.name, ins := ArrayToList(arg), bp := JunoAST.End)
  END MakeConstraint;

PROCEDURE MakeEqConstraint(tl: FuncTool; READONLY arg: ARRAY OF Arg):
    JunoAST.Formula =
  BEGIN
    RETURN NEW(JunoAST.Equals, bp := JunoAST.End, e1 := arg[0].name,
      e2 := NEW(JunoAST.Call, bp := JunoAST.End,
        inouts := JunoAST.EmptyExprList, name := tl.name,
        ins := ArrayToList(SUBARRAY(arg, 1, tl.in_cnt))))
  END MakeEqConstraint;

PROCEDURE MakeCommand(
    tl: ProcTool;
    READONLY arg: ARRAY OF Arg;
    byVal := FALSE): JunoAST.ProcCall =

Return a procedure call to the procedure tl.name with the arguments stored in arg.

  BEGIN
    <* ASSERT tl.out_cnt + tl.inout_cnt + tl.in_cnt = NUMBER(arg) *>
    WITH
      outArgs = SUBARRAY(arg, 0, tl.out_cnt),
      inoutArgs = SUBARRAY(arg, tl.out_cnt, tl.inout_cnt),
      inArgs = SUBARRAY(arg, tl.out_cnt + tl.inout_cnt, tl.in_cnt)
    DO
      RETURN NEW(JunoAST.ProcCall, bp := JunoAST.End, name := tl.name,
        outs := ArrayToList(outArgs, byVal := FALSE),
        inouts := ArrayToList(inoutArgs, byVal := FALSE),
        inout_parens := NUMBER(inoutArgs) > 1,
        ins := ArrayToList(inArgs, byVal))
    END
  END MakeCommand;

PROCEDURE MakePair(id1, id2: JunoAST.QId): JunoAST.Pair =
  BEGIN
    RETURN NEW(JunoAST.Pair, e1 := id1, e2 := id2, bp := JunoAST.End)
  END MakePair;

PROCEDURE EvalRel(x, y: JunoValue.Real; p0, p1: JunoPt.T): JunoPt.T =
  VAR res: JunoPt.T; dx := p1.x - p0.x; dy := p1.y - p0.y; BEGIN
    res.x := p0.x + dx * x - dy * y;
    res.y := p0.y + dx * y + dy * x;
    RETURN res
  END EvalRel;

<* INLINE *>
PROCEDURE IdToQId(a: JunoAST.Id): JunoAST.QId =
  BEGIN
    RETURN NEW(JunoAST.QId, bp := JunoAST.End, id0 := JunoAST.NilId, id1 := a)
  END IdToQId;

PROCEDURE SelectTool(d: T; t: Tool; time: VBT.TimeStamp) =
  BEGIN
    (* IF d.tool = NIL THEN PopupMarquee(d) END; *)
    IF d.txt # NIL THEN
      IF Text.Length(d.txt) > 0 THEN
        (* In the middle of entering text; simulate <RETURN> *)
        d.stack[d.stackSize].text := d.txt;
        d.txt := NIL;
        ApplyIfReady(d, time);
        (* NOTE: If the current tool is a text tool taking a single argument,
           its "setup" method will have set "d.txt" to the empty string. *)
      END;
      IF d.txt # NIL THEN
        <* ASSERT Text.Length(d.txt) = 0 *>
        (* erase the vertical bar for the empty text arg *)
        DblBufferVBT.Restore(Filter.Child(d));
        d.txt := NIL
      END;
      Sync(Filter.Child(d))
    END;
    IF t # NIL AND NUMBER(t.argType^) = 0 THEN
      (* attempt to apply a tool with 0 user-supplied arguments;
         this includes set tools *)
      IF d.root.astTrue THEN (* AST must be up-to-date *)
        ClearStack(d, time, tl := t);
        t.apply(d, ARRAY OF Arg{});
      	ClearStack(d, time);
      	Sync(Filter.Child(d));

d.root.marquee.erase(); d.root.marquee.putName(t.label); d.root.marquee.newline()

      ELSE
        JunoError.Display(Filter.Child(d), "Oops! You forgot to click Run.");
      END
    ELSE
      (* deselect tool or select tool with > 0 arguments *)
      d.tool := t;
      ClearStack(d, time)
    END
  END SelectTool;

PROCEDURE NewArgArray(n: CARDINAL; type: ArgType): REF ARRAY OF ArgType =
  VAR res := NEW(REF ARRAY OF ArgType, n); BEGIN
    FOR i := 0 TO LAST(res^) DO res[i] := type END;
    RETURN res
  END NewArgArray;

PROCEDURE NewCreateTool(): ArgTool =
  BEGIN
    RETURN NEW(ArgTool, argType := NewArgArray(1, ArgType.CreateClick),
      apply := ApplyPoint)
  END NewCreateTool;

<* SPEC ApplyPoint REQUIRES sup(LL) = VBT.mu *>

PROCEDURE ApplyPoint(
  <*UNUSED*> tl: Tool;
  <*UNUSED*> d: T;
  <*UNUSED*> READONLY arg: ARRAY OF Arg) =
  BEGIN
    (*SKIP*)
  END ApplyPoint;

PROCEDURE NewPredTool(name: JunoAST.QId; in_cnt: CARDINAL): ArgTool =
  BEGIN
    RETURN NEW(PredTool, name := name, in_cnt := in_cnt,
      argType := NewArgArray(in_cnt, ArgType.Click))
  END NewPredTool;

<* SPEC ApplyPred REQUIRES sup(LL) = VBT.mu *>

PROCEDURE ApplyPred(tl: PredTool; d: T; READONLY arg: ARRAY OF Arg) =

This is the default implementation of the apply method for predicate tools.

  BEGIN
    <* ASSERT d.root.astTrue *>
    CurrCmd.AddConstraint(d.root.ccmd, MakeConstraint(tl, arg));
    d.root.dTrue := FALSE;		 (* indicate implicit modification *)
    SourceUntrue(d, View.ModKind.ImplicitOutOfDate)
  END ApplyPred;

PROCEDURE NewFuncTool(name: JunoAST.QId; in_cnt: CARDINAL): ArgTool =
  BEGIN
    RETURN NEW(FuncTool, name := name, in_cnt := in_cnt,
      argType := NewArgArray(1 + in_cnt, ArgType.Click))
  END NewFuncTool;

<* SPEC ApplyFunc REQUIRES sup(LL) = VBT.mu *>

PROCEDURE ApplyFunc(tl: FuncTool; d: T; READONLY arg: ARRAY OF Arg) =

This is the default implementation of the apply method for function tools.

  BEGIN
    <* ASSERT d.root.astTrue *>
    CurrCmd.AddConstraint(d.root.ccmd, MakeEqConstraint(tl, arg));
    d.root.dTrue := FALSE;		 (* indicate implicit modification *)
    SourceUntrue(d, View.ModKind.ImplicitOutOfDate)
  END ApplyFunc;

PROCEDURE NewProcTool(name: JunoAST.QId; in_cnt: CARDINAL;
  out_cnt, inout_cnt: CARDINAL := 0; isText: BOOLEAN): ArgTool =
  VAR
    num := in_cnt + out_cnt + inout_cnt;
    args := NewArgArray(num, ArgType.Click);
  BEGIN
    IF isText THEN args[num-1] := ArgType.Text END;
    RETURN NEW(ProcTool, name := name, argType := args,
      out_cnt := out_cnt, inout_cnt := inout_cnt, in_cnt := in_cnt)
  END NewProcTool;

PROCEDURE SetupProc(tl: ProcTool; <*UNUSED*> d: T;
    <*UNUSED*> time: VBT.TimeStamp) =
  BEGIN
    (* initialize "ProcTool" fields *)
    tl.txt := NIL; tl.call := NIL;
  END SetupProc;

<* SPEC ApplyProc REQUIRES sup(LL) = VBT.mu *>

PROCEDURE ApplyProc(tl: ProcTool; d: T; READONLY arg: ARRAY OF Arg) =

This is the default implementation of the apply method for procedure tools.

  BEGIN
    <* ASSERT d.root.astTrue *>
    IF tl.txt # NIL THEN
      (* This is a procedure whose last argument is a text *)
      tl.txt.val := d.stack[d.stackSize-1].text;
      DblBufferVBT.Restore(Filter.Child(d));
      tl.txt := NIL; tl.call := NIL
    END;
    IncrRunCmd(d, MakeCommand(tl, arg, byVal := TRUE));
    CurrCmd.AddCommand(d.root.ccmd, MakeCommand(tl, arg, byVal := FALSE));
    SourceUntrue(d, View.ModKind.ImplicitConsistent)
  END ApplyProc;

PROCEDURE IncrRunCmd(d: T; cmd: JunoAST.Cmd) =

Incrementally compile and run cmd, then annotate the current path and the point labels. Requires that cmd compiles without any errors.

  <* FATAL JunoCompileErr.Error *>
  VAR
    slot := JunoBuild.Cmd(cmd, CurrCmd.GetScope(d.root.ccmd));
    execRes: JunoRT.ExecRes;
  BEGIN
    execRes := JunoRT.ExecFromSlot(slot);
    IF execRes.trapCode # JunoRT.TrapCode.NormalHalt THEN
      JunoError.Display(d, JunoRT.TrapMessage(execRes))
    END;
    PaintPath(d);
    PaintPoints(d)
  END IncrRunCmd;

PROCEDURE TextProc(t: ProcTool; d: T; txt: TEXT) =
  <* LL.sup = VBT.mu *>
  VAR txtArg := txt & "|"; ch := Filter.Child(d); BEGIN
    IF t.txt = NIL THEN
      (* save partial arg on stack for subsequent call to "MakeCommand" *)
      d.stack[d.stackSize].text := txtArg;
      WITH args = SUBARRAY(d.stack, 0, d.stackSize+1) DO
        t.call := NEW(JunoAST.Save, bp := JunoAST.End,
          nm := JunoASTUtils.QIdFromText("PS"),
          body := MakeCommand(t, args, byVal := TRUE))
      END;
      t.txt := GetLastArg(t.call.body);
      DblBufferVBT.Save(ch);
    ELSE
      DblBufferVBT.Restore(ch);
      t.txt.val := txtArg   (* destructively change "t.call" *)
    END;
    IncrRunCmd(d, t.call);
    Sync(ch)
  END TextProc;

PROCEDURE GetLastArg(c: JunoAST.ProcCall): JunoAST.Expr =

Return the last IN argument of c. Requires that c has at least one IN parameter.

  VAR curr := c.ins.head; BEGIN
    WHILE curr.next # NIL DO curr := curr.next END;
    RETURN curr.expr
  END GetLastArg;

PROCEDURE NewRelTool(): ArgTool =
  BEGIN
    RETURN NEW(ArgTool, argType := NewArgArray(3, ArgType.Click),
      apply := ApplyRel)
  END NewRelTool;

<* SPEC ApplyRel REQUIRES sup(LL) = VBT.mu *>

PROCEDURE ApplyRel(<*UNUSED*> tl: Tool; m: T; READONLY arg: ARRAY OF Arg) =
  BEGIN
    CurrCmd.DoRel(m.root.ccmd, arg[0].name.id1,
      arg[1].name.id1, arg[2].name.id1);
    SourceUntrue(m, View.ModKind.ImplicitConsistent)
  END ApplyRel;

PROCEDURE NewRel1Tool(): ArgTool =
  BEGIN
    RETURN NEW(ArgTool, argType := NewArgArray(2, ArgType.Click),
      apply := ApplyRel1)
  END NewRel1Tool;

<* SPEC ApplyRel1 REQUIRES sup(LL) = VBT.mu *>

PROCEDURE ApplyRel1(<*UNUSED*> tl: Tool; m: T; READONLY arg: ARRAY OF Arg) =
  BEGIN
    CurrCmd.DoRel1(m.root.ccmd, arg[0].name.id1,
      arg[1].name.id1);
    SourceUntrue(m, View.ModKind.ImplicitConsistent)
  END ApplyRel1;

PROCEDURE NewFreezeTool(): ArgTool =
  BEGIN
    RETURN NEW(ArgTool, argType := NewArgArray(1, ArgType.Click),
      apply := ApplyFreeze)
  END NewFreezeTool;

<* SPEC ApplyFreeze REQUIRES sup(LL) = VBT.mu *>

PROCEDURE ApplyFreeze(<*UNUSED*> tl: Tool; m: T; READONLY arg: ARRAY OF Arg) =
  BEGIN
    CurrCmd.FreezePoint(m.root.ccmd, arg[0].name.id1);
    SourceUntrue(m, View.ModKind.ImplicitConsistent);
    PaintPoints(m)
  END ApplyFreeze;

PROCEDURE NewAdjustTool(): ArgTool =
  BEGIN
    RETURN NEW(ArgTool, argType := NewArgArray(1, ArgType.Drag),
      apply := ApplyAdjust);
  END NewAdjustTool;

PROCEDURE RoundToGrid(d: T; p: JunoPt.T): JunoPt.T =

If d's grid is not active, return p. Otherwise, return the grid point nearest to p.

  VAR x, y: JunoValue.Real; BEGIN
    IF NOT GridActive(d) THEN RETURN p END;
    EVAL JunoPt.RelVal(p.x, p.y, d.grid0.x, d.grid0.y,
      d.grid1.x, d.grid1.y, x, y);
    x := FLOAT(ROUND(x), JunoValue.Real);
    y := FLOAT(ROUND(y), JunoValue.Real);
    RETURN EvalRel(x, y, d.grid0, d.grid1)
  END RoundToGrid;

<* SPEC ApplyAdjust REQUIRES sup(LL) = VBT.mu *>

PROCEDURE ApplyAdjust(<*UNUSED*> tl: Tool; d: T; READONLY arg: ARRAY OF Arg) =
  VAR newLoc := RoundToGrid(d, arg[0].locUp); BEGIN
    Adjust(d, arg[0].name.id1, newLoc)
  END ApplyAdjust;

PROCEDURE Adjust(d: T; ptName: JunoAST.Id; READONLY ptLoc: JunoPt.T) =

Adjusts the point named ptName in the drawing d to the new location ptLoc. If the point is currently unfrozen, Juno temporarily freezes the point and runs the current command. If that does not succeed, the point is unfrozen again, and the current command is re-tried.

This procedure calls SourceUntrue(d), and displays any run-time error message. It also automatically adjusts the drawing's grid if the grid is active and ptName is one of the grid control points.

  VAR isFrozen := CurrCmd.IsFrozen(d.root.ccmd, ptName); res: TEXT; BEGIN
    IF NOT isFrozen THEN
      (* temporarily freeze the point *)
      CurrCmd.FreezePoint(d.root.ccmd, ptName)
    END;
    CurrCmd.MovePoint(d.root.ccmd, ptName, ptLoc.x, ptLoc.y);
    res := ExecCurrCmd(d, d.root.skipify);
    IF NOT isFrozen THEN
      (* point was originally unfrozen; unfreeze the point *)
      CurrCmd.FreezePoint(d.root.ccmd, ptName);
      (* run again if the command failed with the point frozen *)
      IF res # NIL THEN
        res := ExecCurrCmd(d, d.root.skipify)
      END
    END;
    Annotations(d);
    SourceUntrue(d, View.ModKind.ImplicitConsistent);
    DisplayError(d, res)
  END Adjust;

PROCEDURE NewGridTools(tb: VBT.Split; d: T): ArgTool =
  BEGIN
    d.toolBox := tb;
    d.gridOn := NEW(ArgTool, argType := NewArgArray(2, ArgType.Click),
      apply := ApplyGridOn);
    d.gridOff := NEW(ArgTool, argType := NewArgArray(0, ArgType.Click),
      apply := ApplyGridOff);
    RETURN d.gridOn
  END NewGridTools;

<* SPEC ApplyGridOn REQUIRES sup(LL) = VBT.mu *>

PROCEDURE ApplyGridOn(<*UNUSED*> tl: Tool; d: T; READONLY arg: ARRAY OF Arg) =
  BEGIN
    d.gridMode := TRUE;
    d.grid0 := arg[0].loc; d.grid0nm := arg[0].name;
    d.grid1 := arg[1].loc; d.grid1nm := arg[1].name;
    ToolBox.Unselect(d.root);
    ToolBox.SwapButton(d.toolBox, d.gridOn, d.gridOff, "Grid Off");
    PaintGrid(d);
    PaintBBox(d);
    PaintPoints(d);
    Sync(Filter.Child(d))
  END ApplyGridOn;

<* SPEC ApplyGridOff REQUIRES sup(LL) = VBT.mu *>

PROCEDURE ApplyGridOff(
    <*UNUSED*> tl: Tool;
    d: T;
    <*UNUSED*> READONLY arg: ARRAY OF Arg) =
  BEGIN
    ToolBox.SwapButton(d.toolBox, d.gridOff, d.gridOn, "Grid On");
    d.gridMode := FALSE;
    d.root.dTrue := FALSE; (* force exec to repaint drawing *)
    DisplayError(d, Exec(d));
    Sync(Filter.Child(d))
  END ApplyGridOff;

PROCEDURE NewSetTool(procNm: JunoAST.QId; arg: JunoAST.Expr): SetTool =
  VAR res := NEW(SetTool, argType := NEW(REF ARRAY OF ArgType, 0)); BEGIN
    res.cmd := NEW(JunoAST.ProcCall, bp := JunoAST.End,
      outs := JunoAST.EmptyQIdList, inouts := JunoAST.EmptyQIdList,
      name := procNm, ins := JunoASTUtils.NewExprList(arg));
    RETURN res
  END NewSetTool;

<* SPEC ApplySetTool REQUIRES sup(LL) = VBT.mu *>

PROCEDURE ApplySetTool(tl: SetTool; d: T;
    <*UNUSED*> READONLY arg: ARRAY OF Arg) =
  VAR cmd := Unqualify(tl.cmd, Editor.ModuleName(d.root.editor)); BEGIN
    CurrCmd.AddCommand(d.root.ccmd, cmd);
    IncrRunCmd(d, cmd);
    SourceUntrue(d, View.ModKind.ImplicitConsistent)
  END ApplySetTool;

PROCEDURE Unqualify(call: JunoAST.ProcCall; mod: Atom.T): JunoAST.Cmd =

Requires call to have one argument. This unqualifies any top-level qualified identifier in call whose qualifier is mod.

  BEGIN
    RETURN NEW(JunoAST.ProcCall, bp := JunoAST.End,
      outs := call.outs, inouts := call.inouts,
      name := UnqualifyQId(call.name, mod),
      ins := JunoASTUtils.NewExprList(UnqualifyQId(call.ins.head.expr, mod)))
  END Unqualify;

PROCEDURE UnqualifyQId(ex: JunoAST.Expr; mod: Atom.T): JunoAST.Expr =
  BEGIN
    TYPECASE ex OF
      JunoAST.QId (qid) =>
        IF qid.id0 # JunoAST.NilId AND qid.id0 = mod THEN
          RETURN NEW(JunoAST.QId, bp := JunoAST.End,
            id0 := JunoAST.NilId, id1 := qid.id1)
        END
    ELSE (* SKIP *)
    END;
    RETURN ex
  END UnqualifyQId;

PROCEDURE PopupMarquee(m: T) = BEGIN IF VBT.Parent(m.root.marquee) = NIL THEN VAR b := BorderedVBT.New( BorderedVBT.New(m.root.marquee, size := 3.0, op := PaintOp.Bg)); BEGIN VBTClass.Rescreen(b, VBT.ScreenTypeOf(m.root.source)); VAR sh := VBTClass.GetShapes(b); se := Rect.SouthEast(VBT.Domain(m.root.source)); BEGIN ZSplit.InsertAt(VBT.Parent(m.root.source), b, Point.MoveHV(se, -sh[Axis.T.Hor].pref - 10, -sh[Axis.T.Ver].pref - 10)); ZSplit.SetReshapeControl(b, ZSplit.ESChains) END END END END PopupMarquee;

PROCEDURE SourceUntrue(d: T; how: View.ModKind) =
  BEGIN
    d.root.source.modified(how);
    IF d.continuousUnparse THEN d.root.source.update() END
  END SourceUntrue;

PROCEDURE DisplayError(d: T; errmsg: TEXT) =
  <* LL.sup = VBT.mu *>
  BEGIN
    IF errmsg # NIL THEN
      VAR ch := Filter.Child(d.root.source); BEGIN
        JunoError.P(NARROW(ch, TextEditVBT.T).tp, errmsg)
      END
    END
  END DisplayError;

BEGIN
  HorToolSym  := Atom.FromText("_HOR");
  VerToolSym  := Atom.FromText("_VER");
  CongToolSym := Atom.FromText("_CONG");
  ParaToolSym := Atom.FromText("_PARA");
END Drawing.