taverngen.vb

Option Explicit
Private Function Menu(Quality, EType)
    Dim M, FoodPriceS, DrinkPriceS As String
    Dim FCount, DCount, DP, FP As Integer
    
    Dim Dum As String
    
    Dim SplitIt() As String
    
    Dim i, j As Long
    
    Dim PrevValue As Double
    
    Dim FoodTable(), FoodPrice(), DrinkTable(), DrinkPrice() As Variant
    
    'get tables
    FoodTable() = Sheets("Menu Items").Range("Food[" & Quality & "]").Value
    DrinkTable() = Sheets("Menu Items").Range("Drink[" & Quality & "]").Value
    
    FoodPrice() = Sheets("Menu Items").Range("FoodPricing").Value
    DrinkPrice() = Sheets("Menu Items").Range("DrinkPricing").Value
    
    'get prices
    For i = 1 To UBound(FoodPrice(), 1)
        If FoodPrice(i, 1) = Quality Then
            FoodPriceS = FoodPrice(i, 2)
            FCount = FoodPrice(i, 3) + Rand(1, -1, False)
            
            For j = 1 To UBound(FoodTable(), 1)
                If FoodTable(j, 1) = "" Then
                    Exit For
                End If
            Next
            
            j = j - 1
            
            If FCount > j Then FCount = j
            
            Exit For
        End If
    Next
    
    For i = 1 To UBound(DrinkPrice(), 1)
        If DrinkPrice(i, 1) = Quality Then
            DrinkPriceS = DrinkPrice(i, 2)
            DCount = DrinkPrice(i, 3)
            
            For j = 1 To UBound(DrinkTable(), 1)
                If DrinkTable(j, 1) = "" Then
                    Exit For
                End If
            Next
            
            j = j - 1
            
            If DCount > j Then DCount = j
            
            Exit For
        End If
    Next
    
    'header
    If FCount + DCount > 0 Then
        M = "Menu"
        
        'get food
        If FCount > 0 Then
            SplitIt() = Split(FoodPriceS, " ")
            
            If CInt(SplitIt(0)) > 1 Then
                j = -1
            Else
                j = 0
            End If
            
            For i = 1 To FCount
                'price
                Dum = CInt(SplitIt(0)) + Rand(1, j, False) & " " & SplitIt(1)
                
                'item
                Dum = RandVal(FoodTable(), 1, False, PrevValue, True) & " - " & Dum
                
                FoodTable(PrevValue, 1) = ""
                
                M = M & vbNewLine & Dum
            Next
        End If
        
        'get drink
        SplitIt() = Split(DrinkPriceS, " ")
        
        If CInt(SplitIt(0)) > 1 Then
            j = -1
        Else
            j = 0
        End If
        
        For i = 1 To DCount
            'price
            Dum = CInt(SplitIt(0)) + Rand(1, j, False) & " " & SplitIt(1)
            
            'item
            Dum = RandVal(DrinkTable(), 1, False, PrevValue, True) & " - " & Dum
            
            DrinkTable(PrevValue, 1) = ""
            
            M = M & vbNewLine & Dum
        Next
        
        Menu = M
    End If
