stjr/SRB2
0
0
Fork 0
mirror of https://git.do.srb2.org/STJr/SRB2.git synced 2024-11-21 20:11:12 +00:00
Code Issues Projects Releases Packages Wiki Activity

Remove unmaintained SOCEdit

Browse source 
Written in VB6. Superceded by better tools and also probably not even
buildable anymore.
This commit is contained in:
Eidolon 2022-07-17 19:52:41 -05:00
parent af1485075b
commit 292b8d1470
27 changed files with 0 additions and 8369 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

96
tools/SOCEdit/Global.bas
View file

@ -1,96 +0,0 @@
Attribute VB_Name = "Module1"
Option Explicit
Public SOCFile As String
Public SOCTemp As String
Public SourcePath As String
Public Function FirstToken(ByVal line As String)
Dim index As Integer
index = InStr(line, " ") - 1
If index < 1 Then
index = Len(line)
End If
FirstToken = TrimComplete(Left(line, index))
End Function
Public Function SecondToken(ByVal line As String)
Dim startclip As Integer
Dim endclip As Integer
startclip = InStr(line, " ")
startclip = startclip + 1
SecondToken = TrimComplete(Mid(line, startclip, Len(line)))
End Function
Public Function SecondTokenEqual(ByVal line As String)
Dim startclip As Integer
Dim endclip As Integer
startclip = InStr(line, "=")
startclip = startclip + 2
line = Mid(line, startclip, Len(line))
SecondTokenEqual = TrimComplete(line)
End Function
Public Function TrimComplete(ByVal sValue As String) As String
Dim sAns As String
Dim sWkg As String
Dim sChar As String
Dim lLen As Long
Dim lCtr As Long
sAns = sValue
lLen = Len(sValue)
If lLen > 0 Then
'Ltrim
For lCtr = 1 To lLen
sChar = Mid(sAns, lCtr, 1)
If Asc(sChar) > 32 Then Exit For
Next
sAns = Mid(sAns, lCtr)
lLen = Len(sAns)
'Rtrim
If lLen > 0 Then
For lCtr = lLen To 1 Step -1
sChar = Mid(sAns, lCtr, 1)
If Asc(sChar) > 32 Then Exit For
Next
End If
sAns = Left$(sAns, lCtr)
End If
TrimComplete = sAns
End Function
Public Function RTrimComplete(ByVal sValue As String) As String
Dim sAns As String
Dim sWkg As String
Dim sChar As String
Dim lLen As Long
Dim lCtr As Long
sAns = sValue
lLen = Len(sValue)
'Rtrim
If lLen > 0 Then
For lCtr = lLen To 1 Step -1
sChar = Mid(sAns, lCtr, 1)
If Asc(sChar) > 32 Then Exit For
Next
End If
sAns = Left$(sAns, lCtr)
RTrimComplete = sAns
End Function

53
tools/SOCEdit/SOCEdit.vbp
View file

@ -1,53 +0,0 @@
Type=Exe
Reference=*\G{00020430-0000-0000-C000-000000000046}#2.0#0#..\..\..\WINNT\system32\stdole2.tlb#OLE Automation
Reference=*\G{420B2830-E718-11CF-893D-00A0C9054228}#1.0#0#..\..\..\WINNT\system32\scrrun.dll#Microsoft Scripting Runtime
Form=Things.frm
Module=Module1; Global.bas
Form=frmStateEdit.frm
Form=frmLevelHeader.frm
Form=frmHub.frm
Form=frmMaincfg.frm
Form=frmUnlockablesEdit.frm
Form=frmEmblemEdit.frm
Form=frmSoundEdit.frm
Form=frmCharacterEdit.frm
Form=frmCutsceneEdit.frm
Form=frmHelp.frm
Form=frmHUDEdit.frm
IconForm="frmThingEdit"
Startup="frmHub"
HelpFile=""
Title="SOC Editor"
ExeName32="SOCEdit.exe"
Path32="..\..\..\srb2demo2\SOCEdit"
Command32=""
Name="SOCEditor"
HelpContextID="0"
CompatibleMode="0"
MajorVer=0
MinorVer=7
RevisionVer=7
AutoIncrementVer=0
ServerSupportFiles=0
VersionComments="http://www.srb2.org/"
VersionCompanyName="Sonic Team Junior"
VersionFileDescription="For SRB2 v1.09.4"
CompilationType=0
OptimizationType=0
FavorPentiumPro(tm)=0
CodeViewDebugInfo=0
NoAliasing=0
BoundsCheck=0
OverflowCheck=0
FlPointCheck=0
FDIVCheck=0
UnroundedFP=0
StartMode=0
Unattended=0
Retained=0
ThreadPerObject=0
MaxNumberOfThreads=1
DebugStartupOption=0
[MS Transaction Server]
AutoRefresh=1

1895
tools/SOCEdit/Things.frm
View file

File diff suppressed because it is too large Load diff

BIN
tools/SOCEdit/Things.frx
View file

Binary file not shown.

320
tools/SOCEdit/frmCharacterEdit.frm
View file

@ -1,320 +0,0 @@
VERSION 5.00
Begin VB.Form frmCharacterEdit
Caption = "Character Edit"
ClientHeight = 3345
ClientLeft = 60
ClientTop = 345
ClientWidth = 4680
Icon = "frmCharacterEdit.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 3345
ScaleWidth = 4680
Begin VB.CommandButton cmdExample
Caption = "Show Me An &Example"
Height = 495
Left = 1320
Style = 1 'Graphical
TabIndex = 14
Top = 2400
Width = 975
End
Begin VB.CheckBox chkEnabled
Caption = "Enable this player selection."
Height = 495
Left = 1080
TabIndex = 13
Top = 1560
Width = 1455
End
Begin VB.CommandButton cmdDelete
Caption = "&Delete from SOC"
Height = 495
Left = 120
Style = 1 'Graphical
TabIndex = 12
Top = 2760
Width = 855
End
Begin VB.CommandButton cmdSave
Caption = "&Save"
Height = 495
Left = 120
TabIndex = 11
Top = 2160
Width = 855
End
Begin VB.TextBox txtSkinname
Height = 285
Left = 3240
TabIndex = 9
Top = 1200
Width = 1335
End
Begin VB.TextBox txtPicname
Height = 285
Left = 3240
MaxLength = 8
TabIndex = 7
Top = 840
Width = 1095
End
Begin VB.TextBox txtMenuposition
Height = 285
Left = 3240
MaxLength = 3
TabIndex = 5
Top = 480
Width = 495
End
Begin VB.TextBox txtPlayername
Height = 285
Left = 3240
MaxLength = 64
TabIndex = 3
Top = 120
Width = 1335
End
Begin VB.TextBox txtPlayertext
Height = 1455
Left = 2640
MultiLine = -1 'True
TabIndex = 1
Top = 1800
Width = 1935
End
Begin VB.ListBox lstPlayers
Height = 1815
ItemData = "frmCharacterEdit.frx":0442
Left = 120
List = "frmCharacterEdit.frx":0461
TabIndex = 0
Top = 240
Width = 855
End
Begin VB.Label lblSkinname
Caption = "Name of player (skin) to use:"
Height = 255
Left = 1080
TabIndex = 10
Top = 1200
Width = 2055
End
Begin VB.Label lblPicname
Alignment = 1 'Right Justify
Caption = "Picture to display:"
Height = 255
Left = 1560
TabIndex = 8
Top = 840
Width = 1575
End
Begin VB.Label lblMenuposition
Alignment = 1 'Right Justify
Caption = "Vertical menu position:"
Height = 255
Left = 1320
TabIndex = 6
Top = 480
Width = 1815
End
Begin VB.Label lblPlayername
Alignment = 1 'Right Justify
Caption = "Displayed name of player:"
Height = 255
Left = 1320
TabIndex = 4
Top = 120
Width = 1815
End
Begin VB.Label lblPlayertext
Caption = "Short Description:"
Height = 255
Left = 2640
TabIndex = 2
Top = 1560
Width = 1455
End
End
Attribute VB_Name = "frmCharacterEdit"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub cmdDelete_Click()
Call WriteCharacter(True)
End Sub
Private Sub cmdExample_Click()
txtPlayername.Text = "SONIC"
txtMenuposition.Text = "20"
txtPicname.Text = "SONCCHAR"
txtSkinname.Text = "SONIC"
chkEnabled.Value = 1
txtPlayertext.Text = " Fastest" & vbCrLf & " Speed Thok" & vbCrLf & " Not a good pick" & vbCrLf & "for starters, but when" & vbCrLf & "controlled properly," & vbCrLf & "Sonic is the most" & vbCrLf & "powerful of the three."
End Sub
Private Sub cmdSave_Click()
Call WriteCharacter(False)
End Sub
Private Sub ClearForm()
txtPlayername.Text = ""
txtMenuposition.Text = ""
txtPicname.Text = ""
txtSkinname.Text = ""
chkEnabled.Value = 0
txtPlayertext.Text = ""
End Sub
Private Sub ReadSOCPlayer(num As Integer)
Dim myFSO As New Scripting.FileSystemObject
Dim ts As TextStream
Dim line As String
Dim word As String
Dim word2 As String
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) = "CHARACTER" And Val(word2) = num Then
Do While Len(line) > 0 And Not ts.AtEndOfStream
line = ts.ReadLine
word = UCase(FirstToken(line))
word2 = UCase(SecondTokenEqual(line))
If word = "PLAYERTEXT" Then
Dim startclip As Integer, endclip As Integer
startclip = InStr(line, "=")
startclip = startclip + 2
line = Mid(line, startclip, Len(line))
txtPlayertext.Text = line & vbCrLf
Do While InStr(line, "#") = 0 And Not ts.AtEndOfStream
line = ts.ReadLine & vbCrLf
txtPlayertext.Text = txtPlayertext.Text & line
Loop
txtPlayertext.Text = RTrimComplete(txtPlayertext.Text)
If Right(txtPlayertext.Text, 1) = "#" Then
txtPlayertext.Text = Left(txtPlayertext.Text, Len(txtPlayertext.Text) - 1)
End If
ElseIf word = "PLAYERNAME" Then
txtPlayername.Text = word2
ElseIf word = "MENUPOSITION" Then
txtMenuposition.Text = Val(word2)
ElseIf word = "PICNAME" Then
txtPicname.Text = word2
ElseIf word = "STATUS" Then
If Val(word2) = 32 Then
chkEnabled.Value = 1
Else
chkEnabled.Value = 0
End If
ElseIf word = "SKINNAME" Then
txtSkinname.Text = 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 lstPlayers_Click()
Call ClearForm
Call ReadSOCPlayer(lstPlayers.ListIndex)
End Sub
Private Sub WriteCharacter(Remove As Boolean)
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 charfound As Boolean
charfound = 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 character exists in the SOC, delete it.
If word = "CHARACTER" And Val(word2) = lstPlayers.ListIndex Then
charfound = 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 "CHARACTER " & lstPlayers.ListIndex
txtPlayername.Text = TrimComplete(txtPlayername.Text)
txtMenuposition.Text = TrimComplete(txtMenuposition.Text)
txtPicname.Text = TrimComplete(txtPicname.Text)
txtSkinname.Text = TrimComplete(txtSkinname.Text)
If txtPlayername.Text <> "" Then tsTarget.WriteLine "PLAYERNAME = " & txtPlayername.Text
If txtMenuposition.Text <> "" Then tsTarget.WriteLine "MENUPOSITION = " & Val(txtMenuposition.Text)
If txtPicname.Text <> "" Then tsTarget.WriteLine "PICNAME = " & txtPicname.Text
If txtSkinname.Text <> "" Then tsTarget.WriteLine "SKINNAME = " & txtSkinname.Text
If chkEnabled.Value = 1 Then
tsTarget.WriteLine "STATUS = 32"
Else
tsTarget.WriteLine "STATUS = 0"
End If
If txtPlayertext.Text <> "" Then tsTarget.WriteLine "PLAYERTEXT = " & txtPlayertext.Text & "#"
End If
tsTarget.Close
Set myFSOTarget = Nothing
FileCopy SOCTemp, SOCFile
Kill SOCTemp
If Remove = True Then
If charfound = True Then
MsgBox "Player choice removed from SOC."
Else
MsgBox "Player choice not found in SOC."
End If
Else
MsgBox "Character Saved."
End If
End Sub

BIN
tools/SOCEdit/frmCharacterEdit.frx
View file

Binary file not shown.

1365
tools/SOCEdit/frmCutsceneEdit.frm
View file

File diff suppressed because it is too large Load diff

BIN
tools/SOCEdit/frmCutsceneEdit.frx
View file

Binary file not shown.

384
tools/SOCEdit/frmEmblemEdit.frm
View file

