Collisions Box MiniTool für AnimMesh

Übersicht BlitzBasic Codearchiv

Neue Antwort erstellen

Markus2

Betreff: Collisions Box MiniTool für AnimMesh

 BeitragSa, Jul 17, 2004 23:54
Antworten mit Zitat
Benutzer-Profile anzeigen
Kleines Tool für Collision Sphere to Box und Pickmode .
Vielen von euch gehen die AnimMeshes bestimmt auch auf die Nerven .
Dieses kleine Programm lädt ein AnimMesh , also was ne Hirachie hat
und setzt dafür die CollisionsBox/Radius Parameter und man kann
diese dann speichern und wieder laden im Spiel .
Fürn Dateidialog hatte ich keine Lust , also die 3ds Namen muß man
selber angeben .
Bei komplexen Objekten wie z.B. Häuser oder auch nur Bäume
nimmt es eine Menge Arbeit ab !
Das Prog. erklärt sich von selbst ... Smile

BlitzBasic: [AUSKLAPPEN] 

.Top

;Collisions Editor   

;M.Rauch 17.07.2004

;Info zu Cinema 4D , bei der Objekt scalierung muß die größe 1,1,1 sein !

;-------------------------------------- Fenster

Graphics3D 800,600,16,2
SetBuffer BackBuffer()
AppTitle "Collisions Box Editor , M.Rauch"

;-------------------------------------- Kamera

Global cam=CreateCamera()
CameraClsColor cam,128,128,128
CameraRange cam,1,100000
PositionEntity cam,0,168,-1500
TurnEntity cam,10,0,0

;-------------------------------------- Kugel um Colli zu testen

Global eColliTest=CreateSphere(16)
ScaleMesh eColliTest,0.5,0.5,0.5
ScaleMesh eColliTest,50,50,50 ;Durchmesser
EntityAlpha eColliTest,1
EntityColor eColliTest,0,255,0
EntityFX eColliTest,1
EntityType eColliTest,1
EntityRadius eColliTest,25

;--------------------------------------

Type ColliType
 Field Entity
 Field Name$
 Field EType
 Field Pickmode
 Field BoxX# 
 Field BoxY# 
 Field BoxZ# 
 Field BoxW# 
 Field BoxH# 
 Field BoxD#
 Field Radius#
 Field x,y
End Type
Global Colli.ColliType

;-------------------------------------- Kugel Durchmesser 1

Global eSphere=CreateSphere(16)
ScaleMesh eSphere,0.5,0.5,0.5
EntityAlpha eSphere,0.5
EntityColor eSphere,255,255,0
EntityFX eSphere,1

;-------------------------------------- Würfel LBH 1x1x1

Global eCube=CreateCube()
ScaleMesh eCube,0.5,0.5,0.5
PositionMesh eCube,MeshWidth(eCube)/2.0,MeshWidth(eCube)/2.0,MeshDepth(eCube)/2.0
EntityAlpha eCube,0.5
EntityColor eCube,255,255,0
EntityFX eCube,1

;--------------------------------------

.Meshes

;fi$="Obj\Baum\Baum1"
;fi$="Obj\Haus\Haus1"
fi$="Obj\Inventar\Inventar1"
;fi$="Obj\Inventar\Inventar2"
;fi$="Obj\Test\Test"

ex$="3ds"
e=LoadAnimMesh(fi$+"."+ex$)
NameEntity e,"Root" ;<- wichtig zum wieder finden
EntityColli e ;Entity Hirachie in Types auflisten und Radius/Box setzen 

;ColliLoad(e,fi$+".cbb") ;zum testen die Parameter laden

;--------------------------------------

Collisions 1,2,3,2 ;Type 1 , mit 2 , Kugel zu Würfel , Slide

;--------------------------------------

.MainLoop

 ;MR 17.07.2004

While Not KeyHit(1)

 Local xColli.ColliType

 Local GoX#
 Local GoY#
 Local GoZ#

 If xColli=Null Then
  HideEntity eSphere
  HideEntity eCube
 Else
  ShowEntity eSphere
  ShowEntity eCube
  PositionEntity eSphere,EntityX(xColli\Entity,True),EntityY(xColli\Entity,True),EntityZ(xColli\Entity,True)
  PositionEntity eCube,EntityX(xColli\Entity,True),EntityY(xColli\Entity,True),EntityZ(xColli\Entity,True)
  RotateEntity eCube,EntityPitch(xColli\Entity,True),EntityYaw(xColli\Entity,True),EntityRoll(xColli\Entity,True)
  MoveEntity eCube,xColli\BoxX,xColli\BoxY,xColli\BoxZ

  ScaleEntity eSphere,xColli\Radius*2.0,xColli\Radius*2.0,xColli\Radius*2.0
  ScaleEntity eCube,xColli\BoxW,xColli\BoxH,xColli\BoxD,True
 EndIf

 If MouseHit(1) Then
  pe=CameraPick(cam,mx,my) 
  If pe Then
   PositionEntity eColliTest,EntityX(Cam),EntityY(Cam),EntityZ(Cam)
   PointEntity eColliTest,pe,0
   ResetEntity eColliTest
   GoX=PickedX()
   GoY=PickedY()
   GoZ=PickedZ()
  EndIf
  xColli=ColliFind(pe)  
 EndIf

 If EntityX(eColliTest)<>GoX Then MoveEntity eColliTest,-(EntityX(eColliTest)-GoX)/50.0,0,0
 If EntityY(eColliTest)<>GoY Then MoveEntity eColliTest,0,-(EntityY(eColliTest)-GoY)/50.0,0
 If EntityZ(eColliTest)<>GoZ Then MoveEntity eColliTest,0,0,-(EntityZ(eColliTest)-GoZ)/50.0

 UpdateWorld
 RenderWorld

 mx=MouseX()
 my=MouseY()

 If KeyDown(200) Then ;Cursor Hoch
  MoveEntity Cam,0,2,0
 EndIf

 If KeyDown(208) Then ;Cursor Runter
  MoveEntity Cam,0,-2,0
 EndIf

 If KeyDown(203) Then ;Cursor Links
  MoveEntity Cam,-2,0,0
 EndIf

 If KeyDown(205) Then ;Cursor Rechts
  MoveEntity Cam,2,0,0
 EndIf

 If KeyHit(201) Then ;Bild Hoch
  If xColli=Null Then
   xColli.ColliType=First ColliType
  Else
   xColli =Before xColli
  EndIf
 EndIf

 If KeyHit(209) Then ;Bild Runter
  If xColli=Null Then
   xColli.ColliType=Last ColliType
  Else
   xColli =After xColli
  EndIf
 EndIf

 If KeyHit(199) Then ;Pos1
  xColli.ColliType=First ColliType
 EndIf

 If KeyHit(207) Then ;Ende
  xColli.ColliType=Last ColliType
 EndIf

 If KeyHit(60) Then ;F2 Save
  ColliSave(fi$)
 EndIf

 If xColli<>Null Then
  Text 0,0,xColli\Name
  Text 0,20,PickModeName(xColli\Pickmode)
  If EntityClass(xColli\Entity)="Mesh" Then
   Text 0,40,"Surfaces "+CountSurfaces(xColli\Entity)
   Text 0,60,"Vertices "+CountAllVertices(xColli\Entity)
  EndIf
  Text 0,80,"F2 = '"+fi$+".cbb' Datei speichern"
  Text 0,100,"Box XxYxZ "+xColli\BoxX+" x "+xColli\BoxY+" x "+xColli\BoxZ
  Text 0,120,"Box WxHxD "+xColli\BoxW+" x "+xColli\BoxH+" x "+xColli\BoxD
 EndIf

 Text 0,GraphicsHeight()-20,"Benutze Pos1,Ende,Bild hoch/runter,Cursor Tasten,L Maus Taste,Esc=Ende"
 
 Delay 10

 Flip
Wend
End

;--------------------------------------

