Galton box animation: Difference between revisions
Content added Content deleted
(→Perl 6: use an animated gif instead of a static screenshot.) |
|||
Line 1,348: | Line 1,348: | ||
Next |
Next |
||
Repeat: eventLoop(): ForEver</lang> |
Repeat: eventLoop(): ForEver</lang> |
||
=={{header|Racket}}== |
|||
This does not use the default #lang racket. Required is advanced student with teachpacks universe and image. |
|||
<lang Racket> |
|||
;a ball's position...row is a natural number and col is an integer where 0 is the center |
|||
(define-struct pos (row col)) |
|||
;state of simulation...list of all positions and vector of balls (index = bin) |
|||
(define-struct st (poss bins)) |
|||
;given list of indices, increment those by 1 |
|||
(define (vector-inc-indices! is v) |
|||
(let vector-inc-indices ([is is]) |
|||
(if (null? is) |
|||
v |
|||
(begin (vector-set! v (car is) (add1 (vector-ref v (car is)))) |
|||
(vector-inc-indices (cdr is)))))) |
|||
(define BALL-RADIUS 6) |
|||
;for balls to fit perfectly between diamond-shaped pins, the side length is |
|||
;determined by inscribing the diamond in the circle |
|||
(define PIN-SIDE-LENGTH (* (sqrt 2) BALL-RADIUS)) |
|||
;ultimate pin width and height |
|||
(define PIN-WH (* 2 BALL-RADIUS)) |
|||
(define PIN-HOR-SPACING (* 2 PIN-WH)) |
|||
;vertical space is the height of an equilateral triangle with side length = PIN-HOR-SPACING |
|||
(define PIN-VER-SPACING (* 1/2 (sqrt 3) PIN-HOR-SPACING)) |
|||
;somewhat copying BASIC256's graphics |
|||
;determines how thick the outline will be |
|||
(define FILL-RATIO 0.7) |
|||
;freeze is a function that converts the drawing code into an actual bitmap forever |
|||
(define PIN (freeze (overlay (rotate 45 (square (* FILL-RATIO PIN-SIDE-LENGTH) "solid" "purple")) |
|||
(rotate 45 (square PIN-SIDE-LENGTH "solid" "magenta"))))) |
|||
(define BALL (freeze (overlay (circle (* FILL-RATIO BALL-RADIUS) "solid" "green") |
|||
(circle BALL-RADIUS "solid" "dark green")))) |
|||
(define BIN-COLOR (make-color 255 128 192)) |
|||
;# balls bin can fit |
|||
(define BIN-CAPACITY 10) |
|||
(define BIN-HEIGHT (* BIN-CAPACITY PIN-WH)) |
|||
(define BIN (freeze (beside/align "bottom" |
|||
(line 0 BIN-HEIGHT BIN-COLOR) |
|||
(line PIN-WH 0 BIN-COLOR) |
|||
(line 0 BIN-HEIGHT BIN-COLOR)))) |
|||
(define draw-background |
|||
(let ([background #f]) |
|||
(λ (height) |
|||
(if (image? background) |
|||
background |
|||
(let* ([w (+ (image-width BIN) (* PIN-HOR-SPACING height))] |
|||
[h (+ PIN-WH (image-height BIN) (* PIN-VER-SPACING height))] |
|||
[draw-background (λ () (rectangle w h "solid" "black"))]) |
|||
(begin (set! background (freeze (draw-background))) background)))))) |
|||
;draws images using x horizontal space between center points |
|||
(define (spaced/x x is) |
|||
(if (null? is) |
|||
(empty-scene 0 0) |
|||
(let spaced/x ([n 1] [i (car is)] [is (cdr is)]) |
|||
(if (null? is) |
|||
i |
|||
(overlay/xy i (* -1 n x) 0 (spaced/x (add1 n) (car is) (cdr is))))))) |
|||
(define (draw-pin-row r) (spaced/x PIN-HOR-SPACING (make-list (add1 r) PIN))) |
|||
;draws all pins, using saved bitmap for efficiency |
|||
(define draw-pins |
|||
(let ([bmp #f]) |
|||
(λ (height) |
|||
(let ([draw-pins (λ () (foldl (λ (r i) (overlay/align/offset |
|||
;vertically line up all pin rows |
|||
"center" "bottom" (draw-pin-row r) |
|||
;shift down from the bottom of accum'ed image by ver spacing |
|||
0 (- PIN-VER-SPACING) i)) |
|||
(draw-pin-row 0) (range 1 height 1)))]) |
|||
(if (image? bmp) |
|||
bmp |
|||
(begin (set! bmp (freeze (draw-pins))) bmp)))))) |
|||
(define (draw-ball p i) |
|||
;the ball starts at the top of the image |
|||
(overlay/align/offset "center" "top" BALL (* -1 (pos-col p) PIN-WH) (* -1 (pos-row p) PIN-VER-SPACING) i)) |
|||
;bin has balls added from bottom, stacked exactly on top of each other |
|||
;the conditional logic is needed because above can't handle 0 or 1 things |
|||
(define (draw-bin n) |
|||
(if (zero? n) |
|||
BIN |
|||
(overlay/align "center" "bottom" |
|||
(if (= n 1) BALL (apply above (make-list n BALL))) |
|||
BIN))) |
|||
;main drawing function |
|||
(define (draw height s) |
|||
(let* ([bins (spaced/x PIN-HOR-SPACING (map draw-bin (vector->list (st-bins s))))] |
|||
;pins above bins |
|||
[w/pins (above (draw-pins height) bins)] |
|||
;draw this all one ball diameter (PIN-WH) below top |
|||
[w/background (overlay/align/offset "center" "top" w/pins |
|||
0 (- PIN-WH) (draw-background height))]) |
|||
;now accumulate in each ball |
|||
(foldl draw-ball w/background (st-poss s)))) |
|||
;a ball moves down by increasing its row and randomly changing its col by -1 or 1 |
|||
(define (next-row height p) |
|||
(make-pos (add1 (pos-row p)) |
|||
(+ -1 (* 2 (random 2)) (pos-col p)))) |
|||
;each step, every ball goes to the next row and a new ball is added at the top center |
|||
;balls that fall off go into bins |
|||
(define (tock height s) |
|||
(let* ([new-ps (map (λ (p) (next-row height p)) (st-poss s))] |
|||
;live balls haven't gone past the last row of pins |
|||
[live (filter (λ (p) (< (pos-row p) height)) new-ps)] |
|||
;dead balls have (partition from normal Racket would be useful here...) |
|||
[dead (filter (λ (p) (>= (pos-row p) height)) new-ps)] |
|||
;map col to bin index |
|||
[bin-indices (map (λ (p) (quotient (+ (pos-col p) height) 2)) dead)]) |
|||
;add a new ball to the live balls |
|||
(make-st (cons (make-pos 0 0) live) |
|||
;sum dead ball positions into bins |
|||
(vector-inc-indices! bin-indices (st-bins s))))) |
|||
;run simulation with empty list of positions to start, stepping with "tock" and drawing with "draw" |
|||
(define (run height) |
|||
(big-bang (make-st '() (make-vector (add1 height) 0)) |
|||
(on-tick (λ (ps) (tock height ps)) 0.5) |
|||
(to-draw (λ (ps) (draw height ps))))) |
|||
</lang> |
|||
=={{header|Ruby}}== |
=={{header|Ruby}}== |