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