Same app but different problem.

When a good thing happens I have a list of blurbs for the player.
Same with bad things.

But not nearly enough. They tend to get stale - particularly when you see the same ones twenty times per hour. I add new ones as I think of them but this is what I've got.

The idea is that you're the top executive in a widget factory so while some of the things I've got don't correspond well with that, that's kind of where I'd like to focus more.

Any ideas you have are appreciated.

Code:
Public Function TookDamage() As String
Dim m_CallStacker As New cCallStacker
Static nTookDamage(1 To 12) As Long
Static nCount As Long
Dim nRnd As Long

m_CallStacker.Add NAME & ".TookDamage(Private Function)"

If RollDie(d40) = 40 Then

  TookDamage = "Will someone please get the velociraptors out of the kitchen?!?  I'm trying to cook here!"

  Exit Function

End If

nRnd = RollDie(12)

nTookDamage(nRnd) = nTookDamage(nRnd) + 1

Select Case nRnd

  Case 1

    TookDamage = "You Twitted something really stupid and now everyone is laughing at you."

  Case 2

    TookDamage = "You missed an important deadline."

  Case 3

    TookDamage = "The Board of Directors would like a word with you."

  Case 4

    TookDamage = "Karen demanded to speak with you."

  Case 5

    TookDamage = "Something went wrong on the production line."

  Case 6

    TookDamage = "A group of McGuffins screwing around on a Segway ran over your foot."

  Case 7

    TookDamage = "You disappointed your Mother."

  Case 8

    TookDamage = "You were looking at your cell while driving and caused another accident."

  Case 9

    TookDamage = "You got banned from the CoD server because you were just too good."

  Case 10

    TookDamage = "You heard a strange noise in the woods at night and decided to investigate all by yourself wearing nothing but underpants."

  Case 11

    nCount = nCount + 1

    Select Case nCount

      Case 1

        TookDamage = "NASA abandoned you on Mars and left you with nothing." & DBL_RETURN & vbTab & "Also, you have a sucking chest wound."


      Case 2

        TookDamage = "NASA abandoned you on Mars and left you with nothing but a potato." & DBL_RETURN & vbTab & "Also, you're in the middle of a Martian dust storm."

      Case 3

        TookDamage = "NASA abandoned you on Mars and left you with nothing but a potato and a packet of ketchup." & DBL_RETURN & vbTab & "Also, you exploded yourself a little bit when you played with fire around flammable gas."

      Case 4

        TookDamage = "NASA abandoned you on Mars and left you with nothing but a potato, a packet of ketchup and part of a rocketship." & DBL_RETURN & vbTab & "Also, you're out of ketchup."

      Case 5

        TookDamage = "NASA abandoned you on Mars and left you with nothing but a potato, a packet of ketchup, part of a rocketship and a fire extinguisher." & DBL_RETURN & vbTab & "Also, the front of the rocketship is missing."

        nCount = 0

    End Select

  Case 12

    TookDamage = "You can do it!" & DBL_RETURN & vbTab & "wait... no you couldn't..."

End Select

ShowChoiceCount "nTookDamage", nTookDamage

End Function


Public Property Get GotBuffed() As String
Dim m_CallStacker As New cCallStacker
Static nGotBuffed(1 To 9) As Long
Dim nRnd As Long

m_CallStacker.Add NAME & ".GotBuffed(Public Property Get)"

nRnd = RollDie(9)

nGotBuffed(nRnd) = nGotBuffed(nRnd) + 1

Select Case nRnd

  Case 1

    GotBuffed = "You've been hitting the gym!"

  Case 2

    GotBuffed = "Great job on those TPS reports!"

  Case 3

    GotBuffed = "The Board of Directors would like a word with you."

  Case 4

    GotBuffed = "Karen demanded to speak with someone else."

  Case 5

    GotBuffed = "You found a Thing!"

  Case 6

    GotBuffed = "Tour Mother is proud of you."

  Case 7

    GotBuffed = "You rescued a stray animal."

  Case 8

    GotBuffed = "Your favorite " & Relative & " gave you something special."

  Case 9

    GotBuffed = "You missed your ride back to Earth from Mars with NASA but they sent someone back to get you." & DBL_RETURN & vbTab & "Also, they have ketchup packets."

End Select

ShowChoiceCount "nGotBuffed", nGotBuffed

End Property