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

                                    ` 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
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
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
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

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