(DEFPROP EXPLAINFNS
 (EXPLAINFNS STAR
	     HORIZONTALFLAG
	     CURLYCIRCLE
	     BONDING
	     DRAW2NODES
	     EXPLAINATIONMOLECULES
	     PRINCL
	     EXPLAIN
	     EXPLAINGENMOL
	     EXPLAINRINGS
	     COLLNUMLIST
	     EXPLAINSTRUCWAT
	     EXPLAINRINGSKEL
	     EXPLAINATTACFVS
	     EXPLAINNOFV
	     EXPLAINNOLOOP
	     EXPLAINCAT
	     EXPLAINATTBIV
	     EXPLAINKLOOP
	     EXPLAINBVL
	     (SETQ EXPLAINALL NIL)
	     (DEFLIST (QUOTE
		       ((GENMOL EXPLAINGENMOL)
			(RINGS EXPLAINRINGS)
			(STRUCTURESWITHATOMS EXPLAINSTRUCWAT)
			(RINGSKELETONS EXPLAINRINGSKEL)
			(ATTACHFVS EXPLAINATTACFVS)
			(NOFV-RINGS EXPLAINNOFV)
			(NOLOOPEDRINGS EXPLAINNOLOOP)
			(CATALOG EXPLAINCAT)
			(ATTACHBIVALENTS EXPLAINATTBIV)
			(KLOOPEDRINGS EXPLAINKLOOP)
			(ATTACHBIVS&LOOPS EXPLAINBVL)
			(MOLECULES EXPLAINATIONMOLECULES)
			(VALENTNODE STAR)))
		      (QUOTE EXPLAINATION)))
VALUE)

(DEFPROP STAR
 (LAMBDA(N)
  (CONS	(QUOTE NOSCALE)
	(SELECTQ N
		 (0. (HELP))
		 (1. (QUOTE (STREAM (0. . 0.) (0. . 20.))))
		 (2. (QUOTE (STREAMLIST (STREAM (0. . 0.) (-14. . 20.)) (STREAM (0. . 0.) (14. . 20.)))))
		 (3.
		  (QUOTE
		   (STREAMLIST (STREAM (0. . 0.) (-14. . 20.))
			       (STREAM (0. . 0.) (0. . 20.))
			       (STREAM (0. . 0.) (14. . 20.)))))
		 (4.
		  (QUOTE
		   (STREAMLIST (STREAM (0. . 0.) (-14. . 20.))
			       (STREAM (0. . 0.) (7. . 20.))
			       (STREAM (0. . 0.) (-7. . 20.))
			       (STREAM (0. . 0.) (14. . 20.)))))
		 (HELP))))
EXPR)

(DEFPROP HORIZONTALFLAG
 (HORIZONTALFLAG)
VALUE)

(DEFPROP CURLYCIRCLE
 (LAMBDA (PIC) (BOX PIC))
EXPR)

(DEFPROP BONDING
 (LAMBDA(X)
  (SELECTQ X
	   (0. (QUOTE +))
	   (1. (QUOTE -))
	   (2. (QUOTE =))
	   (3. (QUOTE ≡))
	   (T (READLIST (LIST (QUOTE /") (QUOTE -) X (QUOTE -/"))))))
EXPR)

(DEFPROP DRAW2NODES
 (LAMBDA (NODE1 BOND NODE2) (TEXTNODE THE-TEXT = (LIST NODE1 (BONDING BOND) NODE2)))
EXPR)

(DEFPROP EXPLAINATIONMOLECULES
 (LAMBDA (CL U) (BOX (PRINCL (CONS (CONS (QUOTE U) U) CL))))
EXPR)

