      program advent
c
c For x86_64, pgf77/ifort/gfortran, S. O. Lidie, 2015.04.01
c           Tested On Mac OS X Yosemite and CentOS 6.x.
c
c Update for NOS/VE 1.4.x, 89/11/03.  SOL, LUCC.
c
c Convert to NOS/VE: use direct access reads instead of word addressable
c NOS CRM files.    S. O. Lidie,  87/05/01,  LUCC.  NOS/VE 1.2.2 L678
c
c Program last updated from SCOPE 3.4 to NOS 1.3 by
c Bill Hein and Shelley Hobson (ACCA).
c
c Modified by Kent Blackett
c           Engineering Systems Group
c           Digital Equipment Corp.
c           15-JUL-77
c Modified by Bob Supnik
c             Disk Engineering
c             21-OCT-77
c Original version was for DECsystem-10
c Next version was for FORTRAN IV-Plus under
c the IAS operating system on the PDP-11/70
c This version is for FORTRAN IV (V01C or later)
c under RT-11 on *any* PDP-11.*
c
c
c  Current limits:
c     750 travel options (travel, trvsiz).
c     300 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     211 random messages (rtext, rtxsiz).
c      12 different player classifications (ctext, cval, clsmax).
c      20 hints, less 3 (hintlc, hinted, hints, hntsiz).
c      35 magic messages (mtext, magsiz).
c  There are also limits which cannot be exceeded due to the structure o
c  the database.  (e.g., the vocabulary uses n/1000 to determine word ty
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
      implicit integer (a-z)
      logical blklin,noinpt
*      logical wizsw
      logical lmwarn,closng,panic,hinted,
     1       closed,gaveup,scorng,dseen
c
      common /txtcom/ rtext,lines,ascvar
      common /blkcom/ blklin,noinpt
      common/alphas/blank,eofm
      common /voccom/ ktab,atab ,tabsiz
      common /placom/ atloc,link,place,fixed,holdng
      common /mtxcom/ mtext
      common /ptxcom/ ptext
      common /abbcom/ abb
      common /miscom/ linuse,trvs,clsses,oldloc,loc,cval,tk,newloc,
     1key,plac,fixd,actspk,cond,hints,hntmax,prop,tally,tally2,
     2 hintlc,chloc,chloc2,dseen,dflag,dloc,daltlc,keys,lamp,grate,
     3 cage,rod,rod2,steps,bird,door,pillow,snake,fissur,tablet,
     4 clam,oyster,magzin,dwarf,knife,food,bottle,water,oil,plant,
     5 plant2,axe,mirror,dragon,chasm,troll,troll2,bear,messag,vend,
     6 batter,nugget,coins,chest,eggs,tridnt,vase,emrald,pyram,
     7 pearl,rug,chain,back,look,cave,null,entrnc,dprssn,say,lock,
     8 throw,find,invent,turns,lmwarn,knfloc,detail,abbnum,
     9 numdie,maxdie,dkill,foobar,bonus,clock1,clock2,
     1closng,panic,closed,gaveup,scorng,odloc,stream,orb
      common /misc2/ i,rtxsiz,clsmax,magsiz,locsiz,ctext,stext,ltext,
     1sect,travel,trvcon,trvloc,trvsiz,tabndx,obj,j,k,verb,hntsiz,
     2 maxtrs,hinted,hntloc,kk
*      common /tiktok/ t(4), wizsw
c
      dimension lines(18)
      dimension travel(800),trvcon(800),trvloc(800)
      dimension ktab(300),atab(300)
      dimension ltext(150),stext(150),key(150),cond(150),abb(150),
     1       atloc(150)
      dimension plac(100),place(100),fixd(100),fixed(100),link(200),
     1       ptext(100),prop(100)
      dimension actspk(35)
      dimension rtext(212)
      dimension ctext(12),cval(12)
      dimension hintlc(20),hinted(20),hints(20,4)
      dimension mtext(35)
      dimension tk(20),dseen(6),dloc(6),odloc(6)
c
*      data t/"06:00:00", "11:30:00", "13:30:00", "15:30:00"/
      data blank/8h         /,eofm/3h>$</
c
      call init
      call main
      call exitadv
      end

*      subroutine timer
*      implicit integer (a-z)
*      common /tiktok/ t(4), wizsw
*      logical wizsw
*      character * 8, time, when
*
*      print 100
*  100 format(' Welcome. Perchance, are you a Wizard?')
*101   read (5, 105,end=10000) frst
*  105 format(bz,a2)
*10000 continue
*      print *, "eof at 10000"
*c      if(eof(5))101,102,101
*102   if ((frst.ne.2hYE) .and. (frst.ne.2hye)) go to 30
*      print 110
*  110 format(' Excuse my scepticism, but... PROVE it!')
*111   read (5, 115,end=10001) word
*  115 format(bz,a8)
*10001 continue
*      print *, "eof at 10001"
*c      if(eof(5)) 111,112,111
*112   if (word .ne. 8hWORMTONG) go to 40
*      wizsw = .true.
*      print 120
*  120 format(' Welcome, Wizard! The clock is off.')
*      return
*   40 print 125
*  125 format(' Bah! You are a fraud and charlatan!')
*   30 wizsw = .false.
*      when = time()
*      read ( when, 5 ) now
*    5 format(a8)
*      if(now.ge.t(1).and.now.lt.t(2))goto 20
*      if(now.ge.t(3).and.now.lt.t(4)) goto 20
*      return
*   20 print 10, t
*   10 format(' Due to excessive environmental impact, the E.P.A.',/
*     +' has stated that middle earth may not be entered during the',/
*     +' following hours :',//,1x,a9,' to ',a9,/,1x,a9,' to ',a9)
*      stop
*      end



c  data structure routines (vocab, dstroy, juggle, move, lput, carry, dr
c
c
      subroutine vocab(id1,init,v)
c
c  look up id1 in the vocabulary (atab )
c  and return its "definition" (ktab), or
c  -1 if not found.  if init is positive, this is an init call setting
c  up a keyword variable, and not finding it constitutes a bug.  it also
c  that only ktab values which taken over 1000 equal init may be conside
c  (thus "steps", which is a motion verb as well as an object, may be lo
c  as an object.)  and it also means the ktab value is taken mod 1000.
c
      implicit integer (a-z)
      common /voccom/ ktab,atab,tabsiz
      dimension ktab(300),atab(300)
c
      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.id1)goto 3
1     continue
      call bug(21)
c
2     v=-1
      if(init.lt.0)return
      print 100,id1
  100 format(' Keyword = ',a4)
      call bug(5)
c
3     v=ktab(i)
      if(init.ge.0)v=mod(v,1000)
      return
      end
c
c
c
      subroutine dstroy(object)
c
c  permanently eliminate "object" by moving to a non-existent location.
c
      implicit integer (a-z)
c
      call move(object,0)
      return
      end
c
c
c
      subroutine juggle(object)
c
c  juggle an object by picking it up and putting it down again, the purp
c  being to get the object to the front of the chain of things at its lo
c
      implicit integer (a-z)
      common /placom/ atloc,link,place,fixed,holdng
      dimension atloc(150),link(200),place(100),fixed(100)
c
      i=place(object)
      j=fixed(object)
      call move(object,i)
      call move(object+100,j)
      return
      end
c
c
c
      subroutine move(object,where)
c
c  place any object anywhere by picking it up and dropping it.  may alre
c  toting, in which case the carry is a no-op.  mustn't pick up objects
c  are not at any loc, since carry wants to remove objects from atloc ch
c
      implicit integer (a-z)
      common /placom/ atloc,link,place,fixed,holdng
      dimension atloc(150),link(200),place(100),fixed(100)
c
      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
c
c
c
      integer function lput(object,where,pval)
c
c  lput is the same as move, except it returns a value used to set up th
c  negated prop values for the repository objects.
c
      implicit integer (a-z)
c
      call move(object,where)
      lput=(-1)-pval
      return
      end
c
c
c
      subroutine carry(object,where)
c
c  start toting an object, removing it from the list of things at its fo
c  location.  incr holdng unless it was already being toted.  if object>
c  (moving "fixed" second loc), don't change place or holdng.
c
      implicit integer (a-z)
      common /placom/ atloc,link,place,fixed,holdng
      dimension atloc(150),link(200),place(100),fixed(100)
c
      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
c
c
c
      subroutine drop(object,where)
c
c  place an object at a given loc, prefixing it onto the atloc list.  de
c  holdng if the object was being toted.
c
      implicit integer (a-z)
      common /placom/ atloc,link,place,fixed,holdng
      dimension atloc(150)
      dimension link(200)
      dimension place(100)
      dimension fixed(100)
c
      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



       INTEGER FUNCTION RND(X)
       INTEGER X

C Return random integer 0 .. X                                                                                                                 
#if (! defined __GFORTRAN__)                                                                                                                  
       integer r
       r = irandm( 0 )
       rnd = mod(r, x )
#else
       real r
       r = rand( 0 )
       rnd =  int( r * x )
#endif
       END



c
c
c
c
      subroutine bug(num)
      implicit integer (a-z)
c
c  the following conditions are currently considered fatal bugs.  number
c  are detected while reading the database; the others occur at "run tim
c     0       message line > 70 characters
c     1       null line in message
c     2       too many words of messages
c     3       too many travel options
c     4       too many vocabulary words
c     5       required vocabulary word not found
c     6       too many rtext or mtext 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  print (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
c     29    input in 1 word exceeds 10 chars.
c
       print 1, num
1     format (' Fatal error ',i3,', consult your local Wizard.'/)
      call exit
      end
c  i/o routines (speak, pspeak, rspeak, getin, yes)
c
c
      subroutine speak(n)
c
c  print the message in record n of the random access message file.
c  precede it with a blank line unless blklin is false.
c
      implicit integer (a-z)
      logical blklin,noinpt
      common /txtcom/ rtext,lines,ascvar
      common /blkcom/ blklin,noinpt
      common /alphas/ blank,eofm
      dimension rtext(212),lines(18)
c
      if(n.eq.0)return
      read (2, '(i4, 18a4)', rec=n) loc, lines
      if(lines(1).eq.eofm)return
      if(blklin.and.noinpt) print 2
      noinpt=.true.
      n1=n+1
1     oldloc = loc
      do 3 ii=1,18
      i=19-ii
      l = i
      if(lines(i) .ne. blank) go to 5
3     continue
5      print 2,(lines(i),i=1,l)
2     format(18a4)
      read( 2, '(i4, 18a4)', rec=n1) loc, lines
      n1=n1+1
      if(loc .eq. oldloc) go to 1
      return
      end
c
c
c
      subroutine pspeak(msg,skip)
c
c  find the skip+1st message for object msg and print it.
c  msg should be the index of
c  the object.  (inven+n+1 message is prop=n message).
c
      implicit integer (a-z)
      common /txtcom/ rtext,lines,ascvar
      common /ptxcom/ ptext
      dimension rtext(212),lines(18),ptext(100)
c
      m=ptext(msg)
      if(skip.lt.0)goto 9
      skip1=skip+1
      oldloc=msg
      do 3 i=1,skip1
    1 read( 2, '(i4,18a4)', rec=m) loc, lines
      m=m+1
      if(loc.eq.oldloc) go to 1
      oldloc=loc
3     continue
      m=m-1
9     call speak(m)
      return
      end
c
c
c
      subroutine rspeak(i)
c
c  print the i-th "random" message (section 6 of database).
c
      implicit integer (a-z)
      common /txtcom/ rtext
      dimension rtext(212)
c
      if(i.ne.0)call speak(rtext(i))
      return
      end
c
c
c
c
      subroutine mspeak(i)
c
c  print the i-th "magic" message from section 12 of database
c
      implicit integer (a-z)
      common /mtxcom/ mtext
      dimension mtext (35)
c
      if(i.ne.0) call speak(mtext(i))
      return
      end
c
c




      subroutine getin( word1, word2, wordfull )
c
c  Get a command from the adventurer.  Snarf out at most two words and ensure
c  they are upper case and at most 4 characters in length for the vocabulary
c  comparisons. WORDFULL, all lower case, is they entire spelling of either
c  the first word if there is no second word, else the second word ... for
c  human messages.
c
      implicit integer (a-z)
      logical blklin,noinpt
      common /blkcom/ blklin,noinpt
      character*81 in
      character*81 in0
      character*81 w1
      character*81 w2
      character*20 wordfull

 100  continue
      noinpt = .false.
      if( blklin ) print 1

      in = ""
      w1 = ""
      w2 = ""
      wordfull = ""
      inc = 1
      w1c = 1
      w2c = 1
      word1 = 0
      word2 = 0

      write( 6, '(A$)' ) "Adventure>"
      read ( 5, 2, end=600 ) in0

* upper case input
      do i = 1, len(in0)
#if (! defined __GFORTRAN__)
          j = ichar(in0(i:i))
          if (j>= ichar("a") .and. j<=ichar("z") ) then
             in(i:i) = char(ichar(in0(i:i))-32)
          else
               in(i:i) = in0(i:i)
          end if
#else
          j = iachar(in0(i:i))
          if (j>= iachar("a") .and. j<=iachar("z") ) then
             in(i:i) = achar(iachar(in0(i:i))-32)
          else
               in(i:i) = in0(i:i)
          end if
#endif
      end do

* skip leading spaces
      do 201 c = inc, 81
         if( in(c:c) .ne. " " ) goto 202
         inc = inc + 1
 201  continue
 202  continue

* collect non-space characters in w1
      do 301 c = inc, 81
         if( in(c:c) .eq. " " ) goto 302
         w1(w1c:w1c) = in(c:c)
         w1c = w1c + 1
         inc = inc + 1
 301  continue
 302  continue

* skip leading spaces
      do 401 c = inc, 81
         if( in(c:c) .ne. " " ) goto 402
         inc = inc +1
 401  continue
 402  continue

* collect non-space characters in w2
      do 501 c = inc, 81
         if( in(c:c) .eq. " " ) goto 502
         w2(w2c:w2c) = in(c:c)
         w2c = w2c + 1
         inc = inc + 1
 501  continue
 502  continue

      if ( w1 .ne. "" ) then
         read( w1, 3 ) word1
         wordfull = w1
      endif
      
      if ( w2 .ne. "" ) then
         read( w2, 3 ) word2
         wordfull = w2
      endif

* lower case wordfull
      do i = 1, len(wordfull)
#if (! defined __GFORTRAN__)
          j = ichar(wordfull(i:i))
          if (j>= ichar("A") .and. j<=ichar("Z") ) then
             wordfull(i:i) = char(ichar(wordfull(i:i))+32)
          else
             wordfull(i:i) = wordfull(i:i)
          end if
#else
          j = iachar(wordfull(i:i))
          if (j>= iachar("A") .and. j<=iachar("Z") ) then
             wordfull(i:i) = achar(iachar(wordfull(i:i))+32)
          else
             wordfull(i:i) = wordfull(i:i)
          end if
#endif
      end do

      return
 
 600  continue
      close(unit=5)
      open(unit=5, file='/dev/tty')
      goto 100

 1    format( 1x )
 2    format( a81 )
 3    format( a4 )
      
      end

c
      logical function yes(x,y,z)
c
c  call yesx (below) with messages from section 6.
c
      implicit integer (a-z)
      external rspeak
      logical yesx
c
      yes=yesx(x,y,z,rspeak)
      return
      end
c
c
c
      logical function yesm(x,y,z)
c
c  call yesx (below) with messages from section 12.
c
      implicit integer (a-z)
      external mspeak
      logical yesx
c
      yesm=yesx(x,y,z,mspeak)
      return
      end
c
c
c
      logical function yesx(x,y,z,spk)
c
c  print message x, wait for yes/no answer.  if yes, print y and leave y
c  true; if no, print z and leave yea false.  spk is either rspeak or ms
c
      implicit integer (a-z)
      character*1 reply
      common /alphas/ blank,eofm
c
1     if(x.ne.0)call spk(x)
      read (5,3,end=8) reply
    3 format(bz,a1)
10000 continue
c      if(eof(5)) 8,7,8
    7 if ((reply.eq."Y") .or. (reply.eq."y")) goto 10
      if ((reply.eq."N") .or. (reply.eq."n")) goto 20
    8 print 9
9     format(/'Please answer the question.')
      close(unit=5)
      open(unit=5, file='/dev/tty')
      goto 1
10    yesx=.true.
      if(y.ne.0)call spk(y)
      return
20    yesx=.false.
      if(z.ne.0)call spk(z)
      return
      end




      subroutine exitadv
      call exit
      end




      integer function ishft (var,count)
      implicit integer (a-z)
      ivar = var
      icount = count
c
c
c this beast replaces adv004.for
c result = ishft(variable,count)
c on shifts to the right the sign bit is zeroed
c
c
c if count=0, no shift occurs
c if count>0, a left shift occurs
c if count<0, a right shift occurs
c
c
      ivar= and( ivar, '177777'O )
      ishft=ivar
      if (icount.eq.0) return
      if (icount.lt.0) go to 1
#if defined(__INTEL_COMPILER) || defined(__GFORTRAN__)
      ishft=ISHFTC(ivar,icount)
#elif defined (__PGI_COMPILER)
      ishft=shift(ivar,icount)
#else
#error FORTRAN Compiler not defined
#endif
      return
c shift right one bit and clear sign bit
*      print *,"this shift is WRONG"
c orig    1 tshft=shift(ivar,-1).and.z"8fffffffffffffff"
#if defined(__INTEL_COMPILER) || defined(__GFORTRAN__)
    1 tshft= and( ISHFTC(ivar,-1), '8fffffff'x )
      ishft=ISHFTC(tshft,-(icount-1))
#elif defined (__PGI_COMPILER)
    1 tshft=shift(ivar,-1).and.'8fffffff'x
      ishft=shift(tshft,-(icount-1))
#else
#error FORTRAN Compiler not defined
#endif
      return
      end




      subroutine init
c
      implicit integer (a-z)
      logical blklin,noinpt
      logical forced, pct
      logical dseen,hinted
      logical bitset,lmwarn,closng,panic,
     1        closed,gaveup,scorng
c
      common /txtcom/ rtext,lines,ascvar
      common /blkcom/ blklin,noinpt
      common /voccom/ ktab,atab ,tabsiz
      common /placom/ atloc,link,place,fixed,holdng
      common /mtxcom/ mtext
      common /ptxcom/ ptext
      common /abbcom/ abb
      common /miscom/ linuse,trvs,clsses,oldloc,loc,cval,tk,newloc,
     1 key,plac,fixd,actspk,cond,hints,hntmax,prop,tally,tally2,
     2 hintlc,chloc,chloc2,dseen,dflag,dloc,daltlc,keys,lamp,grate,
     3 cage,rod,rod2,steps,bird,door,pillow,snake,fissur,tablet,
     4 clam,oyster,magzin,dwarf,knife,food,bottle,water,oil,plant,
     5 plant2,axe,mirror,dragon,chasm,troll,troll2,bear,messag,vend,
     6 batter,nugget,coins,chest,eggs,tridnt,vase,emrald,pyram,
     7 pearl,rug,chain,back,look,cave,null,entrnc,dprssn,say,lock,
     8 throw,find,invent,turns,lmwarn,knfloc,detail,abbnum,
     9 numdie,maxdie,dkill,foobar,bonus,clock1,clock2,
     1 closng,panic,closed,gaveup,scorng,odloc,stream,orb
      common /misc2/ i,rtxsiz,clsmax,magsiz,locsiz,ctext,stext,ltext,
     1 sect,travel,trvcon,trvloc,trvsiz,tabndx,obj,j,k,verb,hntsiz,
     2 maxtrs,hinted,hntloc,kk
c
      dimension lines(18)
      dimension travel(800),trvcon(800),trvloc(800)
      dimension ktab(300),atab(300)
      dimension ltext(150),stext(150),key(150),cond(150),abb(150),
     1        atloc(150)
      dimension plac(100),place(100),fixd(100),fixed(100),link(200),
     1        ptext(100),prop(100)
      dimension actspk(35)
      dimension rtext(212)
      dimension ctext(12),cval(12)
      dimension hintlc(20),hinted(20),hints(20,4)
      dimension mtext(35)
      dimension tk(20),dseen(6),dloc(6),odloc(6)

c ENV variable BUILD_Adventure determines when to rebuild the database:
c 0 = use existing
c 1 = build a new version
        character*80 envvalue
c
c
*      bitset(l,n)=(cond(l).and.ishft(1,n)).ne.0
      bitset(l,n)= ( and( cond(l), ishft(1,n) ) ) .ne.0
c  description of the database format
c
c
c  the data file contains several sections.  each begins with a line con
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 num
c     a comma, and a line of text.  the set of (necessarily adjacent) li
c     whose numbers are x form the long description of location x.
c  section 2: short form descriptions.  same format as long form.  not a
c     places have short descriptions.
c  section 3: travel table.  each line contains a location number (x), a
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     if the condition (if any) is not met, then the next *different*
c     "destination" value is used (unless it fails to meet *its* conditi
c     in which case the next is found, etc.).  typically, the next dest
c     be for one of the same verbs, so that its only use is as the alter
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, etc., will t
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 wh
c     case he goes to 9.  verb 50 takes him to 9 regardless of prop(3).
c
c     in this implementation, the second location number y has been
c     split into m, conditions, and n, location.
c
c  section 4: vocabulary.  each line contains a number (n), a tab, and a
c     five-letter word.  call m=n/1000.  if m=0, then the word is a moti
c     verb for use in travelling (see section 3).  else, if m=1, the wor
c     an object.  else, if m=2, the word is an action verb (such as "car
c     or "attack").  else, if m=3, the word is a special case verb (such
c     "dig") and n mod 1000 is an index into section 6.  objects from 50
c     (currently, anyway) 79 are considered treasures (for pirate, close
c  section 5: object descriptions.  each line contains a number (n), a t
c     and a message.  if n is from 1 to 100, the message is the "invento
c     message for object n.  otherwise, n should be 000, 100, 200, etc.,
c     the message should be the description of the preceding object when
c     prop value is n/100.  the n/100 is used only to distinguish multip
c     messages from multi-line messages; the prop info actually requires
c     messages for an object to be present and consecutive.  properties
c     produce no message should be given the message ">$<".
c  section 6: arbitrary messages.  same format as sections 1, 2, and 5,
c     the numbers bear no relation to anything (except for special verbs
c     in section 4).
c  section 7: object locations.  each line contains an object number and
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 loca
c     (e.g. the grate) the first location is followed with the second, a
c     the object is assumed to be immovable.
c  section 8: action defaults.  each line contains an "action-verb" numb
c     the index (in section 6) of the default message for the verb.
c  section 9: liquid assets, etc.  each line contains a number (n) and u
c     location numbers.  bit n (where 0 is the units bit) is set in cond
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" routin
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 force
c     motion.
c  section 10: class messages.  each line contains a number (n), a tab,
c     message describing a classification of player.  the scoring sectio
c     selects the appropriate message, where each message is considered
c     apply to players whose scores are higher than the previous n but n
c     higher than this n.  note that these scores probably change with e
c     modification (and particularly expansion) of the program.
c  section 11: hints.  each line contains a hint number (corresponding t
c     cond bit, see section 9), the number of turns he must be at the ri
c     loc(s) before triggering the hint, the points deducted for taking
c     hint, the message number (section 6) of the question, and the mess
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 l
c     points).
c  section 12: magic messages. identical to section 6 except put in a se
c     section for easier reference.  magic messages are used by the star
c     maintenance mode, and related routines.
c  section 0: end of database.
c  read the database if we have not yet done so
c      open (unit=5, file='INPUT')
c      open (unit=6, file='OUTPUT')
*      call timer

      open(unit=5, file='/dev/tty')

c Initialize random number generator.
#if (! defined __GFORTRAN__ )
      ijkl = irandm( time() )
#else
      call srand( time() )
#endif

c
      filsiz=2100
      tabsiz=300
      locsiz=150
      vrbsiz=35
      blklin=.true.
      noinpt=.true.
      rtxsiz = 211
      hntsiz = 20
      magsiz = 35
      trvsiz = 800
      clsmax = 12
      vcount = 0


c Check Build_Adventure environment variable and convert to an integer, must be 0 or 1.
      call getenv( "BUILD_Adventure", envvalue)
      read(envvalue, 71) i
 71   format(i1)
      i = i + 1
      if ( i .eq. 1 ) then
         open (unit=2, file='Adventure.text.db', access='DIRECT',
     +        recl=76, form='FORMATTED')
         open (unit=3, file='Adventure.save', form='unformatted',
     + status='old')
         call restoregm
         return
      endif

* Create initial text database and save state files.

      print 123
 123  format("Creating new 'Adventure.text.db'")

      open (unit=1, file='src/Adventure.text', status='OLD')
      open (unit=2, file='etc/Adventure.text.db', access='DIRECT',
     +     recl=76,form='FORMATTED', status='new')
      open (unit=3, file='etc/Adventure.save.init', form='unformatted')

      print 1000
 1000 format('Wait a minute... I can''t find the keys...')
*      endfile 6
c
c  clear out the various text-pointer arrays.  all text is stored in dis
c  file (random access on unit 2).  the text-pointer arrays contain reco
c  numbers in the file.  stext(n) is short description of location n.
c  ltext(n) is long description.  ptext(n) points to message for prop(n)
c  successive prop messages are found by chasing pointers.  rtext contai
c  section 6's stuff.  ctext(n) points to a player-class message.  mtext
c  section 12.  we also clear cond.  see description of section 9 for de
c
      do 1001 i=1,tabsiz
      ktab(i)=0
      atab(i)=0
      if(i.gt.100) go to 1990
      ptext(i)=0
      prop(i)=0
      plac(i)=0
      place(i)=0
      fixd(i)=0
      fixed(i)=0
      link(i)=0
      link(i+100)=0
1990  if(i.le.rtxsiz)rtext(i)=0
      if(i.le.clsmax)ctext(i)=0
      if(i.le.magsiz)mtext(i)=0
      if(i.le.vrbsiz)actspk(i)=0
      if(i.gt.locsiz)goto 1001
      key(i)=0
      abb(i)=0
      atloc(i)=0
      stext(i)=0
      ltext(i)=0
      cond(i)=0
1001  continue
c
      wrdsum=1
      ascvar=1
      wasiz=19
      wasiz10=370
      linuse=1 - 1
      trvs=1
      clsses=1
c
c  start new data section.  sect is the section number.
c
1002  read(1,1003,end=10000)sect
1003  format(bz,i5)
c      print 930,sect
c930   format(' now loading section',i3)
10000 oldloc=-1
      if(sect+1.le.0 .or. sect+1.gt.13) call bug(9)
      print 125, sect
 125  format("Initializing section #",i4)
      goto(1100,1004,1004,1030,1040,1004,1004,1050,1060,1070,1004,
     1     1080,1004) (sect+1)
      call gotoer
c           (0)  (1)  (2)  (3)  (4)  (5)  (6)  (7)  (8)  (9)  (10)
c          (11) (12)
c
c  sections 1, 2, 5, 6, 10, 12.  read messages and set up pointers.
c
1004  read(1,1005,end=10001) loc, lines
1005  format(bz,i4,18a4)
10001 continue
      write (2, '(i4, 18a4)', rec=linuse+1) loc, lines
      linuse = linuse + 1
      if(loc .eq. -1) go to 1002
      if(loc .eq. oldloc) go to 1020
      if(sect.eq.12)goto 1013
      if(sect.eq.10)goto 1012
      if(sect.eq.6)goto 1011
      if(sect.eq.5)goto 1010
      if(sect.eq.1)goto 1008
c
      stext(loc)=linuse
      goto 1020
c
1008  ltext(loc)=linuse
      goto 1020
c
1010  if(loc.gt.0.and.loc.le.100)ptext(loc)=linuse
      goto 1020
c
1011  if(loc .gt. rtxsiz) call bug(6)
      rtext(loc)=linuse
      goto 1020
c
1012  ctext(clsses)=linuse
      cval(clsses)=loc
      clsses=clsses+1
      goto 1020
c
1013  continue
      if(loc.gt.magsiz)call bug(6)
      mtext(loc)=linuse
c
1020  oldloc = loc
      if(linuse .ge. filsiz) call bug(2)
      goto 1004
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  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 tra
c  of the first option at location n.
c
c  special conditions on travel are encoded in the corresponding
c  entries of trvcon.  the new location is in trvloc.
c
c
1030  read(1,1031,end=10002)loc,j,newloc,tk
1031  format(bz,23i5)
10002 if(loc.eq.-1)goto 1002
      if(key(loc).ne.0)goto 1033
      key(loc)=trvs
      goto 1035
1033  travel(trvs-1)=-travel(trvs-1)
1035  do 1037 l=1,20
      if(tk(l).eq.0)goto 1039
      travel(trvs)=tk(l)
      trvloc(trvs)=newloc
      trvcon(trvs)=j
      trvs=trvs+1
      if(trvs.eq.trvsiz)call bug(3)
1037  continue
1039  travel(trvs-1)=-travel(trvs-1)
      goto 1030
c
c  here we read in the vocabulary.  ktab(n) is the word number, atab(n)
c  the corresponding word.  the -1 at the end of section 4 is left in kt
c  as an end-marker.
c
1040  do 1042 tabndx=1,tabsiz
 1043 read(1,1041,end=10003)ktab(tabndx),atab(tabndx)
 1041 format(bz,i6,a4)
10003 if(ktab(tabndx).eq.-1)goto 1002
1042  continue
      call bug(4)
c
c  read in the initial locations for each object.  also the immovability
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
1050  read(1,1031,end=10004)obj,j,k
10004 if(obj.eq.-1)goto 1002
      plac(obj)=j
      fixd(obj)=k
      goto 1050
c
c  read default message numbers for action verbs, store in actspk.
c
1060  read(1,1031,end=10005)verb,j
10005 if(verb.eq.-1)goto 1002
      actspk(verb)=j
      vcount=max0(verb,vcount)
      goto 1060
c
c  read info about available liquids and other conditions, store in cond
c
1070  read(1,1031,end=10006)k,tk
10006 if(k.eq.-1)goto 1002
      do 1071 i=1,20
      loc=tk(i)
      if(loc.eq.0)goto 1070
      if(bitset(loc,k))call bug(8)
1071  cond(loc)=cond(loc)+ishft(1,k)
      goto 1070
c
c  read data for hints.
c
1080  hntmax=0
1081  read(1,1031,end=10007)k,tk
10007 if(k.eq.-1)goto 1002
      if(k.lt.0.or.k.gt.hntsiz)call bug(7)
      do 1083 i=1,4
1083  hints(k,i)=tk(i)
      hntmax=max0(hntmax,k)
      goto 1081
c  finish constructing internal data format
c
1100  continue
c
c  having read in the database, certain things are now constructed.  pro
c  set to zero.  we finish setting up cond by checking for forced-motion
c  entries.  the plac and fixd arrays are used to set up atloc(n) as the
c  object at location n, and link(obj) as the next object at the same lo
c  as obj.  (obj>100 indicates that fixed(obj-100)=loc; link(obj) is sti
c  correct link to use.)  abb is zeroed; it controls whether the abbrevi
c  description is printed.  counts mod 5 unless "look" is used.
c
c
c  if the first motion verb is 1 (illegal), then this is a forced
c  motion entry.
c
      do 1102 i=1,locsiz
      if(ltext(i).eq.0.or.key(i).eq.0)goto 1102
      k=key(i)
      if(iabs(travel(k)).eq.1)cond(i)=2
1102  continue
c
c  set up the atloc and link arrays as described above.  we'll use the d
c  subroutine, which prefaces new objects on the lists.  since we want t
c  in the other order, we'll run the loop backwards.  if the object is i
c  locs, we drop it twice.  this also sets up "place" and "fixed" as cop
c  "plac" and "fixd".  also, since two-placed objects are typically best
c  described last, we'll drop them first.
c
      do 1106 i=1,100
      k=101-i
      if(fixd(k).le.0)goto 1106
      call drop(k+100,fixd(k))
      call drop(k,plac(k))
1106  continue
c
      do 1107 i=1,100
      k=101-i
      fixed(k)=fixd(k)
1107  if(plac(k).ne.0.and.fixd(k).le.0)call drop(k,plac(k))
c
c  treasures, as noted earlier, are objects 50 through maxtrs (currently
c  their props are initially -1, and are set to 0 the first time they ar
c  described.  tally keeps track of how many are not yet found, so we kn
c  when to close the cave.  tally2 counts how many can never be found (e
c  lost bird or bridge).
c
      maxtrs=79
      tally=0
      tally2=0
      do 1200 i=50,maxtrs
      if(ptext(i).ne.0)prop(i)=-1
1200  tally=tally-prop(i)
c
c  clear the hint stuff.  hintlc(i) is how long he's been at loc with co
c  i.  hinted(i) is true iff hint i has been used.
c
      do 1300 i=1,hntmax
      hinted(i)=.false.
1300  hintlc(i)=0
c
      print 931,tabndx,tabsiz,vcount,vrbsiz,clsses,clsmax,
     1        hntmax,hntsiz,trvs,trvsiz,linuse,filsiz
 931  format('Used vs max table values:'/
     1        1x,i5,' of ',i5,' vocab entries'/
     2        1x,i5,' of ',i5,' verb entries'/
     3        1x,i5,' of ',i5,' class entries'/
     4        1x,i5,' of ',i5,' hint entries'/
     5        1x,i5,' of ',i5,' travel entries'/
     6        1x,i5,' of ',i5,' file records'
     9        )
c
c  define some handy mnemonics.  these correspond to object numbers.
c
      call vocab("KEYS",1,keys)
      call vocab("LAMP",1,lamp)
      call vocab("GRAT",1,grate)
      call vocab("CAGE",1,cage)
      call vocab("ROD ",1,rod)
      rod2=rod+1
      call vocab("STEP",1,steps)
      call vocab ("BIRD",1,bird)
      call vocab("DOOR",1,door)
      call vocab("PILL",1,pillow)
      call vocab("SNAK",1,snake)
      call vocab("FISS",1,fissur)
      call vocab("TABL",1,tablet)
      call vocab("CLAM",1,clam)
      call vocab ("OYST",1,oyster)
      call vocab("MAGA",1,magzin)
      call vocab("DWAR",1,dwarf)
      call vocab("KNIF",1,knife)
      call vocab("FOOD",1,food)
      call vocab("BOTT",1,bottle)
      call vocab("WATE",1,water)
      call vocab("OIL ",1,oil)
      call vocab("PLAN",1,plant)
      plant2=plant+1
      CALL VOCAB("AXE ",1,AXE)
      CALL VOCAB("MIRR",1,MIRROR)
      CALL VOCAB("DRAG",1,DRAGON)
      CALL VOCAB("CHAS",1,CHASM)
      CALL VOCAB("TROL",1,TROLL)
      TROLL2=TROLL+1
      CALL VOCAB("BEAR",1,BEAR)
      CALL VOCAB("MESS",1,MESSAG)
      CALL VOCAB("VEND",1,VEND)
      CALL VOCAB("BATT",1,BATTER)
C
C  OBJECTS FROM 50 THROUGH WHATEVER ARE TREASURES.  HERE ARE A FEW.
C
      CALL VOCAB("GOLD",1,NUGGET)
      CALL VOCAB("COIN",1,COINS)
      CALL VOCAB("CHES",1,CHEST)
      CALL VOCAB("EGGS",1,EGGS)
      CALL VOCAB("TRID",1,TRIDNT)
      CALL VOCAB("VASE",1,VASE)
      CALL VOCAB("EMER",1,EMRALD)
      CALL VOCAB("PYRA",1,PYRAM)
      CALL VOCAB("PEAR",1,PEARL)
      CALL VOCAB("RUG ",1,RUG)
      CALL VOCAB("CHAI",1,CHAIN)
      CALL VOCAB("ORB ",1,ORB)
C
C  THESE ARE MOTION-VERB NUMBERS.
C
      CALL VOCAB("BACK",0,BACK)
      CALL VOCAB("LOOK",0,LOOK)
      CALL VOCAB("CAVE",0,CAVE)
      CALL VOCAB("NULL",0,NULL)
      CALL VOCAB("ENTR",0,ENTRNC)
      CALL VOCAB("DEPR",0,DPRSSN)
      CALL VOCAB("STRE",0,STREAM)
C
C  AND SOME ACTION VERBS.
C
      CALL VOCAB("SAY ",2,SAY)
      CALL VOCAB("LOCK",2,LOCK)
      CALL VOCAB("THRO",2,THROW)
      CALL VOCAB("FIND",2,FIND)
      CALL VOCAB("INVE",2,INVENT)
c
c  initialise the dwarves.  dloc is loc of dwarves, hard-wired in.  odlo
c  prior loc of each dwarf, initially garbage.  daltlc is alternate init
c  for dwarf, in case one of them starts out on top of the adventurer.
c  of the 5 initial locs are adjacent.)  dseen is true if dwarf has seen
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 re
c  the dead end in the other maze has its loc stored in chloc2.
c
      chloc=114
      chloc2=140
      do 1700 i=1,6
1700  dseen(i)=.false.
      dflag=0
      dloc(1)=19
      dloc(2)=27
      dloc(3)=33
      dloc(4)=44
      dloc(5)=64
      dloc(6)=chloc
      daltlc=18
c
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     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 ms
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
      turns=0
      lmwarn=.false.
      knfloc=0
      detail=0
      abbnum=5
      do 1800 itemp=1,5
      i=itemp-1
      if(rtext(2*i+81).ne.0)maxdie=i+1
 1800 continue
      numdie=0
      holdng=0
      dkill=0
      foobar=0
      bonus=0
      clock1=30
      clock2=50
      closng=.false.
      panic=.false.
      closed=.false.
      gaveup=.false.
      scorng=.false.
c
c
c
c  finally, since we're clearly setting things up for the first time...
c
      print 999
  999 format('OK, I got them...oh, yes....orange smoke...',/
     +'Well, here goes...')

      newloc=1
      loc = newloc
      print 124
 124  format("Creating new 'Adventure.save.init'")
      call savegm( 0 )
      CALL EXIT

      end




      subroutine main
c
      implicit integer (a-z)
      character * 8, time, when
      character*4 holl2char
      character*20 wdfull
      logical blklin,noinpt
*      logical wizsw
      logical forced, pct
      logical dseen,hinted,yes
      logical toting,here,at,bitset,dark,wzdark,lmwarn,closng,panic,
     1        closed,gaveup,scorng,yea
c
      common /txtcom/ rtext,lines,ascvar
      common /blkcom/ blklin,noinpt
      common /alphas/ blank,eofm
      common /voccom/ ktab,atab ,tabsiz
      common /placom/ atloc,link,place,fixed,holdng
      common /mtxcom/ mtext
      common /ptxcom/ ptext
      common /abbcom/ abb
      common /miscom/ linuse,trvs,clsses,oldloc,loc,cval,tk,newloc,
     1 key,plac,fixd,actspk,cond,hints,hntmax,prop,tally,tally2,
     2 hintlc,chloc,chloc2,dseen,dflag,dloc,daltlc,keys,lamp,grate,
     3 cage,rod,rod2,steps,bird,door,pillow,snake,fissur,tablet,
     4 clam,oyster,magzin,dwarf,knife,food,bottle,water,oil,plant,
     5 plant2,axe,mirror,dragon,chasm,troll,troll2,bear,messag,vend,
     6 batter,nugget,coins,chest,eggs,tridnt,vase,emrald,pyram,
     7 pearl,rug,chain,back,look,cave,null,entrnc,dprssn,say,lock,
     8 throw,find,invent,turns,lmwarn,knfloc,detail,abbnum,
     9 numdie,maxdie,dkill,foobar,bonus,clock1,clock2,
     1 closng,panic,closed,gaveup,scorng,odloc,stream,orb
      common /misc2/ i,rtxsiz,clsmax,magsiz,locsiz,ctext,stext,ltext,
     1 sect,travel,trvcon,trvloc,trvsiz,tabndx,obj,j,k,verb,hntsiz,
     2 maxtrs,hinted,hntloc,kk
c
*      common /tiktok/ t(4), wizsw
      dimension lines(18)
      dimension travel(800),trvcon(800),trvloc(800)
      dimension ktab(300),atab(300)
      dimension ltext(150),stext(150),key(150),cond(150),abb(150),
     1        atloc(150)
      dimension plac(100),place(100),fixd(100),fixed(100),link(200),
     1        ptext(100),prop(100)
      dimension actspk(35)
      dimension rtext(212)
      dimension ctext(12),cval(12)
      dimension hintlc(20),hinted(20),hints(20,4)
      dimension mtext(35)
      dimension tk(20),dseen(6),dloc(6),odloc(6)
c
c  statement functions
c
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 from 0 to 100)
c
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" c
c  demo is true if this is a prime-time demonstration game
c  yea is random yes/no reply
c
c
      toting(obj)=place(obj).eq.-1
      here(obj)=place(obj).eq.loc.or.toting(obj)
      at(obj)=place(obj).eq.loc.or.fixed(obj).eq.loc
      liq2(pbotl)=(1-pbotl)*water+(pbotl/2)*(water+oil)
      liq(dummy)=liq2(max0(prop(bottle),-1-prop(bottle)))
      liqloc(loc)=liq2((mod(cond(loc)/2*2,8)-5)*mod(cond(loc)/4,2)+1)
*      bitset(l,n)=(cond(l).and.ishft(1,n)).ne.0
      bitset(l,n)= ( and (cond(l), ishft(1,n) ) ) .ne.0
      forced(loc)=cond(loc).eq.2
      dark(dummy)=mod(cond(loc),2).eq.0.and.(prop(lamp).eq.0.or.
     1        .not.here(lamp))
      pct(n)=rnd(100).lt.n
c  description of the database format
c
c
c  the data file contains several sections.  each begins with a line con
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 num
c     a comma, and a line of text.  the set of (necessarily adjacent) li
c     whose numbers are x form the long description of location x.
c  section 2: short form descriptions.  same format as long form.  not a
c     places have short descriptions.
c  section 3: travel table.  each line contains a location number (x), a
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     if the condition (if any) is not met, then the next *different*
c     "destination" value is used (unless it fails to meet *its* conditi
c     in which case the next is found, etc.).  typically, the next dest
c     be for one of the same verbs, so that its only use is as the alter
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, etc., will t
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 wh
c     case he goes to 9.  verb 50 takes him to 9 regardless of prop(3).
c  section 4: vocabulary.  each line contains a number (n), a tab, and a
c     five-letter word.  call m=n/1000.  if m=0, then the word is a moti
c     verb for use in travelling (see section 3).  else, if m=1, the wor
c     an object.  else, if m=2, the word is an action verb (such as "car
c     or "attack").  else, if m=3, the word is a special case verb (such
c     "dig") and n mod 1000 is an index into section 6.  objects from 50
c     (currently, anyway) 79 are considered treasures (for pirate, close
c  section 5: object descriptions.  each line contains a number (n), a t
c     and a message.  if n is from 1 to 100, the message is the "invento
c     message for object n.  otherwise, n should be 000, 100, 200, etc.,
c     the message should be the description of the preceding object when
c     prop value is n/100.  the n/100 is used only to distinguish multip
c     messages from multi-line messages; the prop info actually requires
c     messages for an object to be present and consecutive.  properties
c     produce no message should be given the message ">$<".
c  section 6: arbitrary messages.  same format as sections 1, 2, and 5,
c     the numbers bear no relation to anything (except for special verbs
c     in section 4).
c  section 7: object locations.  each line contains an object number and
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 loca
c     (e.g. the grate) the first location is followed with the second, a
c     the object is assumed to be immovable.
c  section 8: action defaults.  each line contains an "action-verb" numb
c     the index (in section 6) of the default message for the verb.
c  section 9: liquid assets, etc.  each line contains a number (n) and u
c     location numbers.  bit n (where 0 is the units bit) is set in cond
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" routin
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 force
c     motion.
c  section 10: class messages.  each line contains a number (n), a tab,
c     message describing a classification of player.  the scoring sectio
c     selects the appropriate message, where each message is considered
c     apply to players whose scores are higher than the previous n but n
c     higher than this n.  note that these scores probably change with e
c     modification (and particularly expansion) of the program.
c  section 11: hints.  each line contains a hint number (corresponding t
c     cond bit, see section 9), the number of turns he must be at the ri
c     loc(s) before triggering the hint, the points deducted for taking
c     hint, the message number (section 6) of the question, and the mess
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 l
c     points).
c  section 12: magic messages. identical to section 6 except put in a se
c     section for easier reference.  magic messages are used by the star
c     maintenance mode, and related routines.
c  section 0: end of database.
c  start-up, dwarf stuff
c

1     i=rnd(1)
      if ( .not. hinted(3) ) hinted(3) = yes( 65, 1, 0 )
      newloc = loc
      limit=340
      if(hinted(3))limit=1000
c
c  can't leave cave once it's closing (except by main office).
c
2     if(newloc.ge.9.or.newloc.eq.0.or..not.closng)goto 71
      call rspeak(130)
      newloc=loc
      if(.not.panic)clock2=15
      panic=.true.
c
c  see if a dwarf has seen him and has come from where he wants to go.
c  the dwarf's blocking his way.  if coming from place forbidden to pira
c  (dwarves rooted in place) let him get out (and attacked).
c
71    if(newloc.eq.loc.or.forced(loc).or.bitset(loc,3))goto 74
      do 73 i=1,5
      if(odloc(i).ne.newloc.or..not.dseen(i))goto 73
      newloc=loc
      call rspeak(2)
      goto 74
73    continue
74    loc=newloc
c
c  dwarf stuff.  see earlier comments for description of variables.  rem
c  sixth dwarf is pirate and is thus very different except for motion ru
c
c  first off, don't let the dwarves follow him into a pit or a wall.  ac
c  the whole mess the first time he gets as far as the hall of mists (lo
c  if newloc is forbidden to pirate (in particular, if it's beyond the t
c  bridge), bypass dwarf stuff.  that way pirate can't steal return toll
c  dwarves can't meet the bear.  also means dwarves won't follow him int
c  end in maze, but c'est la vie.  they'll wait for him outside the dead
c
      if(loc.eq.0.or.forced(loc).or.bitset(newloc,3))goto 2000
      if(dflag.ne.0)goto 6000
      if(loc.ge.15)dflag=1
      goto 2000
c
c  when we encounter the first dwarf, we kill 0, 1, or 2 of the 5 dwarve
c  any of the survivors is at loc, replace him with the alternate.
c
6000  if(dflag.ne.1)goto 6010
      if(loc.lt.15.or.pct(80))goto 2000
      dflag=2
      do 6001 i=1,2
      j=1+rnd(5)
6001  if(pct(50))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
c  things are in full swing.  move each dwarf at random, except if he's
c  he sticks with us.  dwarves never go to locs <15.  if wandering at ra
c  they don't back up unless there's no alternative.  if they don't have
c  move, they attack.  and, of course, dead dwarves don't do much of any
c
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=trvloc(kk)
      if(newloc.gt.300.or.newloc.lt.15.or.newloc.eq.odloc(i)
     1        .or.(j.gt.1.and.newloc.eq.tk(j-1)).or.j.ge.20
     2        .or.newloc.eq.dloc(i).or.forced(newloc)
     3        .or.(i.eq.6.and.bitset(newloc,3))
     4        .or.trvcon(kk).eq.100)goto 6014
      tk(j)=newloc
      j=j+1
6014  kk=kk+1
      if(travel(kk-1).ge.0)goto 6012
6016  tk(j)=odloc(i)
      if(j.ge.2)j=j-1
      j=1+rnd(j)
      odloc(i)=dloc(i)
      dloc(i)=tk(j)
      dseen(i)=(dseen(i).and.loc.ge.15)
     1        .or.(dloc(i).eq.loc.or.odloc(i).eq.loc)
      if(.not.dseen(i))goto 6030
      dloc(i)=loc
      if(i.ne.6)goto 6027
c
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 fo
c  an unseen chest, let the pirate be spotted.
c
      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)
     1        .or.loc.eq.plac(emrald)))goto 6020
      if(toting(j))goto 6022
