Text Adventure Engine

'
' Interactive fiction engine
'

' Subroutines
DECLARE SUB Database (SNum)
DECLARE SUB ItemDesc (INum)
DECLARE SUB ProcessCommand ()
DECLARE SUB SetupGame ()
DECLARE SUB ShowIntro ()
DECLARE SUB ShowRoom ()
DECLARE SUB StatusBar ()

' Constants
CONST Player = -1
CONST True = -1
CONST False = 0
CONST NumRooms = 10  ' Number of rooms in game (Must be no less than 2)
CONST NumItems = 10  ' Number of items in game
CONST MaxAdjs = 5    ' Max number of adjectives per item
CONST MaxNouns = 5   ' Max number of nouns per item
CONST MaxScore = 100 ' Max score possible

' Game variables
DIM SHARED Score AS INTEGER      ' Player's score
DIM SHARED Moves AS INTEGER      ' Player's moves
DIM SHARED CMD AS STRING         ' Command entered into parser
DIM SHARED MCMD(10) AS STRING    ' Storage for multiple sentences
DIM SHARED CurRoom AS INTEGER    ' Player's current location
DIM SHARED Message(10) AS STRING ' In-game messages
DIM SHARED SaveGame AS STRING    ' Game's default savegame name
DIM SHARED Restart AS INTEGER    ' If set to 1 then game is restarted
DIM SHARED RoomName AS STRING    ' Stores the current room's name
DIM SHARED Verbose AS INTEGER    ' Is verbosity on?

' For rooms
DIM SHARED RN(NumRooms) AS INTEGER    ' Eight basic directions
DIM SHARED RS(NumRooms) AS INTEGER
DIM SHARED RE(NumRooms) AS INTEGER
DIM SHARED RW(NumRooms) AS INTEGER
DIM SHARED RNE(NumRooms) AS INTEGER
DIM SHARED RNW(NumRooms) AS INTEGER
DIM SHARED RSE(NumRooms) AS INTEGER
DIM SHARED RSW(NumRooms) AS INTEGER
DIM SHARED RU(NumRooms) AS INTEGER    ' Up, down, in and out
DIM SHARED RD(NumRooms) AS INTEGER
DIM SHARED RI(NumRooms) AS INTEGER
DIM SHARED RO(NumRooms) AS INTEGER
DIM SHARED RDark(NumRooms) AS INTEGER ' Room is dark?
DIM SHARED RSeen(NumRooms) AS INTEGER ' Has room been seen? (Used by verbose)

' For items
DIM SHARED IName(NumItems) AS STRING            ' Name of the item
DIM SHARED IAdj(NumItems, MaxAdjs) AS STRING    ' Item's adjectives
DIM SHARED INoun(NumItems, MaxNouns) AS STRING  ' Item's nouns
DIM SHARED ILoc(NumItems) AS INTEGER            ' Item's location
DIM SHARED IFixed(NumItems) AS INTEGER          ' Item is non-movable?
DIM SHARED ILit(NumItems) AS INTEGER            ' Item is lightsource?
DIM SHARED ILightSwitch(NumItems) AS INTEGER    ' Item has a light switch?
DIM SHARED IDecoration(NumItems) AS INTEGER     ' Item is decoration?
DIM SHARED ITakeScore(NumItems) AS INTEGER      ' Score obtained from taking item
DIM SHARED ITakenOnce(NumItems) AS INTEGER      ' Makes sure you get score once

' Error number used for crash prevention
DIM SHARED ErrorNum AS INTEGER

' Initialize game
NewGame:
CLS : SCREEN 0
CALL SetupGame ' Set the game's variables
CALL ShowIntro ' Show the introduction
CALL ShowRoom ' Show the initial starting location
CALL StatusBar
PRINT
ON ERROR GOTO ErrorHandle

' Parser
Parser:
FOR A = 0 TO 10: MCMD(A) = "": NEXT A
CMD = "": LINE INPUT ">"; CMD
IF CMD = "" THEN PRINT "Huh?": PRINT : GOTO Parser
CALL ProcessCommand
IF Restart = True THEN GOTO NewGame
GOTO Parser

