stjr/SRB2
0
0
Fork 0
mirror of https://git.do.srb2.org/STJr/SRB2.git synced 2024-11-29 23:52:30 +00:00
Code Issues Projects Releases Packages Wiki Activity
SRB2/tools/SOCEdit/frmStateEdit.frm

941 lines
28 KiB
Text
Raw Normal View History

SRB2 2.1 release
2014-03-15 16:59:03 +00:00
VERSION 5.00
Begin VB.Form frmStateEdit
Caption = "State Edit"
ClientHeight = 6750
ClientLeft = 60
ClientTop = 345
ClientWidth = 8970
Icon = "frmStateEdit.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 6750
ScaleWidth = 8970
StartUpPosition = 3 'Windows Default
Begin VB.TextBox lblVar2Desc
Height = 495
Left = 4440
Locked = -1 'True
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 25
Top = 3000
Width = 4455
End
Begin VB.TextBox lblVar1Desc
Height = 495
Left = 4440
Locked = -1 'True
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 24
Top = 2400
Width = 4455
End
Begin VB.TextBox lblActionDesc
Height = 735
Left = 4440
Locked = -1 'True
MultiLine = -1 'True
ScrollBars = 2 'Vertical
TabIndex = 23
Top = 1560
Width = 4455
End
Begin VB.ListBox lstThings
Height = 450
ItemData = "frmStateEdit.frx":0442
Left = 7440
List = "frmStateEdit.frx":0444
TabIndex = 22
Top = 6120
Visible = 0 'False
Width = 975
End
Begin VB.TextBox txtFuncVar2
Height = 285
Left = 7200
TabIndex = 19
Top = 3600
Width = 1215
End
Begin VB.TextBox txtFuncVar1
Height = 285
Left = 5520
TabIndex = 18
Top = 3600
Width = 1095
End
Begin VB.CommandButton cmdCopy
Caption = "&Copy state to..."
Height = 495
Left = 6120
Style = 1 'Graphical
TabIndex = 17
Top = 6120
Width = 1095
End
Begin VB.CommandButton cmdDelete
Caption = "&Delete State from SOC"
Height = 495
Left = 6120
Style = 1 'Graphical
TabIndex = 16
Top = 5520
Width = 1095
End
Begin VB.CommandButton cmdReload
Caption = "&Load Code Default"
Height = 495
Left = 4920
Style = 1 'Graphical
TabIndex = 15
Top = 5520
Width = 1095
End
Begin VB.CommandButton cmdSave
Caption = "&Save"
Height = 495
Left = 7320
TabIndex = 14
Top = 5520
Width = 1095
End
Begin VB.ComboBox cmbTranslucency
Height = 315
ItemData = "frmStateEdit.frx":0446
Left = 6720
List = "frmStateEdit.frx":045C
TabIndex = 12
Top = 5040
Width = 1695
End
Begin VB.CheckBox chkFullbright
Caption = "Make sprite full-brightness (unaffected by lighting)"
Height = 495
Left = 6240
TabIndex = 11
Top = 4440
Width = 2175
End
Begin VB.ComboBox cmbNextstate
Height = 315
Left = 6120
TabIndex = 9
Top = 3960
Width = 2295
End
Begin VB.ComboBox cmbAction
Height = 315
Left = 6000
TabIndex = 7
Top = 1200
Width = 2295
End
Begin VB.TextBox txtTics
Height = 285
Left = 7800
TabIndex = 5
Top = 720
Width = 495
End
Begin VB.TextBox txtFrame
Height = 285
Left = 5880
MaxLength = 2
TabIndex = 3
Top = 720
Width = 495
End
Begin VB.ComboBox cmbSprite
Height = 315
Left = 5880
TabIndex = 1
Top = 120
Width = 2415
End
Begin VB.ListBox lstStates
Height = 6495
Left = 120
TabIndex = 0
Top = 120
Width = 4215
End
Begin VB.Label lblFuncVar2
Alignment = 1 'Right Justify
Caption = "Var2:"
Height = 255
Left = 6600
TabIndex = 21
Top = 3600
Width = 495
End
Begin VB.Label lblFuncVar1
Alignment = 1 'Right Justify
Caption = "Var1:"
Height = 255
Left = 4920
TabIndex = 20
Top = 3600
Width = 495
End
Begin VB.Label lblTranslucency
Alignment = 1 'Right Justify
Caption = "Translucency:"
Height = 255
Left = 5520
TabIndex = 13
Top = 5040
Width = 1095
End
Begin VB.Label lblNextstate
Alignment = 1 'Right Justify
Caption = "Next State:"
Height = 255
Left = 5160
TabIndex = 10
Top = 3960
Width = 855
End
Begin VB.Label lblAction
Alignment = 1 'Right Justify
Caption = "Function to Call:"
Height = 375
Left = 5040
TabIndex = 8
Top = 1080
Width = 855
End
Begin VB.Label lblTics
Alignment = 1 'Right Justify
Caption = "Tics (-1 for infinite duration):"
Height = 495
Left = 6480
TabIndex = 6
Top = 600
Width = 1215
End
Begin VB.Label lblFrame
Alignment = 1 'Right Justify
Caption = "Frame:"
Height = 255
Left = 5160
TabIndex = 4
Top = 720
Width = 615
End
Begin VB.Label lblSprite
Alignment = 1 'Right Justify
Caption = "Sprite:"
Height = 255
Left = 5160
TabIndex = 2
Top = 120
Width = 615
End
End
Attribute VB_Name = "frmStateEdit"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub cmbAction_Click()
Dim myFSO As New Scripting.FileSystemObject
Dim ts As TextStream
Dim line As String
Dim index As Integer
Dim ActionName As String
ActionName = cmbAction.List(cmbAction.ListIndex)
If cmbAction.ListIndex = 0 Then
lblActionDesc.Text = ""
lblVar1Desc.Text = ""
lblVar2Desc.Text = ""
Exit Sub
End If
ChDir SourcePath
Set ts = myFSO.OpenTextFile("p_enemy.c", ForReading, False)
Do While Not ts.AtEndOfStream
line = ts.ReadLine
If Mid(line, 4, 9) = "Function:" And InStr(line, ActionName) > 0 Then
ts.ReadLine ' //
line = ts.ReadLine ' // Description:
index = InStr(line, ":")
lblActionDesc.Text = Mid(line, index + 2, Len(line) - (index + 1))
ts.ReadLine ' //
line = ts.ReadLine ' // var1 =
If InStr(line, "var1:") Then
lblVar1Desc.Text = Mid(line, 4, Len(line) - 3)
line = ts.ReadLine
Do While Left(line, 7) <> "// var2"
lblVar1Desc.Text = lblVar1Desc.Text & vbCrLf & TrimComplete(Mid(line, 4, Len(line) - 3))
line = ts.ReadLine
Loop
Else
lblVar1Desc.Text = Mid(line, 4, Len(line) - 3)
End If
If Left(line, 7) <> "// var2" Then
line = ts.ReadLine ' // var2 =
End If
If InStr(line, "var2:") Then
lblVar2Desc.Text = Mid(line, 4, Len(line) - 3)
line = ts.ReadLine
Do While Len(line) > 4
lblVar2Desc.Text = lblVar2Desc.Text & vbCrLf & TrimComplete(Mid(line, 4, Len(line) - 3))
line = ts.ReadLine
Loop
Else
lblVar2Desc.Text = Mid(line, 4, Len(line) - 3)
End If
End If
Loop
ts.Close
Set myFSO = Nothing
End Sub
Private Sub cmdCopy_Click()
Dim Response As String
Response$ = InputBox("Copy state to #:", "Copy State")
If Response = "" Then Exit Sub
Response = TrimComplete(Response)
Call WriteState(False, Val(Response))
MsgBox "State copied to #" & Val(Response)
End Sub
Private Sub cmdDelete_Click()
Call WriteState(True, lstStates.ListIndex)
End Sub
Private Sub cmdReload_Click()
Call ClearForm
If InStr(lstStates.List(lstStates.ListIndex), "S_FREESLOT") = 0 Then
LoadStateInfo (lstStates.ListIndex)
Else
MsgBox "Free slots do not have a code default."
End If
End Sub
Private Sub cmdSave_Click()
If TrimComplete(txtFrame.Text) = "" And (chkFullbright.Value = 1 Or cmbTranslucency.ListIndex > 0) Then
MsgBox "ERROR: Frame field required for fullbright/translucency."
Exit Sub
End If
Call WriteState(False, lstStates.ListIndex)
End Sub
Private Sub Form_Load()
Call Reload
lstStates.ListIndex = 0
End Sub
Private Sub ClearForm()
cmbNextstate.Text = ""
cmbSprite.Text = ""
txtFrame.Text = ""
cmbAction.Text = ""
txtFuncVar1.Text = ""
txtFuncVar2.Text = ""
lblActionDesc.Text = ""
lblVar1Desc.Text = ""
lblVar2Desc.Text = ""
chkFullbright.Value = False
cmbTranslucency.ListIndex = 0
End Sub
Private Sub Reload()
LoadStates
LoadSprites
LoadActions
End Sub
Private Sub LoadStates()
Dim myFSO As New Scripting.FileSystemObject
Dim ts As TextStream
Dim line As String
Dim number As Integer
Dim startclip As Integer, endclip As Integer
Dim addstring As String
Dim numfreeslots As Integer, i As Integer
ChDir SourcePath
Set ts = myFSO.OpenTextFile("info.h", ForReading, False)
Do While InStr(ts.ReadLine, "Object states (don't modify this comment!)") = 0
Loop
ts.SkipLine ' typedef enum
ts.SkipLine ' {
line = ts.ReadLine
number = 0
lstStates.Clear
Do While InStr(line, "S_FIRSTFREESLOT") = 0
startclip = InStr(line, "S_")
If InStr(line, "S_") <> 0 Then
endclip = InStr(line, ",")
line = Mid(line, startclip, endclip - startclip)
addstring = number & " - " & line
lstStates.AddItem addstring
cmbNextstate.AddItem addstring
number = number + 1
End If
line = ts.ReadLine
Loop
ts.Close
'Populate the free slots!
Set ts = myFSO.OpenTextFile("info.h", ForReading, False)
line = ts.ReadLine
Do While InStr(line, "#define NUMMOBJFREESLOTS") = 0
line = ts.ReadLine
Loop
startclip = InStr(line, "SLOTS ") + 6
numfreeslots = Val(Mid(line, startclip, Len(line) - startclip + 1)) * 6
For i = 1 To numfreeslots
addstring = number & " - " & "S_FREESLOT" & i
lstStates.AddItem addstring
cmbNextstate.AddItem addstring
number = number + 1
Next
ts.Close
Set myFSO = Nothing
End Sub
Private Sub LoadSprites()
Dim myFSO As New Scripting.FileSystemObject
Dim ts As TextStream
Dim line As String
Dim number As Integer
Dim startclip As Integer, endclip As Integer
Dim addstring As String
Dim numfreeslots As Integer, i As Integer
ChDir SourcePath
Set ts = myFSO.OpenTextFile("info.h", ForReading, False)
Do While InStr(ts.ReadLine, "Hey, moron! If you change this table, don't forget about") = 0
Loop
ts.SkipLine ' typedef enum
ts.SkipLine ' {
line = ts.ReadLine
number = 0
cmbSprite.Clear
Do While InStr(line, "SPR_FIRSTFREESLOT") = 0
startclip = InStr(line, "SPR_")
If InStr(line, "SPR_") <> 0 Then
endclip = InStr(line, ",")
line = Mid(line, startclip, endclip - startclip)
addstring = number & " - " & line
cmbSprite.AddItem addstring
number = number + 1
End If
line = ts.ReadLine
Loop
ts.Close
'Populate the free slots!
Set ts = myFSO.OpenTextFile("info.h", ForReading, False)
line = ts.ReadLine
Do While InStr(line, "#define NUMMOBJFREESLOTS") = 0
line = ts.ReadLine
Loop
startclip = InStr(line, "SLOTS ") + 6
numfreeslots = Val(Mid(line, startclip, Len(line) - startclip + 1))
For i = 1 To numfreeslots
If i < 10 Then
addstring = number & " - " & "SPR_F00" & i & " (Free slot)"
ElseIf i < 100 Then
addstring = number & " - " & "SPR_F0" & i & " (Free slot)"
Else
addstring = number & " - " & "SPR_F" & i & " (Free slot)"
End If
cmbSprite.AddItem addstring
number = number + 1
Next
ts.Close
Set myFSO = Nothing
End Sub
Private Sub LoadActions()
Dim myFSO As New Scripting.FileSystemObject
Dim ts As TextStream
Dim line As String
Dim number As Integer
Dim startclip As Integer, endclip As Integer
Dim addstring As String
ChDir SourcePath
Set ts = myFSO.OpenTextFile("dehacked.c", ForReading, False)
Do While InStr(ts.ReadLine, "actionpointer_t actionpointers[]") = 0
Loop
ts.SkipLine ' {
line = ts.ReadLine
number = 0
cmbAction.Clear
cmbAction.AddItem "None"
Do While InStr(line, "NULL") = 0
startclip = InStr(line, "A_")
If InStr(line, "A_") <> 0 Then
endclip = InStr(line, "}")
line = Mid(line, startclip, endclip - startclip)
cmbAction.AddItem line
number = number + 1
End If
line = ts.ReadLine
Loop
ts.Close
Set myFSO = Nothing
End Sub
Private Sub lstStates_Click()
Call ClearForm
If InStr(lstStates.List(lstStates.ListIndex), "S_FREESLOT") = 0 Then
LoadStateInfo (lstStates.ListIndex)
End If
LoadSOCStateInfo (lstStates.ListIndex)
End Sub
Private Sub LoadSOCStateInfo(StateNum As Integer)
Dim myFSO As New Scripting.FileSystemObject
Dim ts As TextStream
Dim line As String
Dim word As String
Dim word2 As String
Dim frameNum As Long
Set ts = myFSO.OpenTextFile(SOCFile, ForReading, False)
SOCLoad:
Do While Not ts.AtEndOfStream
line = ts.ReadLine
If Left(line, 1) = "#" Then GoTo SOCLoad
If Left(line, 1) = vbCrLf Then GoTo SOCLoad
If Len(line) < 1 Then GoTo SOCLoad
word = FirstToken(line)
word2 = SecondToken(line)
If UCase(word) = "FRAME" And Val(word2) = StateNum Then
Do While Len(line) > 0 And Not ts.AtEndOfStream
line = ts.ReadLine
word = UCase(FirstToken(line))
word2 = UCase(SecondTokenEqual(line))
If word = "SPRITENUMBER" Then
cmbSprite.ListIndex = Val(word2)
ElseIf word = "SPRITESUBNUMBER" Then
frameNum = Val(word2)
If frameNum >= 327680 Then ' 5 << 16
cmbTranslucency.ListIndex = 5
frameNum = frameNum And Not 327680
ElseIf frameNum >= 262144 Then ' 4 << 16
cmbTranslucency.ListIndex = 4
frameNum = frameNum And Not 262144
ElseIf frameNum >= 196608 Then ' 3 << 16
cmbTranslucency.ListIndex = 3
frameNum = frameNum And Not 196608
ElseIf frameNum >= 131072 Then ' 2 << 16
cmbTranslucency.ListIndex = 2
frameNum = frameNum And Not 131072
ElseIf frameNum >= 65536 Then ' 1 << 16
cmbTranslucency.ListIndex = 1
frameNum = frameNum And Not 65536
End If
If frameNum >= 32768 Then
chkFullbright.Value = 1
frameNum = frameNum And Not 32768
Else
chkFullbright.Value = 0
End If
txtFrame.Text = frameNum
ElseIf word = "DURATION" Then
txtTics.Text = Val(word2)
ElseIf word = "NEXT" Then
cmbNextstate.ListIndex = Val(word2)
ElseIf word = "ACTION" Then
Call FindComboIndex(cmbAction, UCase(SecondToken(line)))
ElseIf word = "VAR1" Then
txtFuncVar1.Text = Val(word2)
ElseIf word = "VAR2" Then
txtFuncVar2.Text = Val(word2)
ElseIf Len(line) > 0 And Left(line, 1) <> "#" Then
MsgBox "Error in SOC!" & vbCrLf & "Unknown line: " & line
End If
Loop
Exit Do
End If
Loop
ts.Close
Set myFSO = Nothing
End Sub
Private Sub LoadStateInfo(StateNum As Integer)
Dim myFSO As New Scripting.FileSystemObject
Dim ts As TextStream
Dim line As String
Dim number As Integer
Dim startclip As Integer, endclip As Integer
Dim token As String
Dim frame As Long
Dim templine As String
ChDir SourcePath
Set ts = myFSO.OpenTextFile("info.c", ForReading, False)
Do While InStr(ts.ReadLine, "Keep this comment directly above S_NULL") = 0
Loop
number = 0
Do While number <> StateNum
Do While InStr(ts.ReadLine, "SPR_") = 0
Loop
number = number + 1
Loop
Do While InStr(line, "SPR_") = 0
line = ts.ReadLine
Loop
startclip = InStr(line, "SPR_")
line = Mid(line, startclip, Len(line) - startclip)
endclip = InStr(line, ",") - 1
token = Left(line, endclip)
Call FindComboIndex(cmbSprite, token)
startclip = InStr(line, ",") + 1
line = TrimComplete(Mid(line, startclip, Len(line) - startclip))
endclip = InStr(line, ",") - 1
frame = Val(Left(line, endclip))
If frame >= 32768 Then
chkFullbright.Value = 1
frame = frame - 32768
Else
chkFullbright.Value = 0
End If
txtFrame.Text = frame
cmbTranslucency.ListIndex = 0
startclip = InStr(line, ",") + 1
line = TrimComplete(Mid(line, startclip, Len(line) - startclip))
endclip = InStr(line, ",") - 1
txtTics.Text = Val(Left(line, endclip))
startclip = InStr(line, "{") + 1
line = TrimComplete(Mid(line, startclip, Len(line) - startclip))
endclip = InStr(line, "}") - 1
cmbAction.Text = TrimComplete(Left(line, endclip))
If cmbAction.Text = "NULL" Then cmbAction.Text = "None"
startclip = InStr(line, ",") + 1
line = TrimComplete(Mid(line, startclip, Len(line) - startclip))
endclip = InStr(line, ",") - 1
templine = Left(line, endclip)
templine = TrimComplete(templine)
'Check for *FRACUNIT values
endclip = InStr(templine, "*FRACUNIT")
If endclip <> 0 Then
templine = Left(templine, endclip - 1)
templine = Val(templine) * 65536
End If
'Check for crazy-odd MT_ usage
endclip = InStr(templine, "MT_")
If endclip <> 0 Then
templine = FindThingNum(templine) & " - " & templine
End If
'Check for crazy-odd pw_ usage
endclip = InStr(templine, "pw_")
If endclip <> 0 Then
templine = FindPowerNum(templine) & " - " & templine
End If
txtFuncVar1.Text = templine
startclip = InStr(line, ",") + 1
line = TrimComplete(Mid(line, startclip, Len(line) - startclip))
endclip = InStr(line, ",") - 1
templine = Left(line, endclip)
templine = TrimComplete(templine)
'Check for *FRACUNIT values
endclip = InStr(templine, "*FRACUNIT")
If endclip <> 0 Then
templine = Left(templine, endclip - 1)
templine = Val(templine) * 65536
End If
'Check for crazy-odd MT_ usage
endclip = InStr(templine, "MT_")
If endclip <> 0 Then
templine = FindThingNum(templine) & " - " & templine
End If
'Check for crazy-odd pw_ usage
endclip = InStr(templine, "pw_")
If endclip <> 0 Then
templine = FindPowerNum(templine) & " - " & templine
End If
txtFuncVar2.Text = templine
startclip = InStr(line, ",") + 1
line = TrimComplete(Mid(line, startclip, Len(line) - startclip))
endclip = InStr(line, "}") - 1
Call FindComboIndex(cmbNextstate, TrimComplete(Left(line, endclip)))
ts.Close
Set myFSO = Nothing
End Sub
Private Sub FindComboIndex(ByRef Box As ComboBox, line As String)
Dim i As Integer
For i = 0 To Box.ListCount
If InStr(UCase(Box.List(i)), UCase(line)) Then
Box.ListIndex = i
Exit For
End If
Next
End Sub
Private Sub WriteState(Remove As Boolean, num As Integer)
Dim myFSOSource As New Scripting.FileSystemObject
Dim tsSource As TextStream
Dim myFSOTarget As New Scripting.FileSystemObject
Dim tsTarget As TextStream
Dim line As String
Dim word As String
Dim word2 As String
Dim flags As Long
Dim statefound As Boolean
statefound = False
Set tsSource = myFSOSource.OpenTextFile(SOCFile, ForReading, False)
Set tsTarget = myFSOTarget.OpenTextFile(SOCTemp, ForWriting, True)
Do While Not tsSource.AtEndOfStream
line = tsSource.ReadLine
word = UCase(FirstToken(line))
word2 = UCase(SecondToken(line))
'If the current sound exists in the SOC, delete it.
If word = "FRAME" And Val(word2) = num Then
statefound = True
Do While Len(TrimComplete(tsSource.ReadLine)) > 0 And Not (tsSource.AtEndOfStream)
Loop
Else
tsTarget.WriteLine line
End If
Loop
tsSource.Close
Set myFSOSource = Nothing
If Remove = False Then
If line <> "" Then tsTarget.WriteLine ""
tsTarget.WriteLine "FRAME " & num
cmbSprite.Text = TrimComplete(cmbSprite.Text)
txtFrame.Text = TrimComplete(txtFrame.Text)
txtTics.Text = TrimComplete(txtTics.Text)
cmbAction.Text = TrimComplete(cmbAction.Text)
txtFuncVar1.Text = TrimComplete(txtFuncVar1.Text)
txtFuncVar2.Text = TrimComplete(txtFuncVar2.Text)
cmbNextstate.Text = TrimComplete(cmbNextstate.Text)
cmbTranslucency.Text = TrimComplete(cmbTranslucency.Text)
If cmbSprite.Text <> "" Then tsTarget.WriteLine "SPRITENUMBER = " & cmbSprite.ListIndex
flags = Val(txtFrame.Text)
If chkFullbright.Value = 1 Then flags = flags + 32768
' Grrr VB doesn't have bitshifts!!
If cmbTranslucency.Text <> "" Then
flags = flags + cmbTranslucency.ListIndex * 65536
End If
If txtFrame.Text <> "" Then tsTarget.WriteLine "SPRITESUBNUMBER = " & flags
If txtTics.Text <> "" Then tsTarget.WriteLine "DURATION = " & Val(txtTics.Text)
If cmbNextstate.Text <> "" Then tsTarget.WriteLine "NEXT = " & cmbNextstate.ListIndex
If cmbAction.Text <> "" Then tsTarget.WriteLine "ACTION " & cmbAction.Text
If txtFuncVar1.Text <> "" Then tsTarget.WriteLine "VAR1 = " & Val(txtFuncVar1.Text)
If txtFuncVar2.Text <> "" Then tsTarget.WriteLine "VAR2 = " & Val(txtFuncVar2.Text)
End If
tsTarget.Close
Set myFSOTarget = Nothing
FileCopy SOCTemp, SOCFile
Kill SOCTemp
If Remove = True Then
If statefound = True Then
MsgBox "State removed from SOC."
Else
MsgBox "State not found in SOC."
End If
Else
MsgBox "State Saved."
End If
End Sub
Private Sub LoadThings()
Dim myFSO As New Scripting.FileSystemObject
Dim ts As TextStream
Dim line As String
Dim number As Integer
Dim startclip As Integer, endclip As Integer
Dim numfreeslots As Integer, i As Integer
ChDir SourcePath
Set ts = myFSO.OpenTextFile("info.h", ForReading, False)
Do While InStr(ts.ReadLine, "Little flag for SOC editor (don't change this comment!)") = 0
Loop
ts.SkipLine ' typedef enum
ts.SkipLine ' {
line = ts.ReadLine
number = 0
lstThings.Clear
Do While InStr(line, "MT_FIRSTFREESLOT") = 0
startclip = InStr(line, "MT_")
If InStr(line, "MT_") <> 0 Then
endclip = InStr(line, ",")
line = Mid(line, startclip, endclip - startclip)
lstThings.AddItem number & " - " & line
number = number + 1
End If
line = ts.ReadLine
Loop
ts.Close
'Populate the free slots!
Set ts = myFSO.OpenTextFile("info.h", ForReading, False)
line = ts.ReadLine
Do While InStr(line, "#define NUMMOBJFREESLOTS") = 0
line = ts.ReadLine
Loop
startclip = InStr(line, "SLOTS ") + 6
numfreeslots = Val(Mid(line, startclip, Len(line) - startclip + 1))
For i = 1 To numfreeslots
lstThings.AddItem number & " - " & "MT_FREESLOT" & i
number = number + 1
Next
ts.Close
Set myFSO = Nothing
End Sub
Private Function FindThingNum(ThingName As String) As Integer
Dim i As Integer
Dim temp As String
Dim startpoint As Integer
Dim endpoint As Integer
lstThings.Clear
LoadThings
For i = 0 To lstThings.ListCount - 1
temp = lstThings.List(i)
startpoint = InStr(temp, "-") + 2
endpoint = Len(temp) - startpoint + 1
temp = Mid(temp, startpoint, endpoint)
If temp = ThingName Then
FindThingNum = Val(lstThings.List(i))
Exit For
End If
Next
End Function
Private Function FindPowerNum(PowerName As String) As Integer
Dim myFSO As New Scripting.FileSystemObject
Dim ts As TextStream
Dim line As String
Dim number As Integer
Dim startclip As Integer
ChDir SourcePath
Set ts = myFSO.OpenTextFile("d_player.h", ForReading, False)
Do While InStr(ts.ReadLine, "Player powers. (don't edit this comment)") = 0
Loop
ts.SkipLine ' typedef enum
ts.SkipLine ' {
line = ts.ReadLine
number = 0
Do While InStr(line, "NUMPOWERS") = 0
startclip = InStr(line, PowerName)
If startclip <> 0 Then
FindPowerNum = number
Exit Do
End If
number = number + 1
line = ts.ReadLine
Loop
ts.Close
Set myFSO = Nothing
End Function
Reference in a new issue Copy permalink