(FILECREATED " 2-Mar-85 11:41:34" {ERIS}<LISPCORE>LIBRARY>GRAPHER.;35 132318
changes to: (VARS GRAPHERCOMS)
(FNS HARDCOPYGRAPH INIT/NODES/FOR/LAYOUT)
previous date: "18-Feb-85 16:19:31" {ERIS}<LISPCORE>LIBRARY>GRAPHER.;32)
(* Copyright (c) 1983, 1984, 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT GRAPHERCOMS)
(RPAQQ GRAPHERCOMS [[COMS (* For Harmony, if SHIFTDOWNP isn't defined)
(FNS GRAPHER.SHIFTDOWNP)
(P (MOVD? (QUOTE GRAPHER.SHIFTDOWNP)
(QUOTE SHIFTDOWNP]
(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 LINKPARAMETERS
MANHATTANDIST MAX/RIGHT MAX/TOP MEASUREGRAPHNODE MEMBTONODES MIN/BOTTOM MIN/LEFT
MOVENODE NODECREATE NODELST/AS/MENU NODEREGION PRINTDISPLAYNODE FILL/GRAPHNODE/LABEL
FIX/SCALE PROMPTINWINDOW READ/NODE REDISPLAYGRAPH RESET/NODE/BORDER
RESET/NODE/LABELSHADE SCALE/GRAPH SCALE/GRAPHNODE/BORDER SCALE/TONODES SET/LABEL/SIZE
SET/LAYOUT/POSITION 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)
[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)
(CONSTANTS (LINKPARAMS (QUOTE Link% Parameters)))
(VARS DEFAULT.GRAPH.NODEBORDER DEFAULT.GRAPH.NODEFONT DEFAULT.GRAPH.NODELABELSHADE
ScalableLinkParameters (CACHE/NODE/LABEL/BITMAPS)
(EDITGRAPHMENU)
(GRAPHEDITWINDOW)
(NODEBORDERWIDTH 1)
(ORIGIN (CREATEPOSITION 0 0)))
(P (MOVD? (FUNCTION NILL)
(FUNCTION IMAGEOBJP)
T))
(LOCALVARS . T)
(GLOBALVARS EDITGRAPHMENU GRAPHEDITWINDOW NODEBORDERWIDTH ORIGIN)
(RECORDS GRAPHNODE GRAPH)
(DECLARE: DONTCOPY (MACROS HALF))
(COMS (* Grapher image objects)
(FNS GRAPHERCOPYBUTTONEVENTFN GRAPHOBJ.FINDGRAPH)
(FNS ALIGNMENTNODE GRAPHOBJ.CHECKALIGN)
(FNS GRAPHEROBJ GRAPHOBJ.BUTTONEVENTINFN GRAPHOBJ.COPYFN GRAPHOBJ.DISPLAYFN
GRAPHOBJ.GETALIGN GRAPHOBJ.GETFN GRAPHOBJ.IMAGEBOXFN GRAPHOBJ.PUTALIGN
GRAPHOBJ.PUTFN)
(FNS COPYGRAPH DUMPGRAPH READGRAPH)
(VARS (GRAPHERIMAGEFNS))
(ALISTS (IMAGEOBJGETFNS GRAPHOBJ.GETFN])
(* For Harmony, if SHIFTDOWNP isn't defined)
(DEFINEQ
(GRAPHER.SHIFTDOWNP
[LAMBDA (SHIFT) (* rmk: " 4-Feb-85 14:50")
(* Tells whether a given shift is down)
(SELECTQ SHIFT
(LOCK (ffetch (SHIFTSTATE LOCK) of \SHIFTSTATE))
(META (ffetch (SHIFTSTATE META) of \SHIFTSTATE))
(SHIFT (ffetch (SHIFTSTATE SHIFT) of \SHIFTSTATE))
(1SHIFT (ffetch (SHIFTSTATE 1SHIFT) of \SHIFTSTATE))
(2SHIFT (ffetch (SHIFTSTATE 2SHIFT) of \SHIFTSTATE))
(SHIFTORLOCK (ffetch (SHIFTSTATE SHIFTORLOCK) of \SHIFTSTATE))
(CTRL (ffetch (SHIFTSTATE CTRL) of \SHIFTSTATE))
(FONT (ffetch (SHIFTSTATE FONT) of \SHIFTSTATE))
(USERMODE1 (ffetch (SHIFTSTATE USERMODE1) of \SHIFTSTATE))
(USERMODE2 (ffetch (SHIFTSTATE USERMODE2) of \SHIFTSTATE))
(USERMODE3 (ffetch (SHIFTSTATE USERMODE3) of \SHIFTSTATE))
(\ILLEGAL.ARG SHIFT])
)
(MOVD? (QUOTE GRAPHER.SHIFTDOWNP)
(QUOTE SHIFTDOWNP))
(DEFINEQ
(ADD/AND/DISPLAY/LINK
[LAMBDA (FROMND TOND WIN G) (* dgb: "22-Jan-85 06:51")
(* adds and displays a link.)
(COND
((MEMBTONODES (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) (* dgb: "23-Jan-85 08:27")
(* delete a link and updates the display.)
(COND
([NOT (OR (MEMBTONODES (fetch NODEID of TOND)
(TOLINKS FROMND))
(AND (MEMBTONODES (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 NIL (LINKPARAMETERS FROMND TOND))
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 PARAMS) (* dgb: "22-Jan-85 07:40")
(* draws in a link from FRND TO TOND, translated by
TRANS)
(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 PARAMS))
((IGREATERP (GN/LEFT FRND)
(GN/RIGHT TOND))
(DISPLAYLINK/LR TRANS FRND TOND LINEWIDTH NIL STREAM PARAMS))
((IGREATERP (GN/BOTTOM FRND)
(GN/TOP TOND))
(DISPLAYLINK/TB TRANS TOND FRND LINEWIDTH NIL STREAM PARAMS))
((IGREATERP (GN/BOTTOM TOND)
(GN/TOP FRND))
(DISPLAYLINK/TB TRANS FRND TOND LINEWIDTH NIL STREAM PARAMS))
(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 PARAMS))
((IGREATERP (GN/BOTTOM TOND)
(GN/TOP FRND))
(DISPLAYLINK/TB TRANS FRND TOND LINEWIDTH NIL STREAM PARAMS))
((IGREATERP (GN/LEFT TOND)
(GN/RIGHT FRND))
(DISPLAYLINK/LR TRANS TOND FRND LINEWIDTH NIL STREAM PARAMS))
((IGREATERP (GN/LEFT FRND)
(GN/RIGHT TOND))
(DISPLAYLINK/LR TRANS FRND TOND LINEWIDTH NIL STREAM PARAMS))
(T (* if on top of each other, don't draw.)
NIL])
(DISPLAYLINK/LR
[LAMBDA (TRANS GNL GNR WIDTH OPERATION STREAM PARAMS) (* dgb: "23-Jan-85 08:44")
(* draws a line from the left edge of GNL to the right
edge of GNR, translated by TRANS)
(APPLY* (OR (LISTGET PARAMS (QUOTE DRAWLINKFN))
(QUOTE 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)))
(OR (LISTGET PARAMS (QUOTE LINEWIDTH))
WIDTH 1)
OPERATION STREAM (LISTGET PARAMS (QUOTE COLOR))
(LISTGET PARAMS (QUOTE DASHING))
PARAMS])
(DISPLAYLINK/TB
[LAMBDA (TRANS GNT GNB WIDTH OPERATION STREAM PARAMS) (* dgb: "23-Jan-85 08:44")
(* draws a line from the top edge of GNT to the bottom
edge of GNR, translated by TRANS)
(APPLY* (OR (LISTGET PARAMS (QUOTE DRAWLINKFN))
(QUOTE 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)))
(OR (LISTGET PARAMS (QUOTE LINEWIDTH))
WIDTH 1)
OPERATION STREAM (LISTGET PARAMS (QUOTE COLOR))
(LISTGET PARAMS (QUOTE DASHING))
PARAMS])
(EDITTOGGLEBORDER
[LAMBDA (W) (* rmk: "14-Dec-84 13:50")
(* 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 GRAPH)
(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) (* dgb: "23-Jan-85 08:30")
(* displays a node links. IF TOSONLY IS NON-NIL, DRAWS
ONLY THE TO LINKS.)
(PROG ((NODELST (fetch (GRAPH GRAPHNODES) of G)))
(for TONODEID TONODE in (TOLINKS NODE) do (DISPLAYLINK NODE (SETQ TONODE (GETNODEFROMID
TONODEID NODELST))
TRANS STREAM G LINEWIDTH
(LINKPARAMETERS NODE TONODE)))
(OR TOSONLY (for FROMNDID FROMND in (FROMLINKS NODE) do (DISPLAYLINK (SETQ FROMND
(GETNODEFROMID
FROMNDID NODELST))
NODE TRANS STREAM G
LINEWIDTH
(LINKPARAMETERS FROMND
NODE])
(DRAW/GRAPHNODE/BORDER
[LAMBDA (BORDER LEFT BOTTOM WIDTH HEIGHT STREAM) (* rmk: "15-Feb-85 16:58")
(* interprets the node border. If the border is a shade, then bitblt twice in invert mode. This will look ugly if a
link runs underneath the node, but at least the label will be legible.)
(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) (* Extract the PROG after Intermezzo is released)
(AND (OR (NEQ MAKESYSNAME (QUOTE HARMONY))
(WINDOWP STREAM)
(IMAGESTREAMTYPEP STREAM (QUOTE DISPLAY)))
(PROG ((NBW (GRAPHNODE/BORDER/WIDTH BORDER)))
(BITBLT NIL NIL NIL STREAM LEFT BOTTOM WIDTH HEIGHT (QUOTE TEXTURE)
(QUOTE INVERT)
(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 INVERT)
(CADR BORDER]
(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) (* dgb: "24-Jan-85 08:06")
(* Allow Link parameters to be passed as a property
list of the node description.)
(OR (FASSOC ID NODELST)
(AND (LISTP ID)
(EQ (QUOTE Link% Parameters)
(CAR ID))
(FASSOC (CADR 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) (* rmk: " 2-Jan-85 08:37")
(* Assumes that the big-half of width is to the left of
the center, for even width)
(IPLUS (fetch XCOORD of (fetch NODEPOSITION of NODE))
(SUB1 (HALF (ADD1 (fetch NODEWIDTH of NODE])
(GN/TOP
[LAMBDA (NODE) (* rmk: " 2-Jan-85 08:38")
(* Assumes that big-half of height is under the center,
for even height. Result is -1 for height=0, which is
correct.)
(IPLUS (fetch YCOORD of (fetch NODEPOSITION of NODE))
(SUB1 (HALF (ADD1 (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) (* rmk: "16-Feb-85 10:15")
(* implements a graph editor on the right button
transition of a window.)
(COND
((NOT (INSIDE? (DSPCLIPPINGREGION NIL GRWINDOW)
(LASTMOUSEX GRWINDOW)
(LASTMOUSEY GRWINDOW)))
(DOWINDOWCOM GRWINDOW))
((SHIFTDOWNP (QUOTE CTRL))
(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: " 2-Mar-85 11:35")
(PROG [(STREAM (OR (AND FILE (OPENP FILE (QUOTE OUTPUT))
(GETSTREAM FILE))
(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])
(LINKPARAMETERS
[LAMBDA (FROMND TOND) (* dgb: "24-Jan-85 08:29")
(PROG (TOPARAMS)
(RETURN (AND (SETQ TOPARAMS (MEMBTONODES (fetch NODEID of TOND)
(TOLINKS FROMND)))
(LISTP TOPARAMS)
(EQ (QUOTE Link% Parameters)
(CAR TOPARAMS))
(CDDR TOPARAMS])
(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) (* rmk: "20-Dec-84 09:33")
(for NODE in NODES largest (GN/RIGHT NODE) finally (RETURN $$EXTREME])
(MAX/TOP
[LAMBDA (NODES) (* rmk: "20-Dec-84 09:34")
(for NODE in NODES largest (GN/TOP NODE) finally (RETURN $$EXTREME])
(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])
(MEMBTONODES
[LAMBDA (TOND TONODES) (* dgb: "24-Jan-85 08:05")
(for Z in TONODES do (COND
([OR (EQ TOND Z)
(AND (LISTP Z)
(EQ (CAR Z)
(QUOTE Link% Parameters))
(EQ TOND (CADR Z]
(RETURN Z])
(MIN/BOTTOM
[LAMBDA (NODES) (* rmk: "20-Dec-84 09:34")
(* returns the bottommost point of the graph.)
(for NODE in NODES smallest (GN/BOTTOM NODE) finally (RETURN $$EXTREME])
(MIN/LEFT
[LAMBDA (NODES) (* rmk: "20-Dec-84 09:34")
(* returns the leftmost point of the graph.)
(for NODE in NODES smallest (GN/LEFT NODE) finally (RETURN $$EXTREME])
(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) (* rmk: "14-Dec-84 09:21")
(* prints a node at its position translated by TRANS. Takes the operation from the stream so that when editor has
set the operation to invert, this may erase as well as draw; but when the operation is paint, then nodes obliterate
any link lines that they are drawn over.)
(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)))
(T (BITBLT (fetch NODELABEL of NODE)
0 0 STREAM LEFT BOTTOM WIDTH HEIGHT (QUOTE INPUT]
((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]
(T (* so small just use texture)
(BITBLT NIL NIL NIL STREAM LEFT BOTTOM 2 2 (QUOTE TEXTURE)
NIL 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])
(FIX/SCALE
[LAMBDA (PARAMVALUE SCALE) (* dgb: "28-Jan-85 10:01")
(* * fixes PARAMVALUE by SCALE If PARAMVALUE is a list, then fixes the elements of the list)
(COND
((LISTP PARAMVALUE)
(for V in PARAMVALUE collect (FIX/SCALE V SCALE)))
(T (* Note that some parameters may go to zero)
(FIXR (FTIMES SCALE PARAMVALUE])
(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 GRAPH TRANS) (* rmk: "31-Dec-84 11:42")
(* gives the node a new border, and displays it if there is a stream. Might not be a stream if being called just to
finagle a graph datastructure.)
(PROG [(ONBW (GRAPHNODE/BORDER/WIDTH (fetch NODEBORDER of NODE]
[OR TRANS (SETQ TRANS (CONSTANT (create POSITION
XCOORD ← 0
YCOORD ← 0]
(COND
(STREAM (ERASE/GRAPHNODE NODE STREAM TRANS)
[OR GRAPH (AND (WINDOWP STREAM)
(SETQ GRAPH (WINDOWPROP STREAM (QUOTE GRAPH]
(DISPLAYNODELINKS NODE TRANS STREAM GRAPH)))
(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 (DISPLAYNODE NODE TRANS STREAM GRAPH))
(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) (* dgb: "25-Jan-85 09:37")
(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)
TONODES ←(SCALE/TONODES N SCALE)
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])
(SCALE/TONODES
[LAMBDA (NODE SCALE) (* dgb: "25-Jan-85 09:36")
(for NODEID in (fetch TONODES of NODE) collect (COND
[(AND (LISTP NODEID)
(EQ (QUOTE Link% Parameters)
(CAR NODEID))
(for prop val in ScalableLinkParameters
do (AND (SETQ val (LISTGET NODEID prop))
(LISTPUT NODEID prop
(FIX/SCALE val SCALE]
(T NODEID])
(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])
(SHOWGRAPH
[LAMBDA (GRAPH WINDOW LEFTBUTTONFN MIDDLEBUTTONFN TOPJUSTIFYFLG ALLOWEDITFLG COPYBUTTONEVENTFN)
(* rmk: "15-Feb-85 14:47")
(* Harmony version, since expects shift-select to
unambiguously mean copy, not move.
Goes along with redefinition of SHIFTP)
(* 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))
(WINDOWPROP WINDOW (QUOTE HARDCOPYFN)
(FUNCTION HARDCOPYGRAPH))
(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 COPYBUTTONEVENTFN)
(OR COPYBUTTONEVENTFN (FUNCTION GRAPHERCOPYBUTTONEVENTFN)))
(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])
)
(* 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 "11-Dec-84 14:35")
(for N in NODEIDS
do (SETQ N (GETNODEFROMID N NODELST))
(add (fetch YCOORD of (fetch (GRAPHNODE NODEPOSITION) of N))
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) (* dgb: "22-Jan-85 07:17")
(* Adds in all the offsets. See comment on
BRHC/LAYOUT/DAUGHTERS.)
(DECLARE (USEDFREE NODELST))
(PROG ((GN (GETNODEFROMID N NODELST)))
[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) (* dgb: "22-Jan-85 07:25")
(* 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 (P (GN (GETNODEFROMID N NODELST)))
[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) (* rmk: "22-Feb-85 10:32")
(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
((EQMEMB (QUOTE 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)
(* dgb: "23-Jan-85 08:28")
(* assumes CAR of tree is node label, CDR is daughter
trees.)
(COND
[TREE (PROG (RESULT)
(DECLARE (SPECVARS RESULT))
(LAYOUTSEXPR1 TREE)
(RETURN (LAYOUTGRAPH RESULT (LIST TREE)
(APPEND (MKLIST FORMAT)
BOXING)
FONT MOTHERD PERSONALD FAMILYD]
(T (ERROR "Cannot layout NIL as S-EXPRESSION"])
(LAYOUTSEXPR1
[LAMBDA (TREE) (* dgb: "22-Jan-85 07:07")
(DECLARE (SPECVARS RESULT))
(COND
[(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])
)
(DECLARE: EVAL@COMPILE
(RPAQQ LINKPARAMS Link% Parameters)
(CONSTANTS (LINKPARAMS (QUOTE Link% Parameters)))
)
(RPAQQ DEFAULT.GRAPH.NODEBORDER NIL)
(RPAQQ DEFAULT.GRAPH.NODEFONT NIL)
(RPAQQ DEFAULT.GRAPH.NODELABELSHADE NIL)
(RPAQQ ScalableLinkParameters (DASHING LINEWIDTH))
(RPAQQ CACHE/NODE/LABEL/BITMAPS NIL)
(RPAQQ EDITGRAPHMENU NIL)
(RPAQQ GRAPHEDITWINDOW NIL)
(RPAQQ NODEBORDERWIDTH 1)
(RPAQ ORIGIN (CREATEPOSITION 0 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)))
)
)
(* Grapher image objects)
(DEFINEQ
(GRAPHERCOPYBUTTONEVENTFN
[LAMBDA (WINDOW) (* rmk: "22-Dec-84 11:33")
(* Called on down transition in WINDOW. If GRAPHOBJ.FINDGRAPH locates a graph in window, it is copy inserted.
Another callers of GRAPHOBJ.FINDGRAPH might also specify alignments to GRAPHEROBJ.)
(PROG ((GRAPH (GRAPHOBJ.FINDGRAPH WINDOW)))
(AND GRAPH (COPYINSERT (GRAPHEROBJ GRAPH])
(GRAPHOBJ.FINDGRAPH
[LAMBDA (WINDOW) (* rmk: "22-Dec-84 11:29")
(* Get control on down transition, track until key goes
up or mouse leaves the window)
(bind (DS ←(GETSTREAM WINDOW))
(REG ←(WINDOWPROP WINDOW (QUOTE REGION))) first (DSPFILL NIL BLACKSHADE (QUOTE INVERT)
DS)
do (GETMOUSESTATE)
(COND
((NOT (INSIDE? REG LASTMOUSEX LASTMOUSEY))
(DSPFILL NIL BLACKSHADE (QUOTE INVERT)
DS)
(RETURN))
((NOT (LASTMOUSESTATE (OR LEFT MIDDLE RIGHT)))
(DSPFILL NIL BLACKSHADE (QUOTE INVERT)
DS)
(RETURN (COPYGRAPH (WINDOWPROP WINDOW (QUOTE GRAPH])
)
(DEFINEQ
(ALIGNMENTNODE
[LAMBDA (NODESPEC GRAPH) (* rmk: " 2-Jan-85 10:22")
(* Returns the alignment node specified by NODESPEC)
(SELECTQ NODESPEC
(*TOP (for N in (fetch GRAPHNODES of GRAPH) largest (GN/TOP N)))
(*BOTTOM (for N in (fetch GRAPHNODES of GRAPH) smallest (GN/BOTTOM N)))
(*RIGHT (for N in (fetch GRAPHNODES of GRAPH) largest (GN/RIGHT N)))
(*LEFT (for N in (fetch GRAPHNODES of GRAPH) smallest (GN/LEFT N)))
(GETNODEFROMID NODESPEC (fetch GRAPHNODES of GRAPH])
(GRAPHOBJ.CHECKALIGN
[LAMBDA (GRAPH ALIGNSPEC) (* rmk: " 2-Jan-85 10:22")
(* Makes sure that the ALIGNMENTSPEC is valid, putting
it into standard form if necessary)
(OR (AND (NULL ALIGNSPEC)
(SETQ ALIGNSPEC 0))
(NUMBERP ALIGNSPEC)
[AND (LISTP ALIGNSPEC)
(SELECTQ (CAR ALIGNSPEC)
((*TOP *BOTTOM *LEFT *RIGHT)
T)
(GETNODEFROMID (CAR ALIGNSPEC)
(fetch GRAPHNODES of GRAPH)))
(LISTP (CDR ALIGNSPEC))
(OR (NUMBERP (CADR ALIGNSPEC))
(EQ (CADR ALIGNSPEC)
(QUOTE BASELINE))
(AND (NULL (CADR ALIGNSPEC))
(SETQ ALIGNSPEC (LIST (CAR ALIGNSPEC)
0]
(ERROR "ILLEGAL GRAPH ALIGNMENT SPECIFICATION" ALIGNSPEC))
ALIGNSPEC])
)
(DEFINEQ
(GRAPHEROBJ
[LAMBDA (GRAPH HALIGN VALIGN) (* rmk: "15-Feb-85 15:03")
(* Constructs a Grapher image object.)
(* HALIGN and VALIGN specify the horizontal or vertical alignment. Each can be a floating point number between 0 and
1, specifying that the alignment point is located at that portion of the width/height of the graphregion, or a list
of the form (nodespec align), where nodespec is a node ID or one of the atoms LEFT, RIGHT, BOTTOM, TOP, and align is
either a floating point number bewtween 0 and 1, or the atom BASELINE)
(IMAGEOBJCREATE (LIST GRAPH (GRAPHOBJ.CHECKALIGN GRAPH HALIGN)
(GRAPHOBJ.CHECKALIGN GRAPH VALIGN))
(COND
((IMAGEFNSP GRAPHERIMAGEFNS))
(T (SETQ GRAPHERIMAGEFNS (IMAGEFNSCREATE (FUNCTION GRAPHOBJ.DISPLAYFN)
(FUNCTION GRAPHOBJ.IMAGEBOXFN)
(FUNCTION GRAPHOBJ.PUTFN)
(FUNCTION GRAPHOBJ.GETFN)
(FUNCTION GRAPHOBJ.COPYFN)
(FUNCTION GRAPHOBJ.BUTTONEVENTINFN)
(FUNCTION NILL)
(FUNCTION NILL)
(FUNCTION NILL)
(FUNCTION NILL)
(FUNCTION NILL)
(FUNCTION NILL)
NIL
(QUOTE GRAPHER])
(GRAPHOBJ.BUTTONEVENTINFN
[LAMBDA (GROBJ WINDOW) (* rmk: " 8-Jan-85 15:27")
(* the user has pressed a button inside the grapher
object IMAGEOBJ.)
(COND
([MENU (create MENU
ITEMS ←(QUOTE ((Edit% graph T " Opens a window to edit this graph"]
(PROG [W (DATUM (IMAGEOBJPROP GROBJ (QUOTE OBJECTDATUM]
(SETQ W (SIZE/GRAPH/WINDOW (CAR DATUM)
NIL T))
(IMAGEOBJPROP GROBJ (QUOTE OBJECTDATUM)
(LIST (EDITGRAPH (COPYGRAPH (CAR DATUM))
W)
(CADR DATUM)
(CADDR DATUM)))
(CLOSEW W))
(QUOTE CHANGED])
(GRAPHOBJ.COPYFN
[LAMBDA (GROBJ) (* rmk: " 8-Jan-85 15:17")
(* makes a copy of a grapher image object.)
(SETQ GROBJ (IMAGEOBJPROP GROBJ (QUOTE OBJECTDATUM)))
(GRAPHEROBJ (COPYGRAPH (CAR GROBJ))
(CADR GROBJ)
(CADDR GROBJ])
(GRAPHOBJ.DISPLAYFN
[LAMBDA (GROBJ STREAM) (* rmk: "21-Dec-84 17:46")
(* display function for a grapher image object)
(* Scale the streams position back to display coordinates, since DISPLAYGRAPH translates the translation.
Might be simplest to define DISPLAYGRAPH without a translation, as locating the graph coordinate system at the
current X,Y position)
(PROG [REG (BOX (IMAGEOBJPROP GROBJ (QUOTE BOUNDBOX)))
(SCALE (DSPSCALE NIL STREAM))
(GRAPH (CAR (IMAGEOBJPROP GROBJ (QUOTE OBJECTDATUM]
(OR BOX (APPLY* (IMAGEOBJPROP GROBJ (QUOTE IMAGEBOXFN))
GROBJ STREAM))
[SETQ REG (GRAPHREGION (COND
((EQP SCALE 1)
GRAPH)
(T (SCALE/GRAPH GRAPH STREAM SCALE]
(* Kludgy: we have to scale the graph to get the real region, but then DISPLAYGRAPH will do it again, cause it
assumes screen points.)
(* Other kludge is that the translation is also in
screen points)
(DISPLAYGRAPH GRAPH STREAM NIL (CREATEPOSITION (QUOTIENT (DIFFERENCE (DIFFERENCE
(DSPXPOSITION NIL
STREAM)
(fetch XKERN
of BOX))
(fetch (REGION LEFT)
of REG))
SCALE)
(QUOTIENT (DIFFERENCE (DIFFERENCE
(DSPYPOSITION NIL
STREAM)
(fetch YDESC
of BOX))
(fetch (REGION BOTTOM)
of REG))
SCALE])
(GRAPHOBJ.GETALIGN
[LAMBDA (STREAM GRAPH) (* rmk: " 2-Jan-85 10:22")
(PROG ((ALIGN (READ STREAM FILERDTBL)))
[if [AND (LISTP ALIGN)
(NOT (MEMB (CAR ALIGN)
(QUOTE (*TOP *BOTTOM *LEFT *RIGHT]
then (SETQ ALIGN (CONS [fetch NODEID of (CAR (NTH (CAR ALIGN)
(fetch GRAPHNODES of GRAPH]
(CDR ALIGN]
(RETURN ALIGN])
(GRAPHOBJ.GETFN
[LAMBDA (STREAM) (* rmk: "31-Dec-84 12:22")
(* reads a grapher image object from a file.)
(OR (EQ (SKIPSEPRS STREAM FILERDTBL)
(QUOTE %())
(ERROR "ILLEGAL GRAPHOBJECT FORMAT"))
(READC STREAM) (* Read the paren)
(PROG ((GRAPH (READGRAPH STREAM)))
(RETURN (PROG1 (GRAPHEROBJ GRAPH (GRAPHOBJ.GETALIGN STREAM GRAPH)
(GRAPHOBJ.GETALIGN STREAM GRAPH))
(* Skip the closing paren)
(RATOM STREAM FILERDTBL])
(GRAPHOBJ.IMAGEBOXFN
[LAMBDA (GROBJ STREAM) (* rmk: "15-Feb-85 08:28")
(* size function for a tedit bitmap object.)
(PROG (REGION GRAPH HALIGN VALIGN ALNODE (DATUM (IMAGEOBJPROP GROBJ (QUOTE OBJECTDATUM)))
(SCALE (DSPSCALE NIL STREAM))
BMW BMH)
(SETQ GRAPH (CAR DATUM))
(SETQ HALIGN (CADR DATUM))
(SETQ VALIGN (CADDR DATUM))
(OR (EQ 1 SCALE)
(SETQ GRAPH (SCALE/GRAPH GRAPH STREAM SCALE)))
(SETQ REGION (GRAPHREGION GRAPH))
(RETURN (create IMAGEBOX
XSIZE ←(fetch WIDTH of REGION)
YSIZE ←(fetch HEIGHT of REGION)
YDESC ←[COND
((NUMBERP VALIGN)
(TIMES VALIGN (fetch HEIGHT of REGION)))
(T (* Must be a list, cause of checks in GRAPHEROBJ)
(SETQ ALNODE (ALIGNMENTNODE (CAR VALIGN)
GRAPH))
(PLUS (GN/BOTTOM ALNODE)
(COND
((EQ (CADR VALIGN)
(QUOTE BASELINE))
(IQUOTIENT (IPLUS (IDIFFERENCE (fetch NODEHEIGHT
of ALNODE)
(FONTPROP (fetch NODEFONT
of ALNODE)
(QUOTE ASCENT)))
(FONTPROP (fetch NODEFONT of ALNODE)
(QUOTE DESCENT)))
2))
(T (TIMES (CADR VALIGN)
(fetch NODEHEIGHT of ALNODE]
XKERN ←(COND
((NUMBERP HALIGN)
(TIMES HALIGN (fetch WIDTH of REGION)))
(T (* Must be a list, cause of checks in GRAPHEROBJ)
(SETQ ALNODE (ALIGNMENTNODE (CAR HALIGN)
GRAPH))
(PLUS (GN/LEFT ALNODE)
(TIMES (COND
((EQ (CADR HALIGN)
(QUOTE BASELINE))
0)
(T (CADR HALIGN)))
(fetch NODEWIDTH of ALNODE])
(GRAPHOBJ.PUTALIGN
[LAMBDA (STREAM GRAPH ALIGN) (* rmk: " 2-Jan-85 10:22")
(PRIN2 [COND
([OR (NLISTP ALIGN)
(MEMB (CAR ALIGN)
(QUOTE (*TOP *BOTTOM *LEFT *RIGHT]
ALIGN)
(T (* Convert node ID to node index)
(CONS (for I from 1 as N in (fetch GRAPHNODES of GRAPH)
when (EQ (CAR ALIGN)
(fetch NODEID of N))
do (RETURN I))
(CDR ALIGN]
STREAM FILERDTBL])
(GRAPHOBJ.PUTFN
[LAMBDA (GROBJ STREAM) (* rmk: "31-Dec-84 12:25")
(* Put a description of a grapher object into the
file.)
(PROG [ALIGN GRAPH (DATUM (IMAGEOBJPROP GROBJ (QUOTE OBJECTDATUM]
(PRIN1 "(" STREAM)
(SETQ GRAPH (CAR DATUM))
(DUMPGRAPH GRAPH STREAM)
(TERPRI STREAM)
(GRAPHOBJ.PUTALIGN STREAM GRAPH (CADR DATUM))
(SPACES 1 STREAM)
(GRAPHOBJ.PUTALIGN STREAM GRAPH (CADDR DATUM))
(printout STREAM ")" T])
)
(DEFINEQ
(COPYGRAPH
[LAMBDA (GRAPH) (* dgb: "28-Jan-85 11:10")
(create GRAPH using GRAPH GRAPHNODES ←(for N in (fetch GRAPHNODES of GRAPH)
collect (create GRAPHNODE
using N NODEPOSITION ←(create POSITION
using (fetch
NODEPOSITION
of N])
(DUMPGRAPH
[LAMBDA (GRAPH STREAM) (* rmk: "15-Feb-85 16:54")
(* Put a description of a graph into a file.)
(RESETLST (RESETSAVE (SETREADTABLE FILERDTBL))
(PROG (BORDERS FONTS IDS SHADES (#BORDERS 0)
(#FONTS 0)
(#SHADES 0)
(#IDS 0))
(printout STREAM "(" T "FIELDS (")
(if (fetch SIDESFLG of GRAPH)
then (printout STREAM "SIDESFLG " .P2 (fetch SIDESFLG of GRAPH)))
(if (fetch DIRECTEDFLG of GRAPH)
then (printout STREAM "DIRECTEDFLG " .P2 (fetch DIRECTEDFLG of GRAPH)))
(if (fetch GRAPH.MOVENODEFN of GRAPH)
then (printout STREAM "MOVENODEFN " .P2 (fetch GRAPH.MOVENODEFN of GRAPH)))
(if (fetch GRAPH.ADDNODEFN of GRAPH)
then (printout STREAM "ADDNODEFN " .P2 (fetch GRAPH.ADDNODEFN of GRAPH)))
(if (fetch GRAPH.DELETENODEFN of GRAPH)
then (printout STREAM "DELETENODEFN " .P2 (fetch GRAPH.DELETENODEFN
of GRAPH)))
(if (fetch GRAPH.ADDLINKFN of GRAPH)
then (printout STREAM "ADDLINKFN " .P2 (fetch GRAPH.ADDLINKFN of GRAPH)))
(if (fetch GRAPH.DELETELINKFN of GRAPH)
then (printout STREAM "DELETELINKFN " .P2 (fetch GRAPH.DELETELINKFN
of GRAPH)))
(if (fetch GRAPH.FONTCHANGEFN of GRAPH)
then (printout STREAM "FONTCHANGEFN " .P2 (fetch GRAPH.FONTCHANGEFN
of GRAPH)))
(if (fetch GRAPH.INVERTBORDERFN of GRAPH)
then (printout STREAM "INVERTBORDERFN " .P2 (fetch GRAPH.INVERTBORDERFN
of GRAPH)))
(if (fetch GRAPH.INVERTLABELFN of GRAPH)
then (printout STREAM "INVERTLABELFN " .P2 (fetch GRAPH.INVERTLABELFN
of GRAPH)))
(PRIN1 ")" STREAM)
[for N TEMP in (fetch (GRAPH GRAPHNODES) of GRAPH)
do [OR (ASSOC (fetch NODEID of N)
IDS)
(push IDS (CONS (fetch NODEID of N)
(add #IDS 1]
[AND (SETQ TEMP (fetch NODELABELSHADE of N))
(OR (ASSOC TEMP SHADES)
(push SHADES (CONS TEMP (add #SHADES 1]
[OR (ASSOC (fetch NODEFONT of N)
FONTS)
(push FONTS (CONS (fetch NODEFONT of N)
(add #FONTS 1]
(SELECTQ (SETQ TEMP (fetch NODEBORDER of N))
((T NIL))
(OR (ASSOC TEMP BORDERS)
(push BORDERS (CONS TEMP (add #BORDERS 1]
(printout STREAM T "IDS " #IDS ,)
(for X in (SETQ IDS (DREVERSE IDS))
do (PRIN2 (CAR X)
STREAM)
(SPACES 1 STREAM))
(printout STREAM T "FONTS " #FONTS ,)
(for X in (SETQ FONTS (DREVERSE FONTS))
do (SETQ X (CAR X))
(PRIN2 (if (LISTP X)
elseif (type? FONTDESCRIPTOR X)
then (FONTUNPARSE X)
elseif (FONTP X)
then (* Mark it as a class)
(CONS (QUOTE CLASS)
(FONTCLASSUNPARSE X)))
STREAM)
(SPACES 1 STREAM))
[COND
(BORDERS (printout STREAM T "BORDERS " #BORDERS ,)
(for X (POS ←(POSITION STREAM)) in (SETQ BORDERS (DREVERSE BORDERS))
do (TAB POS 0 STREAM)
(HPRINT (CAR X)
STREAM]
[COND
(SHADES (printout STREAM T "SHADES " #SHADES ,)
(for X (POS ←(POSITION STREAM)) in (SETQ SHADES (DREVERSE SHADES))
do (TAB POS 0 STREAM)
(HPRINT (CAR X)
STREAM]
(printout STREAM T "NODES (")
(for N POS in (fetch (GRAPH GRAPHNODES) of GRAPH)
do (printout STREAM 2 "(" .P2 (CDR (ASSOC (fetch NODEID of N)
IDS))
,)
(SETQ POS (POSITION STREAM))
(HPRINT (fetch NODELABEL of N)
STREAM)
(printout STREAM , .TAB POS .P2 (fetch NODEPOSITION of N)
, .P2 (CDR (ASSOC (fetch NODEFONT of N)
FONTS))
, .P2 (SELECTQ (fetch NODEBORDER of N)
((NIL T)
(fetch NODEBORDER of N))
(CDR (ASSOC (fetch NODEBORDER of N)
BORDERS)))
, .P2 (AND (fetch NODELABELSHADE of N)
(CDR (ASSOC (fetch NODELABELSHADE of N)
SHADES)))
,)
(if (fetch TONODES of N)
then (PRIN1 "(" STREAM)
(for X in (fetch TONODES of N)
do (printout STREAM .P2
[COND
[(EQ (CAR (LISTP X))
(QUOTE Link% Parameters))
(CONS (CAR X)
(CONS (CDR (ASSOC (CADR X)
IDS))
(CDDR X]
(T (CDR (ASSOC X IDS]
,))
(PRIN1 ") " STREAM)
else (PRIN1 "NIL " STREAM))
(if (fetch FROMNODES of N)
then (PRIN1 "(" STREAM)
(for X in (fetch FROMNODES of N)
do (printout STREAM .P2 (CDR (ASSOC X IDS))
,))
(PRIN1 ")" STREAM)
else (PRIN1 NIL STREAM))
(printout STREAM ")" T))
(PRIN1 "))" STREAM])
(READGRAPH
[LAMBDA (STREAM) (* rmk: "15-Feb-85 16:56")
(* reads a graph from a file.)
(OR (EQ (SKIPSEPRS STREAM FILERDTBL)
(QUOTE %())
(ERROR "ILLEGAL GRAPH FORMAT"))
(READC STREAM) (* Read the paren)
(bind NUM TEMP FONTS BORDERS SHADES IDS (GRAPH ←(create GRAPH))
do (SELECTQ (SETQ TEMP (RATOM STREAM FILERDTBL))
[FIELDS (for F on (READ STREAM FILERDTBL) by (CDDR F)
do (SELECTQ (CAR F)
(SIDESFLG (replace SIDESFLG of GRAPH with (CADR F)))
(DIRECTEDFLG (replace DIRECTEDFLG of GRAPH
with (CADR F)))
(MOVENODEFN (replace GRAPH.MOVENODEFN of GRAPH
with (CADR F)))
(ADDNODEFN (replace GRAPH.ADDNODEFN of GRAPH
with (CADR F)))
(DELETENODEFN (replace GRAPH.DELETENODEFN of GRAPH
with (CADR F)))
(ADDLINKFN (replace GRAPH.ADDLINKFN of GRAPH
with (CADR F)))
(DELETELINKFN (replace GRAPH.DELETELINKFN of GRAPH
with (CADR F)))
(FONTCHANGEFN (replace GRAPH.FONTCHANGEFN of GRAPH
with (CADR F)))
(INVERTBORDERFN (replace GRAPH.INVERTBORDERFN of GRAPH
with (CADR F)))
(INVERTLABELFN (replace GRAPH.INVERTLABELFN of GRAPH
with (CADR F)))
(ERROR "UNRECOGNIZED GRAPH FIELD" (CAR F]
[IDS (SETQ NUM (RATOM STREAM FILERDTBL))
(SETQ IDS (ARRAY NUM))
(for I to NUM do (SETA IDS I (READ STREAM FILERDTBL]
[BORDERS (SETQ NUM (RATOM STREAM FILERDTBL))
(SETQ BORDERS (ARRAY NUM))
(for I to NUM do (SETA BORDERS I (HREAD STREAM]
[FONTS (SETQ NUM (RATOM STREAM FILERDTBL))
(SETQ FONTS (ARRAY NUM))
(for I to NUM do (SETA FONTS I (COND
((EQ (SETQ TEMP (READ STREAM FILERDTBL))
(QUOTE C))
(* A font class)
(SETQ TEMP (READ STREAM FILERDTBL))
(FONTCLASS (CAR TEMP)
(CDR TEMP)))
((EQ (CAR (LISTP TEMP))
(QUOTE CLASS))
(FONTCLASS (CADR TEMP)
(CDDR TEMP)))
(T TEMP]
(NODES (RATOM STREAM) (* Skip paren)
[replace GRAPHNODES of GRAPH
with (while (EQ (SKIPSEPRS STREAM FILERDTBL)
(QUOTE %())
collect
(READC STREAM)
(PROG1 (create GRAPHNODE
NODEID ←(ELT IDS (RATOM STREAM FILERDTBL))
NODELABEL ←(HREAD STREAM)
NODEPOSITION ←(READ STREAM FILERDTBL)
NODEFONT ←(ELT FONTS (RATOM STREAM FILERDTBL))
NODEBORDER ←(SELECTQ (SETQ TEMP
(RATOM STREAM FILERDTBL))
((NIL T)
TEMP)
(ELT BORDERS TEMP))
NODELABELSHADE ←(AND (SETQ TEMP
(RATOM STREAM FILERDTBL))
(ELT SHADES TEMP))
TONODES ←[for X in (READ STREAM FILERDTBL)
collect
(COND
[(EQ (CAR (LISTP X))
(QUOTE Link% Parameters))
(CONS
(CAR X)
(CONS (ELT IDS (CADR X))
(CDDR X]
(T (ELT IDS X]
FROMNODES ←(for X in (READ STREAM FILERDTBL)
collect (ELT IDS X)))
(* Skip the closing paren)
(RATOM STREAM FILERDTBL]
(* Skip the closing paren)
(RATOM STREAM FILERDTBL))
[SHADES (SETQ NUM (RATOM STREAM FILERDTBL))
(SETQ SHADES (ARRAY NUM))
(for I to NUM do (SETA SHADES I (HREAD STREAM]
(%) (* The closing paren)
(RETURN GRAPH))
(ERROR "INVALID GRAPHER IMAGE OBJECT" STREAM])
)
(RPAQQ GRAPHERIMAGEFNS NIL)
(ADDTOVAR IMAGEOBJGETFNS (GRAPHOBJ.GETFN))
(PUTPROPS GRAPHER COPYRIGHT ("Xerox Corporation" 1983 1984 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (3877 4911 (GRAPHER.SHIFTDOWNP 3887 . 4909)) (4973 73326 (ADD/AND/DISPLAY/LINK 4983 .
5531) (APPLYTOSELECTEDNODE 5533 . 7898) (CALL.MOVENODEFN 7900 . 8254) (CHANGE.NODEFONT.SIZE 8256 .
9243) (CHOOSE.GRAPH.FONT 9245 . 9677) (CLOSEST/NODE 9679 . 10295) (DEFAULT.ADDNODEFN 10297 . 11034) (
DELETE/AND/DISPLAY/LINK 11036 . 12009) (DISPLAY/NAME 12011 . 12156) (DISPLAYGRAPH 12158 . 13662) (
DISPLAYLINK 13664 . 15698) (DISPLAYLINK/LR 15700 . 16661) (DISPLAYLINK/TB 16663 . 17624) (
EDITTOGGLEBORDER 17626 . 18739) (ERASE/GRAPHNODE 18741 . 19582) (DISPLAYNODE 19584 . 19990) (
DISPLAYNODELINKS 19992 . 20876) (DRAW/GRAPHNODE/BORDER 20878 . 22227) (DRAWAREABOX 22229 . 23658) (
EDITADDLINK 23660 . 24012) (EDITADDNODE 24014 . 24802) (EDITAPPLYTOLINK 24804 . 26004) (EDITCHANGEFONT
26006 . 26806) (EDITDELETELINK 26808 . 27168) (EDITDELETENODE 27170 . 28881) (EDITGRAPH 28883 . 29733
) (EDITGRAPH1 29735 . 31362) (EDITGRAPHMENU 31364 . 31972) (EDITMOVENODE 31974 . 33495) (
EDITTOGGLELABEL 33497 . 34605) (FLIPNODE 34607 . 35121) (FONTNAMELIST 35123 . 35376) (FROMLINKS 35378
. 35522) (GETNODEFROMID 35524 . 36013) (GN/BOTTOM 36015 . 36249) (GN/LEFT 36251 . 36482) (GN/RIGHT
36484 . 36897) (GN/TOP 36899 . 37363) (GRAPHADDLINK 37365 . 37866) (GRAPHADDNODE 37868 . 38480) (
GRAPHDELETELINK 38482 . 39098) (GRAPHDELETENODE 39100 . 39490) (GRAPHEDITCOMMANDFN 39492 . 41014) (
GRAPHEDITEVENTFN 41016 . 41677) (GRAPHER/CENTERPRINTINAREA 41679 . 42505) (GRAPHMOVENODE 42507 . 43003
) (GRAPHNODE/BORDER/WIDTH 43005 . 43514) (GRAPHREGION 43516 . 44359) (HARDCOPYGRAPH 44361 . 44841) (
INTERSECT/REGIONP/LBWH 44843 . 45375) (INVERTED/GRAPHNODE/BORDER 45377 . 45915) (
INVERTED/SHADE/FOR/GRAPHER 45917 . 46550) (LAYOUT/POSITION 46552 . 46705) (LINKPARAMETERS 46707 .
47105) (MANHATTANDIST 47107 . 47527) (MAX/RIGHT 47529 . 47734) (MAX/TOP 47736 . 47937) (
MEASUREGRAPHNODE 47939 . 48330) (MEMBTONODES 48332 . 48669) (MIN/BOTTOM 48671 . 48991) (MIN/LEFT 48993
. 49307) (MOVENODE 49309 . 50218) (NODECREATE 50220 . 50783) (NODELST/AS/MENU 50785 . 51586) (
NODEREGION 51588 . 51967) (PRINTDISPLAYNODE 51969 . 55301) (FILL/GRAPHNODE/LABEL 55303 . 56068) (
FIX/SCALE 56070 . 56551) (PROMPTINWINDOW 56553 . 58891) (READ/NODE 58893 . 59636) (REDISPLAYGRAPH
59638 . 60098) (RESET/NODE/BORDER 60100 . 61287) (RESET/NODE/LABELSHADE 61289 . 62008) (SCALE/GRAPH
62010 . 63050) (SCALE/GRAPHNODE/BORDER 63052 . 63656) (SCALE/TONODES 63658 . 64200) (SET/LABEL/SIZE
64202 . 66220) (SET/LAYOUT/POSITION 66222 . 66655) (SHOWGRAPH 66657 . 68689) (SIZE/GRAPH/WINDOW 68691
. 70378) (TOGGLE/DIRECTEDFLG 70380 . 70952) (TOGGLE/SIDESFLG 70954 . 71567) (TOLINKS 71569 . 71709) (
TRACKCURSOR 71711 . 72776) (TRACKNODE 72778 . 73324)) (73386 75627 (NEXTSIZEFONT 73396 . 74500) (
DECREASING.FONT.LIST 74502 . 74922) (SCALE.FONT 74924 . 75625)) (75845 108135 (BRH/LAYOUT 75855 .
77337) (BRH/LAYOUT/DAUGHTERS 77339 . 78124) (BRH/OFFSET 78126 . 78525) (BRHC/INTERTREE/SPACE 78527 .
79775) (BRHC/LAYOUT 79777 . 81364) (BRHC/LAYOUT/DAUGHTERS 81366 . 83871) (BRHC/LAYOUT/TERMINAL 83873
. 84518) (BRHC/OFFSET 84520 . 85256) (BRHL/LAYOUT 85258 . 87001) (BRHL/LAYOUT/DAUGHTERS 87003 . 88361
) (BRHL/MOVE/RIGHT 88363 . 89267) (BROWSE/LAYOUT/HORIZ 89269 . 89817) (BROWSE/LAYOUT/HORIZ/COMPACTLY
89819 . 91836) (BROWSE/LAYOUT/LATTICE 91838 . 92504) (BRV/OFFSET 92506 . 93340) (
EXTEND/TRANSITION/CHAIN 93342 . 94509) (FOREST/BREAK/CYCLES 94511 . 95273) (INIT/NODES/FOR/LAYOUT
95275 . 96240) (INTERPRET/MARK/FORMAT 96242 . 97533) (LATTICE/BREAK/CYCLES 97535 . 98163) (
LAYOUTFOREST 98165 . 98605) (LAYOUTGRAPH 98607 . 101570) (LAYOUTLATTICE 101572 . 102860) (LAYOUTSEXPR
102862 . 103530) (LAYOUTSEXPR1 103532 . 104122) (MARK/GRAPH/NODE 104124 . 104734) (
NEW/INSTANCE/OF/GRAPHNODE 104736 . 105813) (RAISE/TRANSITION/CHAIN 105815 . 106263) (
REFLECT/GRAPH/DIAGONALLY 106265 . 106799) (REFLECT/GRAPH/HORIZONTALLY 106801 . 107329) (
REFLECT/GRAPH/VERTICALLY 107331 . 107875) (SWITCH/NODE/HEIGHT/WIDTH 107877 . 108133)) (109488 110807 (
GRAPHERCOPYBUTTONEVENTFN 109498 . 109958) (GRAPHOBJ.FINDGRAPH 109960 . 110805)) (110808 112477 (
ALIGNMENTNODE 110818 . 111537) (GRAPHOBJ.CHECKALIGN 111539 . 112475)) (112478 121515 (GRAPHEROBJ
112488 . 113925) (GRAPHOBJ.BUTTONEVENTINFN 113927 . 114694) (GRAPHOBJ.COPYFN 114696 . 115079) (
GRAPHOBJ.DISPLAYFN 115081 . 116872) (GRAPHOBJ.GETALIGN 116874 . 117373) (GRAPHOBJ.GETFN 117375 .
118114) (GRAPHOBJ.IMAGEBOXFN 118116 . 120248) (GRAPHOBJ.PUTALIGN 120250 . 120834) (GRAPHOBJ.PUTFN
120836 . 121513)) (121516 132149 (COPYGRAPH 121526 . 121919) (DUMPGRAPH 121921 . 127673) (READGRAPH
127675 . 132147)))))
STOP