(FILECREATED " 7-Jun-84 13:40:12" {ERIS}<LISPUSERS>GRAPHZOOM.;3 18938
changes to: (VARS GRAPHZOOMCOMS)
(RECORDS ZOOMGRAPH ZOOMGRAPHNODE)
(FNS EXTEND.DECREASING.FONT.LIST)
previous date: "14-Feb-84 13:32:40" {ERIS}<LISPUSERS>GRAPHZOOM.;1)
(* Copyright (c) 1983, 1984 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT GRAPHZOOMCOMS)
(RPAQQ GRAPHZOOMCOMS [(FILES GRAPHER)
(RECORDS ZOOMGRAPH ZOOMGRAPHNODE)
(FNS MAKE.ZOOM.GRAPH ORIG.NODE.OF.GRAPH SCALE.GRAPH.FONT SCALE.GRAPH.NODE SCALE.GRAPH.NODES
SCALE.GRAPH RESET.GRAPH.EXTENT ZOOM.GRAPH.WINDOW ADJUST.EXTENT ZOOM.GRAPH.ADDLINKFN
ZOOM.GRAPH.ADDNODEFN ZOOM.GRAPH.DELETELINKFN ZOOM.GRAPH.DELETENODEFN
ZOOM.GRAPH.FONTCHANGEFN ZOOM.GRAPH.MOVENODEFN SHOWZOOMGRAPH ZOOM.TO.CENTER)
(COMS (* general functions for scaling)
(FNS ABSWXOFFSET ABSWYOFFSET SCALE.REGION UNSCALE.POSITION SCALE.POSITION WINDOW.SCALE))
(COMS (FNS EXTEND.DECREASING.FONT.LIST)
(ADDVARS (FONTDIRECTORIES {ERIS}<LISPFONTS>))
(VARS (DECREASING.FONT.LIST (EXTEND.DECREASING.FONT.LIST])
(FILESLOAD GRAPHER)
[DECLARE: EVAL@COMPILE
(RECORD ZOOMGRAPH (NODELST DISPLAYGRAPH SG.MOVENODEFN SG.ADDNODEFN SG.DELETENODEFN SG.ADDLINKFN
SG.DELETELINKFN))
(RECORD ZOOMGRAPHNODE (SG.POSITION SG.FONT SG.LABEL SG.USERDATA SG.))
]
(DEFINEQ
(MAKE.ZOOM.GRAPH
[LAMBDA (GRAPH SCALE) (* rrb " 6-NOV-83 12:07")
(* returns a graph that is a scaled version of GRAPH)
(create GRAPH
GRAPHNODES ←(SCALE.GRAPH.NODES (fetch (GRAPH GRAPHNODES) of GRAPH)
SCALE)
SIDESFLG ←(fetch (GRAPH SIDESFLG) of GRAPH)
DIRECTEDFLG ←(fetch (GRAPH DIRECTEDFLG) of GRAPH)
GRAPH.MOVENODEFN ←(FUNCTION ZOOM.GRAPH.MOVENODEFN)
GRAPH.ADDNODEFN ←(FUNCTION ZOOM.GRAPH.ADDNODEFN)
GRAPH.DELETENODEFN ←(FUNCTION ZOOM.GRAPH.DELETENODEFN)
GRAPH.ADDLINKFN ←(FUNCTION ZOOM.GRAPH.ADDLINKFN)
GRAPH.DELETELINKFN ←(FUNCTION ZOOM.GRAPH.DELETELINKFN)
GRAPH.FONTCHANGEFN ←(FUNCTION ZOOM.GRAPH.FONTCHANGEFN])
(ORIG.NODE.OF.GRAPH
[LAMBDA (NODE INGRAPH CORRESGRAPH) (* rrb " 1-NOV-83 19:02")
(* returns the node in CORRESGRAPH corresponding to NODE
in INGRAPH.)
(bind (NODEID ←(fetch (GRAPHNODE NODEID) of NODE)) for INND in (fetch (GRAPH GRAPHNODES)
of INGRAPH)
as CORND in (fetch (GRAPH GRAPHNODES) of CORRESGRAPH) when (EQ (fetch (GRAPHNODE NODEID)
of INND)
NODEID)
do (RETURN CORND])
(SCALE.GRAPH.FONT
[LAMBDA (FONT SCALE) (* rrb " 1-NOV-83 18:23")
(* returns the closest font for this scale.)
(* "LABEL" is an approximation of the label string. A fixed one is used rather than the label of the node so that
all labels in the same font will scale to the same font.)
(SCALE.FONT (QUOTIENT (STRINGWIDTH "LABEL" FONT)
SCALE)
"LABEL"])
(SCALE.GRAPH.NODE
[LAMBDA (NODE SCALE) (* rrb " 1-NOV-83 17:54")
(* returns a node that has been scaled.)
(* keeps the same id's so that the links don't have to
change.)
(create GRAPHNODE
NODEID ←(fetch (GRAPHNODE NODEID) of NODE)
NODEPOSITION ←(SCALE.POSITION (fetch (GRAPHNODE NODEPOSITION) of NODE)
SCALE)
TONODES ←(fetch (GRAPHNODE TONODES) of NODE)
FROMNODES ←(fetch (GRAPHNODE FROMNODES) of NODE)
NODEFONT ←(SCALE.GRAPH.FONT (fetch (GRAPHNODE NODEFONT) of NODE)
SCALE)
NODELABEL ←(fetch (GRAPHNODE NODELABEL) of NODE)
BOXNODEFLG ←(fetch (GRAPHNODE BOXNODEFLG) of NODE])
(SCALE.GRAPH.NODES
[LAMBDA (NODELST SCALE) (* rrb " 1-NOV-83 11:05")
(* scales a list of nodes)
(for NODE in NODELST collect (SCALE.GRAPH.NODE NODE SCALE])
(SCALE.GRAPH
[LAMBDA (SGWINDOW) (* rrb " 8-NOV-83 12:35")
(* takes the SKETCH.GRAPH in SGWINDOW and recomputes it
to its current scale)
(PROG [(SCALEDGRAPH (MAKE.ZOOM.GRAPH (WINDOWPROP SGWINDOW (QUOTE SKETCH.GRAPH))
(WINDOWPROP SGWINDOW (QUOTE SCALE]
(WINDOWPROP SGWINDOW (QUOTE GRAPH)
SCALEDGRAPH)
(RESET.GRAPH.EXTENT SCALEDGRAPH SGWINDOW)
(RETURN SCALEDGRAPH])
(RESET.GRAPH.EXTENT
[LAMBDA (GRAPH WINDOW) (* sets the extent of the graph onto the extent window
property)
(WINDOWPROP WINDOW (QUOTE EXTENT)
(GRAPHREGION GRAPH])
(ZOOM.GRAPH.WINDOW
[LAMBDA (ITEM MENU BUTTON) (* rrb " 8-NOV-83 13:47")
(* zooms the main sketch graph window.)
(PROG ((MAINW (WINDOWPROP (WFROMMENU MENU)
(QUOTE MAINWINDOW)))
(SMALLOUTFACTOR 1.1)
(LARGEOUTFACTOR 1.8)
SMALLINFACTOR LARGEINFACTOR) (* factors are reciprocals so that IN followed by small
OUT should return to the same place.)
(SETQ SMALLINFACTOR (FQUOTIENT 1.0 SMALLOUTFACTOR))
(SETQ LARGEINFACTOR (FQUOTIENT 1.0 LARGEOUTFACTOR))
(* set the SCALE and offsets)
(ZOOM.TO.CENTER MAINW (SELECTQ (CADR (CADR ITEM))
(IN (SELECTQ BUTTON
(MIDDLE LARGEINFACTOR)
SMALLINFACTOR))
(SELECTQ BUTTON
(MIDDLE LARGEOUTFACTOR)
SMALLOUTFACTOR)))
(* rescale the graph)
(SCALE.GRAPH MAINW)
(ADJUST.EXTENT MAINW)
(REDISPLAYGRAPH MAINW])
(ADJUST.EXTENT
[LAMBDA (WINDOW) (* rrb " 8-NOV-83 13:51")
(* adjust the offsets of WINDOW so that the visible region of the window is all extent. If there is more visible
region than extent, it centers the extent.)
(PROG ((EXTENT (WINDOWPROP WINDOW (QUOTE EXTENT)))
(REG (DSPCLIPPINGREGION NIL WINDOW))
REGOFF REGEXT EXTOFF EXTEXT)
(COND
((GREATERP (SETQ REGEXT (fetch (REGION WIDTH) of REG))
(SETQ EXTEXT (fetch (REGION WIDTH) of EXTENT)))
(* center in X)
(ABSWXOFFSET (DIFFERENCE (fetch (REGION LEFT) of EXTENT)
(IQUOTIENT (IDIFFERENCE REGEXT EXTEXT)
2))
WINDOW))
((GREATERP (SETQ EXTOFF (fetch (REGION LEFT) of EXTENT))
(SETQ REGOFF (fetch (REGION LEFT) of REG)))
(* move it to the left)
(ABSWXOFFSET EXTOFF WINDOW))
((GREATERP (IPLUS REGOFF REGEXT)
(SETQ EXTOFF (IPLUS EXTOFF EXTEXT)))
(* move it to the right)
(ABSWXOFFSET (DIFFERENCE EXTOFF REGEXT)
WINDOW)))
(COND
((GREATERP (SETQ REGEXT (fetch (REGION HEIGHT) of REG))
(SETQ EXTEXT (fetch (REGION HEIGHT) of EXTENT)))
(* center in Y)
(ABSWYOFFSET (DIFFERENCE (fetch (REGION BOTTOM) of EXTENT)
(IQUOTIENT (IDIFFERENCE REGEXT EXTEXT)
2))
WINDOW))
((GREATERP (SETQ EXTOFF (fetch (REGION BOTTOM) of EXTENT))
(SETQ REGOFF (fetch (REGION BOTTOM) of REG)))
(* move it up)
(ABSWYOFFSET EXTOFF WINDOW))
((GREATERP (IPLUS REGOFF REGEXT)
(SETQ EXTOFF (IPLUS EXTOFF EXTEXT)))
(* move it down)
(ABSWYOFFSET (DIFFERENCE EXTOFF REGEXT)
WINDOW])
(ZOOM.GRAPH.ADDLINKFN
[LAMBDA (FROM TO GRAPH WINDOW) (* rrb " 6-NOV-83 12:08")
(* the link adding function for a sketch graph.)
(PROG [(ORGGRAPH (WINDOWPROP WINDOW (QUOTE SKETCH.GRAPH]
(GRAPHADDLINK (ORIG.NODE.OF.GRAPH FROM GRAPH ORGGRAPH)
(ORIG.NODE.OF.GRAPH TO GRAPH ORGGRAPH)
ORGGRAPH WINDOW])
(ZOOM.GRAPH.ADDNODEFN
[LAMBDA (GRAPH WINDOW) (* rrb " 1-NOV-83 17:46")
(* the node adding function for a sketch graph.)
(PROG (NEWNODE)
(COND
((SETQ NEWNODE (GRAPHADDNODE (WINDOWPROP WINDOW (QUOTE SKETCH.GRAPH))
WINDOW)) (* calls the graphs addnode function to create the node
then scale it to the sketch window.)
(RETURN (SCALE.GRAPH.NODE NEWNODE (WINDOWPROP WINDOW (QUOTE SCALE])
(ZOOM.GRAPH.DELETELINKFN
[LAMBDA (FROM TO GRAPH WINDOW) (* rrb " 6-NOV-83 12:08")
(* the link adding function for a sketch graph.)
(PROG [(ORGGRAPH (WINDOWPROP WINDOW (QUOTE SKETCH.GRAPH]
(GRAPHDELETELINK (ORIG.NODE.OF.GRAPH FROM GRAPH ORGGRAPH)
(ORIG.NODE.OF.GRAPH TO GRAPH ORGGRAPH)
ORGGRAPH WINDOW])
(ZOOM.GRAPH.DELETENODEFN
[LAMBDA (NODE GRAPH WINDOW) (* rrb " 6-NOV-83 12:08")
(* the node deleting function for a sketch graph.)
(PROG [(ORGGRAPH (WINDOWPROP WINDOW (QUOTE SKETCH.GRAPH]
(RETURN (GRAPHDELETENODE (ORIG.NODE.OF.GRAPH NODE GRAPH ORGGRAPH)
ORGGRAPH WINDOW])
(ZOOM.GRAPH.FONTCHANGEFN
[LAMBDA (HOW NODE GRAPH WINDOW) (* rrb " 6-NOV-83 12:08")
(* the node deleting function for a sketch graph.)
(PROG (NEWFONT ORIGNODE)
[SETQ NEWFONT (NEXTSIZEFONT HOW (fetch (GRAPHNODE NODEFONT)
of (SETQ ORIGNODE (ORIG.NODE.OF.GRAPH
NODE GRAPH (WINDOWPROP WINDOW (QUOTE SKETCH.GRAPH]
(COND
(NEWFONT (replace (GRAPHNODE NODEFONT) of ORIGNODE with NEWFONT])
(ZOOM.GRAPH.MOVENODEFN
[LAMBDA (NODE NEWPOS GRAPH WINDOW) (* rrb " 6-NOV-83 12:08")
(* the move function for a sketch graph.
Moves the original node and calls its move fn if any.)
(PROG [(ORGGRAPH (WINDOWPROP WINDOW (QUOTE SKETCH.GRAPH)))
(SCALE (WINDOWPROP WINDOW (QUOTE SCALE]
(GRAPHMOVENODE (ORIG.NODE.OF.GRAPH NODE GRAPH ORGGRAPH)
(UNSCALE.POSITION NEWPOS SCALE)
ORGGRAPH WINDOW])
(SHOWZOOMGRAPH
[LAMBDA (GRAPH WINDOW LEFTBUTTONFN MIDDLEBUTTONFN TOPJUSTIFYFLG ALLOWEDITFLG INITSCALE)
(* edited: "14-Feb-84 13:30")
(* puts a zoomable graph in the given window, creating
one if a window is not given.)
(PROG (SKETCH.GRAPH (INITSCALE (OR INITSCALE 1.0)))
(COND
((LISTP GRAPH) (* should be a GRAPHP check but since it is a list there
is no easy test.)
NIL)
((NULL GRAPH)
(SETQ GRAPH (create GRAPH)))
(T (\ILLEGAL.ARG GRAPH)))
(SETQ SKETCH.GRAPH (MAKE.ZOOM.GRAPH GRAPH INITSCALE))
(* put a title on so that there will be a place to right
button.)
(SETQ WINDOW (SIZE/GRAPH/WINDOW SKETCH.GRAPH (OR WINDOW (AND ALLOWEDITFLG ""))
TOPJUSTIFYFLG))
(bind MENU for ATW in (ATTACHEDWINDOWS WINDOW) when (AND (SETQ MENU (WINDOWPROP
ATW
(QUOTE MENU)))
(EQ (fetch (MENU WHENSELECTEDFN)
of (CAR MENU))
(FUNCTION ZOOM.GRAPH.WINDOW)))
do (* a zoom menu is already attached to this window.)
(RETURN)
finally (ATTACHMENU (create MENU
ITEMS ←(QUOTE ((LARGER (QUOTE IN)
"increases the size of the graph elements.")
(smaller (QUOTE OUT)
"decreases the size of the graph elements")))
CENTERFLG ← T
WHENSELECTEDFN ←(FUNCTION ZOOM.GRAPH.WINDOW)
MENUROWS ← 1
MENUBORDERSIZE ← 1)
WINDOW
(QUOTE TOP)))
(WINDOWPROP WINDOW (QUOTE SKETCH.GRAPH)
GRAPH)
(WINDOWPROP WINDOW (QUOTE SCALE)
INITSCALE)
(WINDOWPROP WINDOW (QUOTE GRAPH)
SKETCH.GRAPH)
(WINDOWADDPROP WINDOW (QUOTE REPAINTFN)
(FUNCTION REDISPLAYGRAPH))
(WINDOWADDPROP WINDOW (QUOTE RESHAPEFN)
(FUNCTION RESHAPEBYREPAINTFN))
(WINDOWPROP WINDOW (QUOTE SCROLLFN)
(FUNCTION SCROLLBYREPAINTFN))
[COND
(ALLOWEDITFLG (* change the mode to invert so lines can be erased by
being redrawn.)
(DSPOPERATION (QUOTE INVERT)
WINDOW)
(WINDOWPROP WINDOW (QUOTE RIGHTBUTTONFN)
(FUNCTION GRAPHEDITEVENTFN]
(WINDOWPROP WINDOW (QUOTE BUTTONEVENTFN)
(FUNCTION APPLYTOSELECTEDNODE))
(WINDOWPROP WINDOW (QUOTE BROWSER/LEFTFN)
LEFTBUTTONFN)
(WINDOWPROP WINDOW (QUOTE BROWSER/MIDDLEFN)
MIDDLEBUTTONFN)
(OPENW WINDOW)
(REDISPLAYGRAPH WINDOW)
(RETURN WINDOW])
(ZOOM.TO.CENTER
[LAMBDA (WINDOW FACTOR) (* rrb " 6-NOV-83 11:46")
(* adjusts the SCALE window property and the offsets of
WINDOW so that they correspond to zooming by FACTOR
towards the center.)
(PROG ((OLDSCALE (WINDOW.SCALE WINDOW))
(REG (DSPCLIPPINGREGION NIL WINDOW))
NEWSCALE)
(WINDOWPROP WINDOW (QUOTE SCALE)
(SETQ NEWSCALE (FTIMES OLDSCALE FACTOR)))
(ABSWXOFFSET (FIX (FQUOTIENT [FTIMES OLDSCALE (FPLUS (fetch (REGION LEFT) of REG)
(FTIMES (fetch (REGION WIDTH)
of REG)
(FQUOTIENT (FDIFFERENCE 1.0
FACTOR)
2]
NEWSCALE))
WINDOW)
(ABSWYOFFSET (FIX (FQUOTIENT [FTIMES OLDSCALE (FPLUS (fetch (REGION BOTTOM) of REG)
(FTIMES (fetch (REGION HEIGHT)
of REG)
(FQUOTIENT (FDIFFERENCE 1.0
FACTOR)
2]
NEWSCALE))
WINDOW) (* scale the EXTENT also.)
(AND (SETQ REG (WINDOWPROP WINDOW (QUOTE EXTENT)))
(WINDOWPROP WINDOW (QUOTE EXTENT)
(SCALE.REGION REG FACTOR])
)
(* general functions for scaling)
(DEFINEQ
(ABSWXOFFSET
[LAMBDA (NEWX W) (* rrb "29-MAR-83 11:27")
(* sets the offset of a window.)
(WXOFFSET (IDIFFERENCE (WXOFFSET NIL W)
NEWX)
W])
(ABSWYOFFSET
[LAMBDA (NEWY W) (* rrb "29-MAR-83 11:28")
(* sets the offset of a window.)
(WYOFFSET (IDIFFERENCE (WYOFFSET NIL W)
NEWY)
W])
(SCALE.REGION
[LAMBDA (REGION SCALE) (* rrb "15-AUG-83 17:30")
(* scales a region into a windows coordinate space.)
(CREATEREGION (FIXR (QUOTIENT (fetch (REGION LEFT) of REGION)
SCALE))
(FIXR (QUOTIENT (fetch (REGION BOTTOM) of REGION)
SCALE))
(FIXR (QUOTIENT (fetch (REGION WIDTH) of REGION)
SCALE))
(FIXR (QUOTIENT (fetch (REGION HEIGHT) of REGION)
SCALE])
(UNSCALE.POSITION
[LAMBDA (POSITION SCALE) (* rrb " 1-APR-83 16:05")
(* unscales a point in a window out into the larger
coordinate space.)
(create POSITION
XCOORD ←(TIMES (fetch (POSITION XCOORD) of POSITION)
SCALE)
YCOORD ←(TIMES (fetch (POSITION YCOORD) of POSITION)
SCALE])
(SCALE.POSITION
[LAMBDA (POS SCALE) (* rrb "29-APR-83 08:27")
(* scales a position from window coordinates into global
coordinates.)
(create POSITION
XCOORD ←(QUOTIENT (fetch (POSITION XCOORD) of POS)
SCALE)
YCOORD ←(QUOTIENT (fetch (POSITION YCOORD) of POS)
SCALE])
(WINDOW.SCALE
[LAMBDA (SKETCHW) (* rrb "14-MAR-83 10:31")
(* returns the scale of a sketch window.)
(WINDOWPROP SKETCHW (QUOTE SCALE])
)
(DEFINEQ
(EXTEND.DECREASING.FONT.LIST
[LAMBDA NIL (* rrb " 7-Jun-84 12:11")
(* returns a list of the font descriptors for the fonts
sketch windows are willing to print in.)
(NCONC (bind FONT for SIZE in (QUOTE (72 36 30)) join (AND (SETQ FONT (FONTCREATE (QUOTE
TIMESROMAND)
SIZE))
(CONS FONT)))
(bind FONT for SIZE in (QUOTE (18 14 12 10 8 5 4 3)) join (AND (SETQ FONT
(FONTCREATE (QUOTE
HELVETICA)
SIZE))
(CONS FONT])
)
(ADDTOVAR FONTDIRECTORIES {ERIS}<LISPFONTS>)
(RPAQ DECREASING.FONT.LIST (EXTEND.DECREASING.FONT.LIST))
(PUTPROPS GRAPHZOOM COPYRIGHT ("Xerox Corporation" 1983 1984))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1340 15743 (MAKE.ZOOM.GRAPH 1350 . 2166) (ORIG.NODE.OF.GRAPH 2168 . 2775) (
SCALE.GRAPH.FONT 2777 . 3277) (SCALE.GRAPH.NODE 3279 . 4168) (SCALE.GRAPH.NODES 4170 . 4455) (
SCALE.GRAPH 4457 . 5007) (RESET.GRAPH.EXTENT 5009 . 5240) (ZOOM.GRAPH.WINDOW 5242 . 6399) (
ADJUST.EXTENT 6401 . 8579) (ZOOM.GRAPH.ADDLINKFN 8581 . 9016) (ZOOM.GRAPH.ADDNODEFN 9018 . 9578) (
ZOOM.GRAPH.DELETELINKFN 9580 . 10027) (ZOOM.GRAPH.DELETENODEFN 10029 . 10430) (ZOOM.GRAPH.FONTCHANGEFN
10432 . 10986) (ZOOM.GRAPH.MOVENODEFN 10988 . 11521) (SHOWZOOMGRAPH 11523 . 14411) (ZOOM.TO.CENTER
14413 . 15741)) (15786 18044 (ABSWXOFFSET 15796 . 16068) (ABSWYOFFSET 16070 . 16342) (SCALE.REGION
16344 . 16885) (UNSCALE.POSITION 16887 . 17336) (SCALE.POSITION 17338 . 17786) (WINDOW.SCALE 17788 .
18042)) (18045 18740 (EXTEND.DECREASING.FONT.LIST 18055 . 18738)))))
STOP