 (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))))
