;;; -*- Mode:Common-Lisp; Package:TV; Base:10 -*-
;;;
;;;
;;; points
;;;
;;; 15 November 1989 pz@hx.lcs.mit.edu, with Steve Ward.
;;;
;;; (c) 1989 J. S. Pezaris, All Rights Reserved.


(pushnew 'points tv:*screen-saver-hacks-list*)

(defvar point-vector '())
(defvar xarray '())
(defvar yarray '())

(defun init-arrays (xlim ylim)
  (setq xarray (make-array 1024 :element-type 'integer))
  (setq yarray (make-array 1024 :element-type 'integer))
  (loop for i from 0 to 1023 do
	(setf (svref xarray i) (floor (/ (* xlim i) 1024)))
	(setf (svref yarray i) (floor (/ (* ylim i) 1024))))
  )

(defsubst screen-map (x array)
  (svref array (lsh (logand (+ x #x7FFF) #xFFFF) -6)))


(defstruct point
  (x 0)
  (y 0)
  )

(defvar x1 10000)
(defvar y1 10000)


(defsubst fixit (x)
  (if (minusp x)
      (let ((y (logior x #x7f0000)))
	(case (type-of y)
	  (fixnum y)
	  (t (if (minusp y)
		 (- (mod y #xffffff))
		 #xffffff
		 ))))
      (logand x #xFFFFFF)))

(defmacro circle (x y xsh ysh)
  `(progn
     (setq ,x (fixit (- ,x (ash ,y ,xsh))))
     (setq ,y (fixit (+ ,y (lsh ,x ,ysh))))))

(defvar state 0)

(defvar mod1 -2)
(defvar mod2 -2)

(defsubst new-position (p)
  (circle x1 y1 mod1 mod2)

  (when (zerop 5000)
    (case (random 4)
      (0 (setq mod1 (- (mod (1+ mod1) 11) 5)))
      (1 (setq mod1 (- (mod (1- mod1) 11) 5)))
      (2 (setq mod2 (- (mod (1+ mod2) 11) 5)))
      (3 (setq mod2 (- (mod (1- mod2) 11) 5)))
      ))

  (when (zerop (random 1000))
    (setq x1 (fixit (+ x1 (- 1000 (random 2000)))))
    (setq y1 (fixit (+ y1 (- 1000 (random 2000)))))
    )

  (when (zerop (random 5000))
    (setq state (random 4)))

  (case state
    (0 (setf (point-x p) x1)
       (setf (point-y p) y1))
    (1 (setf (point-x p) y1)
       (setf (point-y p) x1))
    (2 (setf (point-x p) (- x1))
       (setf (point-y p) (- y1)))
    (3 (setf (point-x p) (- y1))
       (setf (point-y p) (- x1)))
    (t (setq state 0)))

  )



(defun points (&optional ignore (n 1000) (reset? '()))

  (setq x1 50000)
  (setq y1 10000)
  
  (setq mod1 -1)
  (setq mod2 -1)
  
  (let* ((screen (tv:main-screen-and-who-line))
	 (dims (array-dimensions screen))
	 (xlim (cadr dims))
	 (ylim (car dims)))
    
    (if (or reset?
	    (null xarray)
	    (null yarray))
	(init-arrays xlim ylim))

    (if (or reset?
	    (null point-vector)
	    (not (= (length point-vector)
		    n)))
	(setq point-vector
	      (apply #'vector (loop repeat n collecting
				    (make-point :x (random 1000) :y (random 1000))))))
    
    (loop while t do
	  (map '()
	       #'(lambda (this-point)
		   (setf (aref screen
			       (screen-map (point-y this-point) yarray)
			       (screen-map (point-x this-point) xarray))
			 0)

		   (new-position this-point)
		     
		   (setf (aref screen
			       (screen-map (point-y this-point) yarray)
			       (screen-map (point-x this-point) xarray))
			 1)
		   )
	       point-vector))
    )
  )