C  I/O ROUTINES (SPEAK, PSPEAK, RSPEAK, GETIN, YES, A5TOA1)


	SUBROUTINE SPEAK(N)

C  PRINT THE MESSAGE WHICH STARTS AT LINES(N).  PRECEDE IT WITH A BLANK LINE
C  UNLESS BLKLIN IS FALSE.

	IMPLICIT INTEGER(A-Z)
	LOGICAL BLKLIN
	COMMON /TXTCOM/ RTEXT,LINES
	COMMON /BLKCOM/ BLKLIN
	DIMENSION RTEXT(205),LINES(9650)

	IF(N.EQ.0)RETURN
	IF(LINES(N+1).EQ.'>$<')RETURN
	IF(BLKLIN)TYPE 2
	K=N
1	L=IABS(LINES(K))-1
	K=K+1
	TYPE 2,(LINES(I),I=K,L)
2	FORMAT(' ',14A5)
	K=L+1
	IF(LINES(K).GE.0)GOTO 1
	RETURN
	END



	SUBROUTINE PSPEAK(MSG,SKIP)

C  FIND THE SKIP+1ST MESSAGE FROM MSG AND PRINT IT.  MSG SHOULD BE THE INDEX OF
C  THE INVENTORY MESSAGE FOR OBJECT.  (INVEN+N+1 MESSAGE IS PROP=N MESSAGE).

	IMPLICIT INTEGER(A-Z)
	COMMON /TXTCOM/ RTEXT,LINES
	COMMON /PTXCOM/ PTEXT
	DIMENSION RTEXT(205),LINES(9650),PTEXT(100)

	M=PTEXT(MSG)
	IF(SKIP.LT.0)GOTO 9
	DO 3 I=0,SKIP
1	M=IABS(LINES(M))
	IF(LINES(M).GE.0)GOTO 1
3	CONTINUE
9	CALL SPEAK(M)
	RETURN
	END



	SUBROUTINE RSPEAK(I)

C  PRINT THE I-TH "RANDOM" MESSAGE (SECTION 6 OF DATABASE).

	IMPLICIT INTEGER(A-Z)
	COMMON /TXTCOM/ RTEXT
	DIMENSION RTEXT(205)

	IF(I.NE.0)CALL SPEAK(RTEXT(I))
	RETURN
	END



	SUBROUTINE MSPEAK(I)

C  PRINT THE I-TH "MAGIC" MESSAGE (SECTION 12 OF DATABASE).

	IMPLICIT INTEGER(A-Z)
	COMMON /MTXCOM/ MTEXT
	DIMENSION MTEXT(35)

	IF(I.NE.0)CALL SPEAK(MTEXT(I))
	RETURN
	END



	SUBROUTINE GETIN(WORD1,WORD1X,WORD2,WORD2X)

C  GET A COMMAND FROM THE ADVENTURER.  SNARF OUT THE FIRST WORD, PAD IT WITH
C  BLANKS, AND RETURN IT IN WORD1.  CHARS 6 THRU 10 ARE RETURNED IN WORD1X, IN
C  CASE WE NEED TO PRINT OUT THE WHOLE WORD IN AN ERROR MESSAGE.  ANY NUMBER OF
C  BLANKS MAY FOLLOW THE WORD.  IF A SECOND WORD APPEARS, IT IS RETURNED IN
C  WORD2 (CHARS 6 THRU 10 IN WORD2X), ELSE WORD2 IS SET TO ZERO.

	IMPLICIT INTEGER(A-Z)
	LOGICAL BLKLIN
	COMMON /BLKCOM/ BLKLIN
	DIMENSION A(5),MASKS(6)
	DATA MASKS/"4000000000,"20000000,"100000,"400,"2,0/
	1	,BLANKS/'     '/

	IF(BLKLIN)TYPE 1
1	FORMAT()
2	ACCEPT 3,(A(I),I=1,4)
3	FORMAT(4A5)
	J=0
	DO 9 I=1,4
	IF(A(I).NE.BLANKS)J=1
