[dsd]

Внезапно осознал как ускорить свой генератор высот во много раз. Теперь изображение генерируется раз в 10 дольше массива. Плюс добавил отрисовку уровня моря и еще кое что.

Кстати, а почему шаг в цикле for ... next нельзя менять даже вне цикла?

Global xelements=1024,maxd,img,h#
Global sealevel#=0.15
Global MountainDiff=4
Graphics3D 536,536,0,2
SetBuffer BackBuffer()

SeedRnd MilliSecs()
z=Rand(20,4500)

While  Not z=0 Or KeyHit(1)
maxd=maxd+1
z=xelements Shr maxd
Wend
maxd=maxd-1
Print "number of repetitions: "+maxd

Dim heightmap#(xelements,xelements,2)
heightmap#(0,0,0)=Rnd(-5,5)	 											heightmap#(0,0,1)=1
heightmap#(xelements-1,0,0)=Rnd(-5,5)							heightmap#(xelements-1,0,1)=1
heightmap#(0,xelements-1,0)=Rnd(-5,5)							heightmap#(0,xelements-1,0)=1
heightmap#(xelements-1,xelements-1,0)=Rnd(-5,5)		heightmap#(xelements-1,xelements-1,0)=1

h00#=heightmap#(0,0,0)
h10#=heightmap#(xelements-1,0,0)
h01#=heightmap#(0,xelements-1,0)
h11#=heightmap#(xelements-1,xelements-1,0)


For d=maxd To 1 Step -1 

bz=2^(d-1) 
x0=0
While Not  x0>( xelements-1)
y0=0
While Not  y0>( xelements-1)

			x000=Abs((x0-bz) Mod xelements)
			y000=Abs((y0-bz) Mod xelements)
			x001=Abs((x0+bz)Mod xelements)
			y001=Abs((y0+bz)Mod xelements)			
			x002=Abs((x0+bz-1)Mod xelements)
			y002=Abs((y0+bz-1)Mod xelements)

			x00#=heightmap#(x000,y000,0)
			x01#=heightmap#(x001,y000,0)
			x10#=heightmap#(x000,y001,0)
			x11#=heightmap#(x001,y001,0)

			If heightmap#(x001,y001,1)=1 And heightmap#(x000,y001,1)=1 And heightmap#(x001,y000,1)=1 And heightmap#(x000,y000,1)=1 Then

				heightmap#(x0,y0,0)=(x00+x01+x10+x11)/4+1.44*bz*Rnd(-0.2,0.2)
				heightmap#(x000,y0,0)=(x00+x10)/2+bz*Rnd(-0.1,0.1)
				heightmap#(x001,y0,0)=(x01+x11)/2+bz*Rnd(-0.1,0.1)
				heightmap#(x0,y000,0)=(x00+x01)/2+bz*Rnd(-0.1,0.1)
				heightmap#(x0,y001,0)=(x11+x10)/2+bz*Rnd(-0.1,0.1)

				heightmap#(x0,y0,1)=1
				heightmap#(x000,y0,1)=1
				heightmap#(x001,y0,1)=1
				heightmap#(x0,y000,1)=1
				heightmap#(x0,y001,1)=1
				
			EndIf
y0=y0+bz		

Wend
x0=x0+bz
Wend
Print Abs((d-maxd)*100/maxd)+"%      "+(xelements-1)Mod (1 Shl d) + "      " + bz
Next
Print "Array is ready"
Print "resize of array elements just started"
hmax#=0
hmin#=0
For x=1 To xelements 
For y=1 To xelements 
x0=x-1
y0=y-1
If heightmap#(x0,y0,0)>hmax Then hmax=heightmap#(x0,y0,0)
If heightmap#(x0,y0,0)<hmin Then hmin=heightmap#(x0,y0,0)
Next 
Next 

h#=hmax-hmin
For x=1 To xelements 
For y=1 To xelements 
x0=x-1
y0=y-1
heightmap#(x0,y0,0)=((heightmap#(x0,y0,0)-hmin)/h)^MountainDiff
Next 
Next 


MakeImage()
ResizeImage img,512,512


While Not  ((KeyDown(56) And KeyHit(62)) Or  (KeyHit(56) And KeyDown(62))  Or KeyHit(1))

UpdateWorld
RenderWorld
ClsColor 0,75,151
Cls
DrawImage img,12,12

;Text 200,400,17 Mod (1 Shl 8)
;Text 200,420,hmin+"     "+hmax

Text 0,0,1 Shl 8
Flip
Wend
End

Function MakeImage()
Print "Making image"
img=CreateImage(xelements,xelements)
SetBuffer ImageBuffer(img)
ClsColor 255,0,0
Cls
For x=1 To xelements 
For y=1 To xelements 
x0=x-1
y0=y-1
d=255*(1-heightmap#(x0,y0,0))

;If x0>xelements/2 Then d=Rand(0,255) ; for viewing regular noise, just to find is there any difference or not
Color d,d,d
If heightmap#(x0,y0,0)<sealevel Then Color 57,67,255 ;for showing sea level

Plot x0,y0

Next 
Next 
SetBuffer BackBuffer()
End Function