6020  if(here(j))k=1
      if(tally.eq.tally2+1.and.k.eq.0.and.place(chest).eq.0
     1        .and.here(lamp).and.prop(lamp).eq.1)goto 6025
      if(odloc(6).ne.dloc(6).and.pct(80))call rspeak(127)
      goto 6030
c
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)
     1        .or.loc.eq.plac(emrald)))goto 6023
      if(at(j).and.fixed(j).eq.0)call carry(j,loc)
      if(toting(j))call drop(j,chloc)
6023  continue
6024  dloc(6)=chloc
      odloc(6)=chloc
      dseen(6)=.false.
      goto 6030
c
6025  call rspeak(186)
      call move(chest,chloc)
      call move(messag,chloc2)
      goto 6024
c
c  this threatening little dwarf is in the room with him!
c
6027  dtotal=dtotal+1
      if(odloc(i).ne.dloc(i))goto 6030
      attack=attack+1
      if(knfloc.ge.0)knfloc=loc
      if(rnd(1000).lt.95*(dflag-2))stick=stick+1
6030  continue
c
c  now we know what's happening.  let's tell the poor sucker about it.
c
      if(dtotal.eq.0)goto 2000
      if(dtotal.eq.1)goto 75
       print 67,dtotal
67    format(/'There are ',i1,' threatening little dwarves in the'
     1        ,' 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
       print 78,attack
78    format(/1x,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     print 68,stick
68    format(/1x,i1,' of them get you!')
84    oldlc2=loc
      goto 99
c
79    call rspeak(5)
      k=52
      goto 82
c  describe the current location and (maybe) get next command.
c
c  print text for current loc.
c
2000  if(loc.eq.0)goto 99
      kk=stext(loc)
      kent=0
      if (abbnum.ne.0) kent=mod(abb(loc),abbnum)
      if (kent.eq.0.or.kk.eq.0) kk=ltext(loc)
      if(forced(loc).or..not.dark(0))goto 2001
      if(wzdark.and.pct(35))goto 90
      kk=rtext(16)
2001  if(toting(bear))call rspeak(141)
      call speak(kk)
      k=1
      if(forced(loc))goto 8
      if(loc.eq.33.and.pct(25).and..not.closng)call rspeak(8)
c
c  print out descriptions of objects at this location.  if not closing a
c  property value is negative, tally off another treasure.  rug is speci
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 hac
c  are because prop=0 is needed to get full score.
c
      if(dark(0))goto 2012
      abb(loc)=abb(loc)+1
      i=atloc(loc)
2004  if(i.eq.0)goto 2012
      obj=i
      if(obj.gt.100)obj=obj-100
      if(obj.eq.steps.and.toting(nugget))goto 2008
      if(prop(obj).ge.0)goto 2006
      if(closed)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
      call pspeak(obj,kk)
2008  i=link(i)
      goto 2004
c
2009  k=54
2010  spk=k
 2011 call rspeak(spk)
c
2012  verb=0
      obj=0
c
c  check if this loc is eligible for any hints.  if been here long enoug
c  branch to help section (on later page).  hints all come back here eve
c  to finish the loop.  ignore "hints" < 4 (special stuff, see database
c
2600  do 2602 hint=4,hntmax
      if(hinted(hint))goto 2602
      if(.not.bitset(loc,hint))hintlc(hint)=-1
      hintlc(hint)=hintlc(hint)+1
      if(hintlc(hint).ge.hints(hint,1))goto 40000
2602  continue
c
c  kick the random number generator just to add variety to the chase.  a
c  if closing time, check for any objects being toted with prop < 0 and
c  the prop to -1-prop.  this way objects won't be described until they'
c  been picked up and put down separate from their respective piles.  do
c  tick clock1 unless well into cave (and not at y2).
c
      if(.not.closed)goto 2605
      if(prop(oyster).lt.0.and.toting(oyster))
     1        call pspeak(oyster,1)
      do 2604 i=1,100
2604  if(toting(i).and.prop(i).lt.0)prop(i)=-1-prop(i)
2605  wzdark=dark(0)
      if(knfloc.gt.0.and.knfloc.ne.loc)knfloc=0
      i=rnd(1)
      call getin(wd1,wd2,wdfull)
*      print 123, wd1,wd2,wdfull
* 123  format("wd1='",a4,"',wd2='",a4,"',wdfull='",a20,"'")
      goto 2608

*      if (wizsw) go to 2608
*      when = time()
* 2100 format(a8)
*      read(when,2100) now
*      if (now .ge. t(1) .and. now .le. t(2)) go to 2611
*      if (now .ge. t(3) .and. now .le. t(4)) go to 2611
*      goto 2608
* 2611 print 2110,now
* 2110 format(' You look at your watch and see it is now',/
*     +1x,a9,' when...')
*      call mspeak(1)
*      scorng=.false.
*      goto 20000

c  every input, check "foobar" flag.  if zero, nothing's going on.  if p
c  make neg.  if neg, he skipped a word, so make it zero.
c
2608  foobar=min0(0,-foobar)
      turns=turns+1
      if(verb.eq.say.and.wd2.ne.0)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).and.prop(batter).eq.0
     1        .and.here(lamp))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
c
c  do preliminary analysis of sentence to find certain special
c  cases, viz,
c
c  enter <water,stream>
c  enter <location>
c  <water,oil> <plant,door>
c
      call vocab(wd1,-1,i)
      call vocab(wd2,-1,j)
      write( holl2char, 124 ) wd1
      if( holl2char .ne."ente")goto 2609
      if(j .eq. (water+1000)
     1        .or. j .eq. stream) go to 2010
      if(wd2 .ne. 0) go to 2800
2609  if((i .ne. (water+1000) .and. i .ne. (oil+1000))
     1        .or. (j .ne. (plant+1000) .and. j .ne. (door+1000)))
     2        go to 2610
      wd2=4hpour
 2610 continue
 124  format( a4 )
      write( holl2char, 124 ) wd1
      if( holl2char .eq."west".and.pct(10))
     1         call rspeak(17)
 2630 call vocab(wd1,-1,i)
      if(i.eq.-1)goto 3000
      k=mod(i,1000)
      kq=i/1000+1
      if(kq.le.0 .or. kq.gt.4) call bug(22)
      goto (8,5000,4000,2010)kq
      call gotoer
c
c  get second word for analysis.
c
2800  wd1=wd2
      wd2=0
      goto 2610
c
c  gee, i don't understand.
c
3000  spk=60
      if(pct(20))spk=61
      if(pct(20))spk=13
      call rspeak(spk)
      goto 2600
c
c  analyse a verb.  remember what it was, go back for object if second w
c  unless verb is "say", which snarfs arbitrary second word.
c
4000  verb=k
      spk=actspk(verb)
      if(wd2.ne.0.and.verb.ne.say)goto 2800
      if(verb.eq.say)obj=wd2
      if(obj.ne.0)goto 4090
c
c  analyse an intransitive verb (ie, no object given yet).
c
 4080 if(verb.le.0 .or. verb.gt.33) call bug(23)
      goto(8010,8000,8000,8040,2009,8040,9070,9080,8000,8000,
     1     2011,9120,9130,8140,9150,8000,8000,8180,8000,8200,
     2     8000,9220,9230,8240,8250,8260,8270,8000,8000,8300,
     3     8310,8320,8301)verb
      call gotoer
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,gaze rstr
c
c  analyse a transitive verb.
c
 4090 if(verb.le.0 .or. verb.gt.33) call bug(24)
      goto(9010,9020,9030,9040,2009,9040,9070,9080,9090,2011,
     1     2011,9120,9130,9140,9150,9160,9170,2011,9190,9190,
     2     9210,9220,9230,2011,2011,2011,9270,9280,9290,2011,
     3     2011,8320,8301)verb
      call gotoer
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,gaze rstr
c
c  analyse an object word.  see if the thing is here, whether we've got
c  yet, and so on.  object must be here unless verb is "find" or "invent
c  (and no new verb yet to be analysed).  water and oil are also funny,
c  they are never actually dropped at any location, but might be here in
c  the bottle or as a feature of the location.
c
5000  obj=k
      if(fixed(k).ne.loc.and..not.here(k))goto 5100
5010  if(wd2.ne.0)goto 2800
      if(verb.ne.0)goto 4090
*      print 5015,wdfull
* 5015 format('What do you want to do with the ',a20)
      call trmprt( "What do you want to do with the ", wdfull, "?" )
      goto 2600
c
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)).or.k.eq.liqloc(loc))goto 5010
      if(obj.ne.plant.or..not.at(plant2).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..not.here(rod2))goto 5190
      obj=rod2
      goto 5010
