TheGameCreators - CodeBase

Return to the CodeBase listing

Category: Games

Version: 1.0

Information

Uploaded: 22nd Dec 2003 08:48

Modified: 1st Jan 1970 01:00

Author: Megaton Cat

Summary

A simple hover craft engine (not made by me)

Full Description

DarkBASIC Professional Source Code

` This code was downloaded from The Game Creators

` It is reproduced here with full permission

` http://www.thegamecreators.com

REM ************************************************************************************

REM YOU WILL NEED A SOME TEXTURES (BMPS) THEY ARE

REM Grass08,Sky,stone01,red,blue,green(make them

REM yourself or you can use the ones that come with db classic

REM ************************************************************************************

set cursor 10,200:print "1 = 640,480,16"

set cursor 10,220:print "2 = 640,480,32"

set cursor 10,240:print "3 = 800,600,16"

set cursor 10,260:print "4 = 800,600,32"

input "Choose Display Mode:_";dis

if dis=1 then set display mode 640,480,16

if dis=2 then set display mode 640,480,32

if dis=3 then set display mode 800,600,16

if dis=4 then set display mode 800,600,32

sync on

sync rate 25

hide mouse

autocam off

fog on

fog distance 2000

fog color 0

fog off

set camera range 1,100000

set mipmap mode 2

REM ARRAYS

sync

input "Enter amount of Enemies 2(low-spec)-1000(Top-Spec):_";maxen

backdrop on:color backdrop 0

dim maxen(1)

maxen(1)=maxen

dim score(maxen)

dim target(maxen):for t=1 to maxen:target(t)=1501:next t

dim matrix#(30,30,2)

dim xspeed#(maxen)

dim zspeed#(maxen)

dim yspeed#(maxen)

dim friction#(maxen):for t=1 to maxen:friction#(t)=0.97:next t

dim life(1)

REM TEXTURES /BITMAPS /SPRITES

`load image "sky.bmp",1

ink rgb(0,0,200),0

box 0,0,200,200

ink rgb(255,255,255),0

for f=1 to 200

dot rnd(128),rnd(128)

next f

get image 1,0,0,128,128

ink rgb(0,200,0),0

box 0,0,200,200

ink rgb(0,0,0),0

for f=1 to 200

dot rnd(128),rnd(128)

next f

get image 2,0,0,128,128

ink rgb(128,128,128),0

box 0,0,200,200

ink rgb(255,255,255),0

for f=1 to 200

dot rnd(128),rnd(128)

next f

get image 4,0,0,128,128

`load image "grass08.bmp",2

`load image "stone01.bmp",4

` load image "red.bmp",5

` load image "blue.bmp",6

` load image "green.bmp",3

sync

REM MUSIC

REM LAND

rem sky

make object sphere 1042,90000

set object 1042,1,1,0,1,0,0,0

position object 1042,15000,0,15000

` ghost object on 1042

texture object 1042,1

set object collision off 1042

rem matrix

make matrix 1,30000,30000,30,30

prepare matrix texture 1,2,1,1

randomize matrix 1,400

matrix_hill(15,15,100)

matrix_hill(25,25,100)

matrix_hill_2(10,7,150)

matrix_hill_2(10,9,-120)

matrix_hill_3(20,13,-160)

matrix_hill_3(5,20,200)

matrix_hill_4(5,5,200)

matrix_hill(25,25,300)

matrix_hill(25,5,-130)

set matrix texture 1,0,1

update matrix 1

rem set matrix array for wave

for x=1 to 29

for z=1 to 29

matrix#(x,z,2)=get matrix height(1,x,z)

matrix#(x,z,1)=rnd(2)-1:randomize timer()

set matrix normal 1,x,z,0,get matrix height(1,x,z),0

next z

next x

update matrix 1

REM target objects

for t=1501 to 1508

make object box t,300,2000,300

