@Scraggle
I've had a look at my old diamond-square code and it looks a bit tired now.
I've revamped it a bit for heightmaps. It gives you 766 different possible heights (=255*3+1) and there is an option for it to be seamless.
The output is an (almost) grey scale image and you get the height by adding all three RGB components.
The code could probably be improved further - let me know if you need any changes.
One addition might be to make the heightmap rougher with increasing altitude - probably my next refinement (other than code optimisation which this version desperately needs
).
Here's the new code:
` Green Gandalf's fractal height map maker v3
` Created 11 November 2007.
` Produces a heightmap image in which the height should be interpreted as
` the sum of the RGB colour components, i.e. a height resolution of
` 766 values ranging from 0 (black = 0+0+0) to 765 (white = 255+255+255)
` Produces a fractal image based on ideas in following website
` http://www.gameprogrammer.com/fractal.html
` n=8 gives a 256x256 bitmap, n=9 gives a 512x512 bitmap
set display mode 1024, 768, 32
sync on: sync rate 60: sync
set text opaque
set cursor 20, 20: input "Enter 1 for seamless image, 0 otherwise: "; seamless
set cursor 20, 50: input "Image size power of 2 (e.g. 8 for 256x256 image): "; n
dispersion#=512: k=0
maxgrid=2^n: g=maxgrid
dim height(maxgrid, maxgrid) as float
dim col(2, maxgrid, maxgrid) as integer
im=1: gosub makeImage ` prepare initial image
set current bitmap 1
get image 1,0,0,maxgrid,maxgrid,1
if file exist("testImage.png") then delete file "testImage.png"
save image "testImage.png",1
end
make_bitmap:
create bitmap im, maxgrid+1, maxgrid+1
lock pixels
for i=0 to maxgrid
for j=0 to maxgrid
gosub dotij
next j
next i
unlock pixels
set current bitmap 0
cls
copy bitmap im,0
center text screen width()/2, screen height()/2, "Press any key to continue"
sync
wait key
return
dotij:
dot i, j, rgb(col(0,i,j), col(1,i,j), col(2,i,j))
return
diamond_step:
i=mid: i1=i-mid: i2=i+mid
while i<maxgrid
j=mid: j1=j-mid: j2=j+mid
while j<maxgrid
av#=(height(i1,j1)+height(i1,j2)+height(i2,j1)+height(i2,j2))/4.0
` calculate random values between -1 and 1
u#=rnd(16384)/8192.0-1.0
height(i,j)=av#+u#*d#
inc j,g: inc j1,g: inc j2,g
endwhile
inc i,g: inc i1,g: inc i2,g
endwhile
return
square_step:
i=0: i1=i-mid: i2=i+mid: js=0
while i<maxgrid+1-seamless ` use this line for seamless image
js=mid-js ` toggle start values of j loop
j=js: j1=j-mid: j2=j+mid
while j<maxgrid+1-seamless ` use this line for seamless image
av#=0
if i1<0 ` check for need to wrap around read i value
if seamless
inc av#, height(maxgrid+i1,j) + height(i2,j)
else
inc av#, height(i2,j) + height(i2,j)
endif
else
if i2>maxgrid
if seamless
inc av#, height(i1,j) + height(i2-maxgrid,j)
else
inc av#, height(i1,j) + height(i1,j)
endif
else
inc av#, height(i1,j) + height(i2,j)
endif
endif
if j1<0 ` check for need to wrap around read j value
if seamless
inc av#, height(i,maxgrid+j1) + height(i,j2)
else
inc av#, height(i,j2) + height(i,j2)
endif
else
if j2>maxgrid
if seamless
inc av#, height(i,j1) + height(i,j2-maxgrid)
else
inc av#, height(i,j1) + height(i,j1)
endif
else
inc av#, height(i,j1) + height(i,j2)
endif
endif
av#=av#/4
` calculate random value between -1 and 1
u#=rnd(16384)/8192.0-1.0
height(i,j) = av# +u# *d#
if seamless
if i=0 then height(maxgrid,j) = height(0,j) ` copy opposite edge
if j=0 then height(i,maxgrid) = height(i,0)
endif
inc j,g: inc j1,g: inc j2,g
endwhile
inc i,mid: inc i1,mid: inc i2,mid
endwhile
return
makeImage:
` creates a fractal image loosely based on the "diamond-square algorithm"
cls
` initialise a few things
randomize timer()
g=maxgrid
d#=dispersion#
for i=0 to maxgrid
for j=0 to maxgrid
height(i,j)=k
next j
next i
` main loop
while g>1
mid=g/2
` diamond step - calculates new diamond corners from squares
gosub diamond_step
` square step - calculates new square corners from diamonds
gosub square_step
d#=d#/2.0: g=g/2
endwhile
` now scale heightmap values to range 0 to 765
min#=height(0,0): max#=min#
for i=0 to maxgrid
for j=0 to maxgrid
u#=height(i,j)
if u#<min#
min#=u#
else
if u#>max# then max#=u#
endif
next j
next i
max#=765.0/(max#-min#)
for i=0 to maxgrid
for j=0 to maxgrid
temp=int((height(i,j) - min#) * max#)
` range check for three byte total just in case
if temp<0
temp = 0
else
if temp > 765 then temp = 765
endif
temp1 = temp MOD 3
temp2 = temp/3
col(0,i,j) = temp2
col(1,i,j) = temp2
col(2,i,j) = temp2
if temp1 > 0
col(0,i,j) = temp2+1
if temp1 > 1
col(1,i,j) = temp2 + 1
endif
endif
next j
next i
gosub make_bitmap
return
