'     THE WONDERFUL WORLD OF EAMON DELUXE (v2)
'                BY FRANK BLACK
'
'   A COMPUTERIZED FANTASY ROLE-PLAYING SYSTEM
' BASED UPON THE APPLE II VERSION BY DONALD BROWN,
'    JOHN NELSON, TOM ZUCHOWSKI, & FRANK BLACK
'
'              BASE DUNGEON PROGRAM v3.0
'
'          The Heart of Gold
'            by Frank Black
'
' Converted to Eamon Deluxe, March, 1997
'        Update: 16 MAY 1999 (v2 mods)
'   Last Update: 15 NOV 2003
'
DECLARE SUB Main ()
TYPE DESC
  TEXT AS STRING * 255
END TYPE
DIM SHARED DS AS DESC
'
TYPE ROOM
  RNAME AS STRING * 79: D1 AS INTEGER: d2 AS INTEGER: D3 AS INTEGER
  D4 AS INTEGER: D5 AS INTEGER: D6 AS INTEGER: D7 AS INTEGER: D8 AS INTEGER
  D9 AS INTEGER: D10 AS INTEGER: Light AS INTEGER
END TYPE
DIM SHARED rm AS ROOM
'
TYPE ARTIFACT
  ARTNAME AS STRING * 35: AD1 AS INTEGER: AD2 AS INTEGER: AD3 AS INTEGER:
  AD4 AS INTEGER: AD5 AS INTEGER: AD6 AS INTEGER: AD7 AS INTEGER:
  AD8 AS INTEGER
END TYPE
DIM SHARED art AS ARTIFACT
'
TYPE MONSTER
  MNAME AS STRING * 35: MD1 AS INTEGER: MD2 AS INTEGER: MD3 AS INTEGER:
  MD4 AS INTEGER: MD5 AS INTEGER: MD6 AS INTEGER: MD7 AS INTEGER:
  MD8 AS INTEGER: MD9 AS INTEGER: MD10 AS INTEGER: MD11 AS INTEGER
  MD12 AS INTEGER: MD13 AS INTEGER
END TYPE
DIM SHARED mon AS MONSTER
'
TYPE RECORD
  CNAME AS STRING * 40: Status AS INTEGER: A1 AS INTEGER: a2 AS INTEGER
  a3 AS INTEGER: SP1 AS INTEGER: SP2 AS INTEGER: SP3 AS INTEGER
  SP4 AS INTEGER: WA1 AS INTEGER: WA2 AS INTEGER: WA3 AS INTEGER
  WA4 AS INTEGER: WA5 AS INTEGER: ae AS INTEGER: sex AS INTEGER: gold AS LONG
  bank AS LONG: ac AS INTEGER: WN1 AS STRING * 20: WN2 AS STRING * 20
  WN3 AS STRING * 20: WN4 AS STRING * 20: WCOMPLX1 AS INTEGER
  WCOMPLX2 AS INTEGER: WCOMPLX3 AS INTEGER: WCOMPLX4 AS INTEGER
  WTYPE1 AS INTEGER: WTYPE2 AS INTEGER: WTYPE3 AS INTEGER: WTYPE4 AS INTEGER
  WDICE1 AS INTEGER: WDICE2 AS INTEGER: WDICE3 AS INTEGER: WDICE4 AS INTEGER
  WSIDES1 AS INTEGER: WSIDES2 AS INTEGER: WSIDES3 AS INTEGER
  WSIDES4 AS INTEGER
END TYPE
DIM SHARED z AS RECORD
'
DIM SHARED a, a$, a2, aname$, c, c2, cz$, d, d2, df, die
DIM SHARED em, f, ha, k, l, lt, m, mc, mm, na, nc
DIM SHARED nd, ne, ng, nh, nl, nm, nr, nx, peril, q$, r, r2, r3, rl
DIM SHARED ro, round, s, s$, s2$, SL, sy, sy$, turns, tt
DIM SHARED v$, ver, w, w2, wh, x, xm, adj1, adj2, adj3, adj4
'
'  Set up variable table
'
OPEN "NAME.DAT  " FOR INPUT AS #1
INPUT #1, nr, na, ne, nm, aname$, nd, ver
CLOSE : a = 0: m = a: ro = m
'
OPEN "HINTDIR.DAT" FOR INPUT AS #1
INPUT #1, nh: DIM SHARED h$(nh), h%(nh, 2)
FOR r = 1 TO nh
   LINE INPUT #1, h$(r): INPUT #1, h%(r, 1), h%(r, 2)
NEXT: CLOSE
'
nr = 15: na = 25: nm = 12: ne = 139
adj1 = 151: adj2 = 125: adj3 = 107: adj4 = 150
'
OPEN "GUIDEDIR.DAT" FOR INPUT AS #1
INPUT #1, ng: DIM SHARED g$(ng), g%(ng, 2)
FOR r = 1 TO ng
   LINE INPUT #1, g$(r): INPUT #1, g%(r, 1), g%(r, 2)
NEXT: CLOSE
'
READ nc
DIM SHARED a$(na), a%(na, 8), c$(nc), d%(200), m$(nm), m%(nm), marvin(13)
DIM SHARED ms%(nm), r%(nr, 7), r$(nr), s%(20), sm$(3), t(4), gm$(5)
'---------------------------------------------------------------------------
'  Input data from files
'
Init:
OPEN "ROOMS.DAT" FOR RANDOM AS #1 LEN = 101
OPEN "ARTIFACT.DAT" FOR RANDOM AS #2 LEN = 51
OPEN "MONSTERS.DAT" FOR RANDOM AS #3 LEN = 61
FOR c = 1 TO nc: READ c$(c): NEXT
'
'   Rooms
'
FOR r = 1 TO nr
   GET #1, r + adj1, rm
   r$(r) = RTRIM$(rm.RNAME)
   r%(r, 1) = rm.D1: r%(r, 2) = rm.d2: r%(r, 3) = rm.D3: r%(r, 4) = rm.D4
   r%(r, 5) = rm.D5: r%(r, 6) = rm.D6: r%(r, 7) = rm.Light
NEXT
'
'   Artifacts
'
FOR a = 1 TO na
   GET #2, a + adj2, art
   a$(a) = RTRIM$(art.ARTNAME): a%(a, 2) = art.AD2: a%(a, 4) = art.AD4
   a%(a, 6) = art.AD6: a%(a, 7) = art.AD7: a%(a, 8) = art.AD8
NEXT
'
'   Monsters
'
FOR m = 1 TO nm
   GET #3, m + adj3, mon
   m$(m) = RTRIM$(mon.MNAME): m%(m) = mon.MD5
NEXT
CLOSE
'
'    Set starting variable values
'
ro = 1: q$ = CHR$(34): round = 1: turns = 0:
FOR a = 0 TO 13: READ marvin(a): NEXT
OPEN "ROOMS.DSC" FOR RANDOM AS #10 LEN = 255
OPEN "ARTIFACT.DSC" FOR RANDOM AS #11 LEN = 255
OPEN "MONSTERS.DSC" FOR RANDOM AS #12 LEN = 255
OPEN "EFFECT.DSC" FOR RANDOM AS #13 LEN = 255
'
' Ranomize the RND seed
'
CLS : LOCATE 12: COLOR 3
PRINT "Welcome to the Eamon Deluxe fantasy gaming system!"
PRINT : PRINT SPC(13); "Hit any key to begin.": a$ = INKEY$
DO
  a = RND
LOOP UNTIL INKEY$ <> ""
CLS : LOCATE 24
'----------------------------------------------------------------------------
' Start the game
'
CALL Main
'
'----------------------------------------------------------------------------
' Game returns here when finished
'
'  Delete player files and return to Main Hall
'
ExitRtn:
CLOSE : OPEN "GAMEDIR.DAT" FOR OUTPUT AS #1: PRINT #1, -1
FOR m = 1 TO 5: PRINT #1, "(none)": NEXT: CLOSE
FOR m = 1 TO 5
   a$ = "GAME" + LTRIM$(RTRIM$(STR$(m))) + ".SAV"
   OPEN a$ FOR OUTPUT AS #1: PRINT #1, 1: CLOSE : KILL a$
