First attempt for a solar system 2D

[TempodiBasic]

Hi guys

here I first attempt to port in QB64 what had been coded in Java with OOP  (classes and instances of them)

At a moment of the instructions video I loose my mind in my imagination activity so this came out as result:

Code: QB64: [Select]

1. ' Solar System 2D: code developed following this tutorial
2. '[youtube]https://www.youtube.com/watch?v=l8SiJ-RmeHU&list=PLRqwX-V7Uu6ZiZxtDDRCi6uhfTH4FilpH[/youtube]&index=7
3. TYPE Planet
4.     Radius AS SINGLE
5.     Angle AS SINGLE
6.     Distance AS SINGLE
7.     Names AS STRING * 3
8.     Parent AS INTEGER
9. END TYPE
10.  
11. CONST WScreen = 900, HScreen = 600, Black = _RGBA32(0, 0, 0, 255), True = -1, False = 0
12. CONST r = 50, CSun = _RGBA32(222, 194, 61, 255), MaxPlanet = 5, MaxMoon = 5
13. CONST CPlanet = _RGBA32(238, 111, 89, 255): CONST CMoon = _RGBA32(100, 227, 11, 255)
14. CONST CBlack = _RGBA32(0, 0, 10, 255)
15.  
16. DIM SHARED A AS LONG, Sun AS Planet, Planets(1 TO MaxPlanet * MaxMoon) AS Planet
17. DIM SHARED ShowName AS INTEGER
18.  
19.  
20. Setup
21. DO
22.     Draws
23.     MovePlanets
24.     IF _KEYDOWN(13) THEN ShowName = NOT ShowName
25.     _LIMIT 10
26. LOOP UNTIL _KEYHIT = 32
27. END
28.  
29. SUB MovePlanets
30.     DIM w AS INTEGER
31.     FOR w = 1 TO MaxPlanet + MaxMoon
32.         IF Planets(w).Radius > 0 THEN Planets(w).Angle = Planets(w).Angle + .1
33.     NEXT w
34. END SUB
35.  
36. SUB Setup
37.     DIM w AS INTEGER, radius AS INTEGER, distance AS INTEGER
38.     RANDOMIZE TIMER
39.     A = _NEWIMAGE(WScreen, HScreen, 32)
40.     IF A < -1 THEN SCREEN A ELSE PRINT "Error handle image": EXIT SUB
41.     _TITLE "Solar System 2D"
42.     _SCREENMOVE 10, 10
43.     Sun.Radius = 0
44.     Sun.Angle = 0
45.     Sun.Distance = 0
46.     Sun.Names = "SUN"
47.     Sun.Parent = 0
48.     FOR w = 1 TO MaxPlanet STEP 1
49.         radius = INT(RND * 20) + 10
50.         distance = INT(RND * 200) + 100
51.         '          Index, radius, distance from parent, parent
52.         MakePlanet w, radius, distance, 0
53.         RandomMoon w
54.     NEXT w
55.     ShowName = False
56. END SUB
57.  
58. SUB RandomMoon (Index AS INTEGER)
59.     DIM z AS INTEGER
60.     IF INT(RND * 3) + 1 > 1 THEN
61.         FOR z = 1 TO INT(RND * (MaxMoon - 1)) + 1
62.             ' index moon, 1/2 radius, Parent
63.             MakePlanet z + MaxPlanet, INT(Planets(Index).Radius / 2), INT(RND * 20) + 10, Index
64.         NEXT
65.     END IF
66. END SUB
67.  
68. SUB DrawSun
69.     CIRCLE (WScreen / 2, HScreen / 2), 100, CBlack
70.     PAINT STEP(0, 0), CSun, CBlack
71.     IF ShowName = True THEN COLOR _RGBA(70, 200, 200, 255): _PRINTSTRING (WScreen / 2, HScreen / 2), Sun.Names
72. END SUB
73.  
74. SUB Draws
75.     DIM w AS INTEGER
76.     CLS , Black
77.     DrawSun
78.     FOR w = 1 TO MaxPlanet + MaxMoon
79.         IF Planets(w).Radius > 0 THEN ShowPlanet w
80.     NEXT w
81.     _DISPLAY
82. END SUB
83.  
84. SUB MakePlanet (Index AS INTEGER, r AS SINGLE, d AS SINGLE, p AS INTEGER)
85.     Planets(Index).Radius = r
86.     Planets(Index).Angle = INT(RND * 360)
87.     Planets(Index).Distance = d
88.     Planets(Index).Names = STR$(Index)
89.     Planets(Index).Parent = p
90. END SUB
91.  
92. SUB ShowPlanet (Index AS INTEGER)
93.     DIM Sinus AS SINGLE, Cosinus AS SINGLE, Colr AS _UNSIGNED LONG
94.     DIM Xcircle AS SINGLE, Ycircle AS SINGLE, Rcircle AS INTEGER
95.     DIM Cosinus2 AS SINGLE, Sinus2 AS SINGLE
96.     Sinus = SIN(Planets(Index).Angle)
97.     Cosinus = COS(Planets(Index).Angle)
98.     ' parent is an important Flag both to choose X,y of circle
99.     ' both to understand if it is a planet around the sun or a moon around a planet
100.  
101.     IF Planets(Index).Parent = 0 THEN
102.         Colr = CPlanet
103.         Xcircle = (WScreen / 2) + Sun.Radius
104.         Ycircle = (HScreen / 2) + Sun.Radius
105.     ELSEIF Planets(Index).Parent > 0 THEN
106.         Colr = CMoon
107.         Sinus2 = SIN(Planets(Planets(Index).Parent).Angle)
108.         Cosinus2 = COS(Planets(Planets(Index).Parent).Angle)
109.  
110.         Xcircle = ((Planets(Planets(Index).Parent).Distance * Cosinus2) + (WScreen / 2) + Sun.Radius)
111.         Ycircle = ((Planets(Planets(Index).Parent).Distance * Sinus2) + (HScreen / 2) + Sun.Radius)
112.     END IF
113.     Rcircle = Planets(Index).Radius
114.     Xcircle = Xcircle + (Planets(Index).Distance * Cosinus)
115.     Ycircle = Ycircle + (Planets(Index).Distance * Sinus)
116.     CIRCLE (Xcircle, Ycircle), Rcircle, CBlack
117.     PAINT STEP(0, 0), Colr, CBlack
118.  
119.     IF ShowName = True THEN COLOR _RGBA(70, 200, 200, 255): _PRINTSTRING (Xcircle, Ycircle), Planets(Index).Names
120. END SUB

