Text Adventure!

[Nixon]

This runs easy in a 33mhz computer. Enjoy

Code:

DECLARE SUB locations ()
DECLARE SUB items ()
DECLARE SUB beings ()
DECLARE SUB specialcode ()
DECLARE SUB editor ()

Screen 13

DIM SHARED location$(500, 8), item$(250, 4), being$(250, 4), scode$(500, 2)
DIM SHARED dirs$(6), tbeing(250), know$(1001)
        '**** LOADS TALKER ****
OPEN "know.txt" FOR INPUT AS #1
FOR i = 1 TO 1000: INPUT #1, know$(i): NEXT
CLOSE #1

        '**** LOADS LOCATIONS ****
OPEN "locate.txt" FOR INPUT AS #1
INPUT #1, amount
PRINT amount
SLEEP 1
FOR i = 1 TO amount: FOR t = 1 TO 8: INPUT #1, location$(i, t): NEXT: NEXT
CLOSE #1
        '**** LOADS ITMES ****
OPEN "items.txt" FOR INPUT AS #1
INPUT #1, amount
FOR i = 1 TO amount: FOR t = 1 TO 4: INPUT #1, item$(i, t): NEXT: NEXT
CLOSE #1
        '**** LOADS BEINGS ****
OPEN "beings.txt" FOR INPUT AS #1
INPUT #1, amount
FOR i = 1 TO amount: FOR t = 1 TO 4: INPUT #1, being$(i, t): NEXT: NEXT
CLOSE #1
        '**** LOADS SCODE ****
OPEN "scode.txt" FOR INPUT AS #1
INPUT #1, amount
FOR i = 1 TO amount: FOR t = 1 TO 2: INPUT #1, scode$(i, t): NEXT: NEXT
CLOSE #1
        '**** DIR DATA ****
dirs$(1) = "n": dirs$(2) = "s": dirs$(3) = "e": dirs$(4) = "w": dirs$(5) = "u": dirs$(6) = "d"


        '**** MAIN LOOP ****
lc = 1
sc = 2
ec = 3
ic = 4
tc = 5

1
CLS
LOCATE 1, 1
COLOR 15: PRINT "Nixon's Text Adventure"
DO
check:
P$ = INKEY$
IF P$ = "n" AND a = 0 THEN a = a + 1: GOTO check
IF P$ = "i" AND a = 1 THEN a = a + 1: GOTO check
IF P$ = "x" AND a = 2 THEN a = a + 1: GOTO check
IF P$ = "o" AND a = 3 THEN a = a + 1: GOTO check
IF P$ = "n" AND a = 4 THEN a = a + 1: CALL editor: GOTO 1
LOOP UNTIL P$ <> ""
l = 1
CLS
start:
        '**** RUNS SCODE ****
FOR i = 1 TO 500
IF scode$(i, 1) = "" THEN EXIT FOR
IF VAL(scode$(i, 1)) = l THEN
        IF MID$(scode$(i, 2), 1, 1) = "?" THEN
                text$ = MID$(scode$(i, 2), 2, LEN(scode$(i, 2))) + " "
                leng = 40: a = 1: length = LEN(text$): FOR i = 1 TO 23: FOR x = leng TO 1 STEP -1: IF MID$(text$, a + x, 1) = " " THEN gapos = x: GOTO con2
                NEXT