5190  if((verb.eq.find.or.verb.eq.invent).and.wd2.eq.0)goto 5010
*      print 5199,wdfull
* 5199 format('I don''t see any ', a20)
      call trmprt( "I don't see any ", wdfull, "." )
      goto 2012
c  figure out the new location
c
c  given the current location in "loc", and a motion verb number in "k",
c  the new location in "newloc".  the current loc is saved in "oldloc" i
c  he wants to retreat.  the current oldloc is saved in oldlc2, in case
c  dies.  (if he does, newloc will be limbo, and oldloc will be what kil
c  him, so we need oldlc2, which is the last place he was safe.)
c
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
c
9     ll=iabs(travel(kk))
      if(ll.eq.1 .or. ll.eq.k)goto 10
      if(travel(kk).lt.0)goto 50
      kk=kk+1
      goto 9
c
10    newloc=trvcon(kk)
      k=mod(newloc,100)
      if(newloc.le.300)goto 13
      if(prop(k).ne.newloc/100-3)goto 16
12    if(travel(kk).lt.0)call bug(25)
      kk=kk+1
      go to 10
c
13    if(newloc.le.100)goto 14
      if(toting(k).or.(newloc.gt.200.and.at(k)))goto 16
      goto 12
c
14    if(newloc.ne.0.and..not.pct(newloc))goto 12
16    newloc=trvloc(kk)
      if(newloc.le.300)goto 2
      if(newloc.le.500)goto 30000
      call rspeak(newloc-500)
      newloc=loc
      goto 2
