Enhanced 3D Model Viewer by Nigel _Okgo15th Mar 2010 6:33
|
|---|
|
Summary Enhanced .X & .3DS Model Converter & Viewer Program.... This Program may convert .3DS Models to .X Format Models with Model Viewer, Recommended :- 3D Studio Max with an .X Description Other Code ` This code was downloaded from The Game Creators
` It is reproduced here with full permission
` http://www.thegamecreators.com
set display mode 1024,768,32
sync on
sync rate 0
fastsync
backdrop on
sync
dim FileNames$(255) as string
dim ListPosition(255) as integer
dim StType(255) as integer
NumberInList as integer
SaveFile as integer =0
SaveFileName$ as string=""
Object1=1
cd "f:Games ProgrammingProjectsObject ConverterObjects"
CheckDirectory:
cls
gosub CreateFileList
for t=1 to CLQuantity
if find first char$(FileNames$(t),".")<2
ListPosition(NumberInList)=t
StType(NumberInList)=0
NumberInList=NumberInList+1
endif
if FIND SUB STRING$(FileNames$(t),".3DS")>-1 or FIND SUB STRING$(FileNames$(t),".X")>-1 or FIND SUB STRING$(FileNames$(t),".MDL")>-1 or FIND SUB STRING$(FileNames$(t),".MD2")>-1 or FIND SUB STRING$(FileNames$(t),".MD3")>-1
ListPosition(NumberInList)=t
StType(NumberInList)=1
NumberInList=NumberInList+1
endif
next t
startdir=0
ShowDir:
cls
enddir=NumberInList-1
if (enddir-startdir)>20 then enddir=startdir+20
SET WINDOW TITLE GET DIR$()
for t=startdir to enddir
if StType(t)=0 then print "["+FileNames$(ListPosition(t))+"]"
if StType(t)=1 then print FileNames$(ListPosition(t))
filego$=filenames$(listposition(t))
next t
if SaveFile=1 then TEXT 0,432,"Save File As (no extension): "+SaveFileName$
if startdir>0 then TEXT 0,464,"{PREVIOUS}"
if enddir<(NumberInList-1) then TEXT 360,464,"{NEXT}"
sync
do
if MOUSECLICK()=1
while MOUSECLICK()=1
endwhile
MY=MOUSEY()/15
if (MY+startdir)<=enddir and MY<=20
if StType(MY+startdir)=0
cd FileNames$(ListPosition(MY+startdir))
goto CheckDirectory
endif
if StType(MY+startdir)=1
gosub prog1
cls
print "************** CONVERSION IN PROGRESS **************"
print "This may take some time depending on mesh complexity"
sync
load object FileNames$(ListPosition(MY+startdir)),Object1
SaveFile=1
goto ShowDir
endif
endif
if MY>20
if MOUSEX()>360 and enddir<NumberInList-1
startdir=startdir+21
goto ShowDir
endif
if MOUSEX()<360 and startdir>0
startdir=startdir-21
goto ShowDir
endif
endif
endif
if SaveFile=1
TEXT 0,432,"Save File As (no extension): "+SaveFileName$
for k=65 to 90
if GET KEY STATE(k)<0
while GET KEY STATE(k)<0
endwhile
SaveFileName$=SaveFileName$+chr$(k)
goto ShowDir
endif
next k
if GET KEY STATE(8)<0 `8=BACKSPACE
while GET KEY STATE(8)<0
endwhile
L=len(SaveFileName$)-1
Old$=SaveFileName$
SaveFileName$=""
for s=0 to L
SaveFileName$=SaveFileName$+mid$(Old$,s)
next s
goto ShowDir
endif
if GET KEY STATE(13)<0 `8=ENTER
while GET KEY STATE(13)<0
endwhile
SaveFileName$=SaveFileName$+".dbo"
save object SaveFileName$,Object1
delete object Object1
SaveFile=0
SaveFileName$=""
goto ShowDir
endif
endif
loop
if OBJECT EXIST(Object1)=1 then delete object Object1
end
CreateFileList:
NumberInList=0
perform checklist for files
CLQuantity=checklist quantity()
for t=1 to checklist quantity()
FileNames$(t)=UPPER$(checklist string$(t))
next t
return
prog1:
perform checklist for files
prog2:
for t=1 to checklist quantity()
filenames$(t)=upper$(checklist string$(t))
filego$=filenames$(t)
a$=right$(filego$,2)
if a$=".X" then goto prog3
next t
return
prog3:
load object filego$,101
cd "textures/"
prog6:
perform checklist for files
nm=0
prog7:
for t=1 to checklist quantity()
file$=upper$(checklist string$(t))
ok=0
if right$(file$,4)=".BMP" then ok=1
if ok=1 then nm=nm+1:filenames$(nm)=file$
next t
prog8:
for t=1 to nm
load image filenames$(t),200+t
next t
prog9:
sync
prog5:
cls rgb(0,0,0)
set ambient light 90
position camera 0,0,0
make object sphere 40,10
make object sphere 41,10
position object 40,0,0,2000
position object 41,0,0,2000
if ok=1 then texture object 41,201
position object 101,0,0,800
position camera 0,0,0
set object 101,1,0,0,1,1,0,1
for t=1 to nm
sprite t,t*100,500,200+t
size sprite t,80,80
next t
perform checklist for object limbs 101
nmgo=0
for t=1 to checklist quantity()
nmgo=nmgo+1
next t
scrx=-28
selectx=5
okgo1=0:okgo2=0
prog4:
for t=1 to nm
sprite t,scrx+t*100,640,200+t
next t
set text font "Arial"
set text size 28
set text to bold
ink rgb(0,0,255),rgb(0,0,255)
center text 511,718,"Object :- <>"
center text 511,743,"< > Select Texture, <Enter> Stretch Texture on Main Texture, <S> Save Object"
ink rgb(255,255,0),rgb(255,255,0)
center text 512,719,"Object :- <>"
center text 512,742,"< > Select Texture, <Enter> Stretch Texture on Main Texture, <S> Save Object"
if upkey()=1 then pitch camera up 2
if downkey()=1 then pitch camera down 2
if leftkey()=1 then turn camera left 2
if rightkey()=1 then turn camera right 2
if inkey$()="a" then move camera 20
if inkey$()="z" then move camera -20
okgo1=0
if inkey$()="," or inkey$()="<" then okgo1=1
if inkey$()="." or inkey$()=">" then okgo1=2
if inkey$()="" then okgo2=0
if okgo1>0 then okgo2=okgo2+1
if okgo2>4 then okgo2=0
if okgo1=1 and okgo2=1 and selectx>1 then selectx=selectx-1:scrx=scrx+100
if okgo1=2 and okgo2=1 and selectx<nm-1 then selectx=selectx+1:scrx=scrx-100
position object 40,camera position x(),camera position y(),camera position z()
set object to camera orientation 40
move object 40,280
hide object 40
position object 41,object position x(40),object position y(40),object position z(40)
set object to camera orientation 41
if object collision(41,101)=0 then if ok=1 then texture object 41,201
if object collision(41,101)=1 then if ok=1 and nm>1 then texture object 41,202
sync
goto prog4
` This code was downloaded from The Game Creators
` It is reproduced here with full permission
` http://www.thegamecreators.com
` Flight angles demo by David Lawrence ( muddleglum in the forums) September 2007.
` email - muddle (at) orcon.net.nz
` If you want a scientific simulator you will have to use a different system
` that works out the effects of rotation and position change seperately. ... but this method, using
` angular change to represent the forces, is simple, convincing to most appearances,
` and pleasingly natural to control for most uses.
` The method can be matched to specific aerodynamic factors,
` ie. scaling of turn radius to plane size, scaling of gravity,
` specific inertia , drag, control reaction rate according to speed or plane type,
` improved rudder yaw action etc etc. so that the whole system is almost
` indistinguishable from the scientific method.
` Note that this is a fixed frame rate method, which make a lot of things simpler, and does not
` normally cause a visual problem because of the smoothness of the movement.
` ` The essential flight rotation code is only two lines and without complicated maths -- much of the
` program is 'setting up'--- however, the imitation inertia inputs are an essential
` part of the natural feel. You also get a few simple but effective methods for power and views.
` Please use a joystick if you have one. It is much more satisfying.
` ( Use with a classic DB version later than 1.1 .. db pro should also work I believe,
` but my trial version just expired .. maybe minor changes?)
` -----------------------------------------------------------------------------------
` NOTE NOTE
` The simulation method contained in this code may be freely copied
`If found useful for commercial purposes acknowledgment would be nice, or even reward for this author!
` -------------------------------------------------------------------- ----------------------
`set up a world stuff
set display mode 1024,768,16
hide mouse
sync on
`make a ground texture
cls rgb(80,130,90)
ink rgb(90,110,60),0
for x=0 to 56
dot x,rnd(56):dot x,rnd(56):dot x,rnd(56):dot x,rnd(56)
dot x,rnd(56):dot x,rnd(56):dot x,rnd(56):dot x,rnd(56)
next x
ink rgb(70,120,70),0
for x=0 to 56
dot x,rnd(56):dot x,rnd(56):dot x,rnd(56):dot x,rnd(56)
dot x,rnd(56):dot x,rnd(56):dot x,rnd(56):dot x,rnd(56)
next x
ink rgb(95,115,90),0
for x=0 to 56
dot x,rnd(56):dot x,rnd(56):dot x,rnd(56):dot x,rnd(56)
dot x,rnd(56):dot x,rnd(56):dot x,rnd(56):dot x,rnd(56)
next x
get image 1,0,0,56,56
cls rgb(50,90,90)
sync rate 30
set camera range 1,9000
set camera view 25,55,1000,700
autocam off
make matrix 1,20000,20000,45,45
prepare matrix texture 1,1,2,2
randomize matrix 1,150.0
ink rgb(250,125,20),0
set cursor 10,1: print "F1 cockpit view"
set cursor 540,1: print "F4 follow view level"
set cursor 270,1: print "F2 follow view rolling"
set cursor 850,1:print "F3 fly by view"
set cursor 10, 18:print "A -accelerate , S slow"
set cursor 270,18:print "R reset position to start"
set cursor 540,18:print " arrow keys for roll/pitch"
set cursor 850,18:print "Q left yaw , W right yaw"
set cursor 10,36:print " J - use joystick control ... or .... ... K - use Arrow key controls(default)"
set cursor 540,36:print "Elevator is used to pull a sharp banked turn "
ink rgb(250,225,220),0
view=2
auto=0
control=0
`make an 'aircraft'
make object cube 4, 20
scale object 4,130,3,20
make object cone 5,25
scale object 5,8,600,400
pitch object down 5,90
fix object pivot 5
glue object to limb 5,4,0
color object 5,rgb(255,40,40)
set ambient light 30
fog on
fog color rgb(60,140,150)
color backdrop rgb(70,150,170)
fog distance 3500
sync on
direction#=0
climb#=0
speed# = 0
power#=2
position object 4, 3400,250,3200
rotate object 4,0,0,0
mainloop:
` ///////////////////////////////////////////-MAIN LOOP ////////////////////////////////
do
` if hit ground
if object position y(4) < get ground height(1,object position x(4), object position z(4))
set cursor 250,250
print "THUD! CRASH!"
position object 4,object position x(4),object position y(4)+20,object position z(4)
pitch object up 4,20
endif
` view control Inputs
if scancode()=59 then view =2 : ` F1
if scancode()=60 then view =0
if scancode()=62 then view =1
if scancode()=61 then view=3
` power input
if inkey$()="a" then power#=power#+.15
if power#>15 then power#=15
if inkey$()="s"
power#=power# -.2
if power#<0 then power#=0
endif
if inkey$()="j" then control =1
if inkey$()="k" then control=0
arrowkeycontrol:
if control =0
if rightkey() = 1 then rollstep#=rollstep#+.4
if leftkey() = 1 then rollstep#=rollstep#-.4
rollstep#=rollstep#*.9
roll object right 4,rollstep#:` basic aileron / roll action of plane.
if downkey() = 1 then pitchstep#=pitchstep#+.2
if upkey() = 1 then pitchstep#=pitchstep#-.2
pitchstep#=pitchstep#*.9
pitch object up 4, pitchstep#: `basic pitch action of plane
endif
alternatejoystick:
if control =1
joyr#=joystick x()/180.0
joyp#=joystick y()/180.0
` apply aileron
rollstep#=rollstep#+(joyr#/8) :` provides an intertia effect
rollstep#=rollstep#*.9 :` provides a damping effect.. a value like .95 or higher will also allow a
` wandering effect such as you get with some less laterally stable model aircraft.
roll object right 4,rollstep#:` basic aileron / roll action of plane
` apply elevator
pitchstep#=pitchstep#+(joyp#/20)
pitchstep#=pitchstep#*.9
pitch object up 4, pitchstep#
endif
` -----------------------------------------------------------
` the critical code follows ...
` -----------------------------------------------------
` get a roll angle related to WORLD horizontal. When the plane is tilted, pitched or turned this provides
` a result different from the plane relative roll angle. This difference makes the system work.
alt#=object position y(4)
turn object right 4,90
move object 4,1
sineroll#= object position y(4) -alt#
move object 4, -1
turn object left 4, 90
`then split the tilted lift vector of the wings between the WORLD horizontal and vertical axis using sineroll.
turn object left 4,sineroll#
pitch object up 4, abs(sineroll#)/2
` The above lines are the approximate lift split version, but are better for common use as they
` include a slight over elevation effect which require less pilot input.
` ----------------------
` The ACCURATE force split is shown just below .... BUT.. it is actually more demandng
` of the pilot , especially without the rest of a full code, and effects of wing/tailplane incidence at speed.
` The following may still be simple, but it was a giant and ORIGINAL effort to discover (geometric-graphically?).
` turn object left 4, sineroll#
` if sinroll#<0 then cotilt#=(1+sineroll#)*-1 else cotilt#=1-sineroll#
` pitch object up 4, (abs(sineroll#) - abs(sineroll#*cotilt#))
` The split code also imitates the gravity effect when the rolled wing loses vertical lift
` and the plane turns towards the ground. When correctly scaled to match a 1G turn radius ( which is
` when the height remains constant through the turn) with a correct forward speed increase for G
` then the turn downwards matches gravity quite accurately.
` ---------------------------
` then continue with some simple rudder yaw input -------- good for aiming at things ( a true yaw does not
` necessarily alter the plane flight direction as this does).
if inkey$()="w" then rudder#=rudder#+.1
if inkey$()="q" then rudder#=rudder#-.1
rudder#=rudder#*.9
turn object right 4,rudder#
` -------------If you want to add simple gravity and gliding effects ---------------
`get world related pitch.
move object 4,1
truepitch#= alt# -object position y(4)
move object 4, -1
gravity#=truepitch#*2 :` gravity can be accurately calculated against world scale and frame rate if desired.
` ie.. the speed increase exactly vertical ( without drag) should be an additional 32 ft every sec.
` You can simply add this each time and though it is fractionally different from the 'official'
` calculation over the first frames it is absolutely accurate therafter.
`add a cheap glide effect!
if speed#<2.5 and truepitch#<.3 then pitch object down 4,.15
` the nose down attitude will mean gravity# provides a basic glide speed# even with power at zero.
` -----------------------------------
` To do gliding 'properly' you need
` 1. a 'pitching up' that results from tailplane incidence and speed .. different degree for different designs.
` 2. a 'pitching down' that results from how far the planes center of gravity is ahead ( usually) of the `
` centre of lift of the wings. This pitching is 0 when pitch is vertical. max when horizontal.
` ie it matches the cosine of the pitch angle. Obtain with a 'move' similar to the pitch angle above.
` (This cosine is relative to the world again, since the drop from the wing being tilted /rolled
` is handled previously)
` 3. an accurate speed increase for gravity.
` 4. an accurate drag coeficient.
` The whole is a delicate and interactive balance. You can see its operation with a simple real
` model plane or nose weighted paper dart by dropping and throwing it in different ways.
` ( which is how I confirmed this theory. Then saw similar formula on the internet. )
` One thing I want to perfect later is the transition when elevator is used to hold the wing
` at a steeper angle (and greater drag) as the speed drops close to the wings stall speed and
` the inertia and/or propeller may still maintains a 'flare' for a short time.
` ------------------------------------
rem .... some basic speed control
coefdrag#=.05
drag#=coefdrag#*speed#*speed# : ` airdrag increases with square of airspeed and limits the maximum
speed#=speed#+gravity# + power#-drag#
if speed#<1 then speed#= 1 : ` because this demo has no stall routine etc.!
move object 4,speed#
` ................... camera views ....................
views:
if view =0
position camera object position x(4),object position y(4),object position z(4)
set camera to object orientation 4
pitch camera down 8
move camera -70
endif
if view=1
position camera object position x(4),object position y(4),object position z(4)
set camera to object orientation 4
pitch camera down 8
move camera -70
point camera object position x(4),object position y(4),object position z(4)
endif
if view=2
position camera object position x(4),object position y(4),object position z(4)
set camera to object orientation 4
endif
if view =3:` fly by view
if count<1
position camera object position x(4),object position y(4),object position z(4)
set camera to object orientation 4
move camera 100+(speed#*50)
if camera position y() < 120 then position camera camera position x(),130, camera position z()
count= 120
endif
dec count
point camera object position x(4),object position y(4),object position z(4)
endif
` reset to start position
if inkey$()="r"
speed# = 0
power#=2
position object 4, 3400,250,3200
rotate object 4,0,0,0
endif
set cursor 400,90
print "Power "; int(power#*10)
set cursor 400,110
print "Speed "; int(speed#)
sync
loop
rem you may Copy & Paste this Enhanced Code into DBPro, then Run & Compile the code to use the Program....
|