New, New mtn thing
Here's the last version I'm doing for awhile. This one has the palette
included, so you don't need the color.gif thing anymore.
Enjoy,
Michael Packard
Lord Generic Productions
----------------------------------------------------------
----------------------------------
-- Fractal Landscape Generator -
-- Version .75 2/11/98 -
-- Copyright 1998 -
-- Lord Generic Productions -
----------------------------------
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,pal
integer maxlevel,addition,i,N,wire
integer D,d
atom sigma,H,delta,max,min
----------------------------
-- vga palette for mountain
pal=
{63,63,63}}
-------------------------------------------
--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
---------------------------------------------
--initial parameters
sigma=1.5 -- Initial Standard Deviation Determines max height
H=.75 -- Fractal Dimention = 3-H Determines smoothness
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,50)
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
position(3,50)
puts(1,"Time: ") ?(max)
position(4,50)
puts(1,"Size: ") ?(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()
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=-2000 MX=0 MY=-700 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)+500
sy=floor(D1*z1/y1)+380
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>240 then color=240 end if
if color<0 then color=-color end if
if wire=0 then polygon(0,1,{point1,point2,point3,point4,point1}) end if
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-129,(x-1)*scale-129,-X[x-1][N]/10) /vscale
end for
polygon(0,1,points)
polygon(0,1,points2)
polygon(150,0,points)
polygon(150,0,points2)
check=time()-check
position(6,50)
puts(1,"3D Draw Time: ") print(1,check)
end procedure
-------------------------------------------------
--main program
i=graphics_mode(261)
all_palette(pal)
for x= 1 to 50 do
puts(1,"*******************************\n\r")
puts(1,"* Fractal Landscape Generator *\n\r")
puts(1,"* Version .75 2/11/98 *\n\r")
puts(1,"* Copyright 1998 *\n\r")
puts(1,"* Lord Generic Productions *\n\r")
puts(1,"*******************************\n\r")
wire=1 --0 for wireframe, 1 for filled polygons
maxlevel=8 --High detail level but slow. Set lower for lower detail
mtn() --Generates the fractal
drawit() --Draw the 2D map
viewangle(30,rand(90)) --Rotates the landscape for a good view. (pitch,yaw)
test3d() --Makes 3D coordinates and draws polygons
position(45,1) puts(1,"Press any Key\n\rPress Q or ESC to quit")
i=wait_key()
if i=27 or i='q' then i= graphics_mode(-1) abort(0) end if
if i='m' then i=save_screen(0,"3dland.bmp") end if
clear_screen()
end for
i=graphics_mode(-1)
----------------------------------------------
|
Not Categorized, Please Help
|
|