c
c  special motions come here.  labelling convention: statement numbers n
c  (xx=00-99) are used for special case number nnn (nnn=301-500).
c
30000 newloc=newloc-300
      if(newloc.le.0 .or. newloc.gt.3) call bug(20)
      goto (30100,30200,30300)newloc
      call gotoer
c
c  travel 301.  plover-alcove passage.  can carry only emerald.  note: t
c  table must include "useless" entries going through passage, which can
c  be used for actual motion, but can be spotted by "go back".
c
30100 newloc=99+100-loc
      if(holdng.eq.0.or.(holdng.eq.1.and.toting(emrald)))goto 2
      newloc=loc
      call rspeak(117)
      goto 2
c
c  travel 302.  plover transport.  drop the emerald (only use special tr
c  toting it), so he's forced to use the plover-passage to get it out.
c  dropped it, go back and pretend he wasn't carrying it after all.
c
30200 call drop(emrald,loc)
      goto 12
c
c  travel 303.  troll bridge.  must be done only as special motion so th
c  dwarves won't wander across and encounter the bear.  (they won't foll
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
c
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
c
30310 newloc=plac(troll)+fixd(troll)-loc
      if(prop(troll).eq.0)prop(troll)=1
      if(.not.toting(bear))goto 2
      call rspeak(162)
      prop(chasm)=1
      prop(troll)=2
      call drop(bear,newloc)
      fixed(bear)=-1
      prop(bear)=3
      if(prop(spices).lt.0)tally2=tally2+1
      oldlc2=newloc
      goto 99
