-- junoTop.mesa
-- coded May 1981 by Greg Nelson

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

-- 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 11:22 am

DIRECTORY JunoBody, OldJunoSolver, JunoStorage,
JunoAlgebra, Real, List, JunoGraphics,
Terminal, ViewerClasses, ViewerOps, ViewerTools, TIPTables, TIPUser, JunoKeyboard,
InputFocus, Rope, Carets, Menus,
Cursors, WindowManager, Process, JunoButtons, OldJunoParserEtc,
OldParseWindow, Atom;


JunoTop: PROGRAM IMPORTS JunoStorage, Real,
Terminal, JunoBody, OldJunoSolver, JunoGraphics,
JunoAlgebra, Carets, Rope,
ViewerOps, ViewerTools, TIPUser, JunoKeyboard, InputFocus,
Cursors, WindowManager,
Process, OldJunoParserEtc, Atom,
OldParseWindow
    EXPORTS JunoButtons =

BEGIN OPEN JunoSolver: OldJunoSolver, JunoBody, JunoStorage, jkb: JunoKeyboard,
JG: JunoGraphics, JA: JunoAlgebra, PW: OldParseWindow, Rope,
JunoParserEtc: OldJunoParserEtc;

debug1, debug2: BOOL ← FALSE; -- can be set by BugBane to avoid debug output
screenOnly: BOOL ← TRUE;


xhot: INTEGER ← 0;
yhot: INTEGER ← 0; -- displacement to hot spot of current cursor. 0,0 means upper left.
-- the Cursors interface uses the upper left corner as origin, and
-- counts positive x to the left, positive y straight up.

numCursor: INTEGER ← 12; -- compass, tsquares (2), snowman, straightedge, move, copy,
-- typewriter, pencil, eraser, and X and Y.

cursorArrayHeight: INTEGER = 300; -- 10 cursors @ 30 pixels each

cursor: ARRAY [1..20] OF
RECORD [y: INTEGER, pattern:Cursors.CursorArray, proc:PROC,
xhot, yhot: INTEGER, cursorName: Cursors.CursorType];

-- arrowCursor: UserTerminal.CursorArray =
-- [10B, 4B, 2B, 177777B, 2B, 4B, 10B, 0,0,0,0,0,0,0,0,0];


InitCursors: PROC =

{cursor[1].y ← 410;
cursor[1].proc ← CongruentCmd;
cursor[1].xhot ← 0;
cursor[1].yhot ← -16;
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: cursor[1].xhot, hotY: cursor[1].yhot];


cursor[2].y ← 440;
cursor[2].proc ← VerticalCmd;
cursor[2].xhot ← -10;
cursor[2].yhot ← -9;
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: cursor[2].xhot, hotY: cursor[2].yhot];


cursor[3].y ← 470;
cursor[3].proc ← HorizontalCmd;
cursor[3].xhot ← -9;
cursor[3].yhot ← -6;
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: cursor[3].xhot, hotY: cursor[3].yhot];


cursor[4].y ← 380;
cursor[4].proc ← CollinearCmd;
cursor[4].xhot ← -8; --! fix the hot spot for this cursor
cursor[4].yhot ← -4;
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: cursor[4].xhot, hotY: cursor[4].yhot];


cursor[5].y ← 590;
cursor[5].proc ← PencilCmd;
cursor[5].xhot ← -8;
cursor[5].yhot ← -16;
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: cursor[5].xhot, hotY: cursor[5].yhot];

cursor[6].y ← 230;
cursor[6].proc ← EraseCmd;
cursor[6].xhot ← -8;
cursor[6].yhot ← -16;
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: cursor[6].xhot, hotY: cursor[6].yhot];


cursor[7].y ← 320;
cursor[7].proc ← FreezeCmd;
cursor[7].xhot ← -9;
cursor[6].yhot ← -12;
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: cursor[7].xhot, hotY: cursor[7].yhot];


cursor[8].y ← 560;
cursor[8].proc ← TypeCmd;
cursor[8].xhot ← -5;
cursor[7].yhot ← -4;
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: cursor[8].xhot, hotY: cursor[8].yhot];


cursor[9].y ← 260;
cursor[9].proc ← CopyCmd;
cursor[9].xhot ← -8;
cursor[8].yhot ← 0;
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: cursor[9].xhot, hotY: cursor[9].yhot];


cursor[10].y ← 290;
cursor[10].proc ← MoveCmd;
cursor[10].xhot ← -8;
cursor[9].yhot ← -3;
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: cursor[10].xhot, hotY: cursor[10].yhot];


cursor[11].y ← 200;
cursor[11].proc ← YCmd;
cursor[11].xhot ← 8 ; cursor[11].yhot ← 8 ;
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: cursor[11].xhot, hotY: cursor[11].yhot];

cursor[12].y ← 530;
cursor[12].proc ← XCmd;
cursor[12].xhot ← -8; cursor[12].yhot ← -8;
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: cursor[12].xhot, hotY: cursor[12].yhot];

};

RefreshCursors: PROC =
{i: INTEGER;
FOR i IN [1..numCursor]
DO
  JG.DrawPattern[cursor[i].pattern, cursorLine, cursor[i].y];
ENDLOOP;
JG.viewerChanged ← TRUE
};


currentCursor: [0..20] ← 5;
oldRope: ROPE ← NIL;
cursorLine: INTEGER = 30;