9	A(I)=A(I).AND.(SHIFT((A(I).AND.'@@@@@'),-1).XOR.-1)
	IF(BLKLIN.AND.J.EQ.0)GOTO 2

	SECOND=0
	WORD1=A(1)
	WORD1X=A(2)
	WORD2=0

	DO 10 J=1,4
	DO 10 K=1,5
	MSK="774000000000
	IF(K.NE.1)MSK="177*MASKS(K)
	IF(((A(J).XOR.BLANKS).AND.MSK).EQ.0)GOTO 15
	IF(SECOND.EQ.3)GOTO 20
	IF(SECOND.NE.1)GOTO 10
	MSK=-MASKS(6-K)
	WORD2=(SHIFT(A(J),7*(K-1)).AND.MSK)
	1	+(SHIFT(A(J+1),7*(K-6)).AND.(-2-MSK))
	WORD2X=(SHIFT(A(J+1),7*(K-1)).AND.MSK)
	1	+(SHIFT(A(J+2),7*(K-6)).AND.(-2-MSK))
	SECOND=2
	GOTO 10

15	IF(SECOND.EQ.2)SECOND=3
	IF(SECOND.NE.0)GOTO 10
	SECOND=1
	IF(J.EQ.1)WORD1=(WORD1.AND.-MASKS(K))
	1	.OR.(BLANKS.AND.(-MASKS(K).XOR.-1))
10	CONTINUE
	RETURN

20	TYPE 21
21	FORMAT(/' PLEASE STICK TO 1- AND 2-WORD COMMANDS.'/)
	GOTO 2
	END



	LOGICAL FUNCTION YES(X,Y,Z)

C  CALL YESX (BELOW) WITH MESSAGES FROM SECTION 6.

	IMPLICIT INTEGER(A-Z)
	EXTERNAL RSPEAK
	LOGICAL YESX

	YES=YESX(X,Y,Z,RSPEAK)
	RETURN
	END



	LOGICAL FUNCTION YESM(X,Y,Z)

C  CALL YESX (BELOW) WITH MESSAGES FROM SECTION 12.

	IMPLICIT INTEGER(A-Z)
	EXTERNAL MSPEAK
	LOGICAL YESX

	YESM=YESX(X,Y,Z,MSPEAK)
	RETURN
	END



	LOGICAL FUNCTION YESX(X,Y,Z,SPK)

C  PRINT MESSAGE X, WAIT FOR YES/NO ANSWER.  IF YES, PRINT Y AND LEAVE YEA
C  TRUE; IF NO, PRINT Z AND LEAVE YEA FALSE.  SPK IS EITHER RSPEAK OR MSPEAK.

	IMPLICIT INTEGER(A-Z)

1	IF(X.NE.0)CALL SPK(X)
	CALL GETIN(REPLY,JUNK1,JUNK2,JUNK3)
	IF(REPLY.EQ.'YES'.OR.REPLY.EQ.'Y')GOTO 10
	IF(REPLY.EQ.'NO'.OR.REPLY.EQ.'N')GOTO 20
	TYPE 9
9	FORMAT(/' PLEASE ANSWER THE QUESTION.')
	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 A5TOA1(A,B,C,CHARS,LENG)

C  A AND B CONTAIN A 1- TO 9-CHARACTER WORD IN A5 FORMAT, C CONTAINS ANOTHER
C  WORD AND/OR PUNCTUATION.  THEY ARE UNPACKED TO ONE CHARACTER PER WORD IN THE
C  ARRAY "CHARS", WITH EXACTLY ONE BLANK BETWEEN B AND C (OR NONE, IF C >= 0).
C  THE INDEX OF THE LAST NON-BLANK CHAR IN CHARS IS RETURNED IN LENG.

	IMPLICIT INTEGER(A-Z)
	DIMENSION CHARS(20),WORDS(3)
	DATA MASK,BLANK/"774000000000,' '/

	WORDS(1)=A
	WORDS(2)=B
	WORDS(3)=C
	POSN=1
	DO 1 WORD=1,3
	IF(WORD.EQ.2.AND.POSN.NE.6)GOTO 1
	IF(WORD.EQ.3.AND.C.LT.0)POSN=POSN+1
	DO 2 CH=1,5
	CHARS(POSN)=(WORDS(WORD).AND.MASK)+(BLANK-(BLANK.AND.MASK))
	IF(CHARS(POSN).EQ.BLANK)GOTO 1
	LENG=POSN
	WORDS(WORD)=SHIFT(WORDS(WORD),7)
2	POSN=POSN+1
1	CONTINUE
	RETURN
	END
C  DATA STRUCTURE ROUTINES (VOCAB, DSTROY, JUGGLE, MOVE, PUT, CARRY, DROP)


	INTEGER FUNCTION VOCAB(ID,INIT)

