(FILECREATED "12-Apr-85 17:53:39" {ERIS}<LISPNEW>PATCHES>GRAPHERPATCH.;1 15412
changes to: (VARS GRAPHERPATCHCOMS)
previous date: " 5-Apr-85 11:18:25" {PHYLUM}<NOTECARDS>RELEASE1.2>GRAPHERPATCH.;3)
(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT GRAPHERPATCHCOMS)
(RPAQQ GRAPHERPATCHCOMS ((* Fix bugs in grapher image objects)
(FNS DUMPGRAPH GRAPHOBJ.DISPLAYFN)
(* * These fixes to grapher are so that all line drawing will be from the
fromnode to the tonode. This is important when user cares about endpoint
order in a user-provided Grapher DRAWLINKFN.)
(FNS DISPLAYLINK)
(* Following are new functions.)
(FNS DISPLAYLINK/BT DISPLAYLINK/RL)
(* * Fix so that deleting links through editor will work with Danny's
paramlist creatures.)
(FNS GRAPHDELETELINK DELETE/AND/DISPLAY/LINK)
(* Following is a new function.)
(FNS REMOVETONODES)))
(* Fix bugs in grapher image objects)
(DEFINEQ
(DUMPGRAPH
[LAMBDA (GRAPH STREAM) (* rmk: "11-Mar-85 20:10")
(* 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 2 "SIDESFLG " .P2 (fetch SIDESFLG of GRAPH)))
(if (fetch DIRECTEDFLG of GRAPH)
then (printout STREAM 2 "DIRECTEDFLG " .P2 (fetch DIRECTEDFLG of GRAPH)))
(if (fetch GRAPH.MOVENODEFN of GRAPH)
then (printout STREAM 2 "MOVENODEFN " .P2 (fetch GRAPH.MOVENODEFN
of GRAPH)))
(if (fetch GRAPH.ADDNODEFN of GRAPH)
then (printout STREAM 2 "ADDNODEFN " .P2 (fetch GRAPH.ADDNODEFN of GRAPH)))
(if (fetch GRAPH.DELETENODEFN of GRAPH)
then (printout STREAM 2 "DELETENODEFN " .P2 (fetch GRAPH.DELETENODEFN
of GRAPH)))
(if (fetch GRAPH.ADDLINKFN of GRAPH)
then (printout STREAM 2 "ADDLINKFN " .P2 (fetch GRAPH.ADDLINKFN of GRAPH)))
(if (fetch GRAPH.DELETELINKFN of GRAPH)
then (printout STREAM 2 "DELETELINKFN " .P2 (fetch GRAPH.DELETELINKFN
of GRAPH)))
(if (fetch GRAPH.FONTCHANGEFN of GRAPH)
then (printout STREAM 2 "FONTCHANGEFN " .P2 (fetch GRAPH.FONTCHANGEFN
of GRAPH)))
(if (fetch GRAPH.INVERTBORDERFN of GRAPH)
then (printout STREAM 2 "INVERTBORDERFN " .P2 (fetch GRAPH.INVERTBORDERFN
of GRAPH)))
(if (fetch GRAPH.INVERTLABELFN of GRAPH)
then (printout STREAM 2 "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 1 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 1 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])
(GRAPHOBJ.DISPLAYFN
[LAMBDA (GROBJ STREAM) (* rmk: " 2-Apr-85 10:56")
(* 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 (SETQ 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])
)
(* * These fixes to grapher are so that all line drawing will be from the fromnode to the
tonode. This is important when user cares about endpoint order in a user-provided Grapher
DRAWLINKFN.)
(DEFINEQ
(DISPLAYLINK
(LAMBDA (FRND TOND TRANS STREAM G LINEWIDTH PARAMS) (* rht: "13-Mar-85 13:58")
(* 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/RL TRANS FRND TOND 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/BT TRANS FRND TOND 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/BT TRANS FRND TOND 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/RL TRANS FRND TOND 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))))))
)
(* Following are new functions.)
(DEFINEQ
(DISPLAYLINK/BT
(LAMBDA (TRANS GNB GNT WIDTH OPERATION STREAM PARAMS) (* rht: "13-Mar-85 13:56")
(* draws a line from the bottom edge of GNB to the top
edge of GNT translated by TRANS)
(APPLY* (OR (LISTGET PARAMS (QUOTE DRAWLINKFN))
(QUOTE DRAWLINE))
(IPLUS (fetch XCOORD of TRANS)
(fetch XCOORD of (fetch NODEPOSITION of GNB)))
(IPLUS (fetch YCOORD of TRANS)
(SUB1 (GN/BOTTOM GNB)))
(IPLUS (fetch XCOORD of TRANS)
(fetch XCOORD of (fetch NODEPOSITION of GNT)))
(IPLUS (fetch YCOORD of TRANS)
(ADD1 (GN/TOP GNT)))
(OR (LISTGET PARAMS (QUOTE LINEWIDTH))
WIDTH 1)
OPERATION STREAM (LISTGET PARAMS (QUOTE COLOR))
(LISTGET PARAMS (QUOTE DASHING))
PARAMS)))
(DISPLAYLINK/RL
(LAMBDA (TRANS GNR GNL WIDTH OPERATION STREAM PARAMS) (* rht: "13-Mar-85 13:54")
(* draws a line from the right edge of GNR, to the left
edge of GNL translated by TRANS)
(APPLY* (OR (LISTGET PARAMS (QUOTE DRAWLINKFN))
(QUOTE DRAWLINE))
(IPLUS (fetch XCOORD of TRANS)
(ADD1 (GN/RIGHT GNR)))
(IPLUS (fetch YCOORD of TRANS)
(fetch YCOORD of (fetch NODEPOSITION of GNR)))
(IPLUS (fetch XCOORD of TRANS)
(SUB1 (GN/LEFT GNL)))
(IPLUS (fetch YCOORD of TRANS)
(fetch YCOORD of (fetch NODEPOSITION of GNL)))
(OR (LISTGET PARAMS (QUOTE LINEWIDTH))
WIDTH 1)
OPERATION STREAM (LISTGET PARAMS (QUOTE COLOR))
(LISTGET PARAMS (QUOTE DASHING))
PARAMS)))
)
(* * Fix so that deleting links through editor will work with Danny's paramlist creatures.)
(DEFINEQ
(GRAPHDELETELINK
(LAMBDA (FROM TO GRAPH WINDOW) (* rht: " 4-Apr-85 19:37")
(* deletes a link from a graph)
(* * rht 4/4/85: Changed to call REMOVETONODES to remove either nodeID or paramlist thingie for nodeID.)
(PROG ((DELFN (fetch (GRAPH GRAPH.DELETELINKFN) of GRAPH)))
(AND DELFN (APPLY* DELFN FROM TO GRAPH WINDOW)))
(replace TONODES of FROM with (REMOVETONODES (fetch NODEID of TO)
(fetch TONODES of FROM)))
(replace FROMNODES of TO with (REMOVE (fetch NODEID of FROM)
(fetch FROMNODES of TO)))))
(DELETE/AND/DISPLAY/LINK
(LAMBDA (FROMND TOND WIN G) (* rht: " 5-Apr-85 11:18")
(* delete a link and updates the display.)
(* * rht 4/4/85: Added temporary var LINKPARAMS to hold link parameters since they'll get tossed by
GRAPHDELETELINK.)
(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 (PROG ((LPARAMS (LINKPARAMETERS FROMND TOND)))
(GRAPHDELETELINK FROMND TOND G WIN)
(DISPLAYLINK FROMND TOND (CONSTANT (create POSITION
XCOORD ← 0
YCOORD ← 0))
WIN G NIL LPARAMS))
T))))
)
(* Following is a new function.)
(DEFINEQ
(REMOVETONODES
(LAMBDA (TOND TONODES) (* rht: " 4-Apr-85 19:32")
(* * Removes either TOND or a paramlist thingie for TOND.)
(for Z in TONODES unless (OR (EQ Z TOND)
(AND (LISTP Z)
(EQ (CAR Z)
(QUOTE Link% Parameters))
(EQ TOND (CADR Z))))
collect Z)))
)
(PUTPROPS GRAPHERPATCH COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1006 8610 (DUMPGRAPH 1016 . 6797) (GRAPHOBJ.DISPLAYFN 6799 . 8608)) (8812 10862 (
DISPLAYLINK 8822 . 10860)) (10904 12840 (DISPLAYLINK/BT 10914 . 11875) (DISPLAYLINK/RL 11877 . 12838))
(12939 14866 (GRAPHDELETELINK 12949 . 13698) (DELETE/AND/DISPLAY/LINK 13700 . 14864)) (14908 15329 (
REMOVETONODES 14918 . 15327)))))
STOP