TheGameCreators - CodeBase

Return to the CodeBase listing

Category: Complete Applications

Version: 1.0

Information

Uploaded: 17th Feb 2009 04:07

Modified: 1st Jan 1970 01:00

Author: Anonymous Coder

Summary

application game 3d labirynt

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 Project: laby001

Rem Created: Thursday, January 08, 2009

Rem ***** Main Source File *****

rem by vitaluciano@hotmail.fr

Rem ***** Main Source File *****

`set display mode 800,600,16

sync on

sync rate 0

//hide mouse

backcolor=rgb(0,0,0)

backdrop on

color backdrop backcolor

cls

randomize timer()

// global size=16

// global comsize=0

// global dim tmap$(size,size)

// global dim laby(size)

// dim wlaby(4)

` Attention ... This value is the size of the map ! change it to fit your map file

// mapsize=size

//mapsize=32

// dim map$(mapsize,mapsize)

global comiter=0

maxcubes=24

cubesize=20

collisionstep=int(cubesize/10)

fog on

fog color backcolor

fog distance (int(maxcubes)*cubesize)

set camera range 1,(maxcubes*cubesize)

` Current map

//loadmap("media/dungeon.map",mapsize)

// gosub setuproom

autocam off

load image "media/mur.bmp",1

load image "media/grass1.bmp",2

load image "media/ciel.bmp",3

load image "media/rainb.bmp",4

load image "media/grass11.bmp",5

load image "media/stat.bmp",6

` Wall â€¦ you can change the walls to other objects J

for i=1 to maxcubes*maxcubes

make object cube 100+i,cubesize

`   make object sphere 100+i,cubesize

`   make object box 100+i,cubesize,cubesize*2,cubesize

`   make object cone 100+i,cubesize

`   make object cylinder 100+i,cubesize+((cubesize/100)*10)

texture object 100+i,1

next i

objsph=30000

make object sphere objsph,cubesize

//color object objsph,rgb(rnd(255),rnd(255),rnd(255))

texture object objsph,4

make object sphere objsph+1,cubesize/16

` floor

for i=1 to maxcubes*maxcubes

make object plain 10000+i,cubesize,cubesize

rotate object 10000+i,90,0,0

texture object 10000+i,2

next i

` ceiling

for i=1 to maxcubes*maxcubes

make object plain 20000+i,cubesize,cubesize

rotate object 20000+i,270,0,0

texture object 20000+i,3

next i

set ambient light 30

make light 1

make light 2

set point light 1,0,0,0

set spot light 2,45,90

color light 2,RGB(252,216,141)

color light 1,RGB(236,182,100)

color light 0,RGB(0,0,0)

// ` Search startpoint

// for z=1 to mapsize

// for x=1 to mapsize

//     if map$(x,z)="22"

//        cx=x*cubesize

//        cz=z*cubesize

//     endif

//     if map$(x,z)="U"

//        ex=x

//        ez=z

//     endif

// next x

// next zd

// position camera cx,0,cz

// oldpositionx#=camera position x()

// oldpositionz#=camera position z()

// randomize timer()

// cls

// flg=0

if flg=0

sync

gosub startgame

flg=1

endif

rem ========

while flg<>0

gosub mapdisplay

if mouseclick()=1 then move camera maxcubes

if mouseclick()=2 then move camera maxcubes*(-1)

ry#=wrapvalue(ry#+mousemovex())

rotate camera rx#,ry#,0

cx#=int(camera position x()/cubesize)-int(maxcubes/2)

cz#=int(camera position z()/cubesize)-int(maxcubes/2)

tx#=camera position x()

tz#=camera position z()

position object objsph+1,camera position x(0),camera position y(0),camera position z(0),

zzz=0

for zz=1 to maxcubes

for xx=1 to maxcubes

zzz=zzz+1

