fixing missing ProcessKeyStroke: A first guess

Topics: Developer Forum
Feb 8, 2008 at 10:20 PM
Edited Feb 9, 2008 at 12:31 AM
I created this a a pure first guess by scavenging from the 20168 change set

-----------------------------------------------------------------------------------------------------
Private Function ProcessKeyStroke(ByVal strCommand As String, _
ByRef strMessage As String, _
ByRef strAutoWalkDirection As String, _
ByRef bolValid As Boolean, _
ByRef GameOver As Boolean) As String

Select Case strCommand ' main loop for keybound commands
Case "?" ' display keybindings
kbShowKeyBindings()
bolValid = False
strMessage = ""
Case "," ' pick something up
strMessage = kbGet(mHero.LocX, mHero.LocY, m_Hero.LocZ)
DoTurnCounter()

Case "w" ' walk until danger or door
WriteAt(1, 0, CLEARSPACE)
MessageHandler("Please select a direction: (1-9)")
CursorLeft = 34
CursorTop = 0
CursorVisible = True

Dim WalkDirection As ConsoleKeyInfo, OK As Boolean = False
WalkDirection = Console.ReadKey
strAutoWalkDirection = WalkDirection.KeyChar.ToString

Do Until OK
Select Case strAutoWalkDirection
Case 1 To 9 ' SW, S, SE, W, WAIT, E, NW, N, NE
m_Hero.AutoWalk = True
strCommand = EvaluateDirection(strAutoWalkDirection)
bolValid = True
strMessage = "...and we're walking... "
OK = True

Case "UpArrow", "DownArrow", "LeftArrow", "RightArrow"
Select Case strAutoWalkDirection
Case "UpArrow"
strAutoWalkDirection = 8
Case "DownArrow"
strAutoWalkDirection = 2
Case "LeftArrow"
strAutoWalkDirection = 4
Case "RightArrow"
strAutoWalkDirection = 6
End Select
m_Hero.AutoWalk = True
strCommand = EvaluateDirection(strAutoWalkDirection)
bolValid = True
strMessage = "...and we're walking... "
OK = True

Case Else
m_Hero.AutoWalk = False
strMessage = ""
OK = True
End Select

Loop
CursorVisible = False

Case "UpArrow", "DownArrow", "LeftArrow", "RightArrow", 1 To 9
' move/attack in the specified direction
' if hero walks into a wall or door, it shouldn't count
' as an action, so set Valid to False and don't allow a
' monster action
Select Case strCommand
Case "UpArrow"
strCommand = 8
Case "DownArrow"
strCommand = 2
Case "LeftArrow"
strCommand = 4
Case "RightArrow"
strCommand = 6
End Select

If m_Hero.Confused Then
strCommand = RND.Next(1, 9)
End If

strMessage = ""
bolValid = kbDirection(strCommand, strMessage)
If strMessage.Length > 0 Then
Debug.WriteLine("strmessage = " & strMessage)
End If
Case "a" ' apply skills
bolValid = False
If m_Hero.Confused Then
strMessage = "Not while confused. "
Else
strMessage = kbSkills(bolValid)
End If

Case "c" ' close the door
strMessage = kbClose()
DoTurnCounter()

Case "C" ' chat with someone or something
If m_Hero.Confused Then
strMessage = "You attempt to speak, but can only babble. "
Else
strMessage = kbChat()
End If
DoTurnCounter()
Case "d" ' drop something
strMessage = kbDrop()
Case "D" ' drink something
strMessage = kbDrink()
DoTurnCounter()
Case "i" ' show inventory screen
kbInventory()
strMessage = ""
bolValid = False
Case "k" ' kick something
strMessage = kbKick()
DoTurnCounter()
Case "o" ' open the door
strMessage = kbOpen()
If Not m_Hero.Overland Then
HeroLOS()
ElseIf m_Hero.InTown Then
TownLOS(m_Hero.Town)
Else
OverlandLOS()
End If
DoTurnCounter()
Case "Q" ' quit the game
If kbQuit() Then Exit Function
Case "@" ' show character info
bolValid = False
HeroDisplay()
strMessage = ""
Case "s" ' search immediate area
strMessage = kbSearch()
DoTurnCounter()

Case ">" ' descend 1 level (DoTurnCounter is included in kbDown sub)
strMessage = kbDown()
Case "<" ' ascend 1 level (DoTurnCounter is included in kbUp sub)
strMessage = kbUp()
Case "^" ' for testing only
m_Hero.XP += 500
UpdateXPDisplay()
strMessage = ""
Case Else 'invalid keypress
bolValid = False
strMessage = ""
End Select

Return strMessage
End Function
Coordinator
Feb 19, 2008 at 5:00 AM
Yeah, this has been fixed now. I'm not sure how/when the code went missing, but it should all be back together again. I changed machines recently and some stuff got lost in the shuffle. Thanks!!