@ -1,384 +0,0 @@
VERSION 5.00
Begin VB.Form frmEmblemEdit
Caption = "Emblem Edit"
ClientHeight = 2865
ClientLeft = 60
ClientTop = 345
ClientWidth = 5160
Icon = "frmEmblemEdit.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 2865
ScaleWidth = 5160
StartUpPosition = 3 'Windows Default
Begin VB.CommandButton cmdDelete
Caption = "&Delete Last Emblem"
Height = 735
Left = 1560
Style = 1 'Graphical
TabIndex = 17
Top = 600
Width = 855
End
Begin VB.CommandButton cmdAdd
Caption = "&Add"
Height = 375
Left = 1560
TabIndex = 16
Top = 120
Width = 855
End
Begin VB.CommandButton cmdSave
Caption = "&Save Emblem"
Height = 495
Left = 4200
Style = 1 'Graphical
TabIndex = 13
Top = 2280
Width = 855
End
Begin VB.CommandButton cmdReload
Caption = "&Reload"
Height = 495
Left = 3120
TabIndex = 12
Top = 2280
Width = 975
End
Begin VB.TextBox txtPlayernum
Height = 285
Left = 4320
MaxLength = 3
TabIndex = 9
Top = 1800
Width = 735
End
Begin VB.TextBox txtMapnum
Height = 285
Left = 4320
MaxLength = 4
TabIndex = 7
Top = 1320
Width = 735
End
Begin VB.TextBox txtZ
Height = 285
Left = 4320
MaxLength = 5
TabIndex = 3
Top = 960
Width = 735
End
Begin VB.TextBox txtY
Height = 285
Left = 4320
MaxLength = 5
TabIndex = 2
Top = 600
Width = 735
End
Begin VB.TextBox txtX
Height = 285
Left = 4320
MaxLength = 5
TabIndex = 1
Top = 240
Width = 735
End
Begin VB.ListBox lstEmblems
Height = 2400
Left = 120
TabIndex = 0
Top = 120
Width = 1335
End
Begin VB.Label Label1
Caption = "Emblem #s must be linear, sorry!"
Height = 495
Left = 1560
TabIndex = 18
Top = 2400
Width = 1455
End
Begin VB.Label lblNumEmblems
Caption = "# of Emblems:"
Height = 255
Left = 120
TabIndex = 15
Top = 2520
Width = 1335
End
Begin VB.Label lblNote2
Caption = "Don't forget to set Game Data file and # of Emblems in Global Game Settings!"
Height = 855
Left = 1560
TabIndex = 14
Top = 1440
Width = 1575
End
Begin VB.Label lblNote
Appearance = 0 'Flat
BorderStyle = 1 'Fixed Single
Caption = "Note: Enter map coordinates, not game coordinates. (I.e., 128, not 8388608)"
ForeColor = &H80000008&
Height = 1095
Left = 2640
TabIndex = 11
Top = 120
Width = 1335
End
Begin VB.Label lblPlayernum
Caption = "Player # (255 for all players):"
Height = 495
Left = 3240
TabIndex = 10
Top = 1680
Width = 1095
End
Begin VB.Label lblMapnum
Alignment = 1 'Right Justify
Caption = "Map #:"
Height = 255
Left = 3600
TabIndex = 8
Top = 1320
Width = 615
End
Begin VB.Label lblZ
Alignment = 1 'Right Justify
Caption = "Z:"
Height = 255
Left = 3960
TabIndex = 6
Top = 960
Width = 255
End
Begin VB.Label lblY
Alignment = 1 'Right Justify
Caption = "Y:"
Height = 255
Left = 3960
TabIndex = 5
Top = 600
Width = 255
End
Begin VB.Label lblX
Alignment = 1 'Right Justify
Caption = "X:"
Height = 255
Left = 3960
TabIndex = 4
Top = 240
Width = 255
End
End
Attribute VB_Name = "frmEmblemEdit"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub cmdAdd_Click()
lstEmblems.AddItem "Emblem " & lstEmblems.ListCount + 1
lstEmblems.ListIndex = lstEmblems.ListCount - 1
lblNumEmblems.Caption = "# of Emblems: " & lstEmblems.ListCount
txtX.Text = 0
txtY.Text = 0
txtZ.Text = 0
txtPlayernum.Text = 255
txtMapnum.Text = 1
End Sub
Private Sub cmdDelete_Click()
Call WriteEmblem(True)
lstEmblems.RemoveItem lstEmblems.ListCount - 1
lstEmblems.ListIndex = lstEmblems.ListCount - 1
lblNumEmblems.Caption = "# of Emblems: " & lstEmblems.ListCount
End Sub
Private Sub cmdReload_Click()
Call Reload
End Sub
Private Sub Reload()
lstEmblems.Clear
txtX.Text = ""
txtY.Text = ""
txtZ.Text = ""
txtMapnum.Text = ""
txtPlayernum.Text = ""
lblNumEmblems.Caption = "# of Emblems: " & lstEmblems.ListCount
Call ReadSOCEmblems
End Sub
Private Sub cmdSave_Click()
If lstEmblems.ListCount <= 0 Then
MsgBox "You have no emblems to save!"
Else
Call WriteEmblem(False)
End If
End Sub
Private Sub Form_Load()
Call Reload
End Sub
Private Sub ReadSOCEmblems()
Dim myFSO As New Scripting.FileSystemObject
Dim ts As TextStream
Dim line As String
Dim word As String
Dim word2 As String
Set ts = myFSO.OpenTextFile(SOCFile, ForReading, False)
lstEmblems.Clear
EmblemLoad:
Do While Not ts.AtEndOfStream
line = ts.ReadLine
If Left(line, 1) = "#" Then GoTo EmblemLoad
If Left(line, 1) = vbCrLf Then GoTo EmblemLoad
If Len(line) < 1 Then GoTo EmblemLoad
word = FirstToken(line)
word2 = SecondToken(line)
If UCase(word) = "EMBLEM" Then
lstEmblems.AddItem ("Emblem " & Val(word2))
End If
Loop
ts.Close
Set myFSO = Nothing
End Sub
Private Sub ReadSOCEmblemNum(num As Integer)
Dim myFSO As New Scripting.FileSystemObject
Dim ts As TextStream
Dim line As String
Dim word As String
Dim word2 As String
Set ts = myFSO.OpenTextFile(SOCFile, ForReading, False)
EmblemLoad:
Do While Not ts.AtEndOfStream
line = ts.ReadLine
If Left(line, 1) = "#" Then GoTo EmblemLoad
If Left(line, 1) = vbCrLf Then GoTo EmblemLoad
If Len(line) < 1 Then GoTo EmblemLoad
word = UCase(FirstToken(line))
word2 = UCase(SecondToken(line))
If word = "EMBLEM" Then
If Val(word2) = num Then
Do While Len(line) > 0 And Not ts.AtEndOfStream
line = ts.ReadLine
word = UCase(FirstToken(line))
word2 = UCase(SecondTokenEqual(line))
If word = "X" Then
txtX.Text = Val(word2)
ElseIf word = "Y" Then
txtY.Text = Val(word2)
ElseIf word = "Z" Then
txtZ.Text = Val(word2)
ElseIf word = "PLAYERNUM" Then
txtPlayernum.Text = Val(word2)
ElseIf word = "MAPNUM" Then
txtMapnum.Text = Val(word2)
ElseIf Len(line) > 0 And Left(line, 1) <> "#" Then
MsgBox "Error in SOC with Emblem " & num & vbCrLf & "Unknown line: " & line
End If
Loop
Exit Do
End If
End If
Loop
ts.Close
Set myFSO = Nothing
End Sub
Private Sub lstEmblems_Click()
Dim i As Integer
i = InStr(lstEmblems.List(lstEmblems.ListIndex), " ") + 1
i = Mid(lstEmblems.List(lstEmblems.ListIndex), i, Len(lstEmblems.List(lstEmblems.ListIndex)) - i + 1)
i = Val(i)
Call ReadSOCEmblemNum(i)
End Sub
Private Sub WriteEmblem(Remove As Boolean)
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 i As Integer
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))
i = InStr(lstEmblems.List(lstEmblems.ListIndex), " ") + 1
i = Mid(lstEmblems.List(lstEmblems.ListIndex), i, Len(lstEmblems.List(lstEmblems.ListIndex)) - i + 1)
i = Val(i)
'If the current emblem exists in the SOC, delete it.
If word = "EMBLEM" And Val(word2) = i Then
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 UCase(lstEmblems.List(lstEmblems.ListIndex))
txtX.Text = TrimComplete(txtX.Text)
txtY.Text = TrimComplete(txtY.Text)
txtZ.Text = TrimComplete(txtZ.Text)
txtMapnum.Text = TrimComplete(txtMapnum.Text)
txtPlayernum.Text = TrimComplete(txtPlayernum.Text)
If txtX.Text <> "" Then tsTarget.WriteLine "X = " & Val(txtX.Text)
If txtY.Text <> "" Then tsTarget.WriteLine "Y = " & Val(txtY.Text)
If txtZ.Text <> "" Then tsTarget.WriteLine "Z = " & Val(txtZ.Text)
If txtMapnum.Text <> "" Then tsTarget.WriteLine "MAPNUM = " & Val(txtMapnum.Text)
If txtPlayernum.Text <> "" Then tsTarget.WriteLine "PLAYERNUM = " & Val(txtPlayernum.Text)
End If
tsTarget.Close
Set myFSOTarget = Nothing
FileCopy SOCTemp, SOCFile
Kill SOCTemp
If Remove = True Then
MsgBox "Emblem deleted."
Else
MsgBox "Emblem Saved."
End If
End Sub

BIN
tools/SOCEdit/frmEmblemEdit.frx
View file

Binary file not shown.

315
tools/SOCEdit/frmHUDEdit.frm
View file

@ -1,315 +0,0 @@
VERSION 5.00
Begin VB.Form frmHUDEdit
Caption = "HUD Edit"
ClientHeight = 2505
ClientLeft = 60
ClientTop = 345
ClientWidth = 5160
Icon = "frmHUDEdit.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 2505
ScaleWidth = 5160
StartUpPosition = 3 'Windows Default
Begin VB.CommandButton cmdCodeDefault
Caption = "&Load Code Default"
Height = 375
Left = 3480
TabIndex = 9
Top = 1080
Width = 1575
End
Begin VB.CommandButton cmdDelete
Caption = "&Delete from SOC"
Height = 375
Left = 3480
TabIndex = 7
Top = 2040
Width = 1575
End
Begin VB.CommandButton cmdSave
Caption = "&Save Changes"
Height = 375
Left = 3480
TabIndex = 6
Top = 1560
Width = 1575
End
Begin VB.TextBox txtY
Height = 285
Left = 4080
MaxLength = 3
TabIndex = 3
Top = 720
Width = 615
End
Begin VB.TextBox txtX
Height = 285
Left = 4080
MaxLength = 3
TabIndex = 2
Top = 360
Width = 615
End
Begin VB.ListBox lstHUD
Height = 2010
Left = 120
TabIndex = 0
Top = 360
Width = 3255
End
Begin VB.Label lblNote
Caption = "HUD items are placed on a 320x200 grid."
Height = 255
Left = 1680
TabIndex = 8
Top = 120
Width = 3015
End
Begin VB.Label lblY
Alignment = 1 'Right Justify
Caption = "Y:"
Height = 255
Left = 3600
TabIndex = 5
Top = 720
Width = 375
End
Begin VB.Label lblX
Alignment = 1 'Right Justify
Caption = "X:"
Height = 255
Left = 3720
TabIndex = 4
Top = 360
Width = 255
End
Begin VB.Label lblHUDItems
Caption = "HUD Items:"
Height = 255
Left = 120
TabIndex = 1
Top = 120
Width = 975
End
End
Attribute VB_Name = "frmHUDEdit"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub cmdCodeDefault_Click()
LoadHUDInfo (lstHUD.ListIndex)
End Sub
Private Sub cmdDelete_Click()
Call WriteHUDItem(True)
End Sub
Private Sub cmdSave_Click()
Call WriteHUDItem(False)
End Sub
Private Sub Form_Load()
Call Reload
End Sub
Private Sub Reload()
txtX.Text = ""
txtY.Text = ""
Call LoadCode
lstHUD.ListIndex = 0
End Sub
Private Sub LoadCode()
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("st_stuff.h", ForReading, False)
Do While ts.ReadLine <> "/** HUD location information (don't move this comment)"
Loop
ts.ReadLine ' */
ts.ReadLine ' typedef struct
ts.ReadLine ' {
ts.ReadLine ' int x, y;
ts.ReadLine ' } hudinfo_t;
ts.ReadLine '
ts.ReadLine ' typedef enum
ts.ReadLine ' {
line = ts.ReadLine
number = 0
lstHUD.Clear
Do While InStr(line, "NUMHUDITEMS") = 0
startclip = InStr(line, "HUD_")
If InStr(line, "HUD_") <> 0 Then
endclip = InStr(line, ",")
line = Mid(line, startclip, endclip - startclip)
addstring = number & " - " & line
lstHUD.AddItem addstring
number = number + 1
End If
line = ts.ReadLine
Loop
ts.Close
Set myFSO = Nothing
End Sub
Private Sub lstHUD_Click()
LoadHUDInfo (lstHUD.ListIndex)
Call ReadSOC(lstHUD.ListIndex)
End Sub
Private Sub LoadHUDInfo(HUDNum 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
ChDir SourcePath
Set ts = myFSO.OpenTextFile("st_stuff.c", ForReading, False)
Do While InStr(ts.ReadLine, "hudinfo[NUMHUDITEMS] =") = 0
Loop
ts.SkipLine ' {
line = ts.ReadLine ' First HUD item
number = 0
Do While number <> HUDNum
line = ts.ReadLine
number = number + 1
Loop
startclip = InStr(line, "{") + 1
endclip = InStr(line, ",")
txtX.Text = TrimComplete(Mid(line, startclip, endclip - startclip))
startclip = endclip + 2
endclip = InStr(startclip, line, "}") - 1
txtY.Text = TrimComplete(Mid(line, startclip, endclip - startclip))
ts.Close
Set myFSO = Nothing
End Sub
Private Sub ReadSOC(HUDNum As Integer)
Dim myFSO As New Scripting.FileSystemObject
Dim ts As TextStream
Dim line As String
Dim word As String
Dim word2 As String
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) = "HUDITEM" And Val(word2) = HUDNum Then
Do While Len(line) > 0 And Not ts.AtEndOfStream
line = ts.ReadLine
word = UCase(FirstToken(line))
word2 = UCase(SecondTokenEqual(line))
If word = "X" Then
txtX.Text = Val(word2)
ElseIf word = "Y" Then
txtY.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 WriteHUDItem(Remove As Boolean)
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 hudremoved As Boolean
hudremoved = 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 item exists in the SOC, delete it.
If word = "HUDITEM" And Val(word2) = lstHUD.ListIndex Then
hudremoved = 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 "HUDITEM " & lstHUD.ListIndex
txtX.Text = TrimComplete(txtX.Text)
txtY.Text = TrimComplete(txtY.Text)
If txtX.Text <> "" Then tsTarget.WriteLine "X = " & Val(txtX.Text)
If txtY.Text <> "" Then tsTarget.WriteLine "Y = " & Val(txtY.Text)
End If
tsTarget.Close
Set myFSOTarget = Nothing
FileCopy SOCTemp, SOCFile
Kill SOCTemp
If Remove = True Then
If hudremoved = True Then
MsgBox "HUD Item deleted from SOC."
Else
MsgBox "Couldn't find HUD Item in SOC."
End If
Else
MsgBox "HUD Item Saved."
End If
End Sub