c
c  end of specials.
c
c  handle "go back".  look for verb which goes from loc to oldloc, or to
c  if oldloc has forced-motion.  k2 saves entry -> forced loc -> previou
c
20    k=oldloc
      if(forced(k))k=oldlc2
      oldlc2=oldloc
      oldloc=loc
      k2=0
      if(k.ne.loc)goto 21
      call rspeak(91)
      goto 2
c
21    ll=trvloc(kk)
      if(ll.eq.k)goto 25
      if(ll.gt.300)goto 22
      j=key(ll)
      if(forced(ll).and.trvloc(kk).eq.k)k2=kk
22    if(travel(kk).lt.0)goto 23
      kk=kk+1
      goto 21
c
23    kk=k2
      if(kk.ne.0)goto 25
      call rspeak(140)
      goto 2
c
25    k=iabs(travel(kk))
      kk=key(loc)
      goto 9
c
c  look.  can't give more detail.  pretend it wasn't dark (though it may
c  be dark) so he won't fall into a pit while staring into the gloom.
c
30    if(detail.lt.3)call rspeak(15)
      detail=detail+1
      wzdark=.false.
      abb(loc)=0
      goto 2
c
c  cave.  different messages depending on whether above ground.
c
40    if(loc.lt.8)call rspeak(57)
      if(loc.ge.8)call rspeak(58)
      goto 2
