TheGameCreators - CodeBase

Return to the CodeBase listing

Category: Complete Applications

Version: 1.0

Information

Uploaded: 25th Feb 2005 07:52

Modified: 1st Jan 1970 01:00

Author: hannibal dark

Summary

zooms, finds distances, cooks e.t.c. :)

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 here you are. your 3d distance calculator

rem by hannibal dark

rem sorry for the long code

rem the real part you want is so short

rem you can use it any where

rem i would be pleased if you'd count me in credits of your own programs

rem it includes;

rem zoom generator (a little bit bugged)

rem basic 3d moving (sorry no jumping)

rem basic camera look without breaking your neck

rem real 3d distance calculating

rem basic 3d obstacle identyfiing

rem i think those are enough

rem sorry i do not have much time for adding the jumping,fire routinnes

rem but still this is the solvent of your problem

rem 23/2/2005 wednesday

rem total re-writing ! time almost 45 mins.

rem nobody beta-tested this program

rem DO NOT FORGET to re-locate the bitmap destination

rem change the "c:/target/blablabla.bmp;jpg;or else"

rem you can put an edge to scanning axisses because when the vector is

rem bigger than nearly 10000 pixels it damn slows

rem moving while zooming is wrong

gosub titlescreen

gosub mymatrix

gosub randomobjects

my_y=180+ get ground height (1,10000,10000)

position camera 10000,my_y,10000

routinne:

if escapekey()=1 then end

cx#=wrapvalue(cx#+mousemovey()/5)

cy#=wrapvalue(cy#+mousemovex()/5)

cz#=wrapvalue(cz#+mousemovez()/5)

if cx#<= 60 then mode=1:amode=1

if cx#>=300 then mode=2:amode=1

if cx#>60 and cx#<300 then amode=0

if amode=0

if mode=1 then cx#=60

if mode=2 then cx#=300

endif

rotate camera cx#,cy#,0

if upkey()=1 then gosub moveforward:zoomed=0

if downkey()=1 then gosub movebackward:zoomed=0

if leftkey()=1 then gosub moveleftward:zoomed=0

if rightkey()=1 then gosub moverightward:zoomed=0

if upkey()=0 and downkey()=0 and rightkey()=0 and leftkey()=0

if shake > 2 then shake=shake-1

endif

for t=2 to 11

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

next t

rem the v key

if scancode()=47

if v_key_avaible=1

if checkvector=1

checkvector=0

else

checkvector=1

endif

v_key_avaible=0

endif

if scancode()<>47 then v_key_avaible=1

rem the O key

if scancode()=24

if o_key_avaible=1

if checkobject=1

checkobject=0

else

checkobject=1

endif

o_key_avaible=0

endif

if scancode()<>24 then o_key_avaible=1

if checkvector=1

gosub findvector

tx$=str$(zx)

ty$=str$(zy)

tz$=str$(zz)

td$=str$(rrr)

tob$=str$(the_object)

tox$=str$(ozx)

toy$=str$(ozy)

toz$=str$(ozz)

tod$=str$(orrr)

ink rgb(0,0,0),1

text 12,12,"The distance where you are looking on x axis is "+tx$+" pixels"

text 12,22,"The distance where you are looking on y axis is "+ty$+" pixels"

text 12,32,"The distance where you are looking on z axis is "+tz$+" pixels"

ink rgb(255,255,255),1

text 10,10,"The distance where you are looking on x axis is "+tx$+" pixels"

text 10,20,"The distance where you are looking on y axis is "+ty$+" pixels"

text 10,30,"The distance where you are looking on z axis is "+tz$+" pixels"

if bumped=1

ink rgb(0,0,0),1

text 12,52,"The object you are looking on x axis is "+tox$+" pixels"

text 12,62,"The object you are looking on y axis is "+toy$+" pixels"

text 12,72,"The object you are looking on z axis is "+toz$+" pixels"

text 12,92,"It is the object numbered as "+tob$

ink rgb(255,255,255),1

text 10,50,"The object you are looking on x axis is "+tox$+" pixels"

text 10,60,"The object you are looking on y axis is "+toy$+" pixels"

text 10,70,"The object you are looking on z axis is "+toz$+" pixels"

