Was JunoTop.mesa

HerculesBody USING
[MakeBody, EraseAllNames, NamePoint, NestAtoms],
HerculesSolver USING
[Solve, displayingMotions],
HerculesStorage,
HerculesImage,
HerculesAlgebra USING
[Se, Value, comma, colon, draw, print, leftPren, Cadr, Caddr,
Apply, globals, AddGlobalDef, UnnestAtoms, FunValRec, FunVal, GetDef],
HerculesSyntax USING [],
HerculesParseViewer USING [],
HerculesButtons,
Real USING [RoundI, FixI],
HerculesGraphics USING
[Hylite, DrawPattern, viewerChanged, cursorOffsetY, DrawChar,
DrawPoint, Blink, currentFont, currentPointSize, currentBold, currentItalic,
fontHeight, CharWidth, DrawRope, RopeBox, SetPaintMode, DcGetsPressContext,
GetNewFont, Whiten, PaintMe, DcGetsScreenContext],
Terminal USING [WaitForBWVerticalRetrace, Virtual, Current],
ViewerClasses USING
[NotifyProc, ModifyProc, DestroyProc, ViewerClass, Viewer,
ViewerClassRec],
ViewerOps USING [RegisterViewerClass, CreateViewer, PaintViewer],
ViewerTools USING [GetSelectionContents],
TIPUser USING [InstantiateNewTIPTable],
JunoKeyboard USING [Quit, x, y, Next, event, button, status, oldx, EnterAndNotify, char],
InputFocus USING [SetInputFocus],
Rope USING [ROPE, FromChar, Concat, Fetch, Length, Substr],
Carets USING [StartCaret, StopCaret],
Cursors USING [CursorArray, NewCursor, CursorType],
WindowManager USING [RestoreCursor],
Process USING [Detach],
Atom USING [GetPName, MakeAtom];

c is count of # of times point appeared on stack when it was pushed on stack; when a point is selected a second time it is hilighted differently.

BEGIN
IF p=NIL THEN SIGNAL NullPoint; --no point found
IF atop = amax THEN ERROR;
atop ← atop + 1; a[atop].p ← p; a[atop].c ← 1;
FOR i: INTEGER IN [1..atop - 1] DO
IF ABS[a[i].p.x - p.x] <= 1 AND ABS[a[i].p.y - p.y] <= 1
THEN a[atop].c ← a[atop].c + 1
ENDLOOP;
FlipLite [a[atop].p, a[atop].c]
END;

BEGIN
i: INTEGER;
IF atop = 0 THEN ERROR;
FlipLite [a[1].p, a[1].c];
FOR i IN [1 .. atop - 1] DO a[i] ← a[i + 1] ENDLOOP;
atop ← atop - 1
END;

BEGIN
IF p = NIL THEN SIGNAL NullPoint;
IF satop = amax THEN ERROR;
satop ← satop + 1; sa[satop].p ← p;
FlipLite [sa[satop].p, 0]
END;

BEGIN
i: INTEGER;
IF satop = 0 THEN ERROR;
FlipLite [sa[1].p, 0];
FOR i IN [1 .. satop - 1] DO sa[i] ← sa[i + 1] ENDLOOP;
satop ← satop - 1
END;

BEGIN
Gr.Hylite [Real.RoundI[p.x], Real.RoundI[p.y], c]
END;

BEGIN
p: PointPtr ← Im.image.points;
UNTIL atop = 0 DO Pop[] ENDLOOP;
UNTIL satop = 0 DO PopS[] ENDLOOP;
WHILE p # NIL DO
p.wn ← 0; p.mark ← FALSE;
p.copy ← NIL;
p ← p.link
ENDLOOP
END;

X, pencil, typewriter,
compass, parallels, tsquares (2),
snowman, move, copy, eraser,
Y.

BEGIN

cursor[5].y ← 620;
cursor[5].proc ← DrawCmd;
cursor[5].pattern ←
[4440B, 4440B, 4440B, 4440B, 4440B, 4440B, 4440B,
4440B, 4040B, 4040B, 2100B, 2100B, 1600B, 1600B, 400B, 400B];
cursor[5].cursorName ← Cursors.NewCursor [ bits: cursor[5].pattern,
hotX: -8, hotY: -16];

cursor[8].y ← 590;
cursor[8].proc ← TypeCmd;
cursor[8].pattern ←
[0,0,0,0, 17760B, 10020B, 10020B, 37770B, 40004B, 45244B,
100002B, 132532B, 100002B, 117762B, 40004B, 37770B];
cursor[8].cursorName ← Cursors.NewCursor [ bits: cursor[8].pattern,
hotX: -5, hotY: -4];

