#lang racket/gui
(require (planet williams/simulation/simulation))
(require (planet williams/science/math))
(define F 100.0) (define p-life 5000.0) (define-values (n-min n-max) (values 20 40))
(define-values (x-min x-max) (values -1000.0 1000.0))
(define-values (y-min y-max) (values -1000.0 1000.0))
(define-values (v-min v-max) (values -1.0 1.0))
(define n 0) (define k #f) (define p #f) (define x #f) (define y #f) (define dx/dt #f) (define dy/dt #f) (define pen #f)
(define-process (particle i)
(let ((death-time (+ (current-simulation-time) (random-flat 0.0 p-life))))
(vector-set! p i self)
(vector-set! dx/dt i (make-continuous-variable (random-flat v-min v-max)))
(vector-set! dy/dt i (make-continuous-variable (random-flat v-min v-max)))
(vector-set! x i (make-continuous-variable (random-flat x-min x-max)))
(vector-set! y i (make-continuous-variable (random-flat y-min y-max)))
(work/continuously
until (>= (current-simulation-time) death-time)
(let ((xi (variable-value (vector-ref x i)))
(yi (variable-value (vector-ref y i)))
(x-dot 0.0)
(y-dot 0.0))
(for ((ii (in-range n)))
(when (and (not (= ii i))
(vector-ref p ii))
(let* ((xii (variable-value (vector-ref x ii)))
(yii (variable-value (vector-ref y ii)))
(r2 (max 100.0
(+ (sqr (- xii xi)) (sqr (- yii yi))))))
(set! x-dot (+ x-dot (/ (* (sign (- xii xi)) F) r2)))
(set! y-dot (+ y-dot (/ (* (sign (- yii yi)) F) r2))))))
(set-variable-dt! (vector-ref dx/dt i) x-dot)
(set-variable-dt! (vector-ref dy/dt i) y-dot)
(set-variable-dt! (vector-ref x i) (variable-value (vector-ref dx/dt i)))
(set-variable-dt! (vector-ref y i) (variable-value (vector-ref dy/dt i)))))
(vector-set! p i #f)
(set-variable-value! k (+ (variable-value k) 1))))
(define (run-simulation)
(break-enabled #t)
(with-new-simulation-environment
(begin-busy-cursor)
(send run-button enable #f)
(send (send canvas get-dc) clear)
(random-source-randomize! (current-random-source))
(current-simulation-step-size 1.0)
(current-simulation-control #f)
(set! n (+ n-min (random-uniform-int (- n-max n-min))))
(send gauge set-range n)
(send gauge set-value 0)
(set! k (make-variable 0))
(monitor after (set-variable-value! k v)
(send gauge set-value v))
(set! p (make-vector n #f))
(set! x (make-vector n))
(set! y (make-vector n))
(set! dx/dt (make-vector n))
(set! dy/dt (make-vector n))
(set! pen (build-vector
n
(lambda (i)
(new pen%
(color (make-object color%
(random 256) (random 256) (random 256)))))))
(for ((i (in-range n)))
(schedule #:now (particle i)))
(current-simulation-monitor
(lambda ()
(when (check-for-break)
(stop-simulation))
(let ((dc (send canvas get-dc)))
(for ((i (in-range n)))
(when (vector-ref p i)
(let-values (((sx sy) (model-coords->screen-coords
(variable-value (vector-ref x i))
(variable-value (vector-ref y i)))))
(send dc set-pen (vector-ref pen i))
(send dc draw-point sx sy)))))
(yield)))
(start-simulation)
(send run-button enable #t)
(end-busy-cursor)))
(define-values (WIDTH HEIGHT) (values 800 600))
(define (model-coords->screen-coords x y)
(values (* WIDTH (/ (- x x-min) (- x-max x-min)))
(* HEIGHT (/ (- y y-min) (- y-max y-min)))))
(define frame
(instantiate frame%
("Interacting Particles")
(x 0)
(y 0)))
(define canvas
(instantiate canvas%
(frame)
(min-width WIDTH)
(min-height HEIGHT)))
(define gauge
(instantiate gauge%
("Progress" n-max frame)))
(define run-button
(instantiate button%
("Run" frame
(lambda (b e)
(run-simulation)))))
(send frame show #t)