You can observe the following code in a separate window.
(setq s2 (sqrt 2.0))
(setq s3 (sqrt 3.0))
(defun c:fractet ()
(setq
t1 '(0 0 0)
t2 '(1 0 0)
t3 (list 0.5 (/ s3 2.0) 0)
t4 (list 0.5 (/ 1.0 (* 2 s3)) (/ s2 s3))
)
(command "3dface" t1 t3 t2 "" "")
(command "3dface" t1 t2 t4 "" "")
(command "3dface" t1 t4 t3 "" "")
(command "3dface" t2 t3 t4 "" "")
(setq number 4)
(newthing t1 t3 t2 number (/ s3 2.0))
(newthing t1 t2 t4 number (/ s3 2.0))
(newthing t3 t1 t4 number (/ s3 2.0))
(newthing t3 t4 t2 number (/ s3 2.0))
)
(defun newthing (p1 p2 p3 n height / p4 p4proj)
;note that p4proj is the average of p1 p2 & p3
(cond ((< n 0) nil)(t
(setq sum (mapcar '+ p1 p2 p3) p4proj (mapcar '/ sum '(3.0 3.0 3.0))
u (mapcar '- p2 p1) v (mapcar '- p3 p1)
cp (crossprod u v)
magnitude-of-cp (distance cp '(0 0 0))
unit-normal (mapcar '/ cp (list magnitude-of-cp magnitude-of-cp magnitude-of-cp))
height-vector (mapcar '* unit-normal (list height height height))
p4 (mapcar '+ p4proj height-vector)
)
;shrink it abount center of base [p4proj]
(setq p1 (avpoint p1 p4proj) p2 (avpoint p2 p4proj) p3 (avpoint p3 p4proj) p4 (avpoint p4 p4proj))
;draw faces
(command "3dface" p2 p4 p3 "" "")
(command "3dface" p1 p2 p4 "" "")
(command "3dface" p1 p4 p3 "" "")
;here we will recur
(newthing p1 p3 p2 (1- n) (/ height 2.0) )
(newthing p1 p2 p4 (1- n) (/ height 2.0) )
(newthing p3 p1 p4 (1- n) (/ height 2.0) )
(newthing p3 p4 p2 (1- n) (/ height 2.0) )
)))
(defun det (a d b c)(- (* a d)(* b c)));determinate
(defun crossprod (u v);cross product
(list (det (cadr u)(caddr v)
(caddr u)(cadr v))
(- (det (car u)(caddr v)
(caddr u)(car v)))
(det (car u)(cadr v)
(cadr u)(car v))
))
(defun avpoint (p q)(mapcar '/ (mapcar '+ p q) '(2.0 2.0 2.0)))
;(defun c:t ()(c:fractet));quick alias
|