A very basic text adventure

A rant.

Sometime in the early 2000s, we began to call Doom-Likes and Quake-Likes (shortly referred to as Half-Life-Likes) "First Person Shooters," I get the idea. The game has to simulate a first-person view and let the player drill holes into enemies; presentation and gameplay neatly packed into a convenient name, there's nothing wrong with that. Strategy Games a-la Age of Empires became "Real Time Strategy." I can get behind that: the title makes a distinction with turn-based strategy games, puts the emphasis on planning... sure. And then, text adventure games somehow became "Interactive Fiction" (not to be confused with "Visual Novels", which are also not to be confused with "Graphic Novels"...) and suddenly, I'm baffled.

Looking back, point-and-click games directly evolved from text adventure games (not to say they are the same thing, but they do share two core elements: they are story-heavy and the player's actions advance the intrigue in a meaningful way.) In fact, you can unequivocally notice the gradual streamlining of the interface happening from "Adventure" (1976, all text) to "Mystery House" (1980, mostly text and still images) to "King's Quest" (1984, mostly graphic with a text parser) to "Maniac Mansion" (1987, graphics with a virtual text input in the form of 14 verbs) to "Indiana Jones and the Fate of Atlantis" (1992, graphics with a 9-verb list) to "Sam & Max: Hit the Road" (1993, graphics with icons to illustrate 5 unique actions.)

By that observation alone, "Grim Fandango," a game that can (almost) be entirely completed with the press of the Enter key would be an "Interactive Fiction" as the idea of a text-based interface is not even implied... as if that feature didn't warrant its own genre (or in the very least its inclusion in the genre's name.) But what if the story is non-fiction? Well, it's still an "IF." And yes, aficionados of the genre rather use the contraction "IF" over "Interactive Fiction" as if it wasn't confusing enough yet. Seriously, it's all absolutely baffling to me. All that to say, if (used as a preposition here) I'm going to code like it's 1990, I'm also going to use the period-accurate "text adventure game" name... but only in this first chapter. As it turned out, I had no use for that name beyond the introduction. Had I any reason to type three whole paragraphs, if not to spill my frustration on you like a heavily liquored up lunch on the pavement before my house? Probably not. I got a headache.

Anyway.

I got somewhat engrossed by the genre after playing a few games programmed in QuickBASIC. Can we design our very own simple game with an equally simple two-element parser (just a verb and noun?) I genuinely would love to do something more complex, but we have to start somewhere. Type "READ" to continue.

Garbage day!

Let's first get one thing straight: what I'm calling a "prompt" is the entirety of the string entered by the user. "Commands" are the individual verb + noun strings. We're going to use periods to separate each command; for instance "TAKE APPLE.EAT APPLE." are two commands in one prompt.

The major problem with text inputs is that we can never be a hundred percent certain of the content of the string, which makes parsing an absolute nightmare. That's why we should "aggressively sanitize" the prompt before anything else. First, working with mixed-case letters is a pain so we're going to convert everything to uppercase. Second, we'll convert semicolons, commas, exclamation points, and question marks to periods (as we're going to use periods to determine where commands end.) Third, we're going to discard any character that is not a letter, number, apostrophe, space, or period. As we go, we'll remove leading, trailing, and consecutive spaces, as well as spaces surrounding periods.

''
'' SANITIZE STRING - PART 1: STRICT FORMATTING.
'' This routine takes <msg>, a user prompt, and returns a formalized
'' representation of it: it is uppercase, without excess spaces, without
'' unusual characters and always ends with a period.
''
SUB strFormat (msg AS STRING)
  DIM readOfs AS INTEGER, writeOfs AS INTEGER
  DIM prevChar AS INTEGER

  ' Make the string uppercase and append a period (it's easier to remove
  ' excess periods than test for the presence of one.)
  msg = UCASE$(msg) + "."

  ' Define the previous character read as "space;" this will clip leading
  ' spaces from the string. We may treat some characters as space even
  ' though they are not; that's why we're not using LTRIM$() and RTRIM$().
  prevChar = &H20

  ' Set writing offset.
  writeOfs = 1

  ' Parse the string, one character at a time. We're going to remove
  ' consecutive spaces, convert some characters to period (which is used to
  ' separate individual commands in the prompt.)
  FOR readOfs = 1 TO LEN(msg)

    ' Take the ASCII value of the character at <readOfs>; it's faster to
    ' process INTEGERs than STRINGs.
    SELECT CASE ASC(MID$(msg, readOfs, 1))

    ' We got an uppercase letter (0x41 to 0x5A,) a number (0x30 to 0x39,)
    ' or an apostrophe (0x27:) copy as is.
    CASE &H27, &H41 TO &H5A, &H30 TO &H39
      MID$(msg, writeOfs, 1) = MID$(msg, readOfs, 1)
      prevChar = ASC(MID$(msg, writeOfs, 1))
      writeOfs = writeOfs + 1

    ' Exclamation point (0x21,) comma (0x2C,) period (0x2E,) semi-colon
    ' (0x3B,) and question mark (0x3F:) convert to period and ignore
    ' following spaces. If the character before the punctuation mark was a
    ' space, remove it too! We also pretend the character we wrote is space
    ' to prevent following spaces and repeated periods.
    CASE &H21, &H2C, &H2E, &H3B, &H3F
      IF ((writeOfs > 1) AND (prevChar = &H20)) THEN
        MID$(msg, writeOfs - 1, 1) = CHR$(&H2E)
        prevChar = &H20
      ELSE
        MID$(msg, writeOfs, 1) = CHR$(&H2E)
        prevChar = &H20
        writeOfs = writeOfs + 1
      END IF

    ' Everything else ("everything" includes tabs (0x07) and spaces (0x20,)
    ' obviously:) treat as spaces. Remove duplicates/leading spaces.
    CASE ELSE
      ' We are allowed to preserve this "space" (whatever it is) only if
      ' the previous character was not already a space.
      IF (prevChar <> &H20) THEN
        MID$(msg, writeOfs, 1) = CHR$(&H20)
        prevChar = &H20
        writeOfs = writeOfs + 1
      END IF
    END SELECT
  NEXT readOfs

  ' We may have some junk left behind the writing offset, clip it.
  msg = LEFT$(msg, writeOfs - 1)
