Sorry your browser is not supported!

_______TOP_______:
rem Generic Template
rem Player = object 10
rem Cubes = objects 100-101
_____INITIALIZE_____:
set display mode 1024,768,32
SYNC ON
SYNC RATE 60
backdrop on
color backdrop rgb(10,100,100)
set text opaque
autocam off
hide mouse
set global collision off
x#=1000.0:z#=1000.0:a#=0.0:s#=0.0:h#=0.0
cx#=0.0:cy#=0.0:cz#=0.0:ca#=0.0:camght=50
camrot=0:camdist=0:camlen=0:pdist#=0
collx#=0:collz#=0:objnum=100
gosub Setupland1
gosub makeplayer
gosub makeobjects
gosub makespheres
gosub ambient
gosub resetcam

_____DO_LOOP_____:
do
if x#<100 then x#=100
if z#<100 then z#=100
if x#>landsize-100 then x#=landsize-100
if z#>landsize-100 then z#=landsize-100
collx#=x#:collz#=z#
 if inkey$()="e" then sync rate 0
 if inkey$()="E" then sync rate 60
 gosub printdata
 gosub camera_control
 gosub Playercontrol
 gosub checkcoll
 gosub positionspheres
SYNC
loop

rem -------------ROUTINES--------------------
____SET_SCENERY___:

Setupland1:
rem ground textures
rem create  texture
cls rgb(0,100,20)
inkcolor#=rgb(255,255,255)
line 0,0,0,250
line 1,1,1,250
line 2,2,2,250
line 0,0,250,0
line 1,1,250,1
line 2,2,250,2
line 0,0,250,250
line 0,250,250,0
rem next n
get image 2,0,0,250,250
rem Make landscape
landsize=4000:grid=30:mtxrandomize=1
make matrix 1,landsize,landsize,grid,grid
set matrix 1,1,0,0,1,1,1,1
prepare matrix texture 1,2,1,1
randomize matrix 1,mtxrandomize
rem ***********
rem get ground done
update matrix 1
return

_____CONTROL_PLAYER___:

Playercontrol:
rem ---- Control Character ----
 x#=newxvalue(x#,a#,s#)
 z#=newzvalue(z#,a#,s#)
 h#=get ground height(1,x#,z#)
 position object 10,x#,h#+10,z#
 yrotate object 10,a#
 if upkey()=1 and s#<8 then s#=s#+0.1
 if downkey()=1 and s#>-8 then s#=s#-0.2
 if leftkey()=1 then a#=wrapvalue(a#-1)
 if rightkey()=1 then a#=wrapvalue(a#+1)
 if inkey$()="ù" then s#=0.0
 if inkey$()="à" then s#=10.0
return

______CAMERA_ROUTINES____:
rem -------CAMERA--------

camera_control:
mymousex=mousemovex()
if mymousex>0 then camrot=camrot+2
if mymousex<0 then camrot=camrot-2
mymousey=mousemovey()
if mymousey>0 then campointh=campointh+3
if mymousey<0 then campointh=campointh-3
mymousez=mousemovez()
if mymousez>0 then camdist=camdist+10
if mymousez<0 then camdist=camdist-10
rem camera update
position mouse 300,300
rem Position camera to the back of the character
ca#=wrapvalue(a#+camrot)
cx#=newxvalue(x#,ca#,camdist)
cz#=newzvalue(z#,ca#,camdist)
cy#=h#
position camera cx#,cy#+camhgt,cz#
rem Point camera at object
point camera x#,h#+camhgt+campointh,z#
return

 rem camera reset
Resetcam:
set camera range 1,20000
camdist=-150
camhgt=60
camrot=0
camlen=0
return

_____PRINT_ON__SCREEN___:

printdata:
set cursor 0,0
print "Polys=",statistic(1)
print "FPS=",screen fps()
print "player x#= ",x#
print "player h#= ",h#
print "player z#= ",z#
print "player angle a#= ",a#
print "speed s#= ",s#
print "intersect value collcheck1#=",collcheck1#
print "intersect value collcheck2#=",collcheck2#
return

printdata2:
set cursor 0,0
print statistic(1)
print screen fps()
return

_____CHECK_ROUTINES_____:

checkcoll:
rem general remark: collision will be checked in two angles forward or backwards
if inkey$()="r" then return
rem object 100=room - object 101=cube
for n=100 to 101
rem if moving forward
if s#>0
 a1#=wrapvalue(a#+30)
 a2#=wrapvalue(a#-30)
 to1x#=newxvalue(x#,a1#,40)
 to1z#=newzvalue(z#,a1#,40)
 to2x#=newxvalue(x#,a2#,40)
 to2z#=newzvalue(z#,a2#,40)
  collcheck1#=intersect object(n,x#,50,z#,to1x#,50,to1z#)
  collcheck2#=intersect object(n,x#,50,z#,to2x#,50,to2z#)
 if collcheck1#<16 and collcheck1#>0 then x#=collx#:z#=collz#:s#=0.0
 if collcheck2#<16 and collcheck2#>0 then x#=collx#:z#=collz#:s#=0.0
