The Fred Fish Collection 1.5/ffcollection-1-5-1992-11.iso/ff_progs/prog_oth/amigaven.lzh/AMIGAVENTURE/AMIGAVENTURE.BAS

BASIC Source File | 1991-11-01 | 99.3 KB | 3,524 lines

DEFINT a-z
game$ = "AmigaVenture 1.17" ' Version number of game
dataformat$ = "AmigaVenture 1.1X" ' Version number for load/save only
'
'  AmigaVenture Kernal 1.17
'
'  Core routines for writing an Adventure of your own
'  In Microsoft AmigaBasic
'
'  by Mitsu Hadeishi 7/15/86
'  1460 W. 182nd Street
'  Gardena CA 90248
'
'  Written for the Winner's Circle Amiga User's Group
'
'---------------------------------------------------------------------------
'  Permission is given to freely distribute this code in full or in part
'  provided this notice is copied IN FULL.
'
'  AmigaVenture Kernal Copyright (c) 1986 by Mitsu Hadeishi
'  This code may not be used in part or in full in any commercial
'  product, nor may this code in part or in full be sold intentionally
'  to make a profit, without an explicit written agreement with the author.
'---------------------------------------------------------------------------
'
'  Please write to me if you have plans to distribute a significantly
'  modified version of the *kernal*.
'  Feel free to distribute *adventures* written with this kernal without
'  contacting me, but please! give credit where credit is due.
'
'  Updates and enhancements may be obtained from:
'
'  Mitsu Hadeishi
'  [e-mail]
'  or hadeishi%husc4.harvard.edu
'  3 Sacramento Street
'  Cambridge, MA 02138
'
'  All variables are, unless otherwise indicated, short integers.
'
GOTO Initialize

Messages:
' Message subroutines/subprograms
Cannot:
IF n$(1) = "" THEN
   PRINT"You can't "v$" "nn$(0)"!
ELSE
   PRINT"You can't "v$" "nn$(0)" "p$" "nn$(1)"!
END IF
RETURN

SUB CantSee(nn$) STATIC
PRINT"I don't see what you're referring to.
END SUB

SUB DontHave(nn$) STATIC
PRINT"You don't have "nn$"!
END SUB

SUB CantGetAt(nn$) STATIC
PRINT"You can't get at "nn$"!"
END SUB

Absurd:
ON RND(1)*2+1 GOTO Absurd1,Absurd2
Absurd1:
PRINT"Don't be absurd.":RETURN
Absurd2:
PRINT"Don't talk nonsense.":RETURN

Mystery:
PRINT"I can't see what you're referring to.
RETURN

' Prints a list of alternatives for the player to select from
' If all the choices are positionally referenced, then "that" is
' returned as 1
SUB AskAmbig(choice(2),num,that) STATIC
SHARED adj$(),par(),rel(),prepn$()

PRINT"Which do you mean:"
num = ABS(num)
FOR i = 1 TO num
   IF i = num THEN PRINT"or ";
   c=choice(i,0)
   CALL NameNoun(c,n$,nn$)
   IF c > 0 AND adj$(c) <> "" THEN
      PRINT"the "adj$(c)" "n$;
      that=-1
   ELSE
      PRINT nn$;
   END IF
   IF c > 0 AND adj$(c) = "" AND par(c) <> 0 THEN
      PRINT" that's "prepn$(rel(c)+1)" ";
      IF that <> -1 THEN that=1
      CALL NameNoun(par(c),n$,nn$)
      PRINT nn$;
   END IF
   IF i = num THEN PRINT"?" ELSE PRINT", ";
NEXT i
IF that = -1 THEN that=0
END SUB

Calc:
'
' Calculation subprograms follow
'

' Visible() determines whether noun code 'code' is visible or not.
' If type is 1, then only checks to see if visible on the player,
' if 2, then only checks to see if visible in room (but not on player).
' Returns truth value in vis
SUB Visible(code,vis,type) STATIC
SHARED par(),rel(),opaque(),closed(),lo(),l

a = type

obj = code

IF obj < 0 THEN vis=1:EXIT SUB

vis = 0
IF a = 1 THEN IF lo(obj) <> 1 THEN EXIT SUB
IF a = 2 THEN IF lo(obj) <> l THEN EXIT SUB
IF a = 0 THEN IF lo(obj) <> 1 AND lo(obj) <> l THEN EXIT SUB

vis = -1
WHILE (vis = -1)
   IF par(obj) < 2 THEN
      vis = 1
   ELSEIF (opaque(rel(obj),par(obj)) = 1) AND (rel(obj) = 0 AND closed(par(obj)) <> 0) THEN
      vis = 0
   ELSE
      obj = par(obj)
   END IF
WEND
END SUB

' Avail() determines whether noun code 'code' is available or not.
' If the object is available, but you couldn't get it out from where
' it is, returns -1
' See Visible, above, for explanation of 'type'
' Returns truth value in ava
SUB Avail(code,ava,type) STATIC
SHARED par(),rel(),closed(),lo(),l,opening(),size(),holdwater()

a = type
IF a = 0 THEN a = 3
obj = code

IF obj < 0 THEN ava=1:EXIT SUB

ava = 0
IF a = 1 THEN IF lo(obj) <> 1 THEN EXIT SUB
IF a = 2 THEN IF lo(obj) <> l THEN EXIT SUB
IF a = 0 THEN IF lo(obj) <> 1 AND lo(obj) <> l THEN EXIT SUB

siz = size(code):IF holdwater(code) = 2 THEN siz = 0

WHILE (1)
   IF par(obj)<2 THEN
      IF ava <> -1 THEN ava = 1
      EXIT SUB
   ELSEIF closed(par(obj)) <> 0 AND (rel(obj) < 2) THEN
      ava = 0
      EXIT SUB
   ELSEIF opening(rel(obj),par(obj)) < siz THEN
      ava = -1
   END IF
   obj = par(obj)
WEND
END SUB

'*** CheckLight() should be modified for your own program's way
'*** of casting light and shadow on the situation.  Returns 0
'*** for total darkness, 1 for lamp light, 2 for moonlight/nighttime,
'*** 3 for twilight, 4 for daylight
SUB CheckLight(light) STATIC
SHARED l,lamp,lampon,day,flag(),Llight(),Lon()

light = 0
IF Lon(l) THEN light = Lon(l):EXIT SUB
IF Llight(l) = 1 AND flag(day) <> 0 THEN light = flag(day):EXIT SUB

CALL Visible(lamp,vis,0)
IF (flag(lampon) = 1) AND (vis = 1) THEN light = 1
END SUB

' NameNoun() returns appropriate strings in n$ and nn$, where
' n$ is the class word for the noun code, and nn$ is "the " + n$,
' unless the noun is abstract (negative code) in which case nn$ = n$
SUB NameNoun(n,n$,nn$) STATIC
SHARED word$(),abstract$()
IF n > 0 THEN
   n$ = word$(n)
   nn$ = "the " + n$
ELSE
   n$ = abstract$(-n)
   nn$ = n$
END IF
END SUB

Calc2:
' Places in array() siblings starting with object obj and children
' which are underneath all objects in the list.
' Starts the list at array(count + 1) (this allows you to call this
' routine multiple times and list several lists)  This routine
' is used by the interpreter to list objects
SUB ListSib(obj,array(2),count(1),nn) STATIC
SHARED cc(),opaque(),right(),first()

ll = 1
cc(1) = obj
cc(0) = 0

ListSib1:
WHILE (ll > 0)
   WHILE (cc(ll))
      count(nn) = count(nn) + 1
      array(nn,count(nn)) = cc(ll)
      IF first(3,cc(ll)) <> 0 AND opaque(3,cc(ll)) = 0 THEN
         ll = ll + 1
         cc(ll) = first(3,cc(ll-1))
         GOTO ListSib1
      END IF
      cc(ll) = right(cc(ll))
   WEND
   ll = ll - 1
   cc(ll) = right(cc(ll))
WEND
END SUB

' Determines if c1 is a descendant of c2 (inside, on, etc.)
' Returns truth value in ins
SUB Inside(c1,c2,ins,rel) STATIC
SHARED par()

ins = 0
c = c1
WHILE (c)
   IF par(c) = c2 THEN ins = 1:rel = rel(c):EXIT SUB
   c = par(c)
WEND
END SUB

' EvalCond evaluates a condition on the flag() array; ret is the truth
' value returned.  The condition tested depends on the value of b;
' it is whether or not flag(a) < c, flag(a) = c, or flag(a) > c,
' depending on whether b = -1, 0, or 1, respectively.  This function
' is used to evaluate the conditionals in the map and the descriptions.
' (see Go:, Look:, and map:).
SUB EvalCond(a,b,c,ret) STATIC
SHARED flag(),random

IF a = random THEN CALL RollDice
IF b = 0 THEN
   ret = (flag(a) = c)
ELSEIF b = 1 THEN
   ret = (flag(a) > c)
ELSE
   ret = (flag(a) < c)
END IF
END SUB

SUB RollDice STATIC
SHARED flag(),random

flag(random) = RND(1) * 100
END SUB

' List all bottles in the player's possession
' Starts at array(0), returns count in a
SUB ListBottles(array(1),a) STATIC
SHARED bottles(),lo(),nbot

a = 0
FOR i = 0 TO nbot
   IF lo(bottles(i)) = 1 THEN
      CALL Avail(bottles(i),ava,1)
      IF ava THEN
         array(a) = bottles(i)
         a = a + 1
      END IF
   END IF
NEXT
END SUB

Lists:
' The following subprograms handle the linked lists of objects,
' parents, children, siblings

' Contents() prints a list of obj and all siblings and children
' If sing = 1, then just prints what's in it,
' not siblings
SUB Contents(obj,indent,sing) STATIC
SHARED cc(),mc(),mrel,pre$(),word$(),closed(),opaque(),right(),worn()
SHARED folded(),fold$(),first()

ll = 1
mc(1) = 0
cc(1) = obj

WHILE (ll > 0)
   WHILE (cc(ll) <> 0)
Contents1:
      c = cc(ll)
      mode = mc(ll)
      IF mode = 0 AND (sing = 0 OR ll > 1) AND c > 1 THEN
         PRINT TAB(indent);pre$(c)" "word$(c);
         IF folded(c) THEN
            PRINT" ("fold$(folded(c))")"
         ELSE
            PRINT
         END IF
      END IF
      IF first(mode,c) <> 0 AND (opaque(mode,c) = 0 OR (mode = 0 AND closed(c) = 0)) THEN
         nn$ = "the " + word$(c)
         PRINT TAB(indent);
         IF sing = 2 THEN
            ' *** Don't print anything
         ELSEIF mode = 0 THEN
            IF c = 1 THEN
               PRINT"You are wearing:"
            ELSE
               IF sing THEN PRINT FNcap$(nn$); ELSE PRINT nn$;
               PRINT" contains:"
            END IF
         ELSEIF mode = 1 THEN
            IF c = 1 THEN
               PRINT"You are carrying:"
            ELSE
               IF sing THEN PRINT"W"; ELSE PRINT"w";
               PRINT"rapped by "nn$", you see:"
            END IF
         ELSEIF mode = 2 THEN
            IF sing THEN PRINT"L"; ELSE PRINT"l";
            PRINT"ying on "nn$", you see:"
         ELSEIF mode = 3 THEN
            IF sing THEN PRINT"U"; ELSE PRINT"u";
            PRINT"nder "nn$", you see:"
         END IF
         ll = ll + 1
         cc(ll) = first(mode,c)
         mc(ll) = 0
         indent = indent + 3
         GOTO Contents1
      END IF
      mc(ll) = mc(ll) + 1
      IF mc(ll) > mrel THEN
         IF sing THEN IF ll = 1 THEN EXIT SUB
         cc(ll) = right(c)
         mc(ll) = 0
      END IF
   WEND
   ll = ll - 1
   indent = indent - 3
   mc(ll) = mc(ll) + 1
   IF mc(ll) > mrel THEN
      IF sing THEN IF ll = 1 THEN EXIT SUB
      cc(ll) = right(cc(ll))
      mc(ll) = 0
   END IF
WEND
END SUB

' Removes object from list and places it in limbo
SUB Remove(obj) STATIC
SHARED par(),right(),left(),rel(),first(),last()
SHARED Lfirst(),Llast(),lo(),totw(),totb(),bulk(),size()

ri = right(obj)
le = left(obj)
right(le) = ri
left(ri) = le

IF par(obj) = 0 THEN
   lc = lo(obj)
   IF Llast(lc) = obj THEN Llast(lc) = le
   IF Lfirst(lc) = obj THEN Lfirst(lc) = ri
ELSE
   pa = par(obj)
   IF last(rel(obj),pa) = obj THEN last(rel(obj),pa) = le
   IF first(rel(obj),pa) = obj THEN first(rel(obj),pa) = ri
   c = obj
   w = totw(c):b = totb(c)
   IF rel(c) = 2 THEN bulk(rel(c),pa) = bulk(rel(c),pa) - size(c)
   WHILE (pa)
      IF rel(c) < 3 THEN totw(pa) = totw(pa) - w ELSE w = 0
      IF rel(c) <> 2 THEN bulk(rel(c),pa) = bulk(rel(c),pa) - b
      IF rel(c) = 1 OR rel(c) = 2 THEN totb(pa) = totb(pa) - b ELSE b = 0
      c = par(c)
      pa = par(c)
   WEND
END IF

par(obj) = 0
left(obj) = 0
right(obj) = 0
lo(obj) = 0
rel(obj) = 0
END SUB

' Inserts object into relation to object "into".  If into is negative
' or zero, the routine will insert it into the room number -into.
' The relation is determined by "mode".  This is 0 for in, 1 for wrapped,
' 2 for on top of, and 3 for underneath (like under a table, NOT like
' under something stacked on top of the object.)
' NOTE: this routine assumes that the object has already been "Removed"
' (see above.)  The routine does not do any checking for weight, capacity,
' or mode violations.  This must be done by the calling routine, using the
' totw() and totb() arrays, which are updated by this routine.
SUB Insert(obj,into,mode) STATIC
SHARED par(),rel(),mrel,right(),left(),first(),last()
SHARED Lfirst(),Llast(),lo(),totw(),totb(),bulk(),size()

IF mode < 0 OR mode > mrel THEN EXIT SUB

right(obj) = 0

IF into > 0 THEN
   par(obj) = into
   IF first(mode,into) = 0 THEN first(mode,into) = obj
   left(obj) = last(mode,into)
   right(last(mode,into)) = obj
   last(mode,into) = obj
   rel(obj) = mode
   pa = into
   c = obj
   w = totw(c):b = totb(c)
   IF rel(c) = 2 THEN bulk(rel(c),pa) = bulk(rel(c),pa) + size(c)
   WHILE (pa)
      IF rel(c) < 3 THEN totw(pa) = totw(pa) + w ELSE w = 0
      IF rel(c) <> 2 THEN bulk(rel(c),pa) = bulk(rel(c),pa) + b
      IF rel(c) = 1 OR rel(c) = 2 THEN totb(pa) = totb(pa) + b ELSE b = 0
      c = par(c)
      pa = par(c)
   WEND
   CALL Setloc(obj,lo(into),1)
ELSE
   into = -into
   par(obj) = 0
   rel(obj) = 0
   IF Lfirst(into) = 0 THEN Lfirst(into) = obj
   left(obj) = Llast(into)
   right(Llast(into)) = obj
   Llast(into) = obj
   CALL Setloc(obj,into,1)
END IF
END SUB

' Sets the location of obj and all its descendants recursively
' If sing is 0, then all siblings are set to location l as well,
' otherwise, only obj is set
SUB Setloc(obj,l,sing) STATIC
SHARED mrel,cc(),mc(),first(),right(),lo()

lo(obj) = l
ll = 1
mc(1) = 0
cc(1) = obj

WHILE (ll > 0)
   WHILE (cc(ll) <> 0)
Setloc1:
      c = cc(ll)
      mode = mc(ll)
      lo(c) = l
      IF (first(mode,c) <> 0) THEN
         ll = ll + 1
         cc(ll) = first(mode,c)
         GOTO Setloc1
      END IF
      mc(ll) = mc(ll) + 1
      IF mc(ll) > mrel THEN
         IF sing THEN IF ll = 1 THEN EXIT SUB
         cc(ll) = right(cc(ll))
         mc(ll) = 0
      END IF
   WEND
   ll = ll - 1
   mc(ll) = mc(ll) + 1
   IF mc(ll) > mrel THEN
      IF sing THEN IF ll = 1 THEN EXIT SUB
      cc(ll) = right(cc(ll))
      mc(ll) = 0
   END IF
