Satunnaista maastoa Perlin Noisella

Oletko tehnyt jotain, mistä muut voisivat hyötyä. Postita vinkit tänne.
Post Reply
User avatar
Misthema
Advanced Member
Posts: 312
Joined: Mon Aug 27, 2007 8:32 pm
Location: Turku, Finland
Contact:

Satunnaista maastoa Perlin Noisella

Post by Misthema » Fri Apr 27, 2012 2:55 pm

Tervehdys kuolleen foorumin jäsenet!

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
perlin_noise.cb - Koodi kommentoitu

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:

Image
Image
Image
Last edited by Misthema on Sun May 06, 2012 3:20 pm, edited 1 time in total.

VerkkoGuru
Member
Posts: 73
Joined: Sat Feb 25, 2012 4:42 pm

Re: Satunnaista maastoa Perlin Noisella

Post by VerkkoGuru » Sun May 06, 2012 12:13 pm

Hienolta näyttää! Vielä kun ymmärtäisi, miten tämä toimii. :D

User avatar
Misthema
Advanced Member
Posts: 312
Joined: Mon Aug 27, 2007 8:32 pm
Location: Turku, Finland
Contact:

Re: Satunnaista maastoa Perlin Noisella

Post by Misthema » Sun May 06, 2012 1:54 pm

VerkkoGuru wrote:Hienolta näyttää! Vielä kun ymmärtäisi, miten tämä toimii. :D
Kiitos! Kunhan tässä kerkiää, niin kommentoin koodin mahdollisimman kattavasti, jotta se on helpompi ymmärtää. :)
EDIT:

Perlin_Noise.cb nyt kommentoitu, parhaani mukaan.


Post Reply