BIN
tools/SOCEdit/frmHUDEdit.frx
View file

Binary file not shown.

213
tools/SOCEdit/frmHelp.frm
View file

@ -1,213 +0,0 @@
VERSION 5.00
Begin VB.Form frmHelp
BorderStyle = 3 'Fixed Dialog
Caption = "Getting Started"
ClientHeight = 7395
ClientLeft = 45
ClientTop = 330
ClientWidth = 6360
Icon = "frmHelp.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
MinButton = 0 'False
ScaleHeight = 7395
ScaleWidth = 6360
ShowInTaskbar = 0 'False
StartUpPosition = 1 'CenterOwner
Begin VB.CommandButton cmdOK
Caption = "&OK, I know what I'm doing now."
Height = 495
Left = 1920
Style = 1 'Graphical
TabIndex = 8
Top = 6840
Width = 2535
End
Begin VB.Line Line9
X1 = 120
X2 = 6120
Y1 = 4800
Y2 = 4800
End
Begin VB.Line Line7
X1 = 120
X2 = 6120
Y1 = 5400
Y2 = 5400
End
Begin VB.Label Label12
Caption = $"frmHelp.frx":0442
Height = 615
Left = 120
TabIndex = 12
Top = 4800
Width = 6015
End
Begin VB.Line Line6
X1 = 120
X2 = 6120
Y1 = 4200
Y2 = 4200
End
Begin VB.Label Label11
Caption = $"frmHelp.frx":04F8
Height = 615
Left = 120
TabIndex = 11
Top = 4200
Width = 6015
End
Begin VB.Line Line8
X1 = 120
X2 = 6120
Y1 = 6360
Y2 = 6360
End
Begin VB.Line Line5
X1 = 120
X2 = 6120
Y1 = 3720
Y2 = 3720
End
Begin VB.Line Line4
X1 = 120
X2 = 6120
Y1 = 2880
Y2 = 2880
End
Begin VB.Line Line3
X1 = 120
X2 = 6120
Y1 = 2400
Y2 = 2400
End
Begin VB.Line Line2
X1 = 120
X2 = 6120
Y1 = 1800
Y2 = 1800
End
Begin VB.Line Line1
X1 = 120
X2 = 6120
Y1 = 1200
Y2 = 1200
End
Begin VB.Label Label10
Caption = $"frmHelp.frx":05EC
Height = 495
Left = 120
TabIndex = 10
Top = 3720
Width = 6135
End
Begin VB.Label Label9
Caption = $"frmHelp.frx":068F
Height = 615
Left = 120
TabIndex = 9
Top = 1200
Width = 6135
End
Begin VB.Label Label8
Caption = $"frmHelp.frx":0772
Height = 495
Left = 120
TabIndex = 7
Top = 6360
Width = 6135
End
Begin VB.Label Label7
Caption = "However, if you have these settings in the SOC you are using, don't worry - the editor will not erase them from your file."
Height = 495
Left = 120
TabIndex = 6
Top = 5880
Width = 6135
End
Begin VB.Label Label6
Caption = $"frmHelp.frx":0816
Height = 495
Left = 120
TabIndex = 5
Top = 5400
Width = 6135
End
Begin VB.Label Label5
Caption = $"frmHelp.frx":08A9
BeginProperty Font
Name = "MS Sans Serif"
Size = 8.25
Charset = 0
Weight = 700
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 855
Left = 120
TabIndex = 4
Top = 2880
Width = 6135
End
Begin VB.Label Label4
Caption = $"frmHelp.frx":09B1
Height = 495
Left = 120
TabIndex = 3
Top = 2400
Width = 6135
End
Begin VB.Label Label3
Caption = $"frmHelp.frx":0A5A
Height = 495
Left = 120
TabIndex = 2
Top = 1920
Width = 6135
End
Begin VB.Label Label2
Caption = "Finally! A way to easily edit SOC files! I know you're anxious to get started, but here are some things you should know first:"
BeginProperty Font
Name = "MS Sans Serif"
Size = 9.75
Charset = 0
Weight = 400
Underline = 0 'False
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 120
TabIndex = 1
Top = 600
Width = 6135
End
Begin VB.Label Label1
Caption = "How To Use This Program"
BeginProperty Font
Name = "MS Sans Serif"
Size = 13.5
Charset = 0
Weight = 700
Underline = -1 'True
Italic = 0 'False
Strikethrough = 0 'False
EndProperty
Height = 495
Left = 120
TabIndex = 0
Top = 120
Width = 3855
End
End
Attribute VB_Name = "frmHelp"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub cmdOK_Click()
frmHelp.Hide
End Sub

BIN
tools/SOCEdit/frmHelp.frx
View file

Binary file not shown.

429
tools/SOCEdit/frmHub.frm
View file

@ -1,429 +0,0 @@
VERSION 5.00
Begin VB.Form frmHub
Caption = "SOC Editor"
ClientHeight = 6960
ClientLeft = 60
ClientTop = 345
ClientWidth = 4920
Icon = "frmHub.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 6960
ScaleWidth = 4920
StartUpPosition = 3 'Windows Default
Begin VB.CommandButton cmdCreateBlank
Caption = "Make a &Blank SOC"
Height = 255
Left = 240
TabIndex = 22
Top = 2520
Width = 2055
End
Begin VB.CommandButton cmdUnlockables
Caption = "Edit &Unlockables"
Enabled = 0 'False
Height = 495
Left = 2760
Style = 1 'Graphical
TabIndex = 21
Top = 6360
Width = 1095
End
Begin VB.CommandButton cmdAuthor
Caption = "Enter &Author Info"
Enabled = 0 'False
Height = 495
Left = 120
Style = 1 'Graphical
TabIndex = 19
Top = 3960
Width = 1215
End
Begin VB.CommandButton cmdHelp
Caption = "Getting Starte&d / READ ME FIRST!"
Height = 495
Left = 480
TabIndex = 18
Top = 2880
Width = 1575
End
Begin VB.CommandButton cmdEditCutscenes
Caption = "Edit C&utscenes"
Enabled = 0 'False
Height = 495
Left = 120
TabIndex = 17
Top = 6360
Width = 1215
End
Begin VB.CommandButton cmdCharacterEdit
Caption = "Edit &Character Select Screen"
Enabled = 0 'False
Height = 495
Left = 120
Style = 1 'Graphical
TabIndex = 16
Top = 5760
Width = 1215
End
Begin VB.PictureBox Picture1
Height = 1965
Left = 2760
Picture = "frmHub.frx":0442
ScaleHeight = 1905
ScaleWidth = 1905
TabIndex = 15
Top = 3960
Width = 1965
End
Begin VB.CommandButton cmdSoundEdit
Caption = "Edit &Sounds"
Enabled = 0 'False
Height = 495
Left = 120
TabIndex = 14
Top = 5160
Width = 1215
End
Begin VB.CommandButton cmdEmblemEdit
Caption = "Edit &Emblem Locations"
Enabled = 0 'False
Height = 495
Left = 120
Style = 1 'Graphical
TabIndex = 13
Top = 4560
Width = 1215
End
Begin VB.CommandButton cmdHUDEdit
Caption = "Edit &HUD Coordinates"
Enabled = 0 'False
Height = 495
Left = 1440
Style = 1 'Graphical
TabIndex = 12
Top = 3960
Width = 1215
End
Begin VB.CommandButton cmdMaincfg
Caption = "Edit &Global Game Settings"
Enabled = 0 'False
Height = 495
Left = 1440
Style = 1 'Graphical
TabIndex = 11
Top = 4560
Width = 1215
End
Begin VB.DriveListBox Drive2
Height = 315
Left = 2640
TabIndex = 9
Top = 360
Width = 2175
End
Begin VB.DirListBox Dir2
Height = 1665
Left = 2520
TabIndex = 8
Top = 720
Width = 2295
End
Begin VB.FileListBox File1
Height = 1455
Left = 2520
Pattern = "*.soc"
TabIndex = 7
Top = 2400
Width = 2295
End
Begin VB.DriveListBox Drive1
Height = 315
Left = 120
TabIndex = 6
Top = 360
Width = 2295
End
Begin VB.DirListBox Dir1
Height = 1665
Left = 120
TabIndex = 4
Top = 720
Width = 2295
End
Begin VB.CommandButton cmdAbout
Caption = "&About"
Height = 375
Left = 3960
TabIndex = 3
Top = 6000
Width = 735
End
Begin VB.CommandButton cmdStateEdit
Caption = "Edit St&ates"
Enabled = 0 'False
Height = 495
Left = 1440
TabIndex = 2
Top = 6360
Width = 1215
End
Begin VB.CommandButton cmdLevelHeader
Caption = "Edit &Level Headers"
Enabled = 0 'False
Height = 495
Left = 1440
Style = 1 'Graphical
TabIndex = 1
Top = 5160
Width = 1215
End
Begin VB.CommandButton cmdThingEdit
Caption = "Edit &Things"
Enabled = 0 'False
Height = 495
Left = 1440
TabIndex = 0
Top = 5760
Width = 1215
End
Begin VB.Label lblAuthor
Caption = "Modification By:"
Height = 495
Left = 120
TabIndex = 20
Top = 3480
Width = 2295
End
Begin VB.Label lblSOCFile
Caption = "SOC File to use (double click):"
Height = 255
Left = 2640
TabIndex = 10
Top = 120
Width = 2175
End
Begin VB.Label lblSourcePath
Caption = "Path to SRB2 Source Code:"
Height = 255
Left = 120
TabIndex = 5
Top = 120
Width = 2175
End
End
Attribute VB_Name = "frmHub"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub cmdAbout_Click()
MsgBox App.Title & " v" & App.Major & "." & App.Minor & "." & App.Revision & vbCrLf & "By " & App.CompanyName & vbCrLf & "(SSNTails)" & vbCrLf & App.Comments & vbCrLf & App.FileDescription
End Sub
Private Sub cmdAuthor_Click()
Dim Response As String
Response$ = InputBox("Enter name to appear on credits (type in NOBODY to delete):", "Modification By", GetAuthor)
If Response = "" Then Exit Sub
Response = TrimComplete(Response)
If UCase(Response) = "NOBODY" Then
Call WriteAuthor(True, Response)
lblAuthor.Caption = "Modification By: "
Else
Call WriteAuthor(False, Response)
lblAuthor.Caption = "Modification By: " & Response
End If
End Sub
Private Sub cmdCharacterEdit_Click()
frmCharacterEdit.Show vbModal, Me
End Sub
Private Sub cmdCreateBlank_Click()
Dim socname As String
socname = InputBox("This file will be created in the directory you have selected on the main window." & vbCrLf & vbCrLf & "Enter the filename you want (do not include .SOC at the end):", "Make A Blank SOC")
Trim (socname)
If InStr(LCase(socname), ".soc") > 0 Then
MsgBox "The thing says not to include the .SOC at the end, stupid.", vbOKOnly, "You goofed!"
Exit Sub
End If
If Len(socname) > 0 Then
socname = socname & ".soc"
Dim myFSOSOC As New Scripting.FileSystemObject
Dim tsSOC As TextStream
Set tsSOC = myFSOSOC.OpenTextFile(File1.Path & "\" & socname, ForWriting, True)
tsSOC.Close
Set myFSOSOC = Nothing
MsgBox "Blank SOC named " & socname & " created in " & File1.Path, vbOKOnly, "Success!"
End If
End Sub
Private Sub cmdEditCutscenes_Click()
frmCutsceneEdit.Show vbModal, Me
End Sub
Private Sub cmdEmblemEdit_Click()
frmEmblemEdit.Show vbModal, Me
End Sub
Private Sub cmdHelp_Click()
frmHelp.Show vbModal, Me
End Sub
Private Sub cmdHUDEdit_Click()
frmHUDEdit.Show vbModal, Me
End Sub
Private Sub cmdLevelHeader_Click()
frmLevelHeader.Show vbModal, Me
End Sub
Private Sub cmdMaincfg_Click()
frmMaincfg.Show vbModal, Me
End Sub
Private Sub cmdSoundEdit_Click()
frmSoundEdit.Show vbModal, Me
End Sub
Private Sub cmdStateEdit_Click()
frmStateEdit.Show vbModal, Me
End Sub
Private Sub cmdThingEdit_Click()
frmThingEdit.Show vbModal, Me
End Sub
Private Sub cmdUnlockables_Click()
frmUnlockablesEdit.Show vbModal, Me
End Sub
Private Sub Dir1_Change()
SourcePath = Dir1.Path
End Sub
Private Sub Dir2_Change()
File1.Path = Dir2.Path
End Sub
Private Sub Drive1_Change()
Dir1.Path = Drive1.Drive
End Sub
Private Sub Drive2_Change()
Dir2.Path = Drive2.Drive
End Sub
Private Sub File1_DblClick()
SOCTemp = File1.Path & "\" & "socedit.tmp"
SOCFile = File1.Path & "\" & File1.List(File1.ListIndex)
MsgBox "You are now using the file: " & vbCrLf & SOCFile
cmdLevelHeader.Enabled = True
cmdThingEdit.Enabled = True
cmdStateEdit.Enabled = True
cmdHUDEdit.Enabled = True
cmdMaincfg.Enabled = True
cmdEmblemEdit.Enabled = True
cmdSoundEdit.Enabled = True
cmdCharacterEdit.Enabled = True
cmdEditCutscenes.Enabled = True
cmdAuthor.Enabled = True
cmdUnlockables.Enabled = True
lblAuthor.Caption = "Modification By: " & GetAuthor
End Sub
Private Sub Form_Load()
SourcePath = App.Path
Dir1.Path = SourcePath
End Sub
Private Function GetAuthor() As String
Dim myFSO As New Scripting.FileSystemObject
Dim ts As TextStream
Dim line As String
Dim word As String
Dim word2 As String
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) = "MODBY" Then
GetAuthor = word2
Exit Do
End If
Loop
ts.Close
Set myFSO = Nothing
End Function
Private Sub WriteAuthor(Remove As Boolean, ModderName As String)
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
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 entry exists in the SOC, delete it.
If word <> "MODBY" Then
tsTarget.WriteLine line
End If
Loop
tsSource.Close
Set myFSOSource = Nothing
If Remove = False Then
If line <> "" Then tsTarget.WriteLine ""
tsTarget.WriteLine "ModBy " & ModderName
End If
tsTarget.Close
Set myFSOTarget = Nothing
FileCopy SOCTemp, SOCFile
Kill SOCTemp
If Remove = True Then
MsgBox "Name removed."
Else
MsgBox "Name Saved."
End If
End Sub

