club5d.scm

 

(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 ((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 ((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)))))