position object t,newxvalue(15000,a#,12000),0,newzvalue(15000,a#,12000)

xs#=object size x(t)/2

zs#=object size z(t)/2

ys#=object size y(t)/2

make object collision box t,0-xs#,0-ys#,0-zs#,xs#,ys#,zs#,0

a#=wrapvalue(a#+45)

next t

REM PILLARS

a#=15

for pillar=1051 to 1062

make object box pillar,250,5000,250

texture object pillar,4

scale object texture pillar,1.5,25

set object texture pillar,0,1

position object pillar,newxvalue(15000,a#,10000),0,newzvalue(15000,a#,10000):a#=wrapvalue(a#+30)

next pillar

REM collision boxes for objects

for t=1050 to 1200

if object exist(t)=1

xs#=object size x(t)/2

ys#=object size y(t)/2

zs#=object size z(t)/2

make object collision box t,0-xs#,0-ys#,0-zs#,xs#,ys#,zs#,0

endif

next t

REM PLAYERS && ** (( )) !! "" Â£Â£ $$ %% ^^

REM PLAYER

make object sphere 1,50:position object 1,100,0,100:color object 1,rgb(0,255,0)

REM ENEMIES

tex=6

for t=2 to maxen

make object sphere t,50

`texture object t,tex

if tex = 5

color object T,rgb(0,0,255)

else

color object T,rgb(255,0,0)

endif

inc tex

if tex=7 then tex=5

set object texture T,0,1

position object t,rnd(30000),25,rnd(30000)

randomize timer()

next t

REM COLLISION BOXES

for t=1 to maxen

if object exist(t)=1

xs#=object size x(t)/2

ys#=object size x(t)/2

zs#=object size x(t)/2

make object collision box t,0-xs#,0-ys#,0-zs#,xs#,ys#,zs#,0

endif

next t

REM START

start:

repeat:until scancode()=0

for t=1 to maxen

position object t,15000,get ground height(1,15000,15000),15000

x#=15000

z#=15000

if object collision(t,0) => 1

x#=x#-get object collision x()

z#=z#-get object collision x()

endif

target(t)=1501

Score(t)=0

y#=get ground height(1,x#,z#)+500

position object t,x#,y#,z#

next t

sync

ink rgb(500,500,500),0

choice=0

repeat

center text screen width()/2,screen height()/2+30,"Press Enter To Race or Space to Play 'Chase'"

if returnkey()=1 then choice=2

if spacekey()=1 then choice=1:for t=1 to maxen:target(t)=1:next t:for t=1501 to 1508:hide object t:next t

sync

until choice => 1

player=1

repeat:until scancode()=0

life(1)=100

REM ********************* MAIN LOOP **********************************

if spacekey()=1 and keystate(17)=1 then center text screen width()/2,screen height()/2,"GOD MODE ON":life(1)=-1000

if keystate(19)=1 then life(1)=0:repeat:until scancode()=0

if life(1) =< 0 and life(1) => -100 then cls rgb(500,0,0):goto start

ink rgb(0,0,0),0

box 0,0,life(1)*4,20

ink rgb(150,0,0),0

box 4,4,(life(1)*4)-4,16

rem pause

if returnkey()=1

repeat:until returnkey()=0

pause=1

endif

if pause=1

repeat

if controlkey()=1 then repeat:until controlkey()=0:inc player:chase_camera(player):if player=41 then player=1

if choice=2 then for t= 1501 to 1508:ghost object on t:hide object t:scale object t,100,100,100:next t:show object target(player):scale object target(player),100,1000,100

if shiftkey()=1 then player=1:repeat:until shiftkey()=0:chase_camera(player)

if upkey()=1 then move camera 30

if downkey()=1 then move camera -30

rotate camera wrapvalue(camera angle x()+mousemovey()),wrapvalue(camera angle y()+mousemovex()),0

x#=camera position x()

z#=camera position z()

y#=camera position y()

if y# =< get ground height(1,x#,z#)+10 then y#=get ground height(1,x#,z#)+10

position camera x#,y#,z#

inc s

if s=2 then sync:s=0

until returnkey()=1

repeat:until returnkey()=0

pause=0

player=1

endif

rem turn sky

yrotate object 1042,1:fix object pivot 1042

rem playerkeys

if upkey()=1 then forward=1 else forward=0

if downkey()=1 then back=1 else back=0

if leftkey()=1 then left=1 else left=0

if rightkey()=1 then right=1 else right=0

move_player(1,forward,back,left,right)

for t=2 to maxen

if shiftkey()=0

if choice=2 then turn_enemy(t,target(t))

if choice=1 then turn_enemy(t,1)

endif

if score(t) => 16

repeat

center text screen width()/2,screen height()/2,"You Lose"

chase_camera(t)

sync

until spacekey()=1

cls 0

goto start

endif

if shiftkey()=0 then move_player(t,1,0,0,0) else move_player(t,0,0,0,0)

next t

if score(1) => 16

repeat

ink rgb(0,0,150),0

center text screen width()/2,screen height()/2,"You WIN"

chase_camera(1)

sync

until spacekey()=1

cls 0

goto start

endif

if shiftkey()=1 then player=1

if controlkey()=1 then repeat:until controlkey()=0:inc player:if player=(maxen+1) then player=1

chase_camera(player)

if choice=2 then for t= 1501 to 1508:ghost object on t:hide object t:scale object t,100,100,100:next t:show object target(player):scale object target(player),100,1000,100

if spacekey()=1 then point camera newxvalue(object position x(player),object angle y(player),-800),0,newzvalue(object position z(player),object angle y(player),-800):move camera -50

if syncthisframe=2 then SYNC : syncthisframe=0 : if keystate(17)=1 then wave()

inc syncthisframe

LOOP

REM ******************** SUBROUTINES *********************************

REM ******************** FUNCTIONS ***********************************

REM ** ** TURN_ENEMY ** ** ** ** ** ** **

function turn_enemy(objid,destobjid)

yang#=object angle y(objid)

destx#=object position x(destobjid)

destz#=object position z(destobjid)

x#=object position x(objid)

y#=object position y(objid)

z#=object position z(objid)

point object objid,destx#,y#,destz#

destyang#=object angle y(objid)

yang#=curveangle(destyang#,yang#,15)

yrotate object objid,yang#

endfunction

REM ** ** CHASE_CAMERA ** ** ** ** ** **

Function chase_camera(object)

x#=object position x(object)

y#=object position y(object)

z#=object position z(object)

yang#=object angle y(object)

cx#=camera position x()

cy#=camera position y()

cz#=camera position z()

ncx#=newxvalue(x#,wrapvalue(yang#+180),150)

cy#=y#+100

ncz#=newzvalue(z#,wrapvalue(yang#+180),150)

cx#=curvevalue(ncx#,cx#,8)

cz#=curvevalue(ncz#,cz#,8)

position camera cx#,cy#,cz#

if cy# =< get ground height(1,cx#,cz#)+50 then cy#=get ground height(1,cx#,cz#)+100

position camera cx#,cy#,cz#

point camera x#,y#+50,z#

endfunction

REM ** ** MOVEPLAYERS ** ** ** ** ** **

Function move_player(objid,forward,back,left,right)

x#=object position x(objid)

y#=object position y(objid)

z#=object position z(objid)

yang#=object angle y(objid)

rem forwards

if forward=1

xspeed#(objid)=xspeed#(objid)+newxvalue(0,yang#,0.95)

zspeed#(objid)=zspeed#(objid)+newzvalue(0,yang#,0.95)

endif

rem backwards

if back=1

xspeed#(objid)=xspeed#(objid)+newxvalue(0,yang#,-0.95)

zspeed#(objid)=zspeed#(objid)+newzvalue(0,yang#,-0.95)

endif

rem makesurespeedisnottohigh

if objid=1

rem turnleft

if left=1

yrotate object objid,wrapvalue(yang#-4)

endif

rem turnright

if rightkey()=1

yrotate object objid,wrapvalue(yang#+4)

endif

rem slowdown and gravity

xspeed#(objid)=xspeed#(objid)*friction#(objid)

zspeed#(objid)=zspeed#(objid)*friction#(objid)

yspeed#(objid)=yspeed#(objid)+1

if y# =< get ground height(1,x#,z#)+25

rem slide down

left#=x#-30

right#=x#+30

front#=z#+30

back#=z#-30

leftheight#=get ground height(1,left#,z#)

rightheight#=get ground height(1,right#,z#)

frontheight#=get ground height(1,x#,front#)

backheight#=get ground height(1,x#,back#)

xspeed#(objid)=xspeed#(objid)+((leftheight#-rightheight#)/50)

zspeed#(objid)=zspeed#(objid)-((frontheight#-backheight#)/50)

endif

rem update position and rotation and collision

x#=x#+xspeed#(objid)

y#=y#-yspeed#(objid)

z#=z#+zspeed#(objid)

rem jumping

if y# < get ground height(1,x#,z#)

ySpeed#(objid)=ySpeed#(objid)+(y#-get ground height(1,x#,z#))

y#=get ground height(1,x#,z#)

endif

rem collision

if x# =< 25 then x#=30:xspeed#(objid)=0-xspeed#(objid)

if z# =< 25 then z#=30:zspeed#(objid)=0-zspeed#(objid)

if x# => 29975 then x#=29970:xspeed#(objid)=0-xspeed#(objid)

if z# => 29975 then z#=29970:zspeed#(objid)=0-zspeed#(objid)

position object objid,x#,y#,z#

if object collision(objid,0) => 1 and object collision(objid,0) <> 1050

rem collision with other players

colid=object collision(objid,0)

if colid =< 1500

for t=2 to maxen(1)

if colid=t

if objid=1

life(1)=life(1)-1

xspeed#(objid)=xspeed#(colid)

zspeed#(objid)=zspeed#(colid)

endif

next t

rem collision with level

x#=x#-get object collision x()

z#=z#-get object collision z()

if get object collision x() <> 0 then xspeed#(objid)=(0-xspeed#(objid))

if get object collision z() <> 0 then zspeed#(objid)=(0-zspeed#(objid))

yspeed#(objid)=(yspeed#(objid))+get object collision y()

endif

rem target colid

if colid=target(objid) then score(objid)=score(objid)+1:target(objid)=target(objid)+1:if target(objid) => 1508 then target(objid)=1501

endif

rem position and rotate objid with new position stuff

`         rotate object objid,wrapvalue(zspeed#(objid)*20),object angle y(objid),wrapvalue(xspeed#(objid)*20)

position object objid,x#,y#+5,z#

endfunction

REM MATRIX FUNCTIONS

REM  matrix_hill matrix_hillmatrix_hillmatrix_hillmatrix_hill

Function matrix_hill(x,z,height)

set matrix height 1,x,z,height

set matrix height 1,x+1,z,height

set matrix height 1,x,z+1,height*3

set matrix height 1,x+1,z+1,height*3

set matrix height 1,x,z-1,height*3

set matrix height 1,x+1,z-1,height*3

set matrix height 1,x-1,z,height

set matrix height 1,x-1,z+1,height

set matrix height 1,x+1,z,height

set matrix height 1,x+1,z+1,height

endfunction

rem

Function matrix_hill_2(x,z,height)

set matrix height 1,x,z,height*4

set matrix height 1,x+1,z,height

set matrix height 1,x-1,z,height

set matrix height 1,x,z+1,height

set matrix height 1,x,z-1,height

endfunction

rem

Function matrix_hill_3(x,z,height)

set matrix height 1,x,z,height*4

set matrix height 1,x+1,z,height*2

set matrix height 1,x-1,z,height*2

set matrix height 1,x,z+1,height*2

set matrix height 1,x,z-1,height*2

set matrix height 1,x+2,z,height*1

set matrix height 1,x-2,z,height*1

set matrix height 1,x,z+2,height*1

set matrix height 1,x,z-2,height*1

endfunction

rem

Function matrix_hill_4(x,z,height)

set matrix height 1,x,z,height

set matrix height 1,x+1,z,height*2

set matrix height 1,x-1,z,height*2

set matrix height 1,x,z+1,height*2

set matrix height 1,x,z-1,height*2

set matrix height 1,x+2,z,height*1

set matrix height 1,x-2,z,height*1

set matrix height 1,x,z+2,height*1

set matrix height 1,x,z-2,height*1

endfunction

REM ** WAVE **

function wave()

for x=1 to 29

for z=1 to 29

oldheight#=get matrix height(1,x,z)

if matrix#(x,z,1)=0 then newheight#=oldheight#+20

if matrix#(x,z,1)=1 then newheight#=oldheight#-20

if newheight# => matrix#(x,z,2)+300 then matrix#(x,z,1)=1

if newheight# < matrix#(x,z,2)-300 then matrix#(x,z,1)=0

set matrix height 1,x,z,newheight#

set matrix normal 1,x,z,0,get matrix height(1,x,z),0

next z

next x

update matrix 1

for t=51 to 76

if object exist(t)=1

x=object position x(t)

z=object position z(t)

y#=get ground height(1,x,z)+300

position object t,x,y#,z

endif

next t

endfunction

Download

Please login to download

Comments

No comments yet.

CodeBase - Hover engine

Information

Summary

Full Description

DarkBASIC Professional Source Code

Download

Screen Shot

Author

Comments

Author Name:	Megaton Cat
CodeBase Entries:	1