c
c  non-applicable motion.  various messages depending on word given.
c
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.  w
c  allow this maxdie times.  maxdie is automatically set based on the nu
c  snide messages available.  each death results in a message (81, 83, e
c  which offers reincarnation; if accepted, this results in message 82,
c  etc.  the last time, if he wants another chance, he gets a snide rema
c  we exit.  when reincarnated, all objects being carried get dropped at
c  (presumably the last place prior to being killed) without change of p
c  the loop runs backwards to assure that the bird is dropped before the
c  (this kluge could be changed once we're sure all references to bird a
c  are done by keywords.)  the lamp is a special case (it wouldn't do to
c  it in the cave).  it is turned off and left outside the building (onl
c  was carrying it, of course).  he himself is left inside the building
c  heaven help him if he tries to xyzzy back into the cave without the l
c  oldloc is zapped so he can't just "retreat".
c
c  the easiest way to get killed is to fall into a pit in pitch darkness
c
90    call rspeak(23)
      oldlc2=loc
c
c  okay, he's dead.  let's get on with it.
c
99    if(closng)goto 95
      yea=yes(81+numdie*2,82+numdie*2,54)
      numdie=numdie+1
      if(numdie.eq.maxdie.or..not.yea)goto 20000
      place(water)=0
      place(oil)=0
      if(toting(lamp))prop(lamp)=0
      do 98 j=1,100
      i=101-j
      if(.not.toting(i))goto 98
      k=oldlc2
      if(i.eq.lamp)k=1
      call drop(i,k)
98    continue
      loc=3
      oldloc=loc
      goto 2000
c
c  he died during closing time.  no resurrection.  tally up a death and
c
95    call rspeak(131)
      numdie=numdie+1
      goto 20000
c  routines for performing the various action verbs
c
c  statement numbers in this section are 8000 for intransitive verbs, 90
c  transitive, plus ten times the verb number.  many intransitive verbs
c  transitive code, and some verbs use code for other verbs, as noted be
c
c  random intransitive verbs come here.  clear obj just in case (see "at
c
 8000 continue
* 8000 print 8002,wdfull
* 8002 format('I don''t understand ',a20)
      call trmprt( "I don't understand ", wdfull, "." )
      obj=0
      goto 2600
c
c  carry, no object given yet.  ok if only one object present.
c
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
c  carry an object.  special cases for bird and cage (if bird in cage, c
c  take one without the other.  liquids also special, since they depend
c  status of bottle.  also various side effects, etc.
c
9010  if(toting(obj))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).and.liq(0).eq.obj)goto 9018
      obj=bottle
      if(toting(bottle).and.prop(bottle).eq.1)goto 9220
      if(prop(bottle).ne.1)spk=105
      if(.not.toting(bottle))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(.not.toting(rod))goto 9013
      call rspeak(26)
      goto 2012
9013  if(toting(cage))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)
     1        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
c  discard object.  "throw" also comes here for most objects.  special c
c  bird (might attack snake or dragon) and cage (might contain bird) and
c  drop coins at vending machine for extra batteries.
c
9020  if(toting(rod2).and.obj.eq.rod.and..not.toting(rod))obj=rod2
      if(.not.toting(obj))goto 2011
      if(obj.ne.bird.or..not.here(snake))goto 9024
      call rspeak(30)
      if(closed)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
c
9024  if(obj.ne.coins.or..not.here(vend))goto 9025
      call dstroy(coins)
      call drop(batter,loc)
      call pspeak(batter,0)
      goto 2012
c
9025  if(obj.ne.bird.or..not.at(dragon).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
c
9026  if(obj.ne.bear.or..not.at(troll))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
c
9027  if(obj.eq.vase.and.loc.ne.plac(pillow))goto 9028
      call rspeak(54)
      goto 9021
c
9028  prop(vase)=2
      if(at(pillow))prop(vase)=0
      call pspeak(vase,prop(vase)+1)
      if(prop(vase).ne.0)fixed(vase)=-1
      goto 9021
c
c  say.  echo wd2 (or wd1 if no wd2 (say what?, etc.).)  magic words ove
c
9030  if(wd2.eq.0)goto 9031
      wd1=wd2
 9031 call vocab (wd1,-1,i)
      if(i.eq.62.or.i.eq.65.or.i.eq.71.or.i.eq.2025)goto 9035
*      print 9032,wdfull
* 9032 format(' Okay, ',a20)
      call trmprt( "Okay, ", wdfull, "." )
      goto 2012
c
9035  wd2=0
      obj=0
      goto 2630
c
c  lock, unlock, no object given.  assume various things if present.
c
8040  spk=28
      if(here(clam))obj=clam
      if(here(oyster))obj=oyster
      if(at(door))obj=door
      if(at(grate))obj=grate
      if(obj.ne.0.and.here(chain))goto 8000
      if(here(chain))obj=chain
      if(obj.eq.0)goto 2011
c
c  lock, unlock object.  special stuff for opening clam/oyster and for c
c
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..not.here(keys))goto 2011
      if(obj.eq.chain)goto 9048
      if(.not.closng)goto 9043
      k=130
      if(.not.panic)clock2=15
      panic=.true.
      goto 2010
c
9043  k=34+prop(grate)
      prop(grate)=1
      if(verb.eq.lock)prop(grate)=0
      k=k+2*prop(grate)
      goto 2010
c
c  clam/oyster.
9046  k=0
      if(obj.eq.oyster)k=1
      spk=124+k
      if(toting(obj))spk=120+k
      if(.not.toting(tridnt))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
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
c
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))call drop(chain,loc)
      fixed(chain)=-1
      goto 2011
c
c  light lamp
c
9070  if(.not.here(lamp))goto 2011
      spk=184
      if(limit.lt.0)goto 2011
      prop(lamp)=1
      call rspeak(39)
      if(wzdark)goto 2000
      goto 2012
c
c  lamp off
c
9080  if(.not.here(lamp))goto 2011
      prop(lamp)=0
      call rspeak(40)
      if(dark(0))call rspeak(16)
      goto 2012
c
c  wave.  no effect unless waving rod at fissure.
c
9090  if((.not.toting(obj)).and.(obj.ne.rod.or..not.toting(rod2)))
     1        spk=29
      if(obj.ne.rod.or..not.at(fissur).or..not.toting(obj)
     1        .or.closng)goto 2011
      prop(fissur)=1-prop(fissur)
      call pspeak(fissur,2-prop(fissur))
      goto 2012
c
c  attack.  assume target if unambiguous.  "throw" also links here.  att
c  objects fall into two categories: enemies (snake, dwarf, etc.)  and o
c  (bird, clam).  ambiguous if two enemies, or if no enemies but two oth
c
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))obj=obj*100+snake
      if(at(dragon).and.prop(dragon).eq.0)obj=obj*100+dragon
      if(at(troll))obj=obj*100+troll
      if(here(bear).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).and.verb.ne.throw)obj=bird
c  clam and oyster both treated as clam for intransitive case; no harm d
      if(here(clam).or.here(oyster))obj=100*obj+clam
      if(obj.gt.100)goto 8000
9124  if(obj.ne.bird)goto 9125
      spk=137
      if(closed)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)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
c  move dragon to central loc (still fixed), move rug there (not fixed),
c  move him there, too.  then do a null motion to get new description.
      verb=0
      obj=0
      if(.not.yes(49,0,0))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
      if(place(obj).eq.plac(dragon).or.place(obj).eq.fixd(dragon))
     1        call move(obj,k)
9126  continue
      loc=k
      k=null
      goto 8
c
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.
c
9130  if(obj.eq.bottle.or.obj.eq.0)obj=liq(0)
      if(obj.eq.0)goto 8000
      if(.not.toting(obj))goto 2011
      spk=78
      if(obj.ne.oil.and.obj.ne.water)goto 2011
      prop(bottle)=1
      place(obj)=0
      spk=77
      if(.not.(at(plant).or.at(door)))goto 2011
c
      if(at(door))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
c
9132  prop(door)=0
      if(obj.eq.oil)prop(door)=1
      spk=113+prop(door)
      goto 2011
c
c  eat.  intransitive: assume food if present, else ask what.  transitiv
c  ok, some things lose appetite, rest are ridiculous.
c
8140  if(.not.here(food))goto 8000
8142  call dstroy(food)
      spk=72
      goto 2011
c
9140  if(obj.eq.food)goto 8142
      if(obj.eq.bird.or.obj.eq.snake.or.obj.eq.clam.or.obj.eq.oyster
     1        .or.obj.eq.dwarf.or.obj.eq.dragon.or.obj.eq.troll
     2        .or.obj.eq.bear)spk=71
      goto 2011
c
c  drink.  if no object, assume water and look for it here.  if water is
c  the bottle, drink that, else must be at a water loc, so drink stream.
c
9150  if(obj.eq.0.and.liqloc(loc).ne.water.and.(liq(0).ne.water
     1        .or..not.here(bottle)))goto 8000
      if(obj.ne.0.and.obj.ne.water)spk=110
      if(spk.eq.110.or.liq(0).ne.water.or..not.here(bottle))goto 2011
      prop(bottle)=1
      place(water)=0
      spk=74
      goto 2011
c
c  rub.  yields various snide remarks.
c
9160  if(obj.ne.lamp)spk=76
      goto 2011
c
c  throw.  same as discard unless axe.  then same as attack except ignor
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
c
9170  if(toting(rod2).and.obj.eq.rod.and..not.toting(rod))obj=rod2
      if(.not.toting(obj))goto 2011
      if(obj.ge.50.and.obj.le.maxtrs.and.at(troll))goto 9178
      if(obj.eq.food.and.here(bear))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).and.prop(dragon).eq.0)goto 9175
      spk=158
      if(at(troll))goto 9175
      if(here(bear).and.prop(bear).eq.0)goto 9176
      obj=0
      goto 9120
c
9172  spk=48
      if(rnd(3).eq.0)goto 9175
      dseen(i)=.false.
      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
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
c  but throwing food is another story.
9177  obj=bear
      goto 9210
c
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
c  quit.  intransitive only.  verify intent and exit if that's what he w
c
8180  gaveup=yes(22,54,54)
8185  if(gaveup)goto 20000
      goto 2012
c
c  find.  might be carrying it, or it might be here.  else give caveat.
c
9190  if(at(obj).or.(liq(0).eq.obj.and.at(bottle))
     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)spk=138
      if(toting(obj))spk=24
      goto 2011
c
c  inventory.  if object, treat same as find.  else report on current bu
c
8200  spk=98
      do 8201 i=1,100
      if(i.eq.bear.or..not.toting(i))goto 8201
      if(spk.eq.98)call rspeak(99)
      blklin=.false.
      call pspeak(i,-1)
      blklin=.true.
      spk=0
8201  continue
      if(toting(bear))spk=141
      goto 2011
c
c  feed.  if bird, no seed.  snake, dragon, troll: quip.  if dwarf, make
c  mad.  bear, special.
c
9210  if(obj.ne.bird)goto 9212
      spk=100
      goto 2011
c
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.or..not.here(bird))goto 2011
      spk=101
      call dstroy(bird)
      prop(bird)=0
      tally2=tally2+1
      goto 2011
c
9213  if(obj.ne.dwarf)goto 9214
      if(.not.here(food))goto 2011
      spk=103
      dflag=dflag+1
      goto 2011
c
9214  if(obj.ne.bear)goto 9215
      if(prop(bear).eq.0)spk=102
      if(prop(bear).eq.3)spk=110
      if(.not.here(food))goto 2011
      call dstroy(food)
      prop(bear)=1
      fixed(axe)=0
      prop(axe)=0
      spk=168
      goto 2011
c
9215  spk=14
      goto 2011
c
c  fill.  bottle must be empty, and some liquid available.  (vase is nas
c
9220  if(obj.eq.vase)goto 9222
      if(obj.ne.0.and.obj.ne.bottle)goto 2011
      if(obj.eq.0.and..not.here(bottle))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))place(k)=-1
      if(k.eq.oil)spk=108
      goto 2011
c
9222  spk=29
      if(liqloc(loc).eq.0)spk=144
      if(liqloc(loc).eq.0.or..not.toting(vase))goto 2011
      call rspeak(145)
      prop(vase)=2
      fixed(vase)=-1
      goto 9024
c
c  blast.  no effect unless you've got dynamite, which is a neat trick!
c
9230  if(prop(rod2).lt.0.or..not.closed)goto 2011
      bonus=133
      if(loc.eq.115)bonus=134
      if(here(rod2))bonus=135
      call rspeak(bonus)
      goto 20000
