Guest User

Ryiah's Adventure Engine

a guest
Jul 31st, 2017
16
Never
Not a member of Pastebin yet? Sign Up, it unlocks many cool features!
  1. '
  2. ' Interactive fiction engine
  3. '
  4.  
  5. ' Subroutines
  6. DECLARE SUB Database (SNum)
  7. DECLARE SUB ItemDesc (INum)
  8. DECLARE SUB ProcessCommand ()
  9. DECLARE SUB SetupGame ()
  10. DECLARE SUB ShowIntro ()
  11. DECLARE SUB ShowRoom ()
  12. DECLARE SUB StatusBar ()
  13.  
  14. ' Constants
  15. CONST Player = -1
  16. CONST True = -1
  17. CONST False = 0
  18. CONST NumRooms = 10  ' Number of rooms in game (Must be no less than 2)
  19. CONST NumItems = 10  ' Number of items in game
  20. CONST MaxAdjs = 5    ' Max number of adjectives per item
  21. CONST MaxNouns = 5   ' Max number of nouns per item
  22. CONST MaxScore = 100 ' Max score possible
  23.  
  24. ' Game variables
  25. DIM SHARED Score AS INTEGER      ' Player's score
  26. DIM SHARED Moves AS INTEGER      ' Player's moves
  27. DIM SHARED CMD AS STRING         ' Command entered into parser
  28. DIM SHARED MCMD(10) AS STRING    ' Storage for multiple sentences
  29. DIM SHARED CurRoom AS INTEGER    ' Player's current location
  30. DIM SHARED Message(10) AS STRING ' In-game messages
  31. DIM SHARED SaveGame AS STRING    ' Game's default savegame name
  32. DIM SHARED Restart AS INTEGER    ' If set to 1 then game is restarted
  33. DIM SHARED RoomName AS STRING    ' Stores the current room's name
  34. DIM SHARED Verbose AS INTEGER    ' Is verbosity on?
  35.  
  36. ' For rooms
  37. DIM SHARED RN(NumRooms) AS INTEGER    ' Eight basic directions
  38. DIM SHARED RS(NumRooms) AS INTEGER
  39. DIM SHARED RE(NumRooms) AS INTEGER
  40. DIM SHARED RW(NumRooms) AS INTEGER
  41. DIM SHARED RNE(NumRooms) AS INTEGER
  42. DIM SHARED RNW(NumRooms) AS INTEGER
  43. DIM SHARED RSE(NumRooms) AS INTEGER
  44. DIM SHARED RSW(NumRooms) AS INTEGER
  45. DIM SHARED RU(NumRooms) AS INTEGER    ' Up, down, in and out
  46. DIM SHARED RD(NumRooms) AS INTEGER
  47. DIM SHARED RI(NumRooms) AS INTEGER
  48. DIM SHARED RO(NumRooms) AS INTEGER
  49. DIM SHARED RDark(NumRooms) AS INTEGER ' Room is dark?
  50. DIM SHARED RSeen(NumRooms) AS INTEGER ' Has room been seen? (Used by verbose)
  51.  
  52. ' For items
  53. DIM SHARED IName(NumItems) AS STRING            ' Name of the item
  54. DIM SHARED IAdj(NumItems, MaxAdjs) AS STRING    ' Item's adjectives
  55. DIM SHARED INoun(NumItems, MaxNouns) AS STRING  ' Item's nouns
  56. DIM SHARED ILoc(NumItems) AS INTEGER            ' Item's location
  57. DIM SHARED IFixed(NumItems) AS INTEGER          ' Item is non-movable?
  58. DIM SHARED ILit(NumItems) AS INTEGER            ' Item is lightsource?
  59. DIM SHARED ILightSwitch(NumItems) AS INTEGER    ' Item has a light switch?
  60. DIM SHARED IDecoration(NumItems) AS INTEGER     ' Item is decoration?
  61. DIM SHARED ITakeScore(NumItems) AS INTEGER      ' Score obtained from taking item
  62. DIM SHARED ITakenOnce(NumItems) AS INTEGER      ' Makes sure you get score once
  63.  
  64. ' Error number used for crash prevention
  65. DIM SHARED ErrorNum AS INTEGER
  66.  
  67. ' Initialize game
  68. NewGame:
  69. CLS : SCREEN 0
  70. CALL SetupGame ' Set the game's variables
  71. CALL ShowIntro ' Show the introduction
  72. CALL ShowRoom ' Show the initial starting location
  73. CALL StatusBar
  74. PRINT
  75. ON ERROR GOTO ErrorHandle
  76.  
  77. ' Parser
  78. Parser:
  79. FOR A = 0 TO 10: MCMD(A) = "": NEXT A
  80. CMD = "": LINE INPUT ">"; CMD
  81. IF CMD = "" THEN PRINT "Huh?": PRINT : GOTO Parser
  82. CALL ProcessCommand
  83. IF Restart = True THEN GOTO NewGame
  84. GOTO Parser
  85.  
  86. ' Error handler
  87. ErrorHandle:
  88. IF ErrorNum = 1 THEN PRINT "Failed.": PRINT : CLOSE #1
  89. ErrorNum = 0: GOTO Parser
  90.  
  91. SUB Database (SNum)
  92.     ' Process basic commands and travel verbs
  93.     SELECT CASE MCMD(SNum)
  94.         CASE "GO NORTH", "GO N", "NORTH", "N"
  95.             IF RN(CurRoom) = 0 THEN PRINT Message(1)
  96.             IF RN(CurRoom) <> 0 THEN CurRoom = RN(CurRoom): Moves = Moves + 1: CALL ShowRoom
  97.             GOTO EndOfProcess
  98.         CASE "GO SOUTH", "GO S", "SOUTH", "S"
  99.             IF RS(CurRoom) = 0 THEN PRINT Message(1)
  100.             IF RS(CurRoom) <> 0 THEN CurRoom = RS(CurRoom): Moves = Moves + 1: CALL ShowRoom
  101.             GOTO EndOfProcess
  102.         CASE "GO EAST", "GO E", "EAST", "E"
  103.             IF RE(CurRoom) = 0 THEN PRINT Message(1)
  104.             IF RE(CurRoom) <> 0 THEN CurRoom = RE(CurRoom): Moves = Moves + 1: CALL ShowRoom
  105.             GOTO EndOfProcess
  106.         CASE "GO WEST", "GO W", "WEST", "W"
  107.             IF RW(CurRoom) = 0 THEN PRINT Message(1)
  108.             IF RW(CurRoom) <> 0 THEN CurRoom = RW(CurRoom): Moves = Moves + 1: CALL ShowRoom
  109.             GOTO EndOfProcess
  110.         CASE "GO NORTHEAST", "GO NE", "NORTHEAST", "NE"
  111.             IF RNE(CurRoom) = 0 THEN PRINT Message(1)
  112.             IF RNE(CurRoom) <> 0 THEN CurRoom = RNE(CurRoom): Moves = Moves + 1: CALL ShowRoom
  113.             GOTO EndOfProcess
  114.         CASE "GO NORTHWEST", "GO NW", "NORTHWEST", "NW"
  115.             IF RNW(CurRoom) = 0 THEN PRINT Message(1)
  116.             IF RNW(CurRoom) <> 0 THEN CurRoom = RNW(CurRoom): Moves = Moves + 1: CALL ShowRoom
  117.             GOTO EndOfProcess
  118.         CASE "GO SOUTHEAST", "GO SE", "SOUTHEAST", "SE"
  119.             IF RSE(CurRoom) = 0 THEN PRINT Message(1)
  120.             IF RSE(CurRoom) <> 0 THEN CurRoom = RSE(CurRoom): Moves = Moves + 1: CALL ShowRoom
  121.             GOTO EndOfProcess
  122.         CASE "GO SOUTHWEST", "GO SW", "SOUTHWEST", "SW"
  123.             IF RSW(CurRoom) = 0 THEN PRINT Message(1)
  124.             IF RSW(CurRoom) <> 0 THEN CurRoom = RSW(CurRoom): Moves = Moves + 1: CALL ShowRoom
  125.             GOTO EndOfProcess
  126.         CASE "GO UP", "GO U", "UP", "U"
  127.             IF RU(CurRoom) = 0 THEN PRINT Message(1)
  128.             IF RU(CurRoom) <> 0 THEN CurRoom = RU(CurRoom): Moves = Moves + 1: CALL ShowRoom
  129.             GOTO EndOfProcess
  130.         CASE "GO DOWN", "GO D", "DOWN", "D"
  131.             IF RD(CurRoom) = 0 THEN PRINT Message(1)
  132.             IF RD(CurRoom) <> 0 THEN CurRoom = RD(CurRoom): Moves = Moves + 1: CALL ShowRoom
  133.             GOTO EndOfProcess
  134.         CASE "GO IN", "IN", "ENTER"
  135.             IF RI(CurRoom) = 0 THEN PRINT Message(6)
  136.             IF RI(CurRoom) <> 0 THEN CurRoom = RI(CurRoom): Moves = Moves + 1: CALL ShowRoom
  137.             GOTO EndOfProcess
  138.         CASE "GO OUT", "OUT", "LEAVE"
  139.             IF RO(CurRoom) = 0 THEN PRINT Message(7)
  140.             IF RO(CurRoom) <> 0 THEN CurRoom = RO(CurRoom): Moves = Moves + 1: CALL ShowRoom
  141.             GOTO EndOfProcess
  142.         CASE "LOOK", "L"
  143.             Moves = Moves + 1: CALL ShowRoom: GOTO EndOfProcess
  144.         CASE "QUIT", "Q"
  145.             GOSUB ShowScore
  146.             LINE INPUT "Are you sure you want to quit? (Y is affirmative):"; A$
  147.             IF UCASE$(A$) = "Y" OR UCASE$(A$) = "YES" THEN END
  148.             GOTO EndOfProcess
  149.         CASE "SCORE"
  150.             GOSUB ShowScore: GOTO EndOfProcess
  151.         CASE "GO"
  152.             PRINT "Where do you want to go?": GOTO EndOfProcess
  153.         CASE "TAKE", "GET", "PICK UP", "DROP", "PUT DOWN"
  154.             PRINT "What do you want to " + LCASE$(MCMD(SNum)) + "?": GOTO EndOfProcess
  155.         CASE "TAKE ALL", "GET ALL", "PICK UP ALL"
  156.             B = 0
  157.             FOR A = 1 TO NumItems
  158.                 IF ILoc(A) = CurRoom AND IFixed(A) = 0 THEN
  159.                     ILoc(A) = Player: B = 1: PRINT IName(A) + ": Taken."
  160.                 END IF
  161.             NEXT A
  162.             IF B = 0 THEN
  163.                 PRINT Message(4)
  164.             ELSE
  165.                 Moves = Moves + 1
  166.             END IF
  167.             GOTO EndOfProcess
  168.         CASE "DROP ALL", "PUT DOWN ALL"
  169.             B = 0
  170.             FOR A = 1 TO NumItems
  171.                 IF ILoc(A) = Player THEN
  172.                     ILoc(A) = CurRoom: B = 1: PRINT IName(A) + ": Taken."
  173.                 END IF
  174.             NEXT A
  175.             IF B = 0 THEN
  176.                 PRINT Message(5)
  177.             ELSE
  178.                 Moves = Moves + 1
  179.             END IF
  180.             GOTO EndOfProcess
  181.         CASE "INVENTORY", "I"
  182.             FOR A = 1 TO NumItems
  183.                 IF ILit(A) = True AND ILoc(A) = CurRoom THEN GOTO ShowInv
  184.                 IF ILit(A) = True AND ILoc(A) = Player THEN GOTO ShowInv
  185.             NEXT A
  186.             IF RDark(CurRoom) = True THEN
  187.                 PRINT Message(2): GOTO EndOfProcess
  188.             END IF
  189. ShowInv:
  190.             B = 0: PRINT "You are carrying";
  191.             FOR A = 1 TO NumItems
  192.                 IF ILoc(A) = Player THEN
  193.                     IF B = 0 THEN
  194.                         B = 1: PRINT ":"
  195.                     END IF
  196.                     PRINT "  " + "a";
  197.                     IF A$ = "A" OR A$ = "E" OR A$ = "I" OR A$ = "O" OR A$ = "U" THEN
  198.                         PRINT "n"
  199.                     END IF
  200.                     PRINT " " + IName(A);
  201.                     IF ILit(A) = True THEN
  202.                         PRINT " (providing light)"
  203.                     ELSE
  204.                         PRINT
  205.                     END IF
  206.                 END IF
  207.             NEXT A
  208.             IF B = 0 THEN PRINT " nothing at all."
  209.             Moves = Moves + 1
  210.             GOTO EndOfProcess
  211.         CASE "SAVE", "SAVE GAME"
  212.             PRINT "Enter name of file (Default is " + SaveGame + ")";
  213.             LINE INPUT ":"; A$
  214.             IF A$ = "" THEN
  215.                 A$ = SaveGame
  216.             ELSE
  217.                 SaveGame = A$
  218.             END IF
  219.             GOTO SaveGame
  220.         CASE "RESTORE", "RESTORE GAME"
  221.             PRINT "Enter name of file (Default is " + SaveGame + ")";
  222.             LINE INPUT ":"; A$
  223.             IF A$ = "" THEN
  224.                 A$ = SaveGame
  225.             ELSE
  226.                 SaveGame = A$
  227.             END IF
  228.             GOTO LoadGame
  229.         CASE "RESTART", "RESTART GAME"
  230.             LINE INPUT "Are you sure you want to restart? (Y is affirmative):"; A$
  231.             IF UCASE$(A$) = "Y" OR UCASE$(A$) = "YES" THEN Restart = True
  232.             GOTO EndOfProcess
  233.         CASE "VERBOSE"
  234.             PRINT "Maximum verbosity."
  235.             Verbose = True
  236.             GOTO EndOfProcess
  237.         CASE "BRIEF"
  238.             PRINT "Brief descriptions."
  239.             Verbose = False
  240.             GOTO EndOfProcess
  241.     END SELECT
  242.  
  243.     ' Process item related commands
  244.     FOR A = 1 TO NumItems
  245.         FOR B = 1 TO MaxAdjs
  246.             FOR C = 1 TO MaxNouns
  247.                 IF MCMD(SNum) = "TAKE " + UCASE$(IAdj(A, B)) + " " + UCASE$(INoun(A, C)) THEN GOTO TakeItem
  248.                 IF MCMD(SNum) = "TAKE " + UCASE$(INoun(A, C)) THEN GOTO TakeItem
  249.                 IF MCMD(SNum) = "GET " + UCASE$(IAdj(A, B)) + " " + UCASE$(INoun(A, C)) THEN GOTO TakeItem
  250.                 IF MCMD(SNum) = "GET " + UCASE$(INoun(A, C)) THEN GOTO TakeItem
  251.                 IF MCMD(SNum) = "PICK UP " + UCASE$(IAdj(A, B)) + " " + UCASE$(INoun(A, C)) THEN GOTO TakeItem
  252.                 IF MCMD(SNum) = "PICK UP " + UCASE$(INoun(A, C)) THEN GOTO TakeItem
  253.                 IF MCMD(SNum) = "DROP " + UCASE$(IAdj(A, B)) + " " + UCASE$(INoun(A, C)) THEN GOTO DropItem
  254.                 IF MCMD(SNum) = "DROP " + UCASE$(INoun(A, C)) THEN GOTO DropItem
  255.                 IF MCMD(SNum) = "PUT DOWN " + UCASE$(IAdj(A, B)) + " " + UCASE$(INoun(A, C)) THEN GOTO DropItem
  256.                 IF MCMD(SNum) = "PUT DOWN " + UCASE$(INoun(A, C)) THEN GOTO DropItem
  257.                 IF MCMD(SNum) = "EXAMINE " + UCASE$(IAdj(A, B)) + " " + UCASE$(INoun(A, C)) THEN GOTO ExamItem
  258.                 IF MCMD(SNum) = "EXAMINE " + UCASE$(INoun(A, C)) THEN GOTO ExamItem
  259.                 IF MCMD(SNum) = "X " + UCASE$(IAdj(A, B)) + " " + UCASE$(INoun(A, C)) THEN GOTO ExamItem
  260.                 IF MCMD(SNum) = "X " + UCASE$(INoun(A, C)) THEN GOTO ExamItem
  261.                 IF MCMD(SNum) = "LOOK AT " + UCASE$(IAdj(A, B)) + " " + UCASE$(INoun(A, B)) THEN GOTO ExamItem
  262.                 IF MCMD(SNum) = "LOOK AT " + UCASE$(INoun(A, C)) THEN GOTO ExamItem
  263.                 IF MCMD(SNum) = "TURN ON " + UCASE$(IAdj(A, B)) + " " + UCASE$(INoun(A, B)) THEN GOTO TurnOn
  264.                 IF MCMD(SNum) = "TURN ON " + UCASE$(INoun(A, C)) THEN GOTO TurnOn
  265.                 IF MCMD(SNum) = "LIGHT " + UCASE$(IAdj(A, B)) + " " + UCASE$(INoun(A, B)) THEN GOTO TurnOn
  266.                 IF MCMD(SNum) = "LIGHT " + UCASE$(INoun(A, C)) THEN GOTO TurnOn
  267.                 IF MCMD(SNum) = "TURN OFF " + UCASE$(IAdj(A, B)) + " " + UCASE$(INoun(A, B)) THEN GOTO TurnOff
  268.                 IF MCMD(SNum) = "TURN OFF " + UCASE$(INoun(A, C)) THEN GOTO TurnOff
  269.                 IF MCMD(SNum) = "EXTINGUISH " + UCASE$(IAdj(A, B)) + " " + UCASE$(INoun(A, B)) THEN GOTO TurnOff
  270.                 IF MCMD(SNum) = "EXTINGUISH " + UCASE$(INoun(A, C)) THEN GOTO TurnOff
  271.                 IF MCMD(SNum) = "PUT OUT " + UCASE$(IAdj(A, B)) + " " + UCASE$(INoun(A, B)) THEN GOTO TurnOff
  272.                 IF MCMD(SNum) = "PUT OUT " + UCASE$(INoun(A, C)) THEN GOTO TurnOff
  273.             NEXT C
  274.         NEXT B
  275.     NEXT A
  276.    
  277.     ' Show if command is not in database
  278.     PRINT "I don't understand " + CHR$(34) + LCASE$(MCMD(SNum)) + CHR$(34) + "."
  279.     GOTO EndOfProcess
  280.     ' Take items
  281. TakeItem:
  282.     FOR B = 1 TO NumItems
  283.         IF ILit(B) = True AND ILoc(B) = CurRoom THEN GOTO TakeI
  284.         IF ILit(B) = True AND ILoc(B) = Player THEN GOTO TakeI
  285.     NEXT B
  286.     IF RDark(CurRoom) = True THEN
  287.         PRINT Message(2): GOTO EndOfProcess
  288.     END IF
  289. TakeI:
  290.     IF ILoc(A) = CurRoom AND IFixed(A) = 0 THEN
  291.         ILoc(A) = Player: Moves = Moves + 1: PRINT "Taken."
  292.         IF ITakeScore(A) <> 0 AND ITakenOnce(A) = False THEN
  293.             Score = Score + ITakeScore(A)
  294.             PRINT "Your score has just gone up by"; ITakeScore(A); "point";
  295.             IF ITakeScore(A) <> 1 THEN
  296.                 PRINT "s."
  297.             ELSE
  298.                 PRINT "."
  299.             END IF
  300.         END IF
  301.     ELSEIF ILoc(A) = CurRoom AND IFixed(A) = True THEN
  302.         PRINT "That can't be taken."
  303.     ELSEIF ILoc(A) = Player THEN
  304.         PRINT "You already have that."
  305.     ELSE
  306.         PRINT "You don't see that here."
  307.     END IF
  308.     GOTO EndOfProcess
  309.     ' Drop items
  310. DropItem:
  311.     IF ILoc(A) = Player THEN
  312.         ILoc(A) = CurRoom: Moves = Moves + 1: PRINT "Dropped."
  313.     ELSE
  314.         PRINT "You don't have that."
  315.     END IF
  316.     GOTO EndOfProcess
  317.     ' Turn on items
  318. TurnOn:
  319.     IF ILoc(A) = Player OR ILoc(A) = CurRoom THEN
  320.         IF ILightSwitch(A) = True THEN
  321.             IF ILit(A) = True THEN
  322.                 PRINT "It's already on."
  323.             ELSE
  324.                 ILit(A) = True: PRINT "The " + INoun(A, B) + " is now on."
  325.             END IF
  326.         ELSE
  327.             PRINT "That can't be turned on."
  328.         END IF
  329.     ELSE
  330.         PRINT Message(3)
  331.     END IF
  332.     GOTO EndOfProcess
  333.     ' Turn off items
  334. TurnOff:
  335.     IF ILoc(A) = Player OR ILoc(A) = CurRoom THEN
  336.         IF ILightSwitch(A) = True THEN
  337.             IF ILit(A) = True THEN
  338.                 ILit(A) = False: PRINT "The " + INoun(A, B) + " is now off."
  339.             ELSE
  340.                 PRINT "It's already off."
  341.             END IF
  342.         ELSE
  343.             PRINT "That can't be turned off."
  344.         END IF
  345.     ELSE
  346.         PRINT Message(3)
  347.     END IF
  348.     GOTO EndOfProcess
  349.  
  350.     ' Save game
  351. SaveGame:
  352.     ErrorNum = 1
  353.     OPEN A$ FOR OUTPUT ACCESS WRITE LOCK READ AS #1
  354.     WRITE #1, CurRoom, Score, Moves
  355.     FOR A = 1 TO NumRooms
  356.         WRITE #1, RSeen(A)
  357.     NEXT A
  358.     FOR A = 1 TO NumItems
  359.         WRITE #1, ILit(A)
  360.         WRITE #1, ILoc(A)
  361.         WRITE #1, ITakeScore(A)
  362.         WRITE #1, ITakenOnce(A)
  363.     NEXT A
  364.     CLOSE #1
  365.     GOTO EndOfProcess
  366.     ' Restore game
  367. LoadGame:
  368.     ErrorNum = 1
  369.     OPEN A$ FOR INPUT ACCESS READ LOCK WRITE AS #1
  370.     INPUT #1, CurRoom, Score, Moves
  371.     FOR A = 1 TO NumRooms
  372.         INPUT #1, RSeen(A)
  373.     NEXT A
  374.     FOR A = 1 TO NumItems
  375.         INPUT #1, ILit(A)
  376.         INPUT #1, ILoc(A)
  377.         INPUT #1, ITakeScore(A)
  378.         INPUT #1, ITakenOnce(A)
  379.     NEXT A
  380.     CLOSE #1
  381.     GOTO EndOfProcess
  382.     ' Display Score
  383. ShowScore:
  384.     PRINT "Your score is"; Score; "point";
  385.     IF Score <> 1 THEN PRINT "s";
  386.     PRINT " out of"; MaxScore; "in"; Moves; "move";
  387.     IF Moves <> 1 THEN PRINT "s";
  388.     PRINT "."
  389.     RETURN
  390. ExamItem:
  391.     FOR B = 1 TO NumItems
  392.         IF ILit(B) = True AND ILoc(B) = CurRoom THEN GOTO ExamI
  393.         IF ILit(B) = True AND ILoc(B) = Player THEN GOTO ExamI
  394.     NEXT B
  395.     IF RDark(CurRoom) = True THEN
  396.         PRINT Message(2): GOTO EndOfProcess
  397.     END IF
  398. ExamI:
  399.     IF ILoc(A) = CurRoom OR ILoc(A) = Player THEN
  400.         Moves = Moves + 1: CALL ItemDesc(A)
  401.     ELSE
  402.         PRINT Message(3)
  403.     END IF
  404.     GOTO EndOfProcess
  405.     ' End of Processing
  406. EndOfProcess:
  407. END SUB
  408.  
  409. SUB ItemDesc (INum)
  410.     SELECT CASE INum
  411.         CASE ELSE
  412.             PRINT "You see nothing special about that."
  413.     END SELECT
  414. END SUB
  415.  
  416. SUB ProcessCommand
  417.     ' Process multiple sentences
  418.     CMD = UCASE$(CMD): L = LEN(CMD)
  419.     A$ = "": A = 0: B = 0: NumS = 0
  420.     FOR A = 1 TO L
  421.         A$ = MID$(CMD, A, 1)
  422.         IF A$ = "." THEN
  423.             A$ = "": NumS = NumS + 1: B = 1
  424.         ELSEIF A$ = " " AND B = 1 THEN
  425.             A$ = ""
  426.         ELSE
  427.             MCMD(NumS) = MCMD(NumS) + A$: B = 0
  428.         END IF
  429.     NEXT A
  430.     ' Run the multiple sentences through the database (one at a time)
  431.     FOR A = 0 TO NumS
  432.         IF MCMD(A) <> "" THEN CALL Database(A): MCMD(A) = "": PRINT
  433.         CALL StatusBar
  434.     NEXT A
  435. END SUB
  436.  
  437. SUB SetupGame
  438.     CurRoom = 1 ' Set the player's starting location
  439.     Score = 0 ' Set the player's initial score
  440.     Moves = 0 ' Set the player's initial moves
  441.     Restart = 0 ' Has the player typed RESTART?
  442.     SaveGame = "ADVENT.SAV" ' Default savegame name
  443.     ' Setup rooms
  444.  
  445.     ' Setup items
  446.  
  447.     ' Setup in-game messages
  448.     Message(1) = "There's a wall there."
  449.     Message(2) = "You can't see anything."
  450.     Message(3) = "You can't see that here."
  451.     Message(4) = "You can't see anything that can be taken."
  452.     Message(5) = "You don't have anything to drop."
  453.     Message(6) = "There's nothing to get into."
  454.     Message(7) = "You're not in anything."
  455. END SUB
  456.  
  457. SUB ShowIntro
  458.     FOR A = 1 TO 15: PRINT : NEXT A
  459. END SUB
  460.  
  461. SUB ShowRoom
  462.     ' Show room short and long descriptions
  463.     FOR A = 1 TO NumItems
  464.         IF ILit(A) = True AND ILoc(A) = CurRoom THEN GOTO ShowRm
  465.         IF ILit(A) = True AND ILoc(A) = Player THEN GOTO ShowRm
  466.     NEXT A
  467.     IF RDark(CurRoom) = True THEN GOTO RoomIsDark
  468. ShowRm:
  469.     ' Show short description
  470.     'SELECT CASE CurRoom
  471.     'END SELECT
  472.  
  473.     ' Check to see if LOOK was entered (always shows full room description)
  474.     IF MCMD(SNum) = "LOOK" OR MCMD(SNum) = "L" THEN GOTO LongDesc
  475.     ' Check for verbosity
  476.     IF Verbose = False AND RSeen(CurRoom) = True THEN GOTO ShowItems
  477.     RSeen(CurRoom) = True
  478.  
  479.     ' Show long description
  480. LongDesc:
  481.     'SELECT CASE CurRoom
  482.     'END SELECT
  483.  
  484.     ' Show items found in CurRoom
  485. ShowItems:
  486.     FOR A = 1 TO NumItems
  487.         A$ = UCASE$(LEFT$(IName(A), 1))
  488.         IF ILoc(A) = CurRoom AND IDecoration(A) = False THEN
  489.             IF A$ = "A" OR A$ = "E" OR A$ = "I" OR A$ = "O" OR A$ = "U" THEN
  490.                 PRINT "There is an " + IName(A) + " here.";
  491.             ELSE
  492.                 PRINT "There is a " + IName(A) + " here.";
  493.             END IF
  494.             IF ILit(A) = True THEN
  495.                 PRINT " It is glowing."
  496.             ELSE
  497.                 PRINT
  498.             END IF
  499.         END IF
  500.     NEXT A
  501.     GOTO RoomShown
  502.     ' Show darkness
  503. RoomIsDark:
  504.     RoomName = "In the Dark": PRINT "You are in the dark."
  505. RoomShown:
  506. END SUB
  507.  
  508. SUB StatusBar
  509.     Row = CSRLIN: Col = POS(0): L = LEN(RoomName)
  510.     LOCATE 1, 1: COLOR 0, 7
  511.     PRINT RoomName + SPACE$(53 - L) + "Score:" + SPACE$(7) + "Moves:" + SPACE$(7)
  512.     LOCATE 1, 60: PRINT Score: LOCATE 1, 73: PRINT Moves
  513.     COLOR 7, 0: LOCATE Row, Col
  514. END SUB
RAW Paste Data