;;; -*- Mode:Common-Lisp; Package:TV; Base:10 -*-
;;;
;;; spin
;;;
;;; Yet another screen saver.
;;;
;;; jsp 21-April-89
;;;
;;; (C) Copyright 1989 John S. Pezaris.  All rights reserved.


;;; To install SPIN onto the list of possible screen-savers, we evaluate the next line:
(eval-when (load)
  (push 'spin *screen-saver-hacks-list*))


(defstruct (particle (:print-function print-particle))
  (x-pos 0)
  (y-pos 0)
  (z-pos 0)
  (x-vel 0)
  (y-vel 0)
  (z-vel 0)
  (phase 0)
  (freq  0)
  (magnitude 0)
  (size  10)
  (dead  t)
  )

(defun print-particle (p ignore ignore)
  (format t "<Psi  (~s, ~s, ~s) [~s, ~s, ~s] phase: ~s  freq: ~s  mag: ~s  dead: ~s>"
	  (particle-x-pos p) (particle-y-pos p) (particle-z-pos p)
	  (particle-x-vel p) (particle-y-vel p) (particle-z-vel p)
	  (particle-phase p) (particle-freq  p)
	  (particle-magnitude p) (particle-dead p)))


;;; *particles* and *free-parts*
;;;
;;; These two lists contain the objects for the system.  *particles* contains all of the projectiles being
;;; simulated.  *free-parts* contains a subset of *particles*, specifically all projectiles which are
;;; currently idle (not being simulated or displayed).

(defvar *particles* '())

(defvar *free-parts* '())


;;; find-unused-part
;;;
;;; This returns an idle part, if any are available, by popping one off of the *free-parts* list.

(defsubst find-unused-particle ()
  (pop *free-parts*))


;;; kill-particle
;;;
;;; This kills a particle by setting the particle-dead field, and pushes it onto the free list.

(defsubst kill-particle (p)
  (setf (particle-dead p) t)
  (push p *free-parts*)
  )


;;; new-particle
;;;
;;; This attempts to create a new projectile for simulation.  If one is available, it sets the
;;; initial parameters which have been empiracly chosen to provide a pleasing display on a full
;;; screen window.  It returns the new particle.

(defun new-particle (x y)
  (let ((p (find-unused-particle)))
    (setf (particle-x-pos p) (random x))
    (setf (particle-y-pos p) (random y))
    (setf (particle-z-pos p) 0.1)
    (setf (particle-x-vel p) (- 1.0 (random 0.5)))
    (setf (particle-y-vel p) (- 1.0 (random 0.5)))
    (setf (particle-z-vel p) (random 0.100))
    (setf (particle-phase p) 0)
    (setf (particle-size  p) 10)
    (setf (particle-freq  p) (/ (- 100 (random 200)) 1000))
    (setf (particle-magnitude p) (+ 50 (random 200)))
    (setf (particle-dead p) '())
    p))



;;; project

(defsubst project (x z m)
  (floor (+ (* m (- 1 (/ 1 z)))
	    (/ x z)))

  )

;;; scale

(defun scale (s z &optional (fudge? '()))
  (if fudge?
      (floor (- (+ (/ s z)
		   (random 0.5))
		1))
      (floor (/ s z))))


;;; spin
;;;
;;; This is the main simulation function.  It cycles indefinitely through the active works list
;;; *particles* simulating each in turn.  Figures are computed with integers (fixnums or
;;; bignums) with a false scaling factor of 1000.  This is because computing with integers
;;; combined with the necessary scaling is much faster than computing with floating-points and
;;; converting into integers.  The actual scaling factor is 1024, which makes normalization
;;; simple.  Particles are drawn as squares (much faster than arbitrary glyphs).

(defun spin (&optional (stream *terminal-io*))
  (let* ((processor-name (si:get-processor-name))
	 (processor-type (cond ((equal processor-name "Explorer I")  0)
			       ((equal processor-name "Explorer II") 1))))
    (send stream :clear-screen)
    (if (null *particles*)
	(case processor-type
	  (0 (setq *particles* (loop repeat 6 collecting (make-particle))))
	  (1 (setq *particles* (loop repeat 16 collecting (make-particle))))))
    (setq *free-parts* '())
    (loop for p in *particles* do (kill-particle p))
    
    (let ((x-lim) (y-lim)
	  (x-lim/2) (y-lim/2))
      
      (multiple-value-setq (x-lim y-lim)
	(send stream :inside-size))

      (setq x-lim/2 (/ x-lim 2)
	    y-lim/2 (/ y-lim 2))

      (loop do
	    
	    (loop for p in *particles* do
		  (if (particle-dead p)
		      (new-particle x-lim y-lim)
		      (let* ((old-x     (particle-x-pos  p))
			     (old-y     (particle-y-pos  p))
			     (old-z     (particle-z-pos  p))
			     (old-phase (particle-phase  p))
			     (old-size  (scale (particle-size  p) old-z))
			     
			     (magnitude (particle-magnitude p))
			     (phase     (incf (particle-phase p) (particle-freq p)))
			     
			     (old-x*    (floor (+ old-x (* magnitude (cos old-phase)))))
			     (old-y*    (floor (+ old-y (* magnitude (sin old-phase)))))
			     
			     (x-pos     (incf (particle-x-pos p) (particle-x-vel p)))
			     (y-pos     (incf (particle-y-pos p) (particle-y-vel p)))
			     (z-pos     (incf (particle-z-pos p) (particle-z-vel p)))
			     
			     (x-pos*    (floor (+ x-pos (* magnitude (cos phase)))))
			     (y-pos*    (floor (+ y-pos (* magnitude (sin phase)))))
			     
			     (x-pix     (project x-pos z-pos x-lim/2))
			     (y-pix     (project y-pos z-pos x-lim/2))

			     (size      (scale (particle-size p) z-pos t))
			     )

			;; And draw it
			(tv:prepare-sheet (stream)
			  ;; Erase old image
			  (sys:%draw-rectangle
			    old-size old-size
			    (project old-x* old-z x-lim/2)
			    (project old-y* old-z y-lim/2)
			    tv:alu-setz stream)

			  ;; If alive, then display new image.
			  (if (and (< x-pos (+ magnitude x-lim))
				   (< (- magnitude) x-pos)
				   (< y-pos (+ magnitude y-lim))
				   (< (- magnitude) y-pos)
				   (< 0 old-size))
			      
			      (sys:%draw-rectangle
				size size
				(project x-pos* z-pos x-lim/2)
				(project y-pos* z-pos y-lim/2)
				tv:alu-seta stream)

			      ;; If expired, then kill projectile.
			      (kill-particle p)))
			
			)
		      
		      )
		  )
	    )
      )
    ))