What's new

Smash Bros Melee Model Viewer Status

cooliscool

Nintendo Zealot
Wow, very nice. I'd love to look at your source, been working on a model loader for OoT (in VB) which decompresses on the fly. Given Nintendo's consistenscy, I'm sure a quick study of your code would help out tremendously. Don't get me wrong, I don't want to steal your code by any means. Just need something to study to put me on the right track. :)
 
Last edited:
OP
J

jahra!n

New member
Im very up for source sharing. Everything i created is done in visual basic 6 and i dont mind sharing my model decoding modules. Give me a few to clean up some of the code and comment it and il release the vb6 source once i get the chance. All that i ask to be done with the source code of anything i release is that app using any bit or reference from my source code is to be open sourced. If you can agree to that, do as you please with my code. ;)

EDIT:

Heres My Super module that i use for every game file reverse engineering project i take on. Just copy paste it into a new module into vb and its all fully usable ;) It has most of the needed functions to convert the hex data within a file to any representation you need the data in.

Code:
'******Jahrain's 3d Reverse Engineering Functions********
'The sources of most of this stuff comes from all over the net
'big thanks goes out to Yomamma for the low level Floating point
'from and to hex conversion functions.
'Please Share the source code to any applications using or
'referencing anything from this code
'       _____________    __  __  ____   ___   _____  ____   __
'      /____  ___/   |\ / /\/ /\/ _  \ /   |\/_  _/\/   |\ / /\
'      \___/ /\_/ /| ||/ /_/ / / /\/ |/ /| ||\/ /\\/ /| ||/ / /
'     __  / / // /_| |/ __  / / __¯ </ /_| ||/ / // / | |/ / /
'    |  \/ / // ___  / / / / / /\_| / ___  |/ /_// / /|   / /
'     \___/ //_/\__|/_/ /_/ /_/ //_/_/ __|/____//_/ / |__/ /
'      \__\/ \_\/  \\_\/\_\/\_\/ \_\_\/  \\____\\_\/  \__\/
'-Word art by Jahrain

'*****Instructions*******
'To use any of these functions, its simple
'just add this module to the project. and use this to open the file into the Global Hex Array.

'    Open "C:\My File.dat" For Binary As #1
'    ReDim ByteArray(0 To LOF(1) - 1) As Byte
'    Get 1, , ByteArray
'    Close #1

'Now any function in this can be used on any array number or offset in the file
'for example, if you want to read a Single Precision floating point number from
'the offset of 32
'just type this

'   text1.text = GetSingle(32)

'and this returns the float value of that offset in the opened file and displays it in the textbox

'Now happy reverse engineering :)


Public ByteArray() As Byte 'this is the global array of the
'Hex bytes in a file opened used in this module.

'These are common data types used to store information in models, animations etc...

Type Vector3d 'this is mainly for vertecies, normals etc...
x As Single
y As Single
Z As Single
End Type

Type Vector2d 'this is mainly for texture coords and other 2 dimentional vectors
U As Single
V As Single
End Type

Type Vector4d 'Although rarely used, this is for 4 dimentional data types such as quaternions which are used in bone orientation and animation
i As Single
j As Single
k As Single
W As Single
End Type

Type FaceIndex3d 'These are for storing Triangle Data for models
a As Integer
B As Integer
C As Integer
End Type

'These are more complex types used to hold lots of model data in groups and what not
Type MESH
'for storing model mesh data and hex offsets
MeshName As String
MeshOffset As Double

VertexCount As Long
INDEXCOUNT As Long

VTXBlock() As Vector3d
INDBlock() As FaceIndex3d
End Type

Type BM8
'you probably wont use this
BMOffset As Double
BMSize As Long
End Type
Type TGA
'or this either
TGAOffset As Double
TGAsize As Long
End Type


Public Function GetTag(Offset As Double) As String 'This Function returns a string of 4 Characters at any given offset.
'Certain file types identify blocks by 4 letter 'tags' so this may proove helpful.
    tmp1 = Chr$(ByteArray(Offset))
    tmp2 = Chr$(ByteArray(Offset + 1))
    tmp3 = Chr$(ByteArray(Offset + 2))
    tmp4 = Chr$(ByteArray(Offset + 3))
    
    GetTag = tmp1 & tmp2 & tmp3 & tmp4
    
End Function
Public Function GetLong(Offset As Double) As Double 'Returns a unsigned Long integer value from the specified offset in the global bytearray

    tmp1 = Hex(ByteArray(Offset))
    tmp2 = Hex(ByteArray(Offset + 1))
    tmp3 = Hex(ByteArray(Offset + 2))
    tmp4 = Hex(ByteArray(Offset + 3))
    If Len(tmp1) = 1 Then tmp1 = "0" & tmp1
    If Len(tmp2) = 1 Then tmp2 = "0" & tmp2
    If Len(tmp3) = 1 Then tmp3 = "0" & tmp3
    If Len(tmp4) = 1 Then tmp4 = "0" & tmp4
    
    GetLong = HexToDec(tmp4 & tmp3 & tmp2 & tmp1)
    
End Function
Public Function GetLongS(Offset As Double) As Double 'Returns a Endian Swapped unsigned Long integer value from the specified offset in the global bytearray
If Offset < UBound(ByteArray) Then
    tmp1 = Hex(ByteArray(Offset))
    tmp2 = Hex(ByteArray(Offset + 1))
    tmp3 = Hex(ByteArray(Offset + 2))
    tmp4 = Hex(ByteArray(Offset + 3))
    If Len(tmp1) = 1 Then tmp1 = "0" & tmp1
    If Len(tmp2) = 1 Then tmp2 = "0" & tmp2
    If Len(tmp3) = 1 Then tmp3 = "0" & tmp3
    If Len(tmp4) = 1 Then tmp4 = "0" & tmp4
    
    GetLongS = HexToDec(tmp1 & tmp2 & tmp3 & tmp4)
    Else
    GetLongS = 0
    End If
End Function
Public Function GetInt(Offset As Double) As Long 'Returns a unsigned short integer value from the specified offset in the global bytearray
    tmp1 = Hex(ByteArray(Offset))
    tmp2 = Hex(ByteArray(Offset + 1))

    If Len(tmp1) = 1 Then tmp1 = "0" & tmp1
    If Len(tmp2) = 1 Then tmp2 = "0" & tmp2

    
    GetInt = HexToDec(tmp2 & tmp1)
    
End Function
Public Function GetIntS(Offset As Double) As Long 'Returns a endian swapped unsigned short integer value from the specified offset in the global bytearray

    tmp1 = Hex(ByteArray(Offset))
    tmp2 = Hex(ByteArray(Offset + 1))

    If Len(tmp1) = 1 Then tmp1 = "0" & tmp1
    If Len(tmp2) = 1 Then tmp2 = "0" & tmp2

    
    GetIntS = HexToDec(tmp1 & tmp2)
    
End Function
Public Function GetByte(Offset As Double) As Long 'returns a unsigned Byte value from the specified offset
If Offset < UBound(ByteArray) Then
    tmp1 = Hex(ByteArray(Offset))


    If Len(tmp1) = 1 Then tmp1 = "0" & tmp1

    
    GetByte = HexToDec(tmp1)
    Else
     GetByte = 0
     End If
End Function
Public Function GetIntS1(Offset As Double) As Long 'same as GetIntS except it swaps bytes. example: reads A0 1F instead of 0A F1
    tmp1 = Hex(ByteArray(Offset))
    tmp2 = Hex(ByteArray(Offset + 1))
    If Len(tmp1) = 2 Then tmp1 = Mid(tmp1, 2, 1) & Mid(tmp1, 1, 1)
    If Len(tmp2) = 2 Then tmp2 = Mid(tmp2, 2, 1) & Mid(tmp2, 1, 1)

    If Len(tmp1) = 1 Then tmp1 = "0" & tmp1
    If Len(tmp2) = 1 Then tmp2 = "0" & tmp2

    tmp3 = tmp2 & tmp1

    
    GetIntS = CLng("&h" & tmp3)
End Function

Public Function IsTag(Offset As Double) As Boolean 'just a boolean to return if an offset is a specified 4 byte tag, add some to the long list of ifs to check ;)
If GetTag(Offset) = "MATE" Or GetTag(Offset) = "OBJM" Or GetTag(Offset) = "CNST" Or GetTag(Offset) = "TEXT" Or GetTag(Offset) = "LIGH" Or GetTag(Offset) = "MESH" Or GetTag(Offset) = "MORP" Or GetTag(Offset) = "MATA" Or GetTag(Offset) = "BLND" Or GetTag(Offset) = "FRAM" Or GetTag(Offset) = "ANIM" Or GetTag(Offset) = "FOG " Or GetTag(Offset) = "ENVL" Then
IsTag = True
Else
IsTag = False
End If


End Function

Private Function HexToDec(ByVal HexStr As String) As Double 'Low level hex to decimal conversion
Dim mult As Double
Dim DecNum As Double
Dim ch As String
Dim i As Integer
mult = 1
DecNum = 0
For i = Len(HexStr) To 1 Step -1
    ch = Mid(HexStr, i, 1)
    If (ch >= "0") And (ch <= "9") Then
        DecNum = DecNum + (Val(ch) * mult)
    Else
        If (ch >= "A") And (ch <= "F") Then
            DecNum = DecNum + ((Asc(ch) - Asc("A") + 10) * mult)
        Else
            If (ch >= "a") And (ch <= "f") Then
                DecNum = DecNum + ((Asc(ch) - Asc("a") + 10) * mult)
            Else
                HexToDec = 0
                Exit Function
            End If
        End If
    End If
    mult = mult * 16
Next i
HexToDec = DecNum
End Function

Public Function GetFSingleS(ByRef address As Double, Optional Scalar As Integer = 512) As Single 'This reads a 16bit Fixed decimal signed integer and devides it by the scalar to get the floating point value. This is commonly used in GameCube Models
Dim TmpInt As Long
TmpInt = GetIntS(address)
GetFSingleS = nSigned(TmpInt) / Scalar

End Function
Public Function GetSingle(ByRef address As Double) 'Returns a Single Point Precision Decimal number from the specified offset in the global hex array
tmph = ""
    For i = 0 To 3
        x = CStr(Hex(ByteArray(address + i)))
        If Len(x) = 1 Then x = "0" & x
        tmph = tmph & x
    Next i
    
       GetSingle = CSng(HaloFloat(CStr(tmph)))
End Function

Public Function GetSingleS(ByRef address As Double) 'Returns a Endian Swapped Single Point Precision Decimal number from the specified offset in the global hex array
tmph = ""
    For i = 3 To 0 Step -1
        x = CStr(Hex(ByteArray(address + i)))
        If Len(x) = 1 Then x = "0" & x
        tmph = tmph & x
    Next i
    
       GetSingleS = CDbl(HaloFloat(CStr(tmph)))
End Function






Private Function BinToDec(ByVal num As String) As String 'Converts a Binary string to Decimal
bins = num
tmp1 = InStr(1, bins, ".")
If tmp1 = 0 Then
 unman = bins
 man = ""
Else
 unman = Mid$(bins, 1, tmp1 - 1)
 man = Mid$(bins, tmp1 + 1)
End If
For i = 1 To Len(unman) - 1
 tmp2 = Mid$(unman, Len(unman) - i, 1)
 If tmp2 = 1 Then total = total + 2 ^ i
Next i
For i = 1 To Len(man)
 tmp2 = Mid$(man, i, 1)
 If tmp2 = 1 Then total = total + 2 ^ (i * -1)
Next i
If Right(unman, 1) = "1" Then total = total + 1
BinToDec = Str$(total)
End Function
Private Function HexToBin(ByVal hexy As String) As String
'Converts Hex to binary
For i = 1 To Len(hexy)
 chexy = Mid$(hexy, i, 1)
 