NEXT
OPEN "NEW-MEAT" FOR RANDOM AS #4 LEN = 200: a = 1: GET #4, a, z: CLOSE
KILL "NEW-MEAT"
'
' Return to Test Bench
'
r = z.Status: z.Status = 1: IF die = 1 THEN z.Status = 2
IF r < 1 THEN CHDIR "..": CHDIR "DD": RUN "DDMENU"
'
' Return to Main Hall
'
CHDIR "..": CHDIR "MAIN"
OPEN "PLAYERS.DAT" FOR RANDOM AS #1 LEN = 200
PUT #1, r, z
CLOSE
OPEN "PLAYER" FOR OUTPUT AS #2: WRITE #2, r: CLOSE
IF die <> 1 THEN RUN "MAINHALL"
CHDIR "..": RUN "EAMONDX"
'
DATA 37,north,south,east,west,up,down,flee
DATA close,connect,consult,drink,drop,eat,examine,get,open,put,read,remove
DATA smell,use,wear,attack,give,order,request,smile,talk,inventory,look,panic
DATA say,wait,hints,save,restore,quit
'
'  == Walk of Marvin ==
'
DATA 5,6,5,4,8,7,8,4,2,1,2,4,5,3

SUB Main

t = 0: ro = 1: GOTO Main
'----------------------------------------------------------------------------
' Main Loop
'
Main:
IF die THEN GOTO EndGame
turns = turns + 1: GOSUB Lp1: COLOR 12
IF lt = 0 THEN PRINT "Dark.": GOSUB Lp4: r = 1: GOSUB Effect: GOTO Com1
COLOR 3: ON round GOSUB Round1, Round2, Round3
COLOR 12: IF die THEN GOTO EndGame
IF peril AND a%(17, 5) THEN r = 42: GOSUB Effect: GOTO Com1
IF ro = 12 AND r%(ro, 0) = 0 THEN
  COLOR 3: FOR m = 116 TO 118: r = m: GOSUB Effect: NEXT: COLOR 12
END IF
'
' Give room name and description
'
PRINT r$(ro): GOSUB Lp4
IF r%(ro, 0) = 0 THEN r%(ro, 0) = 1: r = ro: GOSUB DiskRead
IF ro = 13 AND d%(9) = 0 AND m%(2) = ro AND m%(3) = ro THEN
   COLOR 3: r = 119: GOSUB Effect: r = 120: GOSUB Effect: r = 123
   GOSUB Effect: COLOR 12: d%(9) = 1: peril = 1
END IF
'
' List monsters in room
'
Main4A:
m2 = 1
FOR m = 1 TO nm
   IF m%(m) = ro THEN
     IF ms%(m) = 0 THEN
       IF m2 = 0 THEN GOSUB Lp1
       ms%(m) = 1: r = m + 800: GOSUB DiskRead: m2 = 1
       PRINT m$(m); " is here.": GOSUB Lp4: GOTO Main4B
     END IF
     m2 = 0
     PRINT m$(m); " is here.": GOSUB Lp2
   END IF
Main4B:
NEXT
'
' List artifacts in room
'
Main5A:
f = 0
FOR a = 1 TO na
   IF a%(a, 4) <> ro AND (a%(a, 4) <> -99 OR m%(6) <> ro) THEN GOTO Main5B
   f = f + 1
   IF a%(a, 0) = 0 THEN
     IF m2 = 0 THEN GOSUB Lp1
     a%(a, 0) = 1: r = a + 400: GOSUB DiskRead: m2 = 1
     PRINT "You see a "; : IF a = 17 THEN PRINT "pair of ";
     PRINT a$(a); ".": GOSUB Lp2
     IF a%(a, 2) = 4 AND a%(a, 6) = 1 THEN GOSUB Inv4
     GOSUB Lp1: GOTO Main5B
   END IF
   PRINT "You see a "; : IF a = 17 THEN PRINT "pair of ";
   PRINT a$(a);
   IF a%(a, 4) = -99 THEN PRINT "  (connected to Eddie)";
   PRINT ".": GOSUB Lp2: m2 = 0
   IF (a%(a, 2) = 4 AND a%(a, 6) = 1) OR (a = 24 AND a%(5, 4) = 1024) THEN GOSUB Inv4
Main5B:
NEXT
'
' Get command
'
Com0:
GOSUB Lp1
Com1:
LINE INPUT "Your command?->"; a$: a$ = RTRIM$(LTRIM$(LCASE$(a$)))
l = 0: GOSUB Lp1
IF a$ = "" THEN
  a$ = cz$: LOCATE CSRLIN - 2, 16: PRINT a$: PRINT
END IF
'
' Parse command
'
v$ = "": s$ = "": s2$ = ""
IF a$ = "" THEN GOTO Err0
cz$ = a$
FOR a = 2 TO LEN(a$)
   IF MID$(a$, a, 1) = " " THEN
     v$ = LTRIM$(RTRIM$(LEFT$(a$, a - 1)))
     s$ = LTRIM$(RTRIM$(MID$(a$, a + 1))): a = LEN(a$)
   END IF
NEXT
IF v$ = "" THEN v$ = a$: GOTO Com2
'
FOR a = 1 TO LEN(s$)
   zz$ = MID$(s$, a, 3)
   IF zz$ = "to " OR zz$ = "on " OR zz$ = "in " THEN
     s2$ = LTRIM$(RTRIM$(MID$(s$, a + 3)))
     s$ = LTRIM$(RTRIM$(LEFT$(s$, a - 1)))
   END IF
NEXT: IF s2$ <> "" THEN GOTO Com2
FOR a = 1 TO LEN(s$)
   zz$ = MID$(s$, a, 5)
   IF zz$ = "from " OR zz$ = "with " THEN
     s2$ = LTRIM$(RTRIM$(MID$(s$, a + 5)))
     s$ = LTRIM$(RTRIM$(LEFT$(s$, a - 1)))
   END IF
NEXT
'
Com2:
GOSUB ComSearch: IF c = 0 THEN GOTO Err0
IF lt = 0 THEN
  IF round = 1 AND (turns / 10 = INT(turns / 10)) THEN
    COLOR 2: r = 43: GOTO Lp14
  END IF
  IF c <> 20 AND c < 34 THEN GOTO Main
END IF
COLOR 3
Com3:
ON c GOTO Move, Move, Move, Move, Move, Move, Flee
ON c - 7 GOTO ItemClose, Connect, Consult, Drink, Drop, Eat, Examine
ON c - 14 GOTO ItemGet, ItemOpen, ItemPut, ItemRead, Remove, Smell, Use, Wear
ON c - 22 GOTO Attack, Give, Order, Request, Smile, Talk
ON c - 28 GOTO Inventory, Look, Panic, Say, TimeWait, Hints
ON c - 34 GOTO GameSave, GameRestore, Quit
'---------------------------------------------------------------------------
'  **** Special every-round routines
'
'---------------------------------------------------------------------------
'
Round1:
IF turns < 150 THEN GOSUB MoveMarvin
' ** Everybody leaves the room **
IF turns = 50 THEN
  m%(1) = 9: m%(2) = 3: m%(3) = 6: m%(4) = 6: IF ro <> 5 THEN RETURN
  r = 44: GOTO Effect
END IF
' ** Ford/robot take satchel **
IF turns = 51 AND (a%(21, 4) = -1 OR a%(21, 4) = ro) THEN
  a%(21, 4) = -3
  IF m%(2) = ro THEN r = 27: GOTO Effect
  r = 26: GOTO Effect
END IF
' ** Ship implodes!
IF turns = 165 THEN die = 1: r = 70: GOTO Effect
IF turns <> 150 THEN RETURN
' ** Drive malfunction **
FOR m = 58 TO 62: r = m: GOSUB Effect: NEXT: f = 0
FOR m = 1 TO 5
   IF m%(m) > 0 THEN m%(m) = 8: f = f + 1
   IF m%(m) = 0 THEN x = m
