planetdoodle2

[James D Jarvis]

This is an earlier version of my alien skies program posted elsewhere here in this forum. I whipped this up a few months back when first using QB64 again. This is nowhere near as fancy as alien skies or as complicated in code. It's also just in 256 colors but it works well enough for what it does so I'm sharing it.

Code: (Select All)

'planetdoodle2
' By James D. Jarvis
' a 256 color planet picture generator
' type quit   to leave program, press enter to go on
Screen _NewImage(800, 500, 256)
Cls
redstart = 17
redstop = 32
orangestart = 33
orangestop = 48
yellowstart = 49
yellowstop = 64
greenstart = 65
greenstop = 80
bluestart = 81
bluestop = 96
purplestart = 97
purplestop = 112
greystart = 113
greystop = 128
brownstart = 129
brownstop = 144
pinkstart = 145
pinkstop = 160
whitestart = 161
whitestop = 176
cyanstart = 177
cyanstop = 192
neonstart = 193
neonstop = 208
mix1start = 209
mix1stop = 224
mix2start = 225
mix2stop = 240

Randomize Timer

For x = 0 To 15
    _PaletteColor redstart + x, _RGB32(x * 16, 0, 0)
    _PaletteColor bluestart + x, _RGB32(0, 0, x * 16)
    _PaletteColor greenstart + x, _RGB32(0, x * 16, 0)
    _PaletteColor yellowstart + x, _RGB32(x * 16, x * 16, 0)
    _PaletteColor purplestart + x, _RGB32(x * 16, 0, x * 16)
    _PaletteColor orangestart + x, _RGB32(x * 16, x * 12, 0)
    _PaletteColor greystart + x, _RGB32(x * 16, x * 16, x * 16)
    _PaletteColor brownstart + x, _RGB32(x * 8 + 37, x * 2 + 18, x * 3 + 17)
    _PaletteColor pinkstart + x, _RGB32(x * 4 + 191, x * 12, (x * 15))
    _PaletteColor whitestart + x, _RGB32(x * 2 + 223, x * 2 + 224, x * 2 + 225)
    _PaletteColor cyanstart + x, _RGB32(0, x * 8 + 127, x * 8 + 127)
    _PaletteColor neonstart + x, _RGB32(x * x, x * x, x * 2)
    _PaletteColor mix1start + x, _RGB32(x * x, x * x, x * x)
    _PaletteColor mix2start + x, _RGB32(255 - (x * x), x * x, x * x)
Next x

Cls
'shadded balls
planets:
'sky
stars = Int(Rnd * 3000)

horizon = 200 + Int(Rnd * 200)

hstart = 1
hstop = horizon
hkolor = Int(Rnd * 14)
hkolor = hkolor * 16 + 17
change = 0
For h = 0 To horizon
    Line (0, h)-(799, h), hkolor + change
    If Int(Rnd * 3) = 1 Then change = change + 1
    If change > 15 Then change = 15

Next h

For s = 1 To stars
    x = Int(Rnd * 800)
    y = Int(Rnd * horizon)
    sr = Int(Rnd * 10) + 1
    sr = Int(Sqr(sr))
    sr = sr / 3
    kk = whitestart + Int(Rnd * 16)
    Circle (x, y), sr, kk
    Paint (x, y), kk, kk
Next s

For balls = 1 To 5
    x = Int(Rnd * 700) + 100
    y = Int(Rnd * horizon) + 50
    ox = x
    oy = y
    rr = Int(Rnd * 60) + 20
    kk = Int(Rnd * 14)
    kk = kk * 16 + 17 + Int(Rnd * 4)
    Circle (x, y), rr, kk
    Paint (x, y), kk, kk
    ck = kk
    For inner = 1 To 4
        oldr = rr
        rr = Int(rr * .87)
        nc = Int((oldr - rr) / 2)
        x = x + nc
        y = y - nc
        kk = kk + inf(Rnd * 2) + 1
        Circle (x, y), rr, kk
        Paint (x, y), kk, kk
    Next inner
    craters = Int(Rnd * 10) - 6
    If craters < 0 Then craters = 0
    If craters > 0 Then

        For cc = 1 To craters
            cr = oldr * .75
            xv = Int((Rnd * cr) + 3) - Int(Rnd * (cr + 3))
            yv = Int((Rnd * cr) + 3) - Int(Rnd * (cr + 3))
            Circle (ox + xv, oy + yv), cr - 2, ck + 2
            Paint (ox + xv, oy + yv), ck + 1, ck + 2
        Next cc
    End If
Next balls

pointy = Int(Rnd * 30) + 1

pkolor = Int(Rnd * 14)
pkolor = pkolor * 16 + 17 + Int(Rnd * 3)
change = 0
For h = horizon To 499
    Line (0, h)-(799, h), pkolor + chnage
    For qq = 1 To 8
        mcheck = Int(Rnd * 20)
        If mcheck = 1 Then GoTo drawmountain
        dirt:
    Next qq

    If Int(Rnd * 4) = 1 Then
        change = change + 1
        If change > 15 Then change = 15
    End If
Next h
Input a$
If a$ = "quit" Then GoTo done

GoTo planets

drawmountain:

mhigh = h - (Int(Rnd * 120) + 20)
mwide = Int(Rnd * 3) + 2
mwide = mwide * Sqr(Rnd * mwide / 3)

'mlow = horizon + Int(Rnd * mhigh) + 40

mkolor = pkolor + Int(Rnd * 8)
mx = Int(Rnd * 800) + 1

mx1 = mx - (mwide / 2)
mx2 = mx + (mwide / 2)
rcheck = 0
rlimit = Int(Rnd * 30) + 1

For my = mhigh To h
    Line (mx1, my)-(mx2, my), mkolor
    xv1 = Int(Rnd * 5)
    xv2 = Int(Rnd * 5)
    Line (mx1 + xv1, my)-(mx2 - xv2, my), mkolor + 1
    Line (mx - (xv1 + mwide / 3), my)-(mx2 - xv2, my), mkolor + 3
    rcheck = rcheck + 1
    If rcheck > rlimit Then
        Line (mx - (xv1 + mwide / 3), my)-(mx - (mwide / 2), my), mkolor + 3
    End If

    mwide = mwide + xv1 + wv2
    mx1 = mx1 - (Int(Rnd * pointy) + (Rnd * mwide) / 2)
    mx2 = mx2 + (Int(Rnd * pointy) + (Rnd * mwide) / 2)
    ' mwide = mx2 - mx1
Next my
GoTo dirt
done:
'end program
Cls
Clear
End