perm filename CYCDRG.PRT[4,LMM] blob
sn#037525 filedate 1973-04-23 generic text, type T, neo UTF8
(DEFPROP CYCDRGFNS
(CYCDRGFNS PATFACE FNODLST PATNODFC NODEPICK2 NODEPICK3
NODECHK PATCONN PATPTS PATPOINTS)
VALUE)
(DEFPROP PATFACE (LAMBDA (X)
(CADDR X))
EXPR)
(DEFPROP FNODLST (LAMBDA (X)
(PROG (Y Y1)
(SETQ Y (CDR X))
(SETQ Y1 (CADDAR Y))
B
(COND ((NULL (SETQ Y (CDR Y)))
(RETURN (CONS (CAR X)
Y1)))
(T (SETQ Y1 (UNION Y1
(CADDAR
Y)))))
(GO B)))
EXPR)
(DEFPROP PATNODFC (LAMBDA (X)
(CADDDR X))
EXPR)
(DEFPROP NODEPICK2 (LAMBDA (PS)
(NODEPICK3 PS NIL NIL))
EXPR)
(DEFPROP NODEPICK3
(LAMBDA (PS1 LST USD)
(PROG (X Y)
(SETQ X (CDAR PS1))
B
(COND
((NULL X)
(RETURN NIL))
((MEMQ (CAR X)
USD)
NIL)
((CDR PS1)
(GO A))
(T (RETURN (CONS (CONS (CAAR PS1)
(CAR X))
LST))))
C
(SETQ X (CDR X))
(GO B)
A
(COND ((NOT (NODECHK (CAAR PS1)
(CAR X)
LST))
(GO C)))
(SETQ Y (NODEPICK3 (CDR PS1)
(CONS (CONS (CAAR PS1)
(CAR X))
LST)
(CONS (CAR X)
USD)))
(COND (Y (RETURN Y)))
(GO C)))
EXPR)
(DEFPROP NODECHK
(LAMBDA
(PX NX LST)
(PROG (Y Y1 Y2)
(SETQ Y2 (CONN NX))
(RETURN (FOR Y IN (CDR (ASSOC PX (PATCONN CURPAT)))
AS Y1 IS (ASSOC2 Y LST)
IF Y1 AND (MEMBER (CDR Y1)
Y2)))))
EXPR)
(DEFPROP PATCONN (LAMBDA (X)
(CADR X))
EXPR)
(DEFPROP PATPTS (LAMBDA (X LC)
(FOR NEW Y IN X AS NEW Z IS
(ASSOC2 (CAR Y)
LC)
LIST
(LIST (CDR Y)
(PLUS (CADR Z)
15.0)
(PLUS (CADDR Z)
15.0))))
EXPR)
(DEFPROP PATPOINTS (LAMBDA (X)
(CADR (CDDDDR X)))
EXPR)
STOP