NEXT
peril = 1: ro = 8: IF f = 5 THEN GOTO Main
'
r = 68: GOSUB Effect: a$ = q$ + "Oh no!" + q$ + "  he says, " + q$ + m$(x)
a$ = a$ + " was supposed to fix the bloozer rail in the transporter!" + q$
die = 1: GOTO Lp10
'
' Marvin roams the ship
'
MoveMarvin:
mc = mc + 1: IF mc < 4 THEN RETURN
mc = 0: wh = m%(5): mm = mm + 1: IF mm = 14 THEN mm = 0
m%(5) = marvin(mm)
IF m%(5) = ro THEN r = 805: ms%(5) = 1: GOTO DiskRead
IF wh = ro AND m%(5) <> ro AND ms%(5) > 0 THEN
  PRINT "Marvin has just stalked miserably out of the room.": GOTO Lp4
END IF
RETURN
'---------------------------------------------------------------------------
'
Round2:
IF turns < 1 THEN FOR m = 104 TO 107: r = m: GOSUB Effect: NEXT
' ** Ford talks to Hotblack
IF m%(2) = 11 AND m%(3) = 11 AND ro = 11 AND d%(8) = 0 THEN
  d%(8) = 1: FOR m = 108 TO 109: r = m: GOSUB Effect: NEXT: RETURN
END IF
IF m%(2) = 11 AND m%(3) = 11 AND ro = 11 AND d%(8) = 1 THEN
  d%(8) = 2: r = 110: GOSUB Effect
END IF
' ** Everybody leaves **
IF turns = 20 THEN
  IF m%(3) = 11 THEN m%(3) = 12
  IF m%(2) = 11 THEN m%(2) = 12: r = 111: GOTO Effect
  RETURN
END IF
' ** Restaurant explodes! **
IF turns = 30 AND ro <> 13 THEN r = 115: die = 1: GOTO Effect
' ** Ship melts! **
IF turns >= 40 THEN r = 121: die = 1: GOTO Effect
RETURN
'---------------------------------------------------------------------------
'
Round3:
' ** Beast kills you! **
IF turns >= 5 AND ro = 14 AND m%(10) = ro THEN r = 124: die = 1: GOTO Effect
' ** Leave Beast's lair **
IF turns >= 5 AND ro = 14 AND m%(11) = ro THEN
  FOR m = 125 TO 128: r = m: GOSUB Effect: NEXT
  score = score + 20: ro = 15: m%(11) = ro: m%(2) = ro: RETURN
END IF
' ** Poetry kills you! **
IF turns >= 12 THEN r = 129: die = 1: GOTO Effect
' ** Winner!
IF ro = 15 AND m%(10) = ro THEN score = score + 25: die = 0: GOTO EndGame
RETURN
'---------------------------------------------------------------------------
' **** Movement commands ****
'
' **** Directions ****
'
Move:
' ** Ford stops you **
IF m%(2) = ro AND ro < 10 AND peril = 0 AND (a%(21, 4) = -1 OR a%(1, 4) = -1 OR a%(3, 4) = -1 OR a%(9, 4) = -1) THEN r = 29: GOTO Lp14
' ** Enter drive room **
IF round = 1 AND turns > 149 AND ro = 8 AND c = 4 THEN r = 63: GOSUB Effect: GOTO Flee
r2 = r%(ro, c): IF r2 > 0 AND r2 <= nr AND r2 <> 12 THEN ro = r2: GOTO Main
IF r2 = 12 THEN
  IF turns < 20 THEN PRINT "You can't leave without your friends!": GOTO Lp12
  IF d%(7) = 1 THEN ro = r2: GOTO Main
  r = 112: GOSUB Effect: s2$ = "": a$ = "Your name": GOSUB CheckSub2
  IF s2$ <> "hotblack desiato" THEN r = 114: GOTO Lp14
  d%(7) = 1: score = score + 10: r = 113: GOTO Lp14
END IF
IF r2 = -1 THEN PRINT "You wander among the tables for a bit...": GOTO Lp12
' ** Enter stuntship **
IF r2 = -2 THEN
  IF m%(2) <> ro THEN GOSUB Round2
  FOR m = 1 TO 5
     IF m%(m) = ro THEN m%(m) = 13
  NEXT
  ro = 13: GOTO Main
END IF
IF r2 = -3 THEN PRINT "You have no idea how to work it!": GOTO Lp12
PRINT "You can't go that way.": GOTO Main
'---------------------------------------------------------------------------
' Flee command
'
Flee:
FOR m = 21 TO 22: r = m: GOSUB Effect: NEXT: die = 1: GOTO EndGame
'---------------------------------------------------------------------------
'  **** Artifact manipulation commands ****
'---------------------------------------------------------------------------
' Close command
'
ItemClose:
GOSUB CheckSub: GOSUB Asearch0: IF f = 0 THEN GOTO Err5
IF a < 19 OR a > 21 THEN s$ = "the " + a$(a): GOTO Err3
IF a%(a, 6) = 0 THEN PRINT "The "; a$(a); " is not open.": GOTO Lp12
a%(a, 6) = 0: PRINT "The "; a$(a); " is now closed.": GOTO Lp12
'---------------------------------------------------------------------------
' Connect command
'
Connect:
GOSUB CheckSub: GOSUB Asearch0
IF f = 0 THEN
  GOSUB Msearch0: IF f = 0 THEN GOTO Err4
  PRINT m$(m); " resists your attempts.": GOTO Lp12
END IF
a$ = "Connect the " + a$(a) + " to what": GOSUB CheckSub2
s$ = s2$: GOSUB Msearch
IF (a <> 9 AND a <> 24) OR f = 0 THEN
  m = a: GOSUB Asearch0: IF f = 0 THEN GOTO Err1
  s$ = "the " + a$(m) + " to the " + a$(a): GOTO Err3
END IF
IF m = 5 THEN GOTO Talk
IF m <> 6 THEN
  a$ = m$(m) + " yells, " + q$ + "Hey!  Get your bloody hands off of me!" + q$
  GOTO Lp8
END IF
IF m%(3) = ro THEN r = 32: GOTO Lp14
IF a = 9 THEN
  a%(9, 5) = 1
  IF s%(5) = 0 THEN
    s%(5) = 1: score = score + 10: a%(17, 4) = 1: a%(24, 4) = 7
    FOR c2 = 33 TO 34: r = c2: GOSUB Effect: NEXT
  END IF
END IF
IF a = 24 THEN
  a%(24, 6) = 1: r = 46: GOSUB Effect
  IF s%(8) = 0 THEN s%(8) = 1: score = score + 5
END IF
a%(a, 4) = -99
a$ = "You have connected the " + a$(a) + " to " + m$(m) + ".": GOTO Lp8
'---------------------------------------------------------------------------
' Consult command
'
Consult:
GOSUB CheckSub: GOSUB Asearch0: IF f = 0 THEN GOSUB Msearch
IF a <> 1 OR f = 0 THEN GOTO Talk
GOSUB ItemTake: a$ = "About what": GOSUB CheckSub2
s2$ = LTRIM$(RTRIM$(LCASE$(s2$))): a = LEN(s2$): f = 0
FOR m = 1 TO ng
   a$ = LCASE$(g$(m))
   IF s2$ = LEFT$(a$, a) OR s2$ = RIGHT$(a$, a) THEN f = m: m = ng
NEXT
IF f = 0 THEN a$ = "No matches found for:  " + s2$ + ".": GOTO Lp8
r = 56: GOSUB Effect: PRINT g$(f); " --": GOSUB Lp4
OPEN "GUIDE.DSC" FOR RANDOM AS #2 LEN = 255
a = g%(f, 1) + g%(f, 2) - 1
FOR m = g%(f, 1) TO a
   GET #2, m, DS: a$ = RTRIM$(DS.TEXT): GOSUB Lp10