' Error handler
ErrorHandle:
IF ErrorNum = 1 THEN PRINT "Failed.": PRINT : CLOSE #1
ErrorNum = 0: GOTO Parser

SUB Database (SNum)
    ' Process basic commands and travel verbs
    SELECT CASE MCMD(SNum)
        CASE "GO NORTH", "GO N", "NORTH", "N"
            IF RN(CurRoom) = 0 THEN PRINT Message(1)
            IF RN(CurRoom) <> 0 THEN CurRoom = RN(CurRoom): Moves = Moves + 1: CALL ShowRoom
            GOTO EndOfProcess
        CASE "GO SOUTH", "GO S", "SOUTH", "S"
            IF RS(CurRoom) = 0 THEN PRINT Message(1)
            IF RS(CurRoom) <> 0 THEN CurRoom = RS(CurRoom): Moves = Moves + 1: CALL ShowRoom
            GOTO EndOfProcess
        CASE "GO EAST", "GO E", "EAST", "E"
            IF RE(CurRoom) = 0 THEN PRINT Message(1)
            IF RE(CurRoom) <> 0 THEN CurRoom = RE(CurRoom): Moves = Moves + 1: CALL ShowRoom
            GOTO EndOfProcess
        CASE "GO WEST", "GO W", "WEST", "W"
            IF RW(CurRoom) = 0 THEN PRINT Message(1)
            IF RW(CurRoom) <> 0 THEN CurRoom = RW(CurRoom): Moves = Moves + 1: CALL ShowRoom
            GOTO EndOfProcess
        CASE "GO NORTHEAST", "GO NE", "NORTHEAST", "NE"
            IF RNE(CurRoom) = 0 THEN PRINT Message(1)
            IF RNE(CurRoom) <> 0 THEN CurRoom = RNE(CurRoom): Moves = Moves + 1: CALL ShowRoom
            GOTO EndOfProcess
        CASE "GO NORTHWEST", "GO NW", "NORTHWEST", "NW"
            IF RNW(CurRoom) = 0 THEN PRINT Message(1)
            IF RNW(CurRoom) <> 0 THEN CurRoom = RNW(CurRoom): Moves = Moves + 1: CALL ShowRoom
            GOTO EndOfProcess
        CASE "GO SOUTHEAST", "GO SE", "SOUTHEAST", "SE"
            IF RSE(CurRoom) = 0 THEN PRINT Message(1)
            IF RSE(CurRoom) <> 0 THEN CurRoom = RSE(CurRoom): Moves = Moves + 1: CALL ShowRoom
            GOTO EndOfProcess
        CASE "GO SOUTHWEST", "GO SW", "SOUTHWEST", "SW"
            IF RSW(CurRoom) = 0 THEN PRINT Message(1)
            IF RSW(CurRoom) <> 0 THEN CurRoom = RSW(CurRoom): Moves = Moves + 1: CALL ShowRoom
            GOTO EndOfProcess
        CASE "GO UP", "GO U", "UP", "U"
            IF RU(CurRoom) = 0 THEN PRINT Message(1)
            IF RU(CurRoom) <> 0 THEN CurRoom = RU(CurRoom): Moves = Moves + 1: CALL ShowRoom
            GOTO EndOfProcess
        CASE "GO DOWN", "GO D", "DOWN", "D"
            IF RD(CurRoom) = 0 THEN PRINT Message(1)
            IF RD(CurRoom) <> 0 THEN CurRoom = RD(CurRoom): Moves = Moves + 1: CALL ShowRoom
            GOTO EndOfProcess
        CASE "GO IN", "IN", "ENTER"
            IF RI(CurRoom) = 0 THEN PRINT Message(6)
            IF RI(CurRoom) <> 0 THEN CurRoom = RI(CurRoom): Moves = Moves + 1: CALL ShowRoom
            GOTO EndOfProcess
        CASE "GO OUT", "OUT", "LEAVE"
            IF RO(CurRoom) = 0 THEN PRINT Message(7)
            IF RO(CurRoom) <> 0 THEN CurRoom = RO(CurRoom): Moves = Moves + 1: CALL ShowRoom
            GOTO EndOfProcess
        CASE "LOOK", "L"
            Moves = Moves + 1: CALL ShowRoom: GOTO EndOfProcess
        CASE "QUIT", "Q"
            GOSUB ShowScore
            LINE INPUT "Are you sure you want to quit? (Y is affirmative):"; A$
            IF UCASE$(A$) = "Y" OR UCASE$(A$) = "YES" THEN END
            GOTO EndOfProcess
        CASE "SCORE"
            GOSUB ShowScore: GOTO EndOfProcess
        CASE "GO"
            PRINT "Where do you want to go?": GOTO EndOfProcess
        CASE "TAKE", "GET", "PICK UP", "DROP", "PUT DOWN"
            PRINT "What do you want to " + LCASE$(MCMD(SNum)) + "?": GOTO EndOfProcess
        CASE "TAKE ALL", "GET ALL", "PICK UP ALL"
            B = 0
            FOR A = 1 TO NumItems
                IF ILoc(A) = CurRoom AND IFixed(A) = 0 THEN
                    ILoc(A) = Player: B = 1: PRINT IName(A) + ": Taken."
                END IF
            NEXT A
            IF B = 0 THEN
                PRINT Message(4)
            ELSE
                Moves = Moves + 1
            END IF
            GOTO EndOfProcess
        CASE "DROP ALL", "PUT DOWN ALL"
            B = 0
            FOR A = 1 TO NumItems
                IF ILoc(A) = Player THEN
                    ILoc(A) = CurRoom: B = 1: PRINT IName(A) + ": Taken."
                END IF
            NEXT A
            IF B = 0 THEN
                PRINT Message(5)
            ELSE
                Moves = Moves + 1
            END IF
            GOTO EndOfProcess
        CASE "INVENTORY", "I"
            FOR A = 1 TO NumItems
                IF ILit(A) = True AND ILoc(A) = CurRoom THEN GOTO ShowInv
                IF ILit(A) = True AND ILoc(A) = Player THEN GOTO ShowInv
            NEXT A
            IF RDark(CurRoom) = True THEN
                PRINT Message(2): GOTO EndOfProcess
            END IF
