Attribute VB_Name = "mExScenFile" ' Constant Declarations Const IBM = 1346119700 Const MAC = 673059850 Const EXS = 1398293822 Const EXD = 1146634814 Const EXG = 1192772926 Public Const cstScnSpNode = 255 Public Const cstScnText = 319 Public Const cstScnTerrain = 255 Public Const cstScnMonster = 255 Public Const cstScnItem = 499 Public Const cstScnSpItem = 49 Public Const cstScnEvent = 19 Public Const cstOutArea = 7 Public Const cstOutSpNode = 59 Public Const cstOutText = 107 'Public Const cstOutSpecial = 17 'Defined in outdoor section heading Public Const cstOutTown = 7 Public Const cstOutSign = 15 Public Const cstTwnArea = 15 Public Const cstTwnSpNode = 99 'Public Const cstTwnText = 139 'Old town text size Public Const cstTwnText = 189 'New town text size Public Const cstTwnSign = 15 'Public Const cstTwnSpecial = 49 'Defined in town section heading 'Public Const cstTwnField = 255 'Defined in town section heading 'Public Const cstTwnItem = 63 'Defined in town section heading 'Public Const cstTwnMonster = 59 'Defined in town section heading 'Public Const cstTwnDlogNode = 69 'Old value Public Const cstTwnDlogNode = 89 'New value ' Data structure declarations Public Type typAreaLoc Loc(3) As Byte ' Left, Top, Right, Bottom End Type Public Type typLoc Loc(1) As Byte ' X, Y location End Type Public Type typLocNum Num As Integer Loc(1) As Byte End Type Public Type typSaveItemArea TownNum As Integer Loc(3) As Byte End Type Public Type typSpecNode ' Special Nodes NodeType As Integer StuffDone(1) As Integer Mess(1) As Integer Pict As Integer Extra(3) As Integer JumpTo As Integer End Type Public Type typDialogNode Personality As Integer Type As Integer ' Values 0-0x1e Word(1) As String * 4 Extra(3) As Integer Text(1) As String End Type Public Type typDialogPerson Name As String LookResponse As String NameResponse As String JobResponse As String HuhResponse As String End Type Public Type typDialogData Person(9) As typDialogPerson Node(cstTwnDlogNode) As typDialogNode End Type Public Type typItemShortcut ' Item placement shortcuts TerrainType As Integer ItemNumber(9) As Integer PctPlace(9) As Integer Property As Boolean End Type Public Type typItem ' Item Definitions ItemName As String * 25 ' Full Identified name UnIDName As String * 15 ' Short Unidentified name Pict As Integer ItemType As Integer Value As Integer ' Values 0-10000 Weight As Byte ' Values 0-250 Level As Byte ' Values 1-50 Awkwardness As Byte ' Values 0-20 Bonus As Byte ' Values 0-10 Protection As Byte ' Values -10 - 20 Charges As Byte ' Values 0-100 WeaponType As Byte ' Values 1-3 ItemUses As Byte ' Values 0-3 SpAbility As Byte ' Values defined below SpAbilityStr As Byte ' Values 0-10 TypeFlag As Byte ' Groups like items Equipped As Byte ' Used in game SpecClass As Byte ' Values 0-100 TreasureType As Byte ' Values 0-4 Identified As Byte ' Values 0-1 Magical As Byte ' Values 0-1 Cursed As Byte ' Values 0-1 ConcealAbility As Byte ' Values 0-1 ' Special Ability Values ' Weapon 1-15 General 1e-3e ' Nonspell Usable 46-53 Spell Usable 6e-87 ' Reagents 96-a1 Missile aa-b0 End Type Public Type typMonster ' Monster Definitions Name As String * 20 Pict As Integer ' Picture on map PicWidth As Byte ' Width of picture in frames PicHeight As Byte ' Height of picture in frames TalkPic As Integer ' Talking Picture Type As Byte ' Values 0-15 Level As Byte ' Values 0-40 Health As Integer ' Values 0-2500 Armor As Byte ' Values 0-50 Skill As Byte ' Values 0-40 Speed As Byte ' Values 1-12 MagicLev As Byte ' Values 0-7 PriestLev As Byte ' Values 0-7 Attitude As Byte ' Values 0-3 Treasure As Byte ' Values 0-3 ItemDropped As Integer ' Item to be dropped when killed ChanceDrop As Integer ' % chance that item will be dropped Poison As Byte ' Values 0-8 SpAbility As Byte ' Values 0-25 AttackType(2) As Byte ' Values 0-9 AttackDice(2) As Byte ' Number of dice AttackDSide(2) As Byte ' Sides on dice BreathWpn As Byte ' Values 0-3 BreathStr As Byte ' Values 0-40 CreateGenerate As Byte ' Summon monsters or fields CreateExtra As Byte ' Extra value affected by Summon/generate SummonType As Byte ' Values 0-3 MagicRes As Byte ' Values 0-2 FireRes As Byte ' Values 0-2 ColdRes As Byte ' Values 0-2 PoisonRes As Byte ' Values 0-2 pad(2) As Byte End Type Public Type typOutDataSize DbSize As Integer StrSize As Integer End Type Public Type typOutMonst MonsterNum(9) As Byte ' 10 monster types per encounter SpNode(2) As Integer ' 0-Special node to call at start of encounter ' 1-Special node to call if party wins ' 2-Special node to call if party loses CantFlee As Byte ' Value 0-1 EncForce As Byte ' Value 0-1 StuffDone(1) As Integer End Type Public Type typOutData ' Outdoor Data NSpecial As Integer AreaLoc(7) As typAreaLoc ' Location of area descriptions WanderingLoc(3) As typLoc ' X,Y Location of wandering monsters ' order in file is 3,2,1,0 Wandering(3) As typOutMonst ' Wandering monsters SpecEncounter(3) As typOutMonst ' Special encounters SpecNode(cstOutSpNode) As typSpecNode ' Special nodes Sign(cstOutSign) As typLoc ' Sign locations Town(cstOutTown) As typLocNum ' Town locations on map Special() As typLocNum ' Specials on map Text(cstOutText) As String ' Use the first 108 only Map(47, 47) As Byte End Type Public Type typScenData Filename As String PathName As String Version(2) As Byte NumTowns As Byte OutSize(1) As Byte ' Width, Height Difficulty As Byte Icon As Byte Rating As Byte ListLock As Byte StartTownNum As Byte StartTownCoord(1) As Byte ' X, Y StartOutdoors(1) As Byte ' X, Y StartOutCoord(1) As Byte ' X, Y EventTimer(19, 1) As Integer ' Moves/special nodes for event timers ' Can only use the first 10 SpecNode(cstScnSpNode) As typSpecNode Text(cstScnText) As String End Type Public Type typStuffDoneDesc SD1 As String SD2(9) As String End Type Public Type typTerrDef ' Terrain definitions Name As String * 30 Pict As Integer Extra1 As Integer Extra2 As Integer Blockage As Byte ' Values 0-5 Transform As Byte ' Terrain type to transform to FlyOver As Byte BoatOver As Byte HorseBlock As Byte Light As Byte ' Values 0-8 Sound As Byte ' Sound made when stepped on; values 0-3 SpProperty As Byte ' Special properties; values 0-17 ShortCutKey As String * 1 Set As Integer ' Set# to which this terrain belongs pad(1) As Byte End Type Public Type typTownDataSize DbSize As Integer StrSize1 As Integer StrSize2 As Integer DlgSize1 As Integer DlgSize2 As Integer End Type Public Type typTownItems Type As Integer Loc(1) As Byte Charges As Integer AlwaysHere As Byte Property As Byte ContainedIn As Byte pad As Byte End Type Public Type typTownMonster Num As Byte Loc(1) As Byte Attitude As Byte ' Values 0-3 CanMove As Byte ' Values 0,1 CreatureHere As Byte ' Values 0-8 Personality As Integer ' Personality dialog TalkPic As Integer ' Dialog picture Extra(1) As Byte SpecEncounterGrp As Byte ' Value 0-10 KilledSpecNode As Integer ' Special node to call when monster is killed StuffDone(1) As Integer ' Set when monster killed pad As Byte End Type Public Type typTownData ' Town Data NSpecial As Integer NField As Integer NItem As Integer NMonst As Integer OutSect As typLoc ' Outdoor section where town located OutLoc As typLoc ' Last location where town found Size As Byte ' Values 0-Lg, 1-Md, 2-Sm Hidden As Byte ' Values 0,1 Light As Integer ' Values 0-4; lightness/darkness of town Difficulty As Integer ' Difficulty factor for town DayDies As Integer ' Day the town dies EventStop As Integer ' Event that prevents town death MaxMonsters As Integer ' max monsters to kill before town is abandoned EntrySpecial(1) As Integer ' Special nodes to call when enter town ExitSpecial(3) As Integer ' Special nodes to call when leave town AreaLoc(15) As typAreaLoc ' Locations of area desc.; L,T,R,B Boundary As typAreaLoc ' Town boundaries: L,T,R,B EntryLoc(3) As typLoc ' X,Y coordinates of town entries; N,E,S,W ExitLoc(3) As typLoc ' X,Y coordinates of outdoor when leave town EventTimer(7, 1) As Integer ' Moves/special nodes for event timers Wandering(3, 3) As Byte ' 4 sets of 4 monster types WanderingLoc(3) As typLoc ' X,Y coordinates for wandering monsters SpecNode(cstTwnSpNode) As typSpecNode ' Special nodes Sign(cstTwnSign) As typLoc ' X,Y coordinates for signs Special() As typLocNum ' X,Y coordinates for special nodes Field() As typLocNum ' Field effects Item() As typTownItems ' Item placement and overrides Monster() As typTownMonster ' Use as needed (29; 39; 59) Text(cstTwnText) As String Map() As Byte ' Redim as needed (31,31; 47,47; 63,63) End Type Public Type typVarTownEntry TownNum As Integer SDAdjust(1) As Integer ' X, Y End Type Public Type typTransport Town As Integer Loc(1) As Byte Property As Byte End Type Public Type typSpItem SpNode As Integer ' Scenario Special node StartWith As Byte Usable As Byte End Type ' Global Variable Declarations Private FileType As Integer ' 0 - IBM, 1 - MAC, 2 - Mine Private DBPtr(299) As Long Private ExtraTrans(11) As typTransport Public ScenFileCancel As Boolean Public FieldXlate(21) As Integer Public CurOutX As Byte Public CurOutY As Byte Public CurTown As Byte Public DialogData() As typDialogData Public Boat(23) As typTransport Public Horse(23) As typTransport Public ItemDef(cstScnItem) As typItem Public ItemShortcut(9) As typItemShortcut Public MonsterDef(cstScnMonster) As typMonster Public OutData() As typOutData Public SaveItemArea(3) As typSaveItemArea ' Town#,Left,Top,Right,Bottom Public SpItem(cstScnSpItem) As typSpItem Public Scen As typScenData Public StuffDoneDesc(299) As typStuffDoneDesc Public TerrDef(cstScnTerrain) As typTerrDef Public TownData() As typTownData Public TownSize(199) As Byte Public TownHidden(199) As Byte Public VarTownEntry(9) As typVarTownEntry Public Sub OpenScenFile(Filename As String, PathName As String, _ ByVal flgAction As Integer) On Error GoTo ErrHandler ScenFileCancel = False frmMain.CommonDialog1.InitDir = App.Path & "\scenario" frmMain.CommonDialog1.CancelError = True frmMain.CommonDialog1.Filename = "" frmMain.CommonDialog1.Flags = 0 frmMain.CommonDialog1.Filter = "Exile Scenario (*.exs)|*.exs" frmMain.CommonDialog1.FilterIndex = 1 If flgAction = 1 Then frmMain.CommonDialog1.Flags = cdlOFNFileMustExist frmMain.CommonDialog1.ShowOpen Else frmMain.CommonDialog1.ShowSave End If Filename = frmMain.CommonDialog1.FileTitle If UCase(Right(Filename, 4)) <> ".EXS" Then MsgBox "File extension must be '.exs'.", vbExclamation, "Error!" GoTo ErrHandler End If PathName = frmMain.CommonDialog1.Filename Exit Sub ErrHandler: Select Case Err.Number Case 32755 ' Selected Cancel ScenFileCancel = True Case Else MsgBox "OpenScenFile" & "Error encountered!" & vbCrLf & "Err# " & Err.Number & ", " & Err.Description, _ vbCritical, "Error" ScenFileCancel = True End Select End Sub Public Sub ImportOut(ByVal OutX As Integer, ByVal OutY As Integer, _ ByVal PathName As String) Dim Signature As Long Dim DataPointer As Long Dim TxtPtr As Long Dim OutW As Byte Dim OutH As Byte Dim DBPtrs(299) As Long Dim OutDataSize(99) As typOutDataSize Dim TownDataSize(199) As typTownDataSize Dim TxtLen(299) As Byte Dim IX As Integer ' open the file to import from On Error GoTo ErrHandler Open PathName For Binary Access Read As #1 Get #1, 1, Signature Select Case Signature Case 1346119700 ' IBM FileType = 0 Case 673059850 ' Mac FileType = 1 Case 1398293822 ' Mine FileType = 2 Case Else Close #1 MsgBox "LoadScenario" & "Error encountered!" & vbCrLf _ & "Not a valid Scenario file." _ , vbCritical, "Error" Exit Sub End Select ' calculate where in the file to get the desired outdoor data Select Case FileType Case 0, 1 'ibm, mac Get #1, 13, OutW Get #1, 14, OutH Get #1, 435, TownDataSize Get #1, 2497, OutDataSize Get #1, 41637, TxtLen TxtPtr = 81143 For IX = 0 To cstScnText TxtPtr = TxtPtr + TxtLen(IX) Next IX TxtPtr = TxtPtr + TxtLen(IX) DataPointer = TxtPtr IDX = OutX * OutW + OutY For IX = 0 To IDX - 1 DataPointer = DataPointer + OutDataSize(IX).DbSize DataPointer = DataPointer + OutDataSize(IX).StrSize Next IX Case 2 'mine Get #1, 9, OutW Get #1, 10, OutH Get #1, 81, DBPtrs IX = OutX * OutW + OutY DataPointer = DBPtrs(IX) + 1 End Select ' load the outdoor data Select Case FileType Case 0, 1 'ibm, mac GetOutDataV1 OutX, OutY, DataPointer Case 2 'mine GetOutDataV2 OutX, OutY, DataPointer End Select Close #1 Exit Sub ErrHandler: Close #1 MsgBox "ImportTown" & "Error encountered!" & vbCrLf & "Err# " & Err.Number & ", " & Err.Description _ , vbCritical, "Error" ScenFileCancel = True End Sub Public Sub ImportTown(ByVal TownNum As Integer, ByVal PathName As String) Dim Signature As Long Dim DataPointer As Long Dim DBPtrs(299) As Long Dim OutDataSize(99) As typOutDataSize Dim TownDataSize(199) As typTownDataSize Dim TxtLen(299) As Byte Dim TwnSz(199) As Byte Dim IX As Integer Dim vByte As Byte ' open the file to import from On Error GoTo ErrHandler Open PathName For Binary Access Read As #1 Get #1, 1, Signature Select Case Signature Case IBM FileType = 0 Case MAC FileType = 1 Case EXS FileType = 2 Case Else Close #1 MsgBox "LoadScenario" & "Error encountered!" & vbCrLf _ & "Not a valid Scenario file." _ , vbCritical, "Error" Exit Sub End Select ' ----- calculate where in the file to get the desired town data ----- Select Case FileType Case 0, 1 ' ibm, mac For IX = 0 To 199 Get #1, 18, vByte TwnSz(IX) = vByte Next IX Get #1, 435, TownDataSize Get #1, 2497, OutDataSize Get #1, 41637, TxtLen TownSize(CurTown) = TwnSz(TownNum) TxtPtr = 81143 For IX = 0 To 269 TxtPtr = TxtPtr + TxtLen(IX) Next IX TxtPtr = TxtPtr + TxtLen(IX) DataPointer = TxtPtr For IX = 0 To 99 DataPointer = DataPointer + OutDataSize(IX).DbSize DataPointer = DataPointer + OutDataSize(IX).StrSize Next IX For IX = 0 To TownNum - 1 DataPointer = DataPointer + TownDataSize(IX).DbSize DataPointer = DataPointer + TownDataSize(IX).StrSize1 DataPointer = DataPointer + TownDataSize(IX).StrSize2 DataPointer = DataPointer + TownDataSize(IX).DlgSize1 DataPointer = DataPointer + TownDataSize(IX).DlgSize2 Next IX Case 2 ' mine Get #1, 81, DBPtrs DataPointer = DBPtrs(100 + TownNum) + 1 End Select ' load the town data IX = CurTown Select Case FileType Case 0, 1 GetTownDataV1 IX, DataPointer Case 2 GetTownDataV2 IX, DataPointer End Select ' Clear dialog because we may not be loaded into the same town position With DialogData(CurTown) ' Dialog For IX = 0 To 9 .Person(IX).Name = "Unused" .Person(IX).LookResponse = "" .Person(IX).NameResponse = "" .Person(IX).JobResponse = "" .Person(IX).HuhResponse = "" Next IX For IX = 0 To cstTwnDlogNode .Node(IX).Personality = -1 .Node(IX).Type = 0 .Node(IX).Word(0) = "xxxx" .Node(IX).Word(1) = "xxxx" For IY = 0 To 1 .Node(IX).Extra(IY) = 0 .Node(IX).Text(IY) = "" Next IY For IY = 0 To 3 .Node(IX).Extra(IY) = 0 Next IY Next IX End With Close #1 Exit Sub ErrHandler: Close #1 MsgBox "ImportTown" & "Error encountered!" & vbCrLf & "Err# " & Err.Number & ", " & Err.Description _ , vbCritical, "Error" ScenFileCancel = True End Sub Public Sub LoadScenario() Dim Signature As Long Dim CustomPicsFile As String Dim ScenDataFile As String Dim DataPointer As Long Dim IDX As Integer Dim IX As Integer Dim IY As Integer Dim IZ As Integer Dim IXLimit As Integer Dim IYlimit As Integer ' open the file On Error GoTo ErrHandler Open Scen.PathName For Binary Access Read As #1 ' Determine file structure Get #1, 1, Signature Select Case Signature Case IBM FileType = 0 Case MAC FileType = 1 Case EXS ' Mine FileType = 2 Case Else Close #1 MsgBox "LoadScenario" & "Error encountered!" & vbCrLf _ & "Not a valid Scenario file." _ , vbCritical, "Error" Exit Sub End Select ' load scenario data DataPointer = 1 Select Case FileType Case 0, 1 GetScenDataV1 DataPointer Case 2 GetScenDataV2 DataPointer End Select ' load the outdoor sections IXLimit = Scen.OutSize(0) - 1 IYlimit = Scen.OutSize(1) - 1 ReDim OutData(IXLimit, IYlimit) For IY = 0 To IYlimit For IX = 0 To IXLimit Select Case FileType Case 0, 1 GetOutDataV1 IX, IY, DataPointer Case 2 GetOutDataV2 IX, IY, DataPointer End Select Next IX Next IY ' load the town data IXLimit = Scen.NumTowns - 1 ReDim TownData(IXLimit) ReDim DialogData(IXLimit) For IX = 0 To IXLimit Select Case FileType Case 0, 1 GetTownDataV1 IX, DataPointer Case 2 GetTownDataV2 IX, DataPointer End Select Next IX Close #1 ' Load the custom graphics file if it exists CustomPicsFile = Mid(Scen.PathName, 1, Len(Scen.PathName) - 3) & "bmp" LoadCustomGraphics CustomPicsFile ' Load Scen Editor data file if it exists ScenDataFile = Mid(Scen.PathName, 1, Len(Scen.PathName) - 3) & "exd" LoadScenData ScenDataFile ' Build Town/Outdoor crossreference IXLimit = Scen.OutSize(0) - 1 IYlimit = Scen.OutSize(1) - 1 For IY = 0 To IYlimit For IX = 0 To IXLimit With OutData(IX, IY) For IZ = 0 To cstOutTown If .Town(IZ).Loc(0) < 100 Then IDX = .Town(IZ).Num If IDX < Scen.NumTowns Then TownData(IDX).OutSect.Loc(0) = IX TownData(IDX).OutSect.Loc(1) = IY TownData(IDX).OutLoc.Loc(0) = .Town(IZ).Loc(0) TownData(IDX).OutLoc.Loc(1) = .Town(IZ).Loc(1) End If End If Next IZ End With Next IX Next IY ' if we are loading the orig. version of Bladebase.exs, ' then shift monsters down two to add a couple of townspeople If Scen.Filename = "Bladebase.exs" And FileType = 0 Then IY = 255 For IX = 253 To 5 Step -1 MonsterDef(IY) = MonsterDef(IX) IY = IY - 1 Next IX MonsterDef(5).Pict = 4 MonsterDef(5).TalkPic = 9 MonsterDef(6).Pict = 5 With TownData(0) For IX = 0 To .NMonst If .Monster(IX).Num > 4 Then .Monster(IX).Num = .Monster(IX).Num + 2 End If Next IX End With End If If Scen.Filename = "Exile.exs" And FileType = 0 Then IY = 210 For IX = 208 To 5 Step -1 MonsterDef(IY) = MonsterDef(IX) IY = IY - 1 Next IX MonsterDef(5).Pict = 4 MonsterDef(5).TalkPic = 9 MonsterDef(6).Pict = 5 For IY = 0 To Scen.NumTowns - 1 With TownData(IY) For IX = 0 To .NMonst Select Case .Monster(IX).Num Case 209 .Monster(IX).Num = 6 Case 210 .Monster(IX).Num = 5 Case Else If .Monster(IX).Num > 4 And .Monster(IX).Num < 211 Then .Monster(IX).Num = .Monster(IX).Num + 2 End If End Select Next IX End With Next IY End If Exit Sub ErrHandler: Close #1 MsgBox "LoadScenario" & "Error encountered!" & vbCrLf & "Err# " & Err.Number & ", " & Err.Description _ , vbCritical, "Error" End Sub Public Sub LoadScenData(ByVal Filename As String) Dim IX As Integer Dim IY As Integer Dim Quote As String Dim varString As String Quote = Chr(34) For IX = 0 To 299 StuffDoneDesc(IX).SD1 = "" For IY = 0 To 9 StuffDoneDesc(IX).SD2(IY) = "" Next IY Next IX On Error GoTo ErrorHandler Open Filename For Input As #2 Line Input #2, varString If varString <> ">EXD" Then GoTo ErrorHandler Do Until EOF(2) Input #2, IX, IY, varString If IY = -1 Then StuffDoneDesc(IX).SD1 = varString Else StuffDoneDesc(IX).SD2(IY) = varString End If Loop ErrorHandler: Close #2 End Sub Public Sub SaveScenarioV2() Dim TempFileName As String Dim Signature As Long Dim DataPointer As Long Dim IX As Integer Dim IY As Integer Dim IDX As Integer Dim IXLimit As Integer Dim IYlimit As Integer On Error Resume Next ' open the file (temporary) On Error GoTo ErrHandler Scen.PathName = App.Path & "\scenario\" & Scen.Filename TempFileName = "C:\temp\" & Scen.Filename Open TempFileName For Binary Access Write As #1 Signature = 1398293822 Put #1, 1, Signature ' write out the scenario data PutScenDataV2 DataPointer ' write out the outdoor sections IXLimit = Scen.OutSize(0) - 1 IYlimit = Scen.OutSize(1) - 1 For IY = 0 To IYlimit For IX = 0 To IXLimit IDX = IX * Scen.OutSize(0) + IY DBPtr(IDX) = DataPointer - 1 PutOutDataV2 IX, IY, DataPointer Next IX Next IY ' write out the town data IXLimit = Scen.NumTowns - 1 For IX = 0 To IXLimit DBPtr(100 + IX) = DataPointer - 1 PutTownDataV2 IX, DataPointer Next IX Put #1, 81, DBPtr ' write out the following Close #1 ' copy temp file to existing one and clean up temp file FileCopy TempFileName, Scen.PathName Select Case Err.Number Case 0 ' Normal Case Else MsgBox "An error occurred trying to replace file." & vbCrLf & _ Err.Number & " - " & Err.Description & _ " Cannot replace", vbExclamation, "Error" Exit Sub End Select Scen.PathName = App.Path & "\scenario\" & Scen.Filename Select Case Err.Number Case 0 ' Normal Case Else MsgBox "An error occurred trying to remove temporary file." & vbCrLf & _ Err.Number & " - " & Err.Description, vbExclamation, "Error" Exit Sub End Select ScenDataFile = Mid(Scen.PathName, 1, Len(Scen.PathName) - 3) & "exd" SaveScenData ScenDataFile Exit Sub ErrHandler: Close #1 MsgBox "SaveScenarioV2" & "Error encountered!" & vbCrLf & "Err# " & Err.Number & ", " & Err.Description _ , vbCritical, "Error" End Sub Public Sub SaveScenData(ByVal Filename As String) Dim IX As Integer Dim IY As Integer On Error GoTo ErrHandler Open Filename For Output As #2 Print #2, ">EXD" For IX = 0 To 299 If StuffDoneDesc(IX).SD1 <> "" Then Write #2, IX, -1, StuffDoneDesc(IX).SD1 End If For IY = 0 To 9 If StuffDoneDesc(IX).SD2(IY) <> "" Then Write #2, IX, IY, StuffDoneDesc(IX).SD2(IY) End If Next IY Next IX Close #2 Exit Sub ErrHandler: Close #2 MsgBox "SaveScenData" & "Error encountered!" & vbCrLf & "Err# " & Err.Number & ", " & Err.Description _ , vbCritical, "Error" End Sub Private Function GetByte(ByVal DPtr As Long) As Byte Get #1, DPtr, GetByte End Function Private Function GetInteger(ByVal DPtr As Long) As Integer Dim varByte(1) As Byte Dim Sign As Integer Select Case FileType Case 0, 2 Get #1, DPtr, GetInteger Case 1 Get #1, DPtr, varByte(0) Get #1, DPtr + 1, varByte(1) Sign = 1 If varByte(0) > 127 Then Sign = -1 varByte(0) = varByte(0) Xor 255 varByte(1) = varByte(1) Xor 255 End If GetInteger = (varByte(0) * 256 + varByte(1)) If Sign < 0 Then GetInteger = (GetInteger + 1) GetInteger = GetInteger * Sign End If End Select End Function Private Function GetString(ByVal DPtr As Long, ByVal StrLen As Byte) As String Dim IX As Integer Dim IChar As Byte Dim varString As String varString = "" For IX = 0 To StrLen - 1 Get #1, DPtr + IX, IChar If IChar = 0 Then Exit For varString = varString & Chr(IChar) Next IX GetString = varString End Function Private Function GetVarString(ByVal DPtr As Long, ByVal StrLen As Byte) Dim varString As String varString = String(StrLen, " ") Get #1, DPtr, varString If FileType = 2 Then GetVarString = varString Else GetVarString = Replace(varString, "|", Chr(13) & Chr(10)) End If End Function Private Function GetSpNode(ByVal DPtr As Long) As typSpecNode Dim SpWork As typSpecNode Dim varInteger As Integer With SpWork .NodeType = GetInteger(DPtr) .StuffDone(0) = GetInteger(DPtr + 2) .StuffDone(1) = GetInteger(DPtr + 4) .Pict = GetInteger(DPtr + 6) .Mess(0) = GetInteger(DPtr + 8) .Mess(1) = GetInteger(DPtr + 10) .Extra(0) = GetInteger(DPtr + 12) .Extra(1) = GetInteger(DPtr + 14) .Extra(2) = GetInteger(DPtr + 16) .Extra(3) = GetInteger(DPtr + 18) .JumpTo = GetInteger(DPtr + 20) If FileType < 2 Then Select Case .NodeType Case 57, 60 If .Extra(3) > 3 And .Extra(3) < 1000 Then .Extra(3) = .Extra(3) + 2 End If Case 99, 100 .Extra(0) = .Extra(0) + 30 Case 299 varInteger = .Extra(1) .Extra(1) = .Extra(0) .Extra(0) = varInteger If varInteger = 1 Or varInteger = 2 Then .Extra(1) = .Extra(1) + 30 End If End Select End If GetSpNode = SpWork End With End Function Public Sub CreateScenario() Dim CustomPicsFile As String Dim DataPointer As Long Dim IX As Integer Dim IY As Integer Dim IXLimit As Integer Dim IYlimit As Integer On Error GoTo ErrHandler ' Load Bladebase scenario data, then tweak some beginning values Open App.Path & "\scenario\bladebase\bladebase.exs" For Binary As #1 DataPointer = 1 GetScenDataV2 DataPointer Close #1 Scen.Filename = frmFileNew.txtFileName & ".exs" Scen.PathName = App.Path & "\scenario" Scen.Text(0) = frmFileNew.txtScenName Scen.OutSize(0) = frmFileNew.txtOutWidth Scen.OutSize(1) = frmFileNew.txtOutHeight Scen.ListLock = 0 ' Load the custom graphics file if it exists CustomPicsFile = Mid(Scen.PathName, 1, Len(Scen.PathName) - 3) & "bmp" LoadCustomGraphics CustomPicsFile ' Create the outdoor sections IXLimit = Scen.OutSize(0) - 1 IYlimit = Scen.OutSize(1) - 1 ReDim OutData(IXLimit, IYlimit) For IY = 0 To IYlimit For IX = 0 To IXLimit CreateOutSection IX, IY, frmFileNew.chkGrass Next IX Next IY CurOutX = 0 CurOutY = 0 ' Create one medium size town (original did more, but not necessary) Scen.NumTowns = 1 ReDim TownData(0) CreateTown 0, "Town name", frmFileNew.TownSize, frmFileNew.chkGrass CurTown = 0 Exit Sub ErrHandler: Close #1 MsgBox "CreateScenario" & "Error encountered!" & vbCrLf & "Err# " & Err.Number & ", " & Err.Description _ , vbCritical, "Error" End Sub Private Sub CreateOutSection(ByVal OutX As Integer, ByVal OutY As Integer, _ ByVal Terrain As Integer) Dim IX As Integer Dim IY As Integer Dim IXLimit As Integer Dim IYlimit As Integer Dim FieldTerr As Byte Dim EdgeTerr As Byte InitOutData OutX, OutY ' Initialize common stuff With OutData(OutX, OutY) ' Customize for building a new scenario ' Initialize the map Select Case Terrain Case 0 FieldTerr = 0 EdgeTerr = 5 Case 1 FieldTerr = 2 EdgeTerr = 22 End Select For IX = 0 To 47 For IY = 0 To 47 .Map(IX, IY) = FieldTerr Next IY Next IX If OutX = 0 Then For IY = 0 To 47 For IX = 0 To 2 .Map(IX, IY) = EdgeTerr Next IX .Map(3, IY) = TerrainSet(Terrain, 3) Next IY End If If OutY = 0 Then For IX = 0 To 47 For IY = 0 To 2 .Map(IX, IY) = EdgeTerr Next IY If .Map(IX, 3) = FieldTerr Then .Map(IX, 3) = TerrainSet(Terrain, 1) End If Next IX End If If OutX = Scen.OutSize(0) - 1 Then For IY = 0 To 47 For IX = 45 To 47 .Map(IX, IY) = EdgeTerr Next IX If .Map(44, IY) = FieldTerr Then .Map(44, IY) = TerrainSet(Terrain, 7) End If Next IY End If If OutY = Scen.OutSize(1) - 1 Then For IX = 0 To 47 For IY = 45 To 47 .Map(IX, IY) = EdgeTerr Next IY If .Map(IX, 44) = FieldTerr Then .Map(IX, 44) = TerrainSet(Terrain, 5) End If Next IX End If If OutX = 0 And OutY = 0 Then .Map(3, 3) = TerrainSet(Terrain, 12) End If If OutX = 0 And OutY = Scen.OutSize(1) - 1 Then .Map(3, 44) = TerrainSet(Terrain, 11) End If If OutX = Scen.OutSize(0) - 1 And OutY = 0 Then .Map(44, 3) = TerrainSet(Terrain, 9) End If If OutX = Scen.OutSize(0) - 1 And OutY = Scen.OutSize(1) - 1 Then .Map(44, 44) = TerrainSet(Terrain, 10) End If ' initialize wandering monsters and special encounters For IX = 0 To 3 For IY = 0 To 9 .Wandering(IX).MonsterNum(IY) = 0 .SpecEncounter(IX).MonsterNum(IY) = 0 Next IY .Wandering(IX).SpNode(0) = -1 .Wandering(IX).SpNode(1) = -1 .Wandering(IX).SpNode(2) = -1 .Wandering(IX).CantFlee = 0 .Wandering(IX).EncForce = 0 .Wandering(IX).StuffDone(0) = -1 .Wandering(IX).StuffDone(1) = -1 .SpecEncounter(IX).SpNode(0) = -1 .SpecEncounter(IX).SpNode(1) = -1 .SpecEncounter(IX).SpNode(2) = -1 .SpecEncounter(IX).CantFlee = 0 .SpecEncounter(IX).EncForce = 0 .SpecEncounter(IX).StuffDone(0) = -1 .SpecEncounter(IX).StuffDone(1) = -1 Next IX .WanderingLoc(0).Loc(0) = 8 .WanderingLoc(0).Loc(1) = 8 .WanderingLoc(1).Loc(0) = 8 .WanderingLoc(1).Loc(1) = 32 .WanderingLoc(2).Loc(0) = 32 .WanderingLoc(2).Loc(1) = 32 .WanderingLoc(3).Loc(0) = 8 .WanderingLoc(3).Loc(1) = 32 ' initialize text .Text(0) = "Area name" .Text(1) = "Rectangle 1" .Text(2) = "Rectangle 2" .Text(3) = "Rectangle 3" .Text(4) = "Rectangle 4" .Text(5) = "Rectangle 5" .Text(6) = "Rectangle 6" .Text(7) = "Rectangle 7" .Text(8) = "Rectangle 8" .Text(9) = "Comment" .Text(10) = "*Begin special strs" For IX = 11 To 99 .Text(IX) = "*" Next IX End With End Sub Public Sub CreateTown(ByVal Townx As Integer, ByVal Name As String, _ ByVal Size As Integer, ByVal Terrain As Integer) Dim IX As Integer Dim IY As Integer ' expand our dimensions ReDim Preserve TownData(Townx) ReDim Preserve DialogData(Townx) InitTownData Townx ' Initialize common data TownData(Townx).Size = Size Select Case Size Case 0 MapSize = 63 Case 1 MapSize = 47 Case 2 MapSize = 31 End Select With TownData(Townx) ' initialize some town variables .Hidden = 0 .Light = 0 .Difficulty = 0 .DayDies = -1 .EventStop = -1 .MaxMonsters = 30000 ' initialize the town boundaries .Boundary.Loc(0) = 3 .Boundary.Loc(1) = 3 .Boundary.Loc(2) = MapSize - 3 .Boundary.Loc(3) = MapSize - 3 ' initialize entry/exit points to the town .EntryLoc(0).Loc(0) = MapSize / 2 .EntryLoc(0).Loc(1) = 4 .EntryLoc(1).Loc(0) = MapSize - 4 .EntryLoc(1).Loc(1) = MapSize / 2 .EntryLoc(2).Loc(0) = MapSize / 2 .EntryLoc(2).Loc(1) = MapSize - 4 .EntryLoc(3).Loc(0) = 4 .EntryLoc(3).Loc(1) = MapSize / 2 For IX = 0 To 3 For IY = 0 To 1 .ExitLoc(IX).Loc(IY) = 255 Next IY .ExitSpecial(IX) = -1 Next IX ' initialize special nodes to call upon entry .EntrySpecial(0) = -1 .EntrySpecial(1) = -1 ' initialize event timers For IX = 0 To 7 .EventTimer(IX, 0) = 0 .EventTimer(IX, 1) = -1 Next IX ' initialize map Select Case Size Case 0 ' Large town ReDim .Map(63, 63) IXLimit = 63 IYlimit = 63 Case 1 ' Medium town ReDim .Map(47, 47) IXLimit = 47 IYlimit = 47 Case 2 ' Small town ReDim .Map(31, 31) IXLimit = 31 IYlimit = 31 End Select For IX = 0 To IXLimit For IY = 0 To IYlimit Select Case Terrain Case 0 .Map(IX, IY) = 0 Case 1 .Map(IX, IY) = 2 Case 2 .Map(IX, IY) = 4 End Select Next IY Next IX ' initialize text .Text(0) = Name For IX = 1 To 16 .Text(IX) = "Rectangle " & IX Next IX .Text(17) = "Comment 1" .Text(18) = "Comment 2" .Text(19) = "Comment 3" .Text(20) = "*Begin special strs" For IX = 21 To 169 ' was 21 to 119 .Text(IX) = "*" Next IX End With End Sub Private Sub GetScenDataV1(DataPointer As Long) Dim IX As Integer Dim IY As Long Dim DPtr As Long Dim varByte As Byte Dim varInteger As Integer Dim TxtLen(299) As Byte Dim TxtPtr As Long Dim SpecWork(5) As Byte InitScenData Get #1, 5, Scen.Version Get #1, 12, Scen.NumTowns Get #1, 13, Scen.OutSize Get #1, 15, Scen.Difficulty Get #1, 16, Scen.Icon Get #1, 18, TownSize Get #1, 218, TownHidden Get #1, 425, Scen.StartTownCoord Get #1, 427, Scen.StartOutdoors Get #1, 429, Scen.StartOutCoord Get #1, 431, Scen.StartTownNum Scen.ListLock = 1 ' Don't need to get town data sizes DPtr = 2435 'Variable Town entry For IX = 0 To 9 With VarTownEntry(IX) .TownNum = GetInteger(DPtr) .SDAdjust(0) = GetInteger(DPtr + 20 + (2 * IX)) .SDAdjust(1) = GetInteger(DPtr + 22 + (2 * IX)) DPtr = DPtr + 2 End With Next IX ' Don't need to get Outdoor data sizes DPtr = 2897 ' Save area rectangles If FileType = 0 Then ' IBM format For IX = 0 To 2 SaveItemArea(IX).TownNum = GetInteger(DPtr + 24 + (2 * IX)) ' Town# SaveItemArea(IX).Loc(0) = GetInteger(DPtr + (8 * IX)) ' Top SaveItemArea(IX).Loc(1) = GetInteger(DPtr + 2 + (8 * IX)) ' Left SaveItemArea(IX).Loc(2) = GetInteger(DPtr + 4 + (8 * IX)) ' Bottom SaveItemArea(IX).Loc(3) = GetInteger(DPtr + 6 + (8 * IX)) ' Right Next IX Else For IX = 0 To 2 ' MAC format SaveItemArea(IX).TownNum = GetInteger(DPtr + 24 + (2 * IX)) ' Town# SaveItemArea(IX).Loc(0) = GetInteger(DPtr + 2 + (8 * IX)) ' Left SaveItemArea(IX).Loc(1) = GetInteger(DPtr + (8 * IX)) ' Top SaveItemArea(IX).Loc(2) = GetInteger(DPtr + 6 + (8 * IX)) ' Right SaveItemArea(IX).Loc(3) = GetInteger(DPtr + 4 + (8 * IX)) ' Bottom Next IX End If SaveItemArea(3).TownNum = -1 For IX = 0 To 3 SaveItemArea(3).Loc(IX) = 0 Next IX DPtr = 2929 For IX = 0 To 49 IY = GetInteger(DPtr) Select Case IY Case 0 SpItem(IX).StartWith = 0 SpItem(IX).Usable = 0 Case 1 SpItem(IX).StartWith = 0 SpItem(IX).Usable = 1 Case 10 SpItem(IX).StartWith = 1 SpItem(IX).Usable = 0 Case 11 SpItem(IX).StartWith = 1 SpItem(IX).Usable = 1 End Select SpItem(IX).SpNode = GetInteger(DPtr + 100) DPtr = DPtr + 2 Next IX Scen.Rating = GetByte(3129) DPtr = 3135 ' Monster definitions For IX = 0 To 255 With MonsterDef(IX) .Level = GetByte(DPtr + 1) .Health = GetInteger(DPtr + 28) .Armor = GetByte(DPtr + 36) .Skill = GetByte(DPtr + 37) 'Attack Dice Examples: ' 1d1 = 0x65 or 101 decimal ' 1d6 = 0x6a or 106 decimal ' 2d6 = 0xce or 206 decimal ' 20d50 = 0x802 or 2050 decimal (max values) For IY = 0 To 2 varInteger = GetInteger(DPtr + 38 + (IY * 2)) .AttackDice(IY) = Int(varInteger / 100) .AttackDSide(IY) = Int(varInteger Mod 100) Next IY .AttackType(0) = GetByte(DPtr + 44) .AttackType(1) = GetByte(DPtr + 45) .AttackType(2) = .AttackType(1) .Type = GetByte(DPtr + 46) .Speed = GetByte(DPtr + 47) .MagicLev = GetByte(DPtr + 49) .PriestLev = GetByte(DPtr + 50) .BreathStr = GetByte(DPtr + 51) .BreathWpn = GetByte(DPtr + 52) .Treasure = GetByte(DPtr + 53) .SpAbility = GetByte(DPtr + 54) .Poison = GetByte(DPtr + 55) .ItemDropped = GetInteger(DPtr + 60) .ChanceDrop = GetInteger(DPtr + 62) 'Resistances Bitmap Values ' 0x1 = resist magic 0x10 = resist cold ' 0x2 = immune magic 0x20 = immune cold ' 0x4 = resist fire 0x40 = resist poison ' 0x8 = immune fire 0x80 = immune poison varByte = GetByte(DPtr + 95) .MagicRes = 0 .FireRes = 0 .ColdRes = 0 .PoisonRes = 0 IY = 2 ^ 1 If varByte And 2 ^ 0 Then .MagicRes = 1 If varByte And 2 ^ 1 Then .MagicRes = 2 If varByte And 2 ^ 2 Then .FireRes = 1 If varByte And 2 ^ 3 Then .FireRes = 2 If varByte And 2 ^ 4 Then .ColdRes = 1 If varByte And 2 ^ 5 Then .ColdRes = 2 If varByte And 2 ^ 6 Then .PoisonRes = 1 If varByte And 2 ^ 7 Then .PoisonRes = 2 .PicWidth = GetByte(DPtr + 96) .PicHeight = GetByte(DPtr + 97) .CreateGenerate = GetByte(DPtr + 98) .CreateExtra = GetByte(DPtr + 99) .Attitude = GetByte(DPtr + 100) .SummonType = GetByte(DPtr + 101) .TalkPic = GetByte(DPtr + 102) .Pict = GetInteger(DPtr + 106) If .Pict > 3 And .Pict < 1000 Then ' adjust for the two picts I added .Pict = .Pict + 2 End If End With DPtr = DPtr + 108 Next IX DPtr = 30783 ' Boat data For IX = 0 To 23 With Boat(IX) .Loc(0) = GetByte(DPtr) .Loc(1) = GetByte(DPtr + 1) .Town = GetInteger(DPtr + 6) .Property = GetByte(DPtr + 9) DPtr = DPtr + 10 End With Next IX DPtr = 31083 ' Horse data For IX = 0 To 23 With Horse(IX) .Loc(0) = GetByte(DPtr) .Loc(1) = GetByte(DPtr + 1) .Town = GetInteger(DPtr + 6) .Property = GetByte(DPtr + 9) DPtr = DPtr + 10 End With Next IX DPtr = 31385 ' Terrain definitions For IX = 0 To 255 With TerrDef(IX) .Pict = GetInteger(DPtr) .Blockage = GetByte(DPtr + 2) .Extra1 = GetByte(DPtr + 3) .Extra2 = GetByte(DPtr + 4) .SpProperty = GetByte(DPtr + 5) Select Case IX Case 7, 10, 13, 16 ' Secret passages in cave walls .SpProperty = 1 .Extra1 = .Pict Case 82 ' Cave walkway .SpProperty = 25 Case 83 ' Grass walkway .SpProperty = 26 Case 125, 142, 157 ' Doors .SpProperty = 24 End Select .Transform = GetByte(DPtr + 6) .FlyOver = GetByte(DPtr + 7) .BoatOver = GetByte(DPtr + 8) .HorseBlock = GetByte(DPtr + 9) .Light = GetByte(DPtr + 10) .Sound = GetByte(DPtr + 11) .ShortCutKey = GetString(DPtr + 12, 1) If Blockage = 0 And .SpProperty = 0 Then Select Case .Pict Case 0 SpecWork(0) = IX Case 123 SpecWork(1) = IX Case 157 SpecWork(2) = IX Case 163 SpecWork(3) = IX Case 2 SpecWork(4) = IX Case 32 SpecWork(5) = IX End Select End If Select Case IX Case 5, 6, 8, 9, 11, 12, 14, 15, 17, 18, 19, 20, 21 .Set = 0 Case 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35 .Set = 1 Case 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49 .Set = 2 Case 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62 .Set = 3 Case Else .Set = -1 End Select End With DPtr = DPtr + 16 Next IX For IX = 0 To 255 ' Fix transform to for terrain with special With TerrDef(IX) Select Case .Pict Case 207 .Transform = SpecWork(0) Case 208 .Transform = SpecWork(1) Case 209 .Transform = SpecWork(2) Case 210 .Transform = SpecWork(3) Case 211 .Transform = SpecWork(4) Case 212 .Transform = SpecWork(5) End Select End With Next IX DPtr = 35481 ' Scenario event timers For IX = 0 To 19 With Scen .EventTimer(IX, 0) = GetInteger(DPtr) .EventTimer(IX, 1) = GetInteger(DPtr + 40) DPtr = DPtr + 2 End With Next IX DPtr = 35563 ' Scenario Special nodes For IX = 0 To 255 Scen.SpecNode(IX) = GetSpNode(DPtr) DPtr = DPtr + 22 Next IX DPtr = 41195 ' Item Placement shortcuts For IX = 0 To 9 With ItemShortcut(IX) .TerrainType = GetInteger(DPtr) For IY = 0 To 9 .ItemNumber(IY) = GetInteger(DPtr + 2 + (IY * 2)) .PctPlace(IY) = GetInteger(DPtr + 22 + (IY * 2)) Next IY .Property = GetInteger(DPtr + 42) End With DPtr = DPtr + 44 Next IX Get #1, 41637, TxtLen CurOutX = GetByte(41939) CurOutY = GetByte(41940) CurTown = GetInteger(41941) DPtr = 41943 ' Item definitions For IX = 0 To 399 If IX > 175 Then IY = 0 End If With ItemDef(IX) .ItemType = GetInteger(DPtr) .Level = GetByte(DPtr + 2) .Awkwardness = GetByte(DPtr + 4) .Bonus = GetByte(DPtr + 5) .Protection = GetByte(DPtr + 6) .Charges = GetByte(DPtr + 7) .WeaponType = GetByte(DPtr + 8) .ItemUses = GetByte(DPtr + 9) .Pict = GetByte(DPtr + 10) .SpAbility = GetByte(DPtr + 11) .SpAbilityStr = GetByte(DPtr + 12) .TypeFlag = GetByte(DPtr + 13) ' Adjust for duplicate shield type If .ItemType = 16 Then .ItemType = 12 End If If .ItemType > 15 Then .ItemType = .ItemType - 1 End If ' .Value = GetInteger(DPtr + 16) .Weight = GetByte(DPtr + 18) .SpecClass = GetByte(DPtr + 19) .ItemName = GetString(DPtr + 22, 25) .UnIDName = GetString(DPtr + 47, 15) .TreasureType = GetByte(DPtr + 62) ' Bitmapped flags ' Identified 0x1 Cursed 0x10 ' Magical 0x4 Conceal Ability 0x20 varByte = GetByte(DPtr + 63) .Identified = 0 .Magical = 0 .Cursed = 0 .ConcealAbility = 0 If varByte And 2 ^ 0 Then .Identified = 1 If varByte And 2 ^ 2 Then .Magical = 1 If varByte And 2 ^ 4 Then .Cursed = 1 If varByte And 2 ^ 5 Then .ConcealAbility = 1 End With DPtr = DPtr + 66 Next IX For IX = 400 To 499 With ItemDef(IX) .ItemType = 0 .Level = 0 .Awkwardness = 0 .Bonus = 0 .Protection = 0 .Charges = 0 .WeaponType = 1 .ItemUses = 0 .Pict = 0 .SpAbility = 0 .SpAbilityStr = 0 .TypeFlag = 0 .Value = 0 .Weight = 0 .SpecClass = 0 .ItemName = "Empty" .UnIDName = "Empty" .TreasureType = 0 .Identified = 0 .Magical = 0 .Cursed = 0 .ConcealAbility = 0 End With Next IX DPtr = 68343 ' Monster names For IX = 0 To 255 With MonsterDef(IX) .Name = GetString(DPtr, 20) End With DPtr = DPtr + 20 Next IX DPtr = 73463 ' Terrain names For IX = 0 To 255 With TerrDef(IX) .Name = GetString(DPtr, 30) DPtr = DPtr + 30 End With Next IX TxtPtr = 81143 For IX = 0 To 259 Scen.Text(IX) = GetVarString(TxtPtr, TxtLen(IX)) TxtPtr = TxtPtr + TxtLen(IX) Next IX TxtPtr = TxtPtr + TxtLen(IX) DataPointer = TxtPtr Scen.Text(10) = "Being an adventurer is unpredicatable work. Sometimes, you become heroes, wealthy as Croesus and famous beyond words. And sometimes your gnawed bones are left to dry out in some shadowy, forgotten hole." Scen.Text(11) = "Unfortunately, the latter fate is the one that just befell you. Easy come, easy go. Care to make another attempt?" Scen.Text(12) = "Begin journal strs" For IX = 0 To 52 Scen.Text(IX + 260) = ButtonName(IX) Next IX End Sub Public Sub GetScenDataV2(DataPointer As Long) Dim IX As Integer Dim IY As Integer Dim IXLimit As Integer Dim IYlimit As Integer Dim DPtr As Long Dim TxtPtr As Long Dim TxtLen() As Byte ' Initialize data ' InitScenData ' Get data from file Get #1, 5, Scen.Version Get #1, 8, Scen.NumTowns Get #1, 9, Scen.OutSize Get #1, 11, Scen.Difficulty Get #1, 12, Scen.Rating Get #1, 13, Scen.Icon Get #1, 14, CurTown Get #1, 15, CurOutX Get #1, 16, CurOutY Get #1, 17, Scen.StartTownNum Get #1, 18, Scen.StartTownCoord Get #1, 20, Scen.StartOutdoors Get #1, 22, Scen.StartOutCoord Get #1, 23, Scen.ListLock DPtr = 1281 Get #1, DPtr, TerrDef For IX = 0 To cstScnTerrain ' Terrain Definitions Get #1, DPtr, TerrDef(IX) DPtr = DPtr + 48 With TerrDef(IX) Select Case IX Case 5, 6, 8, 9, 11, 12, 14, 15, 17, 18, 19, 20, 21 .Set = 0 Case 22, 23, 24, 25, 26, 27, 28, 29, 30, 31, 32, 33, 34, 35 .Set = 1 Case 36, 37, 38, 39, 40, 41, 42, 43, 44, 45, 46, 47, 48, 49 .Set = 2 Case 50, 51, 52, 53, 54, 55, 56, 57, 58, 59, 60, 61, 62 .Set = 3 Case Else .Set = -1 End Select End With Next IX For IX = 0 To cstScnMonster ' Monster Definitions Get #1, DPtr, MonsterDef(IX) DPtr = DPtr + 64 Next IX For IX = 0 To cstScnItem ' Item Definitions Get #1, DPtr, ItemDef(IX) DPtr = DPtr + 64 Next IX For IX = 0 To 9 Get #1, DPtr, ItemShortcut(IX) ' Item Placement shortcuts DPtr = DPtr + 42 Next IX For IX = 0 To 9 Get #1, DPtr, VarTownEntry(IX) ' Variable Town Entry DPtr = DPtr + 6 Next IX For IX = 0 To 3 Get #1, DPtr, SaveItemArea(IX) ' Saved Item Rectangles DPtr = DPtr + 6 Next IX For IX = 0 To 19 ' Scenario Event Timers Get #1, DPtr, Scen.EventTimer(IX, 0) Get #1, DPtr + 2, Scen.EventTimer(IX, 1) DPtr = DPtr + 4 Next IX For IX = 0 To cstScnSpItem ' Special Items Get #1, DPtr, SpItem(IX) DPtr = DPtr + 4 Next IX For IX = 0 To 23 ' Transports Get #1, DPtr, Boat(IX) DPtr = DPtr + 5 Next IX For IX = 0 To 23 Get #1, DPtr, Horse(IX) DPtr = DPtr + 5 Next IX DPtr = DPtr + (20 * 5) Get #1, 25, IXLimit ' Get Number of scenario special nodes For IX = 0 To IXLimit Get #1, DPtr, Scen.SpecNode(IX) DPtr = DPtr + 22 Next IX Get #1, 27, IXLimit ' Get Number of Texts ReDim TxtLen(IXLimit) Get #1, DPtr, TxtLen TxtPtr = DPtr + IXLimit + 1 For IX = 0 To IXLimit Scen.Text(IX) = GetVarString(TxtPtr, TxtLen(IX)) TxtPtr = TxtPtr + TxtLen(IX) Next IX DataPointer = TxtPtr End Sub Private Sub InitScenData() Dim IX As Integer Scen.ListLock = 1 Scen.SpecNode(0).NodeType = 0 Scen.SpecNode(0).Pict = -1 For IX = 0 To 1 Scen.SpecNode(0).StuffDone(IX) = -1 Scen.SpecNode(0).Mess(IX) = -1 Scen.SpecNode(0).Extra(IX) = -1 Scen.SpecNode(0).Extra(IX + 2) = -1 Next IX Scen.SpecNode(0).JumpTo = -1 For IX = 1 To cstScnSpNode ' Initialize special nodes Scen.SpecNode(IX) = Scen.SpecNode(0) Next IX For IX = 0 To cstScnText ' Initialize Scenario text Scen.Text(IX) = "" Next IX End Sub Private Sub GetOutDataV1(OutX As Integer, OutY As Integer, DataPointer As Long) Dim IX As Integer Dim IY As Integer Dim IXLimit As Integer Dim IYlimit As Integer Dim NDX As Integer Dim DPtr As Long Dim TxtPtr As Long Dim TxtLen(179) As Byte Dim varByte As Byte Dim varByte1 As Byte InitOutData OutX, OutY With OutData(OutX, OutY) DPtr = DataPointer ' Map For IX = 0 To 47 For IY = 0 To 47 .Map(IX, IY) = GetByte(DPtr) DPtr = DPtr + 1 Next IY Next IX DPtr = DataPointer + 2304 ' Special locations NDX = -1 For IX = 0 To 17 varByte = GetByte(DPtr) If varByte < 100 Then NDX = NDX + 1 If NDX > .NSpecial Then .NSpecial = .NSpecial + 8 ReDim Preserve .Special(.NSpecial) For IY = .NSpecial - 7 To .NSpecial .Special(IY).Num = -1 .Special(IY).Loc(0) = 100 .Special(IY).Loc(1) = 0 Next IY End If varByte1 = GetByte(DPtr + 1) If varByte < 48 And varByte1 < 48 Then .Special(NDX).Loc(0) = varByte .Special(NDX).Loc(1) = varByte1 .Special(NDX).Num = GetByte(DataPointer + 2340 + IX) End If End If DPtr = DPtr + 2 Next IX DPtr = DataPointer + 2358 ' Town locations For IX = 0 To 7 .Town(IX).Loc(0) = GetByte(DPtr) .Town(IX).Loc(1) = GetByte(DPtr + 1) If .Town(IX).Loc(0) = 100 Then .Town(IX).Num = -1 Else .Town(IX).Num = GetByte(DPtr + 16 - IX) End If If .Town(IX).Num >= Scen.NumTowns Then .Town(IX).Num = -1 .Town(IX).Loc(0) = 100 .Town(IX).Loc(1) = 0 End If DPtr = DPtr + 2 Next IX DPtr = DataPointer + 2382 ' Sign Locations For IX = 0 To 7 .Sign(IX).Loc(0) = GetByte(DPtr) .Sign(IX).Loc(1) = GetByte(DPtr + 1) DPtr = DPtr + 2 Next IX DPtr = DataPointer + 2398 ' Wandering Monster Definitions For IX = 0 To 3 For IY = 0 To 9 .Wandering(IX).MonsterNum(IY) = GetByte(DPtr) DPtr = DPtr + 1 Next IY For IY = 0 To 2 .Wandering(IX).SpNode(IY) = GetInteger(DPtr) DPtr = DPtr + 2 Next IY IY = GetInteger(DPtr) DPtr = DPtr + 2 Select Case IY Case 1 .Wandering(IX).CantFlee = 1 Case 10 .Wandering(IX).EncForce = 1 Case 11 .Wandering(IX).CantFlee = 1 .Wandering(IX).EncForce = 1 Case Else .Wandering(IX).CantFlee = 0 .Wandering(IX).EncForce = 0 End Select For IY = 0 To 1 .Wandering(IX).StuffDone(IY) = GetInteger(DPtr) DPtr = DPtr + 2 Next IY Next IX DPtr = DataPointer + 2486 ' Special Encounter Definitions For IX = 0 To 3 For IY = 0 To 9 .SpecEncounter(IX).MonsterNum(IY) = GetByte(DPtr) DPtr = DPtr + 1 Next IY For IY = 0 To 2 .SpecEncounter(IX).SpNode(IY) = GetInteger(DPtr) DPtr = DPtr + 2 Next IY varByte = GetByte(DPtr) DPtr = DPtr + 2 Select Case varByte Case 1 .SpecEncounter(IX).CantFlee = 1 Case 10 .SpecEncounter(IX).EncForce = 1 Case 11 .SpecEncounter(IX).CantFlee = 1 .SpecEncounter(IX).EncForce = 1 Case Else .SpecEncounter(IX).CantFlee = 0 .SpecEncounter(IX).EncForce = 0 End Select For IY = 0 To 1 .SpecEncounter(IX).StuffDone(IY) = GetInteger(DPtr) DPtr = DPtr + 2 Next IY Next IX DPtr = DataPointer + 2574 ' Wandering Monster Locations For IX = 0 To 3 For IY = 0 To 1 .WanderingLoc(IX).Loc(IY) = GetByte(DPtr) DPtr = DPtr + 1 Next IY Next IX DPtr = DataPointer + 2582 For IX = 0 To 7 ' Area boundaries Select Case FileType Case 0: 'ibm For IY = 0 To 3 .AreaLoc(IX).Loc(IY) = GetInteger(DPtr) DPtr = DPtr + 2 Next IY Case 1: 'mac .AreaLoc(IX).Loc(1) = GetInteger(DPtr) DPtr = DPtr + 2 .AreaLoc(IX).Loc(0) = GetInteger(DPtr) DPtr = DPtr + 2 .AreaLoc(IX).Loc(3) = GetInteger(DPtr) DPtr = DPtr + 2 .AreaLoc(IX).Loc(2) = GetInteger(DPtr) DPtr = DPtr + 2 End Select Next IX Get #1, DataPointer + 2646, TxtLen For IX = 0 To cstOutSpNode ' initialize special nodes .SpecNode(IX).NodeType = -1 .SpecNode(IX).Pict = -1 For IY = 0 To 1 .SpecNode(IX).StuffDone(IY) = -1 .SpecNode(IX).Mess(IY) = -1 .SpecNode(IX).Extra(IY) = -1 .SpecNode(IX).Extra(IY + 2) = -1 Next IY .SpecNode(IX).JumpTo = -1 Next IX DPtr = DataPointer + 2826 ' Special nodes For IX = 0 To 59 OutData(OutX, OutY).SpecNode(IX) = GetSpNode(DPtr) DPtr = DPtr + 22 Next IX For IX = 0 To cstOutText ' Initialize text .Text(IX) = "" Next IX TxtPtr = DataPointer + 4146 ' Text For IX = 0 To 107 .Text(IX) = GetVarString(TxtPtr, TxtLen(IX)) TxtPtr = TxtPtr + TxtLen(IX) Next IX TxtPtr = TxtPtr + TxtLen(IX) End With DataPointer = TxtPtr End Sub Private Sub GetOutDataV2(OutX As Integer, OutY As Integer, DataPointer As Long) Dim IX As Integer Dim IY As Integer Dim IXLimit As Integer Dim IYlimit As Integer Dim DPtr As Long Dim TxtPtr As Long Dim TxtLen() As Byte 'InitOutData OutX, OutY IX = OutX * OutY + OutX DPtr = DataPointer With OutData(OutX, OutY) ' Get data from file Get #1, DPtr, .NSpecial DPtr = DPtr + 2 Get #1, DPtr, .AreaLoc DPtr = DPtr + 32 Get #1, DPtr, .WanderingLoc DPtr = DPtr + 8 Get #1, DPtr, .Wandering DPtr = DPtr + 88 Get #1, DPtr, .SpecEncounter DPtr = DPtr + 88 Get #1, 39, IXLimit For IX = 0 To IXLimit ' Signs and locations Get #1, DPtr, .Sign(IX) DPtr = DPtr + 2 Next IX Get #1, 41, IXLimit For IX = 0 To IXLimit ' Town and locations Get #1, DPtr, .Town(IX) If .Town(IX).Loc(0) = 100 Then .Town(IX).Num = -1 End If DPtr = DPtr + 4 Next IX IXLimit = .NSpecial ReDim .Special(IXLimit) For IX = 0 To IXLimit ' Specials and locations Get #1, DPtr, .Special(IX) DPtr = DPtr + 4 Next IX Get #1, 33, IXLimit For IX = 0 To IXLimit ' Special nodes Get #1, DPtr, .SpecNode(IX) DPtr = DPtr + 22 Next IX Get #1, DPtr, .Map DPtr = DPtr + (48 * 48) Get #1, 35, IXLimit ' Get Number of Texts ReDim TxtLen(IXLimit) Get #1, DPtr, TxtLen TxtPtr = DPtr + IXLimit + 1 For IX = 0 To IXLimit .Text(IX) = GetVarString(TxtPtr, TxtLen(IX)) TxtPtr = TxtPtr + TxtLen(IX) Next IX End With DataPointer = TxtPtr End Sub Public Sub InitOutData(OutX As Integer, OutY As Integer) Dim IX As Integer With OutData(OutX, OutY) For IX = 0 To 7 ' area descriptions For IY = 0 To 3 .AreaLoc(IX).Loc(IY) = 0 Next IY Next IX For IX = 0 To cstOutTown ' Town locations .Town(IX).Num = -1 .Town(IX).Loc(0) = 100 .Town(IX).Loc(1) = 0 Next IX For IX = 0 To cstOutSign ' Sign locations .Sign(IX).Loc(0) = 100 .Sign(IX).Loc(1) = 0 Next IX .NSpecial = 7 ReDim .Special(.NSpecial) For IX = 0 To .NSpecial ' Special node locations .Special(IX).Num = -1 .Special(IX).Loc(0) = 100 .Special(IX).Loc(1) = 0 Next IX .SpecNode(0).NodeType = 0 ' Special nodes .SpecNode(0).Pict = -1 For IX = 0 To 1 .SpecNode(0).StuffDone(IX) = -1 .SpecNode(0).Mess(IX) = -1 .SpecNode(0).Extra(IX) = -1 .SpecNode(0).Extra(IX + 2) = -1 Next IX .SpecNode(0).JumpTo = -1 For IX = 1 To cstOutSpNode .SpecNode(IX) = .SpecNode(0) Next IX .SpecNode(0).NodeType = 7 ' 0th node is a out block .SpecNode(0).Extra(0) = 1 For IX = 0 To cstOutText ' Text .Text(IX) = "" Next IX End With End Sub Private Sub GetTownDataV1(Townx As Integer, DataPointer As Long) Dim IX As Integer Dim IY As Integer Dim NDX As Integer Dim IXLimit As Integer Dim IYlimit As Integer Dim DPtr As Long Dim varInteger As Integer Dim varString As String Dim NMonsters As Integer Dim MapSize As Integer Dim TxtLen() As Byte Dim TxtPtr As Long InitTownData Townx ReDim TxtLen(cstTwnText) With TownData(Townx) .Size = TownSize(Townx) .Hidden = TownHidden(Townx) .DayDies = GetInteger(DataPointer) ' Day Dies .EventStop = GetInteger(DataPointer + 2) ' Scenario event to prevent death DPtr = DataPointer + 4 ' Wandering Monster Definitions For IX = 0 To 3 For IY = 0 To 3 .Wandering(IX, IY) = GetByte(DPtr) DPtr = DPtr + 1 Next IY Next IX DPtr = DataPointer + 20 For IX = 0 To 3 For IY = 0 To 1 .WanderingLoc(IX).Loc(IY) = GetByte(DPtr) DPtr = DPtr + 1 Next IY Next IX ' ----- Special node locations ----- DPtr = DataPointer + 28 NDX = -1 For IX = 0 To 49 varByte = GetByte(DPtr) If varByte < 100 Then NDX = NDX + 1 If NDX > .NSpecial Then .NSpecial = .NSpecial + 8 ReDim Preserve .Special(.NSpecial) For IY = .NSpecial - 7 To .NSpecial .Special(IY).Num = -1 .Special(IY).Loc(0) = 100 Next IY End If .Special(NDX).Loc(0) = varByte .Special(NDX).Loc(1) = GetByte(DPtr + 1) .Special(NDX).Num = GetByte(DataPointer + 128 + IX) End If DPtr = DPtr + 2 Next IX DPtr = DataPointer + 178 ' Sign locations For IX = 0 To 14 .Sign(IX).Loc(0) = GetByte(DPtr) .Sign(IX).Loc(1) = GetByte(DPtr + 1) DPtr = DPtr + 2 Next IX .Light = GetInteger(DataPointer + 208) ' Light flag DPtr = DataPointer + 210 ' Entry locations For IX = 0 To 3 For IY = 0 To 1 .EntryLoc(IX).Loc(IY) = GetByte(DPtr) DPtr = DPtr + 1 Next IY Next IX DPtr = DataPointer + 218 ' Exit locations to outdoors For IX = 0 To 3 For IY = 0 To 1 .ExitLoc(IX).Loc(IY) = GetByte(DPtr) DPtr = DPtr + 1 Next IY Next IX DPtr = DataPointer + 226 ' Specials to execute on exit For IX = 0 To 3 .ExitSpecial(IX) = GetInteger(DPtr) DPtr = DPtr + 2 Next IX DPtr = DataPointer + 234 If FileType = 0 Then ' Boundaries For IX = 0 To 3 IY = GetByte(DPtr) .Boundary.Loc(IX) = IY DPtr = DPtr + 2 Next IX Else .Boundary.Loc(1) = GetInteger(DPtr) DPtr = DPtr + 2 .Boundary.Loc(0) = GetInteger(DPtr) DPtr = DPtr + 2 .Boundary.Loc(3) = GetInteger(DPtr) DPtr = DPtr + 2 .Boundary.Loc(2) = GetInteger(DPtr) DPtr = DPtr + 2 End If ' --- Item Locations/Properties --- DPtr = DataPointer + 242 NDX = -1 For IX = 0 To 63 varInteger = GetInteger(DPtr + 2) If varInteger > -1 Then NDX = NDX + 1 If NDX > .NItem Then .NItem = .NItem + 8 ReDim Preserve .Item(.NItem) For IY = .NItem - 7 To .NItem .Item(IY).Type = -1 .Item(IY).Loc(0) = 100 .Item(IY).Charges = -1 Next IY End If .Item(NDX).Type = varInteger .Item(NDX).Loc(0) = GetByte(DPtr) .Item(NDX).Loc(1) = GetByte(DPtr + 1) .Item(NDX).Charges = GetInteger(DPtr + 4) .Item(NDX).AlwaysHere = GetByte(DPtr + 7) .Item(NDX).Property = GetByte(DPtr + 8) .Item(NDX).ContainedIn = GetByte(DPtr + 9) End If DPtr = DPtr + 10 Next IX .MaxMonsters = GetInteger(DataPointer + 882) DPtr = DataPointer + 884 ' --- Field locations/properties --- NDX = -1 For IX = 0 To 49 varInteger = GetInteger(DPtr + 2) ' varInteger = GetByte(DPtr + 2) If varInteger > 0 Then NDX = NDX + 1 If NDX > .NField Then .NField = .NField + 8 ReDim Preserve .Field(.NField) For IY = .NField - 7 To .NField .Field(IY).Num = -1 .Field(IY).Loc(0) = 100 Next IY End If .Field(NDX).Num = FieldXlate(varInteger) .Field(NDX).Loc(0) = GetByte(DPtr) .Field(NDX).Loc(1) = GetByte(DPtr + 1) End If DPtr = DPtr + 4 Next IX ' --- Specials to execute on entry --- DPtr = DataPointer + 1084 For IX = 0 To 1 .EntrySpecial(IX) = GetInteger(DPtr) DPtr = DPtr + 2 Next IX ' --- Town event timers --- DPtr = DataPointer + 1088 For IY = 0 To 1 For IX = 0 To 7 .EventTimer(IX, IY) = GetInteger(DPtr) DPtr = DPtr + 2 Next IX Next IY Get #1, DataPointer + 1120, TxtLen ' --- Special node definitions --- DPtr = DataPointer + 1300 For IX = 0 To 99 .SpecNode(IX) = GetSpNode(DPtr) DPtr = DPtr + 22 Next IX .Difficulty = GetInteger(DataPointer + 3504) ' difficulty ' --- Define parameters for old style .exs --- Select Case TownSize(Townx) Case 0 ' Large town ReDim .Map(63, 63) TxtPtr = DataPointer + 9562 NMonsters = 59 MapSize = 63 Case 1 ' Medium town ReDim .Map(47, 47) TxtPtr = DataPointer + 7106 NMonsters = 39 MapSize = 47 Case 2 ' Small town ReDim .Map(31, 31) TxtPtr = DataPointer + 5446 NMonsters = 29 MapSize = 31 End Select DPtr = DataPointer + 3506 ' Map For IX = 0 To MapSize For IY = 0 To MapSize .Map(IX, IY) = GetByte(DPtr) DPtr = DPtr + 1 Next IY Next IX ' --- Area boundaries --- For IX = 0 To 15 Select Case FileType Case 0: 'ibm For IY = 0 To 3 .AreaLoc(IX).Loc(IY) = GetInteger(DPtr) DPtr = DPtr + 2 Next IY Case 1: 'mac varInteger = GetInteger(DPtr) If varInteger > 255 Then varInteger = 0 .AreaLoc(IX).Loc(1) = varInteger DPtr = DPtr + 2 varInteger = GetInteger(DPtr) If varInteger > 255 Then varInteger = 0 .AreaLoc(IX).Loc(0) = varInteger DPtr = DPtr + 2 varInteger = GetInteger(DPtr) If varInteger > 255 Then varInteger = 0 .AreaLoc(IX).Loc(3) = varInteger DPtr = DPtr + 2 varInteger = GetInteger(DPtr) If varInteger > 255 Then varInteger = 0 .AreaLoc(IX).Loc(2) = varInteger DPtr = DPtr + 2 End Select Next IX NDX = -1 ' --- Monster locations/properties --- For IX = 0 To NMonsters varByte = GetByte(DPtr) If varByte > 0 Then NDX = NDX + 1 If NDX > .NMonst Then .NMonst = .NMonst + 8 ReDim Preserve .Monster(.NMonst) For IY = .NMonst - 7 To .NMonst .Monster(IY).Num = 0 .Monster(IY).Loc(0) = 100 .Monster(IY).KilledSpecNode = -1 .Monster(IY).Personality = -1 .Monster(IY).StuffDone(0) = -1 .Monster(IY).StuffDone(1) = -1 Next IY End If .Monster(NDX).Num = varByte .Monster(NDX).Attitude = GetByte(DPtr + 1) .Monster(NDX).Loc(0) = GetByte(DPtr + 2) .Monster(NDX).Loc(1) = GetByte(DPtr + 3) .Monster(NDX).CanMove = GetByte(DPtr + 4) .Monster(NDX).CreatureHere = GetByte(DPtr + 5) .Monster(NDX).StuffDone(0) = GetInteger(DPtr + 8) .Monster(NDX).StuffDone(1) = GetInteger(DPtr + 10) .Monster(NDX).SpecEncounterGrp = GetByte(DPtr + 12) .Monster(NDX).Extra(0) = GetByte(DPtr + 14) .Monster(NDX).Extra(1) = GetByte(DPtr + 15) .Monster(NDX).Personality = GetInteger(DPtr + 16) .Monster(NDX).KilledSpecNode = GetInteger(DPtr + 18) .Monster(NDX).TalkPic = GetInteger(DPtr + 20) End If DPtr = DPtr + 22 Next IX ' --- Text strings --- ' Old way ' For IX = 0 To 139 ' .Text(IX) = GetVarString(TxtPtr, TxtLen(IX)) ' TxtPtr = TxtPtr + TxtLen(IX) ' Next IX ' New way - Inserted 50 more special texts For IX = 0 To 119 .Text(IX) = GetVarString(TxtPtr, TxtLen(IX)) TxtPtr = TxtPtr + TxtLen(IX) Next IX For IX = 120 To 169 .Text(IX) = "*" Next IX For IX = 120 To 139 .Text(IX + 50) = GetVarString(TxtPtr, TxtLen(IX)) TxtPtr = TxtPtr + TxtLen(IX) Next IX ' end of new code End With DataPointer = TxtPtr With DialogData(Townx) ' Town Dialog ReDim TxtLen(169) Get #1, DataPointer, TxtLen DPtr = DataPointer + 200 For IX = 0 To 59 .Node(IX).Personality = GetInteger(DPtr) .Node(IX).Type = GetInteger(DPtr + 2) .Node(IX).Word(0) = GetString(DPtr + 4, 4) .Node(IX).Word(1) = GetString(DPtr + 8, 4) .Node(IX).Extra(0) = GetInteger(DPtr + 12) .Node(IX).Extra(1) = GetInteger(DPtr + 14) .Node(IX).Extra(2) = GetInteger(DPtr + 16) .Node(IX).Extra(3) = GetInteger(DPtr + 18) ' Adjust old scenarios to allow for All spells, not just level 4 and up If .Node(IX).Type = 9 Or .Node(IX).Type = 10 Then .Node(IX).Extra(1) = .Node(IX).Extra(1) + 30 End If DPtr = DPtr + 20 Next IX TxtPtr = DataPointer + 1400 IY = -1 For IX = 0 To 9 IY = IY + 1 .Person(IX).Name = GetVarString(TxtPtr, TxtLen(IY)) TxtPtr = TxtPtr + TxtLen(IY) Next IX For IX = 0 To 9 IY = IY + 1 .Person(IX).LookResponse = GetVarString(TxtPtr, TxtLen(IY)) TxtPtr = TxtPtr + TxtLen(IY) Next IX For IX = 0 To 9 IY = IY + 1 .Person(IX).NameResponse = GetVarString(TxtPtr, TxtLen(IY)) TxtPtr = TxtPtr + TxtLen(IY) Next IX For IX = 0 To 9 IY = IY + 1 .Person(IX).JobResponse = GetVarString(TxtPtr, TxtLen(IY)) TxtPtr = TxtPtr + TxtLen(IY) Next IX For IX = 0 To 59 IY = IY + 1 .Node(IX).Text(0) = GetVarString(TxtPtr, TxtLen(IY)) TxtPtr = TxtPtr + TxtLen(IY) IY = IY + 1 .Node(IX).Text(1) = GetVarString(TxtPtr, TxtLen(IY)) TxtPtr = TxtPtr + TxtLen(IY) Next IX For IX = 0 To 9 IY = IY + 1 .Person(IX).HuhResponse = GetVarString(TxtPtr, TxtLen(IY)) TxtPtr = TxtPtr + TxtLen(IY) Next IX End With DataPointer = TxtPtr End Sub Private Sub GetTownDataV2(Townx As Integer, DataPointer As Long) Dim IX As Integer Dim IY As Integer Dim IXLimit As Integer Dim IYlimit As Integer Dim DPtr As Long Dim TxtPtr As Long Dim TxtLen() As Byte Dim varString As String DPtr = DataPointer InitTownData Townx With TownData(Townx) Get #1, DPtr, .NField DPtr = DPtr + 2 Get #1, DPtr, .NItem DPtr = DPtr + 2 Get #1, DPtr, .NMonst DPtr = DPtr + 2 Get #1, DPtr, .NSpecial DPtr = DPtr + 2 Get #1, DPtr, .Size DPtr = DPtr + 1 Get #1, DPtr, .Hidden DPtr = DPtr + 1 Get #1, DPtr, .Light DPtr = DPtr + 2 Get #1, DPtr, .Difficulty DPtr = DPtr + 2 Get #1, DPtr, .DayDies DPtr = DPtr + 2 Get #1, DPtr, .EventStop DPtr = DPtr + 2 Get #1, DPtr, .MaxMonsters DPtr = DPtr + 2 Get #1, DPtr, .EntrySpecial DPtr = DPtr + 4 Get #1, DPtr, .ExitSpecial DPtr = DPtr + 8 Get #1, DPtr, .Boundary DPtr = DPtr + 4 Get #1, DPtr, .AreaLoc DPtr = DPtr + 64 Get #1, DPtr, .EntryLoc DPtr = DPtr + 8 Get #1, DPtr, .ExitLoc DPtr = DPtr + 8 Get #1, DPtr, .EventTimer DPtr = DPtr + 32 Get #1, DPtr, .Wandering DPtr = DPtr + 16 Get #1, DPtr, .WanderingLoc DPtr = DPtr + 8 Get #1, 55, IXLimit ' Num Signs For IX = 0 To IXLimit Get #1, DPtr, .Sign(IX) DPtr = DPtr + 2 Next IX IXLimit = .NSpecial ' Num Specials ReDim .Special(IXLimit) For IX = 0 To IXLimit Get #1, DPtr, .Special(IX) DPtr = DPtr + 4 Next IX IXLimit = .NField ' Num Fields ReDim .Field(IXLimit) For IX = 0 To IXLimit Get #1, DPtr, .Field(IX) DPtr = DPtr + 4 Next IX IXLimit = .NItem ' Num Items ReDim .Item(IXLimit) For IX = 0 To IXLimit Get #1, DPtr, .Item(IX) DPtr = DPtr + 10 Next IX IXLimit = .NMonst ' Num Monsters ReDim .Monster(IXLimit) For IX = 0 To IXLimit Get #1, DPtr, .Monster(IX) DPtr = DPtr + 20 Next IX Get #1, 49, IXLimit ' Num Sp Node For IX = 0 To IXLimit Get #1, DPtr, .SpecNode(IX) DPtr = DPtr + 22 Next IX Select Case .Size Case 0 ' Large ReDim .Map(63, 63) Get #1, DPtr, .Map DPtr = DPtr + (64 * 64) Case 1 ' Medium ReDim .Map(47, 47) Get #1, DPtr, .Map DPtr = DPtr + (48 * 48) Case 2 ' Small ReDim .Map(31, 31) Get #1, DPtr, .Map DPtr = DPtr + (32 * 32) End Select Get #1, 51, IXLimit ' Num Text ReDim TxtLen(IXLimit) Select Case IXLimit Case 139 Get #1, DPtr, TxtLen TxtPtr = DPtr + IXLimit + 1 For IX = 0 To 119 .Text(IX) = GetVarString(TxtPtr, TxtLen(IX)) TxtPtr = TxtPtr + TxtLen(IX) Next IX For IX = 120 To 169 .Text(IX) = "*" Next IX For IX = 120 To 139 .Text(IX + 50) = GetVarString(TxtPtr, TxtLen(IX)) TxtPtr = TxtPtr + TxtLen(IX) Next IX Case 219 Get #1, DPtr, TxtLen TxtPtr = DPtr + IXLimit + 1 For IX = 0 To 169 .Text(IX) = GetVarString(TxtPtr, TxtLen(IX)) TxtPtr = TxtPtr + TxtLen(IX) Next IX For IX = 170 To 199 TxtPtr = TxtPtr + TxtLen(IX) Next IX For IX = 200 To 219 .Text(IX - 30) = GetVarString(TxtPtr, TxtLen(IX)) TxtPtr = TxtPtr + TxtLen(IX) Next IX Case Else Get #1, DPtr, TxtLen TxtPtr = DPtr + IXLimit + 1 For IX = 0 To IXLimit .Text(IX) = GetVarString(TxtPtr, TxtLen(IX)) TxtPtr = TxtPtr + TxtLen(IX) Next IX End Select End With DataPointer = TxtPtr With DialogData(Townx) DPtr = DataPointer Get #1, 63, IXLimit ' Num Text ' IXLimit = cstTwnDlogNode For IX = 0 To IXLimit .Node(IX).Personality = GetInteger(DPtr) .Node(IX).Type = GetInteger(DPtr + 2) .Node(IX).Word(0) = GetString(DPtr + 4, 4) .Node(IX).Word(1) = GetString(DPtr + 8, 4) .Node(IX).Extra(0) = GetInteger(DPtr + 12) .Node(IX).Extra(1) = GetInteger(DPtr + 14) .Node(IX).Extra(2) = GetInteger(DPtr + 16) .Node(IX).Extra(3) = GetInteger(DPtr + 18) DPtr = DPtr + 20 Next IX IYlimit = 50 + (IXLimit + 1) * 2 ReDim TxtLen(IYlimit) TxtPtr = DPtr + IYlimit + 1 IY = 0 Get #1, DPtr, TxtLen For IX = 0 To 9 .Person(IX).Name = GetVarString(TxtPtr, TxtLen(IY)) TxtPtr = TxtPtr + TxtLen(IY) IY = IY + 1 Next IX For IX = 0 To 9 .Person(IX).HuhResponse = GetVarString(TxtPtr, TxtLen(IY)) TxtPtr = TxtPtr + TxtLen(IY) IY = IY + 1 Next IX For IX = 0 To 9 .Person(IX).LookResponse = GetVarString(TxtPtr, TxtLen(IY)) TxtPtr = TxtPtr + TxtLen(IY) IY = IY + 1 Next IX For IX = 0 To 9 .Person(IX).NameResponse = GetVarString(TxtPtr, TxtLen(IY)) TxtPtr = TxtPtr + TxtLen(IY) IY = IY + 1 Next IX For IX = 0 To 9 .Person(IX).JobResponse = GetVarString(TxtPtr, TxtLen(IY)) TxtPtr = TxtPtr + TxtLen(IY) IY = IY + 1 Next IX For IX = 0 To IXLimit .Node(IX).Text(0) = GetVarString(TxtPtr, TxtLen(IY)) TxtPtr = TxtPtr + TxtLen(IY) IY = IY + 1 .Node(IX).Text(1) = GetVarString(TxtPtr, TxtLen(IY)) TxtPtr = TxtPtr + TxtLen(IY) IY = IY + 1 Next IX End With DataPointer = TxtPtr End Sub Public Sub InitTownData(Townx As Integer) Dim IX As Integer With TownData(Townx) .OutSect.Loc(0) = 0 .OutSect.Loc(1) = 0 .OutLoc.Loc(0) = 0 .OutLoc.Loc(1) = 0 For IX = 0 To 3 ' wandering monsters .WanderingLoc(IX).Loc(0) = 100 .WanderingLoc(IX).Loc(1) = 0 For IY = 0 To 3 .Wandering(IX, IY) = 0 Next IY Next IX For IX = 0 To 15 ' area/room descriptions For IY = 0 To 3 .AreaLoc(IX).Loc(IY) = 0 Next IY Next IX For IX = 0 To cstTwnSign ' Sign locations .Sign(IX).Loc(0) = 100 .Sign(IX).Loc(1) = 0 Next IX .NField = 7 ReDim .Field(.NField) For IX = 0 To .NField ' Field effects, etc .Field(IX).Num = -1 .Field(IX).Loc(0) = 100 .Field(IX).Loc(1) = 0 Next IX .NItem = 7 ReDim .Item(.NItem) For IX = 0 To .NItem ' Item locations .Item(IX).Type = -1 .Item(IX).Loc(0) = 100 .Item(IX).Loc(1) = 0 .Item(IX).Charges = 0 .Item(IX).AlwaysHere = 0 .Item(IX).Property = 0 .Item(IX).ContainedIn = 0 Next IX .NMonst = 15 ReDim .Monster(.NMonst) For IX = 0 To .NMonst ' Monsters .Monster(IX).Num = 0 .Monster(IX).Loc(0) = 100 .Monster(IX).Loc(1) = 0 .Monster(IX).Attitude = 0 .Monster(IX).CanMove = 1 .Monster(IX).CreatureHere = 0 .Monster(IX).StuffDone(0) = -1 .Monster(IX).StuffDone(1) = -1 .Monster(IX).SpecEncounterGrp = 0 .Monster(IX).Personality = -1 .Monster(IX).TalkPic = 0 .Monster(IX).Extra(0) = 0 .Monster(IX).Extra(1) = 0 .Monster(IX).KilledSpecNode = -1 Next IX .NSpecial = 7 ReDim .Special(.NSpecial) For IX = 0 To .NSpecial ' Special node locations .Special(IX).Num = -1 .Special(IX).Loc(0) = 100 .Special(IX).Loc(1) = 0 Next IX .SpecNode(0).NodeType = 0 ' Special nodes .SpecNode(0).Pict = -1 For IX = 0 To 1 .SpecNode(0).StuffDone(IX) = -1 .SpecNode(0).Mess(IX) = -1 .SpecNode(0).Extra(IX) = -1 .SpecNode(0).Extra(IX + 2) = -1 Next IX .SpecNode(0).JumpTo = -1 For IX = 1 To cstTwnSpNode .SpecNode(IX) = .SpecNode(0) Next IX .SpecNode(0).NodeType = 8 ' 0th node is a town block .SpecNode(0).Extra(0) = 1 For IX = 0 To cstTwnText ' Text .Text(IX) = "" Next IX End With With DialogData(Townx) ' Dialog For IX = 0 To 9 .Person(IX).Name = "Unused" .Person(IX).LookResponse = "" .Person(IX).NameResponse = "" .Person(IX).JobResponse = "" .Person(IX).HuhResponse = "" Next IX For IX = 0 To cstTwnDlogNode .Node(IX).Personality = -1 .Node(IX).Type = 0 .Node(IX).Word(0) = "xxxx" .Node(IX).Word(1) = "xxxx" For IY = 0 To 1 .Node(IX).Text(IY) = "" Next IY For IY = 0 To 3 .Node(IX).Extra(IY) = 0 Next IY Next IX End With End Sub Private Sub PutScenDataV2(DataPointer As Long) Dim IX As Integer Dim IXLimit As Integer Dim DPtr As Long Dim TxtPtr As Long Dim TxtLen(cstScnText) As Byte ' Put data to file Put #1, 5, Scen.Version Put #1, 8, Scen.NumTowns Put #1, 9, Scen.OutSize Put #1, 11, Scen.Difficulty Put #1, 12, Scen.Rating Put #1, 13, Scen.Icon Put #1, 14, CurTown Put #1, 15, CurOutX Put #1, 16, CurOutY Put #1, 17, Scen.StartTownNum Put #1, 18, Scen.StartTownCoord Put #1, 20, Scen.StartOutdoors Put #1, 22, Scen.StartOutCoord Put #1, 23, Scen.ListLock Put #1, 25, cstScnSpNode Put #1, 27, cstScnText Put #1, 33, cstOutSpNode Put #1, 35, cstOutText Put #1, 37, cstoutspecial Put #1, 39, cstOutSign Put #1, 41, cstOutTown Put #1, 49, cstTwnSpNode Put #1, 51, cstTwnText Put #1, 53, cstTwnSpecial Put #1, 55, cstTwnSign Put #1, 57, cstTwnField Put #1, 59, cstTwnItem Put #1, 61, cstTwnMonster Put #1, 63, cstTwnDlogNode DPtr = 1281 For IX = 0 To cstScnTerrain ' Terrain Definitions Put #1, DPtr, TerrDef(IX) DPtr = DPtr + 48 Next IX For IX = 0 To cstScnMonster ' Monster Definitions Put #1, DPtr, MonsterDef(IX) DPtr = DPtr + 64 Next IX For IX = 0 To cstScnItem ' Item Definitions Put #1, DPtr, ItemDef(IX) DPtr = DPtr + 64 Next IX For IX = 0 To 9 Put #1, DPtr, ItemShortcut(IX) ' Item Placement shortcuts DPtr = DPtr + 42 Next IX For IX = 0 To 9 Put #1, DPtr, VarTownEntry(IX) ' Variable Town Entry DPtr = DPtr + 6 Next IX For IX = 0 To 3 Put #1, DPtr, SaveItemArea(IX) ' Saved Item Rectangles DPtr = DPtr + 6 Next IX For IX = 0 To 19 ' Scenario Event Timers Put #1, DPtr, Scen.EventTimer(IX, 0) Put #1, DPtr + 2, Scen.EventTimer(IX, 1) DPtr = DPtr + 4 Next IX For IX = 0 To cstScnSpItem ' Special Items Put #1, DPtr, SpItem(IX) DPtr = DPtr + 4 Next IX For IX = 0 To 23 ' Transports Put #1, DPtr, Boat(IX) DPtr = DPtr + 5 Next IX For IX = 0 To 23 Put #1, DPtr, Horse(IX) DPtr = DPtr + 5 Next IX DPtr = DPtr + (20 * 5) ' Scenario Special Nodes For IX = 0 To cstScnSpNode Put #1, DPtr, Scen.SpecNode(IX) DPtr = DPtr + 22 Next IX TxtPtr = DPtr + cstScnText + 1 ' Scenario Text For IX = 0 To cstScnText TxtLen(IX) = Len(Scen.Text(IX)) Put #1, TxtPtr, Scen.Text(IX) TxtPtr = TxtPtr + TxtLen(IX) Next IX Put #1, DPtr, TxtLen DataPointer = TxtPtr End Sub Private Sub PutOutDataV2(OutX As Integer, OutY As Integer, DataPointer As Long) Dim IX As Integer Dim IXLimit As Integer Dim DPtr As Long Dim TxtPtr As Long Dim TxtLen(cstOutText) As Byte IX = OutX * Scen.OutSize(0) + OutY Put #1, 81 + IX * 4, DataPointer - 1 ' Datablock pointer this outdoor section DPtr = DataPointer With OutData(OutX, OutY) Put #1, DPtr, .NSpecial DPtr = DPtr + 2 Put #1, DPtr, .AreaLoc DPtr = DPtr + 32 Put #1, DPtr, .WanderingLoc DPtr = DPtr + 8 Put #1, DPtr, .Wandering DPtr = DPtr + 88 Put #1, DPtr, .SpecEncounter DPtr = DPtr + 88 For IX = 0 To cstOutSign ' Signs and locations Put #1, DPtr, .Sign(IX) DPtr = DPtr + 2 Next IX For IX = 0 To cstOutTown ' Town and locations Put #1, DPtr, .Town(IX) DPtr = DPtr + 4 Next IX For IX = 0 To .NSpecial ' Specials and locations Put #1, DPtr, .Special(IX) DPtr = DPtr + 4 Next IX For IX = 0 To cstOutSpNode ' Special nodes Put #1, DPtr, .SpecNode(IX) DPtr = DPtr + 22 Next IX Put #1, DPtr, .Map DPtr = DPtr + (48 * 48) TxtPtr = DPtr + cstOutText + 1 For IX = 0 To cstOutText TxtLen(IX) = Len(.Text(IX)) Put #1, TxtPtr, .Text(IX) TxtPtr = TxtPtr + TxtLen(IX) Next IX Put #1, DPtr, TxtLen End With DataPointer = TxtPtr End Sub Private Sub PutTownDataV2(Townx As Integer, DataPointer As Long) Dim IX As Integer Dim IY As Integer Dim IXLimit As Integer Dim IYlimit As Integer Dim DPtr As Long Dim TxtLen() As Byte Dim TxtPtr As Long Dim varString As String Put #1, 481 + Townx * 4, DataPointer - 1 ' Datablock pointer this town DPtr = DataPointer With TownData(Townx) Put #1, DPtr, .NField DPtr = DPtr + 2 Put #1, DPtr, .NItem DPtr = DPtr + 2 Put #1, DPtr, .NMonst DPtr = DPtr + 2 Put #1, DPtr, .NSpecial DPtr = DPtr + 2 Put #1, DPtr, .Size DPtr = DPtr + 1 Put #1, DPtr, .Hidden DPtr = DPtr + 1 Put #1, DPtr, .Light DPtr = DPtr + 2 Put #1, DPtr, .Difficulty DPtr = DPtr + 2 Put #1, DPtr, .DayDies DPtr = DPtr + 2 Put #1, DPtr, .EventStop DPtr = DPtr + 2 Put #1, DPtr, .MaxMonsters DPtr = DPtr + 2 Put #1, DPtr, .EntrySpecial DPtr = DPtr + 4 Put #1, DPtr, .ExitSpecial DPtr = DPtr + 8 Put #1, DPtr, .Boundary DPtr = DPtr + 4 Put #1, DPtr, .AreaLoc DPtr = DPtr + 64 Put #1, DPtr, .EntryLoc DPtr = DPtr + 8 Put #1, DPtr, .ExitLoc DPtr = DPtr + 8 Put #1, DPtr, .EventTimer DPtr = DPtr + 32 Put #1, DPtr, .Wandering DPtr = DPtr + 16 Put #1, DPtr, .WanderingLoc DPtr = DPtr + 8 For IX = 0 To cstTwnSign Put #1, DPtr, .Sign(IX) DPtr = DPtr + 2 Next IX For IX = 0 To .NSpecial Put #1, DPtr, .Special(IX) DPtr = DPtr + 4 Next IX For IX = 0 To .NField Put #1, DPtr, .Field(IX) DPtr = DPtr + 4 Next IX For IX = 0 To .NItem Put #1, DPtr, .Item(IX) DPtr = DPtr + 10 Next IX For IX = 0 To .NMonst Put #1, DPtr, .Monster(IX) DPtr = DPtr + 20 Next IX For IX = 0 To cstTwnSpNode Put #1, DPtr, .SpecNode(IX) DPtr = DPtr + 22 Next IX Select Case .Size Case 0 ' Large Put #1, DPtr, .Map DPtr = DPtr + (64 * 64) Case 1 ' Medium Put #1, DPtr, .Map DPtr = DPtr + (48 * 48) Case 2 ' Small Put #1, DPtr, .Map DPtr = DPtr + (32 * 32) End Select ReDim TxtLen(cstTwnText) As Byte TxtPtr = DPtr + cstTwnText + 1 For IX = 0 To cstTwnText TxtLen(IX) = Len(.Text(IX)) Put #1, TxtPtr, .Text(IX) TxtPtr = TxtPtr + TxtLen(IX) Next IX Put #1, DPtr, TxtLen End With DPtr = TxtPtr With DialogData(Townx) For IX = 0 To cstTwnDlogNode Put #1, DPtr, .Node(IX).Personality Put #1, DPtr + 2, .Node(IX).Type Put #1, DPtr + 4, .Node(IX).Word(0) Put #1, DPtr + 8, .Node(IX).Word(1) Put #1, DPtr + 12, .Node(IX).Extra(0) Put #1, DPtr + 14, .Node(IX).Extra(1) Put #1, DPtr + 16, .Node(IX).Extra(2) Put #1, DPtr + 18, .Node(IX).Extra(3) DPtr = DPtr + 20 Next IX IYlimit = 50 + ((cstTwnDlogNode + 1) * 2) ReDim TxtLen(IYlimit) TxtPtr = DPtr + IYlimit + 1 IY = 0 For IX = 0 To 9 TxtLen(IY) = Len(.Person(IX).Name) Put #1, TxtPtr, .Person(IX).Name TxtPtr = TxtPtr + TxtLen(IY) IY = IY + 1 Next IX For IX = 0 To 9 TxtLen(IY) = Len(.Person(IX).HuhResponse) Put #1, TxtPtr, .Person(IX).HuhResponse TxtPtr = TxtPtr + TxtLen(IY) IY = IY + 1 Next IX For IX = 0 To 9 TxtLen(IY) = Len(.Person(IX).LookResponse) Put #1, TxtPtr, .Person(IX).LookResponse TxtPtr = TxtPtr + TxtLen(IY) IY = IY + 1 Next IX For IX = 0 To 9 TxtLen(IY) = Len(.Person(IX).NameResponse) Put #1, TxtPtr, .Person(IX).NameResponse TxtPtr = TxtPtr + TxtLen(IY) IY = IY + 1 Next IX For IX = 0 To 9 TxtLen(IY) = Len(.Person(IX).JobResponse) Put #1, TxtPtr, .Person(IX).JobResponse TxtPtr = TxtPtr + TxtLen(IY) IY = IY + 1 Next IX For IX = 0 To cstTwnDlogNode TxtLen(IY) = Len(.Node(IX).Text(0)) Put #1, TxtPtr, .Node(IX).Text(0) TxtPtr = TxtPtr + TxtLen(IY) IY = IY + 1 TxtLen(IY) = Len(.Node(IX).Text(1)) Put #1, TxtPtr, .Node(IX).Text(1) TxtPtr = TxtPtr + TxtLen(IY) IY = IY + 1 Next IX End With Put #1, DPtr, TxtLen DataPointer = TxtPtr End Sub