![[BACK]](/cvsweb/icons/back.gif){kind=icon}
Return to sverbs.F CVS log ![[TXT]](/cvsweb/icons/text.gif){kind=icon}
![[DIR]](/cvsweb/icons/dir.gif){kind=icon}
Up to [CSRG BSD Unix] / 43BSDReno / games / dungeon|
Return to sverbs.F CVS log | Up to [CSRG BSD Unix] / 43BSDReno / games / dungeon |
1.1 root 1: C SVERBS- SIMPLE VERBS PROCESSOR
2: C ALL VERBS IN THIS ROUTINE MUST BE INDEPENDANT
3: C OF OBJECT ACTIONS
4: C
5: C COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142
6: C ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED
7: C WRITTEN BY R. M. SUPNIK
8: C
9: C DECLARATIONS
10: C
11: LOGICAL FUNCTION SVERBS(RI)
12: IMPLICIT INTEGER (A-Z)
13: LOGICAL MOVETO,YESNO
14: LOGICAL RMDESC
15: LOGICAL QOPEN
16: LOGICAL FINDXT,QHERE,F
17: INTEGER JOKES(25)
18: CHARACTER ANSSTR(78)
19: CHARACTER PP1(6),PP2(6),CH(6)
20: INTEGER ANSWER(28)
21: #include "parser.h"
22: #include "gamestate.h"
23: #include "state.h"
24: #include "screen.h"
25: C
26: C MISCELLANEOUS VARIABLES
27: C
28: CHARACTER VEDIT
29: COMMON /VERS/ VMAJ,VMIN,VEDIT
30: #include "io.h"
31: #include "rooms.h"
32: #include "rflag.h"
33: #include "rindex.h"
34: #include "exits.h"
35: #include "curxt.h"
36: #include "xpars.h"
37: #include "xsrch.h"
38: #include "objects.h"
39: #include "oflags.h"
40: #include "oindex.h"
41: #include "clock.h"
42:
43: #include "advers.h"
44: #include "verbs.h"
45: #include "flags.h"
46: C
47: C FUNCTIONS AND DATA
48: C
49: QOPEN(R)=and(OFLAG2(R),OPENBT).NE.0
50: DATA MXNOP/39/,MXJOKE/64/
51: DATA JOKES/4,5,3,304,305,306,307,308,309,310,311,312,
52: & 313,5314,5319,324,325,883,884,120,120,0,0,0,0/
53: DATA ANSWER/0,6,1,6,2,5,3,5,4,3,4,6,4,6,4,5,
54: & 5,5,5,4,5,6,6,10,7,4,7,6/
55: DATA ANSSTR/'T','E','M','P','L','E',
56: & 'F','O','R','E','S','T',
57: & '3','0','0','0','3',
58: & 'F','L','A','S','K',
59: & 'R','U','B',
60: & 'F','O','N','D','L','E',
61: & 'C','A','R','R','E','S',
62: & 'T','O','U','C','H',
63: & 'B','O','N','E','S',
64: & 'B','O','D','Y',
65: & 'S','K','E','L','E','T',
66: & 'R','U','S','T','Y','K','N','I','F','E',
67: & 'N','O','N','E',
68: & 'N','O','W','H','E','R','\0'/
69: C SVERBS, PAGE 2
70: C
71: SVERBS=.TRUE.
72: C !ASSUME WINS.
73: IF(PRSO.NE.0) ODO2=ODESC2(PRSO)
74: C !SET UP DESCRIPTORS.
75: IF(PRSI.NE.0) ODI2=ODESC2(PRSI)
76: C
77: IF(RI.EQ.0) CALL BUG(7,RI)
78: C !ZERO IS VERBOTEN.
79: IF(RI.LE.MXNOP) RETURN
80: C !NOP?
81: IF(RI.LE.MXJOKE) GO TO 100
82: C !JOKE?
83: GO TO (65000,66000,67000,68000,69000,
84: & 1000,2000,3000,4000,5000,6000,7000,8000,9000,10000,
85: & 11000,12000,13000,14000,15000,16000,17000,18000,19000,20000,
86: & 21000,22000,23000,24000,25000,26000,27000),
87: & (RI-MXJOKE)
88: CALL BUG(7,RI)
89: C
90: C ALL VERB PROCESSORS RETURN HERE TO DECLARE FAILURE.
91: C
92: 10 SVERBS=.FALSE.
93: C !LOSE.
94: RETURN
95: C
96: C JOKE PROCESSOR.
97: C FIND PROPER ENTRY IN JOKES, USE IT TO SELECT STRING TO PRINT.
98: C
99: 100 I=JOKES(RI-MXNOP)
100: C !GET TABLE ENTRY.
101: J=I/1000
102: C !ISOLATE # STRINGS.
103: IF(J.NE.0) I=MOD(I,1000)+RND(J)
104: C !IF RANDOM, CHOOSE.
105: CALL RSPEAK(I)
106: C !PRINT JOKE.
107: RETURN
108: C SVERBS, PAGE 2A
109: C
110: C V65-- ROOM
111: C
112: 65000 SVERBS=RMDESC(2)
113: C !DESCRIBE ROOM ONLY.
114: RETURN
115: C
116: C V66-- OBJECTS
117: C
118: 66000 SVERBS=RMDESC(1)
119: C !DESCRIBE OBJ ONLY.
120: IF(.NOT.TELFLG) CALL RSPEAK(138)
121: C !NO OBJECTS.
122: RETURN
123: C
124: C V67-- RNAME
125: C
126: 67000 CALL RSPEAK(RDESC2-HERE)
127: C !SHORT ROOM NAME.
128: RETURN
129: C
130: C V68-- RESERVED
131: C
132: 68000 RETURN
133: C
134: C V69-- RESERVED
135: C
136: 69000 RETURN
137: C SVERBS, PAGE 3
138: C
139: C V70-- BRIEF. SET FLAG.
140: C
141: 1000 BRIEFF=.TRUE.
142: C !BRIEF DESCRIPTIONS.
143: SUPERF=.FALSE.
144: CALL RSPEAK(326)
145: RETURN
146: C
147: C V71-- VERBOSE. CLEAR FLAGS.
148: C
149: 2000 BRIEFF=.FALSE.
150: C !LONG DESCRIPTIONS.
151: SUPERF=.FALSE.
152: CALL RSPEAK(327)
153: RETURN
154: C
155: C V72-- SUPERBRIEF. SET FLAG.
156: C
157: 3000 SUPERF=.TRUE.
158: CALL RSPEAK(328)
159: RETURN
160: C
161: C V73-- STAY (USED IN ENDGAME).
162: C
163: 4000 IF(WINNER.NE.AMASTR) GO TO 4100
164: C !TELL MASTER, STAY.
165: CALL RSPEAK(781)
166: C !HE DOES.
167: CTICK(CEVFOL)=0
168: C !NOT FOLLOWING.
169: RETURN
170: C
171: 4100 IF(WINNER.EQ.PLAYER) CALL RSPEAK(664)
172: C !JOKE.
173: RETURN
174: C
175: C V74-- VERSION. PRINT INFO.
176: C
177: #ifdef PDP
178: 5000 call prvers(vmaj,vmin,vedit)
179: #else
180: 5000 WRITE(OUTCH,5010) VMAJ,VMIN,VEDIT
181: #ifdef NOCC
182: 5010 FORMAT('V',I1,'.',I2,A1)
183: #else NOCC
184: 5010 FORMAT(' V',I1,'.',I2,A1)
185: #endif NOCC
186: #endif PDP
187: TELFLG=.TRUE.
188: RETURN
189: C
190: C V75-- SWIM. ALWAYS A JOKE.
191: C
192: 6000 I=330
193: C !ASSUME WATER.
194: IF(and(RFLAG(HERE),(RWATER+RFILL)).EQ.0)
195: & I=331+RND(3)
196: CALL RSPEAK(I)
197: RETURN
198: C
199: C V76-- GERONIMO. IF IN BARREL, FATAL, ELSE JOKE.
200: C
201: 7000 IF(HERE.EQ.MBARR) GO TO 7100
202: C !IN BARREL?
203: CALL RSPEAK(334)
204: C !NO, JOKE.
205: RETURN
206: C
207: 7100 CALL JIGSUP(335)
208: C !OVER FALLS.
209: RETURN
210: C
211: C V77-- SINBAD ET AL. CHASE CYCLOPS, ELSE JOKE.
212: C
213: 8000 IF((HERE.EQ.MCYCL).AND.QHERE(CYCLO,HERE)) GO TO 8100
214: CALL RSPEAK(336)
215: C !NOT HERE, JOKE.
216: RETURN
217: C
218: 8100 CALL NEWSTA(CYCLO,337,0,0,0)
219: C !CYCLOPS FLEES.
220: CYCLOF=.TRUE.
221: C !SET ALL FLAGS.
222: MAGICF=.TRUE.
223: OFLAG2(CYCLO)=and(OFLAG2(CYCLO), not(FITEBT))
224: RETURN
225: C
226: C V78-- WELL. OPEN DOOR, ELSE JOKE.
227: C
228: 9000 IF(RIDDLF.OR.(HERE.NE.RIDDL)) GO TO 9100
229: C !IN RIDDLE ROOM?
230: RIDDLF=.TRUE.
231: C !YES, SOLVED IT.
232: CALL RSPEAK(338)
233: RETURN
234: C
235: 9100 CALL RSPEAK(339)
236: C !WELL, WHAT?
237: RETURN
238: C
239: C V79-- PRAY. IF IN TEMP2, POOF
240: C !
241: C
242: 10000 IF(HERE.NE.TEMP2) GO TO 10050
243: C !IN TEMPLE?
244: IF(MOVETO(FORE1,WINNER)) GO TO 10100
245: C !FORE1 STILL THERE?
246: 10050 CALL RSPEAK(340)
247: C !JOKE.
248: RETURN
249: C
250: 10100 F=RMDESC(3)
251: C !MOVED, DESCRIBE.
252: RETURN
253: C
254: C V80-- TREASURE. IF IN TEMP1, POOF
255: C !
256: C
257: 11000 IF(HERE.NE.TEMP1) GO TO 11050
258: C !IN TEMPLE?
259: IF(MOVETO(TREAS,WINNER)) GO TO 10100
260: C !TREASURE ROOM THERE?
261: 11050 CALL RSPEAK(341)
262: C !NOTHING HAPPENS.
263: RETURN
264: C
265: C V81-- TEMPLE. IF IN TREAS, POOF
266: C !
267: C
268: 12000 IF(HERE.NE.TREAS) GO TO 12050
269: C !IN TREASURE?
270: IF(MOVETO(TEMP1,WINNER)) GO TO 10100
271: C !TEMP1 STILL THERE?
272: 12050 CALL RSPEAK(341)
273: C !NOTHING HAPPENS.
274: RETURN
275: C
276: C V82-- BLAST. USUALLY A JOKE.
277: C
278: 13000 I=342
279: C !DONT UNDERSTAND.
280: IF(PRSO.EQ.SAFE) I=252
281: C !JOKE FOR SAFE.
282: CALL RSPEAK(I)
283: RETURN
284: C
285: C V83-- SCORE. PRINT SCORE.
286: C
287: 14000 CALL SCORE(.FALSE.)
288: RETURN
289: C
290: C V84-- QUIT. FINISH OUT THE GAME.
291: C
292: 15000 CALL SCORE(.TRUE.)
293: C !TELLL SCORE.
294: IF(.NOT.YESNO(343,0,0)) RETURN
295: C !ASK FOR Y/N DECISION.
296: #ifdef PDP
297: C close routine moved to exit for pdp version
298: #else
299: CLOSE (DBCH)
300: #endif PDP
301: CALL EXIT
302: C !BYE.
303: C SVERBS, PAGE 4
304: C
305: C V85-- FOLLOW (USED IN ENDGAME)
306: C
307: 16000 IF(WINNER.NE.AMASTR) RETURN
308: C !TELL MASTER, FOLLOW.
309: CALL RSPEAK(782)
310: CTICK(CEVFOL)=-1
311: C !STARTS FOLLOWING.
312: RETURN
313: C
314: C V86-- WALK THROUGH
315: C
316: 17000 IF((SCOLRM.EQ.0).OR.((PRSO.NE.SCOL).AND.
317: & ((PRSO.NE.WNORT).OR.(HERE.NE.BKBOX)))) GO TO 17100
318: SCOLAC=SCOLRM
319: C !WALKED THRU SCOL.
320: PRSO=0
321: C !FAKE OUT FROMDR.
322: CTICK(CEVSCL)=6
323: C !START ALARM.
324: CALL RSPEAK(668)
325: C !DISORIENT HIM.
326: F=MOVETO(SCOLRM,WINNER)
327: C !INTO ROOM.
328: F=RMDESC(3)
329: C !DESCRIBE.
330: RETURN
331: C
332: 17100 IF(HERE.NE.SCOLAC) GO TO 17300
333: C !ON OTHER SIDE OF SCOL?
334: DO 17200 I=1,12,3
335: C !WALK THRU PROPER WALL?
336: IF((SCOLWL(I).EQ.HERE).AND.(SCOLWL(I+1).EQ.PRSO))
337: & GO TO 17500
338: 17200 CONTINUE
339: C
340: 17300 IF(and(OFLAG1(PRSO),TAKEBT).NE.0) GO TO 17400
341: I=669
342: C !NO, JOKE.
343: IF(PRSO.EQ.SCOL) I=670
344: C !SPECIAL JOKE FOR SCOL.
345: CALL RSPSUB(I,ODO2)
346: RETURN
347: C
348: 17400 I=671
349: C !JOKE.
350: IF(OROOM(PRSO).NE.0) I=552+RND(5)
351: C !SPECIAL JOKES IF CARRY.
352: CALL RSPEAK(I)
353: RETURN
354: C
355: 17500 PRSO=SCOLWL(I+2)
356: C !THRU SCOL WALL...
357: DO 17600 I=1,8,2
358: C !FIND MATCHING ROOM.
359: IF(PRSO.EQ.SCOLDR(I)) SCOLRM=SCOLDR(I+1)
360: 17600 CONTINUE
361: C !DECLARE NEW SCOLRM.
362: CTICK(CEVSCL)=0
363: C !CANCEL ALARM.
364: CALL RSPEAK(668)
365: C !DISORIENT HIM.
366: F=MOVETO(BKBOX,WINNER)
367: C !BACK IN BOX ROOM.
368: F=RMDESC(3)
369: RETURN
370: C
371: C V87-- RING. A JOKE.
372: C
373: 18000 I=359
374: C !CANT RING.
375: IF(PRSO.EQ.BELL) I=360
376: C !DING, DONG.
377: CALL RSPEAK(I)
378: C !JOKE.
379: RETURN
380: C
381: C V88-- BRUSH. JOKE WITH OBSCURE TRAP.
382: C
383: 19000 IF(PRSO.EQ.TEETH) GO TO 19100
384: C !BRUSH TEETH?
385: CALL RSPEAK(362)
386: C !NO, JOKE.
387: RETURN
388: C
389: 19100 IF(PRSI.NE.0) GO TO 19200
390: C !WITH SOMETHING?
391: CALL RSPEAK(363)
392: C !NO, JOKE.
393: RETURN
394: C
395: 19200 IF((PRSI.EQ.PUTTY).AND.(OADV(PUTTY).EQ.WINNER))
396: & GO TO 19300
397: CALL RSPSUB(364,ODI2)
398: C !NO, JOKE.
399: RETURN
400: C
401: 19300 CALL JIGSUP(365)
402: C !YES, DEAD
403: C !
404: C !
405: C !
406: C !
407: C !
408: RETURN
409: C SVERBS, PAGE 5
410: C
411: C V89-- DIG. UNLESS SHOVEL, A JOKE.
412: C
413: 20000 IF(PRSO.EQ.SHOVE) RETURN
414: C !SHOVEL?
415: I=392
416: C !ASSUME TOOL.
417: IF(and(OFLAG1(PRSO),TOOLBT).EQ.0) I=393
418: CALL RSPSUB(I,ODO2)
419: RETURN
420: C
421: C V90-- TIME. PRINT OUT DURATION OF GAME.
422: C
423: #ifdef PDP
424: C no duration time available for pdp version (removed
425: C to make things fit)
426: 21000 TELFLG=.TRUE.
427: RETURN
428: #else
429: 21000 CALL GTTIME(K)
430: C !GET PLAY TIME.
431: I=K/60
432: J=MOD(K,60)
433: C
434: #ifdef NOCC
435: IF(I.EQ.0.AND.J.EQ.1) WRITE(OUTCH,21010) J
436: IF(I.EQ.0.AND.J.NE.1) WRITE(OUTCH,21011) J
437: IF(I.EQ.1.AND.J.EQ.1) WRITE(OUTCH,21012) I,J
438: IF(I.EQ.1.AND.J.NE.1) WRITE(OUTCH,21013) I,J
439: IF(I.GE.2.AND.J.EQ.1) WRITE(OUTCH,21014) I,J
440: IF(I.GE.2.AND.J.NE.1) WRITE(OUTCH,21015) I,J
441: TELFLG=.TRUE.
442: RETURN
443: C
444: 21010 FORMAT('You have been playing Dungeon for ',I2,' minute.')
445: 21011 FORMAT('You have been playing Dungeon for ',I2,' minutes.')
446: 21012 FORMAT('You have been playing Dungeon for ',I3,' hour and ',
447: & I2,' minute.')
448: 21013 FORMAT('You have been playing Dungeon for ',I3,' hour and ',
449: & I2,' minutes.')
450: 21014 FORMAT('You have been playing Dungeon for ',I3,' hours and ',
451: & I2,' minute.')
452: 21015 FORMAT('You have been playing Dungeon for ',I3,' hours and ',
453: & I2,' minutes.')
454: #else NOCC
455: WRITE(OUTCH,21010)
456: IF(I.NE.0) WRITE(OUTCH,21011) I
457: IF(I.GE.2) WRITE(OUTCH,21012)
458: IF(I.EQ.1) WRITE(OUTCH,21013)
459: IF(J.EQ.1) WRITE(OUTCH,21014) J
460: IF(J.NE.1) WRITE(OUTCH,21015) J
461: TELFLG=.TRUE.
462: RETURN
463: C
464: 21010 FORMAT(' You have been playing Dungeon for ',$)
465: 21011 FORMAT('+',I3,' hour',$)
466: 21012 FORMAT('+s and ',$)
467: 21013 FORMAT('+ and ',$)
468: 21014 FORMAT('+',I2,' minute.')
469: 21015 FORMAT('+',I2,' minutes.')
470: #endif NOCC
471: #endif PDP
472: C
473: C V91-- LEAP. USUALLY A JOKE, WITH A CATCH.
474: C
475: 22000 IF(PRSO.EQ.0) GO TO 22200
476: C !OVER SOMETHING?
477: IF(QHERE(PRSO,HERE)) GO TO 22100
478: C !HERE?
479: CALL RSPEAK(447)
480: C !NO, JOKE.
481: RETURN
482: C
483: 22100 IF(and(OFLAG2(PRSO),VILLBT).EQ.0) GO TO 22300
484: CALL RSPSUB(448,ODO2)
485: C !CANT JUMP VILLAIN.
486: RETURN
487: C
488: 22200 IF(.NOT.FINDXT(XDOWN,HERE)) GO TO 22300
489: C !DOWN EXIT?
490: IF((XTYPE.EQ.XNO).OR.((XTYPE.EQ.XCOND).AND.
491: & .NOT.FLAGS(XFLAG))) GO TO 22400
492: 22300 CALL RSPEAK(314+RND(5))
493: C !WHEEEE
494: C !
495: RETURN
496: C
497: 22400 CALL JIGSUP(449+RND(4))
498: C !FATAL LEAP.
499: RETURN
500: C SVERBS, PAGE 6
501: C
502: C V92-- LOCK.
503: C
504: 23000 IF((PRSO.EQ.GRATE).AND.(HERE.EQ.MGRAT))
505: & GO TO 23200
506: 23100 CALL RSPEAK(464)
507: C !NOT LOCK GRATE.
508: RETURN
509: C
510: 23200 GRUNLF=.FALSE.
511: C !GRATE NOW LOCKED.
512: CALL RSPEAK(214)
513: TRAVEL(REXIT(HERE)+1)=214
514: C !CHANGE EXIT STATUS.
515: RETURN
516: C
517: C V93-- UNLOCK
518: C
519: 24000 IF((PRSO.NE.GRATE).OR.(HERE.NE.MGRAT))
520: & GO TO 23100
521: IF(PRSI.EQ.KEYS) GO TO 24200
522: C !GOT KEYS?
523: CALL RSPSUB(465,ODI2)
524: C !NO, JOKE.
525: RETURN
526: C
527: 24200 GRUNLF=.TRUE.
528: C !UNLOCK GRATE.
529: CALL RSPEAK(217)
530: TRAVEL(REXIT(HERE)+1)=217
531: C !CHANGE EXIT STATUS.
532: RETURN
533: C
534: C V94-- DIAGNOSE.
535: C
536: 25000 I=FIGHTS(WINNER,.FALSE.)
537: C !GET FIGHTS STRENGTH.
538: J=ASTREN(WINNER)
539: C !GET HEALTH.
540: K=MIN0(I+J,4)
541: C !GET STATE.
542: IF(.NOT.CFLAG(CEVCUR)) J=0
543: C !IF NO WOUNDS.
544: L=MIN0(4,IABS(J))
545: C !SCALE.
546: CALL RSPEAK(473+L)
547: C !DESCRIBE HEALTH.
548: I=(30*(-J-1))+CTICK(CEVCUR)
549: C !COMPUTE WAIT.
550: C
551: #ifdef PDP
552: if(J .ne. 0) call cured(I)
553: #else
554: IF(J.NE.0) WRITE(OUTCH,25100) I
555: #ifdef NOCC
556: 25100 FORMAT('You will be cured after ',I3,' moves.')
557: #else NOCC
558: 25100 FORMAT(' You will be cured after ',I3,' moves.')
559: #endif NOCC
560: #endif PDP
561: C
562: CALL RSPEAK(478+K)
563: C !HOW MUCH MORE?
564: IF(DEATHS.NE.0) CALL RSPEAK(482+DEATHS)
565: C !HOW MANY DEATHS?
566: RETURN
567: C SVERBS, PAGE 7
568: C
569: C V95-- INCANT
570: C
571: 26000 DO 26100 I=1,6
572: C !SET UP PARSE.
573: PP1(I)=' '
574: PP2(I)=' '
575: 26100 CONTINUE
576: WP=1
577: C !WORD POINTER.
578: CP=1
579: C !CHAR POINTER.
580: IF(PRSCON.LE.1) GO TO 26300
581: DO 26200 I=PRSCON,INLNT
582: C !PARSE INPUT
583: IF(INBUF(I).EQ.',') GO TO 26300
584: C !END OF PHRASE?
585: IF(INBUF(I).NE.' ') GO TO 26150
586: C !SPACE?
587: IF(CP.NE.1) WP=WP+1
588: CP=1
589: GO TO 26200
590: 26150 IF(WP.EQ.1) PP1(CP)=INBUF(I)
591: C !STUFF INTO HOLDER.
592: IF(WP.EQ.2) PP2(CP)=INBUF(I)
593: CP=MIN0(CP+1,6)
594: 26200 CONTINUE
595: C
596: 26300 PRSCON=1
597: C !KILL REST OF LINE.
598: IF(PP1(1).NE.' ') GO TO 26400
599: C !ANY INPUT?
600: CALL RSPEAK(856)
601: C !NO, HO HUM.
602: RETURN
603: C
604: 26400 CALL ENCRYP(PP1,CH)
605: C !COMPUTE RESPONSE.
606: IF(PP2(1).NE.' ') GO TO 26600
607: C !TWO PHRASES?
608: C
609: IF(SPELLF) GO TO 26550
610: C !HE'S TRYING TO LEARN.
611: IF(and(RFLAG(TSTRS),RSEEN).EQ.0) GO TO 26575
612: SPELLF=.TRUE.
613: C !TELL HIM.
614: TELFLG=.TRUE.
615: #ifdef PDP
616: call voice(PP1,CH)
617: #else
618: WRITE(OUTCH,26510) PP1,CH
619: #ifdef NOCC
620: 26510 FORMAT('A hollow voice replies: "',6A1,1X,6A1,'".')
621: #else NOCC
622: 26510 FORMAT(' A hollow voice replies: "',6A1,1X,6A1,'".')
623: #endif NOCC
624: #endif PDP
625: C
626: RETURN
627: C
628: 26550 CALL RSPEAK(857)
629: C !HE'S GOT ONE ALREADY.
630: RETURN
631: C
632: 26575 CALL RSPEAK(858)
633: C !HE'S NOT IN ENDGAME.
634: RETURN
635: C
636: 26600 IF(and(RFLAG(TSTRS),RSEEN).NE.0) GO TO 26800
637: DO 26700 I=1,6
638: IF(PP2(I).NE.CH(I)) GO TO 26575
639: C !WRONG.
640: 26700 CONTINUE
641: SPELLF=.TRUE.
642: C !IT WORKS.
643: CALL RSPEAK(859)
644: CTICK(CEVSTE)=1
645: C !FORCE START.
646: RETURN
647: C
648: 26800 CALL RSPEAK(855)
649: C !TOO LATE.
650: RETURN
651: C SVERBS, PAGE 8
652: C
653: C V96-- ANSWER
654: C
655: 27000 IF((PRSCON.GT.1).AND.
656: & (HERE.EQ.FDOOR).AND.INQSTF)
657: & GO TO 27100
658: CALL RSPEAK(799)
659: C !NO ONE LISTENS.
660: PRSCON=1
661: RETURN
662: C
663: 27100 K=1
664: C !POINTER INTO ANSSTR.
665: DO 27300 J=1,28,2
666: C !CHECK ANSWERS.
667: NEWK=K+ANSWER(J+1)
668: C !COMPUTE NEXT K.
669: IF(QUESNO.NE.ANSWER(J)) GO TO 27300
670: C !ONLY CHECK PROPER ANS.
671: I=PRSCON-1
672: C !SCAN ANSWER.
673: DO 27200 L=K,NEWK-1
674: 27150 I=I+1
675: C !SKIP INPUT BLANKS.
676: IF(I.GT.INLNT) GO TO 27300
677: C !END OF INPUT? LOSE.
678: IF(INBUF(I).EQ.' ') GO TO 27150
679: IF(INBUF(I).NE.ANSSTR(L)) GO TO 27300
680: 27200 CONTINUE
681: GO TO 27500
682: C !RIGHT ANSWER.
683: 27300 K=NEWK
684: C
685: PRSCON=1
686: C !KILL REST OF LINE.
687: NQATT=NQATT+1
688: C !WRONG, CRETIN.
689: IF(NQATT.GE.5) GO TO 27400
690: C !TOO MANY WRONG?
691: CALL RSPEAK(800+NQATT)
692: C !NO, TRY AGAIN.
693: RETURN
694: C
695: 27400 CALL RSPEAK(826)
696: C !ALL OVER.
697: CFLAG(CEVINQ)=.FALSE.
698: C !LOSE.
699: RETURN
700: C
701: 27500 PRSCON=1
702: C !KILL REST OF LINE.
703: CORRCT=CORRCT+1
704: C !GOT IT RIGHT.
705: CALL RSPEAK(800)
706: C !HOORAY.
707: IF(CORRCT.GE.3) GO TO 27600
708: C !WON TOTALLY?
709: CTICK(CEVINQ)=2
710: C !NO, START AGAIN.
711: QUESNO=MOD(QUESNO+3,8)
712: NQATT=0
713: CALL RSPEAK(769)
714: C !ASK NEXT QUESTION.
715: CALL RSPEAK(770+QUESNO)
716: RETURN
717: C
718: 27600 CALL RSPEAK(827)
719: C !QUIZ OVER,
720: CFLAG(CEVINQ)=.FALSE.
721: OFLAG2(QDOOR)=or(OFLAG2(QDOOR),OPENBT)
722: RETURN
723: C
724: END
This archive runs on limited infrastructure. Preserving old code on modern bandwidth. Automated agents are requested to crawl responsibly.