 # Solar sim

a guest
May 14th, 2017
304
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
1. #lang racket
2.
3. (require racket/gui/base)
4.
5. ; The gravitational constant G
6. (define G 6.67428e-11)
7.
8. ; Assumed scale: 100 pixels = 1AU
9. (define AU (* 149.6e6 1000))
10. (define SCALE (/ 250 AU))
11.
12. (struct body (id px py vx vy mass radius color) #:mutable #:transparent) ;Structure of body
13. ;position in m, vector in m/s, mass in kg, radius in m
14.
15. (define (force g mass otherMass distance) ;Calculate the force of attraction
16.   (/ (* g (* mass otherMass)) (expt distance 2)))
17.
18. (define (directionOfForce dx dy force) ;Calculate direction of the force
19.   (let ([theta (atan dy dx)])
20.     (list (* (cos theta) force) (* (sin theta) force))))
21.
22. (define (attraction body otherBody) ;Creates a vector to adjust planet heading depending on all other bodies
23.   (let* ([dx (- (body-px otherBody) (body-px body))]
24.          [dy (- (body-py otherBody) (body-py body))]
25.          [distance (sqrt (+ (expt dx 2) (expt dy 2)))]) ;Distance between bodys
26.     (if (= distance 0) (print "Hitt!")
27.         (directionOfForce dx dy
28.                         (force G (body-mass body) (body-mass otherBody) distance)))))
29.
30. (define timestep (* 12 3600)) ;Half a day
31.
32. (define (totalAttraction body bodies fxy) ;Creates a list of vectors, a vector for every body
33.   (if (equal? bodies '())
34.       fxy
35.       (totalAttraction body (cdr bodies) (map + fxy (attraction body (car bodies)))))
36.   )
37.
38. (define (gravity bodies timestep)
39.   (let* ([forces (for/list ([b bodies]) (totalAttraction b (remove b bodies) '(0 0)))]
40.          [vectors (for/list ([f forces][b bodies]) (list (+ (body-vx b) (*(/ (car f) (body-mass b)) timestep))
41.                                                          (+ (body-vy b) (* (/(car(cdr f)) (body-mass b)) timestep))))]
42.          [positions (for/list ([v vectors][b bodies]) (list (+ (body-px b) (* (car v) timestep))
43.                                                             (+ (body-py b) (* (car (cdr v)) timestep))))])
44.
45.     (for/list ([b bodies][v vectors][p positions])
46.       (body (body-id b) (car p) (car(cdr p)) (car v) (car(cdr v))
47.             (body-mass b) (body-radius b) (body-color b)))
48.     ))
49. ;(struct body (id px py vx vy mass radius color)) ;just a reminder of the struct
50.
51.
52. ;A list of bodies, size of planets is not real... you woldent se the planets.
53. (define testCollPlanets (list
54.                          (body "Sun" 0 0 0 0 (* 1.98892 (expt 10 30)) 100 "yellow")
55.                          (body "Mercury" (* -0.387098 AU) 0 0 (* -47.362 1000) (* 3.3011 (expt 10 23)) 4 "red")
56.                          (body "Venus" (* 0.723 AU) 0 0 (* 35.02 1000) (* 4.8685 (expt 10 24)) 8 "brown")
57.                          (body "Earth" (* -1 AU) 0 0 (* -29.783 1000) (* 5.9742 (expt 10 24)) 8 "green")
58.                          (body "Mars" (* -1.5236 AU) 0 0 (* -24.077 1000) (* 6.4174 (expt 10 23)) 4 "orange")
59.                          ;(body "Havoc" (* -1.2 AU) 0 0 (* -10 1000) (* 8 (expt 10 25)) 50 "green")
60.                          ))
61.
62.
63.
64. (define (printBodies bodies scale) ;To print the numbers for control
65.   (if (equal? bodies '())
66.       (printf "Done\n")
67.       (let
68.       ([ p (printf "Position XY ~a \n" (list (body-id (car bodies))
69.                                              (* (body-px (car bodies)) scale)
70.                                              (* (body-py (car bodies)) scale)
71.                                              (* (body-vx (car bodies)) scale)
72.                                              (* (body-vy (car bodies)) scale)))])
73.       (printBodies (cdr bodies) scale))))
74.
75. (define (loop grav bodies timestep scale n);A numeric simulation
76.   (printBodies bodies scale)
77.   (if (> n 0)
78.       (loop grav (gravity bodies timestep) timestep scale (- n 1))
79.       (printf "End")
80.       ))
81.
82.
83. ;(loop G testCollPlanets timestep SCALE 90)
84.
85. ;A gui below
86. (define myframe (new frame%
87.                      [width 100]
88.                      [height 100]
89.                      [label "Solarsystem simulator"]))
90.
91. (define (solarPainter grav bodies timestep scale);Update planet positions and paint
92.     (let ([ bp (gravity bodies timestep)])
93.       (for ([b bp][i (length bodies)])
94.         ;mutate struct
95.         (set-body-px! (list-ref testCollPlanets i) (body-px b))
96.         (set-body-py! (list-ref testCollPlanets i) (body-py b))
97.         (set-body-vx! (list-ref testCollPlanets i) (body-vx b))
98.         (set-body-vy! (list-ref testCollPlanets i) (body-vy b))
99.         ;paint
100.         (send dc set-brush (make-object brush% (body-color b) 'solid))
101.         (send dc draw-ellipse
102.               (+ (* (body-px b) scale) (- 500 (/(body-radius b) 2)))
103.               (+ (* (body-py b) scale) (- 500 (/(body-radius b) 2)))
106.         )))
107.
108.
109. (define my_canvas (new canvas% ;Only a canvas
110.                  [parent myframe]
111.                   [min-width 1000]
112.                   [min-height 1000]
113.                   [paint-callback
114.                      (lambda(canvas dc)
115.                        (send dc set-smoothing 'smoothed)
116.                        (send dc erase)
117.                        (send dc set-brush (make-object brush% "black" 'solid))
118.                        (send dc draw-rectangle 0 0 1000 1000)
119.                        (send dc set-alpha 1)
120.                        (solarPainter G testCollPlanets timestep SCALE))] ;Call the planetpainter
121.                   ))
122.
123.
124. (define refreshTimer ;Canvas refresh
125.   (new timer% [notify-callback (lambda () (send my_canvas refresh))]))
126.
127. (define dc (send my_canvas get-dc))
128.
129. (send myframe show #t)
130. (send refreshTimer start 16 #f) ;Start refresh timer
RAW Paste Data