(FILECREATED "14-Jul-87 21:06:40" {QV}<NOTECARDS>1.3KNEXT>GRAPHERPATCH.;2 14683
changes to: (VARS GRAPHERPATCHCOMS)
previous date: "10-Jul-87 20:22:38" {QV}<NOTECARDS>1.3KNEXT>GRAPHERPATCH.;1)
(* Copyright (c) 1987 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT GRAPHERPATCHCOMS)
(RPAQQ GRAPHERPATCHCOMS [(* * RG 1/28/87 From Dave Newman's DVNPATCH003 for NoteCards. Adds
MoveRegion and MoveSubtree facilities.)
[DECLARE: DONTEVAL@LOAD (P (if (NOT (OR (MEMBER (QUOTE GRAPHER)
SYSFILES)
(MEMBER (QUOTE GRAPHER)
FILELST)))
then
(ERROR
"GRAPHER is not loaded. It must be loaded before GRAPHERPATCH."]
(FNS EDITMOVEREGION EDITMOVESUBTREE NOT.TRACKCURSOR
RECURSIVE.COLLECTDESCENDENTS MOVEDESCENDENTS COLLECT.CHILD.NODES
CREATE.NEW.NODEPOSITION GETBOXPOSITION.FROMINITIALREGION
INIT/NODES/FOR/LAYOUT NODECREATE)
(DECLARE: DONTEVAL@LOAD (P (DREMOVE (SASSOC "Move Node"
EDITGRAPHMENUCOMMANDS)
EDITGRAPHMENUCOMMANDS)
[ADDTOVAR EDITGRAPHMENUCOMMANDS
(Move% Node
(QUOTE MOVENODE)
"Moves a single node in the graph."
(SUBITEMS (Move% Single% Node
(QUOTE MOVENODE)
"Moves a single node in the graph.")
(Move% Node% and% Subtree
(EDITMOVESUBTREE
GRAPHWINDOW)
"Moves a subtree of nodes relative to the movement of their root.")
(Move% Region
(EDITMOVEREGION
GRAPHWINDOW)
"Moves a group of nodes within a specified region to another region."]
(SETQ EDITGRAPHMENU NIL])
(* * RG 1/28/87 From Dave Newman's DVNPATCH003 for NoteCards. Adds MoveRegion and MoveSubtree
facilities.)
(DECLARE: DONTEVAL@LOAD
(if (NOT (OR (MEMBER (QUOTE GRAPHER)
SYSFILES)
(MEMBER (QUOTE GRAPHER)
FILELST)))
then
(ERROR "GRAPHER is not loaded. It must be loaded before GRAPHERPATCH."))
)
(DEFINEQ
(EDITMOVEREGION
[LAMBDA (Window) (* Newman "27-Jan-87 11:08")
(* * This function moves all the nodes within a selected region to another region of similar shape and size.)
(if (NOT (WINDOWP Window))
then (ERROR Window " not a window.")
else (PROMPTPRINT " Select the region containing the nodes you wish to move.")
(PROG* ((DisplayStream (WINDOWPROP Window (QUOTE DSP)))
(Region (GETWREGION Window))
(Graph (WINDOWPROP Window (QUOTE GRAPH)))
(NodeList (for Node in (fetch (GRAPH GRAPHNODES) of Graph)
when (OR (INTERSECTREGIONS Region (NODEREGION Node))
(SUBREGIONP Region (NODEREGION Node)))
collect Node)))
(if (NULL Graph)
then (ERROR Window " not a graph window.")
elseif (NULL NodeList)
then (PROMPTPRINT "No nodes in the region selected."))
(for Node in NodeList do (FLIPNODE Node DisplayStream))
(bind OldPos (NewRegionPosition ← (GETBOXPOSITION.FROMINITIALREGION Window
Region
DisplayStream))
for SelectedNode in NodeList eachtime (SETQ OldPos
(fetch (GRAPHNODE NODEPOSITION)
of SelectedNode))
do (MOVENODE SelectedNode OldPos (CREATE.NEW.NODEPOSITION
SelectedNode
(DIFFERENCE (fetch (POSITION XCOORD) of
NewRegionPosition)
(fetch (REGION LEFT) of Region))
(DIFFERENCE (fetch (POSITION YCOORD) of
NewRegionPosition)
(fetch (REGION BOTTOM) of Region)))
Graph DisplayStream)
(EXTENDEXTENT (WFROMDS DisplayStream)
(NODEREGION SelectedNode))
(* extent the graph extent because the node may be
outside the old extent.)
(FLIPNODE SelectedNode DisplayStream])
(EDITMOVESUBTREE
[LAMBDA (WINDOW) (* Newman "27-Jan-87 11:10")
(* * Code derived from EDITMOVENODE by Richard Burton. Changes to prompt strings, and changes the to TRACKCURSOR to
a call to NOT.TRACKCURSOR)
(* 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 " "that is the common root of "
"the subtree 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.")
(NOT.TRACKCURSOR NOW DS GRAPH)
(printout PROMPTWINDOW T "Done."])
(NOT.TRACKCURSOR
[LAMBDA (Node DisplayStream Graph) (* rht: "28-Apr-87 18:06")
(* * Gets an old, and a new region from the user, and uses these to calculate all the new positions for all the
children of Node.)
(* * rht 4/28/87: Changed from APPLY of UNIONREGIONS to for loop doing successive UNIONREGIONS calls.)
(if (NULL Node)
then (PROMPTPRINT "No node selected.")
else (PROG* ((Children (RECURSIVE.COLLECTDESCENDENTS Node Graph))
(OldRegion (for EachNode in (CONS Node Children)
bind (TotalRegion ← (NODEREGION Node))
do (FLIPNODE EachNode DisplayStream)
(SETQ TotalRegion (UNIONREGIONS TotalRegion (NODEREGION
EachNode)))
finally (RETURN TotalRegion)))
(NewRegionPosition (GETBOXPOSITION.FROMINITIALREGION (WFROMDS DisplayStream)
OldRegion DisplayStream))
(deltaX (DIFFERENCE (fetch (POSITION XCOORD) of NewRegionPosition)
(fetch (REGION LEFT) of OldRegion)))
(deltaY (DIFFERENCE (fetch (POSITION YCOORD) of NewRegionPosition)
(fetch (REGION BOTTOM) of OldRegion)))
(OldPos (fetch (GRAPHNODE NODEPOSITION) of Node))
(NewPos (CREATE.NEW.NODEPOSITION Node deltaX deltaY)))
[if (NOT (EQUAL OldPos NewPos))
then (MOVENODE Node OldPos NewPos Graph DisplayStream)
(EXTENDEXTENT (WFROMDS DisplayStream)
(NODEREGION Node))
(CALL.MOVENODEFN Node OldPos Graph (WFROMDS DisplayStream)
NewPos)
(if Children
then (PROG [(MovedNodes (LIST (fetch (GRAPHNODE NODEID)
of Node]
(MOVEDESCENDENTS Graph Node DisplayStream deltaX
deltaY]
(for EachNode in (CONS Node Children) do (FLIPNODE EachNode
DisplayStream])
(RECURSIVE.COLLECTDESCENDENTS
[LAMBDA (Node Graph) (* Newman "26-Jan-87 13:18")
(* * Collect all descendents of Node in Graph.)
(for Child in (COLLECT.CHILD.NODES Node Graph) join (CONS Child (
RECURSIVE.COLLECTDESCENDENTS
Child Graph])
(MOVEDESCENDENTS
[LAMBDA (Graph Node DisplayStream deltaX deltaY) (* Newman "27-Jan-87 11:08")
(* * Moves Node and all Children of Node by deltaX and deltaY.)
(* * first, finds all descendents of Node. For each of these, create a new position based on the old and the
deltas. Then, if the child has not been moved yet, we add it to the list of moved nodes, move the node, and call
the MOVENODEFN,)
(bind (MovedNodes ← (LIST Node))
NewPos for Child in (RECURSIVE.COLLECTDESCENDENTS Node Graph)
eachtime (SETQ NewPos (CREATE.NEW.NODEPOSITION Child deltaX deltaY))
unless (MEMBER (fetch (GRAPHNODE NODEID) of Child)
MovedNodes)
do (SETQ MovedNodes (CONS (fetch (GRAPHNODE NODEID) of Child)
MovedNodes))
(MOVENODE Child (fetch NODEPOSITION of Child)
NewPos Graph DisplayStream)
(EXTENDEXTENT (WFROMDS DisplayStream)
(NODEREGION Child)) (* we must call EXTENDEXTENT to extend the graph
extent in case we have moved a node outside the
previous extent.)
(CALL.MOVENODEFN Child NewPos Graph (WFROMDS DisplayStream)
(fetch NODEPOSITION of Child])
(COLLECT.CHILD.NODES
[LAMBDA (Node Graph) (* Newman "27-Jan-87 11:16")
(* * collect all immediate children (only one generation) of Node in Graph.)
(bind (GraphNodes ← (fetch (GRAPH GRAPHNODES) of Graph)) for NodeID
in (fetch (GRAPHNODE TONODES) of Node)
collect
(* ??? (ASSOC (if (AND (LISTP NodeID) (EQUAL (CAR NodeID) (QUOTE Link% Parameters))) then (* Special case where the
second item in the list is the NodeID) (CADR NodeID) else NodeID) GraphNodes))
(GETNODEFROMID NodeID GraphNodes])
(CREATE.NEW.NODEPOSITION
[LAMBDA (Node deltaX deltaY) (* Newman "27-Jan-87 11:06")
(* * Creates a new position for Node by adding deltaX and deltaY to the appropriate coordinates.)
(PROG ((OldPos (fetch (GRAPHNODE NODEPOSITION) of Node)))
(RETURN (create POSITION
XCOORD ← (PLUS deltaX (fetch (POSITION XCOORD) of OldPos))
YCOORD ← (PLUS deltaY (fetch (POSITION YCOORD) of OldPos])
(GETBOXPOSITION.FROMINITIALREGION
[LAMBDA (Window Region DisplayStream) (* Newman "26-Jan-87 11:38")
(* * This function obtains a new region from the user, and it prompts the user using the region passed in as
Region. DisplayStream is the displaystream of Window, and Region is considered to be a region within Window.
This function was written to be called from EDITMOVEREGION.)
(* All of the garbage below to calculate the third and fourth arguments to GETBOXPOSITION exists to put the ghost
box prompting the user in exactly the same place as the region passed in.)
(GETBOXPOSITION (fetch (REGION WIDTH) of Region)
(fetch (REGION HEIGHT) of Region)
(DIFFERENCE (PLUS (fetch (REGION LEFT) of Region)
(fetch (REGION LEFT) of (WINDOWPROP Window
(QUOTE REGION)
))
(WINDOWPROP Window (QUOTE BORDER)))
(fetch (REGION LEFT) of (DSPCLIPPINGREGION NIL
DisplayStream)))
(DIFFERENCE (PLUS (fetch (REGION BOTTOM) of Region)
(fetch (REGION BOTTOM) of (WINDOWPROP Window
(QUOTE
REGION)))
(WINDOWPROP Window (QUOTE BORDER)))
(fetch (REGION BOTTOM) of (DSPCLIPPINGREGION NIL
DisplayStream)))
Window "Select new region for nodes."])
(INIT/NODES/FOR/LAYOUT
[LAMBDA (NS FORMAT ROOTIDS FONT) (* Randy.Gobbel " 8-May-87 16:22")
(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 (IMAGEOBJP (fetch (GRAPHNODE NODELABEL) of GN))
(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])
(NODECREATE
[LAMBDA (ID LABEL POS TONODEIDS FROMNODEIDS FONT BORDER LABELSHADE)
(* Randy.Gobbel "13-May-87 12:04")
(* creates a node for a grapher.)
(create GRAPHNODE
NODEID ← ID
NODEPOSITION ← POS
NODELABEL ← LABEL
NODEFONT ← (COND
(FONT)
((IMAGEOBJP LABEL)
NIL)
(DEFAULT.GRAPH.NODEFONT)
(T (FONTNAMELIST DEFAULTFONT)))
TONODES ← TONODEIDS
FROMNODES ← FROMNODEIDS
NODEBORDER ← BORDER
NODELABELSHADE ← LABELSHADE])
)
(DECLARE: DONTEVAL@LOAD
(DREMOVE (SASSOC "Move Node" EDITGRAPHMENUCOMMANDS)
EDITGRAPHMENUCOMMANDS)
[ADDTOVAR EDITGRAPHMENUCOMMANDS (Move% Node (QUOTE MOVENODE)
"Moves a single node in the graph."
(SUBITEMS (Move% Single% Node (QUOTE MOVENODE)
"Moves a single node in the graph.")
(Move% Node% and% Subtree (EDITMOVESUBTREE
GRAPHWINDOW)
"Moves a subtree of nodes relative to the movement of their root.")
(Move% Region (EDITMOVEREGION GRAPHWINDOW)
"Moves a group of nodes within a specified region to another region."]
(SETQ EDITGRAPHMENU NIL)
)
(PUTPROPS GRAPHERPATCH COPYRIGHT ("Xerox Corporation" 1987))
(DECLARE: DONTCOPY
(FILEMAP (NIL (2105 13932 (EDITMOVEREGION 2115 . 4219) (EDITMOVESUBTREE 4221 . 5896) (NOT.TRACKCURSOR
5898 . 7946) (RECURSIVE.COLLECTDESCENDENTS 7948 . 8305) (MOVEDESCENDENTS 8307 . 9652) (
COLLECT.CHILD.NODES 9654 . 10293) (CREATE.NEW.NODEPOSITION 10295 . 10802) (
GETBOXPOSITION.FROMINITIALREGION 10804 . 12308) (INIT/NODES/FOR/LAYOUT 12310 . 13290) (NODECREATE
13292 . 13930)))))
STOP