[B3D] Terrain Generator

Übersicht BlitzBasic Codearchiv

Neue Antwort erstellen

 

Kruemelator

Betreff: [B3D] Terrain Generator

BeitragMo, Jul 14, 2014 16:51
Antworten mit Zitat
Benutzer-Profile anzeigen
Hier mal ein Terrain Generator von mir, mit Terrain Beispielbildern (Beispiele sind im Code enthalten).

user posted image

Liste der Funktionen:
Es ist möglich Parameter in Echtzeit zu ändern (aktualisiert Stück für Stück).
Es können Terrains in beliebiger Größe erstellt werden.
Es gibt ein Offset, womit angrenzende Terrains in beliebiger Anzahl erstellt werden können.
Es ist möglich Erosion zu imitieren.

BlitzBasic: [AUSKLAPPEN]
;Allgemein----------------------------------------
Global xfenster = 1024
Global yfenster = 768
Global windowmode = 1

Global mx
Global my
Global mz
Global mxs
Global mys
Global mzs
Global mht1
Global mht2


If 0 Then
xfenster = 1920
yfenster = 1080
windowmode = 0
EndIf


Graphics3D xfenster,yfenster,32,1+windowmode
SetBuffer BackBuffer()
ClsColor 127,127,127

MoveMouse xfenster/2,yfenster/2

;3D-----------------------------------------------
Global camera = CreateCamera()
CameraViewport camera,256,0,xfenster-256,yfenster
CameraClsColor camera,70,120,180
PositionEntity camera,120,100,-50
RotateEntity camera,30,0,0
AmbientLight 20,20,20


light = CreateLight()
RotateEntity light,30,20,0



;Menu---------------------------------------------
Global takt
Global buttonwahl=-1


;Parameter----------------------------------------
Global frequenz# = 7
Global octave# = 5
Global octavescale# = 5
Global octavevalue# = 1.5
Global erosionstrength# = 0
Global erosionsize# = 10
Global height# = 1
Global winkel# = 1
Global xoffset# = 0
Global yoffset# = 0


;Textur-------------------------------------------
Global tex = CreateTexture(128,128,8)
SetBuffer TextureBuffer(tex)
Color 0,0,0
Rect 0,0,128,128,1
Color 255,255,255
Rect 1,1,126,126,1
SetBuffer BackBuffer()


;Noisefield----------------------------------------
Dim noisefield#(127,127)
For y=0 To 127
For x=0 To 127
noisefield(x,y) = Rnd(-1,1)
Next
Next



;Heightmap----------------------------------------
Global weltx = 256
Global welty = 256
Dim welt#(weltx,welty)
Global tilex = weltx/32
Global tiley = welty/32
Dim terrainmesh(tilex-1,tiley-1)


;Start--------------------------------------------
For y=0 To tiley-1
For x=0 To tilex-1
terrainmesh(x,y) = CreateTerrainTile()
PositionEntity terrainmesh(x,y),x*32,0,y*32
EntityTexture terrainmesh(x,y),tex
Next
Next



;Hauptschleife------------------------------------
fps = CreateTimer(60)
While Not KeyHit(1)
WaitTimer(fps)
Cls
WireFrame KeyDown(57)
mx = MouseX()
my = MouseY()
mz = MouseZ()
mxs = MouseXSpeed()
mys = MouseYSpeed()
mzs = MouseZSpeed()
mht1 = MouseHit(1)
mht2 = MouseHit(2)
time = MilliSecs()


cammove()


num = takt Mod (tilex*tiley)
y = num/tilex
x = num Mod tilex

Update(x,y)


UpdateWorld()
RenderWorld()

Menu()



Text 0,yfenster-13,"ms: "+(MilliSecs()-time)
takt = takt + 1
Flip 0
Wend
End



;Funktionen---------------------------------------
Function Update(x,y)
;Aktualisiert Tile (mit Rand wenn moeglich, um Normals berechnen zu koennen)
ystart = -1*(y<>0)
xstart = -1*(x<>0)
yend = 32+(y<>tiley-1)
xend = 32+(x<>tilex-1)
;Perlin
os# = 2^octavescale
Local afeld#[10]
Local ffeld#[10]
For i=0 To 10
afeld[i] = (1/os)*2^i
ffeld[i] = frequenz/((2^octavevalue)^i)
Next
;Winkel (reduziert Wiederholungen des Terrains)
Local drehmat#[4*10]
For i=0 To 9
drehmat[0+4*i] = Cos(winkel*i)
drehmat[1+4*i] = Sin(winkel*i)
drehmat[2+4*i] = -Sin(winkel*i)
drehmat[3+4*i] = Cos(winkel*i)
Next
;behebt Samplefehler
xoff# = Int(xoffset*128)/128.0
yoff# = Int(yoffset*128)/128.0
;berechnet Werte
For yi=ystart To yend
For xi=xstart To xend
xv# = x*32+xi
yv# = y*32+yi
welt(xv,yv) = 0
For i=0 To octave
xp# = drehmat[0+i*4]*xv*afeld[i] + drehmat[2+i*4]*yv*afeld[i]
yp# = drehmat[1+i*4]*xv*afeld[i] + drehmat[3+i*4]*yv*afeld[i]
hwert# = (Sin(erosionsize*welt(xv,yv)-erosionstrength)+1)
welt(xv,yv) = welt(xv,yv) + SampleNoisefield(xoff*afeld[i]+xp,yoff*afeld[i]+yp)*ffeld[i]*hwert
Next
welt(xv,yv) = welt(xv,yv)*height
Next
Next
UpdateTerrainMesh(x,y)
End Function