End Function
Public Sub ReplaceAttendant()
    
    Dim OApp, OPer, OName As String
    
    Dim SplitIt() As String
    
    Dim PBTName, PBTRace, PBTGender, PBTHNR, NPCTitle As String
    Dim BTAppearance, BTPersonality, BTName As String
    
    Dim Establishment As String
    
    Dim Dum As String
    
    If Sheets("Establishment Generator").Range("BTAppearance").Value = "" Or Sheets("Establishment Generator").Range("BTPersonality").Value = "" Then
        Dum = MsgBox("This function requires the previous attendant appearance and personality to be present to work correctly.", vbOKOnly, "Error")
        End
    End If
    
    'get original values
    OApp = Sheets("Establishment Generator").Range("BTAppearance").Value
    OPer = Sheets("Establishment Generator").Range("BTPersonality").Value
    SplitIt() = Split(OApp, " is ")
    OName = SplitIt(0)
    
    'get title
    SplitIt() = Split(OPer, " ")
    NPCTitle = SplitIt(1)
    
    'Get parameters
    PBTName = Sheets("Establishment Generator").Range("BTName").Value
    PBTRace = Sheets("Establishment Generator").Range("BTRace").Value
    PBTGender = Sheets("Establishment Generator").Range("BTGender").Value
    PBTHNR = Sheets("Establishment Generator").Range("BTHNR").Value
    BTAppearance = Sheets("Establishment Generator").Range("BTAppearance").Value
    BTPersonality = Sheets("Establishment Generator").Range("BTPersonality").Value
    
    'generate npc
    Call GenerateNPC(PBTName, PBTRace, PBTGender, PBTHNR, BTAppearance, BTPersonality, BTName, NPCTitle)
    
    'Export
    Sheets("Establishment Generator").Range("BTName").Value = BTName
    Sheets("Establishment Generator").Range("BTRace").Value = PBTRace
    Sheets("Establishment Generator").Range("BTGender").Value = PBTGender
    Sheets("Establishment Generator").Range("BTHNR").Value = PBTHNR
    Sheets("Establishment Generator").Range("BTAppearance").Value = BTAppearance
    
    BTPersonality = "The " & NPCTitle & " " & BTPersonality
    Sheets("Establishment Generator").Range("BTPersonality").Value = BTPersonality
    
    'replace attendant
    Establishment = Sheets("Establishment Generator").Range("EOutput").Value
    
    Establishment = Replace(Establishment, OPer, BTPersonality)
    Establishment = Replace(Establishment, OApp, BTAppearance)
    
    Sheets("Establishment Generator").Range("EOutput").Value = Establishment
    
End Sub
Public Sub ClearAll()
    Call ClearAttendant
    Call ClearEstablishment
End Sub
Public Sub ClearAttendant()
    Sheets("Establishment Generator").Range("BTName").Value = ""
    Sheets("Establishment Generator").Range("BTRace").Value = ""
    Sheets("Establishment Generator").Range("BTGender").Value = ""
    Sheets("Establishment Generator").Range("BTHNR").Value = ""
    Sheets("Establishment Generator").Range("BTAppearance").Value = ""
    Sheets("Establishment Generator").Range("BTPersonality").Value = ""
End Sub
Public Sub ClearEstablishment()
    Sheets("Establishment Generator").Range("Establishment").Value = ""
    Sheets("Establishment Generator").Range("Quality").Value = ""
    Sheets("Establishment Generator").Range("EName").Value = ""
    Sheets("Establishment Generator").Range("EOutput").Value = ""
