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