NEXT
CLOSE #2: GOSUB Lp6: GOTO Main
'---------------------------------------------------------------------------
' Drink command
'
Drink:
GOSUB CheckSub: GOSUB Asearch0: IF f = 0 THEN s$ = "that": GOTO Err3
IF a <> 5 AND a <> 11 THEN s$ = "the " + a$(a): GOTO Err3
IF a = 5 THEN
  PRINT "Ahh...  Delicious!": a%(5, 4) = 1020: a%(5, 5) = 1: GOTO Main
END IF
PRINT "That would be suicide!": GOTO Main
'---------------------------------------------------------------------------
' Eat command
'
Eat:
GOSUB CheckSub: GOSUB Msearch: IF f = 0 THEN GOTO Eat2
IF m = 5 THEN a = 0: s$ = "robot": GOTO Eat3
IF m = 6 THEN a = 0: s$ = "computer": GOTO Eat3
r = 51: GOTO Lp14
Eat2:
GOSUB Asearch0: IF f = 0 THEN GOTO Err5
s$ = a$(a): IF a = 5 THEN r = 52: GOTO Lp14
IF a = 8 THEN PRINT "You don't have a headache.": GOTO Lp12
Eat3:
a$ = "While the food sources of the universe are many and varied, a "
a$ = a$ + s$ + " is not one of them.": GOTO Lp8
'---------------------------------------------------------------------------
' Drop command
'
Drop:
GOSUB CheckSub: IF s$ = "all" THEN GOTO Drop1
GOSUB Asearch: IF f = 0 THEN GOTO Err1
IF a = 2 THEN r = 402: GOSUB DiskRead: GOTO Main
IF a = 17 AND a%(a, 5) THEN
  PRINT "You'll have to remove them.": GOTO Lp12
END IF
a%(a, 4) = ro: GOSUB Pu0: PRINT a$; "dropped.": GOTO Lp12
'
Drop1:
FOR a = 1 TO na
   IF a%(a, 4) = -1 THEN
     GOSUB Pu0: PRINT RTRIM$(a$);
     IF a = 2 OR (a = 17 AND a%(a, 5)) THEN
       PRINT ":  You'll have to remove this first.": GOSUB Lp2: GOTO Drop2
     END IF
     a%(a, 4) = ro: PRINT " dropped.": GOSUB Lp2
   END IF
Drop2:
NEXT: GOTO Main
'---------------------------------------------------------------------------
' Examine command
'
Examine:
GOSUB CheckSub: IF LEFT$(s$, 4) = "room" THEN s$ = "": GOTO Look
GOSUB Asearch0
IF f = 0 THEN GOTO Examine1
'
' ** Examine artifact **
'
IF a = 17 AND a%(a, 5) THEN a = 2
Examine0:
r = a + 400: GOSUB DiskRead: a%(a, 0) = 1: GOTO Main
'
' ** Examine monster **
'
Examine1:
GOSUB Msearch: IF f = 0 THEN PRINT "You see nothing special.": GOTO Lp12
r = m + 800: GOSUB DiskRead: ms%(m) = 1: GOTO Main
'---------------------------------------------------------------------------
' The Get command
'
ItemGet:
GOSUB CheckSub: IF s$ = "all" THEN GOTO ItemGet2
ha = ro: GOSUB Asearch1: IF f = 0 THEN s$ = "that": GOTO Err3
GOSUB ItemGet3: GOSUB Lp4: GOTO Main
'
ItemGet2:
em = -99
FOR a = 1 TO na
   IF a%(a, 4) = ro OR (a%(a, 4) = em AND m%(6) = ro) THEN
     IF a <> 18 AND a <> 20 THEN GOSUB ItemGet3
   END IF
NEXT
GOTO Main
'
ItemGet3:
IF a = 18 OR a = 20 THEN PRINT "Don't be absurd.": GOTO Lp4
GOSUB Pu0: PRINT a$;
IF a%(a, 4) = em THEN PRINT "[You disconnect it first.]": GOSUB Lp2: PRINT a$;
a%(a, 4) = -1: PRINT "taken.": GOTO Lp2
'----------------------------------------------------------------------------
' Open command
'
ItemOpen:
GOSUB CheckSub: GOSUB Asearch0: IF f = 0 THEN GOTO Err5
IF a%(a, 2) <> 4 THEN PRINT "It won't open.": GOTO Lp12
IF a%(a, 6) THEN PRINT "It's already open.": GOTO Lp12
IF a = 21 THEN
  IF m%(2) = ro THEN r = 31: a%(a, 4) = -3: a%(a, 1) = 1: GOTO Lp14
  IF s%(3) = 0 THEN s%(3) = 1: score = score + 10
END IF
IF a = 18 OR a = 20 THEN PRINT "It's bolted shut.": GOTO Lp12
ItemOpen1:
a%(a, 6) = 1: PRINT "You open the "; a$(a); ".": GOSUB Lp4: a$ = ""
FOR m = 1 TO na
   IF a%(m, 4) = 1000 + a THEN a$ = a$ + a$(m) + ", "
NEXT: IF a$ = "" THEN GOTO Main
a$ = "The " + a$(a) + " contains " + LEFT$(a$, LEN(a$) - 2) + ".": GOTO Lp8
'----------------------------------------------------------------------------
' Put command
'
ItemPut:
GOSUB CheckSub: GOSUB Asearch0: IF f = 0 THEN GOTO Err1
a$ = "Put it in what": GOSUB CheckSub2
s$ = s2$: m = a: GOSUB Asearch0: IF f = 0 THEN GOTO Err1
' ** Put tea in spare drive **
IF a = 24 THEN
  IF m <> 5 THEN PRINT "It won't fit.": GOTO Lp12
  a%(24, 5) = 1: IF s%(9) = 0 THEN s%(9) = 1: score = score + 5
  GOTO ItemPut1
END IF
IF a = m THEN s$ = "the " + a$(a) + " in itself": GOTO Err3
IF a%(a, 2) <> 4 THEN s$ = "anything in that": GOTO Err3
'
IF a%(a, 6) = 0 THEN GOTO Err2
IF a%(a, 8) < 1 THEN PRINT "You don't need to.": GOTO Lp12
IF a%(a, 7) >= a%(a, 8) THEN PRINT "It's full.": GOTO Lp12
IF m = 17 AND a%(m, 5) THEN
  PRINT "You'll have to remove them.": GOTO Lp12
END IF
'
ItemPut1:
a%(m, 4) = a + 1000: a%(a, 7) = a%(a, 7) + 1
a$ = "Okay, the " + a$(m) + " is now inside the " + a$(a) + ".": GOTO Lp8
'----------------------------------------------------------------------------
' Read command
'
ItemRead:
GOSUB CheckSub: GOSUB Asearch0: IF f = 0 THEN GOTO Err5
IF a = 1 THEN c = 9: GOTO Err6
IF a = 12 THEN a$ = "To Sabrina, with love -- Janx": GOTO ItemRead2
IF a = 9 THEN c = 19: GOTO Err6
IF a = 22 THEN a$ = "BABEL FISH  $499da": GOTO ItemRead2
IF a = 23 THEN r = 55: GOTO Lp14
IF a = 25 THEN a$ = "T-Restorer  $72.9da": GOTO ItemRead2
PRINT "There's nothing to read on the "; a$(a); ".": GOTO Lp12
ItemRead2:
PRINT "It appears to say:": GOSUB Lp4
GOSUB BabelCheck: IF f = 0 THEN GOTO Main
GOTO Lp8
'---------------------------------------------------------------------------
' Remove command
'
Remove:
GOSUB CheckSub: GOSUB Asearch0
IF (a <> 2 AND a <> 17) OR f = 0 THEN GOTO Remove1
IF a = 2 THEN r = 57: GOTO Lp14
IF a%(a, 5) THEN
  a%(a, 5) = 0: lt = 1: PRINT "You have removed the "; a$(a); ".": GOTO Lp12