C  LOOK UP ID IN THE VOCABULARY (ATAB) AND RETURN ITS "DEFINITION" (KTAB), OR
C  -1 IF NOT FOUND.  IF INIT IS POSITIVE, THIS IS AN INITIALISATION 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.

	IMPLICIT INTEGER(A-Z)
	COMMON /VOCCOM/ KTAB,ATAB,TABSIZ
	DIMENSION KTAB(300),ATAB(300)

	HASH=ID.XOR.'PHROG'
	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.HASH)GOTO 3
1	CONTINUE
	CALL BUG(21)

2	VOCAB=-1
	IF(INIT.LT.0)RETURN
	CALL BUG(5)

3	VOCAB=KTAB(I)
	IF(INIT.GE.0)VOCAB=MOD(VOCAB,1000)
	RETURN
	END



	SUBROUTINE DSTROY(OBJECT)

C  PERMANENTLY ELIMINATE "OBJECT" BY MOVING TO A NON-EXISTENT LOCATION.

	IMPLICIT INTEGER(A-Z)

	CALL MOVE(OBJECT,0)
	RETURN
	END



	SUBROUTINE JUGGLE(OBJECT)

C  JUGGLE AN OBJECT BY PICKING IT UP AND PUTTING IT DOWN AGAIN, THE PURPOSE
C  BEING TO GET THE OBJECT TO THE FRONT OF THE CHAIN OF THINGS AT ITS LOC.

	IMPLICIT INTEGER(A-Z)
	COMMON /PLACOM/ ATLOC,LINK,PLACE,FIXED,HOLDNG
	DIMENSION ATLOC(150),LINK(200),PLACE(100),FIXED(100)

	I=PLACE(OBJECT)
	J=FIXED(OBJECT)
	CALL MOVE(OBJECT,I)
	CALL MOVE(OBJECT+100,J)
	RETURN
	END



	SUBROUTINE MOVE(OBJECT,WHERE)

C  PLACE ANY OBJECT ANYWHERE BY PICKING IT UP AND DROPPING IT.  MAY ALREADY BE
C  TOTING, IN WHICH CASE THE CARRY IS A NO-OP.  MUSTN'T PICK UP OBJECTS WHICH
C  ARE NOT AT ANY LOC, SINCE CARRY WANTS TO REMOVE OBJECTS FROM ATLOC CHAINS.

	IMPLICIT INTEGER(A-Z)
	COMMON /PLACOM/ ATLOC,LINK,PLACE,FIXED,HOLDNG
	DIMENSION ATLOC(150),LINK(200),PLACE(100),FIXED(100)

	IF(OBJECT.GT.100)GOTO 1
	FROM=PLACE(OBJECT)
	GOTO 2
1	FROM=FIXED(OBJECT-100)
2	IF(FROM.GT.0.AND.FROM.LE.300)CALL CARRY(OBJECT,FROM)
	CALL DROP(OBJECT,WHERE)
	RETURN
	END



	INTEGER FUNCTION PUT(OBJECT,WHERE,PVAL)

C  PUT IS THE SAME AS MOVE, EXCEPT IT RETURNS A VALUE USED TO SET UP THE
C  NEGATED PROP VALUES FOR THE REPOSITORY OBJECTS.

	IMPLICIT INTEGER(A-Z)

	CALL MOVE(OBJECT,WHERE)
	PUT=(-1)-PVAL
	RETURN
	END



	SUBROUTINE CARRY(OBJECT,WHERE)

C  START TOTING AN OBJECT, REMOVING IT FROM THE LIST OF THINGS AT ITS FORMER
C  LOCATION.  INCR HOLDNG UNLESS IT WAS ALREADY BEING TOTED.  IF OBJECT>100
C  (MOVING "FIXED" SECOND LOC), DON'T CHANGE PLACE OR HOLDNG.

	IMPLICIT INTEGER(A-Z)
	COMMON /PLACOM/ ATLOC,LINK,PLACE,FIXED,HOLDNG
	DIMENSION ATLOC(150),LINK(200),PLACE(100),FIXED(100)

	IF(OBJECT.GT.100)GOTO 5
	IF(PLACE(OBJECT).EQ.-1)RETURN
	PLACE(OBJECT)=-1
	HOLDNG=HOLDNG+1
5	IF(ATLOC(WHERE).NE.OBJECT)GOTO 6
	ATLOC(WHERE)=LINK(OBJECT)
	RETURN
