(define smash-count 8) (define smash-scale-factor 0.5) (define smash-minimum 0.2) (define (smash-kick) (vector (- (flxrnd) 0.5) 1 (- (flxrnd) 0.5))) (collisions 1) (gravity (vector 0 -1 0)) (ground-plane (vector 0 1 0) 0) (define (smash-sub n p sz) (if (< n 1) (list) (cons (let ((s (build-sphere 15 15))) (begin (push) (grab s) (colour (vector 1 1 1)) (scale (vector sz sz sz)) (translate p) (translate (vector (flxrnd) (flxrnd) (flxrnd))) (ungrab) (pop) (active-sphere s) (set-mass s (* sz sz sz)) (kick s (smash-kick)) (list s sz) )) (smash-sub (- n 1) p sz))) ) (define (smash b) (if (< (head (tail b)) smash-minimum) (list) (let ((smashed (list))) (grab (head b))(let ((pos (vtransform (vector 0 0 0) (get-transform)))) (ungrab) (set! smashed (smash-sub smash-count pos (* smash-scale-factor (head (tail b))))) ) (destroy (head b)) smashed )) ) (define (make-balls count) (if (< count 1) (list) (begin (let ((s (build-sphere 15 15))) (begin (push) (grab s) (colour (vector 1 1 1)) (scale (vector 1 1 1)) (translate (vector (* 10 (- (flxrnd) 0.5)) (* 10 (+ (flxrnd) 0.5)) (* 10 (- (flxrnd) 0.5)))) (active-sphere s) (set-mass s 1) (ungrab) (pop) (cons (list s 1) (make-balls (- count 1))) )) )) ) (define (update bs) (if (empty? bs) (list) (if (has-collided (head (head bs))) (append (smash (head bs)) (update (tail bs))) (cons (head bs) (update (tail bs))) ) ) ) (define balls 0) (set! balls (make-balls 10)) (every-frame (set! balls (update balls)))