(FILECREATED " 5-Apr-85 11:18:25" {PHYLUM}<NOTECARDS>RELEASE1.2>GRAPHERPATCH.;3 7752   

      changes to:  (FNS DELETE/AND/DISPLAY/LINK REMOVETONODES GRAPHDELETELINK)
		   (VARS GRAPHERPATCHCOMS)

      previous date: "13-Mar-85 14:02:08" {PHYLUM}<NOTECARDS>RELEASE1.2>GRAPHERPATCH.;1)


(* 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)))
(* * 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 (1152 3202 (DISPLAYLINK 1162 . 3200)) (3244 5180 (DISPLAYLINK/BT 3254 . 4215) (
DISPLAYLINK/RL 4217 . 5178)) (5279 7206 (GRAPHDELETELINK 5289 . 6038) (DELETE/AND/DISPLAY/LINK 6040 . 
7204)) (7248 7669 (REMOVETONODES 7258 . 7667)))))
STOP