-- The main loop executes the pencil procedure until the pencil is put down, then
-- it waits until another cursor is picked up, in which case it executes that
-- command, etc.
viewerDead: BOOL ← FALSE;

MainLoop: PROC =
{ jkb.Next[];
x ← jkb.x;
y ← jkb.y;
DO ENABLE {ABORTED => LOOP;
Quit => { viewerDead ← TRUE;
EXIT} };
DropCursor[];
WaitForCrossRight[];
PickUpCursor[];
cursor[currentCursor].proc[];

ENDLOOP
};

WaitForCrossRight: PROC = {WHILE Next[] # crossright DO NULL ENDLOOP};

-- The procedure call Next[] returns one of the tokens left, middle, right, escape, cross.
-- It sets x and y to the mouse coordinates at the time of the click.

Event: TYPE = {left, middle, right, esc, crossleft, crossright, tab, backspace, cr, keyboard};

x, y: INTEGER; -- globals set by Next

Next: PROCEDURE RETURNS [Event] =
{DO jkb.Next[];
x ← jkb.x ; -- this was x ← jkb.x + xhot...made no apparent difference
y ← jkb.y - Real.FixI[JG.cursorOffsetY] ; -- this was y ← jkb.y + yhot...made no apparent difference
SELECT TRUE FROM
jkb.event = roll AND jkb.x <= cursorLine AND jkb.oldx > cursorLine
=> RETURN [crossleft];
jkb.event = roll AND jkb.x > cursorLine AND jkb.oldx <= cursorLine
=> RETURN [crossright];
jkb.event = clickDown AND jkb.button = red
=> RETURN [left];
jkb.event = clickDown AND jkb.button = yellow
=> RETURN [middle];
jkb.event = clickDown AND jkb.button = blue
=> RETURN [right];
jkb.event = keyDown AND jkb.char = 33C
=> RETURN [esc];
jkb.event = keyDown AND jkb.char = 11C
=> RETURN [tab];
jkb.event = keyDown AND jkb.char = 10C
=> RETURN [backspace];
jkb.event = keyDown AND jkb.char = 15C
=> RETURN [cr];
jkb.event = keyDown AND jkb.char # 33C AND jkb.char # 11C
AND jkb.char # 10C AND jkb.char # 15C
=> RETURN [keyboard];
ENDCASE => LOOP
ENDLOOP};

Quit: SIGNAL = jkb.Quit;

DropCursor: PROC =
{-- UserTerminal.SetCursorPattern[arrowCursor];
JunoClass.cursor ← pointRight;
WindowManager.RestoreCursor;
xhot ← 0; yhot ← 0;
currentCursor ← 0;
ClearSelectedPoints[]};

amax: INTEGER = 50;

a: ARRAY [1..amax] OF RECORD [p:PointPtr, c:[1..amax], x,y:INTEGER];

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

atop: [0..amax] ← 0;

sa: ARRAY [1..amax] OF RECORD [p:PointPtr, x,y:INTEGER];

satop: [0..amax] ← 0;

Push: PROC[p:PointPtr] =
{IF p=NIL THEN RETURN; --no point found
IF atop = amax THEN ERROR;
atop ← atop + 1; a[atop].p ← p; a[atop].c ← 1;
a[atop].x ← Real.FixI[p.x]; a[atop].y ← Real.FixI[p.y];
FOR i: INTEGER IN [1..atop - 1] DO
IF ABS[a[i].x - a[atop].x] <= 1 AND ABS[a[i].y - a[atop].y] <= 1
THEN a[atop].c ← a[atop].c + 1
ENDLOOP;
JG.Hylite[a[atop].x, a[atop].y, a[atop].c]};



Pop: PROC =
{i: INTEGER;
IF atop = 0 THEN ERROR;
JG.Hylite[a[1].x, a[1].y, a[1].c];
FOR i IN [1 .. atop - 1] DO a[i] ← a[i + 1] ENDLOOP;
atop ← atop - 1};

PushS: PROC[p:PointPtr] =
{IF satop = amax THEN ERROR;
satop ← satop + 1; sa[satop].p ← p;
sa[satop].x ← Real.FixI[p.x]; sa[satop].y ← Real.FixI[p.y];
JG.Hylite[sa[satop].x, sa[satop].y, 0]};

PopS: PROC =
{i: INTEGER;
IF satop = 0 THEN ERROR;
JG.Hylite[sa[1].x, sa[1].y, 0];
FOR i IN [1 .. satop - 1] DO sa[i] ← sa[i + 1] ENDLOOP;
satop ← satop - 1};

ClearSelectedPoints: PROC =
{UNTIL atop = 0 DO Pop[] ENDLOOP;
UNTIL satop = 0 DO PopS[] ENDLOOP;
pointLpad.slink ← pointRpad};

PickUpCursor: PROC =
{i : INTEGER ← 1;
champ: INTEGER ← 5; -- five is the pencil cursor index
UNTIL i > numCursor
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;
JunoClass.cursor ← cursor[currentCursor].cursorName;
WindowManager.RestoreCursor;
xhot ← cursor[currentCursor].xhot;
yhot ← cursor[currentCursor].yhot;

};

TrackPoint: PROC =
{jkb.Next[];
DO SELECT TRUE FROM
jkb.event = roll
=> {p: PointPtr ← FindPoint[jkb.x, jkb.y - Real.FixI[JG.cursorOffsetY] ];
IF p # a[atop].p
THEN {JG.Hylite[a[atop].x, a[atop].y, a[atop].c];
atop ← atop - 1;
Push[p]};
jkb.Next[]};
NOT (jkb.event = clickUp AND jkb.button = yellow) => jkb.Next[];
ENDCASE => EXIT ENDLOOP};

TrackSelectedPoint: PROC =
{jkb.Next[];
DO SELECT TRUE FROM
jkb.event = roll
=> {p: PointPtr ← FindSelectedPoint[jkb.x, jkb.y - Real.FixI[JG.cursorOffsetY] ];
IF p # sa[satop].p
THEN {JG.Hylite[sa[satop].x, sa[satop].y, 0];
satop ← satop - 1;
PushS[p]};
jkb.Next[]};
NOT (jkb.event = clickUp AND jkb.button = blue) => jkb.Next[];
ENDCASE => EXIT ENDLOOP};


NewPoint: PROC[x,y: INTEGER, visible: BOOL ← TRUE] RETURNS [PointPtr] =
{p: PointPtr ← AddPoint[x,y];
p.visible ← visible;
IF visible THEN JG.DrawPoint[x,y];
SortPoints[];
RETURN [p]};

PencilCmd: PROC =
{InputFocus.SetInputFocus [self];
DO SELECT Next[] FROM
left => {IF atop = 4 THEN Pop[];
Push[NewPoint[x,y]]};
middle => {IF atop = 4 THEN Pop[];
Push[FindPoint[x,y]];
TrackPoint[]};
right => { };
esc => {IF atop = 3 THEN Pop[];
IF atop = 1 OR atop = 0 THEN {Redisplay[]; LOOP};
  IF atop = 2
THEN {AddEdge[a[1].p, a[2].p];
  JG.DrawEdge[a[1].p.x, a[1].p.y, a[2].p.x, a[2].p.y]; Pop[]}
  ELSE {AddArc[a[1].p, a[2].p, a[3].p, a[4].p];
  JG.DrawArc[a[1].p.x, a[1].p.y, a[2].p.x, a[2].p.y,
   a[3].p.x, a[3].p.y, a[4].p.x, a[4].p.y];
   Pop[]; Pop[]; Pop[]}};
crossright => {};
crossleft => RETURN;
ENDCASE
ENDLOOP};

CongruentCmd: PROC =
{InputFocus.SetInputFocus [self];
DO SELECT Next[] FROM
left => {IF atop = 4 THEN {Pop[]; Pop[]};
Push[NewPoint[x,y]]};
middle => {IF atop = 4 THEN {Pop[]; Pop[]};
Push[FindPoint[x,y]];
TrackPoint[]};
right => {};
esc => {IF atop # 4 THEN {Redisplay[]}
  ELSE {AddCong[a[1].p, a[2].p, a[3].p, a[4].p]; Pop[]; Pop[]}};
crossright => {};
crossleft => RETURN;
ENDCASE
ENDLOOP};

CollinearCmd: PROC =
{InputFocus.SetInputFocus [self];
DO SELECT Next[] FROM
left => {IF atop = 4 THEN {Pop[]; Pop[]};
Push[NewPoint[x,y]]};
middle => {IF atop = 4 THEN {Pop[]; Pop[]};
Push[FindPoint[x,y]];
TrackPoint[]};
right => {};
esc => {IF atop # 4 THEN {Redisplay[]}
  ELSE {AddLin[a[1].p, a[2].p, a[3].p, a[4].p]; Pop[]; Pop[]}};
crossright => {};
crossleft => RETURN;
ENDCASE
ENDLOOP};

YCmd: PROC =
{bluBalloon: BOOLEAN ← TRUE;
InputFocus.SetInputFocus [self];
DO SELECT Next[] FROM
left => {IF atop = 3 THEN Pop[];
Push[NewPoint[x,y]]};
middle => {IF atop = 3 THEN Pop[];
Push[FindPoint[x,y]];
TrackPoint[]};
right => {IF NOT(bluBalloon)
THEN {IF satop = 3
THEN PopS[]; PushS[FindSelectedPoint[x,y]]; TrackSelectedPoint[]}
   ELSE {UNTIL satop = 0 DO PopS[] ENDLOOP;
   TrackLoop[];
    IF pointLpad.slink # pointRpad THEN bluBalloon ← FALSE}};
esc => {IF satop = 2 THEN {AlgebraStep[]; PopS[]; PopS[]}
ELSE IF satop = 1 THEN {OtherAlgebraStep[]; PopS[]}
ELSE ERROR};
crossright => {};
crossleft => RETURN;
ENDCASE
ENDLOOP};

AlgebraStep: PROC =
{body: REF ← MakeDefBody[sa[satop-1].p, sa[satop].p]; -- MakeDefBody is from JunoBody
colon: ATOM ← Atom.MakeAtom[":"];
leftpren: ATOM ← Atom.MakeAtom["("];
comma: ATOM ← Atom.MakeAtom[","];
AddDef[name: $X, locals: LIST[comma, $a, $b], body: body];
PW.AddTree[JunoParserEtc.junoA,
LIST[colon, LIST[leftpren, $X, LIST[comma, $a, $b]], body]]};

OtherAlgebraStep: PROC =
{body: REF ← MakeDefBody[sa[satop].p, NIL]; -- MakeDefBody is from JunoBody
colon: ATOM ← Atom.MakeAtom[":"];
leftpren: ATOM ← Atom.MakeAtom["("];
comma: ATOM ← Atom.MakeAtom[","];
AddDef[name: $X, locals: $a, body: body];
PW.AddTree[JunoParserEtc.junoA,
LIST[colon, LIST[leftpren, $X, $a], body]]};


HorizontalCmd: PROC =
{InputFocus.SetInputFocus [self];
DO SELECT Next[] FROM
left => {IF atop = 2 THEN Pop[]; Push[NewPoint[x,y]]};
middle => {IF atop = 2 THEN Pop[]; Push[FindPoint[x,y]];
TrackPoint[]};
right => { };
esc => {IF atop = 2 THEN {AddHor[a[1].p, a[2].p]; Pop[]}
ELSE Redisplay[]};
crossright => {};
crossleft => RETURN;
ENDCASE
ENDLOOP};

VerticalCmd: PROC =
{InputFocus.SetInputFocus [self];
DO SELECT Next[] FROM
left => {IF atop = 2 THEN Pop[]; Push[NewPoint[x,y]]};
middle => {IF atop = 2 THEN Pop[]; Push[FindPoint[x,y]];
TrackPoint[]};
right => { };
esc => {IF atop = 2 THEN {AddVer[a[1].p, a[2].p]; Pop[]}
ELSE Redisplay[]};
crossright => {};
crossleft => RETURN;
ENDCASE
ENDLOOP};

FreezeCmd: PROC =
{p:PointPtr ← pointLpad.link;
UNTIL p = pointRpad DO
IF p.fixed THEN JG.Hylite[Real.FixI[p.x], Real.FixI[p.y], 1];
p ← p.link;
ENDLOOP;
DO SELECT Next[] FROM
left => { };
middle => {p ← FindPoint[x,y]; p.fixed ← NOT(p.fixed);
JG.Hylite[Real.FixI[p.x], Real.FixI[p.y], 1]};
right => { };
esc => { };
crossright => {};
crossleft => {p ← pointLpad.link;
UNTIL p = pointRpad DO
IF p.fixed THEN JG.Hylite[Real.FixI[p.x], Real.FixI[p.y], 1];
   p ← p.link;
ENDLOOP;
   RETURN};
ENDCASE
ENDLOOP};

TypeWriterStateType: TYPE = {waitingForClick, waitingForChar};

typeWriterState: TypeWriterStateType;

TypeCmd: PROC =
{event: Event;
p3, p4: PointPtr;
myRope: ROPE ← NIL;
xw, yw: REAL;
xmin, ymin, xmax, ymax: REAL;
xCaret, yCaret, len: INTEGER;
InputFocus.SetInputFocus [self];
typeWriterState ← waitingForClick;
event ← Next[];
DO SELECT TRUE FROM

event = crossleft AND typeWriterState = waitingForClick
=> RETURN;

typeWriterState = waitingForClick AND (event = left OR event = middle)
=> {IF event = left
THEN p3← NewPoint[x, y, FALSE]
ELSE p3 ← FindPoint[x,y];
xCaret ← Real.FixI[p3.x];
yCaret ← Real.FixI[p3.y];
-- <<create flashing carat at the selected point>>
Carets.StartCaret [ self, xCaret,
yCaret + Real.FixI[JG.cursorOffsetY], primary];
-- the cursor offset is necessary here because Carets.StartCaret is
-- painting directly on the existing bitmap, not our stored bitmap,
myRope ← NIL;
typeWriterState ← waitingForChar};

typeWriterState = waitingForChar AND event = keyboard
=> {
-- display character at carat and move carat past character;
JG.DrawChar [jkb.char, xCaret, yCaret];
[xw, yw] ← JG.CharWidth [jkb.char];
xCaret ← xCaret + Real.FixI [ xw ];
Carets.StopCaret[primary];
Carets.StartCaret [ self, xCaret,
yCaret + Real.FixI[JG.cursorOffsetY], primary];
-- concatenate the new character onto
myRope ← Concat[myRope, FromChar[jkb.char] ] };

typeWriterState = waitingForChar AND event = backspace
=> { len ← Rope.Length [myRope];
IF len # 0 THEN
BEGIN
[xw, yw] ← JG.CharWidth [Fetch[myRope, len - 1]];
xCaret ← xCaret - Real.FixI [xw]; -- doesn't unpaint char yet --
JG.DrawChar [Fetch[myRope, len - 1], xCaret, yCaret];
-- now it is unpainted --
Carets.StopCaret[primary];
Carets.StartCaret [ self, xCaret,
yCaret + Real.FixI[JG.cursorOffsetY] , primary];
myRope ← Substr [ myRope, 0, len - 1]
END };


typeWriterState = waitingForChar AND (event = esc OR event = cr OR event = crossleft)
=> {
-- if user hits carriage return, treat it as an ESC, and position the
-- cursor to start a new line directly below the previous line.
len ← Rope.Length [myRope];
-- measure myRope,
[xmin, ymin, xmax, ymax] ← JG.RopeBox[myRope];
-- calculate the five new positions
-- and make them points
IF myRope # NIL THEN {
p4 ← NewPoint[Real.FixI [p3.x + xmax] ,Real.FixI [p3.y], FALSE];
-- insert the new points into junostorage as a new string object
AddString[p3,p4,
0, p4.x - p3.x, 0,
myRope, JG.myfont, JG.currentFont,
JG.currentPointSize, JG.currentBold, JG.currentItalic]
};
typeWriterState ← waitingForClick;
Carets.StopCaret[primary];
-- save oldRope in case user just hits ESC (or CR) next time
oldRope ← myRope; myRope ← NIL;
-- if user hit CR, position the cursor below the last line.
IF event = cr THEN
{xCaret ← Real.FixI[p3.x];
yCaret ← Real.FixI[p3.y - JG.fontHeight];
p3 ← NewPoint[xCaret, yCaret, FALSE];
Carets.StopCaret[primary];
Carets.StartCaret [self, xCaret, yCaret + Real.FixI[JG.cursorOffsetY], primary];
myRope ← NIL;
typeWriterState ← waitingForChar}
};

ENDCASE;
event ← Next[ ];
ENDLOOP};


EraseCmd: PROC =
{InputFocus.SetInputFocus [self];
DO SELECT Next[] FROM
left, middle => { };
right => TrackLoop[];
esc => {Delete[]; Refresh[]};
crossright => {};
crossleft => RETURN;
ENDCASE
ENDLOOP};

xLength: INTEGER ← 0;
currentLambda: ATOM;

LoadX: PUBLIC PROC = {
r: ROPE ← ViewerTools.GetSelectionContents[];
a: ATOM ← Atom.MakeAtom[r];
locals: REF ← GetLocals[a]; -- GetLocals is from JunoStorage
IF locals = NIL
THEN {Terminal.BlinkBWDisplay[Terminal.Current[]]; xLength ← 0};
currentLambda ← a;
xLength ← ArgListLength[locals]};

XCmd: PROC =
{IF xLength = 0
THEN DO SELECT Next[] FROM crossleft => RETURN ENDCASE ENDLOOP
ELSE {
InputFocus.SetInputFocus [self];
DO SELECT Next[] FROM
left => {IF atop = xLength THEN Pop[];
Push[NewPoint[x,y]]};
middle => {IF atop = xLength THEN Pop[];
Push[FindPoint[x,y]];
TrackPoint[]};
right => {};
esc => {IF atop # xLength THEN
{JG.Blink["You haven't chosen enough points yet"]; LOOP}
ELSE {l:LIST OF PointPtr ← ConsPointList[1, atop];
WHILE atop # 0 DO Pop[] ENDLOOP;
AddLambda[currentLambda, l]}};
crossright => {};
crossleft => RETURN;
ENDCASE
ENDLOOP}};


-- Eval: PROC[f: LIST OF REF ANY] = {JA.Eval[f]; SortPoints[]};
 

ConsPointList: PROC [i, atop: INT] RETURNS [LIST OF PointPtr] =
{IF i > atop
THEN RETURN[NIL]
ELSE RETURN[CONS[a[i].p, ConsPointList[i+1, atop]]] };

AddLambda: PROC [f: REF ANY, args: LIST OF PointPtr] =
{JG.SetPaintMode[opaque];
JA.Apply[f, args, NIL]; -- f is an atom
JG.SetPaintMode[invert];
JG.viewerChanged ← TRUE;
AddX[f, args]; 
SortPoints[] };


MoveStep: PROC[copying: BOOLEAN, solving: BOOLEAN] =
-- this proc is used by both MoveCmd and CopyCmd. It (a) identifies t with s,
-- for each source-target pair (s,t) that satisfies s is selected and t is not
-- selected; (b) computes a transform that takes the sources to the targets,
-- and (c) applies the transform to all selected points (if copying = FALSE) or
-- to all copied points (if copying = TRUE). It also actually copies the selected
-- list if copying = TRUE. It is only within this procedure that copy fields are
-- ever non-NIL.
BEGIN
n: INTEGER = MIN[atop,satop];
i: INTEGER;
savedFixBit: ARRAY[0..10] OF BOOLEAN;
savedSourcePoint: ARRAY[0..10] OF PointPtr;
singular ← FALSE;
IF n > 2 THEN ComputeTransform[a[atop].p, a[atop-1].p, a[atop-2].p, sa[satop].p, sa[satop-1].p, sa[satop-2].p];
IF n = 2 OR singular THEN ComputeTransform[a[atop].p, a[atop-1].p, NIL, sa[satop].p, sa[satop-1].p, NIL];
IF n = 1 OR singular THEN ComputeTransform[a[atop].p, NIL, NIL, sa[satop].p, NIL, NIL];
IF n = 0 OR singular THEN
{JG.Blink["No such affine transformation"];
RETURN};
IF copying THEN {Copy[]; PerformTransform[copiedPoints]}
ELSE PerformTransform[pointLpad.slink];
FOR i IN [0.. n-1] DO
IF UnSelected[a[atop-i].p] AND NOT(UnSelected[sa[satop-i].p])
THEN {IF copying THEN a[atop-i].p.copy ← sa[satop-i].p.copy
  ELSE a[atop-i].p.copy ← sa[satop-i].p}
ENDLOOP;
FOR i IN [0..n-1] DO
IF copying THEN savedSourcePoint[i] ← sa[satop-i].p.copy
ELSE savedSourcePoint[i] ← sa[satop-i].p;
savedFixBit[i] ← savedSourcePoint[i].fixed;
savedSourcePoint[i].fixed ← TRUE;
ENDLOOP;
IF copying
THEN {p: PointPtr ← pointLpad.slink;
UNTIL p = pointRpad DO p.copy ← NIL; p ← p.slink ENDLOOP};
Identify[]; -- identify p with p.copy for all p such that p.copy # NIL
IF solving THEN {JunoClass.cursor ← hourGlass;
WindowManager.RestoreCursor;
[] ← JunoSolver.Solve[.5];
JunoClass.cursor ← cursor[currentCursor].cursorName;
WindowManager.RestoreCursor};
SortPoints[];
FOR i IN [0..n-1] DO savedSourcePoint[i].fixed ← savedFixBit[i] ENDLOOP;
Refresh[];
END;

MoveCmd: PROC =
{bluBalloon: BOOLEAN ← TRUE;
next: Event;
InputFocus.SetInputFocus [self];
DO
next ← Next[];
SELECT next FROM
left => {IF atop = 3 THEN Pop[]; Push[NewPoint[x,y]]};
middle => {IF atop = 3 THEN Pop[]; Push[FindPoint[x,y]];
TrackPoint[]};
right => {IF NOT(bluBalloon)
THEN {IF satop = 3 THEN PopS[]; PushS[FindSelectedPoint[x,y]]; TrackSelectedPoint[]}
   ELSE {UNTIL satop = 0 DO PopS[] ENDLOOP;
   TrackLoop[];
    IF pointLpad.slink # pointRpad THEN bluBalloon ← FALSE}};
esc, tab =>
{IF satop = 0 AND atop > 1
THEN {UNTIL atop = 2 DO Pop[] ENDLOOP;
  PushS[a[1].p];
   Pop[];
   pointLpad.slink ← sa[1].p;
   sa[1].p.slink ← pointRpad};
  MoveStep[copying: FALSE, solving: next = esc];
  -- if command was invoked by ESC, move and re-solve;
  -- else move but do not re-solve.
  UNTIL atop = 0 DO Pop[] ENDLOOP;
  UNTIL satop = 0 DO PopS[] ENDLOOP;
  bluBalloon ← TRUE;};
crossright => {};
crossleft => RETURN;
ENDCASE
ENDLOOP};

UnSelected: PROC[q:PointPtr] RETURNS [BOOLEAN] =
{p:PointPtr ← pointLpad.slink;
UNTIL p = pointRpad DO IF p = q THEN RETURN [FALSE] ELSE p ← p.slink ENDLOOP;
RETURN [TRUE]};

CopyCmd: PROC =
{bluBalloon: BOOLEAN ← TRUE;
next: Event;
InputFocus.SetInputFocus [self];
DO
next ← Next[];
SELECT next FROM
left => {IF atop = amax THEN Pop[]; Push[NewPoint[x,y]]};
middle => {IF atop = amax THEN Pop[]; Push[FindPoint[x,y]];
TrackPoint[]};
right => {IF NOT(bluBalloon)
THEN {IF satop = amax THEN PopS[]; PushS[FindSelectedPoint[x,y]]; TrackSelectedPoint[]}
   ELSE {TrackLoop[];
   UNTIL satop = 0 DO PopS[] ENDLOOP;
    UNTIL atop = 0 DO Pop[] ENDLOOP;
    IF pointLpad.slink # pointRpad THEN bluBalloon ← FALSE}};
esc, tab => {MoveStep[copying: TRUE, solving: next = esc];
UNTIL atop = 0 DO Pop[] ENDLOOP;
  bluBalloon ← TRUE};
crossright => {};
crossleft => {UNTIL satop = 0 DO PopS[] ENDLOOP; RETURN};
ENDCASE
ENDLOOP};

TrackLoop: PROCEDURE =

-- The effect of TrackLoop is to track the cursor until the Blue button is
-- released, and to determine which points are contained in the loop made by
-- the cursor.

BEGIN
leftpad: PointPtr = pointLpad;
rightpad: PointPtr = pointRpad;
temp, pl, pr: PointPtr;
firstx, firsty, oldx, oldy, oldoldx, oldoldy, newx, newy, slope: INTEGER;

-- TrackLoop works by repeatedly sampling the mouse coordinates and
-- calling the procedure Wind:

Wind: PROCEDURE =

-- The effect of Wind is to compute the winding number of the small segment
-- from (oldx,oldy) to (newx,newy) around every point. The winding
-- number of the segment around the point (px, py) is zero unless px is in
-- the range [oldx, newx) and the point p is above the line through old
-- and new. If non-zero, it is 1 or -1 according as newx > oldx or newx < oldx.

-- To rapidly find the points (px,py) such that px is in [oldx, newx),
-- we arrange that (a) the points pl, link[pl], link[link[pl]] ...
-- up to but not including leftpad are exactly those points whose
-- x coordinates are less than oldx, and the points are listed
-- in decreasing order of their x coordinates, and (b) the points
-- pr, link[pr], link[link[pr]], ... up to but not including rightpad
-- are exactly those points whose x coordinates are greater than or
-- equal to oldx, and the points are listed in increasing order of
-- their x coordinates.

BEGIN
IF oldx = newx THEN BEGIN oldy ← newy; RETURN END;
IF oldx < newx THEN -- move right:
 WHILE pr.x < newx DO
  -- transfer one point from the list pr to the list pl:
  temp ← pr.link;
  pr.link ← pl;
  pl ← pr;
  pr ← temp;
  -- now update winding number of point if it is above line of mouse motion.
  slope ← (12 * (newy - oldy)) / (newx - oldx);
  -- slope is 12 times too big, but it is an integer and overflow cannot
  -- occur, since the variables are mouse coordinates.
  IF 12 * (pl.y - oldy) > slope * (pl.x - oldx)
  -- I.e. if (px,py) is above the line from old to new. In theory this could
  -- overflow, but only if the user moved the mouse == 50 pixels between
  -- samples. The resulting chaos will teach the user to move the mouse
  -- more slowly.
  THEN pl.wn ← pl.wn + 1
 ENDLOOP
ELSE -- move left:
 WHILE pl.x >= newx DO
  temp ← pl.link;
  pl.link ← pr;
  pr ← pl;
  pl ← temp;
  slope ← (12 * (newy - oldy)) / (newx - oldx);
  IF 12 * (pr.y - oldy) > slope * (pr.x - oldx) THEN pr.wn ← pr.wn - 1
 ENDLOOP;
 oldx ← newx;
 oldy ← newy;
END;

-- body of procedure TrackLoop:

oldx ← x; -- starting point of loop is current mouse position
oldy ← y;
oldoldx ← 9999; oldoldy ← 9999;
firstx ← oldx; -- save starting point to use as ending point
firsty ← oldy;

pl ← leftpad; -- initialize linked lists pl and pr:
pr ← pointLpad.link;
WHILE pr.x < oldx DO temp ← pr.link; pr.link ← pl; pl ← pr; pr ← temp ENDLOOP;

DO newx ← x;
newy ← y;
IF ABS[newx - oldoldx] > 5 OR ABS[newy - oldoldy] > 5 THEN
BEGIN
JG.DrawChar['. , newx, newy];
  oldoldx ← newx;
  oldoldy ← newy
  END;
Wind;
jkb.Next[]; x ← jkb.x; y ← jkb.y - Real.FixI[JG.cursorOffsetY]; IF jkb.status[blue] = up THEN EXIT;
ENDLOOP;
newx ← firstx;
newy ← firsty;
Wind;

-- now the winding numbers have been computed for all points. Must reset the
-- linked list of points, form a list of all points whose winding number
-- is odd, and find all edges and arcs that only involve such points.

WHILE pl # leftpad DO temp ← pl.link; pl.link ← pr; pr ← pl; pl ← temp ENDLOOP;

pl ← leftpad; -- pl will point to last selected point found.
temp ← leftpad.link; -- temp will move down the list of points.
WHILE temp # rightpad DO
IF temp.wn # 0
THEN BEGIN pl.slink ← temp; pl ← temp; temp.wn ← 0 END
 ELSE temp.slink ← NIL;
temp ← temp.link;
ENDLOOP;
pl.slink ← rightpad; -- add rightpad to end of list of selected points.

-- loops similar to the one above will find all selected edges and arcs:


END; -- of procedure TrackLoop

Redisplay: PUBLIC PROC =
{ JunoClass.cursor ← hourGlass;
WindowManager.RestoreCursor;
IF NOT JunoSolver.Solve[0.1]
THEN JG.Blink["The solver failed"];
SortPoints[];
ClearSelectedPoints[];
JunoClass.cursor ← cursor[currentCursor].cursorName;
WindowManager.RestoreCursor;
Refresh[]};

-- gotNewJunoA: BOOL ← FALSE;

CopyToViewer: PROC =
{ DO -- IF JunoA.newVersion = TRUE AND gotNewJunoA = FALSE
-- THEN { RefreshCursors[];
-- numCursor ← 11; notice that this is one-macro dependent!!
-- JunoA.newVersion ← FALSE;
-- gotNewJunoA ← TRUE;
-- RefreshCursors[]};
IF viewerDead THEN EXIT;
{t: Terminal.Virtual = Terminal.Current[];
Terminal.WaitForBWVerticalRetrace [t]; --! Should there be one instead of two calls?
Terminal.WaitForBWVerticalRetrace [t]};
IF JG.viewerChanged
THEN {ViewerOps.PaintViewer [viewer: self, hint: client, clearClient: FALSE];
JG.viewerChanged ← FALSE;}
ENDLOOP};


Refresh: PROCEDURE =
BEGIN
i:INTEGER;
JG.Whiten[];
JG.SetPaintMode[opaque];
IF screenOnly THEN RefreshCursors[];
RefreshX[];
RefreshPoints[];
RefreshEdges[];
RefreshArcs[];
RefreshStrings[];
JG.SetPaintMode[invert];
FOR i IN [1..atop] DO JG.Hylite[a[i].x, a[i].y, a[i].c] ENDLOOP;
FOR i IN [1..satop] DO JG.Hylite[sa[i].x, sa[i].y, 0] ENDLOOP;
JG.viewerChanged ← TRUE;
END;

RefreshPoints: PROCEDURE =
BEGIN
p: PointPtr ← pointLpad.link;
WHILE p # pointRpad
DO IF p.visible THEN JG.DrawPoint[Real.FixI[p.x], Real.FixI[p.y]];
  p ← p.link ENDLOOP;
END;

RefreshEdges: PROCEDURE =
BEGIN
p: EdgePtr ← edgeLpad.link;
WHILE p # edgeRpad
DO JG.DrawEdge[p.b1.x, p.b1.y, p.b2.x, p.b2.y];
  p ← p.link ENDLOOP;
END;

RefreshArcs: PROCEDURE =
BEGIN
p: ArcPtr ← arcLpad.link;
WHILE p # arcRpad
DO JG.DrawArc[p.b1.x, p.b1.y, p.b2.x, p.b2.y, p.b3.x, p.b3.y, p.b4.x, p.b4.y];
  p ← p.link ENDLOOP;
END;

RefreshStrings: PROCEDURE =
BEGIN
p : StringPtr ← stringLpad.link;
WHILE p # stringRpad
DO
JG.DrawString[p.b3.x, p.b3.y, p.stringText, p.stringFont,
p.fontName, p.fontSize, p.bold, p.italic];
p ← p.link ENDLOOP;
END;

RefreshX: PROC = {RefreshXR[constructionList]};

RefreshXR: PROC[l: LIST OF ApplyRecord] = {
IF l # NIL THEN {RefreshXR[l.rest]; JA.Apply[l.first.f, l.first.args, NIL]}};

NotifyMe: ViewerClasses.NotifyProc =
-- [self : ViewerClasses.Viewer,
-- input : LIST OF REF ANY]
TRUSTED
{
jkb.EnterAndNotify [self, input]
};

InputFocusChanged: ViewerClasses.ModifyProc =
-- [ self: Viewer,
-- change: ModifyAction]
TRUSTED
{
};

DestroyMe: ViewerClasses.DestroyProc =
-- [self: Viewer]
TRUSTED
{
input : LIST OF REF ANY ← LIST[$Destroy];
IF NOT self.iconic THEN InputFocus.SetInputFocus [self];
jkb.EnterAndNotify [self, input]
};


JunoClass: ViewerClasses.ViewerClass
← NEW [ViewerClasses.ViewerClassRec ← [

paint: JG.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

] ];

self: ViewerClasses.Viewer;

Hardcopy: PUBLIC PROC [filename: Rope.ROPE] =
{JG.DcGetsPressContext[filename];
screenOnly ← FALSE;
Refresh[];
JG.Blink["press file created: ", filename];
JG.DcGetsScreenContext[];
screenOnly ← TRUE;
};

ChangeFont: PUBLIC PROC[font: ROPE, pointSize: INT, bold: BOOL, italic: BOOL] =
{JG.currentFont ← font;
JG.currentPointSize ← pointSize;
JG.currentBold ← bold;
JG.currentItalic ← italic;
JG.GetNewFont[]};


StartOver: PUBLIC PROC =
{ InitJunoStorage [];
oldRope ← NIL;
constructionList ← NIL;
--! need to add a proc to junokeyboardimpl which empties the queue.
--! i.e. queueRight = queueLeft & broadcast nonfull
Refresh[];
};


Parse: PUBLIC PROC =
{junoA: PW.Handle = JunoParserEtc.junoA;
JunoParserEtc.Parse[];
IF NOT junoA.contentValid THEN JG.Blink["Parse error"]
ELSE {p: LIST OF PW.NodeContent ← junoA.content;
-- p is a list of pairs [text: rope, tree: REF ANY]; the trees
-- are all valid definitions, which we will add to the list of
-- definitions. Except that some are NILs that should be skipped.
WHILE p # NIL DO
IF p.first.tree # NIL
THEN {t: REF ANY = p.first.tree;
AddDef[Cadr[Cadr[t]], Caddr[Cadr[t]], Caddr[t]]};
p ← p.rest
ENDLOOP}};

NewProc: PUBLIC PROC =
{junoA: PW.Handle = JunoParserEtc.junoA;
PW.AddText[junoA, " CommandName(Args)", ": Body\n"]};

ProcFile: PUBLIC PROC[fileName: Rope.ROPE] =
{JunoParserEtc.Algebra[fileName]; Parse[]};

ArgListLength: PROC [l: REF ANY] RETURNS [INT] =
{IF ISTYPE[l, ATOM] THEN RETURN [1] ELSE RETURN [1+ ArgListLength[Caddr[l]]]};

Car: PROC [r: REF ANY] RETURNS [REF ANY] =
{RETURN[NARROW[r, LIST OF REF ANY].first]};

Cdr: PROC [r: REF ANY] RETURNS [REF ANY] =
{RETURN[NARROW[r, LIST OF REF ANY].rest]};

Cadr: PROC [r: REF ANY] RETURNS [REF ANY] = {RETURN[Car[Cdr[r]]]};

Caddr: PROC [r: REF ANY] RETURNS [REF ANY] = {RETURN[Car[Cdr[Cdr[r]]]]};

ViewerOps.RegisterViewerClass[$Juno, JunoClass];

InitJunoStorage[];

InitCursors[];

self ← ViewerOps.CreateViewer[flavor: $Juno, info: [name: "Juno Image",
iconic: FALSE,
column: left]];

Process.Detach[FORK CopyToViewer[] ];
Process.Detach[FORK MainLoop[]];

END.