05-19-2022, 02:10 PM
working on my alienskies program posted elsewhere and I'm trying to develop a better method of rendering the moons so the craters don't jump off the moon. I'm trying a rendering methods where I draw the craters in a separate image and then I scan that image layer only copying the pixels on that image layer that are inside the space of the moon. That's working but when I attempt to clear the image holding the craters to draw fresh craters it just isn't clearing out the old craters. I suspect it's in the order of my _dest and _source calls but I'm lost and can't see where the error is. Anyone want to take a look and offer advice I'd really appreciate it?
Code: (Select All)
'not better mooon
'arrggghhhh ..... why isn't this working????
Dim Shared imgmax_x, imgmax_y, MS&, cp&
Dim Shared nopaint As _Unsigned Long
imgmax_x = 800
imgmax_y = 600
Randomize Timer
MS& = _NewImage(imgmax_x, imgmax_y, 32)
cp& = _NewImage(imgmax_x, imgmax_y, 32) <- the crater paint image
Screen MS&
nopaint = Point(1, 1)
Do
Cls
_Limit 1
bettermoon
_Display
A$ = InKey$
Loop Until A$ = "q"
Sub bettermoon
mx = 400
my = 300
' mx = Int(Rnd * (imgmax_x / 2)) + (imgmax_x / 4)
' my = Int(Rnd * (imgmax_y / 2)) + (imgmax_x / 4)
mkr = Int(Rnd * 100) + 50: mkg = Int(Rnd * 100) + 50: mkb = Int(Rnd * 100) + 50
mklr& = _RGB32(mkr, mkg, mkb)
' moonsize = Int(((Rnd * 200) + (Rnd * 200)) / 2)
moonsize = Int(((Rnd * 200) + 50 + (Rnd * 200) + 50) / 2)
orb mx, my, moonsize, mklr&, 1.8
kk = 1
ccheck = Int(Rnd * 100)
If ccheck < 90 Then
kk = craters(mx, my, moonsize, mklr&)
End If
moonfuzz mx, my, moonsize, mklr&, 10 + (kk * 3)
' moonshadow mx, my, moonsize, mklr& turned off because I'm focusing on the problem for now
End Sub
Sub orb (XX As Long, YY As Long, Rd As Long, KK As Long, brt As Integer)
'false shaded 3d spheres
Dim nk As Long
nk = KK
ps = _Pi
p3 = _Pi / 3
p4 = _Pi / 4
If Rd < 10 Then ps = _Pi / 6 'so small radius orbs look cool too
rdc = p4 / Rd
For c = 0 To Int(Rd * .87) Step ps
nk = brighter&(nk, brt)
CircleFill XX, YY, Rd - (c), nk
XX = XX + rdc * (c * p3) ' could be fiddled with to move the center of the gradient
YY = YY - rdc * (c * 2 * p4) ' could be fiddled with to move the center of the gradient
Next c
End Sub
Sub CircleFill (CX As Long, CY As Long, R As Long, C As Long)
'sub by SMcNeill makes a filled circle without worrying about using the paint comamnd to fill an empty circle
Dim Radius As Long, RadiusError As Long
Dim X As Long, Y As Long
Radius = Abs(R): RadiusError = -Radius: X = Radius: Y = 0
If Radius = 0 Then PSet (CX, CY), C: Exit Sub
Line (CX - X, CY)-(CX + X, CY), C, BF
While X > Y
RadiusError = RadiusError + Y * 2 + 1
If RadiusError >= 0 Then
If X <> Y + 1 Then
Line (CX - Y, CY - X)-(CX + Y, CY - X), C, BF
Line (CX - Y, CY + X)-(CX + Y, CY + X), C, BF
End If
X = X - 1
RadiusError = RadiusError - X * 2
End If
Y = Y + 1
Line (CX - X, CY - Y)-(CX + X, CY - Y), C, BF
Line (CX - X, CY + Y)-(CX + X, CY + Y), C, BF
Wend
End Sub
Sub moonfuzz (CX As Long, CY As Long, R As Long, C As Long, CHNC As Integer)
'CX and CY are to plot of the circle center R is the radius, c is the primary color, CHNC is the chance for noise to vary from from primary color
Dim Radius As Long, RadiusError As Long
Dim X As Long, Y As Long
Radius = Abs(R)
RadiusError = -Radius
X = Radius
Y = 0
If Radius = 0 Then PSet (CX, CY), C: Exit Sub
'checking to see if we should use the base color or slap down some random noise
For tx = CX - X To CX + X
chance = Rnd * 100
If chance < CHNC Then
dotc = Int(Rnd * 256)
PSet (tx, CY), _RGBA32(dotc, dotc, dotc, Int(Rnd * 84)) 'drawing each point in the line because color can change from pixel to pixel
Else
' dotc = C let the color stay as drawn by orb
End If
Next tx
While X > Y
RadiusError = RadiusError + Y * 2 + 1
If RadiusError >= 0 Then
If X <> Y + 1 Then
For tx = CX - Y To CX + Y
chance = Rnd * 100
If chance < CHNC Then
dotc = Int(Rnd * 256)
PSet (tx, CY - X), _RGBA32(dotc, dotc, dotc, Int(Rnd * 84))
Else
' dotc = C let the color stay as drawn by orb
End If
Next tx
For tx = CX - Y To CX + Y
chance = Rnd * 100
If chance < CHNC Then
dotc = Int(Rnd * 256)
PSet (tx, CY + X), _RGBA32(dotc, dotc, dotc, Int(Rnd * 84))
Else
' dotc = C let the color stay as drawn by orb
End If
Next tx
End If
X = X - 1
RadiusError = RadiusError - X * 2
End If
Y = Y + 1
For tx = CX - X To CX + X
chance = Rnd * 100
If chance < CHNC Then
dotc = Int(Rnd * 256)
PSet (tx, CY - Y), _RGBA32(dotc, dotc, dotc, Int(Rnd * 84))
Else
' dotc = C let the color stay as drawn by orb
End If
Next tx
For tx = CX - X To CX + X
chance = Rnd * 100
If chance < CHNC Then
dotc = Int(Rnd * 256)
PSet (tx, CY + Y), _RGBA32(dotc, dotc, dotc, Int(Rnd * 84))
Else
'dotc = C let the color stay as drawn by orb
End If
Next tx
Wend
End Sub
Function brighter& (ch&&, p)
'eventually going to replace this sub with a beter one
r = _Red(ch&&)
b = _Blue(ch&&)
g = _Green(ch&&)
If p < 0 Then p = 0
If p > 100 Then p = 100
p = p / 100
rdif = 255 - r: rc = rdif * p: brr = Int(r + rc): If brr > 255 Then brr = 255
gdif = 255 - g: gc = gdif * p: bgg = Int(g + gc): If bgg > 255 Then bgg = 255
bdif = 255 - b: bc = bdif * p: bbb = Int(b + bc): If bbb > 255 Then bbb = 255
brighter& = _RGB(brr, bgg, bbb)
End Function
Function craters (mx, my, mrd, mk&)
' put craters on those moons
crmax = mrd * .24
numk = Int(Rnd * 24) + 12
_Dest cp&
Line (0, 0)-(img_maxx - 1, img_maxy - 1), _RGB32(0, 0, 0) ' <---- why isn't this overwritng the old image on cp&
For k = 1 To numk
crad = Int(Rnd * crmax) + 1
cgominx = mx - mrd + crad: cgomax = mx + mrd - crad
cgominy = my - mrd + crad: cgomay = my + mrd - crad
cx = Int(Rnd * (cgomax - cgominx)) + cgominx + 1
cy = Int(Rnd * (cgomay - cgominy)) + cgominy + 1
nk& = mk&
orb cx, cy, crad, nk&, 1.9
Next k
_Dest MS&
cratercopy mx, my, mrd
_Source MS&
_Dest MS&
craters = numk
End Function
Sub cratercopy (CX As Long, CY As Long, R As Long)
'CX and CY are to plot of the circle center R is the radius, c is the primary color, CHNC is the chance for noise to vary from from primary color
Dim Radius As Long, RadiusError As Long
Dim X As Long, Y As Long
_Source cp&
_Dest MS&
Radius = Abs(R)
RadiusError = -Radius
X = Radius
Y = 0
If Radius = 0 Then PSet (CX, CY), C: Exit Sub
'checking to see if we should use the base color or slap down some random noise
For tx = CX - X To CX + X
dotc& = Point(tx, CY)
If dotc& <> nopaint Then PSet (tx, CY), dotc& 'drawing each point in the line because color can change from pixel to pixel
Next tx
While X > Y
RadiusError = RadiusError + Y * 2 + 1
If RadiusError >= 0 Then
If X <> Y + 1 Then
For tx = CX - Y To CX + Y
dotc& = Point(tx, CY - X)
If dotc& <> nopaint Then PSet (tx, CY - X), dotc&
Next tx
For tx = CX - Y To CX + Y
dotc& = Point(tx, CY + X)
If dotc& <> nopaint Then PSet (tx, CY + X), dotc&
Next tx
End If
X = X - 1
RadiusError = RadiusError - X * 2
End If
Y = Y + 1
For tx = CX - X To CX + X
dotc& = Point(tx, CY - Y)
If dotc& <> nopaint Then PSet (tx, CY - Y), dotc&
Next tx
For tx = CX - X To CX + X
dotc& = Point(tx, CY + Y)
If dotc& <> nopaint Then PSet (tx, CY + Y), dotc&
Next tx
Wend
_Dest cp&
_Dest MS&
End Sub
Sub moonshadow (mx, my, moonsize, mklr&)
'this isn't perfect but it works. It's currentyl commented in the main routine
moffx = mx + Int(Rnd * moonsize) - Int(Rnd * moonsize)
moffy = my + Int(Rnd * moonsize) - Int(Rnd * moonsize)
CircleFill moffx, moffy, moonsize, _RGB32(0, 0, 0)
End Sub