1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
|
(defun srand ()
(let ((r (tan (random 0.79))))
(setq r (* r r))
(if (= (random 2) 0) (- r) r)))
(defun meteor1 (n)
(let ((p (float-vector 0 0)))
(dotimes (i n)
(setf (aref p 0) (srand)
(aref p 1) (srand))
(send *viewer* :draw-point-ndc p)
; (xflush)
))))
(defun meteor2 (n)
(let ((p (float-vector 0 0)) r ang (p3 (float-vector 1 2 0)))
(dotimes (i n)
(setq ang (random 2pi))
(setq r (abs (srand)))
(setf (aref p 0) (* r (cos ang))
(aref p 1) (* r (sin ang)))
(setq r (random 1.000))
(cond ((> r 0.990)
(send *viewer* :draw-star-ndc p))
((< r 0.02)
(send *viewer* :draw-fill-arc-ndc p r r
0.0 2pi))
(t (send *viewer* :draw-point-ndc p)))
; (xflush)
))))
(defun reflection-ray (normal light)
(normalize-vector
(v- (scale (* 2.0 (v. normal light)) normal)
light) ))
(defun random-direction (dir ratio)
(v+ dir (random-vector ratio)))
(defun dod (dod n &optional (speed 30.0))
(let ((bx (make-bounding-box (list #f(-500 -500 -500) #f(500 500 500))))
(dir (float-vector 0 1 0)) p ix ref)
(send *viewsurface* :function 6)
(send *viewing* :look-body (send bx :body))
(hidd (send bx :body))
(dotimes (i n)
(draw dod)
(setq dir (random-direction dir 0.1))
(send dod :translate (scale speed dir) :world)
(send dod :rotate (random 0.1) dir)
(draw dod)
(unless (send bx :inner (setq p (send dod :worldpos)))
(setq ix (maxindex p))
(setq ref (elt #(#f(1 0 0) #f(0 1 0) #f(0 0 1)) ix))
(setq ref (copy-seq ref))
(if (> (aref p ix) 0) (scale -1.0 ref ref))
(setq dir (reflection-ray ref (scale -1.0 dir)))]
(x:bell x:disp)
(draw dod)
(send dod :translate (scale speed dir) :world)
(draw dod))
(unix:usleep 10000))))
|
