perm filename CYCDRC.LSP[3,LMM] blob
sn#037472 filedate 1973-04-21 generic text, type T, neo UTF8
(DEFPROP CYCDRCFNS
(CYCDRCFNS SORTLN SRTLNA)
VALUE)
(DEFPROP SORTLN
(LAMBDA NIL
(PROG (L X X1 X2 X3 Y Y1 I)
(FOR I := (1. NMX) DO (STORE (TMP I) (LENGTH (CONN I))))
(FOR I IN PATSELECT DO (STORE (TMP (CAR I)) 20.))
(SETQ L NIL)
(SETQ Y1 (TIMES NMX 10.))
(SETQ Y NIL)
A (SETQ X1 0.)
(SETQ X2 NIL)
(FOR X
IN
LINE
IF
(NOT (MEMBER X L))
DO
(SETQ X3 (PLUS (TMP (CAAR X)) (TMP (CDAR X))))
(COND ((LESSP X1 X3) (PROG2 (SETQ X1 X3) (SETQ X2 X)))))
(COND ((AND Y (NOT (MEMBER (CAAR X2) Y))) (RPLACA X2 (CONS (CDAR X2) (CAAR X2)))))
(SETQ Y (SRTLNA (CAAR X2) Y Y1))
(SETQ Y (SRTLNA (CDAR X2) Y Y1))
(SETQ Y1 (PLUS Y1 -10.))
(SETQ L (CONS X2 L))
(COND ((LESSP (LENGTH L) LLN) (GO A)))
(RETURN (SETQ LINE (REVERSE L)))))
EXPR)
(DEFPROP SRTLNA
(LAMBDA(X Y Y1)
(PROG NIL (COND ((MEMBER X Y) (RETURN Y))) (STORE (TMP X) (PLUS Y1 (TMP X))) (RETURN (CONS X Y))))
EXPR)