'     THE WONDERFUL WORLD OF EAMON DELUXE
'           BY FRANK BLACK 1996-1999
'
'   A COMPUTERIZED FANTASY ROLE-PLAYING SYSTEM
' BASED UPON THE APPLE II VERSION BY DONALD BROWN,
'    JOHN NELSON, TOM ZUCHOWSKI, & FRANK BLACK
'
'  BASE DUNGEON PROGRAM v1.1              Update: 15 JUL 1999
'  The Lost Island of Apple               Original program by Donald Brown
'
' **  Eamon Deluxe version and PC graphics conversions by Frank Black **
'
' d%(1), d%(2) - Last x,y coordinates for drawing
' d%(3) - Food
' d%(4) - Return codes when exiting graphic mode
'        (1=Save,2=Restore,3=Quit,4=Enter a place,5=Player died)
' d%(5) - Screen code (1=Text,2=Graphics)
' d%(6) - First-turn flag for graphic mode (displays key info)
' d%(7) - Test mode enabled? (Try pressing Ctrl-A, then 1-7 in gr mode)
' d%(8) - Shape # of player icon
' d%(9) - # of breaths of air left in watery parts
'
'          SHAPE DIMENSIONS ARE 1 TO 225
'                    (15 x 15)
'
' shape%(1)  Player           shape%(6)  Wolf
' shape%(2)  Slaver           shape%(7)  Dragon
' shape%(3)  Hermit           shape%(8)  Saved Background #1  (player)
' shape%(4)  Wagon            shape%(9)  Saved Background #2  (encounters)
' shape%(5)  Bear
'
DECLARE SUB Apple.Island ()
DECLARE SUB MakePic ()

CLEAR
DIM SHARED shape%(594), x, y, shape, ro, r2, gold, nm, q$

CLS : LOCATE 10
PRINT "Welcome to the Eamon Deluxe fantasy gaming system! (MAINPGM v1.1)"
PRINT : PRINT "Loading shapes...";

OPEN "shapes.dat" FOR INPUT AS #1
FOR m = 1 TO 46: INPUT #1, a: NEXT       'IGNORE PAC-MAN
FOR m = 1 TO 462: INPUT #1, shape%(m): NEXT
CLOSE
PRINT "Done"

TYPE DESC
  TEXT AS STRING * 253
END TYPE
DIM 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 rm AS ROOM

TYPE ARTIFACT
  aname 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 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
END TYPE
DIM 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 z AS RECORD
'
'  Set up variable table
'
OPEN "NAME.DAT  " FOR INPUT AS #1
INPUT #1, nr, naf, ne, nm, aname$, nd, ver
CLOSE
'==========================================
' Re-set variables
'
nr = 49: naf = 27: ne = 3: nm = 15

' Adjustment to locations in DSC & DAT files
' 1=rooms 2=artifacts 3=monsters

adj1 = 346: adj2 = 199: adj3 = 93

'==========================================
a = 0: m = a: ro = m: na = naf + 6
OPEN "HINTDIR.DAT" FOR INPUT AS #1
INPUT #1, nh
DIM h$(nh), h%(nh, 2)
FOR r = 1 TO nh
   INPUT #1, h$(r), h%(r, 1), h%(r, 2)
NEXT: CLOSE

DIM SHARED a$(na), a%(na, 8), d%(200), m$(nm), m%(nm, 15), r$(nr), r%(nr, 11)
DIM SHARED sa%(4), sp%(4), sm$(3), bv$(5, 2), rb$(5, 1), wp$(5), wa%(5), wp%(na)
READ nc: DIM SHARED c$(nc), gm$(5), sp$(4), sa$(4), sex$(2)
GOTO Init

'---------------------------------------------------------------------------
' Main Loop
'
Main0:
GOSUB Lp4
Main:
IF die = 1 THEN GOTO EndGame
COLOR 12: GOSUB Lp1: IF ls = 0 THEN GOTO Main2A
IF a%(ls, 5) = -1 THEN GOTO Main2A
a%(ls, 5) = a%(ls, 5) - 1: m = a%(ls, 5)
IF m = 0 THEN
  COLOR 2: PRINT "Your "; a$(ls); " has gone out!": COLOR 12
  ls = 0: lt = nl: GOTO Main0
END IF
Main1A:
IF m < 10 THEN
  PRINT "Your "; a$(ls); " is almost out!": GOSUB Lp4: GOTO Main2A
END IF
Main1B:
IF m < 20 THEN PRINT "Your "; a$(ls); " grows dim!": GOSUB Lp4
Main2A:
IF Speed > 0 THEN
  Speed = Speed - 1
  IF Speed = 0 THEN
    m%(0, 2) = m%(0, 2) / 2
    PRINT "Your speed spell has just expired!": GOSUB Lp4
  END IF
END IF
Main2B:
FOR a = 1 TO 4
   IF sa%(a) < sp%(a) THEN
     sa%(a) = sa%(a) * 1.1
     IF sa%(a) > sp%(a) THEN sa%(a) = sp%(a)
   END IF
NEXT
Main3A:
IF lt = 0 THEN PRINT "It's too dark to see.": GOSUB Lp4: GOTO Com1
'
' Give room name and desc
'
Main3B:
PRINT "You are "; r$(ro): GOSUB Lp4
IF r%(ro, 0) = 0 THEN r%(ro, 0) = 1: r = ro: GOSUB DiskRead
'
' List monsters in room
'
Main4A:
m2 = 1
FOR m = 1 TO nm
   IF m%(m, 5) = ro THEN
     IF m%(m, 0) = 0 THEN
       IF m2 = 0 THEN GOSUB Lp1
       m%(m, 0) = 1: r = m + 800: GOSUB DiskRead: m2 = 1
       IF m%(m, 3) = 1 THEN PRINT m$(m); " is here.": GOSUB Lp4: GOTO Main4B
       PRINT LTRIM$(STR$(m%(m, 3))); " "; m$(m); "s are here."
       GOSUB Lp4: GOTO Main4B
     END IF
     m2 = 0
     IF m%(m, 3) = 1 THEN PRINT m$(m); " is here.": GOSUB Lp2
     PRINT LTRIM$(STR$(m%(m, 3))); " "; m$(m); "s are here.": GOSUB Lp2
   END IF
