Drawing 20 planets with graphical commands

[Delsus]

Hello team! I thought I would share a bit of fun code with graphical statements, to draw planets randomly. Trying to make it as beautiful as possible.

Code: (Select All)

Screen _NewImage(800, 600, 32)

_Title "20 Beautiful Planets in QB64PE"

Randomize Timer

Type PlanetData

    x As Integer

    y As Integer

    radius As Integer

    r As Integer

    g As Integer

    b As Integer

    hasRings As Integer

    ringAngle As Single

    atmosphere As Integer

    spots As Integer

End Type



Dim Shared Planets(1 To 20) As PlanetData

Dim Shared i As Integer

Dim Shared f As Long



f = _LoadFont("Arial.ttf", 16, "MONOSPACE")

If f > 0 Then _Font f



For i = 1 To 20

    Planets(i).x = 70 + ((i - 1) Mod 5) * 150

    Planets(i).y = 70 + ((i - 1) \ 5) * 120

    Planets(i).radius = 20 + Rnd * 25

    Planets(i).hasRings = IIf(Rnd > 0.5, -1, 0)

    Planets(i).ringAngle = Rnd * _Pi

    Planets(i).atmosphere = IIf(Rnd > 0.3, -1, 0)

    Planets(i).spots = Int(Rnd * 8) + 2

    Select Case i

        Case 1: ' Blue gas giant

            Planets(i).r = 50: Planets(i).g = 100: Planets(i).b = 200

        Case 2: ' Red desert planet

            Planets(i).r = 180: Planets(i).g = 80: Planets(i).b = 60

        Case 3: ' Green jungle planet

            Planets(i).r = 60: Planets(i).g = 150: Planets(i).b = 80

        Case 4: ' Purple crystal planet

            Planets(i).r = 150: Planets(i).g = 70: Planets(i).b = 200

        Case 5: ' Orange lava planet

            Planets(i).r = 220: Planets(i).g = 120: Planets(i).b = 40

        Case 6: ' Ice planet

            Planets(i).r = 200: Planets(i).g = 230: Planets(i).b = 250

        Case 7: ' Brown rocky planet

            Planets(i).r = 140: Planets(i).g = 110: Planets(i).b = 90

        Case 8: ' Pink nebula planet

            Planets(i).r = 230: Planets(i).g = 150: Planets(i).b = 200

        Case 9: ' Yellow sun-like

            Planets(i).r = 240: Planets(i).g = 220: Planets(i).b = 100

        Case 10: ' Teal ocean planet

            Planets(i).r = 70: Planets(i).g = 180: Planets(i).b = 170

        Case 11: ' Maroon volcanic

            Planets(i).r = 120: Planets(i).g = 40: Planets(i).b = 50

        Case 12: ' Cyan gas giant

            Planets(i).r = 80: Planets(i).g = 200: Planets(i).b = 220

        Case 13: ' Gold metallic

            Planets(i).r = 210: Planets(i).g = 180: Planets(i).b = 80

        Case 14: ' Emerald green

            Planets(i).r = 40: Planets(i).g = 180: Planets(i).b = 120

        Case 15: ' Deep blue

            Planets(i).r = 30: Planets(i).g = 70: Planets(i).b = 150

        Case 16: ' Rust planet

            Planets(i).r = 170: Planets(i).g = 90: Planets(i).b = 70

        Case 17: ' Lilac planet

            Planets(i).r = 180: Planets(i).g = 140: Planets(i).b = 220

        Case 18: ' Turquoise

            Planets(i).r = 70: Planets(i).g = 210: Planets(i).b = 190

        Case 19: ' Copper

            Planets(i).r = 190: Planets(i).g = 130: Planets(i).b = 100

        Case 20: ' Violet storm

            Planets(i).r = 130: Planets(i).g = 80: Planets(i).b = 180

    End Select

Next i

Cls , _RGB32(5, 5, 20)



For i = 1 To 200

    PSet (Rnd * 800, Rnd * 600), _RGB32(200 + Rnd * 55, 200 + Rnd * 55, 200 + Rnd * 55)

