PasteRack.org
Paste # 32484
2017-05-23 16:32:25

Fork as a new paste.

Paste viewed 129 times.


Embed:

solar sim

  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

=>