Main4B:
NEXT
'
' List artifacts in room
'
Main5A:
f = 0
FOR a = 1 TO na
   IF a%(a, 4) <> ro THEN GOTO Main5B
   f = f + 1
   IF a > naf THEN
     IF m2 = 0 AND f > 1 THEN GOSUB Lp1
     PRINT "Your "; a$(a); " is here.": GOSUB Lp2: m2 = 1: GOTO Main5B
   END IF
   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$(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$(a); ".": GOSUB Lp2: m2 = 0
   IF a%(a, 2) = 4 AND a%(a, 6) = 1 THEN GOSUB Inv4
Main5B:
NEXT
Com0:
GOSUB Lp1
'==============================================================
  IF ro = 22 AND d%(9) < 2 * m%(0, 1) THEN d%(9) = 2 * m%(0, 1)
  IF ro > 22 AND ro < 34 THEN
    d%(9) = d%(9) - 1
    IF d%(9) < 8 THEN
      COLOR 14: PRINT "You are having great trouble holding your breath!"
      GOSUB Lp4
      IF d%(9) < 1 THEN PRINT "You just drowned!": COLOR 3: die = 1: GOTO EndGame
    END IF
  END IF
'===============================================================
Com1:
COLOR 12
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
'
' Parse command
'
v$ = "": s$ = "": s2$ = "": S3$ = ""
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 a
IF v$ = "" THEN v$ = a$: GOTO Com2
S3$ = s$
'
FOR a = 1 TO LEN(s$)
   IF MID$(s$, a, 1) = " " THEN
     s2$ = LTRIM$(RTRIM$(MID$(s$, a + 1)))
     s$ = LTRIM$(RTRIM$(LEFT$(s$, a - 1))): a = LEN(s$)
   END IF
NEXT
IF s2$ = "" THEN GOTO Com2
'
zz$ = LEFT$(s2$, 3)
IF zz$ = "to " OR zz$ = "on " OR zz$ = "in " THEN
  s2$ = LTRIM$(RTRIM$(MID$(s2$, 4))): GOTO Com2
END IF
zz$ = LEFT$(s2$, 5)
IF zz$ = "from " OR zz$ = "with " THEN s2$ = LTRIM$(RTRIM$(MID$(s2$, 6)))
Com2:
'
a = LEN(v$): c = 0
FOR k = 1 TO nc
   IF v$ = LEFT$(c$(k), a) OR v$ = RIGHT$(c$(k), a) THEN c = k: k = nc
NEXT
IF c = 0 THEN GOTO Err0
COLOR 3: IF c <> 20 AND c <> 23 AND c <> 29 AND c <> 31 THEN s$ = S3$
Com3:
ON c GOTO Move, Move, Move, Move, Move, Move, Move, Move, Move, Move, Flee
ON c - 11 GOTO ItemClose, Drink, Drop, Drink, examine, ITEMGET, Light, ItemOpen
ON c - 19 GOTO ItemPut, ItemRead, Ready, Remove, Use, Wear
ON c - 25 GOTO Attack, Blast, Free, Give, Heal, Request, Smile
ON c - 32 GOTO Inventory, Look, Say, Speed, Power, Status, Hints
ON c - 39 GOTO GameSave, GameRestore, Quit
'---------------------------------------------------------------------------
'  Pick foes
'
Pfoe:
  IF die = 1 THEN GOTO EndGame
  IF t(1) < 0 THEN t(1) = 0
  IF t(1) = 0 THEN GOTO Pfoe3
  GOSUB Lp1: m = 0: m9 = 1
Pfoe0:
  m = m + 1
  IF m%(m, 5) <> ro THEN GOTO Pfoe2A
  IF m%(m, 11) = 2 THEN GOTO Pfoe2A
'
'  Will monster flee?
'
  GOSUB RollDice
  IF m%(m, 13) > 0 THEN rl = rl + 10
  IF m%(m, 13) <= 0 AND m%(m, 12) > m%(m, 3) THEN rl = rl + 10
  IF m%(m, 13) + 4 >= m%(m, 1) THEN rl = rl + 10
  IF rl > m%(m, 4) THEN mr% = 1
  IF mr% = 0 OR m%(m, 4) > 99 THEN GOTO SkipFlee
'
  mr% = INT(RND * m%(m, 3)) + 1
  IF m%(m, 3) > 1 THEN PRINT LTRIM$(RTRIM$(STR$(mr%))); " ";
  PRINT m$(m);
  PRINT MID$("s flee! flees!", ABS(mr% = 1) * 7 + 1, 7): GOSUB Lp4
  IF nx = 0 THEN
    PRINT "But can't find an exit!": GOSUB Lp4: GOTO Pfoe2A
  END IF
  IF mr% = m%(m, 3) THEN
    GOSUB Flee1: m%(m, 5) = r2
    r3 = ro: GOSUB EnemyCheck: GOTO Pfoe2A
  END IF
  m%(m, 3) = m%(m, 3) - mr%: r3 = ro: GOSUB EnemyCheck
'
'  Find an enemy to attack
'
SkipFlee:
  MC = 0: XMC = 1: IF m%(m, 3) > 1 THEN XMC = m%(m, 3)
  of = m: df = 0: IF XMC > 8 THEN XMC = 8
Pfoe0A:
  MC = MC + 1: df = 0
  IF MC > XMC THEN GOTO Pfoe2A
  IF m%(m, 11) = 3 THEN GOTO Pfoe1
'
' Unfriendly monsters find an enemy to attack
'
  IF t(3) = m%(0, 1) THEN GOTO Pfoe2
  FOR m2 = 1 TO nm
     IF m%(m2, 5) = ro AND m%(m2, 11) = 3 AND RND < .45 THEN
       df = m2: m2 = nm
     END IF
  NEXT m2: GOTO Pfoe2
'
' Friendly monsters pick an enemy
'
Pfoe1:
  FOR m2 = 1 TO nm
     IF m%(m2, 5) = ro AND m%(m2, 11) = 1 THEN
       df = m2
       IF df = nm OR RND(1) < .45 THEN m2 = nm
     END IF
  NEXT m2
  IF df = 0 THEN GOTO Pfoe2A
'
'  Send em' off to war
'
Pfoe2:
  GOSUB Battle
  IF die = 1 THEN GOTO EndGame
  IF t(1) > 0 THEN GOTO Pfoe0A
Pfoe2A:
  IF m < nm THEN GOTO Pfoe0
'
'  Every-round events
'
Pfoe3:
  m9 = 0
  FOR of = 1 TO nm
     IF m%(of, 5) = ro AND m%(of, 8) < 0 THEN GOSUB GetWep
  NEXT of
'
' Add your own special stuff here
'
  GOTO Main
'---------------------------------------------------------------------------
' ****  Move commands ****
'
Move:
  r2 = r%(ro, c)
  IF t(1) AND (nl > 0 OR lt > 0) THEN
    PRINT "You can't do that with unfriendlies about!": GOTO Main0
  END IF
MoveCheck:
  IF r2 > 1000 THEN GOTO Move1
  IF r2 > 0 AND r2 <= nr THEN GOTO Move2
'
' Add special (negative) moves here
'
  IF r2 = -998 THEN
    PRINT "Leave this place?"; : GOSUB AtFr1
    IF s$ <> "y" THEN GOTO Main
    GOTO Init1
  END IF
  IF r2 = -999 THEN
    PRINT "You successfully ride off into the sunset."
    DI = 0: GOTO EndGame
  END IF
  PRINT "You can't go that way!": GOTO Main0
'
' Doors/Gates
'
Move1:
  a = r2 - 1000
  IF a%(a, 6) = 0 AND a%(a, 7) = 0 AND a%(a, 8) = 0 THEN
    r2 = a%(a, 5): GOTO MoveCheck
  END IF
  IF a%(a, 8) = 1 AND a%(a, 0) = 0 THEN
    PRINT "You can't go that way!": GOTO Main0
  END IF
  PRINT "The "; a$(a); " blocks the way!": GOTO Main0
'
' Go to another room
'
Move2:
'===================
  d%(5) = 1
'===================
  IF ls > 0 AND ls <= na THEN
    IF a%(ls, 4) <> -1 THEN ls = 0
  END IF
  r3 = ro: ro = r2: GOSUB EnemyCheck
  nl = r%(ro, 11): lt = ABS(nl OR ls): nx = 0
  FOR a = 1 TO nd
     nx = nx + ABS(r%(ro, a) > 0 AND r%(ro, a) <= nr AND r%(ro, a) <> ro)
  NEXT
  IF nl > 0 AND ls > 0 THEN
    PRINT "It's not dark here.  Extinguish "; a$(ls); : GOSUB AtFr1
    IF s$ = "y" THEN ls = 0
  END IF
  GOTO Main
'---------------------------------------------------------------------------
' **** Flee command ****
'
Flee:
  IF t(1) = 0 THEN
    PRINT "Calm down.": GOTO Main0
  END IF
  IF nx = 0 THEN
    PRINT "There's no place to run!": GOTO Main0
  END IF
'====================================================
  IF m%(12, 5) = ro THEN
    PRINT "The mimic holds you tightly and you cannot flee!": GOTO Pfoe
  END IF
'====================================================
  IF s$ <> "" THEN GOTO Flee2
Flee0:
  GOSUB Flee1: GOTO Move2
Flee1:
  r2 = r%(ro, nd * RND + 1)
  IF r2 < 1 OR r2 > nr OR r2 = ro THEN GOTO Flee1
  RETURN
Flee2:
  r2 = 0
  FOR a = 1 TO nd
     IF LEFT$(c$(a), LEN(s$)) = s$ THEN r2 = r%(ro, a)
  NEXT
  IF r2 = 0 THEN GOTO Flee0
  IF r2 = -998 THEN PRINT "You don't get away!": GOTO Lp12
  GOTO MoveCheck
'---------------------------------------------------------------------------
' **** Close command ****
'
ItemClose:
  GOSUB CheckSub: GOSUB Asearch0: IF f = 0 THEN GOTO Err1
  IF a%(a, 2) <> 4 THEN PRINT "You can't close it.": GOTO Main0
  IF a%(a, 6) = 0 THEN
    PRINT "It's not open.": GOTO Main0
  END IF
  PRINT UCASE$(LEFT$(a$(a), 1)); MID$(a$(a), 2); " closed."
  a%(a, 6) = 0: GOTO Lp12
'---------------------------------------------------------------------------
' **** Drink & Eat commands ****
'
Drink:
  GOSUB CheckSub: GOSUB Asearch0: IF f = 0 THEN GOTO Err3
'===========================================================================
  IF a = 14 OR a = 7 THEN
    PRINT a$(a); " swallowed.": GOSUB Lp4: d%(9) = d%(9) + 100
    IF a%(a, 4) = -1 THEN wt = wt - a%(a, 3)
    a%(a, 4) = 0: PRINT "You lungs suddenly feel very strange...": GOTO Lp12
  END IF
  IF a = 15 THEN
    PRINT "You get a full breath of air.": IF a%(a, 4) = -1 THEN wt = wt - a%(a, 3)
    IF d%(9) < 2 * m%(0, 1) THEN d%(9) = m%(0, 1)
    a%(a, 4) = 0: GOTO Lp12
  END IF
  IF a = 22 THEN
    PRINT "You forget everything you have ever learned about weapons!"
    wa%(1) = 5: wa%(2) = -10: wa%(3) = 20: wa%(4) = 10: wa%(5) = 0
    IF a%(a, 4) = -1 THEN wt = wt - a%(a, 3)
    a%(a, 4) = 0: GOTO Lp12
  END IF
'===========================================================================
  IF a%(a, 2) <> 6 AND a%(a, 2) <> 9 THEN s$ = "that": GOTO Err3
  IF a%(a, 7) = 0 THEN GOTO Err2
  IF a%(a, 6) < 1 THEN PRINT "There's none left.": GOTO Lp12
  a%(a, 6) = a%(a, 6) - 1
  IF a%(a, 6) = 0 AND a%(a, 2) = 9 THEN
    PRINT "You eat it all up.": GOSUB Lp4
    wt = wt - a%(a, 3) * (a%(a, 4) = -1): a%(a, 4) = 0
  END IF
  m%(0, 13) = m%(0, 13) - a%(a, 5): IF m%(0, 13) < 0 THEN m%(0, 13) = 0
  PRINT "You feel "; MID$("betterworse", (a%(a, 5) < 0) * 6 + 1, 6); "!"
  GOSUB Lp4: df = 0: D2 = 0: GOSUB Mstatus: GOTO Pfoe
'---------------------------------------------------------------------------
'  **** Drop command ****
'
Drop:
  IF lt = 0 THEN GOTO Main
  GOSUB CheckSub: IF s$ = "all" THEN GOTO Drop1
  GOSUB Asearch
  IF f = 0 THEN
      ha = -999: wh = ha: EM = ha: GOSUB Asearch2: IF f = 0 THEN GOTO Err1
      GOTO Give
  END IF
  GOSUB Drop2: GOTO Pfoe
Drop1:
  FOR a = 1 TO na
     IF a%(a, 4) = -1 THEN GOSUB Drop2
  NEXT a
  wt = 0: m%(0, 8) = -1: GOSUB Lp4: GOTO Pfoe
Drop2:
  IF a = m%(0, 8) THEN m%(0, 8) = -1
  wt = wt - a%(a, 3): a%(a, 4) = ro
  PRINT UCASE$(LEFT$(a$(a), 1)); MID$(a$(a), 2); " dropped.": GOSUB Lp2
  IF a = ls THEN
    ls = 0: lt = nl: GOSUB Lp1
    PRINT "The "; a$(a); " goes out.": GOTO Lp4
  END IF
  RETURN
'---------------------------------------------------------------------------
'  **** Examine command ****
'
examine:
  IF lt = 0 THEN GOTO Main
  GOSUB CheckSub: GOSUB Asearch0: IF f = 0 THEN GOTO Examine1
'
' Examine artifact
'
  IF a%(a, 4) = EM THEN a%(a, 4) = ro
  IF a%(a, 2) = 8 THEN a%(a, 8) = 0
  IF a > naf THEN
    PRINT "This is your "; a$(a); ".": GOTO Lp12
  END IF
  IF a%(a, 2) = 12 THEN GOSUB ItemGet3: GOTO Main
  r = a + 400: GOSUB DiskRead: a%(a, 0) = 1
  IF a%(a, 2) = 6 OR a%(a, 2) = 9 THEN
    PRINT "There "; MID$("are is ", ABS(a%(a, 6) = 1) * 4 + 1, 4);
    PRINT LTRIM$(RTRIM$(STR$(a%(a, 6)))); " ";
    PRINT MID$("swallowbite", ABS(a%(a, 2) = 9) * 7 + 1, 7);
    PRINT MID$("s", ABS(a%(a, 6) = 1) * 1 + 1, 1);
    PRINT " left.": GOSUB Lp4
  END IF
  GOTO Pfoe
'
' Examine monster
'
Examine1:
  GOSUB Msearch
  IF f = 0 THEN
    ha = -999: wh = ha: EM = ha: GOSUB Asearch2
    IF f = 0 THEN
      PRINT "You see nothing special.": GOTO Lp12
    END IF
    PRINT "This is your "; a$(a); ".": GOTO Lp12
  END IF
  r = m + 800: GOSUB DiskRead: df = m: D2 = 0
  IF m%(m, 3) > 1 AND m%(m, 13) = 0 THEN
    a$ = "They are ": GOSUB Ms1: GOTO Pfoe
  END IF
  GOSUB Mstatus: GOTO Pfoe
'---------------------------------------------------------------------------
'  **** Get command ****
'
ITEMGET:
  IF lt = 0 THEN GOTO Main
  GOSUB CheckSub: IF s$ = "all" THEN GOTO ItemGet2
  ha = ro: GOSUB Asearch2: IF f = 0 THEN GOTO Err3
  IF db > 0 AND a >= db AND a <= naf THEN
    PRINT "Dead bodies are best if left alone.": GOTO Main0
  END IF
  GOSUB ItemGet3: GOSUB Lp4: GOTO Pfoe
'
' Get all possible items in room
'
ItemGet2:
  FOR a = 1 TO na
     IF a%(a, 4) = ro THEN
       IF db > 0 AND a >= db AND a <= naf THEN GOTO ItemGet2A
       IF a%(a, 3) > 900 THEN
         PRINT UCASE$(LEFT$(a$(a), 1)); MID$(a$(a), 2); ": ";
       END IF
       IF a%(a, 3) <> -999 THEN GOSUB ItemGet3
     END IF
ItemGet2A:
  NEXT a: GOTO Pfoe
ItemGet3:
  IF a%(a, 2) = 12 THEN
    'PRINT UCASE$(LEFT$(a$(a), 1)); MID$(a$(a), 2); " is alive!": GOSUB Lp4
    IF a%(a, 6) > 0 THEN r = a%(a, 6): GOSUB Effect
     a%(a, 4) = 0: m%(a%(a, 5), 5) = ro: r3 = ro: GOTO EnemyCheck
  END IF
  IF a%(a, 3) > 900 THEN
    PRINT "Don't be absurd.": GOTO Lp2
  END IF
  IF a%(a, 3) = -999 THEN
    PRINT "You can't get that.": GOTO Lp2
  END IF
  PRINT UCASE$(LEFT$(a$(a), 1)); MID$(a$(a), 2); " ";
  IF wt + a%(a, 3) > 10 * m%(0, 1) THEN
    PRINT "is too heavy.": GOTO Lp2
  END IF
  IF a%(a, 2) = 10 THEN
    PRINT "must be freed.": GOTO Lp2
  END IF
  PRINT "taken.": a%(a, 4) = -1: wt = wt + a%(a, 3)
  IF m%(0, 8) < 1 THEN
    IF a%(a, 2) = 2 OR a%(a, 2) = 3 THEN
      m%(0, 8) = a: GOSUB Lp2: PRINT a$(a); " readied."
    END IF
  END IF
  GOTO Lp2
'---------------------------------------------------------------------------
' **** Light command ****
'
Light:
  GOSUB CheckSub: GOSUB Asearch0: IF f = 0 THEN GOTO Err1
  IF a%(a, 2) <> 5 OR a%(a, 5) = 0 THEN
    PRINT "It won't light!": GOTO Lp12
  END IF
  lt = 1: ls = a: PRINT "You've lit the "; a$(a); ".": GOTO Lp12
'---------------------------------------------------------------------------
' **** Open command ****
'
ItemOpen:
  IF lt = 0 THEN GOTO Main
  GOSUB CheckSub: GOSUB Asearch0: IF f = 0 THEN GOTO Err1
  m = a%(a, 2): IF m = 8 THEN GOTO DoorOpen
  IF m = 12 THEN GOSUB ItemGet3: GOTO Pfoe
  IF m <> 4 AND m <> 6 AND m <> 7 AND m <> 9 THEN
    s$ = a$(a): GOTO Err3
  END IF
  IF a%(a, 4) = EM THEN a%(a, 4) = ro
  k = a%(a, 5): r = a%(a, 7): IF m = 4 THEN r = a%(a, 6)
  IF r = 1 THEN PRINT "It's already open.": GOTO Lp12
'
  IF m = 6 OR m = 7 OR m = 9 THEN
    a%(a, 7) = 1: a$ = "You've opened the " + a$(a) + ".": GOTO Lp9
  END IF
'
  IF k > 0 AND k <= naf THEN
    IF a%(k, 4) <> -1 AND a%(k, 4) <> ro THEN
      PRINT "It's locked.": GOTO Lp12
    END IF
  END IF
  IF a%(a, 6) > 1 THEN
    PRINT "It's locked.": GOTO Lp12
  END IF
  a%(a, 5) = 0: a%(a, 6) = 1
  PRINT UCASE$(LEFT$(a$(a), 1)); MID$(a$(a), 2); " opened.": GOSUB Lp2
  GOSUB Inv4: GOTO Pfoe
'
DoorOpen:
  a%(a, 4) = ro: k = a%(a, 6)
  IF a%(a, 7) = 0 THEN PRINT "It's already open.": GOTO Lp12
'
  IF k > 0 AND k <= naf THEN
    IF a%(k, 4) <> -1 AND a%(k, 4) <> ro THEN
      PRINT "It's locked.": GOTO Lp12
    END IF
    a$ = "You open it with the " + a$(k) + ".": GOTO DoorOpen1
  END IF
'
  IF a%(a, 7) > 1 THEN
    PRINT "You'll have to force it open.": GOTO Lp12
  END IF
  IF k = -1 THEN PRINT "It won't open.": GOTO Lp12
  a$ = "You've opened the " + a$(a) + "."
DoorOpen1:
  a%(a, 6) = 0: a%(a, 7) = 0: GOTO Lp9
'---------------------------------------------------------------------------
' **** Put command ****
'
ItemPut:
  IF lt = 0 THEN GOTO Main
  GOSUB CheckSub: GOSUB Asearch0: IF f = 0 THEN GOTO Err1
  a$ = "Put it in what": GOSUB CheckSub2: s$ = s2$
  GOSUB ItemTake: IF a%(a, 4) <> -1 THEN GOTO Main
  m = a: GOSUB Asearch0: s$ = "anything in that": IF f = 0 THEN GOTO Err1
  IF a = m OR a%(a, 2) <> 4 THEN GOTO Err3
  IF a%(a, 6) = 0 THEN GOTO Err2
  IF a%(a, 8) < 1 THEN
    PRINT "You don't need to.": GOTO Lp12
  END IF
  IF a%(a, 7) >= a%(a, 8) THEN
    PRINT "It's full.": GOTO Lp12
  END IF
  IF a%(m, 3) > a%(a, 3) THEN
    PRINT "It won't fit.": GOTO Lp12
  END IF
  f = 0
  FOR k = 1 TO na
     IF a%(k, 4) = 1000 + a THEN f = f + a%(k, 3)
  NEXT
  IF f + a%(m, 3) > a%(a, 3) THEN
    PRINT "It's full.": GOTO Lp12
  END IF
  wt = wt - ABS(a%(m, 4) = -1) * a%(m, 3)
  IF m = m%(0, 8) THEN m%(0, 8) = -1
  a%(m, 4) = a + 1000: a%(a, 7) = a%(a, 7) + 1
  IF m = ls THEN
    ls = 0: lt = nl: GOSUB Lp1
    PRINT "(The "; a$(m); " goes out.)": GOSUB Lp4
  END IF
  PRINT "Done.": GOTO Lp12
'---------------------------------------------------------------------------
' **** Read command ****
'
ItemRead:
  IF lt = 0 THEN GOTO Main
  GOSUB CheckSub: GOSUB Asearch0
  IF f = 0 THEN
    s$ = "that": GOTO Err3
  END IF
  IF a%(a, 2) <> 7 THEN
    s$ = a$(a): GOTO Err3
  END IF
  IF a%(a, 7) = 0 THEN GOTO Err2
  COLOR 2
  r = a%(a, 5): GOSUB Effect
  COLOR 3: GOTO Pfoe
'---------------------------------------------------------------------------
' **** Ready command ****
'
Ready:
  GOSUB CheckSub: GOSUB Asearch0: IF f = 0 THEN GOTO Err1
  IF a%(a, 2) <> 2 AND a%(a, 2) <> 3 THEN
    PRINT "That isn't a weapon!": GOSUB Lp2: GOTO Main
  END IF
  GOSUB ItemTake: IF a%(a, 4) <> -1 THEN GOTO Main
  m%(0, 8) = a: w2 = a%(a, 6)
  PRINT UCASE$(LEFT$(a$(a), 1)); MID$(a$(a), 2); " readied.": GOSUB Lp2
  GOTO Pfoe
'---------------------------------------------------------------------------
' **** Remove command ****
'
'    Remove armor
'
Remove:
  GOSUB CheckSub: ha = -999: wh = ha: EM = ha: GOSUB Asearch2
  IF f = 0 THEN GOTO Remove1
  IF a = sh THEN
    m%(0, 7) = m%(0, 7) - 1: sh = 0
  END IF
  IF a = ar THEN
    m%(0, 7) = m%(0, 7) - a%(a, 5) / 2: ar = 0
  END IF
  a%(a, 4) = -1
  PRINT UCASE$(LEFT$(a$(a), 1)); MID$(a$(a), 2); " removed."
  GOTO Pfoe
'
' Remove items from a container
'
Remove1:
  IF lt = 0 THEN GOTO Main
  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 "I don't follow you.": GOTO Main0
  END IF
  IF a%(m, 6) = 0 THEN GOTO Err2
  GOSUB ItemTake: IF a%(a, 4) <> -1 THEN a%(a, 4) = ro
  a%(m, 7) = a%(m, 7) - 1: IF a%(m, 7) < 0 THEN a%(m, 7) = 0
  PRINT "Okay.": GOTO Pfoe
'---------------------------------------------------------------------------
' **** Use command ****
'
' Put your own special stuff here
'
Use:
  IF lt = 0 THEN GOTO Main
  GOSUB CheckSub: PRINT "Try another command.": GOTO Lp12
'---------------------------------------------------------------------------
' **** Wear command ****
'
Wear:
  GOSUB CheckSub: ha = -1: wh = ro: EM = -999: GOSUB Asearch2
  IF f = 0 THEN GOTO Err1
  IF a%(a, 4) = ro THEN
    GOSUB ItemTake: IF a%(a, 4) <> -1 THEN GOTO Main
  END IF
  IF a%(a, 2) <> 11 THEN
    s$ = "that": GOTO Err3
  END IF
  IF a%(a, 4) = EM THEN GOTO Wear2
  IF a%(a, 5) = 0 THEN GOTO Wear1
  IF a%(a, 5) = 1 AND sh > 0 THEN GOTO Wear2
  IF a%(a, 5) = 1 THEN
    sh = a: m%(0, 7) = m%(0, 7) + 1: GOTO Wear1
  END IF
  IF ar <> 0 THEN GOTO Wear2
  ar = a: m%(0, 7) = m%(0, 7) + a%(a, 5) / 2
Wear1:
  a%(a, 4) = -999
  PRINT UCASE$(LEFT$(a$(a), 1)); MID$(a$(a), 2); " worn."
  GOTO Pfoe
Wear2:
  PRINT "You're already wearing armor of that type!": GOTO Main0
'---------------------------------------------------------------------------
'  **** Attack command ****
'
Attack:
  IF m%(0, 8) < 1 THEN
    PRINT "You must first ready a weapon!": GOTO Main0
  END IF
  GOSUB CheckSub:  GOSUB Msearch: ta = 0: IF f THEN GOTO AttackMon
'
'  Attack/blast open a door or container
'
AttackItem:
  IF lt = 0 THEN GOTO Main
  ha = ro: GOSUB Asearch1: IF f = 0 THEN GOTO Err4
  IF db > 0 AND a >= db AND a <= naf THEN
    PRINT "You hack the body to bits!": a%(a, 4) = 0: GOTO Pfoe
  END IF
  m = a%(a, 2)
  IF m = 12 THEN
    GOSUB ItemGet3: m = a%(a, 5): GOTO AttackMon
  END IF
  IF m <> 4 AND m <> 8 THEN
    a$ = "Why would you attack a " + a$(a) + "?": GOSUB Lp0: GOTO Main
  END IF
  IF (m = 8 AND a%(a, 7) < 100) OR (m = 4 AND a%(a, 6) < 100) THEN
    PRINT "Nothing happens.": GOTO Lp12
  END IF
  w = m%(0, 8): d = a%(w, 7): s = a%(w, 8): x = 7: k = 6: D2 = 0
  IF ta = 1 THEN
    d = 2: s = 5
  END IF
  IF m = 4 THEN
    x = 6: k = 5
  END IF
  FOR a2 = 1 TO d
     D2 = D2 + INT(RND * s) + 1
  NEXT
  a$ = "Wham!  You " + MID$("hitblast", ta * 3 + 1, 3 + ta * 2)
  a$ = a$ + " the " + a$(a) + "!": GOSUB Lp10
  a%(a, x) = a%(a, x) - D2
  IF a%(a, x) < 100 THEN
    a%(a, x) = 1: a%(a, k) = 0: a$ = "The " + a$(a) + " shatters open!"
    IF m = 8 THEN
      a%(a, 6) = 0: a%(a, 7) = 0
    END IF
    GOTO Lp9
  END IF
  GOTO Pfoe
'
' Attack a monster
'
AttackMon:
  IF m%(m, 11) <> 1 THEN GOSUB AtFr: IF s$ <> "y" THEN GOTO Main
  IF m%(m, 11) = 2 THEN
    a$ = m$(m) + " get's angry!": GOSUB Lp10
  END IF
  of = 0: df = m: up = 0: GOSUB Battle
  IF die = 1 THEN GOTO EndGame
  IF hi = 1 AND up = 1 THEN
    w2 = a%(m%(0, 8), 6)
    a$ = m$(0) + MID$("'s'", ABS(LCASE$(RIGHT$(m$(0), 1)) = "s") * 2 + 1, 2)
    a$ = a$ + " " + wp$(w2) + " ability just increased!"
    wa%(w2) = wa%(w2) + 1: GOSUB Lp0: GOSUB Lp1
  END IF
  IF m%(df, 11) = 1 OR df = 0 THEN GOTO Pfoe
  m%(df, 11) = m%(df, 11) - 1
  r3 = ro: GOSUB EnemyCheck: GOTO Pfoe
'---------------------------------------------------------------------------
' **** Free command ****
'
Free:
  IF lt = 0 THEN GOTO Main
  GOSUB CheckSub: GOSUB Asearch0: IF f = 0 THEN GOTO Err4
  IF a%(a, 2) <> 10 THEN GOTO Err3
  m = a%(a, 5): k = a%(a, 6): w = a%(a, 7)
  IF w > 0 AND w <= nm THEN
    IF m%(w, 5) = ro THEN
      PRINT m$(w); " won't let you!": GOTO Lp12
    END IF
  END IF
  IF k > 0 AND k <= naf THEN
    IF a%(k, 4) <> -1 AND a%(k, 4) <> ro THEN
      PRINT "You don't have the key.": GOTO Lp12
    END IF
  END IF
  a$ = "You have freed " + m$(m)
  IF k > 0 AND k <= naf THEN a$ = a$ + " with the " + a$(k)
  a$ = a$ + ".": GOSUB Lp0
  m%(m, 5) = ro: a%(a, 4) = 0: r3 = ro
  GOSUB EnemyCheck: GOTO Pfoe
'---------------------------------------------------------------------------
' **** Give command ****
'
Give:
  IF lt = 0 THEN GOTO Main
  GOSUB CheckSub: k = ABS(INT(VAL(s$)))
  IF k = 0 THEN
    GOSUB Asearch0
    IF f = 0 THEN
      ha = -999: wh = ha: EM = ha: GOSUB Asearch2: IF f = 0 THEN GOTO Err1
      PRINT "You're wearing it.  "; q$; "REMOVE"; q$; " it first.": GOTO Main0
    END IF
    GOSUB ItemTake: IF a%(a, 4) <> -1 THEN GOTO Main
  END IF
  a$ = "To whom": GOSUB CheckSub2
  s$ = s2$: GOSUB Msearch: IF f = 0 THEN GOTO Err4
  IF k = 0 THEN GOTO Give1
'
' Give money
'
GiveMoney:
  s2$ = "": a$ = "Give " + LTRIM$(STR$(k)) + "GP to "
  a$ = a$ + m$(m) + " (Y/N)": GOSUB CheckSub2
  s2$ = LEFT$(s2$, 1): IF s2$ <> "y" AND s2$ <> "n" THEN GOTO GiveMoney
  IF s2$ = "n" THEN GOTO Main
  IF gold < k THEN PRINT "You only have"; gold; "gold pieces.": GOTO Main0
  gold = gold - k: a$ = m$(m) + " takes the money.": GOSUB Lp10
  IF m%(m, 11) = 2 AND k >= 5000 THEN
    m%(m, 11) = 3: GOSUB Smile1
  END IF
  GOTO Give2
'
' Give an item
'
Give1:
  a$ = "You give the " + a$(a) + " to " + m$(m) + ".": GOSUB Lp0: GOSUB Lp1
  IF a = m%(0, 8) THEN m%(0, 8) = -1
  IF a%(a, 2) = 6 THEN
    IF m%(m, 13) > 0 AND a%(a, 6) > 0 THEN GOTO GiveDrink
  END IF
  wt = wt - a%(a, 3) * (a%(a, 4) = -1)
  a%(a, 4) = -m - 1
  IF m%(m, 8) < 0 THEN
    IF a%(a, 2) = 2 OR a%(a, 2) = 3 THEN
      m%(m, 8) = a: a$ = m$(m) + " readies " + a$(a) + ".": GOSUB Lp0
    END IF
  END IF
  IF m%(m, 11) < 3 THEN m%(m, 11) = 100 + m%(m, 11) * (30 + a%(a, 1) / 100)
Give2:
  r3 = ro: GOSUB EnemyCheck: GOTO Pfoe
'
' Give something drinkable
'
GiveDrink:
  a$ = m$(m) + " takes a drink and hands it back to you.": GOSUB Lp0
  GOSUB Lp1: a%(a, 6) = a%(a, 6) - 1
  IF m%(m, 11) < 3 THEN m%(m, 11) = 140 + 60 * m%(m, 13) / m%(m, 1)
  m%(m, 13) = m%(m, 13) - a%(a, 5): IF m%(m, 13) < 0 THEN m%(m, 13) = 0
  df = m: D2 = 0: GOSUB Mstatus: GOTO Give2
'---------------------------------------------------------------------------
' **** Request command ****
'
Request:
  IF lt = 0 THEN GOTO Main
  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
    PRINT m$(m); " doesn't have it.": GOTO Main0
  END IF
  IF m%(m, 11) < 3 THEN
    GOSUB Smile1: GOTO Pfoe
  END IF
  PRINT "Okay.": GOSUB Lp4
  GOSUB ItemGet3
  IF a%(a, 4) = -1 THEN
    IF a = m%(m, 8) THEN m%(m, 8) = -1
    IF a%(a, 0) = 0 THEN
      a%(a, 0) = 1: GOSUB Lp1: r = a + 400: GOSUB DiskRead
    END IF
  END IF
  GOTO Pfoe
'---------------------------------------------------------------------------
' **** Smile command ****
'
Smile:
  IF lt = 0 THEN GOTO Main
  FOR m = 1 TO nm
     IF m%(m, 5) = ro THEN GOSUB Smile1
  NEXT: GOTO Pfoe
Smile1:
  PRINT m$(m); : IF m%(m, 3) > 1 THEN PRINT "s";
  IF m%(m, 11) = 2 THEN
    PRINT " "; sm$(2); : IF m%(m, 3) > 1 THEN PRINT " you."
    IF m%(m, 3) = 1 THEN PRINT "s you."
    GOSUB Lp2: RETURN
  END IF
  PRINT " "; sm$(m%(m, 11)); : IF m%(m, 3) = 1 THEN PRINT "s";
  PRINT " at you.": GOSUB Lp2: RETURN
'---------------------------------------------------------------------------
' **** Inventory command ****
'
Inventory:
  IF s$ = "" THEN GOTO Inv1
  IF lt = 0 THEN GOTO Main
  GOSUB CheckSub: GOSUB Msearch: IF f = 0 THEN GOTO Err4
  IF m%(m, 11) = 3 THEN GOTO Inv2
  GOSUB Smile1: GOTO Pfoe
Inv1:
  m = 0: m2 = 0: PRINT m$(m); " is wearing:": GOSUB Lp4
  FOR a = 1 TO na
     IF a%(a, 4) = -999 THEN
       PRINT " "; UCASE$(LEFT$(a$(a), 1)); MID$(a$(a), 2)
       m2 = 1: GOSUB Lp2
     END IF
  NEXT
  IF m2 = 0 THEN PRINT " (No armor)": GOSUB Lp2
  GOSUB Lp1
Inv2:
  f = 0: PRINT m$(m); " is carrying:": GOSUB Lp4
  ha = -m - 1: wh = -m - 1000: IF m = 0 THEN wh = ha
  FOR a = 1 TO na
     IF a%(a, 4) = ha OR a%(a, 4) = wh THEN
       PRINT " "; UCASE$(LEFT$(a$(a), 1)); MID$(a$(a), 2);
       IF m > 0 AND a%(a, 4) = wh THEN PRINT "  (Being worn)";
       IF a = m%(m, 8) THEN PRINT "  [Ready Weapon]";
       IF a = ls THEN PRINT "  (Providing light)";
       IF a%(a, 2) = 4 THEN GOSUB Inv3
       f = 1: GOSUB Lp1
     END IF
  NEXT
  IF f = 0 THEN
    PRINT " (Nothing)": GOSUB Lp4
  END IF
  IF m = 0 THEN
    PRINT LTRIM$(STR$(gold)); " gold pieces": GOSUB Lp4
  END IF
  df = m: D2 = 0: GOSUB Mstatus: GOTO Pfoe
'
' Show items inside of container
'
Inv3:
  IF a%(a, 6) <> 1 THEN
    PRINT "  (Closed)"; : RETURN
  END IF
  GOSUB Lp1
Inv4:
  m2 = 0: PRINT "(This contains:)": GOSUB Lp2: of = 0
  FOR a2 = 1 TO na
     IF a%(a2, 4) = a + 1000 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
  END IF
  RETURN
'---------------------------------------------------------------------------
' **** Status command ****
'
Status:
  CLS : L = 0
  FOR a = 1 TO 4
     sa$(a) = LTRIM$(STR$(sa%(a))) + "%": sp$(a) = LTRIM$(STR$(sp%(a))) + "%"
  NEXT
  IF sex < 0 OR sex > 1 THEN sex = 0
  PRINT "Name: "; LEFT$(m$(0), 32); : LOCATE CSRLIN, 40
  PRINT "Sex: "; sex$(sex); : LOCATE CSRLIN, 55
  a$ = STR$(m%(0, 13)) + "/" + LTRIM$(STR$(m%(0, 1)))
  PRINT "Damage Taken:"; a$: PRINT
  PRINT "Hardiness: "; m%(0, 1): LOCATE 3, 20: PRINT "Agility: "; m%(0, 2)
  LOCATE 3, 37: PRINT "Charisma: "; ch;
  PRINT "   (Charm Mon:"; : a = (ch - 10) * 2: a$ = LTRIM$(STR$(a)) + "%)"
  PRINT MID$("+", ABS((a < 1)) * 1 + 1, 1); a$: PRINT
  PRINT "Weapon Abilities:"; : LOCATE 5, 41: PRINT "Spell Abilities:"
  PRINT "1. Axe:  "; wa%(1);
  LOCATE 6, 42: PRINT "Blast.."; : a = 1: GOSUB Status1
  PRINT "2. Bow:  "; wa%(2);
  LOCATE 7, 42: PRINT "Heal..."; : a = 2: GOSUB Status1
  PRINT "3. Mace: "; wa%(3);
  LOCATE 8, 42: PRINT "Speed.."; : a = 3: GOSUB Status1
  PRINT "4. Spear:"; wa%(4);
  LOCATE 9, 42: PRINT "Power.."; : a = 4: GOSUB Status1
  PRINT "5. Sword:"; wa%(5); : LOCATE 10, 24: PRINT "Gold:"; gold
  LOCATE 10, 56: PRINT "In bank:"; bank: PRINT
  PRINT "Armor: ";
  IF ar > 1 AND ar <= na THEN PRINT UCASE$(LEFT$(a$(ar), 1)); MID$(a$(ar), 2);
  IF sh > 1 AND sh <= na AND ar > 1 AND ar <= na THEN PRINT " & ";
  IF sh > 1 AND sh <= na THEN PRINT UCASE$(LEFT$(a$(sh), 1)); MID$(a$(sh), 2);
  a$ = RTRIM$(STR$(ae)) + "%"
  PRINT : LOCATE 12, 41: PRINT "  Armor Expertise: "; a$
  PRINT : PRINT "Weight Carryable:"; m%(0, 1) * 10; "Gronds  (";
  a$ = LTRIM$(RTRIM$(STR$(a * 10))): PRINT a$; " Dos)": LOCATE 14, 43
  s$ = LTRIM$(RTRIM$(STR$(wt))): PRINT "  Weight carried:"; wt; "Gronds"
  IF ro < 34 AND ro > 22 THEN
    COLOR 2: PRINT : PRINT "Number of breaths left:"; d%(9): COLOR 3
  END IF
  LOCATE 22: GOSUB Lp6: CLS : LOCATE 24: GOTO Main
Status1:
  m = sa%(a)
  PRINT LEFT$("...", ABS(m < 1000) + ABS(m < 100) + ABS(m < 10));
  IF m <> sp%(a) THEN COLOR 2
  PRINT sa$(a); : COLOR 3: PRINT " / "; sp$(a)
  RETURN
'---------------------------------------------------------------------------
'  **** Look command ****
'
Look:
  IF lt = 0 THEN GOTO Main
  r = ro: GOSUB DiskRead: GOTO Pfoe
'---------------------------------------------------------------------------
' **** 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 Pfoe
'---------------------------------------------------------------------------
' **** Blast command ****
'
Blast:
  s = 1: GOSUB SpellCast: IF SUC = 0 THEN GOTO Pfoe
  GOSUB CheckSub: GOSUB Msearch: ta = 1: IF f = 0 THEN GOTO AttackItem
  IF m%(m, 11) <> 1 THEN
    GOSUB AtFr: IF s$ <> "y" THEN GOTO Main
    m%(m, 11) = m%(m, 11) - 1
    IF m%(m, 11) = 1 THEN
      a$ = m$(m) + " get's angry!": GOSUB Lp10
    END IF
    r3 = ro: GOSUB EnemyCheck
  END IF
  PRINT "ZAP!  Direct hit!": GOSUB Lp4
  s = 5: d = 2: df = m: a = 0: GOSUB Damage0: GOTO Pfoe
'---------------------------------------------------------------------------
' **** Heal command ****
'
Heal:
  s = 2: GOSUB SpellCast: m = 0: IF SUC = 0 THEN GOTO Pfoe
  IF s$ <> "" THEN GOSUB Msearch: IF f = 0 THEN GOTO Err4
  IF m%(m, 13) > 0 THEN
    a$ = m$(m) + MID$("'s'", ABS(LCASE$(RIGHT$(m$(0), 1)) = "s") * 2 + 1, 2)
    a$ = a$ + " health improves!": GOSUB Lp0
    m%(m, 13) = m%(m, 13) - 3 - 10 * RND
    IF m%(m, 13) < 0 THEN m%(m, 13) = 0
  END IF
  df = m: D2 = 0: GOSUB Mstatus: GOTO Pfoe
'---------------------------------------------------------------------------
' **** Speed command ****
'
Speed:
  s = 3: GOSUB SpellCast: IF SUC = 0 THEN GOTO Pfoe
  IF Speed <> 0 THEN PRINT "Nothing happened.": GOTO Lp12
  m%(0, 2) = m%(0, 2) * 2: Speed = INT(RND * 10 + 26)
  PRINT "Your agility temporarily increases!"
  GOTO Lp12
'---------------------------------------------------------------------------
' **** Power command ****
'
Power:
  s = 4: GOSUB SpellCast: IF SUC = 0 THEN GOTO Pfoe
'
' Add your own power spell effects here
'
  PRINT "You hear a loud sonic boom which echoes all around you!"
  GOTO Lp12
'---------------------------------------------------------------------------
' **** Hints command ****
'
Hints:
  PRINT "Your question?": GOSUB Lp4
  FOR r = 1 TO nh
     PRINT r; "- "; h$(r): GOSUB Lp2
  NEXT
  GOSUB Lp1: LINE INPUT "Your choice?:"; a$: L = 0
  r = INT(VAL(a$)): a$ = h$(r): IF r < 1 OR r > nh THEN GOTO Main
  FOR m = 1 TO LEN(a$)
     IF LEFT$(a$, 1) = "." THEN a$ = MID$(a$, 2)
  NEXT
  GOSUB Lp1: COLOR 2: PRINT a$: COLOR 3: 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$ <> ""
       LOCATE CSRLIN, 1: PRINT "               "; : LOCATE CSRLIN, 1: L = 0
       IF s$ <> "y" THEN m = a
     END IF
  NEXT
  CLOSE #2: GOTO Main0
'---------------------------------------------------------------------------
' **** Save game ****
'
GameSave:
  GOSUB GameSave0: GOTO Main
GameSave0:
  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 m; " - "; gm$(m): GOSUB Lp2
  NEXT: PRINT 6; " - (Don't save, return to game)": GOSUB Lp2: GOSUB Lp1
  INPUT "Enter 1-6 for saved position:"; a$
  m = INT(VAL(a$))
  IF m < 1 OR m > 6 THEN GOTO GameSave
  IF m = 6 THEN RETURN
  IF m > a + 1 THEN
    PRINT "Use #"; a + 1; "first.": GOSUB Lp4: GOTO GameSave
  END IF
  IF m = a + 1 THEN a = a + 1
  IF gm$(m) <> "(none)" THEN
    PRINT "Enter a new description for save?"; : GOSUB AtFr1
    IF s$ <> "y" THEN GOTO GameSave1
  END IF
  PRINT "Enter new description:": GOSUB Lp4
  LINE INPUT "-->"; gm$(m): L = 1
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
     FOR a = 0 TO 15
        PRINT #2, m%(m, a)
     NEXT
  NEXT
  FOR r = 1 TO nr
     FOR m = 0 TO 11
        PRINT #2, r%(r, m)
     NEXT
  NEXT
  FOR a = 1 TO 4
     PRINT #2, f(a), t(a), sa%(a), sp%(a)
  NEXT
  FOR a = 1 TO 5
     PRINT #2, wa%(a)
  NEXT
  FOR a = 1 TO 200
     PRINT #2, d%(a)
  NEXT
'===========================================================================
  FOR a = 0 TO 15
     FOR m = 0 TO 15
       PRINT #2, sc%(1, a, m)
     NEXT
  NEXT
  FOR a = 0 TO 15
     FOR m = 0 TO 15
       PRINT #2, sc%(2, a, m)
     NEXT
  NEXT
'===========================================================================
  PRINT #2, ac, ae, ar, bank, ch, die, ea, gold, ls, lt, nl, r3, ro, SE, sh
  PRINT #2, Speed, wt
  CLOSE #2
  PRINT "Game saved.": GOSUB Lp4
  RETURN
'---------------------------------------------------------------------------
' **** Restore saved game ****
'
GameRestore:
  GOSUB GameRestore0
  IF d%(5) = 1 THEN GOTO Move2
  GOTO Init1
GameRestore0:
  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 m; " - "; gm$(m): GOSUB Lp2
  NEXT: PRINT 6; " - (Don't restore, return to game)": GOSUB Lp2: GOSUB Lp1
  INPUT "Enter 1-6 to restore a position:"; a$
  m = INT(VAL(a$))
  IF m < 1 OR m > 6 THEN GOTO GameRestore
  IF m = 6 THEN
    IF die = 1 THEN GOTO Dead
    RETURN
  END IF
  IF m > a THEN
    PRINT "There is no saved game there.": GOSUB Lp4: GOTO GameRestore
  END IF
  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
     FOR a = 0 TO 15
        INPUT #2, m%(m, a)
     NEXT
  NEXT
  FOR r = 1 TO nr
     FOR m = 0 TO 11
        INPUT #2, r%(r, m)
     NEXT
  NEXT
  FOR a = 1 TO 4
     INPUT #2, f(a), t(a), sa%(a), sp%(a)
  NEXT
  FOR a = 1 TO 5
     INPUT #2, wa%(a)
  NEXT
  FOR a = 1 TO 200
     INPUT #2, d%(a)
  NEXT
'===========================================================================
  FOR a = 0 TO 15
     FOR m = 0 TO 15
       INPUT #2, sc%(1, a, m)
     NEXT
  NEXT
  FOR a = 0 TO 15
     FOR m = 0 TO 15
       INPUT #2, sc%(2, a, m)
     NEXT
  NEXT
'===========================================================================
  INPUT #2, ac, ae, ar, bank, ch, die, ea, gold, ls, lt, nl, r3, ro, SE, sh
  INPUT #2, Speed, wt
  CLOSE #2
  CZ$ = "": r2 = ro
  RETURN
'---------------------------------------------------------------------------
' **** Quit, leave the Eamon system ****
'
Quit:
  GOSUB Quit1: GOTO Main
Quit1:
  f = 0: 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 AtFr1
  IF s$ <> "y" THEN RETURN
  CLS : CHDIR "..": RUN "STARTUP.BAS"
  END
'---------------------------------------------------------------------------
' **** End of game routines ****
'
EndGame:
  GOSUB Lp1: GOSUB Lp6
  IF die = 0 THEN
    PRINT "Leave this adventure?"; : GOSUB AtFr1
    IF s$ <> "y" THEN GOTO Main
  END IF
  a = 0: m = 0: w = 0: IF Speed THEN m%(0, 2) = m%(0, 2) / 2
  IF die > 0 THEN GOTO Dead
  IF ar > 1 AND ar <= na THEN
    a%(ar, 4) = 0: a = a%(ar, 5)
  END IF
  IF sh > 1 AND sh <= na THEN
    a%(sh, 4) = 0: m = 1
  END IF
  IF ac < 7 THEN ac = a + m
  FOR a = 1 TO na
     wp%(a) = 0
     IF a%(a, 4) = -999 THEN a%(a, 4) = -1
     IF a%(a, 4) > 1000 AND a%(a, 4) < 2001 THEN
       k = a%(a, 4) - 1000
       IF a%(k, 4) = -1 AND a%(a, 0) > 0 THEN a%(a, 4) = -1
     END IF
     IF a%(a, 4) = -1 AND (a%(a, 2) = 2 OR a%(a, 2) = 3) THEN
       w = w + 1: wp%(w) = a: a%(a, 4) = 0
     END IF
  NEXT
  IF w < 5 THEN GOTO EndGame1
  s$ = "Lord William Missilefire"
  GOSUB Lp7: a$ = "As you enter the Main Hall, " + s$ + " approaches you "
  a$ = a$ + "and says, " + q$ + "You have too many weapons -- 4 is the "
  a$ = a$ + "legal limit." + q$: GOSUB Lp0: GOSUB Lp6
SellWep:
  GOSUB Lp7: PRINT "Your weapons are:": GOSUB Lp4
  s$ = "......................"
  FOR a = 1 TO w
     m = wp%(a)
     PRINT SPC(ABS(a < 10) + ABS(a < 100) + 5); a; ": ";
     a$ = LEFT$(a$(m), 20): PRINT a$;
     PRINT LEFT$(s$, 22 - LEN(a$)); "("; LTRIM$(RTRIM$(STR$(a%(m, 7))));
     PRINT "D"; LTRIM$(RTRIM$(STR$(a%(m, 8)))); ")": GOSUB Lp2
  NEXT: GOSUB Lp1
  INPUT "Enter the number of the weapon to sell:"; a$
  m = INT(VAL(a$)): IF m < 1 OR m > w THEN GOTO SellWep
  a%(wp%(m), 4) = -1: w = w - 1: IF m = w + 1 AND w > 4 THEN GOTO SellWep
  wp%(m) = wp%(w + 1): IF w > 4 THEN GOTO SellWep
EndGame1:
  GOSUB Lp7: a$ = "You deliver your goods to Sam Slicker, the local buyer of "
  a$ = a$ + "treasure.  He looks them over and pays you what they are worth..."
  GOSUB Lp0: GOSUB Lp1: tp = 0
  FOR a = 1 TO naf
     IF a%(a, 4) = -1 THEN
       x = 0
       IF a%(a, 2) > 0 THEN IF ch > 15 THEN x = .05: IF ch > 20 THEN x = .1
       m = CINT(a%(a, 1) + a%(a, 1) * x): tp = tp + m
       PRINT UCASE$(LEFT$(a$(a), 1)); MID$(a$(a), 2);
       IF RIGHT$(a$(a), 1) = "s" THEN PRINT " are";
       IF RIGHT$(a$(a), 1) <> "s" THEN PRINT " is";
       PRINT " worth "; : s$ = LTRIM$(RTRIM$(STR$(m))) + " gold pieces."
       IF m < 1 THEN s$ = "nothing."
       PRINT s$: GOSUB Lp4
     END IF
  NEXT
  GOSUB Lp1: PRINT "He pays you "; tp; " gold pieces total."
  GOSUB Lp4: gold = INT(gold + tp): IF gold < 0 THEN gold = 0
  GOSUB Lp6
'
'  Kill 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
  KILL "NEW-MEAT"
'
' Update player record data
'
r = z.Status
z.CNAME = m$(0): z.Status = 1: z.A1 = m%(0, 1): z.a2 = m%(0, 2)
IF die = 1 THEN z.Status = 2
z.a3 = ch: z.SP1 = sp%(1): z.SP2 = sp%(2): z.SP3 = sp%(3): z.SP4 = sp%(4)
z.WA1 = wa%(1): z.WA2 = wa%(2): z.WA3 = wa%(3): z.WA4 = wa%(4): z.WA5 = wa%(5)
z.ae = ae: z.sex = sex: z.gold = gold: z.bank = bank: z.ac = ac
a = wp%(1): m = wp%(2): k = wp%(3): w = wp%(4)
z.WN1 = a$(a): z.WN2 = a$(m): z.WN3 = a$(k): z.WN4 = a$(w)
z.WCOMPLX1 = a%(a, 5): z.WCOMPLX2 = a%(m, 5): z.WCOMPLX3 = a%(k, 5)
z.WCOMPLX4 = a%(w, 5): z.WTYPE1 = a%(a, 6): z.WTYPE2 = a%(m, 6)
z.WTYPE3 = a%(k, 6): z.WTYPE4 = a%(w, 6): z.WDICE1 = a%(a, 7)
z.WDICE2 = a%(m, 7): z.WDICE3 = a%(k, 7): z.WDICE4 = a%(w, 7)
z.WSIDES1 = a%(a, 8): z.WSIDES2 = a%(m, 8): z.WSIDES3 = a%(k, 8)
z.WSIDES4 = a%(w, 8)
CLOSE
'
' Return to Test Bench
'
IF r < 1 THEN
  CHDIR "..": CHDIR "DD": RUN "DDMENU.BAS"
END IF
'
' 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.BAS"
CHDIR "..": RUN "STARTUP.BAS"
'
' 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 GOTO ExitRtn
  IF a = 2 THEN RUN
  GOTO GameRestore
'---------------------------------------------------------------------------
' Most-useful and main subroutines
'
' Read text from DESC file
'
Effect:
  r = r + 1240
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, DS
a$ = RTRIM$(DS.TEXT): GOSUB Lp0: GOTO Lp1
'
' Print a$ without wrap-around
'
Lp0:
  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
     END IF
  NEXT: GOTO Lp0
'
' 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: L = 0: RETURN
Lp7:
  CLS : L = 0: RETURN
Lp8:
  GOSUB Lp0: GOTO Main
Lp9:
  GOSUB Lp0: GOTO Pfoe
Lp10:
  GOSUB Lp0: GOTO Lp1
Lp11:
  GOSUB DiskRead: L = L - 1: LOCATE CSRLIN - 1, 1: RETURN
Lp12:
  GOSUB Lp4: GOTO Pfoe
'---------------------------------------------------------------------------
' Player input error messages
'
Err0:
  PRINT "Movement commands:"
  FOR c = 1 TO nd
     PRINT UCASE$(c$(c)),
  NEXT: PRINT UCASE$(c$(11)): PRINT
  PRINT "Artifact manipulation:"
  FOR c = 12 TO 25
     PRINT UCASE$(c$(c)),
  NEXT: PRINT : PRINT
  PRINT "Interactive:"
  FOR c = 26 TO 32
     PRINT UCASE$(c$(c)),
  NEXT: PRINT : PRINT
  PRINT "Miscelaneous:"
  FOR c = 33 TO nc
     PRINT UCASE$(c$(c)),
  NEXT: PRINT : PRINT
  L = 99: GOTO Main0
Err1:
  PRINT "You aren't carrying that and you can't see it here.": GOTO Main0
Err2:
  PRINT "You must first open it.": GOTO Main0
Err3:
  a$ = "You can't " + c$(c) + " " + s$ + ".": GOTO Lp8
Err4:
  PRINT "Nobody here by that name!": GOTO Main0
'---------------------------------------------------------------------------
' Attack friend
'
AtFr:
  PRINT "Attack non-enemy?";
AtFr1:
  LINE INPUT "  (Y/N):"; s$: s$ = LTRIM$(RTRIM$(LCASE$(s$)))
  s$ = LEFT$(s$, 1)
  IF s$ = "" OR (s$ <> "y" AND s$ <> "n") THEN GOTO AtFr1
  L = 1: PRINT : RETURN
'---------------------------------------------------------------------------
' Synonym checker
'
Synonym:
  SL = LEN(s$): sy$ = "": sy = 0
  IF ro = 47 THEN sy$ = "mural": sy = 27: GOSUB Synonym1
  IF ro = 47 THEN sy$ = "painting": sy = 27: GOSUB Synonym1
  IF ro = 47 THEN sy$ = "wall": sy = 27
  GOSUB Synonym1: RETURN
Synonym1:
  IF LEFT$(sy$, SL) = s$ OR RIGHT$(sy$, SL) = s$ THEN s$ = LCASE$(a$(sy))
  RETURN
'---------------------------------------------------------------------------
'
' Set up enemy factor and see who folows player
'
EnemyCheck:
  t(1) = 0: t(2) = 0: t(3) = m%(0, 1)
  FOR xm = 1 TO nm
     IF m%(xm, 5) = r3 THEN
       IF m%(xm, 11) > 100 THEN
         rl = m%(xm, 11) - 100 + (ch - 10) * 2
         x = 1 + ABS(rl > RND * 100) + ABS(x = 2 AND rl > RND * 200)
         m%(xm, 11) = x
       END IF
       IF m%(xm, 11) = 3 THEN m%(xm, 5) = ro
       IF m%(xm, 11) = 1 THEN
         IF INT(RND * 100) + 1 <= m%(xm, 4) THEN m%(xm, 5) = ro
       END IF
     END IF
  NEXT xm
Ec1:
  FOR xm = 1 TO nm
     IF m%(xm, 5) = ro THEN
       IF m%(xm, 11) > 3 THEN
         rl = m%(xm, 11) - 100 + (ch - 10) * 2
         k = 1 + ABS(rl > INT(RND * 100 + 1))
         k = k + ABS(k = 2 AND rl > INT(RND * 200 + 1))
         m%(xm, 11) = k
       END IF
       t(m%(xm, 11)) = t(m%(xm, 11)) + m%(xm, 1) * m%(xm, 3)
     END IF
  NEXT xm
  RETURN
'---------------------------------------------------------------------------
' Monster tries to get a weapon
'
GetWep:
  IF m%(of, 6) = -2 THEN RETURN
  w = 0: IF m%(of, 8) < 0 THEN w = ABS(m%(of, 8)) - 1
  IF w > 0 AND w <= na THEN
    IF a%(w, 0) = 1 AND (a%(w, 2) = 2 OR a%(w, 2) = 3) AND a%(w, 4) = ro THEN GOTO GetWep1
  END IF
  w = 0
  FOR x = 1 TO na
     IF a%(x, 4) = ro AND (a%(x, 2) = 2 OR a%(x, 2) = 3) THEN
       IF a%(x, 0) = 1 AND a%(x, 7) * a%(x, 8) > a%(w, 7) * a%(w, 8) THEN w = x
     END IF
  NEXT
GetWep1:
  IF w > 0 THEN
    a$ = m$(of) + " picks up " + a$(w) + ".": GOSUB Lp0
    a%(w, 4) = -of - 1: m%(of, 8) = w: GOTO Lp4
  END IF
  FOR x = 1 TO na
     IF a%(x, 4) = -of - 1 THEN
       IF (a%(x, 2) = 2 OR a%(x, 2) = 3) THEN
         IF a%(x, 7) * a%(x, 8) > a%(w, 7) * a%(w, 8) THEN w = x
       END IF
     END IF
  NEXT
  IF w > 0 THEN
    a$ = m$(of) + " readies " + a$(w) + ".": GOSUB Lp0
    m%(of, 8) = w: GOTO Lp4
  END IF
  IF m%(of, 6) = -1 AND m9 = 1 THEN GOTO Battle0
  RETURN
'---------------------------------------------------------------------------
'  Combat routine
'
Battle:
  IF m%(of, 6) = -2 THEN RETURN
  w2 = 0: IF m%(0, 8) > 1 AND m%(0, 8) >= na THEN w2 = a%(m%(0, 8), 6)
  hi = 0: w = m%(of, 8)
  IF w < 0 THEN GOTO GetWep
Battle0:
' Compute players armor factor
'
  a3 = 0: IF ar > 1 AND ar <= na THEN a3 = a%(ar, 5)
  IF sh > 1 AND sh <= na THEN a3 = a3 + 1
  IF a2 > 7 THEN a3 = 7
  ea = 0: IF ae < a3 * a3 THEN ea = ae - ac * ac
'
'  Compute odds to hit
'
  wm = 50 + 2 * (m%(of, 2) - m%(df, 2) - m%(of, 7) + m%(df, 7))
  IF w > 0 THEN wm = wm + a%(w, 5) / 2
  IF of = 0 THEN wm = wm + wa%(w2) / 4 + ea
  a = a%(w, 6) * ABS(w > 0)
  a$ = m$(of) + " " + bv$(a, INT(RND * 3)) + " at " + m$(df) + "..."
  GOSUB Lp0: GOSUB RollDice
  IF (rl < 5 OR rl < wm) AND rl < 97 THEN
    hi = 1: GOTO Battle1
  END IF
  a2 = 0
  IF m%(df, 8) > 0 THEN a2 = a%(m%(df, 8), 6)
  IF rl < 97 OR w = 0 THEN
    PRINT " --- "; rb$(a2, INT(RND * 2)); "!": GOTO Lp4
  END IF
  PRINT "...A fumble!": GOSUB Lp2: r = INT(RND * 100 + 1)
  IF r < 41 THEN
    PRINT "    Recovered.": GOTO Lp4
  END IF
  IF r < 81 THEN
    a$ = m$(of) + " drops " + a$(w) + "!": GOSUB Lp0
    wt = wt - (ABS(of = 0) * a%(w, 3)): a%(w, 4) = ro
    m%(of, 8) = -w - 1:  GOTO Lp1
  END IF
  IF a%(w, 2) = 3 THEN
    a$ = "Sparks fly from " + a$(w) + "!": GOTO Lp9
  END IF
  IF r > 95 THEN
    PRINT " Weapon hits user!": GOSUB Lp4: df = of
    ON ABS(r = 100) + 1 GOTO Battle2, Battle3
  END IF
  IF r < 91 THEN
    a%(w, 8) = a%(w, 8) - 1
    IF a%(w, 8) > 0 THEN
      PRINT " Weapon damaged!": GOTO Lp4
    END IF
  END IF
  PRINT " Weapon broken!": wt = wt - (ABS(of = 0) * a%(w, 3))
  a%(w, 4) = 0: m%(of, 8) = -1
  IF RND > .5 THEN GOTO Lp4
  PRINT " Broken weapon hits user!": GOSUB Lp4: df = of
  ON ABS(r = 100) + 1 GOTO Battle2, Battle3
Battle1:
  IF of = 0 THEN
    up = ABS(INT(RND * 100) + 1 > wm + wa%(w2))
    IF INT(RND * 100) + 1 < wa%(w2) THEN
      IF ABS(ea) > INT(RND * 10) + 1 AND ae < a3 * a3 AND ae < 65 THEN
        ae = ae + 2
        s$ = MID$("'s'", ABS(LCASE$(RIGHT$(m$(0), 1)) = "s") * 2 + 1, 2)
        a$ = m$(0) + s$ + " armor expertise just increased!": GOSUB Lp10
      END IF
    END IF
  END IF
Battle2:
  d = m%(of, 9): s = m%(of, 10)
  IF w > 0 THEN
    d = a%(w, 7): s = a%(w, 8)
  END IF
  a = 1: PRINT MID$(" ***  +++ ", ABS((df > 0)) * 5 + 1, 5);
  IF rl > 5 THEN
    PRINT "A hit!": GOSUB Lp2: GOTO Damage0
  END IF
Battle3:
  PRINT "A critical hit!": GOSUB Lp2: r2 = INT(RND * 100) + 1
  IF r2 < 51 THEN a = 0: GOTO Damage0
  rl = 1.5: IF r2 > 85 THEN rl = 2
  IF r2 > 95 THEN rl = 3
  IF r2 = 100 THEN rl = m%(df, 1)
  s = rl * s
Damage0:
  D2 = 0
  FOR k = 1 TO d
     D2 = D2 + INT(RND * s) + 1
  NEXT
  D2 = INT(D2 - a * m%(df, 7))
  IF D2 < 1 AND m%(df, 7) = 0 THEN
    PRINT "  Blow turned!": GOTO Lp4
  END IF
Damage1:
  IF D2 < 1 THEN
    PRINT "  Armor absorbs damage!": GOTO Lp4
  END IF
'---------------------------------------------------------------------------
' Add damage/report monster's health
'
Mstatus:
  a$ = ""
  IF m%(df, 3) > 1 THEN a$ = "One "
  a$ = m$(df) + " is "
  m%(df, 13) = m%(df, 13) + D2
  IF m%(df, 13) >= m%(df, 1) THEN GOTO Mdead
  IF m%(df, 13) = 0 THEN GOTO Ms1
  xm% = m%(df, 13) * 5 / m%(df, 1) + 1
  ON xm% GOTO Ms2, Ms3, Ms4, Ms5, Ms6, Ms6
  PRINT xm%: END
Ms1:
  a$ = a$ + "in perfect health.": GOTO Lp10
Ms2:
  a$ = a$ + "still in good shape.": GOTO Lp10
Ms3:
  a$ = a$ + "hurting.": GOTO Lp10
Ms4:
  a$ = a$ + "in pain.": GOTO Lp10
Ms5:
  a$ = a$ + "badly injured.": GOTO Lp10
Ms6:
  a$ = a$ + "at death's door, knocking loudly.": GOTO Lp10
'---------------------------------------------------------------------------
' Monster dies
'
Mdead:
  a$ = a$ + "dead!"
  IF m%(df, 3) > 1 THEN
    m%(df, 3) = m%(df, 3) - 1: m%(df, 13) = 0: GOTO Mdead2
  END IF
  IF df = 0 THEN die = 1: GOTO Lp10
  m%(df, 8) = -1 * ABS(m%(df, 8) <> 0): m%(df, 5) = 0
  m%(df, 3) = m%(df, 12): m%(df, 13) = 0
  FOR a2 = 1 TO na
     IF a%(a2, 4) = -df - 1 OR a%(a2, 4) = -df - 1000 THEN a%(a2, 4) = ro
  NEXT a2
Mdead0:
'
' Add special effects of a monsters death here
'
  IF db > 0 THEN a%(df + db - 1, 4) = ro
Mdead2:
  w = m%(df, 11): t(w) = t(w) - m%(df, 1)
  GOTO Lp10
'---------------------------------------------------------------------------
' Was player's spell successful?
'
SpellCast:
  SUC = 0: GOSUB RollDice: rl = rl * ABS(sp%(s) > 0)
  IF (rl < sa%(s) OR rl < 5) AND rl < 100 AND rl > 0 THEN SUC = 1
  IF rl = 100 THEN
    a$ = "Spell backlash!!  Your ability to cast the " + c$(c) + " spell "
    a$ = a$ + "temporarily diminishes!": GOSUB Lp0
    sa%(s) = sa%(s) / 10
  END IF
  IF SUC = 0 THEN
    PRINT "Nothing happened.": GOSUB Lp2
  END IF
  IF SUC = 1 THEN
    GOSUB RollDice
    IF rl > sp%(s) THEN
      sp%(s) = sp%(s) + 2: sa%(s) = sa%(s) + 2
      a$ = m$(0) + MID$("'s'", (LCASE$(RIGHT$(m$(0), 1)) = "s") * 2 + 1, 2)
      a$ = a$ + " ability to cast " + c$(c) + " just increased by 2!"
      GOSUB Lp0: GOSUB Lp1
    END IF
    IF sa%(s) > 9 THEN sa%(s) = sa%(s) / 2
  END IF
  RETURN
'---------------------------------------------------------------------------
' Get a random roll between 1 and RL
'
RollDice:
  rl = 100
RollDice2:
  rl = INT(RND * rl + 1)
  RETURN
'---------------------------------------------------------------------------
' Get an item before doing something with it (Ready/Wear/Etc.)
'
ItemTake:
  IF a%(a, 4) = -1 THEN RETURN
  PRINT "(Taking it first.)"
  IF wt + a%(a, 3) > m%(0, 1) * 10 OR a%(a, 3) = -999 OR a%(a, 3) > 900 THEN
    PRINT "It's too heavy.": GOSUB Lp2: RETURN
  END IF
  a%(a, 4) = -1: wt = wt + a%(a, 3): RETURN
'---------------------------------------------------------------------------
' Monster search routine
'
Msearch:
  wh = ro: ha = wh
Msearch0:
  f = 0: SL = LEN(s$): m = 0
  FOR x = 1 TO nm
     IF s$ = LCASE$(m$(x)) THEN
       IF m%(x, 5) = wh OR m%(x, 5) = ha THEN
         m = x: f = f + 1:  x = nm:  GOTO Msearch1
       END IF
     END IF
     IF s$ = LEFT$(LCASE$(m$(x)), SL) OR s$ = RIGHT$(LCASE$(m$(x)), SL) THEN
       IF m%(x, 5) = wh OR m%(x, 5) = ha THEN
         m = x: f = f + 1
       END IF
     END IF
Msearch1:
  NEXT
  IF f = 0 THEN
    IF RIGHT$(s$, 1) = "s" AND SL > 1 THEN
      s$ = LEFT$(s$, SL - 1): GOTO Msearch0
    END IF
  END IF
  RETURN
'---------------------------------------------------------------------------
' Artifact search routine
'
Asearch:
  ha = -1: wh = ha: EM = ha: GOTO Asearch2
Asearch0:
  ha = -1
Asearch1:
  wh = ro: EM = ro + 2000
Asearch2:
  GOSUB Synonym: f = 0
  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
       END IF
     END IF
Asearch3:
  NEXT
  IF f > 1 THEN
    f = 0: a$ = "(Which " + q$ + s$ + q$ + " do you mean?)": GOSUB Lp0
  END IF
  RETURN
'---------------------------------------------------------------------------
' 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

'---------------------------------------------------------------------------
'  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
OPEN "NEW-MEAT" FOR RANDOM AS #4 LEN = 200
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.D7: r%(r, 8) = rm.D8
   r%(r, 9) = rm.D9: r%(r, 10) = rm.D10: r%(r, 11) = rm.Light
NEXT
'
'   Artifacts
'
FOR a = 1 TO naf
   GET #2, a + adj2, art
   a$(a) = RTRIM$(art.aname): a%(a, 1) = art.AD1: a%(a, 2) = art.AD2
   a%(a, 3) = art.AD3: a%(a, 4) = art.AD4: a%(a, 5) = art.AD5
   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, 1) = mon.MD1: m%(m, 2) = mon.MD2
   m%(m, 3) = mon.MD3: m%(m, 4) = mon.MD4: m%(m, 5) = mon.MD5
   m%(m, 6) = mon.MD6: m%(m, 7) = mon.MD7: m%(m, 8) = mon.MD8
   m%(m, 9) = mon.MD9: m%(m, 10) = mon.MD10: m%(m, 11) = mon.MD11
   m%(m, 12) = m%(m, 3)