Next i



For i = 1 To 5

    DrawNebula Rnd * 800, Rnd * 600, Int(Rnd * 100) + 50

Next i



For i = 1 To 20

    DrawPlanet Planets(i)

Next i





Color _RGB32(180, 180, 255)

_PrintMode _KeepBackground

_PrintString (320, 550), "Press SPACE to regenerate"

_PrintString (350, 570), "Press ESC to exit"





Do

    k$ = InKey$

    If k$ = " " Then

        Randomize Timer

        For i = 1 To 20

            Planets(i).radius = 20 + Rnd * 25

            Planets(i).hasRings = IIf(Rnd > 0.5, -1, 0)

            Planets(i).ringAngle = Rnd * _Pi

            Planets(i).atmosphere = IIf(Rnd > 0.3, -1, 0)

            Planets(i).spots = Int(Rnd * 8) + 2

        Next i

        Cls , _RGB32(5, 5, 20)

        For i = 1 To 200

            PSet (Rnd * 800, Rnd * 600), _RGB32(200 + Rnd * 55, 200 + Rnd * 55, 200 + Rnd * 55)

        Next i

        For i = 1 To 5

            DrawNebula Rnd * 800, Rnd * 600, Int(Rnd * 100) + 50

        Next i

        For i = 1 To 20

            DrawPlanet Planets(i)

        Next i

        Color _RGB32(180, 180, 255)

        _PrintString (320, 550), "Press SPACE to regenerate"

        _PrintString (350, 570), "Press ESC to exit"

    End If

    _Limit 30

Loop Until k$ = Chr$(27)



System



Sub DrawPlanet (p As PlanetData)



    For r = p.radius To 0 Step -1

        intensity = 0.3 + 0.7 * (r / p.radius)

        Circle (p.x - 3, p.y - 3), r, _RGB32(p.r * intensity * 0.3, p.g * intensity * 0.3, p.b * intensity * 0.3)

    Next r

    For r = p.radius To 0 Step -1

        intensity = 0.5 + 0.5 * (r / p.radius)

        gradient = 0.7 + 0.3 * Sin(r * _Pi / p.radius)

        Circle (p.x, p.y), r, _RGB32(p.r * intensity * gradient, p.g * intensity * gradient, p.b * intensity * gradient)

    Next r

    If p.atmosphere Then

        For r = p.radius + 3 To p.radius + 10 Step 1

            alpha = 50 - (r - p.radius - 3) * 7

            If alpha > 0 Then

                Circle (p.x, p.y), r, _RGBA32(p.r, p.g, p.b, alpha)

            End If

        Next r

    End If

    If p.hasRings Then

        DrawRings p.x, p.y, p.radius, p.ringAngle, p.r, p.g, p.b

    End If

    DrawSurfaceDetails p.x, p.y, p.radius, p.spots, p.r, p.g, p.b

    For r = p.radius \ 3 To 0 Step -1

        intensity = 0.8 + 0.2 * (r / (p.radius \ 3))

        Circle (p.x - p.radius \ 3, p.y - p.radius \ 3), r, _RGBA32(255, 255, 255, 100 * intensity)

    Next r

End Sub



Sub DrawRings (x, y, radius, angle, r, g, b)

    For ring = 1 To 3

        ringRadius = radius + 15 + ring * 5

        ringWidth = 3

        For w = -ringWidth To ringWidth

            For a = 0 To _Pi(2) Step 0.01

                rx = ringRadius * Cos(a)

                ry = (ringRadius + w) * Sin(a) * 0.3

                rx2 = rx * Cos(angle) - ry * Sin(angle)

                ry2 = rx * Sin(angle) + ry * Cos(angle)

                distFromCenter = Abs(w) / ringWidth

                alpha = 150 * (1 - distFromCenter)

                ringColor = _RGBA32(r + 30, g + 30, b + 30, alpha)

                PSet (x + rx2, y + ry2), ringColor

            Next a

        Next w

    Next ring

