home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / sigm / vols000 / vol047 / ballop.for < prev    next >
Encoding:
Text File  |  1984-04-29  |  6.2 KB  |  192 lines
  1. C BALLOP-    BALLOON FUNCTION
  2. C
  3. C COPYRIGHT 1980, INFOCOM COMPUTERS AND COMMUNICATIONS, CAMBRIDGE MA. 02142
  4. C ALL RIGHTS RESERVED, COMMERCIAL USAGE STRICTLY PROHIBITED
  5. C WRITTEN BY R. M. SUPNIK
  6. C
  7. C DECLARATIONS
  8. C
  9.     LOGICAL FUNCTION BALLOP(ARG)
  10.     IMPLICIT INTEGER (A-Z)
  11.     LOGICAL FINDXT,QEMPTY
  12. C
  13. C PARSER OUTPUT
  14. C
  15.     LOGICAL PRSWON
  16.     COMMON /PRSVEC/ PRSA,PRSI,PRSO,PRSWON,PRSCON
  17. C
  18. C GAME STATE
  19. C
  20.     LOGICAL TELFLG
  21.     COMMON /PLAY/ WINNER,HERE,TELFLG
  22.     COMMON /STATE/ MOVES,DEATHS,RWSCOR,MXSCOR,MXLOAD,
  23.     1    LTSHFT,BLOC,MUNGRM,HS,EGSCOR,EGMXSC
  24. C
  25. C ROOMS
  26. C
  27.     COMMON /ROOMS/ RLNT,RDESC2,RDESC1(200),REXIT(200),
  28.     1    RACTIO(200),RVAL(200),RFLAG(200)
  29.     INTEGER RRAND(200)
  30.     EQUIVALENCE (RVAL,RRAND)
  31. C
  32.     COMMON /RFLAG/ RSEEN,RLIGHT,RLAND,RWATER,RAIR,
  33.     1    RSACRD,RFILL,RMUNG,RBUCK,RHOUSE,RNWALL,REND
  34. C
  35. C EXITS
  36. C
  37.     COMMON /CURXT/ XTYPE,XROOM1,XSTRNG,XACTIO,XOBJ
  38.     EQUIVALENCE (XFLAG,XOBJ)
  39. C
  40.     COMMON /XPARS/ XRMASK,XDMASK,XFMASK,XFSHFT,XASHFT,
  41.     1    XELNT(4),XNORM,XNO,XCOND,XDOOR,XLFLAG
  42. C
  43. C OBJECTS
  44. C
  45.     COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220),
  46.     1    OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220),
  47.     2    OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220),
  48.     3    OADV(220),OCAN(220),OREAD(220)
  49. C
  50.     COMMON /OFLAGS/ VISIBT,READBT,TAKEBT,DOORBT,TRANBT,FOODBT,
  51.     1    NDSCBT,DRNKBT,CONTBT,LITEBT,VICTBT,BURNBT,FLAMBT,
  52.     2    TOOLBT,TURNBT,ONBT
  53.     COMMON /OFLAGS/ FINDBT,SLEPBT,SCRDBT,TIEBT,CLMBBT,ACTRBT,
  54.     1    WEAPBT,FITEBT,VILLBT,STAGBT,TRYBT,NOCHBT,OPENBT,
  55.     2    TCHBT,VEHBT,SCHBT
  56. C
  57.     COMMON /OINDEX/ GARLI,FOOD,GUNK,COAL,MACHI,DIAMO,TCASE,BOTTL
  58.     COMMON /OINDEX/ WATER,ROPE,KNIFE,SWORD,LAMP,BLAMP,RUG
  59.     COMMON /OINDEX/    LEAVE,TROLL,AXE
  60.     COMMON /OINDEX/ RKNIF,KEYS,ICE,BAR
  61.     COMMON /OINDEX/ COFFI,TORCH,TBASK,FBASK,IRBOX
  62.     COMMON /OINDEX/ GHOST,TRUNK,BELL,BOOK,CANDL
  63.     COMMON /OINDEX/ MATCH,TUBE,PUTTY,WRENC,SCREW,CYCLO,CHALI
  64.     COMMON /OINDEX/ THIEF,STILL,WINDO,GRATE,DOOR
  65.     COMMON /OINDEX/ HPOLE,LEAK,RBUTT,RAILI
  66.     COMMON /OINDEX/ POT,STATU,IBOAT,DBOAT,PUMP,RBOAT
  67.     COMMON /OINDEX/ STICK,BUOY,SHOVE,BALLO,RECEP,GUANO
  68.     COMMON /OINDEX/ BROPE,HOOK1,HOOK2,SAFE,SSLOT,BRICK,FUSE
  69.     COMMON /OINDEX/ GNOME,BLABE,DBALL,TOMB
  70.     COMMON /OINDEX/ LCASE,CAGE,RCAGE,SPHER,SQBUT
  71.     COMMON /OINDEX/ FLASK,POOL,SAFFR,BUCKE,ECAKE,ORICE,RDICE,BLICE
  72.     COMMON /OINDEX/ ROBOT,FTREE,BILLS,PORTR,SCOL,ZGNOM
  73.     COMMON /OINDEX/ EGG,BEGG,BAUBL,CANAR,BCANA
  74.     COMMON /OINDEX/ YLWAL,RDWAL,PINDR,RBEAM
  75.     COMMON /OINDEX/ ODOOR,QDOOR,CDOOR,NUM1,NUM8
  76.     COMMON /OINDEX/ WARNI,CSLIT,GCARD,STLDR
  77.     COMMON /OINDEX/ HANDS,WALL,LUNGS,SAILO,AVIAT,TEETH
  78.     COMMON /OINDEX/ ITOBJ,EVERY,VALUA,OPLAY,WNORT,GWATE,MASTER
  79. C
  80. C CLOCK INTERRUPTS
  81. C
  82.     LOGICAL*1 CFLAG
  83.     COMMON /CEVENT/ CLNT,CTICK(25),CACTIO(25),CFLAG(25)
  84. C
  85.     COMMON /CINDEX/ CEVCUR,CEVMNT,CEVLNT,CEVMAT,CEVCND,
  86.     1    CEVBAL,CEVBRN,CEVFUS,CEVLED,CEVSAF,CEVVLG,
  87.     2    CEVGNO,CEVBUC,CEVSPH,CEVEGH,
  88.     3    CEVFOR,CEVSCL,CEVZGI,CEVZGO,CEVSTE,
  89.     5    CEVMRS,CEVPIN,CEVINQ,CEVFOL
  90.  
  91. C
  92. C VERBS
  93. C
  94.     COMMON /VINDEX/ CINTW,DEADXW,FRSTQW,INXW,OUTXW
  95.     COMMON /VINDEX/ WALKIW,FIGHTW,FOOW
  96.     COMMON /VINDEX/ MELTW,READW,INFLAW,DEFLAW,ALARMW,EXORCW
  97.     COMMON /VINDEX/ PLUGW,KICKW,WAVEW,RAISEW,LOWERW,RUBW
  98.     COMMON /VINDEX/ PUSHW,UNTIEW,TIEW,TIEUPW,TURNW,BREATW
  99.     COMMON /VINDEX/ KNOCKW,LOOKW,EXAMIW,SHAKEW,MOVEW,TRNONW,TRNOFW
  100.     COMMON /VINDEX/ OPENW,CLOSEW,FINDW,WAITW,SPINW,BOARDW,UNBOAW,TAKEW
  101.     COMMON /VINDEX/ INVENW,FILLW,EATW,DRINKW,BURNW
  102.     COMMON /VINDEX/ MUNGW,KILLW,ATTACW,SWINGW
  103.     COMMON /VINDEX/ WALKW,TELLW,PUTW,DROPW,GIVEW,POURW,THROWW
  104.     COMMON /VINDEX/ DIGW,LEAPW,STAYW,FOLLOW
  105.     COMMON /VINDEX/ HELLOW,LOOKIW,LOOKUW,PUMPW,WINDW
  106.     COMMON /VINDEX/ CLMBW,CLMBUW,CLMBDW,TRNTOW
  107. C
  108. C FLAGS
  109. C
  110.     LOGICAL*1 TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF
  111.     LOGICAL*1 DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF
  112.     LOGICAL*1 MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF
  113.     LOGICAL*1 EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF
  114.     LOGICAL*1 GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF
  115.     LOGICAL*1 GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF
  116.     LOGICAL*1 MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF
  117.     LOGICAL*1 FOLLWF,SPELLF,CPOUTF,CPUSHF
  118.     COMMON /FINDEX/ TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF,
  119.     1    DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF,
  120.     2    MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF,
  121.     3    EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF,
  122.     4    GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF,
  123.     5    GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF,
  124.     6    MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF,
  125.     7    FOLLWF,SPELLF,CPOUTF,CPUSHF
  126.     COMMON /FINDEX/ BTIEF,BINFF
  127.     COMMON /FINDEX/ RVMNT,RVCLR,RVCYC,RVSND,RVGUA
  128.     COMMON /FINDEX/ ORRUG,ORCAND,ORMTCH,ORLAMP
  129.     COMMON /FINDEX/ MDIR,MLOC,POLEUF
  130.     COMMON /FINDEX/ QUESNO,NQATT,CORRCT
  131.     COMMON /FINDEX/ LCELL,PNUMB,ACELL,DCELL,CPHERE
  132. C BALLOP, PAGE 2
  133. C
  134.     BALLOP=.TRUE.                !ASSUME WINS.
  135.     IF(ARG.NE.2) GO TO 200            !READOUT?
  136.     IF(PRSA.NE.LOOKW) GO TO 10        !ONLY PROCESS LOOK.
  137.     IF(BINFF.NE.0) GO TO 50            !INFLATED?
  138.     CALL RSPEAK(543)            !NO.
  139.     GO TO 100
  140. 50    CALL RSPSUB(544,ODESC2(BINFF))        !YES.
  141. 100    IF(BTIEF.NE.0) CALL RSPEAK(545)        !HOOKED?
  142.     RETURN
  143. C
  144. 200    IF(ARG.NE.1) GO TO 500            !READIN?
  145.     IF(PRSA.NE.WALKW) GO TO 300        !WALK?
  146.     IF(FINDXT(PRSO,HERE)) GO TO 250        !VALID EXIT?
  147.     CALL RSPEAK(546)            !NO, JOKE.
  148.     RETURN
  149. C
  150. 250    IF(BTIEF.EQ.0) GO TO 275        !TIED UP?
  151.     CALL RSPEAK(547)            !YES, JOKE.
  152.     RETURN
  153. C
  154. 275    IF(XTYPE.NE.XNORM) GO TO 10        !NORMAL EXIT?
  155.     IF((RFLAG(XROOM1).AND.RMUNG).EQ.0) BLOC=XROOM1
  156. 10    BALLOP=.FALSE.
  157.     RETURN
  158. C
  159. 300    IF((PRSA.NE.TAKEW).OR.(PRSO.NE.BINFF)) GO TO 350
  160.     CALL RSPSUB(548,ODESC2(BINFF))        !RECEP CONT TOO HOT.
  161.     RETURN
  162. C
  163. 350    IF((PRSA.NE.PUTW).OR.(PRSI.NE.RECEP).OR.QEMPTY(RECEP))
  164.     1    GO TO 10            !RECEP ALREADY FULL.
  165.     CALL RSPEAK(549)
  166.     RETURN
  167. C
  168. 500    IF((PRSA.NE.UNBOAW).OR.((RFLAG(HERE).AND.RLAND).EQ.0))
  169.     1    GO TO 600            !DISEMBARK ON LAND?
  170.     IF(BINFF.NE.0) CTICK(CEVBAL)=3        !HE GOT OUT, START BALLOON.
  171.     GO TO 10
  172. C
  173. 600    IF((PRSA.NE.BURNW).OR.(OCAN(PRSO).NE.RECEP)) GO TO 700
  174.     CALL RSPSUB(550,ODESC2(PRSO))        !LIGHT FIRE IN RECEP.
  175.     CTICK(CEVBRN)=OSIZE(PRSO)*20
  176.     OFLAG1(PRSO)=(OFLAG1(PRSO).OR.(ONBT+FLAMBT+LITEBT)).AND.
  177.     1    .NOT.(TAKEBT+READBT)        !BURN IT.
  178.     IF(BINFF.NE.0) RETURN            !ALREADY INFLATED?
  179.     IF(.NOT.BLABF) CALL NEWSTA(BLABE,0,0,BALLO,0)    !INSERT LABEL.
  180.     BLABF=.TRUE.                !ONLY ONCE.
  181.     BINFF=PRSO
  182.     CTICK(CEVBAL)=3                !START COUNTDOWN.
  183.     CALL RSPEAK(551)
  184.     RETURN
  185. C
  186. 700    IF((PRSA.EQ.UNBOAW).AND.(BINFF.NE.0).AND.
  187.     1    ((RFLAG(HERE).AND.RLAND).NE.0))
  188.     2    CTICK(CEVBAL)=3
  189.     GO TO 10
  190. C
  191.     END
  192.