con2:
                IF MID$(text$, a, gapos) = "" THEN EXIT FOR: EXIT FOR
                PRINT MID$(text$, a, gapos): a = a + gapos + 1: NEXT
        END IF
        IF MID$(scode$(i, 2), 1, 1) = "c" THEN COLOR VAL(MID$(scode$(i, 2), 2, LEN(scode$(i, 2))))
        IF MID$(scode$(i, 2), 1, 1) = "k" THEN scode$(VAL(MID$(scode$(i, 2), 2, LEN(scode$(i, 2)))), 1) = ""
        'IF MID$(scode$(i, 2), 1, 1) = "p" THEN PLAY MID$(scode$(i, 2), 2, LEN(scode$(i, 2)))
        IF MID$(scode$(i, 2), 1, 6) = "locate" THEN l = VAL(MID$(scode$(i, 2), 7, 3))
        IF MID$(scode$(i, 2), 1, 1) = "-" THEN
                IF MID$(scode$(i, 2), 2, 2) = "lc" THEN lc = VAL(MID$(scode$(i, 2), 4, LEN(scode$(i, 2))))
                IF MID$(scode$(i, 2), 2, 2) = "sc" THEN sc = VAL(MID$(scode$(i, 2), 4, LEN(scode$(i, 2))))
                IF MID$(scode$(i, 2), 2, 2) = "ec" THEN ec = VAL(MID$(scode$(i, 2), 4, LEN(scode$(i, 2))))
                IF MID$(scode$(i, 2), 2, 2) = "ic" THEN ic = VAL(MID$(scode$(i, 2), 4, LEN(scode$(i, 2))))
                IF MID$(scode$(i, 2), 2, 2) = "tc" THEN tc = VAL(MID$(scode$(i, 2), 4, LEN(scode$(i, 2))))
              
                IF MID$(scode$(i, 2), 2, 2) = "ls" THEN location$(VAL(MID$(scode$(i, 2), 4, 3)), 4) = MID$(scode$(i, 2), 7, 3)
                IF MID$(scode$(i, 2), 2, 2) = "ln" THEN location$(VAL(MID$(scode$(i, 2), 4, 3)), 3) = MID$(scode$(i, 2), 7, 3)
                IF MID$(scode$(i, 2), 2, 2) = "le" THEN location$(VAL(MID$(scode$(i, 2), 4, 3)), 5) = MID$(scode$(i, 2), 7, 3)
                IF MID$(scode$(i, 2), 2, 2) = "lw" THEN location$(VAL(MID$(scode$(i, 2), 4, 3)), 6) = MID$(scode$(i, 2), 7, 3)
                IF MID$(scode$(i, 2), 2, 2) = "lu" THEN location$(VAL(MID$(scode$(i, 2), 4, 3)), 7) = MID$(scode$(i, 2), 7, 3)
                IF MID$(scode$(i, 2), 2, 2) = "ld" THEN location$(VAL(MID$(scode$(i, 2), 4, 3)), 8) = MID$(scode$(i, 2), 7, 3)


       END IF

END IF
NEXT

        '**** TALKING ****
'FOR i = 1 TO 250
'IF being$(i, 4) <> "" AND tbeing(i) = 0 AND VAL(being$(i, 1)) = l THEN tbeing(i) = 1: COLOR tc: PRINT being$(i, 4)
'NEXT
        '**** DISPLAY ****
COLOR lc + 8: PRINT location$(l, 1); ":": COLOR lc
        '**** SHORTENS TEXT LINES ****
leng = 40  'Tells how many characters to have on 1 line
a = 1
text$ = location$(l, 2) + " "
length = LEN(text$)
FOR i = 1 TO 23: FOR x = leng TO 1 STEP -1
IF MID$(text$, a + x, 1) = " " THEN gapos = x: GOTO contine
NEXT
contine:
IF MID$(text$, a, gapos) = "" THEN EXIT FOR: EXIT FOR
PRINT MID$(text$, a, gapos): a = a + gapos + 1: NEXT

        '**** WHAT CAN BE SEEN ****
COLOR sc + 8: PRINT "You See:"; : COLOR sc
separator = 0
FOR i = 1 TO 500
    IF VAL(item$(i, 1)) = l THEN
        IF separator <> 0 THEN
            PRINT ", "; item$(i, 2);
        ELSE
            PRINT " "; item$(i, 2);
        END IF
        separator = separator + 1
    END IF
    IF VAL(being$(i, 1)) = l THEN
        IF separator <> 0 THEN
            PRINT ", "; being$(i, 2);
        ELSE
            PRINT " "; being$(i, 2);
        END IF
        separator = separator + 1
    END IF
    IF item$(i, 1) = "" AND being$(i, 1) = "" THEN EXIT FOR
NEXT
        '**** EXITS ****
PRINT
COLOR ec + 8: PRINT "Exits:"; : COLOR ec
FOR i = 1 TO 6
IF location$(l, i + 2) <> "" AND VAL(location$(l, i + 2)) <> 0 THEN PRINT " "; UCASE$(dirs$(i));
NEXT
      
pinput:
        '**** GETS INPUT ****
PRINT : COLOR ic + 8: PRINT "->"; : COLOR ic: INPUT "", a$
        '**** USE INPUT ****
FOR i = 1 TO 6
IF location$(l, i + 2) <> "" AND dirs$(i) = LCASE$(a$) THEN l = VAL(location$(l, i + 2)): GOTO start
IF location$(l, i + 2) = "" AND dirs$(i) = LCASE$(a$) THEN PRINT "Can't go that way": PRINT : GOTO start
NEXT
FOR i = 1 TO 250
IF LCASE$(a$) = "take " + LCASE$(item$(i, 2)) AND VAL(item$(i, 1)) = l THEN item$(i, 1) = "501": PRINT item$(i, 2); " is taken": PRINT : GOTO start
IF LCASE$(a$) = "take " + LCASE$(item$(i, 2)) THEN PRINT "Can't take "; item$(i, 2): PRINT : GOTO start
IF LCASE$(a$) = "drop " + LCASE$(item$(i, 2)) AND VAL(item$(i, 1)) = 501 THEN item$(i, 1) = STR$(l): PRINT item$(i, 2); " is droped": PRINT : GOTO start
IF LCASE$(a$) = "drop " + LCASE$(item$(i, 2)) THEN PRINT "Can't drop "; item$(i, 2): PRINT : GOTO start
NEXT
IF LCASE$(MID$(a$, 1, 5)) = "take " THEN PRINT "Can't take "; MID$(a$, 6, LEN(a$)): PRINT : GOTO start
IF LCASE$(MID$(a$, 1, 5)) = "drop " THEN PRINT "Can't drop "; MID$(a$, 6, LEN(a$)): PRINT : GOTO start
IF LCASE$(MID$(a$, 1, 5)) = "talk " THEN
    FOR i = 1 TO 100
        IF LCASE$(LTRIM$(RTRIM$(MID$(a$, 6, LEN(a$))))) = LCASE$(being$(i, 2)) THEN PRINT being$(i, 2) + " Says:": PRINT being$(i, 4): PRINT : GOTO start
    NEXT
END IF
IF LCASE$(MID$(a$, 1, 4)) = "exa " THEN
    FOR i = 1 TO 100
        IF LCASE$(LTRIM$(RTRIM$(MID$(a$, 5, LEN(a$))))) = LCASE$(being$(i, 2)) THEN PRINT being$(i, 2) + ":": PRINT being$(i, 3): PRINT : GOTO start
        IF LCASE$(LTRIM$(RTRIM$(MID$(a$, 5, LEN(a$))))) = LCASE$(item$(i, 2)) THEN PRINT item$(i, 2) + ":": PRINT item$(i, 3): PRINT : GOTO start
        
    NEXT
END IF

IF LCASE$(a$) = "save" THEN GOTO save
IF LCASE$(a$) = "load" THEN GOTO load
IF LCASE$(a$) = "quit" OR LCASE$(a$) = "q" OR LCASE$(a$) = "exit" THEN END

IF LCASE$(a$) = "i" OR LCASE$(a$) = "inventory" THEN
        PRINT "**** Inventory ****"
        FOR i = 1 TO 250: IF VAL(item$(i, 1)) = 501 THEN PRINT "-"; item$(i, 2)
        NEXT
        PRINT
        GOTO start
END IF

chat:
FOR i = 1 TO 1000 STEP 2
IF LCASE$(a$) = LCASE$(know$(i)) THEN
COLOR 1: PRINT "Jim-"; : COLOR 9: PRINT know$(i + 1): GOTO pinput
END IF: NEXT: FOR i = 1 TO 1000
IF know$(i) = "*" THEN
        B$ = a$: COLOR 1: PRINT "Jim-"; : COLOR 9: PRINT a$: COLOR 2
        PRINT "You teach-"; : COLOR 10: INPUT "", a$
        IF a$ = "*" THEN GOTO pinput
        know$(i) = B$: know$(i + 1) = a$
        OPEN "know.txt" FOR OUTPUT AS #1: FOR i = 1 TO 1000: PRINT #1, know$(i)
        NEXT: CLOSE #1: GOTO pinput
