This may be my last entry, I'm hexed at working on this. Just got a bloody nose and spilled water all over the desk.
f = fault formation randomize
r = randomize
s = smooth
n = calculate normals
p = repopulate ferns across map
set display mode 1024,768,32
sync on
backdrop on
color backdrop 0
hide mouse
randomize timer()
set camera range 1, 18000
grass()
get image 1, 0,0,128,128
cloud()
get image 2, 0,0,50,50
cls
ink rgb(0,255,0),0
fern(512,668,7,90,7,50,150)
fern(511,668,7,90,7,50,150)
fern(513,668,7,90,7,50,150)
fern(510,668,7,90,7,50,150)
fern(514,668,7,90,7,50,150)
line 512,668,512,768
box 510,668,514,768
blur bitmap 0,4
get image 3, 346,376,714,767
#constant N1 = 3
#constant N2 = 4
#constant N3 = 5
#constant N4 = 6
for t = 1 to 6
null = make vector3(t)
next t
global cStart = 10
global cCount = 400
global fStart = 600
global fCount = 600
for t = cStart to cStart+cCount
make object plain t, 1000+rnd(1000),1000+rnd(1000)
position object t, rnd(18000)-7000,rnd(100)+4000,rnd(18000)-7000
xrotate object t, 90
texture object t, 2
ghost object on t, 0
disable object zwrite t
set object light t,0
set object fog t, 0
next t
REM fern
tempObject = 599
make object plain tempObject,50,100
offset limb tempObject,0,0,50,0
texture object tempObject,3
set object transparency tempObject, 1
set object cull tempObject, 0
rem populate ferns
for t = fStart to fStart+fCount step 3
instance object t,tempObject
instance object t+1,tempObject
instance object t+2,tempObject
x = rnd(4000)
z = rnd(4000)
position object t, x, 0, z
position object t+1, x, 0, z
position object t+2, x, 0, z
yrotate object t+1,120 : fix object pivot t+1
yrotate object t+2,240 : fix object pivot t+2
x = wrapvalue(rnd(150)-75)
y = rnd(360)
z = wrapvalue(rnd(150)-75)
rotate object t,x,y,z
rotate object t+1,x,y,z
rotate object t+2,x,y,z
next t
tx = 100
tz = 100
tsx# = 3000.0/tx
tsz# = 3000.0/tz
mSize = 4000
dim heights#(tx,tz)
make matrix 1, mSize, mSize,tx,tz
`set matrix 1, 0, 0, 1, 1, 1, 1, 1
prepare matrix texture 1,1,1,1
rem water plane
make object plain 2, 18500, 18500
`make object plain 2, 5000,5000
set object fog 2,0
`set object light 2,0
`set object ambient 2, 0
position object 2, 2000,10,2000
xrotate object 2, 270
color object 2, rgb(30,60,250)
rem sky sphere
make object sphere 3, 18000
set object light 3,0
position object 3, 2000,0,2000
set object cull 3, 0
color object 3, rgb(60,120,250)
position camera 0,300,0
point camera 500,100,500
make light 1
`set point light 0,2000,3000,2000
set light range 1, 4000
fog on
fog distance 4000
fog color rgb(230,230,250)
DO
gosub camera_stuff
if inkey$()="f" and flag=0
flag = 1
x1 = rnd(mSize)
y1 = rnd(mSize)
x2 = rnd(mSize)
y2 = rnd(mSize)
gosub _calc_matrix
endif
if inkey$()="s" and flag2=0
flag2 = 1
gosub _smooth_matrix
endif
if inkey$()="r" and flag3=0
flag3=1
gosub _randomize_matrix
endif
if inkey$()="n" and flag4=0 then gosub calc_normals : flag4=1
if inkey$()="p" and flag5=0 then repopulateFerns() : flag5=1
if inkey$()<>"f" then flag = 0
if inkey$()<>"s" then flag2 = 0
if inkey$()<>"r" then flag3 = 0
if inkey$()<>"n" then flag4 = 0
if inkey$()<>"p" then flag5 = 0
moveClouds()
set cursor 0,0
print "FPS: ",screen fps()
print "X: ",cx#
print "Z: ",cz#
angle# = wrapvalue(angle#+0.1)
lx# = 2000+sin(angle#)*2000
lz# = 2000+cos(angle#)*2000
set point light 1, lx#,get ground height(1,lx#,lz#)+1000,lz#
sync
LOOP
_randomize_matrix:
for z = 1 to tz-1
for x = 1 to tx-1
h# = rnd(50)
set matrix height 1,x,z,heights#(x,z)+h#
heights#(x,z) = heights#(x,z)+h#
next x
next z
update matrix 1
RETURN
_calc_matrix:
h0# = 50
h1# = 20
for z = 1 to tz-1
for x = 1 to tx-1
px# = x*tsx#
pz# = z*tsz#
if point_line(px#,pz#,x1,y1,x2,y2) >= 0
h# = get matrix height(1,x,z)+h0#
set matrix height 1, x, z, h#
else
h# = get matrix height(1,x,z)-h1#
set matrix height 1, x, z, h#
endif
heights#(x,z) = h#
next x
next z
update matrix 1
RETURN
_smooth_matrix:
for z = 1 to tz-1
for x = 1 to tx-1
count = 0
h1# = 0
h2# = 0
h3# = 0
h4# = 0
h5# = 0
h6# = 0
h7# = 0
h8# = 0
if z < tz
if x > 0 then h1# = heights#(x-1,z+1) : inc count
h2# = heights#(x,z+1) : inc count
if x < tx then h3# = heights#(x+1,z+1) : inc count
endif
if x > 0 then h4# = heights#(x-1,z) : inc count
if x < tx then h5# = heights#(x+1,z) : inc count
if z > 0
if x > 0 then h6# = heights#(x-1,z-1) : inc count
h7# = heights#(x,z-1) : inc count
if x < tx then h8# = heights#(x+1,z-1) : inc count
endif
`count=count+5 : h1#=h1#+(5.0*heights#(x,z))
avg# = (h1#+h2#+h3#+h4#+h5#+h6#+h7#+h8#) / count
set matrix height 1,x,z,avg#
next x
next z
update matrix 1
for z = 0 to tz
for x = 0 to tx
heights#(x,z) = get matrix height(1,x,z)
next x
next z
RETURN
calc_normals2:
for z = 0 to tz
for x = 0 to tx
aa# = rnd(360)
nx#=0.0 : ny#=(sin(aa#)+1.0)/2.0 : nz#=0.0
set matrix normal 1, x, z, nx#, ny#, nz#
next x
next z
RETURN
calc_normals:
for z = 1 to tz-1
for x = 1 to tx-1
rem upper right
set vector3 1,x*tsx#,get matrix height(1,x,z+1),(z+1)*tsz#
set vector3 2,(x+1)*tsx#,get matrix height(1,x+1,z),z*tsz#
cross product vector3 N1,1,2
normalize vector3 N1, 1
rem upper left
set vector3 1,x*tsx#,get matrix height(1,x,z+1),(z+1)*tsz#
set vector3 2,(x-1)*tsx#,get matrix height(1,x-1,z),z*tsz#
cross product vector3 N2,1,2
normalize vector3 N2, 1
rem lower left
set vector3 1,x*tsx#,get matrix height(1,x,z-1),(z-1)*tsz#
set vector3 2,(x-1)*tsx#,get matrix height(1,x-1,z),z*tsz#
cross product vector3 N3,1,2
normalize vector3 N3, 1
rem lower right
set vector3 1,x*tsx#,get matrix height(1,x,z-1),(z-1)*tsz#
set vector3 2,(x+1)*tsx#,get matrix height(1,x+1,z),z*tsz#
cross product vector3 N4,1,2
normalize vector3 N4, 1
rem average 4 normals
add vector3 N1,N1,N2
add vector3 N1,N1,N3
add vector3 N1,N1,N4
divide vector3 N1,4
normalize vector3 N1, N1
nx# = x vector3(N1)
ny# = y vector3(N1)
nz# = z vector3(N1)
set matrix normal 1, x, z, nx#, ny#, nz#
next x
next z
update matrix 1
RETURN
camera_stuff:
oldcx#=cx#
oldcz#=cz#
speed# = 5
if upkey()=1
cx#=newxvalue(cx#,a#,speed#)
cz#=newzvalue(cz#,a#,speed#)
endif
if downkey()=1
cx#=newxvalue(cx#,a#,-speed#)
cz#=newzvalue(cz#,a#,-speed#)
endif
if leftkey()=1
cx#=newxvalue(cx#,wrapvalue(a#-90.0),speed#)
cz#=newzvalue(cz#,wrapvalue(a#-90.0),speed#)
endif
if rightkey()=1
cx#=newxvalue(cx#,wrapvalue(a#+90.0),speed#)
cz#=newzvalue(cz#,wrapvalue(a#+90.0),speed#)
endif
if shiftkey() then inc cy#, 2
if controlkey() then dec cy#, 2
a#=wrapvalue(a#+(mousemovex()/3.0))
cxa#=cxa#+(mousemovey()/3.0)
if cxa#<-90.0 then cxa#=-90.0
if cxa#>90.0 then cxa#=90.0
cy# = get ground height(1,cx#,cz#)
position camera cx#,cy#+100,cz#
rotate camera wrapvalue(cxa#),a#,0
RETURN
function point_line(px#,py#, x1#,y1#,x2#,y2#)
dp# = (x2# - x1#) * (py# - y1#) - (px# - x1#) * (y2# - y1#)
endfunction dp#
function moveClouds()
for t = cStart to cStart+cCount
hh# = (object position y(t) - 4000) / 100
if hh# < 2 then hh# = 0.04
hh# = (1.04 - hh#)
position object t, object position x(t),object position y(t),object position z(t)-hh#
if object position z(t) < -8000 then position object t, rnd(18000)-7000,rnd(100)+4000,11000+rnd(1000)
next t
endfunction
function grass()
cls
ink rgb(30,150,0),0
box 0,0,128,128
for t = 1 to 1000
x = rnd(128)
y = rnd(128)
g = rnd(200)+55
r = rnd(50)+65
if r > g then r = g
ink rgb(r,g,rnd(50)),0
box x,y,x+4,y+4
next t
blur bitmap 0,4
endfunction
function cloud()
cls
ink rgb(255,255,200),0
for x=1 to 1000
ang=rnd(360)
rad=rnd(20)
box 25+sin(ang)*rad,25+cos(ang)*rad,rnd(3)+25+sin(ang)*rad,rnd(3)+25+cos(ang)*rad
next x
blur bitmap 0,4
endfunction
REM ====== FERN FRACTAL =======
REM X,Y - starting position for fern, root of first stem
REM passes - number of iterations
REM startAngle - angle to start drawing on this pass
REM bendAngle - overall bending angle of the whole leaf
REM branchAngle - angle to branch off each stem at
REM height - starting height
function fern(x as float, y as float, passes as integer, startAngle as float, bendAngle as float, branchAngle as float, height as float)
rootAngle# = wrapvalue(startAngle - bendAngle)
x2 = x + cos(rootAngle#)*height
y2 = y - sin(rootAngle#)*height
line x,y,x2,y2
height = height*0.5
x3 = x + cos(wrapvalue(rootAngle#+branchAngle))*height
y3 = y - sin(wrapvalue(rootAngle#+branchAngle))*height
line x,y,x3,y3
x4 = x + cos(wrapvalue(rootAngle#-branchAngle))*height
y4 = y - sin(wrapvalue(rootAngle#-branchAngle))*height
line x,y,x4,y4
if passes > 1
fern(x2,y2,passes-1, rootAngle#, bendAngle, branchAngle, height)
fern(x3,y3,passes-1, wrapvalue(rootAngle#+branchAngle), bendAngle, branchAngle, height)
fern(x4,y4,passes-1, wrapvalue(rootAngle#-branchAngle), bendAngle, branchAngle, height)
endif
endfunction
function repopulateFerns()
for t = fStart to fStart+fCount step 3
x = rnd(4000)
z = rnd(4000)
position object t, x, get ground height(1,x,z), z
position object t+1, x, get ground height(1,x,z), z
position object t+2, x, get ground height(1,x,z), z
x = wrapvalue(rnd(90)-45)
y = rnd(360)
z = wrapvalue(rnd(90)-45)
rotate object t,x,y,z
rotate object t+1,x,y,z
rotate object t+2,x,y,z
next t
endfunction