(FILECREATED "23-Sep-84 19:06:45" {ERIS}<LISPUSERS>LATTICER.;4 26010
changes to: (FNS EDITLATTICE)
previous date: "12-SEP-83 16:23:45" {ERIS}<LISPUSERS>LATTICER.;3)
(* Copyright (c) 1982, 1983, 1984 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT LATTICERCOMS)
(RPAQQ LATTICERCOMS ((FNS ADD/AND/DISPLAY/LLINK BOTTOM/LEFT/CORNER CHANGE/LAYOUT/POSITION
CREATE/NODE/IMAGE DELETE/AND/DISPLAY/LLINK DELETELLINK EDITLATTICE
EDITLATTICEMENU FOLLOW/CURSOR FROMLLINKS FROMPOS GRAPHADDLLINK MARKNODE
BOXNODE OUTLINENODE LATTICE/NODE/RIGHT LATTICE/NODE/TOP LATTICEADDLINK
LATTICEADDNODE LATTICEDELETELINK LATTICEAPPLYTOLINK LATTICEDELETENODE
LATTICE/MAX/TOP LATTICE/MAX/RIGHT LABEL/IMAGE MOVE/NODE NEAREST/NODE
NODE/NAME NODE/POSITION NODEIDTONODE READ/LNODE SHOW/NODE/LABEL SHOWBOX
SHOWLINK SHOWNODE SQUARE/DISTANCE TOLLINKS TOPOS LNODE/DISPLAY/NAME
LNODEBOXHEIGHT LNODEBOXWIDTH LNODECREATE)
(VARS (LATTICEEDITWINDOW)
(LATTICEEDITMENU)
NODEBOARDERWIDTH
(ORIGIN (CREATE POSITION XCOORD ← 0 YCOORD ← 0))
(BOXLABELSFLG T)
(LABEL/CREATING/DS))
(RECORDS LNODE)
(MACROS HALF)))
(DEFINEQ
(ADD/AND/DISPLAY/LLINK
[LAMBDA (FROMND TOND DS) (* rrb "18-FEB-82 10:16")
(* adds and displays a link.)
(COND
((MEMB (fetch (LNODE LNODEID) of TOND)
(TOLLINKS FROMND))
(PRIN1 " link already exists. " T)
(TERPRI T)
NIL)
(T (GRAPHADDLLINK FROMND TOND)
(SHOWLINK FROMND TOND DS)
T])
(BOTTOM/LEFT/CORNER
[LAMBDA (NODE SMASHPOS) (* rrb "18-FEB-82 10:15")
(PROG ((POS (NODE/POSITION NODE)))
(SETQ SMASHPOS (OR (LISTP SMASHPOS)
(create POSITION)))
[replace XCOORD of SMASHPOS with (IDIFFERENCE (fetch XCOORD of POS)
(HALF (fetch (LNODE LNODEWIDTH) of NODE]
[replace YCOORD of SMASHPOS with (IDIFFERENCE (fetch YCOORD of POS)
(HALF (fetch (LNODE LNODEHEIGHT)
of NODE]
(RETURN SMASHPOS])
(CHANGE/LAYOUT/POSITION
[LAMBDA (NODE POS) (* rrb "18-FEB-82 10:15")
(* sets a nodes position and recalculates the fields
that depend on it.)
(PROG ((X (fetch XCOORD of POS))
(Y (fetch YCOORD of POS)))
(replace XCOORD of (NODE/POSITION NODE) with X)
(replace YCOORD of (NODE/POSITION NODE) with Y)
[replace (LNODE NODETOPOS) of NODE with (create POSITION
XCOORD ← X
YCOORD ←(IPLUS Y
(HALF (fetch (LNODE
LNODEHEIGHT)
of NODE]
[replace (LNODE NODEFROMPOS) of NODE with (create POSITION
XCOORD ← X
YCOORD ←(IDIFFERENCE
Y
(HALF (fetch (LNODE LNODEHEIGHT)
of NODE]
(RETURN NODE])
(CREATE/NODE/IMAGE
[LAMBDA (NODE DS) (* rmk: "12-SEP-83 16:23")
(PROG (NODEBITMAP WIDTH HEIGHT FONT)
[SETQ FONT (COND
[(FONTP (SETQ FONT (fetch (LNODE LNODEFONT) of NODE]
(FONT (FONTCREATE FONT))
(T (DSPFONT NIL DS]
[SETQ NODEBITMAP (BITMAPCREATE (SETQ WIDTH (LNODEBOXWIDTH NODE FONT))
(SETQ HEIGHT (LNODEBOXHEIGHT NODE FONT]
(replace (LNODE LNODEWIDTH) of NODE with WIDTH)
(replace (LNODE LNODEHEIGHT) of NODE with HEIGHT)
(* recalculate the dependent fields.)
(CHANGE/LAYOUT/POSITION NODE (NODE/POSITION NODE))
(PROGN (COND
((DISPLAYSTREAMP LABEL/CREATING/DS))
(T (SETQ LABEL/CREATING/DS (DSPCREATE))
(DSPOPERATION (QUOTE PAINT)
LABEL/CREATING/DS)))
(DSPFONT FONT LABEL/CREATING/DS)
(DSPDESTINATION NODEBITMAP LABEL/CREATING/DS)
(AND (fetch (LNODE BOXNODEFLG) of NODE)
(SHOWBOX ORIGIN WIDTH HEIGHT (OR (NUMBERP (fetch (LNODE BOXNODEFLG)
of NODE))
NODEBOARDERWIDTH)
NIL LABEL/CREATING/DS))
(CENTERPRINTINAREA (NODE/NAME NODE)
(fetch XCOORD of ORIGIN)
(fetch YCOORD of ORIGIN)
WIDTH HEIGHT LABEL/CREATING/DS))
(replace (LNODE NODELABELBITMAP) of NODE with NODEBITMAP)
(RETURN NODE])
(DELETE/AND/DISPLAY/LLINK
[LAMBDA (FROMND TOND DS) (* rrb "18-FEB-82 10:16")
(* delete a link and updates the display.)
(COND
([NOT (OR (MEMB (fetch (LNODE LNODEID) of TOND)
(TOLLINKS FROMND))
(AND (MEMB (fetch (LNODE LNODEID) of FROMND)
(TOLLINKS TOND))
(NOT LATTICEFLG)
(PROG ((TMP FROMND)) (* editting graph, don't distinguish between links.)
(SETQ FROMND TOND)
(SETQ TOND FROMND)
(RETURN T]
(PRIN1 " link does not exist. " T)
(TERPRI T)
NIL)
(T (DELETELLINK FROMND TOND)
(SHOWLINK FROMND TOND DS)
T])
(DELETELLINK
[LAMBDA (FROM TO) (* rrb "18-FEB-82 10:16")
(replace (LNODE TOLNODES) of FROM with (REMOVE (fetch (LNODE LNODEID) of TO)
(fetch (LNODE TOLNODES) of FROM)))
(replace (LNODE FROMLNODES) of TO with (REMOVE (fetch (LNODE LNODEID) of FROM)
(fetch (LNODE FROMLNODES) of TO])
(EDITLATTICE
[LAMBDA (NODELST DS DONTDRAWFLG) (* edited: "23-Sep-84 19:05")
(* edits a lattice)
(PROG ((DS (OR DS (DSPCREATE)))
VAL OLDPOS WIDTH HEIGHT)
(DSPOPERATION (QUOTE INVERT)
DS) (* recalculate the node label images)
(for NS in NODELST do (CREATE/NODE/IMAGE NS DS))
(DSPCLIPPINGREGION (COND
(NODELST [SETQ VAL (GETBOXPOSITION (SETQ WIDTH (IMAX (LATTICE/MAX/RIGHT
NODELST)
150))
(SETQ HEIGHT (IMAX (LATTICE/MAX/TOP
NODELST)
150]
(create REGION
LEFT ←(fetch XCOORD of VAL)
BOTTOM ←(fetch YCOORD of VAL)
WIDTH ← WIDTH
HEIGHT ← HEIGHT))
(T (GETREGION)))
DS)
(CREATEW DS)
(CLEARW DS)
(for NS in NODELST do (SHOWNODE NS NODELST DS T))
(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 (UNTILMOUSESTATE (OR RED YELLOW))
(COND
((LASTMOUSESTATE YELLOW)
(COND
[(SELECTQ (SETQ VAL (MENU (EDITLATTICEMENU)))
(STOP (CLRPROMPT) (* aborting is done via ERROR! out of MENU.)
(CLOSEW DS)
(RETURN NODELST))
(ERSETQ (SELECTQ VAL
(ADDNODE (SETQ NODELST (LATTICEADDNODE NODELST DS)))
(DELETENODE (SETQ NODELST (LATTICEDELETENODE NODELST DS)))
(ADDLINK (LATTICEADDLINK NODELST DS))
(DELETELINK (LATTICEDELETELINK NODELST DS))
NIL]
((NULL VAL) (* aborted)
(printout PROMPTWINDOW T T "command aborted." T)))
(UNTILMOUSESTATE UP 60000)
(CLRPROMPT)
(GO LP))
(NODELST (* track the nearest node.)
(FOLLOW/CURSOR (NEAREST/NODE NODELST (SETQ OLDPOS (CURSORPOSITION NIL DS OLDPOS))
)
DS))
(T (printout PROMPTWINDOW T "There are no nodes to move yet." T
"Press the right button and select the 'Add a node' command.")
(UNTILMOUSESTATE UP)
(CLRPROMPT)))
(GO LP])
(EDITLATTICEMENU
[LAMBDA NIL (* rrb "10-FEB-82 11:07")
(COND
((NOT (type? MENU EDITLATTICEMENU))
(SETQ EDITLATTICEMENU (create MENU
ITEMS ←(QUOTE (("Add Node" (QUOTE ADDNODE)
"Asks for the name of a new node and adds it.")
("Delete Node" (QUOTE DELETENODE)
"Asks you to select a node and then deletes it and all links to it.")
("Add Link" (QUOTE ADDLINK)
"Asks for two nodes and adds a link from the first TO the second.")
("Delete Link" (QUOTE DELETELINK)
"Asks for two nodes and deletes the link from the first TO the second.")
(STOP (QUOTE STOP)
"Exits the editting.")))
CENTERFLG ← T
CHANGEOFFSETFLG ← T)))
(T EDITLATTICEMENU])
(FOLLOW/CURSOR
[LAMBDA (ND DS) (* bas: " 5-JUN-82 18:13")
(* Sets the cursor to the position of the node ND and then moves ND as the cursor moves until the left button is
released.)
(PROG (OLDPOS)
(SETQ OLDPOS (CURSORPOSITION (NODE/POSITION ND)
DS))
(MARKNODE ND DS)
(until (MOUSESTATE (NOT LEFT)) do (MOVE/NODE ND (NODE/POSITION ND)
(CURSORPOSITION NIL DS OLDPOS)
DS))
(MARKNODE ND DS])
(FROMLLINKS
[LAMBDA (NODE) (* rrb "18-FEB-82 10:15")
(fetch (LNODE FROMLNODES) of NODE])
(FROMPOS
[LAMBDA (NODE) (* rrb "18-FEB-82 10:15")
(* returns the starting place of lines from a node.)
(fetch (LNODE NODEFROMPOS) of NODE])
(GRAPHADDLLINK
[LAMBDA (FROM TO) (* rrb "18-FEB-82 10:16")
(* links two nodes)
(push (fetch FROMLNODES of TO)
(fetch (LNODE LNODEID) of FROM))
(push (fetch TOLNODES of FROM)
(fetch (LNODE LNODEID) of TO])
(MARKNODE
[LAMBDA (DSPND DS) (* bas: " 5-JUN-82 18:22")
(* flips the region around a node.)
(PROG ((POS (BOTTOM/LEFT/CORNER DSPND))
(IMAGEBM (LABEL/IMAGE DSPND)))
(BITBLT NIL NIL NIL DS (fetch XCOORD of POS)
(fetch YCOORD of POS)
(fetch BITMAPWIDTH of IMAGEBM)
(fetch BITMAPHEIGHT of IMAGEBM)
(QUOTE TEXTURE)
(QUOTE INVERT)
BLACKSHADE)
(RETURN])
(BOXNODE
[LAMBDA (X Y WIDTH HEIGHT DISPLAYSTREAM) (* bas: " 5-JUN-82 18:23")
(* puts a box on the display stream DISPLAYSTREAM at the
indicated position.)
(BITBLT NIL NIL NIL DISPLAYSTREAM (IDIFFERENCE X 2)
(IDIFFERENCE Y 2)
(IPLUS WIDTH 4)
(IPLUS HEIGHT 4)
(QUOTE TEXTURE)
(QUOTE INVERT)
BLACKSHADE)
(BITBLT NIL NIL NIL DISPLAYSTREAM X Y WIDTH HEIGHT (QUOTE TEXTURE)
(QUOTE INVERT)
BLACKSHADE])
(OUTLINENODE
[LAMBDA (LATTICENODE DS) (* bas: " 5-JUN-82 17:54")
(* outlines the region of a node)
(PROG ((POS (BOTTOM/LEFT/CORNER LATTICENODE))
(IMAGEBM (LABEL/IMAGE LATTICENODE)))
(BITBLT NIL NIL NIL DS (IDIFFERENCE (fetch XCOORD of POS)
2)
(IDIFFERENCE (fetch YCOORD of POS)
2)
(IPLUS (fetch BITMAPWIDTH of IMAGEBM)
4)
(IPLUS (fetch BITMAPHEIGHT of IMAGEBM)
4)
(QUOTE TEXTURE)
(QUOTE INVERT)
BLACKSHADE)
(BITBLT NIL NIL NIL DS (fetch XCOORD of POS)
(fetch YCOORD of POS)
(fetch BITMAPWIDTH of IMAGEBM)
(fetch BITMAPHEIGHT of IMAGEBM)
(QUOTE TEXTURE)
(QUOTE INVERT)
BLACKSHADE)
(RETURN])
(LATTICE/NODE/RIGHT
[LAMBDA (NODE) (* rrb "18-FEB-82 10:16")
(* determines the rightmost point of a lattice node.)
(IPLUS (fetch XCOORD of (fetch (LNODE LNODEPOSITION) of NODE))
(HALF (fetch (LNODE LNODEWIDTH) of NODE])
(LATTICE/NODE/TOP
[LAMBDA (NODE) (* rrb "18-FEB-82 10:16")
(* determines the rightmost point of a lattice node.)
(IPLUS (fetch YCOORD of (fetch (LNODE LNODEPOSITION) of NODE))
(HALF (fetch (LNODE LNODEHEIGHT) of NODE])
(LATTICEADDLINK
[LAMBDA (NODELST W) (* rrb " 5-FEB-82 12:05")
(* reads and adds a link to the graph)
(LATTICEAPPLYTOLINK (FUNCTION ADD/AND/DISPLAY/LLINK)
(QUOTE added)
NODELST W])
(LATTICEADDNODE
[LAMBDA (NODELST DS) (* rrb "18-FEB-82 09:41")
(* adds a node by giving it a location, reading a label
and putting it on NODELST)
(RESETFORM (TTYDISPLAYSTREAM PROMPTWINDOW)
(PROG (NODELABEL NODENAME)
(CLRPROMPT)
LP (PROMPTPRINT "Node label? ")
(SETQ NODELABEL (READ T))
(TERPRI T)
(SETQ NODENAME (PACK* NODELABEL (GENSYM)))
(COND
((FASSOC NODENAME NODELST)
(printout PROMPTWINDOW "Node " NODELABEL " already exists." T)
(GO LP)))
[SETQ NODELST (NCONC1 NODELST (SETQ NODE (LNODECREATE NODENAME NODELABEL
(CURSORPOSITION NIL DS)
NIL NIL NIL NIL]
(CREATE/NODE/IMAGE NODE DS)
(SHOW/NODE/LABEL NODE DS)
(printout PROMPTWINDOW "Node " (LNODE/DISPLAY/NAME NODE)
" added." T)
(RETURN NODELST])
(LATTICEDELETELINK
[LAMBDA (NODELST W) (* rrb " 5-FEB-82 12:04")
(* reads and adds a link to the graph)
(LATTICEAPPLYTOLINK (FUNCTION DELETE/AND/DISPLAY/LLINK)
(QUOTE deleted)
NODELST W])
(LATTICEAPPLYTOLINK
[LAMBDA (FN MSG NODELST DS) (* bas: " 5-JUN-82 18:12")
(RESETFORM (TTYDISPLAYSTREAM PROMPTWINDOW)
(PROG (FROM TO)
(printout T "Specify the link by selecting the FROM node, then the TO node." T)
(PRIN1 "FROM?" T)
(SETQ FROM (READ/LNODE NODELST DS))
(CLRPROMPT)
(MARKNODE FROM DS)
(PRIN1 "TO?" T)
[SETQ TO (COND
[(CAR (ERSETQ (READ/LNODE NODELST DS]
(T (MARKNODE FROM DS)
(ERROR!]
(CLRPROMPT)
(MARKNODE FROM DS)
(COND
((APPLY* FN FROM TO DS) (* return non-nil if changed anything.)
(printout T "Link from " (LNODE/DISPLAY/NAME FROM)
" to "
(LNODE/DISPLAY/NAME TO)
, MSG T])
(LATTICEDELETENODE
[LAMBDA (NODELST DS) (* bas: " 5-JUN-82 18:13")
(* deletes a node from NODELST.
Returns NODELST)
(RESETFORM (TTYDISPLAYSTREAM PROMPTWINDOW)
(CLRPROMPT)
(PROG (NODE NODELABEL)
(PROMPTPRINT " Select node to be deleted. ")
(SETQ NODE (READ/LNODE NODELST DS))
(TERPRI T)
(MARKNODE NODE DS)
(COND
((EQ [ASKUSER NIL NIL (LIST "delete node " (SETQ NODELABEL
(fetch (LNODE NODELABEL) of NODE]
(QUOTE Y))
(MARKNODE NODE DS)
(SHOWNODE NODE NODELST DS)
(for TOND in (APPEND (TOLLINKS NODE)) do (DELETELLINK NODE (NODEIDTONODE
TOND NODELST)))
(for FROMND in (APPEND (FROMLLINKS NODE)) do (DELETELLINK (NODEIDTONODE
FROMND NODELST)
NODE))
(SETQ NODELST (DREMOVE NODE NODELST))
(printout T "Node " NODELABEL " deleted." T)
(RETURN NODELST))
(T (MARKNODE NODE DS)
(printout T "nothing deleted." T)
(RETURN NODELST])
(LATTICE/MAX/TOP
[LAMBDA (NODES) (* rrb " 7-JAN-82 17:34")
(bind NR TOP←-1000 for NODE in NODES do (COND
((IGREATERP (SETQ NR (LATTICE/NODE/TOP NODE))
TOP)
(SETQ TOP NR)))
finally (RETURN (IPLUS TOP 12])
(LATTICE/MAX/RIGHT
[LAMBDA (NODES) (* rrb " 7-JAN-82 17:33")
(bind NR RIGHT←-1000 for NODE in NODES do (COND
((IGREATERP (SETQ NR (LATTICE/NODE/RIGHT NODE))
RIGHT)
(SETQ RIGHT NR)))
finally (RETURN RIGHT])
(LABEL/IMAGE
[LAMBDA (NODE) (* rrb "18-FEB-82 10:15")
(* retrieves, creating if necessary, the bitmap image of
a node.)
(OR (fetch (LNODE NODELABELBITMAP) of NODE)
(HELP NODE "DOESN'T HAVE A LABEL BITMAP."])
(MOVE/NODE
[LAMBDA (DSND OLDPOS POS DS) (* bas: " 5-JUN-82 18:13")
(* 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.)
(MARKNODE DSND DS) (* erase current position)
(SHOWNODE DSND NODELST DS) (* put it in new one.)
(CHANGE/LAYOUT/POSITION DSND POS)
(SHOWNODE DSND NODELST DS)
(MARKNODE DSND DS])
(NEAREST/NODE
[LAMBDA (NODELST POS) (* rrb "27-AUG-81 09:31")
(* finds the node that is closest to POS)
(PROG (CLOSEST (MINDIST 65000)
DIST)
LP (COND
((NULL NODELST)
(RETURN CLOSEST))
((IGREATERP MINDIST (SETQ DIST (SQUARE/DISTANCE (NODE/POSITION (CAR NODELST))
POS)))
(SETQ CLOSEST (CAR NODELST))
(SETQ MINDIST DIST)))
(SETQ NODELST (CDR NODELST))
(GO LP])
(NODE/NAME
[LAMBDA (ND) (* rrb "18-FEB-82 10:14")
(fetch (LNODE NODELABEL) of ND])
(NODE/POSITION
[LAMBDA (NODE) (* rrb "18-FEB-82 10:16")
(fetch (LNODE LNODEPOSITION) of NODE])
(NODEIDTONODE
[LAMBDA (ID NODELST) (* rrb "18-FEB-82 10:19")
(for LNODE in NODELST when (EQ (fetch (LNODE LNODEID) of LNODE)
ID)
do (RETURN LNODE) finally (HELP ID "NOT A LEGAL NODE ID."])
(READ/LNODE
[LAMBDA (NODES DS) (* bas: " 5-JUN-82 18:13")
(UNTILMOUSESTATE (OR LEFT MIDDLE))
(COND
((LASTMOUSESTATE MIDDLE)
(ERROR!)))
(PROG (NEAR NOW OLDPOS)
[SETQ NEAR (NEAREST/NODE NODES (SETQ OLDPOS (CURSORPOSITION NIL DS]
FLIP (* turn off old flip (if one) and turn on new flip.)
(AND NOW (MARKNODE NOW DS))
(MARKNODE (SETQ NOW NEAR)
DS)
LP (COND
((MOUSESTATE UP)
(MARKNODE NOW DS)
(RETURN NOW))
((MOUSESTATE MIDDLE)
(MARKNODE NOW DS)
(ERROR!))
([EQ NOW (SETQ NEAR (NEAREST/NODE NODES (CURSORPOSITION NIL DS OLDPOS]
(GO LP))
(T (GO FLIP])
(SHOW/NODE/LABEL
[LAMBDA (DSPND DS) (* rrb " 7-JAN-82 16:44")
(* prints a display node at a position Uses cached
bitmap.)
(PROG ((POS (BOTTOM/LEFT/CORNER DSPND)))
(RETURN (BITBLT (LABEL/IMAGE DSPND)
0 0 DS (fetch XCOORD of POS)
(fetch YCOORD of POS)
NIL NIL NIL (DSPOPERATION NIL DS])
(SHOWBOX
[LAMBDA (POS WIDTH HEIGHT LINEWIDTH OPERATION DS) (* rrb "10-FEB-82 11:38")
(* draws a box to a display stream)
(PROG ((LEFT (fetch XCOORD of POS))
(BOTTOM (fetch YCOORD of POS))
LEFTPLUSWIDTH RIGHTLINELEFT VERTLINETOP TOPY (LINEWIDTH (OR (NUMBERP LINEWIDTH)
1)))
(* draw left side)
(DRAWLINE LEFT BOTTOM LEFT (SETQ VERTLINETOP (SUB1 (IPLUS BOTTOM HEIGHT LINEWIDTH)))
LINEWIDTH OPERATION DS) (* draw right side)
(DRAWLINE (SETQ RIGHTLINELEFT (IDIFFERENCE (IPLUS LEFT WIDTH)
LINEWIDTH))
BOTTOM RIGHTLINELEFT VERTLINETOP LINEWIDTH OPERATION DS)
(* draw bottom)
(DRAWLINE (SETQ LEFTPLUSWIDTH (IPLUS LEFT LINEWIDTH))
BOTTOM RIGHTLINELEFT BOTTOM LINEWIDTH OPERATION DS)
(* draw top)
(DRAWLINE LEFTPLUSWIDTH (SETQ TOPY (IDIFFERENCE VERTLINETOP LINEWIDTH))
RIGHTLINELEFT TOPY LINEWIDTH OPERATION DS])
(SHOWLINK
[LAMBDA (FRND TOND DS) (* rrb "18-JUN-81 13:56")
(* draws in a link from FRND TO TOND)
(DRAWBETWEEN (FROMPOS FRND)
(TOPOS TOND)
1 NIL DS])
(SHOWNODE
[LAMBDA (ND NODELST DS TOSONLY) (* rrb "28-JAN-82 19:04")
(* displays a node and its links.
IF TOSONLY IS NON-NIL, DRAWS ONLY THE TO LINKS.)
(SHOW/NODE/LABEL ND DS)
(for TONODEID in (TOLLINKS ND) do (SHOWLINK ND (NODEIDTONODE TONODEID NODELST)
DS))
(OR TOSONLY (for FROMNDID in (FROMLLINKS ND) do (SHOWLINK (NODEIDTONODE FROMNDID NODELST)
ND DS])
(SQUARE/DISTANCE
[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])
(TOLLINKS
[LAMBDA (NODE) (* rrb "18-FEB-82 10:15")
(fetch (LNODE TOLNODES) of NODE])
(TOPOS
[LAMBDA (NODE) (* rrb "18-FEB-82 10:15")
(* returns the starting place of lines from a node.)
(fetch (LNODE NODETOPOS) of NODE])
(LNODE/DISPLAY/NAME
[LAMBDA (ND) (* rrb "18-FEB-82 10:14")
(fetch (LNODE NODELABEL) of ND])
(LNODEBOXHEIGHT
[LAMBDA (NODE FONT) (* rrb "10-FEB-82 11:22")
(* leave room for the box outline)
(* determines the height of the label box.
For now assume one line)
(IPLUS (FONTPROP FONT (QUOTE HEIGHT))
2])
(LNODEBOXWIDTH
[LAMBDA (NODE FONT) (* rrb "28-JAN-82 17:42")
(IPLUS (STRINGWIDTH (LNODE/DISPLAY/NAME NODE)
FONT)
(ITIMES NODEBOARDERWIDTH 2)
2])
(LNODECREATE
[LAMBDA (ID LABEL POS TONODEIDS FROMNODEIDS FONT BOXED?) (* rrb "18-FEB-82 09:39")
(create LNODE
LNODEID ← ID
LNODEPOSITION ← POS
NODELABEL ← LABEL
LNODEFONT ← FONT
BOXNODEFLG ← BOXED?
TOLNODES ← TONODEIDS
FROMLNODES ← FROMNODEIDS])
)
(RPAQQ LATTICEEDITWINDOW NIL)
(RPAQQ LATTICEEDITMENU NIL)
(RPAQQ NODEBOARDERWIDTH 1)
(RPAQ ORIGIN (CREATE POSITION XCOORD ← 0 YCOORD ← 0))
(RPAQQ BOXLABELSFLG T)
(RPAQQ LABEL/CREATING/DS NIL)
[DECLARE: EVAL@COMPILE
(DATATYPE LNODE (LNODEID LNODEPOSITION NODELABELBITMAP NODEFROMPOS NODETOPOS LNODEWIDTH LNODEHEIGHT
TOLNODES FROMLNODES LNODEFONT NODELABEL BOXNODEFLG)
(SYSTEM))
]
(/DECLAREDATATYPE (QUOTE LNODE)
(QUOTE (POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER POINTER
POINTER POINTER POINTER)))
(DECLARE: EVAL@COMPILE
(PUTPROPS HALF MACRO ((X)
(LRSH X 1)))
)
(PUTPROPS LATTICER COPYRIGHT ("Xerox Corporation" 1982 1983 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1191 25267 (ADD/AND/DISPLAY/LLINK 1201 . 1638) (BOTTOM/LEFT/CORNER 1640 . 2222) (
CHANGE/LAYOUT/POSITION 2224 . 3204) (CREATE/NODE/IMAGE 3206 . 4719) (DELETE/AND/DISPLAY/LLINK 4721 .
5481) (DELETELLINK 5483 . 5905) (EDITLATTICE 5907 . 8495) (EDITLATTICEMENU 8497 . 9381) (FOLLOW/CURSOR
9383 . 9957) (FROMLLINKS 9959 . 10113) (FROMPOS 10115 . 10385) (GRAPHADDLLINK 10387 . 10769) (
MARKNODE 10771 . 11323) (BOXNODE 11325 . 11877) (OUTLINENODE 11879 . 12764) (LATTICE/NODE/RIGHT 12766
. 13136) (LATTICE/NODE/TOP 13138 . 13507) (LATTICEADDLINK 13509 . 13816) (LATTICEADDNODE 13818 .
14810) (LATTICEDELETELINK 14812 . 15127) (LATTICEAPPLYTOLINK 15129 . 15954) (LATTICEDELETENODE 15956
. 17156) (LATTICE/MAX/TOP 17158 . 17475) (LATTICE/MAX/RIGHT 17477 . 17795) (LABEL/IMAGE 17797 . 18152
) (MOVE/NODE 18154 . 18871) (NEAREST/NODE 18873 . 19428) (NODE/NAME 19430 . 19580) (NODE/POSITION
19582 . 19742) (NODEIDTONODE 19744 . 20026) (READ/LNODE 20028 . 20822) (SHOW/NODE/LABEL 20824 . 21293)
(SHOWBOX 21295 . 22515) (SHOWLINK 22517 . 22794) (SHOWNODE 22796 . 23353) (SQUARE/DISTANCE 23355 .
23757) (TOLLINKS 23759 . 23909) (TOPOS 23911 . 24177) (LNODE/DISPLAY/NAME 24179 . 24338) (
LNODEBOXHEIGHT 24340 . 24749) (LNODEBOXWIDTH 24751 . 24963) (LNODECREATE 24965 . 25265)))))
STOP