END IF
'
' ** Remove items from a container **
'
Remove1:
a$ = "From what": GOSUB CheckSub2: a$ = s$: s$ = s2$
GOSUB Asearch0: IF f = 0 THEN GOTO Err1
m = a: s$ = a$: wh = a + 1000: ha = wh: em = wh: GOSUB Asearch2
IF f = 0 THEN
  PRINT "There is a padded cell somewhere with your name on it.": GOTO Lp12
END IF
IF a%(m, 6) = 0 THEN GOTO Err2
'
IF m = 5 AND a = 20 THEN a%(m, 6) = 0: a%(m, 7) = 0
IF m = 5 AND a = 24 THEN td = 0
a%(m, 7) = a%(m, 7) - 1: IF a%(m, 7) < 0 THEN a%(m, 7) = 0
PRINT "Okay.": GOSUB Lp4: a%(a, 4) = -1
IF a%(a, 0) = 0 THEN a%(a, 0) = 1: r = a + 400: GOSUB DiskRead
IF a = 5 AND m = 20 THEN a%(m, 6) = 0
GOTO Main
'---------------------------------------------------------------------------
' Smell command
'
Smell:
IF lt = 0 THEN GOTO Smell2
GOSUB CheckSub: GOSUB Msearch
IF f > 0 THEN
  a$ = m$(m) + " says, " + q$ + "Hey, you weirdo, stop sniffing at me!" + q$
  GOTO Lp8
END IF
GOSUB Asearch0: IF f = 0 THEN GOTO Err1
'  *** Get babel fish ***
IF a = 22 AND round = 1 AND s%(4) = 0 THEN
  s%(4) = 1: score = score + 20: a%(2, 4) = -1
  r = 24: GOSUB Effect: r = 25: GOTO Lp14
END IF
a$ = "It smells just like any other " + a$(a) + ".": GOTO Lp8
'  *** Smell dark ***
Smell2:
IF round = 2 THEN
  lt = 1: turns = -1: score = score + 5
  r = 103: GOSUB Effect: GOSUB Lp6
  FOR m = 71 TO 102: r = m: GOSUB Effect: NEXT: GOTO Main
END IF
IF score > 0 THEN GOTO Err7
lt = 1: score = 5: r = 54: GOSUB Effect: turns = -1: r = 3: GOTO Lp14
'
' **** Use command ****
'
Use:
GOSUB CheckSub: GOSUB Asearch0: IF f = 0 THEN GOTO Err1
'
' ** Use T-Remover **
'
IF a = 7 THEN
  a$ = "Use it on who/what": GOSUB CheckSub2: s$ = s2$: GOSUB Msearch
  IF f > 0 THEN
    IF m <> 1 AND m <> 2 AND m <> 4 AND m <> 10 THEN GOTO UseT1
    IF round = 1 AND turns > 149 THEN r = 69: GOTO Lp14
    m%(m) = 0: r = 50: GOSUB Effect: IF m < 3 THEN m%(m + 6) = ro: GOTO Main
    m%(9 + 2 * ABS(m = 10)) = ro: GOTO Main
  END IF
  GOSUB Asearch0: IF f = 0 THEN GOTO Err1
  IF round = 1 AND turns > 149 THEN r = 69: GOTO Lp14
  IF a <> 3 AND a <> 9 AND a <> 11 THEN GOTO UseT1
  a%(a, 4) = 0: a%(a + 1, 4) = ro: r = 50: GOTO Lp14
UseT1:
  r = 49: die = 1: GOTO Lp14
END IF
'
' ** Use laptop **
'
IF a = 9 THEN
  IF a%(a, 4) <> -99 THEN r = 35: GOTO Lp14
  r = 36: GOSUB Effect: GOSUB BabelCheck: IF f = 0 THEN GOTO Main
  r = 37: GOSUB Effect: GOSUB Lp6
  IF s%(6) = 0 THEN s%(6) = 1: score = score + 5
Lap1:
  PRINT : COLOR 0, 3: PRINT "  Your options are:  "; : COLOR 3, 0: PRINT
  PRINT : PRINT "<1> News": PRINT "<2> Forums": PRINT "<3> Eamon Deluxe"
  PRINT "<4> More options": PRINT "<5> Exit": PRINT
  LINE INPUT " Your choice? "; a$: a = INT(VAL(a$)): PRINT : l = 1
  IF a < 1 OR a > 5 THEN GOTO Lap1
  IF a = 5 THEN GOTO Main
  IF a > 1 THEN r = 41: GOSUB Effect: GOSUB Lp6: GOTO Lap1
  FOR m = 38 TO 41: r = m: GOSUB Effect: NEXT: GOSUB Lp6: GOTO Lap1
END IF
'
' ** Use wrench **
'
IF a = 13 THEN
  a$ = "Use it on what": GOSUB CheckSub2: s$ = s2$: GOSUB Asearch0
  IF f = 0 THEN GOTO Err1
  IF a <> 18 THEN GOTO Err7
  IF a%(a, 6) = 1 THEN PRINT "It's already open.": GOTO Lp12
  score = score + 5: GOTO ItemOpen1
END IF
'
' ** decimal/binary conv. **
'
IF a = 15 THEN
Ionic:
  PRINT : LINE INPUT "Number to convert? (0-255) >"; a$: a = INT(VAL(a$))
  PRINT : IF a$ = "" OR (a = 0 AND a$ <> "0") THEN l = 1: GOTO Main
  IF a < 0 OR a > 255 THEN PRINT "Invalid number!": GOTO Ionic
  k = 128
  FOR m = 1 TO 8
     IF INT(a / k) = 1 THEN PRINT "1"; : a = a - k: GOTO Ionic1
     PRINT "0";
Ionic1:
     k = k / 2
  NEXT: GOTO Ionic
END IF
'
' ** Use Nutri-Mat **
'
IF a = 20 THEN
  IF a%(5, 4) <> 1020 OR a%(a, 6) THEN GOTO Err7
  IF s%(7) = 0 THEN s%(7) = 1: score = score + 5
  a%(a, 6) = 1: r = 45: GOTO Lp14
END IF
'
' ** Use T-Restorer **
'
IF a = 25 THEN
  a$ = "Use it on who/what": GOSUB CheckSub2: s$ = s2$: GOSUB Msearch
  IF f > 0 THEN
    IF m <> 7 AND m <> 8 AND m <> 9 AND m <> 11 THEN GOTO Err7
    m%(m) = 0: r = 130: GOSUB Effect
    IF m = 7 OR m = 8 THEN m%(m - 6) = ro: GOTO Main
    m%(4 + 6 * ABS(m = 11)) = ro: GOTO Main
  END IF
  GOSUB Asearch0: IF f = 0 THEN GOTO Err1
  IF a <> 4 AND a <> 10 AND a <> 12 THEN GOTO Err7
  a%(a, 4) = 0: a%(a - 1, 4) = ro: r = 130: GOTO Lp14
END IF
'
' ** Use drive **
'
IF a = 24 THEN
  IF round <> 1 OR a%(24, 5) = 0 OR a%(24, 6) = 0 THEN GOTO Err7
  a$ = "/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\/\": WIDTH 40
  FOR x = 1 TO 50
     CLS : LOCATE 24: COLOR 0, INT(RND * 15) + 1
     FOR a = 1 TO 10: PRINT a$: PRINT : PRINT a$: NEXT
     SOUND 8000 - x * 50, 1
  NEXT
  COLOR 3, 0: WIDTH 80: CLS : LOCATE 24: l = 0
  FOR m = 47 TO 48: r = m: GOSUB Effect: NEXT
  FOR m = 18 TO 19
     a%(m, 4) = ro: a%(m, 0) = 1: r = m + 400: GOSUB DiskRead
  NEXT
  a%(5, 4) = 1020: a%(24, 4) = 0: score = score + 20: GOTO Main