ShowInv:
            B = 0: PRINT "You are carrying";
            FOR A = 1 TO NumItems
                IF ILoc(A) = Player THEN
                    IF B = 0 THEN
                        B = 1: PRINT ":"
                    END IF
                    PRINT "  " + "a";
                    IF A$ = "A" OR A$ = "E" OR A$ = "I" OR A$ = "O" OR A$ = "U" THEN
                        PRINT "n"
                    END IF
                    PRINT " " + IName(A);
                    IF ILit(A) = True THEN
                        PRINT " (providing light)"
                    ELSE
                        PRINT
                    END IF
                END IF
            NEXT A
            IF B = 0 THEN PRINT " nothing at all."
            Moves = Moves + 1
            GOTO EndOfProcess
        CASE "SAVE", "SAVE GAME"
            PRINT "Enter name of file (Default is " + SaveGame + ")";
            LINE INPUT ":"; A$
            IF A$ = "" THEN
                A$ = SaveGame
            ELSE
                SaveGame = A$
            END IF
            GOTO SaveGame
        CASE "RESTORE", "RESTORE GAME"
            PRINT "Enter name of file (Default is " + SaveGame + ")";
            LINE INPUT ":"; A$
            IF A$ = "" THEN
                A$ = SaveGame
            ELSE
                SaveGame = A$
            END IF
            GOTO LoadGame
        CASE "RESTART", "RESTART GAME"
            LINE INPUT "Are you sure you want to restart? (Y is affirmative):"; A$
            IF UCASE$(A$) = "Y" OR UCASE$(A$) = "YES" THEN Restart = True
            GOTO EndOfProcess
        CASE "VERBOSE"
            PRINT "Maximum verbosity."
            Verbose = True
            GOTO EndOfProcess
        CASE "BRIEF"
            PRINT "Brief descriptions."
            Verbose = False
            GOTO EndOfProcess
    END SELECT

    ' Process item related commands
    FOR A = 1 TO NumItems
        FOR B = 1 TO MaxAdjs
            FOR C = 1 TO MaxNouns
                IF MCMD(SNum) = "TAKE " + UCASE$(IAdj(A, B)) + " " + UCASE$(INoun(A, C)) THEN GOTO TakeItem
                IF MCMD(SNum) = "TAKE " + UCASE$(INoun(A, C)) THEN GOTO TakeItem
                IF MCMD(SNum) = "GET " + UCASE$(IAdj(A, B)) + " " + UCASE$(INoun(A, C)) THEN GOTO TakeItem
                IF MCMD(SNum) = "GET " + UCASE$(INoun(A, C)) THEN GOTO TakeItem
                IF MCMD(SNum) = "PICK UP " + UCASE$(IAdj(A, B)) + " " + UCASE$(INoun(A, C)) THEN GOTO TakeItem
                IF MCMD(SNum) = "PICK UP " + UCASE$(INoun(A, C)) THEN GOTO TakeItem
                IF MCMD(SNum) = "DROP " + UCASE$(IAdj(A, B)) + " " + UCASE$(INoun(A, C)) THEN GOTO DropItem
                IF MCMD(SNum) = "DROP " + UCASE$(INoun(A, C)) THEN GOTO DropItem
                IF MCMD(SNum) = "PUT DOWN " + UCASE$(IAdj(A, B)) + " " + UCASE$(INoun(A, C)) THEN GOTO DropItem
                IF MCMD(SNum) = "PUT DOWN " + UCASE$(INoun(A, C)) THEN GOTO DropItem
                IF MCMD(SNum) = "EXAMINE " + UCASE$(IAdj(A, B)) + " " + UCASE$(INoun(A, C)) THEN GOTO ExamItem
                IF MCMD(SNum) = "EXAMINE " + UCASE$(INoun(A, C)) THEN GOTO ExamItem
                IF MCMD(SNum) = "X " + UCASE$(IAdj(A, B)) + " " + UCASE$(INoun(A, C)) THEN GOTO ExamItem
                IF MCMD(SNum) = "X " + UCASE$(INoun(A, C)) THEN GOTO ExamItem
                IF MCMD(SNum) = "LOOK AT " + UCASE$(IAdj(A, B)) + " " + UCASE$(INoun(A, B)) THEN GOTO ExamItem
                IF MCMD(SNum) = "LOOK AT " + UCASE$(INoun(A, C)) THEN GOTO ExamItem
                IF MCMD(SNum) = "TURN ON " + UCASE$(IAdj(A, B)) + " " + UCASE$(INoun(A, B)) THEN GOTO TurnOn
                IF MCMD(SNum) = "TURN ON " + UCASE$(INoun(A, C)) THEN GOTO TurnOn
                IF MCMD(SNum) = "LIGHT " + UCASE$(IAdj(A, B)) + " " + UCASE$(INoun(A, B)) THEN GOTO TurnOn
                IF MCMD(SNum) = "LIGHT " + UCASE$(INoun(A, C)) THEN GOTO TurnOn
                IF MCMD(SNum) = "TURN OFF " + UCASE$(IAdj(A, B)) + " " + UCASE$(INoun(A, B)) THEN GOTO TurnOff
                IF MCMD(SNum) = "TURN OFF " + UCASE$(INoun(A, C)) THEN GOTO TurnOff
                IF MCMD(SNum) = "EXTINGUISH " + UCASE$(IAdj(A, B)) + " " + UCASE$(INoun(A, B)) THEN GOTO TurnOff
                IF MCMD(SNum) = "EXTINGUISH " + UCASE$(INoun(A, C)) THEN GOTO TurnOff
                IF MCMD(SNum) = "PUT OUT " + UCASE$(IAdj(A, B)) + " " + UCASE$(INoun(A, B)) THEN GOTO TurnOff
                IF MCMD(SNum) = "PUT OUT " + UCASE$(INoun(A, C)) THEN GOTO TurnOff
            NEXT C
        NEXT B
    NEXT A

    ' Show if command is not in database
    PRINT "I don't understand " + CHR$(34) + LCASE$(MCMD(SNum)) + CHR$(34) + "."
    GOTO EndOfProcess
    ' Take items