BIN
tools/SOCEdit/frmHub.frx
View file

Binary file not shown.

839
tools/SOCEdit/frmLevelHeader.frm
View file

@ -1,839 +0,0 @@
VERSION 5.00
Begin VB.Form frmLevelHeader
Caption = "Level Header Info"
ClientHeight = 5250
ClientLeft = 60
ClientTop = 345
ClientWidth = 7650
Icon = "frmLevelHeader.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 5250
ScaleWidth = 7650
StartUpPosition = 3 'Windows Default
Begin VB.TextBox txtRunSOC
Height = 285
Left = 6240
MaxLength = 8
TabIndex = 49
Top = 4680
Width = 1215
End
Begin VB.CheckBox chkLevelSelect
Caption = "Show on Host Game selection menu"
Height = 375
Left = 1680
TabIndex = 48
Top = 4800
Width = 1935
End
Begin VB.CheckBox chkTimeAttack
Caption = "Include in Time Attack calculations"
Height = 255
Left = 1680
TabIndex = 47
Top = 4440
Width = 2775
End
Begin VB.CheckBox chkNoReload
Caption = "Retain level state when player dies."
Height = 255
Left = 1680
TabIndex = 46
Top = 4080
Width = 2895
End
Begin VB.CommandButton cmdSave
Caption = "&Save Map"
Height = 735
Left = 120
Style = 1 'Graphical
TabIndex = 45
Top = 4440
Width = 1215
End
Begin VB.CommandButton cmdRename
Caption = "&Rename Map"
Height = 375
Left = 120
TabIndex = 44
Top = 3960
Width = 1215
End
Begin VB.CommandButton cmdDelete
Caption = "&Delete Map"
Height = 375
Left = 120
TabIndex = 43
Top = 3480
Width = 1215
End
Begin VB.CommandButton cmdAddMap
Caption = "&Add Map"
Height = 375
Left = 120
TabIndex = 42
Top = 3000
Width = 1215
End
Begin VB.CheckBox chkNossmusic
Caption = "Disable Super Sonic music changes"
Height = 255
Left = 4560
TabIndex = 29
Top = 1200
Width = 2895
End
Begin VB.CheckBox chkHidden
Caption = "Don't show on level selection menu"
Height = 255
Left = 4560
TabIndex = 28
Top = 480
Width = 2895
End
Begin VB.TextBox txtCountdown
Height = 285
Left = 6360
MaxLength = 3
TabIndex = 26
Top = 840
Width = 735
End
Begin VB.TextBox txtCutscenenum
Height = 285
Left = 4440
MaxLength = 3
TabIndex = 25
Top = 3720
Width = 495
End
Begin VB.TextBox txtPrecutscenenum
Height = 285
Left = 2640
MaxLength = 3
TabIndex = 22
Top = 3720
Width = 495
End
Begin VB.CheckBox chkScriptislump
Caption = "Script is a lump in WAD, not a file"
Height = 255
Left = 1680
TabIndex = 21
Top = 3360
Width = 2775
End
Begin VB.TextBox txtScriptname
Height = 285
Left = 2640
MaxLength = 191
TabIndex = 19
Top = 3000
Width = 1455
End
Begin VB.TextBox txtSkynum
Height = 285
Left = 2640
MaxLength = 4
TabIndex = 17
Top = 2640
Width = 495
End
Begin VB.ComboBox cmbWeather
Height = 315
ItemData = "frmLevelHeader.frx":0442
Left = 2640
List = "frmLevelHeader.frx":0458
TabIndex = 15
Top = 2280
Width = 2295
End
Begin VB.TextBox txtForcecharacter
Height = 285
Left = 2640
MaxLength = 2
TabIndex = 13
Top = 1920
Width = 495
End
Begin VB.ComboBox cmbMusicslot
Height = 315
Left = 2640
TabIndex = 11
Top = 1560
Width = 1815
End
Begin VB.TextBox txtNextlevel
Height = 285
Left = 2640
MaxLength = 4
TabIndex = 9
Top = 1200
Width = 615
End
Begin VB.Frame frmTypeOfLevel
Caption = "Type of Level"
Height = 2775
Left = 5040
TabIndex = 8
Top = 1680
Width = 2535
Begin VB.CheckBox chkTypeoflevel
Caption = "Christmas"
Height = 255
Index = 11
Left = 1440
TabIndex = 41
Tag = "1024"
Top = 960
Width = 975
End
Begin VB.CheckBox chkTypeoflevel
Caption = "2D"
Height = 255
Index = 10
Left = 1440
TabIndex = 40
Tag = "512"
Top = 720
Width = 735
End
Begin VB.CheckBox chkTypeoflevel
Caption = "Mario"
Height = 255
Index = 9
Left = 120
TabIndex = 39
Tag = "256"
Top = 2400
Width = 1455
End
Begin VB.CheckBox chkTypeoflevel
Caption = "Sonic Adventure"
Height = 255
Index = 8
Left = 120
TabIndex = 38
Tag = "128"
Top = 2160
Width = 1575
End
Begin VB.CheckBox chkTypeoflevel
Caption = "NiGHTS"
Height = 255
Index = 7
Left = 120
TabIndex = 37
Tag = "64"
Top = 1920
Width = 1335
End
Begin VB.CheckBox chkTypeoflevel
Caption = "Chaos"
Height = 255
Index = 6
Left = 120
TabIndex = 36
Tag = "32"
Top = 1680
Width = 1455
End
Begin VB.CheckBox chkTypeoflevel
Caption = "Capture the Flag"
Height = 255
Index = 5
Left = 120
TabIndex = 35
Tag = "16"
Top = 1440
Width = 1695
End
Begin VB.CheckBox chkTypeoflevel
Caption = "Tag"
Height = 255
Index = 4
Left = 120
TabIndex = 34
Tag = "8"
Top = 1200
Width = 1215
End
Begin VB.CheckBox chkTypeoflevel
Caption = "Match"
Height = 255
Index = 3
Left = 120
TabIndex = 33
Tag = "4"
Top = 960
Width = 855
End
Begin VB.CheckBox chkTypeoflevel
Caption = "Race"
Height = 255
Index = 2
Left = 120
TabIndex = 32
Tag = "2"
Top = 720
Width = 855
End
Begin VB.CheckBox chkTypeoflevel
Caption = "Cooperative"
Height = 255
Index = 1
Left = 120
TabIndex = 31
Tag = "1"
Top = 480
Width = 1215
End
Begin VB.CheckBox chkTypeoflevel
Caption = "Single Player"
Height = 255
Index = 0
Left = 120
TabIndex = 30
Tag = "4096"
Top = 240
Width = 1215
End
End
Begin VB.CheckBox chkNozone
Caption = "Don't show ""ZONE"" after Level Name"
Height = 255
Left = 4560
TabIndex = 7
Top = 120
Width = 3015
End
Begin VB.TextBox txtAct
Height = 285
Left = 2640
MaxLength = 2
TabIndex = 5
Top = 840
Width = 495
End
Begin VB.TextBox txtInterscreen
Height = 285
Left = 2640
MaxLength = 8
TabIndex = 3
Top = 480
Width = 1335
End
Begin VB.ListBox lstMaps
Height = 2790
Left = 120
Sorted = -1 'True
TabIndex = 2
Top = 120
Width = 1215
End
Begin VB.TextBox txtLevelName
Height = 285
Left = 2640
MaxLength = 32
TabIndex = 0
Top = 120
Width = 1815
End
Begin VB.Label lblRunSOC
Alignment = 1 'Right Justify
Caption = "Run SOC at level load (lump name):"
Height = 495
Left = 4440
TabIndex = 50
Top = 4560
Width = 1695
End
Begin VB.Label lblCountdown
Alignment = 1 'Right Justify
Caption = "Level Timer (seconds):"
Height = 255
Left = 4560
TabIndex = 27
Top = 840
Width = 1695
End
Begin VB.Label lblCutscenenum
Alignment = 1 'Right Justify
Caption = "Cutscene to play after level:"
Height = 495
Left = 3240
TabIndex = 24
Top = 3600
Width = 1095
End
Begin VB.Label lblPrecutscenenum
Alignment = 1 'Right Justify
Caption = "Cutscene to play before level:"
Height = 375
Left = 1320
TabIndex = 23
Top = 3600
Width = 1215
End
Begin VB.Label lblScriptName
Alignment = 1 'Right Justify
Caption = "Script Name:"
Height = 255
Left = 1440
TabIndex = 20
Top = 3000
Width = 1095
End
Begin VB.Label lblSkynum
Alignment = 1 'Right Justify
Caption = "Sky #:"
Height = 255
Left = 1800
TabIndex = 18
Top = 2640
Width = 735
End
Begin VB.Label Label1
Alignment = 1 'Right Justify
Caption = "Weather:"
Height = 255
Left = 1680
TabIndex = 16
Top = 2280
Width = 855
End
Begin VB.Label lblForcecharacter
Caption = "Force Character #:"
Height = 375
Left = 1440
TabIndex = 14
Top = 1800
Width = 1095
End
Begin VB.Label lblMusicslot
Alignment = 1 'Right Justify
Caption = "Music:"
Height = 255
Left = 1800
TabIndex = 12
Top = 1560
Width = 735
End
Begin VB.Label lblNextlevel
Alignment = 1 'Right Justify
Caption = "Next Level:"
Height = 255
Left = 1440
TabIndex = 10
Top = 1200
Width = 1095
End
Begin VB.Label lblAct
Alignment = 1 'Right Justify
Caption = "Act:"
Height = 255
Left = 2040
TabIndex = 6
Top = 840
Width = 495
End
Begin VB.Label lblInterscreen
Alignment = 1 'Right Justify
Caption = "Intermission BG:"
Height = 255
Left = 1320
TabIndex = 4
Top = 480
Width = 1215
End
Begin VB.Label lblLevelName
Alignment = 1 'Right Justify
Caption = "Level Name:"
Height = 255
Left = 1560
TabIndex = 1
Top = 120
Width = 975
End
End
Attribute VB_Name = "frmLevelHeader"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub cmdAddMap_Click()
Dim Response As String
Dim NewNum As Integer
Response$ = InputBox("Enter the new level (NUMBER ONLY):")
If Response = "" Then
Exit Sub
End If
NewNum = Val(TrimComplete(Response))
lstMaps.AddItem "Level " & NewNum
lstMaps.ListIndex = lstMaps.ListCount - 1
End Sub
Private Sub cmdDelete_Click()
Dim i As Integer
If MsgBox("Delete this level header?", vbYesNo) = vbNo Then
Exit Sub
End If
i = InStr(lstMaps.List(lstMaps.ListIndex), " ") + 1
i = Mid(lstMaps.List(lstMaps.ListIndex), i, Len(lstMaps.List(lstMaps.ListIndex)) - i + 1)
i = Val(i)
Call WriteLevel(True, i)
lstMaps.RemoveItem lstMaps.ListIndex
If lstMaps.ListCount > 0 Then
lstMaps.ListIndex = 0
End If
End Sub
Private Sub cmdRename_Click()
Dim Response As String
Dim NewNum As Integer
Dim i As Integer
Response$ = InputBox("Rename level to (NUMBER ONLY):")
If Response = "" Then
Exit Sub
End If
NewNum = Val(TrimComplete(Response))
i = InStr(lstMaps.List(lstMaps.ListIndex), " ") + 1
i = Mid(lstMaps.List(lstMaps.ListIndex), i, Len(lstMaps.List(lstMaps.ListIndex)) - i + 1)
i = Val(i)
Call WriteLevel(True, i)
lstMaps.List(lstMaps.ListIndex) = "Level " & NewNum
Call cmdSave_Click
End Sub
Private Sub cmdSave_Click()
Dim i As Integer
i = InStr(lstMaps.List(lstMaps.ListIndex), " ") + 1
i = Val(Mid(lstMaps.List(lstMaps.ListIndex), i, Len(lstMaps.List(lstMaps.ListIndex)) - i + 1))
Call WriteLevel(False, i)
End Sub
Private Sub Form_Load()
Call LoadMusic
Call LoadSOCMaps
If lstMaps.ListCount > 0 Then lstMaps.ListIndex = 0
End Sub
Private Sub LoadSOCMaps()
Dim myFSO As New Scripting.FileSystemObject
Dim ts As TextStream
Dim line As String
Dim word As String
Dim word2 As String
Set ts = myFSO.OpenTextFile(SOCFile, ForReading, False)
lstMaps.Clear
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) = "LEVEL" Then
lstMaps.AddItem ("Level " & Val(word2))
End If
Loop
ts.Close
Set myFSO = Nothing
End Sub
Private Sub LoadMusic()
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("sounds.h", ForReading, False)
Do While InStr(ts.ReadLine, "Music list (don't edit this comment!)") = 0
Loop
ts.SkipLine ' typedef enum
ts.SkipLine ' {
line = ts.ReadLine
number = 0
cmbMusicslot.Clear
Do While InStr(line, "NUMMUSIC") = 0
startclip = InStr(line, "mus_")
If InStr(line, "mus_") <> 0 Then
endclip = InStr(line, ",")
line = Mid(line, startclip, endclip - startclip)
addstring = number & " - " & line
cmbMusicslot.AddItem addstring
number = number + 1
End If
line = ts.ReadLine
Loop
ts.Close
Set myFSO = Nothing
End Sub
Private Sub ClearForm()
Dim j As Integer
txtLevelName.Text = ""
txtInterscreen.Text = ""
txtAct.Text = ""
txtNextlevel.Text = ""
cmbMusicslot.Text = ""
txtForcecharacter.Text = ""
cmbWeather.Text = ""
txtSkynum.Text = ""
txtScriptname.Text = ""
chkScriptislump.Value = 0
txtPrecutscenenum.Text = ""
txtCutscenenum.Text = ""
txtRunSOC.Text = ""
chkNozone.Value = 0
chkHidden.Value = 0
txtCountdown.Text = ""
chkNossmusic.Value = 0
chkNoReload.Value = 0
chkTimeAttack.Value = 0
chkLevelSelect = 0
For j = 0 To 11
chkTypeoflevel(j).Value = 0
Next j
End Sub
Private Sub lstMaps_Click()
Dim startclip As Integer
Call ClearForm
startclip = InStr(lstMaps.List(lstMaps.ListIndex), " ")
Call LoadSOCMapInfo(Val(Mid(lstMaps.List(lstMaps.ListIndex), startclip + 1, Len(lstMaps.List(lstMaps.ListIndex)))))
End Sub
Private Sub LoadSOCMapInfo(num As Integer)
Dim myFSO As New Scripting.FileSystemObject
Dim ts As TextStream
Dim line As String
Dim word As String
Dim word2 As String
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 = UCase(FirstToken(line))
word2 = UCase(SecondToken(line))
If word = "LEVEL" Then
If Val(word2) = num Then
Do While Len(line) > 0 And Not ts.AtEndOfStream
line = ts.ReadLine
word = UCase(FirstToken(line))
word2 = UCase(SecondTokenEqual(line))
If word = "LEVELNAME" Then
txtLevelName.Text = word2
ElseIf word = "INTERSCREEN" Then
txtInterscreen.Text = word2
ElseIf word = "ACT" Then
txtAct.Text = Val(word2)
ElseIf word = "NOZONE" Then
chkNozone.Value = Val(word2)
ElseIf word = "TYPEOFLEVEL" Then
ProcessMapFlags (Val(word2))
ElseIf word = "NEXTLEVEL" Then
txtNextlevel.Text = Val(word2)
ElseIf word = "MUSICSLOT" Then
cmbMusicslot.ListIndex = Val(word2)
ElseIf word = "FORCECHARACTER" Then
txtForcecharacter.Text = Val(word2)
ElseIf word = "WEATHER" Then
cmbWeather.ListIndex = Val(word2)
ElseIf word = "SKYNUM" Then
txtSkynum.Text = Val(word2)
ElseIf word = "SCRIPTNAME" Then
txtScriptname.Text = word2
ElseIf word = "SCRIPTISLUMP" Then
chkScriptislump.Value = Val(word2)
ElseIf word = "PRECUTSCENENUM" Then
txtPrecutscenenum.Text = Val(word2)
ElseIf word = "CUTSCENENUM" Then
txtCutscenenum.Text = Val(word2)
ElseIf word = "COUNTDOWN" Then
txtCountdown.Text = Val(word2)
ElseIf word = "HIDDEN" Then
chkHidden.Value = Val(word2)
ElseIf word = "NOSSMUSIC" Then
chkNossmusic.Value = Val(word2)
ElseIf word = "NORELOAD" Then
chkNoReload.Value = Val(word2)
ElseIf word = "TIMEATTACK" Then
chkTimeAttack.Value = Val(word2)
ElseIf word = "LEVELSELECT" Then
chkLevelSelect.Value = Val(word2)
ElseIf word = "RUNSOC" Then
txtRunSOC.Text = 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
End If
Loop
ts.Close
Set myFSO = Nothing
End Sub
Private Sub ProcessMapFlags(flags As Long)
Dim j As Integer
For j = 0 To 11
If flags And chkTypeoflevel(j).Tag Then
chkTypeoflevel(j).Value = 1
Else
chkTypeoflevel(j).Value = 0
End If
Next j
End Sub
Private Sub WriteLevel(Remove As Boolean, Mapnum 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 i As Integer
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))
i = InStr(lstMaps.List(lstMaps.ListIndex), " ") + 1
i = Mid(lstMaps.List(lstMaps.ListIndex), i, Len(lstMaps.List(lstMaps.ListIndex)) - i + 1)
i = Val(i)
'If the current level exists in the SOC, delete it.
If word = "LEVEL" And Val(word2) = i Then
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 UCase(lstMaps.List(lstMaps.ListIndex))
txtLevelName.Text = TrimComplete(txtLevelName.Text)
txtInterscreen.Text = TrimComplete(txtInterscreen.Text)
txtAct.Text = TrimComplete(txtAct.Text)
txtNextlevel.Text = TrimComplete(txtNextlevel.Text)
cmbMusicslot.Text = TrimComplete(cmbMusicslot.Text)
txtForcecharacter.Text = TrimComplete(txtForcecharacter.Text)
cmbWeather.Text = TrimComplete(cmbWeather.Text)
txtSkynum.Text = TrimComplete(txtSkynum.Text)
txtScriptname.Text = TrimComplete(txtScriptname.Text)
txtPrecutscenenum.Text = TrimComplete(txtPrecutscenenum.Text)
txtCutscenenum.Text = TrimComplete(txtCutscenenum.Text)
txtCountdown.Text = TrimComplete(txtCountdown.Text)
txtRunSOC.Text = TrimComplete(txtRunSOC.Text)
If txtLevelName.Text <> "" Then tsTarget.WriteLine "LEVELNAME = " & txtLevelName.Text
If txtInterscreen.Text <> "" Then tsTarget.WriteLine "INTERSCREEN = " & txtInterscreen.Text
If txtAct.Text <> "" Then tsTarget.WriteLine "ACT = " & Val(txtAct.Text)
If txtNextlevel.Text <> "" Then tsTarget.WriteLine "NEXTLEVEL = " & Val(txtNextlevel.Text)
If cmbMusicslot.Text <> "" Then tsTarget.WriteLine "MUSICSLOT = " & cmbMusicslot.ListIndex
If txtForcecharacter.Text <> "" Then tsTarget.WriteLine "FORCECHARACTER = " & Val(txtForcecharacter.Text)
If cmbWeather.Text <> "" Then tsTarget.WriteLine "WEATHER = " & cmbWeather.ListIndex
If txtSkynum.Text <> "" Then tsTarget.WriteLine "SKYNUM = " & Val(txtSkynum.Text)
If txtScriptname.Text <> "" Then tsTarget.WriteLine "SCRIPTNAME = " & txtScriptname.Text
If txtPrecutscenenum.Text <> "" Then tsTarget.WriteLine "PRECUTSCENENUM = " & Val(txtPrecutscenenum.Text)
If txtCutscenenum.Text <> "" Then tsTarget.WriteLine "CUTSCENENUM = " & Val(txtCutscenenum.Text)
If txtCountdown.Text <> "" Then tsTarget.WriteLine "COUNTDOWN = " & Val(txtCountdown.Text)
If chkScriptislump.Value = 1 Then tsTarget.WriteLine "SCRIPTISLUMP = 1"
If chkNozone.Value = 1 Then tsTarget.WriteLine "NOZONE = 1"
If chkHidden.Value = 1 Then tsTarget.WriteLine "HIDDEN = 1"
If chkNossmusic.Value = 1 Then tsTarget.WriteLine "NOSSMUSIC = 1"
If chkNoReload.Value = 1 Then tsTarget.WriteLine "NORELOAD = 1"
If chkTimeAttack.Value = 1 Then tsTarget.WriteLine "TIMEATTACK = 1"
If chkLevelSelect.Value = 1 Then tsTarget.WriteLine "LEVELSELECT = 1"
If txtRunSOC.Text <> "" Then tsTarget.WriteLine "RUNSOC = " & txtRunSOC.Text
flags = 0
For i = 0 To 11
If chkTypeoflevel(i).Value = 1 Then
flags = flags + Val(chkTypeoflevel(i).Tag)
End If
Next
If flags > 0 Then tsTarget.WriteLine "TYPEOFLEVEL = " & flags
End If
tsTarget.Close
Set myFSOTarget = Nothing
FileCopy SOCTemp, SOCFile
Kill SOCTemp
If Remove = True Then
MsgBox "Level Deleted."
Else
MsgBox "Level Saved."
End If
End Sub