End Sub



Sub DrawSurfaceDetails (x, y, radius, numSpots, baseR, baseG, baseB)

    For spot = 1 To numSpots

        angle = Rnd * _Pi(2)

        distance = Rnd * radius * 0.8

        spotX = x + distance * Cos(angle)

        spotY = y + distance * Sin(angle)

        spotSize = radius * (0.1 + Rnd * 0.2)

        spotType = Int(Rnd * 3)

        Select Case spotType

            Case 0:

                spotR = baseR * 0.5

                spotG = baseG * 0.5

                spotB = baseB * 0.5

            Case 1:

                spotR = _Min(255, baseR * 1.3)

                spotG = _Min(255, baseG * 1.3)

                spotB = _Min(255, baseB * 1.3)

            Case 2:

                spotR = _Min(255, baseG * 1.2)

                spotG = _Min(255, baseB * 1.2)

                spotB = _Min(255, baseR * 1.2)

        End Select

        For r = spotSize To 0 Step -1

            alpha = 200 * (r / spotSize)

            Circle (spotX, spotY), r, _RGBA32(spotR, spotG, spotB, alpha)

        Next r

        If Rnd > 0.7 Then

            craterSize = spotSize * 0.5

            Circle (spotX + craterSize * 0.3, spotY + craterSize * 0.3), craterSize, _RGB32(baseR * 0.3, baseG * 0.3, baseB * 0.3)

            Circle (spotX + craterSize * 0.2, spotY + craterSize * 0.2), craterSize * 0.7, _RGB32(baseR * 0.7, baseG * 0.7, baseB * 0.7)

        End If

    Next spot

End Sub



Sub DrawNebula (x, y, size)

    For i = 1 To 5

        nx = x + (Rnd - 0.5) * size

        ny = y + (Rnd - 0.5) * size

        ns = size * (0.3 + Rnd * 0.3)

        nr = 50 + Rnd * 100

        ng = 50 + Rnd * 100

        nb = 100 + Rnd * 100

        For r = ns To 0 Step -1

            alpha = 30 * (r / ns)

            Circle (nx, ny), r, _RGBA32(nr, ng, nb, alpha)

        Next r

    Next i

End Sub



Function IIf% (condition, trueValue, falseValue)

    If condition Then

        IIf = trueValue

    Else

        IIf = falseValue

    End If

End Function

Let me know what you think!

[Unseen Machine]

Not bad at all, I like the atmosphere affect especially.

One tweak I could suggest is when you draw your rings the back bits should be obscured by the planets but other than thast, good job! + 1

John

[OldMoses]

That's a very pleasing graphic to the eye.

Doing ring obscuring is quite a challenge. I added that to my space flight program, but I was using _PUTIMAGE to split the planets in two, then draw one half of the planet, then draw the rings, then draw the other half while switching between _BLEND and _DONTBLEND to get the foreground part of the ring to be translucent. In my case, I wasn't angling my planets, but once you have an image, Rotozoom can tilt it.

[grymmjack]

This is good thank you for sharing. One thing I would suggest you check into is SVG format, because you can do a LOT with it.

QB64PE has the ability to use vector graphics with SVG format so you could render to raster using it, but also gain all the nice workflow of using procedural SVG to create beautiful planets. You get filled shapes, gradients, opacities, etc.
https://developer.mozilla.org/en-US/docs...ce/Element

Check out the QB64 PE Manual here on _LOADIMAGE (scroll down to example 4 which shows how to use a string of SVG and then load into an image)

You can use Inkscape to make SVG graphics and reverse engineer them as well:
https://inkscape.org

Not to overwhelm you but here is an example of someone doing a solar system:
https://cloudfour.com/thinks/generating-...the-scene/

Thanks for sharing your program.

You may get more responses / comments if you share a screenshot with your code. It was a small snippet so I just added one for you.

[bplus]

How to draw a ring around a planet with just QB64. Basically draw the back half of the ellipse ring draw the planet then draw the front half of the ellipse ring.