curposx=int(cx#)+xx

curposz=int(cz#)+zz

if curposx<=1 then curposx=1

if curposx>=mapsize then curposx=mapsize

if curposz<=1 then curposz=1

if curposz>=mapsize then curposz=mapsize

` wall

if map$(int(curposx),int(curposz))="11" or map$(int(curposx),int(curposz))="S"

show object 100+zzz

position object 100+zzz,curposx*cubesize,0.0,curposz*cubesize

` Collisiondetection

if map$(int(curposx),int(curposz))="11"

if tx#>=((curposx*cubesize)-(cubesize/2))-collisionstep and tx#<=((curposx*cubesize)+(cubesize/2))+collisionstep and tz#>=((curposz*cubesize)-(cubesize/2))-collisionstep and tz#<=((curposz*cubesize)+(cubesize/2))+collisionstep

position camera oldpositionx#,camera position y(),oldpositionz#

oldpositionx#=camera position x()

oldpositionz#=camera position z()

endif

else

hide object 100+zzz

endif

` floor

if map$(int(curposx),int(curposz))="88" or map$(int(curposx),int(curposz))="33" or map$(int(curposx),int(curposz))="34" or map$(int(curposx),int(curposz))="99" or map$(int(curposx),int(curposz))="22"

show object 10000+zzz

position object 10000+zzz,curposx*cubesize,(cubesize/2)*(-1),curposz*cubesize

texture object 10000+zzz,2

if comiter=1 and (map$(int(curposx),int(curposz))="33" or map$(int(curposx),int(curposz))="34")

texture object 10000+zzz,5

endif

if map$(int(curposx),int(curposz))="22"

texture object 10000+zzz,6

endif

else

hide object 10000+zzz

endif

` ceiling

if map$(int(curposx),int(curposz))="88" or map$(int(curposx),int(curposz))="33" or map$(int(curposx),int(curposz))="34" or map$(int(curposx),int(curposz))="99" or map$(int(curposx),int(curposz))="22"

show object 20000+zzz

position object 20000+zzz,curposx*cubesize,(cubesize/2),curposz*cubesize

//    if map$(int(curposx),int(curposz))="22"

// texture object 20000+zzz,6

//   endif

else

hide object 20000+zzz

endif

//sphere

if map$(int(curposx),int(curposz))="99"

show object objsph

position object objsph,curposx*cubesize,0.0,curposz*cubesize

//color object objsph,rgb(rnd(255),rnd(255),rnd(255))

turn object left objsph,cos(aa#)*5

inc aa#,1

//     else

//        hide object objsph

endif

next xx#

next yy#

oldpositionx#=camera position x()

oldpositionz#=camera position z()

position light 1,camera position x(),camera position y(),camera position z()

position light 2,camera position x(),camera position y(),camera position z()

color light 1,RGB(200+int(rnd(50)-25),120,60)

rotate light 2,camera angle x(),camera angle y(),camera angle z()

control camera using arrowkeys 0,1,2

//sync

if object collision(objsph+1,objsph)=1

text 10,20,"collision"

hide object objsph

inc comsize,1

flg=0

endif

if controlkey()=1

flg=0

text 10,10,"escape "  rem +str$(scancode())

endif

rem

comiter=0

if spacekey()=1

inc ww,1

comiter= ww mod 2

endif

rem

sync

endwhile

sync

loop

end

setuproom:

for k=1 to mapsize

for j=1 to mapsize

map$(k,j)=tmap$(k,j)

next j

next k

return

rem ===============routin

Rem Project: maplabyrynt

Rem Created: Thursday, January 08, 2009

Rem ***** Main Source File *****

rem =================map definition

rem ==================num 22 start vide

rem ==================num 33 percours vide

rem ===================num 34 percours vide

rem ====================num 99 fine

rem ===================num 11 mur

rem ===================num 88 sol

// randomize timer()

// size=16

// dim tmap$(size,size)

// dim laby(16)

// dim wlaby(4)

// rem routine labyrint

// gosub rlaby

//gosub mapdisplay

// wait key

// end

rem ==================================================

mapdisplay:

//  for x=1 to size

//  text 10,10*x, tmap$(x,1)+" "+tmap$(x,2)+" "+tmap$(x,3)+" "+tmap$(x,4)+" "+tmap$(x,5)+" "+tmap$(x,6)+" "+tmap$(x,7)+" "+tmap$(x,8)+" "+tmap$(x,9)+" "+tmap$(x,10)+" "+tmap$(x,11)+" "+tmap$(x,12)+" "+tmap$(x,13)+" "+tmap$(x,14)+" "+tmap$(x,15)+" "+tmap$(x,16)+" "

//  next x

//   text 10,200,str$(asize)+" "+str$(csize)+" "+str$(bsize)

//  wait key

//text 10,10,"size "+str$(size)

return

rem ==========================================

rem ==============laby======================

r003:

if laby(x)<laby(x+1)

a=laby(x)+1

b=laby(x+1)

endif

if laby(x)>laby(x+1)

a=laby(x+1)

b=laby(x)-1

endif

for k=a to b

tmap$(x,k)="34"

next k

return

rem

r010:

for rowp=2 to size-1

tmap$(x,rowp)="88"

next rowp

return

rem ===================================

r011:

flg=0

asize=0

bsize=0

csize=0

for k=2 to size-1

if tmap$(x,k)="22" or tmap$(x,k)="33" or tmap$(x,k)="34" or tmap$(x,k)="99"

flg=1

inc csize,1

else

if flg=0

inc asize,1

else

inc bsize,1

endif

next k

text 10,210,str$(asize)

if asize=0 and bsize=0 then goto l001

if asize<>0

for k=1 to asize

anum=rnd(asize) mod 2

if anum=0 then tmap$(x,k+1)="11"

if anum<>0 then tmap$(x,k+1)="88"

next k

endif

if bsize<>0

for k=1 to bsize

anum=rnd(asize+csize) mod 3

if anum=0 then tmap$(x,k+asize+csize+1)="88"

if anum<>0 then tmap$(x,k+asize+csize+1)="11"

next k

endif

l001:

return

rem ==========================================

startgame:

gosub initgame

global size as integer =0

if comsize=0 then size=16

if comsize=1 then size=32

if comsize=2 then size=64

if comsize=3 then size=128

if comsize>3 then size=16

// if comsize=4

// text 10,20,"game over!"

// wait key

// exit

// endif

//gosub mapdisplay

global dim laby(size)

global dim tmap$(size,size)

gosub rlaby32

mapsize=size

//mapsize=32

dim map$(mapsize,mapsize)

gosub setuproom

` Search startpoint

for z=1 to mapsize

for x=1 to mapsize

if map$(x,z)="22"

cx=x*cubesize

cz=z*cubesize

endif

if map$(x,z)="U"

ex=x

ez=z

endif

next x

next zd

position camera cx,0,cz

oldpositionx#=camera position x()

oldpositionz#=camera position z()

randomize timer()

cls

flg=0

return

rem

rem ============size 32*32============================

rem

rlaby32:

for k=1 to size

flg=0

while flg=0

a=rnd(size)

if a>1 and a<size

laby(k)=a

flg=1

endif

endwhile

next k

for x=1 to size

if x=1

gosub r3201

else

if x=2

gosub r3202

else if x=size-1

gosub r3203

else if x=size

gosub r3201

else

gosub r3204

endif

next x

return

rem  ================================

r3201:

for r01=1 to size

tmap$(x,r01)="11"

next r01

return

r3202:

tmap$(x,1)="11"

tmap$(x,size)="11"

gosub r010

tmap$(x,laby(x))="22"

gosub r003

gosub r011

return

r3203:

tmap$(x,1)="11"

tmap$(x,size)="11"

gosub r010

tmap$(x,laby(x))="99"

gosub r011

return

r3204:

tmap$(x,1)="11"

tmap$(x,size)="11"

gosub r010

tmap$(x,laby(x))="33"

gosub r003

gosub r011

return

rem ========================================

rem inizio========================

initgame:

// cls

set text size 50

//set text to bold

text 200,10,"LABYRINT"

set text size 25

text 10,40,"UP and DOWN keys"

text 10,70,"Mouse  left and right"

text 10,100,"Space help"

text 10,130,"CTRL reset level"

if comsize <>0 and comsize <=3 then text 150,300,"Next Level"

// show object objsph

// turn object left objsph,0.5

paste image 6,180,180

if comsize > 3

text 10,400,"GAME OVER               press a key..........."

else

text 10,400,"press a key..........."

endif

text 10,450,"                                             By: vitaluciano@hotmail.fr"

//   make object cube 64,10

position object objsph,10,10,-100

sync

wait key

if comsize >3 then end

//  sync rate 0

return

Download

Please login to download

Comments

No comments yet.

CodeBase - labirynt_game

Information

Summary

Full Description

DarkBASIC Professional Source Code

Download

Screen Shot

Author

Comments

Author Name:	Anonymous Coder
CodeBase Entries:	7