END IF
GOTO Err7
'---------------------------------------------------------------------------
' Wear command
'
Wear:
GOSUB CheckSub: GOSUB Asearch0: IF f = 0 THEN GOTO Err5
IF a <> 17 THEN s$ = "the " + a$(a): GOTO Err3
IF a%(a, 5) THEN PRINT "You're already wearing them.": GOTO Lp12
GOSUB ItemTake: a%(17, 5) = 1: lt = 2
a$ = "You are now wearing the " + a$(a): GOTO Lp8
'---------------------------------------------------------------------------
'  Interaction commands
'
'  **** Attack command ****
'
Attack:
PRINT "Relax.": GOTO Lp12
'
' **** Give command ****
'
Give:
GOSUB CheckSub: GOSUB Asearch0: IF f = 0 THEN GOTO Err1
a$ = "To whom": GOSUB CheckSub2
s$ = s2$: GOSUB Msearch: IF f = 0 THEN GOTO Err4
IF m <> 2 AND m <> 4 AND m <> 5 THEN
  a$ = m$(m) + " politely refuses your gift.": GOTO Lp8
END IF
PRINT "Okay.": GOSUB Lp4: a$ = m$(m): a%(a, 4) = -m - 1
IF m = 2 THEN
  a$ = a$ + " takes the " + a$(a) + " without even thinking twice, then "
  a$ = a$ + "returns to his work."
END IF
IF m = 4 THEN
  a$ = a$ + " smiles warmly at you as you hand the " + a$(a) + " to her."
END IF
IF m = 5 THEN
  a$ = q$ + "Oh, thank you soooo much." + q$ + "  Marvin says sarcastically "
  a$ = a$ + "in his cold nasal whine as he takes the " + a$(a) + "."
  IF a = 21 AND s%(2) = 0 THEN s%(2) = 1: score = score + 5
END IF
GOTO Lp8
'---------------------------------------------------------------------------
' Order command
'
Order:
GOSUB CheckSub: GOSUB Msearch: IF f = 0 THEN GOTO Talk
IF m = 6 THEN r = 23: GOTO Lp14
IF m <> 5 OR (round = 1 AND turns < 150) OR (round > 1 AND ro <> 13) THEN GOTO Talk
a$ = "Order " + m$(m) + " to do what": GOSUB CheckSub2
v$ = s2$: GOSUB ComSearch
IF c = 0 THEN
  PRINT q$; "Order"; q$; " is only used with:": GOSUB Lp4
  FOR c = 1 TO nc - 5: PRINT c$(c), : NEXT: PRINT : GOSUB Lp6: GOTO Main
END IF
IF round = 2 THEN
  IF c <> 3 THEN GOTO Talk
  score = score + 20: r = 122: GOSUB Effect: ro = 14
  IF m%(2) = ro THEN m%(2) = 15
  GOTO EndRound
END IF
IF c <> 4 OR ro <> 8 THEN GOTO Talk
score = score + 20: peril = 0: ro = 10: lt = 0
m%(1) = 12: m%(2) = 11: m%(3) = 11: m%(4) = 12: m%(5) = 12
FOR m = 64 TO 67: r = m: GOSUB Effect: NEXT
GOTO EndRound
'---------------------------------------------------------------------------
' Request command
'
Request:
GOSUB CheckSub: a$ = "From whom": GOSUB CheckSub2
a$ = s$: s$ = s2$: GOSUB Msearch: IF f = 0 THEN GOTO Err4
s$ = a$: wh = -m - 1: ha = -m - 1000: em = wh: GOSUB Asearch2
IF f = 0 THEN a$ = m$(m) + " doesn't have it.": GOTO Lp8
IF m = 1 OR m = 3 THEN r = 3 + m: GOTO Lp14
IF (m <> 4 AND m <> 5 AND m <> 2) OR (m = 2 AND (turns > 51 OR round > 1)) THEN
  PRINT m$(m); " ignores you.": GOTO Lp12
END IF
' *** Get Ford's satchel ***
IF m = 2 THEN
  IF a%(21, 1) THEN r = 30: GOTO Lp14
  IF a <> 21 THEN GOTO Request1
  r = 28: GOSUB Effect: IF s%(1) = 0 THEN s%(1) = 1: score = score + 5
END IF
IF m = 5 THEN
  a$ = q$ + "'Marvin take this, Marvin give it back,'" + q$ + " the robot "
  a$ = a$ + "whines as he hands the " + a$(a) + " to you, "
  a$ = a$ + q$ + "I'm so depressed!" + q$: GOSUB Lp10
END IF
Request1:
'
a%(a, 4) = -1: GOSUB Pu0: : PRINT a$; "taken.": GOSUB Lp4:
IF a%(a, 0) = 0 THEN a%(a, 0) = 1: GOSUB Lp1: r = a + 400: GOSUB DiskRead
GOTO Main
'---------------------------------------------------------------------------
' Smile command
'
Smile:
PRINT "How nice.": GOTO Lp12
'---------------------------------------------------------------------------
' Talk command
'
Talk:
GOSUB CheckSub: GOSUB Msearch
IF f > 0 THEN r = 3 + m: GOTO Lp14
GOSUB Asearch0: IF f = 0 THEN GOTO Err4
a$ = "Talking to a " + a$(a) + " bears no fruit.": GOTO Lp8
'---------------------------------------------------------------------------
' Miscelaneous commands
'
' **** Inventory ****
'
Inventory:
m = 0: a$ = "You are": IF s$ = "" THEN GOTO Inv2
GOSUB Msearch: IF f = 0 THEN GOTO Err4
a$ = m$(m) + " is"
'
Inv2:
ha = -m - 1: f = 0: PRINT a$; " carrying:": GOSUB Lp4
IF m = 6 THEN PRINT "  (A lot of microchips.)": GOTO Lp12
FOR a = 1 TO na
   IF a%(a, 4) = ha THEN
     GOSUB Pu0: PRINT " "; a$;
     IF a = 2 THEN PRINT "   (in ear)";
     IF a = 17 AND a%(a, 5) = 1 THEN PRINT "  (Being worn)";
     IF a = 19 OR a = 21 THEN GOSUB Inv3
     IF a = 24 AND td THEN GOSUB Lp1: GOSUB Inv4
     f = 1: GOSUB Lp1
   END IF
NEXT
IF f = 0 THEN PRINT " (Nothing)": GOSUB Lp4
IF m = 0 THEN
  PRINT "Score "; LTRIM$(RTRIM$(STR$(score))); "/200   Turns: ";
  PRINT LTRIM$(RTRIM$(STR$(turns + tt))): GOSUB Lp4
END IF
GOTO Main
'
' Show items inside of container
'
Inv3:
IF a%(a, 6) <> 1 THEN PRINT "  (Closed)"; : RETURN
GOSUB Lp1
'
Inv4:
xm = a + 1000: m2 = 0: PRINT "(This contains:)": GOSUB Lp2: of = 0
FOR a2 = 1 TO na
   IF a%(a2, 4) = xm THEN
     PRINT " --- "; UCASE$(LEFT$(a$(a2), 1)); MID$(a$(a2), 2)
     GOSUB Lp2: of = 1
   END IF
NEXT
IF of = 0 THEN PRINT " --- (Nothing)": GOSUB Lp2
RETURN
'---------------------------------------------------------------------------
' Look command
'
Look:
IF s$ <> "" THEN GOTO Examine
r%(ro, 0) = 1: r = ro: GOSUB DiskRead: GOTO Main
'---------------------------------------------------------------------------
' Panic command
'
Panic:
r = 53: GOTO Lp14
'----------------------------------------------------------------------------
' Say command
'
Say:
GOSUB CheckSub: s$ = LTRIM$(RTRIM$(LEFT$(s$, 60)))
s$ = UCASE$(LEFT$(s$, 1)) + LCASE$(MID$(s$, 2))
a$ = "Okay, " + q$ + LEFT$(s$, 60) + q$ + ".": GOSUB Lp10: GOTO Main
'----------------------------------------------------------------------------
' Wait command
'
TimeWait:
PRINT "Time passes...": GOSUB Lp4
FOR x = 1 TO 3
   turns = turns + 1
   ON round GOSUB Round1, Round2, Round3
   IF die = 1 THEN x = 3
