'GENERAL DECLARATIONS

Option Explicit  'Forces declaration of all variables
Public FireBreak As New Forest
Public Road As New Forest
Public Grass As New Forest
Public Trees As New Forest
Public Fire As New Forest
Public WSpeed As Integer
Public WDirection As Integer

Dim FireTracking() As Forest
'NOTE: THIS VERSION USES A DUMB SWEEP, ALL THE WAY THROUGH EACH TIME. CHANGE TO FIND AND
'FOCUS ON THE FIRE. THEN SWEEP OUTWARD FROM THE FIRE

'DIMENSION ALL VARIABLES USED
'Note that input values are for the plotting grid reference. They refer to lines
'With lines starting at 0 in both directions
Dim i As Integer
Dim j As Integer
Dim length As Integer 'Length of the area, feet
Dim width As Integer 'Width of the area, feet
Dim Spacing As Integer 'Width of a cell, resolution, feet
Dim WindSpeed As Integer 'Speed of the wind, FPS
Dim FireStartCol As Integer 'Left boundary column where fire starts
Dim FireEndCol As Integer 'Right boundary column where fire starts
Dim FireStartRow As Integer 'Bottom boundary row where fire starts
Dim FireEndRow As Integer 'Top boundary row where fire starts
Dim WindDirection As Integer 'Direction of the wind, 8 possibilities
Dim FBStartRow As Integer 'Start row of fire break
Dim FBEndRow As Integer 'End row of fire break
Dim FBStartCol As Integer 'Start col of fire break
Dim FBEndCol As Integer 'End col of fire break
Dim GrassStartRow As Integer 'Start row of grass
Dim GrassEndRow As Integer 'End row of grass
Dim GrassStartCol As Integer 'Start col of grass
Dim GrassEndCol As Integer 'End col of grass
Dim HFBStartCol As Integer 'Start col of horizontal fire break
Dim HFBEndCol As Integer 'End col of horizontal fire break
Dim HFBStartRow As Integer 'Start row of horizontal fire break
Dim HFBEndRow As Integer 'End row of horizontal fire break
Dim LeftColRoad As Integer 'Left column of vertical road
Dim Precipitation As Integer 'Rain

'CAPTURE VALUES OF THE VARIABLES FROM USER INPUT
length = Val(LengthIn.Text)
width = Val(WidthIn.Text)
Spacing = Val(SpacingIn.Text)
WindSpeed = Val(WindSpeedIn.Text)
WSpeed = Val(WindSpeedIn.Text)
FireStartRow = Val(FireStartRowIn.Text)
FireEndRow = Val(FireEndRowIn.Text)
FireStartCol = Val(FireStartColIn.Text)
FireEndCol = Val(FireEndColIn.Text)
WindDirection = Val(WindDirectionIn.Text)
WDirection = Val(WindDirectionIn.Text)
FBStartRow = Val(SRFB.Text)
FBEndRow = Val(ERFB.Text)
FBStartCol = Val(SCFB.Text)
FBEndCol = Val(ECFB.Text)
GrassStartRow = Val(SRGrass.Text)
GrassEndRow = Val(ERGrass.Text)
GrassStartCol = Val(SCGrass.Text)
GrassEndCol = Val(ECGrass.Text)
HFBStartRow = Val(HFBStartRowIn.Text)
HFBEndRow = Val(HFBEndRowIn.Text)
HFBStartCol = Val(HFBStartColIn.Text)
HFBEndCol = Val(HFBEndColIn.Text)
Precipitation = Val(PrecipitationIn.Text) 'Rain
Form3.AutoRedraw = True

'CALL METHOD TO CREATE GRID FOR VISUAL REPRESENTATION
Call CreateGrid(length, width, Spacing, FireStartCol, FireStartRow, FireEndCol, _
FireEndRow, FBStartRow, FBEndRow, FBStartCol, FBEndCol, GrassStartRow, GrassEndRow, _
GrassStartCol, GrassEndCol, LeftColRoad, HFBStartRow, HFBEndRow, HFBStartCol, _
HFBEndCol)

