SCREEN 400,300,0,2
ClsColor 28,98,130
Cls
SetWindow "loading"
hmap=LoadImage("heightmap.bmp")
texmap=LoadImage("Terrain texture1.bmp")
Dim map(512,512,2)
Lock Image(hmap)
For x=0 To 511
For y=0 To 511
map(x,y,1)=GetPixel2(x,y,Image(hmap))/70000
Next y
SetWindow "loading"+Left("...",(x Mod 100)/ 30)
Next x
Lock Image(texmap)
For x=0 To 511
For y=0 To 511
map(x,y,2)=GetPixel2(x,y,Image(texmap))
Next y
SetWindow "loading"+Left("...",(x Mod 100)/ 30)
Next x
Unlock
For x=1 To 510
For y=1 To 510
map(x,y,0)=map(x,y,1)-Min( Min(map(x-1,y,1),map(x+1,y,1)),Min( Min(map(x+1,y+1,1),Min(map(x-1,y+1,1),map(x,y+1,1))) ,Min(map(x+1,y-1,1),Min(map(x-1,y-1,1),map(x,y-1,1)))))
Next y
SetWindow "processing..."
Next x
kulma=-50
Repeat
kulma-5
For x=0 To 511 Step 3
For y=0 To 511 Step 3
Color 0,0,map(x,y,2)
For i=0 To abs(map(x,y,0))+1 Step 3
d#=Distance(255,255,x,y)
k#=WrapAngle(ATan((y-250)/Float(x-250.5))+kulma)
If x>250 Then k-180
x2=Sin(k)*d
y2=Cos(k)*d
dot3d(y2,-(map(x,y,1)-i)-150,x2-200)
Next i
Next y
SetWindow "drawing"+Left("...",(x Mod 30)/ 8)
Next x
DrawScreen
Forever
SetWindow "ready"
WaitKey
Function Dot3D( x#, y#, z# )
If z# > 0 Then Return 0
If z# = 0 Then z# = 0.01
p_s# = (1/z#)*100
sx = x# * p_s# + 200
sy =-y# * p_s# + 150
'Dot sx,sy
s=-(p_s*3)*3
s2=-(p_s*3)/2*3
Box sx-s2,sy-s2,s,s
End Function