Select Case chexy
 Case "0"
 tmp1 = tmp1 + "0000"
 Case "1"
 tmp1 = tmp1 + "0001"
 Case "2"
 tmp1 = tmp1 + "0010"
 Case "3"
 tmp1 = tmp1 + "0011"
 Case "4"
 tmp1 = tmp1 + "0100"
 Case "5"
 tmp1 = tmp1 + "0101"
 Case "6"
 tmp1 = tmp1 + "0110"
 Case "7"
 tmp1 = tmp1 + "0111"
 Case "8"
 tmp1 = tmp1 + "1000"
 Case "9"
 tmp1 = tmp1 + "1001"
 Case "A"
 tmp1 = tmp1 + "1010"
 Case "B"
 tmp1 = tmp1 + "1011"
 Case "C"
 tmp1 = tmp1 + "1100"
 Case "D"
 tmp1 = tmp1 + "1101"
 Case "E"
 tmp1 = tmp1 + "1110"
 Case "F"
 tmp1 = tmp1 + "1111"
End Select

Next i

HexToBin = tmp1
End Function
Private Function HaloFloat(hexs As String) As Double
'Low level function to convert 4 byte hex strings into floats
For i = 1 To Len(hexs)
If Mid$(hexs, i, 1) <> "0" Then GoTo exitthiscrap
Next i
s = 0
GoTo endingskip

exitthiscrap:
For i = 1 To Len(hexs) Step 2
 tmp1 = Mid$(hexs, i, 2) + tmp1
Next i
tmp1 = HexToBin(tmp1)

'Split
sign = Mid$(tmp1, 1, 1)
exponent = Mid$(tmp1, 2, 8)
mantissa = Mid$(tmp1, 10, 23)

'Sign
If sign = "0" Then
 s = 1
Else
 s = -1
End If

'Exponent
e = Val(BinToDec(exponent)) - 127

'Mantissa
m = Val(BinToDec("1." + mantissa))

endingskip:
HaloFloat = s * m * (2 ^ e)
End Function
Private Function DecOfBin(ByVal num As String) As String
'Converts Binary string to decimal values
bins = num
tmp1 = InStr(1, bins, ".")
If tmp1 = 0 Then
 unman = bins
 man = ""
Else
 unman = Mid$(bins, 1, tmp1 - 1)
 man = Mid$(bins, tmp1 + 1)
End If
For i = 1 To Len(unman) - 1
 tmp2 = Mid$(unman, Len(unman) - i, 1)
 If tmp2 = 1 Then total = total + 2 ^ i
Next i
For i = 1 To Len(man)
 tmp2 = Mid$(man, i, 1)
 If tmp2 = 1 Then total = total + 2 ^ (i * -1)
Next i
If Right(unman, 1) = "1" Then total = total + 1
DecOfBin = Str$(total)
End Function

Private Function DecOfFloat(ByVal Float As String) As String
'Converts floating point string to decimal values
Dim sign, mantissa1, mantissa2, exponent As String

'If Left(Float, 1) = 1 Then sign = "-" Else sign = ""
If Left(Float, 1) = 1 Then sign = -1 Else sign = 1

exponent = Mid(Float, 2, 8)

exponent = DecOfBin(exponent)

exponent = (exponent - 127)

'mantissa1 = 1 & Mid(Float, 10, exponent)

'mantissa2 = Mid(Float, (10 + exponent), 32)

'mantissa1 = DecOfBin(mantissa1)
'mantissa2 = DecOfPointBin(mantissa2)

man2 = "1." + Mid$(Float, 10)
man1 = DecOfBin(man2)

DecOfFloat = sign * man1 * 2 ^ exponent

'DecOfFloat = sign & (Val(mantissa1) + Val(mantissa2))


End Function
Private Function BinOfDec(ByVal number As String, Optional length As Integer) As String

Dim d, B, L, wk, C

d = number
L = 0


If length = Empty Then
    Do
        If d Mod 2 Then B = "1" & B Else B = "0" & B
        d = d \ 2
    Loop Until d = 0
Else
    Do
        If d Mod 2 Then B = "1" & B Else B = "0" & B
        d = d \ 2
        L = L + 1
    Loop Until L = length
End If

If number < 0 And length = 8 Then GoTo TwosCompliment

GoTo BinAns

TwosCompliment:     'the binary is inverted and 1 is added, this is how minus numbers are represented in binary
    L = Len(B)
    d = 0
    C = 1
        For d = L To 1 Step -1
            wk = Mid(B, d, 1)
            
            If wk = 1 Then wk = 0 Else wk = 1   'inverse
            
            If wk = 1 And C = 1 Then            'add 1
                wk = 0
                C = 1
            ElseIf wk = 0 And C = 1 Then
                wk = 1
                C = 0
            ElseIf wk = 1 And C = 0 Then
                wk = 1
                C = 0
            ElseIf wk = 0 And C = 0 Then
                wk = 0
                C = 0
            End If
                        
            BinOfDec = BinOfDec & wk
                        
        Next d
  
Exit Function
BinAns:
BinOfDec = B

End Function

Private Function DefOfBin(ByVal number As String) As String

    Dim k%
    Dim L%
    Dim d&
    Dim B$

    B = CStr(number)
    L = Len(B)

    For k = 1 To L
        If Mid(B, k, 1) = "1" Then d = d + (2 ^ (L - k))
    Next

    DefOfBin = d

End Function
Public Function GetString(Offset As Double, Lenth As Long) As String
'Returns a string to a specified lenth from a specified offset
    For i = Offset To Offset + Lenth
    If ByteArray(i) = 0 Then GoTo endthisstring
    tmptext = tmptext & Chr$(ByteArray(i))
    Next i
endthisstring:
    GetString = tmptext
End Function
Public Function LoadString(Offset As Double) As String
'Returns a string from the specified offset, the lenth is detemined by when the reading runs into a '00' byte
p = Offset
tmpu = ""
taglenth = 0
r = 0
Dim TmpTxt As String

L = Offset
TmpTxt = ""


    Do
      TmpTxt = TmpTxt & Chr$(ByteArray(L))
    r = r + 1
    L = L + 1

    
    
    Loop Until ByteArray(L) = 0


LoadString = Left(TmpTxt, r - 1)
End Function

Public Function Get3dAngle(Quaternion As Vector4d, rad As Boolean) As Vector3d
'Converts a Quaternion 4 dimentional directional vector into eular 3d angle (yaw, pitch, roll)
Dim Scale3d As Double
Dim Pi As Double
Dim x As Double
Dim y As Double
Dim Z As Double
Dim q1 As Double
Dim q2 As Double
Dim q3 As Double
Dim q0 As Double
Dim tmp1 As Double
Dim tmp2 As Double