endif
rem if moving backwards
if s#<0
 a1#=wrapvalue(a#+160)
 a2#=wrapvalue(a#-160)
 to1x#=newxvalue(x#,a1#,40)
 to1z#=newzvalue(z#,a1#,40)
 to2x#=newxvalue(x#,a2#,40)
 to2z#=newzvalue(z#,a2#,40)
  collcheck1#=intersect object(n,x#,20,z#,to1x#,20,to1z#)
  collcheck2#=intersect object(n,x#,20,z#,to2x#,20,to2z#)
 if collcheck1#<16 and collcheck1#>0 then x#=collx#:z#=collz#:s#=0.0
 if collcheck2#<16 and collcheck2#>0 then x#=collx#:z#=collz#:s#=0.0
endif
next n
return

positionspheres:
position object 1000,to1x#,20,to1z#
position object 1001,to2x#,20,to2z#
return

____MAKE_OBJECTS____:
rem -------------Characters-Objects------------

makeplayer:
make object cube 10,20
return

makeobjects:
cls rgb(100,60,20)
inkcolor#=rgb(2,2,2)
line 0,0,0,250
line 1,1,1,250
line 2,2,2,250
line 0,0,250,0
line 1,1,250,1
line 2,2,250,2
line 0,0,250,250
line 0,250,250,0
get image 3,0,0,250,250
cubesize=800
make object cube 100,cubesize
texture object 100,3
set object 100,1,1,0,1,1,1
position object 100,1000,cubesize/2-5,1000
make object cube 101,100
position object 101,1100,50,800
return

makespheres:
make object sphere 1000,3
make object sphere 1001,3
color object 1000,rgb(160,30,30)
color object 1001,rgb(160,30,30)
return

rem ------------------ambient----------------
_______AMBIENT_______:

ambient:
set ambient light 70
set directional light 0,0.1,0.2,0.25
position light 0,0.0,2000.0,0.0
point light 0,4000,0,4000
fog on
fog color rgb(150,150,200)
fog distance 10000
return
end

Rem * Title  : Chafari Collision Concept
Rem Scorpyo - 2008
rem Setting by chafari April 21 -2008
top:
rem **********  MAIN 1  ****************

set display mode 1024,768,16
ink rgb(200,0,0),1
box 0,0,40,40
ink rgb(0,200,0),1
box 10,10,20,20
get image 51,0,0,40,40,1
hide mouse
sync on
sync rate 60
rem backdrop on
global x#,z#,h#,s#,a#
x#=10000.0:h#=0.0:z#=10000.0:turn=0
gosub Makematrix
gosub setambience
gosub Character
gosub makecube
gosub maketrackingobjects
set global collision off
gosub Resetcam
sync rate 60
soft=5

rem *****MAIN LOOP******
do
if inkey$()="r" then x#=10000.0:z#=10000.0:s#=0.0
if inkey$()="e" then sync rate 0
if inkey$()="E" then sync rate 40
x#=newxvalue(x#,a#,s#)
z#=newzvalue(z#,a#,s#)
gosub Playercontrol
gosub printdata
rem call to camera changes subroutine ( bottom key row )
gosub camera_controls
 rem terrain height check
 gosub heightcheck
 gosub checkcoll
 gosub putspheres
position object 9999,x#,h#,z#
yrotate object 9999,a#
rem calls camera update subroutine
gosub update_camera
rem Update screen
sync
rem End loop
loop

rem ****** CREATE LEVEL ******
Makematrix:
rem create  ground texture
cls rgb(0,100,20)
get image 2,0,0,250,250
rem Make landscape
landsize=23000:grid=30:mtxrandomize=1
make matrix 1,landsize,landsize,grid,grid
set matrix 1,1,0,0,1,1,1,1
prepare matrix texture 1,2,1,1
randomize matrix 1,mtxrandomize
rem ***********
rem get ground done
update matrix 1
return

setambience:
rem Create fog and ambience
set ambient light 2
if fog available()=1
rem fog on
fog distance 100000
fog color rgb(150,150,255)
endif
return

rem make object
makecube:
make object box 1000,800,500,800
 set object 1000,1,1,0,1,1,1,1