cursor[12].y ← 560;
cursor[12].proc ← XCmd;
cursor[12].pattern ←
[040001B, 020002B, 010004B, 004010B, 002020B, 001040B, 000500B, 000200B,
000500B, 001040B, 002020B, 004010B, 010004B, 020002B, 040001B,0];
cursor[12].cursorName ← Cursors.NewCursor[ bits: cursor[12].pattern,
hotX: -8, hotY: -8];

cursor[3].y ← 500;
cursor[3].proc ← HorCmd;
cursor[3].pattern ←
[0B, 0B, 20000B, 60000B, 60000B, 60000B, 160000B, 177777B,
177777B, 160000B,060000B, 060000B, 060000B, 020000B, 0b, 0b];
cursor[3].cursorName ← Cursors.NewCursor [ bits: cursor[3].pattern,
hotX: -9, hotY: -6];

cursor[2].y ← 470;
cursor[2].proc ← VerCmd;
cursor[2].pattern ←
[1700B, 17770B, 37774B, 600B, 600B, 600B, 600B,
600B, 600B, 600B, 600B, 600B, 600B, 600B, 600B, 600B];
cursor[2].cursorName ← Cursors.NewCursor [ bits: cursor[2].pattern,
hotX: -10, hotY: -9];

cursor[1].y ← 440;
cursor[1].proc ← CongCmd;
cursor[1].pattern ←
[4000B, 4000B, 6000B, 16000B, 13000B, 11000B, 31540B, 20700B, 23600B,
76200B, 40300B, 40100B, 140140B, 100040B, 100040B, 100000B];
cursor[1].cursorName ← Cursors.NewCursor [ bits: cursor[1].pattern,
hotX: 0, hotY: -16];

cursor[4].y ← 410;
cursor[4].proc ← ParaCmd;
cursor[4].pattern ←
[1040B, 1040B, 1040B, 1040B, 1040B, 1040B, 1040B, 1040B,
1040B, 1040B, 1040B, 1040B, 1040B, 1040B, 1040B, 1040B];
cursor[4].cursorName ← Cursors.NewCursor [ bits: cursor[4].pattern,
hotX: -7, hotY: -8]; --! fix the hot spot for this cursor

cursor[12].y ← 380;
cursor[12].proc ← PerpCmd;
cursor[12].pattern ←
[040000B, 060000B, 060000B, 050000B, 044000B, 044000B, 042000B, 041000B,
041000B, 040400B, 040200B, 040200B, 040100B, 040040B, 040040B, 077740B];
cursor[12].cursorName ← Cursors.NewCursor[ bits: cursor[12].pattern,
hotX: 0, hotY: 0];

cursor[7].y ← 320;
cursor[7].proc ← FreezeCmd;
cursor[7].pattern ←
[1700B, 1700B, 37774B, 4020B, 11110B, 10010B, 4020B, 3140B,
14030B, 20004B, 40002B, 40002B, 40002B, 20004B, 14030B, 3740B];
cursor[7].cursorName ← Cursors.NewCursor [ bits: cursor[7].pattern,
hotX: -9, hotY: -12];

cursor[10].y ← 290;
cursor[10].proc ← MoveCmd;
cursor[10].pattern ←
[0,0,0,40B, 160B, 370B, 774B, 1776B, 3777B, 370B,
370B, 370B, 370B, 370B, 370B, 370B];
cursor[10].cursorName ← Cursors.NewCursor [ bits: cursor[10].pattern,
hotX: -8, hotY: -3];

cursor[9].y ← 260;
cursor[9].proc ← CopyCmd;
cursor[9].pattern ←
[40B, 120B, 210B, 444B, 1162B, 3373B, 774B, 1776B, 3777B, 370B,
370B, 370B, 370B, 370B, 370B, 370B];
cursor[9].cursorName ← Cursors.NewCursor [ bits: cursor[9].pattern,
hotX: -8, hotY: 0];

cursor[6].y ← 230;
cursor[6].proc ← EraseCmd;
cursor[6].pattern ←
[4440B, 4440B, 4440B, 4440B, 4440B, 4440B, 4440B, 7740B,
4040B, 4040B, 4040B, 4040B, 4040B, 4040B, 4040B, 3700B];
cursor[6].cursorName ← Cursors.NewCursor [ bits: cursor[6].pattern,
hotX: -8, hotY: -16];

cursor[11].y ← 200;
cursor[11].proc ← YCmd;
cursor[11].pattern ←
[040001B, 020002B, 010004B, 004010B, 002020B, 001040B, 000500B, 000200B,
000200B, 000200B, 000200B, 000200B, 000200B, 000200B, 000200B,0];
cursor[11].cursorName ← Cursors.NewCursor [ bits: cursor[11].pattern,
hotX: 8, hotY: 8];

END;

BEGIN
i: INTEGER;
FOR i IN [1..numCursors]
DO
  Gr.DrawPattern[cursor[i].pattern, cursorLine, cursor[i].y];
ENDLOOP;
Gr.viewerChanged ← TRUE
END;