BIN
tools/SOCEdit/frmLevelHeader.frx
View file

Binary file not shown.

644
tools/SOCEdit/frmMaincfg.frm
View file

@ -1,644 +0,0 @@
VERSION 5.00
Begin VB.Form frmMaincfg
Caption = "Global Game Settings"
ClientHeight = 5295
ClientLeft = 60
ClientTop = 345
ClientWidth = 9360
Icon = "frmMaincfg.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 5295
ScaleWidth = 9360
StartUpPosition = 3 'Windows Default
Begin VB.Frame frmReset
Caption = "Reset Data (Be sure this is at the TOP of your SOC)"
Height = 975
Left = 4800
TabIndex = 43
Top = 4200
Width = 4455
Begin VB.CheckBox chkReset
Caption = "Thing Properties"
Height = 255
Index = 2
Left = 1680
TabIndex = 46
Tag = "4"
Top = 240
Width = 1575
End
Begin VB.CheckBox chkReset
Caption = "States"
Height = 255
Index = 1
Left = 240
TabIndex = 45
Tag = "2"
Top = 600
Width = 1335
End
Begin VB.CheckBox chkReset
Caption = "Sprite Names"
Height = 255
Index = 0
Left = 240
TabIndex = 44
Tag = "1"
Top = 240
Width = 1575
End
End
Begin VB.CheckBox chkDisableSpeedAdjust
Caption = "Disable speed adjustment of player animations depending on how fast they are moving."
Height = 375
Left = 1080
TabIndex = 42
Top = 4200
Width = 3615
End
Begin VB.TextBox txtTitleScrollSpeed
Height = 285
Left = 4080
TabIndex = 41
Top = 1920
Width = 495
End
Begin VB.CheckBox chkLoopTitle
Caption = "Loop the title screen music?"
Height = 195
Left = 1080
TabIndex = 39
Top = 3840
Width = 2415
End
Begin VB.TextBox txtCreditsCutscene
Height = 285
Left = 4080
TabIndex = 37
Top = 1560
Width = 495
End
Begin VB.CommandButton cmdSave
Caption = "&Save"
Height = 495
Left = 120
TabIndex = 36
Top = 3120
Width = 735
End
Begin VB.CommandButton cmdReload
Caption = "&Reload"
Height = 495
Left = 120
TabIndex = 35
Top = 2520
Width = 735
End
Begin VB.TextBox txtNumemblems
Height = 285
Left = 4080
MaxLength = 2
TabIndex = 33
Top = 3360
Width = 495
End
Begin VB.TextBox txtGamedata
Height = 285
Left = 3240
MaxLength = 64
TabIndex = 31
Top = 2880
Width = 1335
End
Begin VB.TextBox txtExeccfg
Height = 285
Left = 3240
TabIndex = 9
Top = 2400
Width = 1335
End
Begin VB.Frame frmTimers
Caption = "Timers (35 = 1 second)"
Height = 3975
Left = 4800
TabIndex = 8
Top = 120
Width = 4455
Begin VB.TextBox txtGameovertics
Height = 285
Left = 3000
TabIndex = 29
Top = 3480
Width = 1335
End
Begin VB.TextBox txtHelpertics
Height = 285
Left = 3000
TabIndex = 27
Top = 3120
Width = 1335
End
Begin VB.TextBox txtParalooptics
Height = 285
Left = 3000
TabIndex = 25
Top = 2760
Width = 1335
End
Begin VB.TextBox txtExtralifetics
Height = 285
Left = 3000
TabIndex = 23
Top = 2400
Width = 1335
End
Begin VB.TextBox txtSpacetimetics
Height = 285
Left = 3000
TabIndex = 21
Top = 2040
Width = 1335
End
Begin VB.TextBox txtUnderwatertics
Height = 285
Left = 3000
TabIndex = 19
Top = 1680
Width = 1335
End
Begin VB.TextBox txtTailsflytics
Height = 285
Left = 3000
TabIndex = 17
Top = 1320
Width = 1335
End
Begin VB.TextBox txtFlashingtics
Height = 285
Left = 3000
TabIndex = 15
Top = 960
Width = 1335
End
Begin VB.TextBox txtSneakertics
Height = 285
Left = 3000
TabIndex = 13
Top = 600
Width = 1335
End
Begin VB.TextBox txtInvulntics
Height = 285
Left = 3000
TabIndex = 11
Top = 240
Width = 1335
End
Begin VB.Label lblGameovertics
Alignment = 1 'Right Justify
Caption = "Game Over Screen Time:"
Height = 255
Left = 960
TabIndex = 30
Top = 3480
Width = 1935
End
Begin VB.Label lblHelpertics
Alignment = 1 'Right Justify
Caption = "NiGHTS Nightopian Helper Time:"
Height = 255
Left = 240
TabIndex = 28
Top = 3120
Width = 2655
End
Begin VB.Label lblParalooptics
Alignment = 1 'Right Justify
Caption = "NiGHTS Paraloop Powerup Time:"
Height = 255
Left = 360
TabIndex = 26
Top = 2760
Width = 2535
End
Begin VB.Label lblExtralifetics
Alignment = 1 'Right Justify
Caption = "Extra Life Music Duration:"
Height = 255
Left = 960
TabIndex = 24
Top = 2400
Width = 1935
End
Begin VB.Label lblSpacetimetics
Alignment = 1 'Right Justify
Caption = "Space Breath Timeout:"
Height = 255
Left = 1200
TabIndex = 22
Top = 2040
Width = 1695
End
Begin VB.Label lblUnderwatertics
Alignment = 1 'Right Justify
Caption = "Underwater Breath Timeout:"
Height = 255
Left = 840
TabIndex = 20
Top = 1680
Width = 2055
End
Begin VB.Label lblTailsflytics
Alignment = 1 'Right Justify
Caption = "Tails Flying Time:"
Height = 255
Left = 1440
TabIndex = 18
Top = 1320
Width = 1455
End
Begin VB.Label lblFlashingtics
Alignment = 1 'Right Justify
Caption = "Flashing Time After Being Hit:"
Height = 255
Left = 360
TabIndex = 16
Top = 960
Width = 2535
End
Begin VB.Label lblSneakertics
Alignment = 1 'Right Justify
Caption = "Super Sneakers Time:"
Height = 255
Left = 240
TabIndex = 14
Top = 600
Width = 2655
End
Begin VB.Label lblInvulntics
Alignment = 1 'Right Justify
Caption = "Invincibility Time:"
Height = 255
Left = 360
TabIndex = 12
Top = 240
Width = 2535
End
End
Begin VB.TextBox txtIntrotoplay
Height = 285
Left = 4080
TabIndex = 6
Top = 1200
Width = 495
End
Begin VB.TextBox txtRacestage_start
Height = 285
Left = 4080
MaxLength = 4
TabIndex = 4
Top = 840
Width = 495
End
Begin VB.TextBox txtSpstage_start
Height = 285
Left = 4080
MaxLength = 4
TabIndex = 2
Top = 480
Width = 495
End
Begin VB.TextBox txtSstage_start
Height = 285
Left = 4080
MaxLength = 4
TabIndex = 0
Top = 120
Width = 495
End
Begin VB.Label lblTitleScrollSpeed
Alignment = 1 'Right Justify
Caption = "Scroll speed of title background:"
Height = 255
Left = 1560
TabIndex = 40
Top = 1920
Width = 2415
End
Begin VB.Label lblCreditsCutscene
Alignment = 1 'Right Justify
Caption = "Cutscene # to replace credits with:"
Height = 255
Left = 1080
TabIndex = 38
Top = 1560
Width = 2895
End
Begin VB.Label lblNumemblems
Alignment = 1 'Right Justify
Caption = "# of LEVEL Emblems (Gamedata field must also be filled out):"
Height = 375
Left = 1440
TabIndex = 34
Top = 3240
Width = 2535
End
Begin VB.Label lblGamedata
Alignment = 1 'Right Justify
Caption = "Gamedata file (to save mod emblems and time data):"
Height = 375
Left = 960
TabIndex = 32
Top = 2760
Width = 2175
End
Begin VB.Label lblExeccfg
Alignment = 1 'Right Justify
Caption = "CFG file to instantly execute upon loading this SOC:"
Height = 495
Left = 960
TabIndex = 10
Top = 2280
Width = 2175
End
Begin VB.Label lblIntrotoplay
Alignment = 1 'Right Justify
Caption = "Cutscene # to use for introduction:"
Height = 255
Left = 1440
TabIndex = 7
Top = 1200
Width = 2535
End
Begin VB.Label lblRacestage_start
Alignment = 1 'Right Justify
Caption = "Racing mode starts/loops back to this map #:"
Height = 255
Left = 720
TabIndex = 5
Top = 840
Width = 3255
End
Begin VB.Label lblSpstage_start
Alignment = 1 'Right Justify
Caption = "Single Player Game Starts on this map #:"
Height = 255
Left = 1080
TabIndex = 3
Top = 480
Width = 2895
End
Begin VB.Label lblSstage_start
Alignment = 1 'Right Justify
Caption = "First Special Stage Map #:"
Height = 255
Left = 2040
TabIndex = 1
Top = 120
Width = 1935
End
End
Attribute VB_Name = "frmMaincfg"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Private Sub cmdReload_Click()
Call Reload
End Sub
Private Sub cmdSave_Click()
Call WriteSettings
End Sub
Private Sub Form_Load()
Call Reload
End Sub
Private Sub ClearForm()
Dim i As Integer
txtSstage_start.Text = ""
txtSpstage_start.Text = ""
txtRacestage_start.Text = ""
txtIntrotoplay.Text = ""
txtExeccfg.Text = ""
txtGamedata.Text = ""
txtNumemblems.Text = ""
txtInvulntics.Text = ""
txtSneakertics.Text = ""
txtFlashingtics.Text = ""
txtTailsflytics.Text = ""
txtUnderwatertics.Text = ""
txtSpacetimetics.Text = ""
txtExtralifetics.Text = ""
txtParalooptics.Text = ""
txtHelpertics.Text = ""
txtGameovertics.Text = ""
txtCreditsCutscene.Text = ""
txtTitleScrollSpeed.Text = ""
chkLoopTitle.Value = 0
chkDisableSpeedAdjust.Value = 0
For i = 0 To 2
chkReset(i).Value = 0
Next i
End Sub
Private Sub Reload()
Call ClearForm
Call ReadSOCMaincfg
End Sub
Private Sub ReadSOCMaincfg()
Dim myFSO As New Scripting.FileSystemObject
Dim ts As TextStream
Dim line As String
Dim word As String
Dim word2 As String
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) = "MAINCFG" Then
Do While Len(line) > 0 And Not ts.AtEndOfStream
line = ts.ReadLine
word = UCase(FirstToken(line))
word2 = UCase(SecondTokenEqual(line))
If word = "SSTAGE_START" Then
txtSstage_start.Text = Val(word2)
ElseIf word = "SPSTAGE_START" Then
txtSpstage_start.Text = Val(word2)
ElseIf word = "RACESTAGE_START" Then
txtRacestage_start.Text = Val(word2)
ElseIf word = "INVULNTICS" Then
txtInvulntics.Text = Val(word2)
ElseIf word = "SNEAKERTICS" Then
txtSneakertics.Text = Val(word2)
ElseIf word = "FLASHINGTICS" Then
txtFlashingtics.Text = Val(word2)
ElseIf word = "TAILSFLYTICS" Then
txtTailsflytics.Text = Val(word2)
ElseIf word = "UNDERWATERTICS" Then
txtUnderwatertics.Text = Val(word2)
ElseIf word = "SPACETIMETICS" Then
txtSpacetimetics.Text = Val(word2)
ElseIf word = "EXTRALIFETICS" Then
txtExtralifetics.Text = Val(word2)
ElseIf word = "PARALOOPTICS" Then
txtParalooptics.Text = Val(word2)
ElseIf word = "HELPERTICS" Then
txtHelpertics.Text = Val(word2)
ElseIf word = "GAMEOVERTICS" Then
txtGameovertics.Text = Val(word2)
ElseIf word = "INTROTOPLAY" Then
txtIntrotoplay.Text = Val(word2)
ElseIf word = "CREDITSCUTSCENE" Then
txtCreditsCutscene.Text = Val(word2)
ElseIf word = "TITLESCROLLSPEED" Then
txtTitleScrollSpeed.Text = Val(word2)
ElseIf word = "LOOPTITLE" Then
chkLoopTitle.Value = Val(word2)
ElseIf word = "DISABLESPEEDADJUST" Then
chkDisableSpeedAdjust.Value = Val(word2)
ElseIf word = "GAMEDATA" Then
txtGamedata.Text = word2
ElseIf word = "NUMEMBLEMS" Then
txtNumemblems.Text = Val(word2)
ElseIf word = "RESETDATA" Then
Dim resetflags As Integer
Dim z As Integer
resetflags = Val(word2)
For z = 0 To 2
If resetflags And chkReset(z).Tag Then
chkReset(z).Value = 1
Else
chkReset(z).Value = 0
End If
Next z
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 WriteSettings()
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 i As Integer
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 category exists in the SOC, delete it.
If word = "MAINCFG" Then
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 line <> "" Then tsTarget.WriteLine ""
tsTarget.WriteLine "MAINCFG CATEGORY"
txtSstage_start.Text = TrimComplete(txtSstage_start.Text)
txtSpstage_start.Text = TrimComplete(txtSpstage_start.Text)
txtRacestage_start.Text = TrimComplete(txtRacestage_start.Text)
txtIntrotoplay.Text = TrimComplete(txtIntrotoplay.Text)
txtCreditsCutscene.Text = TrimComplete(txtCreditsCutscene.Text)
txtExeccfg.Text = TrimComplete(txtExeccfg.Text)
txtGamedata.Text = TrimComplete(txtGamedata.Text)
txtNumemblems.Text = TrimComplete(txtNumemblems.Text)
txtInvulntics.Text = TrimComplete(txtInvulntics.Text)
txtSneakertics.Text = TrimComplete(txtSneakertics.Text)
txtFlashingtics.Text = TrimComplete(txtFlashingtics.Text)
txtTailsflytics.Text = TrimComplete(txtTailsflytics.Text)
txtUnderwatertics.Text = TrimComplete(txtUnderwatertics.Text)
txtSpacetimetics.Text = TrimComplete(txtSpacetimetics.Text)
txtExtralifetics.Text = TrimComplete(txtExtralifetics.Text)
txtParalooptics.Text = TrimComplete(txtParalooptics.Text)
txtHelpertics.Text = TrimComplete(txtHelpertics.Text)
txtGameovertics.Text = TrimComplete(txtGameovertics.Text)
txtTitleScrollSpeed.Text = TrimComplete(txtTitleScrollSpeed.Text)
If txtSstage_start.Text <> "" Then tsTarget.WriteLine "SSTAGE_START = " & Val(txtSstage_start.Text)
If txtSpstage_start.Text <> "" Then tsTarget.WriteLine "SPSTAGE_START = " & Val(txtSpstage_start.Text)
If txtRacestage_start.Text <> "" Then tsTarget.WriteLine "RACESTAGE_START = " & Val(txtRacestage_start.Text)
If txtIntrotoplay.Text <> "" Then tsTarget.WriteLine "INTROTOPLAY = " & Val(txtIntrotoplay.Text)
If txtCreditsCutscene.Text <> "" Then tsTarget.WriteLine "CREDITSCUTSCENE = " & Val(txtCreditsCutscene.Text)
If txtExeccfg.Text <> "" Then tsTarget.WriteLine "EXECCFG = " & txtExeccfg.Text
If txtGamedata.Text <> "" Then tsTarget.WriteLine "GAMEDATA = " & txtGamedata.Text
If txtNumemblems.Text <> "" Then
tsTarget.WriteLine "NUMEMBLEMS = " & Val(txtNumemblems.Text)
EditedNumemblems = True
End If
If txtInvulntics.Text <> "" Then tsTarget.WriteLine "INVULNTICS = " & Val(txtInvulntics.Text)
If txtSneakertics.Text <> "" Then tsTarget.WriteLine "SNEAKERTICS = " & Val(txtSneakertics.Text)
If txtFlashingtics.Text <> "" Then tsTarget.WriteLine "FLASHINGTICS = " & Val(txtFlashingtics.Text)
If txtTailsflytics.Text <> "" Then tsTarget.WriteLine "TAILSFLYTICS = " & Val(txtTailsflytics.Text)
If txtUnderwatertics.Text <> "" Then tsTarget.WriteLine "UNDERWATERTICS = " & Val(txtUnderwatertics.Text)
If txtSpacetimetics.Text <> "" Then tsTarget.WriteLine "SPACETIMETICS = " & Val(txtSpacetimetics.Text)
If txtExtralifetics.Text <> "" Then tsTarget.WriteLine "EXTRALIFETICS = " & Val(txtExtralifetics.Text)
If txtParalooptics.Text <> "" Then tsTarget.WriteLine "PARALOOPTICS = " & Val(txtParalooptics.Text)
If txtHelpertics.Text <> "" Then tsTarget.WriteLine "HELPERTICS = " & Val(txtHelpertics.Text)
If txtGameovertics.Text <> "" Then tsTarget.WriteLine "GAMEOVERTICS = " & Val(txtGameovertics.Text)
If txtTitleScrollSpeed.Text <> "" Then tsTarget.WriteLine "TITLESCROLLSPEED = " & Val(txtTitleScrollSpeed.Text)
If chkLoopTitle.Value = 1 Then tsTarget.WriteLine "LOOPTITLE = " & chkLoopTitle.Value
If chkDisableSpeedAdjust.Value = 1 Then tsTarget.WriteLine "DISABLESPEEDADJUST = " & chkDisableSpeedAdjust.Value
flags = 0
For i = 0 To 2
If chkReset(i).Value = 1 Then
flags = flags + Val(chkReset(i).Tag)
End If
Next
If flags > 0 Then tsTarget.WriteLine "RESETDATA = " & flags
tsTarget.Close
Set myFSOTarget = Nothing
FileCopy SOCTemp, SOCFile
Kill SOCTemp
MsgBox "Settings Saved."
End Sub

