All pastes #744878 Raw Edit

atomimalli

public text v1 · immutable
·published 2007-10-21 21:19 UTC
rendered paste body
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


Repeat
kulma-5

For x=0 To 511 'Step 3
For y=0 To 511 'Step 3
Color 0,0,map(x,y,2)

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(x2,y2,map(x,y,1)+100)
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# + ScreenWidth()/2
    sy =-y# * p_s# + ScreenHeight()/2
   
    'Dot sx,sy
    'Box sx,sy,Abs(p_s*3),Abs(p_s*3)
    s=-(p_s*3)
    s2=-(p_s*3)/2
    Box sx-s2,sy-s2,s,s
   
End Function