Help:
press Spacebar to stop and quit
Enter to toggle Name On/OFF

In coming....
one color for one planet
one speed for one planet
a better graphic output using FillCircle taken here  https://www.qb64.org/forum/index.php?topic=1069.0

[Ashish]

Good one!
BTW, I see some on the planets overlapping each other and sometime a planet being revolving inside the sun!

[Qwerkey]

Tempo, I assume that you will adjust each planet speed so that the orbital period is longer the further out from the Sun you are.

[TempodiBasic]

Thanks
@ Ashish
yes i'll set a greater min distance from Sun for planets in Setup


@Qwerkey
yes it is one of the further steps to give to each planet an own speed related to distance to sun

[Jack002]

Very cool demonstration. You have started a new revolution.

[TempodiBasic]

Here a more little step:

Code: QB64: [Select]

1. ' Solar System 2D: code developed following this tutorial
2. '[youtube]https://www.youtube.com/watch?v=l8SiJ-RmeHU&list=PLRqwX-V7Uu6ZiZxtDDRCi6uhfTH4FilpH[/youtube]&index=7
3. TYPE Planet
4.     Radius AS SINGLE
5.     Angle AS SINGLE
6.     Distance AS SINGLE
7.     Names AS STRING * 3
8.     Parent AS INTEGER
9.     Speed AS SINGLE
10.     Colors AS _UNSIGNED LONG
11. END TYPE
12.  
13. CONST WScreen = 900, HScreen = 600, True = -1, False = 0
14. CONST r = 50, MaxPlanet = 5, MaxMoon = 5
15.  
16. CONST Black = _RGBA32(0, 0, 0, 255)
17. CONST NameColor = _RGBA32(70, 200, 200, 255)
18.  
19. DIM SHARED A AS LONG, Sun AS Planet, Planets(1 TO MaxPlanet * MaxMoon) AS Planet
20. DIM SHARED ShowName AS INTEGER
21. DIM k AS INTEGER
22.  
23. Setup
24. DO
25.     k = _KEYHIT
26.     IF k = 8 THEN Setup
27.     Draws
28.     MovePlanets
29.     IF k = 13 THEN ShowName = NOT ShowName
30.     _DISPLAY
31.     _LIMIT 15
32. LOOP UNTIL k = 32
33. END
34.  
35. SUB MovePlanets
36.     DIM w AS INTEGER
37.     FOR w = 1 TO MaxPlanet + MaxMoon
38.         IF Planets(w).Radius > 0 THEN Planets(w).Angle = Planets(w).Angle + Planets(w).Speed
39.     NEXT w
40. END SUB
41.  
42. SUB Setup
43.     DIM w AS INTEGER, radius AS INTEGER, distance AS INTEGER
44.     RANDOMIZE TIMER
45.     A = _NEWIMAGE(WScreen, HScreen, 32)
46.     IF A < -1 THEN SCREEN A ELSE PRINT "Error handle image": EXIT SUB
47.     _TITLE "Solar System 2D"
48.     _SCREENMOVE 10, 10
49.     _PRINTMODE _KEEPBACKGROUND
50.     Sun.Radius = 0
51.     Sun.Angle = 0
52.     Sun.Distance = 0
53.     Sun.Names = "SUN"
54.     Sun.Parent = 0
55.     Sun.Colors = _RGBA32(222, 194, 61, 255)
56.     FOR w = 1 TO MaxPlanet STEP 1
57.         radius = INT(RND * 15) + 10
58.         distance = INT(RND * 3 * r) + (3 * r)
59.         '          Index, radius, distance from parent, parent
60.         MakePlanet w, radius, distance, 0
61.         RandomMoon w
62.     NEXT w
63.     ShowName = False
64. END SUB
65.  
66. SUB RandomMoon (Index AS INTEGER)
67.     DIM z AS INTEGER
68.     IF INT(RND * 3) + 1 > 1 THEN
69.         FOR z = 1 TO INT(RND * (MaxMoon - 1)) + 1
70.             ' index moon, 1/2 radius, Parent
71.             MakePlanet z + MaxPlanet, INT(Planets(Index).Radius / 2), INT(RND * 20) + 10, Index
72.         NEXT
73.     END IF
74. END SUB
75.  
76. SUB DrawSun
77.     CircleFill WScreen / 2, HScreen / 2, 100, Sun.Colors
78.     IF ShowName = True THEN COLOR NameColor: _PRINTSTRING (WScreen / 2, HScreen / 2), Sun.Names
79. END SUB
80.  
81. SUB Draws
82.     DIM w AS INTEGER
83.     CLS , Black
84.     DrawSun
85.     FOR w = 1 TO MaxPlanet + MaxMoon
86.         IF Planets(w).Radius > 0 THEN ShowPlanet w
87.     NEXT w
88. END SUB
89.  
90. SUB MakePlanet (Index AS INTEGER, r AS SINGLE, d AS SINGLE, p AS INTEGER)
91.     Planets(Index).Radius = r
92.     Planets(Index).Angle = INT(RND * 360)
93.     Planets(Index).Distance = d
94.     Planets(Index).Names = STR$(Index)
95.     Planets(Index).Parent = p
96.     Planets(Index).Speed = 0.01 + (RND * 0.03)
97.     IF p = 0 THEN Planets(Index).Colors = _RGBA(0, 100 + (RND * 150), 100 + (RND * 150), 255) ELSE Planets(Index).Colors = _RGBA(100 + (RND * 150), 100 + (RND * 150), 100 + (RND * 150), 255)
98. END SUB
99.  
100. SUB ShowPlanet (Index AS INTEGER)
101.     DIM Sinus AS SINGLE, Cosinus AS SINGLE
102.     DIM Xcircle AS SINGLE, Ycircle AS SINGLE, Rcircle AS INTEGER
103.     DIM Cosinus2 AS SINGLE, Sinus2 AS SINGLE
104.     Sinus = SIN(Planets(Index).Angle)
105.     Cosinus = COS(Planets(Index).Angle)
106.     ' parent is an important Flag both to choose X,y of circle
107.     ' both to understand if it is a planet around the sun or a moon around a planet
108.  
109.     IF Planets(Index).Parent = 0 THEN
110.         Xcircle = (WScreen / 2) + Sun.Radius
111.         Ycircle = (HScreen / 2) + Sun.Radius
112.     ELSEIF Planets(Index).Parent > 0 THEN
113.         Sinus2 = SIN(Planets(Planets(Index).Parent).Angle)
114.         Cosinus2 = COS(Planets(Planets(Index).Parent).Angle)
115.         Xcircle = ((Planets(Planets(Index).Parent).Distance * Cosinus2) + (WScreen / 2) + Sun.Radius)
116.         Ycircle = ((Planets(Planets(Index).Parent).Distance * Sinus2) + (HScreen / 2) + Sun.Radius)
117.     END IF
118.     Rcircle = Planets(Index).Radius
119.     Xcircle = Xcircle + (Planets(Index).Distance * Cosinus)
120.     Ycircle = Ycircle + (Planets(Index).Distance * Sinus)
121.     CircleFill Xcircle, Ycircle, Rcircle, Planets(Index).Colors
122.     IF ShowName = True THEN COLOR NameColor: _PRINTSTRING (Xcircle, Ycircle), Planets(Index).Names
123. END SUB
124.  
125.  
126. SUB CircleFill (CX AS INTEGER, CY AS INTEGER, R AS INTEGER, C AS _UNSIGNED LONG)
127.     ' CX = center x coordinate
128.     ' CY = center y coordinate
129.     '  R = radius
130.     '  C = fill color
131.     DIM Radius AS INTEGER, RadiusError AS INTEGER
132.     DIM X AS INTEGER, Y AS INTEGER
133.     Radius = ABS(R)
134.     RadiusError = -Radius
135.     X = Radius
136.     Y = 0
137.     IF Radius = 0 THEN PSET (CX, CY), C: EXIT SUB
138.     LINE (CX - X, CY)-(CX + X, CY), C, BF
139.     WHILE X > Y
140.         RadiusError = RadiusError + Y * 2 + 1
141.         IF RadiusError >= 0 THEN
142.             IF X <> Y + 1 THEN
143.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
144.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
145.             END IF
146.             X = X - 1
147.             RadiusError = RadiusError - X * 2
148.         END IF
149.         Y = Y + 1
150.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
151.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
152.     WEND
153. END SUB

