(FILECREATED " 3-Oct-84 17:04:09" {ERIS}<LISPCORE>LIBRARY>GRAPHER.;15 99978
previous date: "15-Sep-84 15:54:31" {ERIS}<LISPCORE>LIBRARY>GRAPHER.;14)
(* Copyright (c) 1983, 1984 by Xerox Corporation. All rights reserved. The following program was
created in 1983 but has not been published within the meaning of the copyright law, is furnished
under license, and may not be used, copied and/or disclosed except in accordance with the terms of
said license.)
(PRETTYCOMPRINT GRAPHERCOMS)
(RPAQQ GRAPHERCOMS ((FNS ADD/AND/DISPLAY/LINK APPLYTOSELECTEDNODE CALL.MOVENODEFN
CHANGE.NODEFONT.SIZE CHOOSE.GRAPH.FONT CLOSEST/NODE DEFAULT.ADDNODEFN
DELETE/AND/DISPLAY/LINK DISPLAY/NAME DISPLAYGRAPH DISPLAYLINK DISPLAYLINK/LR
DISPLAYLINK/TB EDITTOGGLEBORDER ERASE/GRAPHNODE DISPLAYNODE DISPLAYNODELINKS
DRAW/GRAPHNODE/BORDER DRAWAREABOX EDITADDLINK EDITADDNODE EDITAPPLYTOLINK
EDITCHANGEFONT EDITDELETELINK EDITDELETENODE EDITGRAPH EDITGRAPH1
EDITGRAPHMENU EDITMOVENODE EDITTOGGLELABEL FLIPNODE FONTNAMELIST FROMLINKS
GETNODEFROMID GN/BOTTOM GN/LEFT GN/RIGHT GN/TOP GRAPHADDLINK GRAPHADDNODE
GRAPHDELETELINK GRAPHDELETENODE GRAPHEDITCOMMANDFN GRAPHEDITEVENTFN
GRAPHER/CENTERPRINTINAREA GRAPHMOVENODE GRAPHNODE/BORDER/WIDTH GRAPHREGION
HARDCOPYGRAPH INTERSECT/REGIONP/LBWH INVERTED/GRAPHNODE/BORDER
INVERTED/SHADE/FOR/GRAPHER LAYOUT/POSITION MANHATTANDIST MAX/RIGHT MAX/TOP
MEASUREGRAPHNODE MIN/BOTTOM MIN/LEFT MOVENODE NODECREATE NODELST/AS/MENU
NODEREGION PRINTDISPLAYNODE FILL/GRAPHNODE/LABEL PROMPTINWINDOW READ/NODE
REDISPLAYGRAPH RESET/NODE/BORDER RESET/NODE/LABELSHADE SCALE/GRAPH
SCALE/GRAPHNODE/BORDER SET/LABEL/SIZE SET/LAYOUT/POSITION SHIFTP SHOWGRAPH
SIZE/GRAPH/WINDOW TOGGLE/DIRECTEDFLG TOGGLE/SIDESFLG TOLINKS TRACKCURSOR
TRACKNODE)
(COMS (* Dummy for Carol)
(FNS GRAPHER.DSPSCALE)
(P (MOVD? 'GRAPHER.DSPSCALE 'DSPSCALE)))
(COMS (* functions for finding larger and smaller fonts)
(FNS NEXTSIZEFONT DECREASING.FONT.LIST SCALE.FONT)
[DECLARE: DONTEVAL@LOAD DOCOPY (VARS (DECREASING.FONT.LIST (DECREASING.FONT.LIST]
(GLOBALVARS DECREASING.FONT.LIST))
(* functions for 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 FOREST/BREAK/CYCLES INIT/NODES/FOR/LAYOUT
INTERPRET/MARK/FORMAT LATTICE/BREAK/CYCLES LAYOUTFOREST LAYOUTGRAPH LAYOUTLATTICE
LAYOUTSEXPR LAYOUTSEXPR1 MARK/GRAPH/NODE NEW/INSTANCE/OF/GRAPHNODE
RAISE/TRANSITION/CHAIN REFLECT/GRAPH/DIAGONALLY REFLECT/GRAPH/HORIZONTALLY
REFLECT/GRAPH/VERTICALLY SWITCH/NODE/HEIGHT/WIDTH)
(VARS DEFAULT.GRAPH.NODEBORDER DEFAULT.GRAPH.NODEFONT DEFAULT.GRAPH.NODELABELSHADE (
CACHE/NODE/LABEL/BITMAPS)
(EDITGRAPHMENU)
(GRAPHEDITWINDOW)
(NODEBORDERWIDTH 1)
(ORIGIN (CREATE POSITION XCOORD ← 0 YCOORD ← 0)))
(P (MOVD? (FUNCTION NILL)
(FUNCTION IMAGEOBJP)
T))
(LOCALVARS . T)
(GLOBALVARS EDITGRAPHMENU GRAPHEDITWINDOW NODEBORDERWIDTH ORIGIN)
(RECORDS GRAPHNODE GRAPH)
(DECLARE: DONTCOPY (MACROS HALF))))
(DEFINEQ
(ADD/AND/DISPLAY/LINK
(LAMBDA (FROMND TOND WIN G) (* rmk: "10-Apr-84 12:36")
(* 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 (CONSTANT (create POSITION
XCOORD ← 0
YCOORD ← 0))
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))))))
(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 "20-Aug-84 10:36")
(* makes the label font of a node larger.)
(PROG [(NEWFONT (NEXTSIZEFONT HOW (fetch (GRAPHNODE NODEFONT) of NODE]
(COND
(NEWFONT (DISPLAYNODE NODE (CONSTANT (create POSITION
XCOORD ← 0
YCOORD ← 0))
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)
(replace (GRAPHNODE NODEWIDTH) of NODE with NIL)
(replace (GRAPHNODE NODEHEIGHT) of NODE with NIL)
(MEASUREGRAPHNODE NODE)
(DISPLAYNODE NODE (CONSTANT (create POSITION
XCOORD ← 0
YCOORD ← 0))
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) (* rmk: " 2-Feb-84 22:35")
(* finds the node that is closest to POS)
(PROG (CLOSEST (MINDIST 65000)
DIST)
LP (COND
((NULL NODELST)
(RETURN CLOSEST))
((IGREATERP MINDIST (SETQ DIST (MANHATTANDIST (fetch NODEPOSITION of (CAR NODELST))
POS)))
(SETQ CLOSEST (CAR NODELST))
(SETQ MINDIST DIST)))
(SETQ NODELST (CDR NODELST))
(GO LP))))
(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) (* rmk: "10-Apr-84 12:38")
(* 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 (CONSTANT (create POSITION
XCOORD ← 0
YCOORD ← 0))
WIN G)
T))))
(DISPLAY/NAME
(LAMBDA (ND) (* rrb "13-JUL-81 10:56")
(fetch NODELABEL of ND)))
(DISPLAYGRAPH
[LAMBDA (GRAPH STREAM CLIP/REG TRANS) (* rmk: "27-Aug-84 10:04")
(* Displays GRAPH with coordinates system translated to TRANS on STREAM. POS=NIL is interpreted as 0,0.
Draws links first then labels so that lattices don't have lines through the labels.)
(PROG (SCALE (LINEWIDTH 1))
[OR (type? POSITION TRANS)
(SETQ TRANS (CONSTANT (create POSITION
XCOORD ← 0
YCOORD ← 0]
(SETQ STREAM (\GETSTREAM STREAM (QUOTE OUTPUT)))
(COND
((DISPLAYSTREAMP STREAM)
(* This is because PRIN3 on displaystreams can sometimes cause CR's to be output. GRAPHER/CENTERPRINTINAREA
doesn't have the rightmargin kludge that the CENTERPRINTINAREA in MENU has.)
(DSPRIGHTMARGIN 65000 STREAM))
(T (SETQ SCALE (DSPSCALE NIL STREAM))
(SETQ GRAPH (SCALE/GRAPH GRAPH STREAM SCALE))
[SETQ TRANS (create POSITION
XCOORD ←(FIXR (FTIMES SCALE (fetch XCOORD of TRANS)))
YCOORD ←(FIXR (FTIMES SCALE (fetch YCOORD of TRANS]
(SETQ LINEWIDTH SCALE)))
(for N in (fetch (GRAPH GRAPHNODES) of GRAPH) do (DISPLAYNODELINKS N TRANS STREAM GRAPH T
LINEWIDTH))
(for N in (fetch (GRAPH GRAPHNODES) of GRAPH) do (PRINTDISPLAYNODE N TRANS STREAM CLIP/REG])
(DISPLAYLINK
[LAMBDA (FRND TOND TRANS STREAM G LINEWIDTH) (* kvl "15-Aug-84 10:12")
(* draws in a link from FRND TO TOND, translated by
TRANS)
(OR LINEWIDTH (SETQ LINEWIDTH 1))
(COND
((fetch (GRAPH SIDESFLG) of G)
(COND
((OR (fetch (GRAPH DIRECTEDFLG) of G)
(IGREATERP (GN/LEFT TOND)
(GN/RIGHT FRND))) (* in the horizontal case of LATTICE, always draw from
right to left.)
(DISPLAYLINK/LR TRANS TOND FRND LINEWIDTH NIL STREAM))
((IGREATERP (GN/LEFT FRND)
(GN/RIGHT TOND))
(DISPLAYLINK/LR TRANS FRND TOND LINEWIDTH NIL STREAM))
((IGREATERP (GN/BOTTOM FRND)
(GN/TOP TOND))
(DISPLAYLINK/TB TRANS TOND FRND LINEWIDTH NIL STREAM))
((IGREATERP (GN/BOTTOM TOND)
(GN/TOP FRND))
(DISPLAYLINK/TB TRANS FRND TOND LINEWIDTH NIL STREAM))
(T (* if on top of each other, don't draw.)
NIL)))
(T (COND
((OR (fetch (GRAPH DIRECTEDFLG) of G)
(IGREATERP (GN/BOTTOM FRND)
(GN/TOP TOND))) (* if LATTICE, always draw from FROMNODE BOTTOM to
TONODE TOP. Otherwise find the one that looks best.)
(DISPLAYLINK/TB TRANS TOND FRND LINEWIDTH NIL STREAM))
((IGREATERP (GN/BOTTOM TOND)
(GN/TOP FRND))
(DISPLAYLINK/TB TRANS FRND TOND LINEWIDTH NIL STREAM))
((IGREATERP (GN/LEFT TOND)
(GN/RIGHT FRND))
(DISPLAYLINK/LR TRANS TOND FRND LINEWIDTH NIL STREAM))
((IGREATERP (GN/LEFT FRND)
(GN/RIGHT TOND))
(DISPLAYLINK/LR TRANS FRND TOND LINEWIDTH NIL STREAM))
(T (* if on top of each other, don't draw.)
NIL])
(DISPLAYLINK/LR
[LAMBDA (TRANS GNL GNR WIDTH OPERATION STREAM COLOR) (* rmk: "17-Aug-84 10:18")
(* draws a line from the left edge of GNL to the right
edge of GNR, translated by TRANS)
(DRAWLINE (IPLUS (fetch XCOORD of TRANS)
(SUB1 (GN/LEFT GNL)))
(IPLUS (fetch YCOORD of TRANS)
(fetch YCOORD of (fetch NODEPOSITION of GNL)))
(IPLUS (fetch XCOORD of TRANS)
(ADD1 (GN/RIGHT GNR)))
(IPLUS (fetch YCOORD of TRANS)
(fetch YCOORD of (fetch NODEPOSITION of GNR)))
WIDTH OPERATION STREAM COLOR])
(DISPLAYLINK/TB
[LAMBDA (TRANS GNT GNB WIDTH OPERATION STREAM COLOR) (* rmk: "17-Aug-84 10:16")
(* draws a line from the top edge of GNT to the bottom
edge of GNR, translated by TRANS)
(DRAWLINE (IPLUS (fetch XCOORD of TRANS)
(fetch XCOORD of (fetch NODEPOSITION of GNT)))
(IPLUS (fetch YCOORD of TRANS)
(ADD1 (GN/TOP GNT)))
(IPLUS (fetch XCOORD of TRANS)
(fetch XCOORD of (fetch NODEPOSITION of GNB)))
(IPLUS (fetch YCOORD of TRANS)
(SUB1 (GN/BOTTOM GNB)))
WIDTH OPERATION STREAM COLOR])
(EDITTOGGLEBORDER
[LAMBDA (W) (* kvl " 5-Sep-84 19:16")
(* prompts the user for a node and inverts its border)
(RESETFORM (TTYDISPLAYSTREAM PROMPTWINDOW)
(CLRPROMPT)
(PROG ((GRAPH (WINDOWPROP W (QUOTE GRAPH)))
(DS (WINDOWPROP W (QUOTE DSP)))
NODE)
(COND
((NOT (fetch (GRAPH GRAPHNODES) of GRAPH))
(PROMPTPRINT " No nodes to invert. ")
(RETURN)))
(PROMPTPRINT " Select node to have border inverted. ")
(SETQ NODE (READ/NODE (fetch (GRAPH GRAPHNODES) of GRAPH)
DS))
(TERPRI T)
(RESET/NODE/BORDER NODE (QUOTE INVERT)
W)
(AND (fetch (GRAPH GRAPH.INVERTBORDERFN) of GRAPH)
(APPLY* (fetch (GRAPH GRAPH.INVERTBORDERFN) of GRAPH)
NODE GRAPH W))
(printout T "Node " (fetch NODELABEL of NODE)
" inverted." T)
(RETURN NODE])
(ERASE/GRAPHNODE
[LAMBDA (NODE STREAM TRANS) (* kvl " 5-Sep-84 18:22")
(* erases a node at its position translated by TRANS)
(OR [NOT (OR (WINDOWP STREAM)
(IMAGESTREAMTYPEP STREAM (QUOTE DISPLAY]
(ZEROP (fetch (GRAPHNODE NODEHEIGHT) of NODE))
(NULL (fetch NODEFONT of NODE))
(BITBLT NIL NIL NIL STREAM (COND
(TRANS (IPLUS (fetch XCOORD of TRANS)
(GN/LEFT NODE)))
(T (GN/LEFT NODE)))
(COND
(TRANS (IPLUS (fetch YCOORD of TRANS)
(GN/BOTTOM NODE)))
(T (GN/BOTTOM NODE)))
(fetch NODEWIDTH of NODE)
(fetch NODEHEIGHT of NODE)
(QUOTE TEXTURE)
(QUOTE REPLACE)
WHITESHADE])
(DISPLAYNODE
[LAMBDA (NODE TRANS STREAM G TOSONLY) (* kvl "10-Aug-84 19:08")
(* displays a node and its links.
IF TOSONLY IS NON-NIL, DRAWS ONLY THE TO LINKS.)
(DISPLAYNODELINKS NODE TRANS STREAM G TOSONLY)
(PRINTDISPLAYNODE NODE TRANS STREAM (DSPCLIPPINGREGION NIL STREAM])
(DISPLAYNODELINKS
[LAMBDA (NODE TRANS STREAM G TOSONLY LINEWIDTH) (* kvl "15-Aug-84 10:12")
(* 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 NODE) do (DISPLAYLINK NODE (GETNODEFROMID TONODEID NODELST)
TRANS STREAM G LINEWIDTH))
(OR TOSONLY (for FROMNDID in (FROMLINKS NODE) do (DISPLAYLINK (GETNODEFROMID FROMNDID
NODELST)
NODE TRANS STREAM G LINEWIDTH]
)
(DRAW/GRAPHNODE/BORDER
[LAMBDA (BORDER LEFT BOTTOM WIDTH HEIGHT STREAM) (* kvl " 5-Sep-84 17:51")
(* interprets the node border)
(COND
((EQ BORDER NIL))
((EQ BORDER T)
(DRAWAREABOX LEFT BOTTOM WIDTH HEIGHT 1 NIL STREAM))
((FIXP BORDER)
(OR (ILEQ BORDER 0)
(DRAWAREABOX LEFT BOTTOM WIDTH HEIGHT BORDER NIL STREAM)))
[(LISTP BORDER)
(AND (OR (WINDOWP STREAM)
(IMAGESTREAMTYPEP STREAM (QUOTE DISPLAY)))
(PROG ((NBW (GRAPHNODE/BORDER/WIDTH BORDER)))
(BITBLT NIL NIL NIL STREAM LEFT BOTTOM WIDTH HEIGHT (QUOTE TEXTURE)
(QUOTE REPLACE)
(CADR BORDER))
(BITBLT NIL NIL NIL STREAM (IPLUS LEFT NBW)
(IPLUS BOTTOM NBW)
(IDIFFERENCE WIDTH (IPLUS NBW NBW))
(IDIFFERENCE HEIGHT (IPLUS NBW NBW))
(QUOTE TEXTURE)
(QUOTE REPLACE)
WHITESHADE]
(T (ERROR "Illegal border:" BORDER])
(DRAWAREABOX
[LAMBDA (LEFT BOTTOM WIDTH HEIGHT BORDER OP W) (* kvl " 5-Sep-84 17:27")
(* draws lines inside the region.)
(PROG (BIG/HALF SM/HALF VERTLEFT VERTRIGHT HORIZTOP HORIZBOTTOM HORIZLEFT HORIZRIGHT)
(SETQ BIG/HALF (IQUOTIENT BORDER 2))
(SETQ SM/HALF (IQUOTIENT (SUB1 BORDER)
2)) (* draw left edge)
(SETQ VERTLEFT (IPLUS LEFT SM/HALF))
(SETQ HORIZTOP (IPLUS BOTTOM HEIGHT -1))
(DRAWLINE VERTLEFT BOTTOM VERTLEFT HORIZTOP BORDER OP W)
(* draw top)
(SETQ HORIZTOP (IDIFFERENCE HORIZTOP BIG/HALF))
(DRAWLINE (SETQ HORIZLEFT (IPLUS LEFT BORDER))
HORIZTOP
(SETQ HORIZRIGHT (IDIFFERENCE (IPLUS LEFT WIDTH -1)
BORDER))
HORIZTOP BORDER OP W) (* draw right edge)
(SETQ VERTRIGHT (IDIFFERENCE (IPLUS LEFT WIDTH -1)
BIG/HALF))
(DRAWLINE VERTRIGHT BOTTOM VERTRIGHT (IPLUS BOTTOM HEIGHT -1)
BORDER OP W) (* draw bottom)
(SETQ HORIZBOTTOM (IPLUS BOTTOM SM/HALF))
(DRAWLINE HORIZLEFT HORIZBOTTOM HORIZRIGHT HORIZBOTTOM BORDER OP W])
(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 "10-Aug-84 19:06")
(* 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))
(MEASUREGRAPHNODE NODE)
(printout PROMPTWINDOW T "Position node " (DISPLAY/NAME NODE))
(PRINTDISPLAYNODE NODE (CONSTANT (create POSITION
XCOORD ← 0
YCOORD ← 0))
W
(DSPCLIPPINGREGION NIL 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) (* rmk: "10-Apr-84 12:33")
(* 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 (CONSTANT (create POSITION
XCOORD ← 0
YCOORD ← 0))
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) (* kvl "10-Aug-84 19:56")
(* 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."))))
(EDITTOGGLELABEL
[LAMBDA (W) (* kvl " 5-Sep-84 19:16")
(* prompts the user for a node and inverts its lable)
(RESETFORM (TTYDISPLAYSTREAM PROMPTWINDOW)
(CLRPROMPT)
(PROG ((GRAPH (WINDOWPROP W (QUOTE GRAPH)))
(DS (WINDOWPROP W (QUOTE DSP)))
NODE)
(COND
((NOT (fetch (GRAPH GRAPHNODES) of GRAPH))
(PROMPTPRINT " No nodes to invert.")
(RETURN)))
(PROMPTPRINT " Select node to have label inverted. ")
(SETQ NODE (READ/NODE (fetch (GRAPH GRAPHNODES) of GRAPH)
DS))
(TERPRI T)
(RESET/NODE/LABELSHADE NODE (QUOTE INVERT)
W)
(AND (fetch (GRAPH GRAPH.INVERTLABELFN) of GRAPH)
(APPLY* (fetch (GRAPH GRAPH.INVERTLABELFN) of GRAPH)
NODE GRAPH W))
(printout T "Node " (fetch NODELABEL of NODE)
" inverted." T)
(RETURN NODE])
(FLIPNODE
[LAMBDA (NODE DS) (* kvl "10-Aug-84 17:27")
(* flips the region around a node.)
(BITBLT NIL NIL NIL DS (IDIFFERENCE (GN/LEFT NODE)
1)
(IDIFFERENCE (GN/BOTTOM NODE)
1)
(IPLUS (fetch NODEWIDTH of NODE)
2)
(IPLUS (fetch NODEHEIGHT of NODE)
2)
(QUOTE TEXTURE)
(QUOTE INVERT)
BLACKSHADE])
(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))))
(GN/BOTTOM
[LAMBDA (NODE) (* kvl "10-Aug-84 17:08")
(IDIFFERENCE (fetch YCOORD of (fetch NODEPOSITION of NODE))
(HALF (fetch NODEHEIGHT of NODE])
(GN/LEFT
[LAMBDA (NODE) (* kvl "10-Aug-84 17:03")
(IDIFFERENCE (fetch XCOORD of (fetch NODEPOSITION of NODE))
(HALF (fetch NODEWIDTH of NODE])
(GN/RIGHT
[LAMBDA (NODE) (* kvl "10-Aug-84 17:04")
(IPLUS (fetch XCOORD of (fetch NODEPOSITION of NODE))
(HALF (fetch NODEWIDTH of NODE])
(GN/TOP
[LAMBDA (NODE) (* kvl "10-Aug-84 17:07")
(IPLUS (fetch YCOORD of (fetch NODEPOSITION of NODE))
(HALF (fetch NODEHEIGHT of NODE])
(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) (* kvl " 5-Sep-84 19:03")
(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) (* kvl " 5-Sep-84 19:14")
(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))
("<-> Border" (QUOTE BORDER))
("<-> Shade" (QUOTE SHADE))
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))
(BORDER (EDITTOGGLEBORDER GRAPHWINDOW))
(SHADE (EDITTOGGLELABEL 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)))))
(GRAPHER/CENTERPRINTINAREA
[LAMBDA (EXP X Y WIDTH HEIGHT STREAM) (* kvl "15-Aug-84 11:01")
(* prints an expression in a box.
The system CENTERPRINTINAREA on MENU worried about
overflowing the right margin, which we ignore here.)
(SETQ STREAM (\GETSTREAM STREAM (QUOTE OUTPUT)))
(PROG (XPOS (STRWIDTH (STRINGWIDTH EXP STREAM)))
(MOVETO (SETQ XPOS (IPLUS X (IQUOTIENT (ADD1 (IDIFFERENCE WIDTH STRWIDTH))
2)))
(IPLUS Y (IQUOTIENT (IPLUS (IDIFFERENCE HEIGHT (FONTPROP STREAM (QUOTE ASCENT)))
(FONTPROP STREAM (QUOTE DESCENT)))
2))
STREAM)
(PRIN3 EXP STREAM])
(GRAPHMOVENODE
(LAMBDA (NODE NEWPOS GRAPH WINDOW) (* rmk: " 2-Feb-84 22:35")
(* moves a node but doesn't change any display.)
(COND
((EQUAL (fetch NODEPOSITION of NODE)
NEWPOS) (* don't move if position hasn't changed)
NIL)
(T (SET/LAYOUT/POSITION NODE NEWPOS)
(CALL.MOVENODEFN NODE NEWPOS GRAPH WINDOW)))))
(GRAPHNODE/BORDER/WIDTH
[LAMBDA (BORDER) (* kvl " 5-Sep-84 16:19")
(* returns a non-negative interger)
(COND
((NULL BORDER)
0)
((EQ BORDER T)
1)
((FIXP BORDER)
(ABS BORDER))
((AND (LISTP BORDER)
(FIXP (CAR BORDER))
(IGEQ (CAR BORDER)
0))
(CAR BORDER))
(T (ERROR "Illegal border:" BORDER])
(GRAPHREGION
[LAMBDA (GRAPH) (* kvl "10-Aug-84 20:14")
(* Returns the minimum region containing the graph.)
(PROG (LEFTOFFSET BOTTOMOFFSET (NODELST (fetch GRAPHNODES of GRAPH)))
(RETURN (COND
[NODELST (* Determine the dimensions of the node labels)
(for N in NODELST do (MEASUREGRAPHNODE N))
(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])
(HARDCOPYGRAPH
[LAMBDA (GRAPH/WINDOW FILE IMAGETYPE TRANS) (* rmk: "27-Aug-84 10:03")
(PROG ((STREAM (OPENIMAGESTREAM FILE IMAGETYPE)))
(DISPLAYGRAPH (COND
((WINDOWP GRAPH/WINDOW)
(WINDOWPROP GRAPH/WINDOW (QUOTE GRAPH)))
(T GRAPH/WINDOW))
STREAM NIL TRANS)
(RETURN (CLOSEF STREAM])
(INTERSECT/REGIONP/LBWH
[LAMBDA (L B W H REG) (* kvl "20-Aug-84 09:54")
(* like intersect regions, but without requiring the
consing)
(NOT (OR (IGREATERP (fetch BOTTOM of REG)
(IPLUS B H))
(ILESSP (fetch PRIGHT of REG)
L)
(IGREATERP (fetch LEFT of REG)
(IPLUS L W))
(ILESSP (fetch PTOP of REG)
B])
(INVERTED/GRAPHNODE/BORDER
[LAMBDA (BORDER) (* kvl " 5-Sep-84 18:49")
(* returns the right thing to invert a graphnode's
border)
(COND
((EQ BORDER T)
NIL)
((NULL BORDER)
T)
((FIXP BORDER)
(IMINUS BORDER))
((AND (LISTP BORDER)
(FIXP (CAR BORDER)))
(LIST (CAR BORDER)
(INVERTED/SHADE/FOR/GRAPHER (CADR BORDER])
(INVERTED/SHADE/FOR/GRAPHER
[LAMBDA (SHADE) (* kvl " 5-Sep-84 18:50")
(* funny name because hopefully will become system
function)
(COND
((EQ SHADE T)
NIL)
((NULL SHADE)
T)
((FIXP SHADE)
(LOGNOT SHADE))
((BITMAPP SHADE)
(PROG ((NB (COPYBITMAP SHADE)))
(BITBLT NIL NIL NIL NB NIL NIL NIL NIL (QUOTE TEXTURE)
(QUOTE INVERT)
BLACKSHADE)
(RETURN NB)))
(T (ERROR "Illegal shade:" SHADE])
(LAYOUT/POSITION
(LAMBDA (NODE) (* rrb "13-JUL-81 10:54")
(fetch NODEPOSITION 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) (* kvl "10-Aug-84 17:24")
(bind NR (RIGHT ← MIN.FIXP) for NODE in NODES do (COND
((IGREATERP (SETQ NR (GN/RIGHT NODE))
RIGHT)
(SETQ RIGHT NR)))
finally (RETURN RIGHT])
(MAX/TOP
[LAMBDA (NODES) (* kvl "10-Aug-84 16:48")
(bind NR (TOP ← MIN.FIXP) for NODE in NODES do (COND
((IGREATERP (SETQ NR (GN/TOP NODE))
TOP)
(SETQ TOP NR)))
finally (RETURN TOP])
(MEASUREGRAPHNODE
(LAMBDA (NODE) (* rmk: " 2-Feb-84 21:19")
(* Measure the nodelabel image)
(SET/LABEL/SIZE NODE)
(SET/LAYOUT/POSITION NODE (OR (fetch NODEPOSITION of NODE)
(ERROR "This graphnode has not been given a position:" NODE)))))
(MIN/BOTTOM
[LAMBDA (NODES) (* kvl "10-Aug-84 17:24")
(* returns the bottommost point of the graph.)
(bind NL (BOTTOM ← MAX.FIXP) for NODE in NODES do (COND
((IGREATERP BOTTOM (SETQ NL (GN/BOTTOM NODE)))
(SETQ BOTTOM NL)))
finally (RETURN BOTTOM])
(MIN/LEFT
[LAMBDA (NODES) (* kvl "10-Aug-84 17:29")
(* returns the leftmost point of the graph.)
(bind NL (LEFT ← MAX.FIXP) for NODE in NODES do (COND
((IGREATERP LEFT (SETQ NL (GN/LEFT NODE)))
(SETQ LEFT NL)))
finally (RETURN LEFT])
(MOVENODE
(LAMBDA (NODE OLDPOS POS GRAPH STREAM) (* rmk: "10-Apr-84 12:31")
(* 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 NODE STREAM) (* erase current position)
(DISPLAYNODE NODE (CONSTANT (create POSITION
XCOORD ← 0
YCOORD ← 0))
STREAM GRAPH) (* put it in new one.)
(SET/LAYOUT/POSITION NODE POS)
(DISPLAYNODE NODE (CONSTANT (create POSITION
XCOORD ← 0
YCOORD ← 0))
STREAM GRAPH)
(FLIPNODE NODE STREAM)))))
(NODECREATE
[LAMBDA (ID LABEL POS TONODEIDS FROMNODEIDS FONT BORDER LABELSHADE)
(* rmk: "15-Sep-84 00:11")
(* creates a node for a grapher.)
(create GRAPHNODE
NODEID ← ID
NODEPOSITION ← POS
NODELABEL ← LABEL
NODEFONT ←(OR FONT DEFAULT.GRAPH.NODEFONT (FONTNAMELIST DEFAULTFONT))
TONODES ← TONODEIDS
FROMNODES ← FROMNODEIDS
NODEBORDER ← BORDER
NODELABELSHADE ← LABELSHADE])
(NODELST/AS/MENU
[LAMBDA (NODELST POS) (* kvl "10-Aug-84 18:55")
(* finds the node that is closest to POS)
(for N in NODELST
bind (X ←(fetch XCOORD of POS))
(Y ←(fetch YCOORD of POS))
T1 T2
thereis (AND (ILESSP [IDIFFERENCE (SETQ T1 (fetch YCOORD of (fetch NODEPOSITION of N)))
(SETQ T2 (HALF (fetch NODEHEIGHT of N]
Y)
(ILESSP Y (IPLUS T1 T2))
(ILESSP [IDIFFERENCE (SETQ T1 (fetch XCOORD of (fetch NODEPOSITION of N)))
(SETQ T2 (HALF (fetch NODEWIDTH of N]
X)
(ILESSP X (IPLUS T1 T2])
(NODEREGION
[LAMBDA (NODE) (* kvl "10-Aug-84 17:25")
(* returns the region taken up by NODE)
(CREATEREGION (GN/LEFT NODE)
(GN/BOTTOM NODE)
(fetch (GRAPHNODE NODEWIDTH) of NODE)
(fetch (GRAPHNODE NODEHEIGHT) of NODE])
(PRINTDISPLAYNODE
[LAMBDA (NODE TRANS STREAM CLIP/REG) (* kvl "10-Sep-84 14:41")
(* prints a node at its position translated by TRANS)
(OR (ZEROP (fetch (GRAPHNODE NODEHEIGHT) of NODE))
(PROG [(LEFT (IPLUS (fetch XCOORD of TRANS)
(GN/LEFT NODE)))
(BOTTOM (IPLUS (fetch YCOORD of TRANS)
(GN/BOTTOM NODE)))
(WIDTH (fetch NODEWIDTH of NODE))
(HEIGHT (fetch NODEHEIGHT of NODE))
(FONT (fetch (GRAPHNODE NODEFONT) of NODE))
(NBW (GRAPHNODE/BORDER/WIDTH (fetch NODEBORDER of NODE]
(COND
((AND CLIP/REG (NOT (INTERSECT/REGIONP/LBWH LEFT BOTTOM WIDTH HEIGHT CLIP/REG)))
(RETURN NODE))
((BITMAPP (fetch NODELABELBITMAP of NODE))
(BITBLT (fetch NODELABELBITMAP of NODE)
0 0 STREAM LEFT BOTTOM WIDTH HEIGHT (QUOTE INPUT)))
[(BITMAPP (fetch NODELABEL of NODE))
(COND
((NEQ 0 NBW)
(DRAW/GRAPHNODE/BORDER (fetch NODEBORDER of NODE)
LEFT BOTTOM WIDTH HEIGHT STREAM)
(BITBLT (fetch NODELABEL of NODE)
0 0 STREAM (IPLUS LEFT NBW)
(IPLUS BOTTOM NBW)
WIDTH HEIGHT (QUOTE INPUT)
(QUOTE REPLACE)))
(T (BITBLT (fetch NODELABEL of NODE)
0 0 STREAM LEFT BOTTOM WIDTH HEIGHT (QUOTE INPUT)
(QUOTE REPLACE]
((IMAGEOBJP (fetch NODELABEL of NODE))
(COND
((NEQ 0 NBW)
(DRAW/GRAPHNODE/BORDER (fetch NODEBORDER of NODE)
LEFT BOTTOM WIDTH HEIGHT STREAM)
(MOVETO (IPLUS NBW LEFT)
(IPLUS NBW BOTTOM)
STREAM))
(T (MOVETO LEFT BOTTOM STREAM)))
(APPLY* (IMAGEOBJPROP (fetch NODELABEL of NODE)
(QUOTE DISPLAYFN))
(fetch NODELABEL of NODE)
STREAM))
((NULL FONT))
[(IGREATERP HEIGHT 2) (* This constant is wrong for scaled graphs)
(AND (NEQ NBW 0)
(DRAW/GRAPHNODE/BORDER (fetch NODEBORDER of NODE)
LEFT BOTTOM WIDTH HEIGHT STREAM))
(DSPFONT FONT STREAM)
(GRAPHER/CENTERPRINTINAREA (fetch NODELABEL of NODE)
LEFT BOTTOM WIDTH HEIGHT STREAM)
(AND (fetch NODELABELSHADE of NODE)
(FILL/GRAPHNODE/LABEL (fetch NODELABELSHADE of NODE)
LEFT BOTTOM WIDTH HEIGHT NBW STREAM))
(COND
((AND CACHE/NODE/LABEL/BITMAPS CLIP/REG (INTERSECT/REGIONP/LBWH LEFT BOTTOM WIDTH
HEIGHT CLIP/REG))
(replace NODELABELBITMAP of NODE with (BITMAPCREATE WIDTH HEIGHT))
(BITBLT STREAM LEFT BOTTOM (fetch NODELABELBITMAP of NODE)
0 0 WIDTH HEIGHT (QUOTE INPUT)
(QUOTE REPLACE]
(T (* so small just use texture)
(BITBLT NIL NIL NIL STREAM LEFT BOTTOM 2 2 (QUOTE TEXTURE)
(QUOTE REPLACE)
BLACKSHADE)))
(RETURN NODE])
(FILL/GRAPHNODE/LABEL
[LAMBDA (SHADE LEFT BOTTOM WIDTH HEIGHT NBW STREAM) (* kvl "10-Sep-84 14:41")
(* NBW is the border, which must be subtracted from the
node's region)
(PROG ((NS SHADE))
(OR (WINDOWP STREAM)
(DISPLAYSTREAMP STREAM)
(RETURN))
(COND
((EQ SHADE T)
(SETQ NS BLACKSHADE))
((NULL SHADE)
(SETQ NS WHITESHADE)))
(BITBLT NIL NIL NIL STREAM (IPLUS LEFT NBW)
(IPLUS BOTTOM NBW)
(IDIFFERENCE WIDTH (IPLUS NBW NBW))
(IDIFFERENCE HEIGHT (IPLUS NBW NBW))
(QUOTE TEXTURE)
(QUOTE INVERT)
NS])
(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 "10-Aug-84 19:26")
(until (MOUSESTATE (OR LEFT MIDDLE RIGHT)) do)
(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))
([EQ NOW (SETQ NEAR (CLOSEST/NODE NODES (CURSORPOSITION NIL DS OLDPOS]
(GO LP))
(T (GO FLIP])
(REDISPLAYGRAPH
[LAMBDA (WINDOW REGION) (* kvl "10-Aug-84 19:52")
(* 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.)
(DSPFILL NIL NIL (QUOTE REPLACE)
WINDOW)
(DISPLAYGRAPH (WINDOWPROP WINDOW (QUOTE GRAPH))
WINDOW
(OR REGION (DSPCLIPPINGREGION NIL WINDOW])
(RESET/NODE/BORDER
[LAMBDA (NODE BORDER STREAM TRANS) (* kvl " 5-Sep-84 19:18")
(* gives the node a new border, and displays it if there
is a stream)
(PROG [(ONBW (GRAPHNODE/BORDER/WIDTH (fetch NODEBORDER of NODE]
(AND STREAM (ERASE/GRAPHNODE NODE STREAM TRANS))
(replace NODEBORDER of NODE with (COND
((EQ BORDER (QUOTE INVERT))
(INVERTED/GRAPHNODE/BORDER (fetch NODEBORDER
of NODE)))
(T BORDER)))
(OR (IEQP ONBW (GRAPHNODE/BORDER/WIDTH (fetch NODEBORDER of NODE)))
(SET/LABEL/SIZE NODE T))
(AND STREAM (PRINTDISPLAYNODE NODE (OR TRANS
(CONSTANT (create POSITION
XCOORD ← 0
YCOORD ← 0)))
STREAM))
(RETURN NODE])
(RESET/NODE/LABELSHADE
[LAMBDA (NODE SHADE STREAM TRANS) (* kvl " 5-Sep-84 19:23")
(* gives the node a new SHADE and displays it if there
is a stream)
(AND STREAM (ERASE/GRAPHNODE NODE STREAM TRANS))
(replace NODELABELSHADE of NODE with (COND
((EQ SHADE (QUOTE INVERT))
(INVERTED/SHADE/FOR/GRAPHER (fetch NODELABELSHADE
of NODE)))
(T SHADE)))
(AND STREAM (PRINTDISPLAYNODE NODE (OR TRANS (CONSTANT (create POSITION
XCOORD ← 0
YCOORD ← 0)))
STREAM))
NODE])
(SCALE/GRAPH
[LAMBDA (GRAPH STREAM SCALE) (* rmk: "15-Sep-84 13:52")
(create GRAPH using GRAPH GRAPHNODES ←(for N in (fetch GRAPHNODES of GRAPH)
collect
(SETQ N
(create GRAPHNODE
using N NODEPOSITION ←[create
POSITION
XCOORD ←[FIXR (FTIMES SCALE
(fetch XCOORD
of (fetch
NODEPOSITION
of N]
YCOORD ←(FIXR (FTIMES SCALE
(fetch YCOORD
of (fetch
NODEPOSITION
of N]
NODELABELBITMAP ← NIL NODEWIDTH ← NIL
NODEHEIGHT ← NIL NODEFONT ←(FONTCREATE
(fetch NODEFONT of N)
NIL NIL NIL STREAM)
NODEBORDER ←(SCALE/GRAPHNODE/BORDER
(fetch NODEBORDER of N)
SCALE)))
(SET/LABEL/SIZE N)
N])
(SCALE/GRAPHNODE/BORDER
[LAMBDA (BORDER SCALE) (* kvl " 5-Sep-84 18:06")
(* returns a new setting for the border appropriate for
the given SCALE)
(COND
((NULL BORDER)
0)
((EQ BORDER T)
(FIXR (FTIMES SCALE NODEBORDERWIDTH)))
((FIXP BORDER)
(FIXR (FTIMES SCALE BORDER)))
((AND (LISTP BORDER)
(FIXP (CAR BORDER)))
(CONS (FIXR (FTIMES SCALE (CAR BORDER)))
(CDR BORDER])
(SET/LABEL/SIZE
[LAMBDA (NODE RESET/FLG) (* kvl " 5-Sep-84 18:27")
(* the SHADE and null font stuff is for ZOOMGRAPH)
(OR (AND (NOT RESET/FLG)
(FIXP (fetch NODEHEIGHT of NODE))
(FIXP (fetch NODEWIDTH of NODE)))
(PROG ((FONT (fetch (GRAPHNODE NODEFONT) of NODE))
(LAB (fetch (GRAPHNODE NODELABEL) of NODE))
(NBW (GRAPHNODE/BORDER/WIDTH (fetch NODEBORDER 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)))
((IMAGEOBJP LAB)
(SETQ WIDTH (APPLY* (IMAGEOBJPROP LAB (QUOTE IMAGEBOXFN))
LAB))
(SETQ HEIGHT (fetch (IMAGEBOX YSIZE) of WIDTH))
(SETQ WIDTH (fetch (IMAGEBOX XSIZE) of WIDTH)))
[(NULL FONT) (* FONT of NIL means that the node is smaller than
displays)
(SETQ NBW (SETQ WIDTH (SETQ HEIGHT 0]
(T (OR (FONTP FONT)
(SETQ FONT (FONTCREATE FONT)))
[SETQ WIDTH (IPLUS (STRINGWIDTH (fetch NODELABEL of NODE)
FONT)
(FONTPROP FONT (QUOTE DESCENT]
(SETQ HEIGHT (IPLUS (FONTPROP FONT (QUOTE HEIGHT))
(FONTPROP FONT (QUOTE DESCENT]
(OR (AND (NOT RESET/FLG)
(FIXP (fetch NODEWIDTH of NODE)))
(replace NODEWIDTH of NODE with (IPLUS WIDTH NBW NBW)))
(OR (AND (NOT RESET/FLG)
(FIXP (fetch NODEHEIGHT of NODE)))
(replace NODEHEIGHT of NODE with (IPLUS HEIGHT NBW NBW)))
(RETURN NODE])
(SET/LAYOUT/POSITION
[LAMBDA (NODE POS) (* kvl "10-Aug-84 17:32")
(* sets a nodes position)
(replace XCOORD of (fetch NODEPOSITION of NODE) with (fetch XCOORD of POS))
(replace YCOORD of (fetch NODEPOSITION of NODE) with (fetch YCOORD of POS))
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)
(* kvl "10-Sep-84 14:35")
(* 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)))
(T (WINDOWPROP WINDOW (QUOTE RIGHTBUTTONFN)
NIL)))
(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) (* kvl "10-Aug-84 20:18")
(* 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 PTOP) 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) (* rmk: " 2-Feb-84 22:36")
(* causes ND to follow cursor.)
(PROG (OLDPOS ORIGPOS DOWNFLG) (* maybe there aren't any nodes)
(OR ND (RETURN))
(SETQ ORIGPOS (COPYALL (fetch NODEPOSITION of ND)))
(SETQ OLDPOS (CURSORPOSITION (fetch NODEPOSITION of ND)
DS))
(FLIPNODE ND DS)
(until (COND
(DOWNFLG (MOUSESTATE UP))
((SETQ DOWNFLG (MOUSESTATE (NOT UP)))
NIL))
do (MOVENODE ND (fetch NODEPOSITION of ND)
(CURSORPOSITION NIL DS OLDPOS)
GRAPH DS))
(FLIPNODE ND DS)
(COND
((NOT (EQUAL ORIGPOS (SETQ OLDPOS (fetch NODEPOSITION of 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)))))
)
(* Dummy for Carol)
(DEFINEQ
(GRAPHER.DSPSCALE
[LAMBDA (SCALE STREAM) (* rmk: "27-Aug-84 10:05")
(* Dummy for Carol)
1])
)
(MOVD? 'GRAPHER.DSPSCALE 'DSPSCALE)
(* functions for finding larger and smaller fonts)
(DEFINEQ
(NEXTSIZEFONT
[LAMBDA (WHICHDIR NOWFONT) (* rmk: "15-Sep-84 00:14")
(* returns the next sized font either SMALLER or LARGER
that on of size FONT. (NEXTSIZEFONT
(QUOTE LARGER) 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)))))))
)
(DECLARE: DONTEVAL@LOAD DOCOPY
(RPAQ DECREASING.FONT.LIST (DECREASING.FONT.LIST))
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS DECREASING.FONT.LIST)
)
(* functions for 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) (* rmk: " 5-Feb-84 15:01")
(* 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 D (FLOOR ← Y) in DS do (SETQ FLOOR (IPLUS FLOOR (BRH/LAYOUT D X FLOOR MOMLST
(GETNODEFROMID D NODELST))))
finally (RETURN (IDIFFERENCE FLOOR Y)))))
(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) (* rmk: " 5-Feb-84 14:47")
(* See comment on BRH/LAYOUT. Instead of keeping only the graphnode in layed out node'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 free variables to return transition chains. RETURNTTC is the top left corners of all the labels.
RETURNBTC is the bottom left corners.)
(DECLARE (USEDFREE PERSONALD RETURNTTC RETURNBTC))
(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))
(push RETURNTTC (create POSITION
XCOORD ← X
YCOORD ←(IPLUS PERSONALD (IPLUS (IDIFFERENCE YCENTER H/2)
H))))
(push RETURNBTC (create POSITION
XCOORD ← X
YCOORD ←(IDIFFERENCE YCENTER H/2)))
(RETURN YCENTER))))
(BRHC/LAYOUT/DAUGHTERS
(LAMBDA (DS X/SW MOMLST)
(DECLARE (USEDFREE MOTHERD FAMILYD NODELST RETURNTTC RETURNBTC))
(* rmk: " 5-Feb-84 14:52")
(* 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 RETURNBTC). 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 D in DS bind GN BTC TTC 1ST/DCENTER LST/DCENTER (OFFSET ← 0)
(X ←(IPLUS X/SW MOTHERD))
do (SETQ GN (GETNODEFROMID D NODELST))
(SETQ LST/DCENTER (BRHC/LAYOUT D X MOMLST GN))
(COND
((NULL TTC) (* first daughter)
(SETQ 1ST/DCENTER LST/DCENTER)
(SETQ TTC RETURNTTC)
(SETQ BTC RETURNBTC))
(T (SETQ OFFSET (BRHC/INTERTREE/SPACE TTC RETURNBTC))
(RPLACA (fetch (GRAPHNODE NODEPOSITION) of GN)
OFFSET)
(SETQ TTC (EXTEND/TRANSITION/CHAIN (RAISE/TRANSITION/CHAIN RETURNTTC OFFSET)
TTC))
(SETQ BTC (EXTEND/TRANSITION/CHAIN BTC (RAISE/TRANSITION/CHAIN RETURNBTC 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 RETURNTTC (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 RETURNBTC 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) (* rmk: " 3-Feb-84 09:55")
(* initiallizes the transition chains to the right edge
of the node label, and returns the label's center.)
(DECLARE (USEDFREE RETURNTTC RETURN/TBC))
(SETQ RETURNTTC (LIST (create POSITION
XCOORD ← X/SW
YCOORD ← 0)))
(SETQ RETURNBTC (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 "10-Aug-84 19:56")
(* 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 "10-Aug-84 19:56")
(* See comments on BRH/LAYOUT and BRH/LAYOUT/DAUGHTERS first. This 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 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.)
[PROG (RETURNTTC RETURNBTC)
(DECLARE (SPECVARS RETURNTTC RETURNBTC))
(COND
((NLISTP ROOTS)
(BRHC/LAYOUT ROOTS 0 NIL (GETNODEFROMID ROOTS NODELST))
(BRHC/OFFSET ROOTS 0))
((NULL (CDR ROOTS))
(BRHC/LAYOUT (CAR ROOTS)
0 NIL (GETNODEFROMID (CAR ROOTS)
NODELST))
(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 "10-Aug-84 19:56")
(* 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))))
(FOREST/BREAK/CYCLES
[LAMBDA (NODE) (* kvl "14-Aug-84 09:19")
(* Breaks any cycles by inserting new nodes and boxing)
(DECLARE (USEDFREE NODELST))
(replace (GRAPHNODE NODEPOSITION) of NODE with T)
(for DTAIL DN on (fetch (GRAPHNODE TONODES) of NODE)
do (SETQ DN (GETNODEFROMID (CAR DTAIL)
NODELST))
(COND
((fetch (GRAPHNODE NODEPOSITION) of DN) (* We%'ve seen this before)
(SETQ DN (NEW/INSTANCE/OF/GRAPHNODE DN))
(RPLACA DTAIL (fetch (GRAPHNODE NODEID) of DN)))
(T (FOREST/BREAK/CYCLES DN])
(INIT/NODES/FOR/LAYOUT
[LAMBDA (NS FORMAT ROOTIDS FONT) (* hdj " 5-Sep-84 10:37")
(for GN in NS
do [replace (GRAPHNODE NODEPOSITION) of GN with (NOT (NOT (FMEMB (fetch (GRAPHNODE NODEID)
of GN)
ROOTIDS]
(* T Used to indicate prior visitation.
Roots are already visited)
(OR (fetch (GRAPHNODE NODEFONT) of GN)
(replace (GRAPHNODE NODEFONT) of GN with FONT)))
[for R in ROOTIDS do (COND
((FMEMB 'LATTICE FORMAT)
(LATTICE/BREAK/CYCLES (GETNODEFROMID R NODELST)
NIL))
(T (FOREST/BREAK/CYCLES (GETNODEFROMID R NODELST]
(for GN in NODELST
do (replace (GRAPHNODE NODEPOSITION) of GN with NIL)
(SET/LABEL/SIZE GN])
(INTERPRET/MARK/FORMAT
[LAMBDA (FORMAT) (* kvl " 5-Sep-84 17:29")
(* sets specvars for NEW/INSTANCE/OF/GRAPHNODE and
MARK/GRAPH/NODE)
(DECLARE (SPECVARS BOX/BOTH/FLG BOX/LEAVES/FLG BORDER/FOR/MARKING LABELSHADE/FOR/MARKING))
(PROG (PL)
(AND (EQMEMB (QUOTE COPIES/ONLY)
FORMAT)
(SETQ BOX/BOTH/FLG NIL))
(AND (EQMEMB (QUOTE NOT/LEAVES)
FORMAT)
(SETQ BOX/LEAVES/FLG NIL))
(COND
((NLISTP FORMAT)
(RETURN))
((EQ (CAR FORMAT)
(QUOTE MARK))
(SETQ PL (CDR FORMAT)))
((SETQ PL (FASSOC (QUOTE MARK)
FORMAT))
(SETQ PL (CDR PL)))
(T (RETURN)))
[COND
[(FMEMB (QUOTE BORDER)
PL)
(SETQ BORDER/FOR/MARKING (LISTGET PL (QUOTE BORDER]
(T (SETQ BORDER/FOR/MARKING (QUOTE DON'T]
(COND
[(FMEMB (QUOTE LABELSHADE)
PL)
(SETQ LABELSHADE/FOR/MARKING (LISTGET PL (QUOTE LABELSHADE]
(T (SETQ LABELSHADE/FOR/MARKING (QUOTE DON'T])
(LATTICE/BREAK/CYCLES
[LAMBDA (NODE STACK) (* kvl "14-Aug-84 09:14")
(replace (GRAPHNODE NODEPOSITION) of NODE with T)
(for DTAIL on (fetch (GRAPHNODE TONODES) of NODE) bind D GN
do (SETQ GN (GETNODEFROMID (SETQ D (CAR DTAIL))
NODELST))
(COND
((FMEMB D STACK)
(SETQ GN (NEW/INSTANCE/OF/GRAPHNODE GN))
(RPLACA DTAIL (fetch NODEID of GN)))
((NULL (fetch (GRAPHNODE NODEPOSITION) of GN))
(LATTICE/BREAK/CYCLES GN (CONS D STACK])
(LAYOUTFOREST
(LAMBDA (NODELST ROOTIDS FORMAT BOXING FONT MOTHERD PERSONALD FAMILYD)
(* rmk: " 2-Feb-84 16:55")
(* This is an older version of LayoutGraph, kept around
temporarily but de-documented)
(LAYOUTGRAPH NODELST ROOTIDS (CONS FORMAT BOXING)
FONT MOTHERD PERSONALD)))
(LAYOUTGRAPH
[LAMBDA (NODELST ROOTIDS FORMAT FONT MOTHERD PERSONALD FAMILYD)
(* rmk: "15-Sep-84 00:15")
(* 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 MOTHERD PERSONALD FAMILYD))
(PROG ((BOX/BOTH/FLG T)
(BOX/LEAVES/FLG T)
(BORDER/FOR/MARKING T)
(LABELSHADE/FOR/MARKING (QUOTE DON'T))
G)
(DECLARE (SPECVARS BOX/BOTH/FLG BOX/LEAVES/FLG BORDER/FOR/MARKING LABELSHADE/FOR/MARKING))
(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."))
(OR FONT (SETQ FONT DEFAULTFONT))
(OR MOTHERD (SETQ MOTHERD (STRINGWIDTH "AAAAAA" FONT)))
[OR PERSONALD (SETQ PERSONALD (COND
((EQMEMB (QUOTE VERTICAL)
FORMAT)
(STRINGWIDTH "AA" FONT))
(T 0]
[OR FAMILYD (SETQ FAMILYD (HALF (FONTPROP FONT (QUOTE ASCENT]
(INTERPRET/MARK/FORMAT FORMAT)
(INIT/NODES/FOR/LAYOUT NODELST FORMAT ROOTIDS FONT)
(AND (EQMEMB (QUOTE VERTICAL)
FORMAT)
(SWITCH/NODE/HEIGHT/WIDTH NODELST))
[SETQ G (COND
((EQMEMB (QUOTE LATTICE)
FORMAT)
(BROWSE/LAYOUT/LATTICE ROOTIDS))
((EQMEMB (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
((EQMEMB (QUOTE VERTICAL)
FORMAT)
(SWITCH/NODE/HEIGHT/WIDTH NODELST)
(REFLECT/GRAPH/DIAGONALLY G)
(OR (EQMEMB (QUOTE REVERSE)
FORMAT)
(REFLECT/GRAPH/VERTICALLY G))
(AND (EQMEMB (QUOTE REVERSE/DAUGHTERS)
FORMAT)
(REFLECT/GRAPH/HORIZONTALLY G)))
(T (AND (EQMEMB (QUOTE REVERSE)
FORMAT)
(REFLECT/GRAPH/HORIZONTALLY G))
(AND (EQMEMB (QUOTE REVERSE/DAUGHTERS)
FORMAT)
(REFLECT/GRAPH/VERTICALLY G]
(RETURN G])
(LAYOUTLATTICE
[LAMBDA (NODELST ROOTIDS FORMAT FONT MOTHERD PERSONALD FAMILYD)
(* rmk: "15-Sep-84 00:15")
(* 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 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 FONT (OR FONT DEFAULTFONT))
(INIT/NODES/FOR/LAYOUT NODELST ROOTIDS FORMAT FONT)
[OR FAMILYD (SETQ FAMILYD (HALF (FONTPROP FONT (QUOTE ASCENT]
(OR MOTHERD (SETQ MOTHERD (STRINGWIDTH "AAAAAA" FONT)))
[OR PERSONALD (SETQ PERSONALD (COND
((EQ FORMAT (QUOTE VERTICAL))
(STRINGWIDTH "AA" FONT))
(T 0]
(BROWSE/LAYOUT/LATTICE ROOTIDS])
(LAYOUTSEXPR
(LAMBDA (TREE FORMAT BOXING FONT MOTHERD PERSONALD FAMILYD)
(* rmk: "10-Apr-84 12:15")
(* 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))))))
(MARK/GRAPH/NODE
[LAMBDA (NODE) (* rmk: "15-Sep-84 00:18")
(* changes appearance of graph node to indicate that a
link has been snapped.)
(DECLARE (USEDFREE BORDER/FOR/MARKING LABELSHADE/FOR/MARKING))
(OR (EQ BORDER/FOR/MARKING (QUOTE DON'T))
(replace NODEBORDER of NODE with BORDER/FOR/MARKING))
(OR (EQ LABELSHADE/FOR/MARKING (QUOTE DON'T))
(replace NODELABELSHADE of NODE with LABELSHADE/FOR/MARKING])
(NEW/INSTANCE/OF/GRAPHNODE
[LAMBDA (GN)
(DECLARE (USEDFREE NODELST BOX/LEAVES/FLG BOX/BOTH/FLG))
(* kvl " 5-Sep-84 16:30")
(* 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)
NODEBORDER ←(COPY (fetch (GRAPHNODE NODEBORDER) of GN))
NODELABELSHADE ←(fetch NODELABELSHADE of GN]
(push NODELST NEW)
[COND
((OR BOX/LEAVES/FLG (fetch (GRAPHNODE TONODES) of GN))
(MARK/GRAPH/NODE NEW)
(COND
(BOX/BOTH/FLG (MARK/GRAPH/NODE GN]
(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 "10-Aug-84 17:23")
(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 (SETQ N (fetch (GRAPHNODE NODEPOSITION) of N))
(replace XCOORD of N with (IDIFFERENCE W (fetch XCOORD of N])
(REFLECT/GRAPH/VERTICALLY
[LAMBDA (GRAPH) (* kvl "10-Aug-84 16:48")
(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 (SETQ N (fetch (GRAPHNODE NODEPOSITION) of N))
(replace YCOORD of N with (IDIFFERENCE H (fetch YCOORD of N])
(SWITCH/NODE/HEIGHT/WIDTH
(LAMBDA (NL) (* rmk: " 2-Feb-84 22:19")
(for N in NL do (swap (fetch (GRAPHNODE NODEWIDTH) of N)
(fetch (GRAPHNODE NODEHEIGHT) of N)))))
)
(RPAQQ DEFAULT.GRAPH.NODEBORDER NIL)
(RPAQQ DEFAULT.GRAPH.NODEFONT NIL)
(RPAQQ DEFAULT.GRAPH.NODELABELSHADE NIL)
(RPAQQ CACHE/NODE/LABEL/BITMAPS NIL)
(RPAQQ EDITGRAPHMENU NIL)
(RPAQQ GRAPHEDITWINDOW NIL)
(RPAQQ NODEBORDERWIDTH 1)
(RPAQ ORIGIN (CREATE POSITION XCOORD ← 0 YCOORD ← 0))
(MOVD? (FUNCTION NILL)
(FUNCTION IMAGEOBJP)
T)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(LOCALVARS)
)
(DECLARE: DOEVAL@COMPILE DONTCOPY
(GLOBALVARS EDITGRAPHMENU GRAPHEDITWINDOW NODEBORDERWIDTH ORIGIN)
)
[DECLARE: EVAL@COMPILE
(RECORD GRAPHNODE (NODEID NODEPOSITION NODELABELBITMAP NIL NODELABELSHADE NODEWIDTH NODEHEIGHT
TONODES FROMNODES NODEFONT NODELABEL NODEBORDER)
NODEBORDER ← DEFAULT.GRAPH.NODEBORDER NODELABELSHADE ← DEFAULT.GRAPH.NODELABELSHADE
NODEFONT ← DEFAULT.GRAPH.NODEFONT)
(RECORD GRAPH (GRAPHNODES SIDESFLG DIRECTEDFLG GRAPH.MOVENODEFN GRAPH.ADDNODEFN GRAPH.DELETENODEFN
GRAPH.ADDLINKFN GRAPH.DELETELINKFN GRAPH.FONTCHANGEFN GRAPH.INVERTBORDERFN
GRAPH.INVERTLABELFN))
]
(DECLARE: DONTCOPY
(DECLARE: EVAL@COMPILE
(PUTPROPS HALF MACRO ((X)
(LRSH X 1)))
)
)
(PUTPROPS GRAPHER COPYRIGHT ("Xerox Corporation" T 1983 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (3362 64706 (ADD/AND/DISPLAY/LINK 3372 . 3895) (APPLYTOSELECTEDNODE 3897 . 6078) (
CALL.MOVENODEFN 6080 . 6425) (CHANGE.NODEFONT.SIZE 6427 . 7386) (CHOOSE.GRAPH.FONT 7388 . 7819) (
CLOSEST/NODE 7821 . 8387) (DEFAULT.ADDNODEFN 8389 . 9084) (DELETE/AND/DISPLAY/LINK 9086 . 9958) (
DISPLAY/NAME 9960 . 10106) (DISPLAYGRAPH 10108 . 11536) (DISPLAYLINK 11538 . 13501) (DISPLAYLINK/LR
13503 . 14221) (DISPLAYLINK/TB 14223 . 14941) (EDITTOGGLEBORDER 14943 . 15973) (ERASE/GRAPHNODE 15975
. 16756) (DISPLAYNODE 16758 . 17160) (DISPLAYNODELINKS 17162 . 17838) (DRAW/GRAPHNODE/BORDER 17840 .
18821) (DRAWAREABOX 18823 . 20144) (EDITADDLINK 20146 . 20483) (EDITADDNODE 20485 . 21228) (
EDITAPPLYTOLINK 21230 . 22381) (EDITCHANGEFONT 22383 . 23130) (EDITDELETELINK 23132 . 23477) (
EDITDELETENODE 23479 . 25094) (EDITGRAPH 25096 . 25894) (EDITGRAPH1 25896 . 27467) (EDITGRAPHMENU
27469 . 28045) (EDITMOVENODE 28047 . 29459) (EDITTOGGLELABEL 29461 . 30493) (FLIPNODE 30495 . 30981) (
FONTNAMELIST 30983 . 31236) (FROMLINKS 31238 . 31383) (GETNODEFROMID 31385 . 31564) (GN/BOTTOM 31566
. 31796) (GN/LEFT 31798 . 32025) (GN/RIGHT 32027 . 32250) (GN/TOP 32252 . 32474) (GRAPHADDLINK 32476
. 32967) (GRAPHADDNODE 32969 . 33550) (GRAPHDELETELINK 33552 . 34151) (GRAPHDELETENODE 34153 . 34527)
(GRAPHEDITCOMMANDFN 34529 . 35975) (GRAPHEDITEVENTFN 35977 . 36579) (GRAPHER/CENTERPRINTINAREA 36581
. 37327) (GRAPHMOVENODE 37329 . 37820) (GRAPHNODE/BORDER/WIDTH 37822 . 38279) (GRAPHREGION 38281 .
39080) (HARDCOPYGRAPH 39082 . 39436) (INTERSECT/REGIONP/LBWH 39438 . 39938) (INVERTED/GRAPHNODE/BORDER
39940 . 40430) (INVERTED/SHADE/FOR/GRAPHER 40432 . 41017) (LAYOUT/POSITION 41019 . 41173) (
MANHATTANDIST 41175 . 41579) (MAX/RIGHT 41581 . 41895) (MAX/TOP 41897 . 42200) (MEASUREGRAPHNODE 42202
. 42588) (MIN/BOTTOM 42590 . 43006) (MIN/LEFT 43008 . 43413) (MOVENODE 43415 . 44311) (NODECREATE
44313 . 44876) (NODELST/AS/MENU 44878 . 45627) (NODEREGION 45629 . 46004) (PRINTDISPLAYNODE 46006 .
49065) (FILL/GRAPHNODE/LABEL 49067 . 49757) (PROMPTINWINDOW 49759 . 52097) (READ/NODE 52099 . 52786) (
REDISPLAYGRAPH 52788 . 53224) (RESET/NODE/BORDER 53226 . 54158) (RESET/NODE/LABELSHADE 54160 . 54851)
(SCALE/GRAPH 54853 . 55848) (SCALE/GRAPHNODE/BORDER 55850 . 56387) (SET/LABEL/SIZE 56389 . 58187) (
SET/LAYOUT/POSITION 58189 . 58622) (SHIFTP 58624 . 58879) (SHOWGRAPH 58881 . 60351) (SIZE/GRAPH/WINDOW
60353 . 61916) (TOGGLE/DIRECTEDFLG 61918 . 62463) (TOGGLE/SIDESFLG 62465 . 63051) (TOLINKS 63053 .
63194) (TRACKCURSOR 63196 . 64197) (TRACKNODE 64199 . 64704)) (64735 64953 (GRAPHER.DSPSCALE 64745 .
64951)) (65049 67242 (NEXTSIZEFONT 65059 . 66163) (DECREASING.FONT.LIST 66165 . 66576) (SCALE.FONT
66578 . 67240)) (67460 98730 (BRH/LAYOUT 67470 . 68907) (BRH/LAYOUT/DAUGHTERS 68909 . 69680) (
BRH/OFFSET 69682 . 70081) (BRHC/INTERTREE/SPACE 70083 . 71238) (BRHC/LAYOUT 71240 . 72771) (
BRHC/LAYOUT/DAUGHTERS 72773 . 75201) (BRHC/LAYOUT/TERMINAL 75203 . 75834) (BRHC/OFFSET 75836 . 76603)
(BRHL/LAYOUT 76605 . 78309) (BRHL/LAYOUT/DAUGHTERS 78311 . 79612) (BRHL/MOVE/RIGHT 79614 . 80474) (
BROWSE/LAYOUT/HORIZ 80476 . 81012) (BROWSE/LAYOUT/HORIZ/COMPACTLY 81014 . 82951) (
BROWSE/LAYOUT/LATTICE 82953 . 83607) (BRV/OFFSET 83609 . 84467) (EXTEND/TRANSITION/CHAIN 84469 . 85533
) (FOREST/BREAK/CYCLES 85535 . 86274) (INIT/NODES/FOR/LAYOUT 86276 . 87196) (INTERPRET/MARK/FORMAT
87198 . 88337) (LATTICE/BREAK/CYCLES 88339 . 88931) (LAYOUTFOREST 88933 . 89371) (LAYOUTGRAPH 89373 .
92336) (LAYOUTLATTICE 92338 . 93626) (LAYOUTSEXPR 93628 . 94190) (LAYOUTSEXPR1 94192 . 94779) (
MARK/GRAPH/NODE 94781 . 95391) (NEW/INSTANCE/OF/GRAPHNODE 95393 . 96438) (RAISE/TRANSITION/CHAIN 96440
. 96887) (REFLECT/GRAPH/DIAGONALLY 96889 . 97415) (REFLECT/GRAPH/HORIZONTALLY 97417 . 97933) (
REFLECT/GRAPH/VERTICALLY 97935 . 98467) (SWITCH/NODE/HEIGHT/WIDTH 98469 . 98728)))))
STOP