rendered paste bodySuperStrict
Global scx:Int = 640
Global scy:Int = 480
Global diameter:Int = scy
Graphics scx, scy
Cls
SetBlend ALPHABLEND
SetAlpha 1.0
SetColor 255, 255, 255
SetClsColor 0, 0, 40
Global sizefactor:Int = 1
SetScale sizefactor, sizefactor
Global planetsize:Int = 480 / sizefactor
Global frames:Int = 60
Global planetid:Int = 6
Global loopimage:TImage = CreateImage(planetsize, planetsize, frames + 1, DYNAMICIMAGE | FILTEREDIMAGE)
'tplanet.create options:
'in order:
'Frame, Planet ID, Size, cloud coverage, land mass,day>night transition flag, "flare" flag,"Star" flag,cloud colour, land colour,water colour.
'Note that cloud coverage/land mass isnt spot on, you'll need to adjust it to get what you want.
'Higher cloud coverage and land mass increases generation time.
Local x:Float, Frame:Int
Repeat
'Local planet:tplanet = tplanet.Create(x + 1, planetid, planetsize, 0.9, 0.1, 0, 0, 0, $ffffff, $10ff10, $4040ff) 'normal planet
'Local planet:tplanet = tplanet.Create(x + 1, planetid, planetsize, 1.3, 0.1, 0, 1, 1, $ff0000, $ff0000, $ff0000) 'red giant
Local planet:tplanet = tplanet.Create(x + 1, planetid, planetsize, 1.2, 0.1, 0, 1, 1, $FFFF33, $ff0000, $400000) 'sun
DrawImage planet.image, 0, 0
loopimage.SetPixmap(Frame, planet.worldpixmap)
SavePixmapPNG(planet.worldpixmap, "output\planet" + String(planetid) + "f" + String(Frame + 1) + ".png", 9)
Flip
Cls
x = x + Float(planetsize) / Float(frames)
Frame = Frame + 1
Until Frame > frames
Repeat
For Local x:Int = 1 To frames
DrawImage(loopimage, 0, 0, x)
Flip
Cls
Delay 1000 / 30
If KeyHit(KEY_ESCAPE) Then End
Next
Until KeyDown(KEY_ESCAPE)
Type tplanet
Field worldpixmap:TPixmap
Field image:TImage
Global heightmap:TBank
Global cloudmap:TBank
Global dimensions:Int
Field cloudcolourr:Int
Field cloudcolourg:Int
Field cloudcolourb:Int
Field landcolourr:Int
Field landcolourg:Int
Field landcolourb:Int
Field watercolourr:Int
Field watercolourg:Int
Field watercolourb:Int
Function Create:Tplanet(rot:Int, seed:Int = 10, diameter:Int, clouddensity:Float = 0.5, landmass:Float = 0.5, DAYNIGHT:Byte = 0, flares:Byte = 0, star:Byte = 0, CLOUDCOLOURRGB:Int = $909090, landcolourRGB:Int = $00FF00, WatercolourRGB:Int = $4040FF)
rot = (rot + diameter * 20) mod diameter
Local planet:tplanet = New tplanet
planet.cloudcolourr = (cloudcolourRGB & $FF0000) Shr 16
planet.cloudcolourg = (cloudcolourrGB & $FF00) Shr 8
planet.cloudcolourb = cloudcolourrGB mod 256
planet.landcolourr = (landcolourRGB & $FF0000) Shr 16
planet.landcolourg = (landcolourrGB & $FF00) Shr 8
planet.landcolourb = landcolourrGB mod 256
planet.watercolourr = (watercolourRGB & $FF0000) Shr 16
planet.watercolourg = (watercolourrGB & $FF00) Shr 8
planet.watercolourb = watercolourrGB mod 256
planet._Init(rot, seed, diameter, clouddensity, landmass, daynight, flares, star)
Return planet
End Function
Method _init(rot:Int, seed:Int, diameter:Int, clouddensity:Float, landmass:Float, daynight:Byte, flares:Byte,star:byte)
Local edge:Float = diameter / 2.5
Local faredge:Float = diameter / 2.4
Local nearedge:Float = diameter / 2.6
Local ms1:Int = MilliSecs()
'Do wierd pixmap creation as my machine wont allow normal usage ?!
Self.worldpixmap = GrabPixmap(0, 0, diameter + 1, diameter + 1)
Self.image = LoadImage(worldpixmap)
SeedRnd(seed)
Local newhm:TBank
Local newcm:TBank
If heightmap = Null Then heightmap = TBank.Create(1)
If cloudmap= Null Then cloudmap = TBank.Create(1)
heightmap.Resize((((diameter + 1) ^ 2) * 4) + 1)
cloudmap.Resize((((diameter + 1) ^ 2) * 4) + 1)
'heightmap = newhm
'cloudmap = newcm
tplanet.dimensions = diameter
Print "Time till start: " + (MilliSecs() - ms1)
Local colourmapr:Float[diameter + 1, diameter + 1]
Local colourmapg:Float[diameter + 1, diameter + 1]
Local colourmapb:Float[diameter + 1, diameter + 1]
Local x:Int, y:Int
Local centx:Int = diameter / 2
Local centy:Int = diameter / 2
Local dx:Float, dy:Float, val:Int, distance:Float, x1:Int, y1:Int, x2:Int, y2:Int, rx:Int
Local c:Int, d:Int, cloudavg:Float
Global maxsize:Int = Rand(diameter / 10, diameter / 4)
Global maxrocks:Int = landmass * 20
ms1:Int = MilliSecs()
For x = 0 To diameter Step 1
rx:Int = ((x - rot) + diameter * 100) mod diameter
For y = 0 To diameter
dx:Float = centx - rx
dy:Float = centy - y
val:Int = Rand(20, 512)
Distance = Sqr(dx * dx + dy * dy)
If Distance < diameter / 2 Then
'For c = -2 To 2
'For d = -2 To 2
'If c <> 0 Or d <> 0 Then val = val + getheightmap(rx + c, y + d)
'Next
'Next
setheightmap(rx, y, val)
EndIf
setcloudmap(x,y,0)
Next
Next
Print "Map clear :" + (MilliSecs() - ms1)
'generate other map
Local points:Int = maxrocks
ms1 = MilliSecs()
Local pointx:Int[points + 1]
Local pointy:Int[points + 1]
local pointheight:Float[points + 1]
Local rad:Int[points + 1]
For x = 0 To points
pointx[x] = ((Rand(0, diameter) - rot * 2) + diameter * 10) mod diameter
pointy[x] = Rand(0, diameter)
pointheight[x] = Rand(64, 255)
rad[x] = Rand(diameter / 10, maxsize) * 2
'pointx[x] = pointx[x] - (rot * Abs(pointy[x] - centy) / 100)
Next
For x2 = 0 To diameter
For y = 0 To diameter
x = x2
val = 64
For Local z:Int = 0 To points
dx = Abs(pointx[z] - x)
If dx > diameter / 2 Then dx = Abs(dx - diameter)
dy = Abs(pointy[z] - y)
If dy > diameter / 2 Then dy = Abs(dy - diameter)
Distance = (rad[z] - Sqr(dx * dx + dy * dy))
If distance < 1 Then distance = 1 Else val = val + (Float(distance) / Float(rad[z] )) * pointheight[z]
Next
setheightmap(x, y, val)
Next
Next
Print "Generated ground: " + (MilliSecs() - ms1)
'now generate clouds
ms1 = MilliSecs()
points:Int = 6 * clouddensity'(diameter / 120) * clouddensity
pointx = pointx:Int[..points + 1]
pointy = pointy:Int[..points + 1]
pointheight = pointheight:Float[..points + 1]
rad = rad:Int[..points + 1]
Local cloudxsc:Float[points + 1]
Local cloudysc:Float[points + 1]
'Local cloudxsc:TBank = TBank.Create((points + 1) * 4)
'Local cloudysc:TBank = TBank.Create((points + 1) * 4)
For x = 0 To points
Local spd:Int = Rnd(1, 2)
Local xmov:Int, ymov:Int
xmov = Sgn(Rnd(- 100, 0)) * Rand(2, 1)
ymov = Sgn(Rnd(- 100, 100))*0
pointx[x] = ((Rand(0, diameter) + (xmov * spd * rot)) + diameter) mod diameter
pointy[x] = ((Rand(0, diameter) + (ymov * spd * rot)) + diameter) mod diameter
'cloudxsc.PokeFloat(x * 4, Rnd(.3, 2))
'cloudysc.PokeFloat(x * 4, Rnd(.3, 2))
cloudxsc[x] = Rnd(.1, 1)
cloudysc[x] = Rnd(.1, 1)
pointheight[x] = Rand(- 190, 512)
rad[x] = ((diameter / 30) * clouddensity) * (x + 1)
'Rand(diameter / 40, diameter / 5) * clouddensity
'pointx[x] = pointx[x] - (rot * Abs(pointy[x] - centy) / 100)
Next
For x2 = 0 To diameter
For y = 0 To diameter
x = x2
val = 64
For Local z:Int = 0 To points
Local snx:Int = Sgn(Rnd(- 100, 100))
Local sny:Int = Sgn(Rnd(- 100, 100))
Local xsc:Float = 1'Rnd(.1, 1) '* cloudxsc[x]
Local ysc:Float = 1'Rnd(.1, 1) '* cloudysc[x]
Local px:Int = pointx[z]
Local py:Int = pointy[z]
If (px - x) < - diameter / 2 Then px = px + diameter
If (px - x) > diameter / 2 Then px = px - diameter
If (py - y) < - diameter / 2 Then py = py + diameter
If (py - y) > diameter / 2 Then py = py - diameter
dx = Abs(px - x) / xsc * cloudxsc[z]
dy = Abs(py - y) / ysc * cloudysc[z]
dx = dx + Rand(- diameter, diameter) / 40
dy = dy + Rand(- diameter, diameter) / 40
If Sgn(px - x) = snx Then dx = dx + 2
If Sgn(px - y) = sny Then dy = dy + 2
Local Distance:Float = rad[z] - Sqr(dx * dx + dy * dy)
If distance < 0 Then distance = 0
If distance < 1 Then distance = 1 Else val = val + (Float(distance) / Float(rad[z] )) * pointheight[z]
Next
setcloudmap(x, y, val)
Next
Next
Print "INitial cloud generation: " + (MilliSecs() - ms1)
rem
'clouds:
Local cv:Float = ((diameter * 2) * (1 - clouddensity)) + (diameter * 7) * (clouddensity)
Local clouds:Int = cv
SeedRnd(seed)
For Local cloud:Int = 1 To clouds
Local spd:Int = Rnd(1, 2)
Local xmov:Int, ymov:Int
Repeat;xmov = Rand(- 1, 1) ;ymov = Rand(- 1, 1) ;Until xmov <> 0 Or ymov <> 0
Local val:Int = Rand(2, 255)
Local Sz:Int = Rnd(1, 10) * clouddensity * diameter / 300
x = (Rand(0, diameter) + (xmov * spd * rot)) mod diameter
y = Rand(0, diameter) + (ymov * spd * rot) mod diameter
For x2:Int = x - sz To x + sz
For y2:Int = y - sz To y + sz
rx:Int = (x2)
dx:Float = centx - rx
dy:Float = centy - y2
'If Sqr(dx * dx + dy * dy) < nearedge Then
If getheightmap(rx, y2) > 0 Then setcloudmap(rx, y2, (getcloudmap(rx, y2) + val))
'If getcloudmap(rx, y2) > 256 Then setcloudmap(rx, y2, 256)
'EndIf
Next
Next
Next
endrem
'smooth now
ms1:Int = MilliSecs()
Local smoothtype:Int = Rand(1, 2)
Local smooth:Int, avg:Float
For Local smooth:Int = 1 To 5
Local sm1:Int = Rand(0, 2)
Local sm2:Int = Rand(0, 2)
For x:Int = (centx - (faredge + 5)) To centx + (faredge + 5) Step 1
For y:Int = (centy - (faredge + 5)) To (centy + (faredge + 5)) Step 1
If getheightmapfast(x, y) <> 0 Then
Local count:Float = 0
avg = 0
For c = -1 To 1
For d = -1 To 1
avg = avg + getheightmap(x + c, y + d) ' (getheightmap(x1 + 1, y1) + getheightmap(x1 - 1, y1) + getheightmap(x1, y1 + 1) + getheightmap(x1, y1 - 1) + getheightmap(x1, y1)) / 5
Next
Next
setheightmap(x, y, avg / 9)
If getheightmap(x, y) > 512 Then setheightmap(x, y, 512)
EndIf
Next
Next
Next
Print "Blur ground: " + (MilliSecs() - ms1)
ms1 = MilliSecs()
'smooth clouds:
For Local smooth:Int = 1 To 3'Float(diameter / 40)
For x:Int = (centx - faredge - 15) To centx + faredge Step 1
For y:Int = centy - faredge To centy + faredge Step 1
'If getcloudmapfast(x, y) <> 0 Then
cloudavg:Float = 0
For c:Int = -2 To - 0
For d:Int = -1 To 1 Step 1
'If c <> 0 Or d <> 0 Then
cloudavg = cloudavg + getcloudmap(x + c, y + d)
Next
Next
dx:Float = centx - x
dy:Float = centy - y
distance = Sqr(dx * dx + dy * dy)
'If (Distance - 15) < faredge Then
setcloudmap(x, y, cloudavg / 9) '15)
'Next
'Next
'EndIf
Next
Next
Next
'remove extra clouds
For x = 0 To diameter
For y = 0 To diameter
dx:Float = centx - x
dy:Float = centy - y
Local distance:Float = Sqr(dx * dx + dy * dy)
Local v2:Float = (faredge * 1.5) - distance'('distance + (diameter / 18)) - (edge)
Local v3:Float = (v2 / (faredge)) * 2
If v3 < 0 Then v3 = 0
If v3 > 1 Then v3 = 1
setcloudmap(x,y,getcloudmapfast(x,y)*v3)
Next
Next
'Print "Blur clouds: " + (MilliSecs() - ms1)
'shadows:
ms1 = MilliSecs()
For x = 0 To diameter
For y = 0 To diameter
Local diff:Float = getheightmap(x, y) - getheightmap(x + 1, y)
Local mul:Float
colourmapg[x, y] = landcolourg
colourmapr[x, y] = landcolourr
colourmapb[x, y] = landcolourb
If getheightmap(x, y) < 128 Then
colourmapb[x, y] = watercolourb * 2;colourmapg[x, y] = watercolourg * 2;colourmapr[x, y] = watercolourr * 2
Else
If getheightmap(x, y) <= getheightmap(x + 1, y) Then
Else
mul:Float = 1.15
If Abs(getheightmap(x, y) - getheightmap(x + 1, y)) < 10 Then mul = Rnd(1, 1.1)
EndIf
mul = mul * Float((x - (centx / 2)) / 100.0) ;If mul < 1 Then mul = 1
If Abs(getheightmap(x, y) - getheightmap(x + 1, y)) < 10 Then mul = mul * Rnd(1, 1.1)
setheightmap(x, y, getheightmap(x, y) * mul)
setheightmap(x, y, getheightmap(x, y) + diff * 10) ' 250)
If getheightmap(x, y) < 0 Then setheightmap(x, y, 0)
EndIf
Next
Next
'Print "Processing shadows: " + (MilliSecs() - ms1)
ms1 = MilliSecs()
'atmosphere and smoothing
Local ox:Int, oy:Int
For Local ang:Int = 0 To 360
x = (Sin(ang) * (edge)) + centx
y = (Cos(ang) * (edge)) + centy
Local sz:Int = diameter / 240
Local val:Int = 255
For x2:Int = x - sz To x + sz / 2
For y2:Int = y - sz To y + sz
Local newval:Int = getcloudmap(x2, y2) + val
If newval > 512 Then newval = 512
setcloudmap(x2, y2, 128)
Next
Next
Next
For Local ang:Int = 0 To 360
x = (Sin(ang) * (faredge)) + centx
y = (Cos(ang) * (faredge)) + centy
If x <> ox Or y <> oy Then
ox = x;oy = y
Local sz:Int = Float(diameter / 20)
Local val:Int = 255
For Local x2:Int = x - sz To x + sz
For Local y2:Int = y - sz To y + sz
Local cloudavg:Float = 0
Local cloudcnt:Float = 0
For Local c:Int = -1 To 1
For Local d:Int = -1 To 1
If c <> 0 Or d <> 0 Then
'If (x2 + c) > 0 And (x2 + c) < diameter And (y2 + d) > 0 And (y2 + d) < diameter Then
cloudavg = cloudavg + getcloudmap(x2 + c, y2 + d)
cloudcnt = cloudcnt + 1
'endif
EndIf
Next
Next
setcloudmap(x2, y2, cloudavg / (cloudcnt - 0))
Next
Next
EndIf
Next
Print "Atmosphere: " + (MilliSecs() - ms1)
worldpixmap = LockImage(image)
ms1 = MilliSecs()
For x = 0 To diameter
For y = 0 To diameter
Local dx:Float = centx - x
Local dy:Float = centy - y
Local Distance:Float = Sqr(dx * dx + dy * dy)
If distance > edge Then setheightmap(x, y, 127) ;colourmapr[x, y] = 0;colourmapg[x, y] = 0;colourmapb[x, y] = 255
Local colour:Float = getheightmap(x, y) / 2
'colour = colour / ((diameter / Float(x)) / 2.0) - 32
If daynight <> 0 Then colour = colour * ((x - diameter / 2) / Float(diameter)) * 1.3
if colour<0 then colour=0
colour = colour / 256
Local colour1r:Float = colour * colourmapr[x, y]
Local colour1g:Float = colour * colourmapg[x, y]
Local colour1b:Float = colour * colourmapb[x, y]
Local colourmix:Float = (getcloudmap(x, y) - 0) / 255
'colourmix = (colourmix -.2) * 0.8
Local colour2r:Float = ((1 - colourmix) * cloudcolourr) + (colourmix * cloudcolourr) / 3
Local colour2g:Float = ((1 - colourmix) * cloudcolourg) + (colourmix * cloudcolourg) / 3
Local colour2b:Float = ((1 - colourmix) * cloudcolourb) + (colourmix * cloudcolourb) / 3
If star = True Then
colour2r:Float = ((colourmix) * cloudcolourr) + ((1 - colourmix) * cloudcolourr) / 3
colour2g:Float = ((colourmix) * cloudcolourg) + ((1 - colourmix) * cloudcolourg) / 3
colour2b:Float = ((colourmix) * cloudcolourb) + ((1 - colourmix) * cloudcolourb) / 3
Else
EndIf
'If distance > edge Then colour2g = 0;colour2r = 0
'colour2r = 256
'colour2g = 256
'colour2b = 256
colourmix = (colourmix -.2) * 4.5
If colourmix < 0 Then colourmix = 0
If colourmix > 1 Then colourmix = 1
'colourmix = colourmix / 1.25
Local finalcolourr:Int = (colour1r * (1 - colourmix)) + (colour2r * colourmix)
Local finalcolourg:Int = (colour1g * (1 - colourmix)) + (colour2g * colourmix)
Local finalcolourb:Int = (colour1b * (1 - colourmix)) + (colour2b * colourmix)
Local alpha:Int = 255
alpha = Float(colourmix * 255)
Local v2:Float = (nearedge - distance)
Local v3:Float = v2 / (edge - distance)
If distance < faredge Then v3 = 0
If v3 < 0 Then v3 = 0
If v3 > 1 Then v3 = 1
'alpha = (alpha / 5) +
alpha = ((1 - v3)) ' * 255
If alpha < 0 Then alpha = 0
'finalcolourr = Float(finalcolourr) * alpha
'finalcolourg = Float(finalcolourg) * alpha
'finalcolourb = Float(finalcolourb) * alpha
If finalcolourr > 255 Then finalcolourr = 255
If finalcolourg > 255 Then finalcolourg = 255
If finalcolourb > 255 Then finalcolourb = 255
If finalcolourr < 0 Then finalcolourr = 0
If finalcolourg < 0 Then finalcolourg = 0
If finalcolourb < 0 Then finalcolourb = 0
alpha = (alpha * 255) + (colourmix * 255)
If colourmix > 0 Then
Local alpha2:Float = ((diameter / 20) - (distance - faredge))
If flares Then alpha2 = alpha2 / 1.3
If alpha2 < 0 Then alpha2 = 0
alpha = alpha * (alpha2 / (diameter / 20))
alpha = alpha - colourmix
'alpha = colourmix * 255
EndIf
Local alpha2:Float = ((Float(distance - edge)) / (edge - faredge)) +.95
If alpha2 < 0 Then alpha2 = 0 Else If alpha2 > 1 Then alpha2 = 1
If flares = 0 Then alpha = alpha * alpha2 ' * 255
If alpha < 0 Then alpha = 0 Else If alpha > 255 Then alpha = 255
Local pixel:Int = (finalcolourb | finalcolourg Shl 8 | finalcolourr Shl 16 | alpha Shl 24)
worldpixmap.WritePixel(x, y, pixel)
Next
Next
ms1 = MilliSecs()
UnlockImage(image)
Print "Unlocking image:" + (MilliSecs() - ms1)
' SetScale 2, 2
End Method
Function blurheightmap()
Local x:Int, y:Int, x1:Int, y1:Int, c:Int, d:Int
Local val:Float
For x = 0 To dimensions
For y = 0 To dimensions
For c = -1 To 1
For d = -1 To 1
x1 = x + c;y1 = y + d
If x1 < 1 Or x1 > dimensions - 1 Or y1 < 1 Or y1 > dimensions - 1 Then
x1 = (x1 + dimensions) mod dimensions
y1 = (y1 + dimensions) mod dimensions
EndIf
val = val + PeekFloat(heightmap, ((x1 * dimensions) + y1) * 4)
Next
Next
PokeFloat(heightmap, ((x * dimensions) + y) * 4, val / 9.0)
Next
Next
End Function
Function getcloudmap:Float(x:Int, y:Int) nodebug
'Local xmax:Int = cloudmap.dimensions()[0]
'Local ymax:Int = cloudmap.dimensions()[1]
x = (x + dimensions) mod dimensions
y = (y + dimensions) mod dimensions
Local add:Int = ((x * dimensions) + y) * 4
Return cloudmap.PeekFloat(add)
'Return cloudmap[x, y]
End Function
Function setcloudmap(x:Int, y:Int, val:Float) nodebug
'Local xmax:Int = cloudmap.dimensions()[0]
'Local ymax:Int = cloudmap.dimensions()[1]
x = (x + dimensions) mod dimensions
y = (y + dimensions) mod dimensions
Local add:Int = ((x * dimensions) + y) * 4
cloudmap.PokeFloat(add, val)
'cloudmap[x, y] = val
End Function
Function getheightmap:Float(x:Int, y:Int) nodebug
'Local xmax:Int = heightmap.dimensions()[0]
'Local ymax:Int = heightmap.dimensions()[1]
x = (x + dimensions) mod dimensions
y = (y + dimensions) mod dimensions
Local add:Int = ((x * dimensions) + y) * 4
Return heightmap.PeekFloat(add)
End Function
Function getheightmapfast:Float(x:Int, y:Int)
'Local xmax:Int = heightmap.dimensions()[0]
'Local ymax:Int = heightmap.dimensions()[1]
Return heightmap.PeekFloat(((x * dimensions) + y) * 4)
End Function
Function getcloudmapfast:Float(x:Int, y:Int)
'Local xmax:Int = heightmap.dimensions()[0]
'Local ymax:Int = heightmap.dimensions()[1]
Return cloudmap.PeekFloat(((x * dimensions) + y) * 4)
End Function
Function setheightmap(x:Int, y:Int, val:Float) nodebug
'Local xmax:Int = heightmap.dimensions()[0]
'Local ymax:Int = heightmap.dimensions()[1]
x = (x + dimensions) mod dimensions
y = (y + dimensions) mod dimensions
Local add:Int = ((x * dimensions) + y) * 4
heightmap.PokeFloat(add, val)
End Function
End Type
rem
'SetBlend SOLIDBLEND
image.handle_x = diameter / 2
image.handle_y = diameter / 2
Repeat
SetClsColor Sin(MilliSecs() / 360) * 128, 0, 0
Cls
SetColor 255, 255, 255
'DrawPixmap worldpixmap, 0, 0
DrawImage image, MouseX(), MouseY()
Flip
Until KeyDown(KEY_ESCAPE)
WaitKey
End
endrem