Vapaa-ajallaan kun kerkeää kikkailemaan vaikka mitä, niin teinpä nyt CB:llä sitten satunnaisen maastogeneraattorin käyttäen Perlin Noisea. Olkaa hyvä!
Funktio jota tulisi käyttää on CreateTerrain(). Parametrit funktiolle ovat planet_type, octaves ja peristence.
Mitä vähemmän oktaaveja on, sitä karkeampi maastosta tulee. Oktaaveja voi olla maksimissaan 15 (mitä vähemmän, sen nopeampi generointi).
Mitä suurempi persistence on, sitä yksityiskohtaisempi maastosta tulee.
Kokeilemalla ne parhaat arvot löytyvät! =)
HUOM! Koodia ei ole kummemmin kommentoitu! Optimoitavaakin varmasti löytyy, joten jakakaa optimointinne, kiitos!
example.cb
Code: Select all
' ********** ESIMERKKI-OHJELMA *************
Include "perlin_noise.cb"
again:
planet_type=Rand(PLANET_TYPESTOTAL-1)
start=Timer()
img = CreateTerrain(planet_type, 7, 1.0)
aika=Timer()-start
SetWindow "Done in "+aika+ " | "+planet_type
DrawImage img,0,0
DrawScreen
WaitKey
Goto again
Code: Select all
'Oletus kuvakoko
Global g_Width,g_Height
g_Width = 256
g_Height = 256
'Oktaavien maksimi määrä
'(eli kuinka monesta kohina-kuvasta perlin noisen voi maksimissaan luoda)
Const MAX_OCTAVES = 15
'Satunnaistetaan satunnaisuutta
Randomize Timer()
'Vakiot planeetta-tyypeille
Const PLANET_ARID = 0
Const PLANET_DESERT = 1
Const PLANET_TEMPERATE = 2
Const PLANET_FROZEN = 3
Const PLANET_ICY = 4
Const PLANET_MARS = 5
Const PLANET_OCEAN = 6
Const PLANET_VENUS = 7
Const PLANET_ACID = 8
Const PLANET_TYPESTOTAL = 9
'Taulukoita
Dim Palettes(PLANET_TYPESTOTAL, 10) As String
Dim ColorPalette(256) As Integer
Dim Noise(g_Width,g_Height) As Float ' "Raaka" kohina-kartta
Dim SNoise(g_Width,g_Height,MAX_OCTAVES) As Float 'Pehmennetyt kohinakartat
Dim PNoise(g_Width,g_Height) As Float 'Itse Perlin Noise
'Strings contains: Gradient Percent, Red, Green and Blue
'First array value is the color count
Palettes( PLANET_ARID,0 )="7"
Palettes( PLANET_ARID,1 )="000,214,153,103"
Palettes( PLANET_ARID,2 )="025,181,148,105"
Palettes( PLANET_ARID,3 )="050,158,128,079"
Palettes( PLANET_ARID,4 )="097,128,106,070"
Palettes( PLANET_ARID,5 )="098,108,138,141"
Palettes( PLANET_ARID,6 )="099,090,125,144"
Palettes( PLANET_ARID,7 )="100,045,094,101"
Palettes( PLANET_DESERT,0 )="9"
Palettes( PLANET_DESERT,1 )="0.0,181,144,111"
Palettes( PLANET_DESERT,2 )="12.5,235,181,136"
Palettes( PLANET_DESERT,3 )="25.0,199,153,116"
Palettes( PLANET_DESERT,4 )="37.5,223,173,131"
Palettes( PLANET_DESERT,5 )="50.0,211,164,124"
Palettes( PLANET_DESERT,6 )="62.5,241,193,151"
Palettes( PLANET_DESERT,7 )="75.0,135,101,77"
Palettes( PLANET_DESERT,8 )="87.5,165,124,95"
Palettes( PLANET_DESERT,9 )="100.0,192,137,102"
Palettes( PLANET_TEMPERATE,0 )="9"
Palettes( PLANET_TEMPERATE,1 )="0,220,200,180"
Palettes( PLANET_TEMPERATE,2 )="5,179,160,120"
Palettes( PLANET_TEMPERATE,3 )="15,153,143,92"
Palettes( PLANET_TEMPERATE,4 )="25,115,128,77"
Palettes( PLANET_TEMPERATE,5 )="49,42,102,41"
Palettes( PLANET_TEMPERATE,6 )="50,69,108,118"
Palettes( PLANET_TEMPERATE,7 )="51,17,82,112"
Palettes( PLANET_TEMPERATE,8 )="55,9,62,92"
Palettes( PLANET_TEMPERATE,9 )="100,2,43,68"
Palettes( PLANET_FROZEN,0 )="9"
Palettes( PLANET_FROZEN,1 )="0,238,255,255"
Palettes( PLANET_FROZEN,2 )="15,221,238,255"
Palettes( PLANET_FROZEN,3 )="25,187,221,238"
Palettes( PLANET_FROZEN,4 )="35,153,204,238"
Palettes( PLANET_FROZEN,5 )="45,153,187,221"
Palettes( PLANET_FROZEN,6 )="60,136,170,221"
Palettes( PLANET_FROZEN,7 )="75,119,153,204"
Palettes( PLANET_FROZEN,8 )="90,102,136,170"
Palettes( PLANET_FROZEN, 9 ) = "100,85,119,170"
Palettes( PLANET_ICY,0 )="5"
Palettes( PLANET_ICY,1 )="0,65,51,45"
Palettes( PLANET_ICY,2 )="20,102,84,74"
Palettes( PLANET_ICY,3 )="40,136,115,98"
Palettes( PLANET_ICY,4 )="80,152,139,125"
Palettes( PLANET_ICY,5 )="100,203,187,189"
Palettes( PLANET_MARS,0 )="7"
Palettes( PLANET_MARS,1 )="0,222,159,57"
Palettes( PLANET_MARS,2 )="15,211,137,64"
Palettes( PLANET_MARS,3 )="25,200,121,42"
Palettes( PLANET_MARS,4 )="45,162,93,31"
Palettes( PLANET_MARS,5 )="50,164,77,36"
Palettes( PLANET_MARS,6 )="70,134,72,43"
Palettes( PLANET_MARS,7 )="100,98,43,24"
Palettes( PLANET_OCEAN,0 )="8"
Palettes( PLANET_OCEAN,1 )="0,115,128,77"
Palettes( PLANET_OCEAN,2 )="10,42,102,41"
Palettes( PLANET_OCEAN,3 )="12,17,82,112"
Palettes( PLANET_OCEAN,4 )="14,9,62,92"
Palettes( PLANET_OCEAN,5 )="40,2,43,68"
Palettes( PLANET_OCEAN,6 )="60,2,43,68"
Palettes( PLANET_OCEAN,7 )="80,2,43,68"
Palettes( PLANET_OCEAN,8 )="100,2,43,68"
Palettes( PLANET_VENUS,0 )="9"
Palettes( PLANET_VENUS,1 )="0.0,44,26,4"
Palettes( PLANET_VENUS,2 )="12.5,204,130,44"
Palettes( PLANET_VENUS,3 )="25.0,132,50,12"
Palettes( PLANET_VENUS,4 )="37.5,156,90,28"
Palettes( PLANET_VENUS,5 )="50.0,236,182,76"
Palettes( PLANET_VENUS,6 )="62.5,172,110,36"
Palettes( PLANET_VENUS,7 )="75.0,92,34,4"
Palettes( PLANET_VENUS,8 )="87.5,220,158,60"
Palettes( PLANET_VENUS,9 )="100.0,132,70,20"
Palettes( PLANET_ACID,0 )="9"
Palettes( PLANET_ACID,1 )="0.0,141,111,62"
Palettes( PLANET_ACID,2 )="10,125,96,52"
Palettes( PLANET_ACID,3 )="30,96,72,38"
Palettes( PLANET_ACID,4 )="40.0,169,144,81"
Palettes( PLANET_ACID,5 )="50,166,159,93"
Palettes( PLANET_ACID,6 )="60,210,199,123"
Palettes( PLANET_ACID,7 )="70.0,117,109,66"
Palettes( PLANET_ACID,8 )="80,154,145,104"
Palettes( PLANET_ACID,9 )="100.0,228,255,135"
'Log-kirjoitus funktio NetMatch:stä
Function WriteLog(_text$)
fs = FileSize("log.txt")
// Alkeellinen suoja. Jos logi kasvaa yli 50 megatavun kokoiseksi, ei kirjoiteta.
If fs > 52428800 Then Return False
f = OpenToEdit("log.txt")
SeekFile f, fs
WriteLine f, LSet(Date() + " " + Time(), 22) + _text
CloseFile f
EndFunction
'Funktio paletin alustukseen planeetta-tyypin mukaan
'Tätä funktiota en koe tarpeelliseksi kommentoida
Function InitPalette(planet_type)
WriteLog("Initializing palettes")
color_count% = Int(Palettes(planet_type, 0))
index=0
For i = 1 To color_count-1
j = i+1
start=Int(GetWord(Palettes( planet_type,i ),1,","))
_end =Int(GetWord(Palettes( planet_type,j ),1,","))
sr=Int(GetWord(Palettes( planet_type,i ),2,","))
sg=Int(GetWord(Palettes( planet_type,i ),3,","))
sb=Int(GetWord(Palettes( planet_type,i ),4,","))
er=Int(GetWord(Palettes( planet_type,j ),2,","))
eg=Int(GetWord(Palettes( planet_type,j ),3,","))
eb=Int(GetWord(Palettes( planet_type,j ),4,","))
size = (_end-start)*2.54
For k = 0 To size-1
colR = ((sr*(size-k)) + (er*k)) / size
colG = ((sg*(size-k)) + (eg*k)) / size
colB = ((sb*(size-k)) + (eb*k)) / size
If colR > 255 Then colR = 255
If colG > 255 Then colG = 255
If colB > 255 Then colB = 255
If colR < 0 Then colR = 0
If colG < 0 Then colG = 0
If colB < 0 Then colB = 0
ColorPalette(index ) = GetARGB(255, colR, colG, colB)
'**********
'Nämä voi ottaa pois jos haluaa
Color 0,0,ColorPalette(index)
Line 10+k,10*i,10+k,10+10*i
DrawScreen OFF
'**********
index=index + 1
Next k
Next i
WriteLog("Palettes done (End index = "+index+")")
Return True
EndFunction
// Tällä funktiolla luodaan taulukko, jonka arvot ovat 0.0 ja 1.0 väliltä.
// Tämä on perlin noisen ensimmäinen vaihe, eli ns. "raaka" kohina.
Function CreateWhiteNoise()
WriteLog("Creating white noise")
For y = 0 To g_Height - 1
For x = 0 To g_Width - 1
Noise(x, y) = Rnd(1.0) 'Syötetään taulukko täyteen satunnaisia arvoja
Next x
Next y
WriteLog("White noise done")
End Function
// Tällä funktiolla luodaan "raaka" kohinasta pehmennettyjä
// (ts. venytettyjä) kohina-taulukkoja. Mitä suurempi 'octave' -arvo, sitä pehmeämpää kohinaa.
Function CreateSmoothNoise(octave)
WriteLog("Creating smooth noise")
If octave>= MAX_OCTAVES Then MakeError "Too many octaves! "+MAX_OCTAVES+" is the maximum!"
// Alustetaan muuttujia, joiden avulla saadaan pehmennykset
samplePeriod = 1 Shl octave
sampleFreq# = 1.0 / samplePeriod
For x = 0 To g_Width - 1
'Lasketaan vaaka näytteenotto-indeksit
sample_x0 = (x / samplePeriod) * samplePeriod
sample_x1 = (sample_x0 + samplePeriod) Mod g_Width
horizontal_blend# = (x - sample_x0) * sampleFreq
For y = 0 To g_Height - 1
'Lasketaan pysty näytteenotto-indeksit
sample_y0 = (y / samplePeriod) * samplePeriod
sample_y1 = (sample_y0 + samplePeriod) Mod g_Height
vertical_blend# = (y - sample_y0) * sampleFreq
'Yläosan pehmeys
top# = Interpolate(Noise(sample_x0, sample_y0), Noise(sample_x1, sample_y0), horizontal_blend)
'Alaosan pehmeys
bottom# = Interpolate(Noise(sample_x0, sample_y1), Noise(sample_x1, sample_y1), horizontal_blend)
'Tallennetaan pehmennetty arvo taulukkoon
' (pystysuora arvo top ja bottom muuttujien välillä on tämän hetkisen (x ja y kohta loopissa) pisteen arvo)
SNoise(x, y,octave) = Min(1.0,Max(0.0,Interpolate(top, bottom, vertical_blend) ))
Next y
Next x
WriteLog("Smooth noise done")
EndFunction
// Tällä funktiolla saadaan aikaan itse Perlin Noisea.
// Ennen tätä funktiota TÄYTYY kutsua funktioita järjestyksessä:
// - CreateWhiteNoise()
// - CreateSmoothNoise(octave)
// Mitä pienempi 'octaves', sitä karkeampi kuva.
// Mitä pienempi 'persistence', sitä pehmeämpi kuva.
Function CreatePerlinNoise(octaves, persistence#=0.5)
WriteLog("Creating perlin noise")
'This is our base table
CreateWhiteNoise()
Dim amplitude As Float
Dim totalAmplitude As Float
amplitude = 1.0
totalAmplitude = 0.0
For i = octaves To 1 Step - 1
'Luodaan pehmeää kohinaa oktaaville
CreateSmoothNoise(i)
'Alustetaan muuttujia
amplitude=amplitude * persistence
totalAmplitude=totalAmplitude + amplitude
For x = 0 To g_Width - 1
For y = 0 To g_Height - 1
PNoise(x, y) = PNoise(x, y) + SNoise(x, y, i) * amplitude
Next y
Next x
Next i
'Jaetaan arvot totalAmplitude:lla jotta saadaan arvoja 0.0 ja 1.0 väliltä
For x = 0 To g_Width - 1
For y = 0 To g_Height - 1
PNoise( x, y)=PNoise( x, y) / totalAmplitude
Next y
Next x
WriteLog("Perlin noise done")
EndFunction
// Interpolaatio funktio. Palauttaa arvon x0 ja x1 väliltä alpha:n perusteella.
// alpha:n tulee olla väliltä 0.0 ja 1.0 (0.5 on keskikohta x0 ja x1 arvojen väliltä, esim. Interpolate(1.0, 2.0, 0.5) = 1.5)
Function Interpolate#(x0#, x1#, alpha#)
Return x0 * (1 - alpha) + alpha * x1
EndFunction
// Tällä funktiolla luodaan itse maastokuva Perlin Noisen arvojen mukaan.
Function CreateTerrain(planet_type, width=0, height=0, octaves=6, persistence#=0.5)
WriteLog("Creating planet image")
'Jos kuvakoko on määritelty erisuureksi globaaleista, tallennetaan se globaaleihin
If width<>g_Width And height<>g_Height Then
g_Width=width
g_Height=height
EndIf
'Luodaan tyhjä kuva maastoa varten
pix = MakeImage(g_Width, g_Height)
'Tyhjennetään taulukot ja määritellään niille koot
ClearArray ON
ReDim Noise(g_Width, g_Height)
ReDim SNoise(g_Width, g_Height, octaves)
ReDim PNoise(g_Width, g_Height)
'Luodaan itse Perlin Noise
CreatePerlinNoise(octaves,persistence)
'Luodaan väripaletti planeetta-tyypillemme
If InitPalette(planet_type) = True Then
'Väritetään!
Lock(Image(pix))
For x = 0 To g_Width-1
For y=0 To g_Height-1
' Otetaan arvo Perlin Noisesta ja kerrotaan se 255:llä.
c = Abs(PNoise(x, y) * 255.0)
'Koska muuttuja "c" on väliltä 0-255, ja väritaulukkomme koko on 256,
' voimme poimia värin suoraan muuttuja-arvolla "c".
_color = ColorPalette(c)
PutPixel2 x,y,_color, Image(pix)
Next y
Next x
Unlock(Image(pix))
EndIf
WriteLog("Planet image done")
'Kaikki valmista, palautetaan kuva
Return pix
EndFunction
// Palauttaa kokonaisluvun annetuista väri-komponenteista
Function GetARGB(alpha, _r, _g, _b)
Return (alpha Shl 24) + (_r Shl 16) + (_g Shl 8) + _b
EndFunction
Mitä generaattori saa aikaan: