Code archives/3D Graphics - Misc/AnimB3D
This code has been declared by its author to be Public Domain code.
Download source code
| |||||
| The source for AnimB3D I put them as public-domain in the code archives because some people mailed me and some of the EMails are lost in the Spam-Filter from the provider. YOU must copy and paste the code together, because it is much too long for one text file. At the end is the keys.bb file, save them as extra file or manipulate the code to include them directly. There is a comment from cygnus between the source parts, recognize the end is the keys.bb file. put following line in user32.decls ScreenWH% (nIndex%) : "GetSystemMetrics" put following lines in kernel32.decls MemoryToBank(Destination*,Source,Length):"RtlMoveMemory" BankToMemory(Destination,Source*,Length):"RtlMoveMemory" | |||||
Include "C:\Blitz3d\userlibs\keys.bb"
;#Region Types
Type TEXS
Field name$
Field flags
Field blend
Field xpos#
Field ypos#
Field xscale#
Field yscale#
Field rot#
End Type
Global texs.texs
Type BRUS
Field name$
Field red#
Field green#
Field blue#
Field alpha#
Field shine#
Field blend
Field fx
Field texID[7]
End Type
Global brus.brus
Type VRTS
Field x#
Field y#
Field z#
Field nx#
Field ny#
Field nz#
Field red#
Field green#
Field blue#
Field alpha#
Field tex_coords#[32]
End Type
Global vrts.vrts
Type TRIS
Field brushid
Field vxbank
Field anztris
End Type
Global tris.tris
Dim CountVerts(1)
Global fsize, outoffile
Type node
Field name$
Field parent
Field parentHD
Field aktchild
Field childbank
Field anzchild
Field num
Field lastChild
Field ChunkNodeBank
Field VXanz
Field bonebank
Field KEYSflags
Field key1bank
Field key2bank
Field key3bank
Field nchunk$
Field nchunksize
Field nchunkFP
Field endchunkFP
Field posX#
Field posY#
Field posZ#
Field scaleX#
Field scaleY#
Field scaleZ#
Field rotW#
Field rotX#
Field rotY#
Field rotZ#
Field Bone
Field sphere
Field bsphere
Field spiv
Field bsphereparent
End Type
Dim Modus(100)
Dim outmode(6)
Dim wfi(6)
Dim wfmode(6)
;#End Region
;#Region Settings
; Settings
startup()
.start
Dim modus(0)
Dim merke(39)
SeedRnd MilliSecs()
bnx = CreateBank(100)
;Menu from East-Power-Soft
Dim Mnu$(20),MnuX(20);,MnuIcon(20,20) ;--> Menüeinträge, Position und Handle für Icons
;--> Hier den Wert 20 ändern wenn mehr Einträge benötigt werden
Dim FFRQ$(0)
Dim DFRQ$(0)
Dim frqSel$(0)
Dim Gtext$(49)
Global node.node
Dim tempArray(1)
Dim banks(1)
Global anzBanks = 0
Global KeyIsLoad = 0
Global FirstNodeHD
Global rotspeed# = 0.2
Global movespeed# = 0.02
Global scalespeed# = 0.02
Global rt1speed# = 0.05
Global mv1speed# = 0.005
Global sc1speed# = 0.005
Global rt2speed# = 0.2
Global mv2speed# = 0.02
Global sc2speed# = 0.02
Global rt3speed# = 0.4
Global mv3speed# = 0.04
Global sc3speed# = 0.04
Global fx = 16
Global aktualModus
Global differentVertexMode = 0
Global SaveFirstFrameNull = 0
Global FrameStart = 1
Local hasanim = 0
Global E_RM_mode = 1
Global aktbonespeed = 1
Global rotBonespeed# = 0.5
Global moveBonespeed# = 0.04
Global bonespeedS# = 0.005
Global bonespeedM# = 0.04
Global bonespeedF# = 0.1
Global scrnd# = 0.02
Global weight# = 1.0
Global machfarbig = 0
Local dummyname = 0
Local ERRORnode1 = 0
Local ERRORnode2 = 0
Local ErrorBONE = 0
Local ErrorKEYS = 0
Local ErrorFILEEND = 0
Global bonemodus = 1
font=LoadFont( "verdana",16 )
bigfont=LoadFont( "verdana",30 )
SetFont font
tex=CreateTexture(128,128,12)
SetBuffer TextureBuffer(tex)
Color 50,60,80
Rect 0,0,128,20,1
Rect 0,0,20,128
Color 100,120,140
Rect 0,5,128,10,1
Rect 5,0,10,128
ScaleTexture tex,0.001,0.001
plane=CreateCube()
ScaleEntity plane,1000,0.001,1000
EntityTexture plane,tex
;EntityOrder plane, 20
EntityAlpha plane,0.6
SetBuffer BackBuffer()
piv = CreatePivot()
PositionEntity piv, 0, 5, 0
camera = CreateCamera()
PositionEntity camera, 0, 0, -10
EntityParent Camera, piv, 0
CameraRange Camera, 0.01, 1000
light = CreateLight(1,piv)
PositionEntity light,0,0,-0
;light2 = CREATELIGHT(1,piv)
;Positionentity light2,-200,2,-200
;light3 = CREATELIGHT(1,piv)
;Positionentity light3,200,2,200
;light4 = CREATELIGHT(1,piv)
;Positionentity light4,-200,2,200
;Lightrange light,1000
RotateEntity light, 90, 0, 0
;ROTATEENTITY light2, 90, 90, 0
;ROTATEENTITY light3, 90, 180, 0
;ROTATEENTITY light4, 90, 270, 0
darky = CreateCube (camera)
EntityColor darky, 15,27,30
EntityAlpha darky,0.9
MoveEntity darky,0,0,2
EntityOrder darky, -20
HideEntity darky
rot = CreateBrush (255, 0, 0)
;BrushFX rot,1
BrushAlpha rot,0.7
gruen = CreateBrush (0, 255, 0)
;BrushFX gruen,1
BrushAlpha gruen,0.7
blau = CreateBrush (0, 0, 255)
;BrushFX blau,1
BrushAlpha blau,0.7
gelb = CreateBrush (255, 255, 0)
;BrushFX gelb,1
BrushAlpha gelb,0.7
hellblau = CreateBrush (0, 255, 255)
;BrushFX hellblau,1
BrushAlpha hellblau,0.7
violett = CreateBrush (255, 0, 255)
;BrushFX violett,1
BrushAlpha violett,0.7
weiss = CreateBrush (255, 255, 255)
;BrushFX weiss,1
BrushAlpha weiss,0.7
wg10 = CreateBrush(65,60,90)
;BrushFX wg10,1
BrushAlpha wg10,0.7
wg20 = CreateBrush(50,70,140)
;BrushFX wg20,1
BrushAlpha wg20,0.7
wg30 = CreateBrush(40,130,150)
;BrushFX wg30,1
BrushAlpha wg30,0.7
wg40 = CreateBrush(30,200,150)
;BrushFX wg40,1
BrushAlpha wg40,0.7
wg50 = CreateBrush(25,240,120)
;BrushFX wg50,1
BrushAlpha wg50,0.7
wg60 = CreateBrush(255,255,0)
;BrushFX wg60,1
BrushAlpha wg60,0.7
wg70 = CreateBrush(255,210,10)
;BrushFX wg70,1
BrushAlpha wg70,0.7
wg80 = CreateBrush(255,160,20)
;BrushFX wg80,1
BrushAlpha wg80,0.7
wg90 = CreateBrush(255,100,30)
;BrushFX wg90,1
BrushAlpha wg90,0.7
wg100 = CreateBrush(255,60,40)
;BrushFX wg100,1
BrushAlpha wg100,0.7
;Kreuz
xyz = CreateCube()
PositionMesh xyz,0,0,0
PaintMesh xyz,rot
ScaleMesh xyz,1,0.02,0.02
greenY =CreateCube()
PositionMesh greenY,0,0,0
PaintMesh greenY,gruen
ScaleMesh greenY,0.02,1,0.02
AddMesh greenY,xyz
FreeEntity greenY
blueZ = CreateCube()
PositionMesh blueZ,0,0,0
PaintMesh blueZ,blau
ScaleMesh blueZ,0.02,0.02,1
AddMesh blueZ,xyz
FreeEntity blueZ
;MoveEntity xyz,0,0,5
EntityAlpha xyz,0.5
;HideEntity xyz
EntityOrder XYZ,-10
ScaleEntity xyz,0.1,0.1,0.1
AppTitle "AnimB3D Version 057d Beta","Are you sure ? "
HidePointer
;Menu from East-Power-Soft
Global MnuBackC: MnuBackC=$033D4E ;--> Farbe Hintergrund (Menü) --- color background menu
Global MnuForeC: MnuForeC=$9CD1C7 ;--> Farbe Vordergrund (Menü) --- color foreground menu
Global MnuBorderH: MnuBorderH=$9CD1C7 ;--> Farbe SUB-Menü-Rahmen (hell) --- light color framework submenu
Global MnuBorderD: MnuBorderD=$347265 ;--> Farbe SUB-Menü-Rahmen (dunkel) --- dark color framework submenu
Global MnuBackM: MnuBackM=$B6BDD2 ;--> Farbe Hintergrund (Markierung) --- selection color background
Global MnuForeM: MnuForeM=$9CD1C7 ;--> Farbe Vordergrund (Markierung) --- selection color foreground
Global MnuBorderM: MnuBorderM=$4877BD ;--> Farbe Rahmen (Markierung) --- selection color framework
Global MnuPosX:MnuPosX=0 ;--> Menüversatz X (falls das Menü nicht oben links sitzen soll) --- menu-offset X
Global MnuPosY:MnuPosY=0 ;--> Menüversatz Y (falls das Menü nicht oben links sitzen soll) --- menu-offset Y
Global MnuState, MnuActiv ;--> Menüstatus, Submenü Aktivität
Global MnuFont
MnuFont=LoadFont("tahoma",13) ;--> empfohlene Schriftart
;Global Mouse: Mouse=LoadImage("system\mouse.png"):MaskImage Mouse,255,0,255
;
;#End Region
;#Region Load B3D
; Load Anim
.loadMeshAnim;
; Load the Mesh
Pfad$=CurrentDir$ ()
.dofilein
filename$ = ListDir$(Pfad$, " Select a B3D File","L","F",".b3d")
If Trim$(filename$) = ""
Goto auscl
ElseIf Instr(Upper(filename$) , ".B3D") = 0
Goto dofilein
EndIf
Pos=Instr (filename$, "\",1)
Repeat
Pos2 = Pos
If Pos > 0
Pos=Instr (filename$, "\",Pos+1)
EndIf
Until Pos = 0
If Pos2 > 0
pfad2$ = Left$ (filename$, Pos2)
ChangeDir pfad2$
EndIf
infile = ReadFile(filename$)
fsize = FileSize(filename$)
fn2$ = filename$
i = 0
theanim = LoadAnimMesh(filename$)
EntityFX theanim,0
savefilename$ = filename$
BB3Dchunk$ = Read4Char$(infile)
BB3Dchunksize = ReadInt( infile )
BB3Dversion = ReadInt( infile )
seqi = 0
boni = 0
keyi = 0
zmesh = 0
;HideEntity themesh
HideEntity theanim
gw = GraphicsWidth()
gh = GraphicsHeight()
gw2 = gw/2
gh2 = gh/2
;
Repeat
chunk$ = Read4Char$(infile)
Select chunk$
; CASE TEXS
Case "TEXS"
TEXSchunk$ = chunk$
TEXSchunksize = ReadInt( infile )
fp = FilePos( infile )
Repeat
texs.texs = New texs
;txhd = handle(texs)
texs\name = ReadNullString$(infile)
TEXS\flags = ReadInt( infile )
TEXS\blend = ReadInt( infile )
TEXS\xpos# = ReadFloat( infile )
TEXS\ypos# = ReadFloat( infile )
TEXS\xscale# = ReadFloat( infile )
TEXS\yscale# = ReadFloat( infile )
TEXS\rot# = ReadFloat( infile )
If FilePos( infile ) > fp+TEXSchunksize
RuntimeError "ERROR in TEXS chunk"
Exit
EndIf
Until FilePos( infile ) >= fp+TEXSchunksize
;
; CASE BRUS
Case "BRUS"
BRUSchunk$ = chunk$
BRUSchunksize = ReadInt( infile )
fp = FilePos( infile )
BRUSntexs = ReadInt( infile )
Repeat
brus.brus = New brus
;brhd = handle(brus)
;brus.brus = Object.brus(brhd)
BRUS\name$ = ReadNullString$(infile)
BRUS\red# = ReadFloat( infile )
BRUS\green# = ReadFloat( infile )
BRUS\blue# = ReadFloat( infile )
BRUS\alpha# = ReadFloat( infile )
BRUS\shine# = ReadFloat( infile )
BRUS\blend = ReadInt( infile )
BRUS\fx = ReadInt( infile )
For k = 0 To BRUSntexs-1
BRUS\texid[k] = ReadInt( infile )
Next
If FilePos( infile ) > fp+BRUSchunksize
RuntimeError "ERROR in BRUS chunk"
Exit
EndIf
Until FilePos( infile ) >= fp+BRUSchunksize
AnzBrush = i-1
;
; CASE MESH
Case "MESH"
If zmesh > 0
SetFont bigfont
st$ = "AnimB3D does not handle multiple MESH chunks"
ln = StringWidth(st$)
Text gw2-(ln/2),gh2, st$
SetFont font
Goto auscl
EndIf
MESHchunk$ = chunk$
MESHchunksize = ReadInt( infile )
MESHbrushID = ReadInt( infile )
zmesh = zmesh + 1
;
; CASE VRTS
Case "VRTS"
VRTSchunk$ = chunk$
VRTSchunksize = ReadInt( infile )
fp = FilePos( infile )
VRTSflags = ReadInt( infile )
VRTStex_coord_sets = ReadInt( infile )
VRTStex_coord_set_size = ReadInt( infile )
i = 0
Repeat
vrts.vrts = New vrts
VRTS\x# = ReadFloat( infile )
VRTS\y# = ReadFloat( infile )
VRTS\z# = ReadFloat( infile )
If VRTSflags And 1
VRTS\nx# = ReadFloat( infile )
VRTS\ny# = ReadFloat( infile )
VRTS\nz# = ReadFloat( infile )
EndIf
If VRTSflags And 2
VRTS\red# = ReadFloat( infile )
VRTS\green# = ReadFloat( infile )
VRTS\blue# = ReadFloat( infile )
VRTS\alpha# = ReadFloat( infile )
EndIf
For k = 0 To (VRTStex_coord_sets*VRTStex_coord_set_size)-1
VRTS\tex_coords#[k] = ReadFloat( infile )
Next
If FilePos( infile ) > fp+VRTSchunksize
RuntimeError "ERROR VRTS chunk too long"
Exit
EndIf
i = i+1
Until FilePos( infile ) >= fp+VRTSchunksize
AnzVert = i-1
i = 0
;
; CASE TRIS
Case "TRIS"
TRchunk$ = chunk$
TRchunksize = ReadInt( infile )
fp = FilePos( infile )
tris.tris = New tris
TRIS\brushid = ReadInt( infile )
TRIS\vxbank = CreateBank(0)
i = 0
Repeat
TRvertexID_1 = ReadInt( infile )
TRvertexID_2 = ReadInt( infile )
TRvertexID_3 = ReadInt( infile )
blocknum = AddBlockInt( TRIS\vxbank, 12, TRvertexID_1, 0 )
InsertBlockInt( TRIS\vxbank, blocknum, 12,TRvertexID_2, 4 )
InsertBlockInt( TRIS\vxbank, blocknum, 12, TRvertexID_3, 8 )
If FilePos( infile ) > fp+TRchunksize
RuntimeError "ERROR in TRIS chunk"
Exit
EndIf
i = i+1
Until FilePos( infile ) >= fp+TRchunksize
TRIS\AnzTris = i
i = 0
trisi = trisi+1
;
; CASE ANIM
Case "ANIM"
ANIMchunk$ = chunk$
ANIMchunksize = ReadInt( infile )
ANIMflags = ReadInt( infile )
ANIMframes = ReadInt( infile )
ANIMfps# = ReadFloat( infile )
hasanim = 1
;
; CASE NODE
Case "NODE"
If Countnode = 0
ROOTNODEchunk$ = chunk$
ROOTNODEchunksize = ReadInt( infile )
ROOTNODEchunkFP = ROOTNODEchunksize+FilePos( infile )
ROOTNODEname$ = ReadNullString$(infile)
ROOTNODEposX# = ReadFloat( infile )
ROOTNODEposY# = ReadFloat( infile )
ROOTNODEposZ# = ReadFloat( infile )
ROOTNODEscaleX# = ReadFloat( infile )
ROOTNODEscaleY# = ReadFloat( infile )
ROOTNODEscaleZ# = ReadFloat( infile )
ROOTNODErotW# = ReadFloat( infile )
ROOTNODErotX# = ReadFloat( infile )
ROOTNODErotY# = ReadFloat( infile )
ROOTNODErotZ# = ReadFloat( infile )
Else
TNchunk$ = chunk$
TNchunksize = ReadInt( infile )
TNchunkFP = TNchunksize+FilePos( infile )
TNname$ = ReadNullString$(infile)
If Trim$(TNname$) = ""
dummyname = dummyname + 1
If dummyname < 10
TNname$ = "Bone " + dummyname
ElseIf dummyname < 100
TNname$ = "Bone " + dummyname
Else
TNname$ = "Bone" + dummyname
EndIf
EndIf
TNposX# = ReadFloat( infile )
TNposY# = ReadFloat( infile )
TNposZ# = ReadFloat( infile )
TNscaleX# = ReadFloat( infile )
TNscaleY# = ReadFloat( infile )
TNscaleZ# = ReadFloat( infile )
TNrotW# = ReadFloat( infile )
TNrotX# = ReadFloat( infile )
TNrotY# = ReadFloat( infile )
TNrotZ# = ReadFloat( infile )
If nodi < 1
phandle = AddNode(0, TNname$)
Node.Node = Object.Node(phandle)
FirstNodeHD = phandle
node\nchunk$ = chunk$
node\nchunksize = TNchunksize
node\nchunkFP = TNchunkFP
node\posX# = TNposX#
node\posY# = TNposY#
node\posZ# = TNposZ#
node\scaleX# = TNscaleX#
node\scaleY# = TNscaleY#
node\scaleZ# = TNscaleZ#
node\rotW# = TNrotW#
node\rotX# = TNrotX#
node\rotY# = TNrotY#
node\rotZ# = TNrotZ#
nodi = nodi + 1
Else
If node\NchunkFP >= FilePos( infile ) ;4
phandle = AddNode(phandle, TNname$)
Node.Node = Object.Node(phandle)
node\nchunk$ = chunk$
node\nchunksize = TNchunksize
node\nchunkFP = TNchunkFP
node\posX# = TNposX#
node\posY# = TNposY#
node\posZ# = TNposZ#
node\scaleX# = TNscaleX#
node\scaleY# = TNscaleY#
node\scaleZ# = TNscaleZ#
node\rotW# = TNrotW#
node\rotX# = TNrotX#
node\rotY# = TNrotY#
node\rotZ# = TNrotZ#
nodi = nodi + 1
ElseIf node\NchunkFP < FilePos( infile )
Repeat
If phandle > 0
If node\NchunkFP >= FilePos( infile )
phandle = AddNode(phandle, TNname$)
Node.Node = Object.Node(phandle)
node\nchunk$ = chunk$
node\nchunksize = TNchunksize
node\nchunkFP = TNchunkFP
node\posX# = TNposX#
node\posY# = TNposY#
node\posZ# = TNposZ#
node\scaleX# = TNscaleX#
node\scaleY# = TNscaleY#
node\scaleZ# = TNscaleZ#
node\rotW# = TNrotW#
node\rotX# = TNrotX#
node\rotY# = TNrotY#
node\rotZ# = TNrotZ#
nodi = nodi + 1
Exit
Else
node = Before node
phandle = Handle(node)
If phandle > 0
Node.Node = Object.Node(phandle)
Else
ERRORnode1 = ERRORnode1 + 1
;RUNTIMEERROR "Can not read B3D File1"
;EXIT
EndIf
EndIf
Else
ERRORnode2 = ERRORnode2 + 1
;RUNTIMEERROR "Can not read B3D File2"
;EXIT
EndIf
Forever
EndIf
EndIf
NodeKeyAnz = 0
EndIf ;1
Countnode = Countnode+1
;
; CASE BONE
Case "BONE"
;BONEchunk$ = chunk$
BNEchunksize = ReadInt( infile )
fp = FilePos( infile )
tempbank = node\bonebank
z = 0
If BNEchunksize > 0
Repeat
tmpInt = ReadInt( infile )
tmpfloat# = ReadFloat( infile )
blocknum = AddBlockInt( tempbank, 8, tmpInt, 0 )
InsertBlockFloat( tempbank,blocknum, 8, tmpfloat#, 4 )
allbones = allbones+1
z = z + 1
If FilePos( infile ) > fp + BNEchunksize
ErrorBONE = ErrorBONE + 1
;RUNTIMEERROR "ERROR BONE chunk too long"
;EXIT
EndIf
Until FilePos( infile ) >= fp + BNEchunksize
EndIf
node\VXanz = z
boni = boni + 1
;
; CASE KEYS
Case "KEYS"
NodeKeyAnz = NodeKeyAnz + 1
;KEYSchunk$ = chunk$
KYSchunksize = ReadInt( infile )
If KYSchunksize > 0
fp = FilePos( infile )
bankK1 = node\key1bank
bankK2 = node\key2bank
bankK3 = node\key3bank
node\KEYSflags = ReadInt( infile )
z = 0
If KYSchunksize > 4
If nodi < 1 Then SaveFirstFrameNull = 1
Repeat
KYSframe = ReadInt( infile )
If KYSframe > AnimFrames Then AnimFrames = KYSframe
If node\KEYSflags And 1
KYSposX# = ReadFloat( infile )
KYSposY# = ReadFloat( infile )
KYSposZ# = ReadFloat( infile )
blocknum = AddBlockInt( bankK1, 16, KYSframe, 0 )
InsertBlockFloat( bankK1, blocknum, 16,KYSposX#, 4 )
InsertBlockFloat( bankK1, blocknum, 16, KYSposY#, 8 )
InsertBlockFloat( bankK1, blocknum, 16 ,KYSposZ#, 12 )
EndIf
If node\KEYSflags And 2
KYSscaleX# = ReadFloat( infile )
KYSscaleY# = ReadFloat( infile )
KYSscaleZ# = ReadFloat( infile )
blocknum = AddBlockInt( bankK2, 16, KYSframe, 0 )
InsertBlockFloat( bankK2, blocknum, 16, KYSscaleX#, 4 )
InsertBlockFloat( bankK2, blocknum, 16, KYSscaleY#, 8 )
InsertBlockFloat( bankK2, blocknum, 16, KYSscaleZ#, 12 )
EndIf
If node\KEYSflags And 4
KYSrotW# = ReadFloat( infile )
KYSrotX# = ReadFloat( infile )
KYSrotY# = ReadFloat( infile )
KYSrotZ# = ReadFloat( infile )
blocknum = AddBlockInt( bankK3, 20, KYSframe, 0 )
InsertBlockFloat( bankK3, blocknum, 20, KYSrotW#, 4 )
InsertBlockFloat( bankK3, blocknum, 20, KYSrotX#, 8 )
InsertBlockFloat( bankK3, blocknum, 20, KYSrotY#, 12 )
InsertBlockFloat( bankK3, blocknum, 20, KYSrotZ#, 16 )
EndIf
z = z + 1
allkeys = allkeys+1
If FilePos( infile ) > fp + KYSchunksize
ErrorKEYS = ErrorKEYS + 1
;RUNTIMEERROR "ERROR KEYS chunk too long" ;Abfrage erstellen ------ <<
;EXIT
EndIf
Until FilePos( infile ) >= fp + KYSchunksize
EndIf
EndIf
keyi = keyi + 1
;
; DEFAULT
Default
csz = ReadInt( infile )
nfp = FilePos( infile )+csz
SeekFile(infile, nfp)
;
End Select
; EndSelect
If FilePos( infile ) > fsize
ErrorFILEEND = ErrorFILEEND + 1
;RUNTIMEERROR "ERROR file reads after fileend"
;EXIT
EndIf
If outoffile = 1 Then Exit
.endchunk
Until FilePos( infile ) >= fsize
AnzTrisi = trisi-1
AnzNodi = nodi-1
AnzBoni = boni-1
AnzKeyi = keyi-1
CloseFile infile
;#End Region
;#Region not animated
If animframes = 0 Then animframes = 1
If hasanim = 0
phandle = AddNode(0, "RootBone")
Node.Node = Object.Node(phandle)
node\nchunk$ = chunk$
node\nchunksize = TNchunksize
node\nchunkFP = TNchunkFP
node\posX# = ROOTNODEposX#
node\posY# = ROOTNODEposY#-1
node\posZ# = ROOTNODEposZ#
node\scaleX# = ROOTNODEscaleX#
node\scaleY# = ROOTNODEscaleY#
node\scaleZ# = ROOTNODEscaleZ#
node\rotW# = ROOTNODErotW#
node\rotX# = ROOTNODErotX#
node\rotY# = ROOTNODErotY#
node\rotZ# = ROOTNODErotZ#
bankK1 = node\key1bank
bankK2 = node\key2bank
bankK3 = node\key3bank
node\KEYSflags = 7
blocknum = AddBlockInt( bankK1, 16, 1, 0 )
InsertBlockFloat( bankK1, blocknum, 16,0.0, 4 )
InsertBlockFloat( bankK1, blocknum, 16, 0.0, 8 )
InsertBlockFloat( bankK1, blocknum, 16 ,0.0, 12 )
blocknum = AddBlockInt( bankK2, 16, 1, 0 )
InsertBlockFloat( bankK2, blocknum, 16, 1.0, 4 )
InsertBlockFloat( bankK2, blocknum, 16, 1.0, 8 )
InsertBlockFloat( bankK2, blocknum, 16, 1.0, 12 )
blocknum = AddBlockInt( bankK3, 20, 1, 0 )
InsertBlockFloat( bankK3, blocknum, 20, 0.0, 4 )
InsertBlockFloat( bankK3, blocknum, 20, 0.0, 8 )
InsertBlockFloat( bankK3, blocknum, 20, 0.0, 12 )
InsertBlockFloat( bankK3, blocknum, 20, 0.0, 16 )
ANIMchunk$ = chunk$
ANIMchunksize = 0
ANIMflags = 0
ANIMframes = 1
ANIMfps# = 60
AnzNodes = 1
Dim FRposX#(ANIMframes ,AnzNodes)
Dim FRposY#(ANIMframes ,AnzNodes)
Dim FRposZ#(ANIMframes ,AnzNodes)
Dim FRposDO(ANIMframes ,AnzNodes)
Dim FRscaleX#(ANIMframes ,AnzNodes)
Dim FRscaleY#(ANIMframes ,AnzNodes)
Dim FRscaleZ#(ANIMframes ,AnzNodes)
Dim FRscaleDO(ANIMframes ,AnzNodes)
Dim FRrotW#(ANIMframes ,AnzNodes)
Dim FRrotX#(ANIMframes ,AnzNodes)
Dim FRrotY#(ANIMframes ,AnzNodes)
Dim FRrotZ#(ANIMframes ,AnzNodes)
Dim FRrotDO(ANIMframes ,AnzNodes)
Dim FReuX#(ANIMframes ,AnzNodes)
Dim FReuY#(ANIMframes ,AnzNodes)
Dim FReuZ#(ANIMframes ,AnzNodes)
Dim FReuDO(ANIMframes ,AnzNodes)
FRposX#(1,0) = ROOTNODEposX#
FRposY#(1,0) = ROOTNODEposY#-1
FRposZ#(1,0) = ROOTNODEposZ#
FRposDO(1,0) = 1
FRscaleX#(1,0) = ROOTNODEscaleX#
FRscaleY#(1,0) = ROOTNODEscaleY#
FRscaleZ#(1,0) = ROOTNODEscaleZ#
FRscaleDO(1,0) = 1
FRrotW#(1,0) = ROOTNODErotW#
FRrotX#(1,0) = ROOTNODErotX#
FRrotY#(1,0) = ROOTNODErotY#
FRrotZ#(1,0) = ROOTNODErotZ#
FRrotDO(1,0) = 1
filename$ = "Temp.b3d"
saveQuestion = 0
Gosub saveall
FreeEntity theanim
theanim = LoadAnimMesh(filename$)
HideEntity theanim
EntityFX theanim,0
EndIf
;#End Region
;#Region Create Vertex-boxes and Bone-Spheres
bn2 = CreateBank(100)
PutAllLCB2()
Dim FRkeySEQ$(ANIMframes)
;
;
; Create Vertex-boxes and Bone-Spheres
saveshort = 1
filename$ = "anim0.b3d"
Node.Node = First Node
saveQuestion = 0
Gosub saveNull
saveshort = 0
anim0 = LoadAnimMesh("anim0.b3d")
;EntityOrder anim0, 10
fx = 16
EntityFX anim0,fx
Dim Cubes(AnzVert+1)
sccubes# = 0.05
scsph# = 0.05
i = 0
For vrts.vrts = Each vrts
Cubes(i) = CreateCube()
EntityPickMode Cubes(i), 2,0
ScaleEntity Cubes(i), sccubes#, sccubes#, sccubes#
PositionEntity Cubes(i), VRTS\x#, VRTS\y#, VRTS\z#
EntityOrder Cubes(i),-10
If i = 0
vxtempstore# = VRTS\y#
Else
If VRTS\y# < vxtempstore# Then vxtempstore# = VRTS\y#
EndIf
i = i + 1
Next
i = 0
anzNodes = 0
Node.Node = First Node
minusNode = node\num
Animate anim0,3,1
UpdateWorld
RenderWorld
Flip
Node.Node = First Node
minusNode = node\num
For Node.Node = Each node
thisHD = Node\num
If node\parent > 0
node.node = Object.node(node\parent)
parentHD = node\sphere
node.node = Object.node(thisHD)
node\parentHD = parentHD
node\bsphereparent = FindChild(anim0,node\name)
Node\Sphere = CreateCube(node\bsphereparent)
Node\spiv = CreateSphere(6,Node\Sphere)
EntityParent Node\sphere, node\parentHD
EntityAlpha node\sphere,0
ScaleEntity Node\Sphere,node\scaleX#,node\scaleY#,node\scaleZ#,0
EntityOrder Node\spiv,-2
;EntityAlpha node\spiv,0.6
;EntityBlend node\spiv,3
ElseIf anznodes = 0
node\bsphereparent = FindChild(anim0,node\name)
node\parentHD = 0;node\bsphereparent
Node\Sphere = CreateCube(node\bsphereparent)
Node\spiv = CreateSphere(6,Node\Sphere)
;EntityParent Node\sphere, node\parentHD
EntityAlpha node\sphere,0
ScaleEntity Node\Sphere,node\scaleX#,node\scaleY#,node\scaleZ#,1
EntityParent Node\sphere,Node\bsphereparent
EntityOrder Node\spiv,-2
;EntityAlpha node\spiv,0.6
;EntityBlend node\spiv,3
EndIf
EntityPickMode Node\spiv, 2,0
PaintEntity Node\spiv, blau
anzNodes = anzNodes + 1
Next
For node.node = Each node
ScaleEntity Node\spiv, scsph#, scsph#, scsph# ,1
Next
node.node = First node
aktiveBone = node\num
firstBone = aktiveBone
Gosub readspeedconfig
PositionEntity plane,0,vxtempstore#,0
;
;#End Region
; =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
;#Region Edit Loop
; Edit Loop ------------
.MainLoop
aktualModus = 1
For I=0 To MnuCount(Mnu$(0))
mnu$(i) = ""
Next
b2dw = 40
b2dh = 22
b2Xpos = gw-120
b2ypos = gh-140
EntityFX anim0,fx
Repeat
If animmode = 1
animmode = 0
waittext = 0
node.node = First node
Goto AnimLoop
End If
msx = MouseX()
msy = MouseY()
entity = CameraPick(camera, msx, msy)
;#Region Maustasten --- Mousebuttons
; Linke Maustaste --- left mousebutton
If MouseHit(1) Or machfarbig = 1
;EntityOrder anim0,20
If msx >= b2Xpos And msy >= b2ypos-24 And msx <= b2Xpos+82 And msy <= b2ypos+b2dh-24
If bonemodus = 1
bonemodus = 2
E_RM_mode = 2
ShowEntity XYZ
EntityParent xyz,0
ScaleEntity xyz,scsph#*3, scsph#*3, scsph#*3
PositionEntity xyz,0,0,0,1
RotateEntity xyz,0,0,0,1
EntityParent xyz, Node\Sphere,0
;bonemodus = 2
ElseIf bonemodus = 2
bonemodus = 1
E_RM_mode = 1
ShowEntity XYZ
EntityParent xyz,0
ScaleEntity xyz,scsph#*3, scsph#*3, scsph#*3
PositionEntity xyz,0,0,0,1
RotateEntity xyz,0,0,0,1
EntityParent xyz, node\Sphere,0
;HideEntity XYZ
bonemodus = 1
EndIf
ElseIf msx >= b2Xpos And msy >= b2ypos-48 And msx <= b2Xpos+26 And msy <= b2ypos+b2dh-48
moveBonespeed# = bonespeedS#
aktbonespeed = 0
ElseIf msx >= b2Xpos+28 And msy >= b2ypos-48 And msx <= b2Xpos+28+26 And msy <= b2ypos+b2dh-48
moveBonespeed# = bonespeedM#
aktbonespeed = 1
ElseIf msx >= b2Xpos+56 And msy >= b2ypos-48 And msx <= b2Xpos+56+26 And msy <= b2ypos+b2dh-48
moveBonespeed# = bonespeedF#
aktbonespeed = 2
ElseIf entity<>0 Or machfarbig = 1
If machfarbig = 1
machfarbig = 0
entity = storeEntity
EndIf
thisID = node\num
For node.node = Each node
If Node\spiv > 0 Then PaintEntity Node\spiv, blau ;: EntityAlpha node\spiv,0.6 : EntityBlend node\spiv,3 ;paint all bones blue
Next
;node.node = Object.node(thisID)
For node.node = Each node
If entity = Node\spiv ;if you selected a bone, then.....
thisID = node\num
For j = 0 To AnzVert
PaintEntity Cubes(j), weiss ;paint all cubes white
Next
PaintEntity Node\spiv, rot ;paint the selected bone red
;IF E_RM_mode = 2
EntityParent XYZ,Node\Sphere,0
;ENDIF
aktbonename$ = node\name ;get Name of the active bone
AktiveBone = Node\num
If node\anzchild > 0
tempbank = node\childbank
For anc = 1 To node\anzchild
CHandle = PeekInt (tempbank, (anc-1)*4)
node.node = Object.node(CHandle)
If node\spiv > 0
PaintEntity node\spiv,gruen
;EntityAlpha node\spiv,0.6
;EntityBlend node\spiv,3
EndIf
node.node = Object.node(thisID)
Next
node.node = Object.node(thisID)
EndIf
If node\parent > 0
node.node = Object.node(node\parent)
PaintEntity node\spiv,violett
;EntityAlpha node\spiv,0.6
;EntityBlend node\spiv,3
EndIf
node.node = Object.node(thisID)
If node\VXanz > 0
tempbank = node\bonebank
For k = 0 To node\VXanz-1
tmpvx = GetBlockInt( tempbank, k, 8, 0 )
tmpwgt# = GetBlockFloat( tempbank, k, 8, 4 )
If tmpwgt# <0.101
PaintEntity Cubes(tmpvx), wg10
ElseIf tmpwgt# < 0.201
PaintEntity Cubes(tmpvx), wg20
ElseIf tmpwgt# < 0.301
PaintEntity Cubes(tmpvx), wg30
ElseIf tmpwgt# < 0.401
PaintEntity Cubes(tmpvx), wg40
ElseIf tmpwgt# < 0.501
PaintEntity Cubes(tmpvx), wg50
ElseIf tmpwgt# < 0.601
PaintEntity Cubes(tmpvx), wg60
ElseIf tmpwgt# < 0.701
PaintEntity Cubes(tmpvx), wg70
ElseIf tmpwgt# < 0.801
PaintEntity Cubes(tmpvx), wg80
ElseIf tmpwgt# < 0.901
PaintEntity Cubes(tmpvx), wg90
Else
PaintEntity Cubes(tmpvx), wg100
EndIf
Next
EndIf
Goto allegelb
EndIf
Next
.allegelb
node.node = Object.node(thisID)
EndIf
If entity<>0
startentity = entity ;Entity merken um gegen alle überschneidenden Cubes vergleichen zu können
For mk = 0 To 39
merke(mk) = 0
Next
merkZ = 0 ;merk Zähler für Cubes (Vertexes) welche am selben Platz sind oder sich berühren (muss hier vor der Schleife stehen)
merkV = 0 ;von wo ab wurde schon getestet
If node\num <> firstBone
.nochmalvrts
vrt = 0
For vrt = 0 To AnzVert ;Scan all Cubes --- Alle Cubes durchsuchen
If entity = Cubes(vrt) ;If found selected vertex --- Wenn geklickter Vertex gefunden
;Loop to search vertexes from different tris --- Suchschleife um verschiedene Vertexe von verschiedenen TRIS zu finden
If differentVertexMode = 1 ; <<<<<<<<<<<<<<<<<<<<<<<<<<< Menü einbinden und Toggle- Hotkey (K)
; mit (L) Liste durchblättern differentVertexMode = 2
If zufallmodus = 1 Then Gosub positionVertexes
suchX# = EntityX#(entity)
suchY# = EntityY#(entity)
suchZ# = EntityZ#(entity)
Dim VertexListe(100) ; 100 ist natürlich viel zu viel, aber sicher ist sicher.
vertexzahl = 0 ;Zähler für vrts.vrts Type
lz = 0
For vrts.vrts = Each vrts
If suchX# = vrts\x# And suchY# = vrts\y# And suchZ# = vrts\z#
VertexListe(lz) = vertexzahl
PaintEntity cubes(vertexzahl),hellblau
lz = lz + 1
EndIf
vertexzahl = vertexzahl +1
Next
diffdone = lz
lz = lz - 1
VXliste = lz
If zufallmodus = 1 Then Gosub VertexRND
ElseIf differentVertexMode = 0 ; normaler Selektiermodus
If weight# <0.101
PaintEntity entity, wg10
ElseIf weight# < 0.201
PaintEntity entity, wg20
ElseIf weight# < 0.301
PaintEntity entity, wg30
ElseIf weight# < 0.401
PaintEntity entity, wg40
ElseIf weight# < 0.501
PaintEntity entity, wg50
ElseIf weight# < 0.601
PaintEntity entity, wg60
ElseIf weight# < 0.701
PaintEntity entity, wg70
ElseIf weight# < 0.801
PaintEntity entity, wg80
ElseIf weight# < 0.901
PaintEntity entity, wg90
Else
PaintEntity entity, wg100
EndIf
;PaintEntity entity, gelb ;<---------------------------------- ändern-------------------------------------<<<<<<<<<<<<<<<<<<<<<<<<
aktvx = vrt ;aktueller Vertex
node.node = Object.node(AktiveBone)
If node\bonebank = 0 Then node\bonebank = CreateBank(0) ;In bonebank sind Vertexnummer und Weight enthalten (Int, Float)
vxIN = 0
For k = 0 To node\VXanz-1
If aktvx = GetBlockInt( node\bonebank, k, 8, 0 ) Then vxIN = 1 : vxBLnum = k ;prüfe ob Vertex schon selektiert ist
Next
If vxIN = 0 ;wenn Vertex noch nicht selektiert, dann selektiere jetzt
blocknum = AddBlockInt( node\bonebank, 8, aktvx, 0 ) ;aktuelle Vertexnummer dem Bone zufügen
InsertBlockFloat( node\bonebank,blocknum, 8, weight#, 4 ) ; Weight (hier 1.0) <<<<<<<<<<<<<<<<< ändern
node\VXanz = node\VXanz+1 ;merke wieviel Vertexe pro Bone selektiert sind
Else
InsertBlockInt( node\bonebank, vxBLnum ,8, aktvx, 0 )
InsertBlockFloat( node\bonebank, vxBLnum ,8, weight#, 4 )
EndIf
node.node = Object.node(AktiveBone)
Goto paintfertig
EndIf
EndIf
Next
EndIf
EndIf
EndIf
Goto nachpaintfertig
.paintfertig
For vrt2 = merkV To AnzVert
If startentity <> Cubes(vrt2) And MeshesIntersect (startentity, Cubes(vrt2)) And merkZ < 40 ;teste ob ein VertexCube einen anderen berührt oder am selben Platz ist.
schongemerkt = 1
For mi = 0 To 39
If merke(mi) = Cubes(vrt2) ;testen ob Cube Berührung schon gemerkt wurde.
Exit ;wenn ja dann Schleife verlassen
ElseIf merke(mi) = 0
schongemerkt = 0 ;noch frei und nicht gefunden
Exit
EndIf
Next
If schongemerkt = 0 ;wenn noch nicht gemerkt, dann merke jetzt (bis zu 40 Cubes)
merke(merkZ) = Cubes(vrt2)
entity = Cubes(vrt2) ;gefundene Cube als entity setzen und zum > färben und speichern schicken
merkZ = merkZ+1 ;wieder eins mehr gemerkt
merkV = vrt2+1 ;bis dahin schon gemerkt, als neue start-suchposition setzen
Goto nochmalvrts
EndIf
EndIf
Next
.nachpaintfertig
PaintEntity Node\spiv, rot
;EntityAlpha node\spiv,0.6
;EntityBlend node\spiv,3
;
; Rechte Maustaste --- right mousebutton
;clear selected vertex
If entity<>0 And MouseHit(2) > 0 And MouseHit(1) = 0
startentity = entity
For mk = 0 To 39
merke(mk) = 0
Next
merkZ = 0 ;merk Zähler für Cubes (Vertexes) welche am selben Platz sind oder sich berühren (muss hier vor der Schleife stehen)
merkV = 0 ;von wo ab wurde schon getestet
If node\num <> firstBone
.nochmalWvrts
For i = 0 To AnzVert
If entity = Cubes(i)
PaintEntity entity, weiss
aktvx = i
node.node = Object.node(AktiveBone)
;tempbank = node\bonebank
vxIN = 0
For k = 0 To node\VXanz-1
If aktvx = GetBlockInt( node\bonebank, k, 8, 0 )
vxIN = 1
vxBLnum = k
EndIf
Next
If vxIN = 1
DeleteBlock( node\bonebank, 8, vxBLnum )
node\VXanz = node\VXanz-1
EndIf
Goto wpaintfertig
EndIf
Next
EndIf
EndIf
node.node = Object.node(AktiveBone)
Goto nachwpaintfertig
.wpaintfertig
vrt2 = 0
For vrt2 = merkV To AnzVert
If startentity <> Cubes(vrt2) And MeshesIntersect (startentity, Cubes(vrt2)) And merkZ < 40 ;teste ob ein VertexCube einen anderen berührt oder am selben Platz ist.
schongemerkt = 1
For mi = 0 To 39
If merke(mi) = Cubes(vrt2) ;testen ob Cube Berührung schon gemerkt wurde.
Exit ;wenn ja dann Schleife verlassen
ElseIf merke(mi) = 0
schongemerkt = 0 ;noch frei und nicht gefunden
Exit
EndIf
Next
If schongemerkt = 0 ;wenn noch nicht gemerkt, dann merke jetzt (bis zu 40 Cubes)
merke(merkZ) = Cubes(vrt2)
entity = Cubes(vrt2)
merkZ = merkZ+1 ;wieder eins mehr gemerkt
merkV = vrt2+1
Goto nochmalwvrts
EndIf
EndIf
Next
node.node = Object.node(AktiveBone)
.nachwpaintfertig
;
;EntityOrder themesh,0
; Mittlere Maustaste --- middle mousebutton
mzspeed#=MouseZSpeed()
If mzspeed# And ( KeyDown(KEY_SHIFT_LINKS ) <> 0 ) Or ( KeyDown(KEY_SHIFT_RECHTS ) <> 0)
MoveEntity Camera, 0, 0, (mzspeed#/15)
ElseIf mzspeed# And ( KeyDown(KEY_STRG_LINKS ) <> 0 ) Or ( KeyDown(KEY_STRG_RECHTS ) <> 0)
MoveEntity Camera, 0, 0, (mzspeed#*2.9)
Else
MoveEntity Camera, 0, 0, (mzspeed#/1.5)
EndIf
If MouseDown(3) Or ( MouseDown(1) And MouseDown(2))
mxspeed#=MouseXSpeed()
myspeed#=MouseYSpeed()
If KeyDown(KEY_CTRL_RIGHT) Or KeyDown(KEY_CTRL_Left)
mxspeed = mxspeed-(mxspeed*2)
If delspeed = 1
MoveEntity Camera, mxspeed#/5.0, 0, 0
MoveEntity Camera, 0, myspeed#/5.0, 0
EndIf
ElseIf KeyDown(KEY_SHIFT_LINKS ) Or KeyDown(KEY_SHIFT_RECHTS )
If delspeed = 1
mxspeed = mxspeed-(mxspeed*2)
If msx > (gw2-(gw2/10)) And msx < (gw2+(gw2/10))
TurnEntity piv, myspeed#,0, 0 , 0
Else
If msx < gw2 Then myspeed = myspeed-(myspeed*2)
TurnEntity piv, 0, 0, myspeed#
EndIf
TurnEntity piv, 0, mxspeed#, 0 , 0
EndIf
Else
If delspeed = 1
mxspeed = mxspeed-(mxspeed*2)
TurnEntity piv, myspeed#,0, 0 , 0
TurnEntity piv, 0, mxspeed#, 0 , 1
EndIf
EndIf
delspeed = 1
Else
delspeed = 0
End If
;
;#End Region
;#Region Tasten --- Keys
; Tasten
If KeyDown(KEY_CTRL_RIGHT) Or KeyDown(KEY_CTRL_Left) And KeyDown(KEY_ALT_RECHTS) = 0 ;--- CTRL/STRG +
; CTRL / STRG Keys
If KeyDown(Key_Links)
MoveEntity piv, -0.2, 0, 0
ElseIf KeyDown(Key_Rechts)
MoveEntity piv, 0.2, 0, 0
ElseIf KeyDown(Key_Auf)
MoveEntity piv, 0, 0.2, 0
ElseIf KeyDown(Key_Ab)
MoveEntity piv, 0, -0.2, 0
ElseIf KeyDown(Key_BILD_Auf)
MoveEntity plane, 0.0, 0.01,0.0
ElseIf KeyDown(Key_BILD_Ab)
MoveEntity plane, 0.0, -0.01,0.0
ElseIf KeyDown(Key_0) Or KeyDown(KEY_NUM_0)
PositionEntity piv, 0, 0, 0
ElseIf KeyDown(Key_N)
ShowEntity darky
st$ = "New name of the bone: "
ln = StringWidth(st$)
node\name = GetInput$(gw2-(ln/2),gh2, st$,50) ;new bone name
EndIf
;
ElseIf KeyDown(KEY_ALT_RIGHT) Or KeyDown(KEY_ALT_Left) Or aktMenu = 201 Or aktMenu = 202 ;------- ALT +
; ALT + Keys
; DEL Bone
If KeyDown(KEY_D) Or aktMenu = 202; Delete Node/Bone
.dellastbone
If node\anzchild = 0 And node\num <> minusNode
FreeEntity node\spiv
FreeEntity node\sphere
thisHD = DeleteLastNode( node\num )
node.node = Object.node(thisHD)
aktivebone = node\num
EndIf
machfarbig = 1
storeentity = node\spiv
DownWait(KEY_D)
;
; add Bone
ElseIf KeyDown(KEY_A) Or aktMenu = 201 ;Add new Bone
.addnewbone
FlushKeys
Locate gw2-100, gh-50
ShowEntity darky
st$ = "Input a Name for the new Bone: "
ln = StringWidth(st$)
TNname$ = GetInput$(gw2-(ln/2),gh2, st$,50)
;TNname$ = Input$( "Input a Name for the new Bone: ")
phandle = AddNode(node\num, TNname$)
Node.Node = Object.Node(phandle)
thisHD = node\num
node.node = Object.node(node\parent)
parentHD = node\sphere
node.node = Object.node(thisHD)
node\parentHD = parentHD
Node\Sphere = CreateCube(parentHD)
Node\spiv = CreateSphere(6,node\sphere)
EntityOrder Node\spiv,-2
;EntityAlpha node\spiv,0.6
;EntityBlend node\spiv,3
MoveEntity node\sphere ,0,0.3,0
EntityAlpha node\sphere,0
RotateEntity Node\Sphere,0,0,0,1
ScaleEntity Node\spiv, scsph#, scsph#, scsph# ,1
MemoryToBank(bnx,node\sphere,100)
node\rotW# = PeekFloat(bnx,12*4)
node\rotX# = PeekFloat(bnx,13*4)
node\rotY# = PeekFloat(bnx,14*4)
node\rotZ# = PeekFloat(bnx,15*4)
node\posX# = PeekFloat(bnx,16*4)
node\posY# = PeekFloat(bnx,17*4)
node\posZ# = PeekFloat(bnx,18*4)
node\scaleX# = PeekFloat(bnx,19*4)
node\scaleY# = PeekFloat(bnx,20*4)
node\scaleZ# = PeekFloat(bnx,21*4)
EntityPickMode Node\spiv, 2,0
AnzNodes = AnzNodes + 1
storeentity = node\spiv
machfarbig = 1
DownWait(KEY_A)
ElseIf KeyDown(KEY_O)
aktmenu = 0
aktmenu2 = 0
Gosub opennew
Goto start
EndIf
;
;
Else ;------------------------------------------------------------------------ pure Tasten
; Keys
If KeyDown(Key_INSERT)
MoveEntity Camera, 0, 0, 0.2
ElseIf KeyDown(Key_DELETE)
MoveEntity camera, 0, 0, -0.2
ElseIf KeyDown(Key_POS1)
MoveEntity Camera, 0, 0, 0.004
ElseIf KeyDown(Key_ENDE)
MoveEntity camera, 0, 0, -0.004
ElseIf KeyDown(Key_Links)
TurnEntity piv, 0.0, 1, 0.0
ElseIf KeyDown(Key_Rechts)
TurnEntity piv, 0.0, -1, 0.0
ElseIf KeyDown(Key_Auf)
TurnEntity piv, 1.0, 0, 0.0
ElseIf KeyDown(Key_Ab)
TurnEntity piv, -1.0, 0, 0.0
ElseIf KeyDown(Key_BILD_Auf)
TurnEntity piv, 0.0, 0, 1.0
ElseIf KeyDown(Key_BILD_Ab)
TurnEntity piv, .0, 0, -1.0
; ELSEIF KeyDown(KEY_SPACE) or aktMenu = 403
; BoObMode = 1-BoObMode
; DownWait(Key_Space)
; MoveBone
ElseIf KeyDown(Key_1) Or KeyDown(Key_NUM_1) Or xpressm = 1
If E_RM_mode = 1
Gosub beforeMove
MoveEntity node\sphere, -moveBonespeed#, 0, 0
Gosub afterMove
ElseIf E_RM_mode = 2
TurnEntity node\sphere, -rotBonespeed#, 0, 0, 1
MemoryToBank(bnx,node\sphere,100)
node\rotW# = PeekFloat(bnx,12*4)
node\rotX# = PeekFloat(bnx,13*4)
node\rotY# = PeekFloat(bnx,14*4)
node\rotZ# = PeekFloat(bnx,15*4)
EndIf
ElseIf KeyDown(Key_2) Or KeyDown(Key_NUM_3) Or xpressp = 1
EntityParent node\sphere,node\parentHD
If E_RM_mode = 1
Gosub beforeMove
MoveEntity node\sphere, moveBonespeed#, 0, 0
Gosub afterMove
ElseIf E_RM_mode = 2
TurnEntity node\sphere, rotBonespeed#, 0, 0, 0
MemoryToBank(bnx,node\sphere,100)
node\rotW# = PeekFloat(bnx,12*4)
node\rotX# = PeekFloat(bnx,13*4)
node\rotY# = PeekFloat(bnx,14*4)
node\rotZ# = PeekFloat(bnx,15*4)
EndIf
ElseIf KeyDown(Key_3) Or KeyDown(Key_NUM_4) Or ypressm = 1
If E_RM_mode = 1
Gosub beforeMove
MoveEntity node\sphere, 0, -moveBonespeed#, 0
Gosub afterMove
ElseIf E_RM_mode = 2
TurnEntity node\sphere, 0,-rotBonespeed#, 0, 0
MemoryToBank(bnx,node\sphere,100)
node\rotW# = PeekFloat(bnx,12*4)
node\rotX# = PeekFloat(bnx,13*4)
node\rotY# = PeekFloat(bnx,14*4)
node\rotZ# = PeekFloat(bnx,15*4)
EndIf
ElseIf KeyDown(Key_4) Or KeyDown(Key_NUM_6) Or ypressp = 1
If E_RM_mode = 1
Gosub beforeMove
MoveEntity node\sphere, 0, moveBonespeed#, 0
Gosub afterMove
ElseIf E_RM_mode = 2
TurnEntity node\sphere,0, rotBonespeed#, 0, 0
MemoryToBank(bnx,node\sphere,100)
node\rotW# = PeekFloat(bnx,12*4)
node\rotX# = PeekFloat(bnx,13*4)
node\rotY# = PeekFloat(bnx,14*4)
node\rotZ# = PeekFloat(bnx,15*4)
EndIf
ElseIf KeyDown(Key_5) Or KeyDown(Key_NUM_7) Or zpressm = 1
If E_RM_mode = 1
Gosub beforeMove
MoveEntity node\sphere, 0, 0, -moveBonespeed#
Gosub afterMove
ElseIf E_RM_mode = 2
TurnEntity node\sphere, 0,0,-rotBonespeed#, 0
MemoryToBank(bnx,node\sphere,100)
node\rotW# = PeekFloat(bnx,12*4)
node\rotX# = PeekFloat(bnx,13*4)
node\rotY# = PeekFloat(bnx,14*4)
node\rotZ# = PeekFloat(bnx,15*4)
EndIf
ElseIf KeyDown(Key_6) Or KeyDown(Key_NUM_9) Or zpressp = 1
If E_RM_mode = 1
Gosub beforeMove
MoveEntity node\sphere, 0, 0, moveBonespeed#
Gosub afterMove
ElseIf E_RM_mode = 2
TurnEntity node\sphere,0,0, rotBonespeed#, 0
MemoryToBank(bnx,node\sphere,100)
node\rotW# = PeekFloat(bnx,12*4)
node\rotX# = PeekFloat(bnx,13*4)
node\rotY# = PeekFloat(bnx,14*4)
node\rotZ# = PeekFloat(bnx,15*4)
EndIf
;
ElseIf KeyDown(KEY_M)
E_RM_mode = 1
;HideEntity XYZ
bonemodus = 1
ShowEntity XYZ
EntityParent xyz,0
ScaleEntity xyz,scsph#*3, scsph#*3, scsph#*3
RotateEntity xyz,0,0,0,1
EntityParent xyz, Node\Sphere,0
ElseIf KeyDown(KEY_R)
If E_RM_mode < 2
E_RM_mode = 2
ShowEntity XYZ
EntityParent xyz,0
ScaleEntity xyz,scsph#*3, scsph#*3, scsph#*3
PositionEntity xyz,0,0,0,1
RotateEntity xyz,0,0,0,1
EntityParent xyz, Node\Sphere,0
bonemodus = 2
DownWait(Key_R)
EndIf
ElseIf KeyDown(1) Or aktmenu = 103
checkend = 1
DownWait(1)
ElseIf KeyDown(Key_TAB) Or aktmenu = 401
i = 0
For vrts.vrts = Each vrts
HideEntity Cubes(i)
i = i+1
Next
For node.node = Each node
HideEntity Node\Sphere
HideEntity Node\Spiv
Next
waittext = 1
animmode = 1
ShowEntity darky
aktmenu = 0
xpressm = 0
xpressp = 0
ypressm = 0
ypressp = 0
zpressm = 0
zpressp = 0
ElseIf KeyDown(KEY_K) ;-------------------------------------------------------------- Menüeintrag erstellen
If differentVertexMode = 0
differentVertexMode = 1
newlz = 0
SETVX = 0
Else
differentVertexMode = 0
For j = 0 To AnzVert
ScaleEntity Cubes(j), sccubes#, sccubes#, sccubes#
Next
EndIf
DownWait(Key_K)
ElseIf KeyDown(KEY_L) ;-------------------------------------------------------------- Menüeintrag erstellen
If differentVertexMode = 1 Then differentVertexMode = 2
If differentVertexMode = 2 And diffdone > 0
For j = 0 To AnzVert
PaintEntity Cubes(j), weiss
ScaleEntity Cubes(j), sccubes#, sccubes#, sccubes#
Next
tz = 0
For tris.tris = Each tris
For BlockTri = 0 To tris\anztris-1
TRvertexID_1 = GetBlockInt( tris\vxbank, BlockTri, 12, 0 )
TRvertexID_2 = GetBlockInt( tris\vxbank, BlockTri, 12, 4 )
TRvertexID_3 = GetBlockInt( tris\vxbank, BlockTri, 12, 8 )
If TRvertexID_1 = VertexListe(newlz) Or TRvertexID_2 = VertexListe(newlz) Or TRvertexID_3 = VertexListe(newlz)
PaintEntity cubes(TRvertexID_1),gruen
PaintEntity cubes(TRvertexID_2),gruen
PaintEntity cubes(TRvertexID_3),gruen
ScaleEntity Cubes(TRvertexID_1), sccubes#*1.5, sccubes#*1.5, sccubes#*1.5
ScaleEntity Cubes(TRvertexID_2), sccubes#*1.5, sccubes#*1.5, sccubes#*1.5
ScaleEntity Cubes(TRvertexID_3), sccubes#*1.5, sccubes#*1.5, sccubes#*1.5
PaintEntity cubes(VertexListe(newlz)),hellblau
EndIf
Next
tz = tz + 1
Next
SETVX = newlz
newlz = newlz + 1
If newlz > VXListe Then newlz = 0
EndIf
DownWait(Key_L)
ElseIf KeyDown(KEY_ENTER) ;Set DIFF-Vertex
If differentVertexMode = 2
If node\bonebank = 0 Then node\bonebank = CreateBank(0) ;In bonebank sind Vertexnummer und Weight enthalten (Int, Float)
vxIN = 0
For k = 0 To node\VXanz-1
If VertexListe(SETVX) = GetBlockInt( node\bonebank, k, 8, 0 ) Then vxIN = 1 ;prüfe ob Vertex schon selektiert ist
Next
If vxIN = 0 ;if vertex not selected --- wenn Vertex noch nicht selektiert
blocknum = AddBlockInt( node\bonebank, 8, VertexListe(SETVX), 0 ) ;give Bone the aktual Vertex number --- aktuelle Vertexnummer dem Bone zufügen
InsertBlockFloat( node\bonebank,blocknum, 8, weight#, 4 ) ; Weight <<<<<<<<<<<<<<<<< ändern
node\VXanz = node\VXanz+1 ;notice how much vertexes are selected --- merke wieviel Vertexe pro Bone selektiert sind
EndIf
EndIf
DownWait(Key_ENTER)
ElseIf KeyDown(KEY_V) ;Input Vertex Weight
st$ = "New weight for selected vertices: (default 1.0) "
ln = StringWidth(st$)
ss$ = Trim$(GetInput$(gw2-(ln/2),gh2, st$))
If ss$ = "" Then ss$ = "1.0"
weight# = Float#(ss$)
ElseIf KeyDown(KEY_F1) Or aktmenu = 601 ;Help --- Hilfe
help = 1-help
DownWait(Key_F1)
MouseUpWait(1)
ElseIf KeyDown(KEY_W) Or aktmenu = 304 ;Wiredframe
wired = 1-wired
WireFrame wired
DownWait(KEY_W)
ElseIf KeyDown(KEY_F) Or aktmenu = 305 ;EntityFX
If fx = 0
fx = 16
Else
fx = 0
EndIf
EntityFX anim0, fx
DownWait(KEY_F)
ElseIf KeyDown(KEY_C) Or aktmenu = 302 ; Center
thisHD = node\num
spxr# = 0
spyr# = 0
spzr# = 0
spcount = 0
For node.node = Each node
spxr# = spxr# + EntityX#(node\sphere,1)
spyr# = spyr# + EntityY#(node\sphere,1)
spzr# = spzr# + EntityZ#(node\sphere,1)
spcount = spcount + 1
Next
spxr# = spxr# / spcount
spyr# = spyr# / spcount
spzr# = spzr# / spcount
node.node = Object.node(thisHD)
PositionEntity piv,spxr#,spyr#,spzr#
DownWait(KEY_C)
ElseIf KeyDown(Key_SPACE) Or KeyDown(KEY_J) Or aktmenu = 301
spx# = EntityX#(node\sphere,1)
spy# = EntityY#(node\sphere,1)
spz# = EntityZ#(node\sphere,1)
PositionEntity piv,spx#,spy#,spz#
DownWait(KEY_SPACE)
ElseIf KeyDown(Key_F6)
moveBonespeed# = bonespeedS#
ElseIf KeyDown(Key_F7)
moveBonespeed# = bonespeedM#
ElseIf KeyDown(Key_F8)
moveBonespeed# = bonespeedF#
ElseIf aktmenu = 204 ;New BoneName
ShowEntity darky
st$ = "New name of the bone: "
ln = StringWidth(st$)
node\name = GetInput$(gw2-(ln/2),gh2, st$,50)
; Scale Bones and Vertices
ElseIf KeyDown(KEY_F9)
If sccubes# < 0.0005 Then sccubes# = 0.0005
If scrnd# < 0.00005 Then scrnd# = 0.00005
scrnd# = scrnd# * 0.98
sccubes# = sccubes# *0.98
For i = 0 To AnzVert
ScaleEntity Cubes(i), sccubes#, sccubes#, sccubes#
Next
ElseIf KeyDown(KEY_F10)
If sccubes# < 0.0005 Then sccubes# = 0.0005
If scrnd# < 0.00005 Then scrnd# = 0.00005
scrnd# = scrnd# * 1.02
sccubes# = sccubes# *1.02
For i = 0 To AnzVert
ScaleEntity Cubes(i), sccubes#, sccubes#, sccubes#
Next
ElseIf KeyDown(KEY_F11)
If scsph# < 0.0005 Then scsph# = 0.0005
scsph# = scsph# *0.98
For node.node = Each node
ScaleEntity Node\spiv, scsph#, scsph#, scsph#
ScaleEntity xyz,scsph#*3, scsph#*3, scsph#*3
Next
node.node = Object.node(aktiveBone)
ElseIf KeyDown(KEY_F12)
If scsph# < 0.0005 Then scsph# = 0.0005
scsph# = scsph# *1.02
For node.node = Each node
ScaleEntity Node\spiv, scsph#, scsph#, scsph#
ScaleEntity xyz,scsph#*3, scsph#*3, scsph#*3
Next
node.node = Object.node(aktiveBone)
End If
EndIf
;
;#End Region
;#Region nur Menü --- only Menu
;
;
; Menu
If aktmenu = 101
aktmenu = 0
aktmenu2 = 0
Gosub opennew
Goto start
ElseIf aktmenu = 206
ShowEntity darky
st$ = "Give in the weight for the vertexes you set (actual = " +weight# +") "
ln = StringWidth(st$)
weight# = Float(Trim$(GetInput$(gw2-(ln/2),gh2, st$)))
ElseIf aktmenu = 501
ShowEntity darky
st$ = "Slow speed of bone movement: (actual = " +bonespeedS# +") "
ln = StringWidth(st$)
tmp# = Float(Trim$(GetInput$(gw2-(ln/2),gh2, st$)))
If tmp# = 0.0 Then bonespeedS# = 0.005 Else bonespeedS# = tmp#
Gosub writespeedconfig
ElseIf aktmenu = 502
ShowEntity darky
st$ = "Middle speed of bone movement: (actual = " +bonespeedM# +") "
ln = StringWidth(st$)
tmp# = Float(Trim$(GetInput$(gw2-(ln/2),gh2, st$)))
If tmp# = 0.0 Then bonespeedM# = 0.02 Else bonespeedM# = tmp#
Gosub writespeedconfig
ElseIf aktmenu = 503
ShowEntity darky
st$ = "Fast speed of bone movement: (actual = " +bonespeedF# +") "
ln = StringWidth(st$)
tmp# = Float(Trim$(GetInput$(gw2-(ln/2),gh2, st$)))
If tmp# = 0.0 Then bonespeedF# = 0.02 Else bonespeedF# = tmp#
Gosub writespeedconfig
ElseIf aktmenu = 505 ; VertexRND
zufallmodus = 1
Gosub VertexRND
ElseIf aktmenu = 506 ; Vertex Position
zufallmodus = 0
Gosub positionVertexes
EndIf
;
;#End Region
UpdateWorld
RenderWorld
;#Region Text
; Texte
SetFont font
Color 180,180,180
If help = 1
ShowEntity darky
Text 10,30, "Cursor keys and Pup / Pdown - rotate around the Mesh"
Text 10,50, "CTRL + cursor keys to move camera"
Text 10,70, "Middle mousebutton or left and right mousebutton - press down and move mouse - move camera around the mesh"
Text 10,90, "Mousewheel or INS+DEL - Zoom | [+ SHIFT] = slow or [+ CTRL] = fast"
Text 10,110, "Left mousebutton - select vertices and toggle between the bones "
Text 10,130, "Right mousebutton - deselect vertices"
Text 10,150, "F9 and F10 - scale vertice-cubes"
Text 10,170, "F11 and F12 - scale bone-spheres"
Text 10,190, "TAB - Animations-mode"
Text 10,210, "ALT + D - Delete actual Bone"
Text 10,230, "ALT + A - Add new Bone"
Color 160,255,160
Text 10,290, "V - weight, then give in the active weight for vertexes"
Color 160,255,255
Text 10,310, "Move Bones X-axis with 1 and 2 or NUM_1 and NUM_3, Y-axis 3/4 or NUM 4/6, Z-axis 5/6 or NUM 7/9 or with the GUI"
Text 10,330, "M - Move-Modus, R - Rotate-Modus"
Color 180,180,180
Text 10,350, "Space or J - Position View on selected Bone / C - Center View"
Text 10,370, "W - toggle wiredframe / F - toggle between FX 1 and FX 17"
Text 10,390, "CTRL+POSup AND CTRL+POSdn |
Comments
| ||
;------------------ put them together --- it's too big for one file
Text 10,410, "look in tutorial for more help"
Color 255,255,255
st$ = "Close Help with F1 or Help in menu again"
ln=StringWidth (st$)
Text gw2-(ln/2),gh2+200, st$
Color 180,180,180
ElseIf waittext = 1
ShowEntity darky
SetFont bigfont
st$ = "Wait a moment, I am busy"
ln = StringWidth(st$)
Text gw2-(ln/2),gh2, st$
SetFont font
ElseIf checkend = 1
SetFont font
ShowEntity darky
st$ = "Really Quit ? y/n (for yes: y,z,j / for no: all other keys)"
ln = StringWidth(st$)
UpdateWorld
RenderWorld
Text gw2-(ln/2),gh2, st$
Flip
WaitKey
If KeyDown(KEY_Z) Or KeyDown(Key_Y) Or KeyDown(Key_J) Then Goto aus1
DownWait(KEY_Z)
DownWait(KEY_Y)
DownWait(KEY_J)
DownWait(1)
checkend = 0
FlushKeys
Flip
Else
HideEntity Darky
Text 10,30, "Name of the Bone: "+aktbonename$
Color 255,255,0
Text gw-150,30, "EDIT-Mode"
Color 180,180,180
Text gw-150,50, "weight = " + weight#
; IF BoObMode = 0
; Color 0,255,0
; Text gw-200,50, "Object-Mode"
If differentVertexMode > 0
Color 0,255,255
ln=StringWidth ("Diff-Vertex mode")
Text (gw2-(ln/2)),50, "Diff-Vertex mode"
Color 180,180,180
ln=StringWidth ("select vertex with LMB, toggle through list with L")
Text (gw2-(ln/2)),70, "select vertex with LMB, toggle through list with L"
EndIf
; Color 180,180,180
; Text gw-200,70, "weight# = "+weight#
; ELSEIF BoObMode = 1
; Color 255,0,0
; Text gw-200,50, "Bone-Mode"
; If differentVertexMode > 0
; Color 0,255,255
; ln=len("Vertex differentiation mode")
; Text (gw2-(ln/2)),50, "Vertex differentiation mode"
; COLOR 180,180,180
; ln=len("select vertex with LMB, toggle through list with L")
; Text (gw2-(ln/2)),70, "select vertex with LMB, toggle through list with L"
;
; ENDIF
; Color 180,180,180
; Text gw-200,70, "weight# = "+weight#
; ENDIF
Color 255,60,40
Rect gw-20,30,20,20
Color 255,100,30
Rect gw-20,50,20,20
Color 255,160,20
Rect gw-20,70,20,20
Color 255,210,10
Rect gw-20,90,20,20
Color 255,255,0
Rect gw-20,110,20,20
Color 25,240,120
Rect gw-20,130,20,20
Color 30,200,150
Rect gw-20,150,20,20
Color 40,130,150
Rect gw-20,170,20,20
Color 50,70,140
Rect gw-20,190,20,20
Color 65,60,90
Rect gw-20,210,20,20
Color 255, 0, 255
Text 10,50, "Parent"
Color 0,255,0
Text 10,70,"Child"
Color 255,0,0
Text 10,90,"Selcted Bone"
Color 0,0,255
Text 10,110, "Unselected Bones"
Color 255,255,255
Text 10,130,"Unselected Vertices"
Color 255,255,0
Text 10,150,"Selected Vertices"
Color 180,180,180
Text 10,170,"Press F1 for Help"
End If
;-------------------------------------------------------------------------------------------------------------
;#End Region
;#Region Small GUI
xpressm = 0
xpressp = 0
ypressm = 0
ypressp = 0
zpressm = 0
zpressp = 0
colR = 3
colG = Int($3D)
colB = Int($4E)
If bonemodus = 1 Then DrawButton b2Xpos,b2ypos-24 ,82,b2dh,colR,colG,colB," Move"
If bonemodus = 2 Then DrawButton b2Xpos,b2ypos-24 ,82,b2dh,colR,colG,colB,"Rotate"
If aktbonespeed = 0
colR = Int($3D)
colG = 3
colB = Int($4E)
DrawButton b2Xpos,b2ypos-48 ,26,b2dh,colR,colG,colB," s"
Else
colR = 3
colG = Int($3D)
colB = Int($4E)
DrawButton b2Xpos,b2ypos-48 ,26,b2dh,colR,colG,colB," s"
EndIf
If aktbonespeed = 1
colR = Int($3D)
colG = 3
colB = Int($4E)
DrawButton b2Xpos+28,b2ypos-48 ,26,b2dh,colR,colG,colB,"m"
Else
colR = 3
colG = Int($3D)
colB = Int($4E)
DrawButton b2Xpos+28,b2ypos-48 ,26,b2dh,colR,colG,colB,"m"
EndIf
If aktbonespeed = 2
colR = Int($3D)
colG = 3
colB = Int($4E)
DrawButton b2Xpos+56,b2ypos-48 ,26,b2dh,colR,colG,colB," f"
Else
colR = 3
colG = Int($3D)
colB = Int($4E)
DrawButton b2Xpos+56,b2ypos-48 ,26,b2dh,colR,colG,colB," f"
EndIf
If MouseDown(1) And msx >= b2Xpos And msy >= b2ypos And msx <= b2Xpos+b2dw And msy <= b2ypos+b2dh
colR = Int($3D)
colG = 3
colB = Int($4E)
DrawButton b2Xpos,b2ypos ,b2dw,b2dh,colR,colG,colB," -X"
xpressm = 1
Else
colR = 255
colG = 0;INT($3D)
colB = 0;INT($4E)
DrawButton b2Xpos,b2ypos ,b2dw,b2dh,colR,colG,colB," -X"
EndIf
If MouseDown(1) And msx >= b2Xpos+b2dw+2 And msy >= b2ypos And msx <= b2Xpos+b2dw+2+b2dw And msy <= b2ypos+b2dh
colR = Int($3D)
colG = 3
colB = Int($4E)
DrawButton b2Xpos+b2dw+2,b2ypos ,b2dw,b2dh,colR,colG,colB," +X"
xpressp = 1
Else
colR = 255
colG = 0;INT($3D)
colB = 0;INT($4E)
DrawButton b2Xpos+b2dw+2,b2ypos ,b2dw,b2dh,colR,colG,colB," +X"
EndIf
If MouseDown(1) And msx >= b2Xpos And msy >= b2ypos+24 And msx <= b2Xpos+b2dw And msy <= b2ypos+24+b2dh
colR = Int($3D)
colG = 3
colB = Int($4E)
DrawButton b2Xpos,b2ypos+24 ,b2dw,b2dh,colR,colG,colB," -Y"
ypressm = 1
Else
colR = 0
colG = 255;INT($3D)
colB = 0;INT($4E)
DrawButton b2Xpos,b2ypos+24 ,b2dw,b2dh,colR,colG,colB," -Y"
EndIf
If MouseDown(1) And msx >= b2Xpos+b2dw+2 And msy >= b2ypos+24 And msx <= b2Xpos+b2dw+2+b2dw And msy <= b2ypos+24+b2dh
colR = Int($3D)
colG = 3
colB = Int($4E)
DrawButton b2Xpos+b2dw+2,b2ypos+24 ,b2dw,b2dh,colR,colG,colB," +Y"
ypressp = 1
Else
colR = 0
colG = 255;INT($3D)
colB = 0;INT($4E)
DrawButton b2Xpos+b2dw+2,b2ypos+24 ,b2dw,b2dh,colR,colG,colB," +Y"
EndIf
If MouseDown(1) And msx >= b2Xpos And msy >= b2ypos+48 And msx <= b2Xpos+b2dw And msy <= b2ypos+48+b2dh
colR = Int($3D)
colG = 3
colB = Int($4E)
DrawButton b2Xpos,b2ypos+48 ,b2dw,b2dh,colR,colG,colB," -Z"
zpressm = 1
Else
colR = 0
colG = 0;INT($3D)
colB = 255;INT($4E)
DrawButton b2Xpos,b2ypos+48 ,b2dw,b2dh,colR,colG,colB," -Z"
EndIf
If MouseDown(1) And msx >= b2Xpos+b2dw+2 And msy >= b2ypos+48 And msx <= b2Xpos+b2dw+2+b2dw And msy <= b2ypos+48+b2dh
colR = Int($3D)
colG = 3
colB = Int($4E)
DrawButton b2Xpos+b2dw+2,b2ypos+48 ,b2dw,b2dh,colR,colG,colB," +Z"
zpressp = 1
Else
colR = 0
colG = 0;INT($3D)
colB = 255;INT($4E)
DrawButton b2Xpos+b2dw+2,b2ypos+48 ,b2dw,b2dh,colR,colG,colB," +Z"
EndIf
; IF mousedown(1) and msx >= 0 and msy >= gh-15
; frameX = msx
; Color 3,$3D,$4E
; RECT 0,gh-20,gw,20,0
; Color 255,0,0
; Rect frameX,gh-20,1,20,1
; FrameProz = (frameX*100)/gw
; aktframenum = ((AnimFrames*FrameProz)/100)+1
; Gosub ShowFrame
; else
;
; Color 3,$3D,$4E
; RECT 0,gh-20,gw,20,0
; Color 255,0,0
; Rect frameX,gh-20,1,20,1
; Color 255,255,255
; RECT MOUSEX()-10,MOUSEY(),20,1,1
; RECT MOUSEX(),MOUSEY()-10,1,20,1
; endif
;-------------------------------------------------------------------------------------------------------------
;#End Region
aktMenu=RenderMenu()
Rect MouseX()-10,MouseY(),20,1,1
Rect MouseX(),MouseY()-10,1,20,1
;
Flip
If KeyHit(Key_X) And KeyDown(KEY_CTRL_LEFT) Then
SaveBuffer FrontBuffer(), "screenshot.bmp"
End If
FlushKeys
Cls
Forever
.aus1
FlushKeys
; save and quit
For Node.Node = Each Node
tempbank = node\ChunkNodeBank
FreeBank tempbank
tempbank = node\childbank
FreeBank tempbank
tb =node\bonebank
FreeBank tb
tb =node\key1bank
FreeBank tb
tb =node\key2bank
FreeBank tb
tb =node\key3bank
FreeBank tb
Next
For tris.tris = Each tris
FreeBank tris\vxbank
Next
.auscl
FreeBank bnx
FreeBank bn2
FreeFont font
FreeFont bigfont
End
;
;
;#End Region
;#Region AnimLoop
;#Region Init AnimLoop
; AnimLoop :::::::::::
.AnimLoop
aktualModus = 2
For I=0 To MnuCount(Mnu$(0))
mnu$(i) = ""
Next
; Initialisieren
HideEntity darky
Dim FRposX#(ANIMframes+1 ,AnzNodes)
Dim FRposY#(ANIMframes+1 ,AnzNodes)
Dim FRposZ#(ANIMframes+1 ,AnzNodes)
Dim FRposDO(ANIMframes+1 ,AnzNodes)
Dim FRscaleX#(ANIMframes+1 ,AnzNodes)
Dim FRscaleY#(ANIMframes+1 ,AnzNodes)
Dim FRscaleZ#(ANIMframes+1 ,AnzNodes)
Dim FRscaleDO(ANIMframes+1 ,AnzNodes)
Dim FRrotW#(ANIMframes+1 ,AnzNodes)
Dim FRrotX#(ANIMframes+1 ,AnzNodes)
Dim FRrotY#(ANIMframes+1 ,AnzNodes)
Dim FRrotZ#(ANIMframes+1 ,AnzNodes)
Dim FRrotDO(ANIMframes+1 ,AnzNodes)
Dim FReuX#(ANIMframes+1 ,AnzNodes)
Dim FReuY#(ANIMframes+1 ,AnzNodes)
Dim FReuZ#(ANIMframes+1 ,AnzNodes)
Dim FReuDO(ANIMframes+1 ,AnzNodes)
Dim STOREposX#(ANIMframes+1 ,AnzNodes)
Dim STOREposY#(ANIMframes+1 ,AnzNodes)
Dim STOREposZ#(ANIMframes+1 ,AnzNodes)
Dim STOREposDO(ANIMframes+1 ,AnzNodes)
Dim STOREscaleX#(ANIMframes+1 ,AnzNodes)
Dim STOREscaleY#(ANIMframes+1 ,AnzNodes)
Dim STOREscaleZ#(ANIMframes+1 ,AnzNodes)
Dim STOREscaleDO(ANIMframes+1 ,AnzNodes)
Dim STORErotW#(ANIMframes+1 ,AnzNodes)
Dim STORErotX#(ANIMframes+1 ,AnzNodes)
Dim STORErotY#(ANIMframes+1 ,AnzNodes)
Dim STORErotZ#(ANIMframes+1 ,AnzNodes)
Dim STORErotDO(ANIMframes+1 ,AnzNodes)
Dim STOREeuX#(ANIMframes+1 ,AnzNodes)
Dim STOREeuY#(ANIMframes+1 ,AnzNodes)
Dim STOREeuZ#(ANIMframes+1 ,AnzNodes)
Dim STOREeuDO(ANIMframes+1 ,AnzNodes)
For i = 0 To animframes
For j = 0 To AnzNodes
FRposX#(i ,j) = 0
FRposY#(i ,j) = 0
FRposZ#(i ,j) = 0
FRposDO(i ,j) = 0
FRscaleX#(i ,j) = 0
FRscaleY#(i ,j) = 0
FRscaleZ#(i ,j) = 0
FRscaleDO(i ,j) = 0
FRrotW#(i ,j) = 0
FRrotX#(i ,j) = 0
FRrotY#(i ,j) = 0
FRrotZ#(i ,j) = 0
FRrotDO(i ,j) = 0
FReuX#(i ,j) = 0
FReuY#(i ,j) = 0
FReuZ#(i ,j) = 0
FReuDO(i ,j) = 0
Next
Next
test2fr = 0
If hasanim > 0
cnode = 0
For node.node = Each node
tempbank = node\key1bank
size = BankSize(tempbank)
If size > 0
Blocksize = 16
K1anz = (size/Blocksize)-1
For z = 0 To K1anz
tmpframe = GetBlockInt( tempbank, z, Blocksize, 0 )
If tmpframe <= AnimFrames
FRposX#(tmpframe,cnode) = GetBlockFloat#( tempbank, z,Blocksize, 4)
FRposY#(tmpframe,cnode) = GetBlockFloat#( tempbank, z, Blocksize, 8)
FRposZ#(tmpframe,cnode) = GetBlockFloat#( tempbank, z,Blocksize, 12 )
FRposDO(tmpframe,cnode) = 1
test2fr = test2fr + 1
EndIf
If tmpframe = 0 Then FrameStart = 0
Next
EndIf
tempbank = node\key2bank
size = BankSize(tempbank)
If size > 0
Blocksize = 16
K2anz = (size/Blocksize)-1
For z = 0 To K2anz
tmpframe = GetBlockInt( tempbank, z, Blocksize, 0 )
If tmpframe <= AnimFrames
FRscaleX#(tmpframe,cnode) = GetBlockFloat#( tempbank, z,Blocksize, 4)
FRscaleY#(tmpframe,cnode) = GetBlockFloat#( tempbank, z, Blocksize, 8)
FRscaleZ#(tmpframe,cnode) = GetBlockFloat#( tempbank, z,Blocksize, 12 )
FRscaleDO(tmpframe,cnode) = 1
test2fr = test2fr + 1
EndIf
If tmpframe = 0 Then FrameStart = 0
Next
EndIf
tempbank = node\key3bank
size = BankSize(tempbank)
If size > 0
Blocksize = 20
K3anz = (size/Blocksize)-1
For z = 0 To K3anz
tmpframe = GetBlockInt( tempbank, z, Blocksize, 0 )
If tmpframe <= AnimFrames
FRrotW#(tmpframe,cnode) = GetBlockFloat#( tempbank, z,Blocksize, 4)
FRrotX#(tmpframe,cnode) = GetBlockFloat#( tempbank, z, Blocksize, 8)
FRrotY#(tmpframe,cnode) = GetBlockFloat#( tempbank, z,Blocksize, 12 )
FRrotZ#(tmpframe,cnode) = GetBlockFloat#( tempbank, z,Blocksize, 16 )
FRrotDO(tmpframe,cnode) = 1
FReuDO(tmpframe,cnode) = 1
test2fr = test2fr + 1
EndIf
If tmpframe = 0 Then FrameStart = 0
Next
EndIf
cnode = cnode+1
Next
node.node = First node
EndIf
.spring
KeyIsLoad = 1
aktframenum = 1
animmodus = 1
filename$ = "Temp.b3d"
saveQuestion = 0
Gosub saveall
FreeEntity theanim
theanim = LoadAnimMesh(filename$)
EntityFX theanim, fx
ShowEntity theanim
HideEntity anim0
;EntityFX theanim,17
;EntityOrder theanim, 10
EntityAlpha theAnim, 0.0
ShowEntity darky
SetFont bigfont
st$ = "Calculate now Bone positions"
ln = StringWidth(st$)
Text gw2-(ln/2),gh2, st$
SetFont font
Flip
bn = CreateBank(100)
If AnimFrames > 0
Dim sq(AnimFrames)
For exf = 0 To AnimFrames
sq(exf) = ExtractAnimSeq(theanim,exf,exf)
;FRkeySEQ$(exf) = exf
Animate theanim,3,1,sq(exf)
;UPDATEWORLD
;RENDERWORLD
cnode = 0
For node.node = Each node
node\bsphereparent = FindChild(theanim,node\name)
MemoryToBank(bn,node\bsphereparent,100)
FRposX#(exf ,cnode) = PeekFloat(bn,16*4)
FRposY#(exf ,cnode) = PeekFloat(bn,17*4)
FRposZ#(exf ,cnode) = PeekFloat(bn,18*4)
If exf <= 1 Then FRposDO(exf ,cnode) = 1
; IF exf > 1
; IF FRposX#(exf-1 ,cnode) = FRposX#(exf ,cnode) AND FRposY#(exf-1 ,cnode) = FRposY#(exf ,cnode) AND FRposZ#(exf-1 ,cnode) = FRposZ#(exf ,cnode)
; FRposDO(exf ,cnode) = 0
; ELSE
; FRposDO(exf ,cnode) = 1
; ENDIF
;
; ENDIF
FRscaleX#(exf ,cnode) = PeekFloat(bn,19*4)
FRscaleY#(exf ,cnode) = PeekFloat(bn,20*4)
FRscaleZ#(exf ,cnode) = PeekFloat(bn,21*4)
If exf <= 1 Then FRscaleDO(exf ,cnode) = 1
; IF exf > 1
; IF FRscaleX#(exf-1 ,cnode) = FRscaleX#(exf ,cnode) AND FRscaleY#(exf-1 ,cnode) = FRscaleY#(exf ,cnode) AND FRscaleZ#(exf-1 ,cnode) = FRscaleZ#(exf ,cnode)
; FRscaleDO(exf ,cnode) = 0
; ELSE
; FRscaleDO(exf ,cnode) = 1
; ENDIF
; ENDIF
FRrotW#(exf ,cnode) = PeekFloat(bn,12*4)
FRrotX#(exf ,cnode) = PeekFloat(bn,13*4)
FRrotY#(exf ,cnode) = PeekFloat(bn,14*4)
FRrotZ#(exf ,cnode) = PeekFloat(bn,15*4)
If exf <= 1 Then FRrotDO(exf ,cnode) = 1 : FReuDO(exf ,cnode) = 1
; IF exf > 1
; IF FRrotW#(exf-1 ,cnode) = FRrotW#(exf ,cnode) AND FRrotX#(exf-1 ,cnode) = FRrotX#(exf ,cnode) AND FRrotY#(exf-1 ,cnode) = FRrotY#(exf ,cnode) AND FRrotZ#(exf-1 ,cnode) <> FRrotZ#(exf ,cnode)
; FReuDO(exf ,cnode) = 0
; FRrotDO(exf ,cnode) = 0
; ELSE
; FReuDO(exf ,cnode) = 1
; FRrotDO(exf ,cnode) = 1
; ENDIF
; ENDIF
FReuX#(exf ,cnode) = EntityPitch#(node\bsphereparent)
FReuY#(exf ,cnode) = EntityYaw#(node\bsphereparent)
FReuZ#(exf ,cnode) = EntityRoll#(node\bsphereparent)
;IF exf < 2 then FReuDO(exf ,cnode) = 1
STOREposX#(exf ,cnode) = FRposX#(exf ,cnode)
STOREposY#(exf ,cnode) = FRposY#(exf ,cnode)
STOREposZ#(exf ,cnode) = FRposZ#(exf ,cnode)
STOREposDO(exf ,cnode) = FRposDO(exf ,cnode)
STOREscaleX#(exf ,cnode) = FRscaleX#(exf ,cnode)
STOREscaleY#(exf ,cnode) = FRscaleY#(exf ,cnode)
STOREscaleZ#(exf ,cnode) = FRscaleZ#(exf ,cnode)
STOREscaleDO(exf ,cnode) = FRscaleDO(exf ,cnode)
STORErotW#(exf ,cnode) = FRrotW#(exf ,cnode)
STORErotX#(exf ,cnode) = FRrotX#(exf ,cnode)
STORErotY#(exf ,cnode) = FRrotY#(exf ,cnode)
STORErotZ#(exf ,cnode) = FRrotZ#(exf ,cnode)
STORErotDO(exf ,cnode) = FRrotDO(exf ,cnode)
STOREeuX#(exf ,cnode) = FReuX#(exf ,cnode)
STOREeuY#(exf ,cnode) = FReuY#(exf ,cnode)
STOREeuZ#(exf ,cnode) = FReuZ#(exf ,cnode)
STOREeuDO(exf ,cnode) = FReuDO(exf ,cnode)
cnode = cnode + 1
Next
ShowEntity darky
SetFont bigfont
st$ = "Calculate now Bone positions"
ln = StringWidth(st$)
Text gw2-(ln/2),gh2, st$
SetFont font
Flip
Next
EndIf
cnode = 0
For node.node = Each node
node\bsphereparent = FindChild(theanim,node\name)
node\bsphere = CreateSphere(6,node\bsphereparent)
EntityPickMode Node\bSphere, 2,0
ScaleEntity Node\bSphere, scsph#, scsph#, scsph# ,1
PaintEntity Node\bSphere, blau
MemoryToBank(bn,node\bsphereparent,100) ;Put in kernel32.decls file>> .lib "kernel32.dll" this line>> MemoryToBank(Destination*,Source,Length):"RtlMoveMemory"
EntityOrder Node\bSphere,-10
cnode = cnode + 1
Next
FreeBank bn
node.node = First node
aktframenum = 1
ShowEntity XYZ
EntityAlpha theAnim ,1.0
EntityParent xyz,0
ScaleEntity xyz,scsph#*40, scsph#*40, scsph#*40
PositionEntity xyz,0,0,0,1
RotateEntity xyz,0,0,0,1
EntityParent xyz, Node\bSphere,0
Gosub ShowFrame
frmCHG = 1
;
;#End Region
|
| ||
;--------- paste this again at the end -------------
;------------------------------------------------------------ Start AnimLoop ------------------------------------------------------------------------------
Repeat ;Mainloop AnimLoop
msx = MouseX()
msy = MouseY()
Code=GetKey ()
b2dw = 40
b2dh = 22
b2Xpos = gw-120
b2ypos = gh-140
;#Region Linke Maustaste
; Linke Maustaste
If GetMouse() = 1
entity = CameraPick(camera, msx, msy)
If msx >= b2Xpos And msy >= b2ypos-24 And msx <= b2Xpos+82 And msy <= b2ypos+b2dh-24
If animmodus = 1
animmodus = 2
ElseIf animmodus = 2
animmodus = 3
ElseIf animmodus = 3
animmodus = 1
EndIf
ElseIf msx >= b2Xpos And msy >= b2ypos-48 And msx <= b2Xpos+26 And msy <= b2ypos+b2dh-48
rotspeed# = rt1speed#
movespeed# = mv1speed#
scalespeed# = sc1speed#
aktbonespeed = 0
ElseIf msx >= b2Xpos+28 And msy >= b2ypos-48 And msx <= b2Xpos+28+26 And msy <= b2ypos+b2dh-48
rotspeed# = rt2speed#
movespeed# = mv2speed#
scalespeed# = sc2speed#
aktbonespeed = 1
ElseIf msx >= b2Xpos+56 And msy >= b2ypos-48 And msx <= b2Xpos+56+26 And msy <= b2ypos+b2dh-48
rotspeed# = rt3speed#
movespeed# = mv3speed#
scalespeed# = sc3speed#
aktbonespeed = 2
ElseIf entity<>0
For node.node = Each node
If Node\bSphere > 0 Then PaintEntity Node\bSphere, blau
;EntityAlpha node\bsphere,0.6
;EntityBlend node\bsphere,3
Next
For node.node = Each node
If entity = Node\bSphere
thisID = node\num
PaintEntity Node\bSphere, rot
;EntityAlpha node\bsphere,0.6
;EntityBlend node\bsphere,3
t2hd = node\bsphereparent
EntityParent xyz, Node\bSphere,0
ScaleEntity xyz,scsph#*40, scsph#*40, scsph#*40
aktbonename$ = Node\name
If node\anzchild > 0
tempbank = node\childbank
For anc = 1 To node\anzchild
CHandle = PeekInt (tempbank, (anc-1)*4)
node.node = Object.node(CHandle)
If node\bSphere > 0
PaintEntity node\bSphere,gruen
;EntityAlpha node\bsphere,0.6
;EntityBlend node\bsphere,3
EndIf
node.node = Object.node(thisID)
Next
node.node = Object.node(thisID)
EndIf
If node\parent > 0
node.node = Object.node(node\parent)
PaintEntity node\bSphere,violett
;EntityAlpha node\bsphere,0.6
;EntityBlend node\bsphere,3
EndIf
node.node = Object.node(thisID)
Goto paintfertig3
EndIf
Next
EndIf
EndIf
.paintfertig3
;
;#End Region
;#Region Mittlere Maustaste
; Mittlere Maustaste
mzspeed#=MouseZSpeed()
If mzspeed# And ( KeyDown(KEY_SHIFT_LINKS ) <> 0 ) Or ( KeyDown(KEY_SHIFT_RECHTS ) <> 0)
MoveEntity Camera, 0, 0, (mzspeed#/15)
ElseIf mzspeed# And ( KeyDown(KEY_STRG_LINKS ) <> 0 ) Or ( KeyDown(KEY_STRG_RECHTS ) <> 0)
MoveEntity Camera, 0, 0, (mzspeed#*2.9)
Else
MoveEntity Camera, 0, 0, (mzspeed#/1.5)
EndIf
If MouseDown(3)
mxspeed#=MouseXSpeed()
myspeed#=MouseYSpeed()
If KeyDown(KEY_CTRL_RIGHT) Or KeyDown(KEY_CTRL_Left)
mxspeed = mxspeed-(mxspeed*2)
If delspeed = 1
MoveEntity Camera, mxspeed#/5.0, 0, 0
MoveEntity Camera, 0, myspeed#/5.0, 0
EndIf
ElseIf KeyDown(KEY_SHIFT_LINKS ) Or KeyDown(KEY_SHIFT_RECHTS )
If delspeed = 1
mxspeed = mxspeed-(mxspeed*2)
If msx > (gw2-(gw2/10)) And msx < (gw2+(gw2/10))
TurnEntity piv, myspeed#,0, 0 , 0
Else
If msx < gw2 Then myspeed = myspeed-(myspeed*2)
TurnEntity piv, 0, 0, myspeed#
EndIf
TurnEntity piv, 0, mxspeed#, 0 , 0
EndIf
Else
If delspeed = 1
mxspeed = mxspeed-(mxspeed*2)
TurnEntity piv, myspeed#,0, 0 , 0
TurnEntity piv, 0, mxspeed#, 0 , 1
EndIf
EndIf
delspeed = 1
Else
delspeed = 0
End If
;
;#End Region
;#Region Tasten --- Keys
; Tasten
; STRG
If KeyDown(KEY_CTRL_RIGHT) Or KeyDown(KEY_CTRL_Left) And KeyDown(KEY_ALT_RECHTS) = 0;--------------------- CTRL/STRG + KEY -----
If KeyDown(Key_Links) Then MoveEntity piv, -0.2, 0, 0
If KeyDown(Key_Rechts) Then MoveEntity piv, 0.2, 0, 0
If KeyDown(Key_Auf) Then MoveEntity piv, 0, 0.2, 0
If KeyDown(Key_Ab) Then MoveEntity piv, 0, -0.2, 0
If KeyDown(Key_BILD_Auf) ; Plane hoch
MoveEntity plane, 0.0, 0.01,0.0
ElseIf KeyDown(Key_BILD_Ab) ; Plane runter
MoveEntity plane, 0.0, -0.01,0.0
EndIf
If KeyDown(52) ; STRG + Komma ( , ) 50% zurück
animPM = (AnimFrames*50)/100
If aktframenum < AnimFrames-animPM
aktframenum = aktframenum +animPM
Else
aktframenum = AnimFrames
EndIf
Gosub ShowFrameAll
DownWait(52)
frmCHG = 1
ElseIf KeyDown(51) ; STRG + Punkt (.) 50% weiter
animPM = (AnimFrames*50)/100
If aktframenum > 1 + animPM
aktframenum = aktframenum - animPM
Else
aktframenum = 1
EndIf
Gosub ShowFrameAll
DownWait(51)
frmCHG = 1
ElseIf KeyDown(Key_7) Or KeyDown(Key_NUM_2) Or aktMenu2 = 208 ;Restore actual Frame the actual Bone
FRposX#(aktframenum ,(node\num - minusnode)) = STOREposX#(aktframenum ,(node\num - minusnode))
FRposY#(aktframenum ,(node\num - minusnode)) = STOREposY#(aktframenum ,(node\num - minusnode))
FRposZ#(aktframenum ,(node\num - minusnode)) = STOREposZ#(aktframenum ,(node\num - minusnode))
FRposDO(aktframenum ,(node\num - minusnode)) = STOREposDO(aktframenum ,(node\num - minusnode))
FRscaleX#(aktframenum ,(node\num - minusnode)) = STOREscaleX#(aktframenum ,(node\num - minusnode))
FRscaleY#(aktframenum ,(node\num - minusnode)) = STOREscaleY#(aktframenum ,(node\num - minusnode))
FRscaleZ#(aktframenum ,(node\num - minusnode)) = STOREscaleZ#(aktframenum ,(node\num - minusnode))
FRscaleDO(aktframenum ,(node\num - minusnode)) = STOREscaleDO(aktframenum ,(node\num - minusnode))
FRrotW#(aktframenum ,(node\num - minusnode)) = STORErotW#(aktframenum ,(node\num - minusnode))
FRrotX#(aktframenum ,(node\num - minusnode)) = STORErotX#(aktframenum ,(node\num - minusnode))
FRrotY#(aktframenum ,(node\num - minusnode)) = STORErotY#(aktframenum ,(node\num - minusnode))
FRrotZ#(aktframenum ,(node\num - minusnode)) = STORErotZ#(aktframenum ,(node\num - minusnode))
FRrotDO(aktframenum ,(node\num - minusnode)) = STORErotDO(aktframenum ,(node\num - minusnode))
FReuX#(aktframenum ,(node\num - minusnode)) = STOREeuX#(aktframenum ,(node\num - minusnode))
FReuY#(aktframenum ,(node\num - minusnode)) = STOREeuY#(aktframenum ,(node\num - minusnode))
FReuZ#(aktframenum ,(node\num - minusnode)) = STOREeuZ#(aktframenum ,(node\num - minusnode))
FReuDO(aktframenum ,(node\num - minusnode)) = STOREeuDO(aktframenum ,(node\num - minusnode))
Gosub ShowFrameAll
ElseIf KeyDown(Key_8) Or KeyDown(Key_NUM_5) Or aktMenu2 = 209 ;Restore actual Frame all Bones
thisHD = node\num
For node.node = Each node
FRposX#(aktframenum ,(node\num - minusnode)) = STOREposX#(aktframenum ,(node\num - minusnode))
FRposY#(aktframenum ,(node\num - minusnode)) = STOREposY#(aktframenum ,(node\num - minusnode))
FRposZ#(aktframenum ,(node\num - minusnode)) = STOREposZ#(aktframenum ,(node\num - minusnode))
FRposDO(aktframenum ,(node\num - minusnode)) = STOREposDO(aktframenum ,(node\num - minusnode))
FRscaleX#(aktframenum ,(node\num - minusnode)) = STOREscaleX#(aktframenum ,(node\num - minusnode))
FRscaleY#(aktframenum ,(node\num - minusnode)) = STOREscaleY#(aktframenum ,(node\num - minusnode))
FRscaleZ#(aktframenum ,(node\num - minusnode)) = STOREscaleZ#(aktframenum ,(node\num - minusnode))
FRscaleDO(aktframenum ,(node\num - minusnode)) = STOREscaleDO(aktframenum ,(node\num - minusnode))
FRrotW#(aktframenum ,(node\num - minusnode)) = STORErotW#(aktframenum ,(node\num - minusnode))
FRrotX#(aktframenum ,(node\num - minusnode)) = STORErotX#(aktframenum ,(node\num - minusnode))
FRrotY#(aktframenum ,(node\num - minusnode)) = STORErotY#(aktframenum ,(node\num - minusnode))
FRrotZ#(aktframenum ,(node\num - minusnode)) = STORErotZ#(aktframenum ,(node\num - minusnode))
FRrotDO(aktframenum ,(node\num - minusnode)) = STORErotDO(aktframenum ,(node\num - minusnode))
FReuX#(aktframenum ,(node\num - minusnode)) = STOREeuX#(aktframenum ,(node\num - minusnode))
FReuY#(aktframenum ,(node\num - minusnode)) = STOREeuY#(aktframenum ,(node\num - minusnode))
FReuZ#(aktframenum ,(node\num - minusnode)) = STOREeuZ#(aktframenum ,(node\num - minusnode))
FReuDO(aktframenum ,(node\num - minusnode)) = STOREeuDO(aktframenum ,(node\num - minusnode))
Gosub ShowFrameAll
Next
node.node = Object.node(thisHD)
ElseIf KeyDown(Key_9) Or KeyDown(Key_NUM_8) Or aktMenu2 = 210 ;Restore all Frames all Bones
thisHD = node\num
storeframe = aktframenum
For cfr = 0 To AnimFrames
For node.node = Each node
FRposX#(cfr ,(node\num - minusnode)) = STOREposX#(cfr ,(node\num - minusnode))
FRposY#(cfr ,(node\num - minusnode)) = STOREposY#(cfr ,(node\num - minusnode))
FRposZ#(cfr ,(node\num - minusnode)) = STOREposZ#(cfr ,(node\num - minusnode))
FRposDO(cfr ,(node\num - minusnode)) = STOREposDO(cfr ,(node\num - minusnode))
FRscaleX#(cfr ,(node\num - minusnode)) = STOREscaleX#(cfr ,(node\num - minusnode))
FRscaleY#(cfr ,(node\num - minusnode)) = STOREscaleY#(cfr ,(node\num - minusnode))
FRscaleZ#(cfr ,(node\num - minusnode)) = STOREscaleZ#(cfr ,(node\num - minusnode))
FRscaleDO(cfr ,(node\num - minusnode)) = STOREscaleDO(cfr ,(node\num - minusnode))
FRrotW#(cfr ,(node\num - minusnode)) = STORErotW#(cfr ,(node\num - minusnode))
FRrotX#(cfr ,(node\num - minusnode)) = STORErotX#(cfr ,(node\num - minusnode))
FRrotY#(cfr ,(node\num - minusnode)) = STORErotY#(cfr ,(node\num - minusnode))
FRrotZ#(cfr ,(node\num - minusnode)) = STORErotZ#(cfr ,(node\num - minusnode))
FRrotDO(cfr ,(node\num - minusnode)) = STORErotDO(cfr ,(node\num - minusnode))
FReuX#(cfr ,(node\num - minusnode)) = STOREeuX#(cfr ,(node\num - minusnode))
FReuY#(cfr ,(node\num - minusnode)) = STOREeuY#(cfr ,(node\num - minusnode))
FReuZ#(cfr ,(node\num - minusnode)) = STOREeuZ#(cfr ,(node\num - minusnode))
FReuDO(cfr ,(node\num - minusnode)) = STOREeuDO(cfr ,(node\num - minusnode))
Gosub ShowFrameAll
Next
Next
node.node = Object.node(thisHD)
aktframenum = storeframe
ElseIf KeyDown(Key_C) ; CTRL + C = CopyFrame
Gosub copyFrame
Gosub ShowFrame
DownWait(KEY_C)
ElseIf KeyDown(Key_V) ;CTRL + V = PasteFrame
Gosub pasteFrame
Gosub ShowFrame
DownWait(KEY_V)
ElseIf KeyDown(KEY_SHIFT_LEFT) And KeyDown(Key_A) ; shows pos scale rot from active node
animdebug = 1 - animdebug
DownWait(KEY_A)
EndIf
;
; ALT
ElseIf KeyDown(KEY_ALT_LINKS) Or KeyDown(KEY_ALT_RECHTS) ;---------------------------- ALT + KEY ------
If KeyDown(52)
animPM = (AnimFrames*25)/100 ; ALT + Komma ( , ) 25% zurück
If aktframenum < AnimFrames-animPM
aktframenum = aktframenum +animPM
Else
aktframenum = AnimFrames
EndIf
Gosub ShowFrameAll
DownWait(52)
frmCHG = 1
ElseIf KeyDown(51) ; STRG + Punkt (.) 25% weiter
animPM = (AnimFrames*25)/100
If aktframenum > 1 + animPM
aktframenum = aktframenum - animPM
Else
aktframenum = 1
EndIf
Gosub ShowFrameAll
DownWait(51)
frmCHG = 1
ElseIf KeyDown(Key_S) ; ALT + S = saveFile
DownWait(Key_S)
saveQuestion = 1
Gosub savewithfilereq
EndIf
;
; SHIFT
ElseIf KeyDown(KEY_SHIFT_RIGHT) Or KeyDown(KEY_SHIFT_Left) ;---------------------- SHIFT + Key -----
If KeyDown(52)
animPM = (AnimFrames*10)/100
If aktframenum < AnimFrames-animPM ; SHIFT + Komma ( , ) 10% zurück
aktframenum = aktframenum +animPM
Else
aktframenum = AnimFrames
EndIf
Gosub ShowFrameAll
DownWait(52)
ElseIf KeyDown(51) ; SHIFT + Punkt (.) 10% weiter
animPM = (AnimFrames*10)/100
If aktframenum > 1 + animPM
aktframenum = aktframenum - animPM
Else
aktframenum = 1
EndIf
Gosub ShowFrameAll
DownWait(51)
EndIf
;
; Keys
Else ;--------------------------------------------------------------------------------- pure Keys -----------------------
If KeyDown(Key_INSERT)
MoveEntity Camera, 0, 0, 0.2
ElseIf KeyDown(Key_DELETE)
MoveEntity camera, 0, 0, -0.2
ElseIf KeyDown(Key_POS1)
MoveEntity Camera, 0, 0, 0.004
ElseIf KeyDown(Key_ENDE)
MoveEntity camera, 0, 0, -0.004
ElseIf KeyDown(Key_Links)
TurnEntity piv, 0.0, 1, 0.0
ElseIf KeyDown(Key_Rechts)
TurnEntity piv, 0.0, -1, 0.0
ElseIf KeyDown(Key_Auf)
TurnEntity piv, 1.0, 0, 0.0
ElseIf KeyDown(Key_Ab)
TurnEntity piv, -1.0, 0, 0.0
ElseIf KeyDown(Key_BILD_Auf)
TurnEntity piv, 0.0, 0, 1.0
ElseIf KeyDown(Key_BILD_Ab)
TurnEntity piv, .0, 0, -1.0
; Key_Backspace Vertex Bone Modus
ElseIf KeyDown(Key_Backspace) Or aktMenu2 = 401
EntityParent xyz,0
i = 0
thisHD = node\num
For vrts.vrts = Each vrts
ShowEntity Cubes(i)
i = i +1
Next
For node.node = Each node
ShowEntity Node\Sphere
ShowEntity Node\Spiv
FreeEntity Node\bsphere
Next
HideEntity theanim
EntityParent XYZ,0
ScaleEntity xyz,scsph#*3, scsph#*3, scsph#*3
PositionEntity xyz,0,0,0,1
RotateEntity xyz,0,0,0,1
;HideEntity XYZ
ShowEntity anim0
xpressm = 0
xpressp = 0
ypressm = 0
ypressp = 0
zpressm = 0
zpressp = 0
E_RM_mode = 1
node.node = Object.node(thisHD)
aktmenu2 = 0
filename$ = "Temp.b3d"
saveQuestion = 0
Gosub saveall
Goto MainLoop
;
ElseIf KeyDown(KEY_F1) Or aktMenu2 = 801 ; HELP
help = 1-help
DownWait(Key_F1)
MouseUpWait(1)
ElseIf KeyDown(KEY_F) Or aktMenu2 = 305 ; EntityFX
If fx = 0
fx = 16
Else
fx = 0
EndIf
EntityFX theanim, fx
DownWait(Key_F)
ElseIf KeyDown(KEY_W) Or aktMenu2 = 304 ;WIREDFRAME
wired = 1-wired
WireFrame wired
DownWait(Key_W)
ElseIf KeyDown(KEY_Space) Or KeyDown(KEY_J)Or aktMenu2 = 301 ;Jump to Sphere
spx# = EntityX#(node\bsphere,1)
spy# = EntityY#(node\bsphere,1)
spz# = EntityZ#(node\bsphere,1)
PositionEntity piv,spx#,spy#,spz#
DownWait(KEY_J)
DownWait(KEY_Space)
ElseIf KeyDown(KEY_C) Or aktMenu2 = 302 ; Center View <<<<<<<<< überarbeiten
thisHD = node\num
spxr# = 0
spyr# = 0
spzr# = 0
spcount = 0
For node.node = Each node
spxr# = spxr# + EntityX#(node\bsphere,1)
spyr# = spyr# + EntityY#(node\bsphere,1)
spzr# = spzr# + EntityZ#(node\bsphere,1)
spcount = spcount + 1
Next
spxr# = spxr# / spcount
spyr# = spyr# / spcount
spzr# = spzr# / spcount
node.node = Object.node(thisHD)
PositionEntity piv,spxr#,spyr#,spzr#
DownWait(KEY_C)
; Add Frame
ElseIf KeyDown(KEY_A) Or aktMenu2 = 203;----------------------------------------------- Add FRAME
If AnimFrames > 0
thisNode = Node\num
insertFrame = 0
AnimFrames = AnimFrames+1
addframe = 1
deleteframe = 0
Gosub redimFR
Node.node = Object.node(thisNode)
EndIf
aktframenum = AnimFrames
Gosub ShowFrame
DownWait(Key_A)
frmCHG = 1
;
; Insert frame
ElseIf KeyDown(KEY_I) Or aktMenu2 = 204
If AnimFrames > 0
thisNode = Node\num
insertFrame = aktframenum + 1
AnimFrames = AnimFrames+1
addframe = 0
deleteframe = 0
Gosub redimFR
aktframenum = aktframenum + 1
Node.node = Object.node(thisNode)
frmCHG = 1
EndIf
Gosub ShowFrame
DownWait(Key_I)
;
; Delete frame
ElseIf KeyDown(KEY_D) Or aktMenu2 = 206
If AnimFrames > 1 And aktframenum > 1
thisNode = Node\num
deleteFrame = aktframenum
AnimFrames = AnimFrames-1
addframe = 0
insertFrame = 0
Gosub redimFR
Node.node = Object.node(thisNode)
aktframenum = aktframenum - 1
EndIf
Gosub ShowFrame
DownWait(Key_D)
frmCHG = 1
;
ElseIf KeyDown(KEY_R) Or aktMenu2 = 403 ; Rotationsmodus
animmodus = 1
ElseIf KeyDown(KEY_M) Or aktMenu2 = 404 ; Movemodus
animmodus = 2
ElseIf KeyDown(KEY_S) Or aktMenu2 = 405 ; Scalemodus
animmodus = 3
; Frame + 1
ElseIf KeyDown(52) ;Frame +
If aktframenum < AnimFrames
aktframenum = aktframenum + 1
Else
aktframenum = 1
EndIf
Gosub ShowFrame
DownWait(52)
frmCHG = 1
;
; Frame - 1
ElseIf KeyDown(51) ; Frame -
If aktframenum > 1
aktframenum = aktframenum - 1
Else
aktframenum = AnimFrames
EndIf
Gosub ShowFrameAll
DownWait(51)
frmCHG = 1
;
; Rot Scale Move Bones
ElseIf KeyDown(Key_1) Or KeyDown(Key_NUM_1) Or xpressM = 1;x
If animmodus = 1 ;Rot
FReuX#(aktframenum ,(node\num - minusnode)) = FReuX#(aktframenum ,(node\num - minusnode)) - rotspeed#
RotateEntity node\bsphereparent, FReuX#(aktframenum ,(node\num - minusnode)) , FReuY#(aktframenum , (node\num - minusnode)) , FReuZ#(aktframenum ,(node\num - minusnode))
MemoryToBank(bnx,node\bsphereparent,100)
FRrotW#(aktframenum ,(node\num - minusnode)) = PeekFloat(bnx,12*4)
FRrotX#(aktframenum ,(node\num - minusnode)) = PeekFloat(bnx,13*4)
FRrotY#(aktframenum ,(node\num - minusnode)) = PeekFloat(bnx,14*4)
FRrotZ#(aktframenum ,(node\num - minusnode)) = PeekFloat(bnx,15*4)
FRrotDO(aktframenum ,(node\num - minusnode)) = 1
FReuDO(aktframenum ,(node\num - minusnode)) = 1
ElseIf animmodus = 2 ;Move
MemoryToBank(bnx,node\bsphereparent,100)
MoveEntity node\bsphereparent, -movespeed#,0,0
FRposX#(aktframenum ,(node\num - minusnode)) = PeekFloat(bnx,16*4)
FRposY#(aktframenum ,(node\num - minusnode)) = PeekFloat(bnx,17*4)
FRposZ#(aktframenum ,(node\num - minusnode)) = PeekFloat(bnx,18*4)
FRposDO(aktframenum ,(node\num - minusnode)) = 1
ElseIf animmodus = 3 ;Scale
FRscaleX#(aktframenum ,(node\num - minusnode)) = FRscaleX#(aktframenum ,(node\num - minusnode)) - scalespeed#
EntityParent node\bsphere,0
ScaleEntity node\bsphereparent, FRscaleX#(aktframenum ,(node\num - minusnode)) , FRscaleY#(aktframenum ,(node\num - minusnode)) , FRscaleZ#(aktframenum ,(node\num - minusnode))
EntityParent node\bsphere,node\bsphereparent
FRscaleDO(aktframenum ,(node\num - minusnode)) = 1
EndIf
ElseIf KeyDown(Key_2) Or KeyDown(Key_NUM_3) Or xpressP = 1 ;x
If animmodus = 1 ;Rot
FReuX#(aktframenum ,(node\num - minusnode)) = FReuX#(aktframenum ,(node\num - minusnode)) + rotspeed#
RotateEntity node\bsphereparent, FReuX#(aktframenum ,(node\num - minusnode)) , FReuY#(aktframenum , (node\num - minusnode)) , FReuZ#(aktframenum ,(node\num - minusnode))
MemoryToBank(bnx,node\bsphereparent,100)
FRrotW#(aktframenum ,(node\num - minusnode)) = PeekFloat(bnx,12*4)
FRrotX#(aktframenum ,(node\num - minusnode)) = PeekFloat(bnx,13*4)
FRrotY#(aktframenum ,(node\num - minusnode)) = PeekFloat(bnx,14*4)
FRrotZ#(aktframenum ,(node\num - minusnode)) = PeekFloat(bnx,15*4)
FRrotDO(aktframenum ,(node\num - minusnode)) = 1
FReuDO(aktframenum ,(node\num - minusnode)) = 1
ElseIf animmodus = 2 ;Move
MemoryToBank(bnx,node\bsphereparent,100)
MoveEntity node\bsphereparent, +movespeed#,0,0
FRposX#(aktframenum ,(node\num - minusnode)) = PeekFloat(bnx,16*4)
FRposY#(aktframenum ,(node\num - minusnode)) = PeekFloat(bnx,17*4)
FRposZ#(aktframenum ,(node\num - minusnode)) = PeekFloat(bnx,18*4)
FRposDO(aktframenum ,(node\num - minusnode)) = 1
ElseIf animmodus = 3 ;Scale
FRscaleX#(aktframenum ,(node\num - minusnode)) = FRscaleX#(aktframenum ,(node\num - minusnode)) + scalespeed#
EntityParent node\bsphere,0
ScaleEntity node\bsphereparent, FRscaleX#(aktframenum ,(node\num - minusnode)) , FRscaleY#(aktframenum ,(node\num - minusnode)) , FRscaleZ#(aktframenum ,(node\num - minusnode))
EntityParent node\bsphere,node\bsphereparent
FRscaleDO(aktframenum ,(node\num - minusnode)) = 1
EndIf
ElseIf KeyDown(Key_3) Or KeyDown(Key_NUM_4) Or ypressM = 1 ;y
If animmodus = 1 ;Rot
FReuY#(aktframenum ,(node\num - minusnode)) = FReuY#(aktframenum ,(node\num - minusnode)) - rotspeed#
RotateEntity node\bsphereparent, FReuX#(aktframenum ,(node\num - minusnode)) , FReuY#(aktframenum , (node\num - minusnode)) , FReuZ#(aktframenum ,(node\num - minusnode))
MemoryToBank(bnx,node\bsphereparent,100)
FRrotW#(aktframenum ,(node\num - minusnode)) = PeekFloat(bnx,12*4)
FRrotX#(aktframenum ,(node\num - minusnode)) = PeekFloat(bnx,13*4)
FRrotY#(aktframenum ,(node\num - minusnode)) = PeekFloat(bnx,14*4)
FRrotZ#(aktframenum ,(node\num - minusnode)) = PeekFloat(bnx,15*4)
FRrotDO(aktframenum ,(node\num - minusnode)) = 1
FReuDO(aktframenum ,(node\num - minusnode)) = 1
ElseIf animmodus = 2 ;Move
MemoryToBank(bnx,node\bsphereparent,100)
MoveEntity node\bsphereparent, 0,-movespeed#,0
FRposX#(aktframenum ,(node\num - minusnode)) = PeekFloat(bnx,16*4)
FRposY#(aktframenum ,(node\num - minusnode)) = PeekFloat(bnx,17*4)
FRposZ#(aktframenum ,(node\num - minusnode)) = PeekFloat(bnx,18*4)
FRposDO(aktframenum ,(node\num - minusnode)) = 1
ElseIf animmodus = 3 ;Scale
FRscaleY#(aktframenum ,(node\num - minusnode)) = FRscaleY#(aktframenum ,(node\num - minusnode)) - scalespeed#
EntityParent node\bsphere,0
ScaleEntity node\bsphereparent, FRscaleX#(aktframenum ,(node\num - minusnode)) , FRscaleY#(aktframenum ,(node\num - minusnode)) , FRscaleZ#(aktframenum ,(node\num - minusnode))
EntityParent node\bsphere,node\bsphereparent
FRscaleDO(aktframenum ,(node\num - minusnode)) = 1
;FReuDO(aktframenum ,(node\num - minusnode)) = 1
EndIf
ElseIf KeyDown(Key_4) Or KeyDown(Key_NUM_6) Or ypressP = 1 ;y
If animmodus = 1 ;Rot
FReuY#(aktframenum ,(node\num - minusnode)) = FReuY#(aktframenum ,(node\num - minusnode)) + rotspeed#
RotateEntity node\bsphereparent, FReuX#(aktframenum ,(node\num - minusnode)) , FReuY#(aktframenum , (node\num - minusnode)) , FReuZ#(aktframenum ,(node\num - minusnode))
MemoryToBank(bnx,node\bsphereparent,100)
FRrotW#(aktframenum ,(node\num - minusnode)) = PeekFloat(bnx,12*4)
FRrotX#(aktframenum ,(node\num - minusnode)) = PeekFloat(bnx,13*4)
FRrotY#(aktframenum ,(node\num - minusnode)) = PeekFloat(bnx,14*4)
FRrotZ#(aktframenum ,(node\num - minusnode)) = PeekFloat(bnx,15*4)
FRrotDO(aktframenum ,(node\num - minusnode)) = 1
FReuDO(aktframenum ,(node\num - minusnode)) = 1
ElseIf animmodus = 2 ;Move
MemoryToBank(bnx,node\bsphereparent,100)
MoveEntity node\bsphereparent, 0,+movespeed#,0
FRposX#(aktframenum ,(node\num - minusnode)) = PeekFloat(bnx,16*4)
FRposY#(aktframenum ,(node\num - minusnode)) = PeekFloat(bnx,17*4)
FRposZ#(aktframenum ,(node\num - minusnode)) = PeekFloat(bnx,18*4)
FRposDO(aktframenum ,(node\num - minusnode)) = 1
ElseIf animmodus = 3 ;Scale
FRscaleY#(aktframenum ,(node\num - minusnode)) = FRscaleY#(aktframenum ,(node\num - minusnode)) + scalespeed#
EntityParent node\bsphere,0
ScaleEntity node\bsphereparent, FRscaleX#(aktframenum ,(node\num - minusnode)) , FRscaleY#(aktframenum ,(node\num - minusnode)) , FRscaleZ#(aktframenum ,(node\num - minusnode))
EntityParent node\bsphere,node\bsphereparent
FRscaleDO(aktframenum ,(node\num - minusnode)) = 1
EndIf
ElseIf KeyDown(Key_5) Or KeyDown(Key_NUM_7) Or zpressM = 1 ;z
If animmodus = 1 ;Rot
FReuZ#(aktframenum ,(node\num - minusnode)) = FReuZ#(aktframenum ,(node\num - minusnode)) - rotspeed#
RotateEntity node\bsphereparent, FReuX#(aktframenum ,(node\num - minusnode)) , FReuY#(aktframenum , (node\num - minusnode)) , FReuZ#(aktframenum ,(node\num - minusnode))
MemoryToBank(bnx,node\bsphereparent,100)
FRrotW#(aktframenum ,(node\num - minusnode)) = PeekFloat(bnx,12*4)
FRrotX#(aktframenum ,(node\num - minusnode)) = PeekFloat(bnx,13*4)
FRrotY#(aktframenum ,(node\num - minusnode)) = PeekFloat(bnx,14*4)
FRrotZ#(aktframenum ,(node\num - minusnode)) = PeekFloat(bnx,15*4)
FRrotDO(aktframenum ,(node\num - minusnode)) = 1
FReuDO(aktframenum ,(node\num - minusnode)) = 1
ElseIf animmodus = 2 ;Move
MemoryToBank(bnx,node\bsphereparent,100)
MoveEntity node\bsphereparent, 0, 0, -movespeed#
FRposX#(aktframenum ,(node\num - minusnode)) = PeekFloat(bnx,16*4)
FRposY#(aktframenum ,(node\num - minusnode)) = PeekFloat(bnx,17*4)
FRposZ#(aktframenum ,(node\num - minusnode)) = PeekFloat(bnx,18*4)
FRposDO(aktframenum ,(node\num - minusnode)) = 1
ElseIf animmodus = 3 ;Scale
FRscaleZ#(aktframenum ,(node\num - minusnode)) = FRscaleZ#(aktframenum ,(node\num - minusnode)) - scalespeed#
EntityParent node\bsphere,0
ScaleEntity node\bsphereparent, FRscaleX#(aktframenum ,(node\num - minusnode)) , FRscaleY#(aktframenum ,(node\num - minusnode)) , FRscaleZ#(aktframenum ,(node\num - minusnode))
EntityParent node\bsphere,node\bsphereparent
FRscaleDO(aktframenum ,(node\num - minusnode)) = 1
EndIf
ElseIf KeyDown(Key_6) Or KeyDown(Key_NUM_9) Or zpressP = 1 ;z
If animmodus = 1 ;Rot
FReuZ#(aktframenum ,(node\num - minusnode)) = FReuZ#(aktframenum ,(node\num - minusnode)) + rotspeed#
RotateEntity node\bsphereparent, FReuX#(aktframenum ,(node\num - minusnode)) , FReuY#(aktframenum , (node\num - minusnode)) , FReuZ#(aktframenum ,(node\num - minusnode))
MemoryToBank(bnx,node\bsphereparent,100)
FRrotW#(aktframenum ,(node\num - minusnode)) = PeekFloat(bnx,12*4)
FRrotX#(aktframenum ,(node\num - minusnode)) = PeekFloat(bnx,13*4)
FRrotY#(aktframenum ,(node\num - minusnode)) = PeekFloat(bnx,14*4)
FRrotZ#(aktframenum ,(node\num - minusnode)) = PeekFloat(bnx,15*4)
FRrotDO(aktframenum ,(node\num - minusnode)) = 1
FReuDO(aktframenum ,(node\num - minusnode)) = 1
ElseIf animmodus = 2 ;Move
MemoryToBank(bnx,node\bsphereparent,100)
MoveEntity node\bsphereparent, 0, 0, +movespeed#
FRposX#(aktframenum ,(node\num - minusnode)) = PeekFloat(bnx,16*4)
FRposY#(aktframenum ,(node\num - minusnode)) = PeekFloat(bnx,17*4)
FRposZ#(aktframenum ,(node\num - minusnode)) = PeekFloat(bnx,18*4)
FRposDO(aktframenum ,(node\num - minusnode)) = 1
ElseIf animmodus = 3 ;Scale
FRscaleZ#(aktframenum ,(node\num - minusnode)) = FRscaleZ#(aktframenum ,(node\num - minusnode)) + scalespeed#
EntityParent node\bsphere,0
ScaleEntity node\bsphereparent, FRscaleX#(aktframenum ,(node\num - minusnode)) , FRscaleY#(aktframenum ,(node\num - minusnode)) , FRscaleZ#(aktframenum ,(node\num - minusnode))
EntityParent node\bsphere,node\bsphereparent
FRscaleDO(aktframenum ,(node\num - minusnode)) = 1
EndIf
;
ElseIf KeyDown(1) Or aktMenu2 = 103 ; Beenden Quit Fini
checkend = 1
DownWait(1)
ElseIf KeyDown(KEY_0) Or KeyDown(KEY_NUM_0) ;lösche Frame und setze Nullwerte aus vorhergehendem
thisHD = node\num
cnode = 0
For node.node = Each node
FRposX#(aktframenum ,(node\num - minusnode)) = FRposX#(aktframenum-1 ,(node\num - minusnode ))
FRposY#(aktframenum ,(node\num - minusnode)) = FRposY#(aktframenum-1 ,(node\num - minusnode ))
FRposZ#(aktframenum ,(node\num - minusnode)) = FRposZ#(aktframenum-1 ,(node\num - minusnode ))
FRposDO(aktframenum ,cnode) = 0
FRscaleX#(aktframenum ,(node\num - minusnode)) = FRscaleX#(aktframenum-1 ,(node\num - minusnode))
FRscaleY#(aktframenum ,(node\num - minusnode)) = FRscaleY#(aktframenum-1 ,(node\num - minusnode))
FRscaleZ#(aktframenum ,(node\num - minusnode)) = FRscaleZ#(aktframenum-1 ,(node\num - minusnode))
FRscaleDO(aktframenum ,cnode) = 0
FRrotW#(aktframenum ,(node\num - minusnode)) = FRrotW#(aktframenum-1 ,(node\num - minusnode))
FRrotX#(aktframenum ,(node\num - minusnode)) = FRrotX#(aktframenum-1 ,(node\num - minusnode))
FRrotY#(aktframenum ,(node\num - minusnode)) = FRrotY#(aktframenum-1 ,(node\num - minusnode))
FRrotZ#(aktframenum ,(node\num - minusnode)) = FRrotZ#(aktframenum-1 ,(node\num - minusnode))
FRrotDO(aktframenum ,cnode) = 0
FReuX#(aktframenum ,(node\num - minusnode)) = FReuX#(aktframenum-1 ,(node\num - minusnode))
FReuY#(aktframenum ,(node\num - minusnode)) = FReuY#(aktframenum-1 ,(node\num - minusnode))
FReuZ#(aktframenum ,(node\num - minusnode)) = FReuZ#(aktframenum-1 ,(node\num - minusnode))
FReuDO(aktframenum ,cnode) = 0
cnode = cnode+1
;Gosub ShowFrame
Next
node.node = Object.node(thisHD)
ElseIf KeyDown(Key_F4) Or aktMenu2 = 201 ; Animation starten F4
ShowEntity darky
DownWait(Key_F4)
ss$ = GetInput$(10,100,"Input AnimSpeed: (default 0.5) negative plays backwards ")
If Trim$(ss$) = "" Then ss$ = "0.5"
aspeed# = Float(ss$)
ss$ = GetInput$(10,100,"Input AnimMode (0=stop, 1=loop, 2=ping-pong, 3=one shot) (default = loop) ")
If Trim$(ss$) = "" Then ss$ = "1"
anMD = Int(ss$)
thisHD = node\num
filename$ = "Anim.b3d"
saveQuestion = 3
Gosub saveall
If playanim > 0 Then FreeEntity playanim : playanim = 0
playanim = LoadAnimMesh(filename$)
allseq = ExtractAnimSeq(playanim,1,AnimFrames)
Animate playanim,anMD,aspeed#,allseq,1
HideEntity theanim
ShowEntity playanim
ElseIf KeyDown(Key_F3) Or aktMenu2 = 202 ; Animation stoppen F3
If playanim > 0
Animate playanim,0,aspeed#,allseq
FreeEntity playanim
playanim = 0
EndIf
ShowEntity theanim
ElseIf KeyDown(KEY_F11) ; Bone-Spheres verkleinern
If scsph# < 0.0005 Then scsph# = 0.0005
scsph# = scsph# *0.98
thisHD = node\num
For node.node = Each node
ScaleEntity Node\bSphere, scsph#, scsph#, scsph#
ScaleEntity xyz,scsph#*40, scsph#*40, scsph#*40
Next
node.node = Object.node(thisHD)
ElseIf KeyDown(KEY_F12) ; Bone-Spheres vergrößern
If scsph# < 0.0005 Then scsph# = 0.0005
scsph# = scsph# *1.02
thisHD = node\num
For node.node = Each node
ScaleEntity Node\bSphere, scsph#, scsph#, scsph#
ScaleEntity xyz,scsph#*40, scsph#*40, scsph#*40
Next
node.node = Object.node(thisHD)
ElseIf KeyDown(Key_F2)
ShowEntity darky
ss$ = Trim$(GetInput$(10,100,"Start frame number: "))
If ss$ = "" Then Goto nomorph
mf1 = Int(ss$)
If mf1 > AnimFrames Or mf1 < 1 Then Goto nomorph
ss$ = Trim$(GetInput$(10,100,"Endframe number: "))
If ss$ = "" Then Goto nomorph
mf2 = Int(ss$)
If mf2 > AnimFrames Or mf2 < 1 Then Goto nomorph
Gosub morphing
.nomorph
End If ; ENDE intern KEY Abfragen
;
EndIf ;ENDE STRG ALT SHIFT und KEY Abfragen
;#End Region ;
|
| ||
| Awesome work! :-D (Can't play yet, but still!) |
| ||
| ;---- paste this again at the end ------------- ; not the comments from others between the source ;)
;#Region Menü --- Menu
; Menu only
If aktmenu2 = 501
ShowEntity darky
st$ = "Slow rotation-speed of the bone: (actual "+rt1speed#+") "
ln = StringWidth(st$)
ss$ = GetInput$(gw2-(ln/2),gh2, st$)
If Trim$(ss$) <> "" Then rt1speed# = Float(Trim$(ss$))
Gosub writespeedconfig
ElseIf aktmenu2 = 502
ShowEntity darky
st$ = "Middle rotation-speed of the bone: (actual "+rt2speed#+") "
ln = StringWidth(st$)
ss$ = GetInput$(gw2-(ln/2),gh2, st$)
If Trim$(ss$) <> "" Then rt2speed# = Float(Trim$(ss$))
Gosub writespeedconfig
ElseIf aktmenu2 = 503
ShowEntity darky
st$ = "Fast rotation-speed of the bone: (actual "+rt3speed#+") "
ln = StringWidth(st$)
ss$ = GetInput$(gw2-(ln/2),gh2, st$)
If Trim$(ss$) <> "" Then rt3speed# = Float(Trim$(ss$))
Gosub writespeedconfig
ElseIf aktmenu2 = 504
ShowEntity darky
st$ = "Slow move-speed of the bone: (actual "+mv1speed#+") "
ln = StringWidth(st$)
ss$ = GetInput$(gw2-(ln/2),gh2, st$)
If Trim$(ss$) <> "" Then mv1speed# = Float(Trim$(ss$))
Gosub writespeedconfig
ElseIf aktmenu2 = 505
ShowEntity darky
st$ = "Middle move-speed of the bone: (actual "+mv2speed#+") "
ln = StringWidth(st$)
ss$ = GetInput$(gw2-(ln/2),gh2, st$)
If Trim$(ss$) <> "" Then mv2speed# = Float(Trim$(ss$))
Gosub writespeedconfig
ElseIf aktmenu2 = 506
ShowEntity darky
st$ = "Fast move-speed of the bone: (actual "+mv3speed#+") "
ln = StringWidth(st$)
ss$ = GetInput$(gw2-(ln/2),gh2, st$)
If Trim$(ss$) <> "" Then mv3speed# = Float(Trim$(ss$))
Gosub writespeedconfig
ElseIf aktmenu2 = 507
ShowEntity darky
st$ = "Slow scale-speed of the bone: (actual "+sc1speed#+") "
ln = StringWidth(st$)
ss$ = GetInput$(gw2-(ln/2),gh2, st$)
If Trim$(ss$) <> "" Then sc1speed# = Float(Trim$(ss$))
Gosub writespeedconfig
ElseIf aktmenu2 = 508
ShowEntity darky
st$ = "Middle scale-speed of the bone: (actual "+sc2speed#+") "
ln = StringWidth(st$)
ss$ = GetInput$(gw2-(ln/2),gh2, st$)
If Trim$(ss$) <> "" Then sc2speed# = Float(Trim$(ss$))
Gosub writespeedconfig
ElseIf aktmenu2 = 509
ShowEntity darky
st$ = "Fast scale-speed of the bone: (actual "+sc3speed#+") "
ln = StringWidth(st$)
ss$ = GetInput$(gw2-(ln/2),gh2, st$)
If Trim$(ss$) <> "" Then sc3speed# = Float(Trim$(ss$))
Gosub writespeedconfig
ElseIf aktmenu2 = 101
saveQuestion = 1
Gosub savewithfilereq
ElseIf aktMenu2 = 208 ;Restore actual Frame the actual Bone
FRposX#(aktframenum ,(node\num - minusnode)) = STOREposX#(aktframenum ,(node\num - minusnode))
FRposY#(aktframenum ,(node\num - minusnode)) = STOREposY#(aktframenum ,(node\num - minusnode))
FRposZ#(aktframenum ,(node\num - minusnode)) = STOREposZ#(aktframenum ,(node\num - minusnode))
FRposDO(aktframenum ,(node\num - minusnode)) = STOREposDO(aktframenum ,(node\num - minusnode))
FRscaleX#(aktframenum ,(node\num - minusnode)) = STOREscaleX#(aktframenum ,(node\num - minusnode))
FRscaleY#(aktframenum ,(node\num - minusnode)) = STOREscaleY#(aktframenum ,(node\num - minusnode))
FRscaleZ#(aktframenum ,(node\num - minusnode)) = STOREscaleZ#(aktframenum ,(node\num - minusnode))
FRscaleDO(aktframenum ,(node\num - minusnode)) = STOREscaleDO(aktframenum ,(node\num - minusnode))
FRrotW#(aktframenum ,(node\num - minusnode)) = STORErotW#(aktframenum ,(node\num - minusnode))
FRrotX#(aktframenum ,(node\num - minusnode)) = STORErotX#(aktframenum ,(node\num - minusnode))
FRrotY#(aktframenum ,(node\num - minusnode)) = STORErotY#(aktframenum ,(node\num - minusnode))
FRrotZ#(aktframenum ,(node\num - minusnode)) = STORErotZ#(aktframenum ,(node\num - minusnode))
FRrotDO(aktframenum ,(node\num - minusnode)) = STORErotDO(aktframenum ,(node\num - minusnode))
FReuX#(aktframenum ,(node\num - minusnode)) = STOREeuX#(aktframenum ,(node\num - minusnode))
FReuY#(aktframenum ,(node\num - minusnode)) = STOREeuY#(aktframenum ,(node\num - minusnode))
FReuZ#(aktframenum ,(node\num - minusnode)) = STOREeuZ#(aktframenum ,(node\num - minusnode))
FReuDO(aktframenum ,(node\num - minusnode)) = STOREeuDO(aktframenum ,(node\num - minusnode))
Gosub ShowFrameAll
ElseIf aktMenu2 = 209 ;Restore actual Frame all Bones
thisHD = node\num
For node.node = Each node
FRposX#(aktframenum ,(node\num - minusnode)) = STOREposX#(aktframenum ,(node\num - minusnode))
FRposY#(aktframenum ,(node\num - minusnode)) = STOREposY#(aktframenum ,(node\num - minusnode))
FRposZ#(aktframenum ,(node\num - minusnode)) = STOREposZ#(aktframenum ,(node\num - minusnode))
FRposDO(aktframenum ,(node\num - minusnode)) = STOREposDO(aktframenum ,(node\num - minusnode))
FRscaleX#(aktframenum ,(node\num - minusnode)) = STOREscaleX#(aktframenum ,(node\num - minusnode))
FRscaleY#(aktframenum ,(node\num - minusnode)) = STOREscaleY#(aktframenum ,(node\num - minusnode))
FRscaleZ#(aktframenum ,(node\num - minusnode)) = STOREscaleZ#(aktframenum ,(node\num - minusnode))
FRscaleDO(aktframenum ,(node\num - minusnode)) = STOREscaleDO(aktframenum ,(node\num - minusnode))
FRrotW#(aktframenum ,(node\num - minusnode)) = STORErotW#(aktframenum ,(node\num - minusnode))
FRrotX#(aktframenum ,(node\num - minusnode)) = STORErotX#(aktframenum ,(node\num - minusnode))
FRrotY#(aktframenum ,(node\num - minusnode)) = STORErotY#(aktframenum ,(node\num - minusnode))
FRrotZ#(aktframenum ,(node\num - minusnode)) = STORErotZ#(aktframenum ,(node\num - minusnode))
FRrotDO(aktframenum ,(node\num - minusnode)) = STORErotDO(aktframenum ,(node\num - minusnode))
FReuX#(aktframenum ,(node\num - minusnode)) = STOREeuX#(aktframenum ,(node\num - minusnode))
FReuY#(aktframenum ,(node\num - minusnode)) = STOREeuY#(aktframenum ,(node\num - minusnode))
FReuZ#(aktframenum ,(node\num - minusnode)) = STOREeuZ#(aktframenum ,(node\num - minusnode))
FReuDO(aktframenum ,(node\num - minusnode)) = STOREeuDO(aktframenum ,(node\num - minusnode))
Gosub ShowFrameAll
Next
node.node = Object.node(thisHD)
ElseIf aktMenu2 = 210 ;Restore all Frames all Bones
thisHD = node\num
storeframe = aktframenum
For cfr = 0 To AnimFrames
For node.node = Each node
FRposX#(cfr ,(node\num - minusnode)) = STOREposX#(cfr ,(node\num - minusnode))
FRposY#(cfr ,(node\num - minusnode)) = STOREposY#(cfr ,(node\num - minusnode))
FRposZ#(cfr ,(node\num - minusnode)) = STOREposZ#(cfr ,(node\num - minusnode))
FRposDO(cfr ,(node\num - minusnode)) = STOREposDO(cfr ,(node\num - minusnode))
FRscaleX#(cfr ,(node\num - minusnode)) = STOREscaleX#(cfr ,(node\num - minusnode))
FRscaleY#(cfr ,(node\num - minusnode)) = STOREscaleY#(cfr ,(node\num - minusnode))
FRscaleZ#(cfr ,(node\num - minusnode)) = STOREscaleZ#(cfr ,(node\num - minusnode))
FRscaleDO(cfr ,(node\num - minusnode)) = STOREscaleDO(cfr ,(node\num - minusnode))
FRrotW#(cfr ,(node\num - minusnode)) = STORErotW#(cfr ,(node\num - minusnode))
FRrotX#(cfr ,(node\num - minusnode)) = STORErotX#(cfr ,(node\num - minusnode))
FRrotY#(cfr ,(node\num - minusnode)) = STORErotY#(cfr ,(node\num - minusnode))
FRrotZ#(cfr ,(node\num - minusnode)) = STORErotZ#(cfr ,(node\num - minusnode))
FRrotDO(cfr ,(node\num - minusnode)) = STORErotDO(cfr ,(node\num - minusnode))
FReuX#(cfr ,(node\num - minusnode)) = STOREeuX#(cfr ,(node\num - minusnode))
FReuY#(cfr ,(node\num - minusnode)) = STOREeuY#(cfr ,(node\num - minusnode))
FReuZ#(cfr ,(node\num - minusnode)) = STOREeuZ#(cfr ,(node\num - minusnode))
FReuDO(cfr ,(node\num - minusnode)) = STOREeuDO(cfr ,(node\num - minusnode))
Gosub ShowFrameAll
Next
Next
node.node = Object.node(thisHD)
aktframenum = storeframe
ElseIf aktMenu2 = 212 ;Store act. Bone
STOREposX#(aktframenum ,(node\num - minusnode)) = FRposX#(aktframenum ,(node\num - minusnode))
STOREposY#(aktframenum ,(node\num - minusnode)) = FRposY#(aktframenum ,(node\num - minusnode))
STOREposZ#(aktframenum ,(node\num - minusnode)) = FRposZ#(aktframenum ,(node\num - minusnode))
STOREposDO(aktframenum ,(node\num - minusnode)) = FRposDO(aktframenum ,(node\num - minusnode))
STOREscaleX#(aktframenum ,(node\num - minusnode)) = FRscaleX#(aktframenum ,(node\num - minusnode))
STOREscaleY#(aktframenum ,(node\num - minusnode)) = FRscaleY#(aktframenum ,(node\num - minusnode))
STOREscaleZ#(aktframenum ,(node\num - minusnode)) = FRscaleZ#(aktframenum ,(node\num - minusnode))
STOREscaleDO(aktframenum ,(node\num - minusnode)) = FRscaleDO(aktframenum ,(node\num - minusnode))
STORErotW#(aktframenum ,(node\num - minusnode)) = FRrotW#(aktframenum ,(node\num - minusnode))
STORErotX#(aktframenum ,(node\num - minusnode)) = FRrotX#(aktframenum ,(node\num - minusnode))
STORErotY#(aktframenum ,(node\num - minusnode)) = FRrotY#(aktframenum ,(node\num - minusnode))
STORErotZ#(aktframenum ,(node\num - minusnode)) = FRrotZ#(aktframenum ,(node\num - minusnode))
STORErotDO(aktframenum ,(node\num - minusnode)) = FRrotDO(aktframenum ,(node\num - minusnode))
STOREeuX#(aktframenum ,(node\num - minusnode)) = FReuX#(aktframenum ,(node\num - minusnode))
STOREeuY#(aktframenum ,(node\num - minusnode)) = FReuY#(aktframenum ,(node\num - minusnode))
STOREeuZ#(aktframenum ,(node\num - minusnode)) = FReuZ#(aktframenum ,(node\num - minusnode))
STOREeuDO(aktframenum ,(node\num - minusnode)) = FReuDO(aktframenum ,(node\num - minusnode))
ElseIf aktMenu2 = 213 ;Store act. Frame
thisHD = node\num
For node.node = Each node
STOREposX#(aktframenum ,(node\num - minusnode)) = FRposX#(aktframenum ,(node\num - minusnode))
STOREposY#(aktframenum ,(node\num - minusnode)) = FRposY#(aktframenum ,(node\num - minusnode))
STOREposZ#(aktframenum ,(node\num - minusnode)) = FRposZ#(aktframenum ,(node\num - minusnode))
STOREposDO(aktframenum ,(node\num - minusnode)) = FRposDO(aktframenum ,(node\num - minusnode))
STOREscaleX#(aktframenum ,(node\num - minusnode)) = FRscaleX#(aktframenum ,(node\num - minusnode))
STOREscaleY#(aktframenum ,(node\num - minusnode)) = FRscaleY#(aktframenum ,(node\num - minusnode))
STOREscaleZ#(aktframenum ,(node\num - minusnode)) = FRscaleZ#(aktframenum ,(node\num - minusnode))
STOREscaleDO(aktframenum ,(node\num - minusnode)) = FRscaleDO(aktframenum ,(node\num - minusnode))
STORErotW#(aktframenum ,(node\num - minusnode)) = FRrotW#(aktframenum ,(node\num - minusnode))
STORErotX#(aktframenum ,(node\num - minusnode)) = FRrotX#(aktframenum ,(node\num - minusnode))
STORErotY#(aktframenum ,(node\num - minusnode)) = FRrotY#(aktframenum ,(node\num - minusnode))
STORErotZ#(aktframenum ,(node\num - minusnode)) = FRrotZ#(aktframenum ,(node\num - minusnode))
STORErotDO(aktframenum ,(node\num - minusnode)) = FRrotDO(aktframenum ,(node\num - minusnode))
STOREeuX#(aktframenum ,(node\num - minusnode)) = FReuX#(aktframenum ,(node\num - minusnode))
STOREeuY#(aktframenum ,(node\num - minusnode)) = FReuY#(aktframenum ,(node\num - minusnode))
STOREeuZ#(aktframenum ,(node\num - minusnode)) = FReuZ#(aktframenum ,(node\num - minusnode))
STOREeuDO(aktframenum ,(node\num - minusnode)) = FReuDO(aktframenum ,(node\num - minusnode))
Next
node.node = Object.node(thisHD)
ElseIf aktMenu2 = 214 ;Store all
thisHD = node\num
storeframe = aktframenum
For cfr = 0 To AnimFrames
For node.node = Each node
STOREposX#(cfr ,(node\num - minusnode)) = FRposX#(cfr ,(node\num - minusnode))
STOREposY#(cfr ,(node\num - minusnode)) = FRposY#(cfr ,(node\num - minusnode))
STOREposZ#(cfr ,(node\num - minusnode)) = FRposZ#(cfr ,(node\num - minusnode))
STOREposDO(cfr ,(node\num - minusnode)) = FRposDO(cfr ,(node\num - minusnode))
STOREscaleX#(cfr ,(node\num - minusnode)) = FRscaleX#(cfr ,(node\num - minusnode))
STOREscaleY#(cfr ,(node\num - minusnode)) = FRscaleY#(cfr ,(node\num - minusnode))
STOREscaleZ#(cfr ,(node\num - minusnode)) = FRscaleZ#(cfr ,(node\num - minusnode))
STOREscaleDO(cfr ,(node\num - minusnode)) = FRscaleDO(cfr ,(node\num - minusnode))
STORErotW#(cfr ,(node\num - minusnode)) = FRrotW#(cfr ,(node\num - minusnode))
STORErotX#(cfr ,(node\num - minusnode)) = FRrotX#(cfr ,(node\num - minusnode))
STORErotY#(cfr ,(node\num - minusnode)) = FRrotY#(cfr ,(node\num - minusnode))
STORErotZ#(cfr ,(node\num - minusnode)) = FRrotZ#(cfr ,(node\num - minusnode))
STORErotDO(cfr ,(node\num - minusnode)) = FRrotDO(cfr ,(node\num - minusnode))
STOREeuX#(cfr ,(node\num - minusnode)) = FReuX#(cfr ,(node\num - minusnode))
STOREeuY#(cfr ,(node\num - minusnode)) = FReuY#(cfr ,(node\num - minusnode))
STOREeuZ#(cfr ,(node\num - minusnode)) = FReuZ#(cfr ,(node\num - minusnode))
STOREeuDO(cfr ,(node\num - minusnode)) = FReuDO(cfr ,(node\num - minusnode))
Next
Next
node.node = Object.node(thisHD)
aktframenum = storeframe
ElseIf aktMenu2 = 216 ;STRG C
Gosub copyFrame
Gosub ShowFrame
ElseIf aktMenu2 = 217 ; STRG P
Gosub pasteFrame
Gosub ShowFrame
ElseIf aktMenu2 = 601
st$ = "Input the name of the new sequence: "
ln = StringWidth(st$)
ss$ = Trim$(GetInput$(gw2-(ln/2),gh2, st$,50))
If ss$ <> "" Then FRkeySEQ$(aktframenum) = ss$
frmCHG = 1
ElseIf aktMenu2 = 602
FRkeySEQ$(aktframenum) = ""
frmCHG = 1
ElseIf aktMenu2 = 702 ;KeyDown(Key_T) ;Texture and Brush TextureFilter
ShowEntity darky
For i = 0 To 49
Gtext$(i) = ""
Next
tz = 0
For texs.texs = Each texs
tz = tz + 1
If Trim$(texs\name) <> "" Then Gtext$(tz-1) = tz + " > " +texs\name$
Next
ss$ = Trim$(GetInput$( 10,(tz+2)*20,"Enter Number of Texture you want to Edit: ",2,25))
si = Int(ss$)
tz = 0
For texs.texs = Each texs
tz = tz + 1
If si = tz
Gtext$(0) = "+1=Color"
Gtext$(1) = "+2=Alpha"
Gtext$(2) = "+4=Masked"
Gtext$(3) = "+8=Mipmapped"
Gtext$(4) = "+16=Clamp U"
Gtext$(5) = "+32=Clamp V"
Gtext$(6) = "+64=Spherical Reflection Map"
Gtext$(7) = "+128=Cubic Environment Mapping"
Gtext$(8) = "+256=VRAM"
Gtext$(9) = "+512=HighColor-Texture"
ss$ = Trim$(GetInput$( 10,11*20,"Enter TextureFilter for your selected Texture: ",2,10))
si = Int(ss$)
texs\flags = si
Exit
EndIf
Next
ElseIf aktMenu2 = 703 ;Texture and Brush TextureBlend
ShowEntity darky
For i = 0 To 49
Gtext$(i) = ""
Next
tz = 0
For texs.texs = Each texs
tz = tz + 1
If Trim$(texs\name) <> "" Then Gtext$(tz-1) = tz + " > " +texs\name$
Next
ss$ = Trim$(GetInput$( 10,(tz+2)*20,"Enter Number of Texture you want to Edit: ",2,25))
si = Int(ss$)
tz = 0
For texs.texs = Each texs
tz = tz + 1
If si = tz
Gtext$(0) = "0: No Texture "
Gtext$(1) = "1: One Texture, (or Alpha, not by multitex.) "
Gtext$(2) = "2: Multiply "
Gtext$(3) = "3: Add "
Gtext$(4) = "4: Dot3 "
Gtext$(5) = "5: Multiply 2"
ss$ = Trim$(GetInput$( 10,8*20,"Enter TextureBlend for your selected Texture: ",2,6))
si = Int(ss$)
texs\blend = si
Exit
EndIf
Next
ElseIf aktMenu2 = 704 ;PositionTexture
ShowEntity darky
For i = 0 To 49
Gtext$(i) = ""
Next
tz = 0
For texs.texs = Each texs
tz = tz + 1
If Trim$(texs\name) <> "" Then Gtext$(tz-1) = tz + " > " +texs\name$
Next
ss$ = Trim$(GetInput$( 10,(tz+2)*20,"Enter Number of Texture you want to Edit: ",2,25))
si = Int(ss$)
tz = 0
For texs.texs = Each texs
tz = tz + 1
If si = tz
ss$ = Trim$(GetInput$( 10,20,"Position of Texture U# ",2))
texs\xpos# = Float(ss$)
ss$ = Trim$(GetInput$( 10,40,"Position of Texture V# ",2))
texs\xpos# = Float(ss$)
Exit
EndIf
Next
ElseIf aktMenu2 = 705 ;RotateTexture
ShowEntity darky
For i = 0 To 49
Gtext$(i) = ""
Next
tz = 0
For texs.texs = Each texs
tz = tz + 1
If Trim$(texs\name) <> "" Then Gtext$(tz-1) = tz + " > " +texs\name$
Next
ss$ = Trim$(GetInput$( 10,(tz+2)*20,"Enter Number of Texture you want to Edit: ",2,25))
si = Int(ss$)
tz = 0
For texs.texs = Each texs
tz = tz + 1
If si = tz
ss$ = Trim$(GetInput$( 10,20,"Degree of rotation ",2))
texs\rot# = Float(ss$)
Exit
EndIf
Next
ElseIf aktMenu2 = 706 ;ScaleTexture
ShowEntity darky
For i = 0 To 49
Gtext$(i) = ""
Next
tz = 0
For texs.texs = Each texs
tz = tz + 1
If Trim$(texs\name) <> "" Then Gtext$(tz-1) = tz + " > " +texs\name$
Next
ss$ = Trim$(GetInput$( 10,(tz+2)*20,"Enter number of the Texture you want to edit: ",2,25))
si = Int(ss$)
tz = 0
For texs.texs = Each texs
tz = tz + 1
If si = tz
ss$ = Trim$(GetInput$( 10,20,"ScaleX ",2))
texs\xscale# = Float(ss$)
ss$ = Trim$(GetInput$( 10,40,"ScaleY ",2))
texs\yscale# = Float(ss$)
Exit
EndIf
Next
ElseIf aktMenu2 = 708 ;BrushBlend
ShowEntity darky
For i = 0 To 49
Gtext$(i) = ""
Next
tz = 0
For brus.brus = Each brus
tz = tz + 1
If Trim$(brus\name) <> "" Then Gtext$(tz-1) = tz + " > " +brus\name$
Next
ss$ = Trim$(GetInput$( 10,(tz+2)*20,"Enter number of the Brush you want to edit: ",2,25))
si = Int(ss$)
tz = 0
For brus.brus = Each brus
tz = tz + 1
If si = tz
ss$ = Trim$(GetInput$( 10,20,"BrushBlend Mode 1-3 ",2))
brus\blend = Int(ss$)
Exit
EndIf
Next
ElseIf aktMenu2 = 709 ;BrushFX
ShowEntity darky
For i = 0 To 49
Gtext$(i) = ""
Next
tz = 0
For brus.brus = Each brus
tz = tz + 1
If Trim$(brus\name) <> "" Then Gtext$(tz-1) = tz + " > " +brus\name$
Next
ss$ = Trim$(GetInput$( 10,(tz+2)*20,"Enter number of the Brush you want to edit: ",2,25))
si = Int(ss$)
tz = 0
For brus.brus = Each brus
tz = tz + 1
If si = tz
ss$ = Trim$(GetInput$( 10,20,"BrushFX ",2))
brus\fx = Int(ss$)
Exit
EndIf
Next
ElseIf aktMenu2 = 710 ;BrushAlpha
ShowEntity darky
For i = 0 To 49
Gtext$(i) = ""
Next
tz = 0
For brus.brus = Each brus
tz = tz + 1
If Trim$(brus\name) <> "" Then Gtext$(tz-1) = tz + " > " +brus\name$
Next
ss$ = Trim$(GetInput$( 10,(tz+2)*20,"Enter number of the Brush you want to edit: ",2,25))
si = Int(ss$)
tz = 0
For brus.brus = Each brus
tz = tz + 1
If si = tz
ss$ = Trim$(GetInput$( 10,20,"BrushAlpha ",2))
brus\alpha# = Float(ss$)
Exit
EndIf
Next
;BrushShine----------------------------------------------------------------<<<<<<<<<<<<<<<<<<<<<
EndIf
;
;#End Region
UpdateWorld
RenderWorld
;#Region Text
; Texte
Color 180,180,180
If help = 1
SetFont font
ShowEntity darky
Text 10,30, "Cursor keys and Pup / Pdown - rotate around the Mesh"
Text 10,50, "CTRL + cursor keys to move camera"
Text 10,70, "Middle mousebutton or left and right mousebutton - press down and move mouse - move camera around the mesh"
Text 10,90, "Mousewheel or INS+DEL - Zoom | [+ SHIFT] = slow or [+ CTRL] = fast"
Color 150,200,100
Text 10,110, "ALT + S - Save"
Text 10,130, "ESC - Exit / [Save]"
Color 200,200,100
Text 10,150, ", = 1 Frame back , SHIFT + , = 10% Frames back, Left Alt + , = 25% , CTRL = 50%"
Text 10,170, ". = 1 Frame forward , SHIFT + . = 10% Frames forward, Left Alt + . = 25% , CTRL = 50%"
Text 10,190, "I - Insert Frame after this Frame"
Text 10,210, "A - Add Frame"
Color 200,150,150
Text 10,230, "F11 / F12 scale Bone-spheres"
Text 10,250, "F4 start animation / F3 stop animation"
Text 10,270, "F5 to set rotationspeed, movespeed and scalespeed for the bones"
Color 150,200,150
Text 10,290, "R = Rotation-mode, S = Scale-mode, M=Move-mode for the bones"
Text 10,310, "CTRL+ 1 or 2 to rotate, move or scale the X-axis of the bone (NumKeyBlock 1 or 3)"
Text 10,330, "CTRL+ 3 or 4 to rotate, move or scale the Y-axis of the bone (NumKeyBlock 4 or 6)"
Text 10,350, "CTRL+ 5 or 6 to rotate, move or scale the Z-axis of the bone (NumKeyBlock 7 or 9)"
Color 255,255,255
st$ = "Close Help with F1 or Help in menu again"
Text gw2-(ln/2),gh2+50, st$
Color 180,180,180
ElseIf waittext = 1
ShowEntity darky
SetFont bigfont
st$ = "Wait a moment, I am busy"
ln = StringWidth(st$)
Text gw2-(ln/2),gh2, st$
SetFont font
ElseIf checkend = 1
SetFont font
ShowEntity darky
st$ = "Really Quit ? y/n (for yes: y,z,j / for no: all other keys)"
ln = StringWidth(st$)
UpdateWorld
RenderWorld
Text gw2-(ln/2),gh2, st$
Flip
WaitKey
If KeyDown(KEY_Z) Or KeyDown(Key_Y) Or KeyDown(Key_J) Then Goto aus2
DownWait(KEY_Z)
DownWait(KEY_Y)
DownWait(KEY_J)
DownWait(1)
checkend = 0
FlushKeys
Else
HideEntity darky
SetFont font
Color 0,0,255
Text gw-200,30, "ANIM-Mode"
Color 0,255,0
If animmodus = 1 Then Text gw-200,50,"Rotation mode"
If animmodus = 2 Then Text gw-200,50,"Move mode"
If animmodus = 3 Then Text gw-200,50,"Scale mode"
Color 180,180,180
Text 10,30, "Bone: "+ aktbonename$
Text gw-150,gh-60, "Frame: "+aktframenum
Text gw-150,gh-40, "AnimFrames " +AnimFrames
If frmCHG = 1
For fms = 1 To AnimFrames
If FRkeySEQ$(fms) <>"" Then outSeq$ = FRkeySEQ$(fms)
If fms = aktframenum Then Exit
Next
frmCHG = 0
EndIf
If FRkeySEQ$(aktframenum) <> ""
Color 255,150,120
poutseq$ = "Startsequence "+outseq$
ln = StringWidth(poutSeq$)
Text gw2-(ln/2),30, poutSeq$
Else
Color 180,180,180
poutseq$ = "Sequence "+outseq$
ln = StringWidth(poutSeq$)
Text gw2-(ln/2),30, poutSeq$
EndIf
;Text 10,600,testfr+ " " + test2fr
;Text 10,920,teststr$
;Text 10,940,t2hd
EndIf
;#End Region
;#Region Small GUI
xpressm = 0
xpressp = 0
ypressm = 0
ypressp = 0
zpressm = 0
zpressp = 0
colR = 3
colG = Int($3D)
colB = Int($4E)
If animmodus = 1 Then DrawButton b2Xpos,b2ypos-24 ,82,b2dh,colR,colG,colB," Rotate"
If animmodus = 2 Then DrawButton b2Xpos,b2ypos-24 ,82,b2dh,colR,colG,colB," Move"
If animmodus = 3 Then DrawButton b2Xpos,b2ypos-24 ,82,b2dh,colR,colG,colB," Scale"
If aktbonespeed = 0
colR = Int($3D)
colG = 3
colB = Int($4E)
DrawButton b2Xpos,b2ypos-48 ,26,b2dh,colR,colG,colB," s"
Else
colR = 3
colG = Int($3D)
colB = Int($4E)
DrawButton b2Xpos,b2ypos-48 ,26,b2dh,colR,colG,colB," s"
EndIf
If aktbonespeed = 1
colR = Int($3D)
colG = 3
colB = Int($4E)
DrawButton b2Xpos+28,b2ypos-48 ,26,b2dh,colR,colG,colB,"m"
Else
colR = 3
colG = Int($3D)
colB = Int($4E)
DrawButton b2Xpos+28,b2ypos-48 ,26,b2dh,colR,colG,colB,"m"
EndIf
If aktbonespeed = 2
colR = Int($3D)
colG = 3
colB = Int($4E)
DrawButton b2Xpos+56,b2ypos-48 ,26,b2dh,colR,colG,colB," f"
Else
colR = 3
colG = Int($3D)
colB = Int($4E)
DrawButton b2Xpos+56,b2ypos-48 ,26,b2dh,colR,colG,colB," f"
EndIf
If MouseDown(1) And msx >= b2Xpos And msy >= b2ypos And msx <= b2Xpos+b2dw And msy <= b2ypos+b2dh
colR = Int($3D)
colG = 3
colB = Int($4E)
DrawButton b2Xpos,b2ypos ,b2dw,b2dh,colR,colG,colB," -X"
xpressm = 1
Else
colR = 255
colG = 0;INT($3D)
colB = 0;INT($4E)
DrawButton b2Xpos,b2ypos ,b2dw,b2dh,colR,colG,colB," -X"
EndIf
If MouseDown(1) And msx >= b2Xpos+b2dw+2 And msy >= b2ypos And msx <= b2Xpos+b2dw+2+b2dw And msy <= b2ypos+b2dh
colR = Int($3D)
colG = 3
colB = Int($4E)
DrawButton b2Xpos+b2dw+2,b2ypos ,b2dw,b2dh,colR,colG,colB," +X"
xpressp = 1
Else
colR = 255
colG = 0;INT($3D)
colB = 0;INT($4E)
DrawButton b2Xpos+b2dw+2,b2ypos ,b2dw,b2dh,colR,colG,colB," +X"
EndIf
If MouseDown(1) And msx >= b2Xpos And msy >= b2ypos+24 And msx <= b2Xpos+b2dw And msy <= b2ypos+24+b2dh
colR = Int($3D)
colG = 3
colB = Int($4E)
DrawButton b2Xpos,b2ypos+24 ,b2dw,b2dh,colR,colG,colB," -Y"
ypressm = 1
Else
colR = 0
colG = 255;INT($3D)
colB = 0;INT($4E)
DrawButton b2Xpos,b2ypos+24 ,b2dw,b2dh,colR,colG,colB," -Y"
EndIf
If MouseDown(1) And msx >= b2Xpos+b2dw+2 And msy >= b2ypos+24 And msx <= b2Xpos+b2dw+2+b2dw And msy <= b2ypos+24+b2dh
colR = Int($3D)
colG = 3
colB = Int($4E)
DrawButton b2Xpos+b2dw+2,b2ypos+24 ,b2dw,b2dh,colR,colG,colB," +Y"
ypressp = 1
Else
colR = 0
colG = 255;INT($3D)
colB = 0;INT($4E)
DrawButton b2Xpos+b2dw+2,b2ypos+24 ,b2dw,b2dh,colR,colG,colB," +Y"
EndIf
If MouseDown(1) And msx >= b2Xpos And msy >= b2ypos+48 And msx <= b2Xpos+b2dw And msy <= b2ypos+48+b2dh
colR = Int($3D)
colG = 3
colB = Int($4E)
DrawButton b2Xpos,b2ypos+48 ,b2dw,b2dh,colR,colG,colB," -Z"
zpressm = 1
Else
colR = 0
colG = 0;INT($3D)
colB = 255;INT($4E)
DrawButton b2Xpos,b2ypos+48 ,b2dw,b2dh,colR,colG,colB," -Z"
EndIf
If MouseDown(1) And msx >= b2Xpos+b2dw+2 And msy >= b2ypos+48 And msx <= b2Xpos+b2dw+2+b2dw And msy <= b2ypos+48+b2dh
colR = Int($3D)
colG = 3
colB = Int($4E)
DrawButton b2Xpos+b2dw+2,b2ypos+48 ,b2dw,b2dh,colR,colG,colB," +Z"
zpressp = 1
Else
colR = 0
colG = 0;INT($3D)
colB = 255;INT($4E)
DrawButton b2Xpos+b2dw+2,b2ypos+48 ,b2dw,b2dh,colR,colG,colB," +Z"
EndIf
If MouseDown(1) And msx >= 0 And msy >= gh-15
frameX = msx
Color 3,$3D,$4E
Rect 0,gh-20,gw,20,0
Color 255,0,0
Rect frameX,gh-20,1,20,1
FrameProz = (frameX*100)/gw
aktframenum = ((AnimFrames*FrameProz)/100)+1
Gosub ShowFrame
Else
Color 3,$3D,$4E
Rect 0,gh-20,gw,20,0
Color 255,0,0
Rect frameX,gh-20,1,20,1
Color 255,255,255
Rect MouseX()-10,MouseY(),20,1,1
Rect MouseX(),MouseY()-10,1,20,1
EndIf
;#End Region
aktMenu2=RenderMenu()
If animdebug = 1
Text 10,400,"posx "+FRposX#(aktframenum ,node\num-minusnode)
Text 10,420,"posy "+FRposY#(aktframenum ,node\num-minusnode)
Text 10,440,"posz "+FRposZ#(aktframenum ,node\num-minusnode)
Text 10,460,"active "+FRposDO(aktframenum ,node\num-minusnode)
Text 10,480,"scalex "+FRscaleX#(aktframenum ,node\num-minusnode)
Text 10,500,"scaley "+FRscaleY#(aktframenum ,node\num-minusnode)
Text 10,520,"scalez "+FRscaleZ#(aktframenum ,node\num-minusnode)
Text 10,540,"active "+FRscaleDO(aktframenum ,node\num-minusnode)
Text 10,560, "Qrotw "+FRrotW#(aktframenum ,node\num-minusnode)
Text 10,580, "Qrotx "+FRrotX#(aktframenum ,node\num-minusnode)
Text 10,600, "Qroty "+FRrotY#(aktframenum ,node\num-minusnode)
Text 10,620, "Qrotz "+FRrotZ#(aktframenum ,node\num-minusnode)
Text 10,640, "active "+FRrotDO(aktframenum ,node\num-minusnode)
Text 10,660, "RotX "+FReuX#(aktframenum ,node\num-minusnode)
Text 10,680, "RotY "+FReuY#(aktframenum ,node\num-minusnode)
Text 10,700, "RotZ "+FReuZ#(aktframenum ,node\num-minusnode)
Text 10,720, "active "+ FReuDO(aktframenum ,node\num-minusnode)
EndIf
;
Flip
If KeyHit(Key_X) And KeyDown(KEY_CTRL_LEFT) Then
SaveBuffer FrontBuffer(), "screenshot.bmp"
End If
FlushKeys
Cls
Forever
;#Region End Anim Loop
.aus2
FlushKeys
; save and quit
saveQuestion = 1
Gosub savewithfilereq
For Node.Node = Each Node
tempbank = node\ChunkNodeBank
FreeBank tempbank
tempbank = node\childbank
FreeBank tempbank
tb =node\bonebank
FreeBank tb
tb =node\key1bank
FreeBank tb
tb =node\key2bank
FreeBank tb
tb =node\key3bank
FreeBank tb
Next
For tris.tris = Each tris
FreeBank tris\vxbank
Next
FreeBank bnx
FreeBank bn2
FreeFont font
ClearWorld
Dim StFRposX#(-1,-1)
Dim StFRposY#(-1,-1)
Dim StFRposZ#(-1,-1)
Dim StFRposDO(-1,-1)
Dim StFRscaleX#(-1,-1)
Dim StFRscaleY#(-1,-1)
Dim StFRscaleZ#(-1,-1)
Dim StFRscaleDO(-1,-1)
Dim StFRrotW#(-1,-1)
Dim StFRrotX#(-1,-1)
Dim StFRrotY#(-1,-1)
Dim StFRrotZ#(-1,-1)
Dim StFRrotDO(-1,-1)
Dim StFReuX#(-1,-1)
Dim StFReuY#(-1,-1)
Dim StFReuZ#(-1,-1)
Dim StFReuDO(-1,-1)
Dim FRposX#(-1,-1)
Dim FRposY#(-1,-1)
Dim FRposZ#(-1,-1)
Dim FRposDO(-1,-1)
Dim FRscaleX#(-1,-1)
Dim FRscaleY#(-1,-1)
Dim FRscaleZ#(-1,-1)
Dim FRscaleDO(-1,-1)
Dim FRrotW#(-1,-1)
Dim FRrotX#(-1,-1)
Dim FRrotY#(-1,-1)
Dim FRrotZ#(-1,-1)
Dim FRrotDO(-1,-1)
Dim FReuX#(-1,-1)
Dim FReuY#(-1,-1)
Dim FReuZ#(-1,-1)
Dim FReuDO(-1,-1)
Dim sq(-1)
Dim CountVerts(-1)
Dim tempArray(-1)
Dim Banks(-1)
Dim frqSel$(-1)
Dim ffrq$(-1)
Dim dfrq$(-1)
End
;
;#End Region
;
;#End Region
; =-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-=-
|
| ||
;---- paste this again at the end ------------
;#Region Save Anim
; Save Anim
.savewithfilereq
filename$ = ListDir$(Pfad$, " Save, Type in a B3D Filename","S","F",".b3d")
If Trim$(filename$) = "" Then Return
filename$ = Trim$(filename$)
If Not Instr(Upper(filename$),".B3D")
If Instr(filename$,".")
filename$ = Replace(filename$,".","")
EndIf
Else
filename$ = Replace(Lower(filename$),".b3d","")
EndIf
storename$ = filename$
seqfilename$ = filename$+"SEQS.bb"
filename$ = filename$+".b3d"
posDir = 1
.suchDir
posDir2 = Instr(storename$,"\",posDir)
If posDir2 = 0 Or posDir2 >= Len(storename$)
storename$=Mid$ (storename$, posDir ,-1)
Else
posDir = posDir2+1
Goto suchDir
EndIf
seqout = WriteFile(seqfilename$)
If seqout = 0 Then seqout = OpenFile(seqfilename$)
WriteLine seqout,storename$+" = LOADANIMMESH("+ filename$+" )"
seqnum = 0
For fms = FrameStart To AnimFrames
If FRkeySEQ$(fms) <> ""
seqnum = seqnum + 1
dummySEQ$ = FRkeySEQ$(fms)
If dummySEQ$ = "" Then dummySeQ$ = "SEQ"+seqnum
startSEQnum = fms
If fms+1 < ANIMFRAMES
For fms2 = fms+1 To AnimFrames
If FRkeySEQ$(fms2) <> ""
fms2 = fms2-1
Exit
EndIf
Next
fms = fms2
endSEQnum = fms2
WriteLine seqout,dummySEQ$+" = EXTRACTANIMSEQ( "+storename$+","+startSEQnum+","+endSEQnum+" )"
EndIf
EndIf
Next
CloseFile(seqout)
.saveall
If saveQuestion = 0
FrameStart = 0
ElseIf saveQuestion = 1
ShowEntity darky
SetFont font
Color 255,255,255
ss$ = GetInput$(10,100,"For saving the animation with the rootmesh as frame 0 PRESS 0 (all other keys save the anim with start-frame 1) ")
If Trim$(ss$) = "0" Then FrameStart = 0 Else FrameStart = 1
ElseIf saveQuestion = 3
FrameStart = 1
EndIf
memNode = node\num
PutAllLCB2()
For node.node = Each node
ResizeBank node\key1bank,0
ResizeBank node\key2bank,0
ResizeBank node\key3bank,0
Next
keysflags = 0
For cfr = FrameStart To Animframes
cnd = 0
For node.node = Each node
bankK1 = node\key1bank
bankK2 = node\key2bank
bankK3 = node\key3bank
If FRposDO(cfr ,cnd) > 0
blocknum = AddBlockInt( bankK1, 16, cfr, 0 )
InsertBlockFloat( bankK1, blocknum, 16,FRposX#(cfr ,cnd) , 4 )
InsertBlockFloat( bankK1, blocknum, 16, FRposY#(cfr ,cnd) , 8 )
InsertBlockFloat( bankK1, blocknum, 16 ,FRposZ#(cfr ,cnd) , 12 )
keysflags = 1
EndIf
If FRscaleDO(cfr ,cnd) > 0
blocknum = AddBlockInt( bankK2, 16, cfr, 0 )
InsertBlockFloat( bankK2, blocknum, 16, FRscaleX#(cfr ,cnd), 4 )
InsertBlockFloat( bankK2, blocknum, 16, FRscaleY#(cfr ,cnd), 8 )
InsertBlockFloat( bankK2, blocknum, 16, FRscaleZ#(cfr ,cnd), 12 )
keysflags = keysflags + 2
EndIf
If FRrotDO(cfr ,cnd) > 0
blocknum = AddBlockInt( bankK3, 20, cfr, 0 )
InsertBlockFloat( bankK3, blocknum, 20, FRrotW#(cfr ,cnd), 4 )
InsertBlockFloat( bankK3, blocknum, 20, FRrotX#(cfr ,cnd), 8 )
InsertBlockFloat( bankK3, blocknum, 20, FRrotY#(cfr ,cnd), 12 )
InsertBlockFloat( bankK3, blocknum, 20, FRrotZ#(cfr ,cnd), 16 )
keysflags = keysflags + 4
EndIf
node\KEYSflags = keysflags
keysflags = 0
cnd = cnd + 1
Next
Next
node.node = Object.node(memNode)
.saveNull
PutAllLCB2()
; HEADER
outfile = WriteFile(filename$)
If Not outfile Then outfile = OpenFile(filename$)
fsize = FileSize(filename$)
WriteByte outfile, Asc("B")
WriteByte outfile, Asc("B")
WriteByte outfile, Asc("3")
WriteByte outfile, Asc("D")
BB3Dchunkpos = FilePos(outfile);<<<<<<<<<<<<<<<< für chunksize
WriteInt outfile, 0 ;dummy für chunksize
WriteInt outfile, 1 ;Version
;
; TEXS
WriteByte outfile, Asc("T")
WriteByte outfile, Asc("E")
WriteByte outfile, Asc("X")
WriteByte outfile, Asc("S")
TEXSchunkpos = FilePos(outfile)
WriteInt outfile, 0
For texs.texs = Each texs
WriteNullString(outfile, TEXS\name)
WriteInt outfile, TEXS\flags
WriteInt outfile, TEXS\blend
WriteFloat outfile, TEXS\xpos#
WriteFloat outfile, TEXS\ypos#
WriteFloat outfile, TEXS\xscale#
WriteFloat outfile, TEXS\yscale#
WriteFloat outfile, TEXS\rot#
Next
dummy = FilePos(outfile)
dummy2 = dummy-TEXSchunkpos-4
SeekFile(outfile, TEXSchunkpos)
WriteInt outfile, dummy2
SeekFile(outfile, dummy)
;
; BRUS
WriteByte outfile, Asc("B")
WriteByte outfile, Asc("R")
WriteByte outfile, Asc("U")
WriteByte outfile, Asc("S")
BRUSchunkpos = FilePos(outfile);<<<<<<<<<<<<<<<< für chunksize
WriteInt outfile, 0 ;dummy für chunksize
WriteInt outfile, BRUSntexs
For brus.brus = Each brus
WriteNullString(outfile, BRUS\name$)
WriteFloat outfile, BRUS\red#
WriteFloat outfile, BRUS\green#
WriteFloat outfile, BRUS\blue#
WriteFloat outfile, BRUS\alpha#
WriteFloat outfile, BRUS\shine#
WriteInt outfile, BRUS\blend
WriteInt outfile, BRUS\fx
For k = 0 To BRUSntexs-1
WriteInt outfile, BRUS\texid[k]
Next
Next
dummy = FilePos(outfile)
dummy2 = dummy-BRUSchunkpos-4
SeekFile(outfile, BRUSchunkpos)
WriteInt outfile, dummy2
SeekFile(outfile, dummy)
;
; NODE
WriteByte outfile, Asc("N")
WriteByte outfile, Asc("O")
WriteByte outfile, Asc("D")
WriteByte outfile, Asc("E")
ROOTNODEchunkpos = FilePos(outfile);<<<<<<<<<<<<<<<< für chunksize
WriteInt outfile, 0 ;dummy für chunksize
WriteNullString(outfile, ROOTNODEname$)
WriteFloat outfile, ROOTNODEposX#
WriteFloat outfile, ROOTNODEposY#
WriteFloat outfile, ROOTNODEposZ#
WriteFloat outfile, ROOTNODEscaleX#
WriteFloat outfile, ROOTNODEscaleY#
WriteFloat outfile, ROOTNODEscaleX#
WriteFloat outfile, ROOTNODErotW#
WriteFloat outfile, ROOTNODErotX#
WriteFloat outfile, ROOTNODErotY#
WriteFloat outfile, ROOTNODErotZ#
;
; MESH
WriteByte outfile, Asc("M")
WriteByte outfile, Asc("E")
WriteByte outfile, Asc("S")
WriteByte outfile, Asc("H")
MESHchunkpos = FilePos(outfile);<<<<<<<<<<<<<<<< für chunksize
WriteInt outfile, 0 ;dummy für chunksize
WriteInt outfile, MESHbrushID
;
; VRTS
WriteByte outfile, Asc("V")
WriteByte outfile, Asc("R")
WriteByte outfile, Asc("T")
WriteByte outfile, Asc("S")
VRTSchunkpos = FilePos(outfile);<<<<<<<<<<<<<<<< für chunksize
WriteInt outfile, 0 ;dummy für chunksize
WriteInt outfile, VRTSflags
WriteInt outfile, VRTStex_coord_sets
WriteInt outfile, VRTStex_coord_set_size
For vrts.vrts = Each vrts
WriteFloat outfile, VRTS\x#
WriteFloat outfile, VRTS\y#
WriteFloat outfile, VRTS\z#
If VRTSflags And 1
WriteFloat outfile, VRTS\nx#
WriteFloat outfile, VRTS\ny#
WriteFloat outfile, VRTS\nz#
EndIf
If VRTSflags And 2
WriteFloat outfile, VRTS\red#
WriteFloat outfile, VRTS\green#
WriteFloat outfile, VRTS\blue#
WriteFloat outfile, VRTS\alpha#
EndIf
For k = 0 To (VRTStex_coord_sets*VRTStex_coord_set_size)-1
WriteFloat outfile, VRTS\tex_coords#[k]
Next
Next
dummy = FilePos(outfile)
dummy2 = dummy-VRTSchunkpos-4
SeekFile(outfile, VRTSchunkpos)
WriteInt outfile, dummy2
SeekFile(outfile, dummy)
;
; TRIS
For tris.tris = Each tris
WriteByte outfile, Asc("T")
WriteByte outfile, Asc("R")
WriteByte outfile, Asc("I")
WriteByte outfile, Asc("S")
TRchunkpos = FilePos(outfile);<<<<<<<<<<<<<<<< für chunksize
WriteInt outfile, 0 ;dummy für chunksize
WriteInt outfile, TRIS\brushid
size = BankSize(tris\vxbank)
anz = (size/12)-1
For i = 0 To anz
TRvertexID_1 = GetBlockInt( tris\vxbank, i, 12, 0)
TRvertexID_2 = GetBlockInt( tris\vxbank, i, 12, 4)
TRvertexID_3 = GetBlockInt( tris\vxbank, i, 12, 8 )
WriteInt outfile, TRvertexID_1
WriteInt outfile, TRvertexID_2
WriteInt outfile, TRvertexID_3
Next
dummy = FilePos(outfile)
dummy2 = dummy-TRchunkpos-4
SeekFile(outfile, TRchunkpos)
WriteInt outfile, dummy2
SeekFile(outfile, dummy)
Next
;
; ANIM
fms = AnimFrames
dummy = FilePos(outfile)
dummy2 = dummy-MESHchunkpos-4
SeekFile(outfile, MESHchunkpos)
WriteInt outfile, dummy2
SeekFile(outfile, dummy)
WriteByte outfile, Asc("A")
WriteByte outfile, Asc("N")
WriteByte outfile, Asc("I")
WriteByte outfile, Asc("M")
ANIMchunkpos = FilePos(outfile);<<<<<<<<<<<<<<<< für chunksize
WriteInt outfile, 0 ;dummy für chunksize
WriteInt outfile, ANIMflags
WriteInt outfile, fms
WriteFloat outfile, ANIMfps#
dummy = FilePos(outfile)
dummy2 = dummy-ANIMchunkpos-4
SeekFile(outfile, ANIMchunkpos)
WriteInt outfile, dummy2
SeekFile(outfile, dummy)
;
; NODE
For node = Each Node
node\aktChild = 0
Next
node.node = First node
readynd = 0
thelast = node\lastchild
Repeat
WriteByte outfile, Asc("N")
WriteByte outfile, Asc("O")
WriteByte outfile, Asc("D")
WriteByte outfile, Asc("E")
node\nchunkFP = FilePos(outfile);<<<<<<<<<<<<<<<< für chunksize
WriteInt outfile, 0 ;dummy für chunksize
WriteNullString(outfile, node\name)
WriteFloat outfile, node\posX#
WriteFloat outfile, node\posY#
WriteFloat outfile, node\posZ#
WriteFloat outfile, node\scaleX#
WriteFloat outfile, node\scaleY#
WriteFloat outfile, node\scaleZ#
WriteFloat outfile, node\rotW#
WriteFloat outfile, node\rotX#
WriteFloat outfile, node\rotY#
WriteFloat outfile, node\rotZ#
;BONE + KEYS hier
boni = node\Bone-1
Gosub gobone
If saveshort = 1 Then Goto nokeys
key1write = 1
key2write = 1
key3write = 1
tempbank = node\key1bank
size = BankSize(tempbank)
If size > 0
kgo = 1
Blocksize = 16
Gosub gokeys
Else
key1write = 0
Gosub gokeys
key1write = 1
EndIf
tempbank = node\key2bank
size = BankSize(tempbank)
If size > 0
kgo = 2
Blocksize = 16
Gosub gokeys
Else
key2write = 0
Gosub gokeys
key2write = 1
EndIf
tempbank = node\key3bank
size = BankSize(tempbank)
If size > 0
kgo = 3
Blocksize = 20
Gosub gokeys
Else
key3write = 0
Gosub gokeys
key3write = 1
EndIf
.nokeys
node\endchunkFP = FilePos(outfile)
Repeat
node\aktChild = node\aktChild +1
If node\aktChild <= node\anzchild
thisnd = ChildNum( node\num, "", node\aktchild )
node.node = Object.node(thisnd)
Exit
ElseIf node\num > 1
If node\num = thelast
readyND = 1
Exit
EndIf
node.node = Object.node(node\parent)
Else
readyND = 1
Exit
EndIf
Forever
Until readyND = 1
dummy = FilePos(outfile)
dummy2 = dummy-BB3Dchunkpos-4
SeekFile(outfile, BB3Dchunkpos)
WriteInt outfile, dummy2
SeekFile(outfile, dummy)
dummy = FilePos(outfile)
dummy2 = dummy-ROOTNODEchunkpos-4
SeekFile(outfile, ROOTNODEchunkpos)
WriteInt outfile, dummy2
SeekFile(outfile, dummy)
For Node.Node = Each Node
th = Handle(node)
node.node = Object.node(th)
fp1 = node\nchunkFP
fp3 = node\endchunkFP
lastc = node\lastchild
node.node = Object.node(lastc)
fp2 = node\endchunkFP
node.node = Object.node(th)
chsize = fp2-fp1-4
SeekFile(outfile, fp1)
WriteInt outfile, chsize
Next
;
; SAVE_END
CloseFile outfile
node.node = Object.node(memNode)
Return
;
; BONES
.gobone
WriteByte outfile, Asc("B")
WriteByte outfile, Asc("O")
WriteByte outfile, Asc("N")
WriteByte outfile, Asc("E")
BONEchunkpos = FilePos(outfile);<<<<<<<<<<<<<<<< für chunksize
WriteInt outfile, 0 ;dummy für chunksize
tempbank = node\bonebank
If tempbank > 0
size = BankSize(tempbank)
If size>0
banz = (size/8) -1
For z = 0 To banz
tmpInt = GetBlockInt( tempbank, z, 8, 0 )
tmpfloat# = GetBlockFloat( tempbank, z, 8, 4 )
WriteInt outfile, tmpInt
WriteFloat outfile, tmpfloat#
Next
EndIf
EndIf
dummy = FilePos(outfile)
dummy2 = dummy-BONEchunkpos-4
SeekFile(outfile, BONEchunkpos)
WriteInt outfile, dummy2
SeekFile(outfile, dummy)
Return
;
; KEYS
.goKeys
WriteByte outfile, Asc("K")
WriteByte outfile, Asc("E")
WriteByte outfile, Asc("Y")
WriteByte outfile, Asc("S")
KYSchunkpos = FilePos(outfile);<<<<<<<<<<<<<<<< für chunksize
WriteInt outfile, 0 ;dummy für chunksize
If key1write = 1 And key2write = 1 And key3write = 1
KYSanz = (size/Blocksize)-1
If kgo = 1 Then WriteInt outfile, 1
If kgo = 2 Then WriteInt outfile, 2
If kgo = 3 Then WriteInt outfile, 4
For z = 0 To KYSanz
tmpInt = GetBlockInt( tempbank, z, Blocksize, 0 )
WriteInt outfile, tmpInt
If kgo = 1
KYSposX# = GetBlockFloat#( tempbank, z,Blocksize, 4)
KYSposY# = GetBlockFloat#( tempbank, z, Blocksize, 8)
KYSposZ# = GetBlockFloat#( tempbank, z,Blocksize, 12 )
WriteFloat outfile, KYSposX#
WriteFloat outfile, KYSposY#
WriteFloat outfile, KYSposZ#
EndIf
If kgo = 2
KYSscaleX# = GetBlockFloat#( tempbank, z,Blocksize, 4)
KYSscaleY# = GetBlockFloat#( tempbank, z, Blocksize, 8)
KYSscaleZ# = GetBlockFloat#( tempbank, z,Blocksize, 12 )
WriteFloat outfile, KYSscaleX#
WriteFloat outfile, KYSscaleY#
WriteFloat outfile, KYSscaleZ#
EndIf
If kgo = 3
KYSrotW# = GetBlockFloat#( tempbank, z,Blocksize, 4)
KYSrotX# = GetBlockFloat#( tempbank, z, Blocksize, 8)
KYSrotY# = GetBlockFloat#( tempbank, z,Blocksize, 12 )
KYSrotZ# = GetBlockFloat#( tempbank, z,Blocksize, 16 )
WriteFloat outfile, KYSrotW#
WriteFloat outfile, KYSrotX#
WriteFloat outfile, KYSrotY#
WriteFloat outfile, KYSrotZ#
EndIf
Next
Else
WriteInt outfile, 0
EndIf
dummy = FilePos(outfile)
dummy2 = dummy-KYSchunkpos-4
SeekFile(outfile, KYSchunkpos)
WriteInt outfile, dummy2
SeekFile(outfile, dummy)
Return
;
;#End Region
;#Region Funktionen
; Funktionen
; ************************************************************************************************************
; Bank usw.
Function Read4Char$(b3dfile)
For i = 1 To 4
s$ = s$+Chr$(ReadByte( b3dfile ))
Next
Return s$
End Function
Function ReadNullString$(b3dfile)
Repeat
b = ReadByte( b3dfile )
If b = 0 Return s$
s$ = s$+Chr$(b)
Forever
End Function
Function WriteNullString(b3dfile, sx1$)
For k = 1 To Len( sx1$ )
ch = Asc(Mid$(sx1$, k, 1))
WriteByte b3dfile, ch
If ch = 0 Return
Next
WriteByte b3dfile, 0
End Function
Function PutAllLCB()
For Node.Node = Each Node
id = Handle(Node)
lastid = FindLastChild( id )
PutLastChildBank( lastid, id )
Next
End Function
Function PutAllLCB2()
For Node.Node = Each Node
id = Handle(Node)
lastid = FindLastChild( id )
PutLastChildBank( lastid, id )
node.node = Object.node( id )
node\lastchild = lastid
Next
End Function
Function PutLastChildBank( id, putid )
Node.Node = Object.Node( id )
tempbank = node\ChunkNodeBank
size = BankSize(tempbank)
foundCNB = 0
If size > 0
anzCNB = (size/4)-1
For i = 0 To anzCNB
If PeekInt(tempbank, i) = putid
foundCNB = 1
Exit
EndIf
Next
EndIf
If foundCNB = 0
ResizeBank TempBank, size+4
PokeInt TempBank, size, putid
EndIf
End Function
Function FindLastChild( id = 0, tname$ = "")
If tname$ <> ""
For Node.Node = Each Node
If Upper$(Node\name) = Upper$(tname$)
id = Handle(Node)
Exit
EndIf
Next
EndIf
If id > 0
Repeat
Node.Node = Object.Node( id )
If node\anzchild > 0 And node\childbank > 0
tempbank = node\childbank
posch = (node\anzchild-1)*4
CHandle = PeekInt (tempbank, posch)
id = FindLastChild( CHandle )
If id = 0
Return CHandle
EndIf
Else
Return id
EndIf
Forever
EndIf
Return 0
End Function
Function NextKnoten( id = 0, nname$ = "" )
If nname$ <> ""
For Node.Node = Each Node
If Upper$(Node\name) = Upper$(nname$)
id = Handle(Node)
EndIf
Next
EndIf
If id > 0
Node.Node = Object.Node( id )
If node\anzchild > 0 And node\childbank > 0
naz = node\anzchild
For ci = 1 To naz
Node.Node = Object.Node( id )
nchnum = ChildNum(id, "", ci)
If nchnum > 0
Node.Node = Object.Node( nchnum )
If node\anzchild > 1 And node\childbank > 0
Return nchnum
ElseIf node\anzchild = 1 And node\childbank > 0
nknt = NextKnoten( nchnum )
If nknt > 0 Then Return nknt
EndIf
EndIf
Next
id = 0
EndIf
EndIf
Return id
End Function
Function NextChildNode( id = 0, nname$ = "" )
If nname$ <> ""
id = 0
For Node.Node = Each Node
If Upper$(Node\name) = Upper$(nname$)
id = Handle(Node)
EndIf
Next
EndIf
If id > 0
Node.Node = Object.Node( id )
If node\anzchild > 0 And node\childbank > 0
tempbank = node\childbank
CHandle = PeekInt (tempbank, posch)
Return CHandle
EndIf
EndIf
Return 0
End Function
Function SelectNextChildNode( id = 0, nname$ = "" )
If nname$ <> ""
id = 0
For Node.Node = Each Node
If Upper$(Node\name) = Upper$(nname$)
id = Handle(Node)
EndIf
Next
EndIf
If id > 0
Node.Node = Object.Node( id )
If node\anzchild > 0 And node\childbank > 0
tempbank = node\childbank
CHandle = PeekInt (tempbank, posch)
Node.Node = Object.Node( CHandle )
Return CHandle
EndIf
EndIf
Return 0
End Function
; ChildNum (0, "Name", 1) Childnummern ab 1
Function ChildNum( id = 0, nname$ = "", cnum)
If nname$ <> ""
For Node.Node = Each Node
If Upper$(Node\name) = Upper$(nname$)
id = Handle(Node)
EndIf
Next
EndIf
If id > 0
Node.Node = Object.Node( id )
If node\anzchild > 0 And node\childbank > 0
tempbank = node\childbank
size = BankSize(tempbank)
If (size/4) >= cnum
CHandle = PeekInt (tempbank, (cnum-1)*4)
Return CHandle
EndIf
EndIf
EndIf
Return 0
End Function
Function PrevKnoten( id = 0, pname$ = "" )
If pname$ <> ""
For Node.Node = Each Node
If Upper$(Node\name) = Upper$(pname$)
id = Handle(Node)
EndIf
Next
EndIf
If id > 1
Repeat
Node.Node = Object.Node( id )
Node.Node = Object.Node( Node\parent )
id = Handle(Node)
If id = 0 Then Exit
Until node\anzchild > 1 Or id = 1
EndIf
Return id
End Function
Function ParentNode(id = 0, pname$ = "" )
If pname$ <> ""
id = 0
For Node.Node = Each Node
If Upper$(Node\name) = Upper$(pname$)
rt = Node\parent
If rt > 0 Then Node.Node = Object.Node( Node\parent )
Return rt
EndIf
Next
ElseIf id > 0
Node.Node = Object.Node( id )
rt = Node\parent
If rt > 0 Then Node.Node = Object.Node( Node\parent )
Return rt
EndIf
End Function
Function DeleteLastNodeByName( delname$ )
For Node.Node = Each Node
If Upper$(Node\name) = Upper$(delname$)
DeleteLastNode( Node\num )
Exit
EndIf
Next
End Function
Function AddNodeByName( pname$, cname$ )
For Node.Node = Each Node
If Upper$(Node\name) = Upper$(pname$)
AddNode( Node\num, cname$ )
Exit
EndIf
Next
End Function
Function AddNode( id, newname$)
If id> 0 Node.Node = Object.Node( id )
Node.Node = New Node
tempID = Handle(Node)
If id > 0 Then Node\parent = id
Node\name$ = newname$
Node\num = tempID
tcnb = CreateBank(0)
Node\ChunkNodeBank = tcnb
Node\bonebank = CreateBank(0)
k1ba = CreateBank(0)
Node\key1bank = k1ba
k2ba = CreateBank(0)
Node\key2bank = k2ba
k3ba = CreateBank(0)
Node\key3bank = k3ba
If id > 0
Node.Node = Object.Node( id )
If Node\childbank = 0
tempbank = CreateBank(4)
Node\childbank = tempbank
PokeInt tempbank, 0, tempID
Dim tempArray(anzBanks+1)
For ab = 0 To anzBanks
tempArray(ab) = banks(ab)
Next
Dim banks(anzBanks+1)
For ab = 0 To anzBanks
banks(ab) = tempArray(ab)
Next
banks(anzBanks) = tempbank
anzBanks = anzBanks +1
node\anzchild = 1
Else
tempbank = Node\childbank
size = BankSize(tempbank)
ResizeBank(tempbank, size+4)
PokeInt tempbank, size, tempID
node\anzchild = (size/4)+1
EndIf
EndIf
Return tempID
End Function
Function DeleteLastNode( id )
Node.Node = Object.Node( id )
thisHD = node\num
If node\anzchild = 0 And id > FirstNodeHD
tcnb = Node\ChunkNodeBank
FreeBank tcnb
tb =node\bonebank
FreeBank tb
tb =node\key1bank
FreeBank tb
tb =node\key2bank
FreeBank tb
tb =node\key3bank
FreeBank tb
Node.Node = Object.Node(Node\parent)
parentHD = node\num
node\anzchild = node\anzchild - 1
tempbank = Node\childbank ;<<< ändern, es könnten mehrere Childs in der Banks sein
size = BankSize(tempbank)
If size > 4
inchild = size/4
For ic = 0 To inchild-1
testchild = PeekInt(tempbank,ic*4)
If testchild = id
DeleteBlock( tempbank, 4, ic)
Node.Node = Object.Node( id )
Delete Node.Node
Exit
EndIf
Next
Else
searchbank = tempbank
FreeBank tempbank
node\anzchild = 0
node\childbank = 0
Node.Node = Object.Node( id )
Delete Node.Node
Dim temparray(anzbanks)
k = 0
For i = 0 To anzbanks
If banks(i) <> searchbank
temparray(k) = banks(i)
k = k +1
EndIf
Next
Dim banks(anzbanks)
anzbanks = anzbanks-1
For i = 0 To anzbanks
banks(i) = temparray(i)
Next
EndIf
For node.node = Each node
If node\lastChild = thisHD Then node\lastChild = parentHD
Next
Node.Node = Object.Node( parentHD)
Return node\num
EndIf
Return 0
End Function
;Nummer ab Null
Function DeleteBlock( Bank, Bsize, num )
bsz = BankSize(Bank)
newbsz = bsz-Bsize
If BankSize(Bank) = Bsize
;Freebank Bank
ResizeBank Bank, 0
Bank = 0
ElseIf num*Bsize+Bsize = bsz
ResizeBank Bank, newbsz
ElseIf num > 0
offset1 = num*Bsize
offset2 = offset1+Bsize
lenB2 = bsz-offset2
CopyBank Bank, offset2, Bank, offset1, lenB2
ResizeBank Bank, newbsz
Else
CopyBank Bank, Bsize, Bank, 0, newbsz
ResizeBank Bank, newbsz
EndIf
End Function
Function PokeString( Bank, offset, value$)
For i = 1 To Len(value$)
a = Asc(Mid(value$, i, 1))
PokeByte Bank, offset + i - 1, a
Next
PokeByte bank, offset + i - 1, 0
End Function
Function PeekString$( Bank, offset)
a = PeekByte( Bank,offset)
While a > 0
s$ = s$ + Chr(a)
i = i + 1
a = PeekByte(bank, offset + i)
Wend
Return s$
End Function
Function InsertBlockString( Bank,num,Bsize, bname$ ,bssize, posoffset)
offset = num*Bsize+posoffset
bname$=Left$ (bname$, bssize-1)
PokeString( Bank, offset, bname$)
End Function
Function GetBlockString$( Bank,num, Bsize, posoffset )
offset = num*Bsize+posoffset
Return PeekString( Bank,offset)
End Function
Function InsertBlockInt( Bank, num,Bsize, wert, posoffset )
offset = (num*Bsize)+posoffset
PokeInt Bank,offset,wert
End Function
Function InsertBlockFloat( Bank, num,Bsize, wert#, posoffset )
offset = (num*Bsize)+posoffset
PokeFloat Bank,offset,wert#
End Function
Function AddBlockInt( Bank, Bsize, wert, posoffset )
If bank > 0
size = BankSize(Bank)
ResizeBank Bank,size+Bsize
offset = size+posoffset
PokeInt Bank,offset,wert
Return size/Bsize
Else
Return 0
EndIf
End Function
Function AddBlockFloat( Bank, Bsize, wert#, posoffset )
If bank > 0
size = BankSize(Bank)
ResizeBank Bank,size+Bsize
offset = size+posoffset
PokeFloat Bank,offset,wert#
Return size/Bsize
Else
Return 0
EndIf
End Function
Function GetBlockInt( Bank, num, Bsize, posoffset )
offset = (num*Bsize)+posoffset
rt = PeekInt (Bank,offset)
Return rt
End Function
Function GetBlockFloat#( Bank, num, Bsize, posoffset )
offset = (num*Bsize)+posoffset
rt# = PeekFloat (Bank,offset)
Return rt#
End Function
Function DownWait( taste% )
.waitforkeyup
If KeyDown(taste%) Goto waitforkeyup
FlushKeys
End Function
Function MouseUpWait(mnum)
.waitformousenow
If MouseDown(mnum) Then Goto waitformousenow
End Function
;
; GetInput$
;Based on Input Function from the Blitz codesection by Russell
Function GetInput$(x,y,sPrompt$,iMaxLength = 10,xtest = 0,sFilter$ = "/all")
FlushKeys
iFlashInterval = 300 ; The blinking cursor speed
If Lower$(sFilter$) = "/123" Then sFilter$ = "0123456789." ; All the numbers
If Lower$(sFilter$) = "/abc" Then sFilter$ = "abcdefghijklmnopqrstuvwxyz" ; All the letters
iTotalWidth = StringWidth(sPrompt$) + (iMaxLength * FontWidth())
iTotalHeight = FontHeight()
hTextBuffer = CreateImage(iTotalWidth,iTotalHeight) ; Where the text will be drawn before blitting to the backbuffer()
hCleanCopy = CreateImage(iTotalWidth,iTotalHeight) ; Will hold a clean copy of the backbuffer (not the whole thing)
MaskImage hTextBuffer,255,0,255 ; Make the text background transparent so we can show text with BG showing
SetBuffer ImageBuffer(hTextBuffer) ; We're going to draw to the text buffer
ClsColor 255,0,255 ; Temporarily make the cls color the transparent color (magenta)
Cls ; Now clear to magenta
; Foreground (text) will be drawn in the current color
CopyRect x,y,iTotalWidth,iTotalHeight,0,0,BackBuffer(),ImageBuffer(hCleanCopy) ; Save a clean copy of the back buffer where the
; text is going to be
SetBuffer BackBuffer()
Repeat
; Blinking cursor code *******************************************************************************************************
iCurrentTime = MilliSecs()
If bFlash = True Then
If (iCurrentTime - iOldFlashTime) >= iFlashInterval Then
bFlash = False
iOldFlashTime = MilliSecs()
EndIf
Else
If (iCurrentTime - iOldFlashTime) >= iFlashInterval Then
bFlash = True
iOldFlashTime = MilliSecs()
EndIf
EndIf
; Input starts here **********************************************************************************************************
iKeyPressed = GetKey()
If iKeyPressed = 13 Then
sKeyPressed$ = ""
Else
sKeyPressed$ = Chr$(iKeyPressed)
EndIf
; IF the key passes, add it to the total *************************************************************************************
If iKeyPressed Then
If (sFilter$ = "/all") Or (sFilter$ = "") Or (Instr(sFilter$,sKeyPressed$) > 0) Then ; "all" does not filter any keys out
If Len(sTotal$) < iMaxLength Then
sTotal$ = sTotal$ + sKeyPressed$ ; Add it to the total string IF it passes
iNumDigits = iNumDigits + 1
EndIf
EndIf
EndIf
; IF backspace was pressed, delete the last character from the total and update the number of digits *************************
If KeyDown(14) And iNumDigits > 0 Then
sTotal$ = Left$(sTotal$,iNumDigits - 1)
iNumDigits = iNumDigits - 1
Delay 50
EndIf
; Draw the clean background and then the text on the backbuffer() ************************************************************
DrawBlock hCleanCopy,x,y
; Draw the cursor IF enough time has passed (change iFlashInterval for different speeds) *************************************
If Len(sTotal$) = iMaxLength Then
rx = StringWidth(sPrompt$ + sTotal$) - StringWidth(Right$(sTotal$,1))
rw = StringWidth(Right$(sTotal$,1))
Else
rx = StringWidth(sPrompt$) +StringWidth(sTotal$); (Len(sTotal$) * FontWidth())
rw = FontWidth()
EndIf
UpdateWorld
RenderWorld
If xtest > 0
For i = 0 To xtest
Text 10,(i+1)*20,Gtext$(i)
Next
EndIf
If bFlash = True Then
Text x,y,sPrompt$ + sTotal$
Rect x + rx,y,rw/6,FontHeight(),True
Else
Text x,y,sPrompt$ + sTotal$
EndIf
Flip
Until iKeyPressed = 13 ; This is the 'return/enter' key
ClsColor 0,0,0 ; Reset back to black
Return sTotal$
End Function
;
; Startup
Function startup()
If info1$<>""
AppTitle info1$,"Exit "+info1$+" ?"
EndIf
FlushKeys()
Anz=CountGfxModes3D()
If Not Anz RuntimeError "ERROR no Graphic-mode found"
.checkcfg
If FileType("ScreenConfig.dat") = 1
cfgin = ReadFile("ScreenConfig.dat")
anz = ReadInt(cfgin)
For i = 1 To anz+1
modus(i) = ReadInt(cfgin)
wfmode(i) = ReadInt(cfgin)
Next
m = anz+1
Else
Graphics 800,600,0,2
m = 0
Repeat
Cls
Locate 0,10
Print "Extract AnimB3D first, don't use from zip archive"
Print "Give in your favorite GFX modes (max 6)"
sm$ = ""
If m > 0
For p = 0 To m-1
sm$ = sm$ + " " +Str$(outmode(p))
Next
EndIf
Print "actual modes: " + sm$
Anz=CountGfxModes3D()
For i = 1 To Anz
If GfxModeWidth(i) > 750
St$ = "Mode " + i + ":"+" W " + GfxModeWidth(i) + " H " + GfxModeHeight(i) +" D " + GfxModeDepth(i)
Print st$
EndIf
Next
x$ = Input ("GFX-Mode-Number: (Empty=Exit)")
If Trim$(x$) = "" Or m = 7 Then Exit
wf$ = Input("Windowed or Fullscreen ? w/f ")
wf$ = Lower(Trim$(wf$))
If wf$ = "w" Then wfi(m) = 2 Else wfi(m) = 1
outmode(m) = Int(Trim$(x$))
m = m+1
Forever
m = m-1
outScreen = WriteFile("ScreenConfig.dat")
WriteInt outscreen,m
For i = 0 To m
WriteInt outscreen,outmode(i)
WriteInt outscreen,wfi(i)
Next
CloseFile outscreen
Goto checkcfg
EndIf
Graphics 640,480,0,2
SetBuffer BackBuffer()
ty = 240
tx = 180
scrw = ScreenWH(0)
scrh = ScreenWH(1) ;Api_GetsystemMetrics
mode = m
Repeat
Cls
Color 10,20,30
Rect 0,300,640,200,1
Color 30,50,60
Rect 10,310,620,160,1
Color 250,70,70
Text tx+70,ty+FontHeight()*5," Quit with [ESC]"
Color 0,155,200
fontA=LoadFont( "Comic Sans MS",120 ):SetFont fontA
Text 95,ty-240+FontHeight()*0.4," AnimB3D"
font=LoadFont( "Comic Sans MS",20 ):SetFont font
Color 0,255,200
Text tx,ty-95+FontHeight()*3, "Freeware Animationprogramm for B3D files"
Text tx,ty-95+FontHeight()*4," Created by Andrea Tobian-Mezger"
Text tx,ty-95+FontHeight()*5," 12/05-01/06"
Color 70,250,70
fullwin$ = ""
If wfmode(mode) = 1 Then fullwin$ = " Fullscreen-mode " Else fullwin$ = " Windowed-mode "
Text tx-10,ty+FontHeight()*7," <" +GfxModeWidth( Modus(mode) )+","+GfxModeHeight( Modus(mode) )+","+GfxModeDepth( Modus(mode) )+"," +fullwin$ +" > "
Color 255,255,0
Text tx-150,ty+FontHeight()*7,"[Cursor-Key left]"
Text tx+300,ty+FontHeight()*7," [Cursor-Key right] "
Color 40,40,255
Text tx+20,ty+FontHeight()*9," Start with [RETURN] or [Space]"
Color 0,0,255
If KeyHit( 1 ) End
If KeyHit( 28 ) Or KeyHit( 57 )
Cls:Flip:Cls:Flip
FreeFont font
FreeFont fontA
EndGraphics
Graphics3D GfxModeWidth(modus(mode)),GfxModeHeight(modus(mode)),GfxModeDepth(modus(mode)),wfmode(mode)
SetBuffer BackBuffer()
Return
EndIf
If KeyHit( 203 )
mode=mode-1
If mode<1 Then mode = m
Else If KeyHit( 205 )
mode=mode+1
If mode>m Then mode = 1
EndIf
Flip
Forever
End Function
;
; DrawInput
;[c]--------------------------------------------------- InputLine ----- Eingabefeld -------------------------------------------------------
;DrawInput rt = rot, gr = grün, bl = blau, txt1$ erste Textzeile,
;ptxt = y+ptxt von Oben fängt erste Zeile an. , hx = Hex Pen Color
;fnt$ = Fontname, fsize = Fontgröße,
;und weitere 4 Textzeilen.
Function DrawInput(x,y,w,h,rt,gr,bl,txt1$="",ptxt=0,hx=-1,fnt$="Verdana",fsize=18,txt2$="",txt3$="",txt4$="",txt5$="")
Local pen
derfont = LoadFont (fnt$,fsize)
SetFont derfont
If h < fsitze+2 Then h = fsize+2
If rt = 0 And gr = 0 And bl = 0
ElseIf rt = 255 And gr = 255 And bl = 255
Else
rt1 = rt+70
If rt1 > 255 Then rt1 = 255
gr1 = gr+70
If gr1 > 255 Then gr1 = 255
bl1 = bl+70
If bl1 > 255 Then bl1 = 255
rt2 = rt-70
If rt2 < 0 Then rt2 = 0
gr2 = gr-70
If gr2 < 0 Then gr2 = 0
bl2 = bl-70
If bl2 < 0 Then bl2 = 0
If hx = -1
If rt+gr+bl/3 > 127
pen = 0
Else
pen = 255
EndIf
EndIf
Color rt,gr,bl
Rect x,y,w,h,1
Color rt1,gr1,bl1
Rect x,y,w,h,0
Color rt2,gr2,bl2
Line x,y,x+w-1,y
Line x,y,x,y+h
If hx=-1
Color pen,pen,pen
Else
Color 0,0,hx
EndIf
If txt1$ > "" Then Text x+4,y+ptxt+1,txt1$
If txt2$ > "" Then Text x+4,y+ptxt+(fsize+2),txt2$
If txt3$ > "" Then Text x+4,y+ptxt+(fsize+2)*2,txt3$
If txt4$ > "" Then Text x+4,y+ptxt+(fsize+2)*3,txt4$
If txt5$ > "" Then Text x+4,y+ptxt+(fsize+2)*4,txt5$
EndIf
FreeFont derfont
End Function
;
; DrawButton
;DrawButton rt = rot, gr = grün, bl = blau, txt1$ erste Textzeile,
;ptxt = y+1+ptxt von Oben fängt erste Zeile an. , hx = Hex Pen Color
;fnt$ = Fontname, fsize = Fontgröße,
;und weitere 4 Textzeilen.
Function DrawButton(x,y,w,h,rt,gr,bl,txt1$="",ptxt=0,hx=-1,fnt$="Verdana",fsize=18,txt2$="",txt3$="",txt4$="",txt5$="")
Local pen
derfont = LoadFont (fnt$,fsize)
SetFont derfont
If h < fsitze+2 Then h = fsize+2
If rt = 0 And gr = 0 And bl = 0
ElseIf rt = 255 And gr = 255 And bl = 255
Else
rt1 = rt+70
If rt1 > 255 Then rt1 = 255
gr1 = gr+70
If gr1 > 255 Then gr1 = 255
bl1 = bl+70
If bl1 > 255 Then bl1 = 255
rt2 = rt-70
If rt2 < 0 Then rt2 = 0
gr2 = gr-70
If gr2 < 0 Then gr2 = 0
bl2 = bl-70
If bl2 < 0 Then bl2 = 0
If hx = -1
If rt+gr+bl/3 > 127
pen = 0
Else
pen = 255
EndIf
EndIf
Color rt,gr,bl
Rect x,y,w,h,1
Color rt2,gr2,bl2
Rect x,y,w,h,0
Color rt1,gr1,bl1
Line x,y,x+w-1,y
Line x,y,x,y+h
If hx=-1
Color pen,pen,pen
Else
Color 0,0,hx
EndIf
If txt1$ > "" Then Text x+4,y+1+ptxt,txt1$
If txt2$ > "" Then Text x+4,y+ptxt+(fsize+2),txt2$
If txt3$ > "" Then Text x+4,y+ptxt+(fsize+2)*2,txt3$
If txt4$ > "" Then Text x+4,y+ptxt+(fsize+2)*3,txt4$
If txt5$ > "" Then Text x+4,y+ptxt+(fsize+2)*4,txt5$
EndIf
FreeFont derfont
End Function
;
; ListDir$(pfad$,titel$,ls$="L",dTyp$ = "F",ext$="",ext2$="",ext3$="",ext4$="")
;[c]------------------------------------ Filerequester ----------------------------------------------
Function ListDir$(pfad$,titel$,ls$="L",dTyp$ = "F",ext$="",ext2$="",ext3$="",ext4$="")
Local locdatei$
Local locv
Local dirTyp
Local ANZdx , ANZfx , AKTfx , AKTdx
Local mz
If Upper$( dTyp$) = "F" Then dirTyp = 0 Else dirTyp = 1
derfont2 = LoadFont("Verdana",16)
SetFont derFont2
mb=CreateImage(400,480)
SetBuffer ImageBuffer(mb)
Color 20,80,60
Rect 0,0,400,480,1
Color 120,180,160
Rect 3,3,394,474,1
Color 80,100,90
Rect 6,6,388,468,1
GrabImage mb,400,480
SetBuffer BackBuffer()
;mb=LoadImage("styles\message5.jpg")
;ResizeImage mb,400,480
ls$ = Upper$(ls$)
If ls$ = "S" Then ls$ = "Save" Else ls$ = "Load"
ext$ = Lower$(ext)
ext2$ = Lower$(ext2$)
ext3$ = Lower$(ext3$)
ext4$ = Lower$(ext4$)
DirPfad$ = pfad$
.startListDir
If FileType(pfad$) = 0 Then Goto endeListDir
Dim frqSel$(18)
locv=ReadDir(pfad$)
Repeat
locdatei$=Lower$(NextFile$(locv))
If locdatei$="" Then Exit
If FileType(pfad$+locdatei$) = 2 Then
ANZdx = ANZdx + 1
Else
If ((ext$ <> "") And (Instr( locdatei$,ext$) > 0)) Or ext$ = "" Then ANZfx = ANZfx + 1
If ((ext2$ <> "") And (Instr( locdatei$,ext2$) > 0)) Then ANZfx = ANZfx + 1
If ((ext3$ <> "") And (Instr( locdatei$,ext3$) > 0)) Then ANZfx = ANZfx + 1
If ((ext4$ <> "") And (Instr( locdatei$,ext4$) > 0)) Then ANZfx = ANZfx + 1
End If
Forever
CloseDir locv
Dim FFRQ$(ANZfx)
Dim DFRQ$(ANZdx)
locv=ReadDir(pfad$)
i=0
Repeat
locdatei$=Lower$(NextFile$(locv))
If locdatei$="" Then Exit
fok = 0
If ((ext$ <> "") And (Instr( locdatei$,ext$) > 0)) Or ext$ = "" Then fok = 1
If ((ext2$ <> "") And (Instr( locdatei$,ext2$) > 0)) Then fok = 1
If ((ext3$ <> "") And (Instr( locdatei$,ext3$) > 0)) Then fok = 1
If ((ext4$ <> "") And (Instr( locdatei$,ext4$) > 0)) Then fok = 1
If FileType(pfad$+locdatei$) = 1 And fok = 1 Then
FFRQ$(i) = locdatei$
i=i+1
End If
Until i = ANZfx
CloseDir locv
locv=ReadDir(pfad$)
i=0
Repeat
locdatei$=NextFile$(locv)
If locdatei$="" Then Exit
If FileType(pfad$+locdatei$) = 2 Then
DFRQ$(i) = locdatei$
i = i+1
End If
Until i = ANZdx
CloseDir locv
If DirTyp = 0
AKTfx = 18
AKTdx = 0
dafx = 0
If ANZfx < 18 Then AKTfx = ANZfx
For i = 0 To 18
If i <= AKTfx
frqSel$(i) = FFRQ$(i)
frqletzt = i
Else
frqSel$(i) = ""
EndIf
Next
Else
AKTfx = 0
AKTdx = 18
dafx = 0
If ANZdx < 18 Then AKTdx = ANZdx
For i = 0 To 18
If i <= AKTdx
frqSel$(i) = DFRQ$(i)
frqletzt = i
Else
frqSel$(i) = ""
EndIf
Next
EndIf
brt=(GraphicsWidth()/2)-200
Origin brt, (GraphicsHeight()/2)-240
Repeat
Cls
If MouseDown(1)
soutsave$ = sout$
If my > 30 And my <50
sout$ = frqSel$(0)
ElseIf my > 50 And my <70
sout$ = frqSel$(1)
ElseIf my > 70 And my <90
sout$ = frqSel$(2)
ElseIf my > 90 And my <110
sout$ = frqSel$(3)
ElseIf my > 110 And my <130
sout$ = frqSel$(4)
ElseIf my > 130 And my <150
sout$ = frqSel$(5)
ElseIf my > 150 And my <170
sout$ = frqSel$(6)
ElseIf my > 170 And my <190
sout$ = frqSel$(7)
ElseIf my > 190 And my <210
sout$ = frqSel$(8)
ElseIf my > 210 And my <230
sout$ = frqSel$(9)
ElseIf my > 230 And my <250
sout$ = frqSel$(10)
ElseIf my > 250 And my <270
sout$ = frqSel$(11)
ElseIf my > 270 And my <290
sout$ = frqSel$(12)
ElseIf my > 290 And my <310
sout$ = frqSel$(13)
ElseIf my > 310 And my <330
sout$ = frqSel$(14)
ElseIf my > 330 And my <350
sout$ = frqSel$(15)
ElseIf my > 350 And my <370
sout$ = frqSel$(16)
ElseIf my > 370 And my <390
sout$ = frqSel$(17)
ElseIf my > 390 And my <410
sout$ = frqSel$(18)
ElseIf my > 440 And my < 468
If mx > 22 And mx < 82
If dirTyp = 0
Origin 0,0
FreeImage mb
FreeFont derfont2
Return pfad$+sout$
Else
If sout$ <> ""
If sout$ = ".."
ln = Len(pfad$)
pfad$ = Left$ (pfad$, ln-1)
Pos=Instr (pfad$, "\",1)
Repeat
Pos2 = Pos
If Pos > 0
Pos=Instr (pfad$, "\",Pos+1)
EndIf
Until Pos = 0
If Pos2 > 0
pfad$ = Left$ (pfad$, Pos2)
sout$ = ""
Else
sout$ = ""
Goto endeListDir
EndIf
EndIf
If sout$ <> ""
pfad$ = pfad$+sout$+"\"
;sout$=""
Repeat : Until MouseDown(1) = 0
Goto endeListDir
EndIf
Goto startListDir
EndIf
EndIf
ElseIf mx > 300 And mx < 378
sout$ = ""
Origin 0,0
FreeImage mb
FreeFont derfont2
Return sout$
ElseIf mx > 160 And mx < 238
sout$ = ""
dirTyp = 1-dirTyp
Repeat : Until MouseDown(1) = 0
FlushMouse
Goto startListDir
EndIf
EndIf
EndIf
If (sout$ <> "") And (soutsave$ = sout$) And dirtyp = 1
If sout$ = ".."
ln = Len(pfad$)
pfad$ = Left$ (pfad$, ln-1)
Pos=Instr (pfad$, "\",1)
Repeat
Pos2 = Pos
If Pos > 0
Pos=Instr (pfad$, "\",Pos+1)
EndIf
Until Pos = 0
If Pos2 > 0
pfad$ = Left$ (pfad$, Pos2)
sout$ = ""
Else
sout$ = ""
Goto endeListDir
EndIf
EndIf
If sout$ <> "" Then pfad$ = pfad$+sout$+"\"
sout$ = ""
Repeat : Until MouseDown(1) = 0
FlushMouse
Goto startListDir
Else
Repeat : Until MouseDown(1) = 0
EndIf
If KeyDown(28)
If dirTyp = 0
Origin 0,0
;freeimage mb
FreeFont derfont2
Return pfad$+sout$
Else
If sout$ <> ""
pfad$ = pfad$+sout$+"\"
sout$=""
Repeat : Until KeyDown(28) = 0
Goto startListDir
EndIf
EndIf
ElseIf (KeyDown(56) Or KeyDown(29)) And (KeyDown(45) Or KeyDown(16))
sout$ = ""
sout$ = ""
Origin 0,0
Return sout$
ElseIf mz > 0
If dirtyp = 0
If dafx > 0 Then
dafx = dafx-mz
AKTfx = AKTfx-mz
If dafx < 0
AKTfx = 18
If AKTfx > ANZfx Then AKTfx = ANZfx
dafx = 0
EndIf
For i = dafx To AKTfx
frqSel$(i-dafx) = FFRQ$(i)
Next
EndIf
Else
If dafx > 0 Then
dafx = dafx-mz
AKTdx = AKTdx-mz
If dafx < 0
AKTdx = 18
If AKTdx > ANZdx Then AKTdx = ANZdx
dafx = 0
EndIf
For i = dafx To AKTdx
frqSel$(i-dafx) = DFRQ$(i)
Next
EndIf
EndIf
FlushKeys
ElseIf mz < 0
If dirtyp = 0
If ANZfx >= (AKTfx-mz)
AKTfx = AKTfx-mz
dafx = dafx - mz
For i = dafx To AKTfx
frqSel$(i-dafx) = FFRQ$(i)
Next
EndIf
Else
If ANZdx >= AKTdx-mz
AKTdx = AKTdx-mz
dafx = dafx - mz
For i = dafx To AKTdx
frqSel$(i-dafx) = DFRQ$(i)
Next
EndIf
EndIf
FlushKeys
ElseIf KeyDown(200)
scsp = 1
If KeyDown(29) Or KeyDown(42) Or KeyDown(56) Or KeyDown(54) Or KeyDown(157) Or KeyDown(184) Then scsp = 6
If dirtyp = 0
If dafx > 0 Then
dafx = dafx-scsp
AKTfx = AKTfx-scsp
If dafx < 0
AKTfx = 18
If AKTfx > ANZfx Then AKTfx = ANZfx
dafx = 0
EndIf
For i = dafx To AKTfx
frqSel$(i-dafx) = FFRQ$(i)
Next
EndIf
Else
If dafx > 0 Then
dafx = dafx-scsp
AKTdx = AKTdx-scsp
If dafx < 0
AKTdx = 18
If AKTdx > ANZdx Then AKTdx = ANZdx
dafx = 0
EndIf
For i = dafx To AKTdx
frqSel$(i-dafx) = DFRQ$(i)
Next
EndIf
EndIf
;DELAY 120
FlushKeys
ElseIf KeyDown(208)
scsp = 1
If KeyDown(29) Or KeyDown(42) Or KeyDown(56) Or KeyDown(54) Or KeyDown(157) Or KeyDown(184) Then scsp = 6
If dirtyp = 0
If ANZfx >= AKTfx+scsp
AKTfx = AKTfx+scsp
dafx = dafx + scsp
For i = dafx To AKTfx
frqSel$(i-dafx) = FFRQ$(i)
Next
EndIf
Else
If ANZdx >= AKTdx+scsp
AKTdx = AKTdx+scsp
dafx = dafx + scsp
For i = dafx To AKTdx
frqSel$(i-dafx) = DFRQ$(i)
Next
EndIf
EndIf
;DELAY 120
FlushKeys
Else
If ls$ = "Save"
key=GetKey()
If key
If key=8
If Len( sout$ )>0
sout$ =Left$( sout$ ,Len( sout$ )-1)
EndIf
ElseIf key <> 13 And key <> 32
sout$ = sout$ + Chr$(key)
EndIf
FlushKeys
EndIf
EndIf
EndIf
UpdateWorld
RenderWorld
SetFont derFont2
DrawImage mb,0,0
Color 0,20,10 Text 4,14,titel$
Color 20,40,30
For i = 0 To 18
Line 14,50+(i*20),386,50+(i*20)
Text 18,34+(i*20),frqSel$(i)
Next
Color 0,40,37
DrawInput(16,32+(i*20),368,24,0,70,65,sout$,0,$90AABB)
Color 100,160,170
SetFont derFont2
;Text 22,36+(i*20),sout$
DrawButton(22,440,60,24,0,70,65," "+ls$,2,$001510)
DrawButton(300,440,78,24,0,70,65," Cancel",2,$001510)
If dirTyp = 0
DrawButton(160,440,78,24,0,70,65,"mode=File",2,$001510,"Verdana",16)
Else
DrawButton(160,440,78,24,0,70,65,"mode=Dir",2,$001510,"Verdana",16)
EndIf
Color 235,180,160
mx = MouseX()
my = MouseY()
If mx > 400 Then mx = 399
If my > 480 Then my = 479
Rect MouseX()-10,MouseY(),20,1,1
Rect MouseX(),MouseY()-10,1,20,1
MoveMouse mx , my
mz = MouseZSpeed()
FlushMouse
;Text 0,0,mx+" "+my
Flip
If KeyHit(Key_X) And KeyDown(KEY_CTRL_LEFT) Then
SaveBuffer FrontBuffer(), "screenshot.bmp"
End If
Until KeyDown(28) And dirtyp = 0
.endeListDir
Origin 0,0
FreeImage mb
FreeFont derfont2
FlushKeys
If dirTyp = 0 Then Return pfad$+sout$
If dirTyp = 1 Then Return pfad$
End Function
;[c]
;[c]
;
;
;#End Region
|
| ||
;---- and paste again at the end ------------
;#Region Subroutinen
; Subroutines
;#Region ReDimFR
; remFR
.redimFR
;DIM TempCH(AnimFrames)
Dim TempCH2$(AnimFrames+1)
If deleteframe > 0
For frc = 0 To AnimFrames+1
;TempCH(frc) = FRkeyCH(frc)
TempCH2$(frc) = FRkeySEQ$(frc)
Next
Else
For frc = 0 To AnimFrames-1
;TempCH(frc) = FRkeyCH(frc)
TempCH2$(frc) = FRkeySEQ$(frc)
Next
EndIf
;DIM FRkeyCH(AnimFrames)
Dim FRkeySEQ$(AnimFrames+1)
;For frc = 0 to AnimFrames
;FRkeyCH(frc) = TempCH(frc)
;FRkeySEQ$(frc) = TempCH2$(frc)
;Next
Dim StFRposX#(AnimFrames+1 ,AnzNodes)
Dim StFRposY#(AnimFrames+1 ,AnzNodes)
Dim StFRposZ#(AnimFrames+1 ,AnzNodes)
Dim StFRposDO(AnimFrames+1 ,AnzNodes)
Dim StFRscaleX#(AnimFrames+1 ,AnzNodes)
Dim StFRscaleY#(AnimFrames+1 ,AnzNodes)
Dim StFRscaleZ#(AnimFrames+1 ,AnzNodes)
Dim StFRscaleDO(AnimFrames+1 ,AnzNodes)
Dim StFRrotW#(AnimFrames+1 ,AnzNodes)
Dim StFRrotX#(AnimFrames+1 ,AnzNodes)
Dim StFRrotY#(AnimFrames+1 ,AnzNodes)
Dim StFRrotZ#(AnimFrames+1 ,AnzNodes)
Dim StFRrotDO(AnimFrames+1 ,AnzNodes)
Dim StFReuX#(AnimFrames+1 ,AnzNodes)
Dim StFReuY#(AnimFrames+1 ,AnzNodes)
Dim StFReuZ#(AnimFrames+1 ,AnzNodes)
Dim StFReuDO(AnimFrames+1 ,AnzNodes)
If deleteframe > 0
ctframes = Animframes+1
Else
ctframes = Animframes
EndIf
For cfr = 0 To ctframes
For cnd = 0 To AnzNodes-1
StFRposX#(cfr ,cnd) = FRposX#(cfr ,cnd)
StFRposY#(cfr ,cnd) = FRposY#(cfr ,cnd)
StFRposZ#(cfr ,cnd) = FRposZ#(cfr ,cnd)
StFRposDO(cfr ,cnd) = FRposDO(cfr ,cnd)
StFRscaleX#(cfr ,cnd) = FRscaleX#(cfr ,cnd)
StFRscaleY#(cfr ,cnd) = FRscaleY#(cfr ,cnd)
StFRscaleZ#(cfr ,cnd) = FRscaleZ#(cfr ,cnd)
StFRscaleDO(cfr ,cnd) = FRscaleDO(cfr ,cnd)
StFRrotW#(cfr ,cnd) = FRrotW#(cfr ,cnd)
StFRrotX#(cfr ,cnd) = FRrotX#(cfr ,cnd)
StFRrotY#(cfr ,cnd) = FRrotY#(cfr ,cnd)
StFRrotZ#(cfr ,cnd) = FRrotZ#(cfr ,cnd)
StFRrotDO(cfr ,cnd) = FRrotDO(cfr ,cnd)
StFReuX#(cfr ,cnd) = FReuX#(cfr ,cnd)
StFReuY#(cfr ,cnd) = FReuY#(cfr ,cnd)
StFReuZ#(cfr ,cnd) = FReuZ#(cfr ,cnd)
StFReuDO(cfr ,cnd) = FReuDO(cfr ,cnd)
Next
Next
Dim FRposX#(AnimFrames+1 ,AnzNodes)
Dim FRposY#(AnimFrames+1 ,AnzNodes)
Dim FRposZ#(AnimFrames+1 ,AnzNodes)
Dim FRposDO(AnimFrames+1 ,AnzNodes)
Dim FRscaleX#(AnimFrames+1 ,AnzNodes)
Dim FRscaleY#(AnimFrames+1 ,AnzNodes)
Dim FRscaleZ#(AnimFrames+1 ,AnzNodes)
Dim FRscaleDO(AnimFrames+1 ,AnzNodes)
Dim FRrotW#(AnimFrames+1 ,AnzNodes)
Dim FRrotX#(AnimFrames+1 ,AnzNodes)
Dim FRrotY#(AnimFrames+1 ,AnzNodes)
Dim FRrotZ#(AnimFrames+1 ,AnzNodes)
Dim FRrotDO(AnimFrames+1 ,AnzNodes)
Dim FReuX#(AnimFrames+1 ,AnzNodes)
Dim FReuY#(AnimFrames+1 ,AnzNodes)
Dim FReuZ#(AnimFrames+1 ,AnzNodes)
Dim FReuDO(AnimFrames+1 ,AnzNodes)
For cfr = 0 To Animframes
For cnd = 0 To AnzNodes-1
If insertframe > 0 And cfr > insertframe
FRposX#(cfr ,cnd) = StFRposX#(cfr-1 ,cnd)
FRposY#(cfr ,cnd) = StFRposY#(cfr-1 ,cnd)
FRposZ#(cfr ,cnd) = StFRposZ#(cfr-1 ,cnd)
FRposDO(cfr ,cnd) = StFRposDO(cfr-1 ,cnd)
FRscaleX#(cfr ,cnd) = StFRscaleX#(cfr-1 ,cnd)
FRscaleY#(cfr ,cnd) = StFRscaleY#(cfr-1 ,cnd)
FRscaleZ#(cfr ,cnd) = StFRscaleZ#(cfr-1 ,cnd)
FRscaleDO(cfr ,cnd) = StFRscaleDO(cfr-1 ,cnd)
FRrotW#(cfr ,cnd) = StFRrotW#(cfr-1 ,cnd)
FRrotX#(cfr ,cnd) = StFRrotX#(cfr-1 ,cnd)
FRrotY#(cfr ,cnd) = StFRrotY#(cfr-1 ,cnd)
FRrotZ#(cfr ,cnd) = StFRrotZ#(cfr-1 ,cnd)
FRrotDO(cfr ,cnd) = StFRrotDO(cfr-1 ,cnd)
FReuX#(cfr ,cnd) = StFReuX#(cfr-1 ,cnd)
FReuY#(cfr ,cnd) = StFReuY#(cfr-1 ,cnd)
FReuZ#(cfr ,cnd) = StFReuZ#(cfr-1 ,cnd)
FReuDO(cfr ,cnd) = StFReuDO(cfr-1 ,cnd)
FRkeySEQ$(cfr) = TempCH2$(cfr-1)
;FRkeyCH(cfr) = TempCH(cfr-1)
ElseIf insertframe > 0 And cfr = insertframe
FRposX#(cfr ,cnd) = StFRposX#(cfr-1 ,cnd)
FRposY#(cfr ,cnd) = StFRposY#(cfr-1 ,cnd)
FRposZ#(cfr ,cnd) = StFRposZ#(cfr-1 ,cnd)
FRposDO(cfr ,cnd) = 0 ;StFRposDO(cfr-1 ,cnd)
FRscaleX#(cfr ,cnd) = StFRscaleX#(cfr-1 ,cnd)
FRscaleY#(cfr ,cnd) = StFRscaleY#(cfr-1 ,cnd)
FRscaleZ#(cfr ,cnd) = StFRscaleZ#(cfr-1 ,cnd)
FRscaleDO(cfr ,cnd) = 0 ;StFRscaleDO(cfr-1 ,cnd)
FRrotW#(cfr ,cnd) = StFRrotW#(cfr-1 ,cnd)
FRrotX#(cfr ,cnd) = StFRrotX#(cfr-1 ,cnd)
FRrotY#(cfr ,cnd) = StFRrotY#(cfr-1 ,cnd)
FRrotZ#(cfr ,cnd) = StFRrotZ#(cfr-1 ,cnd)
FRrotDO(cfr ,cnd) = 0 ;StFRrotDO(cfr-1 ,cnd)
FReuX#(cfr ,cnd) = StFReuX#(cfr-1 ,cnd)
FReuY#(cfr ,cnd) = StFReuY#(cfr-1 ,cnd)
FReuZ#(cfr ,cnd) = StFReuZ#(cfr-1 ,cnd)
FReuDO(cfr ,cnd) = 0 ;StFReuDO(cfr-1 ,cnd)
FRkeySEQ$(cfr) = "";TempCH2$(cfr-1)
ElseIf deleteframe > 0 And cfr >= deleteframe
;If cfr < animframes
FRposX#(cfr ,cnd) = StFRposX#(cfr+1 ,cnd)
FRposY#(cfr ,cnd) = StFRposY#(cfr+1 ,cnd)
FRposZ#(cfr ,cnd) = StFRposZ#(cfr+1 ,cnd)
FRposDO(cfr ,cnd) = StFRposDO(cfr+1 ,cnd)
FRscaleX#(cfr ,cnd) = StFRscaleX#(cfr+1 ,cnd)
FRscaleY#(cfr ,cnd) = StFRscaleY#(cfr+1 ,cnd)
FRscaleZ#(cfr ,cnd) = StFRscaleZ#(cfr+1 ,cnd)
FRscaleDO(cfr ,cnd) = StFRscaleDO(cfr+1 ,cnd)
FRrotW#(cfr ,cnd) = StFRrotW#(cfr+1 ,cnd)
FRrotX#(cfr ,cnd) = StFRrotX#(cfr+1 ,cnd)
FRrotY#(cfr ,cnd) = StFRrotY#(cfr+1 ,cnd)
FRrotZ#(cfr ,cnd) = StFRrotZ#(cfr+1 ,cnd)
FRrotDO(cfr ,cnd) = StFRrotDO(cfr+1 ,cnd)
FReuX#(cfr ,cnd) = StFReuX#(cfr+1 ,cnd)
FReuY#(cfr ,cnd) = StFReuY#(cfr+1 ,cnd)
FReuZ#(cfr ,cnd) = StFReuZ#(cfr+1 ,cnd)
FReuDO(cfr ,cnd) = StFReuDO(cfr+1 ,cnd)
FRkeySEQ$(cfr) = TempCH2$(cfr+1)
;endif
ElseIf addframe = 1 And cfr = Animframes
FRposX#(cfr ,cnd) = StFRposX#(cfr-1 ,cnd)
FRposY#(cfr ,cnd) = StFRposY#(cfr-1 ,cnd)
FRposZ#(cfr ,cnd) = StFRposZ#(cfr-1 ,cnd)
FRposDO(cfr ,cnd) = 0 ;StFRposDO(cfr-1 ,cnd)
FRscaleX#(cfr ,cnd) = StFRscaleX#(cfr-1 ,cnd)
FRscaleY#(cfr ,cnd) = StFRscaleY#(cfr-1 ,cnd)
FRscaleZ#(cfr ,cnd) = StFRscaleZ#(cfr-1 ,cnd)
FRscaleDO(cfr ,cnd) = 0 ;StFRscaleDO(cfr-1 ,cnd)
FRrotW#(cfr ,cnd) = StFRrotW#(cfr-1 ,cnd)
FRrotX#(cfr ,cnd) = StFRrotX#(cfr-1 ,cnd)
FRrotY#(cfr ,cnd) = StFRrotY#(cfr-1 ,cnd)
FRrotZ#(cfr ,cnd) = StFRrotZ#(cfr-1 ,cnd)
FRrotDO(cfr ,cnd) = 0 ;StFRrotDO(cfr-1 ,cnd)
FReuX#(cfr ,cnd) = StFReuX#(cfr-1 ,cnd)
FReuY#(cfr ,cnd) = StFReuY#(cfr-1 ,cnd)
FReuZ#(cfr ,cnd) = StFReuZ#(cfr-1 ,cnd)
FReuDO(cfr ,cnd) = 0 ;StFReuDO(cfr-1 ,cnd)
FRkeySEQ$(cfr) = 0
Else
FRposX#(cfr ,cnd) = StFRposX#(cfr ,cnd)
FRposY#(cfr ,cnd) = StFRposY#(cfr ,cnd)
FRposZ#(cfr ,cnd) = StFRposZ#(cfr ,cnd)
FRposDO(cfr ,cnd) = StFRposDO(cfr ,cnd)
FRscaleX#(cfr ,cnd) = StFRscaleX#(cfr ,cnd)
FRscaleY#(cfr ,cnd) = StFRscaleY#(cfr ,cnd)
FRscaleZ#(cfr ,cnd) = StFRscaleZ#(cfr ,cnd)
FRscaleDO(cfr ,cnd) = StFRscaleDO(cfr ,cnd)
FRrotW#(cfr ,cnd) = StFRrotW#(cfr ,cnd)
FRrotX#(cfr ,cnd) = StFRrotX#(cfr ,cnd)
FRrotY#(cfr ,cnd) = StFRrotY#(cfr ,cnd)
FRrotZ#(cfr ,cnd) = StFRrotZ#(cfr ,cnd)
FRrotDO(cfr ,cnd) = StFRrotDO(cfr ,cnd)
FReuX#(cfr ,cnd) = StFReuX#(cfr ,cnd)
FReuY#(cfr ,cnd) = StFReuY#(cfr ,cnd)
FReuZ#(cfr ,cnd) = StFReuZ#(cfr ,cnd)
FReuDO(cfr ,cnd) = StFReuDO(cfr ,cnd)
FRkeySEQ$(cfr) = TempCH2$(cfr)
EndIf
Next
Next
Dim StFRposX#(AnimFrames+1 ,AnzNodes)
Dim StFRposY#(AnimFrames+1 ,AnzNodes)
Dim StFRposZ#(AnimFrames+1 ,AnzNodes)
Dim StFRposDO(AnimFrames+1 ,AnzNodes)
Dim StFRscaleX#(AnimFrames+1 ,AnzNodes)
Dim StFRscaleY#(AnimFrames+1 ,AnzNodes)
Dim StFRscaleZ#(AnimFrames+1 ,AnzNodes)
Dim StFRscaleDO(AnimFrames+1 ,AnzNodes)
Dim StFRrotW#(AnimFrames+1 ,AnzNodes)
Dim StFRrotX#(AnimFrames+1 ,AnzNodes)
Dim StFRrotY#(AnimFrames+1 ,AnzNodes)
Dim StFRrotZ#(AnimFrames+1 ,AnzNodes)
Dim StFRrotDO(AnimFrames+1 ,AnzNodes)
Dim StFReuX#(AnimFrames+1 ,AnzNodes)
Dim StFReuY#(AnimFrames+1 ,AnzNodes)
Dim StFReuZ#(AnimFrames+1 ,AnzNodes)
Dim StFReuDO(AnimFrames+1 ,AnzNodes)
If deleteframe > 0
ctframes = Animframes+1
Else
ctframes = Animframes
EndIf
For cfr = 0 To ctframes
For cnd = 0 To AnzNodes-1
StFRposX#(cfr ,cnd) = STOREposX#(cfr ,cnd)
StFRposY#(cfr ,cnd) = STOREposY#(cfr ,cnd)
StFRposZ#(cfr ,cnd) = STOREposZ#(cfr ,cnd)
StFRposDO(cfr ,cnd) = STOREposDO(cfr ,cnd)
StFRscaleX#(cfr ,cnd) = STOREscaleX#(cfr ,cnd)
StFRscaleY#(cfr ,cnd) = STOREscaleY#(cfr ,cnd)
StFRscaleZ#(cfr ,cnd) = STOREscaleZ#(cfr ,cnd)
StFRscaleDO(cfr ,cnd) = STOREscaleDO(cfr ,cnd)
StFRrotW#(cfr ,cnd) = STORErotW#(cfr ,cnd)
StFRrotX#(cfr ,cnd) = STORErotX#(cfr ,cnd)
StFRrotY#(cfr ,cnd) = STORErotY#(cfr ,cnd)
StFRrotZ#(cfr ,cnd) = STORErotZ#(cfr ,cnd)
StFRrotDO(cfr ,cnd) = STORErotDO(cfr ,cnd)
StFReuX#(cfr ,cnd) = STOREeuX#(cfr ,cnd)
StFReuY#(cfr ,cnd) = STOREeuY#(cfr ,cnd)
StFReuZ#(cfr ,cnd) = STOREeuZ#(cfr ,cnd)
StFReuDO(cfr ,cnd) = STOREeuDO(cfr ,cnd)
Next
Next
Dim STOREposX#(AnimFrames+1 ,AnzNodes)
Dim STOREposY#(AnimFrames+1 ,AnzNodes)
Dim STOREposZ#(AnimFrames+1 ,AnzNodes)
Dim STOREposDO(AnimFrames+1 ,AnzNodes)
Dim STOREscaleX#(AnimFrames+1 ,AnzNodes)
Dim STOREscaleY#(AnimFrames+1 ,AnzNodes)
Dim STOREscaleZ#(AnimFrames+1 ,AnzNodes)
Dim STOREscaleDO(AnimFrames+1 ,AnzNodes)
Dim STORErotW#(AnimFrames+1 ,AnzNodes)
Dim STORErotX#(AnimFrames+1 ,AnzNodes)
Dim STORErotY#(AnimFrames+1 ,AnzNodes)
Dim STORErotZ#(AnimFrames+1 ,AnzNodes)
Dim STORErotDO(AnimFrames+1 ,AnzNodes)
Dim STOREeuX#(AnimFrames+1 ,AnzNodes)
Dim STOREeuY#(AnimFrames+1 ,AnzNodes)
Dim STOREeuZ#(AnimFrames+1 ,AnzNodes)
Dim STOREeuDO(AnimFrames+1 ,AnzNodes)
For cfr = 0 To Animframes
For cnd = 0 To AnzNodes-1
If insertframe > 0 And cfr > insertframe
STOREposX#(cfr ,cnd) = StFRposX#(cfr-1 ,cnd)
STOREposY#(cfr ,cnd) = StFRposY#(cfr-1 ,cnd)
STOREposZ#(cfr ,cnd) = StFRposZ#(cfr-1 ,cnd)
STOREposDO(cfr ,cnd) = StFRposDO(cfr-1 ,cnd)
STOREscaleX#(cfr ,cnd) = StFRscaleX#(cfr-1 ,cnd)
STOREscaleY#(cfr ,cnd) = StFRscaleY#(cfr-1 ,cnd)
STOREscaleZ#(cfr ,cnd) = StFRscaleZ#(cfr-1 ,cnd)
STOREscaleDO(cfr ,cnd) = StFRscaleDO(cfr-1 ,cnd)
STORErotW#(cfr ,cnd) = StFRrotW#(cfr-1 ,cnd)
STORErotX#(cfr ,cnd) = StFRrotX#(cfr-1 ,cnd)
STORErotY#(cfr ,cnd) = StFRrotY#(cfr-1 ,cnd)
STORErotZ#(cfr ,cnd) = StFRrotZ#(cfr-1 ,cnd)
STORErotDO(cfr ,cnd) = StFRrotDO(cfr-1 ,cnd)
STOREeuX#(cfr ,cnd) = StFReuX#(cfr-1 ,cnd)
STOREeuY#(cfr ,cnd) = StFReuY#(cfr-1 ,cnd)
STOREeuZ#(cfr ,cnd) = StFReuZ#(cfr-1 ,cnd)
STOREeuDO(cfr ,cnd) = StFReuDO(cfr-1 ,cnd)
;STOREkeySEQ$(cfr) = TempCH2$(cfr-1)
;STOREkeyCH(cfr) = TempCH(cfr-1)
ElseIf insertframe > 0 And cfr = insertframe
STOREposX#(cfr ,cnd) = StFRposX#(cfr-1 ,cnd)
STOREposY#(cfr ,cnd) = StFRposY#(cfr-1 ,cnd)
STOREposZ#(cfr ,cnd) = StFRposZ#(cfr-1 ,cnd)
STOREposDO(cfr ,cnd) = 0 ;StFRposDO(cfr-1 ,cnd)
STOREscaleX#(cfr ,cnd) = StFRscaleX#(cfr-1 ,cnd)
STOREscaleY#(cfr ,cnd) = StFRscaleY#(cfr-1 ,cnd)
STOREscaleZ#(cfr ,cnd) = StFRscaleZ#(cfr-1 ,cnd)
STOREscaleDO(cfr ,cnd) = 0 ;StFRscaleDO(cfr-1 ,cnd)
STORErotW#(cfr ,cnd) = StFRrotW#(cfr-1 ,cnd)
STORErotX#(cfr ,cnd) = StFRrotX#(cfr-1 ,cnd)
STORErotY#(cfr ,cnd) = StFRrotY#(cfr-1 ,cnd)
STORErotZ#(cfr ,cnd) = StFRrotZ#(cfr-1 ,cnd)
STORErotDO(cfr ,cnd) = 0 ;StFRrotDO(cfr-1 ,cnd)
STOREeuX#(cfr ,cnd) = StFReuX#(cfr-1 ,cnd)
STOREeuY#(cfr ,cnd) = StFReuY#(cfr-1 ,cnd)
STOREeuZ#(cfr ,cnd) = StFReuZ#(cfr-1 ,cnd)
STOREeuDO(cfr ,cnd) = 0 ;StFReuDO(cfr-1 ,cnd)
;STOREkeySEQ$(cfr) = TempCH2$(cfr-1)
ElseIf deleteframe > 0 And cfr >= deleteframe
;If cfr < animframes
STOREposX#(cfr ,cnd) = StFRposX#(cfr+1 ,cnd)
STOREposY#(cfr ,cnd) = StFRposY#(cfr+1 ,cnd)
STOREposZ#(cfr ,cnd) = StFRposZ#(cfr+1 ,cnd)
STOREposDO(cfr ,cnd) = StFRposDO(cfr+1 ,cnd)
STOREscaleX#(cfr ,cnd) = StFRscaleX#(cfr+1 ,cnd)
STOREscaleY#(cfr ,cnd) = StFRscaleY#(cfr+1 ,cnd)
STOREscaleZ#(cfr ,cnd) = StFRscaleZ#(cfr+1 ,cnd)
STOREscaleDO(cfr ,cnd) = StFRscaleDO(cfr+1 ,cnd)
STORErotW#(cfr ,cnd) = StFRrotW#(cfr+1 ,cnd)
STORErotX#(cfr ,cnd) = StFRrotX#(cfr+1 ,cnd)
STORErotY#(cfr ,cnd) = StFRrotY#(cfr+1 ,cnd)
STORErotZ#(cfr ,cnd) = StFRrotZ#(cfr+1 ,cnd)
STORErotDO(cfr ,cnd) = StFRrotDO(cfr+1 ,cnd)
STOREeuX#(cfr ,cnd) = StFReuX#(cfr+1 ,cnd)
STOREeuY#(cfr ,cnd) = StFReuY#(cfr+1 ,cnd)
STOREeuZ#(cfr ,cnd) = StFReuZ#(cfr+1 ,cnd)
STOREeuDO(cfr ,cnd) = StFReuDO(cfr+1 ,cnd)
;endif
ElseIf cfr = Animframes And addframe = 1
STOREposX#(cfr ,cnd) = StFRposX#(cfr-1 ,cnd)
STOREposY#(cfr ,cnd) = StFRposY#(cfr-1 ,cnd)
STOREposZ#(cfr ,cnd) = StFRposZ#(cfr-1 ,cnd)
STOREposDO(cfr ,cnd) = 0 ;StFRposDO(cfr-1 ,cnd)
STOREscaleX#(cfr ,cnd) = StFRscaleX#(cfr-1 ,cnd)
STOREscaleY#(cfr ,cnd) = StFRscaleY#(cfr-1 ,cnd)
STOREscaleZ#(cfr ,cnd) = StFRscaleZ#(cfr-1 ,cnd)
STOREscaleDO(cfr ,cnd) = 0 ;StFRscaleDO(cfr-1 ,cnd)
STORErotW#(cfr ,cnd) = StFRrotW#(cfr-1 ,cnd)
STORErotX#(cfr ,cnd) = StFRrotX#(cfr-1 ,cnd)
STORErotY#(cfr ,cnd) = StFRrotY#(cfr-1 ,cnd)
STORErotZ#(cfr ,cnd) = StFRrotZ#(cfr-1 ,cnd)
STORErotDO(cfr ,cnd) = 0 ;StFRrotDO(cfr-1 ,cnd)
STOREeuX#(cfr ,cnd) = StFReuX#(cfr-1 ,cnd)
STOREeuY#(cfr ,cnd) = StFReuY#(cfr-1 ,cnd)
STOREeuZ#(cfr ,cnd) = StFReuZ#(cfr-1 ,cnd)
STOREeuDO(cfr ,cnd) = 0 ;StFReuDO(cfr-1 ,cnd)
;STOREkeySEQ$(cfr) = TempCH2$(cfr-1)
Else
STOREposX#(cfr ,cnd) = StFRposX#(cfr ,cnd)
STOREposY#(cfr ,cnd) = StFRposY#(cfr ,cnd)
STOREposZ#(cfr ,cnd) = StFRposZ#(cfr ,cnd)
STOREposDO(cfr ,cnd) = StFRposDO(cfr ,cnd)
STOREscaleX#(cfr ,cnd) = StFRscaleX#(cfr ,cnd)
STOREscaleY#(cfr ,cnd) = StFRscaleY#(cfr ,cnd)
STOREscaleZ#(cfr ,cnd) = StFRscaleZ#(cfr ,cnd)
STOREscaleDO(cfr ,cnd) = StFRscaleDO(cfr ,cnd)
STORErotW#(cfr ,cnd) = StFRrotW#(cfr ,cnd)
STORErotX#(cfr ,cnd) = StFRrotX#(cfr ,cnd)
STORErotY#(cfr ,cnd) = StFRrotY#(cfr ,cnd)
STORErotZ#(cfr ,cnd) = StFRrotZ#(cfr ,cnd)
STORErotDO(cfr ,cnd) = StFRrotDO(cfr ,cnd)
STOREeuX#(cfr ,cnd) = StFReuX#(cfr ,cnd)
STOREeuY#(cfr ,cnd) = StFReuY#(cfr ,cnd)
STOREeuZ#(cfr ,cnd) = StFReuZ#(cfr ,cnd)
STOREeuDO(cfr ,cnd) = StFReuDO(cfr ,cnd)
EndIf
Next
Next
insertframe = 0
addframe = 0
deleteframe = 0
Return
;
;#End Region
; morphing
;#Region morphing
.morphing
thisID = node\num
storeAFN = aktframenum
cnode = 0
If mf2 < mf1
mf3 = mf1
mf1 = mf2
mf2 = mf3
EndIf
aktframenum = mf1
Gosub showFrame
cnode = 0
c# = mf2-mf1+1
cmf# = 1.0
For mfx = mf1 To mf2
cnode = 0
For node.node = Each node
If cmf# > 1.0
;IF FRposDO(mf2 ,cnode) = 1
FRposX#(mfx ,cnode) = ((( FRposX#(mf2 ,cnode) - FRposX#(mf1 ,cnode)) * cmf) / c ) +FRposX#(mf1 ,cnode)
FRposY#(mfx ,cnode) = ((( FRposY#(mf2 ,cnode) - FRposY#(mf1 ,cnode)) * cmf) / c ) +FRposY#(mf1 ,cnode)
FRposZ#(mfx ,cnode) = ((( FRposZ#(mf2 ,cnode) - FRposZ#(mf1 ,cnode)) * cmf) / c ) + FRposZ#(mf1 ,cnode)
FRposDO(mfx ,cnode) = FRposDO(mf2 ,cnode)
If FRposDO(mf2 ,cnode) = 1 Then MoveEntity node\bsphereparent,FRposX#(mfx ,cnode),FRposY#(mfx ,cnode),FRposZ#(mfx ,cnode)
;ENDIF
;IF FRscaleDO(mf2 ,cnode) = 1
FRscaleX#(mfx ,cnode) = ((( FRscaleX#(mf2 ,cnode) - FRscaleX#(mf1 ,cnode)) * cmf) / c ) + FRscaleX#(mf1 ,cnode)
FRscaleY#(mfx ,cnode) = ((( FRscaleY#(mf2 ,cnode) - FRscaleY#(mf1 ,cnode)) * cmf) / c ) + FRscaleY#(mf1 ,cnode)
FRscaleZ#(mfx ,cnode) = ((( FRscaleZ#(mf2 ,cnode) - FRscaleZ#(mf1 ,cnode)) * cmf) / c ) + FRscaleZ#(mf1 ,cnode)
FRscaleDO(mfx ,cnode) = FRscaleDO(mf2 ,cnode)
If FRscaleDO(mf2 ,cnode) = 1 Then ScaleEntity node\bsphereparent, FRscaleX#(mfx ,cnode) , FRscaleY#(mfx ,cnode) , FRscaleZ#(mfx ,cnode)
;ENDIF
;IF FReuDO(mf2 ,cnode) = 1
FReuX#(mfx ,cnode) = ((( FReuX#(mf2 ,cnode) - FReuX#(mf1 ,cnode)) * cmf) / c ) + FReuX#(mf1 ,cnode)
FReuY#(mfx ,cnode) = ((( FReuY#(mf2 ,cnode) - FReuY#(mf1 ,cnode)) * cmf) / c ) + FReuY#(mf1 ,cnode)
FReuZ#(mfx ,cnode) = ((( FReuZ#(mf2 ,cnode) - FReuZ#(mf1 ,cnode)) * cmf) / c ) + FReuZ#(mf1 ,cnode)
FReuDO(mfx ,cnode) = FReuDO(mf2 ,cnode)
If FReuDO(mf2 ,cnode) = 1 Then RotateEntity node\bsphereparent, FReuX#(mfx ,cnode) , FReuY#(mfx ,cnode) , FReuZ#(mfx ,cnode)
;ENDIF
UpdateWorld
RenderWorld
;IF FRrotDO(mf2 ,cnode) = 1 or FReuDO(mf2 ,cnode) = 1
MemoryToBank(bnx,node\bsphereparent,100)
FRrotW#(mfx ,cnode) = PeekFloat(bnx,12*4)
FRrotX#(mfx ,cnode) = PeekFloat(bnx,13*4)
FRrotY#(mfx ,cnode) = PeekFloat(bnx,14*4)
FRrotZ#(mfx ,cnode) = PeekFloat(bnx,15*4)
FRrotDO(mfx ,cnode) = FRrotDO(mf2 ,cnode)
;ENDIF
EndIf
cnode = cnode + 1
Flip
Next
cmf# = cmf# + 1.0
Next
node.node = Object.node(thisID)
aktframenum = storeAFN
Return
;
;#End Region
; showFrame
.showframe
thisHD = node\num
cnode = 0
teststr$ = ""
For node.node = Each node
tmpHD = FindChild(theanim,node\name)
If FReuDO(aktframenum ,cnode) = 1 Or FRrotDO(aktframenum,cnode) = 1
;IF FReuX#(aktframenum ,cnode) <> 0 or FReuY#(aktframenum , cnode) <> 0 or FReuZ#(aktframenum ,cnode) <> 0
RotateEntity tmpHD, FReuX#(aktframenum ,cnode) , FReuY#(aktframenum , cnode) , FReuZ#(aktframenum ,cnode)
;ENDIF
; testfr = testfr +1
; teststr$ = teststr$ + "rot "+tmpHD + " " + aktframenum + " " + cnode + " - "+FReuX#(aktframenum ,cnode) + ", "+ FReuY#(aktframenum , cnode) + ", "+ FReuZ#(aktframenum ,cnode) + " :: "
; updateworld
; renderworld
; flip
EndIf
If FRposDO(aktframenum ,cnode) = 1
;IF FRposX#(aktframenum ,cnode) <> 0 or FRposY#(aktframenum ,cnode) <> 0 or FRposZ#(aktframenum ,cnode)
PositionEntity tmpHD, FRposX#(aktframenum ,cnode) , FRposY#(aktframenum ,cnode) , FRposZ#(aktframenum ,cnode)
;ENDIF
; testfr = testfr +1
; teststr$ = teststr$ + "pos "+tmpHD + " " + aktframenum + " " + cnode
;updateworld
; renderworld
; flip
EndIf
If FRscaleDO(aktframenum ,cnode) = 1
;IF FRscaleX#(aktframenum ,cnode) <> 0 or FRscaleY#(aktframenum ,cnode) <> 0 or FRscaleZ#(aktframenum ,cnode)
EntityParent node\bsphere,0
ScaleEntity tmpHD, FRscaleX#(aktframenum ,cnode) , FRscaleY#(aktframenum ,cnode) , FRscaleZ#(aktframenum ,cnode)
EntityParent node\bsphere,node\bsphereparent
;ENDIF
; testfr = testfr +1
; teststr$ = teststr$ + "scale "+tmpHD + " " + aktframenum + " " + cnode
; updateworld
; renderworld
; flip
EndIf
cnode = cnode + 1
Next
node.node = Object.node(thisHD)
Return
;
; showFrameall
.showframeall
thisHD = node\num
cnode = 0
For node.node = Each node
RotateEntity node\bsphereparent, FReuX#(aktframenum ,cnode) , FReuY#(aktframenum , cnode) , FReuZ#(aktframenum ,cnode)
PositionEntity node\bsphereparent, FRposX#(aktframenum ,cnode) , FRposY#(aktframenum ,cnode) , FRposZ#(aktframenum ,cnode)
EntityParent node\bsphere,0
ScaleEntity node\bsphereparent, FRscaleX#(aktframenum ,cnode) , FRscaleY#(aktframenum ,cnode) , FRscaleZ#(aktframenum ,cnode)
EntityParent node\bsphere,node\bsphereparent
cnode = cnode + 1
;Animate theanim,3,1,sq(aktframenum)
; updateworld
; renderworld
; flip
Next
node.node = Object.node(thisHD)
Return
;
; opennew
.opennew
For Node.Node = Each Node
tempbank = node\ChunkNodeBank
FreeBank tempbank
tempbank = node\childbank
FreeBank tempbank
tb =node\bonebank
FreeBank tb
tb =node\key1bank
FreeBank tb
tb =node\key2bank
FreeBank tb
tb =node\key3bank
FreeBank tb
Next
For tris.tris = Each tris
FreeBank tris\vxbank
Next
FreeBank bn2
FreeBank bnx
For texs.texs = Each texs
Delete texs.texs
Next
For brus.brus = Each brus
Delete brus.brus
Next
For vrts.vrts = Each vrts
Delete vrts.vrts
Next
For tris.tris = Each tris
Delete tris.tris
Next
For node.node = Each node
Delete node.node
Next
countnode = 0
nodi = 0
NodeKeyAnz = 0
boni = 0
keyi = 0
AnimFrames = 0
aktframenum = 0
FreeEntity anim0
FreeEntity theanim
ClearWorld
Return
;
; VertexRND
.VertexRND
i = 0
SeedRnd MilliSecs()
For vrts.vrts = Each vrts
PositionEntity Cubes(i), VRTS\x#+Rnd#(-scrnd#,scrnd#), VRTS\y#+Rnd#(-scrnd#,scrnd#), VRTS\z#+Rnd#(-scrnd#,scrnd#)
i = i + 1
Next
i = 0
Return
;
; PositionVertexes
.positionVertexes
i = 0
For vrts.vrts = Each vrts
PositionEntity Cubes(i), VRTS\x#, VRTS\y#, VRTS\z#
i = i + 1
Next
i = 0
Return
;
; Copy Frame
.copyFrame
Dim CpyFRposX#(AnzNodes)
Dim CpyFRposY#(AnzNodes)
Dim CpyFRposZ#(AnzNodes)
Dim CpyFRposDO(AnzNodes)
Dim CpyFRscaleX#(AnzNodes)
Dim CpyFRscaleY#(AnzNodes)
Dim CpyFRscaleZ#(AnzNodes)
Dim CpyFRscaleDO(AnzNodes)
Dim CpyFRrotW#(AnzNodes)
Dim CpyFRrotX#(AnzNodes)
Dim CpyFRrotY#(AnzNodes)
Dim CpyFRrotZ#(AnzNodes)
Dim CpyFRrotDO(AnzNodes)
Dim CpyFReuX#(AnzNodes)
Dim CpyFReuY#(AnzNodes)
Dim CpyFReuZ#(AnzNodes)
Dim CpyFReuDO(AnzNodes)
copyNodes = AnzNodes-1
For cnd = 0 To AnzNodes-1
CpyFRposX#(cnd) = FRposX#(aktframenum ,cnd)
CpyFRposY#(cnd) = FRposY#(aktframenum ,cnd)
CpyFRposZ#(cnd) = FRposZ#(aktframenum ,cnd)
CpyFRposDO(cnd) = FRposDO(aktframenum ,cnd)
CpyFRscaleX#(cnd) = FRscaleX#(aktframenum ,cnd)
CpyFRscaleY#(cnd) = FRscaleY#(aktframenum ,cnd)
CpyFRscaleZ#(cnd) = FRscaleZ#(aktframenum ,cnd)
CpyFRscaleDO(cnd) = FRscaleDO(aktframenum ,cnd)
CpyFRrotW#(cnd) = FRrotW#(aktframenum ,cnd)
CpyFRrotX#(cnd) = FRrotX#(aktframenum ,cnd)
CpyFRrotY#(cnd) = FRrotY#(aktframenum ,cnd)
CpyFRrotZ#(cnd) = FRrotZ#(aktframenum ,cnd)
CpyFRrotDO(cnd) = FRrotDO(aktframenum ,cnd)
CpyFReuX#(cnd) = FReuX#(aktframenum ,cnd)
CpyFReuY#(cnd) = FReuY#(aktframenum ,cnd)
CpyFReuZ#(cnd) = FReuZ#(aktframenum ,cnd)
CpyFReuDO(cnd) = FReuDO(aktframenum ,cnd)
Next
copyInside = 1
Return
;
; Paste Frame
.pasteFrame
If copyInside = 1
If copyNodes > AnzNodes-1 Then copynodes = AnzNodes-1
For cnd = 0 To copyNodes
FRposX#(aktframenum ,cnd) = CpyFRposX#(cnd)
FRposY#(aktframenum ,cnd) = CpyFRposY#(cnd)
FRposZ#(aktframenum ,cnd) = CpyFRposZ#(cnd)
dodo = 0
If FRposX#(aktframenum-1 ,cnd) <> FRposX#(aktframenum ,cnd) Then dodo = 1
If FRposY#(aktframenum-1 ,cnd) <> FRposY#(aktframenum ,cnd) Then dodo = 1
If FRposZ#(aktframenum-1 ,cnd) <> FRposZ#(aktframenum ,cnd) Then dodo = 1
If dodo = 1 Then FRposDO(aktframenum ,cnd) = 1 Else FRposDO(aktframenum ,cnd) = 0
FRscaleX#(aktframenum ,cnd) = CpyFRscaleX#(cnd)
FRscaleY#(aktframenum ,cnd) = CpyFRscaleY#(cnd)
FRscaleZ#(aktframenum ,cnd) = CpyFRscaleZ#(cnd)
dodo = 0
If FRscaleX#(aktframenum-1 ,cnd) <> FRscaleX#(aktframenum ,cnd) Then dodo = 1
If FRscaleY#(aktframenum-1 ,cnd) <> FRscaleY#(aktframenum ,cnd) Then dodo = 1
If FRscaleZ#(aktframenum-1 ,cnd) <> FRscaleZ#(aktframenum ,cnd) Then dodo = 1
If dodo = 1 Then FRscaleDO(aktframenum ,cnd) = 1 Else FRscaleDO(aktframenum ,cnd) = 0
FRrotW#(aktframenum ,cnd) = CpyFRrotW#(cnd)
FRrotX#(aktframenum ,cnd) = CpyFRrotX#(cnd)
FRrotY#(aktframenum ,cnd) = CpyFRrotY#(cnd)
FRrotZ#(aktframenum ,cnd) = CpyFRrotZ#(cnd)
dodo = 0
If FRrotW#(aktframenum-1 ,cnd) <> FRrotW#(aktframenum ,cnd) Then dodo = 1
If FRrotX#(aktframenum-1 ,cnd) <> FRrotX#(aktframenum ,cnd) Then dodo = 1
If FRrotY#(aktframenum-1 ,cnd) <> FRrotY#(aktframenum ,cnd) Then dodo = 1
If FRrotZ#(aktframenum-1 ,cnd) <> FRrotZ#(aktframenum ,cnd) Then dodo = 1
If dodo = 1 Then FRrotDO(aktframenum ,cnd) = 1 Else FRrotDO(aktframenum ,cnd) = 0
FReuX#(aktframenum ,cnd) = CpyFReuX#(cnd)
FReuY#(aktframenum ,cnd) = CpyFReuY#(cnd)
FReuZ#(aktframenum ,cnd) = CpyFReuZ#(cnd)
dodo = 0
If FReuX#(aktframenum-1 ,cnd) <> FReuX#(aktframenum ,cnd) Then dodo = 1
If FReuY#(aktframenum-1 ,cnd) <> FReuY#(aktframenum ,cnd) Then dodo = 1
If FReuZ#(aktframenum-1 ,cnd) <> FReuZ#(aktframenum ,cnd) Then dodo = 1
If dodo = 1 Then FReuDO(aktframenum ,cnd) = 1 Else FReuDO(aktframenum ,cnd) = 0
Next
EndIf
Return
;
; writespeedconfig
.writespeedconfig
outspeed = WriteFile("SpeedConfig.dat")
WriteFloat outspeed, rt1speed#
WriteFloat outspeed, rt2speed#
WriteFloat outspeed, rt3speed#
WriteFloat outspeed, mv1speed#
WriteFloat outspeed, mv2speed#
WriteFloat outspeed, mv3speed#
WriteFloat outspeed, sc1speed#
WriteFloat outspeed, sc2speed#
WriteFloat outspeed, sc3speed#
WriteFloat outspeed, bonespeedS#
WriteFloat outspeed, bonespeedM#
WriteFloat outspeed, bonespeedF#
CloseFile(outspeed)
Return
;
; readspeedconfig
.readspeedconfig
If FileType ("SpeedConfig.dat")
inspeed = ReadFile("SpeedConfig.dat")
rt1speed# = ReadFloat#(inspeed)
rt2speed# = ReadFloat#(inspeed)
rt3speed# = ReadFloat#(inspeed)
mv1speed# = ReadFloat#(inspeed)
mv2speed# = ReadFloat#(inspeed)
mv3speed# = ReadFloat#(inspeed)
sc1speed# = ReadFloat#(inspeed)
sc2speed# = ReadFloat#(inspeed)
sc3speed# = ReadFloat#(inspeed)
bonespeedS# = ReadFloat#(inspeed)
bonespeedM# = ReadFloat#(inspeed)
bonespeedF# = ReadFloat#(inspeed)
CloseFile(inspeed)
EndIf
Return
;
; beforeMove
.beforeMove
Return
;
; afterMove
.afterMove
MemoryToBank(bnx,node\sphere,100)
node\posX# = PeekFloat(bnx,16*4)
node\posY# = PeekFloat(bnx,17*4)
node\posZ# = PeekFloat(bnx,18*4)
node\rotW# = PeekFloat(bnx,12*4)
node\rotX# = PeekFloat(bnx,13*4)
node\rotY# = PeekFloat(bnx,14*4)
node\rotZ# = PeekFloat(bnx,15*4)
Return
;
;
;#End Region
|
| ||
;---- the same again, paste at the end of the source ---
;#Region Menu
; Menu
Function RenderMenu()
;--> initialisiere Menüdaten wenn noch nicht geschehen
If aktualModus = 1
If Mnu$(0)="" Then MnuInit()
ElseIf aktualModus = 2
If Mnu$(0)="" Then Mnu2Init()
EndIf
;--> Maus gedrückt?
If MouseY() < 500 And MouseX() < 500 And MouseDown(1)
MHit = MouseDown(1)
.waitmouse1
If MouseDown(1) Then Goto waitmouse1
EndIf
SetFont MnuFont
;--> Menüleiste darstellen (Hintergrund)
Color 0,0,MnuBackC
Rect MnuPosX,MnuPosY,GraphicsWidth(),19,True
;--> Einträge auf der Menüleiste darstellen
I=1:A=0:Xw=0
For Cnt=1 To MnuCount(Mnu$(0))
A=Instr(Mnu$(0),"|",I)
B$=" " + Mid$(Mnu$(0),I,A-I) + " "
Xw=StringWidth(B$)
Color 0,0,MnuForeC
;--> wenn Maus auf Menüpunkt, dann markiere den entsprechenden Eintrag
If MouseY()<MnuPosY+19 And MouseY()>MnuPosY Then
If MouseX()>X+MnuPosX And MouseX()<X+Xw+MnuPosX Then
;--> wenn jetzt die Maus geklickt wurde, schalte den Menüstatus an bzw. aus
If MHit Then
MHit=False
If MnuState Then MnuState=False Else MnuState=True
End If
;--> wenn Menüstaus aktiv, dann merke die Eintragsnummer
If MnuState Then MnuActiv=Cnt
;--> Eintrag markieren
Color 0,0,MnuBackM
Rect MnuPosX+X,MnuPosY+1,Xw,17,True
Color 0,0,MnuBorderM
Rect MnuPosX+X,MnuPosY+1,Xw,17,False
Color 0,0,MnuForeM
End If
End If
Text MnuPosX+X,MnuPosY+3,B$
I=A+1
MnuX(Cnt)=X
X=X+Xw
Next
;--> Submenü geöffnet?
If MnuState Then
;-->> finde breitesten Eintrag
I=1:A=0:Xw=0
MaxCnt=MnuCount(Mnu$(MnuActiv))
For Cnt=1 To MaxCnt
A=Instr(Mnu$(MnuActiv),"|",I)
B$=" " + Mid$(Mnu$(MnuActiv),I,A-I) + " "
I=A+1
If StringWidth(B$)>Xw Then Xw=StringWidth(B$)+10
Next
;--> zeichne Submenü
Color 0,0,MnuBackC
Rect MnuPosX+MnuX(MnuActiv),MnuPosY+19,Xw+16,MaxCnt*19+1,True
Color 0,0,MnuBorderH
Rect MnuPosX+MnuX(MnuActiv),MnuPosY+19,Xw+16,MaxCnt*19+1,False
Color 0,0,MnuBorderD
Line MnuPosX+MnuX(MnuActiv)+1,MnuPosY+19+MaxCnt*19,MnuPosX+MnuX(MnuActiv)+Xw+15,MnuPosY+19+MaxCnt*19
Line MnuPosX+MnuX(MnuActiv)+Xw+15,MnuPosY+19+MaxCnt*19,MnuPosX+MnuX(MnuActiv)+Xw+15,MnuPosY+19+1
I=1:A=0
For Cnt=1 To MaxCnt
;--> zeichne Icon
;If MnuIcon(MnuActiv,Cnt)<>0 Then DrawImage MnuIcon(MnuActiv,Cnt),MnuPosX+MnuX(MnuActiv)+1,MnuPosY+Cnt*19+1 ;--> Icon
A=Instr(Mnu$(MnuActiv),"|",I)
B$=" " + Mid$(Mnu$(MnuActiv),I,A-I) + " "
I=A+1
Color 0,0,MnuForeC
;--> wenn Maus auf SUB-Menü-Punkt, dann markiere den entsprechenden Eintrag
If RectsOverlap(MnuPosX+MnuX(MnuActiv),MnuPosY+Cnt*19+1,Xw+17,19,MouseX(),MouseY(),1,1) And B$<>" - " Then
;--> wenn Maus auf Menüpunkt gedrückt, dann kehre zurück
If MHit Then
MnuState=False
MHit=False
Return MnuActiv*100+Cnt
End If
;--> Eintrag markieren
Color 0,0,MnuBackM
Rect MnuPosX+MnuX(MnuActiv)+19,MnuPosY+Cnt*19+1,Xw-4,18,True
Color 0,0,MnuBorderM
Rect MnuPosX+MnuX(MnuActiv)+19,MnuPosY+Cnt*19+1,Xw-4,18,False
Color 0,0,MnuForeM
End If
If B$=" - " Then
Color 0,0,MnuBorderD
Line MnuPosX+MnuX(MnuActiv)+3,MnuPosY+Cnt*19+9,MnuPosX+MnuX(MnuActiv)+Xw+11,MnuPosY+Cnt*19+9
Color 0,0,MnuBorderH
Line MnuPosX+MnuX(MnuActiv)+3,MnuPosY+Cnt*19+10,MnuPosX+MnuX(MnuActiv)+Xw+11,MnuPosY+Cnt*19+10
Else
Text MnuPosX+MnuX(MnuActiv)+19,MnuPosY+Cnt*19+3,B$
End If
Next
End If
;--> wenn Maus gedrückt, schalte Submenüs wieder aus
If MHit Then MnuState=False: MHit=False
End Function
;==================================================================================================================
; Menü initialisieren (Daten des Menüs einlesen)
;==================================================================================================================
Function MnuInit()
Restore MnuData
Read Mnu$(0)
For I=1 To MnuCount(Mnu$(0)): Read Mnu$(I): Next
End Function
Function Mnu2Init()
Restore Mnu2Data
Read Mnu$(0)
For I=1 To MnuCount(Mnu$(0)): Read Mnu$(I): Next
End Function
;===================================================================================================================
; Hilfsroutine für Menü (Ermittelt die Anzahl der Einträge im String)
;===================================================================================================================
Function MnuCount(Count$)
For I=1 To Len(Count$)
If Mid$(Count$,I,1)="|" Then Cnt=Cnt+1
Next
Return Cnt
End Function
;========================================================================================================> Menüdaten
.MnuData
Data "Files|Bone|View|Mode|Settings|Help|"
Data "Open [ALt-O]|-|Quit [ESC]|"
Data "Add Bone [Alt+A]|Delete Bone [Alt+D]|-|Rename Bone [CTRL-N]|-|Set actual Vertex-Weight[V]|"
Data "Jump to active Bone [J]|Center View [C]|-|Wiredframe [W]|BackspaceCulling on/off [F]|"
Data "Anim-Mode [Tab]|-|Diff-Vertex-mode [K]|Next Vertex in Diff-List[L]|Set Diff-Vertex[ENTER]"
Data "bone-movespeed slow|bone-movespeed mid|bone-movespeed fast|-|Randomize Vertexes|Position Vertexes|"
Data "Help [F1]|"
.Mnu2Data
Data "Files|Frame|View|Mode|Settings|Sequences|Adjust|Help|"
Data "Save [Alt-S]|-|Quit [ESC]|"
Data "Play Animation[F4]|Stop Animation[F3]|Add Frame [A]|Insert-Frame [I]|-|Delete-Frame [D]|-|Restore active Bone|Restore active Frame|Restore all|-|Store active Bone|Store active Frame|Store all|-|Copy Frame|Paste Frame|"
Data "Jump to active Bone [J]|Center View [C]|-|Wiredframe [W]|BackspaceCulling on/off [F]|"
Data "Back to Edit-Mode [BS]|-|Rotation-mode [R]|Move-Mode [M]|Scale-Mode [S]|"
Data "slow rotate-speed|middle rotate-speed|fast rotate-speed|slow move-speed|middle move-speed|fast move-speed|slow scale-speed|middle scale-speed|fast scale-speed|"
Data "Mark new sequence start|Unmark sequence|"
Data "ChangeTexure|TextureFilter|TextureBlend|PositionTexture|RotateTexture|ScaleTexture|-|BrushBlend|BrushFX|BrushAlpha|BrushShininess"
Data "Help [F1]|"
;
;#End Region
|
| ||
| ; THIS IS keys.bb FILE, save them extra, do not paste at the end. ############################################################### ;German Keyboard Const KEY_1 = 2 Const KEY_2 = 3 Const KEY_3 = 4 Const KEY_4 = 5 Const KEY_5 = 6 Const KEY_6 = 7 Const KEY_7 = 8 Const KEY_8 = 9 Const KEY_9 = 10 Const KEY_0 = 11 Const KEY_Q = 16 Const KEY_W = 17 Const KEY_E = 18 Const KEY_R = 19 Const KEY_T = 20 Const KEY_Y = 21 Const KEY_U = 22 Const KEY_I = 23 Const KEY_O = 24 Const KEY_P = 25 Const KEY_A = 30 Const KEY_S = 31 Const KEY_D = 32 Const KEY_F = 33 Const KEY_G = 34 Const KEY_H = 35 Const KEY_J = 36 Const KEY_K = 37 Const KEY_L = 38 Const KEY_OE = 39 Const KEY_AE = 40 Const KEY_UE = 26 Const KEY_Z = 44 Const KEY_X = 45 Const KEY_C = 46 Const KEY_V = 47 Const KEY_B = 48 Const KEY_N = 49 Const KEY_M = 50 Const KEY_F1 = 59 Const KEY_F2 = 60 Const KEY_F3 = 61 Const KEY_F4 = 62 Const KEY_F5 = 63 Const KEY_F6 = 64 Const KEY_F7 = 65 Const KEY_F8 = 66 Const KEY_F9 = 67 Const KEY_F10 = 68 Const KEY_F11 = 87 Const KEY_F12 = 88 Const KEY_F13 = 100 Const KEY_F14 = 101 Const KEY_F15 = 102 Const KEY_NUMLOCK = 69 Const KEY_SCROLLLOCK = 70 Const KEY_NUM_7 = 71 Const KEY_NUM_8 = 72 Const KEY_NUM_9 = 73 Const KEY_NUM_SUB = 74 Const KEY_NUM_MINUS = 74 Const KEY_NUM_4 = 75 Const KEY_NUM_5 = 76 Const KEY_NUM_6 = 77 Const KEY_NUM_PLUS = 78 Const KEY_NUM_ADD = 78 Const KEY_NUM_1 = 79 Const KEY_NUM_2 = 80 Const KEY_NUM_3 = 81 Const KEY_NUM_0 = 82 Const KEY_NUM_PERIOD = 83 Const KEY_NUM_EQUAL = 141 Const KEY_NUM_ENTER = 156 Const KEY_NUM_DIV = 181 Const KEY_NUM_MUL = 55 Const KEY_SYS_RQ = 183 Const KEY_PAUSE = 197 Const KEY_POS1 = 199 Const KEY_AUF = 200 Const KEY_UP = 200 Const KEY_BILD_AUF = 201 Const KEY_ENDE = 207 Const KEY_AB = 208 Const KEY_DOWN = 208 Const KEY_BILD_AB = 209 Const KEY_INSERT = 210 Const KEY_EINFUEGEN = 210 Const KEY_EING = 210 Const KEY_DELETE = 211 Const KEY_ENTFERNEN = 211 Const KEY_ENTF = 211 Const KEY_WINDOWS_LEFT = 219 Const KEY_WINDOWS_RIGHT = 220 Const KEY_LINKS = 203 Const KEY_RECHTS = 205 Const KEY_LEFT = 203 Const KEY_RIGHT = 205 Const KEY_SHIFT_LEFT = 42 Const KEY_SHIFT_LINKS = 42 Const KEY_CTRL_LEFT = 29 Const KEY_STRG_LINKS = 29 Const KEY_ALT_LEFT = 56 Const KEY_ALT_LINKS = 56 Const KEY_SHIFT_RIGHT = 54 Const KEY_SHIFT_RECHTS = 54 Const KEY_CTRL_RIGHT = 157 Const KEY_STRG_RECHTS = 157 Const KEY_ALT_RIGHT = 184 Const KEY_ALT_RECHTS = 184 Const KEY_ESC = 1 Const KEY_BACKSLASH = 12 Const KEY_ANFZ = 13 Const KEY_BACKSPACE = 14 Const KEY_BS = 14 Const KEY_TAB = 15 Const KEY_SPACE = 57 Const KEY_LEER = 57 Const KEY_LEERTASTE = 57 Const KEY_CAPS_LOCK = 58 Const KEY_COMMA = 51 Const KEY_PUNKT = 52 Const KEY_MINUS = 53 Const KEY_SUB = 53 Const KEY_ADD = 27 Const KEY_PLUS = 27 Const KEY_ENTER = 28 Const KEY_RETURN = 28 Const KEY_GRAD = 41 Const KEY_HOCH = 41 Const KEY_GITTER = 43 Const KEY_RAUTE = 43 Const KEY_FLOAT = 43 |
| ||
| LMAO. Are you done yet? :D |
| ||
| Yes ready, so the source is now available as long as the board exists, and I must not read the very long spam-filter report every day :) |
| ||
| Thanks for all your effort to bring this source to other users. I cut and paste all the code into a .bb file but when I tried to Run the program or Create an Executable I get the error ---> Function 'memorytobank' not found. Sorry to be a bother, but did I miss something? Or is there another include file needed? Thanks ;-) |
| ||
| Sorry, just caught the declarations necessary at the beginning of this forum. Thanks again for releasing the source code for other programmers to learn from. |
| ||
| Whats it do, and why would someone want it ? |
| ||
| AnimB3D |
Code Archives Forum