WEND
END SUB

' Removes the list of objects related to "code" in the relationship
' "mode" (0 - in, 1 - wrapped, 2 - on, 3 - underneath).
' Returns the first object in the list in "head".
' ***WARNING***:
' This routine DOES NOT set the location pointers, to speed up routines
' that set the location pointers themselves.  Therefore the list is
' unlinked (it won't show up in a "look" or "examine", etc.) but if you
' ask whether or not the objects are visible or accessibile (with
' Visible() and Avail()) they will still be "there" in the room.
' To send them to limbo, call Setloc(head,0,0) after RemList.
SUB RemList(code,mode,head) STATIC
SHARED par(),rel(),right(),first(),last(),Lfirst(),Llast()
SHARED totw(),totb(),bulk(),size()

IF code > 0 THEN
   head = first(mode,code)
   first(mode,code) = 0
   last(mode,code) = 0
ELSE
   code = -code
   head = Lfirst(code)
   Lfirst(code) = 0
   Llast(code) = 0
END IF

c = head
WHILE (c)
   pa = par(c)
   d = c
   w = totw(c):b = totb(c)
   IF rel(c) = 2 THEN bulk(rel(c),pa) = bulk(rel(c),pa) - size(c)
   WHILE (pa)
      IF rel(c) < 3 THEN totw(pa) = totw(pa) - w ELSE w = 0
      IF rel(c) <> 2 THEN bulk(rel(c),pa) = bulk(rel(c),pa) - b
      IF rel(d) = 1 OR rel(d) = 2 THEN totb(pa) = totb(pa) - b ELSE b = 0
      d = par(d)
      pa = par(d)
   WEND
   par(c) = 0
   rel(c) = 0
   c = right(c)
WEND
END SUB

' Concat concatenates the list of objects beginning with "head" into
' relationship with "code" in the manner "mode".  If code is
' positive, it is an object, if negative, it is a location.
' This routine typically called after RemList.
SUB Concat(head,code,mode) STATIC
SHARED lo(),par(),rel(),left(),right(),first(),last(),Lfirst(),Llast()
SHARED totw(),totb(),bulk(),size()

IF head = 0 THEN EXIT SUB
into = code
IF code <= 0 THEN mode = 0:into = 0
totw = 0:totb = 0
c = head
WHILE (c)
   rel(c) = mode
   par(c) = into
   pa = into
   d = c
   w = totw(c):b = totb(c)
   IF rel(c) = 2 THEN bulk(rel(c),pa) = bulk(rel(c),pa) + size(c)
   WHILE (pa)
      IF rel(c) < 3 THEN totw(pa) = totw(pa) + w ELSE w = 0
      IF rel(c) <> 2 THEN bulk(rel(c),pa) = bulk(rel(c),pa) + b
      IF rel(d) = 1 OR rel(d) = 2 THEN totb(pa) = totb(pa) + b ELSE b = 0
      d = par(d)
      pa = par(d)
   WEND
   tail = c
   c = right(c)
WEND
IF code > 0 THEN
   left(head) = last(mode,code)
   right(last(mode,code)) = head
   IF first(mode,code) = 0 THEN first(mode,code) = head
   last(mode,code) = tail
   lc = lo(code)
ELSE
   code = -code
   left(head) = Llast(code)
   right(Llast(code)) = head
   IF Lfirst(code) = 0 THEN Lfirst(code) = head
   Llast(code) = tail
   lc = code
END IF
CALL Setloc(head,lc,0)
END SUB

WaterLists:
' Fill() fills the obj with the specified about of water.  Returns
' the actual amount filled in wat.
SUB Fill(obj,wat) STATIC
SHARED totw(),totb(),bulk(),par(),rel(),cap(),size()

IF obj < 0 THEN EXIT SUB
IF wat = 0 THEN EXIT SUB

c=obj
IF cap(0,c)=-1 THEN RETURN 'Infinite capacity (river, lake, etc.)
' Check for overflow/underflow
IF wat + bulk(0,c) > cap(0,c) THEN
   wat = cap(0,c) - bulk(0,c)
   IF wat < 0 THEN wat = 0:EXIT SUB
ELSEIF wat + bulk(0,c) <= 0 THEN
   wat = -bulk(0,c)
   CALL Empty(obj)
   EXIT SUB
END IF

c = obj
IF par(c+1) = 0 THEN ' No current water object inside c
   totw(c+1) = wat
   totb(c+1) = wat
   size(c+1) = wat
   CALL Insert(c+1,c,0)
   EXIT SUB
ELSE ' Must modify bulk, weight in c
   totw(c+1) = totw(c+1) + wat
   totb(c+1) = totw(c+1) + wat
   size(c+1) = size(c+1) + wat
   bulk(0,c) = bulk(0,c) + wat
   WHILE (c)
      totw(c) = totw(c) + wat
      IF rel(c) < 3 THEN c = par(c) ELSE c = 0
   WEND
END IF
END SUB

' Empties the water from object "obj".  This routine DOES
' check to make sure the object IS a container
SUB Empty(obj) STATIC
SHARED holdwater(),par(),cap(),size(),totw(),totb()

IF obj < 0 THEN EXIT SUB
IF cap(0,obj)=-1 THEN RETURN 'Infinite capacity (river, lake, etc.)
IF holdwater(obj) <> 1 THEN EXIT SUB
IF par(obj+1) = 0 THEN EXIT SUB
CALL Remove(obj+1)
size(obj+1) = 0
totw(obj+1) = 0
totb(obj+1) = 0
END SUB

' The Tumble routine takes all objects that are stacked on top of
' the object obj and makes them siblings of obj
SUB Tumble(obj) STATIC
SHARED cc(),c1(),c2(),lo(),par(),first(),right()

ll = 1
cc(1) = first(2,obj)
IF cc(1) = 0 THEN EXIT SUB
tum = 0
c1(tum) = obj

PRINT c1(tum)
WHILE (ll > 0)
   WHILE (cc(ll) <> 0)
Tumble1:
      c = cc(ll)
      IF (first(2,c) <> 0) THEN
         tum = tum + 1
         c1(tum) = c
         ll = ll + 1
         cc(ll) = first(2,c)
         GOTO Tumble1
      END IF
      cc(ll) = right(cc(ll))
   WEND
   ll = ll - 1
   cc(ll) = right(cc(ll))
WEND
FOR i = 0 TO tum
   CALL RemList(c1(i),2,c2(i))
NEXT i
lc = par(obj)
IF lc = 0 THEN lc = -lo(obj)
FOR i = 0 TO tum
   CALL Concat(c2(i),lc,0)
NEXT i
END SUB

'
' Interpreter subprograms follow
'

Interpreter:
' GetVerb() returns a verb code in v and a verb string in v$,
' and returns cmd$ starting with the first word following the verb phrase
SUB GetVerb(cmd$,v,v$) STATIC
SHARED verb$()

IF cmd$ = "" THEN EXIT SUB
cc(3) = -1
FOR i = 2 TO 0 STEP -1
cc(i) = INSTR(cc(i+1)+2,cmd$," ") - 1
NEXT i

FOR i = 0 TO 2 '*** Search 3-word, 2-word, then 1-word verb lists
IF cc(i) < 0 THEN GetVerb1
c$ = "," + LEFT$(cmd$,cc(i)) + ","
c = INSTR(verb$(i),c$)
IF c <> 0 THEN vl = i:i = 2
GetVerb1:
NEXT i

IF c = 0 THEN
   EXIT SUB
ELSE
   v$ = MID$(c$,2,LEN(c$) - 2)
   lv = LEN(v$)
   v = VAL(MID$(verb$(vl),c + lv + 2))
   cmd$ = MID$(cmd$,lv + 2)
   WHILE (MID$(cmd$,1,1) = " ")
     cmd$ = MID$(cmd$,2)
   WEND
END IF
END SUB

' ExNoun() returns an array of noun code choices and a count
' Returns 0 in nch if no noun is found
' Returns -1 if inconsistent nouns are found (like "diamond sandwich", etc.)
' Returns 1 in "that" if a "that" clause is identified
' Note: this routine exits immediately after ambiguity is resolved.
' This routine truncates cmd$
SUB ExNoun(cmd$,choice(2),nch,that) STATIC
SHARED mhom,nnoun,noun$,nindex(),nhom(),ncode()
ll = 0
ExNoun1:

IF cmd$ = "" THEN ExNoun2
c$ = ","+LEFT$(cmd$,INSTR(cmd$," ")-1)+","
c = INSTR(noun$,c$)
IF c = 0 THEN ExNoun2
ln = LEN(c$) - 2
i = VAL(MID$(noun$,c + ln + 2))
cmd$ = MID$(cmd$,ln + 2)
WHILE (MID$(cmd$,1,1) = " ")
  cmd$ = MID$(cmd$,2)
WEND

IF ncode(nindex(i)) = -14 THEN that = 1:GOTO ExNoun2 ' Found "that"
IF ncode(nindex(i)) = -15 THEN ' "what's" == "everything that"
   IF nch THEN nch = -1:EXIT SUB
   choice(1,0) = -11:nch = 1:that = 1
   CALL SkipNoun(cmd$)
   EXIT SUB
END IF
IF (nhom(i) = 0) THEN ExNoun1 '*** Null word, get next word
IF (nch = 0) THEN   '*** Empty context
   FOR j = 1 TO nhom(i)   '*** Ambiguous
      code = ncode(nindex(i) + j - 1)
      nch = nch + 1
      choice(nch,ll) = ncode(nindex(i) + nch -1)
   NEXT j
   ll = 1 - ll
   GOTO ExNoun1
ELSE   '*** Try to resolve ambiguity within old context
   newnch = 0
   FOR j = 1 TO nch
      FOR k = 1 TO nhom(i)
         code = ncode(nindex(i)+k-1)
         IF choice(j,1-ll) = code THEN
            newnch = newnch + 1
            choice(newnch,ll) = code
            k = mhom
         END IF
      NEXT k
   NEXT j
   IF newnch = 0 THEN
      nch = -1:REM inconsistent nouns
      EXIT SUB
   END IF
   nch = newnch
   ll = 1 - ll
   GOTO ExNoun1
END IF

ExNoun2:
IF ll = 0 THEN
   FOR i = 1 TO nch
      choice(i,0) = choice(i,1)
   NEXT i
END IF

END SUB

' Skip noun (skips nouns without looking at meaning)
SUB SkipNoun(cmd$) STATIC
SHARED noun$
ll = 0

SkipNoun1:

IF cmd$ = "" THEN EXIT SUB

c$ = ","+LEFT$(cmd$,INSTR(cmd$," ")-1)+","
c = INSTR(noun$,c$)
IF c = 0 THEN EXIT SUB
cmd$ = MID$(cmd$,LEN(c$))
WHILE (MID$(cmd$,1,1) = " ")
  cmd$ = MID$(cmd$,2)
WEND
GOTO SkipNoun1

END SUB

' GetNoun() uses ExNoun to return all possible noun code choices,
' and tries to resolve the ambiguity by calling ChooseVisible to
' see if the object is in the room or on the player.  If this
' fails, then tries using the vtype1 flag, and then the vtype2
' flag (see ChooseVisible for explanation of vtype.)  (vtype1 is
' nounat(verb) and vtype2 is noundef(verb) (see Commands for
' explanation of nounat and noundef.))
' Returns ch = -1 for inconsistent nouns
' Returns ch = -2 for ambiguity not resolved by visual check
' Returns that = 1 if a "that" clause follows
' See ExNoun() and ChooseVisible()
SUB GetNoun(cmd$,choice(2),ch,n,vtype1,vtype2,that) STATIC
SHARED c1()
z = 0
c1(0) = 0:c1(1) = vtype1:c1(2) = vtype2
IF vtype1 <> c1(z) THEN z = z + 1:c1(z) = vtype1
IF vtype2 <> c1(z) THEN z = z + 1:c1(z) = vtype2

och = ch
CALL ExNoun(cmd$,choice(),ch,that)
IF that THEN IF ch = och THEN EXIT SUB
IF ch = 1 THEN
   n = choice(1,0)
ELSEIF ch = -1 THEN
   EXIT SUB
ELSE  '*** Try to resolve ambiguity
   FOR i = 0 TO z
      CALL ChooseVisible(choice(),ch,c1(i))
      IF ch = 1 THEN 'Found it
         n = choice(1,0)
         EXIT SUB
      ELSEIF ch < -1 AND i = 0 THEN 'Can't see anywhere
         ch = -2
         EXIT SUB
      ELSEIF ch <= 0 THEN 'Return last step's ambiguity
         ch = -ch
         EXIT SUB
      END IF
   NEXT i
END IF

END SUB

' Get preposition
SUB GetPrep(cmd$,p) STATIC
SHARED prep$,prepn$()

WHILE (1)
IF cmd$ = "" THEN EXIT SUB
c$ = ","+LEFT$(cmd$,INSTR(cmd$," ")-1)+","
c = INSTR(prep$,c$)
IF c = 0 THEN EXIT SUB
lp = LEN(c$) - 2
p = VAL(MID$(prep$,c + lp + 2))
cmd$ = MID$(cmd$,lp + 2)
WHILE (MID$(cmd$,1,1) = " ")
  cmd$ = MID$(cmd$,2)
WEND
WEND

END SUB

' Routine scans the choice array and returns an array with only
' visible items.  Returns the same array with a negative
' nchoice if none of the items are visible.
' If vtype is 1, then only checks to see if object is visible on the
' player, and if 2, then only checks if objects is visible in room,
' but not carried by player.  If 0, checks both places.
SUB ChooseVisible(choice(2),nchoice,vtype) STATIC
SHARED mhom

IF nchoice < 2 THEN EXIT SUB
newnchoice = 0
FOR i = 1 TO nchoice
   CALL Visible(choice(i,0),vis,vtype)
   IF (vis) THEN
      newnchoice = newnchoice + 1
      choice(newnchoice,1) = choice(i,0)
   END IF
NEXT i
IF newnchoice = 0 THEN
   nchoice = -nchoice
   EXIT SUB
ELSE
   nchoice = newnchoice
   FOR i = 1 TO nchoice
      choice(i,0) = choice(i,1)
   NEXT i
END IF
END SUB

' Parses the cmd$ string and returns the next preposition and
' noun (used in a sentence like "get the water that's *in the bottle*")
' Returns -1 in tp if player overrided command in an AskAmbig process
' Returns -2 in tp if player makes a fatal grammatical error
SUB GetThatClause(cmd$,tp,tn) STATIC
SHARED nchoice2()

IF tp THEN GetThatClause1
tn = 0:tp = 0
CALL SkipNoun(cmd$)
CALL GetPrep(cmd$,tp)
GetThatClause1:
IF tp < 1 OR tp > 4 THEN EXIT SUB
nch = 0:ambig = 0:that = 0
GetThatClause2:
CALL GetNoun(cmd$,nchoice2(),nch,tn,0,0,that)
IF that THEN
   PRINT"Your language is too complex for me.  Please restate."
   tp = -2
   EXIT SUB
END IF
IF ambig = 1 AND nch = 0 THEN ' AskAmbig (see below) failed, so
   cmd$ = amb$ ' assume that the player overrided the old command, and
   tp = -1 ' return a -1 error flag
   EXIT SUB
ELSE
   ambig = 0 ' Clear AskAmbig flag
END IF
IF nch = -1 THEN GOSUB Absurd:tp = -2:EXIT SUB
IF nch = -2 THEN GOSUB Mystery:tp = -2:EXIT SUB
IF nch > 1 THEN ' Ask player to resolve ambiguity
   CALL AskAmbig(nchoice2(),nch,that)
   IF that THEN PRINT"Wait a sec---I'm getting confused.  Let's start over from the beginning.":EXIT SUB
   PRINT:LINE INPUT"> ";amb$:amb$ = amb$ + " ":PRINT
   cmd$ = amb$ + cmd$:ambig = 1 ' (see above)
   GOTO GetThatClause2 ' Try to resolve ambiguity
END IF
END SUB

' Skips a clause of the form preposition-noun
SUB SkipThatClause(cmd$) STATIC

