Terrainvegetationsberechnung

Übersicht BlitzBasic Codearchiv

Neue Antwort erstellen

Goldini

Betreff: Terrainvegetationsberechnung

 BeitragSo, März 09, 2008 22:59
Antworten mit Zitat
Benutzer-Profile anzeigen
Hi,
Ich hab mal ein kleines Programm geschrieben, dass Colormaps für Terrains berechnet.

Code: [AUSKLAPPEN]

Graphics3D 800,600,32,2

; Benötigte Parameter für das bemalen des Terrains
Const hmap$="gfx/heightmap.png",steps=2
Global tex,iwidth,iheight,tex2,ter
Dim red(255)
Dim green(255)
Dim blue(255)

; Kamrea und so einrichten
Global main_pivot = CreatePivot()
Global cam = CreateCamera(main_pivot)
PositionEntity cam,0,600,0
RotateEntity cam,90,0,0
CameraRange cam,1,30000
CameraClsColor cam,0,100,200
CameraFogMode cam,0
CameraFogRange cam,150,300
CameraFogColor cam,190,210,245
EntityType cam, 2
MoveEntity cam,0,3,-3
TurnEntity cam,20,0,0

; Licht setzen
main_light = CreateLight(3)
LightRange main_light,3000
PositionEntity main_light,2000,500,2000
PointEntity main_light, main_pivot

; Terrain erstellen
ter = LoadTerrain(hmap$)
;-------------------!!!WICHTIG!!!--Funktion-am-besten-SOFORT-nach Erstellung-des-Terrains-einsetzen------------
DrawTerrainColorMap(hmap$,"gfx/tex02.jpg","gfx/landcolors.bmp",ter)
;--------------------------------------------------------------------------------------------------------------
ScaleEntity ter,5,200,5
PositionEntity ter,-iwidth/2*5,0,-iheight*5
TerrainDetail ter,10000,1
TerrainShading ter,0
EntityFX ter,2

; Hauptschleife
timer=CreateTimer(70)
While Not KeyHit(1)
WaitTimer(timer)

   TurnEntity cam,MouseYSpeed(),-MouseXSpeed(),0
   MoveMouse 400,300
   RotateEntity cam,EntityPitch(cam),EntityYaw(cam),0
   If KeyDown(200) Then MoveEntity cam,0,0,1
   PositionEntity cam,EntityX(cam),TerrainY(ter,EntityX(cam),0,EntityZ(cam))+6,EntityZ(cam)

UpdateWorld
RenderWorld

Flip 0
Wend

; Funktion zum bemalen des Terrains
Function DrawTerrainColorMap(heightmap$,structure$,Colorrect$="gfx/landcolors.bmp",terrain)
   
   cmap=LoadImage(Colorrect$)
   img=LoadImage(heightmap$)
   iwidth=ImageWidth(img)
   iheight=ImageHeight(img)

   For x=0 To 255
      rgb=ReadPixel(x,5,ImageBuffer(cmap))
      red(x)=(rgb And $FF0000)/$10000
      green(x)=(rgb And $FF00)/$100
      blue(x)=rgb And $FF
   Next

   tex=CreateTexture(iwidth,iheight)
   SetBuffer TextureBuffer(tex)

   For x=0 To iwidth Step steps
      For y=0 To iheight Step steps
      rgb=ReadPixel(x,y,ImageBuffer(img))
      b=rgb And $FF
      Color red(b),green(b),blue(b)
      Rect x-1,y-1,2,2
      Next
   Next

   SetBuffer BackBuffer()
   ScaleTexture tex,iwidth,iheight
   tex2=LoadTexture(structure$)
   ScaleTexture tex2,5,5
   TextureBlend tex2,2
   EntityTexture terrain,tex,0,0
   EntityTexture terrain,tex2,0,1

End Function

ClearWorld
End


Die beispiel Daten zum Programm findet ihr HIER

Mfg Goldini

Benibaerenstark

Betreff: Gute Arbeit

 BeitragMo, März 10, 2008 1:34
Antworten mit Zitat
Benutzer-Profile anzeigen
Hey Goldini,

gute Arbeit, damit kann man aufbauen. Der nächste Schritt wäre, dass man einer gewissen Höhe nicht nur eine gewisse Farbe, sondern eine gewisse Textur zuordnen lassen könnte Wink aber schon mal vielen Dank für diesen hübschen code.

mfg beni
3D Scanner selber bauen? -> www.bewe-3dscanner.ch.vu

Goldini

 BeitragMo, März 10, 2008 7:55
Antworten mit Zitat
Benutzer-Profile anzeigen
Danke für das Kompliment und die Erweiterungsidee Very Happy
Ich werd dran bleiben
Mit diesen Zeilen danke ich einer Person, die mich für so wichtig hält, dass sie sogar einen Club nach mir benannt hat!
Danke! Very Happy

