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)))
  104.               (body-radius b)
  105.               (body-radius b))
  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. OK, I Understand
Top