NEXT
'
'   PLAYER
'
a = 1
GET #4, a, z
m$(0) = RTRIM$(z.CNAME): stat = z.Status: m%(0, 1) = z.A1: m%(0, 2) = z.a2
ch = z.a3: sp%(1) = z.SP1: sp%(2) = z.SP2: sp%(3) = z.SP3: sp%(4) = z.SP4
wa%(1) = z.WA1: wa%(2) = z.WA2: wa%(3) = z.WA3: wa%(4) = z.WA4: wa%(5) = z.WA5
ae = z.ae: sex = z.sex: gold = z.gold: bank = z.bank: ac = z.ac
a = naf + 1: m = a + 1: k = a + 2: w = a + 3
a$(a) = RTRIM$(z.WN1): a$(m) = RTRIM$(z.WN2): a$(k) = RTRIM$(z.WN3)
a$(w) = RTRIM$(z.WN4): a%(a, 5) = z.WCOMPLX1: a%(m, 5) = z.WCOMPLX2
a%(k, 5) = z.WCOMPLX3: a%(w, 5) = z.WCOMPLX4: a%(a, 6) = z.WTYPE1
a%(m, 6) = z.WTYPE2: a%(k, 6) = z.WTYPE3: a%(w, 6) = z.WTYPE4
a%(a, 7) = z.WDICE1: a%(m, 7) = z.WDICE2: a%(k, 7) = z.WDICE3
a%(w, 7) = z.WDICE4: a%(a, 8) = z.WSIDES1: a%(m, 8) = z.WSIDES2
a%(k, 8) = z.WSIDES3: a%(w, 8) = z.WSIDES4
CLOSE
FOR a = 1 TO 4
   sa%(a) = sp%(a)