(DEFPROP PRINCL
 (LAMBDA(CL)
  (PROG	(EXPLAINLIST RSLT FOUNDFLAG)
	(SETQ RSLT
	      (TEXTNODE
	       THE-TEXT
	       =
	       (FOR NEW
		    X
		    IN
		    CL
		    AS
		    NEW
		    NUMITEMS
		    IS
		    (CDR X)
		    AS
		    NEW
		    ITEM
		    IS
		    (COND ((ATOM (CAR X)) (CAR X))
			  ((AND (ATOM (CAAR X)) (NOT (CDAR X))) (CAAR X))
			  ((AND (ATOM (CAAR X)) (GET (CAAR X) (QUOTE VALENCE)))
			   (HELP HERE)
			   (CONCAT (CAAR X) (PRINCL2 (CDAR X))))
			  (T (SETQ EXPLAINLIST
				   (CONS (CONS (MAKELOCATION
						(PROG (OH)
						      (SETQ OH HORIZONTALFLAG)
						      (RETURN
						       (PROG (HORIZONTALFLAG)
							     (SETQ HORIZONTALFLAG (NOT OH))
							     (RETURN (EXPLAIN (CAR X)))))))
					       NUMITEMS)
					 EXPLAINLIST))
			     NIL))
		    WHEN
		    ITEM
		    NCONC
		    (SETQ FOUNDFLAG T)
		    (CONS ITEM (COND ((LESSP NUMITEMS 2.) NIL) (T (LIST DOWNVEC NUMITEMS UPVEC)))))))
	(COND ((NULL FOUNDFLAG) (SETQ RSLT NIL)))
	(RETURN
	 (COND ((NULL EXPLAINLIST) RSLT)
	       (T (LINEUP (COND (RSLT (CONS RSLT (CLEXPAND EXPLAINLIST))) (T (CLEXPAND EXPLAINLIST)))))))))
EXPR)

(DEFPROP EXPLAIN
 (LAMBDA(FORM)
  (COND	((STRUCLIST? FORM) (DRAWLIS (CDDR FORM)))
	((STRUCFORM? FORM)
	 (COND ((GET (CADR FORM) (QUOTE EXPLAINATION))
		(APPLY (GET (CADR FORM) (QUOTE EXPLAINATION)) (CDDR FORM)))
	       (T (BOX (DRAWTEXT (CDR FORM))))
	       (T (HELP "NO EXPLAINATION AVAILABLE" (CADR FORM)))))
	((STRUCTURE? FORM) (DRAWSTRUC FORM))
	((RADICAL? FORM) (DRAWRAD FORM))
	(T (ERR (PRINT (QUOTE ???)) (QUOTE ERRORX)))))
EXPR)

(DEFPROP EXPLAINGENMOL
 (LAMBDA (CL) (PRINCL CL))
EXPR)

(DEFPROP EXPLAINRINGS
 (LAMBDA(U CL)
  (COND	((EQUAL (CLCOUNT CL) 2.) (SETQ CL (CLEXPAND CL)) (DRAW2NODES (CAR CL) (ADD1 U) (CADR CL)))
	(T (CURLYCIRCLE (PRINCL CL)))))
EXPR)

(DEFPROP COLLNUMLIST
 (LAMBDA(X)
  (PROGN (SETQ X (REVERSE X))
	 (PROG (LST RES)
	       (SETQ RES (LIST (SETQ LST (CAR X))))
	       (FOR X
		    ON
		    (CDR X)
		    AS
		    NEW
		    FLG
		    IS
		    NIL
		    DO
		    (FOR X ON X WHILE (EQ (CAR X) (SETQ LST (ADD1 LST))) DO (SETQ FLG (CAR X)))
		    (COND (FLG (NCONC1 RES "-") (NCONC1 RES FLG)))
		    (COND (X (NCONC1 RES ",") (NCONC1 RES (SETQ LST (CAR X))))))
	       (RETURN (LIST (APPLY (QUOTE CONCAT) RES))))))
EXPR)

(DEFPROP EXPLAINSTRUCWAT
 (LAMBDA(CLL STRUC)
  (ABOVE (PRINCL
	  (PROGN (COMMENT (FOR NEW X IN CLL APPEND X))
		 (PROG (FOR-VALUE LIST*X X)
		       (SETQ LIST*X CLL)
		  LOOP*1
		       (COND ((NOT LIST*X) (GO RETURN)))
		       (SETQ X (CAR LIST*X))
		       (SETQ FOR-VALUE (NCONC FOR-VALUE (APPEND X NIL)))
		  NEXT*1
		  NEXT*X
		       (SETQ LIST*X (CDR LIST*X))
		       (GO LOOP*1)
		  RETURN
		       (RETURN FOR-VALUE))))
	 (EXPLAIN STRUC)))
EXPR)