END IF
NEXT
GOTO pinput

save:
COLOR 12
INPUT "Are you sure you want to save y/N? It will clear older saves! ->", choice$
IF LCASE$(choice$) = "n" OR LCASE$(choice$) = "no" THEN COLOR 15: PRINT "Save Canceled": GOTO pinput
        '**** SAVE VARIBLES ****
OPEN "saved.txt" FOR OUTPUT AS #1
PRINT #1, l: CLOSE #1
        '**** SAVE BEINGS ****
OPEN "beings.txt" FOR INPUT AS #1
INPUT #1, amount: CLOSE #1
OPEN "sbeings.txt" FOR OUTPUT AS #1
PRINT #1, amount
FOR i = 1 TO amount: FOR t = 1 TO 4
PRINT #1, being$(i, t)
NEXT t: NEXT i
CLOSE #1
        '**** SAVE ITEMS ****
OPEN "items.txt" FOR INPUT AS #1
INPUT #1, amount: CLOSE #1
OPEN "sitems.txt" FOR OUTPUT AS #1
PRINT #1, amount
FOR i = 1 TO amount: FOR t = 1 TO 4
PRINT #1, item$(i, t)
NEXT t: NEXT i
CLOSE #1
        '**** SAVE LOCATIONS ****
OPEN "locate.txt" FOR INPUT AS #1
INPUT #1, amount: CLOSE #1
OPEN "slocate.txt" FOR OUTPUT AS #1
PRINT #1, amount
FOR i = 1 TO amount: FOR t = 1 TO 8: PRINT #1, location$(i, t): NEXT: NEXT
CLOSE #1
        '**** SAVE SPECIAL CODE ****
OPEN "scode.txt" FOR INPUT AS #1
INPUT #1, amount: CLOSE #1
OPEN "sscode.txt" FOR OUTPUT AS #1
PRINT #1, amount
FOR i = 1 TO amount: FOR t = 1 TO 2: PRINT #1, scode$(i, t): NEXT: NEXT
CLOSE #1
COLOR 15: PRINT "Game Saved"
GOTO pinput

load:
        '**** LOADS THE CURRENT LOCATION ****
OPEN "saved.txt" FOR INPUT AS #1
INPUT #1, l: CLOSE #1
        '**** LOADS LOCATIONS ****
OPEN "slocate.txt" FOR INPUT AS #1
INPUT #1, amount
FOR i = 1 TO amount: FOR t = 1 TO 8: INPUT #1, location$(i, t): NEXT: NEXT
CLOSE #1
        '**** LOADS ITMES ****
OPEN "sitems.txt" FOR INPUT AS #1
INPUT #1, amount
FOR i = 1 TO amount: FOR t = 1 TO 4: INPUT #1, item$(i, t): NEXT: NEXT
CLOSE #1
        '**** LOADS BEINGS ****
OPEN "sbeings.txt" FOR INPUT AS #1
INPUT #1, amount
FOR i = 1 TO amount: FOR t = 1 TO 4: INPUT #1, being$(i, t): NEXT: NEXT
CLOSE #1
        '**** LOADS SCODE ****
OPEN "sscode.txt" FOR INPUT AS #1
INPUT #1, amount
FOR i = 1 TO amount: FOR t = 1 TO 2: INPUT #1, scode$(i, t): NEXT: NEXT
CLOSE #1
COLOR 15: PRINT "Game Loaded"
GOTO start

SUB beings
FOR B = 1 TO 100
    IF being$(B, 1) = "" THEN amount = B - 1: EXIT FOR
NEXT
B = 1
btop:
CLS
LOCATE 1, 1: COLOR 12: PRINT "**** "; : COLOR 4: PRINT "Beings"; : COLOR 12: PRINT " ****"
COLOR 10: PRINT "Being-"; : COLOR 2: PRINT B
COLOR 10: PRINT "Board-"; : COLOR 2: PRINT being$(B, 1)
COLOR 10: PRINT "Name-"; : COLOR 2: PRINT being$(B, 2)
COLOR 10: PRINT "Description-"; : COLOR 2: PRINT being$(B, 3)
COLOR 10: PRINT "Talk-"; : COLOR 2: PRINT being$(B, 4)