q1 = Round(Quaternion.i, 5)
q2 = Round(Quaternion.j, 5)
q3 = Round(Quaternion.k, 5)
q0 = Round(Quaternion.W, 5)
Pi = 3.14159265358979

tmp1 = (q0 ^ 2) + (q1 ^ 2) - (q2 ^ 2) - (q3 ^ 2)
tmp2 = (q0 ^ 2) - (q1 ^ 2) - (q2 ^ 2) + (q3 ^ 2)
If tmp1 = 0 Then
tmp1 = -1E-19
End If
If tmp2 = 0 Then
tmp2 = -1E-19
End If
   Z = Round(2 * ((q0 * q3) - (q1 * q2)) / tmp1, 5)
   y = Round(2 * ((q0 * q2) + (q1 * q3)), 5)
   x = Round(2 * ((q0 * q1) - (q2 * q3)) / tmp2, 5)
   
   If y > 1 Then y = 1
   If y < -1 Then y = -1
Get3dAngle.x = Atn(x)
Get3dAngle.y = ASin(y)
Get3dAngle.Z = Atn(Z)




End Function


Public Function OBJVertStr(VertexCoords() As Vector3d, VertexCount As Long) As String
'For logging an array of vertex coords into the format for the .OBJ file format
    Dim TmpTxt() As String
    ReDim TmpTxt(0 To VertexCount - 1)
    
    For i = 0 To VertexCount - 1
        TmpTxt(i) = "v " & VertexCoords(i).x & " " & VertexCoords(i).y & " " & VertexCoords(i).Z
    Next i

    OBJVertStr = Join(TmpTxt, vbCrLf)
End Function
Public Function OBJNormStr(VertexCoords() As Vector3d, NormalCount As Long) As String
'For logging an array of vertex normals into the format for the .OBJ file format
    Dim TmpTxt() As String
    ReDim TmpTxt(0 To NormalCount - 1)
    
    For i = 0 To NormalCount - 1
        TmpTxt(i) = "vn " & VertexCoords(i).x & " " & VertexCoords(i).y & " " & VertexCoords(i).Z
    Next i

    OBJNormStr = Join(TmpTxt, vbCrLf)
End Function
Public Function OBJUVStr(VertexCoords() As Vector2d, UVCount As Long) As String
'For logging an array of UVs into the format for the .OBJ file format
    Dim TmpTxt() As String
    ReDim TmpTxt(0 To UVCount - 1)
    
    For i = 0 To UVCount - 1
        TmpTxt(i) = "vt " & VertexCoords(i).U & " " & VertexCoords(i).V
    Next i

    OBJUVStr = Join(TmpTxt, vbCrLf)
End Function

Public Function nSigned(ByVal lUnsignedInt As Long) As Integer
'Converts an unsigned Integer into a signed integer
  Dim nReturnVal As Integer   ' Return value from Function

  If lUnsignedInt > 65535 Or lUnsignedInt < 0 Then
    Debug.Print "Error in conversion from Unsigned to nSigned Integer"
    nSigned = 0
    Exit Function
  End If

  If lUnsignedInt > 32767 Then
    nReturnVal = lUnsignedInt - 65536
  Else
    nReturnVal = lUnsignedInt
  End If

  nSigned = nReturnVal

End Function
Public Function IsSingle(address As Double, Optional UpperBound As Double = 100000000, Optional LowerBound As Double = 0.00000001) As Boolean
  'a very usefull function to test for possible floating point digits
    If GetSingle(address) ^ 2 < UpperBound And GetSingle(address) ^ 2 > LowerBound Then
    IsSingle = True
    Else
    IsSingle = False
    End If
    
End Function
Public Function IsSingleS(address As Double, Optional UpperBound As Double = 100000000, Optional LowerBound As Double = 0.00000001) As Boolean
  'a very usefull function to test for endian swapped possible floating point digits
    If GetSingleS(address) ^ 2 < UpperBound And GetSingleS(address) ^ 2 > LowerBound Then
    IsSingleS = True
    Else
    IsSingleS = False
    End If
End Function
 
Last edited:

BlueFalcon7

New member
wow! and this was done with visual basic? i learned a little bit of visual basic, but i quit learning it, i must have underestimated visual basic (im going strait to C++)
 

cooliscool