'THE MSGBOX METHOD PAUSES THE PROGRAM SO THE THAT USER CAN SEE THE INITIAL CONFIGURATION
'BEFORE CONTINUING
Dim response As Integer
response = MsgBox("Initial configuration. Press OK to continue, Cancel to terminate", _
vbOK, "FIRE ANALYSIS PROGRAM")
Select Case response
Case vbCancel
End
Case vbOK
End Select

'CALL METHOD TO INITIALIZE OBJECTS
Call InitializeObjects(FireBreak, Road, Grass, Trees, Fire, WindDirection, FBStartRow, _
FBEndRow, FBStartCol, FBEndCol, GrassStartRow, GrassEndRow, GrassStartCol, _
GrassEndCol, Precipitation, HFBStartRow, HFBEndRow, HFBStartCol, HFBEndCol)

'CALL METHOD TO INITIALIZE FIRE TRACKING ARRAY WITH APPROPRIATE OBJECTS
Call FireTrackingArray(FireBreak, Road, Grass, Trees, Fire, length, width, FireStartCol, _
FireEndCol, FireStartRow, FireEndRow, GrassStartRow, GrassEndRow, GrassStartCol, _
GrassEndCol, FBStartRow, FBEndRow, FBStartCol, FBEndCol, HFBStartRow, HFBEndRow, _
HFBStartCol, HFBEndCol)
End Sub

Private Sub InitializeObjects(ByRef FireBreak, ByRef Road , ByRef Grass, ByRef Trees, _
ByRef Fire, ByVal WindDirection As Integer, ByVal FBStartRow As Integer, ByVal FBEndRow As Integer, _
ByVal FBStartCol As Integer, ByVal FBEndCol As Integer, ByVal GrassStartRow As Integer, _
ByVal GrassEndRow, ByVal GrassStartCol, ByVal GrassEndCol, ByVal Precipitation As Integer, _
HFBStartRow, HFBEndRow, HFBStartCol, HFBEndCol)

'Dimension the parameters
'Fire Status in a cell, True or False
Dim F As Boolean
'Status of vegetation: 1: Trees, 2: Grass, 3: Fire Break
Dim V As Integer
'Precipitation: 0: No rain, 1: light rain, 2: medium rain, 3: heavy rain
Dim P As Integer

'Moisture: 0: Dry, 1: slightly moist, 2: moderately moist, 3: very moist
Dim M As Integer
'Slope of terrain: 1: level, 2: slightly sloping, 3: steep slope
Dim S As Integer
'Wind speed, integer between 0 and 100 FPS
Dim W As Integer
'Wind direction: 1: N, 2: NE, 3: E, 4: SE, 5: S, 6: SW, 7: W, 8: NW
Dim WD As Integer
'Can Burn or not: True or False
Dim CB As Boolean

'Initialize the FireBreak object
F = False
V = 1
P = 1
M = 1
S = 1
W = 10
WD = 3
CB = False
Call FireBreak.SetData(F, V, P, M, S, W, WD, CB)

'Initialize the Trees object
F = False
V = 1
P = 1
M = 1
S = 1
W = 10
WD = 3
CB = True
Call Trees.SetData(F, V, P, M, S, W, WD, CB)

'Initialize the Grass object
F = False
V = 1
P = 1
M = 1
S = 1
W = 10
WD = 3
CB = True
Call Grass.SetData(F, V, P, M, S, W, WD, CB)

'Initialize the Roads object
F = False
V = 1
P = 1
M = 1
S = 1
W = 10
WD = 3
CB = False
Call Road.SetData(F, V, P, M, S, W, WD, CB)

'Initialize the Fire object
F = True
V = 1
P = 1
M = 1
S = 1
W = 10
WD = 3
CB = True
Call Fire.SetData(F, V, P, M, S, W, WD, CB)
End Sub

'METHOD TO CREATE GRID FOR VISUAL REPRESENTATION
Private Sub CreateGrid(ByVal length As Integer, ByVal width As Integer, _
ByVal Spacing As Integer, ByVal FireStartCol As Integer, ByVal FireStartRow As Integer, _
ByVal FireEndCol As Integer, ByVal FireEndRow As Integer, ByVal FBStartRow As Integer, _
ByVal FBEndRow As Integer, ByVal FBStartCol As Integer, ByVal FBEndCol As Integer, _
ByVal GrassStartRow As Integer, ByVal GrassEndRow As Integer, ByVal GrassStartCol As Integer, _
ByVal GrassEndCol As Integer, ByVal LeftColRoad As Integer, HFBStartRow, HFBEndRow, _
HFBStartCol, HFBEndCol)

Dim i As Integer 'Loop variable
Dim j As Integer 'Loop variable
Form3.WindowState = 2 'Maximize the window
StartTime = Hour(Time) * 60 + Minute(Time) 'Calculate starting time from system clock
Form3.Text4.Text = StartTime 'Place start time on form
Form3.Show 'Show the form
'Scale output form, boundaries (equal to spacing) added for readability
Form3.Scale (-Spacing, width + 5 * Spacing)-(length + Spacing, -5 * Spacing)

'Initialize all cells to green, occupied by trees
Dim count As Integer
count = 0
For i = 0 To width - 1 Step Spacing
count = count + 1
For j = 0 To length Step Spacing
Form3.Line (i, j)-(i + Spacing, count * Spacing), vbGreen, B
Next j
Next i

'Change fire start cell to solid red
Form3.Line (FireStartCol * Spacing, FireStartRow * Spacing)-(FireEndCol * Spacing, _
FireEndRow * Spacing), vbRed, BF
'Draw the fire break cells solid yellow
Form3.Line (FBStartCol * Spacing, FBStartRow * Spacing)-(FBEndCol * Spacing, _
FBEndRow * Spacing), vbYellow, BF
'Draw the grass cells solid green
Form3.Line (GrassStartCol * Spacing, GrassStartRow * Spacing)-(GrassEndCol * Spacing, _
GrassEndRow * Spacing), vbGreen, BF
'Draw the horizontal road in solid black
Form3.Line (HFBStartCol * Spacing, HFBStartRow * Spacing)- _
(HFBEndCol * Spacing, HFBEndRow * Spacing), vbBlack, BF
End Sub

'METHOD TO CREATE ARRAY FOR STATUS TRACKING
Public Sub FireTrackingArray(FireBreak, Road, Grass, Trees, Fire, length, width, FireStartCol, _
FireEndCol, FireStartRow, FireEndRow, GrassStartRow, GrassEndRow, GrassStartCol, _
GrassEndCol, FBStartRow, FBEndRow, FBStartCol, FBEndCol, HFBStartRow, HFBEndRow, _
HFBStartCol, HFBEndCol)
Dim i As Integer
Dim j As Integer

ReDim FireTracking(width, length) As Forest 'Creates array of type Forest
'Initialize each element of array as reference to Forest objects
For i = 0 To width - 1
For j = 0 To length - 1
Set FireTracking(i, j) = New Forest
Next j
Next i
'Set each element to Tree object, will be modified subsequently below
For i = 0 To width - 1
For j = 0 To length - 1
Set FireTracking(i, j) = Trees
Next j
Next i
'Set horizontal fire break elements
For i = HFBStartRow To HFBEndRow
For j = 0 To length - 1
Set FireTracking(i, j) = Road
Next j
Next i
'Set Fire Break elements
For i = FBStartRow To FBEndRow
For j = FBStartCol To FBEndCol
Set FireTracking(i, j) = FireBreak
Next j
Next i
'Set Grass elements
For i = GrassStartRow To GrassEndRow
For j = GrassStartCol To GrassEndCol
Set FireTracking(i, j) = Grass
Next j
Next i
'Set Fire Start Location.
For i = FireStartRow To FireEndRow - 1
For j = FireStartCol To FireEndCol - 1
Set FireTracking(i, j) = Fire
Next j
Next i
Dim count As Integer
Dim output As Integer
output = 0
count = 0
For i = 0 To width - 1
For j = 0 To length - 1
If FireTracking(i, j).FireStatus = True Then
count = count + 1
End If
Next j
Next i
End Sub

'METHOD TO SWEEP THROUGH FIRETRACKING ARRAY TO CHECK FOR FIRE AND UPDATE PLOT
'THIS METHOD IS CALLED AND CONTROLLED BY A TIMER
'IT IS IN THE TIMER CODE AND CONTAINS A LOOP
Public Sub StatusCheck()
Dim width As Integer
Dim length As Integer
Dim Spacing As Integer
width = Val(WidthIn.Text) 'cannot be passed with timer control
length = Val(LengthIn.Text) 'cannot be passed with timer control
Spacing = Val(SpacingIn.Text)
Dim r As Integer
Dim i As Integer
Dim j As Integer
'LEFT TOP BOUNDARY CELL
For i = 0 To 0
For j = 0 To 0
If FireTracking(i, j).FireStatus = False And _
FireTracking(i, j).CanBurn = True And _
FireTracking(i, j + 1).FireStatus = True Or _
FireTracking(i + 1, j).FireStatus = True Or _
FireTracking(i + 1, j + 1).FireStatus = True _
Then
Call UpDateGrid(i, j, width, length, Spacing)
Let FireTracking(i, j).FireStatus = True
End If
Next j
Next i
'TOP BOUNDARY CELLS LESS THE 2 TOP BORDER CELLS
For i = 0 To 0
For j = 1 To length - 2
If FireTracking(i, j).FireStatus = False And _
FireTracking(i, j).CanBurn = True And _
FireTracking(i, j - 1).FireStatus = True Or _
FireTracking(i + 1, j - 1).FireStatus = True Or _
FireTracking(i + 1, j).FireStatus = True Or _
FireTracking(i + 1, j + 1).FireStatus = True Or _
FireTracking(i, j + 1).FireStatus = True _
Then
Call UpDateGrid(i, j, width, length, Spacing)
Let FireTracking(i, j).FireStatus = True
End If
Next j
Next i
'RIGHT TOP BOUNDARY CELL
For i = 0 To 0
For j = length - 1 To length - 1
If FireTracking(i, j).FireStatus = False And _
FireTracking(i, j).CanBurn = True And _
FireTracking(i, j - 1).FireStatus = True Or _
FireTracking(i + 1, j - 1).FireStatus = True Or _
FireTracking(i + 1, j).FireStatus = True _
Then
Call UpDateGrid(i, j, width, length, Spacing)
Let FireTracking(i, j).FireStatus = True
End If
Next j
Next i
'LEFT BOUNDARY CELLS LESS THE CORNERS
For i = 1 To width - 2
For j = 0 To 0
If FireTracking(i, j).FireStatus = False And _
FireTracking(i, j).CanBurn = True And _
FireTracking(i - 1, j).FireStatus = True Or _
FireTracking(i + 1, j).FireStatus = True Or _
FireTracking(i, j + 1).FireStatus = True Or _
FireTracking(i - 1, j + 1).FireStatus = True Or _
FireTracking(i + 1, j + 1).FireStatus = True _
Then
Call UpDateGrid(i, j, width, length, Spacing)
Let FireTracking(i, j).FireStatus = True
End If
Next j
Next i