CALL SkipNoun(cmd$)
CALL GetPrep(cmd$,a)
CALL SkipNoun(cmd$)
END SUB

' Attempts to resolve ambiguity by choosing only those
' items in array(,0) that are related to tn by mode tr
' (i.e., only objects that are "in" the "bottle", "on" the "table", etc.)
SUB ResolveThat(array(2),nch,n,tr,tn) STATIC
SHARED par(),rel(),mrel

IF tn<0 THEN EXIT SUB
IF tr<0 OR tr>mrel THEN EXIT SUB

nnch = 0
FOR i = 1 TO nch
   IF array(i,0) < 0 THEN
      nnch = nnch + 1
      array(nnch,1) = array(i,0)
   ELSEIF par(array(i,0)) = tn AND rel(array(i,0)) = tr THEN
      nnch = nnch + 1
      array(nnch,1) = array(i,0)
   END IF
NEXT
nch = nnch
FOR i = 1 TO nch
   array(i,0) = array(i,1) ' Copy array to position zero
NEXT
IF nch = 1 THEN n = array(1,0)
END SUB

Initialize:
CLS
PRINT"Welcome to "game$"!
PRINT"One moment please . . ."

DEF FNcap$(a$) = CHR$(ASC(a$) AND 223) + MID$(a$,2)
z$ = CHR$(8)

' Stack for routines which recursively search object lists
' (Maximum stack depth 30)
mdepth = 30
DIM cc(mdepth),mc(mdepth)

' General storage arrays for subroutines
mlist = 50
DIM c1(mlist),c2(mlist)

' Read abstract descriptions
RESTORE abstract
READ mabs 'Maximum # of abstract nouns
DIM abstract$(mabs),abstract(mabs)
READ a
WHILE (a <> 0)
   READ abstract$(a)
   READ a
   IF a > nabs THEN nabs = a
WEND

' Read "folded" state
RESTORE fold
READ mfold
DIM fold$(mfold)
nfold = 0
READ f$
WHILE (f$ <> "")
   nfold = nfold + 1
   fold$(nfold) = f$
   READ f$
WEND

' Read verbs
RESTORE Verbs
DIM verb$(2)
nverb = 0
FOR i = 0 TO 2
   v = 1
   WHILE (v <> 0)
      READ v$,v
      verb$(i) = verb$(i) + "," + v$ + "," + STR$(v)
      IF v > nverb THEN nverb = v
   WEND
NEXT i

' Read verb attributes (verbs must be in order!)
RESTORE Commands
DIM reqnoun(1,nverb),defprep(nverb),nounat(1,nverb)
DIM noundef(1,nverb),nounpl(1,nverb)
FOR i = 1 TO nverb
   READ reqnoun(0,i),reqnoun(1,i),defprep(i),nounat(0,i),nounat(1,i)
   READ noundef(0,i),noundef(1,i),nounpl(0,i),nounpl(1,i)
NEXT i

'*** Set the null verb's "attributes"
nounpl(0,0) = 2:nounpl(1,0) = 2

' Read nouns
RESTORE Nouns
READ mnouns,mcode
DIM nindex(mnouns),nhom(mnouns),ncode(mcode)
noun$ = ""
nnoun = 0
mhom = 0:REM maximum number of homonyms for any noun
nbase = 0:REM start at base of ncode table
code = 0
READ n$
WHILE (n$ <> "")
   noun$ = noun$ + "," + n$ + "," + STR$(nnoun)
   hom = 0
   nindex(nnoun) = nbase
   READ code
   WHILE (code <> 0)
      ncode(nbase) = code
      nbase = nbase + 1
      hom = hom + 1
      READ code
   WEND
   nhom(nnoun) = hom
   IF hom > mhom THEN mhom = hom
   nnoun = nnoun + 1
   READ n$
WEND

' Read prepositions
RESTORE Prepositions
prep$ = ""
nprep = 0
READ p$
WHILE (p$ <> "")
   READ p
   nprep = nprep + 1
   prep$ = prep$ + "," + p$ + "," + STR$(p)
   READ p$
WEND

' Read preposition names
RESTORE Prepnames
DIM prepn$(nprep)
READ p$
nprepn = -1
WHILE (p$ <> "")
   nprepn = nprepn + 1
   prepn$(nprepn) = p$
   READ p$
WEND
imap:
' Read map (see Locations: for details)
PRINT"I am reading the map . . ."
RESTORE map
READ mloc,avdes,mmcond,mfcond,avfcond
DIM map(mloc,9),Llight(mloc),Lon(mloc)
DIM dindex(mloc),des$(mloc * avdes)
DIM mcond(4,mloc),mmes$(mloc)
DIM findex(mloc),fcond(5,mfcond),fdes$(mfcond * avfcond)
REM N,NE,E,SE,S,SW,W,NW,U,D, water, light, lighton?
nloc = 1:ndes = 0:nmcond = 0:nfcond = 0:nfcdes = 0
READ l
WHILE (l <> 0)
   nloc = nloc + 1
   IF nloc <> l THEN PRINT"MAP IS IN BAD FORMAT AT LOC"nloc:STOP
   cmcond = 0 ' Count the number of map cond. in this location
   FOR i = 0 TO 9
      READ n
      IF (n < 0) AND (n > -99) THEN
         n = -n
         IF n > cmcond THEN cmcond = n
         map(l,i) = -nmcond - n
      ELSE
         map(l,i) = n
      END IF
   NEXT i
   READ Llight(l),Lon(l)
   FOR j = 1 TO cmcond ' Read map conditionals (if there are any)
      nmcond = nmcond + 1
      FOR k = 0 TO 4
         READ mcond(k,nmcond)
      NEXT k
      READ mmes$(nmcond)
   NEXT j
   dindex(l) = ndes
   READ des$(ndes) ' First line is short description (can be NULL)
   WHILE (des$(ndes) <> "") ' Succeeding lines are long descriptions
      ndes = ndes + 1
      READ des$(ndes)
   WEND
   READ a,b,c,d
   findex(l) = nfcond + 1
   WHILE (a <> -1) ' Read a flag conditional
      nfcond = nfcond + 1
      fcond(0,nfcond) = a:fcond(1,nfcond) = b:fcond(2,nfcond) = c
      fcond(3,nfcond) = d:fcond(4,nfcond) = nfcdes
      READ fdes$(nfcdes)
      WHILE (fdes$(nfcdes) <> "")
         nfcdes = nfcdes + 1
         READ fdes$(nfcdes)
      WEND
      READ a,b,c,d
   WEND
   READ l
WEND
dindex(nloc+1) = ndes:fcond(4,nfcond+1) = nfcdes ' Mark end of description lists
findex(nloc+1) = nfcond + 1 ' and mark end of flag lists

' Read flags
' Flag 1 is lamp on/off, flag 2 is daytime/nighttime
RESTORE Flags
READ mflag
nflag = 0
DIM flag(mflag)
READ f
WHILE (f)
   IF f>nflag THEN nflag = f
   READ flag(f),f
WEND

iobj:
' Read objects
DIM Lfirst(nloc),Llast(nloc),seen(nloc)
RESTORE Objects
READ mobj,mrel,mbot
DIM pre$(mobj),word$(mobj),adj$(mobj),long$(mobj)
DIM lo(mobj),par(mobj),rel(mobj)
DIM first(mrel,mobj),last(mrel,mobj),left(mobj),right(mobj)
DIM size(mobj),opening(mrel,mobj),cap(mrel,mobj),opaque(mrel,mobj)
DIM closed(mobj),openable(mobj)
DIM folded(mobj),foldable(mobj),locked(mobj),holdwater(mobj)
DIM worn(mobj),wearable(mobj),soft(mobj),food(mobj),immobile(mobj)
DIM totw(mobj),totb(mobj),bulk(mrel,mobj)
DIM bottles(mbot)
nbot = -1 ' Keep a list of bottles
' Read objects
nobj = 0
READ n
WHILE (n <> 0)
   IF (n > nobj) THEN nobj = n
   READ pre$(n),word$(n),adj$(n),long$(n)
   READ lo(n),par(n),rel(n)
   READ size(n),wei
   FOR i = 0 TO mrel
       READ opening(i,n)
   NEXT i
   anycap = 0
   FOR i = 0 TO mrel
       READ cap(i,n)
       anycap = anycap OR cap(i,n)
   NEXT i
   FOR i = 0 TO mrel
       READ opaque(i,n)
   NEXT i
   READ closed(n),openable(n),folded(n),foldable(n),locked(n)
   READ holdwater(n),worn(n),wearable(n),soft(n),food(n),immobile(n)
   IF holdwater(n) THEN nbot = nbot + 1:bottles(nbot) = n
   totw(n) = wei
   totb(n) = size(n)
   IF par(n) <> 0 OR immobile(n) = 0 OR anycap <> 0 THEN
      IF par(n) THEN
         CALL Insert(n,par(n),rel(n))
      ELSE
         CALL Insert(n,-lo(n),0)
      END IF
   END IF
   READ n: REM next object
WEND

Arrays:
' Arrays hold homonyms for ambiguity resolution
DIM nchoice(mhom + 2,1),nchoice2(mhom + 2,1)

' Arrays hold lists of nouns and objects
DIM lnoun(1,mlist),nlnoun(1),ncount(1),olnoun(mlist)
DIM mnoun(1,mlist),mlnoun(1),mcount(1)

' Commands can be superseded temporarily by other commands (e.g.,
' if you say "wear hat" you must first "take" it; the program will
' automatically do this) But for the sake of the multiple-noun
' sequences, etc., the command must be restored to its original
' form, even if it has been superseded.  Thus, you use RecordCommand
' and RestoreCommand to store this activity on a "command stack".
' The Alias() subprogram does this automatically for you.
mrlev = 10 ' Maximum ten (!) levels of command stack
DIM vo(mrlev),po(mrlev),no(mrlev,1)
DIM vo$(mrlev),po$(mrlev),no$(mrlev,1),nno$(mrlev,1)

' Arrays hold the direct object and indirect object
DIM n(1),n$(1),nn$(1)

Initvals:
GOSUB Flags ' Set mnemonic variables
fdindex = 4 ' internal use constant (see Look:)
fseen = 5 ' internal use constant (see SaveGame: and Look:)

' Setup starting values
l = 2:ol = 2:REM You start in room 2
t = flag(tim):REM time is kept by flag variable "tim"
GOSUB ClearCommand:FOR z = 0 TO 1:ncount(z) = 0:nlnoun(z) = 0:NEXT
v = 1:REM "Look" is the first command
v$ = "look"

Player:
maxcap = 15:maxweight = 50:REM Player's capacity, total weight capacity
maxgrab = 20:maxlift = 40:REM Maximum size, weight, player can lift (see Take:)
fat = 20:REM Size of player while sitting (3*fat is size when lying down)

GOTO PreProcess

NewCommand:
rlev = 0 ' Clear command stack
GOSUB RecordCommand
GOSUB ClearCommand
GOSUB ClearList
ncmd$ = "":GOTO InCommand

ContCommand:
rlev = 0 ' Clear command stack
GOSUB RecordCommand
ncmd$ = "":GOTO InCommand

GetCommand:
rlev = 0 ' Clear command stack
IF nlnoun(1) THEN '*** take care of multiple indirect objects
   ncount(1) = ncount(1) + 1
   IF ncount(1) <= nlnoun(1) THEN
      n(1) = lnoun(1,ncount(1))
      CALL NameNoun(n(1),n$(1),nn$(1))
      PRINT p$" "nn$(1)": ";
      GOTO Filter
   END IF
END IF
IF nlnoun(0) THEN '*** take care of multiple direct objects
   ncount(0) = ncount(0) + 1
   IF ncount(0) <= nlnoun(0) THEN
      ncount(1) = 1
      IF nlnoun(1) THEN n(0) = lnoun(1,1)
      n(0) = lnoun(0,ncount(0))
      CALL NameNoun(n(0),n$(0),nn$(0))
      PRINT nn$(0)": ";
      GOTO Filter
   END IF
END IF
GOSUB RecordCommand
GOSUB ClearCommand
GOSUB ClearList

InCommand:
PRINT
IF ncmd$ = "" THEN
   LINE INPUT"> ";cmd$:PRINT:cmd$ = cmd$ + " "
ELSE
   GOSUB waitforesc:IF a$ = CHR$(27) THEN NewCommand
   cmd$ = ncmd$
END IF

Parse: ' Take care of grammatical quirks
a = INSTR(cmd$,".") ' Periods
IF (a) THEN
   ncmd$ = MID$(cmd$,a+1)
   WHILE (MID$(ncmd$,1,1) = " ")
      ncmd$ = MID$(ncmd$,2)
   WEND
   cmd$ = LEFT$(cmd$,a-1) + " "
ELSE
   ncmd$ = ""
END IF
a = INSTR(cmd$,",and ") ' Replace commas
WHILE (a)
   cmd$ = LEFT$(cmd$,a-1)+" and "+MID$(cmd$,a+5)
   a = INSTR(cmd$,",and ")
WEND
a = INSTR(cmd$,", and ")
WHILE (a)
   cmd$ = LEFT$(cmd$,a-1)+" and "+MID$(cmd$,a+6)
   a = INSTR(cmd$,", and ")
WEND
a = INSTR(cmd$,",")
WHILE (a)
   cmd$ = LEFT$(cmd$,a-1)+" and "+MID$(cmd$,a+1)
   a = INSTR(cmd$,",")
WEND
WHILE (MID$(cmd$,1,1) = " ") ' Get rid of excess spaces
   cmd$ = MID$(cmd$,2)
WEND

Interpret: ' nn is the noun number (0 = direct obj, 1 = indirect obj)
IF cmd$ = "" THEN PRINT"Say what?":GOTO ContCommand
nlnoun(0) = 0:nlnoun(1) = 0 '*** stop multiple noun loops
ocmd$ = cmd$:locmd=LEN(ocmd$)
IF noobj THEN v = 0 '*** See Filter: for origin of noobj flag
CALL GetVerb(cmd$,v,v$)
IF noobj THEN
   IF v <> 0 AND v <> vo THEN
      vo=v:vo$=v$
      GOSUB ClearCommand '*** User can override old verb
      v=vo:v$=vo$
   ELSE
      v=vo
   END IF
END IF
IF cmd$ = "" THEN PreProcess
IF noobj THEN InPrep

ambig=0:but=0:cand=0:nch=0:that=0:nn=0
InNoun:
CALL GetNoun(cmd$,nchoice(),nch,n(nn),nounat(nn,v),noundef(nn,v),that)
IF nch = -1 THEN PRINT"I don't understand what you're talking about.":GOTO NewCommand
IF nch = -2 THEN GOSUB Mystery:GOTO NewCommand
IF nn = 0 THEN
   IF cmd$<>"" AND nounpl(1,v) = 0 THEN ' default "that" clause?
      tn=0:c=0:CALL GetPrep(cmd$,c)
      IF c > 0 AND c < 8 THEN
         tp=c:that=1:GOTO InThatClause
      ELSE ' Message for InPrep not to scan again for a preposition
         trp=c
      END IF
   END IF
END IF
IF that THEN ' "that" clause
   tp=0:tn=0
InThatClause:
   IF nch = 0 THEN
      CALL SkipThatClause(cmd$)
   ELSE
      CALL GetThatClause(cmd$,tp,tn)
      IF tp = -1 THEN Parse
      IF tp = -2 THEN NewCommand
      IF ambig = 1 AND tn = 0 THEN 'Ambig resolution failed, so
         GOTO Parse ' assume player overrided old command and start over
      END IF
      IF tp < 0 OR tp > 4 OR tn = 0 THEN
         IF cmd$ <> "" THEN
            PRINT"I don't know what you mean by '"cmd$"'.
            GOTO NewCommand
         ELSE
            PRINT"That's . . . what?" ' Try to resolve ambiguity
            PRINT:LINE INPUT"> ";cmd$:cmd$=cmd$+" ":PRINT
            ambig=1:GOTO InThatClause
         END IF
      END IF
      CALL ResolveThat(nchoice(),nch,n(nn),tp-1,tn)
      IF nch = 0 THEN GOSUB Mystery:GOTO NewCommand
   END IF
END IF
IF ambig = 1 AND nch = 0 THEN ' AskAmbig (see below) failed, so
   cmd$=amb$ ' assume that the player overrided the old command, and
   GOTO Parse  ' start over
ELSE
   ambig = 0 ' Clear AskAmbig flag
END IF
IF nch > 1 THEN ' Ask player to resolve ambiguity
   that = 0:CALL AskAmbig(nchoice(),nch,that)
   PRINT:LINE INPUT"> ";amb$:amb$ = amb$ + " ":PRINT
   cmd$ = amb$ + cmd$:ambig = 1 ' (see above)
   GOTO InNoun ' Try to resolve ambiguity
END IF
IF nch THEN
   IF n(nn) = -12 THEN ' Resolve pronoun ambiguity
      IF no(0,1) > 0 THEN ' Choose last noun referenced
         n(nn)=no(0,1)
      ELSEIF no(0,0) > 0 THEN
         n(nn)=no(0,0)
      ELSE
         n(nn)=0
      END IF
      IF n(nn) <> 0 THEN
         CALL NameNoun(n(nn),n$,nn$)
         IF nn = 0 THEN
            PRINT"("nn$")
         ELSE
            PRINT"("p$" "nn$")
         END IF
      END IF
   END IF
   IF but = 0 THEN ' "and" clause
      IF n(nn) = -11 THEN ' this is the "all" noun
         na = noundef(nn,v):IF na = 0 THEN na = 3
         IF that = 1 AND tp > 0 AND tn > 0 THEN ' everything that's in ...
            that = 0
            CALL Visible(tn,vis,0)
            IF vis = 0 THEN GOSUB Mystery:GOTO NewCommand
            ' Place test particle in tn, relation tp-1, to see if
            ' stuff in there is visible or not
            lo(0)=lo(tn):par(0)=tn:rel(0)=tp-1
            CALL Visible(0,vis,0)
            IF vis THEN
ThatAgain:
               CALL ListSib(first(tp-1,tn),lnoun(),nlnoun(),nn)
            ELSE
               IF closed(tn) THEN
                  PRINT"(opening the "word$(tn)" first): ";
                  CALL Alias("open",8,(tn),0,0):GOSUB OpenIt
                  GOSUB RestoreCommand
                  lo(0)=lo(tn):par(0)=tn:rel(0)=tp-1
                  CALL Visible(0,vis,0)
                  IF vis=0 THEN NewCommand ELSE GOTO ThatAgain
               ELSE
                  GOSUB Mystery:GOTO NewCommand
               END IF
            END IF
         ELSE
            IF na AND 1 THEN CALL ListSib(first(1,1),lnoun(),nlnoun(),nn)
            IF na AND 2 THEN CALL ListSib(Lfirst(l),lnoun(),nlnoun(),nn)
         END IF
         IF nlnoun(nn) = 0 THEN n(nn) = 0 ELSE n(nn) = lnoun(nn,1)
      ELSEIF n(nn) = -13 THEN ' plural pronoun
         IF ncount(nn) = 0 THEN
            FOR i = 1 TO onlnoun
               nlnoun(nn) = nlnoun(nn) + 1
               lnoun(nn,nlnoun(nn)) = olnoun(i)
            NEXT
            IF nlnoun(nn) = 0 THEN n(nn) = 0 ELSE n(nn) = lnoun(nn,1)
         END IF
      ELSEIF n(nn) <> 0 THEN
         nlnoun(nn) = nlnoun(nn) + 1
         lnoun(nn,nlnoun(nn)) = n(nn)
      END IF
   ELSE '"but" clause
      IF n(nn) = -11 THEN PRINT"You humans have a strange way of speaking.":GOTO NewCommand
      IF n(nn) = -13 THEN ' plural pronoun
         FOR i = 1 TO onlnoun
            a = 0
            FOR j = 1 TO nlnoun(nn)
               IF lnoun(nn,j) = olnoun(i) THEN a=1:nlnoun(nn)=nlnoun(nn)-1
               IF a THEN lnoun(nn,i) = lnoun(nn,i+1)
            NEXT
         NEXT
      ELSE ' single word
         a = 0
         FOR i = 1 TO nlnoun(nn)
            IF lnoun(nn,i) = n(nn) THEN a = 1:nlnoun(nn) = nlnoun(nn) - 1
            IF a THEN lnoun(nn,i) = lnoun(nn,i+1)
         NEXT
      END IF
      IF nlnoun(nn) THEN n(nn) = lnoun(nn,1) ELSE n(nn) = 0
   END IF
ELSE
   IF cand = 1 THEN ncmd$ = cmd$+"."+ncmd$:cmd$ = "":GOTO PreProcess
END IF
IF cmd$ = "" THEN PreProcess

InPrep:
lcmd = LEN(cmd$)
c = 0:IF trp THEN c=trp:trp=0 ELSE CALL GetPrep(cmd$,c)
IF c = 0 THEN PreProcess
IF c < 8 AND nn = 0 THEN p = c:ploc = locmd-lcmd ' Record prep location
IF cmd$ = "" THEN PreProcess
IF (c = 8 AND nn = 0 AND n(0) = 0) THEN
   ncmd$ = cmd$ + "." + ncmd$
   cmd$ = ""
   GOTO PreProcess
END IF
IF c = 8 THEN cand = 1:nch = 0:that = 0:GOTO InNoun ' and ...
IF c = 9 THEN but = 1:nch = 0:that = 0:GOTO InNoun ' but ...
IF nn = 1 THEN ' What!? Insert a "that's" and start over
   IF warnthat < 3 THEN
      warnthat = warnthat + 1
      PRINT"(Please use more specific language in the future, e.g.,
      PRINT CHR$(34)LEFT$(ocmd$,ploc)"THAT'S "MID$(ocmd$,ploc+1)CHR$(8)CHR$(34)"-Ed.)
   END IF
   GOSUB ClearCommand:GOSUB ClearList
   cmd$ = LEFT$(ocmd$,ploc)+"that's "+MID$(ocmd$,ploc+1)
   ocmd$ = cmd$:locmd = LEN(ocmd$)
   GOTO Parse
END IF
nn = 1:but = 0:cand = 0:nch = 0:that = 0:GOTO InNoun 'Get indirect object

PreProcess:
nn = 0:p$ = prepn$(p)
FOR i = 0 TO 1
   IF n(i) <> 0 THEN CALL NameNoun(n(i),n$(i),nn$(i))
NEXT
IF cmd$ <> "" THEN
   cmd$ = LEFT$(cmd$,LEN(cmd$) - 1)
   PRINT"I don't know what you mean by '"cmd$CHR$(8)"'.
   GOTO NewCommand
END IF
FOR i = 0 TO 1
   IF nlnoun(i) = 1 THEN nlnoun(i) = 0
NEXT
FOR i = 0 TO 1
   IF nlnoun(i) THEN
      IF nounpl(i,v) < 2 THEN
         PRINT"You can't use multiple ";
         IF i = 1 THEN PRINT"indirect ";
         PRINT"objects with '"v$"'!
         GOTO NewCommand
      END IF
   END IF
NEXT

IF nlnoun(0) > 0 OR nlnoun(1) > 0 THEN GetCommand

Filter:
'*** grammatical replacements
IF (n(0)<0) AND (n(0)>=-10) AND (v = 0) THEN v = 6: v$="go"
IF v = 3 THEN IF n(1) <> 0 THEN v = 7 ' "drop xxx on yyy" == "put xxx on yyy"
IF v = 0 AND n(0) = 0 AND n(1) = 0 THEN PRINT"I don't understand.":GOTO NewCommand

FOR i = 0 TO 1
   IF n(i) <> 0 AND nounpl(i,v) = 0 THEN
      PRINT"You can't use ";
      IF i = 1 THEN PRINT"indirect ";
      PRINT"objects with '"v$"'!
      GOTO NewCommand
   END IF
NEXT
IF v = 0 AND n(0) <> 0 THEN
   PRINT"What do you want to do with "nn$(0)"?
   GOTO ContCommand
END IF
IF v = 0 AND n(1) <> 0 THEN
   PRINT". . . "prepn$(p)" "nn$(1)"?
   GOTO ContCommand
END IF
FOR i = 0 TO 1
   IF reqnoun(i,v) THEN
      na = noundef(i,v):IF na = 0 THEN na = 3
      IF n(i) = 0 THEN
         IF na AND 1 THEN CALL ListSib(first(1,1),lnoun(),nlnoun(),i)
         IF na AND 2 THEN CALL ListSib(Lfirst(l),lnoun(),nlnoun(),i)
         IF nlnoun(i) = 1 THEN
            n(i) = lnoun(i,1):ncount(i) = 1
            CALL NameNoun(n(i),n$(i),nn$(i))
            IF i = 0 THEN
               PRINT"("nn$(i)")
            ELSE
               IF p = 0 THEN p = defprep(v):p$ = prepn$(p)
               PRINT"("p$" "nn$(i)")
            END IF
         ELSE
            IF i = 0 THEN
               PRINT FNcap$(v$)" what?":GOTO ContCommand
            ELSE
               IF p = 0 THEN p = defprep(v):p$ = prepn$(p)
               PRINT FNcap$(v$)" "nn$(0)" "p$" what?":noobj = 1:GOTO ContCommand
            END IF
         END IF
      END IF
      CALL Visible(n(i),vis,0)
      IF vis = 0 THEN CALL CantSee(nn$(i)):GOTO GetCommand
      IF reqnoun(i,v) = 2 THEN ' Check physical accessibility
         pa = par(n(i))
TryAvail:
         CALL Avail(n(i),ava,0)
         IF ava = 0 THEN ' Try to open next parent up if still not accessible
            IF pa = 0 OR closed(pa) = 0 THEN ToNoAvail
            CALL Visible(pa,vis,0):IF vis = 0 THEN ToNoAvail
            PRINT"(opening the "word$(pa)" first): ";
            CALL Alias("open",8,(pa),0,0):GOSUB OpenIt
            GOSUB RestoreCommand
            IF closed(pa) <> 0 THEN ToNoAvail
            pa = par(pa):GOTO TryAvail
ToNoAvail:
            CALL CantGetAt(nn$(i)):GOTO GetCommand
         END IF
      END IF
   END IF
NEXT
FOR i = 0 TO 1
   IF nounat(i,v) THEN
      IF n(i) < 0 THEN
         GOSUB Absurd:GOTO GetCommand
      ELSEIF nounat(i,v) = 1 AND n(i) > 0 THEN
         IF lo(n(i)) <> 1 THEN
            CALL Avail(n(i),ava,2)
            IF ava = 0 THEN CALL DontHave(nn$(i)):GOTO GetCommand
            PRINT"(taking "nn$(i)" first): ";
            CALL Alias("get",2,(n(i)),0,0):GOSUB Take
            GOSUB RestoreCommand
            IF lo(n)<>1 THEN NewCommand
         END IF
      END IF
   END IF
NEXT
DoCommand:
' The variables n and o hold the values of n(0) and n(1), respectively
' (the direct and indirect object).  These variables are used as a
' kind of shorthand to make the verb routines easier to read.
n = n(0):o = n(1)

' See PostProcess for the meaning of the ask flag (set by the verb routine)
ask = 0

IF v = 0 OR v > 33 THEN
   PRINT"DoCommand: Unrecognized verb '"v$"', code"STR$(v)".
   GOTO PostProcess
END IF

IF v < 6 THEN ON v GOSUB Look,Take,Drop,Inventory,Examine:GOTO PostProcess
IF v < 11 THEN ON v - 5 GOSUB go,Place,OpenIt,CloseIt,Lock:GOTO PostProcess
IF v < 16 THEN ON v - 10 GOSUB Unlock,TurnOn,TurnOff,Wordy,Brief:GOTO PostProcess
IF v < 21 THEN ON v - 15 GOSUB Superbrief,SaveGame,LoadGame,PutOn,TakeOff:GOTO PostProcess
IF v < 26 THEN ON v - 20 GOSUB Wrap,UnWrap,Restart,Again,Empty:GOTO PostProcess
IF v < 31 THEN ON v - 25 GOSUB Fill,Eat,Drink,Sit,Stand:GOTO PostProcess
IF v < 36 THEN ON v - 30 GOSUB Lie,QuitGame,DrinkAll:GOTO PostProcess

PostProcess:
ON ask GOTO ContCommand,NewCommand,Interpret
t = t + 1:flag(tim) = t ' Time marches on . . .
ol = l ' Keep track of where we are
GOTO GetCommand

' Record last command on the command stack (push command stack)
RecordCommand:
vo(rlev) = v:po(rlev) = p:vo$(rlev) = v$:po$(rlev) = p$
FOR z = 0 TO 1
   no(rlev,z) = n(z):no$(rlev,z) = n$(z):nno$(rlev,z) = nn$(z)
NEXT
rlev = rlev + 1
RETURN

' Clear current command (clear top of stack)
ClearCommand:
v$ = "":p$ = ""
v = 0:n = 0:p = 0:o = 0
FOR z = 0 TO 1
   n(z) = 0:n$(z) = "":nn$(z) = ""
NEXT
' Reset interpreter flags
noobj = 0
RETURN

' Clear and record multiple noun lists
ClearList:
z1 = 0:onlnoun = nlnoun(0):IF nlnoun(1) THEN onlnoun = nlnoun(1):z1 = 1
FOR z = 1 TO onlnoun
   olnoun(z) = lnoun(z1,z)
NEXT
FOR z = 0 TO 1
   nlnoun(z) = 0:ncount(z) = 0
NEXT
RETURN

' Restore recorded command (pop command stack)
RestoreCommand:
rlev = rlev - 1:IF rlev < 0 THEN rlev = 0
v$ = vo$(rlev):p$ = po$(rlev)
v = vo(rlev):p = po(rlev)
FOR z = 0 TO 1
   n(z) = no(rlev,z):n$(z) = no$(rlev,z):nn$(z) = nno$(rlev,z)
NEXT
n = n(0):o = n(1)
RETURN

' Pushes the command stack with a new command
SUB Alias(av$,av,n0,ap,n1) STATIC
SHARED n(),vo(),no(),po()
SHARED vo$(),n$(),nn$(),nno$(),no$(),po$(),prepn$()
SHARED v$,v,n,p,p$,o,rlev

vo(rlev) = v:po(rlev) = p:vo$(rlev) = v$:po$(rlev) = p$
FOR i = 0 TO 1
   no(rlev,i) = n(i):no$(rlev,i) = n$(i):nno$(rlev,i) = nn$(i)
NEXT
rlev = rlev + 1
v$ = "":p$ = ""
v = 0:n = 0:p = 0:o = 0
FOR i = 0 TO 1
   n(i) = 0:n$(i) = "":nn$(i) = ""
NEXT
v$=av$:v=av:n(0)=n0:n(1)=n1:IF ap THEN p=ap:p$=prepn$(p)
IF n(0) THEN CALL NameNoun(n(0),n$(0),nn$(0))
IF n(1) THEN CALL NameNoun(n(1),n$(1),nn$(1))
n=n(0):o=n(1)
END SUB

Commands:
' The first DATA statement for each verb has the following
' meaning:
'
'    DATA require_direct_object?,require_indirect_object?,defaultprep?
'
' The first two numbers have the following meanings:
'   0 - not required
'   1 - must be visible (see Calc:Visible())
'   2 - must be physically accessible (see Calc:Avail())
'
' defaultprep? is either 0 for no default preposition,or a prep number
' (see Prepositions:)
'
' The next line is:
'
'    DATA direct_object_location?,indirect_object_location?
'
'   0 - no checking done
'   1 - player must be carrying the item
'   2 - the item should be in the same location as the player
'
' The third line means:
'
'    DATA direct_obj_default_location?,indirect_obj_default_location?
'
' The codes are the same as above, except that these are used in the
' "verb all" and "verb what?" ambiguity resolution routines to determine
' where to look.  This is usually the same as above, but in some cases
' the verb is *usually* used for one purpose but may be used for another;
' e.g., "get" which is usually used to get objects from the room but
' may be used to get an object out of a container the player is
' carrying.  In this case the default (room) is different from the
' required (either room or player).
'
' The fourth means:
'
'    DATA number_direct_objects?,number_indirect_objects?
'
' If the number is 0, can have no nouns.
' If 1, can only have a single noun.
' If 2, can have single and plural (no checking is done).
'
' Finally, if the verb wishes to ask a question or report an error,
' the flag 'ask' can be set to the following values:
'     1 - return to input line but keep context (as in "get what?")
'     2 - return to input line (interrupt a multiple-command line)
'          (usually used after some error message has been given)
'          (throw away context)
'     3 - go to Interpret after returning, and reprocess the
'          verb, noun, object codes (see Again:)
'
' See PreProcess:, DoCommand:, and PostProcess:

Look:
DATA 0,0,0
DATA 0,0
DATA 0,0
DATA 0,0

IF l = 0 THEN PRINT"Can't go that way.":l = ol:RETURN

IF map(l,0) <> -99 THEN
   CALL CheckLight(flag(1))
   IF (flag(1) = 0) THEN PRINT"It's too dark to see.":RETURN
END IF

IF (l > nloc) OR l < 2 THEN
   PRINT"You are in room "l", which is manifestly impossible.
   RETURN
END IF

' Display description
' This code can be changed to get a description off of a random file
' from disk
longdes = 0
IF dindex(l) <> dindex(l+1) THEN
   IF des$(dindex(l)) <> " " THEN PRINT des$(dindex(l))
   IF ((seen(l) = 0 OR flag(verbose) = 1 OR v = 1) AND flag(verbose) <> -1) OR des$(dindex(l)) = " " THEN
      longdes = 1 ' We are printing the long description
      FOR i = dindex(l) + 1 TO dindex(l + 1) - 1
         IF des$(i) = "z" THEN
            GOSUB waitforkey
         ELSE
            PRINT des$(i)
         END IF
      NEXT i
      seen(l) = 1 'Jack was here
   END IF
END IF

' Display conditional descriptions
FOR i = findex(l) TO findex(l + 1) - 1
   CALL EvalCond(fcond(0,i),fcond(1,i),fcond(2,i),true)
   IF true AND ((fcond(3,i) AND 1) <> 0 OR longdes = 1) AND NOT ((fcond(3,i) AND 1)= 0 AND flag(verbose) = -1) THEN
      IF (fcond(3,i) AND 2) = 0 OR fcond(fseen,i) = 0 THEN ' Check for one-time-only
         FOR j = fcond(fdindex,i) TO fcond(fdindex,i + 1) - 1
            IF fdes$(j) = "z" THEN
               GOSUB waitforkey
            ELSE
               PRINT fdes$(j)
            END IF
         NEXT j
         fcond(fseen,i) = 1 ' We've seen this one now
      END IF
   END IF
NEXT

IF Lfirst(l) THEN
   PRINT"Here, you see:
   CALL Contents(Lfirst(l),3,0)
END IF

' Check for forced move
IF map(l,0) = -99 THEN
   CALL EvalCond(map(l,1),map(l,2),map(l,3),true)
   IF true THEN nl = map(l,4) ELSE nl = map(l,5)
   IF nl = -99 THEN
      l = ol ' Bounce back
      RETURN
   ELSE
      l = nl ' Don't want absurd negative locations
      PRINT
      GOTO Look ' Describe new location
   END IF
END IF
RETURN

waitforesc:
PRINT"[press any key or ESC]";:GOTO getkey
waitforkey:
PRINT"[press any key]";
getkey:
a$ = INKEY$
WHILE(a$ = "")
   a$ = INKEY$
WEND
' Erase message
PRINT z$z$z$z$z$z$z$z$z$z$z$z$z$z$z$z$z$z$z$z$z$z$;
RETURN

Take:
DATA 2,0,0
DATA 0,0
DATA 2,0
DATA 2,0

IF n > 0 THEN
   IF holdwater(n) = 2 THEN
      CALL ListBottles(c1(),a)
      IF a = 0 THEN PRINT"You don't have anything to hold the water.":RETURN
      IF a > 1 THEN
         PRINT"Put the water in what?
         v=7:v$="put":p=1:p$="in"
         ask=1
         RETURN
      END IF
      CALL Alias("fill",26,c1(0),6,(n)):GOSUB Fill
      GOSUB RestoreCommand
      RETURN
   END IF
END IF
IF n < 0 THEN GOSUB Cannot:RETURN
IF immobile(n) THEN GOSUB Absurd:RETURN
IF lo(n) = 1 AND par(n) = 1 THEN PRINT"You already have "nn$(0)"!":RETURN

IF totw(n) > maxlift THEN PRINT FNcap$(nn$(0))" is too heavy to lift.":RETURN
IF totb(n) > maxgrab THEN PRINT FNcap$(nn$(0))" is too big to get a hold of.":RETURN
IF totw(n) + totw(1) > maxweight THEN PRINT"Your load is too heavy.":RETURN
IF totb(n) + bulk(1,1) > maxcap THEN PRINT"Your load is too bulky.":RETURN

CALL Remove(n)
CALL Insert(n,1,1)
PRINT"Taken."

RETURN

Drop:
DATA 1,0,0
DATA 0,0
DATA 1,0
DATA 2,1

IF n < 0 THEN GOSUB Cannot:RETURN
IF immobile(n) THEN GOSUB Cannot:RETURN
IF lo(n) <> 1 THEN CALL DontHave(nn$(0)):RETURN
CALL Avail(n,ava,0)
IF ava = 0 THEN
   CALL CantGetAt(nn$(0)):RETURN
ELSEIF ava = -1 THEN
   PRINT"You can't get "nn$(0)" out.":RETURN
END IF

IF holdwater(n) = 2 THEN
   IF par(n) = 0 THEN
      PRINT"Something's wrong here.
   ELSE
      CALL Alias("pour out",25,(par(n)),0,0):GOSUB Empty
      GOSUB RestoreCommand
      RETURN
   END IF
ELSE
   CALL Remove(n)
   CALL Insert(n,-l,0)
   worn(n) = 0
   PRINT"Dropped.
END IF

RETURN

Inventory:
DATA 0,0,0
DATA 0,0
DATA 0,0
DATA 0,0

IF sat>0 THEN PRINT"(you are sitting on the "word$(sat)".)
IF sat<0 THEN PRINT"(you are lying on the "word$(-sat)".)
CALL Contents(1,0,0)
IF first(1,1) = 0 THEN PRINT"You are carrying nothing.

RETURN

Examine:
DATA 1,0,0
DATA 0,0
DATA 0,0
DATA 2,0

IF n = -20 THEN GOSUB Inventory:RETURN
IF n < 0 OR long$(n) = "" THEN
   PRINT"You see nothing unusual about "nn$(0)".":RETURN
END IF
PRINT long$(n)
IF openable(n) THEN
   IF closed(n) THEN
      PRINT FNcap$(nn$(0))" is closed.
   ELSE
      PRINT FNcap$(nn$(0))" is open.
   END IF
END IF
IF folded(n) THEN PRINT FNcap$(nn$(0))" is "fold$(folded(n))".
IF n = 7 AND lampon = 1 THEN PRINT"The lamp is on.
CALL Contents(n,0,1) '*** List what's related to it, if anything

RETURN

go:
DATA 0,0,0
DATA 0,0
DATA 0,0
DATA 1,0

IF n = 0 THEN PRINT"Which way do you want to "v$"?":ask = 1:RETURN
IF n > 0 THEN GOSUB Absurd:RETURN

nl = map(l,-n-1)
IF nl < 0 THEN ' Map conditional
   i = -nl
   CALL EvalCond(mcond(0,i),mcond(1,i),mcond(2,i),true)
   IF true THEN
      nl = mcond(3,i)
   ELSE
      IF mmes$(i) <> "" THEN PRINT mmes$(i)
      nl = mcond(4,i)
      IF nl = l THEN RETURN
      IF mmes$(i) <> "" THEN PRINT
   END IF
END IF

ol = l:l = nl
GOTO Look

Place:
DATA 2,2,1
DATA 1,0
DATA 1,0
DATA 2,1

mode = p - 1

IF mode = 1 THEN GOTO Wrap
IF n > 0 THEN
   IF holdwater(n) = 2 AND holdwater(o) = 1 THEN
      CALL Alias("fill",26,(n(1)),6,(n(0))):GOSUB Fill
      GOSUB RestoreCommand
      RETURN
   END IF
END IF
IF n < 0 OR o < 0 THEN GOSUB Cannot:RETURN
IF immobile(n) THEN GOSUB Absurd:RETURN
IF cap(mode,o) = 0 THEN GOSUB Cannot:RETURN
IF mode = 0 THEN
   IF holdwater(n) = 2 THEN PRINT FNcap$(nn$(1))" won't hold water.":RETURN
   IF holdwater(n) = 0 THEN
      IF holdwater(first(0,o))=2 THEN
         PRINT"You can't put anything in "nn$(1)", there's water in it.
         RETURN
      END IF
   END IF
   f = 0:IF folded(o) THEN f = 1
   IF (openable(o) <> 0 AND closed(o) <> 0) OR f = 1 THEN 'try to open o
      PRINT"(opening "nn$(1)" first):
      CALL Alias("open",8,(n(1)),0,0):GOSUB OpenIt
      GOSUB RestoreCommand
      IF (openable(o)<>0 AND closed(o)<>0) OR folded(o)<>0 THEN RETURN
      PRINT"(then, putting "nn$(0)" "p$" "nn$(1)"): ";
      IF f THEN mode=2:p$="on"
   END IF
END IF
IF totb(n) > opening(mode,o) THEN
   PRINT FNcap$(nn$(0))" won't fit "p$" "nn$(1)".
   RETURN
END IF
IF totb(n) + bulk(mode,o) > cap(mode,o) THEN
   PRINT FNcap$(nn$(0))" won't fit; there's too much already "p$" "nn$(1)".
   RETURN
END IF
IF n = o THEN GOSUB Cannot:RETURN
' Can't put stuff in clothing that you're wearing on your head (e.g. hats)
IF mode = 0 AND (worn(o) AND 2) <> 0 THEN
   PRINT"You can't put anything in "nn$(1)"; you're wearing it.":RETURN
END IF
IF rel(n) = mode AND par(n) = o THEN
   PRINT FNcap$(nn$(0))" is already "p$" "nn$(1)"!":RETURN
END IF

CALL Inside(o,n,ins,rel) 'Don't want to make n a descendant of itself
IF ins THEN PRINT"But "nn$(1)" is "prepn$(rel + 1)" "nn$(0)"!":RETURN

CALL Remove(n)
CALL Insert(n,o,mode)
worn(n) = 0

IF mode = 0 AND first(2,n) <> 0 THEN
   PRINT"Done, but everything that was on top of "nn$(0)" falls off inside
   PRINT nn$(1)".
   CALL Tumble(n)
ELSE
   PRINT"Done.
END IF

RETURN

OpenIt:
DATA 2,0,0
DATA 0,0
DATA 0,0
DATA 2,0

IF n < 0 THEN GOSUB Absurd:RETURN
IF folded(n) THEN GOTO UnWrap
IF openable(n) = 0 THEN GOSUB Cannot:RETURN
IF locked(n) THEN
   PRINT"(trying to unlock "nn$(0)" first)
   CALL Alias("unlock",11,(n(0)),0,0):GOSUB Unlock
   GOSUB RestoreCommand
   IF locked(n) THEN RETURN
   PRINT"(then, proceeding . . .)
END IF
IF closed(n) = 0 THEN PRINT FNcap$(nn$(0))" is already open.":RETURN
closed(n) = 0
IF first(0,n) <> 0 AND (opaque(0,n) <> 0) THEN
   PRINT"Opening "nn$(0)" reveals:
   CALL Contents(n,0,2)
ELSE
   PRINT FNcap$(nn$(0))" is now open.
END IF

RETURN

CloseIt:
DATA 2,0,0
DATA 0,0
DATA 0,0
DATA 2,0

IF n < 0 THEN GOSUB Absurd:RETURN
IF openable(n) = 0 THEN
   IF foldable(n) THEN GOTO Wrap ELSE GOSUB Cannot:RETURN
END IF
IF closed(n) THEN PRINT FNcap$(nn$(0))" is already closed.":RETURN

closed(n) = 1
PRINT FNcap$(nn$(0))" is now closed.

RETURN

Lock:
DATA 2,0,0
DATA 0,0
DATA 0,0
DATA 2,0

IF n < 0 THEN GOSUB Absurd:RETURN
PRINT"Don't know how to lock that.

RETURN

Unlock:
DATA 2,0,0
DATA 0,0
DATA 0,0
DATA 2,0

IF n < 0 THEN GOSUB Absurd:RETURN
PRINT"Don't know how to unlock that.

RETURN

TurnOn:
DATA 2,0,0
DATA 0,0
DATA 0,0
DATA 2,0

IF n < 0 THEN GOSUB Absurd:RETURN
IF n <> lamp THEN GOSUB Cannot:RETURN

IF flag(lampon) THEN PRINT FNcap$(nn$(0))" is already on.":RETURN
flag(lampon) = 1
PRINT FNcap$(nn$(0))" is now on.

RETURN

TurnOff:
DATA 2,0,0
DATA 0,0
DATA 0,0
DATA 2,0

IF n < 0 THEN GOSUB Absurd:RETURN
IF n <> lamp THEN GOSUB Cannot:RETURN

IF flag(lampon) = 0 THEN PRINT FNcap$(nn$(0))" is already off.":RETURN
flag(lampon) = 0
PRINT FNcap$(nn$(0))" is now off.

RETURN

Wordy:
DATA 0,0,0
DATA 0,0
DATA 0,0
DATA 0,0

flag(verbose) = 1

PRINT"I shall use long descriptions.
RETURN

Brief:
DATA 0,0,0
DATA 0,0
DATA 0,0
DATA 0,0

flag(verbose) = 0

PRINT"Brief descriptions.
RETURN

Superbrief:
DATA 0,0,0
DATA 0,0
DATA 0,0
DATA 0,0

flag(verbose) = -1

PRINT"Superbrief.
RETURN

SaveGame:
DATA 0,0,0
DATA 0,0
DATA 0,0
DATA 2,0

LINE INPUT"Save to file? ";file$
ON ERROR GOTO Saverr
cantopen = 0
1000 OPEN file$ FOR OUTPUT AS 1
1010 PRINT#1, dataformat$ ' Version number to verify format (see Initialize:)

' Write out globals
PRINT#1, "GLOBAL"
WRITE#1, t,l,ol,maxcap,maxweight,maxgrab,maxlift,fat,warnthat

' Write out flags
PRINT#1, "FLAGS"
WRITE#1, nflag
FOR i = 0 TO nflag
   WRITE#1, flag(i)
NEXT

' Write out objects
PRINT#1, "OBJS"
WRITE#1, nobj,mrel
FOR i = 0 TO nobj
   WRITE#1, lo(i),par(i),rel(i)
   FOR j = 0 TO mrel
      PRINT#1, first(j,i)
   NEXT
   FOR j = 0 TO mrel
      PRINT#1, last(j,i)
   NEXT
   WRITE#1, left(i),right(i),size(i),closed(i),folded(i),locked(i),worn(i)
   WRITE#1, totw(i),totb(i)
   FOR j = 0 TO mrel
      PRINT#1, bulk(j,i)
   NEXT
NEXT i

' Write out locations
PRINT#1, "LOCS"
PRINT#1, nloc
FOR i = 0 TO nloc
   WRITE#1, Lfirst(i),Llast(i),Lon(i)
NEXT i

' Write out flag conditionals
PRINT#1, "FLAGCONDS"
PRINT #1,nfcond
FOR i = 0 TO nfcond
   PRINT#1, fcond(fseen,i)
NEXT

' End marker
PRINT#1, "END"

PRINT:PRINT"Done.
EndSave:
ON ERROR GOTO 0
IF cantopen = 0 THEN CLOSE 1
RETURN

Saverr:
IF ERL = 1000 THEN
   cantopen = 1
   PRINT"Can't open'"file$"'!
ELSE
   PRINT"Disk error while saving game.  Aborting save.
END IF
RESUME EndSave

LoadGame:
DATA 0,0,0
DATA 0,0
DATA 0,0
DATA 0,0

LINE INPUT"Enter name of saved game: ";file$
ON ERROR GOTO Loaderr
cantopen = 0:okay = 0
2000 OPEN file$ FOR INPUT AS 1
2010 INPUT#1, a$
IF a$ <> dataformat$ THEN AbortLoad

' Load constants
INPUT#1, a$:IF a$ <> "GLOBAL" THEN AbortLoad
INPUT#1, t,l,ol,maxcap,maxweight,maxgrab,maxlift,fat,warnthat

