Advertisement
Ange1ofD4rkness

Advf4_AlteredFortranCode

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