NEXT
'
na = naf
FOR a = 1 TO 4
   a$ = UCASE$(LEFT$(a$(naf + a), 4))
   IF a$ <> "NONE" AND a$ <> "" THEN na = na + 1
NEXT
FOR a = naf + 1 TO na
   a%(a, 2) = 2 + ABS((a%(a, 7) * a%(a, 8) > 25))
   a%(a, 3) = 2: wt = wt + 2: : a%(a, 4) = -1
NEXT
m%(0, 7) = ac / 2 + ABS((sh > 0)): m%(0, 11) = 3
m%(0, 8) = -1: IF na > naf THEN m%(0, 8) = naf + 1
IF ae < ac * ac THEN ea = ae - ac * ac
'
'   Make players armor artifacts
'
FOR a = 1 TO 4
   READ wp$(a)
NEXT
a = INT(ac / 2)
IF a > 4 THEN a = 4
IF a THEN
  na = na + 1: a$(na) = wp$(a) + " armor": a%(na, 2) = 11: a%(na, 3) = a * 7
  a%(na, 4) = -999: wt = wt + a%(na, 3): ar = na
  a%(na, 5) = ac - ABS(ac / 2 <> INT(ac / 2))
END IF
a = ABS((INT(ac / 2) <> ac / 2))
IF a THEN
  na = na + 1: sh = na: a$(na) = "shield": a%(na, 2) = 11: a%(na, 3) = 10
  a%(na, 4) = -999: wt = wt + 10: a%(na, 5) = 1
