QB64.org Forum

Active Forums => Programs => Topic started by: TempodiBasic on May 30, 2019, 06:51:46 pm

Title: First attempt for a solar system 2D
Post by: TempodiBasic on May 30, 2019, 06:51:46 pm

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

Quote

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 (https://www.qb64.org/forum/index.php?topic=1069.0)

Title: Re: First attempt for a solar system 2D
Post by: Ashish on May 31, 2019, 03:07:53 am

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

Title: Re: First attempt for a solar system 2D
Post by: Qwerkey on May 31, 2019, 04:58:35 am

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.

Title: Re: First attempt for a solar system 2D
Post by: TempodiBasic on May 31, 2019, 12:18:26 pm

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

Title: Re: First attempt for a solar system 2D
Post by: Jack002 on May 31, 2019, 03:57:46 pm

Very cool demonstration. You have started a new revolution.

Title: Re: First attempt for a solar system 2D
Post by: TempodiBasic on June 01, 2019, 09:34:15 am

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

Quote

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

Title: Re: First attempt for a solar system 2D
Post by: johnno56 on June 02, 2019, 11:11:36 am

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

Title: Re: First attempt for a solar system 2D
Post by: bplus on June 02, 2019, 11:38:01 am

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.  

Title: Re: First attempt for a solar system 2D
Post by: Pete on June 02, 2019, 11:44:03 am

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

Title: Re: First attempt for a solar system 2D
Post by: TempodiBasic on June 02, 2019, 07:51:57 pm

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)?

Title: Re: First attempt for a solar system 2D
Post by: Pete on June 02, 2019, 11:07:07 pm

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

Pete

Title: Re: First attempt for a solar system 2D
Post by: Richard Frost on June 03, 2019, 10:29:56 am

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.  

Title: Re: First attempt for a solar system 2D
Post by: Ashish on June 03, 2019, 11:53:09 am

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).

Title: Re: First attempt for a solar system 2D
Post by: Pete on June 03, 2019, 02:04:23 pm

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

Title: Re: First attempt for a solar system 2D
Post by: bplus on June 03, 2019, 02:29:38 pm

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.  

Title: Re: First attempt for a solar system 2D
Post by: TempodiBasic on June 04, 2019, 06:34:14 am

@Richard Frost

You have fascinated me!

I like demo!
I like precision of data!
I like old Basic coding style!

but the other face of the medal is that I loose my mind in these variables with one or two letters as name!
Yes only this let me have an urticaria  attach! I'm going to have a cortisone pill or to be stinged by a bee!
But this is a my problem.

Thanks to share Frost

Title: Re: First attempt for a solar system 2D
Post by: TempodiBasic on June 04, 2019, 06:45:34 am

@Bplus

Cool!  [ This attachment cannot be displayed inline in 'Print Page' view ]  
Hey but have you tried to draw Indian Chakras? https://en.wikipedia.org/wiki/Chakra (https://en.wikipedia.org/wiki/Chakra)

Title: Re: First attempt for a solar system 2D
Post by: TempodiBasic on June 24, 2019, 04:10:35 pm

Hi another little step towards solar system maker

  [ This attachment cannot be displayed inline in 'Print Page' view ]  
each planet has its speed, dimension, color and can have its moons that have their speed, dimension and color.

but the screen is too little to see all the system! :-)

I must rethink how to output the data on the screen using a different basis!

Here code:

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 = 35, MaxPlanet = 8, MaxMoon = 10
15.  
16. CONST Black = _RGBA32(0, 0, 0, 255)
17. CONST NameColor = _RGBA32(255, 255, 255, 255)
18.  
19. DIM SHARED A AS LONG, Sun AS Planet, Planets(1 TO MaxPlanet * MaxMoon) AS Planet
20. DIM SHARED ShowName AS INTEGER, PDistance 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 = 50
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.     PDistance = 0
57.     FOR w = 1 TO MaxPlanet STEP 1
58.         radius = INT(RND * 15) + 10
59.         distance = INT(RND * 2 * r) + (2 * r)
60.  
61.         PDistance = PDistance + distance
62.         '          Index, radius, distance from parent, parent
63.         MakePlanet w, radius, PDistance, 0
64.         RandomMoon w
65.     NEXT w
66.     ShowName = False
67. END SUB
68.  
69. SUB RandomMoon (Index AS INTEGER)
70.     DIM z AS INTEGER, newR AS INTEGER
71.     IF INT(RND * 3) + 1 > 1 THEN
72.         FOR z = 1 TO INT(RND * (MaxMoon - 1)) + 1
73.             ' index moon, 1/2 radius, Parent
74.             newR = INT(RND * INT(Planets(Index).Radius / 3)) + 1
75.             MakePlanet z + MaxPlanet, newR, INT(Planets(Index).Radius) + (2 * newR), Index
76.         NEXT
77.     END IF
78. END SUB
79.  
80. SUB DrawSun
81.     CircleFill WScreen / 2, HScreen / 2, Sun.Radius, Sun.Colors
82.     IF ShowName = True THEN COLOR NameColor: _PRINTSTRING (WScreen / 2, HScreen / 2), Sun.Names
83. END SUB
84.  
85. SUB Draws
86.     DIM w AS INTEGER
87.     CLS , Black
88.     DrawSun
89.     FOR w = 1 TO MaxPlanet + MaxMoon
90.         IF Planets(w).Radius > 0 THEN ShowPlanet w
91.     NEXT w
92. END SUB
93.  
94. SUB MakePlanet (Index AS INTEGER, r AS SINGLE, d AS SINGLE, p AS INTEGER)
95.     Planets(Index).Radius = r
96.     Planets(Index).Angle = INT(RND * 360)
97.     Planets(Index).Distance = d
98.     Planets(Index).Names = STR$(Index)
99.     Planets(Index).Parent = p
100.     Planets(Index).Speed = 0.01 + (RND * 0.05)
101.     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)
102. END SUB
103.  
104. SUB ShowPlanet (Index AS INTEGER)
105.     DIM Sinus AS SINGLE, Cosinus AS SINGLE
106.     DIM Xcircle AS SINGLE, Ycircle AS SINGLE, Rcircle AS INTEGER
107.     DIM Cosinus2 AS SINGLE, Sinus2 AS SINGLE
108.     Sinus = SIN(Planets(Index).Angle)
109.     Cosinus = COS(Planets(Index).Angle)
110.     ' parent is an important Flag both to choose X,y of circle
111.     ' both to understand if it is a planet around the sun or a moon around a planet
112.  
113.     IF Planets(Index).Parent = 0 AND Planets(Index).Names <> "SUN" THEN
114.         Xcircle = (WScreen / 2)
115.         Ycircle = (HScreen / 2)
116.     ELSEIF Planets(Index).Parent > 0 THEN
117.         Sinus2 = SIN(Planets(Planets(Index).Parent).Angle)
118.         Cosinus2 = COS(Planets(Planets(Index).Parent).Angle)
119.         Xcircle = ((Planets(Planets(Index).Parent).Distance * Cosinus2) + (WScreen / 2))
120.         Ycircle = ((Planets(Planets(Index).Parent).Distance * Sinus2) + (HScreen / 2))
121.     END IF
122.     Rcircle = Planets(Index).Radius
123.     Xcircle = Xcircle + (Planets(Index).Distance * Cosinus)
124.     Ycircle = Ycircle + (Planets(Index).Distance * Sinus)
125.     CircleFill Xcircle, Ycircle, Rcircle, Planets(Index).Colors
126.     IF ShowName = True THEN COLOR NameColor: _PRINTSTRING (Xcircle, Ycircle), Planets(Index).Names
127. END SUB
128.  
129.  
130. SUB CircleFill (CX AS INTEGER, CY AS INTEGER, R AS INTEGER, C AS _UNSIGNED LONG)
131.     ' CX = center x coordinate
132.     ' CY = center y coordinate
133.     '  R = radius
134.     '  C = fill color
135.     DIM Radius AS INTEGER, RadiusError AS INTEGER
136.     DIM X AS INTEGER, Y AS INTEGER
137.     Radius = ABS(R)
138.     RadiusError = -Radius
139.     X = Radius
140.     Y = 0
141.     IF Radius = 0 THEN PSET (CX, CY), C: EXIT SUB
142.     LINE (CX - X, CY)-(CX + X, CY), C, BF
143.     WHILE X > Y
144.         RadiusError = RadiusError + Y * 2 + 1
145.         IF RadiusError >= 0 THEN
146.             IF X <> Y + 1 THEN
147.                 LINE (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
148.                 LINE (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
149.             END IF
150.             X = X - 1
151.             RadiusError = RadiusError - X * 2
152.         END IF
153.         Y = Y + 1
154.         LINE (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
155.         LINE (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
156.     WEND
157. END SUB

Thanks to see
Your MOD are welcome! I like to learn! But I go on my way because also direct experience does knowledge.

Title: Re: First attempt for a solar system 2D
Post by: johnno56 on June 25, 2019, 09:06:56 am

I have been into Astronomy since I was about 15. Not so much now as my eyesight isn't what it used to be.... lol

My suggestion when trying to scale size AND distance in a computer simulation.... Don't. There is nothing wrong with a system that is scaled to your desktop resolution and you are using a standard size discs for each object. Just to give you an idea... If you placed a model of the Sun (1 metre diameter) in London, using the same scale, Pluto would be here in Melbourne Australia. Scale the Sun down to 1 cm and you would be lucky to fit Mercury on the same screen... Just to see the relative movement of the planets, small discs, work just fine.  This is my opinion. Different colours are a great idea...

I had an old Amstrad CPC464 back in 1985. Max screen resolution of 640x400. I had to display the system in two screens. The inner planets out to Mars and the outer planets. Watching it draw the orbits then the planet was tiresome. Poor machine only had a CPU speed of 4mhz. But the wait was worth it...

I think you have done a great job. Makes me wish I had my scope, and eyesight, back again.... Thank you.

Title: Re: First attempt for a solar system 2D
Post by: johnno56 on June 25, 2019, 10:55:37 am

I watched the videos. That guy is one strange presenter. He knows his stuff but I think he has a few kangaroos loose in his top paddock.

His 2D videos made a little sense - there were times he lost me - but it seemed to make sense. I know absolutely nothing about the language he was using but it was fun watching him trying to explain 2D orbits etc... But when he moved to 3D.... I really tried to follow along but that stuff was WAY over my head... It was interesting, but almost all of the 3D stuff, was so hard to follow I just couldn't cope... The results were amazing but how he got there just baked the old noodle... lol

I would still like to make a relatively accurate (movement anyway) model of the Solar System at least once before I "shuffle off"... I am still looking for a tutorial etc in 'basic'... I'm going to study your example and see if there is any way to incorporate some 'real' data... I'm not sure if my skill level is up to it, but it might be fun to try... lol

Title: Re: First attempt for a solar system 2D
Post by: johnno56 on June 25, 2019, 05:47:18 pm

I finally got to bed at about 2am.... I managed to get all nine planets on the screen - almost - and no, I will not get into the discussion of Pluto's downgrading to a dwarf planet... lol

I modified my resolution to 1920x1080 (sorry Laptops...). Used the maximum Y axis for Pluto's orbit which is about 40 Astronomical Units from the Sun. Converted all the other planetary orbits accordingly. At this point, including the Sun, everything is a small disc. I am currently working on the velocity of each planet. In this model ALL orbits are assumed circular. Calculating the circumference of each orbit, factoring the length of time it takes for each planet to complete a single orbit, the relative velocity of each planet can be roughly calculated. All I have to do now is to translate those velocities to a figure that your model can use.... My brain hurts... I need coffee....

Title: Re: First attempt for a solar system 2D
Post by: OldMoses on June 27, 2019, 07:43:01 am

This is good stuff that I'm going to have to study. I want to incorporate something like this into my vector plotter. That way my ships would have to be careful not to smack a celestial body while doing their maneuvers.

https://www.qb64.org/forum/index.php?topic=1429.0 (https://www.qb64.org/forum/index.php?topic=1429.0)

Text Only | Text with Attachments