Planetary System Animation

[James D Jarvis]

A simple program that randomly generates a planetary system showing the main star, some planets, and moons.  There's no physics here and sizes are exaggerated so there is something to see.

EDIT: corrected the value to generate nump so it's the same in both locations in the program.

Code: (Select All)

'planetary system animation
'by James D, Jarvis 10/10/2022
'
' a simple planetary system animation generator, planets and moons orbiting a star
' <esc> to exit
' press "n" for a new system
'feel free to modify for your own use as you wish
Screen _NewImage(1200, 800, 32)
_FullScreen _SquarePixels
Randomize Timer
_Define K As _UNSIGNED LONG
stars& = _NewImage(1200, 800, 32)
_Dest stars&
For s = 1 To 1200
    PSet (Rnd * _Width, Rnd * _Height), _RGB32(240 + Rnd * 15, 240 + Rnd * 15, 240 + Rnd * 15)
Next s
_Dest 0
Type planet_type
    orbit As Double
    size As Double
    kp As _Unsigned Long
    rate As Double
    ppos As Double
End Type
Dim Shared sunx, suny, mooncount(20)
sunx = _Width / 2: suny = _Height / 2: sunr = 10 + Int(Rnd * 40): Ksun = _RGB32(250, 200 + sunr, 0)
Dim Shared planet(20) As planet_type
Dim Shared moon(20, 12) As planet_type
Nump = Int(1 + Rnd * 20)
For p = 1 To Nump
    planet(p).orbit = p * (sunr * 1.5) + Rnd * 10
    planet(p).size = 1 + Int(Rnd * 8)
    planet(p).kp = _RGB32(Int(5 + Rnd * 250), Int(5 + Rnd * 250), Int(5 + Rnd * 250))
    planet(p).rate = (5 / p) / (50 / Sqr(sunr))
    planet(p).ppos = Int(Rnd * 360)
    If p > 1 Then
        nm = (Int(Rnd * (p + 3)))
        If nm > 12 Then nm = Int(nm / 2)
        mooncount(p) = nm
        For m = 1 To mooncount(p)
            moon(p, m).orbit = m * (planet(p).size * 1.5) + Rnd * 10
            moon(p, m).size = .5 + Int(Rnd * (planet(p).size / 3))
            moon(p, m).kp = _RGB32(Int(200 + Rnd * 53), Int(200 + Rnd * 53), Int(200 + Rnd * 53))
            moon(p, m).rate = ((5 / p) / _Pi) * (1 + Rnd * 3)
            moon(p, m).ppos = Int(Rnd * 360)
        Next m
    End If
Next p


Do
    _Limit 60
    Cls
    _PutImage , stars&, 0
    circleBF sunx, suny, sunr, Ksun
    For n = 1 To Nump
        drawplanet n
    Next
    _Display
    kk$ = InKey$
    If kk$ = "n" Then
        stars& = _NewImage(800, 800, 32)
        _Dest stars&
        For s = 1 To 1200
            PSet (Rnd * _Width, Rnd * _Height), _RGB32(240 + Rnd * 15, 240 + Rnd * 15, 240 + Rnd * 15)
        Next s
        _Dest 0
        sunr = 10 + Int(Rnd * 40): Ksun = _RGB32(100 + sunr * 2 + Rnd * 50, sunr * 4 + Rnd * 50, 0)
        Nump = Int(1 + Rnd * 20)
        For p = 1 To Nump
            planet(p).orbit = p * (sunr * 1.5) + Rnd * 10
            planet(p).size = 1 + Int(Rnd * 8)
            planet(p).kp = _RGB32(Int(5 + Rnd * 250), Int(5 + Rnd * 250), Int(5 + Rnd * 250))
            planet(p).rate = (5 / p) / (50 / Sqr(sunr))
            planet(p).ppos = Int(Rnd * 360)
            If p > 1 Then
                nm = (Int(Rnd * (p + 3)))
                If nm > 12 Then nm = Int(nm / 2)
                mooncount(p) = nm
                For m = 1 To mooncount(p)
                    moon(p, m).orbit = (planet(p).size * 1.5) + m * planet(p).size
                    moon(p, m).size = .5 + Int(Rnd * (planet(p).size / 3))
                    moon(p, m).kp = _RGB32(Int(200 + Rnd * 53), Int(200 + Rnd * 53), Int(200 + Rnd * 53))
                    moon(p, m).rate = ((5 / p) / _Pi) * (1 + Rnd * 3)
                    moon(p, m).ppos = Int(Rnd * 360)
                Next m
            End If
        Next p
    End If
Loop Until kk$ = Chr$(27)

_FreeImage stars&

Sub circleBF (cx As Long, cy As Long, r As Long, klr As _Unsigned Long)
    rsqrd = r * r
    y = -r
    While y <= r
        x = Sqr(rsqrd - y * y)
        Line (cx - x, cy + y)-(cx + x, cy + y), klr, BF
        y = y + 1
    Wend
End Sub


