home *** CD-ROM | disk | FTP | other *** search
- SUBROUTINE INIT
- INCLUDE 'HEAD1.H'
- INCLUDE 'FUNCT.H'
- INCLUDE 'DATAB.H'
- C READ THE DATABASE IF WE HAVE NOT YET DONE SO
-
- IF(SETUP.NE.0) GOTO 1100
- LINSIZ = 2100
- RTXSIZ = 205
- HNTSIZ = 20
- VRBSIZ = 35
- MAGSIZ = 35
- TRVSIZ = 750
- CLSMAX = 12
- C TYPE 1000
- WRITE(*,1000)
- 1000 FORMAT(' HAVE PATIENCE. IT TAKES A WHILE TO INITIALIZE...')
-
- C CLEAR OUT THE VARIOUS TEXT-POINTER ARRAYS. ALL TEXT IS STORED ON DISK
- C FILE (RANDOM ACCESS ON UNIT 2). THE TEXT-POINTER ARRAYS CONTAIN RECORD
- 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)=0.
- C SUCCESSIVE PROP MESSAGES ARE FOUND BY CHASING POINTERS. RTEXT CONTAINS
- C SECTION 6'S STUFF. CTEXT(N) POINTS TO A PLAYER-CLASS MESSAGE. MTEXT IS FOR
- C SECTION 12. WE ALSO CLEAR COND. SEE DESCRIPTION OF SECTION 9 FOR DETAILS.
-
- DO 1001 I=1,300
- IF(I.LE.100)PTEXT(I)=0
- IF(I.LE.RTXSIZ)RTEXT(I)=0
- IF(I.LE.CLSMAX)CTEXT(I)=0
- IF(I.LE.MAGSIZ)MTEXT(I)=0
- IF(I.GT.LOCSIZ) GOTO 1001
- STEXT(I)=0
- LTEXT(I)=0
- COND(I)=0
- 1001 CONTINUE
-
- C CALL ASSIGN(1,'TEXT.TXT')
- OPEN(UNIT=1,FILE='TEXT.TXT',STATUS='OLD',MODE='READ')
- C DEFINE FILE 2(2100,38,U,ASCVAR)
- OPEN(UNIT=2,STATUS='SCRATCH',ACCESS='DIRECT',
- 1FORM='UNFORMATTED',RECL=76)
- ASCVAR = 1
- SETUP = 1
- LINUSE = 1
- TRVS = 1
- CLSSES = 1
-
- C START NEW DATA SECTION. SECTION IS THE SECTION NUMBER.
-
- 1002 READ(1,1003)SECT
- 1003 FORMAT(I7)
- C TYPE 10030,SECT
- C WRITE(*,10030) SECT
- C10030 FORMAT(' NOW LOADING SECTION',I3)
- OLDLOC = -1
- GOTO(1100,1004,1004,1030,1040,1004,1004,1050,1060,1070,1004,
- 1 1080,1004) (SECT+1)
- C (0) (1) (2) (3) (4) (5) (6) (7) (8) (9) (10)
- C (11) (12)
- CALL BUG(9)
-
- C SECTIONS 1, 2, 5, 6, 10, 12. READ MESSAGES AND SET UP POINTERS.
-
- 1004 READ(1,1005) LOC,LINES
- 1005 FORMAT(I4,18A4)
- WRITE(2,REC=ASCVAR) LOC,LINES
- ASCVAR=ASCVAR+1
- LINUSE = ASCVAR-1
- IF(LOC .EQ. -1) GOTO 1002
- IF(LOC .EQ. OLDLOC) GOTO 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
-
- STEXT(LOC)=LINUSE
- GOTO 1020
-
- 1008 LTEXT(LOC) = LINUSE
- GOTO 1020
-
- 1010 IF(LOC.GT.0.AND.LOC.LE.100) PTEXT(LOC)=LINUSE
- GOTO 1020
-
- 1011 IF(LOC.GT.RTXSIZ) WRITE(*,*) LOC,RTXSIZ
- IF(LOC.GT.RTXSIZ) CALL BUG(6)
- RTEXT(LOC)=LINUSE
- GOTO 1020
-
- 1012 CTEXT(CLSSES)=LINUSE
- CVAL(CLSSES)=LOC
- CLSSES=CLSSES+1
- GOTO 1020
-
- 1013 IF(LOC.GT.MAGSIZ) CALL BUG(6)
- MTEXT(LOC)=LINUSE
-
- 1020 OLDLOC = LOC
- IF(LINUSE .GE. 2100) CALL BUG(2)
- GOTO 1004
-
- C THE STUFF FOR SECTION 3 IS ENCODED HERE. EACH "FROM-LOCATION" GETS A
- C CONTIGUOUS SECTION OF THE "TRAVEL" ARRAY. EACH ENTRY IN TRAVEL IS
- C NEWLOC*1000 + KEYWORD (FROM SECTION 4, MOTION VERBS), AND IS NEGATED IF
- C THIS IS THE LAST ENTRY FOR THIS LOCATION. KEY(N) IS THE INDEX IN TRAVEL
- C OF THE FIRST OPTION AT LOCATION N.
-
- 1030 READ(1,1031)LOC,NEWLOC,TK
- 1031 FORMAT(99I10)
- IF(LOC.EQ.0) GOTO 1030
- C ABOVE KLUGE IS TO AVOID AFOREMENTIONED F40 BUG
- 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)=NEWLOC*1000+TK(L)
- TRVS=TRVS+1
- IF(TRVS.EQ.TRVSIZ) CALL BUG(3)
- 1037 CONTINUE
- 1039 TRAVEL(TRVS-1)=-TRAVEL(TRVS-1)
- GOTO 1030
-
- C HERE WE READ IN THE VOCAULARY. KTAB(N) IS THE WORD NUMBER, ATAB(N) IS
- C THE CORRESPONDING WORD. THE -1 AT THE END OF SECTION 4 IS LEFT IN KTAB
- C AS AN END-MARKER.
-
- 1040 DO 1042 TABNDX=1,TABSIZ
- 1043 READ(1,1041)KTAB(TABNDX),ATAB(TABNDX)
- 1041 FORMAT(I10,A4)
- IF(KTAB(TABNDX).EQ.0) GOTO 1043
- C ABOVE KLUGE IS TO AVOID AFOREMENTIONED F40 BUG
- IF(KTAB(TABNDX).EQ.-1) GOTO 1002
- 1042 CONTINUE
- CALL BUG(4)
-
- C READ IN THE INITIAL LOCATIONS FOR EACH OBJECT. ALSO THE IMMOVABILITY INFO.
- C PLAC CONTAINS INITIAL LOCATIONS OF OBJECTS. FIXD IS -1 FOR IMMOVABLE
- C OBJECTS (INCLUDING THE SNAKE), OR = SECOND LOC FOR TWO-PLACED OBJECTS.
-
- 1050 READ(1,1031)OBJ,J,K
- IF(OBJ.EQ.-1) GOTO 1002
- PLAC(OBJ)=J
- FIXD(OBJ)=K
- GOTO 1050
-
- C READ DEFAULT MESSAGE NUMBERS FOR ACTION VERBS, STORE IN ACTSPK.
-
- 1060 READ(1,1031) VERB,J
- IF(VERB.EQ.-1) GOTO 1002
- ACTSPK(VERB)=J
- GOTO 1060
-
- C READ INFO ABOUT AVAILABLE LIQUIDS AND OTHER CONDITIONS, STORE IN COND.
-
- 1070 READ(1,1031) K,TK
- 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)+SHIFT(1,K)
- GOTO 1070
-
- C READ DATA FOR HINTS.
-
- 1080 HNTMAX=0
- 1081 READ(1,1031) K,TK
- IF(K.EQ.-1) GOTO 1002
- IF(K.EQ.0) GOTO 1081
- 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 IF SETUP=2 WE DON'T NEED TO DO THIS. IT'S ONLY NECESSARY IF WE HAVEN'T DONE
- C IT AT ALL OR IF THE PROGRAM HAS BEEN RUN SINCE THEN.
-
- 1100 IF(SETUP.EQ.2) GOTO 1
- IF(SETUP.EQ.-1) GOTO 1
-
- C HAVING READ IN THE DATABASE, CERTAIN THINGS ARE NOW CONSTRUCTED. PROPS ARE
- C SET TO ZERO. WE FINISH SETTING UP COND BY CHECKING FOR FORCED-MOTION TRAVEL
- C ENTRIES. THE PLAC AND FIXD ARRAYS ARE USED TO SET UP ATLOC(N) AS THE FIRST
- C OBJECT AT LOCATION N, AND LINK(OBJ) AS THE NEXT OBJECT AT THE SAME LOCATION
- C AS OBJ. (OBJ>100 INDICATES THAT FIXED(OBJ-100)=LOC; LINK(OBJ) IS STILL THE
- C CORRECT LINK TO USE.) ABB IS ZEROED; IT CONTROLS WHETHER THE ABBREVIATED
- C DESCRIPTION IS PRINTED. COUNTS MOD 5 UNLESS "LOOK" IS USED.
-
- DO 1101 I=1,100
- PLACE(I)=0
- PROP(I)=0
- LINK(I)=0
- 1101 LINK(I+100)=0
-
- DO 1102 I=1,LOCSIZ
- ABB(I)=0
- IF(LTEXT(I).EQ.0.OR.KEY(I).EQ.0) GOTO 1102
- K=KEY(I)
- IF(MOD(IABS(TRAVEL(K)),1000).EQ.1) COND(I)=2
- 1102 ATLOC(I)=0
-
- C SET UP THE ATLOC AND LINK ARRAYS AS DESCRIBED ABOVE. WE'LL USE THE DROP
- C SUBROUTINE, WHICH PREFACES NEW OBJECTS ON THE LISTS. SINCE WE WANT THINGS
- C IN THE OTHER ORDER, WE'LL RUN THE LOOP BACKWARDS. IF THE OBJECT IS IN TWO
- C LOCS, WE DROP IT TWICE. THIS ALSO SETS UP "PLACE" AND "FIXED" AS COPIES OF
- C "PLAC" AND "FIXD". ALSO, SINCE TWO-PLACED OBJECTS ARE TYPICALLY BEST
- C DESCRIBED LAST, WE'LL DROP THEM FIRST.
-
- 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
-
- 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 TREASURES, AS NOTED EARLIER, ARE OBJECTS 50 THROUGH MAXTRS (CURRENTLY 79).
- C THEIR PROPS ARE INITIALLY -1, AND ARE SET TO 0 THE FIRST TIME THEY ARE
- C DESCRIBED. TALLY KEEPS TRACK OF HOW MANY ARE NOT YET FOUND, SO WE KNOW
- C WHEN TO CLOSE THE CAVE. TALLY2 COUNTS HOW MANY CAN NEVER BE FOUND (E.G., IF
- C LOST BIRD OR BRIDGE).
-
- 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 CLEAR THE HINT STUFF. HINTLC(I) IS HOW LONG HE'S BEEN AT LOC WITH COND BIT
- C I. HINTED(I) IS TRUE IFF HINT I HAS BEEN USED.
-
- DO 1300 I=1,HNTMAX
- HINTED(I)=.FALSE.
- 1300 HINTLC(I)=0
-
- C DEFINE SOME HANDY MNEMONICS. THESE CORRESPOND TO OBJECT NUMBERS.
-
- KEYS=VOCAB('KEYS',1)
- LAMP=VOCAB('LAMP',1)
- GRATE=VOCAB('GRAT',1)
- CAGE=VOCAB('CAGE',1)
- ROD=VOCAB('ROD ',1)
- ROD2=ROD+1
- STEPS=VOCAB('STEP',1)
- BIRD=VOCAB('BIRD',1)
- DOOR=VOCAB('DOOR',1)
- PILLOW=VOCAB('PILL',1)
- SNAKE=VOCAB('SNAK',1)
- FISSUR=VOCAB('FISS',1)
- TABLET=VOCAB('TABL',1)
- CLAM=VOCAB('CLAM',1)
- OYSTER=VOCAB('OYST',1)
- MAGZIN=VOCAB('MAGA',1)
- DWARF=VOCAB('DWAR',1)
- KNIFE=VOCAB('KNIF',1)
- FOOD=VOCAB('FOOD',1)
- BOTTLE=VOCAB('BOTT',1)
- WATER=VOCAB('WATE',1)
- OIL=VOCAB('OIL ',1)
- PLANT=VOCAB('PLAN',1)
- PLANT2=PLANT+1
- AXE=VOCAB('AXE ',1)
- MIRROR=VOCAB('MIRR',1)
- DRAGON=VOCAB('DRAG',1)
- CHASM=VOCAB('CHAS',1)
- TROLL=VOCAB('TROL',1)
- TROLL2=TROLL+1
- BEAR=VOCAB('BEAR',1)
- MESSAG=VOCAB('MESS',1)
- VEND=VOCAB('VEND',1)
- BATTER=VOCAB('BATT',1)
-
- C OBJECTS FROM 50 THROUGH WHATEVER ARE TREASURES. HERE ARE A FEW.
-
- NUGGET=VOCAB('GOLD',1)
- COINS=VOCAB('COIN',1)
- CHEST=VOCAB('CHES',1)
- EGGS=VOCAB('EGGS',1)
- TRIDNT=VOCAB('TRID',1)
- VASE=VOCAB('VASE',1)
- EMRALD=VOCAB('EMER',1)
- PYRAM=VOCAB('PYRA',1)
- PEARL=VOCAB('PEAR',1)
- RUG=VOCAB('RUG ',1)
- CHAIN=VOCAB('CHAI',1)
-
- C THESE ARE MOTION-VERB NUMBERS
-
- BACK=VOCAB('BACK',0)
- LOOK=VOCAB('LOOK',0)
- CAVE=VOCAB('CAVE',0)
- NULL=VOCAB('NULL',0)
- ENTRNC=VOCAB('ENTR',0)
- DPRSSN=VOCAB('DEPR',0)
-
- C AND SOME ACTION VERBS.
-
- SAY=VOCAB('SAY ',2)
- LOCK=VOCAB('LOCK',2)
- THROW=VOCAB('THRO',2)
- FIND=VOCAB('FIND',2)
- INVENT=VOCAB('INVE',2)
-
- C INITIALISE THE DWARVES. DLOC IS LOC OF DWARVES, HARD-WIRED IN. ODLOC IS
- C PRIOR LOC OF EACH DWARF, INITIALLY GARBAGE. DALTLC IS ALTERNATE INITIAL LOC
- C FOR DWARF, IN CASE ONE OF THEM STARTS OUT ON TOP OF THE ADVENTURER. (NO 2
- C OF THE 5 INITIAL LOCS ARE ADJACENT.) DSEEN IS TRUE IF DWARF HAS SEEN HIM.
- C DFLAG CONTROLS THE LEVEL OF ACTIVATION OF ALL THIS:
- C 0 NO DWARF STUFF YET (WAIT UNTIL REACHES HALL OF MISTS)
- C 1 REACHED HALL OF MISTS, BUT HASN'T MET FIRST DWARF
- C 2 MET FIRST DWARF, OTHERS START MOVING, NO KNIVES THROWN YET
- C 3 A KNIFE HAS BEEN THROWN (FIRST SET ALWAYS MISSES)
- C 3+ DWARVES ARE MAD (INCREASES THEIR ACCURACY)
- C SIXTH DWARF IS SPECIAL (THE PIRATE). HE ALWAYS STARTS AT HIS CHEST'S
- C EVENTUAL LOCATION INSIDE THE MAZE. THIS LOC IS SAVED IN CHLOC FOR REF.
- C THE DEAD END IN THE OTHER MAZE HAS ITS LOC STORED IN CHLOC2.
-
- 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 OTHER RANDOM FLAGS AND COUNTERS, AS FOLLOWS:
- C TURNS TALLIES HOW MANY COMMANDS HE'S GIVEN (IGNORES YES/NO)
- C LIMIT LIFETIME OF LAMP (NOT SET HERE)
- C IWEST HOW MANY TIMES HE'S SAID "WEST" INSTEAD OF "W"
- C KNFLOC 0 IF NO KNIFE HERE, LOC IF KNIFE HERE, -1 AFTER CAVEAT
- C DETAIL HOW OFTEN WE'VE SAID "NOT ALLOWED TO GIVE MORE DETAIL"
- C ABBNUM HOW OFTEN WE SHOULD PRINT NON-ABBREVIATED DESCRIPTIONS
- C MAXDIE NUMBER OF REINCARNATION MESSAGES AVAILABLE (UP TO 5)
- C NUMDIE NUMBER OF TIMES KILLED SO FAR
- C HOLDNG NUMBER OF OBJECTS BEING CARRIED
- C DKILL NUMBER OF DWARVES KILLED (UNUSED IN SCORING, NEEDED FOR MSG)
- C FOOBAR CURRENT PROGRESS IN SAYING "FEE FIE FOE FOO"
- C BONUS USED TO DETERMINE AMOUNT OF BONUS IF HE REACHES CLOSING
- C CLOCK1 NUMBER OF TURNS FROM FINDING LAST TREASURE TILL CLOSING
- C CLOCK2 NUMBER OF TURNS FROM FIRST WARNING TILL BLINDING FLASH
- C LOGICALS WERE EXPLAINED EARLIER
-
- TURNS=0
- LMWARN=.FALSE.
- IWEST=0
- KNFLOC=0
- DETAIL=0
- ABBNUM=5
- DO 1800 I=0,4
- 1800 IF(RTEXT(2*I+81).NE.0) MAXDIE=I+1
- NUMDIE=0
- HOLDNG=0
- DKILL=0
- FOOBAR=0
- BONUS=0
- CLOCK1=30
- CLOCK2=50
- SAVED=0
- CLOSNG=.FALSE.
- PANIC=.FALSE.
- CLOSED=.FALSE.
- GAVEUP=.FALSE.
- SCORNG=.FALSE.
-
- C IF SETUP=1, REPORT ON AMOUNT OF ARRAYS ACTUALLY USED, TO PERMIT REDUCTIONS.
-
- IF(SETUP.NE.1) GOTO 1
- SETUP=2
-
- DO 1998 K=1,LOCSIZ
- KK=LOCSIZ+1-K
- IF(LTEXT(KK).NE.0) GOTO 1997
- 1998 CONTINUE
-
- OBJ=0
- 1997 DO 1996 K=1,100
- 1996 IF(PTEXT(K).NE.0) OBJ=OBJ+1
-
- DO 1995 K=1,TABNDX
- 1995 IF(KTAB(K)/1000.EQ.2) VERB=KTAB(K)-2000
-
- DO 1994 K=1,RTXSIZ
- J=RTXSIZ+1-K
- IF(RTEXT(J).NE.0) GOTO 1993
- 1994 CONTINUE
-
- 1993 DO 1992 K=1,MAGSIZ
- I=MAGSIZ+1-K
- IF(MTEXT(I).NE.0) GOTO 1991
- 1992 CONTINUE
-
- 1991 K=100
- C TYPE 1999,LINUSE,LINSIZ,TRVS,TRVSIZ,TABNDX,TABSIZ,KK,
- C 1 LOCSIZ,OBJ,K,VERB,VRBSIZ,J,RTXSIZ,CLSSES,CLSMAX,
- C 2 HNTMAX,HNTSIZ,I,MAGSIZ
- 1999 FORMAT (' TABLE SPACE USED:'/
- 1 ' ',I6,' OF ',I6, ' WORDS OF MESSAGES'/
- 2 ' ',I6,' OF ',I6, ' TRAVEL OPTONS'/
- 3 ' ',I6,' OF ',I6, ' VOCABULARY WORDS'/
- 4 ' ',I6,' OF ',I6, ' LOCATIONS'/
- 5 ' ',I6,' OF ',I6, ' OBJECTS'/
- 6 ' ',I6,' OF ',I6, ' ACTION VERBS'/
- 7 ' ',I6,' OF ',I6, ' RTEXT MESSAGES'/
- 8 ' ',I6,' OF ',I6, ' CLASS MESSAGES'/
- 9 ' ',I6,' OF ',I6, ' HINTS'/
- 1 ' ',I6,' OF ',I6, ' MAGIC MESSAGES'/
- 2 )
-
- C FINALLY, SINCE WE'RE CLEARLY SETTING THINGS UP FOR THE FIRST TIME...
-
- CALL POOF
- LOC=1
- C PAUSE 'INIT DONE'
- 1 CLOSE(UNIT=1)
- RETURN
- END
-