NEXT: IF die = 1 THEN GOTO EndGame
GOTO Main
'----------------------------------------------------------------------------
' Help command
'
Hints:
PRINT "Your question?": GOSUB Lp4: PRINT "    1- "; h$(1): GOSUB Lp2
FOR r = 43 TO 59
   PRINT "   "; : IF r < 51 THEN PRINT " ";
   PRINT LTRIM$(RTRIM$(STR$(r - 41))); "- "; h$(r): GOSUB Lp2
NEXT
GOSUB Lp1: LINE INPUT "Your choice?:"; a$: l = 0: r = INT(VAL(a$))
IF r > 1 THEN r = r + 41
IF r <> 1 AND ((r > 1 AND r < 43) OR r > 59 OR r < 1) THEN GOTO Main
'
GOSUB Lp1: PRINT h$(r): GOSUB Lp4
OPEN "HINTS.DSC" FOR RANDOM AS #2 LEN = 255
a = h%(r, 1) + h%(r, 2) - 1: s$ = ""
FOR m = h%(r, 1) TO a
   GET #2, m, DS: a$ = RTRIM$(DS.TEXT): GOSUB Lp10
   IF m < a THEN
     PRINT "Another? (Y/N):";
     DO
     s$ = LCASE$(INKEY$)
     LOOP UNTIL s$ = "y" OR s$ = "n"
     LOCATE CSRLIN, 1: PRINT SPC(16); : LOCATE CSRLIN, 1: l = 0
     IF s$ <> "y" THEN m = a
   END IF
NEXT
CLOSE #2: GOTO Main
'---------------------------------------------------------------------------
' Save game
'
GameSave:
OPEN "GAMEDIR.DAT" FOR INPUT AS #2: INPUT #2, a: IF a < 0 THEN a = 0
FOR m = 1 TO 5: LINE INPUT #2, gm$(m): NEXT
CLOSE #2: PRINT "Saved games:": GOSUB Lp4
FOR m = 1 TO 5
   PRINT " "; LTRIM$(RTRIM$(STR$(m))); "- "; gm$(m): GOSUB Lp2
NEXT: PRINT 6; "- (Don't save, return to game)": GOSUB Lp4
'
INPUT "Enter 1-6 for saved position:"; a$: m = INT(VAL(a$)): l = 0
IF m < 1 OR m > 6 THEN GOTO GameSave
IF m = 6 THEN GOTO Main
IF m > a + 1 THEN PRINT "Use #"; a + 1; "first.": GOSUB Lp4: GOTO GameSave
'
IF m = a + 1 THEN a = a + 1
IF gm$(m) <> "(none)" THEN
  PRINT "Enter a new description for save?"; : GOSUB Af1
  IF s$ <> "y" THEN GOTO GameSave1
END IF
PRINT "Enter new description:": GOSUB Lp4: LINE INPUT "-->"; gm$(m)
l = 1: gm$(m) = LEFT$(gm$(m), 40)
'
GameSave1:
OPEN "GAMEDIR.DAT" FOR OUTPUT AS #2: PRINT #2, a
FOR k = 1 TO 5: PRINT #2, gm$(k): NEXT: CLOSE #2
'
a$ = "GAME" + LTRIM$(RTRIM$(STR$(m))) + ".SAV"
OPEN a$ FOR OUTPUT AS #2
FOR a = 1 TO na
   FOR m = 0 TO 8: PRINT #2, a%(a, m): NEXT
NEXT
FOR m = 0 TO nm: PRINT #2, m%(m), ms%(m): NEXT
FOR r = 1 TO nr
   FOR m = 0 TO 7: PRINT #2, r%(r, m): NEXT
NEXT
FOR a = 1 TO 200: PRINT #2, d%(a): NEXT
FOR a = 0 TO 20: PRINT #2, s%(a): NEXT
PRINT #2, die, lt, ro, round, peril, turns, tt, mc, mm, score
CLOSE #2: PRINT "Game saved.": GOSUB Lp4: GOTO Main
'---------------------------------------------------------------------------
' Restore saved game
'
GameRestore:
OPEN "GAMEDIR.DAT" FOR INPUT AS #2: INPUT #2, a
FOR m = 1 TO 5: LINE INPUT #2, gm$(m): NEXT: CLOSE #2
PRINT "Saved games:": GOSUB Lp4
FOR m = 1 TO 5
   PRINT " "; LTRIM$(RTRIM$(STR$(m))); "- "; gm$(m): GOSUB Lp2
NEXT: PRINT 6; "- (Don't restore, return to game)": GOSUB Lp4
INPUT "Enter 1-6 to restore a position:"; a$: m = INT(VAL(a$)): l = 0
IF m < 1 OR m > 6 THEN GOTO GameRestore
IF m = 6 THEN
  IF die = 1 THEN GOTO Dead
  GOTO Main
END IF
IF m > a THEN : PRINT "There is no saved game there.": GOTO GameRestore
'
a$ = "GAME" + LTRIM$(RTRIM$(STR$(m))) + ".SAV"
OPEN a$ FOR INPUT AS #2
FOR a = 1 TO na
   FOR m = 0 TO 8: INPUT #2, a%(a, m): NEXT
NEXT
FOR m = 0 TO nm: INPUT #2, m%(m), ms%(m): NEXT
FOR r = 1 TO nr
   FOR m = 0 TO 7: INPUT #2, r%(r, m): NEXT
NEXT
FOR a = 1 TO 200: INPUT #2, d%(a): NEXT
FOR a = 0 TO 20: INPUT #2, s%(a): NEXT
INPUT #2, die, lt, ro, round, peril, turns, tt, mc, mm, score
CLOSE #2: cz$ = "": r2 = ro: GOTO Main
'---------------------------------------------------------------------------
' Quit, leave the Eamon system
'
Quit:
OPEN "GAMEDIR.DAT" FOR INPUT AS #2: INPUT #2, a: CLOSE #2
IF a < 1 THEN
  COLOR 2: l = 0
  a$ = "!! WARNING !!  You haven't saved a game yet, any progress that you "
  a$ = a$ + "have made will be lost and you'll have to start back at the "
  a$ = a$ + "beginning when you return.": GOSUB Lp10: COLOR 3
END IF
PRINT "Are you sure you want to quit?"; : GOSUB Af1
IF s$ <> "y" THEN GOTO Main
CLS : CHDIR "..": RUN "EAMONDX"
'---------------------------------------------------------------------------
' **** End of round routine ****
'
EndRound:
GOSUB Lp6
COLOR 0, 2: PRINT "  CONGRATULATIONS!  "; : COLOR 3, 0: PRINT : PRINT : PRINT
PRINT "You have completed round "; LTRIM$(RTRIM$(STR$(round))); "."
PRINT : round = round + 1: tt = tt + turns: turns = 0: GOSUB Lp6: GOTO Main
'---------------------------------------------------------------------------
' **** End of game routines ****
'
EndGame:
GOSUB Lp1: GOSUB Lp6
IF die > 0 THEN GOTO Dead
'
FOR m = 131 TO 139: r = m: GOSUB Effect: NEXT
PRINT "Final score:  "; LTRIM$(RTRIM$(STR$(score)));
PRINT "/200  Turns: "; LTRIM$(RTRIM$(STR$(turns + tt)))
GOSUB Lp4: GOSUB Lp6
EXIT SUB
'
' Player died
'
Dead:
CLS : PRINT "You have perished.  Now what?": PRINT "1. Restore a saved game"
PRINT "2. Start over": PRINT "3. Give up, accept death": PRINT
LINE INPUT "Your choice?"; a$: a = INT(VAL(a$))
IF a < 1 OR a > 3 THEN GOTO Dead
IF a = 3 THEN EXIT SUB
IF a = 2 THEN RUN
GOTO GameRestore
'---------------------------------------------------------------------------
'
' Most-useful routines and subroutines
'
' Read text from DESC file
'
Effect:
r = r + 1200
'
DiskRead:
IF r < 401 THEN GET #10, r + adj1, DS
IF r > 400 AND r < 801 THEN GET #11, r - 400 + adj2, DS
IF r > 800 AND r < 1201 THEN GET #12, r - 800 + adj3, DS
IF r > 1200 THEN GET #13, r - 1200 + adj4, DS
a$ = RTRIM$(DS.TEXT): GOSUB Lp0: GOTO Lp1
'
' Print a$ without wrap-around
'
Lp0:
xm = 0: a$ = LTRIM$(a$)
IF LEN(a$) <= 79 THEN PRINT a$:  GOTO Lp2
FOR k = 79 TO 1 STEP -1
   IF MID$(a$, k, 1) = " " THEN
     PRINT LEFT$(a$, k - 1): a$ = RIGHT$(a$, LEN(a$) - k)
     GOSUB Lp2: k = 1: xm = 1
   END IF