BEGIN
-- Continuously updates the top of the primary or secondary stack to the
-- image point that is closed to the current mouse coordinates, until the mouse
-- button is released.
-- If primary=TRUE tracks the top of the primary selection stack (middle button).,
-- If primary=FALSE tracks the secondary selection, and considers only points
-- within the blue baloon (i.e. with nonzero winding number).
x, y: INTEGER;
p: PointPtr;

Kbd.Next[];
DO
Kbd.Next[];
IF Kbd.event = clickUp AND Kbd.button = (IF primary THEN yellow ELSE blue)
THEN RETURN;
IF Kbd.event = roll THEN
{[x, y] ← HotCoords[];
p ← Im.FindPoint [x: x, y: y, wound: NOT primary];
IF primary THEN
{IF p # a[atop].p THEN
{FlipLite [a[atop].p, a[atop].c];
atop ← atop - 1; Push[p]}}
ELSE
{IF p # sa[satop].p THEN
{FlipLite [sa[satop].p, 0];
satop ← satop - 1; PushS[p]}}};
ENDLOOP
END;

BEGIN
-- 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.

prevx, prevy: INTEGER;

NextBaloonPoint: Im.NextPointProc =

-- body of procedure TrackBlueBaloon:
[prevx, prevy] ← HotCoords[]; -- starting point of loop is current mouse position
Gr.DrawChar['., prevx, prevy];

Im.BaloonSelect[prevx, prevy, NextBaloonPoint];
END;

BEGIN

e: Event;
x, y: INTEGER;

DropCursor: PROC =
BEGIN
-- UserTerminal.SetCursorPattern[arrowCursor];
HerculesClass.cursor ← pointRight;
WindowManager.RestoreCursor;
currentCursor ← 0;
ClearSelectedPoints[]
END;

PickUpCursor: PROC =
BEGIN
i : INTEGER ← 1;
champ: INTEGER ← 5; -- five is the pencil cursor index
UNTIL i > numCursors DO
IF ABS[y - cursor[i].y+8] < ABS[y - cursor[champ].y+8] THEN champ ← i;
i ← i + 1
-- each cursor has a height of 30 pixels; boundary is 15 above & 15 below.
--cursor[i].y is top left corner of icon. Drop it to the center of the icon
ENDLOOP;
currentCursor ← champ;
HerculesClass.cursor ← cursor[currentCursor].cursorName;
WindowManager.RestoreCursor;
END;

WaitForCrossRight: PROC =
BEGIN
DO [e, x, y] ← NextEvent[]; IF e = crossright THEN RETURN ENDLOOP
END;

Kbd.Next[];
DO
ENABLE {ABORTED => LOOP; Quit => {viewerDead ← TRUE; EXIT}};
DropCursor[];
WaitForCrossRight[];
PickUpCursor[];
cursor[currentCursor].proc[];
ENDLOOP

END;

BEGIN
-- The procedure call NextEvent[] returns one of the tokens left, middle, right, escape,
-- crossleft, crossright.
-- Also returns hot coordinates of cursor at time of click
DO
Kbd.Next[]; [x, y] ← HotCoords[];
SELECT TRUE FROM
Kbd.event = roll AND Kbd.x <= cursorLine AND Kbd.oldx > cursorLine
=> {e ← crossleft};
Kbd.event = roll AND Kbd.x > cursorLine AND Kbd.oldx <= cursorLine
=> {e ← crossright};
Kbd.event = clickDown AND Kbd.button = red
=> {e ← left};
Kbd.event = clickDown AND Kbd.button = yellow
=> {e ← middle};
Kbd.event = clickDown AND Kbd.button = blue
=> {e ← right};
Kbd.event = keyDown AND Kbd.char = 33C
=> {e ← esc};
Kbd.event = keyDown AND Kbd.char = 11C
=> {e ← tab};
Kbd.event = keyDown AND Kbd.char = 10C
=> {e ← backspace};
Kbd.event = keyDown AND Kbd.char = 15C
=> {e ← cr};
Kbd.event = keyDown
AND Kbd.char # 33C AND Kbd.char # 11C
AND Kbd.char # 10C AND Kbd.char # 15C
=> {e ← keyboard};
ENDCASE => LOOP;
RETURN
ENDLOOP
END;

BEGIN
p ← Stor.NewPoint[x, y, TRUE];
Im.AddPoint[p];
Gr.DrawPoint [x,y]
END;

BEGIN
bluBalloon: BOOLEAN ← baloonSel;
p: PointPtr;
xE, yE: INTEGER;
event: Event;
InputFocus.SetInputFocus [self];
DO
[event, xE, yE] ← NextEvent[];
SELECT event FROM
left =>
{IF maxPrim >0 THEN
{Push[AddVisiblePoint[xE, yE]];
WHILE atop > maxPrim DO Pop[] ENDLOOP}};
middle =>
{p ← Im.FindPoint[x: xE, y: yE, wound: FALSE];
IF p # NIL AND maxPrim > 0 THEN
{Push[p];
TrackTopPoint[primary: TRUE];
WHILE atop > maxPrim DO Pop[] ENDLOOP}};
right =>
{IF bluBalloon THEN
{UNTIL satop = 0 DO PopS[] ENDLOOP;
TrackBlueBaloon[];
IF Im.AnyWoundPoints[] THEN
{bluBalloon ← FALSE}
ELSE
{Refresh[]}}
ELSE
{IF maxSec > 0 THEN
{p ← Im.FindPoint[x: xE, y: yE, wound: TRUE];
IF p # NIL THEN
{PushS[p];
TrackTopPoint[primary: FALSE];
WHILE satop > maxSec DO PopS[] ENDLOOP}}}};
esc, tab =>
{ProcessPoints[event];
WHILE atop > 0 AND atop # nLeave DO Pop[] ENDLOOP;
WHILE satop > 0 DO PopS[] ENDLOOP;
IF solve AND event = esc THEN
{DoSolve[]; Refresh[]}
ELSE IF refresh THEN
{Refresh[]}};
crossright =>
{};
crossleft =>
RETURN;
ENDCASE => {}
ENDLOOP
END;

BEGIN
Im.AddAction[Stor.NewAction[op: op, arg: arg]];
IF doIt THEN [] ← Alg.Apply [function: op, arg: arg, alist: NIL, mode: effect]
END;

BEGIN

DrawThem: PointProcessingProc =
BEGIN
IF atop = 3 OR atop = 1 THEN Pop[];
IF atop = 0 THEN
{RETURN}
ELSE
{AddNewAction
[op: Alg.draw,
arg: IF atop = 2
THEN LIST[LIST[a[1].p, a[2].p]]
ELSE LIST[LIST[a[1].p, a[2].p, a[3].p, a[4].p]],
doIt: TRUE]}
END;

GeneralCmd
[maxPrim: 4, maxSec: 0, nLeave: 1, baloonSel: FALSE,
ProcessPoints: DrawThem]
END;

BEGIN

CongThem: PointProcessingProc =
BEGIN
IF atop # 4 THEN
{WHILE atop > 0 DO Pop[] ENDLOOP; RETURN}
ELSE
{Im.AddConstr[Stor.NewCong[a[1].p, a[2].p, a[3].p, a[4].p]]}
END;

GeneralCmd
[maxPrim: 4, maxSec: 0, nLeave: 2, baloonSel: FALSE,
ProcessPoints: CongThem, solve: TRUE]
END;

BEGIN

ParaThem: PointProcessingProc =
BEGIN
IF atop # 4 THEN
{WHILE atop > 0 DO Pop[] ENDLOOP; RETURN}
ELSE
{Im.AddConstr[Stor.NewPara[a[1].p, a[2].p, a[3].p, a[4].p]]}
END;

GeneralCmd
[maxPrim: 4, maxSec: 0, nLeave: 2, baloonSel: FALSE,
ProcessPoints: ParaThem, solve: TRUE]
END;

BEGIN

PerpThem: PointProcessingProc =
BEGIN
IF atop # 4 THEN
{WHILE atop > 0 DO Pop[] ENDLOOP; RETURN}
ELSE
{Im.AddConstr[Stor.NewPerp[a[1].p, a[2].p, a[3].p, a[4].p]]}
END;

GeneralCmd
[maxPrim: 4, maxSec: 0, nLeave: 2, baloonSel: FALSE,
ProcessPoints: PerpThem, solve: TRUE]
END;

BEGIN

HorThem: PointProcessingProc =
BEGIN
IF atop # 2 THEN
{WHILE atop > 0 DO Pop[] ENDLOOP; RETURN}
ELSE
{Im.AddConstr[Stor.NewHor[a[1].p, a[2].p]]}
END;

GeneralCmd
[maxPrim: 2, maxSec: 0, nLeave: 1, baloonSel: FALSE,
ProcessPoints: HorThem, solve: TRUE]
END;

BEGIN

VerThem: PointProcessingProc =
BEGIN
IF atop # 2 THEN
{WHILE atop > 0 DO Pop[] ENDLOOP; RETURN}
ELSE
{Im.AddConstr[Stor.NewVer[a[1].p, a[2].p]]}
END;

GeneralCmd
[maxPrim: 2, maxSec: 0, nLeave: 1, baloonSel: FALSE,
ProcessPoints: VerThem, solve: TRUE]
END;

BEGIN

DeleteThem: PointProcessingProc =
{Im.DeleteWoundItems[]};

GeneralCmd
[maxPrim: 0, maxSec: 0, nLeave: 0, baloonSel: TRUE,
ProcessPoints: DeleteThem, solve: TRUE]
END;

BEGIN

xE, yE: INTEGER;
event: Event;
p: PointPtr;
WHILE p # NIL DO
IF p.fixed THEN FlipLite [p, 1];
p ← p.link;
ENDLOOP;

InputFocus.SetInputFocus [self];
DO
[event, xE, yE] ← NextEvent[];
SELECT event FROM
middle =>
{p ← Im.FindPoint[x: xE, y: yE, wound: FALSE];
IF p # NIL THEN
{p.fixed ← NOT p.fixed;
FlipLite [p, 1]}};
crossleft =>
{p ← Im.image.points;
WHILE p # NIL DO
IF p.fixed THEN FlipLite [p, 1];
p ← p.link;
ENDLOOP;
RETURN};
ENDCASE => {}
ENDLOOP
END;

BEGIN

MoveThem: PointProcessingProc =
BEGIN
IF satop = 0 AND atop > 1 THEN
{UNTIL atop = 2 DO Pop[] ENDLOOP;
PushS[a[1].p];
Pop[];
sa[1].p.wn ← 1};
MovePointsInBaloon[solve: event = esc];
END;

GeneralCmd
[maxPrim: 3, maxSec: 3, nLeave: 0, baloonSel: TRUE,
ProcessPoints: MoveThem, refresh: TRUE]

END;

BEGIN

CopyThem: PointProcessingProc =
BEGIN
n: INTEGER = MIN[atop,satop];
p: PointPtr;

-- Copy points, constraints and actions in baloon.

Im.CopyWoundItems[];

-- Im.CopyWoundItems should
-- a) copy the points with wn#0 (& attached constraints &actions);
-- b) add the copies to Im.imageXXX,
-- c) set the copy link of the originals to the copies,
-- d) set the coppy 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 the selected frame points by their copies

