;;;; -*- Scheme -*-
;;
;; Utilities to support Gunk programs
;;
;; David DeRoure, Sep 11 1997
;; dder@martigny.ai.mit.edu
;;
;; This is an extension of club5d.scm (see HLSIM documentation).
;; It consists of procedures to support Gunk code executing
;; during the simulation, together with procedures to help
;; set up the simulation.  This file should be compiled.
;; NB These two classes of utilities will probably be separated
;; in the future, as Gunk libraries are developed.

;;;;;;;;;;;;;;;;;;
;;
;; club5d.scm
;;

;; Simulation creation and display for club5

(declare (usual-integrations))

(define (make-sim/1 n r)
  (let ((x (make-initialized-vector n (lambda (i) i (random 1.0))))
	(y (make-initialized-vector n (lambda (i) i (random 1.0))))
	(z (make-vector n 0.0)))
    (let ((neighbours (point-neighbours x y z r)))
      (let ((sim (%make-simulation)))
	(do ((i 0 (+ i 1))) ((= i n))
	  (simulation.add-processor sim))
	(set-simulation.x! sim x)
	(set-simulation.y! sim y)
	(set-simulation.z! sim z)
	(set-simulation.neighbours! sim neighbours)
	sim))))


(define (simulation.display! sim flag)
  (define (make-display)
    (let ((g  (make-graphics-device)))
      (graphics-operation g 'set-foreground-color "white")
      (graphics-operation g 'set-background-color "black")
      (graphics-set-coordinate-limits g -.01 -.01 1.01 1.01)
      (graphics-clear g)
      g))
  (set-simulation.display!
   sim
   (cond ((not flag)  #F)
	 ((graphics-device? flag) flag)
	 (else (make-display)))))
      
(define (%color-me sim i color)
  (define d 0.007)
  (define colors '#("blue" "orange" "yellow" "green" "cyan"
		    "magenta" "pink"))

  (let ((g (simulation.display sim)))

    (define (draw color)
      (let ((x (vector-ref (simulation.x sim) i))
	    (y (vector-ref (simulation.y sim) i)))
	(graphics-operation g 'set-foreground-color color)
	(graphics-draw-text g x y ".")))

    (cond ((not g) unspecific)
	  ((string? color)
	   (draw color))
	  ((exact-integer? color)
	   (if (and (<= 0 color)
		    (< color (vector-length colors)))
	       (draw (vector-ref colors color))
	       (draw "white")))
	  (else
	   (error:wrong-type-argument color "color string"
				      'color-me)))))


;;;;;;;;;;;;;;;;;;;;;;;;
;;
;; These extra routines assist simulation setup

;; simulation.find-processor-nearest is a useful library routine
;; which searches an existing simulation for the processor closest
;; to the given coordinates.

(define (simulation.find-processor-nearest sim x y #!optional z)
  (define (sq x) (* x x))
  (let ((z (if (default-object? z) 0 z))
	(x-vector (simulation.x sim))
	(y-vector (simulation.y sim))
	(z-vector (simulation.z sim))
	(r2-min 1e99)   ; the smallest square of distance found (start > 3)
	(min-i #F))     ; index of the processor at r2-min (else #F)
    (do ((i 0 (+ i 1))) ((= i (simulation.n-processors sim)))
      (let ((r2 (+ (sq (- x (vector-ref x-vector i)))
		   (sq (- y (vector-ref y-vector i)))
		   (sq (- z (vector-ref z-vector i))))))
	(if (< r2 r2-min)
	    (begin
	      (set! min-i i)
	      (set! r2-min r2)))))
    min-i))

;; simulation.find-processors-in-region is a useful library routine which 
;; searches an existing simulation for all the processors which satisfy a 
;; predicate (specified as a function of the processor coordinates).
;; NB An alternative approach to specifying arbitrary regions is to use
;; a drawing package to produce a PNM image for the HLSIM sensor facility.

(define (simulation.find-processors-in-region sim in-region?)
  (let ((x-vector (simulation.x sim))
	(y-vector (simulation.y sim))
	(z-vector (simulation.z sim))
	(n (simulation.n-processors sim)))
    (let loop ((i 0) (result '()))
	 (cond ((= i n) result)
	       ((in-region? (vector-ref x-vector i)
			    (vector-ref y-vector i)
			    (vector-ref z-vector i)) 
		(loop (1+ i) (cons i result)))
	       (else (loop (1+ i) result))))))

;; The make-circle-predicate procedure returns a predicate for use in
;; simulation.find-processors-in-region.  The predicate describes a
;; circular region with origin at (x, y) and radius r (excluding points
;; with radius equal to r).  For example, to find processors in a circle
;; centered at (0.5, 0.5) with radius 0.1, use
;; (simulation.find-processors-in-region sim (make-circle-predicate .5 .5 .1))

(define (make-circle-predicate x0 y0 r)
  (let ((sq (lambda (a) (* a a)))
	(r2 (* r r)))
       (lambda (x y z)
	       (< (+ (sq (- x x0)) (sq (- y y0))) r2))))
	
;; Alternative version of make-sim/1, with variable neighborhood density.
;; The f argument should be a function which maps reals generated by
;; (random 1.0) to values in the same range, e.g. using expt.  If no f 
;; argument is supplied, it defaults to sqrt.  This function can be
;; generalised to take the vector initialization functions as arguments,
;; in wich case the coordinates of each processor could be a function of 
;; the processor index.

(define (make-sim/f n r #!optional f)
  (let ((f (if (default-object? f) sqrt f)))
    (let ((x (make-initialized-vector n (lambda (i) i (f (random 1.0)))))
	  (y (make-initialized-vector n (lambda (i) i (f (random 1.0)))))
	  (z (make-vector n 0.0)))
      (let ((neighbours (point-neighbours x y z r)))
	(let ((sim (%make-simulation)))
	  (do ((i 0 (+ i 1))) ((= i n))
	    (simulation.add-processor sim))
	  (set-simulation.x! sim x)
	  (set-simulation.y! sim y)
	  (set-simulation.z! sim z)
	  (set-simulation.neighbours! sim neighbours)
	  sim)))))

;; Make jiggly simulation.  The j argument is the jigglyness, 0 <= j < 1
;; If no j argument is supplied, it defaults to 0.5 (which gives a jiggly
;; but visibly uniform distribution).  j=0 => no random component.
;; NB If n is not a square number, n processors will still be created,
;; but there will be gaps in the grid near the top right.

(define (make-sim/j n r #!optional j)
  (let ((j (if (default-object? j) 0.5 j))
	(d (ceiling (sqrt n))) ; number of divisions on axes of unit square
	(x (make-vector n))
	(y (make-vector n))
	(z (make-vector n 0.0)))
    (let loop ((p-i 0) (x-i 0) (y-i 0))
      (cond ( (= p-i n) 'done )
	    ( (= x-i d) (loop p-i 0 (1+ y-i)) )
	    ( else (vector-set! x p-i (/ (+ x-i (* j (random 1.0))) d))
		   (vector-set! y p-i (/ (+ y-i (* j (random 1.0))) d))
		   (loop (1+ p-i) (1+ x-i) y-i) )))
    ;; remaining code is identical to make-sim/1
    (let ((neighbours (point-neighbours x y z r)))
      (let ((sim (%make-simulation)))
	(do ((i 0 (+ i 1))) ((= i n))
	  (simulation.add-processor sim))
	(set-simulation.x! sim x)
	(set-simulation.y! sim y)
	(set-simulation.z! sim z)
	(set-simulation.neighbours! sim neighbours)
	sim))))

;; Make constrained simulation, where all processors satisfy the
;; constraint predicate c?, a function of the number of neighbors.
;; If no constraint is provided, it constructs a simulation where
;; all processors have more than two neighbors (a "clumpy" simulation).
;; NB This procedure simply iterates until the constraint is satisfied, 
;; with no limit to the number of iterations.  

(define (make-sim/c n r #!optional c?) 
  (let ((c? (if (default-object? c?) (lambda (n) (> n 1)) c?))
	(x (make-initialized-vector n (lambda (i) i (random 1.0))))
	(y (make-initialized-vector n (lambda (i) i (random 1.0))))
	(z (make-vector n 0.0)))

    (let loop ((neighbours (point-neighbours x y z r)) (tries 1))

      (define (count-rejects i rejects)
	(cond ((= i n) rejects)
	      ((c? (vector-length (vector-ref neighbours i)))
		   (count-rejects (1+ i) rejects))
	      (else (vector-set! x i (random 1.0))
		    (vector-set! y i (random 1.0))
		    (count-rejects (1+ i) (1+ rejects)))))
      
	(if (zero? (count-rejects 0 0))
	    (let ((sim (%make-simulation)))
	      (do ((i 0 (+ i 1))) ((= i n))
		(simulation.add-processor sim))
	      (set-simulation.x! sim x)
	      (set-simulation.y! sim y)
	      (set-simulation.z! sim z)
	      (set-simulation.neighbours! sim neighbours)
	      sim)
	    (loop (point-neighbours x y z r) (1+ tries))))))

;; end of util1d.scm