Attribute VB_Name = "Helpers"
Public Enum MENU
    CREATE_OBJECT
    CREATE_CLASS
    CREATE_GLOBAL
    CREATE_PROCEDURE
    CREATE_CONSTANT
    CREATE_ATTRIBUTE
    CREATE_PROPERTY
    CREATE_ARRAY
    CREATE_COMMENT
    CREATE_GRAMMAR
End Enum

Public Enum DIRS
    N_TO
    NE_TO
    E_TO
    SE_TO
    S_TO
    SW_TO
    W_TO
    NW_TO
    IN_TO
    OUT_TO
    U_TO
    D_TO
    CANT_GO
End Enum


Public sfLibraryUsed As StdFont
Public sfLibraryUnused As StdFont
Public sfUserUsed As StdFont
Public sfUserUnused As StdFont
Public sfSymbol As StdFont
Public sfObjects As StdFont
Public sfClasses As StdFont
Public sfProcedures As StdFont

Public ddLibraryColor As Long
Public ddUserColor As Long
Public Properties As infVProperties
Public Attributes As infVAttributes

Public inf As New infInform
Public isLoaded As Boolean

Public sDirPath As String

Sub LoadSettings()
    Dim objRegKey As RegKey
    Dim tb As Single
    Dim X As Integer
    
    With frmMain.cbPropertyType
        .AddItem "Numeric"
        .AddItem "Numeric Array"
        .AddItem "String"
        .AddItem "String Array"
        .AddItem "Identifier"
        .AddItem "Identifier Array"
        .AddItem "Procedure"
    End With

    '
    ' Check Registry. If this is the first execution of Visual Inform, there
    ' shouldn't be any entries.
    '
    CheckRegistry
    
    With frmMain.txtCode
        .SelTabCount = 31
        X = -1
        For tb = 4 To inf.Columns Step 4
            X = X + 1
            .SelTabs(X) = tb
        Next tb
    End With

    Set sfLibraryUsed = New StdFont
    Set sfLibraryUnused = New StdFont
    Set sfUserUsed = New StdFont
    Set sfUserUnused = New StdFont
    Set sfSymbol = New StdFont
    Set sfObjects = New StdFont
    Set sfClasses = New StdFont
    Set sfProcedures = New StdFont

    sfLibraryUsed.Name = "Verdana"
    sfLibraryUsed.Bold = True
    sfLibraryUsed.Size = 10
    sfLibraryUnused.Name = "Courier New"
    sfLibraryUnused.Bold = True
    sfLibraryUnused.Size = 8
    sfUserUsed.Name = "Verdana"
    sfUserUsed.Bold = True
    sfUserUsed.Size = 10
    sfUserUnused.Name = "Courier New"
    sfUserUnused.Bold = True
    sfUserUnused.Size = 8
    sfObjects.Name = "Verdana"
    sfObjects.Bold = True
    sfObjects.Size = 8
    sfClasses.Name = "Verdana"
    sfClasses.Bold = True
    sfClasses.Size = 8
    sfProcedures.Name = "Verdana"
    sfProcedures.Bold = True
    sfProcedures.Size = 8

    ddLibraryColor = RGB(0, 64, 0) ' dark green
    ddUserColor = vbBlue

    Set Properties = New infVProperties
    Set Attributes = New infVAttributes

    ResetLibraryProperties
    ResetLibraryAttributes
    AddHistoryToMenu
    
End Sub

Public Sub ResetLibraryProperties()
    Properties.Clear

    Properties.Add "add_to_scope", True, False
    Properties.Add "after", True, False
    Properties.Add "article", True, False
    Properties.Add "articles", True, False
    Properties.Add "before", True, False
    Properties.Add "cant_go", True, False
    Properties.Add "capacity", True, False
    Properties.Add "d_to", True, False
    Properties.Add "daemon", True, False
    Properties.Add "describe", True, False
    Properties.Add "description", True, False
    Properties.Add "door_dir", True, False
    Properties.Add "door_to", True, False
    Properties.Add "e_to", True, False
    Properties.Add "each_turn", True, False
    Properties.Add "found_in", True, False
    Properties.Add "grammar", True, False
    Properties.Add "in_to", True, False
    Properties.Add "initial", True, False
    Properties.Add "inside_description", True, False
    Properties.Add "invent", True, False
    Properties.Add "life", True, False
    Properties.Add "list_together", True, False
    Properties.Add "n_to", True, False
    Properties.Add "name", True, False
    Properties.Add "ne_to", True, False
    Properties.Add "number", True, False
    Properties.Add "nw_to", True, False
    Properties.Add "orders", True, False
    Properties.Add "out_to", True, False
    Properties.Add "parse_name", True, False
    Properties.Add "plural", True, False
    Properties.Add "react_after", True, False
    Properties.Add "react_before", True, False
    Properties.Add "s_to", True, False
    Properties.Add "se_to", True, False
    Properties.Add "short_name", True, False
    Properties.Add "short_name_indef", True, False
    Properties.Add "sw_to", True, False
    Properties.Add "time_left", True, False
    Properties.Add "time_out", True, False
    Properties.Add "u_to", True, False
    Properties.Add "w_to", True, False
    Properties.Add "when_closed", True, False
    Properties.Add "when_off", True, False
    Properties.Add "when_on", True, False
    Properties.Add "when_open", True, False
    Properties.Add "with_key", True, False
