Hier mal ein Terrain Generator von mir, mit Terrain Beispielbildern (Beispiele sind im Code enthalten).
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] [EINKLAPPEN] 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
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
Global takt Global buttonwahl=-1
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
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()
Dim noisefield#(127,127) For y=0 To 127 For x=0 To 127 noisefield(x,y) = Rnd(-1,1) Next Next
Global weltx = 256 Global welty = 256 Dim welt#(weltx,welty) Global tilex = weltx/32 Global tiley = welty/32 Dim terrainmesh(tilex-1,tiley-1)
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
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
Function Update(x,y) ystart = -1*(y<>0) xstart = -1*(x<>0) yend = 32+(y<>tiley-1) xend = 32+(x<>tilex-1) 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 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 xoff# = Int(xoffset*128)/128.0 yoff# = Int(yoffset*128)/128.0 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 x = x-Floor(x/br)*br y = y-Floor(y/br)*br xf# = (x-Floor(x)) yf# = (y-Floor(y)) 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() Color 192,192,192 Rect 0,0,256,yfenster,1 Color 0,0,0 Rect 255,0,1,yfenster,1 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 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 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
|