'NON-BOUNDARY CELLS: All cells i, j, except cells along a boundary have 8 neighbors
For i = 1 To (width - 2) 'non-boundary cells
For j = 1 To (length - 2) 'non-boundary cells
If FireTracking(i, j).FireStatus = False And _
FireTracking(i, j).CanBurn = True And _
FireTracking(i + 1, j).FireStatus = True Or _
FireTracking(i - 1, j).FireStatus = True Or _
FireTracking(i, j + 1).FireStatus = True Or _
FireTracking(i, j - 1).FireStatus = True Or _
FireTracking(i - 1, j - 1).FireStatus = True Or _
FireTracking(i + 1, j + 1).FireStatus = True Or _
FireTracking(i - 1, j + 1).FireStatus = True Or _
FireTracking(i + 1, j - 1).FireStatus = True _
Then
Call UpDateGrid(i, j, width, length, Spacing)
Let FireTracking(i, j).FireStatus = True
End If
Next j
Next i
'RIGHT BOUNDARY CELLS LESS THE CORNERS
For i = 1 To width - 2
For j = length - 1 To length - 1
If FireTracking(i, j).FireStatus = False And _
FireTracking(i, j).CanBurn = True And _
FireTracking(i - 1, j - 1).FireStatus = True Or _
FireTracking(i, j - 1).FireStatus = True Or _
FireTracking(i + 1, j - 1).FireStatus = True Or _
FireTracking(i + 1, j).FireStatus = True Or _
FireTracking(i - 1, j).FireStatus = True _
Then
Call UpDateGrid(i, j, width, length, Spacing)
Let FireTracking(i, j).FireStatus = True
End If
Next j
Next i
'LEFT BOTTOM BOUNDARY CELL
For i = width - 1 To width - 1
For j = 0 To 0
If FireTracking(i, j).FireStatus = False And _
FireTracking(i, j).CanBurn = True And _
FireTracking(i - 1, j).FireStatus = True Or _
FireTracking(i - 1, j + 1).FireStatus = True Or _
FireTracking(i, j + 1).FireStatus = True _
Then
Call UpDateGrid(i, j, width, length, Spacing)
Let FireTracking(i, j).FireStatus = True
End If
Next j
Next i
'BOTTOM BOUNDARY CELLS LESS THE LEFT AND RIGHT CORNERS
For i = width - 1 To width - 1
For j = 1 To length - 2
If FireTracking(i, j).FireStatus = False And _
FireTracking(i, j).CanBurn = True And _
FireTracking(i, j - 1).FireStatus = True Or _
FireTracking(i - 1, j - 1).FireStatus = True Or _
FireTracking(i - 1, j).FireStatus = True Or _
FireTracking(i - 1, j + 1).FireStatus = True Or _
FireTracking(i, j + 1).FireStatus = True _
Then
Call UpDateGrid(i, j, width, length, Spacing)
Let FireTracking(i, j).FireStatus = True
End If
Next j
Next i
'RIGHT BOTTOM BOUNDARY CELL
For i = width - 1 To width - 1
For j = length - 1 To length - 1
If FireTracking(i, j).FireStatus = False And _
FireTracking(i, j).CanBurn = True And _
FireTracking(i - 1, j - 1).FireStatus = True Or _
FireTracking(i, j - 1).FireStatus = True Or _
FireTracking(i - 1, j).FireStatus = True _
Then
Call UpDateGrid(i, j, width, length, Spacing)
Let FireTracking(i, j).FireStatus = True
End If
Next j
Next i
End Sub

'METHOD TO UPDATE THE FIRE PLOTTING GRID
'Conversions have to be made to account for fact that array goes from 0 to length - 1 and width - 1, starting
'upper left and the plotting goes from 0 to Length and Width starting bottom left.
Private Sub UpDateGrid(ByVal i As Integer, ByVal j As Integer, ByVal width As Integer, _
ByVal length As Integer, ByVal Spacing As Integer)
Dim response As Integer
response = MsgBox("Fire progression shown. Press OK to continue, Cancel to terminate", _
vbOK, "FIRE ANALYSIS PROGRAM")
Select Case response
Case vbCancel
End
Case vbOK
End Select
Dim x As Integer
Dim y As Integer
Dim ISet As Integer
Dim JSet As Integer
'Start x or col: x = j * Spacing
'End x or col: x = (j + 1) * Spacing
'Start y or row: y = i * Spacing
'End y or row: y = (i + 1) * Spacing
'Dim WindDirection As Integer
If (WDirection = 1) Then 'North
ISet = i - 1
JSet = j
End If
If (WDirection = 2) Then 'Northeast
ISet = i - 1
JSet = j + 1
End If
If (WDirection = 3) Then 'east
ISet = i
JSet = j + 1
End If
If (WDirection = 4) Then 'se
ISet = i + 1
JSet = j + 1
End If
If (WDirection = 5) Then 's
ISet = i + 1
JSet = j
End If
If (WDirection = 6) Then 'sw
ISet = i + 1
JSet = j - 1
End If
If (WDirection = 7) Then 'w
ISet = i
JSet = j - 1
End If
If (WDirection = 8) Then 'nw
ISet = i - 1
JSet = j - 1
End If
Form3.Line (i * Spacing, j * Spacing)-((JSet) * Spacing, ((ISet) * Spacing)), vbRed, BF
End Sub