text 10,90,"It is the object numbered as "+tob$

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

endif

if bumped=0

ink rgb(255,255,255),1

else

ink rgb(0,0,255),1

endif

my_length=len(td$)

if bumped = 0

text ox-(my_length)*4,oy-32,td$+" pixels"

else

text ox-(my_length)*4,oy-32,tod$+" pixels"

endif

if mouseclick()=2

if zoom=0

gosub getcameradata

old_x=eye_x

old_y=eye_y

old_z=eye_z

zoom=1

zooming=1

endif

else

if zoom=1 then position camera old_x,old_y,old_z

zooming=0

zoom=0

zoomed=0

endif

if zooming = 1 then gosub zoomfactor

gosub crosshair

sync

goto routinne

moveforward:

if zoom = 0

gosub getcameradata

else

eye_x=old_x

eye_y=old_y

eye_z=old_z

endif

eye_x=eye_x+sin(angle_y)*speed

eye_z=eye_z+cos(angle_y)*speed

my_y=180+ get ground height (1,eye_x,eye_z)

if zoom=1

old_x=old_x+sin(angle_y)*speed/2

old_z=old_z+cos(angle_y)*speed/2

old_y=180+ get ground height (1,old_x,old_z)

endif

gosub checkpositionallimts_hey_what_a_long_label_name_is_this

if zoom=0

position camera eye_x,my_y,eye_z

else

position camera old_x,old_y,old_z

endif

if shake < 8 then shake=shake+1

return

movebackward:

if zoom = 0

gosub getcameradata

else

eye_x=old_x

eye_y=old_y

eye_z=old_z

endif

gosub getcameradata

eye_x=eye_x-sin(angle_y)*speed

eye_z=eye_z-cos(angle_y)*speed

my_y=180+ get ground height (1,eye_x,eye_z)

if zoom=1

old_x=old_x-sin(angle_y)*speed/2

old_z=old_z-cos(angle_y)*speed/2

old_y=180+ get ground height (1,old_x,old_z)

endif

gosub checkpositionallimts_hey_what_a_long_label_name_is_this

if shake < 8 then shake=shake+1

if zoom=0

position camera eye_x,my_y,eye_z

else

position camera old_x,old_y,old_z

endif

return

moveleftward:

if zoom = 0

gosub getcameradata

else

eye_x=old_x

eye_y=old_y

eye_z=old_z

endif

gosub getcameradata

if upkey()=1 or downkey()=1 then aw=2 else aw=1

if zoom=1 then aw=aw*2

eye_x=eye_x-cos(angle_y)*speed/aw

eye_z=eye_z+sin(angle_y)*speed/aw

gosub checkpositionallimts_hey_what_a_long_label_name_is_this

my_y=180+ get ground height (1,eye_x,eye_z)

if zoom=1

old_x=old_x-cos(angle_y)*speed/aw

old_z=old_z+sin(angle_y)*speed/aw

old_y=180+ get ground height (1,old_x,old_z)

endif

if shake < 8 then shake=shake+1

if zoom=0

position camera eye_x,my_y,eye_z

else

position camera old_x,old_y,old_z

endif

return

moverightward:

if zoom = 0

gosub getcameradata

else

eye_x=old_x

eye_y=old_y

eye_z=old_z

endif

if upkey()=1 or downkey()=1 then aw=2 else aw=1

if zoom=1 then aw=aw*2

gosub getcameradata

eye_x=eye_x+cos(angle_y)*speed/aw

eye_z=eye_z-sin(angle_y)*speed/aw

my_y=180+ get ground height (1,eye_x,eye_z)

if zoom=1

old_x=old_x+cos(angle_y)*speed/aw

old_z=old_z-sin(angle_y)*speed/aw

old_y=180+ get ground height (1,old_x,old_z)

endif

gosub checkpositionallimts_hey_what_a_long_label_name_is_this

if shake < 8 then shake=shake+1

if zoom=0

position camera eye_x,my_y,eye_z

else

position camera old_x,old_y,old_z

endif

return

getcameradata:

eye_x = camera position x()

eye_y = camera position y()

eye_z = camera position z()

angle_x = camera angle x()

angle_y = camera angle y()

angle_z = camera angle z()

