(FILECREATED "22-Feb-84 09:45:16" {PHYLUM}<LISP>LIBRARY>GRAPHER.;15 84813 changes to: (FNS LAYOUTGRAPH LAYOUTSEXPR) previous date: "23-Jan-84 12:08:28" {PHYLUM}<LISP>LIBRARY>GRAPHER.;14) (* Copyright (c) 1983, 1984 by Xerox Corporation) (PRETTYCOMPRINT GRAPHERCOMS) (RPAQQ GRAPHERCOMS ((FNS ABOVE ADD/AND/DISPLAY/LINK APPLYTOSELECTEDNODE CACHE/NODE/LABELS CALL.MOVENODEFN CHANGE.NODEFONT.SIZE CHOOSE.GRAPH.FONT CLOSEST/NODE CREATE/LABEL/BITMAP DEFAULT.ADDNODEFN DELETE/AND/DISPLAY/LINK DISPLAY/NAME DISPLAYLINK DISPLAYNODE DISPLAYNODELINKS DRAWBOX DRAWAREABOX EDITADDLINK EDITADDNODE EDITAPPLYTOLINK EDITCHANGEFONT EDITDELETELINK EDITDELETENODE EDITGRAPH EDITGRAPH1 EDITGRAPHMENU EDITMOVENODE FLIPNODE FONTNAMELIST FROMLINKS GETNODEFROMID GRAPHADDLINK GRAPHADDNODE GRAPHDELETELINK GRAPHDELETENODE GRAPHEDITCOMMANDFN GRAPHEDITEVENTFN GRAPHMOVENODE GRAPHREGION LABEL/BITMAP LAYOUT/POSITION LOWER/LEFT/POSITION MANHATTANDIST MAX/RIGHT MAX/TOP MIN/BOTTOM MIN/LEFT MOVENODE NODE/BOTTOM NODE/LEFT NODE/RIGHT NODE/TOP NODEBOXHEIGHT NODEBOXWIDTH NODECREATE NODELST/AS/MENU NODEREGION PRINTDISPLAYNODE PROMPTINWINDOW READ/NODE REDISPLAYGRAPH RIGHTOF SET/LABEL/SIZE SET/LAYOUT/POSITION SHIFTP SHOWGRAPH SIZE/GRAPH/WINDOW TOGGLE/DIRECTEDFLG TOGGLE/SIDESFLG TOLINKS TRACKCURSOR TRACKNODE) (COMS (* functions for finding larger and smaller fonts) (FNS NEXTSIZEFONT DECREASING.FONT.LIST SCALE.FONT) (VARS (DECREASING.FONT.LIST (DECREASING.FONT.LIST))) (GLOBALVARS DECREASING.FONT.LIST)) (* functions for LAYOUTFOREST. LAYOUTGRAPH And LAYOUTLATTICE) (FNS BRH/LAYOUT BRH/LAYOUT/DAUGHTERS BRH/OFFSET BRHC/INTERTREE/SPACE BRHC/LAYOUT BRHC/LAYOUT/DAUGHTERS BRHC/LAYOUT/TERMINAL BRHC/OFFSET BRHL/LAYOUT BRHL/LAYOUT/DAUGHTERS BRHL/MOVE/RIGHT BROWSE/LAYOUT/HORIZ BROWSE/LAYOUT/HORIZ/COMPACTLY BROWSE/LAYOUT/LATTICE BRV/OFFSET EXTEND/TRANSITION/CHAIN INIT/NODES/FOR/LAYOUT LAYOUTFOREST LAYOUTGRAPH LAYOUTLATTICE LAYOUTSEXPR LAYOUTSEXPR1 NEW/INSTANCE/OF/GRAPHNODE RAISE/TRANSITION/CHAIN REFLECT/GRAPH/DIAGONALLY REFLECT/GRAPH/HORIZONTALLY REFLECT/GRAPH/VERTICALLY SWITCH/NODE/HEIGHT/WIDTH) (VARS DISPLAYNODEHEIGHT (EDITGRAPHMENU) (GRAPHEDITWINDOW) NODEBOARDERWIDTH (ORIGIN (CREATE POSITION XCOORD ← 0 YCOORD ← 0)) (BOXLABELSFLG T) (LABEL/CREATING/DS)) (LOCALVARS . T) (GLOBALVARS DISPLAYNODEHEIGHT EDITGRAPHMENU GRAPHEDITWINDOW NODEBOARDERWIDTH ORIGIN BOXLABELSFLG LABEL/CREATING/DS) (RECORDS GRAPHNODE GRAPH) (MACROS HALF))) (DEFINEQ (ABOVE [LAMBDA (POSITION1 POSITION2) (* rrb "20-MAR-82 12:05") (* determines if one position is above another position.) (OR (POSITIONP POSITION1) (\ILLEGAL.ARG POSITION1)) (OR (POSITIONP POSITION2) (\ILLEGAL.ARG POSITION1)) (IGREATERP (fetch YCOORD of POSITION1) (fetch YCOORD of POSITION2]) (ADD/AND/DISPLAY/LINK [LAMBDA (FROMND TOND WIN G) (* rrb " 1-NOV-83 09:17") (* adds and displays a link.) (COND ((MEMB (fetch NODEID of TOND) (TOLINKS FROMND)) (PRIN1 " link already exists. " T) (TERPRI T) NIL) (T (GRAPHADDLINK FROMND TOND G WIN) (DISPLAYLINK FROMND TOND WIN G) T]) (APPLYTOSELECTEDNODE [LAMBDA (WINDOW) (* kvl " 3-MAY-82 20:45") (* applys a function whenever the node is selected. Is used as BUTTONEVENTFN and gets called whenever cursor moves or button is down.) (PROG ((LEFTFNOFNODE (WINDOWPROP WINDOW (QUOTE BROWSER/LEFTFN))) (MIDDLEFNOFNODE (WINDOWPROP WINDOW (QUOTE BROWSER/MIDDLEFN))) [NODELST (fetch (GRAPH GRAPHNODES) of (WINDOWPROP WINDOW (QUOTE GRAPH] (DS (WINDOWPROP WINDOW (QUOTE DSP))) BUTTON OLDPOS REG NOW NEAR) (* note which button is down.) (TOTOPW WINDOW) (COND ((LASTMOUSESTATE LEFT) (OR LEFTFNOFNODE (RETURN)) (SETQ BUTTON (QUOTE LEFT))) ((LASTMOUSESTATE MIDDLE) (OR MIDDLEFNOFNODE (RETURN)) (SETQ BUTTON (QUOTE MIDDLE))) (T (* no button down, not interested.) (RETURN))) (* get the region of this window.) (SETQ REG (WINDOWPROP WINDOW (QUOTE REGION))) [SETQ NEAR (NODELST/AS/MENU NODELST (SETQ OLDPOS (CURSORPOSITION NIL DS] FLIP(AND NOW (FLIPNODE NOW DS)) (AND NEAR (FLIPNODE NEAR DS)) (SETQ NOW NEAR) LP (* wait for a button up or move out of region) (GETMOUSESTATE) (COND ((NOT (LASTMOUSESTATE (OR LEFT MIDDLE))) (* button up, process it.) (AND NOW (FLIPNODE NOW DS)) (* NOW node has been selected.) (RETURN (APPLY* (SELECTQ BUTTON (LEFT LEFTFNOFNODE) (MIDDLE MIDDLEFNOFNODE) (SHOULDNT)) NOW WINDOW))) ((NOT (INSIDE? (WINDOWPROP WINDOW (QUOTE REGION)) LASTMOUSEX LASTMOUSEY)) (* outside of region, return) (AND NOW (FLIPNODE NOW DS)) (RETURN)) ([EQ NOW (SETQ NEAR (NODELST/AS/MENU NODELST (CURSORPOSITION NIL DS OLDPOS] (GO LP)) (T (GO FLIP]) (CACHE/NODE/LABELS [LAMBDA (NODELST) (* kvl "22-DEC-83 16:39") (* recalculate the node label images) (for NS in NODELST do (COND [(type? BITMAP (fetch NODELABELBITMAP of NS)) (SET/LAYOUT/POSITION NS (OR (LAYOUT/POSITION NS) (ERROR "This graphnode has not been given a position:" NS] (T (CREATE/LABEL/BITMAP NS NIL]) (CALL.MOVENODEFN [LAMBDA (NODE NEWPOS GRAPH WINDOW) (* rrb " 1-NOV-83 12:02") (* calls a graphs movenodefn.) (PROG ((MOVEFN (fetch (GRAPH GRAPH.MOVENODEFN) of GRAPH))) (AND MOVEFN (APPLY* MOVEFN NODE NEWPOS GRAPH WINDOW]) (CHANGE.NODEFONT.SIZE [LAMBDA (HOW NODE GRAPH WINDOW) (* kvl "22-DEC-83 16:38") (* makes the label font of a node larger.) (PROG [(NEWFONT (NEXTSIZEFONT HOW (fetch (GRAPHNODE NODEFONT) of NODE] (COND (NEWFONT (DISPLAYNODE NODE WINDOW GRAPH) (PROG ((CHNGFN (fetch (GRAPH GRAPH.FONTCHANGEFN) of GRAPH))) (AND CHNGFN (APPLY* CHNGFN HOW NODE GRAPH WINDOW))) (replace (GRAPHNODE NODEFONT) of NODE with NEWFONT) (CREATE/LABEL/BITMAP NODE T) (DISPLAYNODE NODE WINDOW GRAPH]) (CHOOSE.GRAPH.FONT [LAMBDA (GRAPH) (* rrb " 1-NOV-83 11:57") (* picks a font for a new node in a graph) (* for now use the same font as the first node.) (fetch (GRAPHNODE NODEFONT) of (CAR (fetch (GRAPH GRAPHNODES) of GRAPH]) (CLOSEST/NODE [LAMBDA (NODELST POS) (* rrb "20-MAR-81 17:02") (* finds the node that is closest to POS) (PROG (CLOSEST (MINDIST 65000) DIST) LP (COND ((NULL NODELST) (RETURN CLOSEST)) ((IGREATERP MINDIST (SETQ DIST (MANHATTANDIST (LAYOUT/POSITION (CAR NODELST)) POS))) (SETQ CLOSEST (CAR NODELST)) (SETQ MINDIST DIST))) (SETQ NODELST (CDR NODELST)) (GO LP]) (CREATE/LABEL/BITMAP [LAMBDA (NODE FORCE/FLG) (* kvl "27-DEC-83 19:28") (PROG ((WIDTH (fetch (GRAPHNODE NODEWIDTH) of NODE)) (HEIGHT (fetch (GRAPHNODE NODEHEIGHT) of NODE)) (FONT (fetch (GRAPHNODE NODEFONT) of NODE)) (NBW (AND (fetch BOXNODEFLG of NODE) (OR (NUMBERP (fetch BOXNODEFLG of NODE)) NODEBOARDERWIDTH))) NODEBITMAP) [COND ((AND (NOT FORCE/FLG) (FIXP WIDTH) (FIXP HEIGHT))) (T (SET/LABEL/SIZE NODE) (SETQ WIDTH (fetch (GRAPHNODE NODEWIDTH) of NODE)) (SETQ HEIGHT (fetch (GRAPHNODE NODEHEIGHT) of NODE] (* recalculate the dependent fields.) (SET/LAYOUT/POSITION NODE (OR (LAYOUT/POSITION NODE) (ERROR "This graphnode has not been given a position:" NODE))) (COND [(BITMAPP (fetch NODELABEL of NODE)) (COND [NBW (SETQ NODEBITMAP (BITMAPCREATE WIDTH HEIGHT)) (BITBLT NIL NIL NIL NODEBITMAP 0 0 WIDTH HEIGHT (QUOTE TEXTURE) (QUOTE REPLACE) BLACKSHADE) (BITBLT (fetch NODELABEL of NODE) 0 0 NODEBITMAP 0 0 WIDTH HEIGHT (QUOTE INPUT) (QUOTE REPLACE) NIL (create REGION LEFT ← NBW BOTTOM ← NBW WIDTH ←(IDIFFERENCE WIDTH (IPLUS NBW NBW)) HEIGHT ←(IDIFFERENCE HEIGHT (IPLUS NBW NBW] (T (SETQ NODEBITMAP (fetch NODELABEL of NODE] ((NULL FONT)) ((IGREATERP HEIGHT 2) (SETQ NODEBITMAP (BITMAPCREATE WIDTH HEIGHT)) (COND ((DISPLAYSTREAMP LABEL/CREATING/DS)) (T (SETQ LABEL/CREATING/DS (DSPCREATE)) (DSPOPERATION (QUOTE PAINT) LABEL/CREATING/DS))) (DSPFONT FONT LABEL/CREATING/DS) (DSPDESTINATION NODEBITMAP LABEL/CREATING/DS) (AND (fetch BOXNODEFLG of NODE) (DRAWBOX ORIGIN WIDTH HEIGHT NBW NIL LABEL/CREATING/DS)) (CENTERPRINTINAREA (fetch NODELABEL of NODE) (fetch XCOORD of ORIGIN) (fetch YCOORD of ORIGIN) WIDTH HEIGHT LABEL/CREATING/DS)) (T (* so small just use texture) (SETQ NODEBITMAP (BITMAPCREATE WIDTH HEIGHT)) (BITBLT NIL NIL NIL NODEBITMAP 0 0 2 2 (QUOTE TEXTURE) (QUOTE REPLACE) BLACKSHADE))) (replace NODELABELBITMAP of NODE with NODEBITMAP) (RETURN NODE]) (DEFAULT.ADDNODEFN [LAMBDA (GRAPH WINDOW BOXED FONT) (* rrb " 2-NOV-83 20:29") (* reads a node label name from the user and puts a node at the current cursor position.) (PROG (NODELABEL NODENAME) (SETQ NODELABEL (PROMPTINWINDOW "Node label? ")) LP (COND ((FASSOC (SETQ NODENAME (PACK* NODELABEL (GENSYM))) (fetch (GRAPH GRAPHNODES) of GRAPH)) (GO LP))) (RETURN (NODECREATE NODENAME NODELABEL (CURSORPOSITION NIL WINDOW) NIL NIL (OR FONT (CHOOSE.GRAPH.FONT GRAPH)) BOXED]) (DELETE/AND/DISPLAY/LINK [LAMBDA (FROMND TOND WIN G) (* rrb " 1-NOV-83 09:14") (* delete a link and updates the display.) (COND ([NOT (OR (MEMB (fetch NODEID of TOND) (TOLINKS FROMND)) (AND (MEMB (fetch NODEID of FROMND) (TOLINKS TOND)) (NOT (fetch (GRAPH DIRECTEDFLG) of G)) (PROG ((TMP FROMND)) (* editting graph, don't distinguish between links.) (SETQ FROMND TOND) (SETQ TOND TMP) (RETURN T] (PRIN1 " link does not exist. " T) (TERPRI T) NIL) (T (GRAPHDELETELINK FROMND TOND G WIN) (DISPLAYLINK FROMND TOND WIN G) T]) (DISPLAY/NAME [LAMBDA (ND) (* rrb "13-JUL-81 10:56") (fetch NODELABEL of ND]) (DISPLAYLINK [LAMBDA (FRND TOND DS G) (* rmk: "16-NOV-83 12:48") (* draws in a link from FRND TO TOND) (COND ((fetch (GRAPH SIDESFLG) of G) (COND ((OR (fetch (GRAPH DIRECTEDFLG) of G) (RIGHTOF (fetch NODELEFT of TOND) (fetch NODERIGHT of FRND))) (* in the horizontal case of LATTICE, always draw from right to left.) (DRAWBETWEEN (fetch NODELEFT of TOND) (fetch NODERIGHT of FRND) 1 NIL DS)) ((RIGHTOF (fetch NODELEFT of FRND) (fetch NODERIGHT of TOND)) (DRAWBETWEEN (fetch NODELEFT of FRND) (fetch NODERIGHT of TOND) 1 NIL DS)) ((ABOVE (fetch NODEBOTTOM of FRND) (fetch NODETOP of TOND)) (DRAWBETWEEN (fetch NODEBOTTOM of FRND) (fetch NODETOP of TOND) 1 NIL DS)) ((ABOVE (fetch NODEBOTTOM of TOND) (fetch NODETOP of FRND)) (DRAWBETWEEN (fetch NODEBOTTOM of TOND) (fetch NODETOP of FRND) 1 NIL DS)) (T (* if on top of each other, don't draw.) NIL))) (T (COND ((OR (fetch (GRAPH DIRECTEDFLG) of G) (ABOVE (fetch NODEBOTTOM of FRND) (fetch NODETOP of TOND))) (* if LATTICE, always draw from FROMNODE BOTTOM to TONODE TOP. Otherwise find the one that looks best.) (DRAWBETWEEN (fetch NODEBOTTOM of FRND) (fetch NODETOP of TOND) 1 NIL DS)) ((ABOVE (fetch NODEBOTTOM of TOND) (fetch NODETOP of FRND)) (DRAWBETWEEN (fetch NODEBOTTOM of TOND) (fetch NODETOP of FRND) 1 NIL DS)) ((RIGHTOF (fetch NODELEFT of TOND) (fetch NODERIGHT of FRND)) (DRAWBETWEEN (fetch NODELEFT of TOND) (fetch NODERIGHT of FRND) 1 NIL DS)) ((RIGHTOF (fetch NODELEFT of FRND) (fetch NODERIGHT of TOND)) (DRAWBETWEEN (fetch NODELEFT of FRND) (fetch NODERIGHT of TOND) 1 NIL DS)) (T (* if on top of each other, don't draw.) NIL]) (DISPLAYNODE [LAMBDA (ND DS G TOSONLY) (* kvl "12-SEP-82 09:29") (* displays a node and its links. IF TOSONLY IS NON-NIL, DRAWS ONLY THE TO LINKS.) (DISPLAYNODELINKS ND DS G TOSONLY) (PRINTDISPLAYNODE ND DS]) (DISPLAYNODELINKS [LAMBDA (ND DS G TOSONLY) (* rmk: "15-NOV-83 17:32") (* displays a node links. IF TOSONLY IS NON-NIL, DRAWS ONLY THE TO LINKS.) (PROG ((NODELST (fetch (GRAPH GRAPHNODES) of G))) (for TONODEID in (TOLINKS ND) do (DISPLAYLINK ND (GETNODEFROMID TONODEID NODELST) DS G)) (OR TOSONLY (for FROMNDID in (FROMLINKS ND) do (DISPLAYLINK (GETNODEFROMID FROMNDID NODELST) ND DS G]) (DRAWBOX [LAMBDA (POS WIDTH HEIGHT SIZE OPERATION WIN) (* rrb "23-Jan-84 12:07") (* draws a box to a display stream) (DRAWAREABOX (fetch XCOORD of POS) (fetch YCOORD of POS) WIDTH HEIGHT SIZE OPERATION WIN]) (DRAWAREABOX [LAMBDA (LEFT BOTTOM WIDTH HEIGHT SIZE OPERATION WIN) (* rrb "23-Jan-84 12:07") (* draws a box along the lines of an area. Is tricky because must take in account the fact that lines are centered by extend first in the up and right directions.) (PROG (TOPRIGHTHALFWIDTH BOTTOMLEFTHALFWIDTH TOP RIGHT VERTBOTTOM VERTTOP HORIZLEFT HORIZRIGHT) [COND ((NUMBERP SIZE) (COND ((ILEQ SIZE 0) (RETURN))) (SETQ TOPRIGHTHALFWIDTH (IQUOTIENT SIZE 2)) (SETQ BOTTOMLEFTHALFWIDTH (IQUOTIENT (SUB1 SIZE) 2))) (T (SETQ SIZE 1) (SETQ TOPRIGHTHALFWIDTH (SETQ BOTTOMLEFTHALFWIDTH 0] (* draw left edge) (DRAWLINE LEFT (SETQ VERTBOTTOM (IDIFFERENCE BOTTOM BOTTOMLEFTHALFWIDTH)) LEFT [SETQ VERTTOP (IPLUS TOPRIGHTHALFWIDTH (SETQ TOP (SUB1 (IPLUS BOTTOM HEIGHT] SIZE OPERATION WIN) (* draw top) (DRAWLINE (SETQ HORIZLEFT (IPLUS LEFT TOPRIGHTHALFWIDTH)) TOP (SETQ HORIZRIGHT (IDIFFERENCE (SETQ RIGHT (SUB1 (IPLUS LEFT WIDTH))) BOTTOMLEFTHALFWIDTH)) TOP SIZE OPERATION WIN) (* draw right edge) (DRAWLINE RIGHT VERTBOTTOM RIGHT VERTTOP SIZE OPERATION WIN) (* draw bottom) (DRAWLINE HORIZLEFT BOTTOM HORIZRIGHT BOTTOM SIZE OPERATION WIN]) (EDITADDLINK [LAMBDA (W) (* kvl "20-APR-82 13:53") (* reads and adds a link to the graph) (EDITAPPLYTOLINK (FUNCTION ADD/AND/DISPLAY/LINK) (QUOTE added) (WINDOWPROP W (QUOTE GRAPH)) W]) (EDITADDNODE [LAMBDA (W) (* kvl "22-DEC-83 16:38") (* adds a node to the graph in the window W and displays it.) (PROG [NODE (GRAPH (WINDOWPROP W (QUOTE GRAPH] (OR (SETQ NODE (GRAPHADDNODE GRAPH W)) (RETURN)) (CREATE/LABEL/BITMAP NODE T) (printout PROMPTWINDOW T "Position node " (DISPLAY/NAME NODE)) (PRINTDISPLAYNODE NODE W) (TRACKCURSOR NODE (WINDOWPROP W (QUOTE DSP)) GRAPH) (RETURN NODE]) (EDITAPPLYTOLINK [LAMBDA (FN MSG GRAPH DS) (* kvl "20-APR-82 14:29") (RESETFORM (TTYDISPLAYSTREAM PROMPTWINDOW) (COND [(fetch (GRAPH GRAPHNODES) of GRAPH) (PROG (FROM TO) (printout T "Specify the link by selecting the FROM node, then the TO node." T) (PRIN1 "FROM?" T) (SETQ FROM (READ/NODE (fetch (GRAPH GRAPHNODES) of GRAPH) DS)) (CLRPROMPT) (FLIPNODE FROM DS) (PRIN1 "TO?" T) [SETQ TO (COND [(CAR (ERSETQ (READ/NODE (fetch (GRAPH GRAPHNODES) of GRAPH) DS] (T (FLIPNODE FROM DS) (ERROR!] (CLRPROMPT) (FLIPNODE FROM DS) (COND ((APPLY* FN FROM TO DS GRAPH) (* return non-nil if changed anything.) (printout T "Link from " (DISPLAY/NAME FROM) " to " (DISPLAY/NAME TO) , MSG T] (T (TERPRI T) (PRINT "There are no nodes. You can create nodes with the Add Node command." T]) (EDITCHANGEFONT [LAMBDA (HOW W) (* rrb " 2-NOV-83 21:26") (* prompts the user for a node and deletes it) (PROG ((GRAPH (WINDOWPROP W (QUOTE GRAPH))) (DS (WINDOWPROP W (QUOTE DSP))) NODE) (COND ((NOT (fetch (GRAPH GRAPHNODES) of GRAPH)) (PROMPTPRINT " No nodes yet. ") (RETURN))) (printout PROMPTWINDOW T " Select node to be made " (COND ((EQ HOW (QUOTE SMALLER)) "smaller.") (T "larger."))) (SETQ NODE (READ/NODE (fetch (GRAPH GRAPHNODES) of GRAPH) DS)) (AND NODE (CHANGE.NODEFONT.SIZE HOW NODE GRAPH W]) (EDITDELETELINK [LAMBDA (W) (* kvl "20-APR-82 13:54") (* reads and adds a link to the graph) (EDITAPPLYTOLINK (FUNCTION DELETE/AND/DISPLAY/LINK) (QUOTE deleted) (WINDOWPROP W (QUOTE GRAPH)) W]) (EDITDELETENODE [LAMBDA (W) (* rrb " 1-NOV-83 11:52") (* prompts the user for a node and deletes it) (RESETFORM (TTYDISPLAYSTREAM PROMPTWINDOW) (CLRPROMPT) (PROG ((GRAPH (WINDOWPROP W (QUOTE GRAPH))) (DS (WINDOWPROP W (QUOTE DSP))) NODE NODELABEL) (COND ((NOT (fetch (GRAPH GRAPHNODES) of GRAPH)) (PROMPTPRINT " No nodes to delete. ") (RETURN))) (PROMPTPRINT " Select node to be deleted. ") (SETQ NODE (READ/NODE (fetch (GRAPH GRAPHNODES) of GRAPH) DS)) (TERPRI T) (FLIPNODE NODE DS) (COND ((EQ [ASKUSER NIL NIL (LIST "delete node " (SETQ NODELABEL (DISPLAY/NAME NODE] (QUOTE Y)) (FLIPNODE NODE DS) (DISPLAYNODE NODE DS GRAPH) (for TOND in (APPEND (TOLINKS NODE)) do (GRAPHDELETELINK NODE (GETNODEFROMID TOND (fetch (GRAPH GRAPHNODES) of GRAPH)) GRAPH W)) (for FROMND in (APPEND (FROMLINKS NODE)) do (GRAPHDELETELINK (GETNODEFROMID FROMND (fetch (GRAPH GRAPHNODES) of GRAPH)) NODE GRAPH W)) (GRAPHDELETENODE NODE GRAPH W) (printout T "Node " NODELABEL " deleted." T) (RETURN NODE)) (T (FLIPNODE NODE DS) (printout T "nothing deleted." T) (RETURN NIL]) (EDITGRAPH [LAMBDA (GRAPH WINDOW) (* rrb " 8-NOV-83 12:22") (* top level function for editing a graph. If there is no graph, create one empty. IF there is no window, create on the right size for the graph. After getting the arguments right, put the right button functions on, display it and enter the main loop.) (OR GRAPH (SETQ GRAPH (create GRAPH))) (SETQ WINDOW (SIZE/GRAPH/WINDOW GRAPH WINDOW)) (WINDOWPROP WINDOW (QUOTE GRAPH) GRAPH) (WINDOWPROP WINDOW (QUOTE REPAINTFN) (FUNCTION REDISPLAYGRAPH)) (WINDOWPROP WINDOW (QUOTE SCROLLFN) (FUNCTION SCROLLBYREPAINTFN)) (DSPOPERATION (QUOTE INVERT) WINDOW) (REDISPLAYGRAPH WINDOW) (EDITGRAPH1 WINDOW) GRAPH]) (EDITGRAPH1 [LAMBDA (W) (* rrb " 7-NOV-83 14:51") (* Can also be called from top level if the given window W has a graph on its GRAPH windowprop and the graph has been displayed by SHOWGRAPH or its equivalent. It waits for mouse hits, does the comand, then waits for mouse clear. Each edit command function takes only the window so that they can be hung separately on button event functions. However, the window must have INVERT as its display operation mode.) (PROG (VAL) (CLRPROMPT) (printout PROMPTWINDOW "Use the left button to move nodes." T "Use the middle button to get a menu of edit commands." T "During an edit command, the middle button can be used to abort.") LP (until (MOUSESTATE (OR LEFT MIDDLE)) do) (COND [(LASTMOUSESTATE MIDDLE) (SETQ VAL (ERSETQ (GRAPHEDITCOMMANDFN W))) (COND ((NULL VAL) (* aborted) (printout PROMPTWINDOW T T "command aborted." T)) ((EQ (CAR VAL) (QUOTE STOP)) (RETURN (CLRPROMPT] ((fetch (GRAPH GRAPHNODES) of (WINDOWPROP W (QUOTE GRAPH))) (* track the nearest node.) (TRACKNODE W)) (T (printout PROMPTWINDOW T "There are no nodes to move yet." T "Press the middle button and select the 'Add a node' command."))) (until (MOUSESTATE UP) do) (GO LP]) (EDITGRAPHMENU [LAMBDA NIL (* rrb " 6-JAN-82 12:29") (COND ((type? MENU EDITGRAPHMENU) EDITGRAPHMENU) (T (SETQ EDITGRAPHMENU (create MENU ITEMS ←(QUOTE (("Add Node" (QUOTE ADDNODE)) ("Delete Node" (QUOTE DELETENODE)) ("Add Link" (QUOTE ADDLINK)) ("Delete Link" (QUOTE DELETELINK)) ("Toggle DirectedFlg" (QUOTE DIRECTED)) ("Toggle SidesFlg" (QUOTE SIDES)) STOP)) CENTERFLG ← T CHANGEOFFSETFLG ← T]) (EDITMOVENODE [LAMBDA (WINDOW) (* rrb "31-OCT-83 21:47") (* hilite nodes until the cursor goes down then move it) (PROG ((DS (WINDOWPROP WINDOW (QUOTE DSP))) (REG (WINDOWPROP WINDOW (QUOTE REGION))) (GRAPH (WINDOWPROP WINDOW (QUOTE GRAPH))) OLDPOS NOW NEAR NODELST) (COND (GRAPH (SETQ NODELST (fetch (GRAPH GRAPHNODES) of GRAPH))) (T (RETURN))) (printout PROMPTWINDOW T "Move the cursor to the node " "you want to move " "and press any button.") [SETQ NEAR (NODELST/AS/MENU NODELST (SETQ OLDPOS (CURSORPOSITION NIL DS] FLIP(AND NOW (FLIPNODE NOW DS)) (AND NEAR (FLIPNODE NEAR DS)) (SETQ NOW NEAR) LP (GETMOUSESTATE) (COND ((LASTMOUSESTATE (NOT UP)) (* button up, process it.) (AND NOW (FLIPNODE NOW DS)) (* NOW node has been selected.) ) ([EQ NOW (SETQ NEAR (NODELST/AS/MENU NODELST (CURSORPOSITION NIL DS OLDPOS] (GO LP)) (T (GO FLIP))) (printout PROMPTWINDOW T "Holding the button down, " "move the node to its new position" "and release the button.") (TRACKCURSOR NOW DS GRAPH) (printout PROMPTWINDOW T "Done."]) (FLIPNODE [LAMBDA (DSPND DS) (* rrb "13-JUL-81 11:20") (* flips the region around a node.) (PROG ((POS (LOWER/LEFT/POSITION DSPND)) (IMAGEBM (LABEL/BITMAP DSPND))) (BITBLT NIL NIL NIL DS (IDIFFERENCE (fetch XCOORD of POS) 2) (IDIFFERENCE (fetch YCOORD of POS) 2) (IPLUS (fetch BITMAPWIDTH of IMAGEBM) 4) (IPLUS (fetch BITMAPHEIGHT of IMAGEBM) 4) (QUOTE TEXTURE) (QUOTE INVERT) BLACKSHADE) (RETURN]) (FONTNAMELIST [LAMBDA (FONTDESC) (* rrb " 2-NOV-83 21:00") (LIST (FONTPROP FONTDESC (QUOTE FAMILY)) (FONTPROP FONTDESC (QUOTE SIZE)) (FONTPROP FONTDESC (QUOTE FACE]) (FROMLINKS [LAMBDA (NODE) (* rrb "13-JUL-81 10:55") (fetch FROMNODES of NODE]) (GETNODEFROMID [LAMBDA (ID NODELST) (* kvl "22-DEC-83 17:55") (OR (FASSOC ID NODELST) (ERROR "No graphnode for nodeid:" ID]) (GRAPHADDLINK [LAMBDA (FROM TO GRAPH WINDOW) (* rrb " 1-NOV-83 09:18") (* links two nodes) (PROG ((ADDFN (fetch (GRAPH GRAPH.ADDLINKFN) of GRAPH))) (AND ADDFN (APPLY* ADDFN FROM TO GRAPH WINDOW))) (push (fetch FROMNODES of TO) (fetch NODEID of FROM)) (push (fetch TONODES of FROM) (fetch NODEID of TO]) (GRAPHADDNODE [LAMBDA (GRAPH W) (* rrb " 2-NOV-83 20:29") (* adds a node to the graph GRAPH) (PROG (ADDFN NODE) (OR [SETQ NODE (COND ((SETQ ADDFN (fetch (GRAPH GRAPH.ADDNODEFN) of GRAPH)) (APPLY* ADDFN GRAPH W)) (T (DEFAULT.ADDNODEFN GRAPH W T] (RETURN)) (replace (GRAPH GRAPHNODES) of GRAPH with (NCONC1 (fetch (GRAPH GRAPHNODES) of GRAPH) NODE)) (RETURN NODE]) (GRAPHDELETELINK [LAMBDA (FROM TO GRAPH WINDOW) (* rrb " 1-NOV-83 09:16") (* deletes a link from a graph) (PROG ((DELFN (fetch (GRAPH GRAPH.DELETELINKFN) of GRAPH))) (AND DELFN (APPLY* DELFN FROM TO GRAPH WINDOW))) (replace TONODES of FROM with (REMOVE (fetch NODEID of TO) (fetch TONODES of FROM))) (replace FROMNODES of TO with (REMOVE (fetch NODEID of FROM) (fetch FROMNODES of TO]) (GRAPHDELETENODE [LAMBDA (NODE GRAPH WINDOW) (* rrb " 1-NOV-83 11:52") (PROG ((DELFN (fetch (GRAPH GRAPH.DELETENODEFN) of GRAPH))) (AND DELFN (APPLY* DELFN NODE GRAPH WINDOW)) (replace (GRAPH GRAPHNODES) of GRAPH with (DREMOVE NODE (fetch (GRAPH GRAPHNODES) of GRAPH]) (GRAPHEDITCOMMANDFN [LAMBDA (GRAPHWINDOW) (* rrb " 2-NOV-83 21:26") (SELECTQ [MENU (COND ((type? MENU EDITGRAPHMENU) EDITGRAPHMENU) (T (SETQ EDITGRAPHMENU (create MENU ITEMS ←(QUOTE (("Move Node" (QUOTE MOVENODE)) ("Add Node" (QUOTE ADDNODE)) ("Delete Node" (QUOTE DELETENODE)) ("Add Link" (QUOTE ADDLINK)) ("Delete Link" (QUOTE DELETELINK)) ("label smaller" (QUOTE SMALLER)) ("label larger" (QUOTE LARGER)) ("<-> Directed" (QUOTE DIRECTED)) ("<-> Sides" (QUOTE SIDES)) STOP)) CENTERFLG ← T CHANGEOFFSETFLG ← T] (STOP (QUOTE STOP)) (MOVENODE (EDITMOVENODE GRAPHWINDOW)) (ADDNODE (EDITADDNODE GRAPHWINDOW)) (DELETENODE (EDITDELETENODE GRAPHWINDOW)) (ADDLINK (EDITADDLINK GRAPHWINDOW)) (SMALLER (EDITCHANGEFONT (QUOTE SMALLER) GRAPHWINDOW)) (LARGER (EDITCHANGEFONT (QUOTE LARGER) GRAPHWINDOW)) (DELETELINK (EDITDELETELINK GRAPHWINDOW)) (DIRECTED (TOGGLE/DIRECTEDFLG GRAPHWINDOW)) (SIDES (TOGGLE/SIDESFLG GRAPHWINDOW)) NIL]) (GRAPHEDITEVENTFN [LAMBDA (GRWINDOW) (* rrb " 8-NOV-83 10:21") (* implements a graph editor on the right button transition of a window.) (COND ((NOT (INSIDE? (DSPCLIPPINGREGION NIL GRWINDOW) (LASTMOUSEX GRWINDOW) (LASTMOUSEY GRWINDOW))) (DOWINDOWCOM GRWINDOW)) ((SHIFTP) (TRACKNODE GRWINDOW)) ((EQ (GRAPHEDITCOMMANDFN GRWINDOW) (QUOTE STOP)) (* do menu) (CLOSEW GRWINDOW]) (GRAPHMOVENODE [LAMBDA (NODE NEWPOS GRAPH WINDOW) (* rrb " 1-NOV-83 12:03") (* moves a node but doesn't change any display.) (COND ((EQUAL (LAYOUT/POSITION NODE) NEWPOS) (* don't move if position hasn't changed) NIL) (T (SET/LAYOUT/POSITION NODE NEWPOS) (CALL.MOVENODEFN NODE NEWPOS GRAPH WINDOW]) (GRAPHREGION [LAMBDA (GRAPH) (* rrb " 8-NOV-83 12:13") (* Returns the minimum region containing the graph.) (PROG (LEFTOFFSET BOTTOMOFFSET (NODELST (fetch GRAPHNODES of GRAPH))) (RETURN (COND [NODELST (* make sure the dimensions of the node labels have been determined.) (CACHE/NODE/LABELS NODELST) (CREATEREGION (SETQ LEFTOFFSET (MIN/LEFT NODELST)) (SETQ BOTTOMOFFSET (MIN/BOTTOM NODELST)) (ADD1 (IDIFFERENCE (MAX/RIGHT NODELST) LEFTOFFSET)) (ADD1 (IDIFFERENCE (MAX/TOP NODELST) BOTTOMOFFSET] (T (CREATEREGION 0 0 0 0]) (LABEL/BITMAP [LAMBDA (NODE) (* kvl "27-DEC-83 19:10") (OR (fetch NODELABELBITMAP of NODE) (ERROR NODE "DOESN'T HAVE A LABEL BITMAP."]) (LAYOUT/POSITION [LAMBDA (NODE) (* rrb "13-JUL-81 10:54") (fetch NODEPOSITION of NODE]) (LOWER/LEFT/POSITION [LAMBDA (NODE) (PROG ((POS (LAYOUT/POSITION NODE))) (RETURN (create POSITION XCOORD ←(IDIFFERENCE (fetch XCOORD of POS) (HALF (fetch NODEWIDTH of NODE))) YCOORD ←(IDIFFERENCE (fetch YCOORD of POS) (HALF (fetch NODEHEIGHT of NODE]) (MANHATTANDIST [LAMBDA (POS1 POS2) (* rrb "13-FEB-81 16:19") (* simple measure of closeness) (IPLUS (ABS (IDIFFERENCE (fetch XCOORD of POS1) (fetch XCOORD of POS2))) (ABS (IDIFFERENCE (fetch YCOORD of POS1) (fetch YCOORD of POS2]) (MAX/RIGHT [LAMBDA (NODES) (* kbr: "21-AUG-83 13:02") (bind NR (RIGHT ← MIN.FIXP) for NODE in NODES do (COND ((IGREATERP (SETQ NR (NODE/RIGHT NODE)) RIGHT) (SETQ RIGHT NR))) finally (RETURN RIGHT]) (MAX/TOP [LAMBDA (NODES) (* kbr: "21-AUG-83 13:02") (bind NR (TOP ← MIN.FIXP) for NODE in NODES do (COND ((IGREATERP (SETQ NR (NODE/TOP NODE)) TOP) (SETQ TOP NR))) finally (RETURN TOP]) (MIN/BOTTOM [LAMBDA (NODES) (* kbr: "21-AUG-83 16:36") (* returns the bottommost point of the graph.) (bind NL (BOTTOM ← MAX.FIXP) for NODE in NODES do (COND ((IGREATERP BOTTOM (SETQ NL (NODE/BOTTOM NODE))) (SETQ BOTTOM NL))) finally (RETURN BOTTOM]) (MIN/LEFT [LAMBDA (NODES) (* kbr: "21-AUG-83 13:04") (* returns the leftmost point of the graph.) (bind NL (LEFT ← MAX.FIXP) for NODE in NODES do (COND ((IGREATERP LEFT (SETQ NL (NODE/LEFT NODE))) (SETQ LEFT NL))) finally (RETURN LEFT]) (MOVENODE [LAMBDA (DSND OLDPOS POS GRAPH DS) (* rrb "31-OCT-83 18:47") (* moves a node from its current position to POS) (COND ((EQUAL OLDPOS POS) (* don't move if position hasn't changed) NIL) (T (* node is flipped, flip it back.) (FLIPNODE DSND DS) (* erase current position) (DISPLAYNODE DSND DS GRAPH) (* put it in new one.) (SET/LAYOUT/POSITION DSND POS) (DISPLAYNODE DSND DS GRAPH) (FLIPNODE DSND DS]) (NODE/BOTTOM [LAMBDA (NODE) (* kvl "22-DEC-83 18:13") (* returns the bottom edge of a node.) (OR (fetch YCOORD of (fetch (GRAPHNODE NODEBOTTOM) of NODE)) (IDIFFERENCE (fetch YCOORD of (fetch (GRAPHNODE NODEPOSITION) of NODE)) (HALF (fetch (GRAPHNODE NODEWIDTH) of NODE]) (NODE/LEFT [LAMBDA (NODE) (* kvl "22-DEC-83 19:37") (* returns the left edge of a node.) (OR (fetch XCOORD of (fetch (GRAPHNODE NODELEFT) of NODE)) (IDIFFERENCE (fetch XCOORD of (fetch (GRAPHNODE NODEPOSITION) of NODE)) (HALF (fetch (GRAPHNODE NODEWIDTH) of NODE]) (NODE/RIGHT [LAMBDA (NODE) (* kvl "22-DEC-83 19:44") (* returns the right edge of a node.) (OR (fetch (POSITION XCOORD) of (fetch (GRAPHNODE NODERIGHT) of NODE)) (IPLUS (fetch XCOORD of (fetch (GRAPHNODE NODEPOSITION) of NODE)) (HALF (fetch (GRAPHNODE NODEWIDTH) of NODE]) (NODE/TOP [LAMBDA (NODE) (* kvl "22-DEC-83 18:15") (* returns the top edge of a node.) (OR (fetch YCOORD of (fetch (GRAPHNODE NODETOP) of NODE)) (IPLUS (fetch YCOORD of (fetch (GRAPHNODE NODEPOSITION) of NODE)) (HALF (fetch (GRAPHNODE NODEHEIGHT) of NODE]) (NODEBOXHEIGHT [LAMBDA (NODE FONT) (* edited: "18-OCT-81 18:31") (* determines the height of the label box. For now assume one line) (FONTPROP FONT (QUOTE HEIGHT]) (NODEBOXWIDTH [LAMBDA (NODE FONT) (* kvl "22-DEC-83 16:30") (IPLUS (STRINGWIDTH (fetch NODELABEL of NODE) FONT) (ITIMES NODEBOARDERWIDTH 2) 2]) (NODECREATE [LAMBDA (ID LABEL POS TONODEIDS FROMNODEIDS FONT BOXED?) (* rrb " 2-NOV-83 21:01") (* creates a node for a grapher.) (create GRAPHNODE NODEID ← ID NODEPOSITION ← POS NODELABEL ← LABEL NODEFONT ←(OR FONT (FONTNAMELIST (CADR DEFAULTFONT))) BOXNODEFLG ← BOXED? TONODES ← TONODEIDS FROMNODES ← FROMNODEIDS]) (NODELST/AS/MENU [LAMBDA (NODELST POS) (* kvl "20-APR-82 14:57") (* finds the node that is closest to POS) (for N in NODELST bind (X ←(fetch XCOORD of POS)) (Y ←(fetch YCOORD of POS)) thereis (AND (ILESSP (fetch XCOORD of (fetch NODELEFT of N)) X) (ILESSP X (fetch XCOORD of (fetch NODERIGHT of N))) (ILESSP (fetch YCOORD of (fetch NODEBOTTOM of N)) Y) (ILESSP Y (fetch YCOORD of (fetch NODETOP of N]) (NODEREGION [LAMBDA (NODE) (* rrb " 2-NOV-83 14:33") (* returns the region taken up by NODE) (CREATEREGION (fetch (POSITION XCOORD) of (fetch (GRAPHNODE NODELEFT) of NODE)) (fetch (POSITION YCOORD) of (fetch (GRAPHNODE NODEBOTTOM) of NODE)) (fetch (GRAPHNODE NODEWIDTH) of NODE) (fetch (GRAPHNODE NODEHEIGHT) of NODE]) (PRINTDISPLAYNODE [LAMBDA (DSPND DS) (* rrb " 2-NOV-83 14:56") (* prints a display node at a position Uses cached bitmap.) (OR (EQ (fetch (GRAPHNODE NODEHEIGHT) of DSPND) 0) (PROG ((POS (LOWER/LEFT/POSITION DSPND))) (RETURN (BITBLT (LABEL/BITMAP DSPND) 0 0 DS (fetch XCOORD of POS) (fetch YCOORD of POS) NIL NIL NIL (DSPOPERATION NIL DS]) (PROMPTINWINDOW [LAMBDA (PROMPTSTR POSITION WHICHCORNER BORDERSIZE) (* rrb "16-Jan-84 11:48") (* opens a small window for prompting at a position and PROMPTFORWORD's a word.) (* POSITION is the location in screen coordinate of the window. Default is the cursor position.) (* WHICHCORNER can be a list of up to two of the atoms LEFT RIGHT TOP BOTTOM which specify which corner position is intended to be. Default is lower left.) (* BORDERSIZE is the border size of the prompt window. Default is 6.0) (PROG ((PROMPTWBORDER (OR (NUMBERP BORDERSIZE) 6)) (X (COND (POSITION (fetch (POSITION XCOORD) of POSITION)) (T LASTMOUSEX))) (Y (COND (POSITION (fetch (POSITION YCOORD) of POSITION)) (T LASTMOUSEY))) HGHT WDTH READSTR PREVTTY) (SETQ HGHT (HEIGHTIFWINDOW (ITIMES (FONTPROP (DEFAULTFONT (QUOTE DISPLAY)) (QUOTE HEIGHT)) 2) T PROMPTWBORDER)) (SETQ WDTH (WIDTHIFWINDOW (IMAX (STRINGWIDTH PROMPTSTR WindowTitleDisplayStream) 60) PROMPTWBORDER)) (SETQ PREVTTY (TTYDISPLAYSTREAM (CREATEW (CREATEREGION (COND ((MEMB (QUOTE RIGHT) WHICHCORNER) (DIFFERENCE X WDTH)) (T X)) (COND ((MEMB (QUOTE TOP) WHICHCORNER) (DIFFERENCE Y HGHT)) (T Y)) WDTH HGHT) PROMPTSTR PROMPTWBORDER))) (DSPLEFTMARGIN (IMAX 0 (fetch (CURSOR CURSORHOTSPOTX) of (CARET))) (TTYDISPLAYSTREAM)) (MOVETOUPPERLEFT (TTYDISPLAYSTREAM)) [SETQ READSTR (ERSETQ (PROMPTFORWORD NIL NIL NIL NIL NIL NIL (CONS (CHARCODE EOL] (CLOSEW (TTYDISPLAYSTREAM PREVTTY)) (RETURN (COND (READSTR (CAR READSTR)) (T (* pass back the error.) (ERROR!]) (READ/NODE [LAMBDA (NODES DS) (* kvl "20-JUL-82 08:05") (until (MOUSESTATE (OR LEFT MIDDLE)) do) (COND ((LASTMOUSESTATE MIDDLE) (ERROR!))) (PROG (NEAR NOW OLDPOS) [SETQ NEAR (CLOSEST/NODE NODES (SETQ OLDPOS (CURSORPOSITION NIL DS] FLIP (* turn off old flip (if one) and turn on new flip.) (AND NOW (FLIPNODE NOW DS)) (FLIPNODE (SETQ NOW NEAR) DS) LP (COND ((MOUSESTATE UP) (FLIPNODE NOW DS) (RETURN NOW)) ((MOUSESTATE MIDDLE) (FLIPNODE NOW DS) (ERROR!)) ([EQ NOW (SETQ NEAR (CLOSEST/NODE NODES (CURSORPOSITION NIL DS OLDPOS] (GO LP)) (T (GO FLIP]) (REDISPLAYGRAPH [LAMBDA (WINDOW REGION) (* kvl "12-SEP-82 09:32") (* displays the graph that is in a window. REGION if given is the clipping region. Later this could be used to make things run faster. Draws links first then labels so that lattices don't have lines through the labels.) (DSPFILL NIL NIL (QUOTE REPLACE) WINDOW) (for NS in (fetch (GRAPH GRAPHNODES) of (WINDOWPROP WINDOW (QUOTE GRAPH))) bind (G ←(WINDOWPROP WINDOW (QUOTE GRAPH))) (DS ←(WINDOWPROP WINDOW (QUOTE DSP))) do (DISPLAYNODELINKS NS DS G T)) (for NS in (fetch (GRAPH GRAPHNODES) of (WINDOWPROP WINDOW (QUOTE GRAPH))) bind (DS ←(WINDOWPROP WINDOW (QUOTE DSP))) do (PRINTDISPLAYNODE NS DS]) (RIGHTOF [LAMBDA (POS1 POS2) (* rrb "13-JUL-81 10:46") (* is pos1 above pos2?) (IGREATERP (fetch XCOORD of POS1) (fetch XCOORD of POS2]) (SET/LABEL/SIZE [LAMBDA (NODE) (* kvl "27-DEC-83 19:12") (* the SHADE and null font stuff is for ZOOMGRAPH) (PROG ((FONT (fetch (GRAPHNODE NODEFONT) of NODE)) (LAB (fetch (GRAPHNODE NODELABEL) of NODE)) WIDTH HEIGHT) [COND ((BITMAPP LAB) (SETQ WIDTH (BITMAPWIDTH LAB)) (SETQ HEIGHT (BITMAPHEIGHT LAB))) ((EQ FONT (QUOTE SHADE)) (* node image is very small) (SETQ WIDTH (SETQ HEIGHT 2))) ((NULL FONT) (* FONT of NIL means that the node is smaller than displays) (SETQ WIDTH (SETQ HEIGHT 0))) (T (OR (FONTP FONT) (SETQ FONT (FONTCREATE FONT))) (SETQ WIDTH (NODEBOXWIDTH NODE FONT)) (SETQ HEIGHT (NODEBOXHEIGHT NODE FONT] (replace NODEWIDTH of NODE with WIDTH) (replace NODEHEIGHT of NODE with HEIGHT) (RETURN NODE]) (SET/LAYOUT/POSITION [LAMBDA (NODE POS) (* rrb " 1-NOV-83 18:52") (* sets a nodes position and recalculates the fields that depend on it.) (PROG ((X (fetch XCOORD of POS)) (Y (fetch YCOORD of POS))) (replace XCOORD of (LAYOUT/POSITION NODE) with X) (replace YCOORD of (LAYOUT/POSITION NODE) with Y) (* if node isn't being displayed, the other fields don't exist.) (OR (fetch NODEHEIGHT of NODE) (RETURN NODE)) [replace NODETOP of NODE with (create POSITION XCOORD ← X YCOORD ←(IPLUS Y (HALF (fetch NODEHEIGHT of NODE] [replace NODEBOTTOM of NODE with (create POSITION XCOORD ← X YCOORD ←(IDIFFERENCE Y (HALF (fetch NODEHEIGHT of NODE] (replace NODERIGHT of NODE with (create POSITION XCOORD ←(IPLUS X (HALF (fetch NODEWIDTH of NODE))) YCOORD ← Y)) (replace NODELEFT of NODE with (create POSITION XCOORD ←(IDIFFERENCE X (HALF (fetch NODEWIDTH of NODE))) YCOORD ← Y)) (RETURN NODE]) (SHIFTP [LAMBDA NIL (* rrb " 8-NOV-83 10:09") (* is a shift key down) (OR (KEYDOWNP (QUOTE RSHIFT)) (KEYDOWNP (QUOTE LSHIFT]) (SHOWGRAPH [LAMBDA (GRAPH WINDOW LEFTBUTTONFN MIDDLEBUTTONFN TOPJUSTIFYFLG ALLOWEDITFLG) (* rrb "22-NOV-83 11:38") (* puts a graph in the given window, creating one if a window is not given.) (SETQ WINDOW (SIZE/GRAPH/WINDOW (COND ((NULL GRAPH) (SETQ GRAPH (create GRAPH))) (T GRAPH)) (COND (WINDOW) (ALLOWEDITFLG (* put on a blank title so there will be a place to get window commands.) "")) TOPJUSTIFYFLG)) (WINDOWPROP WINDOW (QUOTE GRAPH) GRAPH) (WINDOWPROP WINDOW (QUOTE REPAINTFN) (FUNCTION REDISPLAYGRAPH)) (WINDOWPROP WINDOW (QUOTE SCROLLFN) (FUNCTION SCROLLBYREPAINTFN)) [COND (ALLOWEDITFLG (* change the mode to invert so lines can be erased by being redrawn.) (DSPOPERATION (QUOTE INVERT) WINDOW) (WINDOWPROP WINDOW (QUOTE RIGHTBUTTONFN) (FUNCTION GRAPHEDITEVENTFN] (WINDOWPROP WINDOW (QUOTE BUTTONEVENTFN) (FUNCTION APPLYTOSELECTEDNODE)) (WINDOWPROP WINDOW (QUOTE BROWSER/LEFTFN) LEFTBUTTONFN) (WINDOWPROP WINDOW (QUOTE BROWSER/MIDDLEFN) MIDDLEBUTTONFN) (REDISPLAYGRAPH WINDOW) WINDOW]) (SIZE/GRAPH/WINDOW [LAMBDA (GRAPH WINDOW/TITLE TOPJUSTIFYFLG) (* rrb " 8-NOV-83 13:28") (* returns a window sized to fit the given graph. WINDOW/TITLE can be either a window to be printed in or a title of a window to be created. If TOPJUSTIFYFLG is true, scrolls so top of graph is at top of window, else puts bottom of graph at bottom of window.) (PROG ((GRAPHREG (GRAPHREGION GRAPH)) TITLE WINDOW) (COND ((WINDOWP WINDOW/TITLE) (SETQ WINDOW WINDOW/TITLE)) (T (SETQ TITLE WINDOW/TITLE))) (* if there is not already a window, ask the user for one to fit.) (COND ((NULL WINDOW) (SETQ WINDOW (CREATEW (GETBOXREGION (WIDTHIFWINDOW (IMIN (IMAX (fetch (REGION WIDTH) of GRAPHREG) 100) 500)) (HEIGHTIFWINDOW (IMIN (IMAX (fetch (REGION HEIGHT) of GRAPHREG) 60) (IQUOTIENT SCREENHEIGHT 2)) TITLE)) TITLE))) (T (CLEARW WINDOW))) (WINDOWPROP WINDOW (QUOTE EXTENT) GRAPHREG) (WXOFFSET (IDIFFERENCE (WXOFFSET NIL WINDOW) (fetch (REGION LEFT) of GRAPHREG)) WINDOW) (WYOFFSET [IDIFFERENCE (WYOFFSET NIL WINDOW) (COND [TOPJUSTIFYFLG (IDIFFERENCE (fetch (REGION TOP) of GRAPHREG) (WINDOWPROP WINDOW (QUOTE HEIGHT] (T (fetch (REGION BOTTOM) of GRAPHREG] WINDOW) (RETURN WINDOW]) (TOGGLE/DIRECTEDFLG [LAMBDA (WIN) (* kvl "20-APR-82 13:38") (* flips the value of the flag that indicates whether the graph is a lattice.) [replace (GRAPH DIRECTEDFLG) of (WINDOWPROP WIN (QUOTE GRAPH)) with (NOT (fetch (GRAPH DIRECTEDFLG) of (WINDOWPROP WIN (QUOTE GRAPH] (DSPFILL NIL (DSPTEXTURE NIL WIN) (QUOTE REPLACE) WIN) (REDISPLAYGRAPH WIN]) (TOGGLE/SIDESFLG [LAMBDA (WIN) (* kvl "20-APR-82 13:15") (* flips the value of the flag that indicates whether the graph is to be layed out vertically or horizontally.) [replace (GRAPH SIDESFLG) of (WINDOWPROP WIN (QUOTE GRAPH)) with (NOT (fetch (GRAPH SIDESFLG) of (WINDOWPROP WIN (QUOTE GRAPH] (DSPFILL NIL (DSPTEXTURE NIL WIN) (QUOTE REPLACE) WIN) (REDISPLAYGRAPH WIN]) (TOLINKS [LAMBDA (NODE) (* rrb "13-JUL-81 10:55") (fetch TONODES of NODE]) (TRACKCURSOR [LAMBDA (ND DS GRAPH) (* rrb " 2-NOV-83 14:31") (* causes ND to follow cursor.) (PROG (OLDPOS ORIGPOS DOWNFLG) (* maybe there aren't any nodes) (OR ND (RETURN)) (SETQ ORIGPOS (COPYALL (LAYOUT/POSITION ND))) (SETQ OLDPOS (CURSORPOSITION (LAYOUT/POSITION ND) DS)) (FLIPNODE ND DS) (until (COND (DOWNFLG (MOUSESTATE UP)) ((SETQ DOWNFLG (MOUSESTATE (NOT UP))) NIL)) do (MOVENODE ND (LAYOUT/POSITION ND) (CURSORPOSITION NIL DS OLDPOS) GRAPH DS)) (FLIPNODE ND DS) (COND ([NOT (EQUAL ORIGPOS (SETQ OLDPOS (LAYOUT/POSITION ND] (EXTENDEXTENT (WFROMDS DS) (NODEREGION ND)) (CALL.MOVENODEFN ND OLDPOS GRAPH (WFROMDS DS]) (TRACKNODE [LAMBDA (W) (* kvl "20-APR-82 13:43") (* grabs the nearest nodes and hauls it around with the cursor, leaving it where it is when the button goes up.) (TRACKCURSOR (CLOSEST/NODE (fetch (GRAPH GRAPHNODES) of (WINDOWPROP W (QUOTE GRAPH))) (CURSORPOSITION NIL W)) (WINDOWPROP W (QUOTE DSP)) (WINDOWPROP W (QUOTE GRAPH]) ) (* functions for finding larger and smaller fonts) (DEFINEQ (NEXTSIZEFONT [LAMBDA (WHICHDIR NOWFONT) (* rrb " 7-NOV-83 14:00") (* returns the next sized font either SMALLER or LARGER that on of size FONT. (NEXTSIZEFONT (QUOTE LARGER) (CADR DEFAULTFONT))) (PROG [(NOWSIZE (FONTPROP NOWFONT (QUOTE HEIGHT] (RETURN (COND [(EQ WHICHDIR (QUOTE LARGER)) (COND ((IGEQ NOWSIZE (FONTPROP (CAR DECREASING.FONT.LIST) (QUOTE HEIGHT))) (* nothing larger) NIL) (T (for FONTTAIL on DECREASING.FONT.LIST when [AND (CDR FONTTAIL) (IGEQ NOWSIZE (FONTPROP (CADR FONTTAIL) (QUOTE HEIGHT] do (RETURN (FONTNAMELIST (CAR FONTTAIL] (T (for FONT in DECREASING.FONT.LIST when (LESSP (FONTPROP FONT (QUOTE HEIGHT)) NOWSIZE) do (RETURN (FONTNAMELIST FONT]) (DECREASING.FONT.LIST [LAMBDA NIL (* rrb "16-Dec-83 12:28") (* returns a list of the font descriptors for the fonts sketch windows are willing to print in.) (for SIZE in (QUOTE (18 14 12 10 8 5)) collect (FONTCREATE (QUOTE HELVETICA) SIZE]) (SCALE.FONT [LAMBDA (WID STR) (* rrb " 7-NOV-83 11:35") (* returns the font that text should be printed in to have the text STR fit into a region WID points wide) (COND ((GREATERP WID (TIMES (STRINGWIDTH STR (CAR DECREASING.FONT.LIST)) 1.5)) (* scale it too large for even the largest font.) NIL) (T (for FONT in DECREASING.FONT.LIST when (NOT (GREATERP (STRINGWIDTH STR FONT) WID)) do (RETURN FONT) finally (RETURN (QUOTE SHADE]) ) (RPAQ DECREASING.FONT.LIST (DECREASING.FONT.LIST)) (DECLARE: DOEVAL@COMPILE DONTCOPY (ADDTOVAR GLOBALVARS DECREASING.FONT.LIST) ) (* functions for LAYOUTFOREST. LAYOUTGRAPH And LAYOUTLATTICE) (DEFINEQ (BRH/LAYOUT [LAMBDA (N X Y MOMLST GN) (* kvl "26-DEC-83 16:44") (* X and Y are the lower left corner of the box that will surround the tree headed by the browsenode N. MOMLST is the mother node inside a cons cell. GN is the graphnode for the nodeid N. It is crucial that the NODEPOSITION be set before recursion because this marks that the node has been (is being) laid out already. BRH/OFFSET is used to raise the daughters in those rare cases where the label is bigger than the daughters.) (DECLARE (USEDFREE MOTHERD PERSONALD NODELST)) (PROG ((DS (fetch (GRAPHNODE TONODES) of GN)) (W (fetch (GRAPHNODE NODEWIDTH) of GN)) (YHEIGHT (IPLUS PERSONALD (fetch (GRAPHNODE NODEHEIGHT) of GN))) DHEIGHT) (replace (GRAPHNODE FROMNODES) of GN with MOMLST) [replace (GRAPHNODE NODEPOSITION) of GN with (create POSITION XCOORD ←(IPLUS X (HALF W] (COND ((NULL DS)) [[IGREATERP YHEIGHT (SETQ DHEIGHT (BRH/LAYOUT/DAUGHTERS DS (IPLUS X W MOTHERD) Y (LIST N] (BRH/OFFSET DS (HALF (IDIFFERENCE YHEIGHT DHEIGHT] (T (SETQ YHEIGHT DHEIGHT))) (replace YCOORD of (fetch (GRAPHNODE NODEPOSITION) of GN) with (IPLUS Y (HALF YHEIGHT))) (RETURN YHEIGHT]) (BRH/LAYOUT/DAUGHTERS [LAMBDA (DS X Y MOMLST) (* kvl "26-DEC-83 12:19") (* DS are the daughters of (CAR MOMLST). X is where the left edge of their labels will be, and Y is the bottom of the mother's box. Returns the height of the mother's box. Tests to see if a node has been layout out already If so, it replaces the daughter with one that has no descendents, and splices into the mother's daughter list, side-effecting the graphnode structure.) (DECLARE (USEDFREE NODELST)) (for DTAIL on DS bind D GN (FLOOR ← Y) finally (RETURN (IDIFFERENCE FLOOR Y)) do (SETQ GN (GETNODEFROMID (SETQ D (CAR DTAIL)) NODELST)) [COND ((fetch (GRAPHNODE NODEPOSITION) of GN) (SETQ GN (NEW/INSTANCE/OF/GRAPHNODE GN)) (RPLACA DTAIL (SETQ D (fetch (GRAPHNODE NODEID) of GN] (SETQ FLOOR (IPLUS FLOOR (BRH/LAYOUT D X FLOOR MOMLST GN]) (BRH/OFFSET [LAMBDA (NODEIDS YINC) (DECLARE (USEDFREE NODELST)) (* kvl "26-DEC-83 12:31") (for N in NODEIDS do (SETQ N (GETNODEFROMID N NODELST)) (add (fetch YCOORD of (fetch (GRAPHNODE NODEPOSITION) of N) Y) YINC) (BRH/OFFSET (fetch (GRAPHNODE TONODES) of N) YINC]) (BRHC/INTERTREE/SPACE [LAMBDA (TTC BTC) (* kvl "21-DEC-83 10:23") (* Given the top transition chain of the old daughter and the bottom transition chain of the new daughter, where BTC is sitting on the bottom of the box, calculate how much the bottom must be raised so that it just clears the TTC. OP is the top left corner of some label. NP is the bottom left corner.) (PROG ((RAISE -1000) NP DIST OP) (SETQ OP (pop TTC)) (SETQ NP (pop BTC)) L (SETQ DIST (IDIFFERENCE (fetch YCOORD of OP) (fetch YCOORD of NP))) (AND (IGREATERP DIST RAISE) (SETQ RAISE DIST)) [COND ((NULL BTC) (RETURN RAISE)) ((NULL TTC) (RETURN RAISE)) ((IEQP (fetch XCOORD of (CAR BTC)) (fetch XCOORD of (CAR TTC))) (SETQ NP (pop BTC)) (SETQ OP (pop TTC))) ((ILESSP (fetch XCOORD of (CAR BTC)) (fetch XCOORD of (CAR TTC))) (SETQ NP (pop BTC))) (T (SETQ OP (pop TTC] (GO L]) (BRHC/LAYOUT [LAMBDA (N X MOMLST GN) (* kvl "27-DEC-83 19:14") (* See comment on BRH/LAYOUT. Instead of keeping only the graphnode in layed out browsenode's position field, keep the offset as well. The offset is how much this nodes box must be raised relative to the inclosing box. Uses two global variables to return transition chains. RETURN/TTC is the top left corners of all the labels. RETURN/BTC is the bottom left corners.) (DECLARE (USEDFREE PERSONALD) (GLOBALVARS RETURN/TTC RETURN/BTC)) (PROG ((DS (fetch (GRAPHNODE TONODES) of GN)) (W (fetch (GRAPHNODE NODEWIDTH) of GN)) (H (fetch (GRAPHNODE NODEHEIGHT) of GN)) YCENTER X/SW H/2) (SETQ H/2 (HALF H)) (SETQ X/SW (IPLUS X W)) (replace (GRAPHNODE FROMNODES) of GN with MOMLST) (replace (GRAPHNODE NODEPOSITION) of GN with (LIST 0)) [SETQ YCENTER (COND (DS (BRHC/LAYOUT/DAUGHTERS DS X/SW (LIST N))) (T (BRHC/LAYOUT/TERMINAL GN X/SW] (RPLACD (fetch (GRAPHNODE NODEPOSITION) of GN) (create POSITION XCOORD ←(IPLUS X (HALF W)) YCOORD ← YCENTER)) (SETQ RETURN/TTC (CONS (create POSITION XCOORD ← X YCOORD ←(IPLUS PERSONALD (IPLUS (IDIFFERENCE YCENTER H/2) H))) RETURN/TTC)) (SETQ RETURN/BTC (CONS (create POSITION XCOORD ← X YCOORD ←(IDIFFERENCE YCENTER H/2)) RETURN/BTC)) (RETURN YCENTER]) (BRHC/LAYOUT/DAUGHTERS [LAMBDA (DS X/SW MOMLST) (DECLARE (GLOBALVARS RETURN/TTC RETURN/BTC) (USEDFREE MOTHERD FAMILYD NODELST)) (* kvl "21-DEC-83 12:34") (* see comment on BRH/LAYOUT/DAUGHTERS. First daughter is always laid out on the bottom of the box. Subsequent daughters have the amount that they are to be raised calculated by comparing the top edge of the old daughter (in TTC) with the bottom edge of the new daughter (in RETURN/BTC). TTC is update by adding the new daughter's transition chain to the front, because the new daughter's front is guaranteed to be higher than the old daughter's front. Conversely, BTC is updated by adding the new daughter's transition chain to the back, because the old daughter's front is guaranteed to be lower.) (for DTAIL on DS bind D GN BTC TTC 1ST/DCENTER LST/DCENTER (OFFSET ← 0) (X ←(IPLUS X/SW MOTHERD)) do (SETQ D (CAR DTAIL)) (SETQ GN (GETNODEFROMID D NODELST)) [COND ((fetch (GRAPHNODE NODEPOSITION) of GN) (SETQ GN (NEW/INSTANCE/OF/GRAPHNODE GN)) (RPLACA DTAIL (SETQ D (fetch (GRAPHNODE NODEID) of GN] (SETQ LST/DCENTER (BRHC/LAYOUT D X MOMLST GN)) [COND ((NULL TTC) (* first daughter) (SETQ 1ST/DCENTER LST/DCENTER) (SETQ TTC RETURN/TTC) (SETQ BTC RETURN/BTC)) (T (SETQ OFFSET (BRHC/INTERTREE/SPACE TTC RETURN/BTC)) (RPLACA (fetch (GRAPHNODE NODEPOSITION) of GN) OFFSET) (SETQ TTC (EXTEND/TRANSITION/CHAIN (RAISE/TRANSITION/CHAIN RETURN/TTC OFFSET) TTC)) (SETQ BTC (EXTEND/TRANSITION/CHAIN BTC (RAISE/TRANSITION/CHAIN RETURN/BTC OFFSET] finally (* add a mythical top left corner at the height of the highest daughter because diagnonal links are getting clobbered. Move lowest daughter's bottom left corner to the left for the same reason.) (SETQ RETURN/TTC (CONS (create POSITION XCOORD ← X/SW YCOORD ←(fetch YCOORD of (CAR TTC))) TTC)) (replace XCOORD of (CAR BTC) with X/SW) (add (fetch YCOORD of (CAR TTC)) FAMILYD) (SETQ RETURN/BTC BTC) (* center of mother is halfway between first and last daughter's label centers using fact that offset of first daughter is zero and last daughter's offset is OFFSET) (RETURN (HALF (IPLUS 1ST/DCENTER OFFSET LST/DCENTER]) (BRHC/LAYOUT/TERMINAL [LAMBDA (GN X/SW) (* kvl "21-DEC-83 12:43") (* initiallizes the transition chains to the right edge of the node label, and returns the label's center.) (DECLARE (GLOBALVARS RETURN/TTC RETURN/TBC)) (SETQ RETURN/TTC (LIST (create POSITION XCOORD ← X/SW YCOORD ← 0))) [SETQ RETURN/BTC (LIST (create POSITION XCOORD ← X/SW YCOORD ←(fetch (GRAPHNODE NODEHEIGHT) of GN] (HALF (fetch (GRAPHNODE NODEHEIGHT) of GN]) (BRHC/OFFSET [LAMBDA (N ABSY) (* kvl "30-DEC-81 14:08") (* Adds in all the offsets. See comment on BRHC/LAYOUT/DAUGHTERS.) (DECLARE (USEDFREE NODELST)) (PROG ((GN (FASSOC N NODELST))) (OR GN (ERROR "No GRAPHNODE for NODEID" N)) [SETQ ABSY (IPLUS ABSY (pop (fetch (GRAPHNODE NODEPOSITION) of GN] [replace YCOORD of (fetch (GRAPHNODE NODEPOSITION) of GN) with (IPLUS ABSY (fetch YCOORD of (fetch (GRAPHNODE NODEPOSITION) of GN] (for D in (fetch (GRAPHNODE TONODES) of GN) do (BRHC/OFFSET D ABSY]) (BRHL/LAYOUT [LAMBDA (N X Y MOMLST GN) (* kvl "26-DEC-83 16:36") (* X and Y are the lower left corner of the box that will surround the tree headed by the browsenode N. MOMLST is the mother node inside a cons cell. GN is the graphnode for the nodeid N. It is crucial that the NODEPOSITION be set before recursion because this marks that the node has been laid out already. If in addition, the YCOORD is NIL, then the node is still in the process of being laid out. BRHL/LAYOUT/DAUGHTERS uses this fact to break loops by inserting boxed nodes.) (DECLARE (USEDFREE MOTHERD PERSONALD NODELST)) (COND ((fetch (GRAPHNODE NODEPOSITION) of GN) (* This case only occurs if this node has been put in the roots list, and has already been visited by recursion. Value won't be used) 0) (T (PROG [(DS (fetch (GRAPHNODE TONODES) of GN)) (W (fetch (GRAPHNODE NODEWIDTH) of GN)) (YHEIGHT (IPLUS PERSONALD (fetch (GRAPHNODE NODEHEIGHT) of GN] (replace (GRAPHNODE FROMNODES) of GN with MOMLST) (* This is first time for layout, so set FROMNODES) [replace (GRAPHNODE NODEPOSITION) of GN with (create POSITION XCOORD ←(IPLUS X (HALF W] (AND DS (SETQ YHEIGHT (IMAX (BRHL/LAYOUT/DAUGHTERS DS (IPLUS X W MOTHERD) Y (LIST N)) YHEIGHT))) (replace YCOORD of (fetch (GRAPHNODE NODEPOSITION) of GN) with (IPLUS Y (HALF YHEIGHT)) ) (RETURN YHEIGHT]) (BRHL/LAYOUT/DAUGHTERS [LAMBDA (DS X Y MOMLST) (* kvl "26-DEC-83 16:14") (* DS are the daughters of (CAR MOMLST). X is where their the left edge of their labels will be, and Y is the bottom of the mother's box. Returns the height of the mother's box. Tests to see if a node has been laid out out already If so, it sees if the node is far enought to the right; if not it moves the node and its daughters.) (DECLARE (USEDFREE NODELST YHEIGHT)) (for DTAIL on DS bind D GN NP DELTA (FLOOR ← Y) finally (RETURN (IDIFFERENCE FLOOR Y)) do (SETQ GN (GETNODEFROMID (SETQ D (CAR DTAIL)) NODELST)) (COND ((SETQ NP (fetch (GRAPHNODE NODEPOSITION) of GN)) [COND [(NULL (fetch YCOORD of NP)) (SETQ GN (NEW/INSTANCE/OF/GRAPHNODE GN)) (RPLACA DTAIL (fetch NODEID of GN)) (SETQ FLOOR (IPLUS FLOOR (BRHL/LAYOUT (fetch NODEID of GN) X FLOOR MOMLST GN] (T (BRHL/MOVE/RIGHT GN X NIL) (push (fetch (GRAPHNODE FROMNODES) of GN) (CAR MOMLST] (* Add this mother to the fromLinks) ) (T (SETQ FLOOR (IPLUS FLOOR (BRHL/LAYOUT D X FLOOR MOMLST GN]) (BRHL/MOVE/RIGHT [LAMBDA (GN X STACK) (* kvl "26-DEC-83 16:25") (* Move this node and its children right) (DECLARE (USEDFREE NODELST)) (PROG ((W (fetch (GRAPHNODE NODEWIDTH) of GN)) (NP (fetch NODEPOSITION of GN))) (AND (FMEMB GN STACK) (ERROR "Loop caught in BRHL/MOVE/RIGHT at" (fetch NODELABEL of GN))) (COND ((ILESSP X (IDIFFERENCE (fetch XCOORD of NP) (HALF W))) (RETURN))) (for D in (TOLINKS GN) bind (NEWX ←(IPLUS X W MOTHERD)) (NSTACK ←(CONS GN STACK)) do (BRHL/MOVE/RIGHT (GETNODEFROMID D NODELST) NEWX NSTACK)) (replace XCOORD of NP with (IPLUS X (HALF W]) (BROWSE/LAYOUT/HORIZ [LAMBDA (ROOTIDS) (* kvl "26-DEC-83 12:28") (* each subtree is given a box centered vertically on its label. Sister boxes abut but do not intrude as they do in the compacting version.) (DECLARE (USEDFREE NODELST)) [for N in ROOTIDS bind (Y ← 0) do (SETQ Y (IPLUS Y (BRH/LAYOUT N 0 Y NIL (GETNODEFROMID N NODELST] (create GRAPH GRAPHNODES ← NODELST SIDESFLG ← T DIRECTEDFLG ← NIL]) (BROWSE/LAYOUT/HORIZ/COMPACTLY [LAMBDA (ROOTS) (DECLARE (USEDFREE NODELST MOTHERD)) (* kvl "26-DEC-83 17:21") (* See comments on BRH/LAYOUT and BRH/LAYOUT/DAUGHTERS first. This is differs in that it keeps (on the stack) a representation of the shape of the tree that fills the node's box. The representation is a list of POSITIONs. If one starts drawing a line from left to right starting at the CAR, each point is a step in the line, and the point is begins the new plateau (or valley). The last point is where the line would turn around and head back to the left.) (* builds dummy top node for ROOTS if necessary, and adjusts the horizontal distance accordingly.) [COND ((NLISTP ROOTS) (BRHC/LAYOUT ROOTS 0 NIL (OR (FASSOC ROOTS NODELST) (ERROR "No GRAPHNODE for NODEID" ROOTS))) (BRHC/OFFSET ROOTS 0)) ((NULL (CDR ROOTS)) [BRHC/LAYOUT (CAR ROOTS) 0 NIL (OR (FASSOC (CAR ROOTS) NODELST) (ERROR "No GRAPHNODE for NODEID" (CAR ROOTS] (BRHC/OFFSET (CAR ROOTS) 0)) (T (PROG ((GN (create GRAPHNODE NODELABEL ←(PACK) NODEID ←(CONS) TONODES ← ROOTS NODEWIDTH ← 0 NODEHEIGHT ← 0)) TOPNODE) (push NODELST GN) (SETQ TOPNODE (fetch (GRAPHNODE NODEID) of GN)) (BRHC/LAYOUT TOPNODE (IMINUS MOTHERD) NIL GN) (BRHC/OFFSET TOPNODE 0) [for N GN in ROOTS do (replace (GRAPHNODE FROMNODES) of (SETQ GN (FASSOC N NODELST)) with (DREMOVE TOPNODE (fetch (GRAPHNODE FROMNODES) of GN] (SETQ NODELST (DREMOVE GN NODELST] (create GRAPH GRAPHNODES ← NODELST SIDESFLG ← T DIRECTEDFLG ← NIL]) (BROWSE/LAYOUT/LATTICE [LAMBDA (NS) (* kvl "26-DEC-83 15:46") (* almost the same as BROWSE/LAYOUT/HORIZ, except that it doesn't box nodes unless there are cycles. Instead, a single node is placed at the rightmost of the positions that would be laid out by for all of its (boxed) occurrences by BROWSE/LAYOUT/HORIZ.) (DECLARE (USEDFREE NODELST)) [for N in NS bind (Y ← 0) do (SETQ Y (IPLUS Y (BRHL/LAYOUT N 0 Y NIL (GETNODEFROMID N NODELST] (create GRAPH GRAPHNODES ← NODELST SIDESFLG ← T DIRECTEDFLG ← NIL]) (BRV/OFFSET [LAMBDA (N ABSX) (* kvl "31-DEC-81 16:03") (* Adds in offset which are kept in car of NODEPOSITION. TERMY is Y of lowest node. Adding it in raises tree so lowest node is at zero.) (DECLARE (USEDFREE NODELST TERMY)) (PROG ((GN (FASSOC N NODELST)) P) (OR GN (ERROR "No GRAPHNODE for NODEID" N)) [SETQ ABSX (IPLUS ABSX (pop (fetch (GRAPHNODE NODEPOSITION) of GN] (replace XCOORD of (SETQ P (fetch (GRAPHNODE NODEPOSITION) of GN)) with (IPLUS ABSX (fetch XCOORD of P))) (replace YCOORD of P with (IDIFFERENCE (fetch YCOORD of P) TERMY)) (for D in (fetch (GRAPHNODE TONODES) of GN) do (BRV/OFFSET D ABSX]) (EXTEND/TRANSITION/CHAIN [LAMBDA (LTC RTC) (* kvl "21-DEC-83 11:00") (* Extends the left transition chain by appending the part of the right transition chain that is to the right of the end of the left transition chain. End point of left transition chain is changed to intersect right transition chain) (PROG ((LTAIL LTC) (RTAIL RTC) LX RX) L [COND ((NULL (CDR RTAIL)) (replace YCOORD of (CAR (FLAST LTAIL)) with (fetch YCOORD of (CAR RTAIL))) (RETURN LTC)) ((NULL (CDR LTAIL)) (RPLACD LTAIL (CDR RTAIL)) (replace YCOORD of (CAR LTAIL) with (fetch YCOORD of (CAR RTAIL))) (RETURN LTC)) ([IEQP (SETQ LX (fetch XCOORD of (CADR LTAIL))) (SETQ RX (fetch XCOORD of (CADR RTAIL] (SETQ LTAIL (CDR LTAIL)) (SETQ RTAIL (CDR RTAIL))) ((ILESSP LX RX) (SETQ LTAIL (CDR LTAIL))) (T (SETQ RTAIL (CDR RTAIL] (GO L]) (INIT/NODES/FOR/LAYOUT [LAMBDA (NS FONT) (* kvl "26-DEC-83 13:11") (for GN in NS do (replace (GRAPHNODE NODEPOSITION) of GN with NIL) (replace (GRAPHNODE NODETOP) of GN with NIL) (replace (GRAPHNODE NODEBOTTOM) of GN with NIL) (replace (GRAPHNODE NODELEFT) of GN with NIL) (replace (GRAPHNODE NODERIGHT) of GN with NIL) (OR (fetch (GRAPHNODE NODEFONT) of GN) (replace (GRAPHNODE NODEFONT) of GN with FONT)) (SET/LABEL/SIZE GN]) (LAYOUTFOREST [LAMBDA (NODELST ROOTIDS FORMAT BOXING NODEFONT MOTHERD PERSONALD FAMILYD) (* kvl "26-DEC-83 11:07") (* This is an older version of LayoutGraph, kept around temporarily but de-documented) (LAYOUTGRAPH NODELST ROOTIDS (CONS FORMAT BOXING) NODEFONT MOTHERD PERSONALD]) (LAYOUTGRAPH [LAMBDA (NODELST ROOTIDS FORMAT NODEFONT MOTHERD PERSONALD FAMILYD) (* kvl "22-Feb-84 09:39") (* takes a list of GRAPHNODE records and a list node ids for the top level nodes, where the graphnodes have only the NODEID, NODELABEL and TONODES fields filled in. It fills in the other fields appropriately according the format switch and the boxing switch so that the graph becomes a forest. If there are loops in the graph, they are snapped and the NODELST is extended with Push This function returns a GRAPH record with the display slots filled in appropriately.) (DECLARE (SPECVARS NODELST NODEFONT MOTHERD PERSONALD FAMILYD)) (PROG ((BOX/BOTH/FLG T) (BOX/LEAVES/FLG T) G) (DECLARE (SPECVARS BOX/BOTH/FLG BOX/LEAVES/FLG)) (OR (LISTP ROOTIDS) (ERROR "LAYOUTGRAPH needs a LIST of root node ids")) (for R in ROOTIDS unless (FASSOC R NODELST) do (ERROR R "is in ROOTIDS but no GRAPHNODE for it in NODELST.")) (SETQ FORMAT (MKLIST FORMAT)) (OR NODEFONT (SETQ NODEFONT (CADR DEFAULTFONT))) (OR MOTHERD (SETQ MOTHERD (STRINGWIDTH "AAAAAA" NODEFONT))) [OR PERSONALD (SETQ PERSONALD (COND ((FMEMB (QUOTE VERTICAL) FORMAT) (STRINGWIDTH "AA" NODEFONT)) (T 0] (OR FAMILYD (SETQ FAMILYD 0)) (INIT/NODES/FOR/LAYOUT NODELST NODEFONT) (AND (FMEMB (QUOTE COPIES/ONLY) FORMAT) (SETQ BOX/BOTH/FLG NIL)) (AND (FMEMB (QUOTE NOT/LEAVES) FORMAT) (SETQ BOX/LEAVES/FLG NIL)) (AND (FMEMB (QUOTE VERTICAL) FORMAT) (SWITCH/NODE/HEIGHT/WIDTH NODELST)) [SETQ G (COND ((FMEMB (QUOTE LATTICE) FORMAT) (BROWSE/LAYOUT/LATTICE ROOTIDS)) ((FMEMB (QUOTE FAST) FORMAT) (BROWSE/LAYOUT/HORIZ ROOTIDS)) (T (BROWSE/LAYOUT/HORIZ/COMPACTLY ROOTIDS] [for N in NODELST do (OR (type? POSITION (fetch NODEPOSITION of N)) (ERROR "Disconnected graph. Root(s) didn't connect to:" (fetch NODELABEL of N] (COND ((FMEMB (QUOTE VERTICAL) FORMAT) (SWITCH/NODE/HEIGHT/WIDTH NODELST) (REFLECT/GRAPH/DIAGONALLY G) (OR (FMEMB (QUOTE REVERSE) FORMAT) (REFLECT/GRAPH/VERTICALLY G))) ((FMEMB (QUOTE REVERSE) FORMAT) (REFLECT/GRAPH/HORIZONTALLY G))) (RETURN G]) (LAYOUTLATTICE [LAMBDA (NODELST ROOTIDS FORMAT NODEFONT MOTHERD PERSONALD FAMILYD) (* kvl "21-DEC-83 12:25") (* takes a list of GRAPHNODE records and a list node ids for the top level nodes, where the graphnodes have only the NODEID, NODELABEL and TONODES fields filled in. It fills in the other fields appropriately according the format switch If there are loops in the graph, they are detected in BRHL/MOVE/RIGHT and an error occurs. This function returns a GRAPH record with the display slots filled in appropriately.) (DECLARE (SPECVARS NODELST NODEFONT MOTHERD PERSONALD FAMILYD)) (for R in ROOTIDS unless (FASSOC R NODELST) do (ERROR R "is in ROOTIDS but no GRAPHNODE for it in NODELST.")) (SETQ NODEFONT (OR NODEFONT (CADR DEFAULTFONT))) (INIT/NODES/FOR/LAYOUT NODELST NODEFONT) [OR FAMILYD (SETQ FAMILYD (HALF (FONTPROP NODEFONT (QUOTE ASCENT] (OR MOTHERD (SETQ MOTHERD (STRINGWIDTH "AAAAAA" NODEFONT))) [OR PERSONALD (SETQ PERSONALD (COND ((EQ FORMAT (QUOTE VERTICAL)) (STRINGWIDTH "AA" NODEFONT)) (T 0] (BROWSE/LAYOUT/LATTICE ROOTIDS]) (LAYOUTSEXPR [LAMBDA (TREE FORMAT BOXING FONT MOTHERD PERSONALD FAMILYD) (* kvl "22-Feb-84 09:30") (* assumes CAR of tree is node label, CDR is daughter trees.) (PROG (RESULT) (DECLARE (SPECVARS RESULT)) (LAYOUTSEXPR1 TREE) (RETURN (LAYOUTGRAPH RESULT (LIST TREE) (APPEND (MKLIST FORMAT) BOXING) FONT MOTHERD PERSONALD FAMILYD]) (LAYOUTSEXPR1 [LAMBDA (TREE) (* kvl "28-APR-82 10:21") (DECLARE (SPECVARS RESULT)) (COND ((NULL TREE)) [(for R in RESULT thereis (EQ TREE (fetch (GRAPHNODE NODEID) of R] ((NLISTP TREE) (push RESULT (create GRAPHNODE NODEID ← TREE NODELABEL ← TREE))) (T [push RESULT (create GRAPHNODE NODEID ← TREE NODELABEL ←(CAR TREE) TONODES ←(APPEND (CDR TREE] (for D in (CDR TREE) do (LAYOUTSEXPR1 D]) (NEW/INSTANCE/OF/GRAPHNODE [LAMBDA (GN) (DECLARE (USEDFREE NODELST BOX/LEAVES/FLG BOX/BOTH/FLG)) (* kvl "21-DEC-83 12:28") (* returns a second instance of the node, boxing it appropriately. No daughters.) (PROG [(NEW (create GRAPHNODE NODEID ←(LIST (fetch (GRAPHNODE NODEID) of GN)) NODELABEL ←(fetch (GRAPHNODE NODELABEL) of GN) NODEFONT ←(fetch (GRAPHNODE NODEFONT) of GN) NODEWIDTH ←(fetch (GRAPHNODE NODEWIDTH) of GN) NODEHEIGHT ←(fetch (GRAPHNODE NODEHEIGHT) of GN] (push NODELST NEW) [COND ((OR BOX/LEAVES/FLG (fetch (GRAPHNODE TONODES) of GN)) (replace (GRAPHNODE BOXNODEFLG) of NEW with T) (AND BOX/BOTH/FLG (replace (GRAPHNODE BOXNODEFLG) of GN with T] (RETURN NEW]) (RAISE/TRANSITION/CHAIN [LAMBDA (TC RAISE) (* kvl "21-DEC-83 10:25") (* raises a daughters transition chain by adding in the offset of the daughter's box relative to the mother's box.) (for P in TC do (add (fetch YCOORD of P) RAISE) finally (RETURN TC]) (REFLECT/GRAPH/DIAGONALLY [LAMBDA (GRAPH) (* kvl "26-DEC-83 10:58") (replace (GRAPH SIDESFLG) of GRAPH with (NOT (fetch (GRAPH SIDESFLG) of GRAPH))) [for N in (fetch (GRAPH GRAPHNODES) of GRAPH) do (SETQ N (fetch (GRAPHNODE NODEPOSITION) of N)) (replace XCOORD of N with (PROG1 (fetch YCOORD of N) (replace YCOORD of N with (fetch XCOORD of N] GRAPH]) (REFLECT/GRAPH/HORIZONTALLY [LAMBDA (GRAPH) (* kvl "26-DEC-83 13:09") (for N in (fetch (GRAPH GRAPHNODES) of GRAPH) bind [W ←(IPLUS (MAX/RIGHT (fetch (GRAPH GRAPHNODES) of GRAPH)) (MIN/LEFT (fetch (GRAPH GRAPHNODES) of GRAPH] do (replace (GRAPHNODE NODERIGHT) of N with NIL) (replace (GRAPHNODE NODELEFT) of N with NIL) (SETQ N (fetch (GRAPHNODE NODEPOSITION) of N)) (replace XCOORD of N with (IDIFFERENCE W (fetch XCOORD of N]) (REFLECT/GRAPH/VERTICALLY [LAMBDA (GRAPH) (* kvl "26-DEC-83 13:08") (for N in (fetch (GRAPH GRAPHNODES) of GRAPH) bind [H ←(IPLUS (MAX/TOP (fetch (GRAPH GRAPHNODES) of GRAPH)) (MIN/BOTTOM (fetch (GRAPH GRAPHNODES) of GRAPH] do (replace (GRAPHNODE NODETOP) of N with NIL) (replace (GRAPHNODE NODEBOTTOM) of N with NIL) (SETQ N (fetch (GRAPHNODE NODEPOSITION) of N)) (replace YCOORD of N with (IDIFFERENCE H (fetch YCOORD of N]) (SWITCH/NODE/HEIGHT/WIDTH [LAMBDA (NL) (* kvl "22-DEC-83 17:18") (for N in NL bind TEMP do (SETQ TEMP (fetch (GRAPHNODE NODEWIDTH) of N)) (replace (GRAPHNODE NODEWIDTH) of N with (fetch (GRAPHNODE NODEHEIGHT) of N)) (replace (GRAPHNODE NODEHEIGHT) of N with TEMP]) ) (RPAQQ DISPLAYNODEHEIGHT 13) (RPAQQ EDITGRAPHMENU NIL) (RPAQQ GRAPHEDITWINDOW NIL) (RPAQQ NODEBOARDERWIDTH 1) (RPAQ ORIGIN (CREATE POSITION XCOORD ← 0 YCOORD ← 0)) (RPAQQ BOXLABELSFLG T) (RPAQQ LABEL/CREATING/DS NIL) (DECLARE: DOEVAL@COMPILE DONTCOPY (LOCALVARS . T) ) (DECLARE: DOEVAL@COMPILE DONTCOPY (ADDTOVAR GLOBALVARS DISPLAYNODEHEIGHT EDITGRAPHMENU GRAPHEDITWINDOW NODEBOARDERWIDTH ORIGIN BOXLABELSFLG LABEL/CREATING/DS) ) [DECLARE: EVAL@COMPILE (RECORD GRAPHNODE (NODEID NODEPOSITION NODELABELBITMAP NODEBOTTOM NODETOP NODEWIDTH NODEHEIGHT TONODES FROMNODES NODEFONT NODELABEL BOXNODEFLG NODERIGHT NODELEFT)) (RECORD GRAPH (GRAPHNODES SIDESFLG DIRECTEDFLG GRAPH.MOVENODEFN GRAPH.ADDNODEFN GRAPH.DELETENODEFN GRAPH.ADDLINKFN GRAPH.DELETELINKFN GRAPH.FONTCHANGEFN)) ] (DECLARE: EVAL@COMPILE (PUTPROPS HALF MACRO ((X) (LRSH X 1))) ) (PUTPROPS GRAPHER COPYRIGHT ("Xerox Corporation" 1983 1984)) (DECLARE: DONTCOPY (FILEMAP (NIL (2609 53306 (ABOVE 2619 . 3070) (ADD/AND/DISPLAY/LINK 3072 . 3509) (APPLYTOSELECTEDNODE 3511 . 5679) (CACHE/NODE/LABELS 5681 . 6202) (CALL.MOVENODEFN 6204 . 6546) (CHANGE.NODEFONT.SIZE 6548 . 7221) (CHOOSE.GRAPH.FONT 7223 . 7651) (CLOSEST/NODE 7653 . 8206) (CREATE/LABEL/BITMAP 8208 . 10738) (DEFAULT.ADDNODEFN 10740 . 11428) (DELETE/AND/DISPLAY/LINK 11430 . 12212) (DISPLAY/NAME 12214 . 12359 ) (DISPLAYLINK 12361 . 14778) (DISPLAYNODE 14780 . 15128) (DISPLAYNODELINKS 15130 . 15743) (DRAWBOX 15745 . 16070) (DRAWAREABOX 16072 . 17561) (EDITADDLINK 17563 . 17899) (EDITADDNODE 17901 . 18536) ( EDITAPPLYTOLINK 18538 . 19666) (EDITCHANGEFONT 19668 . 20412) (EDITDELETELINK 20414 . 20758) ( EDITDELETENODE 20760 . 22277) (EDITGRAPH 22279 . 23077) (EDITGRAPH1 23079 . 24644) (EDITGRAPHMENU 24646 . 25218) (EDITMOVENODE 25220 . 26624) (FLIPNODE 26626 . 27260) (FONTNAMELIST 27262 . 27487) ( FROMLINKS 27489 . 27633) (GETNODEFROMID 27635 . 27812) (GRAPHADDLINK 27814 . 28303) (GRAPHADDNODE 28305 . 28881) (GRAPHDELETELINK 28883 . 29479) (GRAPHDELETENODE 29481 . 29855) (GRAPHEDITCOMMANDFN 29857 . 31123) (GRAPHEDITEVENTFN 31125 . 31724) (GRAPHMOVENODE 31726 . 32203) (GRAPHREGION 32205 . 33015) (LABEL/BITMAP 33017 . 33219) (LAYOUT/POSITION 33221 . 33374) (LOWER/LEFT/POSITION 33376 . 33721 ) (MANHATTANDIST 33723 . 34123) (MAX/RIGHT 34125 . 34446) (MAX/TOP 34448 . 34758) (MIN/BOTTOM 34760 . 35192) (MIN/LEFT 35194 . 35606) (MOVENODE 35608 . 36321) (NODE/BOTTOM 36323 . 36764) (NODE/LEFT 36766 . 37201) (NODE/RIGHT 37203 . 37647) (NODE/TOP 37649 . 38077) (NODEBOXHEIGHT 38079 . 38376) ( NODEBOXWIDTH 38378 . 38593) (NODECREATE 38595 . 39034) (NODELST/AS/MENU 39036 . 39694) (NODEREGION 39696 . 40197) (PRINTDISPLAYNODE 40199 . 40745) (PROMPTINWINDOW 40747 . 42887) (READ/NODE 42889 . 43695) (REDISPLAYGRAPH 43697 . 44530) (RIGHTOF 44532 . 44810) (SET/LABEL/SIZE 44812 . 45898) ( SET/LAYOUT/POSITION 45900 . 47355) (SHIFTP 47357 . 47609) (SHOWGRAPH 47611 . 49015) (SIZE/GRAPH/WINDOW 49017 . 50579) (TOGGLE/DIRECTEDFLG 50581 . 51121) (TOGGLE/SIDESFLG 51123 . 51704) (TOLINKS 51706 . 51846) (TRACKCURSOR 51848 . 52800) (TRACKNODE 52802 . 53304)) (53366 55463 (NEXTSIZEFONT 53376 . 54391 ) (DECREASING.FONT.LIST 54393 . 54802) (SCALE.FONT 54804 . 55461)) (55670 83814 (BRH/LAYOUT 55680 . 57106) (BRH/LAYOUT/DAUGHTERS 57108 . 58104) (BRH/OFFSET 58106 . 58503) (BRHC/INTERTREE/SPACE 58505 . 59655) (BRHC/LAYOUT 59657 . 61252) (BRHC/LAYOUT/DAUGHTERS 61254 . 63867) (BRHC/LAYOUT/TERMINAL 63869 . 64503) (BRHC/OFFSET 64505 . 65263) (BRHL/LAYOUT 65265 . 66959) (BRHL/LAYOUT/DAUGHTERS 66961 . 68253 ) (BRHL/MOVE/RIGHT 68255 . 69111) (BROWSE/LAYOUT/HORIZ 69113 . 69649) (BROWSE/LAYOUT/HORIZ/COMPACTLY 69651 . 71555) (BROWSE/LAYOUT/LATTICE 71557 . 72211) (BRV/OFFSET 72213 . 73065) ( EXTEND/TRANSITION/CHAIN 73067 . 74123) (INIT/NODES/FOR/LAYOUT 74125 . 74735) (LAYOUTFOREST 74737 . 75181) (LAYOUTGRAPH 75183 . 77780) (LAYOUTLATTICE 77782 . 79027) (LAYOUTSEXPR 79029 . 79587) ( LAYOUTSEXPR1 79589 . 80166) (NEW/INSTANCE/OF/GRAPHNODE 80168 . 81152) (RAISE/TRANSITION/CHAIN 81154 . 81599) (REFLECT/GRAPH/DIAGONALLY 81601 . 82123) (REFLECT/GRAPH/HORIZONTALLY 82125 . 82762) ( REFLECT/GRAPH/VERTICALLY 82764 . 83417) (SWITCH/NODE/HEIGHT/WIDTH 83419 . 83812))))) STOP