New mountain thing
Here's one with 3d colored polygons.
-------------------------------------------
-- Fractal Landscape Generator
-- version .5 2/7/98
-- Copyright 1998 Lord Generic Productions
-- Use at your own risk =)
-------------------------------------------
without type_check
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
sequence X
integer maxlevel,addition,i,N,wire
--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() --Generates Gaussian Random Numbers
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
----------------initial parameters-----------
maxlevel=7 --Number of recursions
sigma=1 --Standard Deviation
H=.5 --Fractal Dimension = 3-H
addition=0 --Add extra randomness to points?
---------------------------------------------
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
position(1,1)
puts(1,"Working on Stage #")?(stage)
-- 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/2)*175)+25 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
end procedure
-----------------------------------------
procedure drawit()
sequence temp
i = graphics_mode(261)
temp=read_gif("color.gif")
all_palette(temp[1]/4)
display_image({0,0},temp[2])
if maxlevel<9 then display_image({0,0},X) 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=15480 MX=0 MY=5250 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)
sy=floor(D1*z1/y1)+250
return({sx,sy})
end function
-------------------------------------------------
procedure test3d()
--atom x1,y1,z1
atom scale,color,vscale,check
sequence points,points2
sequence point1,point2,point3,point4
points=repeat(0,N)
points2=repeat(0,N)
scale=257/N
check=time()
for x=1 to N-1 do
for y=1 to N-1 do
vscale=1
if color>250 then color=250 end if
if color<0 then color=-color end if
--add come highlight pixels to break up the solid colored polys
if color>5 and color<150then pixel(color+rand(50),point1)
elsif color>150 then pixel(color-rand(50),point1) end if
end for
end for
points=repeat(0,N+2)
points2=points
points2[N+2]=points[N+2]
for x=2 to N+1 do
points2[x]=perspective(N*scale+110,(x-1)*scale-80,-X[x-1][N]/7) /vscale
end for
polygon(150,0,points)
polygon(150,0,points2)
check=time()-check
position(1,50) print(1,check)
end procedure
-------------------------------------------------
--main program
for x= 1 to 10 do --creates 10 different maps and displays them
wire=1 --0 for wireframe, 1 for filled polygons
maxlevel=8 --high detail but slow, set lower for lower detail
mtn() --generates the fractal
drawit() --sets the video mode and draws the 2d map
viewangle(25,32) --rotates the landscape for a good view. Pitch,Yaw
test3d() --makes 3d coordinates and draws polygons
position(23,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)
----------------------------------------------
|
Not Categorized, Please Help
|
|
