;;;
;;; school
;;;
;;; A screen saver which displays a school of fish.
;;;
;;; jsp 28-May-89 (pz@mit.edu)
;;;
;;; Copyright (c) John S. Pezaris 1989, 2000.  All rights reserved.
;;;
;;; pz.


(define *graphics-device*   '())
(define *graphics-scale*    500)
(define *n-fish*            20)
(define *fish-list*         '())
(define *reset?*            '())
(define *x-lim*             500)
(define *y-lim*             500)


;;; make-fish
;;;
;;; Constructor for our fishes.  An fish will be a tagged list of values.

(define (make-fish x-pos y-pos x-vel y-vel) 
  (list 'fish x-pos y-pos x-vel y-vel '() 0))


;;; fish selectors
;;;
;;; Allows us to pull out each of the component values.

(define (fish-pxl       v) (/ v *graphics-scale*))
(define (fish-x-pos     f) (list-ref f 1))
(define (fish-y-pos     f) (list-ref f 2))
(define (fish-x-vel     f) (list-ref f 3))
(define (fish-y-vel     f) (list-ref f 4))
(define (fish-neighbors f) (list-ref f 5))
(define (fish-num       f) (list-ref f 6))

(define (fish-x-pos!     f v) (set-car! (list-tail f 1) v))
(define (fish-y-pos!     f v) (set-car! (list-tail f 2) v))
(define (fish-x-vel!     f v) (set-car! (list-tail f 3) v))
(define (fish-y-vel!     f v) (set-car! (list-tail f 4) v))
(define (fish-neighbors! f v) (set-car! (list-tail f 5) v))
(define (fish-num!       f v) (set-car! (list-tail f 6) v))


;;; fish-distance
;;;
;;; Compute the distance between two fishes.  Uses the 
;;; normal Cartesian formula.

(define (fish-distance f1 f2)
  (sqrt (+ (square (- (fish-x-pos f2) (fish-x-pos f1)))
	   (square (- (fish-y-pos f2) (fish-y-pos f1))))))



;;; accumulate
;;;
;;; The standard function.

(define (accumulate combiner null-val term lst)
  (if (null? lst)
      null-val
      (combiner (term (car lst))
		(accumulate combiner null-val term (cdr lst)))))


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

(define (step-fish f)

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

  ;; calculate new velocities
  (fish-x-vel! f (+ -0.5 (random 1.0)
		    (/ (+ (fish-x-vel f)
			  (fish-x-vel f)
			  (accumulate + 0 fish-x-vel (fish-neighbors f))
		       (+ 2 (length (fish-neighbors f)))))))
  (fish-y-vel! f (+ -0.5 (random 1.0)
		    (/ (+ (fish-y-vel f)
			  (fish-y-vel f)
			  (accumulate + 0 fish-y-vel (fish-neighbors f))
		       (+ 2 (length (fish-neighbors f)))))))

  (if (< 5 (abs (fish-x-vel f))) (fish-x-vel! f (* 0.9 (fish-x-vel f))))
  (if (< 5 (abs (fish-y-vel f))) (fish-y-vel! f (* 0.9 (fish-y-vel f))))

  )




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

(define (check-fish f)
  (let ((max-x *x-lim*)
	(max-y *y-lim*))
    (cond ((< max-x (fish-x-pos f))
	   (fish-x-pos! f max-x)
	   (fish-x-vel! f (- (fish-x-vel f)))))
    (cond ((< max-y (fish-y-pos f))
	   (fish-y-pos! f max-y)
	   (fish-y-vel! f (- (fish-y-vel f)))))
    (cond ((< (fish-x-pos f) (- max-x))
	   (fish-x-pos! f (- max x))
	   (fish-x-vel! f (- (fish-x-vel f)))))
    (cond ((< (fish-y-pos f) (- max-y))
	   (fish-y-pos! f (- max-y))
	   (fish-y-vel! f (- (fish-y-vel f)))))
    ))



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

(define (draw-fish f)
  
  ;; Erase old image
  (graphics-operation *graphics-device* 'set-foreground-color "white")
  (graphics-draw-line *graphics-device*
		      (fish-pxl (- (fish-x-pos f) (* 5 (fish-x-vel f))))
		      (fish-pxl (- (fish-y-pos f) (* 5 (fish-y-vel f))))
		      (fish-pxl (+ (fish-x-pos f) (* 5 (fish-x-vel f))))
		      (fish-pxl (+ (fish-y-pos f) (* 5 (fish-y-vel f)))))

  ;; Increment fish
  (step-fish f)
  (check-fish f)
  
  ;; Draw new image
  (graphics-operation *graphics-device* 'set-foreground-color "blue")
  (graphics-draw-line *graphics-device*
		      (fish-pxl (- (fish-x-pos f) (* 5 (fish-x-vel f))))
		      (fish-pxl (- (fish-y-pos f) (* 5 (fish-y-vel f))))
		      (fish-pxl (+ (fish-x-pos f) (* 5 (fish-x-vel f))))
		      (fish-pxl (+ (fish-y-pos f) (* 5 (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. 

(define (create-fish x y)
  (make-fish (+ -100.0 x (random 200.0))
	     (+ -100.0 y (random 200.0))
	     (/ (+ -5.0 (random 10.0)) 1.0)
	     (/ (+ -5.0 (random 10.0)) 1.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.

(define (hack-fish f n-fish)
  (cond ((= 0 (random 20))
	 (if (= 0 (random 2))
	     (and (fish-neighbors f)
		  (fish-neighbors! f (cdr (fish-neighbors f)))))
	 (if (= 0 (random 2))
	     (fish-neighbors! f (cons (list-ref *fish-list* (random n-fish))
				      (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. 

(define (school)
  
  ;; insure that we have a window to display things
  (if (null? *graphics-device*)
      (set! *graphics-device* (make-graphics-device 'x)))

  ;; and run the simulation!
  (graphics-clear *graphics-device*)

  ;; Initialize list of fishes?
  (if (or *reset?*
	  1
	  (null? *fish-list*)
	  (not (= *n-fish* (length *fish-list*))))
      (let ((x-pos 0)
	    (y-pos 0))
	(set! *fish-list* (accumulate cons
				      nil
				      (lambda (x) (create-fish x-pos y-pos))
				      (make-list *n-fish*)))
	(let loop ((i 1)
		   (f-list *fish-list*))
	  (cond ((null? f-list) nil)
		(else
		 (fish-num! (car f-list) i)
		 (loop (inc i) (cdr f-list)))))
	))
    
  ;; Set neighbor relations
  (let loop ((f-list *fish-list*))
    (cond ((null? f-list) nil)
	  (else
	   (fish-neighbors! (car f-list)
			    (map (lambda (x) (list-ref *fish-list* (random *n-fish*)))
				 (make-list (+ 2 (random 3)))))
	   (loop (cdr f-list)))))
				
  ;; Simulate!
  (let loop ((i 1000))
    (cond ((= i 0) nil)
	  (else
	   (map (lambda (f)
		  (draw-fish f)
		  (hack-fish f *n-fish*))
		*fish-list*)
	   (loop (dec i)))))
    
  )