Another mountain thing
This message is in MIME format. The first part should be readable text,
while the remaining parts are likely unreadable without MIME-aware tools.
Send mail to mime at docserver.cac.washington.edu for more info.
--655872-375300303-886840735=:3490
This one actually does the 3d view calculations and displays a 3d
wireframe of the landscape. 3dland.gif is a screen shot.
-----------------------------------------------------------
--Fractal Landscape thing #3
--Copyright 1998 Lord Generic Productions
-------------------------------------------
include get.e
include machine.e
include image.e
include graphics.e
include pic_load.e
integer G,D1,MX,MY,MZ
atom SR1,SR2,CR1,CR2,SR3,CR3,roll
atom seed,Arand,Nrand,GaussAdd,GaussFac
--atom x,y
sequence X
integer maxlevel,addition,i,N
--stage,
integer D,d
atom sigma,H,delta,max,min
-------------------------------------------
--initization of Gaussian random thingy
Nrand=4
Arand=1000
seed=1234
GaussAdd=sqrt(3*Nrand)
GaussFac=2*GaussAdd/(Nrand * Arand)
--set_rand(seed)
------------------------------------------
function Gauss()
atom sum
sum=0
for i = 1 to Nrand do
sum=sum+rand(Arand)
end for
return(GaussFac * sum - GaussAdd)
end function
-------------------------------------------
function f3(atom delta, atom x0, atom x1, atom x2)
atom y,z
z=Gauss()
y=(x0+x1+x2)/3+delta*Gauss()
return(y)
end function
--------------------------------------------
function f4(atom delta, atom x0, atom x1, atom x2, atom x3)
atom y,z
z=Gauss()
y=(x0+x1+x2+x3)/4+delta*Gauss()
return(y)
end function
---------------------------------------------
maxlevel=7 --initial parameters
sigma=2.0
H=.5
addition=1
---------------------------------------------
procedure mtn()
atom k
min=time()
N=power(2,maxlevel)+1
delta=sigma
X=repeat(0,N)
for o=1 to N do
X[o]=repeat(0,N)
end for
X[1][1]=delta*Gauss()
X[1][N]=delta*Gauss()
X[N][1]=delta*Gauss()
X[N][N]=delta*Gauss()
D=N-1
d=D/2
for stage= 1 to maxlevel do
-- going from grid type I to type II
delta = delta * power(.5,.5*H)
-- interpolate and offset points
for x=d+1 to N-d+1 by D do
for y=d+1 to N-d+1 by D do
X[x][y]=f4(delta,X[x+d][y+d],X[x+d][y-d],X[x-d][y+d],X[x-d][y-d])
end for
end for
--displace other points also if necessary
if addition then
for x=1 to N+1 by D do
for y=1 to N+1 by D do
X[x][y]=X[x][y] + delta * Gauss()
end for
end for
end if
-- going from grid type II to type I
delta= delta*power(.5,.5*H)
-- interpolate and offset boundary grid points
for x = d+1 to N-d+1 by D do
X[x][1]=f3(delta,X[x+d][1],X[x-d][1],X[x][d])
X[x][N]=f3(delta,X[x+d][N],X[x-d][N],X[x][N-d])
X[1][x]=f3(delta,X[1][x+d],X[1][x-d],X[d][x])
X[N][x]=f3(delta,X[N][x+d],X[N][x-d],X[N-d][x])
end for
--interpolate and offset interior grid points
for x = d+1 to N-d by D do
for y = D+1 to N-d by D do
X[x][y] = f4(delta, X[x][y+d], X[x][y-d], X[x+d][y], X[x-d][y])
end for
end for
for x = D+1 to N-d by D do
for y = d+1 to N-d+1 by D do
X[x][y] = f4(delta, X[x][y+d], X[x][y-d], X[x+d][y], X[x-d][y])
end for
end for
if addition then
for x=1 to N by D do
for y=1 to N by D do
X[x][y]=X[x][y] + delta * Gauss()
end for
end for
for x=d+1 to N-d+1 by D do
for y=d+1 to N-d+1 by D do
X[x][y]=X[x][y] + delta * Gauss()
end for
end for
end if
D=D/2
d=floor(d/2)
end for
max=time()-min
--puts(1,"time: ") ?(max)
--?(length(X)*length(X))
min=255 max=0
for x= 1 to N do
for y= 1 to N do
k = X[x][y]
if k!=0 then k=((k/5)*128)+50 end if
if k<1 then k=1 end if
X[x][y]=floor(k)
if floor(k)<min then min=floor(k) end if
if floor(k)>max then max=floor(k) end if
end for end for
--puts(1,"min: ") ?(min)
--puts(1,"max: ") ?(max)
--i=wait_key()
end procedure
procedure drawit()
sequence temp
atom color
i = graphics_mode(261)
temp=read_gif("color.gif")
all_palette(temp[1]/4)
display_image({0,0},temp[2])
display_image({0,0},X)
for x=1 to N do
for y=1 to N do
if x=1 or x=N or y=1 or y=N then color=150 else color=X[x][y] end if
if color>255 then color=255 end if
y]/10+1}})
pixel(color,{180+y-(x/5),50+(x/2)-X[x][y]/20})
end for
end for
--i=wait_key()
--if i='m' then i=save_screen(0,"land.bmp") end if
end procedure
-------------------------------------------------
--3d draw stuff
procedure viewangle(atom pitch,atom yaw)--pitch and yaw angles in degrees
pitch=pitch*(.0174533) --convert to radians
yaw=yaw*(.0174533)
roll=0
roll=roll*(.0174533)
G=0 D1=3800 MX=0 MY=1500 MZ=0
SR1=sin(yaw) CR1=cos(yaw)
SR2=sin(roll) CR2=cos(roll)
SR3=sin(pitch) CR3=cos(pitch)
end procedure
---------------------------------------------------
function perspective(atom x1,atom y1, atom z1) --gives screen coordinates
atom xa,ya,za,sx,sy
xa=CR1*x1-SR1*y1
ya=SR1*x1+CR1*y1
x1=CR2*xa+SR2*z1
za=CR2*z1-SR2*xa
y1=CR3*ya-SR3*za
z1=SR3*ya+CR3*za
x1=x1+MX
y1=y1+MY
z1=z1+MZ
sx=floor(D1*x1/y1)+100
sy=floor(D1*z1/y1)+200
return({sx,sy})
end function
-------------------------------------------------
procedure test3d()
atom x1,y1,z1,scale
sequence points,points2
points=repeat(0,N)
points2=repeat(0,N)
scale=257/N
for x=1 to N do
for y=1 to N do
points[y]={x*scale+110,y*scale-80,-X[y][x]/5}
points2[y]={y*scale+110,x*scale-80,-X[x][y]/5}
end for
for m=1 to N do
end for
draw_line(1,points)
draw_line(1,points2)
end for
--i=wait_key()
end procedure
-------------------------------------------------
--main program
for x= 1 to 10 do
maxlevel=7
mtn()
drawit()
viewangle(45,30)
test3d()
position(24,1) puts(1,"Press any Key\n\rPress Q or ESC to quit")
i=wait_key()
if i=27 or i='q' then abort(0) end if
if i='m' then i=save_screen(0,"3dland.bmp") end if
end for
i=graphics_mode(-1)
----------------------------------------------
--655872-375300303-886840735=:3490
|
Not Categorized, Please Help
|
|