c
c  score.  go to scoring section, which will return to 8241 if scorng is
c
8240  scorng=.true.
      goto 20000
c
8241  scorng=.false.
       print 8243,score,mxscor
8243  format('If you were to quit now, you would score',i4
     1        ,' out of a possible',i4,'.')
      gaveup=yes(143,54,54)
      goto 8185
c
c  fee fie foe foo (and fum).  advance to next state if given in proper
c  look up wd1 in section 3 of vocab to determine which word we've got.
c  word zips the eggs back to the giant room (unless already there).
c
 8250 call vocab(wd1,3,k)
      spk=42
      if(foobar.eq.1-k)goto 8252
      if(foobar.ne.0)spk=151
      goto 2011
c
8252  foobar=k
      if(k.ne.4)goto 2009
      foobar=0
      if(place(eggs).eq.plac(eggs)
     1        .or.(toting(eggs).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)
     1        prop(troll)=1
      k=2
      if(here(eggs))k=1
      if(loc.eq.plac(eggs))k=0
      call move(eggs,plac(eggs))
      call pspeak(eggs,k)
      goto 2012
c
c  brief.  intransitive only.  suppress long descriptions after first ti
c
8260  spk=156
      abbnum=10000
      detail=3
      goto 2011
c
c  read.  magazines in dwarvish, message we've seen, and . . . oyster?
c
8270  if(here(magzin))obj=magzin
      if(here(tablet))obj=obj*100+tablet
      if(here(messag))obj=obj*100+messag
      if(closed.and.toting(oyster))obj=oyster
      if(obj.gt.100.or.obj.eq.0.or.dark(0))goto 8000
c
9270  if(dark(0))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).and.toting(oyster))spk=194
      if(obj.ne.oyster.or.hinted(2).or..not.toting(oyster)
     1        .or..not.closed)goto 2011
      hinted(2)=yes(192,193,54)
      goto 2012
c
c  break.  only works for mirror in repository and, of course, the vase.
c
9280  if(obj.eq.mirror)spk=148
      if(obj.eq.vase.and.prop(vase).eq.0)goto 9282
      if(obj.ne.mirror.or..not.closed)goto 2011
      call rspeak(197)
      goto 19000
c
9282  spk=198
      if(toting(vase))call drop(vase,loc)
      prop(vase)=2
      fixed(vase)=-1
      goto 2011
c
c  wake.  only use is to disturb the dwarves.
c
9290  if(obj.ne.dwarf.or..not.closed)goto 2011
      call rspeak(199)
      goto 19000
c
c suspend.  cant in this version.  But Lidie made it happen now!
c
8300  call savegm( 1 )
      go to 2012

 8301 call restoregm
      goto 2012
c
c hours.
c
8310  call mspeak(6)
*      print 8315,t
* 8315 format(1x,a9,' to ',a9,/,1x,a9,' to ',a9)
      go to 2012
c  gazing into palantir for hints
 8320 spk=204
      if(.not.here(orb))spk=203
      call rspeak(spk)
      if(.not.here(orb)) goto 2012
      spk=209
      if(toting(keys))spk=205
      if(toting(keys))goto 8321
      if (toting(axe))spk=208
      if (toting(axe))goto 8321
      if(toting(lamp))spk=207
 8321 call rspeak(spk)
      go to 2012
c
c  come here if he's been long enough at required loc(s) for some unused
c  hint number is in variable "hint".  branch to quick test for addition
c  conditions, then come back to do neat stuff.  goto 40010 if condition
c  met and we want to offer the hint.  goto 40020 to clear hintlc back t
c  40030 to take no action yet.
c
40000 if(hint-3.le.0 .or. hint-3.gt.7) call bug(27)
      goto (40400,40500,40600,40700,40800,40900,40900)(hint-3)
      call gotoer
c           cave  bird  snake maze  dark  witt  orb
c
40010 hintlc(hint)=0
      if(.not.yes(hints(hint,3),0,54))goto 2602
       print 40012,hints(hint,2)
40012 format(/'I am prepared to give you a hint, but it will cost you',
     1        i2,' points.')
      hinted(hint)=yes(175,hints(hint,4),54)
      if(hinted(hint).and.limit.gt.30)limit=limit+30*hints(hint,2)
40020 hintlc(hint)=0
40030 goto 2602
c
c  now for the quick tests.  see database description for one-line notes
c
40400 if(prop(grate).eq.0.and..not.here(keys))goto 40010
      goto 40020
c
40500 if(here(bird).and.toting(rod).and.obj.eq.bird)goto 40010
      goto 40030
c
40600 if(here(snake).and..not.here(bird))goto 40010
      goto 40020
c
40700 if(atloc(loc).eq.0.and.atloc(oldloc).eq.0
     1        .and.atloc(oldlc2).eq.0.and.holdng.gt.1)goto 40010
      goto 40020
c
40800 if(prop(emrald).ne.-1.and.prop(pyram).eq.-1)goto 40010
      goto 40020