' Load flags
INPUT#1, a$:IF a$ <> "FLAGS" THEN AbortLoad
INPUT#1, nflag
FOR i = 0 TO nflag
   INPUT#1, flag(i)
NEXT

' Load objects
INPUT#1, a$:IF a$ <> "OBJS" THEN AbortLoad
INPUT#1, nobj,mrel
FOR i = 0 TO nobj
   INPUT#1, lo(i),par(i),rel(i)
   FOR j = 0 TO mrel
      INPUT#1, first(j,i)
   NEXT
   FOR j = 0 TO mrel
      INPUT#1, last(j,i)
   NEXT
   INPUT#1, left(i),right(i),size(i),closed(i),folded(i),locked(i),worn(i)
   INPUT#1, totw(i),totb(i)
   FOR j = 0 TO mrel
      INPUT#1, bulk(j,i)
   NEXT
NEXT i

' Load locations
INPUT#1, a$:IF a$ <> "LOCS" THEN AbortLoad
INPUT#1, nloc
FOR i = 0 TO nloc
   INPUT#1, Lfirst(i),Llast(i),Lon(i)
NEXT i

' Load flag conditionals info
INPUT#1, a$:IF a$ <> "FLAGCONDS" THEN AbortLoad
INPUT#1, nfcond
FOR i = 0 TO nfcond
   INPUT#1, fcond(fseen,i)
NEXT

PRINT:PRINT"Done.":okay = 1
EndLoad:
ON ERROR GOTO 0
IF cantopen = 0 THEN CLOSE 1
IF okay THEN Look
RETURN

AbortLoad:
PRINT"Saved game is in wrong format (shouldn't have read '"a$"').
PRINT"Aborting.
GOTO EndLoad

Loaderr:
IF ERL = 2000 THEN
   cantopen = 1
   PRINT"Can't open'"file$"'!
ELSE
   PRINT"Disk error while loading game.
END IF
RESUME EndLoad

PutOn:
DATA 2,0,0
DATA 1,0
DATA 0,0
DATA 2,0

IF n < 0 THEN GOSUB Absurd:RETURN
IF wearable(n) = 0 THEN GOSUB Cannot:RETURN
IF worn(n) <> 0 THEN PRINT"You're already wearing "nn$(0)"!":RETURN
worn(n) = wearable(n)
CALL Remove(n)
CALL Insert(n,1,0)
PRINT"You are now wearing "nn$(0)".

RETURN

TakeOff:
DATA 2,0,0
DATA 1,0
DATA 1,0
DATA 2,0

IF n < 0 THEN GOSUB Absurd:RETURN
IF wearable(n) = 0 THEN GOSUB Absurd:RETURN
IF worn(n) = 0 THEN PRINT"You're not wearing "nn$(0)".":RETURN
dropflag = 0
IF totb(n) + totb(1) > maxcap OR totw(n) + totb(1) > maxweight THEN
   PRINT"You're carrying too much already, you'll have to drop something first.
   RETURN
END IF
IF totw(n) > maxlift OR totb(n) > maxgrab THEN
   PRINT"You take off "nn$(0)", but you fumble with it and it falls.
   worn(n) = 0
   PRINT FNcap$(nn$(0))": ";
   GOTO Drop
END IF

worn(n) = 0
CALL Remove(n)
CALL Insert(n,1,1)
PRINT"You are now no longer wearing "nn$(0)".

RETURN

Wrap:
DATA 2,0,0
DATA 0,0
DATA 0,0
DATA 2,1

IF n < 0 OR o < 0 THEN GOSUB Absurd:RETURN
IF o <> 0 AND p <> 1 AND p <> 3 AND p <> 6 THEN GOSUB Absurd:RETURN
IF o <> 0 THEN
   CALL Avail(o,ava,0)
   IF ava = 0 THEN CALL CantGetAt(nn$(1)):RETURN
END IF
IF o = 0 THEN o = n:n(1) = n(0):n = 0:n(0) = 0:nn$(1) = nn$(0)
IF foldable(o) = 0 OR cap(1,o) = 0 THEN GOSUB Absurd:RETURN
IF folded(o) THEN
   PRINT FNcap$(nn$(1))" is already "fold$(folded(o))".
   RETURN
END IF
IF bulk(0,o) THEN
   PRINT"You can't wrap anything with "nn$(1)"; there's something in it.
   RETURN
END IF
IF worn(o) THEN
   PRINT"(taking off "nn$(1)" first):
   CALL Alias("take off",20,(n(1)),0,0):GOSUB TakeOff
   GOSUB RestoreCommand
   IF (worn(n)) THEN RETURN
   PRINT"(then, proceeding . . .)
END IF
IF n = 0 THEN
   IF bulk(2,o) > cap(1,o) THEN
      PRINT FNcap$(nn$(1))" isn't big enough to wrap what's on it.
      RETURN
   END IF
   CALL RemList(o,2,head)
   CALL Concat(head,o,1)
ELSE
   IF totb(n) > cap(1,o) THEN
      PRINT FNcap$(nn$(1))" isn't big enough to wrap "nn$(0)".
      RETURN
   END IF
   CALL Remove(n)
   CALL Insert(n,o,1)
END IF
folded(o) = foldable(o)
PRINT"Done.
RETURN

UnWrap:
DATA 2,0,0
DATA 0,0
DATA 0,0
DATA 2,0

IF n < 0 THEN GOSUB Absurd:RETURN
IF foldable(n) = 0 THEN GOSUB Absurd:RETURN
IF folded(n) = 0 THEN PRINT FNcap$(nn$(0))" isn't "fold$(foldable(n))".":RETURN
folded(n) = 0
tumb = (bulk(1,n) > cap(2,n))
CALL RemList(n,1,head)
IF tumb THEN
   PRINT"When you open "nn$(0)", everything in it falls out.
   CALL Concat(head,-l,0)
ELSE
   IF head <> 0 THEN
      PRINT"Opening "nn$(0)" reveals:
      CALL Contents(head,3,0)
      CALL Concat(head,n,2)
   ELSE
      PRINT"Opened.
   END IF
END IF
RETURN

Restart:
DATA 0,0,0
DATA 0,0
DATA 0,0
DATA 0,0

LINE INPUT"Start over from the beginning? (Are you sure?) >";a$
IF LEFT$(a$,1) = "y" THEN RUN

PRINT:PRINT"Okay.
RETURN

Again:
DATA 0,0,0
DATA 0,0
DATA 0,0
DATA 0,0

cmd$ = ocmd$:ask = 3:RETURN

Empty:
DATA 2,0,1
DATA 1,0
DATA 1,2
DATA 2,1

IF n<0 OR o<0 THEN GOSUB Absurd:RETURN
IF p THEN IF p<>1 THEN GOSUB Cannot:RETURN
IF holdwater(n)=2 THEN c=n-1 ELSE c=n
IF holdwater(c)=0 THEN
   ' Place test particle inside n, to see if
   ' stuff in there is visible or not
   lo(0) = l:par(0) = c:rel(0) = 0
   CALL Visible(0,vis,0)
   IF vis THEN
Empty1:
      mlnoun(0) = 0
      CALL ListSib(first(0,c),mnoun(),mlnoun(),0)
      IF mlnoun(0) = 0 THEN
         PRINT FNcap$(nn$(0))" is empty.
         RETURN
      END IF
   ELSE
      IF closed(c) THEN
         PRINT"(opening "nn$(0)" first): ";
         CALL Alias("open",8,c,0,0):GOSUB OpenIt
         GOSUB RestoreCommand
         lo(0)=l:par(0)=c:rel(0)=0
         CALL Visible(0,vis,0)
         IF vis=0 THEN RETURN ELSE GOTO Empty1
      ELSE
         GOSUB Mystery:GOTO NewCommand
      END IF
   END IF
   FOR emptyi=1 TO mlnoun(0)
      PRINT"the "word$(mnoun(0,emptyi))": ";
      CALL Alias("drop",3,mnoun(0,emptyi),0,0):GOSUB Drop
      GOSUB RestoreCommand
   NEXT
   RETURN
END IF
IF bulk(0,c) = 0 THEN PRINT"The "word$(c)" is empty.":RETURN
IF par(c)<>1 THEN
   PRINT"(taking out the "word$(c)" first): ";
   CALL Alias("take out",2,c,0,0):GOSUB Take
   GOSUB RestoreCommand
   IF par(c)<>1 THEN RETURN
END IF
IF closed(c) THEN
   PRINT"(opening the "word$(c)" first):
   CALL Alias("open",8,c,0,0):GOSUB OpenIt
   GOSUB RestoreCommand
   IF closed(c) THEN RETURN
END IF

IF o THEN
   IF holdwater(o) = 2 THEN d=o-1 ELSE d=o
   amt = bulk(0,c)
   CALL Fill(d,amt)
   CALL Fill(c,-amt)
   IF bulk(0,c)<>0 THEN PRINT"You fill up the "word$(d)" with some water from the "word$(c)".":RETURN
   PRINT"You empty the "word$(c)" completely into the "word$(d)".
ELSE
   CALL Empty(c)
   PRINT"The water pours out and evaporates.
END IF
RETURN

Fill:
DATA 2,2,6
DATA 1,0
DATA 1,2
DATA 2,1

IF n<0 OR (p<>6 AND p<>7) THEN GOSUB Absurd:RETURN
IF holdwater(o) = 1 THEN w=o+1 ELSE w=o
IF holdwater(n)<>1 OR holdwater(w)<>2 THEN
   CALL Alias("put",7,w,1,n):GOSUB Place
   GOSUB RestoreCommand
   RETURN
END IF
IF size(w)=0 THEN PRINT"The "word$(w-1)" is empty.":RETURN
amt=size(w):max=amt
CALL Fill(n,amt)
IF amt<max THEN
   IF amt=0 THEN
      PRINT FNcap$(nn$(0))" is already full.":RETURN
   ELSE
      PRINT"You fill up "nn$(0)" with some water from the "word$(w-1)".
   END IF
END IF
CALL Fill(w-1,-amt)
RETURN

Eat:
DATA 2,0,0
DATA 1,0
DATA 0,0
DATA 2,0

IF n<0 THEN GOSUB Absurd:RETURN
IF food(n) = 0 THEN GOSUB Cannot:RETURN

' Please modify the code below if you want to handle food more realistically
CALL Remove(n) ' The food just disappears
ON RND(1) * 3 GOTO Eat1,Eat2
PRINT"Eaten.":RETURN
Eat1:
PRINT"Mmm, mmm, that was good!":RETURN
Eat2:
PRINT"Ugh, a little stale, but edible.
RETURN

Drink:
DATA 2,0,0
DATA 0,0
DATA 0,0
DATA 2,0

IF n<0 THEN GOSUB Absurd:RETURN

wat = -1
CALL Fill(n-1,wat)
IF wat = -1 THEN
   IF bulk(0,n-1) = 0 THEN
      PRINT "You drink all of "nn$(0)".
   ELSE
      PRINT"You drink some of "nn$(0)".
   END IF
ELSE
   PRINT"There's nothing to drink.
END IF
RETURN

Sit: ' This code handles both sitting and lying down
DATA 0,0,0
DATA 0,2
DATA 0,2
DATA 0,2

sitflag = 1

Sit1: ' The Lie: code jumps to here with sitflag = 3
IF o < 0 THEN GOSUB Absurd:RETURN
IF p <> 3 THEN GOSUB Cannot:RETURN
IF sat THEN
   IF sitflag = 1 THEN
      IF sat = o THEN
         PRINT"You're already sitting on "nn$(1)".
         RETURN
      END IF
   ELSE
      IF -sat = o THEN
         PRINT"You're already lying on "nn$(1)".
         RETURN
      END IF
   END IF
   IF ABS(sat) <> o THEN
      PRINT"(standing up first):
      CALL Alias("stand up",30,0,0,0):GOSUB Stand
      GOSUB RestoreCommand
      IF (sat) THEN RETURN
      PRINT"(then, proceeding . . .)
   END IF
END IF

IF cap(2,o) < fat * sitflag THEN
   PRINT FNcap$(nn$(1))" is too small for you to "v$" on.
ELSE
   IF soft(o) = 0 THEN
      PRINT FNcap$(nn$(1))" is very uncomfortable, but you "v$" on it anyway.
   ELSE
      PRINT"You "v$" on "nn$(1)".
      IF soft(o) = 2 THEN PRINT"It's very comfortable.
   END IF
   IF sitflag = 1 THEN sat = o ELSE sat = -o
END IF
RETURN

Stand:
DATA 0,0,0
DATA 0,0
DATA 0,0
DATA 0,0

IF sat = 0 THEN PRINT"You're already standing.":RETURN
sat = 0
PRINT"You get up.
RETURN

Lie:
DATA 0,0,0
DATA 0,2
DATA 0,2
DATA 0,2

sitflag = 3:GOSUB Sit1
RETURN

QuitGame:
DATA 0,0,0
DATA 0,0
DATA 0,0
DATA 2,0

IF n = 0 THEN n = -22
IF n <> -22 THEN GOSUB Absurd:RETURN

LINE INPUT"Quit the game? (Are you sure?) >";a$
IF LEFT$(a$,1) <> "y" THEN PRINT"Okay.":RETURN
LINE INPUT"Save the game first? ";a$
IF LEFT$(UCASE$(a$),1) = "Y" THEN GOSUB SaveGame

PRINT"Okay, bye!
END
RETURN ' In case the player does a "cont"

DrinkAll:
DATA 2,0,0
DATA 0,0
DATA 0,0
DATA 2,0

IF n<0 THEN GOSUB Absurd:RETURN

wat = -bulk(0,n-1)
CALL Fill(n-1,wat)
IF wat < 0 THEN
   PRINT "You drink all of "nn$(0)".
ELSE
   PRINT"There's nothing to drink.
END IF
RETURN

'*** Error detection marker
DATA "Z"