END IF
'
'   Check for duplicate Art. names
'
CheckDup:
r = 0
FOR a = 1 TO na
   a$(a) = LTRIM$(RTRIM$(a$(a)))
   FOR m = a + 1 TO na
      IF LCASE$(a$(m)) = LCASE$(a$(a)) THEN
        a$(m) = a$(m) + "#": r = 1
      END IF
   NEXT
NEXT
IF r = 1 THEN GOTO CheckDup
'
'    Set starting variable values
'
ro = 1: r2 = 1: r3 = 1: q$ = CHR$(34)
IF m%(0, 8) <> -1 THEN w2 = a%(m%(0, 8), 5)
FOR a = 0 TO 5
   FOR a2 = 0 TO 2
      READ bv$(a, a2)
   NEXT
NEXT
FOR a = 0 TO 5
   FOR a2 = 0 TO 1
      READ rb$(a, a2)
   NEXT
NEXT
FOR a = 1 TO 3
   READ sm$(a)
NEXT
FOR a = 1 TO 5
   READ wp$(a)
NEXT
sex$(0) = "Male": sex$(1) = "Female"
IF nd = 6 THEN
  FOR c = 7 TO 10: c$(c) = "": NEXT
END IF
FOR a = naf + 1 TO na
   a%(a, 0) = 1
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
'
COLOR 2: PRINT : PRINT SPC(10); "Hit any key to begin."
a$ = INKEY$
DO
  a = RND