Function EntityColli(e)

 ;MR 17.07.2004

 ;Fügt alle Entitys in eine Type Collection ein

 If e=0 Then Return

 Colli.ColliType=New ColliType
 Colli\Entity=e 
 If EntityClass(e)="Mesh" And CountAllVertices(e)>0 Then
  EntityAlpha e,0.5
  If CountAllVertices(e)<=4 Then
   Colli\Pickmode=2 ;Poly
  Else
   Colli\Pickmode=3 ;Box
  EndIf
  Colli\EType=2
  SetBox(Colli)
  Colli\Radius=Sqr(MeshWidth(e)*MeshWidth(e)+MeshHeight(e)*MeshHeight(e)+MeshDepth(e)*MeshDepth(e)) 
  Colli\Radius=Colli\Radius/2.0
 Else
  Colli\Pickmode=0
  Colli\EType=0
  Colli\BoxX=EntityX(e)-0.5
  Colli\BoxY=EntityY(e)-0.5
  Colli\BoxZ=EntityZ(e)-0.5
  Colli\BoxW=1
  Colli\BoxH=1
  Colli\BoxD=1
  Colli\Radius=1
 EndIf

 EntityPickMode e,Colli\Pickmode
 EntityType e,Colli\EType
 EntityBox e,Colli\BoxX,Colli\BoxY,Colli\BoxZ,Colli\BoxW,Colli\BoxH,Colli\BoxD
 EntityRadius e,Colli\Radius

 Colli\Name=EntityName(e)

 Local i,c
 For i=1 To CountChildren(e)
  c=GetChild(e,i)
  EntityColli(c)
 Next

End Function

;--------------------------------------

Function PickModeName$(pm)

 ;MR 17.07.2004

 ;Übersetzung

 Select pm
 Case 0 :Return "kein"
 Case 1 :Return "Kugel"
 Case 2 :Return "Poly"
 Case 3 :Return "Box"
 End Select

End Function

;--------------------------------------

Function ColliFind.ColliType(e)

 ;MR 17.07.2004

 ;um vom Picked Entity den Type wieder zu finden

 For Colli.ColliType =Each ColliType
  If e=Colli\Entity Then Return Colli
 Next

End Function

;--------------------------------------

Function CountAllVertices(Entity)

 ;MR 17.07.2004

 ;Als Info anzeigen

 If Entity=0 Then Return 0

 Local i,s,c=0
 If CountSurfaces(Entity)>0 Then
  For i=1 To CountSurfaces(Entity)
   s=GetSurface(Entity,i)
   c=c+CountVertices(s)
  Next
 EndIf

 Return c

End Function

;--------------------------------------

Function SetBox(Colli.ColliType) 

 ;MR 17.07.2004

 ;Rechnet die Collisions Box aus

 Local Entity=Colli\Entity

 If Entity=0 Then Return 0

 ;----------------------------------- Find Mesh Min Max XYZ

 Local mx1#= 3.4*10^38,my1#= 3.4*10^38,mz1#= 3.4*10^38
 Local mx2#=-3.4*10^38,my2#=-3.4*10^38,mz2#=-3.4*10^38
 Local i,vi,s
 Local check=False

 If CountSurfaces(Entity)>0 Then
  For i=1 To CountSurfaces(Entity)
   s=GetSurface(Entity,i)
   If CountVertices(s)=>1 Then
    For vi = 0 To CountVertices(s)-1
     TFormVector VertexX(s,vi),VertexY(s,vi),VertexZ(s,vi),Entity,Entity
     vx=TFormedX()  
     vy=TFormedY()  
     vz=TFormedZ()  
     If VX<mx1 Then mx1=VX
     If VY<my1 Then my1=VY
     If VZ<mz1 Then mz1=VZ
     If VX>mx2 Then mx2=VX
     If VY>my2 Then my2=VY
     If VZ>mz2 Then mz2=VZ
     check=True
    Next
   EndIf ;Count Vert
  Next
 EndIf ;Count Surf

 If check=False Then Return 0

 ;-----------------------------------

 Local mw#,mh#,md#,xp#,yp#,zp#

 mw# = Abs(mx2-mx1)
 mh# = Abs(my2-my1)
 md# = Abs(mz2-mz1)

 Colli\BoxW=mw
 Colli\BoxH=mh
 Colli\BoxD=md
 If Colli\BoxW<1.0 Then Colli\BoxW=1.0
 If Colli\BoxH<1.0 Then Colli\BoxH=1.0
 If Colli\BoxD<1.0 Then Colli\BoxD=1.0
 Colli\BoxX=mx1
 Colli\BoxY=my1
 Colli\BoxZ=mz1

 Return 1
 
