Hi All,
Some of you may find this usefull, it will take your model and output it to the screen and has a list of the limbs names with a line going to each limb.
like so:
Rem Project: Limbviewer
Rem Created: 07/02/2009 19:33:03
rem Thanks to Lee Bamber and his code snippet viewer which I modeifed to work in this
rem preview and keyword vars
global previewindex : previewindex=0
global previewline : previewline=0
global foundline : foundline=-1
`Some variables containing the position of the camera in sphere coordinates
CamDist# = 200.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 choose text font
set display mode 800,600,32,1
set text font "arial"
rem Init program
sync on :
sync rate 60
rem fix the camera
camz#=-10
`autocam off
rem load amodel
file$ = getFileName("load","Load in X model",".x","*.x")
load object file$,1
ghost object on 1,3
`position object 1,0,-25,10
rem make sphere to lock onto the limbs.
make object sphere 2,0.1
rem gather snippets
gosub checklimbs
rem set vars
high=1 : scrollpos=1
mainloop=1
noescapepause=0
do
text 0,0,"ADWS to rotate object."
text 0,12," p : [ ] to move object up down left right."
text 0,24,"< > to zoom in put."
text 0,36," = - to move up and down list page up down"
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
gosub RotateCam
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
ink rgb(105,105,155),0
text 10,112+ly,str$(i-1)+" "+list$(i,0)+" "
inc ly,12
if limb exist(1,i)
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
position object 2,limb position x(1,i),limb position y(1,i),limb position z(1,i)
line 200,112+ly,object screen x(2),object screen y(2)
inc ly,12
next i
rem update screen
sync : sleep 1
loop
end
checklimbs:
if cl=1 then return
perform checklist for object limbs 1
limbnumbrs=checklist quantity()
dim list$(limbnumbrs,5)
for c=1 to limbnumbrs
inc listindex
list$(checklist value a(c),0)=checklist string$(c)
list$(checklist value a(c),1)="0"
next c
cl=1
listindex=listindex-1
return
`Rotate camera
RotateCam:
` gosub RotateCamMouse
gosub RotateCamKeys
gosub UpdateCam
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#)
` endif
`return
RotateCamKeys:
`Allow keys to make camera rotate
CamAngX# = wrapvalue(CamAngX# + (keystate(17) - keystate(31)) * CamIntensityKeys#) :rem w s
CamAngY# = wrapvalue(CamAngY# + (keystate(32) - keystate(30))*CamIntensityKeys#) :rem a d
Camdist# = wrapvalue(Camdist# + (keystate(51)- keystate(52))*CamIntensityKeys#) :rem <>
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
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
Dark Physics makes any hot drink go cold.
