Updated version. You now don't slide down shallow hills.
Sliding collision also on objects. They can even push you around!
Also stuck in a very basic rotating sky sphere.
remstart
mouse to look around
up and down cursors = forward and back
left and right cursors = strafe
remend
sync on : randomize timer() : autocam off : hide mouse : set global collision on
rem *** bitmap variables ***
rem below will create 4*4=16 random tile textures at 64*64 pixels
rem this is same as loading an image of 256*256 pixels cut up into 16 tiles
f$="" : rem filename of tiled textures (leave blank to create random one)
w=4 : rem number of tiles across
h=4 : rem number of tiles down
r=64 : rem texture resolution (32,64,128,256) (ignored if you specify f$)
rem *** matrix variables ***
mw=1000 : rem units wide
mh=1000 : rem units high
mx=32 : rem number of tiles wide
mz=32 : rem number of tiles high
rem *** player variables ***
cx#=100 : rem start x position
cz#=100 : rem start z position
cya#=0 : rem start y angle
cxa#=0 : rem start x angle
ch=20 : rem height above ground of player's eyes
rem *** collision variables ***
s#=0.5 : rem step size
r#=10 : rem player radius
frc#=100 : rem force (bigger number means bigger slopes can be climbed)
slide#=10 : rem how steep before autoslide
objcol#=30: rem object collision sensitivity
rem *** player camera variables ***
mangu#=50 : rem maximum angle you can look up
mangd#=80 : rem maximum angle you can look down
midx#=3 : rem smoothness of mouse camera (higher=smoother)
rem *** diagnostic variables ***
diag=0 : rem 0=normal, 1=show diag objects
gosub setupbitmap
gosub setupmatrix
gosub setupwater
gosub setupobjects
gosub setupsky
h#=get ground height(1,cx#,cz#) : position camera cx#,h#+ch,cz#
do
x# = camera position x()
y# = camera position y()
z# = camera position z()
if upkey()
x#=newxvalue(x#,cya#,s#)
z#=newzvalue(z#,cya#,s#)
endif
if downkey()
x#=newxvalue(x#,cya#,-s#)
z#=newzvalue(z#,cya#,-s#)
endif
if rightkey()
x#=newxvalue(x#,wrapvalue(cya#+90.0),s#)
z#=newzvalue(z#,wrapvalue(cya#+90.0),s#)
endif
if leftkey()
x#=newxvalue(x#,wrapvalue(cya#-90.0),s#)
z#=newzvalue(z#,wrapvalue(cya#-90.0),s#)
endif
fx#=0 : fz#=0
hlow#=99999 : hhigh#=-99999
for r=0 to 35
ex#=newxvalue(x#,r*10.0,r#)
ez#=newzvalue(z#,r*10.0,r#)
eh#=get ground height(1,ex#,ez#)
position object (r+100),ex#,eh#,ez#
if object collision (r+100,0) > 0 then eh#=objcol#
if eh# < 0 then eh#=(-eh#*2)
if eh# > hhigh# then hhigh#=eh#
if eh# < hlow# then hlow#=eh#
force#=eh#/frc#
fx#=fx#+((ex#-x#)*force#) : fz#=fz#+((ez#-z#)*force#)
next r
nx#=x#-(fx#/35.0) : nz#=z#-(fz#/35.0)
if abs(hhigh#-hlow#) >= slide# then x#=nx# : z#=nz#
h#=get ground height(1,x#,z#)
position camera x#,h#+ch,z#
cya#=wrapvalue(cya#+(mousemovex()/midx#))
cxa#=cxa#+(mousemovey()/midx#)
if cxa# < -mangu# then cxa#=-mangu#
if cxa# > mangd# then cxa#=mangd#
rotate camera wrapvalue(cxa#),cya#,0
water#=wrapvalue(water#+0.5)
position object 1,object position x(1),-10+(2*sin(water#)),object position z(1)
yrotate object 13,wrapvalue(object angle y(13)+0.2)
yrotate object 10,wrapvalue(object angle y(10)-0.1)
yrotate object 12,wrapvalue(object angle y(12)-0.1)
position object 500,camera position x(),camera position y()-50,camera position z()
yrotate object 500,object angle y(500)+0.01
position object 14,newxvalue(object position x(10), object angle y(10),50),-10,newzvalue(object position z(10), object angle y(10),50)
yrotate object 14,object angle y(10)
position object 15,newxvalue(object position x(10), object angle y(10),80),-10,newzvalue(object position z(10), object angle y(10),80)
yrotate object 15,object angle y(10)
sync
loop
end
rem ********************
setupbitmap:
if f$=""
create bitmap 1,w*r,h*r
b=0
for f=1 to h
for g=1 to w
ink rgb(b,b,b),rgb(0,0,0) : box (g-1)*r,(f-1)*r,g*r,f*r : b=rnd(255)
next g
next f
for f=1 to (w*h*10)
a1=rnd(w*r) : b1=rnd(h*r) : c1=rnd(20)+2 : d1=rnd(20)+2
ink rgb(rnd(255),rnd(255),rnd(255)),rgb(0,0,0)
box a1,b1,a1+c1,b1+d1
next f
get image 1,0,0,w*r,h*r,1 : delete bitmap 1
else
load image f$,1,1
endif
return
rem ********************
setupmatrix:
make matrix 1,mw,mh,mx,mz : set matrix 1,0,0,1,1,1,1,1
prepare matrix texture 1,1,w,h : fill matrix 1,0,1
for f=1 to (mx-2)
for g=1 to (mz-2)
set matrix tile 1,f,g,rnd((w*h)-1)+1
next g
next f
for f=0 to mx
set matrix height 1,f,0,150+rnd(20)
set matrix height 1,f,mz,150+rnd(20)
next f
for f=0 to mz
set matrix height 1,0,f,150+rnd(20)
set matrix height 1,mx,f,150+rnd(20)
next f
for f=1 to (mx*mz/5)
set matrix height 1,(10+rnd(mx-20)),(10+rnd(mz-20)),rnd(40)
next f
for f=0 to mz-10
set matrix height 1,1,f+5,f*2 : set matrix height 1,2,f+5,f*2
next f
for f=1 to 5
for g=1 to 5
set matrix height 1,f+7,g+2,-50
next g
next f
update matrix 1
return
rem ********************
setupwater:
make object plain 1,mw,mh
rotate object 1,90,0,0
color object 1,rgb(0,0,255)
position object 1,mw/2,0,mh/2
ghost object on 1
water#=0
return
rem ********************
setupobjects:
rem *** required objects (start) ***
for f=0 to 35
make object sphere (f+100),0.3,5,5
if diag=0 then hide object (f+100)
next f
rem *** required objects (end) ***
create bitmap 1,128,128
set text size 6
ink rgb(0,0,200),rgb(0,0,0)
box 0,0,128,128
ink rgb(255,255,255),rgb(0,0,0)
text 0,0,"You can walk"
text 0,20,"through this!"
get image 2,0,0,128,128,1 : delete bitmap 1
make object cube 10,50
color object 10,rgb(255,0,0)
position object 10,150,-10,200
make object cube 11,40
color object 11,rgb(0,255,0)
position object 11,80,20,300
make object box 12,100,100,5
position object 12,180,20,300
set object collision off 12
texture object 12,2
make object sphere 13,200
texture object 13,1
position object 13,220,0,500
make object box 14,10,50,50
color object 14,rgb(255,0,0)
make object box 15,40,50,10
color object 15,rgb(255,0,0)
return
rem ********************
setupsky:
make object sphere 500,-3000,20,20 : texture object 500,1
set object light 500,0
color object 500,rgb(0,0,255) : ghost object on 500
set object collision off 500
return
Gronda, Gronda