Code: (Select All)

Option _Explicit



_Title "Arc of Ellisps" 'b+ 2021-12-25



Dim sw, sh

sw = 600: sh = 600



Screen _NewImage(sw, sh, 32)

_ScreenMove 300, 200



ArcRingOfEllipse sw / 2, sh / 2, 120, 200, _Pi(0), _Pi(1), .25, &HFFAAAAFF

Ring sw / 2, sh / 2, 0, 85, &HFF880088

ArcRingOfEllipse sw / 2, sh / 2, 120, 200, _Pi(1), _Pi(1.999), .25, &HFFAAAAFF



Sub Ring (cx, cy, innerRadius, outerRadius, colr~&) ' wont work well with alpha's < 255

    Dim r

    For r = innerRadius To outerRadius Step .25

        Circle (cx, cy), r, colr~&

    Next

End Sub



'ra's here go Counter Clockwise from East

Sub ArcRing (cx, cy, innerRadius, outerRadius, raStart, raEnd, colr~&) ' ra's 0 to <2*pi (almost)

    Dim r

    For r = innerRadius To outerRadius Step .25

        Circle (cx, cy), r, colr~&, raStart, raEnd

    Next

End Sub



'ra's here go Counter Clockwise from East

Sub ArcRingOfEllipse (cx, cy, innerRadius, outerRadius, raStart, raEnd, aspect, colr~&) ' ra's 0 to <2*pi (almost)

    Dim r

    For r = innerRadius To outerRadius Step .25

        Circle (cx, cy), r, colr~&, raStart, raEnd, aspect

    Next

End Sub

If you are not familiar with Radians: to convert Degrees to Radians (ra = radian angle 0 to _Pi(2)) use D2R() function. Radians are just another scale system for angle measures and used for all trig functions as opposed to Degrees.

If you want to draw ellipse rings that are transparent, Steve's recent Ellipse.Arc.Ring stuff might work because he is using scan lines that dont overlap. That's what you need for transparencies without overlap (no stripes and you can see whats under the drawing). https://qb64phoenix.com/forum/showthread...1#pid34131

As OldMoses mentioned, you can tilt the ellipsii with Rotozoom (after putting the image like above into a contianer with an image handle eg Image below) x,y is your planet center, scale just use 1 for no shrink nor expanding and degreesRotation the angle to shift the ellipse to. 

Code: (Select All)

Sub RotoZoom (X As Long, Y As Long, Image As Long, Scale As Single, degreesRotation As Single)
    Dim px(3) As Single, py(3) As Single, W&, H&, sinr!, cosr!, i&, x2&, y2&
    W& = _Width(Image&): H& = _Height(Image&)
    px(0) = -W& / 2: py(0) = -H& / 2: px(1) = -W& / 2: py(1) = H& / 2
    px(2) = W& / 2: py(2) = H& / 2: px(3) = W& / 2: py(3) = -H& / 2
    sinr! = Sin(-degreesRotation / 57.2957795131): cosr! = Cos(-degreesRotation / 57.2957795131)
    For i& = 0 To 3
        x2& = (px(i&) * cosr! + sinr! * py(i&)) * Scale + X: y2& = (py(i&) * cosr! - px(i&) * sinr!) * Scale + Y
        px(i&) = x2&: py(i&) = y2&
    Next
    _MapTriangle (0, 0)-(0, H& - 1)-(W& - 1, H& - 1), Image& To(px(0), py(0))-(px(1), py(1))-(px(2), py(2))
    _MapTriangle (0, 0)-(W& - 1, 0)-(W& - 1, H& - 1), Image& To(px(0), py(0))-(px(3), py(3))-(px(2), py(2))
End Sub

[bplus]

Oh putting an image into a container you will need to know about _PutImage here is a little tutorial on that:
https://qb64phoenix.com/forum/showthread...25#pid9825

[bplus]

here is demo adding tilts to the rings using RotoZoom and _PutImage, more advanced graphics commands:

Code: (Select All)

Option _Explicit