Goldini

 BeitragMo, März 10, 2008 9:34
Antworten mit Zitat
Benutzer-Profile anzeigen
Kleines update: mit steps lässte sich nun die Feinheit der Textur einstellen.
steps lässt sich nur auf die Werte 1,2,4,8,16,32,64,128,256,512,1024,2048,4096 setzen. Ab 64 wird die ganze Sache so grob,dass man gar keine berechnete Textur mehr braucht.

Code: [AUSKLAPPEN]
;benötigte Daten sind im BlitzPortalArchiv zu finden
Graphics3D 800,600,32,2

; Benötigte Parameter für das bemalen des Terrains
Const hmap$="gfx/heightmap.png",steps=2
Global tex,iwidth,iheight,tex2,ter
Dim red(255)
Dim green(255)
Dim blue(255)

; Kamrea und so einrichten
Global main_pivot = CreatePivot()
Global cam = CreateCamera(main_pivot)
PositionEntity cam,0,600,0
RotateEntity cam,90,0,0
CameraRange cam,1,30000
CameraClsColor cam,0,100,200
CameraFogMode cam,0
CameraFogRange cam,150,300
CameraFogColor cam,190,210,245
EntityType cam, 2
MoveEntity cam,0,3,-3
TurnEntity cam,20,0,0

; Licht setzen
main_light = CreateLight(3)
LightRange main_light,3000
PositionEntity main_light,2000,500,2000
PointEntity main_light, main_pivot

; Terrain erstellen
ter = LoadTerrain(hmap$)
;-------------------!!!WICHTIG!!!--Funktion-am-besten-SOFORT-nach Erstellung-des-Terrains-einsetzen------------
DrawTerrainColorMap(hmap$,"gfx/tex02.jpg","gfx/landcolors.bmp",ter)
;--------------------------------------------------------------------------------------------------------------
ScaleEntity ter,5,200,5
PositionEntity ter,-iwidth/2*5,0,-iheight*5
TerrainDetail ter,10000,1
TerrainShading ter,0
EntityFX ter,2

; Hauptschleife
timer=CreateTimer(70)
While Not KeyHit(1)
WaitTimer(timer)

   TurnEntity cam,MouseYSpeed(),-MouseXSpeed(),0
   MoveMouse 400,300
   RotateEntity cam,EntityPitch(cam),EntityYaw(cam),0
   If KeyDown(200) Then MoveEntity cam,0,0,1
   PositionEntity cam,EntityX(cam),TerrainY(ter,EntityX(cam),0,EntityZ(cam))+6,EntityZ(cam)

UpdateWorld
RenderWorld

Flip 0
Wend

; Funktion zum bemalen des Terrains
Function DrawTerrainColorMap(heightmap$,structure$,Colorrect$="gfx/landcolors.bmp",terrain)
   
   cmap=LoadImage(Colorrect$)
   img=LoadImage(heightmap$)
   iwidth=ImageWidth(img)
   iheight=ImageHeight(img)

   For x=0 To 255
      rgb=ReadPixel(x,5,ImageBuffer(cmap))
      red(x)=(rgb And $FF0000)/$10000
      green(x)=(rgb And $FF00)/$100
      blue(x)=rgb And $FF
   Next

   tex=CreateTexture(iwidth,iheight)
   SetBuffer TextureBuffer(tex)

   For x=0 To iwidth Step steps
      For y=0 To iheight Step steps
      rgb=ReadPixel(x,y,ImageBuffer(img))
      b=rgb And $FF
      Color red(b),green(b),blue(b)
      Rect x-steps/2,y-steps/2,steps,steps
      Next
   Next

   SetBuffer BackBuffer()
   ScaleTexture tex,iwidth,iheight
   tex2=LoadTexture(structure$)
   ScaleTexture tex2,5,5
   TextureBlend tex2,2
   EntityTexture terrain,tex,0,0
   EntityTexture terrain,tex2,0,1

End Function

ClearWorld
End


Mfg Goldini
Mit diesen Zeilen danke ich einer Person, die mich für so wichtig hält, dass sie sogar einen Club nach mir benannt hat!
Danke! Very Happy
 

Phlox

 BeitragMo, März 10, 2008 10:00
Antworten mit Zitat
Benutzer-Profile anzeigen
Goldini hat Folgendes geschrieben:
steps lässt sich nur auf die Werte 1,2,4,8,16,32,64,128,256,512,1024,2048,4096 setzen.


Das stimmt nicht. Steps lässt sich auch auf z.B. 3 setzen!
EDIT:
Toller Code!

Goldini

 BeitragMo, März 10, 2008 10:07
Antworten mit Zitat
Benutzer-Profile anzeigen
Natürlich lässt sich steps auch auf alles andere setzen! Aber da Heightmaps immer ein Exponent von 2² sind sollte man steps auch nur auf ein Exponent von 2 setzen!
Mit diesen Zeilen danke ich einer Person, die mich für so wichtig hält, dass sie sogar einen Club nach mir benannt hat!
Danke! Very Happy
 

Phlox

 BeitragMo, März 10, 2008 10:10
Antworten mit Zitat
Benutzer-Profile anzeigen
Die Textur hat mit dem Terrain nichts zu tun!

Goldini

 BeitragMo, März 10, 2008 10:13
Antworten mit Zitat
Benutzer-Profile anzeigen
Ich hab eine Speicherfunktion eingebaut für die Leute die nicht andauernd für ein und den selben Terrain dieselbe ColorMap wieder und wieder berechnen lassen wollen.
Code: [AUSKLAPPEN]
;benötigte Daten sind im BlitzPortalArchiv zu finden
Graphics3D 800,600,32,2

; Benötigte Parameter für das bemalen des Terrains
Const hmap$="gfx/heightmap.png",steps=2
Global tex,iwidth,iheight,tex2,ter
Dim red(255)
Dim green(255)
Dim blue(255)

; Kamrea und so einrichten
Global main_pivot = CreatePivot()
Global cam = CreateCamera(main_pivot)
PositionEntity cam,0,600,0
RotateEntity cam,90,0,0
CameraRange cam,1,30000
CameraClsColor cam,0,100,200
CameraFogMode cam,0
CameraFogRange cam,150,300
CameraFogColor cam,190,210,245
EntityType cam, 2
MoveEntity cam,0,3,-3
TurnEntity cam,20,0,0

; Licht setzen
main_light = CreateLight(3)
LightRange main_light,3000
PositionEntity main_light,2000,500,2000
PointEntity main_light, main_pivot

; Terrain erstellen
ter = LoadTerrain(hmap$)
;-------------------!!!WICHTIG!!!--Funktion-am-besten-SOFORT-nach Erstellung-des-Terrains-einsetzen------------
DrawTerrainColorMap(hmap$,"gfx/tex02.jpg","gfx/landcolors.bmp",ter)
;--------------------------------------------------------------------------------------------------------------
ScaleEntity ter,5,200,5
PositionEntity ter,-iwidth/2*5,0,-iheight*5
TerrainDetail ter,10000,1
TerrainShading ter,0
EntityFX ter,2

; Hauptschleife
timer=CreateTimer(70)
While Not KeyHit(1)
WaitTimer(timer)

   TurnEntity cam,MouseYSpeed(),-MouseXSpeed(),0
   MoveMouse 400,300
   RotateEntity cam,EntityPitch(cam),EntityYaw(cam),0
   If KeyDown(200) Then MoveEntity cam,0,0,1
   PositionEntity cam,EntityX(cam),TerrainY(ter,EntityX(cam),0,EntityZ(cam))+6,EntityZ(cam)

   If KeyDown(29) And KeyHit(31) Then SaveColorMap("gfx/colormap.bmp")

UpdateWorld
RenderWorld

Flip 0
Wend

; Funktion zum bemalen des Terrains
Function DrawTerrainColorMap(heightmap$,structure$,Colorrect$="gfx/landcolors.bmp",terrain)
   
   cmap=LoadImage(Colorrect$)
   img=LoadImage(heightmap$)
   iwidth=ImageWidth(img)
   iheight=ImageHeight(img)

   For x=0 To 255
      rgb=ReadPixel(x,5,ImageBuffer(cmap))
      red(x)=(rgb And $FF0000)/$10000
      green(x)=(rgb And $FF00)/$100
      blue(x)=rgb And $FF
   Next

   tex=CreateTexture(iwidth,iheight)
   SetBuffer TextureBuffer(tex)

   For x=0 To iwidth Step steps
      For y=0 To iheight Step steps
      rgb=ReadPixel(x,y,ImageBuffer(img))
      b=rgb And $FF
      Color red(b),green(b),blue(b)
      Rect x-steps/2,y-steps/2,steps,steps
      Next
   Next

   SetBuffer BackBuffer()
   ScaleTexture tex,iwidth,iheight
   tex2=LoadTexture(structure$)
   ScaleTexture tex2,5,5
   TextureBlend tex2,2
   EntityTexture terrain,tex,0,0
   EntityTexture terrain,tex2,0,1

End Function

Function SaveColorMap(name$)
SaveBuffer(TextureBuffer(tex),name$)
End Function

ClearWorld
End


@Phlox
Auch Texturen sollten immer ein Exponent von 2² sein, weil das in Blitz am schnellsten ist.

Mfg Goldini
Mit diesen Zeilen danke ich einer Person, die mich für so wichtig hält, dass sie sogar einen Club nach mir benannt hat!
Danke! Very Happy
 

Phlox

 BeitragMo, März 10, 2008 10:15
Antworten mit Zitat
Benutzer-Profile anzeigen
eben nicht, da die Textur nicht gescalt wird, sondern auch wenn man 3 einstellt die Größe von dem terrain hat.

Goldini

 BeitragMo, März 10, 2008 10:26
Antworten mit Zitat
Benutzer-Profile anzeigen
Man kann jetzt steps nur noch auf ein Exponent von 2 setzen!

Code: [AUSKLAPPEN]
;benötigte Daten sind im BlitzPortalArchiv zu finden
Graphics3D 800,600,32,2

; Benötigte Parameter für das bemalen des Terrains
Const hmap$="gfx/heightmap.png",steps=1
Global tex,iwidth,iheight,tex2,ter
Dim red(255)
Dim green(255)
Dim blue(255)

; Kamrea und so einrichten
Global main_pivot = CreatePivot()
Global cam = CreateCamera(main_pivot)
PositionEntity cam,0,600,0
RotateEntity cam,90,0,0
CameraRange cam,1,30000
CameraClsColor cam,0,100,200
CameraFogMode cam,0
CameraFogRange cam,150,300
CameraFogColor cam,190,210,245
EntityType cam, 2
MoveEntity cam,0,3,-3
TurnEntity cam,20,0,0

; Licht setzen
main_light = CreateLight(3)
LightRange main_light,3000
PositionEntity main_light,2000,500,2000
PointEntity main_light, main_pivot

; Terrain erstellen
ter = LoadTerrain(hmap$)
;-------------------!!!WICHTIG!!!--Funktion-am-besten-SOFORT-nach Erstellung-des-Terrains-einsetzen------------
DrawTerrainColorMap(hmap$,"gfx/tex02.jpg","gfx/landcolors.bmp",ter)
;--------------------------------------------------------------------------------------------------------------
ScaleEntity ter,5,200,5
PositionEntity ter,-iwidth/2*5,0,-iheight*5
TerrainDetail ter,10000,1
TerrainShading ter,0
EntityFX ter,2

; Hauptschleife
timer=CreateTimer(70)
While Not KeyHit(1)
WaitTimer(timer)

   TurnEntity cam,MouseYSpeed(),-MouseXSpeed(),0
   MoveMouse 400,300
   RotateEntity cam,EntityPitch(cam),EntityYaw(cam),0
   If KeyDown(200) Then MoveEntity cam,0,0,1
   PositionEntity cam,EntityX(cam),TerrainY(ter,EntityX(cam),0,EntityZ(cam))+6,EntityZ(cam)

   If KeyDown(29) And KeyHit(31) Then SaveColorMap("gfx/ColorMap.bmp")

UpdateWorld
RenderWorld

Flip 0
Wend

; Funktion zum bemalen des Terrains
Function DrawTerrainColorMap(heightmap$,structure$,Colorrect$="gfx/landcolors.bmp",terrain)
   
   If Log(steps) / Log(2) > Floor(Log(steps) / Log(2)) Then RuntimeError "Steps has to be a power of 2"
   cmap=LoadImage(Colorrect$)
   img=LoadImage(heightmap$)
   iwidth=ImageWidth(img)
   iheight=ImageHeight(img)

   For x=0 To 255
      rgb=ReadPixel(x,5,ImageBuffer(cmap))
      red(x)=(rgb And $FF0000)/$10000
      green(x)=(rgb And $FF00)/$100
      blue(x)=rgb And $FF
   Next

   tex=CreateTexture(iwidth,iheight)
   SetBuffer TextureBuffer(tex)

   For x=0 To iwidth Step steps
      For y=0 To iheight Step steps
      rgb=ReadPixel(x,y,ImageBuffer(img))
      b=rgb And $FF
      Color red(b),green(b),blue(b)
      Rect x-steps/2,y-steps/2,steps,steps
      Next
   Next

   SetBuffer BackBuffer()
   ScaleTexture tex,iwidth,iheight
   tex2=LoadTexture(structure$)
   ScaleTexture tex2,5,5
   TextureBlend tex2,2
   EntityTexture terrain,tex,0,0
   EntityTexture terrain,tex2,0,1

End Function

Function SaveColorMap(name$)
SaveBuffer(TextureBuffer(tex),name$)
End Function


ClearWorld
End


Mfg
Mit diesen Zeilen danke ich einer Person, die mich für so wichtig hält, dass sie sogar einen Club nach mir benannt hat!
Danke! Very Happy

Neue Antwort erstellen


Übersicht BlitzBasic Codearchiv

Nach Oben

Gehe zu:

Powered by phpBB © 2001 - 2006, phpBB Group