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 fileText 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