BIN
tools/SOCEdit/frmMaincfg.frx
View file

Binary file not shown.

485
tools/SOCEdit/frmSoundEdit.frm
View file

@ -1,485 +0,0 @@
VERSION 5.00
Begin VB.Form frmSoundEdit
Caption = "Sound Edit"
ClientHeight = 4995
ClientLeft = 60
ClientTop = 345
ClientWidth = 6180
Icon = "frmSoundEdit.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 4995
ScaleWidth = 6180
StartUpPosition = 3 'Windows Default
Begin VB.CommandButton cmdDelete
Caption = "&Delete sound from SOC"
Height = 495
Left = 5040
Style = 1 'Graphical
TabIndex = 13
Top = 4320
Width = 1095
End
Begin VB.CommandButton cmdSave
Caption = "&Save"
Height = 495
Left = 3840
TabIndex = 6
Top = 4320
Width = 1095
End
Begin VB.CommandButton cmdReload
Caption = "&Load Code Default"
Height = 495
Left = 2640
Style = 1 'Graphical
TabIndex = 5
Top = 4320
Width = 1095
End
Begin VB.Frame frmSpecial
Caption = "Special Properties"
Height = 3375
Left = 2640
TabIndex = 4
Top = 840
Width = 3495
Begin VB.CheckBox chkTotallySingle
Caption = "Make sure only one sound of this is playing at a time on any sound channel."
Height = 615
Left = 120
TabIndex = 12
Tag = "1"
Top = 2640
Width = 3255
End
Begin VB.CheckBox chkEightEx
Caption = "Sound can be heard across 8x the distance"
Height = 375
Left = 120
TabIndex = 10
Tag = "16"
Top = 2160
Width = 2295
End
Begin VB.CheckBox chkOutside
Caption = "Volume dependent on how close you are to outside"
Height = 375
Left = 120
TabIndex = 9
Tag = "4"
Top = 360
Width = 2295
End
Begin VB.CheckBox chkFourEx
Caption = "Sound can be heard across 4x the distance"
Height = 375
Left = 120
TabIndex = 8
Tag = "8"
Top = 1560
Width = 2055
End
Begin VB.CheckBox chkMultiple
Caption = "More than one of this sound can be played per object at a time (i.e., thunder)"
Height = 615
Left = 120
TabIndex = 7
Tag = "2"
Top = 840
Width = 2535
End
Begin VB.Label Label1
Caption = "Combine for 32x"
Height = 495
Left = 2760
TabIndex = 11
Top = 1800
Width = 615
End
Begin VB.Line Line4
X1 = 2400
X2 = 2640
Y1 = 2400
Y2 = 2400
End
Begin VB.Line Line2
X1 = 2400
X2 = 2640
Y1 = 1800
Y2 = 1800
End
Begin VB.Line Line1
X1 = 2640
X2 = 2640
Y1 = 2400
Y2 = 1800
End
End
Begin VB.ComboBox cmbPriority
Height = 315
ItemData = "frmSoundEdit.frx":0442
Left = 3360
List = "frmSoundEdit.frx":0444
TabIndex = 2
Top = 120
Width = 855
End
Begin VB.CheckBox chkSingularity
Caption = "Only one can be played at a time per object."
Height = 255
Left = 2640
TabIndex = 1
Top = 480
Width = 3495
End
Begin VB.ListBox lstSounds
Height = 4740
Left = 120
TabIndex = 0
Top = 120
Width = 2415
End
Begin VB.Line Line3
X1 = 0
X2 = 720
Y1 = 0
Y2 = 0
End
Begin VB.Label lblPriority
Alignment = 1 'Right Justify
Caption = "Priority:"
Height = 255
Left = 2640
TabIndex = 3
Top = 120
Width = 615
End
End
Attribute VB_Name = "frmSoundEdit"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub cmdDelete_Click()
Call WriteSound(True)
End Sub
Private Sub cmdReload_Click()
Call ClearForm
If InStr(lstSounds.List(lstSounds.ListIndex), "(free slot)") = 0 Then
Call LoadSoundInfo(lstSounds.ListIndex)
Else
MsgBox "Free slots do not have a code default."
End If
End Sub
Private Sub cmdSave_Click()
Call WriteSound(False)
End Sub
Private Sub Form_Load()
Call Reload
End Sub
Private Sub ClearForm()
cmbPriority.Text = ""
chkSingularity.Value = 0
chkOutside.Value = 0
chkMultiple.Value = 0
chkFourEx.Value = 0
chkEightEx.Value = 0
chkTotallySingle.Value = 0
End Sub
Private Sub Reload()
Call ClearForm
Call LoadCode
lstSounds.ListIndex = 0
End Sub
Private Sub LoadCode()
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 i As Integer, numfreeslots As Integer
ChDir SourcePath
Set ts = myFSO.OpenTextFile("sounds.h", ForReading, False)
Do While InStr(ts.ReadLine, "List of sounds (don't modify this comment!)") = 0
Loop
ts.SkipLine ' typedef enum
ts.SkipLine ' {
line = ts.ReadLine
number = 0
lstSounds.Clear
Do While InStr(line, "sfx_freeslot0") = 0
startclip = InStr(line, "sfx_")
If InStr(line, "sfx_") <> 0 Then
endclip = InStr(line, ",")
line = Mid(line, startclip, endclip - startclip)
addstring = number & " - " & line
lstSounds.AddItem addstring
number = number + 1
End If
line = ts.ReadLine
Loop
ts.Close
Set myFSO = Nothing
'Populate the free slots!
numfreeslots = 800
For i = 1 To numfreeslots
If i < 10 Then
addstring = number & " - " & "sfx_fre00" & i & " (free slot)"
ElseIf i < 100 Then
addstring = number & " - " & "sfx_fre0" & i & " (free slot)"
Else
addstring = number & " - " & "sfx_fre" & i & " (free slot)"
End If
lstSounds.AddItem addstring
number = number + 1
Next
For i = 0 To 127
cmbPriority.AddItem i
Next
End Sub
Private Sub lstSounds_Click()
Call ClearForm
If InStr(lstSounds.List(lstSounds.ListIndex), "(free slot)") = 0 Then
Call LoadSoundInfo(lstSounds.ListIndex)
End If
Call LoadSOCSoundInfo(lstSounds.ListIndex)
End Sub
Private Sub LoadSOCSoundInfo(SoundNum As Integer)
Dim myFSO As New Scripting.FileSystemObject
Dim ts As TextStream
Dim line As String
Dim word As String
Dim word2 As String
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) = "SOUND" And Val(word2) = SoundNum Then
Do While Len(line) > 0 And Not ts.AtEndOfStream
line = ts.ReadLine
word = UCase(FirstToken(line))
word2 = UCase(SecondTokenEqual(line))
If word = "SINGULAR" Then
If Val(word2) = 1 Then
chkSingularity.Value = 1
Else
chkSingularity.Value = 0
End If
ElseIf word = "PRIORITY" Then
cmbPriority.Text = Val(word2)
ElseIf word = "FLAGS" Then
ProcessSoundFlags (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 LoadSoundInfo(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
ChDir SourcePath
Set ts = myFSO.OpenTextFile("sounds.c", ForReading, False)
Do While InStr(ts.ReadLine, "S_sfx[0] needs to be a dummy for odd reasons.") = 0
Loop
number = 0
Do While number <> StateNum
Do While InStr(ts.ReadLine, """") = 0
Loop
number = number + 1
Loop
Do While InStr(line, """") = 0
line = ts.ReadLine
Loop
startclip = InStr(line, """") + 1
line = Mid(line, startclip, Len(line) - startclip)
endclip = InStr(line, """") - 1
token = TrimComplete(Left(line, endclip))
'txtName.Text = line
startclip = InStr(line, ",") + 1
line = Mid(line, startclip, Len(line) - startclip)
endclip = InStr(line, ",") - 1
token = TrimComplete(Left(line, endclip))
If token = "true" Then
chkSingularity.Value = 1
Else
chkSingularity.Value = 0
End If
startclip = InStr(line, ",") + 1
line = Mid(line, startclip, Len(line) - startclip)
endclip = InStr(line, ",") - 1
token = TrimComplete(Left(line, endclip))
cmbPriority.Text = token
startclip = InStr(line, ",") + 1
line = Mid(line, startclip, Len(line) - startclip)
endclip = InStr(line, ",") - 1
token = TrimComplete(Left(line, endclip))
ProcessSoundFlags (Val(token))
ts.Close
Set myFSO = Nothing
End Sub
Private Sub ProcessSoundFlags(flags As Long)
chkTotallySingle.Value = 0
chkMultiple.Value = 0
chkOutside.Value = 0
chkFourEx.Value = 0
chkEightEx.Value = 0
If flags = -1 Then
Exit Sub
End If
If flags And 1 Then
chkTotallySingle.Value = 1
End If
If flags And 2 Then
chkMultiple.Value = 1
End If
If flags And 4 Then
chkOutside.Value = 1
End If
If flags And 8 Then
chkFourEx.Value = 1
End If
If flags And 16 Then
chkEightEx.Value = 1
End If
End Sub
Private Sub WriteSound(Remove As Boolean)
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 soundfound As Boolean
soundfound = 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 = "SOUND" And Val(word2) = lstSounds.ListIndex Then
soundfound = 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 "SOUND " & lstSounds.ListIndex
cmbPriority.Text = TrimComplete(cmbPriority.Text)
If cmbPriority.Text <> "" Then tsTarget.WriteLine "PRIORITY = " & Val(cmbPriority.Text)
If chkSingularity.Value = 1 Then tsTarget.WriteLine "SINGULAR = 1"
flags = 0
If chkOutside.Value = 1 Then flags = flags + Val(chkOutside.Tag)
If chkMultiple.Value = 1 Then flags = flags + Val(chkMultiple.Tag)
If chkFourEx.Value = 1 Then flags = flags + Val(chkFourEx.Tag)
If chkEightEx.Value = 1 Then flags = flags + Val(chkEightEx.Tag)
If chkTotallySingle.Value = 1 Then flags = flags + Val(chkTotallySingle.Tag)
If flags > 0 Then tsTarget.WriteLine "FLAGS = " & flags
End If
tsTarget.Close
Set myFSOTarget = Nothing
FileCopy SOCTemp, SOCFile
Kill SOCTemp
If Remove = True Then
If soundfound = True Then
MsgBox "Sound removed from SOC."
Else
MsgBox "Sound not found in SOC."
End If
Else
MsgBox "Sound Saved."
End If
End Sub

BIN
tools/SOCEdit/frmSoundEdit.frx
View file

Binary file not shown.

940
tools/SOCEdit/frmStateEdit.frm
View file

@ -1,940 +0,0 @@
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

BIN
tools/SOCEdit/frmStateEdit.frx
View file

Binary file not shown.

391
tools/SOCEdit/frmUnlockablesEdit.frm
View file

@ -1,391 +0,0 @@
VERSION 5.00
Begin VB.Form frmUnlockablesEdit
Caption = "Unlockables Edit"
ClientHeight = 3675
ClientLeft = 60
ClientTop = 345
ClientWidth = 8130
Icon = "frmUnlockablesEdit.frx":0000
LinkTopic = "Form1"
MaxButton = 0 'False
ScaleHeight = 3675
ScaleWidth = 8130
StartUpPosition = 3 'Windows Default
Begin VB.CheckBox chkGrade
Caption = "Must have beaten Ultimate"
Height = 255
Index = 4
Left = 5400
TabIndex = 20
Tag = "1024"
Top = 2160
Width = 2655
End
Begin VB.CheckBox chkGrade
Caption = "Must have beaten Very Hard"
Height = 255
Index = 3
Left = 5400
TabIndex = 19
Tag = "128"
Top = 1800
Width = 2655
End
Begin VB.CheckBox chkGrade
Caption = "Must have all emblems"
Height = 255
Index = 2
Left = 5400
TabIndex = 18
Tag = "16"
Top = 1440
Width = 2055
End
Begin VB.CheckBox chkGrade
Caption = "Must have gotten all 7 emeralds"
Height = 255
Index = 1
Left = 5400
TabIndex = 17
Tag = "8"
Top = 1080
Width = 2655
End
Begin VB.CheckBox chkGrade
Caption = "Game must be completed"
Height = 255
Index = 0
Left = 5400
TabIndex = 16
Tag = "1"
Top = 720
Width = 2175
End
Begin VB.TextBox txtVar
Height = 285
Left = 4320
TabIndex = 14
Top = 2640
Width = 615
End
Begin VB.ComboBox cmbType
Height = 315
ItemData = "frmUnlockablesEdit.frx":0442
Left = 3360
List = "frmUnlockablesEdit.frx":044C
TabIndex = 12
Top = 2160
Width = 1575
End
Begin VB.TextBox txtNeededTime
Height = 285
Left = 4080
TabIndex = 10
Top = 1680
Width = 855
End
Begin VB.TextBox txtNeededEmblems
Height = 285
Left = 4440
TabIndex = 9
Top = 1200
Width = 495
End
Begin VB.TextBox txtObjective
Height = 285
Left = 3240
TabIndex = 7
Top = 720
Width = 1695
End
Begin VB.TextBox txtName
Height = 285
Left = 3240
TabIndex = 5
Top = 240
Width = 1695
End
Begin VB.CommandButton cmdDelete
Caption = "&Delete from SOC"
Height = 375
Left = 3480
TabIndex = 3
Top = 3120
Width = 1575
End
Begin VB.CommandButton cmdSave
Caption = "&Save Changes"
Height = 375
Left = 1800
TabIndex = 2
Top = 3120
Width = 1575
End
Begin VB.ListBox lstUnlockables
Height = 2985
ItemData = "frmUnlockablesEdit.frx":046A
Left = 120
List = "frmUnlockablesEdit.frx":049B
TabIndex = 0
Top = 480
Width = 1215
End
Begin VB.Label lblNote
Caption = "Note: All requirements are combinable."
Height = 495
Left = 6000
TabIndex = 22
Top = 2760
Width = 1695
End
Begin VB.Label lblOtherReqs
Caption = "Other Requirements:"
Height = 255
Left = 5400
TabIndex = 21
Top = 360
Width = 1935
End
Begin VB.Label lblVar
Alignment = 1 'Right Justify
Caption = "Map # to warp to:"
Height = 255
Left = 2880
TabIndex = 15
Top = 2640
Width = 1335
End
Begin VB.Label lblType
Alignment = 1 'Right Justify
Caption = "Type of Unlockable:"
Height = 255
Left = 1800
TabIndex = 13
Top = 2160
Width = 1455
End
Begin VB.Label lblNeededTime
Alignment = 1 'Right Justify
Caption = "Needed time on Time Attack rank (in seconds):"
Height = 375
Left = 1440
TabIndex = 11
Top = 1560
Width = 2535
End
Begin VB.Label lblNeededEmblems
Alignment = 1 'Right Justify
Caption = "# of Emblems Needed:"
Height = 255
Left = 2640
TabIndex = 8
Top = 1200
Width = 1695
End
Begin VB.Label lblObjective
Alignment = 1 'Right Justify
Caption = "Objective:"
Height = 255
Left = 2400
TabIndex = 6
Top = 720
Width = 735
End
Begin VB.Label lblName
Alignment = 1 'Right Justify
Caption = "Name:"
Height = 255
Left = 2640
TabIndex = 4
Top = 240
Width = 495
End
Begin VB.Label lblHUDItems
Caption = "Unlockables:"
Height = 255
Left = 120
TabIndex = 1
Top = 240
Width = 975
End
End
Attribute VB_Name = "frmUnlockablesEdit"
Attribute VB_GlobalNameSpace = False
Attribute VB_Creatable = False
Attribute VB_PredeclaredId = True
Attribute VB_Exposed = False
Option Explicit
Private Sub cmdDelete_Click()
Call WriteUnlockableItem(True)
End Sub
Private Sub cmdSave_Click()
Call WriteUnlockableItem(False)
End Sub
Private Sub Form_Load()
Call Reload
End Sub
Private Sub Reload()
txtName.Text = ""
txtObjective.Text = ""
txtNeededEmblems.Text = ""
txtNeededTime.Text = ""
cmbType.Text = ""
txtVar.Text = ""
Dim i As Integer
For i = 0 To chkGrade.Count - 1
chkGrade(i).Value = 0
Next i
lstUnlockables.ListIndex = 0
End Sub
Private Sub lstUnlockables_Click()
Call ReadSOC(lstUnlockables.ListIndex + 1)
End Sub
Private Sub ReadSOC(UnlockableNum As Integer)
Dim myFSO As New Scripting.FileSystemObject
Dim ts As TextStream
Dim line As String
Dim word As String
Dim word2 As String
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) = "UNLOCKABLE" And Val(word2) = UnlockableNum Then
Do While Len(line) > 0 And Not ts.AtEndOfStream
line = ts.ReadLine
word = UCase(FirstToken(line))
word2 = UCase(SecondTokenEqual(line))
If word = "NAME" Then
txtName.Text = word2
ElseIf word = "OBJECTIVE" Then
txtObjective.Text = word2
ElseIf word = "NEEDEDEMBLEMS" Then
txtNeededEmblems.Text = Val(word2)
ElseIf word = "NEEDEDTIME" Then
txtNeededTime.Text = Val(word2)
ElseIf word = "TYPE" Then
cmbType.ListIndex = Val(word2)
ElseIf word = "VAR" Then
txtVar.Text = Val(word2)
ElseIf word = "NEEDEDGRADE" Then
Dim i As Integer
For i = 0 To chkGrade.Count - 1
If Val(word2) And chkGrade(i).Tag Then
chkGrade(i).Tag = True
End If
Next i
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 WriteUnlockableItem(Remove As Boolean)
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 unlockableremoved As Boolean
unlockableremoved = 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 item exists in the SOC, delete it.
If word = "UNLOCKABLE" And Val(word2) = lstUnlockables.ListIndex + 1 Then
unlockableremoved = 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 "UNLOCKABLE " & lstUnlockables.ListIndex + 1
txtName.Text = TrimComplete(txtName.Text)
txtObjective.Text = TrimComplete(txtObjective.Text)
txtNeededEmblems.Text = TrimComplete(txtNeededEmblems.Text)
txtNeededTime.Text = TrimComplete(txtNeededTime.Text)
txtVar.Text = TrimComplete(txtVar.Text)
If txtName.Text <> "" Then tsTarget.WriteLine "NAME = " & txtName.Text
If txtObjective.Text <> "" Then tsTarget.WriteLine "OBJECTIVE = " & txtObjective.Text
If txtNeededEmblems.Text <> "" Then tsTarget.WriteLine "NEEDEDEMBLEMS = " & txtNeededEmblems.Text
If txtNeededTime.Text <> "" Then tsTarget.WriteLine "NEEDEDTIME = " & txtNeededTime.Text
If cmbType.ListIndex <> -1 Then tsTarget.WriteLine "TYPE = " & cmbType.ListIndex
If txtVar.Text <> "" Then tsTarget.WriteLine "VAR = " & txtVar.Text
Dim writegrade As Long
Dim i As Integer
writegrade = 0
For i = 0 To chkGrade.Count - 1
If chkGrade(i).Value = 1 Then
writegrade = writegrade + chkGrade(i).Tag
End If
Next i
If writegrade > 0 Then tsTarget.WriteLine "NEEDEDGRADE = " & writegrade
End If
tsTarget.Close
Set myFSOTarget = Nothing
FileCopy SOCTemp, SOCFile
Kill SOCTemp
If Remove = True Then
If unlockableremoved = True Then
MsgBox "Unlockable deleted from SOC."
Else
MsgBox "Couldn't find Unlockable in SOC."
End If
Else
MsgBox "Unlockable Saved."
End If
End Sub

BIN
tools/SOCEdit/frmUnlockablesEdit.frx
View file

Binary file not shown.

BIN
tools/SOCEdit/icon1.ico
View file

Binary file not shown.
Side by side

Before

Width:  |  Height:  |  Size: 1.1 KiB