Advertisement
Guest User

Untitled

a guest
Mar 20th, 2019
57
0
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
text 1.17 KB | None | 0 0
  1. #lang racket
  2.  
  3. (require 2htdp/image)
  4. (require 2htdp/universe)
  5.  
  6. ;; structure used
  7. (struct crcl (radius color))
  8.  
  9. ;; constants
  10. (define SIZE 500)
  11. (define COUNT 5)
  12. (define CENTER (/ SIZE 2))
  13. (define RADIUS (/ (* SIZE (sqrt 1/2)) COUNT))
  14. (define FPS 60)
  15. (define STEP (/ RADIUS FPS))
  16. (define BACKGROUND (square SIZE 'solid 'white))
  17.  
  18. ;; creates a new crcl struct with a random color
  19. ;; num -> crcl
  20. (define (new-circle r)
  21. (crcl (* r RADIUS) (color (random 256) (random 256) (random 256))))
  22.  
  23. ;; renders a list of circle structs
  24. ;; list-of-crcl -> image
  25. (define (render circle-list)
  26. (foldr (lambda (x y) (place-image (circle (crcl-radius x) 'solid (crcl-color x)) CENTER CENTER y))
  27. BACKGROUND circle-list))
  28.  
  29. ;; moves the circles on each tick (and creates/deletes ones when necessary)
  30. ;; list-of-crcls -> list-of-crcls
  31. (define (move-circles crcls)
  32. (if (>= (crcl-radius (first crcls)) RADIUS) (cons (new-circle 0) (drop-right crcls 1))
  33. (map (lambda (x) (struct-copy crcl x [radius (+ STEP (crcl-radius x))])) crcls)))
  34.  
  35. ;; big-bang function call that runs this infinitely
  36. (big-bang (build-list (add1 COUNT) new-circle)
  37. [name "Circles"]
  38. [on-tick move-circles (/ 1 FPS)]
  39. [to-draw render])
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement