TheGameCreators - CodeBase - 3d height map generator

Return to the CodeBase listing

Category: Basic 2D

Version: 1.0

Information

Uploaded: 22nd Apr 2004 08:39

Modified: 1st Jan 1970 01:00

Author: malcolm

Summary

This code will generator a height map it has been converted from a blitz basic source code

Full Description

Height Map Generator by Rob Farley 2001 converted to dark basic by malcolm bamber all i have done is put some code in to allow any size bitmap you want has long has you have the ram and removed some commands that dark basic did not need

DarkBASIC Professional Source Code

` This code was downloaded from The Game Creators

` It is reproduced here with full permission

` http://www.thegamecreators.com

Rem Project: map_generator

Rem Created: 21/04/2004 17:26:23

Rem ***** Main Source File *****

` Height Map Generator

` Rob Farley 2001

` rob@mentalhangover.co.uk

` http://www.mentalhangover.co.uk

`THIS SOURCE CODE WAS CONVERTED TO DARK BASIC PRO FROM BLITZ BASIC

`BY MALCOLM BAMBER

set display mode 1024,768,32

set text size 32

` Play with these varibles to change the look of the landscape

size=256

scale=5

hill_size=50

hill_number=30

dip_size=100

dip_number=10

ink rgb(255,255,255),0

repeat

cls

a$=""

print "Height Map Generator:"

print "Rob Farley 2001:"

print "THIS SOURCE CODE WAS CONVERTED TO DARK BASIC PRO FROM BLITZ BASIC:"

print "BY MALCOLM BAMBER:"

print "Size: ",size

print "Scale: ",scale

print "Hill Size: ",hill_size

print "Hill Quantity: ",hill_number

print "Dip Size: ",dip_size

print "Dip Quantity: ",dip_number

input "do you wish to edit values ",a$

if a$="y" or a$="Y" then gosub getuserinfo

until a$="N" or a$="n"

Dim land#(size,size)

Dim land2#(size,size)

Dim hill#(45,45)

Dim blur#(9,9)

CREATE BITMAP 1,size,size

rem read some data in for blur & hills

For x=1 To 9

For y=1 To 9

Read blur#(x,y)

blur#(x,y)=blur#(x,y)/10

Next y

Next x

For x=0 To 20

For r=0 To 359

sx=(Sin(r)*x)+23

sy=(Cos(r)*x)+23

hill#(sx,sy)=Cos(x*4)*10

Next r

Next x

gosub make_map

loop

delete bitmap 1

end

getuserinfo:

input "enter map size ",size

If size<256 Then size=256

`If size>1024 Then size=1024

input "enter map scale ",scale

If scale<0 Then scale=0

If scale>50 Then scale=50

input "enter hill_size ",hill_size

If hill_size<0 Then hill_size=0

input "enter hill_number ",hill_number

If hill_number<0 Then hill_number=0

input "enter dip_size ",dip_size

If dip_size<0 Then dip_size=0

input "enter dip_number ",dip_number

If dip_number<0 Then dip_number=0

return

make_map:

cls

` Make Landscape - Drawing edges...

print "Drawing Edges..."

h=120

For x=0 To size-1

land#(x+1,1)=h

h=h+Rnd(scale)-(scale/2)

Next x

h=120

For x=0 To size-1

land#(1,x+1)=h

h=h+Rnd(scale)-(scale/2)

Next x

` make landscape - fill in middle

print "Filling Middle..."

For x=2 To size

For z=2 To size

h=land#(x-1,z)

i=land#(x,z-1)

j=(h+i)/2

h=j+Rnd(scale)-(scale/2)

land#(x,z)=h

Next z

Next x

` make landscape - Create hills

For n=1 To hill_number

print "Creating Hills...",n,"/",hill_number

hx=Rnd(size)

hy=Rnd(size)

For x=1 To hill_size

For xx=1 To 45

For yy=1 To 45

hxx=hx+xx-1

hyy=hy+yy-1

If hxx>size Then hxx=hxx-size

If hxx<1 Then hxx=hxx+size

If hyy>size Then hyy=hyy-size

If hyy<1 Then hyy=hyy+size

land#(hxx,hyy)=land#(hxx,hyy)+hill#(xx,yy)

Next yy

Next xx

hx=hx+Rnd(10)-5

hy=hy+Rnd(10)-5

If hx<20 Then hx=size-20

If hx>size-20 Then hx=20

If hy<20 Then hy=size-20

If hy>size-20 Then hy=20

Next x

Next n

` make landscape - Create Dips

For n=1 To dip_number

print "Creating Dips...",n,"/",dip_number

hx=Rnd(ize)

hy=Rnd(size)

For x=1 To dip_size

For xx=1 To 45

For yy=1 To 45

hxx=hx+xx-1

hyy=hy+yy-1

If hxx>size Then hxx=hxx-size

If hxx<1 Then hxx=hxx+size

If hyy>size Then hyy=hyy-size

If hyy<1 Then hyy=hyy+size

land#(hxx,hyy)=land#(hxx,hyy)-hill#(xx,yy)

If land#(hxx,hyy)<-20 Then land#(hxx,hyy)=-20

Next yy

Next xx

hx=hx+Rnd(10)-5

hy=hy+Rnd(10)-5

If hx<20 Then hx=size-20

If hx>size-20 Then hx=20

If hy<20 Then hy=size-20

If hy>size-20 Then hy=20

Next x

Next n

` Blur Landscape

print "Blurring Landscape pass 1"

For x=1 To size

For y=1 To size

p=land#(x,y)

For bx=-4 To 4

For by=-4 To 4

xx=x+bx

yy=y+by

If xx>=1 And xx<=size And yy>=1 And yy<=size Then land2#(xx,yy)=land2#(xx,yy)+(p*blur#(bx+5,by+5))

Next by

Next bx

Next y

Next x

For x=1 To size

For y=1 To size

land#(x,y)=land2#(x,y)

land2#(x,y)=0

Next y

Next x

` Normalise Landscape

print "Normalising Landscape pass 1"

high#=-10000

low#=10000

For x=0 To size-1

For y=0 To size-1

If land#(x+1,y+1)>high# Then high#=land#(x+1,y+1)

If land#(x+1,y+1)<low# Then low#=land#(x+1,y+1)

Next y

Next x

normal#=high#-low#

For x=0 To size-1

For y=0 To size-1

l#=land#(x+1,y+1)

l#=l#-low#

l#=(l#/normal#)*255

land#(x+1,y+1)=Int(l#)

Next y

Next x

` Blur Landscape

print "Blurring Landscape pass 2"

For x=1 To size

For y=1 To size

p=land#(x,y)

For bx=-4 To 4

For by=-4 To 4

xx=x+bx

yy=y+by

If xx>=1 And xx<=size And yy>=1 And yy<=size Then land2#(xx,yy)=land2#(xx,yy)+(p*blur#(bx+5,by+5))

Next by

Next bx

Next y

Next x

For x=1 To size

For y=1 To size

land#(x,y)=land2#(x,y)

land2#(x,y)=0

Next y

Next x

` Normalise Landscape

print "Normalising Landscape pass 2"

high#=-10000

low#=10000

For x=0 To size-1

For y=0 To size-1

If land#(x+1,y+1)>high# Then high#=land#(x+1,y+1)

If land#(x+1,y+1)<low# Then low#=land#(x+1,y+1)

Next y

Next x

normal#=high#-low#

For x=0 To size-1

For y=0 To size-1

l#=land#(x+1,y+1)

l#=l#-low#

l#=(l#/normal#)*255

land#(x+1,y+1)=Int(l#)

Next y

Next x

cls 0

set current bitmap 1

` Render Heightmap and capture image

For x=0 To size

For y=0 To size

dot x,y,rgb(land#(x+1,y+1),land#(x+1,y+1),land#(x+1,y+1))

Next y

Next x

get image 1,0,0,size,size

set current bitmap 0

text 0,y,"Rendering Height Map"

copy bitmap 1,0

if file exist("heightmap.bmp")=1 then delete file "heightmap.bmp"

Save image "heightmap.bmp",1

return

Data 0,0,0,1,1,1,0,0,0

Data 0,0,1,2,3,2,1,0,0

Data 0,1,2,3,5,3,2,1,0

Data 1,2,3,5,7,5,3,1,1

Data 1,3,5,7,9,7,5,3,1

Data 1,2,3,5,7,5,3,1,1

Data 0,1,2,3,5,3,2,1,0

Data 0,0,1,2,3,2,1,0,0

Data 0,0,0,1,1,1,0,0,0

Download

Please login to download

Comments

No comments yet.

Author Name:	malcolm
CodeBase Entries:	6

CodeBase - 3d height map generator

Information

Summary

Full Description

DarkBASIC Professional Source Code

Download

Screen Shot

Author

Comments