perm filename CYCDRJ[DEN,LMM] blob
sn#034884 filedate 1973-04-13 generic text, type T, neo UTF8
(DEFPROP CYCDRJFNS
(CYCDRJFNS ISOMERS RING DRAW LABELLER)
VALUE)
(DEFPROP ISOMERS
(LAMBDA NIL
(PROG (CL U)
CLLP (PRINT (QUOTE CL?))
(SETQ CL (READ))
(COND ((ATOM CL) (PRINC (QUOTE "THAT CAN'T BE RIGHT - ENTER A ")) (GO CLLP)))
(COND
((PROG (FOR-VALUE LIST*PR PR)
(SETQ LIST*PR CL)
LOOP*1
(COND ((NOT LIST*PR) (GO RETURN)))
(SETQ PR (CAR LIST*PR))
(COND
((SETQ FOR-VALUE
(OR (ATOM PR)
(NOT (NUMBERP (CDR PR)))
(NOT (ATOM (CAR PR)))
(NOT
(OR (NUMBERP (GET (CAR PR) (QUOTE VALENCE)))
(PROG2 (TERPRI)
(PRINC (QUOTE "WHAT'S THE VALENCE OF "))
(PRINC (CAR PR))
(PRINC (QUOTE ?))
(NUMBERP (PUTPROP (CAR PR) (READ) (QUOTE VALENCE))))))))
(RETURN FOR-VALUE)))
NEXT*1
NEXT*PR
(SETQ LIST*PR (CDR LIST*PR))
(GO LOOP*1)
RETURN
(RETURN FOR-VALUE))
(GO CLLP)))
ULP (PRINT (QUOTE U?))
(COND ((NOT (NUMBERP (SETQ U (READ)))) (GO ULP)))
(SETQ RESULTS (MOLECULES CL U))
(PRINT (LIST (LENGTH RESULTS) (QUOTE STRUCTURES) (QUOTE GENERATED)))))
EXPR)
(DEFPROP RING
(LAMBDA NIL
(PROG (CL U)
CLLP (PRINT (QUOTE CL?))
(SETQ CL (READ))
(COND ((ATOM CL) (PRINC (QUOTE "THAT CAN'T BE RIGHT - ENTER A ")) (GO CLLP)))
(COND
((FOR NEW
PR
IN
CL
OR
(OR (ATOM PR)
(NOT (NUMBERP (CDR PR)))
(NOT (ATOM (CAR PR)))
(NOT
(OR (NUMBERP (GET (CAR PR) (QUOTE VALENCE)))
(PROG2 (TERPRI)
(PRINC (QUOTE "WHAT'S THE VALENCE OF "))
(PRINC (CAR PR))
(PRINC (QUOTE ?))
(NUMBERP (PUTPROP (CAR PR) (READ) (QUOTE VALENCE))))))))
(GO CLLP)))
ULP (PRINT (QUOTE U?))
(COND ((NOT (NUMBERP (SETQ U (READ)))) (GO ULP)))
(SETQ RESULTS (RINGS U CL))
(PRINT (LIST (LENGTH RESULTS) (QUOTE STRUCTURES) (QUOTE GENERATED)))))
EXPR)
(DEFPROP DRAW
(LAMBDA(N)
(PROG (S)
(COND ((GREATERP N (LENGTH RESULTS)) (PRINT (QUOTE (NOT THAT MANY STRUCTURES -- TRY AGAIN!!!))))
((STRUCTURE? (SETQ S (CAR (NTH RESULTS N)))) (DRAWS S NIL))
(T (SETQ TITLE (LIST (QUOTE STRUCTURE#) N)) (PRINRAD S)))))
EXPR)
(DEFPROP LABELLER
(LAMBDA NIL
(PROG (CL U)
CLLP (TERPRI)
(PRINC (QUOTE "ATOMS TO BE LABELLED?"))
(SETQ CL (READ))
(COND ((ATOM CL) (PRINC (QUOTE "THAT CAN'T BE RIGHT - ENTER A ")) (GO CLLP)))
(COND
((FOR NEW
PR
IN
CL
OR
(OR (ATOM PR)
(NOT (NUMBERP (CDR PR)))
(NOT (ATOM (CAR PR)))
(NOT
(OR (NUMBERP (GET (CAR PR) (QUOTE VALENCE)))
(PROG2 (TERPRI)
(PRINC (QUOTE "WHAT'S THE VALENCE OF "))
(PRINC (CAR PR))
(PRINC (QUOTE ?))
(NUMBERP (PUTPROP (CAR PR) (READ) (QUOTE VALENCE))))))))
(GO CLLP)))
ULP (PRINT (QUOTE U?))
(COND ((NOT (NUMBERP (SETQ U (READ)))) (GO ULP)))
(SETQ RESULTS (MOLECULES CL U))
(PRINT (LIST (LENGTH RESULTS) (QUOTE STRUCTURES) (QUOTE GENERATED)))))
EXPR)