TakeItem:
    FOR B = 1 TO NumItems
        IF ILit(B) = True AND ILoc(B) = CurRoom THEN GOTO TakeI
        IF ILit(B) = True AND ILoc(B) = Player THEN GOTO TakeI
    NEXT B
    IF RDark(CurRoom) = True THEN
        PRINT Message(2): GOTO EndOfProcess
    END IF
TakeI:
    IF ILoc(A) = CurRoom AND IFixed(A) = 0 THEN
        ILoc(A) = Player: Moves = Moves + 1: PRINT "Taken."
        IF ITakeScore(A) <> 0 AND ITakenOnce(A) = False THEN
            Score = Score + ITakeScore(A)
            PRINT "Your score has just gone up by"; ITakeScore(A); "point";
            IF ITakeScore(A) <> 1 THEN
                PRINT "s."
            ELSE
                PRINT "."
            END IF
        END IF
    ELSEIF ILoc(A) = CurRoom AND IFixed(A) = True THEN
        PRINT "That can't be taken."
    ELSEIF ILoc(A) = Player THEN
        PRINT "You already have that."
    ELSE
        PRINT "You don't see that here."
    END IF
    GOTO EndOfProcess
    ' Drop items
DropItem:
    IF ILoc(A) = Player THEN
        ILoc(A) = CurRoom: Moves = Moves + 1: PRINT "Dropped."
    ELSE
        PRINT "You don't have that."
    END IF
    GOTO EndOfProcess
    ' Turn on items
