Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- #lang racket
- (require 2htdp/image)
- (require 2htdp/universe)
- ;; structure used
- (struct crcl (radius color))
- ;; constants
- (define SIZE 500)
- (define COUNT 5)
- (define CENTER (/ SIZE 2))
- (define RADIUS (/ (* SIZE (sqrt 1/2)) COUNT))
- (define FPS 60)
- (define STEP (/ RADIUS FPS))
- (define BACKGROUND (square SIZE 'solid 'white))
- ;; creates a new crcl struct with a random color
- ;; num -> crcl
- (define (new-circle r)
- (crcl (* r RADIUS) (color (random 256) (random 256) (random 256))))
- ;; renders a list of circle structs
- ;; list-of-crcl -> image
- (define (render circle-list)
- (foldr (lambda (x y) (place-image (circle (crcl-radius x) 'solid (crcl-color x)) CENTER CENTER y))
- BACKGROUND circle-list))
- ;; moves the circles on each tick (and creates/deletes ones when necessary)
- ;; list-of-crcls -> list-of-crcls
- (define (move-circles crcls)
- (if (>= (crcl-radius (first crcls)) RADIUS) (cons (new-circle 0) (drop-right crcls 1))
- (map (lambda (x) (struct-copy crcl x [radius (+ STEP (crcl-radius x))])) crcls)))
- ;; big-bang function call that runs this infinitely
- (big-bang (build-list (add1 COUNT) new-circle)
- [name "Circles"]
- [on-tick move-circles (/ 1 FPS)]
- [to-draw render])
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement