c  =====================================================================
c  Adventure!
c  =====================================================================
c   Modified for MS DOS PDS FORTRAN v5.10 
c    by Paul Mu¤oz-Colman, FunStuff Software
c   27 Mar 1993  change date & time to getdat & gettim
c                delete DO66 and DEBUG metacommands
c                change pause prompt
c                change OPEN STATUS to UNKNOWN on overwrites
c   15 Oct 1990  fix abort in line 653 from using the "say" verb
c   13 Oct 1987  with suspend and resume feature--2-byte storage
c  =====================================================================
c
c  Differences from Honeywell version to live with MS FORTRAN 77:
c    1.  Can't EQUIVALENCE anything in COMMON or storage is bad.
c    2.  LOGICAL functions can't have integer arguments--doesn't work.
c        All were rewritten to be INTEGER functions (1=true,0=false)
c    3.  Data Base is binary file written by separate program to
c        save space and time.  Limited to 64K.  I/O is slowww...
c    4.  SAVE feature saves data arrays instead of whole program.
c        RESUME must be given first turn, which reads file.
c    5.  Demonstration game and wizard stuff is gone...stupid anyway..
c
c  Current limits:
c   21150 words of message text (lines, linsiz)
c     745 travel options (travel, trvsiz).
c     295 vocabulary words (ktab, atab, tabsiz).
c     150 locations (ltext, stext, key, cond, abb, atloc, locsiz).
c     100 objects (plac, place, fixd, fixed, link (twice), ptext, prop)
c      35 "action" verbs (actspk, vrbsiz).
c     205 random messages (rtext, rtxsiz).
c      12 different player classifications (ctext, cval, clsmax).
c      20 hints, less 3 (hintlc, hinted, hints, hntsiz).
c
c  there are also limits which cannot be exceeded due to the structure of
c  the database.  (e.g., the vocabulary uses n/1000 to determine word type,
c  so there can't be more than 1000 words.)  these upper limits are:
c  1000 non-synonymous vocabulary words
c  300 locations
c  100 objects
c
c  set metacommands for ms fortran
$nodebug
$notstrict
$storage: 2
c
      implicit integer*2 (a-z)
c
      common /txtcom/ rtext
      common /blkcom/ blklin
      common /voccom/ ktab,atab,tabsiz
      common /placom/ atloc,link,place,fixed,holdng
      common /ptxcom/ ptext
      common /abbcom/ abb
      common /concom/ cond
      common /loccom/ loc
      common /procom/ prop, lamp
      common /lincom/ lines
      character*2 lines (21150)
      character*4 wd1,wd2,iz,bl,atab(295),wd1x,wd2x
      character*1 tk(20)
c
      integer*2 ktab(295),rtext(205),atloc(150)
      integer*2 ltext(150),stext(150),key(150),cond(150),abb(150)
      integer*2 plac(100),place(100),fixd(100),fixed(100),link(200)
      integer*2 actspk(35),ptext(100),prop(100),ctext(12),cval(12)
      integer*2 hintlc(20),hinted(20),hints(20,4),dseen(6),dloc(6)
      integer*2 idondx,odloc(6)
      integer*4 travel(745),itk(20),newloc,linuse,kk,linsiz
      integer*4 ll,izz
c
      equivalence(izz,iz)
c
      external ran
c
      data linsiz/21150/,trvsiz/745/,locsiz/150/,izz/0/,
     .        vrbsiz/35/,rtxsiz/205/,clsmax/12/,hntsiz/20/
      data bl/'    '/
c
c  various functions--all integer in ms fortran--1 true  0 false
c  some are statement functions--others independently compiled
      bitset(l,n)=mod(shift(cond(l),-n),2)
      liq2(pbotl)=(1-pbotl)*water+(pbotl/2)*(water+oil)
      liqloc(loc)=liq2((mod(cond(loc)/2*2,8)-5)*mod(cond(loc)/4,2)+1)
      liq(dummy)=liq2(max0(prop(bottle),-1-prop(bottle)))
c
c  toting(obj) = true if the obj is being carried
c  here(obj)   = true if the obj is at "loc" (or is being carried)
c  at(obj)     = true if on either side of two-placed object
c  liq(dummy)  = object number of liquid in bottle
c  liqloc(loc) = object number of liquid (if any) at loc
c  bitset(l,n) = true if cond(l) has bit n set (bit 0 is units bit)
c  forced(loc) = true if loc moves without asking for input (cond=2)
c  dark(dummy) = true if location "loc" is dark
c  pct(n)      = true n% of the time (n integer*2 from 0 to 100)
c  wzdark says whether the loc he's leaving was dark
c  lmwarn says whether he's been warned about lamp going dim
c  closng says whether its closing time yet
c  panic says whether he's found out he's trapped in the cave
c  closed says whether we're all the way closed
c  gaveup says whether he exited via "quit"
c  scorng indicates to the score routine whether we're doing a "score" command
c  yea is random yes/no reply
 
c  description of the database format
c  the data file contains several sections.  each begins with a line containing
c  a number identifying the section, and ends with a line containing "-1".
c
c  section 1: long form descriptions.  each line contains a location number,
c  and a line of text.  the set of (necessarily adjacent) lines
c  whose numbers are x form the long description of location x.
c
c  section 2: short form descriptions.  same format as long form.  not all
c  places have short descriptions.
c
c  section 3: travel table.  each line contains a location number (x), a second
c  location number (y), and a list of motion numbers (see section 4).
c  each motion represents a verb which will go to y if currently at x.
c  y, in turn, is interpreted as follows.  let m=y/1000, n=y mod 1000.
c      if n<=300     it is the location to go to.
c      if 300<n<=500 n-300 is used in a computed goto to
c                           a section of special code.
c      if n>500      message n-500 from section 6 is printed,
c                           and he stays wherever he is.
c  meanwhile, m specifies the conditions on the motion.
c      if m=0        it's unconditional.
c      if 0<m<100    it is done with m% probability.
c      if m=100      unconditional, but forbidden to dwarves.
c      if 100<m<=200 he must be carrying object m-100.
c      if 200<m<=300 must be carrying or in same room as m-200.
c      if 300<m<=400 prop(m mod 100) must *not* be 0.
c      if 400<m<=500 prop(m mod 100) must *not* be 1.
c      if 500<m<=600 prop(m mod 100) must *not* be 2, etc.
c
c  if the condition (if any) is not met, then the next *different*
c  "destination" value is used (unless it fails to meet *its* conditions,
c  in which case the next is found, etc.).  typically, the next dest will
c  be for one of the same verbs, so that its only use is as the alternate
c  destination for those verbs.  for instance:
c      15     110022 29     31     34     35     23     43
c      15     14     29
c  this says that, from loc 15, any of the verbs 29, 31, etc1. will take
c  him to 22 if he's carrying object 10, and otherwise will go to 14.
c      11     303008 49
c      11     9      50
c  this says that, from 11, 49 takes him to 8 unless prop(3)=0, in which
c  case he goes to 9.  verb 50 takes him to 9 regardless of prop(3).
c
c  section 4: vocabulary.  each line contains a number (n), and a
c  five-letter word.  call m=n/1000.  if m=0, then the word is a motion
c  verb for use in travelling (see section 3).  else, if m=1, the word is
c  an object.  else, if m=2, the word is an action verb (such as "carry"
c  or "attack").  else, if m=3, the word is a special case verb (such as
c  "dig") and n mod 1000 is an index into section 6.  objects from 50 to
c  (currently, anyway) 79 are considered treasures (for pirate, closeout).
c
c  section 5: object descriptions.  each line contains a number (n),
c  and a message.  if n is from 1 to 100, the message is the "inventory"
c  message for object n.  otherwise, n should be 000, 100, 200, etc., and
c  the message should be the description of the preceding object when its
c  prop value is n/100.  the n/100 is used only to distinguish multiple
c  messages from multi-line messages; the prop info actually requires all
c  messages for an object to be present and consecutive.  properties which
c  produce no message should be given the message ">$<".
c
c  section 6: arbitrary messages.  same format as sections 1, 2, and 5, except
c  the numbers bear no relation to anything (except for special verbs
c  in section 4).
c
c  section 7: object locations.  each line contains an object number and its
c  initial location (zero (or omitted) if none).  if the object is
c  immovable, the location is followed by a "-1".  if it has two locations
c  (e.g. the grate) the first location is followed with the second, and
c  the object is assumed to be immovable.
c
c  section 8: action defaults.  each line contains an "action-verb" number and
c  the index (in section 6) of the default message for the verb.
c
c  section 9: liquid assets, etc.  each line contains a number (n) and up to 20
c  location numbers.  bit n (where 0 is the units bit) is set in cond(loc)
c  for each loc given.  the cond bits currently assigned are:
c      0      light
c      1      if bit 2 is on: on for oil, off for water
c      2      liquid asset, see bit 1
c      3      pirate doesn't go here unless following player
c  other bits are used to indicate areas of interest to "hint" routines:
c      4      trying to get into cave
c      5      trying to catch bird
c      6      trying to deal with snake
c      7      lost in maze
c      8      pondering dark room
c      9      at witt's end
c  cond(loc) is set to 2, overriding all other bits, if loc has forced
c  motion.
c
c  section 10: class messages.  each line contains a number (n), and a
c  message describing a classification of player.  the scoring section
c  selects the appropriate message, where each message is considered to
c  apply to players whose scores are higher than the previous n but not
c  higher than this n.  note that these scores probably change with every
c  modification (and particularly expansion) of the program.
c
c  section 11: hints.  each line contains a hint number (corresponding to a
c  cond bit, see section 9), the number of turns he must be at the right
c  loc(s) before triggering the hint, the points deducted for taking the
c  hint, the message number (section 6) of the question, and the message
c  number of the hint.  these values are stashed in the "hints" array.
c  hntmax is set to the max hint number (<= hntsiz).  numbers 1-3 are
c  unusable since cond bits are otherwise assigned, so 2 is used to
c  remember if he's read the clue in the repository, and 3 is used to
c  remember whether he asked for instructions (gets more turns, but loses
c  points).
c
c  section 12: magic messages. not implemented ibm pc version.  stupid.
c
c  section 0: end of database.
c
c  clear out the various text-pointer arrays.  all text is stored in array
c  lines; each line is preceded by a word pointing to the next pointer (i.e.
c  the word following the end of the line).  the pointer is negative if this is
c  first line of a message.  the text-pointer arrays contain indices of
c  pointer-words in lines.  stext(n) is short description of location n.
c  ltext(n) is long description.  ptext(n) points to message for prop(n)=0.
c  successive prop messages are found by chasing pointers.  rtext contains
c  section 6's stuff.  ctext(n) points to a player-class message.
c  we also clear cond.  see description of section 9 for details.
c
c  the stuff for section 3 is encoded here.  each "from-location" gets a
c  contiguous section of the "travel" array.  each entry in travel is
c  newloc*1000 + keyword (from section 4, motion verbs), and is negated if
c  this is the last entry for this location.  key(n) is the index in travel
c  of the first option at location n.
 
c  here we read in the vocabulary.  ktab(n) is the word number, atab(n) is
c  the corresponding word.  the -1 at the end of section 4 is left in ktab
c  as an end-marker.
 
c  read in the initial locations for each object.  also the immovability info.
c  plac contains initial locations of objects.  fixd is -1 for immovable
c  objects (including the snake), or = second loc for two-placed objects.
 
c  read default message numbers for action verbs, store in actspk.
 
c  read info about available liquids and other conditions, store in cond.
 
c  read data for hints.
 
c  having read in the database, certain things are now constructed.  props are
c  set to zero.  we finish setting up cond by checking for forced-motion travel
c  entries.  the plac and fixd arrays are used to set up atloc(n) as the first
c  object at location n, and link(obj) as the next object at the same location
c  as obj.  (obj>100 indicates that fixed(obj-100)=loc; link(obj) is still the
c  correct link to use.)  abb is zeroed; it controls whether the abbreviated
c  description is printed.  counts mod 5 unless "look" is used.
 
c  set up the atloc and link arrays as described above.  we'll use the drop
c  suboutine, which prefaces new objects on the lists.  since we want things
c  in the other order, we'll run the loop backwards.  if the object is in two
c  locs, we drop it twice.  this also sets up "place" and "fixed" as copies of
c  "plac" and "fixd".  also, since two-placed objects are typically best
c  described last, we'll drop them first.
 
c  treasures, as noted earlier, are objects 50 through maxtrs (currently 79).
c  their props are initially -1, and are set to 0 the first time they are
c  described.  tally keeps track of how many are not yet found, so we know
c  when to close the cave.  tally2 counts how many can never be found (e.g. if
c  lost bird or bridge).
 
c  clear the hint stuff.  hintlc(i) is how long he's been at loc with cond bit
c  i.  hinted(i) is true iff hint i has been used.
 
c  define some handy mnemonics.  these correspond to object numbers.
 
c  objects from 50 through whatever are treasures.  here are a few.
 
c  these are motion-verb numbers.
 
c  and some action verbs.
 
c  initialize the dwarves.  dloc is loc of dwarves, hard-wired in.  odloc is
c  prior loc of each dwarf, initially garbage.  daltlc is alternate initial loc
c  for dwarf, in case one of them starts out on top of the adventurer.  (no 2
c  of the 5 initial locs are adjacent.)  dseen is true if dwarf has seen him.
c  dflag controls the level of activation of all this:
c    0      no dwarf stuff yet (wait until reaches hall of mists)
c    1      reached hall of mists, but hasn't met first dwarf
c    2      met first dwarf, others start moving, no knives thrown yet
c    3      a knife has been thrown (first set always misses)
c    3+     dwarves are mad (increases their accuracy)
c  sixth dwarf is special (the pirate).  he always starts at his chest's
c  eventual location inside the maze.  this loc is saved in chloc for ref.
c  the dead end in the other maze has its loc stored in chloc2.
 
c  other random flags and counters, as follows:
c  turns  tallies how many commands he's given (ignores yes/no)
c  limit  lifetime of lamp (not set here)
c  iwest  how many times he's said "west" instead of "w"
c  knfloc 0 if no knife here, loc if knife here, -1 after caveat
c  detail how often we've said "not allowed to give more detail"
c  abbnum how often we should print non-abbreviated descriptions
c  maxdie number of reincarnation messages available (up to 5)
c  numdie number of times killed so far
c  holdng number of objects being carried
c  dkill  number of dwarves killed (unused in scoring, needed for msg)
c  foobar current progress in saying "fee fie foe foo".
c  bonus  used to determine amount of bonus if he reaches closing
c  clock1 number of turns from finding last treasure till closing
c  clock2 number of turns from first warning till blinding flash
c  logicals were explained earlier
 
c  read the database--resume restores variables at 8305 and proceeds
c
      write (*,1000)
 1000 format(//////////////,
     .           ' Adventure!  (The original Colossal Cave!)',
     .       ///,'     (Implemented for MS DOS in PDS FORTRAN v5.10',
     .         /,'      by Paul Mu¤oz-Colman, FunStuff Software.',
     .	/,'      Version 27 March 1993.)',
     .  ////////,' Initializing, Please Wait ...')
c
      open (1, file='ad.dat', form='unformatted')
c
c  read the data base in array format
c
      read (1) abbnum,axe,back,batter,bear,bird,bonus,bottle,
     .  cage,cave,chain,chasm,chest,chloc,chloc2,clam,
     .  clock1,clock2,closed,closng,coins,daltlc,detail,dflag,
     .  dkill,dloc,door,dprssn,dragon,dseen,dwarf,eggs,
     .  emrald,entrnc,find,fissur,foobar,food,gaveup,grate
c
      read (1) invent,iwest,keys,knfloc,knife,lamp,lmwarn,
     .  lock,look,magzin,maxdie,maxtrs,messag,mirror,nugget,
     .  null,numdie,oil,oyster,panic,pearl,pillow,plant,
     .  plant2,pyram,rod,rod2,rug,saved,say,scorng,
     .  snake,spices,steps,tablet,tally,tally2,throw,tridnt,
     .  troll,troll2,turns,vase,vend,water,tabsiz,blklin,oldloc,fixed
c
      read (1) linuse,trvs,tabndx,obj,verb,clsses,hntmax,loc,newloc,
     .  k,j,stext,ltext,ptext,rtext,ctext,cval,key,
     .  travel,ktab,plac,fixd,actspk,cond,hints,place,prop,link,
     .  abb,atloc,holdng,hinted,hintlc,kk,i,itk,atab,lines
c
      close (1)

      write (*,10001)
10001 format('+                                    ')
 
c  start-up, dwarf stuff
c
 1    i=ran(1)
      hinted(3)=yes(65,1,0)
      newloc=1
      limit=330
      if(hinted(3).eq.1)limit=1000
 
c  can't leave cave once it's closing (except by main office).
 
 2    if(newloc.ge.9.or.newloc.eq.0.or.closng.eq.0) go to 71
      call rspeak(130)
      newloc=loc
      if(panic.eq.0)clock2=15
      panic=1
 
c  see if a dwarf has seen him and has come from where he wants to go.  if so,
c  the dwarf's blocking his way.  if coming from place forbidden to pirate
c  (dwarves rooted in place) let him get out (and attacked).
 
 71   if(newloc.eq.loc.or.forced(loc).eq.1.or.bitset(loc,3).eq.1)goto74
      do 73 i=1,5
      if(odloc(i).ne.newloc.or.dseen(i).eq.0)goto 73
      newloc=loc
      call rspeak(2)
      goto 74
 73   continue
 74   loc=newloc
 
c  dwarf stuff.  see earlier comments for description of variables.  remember
c  sixth dwarf is pirate and is thus very different except for motion rules.
 
c  first off, don't let the dwarves follow him into a pit or a wall.  activate
c  the whole mess the first time he gets as far as the hall of mists (loc 15).
c  if newloc is forbidden to pirate (in particular, if it's beyond the troll
c  bridge), bypass dwarf stuff.  that way pirate can't steal return toll, and
c  dwarves can't meet the bear.  also means dwarves won't follow him into dead
c  end in maze, but c'est la vie.  they'll wait for him outside the dead end.
 
      nl=newloc
      if(loc.eq.0.or.forced(loc).eq.1.or.bitset(nl,3).eq.1)goto2000
      if(dflag.ne.0)goto 6000
      if(loc.ge.15)dflag=1
      goto 2000
 
c  when we encounter the first dwarf, we kill 0, 1, or 2 of the 5 dwarves.  if
c  any of the survivors is at loc, replace him with the alternate.
 
 6000 if(dflag.ne.1)goto 6010
      if(loc.lt.15.or.pct(95).eq.1)goto 2000
      dflag=2
      do 6001 i=1,2
      j=1+ran(5)
 6001 if(pct(50).eq.1) dloc(j)=0
      do 6002 i=1,5
      if(dloc(i).eq.loc)dloc(i)=daltlc
 6002 odloc(i)=dloc(i)
      call rspeak(3)
      call drop(axe,loc)
      goto 2000
 
c  things are in full swing.  move each dwarf at random, except if he's seen us
c  he sticks with us.  dwarves never go to locs <15.  if wandering at random,
c  they don't back up unless there's no alternative.  if they don't have to
c  move, they attack.  and, of course, dead dwarves don't do much of anything.
 
 6010 dtotal=0
      attack=0
      stick=0
      do 6030 i=1,6
      if(dloc(i).eq.0)goto 6030
      j=1
      kk=dloc(i)
      kk=key(kk)
      if(kk.eq.0)goto 6016
 6012 newloc=mod(iabs(travel(kk))/1000,1000)
      nl=newloc
      trv=iabs(travel(kk))/1000000
      itk2=itk(j-1)
      if(nl.gt.300.or.nl.lt.15.or.nl.eq.odloc(i)
     .   .or.(j.gt.1.and.nl.eq.itk2) .or.j.ge.20
     .   .or.nl.eq.dloc(i).or.forced(nl).eq.1
     .   .or.(i.eq.6.and.bitset(nl,3).eq.1)
     .   .or.trv.eq.100) go to 6014
      itk(j)=newloc
      j=j+1
 6014 kk=kk+1
      if(travel(kk-1).ge.0)goto 6012
 6016 itk(j)=odloc(i)
      if(j.ge.2)j=j-1
      j=1+ran(j)
      odloc(i)=dloc(i)
      dloc(i)=itk(j)
      zzz=0
      if (dseen(i).eq.1.and.loc.ge.15) zzz=1
      dseen(i)=0
      if (zzz.eq.1.or.(dloc(i).eq.loc.or.odloc(i).eq.loc))dseen(i)=1
      if(dseen(i).eq.0) go to 6030
      dloc(i)=loc
      if(i.ne.6)goto 6027
 
c  the pirate's spotted him.  he leaves him alone once we've found chest.
c  k counts if a treasure is here.  if not, and tally=tally2 plus one for
c  an unseen chest, let the pirate be spotted.
 
      if(loc.eq.chloc.or.prop(chest).ge.0)goto 6030
      k=0
      do 6020 j=50,maxtrs
c  pirate won't take pyramid from plover room or dark room (too easy!).
      if(j.eq.pyram.and.(loc.eq.plac(pyram)
     .   .or.loc.eq.plac(emrald)))goto 6020
      idondx=j
      if(toting(idondx).eq.1)goto 6022
 6020 if(here(idondx).eq.1)k=1
      if(tally.eq.tally2+1.and.k.eq.0.and.place(chest).eq.0
     .   .and.here(lamp).eq.1.and.prop(lamp).eq.1)goto 6025
      if(odloc(6).ne.dloc(6).and.pct(20).eq.1)call rspeak(127)
      goto 6030
 
 6022 call rspeak(128)
c  don't steal chest back from troll!
      if(place(messag).eq.0)call move(chest,chloc)
      call move(messag,chloc2)
      do 6023 j=50,maxtrs
      if(j.eq.pyram.and.(loc.eq.plac(pyram)
     .   .or.loc.eq.plac(emrald)))goto 6023
      idondx=j
      if(at(idondx).eq.1.and.fixed(idondx).eq.0)
     .  call carry(idondx,loc)
      if(toting(idondx).eq.1)call drop(idondx,chloc)
 6023 continue
 6024 dloc(6)=chloc
      odloc(6)=chloc
      dseen(6)=0
      goto 6030
 
 6025 call rspeak(186)
      call move(chest,chloc)
      call move(messag,chloc2)
      goto 6024
 
c  this threatening little dwarf is in the room with him!
 
 6027 dtotal=dtotal+1
      if(odloc(i).ne.dloc(i))goto 6030
      attack=attack+1
      if(knfloc.ge.0)knfloc=loc
      if(ran(1000).lt.95*(dflag-2))stick=stick+1
 6030 continue
 
c  now we know what's happening.  let's tell the poor sucker about it.
 
      if(dtotal.eq.0)goto 2000
      if(dtotal.eq.1)goto 75
      write (*,67) dtotal
 67   format(/' There are ',i1,' THREATENING LITTLE DWARVES in the'
     .,' room with you.')
      goto 77
 75   call rspeak(4)
 77   if(attack.eq.0)goto 2000
      if(dflag.eq.2)dflag=3
      if(attack.eq.1)goto 79
      write (*,78) attack
 78   format(/' ',i1,' of them THROW KNIVES at you!')
      k=6
 82   if(stick.gt.1)goto 83
      call rspeak(k+stick)
      if(stick.eq.0)goto 2000
      goto 84
 83   write (*,68) stick
 68   format(/' ',i1,' of them get you!')
 84   oldlc2=loc
      goto 99
 
 79   call rspeak(5)
      k=52
      goto 82
c  describe the current location and (maybe) get next command.
 
c  print text for current loc.
 
 2000 if(loc.eq.0)goto 99
      kk=stext(loc)
      if(mod(abb(loc),abbnum).eq.0.or.kk.eq.0)kk=ltext(loc)
      if(forced(loc).eq.1.or.dark(0).eq.0)goto 2001
      if(wzdark.eq.1.and.pct(35).eq.1)goto 90
      kk=rtext(16)
 2001 if(toting(bear).eq.1)call rspeak(141)
      kk2=kk
      call speak(kk2)
      k=1
      if(forced(loc).eq.1)goto 8
      if(loc.eq.33.and.pct(25).eq.1.and.closng.eq.0)call rspeak(8)
 
c  print out descriptions of objects at this location.  if not closing and
c  property value is negative, tally off another treasure.  rug is special
c  case; once seen, its prop is 1 (dragon on it) till dragon is killed.
c  similarly for chain; prop is initially 1 (locked to bear).  these hacks
c  are because prop=0 is needed to get full score.
 
      if(dark(0).eq.1)goto 2012
      abb(loc)=abb(loc)+1
      i=atloc(loc)
      blklin=1
 2004 if(i.eq.0)goto 2012
      obj=i
      if(obj.gt.100)obj=obj-100
      if(obj.eq.steps.and.toting(nugget).eq.1)goto 2008
      if(prop(obj).ge.0)goto 2006
      if(closed.eq.1)goto 2008
      prop(obj)=0
      if(obj.eq.rug.or.obj.eq.chain)prop(obj)=1
      tally=tally-1
c  if remaining treasures too elusive, zap his lamp.
      if(tally.eq.tally2.and.tally.ne.0)limit=min0(35,limit)
 2006 kk=prop(obj)
      if(obj.eq.steps.and.loc.eq.fixed(steps))kk=1
      kk2=kk
      call pspeak(obj,kk2)
      if (blklin.eq.1) blklin=0
 2008 i=link(i)
      goto 2004
 
 2009 k=54
 2010 spk=k
 2011 call rspeak(spk)
 
 2012 verb=0
      obj=0
      blklin=1
 
c  check if this loc is eligible for any hints.  if been here long enough,
c  branch to help section (on later page).  hints all come back here eventually
c  to finish the loop.  ignore "hints" < 4 (special stuff, see database notes).
 
 2600 do 2602 hint=4,hntmax
      if(hinted(hint).eq.1)goto 2602
      idondx=hint
      if(bitset(loc,idondx).eq.0)hintlc(hint)=-1
      hintlc(hint)=hintlc(hint)+1
      if(hintlc(hint).ge.hints(hint,1))goto 40000
 2602 continue
 
c  kick the random number generator just to add variety to the chase.  also,
c  if closing time, check for any objects being toted with prop < 0 and set
c  the prop to -1-prop.  this way objects won't be described until they've
c  been picked up and put down seperate from their seperate piles.  don't
c  tick clock1 unless well into cave (and not at y2).
c
26021 continue
      if(closed.eq.0)goto 2605
      if(prop(oyster).lt.0.and.toting(oyster).eq.1)
     .   call pspeak(oyster,1)
      do 2604 i=1,100
      idondx=i
 2604 if(toting(idondx).eq.1.and.prop(idondx).lt.0)
     .   prop(idondx)=-1-prop(idondx)
 2605 wzdark=dark(0)
      if(knfloc.gt.0.and.knfloc.ne.loc)knfloc=0
      i=ran(1)
      call getin(wd1,wd1x,wd2,wd2x)
 
c  every input, check "foobar" flag.  if zero, nothing's going on.  if pos,
c  make neg.  if neg, he skipped a word, so make it zero.
 
 2608 foobar=min0(0,-foobar)
      if (turns.eq.0.and.wd1.eq.'resu')go to 8305
      turns=turns+1
      if(verb.eq.say.and.wd2.ne.iz)verb=0
      if(verb.eq.say)goto 4090
      if(tally.eq.0.and.loc.ge.15.and.loc.ne.33)clock1=clock1-1
      if(clock1.eq.0)goto 10000
      if(clock1.lt.0)clock2=clock2-1
      if(clock2.eq.0)goto 11000
      if(prop(lamp).eq.1)limit=limit-1
      if(limit.le.30.and.here(batter).eq.1.and.prop(batter).eq.0
     . .and.here(lamp).eq.1)goto 12000
      if(limit.eq.0)goto 12400
      if(limit.lt.0.and.loc.le.8)goto 12600
      if(limit.le.30)goto 12200
19999  k=43
      if(liqloc(loc).eq.water)k=70
      if(wd1.eq.'ente'.and.(wd2.eq.'stre'.or.wd2.eq.'wate'))
     .   goto 2010
      if(wd1.eq.'ente'.and.wd2.ne.iz)goto 2800
      if((wd1.ne.'wate'.and.wd1.ne.'oil ')
     . .or.(wd2.ne.'plan'.and.wd2.ne.'door'))goto 2610
      if(at(vocab(wd2,1)).eq.1)wd2='pour'
 2610 if(wd1.ne.'west')goto 2630
      iwest=iwest+1
      if(iwest.eq.10)call rspeak(17)
 2630 i=vocab(wd1,-1)
      if(i.eq.-1)goto 3000
      k=mod(i,1000)
      kq=i/1000+1
      if(kq.gt.4) call bug(22)
      goto (8,5000,4000,2010),kq
 
c  get second word for analysis.
 
 2800 wd1=wd2
      wd1x=wd2x
      wd2=iz
      goto 2610
 
c  gee, i don't understand.
 
 3000 spk=60
      if(pct(20).eq.1)spk=61
      if(pct(20).eq.1)spk=13
      call rspeak(spk)
      goto 2600
 
c  analyze a verb.  remember what it was, go back for object if second word
c  unless verb is "say", which snarfs arbitrary second word.
 
 4000 verb=k
      spk=actspk(verb)
      if(wd2.ne.iz.and.verb.ne.say)goto 2800
      if(verb.eq.say)obj=wd2
      if(verb.gt.31)call bug(23)
      if(obj.ne.0)goto 4090
 
c  analyze an intransitive verb (ie, no object given yet).
 
 4080 goto(8010,8000,8000,8040,2009,8040,9070,9080,8000,8000,
     .    2011,9120,9130,8140,9150,8000,8000,8180,8000,8200,
     .    8000,9220,9230,8240,8250,8260,8270,8000,8000,8300,
     .    8310),verb
c         take drop  say open noth lock   on  off wave calm
c         walk kill pour  eat drnk  rub toss quit find invn
c         feed fill blst scor  foo  brf read brek wake susp
c         hour
 
c  analyze a transitive verb.
 
 4090 goto(9010,9020,9030,9040,2009,9040,9070,9080,9090,2011,
     .    2011,9120,9130,9140,9150,9160,9170,2011,9190,9190,
     .    9210,9220,9230,2011,2011,2011,9270,9280,9290,2011,
     .    2011),verb
c         take drop  say open noth lock   on  off wave calm
c         walk kill pour  eat drnk  rub toss quit find invn
c         feed fill blst scor  foo  brf read brek wake susp
c         hour
 
c  analyze an object word.  see if the thing is here, whether we've got a verb
c  yet, and so on.  object must be here unless verb is "find" or "invent(ory)"
c  (and no new verb yet to be analyzed).  water and oil are also funny, since
c  they are never actually dropped at any location, but might be here inside
c  the bottle or as a feature of the location.
 
 5000 obj=k
      if(fixed(k).ne.loc.and.here(k).eq.0)goto 5100
 5010 if(wd2.ne.iz)goto 2800
      if(verb.ne.0)goto 4090
      call a5toa1(wd1,wd1x,'?   ','    ',tk,k)
      write (*,5015) (tk(i),i=1,k)
 5015 format(/' What do you want to do with the ',20a1)
      goto 2600
 
 5100 if(k.ne.grate)goto 5110
      if(loc.eq.1.or.loc.eq.4.or.loc.eq.7)k=dprssn
      if(loc.gt.9.and.loc.lt.15)k=entrnc
      if(k.ne.grate)goto 8
 5110 if(k.ne.dwarf)goto 5120
      do 5112 i=1,5
      if(dloc(i).eq.loc.and.dflag.ge.2)goto 5010
 5112 continue
 5120 if((liq(0).eq.k.and.here(bottle).eq.1).or.k.eq.liqloc(loc))
     .  go to 5010
      if(obj.ne.plant.or.at(plant2).eq.0.or.prop(plant2).eq.0)goto 5130
      obj=plant2
      goto 5010
 5130 if(obj.ne.knife.or.knfloc.ne.loc)goto 5140
      knfloc=-1
      spk=116
      goto 2011
 5140 if(obj.ne.rod.or.here(rod2).eq.0)go to 5190
      obj=rod2
      goto 5010
 5190 if((verb.eq.find.or.verb.eq.invent).and.wd2.eq.iz)goto 5010
      call a5toa1(wd1,wd1x,' her','e.  ',tk,k)
      write (*,5199) (tk(i),i=1,k)
 5199 format(/' I see no ',20a1)
      goto 2012
c  figure out the new location
c
c  given the current location in "loc", and a motion verb number in "k", put
c  the new location in "newloc".  the current loc is saved in "oldloc" in case
c  he wants to retreat.  the current oldloc is saved in oldlc2, in case he
c  dies.  (if he does, newloc will be limbo, and oldloc will be what killed
c  him, so we need oldlc2, which is the last place he was safe.)
 
 8    kk=key(loc)
      newloc=loc
      if(kk.eq.0)call bug(26)
      if(k.eq.null)goto 2
      if(k.eq.back)goto 20
      if(k.eq.look)goto 30
      if(k.eq.cave)goto 40
      oldlc2=oldloc
      oldloc=loc
 
 9    ll=iabs(travel(kk))
      if(mod(ll,1000).eq.1.or.mod(ll,1000).eq.k)goto 10
      if(travel(kk).lt.0)goto 50
      kk=kk+1
      goto 9
 
 10   ll=ll/1000
 11   newloc=ll/1000
      k=mod(newloc,100)
      if(newloc.le.300)goto 13
      nl=newloc
      if(prop(k).ne.((nl/100)-3)) go to 16
 12   if(travel(kk).lt.0)call bug(25)
      kk=kk+1
      newloc=iabs(travel(kk))/1000
      if(newloc.eq.ll)goto 12
      ll=newloc
      goto 11
 
 13   if(newloc.le.100)goto 14
      nl=newloc
      if(toting(k).eq.1.or.(nl.gt.200.and.at(k).eq.1))goto 16
      goto 12
 
 14   nl=newloc
      if(nl.ne.0.and.pct(nl).eq.0) go to 12
 16   newloc=mod(ll,1000)
      if(newloc.le.300)goto 2
      if(newloc.le.500)goto 30000
      nl=newloc
      call rspeak(nl-500)
      newloc=loc
      goto 2
 
c  special motions come here.  labelling convention: statement numbers nnnxxc  (
 
30000 newloc=newloc-300
      if(newloc.gt.3)call bug(20)
      goto (30100,30200,30300),newloc
 
c  travel 301.  plover-alcove passage.  can carry only emerald.  note: travel
c  table must include "useless" entries going through passage, which can never
c  be used for actual motion, but can be spotted by "go back".
 
30100 newloc=99+100-loc
      if(holdng.eq.0.or.(holdng.eq.1.and.toting(emrald).eq.1))goto 2
      newloc=loc
      call rspeak(117)
      goto 2
 
c  travel302.  plover transport.  drop the emerald (only use special travel if
c  toting it), so he's forced to use the plover-passage to get it out.  having
c  dropped it, go back and pretend he wasn't carrying it after all.
 
30200 call drop(emrald,loc)
      goto 12
 
c  travel 303.  troll bridge.  must be done only as special motion so that
c  dwarves won't wander across and encounter the bear.  (they won't follow the
c  player there because that region is forbidden to the pirate.)  if
c  prop(troll)=1, he's crossed since paying, so step out and block him.
c  (standard travel entries check for prop(troll)=0.)  special stuff for bear.
 
30300 if(prop(troll).ne.1)goto 30310
      call pspeak(troll,1)
      prop(troll)=0
      call move(troll2,0)
      call move(troll2+100,0)
      call move(troll,plac(troll))
      call move(troll+100,fixd(troll))
      call juggle(chasm)
      newloc=loc
      goto 2
 
30310 newloc=plac(troll)+fixd(troll)-loc
      if(prop(troll).eq.0)prop(troll)=1
      if(toting(bear).eq.0)goto 2
      call rspeak(162)
      prop(chasm)=1
      prop(troll)=2
      nl=newloc
      call drop(bear,nl)
      fixed(bear)=-1
      prop(bear)=3
      if(prop(spices).lt.0)tally2=tally2+1
      oldlc2=newloc
      goto 99
 
c  end of specials.
 
c  handle "go back".  look for verb which goes from loc to oldloc, or to oldlc2
c  if oldloc has forced-motion.  k2 saves entry -> forced loc -> previous loc.
 
 20   k=oldloc
      if(forced(k).eq.1)k=oldlc2
      oldlc2=oldloc
      oldloc=loc
      k2=0
      if(k.ne.loc)goto 21
      call rspeak(91)
      goto 2
 
 21   ll=mod((iabs(travel(kk))/1000),1000)
      if(ll.eq.k)goto 25
      if(ll.gt.300)goto 22
      j=key(ll)
      ls=ll
      trv=mod((iabs(travel(j))/1000),1000)
      if(forced(ls).eq.1.and.trv.eq.k)
     .  k2=kk
 22   if(travel(kk).lt.0)goto 23
      kk=kk+1
      goto 21
 
 23   kk=k2
      if(kk.ne.0)goto 25
      call rspeak(140)
      goto 2
 
 25   k=mod(iabs(travel(kk)),1000)
      kk=key(loc)
      goto 9
 
c  look.  can't give more detail.  pretend it wasn't dark (though it may "now"
c  be dark) so he won't fall into a pit while staring into the gloom.
 
 30   if(detail.lt.3)call rspeak(15)
      detail=detail+1
      wzdark=0
      abb(loc)=0
      goto 2
 
c  cave.  different messages depending on whether above ground.
 
 40   if(loc.lt.8)call rspeak(57)
      if(loc.ge.8)call rspeak(58)
      goto 2
 
c  non-applicable motion.  various messages depending on word given.
 
 50   spk=12
      if(k.ge.43.and.k.le.50)spk=9
      if(k.eq.29.or.k.eq.30)spk=9
      if(k.eq.7.or.k.eq.36.or.k.eq.37)spk=10
      if(k.eq.11.or.k.eq.19)spk=11
      if(verb.eq.find.or.verb.eq.invent)spk=59
      if(k.eq.62.or.k.eq.65)spk=42
      if(k.eq.17)spk=80
      call rspeak(spk)
      goto 2
c  "you're dead, jim."
c
c  if the current loc is zero, it means the clown got himself killed.  we'll
c  allow this maxdie times.  maxdie is automatically set based on the number of
c  snide messages available.  each death results in a message (81, 83, etc.)
c  which offers reincarnation; if accepted, this results in message 82, 84,
c  etc.  the last time, if he wants another chance, he gets a snide remark as
c  we exit.  when reincarnated, all objects being carried get dropped at oldlc2
c  (presumably the last place prior to being killed) without change of props.
c  the loop runs backwards to assure that the bird is dropped before the cage.
c  (this kluge could be changed once we're sure all references to bird and cage
c  are done by keywords.)  the lamp is a special case (it wouldn't do to leave
c  it in the cave).  it is turned off and left outside the building (only if he
c  was carrying it, of course).  he himself is left inside the building (and
c  heaven help him if he tries to xyzzy back into the cave without the lamp).
c  oldloc is zapped so he can't just "retreat".
 
c  the easiest way to get killed is to fall into a pit in pitch darkness.
 
 90   call rspeak(23)
      oldlc2=loc
 
c  okay, he's dead.  let's get on with it.
 
 99   if(closng.eq.1)goto 95
      yea=yes(81+numdie*2,82+numdie*2,54)
      numdie=numdie+1
      if(numdie.eq.maxdie.or.yea.eq.0)goto 20000
      place(water)=0
      place(oil)=0
      if(toting(lamp).eq.1)prop(lamp)=0
      do 98 j=1,100
      i=101-j
      if(toting(i).eq.0)goto 98
      k=oldlc2
      if(i.eq.lamp)k=1
      call drop(i,k)
 98   continue
      loc=3
      oldloc=loc
      goto 2000
 
c  he died during closing time.  no resurrection.  tally up a death and exit.
 
 95   call rspeak(131)
      numdie=numdie+1
      goto 20000
c  routines for performing the various action verbs
 
c  statement numbers in this section are 8000 for intransitive verbs, 9000 for
c  transitive, plus ten times the verb number.  many intransitive verbs use the
c  transitive code, and some verbs use code for other verbs, as noted below.
 
c  random intransitive verbs come here.  clear obj just in case (see "attack").
 
 8000 call a5toa1(wd1,wd1x,' wha','t?  ',tk,k)
      write (*,8002) (tk(i),i=1,k)
 8002 format(/' ',20a1)
      obj=0
      goto 2600
 
c  carry, no object given yet.  ok if only one object present.
 
 8010 if(atloc(loc).eq.0.or.link(atloc(loc)).ne.0)goto 8000
      do 8012 i=1,5
      if(dloc(i).eq.loc.and.dflag.ge.2)goto 8000
 8012 continue
      obj=atloc(loc)
 
c  carry an object.  special cases for bird and cage (if bird in cage, can't
c  take one without the other.  liquids also special, since they depend on
c  status of bottle.  also various side effects, etc.
 
 9010 if(toting(obj).eq.1)goto 2011
      spk=25
      if(obj.eq.plant.and.prop(plant).le.0)spk=115
      if(obj.eq.bear.and.prop(bear).eq.1)spk=169
      if(obj.eq.chain.and.prop(bear).ne.0)spk=170
      if(fixed(obj).ne.0)goto 2011
      if(obj.ne.water.and.obj.ne.oil)goto 9017
      if(here(bottle).eq.1.and.liq(0).eq.obj)goto 9018
      obj=bottle
      if(toting(bottle).eq.1.and.prop(bottle).eq.1)goto 9220
      if(prop(bottle).ne.1)spk=105
      if(toting(bottle).eq.0)spk=104
      goto 2011
 9018 obj=bottle
 9017 if(holdng.lt.7)goto 9016
      call rspeak(92)
      goto 2012
 9016 if(obj.ne.bird)goto 9014
      if(prop(bird).ne.0)goto 9014
      if(toting(rod).eq.0)goto 9013
      call rspeak(26)
      goto 2012
 9013 if(toting(cage).eq.1)goto 9015
      call rspeak(27)
      goto 2012
 9015 prop(bird)=1
 9014 if((obj.eq.bird.or.obj.eq.cage).and.prop(bird).ne.0)
     .   call carry(bird+cage-obj,loc)
      call carry(obj,loc)
      k=liq(0)
      if(obj.eq.bottle.and.k.ne.0)place(k)=-1
      goto 2009
 
c  discard object.  "throw" also comes here for most objects.  special cases for
c  bird (might attack snake or dragon) and cage (might contain bird) and vase.
c  drop coins at vending machine for extra batteries.
 
 9020 if(toting(rod2).eq.1.and.obj.eq.rod.and.toting(rod).eq.0)obj=rod2
      if(toting(obj).eq.0)goto 2011
      if(obj.ne.bird.or.here(snake).eq.0)goto 9024
      call rspeak(30)
      if(closed.eq.1)goto 19000
      call dstroy(snake)
c  set prop for use by travel options
      prop(snake)=1
 9021 k=liq(0)
      if(k.eq.obj)obj=bottle
      if(obj.eq.bottle.and.k.ne.0)place(k)=0
      if(obj.eq.cage.and.prop(bird).ne.0)call drop(bird,loc)
      if(obj.eq.bird)prop(bird)=0
      call drop(obj,loc)
      goto 2012
 
 9024 if(obj.ne.coins.or.here(vend).eq.0)goto 9025
      call dstroy(coins)
      call drop(batter,loc)
      call pspeak(batter,0)
      goto 2012
 
 9025 if(obj.ne.bird.or.at(dragon).eq.0.or.prop(dragon).ne.0)goto 9026
      call rspeak(154)
      call dstroy(bird)
      prop(bird)=0
      if(place(snake).eq.plac(snake))tally2=tally2+1
      goto 2012
 
 9026 if(obj.ne.bear.or.at(troll).eq.0)goto 9027
      call rspeak(163)
      call move(troll,0)
      call move(troll+100,0)
      call move(troll2,plac(troll))
      call move(troll2+100,fixd(troll))
      call juggle(chasm)
      prop(troll)=2
      goto 9021
 
 9027 if(obj.eq.vase.and.loc.ne.plac(pillow))goto 9028
      call rspeak(54)
      goto 9021
 
 9028 prop(vase)=2
      if(at(pillow).eq.1)prop(vase)=0
      call pspeak(vase,prop(vase)+1)
      if(prop(vase).ne.0)fixed(vase)=-1
      goto 9021
 
c  say.  echo wd2 (or wd1 if no wd2 (say what?, etc.).)  magic words override.
 
 9030 call a5toa1(wd2,wd2x,'".  ','    ',tk,k)
      if(wd2.eq.iz)call a5toa1(wd1,wd1x,'".  ','    ',tk,k)
      if(wd2.ne.iz)wd1=wd2
      i=vocab(wd1,-1)
      if(i.eq.62.or.i.eq.65.or.i.eq.71.or.i.eq.2025)goto 9035
      write (*,9032) (tk(i),i=1,k)
 9032 format(/' Okay, "',20a1)
      goto 2012
 
 9035 wd2=iz
      obj=0
      goto 2630
 
c  lock, unlock, no object given.  assume various things if present.
 
 8040 spk=28
      if(here(clam).eq.1)obj=clam
      if(here(oyster).eq.1)obj=oyster
      if(at(door).eq.1)obj=door
      if(at(grate).eq.1)obj=grate
      if(obj.ne.0.and.here(chain).eq.1)goto 8000
      if(here(chain).eq.1)obj=chain
      if(obj.eq.0)goto 2011
 
c  lock, unlock object.  special stuff for opening clam/oyster and for chain.
 
 9040 if(obj.eq.clam.or.obj.eq.oyster)goto 9046
      if(obj.eq.door)spk=111
      if(obj.eq.door.and.prop(door).eq.1)spk=54
      if(obj.eq.cage)spk=32
      if(obj.eq.keys)spk=55
      if(obj.eq.grate.or.obj.eq.chain)spk=31
      if(spk.ne.31.or.here(keys).eq.0)goto 2011
      if(obj.eq.chain)goto 9048
      if(closng.eq.0)goto 9043
      k=130
      if(panic.eq.0)clock2=15
      panic=1
      goto 2010
 
 9043 k=34+prop(grate)
      prop(grate)=1
      if(verb.eq.lock)prop(grate)=0
      k=k+2*prop(grate)
      goto 2010
 
c  clam/oyster.
 9046 k=0
      if(obj.eq.oyster)k=1
      spk=124+k
      if(toting(obj).eq.1)spk=120+k
      if(toting(tridnt).eq.0)spk=122+k
      if(verb.eq.lock)spk=61
      if(spk.ne.124)goto 2011
      call dstroy(clam)
      call drop(oyster,loc)
      call drop(pearl,105)
      goto 2011
 
c  chain.
 9048 if(verb.eq.lock)goto 9049
      spk=171
      if(prop(bear).eq.0)spk=41
      if(prop(chain).eq.0)spk=37
      if(spk.ne.171)goto 2011
      prop(chain)=0
      fixed(chain)=0
      if(prop(bear).ne.3)prop(bear)=2
      fixed(bear)=2-prop(bear)
      goto 2011
 
 9049 spk=172
      if(prop(chain).ne.0)spk=34
      if(loc.ne.plac(chain))spk=173
      if(spk.ne.172)goto 2011
      prop(chain)=2
      if(toting(chain).eq.1)call drop(chain,loc)
      fixed(chain)=-1
      goto 2011
 
c  light lamp
 
 9070 if(here(lamp).eq.0)goto 2011
      spk=184
      if(limit.lt.0)goto 2011
      prop(lamp)=1
      call rspeak(39)
      if(wzdark.eq.1)goto 2000
      goto 2012
 
c  lamp off
 
 9080 if(here(lamp).eq.0)goto 2011
      prop(lamp)=0
      call rspeak(40)
      if(dark(0).eq.1)call rspeak(16)
      goto 2012
 
c  wave.  no effect unless waving rod at fissure.
 
 9090 if((toting(obj)).eq.0.and.(obj.ne.rod.or.toting(rod2).eq.0))
     .   spk=29
      if(obj.ne.rod.or.at(fissur).eq.0.or.toting(obj).eq.0
     .   .or.closng.eq.1)go to 2011
      prop(fissur)=1-prop(fissur)
      call pspeak(fissur,2-prop(fissur))
      goto 2012
 
c  attack.  assume target if unambiguous.  "throw" also links here.  attackable
c  objects fall into two categories: enemies (snake, dwarf, etc.)  and others
c  (bird, clam).  ambiguous if two enemies, or if no enemies but two others.
 
 9120 do 9121 i=1,5
      if(dloc(i).eq.loc.and.dflag.ge.2)goto 9122
 9121 continue
      i=0
 9122 if(obj.ne.0)goto 9124
      if(i.ne.0)obj=dwarf
      if(here(snake).eq.1)obj=obj*100+snake
      if(at(dragon).eq.1.and.prop(dragon).eq.0)obj=obj*100+dragon
      if(at(troll).eq.1)obj=obj*100+troll
      if(here(bear).eq.1.and.prop(bear).eq.0)obj=obj*100+bear
      if(obj.gt.100)goto 8000
      if(obj.ne.0)goto 9124
c  can't attack bird by throwing axe.
      if(here(bird).eq.1.and.verb.ne.throw)obj=bird
c  clam and oyster both treated as clam for intransitive case; no harm done.
      if(here(clam).eq.1.or.here(oyster).eq.1)obj=100*obj+clam
      if(obj.gt.100)goto 8000
 9124 if(obj.ne.bird)goto 9125
      spk=137
      if(closed.eq.1)goto 2011
      call dstroy(bird)
      prop(bird)=0
      if(place(snake).eq.plac(snake))tally2=tally2+1
      spk=45
 9125 if(obj.eq.0)spk=44
      if(obj.eq.clam.or.obj.eq.oyster)spk=150
      if(obj.eq.snake)spk=46
      if(obj.eq.dwarf)spk=49
      if(obj.eq.dwarf.and.closed.eq.1)goto 19000
      if(obj.eq.dragon)spk=167
      if(obj.eq.troll)spk=157
      if(obj.eq.bear)spk=165+(prop(bear)+1)/2
      if(obj.ne.dragon.or.prop(dragon).ne.0)goto 2011
c  fun stuff for dragon.  if he insists on attacking it, win!  set prop to dead,
c  move dragon to central loc (still fixed), move rug there (not fixed), and
c  move him there, too.  then do a null motion to get new description.
      call rspeak(49)
      verb=0
      obj=0
      call getin(wd1,wd1x,wd2,wd2x)
      if(wd1.ne.'y   '.and.wd1.ne.'yes ')goto 2608
      call pspeak(dragon,1)
      prop(dragon)=2
      prop(rug)=0
      k=(plac(dragon)+fixd(dragon))/2
      call move(dragon+100,-1)
      call move(rug+100,0)
      call move(dragon,k)
      call move(rug,k)
      do 9126 obj=1,100
      idondx=obj
      if(place(idondx).eq.plac(dragon).or.
     .   place(idondx).eq.fixd(dragon))
     .   call move(idondx,k)
 9126 continue
      loc=k
      k=null
      goto 8
 
c  pour.  if no object, or object is bottle, assume contents of bottle.
c  special tests for pouring water or oil on plant or rusty door.
 
 9130 if(obj.eq.bottle.or.obj.eq.0)obj=liq(0)
      if(obj.eq.0)goto 8000
      if(toting(obj).eq.0)goto 2011
      spk=78
      if(obj.ne.oil.and.obj.ne.water)goto 2011
      prop(bottle)=1
      place(obj)=0
      spk=77
      if(at(plant).eq.0.and.at(door).eq.0) go to 2011
 
      if(at(door).eq.1)goto 9132
      spk=112
      if(obj.ne.water)goto 2011
      call pspeak(plant,prop(plant)+1)
      prop(plant)=mod(prop(plant)+2,6)
      prop(plant2)=prop(plant)/2
      k=null
      goto 8
 
 9132 prop(door)=0
      if(obj.eq.oil)prop(door)=1
      spk=113+prop(door)
      goto 2011
 
c  eat.  intransitive: assume food if present, else ask what.  transitive: food
c  ok, some things lose appetite, rest are ridiculous.
 
 8140 if(here(food).eq.0)goto 8000
 8142 call dstroy(food)
      spk=72
      goto 2011
 9140 if(obj.eq.food)goto 8142
      if(obj.eq.bird.or.obj.eq.snake.or.obj.eq.clam.or.obj.eq.oyster
     .   .or.obj.eq.dwarf.or.obj.eq.dragon.or.obj.eq.troll
     .   .or.obj.eq.bear)spk=71
      goto 2011
 
c  drink.  if no object, assume water and look for it here.  if water is in
c  the bottle, drink that, else must be at a water loc, so drink stream.
 
 9150 if(obj.eq.0.and.liqloc(loc).ne.water.and.(liq(0).ne.water
     .   .or.here(bottle).eq.0))goto 8000
      if(obj.ne.0.and.obj.ne.water)spk=110
      if(spk.eq.110.or.liq(0).ne.water.or.here(bottle).eq.0)goto 2011
      prop(bottle)=1
      place(water)=0
      spk=74
      goto 2011
 
c  rub.  yields various snide remarks.
 
 9160 if(obj.ne.lamp)spk=76
      goto 2011
 
c  throw.  same as discard unless axe.  then same as attack except ignore bird,
c  and if dwarf is present then one might be killed.  (only way to do so)
c  axe also special for dragon, bear, and troll.  treasures special for troll.
 
 9170 if(toting(rod2).eq.1.and.obj.eq.rod.and.toting(rod).eq.0)obj=rod2
      if(toting(obj).eq.0)goto 2011
      if(obj.ge.50.and.obj.le.maxtrs.and.at(troll).eq.1)goto 9178
      if(obj.eq.food.and.here(bear).eq.1)goto 9177
      if(obj.ne.axe)goto 9020
      do 9171 i=1,5
c  needn't check dflag if axe is here.
      if(dloc(i).eq.loc)goto 9172
 9171 continue
      spk=152
      if(at(dragon).eq.1.and.prop(dragon).eq.0)goto 9175
      spk=158
      if(at(troll).eq.1)goto 9175
      if(here(bear).eq.1.and.prop(bear).eq.0)goto 9176
      obj=0
      goto 9120
 
 9172 spk=48
      if(ran(3).eq.0) go to 9175
      dseen(i)=0
      dloc(i)=0
      spk=47
      dkill=dkill+1
      if(dkill.eq.1)spk=149
 9175 call rspeak(spk)
      call drop(axe,loc)
      k=null
      goto 8
 
c  this'll teach him to throw the axe at the bear!
 9176 spk=164
      call drop(axe,loc)
      fixed(axe)=-1
      prop(axe)=1
      call juggle(bear)
      goto 2011
 
c  but throwing food is another story.
 9177 obj=bear
      goto 9210
 
 9178 spk=159
c  snarf a treasure for the troll.
      call drop(obj,0)
      call move(troll,0)
      call move(troll+100,0)
      call drop(troll2,plac(troll))
      call drop(troll2+100,fixd(troll))
      call juggle(chasm)
      goto 2011
 
c  quit.  intransitive only.  verify intent and exit if that's what he wants.
 
 8180 gaveup=yes(22,54,54)
 8185 if(gaveup.eq.1)goto 20000
      goto 2012
 
c  find.  might be carrying it, or it might be here.  else give caveat.
 
 9190 if(at(obj).eq.1.or.(liq(0).eq.obj.and.at(bottle).eq.1)
     .   .or.k.eq.liqloc(loc))spk=94
      do 9192 i=1,5
 9192 if(dloc(i).eq.loc.and.dflag.ge.2.and.obj.eq.dwarf)spk=94
      if(closed.eq.1)spk=138
      if(toting(obj).eq.1)spk=24
      goto 2011
 
c  inventory.  if object, treat same as find.  else report on current burden.
 
 8200 spk=98
      blklin=1
      do 8201 i=1,100
      idondx=i
      if(idondx.eq.bear.or.toting(idondx).eq.0)goto 8201
      if(spk.eq.98)call rspeak(99)
      call pspeak(idondx,-1)
      if (blklin.eq.1) blklin=0
      spk=0
 8201 continue
      blklin=1
      if(toting(bear).eq.1)spk=141
      goto 2011
 
c  feed.  if bird, no seed.  snake, dragon, troll: quip.  if dwarf, make him
c  mad.  bear, special.
 
 9210 if(obj.ne.bird)goto 9212
      spk=100
      goto 2011
 
 9212 if(obj.ne.snake.and.obj.ne.dragon.and.obj.ne.troll)goto 9213
      spk=102
      if(obj.eq.dragon.and.prop(dragon).ne.0)spk=110
      if(obj.eq.troll)spk=182
      if(obj.ne.snake.or.closed.eq.1.or.here(bird).eq.0)goto 2011
      spk=101
      call dstroy(bird)
      prop(bird)=0
      tally2=tally2+1
      goto 2011
 
 9213 if(obj.ne.dwarf)goto 9214
      if(here(food).eq.0)goto 2011
      spk=103
      dflag=dflag+1
      goto 2011
 
 9214 if(obj.ne.bear)goto 9215
      if(prop(bear).eq.0)spk=102
      if(prop(bear).eq.3)spk=110
      if(here(food).eq.0)goto 2011
      call dstroy(food)
      prop(bear)=1
      fixed(axe)=0
      prop(axe)=0
      spk=168
      goto 2011
 
 9215 spk=14
      goto 2011
 
c  fill.  bottle must be empty, and some liquid available.  (vase is nasty.)
 
 9220 if(obj.eq.vase)goto 9222
      if(obj.ne.0.and.obj.ne.bottle)goto 2011
      if(obj.eq.0.and.here(bottle).eq.0)goto 8000
      spk=107
      if(liqloc(loc).eq.0)spk=106
      if(liq(0).ne.0)spk=105
      if(spk.ne.107)goto 2011
      prop(bottle)=mod(cond(loc),4)/2*2
      k=liq(0)
      if(toting(bottle).eq.1)place(k)=-1
      if(k.eq.oil)spk=108
      goto 2011
 
 9222 spk=29
      if(liqloc(loc).eq.0)spk=144
      if(liqloc(loc).eq.0.or.toting(vase).eq.0)goto 2011
      call rspeak(145)
      prop(vase)=2
      fixed(vase)=-1
      goto 9024
 
c  blast.  no effect unless you've got dynamite, which is a neat trick!
 
 9230 if(prop(rod2).lt.0.or.closed.eq.0)goto 2011
      bonus=133
      if(loc.eq.115)bonus=134
      if(here(rod2).eq.1)bonus=135
      call rspeak(bonus)
      goto 20000
 
c  score.  go to scoring section, which will return to 8241 if scorng is true.
 
 8240 scorng=1
      goto 20000
 
 8241 scorng=0
      write(*,8243) score, mxscor, turns
 8243 format(/' If you were to quit now,',/,' You would score',i4
     . ,' out of a possible',i4,', using ',i5,' turns.')
c  gaveup=yes(143,54,54)
c  goto 8185
      go to 2012
c  fee fie foe foo (and fum).  advance to next state if given in proper order.
c  look up wd1 in section 3 of vocab to determine which word we've got.  last
c  word zips the eggs back to the giant room (unless already there).
 
 8250 k=vocab(wd1,3)
      spk=42
      if(foobar.eq.1-k)goto 8252
      if(foobar.ne.0)spk=151
      goto 2011
 
 8252 foobar=k
      if(k.ne.4)goto 2009
      foobar=0
      if(place(eggs).eq.plac(eggs)
     .      .or.(toting(eggs).eq.1.and.loc.eq.plac(eggs)))goto 2011
c  bring back troll if we steal the eggs back from him before crossing.
      if(place(eggs).eq.0.and.place(troll).eq.0.and.prop(troll).eq.0)
     .      prop(troll)=1
      k=2
      if(here(eggs).eq.1)k=1
      if(loc.eq.plac(eggs))k=0
      call move(eggs,plac(eggs))
      call pspeak(eggs,k)
      goto 2012
 
c  brief.  intransitive only.  suppress long descriptions after first time.
 
 8260 spk=156
      abbnum=10000
      detail=3
      goto 2011
 
c  read.  magazines in dwarvish, message we've seen, and . . . oyster?
 
 8270 if(here(magzin).eq.1)obj=magzin
      if(here(tablet).eq.1)obj=obj*100+tablet
      if(here(messag).eq.1)obj=obj*100+messag
      if(closed.eq.1.and.toting(oyster).eq.1)obj=oyster
      if(obj.gt.100.or.obj.eq.0.or.dark(0).eq.1)goto 8000
 
 9270 if(dark(0).eq.1)goto 5190
      if(obj.eq.magzin)spk=190
      if(obj.eq.tablet)spk=196
      if(obj.eq.messag)spk=191
      if(obj.eq.oyster.and.hinted(2).eq.1.and.toting(oyster).eq.1)
     .  spk=194
      if(obj.ne.oyster.or.hinted(2).eq.1.or.toting(oyster).eq.0
     .   .or.closed.eq.0)goto 2011
      hinted(2)=yes(192,193,54)
      goto 2012
 
c  break.  only works for mirror in repository and, of course, the vase.
 
 9280 if(obj.eq.mirror)spk=148
      if(obj.eq.vase.and.prop(vase).eq.0)goto 9282
      if(obj.ne.mirror.or.closed.eq.0)goto 2011
      call rspeak(197)
      goto 19000
 
 9282 spk=198
      if(toting(vase).eq.1)call drop(vase,loc)
      prop(vase)=2
      fixed(vase)=-1
      goto 2011
 
c  wake.  only use is to disturb the dwarves.
 
 9290 if(obj.ne.dwarf.or.closed.eq.0)goto 2011
      call rspeak(199)
      goto 19000
c
c  suspend.  offer to exit and give specs on restart.
c  upon restarting, "resume" on first turn only comes to 8305
c
 8300 write (*,8302)
 8302 format(/' I can suspend your Adventure for you so that you can',
     . /,' restart later, but you will have to type "resume" on your',
     . /,' FIRST TURN.  The save process will write a 2772 byte file',
     . /,' named ADVENTUR.SV in your current directory.')
c
      if(yes(200,54,54).eq.0) go to 2012
c
c  write data file with all the good stuff to resume from
c
      open (2,file='adventur.sv',form='unformatted',status='unknown')
      write (2) place,prop,link,abb,cond,atloc,fixd,plac,hinted,
     .   hintlc,dseen,dloc,odloc,fixed,hints,tally,tally2,dflag,turns,
     .   limit,iwest,knfloc,detail,abbnum,maxdie,numdie,holdng,dkill,
     .   foobar,bonus,lmwarn,clock1,clock2,panic,closed,obj,verb,newloc
     .  ,loc,dtotal,attack,stick,itk,idondx,kk,oldlc2,oldloc,wzdark,
     .  closng
      close (2)
c
      write (*,83001)
83001 format(//,' Your Adventure has been saved.  Type "resume"',/,
     .   ' on your FIRST TURN to restart where you left off.',//)
      go to 25000
c
c  resume saved game from data file adventur.sv.  resume must be on
c  first turn.  comes here to read all variables as we wrote them
c  and proceeds.
c
8305  open (2,file='adventur.sv',form='unformatted')
      read  (2) place,prop,link,abb,cond,atloc,fixd,plac,hinted,
     .   hintlc,dseen,dloc,odloc,fixed,hints,tally,tally2,dflag,turns,
     .   limit,iwest,knfloc,detail,abbnum,maxdie,numdie,holdng,dkill,
     .   foobar,bonus,lmwarn,clock1,clock2,panic,closed,obj,verb,newloc
     .  ,loc,dtotal,attack,stick,itk,idondx,kk,oldlc2,oldloc,wzdark,
     .  closng
      close (2)
      yea=1
      k=null
      goto 8
 
c  hours.  report current non-prime-time hours.
 
 8310 write (*,83101)
83101 format (/,' Colossal Cave is always open.')
      goto 2012
c
c  hints
 
c  come here if he's been long enough at required loc(s) for some unused hint.
c  hint number is in variable "hint".  branch to quick test for additional
c  conditions, then come back to do neat stuff.  goto 40010 if conditions are
c  met and we want to offer the hint.  goto 40020 to clear hintlc back to zero,
c  40030 to take no action yet.
 
40000 if(hint.lt.4.or.hint.gt.9) call bug(27)
      go to (40400,40500,40600,40700,40800,40900),(hint-3)
c     cave  bird  snake maze  dark  witt
 
40010       hintlc(hint)=0
      if(yes(hints(hint,3),0,54).eq.0)goto 26021
      write (*,40012) hints (hint,2)
40012 format(/' I am prepared to give you a hint, but it will cost you',
     . i2,' points.')
      hinted(hint)=yes(175,hints(hint,4),54)
      if(hinted(hint).eq.1.and.limit.gt.30)limit=limit+30*hints(hint,2)
40020 hintlc(hint)=0
40030 goto 26021
 
c  now for the quick tests.  see database description for one-line notes.
 
40400 if(prop(grate).eq.0.and.here(keys).eq.0)goto 40010
      goto 40020
 
40500 if(here(bird).eq.1.and.toting(rod).eq.1.and.obj.eq.bird)goto40010
      goto 40030
 
40600 if(here(snake).eq.1.and.here(bird).eq.0)goto 40010
      goto 40020
 
40700 if(atloc(loc).eq.0.and.atloc(oldloc).eq.0
     .   .and.atloc(oldlc2).eq.0.and.holdng.gt.1)goto 40010
      goto 40020
 
40800 if(prop(emrald).ne.-1.and.prop(pyram).eq.-1)goto 40010
      goto 40020
 
40900 goto 40010
 
c  cave closing and scoring
 
c  these sections handle the closing of the cave.  the cave closes "clock1"
c  turns after the last treasure has been located (including the pirate's
c  chest, which may of course never show up).  note that the treasures need not
c  have been taken yet, just located.  hence clock1 must be large enough to get
c  out of the cave (it only ticks while inside the cave).  when it hits zero,
c  we branch to 10000 to start closing the cave, and then sit back and wait for
c  him to try to get out.  if he doesn't within clock2 turns, we close the
c  cave; if he does try, we assume he panics, and give him a few additional
c  turns to get frantic before we close.  when clock2 hits zero, we branch to
c  11000 to transport him into the final puzzle.  note that the puzzle depends
c  upon all sorts of random things.  for instance, there must be no water or
c  oil, since there are beanstalks which we don't want to be able to water,
c  since the code can't handle it.  also, we can have no keys, since there is a
c  grate (having moved the fixed object!) there separating him from all the
c  treasures.  most of these problems arise from the use of negative prop
c  numbers to suppress the object descriptions until he's actually moved the
c  objects.
 
c  when the first warning comes, we lock the grate, destroy the bridge, kill
c  all the dwarves (and the pirate), remove the troll and bear (unless dead),
c  and set "closng" to true.  leave the dragon; too much trouble to move it.
c  from now until clock2 runs out, he cannot unlock the grate, move to any
c  location outside the cave (loc<9), or create the bridge.  nor can he be
c  resurrected if he dies.  note that the snake is already gone, since he got
c  to the treasure accessible only via the hall of the mt. king.  also, he's
c  been in giant room (to get eggs), so we can refer to it.  also also, he's
c  gotten the pearl, so we know the bivalve is an oyster.  *and*, the dwarves
c  must have been activated, since we've found chest.
 
10000 prop(grate)=0
      prop(fissur)=0
      do 10010 i=1,6
      dseen(i)=0
10010 dloc(i)=0
      call move(troll,0)
      call move(troll+100,0)
      call move(troll2,plac(troll))
      call move(troll2+100,fixd(troll))
      call juggle(chasm)
      if(prop(bear).ne.3)call dstroy(bear)
      prop(chain)=0
      fixed(chain)=0
      prop(axe)=0
      fixed(axe)=0
      call rspeak(129)
      clock1=-1
      closng=1
      goto 19999
 
c  once he's panicked, and clock2 has run out, we come here to set up the
c  storage room.  the room has two locs, hardwired as 115 (ne) and 116 (sw).
c  at the ne end, we place empty bottles, a nursery of plants, a bed of
c  oysters, a pile of lamps, rods with stars, sleeping dwarves, and him.  and
c  the sw end we place grate over treasures, snake pit, covey of caged birds,
c  more rods, and pillows.  a mirror stretches across one wall.  many of the
c  objects come from known locations and/or states (e.g. the snake is known to
c  have been destroyed and needn't be carried away from its old "place"),
c  making the various objects be handled differently.  we also drop all other
c  objects he might be carrying (lest he have some which could cause trouble,
c  such as the keys).  we describe the flash of light and trundle back.
 
11000 prop(bottle)=put(bottle,115,1)
      prop(plant)=put(plant,115,0)
      prop(oyster)=put(oyster,115,0)
      prop(lamp)=put(lamp,115,0)
      prop(rod)=put(rod,115,0)
      prop(dwarf)=put(dwarf,115,0)
      loc=115
      oldloc=115
      newloc=115
 
c  leave the grate with normal (non-negative property).
 
      foo=put(grate,116,0)
      prop(snake)=put(snake,116,1)
      prop(bird)=put(bird,116,1)
      prop(cage)=put(cage,116,0)
      prop(rod2)=put(rod2,116,0)
      prop(pillow)=put(pillow,116,0)
 
      prop(mirror)=put(mirror,115,0)
      fixed(mirror)=116
 
      do 11010 i=1,100
      idondx=i
11010 if(toting(idondx).eq.1)call dstroy(idondx)
 
      call rspeak(132)
      closed=1
      goto 2
 
c  another way we can force an end to things is by having the lamp give out.
c  when it gets close, we come here to warn him.  we go to 12000 if the lamp
c  and fresh batteries are here, in which case we replace the batteries and
c  continue. 12200 is for other cases of lamp dying.  12400 is when it goes
c  out, and 12600 is if he's wandered outside and the lamp is used up, in which
c  case we force him to give up.
 
12000 call rspeak(188)
      prop(batter)=1
      if(toting(batter).eq.1)call drop(batter,loc)
      limit=limit+2500
      lmwarn=0
      goto 19999
 
12200 if(lmwarn.eq.1.or.here(lamp).eq.0)goto 19999
      lmwarn=1
      spk=187
      if(place(batter).eq.0)spk=183
      if(prop(batter).eq.1)spk=189
      call rspeak(spk)
      goto 19999
 
12400 limit=-1
      prop(lamp)=0
      if(here(lamp).eq.1)call rspeak(184)
      goto 19999
 
12600 call rspeak(185)
      gaveup=1
      goto 20000
 
c  oh dear, he's disturbed the dwarves.
 
19000 call rspeak(136)
 
c  exit code.  will eventually include scoring.  for now, however, ...
 
c  the present scoring algorithm is as follows:
c  objective:          points:        present total possible:
c  getting well into cave   45                    45
c  each treasure < chest    12                    60
c  treasure chest itself    14                    14
c  each treasure > chest    16                   144
c  surviving             (max-num)*10             30
c  not quitting              4                     4
c  reaching "closng"        25                    25
c  "closed": quit/killed    10
c            klutzed        25
c            wrong way      30
c            success        45                    45
c  came to witt's end        1                     1
c  round out the total       2                     2
c                                       total:   370
c  (points can also be deducted for using hints.)
 
20000 score=0
      mxscor=0
 
c  first tally up the treasures.  must be in building and not broken.
c  give the poor guy 2 points just for finding each treasure.
 
      do 20010 i=50,maxtrs
      if(ptext(i).eq.0)goto 20010
      k=12
      if(i.eq.chest)k=14
      if(i.gt.chest)k=16
      if(prop(i).ge.0)score=score+2
      if(place(i).eq.3.and.prop(i).eq.0)score=score+k-2
      mxscor=mxscor+k
20010 continue
 
c  now look at how he finished and how far he got.  maxdie and numdie tell us
c  how well he survived.  gaveup says whether he exited via quit.  dflag will
c  tell us if he ever got suitably deep into the cave.  closng still indicates
c  whether he reached the endgame.  and if he got as far as "cave closed"
c  (indicated by "closed"), then bonus is zero for mundane exits or 133, 134,
c  135 if he blew it (so to speak).
 
      score=score+(maxdie-numdie)*10
      mxscor=mxscor+maxdie*10
      if(scorng.eq.0.and.gaveup.eq.0)score=score+4
      mxscor=mxscor+4
      if(dflag.ne.0)score=score+45
      mxscor=mxscor+45
      if(closng.eq.1)score=score+25
      mxscor=mxscor+25
      if(closed.eq.0)go to 20020
      if(bonus.eq.0)score=score+10
      if(bonus.eq.135)score=score+25
      if(bonus.eq.134)score=score+30
      if(bonus.eq.133)score=score+45
20020 mxscor=mxscor+45
 
c  did he come to witt's end as he should?
 
      if(place(magzin).eq.108)score=score+1
      mxscor=mxscor+1
 
c  round it off.
 
      score=score+2
      mxscor=mxscor+2
 
c  deduct points for hints.  hints < 4 are special; see database description.
 
      do 20030 i=1,hntmax
20030 if(hinted(i).eq.1)score=score-hints(i,2)
 
c  return to score command if that's where we came from.
 
      if(scorng.eq.1)goto 8241
 
c  that should be good enough.  let's tell him all about it.
 
      write (*,20100) score, mxscor, turns
20100 format(///' You scored',i4,' out of a possible',i4,
     . ', using',i5,' turns.')
 
      do 20200 i=1,clsses
      if(cval(i).ge.score)goto 20210
20200 continue
      write (*,20202)
20202 format(/' You just went off my scale !! (Whoops) !!'/)
      goto 25000
 
20210 call speak(ctext(i))
      if(i.eq.clsses-1)goto 20220
      k=cval(i)+1-score
      iz='s.  '
      if(k.eq.1)iz='.   '
      write (*,20212) k, iz
20212 format(/' To achieve the next higher rating, you need',i3,
     . ' more point',a2/)
      goto 25000
 
20220 write (*,20222)
20222 format(/' To achieve the next higher rating ',
     . 'would be a neat trick, Oh Great One!!'//' Congratulations!!'/)
 
25000 write (*,25001)
25001 format (/////)
      pause 'Please Press the ENTER Key to Exit From Adventure.'
      end
c
c  subroutines and functions
      subroutine speak(n)
c  print the message which starts at lines(n).  precede it with a blank line
c  unless blklin is false.
      implicit integer*2 (a-z)
      common /lincom/ lines
      common /txtcom/ rtext
      common /blkcom/ blklin
      dimension rtext (205)
      character*2 lines (21150)
      character*2 np,clines
      integer*4 nnn,k,l,i
      equivalence (clines,ilines)
      data np/'>$'/
      nnn=n
      if(nnn.eq.0)return
      if(lines(nnn+1).eq.np)return
      if(blklin.eq.1) write (*,2)
      k=nnn
 1    clines=lines(k)
      l=iabs(ilines)-1
      k=k+1
      write (*, 2) (lines(i),i=k,l)
 2    format(' ',36a2)
      k=l+1
      clines=lines(k)
      if(ilines.ge.0) go to 1
      return
      end
 
      subroutine pspeak(msg,skip)
c  find the skip+1st message from msg and print it.  msg should be the index of
c  the inventory message for object.  (inven+n+1 message is prop=n message).
      implicit integer*2 (a-z)
      common /lincom/ lines
      common /txtcom/ rtext
      common /ptxcom/ ptext
      character*2 lines (21150),clines
      dimension rtext(205),ptext(100)
      integer*4 mm
      equivalence (clines,ilines)
      m=ptext(msg)
      if(skip.lt.0)goto 9
      do 3 i=1,skip+1
 1    mm=m
      clines=lines(mm)
      m=iabs(ilines)
      mm=m
      clines=lines(mm)
      if(ilines.ge.0) go to 1
 3    continue
 9    call speak(m)
      return
      end
 
      subroutine rspeak(i)
c  print the i-th "random" message (section 6 of database).
      implicit integer*2 (a-z)
      common /txtcom/ rtext
      dimension rtext(205)
      if(i.ne.0)call speak(rtext(i))
      return
      end
 
      integer*2 function yes(x,y,z)
c  call yesx (below) with messages from section 6.
      implicit integer*2 (a-z)
      yes=yesx(x,y,z)
      return
      end
 
      integer*2 function yesx(x,y,z)
c  print message x, wait for yes/no answer.  if yes, print y and leave yea
c  true; if no, print z and leave yea false.
      implicit integer*2 (a-z)
      character*4 reply,junk1,junk2,junk3
 1    if(x.ne.0) call rspeak (x)
      call getin(reply,junk1,junk2,junk3)
      if(reply.eq.'yes '.or.reply.eq.'y   ')goto 10
      if(reply.eq.'no  '.or.reply.eq.'n   ')goto 20
      write (*,9)
 9    format(/' Please answer the question "yes" or "no".')
      goto 1
 10   yesx=1
      if(y.ne.0) call rspeak (y)
      return
 20   yesx=0
      if(z.ne.0) call rspeak (z)
      return
      end
 
      subroutine a5toa1 (a, b, c, d, chars, leng)
c   a & b contain a 1 to 8-character word in a4 format.  c & d contain
c  another word and/or punctuation. they are unpacked to one character
c  per word in the array "chars", with exactly one blank between b & c
c  (or none, if c is zero).  the index of the last non-blank character
c  in chars is returned in leng.
      implicit integer*2 (a-z)
      integer*4 ic
      character *20 aaa
      character *4 a,b,c,d,aa(5),cc
      character *1 chars(20),raw(20)
      equivalence (aaa,aa),(cc,ic)
c  do first word until a blank
      aa(1) = a
      aa(2) = b
      call unpack (aaa, raw)
c  clear output array and move, counting to first blank
      leng=0
      do 2 i=1,20
2     chars(i)=' '
      do 1 i=1,8
      if (raw(i).eq.' ') go to 3
      chars(i)=raw(i)
1     leng=i
c  leng doesn't include trailing blank
3     cc=c
      if(ic.eq.0) go to 99
c  second word--ignore leading blanks, stop at trailing one
      chars(leng+1)=' '
      leng=leng+1
      ll=leng
      aa(1)=c
      aa(2)=d
      call unpack (aaa,raw)
c  skip leading blank if any
      do 4 j=1,8
4     if (raw(j).ne.' ') go to 5
c  second word was all blank--fooey
      go to 99
c  do non-blanks
5     do 6 k=j,8
      if (raw(k).eq.' ') go to 99
      chars (k-j+1+ll) = raw(k)
6     leng=leng+1
99    return
      end
c
      integer*2 function vocab(id,init)
c  look up id in the vocabulary (atab) and return its "definition" (ktab), or
c  -1 if not found.  if init is positive, this is an initialization call setting
c  up a keyword variable, and not finding it constitutes a bug.  it also means
c  that only ktab values which taken over 1000 equal init may be considered.
c  (thus "steps", which is a motion verb also, may be considered
c  as an object.)  and it also means the ktab value is taken mod 1000.
      implicit integer*2 (a-z)
      common /voccom/ ktab,atab,tabsiz
      character*4 atab(295),id
      dimension ktab(295)
      do 1 i=1,tabsiz
      if(ktab(i).eq.-1)goto 2
      if(init.ge.0.and.ktab(i)/1000.ne.init)goto 1
      if(atab(i).eq.id)goto 3
 1    continue
 10   format(1x,i4,2x,a4)
      call bug(21)
 2    vocab=-1
      if(init.lt.0)return
      write (*,10) init, id
      call bug(5)
 3    vocab=ktab(i)
      if(init.ge.0)vocab=mod(vocab,1000)
      return
      end
 
      subroutine dstroy(object)
c  permanently eliminate "object" by moving to a non-existent location.
      implicit integer*2 (a-z)
      call move(object,0)
      return
      end
 
      subroutine juggle(object)
c  juggle an object by picking it up and putting it down again, the purpose
c  being to get the object to the front of the chain of things at its loc.
      implicit integer*2 (a-z)
      common /placom/ atloc,link,place,fixed,holdng
      dimension atloc(150),link(200),place( 100),fixed(100)
      i=place(object)
      call move(object,i)
      call move(object+100,j)
      return
      end
 
      subroutine move(object,where)
 
c  place any object anywhere by picking it up and dropping it.  may already be
c  toting, in which case the carry is a no-op.  mustn't pick up objects which
c  are not at any loc, since carry wants to remove objects from atloc chains.
      implicit integer*2 (a-z)
      common /placom/ atloc,link,place,fixed,holdng
      dimension atloc(150),link(200),place( 100),fixed(100)
      if(object.gt.100)goto 1
      from=place(object)
      goto 2
 1    from=fixed(object-100)
 2    if(from.gt.0.and.from.le.300)call carry(object,from)
      call drop(object,where)
      return
      end
 
      integer*2 function put(object,where,pval)
 
c  put is the same as move, except it returns a value used to set up the
c  negated prop values for the repository objects.
      implicit integer*2 (a-z)
      call move(object,where)
      put=(-1)-pval
      return
      end
 
      subroutine carry(object,where)
c  start toting an object, removing it from the list of things at its former
c  location.  incr holdng unless it was already being toted.  if object>100
c  (moving "fixed" second loc), don't change place or holdng.
      implicit integer*2 (a-z)
      common /placom/ atloc,link,place,fixed,holdng
      dimension atloc(150),link(200),place( 100),fixed(100)
      if(object.gt.100)goto 5
      if(place(object).eq.-1)return
      place(object)=-1
      holdng=holdng+1
 5    if(atloc(where).ne.object)goto 6
      atloc(where)=link(object)
      return
 6    temp=atloc(where)
 7    if(link(temp).eq.object)goto 8
      temp=link(temp)
      goto 7
 8    link(temp)=link(object)
      return
      end
 
      subroutine drop(object,where)
c  place an object at a given loc, prefixing it onto the atloc list.  decr
c  holdng if the object was being toted.
      implicit integer*2 (a-z)
      common /placom/ atloc,link,place,fixed,holdng
      dimension atloc(150),link(200),place( 100),fixed(100)
      if(object.gt.100)goto 1
      if(place(object).eq.-1)holdng=holdng-1
      place(object)=where
      goto 2
 1    fixed(object-100)=where
 2    if(where.le.0)return
      link(object)=atloc(where)
      atloc(where)=object
      return
      end
 
c  utility routines (shift, ran, datime, bug)
      integer*2 function shift (val, dist)
c return val shifted (left if dist>0, else right) dist bits
      implicit integer*2 (a-z)
      shift=val
      if (dist.eq.0) go to 20
      idist=iabs(dist)
      do 1  i = 1,idist
      if (dist.lt.0) shift=shift/2
1     if (dist.gt.0) shift=shift*2
20    return
      end
      subroutine bug(num)
      implicit integer*2 (a-z)
 
c  the following conditions are currently considered fatal bugs.  numbers < 20
c  are detected while reading the database; the others occur at "run time".
c  0      message line > 72 characters                     
c  1      null line in message                             * Only ones
c  2      too many words of messages                         currently
c  3      too many travel options                            implemented
c  4      too many vocabulary words
c  5    * required vocabulary word not found
c  6      too many rtext messages
c  7      too many hints
c  8      location has cond bit being set twice
c  9      invalid section number in database
c  20   * special travel (500>l>300) exceeds goto list
c  21   * ran off end of vocabulary table
c  22   * vocabulary type (n/1000) not between 0 and 3
c  23   * intransitive action verb exceeds goto list
c  24     transitive action verb exceeds goto list
c  25   * conditional travel entry with no alternative
c  26   * location has no travel entries
c  27   * hint number exceeds goto list
c  28     invalid month returned by date function
 
      write (*,1) num
 1    format (' Fatal error, see source code for interpretation.'/
     . ' Probable cause:  erroneous info in database.'/
     2 ' Error code =',i2/)
      pause 'To Exit From Adventure'
      end
 
      subroutine getin (word1,word1x,word2,word2x)
c  get a command from the adventurer.  snarf out the first word, pad it
c  with blanks, and return in word1--word1x used for overflow charcters
c  5-8 in case we need to print the whole word back out in an error.
c  any number of blanks may follow the word.  if a second word appears
c  it is returned in word2/word2x, else word2 is set to zero.  all are
c  converted to lower case for comparison ease (ibm pc version).
      implicit integer*2 (a-z)
      common /blkcom/ blklin
      character*1 s(20), t(20)
      character*4 word1, word1x, word2, word2x, w1(5), w2(5), a(5)
      character*20 w81, w82, aa, bb
      integer*4 iw1, iw1x, iw2, iw2x
      equivalence (w1(1),iw1),(w1(2),iw1x),(a,aa)
      equivalence (w2(1),iw2),(w2(2),iw2x),(w81,w1),(w82,w2)
      if (blklin.eq.1) write (*,1)
1     format (1x)
c  give a prompt to make him think we want input
      write (*,9)
9     format ('   -> ',\)
c
c  read twenty characters into a.  unpack them into s.
      read (*,3) a
3     format (5a4)
      bb = aa
      call unpack (bb, s)
c  translate all to lower case
      do 1001 i=1,20
      if (ichar(s(i)).lt.65.or.ichar(s(i)).gt.90) go to 1001
      s(i)=char(ichar(s(i))+32)
1001  continue
c  go through the characters and transfer the first word into t, up
c  to eight characters
      do 10 i=1,20
10    t(i)=' '
      do 11 i=1,8
      if (s(i).eq.' ') go to 20
11    t(i)=s(i)
c  now repack the characters into w81, equivalent to word1,word1x
20    call pack (w81,t)
      word1=w1(1)
      word1x=w1(2)
c  now find a second word if one exists--clear return words first
      iw2=0
      iw2x=0
      do 30 i=1,20
30    t(i)=' '
      do 31 i=1,20
      if (s(i).ne.' ') go to 31
      go to 32
31    continue
c  all characters--fooey
      go to 40
c  hit first blank after first word--now get first non-blank
32    do 33 j=i,20
      if (s(j).eq.' ') go to 33
      go to 34
33    continue
c  blanked out again
      go to 40
c  hit beginning of second word--finish it
34    do 35 i=j,20
      if (s(i).eq.' ') go to 36
35    t(i-j+1)=s(i)
c  now repack word2/2x
36    call pack (w82,t)
40    word2=w2(1)
      word2x=w2(2)
      return
      end
c
      subroutine unpack (b, s)
      implicit integer*2 (a-z)
c   unpack general subroutine
c  b  20 character string
c  s  20 character*1 singles
      character*20 a,b
      character*4 aa(5)
      integer*4 ia(5)
      equivalence (ia,a,aa)
      character*1 s(20)
      a = b
      do 1 k = 1,5
      do 1 j = 1,4
      s(4*(k-1)+j)=aa(k)
1     if(j.ne.4)ia(k)=ia(k)/256
      return
      end
c
      subroutine pack (b, t)
      implicit integer*2 (a-z)
c   general pack subroutine--20 characters
c   b  return packed word--20
c   t  array to pack of char*1's
      character*20 a,b
      integer*4 ia(5)
      equivalence (ia,a)
      character*1 s(20),t(20)
      do 95 i = 1,20
95      s(i)=t(i)
      do 1 k = 1,5
      ia(6-k)=0
      do 1 j = 1, 4
      l=4*(5-k)+5-j
      ia(6-k) = ia(6-k) + ichar (s(l))
1     if (j.ne.4) ia(6-k) = ia(6-k) * 256
      b=a
      return
      end
c
      integer*2 function toting(obj)
      implicit integer*2 (a-z)
      common /placom/ atloc,link,place,fixed,holdng
      dimension atloc(150),link(200),place( 100),fixed(100)
      toting=0
      if (place(obj).eq.-1) toting=1
      return
      end
c
      integer*2 function here(obj)
      implicit integer*2 (a-z)
      common /placom/ atloc,link,place,fixed,holdng
      common /loccom/ loc
      dimension atloc(150),link(200),place( 100),fixed(100)
      here=0
      if (place(obj).eq.loc.or.toting(obj).eq.1) here=1
      return
      end
c
      integer*2 function at(obj)
      implicit integer*2 (a-z)
      common /placom/ atloc,link,place,fixed,holdng
      common /loccom/ loc
      dimension atloc(150),link(200),place( 100),fixed(100)
      at=0
      if (place(obj).eq.loc.or.fixed(obj).eq.loc) at=1
      return
      end
c
      integer*2 function forced(loc)
      implicit integer*2 (a-z)
      common /concom/ cond
      dimension cond (150)
      forced=0
      if (cond(loc).eq.2) forced=1
      return
      end
c
      integer*2 function dark(dummy)
      implicit integer*2 (a-z)
      common /concom/ cond
      common /loccom/ loc
      common /procom/ prop, lamp
      dimension cond(150),prop(100)
      external here
      dark=0
      if (mod(cond(loc),2).eq.0 .and. (prop(lamp).eq.0 .or.
     .  here(lamp).eq.0)) dark=1
      return
      end
c
      integer*2 function pct(n)
      implicit integer*2 (a-z)
      external ran
      pct=0
      if (ran(100).lt.n) pct=1
      return
      end

      subroutine datime (daye,t)
c   d is date as number of days (more or less) after jan 1 77
c   t is time as number of minutes past midnight
      implicit integer*4 (a-z)
      call getdat(year,month,day)
      call gettim(hour,minute,second,hndrth)
      t=minute+60*hour
      daye=(year-77)*365+((month-1)*30)+day
      return
      end

      integer*2 function ran(range)

c  since the ran function in lib40 seems to be a real lose, we'll use one of
c  our own.  it's been run through many of the tests in knuth vol. 2 and
c  seems to be quite reliable.  ran returns a value uniformly selected
c  between 0 and range-1.  note resemblance to alg used in wizard.
 
      implicit integer*4 (a-z)
      integer*2 range
      data r/-1/
      d=1
      if(r.ne.-1)goto 1
      call datime(d,t)
      r=18*t+5
      d=1000+mod(d,1000)
 1    do 2 t=1,d
 2    r=mod(r*1021,1048576)
      rn=(range*r)/1048576
      ran=rn
      return
      end

c  ======= end =======
