-
Notifications
You must be signed in to change notification settings - Fork 1
/
Copy pathadventure.f
823 lines (722 loc) · 17.7 KB
/
adventure.f
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
262
263
264
265
266
267
268
269
270
271
272
273
274
275
276
277
278
279
280
281
282
283
284
285
286
287
288
289
290
291
292
293
294
295
296
297
298
299
300
301
302
303
304
305
306
307
308
309
310
311
312
313
314
315
316
317
318
319
320
321
322
323
324
325
326
327
328
329
330
331
332
333
334
335
336
337
338
339
340
341
342
343
344
345
346
347
348
349
350
351
352
353
354
355
356
357
358
359
360
361
362
363
364
365
366
367
368
369
370
371
372
373
374
375
376
377
378
379
380
381
382
383
384
385
386
387
388
389
390
391
392
393
394
395
396
397
398
399
400
401
402
403
404
405
406
407
408
409
410
411
412
413
414
415
416
417
418
419
420
421
422
423
424
425
426
427
428
429
430
431
432
433
434
435
436
437
438
439
440
441
442
443
444
445
446
447
448
449
450
451
452
453
454
455
456
457
458
459
460
461
462
463
464
465
466
467
468
469
470
471
472
473
474
475
476
477
478
479
480
481
482
483
484
485
486
487
488
489
490
491
492
493
494
495
496
497
498
499
500
501
502
503
504
505
506
507
508
509
510
511
512
513
514
515
516
517
518
519
520
521
522
523
524
525
526
527
528
529
530
531
532
533
534
535
536
537
538
539
540
541
542
543
544
545
546
547
548
549
550
551
552
553
554
555
556
557
558
559
560
561
562
563
564
565
566
567
568
569
570
571
572
573
574
575
576
577
578
579
580
581
582
583
584
585
586
587
588
589
590
591
592
593
594
595
596
597
598
599
600
601
602
603
604
605
606
607
608
609
610
611
612
613
614
615
616
617
618
619
620
621
622
623
624
625
626
627
628
629
630
631
632
633
634
635
636
637
638
639
640
641
642
643
644
645
646
647
648
649
650
651
652
653
654
655
656
657
658
659
660
661
662
663
664
665
666
667
668
669
670
671
672
673
674
675
676
677
678
679
680
681
682
683
684
685
686
687
688
689
690
691
692
693
694
695
696
697
698
699
700
701
702
703
704
705
706
707
708
709
710
711
712
713
714
715
716
717
718
719
720
721
722
723
724
725
726
727
728
729
730
731
732
733
734
735
736
737
738
739
740
741
742
743
744
745
746
747
748
749
750
751
752
753
754
755
756
757
758
759
760
761
762
763
764
765
766
767
768
769
770
771
772
773
774
775
776
777
778
779
780
781
782
783
784
785
786
787
788
789
790
791
792
793
794
795
796
797
798
799
800
801
802
803
804
805
806
807
808
809
810
811
812
813
814
815
816
817
818
819
820
821
822
823
C ADVENTURES
IMPLICIT INTEGER(A-Z)
CHARACTER*5 A,B,WD2,ATAB
REAL RAN
COMMON RTEXT,LLINE
DIMENSION IOBJ(300),ICHAIN(100),IPLACE(100)
1 ,IFIXED(100),COND(300),PROP(100),ABB(300),LLINE(1000,22)
2 ,LTEXT(300),STEXT(300),KEY(300),DEFAULT(300),TRAVEL(1000)
3 ,TK(25),KTAB(1000),ATAB(1000),BTEXT(200),DSEEN(10)
4 ,DLOC(10),ODLOC(10),DTRAV(20),RTEXT(100),JSPKT(100)
5 ,IPLT(100),IFIXT(100)
LOGICAL LOCOUT
CHARACTER CHRS*4
EQUIVALENCE (BLNK,CHRS)
DATA(JSPKT(I),I=1,16)/24,29,0,31,0,31,38,38,42,42,43,46,77,71
1 ,73,75/
DATA(IPLT(I),I=1,20)/3,3,8,10,11,14,13,9,15,18,19,17,27,28,29
1 ,30,0,0,3,3/
DATA(IFIXT(I),I=1,20)/0,0,1,0,0,1,0,1,1,0,1,1,0,0,0,0,0,0,0,0/
DATA(DTRAV(I),I=1,20)/36,28,19,30,62,60,41,27,17,15,19,28,36
1 ,300,300,5*0/
DATA CHRS /' '/, SETUP /0/
DATA KEY /300*0/
DATA DSEEN /10*0/, DLOC /10*0/, ODLOC /10*0/
DATA LOCOUT /.FALSE./
C PARSE COMMAND LINE ARGS
DO 1000 I=1,IARGC()
CALL GETARG(I,A)
IF (A.EQ.'-LOC' .OR. A.EQ.'-loc') LOCOUT=.TRUE.
1000 CONTINUE
C READ THE PARAMETERS
IF(SETUP.NE.0) GOTO 1
SETUP=1
KEYS=1
LAMP=2
GRATE=3
ROD=5
BIRD=7
NUGGET=10
SNAKE=11
FOOD=19
WATER=20
AXE=21
DO 1001 I=1,300
STEXT(I)=0
IF(I.LE.200) BTEXT(I)=0
IF(I.LE.100)RTEXT(I)=0
1001 LTEXT(I)=0
I=1
C CALL IFILE(1,'TEXT')
OPEN(1,FILE='ADVENTURE.DAT',BLANK='NULL',IOSTAT=IOS)
IF(IOS.NE.0) PAUSE 'BAD DATA FILE'
1002 READ(1,1003) IKIND
C1003 FORMAT(G)
1003 FORMAT(I9)
GOTO(1100,1004,1004,1013,1020,1004,1004)(IKIND+1)
1004 READ(1,1005)JKIND,(LLINE(I,J),J=3,22)
C1005 FORMAT(1G,20A5)
1005 FORMAT(I9,20A4)
IF(JKIND.EQ.-1) GOTO 1002
DO 1006 K=1,20
KK=K
C IF(LLINE(I,21-K).NE.' ') GOTO 1007
IF(LLINE(I,21-K).NE.BLNK) GOTO 1007
1006 CONTINUE
STOP
1007 LLINE(I,2)=20-KK+1
LLINE(I,1)=0
IF(IKIND.EQ.6)GOTO 1023
IF(IKIND.EQ.5)GOTO 1011
IF(IKIND.EQ.1) GOTO 1008
IF(STEXT(JKIND).NE.0) GOTO 1009
STEXT(JKIND)=I
GOTO 1010
1008 IF(LTEXT(JKIND).NE.0) GOTO 1009
LTEXT(JKIND)=I
GOTO 1010
1009 LLINE(I-1,1)=I
1010 I=I+1
IF(I.NE.1000)GOTO 1004
PAUSE 'TOO MANY LINES'
1011 IF(JKIND.LT.200)GOTO 1012
IF(BTEXT(JKIND-100).NE.0)GOTO 1009
BTEXT(JKIND-100)=I
BTEXT(JKIND-200)=I
GOTO 1010
1012 IF(BTEXT(JKIND).NE.0)GOTO 1009
BTEXT(JKIND)=I
GOTO 1010
1023 IF(RTEXT(JKIND).NE.0) GOTO 1009
RTEXT(JKIND)=I
GOTO 1010
1013 I=1
1014 READ(1,1015)JKIND,LKIND,(TK(L),L=1,10)
C1015 FORMAT(12G)
1015 FORMAT(12I10)
IF(JKIND.EQ.-1) GOTO 1002
IF(KEY(JKIND).NE.0) GOTO 1016
KEY(JKIND)=I
GOTO 1017
1016 TRAVEL(I-1)=-TRAVEL(I-1)
1017 DO 1018 L=1,10
IF(TK(L).EQ.0) GOTO 1019
TRAVEL(I)=LKIND*1024+TK(L)
I=I+1
IF(I.EQ.1000) STOP
1018 CONTINUE
1019 TRAVEL(I-1)=-TRAVEL(I-1)
GOTO 1014
1020 DO 1022 IU=1,1000
READ(1,1021) KTAB(IU),ATAB(IU)
C1021 FORMAT(G,A5)
1021 FORMAT(I9,A5)
IF(KTAB(IU).EQ.-1)GOTO 1002
1022 CONTINUE
PAUSE 'TOO MANY WORDS'
C TRAVEL = NEG IF LAST THIS SOURCE + DEST*1024 + KEYWORD
C COND = 1 IF LIGHT, 2 IF DON T ASK QUESTION
1100 DO 1101 I=1,100
IPLACE(I)=0
IFIXED(I)=0
IF(I.LE.20) IPLACE(I)=IPLT(I)
IF(I.LE.20) IFIXED(I)=IFIXT(I)
1101 ICHAIN(I)=0
DO 1102 I=1,300
COND(I)=0
ABB(I)=0
1102 IOBJ(I)=0
DO 1103 I=1,10
1103 COND(I)=1
COND(16)=2
COND(20)=2
COND(21)=2
COND(22)=2
COND(23)=2
COND(24)=2
COND(25)=2
COND(26)=2
COND(31)=2
COND(32)=2
COND(79)=2
DO 1107 I=1,100
KTEM=IPLACE(I)
IF(KTEM.EQ.0)GOTO 1107
IF(IOBJ(KTEM).NE.0) GOTO 1104
IOBJ(KTEM)=I
GO TO 1107
1104 KTEM=IOBJ(KTEM)
1105 IF(ICHAIN(KTEM).NE.0) GOTO 1106
ICHAIN(KTEM)=I
GOTO 1107
1106 KTEM=ICHAIN(KTEM)
GOTO 1105
1107 CONTINUE
IDWARF=0
IFIRST=1
IWEST=0
ILONG=1
IDETAL=0
C PAUSE 'INIT DONE'
PRINT *,'INIT DONE'
1 CALL YES(65,1,0,YEA)
L=1
LOC=1
2 DO 73 I=1,3
IF(ODLOC(I).NE.L.OR.DSEEN(I).EQ.0)GOTO 73
L=LOC
CALL SPEAK(2)
GOTO 74
73 CONTINUE
74 LOC=L
C DWARF STUFF
IF (LOCOUT) PRINT '(A,1x,i2)','LOC:',LOC
IF(IDWARF.NE.0) GOTO 60
IF(LOC.EQ.15) IDWARF=1
GOTO 71
60 IF(IDWARF.NE.1)GOTO 63
IF(RAN(QZ).GT.0.05) GOTO 71
IDWARF=2
DO 61 I=1,3
DLOC(I)=0
ODLOC(I)=0
61 DSEEN(I)=0
CALL SPEAK(3)
ICHAIN(AXE)=IOBJ(LOC)
IOBJ(LOC)=AXE
IPLACE(AXE)=LOC
GOTO 71
63 IDWARF=IDWARF+1
ATTACK=0
DTOT=0
STICK=0
DO 66 I=1,3
C IF(2*I+IDWARF.LT.8)GOTO 66
IF(2*I+IDWARF.LE.8)GOTO 66
IF(2*I+IDWARF.GT.23.AND.DSEEN(I).EQ.0)GOTO 66
ODLOC(I)=DLOC(I)
IF(DSEEN(I).NE.0.AND.LOC.GT.14)GOTO 65
DLOC(I)=DTRAV(I*2+IDWARF-8)
DSEEN(I)=0
IF(DLOC(I).NE.LOC.AND.ODLOC(I).NE.LOC) GOTO 66
65 DSEEN(I)=1
DLOC(I)=LOC
DTOT=DTOT+1
IF(ODLOC(I).NE.DLOC(I)) GOTO 66
ATTACK=ATTACK+1
IF(RAN(QZ).LT.0.1) STICK=STICK+1
66 CONTINUE
IF(DTOT.EQ.0) GOTO 71
IF(DTOT.EQ.1)GOTO 75
C TYPE 67,DTOT
PRINT 67,DTOT
67 FORMAT(' THERE ARE ',I2,' THREATENING LITTLE DWARVES IN THE
1 ROOM WITH YOU.',/)
GOTO 77
75 CALL SPEAK(4)
77 IF(ATTACK.EQ.0)GOTO 71
IF(ATTACK.EQ.1)GOTO 79
C TYPE 78,ATTACK
PRINT 78,ATTACK
78 FORMAT(' ',I2,' OF THEM THROW KNIVES AT YOU!',/)
GOTO 81
79 CALL SPEAK(5)
CALL SPEAK(52+STICK)
GOTO(71,83)(STICK+1)
81 IF(STICK.EQ.0) GOTO 69
IF(STICK.EQ.1)GOTO 82
C TYPE 68,STICK
PRINT 68,STICK
68 FORMAT(' ',I2,' OF THEM GET YOU.',/)
GOTO 83
82 CALL SPEAK(6)
C83 PAUSE 'GAMES OVER'
C GOTO 71
83 CONTINUE
GOTO 31
69 CALL SPEAK(7)
C PLACE DESCRIPTOR
71 KK=STEXT(L)
IF(ABB(L).EQ.0.OR.KK.EQ.0)KK=LTEXT(L)
IF(KK.EQ.0) GOTO 7
C4 TYPE 5,(LLINE(KK,JJ),JJ=3,LLINE(KK,2))
C5 FORMAT(20A5)
4 PRINT 5,(LLINE(KK,JJ),JJ=3,LLINE(KK,2))
5 FORMAT(20A4)
KK=KK+1
IF(LLINE(KK-1,1).NE.0) GOTO 4
C TYPE 6
PRINT 6
6 FORMAT(/)
7 IF(COND(L).EQ.2)GOTO 8
IF(LOC.EQ.33.AND.RAN(QZ).LT.0.25)CALL SPEAK(8)
J=L
GOTO 2000
C GO GET A NEW LOCATION
8 KK=KEY(LOC)
IF(KK.EQ.0)GOTO 19
IF(K.EQ.57)GOTO 32
IF(K.EQ.67)GOTO 40
IF(K.EQ.8)GOTO 12
LOLD=L
9 LL=TRAVEL(KK)
IF(LL.LT.0) LL=-LL
IF(1.EQ.MOD(LL,1024))GOTO 10
IF(K.EQ.MOD(LL,1024))GOTO 10
IF(TRAVEL(KK).LT.0)GOTO 11
KK=KK+1
GOTO 9
12 TEMP=LOLD
LOLD=L
L=TEMP
GOTO 21
10 L=LL/1024
GOTO 21
11 JSPK=12
IF(K.GE.43.AND.K.LE.46)JSPK=9
IF(K.EQ.29.OR.K.EQ.30)JSPK=9
IF(K.EQ.7.OR.K.EQ.8.OR.K.EQ.36.OR.K.EQ.37.OR.K.EQ.68)
1 JSPK=10
IF(K.EQ.11.OR.K.EQ.19)JSPK=11
IF(JVERB.EQ.1)JSPK=59
IF(K.EQ.48)JSPK=42
IF(K.EQ.17)JSPK=80
CALL SPEAK(JSPK)
GOTO 2
19 CALL SPEAK(13)
L=LOC
IF(IFIRST.EQ.0) CALL SPEAK(14)
21 IF(L.LT.300)GOTO 2
IL=L-300+1
C GOTO(22,23,24,25,26,31,27,28,29,30,33,34,36,37)IL
GOTO(22,23,24,25,26,31,27,28,29,30,33,34,36,37,39)IL
PRINT '(a,1x,i2,1x,a,1x,i3,a)',
* '**No special motion',IL-1,'from',LOC,'- hope this is OK...'
GOTO 2
22 L=6
IF(RAN(QZ).GT.0.5) L=5
GOTO 2
23 L=23
IF(PROP(GRATE).NE.0) L=9
GOTO 2
24 L=9
IF(PROP(GRATE).NE.0)L=8
GOTO 2
25 L=20
IF(IPLACE(NUGGET).NE.-1)L=15
GOTO 2
26 L=22
IF(IPLACE(NUGGET).NE.-1) L=14
GOTO 2
27 L=27
IF(PROP(12).EQ.0)L=31
GOTO 2
28 L=28
IF(PROP(SNAKE).EQ.0)L=32
GOTO 2
29 L=29
IF(PROP(SNAKE).EQ.0) L=32
GOTO 2
30 L=30
IF(PROP(SNAKE).EQ.0) L=32
GOTO 2
C31 PAUSE 'GAME IS OVER'
31 CONTINUE
CALL YES(81,54,0,I)
IF (I.EQ.0) STOP
GOTO 1100
32 IF(IDETAL.LT.3)CALL SPEAK(15)
IDETAL=IDETAL+1
L=LOC
ABB(L)=0
GOTO 2
33 L=8
IF(PROP(GRATE).EQ.0) L=9
GOTO 2
34 IF(RAN(QZ).GT.0.2)GOTO 35
L=68
GOTO 2
35 L=65
38 CALL SPEAK(56)
GOTO 2
36 IF(RAN(QZ).GT.0.2)GOTO 35
L=39
IF(RAN(QZ).GT.0.5)L=70
GOTO 2
37 L=66
IF(RAN(QZ).GT.0.4)GOTO 38
L=71
IF(RAN(QZ).GT.0.25)L=72
GOTO 2
39 L=66
IF(RAN(QZ).GT.0.2)GOTO 38
L=77
GOTO 2
40 IF(LOC.LT.8)CALL SPEAK(57)
IF(LOC.GE.8)CALL SPEAK(58)
L=LOC
GOTO 2
C DO NEXT INPUT
2000 LTRUBL=0
LOC=J
ABB(J)=MOD((ABB(J)+1),5)
IDARK=0
IF(MOD(COND(J),2).EQ.1) GOTO 2003
IF((IPLACE(2).NE.J).AND.(IPLACE(2).NE.-1)) GOTO 2001
IF(PROP(2).EQ.1)GOTO 2003
2001 CALL SPEAK(16)
IDARK=1
2003 I=IOBJ(J)
2004 IF(I.EQ.0) GOTO 2011
IF(((I.EQ.6).OR.(I.EQ.9)).AND.(IPLACE(10).EQ.-1))GOTO 2008
ILK=I
IF(PROP(I).NE.0) ILK=I+100
KK=BTEXT(ILK)
IF(KK.EQ.0) GOTO 2008
C2005 TYPE 2006,(LLINE(KK,JJ),JJ=3,LLINE(KK,2))
C2006 FORMAT(20A5)
2005 PRINT 2006,(LLINE(KK,JJ),JJ=3,LLINE(KK,2))
2006 FORMAT(20A4)
KK=KK+1
IF(LLINE(KK-1,1).NE.0) GOTO 2005
C TYPE 2007
PRINT 2007
2007 FORMAT(/)
2008 I=ICHAIN(I)
GOTO 2004
C K=1 MEANS ANY INPUT
2012 A=WD2
B=' '
TWOWDS=0
GOTO 2021
2009 K=54
2010 JSPK=K
5200 CALL SPEAK(JSPK)
2011 JVERB=0
JOBJ=0
TWOWDS=0
2020 CALL GETIN(TWOWDS,A,WD2,B)
K=70
IF(A.EQ.'ENTER'.AND.(WD2.EQ.'STREA'.OR.WD2.EQ.'WATER'))GOTO 2010
IF(A.EQ.'ENTER'.AND.TWOWDS.NE.0)GOTO 2012
2021 IF(A.NE.'WEST')GOTO 2023
IWEST=IWEST+1
IF(IWEST.NE.10)GOTO 2023
CALL SPEAK(17)
2023 DO 2024 I=1,1000
IF(KTAB(I).EQ.-1)GOTO 3000
IF(ATAB(I).EQ.A)GOTO 2025
2024 CONTINUE
PAUSE 'ERROR 6'
2025 K=MOD(KTAB(I),1000)
KQ=KTAB(I)/1000+1
GOTO (5014,5000,2026,2010)KQ
PAUSE 'NO NO'
2026 JVERB=K
JSPK=JSPKT(JVERB)
IF(TWOWDS.NE.0)GOTO 2028
IF(JOBJ.EQ.0)GOTO 2036
2027 GOTO(9000,5066,3000,5031,2009,5031,9404,9406,5081,5200,
1 5200,5300,5506,5502,5504,5505)JVERB
PAUSE 'ERROR 5'
2028 A=WD2
B=' '
TWOWDS=0
GOTO 2023
3000 JSPK=60
IF(RAN(QZ).GT.0.8)JSPK=61
IF(RAN(QZ).GT.0.8)JSPK=13
CALL SPEAK(JSPK)
LTRUBL=LTRUBL+1
IF(LTRUBL.NE.3)GOTO 2020
IF(J.NE.13.OR.IPLACE(7).NE.13.OR.IPLACE(5).NE.-1)GOTO 2032
CALL YES(18,19,54,YEA)
GOTO 2033
2032 IF(J.NE.19.OR.PROP(11).NE.0.OR.IPLACE(7).EQ.-1)GOTO 2034
CALL YES(20,21,54,YEA)
GOTO 2033
2034 IF(J.NE.8.OR.PROP(GRATE).NE.0)GOTO 2035
CALL YES(62,63,54,YEA)
2033 IF(YEA.EQ.0)GOTO 2011
GOTO 2020
2035 IF(IPLACE(5).NE.J.AND.IPLACE(5).NE.-1)GOTO 2020
IF(JOBJ.NE.5)GOTO 2020
CALL SPEAK(22)
GOTO 2020
2036 GOTO(2037,5062,5062,9403,2009,9403,9404,9406,5062,5062,
1 5200,5300,5062,5062,5062,5062)JVERB
PAUSE 'OOPS'
2037 IF((IOBJ(J).EQ.0).OR.(ICHAIN(IOBJ(J)).NE.0)) GOTO 5062
DO 5312 I=1,3
IF(DSEEN(I).NE.0)GOTO 5062
5312 CONTINUE
JOBJ=IOBJ(J)
GOTO 2027
5062 IF(B.NE.' ')GOTO 5333
C TYPE 5063,A
PRINT 5063,A
5063 FORMAT(' ',A5,' WHAT?',/)
GOTO 2020
C5333 TYPE 5334,A,B
5333 PRINT 5334,A,B
5334 FORMAT(' ',2A5,' WHAT?',/)
GOTO 2020
5014 IF(IDARK.EQ.0) GOTO 8
IF(RAN(QZ).GT.0.25) GOTO 8
5017 CALL SPEAK(23)
GOTO 31
C PAUSE 'GAME IS OVER'
C GOTO 2011
5000 JOBJ=K
IF(TWOWDS.NE.0)GOTO 2028
IF((J.EQ.IPLACE(K)).OR.(IPLACE(K).EQ.-1)) GOTO 5004
IF(K.NE.GRATE)GOTO 502
IF((J.EQ.1).OR.(J.EQ.4).OR.(J.EQ.7))GOTO 5098
IF((J.GT.9).AND.(J.LT.15))GOTO 5097
502 IF(B.NE.' ')GOTO 5316
C TYPE 5005,A
PRINT 5005,A
5005 FORMAT(' I SEE NO ',A5,' HERE.',/)
GOTO 2011
C5316 TYPE 5317,A,B
5316 PRINT 5317,A,B
5317 FORMAT(' I SEE NO ',2A5,' HERE.'/)
GOTO 2011
5098 K=49
GOTO 5014
5097 K=50
GOTO 5014
5004 JOBJ=K
IF(JVERB.NE.0)GOTO 2027
5064 IF(B.NE.' ')GOTO 5314
C TYPE 5001,A
PRINT 5001,A
5001 FORMAT(' WHAT DO YOU WANT TO DO WITH THE ',A5,'?',/)
GOTO 2020
C5314 TYPE 5315,A,B
5314 PRINT 5315,A,B
5315 FORMAT(' WHAT DO YOU WANT TO DO WITH THE ',2A5,'?',/)
GOTO 2020
C CARRY
9000 IF(JOBJ.EQ.18)GOTO 2009
IF(IPLACE(JOBJ).NE.J) GOTO 5200
9001 IF(IFIXED(JOBJ).EQ.0)GOTO 9002
CALL SPEAK(25)
GOTO 2011
9002 IF(JOBJ.NE.BIRD)GOTO 9004
IF(IPLACE(ROD).NE.-1)GOTO 9003
CALL SPEAK(26)
GOTO 2011
9003 IF((IPLACE(4).EQ.-1).OR.(IPLACE(4).EQ.J)) GOTO 9004
CALL SPEAK(27)
GOTO 2011
9004 IPLACE(JOBJ)=-1
9005 IF(IOBJ(J).NE.JOBJ) GOTO 9006
IOBJ(J)=ICHAIN(JOBJ)
GOTO 2009
9006 ITEMP=IOBJ(J)
9007 IF(ICHAIN(ITEMP).EQ.(JOBJ)) GOTO 9008
ITEMP=ICHAIN(ITEMP)
GOTO 9007
9008 ICHAIN(ITEMP)=ICHAIN(JOBJ)
GOTO 2009
C LOCK, UNLOCK, NO OBJECT YET
9403 IF((J.EQ.8).OR.(J.EQ.9))GOTO 5105
5032 CALL SPEAK(28)
GOTO 2011
5105 JOBJ=GRATE
GOTO 2027
C DISCARD OBJECT
5066 IF(JOBJ.EQ.18)GOTO 2009
IF(IPLACE(JOBJ).NE.-1) GOTO 5200
5012 IF((JOBJ.NE.BIRD).OR.(J.NE.19).OR.(PROP(11).EQ.1))GOTO 9401
CALL SPEAK(30)
PROP(11)=1
5160 ICHAIN(JOBJ)=IOBJ(J)
IOBJ(J)=JOBJ
IPLACE(JOBJ)=J
GOTO 2011
9401 CALL SPEAK(54)
GOTO 5160
C LOCK,UNLOCK OBJECT
5031 IF(IPLACE(KEYS).NE.-1.AND.IPLACE(KEYS).NE.J)GOTO 5200
IF(JOBJ.NE.4)GOTO 5102
CALL SPEAK(32)
GOTO 2011
5102 IF(JOBJ.NE.KEYS)GOTO 5104
CALL SPEAK(55)
GOTO 2011
5104 IF(JOBJ.EQ.GRATE)GOTO 5107
CALL SPEAK(33)
GOTO 2011
5107 IF(JVERB.EQ.4) GOTO 5033
IF(PROP(GRATE).NE.0)GOTO 5034
CALL SPEAK(34)
GOTO 2011
5034 CALL SPEAK(35)
PROP(GRATE)=0
PROP(8)=0
GOTO 2011
5033 IF(PROP(GRATE).EQ.0)GOTO 5109
CALL SPEAK(36)
GOTO 2011
5109 CALL SPEAK(37)
PROP(GRATE)=1
PROP(8)=1
GOTO 2011
C LIGHT LAMP
9404 IF((IPLACE(2).NE.J).AND.(IPLACE(2).NE.-1))GOTO 5200
PROP(2)=1
IDARK=0
CALL SPEAK(39)
GOTO 2011
C LAMP OFF
9406 IF((IPLACE(2).NE.J).AND.(IPLACE(2).NE.-1)) GOTO 5200
PROP(2)=0
CALL SPEAK(40)
GOTO 2011
C STRIKE
5081 IF(JOBJ.NE.12)GOTO 5200
PROP(12)=1
GOTO 2003
C ATTACK
5300 DO 5313 ID=1,3
IID=ID
IF(DSEEN(ID).NE.0)GOTO 5307
5313 CONTINUE
IF(JOBJ.EQ.0)GOTO 5062
IF(JOBJ.EQ.SNAKE) GOTO 5200
IF(JOBJ.EQ.BIRD) GOTO 5302
CALL SPEAK(44)
GOTO 2011
5302 CALL SPEAK(45)
IPLACE(JOBJ)=300
GOTO 9005
5307 IF(RAN(QZ).GT.0.4) GOTO 5309
DSEEN(IID)=0
ODLOC(IID)=0
DLOC(IID)=0
CALL SPEAK(47)
GOTO 5311
5309 CALL SPEAK(48)
5311 K=21
GOTO 5014
C EAT
5502 IF((IPLACE(FOOD).NE.J.AND.IPLACE(FOOD).NE.-1).OR.PROP(FOOD).NE.0
1 .OR.JOBJ.NE.FOOD)GOTO 5200
PROP(FOOD)=1
5501 JSPK=72
GOTO 5200
C DRINK
5504 IF((IPLACE(WATER).NE.J.AND.IPLACE(WATER).NE.-1)
1 .OR.PROP(WATER).NE.0.OR.JOBJ.NE.WATER) GOTO 5200
PROP(WATER)=1
JSPK=74
GOTO 5200
C RUB
5505 IF(JOBJ.NE.LAMP)JSPK=76
GOTO 5200
C POUR
5506 IF(JOBJ.NE.WATER)JSPK=78
PROP(WATER)=1
GOTO 5200
END
SUBROUTINE SPEAK(IT)
IMPLICIT INTEGER(A-Z)
COMMON RTEXT,LLINE
DIMENSION RTEXT(100),LLINE(1000,22)
KKT=RTEXT(IT)
IF(KKT.EQ.0)RETURN
C999 TYPE 998, (LLINE(KKT,JJT),JJT=3,LLINE(KKT,2))
C998 FORMAT(20A5)
999 PRINT 998, (LLINE(KKT,JJT),JJT=3,LLINE(KKT,2))
998 FORMAT(20A4)
KKT=KKT+1
IF(LLINE(KKT-1,1).NE.0)GOTO 999
C997 TYPE 996
997 PRINT 996
996 FORMAT(/)
RETURN
END
SUBROUTINE GETIN(TWOW,B,C,D)
IMPLICIT INTEGER(A-Z)
CHARACTER B*5,C*5,D*5,LINE*80
DIMENSION A(5),M2(6)
C DATA M2/"4000000000,"20000000,"100000,"400,"2,0/
C6 ACCEPT 1,(A(I), I=1,4)
C1 FORMAT(4A5)
READ(*,1) LINE
1 FORMAT(A)
DO 5 J=1,LEN(LINE)
IF(LINE(J:J).GE.'a'.AND.LINE(J:J).LE.'z')
1 LINE(J:J)=CHAR(ICHAR(LINE(J:J))-ICHAR('a')+ICHAR('A'))
5 CONTINUE
TWOW=0
C S=0
C B=A(1)
C DO 2 J=1,4
C DO 2 K=1,5
C MASK1="774000000000
C IF(K.NE.1) MASK1="177*M2(K)
C IF(((A(J).XOR."201004020100).AND.MASK1).EQ.0)GOTO 3
C IF(S.EQ.0) GOTO 2
C TWOW=1
C CALL SHIFT(A(J),7*(K-1),XX)
C CALL SHIFT(A(J+1),7*(K-6),YY)
C MASK=-M2(6-K)
C C=(XX.AND.MASK)+(YY.AND.(-2-MASK))
C GOTO 4
C3 IF(S.EQ.1) GOTO 2
C S=1
C IF(J.EQ.1) B=(B.AND.-M2(K)).OR.("201004020100.AND.
C 1 (-M2(K).XOR.-1))
C2 CONTINUE
C4 D=A(2)
B=LINE(1:5)
D=LINE(6:10)
J=INDEX(B,' ')
IF(J.NE.0) B(J:)=' '
J=INDEX(D,' ')
IF(J.NE.0) D(J:)=' '
J=INDEX(LINE,' ')
IF(J.GT.2) C=LINE(J+1:)
IF(J.GT.2 .AND. C.NE.' ') TWOW=1
RETURN
END
SUBROUTINE YES(X,Y,Z,YEA)
IMPLICIT INTEGER(A-Z)
CHARACTER*5 IA1,IB1
CALL SPEAK(X)
CALL GETIN(JUNK,IA1,JUNK,IB1)
IF(IA1.EQ.'NO'.OR.IA1.EQ.'N') GOTO 1
YEA=1
IF(Y.NE.0) CALL SPEAK(Y)
RETURN
1 YEA=0
IF(Z.NE.0)CALL SPEAK(Z)
RETURN
END
SUBROUTINE SHIFT (VAL,DIST,RES)
C SHIFT VAL BY |DIST| BITS RIGHT (IF DIST < 0) OR LEFT (IF DIST > 0)
IMPLICIT INTEGER (A-Z)
DATA MR1 /Z'7FFF FFFF'/
DATA ML1 /Z'4000 0000'/
DATA ML2 /Z'3FFF FFFF'/
DATA MSG /Z'8000 0000'/
RES=VAL
IF(DIST)10,20,30
10 IDIST=-DIST
DO 11 I=1,IDIST
J = 0
IF (RES.LT.0) J=MSG
C11 RES = ((RES.AND."377777777777)/2) + J
11 RES = IOR(IAND(RES,MR1)/2,J)
20 RETURN
30 DO 31 I=1,DIST
J = 0
C IF ((RES.AND."200000000000).NE.0) J="400000000000
IF (IAND(RES,ML1).NE.0) J=MSG
C31 RES = (RES.AND."177777777777)*2 + J
31 RES = IOR(IAND(RES,ML2)*2,J)
RETURN
END