LOOP UNTIL INKEY$ <> ""
'===========================================================================
d%(1) = 64: d%(2) = 77: ro = 1: IF gold < 2 THEN gold = 2
'
Init0:
CLS : LOCATE 12: COLOR 3
PRINT "You need to buy some food.  The cost is 2 gold pieces a pack.": PRINT
PRINT "How many do you want to buy?": PRINT
PRINT "Enter 1-"; LTRIM$(RTRIM$(STR$(INT(gold / 2))));
LINE INPUT ":"; a$: a = INT(VAL(a$))
IF a < 1 OR a > INT(gold / 2) THEN GOTO Init0
gold = gold - 2 * a: d%(3) = d%(3) + a
'===========================================================================
Init1:
d%(5) = 2: CALL Apple.Island
SCREEN 0: WIDTH 80: CLS : LOCATE 24: COLOR 3
IF d%(4) = 1 THEN GOSUB GameSave0: GOTO Init1
IF d%(4) = 2 THEN
  GOSUB GameRestore0
  IF d%(5) = 1 THEN GOTO Move2
  GOTO Init1
END IF
IF d%(4) = 3 THEN GOSUB Quit1: GOTO Init1
IF d%(4) = 4 THEN GOTO Move2
IF d%(4) = 5 THEN die = 1: GOTO EndGame
'===========================================================================
'
DATA 42,north,south,east,west,up,down,ne,nw,se,sw,flee,close,drink,drop,eat
DATA examine,get,light,open,put,read,ready,remove,use,wear,attack,blast,free
DATA give,heal,request,smile,inventory,look,say,speed,power,status,hints,save
DATA restore,quit