6	TEMP=ATLOC(WHERE)
7	IF(LINK(TEMP).EQ.OBJECT)GOTO 8
	TEMP=LINK(TEMP)
	GOTO 7
8	LINK(TEMP)=LINK(OBJECT)
	RETURN
	END



	SUBROUTINE DROP(OBJECT,WHERE)

C  PLACE AN OBJECT AT A GIVEN LOC, PREFIXING IT ONTO THE ATLOC LIST.  DECR
C  HOLDNG IF THE OBJECT WAS BEING TOTED.

	IMPLICIT INTEGER(A-Z)
	COMMON /PLACOM/ ATLOC,LINK,PLACE,FIXED,HOLDNG
	DIMENSION ATLOC(150),LINK(200),PLACE(100),FIXED(100)
	
	IF(OBJECT.GT.100)GOTO 1
	IF(PLACE(OBJECT).EQ.-1)HOLDNG=HOLDNG-1
	PLACE(OBJECT)=WHERE
	GOTO 2
1	FIXED(OBJECT-100)=WHERE
2	IF(WHERE.LE.0)RETURN
	LINK(OBJECT)=ATLOC(WHERE)
	ATLOC(WHERE)=OBJECT
	RETURN
	END
C  WIZARDRY ROUTINES (START, MAINT, WIZARD, HOURS(X), NEWHRS(X), MOTD, POOF)


	LOGICAL FUNCTION START(DUMMY)

C  CHECK TO SEE IF THIS IS "PRIME TIME".  IF SO, ONLY WIZARDS MAY PLAY, THOUGH
C  OTHERS MAY BE ALLOWED A SHORT GAME FOR DEMONSTRATION PURPOSES.  IF SETUP<0,
C  WE'RE CONTINUING FROM A SAVED GAME, SO CHECK FOR SUITABLE LATENCY.  RETURN
C  TRUE IF THIS IS A DEMO GAME (VALUE IS IGNORED FOR RESTARTS).

	IMPLICIT INTEGER(A-Z)
	LOGICAL PTIME,SOON,YESM
	DIMENSION HNAME(4)
	COMMON /WIZCOM/ WKDAY,WKEND,HOLID,HBEGIN,HEND,HNAME,
	1	SHORT,MAGIC,MAGNM,LATNCY,SAVED,SAVET,SETUP

C  FIRST FIND OUT WHETHER IT IS PRIME TIME (SAVE IN PTIME) AND, IF RESTARTING,
C  WHETHER IT'S TOO SOON (SAVE IN SOON).  PRIME-TIME SPECS ARE IN WKDAY, WKEND,
C  AND HOLID; SEE MAINT ROUTINE FOR DETAILS.  LATNCY IS REQUIRED DELAY BEFORE
C  RESTARTING.  WIZARDS MAY CUT THIS TO A THIRD.

	CALL DATIME(D,T)
	PRIMTM=WKDAY
	IF(MOD(D,7).LE.1)PRIMTM=WKEND
	IF(D.GE.HBEGIN.AND.D.LE.HEND)PRIMTM=HOLID
	PTIME=(PRIMTM.AND.SHIFT(1,T/60)).NE.0
	SOON=.FALSE.
	IF(SETUP.GE.0)GOTO 20
	DELAY=(D-SAVED)*1440+(T-SAVET)
	IF(DELAY.GE.LATNCY)GOTO 20
	TYPE 10,DELAY
10	FORMAT(' THIS ADVENTURE WAS SUSPENDED A MERE',I3,' MINUTES AGO.')
	SOON=.TRUE.
	IF(DELAY.GE.LATNCY/3)GOTO 20
	CALL MSPEAK(2)
	STOP

C  IF NEITHER TOO SOON NOR PRIME TIME, NO PROBLEM.  ELSE SPECIFY WHAT'S WRONG.

20	START=.FALSE.
	IF(SOON)GOTO 30
	IF(PTIME)GOTO 25
22	SAVED=-1
	RETURN

C  COME HERE IF NOT RESTARTING TOO SOON (MAYBE NOT RESTARTING AT ALL), BUT IT'S
C  PRIME TIME.  GIVE OUR HOURS AND SEE IF HE'S A WIZARD.  IF NOT, THEN CAN'T
C  RESTART, BUT IF JUST BEGINNING THEN WE CAN OFFER A SHORT GAME.