FOR i: INTEGER IN [0.. n-1] DO
sa[satop-i].p ← sa[satop-i].p.copy
ENDLOOP;

-- Now reset copy links of all original points
p ← Im.image.points;
WHILE p # NIL DO
IF p.wn = 0 THEN p.copy ← NIL; p ← p.link
ENDLOOP;

-- Now do a MoveCmd on the copies
MovePointsInBaloon[solve: event = esc];
END;

GeneralCmd
[maxPrim: 3, maxSec: 3, nLeave: 0, baloonSel: TRUE,
ProcessPoints: CopyThem, refresh: TRUE]

END;

BEGIN
n: INTEGER = MIN[atop,satop];
singular: BOOL ← FALSE;
ap, bp, cp, sap, sbp, scp: PointPtr ← NIL;
WHILE atop > n DO Pop[] ENDLOOP;
WHILE satop > n DO PopS[] ENDLOOP;
IF n>0 THEN
{ap ← a[atop].p; sap ← sa[satop].p;
IF n>2 THEN {cp ← a[atop-2].p; scp ← sa[satop-2].p};
IF n>1 THEN {bp ← a[atop-1].p; sbp ← sa[satop-1].p}}
ELSE
{Gr.Blink["You must specify at least one pair of points"]; RETURN};
-- Transform the coordinates of points in baloon
singular ← Im.MoveWoundPoints[source: [sap, sbp, scp], dest: [ap, bp, cp]];
IF singular THEN
{Gr.Blink["No such affine transformation"]; RETURN};
IF solve THEN
{-- temporarily freeze the points on the destination frame
-- Should remove them from the list of points passed to the solver!
FOR i: INTEGER IN [0..n-1] DO
a[atop-i].p.fixed ← TRUE
ENDLOOP;
HerculesClass.cursor ← hourGlass;
WindowManager.RestoreCursor;
[] ← Solv.Solve[Im.image.points, Im.image.constrs];
HerculesClass.cursor ← cursor[currentCursor].cursorName;
WindowManager.RestoreCursor;
-- Unfreeze the points on the destination frame
FOR i: INTEGER IN [0..n-1] DO
a[atop-i].p.fixed ← FALSE
ENDLOOP};
Im.SortPoints[]
END;