TurnOn:
    IF ILoc(A) = Player OR ILoc(A) = CurRoom THEN
        IF ILightSwitch(A) = True THEN
            IF ILit(A) = True THEN
                PRINT "It's already on."
            ELSE
                ILit(A) = True: PRINT "The " + INoun(A, B) + " is now on."
            END IF
        ELSE
            PRINT "That can't be turned on."
        END IF
    ELSE
        PRINT Message(3)
    END IF
    GOTO EndOfProcess
    ' Turn off items
TurnOff:
    IF ILoc(A) = Player OR ILoc(A) = CurRoom THEN
        IF ILightSwitch(A) = True THEN
            IF ILit(A) = True THEN
                ILit(A) = False: PRINT "The " + INoun(A, B) + " is now off."
            ELSE
                PRINT "It's already off."
            END IF
        ELSE
            PRINT "That can't be turned off."
        END IF
    ELSE
        PRINT Message(3)
    END IF
    GOTO EndOfProcess

    ' Save game
SaveGame:
    ErrorNum = 1
    OPEN A$ FOR OUTPUT ACCESS WRITE LOCK READ AS #1
    WRITE #1, CurRoom, Score, Moves
    FOR A = 1 TO NumRooms
        WRITE #1, RSeen(A)
    NEXT A
    FOR A = 1 TO NumItems
        WRITE #1, ILit(A)
        WRITE #1, ILoc(A)
        WRITE #1, ITakeScore(A)
        WRITE #1, ITakenOnce(A)
    NEXT A
    CLOSE #1
    GOTO EndOfProcess
    ' Restore game
LoadGame:
    ErrorNum = 1
    OPEN A$ FOR INPUT ACCESS READ LOCK WRITE AS #1
    INPUT #1, CurRoom, Score, Moves
    FOR A = 1 TO NumRooms
        INPUT #1, RSeen(A)
    NEXT A
    FOR A = 1 TO NumItems
        INPUT #1, ILit(A)
        INPUT #1, ILoc(A)
        INPUT #1, ITakeScore(A)
        INPUT #1, ITakenOnce(A)
    NEXT A
    CLOSE #1
    GOTO EndOfProcess
    ' Display Score
ShowScore:
    PRINT "Your score is"; Score; "point";
    IF Score <> 1 THEN PRINT "s";
    PRINT " out of"; MaxScore; "in"; Moves; "move";
    IF Moves <> 1 THEN PRINT "s";
    PRINT "."
    RETURN
ExamItem:
    FOR B = 1 TO NumItems
        IF ILit(B) = True AND ILoc(B) = CurRoom THEN GOTO ExamI
        IF ILit(B) = True AND ILoc(B) = Player THEN GOTO ExamI
    NEXT B
    IF RDark(CurRoom) = True THEN
        PRINT Message(2): GOTO EndOfProcess
    END IF
