• API
• FAQ
• Tools
• Archive
SHARE
TWEET # Solar sim a guest May 14th, 2017 196 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
We use cookies for various purposes including analytics. By continuing to use Pastebin, you agree to our use of cookies as described in the Cookies Policy.
Top