return

checkscreen:

if check display mode (1024,768,32) then set display mode 1024,768,32

width = screen width()

height = screen height ()

sync on

sync rate 1000

set camera range 1,50000

ox=width/2

oy=height/2

shake=2

speed=25

x_max=20000

x_min=0

y_max=1000

y_min=0

z_max=20000

z_min=0

xlook=5000

ylook=5000

zlook=5000

checkvector=1

v_key_avaible=1

r_click_avaible=1

rem make this 1 for a perfect pixel scan but forget about the performance =

scan_speed=5

return

mymatrix:

load image "mymatrix.bmp",1

make matrix 1,20000,20000,100,100

prepare matrix texture 1,1,4,1

for x=0 to 99

for z=0 to 99

set matrix tile 1,x,z,4

next z

next x

randomize matrix 1,100

update matrix 1

make matrix 2,20000,1000,100,25

prepare matrix texture 2,1,4,4

for x=0 to 99

for z=0 to 24

set matrix tile 2,x,z,16

er=rnd(100)-50

set matrix height 2,x,24-z,z*20+er

next z

next x

position matrix 2,0,0,-980

update matrix 2

make matrix 3,20000,1000,100,25

prepare matrix texture 3,1,4,4

for x=0 to 99

for z=0 to 24

set matrix tile 3,x,z,16

er=rnd(100)-50

set matrix height 3,x,z,z*20+er

next z

next x

position matrix 3,0,0,20000-20

update matrix 3

make matrix 4,1000,20000,25,100

prepare matrix texture 4,1,4,4

for x=0 to 24

for z=0 to 99

set matrix tile 4,x,z,16

er=rnd(100)-50

set matrix height 4,24-x,z,x*20+er

next z

next x

position matrix 4,-980,0,0

update matrix 4

make matrix 5,1000,20000,25,100

prepare matrix texture 5,1,4,4

for x=0 to 24

for z=0 to 99

set matrix tile 5,x,z,16

er=rnd(100)-50

set matrix height 5,x,z,x*20+er

next z

next x

position matrix 5,20000-20,0,0

update matrix 5

make object sphere 1,1

hide object 1

return

crosshair:

rem cl_dynamiccrosshair 1

ink rgb(0,200,0),1

line ox-shake-4,oy,ox-shake,oy

line ox+shake,oy,ox+shake+4,oy

line ox,oy-shake-4,ox,oy-shake

line ox,oy+shake,ox,oy+shake+4

return

rem your answer

findvector:

set_obj_pos=0

gosub getcameradata

position object 1,eye_x,eye_y,eye_z

rotate object 1,angle_x,angle_y,angle_z

control=0

zx=0

zy=0

zz=0

distance=0

bumped=0

objr=object size(1)

y_min= get ground height (1,eye_x,eye_z)

while control=0

move object 1,scan_speed

distance=distance+1

objx=object position x(1)

objy=object position y(1)

objz=object position z(1)

rem bumped=object collision (1,0)

rem makes my amd athlon(R)2800+ xp + fx 5700 + 512 mb 400 mhz ram very slow !

rem here is my own sphere collision detection

rem you wanted an advice in your post

rem "make your own" is my advice

for at=1 to 10

ax=object position x(at+1)

ay=object position y(at+1)

az=object position z(at+1)

radius=object size(at+1)

dx=abs(objx-ax)

dy=abs(objy-ay)

dz=abs(objz-az)

if dx <= (radius-objr) and dy <= (radius-objr) and dz <= (radius-objr)

bumped=1

if set_obj_pos=0

wdistance=distance

set_obj_pos=1

endif

the_object=at+1

rem control=1 (if you use this it will stop when hits an object)

exit

endif

next t

ozx=wdistance*abs(sin(angle_y)*100)*scan_speed

ozy=wdistance*abs(sin(angle_x)*100)*scan_speed

ozz=wdistance*abs(cos(angle_y)*100)*scan_speed

y_min = get ground height (1,objx,objz)

if objx >= x_max or objy >= y_max or objz >= z_max then control=1

if objx <= x_min or objy <= y_min or objz <= z_min then control=1

if control=0

zx=zx+abs(sin(angle_y)*100)*scan_speed

