perm filename MKIMAG.LSP[LSP,BGB]1 blob
sn#041583 filedate 1973-05-15 generic text, type T, neo UTF8
(SETQ IBASE (ADD1 7))
(DEFPROP ALLFNS
(NIL NONZEROP IPFACE POTENT VISIBL TEST TYPE MKIMAG)
VALUE)
(DEFPROP NONZEROP
(LAMBDA (N) (NULL (EQ N 0)))
EXPR)
(DEFPROP IPFACE
(LAMBDA(EDGE)
(COND ((TEST (PFACE EDGE) POTENT) (PFACE EDGE))
((TEST (NFACE EDGE) POTENT) (NFACE EDGE))
(T (ERROR (QUOTE (NO VISIBLE FACE AT IPFACE))))))
EXPR)
[DE SETPOS(VERTEX)
(PROG()
(XWC/. (ALT VERTEX)(XWC VERTEX))
(YWC/. (ALT VERTEX)(YWC VERTEX))
(ZWC/. (ALT VERTEX)(ZWC VERTEX))]
(DEFPROP POTENT
(NIL . 20000000)
VALUE)
(DEFPROP VISIBL
(NIL . 40000000)
VALUE)
(DEFPROP TEST
(LAMBDA (NODE BIT) (NONZEROP (BOOLE 1 (TYPE NODE) BIT)))
EXPR)
(DEFPROP TYPE
(LAMBDA (NODE) (EXAMINE NODE))
EXPR)
(DEFPROP MKIMAG
(LAMBDA NIL
(PROG (T1 T2 T3)
(SETQ IMAGE (MKB WORLD))
(SETQ T1 (PFACE WORLD))
(WHILE (NONZEROP T1) (PROG NIL (ALT/. T1 (MKF IMAGE)) (SETQ T1 (ALT2 T1))))
(SETQ T1 (PED WORLD))
(PRINQ *** FACES MADE ***)
(WHILE (NONZEROP T1) (PROG NIL (ALT/. T1 0) (ALT/. (PVT T1) 0) (ALT/. (NVT T1) 0) (SETQ T1 (ALT2 T1))))
(PRINQ *** ALT LINKS CLEARED ***)
(SETQ T1 (PED WORLD))
(WHILE (NONZEROP T1)
(PROG NIL
(PRINC T1)
(TYO 40)
(COND ((NONZEROP (ALT T1)))
((NONZEROP (ALT (PVT T1)))
(COND ((NONZEROP (ALT (NVT T1)))
(ALT/. T1 (MKFE (PVT T1) (ALT (IPFACE T1)) (NVT T1))))
(T
(PROG NIL
(ALT/. (NVT T1) (MKEV (ALT (IPFACE T1)) (ALT T1)))
(SETPOS (NVT T1))
(ALT/. T1 (PED (ALT (PVT T1))))))))
(T
(PROG NIL
(PRINQ (NEW VERTEX))
(ALT/. (PVT T1) (MKV IMAGE))
(SETPOS (PVT T1))
(COND ((NONZEROP (ALT (NVT T1)))
(PROG NIL (MKFE (ALT (IPFACE T1)) (ALT (PVT T1)))))
(T
(PROG NIL
(ALT/. (NVT T1) (MKEV (ALT (IPFACE T1)) (ALT (PVT T1))))
(SETPOS (NVT T1))
(ALT/. T1 (PED (ALT (PVT T1))))))))))
(SETQ T1 (ALT2 T1))))))
EXPR)