Help:
     Key             action
 SpaceBar         Quit
  Enter              Toggle ON/OFF name
BackSpace        Generate New Solar System

News:
each planet or moon has its own color, name, speed, distance from sun
you can change the solar system ad libitum

In coming...
no overlapping planets with their moons and/or other planets
increasing speed of revolution from external to inner planets

[johnno56]

Are you intending to make an actual 2D model of the Solar System or a 2D simulation? Just curious.

[bplus]

Hi TempodiBasic,

I try a recursive MakeBodies Sub so that moons can have moons too.

Code: QB64: [Select]

1. OPTION _EXPLICIT
2. RANDOMIZE TIMER
3. _TITLE "3 Planets with 3 Moons with 3 Moons System"
4. 'B+ started 2019-06-01  with recursive MakeBodies sub
5. CONST xmaxScreen = 1000, ymaxscreen = 740
6.  
7. SCREEN _NEWIMAGE(xmaxScreen, ymaxscreen, 32)
8. _SCREENMOVE 100, 0
9.  
10. TYPE bodyType
11.     ThisI AS INTEGER
12.     ParentI AS INTEGER '     gives the x,y origin of center of orbit
13.     OrbitI AS INTEGER
14.     Distance AS SINGLE '       R from center origin
15.     Angle AS SINGLE '          current location around center
16.     AngleChange AS SINGLE 'change of angle each frame
17.     X AS SINGLE 'x, y location from above info needed for child planets
18.     Y AS SINGLE
19.     R AS SINGLE
20.     C AS _UNSIGNED LONG
21. END TYPE
22.  
23. DIM SHARED BC AS INTEGER
24. REDIM SHARED B(0) AS bodyType
25.  
26. makeBodies 0, 0, 0
27. WHILE 1
28.     CLS
29.     LOCATE 1, 1: PRINT "Body count:"; BC
30.     drawBodies
31.     _DISPLAY
32.     _LIMIT 10
33. WEND
34.  
35. SUB makeBodies (generation AS INTEGER, OrbitI AS INTEGER, ParentI AS INTEGER)
36.     DIM oi AS INTEGER, pI AS INTEGER, r AS INTEGER, g AS INTEGER, b AS INTEGER
37.  
38.     IF generation > 3 THEN
39.         EXIT SUB
40.     ELSE
41.         BC = BC + 1
42.         REDIM _PRESERVE B(BC) AS bodyType
43.         pI = BC '< save non shared value
44.         IF BC = 1 THEN 'the sun
45.             B(BC).ThisI = BC
46.             B(BC).ParentI = 0
47.             B(BC).Distance = 350
48.             B(BC).AngleChange = _PI(1 / 1440)
49.             B(BC).X = xmaxScreen / 2
50.             B(BC).Y = ymaxscreen / 2
51.             B(BC).R = 20
52.             B(BC).C = &HFFFFFFAA
53.         ELSE 'the body has a parent from which we decide some numbers for location
54.             B(BC).ThisI = BC
55.             B(BC).ParentI = ParentI
56.             B(BC).OrbitI = OrbitI
57.             B(BC).Distance = B(ParentI).Distance / 10
58.             B(BC).Angle = RND * _PI(2)
59.             B(BC).AngleChange = 10 / OrbitI ^ 2 * B(ParentI).AngleChange
60.             B(BC).X = B(ParentI).X + (3 * B(BC).OrbitI + 2) * B(BC).Distance * COS(B(BC).Angle)
61.             B(BC).Y = B(ParentI).Y + (3 * B(BC).OrbitI + 2) * B(BC).Distance * SIN(B(BC).Angle)
62.             B(BC).R = B(ParentI).R / 8
63.             IF B(BC).R < 1 THEN B(BC).R = 1
64.             IF generation = 1 THEN
65.                 B(BC).C = _RGB32(RND * 55 + 200, RND * 155 + 100, RND * 155 + 100)
66.             ELSE
67.                 r = _RED32(B(B(BC).ParentI).C)
68.                 g = _GREEN32(B(B(BC).ParentI).C)
69.                 b = _BLUE32(B(B(BC).ParentI).C)
70.                 B(BC).C = _RGB32(r - OrbitI * 15, g - OrbitI * 15, b - OrbitI * 15)
71.             END IF
72.         END IF
73.         FOR oi = 1 TO 3
74.             makeBodies generation + 1, oi, pI
75.         NEXT
76.     END IF
77. END SUB
78.  
79. SUB drawBodies
80.     DIM i AS INTEGER
81.     FOR i = 1 TO BC
82.         IF i > 1 THEN
83.             B(i).Angle = B(i).Angle + B(i).AngleChange
84.             B(i).X = B(B(i).ParentI).X + (3 * B(i).OrbitI + 2) * B(i).Distance * COS(B(i).Angle)
85.             B(i).Y = B(B(i).ParentI).Y + (3 * B(i).OrbitI + 2) * B(i).Distance * SIN(B(i).Angle)
86.         END IF
87.         fcirc B(i).X, B(i).Y, B(i).R, B(i).C
88.     NEXT
89. END SUB
90.  
91. SUB fcirc (CX AS INTEGER, CY AS INTEGER, RR AS INTEGER, C AS _UNSIGNED LONG)
92.     DIM R AS INTEGER, RError AS INTEGER
93.     DIM X AS INTEGER, Y AS INTEGER
94.  
95.     R = ABS(RR)
96.     RError = -R
97.     X = R
98.     Y = 0
99.     IF R = 0 THEN PSET (CX, CY), C: EXIT SUB
100.     LINE (CX - X, CY)-(CX + X, CY), C, BF
101.     WHILE X > Y
102.         RError = RError + Y * 2 + 1
103.         IF RError >= 0 THEN
104.             IF X <> Y + 1 THEN
105.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
106.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
107.             END IF
108.             X = X - 1
109.             RError = RError - X * 2
110.         END IF
111.         Y = Y + 1
112.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
113.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
114.     WEND
115. END SUB
116.  
117.  

