perm filename NEWDRA[3,LMM] blob
sn#038926 filedate 1973-04-27 generic text, type T, neo UTF8
(DEFPROP NEWDRAWFNS
(NEWDRAWFNS FINDGRAFENTRY BUMPOUTREF DELETENODES NBRS NBR NODES DRAW2NODES UNIVALENT DRAWUNIVS DRAWGRAF)
VALUE)
(DEFPROP FINDGRAFENTRY
(LAMBDA(NODE GRAF)
(COND ((CONSP NODE) NODE)
(T (FOR ENTRY IN (GRAFNODES GRAF) WHEN (EQUAL NODE (GRAFNODENUM ENTRY)) DO (RETURN ENTRY)))))
EXPR)
(DEFPROP BUMPOUTREF
(LAMBDA (NODE BUMPBY GRAF) (REPLACE (OUTPREF (SETQ NODE (FINDGRAFENTRY NODE GRAF))) (ADD1 (OUTPREF NODE))))
EXPR)
(DEFPROP DELETENODES
(LAMBDA (NODELIST GRAF) (HELP))
EXPR)
(DEFPROP NBRS
(LAMBDA (NOD) (GRAFNBRS NOD))
EXPR)
(DEFPROP NBR
(LAMBDA (GRAFNODE NUM) (CAR (NTH (NBRS GRAFNODE) NUM)))
EXPR)
(DEFPROP NODES
(LAMBDA (GRAF) (GRAFNODES GRAF))
EXPR)
(DEFPROP DRAW2NODES
(LAMBDA(GRAF)
(COND ((CDDR (NODES GRAF)) NIL)
(T
(PUTNODE (CAR (NODES GRAF))
(QUOTE (0. . 0.))
(PUTNODE (CADR (NODES GRAF)) (QUOTE (1. . 0.)) (EMPTYPICTURE))))))
EXPR)
(DEFPROP UNIVALENT
(LAMBDA (NODE) (NULL (CDR (GRAFNBRS NODE))))
EXPR)
(DEFPROP DRAWUNIVS
(LAMBDA(GRAF)
(FOR NEW
X
ON
(NODES GRAF)
WHEN
(UNIVALENT (CAR X))
AS
NEW
NBRX
IS
(NBR (CAR X) 1.)
AS
NEW
UNILIST
IS
(CONS (CAR X)
(FOR NEW Y ON (CDR X) WHEN (UNIVALENT (CAR Y)) WHEN (EQUAL (NBR (CAR Y) 1.) NBRX) XLIST (CAR Y)))
AS
NEW
PICTURE
IS
(DRAWGRAF (DELETENODES UNILIST (BUMPOUTREF NBRX (LENGTH UNILIST) GRAF)))
DO
(ATTACHUNIS UNILIST NBRX GRAF PICTURE)
(RETURN T)))
EXPR)
(DEFPROP DRAWGRAF
(LAMBDA (GRAF) (OR (DRAW2NODES GRAF) (DRAWUNIVS GRAF) (DRAWBIVS GRAF) (DRAWUGRAPH GRAF)))
EXPR)