c
40900 goto 40010
c  cave closing and scoring
c
c
c  these sections handle the closing of the cave.  the cave closes "cloc
c  turns after the last treasure has been located (including the pirate'
c  chest, which may of course never show up).  note that the treasures n
c  have been taken yet, just located.  hence clock1 must be large enough
c  out of the cave (it only ticks while inside the cave).  when it hits
c  we branch to 10000 to start closing the cave, and then sit back and w
c  him to try to get out.  if he doesn't within clock2 turns, we close t
c  cave; if he does try, we assume he panics, and give him a few additio
c  turns to get frantic before we close.  when clock2 hits zero, we bran
c  11000 to transport him into the final puzzle.  note that the puzzle d
c  upon all sorts of random things.  for instance, there must be no wate
c  oil, since there are beanstalks which we don't want to be able to wat
c  since the code can't handle it.  also, we can have no keys, since the
c  grate (having moved the fixed object!) there separating him from all
c  treasures.  most of these problems arise from the use of negative pro
c  numbers to suppress the object descriptions until he's actually moved
c  objects.
c
c  when the first warning comes, we lock the grate, destroy the bridge,
c  all the dwarves (and the pirate), remove the troll and bear (unless d
c  and set "closng" to true.  leave the dragon; too much trouble to move
c  from now until clock2 runs out, he cannot unlock the grate, move to a
c  location outside the cave (loc<9), or create the bridge.  nor can he
c  resurrected if he dies.  note that the snake is already gone, since h
c  to the treasure accessible only via the hall of the mt. king.  also,
c  been in giant room (to get eggs), so we can refer to it.  also also,
c  gotten the pearl, so we know the bivalve is an oyster.  *and*, the dw
c  must have been activated, since we've found chest.
c
10000 prop(grate)=0
      prop(fissur)=0
      do 10010 i=1,6
      dseen(i)=.false.
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=.true.
      goto 19999
c
c  once he's panicked, and clock2 has run out, we come here to set up th
c  storage room.  the room has two locs, hardwired as 115 (ne) and 116 (
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.
c  the sw end we place grate over treasures, snake pit, covey of caged b
c  more rods, and pillows.  a mirror stretches across one wall.  many of
c  objects come from known locations and/or states (e.g. the snake is kn
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
c  objects he might be carrying (lest he have some which could cause tro
c  such as the keys).  we describe the flash of light and trundle back.
c
11000 prop(bottle)=lput(bottle,115,1)
      prop(plant)=lput(plant,115,0)
      prop(oyster)=lput(oyster,115,0)
      prop(lamp)=lput(lamp,115,0)
      prop(rod)=lput(rod,115,0)
      prop(dwarf)=lput(dwarf,115,0)
      loc=115
      oldloc=115
      newloc=115
c
c  leave the grate with normal (non-negative property).
c
      i=lput(grate,116,0)
      prop(snake)=lput(snake,116,1)
      prop(bird)=lput(bird,116,1)
      prop(cage)=lput(cage,116,0)
      prop(rod2)=lput(rod2,116,0)
      prop(pillow)=lput(pillow,116,0)
c
      prop(mirror)=lput(mirror,115,0)
      fixed(mirror)=116
c
      do 11010 i=1,100
11010 if(toting(i))call dstroy(i)
c
      call rspeak(132)
      closed=.true.
      goto 2
c
c  another way we can force an end to things is by having the lamp give
c  when it gets close, we come here to warn him.  we go to 12000 if the
c  and fresh batteries are here, in which case we replace the batteries
c  continue.  12200 is for other cases of lamp dying.  12400 is when it
c  out, and 12600 is if he's wandered outside and the lamp is used up, i
c  case we force him to give up.
c
12000 call rspeak(188)
      prop(batter)=1
      if(toting(batter))call drop(batter,loc)
      limit=limit+2500
      lmwarn=.false.
      goto 19999
c
12200 if(lmwarn.or..not.here(lamp))goto 19999
      lmwarn=.true.
      spk=187
      if(place(batter).eq.0)spk=183
      if(prop(batter).eq.1)spk=189
      call rspeak(spk)
      goto 19999
c
12400 limit=-1
      prop(lamp)=0
      if(here(lamp))call rspeak(184)
      goto 19999
c
12600 call rspeak(185)
      gaveup=.true.
      goto 20000
c
c
c  oh dear, he's disturbed the dwarves.
c
19000 call rspeak(136)
c
c  exit code.  will eventually include scoring.  for now, however, ...
c
c  the present scoring algorithm is as follows:
c     objective:          points:        present total possible
c  getting well into cave   25                    25
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:   350
c  (points can also be deducted for using hints.)
c
20000 continue
      call computescore( score, mxscor )
c
c  return to score command if that's where we came from.
c
      if(scorng)goto 8241
c
c  that should be good enough.  let's tell him all about it.
c
       print 20100,score,mxscor,turns
20100 format('You scored',i4,' out of a possible',i4,
     1        ', using',i5,' turns.')
c
      do 20200 i=1,clsses
      if(cval(i).ge.score)goto 20210
20200 continue
       print 20202
20202 format(/' You just went off my scale!!'/)
      goto 25000
c
20210 call speak(ctext(i))
      if(i.eq.clsses-1)goto 20220
      k=cval(i)+1-score
      if (k.eq.1)print 20212,k
      if (k.ne.1)print 20213,k
20212 format('To acheive the next higher rating, you need ',
     + i3,' point.')
20213 format('To achieve the next higher rating, you need ',
     + i3,' points.')
      goto 25000
c
20220  print 20222
20222 format(/' To achieve the next higher rating ',
     1        'would be a neat trick!'//' Congratulations!!'/)
c
25000 continue
c
c
      end




      subroutine computescore( score, mxscor )
c
      implicit integer (a-z)
      logical blklin,noinpt
      logical forced, pct
      logical dseen,hinted
      logical bitset,lmwarn,closng,panic,
     1        closed,gaveup,scorng

      common /txtcom/ rtext,lines,ascvar
      common /blkcom/ blklin,noinpt
      common /voccom/ ktab,atab ,tabsiz
      common /placom/ atloc,link,place,fixed,holdng
      common /mtxcom/ mtext
      common /ptxcom/ ptext
      common /abbcom/ abb
      common /miscom/ linuse,trvs,clsses,oldloc,loc,cval,tk,newloc,
     1 key,plac,fixd,actspk,cond,hints,hntmax,prop,tally,tally2,
     2 hintlc,chloc,chloc2,dseen,dflag,dloc,daltlc,keys,lamp,grate,
     3 cage,rod,rod2,steps,bird,door,pillow,snake,fissur,tablet,
     4 clam,oyster,magzin,dwarf,knife,food,bottle,water,oil,plant,
     5 plant2,axe,mirror,dragon,chasm,troll,troll2,bear,messag,vend,
     6 batter,nugget,coins,chest,eggs,tridnt,vase,emrald,pyram,
     7 pearl,rug,chain,back,look,cave,null,entrnc,dprssn,say,lock,
     8 throw,find,invent,turns,lmwarn,knfloc,detail,abbnum,
     9 numdie,maxdie,dkill,foobar,bonus,clock1,clock2,
     1 closng,panic,closed,gaveup,scorng,odloc,stream,orb
      common /misc2/ i,rtxsiz,clsmax,magsiz,locsiz,ctext,stext,ltext,
     1 sect,travel,trvcon,trvloc,trvsiz,tabndx,obj,j,k,verb,hntsiz,
     2 maxtrs,hinted,hntloc,kk

      dimension lines(18)
      dimension travel(800),trvcon(800),trvloc(800)
      dimension ktab(300),atab(300)
      dimension ltext(150),stext(150),key(150),cond(150),abb(150),
     1        atloc(150)
      dimension plac(100),place(100),fixd(100),fixed(100),link(200),
     1        ptext(100),prop(100)
      dimension actspk(35)
      dimension rtext(212)
      dimension ctext(12),cval(12)
      dimension hintlc(20),hinted(20),hints(20,4)
      dimension mtext(35)
      dimension tk(20),dseen(6),dloc(6),odloc(6)

      score=0
      mxscor=0
c
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.
c
      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
c  now look at how he finished and how far he got.  maxdie and numdie te
c  how well he survived.  gaveup says whether he exited via quit.  dflag
c  tell us if he ever got suitably deep into the cave.  closng still ind
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,
c  135 if he blew it (so to speak).
c
      score=score+(maxdie-numdie)*10
      mxscor=mxscor+maxdie*10
      if(.not.(scorng.or.gaveup))score=score+4
      mxscor=mxscor+4
      if(dflag.ne.0)score=score+25
      mxscor=mxscor+25
      if(closng)score=score+25
      mxscor=mxscor+25
      if(.not.closed)goto 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
c  did he come to witt's end as he should?
c
      if(place(magzin).eq.108)score=score+1
      mxscor=mxscor+1
c
c  round it off.
c
      score=score+2
      mxscor=mxscor+2
c
c  deduct points for hints.  hints < 4 are special; see database descrip
c
      do 20030 i=1,hntmax
20030 if(hinted(i))score=score-hints(i,2)
c
c  return to score command if that's where we came from.
c

      end



      subroutine gotoer
      print *, "computed gopto error"
      end




      subroutine savegm( makecopy)
c
      implicit integer (a-z)
      logical blklin,noinpt
      logical forced, pct
      logical dseen,hinted
      logical bitset,lmwarn,closng,panic,
     1        closed,gaveup,scorng
c
      common /txtcom/ rtext,lines,ascvar
      common /blkcom/ blklin,noinpt
      common /voccom/ ktab,atab ,tabsiz
      common /placom/ atloc,link,place,fixed,holdng
      common /mtxcom/ mtext
      common /ptxcom/ ptext
      common /abbcom/ abb
      common /miscom/ linuse,trvs,clsses,oldloc,loc,cval,tk,newloc,
     1 key,plac,fixd,actspk,cond,hints,hntmax,prop,tally,tally2,
     2 hintlc,chloc,chloc2,dseen,dflag,dloc,daltlc,keys,lamp,grate,
     3 cage,rod,rod2,steps,bird,door,pillow,snake,fissur,tablet,
     4 clam,oyster,magzin,dwarf,knife,food,bottle,water,oil,plant,
     5 plant2,axe,mirror,dragon,chasm,troll,troll2,bear,messag,vend,
     6 batter,nugget,coins,chest,eggs,tridnt,vase,emrald,pyram,
     7 pearl,rug,chain,back,look,cave,null,entrnc,dprssn,say,lock,
     8 throw,find,invent,turns,lmwarn,knfloc,detail,abbnum,
     9 numdie,maxdie,dkill,foobar,bonus,clock1,clock2,
     1 closng,panic,closed,gaveup,scorng,odloc,stream,orb
      common /misc2/ i,rtxsiz,clsmax,magsiz,locsiz,ctext,stext,ltext,
     1 sect,travel,trvcon,trvloc,trvsiz,tabndx,obj,j,k,verb,hntsiz,
     2 maxtrs,hinted,hntloc,kk
c
      dimension lines(18)
      dimension travel(800),trvcon(800),trvloc(800)
      dimension ktab(300),atab(300)
      dimension ltext(150),stext(150),key(150),cond(150),abb(150),
     1        atloc(150)
      dimension plac(100),place(100),fixd(100),fixed(100),link(200),
     1        ptext(100),prop(100)
      dimension actspk(35)
      dimension rtext(212)
      dimension ctext(12),cval(12)
      dimension hintlc(20),hinted(20),hints(20,4)
      dimension mtext(35)
      dimension tk(20),dseen(6),dloc(6),odloc(6)

c Game save state date, score and moves.
        character*19 qd
        character*12 scoremoves
        logical savescorng

      REWIND 3

      write(3) blklin,noinpt
      write(3) forced, pct
      write(3) dseen,hinted
      write(3) bitset,lmwarn,closng,panic,
     1        closed,gaveup,scorng

      write(3) rtext,lines,ascvar
      write(3) blklin,noinpt
      write(3) ktab,atab ,tabsiz
      write(3) atloc,link,place,fixed,holdng
      write(3) mtext
      write(3) ptext
      write(3) abb
      write(3) linuse,trvs,clsses,oldloc,loc,cval,tk,newloc
      write(3) key,plac,fixd,actspk,cond,hints,hntmax,prop,tally,tally2
      write(3) hintlc,chloc,chloc2,dseen,dflag,dloc,daltlc,keys,lamp,gra
     +te
      write(3) cage,rod,rod2,steps,bird,door,pillow,snake,fissur,tablet
      write(3) clam,oyster,magzin,dwarf,knife,food,bottle,water,oil,plan
     +t
      write(3) plant2,axe,mirror,dragon,chasm,troll,troll2,bear,messag,v
     +end
      write(3) batter,nugget,coins,chest,eggs,tridnt,vase,emrald,pyram
      write(3) pearl,rug,chain,back,look,cave,null,entrnc,dprssn,say,loc
     +k
      write(3) throw,find,invent,turns,lmwarn,knfloc,detail,abbnum
      write(3) numdie,maxdie,dkill,foobar,bonus,clock1,clock2
      write(3) closng,panic,closed,gaveup,scorng,odloc,stream,orb
      write(3) i,rtxsiz,clsmax,magsiz,locsiz,ctext,stext,ltext
      write(3) sect,travel,trvcon,trvloc,trvsiz,tabndx,obj,j,k,verb,hnts
     +iz
      write(3) maxtrs,hinted,hntloc,kk

      ENDFILE 3
      close(unit=3)

      if ( makecopy .eq. 1 ) then
c Make a backup copy of the game save state.
         savescorng = scorng
         scorng = .true.
         call computescore( score, mxscor )
         scorng = savescorng
         write( scoremoves, 123 ) score, turns
 123     format( "-", i3.3,"-", i7.7 )
         call qdate( qd )
         call system( "/bin/cp Adventure.save Adventure.save-" // qd //
     +     scoremoves )
         open (unit=3, file='Adventure.save', form='unformatted')
      endif

      call mspeak(34)

      end




      subroutine restoregm
c
      implicit integer (a-z)
      logical blklin,noinpt
      logical forced, pct
      logical dseen,hinted
      logical bitset,lmwarn,closng,panic,
     1        closed,gaveup,scorng
c
      common /txtcom/ rtext,lines,ascvar
      common /blkcom/ blklin,noinpt
      common /voccom/ ktab,atab ,tabsiz
      common /placom/ atloc,link,place,fixed,holdng
      common /mtxcom/ mtext
      common /ptxcom/ ptext
      common /abbcom/ abb
      common /miscom/ linuse,trvs,clsses,oldloc,loc,cval,tk,newloc,
     1 key,plac,fixd,actspk,cond,hints,hntmax,prop,tally,tally2,
     2 hintlc,chloc,chloc2,dseen,dflag,dloc,daltlc,keys,lamp,grate,
     3 cage,rod,rod2,steps,bird,door,pillow,snake,fissur,tablet,
     4 clam,oyster,magzin,dwarf,knife,food,bottle,water,oil,plant,
     5 plant2,axe,mirror,dragon,chasm,troll,troll2,bear,messag,vend,
     6 batter,nugget,coins,chest,eggs,tridnt,vase,emrald,pyram,
     7 pearl,rug,chain,back,look,cave,null,entrnc,dprssn,say,lock,
     8 throw,find,invent,turns,lmwarn,knfloc,detail,abbnum,
     9 numdie,maxdie,dkill,foobar,bonus,clock1,clock2,
     1 closng,panic,closed,gaveup,scorng,odloc,stream,orb
      common /misc2/ i,rtxsiz,clsmax,magsiz,locsiz,ctext,stext,ltext,
     1 sect,travel,trvcon,trvloc,trvsiz,tabndx,obj,j,k,verb,hntsiz,
     2 maxtrs,hinted,hntloc,kk
c
      dimension lines(18)
      dimension travel(800),trvcon(800),trvloc(800)
      dimension ktab(300),atab(300)
      dimension ltext(150),stext(150),key(150),cond(150),abb(150),
     1        atloc(150)
      dimension plac(100),place(100),fixd(100),fixed(100),link(200),
     1        ptext(100),prop(100)
      dimension actspk(35)
      dimension rtext(212)
      dimension ctext(12),cval(12)
      dimension hintlc(20),hinted(20),hints(20,4)
      dimension mtext(35)
      dimension tk(20),dseen(6),dloc(6),odloc(6)

      REWIND 3

      read(3) blklin,noinpt
      read(3) forced, pct
      read(3) dseen,hinted
      read(3) bitset,lmwarn,closng,panic,
     1        closed,gaveup,scorng

      read(3) rtext,lines,ascvar
      read(3) blklin,noinpt
      read(3) ktab,atab ,tabsiz
      read(3) atloc,link,place,fixed,holdng
      read(3) mtext
      read(3) ptext
      read(3) abb
      read(3) linuse,trvs,clsses,oldloc,loc,cval,tk,newloc
      read(3) key,plac,fixd,actspk,cond,hints,hntmax,prop,tally,tally2
      read(3) hintlc,chloc,chloc2,dseen,dflag,dloc,daltlc,keys,lamp,gra
     +te
      read(3) cage,rod,rod2,steps,bird,door,pillow,snake,fissur,tablet
      read(3) clam,oyster,magzin,dwarf,knife,food,bottle,water,oil,plan
     +t
      read(3) plant2,axe,mirror,dragon,chasm,troll,troll2,bear,messag,v
     +end
      read(3) batter,nugget,coins,chest,eggs,tridnt,vase,emrald,pyram
      read(3) pearl,rug,chain,back,look,cave,null,entrnc,dprssn,say,loc
     +k
      read(3) throw,find,invent,turns,lmwarn,knfloc,detail,abbnum
      read(3) numdie,maxdie,dkill,foobar,bonus,clock1,clock2
      read(3) closng,panic,closed,gaveup,scorng,odloc,stream,orb
      read(3) i,rtxsiz,clsmax,magsiz,locsiz,ctext,stext,ltext
      read(3) sect,travel,trvcon,trvloc,trvsiz,tabndx,obj,j,k,verb,hnts
     +iz
      read(3) maxtrs,hinted,hntloc,kk

      call mspeak(33)

      end
      



      subroutine qdate( qd )

c     Return current date/time as character*19 '2015.04.01-01:02:03'

      implicit integer (a-z)
      character*24 fd
      character*19 qd
      character*2 mm, montht(12), dd
      character*3 monthf(12)
      data monthf/'Jan', 'Feb', 'Mar', 'Apr', 'May', 'Jun',
     1            'Jul', 'Aug', 'Sep', 'Oct', 'Nov', 'Dec'/
      data montht/'01',  '02',  '03',  '04',  '05',  '06',
     1            '07',  '08',  '09',  '10',  '11',  '12'/

      call fdate(fd)

      mm = '??'
      do 100 i = 1, 12
         if( monthf(i) .eq. fd(5:7) ) mm = montht(i)
 2       format(bz,i2)
 100  continue

      dd = '??'
      dd = fd(9:10)
      if ( dd(1:1) .eq. ' ' ) then
         dd = '0' // dd(2:2)
      endif

      qd = fd(21:24) // '.' // mm // '.' // dd // '-' //
     1   fd(12:19)

      end




      subroutine trmprt( msg, str, punc )
* Trim trailing spaces from STR and print.
      implicit integer( a-z )
      character*(*) msg, str, punc
      character*20, fmt
      i = len(str)
      do while (str(i:i) .eq. ' ')
        i = i - 1
      enddo
      write( fmt, 1 ), len(msg), i, len(punc)
 1        format("(a",i2,",a",i2,",a",i2,")")
      print fmt, msg, str(1:i), punc
      return
      end
