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  'putpixel ei tykkää näistä
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
aika=Timer()
Repeat
_fps#=1000.0/(Timer()-aika)
aika=Timer()
kulma-5
Lock SCREEN()
For x=0 To 511 Step 6
For y=0 To 511 Step 6
Color 0,0,map(x,y,2)
For i=0 To Abs(map(x,y,0))+1 Step 6
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)-50,x2-200)
    xx#=y2:yy#=-(map(x,y,1)-i)-50:zz#=x2-200
    If zz>0 Then Exit   'epäilyttävä rivi, mutta saattaa olla superoptimaatio
    p_s# = (1/zz#)*100
    sx = xx# * p_s# + 200
    sy =-yy# * p_s# + 150
    s=-(p_s*2.5)*3
    If (sx+s)<399 And (sx-s)>0 And (sy+s)<299 And (sy-s)>0 Then
    For bx=-s To s
        For by=-s To s
        PutPixel2 sx+bx,sy+by,map(x,y,2),SCREEN()
        Next by
    Next bx
    EndIf
Next i
Next y
SetWindow int(x/5.12)+"% fps:"+_fps+" drawing"+Left("...",(x Mod 30)/ 8)
Next x
Unlock
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*2.5)
    s2=-(p_s*2.5)/2
    Box sx-s2,sy-s2,s,s
    
   
End Function