END SUB

We're off to a great start! Now we should remove "noise" words such as definite ("THE") and indefinite ("AN", "A") articles. Hence, "TAKE THE KEY" would become "TAKE KEY". We might as well remove prepositions "TO" (ie. "TALK TO") and "AT" ("LOOK AT";) but we'll preserve "UP" because it could refer to a direction (yes, "PICK UP" and "BLOW UP" will throw a monkey wrench in our logic, but we're only building a basic parser here,) words like "AND", "THEN", and "FINALLY" could also be replaced by periods. The process is somewhat tricky because of the number of oddities we may cross. Special care should be taken with the separators types (space or period) and the position of the word we're processing.

''
'' SANITIZE STRING - PART 2: STRIP NOISE.
'' This routine takes <msg> (must be properly formatted), and discards all
'' "noise" words, including indefinite (A, AN) and definite (THE) articles,
'' adverbs such as "AND", "THEN" and "FINALLY", and prepositions "AT" and
'' "TO". Some words are replaced by spaces, others by periods.
''
SUB strStripNoise (msg AS STRING)
  DIM headOfs AS INTEGER, headChr  AS INTEGER
  DIM tailChr AS INTEGER, clipChr AS INTEGER
  DIM readOfs AS INTEGER

  ' Reset the replacement character (unnecessary since QuickBASIC always
  ' initializes variables to 0, but I want the emphasis.) The value won't
  ' remain null if we got a match.
  clipChr = 0

  ' <msg> went through the first part of the sanitization so we can safely
  ' assume the string is at least one byte long and doesn't start with a
  ' space; if the string starts with a period, it's also the only character
  ' it contains. So here's the thing: if we assume the 1st character has to
  ' be the beginning of the first word...
  headOfs = 1

  ' ...then the first separator cannot appear before the 2nd character...
  readOfs = 2

  ' ...thus, the loop won't trigger if the string only contains a period,
  ' which is exactly what we want! Nice!
  DO UNTIL (readOfs > LEN(msg))

    ' If we found a separator (period or space,) we may check the word.
    SELECT CASE ASC(MID$(msg, readOfs, 1))
    CASE &H20, &H2E

      ' Only check the whole word if it begins with an A, F or T.
      SELECT CASE ASC(MID$(msg, headOfs, 1))
      CASE &H41, &H46, &H54

        ' Compare the word with our "noise" list, some words are replaced
        ' by spaces, others by periods.
        SELECT CASE MID$(msg, headOfs, readOfs - headOfs)
        CASE "AND", "FINALLY", "THEN"
          clipChr = &H2E
        CASE "AN", "AT", "A", "THE", "TO"
          clipChr = &H20
        END SELECT

        ' We got a match! Crush the string to remove the word (including
        ' the separators on both sides) and write the replacement character
        ' instead.
        IF (clipChr) THEN

          ' Get offset of the leading separator, as well as its type.
          headOfs = headOfs - 1
          IF (headOfs < 1) THEN
            headOfs = 1
            headChr = &H20
          ELSE
            headChr = ASC(MID$(msg, headOfs, 1))
          END IF

          ' Get trailing character type.
          tailChr = ASC(MID$(msg, readOfs, 1))

          ' If the word is located at the very beginning of the string, it
          ' should normally not be replaced by a space nor a period, unless
          ' the word is also located at the end of the string (it can
          ' happen if the whole prompt is made of "noise" words.)
          IF (headOfs = 1) THEN
            IF (readOfs = LEN(msg)) THEN
              msg = "."
            ELSE
              msg = RIGHT$(msg, LEN(msg) - readOfs)
            END IF

          ' If either separator is a period, the word must be replaced by
          ' a period.
          ELSEIF ((headChr = &H2E) OR (tailChr = &H2E)) THEN
            msg = LEFT$(msg, headOfs - 1) + "." + RIGHT$(msg, LEN(msg) - readOfs)

          ' For any other case, just use the replacement character we set
          ' earlier.
          ELSE
            msg = LEFT$(msg, headOfs - 1) + CHR$(clipChr) + RIGHT$(msg, LEN(msg) - readOfs)
          END IF

          ' Reset the replacement character now, so we don't falsly assume
          ' the next word as a match.
          clipChr = 0

          ' Reset the reading offset to the beginning of the first
          ' separator, minus 1 (the offset is incremented by 1 at the end
          ' of the loop.)
          readOfs = headOfs - 1
        END IF
      END SELECT

      ' Next word begins next character.
      headOfs = readOfs + 1
    END SELECT

    ' Move to next character.
    readOfs = readOfs + 1
  LOOP
END SUB

For convenience's sake, we're going to write a small function that will preserve the original user prompt, send the copy through both strFormat() and strStripNoise(), and return the simplified version.

''
'' SANITIZE USER PROMPT.
'' Most of the heavy load is split in two routines for clarity's sake. You
'' must invoke only this routine to get a clean user prompt.
''
FUNCTION strSanitize$ (inString AS STRING)
  DIM cpyString AS STRING

  ' QuickBASIC passes arguments BYREF. If we want to preserve the source
  ' string (and we do,) we should make a copy we can wreck-- I mean, "work"
  ' on.
  cpyString = inString

  ' Format and strip noise (in that order.)
  strFormat cpyString
  strStripNoise cpyString

  ' Return simplified prompt.
  strSanitize$ = cpyString
END FUNCTION

And here's what it looks like in action:

INPUT: "   Take the bulb  and   go north then,. open the  door! and look at the tree . . .  "
RESULT: "TAKE BULB.GO NORTH.OPEN DOOR.LOOK TREE."

Break it down for me

Thanks to the prompt simplification, splitting individual commands is going to be a breeze. First we identify commands by looking for periods, then we extract the verb (anything to the left of the first space) and the noun (anything after that.) And we just keep going until the whole prompt has been processed.

I may repeat myself, but our parser is excessively basic. So why not spice it up just a little bit for fun? Let's implement "IT" and "AGAIN": if the noun is "IT", we recall the last noun we decoded. When the command is "AGAIN", we repeat the previous command. It's super easy to code and now the player may type "TAKE THE BOOK AND READ IT" rather than "TAKE THE BOOK AND READ THE BOOK". Neat.

''
'' MAIN LOOP
'' Where the magic happens: this is where the player enters his prompts and
'' the parser attempts to process them. The loop only ends when the player
'' types "QUIT" or "EXIT".
''
SUB mainLoop
  DIM cmdStr AS STRING, cmdVerb AS STRING, cmdNoun AS STRING
  DIM cmdStrOld AS STRING, cmdNounOld AS STRING
  DIM usrPrompt AS STRING, ofsThis AS INTEGER, ofsNext AS INTEGER

  ' Clear screen
  CLS

  DO
    ' Get initial prompt, sanitize right away.
    LINE INPUT "> "; usrPrompt
    usrPrompt = strSanitize$(usrPrompt)

    ' Now let's break the whole prompt into individual commands. Reset the
    ' position of the "last" period we "found."
    ofsThis = 0

    DO

      ' The next command should start right after the last period.
      ofsThis = ofsNext + 1
      ' Get the position of the next period.
      ofsNext = INSTR(ofsThis, usrPrompt, ".")

      ' If there's no period left, the whole string has been processed.
      IF (ofsNext = 0) THEN EXIT DO

      ' Meanwhile, here's a command we found...
      cmdStr = MID$(usrPrompt, ofsThis, ofsNext - ofsThis)

      ' Recall the last command.
      IF (cmdStr = "AGAIN") THEN
        IF (LEN(cmdStrOld)) THEN
          cmdStr = cmdStrOld
        END IF
      END IF
      cmdStrOld = cmdStr

      ' The first word is the verb, the rest is the noun (an object or
      ' an exit.)
      ofsTemp = INSTR(cmdStr, " ")
      IF (ofsTemp = 0) THEN
        cmdVerb = cmdStr
        cmdNoun = ""
      ELSE
        cmdVerb = LEFT$(cmdStr, ofsTemp - 1)
        cmdNoun = MID$(cmdStr, ofsTemp + 1)
      END IF

      ' Recall the last object.
      IF (cmdNoun = "IT") THEN
        IF (LEN(cmdNounOld)) THEN
          cmdNoun = cmdNounOld
        END IF
      END IF
      cmdNounOld = cmdNoun

      ' An now, we submit both parts of the command for execution.
      IF cmdExec%(cmdVerb, cmdNoun) THEN EXIT SUB

    LOOP
  LOOP
END SUB

''
'' EXECUTE COMMAND (VERSION 1)
'' This function returns -1 if the player wants to quit. Otherwise, it just
'' executes the command we provided.
''
FUNCTION cmdExec%(cmdVerb AS STRING, cmdNoun AS STRING)
  SELECT CASE (cmdVerb)

  CASE ""
    PRINT "WHAT NOW?"

  CASE "QUIT", "EXIT"
    cmdExec% = -1
    EXIT FUNCTION

  CASE "DANCE"
    PRINT "YOU DANCE LIKE NO ONE IS WATCHING. AS EXPECTED, IT DIDN'T"
    PRINT "SOLVE ANYTHING BUT IT MAKES YOU FEEL JUST A TINY LITTLE BIT"
    PRINT "BETTER ABOUT YOUR ORDEAL."

  CASE ELSE
    PRINT "I DON'T KNOW HOW TO "; CHR$(34); cmdVerb; CHR$(34); ". TRY "; CHR$(34); "QUIT"; CHR$(34); "."

  END SELECT
END FUNCTION

Connecting rooms, filling them with stuff

Rooms may represent "indoor" locations, but not necessarily. Think of them as "scenes" the player can visit. Obviously, rooms and exits are closely related.

Some games use a very simple navigation system in which each room is mapped into a 2D array, similarly to a classic tile-based engine. It's a great system but it doesn't work too well with non-Euclidean geometry, one-way passages, or times when you want to break room connections. The system we're going to use instead allocates a set number of exits for each room.

But first, let's build the exits. We setup a constant for the number of exits we want per room, then more constants for the index value of each exit (we don't technically need those, but it's going to make room definition more intelligible.) Then we allocate an array for the name of each exit (those will be recognized by the parser.)

Quick reminder for those who just arrived: in QuickBASIC, when only one value is used to declare an array, it corresponds to the upper boundary, not the number of elements. Since arrays start at index 0, we subtract one from the total number of elements.

CONST cNumExits = 6

CONST cNowhere = -1
CONST cExitNorth = 0
CONST cExitSouth = 1
CONST cExitWest = 2
CONST cExitEast = 3
CONST cExitUp = 4
CONST cExitDown = 5

DIM SHARED gExitName(cNumExits - 1) AS STRING

Next, let's build the room system. We need a constant for the number of rooms, some constants for the indices, an array for their name, and a two-dimensional array for the exits: when the player enters "GO" followed by one of the four cardinal directions ("NORTH", "SOUTH", "WEST", or "EAST",) or "UP" and "DOWN", we plug the current location of the player and the exit index in gRoomExit() to obtain the index of the destination. We're also going to declare a shared variable to track the player's location.

CONST cNumRooms = 5

CONST cRoomPorch = 0
CONST cRoomMainHall = 1
CONST cRoomLivingRoom = 2
CONST cRoomDiningRoom = 3
CONST cRoomKitchen = 4

DIM SHARED gRoomName(cNumRooms - 1) AS STRING
DIM SHARED gRoomExit(cNumRooms - 1, cNumExits - 1) AS INTEGER

DIM SHARED gPlWhere AS INTEGER

Finally, we're going to need some objects for the navigation system. Just like we did for rooms and exits, we're going to create a constant for the total count; each object is defined in three arrays: the first one stores their name (it MUST be unique,) the second array tells us where it is located (either a room index, cNowhere if the object is out of reach, or cInInventory if the player has it,) and the third array is used for special flags like cFlagUnmovable (cannot be picked up,) cFlagOpenClose (may be opened or closed,) cFlagIsOpen (is currently open) and cFlagLocked (refuses to open.) While it may sound overkill currently, I have great hopes for this third array to become eye-opening later down the road.

CONST cNumObjects = 4

CONST cInInventory = -2

CONST cNothing = -1
CONST cObjKey = 0
CONST cObjDoor = 1
CONST cObjSpoon = 2
CONST cObjBook = 3

CONST cFlagUnmovable = &h1
CONST cFlagOpenClose = &h2
CONST cFlagIsOpen = &h4
CONST cFlagLocked = &h8

DIM SHARED gObjName(cNumObjects - 1) AS STRING
DIM SHARED gObjRoom(cNumObjects - 1) AS INTEGER
DIM SHARED gObjFlag(cNumObjects - 1) AS INTEGER

We got the basic pieces down, so let's initialize them. We'd do it with DATA statements, but unfortunately QuickBASIC stores DATA as string literals which makes constants unusable... so routines it is!

initExitNames
initRooms
initObjects

''
'' INITIALIZE EXIT NAMES
''
SUB initExitNames
  gExitName(cExitNorth) = "NORTH"
  gExitName(cExitSouth) = "SOUTH"
  gExitName(cExitWest) = "WEST"
  gExitName(cExitEast) = "EAST"
  gExitName(cExitUp) = "UP"
  gExitName(cExitDown) = "DOWN"
END SUB

''
'' INITIALIZE ROOMS
''
''             [ KITCHEN ] -------+
''                  |             |
'' [ LIVING ] - [ HALL ] ---- [ DINING ]
''                  |
''             [ PORCH ]
''
SUB initRooms
  DIM r AS INTEGER, e AS INTEGER

  ' Set all exits to dead ends, for convenience's sake.
  FOR r = 0 TO cNumRooms - 1
    FOR e = 0 TO cNumExits - 1
      gRoomExit(r, e) = cNowhere
    NEXT e
  NEXT r

  gRoomName(cRoomPorch) = "THE PORCH"
  gRoomExit(cRoomPorch, cExitNorth) = cRoomMainHall

  gRoomName(cRoomMainHall) = "THE MAIN HALL"
  gRoomExit(cRoomMainHall, cExitNorth) = cRoomKitchen
  gRoomExit(cRoomMainHall, cExitSouth) = cRoomPorch
  gRoomExit(cRoomMainHall, cExitWest) = cRoomLivingRoom
  gRoomExit(cRoomMainHall, cExitEast) = cRoomDiningRoom

  gRoomName(cRoomLivingRoom) = "THE LIVING ROOM"
  gRoomExit(cRoomLivingRoom, cExitEast) = cRoomMainHall

  gRoomName(cRoomDiningRoom) = "THE DINING ROOM"
  gRoomExit(cRoomDiningRoom, cExitNorth) = cRoomKitchen
  gRoomExit(cRoomDiningRoom, cExitWest) = cRoomMainHall

  gRoomName(cRoomKitchen) = "THE KITCHEN"
  gRoomExit(cRoomKitchen, cExitSouth) = cRoomMainHall
  gRoomExit(cRoomKitchen, cExitEast) = cRoomDiningRoom
END SUB

''
'' INITIALIZE OBJECTS
''
SUB initObjects
  gObjName(cObjKey) = "KEY"
  gObjRoom(cObjKey) = cRoomPorch

  gObjName(cObjDoor) = "FRONT DOOR"
  gObjRoom(cObjDoor) = cRoomPorch
  gObjFlag(cObjDoor) = cFlagUnmovable OR cFlagOpenClose OR cFlagLocked

  gObjName(cObjSpoon) = "SPOON"
  gObjRoom(cObjSpoon) = cRoomKitchen

  gObjName(cObjBook) = "BOOK"
  gObjRoom(cObjBook) = cRoomLivingRoom
  gObjFlag(cObjBook) = cFlagOpenClose
END SUB

The parser will use indices rather than nouns, therefore we need some functions to convert plain strings to integers:

''
'' GET THE EXIT INDEX, BY NAME
''
FUNCTION getExitIndex%(msg AS STRING)
  DIM e AS INTEGER

  ' Look for a match in the exit name list.
  FOR e = 0 TO cNumExits - 1
    IF (msg = gExitName(e)) THEN
      getExitIndex% = e
      EXIT FUNCTION
    END IF
  NEXT e

  ' Not an exit.
  getExitIndex% = cNowhere
END FUNCTION

''
'' GET THE OBJECT INDEX, BY NAME
''
FUNCTION getObjectIndex% (msg AS STRING)
  DIM o AS INTEGER

  ' Look for a match in the object name list.
  FOR o = 0 TO cNumObjects - 1
    IF (msg = gObjName(o)) THEN
      getObjectIndex% = o
      EXIT FUNCTION
    END IF
  NEXT o

  ' Not an object.
  getObjectIndex% = cNothing
END FUNCTION

Okay. Now, we may complete the navigation system with a routine to place the player in a specific room. When the routine is invoked, it should provide the room's name, a short desription, the list of items the player can see, and where each exit is located...

''
'' ROOM SWITCH
'' This routine is used to move the player to another room. It shows the
'' room name, a short description, the exits, and the objects nearby.
''
SUB roomSwitch (nextRoom AS INTEGER)
  DIM e AS INTEGER

  ' Move the player to the proper room.
  gPlWhere = nextRoom

  ' Where is the player?
  COLOR 7: PRINT "YOU ARE IN: ";
  COLOR 15: PRINT gRoomName(gPlWhere)
  COLOR 7: PRINT

  ' Short description, custom for each room.
  SELECT CASE (gPlWhere)

  CASE cRoomPorch
    PRINT TAB(3); "THE PAINTJOB ON THE STEPS HAS SEEN BETTER DAYS."

  CASE cRoomMainHall
    PRINT TAB(3); "THE LIGHT PIERCING THROUGH THE WINDOWS BARELY LITS THE HALL."

  CASE cRoomLivingRoom
    PRINT TAB(3); "THERE'S A MUSTY SMELL LINGERING IN THE AIR, THE COUCH IS DUSTY."

  CASE cRoomDiningRoom
    PRINT TAB(3); "YOU CAN TELL NOONE HAS EATEN IN THE DINING ROOM IN A LONG TIME."

  CASE cRoomKitchen
    PRINT TAB(3); "KITCHEN UTTENSILS ARE SCATTERED ON THE COUNTER."

  END SELECT

  ' Where are the exits, what's in the room?
  PRINT
  printExits
  printObjects gPlWhere
END SUB

''
'' PRINT ROOM EXITS
''
SUB printExits
  DIM e AS INTEGER, count AS INTEGER

  ' Count exits.
  FOR e = 0 TO cNumExits - 1
    count = count - (gRoomExit(gPlWhere, e) <> cNowhere)
  NEXT e

  COLOR 7: PRINT "EXITS: ";
  IF (count = 0) THEN
    COLOR 15: PRINT "NONE";

  ELSE
    FOR e = 0 TO cNumExits - 1
      IF (gRoomExit(gPlWhere, e) <> cNowhere) THEN
        count = count - 1
        COLOR 15: PRINT gRoomName(gRoomExit(gPlWhere, e)); " ("; gExitName(e); ")";
        COLOR 7
        IF (count) THEN PRINT ", ";
      END IF
    NEXT e
  END IF

  COLOR 7: PRINT "."
END SUB

''
'' PRINT ROOM OBJECTS, CAN ALSO PRINT THE INVENTORY
''
SUB printObjects(eRoom AS INTEGER)
  DIM o AS INTEGER, count AS INTEGER

  ' Count objects.
  FOR o = 0 TO cNumObjects - 1
    count = count - (gObjRoom(o) = eRoom)
  NEXT o

  COLOR 7
  IF (eRoom = cInInventory) THEN
    PRINT "YOU HAVE: ";
  ELSE
    PRINT "YOU SEE: ";
  END IF
  IF (count = 0) THEN
    COLOR 15: PRINT "NOTHING";

  ELSE
    FOR o = 0 TO cNumObjects - 1
      IF (gObjRoom(o) = eRoom) THEN
        count = count - 1
        COLOR 15: PRINT gObjName(o);
        COLOR 7
        IF (gObjFlag(o) AND cFlagOpenClose) THEN
          IF (gObjFlag(o) AND cFlagIsOpen) THEN
            PRINT " (OPEN)";
          ELSE
            PRINT " (CLOSED)";
          END IF
        END IF
        IF (count) THEN PRINT ", ";
      END IF
    NEXT o
  END IF

  COLOR 7: PRINT "."
END SUB

And that's it! We just have to add some more commands ("GO"/"WALK", "TAKE"/"GET", "DROP", and "INVENTORY") to cmdExec%(), and we're good to go ("USE", "OPEN", and "CLOSE" will be added momentarily:)

''
'' EXECUTE COMMAND (VERSION 2)
'' This function returns -1 if the player wants to quit. Otherwise, it just
'' executes the command we provided.
''
FUNCTION cmdExec%(cmdVerb AS STRING, cmdNoun AS STRING)
  DIM idx AS INTEGER

  SELECT CASE (cmdVerb)

  CASE ""
    PRINT "WHAT NOW?"

  CASE "QUIT", "EXIT"
    cmdExec% = -1
    EXIT FUNCTION

  CASE "DANCE"
    PRINT "YOU DANCE LIKE NO ONE IS WATCHING. AS EXPECTED, IT DIDN'T"
    PRINT "SOLVE ANYTHING BUT IT MAKES YOU FEEL JUST A TINY LITTLE BIT"
    PRINT "BETTER ABOUT YOUR ORDEAL."

  CASE "INVENTORY"
    printObjects cInInventory

  CASE "DROP"
    idx = getObjectIndex%(cmdNoun)
    IF (idx = cNothing) THEN
      PRINT "I DON'T KNOW WHAT "; cmdNoun; " IS."
    ELSEIF (gObjRoom(idx) <> cInInventory) THEN
      PRINT "YOU DON'T HAVE ANY "; gObjName(idx); "."
    ELSE
      gObjRoom(idx) = gPlWhere
      PRINT "YOU DROPPED "; gObjName(idx); "."
    END IF

  CASE "TAKE", "GET"
    idx = getObjectIndex%(cmdNoun)
    IF (idx = cNothing) THEN
      PRINT "I DON'T KNOW WHAT "; cmdNoun; " IS."
    ELSEIF (gObjRoom(idx) <> gPlWhere) THEN
      PRINT "THERE'S NO "; cmdNoun; " HERE."
    ELSE
      IF (gObjFlag(idx) AND cFlagUnmovable) THEN
        PRINT "YOU CAN'T TAKE "; gObjName(idx); "."
      ELSE
        gObjRoom(idx) = cInInventory
        PRINT "YOU GOT "; gObjName(idx); "."
      END IF
    END IF

  CASE "GO", "WALK"
    idx = getExitIndex%(cmdNoun)
    IF (idx = cNowhere) THEN
      PRINT "WHERE IS THAT EXACTLY?"
    ELSEIF (gRoomExit(gPlWhere, idx) = cNowhere) THEN
      PRINT "YOU CAN'T GO "; cmdNoun; "."
    ELSE
      roomSwitch gRoomExit(gPlWhere, idx)
    END IF

  CASE ELSE
    PRINT "I DON'T KNOW HOW TO "; CHR$(34); cmdVerb; CHR$(34); "."

  END SELECT
END FUNCTION

Let's also go back to mainLoop() and insert two lines right after "CLS":

' Put the player in the first room.
roomSwitch cRoomPorch

Alright. Now we can enter multiple commands, move from one room to the other, pick up and drop items... That's pretty neat, but there's still something missing: when we introduced the "KEY" and "FRONT DOOR", we expected the player to use the key and unlock the door before he could enter the house. However, right now, neither the "KEY" nor the "FRONT DOOR" does anything at all. Let's right that wrong.

Make it so

Obviously anything that can be inferred from the object's properties (like we did for the "FRONT DOOR" and cFlagUnmovable) should be handled automatically. But what about story events? Those should be handled by individual functions that would override the command's default behavior. The function would return True if it handled the event, or False if it lets the generic code do it... something like that:

CONST True = -1
CONST False = 0

''
'' STORY OVERRIDE: DROP
'' This function returns True if it resolved the event, or False if the
'' default code must resolve it itself.
''
FUNCTION storyDoDrop% (theObject AS INTEGER)
  ' Nothing special, allow any object to be dropped anywhere.
  storyDoDrop% = False
END FUNCTION

''
'' STORY OVERRIDE: GO, WALK
'' This function returns True if it resolved the event, or False if the
'' default code must resolve it itself.
''
FUNCTION storyDoGo% (nextRoom AS INTEGER)

  ' We're unlikely going to handle it ourselve, unless...
  storyDoGo% = False

  SELECT CASE (gPlWhere)

  ' If the player is on the porch...
  CASE cRoomPorch
    ' ...and the player wants to go inside the house...
    IF (nextRoom = cRoomMainHall) THEN
      ' ...but the door is still closed...
      IF ((gObjFlag(cObjDoor) AND cFlagIsOpen) = 0) THEN
        ' Tell the player to open it first!
        PRINT "THE FRONT DOOR IS CLOSED, OPEN IT FIRST."
        ' We handled the event.
        storyDoGo% = True
      END IF
    END IF

  END SELECT
END FUNCTION

''
'' STORY OVERRIDE: TAKE, GET
'' This function returns True if it resolved the event, or False if the
'' default code must resolve it itself.
''
FUNCTION storyDoTake% (theObject AS INTEGER)
  ' If the code got this far, the player may take it. Let the default code
  ' handle the event.
  storyDoTake% = False
END FUNCTION

''
'' STORY OVERRIDE: USE
'' This function returns True if it resolved the event, or False if the
'' default code must resolve it itself.
''
FUNCTION storyDoUse% (theObject AS INTEGER)

  ' We're unlikely going to handle it ourselve, unless...
  storyDoUse% = False

  SELECT CASE (gPlWhere)

  ' If the player is on the porch...
  CASE cRoomPorch
    ' ...and is using the key (if we got this far, he can use it.)
    IF (theObject = cObjKey) THEN
      ' Unlock the door.
      gObjFlag(cObjDoor) = gObjFlag(cObjDoor) AND NOT cFlagLocked
      ' Banish the key to the shadow realm.
      gObjRoom(theObject) = cNowhere
      ' Tell the player the door has been unlocked.
      PRINT "YOU UNLOCKED THE FRONT DOOR."
      ' We handled the event.
      storyDoUse% = True
    END IF
  END SELECT
END FUNCTION

Now, we hook those functions in cmdExec%() as we introduce new verbs: "OPEN", "CLOSE" and "USE". Notice how story events have precedent over the default verb behavior. Also, note the compact chunk of code we introduced for "OPEN" and "CLOSE"; Any object with the cFlagOpenClose attribute may be closed or opened without any extra code: whether it's a chest, door, gate, drawer, box, closet, cabinet, a pendant, a book, or a magazine, it just works! Establishing common behaviors for objects makes our world richer with hardly any effort!

''
'' EXECUTE COMMAND (VERSION 3)
'' This function returns -1 if the player wants to quit. Otherwise, it just
'' executes the command we provided.
''
FUNCTION cmdExec%(cmdVerb AS STRING, cmdNoun AS STRING)
  DIM idx AS INTEGER

  SELECT CASE (cmdVerb)

  CASE ""
    PRINT "WHAT NOW?"

  CASE "QUIT", "EXIT"
    cmdExec% = -1
    EXIT FUNCTION

  CASE "DANCE"
    PRINT "YOU DANCE LIKE NO ONE IS WATCHING. AS EXPECTED, IT DIDN'T"
    PRINT "SOLVE ANYTHING BUT IT MAKES YOU FEEL JUST A TINY LITTLE BIT"
    PRINT "BETTER ABOUT YOUR ORDEAL."

  CASE "INVENTORY"
    printObjects cInInventory

  CASE "USE"
    idx = getObjectIndex%(cmdNoun)
    IF (idx = cNothing) THEN
      PRINT "I DON'T KNOW WHAT "; cmdNoun; " IS."
    ELSEIF ((gObjRoom(idx) <> gPlWhere) AND (gObjRoom(idx) <> cInInventory)) THEN
      PRINT "THERE'S NO "; gObjName(idx); " NEARBY."
    ELSEIF (storyDoUse%(idx) = False) THEN
      PRINT "WHAT YOU EXPECTED DID NOT HAPPEN."
    END IF

  CASE "OPEN"
    idx = getObjectIndex%(cmdNoun)
    IF (idx = cNothing) THEN
      PRINT "I DON'T KNOW WHAT "; cmdNoun; " IS."
    ELSEIF ((gObjRoom(idx) <> gPlWhere) AND (gObjRoom(idx) <> cInInventory)) THEN
      PRINT "THERE'S NO "; gObjName(idx); " NEARBY."
    ELSEIF ((gObjFlag(idx) AND cFlagOpenClose) = 0) THEN
      PRINT gObjName(idx); " CAN NOT BE OPENED."
    ELSEIF (gObjFlag(idx) AND cFlagIsOpen) THEN
      PRINT gObjName(idx); " IS ALREADY OPEN."
    ELSEIF (gObjFlag(idx) AND cFlagLocked) THEN
      PRINT gObjName(idx); " IS LOCKED."
    ELSE
      gObjFlag(idx) = gObjFlag(idx) OR cFlagIsOpen
      PRINT gObjName(idx); " IS OPEN."
    END IF

  CASE "CLOSE"
    idx = getObjectIndex%(cmdNoun)
    IF (idx = cNothing) THEN
      PRINT "I DON'T KNOW WHAT "; cmdNoun; " IS."
    ELSEIF ((gObjRoom(idx) <> gPlWhere) AND (gObjRoom(idx) <> cInInventory)) THEN
      PRINT "THERE'S NO "; gObjName(idx); " NEARBY."
    ELSEIF ((gObjFlag(idx) AND cFlagOpenClose) = 0) THEN
      PRINT gObjName(idx); " CAN NOT BE CLOSED."
    ELSEIF ((gObjFlag(idx) AND cFlagIsOpen) = 0) THEN
      PRINT gObjName(idx); " IS ALREADY CLOSED."
    ELSE
      gObjFlag(idx) = gObjFlag(idx) AND NOT cFlagIsOpen
      IF (gObjFlag(idx) AND cFlagLocked) THEN
        PRINT gObjName(idx); " LOCKED ITSELF AS IT CLOSED."
      ELSE
        PRINT gObjName(idx); " IS CLOSED."
      END IF
    END IF

  CASE "DROP"
    idx = getObjectIndex%(cmdNoun)
    IF (idx = cNothing) THEN
      PRINT "I DON'T KNOW WHAT "; cmdNoun; " IS."
    ELSEIF (gObjRoom(idx) <> cInInventory) THEN
      PRINT "YOU DON'T HAVE ANY "; gObjName(idx); "."
    ELSEIF (storyDoDrop%(idx) = False) THEN
      gObjRoom(idx) = gPlWhere
      PRINT "YOU DROPPED "; gObjName(idx); "."
    END IF

  CASE "TAKE", "GET"
    idx = getObjectIndex%(cmdNoun)
    IF (idx = cNothing) THEN
      PRINT "I DON'T KNOW WHAT "; cmdNoun; " IS."
    ELSEIF (gObjRoom(idx) <> gPlWhere) THEN
      PRINT "THERE'S NO "; gObjName(idx); " NEARBY."
    ELSEIF (gObjFlag(idx) AND cFlagUnmovable) THEN
      PRINT "YOU CAN'T TAKE "; gObjName(idx); "."
    ELSEIF (gObjRoom(idx) = cInInventory) THEN
      PRINT "YOU ALREADY HAVE "; gObjName(idx); "."
    ELSEIF (storyDoTake%(idx) = False) THEN
      gObjRoom(idx) = cInInventory
      PRINT "YOU GOT "; gObjName(idx); "."
    END IF

  CASE "GO", "WALK"
    idx = getExitIndex%(cmdNoun)
    IF (idx = cNowhere) THEN
      PRINT "WHERE IS THAT EXACTLY?"
    ELSEIF (gRoomExit(gPlWhere, idx) = cNowhere) THEN
      PRINT "YOU CAN'T GO "; cmdNoun; "."
    ELSEIF (storyDoGo%(gRoomExit(gPlWhere, idx)) = False) THEN
      roomSwitch gRoomExit(gPlWhere, idx)
    END IF

  CASE ELSE
    PRINT "I DON'T KNOW HOW TO "; CHR$(34); cmdVerb; CHR$(34); "."

  END SELECT
END FUNCTION

What now?

You may grow frustrated with "FRONT DOOR" being the full name of the object. What if we wanted the parser to understand that it is just a "DOOR" that happens to be in "FRONT" of the house? And what if we actually wanted to "USE THE KEY WITH THE FRONT DOOR" rather than blindly invoke the mystical powers of the key? What if the user typed "UNLOCK FRONT DOOR" instead? Do we need to establish a distinction between nouns, adjectives and prepositions? Is it really worth the effort, or should we simply rename that object "DOOR"?

The takeaway here is that the parser only requires as much depth as the definition of our world: the more detail we inscribe into objects and actions, the more detail the parser should (and becomes able) to understand. Parsing and splitting commands isn't too difficult, but how do you "PUT WATER IN THE RUSTY BUCKET" if the object "BUCKET" is not described as a container? What is "GREEN" in a world where colors do not exist? How could we possibly handle prepositions of place when objects are never explicitly located anywhere? Nuanced and complex requests have no meaning in a shallow simulation. We don't want a more "intelligent" parser as much as we want a more detailed universe. And that's another can of worm altogether.

If you don't feel like copy/pasting the code above, you can "GET THE LISTING" right here. Have fun!