map:
' Location 1 is reserved to hold object 1, which holds everything the
' player is carrying (in his/her hands)
'
' The data format is as follows:
'
'   DATA loc, N,NE,E,SE,S,SW,W,NW,U,D, light, lighton?
'
' (OPTIONAL:
'   DATA flag1,comp1,value1,loctrue1,locfalse1,"falsemessage"
'   DATA flag2,comp2,value2,loctrue2,locfalse2,"falsemessage"
'    . . . and so on, one line for each map conditional here)
'
'   DATA short description
'   DATA long description line 1
'   DATA long description line 2
'   DATA  . . .
'   DATA long description last line
'   DATA ""
'
' (OPTIONAL:
'   DATA flagnum,comp,value,verbose
'   DATA description lines
'   DATA ""
'    . . . repeat as often as desired)
'
'   DATA -1,0,0,0 ' End of this description
'
' Loc is the location number, and is used as a checking mechanism only;
' unlike elsewhere, the map MUST be in sequential order, starting with 2.
' Location 1 is reserved to hold "object" number 1 which contains
' everything the player is carrying (see Objects:).
'
' The following numbers are direction codes for each direction.
'
' The light flag is 0 if there is no light source (cave), 1 if there is
' natural light, and 2 if there is electric light (switchable on/off).
'
' Lighton? is usually used to flag whether or not the electric light
' is on or off.  If this flag is non-zero, the value returned by CheckLight()
' will be this value.
'
' Then come the map conditional DATA statements, the short and long
' descriptions, the conditional descriptions, then the 0,0,0,0 end marker.
'
' DEFINITIONS:
'
' CONDITIONAL:
'    A "conditional" is a triplet "flagnum,comp,value" which
' is evaluated as TRUE when flag(flagnum) < value, flag(flagnum) = value,
' flag(flagnum) > value, or flag(flagnum) <> value, depending on whether
' comp is -1, 0, 1, or 2, respectively.  (See Calc:EvalCond().  See
' also Flags:)
'
' DIRECTION CODES:
'    If positive, these are simply location numbers.
' (If the first number is -99, this is a "forced move" or a "bounceback"
' location; the codes are interpreted differently; see below for details.)
'
' MAP CONDITIONAL:
'    If the direction code is a negative number (from -10 to -1), the code
' is an index to a "map conditional".  -1 refers to the first map
' conditional in the location, -2 to the second, etc.  For each map
' conditional in a location, there must be a DATA statement: (following
' the direction and status codes)
'
'    DATA flagnum,comp,value,trueloc,falseloc,"falsemessage"
'         ^--(conditional)--^
'
' If the conditional is true, the player lands in trueloc, no questions
' asked.  If false, the program prints "falsemessage" and then a blank line
' (if "falsemessage" is NOT null), and then the player goes to falseloc
' (which can be 0, which ends up with a "Can't go that way.")
'
' For example,
'   DATA 54, 41,0,3,0,27,0,-1,0,0,0, 0,0,0
'   DATA 12,0,1,97,54,"The snake blocks your way."
' means, this is location 54.  You can go north to 41, east to 3,
' and south to 27.  If flag 12 is equal to 1, you can go west to
' location 97; otherwise "The snake blocks your way" and you stay
' in location 54.
'
' FORCED MOVE LOCATIONS, BOUNCEBACK:
'    If the location number for "north" is -99, then the location
' is a "forced move" location; the player simply gets to see the
' description and then is moved immediately to a new location:
'
'    DATA loc, -99,flagnum,cond,value,loctrue,locfalse,0,0,0,0, 0,0,0
'                  ^---conditional---^
'
'    The player is immediately moved to loctrue if the conditional is
' true, and locfalse if false.  If either locations are -99, the player
' is simply "bounced back" to his/her former location (combining this
' with the map conditionals described above allows you to have
' map conditionals that print out arbitrarily long messages).  Note:
' since flag zero is set to a constant value of 1, you can always
' force a specific move or bounceback by testing flag zero for value 1.
'
' DESCRIPTIONS:
'    Finally, you have the short description, which is a one-line
' "title" for the room.  Then follows the long description, which ends
' with a NULL string.  If the first line is a null string, NO description
' is printed (except possibly for the conditional descriptions, below.)
' Normally the long description is only printed when the player
' encounters a location for the first time, when flag(verbose) = 1,
' or when the player says "look".  At other times only the short description
' is printed.
'    In addition, if the short description is simply a space " ", the
' full description will always be printed.
'    Any line in the long description that is just a single "z" will
' cause the "press any key to continue" message.
'
' CONDITIONAL DESCRIPTIONS:
'
'     DATA flagnum,comp,value,verbosity
'          ^---conditional---^
'     DATA "First line"
'         . . .
'     DATA "Last line"
'     DATA ""
'
'    If the conditional is true, and the "verbosity" condition is satisfied,
' the description is printed.  If verbosity is 0, the description is printed
' only if the long description (see above) is printed.  If 1, then
' it doesn't matter whether or not the long description is printed.  If 2,
' then the conditional description is printed only ONCE, but only when
' the long description is printed, and if 3, the conditional is printed
' only once, but irregardless of whether or not the long description is
' printed as well.
'
'    Any line in the conditional description that is just a single "z"
' will cause the "press any key to continue" message.
'
'    Finally, DATA -1,0,0,0 will mark the end of a description.

' All the parameters below can be changed to suit your particular style
' Maximum location number
DATA 100
' Average number of lines of description per location
DATA 5
' Maximum number of map conditionals
DATA 50
' Maximum number of flag conditionals
DATA 50
' Average number of lines of description per flag conditional
DATA 3

MapList:
' Begin with location 2
' -99 means forced move
' "0,0,0" means test flag 0 to equal 0, which is ALWAYS TRUE, so
' go to location 3 immediately
'   this v---v is the conditional (always true)
DATA 2, -99,0,0,0,3,0,0,0,0,0, 0,0
DATA "Welcome . . .
DATA " "
DATA "   You awaken to find yourself in a completely foreign
DATA "land, filled with creatures and peoples you have never even
DATA "imagined.  After wandering for some time, you come to a deserted
DATA "castle on a hilltop, overlooking the sea.  You climb up to the
DATA "tower and have a good night's sleep, unaware of the adventures
DATA "that lie ahead . . .
DATA " "
DATA "   You awake from a deep sleep, hoping to find yourself safe
DATA "at home, but, alas, you are still in the---
DATA "z"
DATA ""
DATA -1,0,0,0

' Go down to location 4 --v
DATA 3, 0,0,0,0,0,0,0,0,0,4, 1,0
'         Natural lighting --^
DATA "Castle Tower
DATA "From here you can see the raging green ocean, stretching out
DATA "to the horizon to the north.  The tower itself is ravaged by
DATA "time, and the walls of the tower are crumbling and exposed.
DATA "A spiral stairway winds down the inside of the walls of this
DATA "round tower.
DATA ""
DATA -1,0,0,0

' Two map conditionals here, indicated by "-1" and "-2"
' West to location 8--v   v--Go up to location 3
DATA 4, 0,0,-1,0,-2,0,8,0,3,0, 1,0
'           Natural lighting --^
' If flag 20 equals 1, go to location 6.  Otherwise go to 4, print "closed."
DATA 20,0,1,6,4,"The door is closed."
' If flag 21 equals 1, go to location 7.  Otherwise print "Can't go that..."
DATA 21,0,1,7,0,""
DATA "Tower Base
DATA "This is a high-ceilinged room, some 25 feet, with the only light
DATA "coming through the doorway to the west and dimly from upstairs.
DATA "There is a heavy wooden door, about fifteen feet tall, in the
DATA "eastern wall.  The walls of made of finely-hewn stone, set with
DATA "a minimum of mortar, and are surprisingly well-preserved.
DATA "A spiral staircase winds up the perimeter.  The staircase was
DATA "cut from the very stone walls themselves.
DATA ""
' On the first day, print this message once
' (flag(4) is the day number, verbosity code 2 means print only once)
DATA 4,0,1,2
DATA "Here in the base of the tower you find evidence that the people
DATA "who built this castle were more highly technically advanced
DATA "than you originally thought: there are steel brackets mounted
DATA "in the walls.  Funny that you didn't recall seeing them last
DATA "night, but after all it was dark and you were tired and disoriented.
DATA ""
' Secret passageway
' If flag 21 equals 1, print the following description
DATA 21,0,1,0
DATA "A solid black rectangle, about the size of a door, hovers
DATA "as if attached to the southern wall.  It appears pitch black,
DATA "nevertheless a slight breeze emerges from it.
DATA ""
' Continuation of long description
' If flag 0 equals 0 (always true), and the long description was
' printed (verbosity 0), print the following
DATA 0,0,0,0
DATA "You hear the surf pounding on the rocks in the distance.
DATA ""
DATA -1,0,0,0

' Example of a bounceback location
' -99 means forced move
' If flag 0 equals 0 (always true), go to location -99, which means
' "bounce back"
'      this v---v is the conditional (always true)
DATA 5, -99,0,0,0,-99,0,0,0,0,0, 0,0
DATA " "
DATA "There is a flash of intense blue light and you are blinded
DATA "for a moment before the air clears and you realize you have
DATA "been jolted back into the tower base by some sort of force field.
DATA ""
DATA -1,0,0,0

' One map conditional, marked by "-1"
'       Going west --v checks map conditional 1 first
DATA 6, 0,0,0,0,0,0,-1,0,0,0, 0,0
'             Lamp lighting --^
' Map conditional 1 (for this location)
' if flag 20 equals 1, goto 4, otherwise stay in 6, print "door shut."
DATA 20,0,1,4,6,"The door is firmly shut.
DATA "Strange Grotto
DATA "This is more a hollowed-out cave than a room.  The walls are
DATA "simply made of soft dirt that seems to have been recently dug,
DATA "except for the stone wall to the west in which is embedded a
DATA "heavy wooden door.  The walls seem to be held together only by
DATA "a tightly woven net of roots which seem to ooze from everywhere
DATA "and appear almost as if they are moving.
DATA ""
' If flag 20 equals 1, print the following
' (verbosity code 0 means only print when the long description is also)
DATA 20,0,1,0
DATA "The door is ajar.",""
DATA -1,0,0,0

' One map conditional here, marked by "-1"
' If you go north, check map conditional 1 first
' Otherwise, stay in location 7, no matter where you go
DATA 7, -1,7,7,7,7,7,7,7,7,7, 0,0
DATA 21,0,1,4,7,""
' " " first means always print the long description
DATA " "
DATA "FLYING
DATA "You have a vision, that you are flying way above the clouds,
DATA "with nothing about you but the earth far below, a mountain range
DATA "to the east, and a bright afternoon sun.
DATA 21,0,1,0
DATA "A dark rectangle hovers in the air directly north of you.",""
DATA -1,0,0,0

' Go east to location 3, west to location 5
DATA 8, 0,0,4,0,0,0,5,0,0,0, 0,0
DATA "Entry Hall
DATA "This is what was obviously once an entry hall.  The doorway to
DATA "the outside lies to the west.  A fountain, made from exquisite
DATA "marble, lies in the center of the room, and still contains water.
DATA ""
DATA -1,0,0,0

' End marker
DATA 0

Flags:
' The flag format is simple:
'
' DATA flag,value,flag,value, . . .
'
' Where flag is a flag number and value is its initial value.  If
' not otherwise specified, the value is zero.
'
' The first value is the maximum number of flags (mflag).
'
DATA 40

' Note: the convention followed here is that flags 0-19 are "system"
' flags, common to all adventures that use this kernal.  At the moment,
' only flags 0-7 are being used.  Flags 20 and up are "adventure" flags,
' which are set and reset by the individual program.  In the example
' "adventure" given here, flags 20 and 21 are used.
'
' This program segment is also called as a subroutine by Initialize:
' to set various mnemonic variables to index the flag() array
'
' Note: flag zero should never be changed from its value of zero
' Flag zero is used as a constant value for flag conditionals
flag(0) = 0
' Lamp on?
lamp = 2:lampon = 2 'lamp is object 2
DATA 2,1
' Daytime? 2-moonlight, 3-twilight, 4-daytime
day = 3
DATA 3,4
' Day number
date = 4
DATA 4,1
' Time (aka "t") (See PostProcess:)
tim = 5
DATA 5,1
' Detail level (see Wordy: Brief: and Superbrief:)
verbose = 6
DATA 6,0
' Random (varies from 0 to 99) call RollDice to set this flag (Calc:)
' Note: EvalCond() automatically calls RollDice if flag(random) is tested
random = 7
RANDOMIZE TIMER ' Seed generator with timer value
DATA 7,0
CALL RollDice

' End marker
DATA 0
RETURN

Objects:
'
'  The list of objects is as follows:
'  data Number,prefix,word,adjectives,long description
'  data location,parent,relation
'  data size,weight,inopening,wrapopening,onopening,underopening
'  data containcapacity,wrapcapacity,surfacecapacity,undercapacity
'  data containopaque,wrapopaque,surfaceopaque,underopaque
'  data closed?,openable?,folded?,foldable?,locked?
'  data holdwater?,worn?,wearable?,soft?,food?,immobile?
'  data special 1,special 2,special 3
'
'  This information is placed in the following arrays, indexed by Number:
'
'  pre$(),word$(),adj$(),long$()
'  lo(),par(),rel()
'  { see below for first(rel,),last(rel,),left(), and right() }
'  size(),{see below for totw()},opening(rel,),cap(rel,),opaque(rel,)
'  closed(),openable(),folded(),foldable(),locked()
'  holdwater(),worn(),wearable(),soft(),food(),immobile()
'  special(0/1/2,)
'
'  More information is placed in the following arrays:
'
'  totw(),totb(),bulk(rel,)
'
'  The Number identifies the object to the program.  You can delete and
'  add objects without changing these Numbers, and in fact the objects
'  can be listed in any order.
'
'  The prefix contains "a" or "an" and any modifiers to be used when
'  listing the object (as in Contents()). --> pre$()
'
'  Word is a single word describing the type of object. --> word$()
'
'  Adjectives are used by the program to ask the player to
'  distinguish one object from another. --> adj$()
'
'  The long description is for use when the player examines an
'  object. --> long$()
'
'  The location is the room number the object is in.  This is 0 if the
'  object does not exist, and 1 if the player is carrying it.  This means
'  actual room numbers start with the number 2. --> lo()
'
'  The parent is the container the object is in, or zero.  (The parent
'  is zero if it is in a room.) --> par()
'
'  The "relationship" to the parent is given by:
'    MODE  DESCRIPTION
'      0 - inside
'      1 - wrapped by
'      2 - on top of
'      3 - underneath (only for objects under tables, etc., NOT for
'          objects stacked on top of each other---use 2 for that)
'  --> rel()
'
'  (The maximum number of relationships is stored in the mrel variable.
'  This is set by the second number in the first DATA statement, below.
'  The relationship is also referred to as "mode" elsewhere in the program.)
'
'  Size --> size().  The size of the object and everything
'     on top of and wrapped by (relations 1 and 2) the object --> totb()
'     The total bulk contained in relation rel to object n. --> bulk(rel,n)
'  Weight --> ?.  You give the weight of the object by itself, but the only
'     number which is stored is the total weight of the object and everything
'     inside it and on top of it.  This is stored in --> totw()
'        (The weight of the object by itself is implicit in the totw() array,
'     so it is not stored anywhere.)
'  Inopening, wrapopening, onopening, underopening --> opening(rel,obj).
'     where rel varies from 0 to 3.  This is how big an object can
'     fit in, wrapped by, on top of, and underneath an object.  The
'     "onopening" is usually equal to the surfacecapacity, below.
'  Containcapacity, wrapcapacity, surfacecapacity, undercapacity -->
'     cap(rel,obj), where rel varies from 0 to 3.  This is how much stuff
'     total can fit in relation to the object in these ways.
'  Containopaque, wrapopaque, surfaceopaque, underopaque --> opaque(rel,obj).
'     This determines whether or not objects inside, wrapped by, on top of,
'     or underneath an object are not visible.
'
'  Examples:
'     A bottle might have inopening 1 (narrow opening) but containcapacity
'  3 (so it can contain 3 objects of size 1).  It would be transparent,
'  i.e. containopaque = 0.
'     A purse, on the other hand, might have inopening 4, capacity 6,
'  and containopaque = 1 (opaque unless the purse is open).
'     A rug might have wrapcapacity 10, but surfacecapacity 30 (you can
'  wrap about a third of what you can stuff on top of it lying flat.)
'     A table might have surfacecapacity 30 and undercapacity 30
'  (you can stuff as much stuff on it as underneath it).  However, a book
'  might have surfacecapacity 3, so a table would not fit on the book,
'  but you could certainly put the book under the table.
'
'  (Size, weight, opening, capacity are in arbitrary units you can devise.
'  My convention is that most ordinary objects have a size of at least
'  2, so that really small objects can be distinguished from them by having
'  a size of 1.)
'
'  Holdwater? --> holdwater().
'  The codes are as follows:
'     0 - cannot hold water
'     1 - can hold water
'     2 - is water
'  ALL OBJECTS WHICH HOLD WATER MUST BE FOLLOWED BY their own personal
'  water object (i.e. holdwater() = 2).  This object is resized
'  as water is added to and removed from the container.
'  Currently, the program allows an object to hold either water or objects,
'  but not both at the same time.  (In a revision that can handle
'  "wetness" this restriction could be lifted.  I *have* thought out
'  algorithms for handling wetness; it would require major
'  revisions of almost every subprogram, so I decided to
'  release this "dry" version of AmigaVenture for those of you who
'  do not require wetness in your adventures.  If you are interested
'  in adding such code (remember, you have to handle evaporation, weight,
'  etc., without slowing down the program too much) please email me (USENET)
'  at [e-mail] through July 1987, and at harvard!mitsu (I think)
'  from August 1987, and I'll mail you my ideas for how to go about
'  implementing it within AmigaVenture.)
'
'  Closed? --> closed()
'  Locked? --> locked()
'
'  Folded? --> folded()
'  Foldable? --> foldable()
'  (Using the following codes:
'     0 - not foldable
'     1 - rolled up/rollable
'     2 - folded up/foldable
'     3 - tied up/tieable)
'
'  Worn? --> worn()
'  Wearable? --> wearable()
'  (Using the following codes:
'     0 - not wearable
'     1 - on hand
'     2 - on head, neck, ears
'     4 - on torso (backpacks, jackets, shirts)
'     8 - around waist (belts)
'     16 - on legs)
'
'  Soft? --> soft() is 1 for a chair or sofa type soft, and 2 for a bed
'  soft. An object can be used as a piece of furniture if its surface is
'  large enough.
'
'  Food? --> food() Whether or not it is edible, and how nutritious.
'     Arbitrary units.  Currently the food just disappears when eaten,
'     and has no effect.  Modify the Eat: routine for your personal system.
'
'  Liquid? --> liquid() Whether or not the object is a liquid.  All such
'     objects MUST be preceded by an object that can "holdwater".
'     Similarly, all objects that "holdwater" must be followed by a
'     liquid.  Currently the only liquid is water.
'
'  Immobile? --> immobile() objects cannot be moved, removed, etc. (like
'  doors, etc.)  In future revisions, this might contain a value
'  describing the degree of immobility (from 0-free, 1-nails/hinges,
'  2-mortar, 3-plasteel, etc.)  Currently, if an "immobile" object
'  that has *no* interior or surface (no capacity in any of the four
'  relations) and is lying free in a room (no parent), it is NOT linked into
'  the list of objects in that room, and will NOT appear in the description
'  of objects in the room (i.e., will not appear in the Here, you see:
'  list.)  The object should be described in the textual description of the
'  room.  Good uses for this would be for stairways, bookshelves, and the
'  like.  You don't want such things in the "Here, you see:" list, but
'  if the player has a reason to refer to them, you don't want the
'  program to say "I see no stairwell here." or worse "I don't know
'  what you mean by 'stairwell.'"
'
'  Please note the special importance of object 1, as described below.
'
'  Feel free to add to this list.  If you add to the list, simply
'  change the Initialize: routine and update the object data statements.
'  Perhaps someone can come up with an IFF-style format for storing
'  object descriptions, and people could write adventures that
'  allowed you to take objects from one adventure to the next.  But
'  that is a whole different ball of wax.  (How would you Number them,
'  for example?)
'
'  Of course, to save memory, this list and the whole Initialize: routine
'  should be placed in a separate program and run *before* the program,
'  and the program could just read in the results from a disk file.  Note
'  that you must copy the Insert() and Setloc() subprograms to such
'  an "initialization" program.  This would also be much faster.  However,
'  while developing an adventure, it is much more handy to have the
'  object list in the program, so you can "recompile" the object list
'  immediately as you modify your adventure.  Another neat idea would be
'  to write an AmigaVenture Object Editor, which could have all sorts
'  of interesting features (standard object types, etc. so you don't
'  have to specify all these attributes over and over for each object.)
'
'  This list is meant only as a guide to a fairly complete, albeit simple,
'  system for defining objects and their relationships.  One could imagine
'  arbitrarily extending this list of attributes to any desired degree
'  of realism; however, you should consider how much the added
'  attribute actually adds to the realism and play value of your
'  adventure versus the effort and program space taken to take care of
'  all the relationships the such attributes might entail (for example,
'  wetness).
'
'  NOTE TO THE PROGRAMMER:
'  Objects are kept track of in the following way:
'  The arrays lo(), par(), first(rel,), last(rel,), left(), and right()
'  contain information about doubly-linked lists of objects embedded
'  in a tree structure.
'
'  lo(obj) is the room the object is in. (0 if it is in limbo.  Note
'  the significance of location 1, the player's special location.)
'
'  first(rel,obj) holds the first in the list of objects in, wrapped by, on,
'  or under object "obj", or zero if none.  The "rel" index is 0, 1, 2,
'  and 3, respectively.
'
'  Lfirst(loc) (see Map:) holds the first in the list of objects lying free
'  in location "loc".
'
'  last(rel,obj) holds the last in the list of objects in, wrapped by, on,
'  or under object "obj", or zero if none.  The "rel" index is the same
'  as above.
'
'  Llast(loc) (see Map:) holds the last in the list of objects lying free
'  in location "loc".
'
'  par(obj) holds the parent of the object (0 if it is lying free)
'  rel(obj) holds the relation. (0, 1, 2, 3 for in, wrapped, on, under.)
'  (Ex.:If object 7 is on top of object 3, then par(7) = 3, rel(7) = 2 (on).)
'  (Ex.:If object 4 is lying free in room 17, then lo(4) = 17, par(4) = 0,
'       and rel(4) = 0.)
'
'  right(obj) holds the next in the list of objects.
'
'  left(obj) is the *previous* object in the list.
'
'  As below:
'
'            Parent (Bag) ---------------------------------\
'                | (RELATION 0, in)                        | Last
'                V                                         V
'            First (Fruit) Right -> (Sandwich) Right -> (Rock) Right -> Zero
'Zero <- Left               <- Left             <- Left
'
'  The paradigm is the program keeps track of a whole bunch of little
'  lists of objects.  Each list is either lying free in a room,
'  or inside, on top of, wrapped by, or underneath another object.
'  EVERY OBJECT keeps track of the following information about their
'  list: the parent of the list (0 if lying free), the relation the list
'  is in to the parent (0, 1, 2, 3 for in, wrapped, on, under), the
'  location number the list resides in (0 for limbo, 1 for player, 2 ...
'  for a map location).
'
'  The Remove(), Insert(), RemList() and Concat() subprograms handle
'  the list operations automatically.  They also update the totw(), totb()
'  and bulk(rel,) arrays.  ALWAYS use these routines to move objects
'  around, NEVER directly modify the list arrays yourself, to ensure that
'  all the lists and arrays remain consistent.  It took a long time to
'  debug these arrays, and a lot of redundant information is kept track
'  of for program speed, so take advantage of these routines.  Descriptions
'  of the routines are found near their implementations (after Lists:).