yrotate object 1000,45
position object 1000,10000,-200,10700
 rem color object 1000,rgb(255,10,10)
make object box 1001,800,500,800
make mesh from object 1,1001:delete object 1001
add limb 1000,1,1:rotate limb 1000,1,0,40,0:offset limb 1000,1,800,0,800



texture object 1000,51:scale object texture 1000,35,35
return

printdata:
set cursor 0,0
rem set text opaque
rem debug check
print "Fps=",screen fps()
print "polygons=",statistic(1)
print "------player data-------"
print "x#= ",x#
print "z#= ",z#
print "player ground height h#= ",h#
print "camera ground height h2#= ",h#
print "angle#= ",a#
print "speed#= ",s#
print "---------------------------"
print "---------------------------"
print "press r to reset position"
print "W & S = walk"
print "mousemove x = turn"
print "mouse wheel = change camera distance from player"
print "R mouse + mouse move y = change camera height"
print "z and x rotate camera around the player"
return

Playercontrol:
rem ****Character walk ****
rem control walking with w and s keys
 if inkey$()="w"  then s#=3
 if inkey$()="s"  then s#=-3
if scancode()=0 then s#=0
 rem control turning with mousemove along x axis
 turn=mousemovex()
 if turn<0 then a#=wrapvalue(a#-3)
 if turn>0 then a#=wrapvalue(a#+3)
rem stop if "à" is pressed
 if inkey$()="à" then s#=0.0
rem slow if "l"
 if inkey$()="l" then s#=0.2
return

rem ****BUILD PLAYER****
rem object 9999
Character:
rem make cone
 make object cone 9999,30
 rem stretch cone
 scale object 9999,100,300,100
 rem tilt cone
 xrotate object 9999,90
 rem fix tilting angle
 fix object pivot 9999
 rem set object solid (no culling)
 set object 9999,1,1,0
return

rem ********CAMERA ROUTINES***********
camera_controls:
rem reset intial camera pressing <
if inkey$()="<" then gosub Resetcam
rem camera views from high (m and M)
if inkey$()="m" then camdist=-1000:camhgt=500:set camera range 100,40000
if inkey$()="M" then camdist=-3000:camhgt=1000:set camera range 100,40000
rem look around (Right Mouse click + mouse move)
if inkey$()="z" then camrot=camrot+3
if inkey$()="x" then camrot=camrot-3
rem camera distance from character
if mouseclick()=2
mymousey=mousemovey()
if mymousey>0 then camhgt=camhgt+3
if mymousey<0 then camhgt=camhgt-3
endif
rem raise - lower camera (mousewheel)
mymousez=mousemovez()
if mymousez>0 then camdist=camdist+5
if mymousez<0 then camdist=camdist-5
rem don't go below ground
if camhgt<0 then camhgt=0
return

rem camera update
update_camera:
rem Position camera to the back of the character
ca#=wrapvalue(a#+camrot)
cx#=newxvalue(x#,ca#,camdist)
cz#=newzvalue(z#,ca#,camdist)
if h2#>h#
cy#=h2#
else
cy#=h#
endif
position camera cx#,cy#+camhgt,cz#
rem Point camera at walker position
point camera x#,cy#+camlen,z#
return

rem reset camera
Resetcam:
set camera range 10,40000
camdist=-260
camhgt=80
camrot=0
camlen=0

rem ---  check ground  -----
heightcheck:
rem check the height at player position (X & Z)
h#=get ground height(1,x#,z#)
rem check the height at camera position
h2#=get ground height(1,cx#,cz#)
return

rem *********COLLISION**********

checkcoll:
collx#=INTERSECT OBJECT(1000,x#,h#+5,z#,x#+20,h#+5,z#)
if collx#>0 then x#=x#-(20-collx#)/soft
collz#=INTERSECT OBJECT(1000,x#,h#+5,z#,x#,h#+5,z#+20)
if collz#>0 then z#=z#-(20-collz#)/soft
collx2#=INTERSECT OBJECT(1000,x#,h#+5,z#,x#-20,h#+5,z#)
if collx2#>0 then x#=x#+(20-collx2#)/soft
collz2#=INTERSECT OBJECT(1000,x#,h#+5,z#,x#,h#+5,z#-20)
if collz2#>0 then z#=z#+(20-collz2#)/soft
return

putspheres:
position object 11,x#+20,h#+5,z#
position object 12,x#,h#+5,z#+20
position object 13,x#-20,h#+5,z#
position object 14,x#,h#+5,z#-20
position object 15,x#,h#+5,z#
return

maketrackingobjects:
for n=11 to 14
make object sphere n,3
next n
make object cylinder 15,2
scale object 15,100,700,100
return

end