+- QB64 Phoenix Edition (https://staging.qb64phoenix.com)
+-- Forum: QB64 Rising (https://staging.qb64phoenix.com/forumdisplay.php?fid=1)
+--- Forum: Code and Stuff (https://staging.qb64phoenix.com/forumdisplay.php?fid=3)
+---- Forum: Programs (https://staging.qb64phoenix.com/forumdisplay.php?fid=7)
+---- Thread: planetdoodle2 (/showthread.php?tid=397)
planetdoodle2 - James D Jarvis - 05-12-2022
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
EndRE: planetdoodle2 - johnno56 - 05-12-2022
Cool... I like it!