' Maximum number of objects (can be changed at will)
DATA 100

' The largest relationship number (in == 0, on, under, wrap == 3)
DATA 3

' The largest number of water containers (can be changed at will)
DATA 10

'  NOTE: Object number 1 is reserved for containing all the objects the
'  player is carrying.  This object is placed in location 1, and may not
'  be moved.  Also, no other object should be placed in location 1.
'
'  Items being carried by the player should be related to object 1 in
'  mode 1 (normally "wrapped by").  Items being *worn* by the player should
'  be related to object 1 in mode 0.
'
'  FOR OBJECT NUMBER 1 ONLY:
'
'       RELATION   DESCRIPTION
'       --------   -----------
'          0       Objects being worn
'          1       Objects being carried
'
' Objects carried thus must start with 1,1,1,...
' Objects worn must start with 1,0,1,...

ObjList:
DATA 1,,you,,
DATA 1,0,0, 0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0,0,0, 0,0,0,,0
' The program currently assumes the variable "lamp" is the object
' number of the lamp, and the flag number "lampon" determines whether
' it is on or off.  See Flags:, Calc:CheckLight(), and also TurnOn:
' and TurnOff:
DATA 2,a brass,lamp,brass,"The lamp is worn from use but still serviceable.
DATA 1,1,1, 5,5, 0,0,2,0, 0,0,2,0, 0,0,0,0, 0,0,0,0,0,0, 0,0,0,0,0
DATA 3,a,sandwich,ham and cheese,"It's a ham and cheese sandwich.
DATA 1,7,0, 2,2, 0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0,0,0, 0,0,0,1,0
DATA 5,a small,purse,satin,"The purse is made of satin.
DATA 4,0,0, 3,2, 6,0,2,0, 6,0,2,0, 1,1,0,0, 0,1,0,0,0,0, 0,0,0,0,0
DATA 6,a pearl,earring,pearl,"The earring is made of three exquisite pearls.
DATA 4,5,0, 1,1, 0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0,0,0, 0,2,0,0,0
DATA 7,a brown,bag,small paper,"It's just a small paper lunch sack.
DATA 1,1,1, 3,2, 4,2,4,0, 4,2,4,0, 1,1,0,0, 1,1,0,2,0,0, 0,0,0,0,0
DATA 8,a diamond,earring,diamond,"The earring is made of two precious diamonds.
DATA 3,0,0, 1,1, 0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0,0,0, 0,2,0,0,0
DATA 10,a glass,bottle,glass,"It's an old Coke bottle.
DATA 3,0,0, 1,1, 1,0,1,0, 2,0,1,0, 0,0,0,0, 0,1,0,0,0,1, 0,0,0,0,0
DATA 11,some,water,"",""
DATA 3,10,0, 2,2, 0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0,0,2, 0,0,0,0,0
DATA 12,an elfin,hat,elfin,"It's made of old, dirty green felt.
DATA 1,1,0, 2,2, 3,1,2,0, 3,1,2,0, 0,1,0,1, 0,0,0,2,0,0, 2,2,1,0,0
DATA 13,a small Oriental,rug,small Oriental,"The rug is well-worn from use.
DATA 4,0,0, 10,8, 0,7,20,0, 0,7,20,0, 0,0,0,1, 0,0,0,1,0,0, 0,0,1,0,0
DATA 14,a large,backpack,frame,"The label says 'REI.'
DATA 3,0,0, 10,10, 10,0,5,0, 20,0,5,0, 1,0,0,0, 1,1,0,0,0,0, 0,4,1,0,0
DATA 15,a long,rope,long,"The rope is made from hemp.
DATA 4,14,0, 4,3, 0,0,10,0, 0,0,10,0, 0,0,0,0, 0,0,0,0,0,0, 0,8,0,0,0
DATA 16,a,table,wooden,"The table is simply constructed from wood.
DATA 4,0,0, 70,50, 0,0,15,20, 0,0,20,20, 0,0,0,0, 0,0,0,0,0,0, 0,0,0,0,0
DATA 17,some steel,brackets,steel,"The brackets are heavy-duty and appear good as new.
DATA 4,0,0, 10,10, 0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0,0,0, 0,0,0,0,1
DATA 18,a spiral,staircase,spiral,"The staircase is somewhat crumbling, but still quite useable.
DATA 4,0,0, 0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0,0,0, 0,0,0,0,1
DATA 19,a marble,fountain,marble,"The fountain is made of striated marble.
DATA 8,0,0, 200,300, 100,0,0,0, 100,0,0,0, 0,0,0,0, 0,0,0,0,0,1, 0,0,0,0,1
DATA 20,some,water,"",""
DATA 8,19,0, 100,100, 0,0,0,0, 0,0,0,0, 0,0,0,0, 0,0,0,0,0,2, 0,0,0,0,0
' (End marker)
DATA 0

Nouns:
'  The list of nouns goes simply
'
'  data  noun,object 1,object 2, . . .,0
'
'  for each noun.  The list of objects are all the objects the noun
'  could possibly refer to.
'
'  The "noun" could also be an adjective.  The interpreter will
'  ask for futher clarification if there is still unresolved ambiguity.
'
'  Negative numbers refer to features or directions or other
'  abstractions which do not have objects associated with them.
'
'  This list must be all single words, no spaces.
'

' Maximum number of nouns, maximum number of homonyms
DATA 150,300

DATA the,0,a,0,an,0,those,0,these,0,for,0,is,0,are,0,by,0

DATA north,-1,0,n,-1,0,northeast,-2,0,ne,-2,0,east,-3,0,e,-3,0
DATA southeast,-4,0,se,-4,0,south,-5,0,s,-5,0,southwest,-6,0,sw,-6,0
DATA west,-7,0,w,-7,0,northwest,-8,0,nw,-8,0
DATA up,-9,0,u,-9,0,down,-10,0,d,-10,0
DATA upstairs,-9,0,downstairs,-10,0,ascend,-9,0,descend,-10,0

' Nouns from -11 to -19 are reserved as special words for use by the
' interpreter.  Do not change them without changing the interpreter also
DATA all,-11,0,everything,-11,0,it,-12,0,him,-12,0,her,-12,0,them,-13,0
DATA that,-14,0,that's,-14,0,that're,-14,0
DATA what,-15,0,what's,-15,0,what're,-15,0

DATA i,-20,0,me,-20,0,myself,-20,0,self,-20,0,my,-20,0
DATA you,-21,0,yourself,-21,0,your,-21,0
DATA game,-22,0

DATA lamp,2,0,brass,2,0
DATA ham,3,0,cheese,3,0,sandwich,3,0
DATA small,5,7,0,satin,5,0,purse,5,0
DATA pearl,6,0,earring,6,8,0
DATA brown,7,0,paper,7,0,bag,7,0
DATA diamond,8,0
DATA glass,10,0,bottle,10,0,Coke,10,0
DATA water,11,20,0
DATA elfin,12,0,felt,12,0,old,12,0,dirty,12,0,green,12,0,hat,12,0
DATA small,13,0,Oriental,13,0,well-worn,13,0,worn,13,0,rug,13,0
DATA large,14,0,frame,14,0,REI,14,0,backpack,14,0,pack,14,0
DATA long,15,0,hemp,15,0,rope,15,0
DATA wooden,16,0,table,16,0,wood,16,0
DATA steel,17,0,brackets,17,0
DATA stairs,18,0,staircase,18,0,spiral,18,0,stairway,18,0
DATA marble,19,0,fountain,19,0
' (End marker)
DATA "",0

' Abstract words like directions, etc., (any noun associated
' with no concrete moveable Object).
' The format is:
'    DATA code,word,code,word,etc.  (this is the same as
' the Objects format, but with only one descriptor).

abstract:
' Maximum number of abstract nouns (changeable, of course)
DATA 50

DATA 1,north,2,northeast,3,east,4,southeast,5,south
DATA 6,southwest,7,west,8,northwest,9,up,10,down
DATA 11,everything
DATA 13,water
DATA 20,yourself,21,me
DATA 22,the game


' (End marker)
DATA 0,""

fold:
DATA 3
DATA rolled up,folded up,tied up

' (End marker)
DATA ""

Verbs:
'
'  The list of verbs goes:
'
'  data verb,number,verb,number, . . .
'
'  The "number" refers to the number of the verb, which must correspond
'  to the number used by DoCommand when it goes to the appropriate
'  command in its ON GOTO statement.  See DoCommand.
'
'  Verbs of three words in length are placed first,
'  followed by a data "",0.  Then verbs of two words, followed
'  by a data "",0.  Finally all single-word verbs.
'
'  (an unlimited number of verbs are possible).
'
'   Please reserve verb numbers 1-49 for kernal verbs, common to
'  all adventures.  This allows upgrades of the adventure kernal
'  to be separated from adventure-specific commands.  If you update
'  the kernal, please use verbs 1-49; use verbs 50 and up for
'  magic words, etc. which would not be used in another adventure.
'  This allows other people to be able to take advantage of your
'  kernal upgrades without having to wade through adventure-specific
'  code.  Currently verbs 1-29 are being used.

'*** Three-word verbs
DATA let go of,3,get rid of,3,do it again,24,do it over,24
DATA i give up,32,I give up,32
DATA "",0

'*** Two-word verbs
DATA look at,5,look around,1,pick up,2,get out,2,take out,2,put down,3
DATA get me,3
DATA turn on,12,turn off,13,save game,17,load game,18
DATA put on,19,take off,20,wrap up,21,fold up,21,tie up,21,roll up,21
DATA start over,23,repeat last,24,do again,24,do over,24,over again,24
DATA pour out,25,fill up,26,eat up,27,gobble up,27
DATA sit down,29,stand up,30,get up,30,lie down,31
DATA quit game,32,give up,32,end game,32,drink all,33,drink up,33,slurp up,33
DATA "",0

'*** One-word verbs
DATA look,1,see,1,l,1
DATA get,2,take,2
DATA drop,3,release,3
DATA inventory,4,i,4
DATA examine,5,read,5
DATA go,6,walk,6,run,6,hop,6,skip,6,jump,6
DATA put,7,place,7
DATA open,8,close,9,lock,10,unlock,11
DATA activate,12,deactivate,13
DATA wordy,14,verbose,14,brief,15,superbrief,16
DATA save,17,load,18,restore,18,record,17
DATA wear,19,don,19
DATA wrap,21,fasten,21,unwrap,22,restart,23
DATA again,24,repeat,24
DATA empty,25,pour,25,fill,26
DATA eat,27,munch,27,consume,27,gobble,27,drink,28,quaff,28,slurp,28
DATA sit,29,stand,30,lie,31
DATA quit,32

' (End marker)
DATA "",0

' The preposition codes are 1 more than the relationship codes
' for object lists (see Objects: 0 = in, 1 = wrapped by, et cetera).
Prepositions:

DATA in,1,into,1,inside,1,wrapped,2,lying,3,on,3,onto,3,under,4,underneath,4
DATA to,5,with,6,from,7,and,8,then,8,but,9,except,9,not,9

' (End marker)
DATA "",0

Prepnames: 'Starting with preposition zero (null)

DATA . . .,inside,wrapped by,on,underneath,to,with

' (End marker)
DATA ""