Nintendo Zealot
Thanks a lot for the module Jahrain. I ported it to VB 2005 Express (automatic upgrade didn't work for it completely), and it seems to work fine.. it's a HUGE help, thank you VERY much! :flowers:

Here's the VB Express version, hope ya don't mind.

Code:
Module Reverse_Engineer
    'Written by Jahrain for VB6, ported to VB 2005 Express by cooliscool. 
    'Thanks Jahrain!

    '===============

    'Start:

    Public ByteArray() As Byte 'this is the global array of the
    'Hex bytes in a file opened used in this module.

    'These are common data types used to store information in models, animations etc...

    Structure Vector3d 'this is mainly for vertecies, normals etc...
        Dim x As Single
        Dim y As Single
        Dim Z As Single
    End Structure

    Structure Vector2d 'this is mainly for texture coords and other 2 dimentional vectors
        Dim U As Single
        Dim V As Single
    End Structure

    Structure Vector4d 'Although rarely used, this is for 4 dimentional data types such as quaternions which are used in bone orientation and animation
        Dim i As Single
        Dim j As Single
        Dim k As Single
        Dim W As Single
    End Structure

    Structure FaceIndex3d 'These are for storing Triangle Data for models
        Dim a As Short
        Dim B As Short
        Dim C As Short
    End Structure

    'These are more complex types used to hold lots of model data in groups and what not
    Structure MESH
        'for storing model mesh data and hex offsets
        Dim MeshName As String
        Dim MeshOffset As Double
        Dim VertexCount As Integer
        Dim INDEXCOUNT As Integer
        Dim VTXBlock() As Vector3d
        Dim INDBlock() As FaceIndex3d
    End Structure

    Structure BM8
        'you probably wont use this
        Dim BMOffset As Double
        Dim BMSize As Integer
    End Structure
    Structure TGA
        'or this either
        Dim TGAOffset As Double
        Dim TGAsize As Integer
    End Structure


    Public Function GetTag(ByRef Offset As Double) As String
        Dim tmp4 As Object
        Dim tmp3 As Object
        Dim tmp2 As Object
        Dim tmp1 As Object 'This Function returns a string of 4 Characters at any given offset.
        'Certain file types identify blocks by 4 letter 'tags' so this may proove helpful.
        tmp1 = Chr(ByteArray(Offset))
        tmp2 = Chr(ByteArray(Offset + 1))
        tmp3 = Chr(ByteArray(Offset + 2))
        tmp4 = Chr(ByteArray(Offset + 3))
        GetTag = tmp1 & tmp2 & tmp3 & tmp4
    End Function
    Public Function GetLong(ByRef Offset As Double) As Double
        Dim tmp4 As Object
        Dim tmp3 As Object
        Dim tmp2 As Object
        Dim tmp1 As Object 'Returns a unsigned Long integer value from the specified offset in the global bytearray
        tmp1 = Hex(ByteArray(Offset))
        tmp2 = Hex(ByteArray(Offset + 1))
        tmp3 = Hex(ByteArray(Offset + 2))
        tmp4 = Hex(ByteArray(Offset + 3))
        If Len(tmp1) = 1 Then tmp1 = "0" & tmp1
        If Len(tmp2) = 1 Then tmp2 = "0" & tmp2
        If Len(tmp3) = 1 Then tmp3 = "0" & tmp3
        If Len(tmp4) = 1 Then tmp4 = "0" & tmp4
        GetLong = HexToDec(tmp4 & tmp3 & tmp2 & tmp1)

    End Function
    Public Function GetLongS(ByRef Offset As Double) As Double
        Dim tmp4 As Object
        Dim tmp3 As Object
        Dim tmp2 As Object
        Dim tmp1 As Object 'Returns a Endian Swapped unsigned Long integer value from the specified offset in the global bytearray
        If Offset < UBound(ByteArray) Then
            tmp1 = Hex(ByteArray(Offset))
            tmp2 = Hex(ByteArray(Offset + 1))
            tmp3 = Hex(ByteArray(Offset + 2))
            tmp4 = Hex(ByteArray(Offset + 3))
            If Len(tmp1) = 1 Then tmp1 = "0" & tmp1
            If Len(tmp2) = 1 Then tmp2 = "0" & tmp2
            If Len(tmp3) = 1 Then tmp3 = "0" & tmp3
            If Len(tmp4) = 1 Then tmp4 = "0" & tmp4
            GetLongS = HexToDec(tmp1 & tmp2 & tmp3 & tmp4)
        Else
            GetLongS = 0
        End If
    End Function
    Public Function GetInt(ByRef Offset As Double) As Integer
        Dim tmp2 As Object
        Dim tmp1 As Object 'Returns a unsigned short integer value from the specified offset in the global bytearray
        tmp1 = Hex(ByteArray(Offset))
        tmp2 = Hex(ByteArray(Offset + 1))
        If Len(tmp1) = 1 Then tmp1 = "0" & tmp1
        If Len(tmp2) = 1 Then tmp2 = "0" & tmp2
        GetInt = HexToDec(tmp2 & tmp1)

    End Function
    Public Function GetIntS(ByRef Offset As Double) As Integer
        Dim tmp2 As Object
        Dim tmp1 As Object 'Returns a endian swapped unsigned short integer value from the specified offset in the global bytearray
        tmp1 = Hex(ByteArray(Offset))
        tmp2 = Hex(ByteArray(Offset + 1))
        If Len(tmp1) = 1 Then tmp1 = "0" & tmp1
        If Len(tmp2) = 1 Then tmp2 = "0" & tmp2
        GetIntS = HexToDec(tmp1 & tmp2)
    End Function
    Public Function GetByte(ByRef Offset As Double) As Integer
        Dim tmp1 As Object 'returns a unsigned Byte value from the specified offset
        If Offset < UBound(ByteArray) Then
            tmp1 = Hex(ByteArray(Offset))
            If Len(tmp1) = 1 Then tmp1 = "0" & tmp1
            GetByte = HexToDec(tmp1)
        Else
            GetByte = 0
        End If
    End Function
    Public Function GetIntS1(ByRef Offset As Double) As Integer
        Dim tmp3 As Object
        Dim tmp2 As Object
        Dim tmp1 As Object 'same as GetIntS except it swaps bytes. example: reads A0 1F instead of 0A F1
        tmp1 = Hex(ByteArray(Offset))
        tmp2 = Hex(ByteArray(Offset + 1))
        If Len(tmp1) = 2 Then tmp1 = Mid(tmp1, 2, 1) & Mid(tmp1, 1, 1)
        If Len(tmp2) = 2 Then tmp2 = Mid(tmp2, 2, 1) & Mid(tmp2, 1, 1)
        If Len(tmp1) = 1 Then tmp1 = "0" & tmp1
        If Len(tmp2) = 1 Then tmp2 = "0" & tmp2
        tmp3 = tmp2 & tmp1
        Dim GetIntS = CInt("&h" & tmp3)
    End Function

    Public Function IsTag(ByRef Offset As Double) As Boolean 'just a boolean to return if an offset is a specified 4 byte tag, add some to the long list of ifs to check ;)
        If GetTag(Offset) = "MATE" Or GetTag(Offset) = "OBJM" Or GetTag(Offset) = "CNST" Or GetTag(Offset) = "TEXT" Or GetTag(Offset) = "LIGH" Or GetTag(Offset) = "MESH" Or GetTag(Offset) = "MORP" Or GetTag(Offset) = "MATA" Or GetTag(Offset) = "BLND" Or GetTag(Offset) = "FRAM" Or GetTag(Offset) = "ANIM" Or GetTag(Offset) = "FOG " Or GetTag(Offset) = "ENVL" Then
            IsTag = True
        Else
            IsTag = False
        End If


    End Function

    Private Function HexToDec(ByVal HexStr As String) As Double 'Low level hex to decimal conversion
        Dim mult As Double
        Dim DecNum As Double
        Dim ch As String
        Dim i As Short
        mult = 1
        DecNum = 0
        For i = Len(HexStr) To 1 Step -1
            ch = Mid(HexStr, i, 1)
            If (ch >= "0") And (ch <= "9") Then
                DecNum = DecNum + (Val(ch) * mult)
            Else
                If (ch >= "A") And (ch <= "F") Then
                    DecNum = DecNum + ((Asc(ch) - Asc("A") + 10) * mult)
                Else
                    If (ch >= "a") And (ch <= "f") Then
                        DecNum = DecNum + ((Asc(ch) - Asc("a") + 10) * mult)
                    Else
                        HexToDec = 0
                        Exit Function
                    End If
                End If
            End If
            mult = mult * 16
        Next i
        HexToDec = DecNum
    End Function

    Public Function GetFSingleS(ByRef address As Double, Optional ByRef Scalar As Short = 512) As Single 'This reads a 16bit Fixed decimal signed integer and devides it by the scalar to get the floating point value. This is commonly used in GameCube Models
        Dim TmpInt As Integer
        TmpInt = GetIntS(address)
        GetFSingleS = nSigned(TmpInt) / Scalar

    End Function
    Public Function GetSingle(ByRef address As Double) As Object
        Dim x As Object
        Dim i As Object
        Dim tmph As Object 'Returns a Single Point Precision Decimal number from the specified offset in the global hex array
        tmph = ""
        For i = 0 To 3
            x = CStr(Hex(ByteArray(address + i)))
            If Len(x) = 1 Then x = "0" & x
            tmph = tmph & x
        Next i
        GetSingle = CSng(HaloFloat(CStr(tmph)))
    End Function

    Public Function GetSingleS(ByRef address As Double) As Object
        Dim x As Object
        Dim i As Object
        Dim tmph As Object 'Returns a Endian Swapped Single Point Precision Decimal number from the specified offset in the global hex array
        tmph = ""
        For i = 3 To 0 Step -1
            x = CStr(Hex(ByteArray(address + i)))
            If Len(x) = 1 Then x = "0" & x
            tmph = tmph & x
        Next i
        GetSingleS = CDbl(HaloFloat(CStr(tmph)))
    End Function






    Private Function BinToDec(ByVal num As String) As String
        Dim total As Object
        Dim tmp2 As Object
        Dim i As Object
        Dim man As Object
        Dim unman As Object
        Dim tmp1 As Object
        Dim bins As Object 'Converts a Binary string to Decimal
        bins = num
        tmp1 = InStr(1, bins, ".")
        If tmp1 = 0 Then
            unman = bins
            man = ""
        Else
            unman = Mid(bins, 1, tmp1 - 1)
            man = Mid(bins, tmp1 + 1)
        End If
        For i = 1 To Len(unman) - 1
            tmp2 = Mid(unman, Len(unman) - i, 1)
            If tmp2 = 1 Then total = total + 2 ^ i
        Next i
        For i = 1 To Len(man)
            tmp2 = Mid(man, i, 1)
            If tmp2 = 1 Then total = total + 2 ^ (i * -1)
        Next i
        If Right(unman, 1) = "1" Then total = total + 1
        BinToDec = Str(total)
    End Function
    Private Function HexToBin(ByVal hexy As String) As String
        Dim tmp1 As Object
        Dim chexy As Object
        Dim i As Object
        'Converts Hex to binary
        For i = 1 To Len(hexy)
            chexy = Mid(hexy, i, 1)

            Select Case chexy
                Case "0"
                    tmp1 = tmp1 + "0000"
                Case "1"
                    tmp1 = tmp1 + "0001"
                Case "2"
                    tmp1 = tmp1 + "0010"
                Case "3"
                    tmp1 = tmp1 + "0011"
                Case "4"
                    tmp1 = tmp1 + "0100"
                Case "5"
                    tmp1 = tmp1 + "0101"
                Case "6"
                    tmp1 = tmp1 + "0110"
                Case "7"
                    tmp1 = tmp1 + "0111"
                Case "8"
                    tmp1 = tmp1 + "1000"
                Case "9"
                    tmp1 = tmp1 + "1001"
                Case "A"
                    tmp1 = tmp1 + "1010"
                Case "B"
                    tmp1 = tmp1 + "1011"
                Case "C"
                    tmp1 = tmp1 + "1100"
                Case "D"
                    tmp1 = tmp1 + "1101"
                Case "E"
                    tmp1 = tmp1 + "1110"
                Case "F"
                    tmp1 = tmp1 + "1111"
            End Select

        Next i

        HexToBin = tmp1
    End Function
    Private Function HaloFloat(ByRef hexs As String) As Double
        Dim m As Object
        Dim e As Object
        Dim mantissa As Object
        Dim exponent As Object
        Dim sign As Object
        Dim tmp1 As Object
        Dim s As Object
        Dim i As Object
        'Low level function to convert 4 byte hex strings into floats
        For i = 1 To Len(hexs)
            If Mid(hexs, i, 1) <> "0" Then GoTo exitthiscrap
        Next i
        s = 0
        GoTo endingskip

exitthiscrap:
        For i = 1 To Len(hexs) Step 2
            tmp1 = Mid(hexs, i, 2) + tmp1
        Next i
        tmp1 = HexToBin(tmp1)

        'Split
        sign = Mid(tmp1, 1, 1)
        exponent = Mid(tmp1, 2, 8)
        mantissa = Mid(tmp1, 10, 23)

        'Sign
        If sign = "0" Then
            s = 1
        Else
            s = -1
        End If

        'Exponent
        e = Val(BinToDec(exponent)) - 127

        'Mantissa
        m = Val(BinToDec("1." + mantissa))

endingskip:
        HaloFloat = s * m * (2 ^ e)
    End Function
    Private Function DecOfBin(ByVal num As String) As String
        Dim total As Object
        Dim tmp2 As Object
        Dim i As Object
        Dim man As Object
        Dim unman As Object
        Dim tmp1 As Object
        Dim bins As Object
        'Converts Binary string to decimal values
        bins = num
        tmp1 = InStr(1, bins, ".")
        If tmp1 = 0 Then
            unman = bins
            man = ""
        Else
            unman = Mid(bins, 1, tmp1 - 1)
            man = Mid(bins, tmp1 + 1)
        End If
        For i = 1 To Len(unman) - 1
            tmp2 = Mid(unman, Len(unman) - i, 1)
            If tmp2 = 1 Then total = total + 2 ^ i
        Next i
        For i = 1 To Len(man)
            tmp2 = Mid(man, i, 1)
            If tmp2 = 1 Then total = total + 2 ^ (i * -1)
        Next i
        If Right(unman, 1) = "1" Then total = total + 1
        DecOfBin = Str(total)
    End Function

    Private Function DecOfFloat(ByVal Float As String) As String
        Dim man1 As Object
        Dim man2 As Object
        'Converts floating point string to decimal values
        Dim mantissa1, sign, mantissa2 As Object
        Dim exponent As String

        'If Left(Float, 1) = 1 Then sign = "-" Else sign = ""
        If CDbl(Left(Float, 1)) = 1 Then
            sign = -1
        Else
            sign = 1
        End If

        exponent = Mid(Float, 2, 8)

        exponent = DecOfBin(exponent)

        exponent = CStr(CDbl(exponent) - 127)

        'mantissa1 = 1 & Mid(Float, 10, exponent)

        'mantissa2 = Mid(Float, (10 + exponent), 32)

        'mantissa1 = DecOfBin(mantissa1)
        'mantissa2 = DecOfPointBin(mantissa2)

        man2 = "1." & Mid(Float, 10)
        man1 = DecOfBin(man2)

        DecOfFloat = CStr(sign * man1 * 2 ^ CDbl(exponent))

        'DecOfFloat = sign & (Val(mantissa1) + Val(mantissa2))


    End Function
    Private Function BinOfDec(ByVal number As String, Optional ByRef length As Short = 0) As String

        Dim wk, B, d, L, C As Object
        d = number
        L = 0
        If IsNothing(length) Then
            Do
                If d Mod 2 Then
                    B = "1" & B
                Else
                    B = "0" & B
                End If
                d = d \ 2
            Loop Until d = 0
        Else
            Do
                If d Mod 2 Then
                    B = "1" & B
                Else
                    B = "0" & B
                End If
                d = d \ 2
                L = L + 1
            Loop Until L = length
        End If

        If CDbl(number) < 0 And length = 8 Then GoTo TwosCompliment

        GoTo BinAns

TwosCompliment:  'the binary is inverted and 1 is added, this is how minus numbers are represented in binary
        L = Len(B)
        d = 0
        C = 1
        For d = L To 1 Step -1
            wk = Mid(B, d, 1)
            If wk = 1 Then
                wk = 0
            Else
                wk = 1
            End If 'inverse
            If wk = 1 And C = 1 Then 'add 1
                wk = 0
                C = 1
            ElseIf wk = 0 And C = 1 Then
                wk = 1
                C = 0
            ElseIf wk = 1 And C = 0 Then
                wk = 1
                C = 0
            ElseIf wk = 0 And C = 0 Then
                wk = 0
                C = 0
            End If
            BinOfDec = BinOfDec & wk

        Next d

BinAns:
        BinOfDec = B

    End Function

    Private Function DefOfBin(ByVal number As String) As String

        Dim k As Short
        Dim L As Short
        Dim d As Integer
        Dim B As String

        B = CStr(number)
        L = Len(B)

        For k = 1 To L
            If Mid(B, k, 1) = "1" Then d = d + (2 ^ (L - k))
        Next

        DefOfBin = CStr(d)

    End Function
    Public Function GetString(ByRef Offset As Double, ByRef Lenth As Integer) As String
        Dim tmptext As Object
        Dim i As Object
        'Returns a string to a specified lenth from a specified offset
        For i = Offset To Offset + Lenth
            If ByteArray(i) = 0 Then GoTo endthisstring
            tmptext = tmptext & Chr(ByteArray(i))
        Next i
endthisstring:
        GetString = tmptext
    End Function
    Public Function LoadString(ByRef Offset As Double) As String
        Dim L As Object
        Dim r As Object
        Dim taglenth As Object
        Dim tmpu As Object
        Dim p As Object
        'Returns a string from the specified offset, the lenth is detemined by when the reading runs into a '00' byte
        p = Offset
        tmpu = ""
        taglenth = 0
        r = 0
        Dim TmpTxt As String
        L = Offset
        TmpTxt = ""


        Do
            TmpTxt = TmpTxt & Chr(ByteArray(L))
            r = r + 1
            L = L + 1
        Loop Until ByteArray(L) = 0
        LoadString = Left(TmpTxt, r - 1)
    End Function

    Public Function Get3dAngle(ByRef Quaternion As Vector4d, ByRef rad As Boolean) As Vector3d
        Dim ASin As Object
        'Converts a Quaternion 4 dimentional directional vector into eular 3d angle (yaw, pitch, roll)
        Dim Scale3d As Double
        Dim Pi As Double
        Dim x As Double
        Dim y As Double
        Dim Z As Double
        Dim q1 As Double
        Dim q2 As Double
        Dim q3 As Double
        Dim q0 As Double
        Dim tmp1 As Double
        Dim tmp2 As Double
        q1 = System.Math.Round(Quaternion.i, 5)
        q2 = System.Math.Round(Quaternion.j, 5)
        q3 = System.Math.Round(Quaternion.k, 5)
        q0 = System.Math.Round(Quaternion.W, 5)
        Pi = 3.14159265358979
        tmp1 = (q0 ^ 2) + (q1 ^ 2) - (q2 ^ 2) - (q3 ^ 2)
        tmp2 = (q0 ^ 2) - (q1 ^ 2) - (q2 ^ 2) + (q3 ^ 2)
        If tmp1 = 0 Then
            tmp1 = -1.0E-19
        End If
        If tmp2 = 0 Then
            tmp2 = -1.0E-19
        End If
        Z = System.Math.Round(2 * ((q0 * q3) - (q1 * q2)) / tmp1, 5)
        y = System.Math.Round(2 * ((q0 * q2) + (q1 * q3)), 5)
        x = System.Math.Round(2 * ((q0 * q1) - (q2 * q3)) / tmp2, 5)
        If y > 1 Then y = 1
        If y < -1 Then y = -1
        Get3dAngle.x = System.Math.Atan(x)
        Get3dAngle.y = ASin(y)
        Get3dAngle.Z = System.Math.Atan(Z)
    End Function


    Public Function OBJVertStr(ByRef VertexCoords() As Vector3d, ByRef VertexCount As Integer) As String
        Dim i As Object
        'For logging an array of vertex coords into the format for the .OBJ file format
        Dim TmpTxt() As String
        ReDim TmpTxt(VertexCount - 1)
        For i = 0 To VertexCount - 1
            TmpTxt(i) = "v " & VertexCoords(i).x & " " & VertexCoords(i).y & " " & VertexCoords(i).Z
        Next i
        OBJVertStr = Join(TmpTxt, vbCrLf)
    End Function
    Public Function OBJNormStr(ByRef VertexCoords() As Vector3d, ByRef NormalCount As Integer) As String
        Dim i As Object
        'For logging an array of vertex normals into the format for the .OBJ file format
        Dim TmpTxt() As String
        ReDim TmpTxt(NormalCount - 1)

        For i = 0 To NormalCount - 1
            TmpTxt(i) = "vn " & VertexCoords(i).x & " " & VertexCoords(i).y & " " & VertexCoords(i).Z
        Next i

        OBJNormStr = Join(TmpTxt, vbCrLf)
    End Function
    Public Function OBJUVStr(ByRef VertexCoords() As Vector2d, ByRef UVCount As Integer) As String
        Dim i As Object
        'For logging an array of UVs into the format for the .OBJ file format
        Dim TmpTxt() As String
        ReDim TmpTxt(UVCount - 1)

        For i = 0 To UVCount - 1
            TmpTxt(i) = "vt " & VertexCoords(i).U & " " & VertexCoords(i).V
        Next i

        OBJUVStr = Join(TmpTxt, vbCrLf)
    End Function

    Public Function nSigned(ByVal lUnsignedInt As Integer) As Short
        'Converts an unsigned Integer into a signed integer
        Dim nReturnVal As Short ' Return value from Function

        If lUnsignedInt > 65535 Or lUnsignedInt < 0 Then
            Debug.Print("Error in conversion from Unsigned to nSigned Integer")
            nSigned = 0
            Exit Function
        End If

        If lUnsignedInt > 32767 Then
            nReturnVal = lUnsignedInt - 65536
        Else
            nReturnVal = lUnsignedInt
        End If

        nSigned = nReturnVal

    End Function
    Public Function IsSingle(ByRef address As Double, Optional ByRef UpperBound As Double = 100000000, Optional ByRef LowerBound As Double = 0.00000001) As Boolean
        'a very usefull function to test for possible floating point digits
        If GetSingle(address) ^ 2 < UpperBound And GetSingle(address) ^ 2 > LowerBound Then
            IsSingle = True
        Else
            IsSingle = False
        End If

    End Function
    Public Function IsSingleS(ByRef address As Double, Optional ByRef UpperBound As Double = 100000000, Optional ByRef LowerBound As Double = 0.00000001) As Boolean
        'a very usefull function to test for endian swapped possible floating point digits
        If GetSingleS(address) ^ 2 < UpperBound And GetSingleS(address) ^ 2 > LowerBound Then
            IsSingleS = True
        Else
            IsSingleS = False
        End If
    End Function
End Module
 
Last edited:

SarahHarp

New member
Jahrain is, to my knowledge, working on texture support.
And also, when he gets progress, he'll post it..
 

Nelde

New member
fantastic! where can i downoad it?

(btw, you aren't planning to export this models to ofb, are you?)
 
Last edited:

tio diego

New member
WOW!!..great work SarahHarp:drool:

mmm....could you upload the program?:whistling...I really NEED to see those models!
 

SarahHarp

New member
I will let Jahrain upload his program when he finishes, because he's the one who initially started to work on smash bros.

And exporting to OFB... what is that an acrynm for? Sims 2? Because if that's what your talking about, then yes, my plan was to upload Child/Adult Link and Zelda : ) .. Though I don't know how I'm going to get the eyes to work properly.. they are quite big compared to the actual modesl in that game.
 
Last edited:

Nelde

New member
yes, ofb is open for business. i saw it on your desktop and thought that you may be planning the same thing as me :D but i didn't want to make the zelda characters. and well, there are some tricks to expand the limitations of bodyshop, but you can't really break them.
 
Last edited:

SarahHarp

New member
Ah, well if I ever get around to completing the .package files, I'll let you know. (It's going to take a lot of work to prepare ssbm models for sims anyway, as that young link I showed earlier has 39 textures... so I have to drop it down to 3 (body, head, hair) then I have to adjust all the bone weights in milkshape.) But yeah
 

BlueFalcon7

New member
did you use Jhar!an's source for the viewer or did you just write it up on your own, you could PM jhar!an your work to help him out. Also, hows the CMDL viewer going? (Im not rushing you)
 

SarahHarp

New member
Jahrains code is in visual basic, which I cannot understand at all. Also, smash bros files are -very- similar to metroid primes files, Therefore, my smash bros viewer is 100% me.

My CMDL viewer, well I just recently fixed another problem where some model files store thier Normals in a compressed way, well I found a way to decompress them and now another large chunk of models are properly displayed (though, no textures are placed on yet, I just need to know which groups use what textures still, then it will be done)
 

Valant Novaligh

New member
Stunning! It wasn't until recently that I thought this was even possible. It so happens that VB6 is my favorite programming language, so I didn't hesitate to try your code, jahra!n.

Mariowire.gif

Mewtwowire.gif

EDIT: pictures not working right now

Too cool. So, I would like to try and create an SSBM model viewer as well.

So far, I understand how to get the vertices, but the triangle index, normals, and textures are a different story, and I'd greatly appreciate any kind of hint as to go about getting this information (if it's not too much trouble to ask).
 
Last edited:

BoggyB

New member
Wow, I thought I was the only one mad enough to do bit mangling in VB6. I've been working on textures and strings in Metroid Prime, but will take a look at SSBM.
 

Top