0. #lang racket/base
1. (require 2htdp/universe 2htdp/image lang/posn)
2. ; The gravitational constant G
3. (define G 6.67428e-11)
4.  
5. ; Assumed scale: 100 pixels = 1AU
6. (define AU (* 149.6e6 1000))
7. (define SCALE (/ 250 AU))
8.  
9. ;Structure of body;position in m, vector in m/s, mass in kg, radius in m
10. (struct body (id px py vx vy mass radius color) #:mutable #:transparent)
11.  
12.  
13. ;Calculate the force of attraction
14. (define (force g mass otherMass distance)
15.   (/ (* g (* mass otherMass)) (expt distance 2)))
16.  
17. ;Calculate direction of the force
18. (define (directionOfForce dx dy force)
19.   (let ([theta (atan dy dx)])
20.     (list (* (cos theta) force) (* (sin theta) force))))
21.  
22. ;Creates a vector to adjust planet heading depending on all other bodies
23. (define (attraction body otherBody)
24.   (let* ([dx (- (body-px otherBody) (body-px body))]
25.          [dy (- (body-py otherBody) (body-py body))]
26.          [distance (sqrt (+ (expt dx 2) (expt dy 2)))]) ;Distance between bodys
27.     (if (= distance 0) (print "Hitt!")
28.         (directionOfForce dx dy
29.                           (force G (body-mass body) (body-mass otherBody) distance)))))
30.  
31. (define timestep (* 12 3600)) ;Half a day
32.  
33. ;Creates a list of vectors, a vector for every body
34. (define (totalAttraction body bodies fxy)
35.   (if (equal? bodies '())
36.       fxy
37.       (totalAttraction body (cdr bodies) (map + fxy (attraction body (car bodies))))))
38.  
39. ;; gravity
40. ;; bodies ⇒ bodies
41. (define (gravity bodies timestep)
42.   (let* ([forces (for/list ([b bodies]) (totalAttraction b (remove b bodies) '(0 0)))]
43.          [vectors
44.           (for/list ([f forces][b bodies])
45.             (list (+ (body-vx b) (* (/ (car f) (body-mass b)) timestep))
46.                   (+ (body-vy b) (* (/ (car(cdr f)) (body-mass b)) timestep))))]
47.          [positions
48.           (for/list ([v vectors][b bodies])
49.             (list (+ (body-px b) (* (car v) timestep))
50.                   (+ (body-py b) (* (car (cdr v)) timestep))))])
51.     (for/list ([b bodies][v vectors][p positions])
52.       (body (body-id b) (car p) (car(cdr p)) (car v) (car(cdr v))
53.             (body-mass b) (body-radius b) (body-color b)))))
54.  
55. ;(struct body (id px py vx vy mass radius color)) ;just a reminder of the struct
56.  
57. ;A list of bodies, size of planets is not real... you woldent se the planets.
58. (define testCollPlanets
59.   (list
60.    (body "Sun" 0 0 0 0 (* 1.98892 (expt 10 30)) 100 "yellow")
61.    (body "Mercury" (* -0.387098 AU) 0 0 (* -47.362 1000) (* 3.3011 (expt 10 23)) 4 "red")
62.    (body "Venus" (* 0.723 AU) 0 0 (* 35.02 1000) (* 4.8685 (expt 10 24)) 8 "brown")
63.    (body "Earth" (* -1 AU) 0 0 (* -29.783 1000) (* 5.9742 (expt 10 24)) 8 "green")
64.    (body "Mars" (* -1.5236 AU) 0 0 (* -24.077 1000) (* 6.4174 (expt 10 23)) 4 "orange")
65.    ;  (body "Havoc" (* -1.2 AU) 0 0 (* -10 1000) (* 8 (expt 10 25)) 50 "green")
66.    ))
67.  
68. (define (printBodies bodies scale) ;To print the numbers for control
69.   (if (equal? bodies '())
70.       (printf "Done\n")
71.       (let
72.           ([ p (printf "Position XY ~a \n" (list (body-id (car bodies))
73.                                                  (* (body-px (car bodies)) scale)
74.                                                  (* (body-py (car bodies)) scale)
75.                                                  (* (body-vx (car bodies)) scale)
76.                                                  (* (body-vy (car bodies)) scale)))])
77.         (printBodies (cdr bodies) scale))))
78.  
79. ;; setup
80. (define Width 1200)
81. (define xoffset (/ Width 2))
82. (define Height 720)
83. (define yoffset (/ Height 2))
84.  
85. ;; start-world (world left right ps vs as f)
86. (define starting-state testCollPlanets);position velocity
87.  
88. ;; world -> scene
89. (define (render-expr bodies)
90.   ;(printBodies bodies SCALE)
91.   (place-images
92.    (map (λ (b) (circle (body-radius b) "solid" (body-color b))) bodies)
93.    (map (λ (b) (make-posn (+ (* (body-px b) SCALE) xoffset )
94.                           (+ (* (body-py b) SCALE) yoffset ))) bodies)
95.    (empty-scene Width Height "black")))
96.  
97. ;; world -> world
98. ;; update velocities and positions
99. (define (tick-expr bodies)
100.   (gravity bodies timestep))
101.  
102. ;;
103. (big-bang starting-state
104.   (on-tick tick-expr)
105.   (to-draw render-expr Width Height))
106.  

=>