BEGIN
event: Event;
p: PointPtr;
xE, yE: INTEGER;
waitingForClick: BOOL ← TRUE;
myRope: ROPE ← NIL;
xw, yw: REAL;
xCaretBase, xCaret, yCaret, len: INTEGER;
yOffset: INTEGER = Real.FixI[Gr.cursorOffsetY];
InputFocus.SetInputFocus [self];
DO
[event, xE, yE] ← NextEvent[];
SELECT event FROM
left, middle =>
{IF waitingForClick THEN
{IF event = left THEN
{p ← Stor.NewPoint[xE, yE];
Im.AddPoint[p]}
ELSE
{p ← Im.FindPoint[x: xE, y: yE, wound: FALSE]};
IF p # NIL THEN
{waitingForClick ← FALSE;
xCaretBase ← xCaret ← Real.FixI[p.x];
yCaret ← Real.FixI[p.y];
Carets.StartCaret [self, xCaret, yCaret + yOffset, primary]}}};
cr =>
{IF NOT waitingForClick THEN
{AddNewAction
[op: Alg.print,
arg: LIST
[p,
myRope,
Gr.currentFont,
NEW[INT ← Gr.currentPointSize],
NEW[INT ← (IF Gr.currentBold THEN 2 ELSE 0)
+ (IF Gr.currentItalic THEN 1 ELSE 0)]],
doIt: FALSE];
Carets.StopCaret[primary];
xCaret ← xCaretBase; yCaret ← yCaret - Gr.fontHeight;
p ← Stor.NewPoint[p.x, p.y - Gr.fontHeight];
Im.AddPoint[p];
Carets.StartCaret [self, xCaret, yCaret + yOffset, primary];
myRope ← NIL;
}};
keyboard =>
{IF NOT waitingForClick THEN
{Gr.DrawChar [Kbd.char, xCaret, yCaret];
[xw, yw] ← Gr.CharWidth [Kbd.char];
xCaret ← xCaret + Real.FixI [ xw ];
Carets.StopCaret[primary];
Carets.StartCaret [ self, xCaret, yCaret + yOffset, primary];
-- concatenate the new character onto
myRope ← Concat[myRope, FromChar[Kbd.char] ]}};
backspace =>
{IF NOT waitingForClick THEN
{len ← Rope.Length [myRope];
IF len # 0 THEN
BEGIN
[xw, yw] ← Gr.CharWidth [Fetch[myRope, len - 1]];
xCaret ← xCaret - Real.FixI [xw]; -- doesn't unpaint char yet --
Gr.DrawChar [Fetch[myRope, len - 1], xCaret, yCaret];
-- now it is unpainted --
Carets.StopCaret[primary];
Carets.StartCaret [ self, xCaret, yCaret + yOffset, primary];
myRope ← Substr [ myRope, 0, len - 1]
END}};
crossright =>
{};
crossleft, esc =>
{IF NOT waitingForClick THEN
{IF myRope = NIL THEN
{IF oldRope # NIL THEN
{xmin, ymin, xmax, ymax: REAL;
Gr.DrawRope [oldRope, xCaret, yCaret];
Carets.StopCaret[primary];
[xmin, ymin, xmax, ymax] ← Gr.RopeBox[myRope];
xCaret ← xCaret + Real.FixI [ xmax - xmin ];
Carets.StartCaret [ self, xCaret, yCaret + yOffset, primary];
myRope ← oldRope}};
IF myRope # NIL THEN
{AddNewAction
[op: Alg.print,
arg: LIST
[p,
myRope,
Gr.currentFont,
NEW[INT ← Gr.currentPointSize],
NEW[INT ← (IF Gr.currentBold THEN 2 ELSE 0)
+ (IF Gr.currentItalic THEN 1 ELSE 0)]],
doIt: TRUE]}};
Carets.StopCaret[primary];
-- save oldRope in case user just hits ESC (or CR) next time
oldRope ← myRope;
IF event = crossleft THEN RETURN};
ENDCASE => {}
ENDLOOP
END;

BEGIN

YThem: PointProcessingProc =
BEGIN
IF satop > 1 THEN
BEGIN

AssignParmNames: PROC RETURNS [names: LIST OF ATOM] =
BEGIN
-- Assigns names to all secondary selections.
-- Also builds a list of the assigned names, in the Juno S-expression format.
Body.EraseAllNames[];
names ← NIL;
FOR i: INT DECREASING IN [1..satop] DO
names ← CONS[Body.NamePoint[sa[i].p, i], names]
ENDLOOP
END;

org: PointPtr = sa[1].p;
xP: PointPtr = IF satop<2 THEN NIL ELSE sa[2].p;
yP: PointPtr = IF satop<3 THEN NIL ELSE sa[3].p;
parms: LIST OF ATOM = AssignParmNames[];
body: Alg.Se = Body.MakeBody[[org, xP, yP], satop];
funVal: Alg.FunVal = NEW [Alg.FunValRec ← [parms, body]];
defSe: Se = LIST
[Alg.is, defaultProcName,
LIST [Alg.leftParen,
LIST [Alg.colon, Body.NestAtoms[parms, Alg.comma, NIL], body]]];
Alg.AddGlobalDef[name: defaultProcName, value: funVal];
-- (<is> <name> (leftParen (<colon> <parms> <body>))),
--
PView.AddExpr [defSe, PView.viewer]
END
ELSE
{Gr.Blink["Right-select at least one parameter"]}
END;

GeneralCmd
[maxPrim: 0, maxSec: amax, nLeave: 0, baloonSel: TRUE,
ProcessPoints: YThem, refresh: FALSE]

END;

BEGIN

ConsPointList: PROC [i, atop: INT] RETURNS [LIST OF REF] =

valOfX: Alg.Value = Alg.GetDef[nameOfX, Alg.globals];

IF ISTYPE[valOfX, Alg.FunVal] AND valOfX # NIL THEN
BEGIN
funVal: Alg.FunVal = NARROW [valOfX];
nParms: INTEGER ← 0;

XThem: PointProcessingProc =
BEGIN
IF atop # nParms THEN
{Gr.Blink["Too few arguments!"]}
ELSE
{arg: Alg.Value ← ConsPointList[1, atop];
Gr.SetPaintMode[opaque];
AddNewAction[op: nameOfX, arg: arg, doIt: TRUE]; 
Gr.SetPaintMode[invert];
Gr.viewerChanged ← TRUE;
Im.SortPoints[]};
END;

p: LIST OF ATOM ← funVal.parms;
WHILE p # NIL DO nParms ← nParms + 1; p ← p.rest ENDLOOP;

-- #@#!$#%!!! Can't do nParms ← List.Length[funVal.parms] just because
-- it is LIST OF ATOM instead of LIST OF REF ANY!

GeneralCmd
[maxPrim: nParms, maxSec: 0, nLeave: 0, baloonSel: FALSE,
ProcessPoints: XThem, refresh: FALSE]
END
ELSE
{Gr.Blink
["Procedure ",
Atom.GetPName[nameOfX],
" not defined; Parse or LoadX again!"]}
END;

BEGIN
r: ROPE ← ViewerTools.GetSelectionContents[];
nameOfX ← Atom.MakeAtom[r];
IF Alg.GetDef[nameOfX, Alg.globals] = NIL THEN
{Gr.Blink["Warning: not defined - try Parse"]}
END;

BEGIN
succ, imp: BOOL;
HerculesClass.cursor ← hourGlass;
WindowManager.RestoreCursor;
[succ, imp] ← Solv.Solve[Im.image.points, Im.image.constrs];
IF NOT succ
THEN Gr.Blink["The solver failed"];
Im.SortPoints[];
HerculesClass.cursor ← cursor[currentCursor].cursorName;
WindowManager.RestoreCursor
END;

BEGIN
DoSolve[];
ClearSelectedPoints[];
Refresh[]
END;

BEGIN
Gr.DcGetsPressContext[filename];
screenOnly ← FALSE;
Refresh[];
Gr.Blink["press file created: ", filename];
Gr.DcGetsScreenContext[];
screenOnly ← TRUE;
END;

BEGIN
Gr.currentFont ← font;
Gr.currentPointSize ← pointSize;
Gr.currentBold ← bold;
Gr.currentItalic ← italic;
Gr.GetNewFont[]
END;

BEGIN
Solv.displayingMotions ← NOT Solv.displayingMotions;
END;

BEGIN
Im.PurgeImage [];
--! need to add a proc to junokeyboardimpl which empties the queue.
--! i.e. queueRight = queueLeft & broadcast nonfull
Refresh[];
END;

BEGIN
list: LIST OF Se;
error: BOOL;
saveGlobals: Alist ← Im.globals;
Im.globals ← Im.basicGlobals; -- definitions in the Proc file may use only standard globals
[list, error] ← PView.ParseViewer[PView.viewer];
IF error THEN {Gr.Blink["Parse error"]; RETURN};
-- list is a list of definitions ((<is> <name> <value>) (<is> <name> <value>) ...)
-- The values are all valid definitions.
WHILE list # NIL DO
{expr: Se ← list.first;
name: ATOM = NARROW [Alg.Cadr[Se]];
valex: Se = Alg.Caddr[Se];
-- creates a FunVal.
value: Alg.Value = Alg.Eval[valex, NIL, result];
saveGlobals ← Alg.InsertDef [name, value, saveGlobals]};
list ← list.rest
ENDLOOP;
Im.globals ← saveGlobals;
Refresh[]
END;

BEGIN
viewer: PView.ParseViewer = PView.viewer;
PView.AddText[viewer, "CommandName is (Args:\n Body)\n"]
END;

BEGIN
PView.SetFile[PView.viewer, fileName];
Parse[]
END;

BEGIN
i:INTEGER;
--
Gr.Whiten[];
Gr.SetPaintMode[opaque];
IF screenOnly THEN RefreshCursors[];
RefreshActions[];
RefreshPoints[];
Gr.SetPaintMode[invert];
FOR i IN [1..atop] DO FlipLite [a[i].p, a[i].c] ENDLOOP;
FOR i IN [1..satop] DO FlipLite [sa[i].p, 0] ENDLOOP;
Gr.viewerChanged ← TRUE;
END;

BEGIN
p: PointPtr ← Im.image.points;
WHILE p # NIL DO
IF p.visible THEN Gr.DrawPoint[Real.FixI[p.x], Real.FixI[p.y]];
p ← p.link
ENDLOOP;
END;

BEGIN
pp: ActionPtr ← Im.image.actions.first;
WHILE pp # NIL DO
[] ← Alg.Apply[pp.op, pp.arg, NIL, effect];
pp ← pp.link
ENDLOOP
END;

