perm filename CYCDR2[1,LMM] blob sn#033101 filedate 1973-04-04 generic text, type T, neo UTF8
(SPECIAL (QUOTE (LABELL LINE NLN NMX LLN TITLE STACK RA REALWIDTH 
                 REALBOT REALEFT REALHEIGHT XBOT XSCL YBOT YSCL)))
  (DE FINDNDS (RA RI)
      (PROG (X1 X2 X3 L1)
        F   (FOR NEW I := (1 NMX)
             DO (STORE (NODEARRAY I) 0)
                (STORE (NODEARRAY (PLUS 20 I)) 0))
            (SETND (CAAAR LINE) (QUOTE (15 . 15)))
            (SETQ STACK (LIST 0 LINE))
            (SETQ L1 NIL)
            (SETQ X3 T)
        C   (SETQ X1 (CAR LINE))
            (SETQ X2 (CDAR X1))
            (COND ((ZEROP (NODEARRAY X2)) NIL)
                  ((RTLIN RI X1 L1) (GO B))
                  (T (GO A)))
            (COND (X3 (STKNDS X2 L1)))
        A   (SETQ X3 (CAR STACK))
            (SETQ STACK (CDR STACK))
            (COND ((ATOM X3) (GO D)))
            (SETND (CADR X3) (CAR X3))
            (COND ((RTLIN RI X1 L1) (GO G)))
            (SETND (CADR X3) (QUOTE (0 . 0)))
            (GO A)
       NXT  (SETQ L1 (CONS X1 L1))
            (SETQ LINE (CDR LINE))
            (SETQ X3 T)
            (COND (LINE (GO C))
                  (T (RETURN NIL)))
      G     (SETQ STACK (CONS NIL (CONS LINE (CONS L1 STACK))))
            (GO NXT)
      B     (SETQ STACK (CONS NIL (CONS (CONS (CAR L1) LINE)
                                        (CONS (CDR L1) STACK))))
            (GO NXT)
      D     (SETQ LINE (CAR STACK))
            (SETQ L1 (CADR STACK))
            (SETQ STACK (CDDR STACK))
            (SETQ X1 (CAR LINE))
            (COND ((NULL STACK) (GO E)))
            (COND (X3 (SETND X3 (QUOTE (0 . 0)))))
            (COND ((ATOM (CAR STACK)) (GO A)))
            (STORE (NODEARRAY (CADAR STACK)) 0)
            (SETQ X3 NIL)
            (GO C)
       E    (SETQ RA (ADD1 RA))
            (COND ((GREATERP RA 3) (SETQ RI T)))
            (GO F)))
  (DE STKNDS (X L1)
      (PROG (X1 XMN XMX YMN YMX N1 N2)
       (COND ((NULL L1)
         (SETQ STACK (CONS X (CONS (CONS NIL LINE) (CONS NIL STACK)))))
       (T(SETQ STACK (CONS X (CONS (CONS (CAR L1) LINE)(CONS (CDR L1) STACK))))))
       (SETQ XMN 0)
       (SETQ XMX 100)
       (SETQ YMN 0)
       (SETQ YMX 100)
       (COND ((LESSP (LENGTH STACK) 6)
               (PROG2 (SETQ XMN 16) (SETQ YMN 15))))
       (FOR X1 IN (CONNARRAY X)
         AS N1 IS (NODEARRAY X1)
         IF (NOT (ZEROP N1))
         AS N2 IS (NODEARRAY (*PLUS X1 20))
             DO (SETQ XMN (MAX XMN (*DIF N1 RA)))
                (SETQ XMX (MIN XMX (*PLUS N1 RA)))
                (SETQ YMN (MAX YMN (*DIF N2 RA)))
                (SETQ YMX (MIN YMX (*PLUS N2 RA))))
       (COND ((OR (*GREAT XMN XMX) (*GREAT YMN YMX)) (RETURN NIL)))
       (SETQ X1 NIL)
       (FOR N1 := (XMN XMX)
         FOR N2 := (YMN YMX)
          WHEN (FOR NEW I :=(1 NMX) AND (NOT (AND (EQUAL N1 (NODEARRAY I))
				      (EQUAL N2(NODEARRAY(*PLUS I 20))))))
               DO(SETQ X1 T)
                 (SETQ STACK (CONS (LIST (CONS N1 N2) X)
                                   STACK)))
       (RETURN X1)))))))