25	CALL MSPEAK(3)
	CALL HOURS
	CALL MSPEAK(4)
	IF(WIZARD(0))GOTO 22
	IF(SETUP.LT.0)GOTO 33
	START=YESM(5,7,7)
	IF(START)GOTO 22
	STOP 

C  COME HERE IF RESTARTING TOO SOON.  IF HE'S A WIZARD, LET HIM GO (AND NOTE
C  THAT IT THEN DOESN'T MATTER WHETHER IT'S PRIME TIME).  ELSE, TOUGH BEANS.

30	CALL MSPEAK(8)
	IF(WIZARD(0))GOTO 22
33	CALL MSPEAK(9)
	STOP
	END



	SUBROUTINE MAINT

C  SOMEONE SAID THE MAGIC WORD TO INVOKE MAINTENANCE MODE.  MAKE SURE HE'S A
C  WIZARD.  IF SO, LET HIM TWEAK ALL SORTS OF RANDOM THINGS, THEN EXIT SO CAN
C  SAVE TWEAKED VERSION.  SINCE MAGIC WORD MUST BE FIRST COMMAND GIVEN, ONLY
C  THING WHICH NEEDS TO BE FIXED UP IS ABB(1).

	IMPLICIT INTEGER(A-Z)
	LOGICAL YESM,BLKLIN
	DIMENSION HNAME(4),ABB(150)
	COMMON /BLKCOM/ BLKLIN
	COMMON /ABBCOM/ ABB
	COMMON /WIZCOM/ WKDAY,WKEND,HOLID,HBEGIN,HEND,HNAME,
	1	SHORT,MAGIC,MAGNM,LATNCY,SAVED,SAVET,SETUP

	IF(.NOT.WIZARD(0))RETURN
	BLKLIN=.FALSE.
	IF(YESM(10,0,0))CALL HOURS
	IF(YESM(11,0,0))CALL NEWHRS
	IF(.NOT.YESM(26,0,0))GOTO 10
	CALL MSPEAK(27)
	ACCEPT 1,HBEGIN
1	FORMAT(G)
	CALL MSPEAK(28)
	ACCEPT 1,HEND
	CALL DATIME(D,T)
	HBEGIN=HBEGIN+D
	HEND=HBEGIN+HEND-1
	CALL MSPEAK(29)
	ACCEPT 2,HNAME
2	FORMAT(4A5)
10	TYPE 12,SHORT
12	FORMAT(' LENGTH OF SHORT GAME (NULL TO LEAVE AT',I3,'):')
	ACCEPT 1,X
	IF(X.GT.0)SHORT=X
	CALL MSPEAK(12)
	CALL GETIN(X,Y,Y,Y)
	IF(X.NE.' ')MAGIC=X
	CALL MSPEAK(13)
	ACCEPT 1,X
	IF(X.GT.0)MAGNM=X
	TYPE 16,LATNCY
16	FORMAT(' LATENCY FOR RESTART (NULL TO LEAVE AT',I3,'):')
	ACCEPT 1,X
	IF(X.GT.0.AND.X.LT.45)CALL MSPEAK(30)
	IF(X.GT.0)LATNCY=MAX0(45,X)
	IF(YESM(14,0,0))CALL MOTD(.TRUE.)
	SAVED=0
	SETUP=2
	ABB(1)=0
	CALL MSPEAK(15)
	BLKLIN=.TRUE.
	CALL CIAO
	END



	LOGICAL FUNCTION WIZARD(DUMMY)

C  ASK IF HE'S A WIZARD.  IF HE SAYS YES, MAKE HIM PROVE IT.  RETURN TRUE IF HE
C  REALLY IS A WIZARD.

	IMPLICIT INTEGER(A-Z)
	LOGICAL YESM
	DIMENSION HNAME(4),VAL(5)
	COMMON /WIZCOM/ WKDAY,WKEND,HOLID,HBEGIN,HEND,HNAME,
	1	SHORT,MAGIC,MAGNM,LATNCY,SAVED,SAVET,SETUP

	WIZARD=YESM(16,0,7)
	IF(.NOT.WIZARD)RETURN

C  HE SAYS HE IS.  FIRST STEP: DOES HE KNOW ANYTHING MAGICAL?

	CALL MSPEAK(17)
	CALL GETIN(WORD,X,Y,Z)
	IF(WORD.NE.MAGIC)GOTO 99

C  HE DOES.  GIVE HIM A RANDOM CHALLENGE AND CHECK HIS REPLY.

	CALL DATIME(D,T)
	T=T*2+1
	WORD='@@@@@'
	DO 15 Y=1,5
	X=79+MOD(D,5)
	D=D/5
	DO 12 Z=1,X