COLOR 9: PRINT "Choice ->"; : COLOR 1: INPUT "", c$
IF B > amount THEN amount = B
IF LCASE$(c$) = "q" OR LCASE$(c$) = "quit" THEN GOTO besave
IF LCASE$(c$) = "b" THEN COLOR 9: PRINT "Board ->"; : COLOR 1: INPUT "", being$(B, 1): GOTO btop
IF LCASE$(c$) = "n" THEN COLOR 9: PRINT "Name ->"; : COLOR 1: INPUT "", being$(B, 2): GOTO btop
IF LCASE$(c$) = "d" THEN COLOR 9: PRINT "Description ->"; : COLOR 1: INPUT "", being$(B, 3): GOTO btop
IF LCASE$(c$) = "t" THEN COLOR 9: PRINT "Talk ->"; : COLOR 1: INPUT "", being$(B, 4): GOTO btop
B = VAL(c$)
GOTO btop

        '**** SAVE ****
besave:
OPEN "beings.txt" FOR OUTPUT AS #1
PRINT #1, amount
FOR i = 1 TO amount
    FOR t = 1 TO 4
        PRINT #1, being$(i, t)
    NEXT t
NEXT i
CLOSE #1

END SUB

SUB editor
1000
CLS
COLOR 15: PRINT "Welcome to the editor"
COLOR 10: PRINT "1)"; : COLOR 2: PRINT " Locations"
COLOR 10: PRINT "2)"; : COLOR 2: PRINT " Items"
COLOR 10: PRINT "3)"; : COLOR 2: PRINT " Beings"
COLOR 10: PRINT "4)"; : COLOR 2: PRINT " Special Code"
COLOR 10: PRINT "5)"; : COLOR 2: PRINT " Exit"
COLOR 9: PRINT "Choice ->"; : COLOR 1: INPUT "", c
IF c = 1 THEN CALL locations
IF c = 2 THEN CALL items
IF c = 3 THEN CALL beings
IF c = 4 THEN CALL specialcode
IF c = 5 THEN GOTO fin
GOTO 1000
fin:
END SUB

SUB items
FOR i = 1 TO 100
IF item$(i, 1) = "" THEN amount = i - 1: EXIT FOR
NEXT
i = 1
itop:
CLS
LOCATE 1, 1: COLOR 12: PRINT "**** "; : COLOR 4: PRINT "Items"; : COLOR 12: PRINT " ****"
COLOR 10: PRINT "Item-"; : COLOR 2: PRINT i
COLOR 10: PRINT "Board-"; : COLOR 2: PRINT item$(i, 1)
COLOR 10: PRINT "Name-"; : COLOR 2: PRINT item$(i, 2)
COLOR 10: PRINT "Description-"; : COLOR 2: PRINT item$(i, 3)
COLOR 10: PRINT "Takable-"; : COLOR 2: PRINT item$(i, 4)

COLOR 9: PRINT "Choice ->"; : COLOR 1: INPUT "", c$
IF i > amount THEN amount = i
IF LCASE$(c$) = "q" OR LCASE$(c$) = "quit" THEN GOTO isave
IF LCASE$(c$) = "t" THEN COLOR 9: PRINT "Takable 0 or 1 ->"; : COLOR 1: INPUT "", item$(i, 4): GOTO itop
IF LCASE$(c$) = "d" THEN COLOR 9: PRINT "Description ->"; : COLOR 1: INPUT "", item$(i, 3): GOTO itop
IF LCASE$(c$) = "b" THEN COLOR 9: PRINT "Board ->"; : COLOR 1: INPUT "", item$(i, 1): GOTO itop
IF LCASE$(c$) = "n" THEN COLOR 9: PRINT "Name ->"; : COLOR 1: INPUT "", item$(i, 2): GOTO itop
i = VAL(c$)
GOTO itop

        '**** SAVE ****
