;;; -*- Mode:Common-Lisp; Package:TV; Base:10 -*-
;;;
;;; school
;;;
;;; A screen saver which displays a school of fish.
;;;
;;; jsp 28-May-89 (pz@hx.lcs.mit.edu)
;;;
;;; (c) John S. Pezaris 1989.  All rights reserved.



;;; Some initialization stuff.  Make sure the proper font is loaded, and place ourselves on the
;;; list of screen savers, if necessary.

(unless (boundp 'fonts:fishes)
  (load "sys:fonts;fishes" :verbose nil))

(defvar *fishes-font* fonts:fishes)

(pushnew 'school *screen-saver-hacks-list*)



;;; fish
;;;
;;; The data structure for simulation.  Includes the standard two-dimensional position and velocity fields,
;;; as well as a character number (dependent upon the velocities, as computed by COMPUTE-FISH-GLYPH), and
;;; a dependency list for velocity determination.

(defstruct (fish (:print-function print-fish))
  (num   0)
  (x-pos 0)
  (y-pos 0)
  (x-vel 0)
  (y-vel 0)
  (glyph  0)
  (neighbors '())
  )


(defun print-fish (f ignore ignore)
  (format t "<Fish ~d (~s, ~s) [~s, ~s] #s"
	  (fish-num f)
	  (fish-x-pos f) (fish-y-pos f)
	  (fish-x-vel f) (fish-y-vel f))
  (loop for ff in (fish-neighbors f) do (format t " ~d" (fish-num ff)))
  (format t ">")
  )



;;; *fish-list*
;;;
;;; The definition of the list of simulation objects.

(defvar *fish-list* '())




;;; step-fish
;;;
;;; The increment of the simulation.  Update the positions, and then peruse the dependency links to
;;; compute the new velocities.

(defun step-fish (f)

  ;; increment position
  (incf (fish-x-pos f) (fish-x-vel f))
  (incf (fish-y-pos f) (fish-y-vel f))

  ;; calculate new velocities
  (setf (fish-x-vel f)
	(+ -1.0 (random 2.0)
	   (/ (+ (fish-x-vel f) (fish-x-vel f)
		 (loop for ff in (fish-neighbors f) summing (fish-x-vel ff)))
	      (+ 2 (length (fish-neighbors f))))))

  (setf (fish-y-vel f)
	(+ -1.0 (random 2.0)
	   (/ (+ (fish-y-vel f) (fish-y-vel f)
		 (loop for ff in (fish-neighbors f) summing (fish-y-vel ff)))
	      (+ 2 (length (fish-neighbors f))))))

  (if (>= (abs (fish-x-vel f)) 10) (setf (fish-x-vel f) (* 0.9 (fish-x-vel f))))
  (if (>= (abs (fish-y-vel f)) 10) (setf (fish-y-vel f) (* 0.9 (fish-y-vel f))))

  (compute-fish-glyph f)

  )



;;; fish-distance
;;;
;;; Computes the cartesian distance between fishes A and B.

(defun fish-distance (a b)
  (let ((x (- (fish-x-pos a) (fish-x-pos b)))
	(y (- (fish-y-pos a) (fish-y-pos b))))
    (sqrt (+ (* x x) (* y y)))))



;;; try
;;;
;;; A small function to debug the fish glyphs.

(defun try ()
  (let ((stream *terminal-io*)
	(f (make-fish)))
    (setf (fish-x-pos f) 100)
    (setf (fish-y-pos f) 100)
    (setf (fish-x-vel f) 0.0)
    (setf (fish-y-vel f) 0.0)
    (loop while t do
	  (let ((x (tyi)))
	    ;; Erase old image
	    (tv:prepare-sheet (stream)
	      (sys:%draw-character *fishes-font* (fish-glyph f) 9
				   (x-pix f) (y-pix f)
				   tv:alu-setz stream))
	    (case x
	      (11 (incf (fish-y-vel f) 1.0))
	      (1  (decf (fish-y-vel f) 1.0))
	      (25 (incf (fish-x-vel f) 1.0))
	      (24 (decf (fish-x-vel f) 1.0))))

	  (if (zerop (fish-x-vel f))
	      (if (plusp (fish-y-vel f))
		  (format t "+")
		  (format t "-"))
	      (format t "~3d" (/ (fish-y-vel f) (fish-x-vel f))))

	  (compute-fish-glyph f)
	  ;; Draw new image
	  (tv:prepare-sheet (stream)
	    (sys:%draw-character *fishes-font* (fish-glyph f) 9		; draw new fish
				 (x-pix f) (y-pix f)
				 tv:alu-seta stream))
	  )))





;;; compute-fish-glyph
;;;
;;; This computes a new glyph number (from the font in pz:fonts;fishes.xld) depending on the direction
;;; of the combined velocity vector.

(defun compute-fish-glyph (f)
  (setf (fish-glyph f)
	(if (zerop (fish-x-vel f))
	    (if (plusp (fish-y-vel f))
		7
		21)
	    (let ((slope (/ (fish-y-vel f) (fish-x-vel f))))
	      (if (or (plusp slope) (zerop slope))
		  (if (plusp (fish-y-vel f))
		      
		      ;; x and y positive
		      (cond ((= 0 slope) 28)
			    ((and (<= 0.00 slope) (<= slope 0.11))  0)
			    ((and (<= 0.11 slope) (<= slope 0.33)) 27)
			    ((and (<= 0.33 slope) (<= slope 0.55)) 26)
			    ((and (<= 0.55 slope) (<= slope 1.08)) 25)
			    ((and (<= 1.08 slope) (<= slope 1.87)) 24)
			    ((and (<= 1.87 slope) (<= slope 3.37)) 23)
			    ((and (<= 3.37 slope) (<= slope 6.00)) 22)
			    (t 21))
		      
		      ;; x and y negative
		      (cond ((= 0 slope) 28)
			    ((and (<= 0.00 slope) (<= slope 0.11)) 14)
			    ((and (<= 0.11 slope) (<= slope 0.33)) 13)
			    ((and (<= 0.33 slope) (<= slope 0.55)) 12)
			    ((and (<= 0.55 slope) (<= slope 1.08)) 11)
			    ((and (<= 1.08 slope) (<= slope 1.87)) 10)
			    ((and (<= 1.87 slope) (<= slope 3.37))  9)
			    ((and (<= 3.37 slope) (<= slope 6.00))  8)
			    (t 7))
		      
		      )
		  
		  (progn
		    (setq slope (abs slope))
		    (if (plusp (fish-y-vel f))
			
			;; x neg, y pos
			(cond ((= 0 slope) 28)
			      ((and (<= 0.00 slope) (<= slope 0.11)) 14)
			      ((and (<= 0.11 slope) (<= slope 0.33)) 15)
			      ((and (<= 0.33 slope) (<= slope 0.55)) 16)
			      ((and (<= 0.55 slope) (<= slope 1.08)) 17)
			      ((and (<= 1.08 slope) (<= slope 1.87)) 18)
			      ((and (<= 1.87 slope) (<= slope 3.37)) 19)
			      ((and (<= 3.37 slope) (<= slope 6.00)) 20)
			      (t 21))
			
			;; x pos, y neg
			(cond ((= 0 slope) 28)
			      ((and (<= 0.00 slope) (<= slope 0.11))  0)
			      ((and (<= 0.11 slope) (<= slope 0.33))  1)
			      ((and (<= 0.33 slope) (<= slope 0.55))  2)
			      ((and (<= 0.55 slope) (<= slope 1.08))  3)
			      ((and (<= 1.08 slope) (<= slope 1.87))  4)
			      ((and (<= 1.87 slope) (<= slope 3.37))  5)
			      ((and (<= 3.37 slope) (<= slope 6.00))  6)
			      (t 7))
			
			)))))
	
	))




;;; *x-lim* and *y-lim*
;;;
;;; Two specials which are determined at runtime to set the limits of x and y coordinate values.

(defvar *x-lim* 0)
(defvar *y-lim* 0)



;;; x-pix and y-pix
;;;
;;; Two functions which transform an x-pos or y-pos field value into a valid pixel value.

(defun x-pix (f)
  (min *x-lim* (max 0 (floor (fish-x-pos f)))))

(defun y-pix (f)
  (min *y-lim* (max 0 (floor (fish-y-pos f)))))



;;; draw-fish
;;;
;;; This erases the old image, computes the increment, checks for boundary conditions, and displays the
;;; new image.

(defun draw-fish (f stream)
  
  ;; Erase old image
  (tv:prepare-sheet (stream)
    (sys:%draw-character *fishes-font* (fish-glyph f) 9		; erase
			 (x-pix f) (y-pix f)
			 tv:alu-setz stream))
  ;; Increment fish
  (step-fish f)
  (check-fish f)
  
  ;; Draw new image
  (tv:prepare-sheet (stream)
    (sys:%draw-character *fishes-font* (fish-glyph f) 9		; draw new fish
			 (x-pix f) (y-pix f)
			 tv:alu-seta stream))
  )



;;; check-fish
;;;
;;; This insures a fish is within the limits of the screen, making it bounce as it hits walls.

(defun check-fish (f &optional (max-x *x-lim*) (max-y *y-lim*))
  (when (>= (fish-x-pos f) max-x)
    (setf (fish-x-pos f) max-x)
    (setf (fish-x-vel f) (* -1 (fish-x-vel f))))
  (when (>= (fish-y-pos f) max-y)
    (setf (fish-y-pos f) max-y)
    (setf (fish-y-vel f) (* -1 (fish-y-vel f))))
  (when (>= 0 (fish-x-pos f))
    (setf (fish-x-pos f) 0)
    (setf (fish-x-vel f) (* -1 (fish-x-vel f))))
  (when (>= 0 (fish-y-pos f))
    (setf (fish-y-pos f) 0)
    (setf (fish-y-vel f) (* -1 (fish-y-vel f))))
  )



;;; create-fish
;;;
;;; This conses up a new fish object with various initializations for position clustering around a given center.
;;; Initial velocities are random.

(defun create-fish (x y)
  (make-fish :x-pos (+ -100.0 x (random 200.0))
	    :y-pos (+ -100.0 y (random 200.0))
	    :x-vel (/ (+ -5.0 (random 10.0)) 10.0)
	    :y-vel (/ (+ -5.0 (random 10.0)) 10.0)
	    ))



;;; hack-fish
;;;
;;; This is used to insure that there is some dynamism in the school by making random alterations in the
;;; neighbor-dependency lists.

(defun hack-fish (f n-fishes)

  ;; Disturb the dependency list
  (when (zerop (random 70))
    (if (zerop (random 2))
	(pop (fish-neighbors f)))
    (if (zerop (random 2))
	(pushnew (nth (random n-fishes) *fish-list*) (fish-neighbors f))))
  )



;;; school
;;;
;;; This is the top-level function.  It clears the screen, optionally creates a new list of simulation fishes,
;;; initializes neightbor relations, and simulates.

(defun school (&optional (stream *terminal-io*) (n-fishes 20) (reset? nil))
  
  (send stream :clear-screen)

  (multiple-value-bind (xlim ylim)
      (send stream :inside-size)
    
    ;; adjust for glyph sizes
    (decf xlim 10)
    (decf ylim 10)

    ;; set the global values
    (setq *x-lim* xlim)
    (setq *y-lim* ylim)
    
    ;; Initialize list of fishes?
    (if (or reset?
	    (null *fish-list*)
	    (not (= n-fishes (length *fish-list*))))
	(let ((x-pos (random *x-lim*))
	      (y-pos (random *y-lim*)))
	  (setq *fish-list* (loop repeat n-fishes collecting (create-fish x-pos y-pos)))
	  (loop for i from 0
		and f in *fish-list* do
		(setf (fish-num f) i))))
    
    ;; Set neighbor relations
    (loop for f in *fish-list* do
	  (setf (fish-neighbors f)
		(loop repeat (+ 2 (random 1)) collecting (nth (random n-fishes) *fish-list*))))    
    
    ;; Simulate!
    (loop while t do
	  (loop for f in *fish-list* do
		(draw-fish f stream)
		(hack-fish f n-fishes)
		))
    
    )
  )