zy=zy+abs(sin(angle_x)*100)*scan_speed

zz=zz+abs(cos(angle_y)*100)*scan_speed

endif

endwhile

zx=zx/100

zy=zy/100

zz=zz/100

ozx=ozx/100

ozy=ozy/100

ozz=ozz/100

rr=sqrt(zx*zx+zz*zz)

rrr=sqrt(rr*rr+zy*zy)

rrr=rrr

orr=sqrt(ozx*ozx+ozz*ozz)

orrr=sqrt(orr*orr+ozy*ozy)

return

checkpositionallimts_hey_what_a_long_label_name_is_this:

if eye_x >= x_max then eye_x=x_max

if eye_x <= x_min then eye_x=x_min

if eye_y >= y_max then eye_y=y_max

if eye_y <= y_min then eye_y=y_min

if eye_z >= z_max then eye_z=z_max

if eye_z <= z_min then eye_z=z_min

if old_x >= x_max then old_x=x_max

if old_x <= x_min then old_x=x_min

if old_y >= y_max then old_y=y_max

if old_y <= y_min then old_y=y_min

if old_z >= z_max then old_z=z_max

if old_z <= z_min then old_z=z_min

return

randomobjects:

for t=1 to 10

radius=rnd(100)+300

acx=rnd(20000-radius*2)+radius

acz=rnd(20000-radius*2)+radius

acy=rnd(500)+200

make object sphere t+1,radius

position object t+1,acx,acy,acz

next t

make object plain 100,5000,1000

texture object 100,10

set object 100,0,12,0,0

position object 100,12000,1000,22000

return

rem there is a little bug here

rem but i am sorry there is no time to reduce it

rem findout what is the bug and solve it if you can

rem also you calculate if the object is bigger than the width/2 then make your own

rem i think there are a few ways for zooming

rem of course when the bugs removed this is the best way

rem because it is done by hannibaldark

rem have fun

zoomfactor:

if zoomed=0

gosub findvector

if bumped=0

move camera rrr/2

else

if (distance*100)/2 < wdistance *100

move camera rrr/2

else

move camera orrr-1

endif

zoomed=1

endif

return

titlescreen:

gosub checkscreen

ink rgb(8,32,255),1

box 0,0,width,height

ink rgb(0,8,75),1

text 12,12,"This program calculates the 3d distance"

text 12,22,"Between the eye and any obstacle"

ink rgb(255,255,255),1

text 10,10,"This program calculates the 3d distance"

text 10,20,"Between the eye and any obstacle"

ink rgb(0,8,75),1

text 22,102,"Press V for the calculation"

text 22,112,"Use arrow keys for moving"

text 22,122,"Use mouse to look around"

text 22,132,"Right button for zooming"

text 22,142,"Escape key to exit"

ink rgb(255,255,255),1

text 22,100,"Press V for the calculation"

text 22,110,"Use arrow keys for moving"

text 22,120,"Use mouse to look around"

text 22,130,"Right button for zooming"

text 22,140,"Escape key to exit"

ink rgb(0,8,75),1

text 52,302,"While zooming ;"

text 52,312,"if you try to walk there will be a mistake"

text 52,322,"But i do not know where the error"

text 52,332,"It is possible that variable is not responding"

text 52,342,"And a small bug while there is an object"

text 52,352,"It is all about calculating "

ink rgb(255,255,255),1

text 50,300,"While zooming ;"

text 50,310,"if you try to walk there will be a mistake"

text 50,320,"But i do not know where the error"

text 50,330,"It is possible that variable is not responding"

text 50,340,"And a small bug while there is an object"

text 50,350,"It is all about calculating "

text 400,400,"Press any key to start"

while inkey$()=""

sync

endwhile

cls

ink rgb(0,0,0),1

box 0,0,width,height

ink rgb(255,255,255),1

text 0,0,"hannibaldark's FPS zooming tutorial"

get image 10,0,0,300,20

cls

hide mouse

return

Download

Please login to download

Comments

No comments yet.

CodeBase - Zoom Generator

Information

Summary

Full Description

DarkBASIC Professional Source Code

Download

Screen Shot

Author

Comments

Author Name:	hannibal dark
CodeBase Entries:	2