Imports WindowsApplication1.Form1
Imports WindowsApplication1.NJCM
Imports WindowsApplication1.VectorMath
Imports System.IO
Imports WindowsApplication1.Utility

Module Scanner

   Public MLD As NJCM.Model

   Public NodeId As Integer = 0

   Public Sub ScanModel(ByVal FileName As String)
      MLD = New NJCM.Model(FileName)
      Dim Keys As New Collection
      Dim tree As System.Windows.Forms.TreeNodeCollection
      Dim thisNode As New TreeNode(Strings.Mid(FileName, InStrRev(FileName, "\") + 1), 5, 4)

      Dim F1 As New Form
      F1.Width = 1208
      F1.Height = 1024
      F1.Text = "Exploring " & FileName
      F1.Enabled = True

      F1.Show()
      F1.Activate()

      Dim T1 As New TreeView
      T1.Parent = F1
      T1.Left = 4
      T1.Top = 4
      T1.Width = 1196
      T1.Height = 988
      T1.ImageList = Form1.ImageList1
      F1.Controls.Add(T1)

      'Form1.TV1.Nodes.Add(thisNode)
      tree = T1.Nodes

      Keys = MLD.FindKeys

      For I As Integer = 1 To Keys.Count
         MLD.lKey = CType(Keys.Item(I), UInteger)
         thisNode.Nodes.Add(Scan(MLD.lStream, MLD.lKey, 0))
      Next

      Dim Q As Integer = T1.Nodes.Add(thisNode)

      tree = T1.Nodes

      Application.DoEvents()
   End Sub
   Public Function Scan(ByVal ex As IO.ExBinaryReader, ByVal sp As UInteger, ByVal T As Integer) As TreeNode
      Dim N As New Types.Node
      ex.Seek(sp, System.IO.SeekOrigin.Begin)
      Dim C As UInteger = ex.Position
      Dim Ni As Integer = 2
      If T = 1 Then Ni = 7
      If T = 2 Then Ni = 6
      Dim retv As New TreeNode(HexOut(C), Ni, Ni)
      N = ex.ReadNode
      NodeId += 1
      retv.Nodes.Add(New TreeNode("Node ID   = " & NodeId.ToString))
      retv.Nodes.Add(New TreeNode("Flags     = " & HexOut(N.Flags)))
      retv.Nodes.Add(New TreeNode("Flag Data = " & ExpandFlags(N.Flags)))
      retv.Nodes.Add(New TreeNode("Translate = " & N.Translate.ToString))
      retv.Nodes.Add(New TreeNode("Rotate    = " & N.Rotate.ToString))
      retv.Nodes.Add(New TreeNode("Scale     = " & N.Scale.ToString))
      If N.Model <> 0 Then
         Dim M As New Types.Model
         ex.Seek(N.Model + MLD.lKey, System.IO.SeekOrigin.Begin)
         M = ex.ReadModel
         If M.Vertex <> 0 Then
            retv.Nodes.Add(ChunkScan(ex, MLD.lKey + M.Vertex))
         End If
         If M.Poly <> 0 Then
            retv.Nodes.Add(ChunkScan(ex, MLD.lKey + M.Poly))
         End If
      End If

      If N.Child <> 0 Then retv.Nodes.Add(Scan(ex, N.Child + MLD.lKey, 1))
      If N.Sibling <> 0 Then retv.Nodes.Add(Scan(ex, N.Sibling + MLD.lKey, 2))
      Return retv
   End Function
   Public Function ChunkScan(ByVal ex As IO.ExBinaryReader, ByVal sp As UInteger) As TreeNode

      Dim rp As UInteger = ex.Position
      Dim retv As New TreeNode("Chunk Data @ " & HexOut(sp), 2, 4)
      Dim C As New Types.Chunk
      Dim cl As UInteger = 0
        Dim cs As UInteger = 0
        Dim ci As UInteger = 0

      ex.Seek(sp, System.IO.SeekOrigin.Begin)

        Do
            ci = ex.Position
            C = ex.ReadChunk
            Select Case C.type
                Case &H0
                    retv.Nodes.Add(New TreeNode("NULL Chunk", 3, 3))
                Case &H1 To &H3
                    retv.Nodes.Add(New TreeNode("Unimplemented BITS Chunk (Type " & HexOut(C.type) & ")", 3, 3))
                Case &H4
                    retv.Nodes.Add(New TreeNode("Store re-entry point in " & Format(C.flag), 3, 3))
                Case &H5
                    retv.Nodes.Add(New TreeNode("Jump to re-entry point stored in " & Format(C.flag), 3, 3))
                Case &H8 To &H9
                    retv.Nodes.Add(New TreeNode("Texture Map Assignment", 3, 3))
                    cs = ex.ReadUInt16 And &H3FFF
                Case &H10 To &H17
                    cl = 2 * ex.ReadUInt16
                    retv.Nodes.Add(New TreeNode("Color assignment Chunk", 3, 3))
                    ex.Seek(cl, System.IO.SeekOrigin.Current)
                Case &H18 To &H1F
                    cl = 2 * ex.ReadUInt16
                    retv.Nodes.Add(New TreeNode("TEXDATA chunk", 3, 3))
                    ex.Seek(cl, System.IO.SeekOrigin.Current)
                Case &H20 To &H37
                    retv.Nodes.Add(VertScan(ex, C))
                Case &H38 To &H3A
                    cl = 2 * ex.ReadUInt16
                    retv.Nodes.Add(New TreeNode("Volume Chunk", 3, 3))
                    ex.Seek(cl, System.IO.SeekOrigin.Current)
                Case &H40 To &H4B
                    cl = 2 * ex.ReadUInt16
                    retv.Nodes.Add(New TreeNode("STRIPS Chunk", 3, 3))
                    ex.Seek(cl, System.IO.SeekOrigin.Current)
                Case &HFF
                    retv.Nodes.Add(New TreeNode("END Chunk", 3, 3))
                Case Else
                    retv.Nodes.Add(New TreeNode("Unimplemented Chunk (Loc = " & HexOut(ci) & " Type " & HexOut(C.type) & ")", 3, 3))
            End Select
        Loop Until C.type = &HFF
      ex.Seek(rp, System.IO.SeekOrigin.Begin)
      Return retv
   End Function
    Public Function VertScan(ByVal ex As IO.ExBinaryReader, ByVal LC As Types.Chunk) As TreeNode
        Dim retv As New TreeNode("Vertex Subchunk", 2, 4)
        Dim cl As UInteger = ex.ReadUInt16 'Length of Subchunk, in 4 byte increments
        Dim rp As UInteger = ex.Position
        Dim ib As UInteger = ex.ReadUInt16
        Dim vc As UInteger = ex.ReadUInt16

        Dim qs As String = "Type : " & HexOut(LC.type) & ", Buffer : " & HexOut(CType(LC.flag And &H3, Byte)) & ", Start : " & Format(ib) & ", Count : " & Format(vc)
        Dim qs2 As String = ""
        Dim qn As New TreeNode(qs, 3, 3)
        'Let's read some vertices and add them as a child to the sub-chunk node...
        Dim ft() As Byte = {3, 15, 1, 3, 3, 3, 3, 3, 3, 5, 13, 13, 13, 13, 13, 13, 3, 11, 11}
        Dim mb As Integer = LC.flag And &H3
        Dim fv As Integer = LC.type - &H20
        Dim rf() As Boolean = {BitTest(ft(fv), 0), BitTest(ft(fv), 1), BitTest(ft(fv), 2), BitTest(ft(fv), 3)}
        Dim I As Integer = ib
        Dim tv As New Types.Vertex

        Do
            If rf(0) Then tv.V = ex.ReadXYZ
            If rf(1) Then ex.ReadUInt32()
            If rf(2) Then tv.N = VectorMath.Normalize(ex.ReadXYZ)
            If rf(3) Then ex.ReadUInt32()
            tv.B = 0
            tv.I = I
            tv.F = False
            qs2 = "Vertex " & Format2(I, "###0") & " = " & tv.V.ToString2
            qn.Nodes.Add(New TreeNode(qs2, 8, 8))
            I += 1
            vc -= 1
        Loop Until vc = 0

        'Add the sub chunk node...
        retv.Nodes.Add(qn)
        ex.Seek(rp, System.IO.SeekOrigin.Begin)
        ex.Seek(cl * 4, System.IO.SeekOrigin.Current)
        Return retv
    End Function
    Public Function PolyScan(ByVal ex As IO.ExBinaryReader, ByVal sp As Integer, ByVal LC As Types.Chunk) As TreeNode
        Dim retv As New TreeNode("Triangle Strip Subchunk (Format = " & HexOut(LC.type) & ")", 9, 9)
        Dim cl As UInteger = ex.ReadUInt16 'Length of Subchunk, in 2 byte increments
        Dim rp As UInteger = ex.Position
        ex.Seek(rp, System.IO.SeekOrigin.Begin)
        ex.Seek(cl * 2, System.IO.SeekOrigin.Current)
        Return retv
    End Function
   Function ExpandFlags(ByVal F As Integer) As String
      Dim t As String = ""
        F = F And &H1FF
        t &= "Translate : " & MakeYN(Not BitTest(F, 0)) & ", "
        t &= "Rotate    : " & MakeYN(Not BitTest(F, 1)) & ", "
        t &= "Scale     : " & MakeYN(Not BitTest(F, 2)) & ", "
        t &= "Draw      : " & MakeYN(Not BitTest(F, 3)) & ", "
        t &= "Trace     : " & MakeYN(Not BitTest(F, 4)) & ", "
        t &= "LWO Order : " & MakeYN(BitTest(F, 5)) & ", "
        t &= "Skip      : " & MakeYN(BitTest(F, 6)) & ", "
        t &= "Shape Skip: " & MakeYN(BitTest(F, 7)) & ", "
        t &= "Clip      : " & MakeYN(BitTest(F, 8))
        
      Return t
   End Function
End Module
Module Multi
    Structure mdlkey
        Public mldtype As String
        Public mldaddr As UInteger
    End Structure

    Public MLD As NJCM.Model
    Private Function indexOf(ByVal toFind() As Byte, ByVal bytesArrayToSearch() As Byte, Optional ByVal startPosition As UInteger = 0) As Integer
        Dim tmp As Integer = -1
        Dim tst As Boolean = True
        Dim i As Integer = 0
        Dim il As Integer = toFind.GetUpperBound(0)
        Dim j As Integer = 0
        Dim jl As Integer = bytesArrayToSearch.GetUpperBound(0) - il
        i = 0
        For j = startPosition To jl
            If bytesArrayToSearch(j) = toFind(i) Then
                i += 1
                If i > il Then
                    tmp = j - il
                    Exit For
                End If
            Else
                i = 0
            End If
        Next
        Return tmp
    End Function

    Public Sub DoConversion(ByVal inputFilePath As String, ByVal outputFilePath As String, ByVal inMode As Integer, ByVal outMode As Integer, ByVal MS As Integer)
        Dim NJTLTAG() As Byte = MakeBytes("NJTL")
        Dim NJCMTAG() As Byte = MakeBytes("NJCM")
        Dim currentTag() As Byte
        Dim tagIndexes As New Collection
        Dim tag As New NJCM.Types.NJHeader
        Dim hdr As String = ""
        Dim tf As String = ""
        Dim txf As Boolean = False
        Dim startPosition As Integer = 0
        Dim tp As Integer = 0
        Dim ip As Integer = -1
        Dim fl As Boolean = True
        Dim previousPosition As Integer = 0

        Dim model As New NJCM.Model(inputFilePath, Val(MS))
        model.Trial = False
        model.ExportMode = 0


        If Form1.Verbosity Then WriteLn("Verbose Output Enabled.") Else WriteLn("Quiet Output Enabled.")
        WriteLn("Loading : " & inputFilePath)

        'Search for Tag NJTL (the magical number)
        startPosition = indexOf(NJTLTAG, model.lBuf, 0)

        'Seach for tag NJCM
        If startPosition = -1 And inMode = 1 Then startPosition = indexOf(NJCMTAG, model.lBuf, 0) : model.ExportMode = 1 'No Textures present
        currentTag = NJTLTAG
        fl = True

        ' Search index of all tag (NJTL abd NJCM) 
        Do Until startPosition = -1
            tagIndexes.Add(startPosition)
            'Switch Tags
            previousPosition = startPosition
            If fl Then
                fl = Not fl
                startPosition = indexOf(NJCMTAG, model.lBuf, previousPosition + 4)
                If startPosition = -1 Then
                    fl = Not fl
                    startPosition = indexOf(NJTLTAG, model.lBuf, previousPosition + 4)
                    If startPosition = -1 Then Exit Do
                End If
            Else
                fl = Not fl
                startPosition = indexOf(NJTLTAG, model.lBuf, previousPosition + 4)
                If startPosition = -1 Then
                    fl = Not fl
                    startPosition = indexOf(NJCMTAG, model.lBuf, previousPosition + 4)
                    If startPosition = -1 Then Exit Do
                End If
            End If
        Loop

        'tagIndexes variable is now populated with what we need.

        Dim textureFlag As Boolean = False
        Dim OFC As Integer = 1
        'Build the Master Texture List

        If inMode = 2 Then model.WriteTextures(inputFilePath, outputFilePath)

        Dim NumMdl As Integer = Int(tagIndexes.Count / 2 + 0.5)

        'Process the model or models in the file, iterating through tags found previously
        For tagIndex As Integer = 1 To tagIndexes.Count
            With model.lStream
                .Seek(tagIndexes(tagIndex), System.IO.SeekOrigin.Begin)
                tag = .ReadNJHeader
                Select Case tag.ID

                    'This is the "magical number" identifying Ninja file
                    Case Is = "NJTL"
                        textureFlag = True
                        model.isTextured = True
                        model.itl = model.NJTLProcess(.Position)    'Fixed textureNames reading
                        model.material = model.TEXTProcess(inMode)
                        model.GBIX = model.BuildGBIXIndex()

                        'The model definition is starting here in the file, after 'NJCM'
                    Case Is = "NJCM"
                        If NumMdl > 1 Then tf = Strings.Replace(outputFilePath, ".", "-" & Format(OFC) & ".") Else tf = outputFilePath
                        WriteLn("Reading Model @ " & HexOut(tagIndexes.Item(tagIndex)))
                        model.LOADProcess(tagIndexes.Item(tagIndex) + 8)
                        Application.DoEvents()
                        'Clean2(MLD, OM)
                        model.RenumberGroups()
                        model.BuildFaceGroups()
                        WriteLn("Writing " & tf)
                        If textureFlag = True Then model.ExportMode = 0 Else model.ExportMode = 1
                        model.NJCMSaveProcess2(tf, outMode)
                        'MLD.SAVEProcess(tf, OM)
                        textureFlag = False
                        model.isTextured = False
                        OFC += 1
                End Select
            End With
        Next
        If (OFC - 1) = 1 Then
            WriteLn("1 Model Written.")
        Else
            WriteLn(Format(OFC - 1) & " Models written.")
        End If
    End Sub

    Private Function Trial2Scan(ByVal M As NJCM.Model) As Collection
        Dim tags() As String = {"NJTL", "NJCM", "GBIX", "PVRT"}
        Dim tag0() As Byte
        Dim tk As New Collection
        Dim sp As Integer = 0
        Dim lp As Integer = 0
        Dim tc As Short = 0
        Dim tm As Short = 0
        Dim um As Short = 0
        Dim qd As mdlkey
        Dim qf As Boolean = False
        Dim fd As Boolean = False
        Dim ka As Boolean = False
        Dim txm As Boolean = False
        Dim txp As Boolean = False

        qd.mldtype = ""
        qd.mldaddr = 0

        WriteLn("Scanning...")
        sp = 0
        tc = 0
        Do
            fd = False
            Do
                lp = sp
                tag0 = MakeBytes(tags(tc))
                sp = indexOf(tag0, M.lBuf, sp)
                If sp > -1 Then fd = True
                If sp = -1 Then tc += 1
                If sp = -1 And tc < 4 Then sp = lp
                If tc = 4 Then Exit Do
            Loop Until fd
            If Not fd Then
                qf = True
            Else
                sp += 4
                Select Case tc
                    Case Is = 0
                        txm = True
                        qd.mldtype = "TM"
                        qd.mldaddr = sp - 4
                        tc = 1
                        ka = True
                    Case Is = 1
                        If Not txm Then
                            um += 1
                            qd.mldaddr = sp - 4
                            qd.mldtype = "UM"
                            ka = True
                        End If
                        tc = 0
                        txm = False
                    Case Is = 2
                        txp = True
                        tc = 3
                    Case Is = 3
                        txp = True
                        tc = 2
                End Select
            End If
            If ka Then tk.Add(qd) : ka = False
            'StepControl()
        Loop Until qf
        Return tk
    End Function

    Public Sub Trial2(ByVal InFile As String, ByVal OutFile As String, ByVal InMode As Integer, ByVal OutMode As Integer)

        Dim tags() As String = {"NJTL", "NJCM", "GBIX", "PVRT"}
        Dim key2 As New Collection
        Dim sp As Integer = 0
        Dim lp As Integer = 0
        Dim GeoOfs As UInteger = 0
        Dim TxtOfs As UInteger = 0
        Dim txm As Boolean = False
        Dim txp As Boolean = False
        Dim tc As Short = 0
        Dim tm As Short = 0
        Dim um As Short = 0
        Dim texmode As Short = 0
        Dim qf As Boolean = False
        Dim fd As Boolean = False
        Dim ka As Boolean = False
        Dim qd As mdlkey
        qd.mldtype = ""
        qd.mldaddr = 0

        Cls()
        WriteLn("Loading " & InFile)
        Dim MyScale As String = InputBox("Model Scale", "Model Master Scale", 1)
        If MyScale = "" Then MyScale = "1"
        Dim MLD As New NJCM.Model(InFile, Val(MyScale))
        MLD.Trial = False
        MLD.ExportMode = 0

        key2 = Trial2Scan(MLD)

        For I As Integer = 1 To key2.Count
            qd = key2(I)
            Select Case qd.mldtype
                Case Is = "TM"
                    tm += 1
                Case Is = "UM"
                    um += 1
            End Select
        Next
        WriteLn(Format(tm, "##0") & " Textured Models Present.")
        WriteLn(Format(um, "##0") & " Untextured Models Present.")
        txp = (indexOf(MakeBytes(tags(2)), MLD.lBuf, 0) <> -1)
        If txp Then
            WriteLn("Textures Present in File.")
            texmode = 2
        Else
            If tm > 0 Then
                WriteLn("Textures External to Model File.")
                texmode = 1
            Else
                WriteLn("No Textures Present.")
                texmode = 0
            End If
        End If

        Dim tf As String = ""
        Dim sf As String = ""
        For mldcount As Integer = 1 To key2.Count
            qd = key2(mldcount)
            If key2.Count > 1 Then tf = Strings.Replace(OutFile, ".", "-" & Format(mldcount) & ".") Else tf = OutFile
            sf = "Extracting " & tf & " from " & InFile
            WriteLn(sf)
            ModelWalk(MLD, qd.mldaddr)
        Next
        WriteLn("Clean Up Goes Here!")
        MLD = Nothing
        WriteLn("Goodbye!")
    End Sub

    Public Sub ModelWalk(ByVal MLD As NJCM.Model, ByVal start As UInteger)
        Dim sp As UInteger = start
        Dim hd As New NJCM.Types.NJHeader
        Dim qf As Boolean = False
        Dim tg As New List(Of Integer)
        Dim tr As Int32 = -1
        Dim sc As Boolean = False
        With MLD.lStream
            .Seek(sp, System.IO.SeekOrigin.Begin)
            Do
                sc = False
                hd = .ReadNJHeader()
                WriteLn("     " & HexOut(.Position - 8) & " : " & hd.ID & " block, " & hd.Nx.ToString & " Bytes.")
                If hd.ID = "STOP" Then qf = True
                If hd.ID = "NJTL" Then
                    Dim tnames() As String = MLD.NJTLProcess(.Position)
                    For Each Ind As String In tnames
                        WriteLn("          Texture : " & Ind)
                    Next
                    sc = True
                End If
                If hd.ID = "GBIX" Then
                    tr = .ReadInt32
                    .Seek(4, System.IO.SeekOrigin.Current)
                    tg.Add(tr)
                    sc = True
                End If
                If (hd.Nx + .Position) >= .Length And qf = False Then qf = True Else .Seek(hd.Nx, System.IO.SeekOrigin.Current)
                If sc Then StepControl()
            Loop Until qf = True



        End With
    End Sub

    Public Sub Clean(ByRef MLD As NJCM.Model)
        'Let's try to clean up the model a little bit...
        'Remove groups whose material is completely transparent... .Kd.A = 0.0
        MLD.RenumberGroups()
        MLD.BuildFaceGroups()

        Dim gr2 As New List(Of Types.FaceGroup)
        Dim mt2 As New List(Of Types.Material)

        Dim xref(MLD.mt.Count) As Integer

        For I As Integer = 0 To MLD.mt.Count - 1
            xref(I) = -1
        Next

        For Each Idv As Types.FaceGroup In MLD.gr
            Dim mti As Integer = Idv.Mat

            If MLD.mt(mti).Kd.A <> 0.0 Then
                'Get Master Group Location...
                Dim pos As Integer = MLD.gr.IndexOf(Idv)
                'Clone Group Entry
                gr2.Add(MLD.gr(pos).Clone)
                'Transfer Material Data
                If mt2.IndexOf(MLD.mt(mti)) = -1 Then
                    mt2.Add(MLD.mt(mti).Clone)
                    gr2(gr2.Count - 1).Mat = mt2.Count - 1

                Else
                    gr2(gr2.Count - 1).Mat = mt2.IndexOf(MLD.mt(mti))
                    Report("CLEAN : Original Group " & (pos + 1).ToString & " has become Group " & gr2.Count.ToString & " after model cleanup.", 1)
                End If
            End If
        Next
        MLD.gr = gr2
        MLD.mt = mt2
        For I As Integer = 0 To MLD.gr.Count - 1
            For J As Integer = MLD.gr(I).Start To MLD.gr(I).Finish
                MLD.fc(J).Mi = MLD.gr(I).Mat
            Next
        Next
    End Sub
    Private Sub Clean2(ByRef MLD As NJCM.Model, ByVal OM As Integer)
        If OM = 2 Then
            MLD.RenumberGroups()
            MLD.BuildFaceGroups()
        End If

    End Sub


End Module




