File INITAD.FT (FORTRAN source file)

Directory of image this file is from
This file as a plain text file

C  ADVENTURES
	SUBROUTINE INIT
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, ITRSIZ).
C	300 VOCABULARY WORDS (KTAB, ATAB, ITBSIZ).
C	150 LOCATIONS (LTEXT, STEXT, KEY, COND, ABB, IATLOC, LOCSIZ).
C	100 IOBJECTS (PLAC, IPLACE, FIXD, FIXED, LINK (TWICE), PTEXT, PROP).
C	 35 "ACTION" IVERBS (ACTSPK, IVRBSZ).
C	205 RANDOM MESSAGES (IRTEXT, IRTXSZ).
C	 12 DIFFERENT PLAYER CLASSIFICATIONS (CTEXT, CVAL, ICLSMX).
C	 20 HINTS, LESS 3 (HINTLC, HINTED, HINTS, IHNTSZ).
C	[MAGIC MESSAGES HAVE BEEN DECOMMITTED]
C	 35 MAGIC MESSAGES (MTEXT, MAGSIZ).
C  THERE ARE ALSO LIMITS WHICH CANNOT BE EXCEEDED DUE TO THE STRUCTURE OF
C  THE DATABASE.  (E.G., THE VOCABULARY USES N/1000 TO DETERMINE WORD TYPE,
C  SO THERE CAN'T BE MORE THAN 1000 WORDS.)  THESE UPPER LIMITS ARE:
C	1000 NON-SYNONYMOUS VOCABULARY WORDS
C	300 LOCATIONS
C	100 IOBJECTS
C
C	IMPLICIT INTEGER (A-Z)
	LOGICAL DSEEN,HINTED
	LOGICAL BITSET,LMWARN,CLOSNG,PANIC,
     1	       CLOSED,GAVEUP,SCORNG
C
	INTEGER VOCAB
	COMMON /TXTCOM/ IRTEXT,LINES,IASCVR,TXTLOC,DATA
	COMMON /VOCCOM/ KTAB,ATAB,ITBSIZ
	COMMON /PLACOM/ IATLOC,LINK,IPLACE,FIXED,IHLDNG
C	COMMON /MTXCOM/ MTEXT
	COMMON /PTXCOM/ PTEXT
	COMMON /ABBCOM/ ABB
	COMMON /MISCOM/ LINUSE,ITRVS,ICLSES,IOLDLC,LOC,CVAL,TK,NEWLOC,
     1	KEY,PLAC,FIXD,ACTSPK,COND,HINTS,MAXHNT,PROP,KTALY,KTALY2,
     2	HINTLC,ICHLC,ICHLC2,DSEEN,KDFLAG,DLOC,LCDALT,KEYS,LAMP,IGRATE,
     3	ICAGE,IROD,IROD2,ISTEPS,IBIRD,IDOOR,IPILOW,ISNAKE,IFISUR,ITABLT
	COMMON /MISCOM/
     4	ICLAM,IOYSTR,MAGZIN,IDWARF,KNIFE,IFOOD,IBOTLE,IWATER,IOIL,IPLANT,
     5	IPLNT2,IAXE,MIRROR,IDRAGN,ICHASM,ITROL,ITROL2,IBEAR,MESSAG,IVEND,
     6	IBATER,NUGGET,ICOINS,ICHEST,IEGGS,ITRDNT,IVASE,IEMRLD,IPYRAM
	COMMON /MISCOM/
     7	IPEARL,IRUG,CHAIN,IBACK,LOOK,ICAVE,NULL,IENTRC,IDPRSN,ISAY,LOCK,
     8	ITHROW,IFIND,INVENT,ITURNS,LMWARN,KNFLOC,IDTAIL,IABNUM,
     9	NUMDIE,MAXDIE,IDKILL,IFOOBR,IBONUS,ICLOK1,ICLOK2,
     1	CLOSNG,PANIC,CLOSED,GAVEUP,SCORNG,ODLOC,ISTREM
	COMMON /MISC2/ I,IRTXSZ,ICLSMX,MAGSIZ,LOCSIZ,CTEXT,STEXT,LTEXT,
     1	ISECT,TRAVEL,TRVPOS,ITRSIZ,ITBNDX,IOBJ,J,K,IVERB,IHNTSZ,
     2	MAXTRS,HINTED,IHNTLC,KK
	COMMON /NUMCOM/ ISEED
C
	INTEGER LINES(12),DATA(52),RECORD

	INTEGER TRAVEL(750),TRVPOS(750)
	INTEGER KTAB(300),ATAB(300)
	INTEGER LTEXT(150),STEXT(150),KEY(150),COND(150),ABB(150),
     1		IATLOC(150)
	INTEGER PLAC(100),IPLACE(100),FIXD(100),FIXED(100),LINK(200),
     1		PTEXT(100),PROP(100)
	INTEGER ACTSPK(35)
	INTEGER IRTEXT(205)
	INTEGER CTEXT(12),CVAL(12)
	INTEGER HINTLC(20),HINTS(20,4)
	DIMENSION HINTED(20)
C	DIMENSION MTEXT(35)
	INTEGER TK(20),DLOC(6),ODLOC(6)
	DIMENSION DSEEN(6)
C
C
C	ISHFT(NUMBER,IPOSIT)=NUMBER*(2**IPOSIT)
C	BITSET(L,N)=(COND(L).AND.ISHFT(1,N)).NE.0

C DESCRIPTION OF THE DATABASE FORMAT C C C THE DATA FILE CONTAINS SEVERAL ISECTIONS. EACH BEGINS WITH A LINE CONTAINING C A NUMBER IDENTIFYING THE ISECTION, AND ENDS WITH A LINE CONTAINING "-1". C C ISECTION 1: LONG FORM DESCRIPTIONS. EACH LINE CONTAINS A LOCATION NUMBER, C A COMMA, AND A LINE OF TEXT. THE SET OF (NECESSARILY ADJACENT) LINES C WHOSE NUMBERS ARE X FORM THE LONG DESCRIPTION OF LOCATION X. C ISECTION 2: SHORT FORM DESCRIPTIONS. SAME FORMAT AS LONG FORM. NOT ALL C IPLACES HAVE SHORT DESCRIPTIONS. C ISECTION 3: TRAVEL TABLE. EACH LINE CONTAINS A LOCATION NUMBER (X), A SECOND C LOCATION NUMBER (Y), AND A LIST OF MOTION NUMBERS (SEE ISECTION 4). C EACH MOTION REPRESENTS A IVERB 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 ISECTION OF SPECIAL CODE. C IF N>500 MESSAGE N-500 FROM ISECTION 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 IOBJECT 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* CONDITIONS, C IN WHICH CASE THE NEXT IS FOUND, ETC.). TYPICALLY, THE NEXT DEST WILL C BE FOR ONE OF THE SAME IVERBS, SO THAT ITS ONLY USE IS AS THE ALTERNATE C DESTINATION FOR THOSE IVERBS. FOR INSTANCE: C 15 110022 29 31 34 35 23 43 C 15 14 29 C THIS ISAYS THAT, FROM LOC 15, ANY OF THE IVERBS 29, 31, ETC., WILL TAKE C HIM TO 22 IF HE'S CARRYING IOBJECT 10, AND OTHERWISE WILL GO TO 14. C 11 303008 49 C 11 9 50 C THIS ISAYS THAT, FROM 11, 49 TAKES HIM TO 8 UNLESS PROP(3)=0, IN WHICH C CASE HE GOES TO 9. IVERB 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 ISECTION 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 MOTION C IVERB FOR USE IN TRAVELLING (SEE ISECTION 3). ELSE, IF M=1, THE WORD IS C AN IOBJECT. ELSE, IF M=2, THE WORD IS AN ACTION IVERB (SUCH AS "CARRY" C OR "ATTACK"). ELSE, IF M=3, THE WORD IS A SPECIAL CASE IVERB (SUCH AS C "DIG") AND N MOD 1000 IS AN INDEX INTO ISECTION 6. IOBJECTS FROM 50 TO C (CURRENTLY, ANYWAY) 79 ARE CONSIDERED TREASURES (FOR PIRATE, CLOSEOUT). C ISECTION 5: IOBJECT DESCRIPTIONS. EACH LINE CONTAINS A NUMBER (N), A TAB, C AND A MESSAGE. IF N IS FROM 1 TO 100, THE MESSAGE IS THE "INVENTORY" C MESSAGE FOR IOBJECT N. OTHERWISE, N SHOULD BE 000, 100, 200, ETC., AND C THE MESSAGE SHOULD BE THE DESCRIPTION OF THE PRECEDING IOBJECT WHEN ITS C PROP VALUE IS N/100. THE N/100 IS USED ONLY TO DISTINGUISH MULTIPLE C MESSAGES FROM MULTI-LINE MESSAGES; THE PROP INFO ACTUALLY REQUIRES ALL C MESSAGES FOR AN IOBJECT TO BE PRESENT AND CONSECUTIVE. PROPERTIES WHICH C PIRODUCE NO MESSAGE SHOULD BE GIVEN THE MESSAGE ">$<". C ISECTION 6: ARBITRARY MESSAGES. SAME FORMAT AS ISECTIONS 1, 2, AND 5, EXCEPT C THE NUMBERS IBEAR NO RELATION TO ANYTHING (EXCEPT FOR SPECIAL IVERBS C IN ISECTION 4). C ISECTION 7: IOBJECT LOCATIONS. EACH LINE CONTAINS AN IOBJECT NUMBER AND ITS C INITIAL LOCATION (ZERO (OR OMITTED) IF NONE). IF THE IOBJECT IS C IMMOVABLE, THE LOCATION IS FOLLOWED BY A "-1". IF IT HAS TWO LOCATIONS C (E.G. THE IGRATE) THE FIRST LOCATION IS FOLLOWED WITH THE SECOND, AND C THE IOBJECT IS ASSUMED TO BE IMMOVABLE. C ISECTION 8: ACTION DEFAULTS. EACH LINE CONTAINS AN "ACTION-IVERB" NUMBER AND C THE INDEX (IN ISECTION 6) OF THE DEFAULT MESSAGE FOR THE IVERB. C ISECTION 9: LIQUID ASSETS, ETC. EACH LINE CONTAINS A NUMBER (N) AND UP TO 20 C LOCATION NUMBERS. BIT N (WHERE 0 IS THE UNITS BIT) IS SET IN COND(LOC) C FOR EACH LOC GIVEN. THE COND BITS CURRENTLY ASSIGNED ARE: C 0 LIGHT C 1 IF BIT 2 IS ON: ON FOR IOIL, OFF FOR IWATER C 2 LIQUID ASSET, SEE BIT 1 C 3 PIRATE DOESN'T GO HERE UNLESS FOLLOWING PLAYER C OTHER BITS ARE USED TO INDICATE AREAS OF INTEREST TO "HINT" ROUTINES: C 4 TRYING TO GET INTO ICAVE C 5 TRYING TO CATCH IBIRD C 6 TRYING TO DEAL WITH ISNAKE C 7 LOST IN MAZE C 8 PONDERING DARK ROOM C 9 AT WITT'S END C COND(LOC) IS SET TO 2, OVERRIDING ALL OTHER BITS, IF LOC HAS FORCED C MOTION. C ISECTION 10: CLASS MESSAGES. EACH LINE CONTAINS A NUMBER (N), A TAB, AND A C MESSAGE DESCRIBING A CLASSIFICATION OF PLAYER. THE SCORING ISECTION C SELECTS THE APPROPRIATE MESSAGE, WHERE EACH MESSAGE IS CONSIDERED TO C APPLY TO PLAYERS WHOSE SCORES ARE HIGHER THAN THE PREVIOUS N BUT NOT C HIGHER THAN THIS N. NOTE THAT THESE SCORES PROBABLY CHANGE WITH EVERY C MODIFICATION (AND PARTICULARLY EXPANSION) OF THE PROGRAM. C ISECTION 11: HINTS. EACH LINE CONTAINS A HINT NUMBER (CORRESPONDING TO A C COND BIT, SEE ISECTION 9), THE NUMBER OF ITURNS HE MUST BE AT THE RIGHT C LOC(S) BEFORE TRIGGERING THE HINT, THE POINTS DEDUCTED FOR TAKING THE C HINT, THE MESSAGE NUMBER (ISECTION 6) OF THE QUESTION, AND THE MESSAGE C NUMBER OF THE HINT. THESE VALUES ARE STASHED IN THE "HINTS" ARRAY. C MAXHNT IS SET TO THE MAX HINT NUMBER (<= IHNTSZ). 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 ITURNS, BUT LOSES C POINTS). C ISECTION 12: MAGIC MESSAGES. IDENTICAL TO ISECTION 6 EXCEPT PUT IN A SEPARATE C ISECTION FOR EASIER REFERENCE. MAGIC MESSAGES ARE USED BY THE STARTUP, C MAINTENANCE MODE, AND RELATED ROUTINES. C ISECTION 0: END OF DATABASE.
C READ THE DATABASE IF WE HAVE NOT YET DONE SO C ISEED=0 IFLSIZ=250 ITBSIZ=300 LOCSIZ=150 IVRBSZ=35 IRTXSZ = 205 IHNTSZ = 20 MAGSIZ = 35 ITRSIZ = 750 ICLSMX = 12 C IVCNT = 0 CDEBUG WRITE(4,1000) CDEBUG1000 FORMAT(' INITIALIZING...') C C CLEAR OUT THE VARIOUS TEXT-POINTER ARRAYS. ALL TEXT IS STORED IN 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. IRTEXT CONTAINS C ISECTION 6'S STUFF. CTEXT(N) POINTS TO A PLAYER-CLASS MESSAGE. MTEXT IS FOR C ISECTION 12. WE ALSO CLEAR COND. SEE DESCRIPTION OF ISECTION 9 FOR IDTAILS. C DO 1001 I=1,ITBSIZ KTAB(I)=0 ATAB(I)=0 A2TAB(I)=0 IF(I.GT.100) GO TO 1990 PTEXT(I)=0 PROP(I)=0 PLAC(I)=0 IPLACE(I)=0 FIXD(I)=0 FIXED(I)=0 LINK(I)=0 LINK(I+100)=0 1990 IF(I.LE.IRTXSZ)IRTEXT(I)=0 IF(I.LE.ICLSMX)CTEXT(I)=0 C IF(I.LE.MAGSIZ)MTEXT(I)=0 IF(I.LE.IVRBSZ)ACTSPK(I)=0 IF(I.GT.LOCSIZ)GOTO 1001 KEY(I)=0 ABB(I)=0 IATLOC(I)=0 STEXT(I)=0 LTEXT(I)=0 COND(I)=0 1001 CONTINUE C DEFINE FILE 2(IFLSIZ,52,U,RECORD) RECORD=1 IASCVR = 1 LINUSE=1 ITRVS=1 ICLSES=1 C C START NEW DATA ISECTION. ISECT IS THE ISECTION NUMBER. C 1002 READ(1,1003)ISECT 1003 FORMAT(I5) CDEBUG WRITE(4,930)ISECT CDEBUG930 FORMAT(' NOW LOADING ISECTION',I3) IOLDLC=-1 GOTO(1100,1004,1004,1030,1040,1004,1004,1050,1060,1070,1004, 1 1080,1004) (ISECT+1) C (0) (1) (2) (3) (4) (5) (6) (7) (8) (9) (10) C (11) (12) CALL BUG(9) C C ISECTIONS 1, 2, 5, 6, 10, 12. READ MESSAGES AND SET UP POINTERS. C 1004 READ(1,1005) LOC,LINES 1005 FORMAT(I4,12A6) C WRITE(2'IASCVR) LOC,LINES MULT=13*MOD(IASCVR-1,4)+1 DATA(MULT)=LOC DO 1006 I=1,12 1006 DATA(I+MULT)=LINES(I) IASCVR=IASCVR+1 IF(MOD(IASCVR,4) .EQ. 0)WRITE(2'RECORD)DATA 1007 LINUSE = IASCVR-1 IF(LOC .EQ. -1) GO TO 1002 IF(LOC .EQ. IOLDLC) GO TO 1020 IF(ISECT.EQ.12)GOTO 1013 IF(ISECT.EQ.10)GOTO 1012 IF(ISECT.EQ.6)GOTO 1011 IF(ISECT.EQ.5)GOTO 1010 IF(ISECT.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. IRTXSZ) CALL BUG(6) IRTEXT(LOC)=LINUSE GOTO 1020 C 1012 CTEXT(ICLSES)=LINUSE CVAL(ICLSES)=LOC ICLSES=ICLSES+1 GOTO 1020 C 1013 CONTINUE C IF(LOC.GT.MAGSIZ)CALL BUG(6) C MTEXT(LOC)=LINUSE C 1020 IOLDLC = LOC IF(RECORD .GE. IFLSIZ) CALL BUG(2) GOTO 1004 C C THE STUFF FOR ISECTION 3 IS ENCODED HERE. EACH "FROM-LOCATION" GETS A C CONTIGUOUS ISECTION OF THE "TRAVEL" ARRAY. EACH ENTRY IN TRAVEL IS C KEYWORD (FROM ISECTION 4, MOTION IVERBS), AND IS NEGATED IF C THIS IS THE LAST ENTRY FOR THIS LOCATION. KEY(N) IS THE INDEX IN TRAVEL C OF THE FIRST OPTION AT LOCATION N. C 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)LOC,J,NEWLOC,TK 1031 FORMAT(99I6) IF(LOC.EQ.-1)GOTO 1002 IF(KEY(LOC).NE.0)GOTO 1033 KEY(LOC)=ITRVS GOTO 1035 1033 TRAVEL(ITRVS-1)=-TRAVEL(ITRVS-1) 1035 DO 1037 L=1,20 IF(TK(L).EQ.0)GOTO 1039 TRAVEL(ITRVS)=TK(L) TRVPOS(ITRVS)=NEWLOC+1000*J ITRVS=ITRVS+1 IF(ITRVS.EQ.ITRSIZ)CALL BUG(3) 1037 CONTINUE 1039 TRAVEL(ITRVS-1)=-TRAVEL(ITRVS-1) GOTO 1030 C C HERE WE READ IN THE VOCABULARY. KTAB(N) IS THE WORD NUMBER, ATAB(N) IS C THE CORRESPONDING WORD. THE -1 AT THE END OF ISECTION 4 IS LEFT IN KTAB C AS AN END-MARKER. C 1040 DO 1042 ITBNDX=1,ITBSIZ 1043 READ(1,1041)KTAB(ITBNDX),ATAB(ITBNDX) 1041 FORMAT(I6,A4) IF(KTAB(ITBNDX).EQ.-1)GOTO 1002 1042 CONTINUE CALL BUG(4) C C READ IN THE INITIAL LOCATIONS FOR EACH IOBJECT. ALSO THE IMMOVABILITY INFO. C PLAC CONTAINS INITIAL LOCATIONS OF IOBJECTS. FIXD IS -1 FOR IMMOVABLE C IOBJECTS (INCLUDING THE ISNAKE), OR = SECOND LOC FOR TWO-IPLACED IOBJECTS. C 1050 READ(1,1031)IOBJ,J,K IF(IOBJ.EQ.-1)GOTO 1002 PLAC(IOBJ)=J FIXD(IOBJ)=K GOTO 1050 C C READ DEFAULT MESSAGE NUMBERS FOR ACTION IVERBS, STORE IN ACTSPK. C 1060 READ(1,1031)IVERB,J IF(IVERB.EQ.-1)GOTO 1002 ACTSPK(IVERB)=J IVCNT=MAX0(IVERB,IVCNT) GOTO 1060 C C READ INFO ABOUT AVAILABLE LIQUIDS AND OTHER CONDITIONS, STORE IN COND. C 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) COND(LOC)=COND(LOC)+2**K 1071 CONTINUE GOTO 1070 C C READ DATA FOR HINTS. C 1080 MAXHNT=0 1081 READ(1,1031)K,TK IF(K.EQ.-1)GOTO 1002 IF(K.LT.0.OR.K.GT.IHNTSZ)CALL BUG(7) DO 1083 I=1,4 1083 HINTS(K,I)=TK(I) MAXHNT=MAX0(MAXHNT,K) GOTO 1081
C FINISH CONSTRUCTING INTERNAL DATA FORMAT C 1100 CONTINUE C 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 IATLOC(N) AS THE FIRST C IOBJECT AT LOCATION N, AND LINK(IOBJ) AS THE NEXT IOBJECT AT THE SAME LOCATION C AS IOBJ. (IOBJ>100 INDICATES THAT FIXED(IOBJ-100)=LOC; LINK(IOBJ) IS STILL THE C CORRECT LINK TO USE.) ABB IS ZEROED; IT CONTROLS WHETHER THE ABBREVIATED C DESCRIPTION IS PRINTED. COUNTS MOD 5 UNLESS "LOOK" IS USED. C C C IF THE FIRST MOTION IVERB 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 IATLOC AND LINK ARRAYS AS DESCRIBED ABOVE. WE'LL USE THE DROP C SUBROUTINE, WHICH PREFACES NEW IOBJECTS ON THE LISTS. SINCE WE WANT THINGS C IN THE OTHER ORDER, WE'LL RUN THE LOOP IBACKWARDS. IF THE IOBJECT IS IN TWO C LOCS, WE DROP IT TWICE. THIS ALSO SETS UP "IPLACE" AND "FIXED" AS COPIES OF C "PLAC" AND "FIXD". ALSO, SINCE TWO-IPLACED IOBJECTS 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 IOBJECTS 50 THROUGH MAXTRS (CURRENTLY 79). C THEIR PROPS ARE INITIALLY -1, AND ARE SET TO 0 THE FIRST TIME THEY ARE C DESCRIBED. KTALY KEEPS TRACK OF HOW MANY ARE NOT YET FOUND, SO WE KNOW C WHEN TO CLOSE THE ICAVE. KTALY2 COUNTS HOW MANY CAN NEVER BE FOUND (E.G. IF C LOST IBIRD OR BRIDGE). C MAXTRS=79 KTALY=0 KTALY2=0 DO 1200 I=50,MAXTRS IF(PTEXT(I).NE.0)PROP(I)=-1 1200 KTALY=KTALY-PROP(I) C C CLEAR THE HINT STUFF. HINTLC(I) IS HOW LONG HE'S BEEN AT LOC WITH COND BIT C I. HINTED(I) IS TRUE IFF HINT I HAS BEEN USED. C DO 1300 I=1,MAXHNT HINTED(I)=.FALSE. 1300 HINTLC(I)=0 C CDEBUG WRITE(4,931)ITBNDX,ITBSIZ,IVCNT,IVRBSZ,ICLSES,ICLSMX, CDEBUG 1 MAXHNT,IHNTSZ,ITRVS,ITRSIZ,LINUSE,IFLSIZ CDEBUG931 FORMAT(' USED VS MAX TABLE VALUES:'/ CDEBUG 1 1X,I5,' OF ',I5,' VOCAB ENTRIES'/ CDEBUG 2 1X,I5,' OF ',I5,' IVERB ENTRIES'/ CDEBUG 3 1X,I5,' OF ',I5,' CLASS ENTRIES'/ CDEBUG 4 1X,I5,' OF ',I5,' HINT ENTRIES'/ CDEBUG 5 1X,I5,' OF ',I5,' TRAVEL ENTRIES'/ CDEBUG 6 1X,I5,' OF ',I5,' FILE RECORDS'/) C C DEFINE SOME HANDY MNEMONICS. THESE CORRESPOND TO IOBJECT NUMBERS. C KEYS=VOCAB('KEYS',1) LAMP=VOCAB('LAMP',1) IGRATE=VOCAB('GRAT',1) ICAGE=VOCAB('CAGE',1) IROD=VOCAB('ROD ',1) IROD2=IROD+1 ISTEPS=VOCAB('STEP',1) IBIRD=VOCAB('BIRD',1) IDOOR=VOCAB('DOOR',1) IPILOW=VOCAB('PILL',1) ISNAKE=VOCAB('SNAK',1) IFISUR=VOCAB('FISS',1) ITABLT=VOCAB('TABL',1) ICLAM=VOCAB('CLAM',1) IOYSTR=VOCAB('OYST',1) MAGZIN=VOCAB('MAGA',1) IDWARF=VOCAB('DWAR',1) KNIFE=VOCAB('KNIF',1) IFOOD=VOCAB('FOOD',1) IBOTLE=VOCAB('BOTT',1) IWATER=VOCAB('WATE',1) IOIL=VOCAB('OIL ',1) IPLANT=VOCAB('PLAN',1) IPLNT2=IPLANT+1 IAXE=VOCAB('AXE ',1) MIRROR=VOCAB('MIRR',1) IDRAGN=VOCAB('DRAG',1) ICHASM=VOCAB('CHAS',1) ITROL=VOCAB('TROL',1) ITROL2=ITROL+1 IBEAR=VOCAB('BEAR',1) MESSAG=VOCAB('MESS',1) IVEND=VOCAB('VEND',1) IBATER=VOCAB('BATT',1) C C IOBJECTS FROM 50 THROUGH WHATEVER ARE TREASURES. HERE ARE A FEW. C NUGGET=VOCAB('GOLD',1) ICOINS=VOCAB('COIN',1) ICHEST=VOCAB('CHES',1) IEGGS=VOCAB('EGGS',1) ITRDNT=VOCAB('TRID',1) IVASE=VOCAB('VASE',1) IEMRLD=VOCAB('EMER',1) IPYRAM=VOCAB('PYRA',1) IPEARL=VOCAB('PEAR',1) IRUG=VOCAB('RUG ',1) CHAIN=VOCAB('CHAI',1) C C THESE ARE MOTION-IVERB NUMBERS. C IBACK=VOCAB('BACK',0) LOOK=VOCAB('LOOK',0) ICAVE=VOCAB('CAVE',0) NULL=VOCAB('NULL',0) IENTRC=VOCAB('ENTR',0) IDPRSN=VOCAB('DEPR',0) ISTREM=VOCAB('STRE',0) C C AND SOME ACTION IVERBS. C ISAY=VOCAB('SAY ',2) LOCK=VOCAB('LOCK',2) ITHROW=VOCAB('THRO',2) IFIND=VOCAB('FIND',2) INVENT=VOCAB('INVE',2) C C INITIALISE THE DWARVES. DLOC IS LOC OF DWARVES, HARD-WIRED IN. ODLOC IS C PRIOR LOC OF EACH IDWARF, INITIALLY GARBAGE. LCDALT IS ALTERNATE INITIAL LOC C FOR IDWARF, 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 IDWARF HAS SEEN HIM. C KDFLAG CONTROLS THE LEVEL OF ACTIVATION OF ALL THIS: C 0 NO IDWARF STUFF YET (WAIT UNTIL REACHES HALL OF MISTS) C 1 REACHED HALL OF MISTS, BUT HASN'T MET FIRST IDWARF C 2 MET FIRST IDWARF, OTHERS START MOVING, NO KNIVES ITHROWN YET C 3 A KNIFE HAS BEEN ITHROWN (FIRST SET ALWAYS MISSES) C 3+ DWARVES ARE MAD (INCREASES THEIR ACCURACY) C SIXTH IDWARF IS SPECIAL (THE PIRATE). HE ALWAYS STARTS AT HIS ICHEST'S C EVENTUAL LOCATION INSIDE THE MAZE. THIS LOC IS SAVED IN ICHLC FOR REF. C THE DEAD END IN THE OTHER MAZE HAS ITS LOC STORED IN ICHLC2. C ICHLC=114 ICHLC2=140 DO 1700 I=1,6 1700 DSEEN(I)=.FALSE. KDFLAG=0 DLOC(1)=19 DLOC(2)=27 DLOC(3)=33 DLOC(4)=44 DLOC(5)=64 DLOC(6)=ICHLC LCDALT=18 C C OTHER RANDOM FLAGS AND COUNTERS, AS FOLLOWS: C ITURNS 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 ICAVEAT C IDTAIL HOW OFTEN WE'VE SAID "NOT ALLOWED TO GIVE MORE IDTAIL" C IABNUM 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 IHLDNG NUMBER OF IOBJECTS BEING CARRIED C IDKILL NUMBER OF DWARVES KILLED (UNUSED IN SCORING, NEEDED FOR MSG) C IFOOBR CURRENT PROGRESS IN ISAYING "FEE FIE FOE FOO". C IBONUS USED TO DETERMINE AMOUNT OF IBONUS IF HE REACHES CLOSING C ICLOK1 NUMBER OF ITURNS FROM IFINDING LAST TREASURE TILL CLOSING C ICLOK2 NUMBER OF ITURNS FROM FIRST WARNING TILL BLINDING FLASH C LOGICALS WERE EXPLAINED EARLIER C ITURNS=0 LMWARN=.FALSE. KNFLOC=0 IDTAIL=0 IABNUM=5 DO 1800 I=0,4 1800 IF(IRTEXT(2*I+81).NE.0)MAXDIE=I+1 NUMDIE=0 IHLDNG=0 IDKILL=0 IFOOBR=0 IBONUS=0 ICLOK1=30 ICLOK2=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 CDEBUG PAUSE 'INIT DONE' 1 IF(MOD(IASCVR,4).NE.0)WRITE(2'RECORD)DATA RETURN END



Feel free to contact me, David Gesswein djg@pdp8online.com with any questions, comments on the web site, or if you have related equipment, documentation, software etc. you are willing to part with.  I am interested in anything PDP-8 related, computers, peripherals used with them, DEC or third party, or documentation. 

PDP-8 Home Page   PDP-8 Site Map   PDP-8 Site Search