isave:
OPEN "items.txt" FOR OUTPUT AS #1
PRINT #1, amount
FOR i = 1 TO amount: FOR t = 1 TO 4
PRINT #1, item$(i, t)
NEXT t: NEXT i
CLOSE #1

END SUB

SUB locations
FOR i = 1 TO 500
IF location$(i, 1) = "" THEN amount = i - 1: EXIT FOR
NEXT
l = 1
ltop:
CLS
LOCATE 1, 1: COLOR 12: PRINT "**** "; : COLOR 4: PRINT "Locations"; : COLOR 12: PRINT " ****"
COLOR 10: PRINT "Board-"; : COLOR 2: PRINT l
COLOR 10: PRINT "Title-"; : COLOR 2: PRINT location$(l, 1)
COLOR 10: PRINT "View-"; : COLOR 2: PRINT location$(l, 2)
COLOR 10: PRINT "North Board-"; : COLOR 2: PRINT location$(l, 3)
COLOR 10: PRINT "South Board-"; : COLOR 2: PRINT location$(l, 4)
COLOR 10: PRINT "East Board-"; : COLOR 2: PRINT location$(l, 5)
COLOR 10: PRINT "West Board-"; : COLOR 2: PRINT location$(l, 6)
COLOR 10: PRINT "Up Board-"; : COLOR 2: PRINT location$(l, 7)
COLOR 10: PRINT "Down Board-"; : COLOR 2: PRINT location$(l, 8)

COLOR 9: PRINT "Choice ->"; : COLOR 1: INPUT "", c$
IF l > amount THEN amount = l
IF LCASE$(c$) = "q" OR LCASE$(c$) = "quit" THEN GOTO lsave
IF LCASE$(c$) = "t" THEN COLOR 9: PRINT "Title ->"; : COLOR 1: INPUT "", location$(l, 1): GOTO ltop
IF LCASE$(c$) = "v" THEN COLOR 9: PRINT "Description ->"; : COLOR 1: INPUT "", location$(l, 2): GOTO ltop
FOR i = 1 TO 6
IF LCASE$(c$) = dirs$(i) THEN COLOR 9: PRINT "Board num ->"; : COLOR 1: INPUT "", location$(l, i + 2): GOTO ltop
NEXT
l = VAL(c$)
GOTO ltop

        '**** SAVE ****
lsave:
OPEN "locate.txt" FOR OUTPUT AS #1
PRINT #1, amount
FOR i = 1 TO amount: FOR t = 1 TO 8: PRINT #1, location$(i, t): NEXT: NEXT
CLOSE #1

END SUB

SUB specialcode
FOR i = 1 TO 500
IF scode$(i, 1) = "" THEN amount = i - 1: EXIT FOR
NEXT
s = 1
sctop:
CLS
LOCATE 1, 1: COLOR 12: PRINT "**** "; : COLOR 4: PRINT "Special Code"; : COLOR 12: PRINT " ****"
COLOR 10: PRINT "Special Code-"; : COLOR 2: PRINT s
COLOR 10: PRINT "Board-"; : COLOR 2: PRINT scode$(s, 1)
COLOR 10: PRINT "Code-"; : COLOR 2: PRINT scode$(s, 2)

COLOR 9: PRINT "Choice ->"; : COLOR 1: INPUT "", c$
IF s > amount THEN amount = s
IF LCASE$(c$) = "q" OR LCASE$(c$) = "quit" THEN GOTO ssave
IF LCASE$(c$) = "b" THEN COLOR 9: PRINT "Board ->"; : COLOR 1: INPUT "", scode$(s, 1): GOTO sctop
IF LCASE$(c$) = "c" THEN COLOR 9: PRINT "Code ->"; : COLOR 1: INPUT "", scode$(s, 2): GOTO sctop
s = VAL(c$)
GOTO sctop
      


        '**** SAVE ****
ssave:
OPEN "scode.txt" FOR OUTPUT AS #1
PRINT #1, amount
FOR i = 1 TO amount: FOR t = 1 TO 2: PRINT #1, scode$(i, t): NEXT: NEXT
CLOSE #1

END SUB

This code makes me shudder

it works in FB and QB, just get rid of the screen 13 for QB, and I think FB should be screen 14, but oh well.