Function SampleNoisefield#(x#,y#)
br = 127;Noisefieldbreite
x = x-Floor(x/br)*br
y = y-Floor(y/br)*br
xf# = (x-Floor(x))
yf# = (y-Floor(y))
;Interpolation (Verlauf von 0 zu 1)
xf = 0.5-Cos(xf*180)*0.5
yf = 0.5-Cos(yf*180)*0.5
xf2# = 1-xf
yf2# = 1-yf
h0# = noisefield(FracInt(x+0,br) Mod br,FracInt(y+0,br) Mod br)
h1# = noisefield(FracInt(x+1,br) Mod br,FracInt(y+0,br) Mod br)
h2# = noisefield(FracInt(x+0,br) Mod br,FracInt(y+1,br) Mod br)
h3# = noisefield(FracInt(x+1,br) Mod br,FracInt(y+1,br) Mod br)
h0 = h0*xf2 + h1*xf
h2 = h2*xf2 + h3*xf
Return h0*yf2 + h2*yf
End Function


Function FracInt(x#,w)
Return Floor(x-Floor(x/w)*w)
End Function


Function Menu()
;Hintergrund
Color 192,192,192
Rect 0,0,256,yfenster,1
Color 0,0,0
Rect 255,0,1,yfenster,1
;Perlin
Text 3,3,"Perlin:"
If mht1 And ButtonValue( 0, 20,128,30,buttonwahl=0,"Frequenz",frequenz) Then buttonwahl = 0
If mht1 And ButtonValue(128, 20,128,30,buttonwahl=1,"Oktave",Int(octave)) Then buttonwahl = 1
If mht1 And ButtonValue( 0, 50,128,30,buttonwahl=2,"OktaveScale",octavescale) Then buttonwahl = 2
If mht1 And ButtonValue(128, 50,128,30,buttonwahl=3,"Oktavewert",octavevalue) Then buttonwahl = 3
If mht1 And ButtonValue( 0, 80,128,30,buttonwahl=4,"Erosionstrenght",erosionstrength) Then buttonwahl = 4
If mht1 And ButtonValue(128, 80,128,30,buttonwahl=5,"Erosionsize",erosionsize) Then buttonwahl = 5
If mht1 And ButtonValue( 0,110,128,30,buttonwahl=6,"Height",height) Then buttonwahl = 6
If mht1 And ButtonValue(128,110,128,30,buttonwahl=7,"Winkel",winkel) Then buttonwahl = 7
If mht1 And ButtonValue( 0,140,128,30,buttonwahl=8,"X-Offset",xoffset) Then buttonwahl = 8
If mht1 And ButtonValue(128,140,128,30,buttonwahl=9,"Y-Offset",yoffset) Then buttonwahl = 9
If MouseDown(1) Then
Select buttonwahl
Case 0
frequenz = frequenz + mxs/100.0
Case 1
octave = octave + mxs/20.0
If octave > 9 Then octave = 9
If octave < 0 Then octave = 0
Case 2
octavescale = octavescale + mxs/100.0
Case 3
octavevalue = octavevalue + mxs/100.0
Case 4
erosionstrength = erosionstrength + mxs/20.0
Case 5
erosionsize = erosionsize + mxs/20.0
Case 6
height = height + mxs/100.0
Case 7
winkel = winkel + mxs/100.0
Case 8
xoffset = xoffset + mxs/5.0
Case 9
yoffset = yoffset + mxs/5.0
End Select
Else
buttonwahl = -1
EndIf
;Beispiele
Text 3,183,"Beispiel:"
If mht1 And Button(0,200,128,30,"Beispiel 1") Then
frequenz# = 7
octave# = 5
octavescale# = 5
octavevalue# = 1.5
erosionstrength# = 0
erosionsize# = 10
height# = 1
winkel# = 1
xoffset# = 0
yoffset# = 0
EndIf
If mht1 And Button(128,200,128,30,"Beispiel 2") Then
frequenz# = 7
octave# = 5
octavescale# = 5
octavevalue# = 1.9
erosionstrength# = 0
erosionsize# = 2
height# = 0.5
winkel# = 1
xoffset# = 300
yoffset# = 0
EndIf
If mht1 And Button(0,230,128,30,"Beispiel 3") Then
frequenz# = 9
octave# = 5
octavescale# = 5
octavevalue# = 1.5
erosionstrength# = 35
erosionsize# = 20
height# = 1.5
winkel# = 1
xoffset# = -300
yoffset# = 0
EndIf
If mht1 And Button(128,230,128,30,"Beispiel 4") Then
frequenz# = 7
octave# = 5
octavescale# = 5
octavevalue# = 1.7
erosionstrength# = 0
erosionsize# = -15
height# = 1
winkel# = 1
xoffset# = 0
yoffset# = -300
EndIf
If mht1 And Button(0,260,128,30,"Beispiel 5") Then
frequenz# = 9
octave# = 6
octavescale# = 6
octavevalue# = 1.7
erosionstrength# = -10
erosionsize# = 10
height# = 2
winkel# = 1
xoffset# = 0
yoffset# = 300
EndIf
If mht1 And Button(128,260,128,30,"Beispiel 6") Then
frequenz# = 9
octave# = 5
octavescale# = 6
octavevalue# = 1.5
erosionstrength# = 50
erosionsize# = 40
height# = 1.2
winkel# = 1
xoffset# = 300
yoffset# = -300
EndIf
;Steuerung
Color 0,0,0
Text 3,303,"Kamera:"
Text 3,319,"Rechte Maustaste gedrückt"
Text 3,331,"halten + WASD + Mausrad"
Text 3,303+60,"Werte:"
Text 3,319+60,"Linke Maustaste gedrückt"
Text 3,331+60,"halten + Seitwärtsbewegung"
End Function


Function Button(x,y,br,ho,inhalt$)
Color 0,0,0
If mx >= x And mx < x+br Then
If my >= y And my < y+ho Then
on = 1
EndIf
EndIf
If on Or down Then Color 255,255,255
Rect x,y,br,ho,0
Text x+br/2-StringWidth(inhalt)/2,y+ho/2-StringHeight(inhalt)/2,inhalt
Return on
End Function


Function ButtonValue(x,y,br,ho,down,inhalt$,wert#)
Color 0,0,0
If mx >= x And mx < x+br Then
If my >= y And my < y+ho Then
on = 1
EndIf
EndIf
If on Or down Then Color 255,255,255
Rect x,y,br,ho,0
Text x+br/2-StringWidth(inhalt)/2,y+ho/4-StringHeight(inhalt)/2,inhalt
Text x+br/2-StringWidth(wert)/2,y+ho/2+ho/4-StringHeight(wert)/2,wert
Return on
End Function


Function GetWelt#(x,y)
If x < 0 Then x = 0
If x > weltx Then x = weltx
If y < 0 Then y = 0
If y > welty Then y = welty
Return welt(x,y)
End Function


Function UpdateTerrainMesh(x,y)
m = terrainmesh(x,y)
sur = GetSurface(m,1)
br = 32
For yi=0 To br
For xi=0 To br
v = xi+yi*(br+1)
h# = GetWelt(x*br+xi,y*br+yi)
VertexCoords(sur,v, xi,h,yi)
nx# = (GetWelt(x*br+xi-1,y*br+yi)-h) - (GetWelt(x*br+xi+1,y*br+yi)-h)
ny# = 1
nz# = (GetWelt(x*br+xi,y*br+yi-1)-h) - (GetWelt(x*br+xi,y*br+yi+1)-h)
l# = entf(nx,ny,nz)
If l > 0 Then
nx = nx / l
ny = ny / l
nz = nz / l
EndIf
VertexNormal(sur,v, nx,ny,nz)
Next
Next
End Function


Function CreateTerrainTile()
br = 32
m = CreateMesh()
sur = CreateSurface(m)
For y=0 To br
For x=0 To br
h# = 0
v = AddVertex(sur, x,h,y, x,y)
VertexNormal(sur,v, 0,1,0)
Next
Next
For y=0 To br-1
For x=0 To br-1
p1 = y*(br+1)+x
p2 = p1+1
p3 = p1+(br+1)
p4 = p1+(br+1)+1
AddTriangle(sur,p1,p3,p2)
AddTriangle(sur,p2,p3,p4)
Next
Next
Return m
End Function


Function entf#(x#,y#,z#)
Return (x*x + y*y + z*z)^0.5
End Function


Function cammove()
If MouseDown(2) Then
RotateEntity camera,EntityPitch(camera)+mys/10.0,EntityYaw(camera)-mxs/10.0,0
speed# = 1.1
If KeyDown(17) Then MoveEntity camera,0,0,speed#
If KeyDown(31) Then MoveEntity camera,0,0,-speed#
If KeyDown(30) Then MoveEntity camera,-speed#,0,0
If KeyDown(32) Then MoveEntity camera,speed#,0,0
MoveEntity camera,0,speed#*mzs*5,0
MoveMouse 256+(xfenster-256)/2,yfenster/2
EndIf
End Function

Neue Antwort erstellen


Übersicht BlitzBasic Codearchiv

Gehe zu:

Powered by phpBB © 2001 - 2006, phpBB Group