Sub drawplanet (p)
    x = planet(p).orbit * Sin(0.01745329 * planet(p).ppos)
    y = planet(p).orbit * Cos(0.01745329 * planet(p).ppos)
    x2 = (planet(p).orbit - planet(p).size / 2) * Sin(0.01745329 * planet(p).ppos)
    y2 = (planet(p).orbit - planet(p).size / 2) * Cos(0.01745329 * planet(p).ppos)
    x3 = (planet(p).orbit - planet(p).size / 3) * Sin(0.01745329 * planet(p).ppos)
    y3 = (planet(p).orbit - planet(p).size / 3) * Cos(0.01745329 * planet(p).ppos)
    pr = _Red(planet(p).kp)
    pg = _Green(planet(p).kp)
    pb = _Blue(planet(p).kp)
    planet(p).ppos = planet(p).ppos + planet(p).rate
    circleBF sunx + x, suny + y, planet(p).size, planet(p).kp
    circleBF sunx + x2, suny + y2, planet(p).size / 2.5, _RGB32(pr * 1.1, pg * 1.1, pb * 1.05)
    circleBF sunx + x3, suny + y3, planet(p).size / 4, _RGB32(pr * 1.2, pg * 1.2, pb * 1.1)
    If mooncount(p) > 0 Then
        For m = 1 To mooncount(p)
            mx = moon(p, m).orbit * Sin(0.01745329 * moon(p, m).ppos)
            my = moon(p, m).orbit * Cos(0.01745329 * moon(p, m).ppos)
            circleBF sunx + x + mx, suny + y + my, moon(p, m).size, moon(p, m).kp
            moon(p, m).ppos = moon(p, m).ppos + moon(p, m).rate
        Next m
    End If
End Sub

[Kernelpanic]

A simple program that randomly generates a planetary system showing the main star, some planets, and moons.  There's no physics here and sizes are exaggerated so there is something to see.

EDIT: corrected the value to generate nump so it's the same in both locations in the program.

Unfortunately, the computer hung up completely! Black screen and the only way out was to turn it off. 

[bplus]

Works fine for me
   

I like Jarvis work, we have parallel interests.

[James D Jarvis]

A simple program that randomly generates a planetary system showing the main star, some planets, and moons.  There's no physics here and sizes are exaggerated so there is something to see.

EDIT: corrected the value to generate nump so it's the same in both locations in the program.

Unfortunately, the computer hung up completely! Black screen and the only way out was to turn it off. 

really?   The program doesn't do anything fancy. Maybe it didn't copy correctly?????

[Kernelpanic]

A simple program that randomly generates a planetary system showing the main star, some planets, and moons.  There's no physics here and sizes are exaggerated so there is something to see.

EDIT: corrected the value to generate nump so it's the same in both locations in the program.

Unfortunately, the computer hung up completely! Black screen and the only way out was to turn it off. 

really?   The program doesn't do anything fancy. Maybe it didn't copy correctly?????

Yes, really! It can't be due to copying, I always copy with "Select all" and have never had any problems with it.

After pressing F5 the translation started, and then . . . the hard drive rumbled and the screen went black, no button responded. I could only move the mouse. After two minutes I pressed the power button.

My system:

[a740g]

Unfortunately, the computer hung up completely! Black screen and the only way out was to turn it off. 

really?   The program doesn't do anything fancy. Maybe it didn't copy correctly?????

Yes, really! It can't be due to copying, I always copy with "Select all" and have never had any problems with it.

After pressing F5 the translation started, and then . . . the hard drive rumbled and the screen went black, no button responded. I could only move the mouse. After two minutes I pressed the power button.

My system:

Works fine for me too. Something wrong with your system or QB64 installation maybe?

[James D Jarvis]

The hard drive rumbled? The program itself doesn't write to the drive at all (QB64 will of course do so when it creates the executable file). So I'm thinking you may have a memory problem on your hands maybe because of a freak bug because this just writes to the screen and an equally sized image with standard graphics commands (no fancy mem calls or peeking and poking), which is cleaned up by freeimage on exit. It's a mystery to me.

I have a goofy version that creates up to 3000 moons per planet and it still runs fine.

[Kernelpanic]

I can see how the drive is working from the flashing diode, and one of course one can hear it too, discreetly.

Something doesn't add up. I've experienced something like this before with software I bought: CorelDRAW 7. After installing it, my computer crashed three times after about every times 10 days.

After the first time I was still wondering what it could be. After the second time I had my first suspicion, and after the third installation of CorelDRAW 7 plus the crash I knew it. I didn't install it again and my computer ran smoothly again. I think the problem was my settings in the autoexece.bat back then, but I needed them.
There were no problems with CorelDRAW 9 - I still use it today with Win 10 Prof without any problems.

Ok, I don't feel like a second crash with reboot right now - maybe I'll try again tomorrow.

[Kernelpanic]

If I gone immediately without logging off, the computer hung up again. . .

It works now. Who knows what happened again yesterday. Looks well!

[James D Jarvis]

If I gone immediately without logging off, the computer hung up again. . .

It works now. Who knows what happened again yesterday. Looks well!

Glad your computer survived the attempt. Back in the olden days I'd have cracked open my computer and made sure none of my ram chips were lose.