'
DATA leather,chain,plate,magic
'
DATA lunges,tears,claws,swings,chops,swings,shoots,shoots,shoots
DATA swings,swings,swings,stabs,lunges,jabs,swings,chops,stabs
'
DATA Missed,Missed,Parried,Missed,Missed,Missed,Parried,Missed,Parried,Missed
DATA Parried,Missed
'
DATA growl,ignore,smile
'
DATA axe,missile weapon,club,spear,sword

SUB Apple.Island
'
' This SUB controls the graphical interface of Apple Island
'
'   Graphics designed by Don Brown
'   PC/QBASIC adaption by Frank Black
'
SCREEN 7: VIEW PRINT 21 TO 25: CLS : mons = 0
CALL MakePic: x = d%(1): y = d%(2): d%(6) = 0: d%(8) = 1: rz = 0
shape = 1: b1 = 1: GOSUB DrawShape
FOR m = 1 TO nm
   IF m%(m, 5) = ro THEN mons = mons + 1
NEXT
COLOR 14: PRINT "Use the arrow keys to move."
PRINT "<Escape> to save, restore, or quit.": COLOR 13
PRINT : PRINT "(Hit any key to begin)": a$ = INKEY$
DO
LOOP UNTIL INKEY$ <> ""
CLS 2: LOCATE 24
'===========================================================================
' Main loop
'
GetKey:
PRINT "Food:"; d%(3)
IF d%(3) < 1 THEN
  COLOR 14: PRINT m$(0); " just died from starvation."
  PRINT : COLOR 14: PRINT "Hit any key to continue.": COLOR 13: k$ = INKEY$
  DO
  LOOP UNTIL INKEY$ <> ""
  d%(4) = 5: EXIT SUB
END IF
'
' Check for special locations
'
IF x = 92 AND y = 97 THEN
  a$ = "the Temple of Pashia": GOSUB Enter
  IF s$ = "y" THEN d%(4) = 4: r2 = 1: GOTO Leave
END IF
IF (x = 68 AND y = 13) OR (x = 72 AND y = 13) THEN
  a$ = "the entrance to the castle": GOSUB Enter
  IF s$ = "y" THEN
    IF a%(12, 4) = -1 AND a%(17, 4) = -1 THEN d%(4) = 4: r2 = 34: GOTO Leave
    PRINT : COLOR 14: PRINT "You can't at this time.": COLOR 13: PRINT
  END IF
END IF
IF x = 112 AND y = 73 THEN
  a$ = "a water-filled hole in the ground": GOSUB Enter
  IF s$ = "y" THEN d%(4) = 4: r2 = 22: GOTO Leave
END IF
IF x = 24 AND y = 37 THEN
  a$ = "the entrance to some mountain caves": GOSUB Enter
  IF s$ = "y" THEN d%(4) = 4: r2 = 8: GOTO Leave
END IF
'---------------------------------------------------------------------------
' Set up random events
'
r = INT(RND * 100) + 1: IF rz = 1 THEN r = 0
IF r > 40 THEN
  r = INT(RND * 100) + 1: IF y < 29 THEN r = 200
  IF r < 6 THEN Event = 1: GOSUB Event
  IF r > 10 AND r < 16 AND d%(3) > 3 THEN Event = 2: GOSUB Event
  IF r > 20 AND r < 31 THEN
    IF x < 92 AND y > 77 THEN Event = 3
    d%(2) = y: k = 36: y = 105: GOSUB Event1
  END IF
  IF r > 30 AND r < 36 THEN Event = 4: GOSUB Event
END IF
'----------------------------------------------------------------------------
' Player input
'
PRINT ">"; : k$ = INKEY$: d%(6) = 1
GetKey1:
DO
   k$ = RIGHT$(INKEY$, 1)
LOOP UNTIL k$ <> ""
k = ASC(k$)
'============================================================================
' Sort keypresses
'
IF k = 1 THEN
  COLOR 14: PRINT "Test privleges enabled.": COLOR 13: d%(7) = 1: GOTO GetKey
END IF
IF k = 26 AND d%(7) = 1 THEN
  COLOR 14: PRINT "Events off.": rz = 1: COLOR 13: GOTO GetKey
END IF
IF k = 32 AND d%(7) = 1 THEN
  PRINT "x="; x; ",y="; y; ",stack="; FRE(-2): GOTO GetKey
END IF
IF k = 27 THEN
  PRINT : CLS 2: PRINT "1. Save   2. Restore   3. Quit"
  LINE INPUT "(Enter 1-3):"; k$: k = VAL(k$)
  IF k < 1 OR k > 3 THEN GOTO GetKey
  d%(4) = k: GOTO Leave
END IF
b1 = 1
IF k = 72 THEN GOTO MoveUp
IF k = 75 THEN GOTO MoveLeft
IF k = 77 THEN GOTO MoveRight
IF k = 80 THEN GOTO MoveDown
IF k < 49 OR k > 55 OR d%(7) = 0 THEN GOTO GetKey1
'
' Change shapes
'
b1 = 1: GOSUB EraseShape: shape = k - 48
PRINT "Change to shape"; shape; "."
c = 7: b1 = 1: GOSUB DrawShape: GOTO GetKey
'===========================================================================
' Move around
'
MoveLeft:
IF x < 12 OR (x < 21 AND (y < 38 OR y > 95)) THEN SOUND 800, .5: GOTO GetKey1
PRINT "West.": SOUND 80, .8
GOSUB EraseShape
d%(3) = d%(3) - 1 - mons: x = x - 4: GOTO DrawPic
'
MoveRight:
IF POINT(x + 18, y) = 1 THEN SOUND 800, .5: GOTO GetKey1
PRINT "East.": SOUND 80, .8
GOSUB EraseShape
d%(3) = d%(3) - 1 - mons: x = x + 4: GOTO DrawPic
'
MoveUp:
IF POINT(x + 8, y - 4) = 1 THEN SOUND 800, .5: GOTO GetKey1
PRINT "North.": SOUND 80, .8
GOSUB EraseShape
d%(3) = d%(3) - 1 - mons: y = y - 4: GOTO DrawPic
'
MoveDown:
IF POINT(x + 8, y + 18) = 1 THEN SOUND 800, .5: GOTO GetKey1
PRINT "South.": SOUND 80, .8
GOSUB EraseShape
d%(3) = d%(3) - 1 - mons: y = y + 4: GOTO DrawPic
'===========================================================================
' Return to text game
'
Leave:
d%(1) = x: d%(2) = y: EXIT SUB
'===========================================================================
Enter:
CLS 2
PRINT "You have arrived at": PRINT a$; ".": PRINT "  Enter? (Y/N):";
DO
s$ = LCASE$(INKEY$)
LOOP UNTIL s$ = "y" OR s$ = "n"
PRINT s$: RETURN
'===========================================================================
' Draw event icons
'
Event:
d%(2) = y: k = x - 25: IF k < 5 THEN k = x + 20
Event1:
d%(1) = x: x = k: sh = 2
CLS 2: d%(8) = shape: shape = Event + 1
IF Event = 4 THEN shape = INT(RND * 3) + 5
b1 = 2: GOSUB DrawShape1

'
' Slavers
'
IF Event = 1 THEN
Slaver:
  PRINT "You encounter three men in armor."
  PRINT "  Will you attack, run, or watch?": PRINT : PRINT "(A/R/W):";
  DO
  s$ = LCASE$(INKEY$)
  LOOP UNTIL s$ = "a" OR s$ = "r" OR s$ = "w"
  PRINT s$
  CLS 2: IF s$ <> "a" AND s$ <> "r" AND s$ <> "w" THEN GOTO Slaver
  IF s$ = "a" THEN PRINT "The men run away.": PRINT : GOTO Event2
  IF s$ = "r" THEN PRINT "You run away unnoticed.": PRINT : GOTO Event2
  IF mons = 0 THEN PRINT "The men hurry away.": PRINT : GOTO Event2
  PRINT "The men are slavers and they wish"
  PRINT "to buy your companions.": PRINT
  LINE INPUT "Sell? (Y/N):"; s$: s$ = LEFT$(LTRIM$(RTRIM$(LCASE$(s$))), 1)
  IF s$ <> "y" THEN GOTO Event2
  PRINT "The slavers take your friends and"
  PRINT "pay you 1000 gold pieces.": PRINT
  gold = gold + 1000: mons = 0
  FOR m = 1 TO nm
     IF m%(m, 5) = ro THEN m%(m, 5) = 0
  NEXT
  GOTO Event2
END IF
'---------------------------------------------------------------------------
' Hermit
'
IF Event = 2 THEN
  PRINT "You encounter a hermit who needs food."
  PRINT "Give him some? (Y/N):";
  DO
  s$ = LCASE$(INKEY$)
  LOOP UNTIL s$ = "y" OR s$ = "n"
  PRINT s$
  IF s$ <> "y" THEN GOTO Event2
  d%(3) = d%(3) - 1: COLOR 14
  PRINT "He says, "; q$; "Remember, one space can"
  PRINT "make two."; q$: PRINT
  COLOR 13: GOTO Event2
END IF
'---------------------------------------------------------------------------
' Wagon
'
IF Event = 3 THEN
  PRINT "You see some merchants that are"
  PRINT "selling food for 10GP a pack.": PRINT : PRINT "Buy some? (Y/N):";
  DO
  s$ = LCASE$(INKEY$)
  LOOP UNTIL s$ = "y" OR s$ = "n"
  PRINT s$
  IF s$ <> "y" THEN GOTO Event2
  PRINT "How many? (0-"; LTRIM$(RTRIM$(STR$(INT(gold / 10))));
  LINE INPUT "): "; s$: PRINT : z = INT(VAL(s$)): z = z * ABS(z > 0)
  IF z * 10 > gold THEN PRINT "You can't afford it.": PRINT : GOTO Event2
  gold = gold - z * 10: d%(3) = d%(3) + z
END IF
'---------------------------------------------------------------------------
' Random combat
'
IF Event = 4 THEN
  hd = 2 + ABS(shape = 5) + 3 * ABS(shape = 7): hp = 0
  FOR a = 1 TO hd: hp = hp + INT(RND * 8) + 1: NEXT
  n$ = MID$("bearwolfdragon", (shape - 5) * 4 + 1, 4 + 2 * ABS(shape = 7))
  CLS 2: COLOR 14: PRINT "You see a "; n$; "!": COLOR 13: PRINT
Combat:
  PRINT "Run of fight? (R/F):";
  DO
  s$ = LCASE$(INKEY$)
  LOOP UNTIL s$ = "r" OR s$ = "f"
  PRINT s$
  IF s$ = "r" THEN GOTO Event2
Combat1:
  CLS 2
  IF INT(RND * 10) + 1 > 5 THEN PRINT "The "; n$; " missed!": GOTO Combat1a
  PRINT "The "; n$; " hit "; m$(0); "!": PRINT
  m%(0, 13) = m%(0, 13) + INT(RND * 4) + 1
  IF m%(0, 13) > m%(0, 1) THEN PRINT m$(0); " is dead!"