12	T=MOD(T*1027,1048576)
	VAL(Y)=(T*26)/1048576+1
15	WORD=WORD+SHIFT(VAL(Y),36-7*Y)
	IF(YESM(18,0,0))GOTO 99
	TYPE 18,WORD
18	FORMAT(/1X,A5)
	CALL GETIN(WORD,X,Y,Z)
	CALL DATIME(D,T)
	T=(T/60)*40+(T/10)*10
	D=MAGNM
	DO 19 Y=1,5
	Z=MOD(Y,5)+1
	X=MOD(IABS(VAL(Y)-VAL(Z))*MOD(D,10)+MOD(T,10),26)+1
	T=T/10
	D=D/10
19	WORD=WORD-SHIFT(X,36-7*Y)
	IF(WORD.NE.'@@@@@')GOTO 99

C  BY GEORGE, HE REALLY *IS* A WIZARD!

	CALL MSPEAK(19)
	RETURN

C  AHA!  AN IMPOSTOR!

99	CALL MSPEAK(20)
	WIZARD=.FALSE.
	RETURN
	END



	SUBROUTINE HOURS

C  ANNOUNCE THE CURRENT HOURS WHEN THE CAVE IS OPEN FOR ADVENTURING.  THIS INFO
C  IS STORED IN WKDAY, WKEND, AND HOLID, WHERE BIT SHIFT(1,N) IS ON IFF THE
C  HOUR FROM N:00 TO N:59 IS "PRIME TIME" (CAVE CLOSED).  WKDAY IS FOR
C  WEEKDAYS, WKEND FOR WEEKENDS, HOLID FOR HOLIDAYS.  NEXT HOLIDAY IS FROM
C  HBEGIN TO HEND.

	IMPLICIT INTEGER(A-Z)
	DIMENSION HNAME(4),VAL(5)
	COMMON /WIZCOM/ WKDAY,WKEND,HOLID,HBEGIN,HEND,HNAME

	TYPE 1
1	FORMAT()
	CALL HOURSX(WKDAY,'MON -',' FRI:')
	CALL HOURSX(WKEND,'SAT -',' SUN:')
	CALL HOURSX(HOLID,'HOLID','AYS: ')
	CALL DATIME(D,T)
	IF(HEND.LT.D.OR.HEND.LT.HBEGIN)RETURN
	IF(HBEGIN.GT.D)GOTO 10
	TYPE 5,HNAME
5	FORMAT(/' TODAY IS A HOLIDAY, NAMELY ',4A5)
	RETURN

10	D=HBEGIN-D
	T='DAYS,'
	IF(D.EQ.1)T='DAY, '
	TYPE 15,D,T,HNAME
15	FORMAT(/' THE NEXT HOLIDAY WILL BE IN',I3,' ',A5,' NAMELY ',4A5)
	RETURN
	END



	SUBROUTINE HOURSX(H,DAY1,DAY2)

C  USED BY HOURS (ABOVE) TO PRINT HOURS FOR EITHER WEEKDAYS OR WEEKENDS.

	IMPLICIT INTEGER(A-Z)
	LOGICAL FIRST

	FIRST=.TRUE.
	FROM=-1
	IF(H.NE.0)GOTO 10
	TYPE 2,DAY1,DAY2
2	FORMAT(10X,2A5,'  OPEN ALL DAY')
	RETURN

10	FROM=FROM+1
	IF((H.AND.SHIFT(1,FROM)).NE.0)GOTO 10
	IF(FROM.GE.24)GOTO 20
	TILL=FROM
14	TILL=TILL+1
	IF((H.AND.SHIFT(1,TILL)).EQ.0.AND.TILL.NE.24)GOTO 14
	IF(FIRST)TYPE 16,DAY1,DAY2,FROM,TILL
	IF(.NOT.FIRST)TYPE 18,FROM,TILL
16	FORMAT(10X,2A5,I4,':00 TO',I3,':00')
18	FORMAT(20X,I4,':00 TO',I3,':00')
	FIRST=.FALSE.
	FROM=TILL
	GOTO 10

20	IF(FIRST)TYPE 22,DAY1,DAY2
22	FORMAT(10X,2A5,'  CLOSED ALL DAY')
	RETURN
	END



	SUBROUTINE NEWHRS