BEGIN
DO
IF viewerDead THEN EXIT;
BEGIN
t: Terminal.Virtual = Terminal.Current[];
Terminal.WaitForBWVerticalRetrace [t]; --! Should there be one instead of two calls?
Terminal.WaitForBWVerticalRetrace [t]
END;
IF Gr.viewerChanged THEN
{ViewerOps.PaintViewer [viewer: self, hint: client, clearClient: FALSE];
Gr.viewerChanged ← FALSE}
ENDLOOP
END;

TRUSTED
BEGIN
Kbd.EnterAndNotify [self, input]
END;

TRUSTED
BEGIN
END;

TRUSTED
BEGIN
input : LIST OF REF ANY ← LIST[$Destroy];
IF NOT self.iconic THEN InputFocus.SetInputFocus [self];
Kbd.EnterAndNotify [self, input]
END;

← NEW [ViewerClasses.ViewerClassRec ← [
paint: Gr.PaintMe, --called whenever the viewer should repaint
notify: NotifyMe, --TIP input events
destroy: DestroyMe,
modify: InputFocusChanged, --InputFocus changes reported through here
tipTable: TIPUser.InstantiateNewTIPTable["Juno.Tip"],
-- cursor: questionMark
cursor: cursor[currentCursor].cursorName
--currentCursor is initialized to 5, so default cursor is pencil
] ];

-- Added tioga formatting

-- Changed Y command to accept more than two parameters

changes to: YCmd, AlgebraStep (deleted), OtherAlgebraStep (deleted), GeneralAlgebraStep (new), MakeParmsList (new)

-- Added Tioga node structure

-- Extended YCmd to accept more than two arguments

changes to: YCmd, GeneralAlgebraStep (replaces AlgebraStep and OtherAlgebraStep), mat (new global work matrix), MoveStep (removed a piece to Body)

-- More formatting changes

changes to: LoadX Added a return in case of error, JunoClass, self

changes to: , RefreshXR, StartOver, CollinearCmd, Refresh, RefreshItems, NotifyMe, OPEN, PointPtr, ClearSelectedPoints, TrackPoint, NewPoint, PencilCmd, CongruentCmd, YCmd, GeneralAlgebraStep, HorizontalCmd, VerticalCmd, FreezeCmd, typeWriterState, LoadX, XCmd, AddLambda, MoveStep, MoveCmd, UnSelected, CopyCmd, TrackLoop, RefreshPoints, Parse, InitJunoStorage, amax

changes to: InitCursors, RefreshCursors, MainLoop, WaitForCrossRight, Next, DropCursor, Push, Pop, PushS, PopS, ClearSelectedPoints, PickUpCursor, TrackPoint, TrackSelectedPoint, NewPoint, PencilCmd, CongruentCmd, CollinearCmd, YCmd, GeneralAlgebraStep, HorizontalCmd, VerticalCmd, FreezeCmd, TypeCmd, EraseCmd, LoadX, XCmd, ConsPointList, AddLambda, MoveStep, MoveCmd, UnSelected, CopyCmd, TrackLoop, Redisplay, CopyToViewer, Refresh, RefreshPoints, RefreshItems, DestroyMe, JunoClass, Hardcopy, ChangeFont, StartOver, Parse, NewProc, ProcFile, ArgListLength

changes to: DisplayMotion (new button - toggles Solv.displayingMotions), Redisplay (accepts impossible return parameter from solver)

-- Propagated changes due to HerculesStorage, HerculesImage
-- Removed slink field from Points
-- Cleaned up code

changes to: UnSelected (deleted), AddVisiblePoint (new - replaces NewPoint), FindPoint (moved here from JunoStorage; combined with FindSelectedPoint), GeneralCmd (new), TrackTopPoint (replaces TrackPoint and TrackSelectedPoint), TrackBlueBaloon (renames TrackLoop), image (made local to this module)

-- Changed more interface names to hercules XXX

changes to:

changes to: MovePointsInBaloon (moved a piece to HerculesImage as MoveWoundPoints) , Car, Cdr, Cadr, Caddr (moved to HerculesStorage), TrackBlueBaloon (modified to use BaloonSelect of HerculesImage), AnyPointsInBaloon (moved to HerculesImage), Parse (alist change, added refresh), LoadX (alist change), XCmd (default proc name is $X, alist change), YCmd (alist change)

changes to: DoSolve (new, was part of Redisplay), GenCmd (added solve option), ClearSelectedPoints (clears also mark, copy and tempfixed),

changes to: a, sa (removed x, y components; use p.x, p.y instead), GenCmd (fixed bugs), xhot, yhot (removed), cursor (removed xhot, yhot components), InitCursors (added perp cursor), AddNewAction (new), DrawCmd, TypeCmd, XCmd (use AddNewAction),