XModel by moqzart3rd Dec 2006 3:28
|
|---|
|
Summary Display 3D Models - no media required Description This will display any 3D models in a directory. It demonstrates how to use arrays and file system routines Code ` This code was downloaded from The Game Creators
` It is reproduced here with full permission
` http://www.thegamecreators.com
#constant DIK_0 11
#constant DIK_1 2
#constant DIK_2 3
#constant DIK_3 4
#constant DIK_4 5
#constant DIK_5 6
#constant DIK_6 7
#constant DIK_7 8
#constant DIK_8 9
#constant DIK_9 10
#constant DIK_A 30
#constant DIK_B 48
#constant DIK_C 46
#constant DIK_D 32
#constant DIK_E 18
#constant DIK_F 33
#constant DIK_G 34
#constant DIK_H 35
#constant DIK_I 23
#constant DIK_J 36
#constant DIK_K 37
#constant DIK_L 38
#constant DIK_M 50
#constant DIK_N 49
#constant DIK_O 24
#constant DIK_P 25
#constant DIK_Q 16
#constant DIK_R 19
#constant DIK_S 31
#constant DIK_T 20
#constant DIK_U 22
#constant DIK_V 47
#constant DIK_W 17
#constant DIK_X 45
#constant DIK_Y 21
#constant DIK_Z 44
#constant DIK_ADD 78
#constant DIK_SUBTRACT 74
#constant DIK_EQUALS 13
#constant DIK_MULTIPLY 55
#constant DIK_DIVIDE 181
#constant DIK_MINUS 12
#constant DIK_APOSTROPHE 40
#constant DIK_SLASH 53
#constant DIK_BACKSLASH 43
#constant DIK_CAPSLOCK 58
#constant DIK_CIRCUMFLEX 144
#constant DIK_COLON 146
#constant DIK_SEMICOLON 39
#constant DIK_COMMA 51
#constant DIK_DECIMAL 83
#constant DIK_UNDERLINE 147
#constant DIK_GRAVE 41
#constant DIK_BACKSPACE 14
#constant DIK_SPACE 57
#constant DIK_TAB 15
#constant DIK_HOME 199
#constant DIK_END 207
#constant DIK_INSERT 210
#constant DIK_DELETE 211
#constant DIK_UPARROW 200
#constant DIK_LEFTARROW 203
#constant DIK_RIGHTARROW 205
#constant DIK_DOWNARROW 208
#constant DIK_ESCAPE 1
#constant DIK_RETURN 28
#constant DIK_PAUSE 197
#constant DIK_PERIOD 52
#constant DIK_PGDN 209
#constant DIK_PGUP 201
#constant DIK_LALT 56
#constant DIK_RALT 184
#constant DIK_LBRACKET 26
#constant DIK_RBRACKET 27
#constant DIK_LCONTROL 29
#constant DIK_RCONTROL 157
#constant DIK_LMENU 56
#constant DIK_RMENU 184
#constant DIK_LSHIFT 42
#constant DIK_RSHIFT 54
#constant DIK_LWIN 219
#constant DIK_RWIN 220
#constant DIK_SCROLL 70
#constant DIK_SYSRQ 183
#constant DIK_F1 59
#constant DIK_F2 60
#constant DIK_F3 61
#constant DIK_F4 62
#constant DIK_F5 63
#constant DIK_F6 64
#constant DIK_F7 65
#constant DIK_F8 66
#constant DIK_F9 67
#constant DIK_F10 68
#constant DIK_F11 87
#constant DIK_F12 88
#constant DIK_F13 100
#constant DIK_F14 101
#constant DIK_F15 102
type objhdr
objf as string
name as string
desc as string
objn as integer
endtype
type _file
filetype as integer
filename as string
filedate as string
creation as string
endtype
global dim _directory() as _file
global dim obj_list() as objhdr
global showobjectbounds as boolean
global showwireframe as boolean
showobjectbounds = 0
showwireframe = 0
maxsize = 100000
if array count(obj_list())>-1 then empty array obj_list()
scrw = screen width()
scrh = screen height()
camx1 = 0
camx2 = scrw
camh = scrh * 0.75
camy1 = (scrh - camh) / 2
camy2 = camy1 + camh
cls 0
set text font "Lucida Console"
set text size 12
autocam off
sync rate 60
sync on
draw to front
color backdrop 0,0x000000
set camera range 0,1,maxsize*2
roll# = 1.0
turn# = 1.0
pitch# = 1.0
GetDirectory("models")
array index to queue _directory()
array index to queue obj_list()
rem Build Object List
while array index valid(_directory())
ext$ = lower$(GetFilenameExtension(_directory().filename))
select ext$
case ".x",".3ds",".dbo"
add to queue obj_list()
obj_list().objf = _directory().filename
obj_list().objn = FreeObject()
endcase
endselect
next array index _directory()
endwhile
array index to top obj_list()
do
if not object exist(obj_list().objn)
load object obj_list().objf,obj_list().objn
set object cull obj_list().objn,0
endif
obj = obj_list().objn
dist# = object size(obj)*2
position object obj,0,0,0
rotate object obj,345,0,330
position camera 0,0,0,-dist#
point camera 0,object position x(obj),object position y(obj),object position z(obj)
objf$ = obj_list().objf
objsize = object size(obj)
objsizex# = object size x(obj)
objsizey# = object size y(obj)
objsizez# = object size z(obj)
if showobjectbounds
show object bounds obj,1
else
hide object bounds obj
endif
if showwireframe
set object wireframe obj,1
else
set object wireframe obj,0
endif
do
sc = scancode()
select sc
case DIK_F1
repeat
until scancode() <> DIK_F1
showobjectbounds = not showobjectbounds
if showobjectbounds
show object bounds obj,1
else
hide object bounds obj
endif
endcase
case DIK_F2
repeat
until scancode() <> DIK_F2
showwireframe = not showwireframe
if showwireframe
set object wireframe obj,1
else
set object wireframe obj,0
endif
endcase
case DIK_BACKSPACE
repeat
until scancode() <> DIK_BACKSPACE
previous array index obj_list()
if not array index valid(obj_list()) then array index to bottom obj_list()
delete object obj
exit
endcase
case DIK_RETURN
repeat
until scancode() <> DIK_RETURN
next array index obj_list()
if not array index valid(obj_list()) then array index to top obj_list()
delete object obj
exit
endcase
case DIK_HOME
repeat
until scancode() <> DIK_HOME
array index to top obj_list()
delete object obj
exit
endcase
case DIK_END
repeat
until scancode() <> DIK_END
array index to bottom obj_list()
delete object obj
exit
endcase
case DIK_SPACE
repeat
until scancode() <> DIK_SPACE
rotate object obj,0,0,0
position camera 0,0,0,-dist#
point camera 0,object position x(obj),object position y(obj),object position z(obj)
endcase
case DIK_PGUP
move camera dist# / 100
endcase
case DIK_PGDN
move camera - (dist# / 100)
endcase
case DIK_LBRACKET
roll object left obj,1 + 14 * shiftkey()
endcase
case DIK_RBRACKET
roll object right obj,1 + 14 * shiftkey()
endcase
endselect
if leftkey() then turn object left obj,1 + 14 * shiftkey()
if rightkey() then turn object right obj,1 + 14 * shiftkey()
if upkey() then pitch object down obj,1 + 14 * shiftkey()
if downkey() then pitch object up obj,1 + 14 * shiftkey()
gosub _sync
loop
loop
_sync:
sync
box 0,0,scrw,camy1,rgb(64,0,0),rgb(0,64,0),rgb(0,0,64),rgb(64,64,0)
set text size 32
ty = 10
th = text height(" ")
center text scrw/2,ty,"XMODEL"
inc ty,th
set text size 12
center text scrw/2,ty,"by Moqzart"
ty = camy2
th = text height(" ")
box 0,camy2,scrw,scrh,rgb(64,0,0),rgb(0,64,0),rgb(0,0,64),rgb(64,64,0)
ink rgb(255,255,255),0
set text size 12
text 10,ty, "obj: " + str$(obj)
inc ty,th
text 10,ty, "file: " + objf$
inc ty,th
if objsize < 250
text 10,ty, "siz: " + right$(" " + str$(objsize),5) + " cm "
inc ty,th
text 10,ty, "wid: " + right$(" " + str$(int(objsizex#)),5) + " cm "
inc ty,th
text 10,ty, "hgt: " + right$(" " + str$(int(objsizey#)),5) + " cm "
inc ty,th
text 10,ty, "len: " + right$(" " + str$(int(objsizez#)),5) + " cm "
inc ty,th
text 10,ty, "dst: " + right$(" " + str$(int(abs(camera position z()))),5) + " cm "
else
text 10,ty, "siz: " + right$(" " + str$(objsize/100),5) + " m "
inc ty,th
text 10,ty, "wid: " + right$(" " + str$(int(objsizex#/100)),5) + " m "
inc ty,th
text 10,ty, "hgt: " + right$(" " + str$(int(objsizey#/100)),5) + " m "
inc ty,th
text 10,ty, "len: " + right$(" " + str$(int(objsizez#/100)),5) + " m "
inc ty,th
text 10,ty, "dst: " + right$(" " + str$(int(abs(camera position z())/100)),5) + " m "
endif
ty = camy2
text 160,ty, "angle x: " + right$(" " + str$(int(object angle x(obj))),5)
inc ty,th
text 160,ty, "angle y: " + right$(" " + str$(int(object angle y(obj))),5)
inc ty,th
text 160,ty, "angle z: " + right$(" " + str$(int(object angle z(obj))),5)
return
`============================================
`
`============================================
Function GetDirectory(d$)
if d$<>"" then set dir d$
if array count(_directory()) > -1 then empty array _directory()
find first
array index to queue _directory()
do
if get file type() = -1 then exit
add to queue _directory()
_directory().filename = get file name$()
_directory().filedate = get file date$()
_directory().creation = get file creation$()
_directory().filetype = get file type()
find next
loop
endfunction
`============================================
`
`============================================
function GetFilenameExtension(f$)
l=len(f$)
rv$=""
repeat
i$=mid$(f$,l)
rv$=i$+rv$
l=l-1
if l=0 then exit
until i$="."
endfunction rv$
`============================================
`
`============================================
function FreeObject()
n=0
repeat
inc n
i=object exist(n)
until i=0
endfunction n
|