C  SET UP NEW HOURS FOR THE CAVE.  SPECIFIED AS INVERSE--I.E., WHEN IS IT
C  CLOSED DUE TO PRIME TIME?  SEE HOURS (ABOVE) FOR DESC OF VARIABLES.

	IMPLICIT INTEGER(A-Z)
	DIMENSION HNAME(4)
	COMMON /WIZCOM/ WKDAY,WKEND,HOLID,HBEGIN,HEND,HNAME

	CALL MSPEAK(21)
	WKDAY=NEWHRX('WEEKD','AYS:')
	WKEND=NEWHRX('WEEKE','NDS:')
	HOLID=NEWHRX('HOLID','AYS:')
	CALL MSPEAK(22)
	CALL HOURS
	RETURN
	END



	INTEGER FUNCTION NEWHRX(DAY1,DAY2)

C  INPUT PRIME TIME SPECS AND SET UP A WORD OF INTERNAL FORMAT.

	IMPLICIT INTEGER(A-Z)

	NEWHRX=0
	TYPE 1,DAY1,DAY2
1	FORMAT(' PRIME TIME ON ',2A5)
10	TYPE 2
2	FORMAT(' FROM:')
	ACCEPT 3,FROM
3	FORMAT(G)
	IF(FROM.LT.0.OR.FROM.GE.24)RETURN
	TYPE 4
4	FORMAT(' TILL:')
	ACCEPT 3,TILL
	TILL=TILL-1
	IF(TILL.LT.FROM.OR.TILL.GE.24)RETURN
	DO 5 I=FROM,TILL
5	NEWHRX=(NEWHRX.OR.SHIFT(1,I))
	GOTO 10
	END



	SUBROUTINE MOTD(ALTER)

C  HANDLES MESSAGE OF THE DAY.  IF ALTER IS TRUE, READ A NEW MESSAGE FROM THE
C  WIZARD.  ELSE PRINT THE CURRENT ONE.  MESSAGE IS INITIALLY NULL.

	IMPLICIT INTEGER(A-Z)
	LOGICAL ALTER
	DIMENSION MSG(100)
	DATA MSG/100*-1/

	IF(ALTER)GOTO 50

	K=1
10	IF(MSG(K).LT.0)RETURN
	TYPE 20,(MSG(I),I=K+1,MSG(K)-1)
20	FORMAT(' ',14A5)
	K=MSG(K)
	GOTO 10

50	M=1
	CALL MSPEAK(23)
55	ACCEPT 56,(MSG(I),I=M+1,M+14),K
56	FORMAT(15A5)
	IF(K.EQ.' ')GOTO 60
	CALL MSPEAK(24)
	GOTO 55
60	DO 62 I=1,14
	K=M+15-I
	IF(MSG(K).NE.' ')GOTO 65
62	CONTINUE
	GOTO 90
65	MSG(M)=K+1
	M=K+1
	IF(M+14.LT.100)GOTO 55
	CALL MSPEAK(25)
90	MSG(M)=-1
	RETURN
	END



	SUBROUTINE POOF

C  AS PART OF DATABASE INITIALISATION, WE CALL POOF TO SET UP SOME DUMMY
C  PRIME-TIME SPECS, MAGIC WORDS, ETC.

	IMPLICIT INTEGER(A-Z)
	DIMENSION HNAME(4)
	COMMON /WIZCOM/ WKDAY,WKEND,HOLID,HBEGIN,HEND,HNAME,
	1	SHORT,MAGIC,MAGNM,LATNCY,SAVED,SAVET,SETUP

	WKDAY="00777400
	WKEND=0
	HOLID=0
	HBEGIN=0
	HEND=-1
	SHORT=30
	MAGIC='DWARF'
	MAGNM=11111
	LATNCY=90
	RETURN
	END
C  UTILITY ROUTINES (SHIFT, RAN, DATIME, CIAO, BUG)


	INTEGER FUNCTION SHIFT(VAL,DIST)
	IMPLICIT INTEGER(A-Z)

C  RETURN VAL LEFT-SHIFTED (LOGICALLY) DIST BITS (RIGHT-SHIFT IF DIST<0).

	SHIFT=VAL
	IF(DIST)10,20,30
10	IDIST=-DIST
	DO 11 I=1,IDIST
	J=0
	IF(SHIFT.LT.0)J="200000000000