End Sub
Public Sub GenerateEstablishment()
    Dim EType, Quality, Name As String
    
    Dim DUMARR() As Variant
    
    Dim Gen(1 To 3) As Boolean
    
    Dim Counter As Integer
    Dim Conf As String
    Dim Canceled As Boolean
    
    Dim Desc As String
    
    Dim i As Integer
    
    Canceled = False
    
    EType = Sheets("Establishment Generator").Range("Establishment").Value
    Quality = Sheets("Establishment Generator").Range("Quality").Value
    Name = Sheets("Establishment Generator").Range("EName").Value
    
    If EType = "" Or Quality = "" Or Name = "" Then
        For i = 1 To UBound(Gen(), 1)
            Gen(i) = False
        Next
        
        Counter = 0
        Do
            'check blanks
            If EType = "" Or Gen(2) = True Then
                Gen(2) = True
                DUMARR() = Sheets("Establishment AUX Tables").Range("EstablishmentTypes").Value
                EType = RandVal(DUMARR(), 1)
            End If
            
            If Quality = "" Or Gen(3) = True Then
                Gen(3) = True
                DUMARR() = Sheets("Establishment AUX Tables").Range("QualityList").Value
                Quality = RandVal(DUMARR(), 1)
            End If
            
            'get name
            If Name = "" Or Gen(1) = True Then
                Gen(1) = True
                Name = EstablishmentName(EType)
            End If
            
            Conf = MsgBox("Is """ & Name & """ a suitable name for your new " & LCase(Quality) & " " & EType, vbYesNoCancel, "Confirm Name")
            Counter = Counter + 1
        Loop Until Conf = vbYes Or Conf = vbCancel Or Counter > 1000
        
        'cancel
        If Conf = vbCancel Then End
    End If
    
    'Get description
    Desc = DescriptionGen(EType, Quality, Name)
    
    'Get Menu
    If Not EType = "Lodging" Then
        Desc = Desc & vbNewLine & vbNewLine & Menu(Quality, EType)
    End If
    
    'export generated stuff
    Sheets("Establishment Generator").Range("EName").Value = Name
    Sheets("Establishment Generator").Range("Establishment").Value = EType
    Sheets("Establishment Generator").Range("Quality").Value = Quality
    Sheets("Establishment Generator").Range("EOutput").Value = Desc
End Sub
Public Function DescriptionGen(EType, Quality, N) As String
    Dim i, j As Integer
    Dim PrevVal As Integer
    
    Dim Desc As String
    Dim InTable() As Variant
    Dim Sel() As String
    
    Dim PBTName, PBTRace, PBTGender, PBTHNR As String
    Dim BTAppearance, BTPersonality, BTName As String
    
    Dim NPCTitle As String
    
    Dim Dum As Variant
    
    Dim Outdoor As Boolean
    
    Dim Conf As String
    Dim Counter As Long
    
    If EType = "Tavern" Then
        NPCTitle = "bartender"
    ElseIf EType = "Lodging" Then
        NPCTitle = "concierge"
    ElseIf EType = "Inn" Then
        Randomize
        If Rnd() < 0.3 Then
            NPCTitle = "bartender"
        Else
            NPCTitle = "innkeep"
        End If
    ElseIf EType = "Hall" Then
        NPCTitle = "attendant"
    End If
    
    'Get NPC
    PBTName = Sheets("Establishment Generator").Range("BTName").Value
    PBTRace = Sheets("Establishment Generator").Range("BTRace").Value
    PBTGender = Sheets("Establishment Generator").Range("BTGender").Value
    PBTHNR = Sheets("Establishment Generator").Range("BTHNR").Value
    BTAppearance = Sheets("Establishment Generator").Range("BTAppearance").Value
    BTPersonality = Sheets("Establishment Generator").Range("BTPersonality").Value
    
    If BTAppearance = "" Or BTPersonality = "" Or PBTName = "" Then
        Call GenerateNPC(PBTName, PBTRace, PBTGender, PBTHNR, BTAppearance, BTPersonality, BTName, NPCTitle)
        
        Sheets("Establishment Generator").Range("BTName").Value = BTName
        Sheets("Establishment Generator").Range("BTRace").Value = PBTRace
        Sheets("Establishment Generator").Range("BTGender").Value = PBTGender
        Sheets("Establishment Generator").Range("BTHNR").Value = PBTHNR
        Sheets("Establishment Generator").Range("BTAppearance").Value = BTAppearance
        
        BTPersonality = BTName & ", a " & NPCTitle & " for " & N & ", " & BTPersonality
        Sheets("Establishment Generator").Range("BTPersonality").Value = BTPersonality
    Else
        BTName = PBTName
    End If
    
    BTAppearance = Right(BTAppearance, Len(BTAppearance) - Len(BTName & " is "))
    
    InTable() = Sheets("Establishment Tables").Range(Quality & "Table").Value
    
    Counter = 0
    
    Desc = ""
    
    j = UBound(InTable(), 2)
    ReDim Sel(1 To j) As String
    For i = 1 To j
        If i = 2 Then
            Sel(i) = InTable(PrevVal, i)
        Else
            Sel(i) = LCase(RandVal(InTable(), i, True, PrevVal))
        End If
    Next
    
    Desc = "You approach the " & Sel(1) & " " & Sel(3) & " " & Sel(5) & " " & EType & "."
    
    If Sel(5) = "painted" Then
        Sel(5) = Sel(17) & " " & Sel(5)
    End If
    
    'opener
    Randomize
    If Rnd() < 0.49 Then
        If Sel(2) = True Then
            Desc = "You approach the " & Sel(1) & " " & Sel(3) & " " & EType & ". Through the " & Sel(5) & " walls you can hear " & Sel(6) & "."
        Else
            Desc = "You approach the " & Sel(1) & " " & Sel(3) & " " & Sel(5) & " " & EType & "."
        End If
    Else
        If Sel(2) = True Then
            Desc = N & " is a " & Sel(1) & " " & Sel(3) & " " & EType & ". Through the " & Sel(5) & " walls you can hear " & Sel(6) & "."
        Else
            Desc = N & " is a " & Sel(1) & " " & Sel(3) & " " & Sel(5) & " " & EType & "."
        End If
    End If
    
    'Awning/Porch
    Randomize
    If Rnd() < 0.49 Then
        Desc = Desc & " Out front there is a " & Sel(19)
        
        Randomize
        Dum = Rnd()
        If Dum < 0.3 Then
            Desc = Desc & " porch with a " & Sel(20) & " awning"
        ElseIf Dum < 0.6 Then
            Desc = Desc & " patio"
        Else
            Desc = Desc & " deck"
        End If
        
        Randomize
        If Rnd() < 0.5 Then
            If Right(Desc, 6) = "awning" Then
                Desc = Desc & " and " & Sel(21) & " outdoor seating"
            Else
                Desc = Desc & " with " & Sel(21) & " outdoor seating"
            End If
        End If
        
        Outdoor = True
    End If
    
    'Stable?
    Randomize
    If Rnd() < 0.3 Then
        Randomize
        Dum = Rnd()
        If Dum >= 0.5 Then
            Dum = "right"
        Else
            Dum = "left"
        End If
        
        If Outdoor = True Then
            Desc = Desc & " and on the " & Dum & " side of the building there is a " & Sel(18) & " stable with a " & Sel(9) & " of horses."
        Else
            Desc = Desc & ". On the " & Dum & " side of the building there is a " & Sel(18) & " stable with a " & Sel(9) & " of horses."
        End If
        
        Outdoor = True
    ElseIf Outdoor = True Then
        Desc = Desc & "."
    End If
    
    Randomize
    If Rnd() < 0.3 Then
        If Outdoor = True Then
            Randomize
            Dum = Rnd()
            If Dum < 0.3 Then
                Desc = Desc & " Lastly,"
            ElseIf Dum < 0.6 Then
                Desc = Desc & " Finally,"
            Else
                Desc = Left(Desc, Len(Desc) - 1) & " and"
            End If
        Else
            Sel(22) = Capitalize(Sel(22))
        End If
        
        Desc = Desc & " " & Sel(22) & "."
    End If
    
    'Paragraph break
    Desc = Desc & vbNewLine & vbNewLine
    
    Randomize
    If Rnd() < 0.49 Then
        Desc = Desc & "As you open the " & Sel(7) & " " & LCase(EType) & " door you are welcomed by " & Sel(8) & " and a " & Sel(9) & " of patrons."
    Else
        Desc = Desc & "As you open the " & Sel(7) & " " & LCase(EType) & " door you are welcomed by a " & Sel(9) & " of patrons."
    End If
    
    'interior compared to exterior
    Randomize
    If Rnd() < 0.3 Then
        Desc = Desc & " It seems just as " & Replace(Sel(3), " looking", "") & " inside as it does from the outside."
    Else
        
    End If
    
    Desc = Desc & " " & Sel(10)
    
    'bar or concierge
    If EType = "Tavern" Or EType = "Inn" Then
        Dum = Sel(11) & " bar"
    ElseIf EType = "Lodging" Then
        Dum = Sel(12)
    End If
    
    'Fix syntax of appearance
    BTAppearance = Replace(Replace(BTAppearance, ". She is", ""), ". He is", "")
    
    If EType = "Hall" Then
        Desc = Desc & " and standing at attention is " & BTAppearance & "."
    Else
        Desc = Desc & " and standing behind the " & Dum & " is " & BTAppearance & "."
    End If
    
    'Paragraph break
    Desc = Desc & vbNewLine & vbNewLine
    
    Desc = Desc & "Between you and the " & NPCTitle
    
    Desc = Desc & " is a " & Sel(13) & " of " & Sel(14) & ", to the"
    
    Randomize
    Dum = Rnd()
    If Dum >= 0.5 Then
        Desc = Desc & " right"
    Else
        Desc = Desc & " left"
    End If
    
    Desc = Desc & " is a hearth with a " & Sel(15)
    
    Randomize
    If Rnd() < 0.49 Or EType = "Inn" Or EType = "Lodging" Then
        Desc = Desc & ", and to the"
        
        If Dum <= 0.5 Then
            Desc = Desc & " right"
        Else
            Desc = Desc & " left"
        End If
         
        Desc = Desc & " is a " & Sel(16) & " staircase."
    Else
        Desc = Desc & "."
    End If
    
    'Paragraph break
    Desc = Desc & vbNewLine & vbNewLine
    
    Desc = Desc & BTPersonality
    
    DescriptionGen = Desc
End Function
Public Function EstablishmentName(Establishment) As String
    Dim Adj(), Noun(), Tavern(), Lodging(), Verb() As Variant
    Dim Form As Double
    Dim EName As String
    Dim j As Integer
    
    Adj() = Sheets("Establishment Name Tables").Range("Adjectives").Value
    Noun() = Sheets("Establishment Name Tables").Range("Nouns").Value
    Tavern() = Sheets("Establishment Name Tables").Range("TavernNames").Value
    Lodging() = Sheets("Establishment Name Tables").Range("LodgingNames").Value
    Verb() = Sheets("Establishment Name Tables").Range("Verbs").Value
    
    Randomize
    Form = Rnd()
    
    j = 6
    If Form < 1 / j Then
    'The verbing noun blank
        EName = "The " & RandVal(Verb(), 1) & " " & RandVal(Noun(), 1)
    ElseIf Form < 2 / j Then
    'The Adjective Noun Blank
        EName = "The " & RandVal(Adj(), 1) & " " & RandVal(Noun(), 1)
    ElseIf Form < 3 / j Then
    'The Noun Blank
        EName = "The " & RandVal(Noun(), 1)
    ElseIf Form < 4 / j Then
    'The Noun Blank
        EName = "The " & RandVal(Adj(), 1)
    ElseIf Form < 5 / j Then
    'The Noun Blank
        EName = "The " & RandVal(Verb(), 1)
    Else
    'The noun and noun blank
        EName = "The " & RandVal(Noun(), 1) & " and " & RandVal(Noun(), 1)
    End If
    
    If Establishment = "Inn" Then
        Randomize
        If Rnd() < 0.8 Then
            EName = EName & " " & RandVal(Lodging(), 1) & " and " & RandVal(Tavern(), 1)
        Else
            EName = EName & " Inn"
        End If
    ElseIf Establishment = "Tavern" Then
        EName = EName & " " & RandVal(Tavern(), 1)
    ElseIf Establishment = "Lodging" Then
        EName = EName & " " & RandVal(Lodging(), 1)
    ElseIf Establishment = "Hall" Then
        EName = EName & " " & Establishment
    End If
    
    EstablishmentName = EName
    
End Function