End Function

;--------------------------------------

Function ColliSave(fi$)

 ;MR 17.07.2004

 Local f$=fi$ + ".cbb"
 Local fh 

 Local c=0
 For Colli.ColliType =Each ColliType
  c=c+1
 Next

 fh=WriteFile(f$)
 If fh Then
  
  WriteLine  fh,"BlitzBasic3D Collisions Parameter"
  WriteLine  fh,"V1.0"
  WriteInt   fh,c

  For Colli.ColliType =Each ColliType
   WriteString fh,Colli\Name$
   WriteInt    fh,Colli\EType
   WriteInt    fh,Colli\Pickmode
   WriteFloat  fh,Colli\BoxX# 
   WriteFloat  fh,Colli\BoxY# 
   WriteFloat  fh,Colli\BoxZ# 
   WriteFloat  fh,Colli\BoxW# 
   WriteFloat  fh,Colli\BoxH# 
   WriteFloat  fh,Colli\BoxD#
   WriteFloat  fh,Colli\Radius#
  Next 

  CloseFile fh
 EndIf

End Function

;######################################################################################
; .cbb Collisions Parameter lader (Include Datei)
;######################################################################################

.IncludesCBB

Function ColliLoad(Entity,File$)

 ;MR 17.07.2004

 If Entity=0 Then
  DebugLog "ERR ColliLoad Entity=0 !?"
  Return 0
 EndIf

 If Len(File$)=0 Then
  DebugLog "ERR ColliLoad File$='' !?"
  Return 0
 EndIf

 NameEntity Entity,"Root"

 Local fh,c,i
 Local e
 Local eName$
 Local eType
 Local ePickMode
 Local eBoxX#
 Local eBoxY#
 Local eBoxZ#
 Local eBoxW#
 Local eBoxH#
 Local eBoxD#
 Local eRadius#

 fh=ReadFile(File)
 If fh Then
  
  DebugLog "ColliLoad read file "+File$
  Local h$=ReadLine(fh) ;Header Name
  Local v$=ReadLine(fh) ;Version
  DebugLog h$+" "+v$

  If v$="V1.0" Then
   c=ReadInt(fh)
   For i=1 To c
   
    eName$   =ReadString(fh)
    eType    =ReadInt(fh)
    ePickMode=ReadInt(fh)
    eBoxX    =ReadFloat(fh)
    eBoxY    =ReadFloat(fh)
    eBoxZ    =ReadFloat(fh)
    eBoxW    =ReadFloat(fh)
    eBoxH    =ReadFloat(fh)
    eBoxD    =ReadFloat(fh)
    eRadius  =ReadFloat(fh)

    e=EntityFindByName(Entity,eName$) 
    If e Then
     EntityPickMode e,ePickMode
     EntityType e,eType
     EntityBox e,eBoxX,eBoxY,eBoxZ,eBoxW,eBoxH,eBoxD
     EntityRadius e,eRadius
    Else 
     DebugLog "ERR ColliLoad Entity '"+eName$+"' konnte nicht zugeordnet werden !?
    EndIf ;Entity wieder gefunden
   Next ;Alle Blöcke lesen
  Else
   DebugLog "ERR ColliLoad this function are load only V1.0 .cbb files , you try to load version " +v$
  EndIf 

  CloseFile fh

  DebugLog "OK"
  Return 1
 Else
  DebugLog "ERR ColliLoad can't load file "+File$
 EndIf

 Return 0

End Function

;--------------------------------------

Function EntityFindByName(e,Name$)

 ;MR 17.07.2004

 ;Entity und alle Child Objekte durchsuchen :-)

 ;Recursive !

 Local ex=0

 If e=0 Then Return 0

 If EntityName(e)=Name$ Then Return e

 Local c,i
 For i=1 To CountChildren(e)
  c=GetChild(e,i) 
  ex=EntityFindByName(c,Name$)
  If ex Then Exit
 Next

 Return ex

End Function

;######################################################################################

Neue Antwort erstellen


Übersicht BlitzBasic Codearchiv

Nach Oben

Gehe zu:

Powered by phpBB © 2001 - 2006, phpBB Group