Advertisement
Not a member of Pastebin yet?
Sign Up,
it unlocks many cool features!
- C ADVENTURES
- IMPLICIT INTEGER(A-Z)
- REAL RAN
- COMMON RTEXT,LLINE
- 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)
- 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
- DATA(JSPKT(I),I=1,16)/24,29,0,31,0,31,38,38,42,42,43,46,77,71,73,75/
- 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/
- 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,15)/36,28,19,30,62,60,41,27,17,15,19,28,36,300,300/
- 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(UNIT=1,NAME='TEXT',ACCESS='SEQIN')
- 1002 READ(1,1003) IKIND
- 1003 FORMAT(G)
- GOTO(1100,1004,1004,1013,1020,1004,1004)(IKIND+1)
- 1004 READ(1,1005)JKIND,(LLINE(I,J),J=3,22)
- 1005 FORMAT(1G,20A5)
- IF(JKIND.EQ.-1) GOTO 1002
- DO 1006 K=1,20
- KK=K
- IF(LLINE(I,21-K).NE.ichar(' ')) GOTO 1007
- C getting an illegal comparison here, something I think do to with the char
- C IF(LLINE(I,21-K).NE.' ') GOTO 1007
- C like below switched to ichar(' ') to fix (instead of setting to zero)
- 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)
- 1015 FORMAT(12G)
- 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)
- 1021 FORMAT(G,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)=IPLT(I)
- 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
- PAUSE '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(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
- IF(2*I+IDWARF.LT.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
- PRINT 67,DTOT
- 67 FORMAT(' THERE ARE ',I2,' THREATENING LITTLE DWARVES IN THE ROOM WITH YOU.',/)
- GOTO 77
- 75 CALL SPEAK(4)
- 77 IF(ATTACK.EQ.0)GOTO 71
- IF(ATTACK.EQ.1)GOTO 79
- 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
- PRINT 68,STICK
- 68 FORMAT(' ',I2,' OF THEM GET YOU.',/)
- GOTO 83
- 82 CALL SPEAK(6)
- 83 PAUSE 'GAMES OVER'
- GOTO 71
- 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
- 4 PRINT 5,(LLINE(KK,JJ),JJ=3,LLINE(KK,2))
- 5 FORMAT(20A5)
- KK=KK+1
- IF(LLINE(KK-1,1).NE.0) GOTO 4
- 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)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
- GOTO(22,23,24,25,26,31,27,28,29,30,33,34,36,37)IL
- 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
- 31 PAUSE 'GAME IS OVER'
- 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
- 2005 PRINT 2006,(LLINE(KK,JJ),JJ=3,LLINE(KK,2))
- 2006 FORMAT(20A5)
- KK=KK+1
- IF(LLINE(KK-1,1).NE.0) GOTO 2005
- PRINT 2007
- 2007 FORMAT(/)
- 2008 I=ICHAIN(I)
- GOTO 2004
- C K=1 MEANS ANY INPUT
- 2012 A=WD2
- B=ichar(' ')
- C using ichar seemed to fix the issue of impossible conversion
- 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.51420518.AND.(WD2.EQ.19201851.OR.WD2.EQ.23120518))GOTO 2010
- C IF(A.EQ.'ENTER'.AND.(WD2.EQ.'STREA'.OR.WD2.EQ.'WATER'))GOTO 2010
- C having an issue with string comparison (as with lines below as well)
- IF(A.EQ.51420518.AND.TWOWDS.NE.0)GOTO 2012
- C IF(A.EQ.'ENTER'.AND.TWOWDS.NE.0)GOTO 2012
- 2021 IF(A.NE.2351920)GOTO 2023
- C 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,5200,5300,5506,5502,5504,5505)JVERB
- PAUSE 'ERROR 5'
- 2028 A=WD2
- B=ichar(' ')
- C used ichar
- 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,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.ichar(' '))GOTO 5333
- PRINT 5063,A
- 5063 FORMAT(' ',A5,' WHAT?',/)
- GOTO 2020
- 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)
- PAUSE 'GAME IS OVER'
- 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.ichar(' '))GOTO 5316
- PRINT 5005,A
- 5005 FORMAT(' I SEE NO ',A5,' HERE.',/)
- GOTO 2011
- 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.ichar(' '))GOTO 5314
- PRINT 5001,A
- 5001 FORMAT(' WHAT DO YOU WANT TO DO WITH THE ',A5,'?',/)
- GOTO 2020
- 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.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).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
- 999 PRINT 998, (LLINE(KKT,JJT),JJT=3,LLINE(KKT,2))
- 998 FORMAT(20A5)
- KKT=KKT+1
- IF(LLINE(KKT-1,1).NE.0)GOTO 999
- 997 PRINT 996
- 996 FORMAT(/)
- RETURN
- END
- SUBROUTINE GETIN(TWOW,B,C,D)
- IMPLICIT INTEGER(A-Z)
- DIMENSION A(5),M2(6)
- DATA M2/O"4000000000",O"20000000",O"100000",O"400",O"2",0/
- 6 READ 1,(A(I), I=1,4)
- 1 FORMAT(4A5)
- TWOW=0
- S=0
- B=A(1)
- DO 2 J=1,4
- DO 2 K=1,5
- MASK1=O"774000000000"
- IF(K.NE.1) MASK1=O"177"*M2(K)
- IF(IAND((XOR(A(J),O"201004020100")),MASK1).EQ.0) GOTO 3
- C !!!!!! NOTE: IEOR might be used instead of XOR
- IF(S.EQ.0) GOTO 2
- TWOW=1
- CALL SHIFT(A(J),7*(K-1),XX)
- CALL SHIFT(A(J+1),7*(K-6),YY)
- MASK=-M2(6-K)
- C=IAND(XX,MASK)+IAND(YY,(-2-MASK))
- GOTO 4
- 3 IF(S.EQ.1) GOTO 2
- S=1
- IF(J.EQ.1) B=IOR((IAND(B,-M2(K))),(IAND(O"201004020100",(XOR(-M2(K),-1)))))
- C !!!!!! NOTE: IEOR might be used instead of XOR
- 2 CONTINUE
- 4 D=A(2)
- RETURN
- END
- SUBROUTINE YES(X,Y,Z,YEA)
- IMPLICIT INTEGER(A-Z)
- CALL SPEAK(X)
- CALL GETIN(JUNK,IA1,JUNK,IB1)
- IF(IA1.EQ.1415.OR.IA1.EQ.ichar('N')) GOTO 1
- C IF(IA1.EQ.'NO'.OR.IA1.EQ.ichar('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)
- IMPLICIT INTEGER (A-Z)
- RES=VAL
- IF(DIST)10,20,30
- 10 IDIST=-DIST
- DO 11 I=1,IDIST
- J = 0
- IF (RES.LT.0) J=O"200000000000"
- 11 RES=((IAND(RES,O"377777777777")/2)+J)
- 20 RETURN
- 30 DO 31 I=1,DIST
- j = 0
- IF((IAND(RES,O"200000000000")).NE.0) J=O"400000000000"
- 31 RES=((IAND(RES,O"177777777777"))*2)+J
- RETURN
- END
Advertisement
Add Comment
Please, Sign In to add comment
Advertisement