ExamI:
    IF ILoc(A) = CurRoom OR ILoc(A) = Player THEN
        Moves = Moves + 1: CALL ItemDesc(A)
    ELSE
        PRINT Message(3)
    END IF
    GOTO EndOfProcess
    ' End of Processing
EndOfProcess:
END SUB

SUB ItemDesc (INum)
    SELECT CASE INum
        CASE ELSE
            PRINT "You see nothing special about that."
    END SELECT
END SUB

SUB ProcessCommand
    ' Process multiple sentences
    CMD = UCASE$(CMD): L = LEN(CMD)
    A$ = "": A = 0: B = 0: NumS = 0
    FOR A = 1 TO L
        A$ = MID$(CMD, A, 1)
        IF A$ = "." THEN
            A$ = "": NumS = NumS + 1: B = 1
        ELSEIF A$ = " " AND B = 1 THEN
            A$ = ""
        ELSE
            MCMD(NumS) = MCMD(NumS) + A$: B = 0
        END IF
    NEXT A
    ' Run the multiple sentences through the database (one at a time)
    FOR A = 0 TO NumS
        IF MCMD(A) <> "" THEN CALL Database(A): MCMD(A) = "": PRINT
        CALL StatusBar
    NEXT A
END SUB

SUB SetupGame
    CurRoom = 1 ' Set the player's starting location
    Score = 0 ' Set the player's initial score
    Moves = 0 ' Set the player's initial moves
    Restart = 0 ' Has the player typed RESTART?
    SaveGame = "ADVENT.SAV" ' Default savegame name
    ' Setup rooms

    ' Setup items

    ' Setup in-game messages
    Message(1) = "There's a wall there."
    Message(2) = "You can't see anything."
    Message(3) = "You can't see that here."
    Message(4) = "You can't see anything that can be taken."
    Message(5) = "You don't have anything to drop."
    Message(6) = "There's nothing to get into."
    Message(7) = "You're not in anything."
END SUB

SUB ShowIntro
    FOR A = 1 TO 15: PRINT : NEXT A
END SUB

SUB ShowRoom
    ' Show room short and long descriptions
    FOR A = 1 TO NumItems
        IF ILit(A) = True AND ILoc(A) = CurRoom THEN GOTO ShowRm
        IF ILit(A) = True AND ILoc(A) = Player THEN GOTO ShowRm
    NEXT A
    IF RDark(CurRoom) = True THEN GOTO RoomIsDark
ShowRm:
    ' Show short description
    'SELECT CASE CurRoom
    'END SELECT

    ' Check to see if LOOK was entered (always shows full room description)
    IF MCMD(SNum) = "LOOK" OR MCMD(SNum) = "L" THEN GOTO LongDesc
    ' Check for verbosity
    IF Verbose = False AND RSeen(CurRoom) = True THEN GOTO ShowItems
    RSeen(CurRoom) = True

    ' Show long description
LongDesc:
    'SELECT CASE CurRoom
    'END SELECT

    ' Show items found in CurRoom
ShowItems:
    FOR A = 1 TO NumItems
        A$ = UCASE$(LEFT$(IName(A), 1))
        IF ILoc(A) = CurRoom AND IDecoration(A) = False THEN
            IF A$ = "A" OR A$ = "E" OR A$ = "I" OR A$ = "O" OR A$ = "U" THEN
                PRINT "There is an " + IName(A) + " here.";
            ELSE
                PRINT "There is a " + IName(A) + " here.";
            END IF
            IF ILit(A) = True THEN
                PRINT " It is glowing."
            ELSE
                PRINT
            END IF
        END IF
    NEXT A
    GOTO RoomShown
    ' Show darkness
RoomIsDark:
    RoomName = "In the Dark": PRINT "You are in the dark."
RoomShown:
END SUB

SUB StatusBar
    Row = CSRLIN: Col = POS(0): L = LEN(RoomName)
    LOCATE 1, 1: COLOR 0, 7
    PRINT RoomName + SPACE$(53 - L) + "Score:" + SPACE$(7) + "Moves:" + SPACE$(7)
    LOCATE 1, 60: PRINT Score: LOCATE 1, 73: PRINT Moves
    COLOR 7, 0: LOCATE Row, Col
END SUB