C SUBROUTINES FOR ADVENTURE C C MODIFIED FOR PDP-11 FORTRAN IV BY C C R. SUPNIK C DISK ENGINEERING C SUBROUTINE A5TOA1(A,B,C,D) C C THIS ROUTINE TAKES THE UP TO 6 CHARACTER "WORD" IN A:B:C C AND TYPES IT OUT, FOLLOWED BY THE PUNCTUATION MARK IN D. C IT ALSO APPENDS A CRLF TO GET TO A NEW LINE. C IMPLICIT INTEGER (A-Z) COMMON /ALPHAS/ BLANK C IF(A .NE. BLANK) TYPE 1,A IF(B .NE. BLANK) TYPE 1,B IF(C .NE. BLANK) TYPE 1,C TYPE 2,D RETURN C 1 FORMAT('+',A2,$) 2 FORMAT('+',A2) C END C DATA STRUCTURE ROUTINES (VOCAB, DSTROY, JUGGLE, MOVE, PUT, CARRY, DROP) C C SUBROUTINE VOCAB(ID1,ID2,INIT,V) C C LOOK UP ID1:ID2 IN THE VOCABULARY (ATAB AND A2TAB) 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 MEANS C THAT ONLY KTAB VALUES WHICH TAKEN OVER 1000 EQUAL INIT MAY BE CONSIDERED. C (THUS "STEPS", WHICH IS A MOTION VERB AS WELL AS AN OBJECT, MAY BE LOCATED C AS AN OBJECT.) AND IT ALSO MEANS THE KTAB VALUE IS TAKEN MOD 1000. C IMPLICIT INTEGER (A-Z) COMMON /VOCCOM/ KTAB,ATAB,A2TAB,TABSIZ DIMENSION KTAB(350),ATAB(350),A2TAB(350) 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 .AND. A2TAB(I).EQ.ID2)GOTO 3 1 CONTINUE CALL BUG(21) C 2 V=-1 IF(INIT.LT.0)RETURN TYPE 100,ID1,ID2 100 FORMAT(' KEYWORD = ',2A2) 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 PURPOSE C BEING TO GET THE OBJECT TO THE FRONT OF THE CHAIN OF THINGS AT ITS LOC. 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 ALREADY BE C TOTING, IN WHICH CASE THE CARRY IS A NO-OP. MUSTN'T PICK UP OBJECTS WHICH C ARE NOT AT ANY LOC, SINCE CARRY WANTS TO REMOVE OBJECTS FROM ATLOC CHAINS. 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 PUT(OBJECT,WHERE,PVAL) C C PUT IS THE SAME AS MOVE, EXCEPT IT RETURNS A VALUE USED TO SET UP THE C NEGATED PROP VALUES FOR THE REPOSITORY OBJECTS. C IMPLICIT INTEGER (A-Z) C CALL MOVE(OBJECT,WHERE) PUT=(-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 FORMER C LOCATION. INCR HOLDNG UNLESS IT WAS ALREADY BEING TOTED. IF OBJECT>100 C (MOVING "FIXED" SECOND LOC), DON'T CHANGE PLACE OR HOLDNG. 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. DECR 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 SUBROUTINE BUG(NUM) IMPLICIT INTEGER (A-Z) C C THE FOLLOWING CONDITIONS ARE CURRENTLY CONSIDERED FATAL BUGS. NUMBERS < 20 C ARE DETECTED WHILE READING THE DATABASE; THE OTHERS OCCUR AT "RUN TIME". C 0 MESSAGE LINE > 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 10 INVALID ACTSPK (VERB) NUMBER C 11 TOO MANY LOCATION (LTEXT OR STEXT) ENTRIES C 12 TOO MANY PLAYER CLASSES C 13 INVALID OBJECT NUMBER C 20 SPECIAL TRAVEL (500>L>300) EXCEEDS GOTO LIST C 21 RAN OFF END OF VOCABULARY TABLE C 22 VOCABULARY TYPE (N/1000) NOT BETWEEN 0 AND 3 C 23 INTRANSITIVE ACTION VERB EXCEEDS GOTO LIST C 24 TRANSITIVE ACTION VERB EXCEEDS GOTO LIST C 25 CONDITIONAL TRAVEL ENTRY WITH NO ALTERNATIVE C 26 LOCATION HAS NO TRAVEL ENTRIES C 27 HINT NUMBER EXCEEDS GOTO LIST C 28 INVALID MONTH RETURNED BY DATE FUNCTION C TYPE 1, NUM 1 FORMAT (' Fatal error ',i3,', consult your local wizard.'/) STOP END C SUBROUTINE INIRND(I,J) IMPLICIT INTEGER(A-Z) C PULL A FEW NUMBERS FROM THE RANDOM NUMBER GENERATOR M=I*J DO 10, K=1,M,2 X=RND(1) 10 CONTINUE RETURN END C INTEGER FUNCTION RND(RANGE) IMPLICIT INTEGER(A-Z) C C THE SEED FOR THE GENERATOR MUST START AT 126. DATA IRAND/126/ C C THE RETURNED NUMBER IS EVENLY DISTRIBUTED C BETWEEN 0 & 32K C CALL IRANDV (IRAND) RND=IRAND / (32767/RANGE) RETURN END