[Pete]

Well, despite the added orbiting lunar bodies, I like Temp's model better. My eyesight isn't what it used to be and, no offense Mark, your balls are too small. Temp has bigger balls, and I find that an attractive quality in a solar system.

Actually, I'm going to ask Odin to lock this thread. I'm pretty sure this is how The Matrix got started! :D

Pete

[TempodiBasic]

Hi

@Johno56
it is an attempt to make a model of a solar system, not just the our solar system.
As you can see the physic is out of model for now, I must see the whole original video to see if physic comes out.

@Bplus
interesting model with moons having moons, I cannot imagine how is complicated if the second generation of moons have moon too.
:)

@Pete
Matrix? Do you talk about Neo (Mr Anderson)?

[Pete]

Yes, Neo. God forbid I ever have to live in a manufactured computer simulati.... God forbid I ever hav...

Pete

[Richard Frost]

Code: QB64: [Select]

1. ' Solar System
2.  
3. DEFDBL A-Z
4. t = 10
5. DIM sx(t), sy(t), ox(t), oy(t), p$(t), pm(t), pd(t), pr(t), pc(t), pv(t), pt(t), interval$(t), interval(t)
6. GOSUB init
7. DO: _LIMIT 30
8.     n& = n& + interval(ts)
9.     PSET (0, 0), 15
10.     FOR sat = 1 TO np
11.         dd = pd(sat)
12.         v = SQR((gc * pm(0)) / dd)
13.         pv(sat) = v
14.         t = SQR(4 * pi * pi * (dd ^ 3) / (gc * pm(0)))
15.         pt(sat) = t
16.         de = (360 / t * n&) MOD 360
17.         r = (de - 90) * dr
18.         sx(sat) = (pd(0) + pd(sat)) * COS(r)
19.         sy(sat) = (pd(0) - pd(sat)) * SIN(r)
20.         z = pr(sat) * q * 2
21.         LINE (ox(sat) - z, oy(sat) - z)-(ox(sat) + z, oy(sat) + z), 0, BF ' erase old
22.         CIRCLE (sx(sat), sy(sat)), pr(sat) * q, pc(sat) '                   plot new
23.         'PAINT (sx(sat), sy(sat)), pc(sat) '                                messes up sometimes, so
24.         ox(sat) = sx(sat)
25.         oy(sat) = sy(sat)
26.     NEXT sat
27.     IF tflag = 0 THEN tflag = 1: GOSUB text
28.     i$ = INKEY$
29.     IF LEN(i$) = 1 THEN
30.         ip = INSTR("3456789", i$)
31.         IF ip THEN
32.             np = ip + 2
33.             GOSUB init2
34.         END IF
35.     END IF
36.     IF LEN(i$) = 2 THEN
37.         a = ASC(RIGHT$(i$, 1))
38.         ts = ts + (a = 72) - (a = 80)
39.         IF ts < 1 THEN ts = 1
40.         IF ts > 7 THEN ts = 7
41.         GOSUB showint
42.     END IF
43. LOOP UNTIL i$ = CHR$(27)
44. END
45. ' ------------------------------------------------------------------------
46. showint:
47. COLOR 8
48. LOCATE 12, 1: PRINT "  INTERVAL"
49. FOR i = 1 TO 7
50.     IF i = ts THEN COLOR 4 ELSE COLOR 8
51.     LOCATE 13 + i, 3
52.     PRINT interval$(i)
53. NEXT i
54. COLOR 8
55. RETURN
56. ' ------------------------------------------------------------------------
57. init:
58. SCREEN 12
59. sos = 1
60. pi = ATN(1) * 4
61. dr = ATN(1) / 45 '                angle to radian conversion
62. xy = 640 / 480 '                  aspect ratio
63. gc = 6.67E-11 '                   gravitational constant
64. mk = 1 / .621371 '                miles to km
65.  
66. em = 5.98E+24: er = 6370000! '    Earth mass, radius (m)
67. mm = 7.4E+22: mr = 1740000! '     Moon mass, radius (m)
68. sm = 2E+30: sr = 7E+08 '          Sun mass, radius
69. sd = 1.5E+11 '                    Sun to Earth
70. min = 356410.3 * 1000 '           Earth to Moon in meters
71. max = 406697.5 * 1000
72.  
73. RESTORE planets
74. FOR p = 0 TO 9 '                  Sun + 9 planets
75.     READ g, p$, m, d, r
76.     p$(p) = p$ '                  name
77.     pm(p) = m * em '              mass
78.     pd(p) = d * mk * 1000000000 ' distance
79.     pr(p) = r * mk * 1000 '       radius
80. NEXT p
81.  
82. FOR p = 1 TO 9
83.     '   color          0  1  2  3  4  5  6  7  8  9
84.     pc(p) = VAL(MID$("14 07 15 10 04 11 14 06 01 08", p * 3 + 1, 2))
85.     '                  S  M  V  E  M  J  S  U  N  P
86. NEXT p
87.  
88. ts = 4: z = 1
89. RESTORE intervals
90. FOR i = 1 TO 7
91.     READ q, interval$(i)
92.     z = z * q
93.     interval(i) = z
94. NEXT i
95. q = 1000 '                        magnification of planets
96. np = 8 '                          planets to show
97. GOSUB init2
98. RETURN
99. ' ------------------------------------------------------------------------
100. init2:
101. SCREEN 12
102. CLS
103. t = pd(np) * 2
104. WINDOW (-t, -t / xy)-(t, t / xy)
105. PSET (0, 0), 15
106. GOSUB showint
107. tflag = 0
108.  
109. t$ = "THE SOLAR SYSTEM"
110. LOCATE 2, 40 - LEN(t$) \ 2: PRINT t$;
111. t$ = "Planets magnified 1000 times"
112. LOCATE 28, 40 - LEN(t$) \ 2: PRINT t$;
113. t$ = "Press 3-9 to select planets, up/down to change interval"
114. LOCATE 29, 40 - LEN(t$) \ 2: PRINT t$;
115. RETURN
116. ' ------------------------------------------------------------------------
117. text:
118. COLOR 8
119. LOCATE 1, 1: PRINT "  km/s     Y";
120. FOR i = 1 TO np
121.     COLOR pc(i)
122.     LOCATE i + 1, 1: PRINT LEFT$(p$(i), 1);
123.     PRINT USING " ##.#"; pv(i) / 1000;
124.     tm = pt(i) / 60
125.     th = tm / 60
126.     td = th / 24
127.     ty = td / 365
128.     PRINT USING " ###.#  "; ty;
129. NEXT i
130. RETURN
131. ' ------------------------------------------------------------------------
132. intervals:
133. DATA 1,Second
134. DATA 60,Minute
135. DATA 60,Hour
136. DATA 24,Day
137. DATA 7,Week
138. DATA 4,Month
139. DATA 12,Year
140. ' ------------------------------------------------------------------------
141. planets:
142. '                        miles  radius
143. '                  mass  (mil)    (mi)
144. DATA 0,"Sun    ",334448,0,435960
145. DATA 1,"Mercury",0.05,36.2,1500
146. DATA 2,"Venus  ",0.816,67.2,3800
147. DATA 3,"Earth  ",1,93.2,3958
148. DATA 4,"Mars   ",0.15,141.6,2090
149. DATA 5,"Jupiter",318,483,43000
150. DATA 6,"Saturn ",95,886,37000
151. DATA 7,"Uranus ",14.6,1790,15000
152. DATA 8,"Neptune",17.2,2800,14000
153. DATA 9,"Pluto  ",.5,4600,1979
154. ' ------------------------------------------------------------------------
155.  