11	SHIFT=((SHIFT.AND."377777777777)/2)+J
20	RETURN
30	DO 31 I=1,DIST
	J=0
	IF((SHIFT.AND."200000000000).NE.0)J="400000000000
31	SHIFT=(SHIFT.AND."177777777777)*2+J
	RETURN
	END



	INTEGER FUNCTION RAN(RANGE)

C  SINCE THE RAN FUNCTION IN LIB40 SEEMS TO BE A REAL LOSE, WE'LL USE ONE OF
C  OUR OWN.  IT'S BEEN RUN THROUGH MANY OF THE TESTS IN KNUTH VOL. 2 AND
C  SEEMS TO BE QUITE RELIABLE.  RAN RETURNS A VALUE UNIFORMLY SELECTED
C  BETWEEN 0 AND RANGE-1.  NOTE RESEMBLANCE TO ALG USED IN WIZARD.

	IMPLICIT INTEGER(A-Z)
	DATA R/0/

	D=1
	IF(R.NE.0)GOTO 1
	CALL DATIME(D,T)
	R=18*T+5
	D=1000+MOD(D,1000)
1	DO 2 T=1,D
2	R=MOD(R*1021,1048576)
	RAN=(RANGE*R)/1048576
	RETURN
	END



	SUBROUTINE DATIME(D,T)

C  RETURN THE DATE AND TIME IN D AND T.  D IS NUMBER OF DAYS SINCE 01-JAN-77,
C  T IS MINUTES PAST MIDNIGHT.  THIS IS HARDER THAN IT SOUNDS, BECAUSE THE
C  FINAGLED DEC FUNCTIONS RETURN THE VALUES ONLY AS ASCII STRINGS!

	IMPLICIT INTEGER(A-Z)
	DIMENSION DAT(2),MONTHS(12),HATH(12)
	DATA MONTHS/'-JAN-','-FEB-','-MAR-','-APR-','-MAY-','-JUN-',
	1	'-JUL-','-AUG-','-SEP-','-OCT-','-NOV-','-DEC-'/
	DATA HATH/31,28,31,30,31,30,31,31,30,31,30,31/

C  FUNCTION I2 TAKES 2-DIGIT ASCII AND YIELDS DECIMAL VALUE.

	I2(X)=(SHIFT(X,-29).AND.15)*10+(SHIFT(X,-22).AND.15)

	CALL DATE(DAT)
	CALL TIME(TIM)

	YEAR=I2(SHIFT(DAT(2),14))-77
	D=I2(DAT(1))-1
	X=((SHIFT(DAT(1),14).OR.SHIFT(DAT(2),-21)).AND..NOT."1004020001)
	1	.OR.'-@@@-'
C  ABOVE FUNNY EXPRESSION GUARANTEES (A) UPPER-CASE, AND (B) BOTTOM BIT OKAY.
	DO 1 MON=1,12
	IF(X.EQ.MONTHS(MON))GOTO 2
1	D=D+HATH(MON)
	CALL BUG(28)

2	D=D+YEAR*365+YEAR/4
	IF(MOD(YEAR,4).EQ.3.AND.MON.GT.2)D=D+1
	T=I2(TIM)*60+I2(SHIFT(TIM,21))
	RETURN
	END



	SUBROUTINE CIAO

C  EXITS, AFTER ISSUING REMINDER TO SAVE NEW CORE IMAGE.  USED WHEN SUSPENDING
C  AND WHEN CREATING NEW VERSION VIA MAGIC MODE.  ON SOME SYSTEMS, THE CORE
C  IMAGE IS LOST ONCE THE PROGRAM EXITS.  IF SO, SET K=31 INSTEAD OF 32.

	IMPLICIT INTEGER(A-Z)
	DATA K/32/

	CALL MSPEAK(K)
	IF(K.EQ.31)CALL GETIN(A,B,C,D)
	STOP
	END



	SUBROUTINE BUG(NUM)
	IMPLICIT INTEGER(A-Z)

C  THE FOLLOWING CONDITIONS ARE CURRENTLY CONSIDERED FATAL BUGS.  NUMBERS < 20
C  ARE DETECTED WHILE READING THE DATABASE; THE OTHERS OCCUR AT "RUN TIME".
C	0	MESSAGE LINE > 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 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

	TYPE 1, NUM
1	FORMAT (' FATAL ERROR, SEE SOURCE CODE FOR INTERPRETATION.'/
	1	' PROBABLE CAUSE: ERRONEOUS INFO IN DATABASE.'/
	2	' ERROR CODE =',I2/)
	STOP
	END