_Title "Arc of Ellipse 2 add tilt demo" 'b+ 2021-12-25 tilt added 2026-02-07



Dim sw, sh, img&, x, y, tilt

sw = 600: sh = 600



Screen _NewImage(sw, sh, 32)

_ScreenMove 300, 200



ArcRingOfEllipse sw / 2, sh / 2, 120, 200, _Pi(0), _Pi(1), .25, &HFFAAAAFF

Ring sw / 2, sh / 2, 0, 85, &HFF880088

ArcRingOfEllipse sw / 2, sh / 2, 120, 200, _Pi(1), _Pi(1.999), .25, &HFFAAAAFF



' copy this image into a container

img& = _NewImage(sw, sh, 32) ' screen sized container

_PutImage , 0, img& ' the easiest use of _PutImage!!!

Cls ' disappear screen image

' now RotoZoom image

tilt = 65

For y = 150 To 450 Step 300

    For x = 150 To 450 Step 300

        RotoZoom x, y, img&, .25, tilt

        tilt = tilt + 65

    Next

Next



Sub Ring (cx, cy, innerRadius, outerRadius, colr~&) ' wont work well with alpha's < 255

    Dim r

    For r = innerRadius To outerRadius Step .25

        Circle (cx, cy), r, colr~&

    Next

End Sub



'ra's here go Counter Clockwise from East

Sub ArcRing (cx, cy, innerRadius, outerRadius, raStart, raEnd, colr~&) ' ra's 0 to <2*pi (almost)

    Dim r

    For r = innerRadius To outerRadius Step .25

        Circle (cx, cy), r, colr~&, raStart, raEnd

    Next

End Sub



'ra's here go Counter Clockwise from East

Sub ArcRingOfEllipse (cx, cy, innerRadius, outerRadius, raStart, raEnd, aspect, colr~&) ' ra's 0 to <2*pi (almost)

    Dim r

    For r = innerRadius To outerRadius Step .25

        Circle (cx, cy), r, colr~&, raStart, raEnd, aspect

    Next

End Sub



Sub RotoZoom (X As Long, Y As Long, Image As Long, Scale As Single, degreesRotation As Single)

    Dim px(3) As Single, py(3) As Single, W&, H&, sinr!, cosr!, i&, x2&, y2&

    W& = _Width(Image&): H& = _Height(Image&)

    px(0) = -W& / 2: py(0) = -H& / 2: px(1) = -W& / 2: py(1) = H& / 2

    px(2) = W& / 2: py(2) = H& / 2: px(3) = W& / 2: py(3) = -H& / 2

    sinr! = Sin(-degreesRotation / 57.2957795131): cosr! = Cos(-degreesRotation / 57.2957795131)

    For i& = 0 To 3

        x2& = (px(i&) * cosr! + sinr! * py(i&)) * Scale + X: y2& = (py(i&) * cosr! - px(i&) * sinr!) * Scale + Y

        px(i&) = x2&: py(i&) = y2&

    Next



    _MapTriangle (0, 0)-(0, H& - 1)-(W& - 1, H& - 1), Image& To(px(0), py(0))-(px(1), py(1))-(px(2), py(2))

    _MapTriangle (0, 0)-(W& - 1, 0)-(W& - 1, H& - 1), Image& To(px(0), py(0))-(px(3), py(3))-(px(2), py(2))

End Sub

   

[ahenry3068]

Now someone @bplus Needs to take some of these Planets and sprinkle them into the standard "warping Starfield" screen blanker display !

[dbox]

Now someone @bplus Needs to take some of these Planets and sprinkle them into the standard "warping Starfield" screen blanker display !

Reminds me of this one that vince did:
https://boxgaming.github.io/qbjs-samples...rscape.bas

[ahenry3068]

Now someone @bplus Needs to take some of these Planets and sprinkle them into the standard "warping Starfield" screen blanker display !

Reminds me of this one that vince did:
https://boxgaming.github.io/qbjs-samples...rscape.bas

   Very close to what I had in mind !