Sorry your browser is not supported!

Rem Project: DarkPhysXVechilesettins
Rem Created: 03/02/2009 09:05:34
sync on
sync rate 60
phy enable debug
phy start
sync on
sync rate 60
global tcx tcy zdist#
`tcx=screen width()/2
`tcy=screen height()/2
dim boxes(2) as float
dim dragbox(8) as float
dim r(8)
dim g(8)
dim b(8)
for i = 1 to 8
    r(i)=255
    g(i)=255
    b(i)=255
next i
rem click box size
boxes(1)=4
boxes(2)=4

global oldpath$
rem run oping credits when made.
set display mode 800,600,32
set text font "airal"
backdrop off
cls rgb(0,0,0)
set window layout 1,1,0
rem preview and keyword vars
global previewindex : previewindex=0
global previewline : previewline=0
global foundline : foundline=-1

global depth# baseheight# rooftop# width# baseheight#
global wheelid1 xrb# yrb# zrb# wheelradiusid1# bodyheightid1#
global wheelid2 xlb# ylb# zlb# wheelradiusid2# bodyheightid2#
global wheelid3 xrf# yrf# zrf# wheelradiusid3# bodyheightid3#
global wheelid4 xlf# ylf# zlf# wheelradiusid4# bodyheightid4#
global camdist#
rem values for limb sizer.
MinX as float
MinY as float
MinZ as float
MaxX as float
MaxY as float
MaxZ as float
MinXnow as float
MinYnow as float
MinZnow as float
MaxXnow as float
MaxYnow as float
MaxZnow as float

`Some variables containing the position of the camera in sphere coordinates
CamDist# = 10.0 :rem how far away from object
CamAngX# = 0.0 :rem start angles
CamAngY# = 0.0
`Target coordinates
TargetX# = 0.0
TargetY# = 0.0
TargetZ# = 0.0
`These variables make the camera rotation faster/slower
CamIntensityMouseZ# = 0.01
CamIntensityMouse#  = 0.5
CamIntensityKeys#   = 0.5
rem button click count
bcount=0
value as double float
rem Screen dimensions
gap=screen height()/10
topline=0
halfwidth =screen width()/2
middleline=screen width()/2
twothirds =screen width()/4-1
bottomline=screen height()
bottomcamscreen=screen height()-100
verthalfline=topline+((bottomcamscreen-topline)/2)
rightline =screen width()
displaymax=((bottomcamscreen-topline)/18)-2
valuesdisplaymax=((bottomcamscreen-(verthalfline+gap))/18)-2
displaywidthmax=((middleline-leftline)/10)-2
valuesdisplaywidthmax=((rightline-middleline)/10)-9
LookSens#=0.3

rem wlecome box
box screen width()/2-100,screen height()/2-50,screen width()/2+100,screen height()/2+50,rgb(0,0,255),rgb(0,200,255),rgb(0,0,255),rgb(0,200,255)
center text screen width()/2,screen height()/2-6,"Welcome to Dark PhysX Vehicle Setup"
center text screen width()/2,screen height()/2+6,"please pick your Vehicle to load"

sync
sync
delay=timer()+1500
repeat
until timer()>delay or inkey$()<>""

rem open file to get object
file$ = getFileName("load","Load in X model",".x .3ds","*.x;  *.3ds")

set camera view 0,twothirds,topline,rightline,bottomcamscreen
set camera aspect 0,(rightline-twothirds)/((bottomline-topline)+0.0)


backdrop on  : color backdrop 0,rgb(0,255,0)
make matrix 1,200,200,100,100
ink rgb(255,255,255),0
`print file$
`load the object
id= 2
load object file$,id




`make object cube 1,1
rem camera link
make object sphere 3,.1
`Make a mesh from the object
MAKE MESH FROM OBJECT 1,3
`Add a limb onto the object using the mesh we just made
ADD LIMB 3,1,1
`Offset the limb 700 units away
OFFSET LIMB 3,1,0,0,10-camz#
`Hide the limb for lag reduction
HIDE LIMB 3,1
`Hide the dummy object for lag reduction
HIDE OBJECT 3
ghost object on id,1
position matrix 1,-100,height#,-100
object=100
startobject=100

make object sphere 98,.1
make object box 97,.1,.1,1
make object cone 96,.2

make mesh from object 1,97
make mesh from object 2,96
hide object 97
hide object 96
add limb 98,1,1 :rem x pole
add limb 98,2,1 :rem y pole
add limb 98,3,1 :rem z pole
add limb 98,4,2
add limb 98,5,2
add limb 98,6,2

link limb 98,0,1
link limb 98,0,2
link limb 98,0,3

rem x pole
rotate limb 98,1,0,90,0
offset limb 98,1,.5,0,0
offset limb 98,4,1.1,0,0
rotate limb 98,4,0,0,-90
rem y pole
rotate limb 98,2,90,0,0
offset limb 98,2,0,.5,0
offset limb 98,5,0,1.1,0
rem z pole
rotate limb 98,3,0,0,-90
offset limb 98,3,0,0,.5
offset limb 98,6,0,0,1
rotate limb 98,6,90,0,0
hide object 97
   rem x y z pointer
lock object on 98
position object 98,-5,-5,10

backdrop on
dim loc(5)
dim wheel(4) as float
rem start of loop ++++++++++++++++++++++++++++++++++++++++++++
do

box 0,0,twothirds,bottomcamscreen,RGB(0,0,155),RGB(0,64,155),RGB(0,0,155),RGB(0,64,155)
box 0,bottomcamscreen,rightline,bottomline,rgb(255,255,255),rgb(255,255,255),rgb(255,255,255),rgb(255,255,255)
box 1,bottomcamscreen+1,rightline-1,bottomline-1,rgb(0,0,0),rgb(0,0,0),rgb(0,0,0),rgb(0,0,0)
ink rgb(255,255,255),0
set cursor 0,0
    mmx# = mousemovex()
    mmy# = mousemovey()
    mmz# = mousemovez()
    `Handle rotation
    gosub RotateCam
    gosub pickobject
if key<1
    repeat
        set cursor 0,0
        print "press key 1 to 4 Presenting model view?"
        print "1. Vehicle Back view."
        print "2. Vehicle Front view."
        print "3. Vehicle left side view."
        print "4. Vehicle Right side view."

        if inkey$()=>"1" and inkey$()<="4"
            key=val(inkey$())
        endif
        print "you picked ";key
        if key=1
`            rotate object id,0,90,0
`            fix object pivot id
            endif
        if key=2
            rotate object id,0,180,0
            fix object pivot id
        endif
        if key=3
            rotate object id,0,90,0
            fix object pivot id
        endif
        if key=4
            rotate object id,0,-90,0
            fix object pivot id
        endif
        gosub RotateCam
        sync
    until key>0