End Sub

Public Sub ResetLibraryAttributes()
    Attributes.Clear

    Attributes.Add "absent", True, False
    Attributes.Add "animate", True, False
    Attributes.Add "clothing", True, False
    Attributes.Add "concealed", True, False
    Attributes.Add "container", True, False
    Attributes.Add "door", True, False
    Attributes.Add "edible", True, False
    Attributes.Add "enterable", True, False
    Attributes.Add "female", True, False
    Attributes.Add "general", True, False
    Attributes.Add "light", True, False
    Attributes.Add "lockable", True, False
    Attributes.Add "locked", True, False
    Attributes.Add "male", True, False
    Attributes.Add "moved", True, False
    Attributes.Add "neuter", True, False
    Attributes.Add "on", True, False
    Attributes.Add "open", True, False
    Attributes.Add "openable", True, False
    Attributes.Add "pluralname", True, False
    Attributes.Add "proper", True, False
    Attributes.Add "scenery", True, False
    Attributes.Add "score", True, False
    Attributes.Add "static", True, False
    Attributes.Add "supporter", True, False
    Attributes.Add "switchable", True, False
    Attributes.Add "talkable", True, False
    Attributes.Add "transparent", True, False
    Attributes.Add "visited", True, False
    Attributes.Add "workflag", True, False
    Attributes.Add "worn", True, False
End Sub

Public Function Tabs(intTabs As Integer) As String
    Tabs = Space(intTabs * inf.TabLength)
End Function

Public Function QuoteBlock(strQuote As String, intTabs As Integer) As String
    '
    ' Return a string with the input string broken up into set lines and
    ' a consistent number of tab indents. Use inf.Columns as a boundary.
    '
    Dim strText As String
    Dim intWidth As Integer
    Dim strCode As String
    Dim wd As Integer
    Dim lw As Integer
    Dim fl As Boolean
    Dim c As Integer

    strText = ""
    
    For c = 1 To Len(strQuote)
        If Mid(strQuote, c, 1) = Chr(34) Then
            strText = strText & "~"
        ElseIf Mid(strQuote, c, 1) = Chr(13) Then
            strText = strText & "^"
            c = c + 1 ' skip the chr(10)
        Else
            strText = strText & Mid(strQuote, c, 1)
        End If
    Next c
    
    intWidth = inf.Columns - (inTabs * inf.TabLength)
    If Len(strText) < intWidth Then
        QuoteBlock = Space(inf.TabLength - 1) & Chr(34) & strText & Chr(34)
        Exit Function
    End If

    wd = 1
    fl = True
    Do Until Len(strText) <= intWidth
        wd = RInstr(intWidth, strText, " ")
        If wd = 0 Then wd = intWidth
        If fl Then
            strCode = Space(inf.TabLength - 1) & Chr(34) & Left(strText, wd - 1) & vbCrLf
            fl = False
        Else
            strCode = strCode & Tabs(1) & Left(strText, wd - 1) & vbCrLf
        End If
        strText = Right(strText, Len(strText) - wd)
    Loop
    QuoteBlock = strCode & Tabs(1) & strText & Chr(34)

End Function

Public Function RInstr(intStart, strSearch, strFind) As Integer
    Dim r As Integer
    For r = intStart To 1 Step -1
        If Mid(strSearch, r, 1) = strFind Then
            RInstr = r
            Exit Function
        End If
    Next r
    RInstr = 0
End Function

Public Function Pad(strInput As String, intPad As Integer) As String
    If Len(strInput) > intPad Then
        Pad = Left(strInput, intPad)
    Else
        Pad = strInput & Space(intPad - Len(strInput))
    End If
End Function

Public Function isBlank(sText) As Boolean
    If Trim(sText & " ") = "" Then
        isBlank = True
    Else
        isBlank = False
    End If
End Function

Public Sub AddHistoryToMenu()
    Dim objRegKey As RegKey
    Dim sFile As String
    Dim lFile As Long
    Dim lSlash As Long
    On Error Resume Next
    Set objRegKey = RegKeyFromString("\HKEY_LOCAL_MACHINE\Software\VInform\Recent Files")
    sFile = objRegKey.Values("1")
    If Err.Number = 0 Then
        lSlash = RInstr(Len(sFile), sFile, "\")
        frmMain.mnuOpenFile1.Caption = "&1 " & Right(sFile, Len(sFile) - lSlash)
        frmMain.mnuOpenFile1.Visible = True
        frmMain.mnuFileSep.Visible = True
    End If
    sFile = objRegKey.Values("2")
    If Err.Number = 0 Then
        lSlash = RInstr(Len(sFile), sFile, "\")
        frmMain.mnuOpenFile2.Caption = "&2 " & Right(sFile, Len(sFile) - lSlash)
        frmMain.mnuOpenFile2.Visible = True
        frmMain.mnuFileSep.Visible = True
    End If
    sFile = objRegKey.Values("3")
    If Err.Number = 0 Then
        lSlash = RInstr(Len(sFile), sFile, "\")
        frmMain.mnuOpenFile3.Caption = "&3 " & Right(sFile, Len(sFile) - lSlash)
        frmMain.mnuOpenFile3.Visible = True
        frmMain.mnuFileSep.Visible = True
    End If
    sFile = objRegKey.Values("4")
    If Err.Number = 0 Then
        lSlash = RInstr(Len(sFile), sFile, "\")
        frmMain.mnuOpenFile4.Caption = "&4 " & Right(sFile, Len(sFile) - lSlash)
        frmMain.mnuOpenFile4.Visible = True
        frmMain.mnuFileSep.Visible = True
    End If
    Set objRegKey = Nothing
    On Error GoTo 0
End Sub

Public Sub AddFileToHistory(sFile As String)
    Dim objRegKey As RegKey
    Dim f1 As Boolean
    Dim f2 As Boolean
    Dim f3 As Boolean
    Dim f4 As Boolean
    Dim sFile1 As String
    Dim sFile2 As String
    Dim sFile3 As String
    Dim sFile4 As String
    On Error Resume Next
    Set objRegKey = RegKeyFromString("\HKEY_LOCAL_MACHINE\Software\VInform\Recent Files")
    sFile1 = objRegKey.Values("1")
    If Err.Number = 0 Then
        f1 = True
    Else
        f1 = False
    End If
    sFile2 = objRegKey.Values("2")
    If Err.Number = 0 Then
        f2 = True
    Else
        f2 = False
    End If
    sFile3 = objRegKey.Values("3")
    If Err.Number = 0 Then
        f3 = True
    Else
        f3 = False
    End If
    sFile4 = objRegKey.Values("4")
    If Err.Number = 0 Then
        f4 = True
    Else
        f4 = False
    End If
    Set objRegKey = Nothing
    
    If sFile <> sFile1 Then
        With frmMain
            If Not f1 Then
                AddReg "Recent Files", "1", sFile
            ElseIf Not f2 Then
                DelReg "Recent Files", "1"
                AddReg "Recent Files", "1", sFile
                AddReg "Recent Files", "2", sFile1
            ElseIf Not f3 Then
                DelReg "Recent Files", "1"
                DelReg "Recent Files", "2"
                AddReg "Recent Files", "1", sFile
                AddReg "Recent Files", "2", sFile1
                AddReg "Recent Files", "3", sFile2
            ElseIf Not f4 Then
                DelReg "Recent Files", "1"
                DelReg "Recent Files", "2"
                DelReg "Recent Files", "3"
                AddReg "Recent Files", "1", sFile
                AddReg "Recent Files", "2", sFile1
                AddReg "Recent Files", "3", sFile2
                AddReg "Recent Files", "4", sFile3
            Else
                DelReg "Recent Files", "1"
                DelReg "Recent Files", "2"
                DelReg "Recent Files", "3"
                DelReg "Recent Files", "4"
                AddReg "Recent Files", "1", sFile
                AddReg "Recent Files", "2", sFile1
                AddReg "Recent Files", "3", sFile2
                AddReg "Recent Files", "4", sFile3
            End If
        End With
    End If
    On Error GoTo 0
End Sub

Public Sub AddReg(sPath As String, sName As String, sKey As String)
    Dim objRegKey As RegKey
    Set objRegKey = RegKeyFromString("\HKEY_LOCAL_MACHINE\Software\VInform\" & sPath)
    objRegKey.Values.Add sName, sKey, RegValueType.rvString
    Set objRegKey = Nothing
End Sub

Public Sub DelReg(sPath As String, sName As String)
    Dim objRegKey As RegKey
    Set objRegKey = RegKeyFromString("\HKEY_LOCAL_MACHINE\Software\VInform\" & sPath)
    objRegKey.Values.Remove sName
    Set objRegKey = Nothing
End Sub

Public Function ReadReg(sPath As String, sName As String) As String
    Dim objRegKey As RegKey
    Set objRegKey = RegKeyFromString("\HKEY_LOCAL_MACHINE\Software\VInform\" & sPath)
    ReadReg = objRegKey.Values(sName)
    Set objRegKey = Nothing
End Function

Public Sub SetReg(sPath As String, sName As String, sValue As String)
    Dim objRegKey As RegKey
    Set objRegKey = RegKeyFromString("\HKEY_LOCAL_MACHINE\Software\VInform\" & sPath)
    objRegKey.Values(sName).Value = sValue
    Set objRegKey = Nothing
End Sub

Public Sub CheckRegistry()
    '
    ' \HKEY_LOCAL_MACHINE\Software\VInform
    '       Columns = 80
    '       TabLength = 4
    '       Path = App Path
    '       \Library
    '           0       lib\6.7
    '           2       lib\6.10
    '           4       lib\6.10G
    '       \Recent Files
    '
    On Error Resume Next
    Dim objRegKey As RegKey
    Set objRegKey = RegKeyFromString("\HKEY_LOCAL_MACHINE\Software\VInform")
    If Err.Number = 0 Then
        '
        ' Get library and compiler paths from registry
        '
        Set objRegKey = RegKeyFromString("\HKEY_LOCAL_MACHINE\Software\VInform\")
        inf.Columns = objRegKey.Values("Columns")
        If Err.Number <> 0 Then
            objRegKey.Values.Add "Columns", 80, RegValueType.rvString
            inf.Columns = objRegKey.Values("Columns")
        End If
        inf.TabLength = objRegKey.Values("TabLength")
        If Err.Number <> 0 Then
            objRegKey.Values.Add "TabLength", 4, RegValueType.rvString
            inf.TabLength = objRegKey.Values("TabLength")
        End If
        inf.BrowserFilename = objRegKey.Values("BrowserFilename")
        If Err.Number <> 0 Then
            objRegKey.Values.Add "BrowserFilename", "C:\Program Files\Internet Explorer\IEXPLORE.EXE", RegValueType.rvString
            inf.TabLength = objRegKey.Values("BrowserFilename")
        End If
        Set objRegKey = Nothing
        Exit Sub
    End If

    Set objRegKey = RegKeyFromString("\HKEY_LOCAL_MACHINE\Software")
    objRegKey.SubKeys.Add "VInform"
    Set objRegKey = RegKeyFromString("\HKEY_LOCAL_MACHINE\Software\VInform")
    objRegKey.Values.Add "Columns", 80, RegValueType.rvString
    objRegKey.Values.Add "TabLength", 4, RegValueType.rvString
    objRegKey.Values.Add "BrowserFilename", "C:\Program Files\Internet Explorer\IEXPLORE.EXE", RegValueType.rvString
    objRegKey.Values.Add "Path", App.Path, RegValueType.rvString
    objRegKey.SubKeys.Add "Library"
    objRegKey.SubKeys.Add "Recent Files"
    Set objRegKey = RegKeyFromString("\HKEY_LOCAL_MACHINE\Software\VInform\Library")
    objRegKey.Values.Add "0", App.Path & "\lib\6.7\", RegValueType.rvString
    objRegKey.Values.Add "2", App.Path & "\lib\6.10\", RegValueType.rvString
    objRegKey.Values.Add "4", App.Path & "\lib\6.10G\", RegValueType.rvString
    '
    ' Get library and compiler paths from registry
    '
    Set objRegKey = RegKeyFromString("\HKEY_LOCAL_MACHINE\Software\VInform\")
    inf.Columns = objRegKey.Values("Columns")
    inf.TabLength = objRegKey.Values("TabLength")
    inf.BrowserFilename = objRegKey.Values("BrowserFilename")
    Set objRegKey = Nothing
End Sub

Public Function TrimAll(sText As String) As String
    Dim lsText As String

    lsText = Trim(sText)

    Do While InStr(1, cnWHITESPACE, Mid(lsText, Len(lsText), 1)) > 0
        lsText = Left(lsText, Len(lsText) - 1)
    Loop
    Do While InStr(1, cnWHITESPACE, Left(lsText, 1)) > 0
        lsText = Right(lsText, Len(lsText) - 1)
    Loop
    TrimAll = lsText
End Function