NEXT: IF xm = 1 THEN GOTO Lp0
COLOR 7: PRINT "Word to long error!": COLOR 3: GOTO Lp4
'----------------------------------------------------------------------------
' Line counter & pause routines
'
Lp1:
PRINT
'
Lp2:
l = l + 1: GOTO Lp5
'
Lp3:
l = l + 1
'
Lp4:
l = l + 2: PRINT
'
Lp5:
IF l < 20 THEN RETURN
'
Lp6:
PRINT "[MORE]"; : zz$ = INKEY$
DO
LOOP UNTIL INKEY$ > ""
LOCATE CSRLIN, 1: PRINT "      "; : LOCATE CSRLIN, 1
zz$ = INKEY$: l = 0: RETURN
'
Lp7:
  CLS : l = 0: RETURN
'
' Redundant stuff
'
Lp8:
GOSUB Lp10: GOTO Main
'
Lp10:
GOSUB Lp0: GOTO Lp1
'
Lp11:
GOSUB DiskRead: l = l - 1: LOCATE CSRLIN - 1, 1: RETURN
'
Lp12:
GOSUB Lp4: GOTO Main
Lp14:
GOSUB Effect: GOTO Main
'----------------------------------------------------------------------------
'
' Capitalize a$
'
Pu0:
a$ = a$(a)
Pu1:
a$ = UCASE$(LEFT$(a$, 1)) + MID$(a$, 2) + " ": RETURN
'
' Make a$ possessive
'
Pu2:
a$ = m$(m) + MID$("'s'", ABS(LCASE$(RIGHT$(m$(m), 1)) = "s") * 2 + 1, 2) + " "
RETURN
'---------------------------------------------------------------------------
' Get an item before doing something with it (Ready/Wear/Etc.)
'
ItemTake:
IF a%(a, 4) = -1 THEN RETURN
PRINT "(Taking it first.)"
'
ItemTake1:
a%(a, 4) = -1: RETURN
'----------------------------------------------------------------------------
' Player input error messages
'
Err0:
COLOR 2: PRINT "Movement commands:": COLOR 3
FOR c = 1 TO 7: PRINT UCASE$(c$(c)), : NEXT: PRINT : PRINT
COLOR 2: PRINT "Artifact manipulation:": COLOR 3
FOR c = 8 TO 22: PRINT UCASE$(c$(c)), : NEXT: PRINT : PRINT
COLOR 2: PRINT "Interactive:": COLOR 3
FOR c = 23 TO 28: PRINT UCASE$(c$(c)), : NEXT: PRINT : PRINT
COLOR 2: PRINT "Miscelaneous:": COLOR 3
FOR c = 29 TO nc: PRINT UCASE$(c$(c)), : NEXT: PRINT : PRINT
l = 99: GOSUB Lp6: GOTO Main
'
Err1:
PRINT "You don't have it and it's not here.": GOTO Lp12
Err2:
PRINT "You must first open it.": GOTO Lp12
Err3:
a$ = "You can't " + c$(c) + " " + s$ + ".": GOTO Lp8
Err4:
PRINT "Nobody here by that name!": GOTO Lp12
Err5:
PRINT "I don't recognize the word "; q$; s$; q$; ".": GOTO Lp12
Err6:
PRINT "Try the "; q$; c$(c); q$; " command.": GOTO Lp12
Err7:
PRINT "Nothing happens.": GOTO Lp12
'---------------------------------------------------------------------------
' Check for babel fish in ear
'
BabelCheck:
f = 0: IF a%(2, 4) = -1 THEN f = 1: RETURN
r = 2: GOTO Effect
'---------------------------------------------------------------------------
' Get yes/no input
'
Af1:
LINE INPUT "  (Y/N):"; s$: s$ = LTRIM$(RTRIM$(LCASE$(s$)))
s$ = LEFT$(s$, 1): IF s$ <> "y" AND s$ <> "n" THEN GOTO Af1
l = 0: GOTO Lp1
'---------------------------------------------------------------------------
' Check/get s$
'
CheckSub:
IF s$ <> "" THEN RETURN
CheckSub1:
PRINT UCASE$(LEFT$(c$(c), 1)); MID$(c$(c), 2);
LINE INPUT " who or what?", s$: s$ = LCASE$(LTRIM$(RTRIM$(s$)))
PRINT : l = 1: GOTO CheckSub
'---------------------------------------------------------------------------
' Check/get s2$
'
CheckSub2:
IF s2$ <> "" THEN RETURN
PRINT a$; : LINE INPUT "?"; s2$: s2$ = LTRIM$(RTRIM$(LCASE$(s2$)))
l = 1: PRINT : GOTO CheckSub2
'---------------------------------------------------------------------------
' Command search routine
'
ComSearch:
a = LEN(v$): c = 0: c2 = 0
FOR k = 1 TO nc
   IF v$ = LEFT$(c$(k), a) OR v$ = RIGHT$(c$(k), a) THEN
     c2 = c: c = k: IF c < 7 THEN k = nc
   END IF
NEXT
IF c2 > 0 THEN
  a$ = "Do you mean " + q$ + c$(c2) + q$ + " or " + q$ + c$(c) + q$ + "?"
  c = 0: GOTO Lp10
END IF
RETURN
'---------------------------------------------------------------------------
' Monster search routine
'
Msearch:
wh = ro
Msearch0:
f = 0: SL = LEN(s$): m = 0
FOR x = 1 TO nm
   IF s$ = LCASE$(m$(x)) THEN
     IF m%(x) = wh THEN m = x: f = f + 1:  x = nm:  GOTO Msearch1
   END IF
   IF s$ = LEFT$(LCASE$(m$(x)), SL) OR s$ = RIGHT$(LCASE$(m$(x)), SL) THEN
     IF m%(x) = wh OR m%(x) = ha THEN m = x: f = f + 1
   END IF
Msearch1:
NEXT: RETURN
'---------------------------------------------------------------------------
' Artifact search routine
'
Asearch:
  ha = -1: wh = ha: em = ha: GOTO Asearch2
Asearch0:
  ha = -1
Asearch1:
  wh = ro: em = -99
'
Asearch2:
f = 0: SL = LEN(s$):
FOR x = 1 TO na
   IF s$ = LCASE$(a$(x)) THEN
     a2 = a%(x, 4)
     IF a2 = ha OR a2 = wh OR a2 = em THEN
       a = x: f = f + 1: a = x: x = na: f = 1: GOTO Asearch3
     END IF
   END IF
   IF s$ = LEFT$(LCASE$(a$(x)), SL) OR s$ = RIGHT$(LCASE$(a$(x)), SL) THEN
     a2 = a%(x, 4)
     IF a2 = ha OR a2 = wh OR a2 = em THEN
       a = x: f = f + 1: IF f = 1 THEN xm = a
     END IF
   END IF
Asearch3:
NEXT: IF f = 1 THEN s$ = a$(a)
IF f > 1 THEN
  f = 0: a$ = "(Do you mean " + q$ + a$(xm) + q$ + " or " + q$
  a$ = a$ + a$(a) + q$ + "?)": GOSUB Lp0
END IF
RETURN
END SUB