endif
`print "key=";key
rem make limbs list
print "Arrowkey to move camera about model"
print "< > to Zoom in and out. + - to move up/down list"
print "right button to move model and zoom in out"
print "left button to pick a model point"
print "LIMBS IN OBJECT"
rem get the list of limbs
gosub checklimbs
gosub listalimb

pt=1
for t = startobject to lastobject
if object exist(t)
 if object screen x(t)>twothirds
    ink rgb(255,255,255),0
    text object screen x(t),object screen y(t),str$(t-startobject+1)
    line object screen x(t),object screen y(t),object screen x(t),object screen y(t)-150
    ink RGB(128,0,255),0
    text object screen x(t),object screen y(t)-170+(pt*3),partname$(pt,0)
    inc pt
  endif
endif
next t

done=1
if bcount<5
ink 0,0
print "R to restart Wheel finding"
if keystate(19)=1
    bcount=0
    for r=1 to limbnumbrs
        partname$(r,1)="0"
    next t
endif
  ink rgb(255,255,255),0
if bcount=0
print "Find and click Right Back Wheel"
endif
if bcount=1
print "Find and cilck Left Back Wheel"
endif
if bcount=2
print "Find and click Right Front Wheel"
endif
if bcount=3
print "Find and click Left Front wheel"
endif
if bcount=4
print "Find and click Left Front suppenion"
endif
endif
drawstartobject=99
for bb= 0 to 4
`print loc(bb)
if bb=0 and loc(bb)<>0
line object screen x(drawstartobject+loc(bb)),object screen y(drawstartobject+loc(bb)),object screen x(drawstartobject+loc(bb)),object screen y(drawstartobject+loc(bb))+100
endif
if bb=1 and loc(bb)<>0
    line object screen x(drawstartobject+loc(bb)),object screen y(drawstartobject+loc(bb)),object screen x(drawstartobject+loc(bb)),object screen y(drawstartobject+loc(bb))+100
    rem lik line
    line object screen x(drawstartobject+loc(bb)),object screen y(drawstartobject+loc(bb))+90,object screen x(drawstartobject+loc(bb-1)),object screen y(drawstartobject+loc(bb-1))+90
    width# = ObjDistToObj(drawstartobject+loc(bb), drawstartobject+loc(bb-1))
    ink RGB(128,0,255),0
    center text (object screen x(drawstartobject+loc(bb))+ object screen x(drawstartobject+loc(bb-1)))/2,(object screen y(drawstartobject+loc(bb))+ object screen y(drawstartobject+loc(bb-1)))/2+95,str$(width#,4)
    ink rgb(255,255,255),0
endif
If bb=2 and loc(bb)<>0
    line object screen x(drawstartobject+loc(bb)),object screen y(drawstartobject+loc(bb)),object screen x(drawstartobject+loc(bb)),object screen y(drawstartobject+loc(bb))+100
    rem join line
    line object screen x(drawstartobject+loc(bb)),object screen y(drawstartobject+loc(bb))+90,object screen x(drawstartobject+loc(bb-2)),object screen y(drawstartobject+loc(bb-2))+90
    depth# = ObjDistToObj(drawstartobject+loc(bb), drawstartobject+loc(bb-2))
    ink RGB(128,0,255),0
    center text (object screen x(drawstartobject+loc(bb))+ object screen x(drawstartobject+loc(bb-2)))/2,(object screen y(drawstartobject+loc(bb))+ object screen y(drawstartobject+loc(bb-2)))/2+95,str$(depth#,4)
    ink rgb(255,255,255),0
 endif

If bb=3 and loc(bb)<>0
    line object screen x(drawstartobject+loc(bb)),object screen y(drawstartobject+loc(bb)),object screen x(drawstartobject+loc(bb)),object screen y(drawstartobject+loc(bb))+100
    rem join line
    line object screen x(drawstartobject+loc(bb)),object screen y(drawstartobject+loc(bb))+90,object screen x(drawstartobject+loc(bb-1)),object screen y(drawstartobject+loc(bb-1))+90
    bwidth# = ObjDistToObj(drawstartobject+loc(bb), drawstartobject+loc(bb-1))
    ink RGB(128,0,255),0
    center text (object screen x(drawstartobject+loc(bb))+ object screen x(drawstartobject+loc(bb-1)))/2,(object screen y(drawstartobject+loc(bb))+ object screen y(drawstartobject+loc(bb-1)))/2+95,str$(bwidth#,4)
    ink rgb(255,255,255),0
endif
rem set the PhysX xyz position of wheels to  VEHICLE BODY .
if loc(0)<>0
xrb#=abs(object position x(id)-object position x (drawstartobject+loc(0)))
yrb#=abs(object position y (drawstartobject+loc(0))-object position y(id))
zrb#=abs(object position z (drawstartobject+loc(0))-object position z(id))
endif
if loc(1)<>0
xlb#=abs(object position x (drawstartobject+loc(1))-object position x(id))
ylb#=abs(object position y (drawstartobject+loc(1))-object position y(id))
zlb#=abs(object position z(id)-object position z (drawstartobject+loc(1)))
endif

if loc(2)<>0
xrf#=abs(object position x (drawstartobject+loc(2))-object position x(id))
yrf#=abs(object position y (drawstartobject+loc(2))-object position y(id))
zrf#=abs(object position z (drawstartobject+loc(2))-object position z(id))
endif
if loc(3)<>0
xlf#=abs(object position x(id)-object position x (drawstartobject+loc(3)))
ylf#=abs(object position y (drawstartobject+loc(3))-object position y(id))
zlf#=abs(object position z(id)-object position z (drawstartobject+loc(3)))
endif

next bb
if loc(3)<>0
for wl = 0 to 3
    numberlimb=loc(wl)
    gosub limbsize
    wheel(wl)=YSize#/2 :`+0.1

    next wl
endif
if loc(4)<>0
    numberlimb=loc(4)
    gosub limbsize
    sup#=ysize#
endif
if loc(1)<>0
originy# =object size y(id)
endif
if loc(3)>0
tcx=object screen x(id)
tcy=object screen y(id)
rem start positions
rem top left x,y
if bdrag<>1
bdrag=1
dragbox(1)=tcx-15
dragbox(2)=tcy-15
rem top right x,y
dragbox(3)=tcx+15
dragbox(4)=tcy-15
rem bottom right x,y
dragbox(5)=tcx+15
dragbox(6)=tcy+15
rem bottom left x,y
dragbox(7)=tcx-15
dragbox(8)=tcy+15
endif
endif
`gosub drawabox
    if loc(3)<>0 and made<>1
        made=1

        baseheight# = wheel(0): rem radius of wheel

        `make object box 50,width#,originy#-baseheight#,depth#
        height#=object size y(id)
        width#=object size x(id)
        depth#=object size z(id)
        make object box 50,width#,height#,depth#
        SET OBJECT WIREFRAME 50,1
        position object 50,0,(height#/2)-(baseheight#*2),0
        rooftop#=height#-baseheight#
    endif
ink rgb(255,255,255),0

text 10,bottomcamscreen+12,"PHY ADD VEHICLE BODY ID "+str$(depth#/2,2)+","+str$(rooftop#-baseheight#,2)+","+str$(width#/2,2)+", 0,"+str$(sup#,2)+", 0"
mesg5$="PHY ADD VEHICLE BODY ID "+str$(depth#/2,2)+","+str$(rooftop#-baseheight#,2)+","+str$(width#/2,2)+", 0,"+str$(sup#,2)+",0"
text 10,bottomcamscreen+12*2,"PHY SET VEHICLE WHEEL RADIUS ID,Back Right,"+str$(wheel(0),2)
text 10,bottomcamscreen+12*3,"PHY SET VEHICLE WHEEL RADIUS ID,Back Left ,"+str$(wheel(1),2)
text 10,bottomcamscreen+12*4,"PHY SET VEHICLE WHEEL RADIUS ID,Front Right,"+str$(wheel(2),2)
text 10,bottomcamscreen+12*5,"PHY SET VEHICLE WHEEL RADIUS ID,Front Left,"+str$(wheel(3),2)
text 10,bottomcamscreen+12*6,"PHY SET VEHICLE WHEEL ROTATION ID, wheel, direction"
text 10,bottomcamscreen+12*7,"PHY SET VEHICLE WHEEL POWER ID, front, rear"
if loc(0)<>0

text 300,bottomcamscreen+12*1,"PHY ADD VEHICLE WHEEL ID,"+str$(loc(0),0)+", "+str$(xrb#,2)+", "+str$(yrb#,2)+", "+str$(zrb#,2)+", "+ str$(wheel(0),2)+", "+str$( object position y(drawstartobject+loc(0))*2,2)+", 0, 0 "+partname$(loc(0),0)

wheelid1=loc(0):wheelradiusid1#=wheel(0):bodyheightid1#=object position y(drawstartobject+loc(0))*2

mesg1$="PHY ADD VEHICLE WHEEL ID,"+str$(loc(0),0)+", "+str$(xrb#,2)+", "+str$(yrb#,2)+", "+str$(zrb#,2)+", "+ str$(wheel(0),2)+", "+str$( object position y(drawstartobject+loc(0))*2,2)+", 0, 0 :`"+partname$(loc(0),0)
endif
if loc(1)<>0
text 300,bottomcamscreen+12*2,"PHY ADD VEHICLE WHEEL ID,"+str$(loc(1),0)+", "+str$(xlb#,2)+", "+str$(ylb#,2)+", -"+str$(zlb#,2)+", "+ str$(wheel(1),2)+", "+str$( object position y(drawstartobject+loc(1))*2,2)+", 0, 1 "+partname$(loc(1),0)

wheelid2=loc(1):wheelradiusid2#=wheel(1):bodyheightid2#=object position y(drawstartobject+loc(1))*2

mesg2$="PHY ADD VEHICLE WHEEL ID,"+str$(loc(1),0)+", "+str$(xlb#,2)+", "+str$(ylb#,2)+", -"+str$(zlb#,2)+", "+ str$(wheel(1),2)+", "+str$( object position y(drawstartobject+loc(1))*2,2)+", 0, 1 :`"+partname$(loc(1),0)
endif
if loc(2)<>0
text 300,bottomcamscreen+12*3,"PHY ADD VEHICLE WHEEL ID,"+str$(loc(2),0)+", -"+str$(xrf#,2)+", "+str$(yrf#,2)+", -"+str$(zrf#,2)+", "+ str$(wheel(2),2)+", "+str$( object position y(drawstartobject+loc(2))*2,2)+", 1, 0 "+partname$(loc(2),0)

wheelid3=loc(2):wheelradiusid3#=wheel(2):bodyheightid3#=object position y(drawstartobject+loc(2))*2

mesg3$="PHY ADD VEHICLE WHEEL ID,"+str$(loc(2),0)+", -"+str$(xrf#,2)+", "+str$(yrf#,2)+", -"+str$(zrf#,2)+", "+ str$(wheel(2),2)+", "+str$( object position y(drawstartobject+loc(2))*2,2)+", 1, 0 :`"+partname$(loc(2),0)
endif
if loc(3)<>0
text 300,bottomcamscreen+12*4,"PHY ADD VEHICLE WHEEL ID,"+str$(loc(3),0)+", -"+str$(xlf#,2)+", "+str$(ylf#,2)+", "+str$(zlf#,2)+", "+ str$(wheel(3),2)+", "+str$( object position y(drawstartobject+loc(3))*2,2)+", 1, 1 "+partname$(loc(3),0)

wheelid4=loc(3):wheelradiusid4#=wheel(3):bodyheightid4#=object position y(drawstartobject+loc(3))*2

mesg4$="PHY ADD VEHICLE WHEEL ID,"+str$(loc(3),0)+", -"+str$(xlf#,2)+", "+str$(ylf#,2)+", "+str$(zlf#,2)+", "+ str$(wheel(3),2)+", "+str$( object position y(drawstartobject+loc(3))*2,2)+", 1, 1 :`"+partname$(loc(3),0)
endif
`phy add vehicle wheel 1, 5,  1.5, 0.3,  1.1, 0.6, 0.2, 0, 0

`phy add vehicle wheel 1, 7,  1.5, 0.3, -1.1, 0.6, 0.2, 0, 1

`phy add vehicle wheel 1, 3, -1.5, 0.3, -1.1, 0.6, 0.2, 1, 0

`phy add vehicle wheel 1, 9, -1.5, 0.3,  1.1, 0.6, 0.2, 1, 1
if loc(3)<>0
text 10,100-12,"load to clipboard ready  <press C>"
if keystate(46)
WRITE TO CLIPBOARD mesg5$+chr$(13)+chr$(10)+mesg1$+chr$(13)+chr$(10)+mesg2$+chr$(13)+chr$(10)+mesg3$+chr$(13)+chr$(10)+mesg4$
endif
endif
if loc(3)<>0
text 10,100-24,"jump in and drive ready."
if keystate(36)
goto jumpin
endif
endif
text 400,100,str$(camz#)
   sync
loop

listalimb:
 rem control
 ink rgb(225,225,255),0
 if scancode()=33 and enterkeyword=0 then enterkeyword=1 : clear entry buffer
 if scancode()=49 and nextkeyword=0 and pressed=0 then nextkeyword=2 : pressed=timer() : nextprompt=10
 if nextkeyword=3 then nextkeyword=2
 if nextkeyword<>0 or previewline<>showpreviewline or nextprompt>0
  rem prompt next search
 if nextprompt>0 then dec nextprompt

 else
   if scancode()=0 then pressed=0
   if pressed<>0 and timer()-pressed>150 and scancode()<>49 then pressed=0
   if pressed=0
    if keystate(12)=1 and high>1 then dec high : pressed=timer() : foundline=-1
    if keystate(13)=1 and high<listindex then inc high : pressed=timer() : foundline=-1
    if keystate(26)=1 then move object left 1,1
    if keystate(27)=1 then move object right 1,1
if keystate(25)=1 then roll object left 1,1
    if keystate(39)=1 then roll object right 1,1



    if keystate(201)=1 and high>1
     dec high,30 : pressed=timer() : foundline=-1
     if high<1 then high=1
    endif
    if keystate(209)=1 and high<listindex
     inc high,30 : pressed=timer() : foundline=-1
     if high>listindex then high=listindex
    endif

   endif
  endif



 rem control preview
 scrollpos=high-5
 if scrollpos<1 then scrollpos=1
 if high<>previewindex
  previewindex=high
  previewline=0
  showpreviewline=0

 endif

 rem display
 ink rgb(225,225,255),0
 text 10,100,"    Viewing Limbs "+str$(high)+" of "+str$(listindex)
 scrollposmax=scrollpos+10
 if scrollposmax>listindex then scrollposmax=listindex
 ly=0
 for i=scrollpos to scrollposmax
if partname$(i,1)="1"
    ink rgb(255,255,255),0
  else
   ink rgb(105,105,155),0
  endif

 text 5,112+ly,"limb "+str$(i)+" name ="+partname$(i,0)
  `text 10,112+ly,str$(i-1)+"  "+list$(i,0)+"    "
  inc ly,12
`if i<>0 or i>limbnumbrs
text 5,112+ly,"  x:"+str$(limb position x(id,i),2)+" y:"+str$(limb position y(id,i),2)+" z:"+str$(limb position z(id,i),2)
`inc ly,12
  if limb exist(id,i)
        if done<>1
            partname$(i,2)=str$(object)
            make object sphere object,0.2
            position object object,limb position x(id,i),limb position y(id,i),limb position z(id,i)
            inc object
        endif
        lastobject=object
        endif
text 5,112+ly,"  x:"+str$(limb position x(id,i),2)+" y:"+str$(limb position y(id,i),2)+" z:"+str$(limb position z(id,i),2)
   ` text 10,112+ly,"x:"+str$(limb position x(1,i),2)+" y:"+str$(limb position y(1,i),2)+" z:"+str$(limb position z(1,i),2)
    inc ly,12
  `endif
  if high=i
    ink rgb(255,255,255),0
  else
   ink rgb(105,105,155),0
  endif

  line 10,112+ly,200,112+ly
if object exist(99+i)
    line 200,112+ly,object screen x(99+i),object screen y(99+i)
    endif
  inc  ly,12
 next i
 return

matrixhieght:
if done<>1
    done=1
    repeat
        if downkey()=1
            height#=height#+0.1
        endif
        if upkey()=1
            height#=height#-0.5
        endif
    rem set the martrix depth
    position matrix 1,-100,height#,-100
    until returnkey()=1
endif
return

`Rotate camera
RotateCam:
    gosub RotateCamMouse
    gosub RotateCamKeys
    gosub UpdateCam
    gosub update3Dpointer
return

`Rotation through mouse
RotateCamMouse:
    `If mouse is right-clicked
    if mouseclick() = 2
        `Allow rotation around the object
        CamAngX# = wrapvalue(CamAngX# + mmy# * CamIntensityMouse#)
        CamAngY# = wrapvalue(CamAngY# + mmx# * CamIntensityMouse#)
        Camdist# = wrapvalue(Camdist# - mmz# * CamIntensityMouseZ#)
`        makezoom(camdist#)
    endif
return

RotateCamKeys:
    `Allow keys to make camera rotate
    CamAngX# = wrapvalue(CamAngX# + (upkey() - downkey()) * CamIntensityKeys#)
    CamAngY# = wrapvalue(CamAngY# + (rightkey() - leftkey())*CamIntensityKeys#)
    Camdist# = wrapvalue(Camdist# + (keystate(51)- keystate(52))*CamIntensityKeys#)
zdist#=-camdist#
return

UpdateCam:
    `Calculate position
    CamX# = newxvalue(TargetX#, CamAngY#, cos(CamAngX#) * CamDist#)
    CamY# = sin(CamAngX#) * CamDist#
    CamZ# = newzvalue(TargetZ#, CamAngY#, cos(CamAngX#) * CamDist#)
    `Update camera
    position camera CamX#, CamY#, CamZ#
    point camera TargetX#, TargetY#, TargetZ#
return

update3Dpointer:
if  camAngX#>270 and  camAngX#<90
    rotate object 98,CamAngX#, CamAngY#, CamAngZ#
else
if camAngX#>90 and camAngX#<270
    rotate object 98,CamAngX#, CamAngY#, CamAngZ#-180
endif
    rotate object 98,CamAngX#, CamAngY#, CamAngZ#
endif
return

pickobject:
dd=0
ink 0,0
`text 300,40,str$(lastobject)+"    "+str$(lastpick)+"  "+str$(picked_object-drawstartobject)
`text 300,50,str$(pick object(mousex(),mousey(),startobject,lastobject))
ink rgb(255,255,255),0
if mouseclick()=0 then pickmode=0
    if mouseclick()=1
    if pick object(mousex(),mousey(),startobject,lastobject)>0

    if pickmode=0
        picked_object=pick object(mousex(),mousey(),drawstartobject,lastobject)
        d#=get pick distance()
        x#=get pick vector x():y#=get pick vector y():z#=get pick vector z()
        inc pickmode
        rem button click count
        if lastpick<>picked_object
            if partname$(picked_object-drawstartobject,1)<>"1"
                partname$(picked_object-drawstartobject,1)="1"
                loc(bcount)=picked_object-drawstartobject
                inc bcount
            endif
        endif
        lastpick=picked_object
    endif
    endif
endif

Return

function ObjDistToObj(Obj1 , Obj2 )
   dx# = object position x(Obj1) - object position x(Obj2)
   dy# = object position y(Obj1) - object position y(Obj2)
   dz# = object position z(Obj1) - object position z(Obj2)
   dx# = dx# * dx#
   dy# = dy# * dy#
   dz# = dz# * dz#
   Distn# = sqrt(dx# + dy# + dz#)
endfunction Distn#


checklimbs:
if cl=1 then return
    perform checklist for object limbs id
    limbnumbrs=checklist quantity()
    dim partname$(limbnumbrs,5)
    for c=1 to limbnumbrs
        partname$(checklist value a(c),0)=checklist string$(c)
        partname$(checklist value a(c),1)="0"
    next c
    listindex=limbnumbrs-1
    cl=1
return

limbsize:
lock vertexdata for limb id, numberlimb

MinX = get vertexdata position x(0)
MinY = get vertexdata position y(0)
MinZ = get vertexdata position z(0)
MaxX = get vertexdata position x(0)
MaxY = get vertexdata position y(0)
MaxZ = get vertexdata position z(0)

for i = get vertexdata vertex count() - 1 to 1 step -1
MinX = get vertexdata position x(i)
MinY = get vertexdata position y(i)
MinZ = get vertexdata position z(i)
MaxX = get vertexdata position x(i)
MaxY = get vertexdata position y(i)
MaxZ = get vertexdata position z(i)
if minX<minXnow
    minXnow=minX
endif
if miny<minynow
    minynow=miny
endif
if maxz<maxznow
    maxznow=maxz
endif
if maxX>maxXnow
    maxXnow=maxX
endif
if maxy>maxynow
    maxynow=maxy
endif
if maxz>maxznow
    maxznow=maxz
endif

next

unlock vertexdata

   XSize# = MaxXnow - MinXnow
   YSize# = MaxYnow - MinYnow
   ZSize# = MaxZnow - MinZnow
return
function makebox()
rem corners points
box dragbox(1)-boxes(1)-zdist#,dragbox(2)-boxes(2)-zdist#,dragbox(1)+boxes(1)-zdist#,dragbox(2)+boxes(2)-zdist#,rgb(r(1),g(1),b(1)),rgb(r(1),g(1),b(1)),rgb(r(1),g(1),b(1)),rgb(r(1),g(1),b(1))
box dragbox(3)-boxes(1)+zdist#,dragbox(4)-boxes(2)-zdist#,dragbox(3)+boxes(1)+zdist#,dragbox(4)+boxes(2)-zdist#,rgb(r(2),g(2),b(2)),rgb(r(2),g(2),b(2)),rgb(r(2),g(2),b(2)),rgb(r(2),g(2),b(2))
box dragbox(5)-boxes(1)+zdist#,dragbox(6)-boxes(2)+zdist#,dragbox(5)+boxes(1)+zdist#,dragbox(6)+boxes(2)+zdist#,rgb(r(3),g(3),b(3)),rgb(r(3),g(3),b(3)),rgb(r(3),g(3),b(3)),rgb(r(3),g(3),b(3))
box dragbox(7)-boxes(1)-zdist#,dragbox(8)-boxes(2)+zdist#,dragbox(7)+boxes(1)-zdist#,dragbox(8)+boxes(2)+zdist#,rgb(r(4),g(4),b(4)),rgb(r(4),g(4),b(4)),rgb(r(4),g(4),b(4)),rgb(r(4),g(4),b(4))

rem midpoint boxes
rem top
box (dragbox(1)-zdist#+dragbox(3)-zdist#)/2-boxes(1),(dragbox(1)-zdist#+dragbox(3)-zdist#)/2-boxes(2),(dragbox(1)-zdist#+dragbox(3)+zdist#)/2+boxes(1),(dragbox(2)+dragbox(4))/2+boxes(2),rgb(r(5),g(5),b(5)),rgb(r(5),g(5),b(5)),rgb(r(5),g(5),b(5)),rgb(r(5),g(5),b(5))
rem right
`box (dragbox(3)+dragbox(5)+zdist#)/2-boxes(1),(dragbox(4)+dragbox(6)-zdist#)/2-boxes(2),(dragbox(3)+dragbox(5)+zdist#)/2+boxes(1),(dragbox(4)+dragbox(6)+zdist#)/2+boxes(2),rgb(r(6),g(6),b(6)),rgb(r(6),g(6),b(6)),rgb(r(6),g(6),b(6)),rgb(r(6),g(6),b(6))
rem bottom
`box (dragbox(5)+dragbox(7)+zdist#)/2-boxes(1),(dragbox(6)+dragbox(8)-zdist#)/2-boxes(2),(dragbox(5)+dragbox(7)+zdist#)/2+boxes(1),(dragbox(6)+dragbox(8)+zdist#)/2+boxes(2),rgb(r(7),g(7),b(7)),rgb(r(7),g(7),b(7)),rgb(r(7),g(7),b(7)),rgb(r(7),g(7),b(7))
rem left
`box (dragbox(1)+dragbox(7)-zdist#)/2-boxes(1),(dragbox(8)+dragbox(2)-zdist#)/2-boxes(2),(dragbox(1)+dragbox(7)+zdist#)/2+boxes(1),(dragbox(8)+dragbox(2)+zdist#)/2+boxes(2),rgb(r(8),g(8),b(8)),rgb(r(8),g(8),b(8)),rgb(r(8),g(8),b(8)),rgb(r(8),g(8),b(8))

rem connecting lines
rem top
line dragbox(1)-zdist#,dragbox(2)-zdist#,dragbox(3)+zdist#,dragbox(4)-zdist#
rem right
line dragbox(3)+zdist#,dragbox(4)-zdist#,dragbox(5)+zdist#,dragbox(6)+zdist#
rem bottom
line dragbox(5)+zdist#,dragbox(6)+zdist#,dragbox(7)-zdist#,dragbox(8)+zdist#
rem left
line dragbox(7)-zdist#,dragbox(8)+zdist#,dragbox(1)-zdist#,dragbox(2)-zdist#

endfunction

function isindragbox()
mx=mousex()
my=mousey()

text 0,60,str$(mx)+"  "+str$(my)
for i = 1 to 8 step 2
text 0,0+(i*6),str$(dragbox(i) )+"   "+str$(dragbox(i+1) )
next i
if mx>dragbox(1)-boxes(1) and mx<dragbox(1)+boxes(1) and my>dragbox(2)-boxes(2) and my<dragbox(2)+boxes(2)
    r(1)=255:g(1)=0:b(1)=0
    while mouseclick()<>0
        drag(1,2)
    endwhile
else
    r(1)=255:g(1)=255:b(1)=255
endif
if mx>dragbox(3)-boxes(1) and mx<dragbox(3)+boxes(1) and my>dragbox(4)-boxes(2) and my<dragbox(4)+boxes(2)
    r(2)=255:g(2)=0:b(2)=0
    while mouseclick()<>0
        drag(3,4)
    endwhile
    else
    r(2)=255:g(2)=255:b(2)=255
endif
if mx>dragbox(5)-boxes(1) and mx<dragbox(5)+boxes(1) and my>dragbox(6)-boxes(2) and my<dragbox(6)+boxes(2)
    r(3)=255:g(3)=0:b(3)=0
    while mouseclick()<>0
        drag(5,6)
    endwhile
    else
    r(3)=255:g(3)=255:b(3)=255
endif
if mx>dragbox(7)-boxes(1) and mx<dragbox(7)+boxes(1) and my>dragbox(8)-boxes(2) and my<dragbox(8)+boxes(2)
    r(4)=255:g(4)=0:b(4)=0
    while mouseclick()<>0
        drag(7,8)
    endwhile
    else
    r(4)=255:g(4)=255:b(4)=255
endif
rem mid point boxes
if mx>(dragbox(1)+dragbox(3))/2-boxes(1) and  mx<(dragbox(1)+dragbox(3))/2+boxes(1) and my>(dragbox(2)+dragbox(4))/2-boxes(2) and my<(dragbox(2)+dragbox(4))/2+boxes(2)
    r(5)=255:g(5)=0:b(5)=0
    oldmy=my
    oldy1=dragbox(2)
    oldy2=dragbox(4)
    while mouseclick()<>0
`        cls
`        text 0,0,"draging on"
        my=mousey()
           dragbox(2)=oldy1+( my-oldmy)
        dragbox(4)= oldy2+(my -oldmy)
        makebox()
    sync
endwhile
else
    r(5)=255:g(5)=255:b(5)=255
endif

if mx>(dragbox(3)+dragbox(5))/2-boxes(1) and  mx<(dragbox(3)+dragbox(5))/2+boxes(1) and my>(dragbox(4)+dragbox(6))/2-boxes(2) and my<(dragbox(4)+dragbox(6))/2+boxes(2)
    r(6)=255:g(6)=0:b(6)=0
    oldmx=mx
    oldx1=dragbox(3)
    oldx2=dragbox(5)
    while mouseclick()<>0
`        cls
    `text 0,0,"draging on"
        mx=mousex()
           dragbox(3)=oldx1+(mx-oldmx)
        dragbox(5)= oldx2+(mx-oldmx)
        makebox()
    sync
endwhile
else
    r(6)=255:g(6)=255:b(6)=255
endif
if mx>(dragbox(5)+dragbox(7))/2-boxes(1) and  mx<(dragbox(5)+dragbox(7))/2+boxes(1) and my>(dragbox(6)+dragbox(8))/2-boxes(2) and my<(dragbox(6)+dragbox(8))/2+boxes(2)
    r(7)=255:g(7)=0:b(7)=0
    oldmy=my
    oldy1=dragbox(6)
    oldy2=dragbox(8)
while mouseclick()<>0
 `   cls
   ` text 0,0,"draging on"
        my=mousey()
        dragbox(6)=oldy1+( my-oldmy)
        dragbox(8)= oldy2+(my -oldmy)
        makebox()
    sync
endwhile
else
    r(7)=255:g(7)=255:b(7)=255
endif
if mx>(dragbox(7)+dragbox(1))/2-boxes(1) and  mx<(dragbox(7)+dragbox(1))/2+boxes(1) and my>(dragbox(8)+dragbox(2))/2-boxes(2) and my<(dragbox(8)+dragbox(2))/2+boxes(2)
    r(8)=255:g(8)=0:b(8)=0
oldmx=mx
    oldx1=dragbox(7)
    oldx2=dragbox(1)
    while mouseclick()<>0
`    cls
    `text 0,0,"draging on"
        mx=mousex()
             dragbox(7)=oldx1+( mx-oldmx)
          dragbox(1)= oldx2+(mx -oldmx)
        makebox()
        sync
endwhile
else
    r(8)=255:g(8)=255:b(8)=255
endif
endfunction

function drag(a,b)
`cls
`    text 0,0,"draging on"
        mx=mousex()
        my=mousey()
        dragbox(a)=mx
        dragbox(b)=my
        makebox()
sync
endfunction




jumpin:
rem Vehicle Physics
cls

set camera view 0,0,0,rightline,bottomline
`set camera aspect 0,0
DELETE OBJECTS 4, lastobject+1
`delete matrix 1
`delete object id
delete object 1
rem Lights and camera
make light 1 : set directional light 1, -5, -5, 5
position camera -20, 20, 25 : point camera 0, 10, 0
set camera fov 90
rem Load scene
set dir "C:Program FilesDark Basic SoftwareDark Basic ProfessionalProjectsDark PhysicsDemosVehiclesVehicle ArenaScene"
load object "levelbanktestleveluniverse.dbo",1
scale object 1,10,10,10 :
phy make rigid body static mesh 1
set dir ".."
ghost object on id

id=2
rem Load buggy
`load object "beach.x", id
`load image "beachBu2.tga",2
`load image "dbprocubemap.dds",3
`texture object id,2
` set blend mapping on id,1,3,2,16
position object id, 15, 4, -25
`offset limb id,0,0,-0.5,0
if key=1
rotate limb id,0,0,-90,0
endif
if key=2
rotate limb id,0,0,90,0
endif
if key=3
rotate limb id,0,0,-90,0
endif
rem Be aware the vehicle width and length orientation
phy create vehicle id
PHY ADD VEHICLE BODY ID,depth#/2,rooftop#-baseheight#,width#/2, 0,sup#, 0

`PHY ADD VEHICLE BODY ID, (depth#+baseheight#)/2,rooftop#/2, width#/2, 0, baseheight# , 0
PHY ADD VEHICLE WHEEL ID,wheelid1, -xrb#, yrb#,-zrb#,wheelradiusid1#,bodyheightid1#, 1, 0
PHY ADD VEHICLE WHEEL ID,wheelid2, -xlb#,ylb#,zlb#,wheelradiusid2#,bodyheightid2#, 1, 1
PHY ADD VEHICLE WHEEL ID,wheelid3,xrf#,yrf#,zrf#,wheelradiusid3#,bodyheightid3#, 0, 0
PHY ADD VEHICLE WHEEL ID,wheelid4,xlf#, ylf#,-zlf#,wheelradiusid4#,bodyheightid4#, 0, 1

steeringDelta# = 0.1 :
phy set vehicle steering delta id, steeringDelta#
phy set vehicle max steering angle id, 0.4
phy set vehicle auto id, 1
phy set vehicle wheel multiplier id,0
phy set vehicle suspension spring id,100
phy build vehicle id

rem follower object invisible
`make object sphere 3,10 : hide object 3

rem Load logo sprite
`load image "logo.png", 100000
`sprite 1, 0, 600 - 60, 100000

` movement
g_fSpeed# = 0.05
g_fTurn#  = 0.3

rem Main
do
 rem Follow buggy
 position object 3,object position x(id),object position y(id),object position z(id)
 set object to object orientation 3,id
 move object 3,-100
 point object 3,object position x(id),object position y(id),object position z(id)
dist#=5.0 : high#=2.5 : angle#=object angle y(3)+90
set camera to follow object position x(id), object position y(id), object position z(id), angle#, dist#, high#, 1, 0
 `
 rem Control buggy
phy set vehicle motor force id,0.0
gosub driveCar
 `
 rem Update physics and screen
 phy update
 sync
 `
loop


driveCar:
 `
 rem movement
 key = 0
 if upkey ( ) = 1 then phy set vehicle motor force id,300 : key = 1 : phy set vehicle wheel multiplier id,50
 if downkey ( ) = 1 then phy set vehicle motor force id,-200.0 : key = 1 : phy set vehicle wheel multiplier id,-50
 if key = 0 then phy set vehicle motor force id, 0.0
 `
 rem steering
 steeringAngle# = phy get vehicle steering angle ( id )
 steeringDelta# = 0.25
 key = 0
 if keystate ( 205 ) = 1
  if steeringAngle# > ( -1.0 + steeringDelta# )
   steeringAngle# = steeringAngle# - ( steeringDelta# / 2 )
  endif
  key = 1
 endif
 if keystate ( 203 ) = 1
  if steeringAngle# < ( 1.0 - steeringDelta# )
   steeringAngle# = steeringAngle# + ( steeringDelta# / 2 )
  endif
  key = 1
 endif
 if key = 0
  if steeringAngle# > 0.0
   steeringAngle# = steeringAngle# - steeringDelta# * 2
   if steeringAngle# < 0
    steeringAngle# = 0.0
   endif
  endif
  if steeringAngle# < 0.0
   steeringAngle# = steeringAngle# + steeringDelta# * 2
   if steeringAngle# > 0
    steeringAngle# = 0.0
   endif
  endif
 endif
 phy set vehicle steering angle id, steeringAngle#
 phy set vehicle steering value id, -( steeringAngle# * 45 )
 `
return

drawabox:
`if loc(0)>0

`ink rgb(255,0,0),0
`line  object screen x(drawstartobject+loc(0))-300,object screen y(drawstartobject+loc(0))-baseheight#,object screen x(drawstartobject+loc(0))+300 ,object screen y(drawstartobject+loc(0))-baseheight#
`endif
if loc(3)>3
isindragbox()
    makebox()
`ink rgb(0,0,255),0
`line object screen x(id)-300,object screen y(id)-object size y(id),object screen x(id)+300 ,object screen y(id)-object size y(id)

endif



return
remstart
function makezoom(zdist#)
`if camz#>10.0 then camz#=-10.0
local olddist#
`inc camz#,1
`text 0,300,str$(camz#)
if loc(3)<>1 then exitfunction
if olddist#<>zdist#
dragbox(1)=dragbox(1)-zdist#:`x
dragbox(2)=dragbox(2)-zdist#:`y
dragbox(3)=dragbox(3)+zdist#:`x
dragbox(4)=dragbox(4)-zdist#:`y
dragbox(5)=dragbox(5)+zdist#:`x
dragbox(6)=dragbox(6)+zdist#:`y
dragbox(7)=dragbox(7)-zdist#:`x
dragbox(8)=dragbox(8)+zdist#:`y
olddist#=zdist#
endif
makebox()
endfunction
remend

Rem ***** Main Source File *****
`set window on
`print "How to use the Windows file dialog":print

`Print "Choose a file on disk..."
`file$=getFileName("load","This is an open file dialog","Image BMP, GIF or JPG",".bmp;*.gif;*.jpg")
`print "Result: "+file$:print

`Print "Input file name for saving..."
`file$=getFileName("save","This is an save file dialog","Text file",".txt")
`print "Result: "+file$:print

`end

rem Show the file identification dialog
rem Parameters:
rem -------------
rem mode$: "load" or "save"
rem FileBoxTitle$: Title of the dialog. Must not contain the character "^" !
rem ShownFileFilter$: Determines what kind of file the user will be able to choose (visible for the user). Must not contain the character "^" !
rem                   It looks like this: "Image BMP, GIF, JPG".
rem RealFileFilter$: Determines what kind of file the user will be able to choose (used by the system). Must not contain the character "^" !
rem                   It looks like this: "*.bmp;*.gif;*.jpg".
rem The first is what the user will see.
rem The second is a list of filters (with ";" as separator).

function getFileName(mode$,FileBoxTitle$,ShownFileFilter$,RealFileFilter$)
   FileBoxTitle$ = FileBoxTitle$+"^"
   FileFilter$ = ShownFileFilter$+"^"+RealFileFilter$+"^^"

   rem Load the DLLs
   user32=findFreeDllSlot()
   load dll "user32.dll",user32
   kernel32=findFreeDllSlot()
   load dll "kernel32.dll",kernel32
   comdlg32=findFreeDllSlot()
   load dll "comdlg32.dll",comdlg32

   rem Offset Table OPENFILENAME Struct
   lStructSize       = 0
   hwndOwner         = 4
   hInstance         = 8
   lpstrFilter       = 12
   lpstrCustomFilter = 16
   nMaxCustFilter    = 20
   nFilterIndex      = 24
   lpstrFile         = 28
   nMaxFile          = 32
   lpstrFileTitle    = 36
   nMaxFileTitle     = 40
   lpstrInitialDir   = 44
   lpstrTitle        = 48
   Flags             = 52
   nFileOffset       = 56
   nFileExtension    = 58
   lpstrDefExt       = 60
   lCustData         = 64
   lpfnHook          = 68
   lpTemplateName    = 72
   StructEnd         = 76

   rem OPENFILENAME Flag Table
   OFN_ALLOWMULTISELECT       = 512:rem 0x00000200
   OFN_CREATEPROMPT           = 8192:rem 0x00002000
   OFN_ENABLEHOOK             = 32:rem 0x00000020
   OFN_ENABLETEMPLATE         = 64:rem 0x00000040
   OFN_ENABLETEMPLATEHANDLE   = 128:rem 0x00000080
   OFN_EXPLORER               = 524288:rem 0x00080000
   OFN_EXTENSIONDIFFERENT     = 1024:rem 0x00000400
   OFN_FILEMUSTEXIST          = 4096:rem 0x00001000
   OFN_HIDEREADONLY           = 4:rem 0x00000004
   OFN_LONGNAMES              = 2097152:rem 0x00200000
   OFN_NOCHANGEDIR            = 8:rem 0x00000008
   OFN_NODEREFERENCELINKS     = 1048576:rem 0x00100000
   OFN_NOLONGNAMES            = 262144:rem 0x00040000
   OFN_NONETWORKBUTTON        = 131072:rem 0x00020000
   OFN_NOREADONLYRETURN       = 32768:rem 0x00008000
   OFN_NOTESTFILECREATE       = 65536:rem 0x00010000
   OFN_NOVALIDATE             = 256:rem 0x00000100
   OFN_OVERWRITEPROMPT        = 2:rem 0x00000002
   OFN_PATHMUSTEXIST          = 2048:rem 0x00000800
   OFN_READONLY               = 1:rem 0x00000001
   OFN_SHAREAWARE             = 16384:rem 0x00004000
   OFN_SHOWHELP               = 16:rem 0x00000010

   rem FileBox Info
   FileBoxFlags   = OFN_EXPLORER + OFN_FILEMUSTEXIST + OFN_PATHMUSTEXIST + OFN_LONGNAMES + OFN_HIDEREADONLY + OFN_NONETWORKBUTTON
   PathBufferSize = 256
   hWnd           = call dll(user32,"GetActiveWindow")
   hMod           = call dll(kernel32,"GetModuleHandleA",0)

   rem Create necessary memblocks
   OFN_MB          = findFreeMemblockSlot()
   make memblock OFN_MB,StructEnd
   PathBuffer_MB   = findFreeMemblockSlot()
   make memblock PathBuffer_MB,PathBufferSize
   FileFilter_MB   = findFreeMemblockSlot()
   make memblock FileFilter_MB,len(FileFilter$)
   FileBoxTitle_MB = findFreeMemblockSlot()
   make memblock FileBoxTitle_MB,len(FileBoxTitle$)

   rem Get the memblocks pointers
   OFN          = get memblock ptr(OFN_MB)
   PathBuffer   = get memblock ptr(PathBuffer_MB)
   FileFilter   = get memblock ptr(FileFilter_MB)
   FileBoxTitle = get memblock ptr(FileBoxTitle_MB)

   rem write Strings to Memblock
   writeStringToMemblock(FileFilter_MB,FileFilter$)
   writeStringToMemblock(FileBoxTitle_MB,FileBoxTitle$)

   rem Write to OPENFILENAME Struct
   write memblock dword OFN_MB,lStructSize,StructEnd
   write memblock dword OFN_MB,hWndOwner,hWnd
   write memblock dword OFN_MB,hInstance,hMod
   write memblock dword OFN_MB,lpstrFilter,FileFilter
   write memblock dword OFN_MB,lpstrFile,PathBuffer
   write memblock dword OFN_MB,nMaxFile,PathBufferSize
   write memblock dword OFN_MB,Flags,FileBoxFlags
   write memblock dword OFN_MB,lpstrTitle,FileBoxTitle

   rem Open the FileBox
   if mode$="save"
      call dll comdlg32,"GetSaveFileNameA",OFN
   else
      call dll comdlg32,"GetOpenFileNameA",OFN
   endif
   result$ = readStringFromMemblock(PathBuffer_MB)

   rem Delete the memblocks
   delete memblock OFN_MB
   delete memblock PathBuffer_MB
   delete memblock FileFilter_MB
   delete memblock FileBoxTitle_MB

   rem Delete the DLL from the memory
   delete dll user32
   delete dll kernel32
   delete dll comdlg32

endfunction result$

rem Write a character string to the specified memblock
function writeStringToMemblock(numMemblock,text$)
   for pos=1 to len(text$)
      b=asc(mid$(text$,pos))
      if b=asc("^") then b=0
      write memblock byte numMemblock,pos-1,b
   next pos
endfunction

rem Read a character string from the specified memblock
function readStringFromMemblock(numMemblock)
   pos=0:text$=""
   do
      b=memblock byte(numMemblock,pos)
      if b=0 then exit
      text$=text$+chr$(b)
      inc pos
   loop
endfunction text$

rem Return the number of the first unused memblock
function findFreeMemblockSlot()
   found=0:numMemblock=1
   repeat
      if memblock exist(numMemblock)=0 then exitfunction numMemblock
      inc numMemblock
   until numMemblock=256
endfunction 0

rem Return the first free DLL slot
function findFreeDllSlot()
   found=0:numDLL=1
   repeat
      if dll exist(numDLL)=0 then exitfunction numDLL
      inc numDLL
   until numDLL=256
endfunction 0

  PHY ADD VEHICLE BODY ID, 1.37,0.22, 0.91, 0, 0.23, 0
PHY ADD VEHICLE WHEEL ID,5, 1.44, 0.46, 0.91, 0.45, 0.46, 0, 0 :`x3ds_Wheel_br
PHY ADD VEHICLE WHEEL ID,7, 1.44, 0.46, -0.91, 0.45, 0.46, 0, 1 :`x3ds_Wheel_bl
PHY ADD VEHICLE WHEEL ID,3, -1.30, 0.39, -0.89, 0.45, 0.39, 1, 0 :`x3ds_WHEEL_fr
PHY ADD VEHICLE WHEEL ID,9, -1.30, 0.39, 0.89, 0.45, 0.39, 1, 1 :`x3ds_WHEEL_fl

:[]:

Rem ***** Main Source File *****
Rem Project: DarkPhysXVechilesettins
Rem Created: 03/02/2009 09:05:34
sync on
sync rate 60
phy enable debug
phy start
sync on
sync rate 60
global tcx tcy zdist#
`tcx=screen width()/2
`tcy=screen height()/2
dim boxes(2) as float
dim dragbox(8) as float
dim r(8)
dim g(8)
dim b(8)
for i = 1 to 8
    r(i)=255
    g(i)=255
    b(i)=255
next i
rem click box size
boxes(1)=4
boxes(2)=4

global oldpath$
rem run oping credits when made.
set display mode 800,600,32
set text font "airal"
backdrop off
cls rgb(0,0,0)
set window layout 1,1,0
rem preview and keyword vars
global previewindex : previewindex=0
global previewline : previewline=0
global foundline : foundline=-1

global depth# baseheight# rooftop# width# baseheight#
global wheelid1 xrb# yrb# zrb# wheelradiusid1# bodyheightid1#
global wheelid2 xlb# ylb# zlb# wheelradiusid2# bodyheightid2#
global wheelid3 xrf# yrf# zrf# wheelradiusid3# bodyheightid3#
global wheelid4 xlf# ylf# zlf# wheelradiusid4# bodyheightid4#
global camdist#
rem values for limb sizer.
MinX as float
MinY as float
MinZ as float
MaxX as float
MaxY as float
MaxZ as float
MinXnow as float
MinYnow as float
MinZnow as float
MaxXnow as float
MaxYnow as float
MaxZnow as float

`Some variables containing the position of the camera in sphere coordinates
CamDist# = 10.0 :rem how far away from object
CamAngX# = 0.0 :rem start angles
CamAngY# = 0.0
`Target coordinates
TargetX# = 0.0
TargetY# = 0.0
TargetZ# = 0.0
`These variables make the camera rotation faster/slower
CamIntensityMouseZ# = 0.01
CamIntensityMouse#  = 0.5
CamIntensityKeys#   = 0.5
rem button click count
bcount=0
value as double float
rem Screen dimensions
gap=screen height()/10
topline=0
halfwidth =screen width()/2
middleline=screen width()/2
twothirds =screen width()/4-1
bottomline=screen height()
bottomcamscreen=screen height()-100
verthalfline=topline+((bottomcamscreen-topline)/2)
rightline =screen width()
displaymax=((bottomcamscreen-topline)/18)-2
valuesdisplaymax=((bottomcamscreen-(verthalfline+gap))/18)-2
displaywidthmax=((middleline-leftline)/10)-2
valuesdisplaywidthmax=((rightline-middleline)/10)-9
LookSens#=0.3

rem wlecome box
box screen width()/2-100,screen height()/2-50,screen width()/2+100,screen height()/2+50,rgb(0,0,255),rgb(0,200,255),rgb(0,0,255),rgb(0,200,255)
center text screen width()/2,screen height()/2-6,"Welcome to Dark PhysX Vehicle Setup"
center text screen width()/2,screen height()/2+6,"please pick your Vehicle to load"

sync
sync
delay=timer()+1500
repeat
until timer()>delay or inkey$()<>""

rem open file to get object
file$ = getFileName("load","Load in X model",".x .3ds","*.x;  *.3ds")

set camera view 0,twothirds,topline,rightline,bottomcamscreen
set camera aspect 0,(rightline-twothirds)/((bottomline-topline)+0.0)


backdrop on  : color backdrop 0,rgb(0,255,0)
make matrix 1,200,200,100,100
ink rgb(255,255,255),0
`print file$
`load the object
id= 2
load object file$,id




`make object cube 1,1
rem camera link
make object sphere 3,.1
`Make a mesh from the object
MAKE MESH FROM OBJECT 1,3
`Add a limb onto the object using the mesh we just made
ADD LIMB 3,1,1
`Offset the limb 700 units away
OFFSET LIMB 3,1,0,0,10-camz#
`Hide the limb for lag reduction
HIDE LIMB 3,1
`Hide the dummy object for lag reduction
HIDE OBJECT 3
ghost object on id,1
position matrix 1,-100,height#,-100
object=100
startobject=100

make object sphere 98,.1
make object box 97,.1,.1,1
make object cone 96,.2

make mesh from object 1,97
make mesh from object 2,96
hide object 97
hide object 96
add limb 98,1,1 :rem x pole
add limb 98,2,1 :rem y pole
add limb 98,3,1 :rem z pole
add limb 98,4,2
add limb 98,5,2
add limb 98,6,2

link limb 98,0,1
link limb 98,0,2
link limb 98,0,3

rem x pole
rotate limb 98,1,0,90,0
offset limb 98,1,.5,0,0
offset limb 98,4,1.1,0,0
rotate limb 98,4,0,0,-90
rem y pole
rotate limb 98,2,90,0,0
offset limb 98,2,0,.5,0
offset limb 98,5,0,1.1,0
rem z pole
rotate limb 98,3,0,0,-90
offset limb 98,3,0,0,.5
offset limb 98,6,0,0,1
rotate limb 98,6,90,0,0
hide object 97
   rem x y z pointer
lock object on 98
position object 98,-5,-5,10

backdrop on
dim loc(5)
dim wheel(4) as float
rem start of loop ++++++++++++++++++++++++++++++++++++++++++++
do

box 0,0,twothirds,bottomcamscreen,RGB(0,0,155),RGB(0,64,155),RGB(0,0,155),RGB(0,64,155)
box 0,bottomcamscreen,rightline,bottomline,rgb(255,255,255),rgb(255,255,255),rgb(255,255,255),rgb(255,255,255)
box 1,bottomcamscreen+1,rightline-1,bottomline-1,rgb(0,0,0),rgb(0,0,0),rgb(0,0,0),rgb(0,0,0)
ink rgb(255,255,255),0
set cursor 0,0
    mmx# = mousemovex()
    mmy# = mousemovey()
    mmz# = mousemovez()
    `Handle rotation
    gosub RotateCam
    gosub pickobject
if key<1
    repeat
        set cursor 0,0
        print "press key 1 to 4 Presenting model view?"
        print "1. Vehicle Back view."
        print "2. Vehicle Front view."
        print "3. Vehicle left side view."
        print "4. Vehicle Right side view."

        if inkey$()=>"1" and inkey$()<="4"
            key=val(inkey$())
        endif
        print "you picked ";key
        if key=1
`            rotate object id,0,90,0
`            fix object pivot id
            endif
        if key=2
            rotate object id,0,180,0
            fix object pivot id
        endif
        if key=3
            rotate object id,0,90,0
            fix object pivot id
        endif
        if key=4
            rotate object id,0,-90,0
            fix object pivot id
        endif
        gosub RotateCam
        sync
    until key>0
endif
`print "key=";key
rem make limbs list
print "Arrowkey to move camera about model"
print "< > to Zoom in and out. + - to move up/down list"
print "right button to move model and zoom in out"
print "left button to pick a model point"
print "LIMBS IN OBJECT"
rem get the list of limbs
gosub checklimbs
gosub listalimb

pt=1
for t = startobject to lastobject
if object exist(t)
 if object screen x(t)>twothirds
    ink rgb(255,255,255),0
    text object screen x(t),object screen y(t),str$(t-startobject+1)
    line object screen x(t),object screen y(t),object screen x(t),object screen y(t)-150
    ink RGB(128,0,255),0
    text object screen x(t),object screen y(t)-170+(pt*3),partname$(pt,0)
    inc pt
  endif
endif
next t

done=1
if bcount<5
ink 0,0
print "R to restart Wheel finding"
if keystate(19)=1
    bcount=0
    for r=1 to limbnumbrs
        partname$(r,1)="0"
    next t
endif
  ink rgb(255,255,255),0
if bcount=0
print "Find and click Right Back Wheel"
endif
if bcount=1
print "Find and cilck Left Back Wheel"
endif
if bcount=2
print "Find and click Right Front Wheel"
endif
if bcount=3
print "Find and click Left Front wheel"
endif
if bcount=4
print "Find and click Left Front suppenion"
endif
endif
drawstartobject=99
for bb= 0 to 4
`print loc(bb)
if bb=0 and loc(bb)<>0
line object screen x(drawstartobject+loc(bb)),object screen y(drawstartobject+loc(bb)),object screen x(drawstartobject+loc(bb)),object screen y(drawstartobject+loc(bb))+100
endif
if bb=1 and loc(bb)<>0
    line object screen x(drawstartobject+loc(bb)),object screen y(drawstartobject+loc(bb)),object screen x(drawstartobject+loc(bb)),object screen y(drawstartobject+loc(bb))+100
    rem lik line
    line object screen x(drawstartobject+loc(bb)),object screen y(drawstartobject+loc(bb))+90,object screen x(drawstartobject+loc(bb-1)),object screen y(drawstartobject+loc(bb-1))+90
    width# = ObjDistToObj(drawstartobject+loc(bb), drawstartobject+loc(bb-1))
    ink RGB(128,0,255),0
    center text (object screen x(drawstartobject+loc(bb))+ object screen x(drawstartobject+loc(bb-1)))/2,(object screen y(drawstartobject+loc(bb))+ object screen y(drawstartobject+loc(bb-1)))/2+95,str$(width#,4)
    ink rgb(255,255,255),0
endif
If bb=2 and loc(bb)<>0
    line object screen x(drawstartobject+loc(bb)),object screen y(drawstartobject+loc(bb)),object screen x(drawstartobject+loc(bb)),object screen y(drawstartobject+loc(bb))+100
    rem join line
    line object screen x(drawstartobject+loc(bb)),object screen y(drawstartobject+loc(bb))+90,object screen x(drawstartobject+loc(bb-2)),object screen y(drawstartobject+loc(bb-2))+90
    depth# = ObjDistToObj(drawstartobject+loc(bb), drawstartobject+loc(bb-2))
    ink RGB(128,0,255),0
    center text (object screen x(drawstartobject+loc(bb))+ object screen x(drawstartobject+loc(bb-2)))/2,(object screen y(drawstartobject+loc(bb))+ object screen y(drawstartobject+loc(bb-2)))/2+95,str$(depth#,4)
    ink rgb(255,255,255),0
 endif

If bb=3 and loc(bb)<>0
    line object screen x(drawstartobject+loc(bb)),object screen y(drawstartobject+loc(bb)),object screen x(drawstartobject+loc(bb)),object screen y(drawstartobject+loc(bb))+100
    rem join line
    line object screen x(drawstartobject+loc(bb)),object screen y(drawstartobject+loc(bb))+90,object screen x(drawstartobject+loc(bb-1)),object screen y(drawstartobject+loc(bb-1))+90
    bwidth# = ObjDistToObj(drawstartobject+loc(bb), drawstartobject+loc(bb-1))
    ink RGB(128,0,255),0
    center text (object screen x(drawstartobject+loc(bb))+ object screen x(drawstartobject+loc(bb-1)))/2,(object screen y(drawstartobject+loc(bb))+ object screen y(drawstartobject+loc(bb-1)))/2+95,str$(bwidth#,4)
    ink rgb(255,255,255),0
endif
rem set the PhysX xyz position of wheels to  VEHICLE BODY .
if loc(0)<>0
xrb#=abs(object position x(id)-object position x (drawstartobject+loc(0)))
yrb#=abs(object position y (drawstartobject+loc(0))-object position y(id))
zrb#=abs(object position z (drawstartobject+loc(0))-object position z(id))
endif
if loc(1)<>0
xlb#=abs(object position x (drawstartobject+loc(1))-object position x(id))
ylb#=abs(object position y (drawstartobject+loc(1))-object position y(id))
zlb#=abs(object position z(id)-object position z (drawstartobject+loc(1)))
endif

if loc(2)<>0
xrf#=abs(object position x (drawstartobject+loc(2))-object position x(id))
yrf#=abs(object position y (drawstartobject+loc(2))-object position y(id))
zrf#=abs(object position z (drawstartobject+loc(2))-object position z(id))
endif
if loc(3)<>0
xlf#=abs(object position x(id)-object position x (drawstartobject+loc(3)))
ylf#=abs(object position y (drawstartobject+loc(3))-object position y(id))
zlf#=abs(object position z(id)-object position z (drawstartobject+loc(3)))
endif

next bb
if loc(3)<>0
for wl = 0 to 3
    numberlimb=loc(wl)
    gosub limbsize
    wheel(wl)=YSize#/2 :`+0.1

    next wl
endif
if loc(4)<>0
    numberlimb=loc(4)
    gosub limbsize
    sup#=ysize#
endif
if loc(1)<>0
originy# =object size y(id)
endif
if loc(3)>0
tcx=object screen x(id)
tcy=object screen y(id)
rem start positions
rem top left x,y
if bdrag<>1
bdrag=1
dragbox(1)=tcx-15
dragbox(2)=tcy-15
rem top right x,y
dragbox(3)=tcx+15
dragbox(4)=tcy-15
rem bottom right x,y
dragbox(5)=tcx+15
dragbox(6)=tcy+15
rem bottom left x,y
dragbox(7)=tcx-15
dragbox(8)=tcy+15
endif
endif
`gosub drawabox
    if loc(3)<>0 and made<>1
        made=1

        baseheight# = wheel(0): rem radius of wheel

        `make object box 50,width#,originy#-baseheight#,depth#
        height#=object size y(id)
        width#=object size x(id)
        depth#=object size z(id)
        make object box 50,width#,height#,depth#
        SET OBJECT WIREFRAME 50,1
        position object 50,0,(height#/2)-(baseheight#*2),0
        rooftop#=height#-baseheight#
    endif
ink rgb(255,255,255),0

text 10,bottomcamscreen+12,"PHY ADD VEHICLE BODY ID "+str$(depth#/2,2)+","+str$(rooftop#-baseheight#,2)+","+str$(width#/2,2)+", 0,"+str$(sup#,2)+", 0"
mesg5$="PHY ADD VEHICLE BODY ID "+str$(depth#/2,2)+","+str$(rooftop#-baseheight#,2)+","+str$(width#/2,2)+", 0,"+str$(sup#,2)+",0"
text 10,bottomcamscreen+12*2,"PHY SET VEHICLE WHEEL RADIUS ID,Back Right,"+str$(wheel(0),2)
text 10,bottomcamscreen+12*3,"PHY SET VEHICLE WHEEL RADIUS ID,Back Left ,"+str$(wheel(1),2)
text 10,bottomcamscreen+12*4,"PHY SET VEHICLE WHEEL RADIUS ID,Front Right,"+str$(wheel(2),2)
text 10,bottomcamscreen+12*5,"PHY SET VEHICLE WHEEL RADIUS ID,Front Left,"+str$(wheel(3),2)
text 10,bottomcamscreen+12*6,"PHY SET VEHICLE WHEEL ROTATION ID, wheel, direction"
text 10,bottomcamscreen+12*7,"PHY SET VEHICLE WHEEL POWER ID, front, rear"
if loc(0)<>0

text 300,bottomcamscreen+12*1,"PHY ADD VEHICLE WHEEL ID,"+str$(loc(0),0)+", "+str$(xrb#,2)+", "+str$(yrb#,2)+", "+str$(zrb#,2)+", "+ str$(wheel(0),2)+", "+str$( object position y(drawstartobject+loc(0))*2,2)+", 0, 0 "+partname$(loc(0),0)

wheelid1=loc(0):wheelradiusid1#=wheel(0):bodyheightid1#=object position y(drawstartobject+loc(0))*2

mesg1$="PHY ADD VEHICLE WHEEL ID,"+str$(loc(0),0)+", "+str$(xrb#,2)+", "+str$(yrb#,2)+", "+str$(zrb#,2)+", "+ str$(wheel(0),2)+", "+str$( object position y(drawstartobject+loc(0))*2,2)+", 0, 0 :`"+partname$(loc(0),0)
endif
if loc(1)<>0
text 300,bottomcamscreen+12*2,"PHY ADD VEHICLE WHEEL ID,"+str$(loc(1),0)+", "+str$(xlb#,2)+", "+str$(ylb#,2)+", -"+str$(zlb#,2)+", "+ str$(wheel(1),2)+", "+str$( object position y(drawstartobject+loc(1))*2,2)+", 0, 1 "+partname$(loc(1),0)

wheelid2=loc(1):wheelradiusid2#=wheel(1):bodyheightid2#=object position y(drawstartobject+loc(1))*2

mesg2$="PHY ADD VEHICLE WHEEL ID,"+str$(loc(1),0)+", "+str$(xlb#,2)+", "+str$(ylb#,2)+", -"+str$(zlb#,2)+", "+ str$(wheel(1),2)+", "+str$( object position y(drawstartobject+loc(1))*2,2)+", 0, 1 :`"+partname$(loc(1),0)
endif
if loc(2)<>0
text 300,bottomcamscreen+12*3,"PHY ADD VEHICLE WHEEL ID,"+str$(loc(2),0)+", -"+str$(xrf#,2)+", "+str$(yrf#,2)+", -"+str$(zrf#,2)+", "+ str$(wheel(2),2)+", "+str$( object position y(drawstartobject+loc(2))*2,2)+", 1, 0 "+partname$(loc(2),0)

wheelid3=loc(2):wheelradiusid3#=wheel(2):bodyheightid3#=object position y(drawstartobject+loc(2))*2

mesg3$="PHY ADD VEHICLE WHEEL ID,"+str$(loc(2),0)+", -"+str$(xrf#,2)+", "+str$(yrf#,2)+", -"+str$(zrf#,2)+", "+ str$(wheel(2),2)+", "+str$( object position y(drawstartobject+loc(2))*2,2)+", 1, 0 :`"+partname$(loc(2),0)
endif
if loc(3)<>0
text 300,bottomcamscreen+12*4,"PHY ADD VEHICLE WHEEL ID,"+str$(loc(3),0)+", -"+str$(xlf#,2)+", "+str$(ylf#,2)+", "+str$(zlf#,2)+", "+ str$(wheel(3),2)+", "+str$( object position y(drawstartobject+loc(3))*2,2)+", 1, 1 "+partname$(loc(3),0)

wheelid4=loc(3):wheelradiusid4#=wheel(3):bodyheightid4#=object position y(drawstartobject+loc(3))*2

mesg4$="PHY ADD VEHICLE WHEEL ID,"+str$(loc(3),0)+", -"+str$(xlf#,2)+", "+str$(ylf#,2)+", "+str$(zlf#,2)+", "+ str$(wheel(3),2)+", "+str$( object position y(drawstartobject+loc(3))*2,2)+", 1, 1 :`"+partname$(loc(3),0)
endif
`phy add vehicle wheel 1, 5,  1.5, 0.3,  1.1, 0.6, 0.2, 0, 0

`phy add vehicle wheel 1, 7,  1.5, 0.3, -1.1, 0.6, 0.2, 0, 1

`phy add vehicle wheel 1, 3, -1.5, 0.3, -1.1, 0.6, 0.2, 1, 0

`phy add vehicle wheel 1, 9, -1.5, 0.3,  1.1, 0.6, 0.2, 1, 1
if loc(3)<>0
text 10,100-12,"load to clipboard ready  <press C>"
if keystate(46)
WRITE TO CLIPBOARD mesg5$+chr$(13)+chr$(10)+mesg1$+chr$(13)+chr$(10)+mesg2$+chr$(13)+chr$(10)+mesg3$+chr$(13)+chr$(10)+mesg4$
endif
endif
if loc(3)<>0
text 10,100-24,"jump in and drive ready."
if keystate(36)
goto jumpin
endif
endif
text 400,100,str$(camz#)
   sync
loop

listalimb:
 rem control
 ink rgb(225,225,255),0
 if scancode()=33 and enterkeyword=0 then enterkeyword=1 : clear entry buffer
 if scancode()=49 and nextkeyword=0 and pressed=0 then nextkeyword=2 : pressed=timer() : nextprompt=10
 if nextkeyword=3 then nextkeyword=2
 if nextkeyword<>0 or previewline<>showpreviewline or nextprompt>0
  rem prompt next search
 if nextprompt>0 then dec nextprompt

 else
   if scancode()=0 then pressed=0
   if pressed<>0 and timer()-pressed>150 and scancode()<>49 then pressed=0
   if pressed=0
    if keystate(12)=1 and high>1 then dec high : pressed=timer() : foundline=-1
    if keystate(13)=1 and high<listindex then inc high : pressed=timer() : foundline=-1
    if keystate(26)=1 then move object left 1,1
    if keystate(27)=1 then move object right 1,1
if keystate(25)=1 then roll object left 1,1
    if keystate(39)=1 then roll object right 1,1



    if keystate(201)=1 and high>1
     dec high,30 : pressed=timer() : foundline=-1
     if high<1 then high=1
    endif
    if keystate(209)=1 and high<listindex
     inc high,30 : pressed=timer() : foundline=-1
     if high>listindex then high=listindex
    endif

   endif
  endif



 rem control preview
 scrollpos=high-5
 if scrollpos<1 then scrollpos=1
 if high<>previewindex
  previewindex=high
  previewline=0
  showpreviewline=0

 endif

 rem display
 ink rgb(225,225,255),0
 text 10,100,"    Viewing Limbs "+str$(high)+" of "+str$(listindex)
 scrollposmax=scrollpos+10
 if scrollposmax>listindex then scrollposmax=listindex
 ly=0
 for i=scrollpos to scrollposmax
if partname$(i,1)="1"
    ink rgb(255,255,255),0
  else
   ink rgb(105,105,155),0
  endif

 text 5,112+ly,"limb "+str$(i)+" name ="+partname$(i,0)
  `text 10,112+ly,str$(i-1)+"  "+list$(i,0)+"    "
  inc ly,12
`if i<>0 or i>limbnumbrs
text 5,112+ly,"  x:"+str$(limb position x(id,i),2)+" y:"+str$(limb position y(id,i),2)+" z:"+str$(limb position z(id,i),2)
`inc ly,12
  if limb exist(id,i)
        if done<>1
            partname$(i,2)=str$(object)
            make object sphere object,0.2
            position object object,limb position x(id,i),limb position y(id,i),limb position z(id,i)
            inc object
        endif
        lastobject=object
        endif
text 5,112+ly,"  x:"+str$(limb position x(id,i),2)+" y:"+str$(limb position y(id,i),2)+" z:"+str$(limb position z(id,i),2)
   ` text 10,112+ly,"x:"+str$(limb position x(1,i),2)+" y:"+str$(limb position y(1,i),2)+" z:"+str$(limb position z(1,i),2)
    inc ly,12
  `endif
  if high=i
    ink rgb(255,255,255),0
  else
   ink rgb(105,105,155),0
  endif

  line 10,112+ly,200,112+ly
if object exist(99+1)
    line 200,112+ly,object screen x(99+i),object screen y(99+i)
    endif
  inc  ly,12
 next i
 return

matrixhieght:
if done<>1
    done=1
    repeat
        if downkey()=1
            height#=height#+0.1
        endif
        if upkey()=1
            height#=height#-0.5
        endif
    rem set the martrix depth
    position matrix 1,-100,height#,-100
    until returnkey()=1
endif
return

`Rotate camera
RotateCam:
    gosub RotateCamMouse
    gosub RotateCamKeys
    gosub UpdateCam
    gosub update3Dpointer
return

`Rotation through mouse
RotateCamMouse:
    `If mouse is right-clicked
    if mouseclick() = 2
        `Allow rotation around the object
        CamAngX# = wrapvalue(CamAngX# + mmy# * CamIntensityMouse#)
        CamAngY# = wrapvalue(CamAngY# + mmx# * CamIntensityMouse#)
        Camdist# = wrapvalue(Camdist# - mmz# * CamIntensityMouseZ#)
`        makezoom(camdist#)
    endif
return

RotateCamKeys:
    `Allow keys to make camera rotate
    CamAngX# = wrapvalue(CamAngX# + (upkey() - downkey()) * CamIntensityKeys#)
    CamAngY# = wrapvalue(CamAngY# + (rightkey() - leftkey())*CamIntensityKeys#)
    Camdist# = wrapvalue(Camdist# + (keystate(51)- keystate(52))*CamIntensityKeys#)
zdist#=-camdist#
return

UpdateCam:
    `Calculate position
    CamX# = newxvalue(TargetX#, CamAngY#, cos(CamAngX#) * CamDist#)
    CamY# = sin(CamAngX#) * CamDist#
    CamZ# = newzvalue(TargetZ#, CamAngY#, cos(CamAngX#) * CamDist#)
    `Update camera
    position camera CamX#, CamY#, CamZ#
    point camera TargetX#, TargetY#, TargetZ#
return

update3Dpointer:
if  camAngX#>270 and  camAngX#<90
    rotate object 98,CamAngX#, CamAngY#, CamAngZ#
else
if camAngX#>90 and camAngX#<270
    rotate object 98,CamAngX#, CamAngY#, CamAngZ#-180
endif
    rotate object 98,CamAngX#, CamAngY#, CamAngZ#
endif
return

pickobject:
dd=0
ink 0,0
`text 300,40,str$(lastobject)+"    "+str$(lastpick)+"  "+str$(picked_object-drawstartobject)
`text 300,50,str$(pick object(mousex(),mousey(),startobject,lastobject))
ink rgb(255,255,255),0
if mouseclick()=0 then pickmode=0
    if mouseclick()=1
    if pick object(mousex(),mousey(),startobject,lastobject)>0

    if pickmode=0
        picked_object=pick object(mousex(),mousey(),drawstartobject,lastobject)
        d#=get pick distance()
        x#=get pick vector x():y#=get pick vector y():z#=get pick vector z()
        inc pickmode
        rem button click count
        if lastpick<>picked_object
            if partname$(picked_object-drawstartobject,1)<>"1"
                partname$(picked_object-drawstartobject,1)="1"
                loc(bcount)=picked_object-drawstartobject
                inc bcount
            endif
        endif
        lastpick=picked_object
    endif
    endif
endif

Return

function ObjDistToObj(Obj1 , Obj2 )
   dx# = object position x(Obj1) - object position x(Obj2)
   dy# = object position y(Obj1) - object position y(Obj2)
   dz# = object position z(Obj1) - object position z(Obj2)
   dx# = dx# * dx#
   dy# = dy# * dy#
   dz# = dz# * dz#
   Distn# = sqrt(dx# + dy# + dz#)
endfunction Distn#


checklimbs:
if cl=1 then return
    perform checklist for object limbs id
    limbnumbrs=checklist quantity()
    dim partname$(limbnumbrs,5)
    for c=1 to limbnumbrs
        partname$(checklist value a(c),0)=checklist string$(c)
        partname$(checklist value a(c),1)="0"
    next c
    listindex=limbnumbrs-1
    cl=1
return

limbsize:
lock vertexdata for limb id, numberlimb

MinX = get vertexdata position x(0)
MinY = get vertexdata position y(0)
MinZ = get vertexdata position z(0)
MaxX = get vertexdata position x(0)
MaxY = get vertexdata position y(0)
MaxZ = get vertexdata position z(0)

for i = get vertexdata vertex count() - 1 to 1 step -1
MinX = get vertexdata position x(i)
MinY = get vertexdata position y(i)
MinZ = get vertexdata position z(i)
MaxX = get vertexdata position x(i)
MaxY = get vertexdata position y(i)
MaxZ = get vertexdata position z(i)
if minX<minXnow
    minXnow=minX
endif
if miny<minynow
    minynow=miny
endif
if maxz<maxznow
    maxznow=maxz
endif
if maxX>maxXnow
    maxXnow=maxX
endif
if maxy>maxynow
    maxynow=maxy
endif
if maxz>maxznow
    maxznow=maxz
endif

next

unlock vertexdata

   XSize# = MaxXnow - MinXnow
   YSize# = MaxYnow - MinYnow
   ZSize# = MaxZnow - MinZnow
return
function makebox()
rem corners points
box dragbox(1)-boxes(1)-zdist#,dragbox(2)-boxes(2)-zdist#,dragbox(1)+boxes(1)-zdist#,dragbox(2)+boxes(2)-zdist#,rgb(r(1),g(1),b(1)),rgb(r(1),g(1),b(1)),rgb(r(1),g(1),b(1)),rgb(r(1),g(1),b(1))
box dragbox(3)-boxes(1)+zdist#,dragbox(4)-boxes(2)-zdist#,dragbox(3)+boxes(1)+zdist#,dragbox(4)+boxes(2)-zdist#,rgb(r(2),g(2),b(2)),rgb(r(2),g(2),b(2)),rgb(r(2),g(2),b(2)),rgb(r(2),g(2),b(2))
box dragbox(5)-boxes(1)+zdist#,dragbox(6)-boxes(2)+zdist#,dragbox(5)+boxes(1)+zdist#,dragbox(6)+boxes(2)+zdist#,rgb(r(3),g(3),b(3)),rgb(r(3),g(3),b(3)),rgb(r(3),g(3),b(3)),rgb(r(3),g(3),b(3))
box dragbox(7)-boxes(1)-zdist#,dragbox(8)-boxes(2)+zdist#,dragbox(7)+boxes(1)-zdist#,dragbox(8)+boxes(2)+zdist#,rgb(r(4),g(4),b(4)),rgb(r(4),g(4),b(4)),rgb(r(4),g(4),b(4)),rgb(r(4),g(4),b(4))

rem midpoint boxes
rem top
box (dragbox(1)-zdist#+dragbox(3)-zdist#)/2-boxes(1),(dragbox(1)-zdist#+dragbox(3)-zdist#)/2-boxes(2),(dragbox(1)-zdist#+dragbox(3)+zdist#)/2+boxes(1),(dragbox(2)+dragbox(4))/2+boxes(2),rgb(r(5),g(5),b(5)),rgb(r(5),g(5),b(5)),rgb(r(5),g(5),b(5)),rgb(r(5),g(5),b(5))
rem right
`box (dragbox(3)+dragbox(5)+zdist#)/2-boxes(1),(dragbox(4)+dragbox(6)-zdist#)/2-boxes(2),(dragbox(3)+dragbox(5)+zdist#)/2+boxes(1),(dragbox(4)+dragbox(6)+zdist#)/2+boxes(2),rgb(r(6),g(6),b(6)),rgb(r(6),g(6),b(6)),rgb(r(6),g(6),b(6)),rgb(r(6),g(6),b(6))
rem bottom
`box (dragbox(5)+dragbox(7)+zdist#)/2-boxes(1),(dragbox(6)+dragbox(8)-zdist#)/2-boxes(2),(dragbox(5)+dragbox(7)+zdist#)/2+boxes(1),(dragbox(6)+dragbox(8)+zdist#)/2+boxes(2),rgb(r(7),g(7),b(7)),rgb(r(7),g(7),b(7)),rgb(r(7),g(7),b(7)),rgb(r(7),g(7),b(7))
rem left
`box (dragbox(1)+dragbox(7)-zdist#)/2-boxes(1),(dragbox(8)+dragbox(2)-zdist#)/2-boxes(2),(dragbox(1)+dragbox(7)+zdist#)/2+boxes(1),(dragbox(8)+dragbox(2)+zdist#)/2+boxes(2),rgb(r(8),g(8),b(8)),rgb(r(8),g(8),b(8)),rgb(r(8),g(8),b(8)),rgb(r(8),g(8),b(8))

rem connecting lines
rem top
line dragbox(1)-zdist#,dragbox(2)-zdist#,dragbox(3)+zdist#,dragbox(4)-zdist#
rem right
line dragbox(3)+zdist#,dragbox(4)-zdist#,dragbox(5)+zdist#,dragbox(6)+zdist#
rem bottom
line dragbox(5)+zdist#,dragbox(6)+zdist#,dragbox(7)-zdist#,dragbox(8)+zdist#
rem left
line dragbox(7)-zdist#,dragbox(8)+zdist#,dragbox(1)-zdist#,dragbox(2)-zdist#

endfunction

function isindragbox()
mx=mousex()
my=mousey()

text 0,60,str$(mx)+"  "+str$(my)
for i = 1 to 8 step 2
text 0,0+(i*6),str$(dragbox(i) )+"   "+str$(dragbox(i+1) )
next i
if mx>dragbox(1)-boxes(1) and mx<dragbox(1)+boxes(1) and my>dragbox(2)-boxes(2) and my<dragbox(2)+boxes(2)
    r(1)=255:g(1)=0:b(1)=0
    while mouseclick()<>0
        drag(1,2)
    endwhile
else
    r(1)=255:g(1)=255:b(1)=255
endif
if mx>dragbox(3)-boxes(1) and mx<dragbox(3)+boxes(1) and my>dragbox(4)-boxes(2) and my<dragbox(4)+boxes(2)
    r(2)=255:g(2)=0:b(2)=0
    while mouseclick()<>0
        drag(3,4)
    endwhile
    else
    r(2)=255:g(2)=255:b(2)=255
endif
if mx>dragbox(5)-boxes(1) and mx<dragbox(5)+boxes(1) and my>dragbox(6)-boxes(2) and my<dragbox(6)+boxes(2)
    r(3)=255:g(3)=0:b(3)=0
    while mouseclick()<>0
        drag(5,6)
    endwhile
    else
    r(3)=255:g(3)=255:b(3)=255
endif
if mx>dragbox(7)-boxes(1) and mx<dragbox(7)+boxes(1) and my>dragbox(8)-boxes(2) and my<dragbox(8)+boxes(2)
    r(4)=255:g(4)=0:b(4)=0
    while mouseclick()<>0
        drag(7,8)
    endwhile
    else
    r(4)=255:g(4)=255:b(4)=255
endif
rem mid point boxes
if mx>(dragbox(1)+dragbox(3))/2-boxes(1) and  mx<(dragbox(1)+dragbox(3))/2+boxes(1) and my>(dragbox(2)+dragbox(4))/2-boxes(2) and my<(dragbox(2)+dragbox(4))/2+boxes(2)
    r(5)=255:g(5)=0:b(5)=0
    oldmy=my
    oldy1=dragbox(2)
    oldy2=dragbox(4)
    while mouseclick()<>0
`        cls
`        text 0,0,"draging on"
        my=mousey()
           dragbox(2)=oldy1+( my-oldmy)
        dragbox(4)= oldy2+(my -oldmy)
        makebox()
    sync
endwhile
else
    r(5)=255:g(5)=255:b(5)=255
endif

if mx>(dragbox(3)+dragbox(5))/2-boxes(1) and  mx<(dragbox(3)+dragbox(5))/2+boxes(1) and my>(dragbox(4)+dragbox(6))/2-boxes(2) and my<(dragbox(4)+dragbox(6))/2+boxes(2)
    r(6)=255:g(6)=0:b(6)=0
    oldmx=mx
    oldx1=dragbox(3)
    oldx2=dragbox(5)
    while mouseclick()<>0
`        cls
    `text 0,0,"draging on"
        mx=mousex()
           dragbox(3)=oldx1+(mx-oldmx)
        dragbox(5)= oldx2+(mx-oldmx)
        makebox()
    sync
endwhile
else
    r(6)=255:g(6)=255:b(6)=255
endif
if mx>(dragbox(5)+dragbox(7))/2-boxes(1) and  mx<(dragbox(5)+dragbox(7))/2+boxes(1) and my>(dragbox(6)+dragbox(8))/2-boxes(2) and my<(dragbox(6)+dragbox(8))/2+boxes(2)
    r(7)=255:g(7)=0:b(7)=0
    oldmy=my
    oldy1=dragbox(6)
    oldy2=dragbox(8)
while mouseclick()<>0
 `   cls
   ` text 0,0,"draging on"
        my=mousey()
        dragbox(6)=oldy1+( my-oldmy)
        dragbox(8)= oldy2+(my -oldmy)
        makebox()
    sync
endwhile
else
    r(7)=255:g(7)=255:b(7)=255
endif
if mx>(dragbox(7)+dragbox(1))/2-boxes(1) and  mx<(dragbox(7)+dragbox(1))/2+boxes(1) and my>(dragbox(8)+dragbox(2))/2-boxes(2) and my<(dragbox(8)+dragbox(2))/2+boxes(2)
    r(8)=255:g(8)=0:b(8)=0
oldmx=mx
    oldx1=dragbox(7)
    oldx2=dragbox(1)
    while mouseclick()<>0
`    cls
    `text 0,0,"draging on"
        mx=mousex()
             dragbox(7)=oldx1+( mx-oldmx)
          dragbox(1)= oldx2+(mx -oldmx)
        makebox()
        sync
endwhile
else
    r(8)=255:g(8)=255:b(8)=255
endif
endfunction

function drag(a,b)
`cls
`    text 0,0,"draging on"
        mx=mousex()
        my=mousey()
        dragbox(a)=mx
        dragbox(b)=my
        makebox()
sync
endfunction




jumpin:
rem Vehicle Physics
cls

set camera view 0,0,0,rightline,bottomline
`set camera aspect 0,0
DELETE OBJECTS 4, lastobject+1
`delete matrix 1
`delete object id
delete object 1
rem Lights and camera
make light 1 : set directional light 1, -5, -5, 5
position camera -20, 20, 25 : point camera 0, 10, 0
set camera fov 90
rem Load scene
set dir "C:\Program Files\Dark Basic Software\Dark Basic Professional\Projects\Dark Physics\Demos\Vehicles\Vehicle Arena\Scene"
load object "levelbank\testlevel\universe.dbo",1
scale object 1,10,10,10 :
phy make rigid body static mesh 1
set dir ".."
ghost object on id

id=2
rem Load buggy
`load object "beach.x", id
`load image "beachBu2.tga",2
`load image "dbprocubemap.dds",3
`texture object id,2
` set blend mapping on id,1,3,2,16
position object id, 15, 4, -25
`offset limb id,0,0,-0.5,0
if key=1
rotate limb id,0,0,-90,0
endif
if key=2
rotate limb id,0,0,90,0
endif
if key=3
rotate limb id,0,0,-90,0
endif
rem Be aware the vehicle width and length orientation
phy create vehicle id
PHY ADD VEHICLE BODY ID,depth#/2,rooftop#-baseheight#,width#/2, 0,sup#, 0

`PHY ADD VEHICLE BODY ID, (depth#+baseheight#)/2,rooftop#/2, width#/2, 0, baseheight# , 0
PHY ADD VEHICLE WHEEL ID,wheelid1, -xrb#, yrb#,-zrb#,wheelradiusid1#,bodyheightid1#, 1, 0
PHY ADD VEHICLE WHEEL ID,wheelid2, -xlb#,ylb#,zlb#,wheelradiusid2#,bodyheightid2#, 1, 1
PHY ADD VEHICLE WHEEL ID,wheelid3,xrf#,yrf#,zrf#,wheelradiusid3#,bodyheightid3#, 0, 0
PHY ADD VEHICLE WHEEL ID,wheelid4,xlf#, ylf#,-zlf#,wheelradiusid4#,bodyheightid4#, 0, 1

steeringDelta# = 0.1 :
phy set vehicle steering delta id, steeringDelta#
phy set vehicle max steering angle id, 0.4
phy set vehicle auto id, 1
phy set vehicle wheel multiplier id,0
phy set vehicle suspension spring id,100
phy build vehicle id

rem follower object invisible
`make object sphere 3,10 : hide object 3

rem Load logo sprite
`load image "logo.png", 100000
`sprite 1, 0, 600 - 60, 100000

` movement
g_fSpeed# = 0.05
g_fTurn#  = 0.3

rem Main
do
 rem Follow buggy
 position object 3,object position x(id),object position y(id),object position z(id)
 set object to object orientation 3,id
 move object 3,-100
 point object 3,object position x(id),object position y(id),object position z(id)
dist#=5.0 : high#=2.5 : angle#=object angle y(3)+90
set camera to follow object position x(id), object position y(id), object position z(id), angle#, dist#, high#, 1, 0
 `
 rem Control buggy
phy set vehicle motor force id,0.0
gosub driveCar
 `
 rem Update physics and screen
 phy update
 sync
 `
loop


driveCar:
 `
 rem movement
 key = 0
 if upkey ( ) = 1 then phy set vehicle motor force id,300 : key = 1 : phy set vehicle wheel multiplier id,50
 if downkey ( ) = 1 then phy set vehicle motor force id,-200.0 : key = 1 : phy set vehicle wheel multiplier id,-50
 if key = 0 then phy set vehicle motor force id, 0.0
 `
 rem steering
 steeringAngle# = phy get vehicle steering angle ( id )
 steeringDelta# = 0.25
 key = 0
 if keystate ( 205 ) = 1
  if steeringAngle# > ( -1.0 + steeringDelta# )
   steeringAngle# = steeringAngle# - ( steeringDelta# / 2 )
  endif
  key = 1
 endif
 if keystate ( 203 ) = 1
  if steeringAngle# < ( 1.0 - steeringDelta# )
   steeringAngle# = steeringAngle# + ( steeringDelta# / 2 )
  endif
  key = 1
 endif
 if key = 0
  if steeringAngle# > 0.0
   steeringAngle# = steeringAngle# - steeringDelta# * 2
   if steeringAngle# < 0
    steeringAngle# = 0.0
   endif
  endif
  if steeringAngle# < 0.0
   steeringAngle# = steeringAngle# + steeringDelta# * 2
   if steeringAngle# > 0
    steeringAngle# = 0.0
   endif
  endif
 endif
 phy set vehicle steering angle id, steeringAngle#
 phy set vehicle steering value id, -( steeringAngle# * 45 )
 `
return

drawabox:
`if loc(0)>0

`ink rgb(255,0,0),0
`line  object screen x(drawstartobject+loc(0))-300,object screen y(drawstartobject+loc(0))-baseheight#,object screen x(drawstartobject+loc(0))+300 ,object screen y(drawstartobject+loc(0))-baseheight#
`endif
if loc(3)>3
isindragbox()
    makebox()
`ink rgb(0,0,255),0
`line object screen x(id)-300,object screen y(id)-object size y(id),object screen x(id)+300 ,object screen y(id)-object size y(id)

endif



return
remstart
function makezoom(zdist#)
`if camz#>10.0 then camz#=-10.0
local olddist#
`inc camz#,1
`text 0,300,str$(camz#)
if loc(3)<>1 then exitfunction
if olddist#<>zdist#
dragbox(1)=dragbox(1)-zdist#:`x
dragbox(2)=dragbox(2)-zdist#:`y
dragbox(3)=dragbox(3)+zdist#:`x
dragbox(4)=dragbox(4)-zdist#:`y
dragbox(5)=dragbox(5)+zdist#:`x
dragbox(6)=dragbox(6)+zdist#:`y
dragbox(7)=dragbox(7)-zdist#:`x
dragbox(8)=dragbox(8)+zdist#:`y
olddist#=zdist#
endif
makebox()
endfunction
remend
Rem Project: filedialog
Rem Created: 04/02/2009 23:28:18

Rem ***** Main Source File *****
`set window on
`print "How to use the Windows file dialog":print

`Print "Choose a file on disk..."
`file$=getFileName("load","This is an open file dialog","Image BMP, GIF or JPG",".bmp;*.gif;*.jpg")
`print "Result: "+file$:print

`Print "Input file name for saving..."
`file$=getFileName("save","This is an save file dialog","Text file",".txt")
`print "Result: "+file$:print

`end

rem Show the file identification dialog
rem Parameters:
rem -------------
rem mode$: "load" or "save"
rem FileBoxTitle$: Title of the dialog. Must not contain the character "^" !
rem ShownFileFilter$: Determines what kind of file the user will be able to choose (visible for the user). Must not contain the character "^" !
rem                   It looks like this: "Image BMP, GIF, JPG".
rem RealFileFilter$: Determines what kind of file the user will be able to choose (used by the system). Must not contain the character "^" !
rem                   It looks like this: "*.bmp;*.gif;*.jpg".
rem The first is what the user will see.
rem The second is a list of filters (with ";" as separator).

function getFileName(mode$,FileBoxTitle$,ShownFileFilter$,RealFileFilter$)
   FileBoxTitle$ = FileBoxTitle$+"^"
   FileFilter$ = ShownFileFilter$+"^"+RealFileFilter$+"^^"

   rem Load the DLLs
   user32=findFreeDllSlot()
   load dll "user32.dll",user32
   kernel32=findFreeDllSlot()
   load dll "kernel32.dll",kernel32
   comdlg32=findFreeDllSlot()
   load dll "comdlg32.dll",comdlg32

   rem Offset Table OPENFILENAME Struct
   lStructSize       = 0
   hwndOwner         = 4
   hInstance         = 8
   lpstrFilter       = 12
   lpstrCustomFilter = 16
   nMaxCustFilter    = 20
   nFilterIndex      = 24
   lpstrFile         = 28
   nMaxFile          = 32
   lpstrFileTitle    = 36
   nMaxFileTitle     = 40
   lpstrInitialDir   = 44
   lpstrTitle        = 48
   Flags             = 52
   nFileOffset       = 56
   nFileExtension    = 58
   lpstrDefExt       = 60
   lCustData         = 64
   lpfnHook          = 68
   lpTemplateName    = 72
   StructEnd         = 76

   rem OPENFILENAME Flag Table
   OFN_ALLOWMULTISELECT       = 512:rem 0x00000200
   OFN_CREATEPROMPT           = 8192:rem 0x00002000
   OFN_ENABLEHOOK             = 32:rem 0x00000020
   OFN_ENABLETEMPLATE         = 64:rem 0x00000040
   OFN_ENABLETEMPLATEHANDLE   = 128:rem 0x00000080
   OFN_EXPLORER               = 524288:rem 0x00080000
   OFN_EXTENSIONDIFFERENT     = 1024:rem 0x00000400
   OFN_FILEMUSTEXIST          = 4096:rem 0x00001000
   OFN_HIDEREADONLY           = 4:rem 0x00000004
   OFN_LONGNAMES              = 2097152:rem 0x00200000
   OFN_NOCHANGEDIR            = 8:rem 0x00000008
   OFN_NODEREFERENCELINKS     = 1048576:rem 0x00100000
   OFN_NOLONGNAMES            = 262144:rem 0x00040000
   OFN_NONETWORKBUTTON        = 131072:rem 0x00020000
   OFN_NOREADONLYRETURN       = 32768:rem 0x00008000
   OFN_NOTESTFILECREATE       = 65536:rem 0x00010000
   OFN_NOVALIDATE             = 256:rem 0x00000100
   OFN_OVERWRITEPROMPT        = 2:rem 0x00000002
   OFN_PATHMUSTEXIST          = 2048:rem 0x00000800
   OFN_READONLY               = 1:rem 0x00000001
   OFN_SHAREAWARE             = 16384:rem 0x00004000
   OFN_SHOWHELP               = 16:rem 0x00000010

   rem FileBox Info
   FileBoxFlags   = OFN_EXPLORER + OFN_FILEMUSTEXIST + OFN_PATHMUSTEXIST + OFN_LONGNAMES + OFN_HIDEREADONLY + OFN_NONETWORKBUTTON
   PathBufferSize = 256
   hWnd           = call dll(user32,"GetActiveWindow")
   hMod           = call dll(kernel32,"GetModuleHandleA",0)

   rem Create necessary memblocks
   OFN_MB          = findFreeMemblockSlot()
   make memblock OFN_MB,StructEnd
   PathBuffer_MB   = findFreeMemblockSlot()
   make memblock PathBuffer_MB,PathBufferSize
   FileFilter_MB   = findFreeMemblockSlot()
   make memblock FileFilter_MB,len(FileFilter$)
   FileBoxTitle_MB = findFreeMemblockSlot()
   make memblock FileBoxTitle_MB,len(FileBoxTitle$)

   rem Get the memblocks pointers
   OFN          = get memblock ptr(OFN_MB)
   PathBuffer   = get memblock ptr(PathBuffer_MB)
   FileFilter   = get memblock ptr(FileFilter_MB)
   FileBoxTitle = get memblock ptr(FileBoxTitle_MB)

   rem write Strings to Memblock
   writeStringToMemblock(FileFilter_MB,FileFilter$)
   writeStringToMemblock(FileBoxTitle_MB,FileBoxTitle$)

   rem Write to OPENFILENAME Struct
   write memblock dword OFN_MB,lStructSize,StructEnd
   write memblock dword OFN_MB,hWndOwner,hWnd
   write memblock dword OFN_MB,hInstance,hMod
   write memblock dword OFN_MB,lpstrFilter,FileFilter
   write memblock dword OFN_MB,lpstrFile,PathBuffer
   write memblock dword OFN_MB,nMaxFile,PathBufferSize
   write memblock dword OFN_MB,Flags,FileBoxFlags
   write memblock dword OFN_MB,lpstrTitle,FileBoxTitle

   rem Open the FileBox
   if mode$="save"
      call dll comdlg32,"GetSaveFileNameA",OFN
   else
      call dll comdlg32,"GetOpenFileNameA",OFN
   endif
   result$ = readStringFromMemblock(PathBuffer_MB)

   rem Delete the memblocks
   delete memblock OFN_MB
   delete memblock PathBuffer_MB
   delete memblock FileFilter_MB
   delete memblock FileBoxTitle_MB

   rem Delete the DLL from the memory
   delete dll user32
   delete dll kernel32
   delete dll comdlg32

endfunction result$

rem Write a character string to the specified memblock
function writeStringToMemblock(numMemblock,text$)
   for pos=1 to len(text$)
      b=asc(mid$(text$,pos))
      if b=asc("^") then b=0
      write memblock byte numMemblock,pos-1,b
   next pos
endfunction

rem Read a character string from the specified memblock
function readStringFromMemblock(numMemblock)
   pos=0:text$=""
   do
      b=memblock byte(numMemblock,pos)
      if b=0 then exit
      text$=text$+chr$(b)
      inc pos
   loop
endfunction text$

rem Return the number of the first unused memblock
function findFreeMemblockSlot()
   found=0:numMemblock=1
   repeat
      if memblock exist(numMemblock)=0 then exitfunction numMemblock
      inc numMemblock
   until numMemblock=256
endfunction 0

rem Return the first free DLL slot
function findFreeDllSlot()
   found=0:numDLL=1
   repeat
      if dll exist(numDLL)=0 then exitfunction numDLL
      inc numDLL
   until numDLL=256
endfunction 0

PHY ADD VEHICLE WHEEL ID, limb, x#, y#, z#, radius#, height#, location, direction

Rem Project: colorpick
Rem Created: 03/03/2009 17:07:53


Rem ***** Main Source File *****
sync on
sync rate 60


gosub pickcolor
Do

sync
Loop

pickcolor:
sw=screen width()
sh=screen height()
create bitmap 1,sw,sh

for p=0 to 255
RColor=rgb(p,0,0)
GColor=rgb(0,p,0)
BColor=rgb(0,0,p)
WColor=rgb(p,p,p)
box 0,0,sw,sh,BColor,RColor,GColor,WColor
next p
get image 1,0,0,sw,sh,1

set current bitmap 0

make object plain 1,5,5
lock object on 1
position object 1,0,0,20
texture object 1,1


repeat
color backdrop inkcolor

`paste image 1,0,0
color=point(mousex(),mousey())
if mouseclick()<>0
    done=1
    inkcolor=rgb(rgbr(color),rgbg(color),rgbb(color))
    Ink inkcolor,0
endif
Text 10,10,"Screen FPS: "+STR$(screen fps())
sync
until mouseclick()=2
delete object 1
return

` demonstrates simple creation of a vehicle

` set up program
phy enable debug
phy start
autocam off
sync on
sync rate 60
color backdrop 0
make light 1
set directional light 1, -5, -5, 5
position camera -20, 20, -25
point camera 0, 10, 0

` create ground
load image "road2.png", 1
make object box 1, 1000, 1, 1000
texture object 1, 1
phy make rigid body static box 1

` load car
load object "truck001.x", 2
load image "beachBu2.tga",2            `leave the textures so you can see the tire rotation
load image "dbprocubemap.dds",3
texture object 2,2
set blend mapping on 2,1,3,2,16
position object 2, 15, 2, -25
rotate limb 2,0,0,90,0    ` <----changed to positive 90 rather than -90

` set up vehicle
phy create vehicle 2
phy add vehicle body 2, 2.2, 0.6, 0.75, 0.0, 0.6, 0.0
phy add vehicle wheel 2, 5,  1.5, 0.3,  1.1, 0.6, 0.2, 0, 0   `<----limb are all set to 0
phy add vehicle wheel 2, 6,  1.5, 0.3, -1.1, 0.6, 0.2, 0, 0
phy add vehicle wheel 2, 3, -1.5, 0.3, -1.1, 0.6, 0.2, 1, 0
phy add vehicle wheel 2, 4, -1.5, 0.3,  1.1, 0.6, 0.2, 1, 0

PHY SET VEHICLE WHEEL ROTATION 2, 9, 2





phy set vehicle max motor 2, 200.0
phy set vehicle steering delta 2, 0.1
phy set vehicle max steering angle 2, 0.4
phy set vehicle auto 2, 1
phy set vehicle suspension spring 2,100
phy build vehicle 2

` display image
load image "logo.png", 100000
sprite 1, 0, 600 - 60, 100000

` main loop
do
   ` follow car
   set camera to follow object position x ( 2 ), object position y ( 2 ), object position z ( 2 ), 0, 6, 4, 1, 0

   ` update physics and screen
   phy update
   sync
loop 

REM Project: CarTesting
REM Created: 06.03.2009 19:33:35
REM
REM ***** Main Source File *****
REM

phy start
sync on
sync rate 60
load object "car.3ds",1
rem rotate object 1,0,180,0
rem fix object pivot 1

make light 1
position light 1,0,-300,0

position camera 150,-300,0
point camera 0,0,0

phy create vehicle 1
phy add vehicle body 1, 2, 2, 2, 0, 0, 0
PHY ADD VEHICLE BODY  1,1.94,28.67,1.46, 0,30.59,0
PHY ADD VEHICLE WHEEL 1,8, 2.08, 0.50, 1.29, 15.29, -1.00, 0, 0
PHY ADD VEHICLE WHEEL 1,1, 2.08, 0.50, -1.63, 15.29, -1.00, 0, 1
PHY ADD VEHICLE WHEEL 1,5, -1.80, 0.50, -1.29, 15.29, -1.00, 1, 0
PHY ADD VEHICLE WHEEL 1,3, -1.80, 0.50, 1.63, 15.29, -1.00, 1, 1

phy build vehicle 1

make object box 2,200,5,200
position object 2,0,-400,0
phy make rigid body static box 2
color object 2,rgb(0,255,0)

do

if keystate(17) then phy set vehicle motor force 1,5
if keystate(31) then phy set vehicle motor force 1,-5
if keystate(30) then phy set vehicle steering angle 1,-30
if keystate(32) then phy set vehicle steering angle 1,30
point camera object position x(1),object position y(1),object position z(1)

phy update
sync
loop

remstart

curw = 1
l = 1
waitlc = timer()

do

text 0,20, "wheelnr:"+str$(curw)
text 0,40, "wheelid:"+str$(l)

         if limb exist(1,l)
            point camera limb position x(1,l),limb position y(1,l),limb position z(1,l)
            color limb 1,l,rgb(rnd(255),rnd(255),rnd(255))
            if omc <> 1 and mouseclick()=1 then addwheel(curw,l) : inc curw : color limb 1,l,rgb(rnd(0),rnd(0),rnd(0))
         endif

     if upkey()=1 and timer() > waitlc+500 then inc l,1 : waitlc = timer()
     if downkey()=1 and timer() > waitlc+500 and l > 1 then dec l,1 : waitlc = timer()

   if mouseclick()=2 then goto fincar

omc = mouseclick()
sync
loop

fincar:

function addwheel(cur,l)
   select cur
      case 1
         phy add vehicle wheel 1, l, limb position x(1,l), limb position y(1,l),limb position z(1,l), 1, 1,0, 0
         global wheelB1 = l
      endcase
      case 2
         phy add vehicle wheel 1, l, limb position x(1,l), limb position y(1,l),limb position z(1,l), 1, 1,0, 0
         global wheelB2 = l
      endcase
      case 3
         phy add vehicle wheel 1, l, limb position x(1,l), limb position y(1,l),limb position z(1,l), 1, 1,1, 0
         global wheelF1 = l
      endcase
      case 4
         phy add vehicle wheel 1, l, limb position x(1,l), limb position y(1,l),limb position z(1,l), 1, 1,1, 0
         global wheelF2 = l
      endcase
   endselect
endfunction
remend