(FILECREATED "24-Sep-85 14:47:32" {QV}<NOTECARDS>RELEASE1.2I>GRAPHERPATCH.;4 9215
changes to: (FNS READ/NODE)
previous date: "23-Aug-85 20:44:56" {QV}<NOTECARDS>RELEASE1.2I>GRAPHERPATCH.;3)
(* Copyright (c) 1985 by Xerox Corporation. All rights reserved.)
(PRETTYCOMPRINT GRAPHERPATCHCOMS)
(RPAQQ GRAPHERPATCHCOMS ((* * 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 so that node selection can only happen inside of grapher window.)
(FNS READ/NODE)
(* * Advice so that GRAPHEROBJ makes a copy of graph before constructing
imageobj.)
(ADVISE GRAPHEROBJ)))
(* * 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)))
)
(* * Fix so that node selection can only happen inside of grapher window.)
(DEFINEQ
(READ/NODE
(LAMBDA (NODES DS) (* rht: "24-Sep-85 14:42")
(* * rht 8/20/85: Modified "until" statement so it waits till user clicks inside of window.)
(until (AND (MOUSESTATE (OR LEFT MIDDLE RIGHT))
(INSIDEP (DSPCLIPPINGREGION NIL DS)
(CURSORPOSITION NIL DS)))
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))))))
)
(* * Advice so that GRAPHEROBJ makes a copy of graph before constructing imageobj.)
(PUTPROPS GRAPHEROBJ READVICE (NIL (BEFORE NIL (COND ((NC.NoteCardsGraphP GRAPH)
(SETQ GRAPH (NC.MakeExternalGraphCopy GRAPH)))))
))
(READVISE GRAPHEROBJ)
(PUTPROPS GRAPHERPATCH COPYRIGHT ("Xerox Corporation" 1985))
(DECLARE: DONTCOPY
(FILEMAP (NIL (1292 3342 (DISPLAYLINK 1302 . 3340)) (3384 5320 (DISPLAYLINK/BT 3394 . 4355) (
DISPLAYLINK/RL 4357 . 5318)) (5419 7346 (GRAPHDELETELINK 5429 . 6178) (DELETE/AND/DISPLAY/LINK 6180 .
7344)) (7388 7809 (REMOVETONODES 7398 . 7807)) (7891 8863 (READ/NODE 7901 . 8861)))))
STOP