[Ashish]

That's very nice implementation of solar system, Richard Frost. :)
I do remember that once upon a time, I tried to code 3D a solar system but it was without the sun and the planets only rotate (does not revolve).

[Pete]

Optical illusion occurs switching to "year" interval with 3 selected. It looks like the orbits reverse, much the way wheels on cars appear to move backwards when filmed, at least in the old days.

I'm not sure about the intervals. Seems fast to me. Is it that a day interval means for every real second that passes, a days worth of orbit is achieved? If so, it seems to run too fast on my system. I would think Earth should complete an orbit in 364+ seconds, but it completes in about 14 seconds. What is an eye opener is how in real time it seems like nothing is moving. It proves as humans, we crave action over reality. I'm sure God looks at it another way. What? Pluto completed another full orbit already? Wow, seems like just yester-century...

Neat demo!

Pete

[bplus]

Trace paths of 3 moons about 3 planets:

Code: QB64: [Select]

1. OPTION _EXPLICIT
2. RANDOMIZE TIMER
3. _TITLE "Trace 3 Moons around 3 Planets Paths"
4. 'B+ started 2019-06-01  with recursive MakeBodies sub
5. CONST xmaxScreen = 1000, ymaxscreen = 740
6.  
7. SCREEN _NEWIMAGE(xmaxScreen, ymaxscreen, 32)
8. _SCREENMOVE 100, 0
9.  
10. TYPE bodyType
11.     ThisI AS INTEGER
12.     ParentI AS INTEGER '     gives the x,y origin of center of orbit
13.     OrbitI AS INTEGER
14.     Distance AS SINGLE '       R from center origin
15.     Angle AS SINGLE '          current location around center
16.     AngleChange AS SINGLE 'change of angle each frame
17.     X AS SINGLE 'x, y location from above info needed for child planets
18.     Y AS SINGLE
19.     R AS SINGLE
20.     C AS _UNSIGNED LONG
21. END TYPE
22.  
23. DIM SHARED BC AS INTEGER
24. REDIM SHARED B(0) AS bodyType
25.  
26. makeBodies 0, 0, 0
27. WHILE 1
28.     LINE (0, 0)-(xmaxScreen, ymaxscreen), _RGBA32(0, 0, 0, 5), BF
29.     LOCATE 1, 1: PRINT "Body count:"; BC
30.     drawBodies
31.     _DISPLAY
32.     _LIMIT 10
33. WEND
34.  
35. SUB makeBodies (generation AS INTEGER, OrbitI AS INTEGER, ParentI AS INTEGER)
36.     DIM oi AS INTEGER, pI AS INTEGER, r AS INTEGER, g AS INTEGER, b AS INTEGER
37.  
38.     IF generation > 2 THEN
39.         EXIT SUB
40.     ELSE
41.         BC = BC + 1
42.         REDIM _PRESERVE B(BC) AS bodyType
43.         pI = BC '< save non shared value
44.         IF BC = 1 THEN 'the sun
45.             B(BC).ThisI = BC
46.             B(BC).ParentI = 0
47.             B(BC).Distance = 350
48.             B(BC).AngleChange = _PI(1 / 1440)
49.             B(BC).X = xmaxScreen / 2
50.             B(BC).Y = ymaxscreen / 2
51.             B(BC).R = 20
52.             B(BC).C = &HFFFFFFAA
53.         ELSE 'the body has a parent from which we decide some numbers for location
54.             B(BC).ThisI = BC
55.             B(BC).ParentI = ParentI
56.             B(BC).OrbitI = OrbitI
57.             B(BC).Distance = B(ParentI).Distance / 10
58.             B(BC).Angle = RND * _PI(2)
59.             B(BC).AngleChange = 10 / OrbitI ^ 2 * B(ParentI).AngleChange
60.             B(BC).X = B(ParentI).X + (3 * B(BC).OrbitI + 2) * B(BC).Distance * COS(B(BC).Angle)
61.             B(BC).Y = B(ParentI).Y + .85 * (3 * B(BC).OrbitI + 2) * B(BC).Distance * SIN(B(BC).Angle)
62.             B(BC).R = B(ParentI).R / 8
63.             IF B(BC).R < 1 THEN B(BC).R = 1
64.             IF generation = 1 THEN
65.                 B(BC).C = _RGB32(RND * 55 + 200, RND * 155 + 100, RND * 155 + 100)
66.             ELSE
67.                 r = _RED32(B(B(BC).ParentI).C)
68.                 g = _GREEN32(B(B(BC).ParentI).C)
69.                 b = _BLUE32(B(B(BC).ParentI).C)
70.                 B(BC).C = _RGB32(r - OrbitI * 45, g - OrbitI * 45, b - OrbitI * 45)
71.             END IF
72.         END IF
73.         FOR oi = 1 TO 3
74.             makeBodies generation + 1, oi, pI
75.         NEXT
76.     END IF
77. END SUB
78.  
79. SUB drawBodies
80.     DIM i AS INTEGER
81.     FOR i = 1 TO BC
82.         IF i > 1 THEN
83.             B(i).Angle = B(i).Angle + B(i).AngleChange
84.             B(i).X = B(B(i).ParentI).X + (3 * B(i).OrbitI + 2) * B(i).Distance * COS(B(i).Angle)
85.             B(i).Y = B(B(i).ParentI).Y + .85 * (3 * B(i).OrbitI + 2) * B(i).Distance * SIN(B(i).Angle)
86.         END IF
87.         fcirc B(i).X, B(i).Y, B(i).R, B(i).C
88.     NEXT
89. END SUB
90.  
91. SUB fcirc (CX AS INTEGER, CY AS INTEGER, RR AS INTEGER, C AS _UNSIGNED LONG)
92.     DIM R AS INTEGER, RError AS INTEGER
93.     DIM X AS INTEGER, Y AS INTEGER
94.  
95.     R = ABS(RR)
96.     RError = -R
97.     X = R
98.     Y = 0
99.     IF R = 0 THEN PSET (CX, CY), C: EXIT SUB
100.     LINE (CX - X, CY)-(CX + X, CY), C, BF
101.     WHILE X > Y
102.         RError = RError + Y * 2 + 1
103.         IF RError >= 0 THEN
104.             IF X <> Y + 1 THEN
105.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
106.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
107.             END IF
108.             X = X - 1
109.             RError = RError - X * 2
110.         END IF
111.         Y = Y + 1
112.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
113.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
114.     WEND
115. END SUB
116.