Combat1a:
  PRINT : COLOR 14: PRINT "Hit any key to continue.": COLOR 13: k$ = INKEY$
  DO
  LOOP UNTIL INKEY$ <> ""
  IF m%(0, 13) > m%(0, 1) THEN d%(4) = 5: EXIT SUB
Combat2:
  CLS 2: PRINT : PRINT m$(0); " attacks "; n$; "..."
  IF INT(RND * 10) + 1 > 6 THEN PRINT " --Missed!": GOTO Combat3
  PRINT " --A hit!": hp = hp - INT(RND * 8) + 1: hp = hp - INT(RND * 8) + 1
  IF hp < 1 THEN PRINT "The "; n$; " is dead!"
Combat3:
  PRINT : COLOR 14: PRINT "Hit any key to continue.": COLOR 13: k$ = INKEY$
  DO
  LOOP UNTIL INKEY$ <> ""
  IF hp > 0 THEN GOTO Combat1
END IF
'---------------------------------------------------------------------------
Event2:
sh = 2: GOSUB EraseShape1: x = d%(1): y = d%(2): shape = d%(8): RETURN

'======================================
DrawPic:
b1 = 1: GOSUB DrawShape: GOTO GetKey
'
'   Draw a shape, saving screen data in shape 9 or 10 before drawing
'
DrawShape:
sh = 1
DrawShape1:
shape2 = 66 * (shape - 1) + 1: back = 66 * (b1 + 6) + 1
GET (x, y)-(x + 15, y + 15), shape%(back)
PUT (x, y), shape%(shape2), PSET
RETURN
'=====================================
' Restore former screen data
'
EraseShape:
sh = 1
EraseShape1:
back = 66 * (b1 + 6) + 1
PUT (x, y), shape%(back), PSET
RETURN
END SUB

SUB MakePic
'
' This sub creates the main game screen for Apple Island
'
'   Graphics designed by Don Brown
'   PC/QBASIC adaption by Frank Black
'
'===========================================================================
' Make screen blue
'
c = 1
FOR z = 0 TO 17
   LINE (0, z)-(154, z), c
NEXT
FOR z = 18 TO 25
   LINE (0, z)-(182, z), c: LINE (252, z)-(280, z), c
NEXT
FOR z = 26 TO 157
   LINE (0, z)-(280, z), c
NEXT
'===========================================================================
' Draw game title
'
'INPUT a$
c = 12
'T
LINE (163, 1)-(171, 1), c: LINE (167, 2)-(167, 7), c
'H
LINE (177, 1)-(177, 7), c: LINE (185, 1)-(185, 7), c
LINE (178, 4)-(184, 4), c
'E
LINE (192, 1)-(201, 1), c: LINE (192, 7)-(201, 7), c
LINE (192, 2)-(192, 6), c: LINE (193, 4)-(199, 4), c

'L
LINE (219, 1)-(219, 7), c: LINE (220, 7)-(227, 7), c
'O
LINE (233, 2)-(233, 6), c: LINE (241, 2)-(241, 6), c
LINE (234, 1)-(240, 1), c: LINE (234, 7)-(240, 7), c
'S
LINE (247, 2)-(247, 3), c: LINE (248, 1)-(254, 1), c
LINE (255, 2)-(255, 2), c: LINE (248, 4)-(254, 4), c
LINE (255, 5)-(255, 6), c: LINE (248, 7)-(254, 7), c
LINE (247, 6)-(247, 6), c
'T
LINE (261, 1)-(270, 1), c: LINE (265, 2)-(265, 7), c

'I
LINE (160, 9)-(166, 9), c: LINE (163, 9)-(163, 14), c
LINE (160, 15)-(166, 15), c
'S
LINE (172, 9)-(178, 9), c: LINE (171, 10)-(171, 11), c
LINE (179, 10)-(179, 10), c: LINE (172, 12)-(178, 12), c
LINE (179, 13)-(179, 14), c: LINE (171, 14)-(171, 14), c
LINE (172, 15)-(178, 15), c
'L
LINE (185, 9)-(185, 15), c: LINE (186, 15)-(193, 15), c
'A
LINE (199, 11)-(199, 15), c: LINE (200, 10)-(205, 10), c
LINE (202, 10)-(203, 10), 0: LINE (202, 9)-(203, 9), c
LINE (200, 13)-(205, 13), c: LINE (206, 11)-(206, 15), c
'N
LINE (213, 9)-(213, 15), c: LINE (220, 9)-(220, 15), c
LINE (214, 11)-(215, 11), c: LINE (216, 12)-(217, 12), c
LINE (218, 13)-(219, 13), c
'D
LINE (227, 9)-(227, 15), c: LINE (228, 9)-(234, 9), c
LINE (235, 10)-(235, 14), c: LINE (228, 15)-(234, 15), c

'O
LINE (255, 10)-(255, 14), c: LINE (263, 10)-(263, 14), c
LINE (256, 9)-(262, 9), c: LINE (256, 15)-(262, 15), c
'F
LINE (269, 9)-(269, 15), c: LINE (270, 9)-(277, 9), c
LINE (270, 12)-(275, 12), c

'A
LINE (185, 20)-(185, 24), c: LINE (186, 19)-(191, 19), c
LINE (188, 19)-(189, 19), 0: LINE (188, 18)-(189, 18), c
LINE (186, 22)-(191, 22), c: LINE (192, 20)-(192, 24), c
'P
LINE (199, 18)-(199, 24), c: LINE (207, 19)-(207, 20), c
LINE (200, 18)-(206, 18), c: LINE (200, 21)-(206, 21), c
'P
LINE (213, 18)-(213, 24), c: LINE (221, 19)-(221, 20), c
LINE (214, 18)-(220, 18), c: LINE (214, 21)-(220, 21), c
'L
LINE (227, 18)-(227, 24), c: LINE (228, 24)-(235, 24), c
'E
LINE (241, 18)-(241, 24), c: LINE (242, 18)-(249, 18), c
LINE (242, 21)-(247, 21), c: LINE (242, 24)-(249, 24), c
'===========================================================================
' Draw Apple Island
'
'INPUT a$
c = 2
FOR z = 13 TO 34
   LINE (73, z)-(87, z), c
NEXT
LINE (105, 30)-(129, 30), c: LINE (31, 30)-(55, 30), c
LINE (101, 31)-(129, 31), c: LINE (29, 31)-(59, 31), c
LINE (97, 32)-(131, 32), c: LINE (29, 32)-(63, 32), c
LINE (93, 33)-(131, 33), c: LINE (27, 33)-(67, 33), c
LINE (89, 34)-(133, 34), c: LINE (27, 34)-(71, 34), c
'
LINE (25, 35)-(133, 35), c: LINE (25, 36)-(135, 36), c
LINE (23, 37)-(135, 37), c: LINE (23, 38)-(137, 38), c
LINE (23, 39)-(137, 39), c: LINE (21, 40)-(137, 40), c
LINE (21, 41)-(139, 41), c: LINE (21, 42)-(139, 42), c
LINE (19, 43)-(139, 43), c: LINE (19, 44)-(141, 44), c
LINE (19, 45)-(141, 45), c: LINE (17, 46)-(141, 46), c
LINE (17, 47)-(141, 47), c: LINE (17, 48)-(143, 48), c
LINE (17, 49)-(143, 49), c: LINE (15, 50)-(143, 50), c
'
LINE (15, 51)-(141, 51), c: LINE (15, 52)-(141, 52), c
LINE (15, 53)-(139, 53), c: LINE (15, 54)-(139, 54), c
LINE (13, 55)-(137, 55), c: LINE (13, 56)-(137, 56), c
LINE (13, 57)-(137, 57), c: LINE (13, 58)-(135, 58), c
LINE (13, 59)-(135, 59), c: LINE (11, 60)-(135, 60), c
LINE (11, 61)-(133, 61), c: LINE (11, 62)-(133, 62), c
LINE (11, 63)-(133, 63), c: LINE (11, 64)-(133, 64), c
LINE (11, 65)-(131, 65), c: LINE (11, 66)-(131, 66), c
LINE (11, 67)-(131, 67), c: LINE (11, 68)-(131, 68), c
LINE (9, 69)-(131, 69), c: LINE (9, 70)-(131, 70), c
LINE (9, 71)-(131, 71), c
FOR z = 72 TO 88
   LINE (9, z)-(129, z), c
NEXT
LINE (9, 89)-(131, 89), c: LINE (9, 90)-(131, 90), c
LINE (9, 91)-(131, 91), c: LINE (11, 92)-(131, 92), c
LINE (11, 93)-(131, 93), c: LINE (11, 94)-(131, 94), c
LINE (11, 95)-(131, 95), c: LINE (11, 96)-(133, 96), c
LINE (11, 97)-(133, 97), c: LINE (11, 98)-(133, 98), c
LINE (11, 99)-(133, 99), c: LINE (11, 100)-(135, 100), c
'
LINE (13, 101)-(135, 101), c: LINE (13, 102)-(135, 102), c
LINE (13, 103)-(137, 103), c: LINE (13, 104)-(137, 104), c
LINE (13, 105)-(137, 105), c: LINE (15, 106)-(139, 106), c
LINE (15, 107)-(139, 107), c: LINE (15, 108)-(141, 108), c
LINE (15, 109)-(141, 109), c: LINE (15, 110)-(143, 110), c
LINE (17, 111)-(143, 111), c
'
LINE (17, 112)-(143, 112), c: LINE (17, 113)-(141, 113), c
LINE (17, 114)-(141, 114), c: LINE (19, 115)-(141, 115), c
LINE (19, 116)-(141, 116), c: LINE (19, 117)-(139, 117), c
LINE (21, 118)-(139, 118), c: LINE (21, 119)-(139, 119), c
LINE (21, 120)-(137, 120), c: LINE (23, 121)-(137, 121), c
LINE (23, 122)-(137, 122), c: LINE (23, 123)-(135, 123), c
LINE (25, 124)-(135, 124), c

LINE (25, 125)-(73, 125), c: LINE (87, 125)-(133, 125), c
LINE (27, 126)-(71, 126), c: LINE (89, 126)-(133, 126), c
LINE (27, 127)-(67, 127), c: LINE (93, 127)-(131, 127), c
LINE (29, 128)-(63, 128), c: LINE (97, 128)-(131, 128), c
LINE (29, 129)-(59, 129), c: LINE (101, 129)-(129, 129), c
LINE (31, 130)-(55, 130), c: LINE (105, 130)-(129, 130), c
'===========================================================================
' Draw castle
'
c = 8
LINE (76, 11)-(76, 13), c: LINE (77, 11)-(77, 15), c
LINE (77, 25)-(77, 26), c: LINE (78, 15)-(78, 26), c
LINE (79, 15)-(79, 26), c: LINE (80, 11)-(80, 26), c
LINE (81, 15)-(81, 26), c: LINE (82, 15)-(82, 26), c
LINE (83, 11)-(83, 15), c: LINE (83, 25)-(83, 26), c
LINE (84, 11)-(84, 13), c
'===========================================================================
' Draw temple
'
c = 4
LINE (100, 100)-(102, 100), c: LINE (99, 101)-(103, 101), c
LINE (98, 102)-(100, 102), c: LINE (102, 102)-(104, 102), c
LINE (97, 103)-(99, 103), c: LINE (103, 103)-(105, 103), c
LINE (96, 104)-(98, 104), c: LINE (104, 104)-(106, 104), c
LINE (95, 105)-(97, 105), c: LINE (105, 105)-(107, 105), c
LINE (95, 106)-(95, 110), c: LINE (96, 106)-(96, 110), c
LINE (106, 106)-(106, 110), c: LINE (107, 106)-(107, 110), c
LINE (97, 110)-(105, 110), c
'===========================================================================
' Draw mountains
'
c = 6
x = 30: y = 38: GOSUB Mountain: x = 39: y = 38: GOSUB Mountain
x = 48: y = 36: GOSUB Mountain: x = 55: y = 37: GOSUB Mountain
x = 20: y = 45: GOSUB Mountain: x = 28: y = 45: GOSUB Mountain
x = 41: y = 46: GOSUB Mountain: x = 48: y = 44: GOSUB Mountain
x = 57: y = 44: GOSUB Mountain: x = 19: y = 57: GOSUB Mountain
x = 29: y = 56: GOSUB Mountain: x = 38: y = 54: GOSUB Mountain
x = 46: y = 55: GOSUB Mountain: x = 58: y = 53: GOSUB Mountain
x = 21: y = 66: GOSUB Mountain: x = 29: y = 63: GOSUB Mountain
x = 38: y = 63: GOSUB Mountain: x = 47: y = 62: GOSUB Mountain
x = 59: y = 66: GOSUB Mountain: x = 21: y = 73: GOSUB Mountain
x = 29: y = 74: GOSUB Mountain: x = 37: y = 71: GOSUB Mountain
x = 20: y = 80: GOSUB Mountain: x = 32: y = 82: GOSUB Mountain
x = 39: y = 80: GOSUB Mountain: x = 49: y = 75: GOSUB Mountain
x = 56: y = 75: GOSUB Mountain: x = 46: y = 83: GOSUB Mountain
x = 22: y = 89: GOSUB Mountain: x = 28: y = 91: GOSUB Mountain
x = 38: y = 89: GOSUB Mountain
EXIT SUB
'
Mountain:
LINE (x + 0, y + 4)-(x + 0, y + 5), c
LINE (x + 1, y + 3)-(x + 1, y + 5), c
LINE (x + 2, y + 1)-(x + 2, y + 3), c
LINE (x + 3, y + 0)-(x + 3, y + 2), c
LINE (x + 4, y + 2)-(x + 4, y + 4), c
LINE (x + 5, y + 3)-(x + 5, y + 5), c
LINE (x + 6, y + 4)-(x + 6, y + 5), c
RETURN
END SUB