(DEFPROP EXPLAINRINGSKEL
 (LAMBDA(FV VL)
  (CURLYCIRCLE
   (PRINCL
    (PROGN (COMMENT
	    (FOR NEW
		 X
		 IN
		 VL
		 AS
		 NEW
		 I
		 :=
		 (2. INFINITY)
		 WHEN
		 (NOT (ZEROP X))
		 LIST
		 FIRST
		 (COND (FV (LIST (CONS (QUOTE FV) FV))) (T NIL))
		 (CONS (LIST (QUOTE FORM) (QUOTE VALENTNODE) I) X)))
	   (PROG (FOR-VALUE I LIST*X X)
		 (SETQ FOR-VALUE (COND (FV (LIST (CONS (QUOTE FV) FV))) (T NIL)))
		 (SETQ LIST*X VL)
		 (SETQ I 2.)
	    LOOP*1
		 (COND ((NOT LIST*X) (GO RETURN)))
		 (SETQ X (CAR LIST*X))
		 (COND ((ZEROP X) (GO NEXT*I)))
		 (SETQ FOR-VALUE (NCONC FOR-VALUE (LIST (CONS (LIST (QUOTE FORM) (QUOTE VALENTNODE) I) X))))
	    NEXT*1
	    NEXT*I
		 (SETQ I (PLUS I 1.))
	    NEXT*X
		 (SETQ LIST*X (CDR LIST*X))
		 (GO LOOP*1)
	    RETURN
		 (RETURN FOR-VALUE))))))
EXPR)

(DEFPROP EXPLAINATTACFVS
 (LAMBDA(FVL STRUC)
  (ABOVE (PRINCL
	  (FOR NEW
	       FVR
	       IN
	       FVL
	       AS
	       NEW
	       VALNODE
	       :=
	       (2. INFINITY)
	       FOR
	       NEW
	       FVI
	       IN
	       FVR
	       AS
	       NEW
	       NUMFV
	       :=
	       (1. 42129.)
	       WHEN
	       (NOT (ZEROP FVI))
	       LIST
	       (CONS (FVVALENTNODE VALNODE NUMFV) FVI)))
	 (EXPLAIN STRUC)))
EXPR)

(DEFPROP EXPLAINNOFV
 (LAMBDA (FV) (CURLYCIRCLE (EXPLAINVL FV)))
EXPR)

(DEFPROP EXPLAINNOLOOP
 (LAMBDA (VL) (CIRCLE (EXPLAINVL VL)))
EXPR)

(DEFPROP EXPLAINCAT
 (LAMBDA (TVL) (EXPLAINNOLOOP (CONS 0. VL)))
EXPR)

(DEFPROP EXPLAINATTBIV
 (LAMBDA(BVP STRUC)
  (ABOVE (PRINCL (FOR NEW PR IN BVP WHEN (NOT (ZEROP (CAR PR))) LIST (CONS (BIVLIST (CAR PR)) (CDR PR))))
	 (EXPLAIN STRUC)))
EXPR)

(DEFPROP EXPLAINKLOOP
 (LAMBDA (K VL) (ABOVE (TEXT (CONS K (QUOTE LOOPS))) (CIRCLE (EXPLAINVL VL))))
EXPR)

(DEFPROP EXPLAINBVL
 (LAMBDA(BVP LPP STRUC)
  (ABOVE (PRINCL
	  (FOR NEW
	       VLPP
	       IN
	       LPP
	       AS
	       NEW
	       NV
	       :=
	       (2. INFINITY)
	       FOR
	       NEW
	       PR
	       IN
	       VLPP
	       LIST
	       (CONS (COND ((EQ (CLCOUNT (CAR PR)) 1.) (SINGLELOOP (CAAAR PR) NV))
			   (T (MUTTIPLELOOP (CAR PR) NV)))
		     (CDR PR))))
	 (EXPLAINATTBIV BVP STRUC)))
EXPR)

(SETQ EXPLAINALL NIL)

(DEFLIST (QUOTE
	  ((GENMOL EXPLAINGENMOL)
	   (RINGS EXPLAINRINGS)
	   (STRUCTURESWITHATOMS EXPLAINSTRUCWAT)
	   (RINGSKELETONS EXPLAINRINGSKEL)
	   (ATTACHFVS EXPLAINATTACFVS)
	   (NOFV-RINGS EXPLAINNOFV)
	   (NOLOOPEDRINGS EXPLAINNOLOOP)
	   (CATALOG EXPLAINCAT)
	   (ATTACHBIVALENTS EXPLAINATTBIV)
	   (KLOOPEDRINGS EXPLAINKLOOP)
	   (ATTACHBIVS&LOOPS EXPLAINBVL)
	   (MOLECULES EXPLAINATIONMOLECULES)
	   (VALENTNODE STAR)))
	 (QUOTE EXPLAINATION))