home *** CD-ROM | disk | FTP | other *** search
/ CP/M / CPM_CDROM.iso / simtel / sigm / vols000 / vol045 / dgame.ftn < prev    next >
Encoding:
Text File  |  1984-04-29  |  9.2 KB  |  306 lines
  1. C GAME- MAIN COMMAND LOOP FOR DUNGEON
  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.     SUBROUTINE GAME
  10.     IMPLICIT INTEGER (A-Z)
  11.     LOGICAL RMDESC,VAPPLI,RAPPLI,AAPPLI
  12.     LOGICAL F,PARSE,FINDXT,XVEHIC,LIT
  13.     LOGICAL*1 SECHO(4),GDTSTR(3)
  14. C
  15. C PARSER OUTPUT
  16. C
  17.     LOGICAL PRSWON
  18.     COMMON /PRSVEC/ PRSA,PRSI,PRSO,PRSWON,PRSCON
  19. C
  20. C GAME STATE
  21. C
  22.     LOGICAL TELFLG
  23.     COMMON /PLAY/ WINNER,HERE,TELFLG
  24.     COMMON /STATE/ MOVES,DEATHS,RWSCOR,MXSCOR,MXLOAD,
  25.     1    LTSHFT,BLOC,MUNGRM,HS,EGSCOR,EGMXSC
  26. C
  27. C MISCELLANEOUS VARIABLES
  28. C
  29.     LOGICAL*1 INLINE
  30.     COMMON /INPUT/ INLNT,INLINE(78)
  31.     COMMON /CHAN/ INPCH,OUTCH,DBCH
  32. C
  33. C ROOMS
  34. C
  35.     COMMON /ROOMS/ RLNT,RDESC2,RDESC1(200),REXIT(200),
  36.     1    RACTIO(200),RVAL(200),RFLAG(200)
  37.     INTEGER RRAND(200)
  38.     EQUIVALENCE (RVAL,RRAND)
  39. C
  40.     COMMON /RINDEX/ WHOUS,LROOM,CELLA
  41.     COMMON /RINDEX/ MTROL,MAZE1    
  42.     COMMON /RINDEX/ MGRAT,MAZ15    
  43.     COMMON /RINDEX/ FORE1,FORE3,CLEAR,RESER
  44.     COMMON /RINDEX/ STREA,EGYPT,ECHOR
  45.     COMMON /RINDEX/ TSHAF    
  46.     COMMON /RINDEX/ BSHAF,MMACH,DOME,MTORC
  47.     COMMON /RINDEX/ CAROU    
  48.     COMMON /RINDEX/ RIDDL,LLD2,TEMP1,TEMP2,MAINT
  49.     COMMON /RINDEX/ BLROO,TREAS,RIVR1,RIVR2,RIVR3,MCYCL
  50.     COMMON /RINDEX/ RIVR4,RIVR5,FCHMP,FALLS,MBARR
  51.     COMMON /RINDEX/ MRAIN,POG,VLBOT,VAIR1,VAIR2,VAIR3,VAIR4
  52.     COMMON /RINDEX/ LEDG2,LEDG3,LEDG4,MSAFE,CAGER
  53.     COMMON /RINDEX/ CAGED,TWELL,BWELL,ALICE,ALISM,ALITR
  54.     COMMON /RINDEX/ MTREE,BKENT,BKVW,BKTWI,BKVAU,BKBOX
  55.     COMMON /RINDEX/ CRYPT,TSTRS,MRANT,MREYE
  56.     COMMON /RINDEX/ MRA,MRB,MRC,MRG,MRD,FDOOR
  57.     COMMON /RINDEX/ MRAE,MRCE,MRCW,MRGE,MRGW,MRDW,INMIR
  58.     COMMON /RINDEX/ SCORR,NCORR,PARAP,CELL,PCELL,NCELL
  59.     COMMON /RINDEX/ CPANT,CPOUT,CPUZZ
  60. C
  61. C OBJECTS
  62. C
  63.     COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220),
  64.     1    OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220),
  65.     2    OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220),
  66.     3    OADV(220),OCAN(220),OREAD(220)
  67. C
  68.     COMMON /OFLAGS/ VISIBT,READBT,TAKEBT,DOORBT,TRANBT,FOODBT,
  69.     1    NDSCBT,DRNKBT,CONTBT,LITEBT,VICTBT,BURNBT,FLAMBT,
  70.     2    TOOLBT,TURNBT,ONBT
  71.     COMMON /OFLAGS/ FINDBT,SLEPBT,SCRDBT,TIEBT,CLMBBT,ACTRBT,
  72.     1    WEAPBT,FITEBT,VILLBT,STAGBT,TRYBT,NOCHBT,OPENBT,
  73.     2    TCHBT,VEHBT,SCHBT
  74. C
  75.     COMMON /OINDEX/ GARLI,FOOD,GUNK,COAL,MACHI,DIAMO,TCASE,BOTTL
  76.     COMMON /OINDEX/ WATER,ROPE,KNIFE,SWORD,LAMP,BLAMP,RUG
  77.     COMMON /OINDEX/    LEAVE,TROLL,AXE
  78.     COMMON /OINDEX/ RKNIF,KEYS,ICE,BAR
  79.     COMMON /OINDEX/ COFFI,TORCH,TBASK,FBASK,IRBOX
  80.     COMMON /OINDEX/ GHOST,TRUNK,BELL,BOOK,CANDL
  81.     COMMON /OINDEX/ MATCH,TUBE,PUTTY,WRENC,SCREW,CYCLO,CHALI
  82.     COMMON /OINDEX/ THIEF,STILL,WINDO,GRATE,DOOR
  83.     COMMON /OINDEX/ HPOLE,LEAK,RBUTT,RAILI
  84.     COMMON /OINDEX/ POT,STATU,IBOAT,DBOAT,PUMP,RBOAT
  85.     COMMON /OINDEX/ STICK,BUOY,SHOVE,BALLO,RECEP,GUANO
  86.     COMMON /OINDEX/ BROPE,HOOK1,HOOK2,SAFE,SSLOT,BRICK,FUSE
  87.     COMMON /OINDEX/ GNOME,BLABE,DBALL,TOMB
  88.     COMMON /OINDEX/ LCASE,CAGE,RCAGE,SPHER,SQBUT
  89.     COMMON /OINDEX/ FLASK,POOL,SAFFR,BUCKE,ECAKE,ORICE,RDICE,BLICE
  90.     COMMON /OINDEX/ ROBOT,FTREE,BILLS,PORTR,SCOL,ZGNOM
  91.     COMMON /OINDEX/ EGG,BEGG,BAUBL,CANAR,BCANA
  92.     COMMON /OINDEX/ YLWAL,RDWAL,PINDR,RBEAM
  93.     COMMON /OINDEX/ ODOOR,QDOOR,CDOOR,NUM1,NUM8
  94.     COMMON /OINDEX/ WARNI,CSLIT,GCARD,STLDR
  95.     COMMON /OINDEX/ HANDS,WALL,LUNGS,SAILO,AVIAT,TEETH
  96.     COMMON /OINDEX/ ITOBJ,EVERY,VALUA,OPLAY,WNORT,GWATE,MASTER
  97. C
  98. C ADVENTURERS
  99. C
  100.     COMMON /ADVS/ ALNT,AROOM(4),ASCORE(4),AVEHIC(4),
  101.     1    AOBJ(4),AACTIO(4),ASTREN(4),AFLAG(4)
  102. C
  103.     COMMON /AINDEX/ PLAYER,AROBOT,AMASTR
  104. C
  105. C VERBS
  106. C
  107.     COMMON /VINDEX/ CINTW,DEADXW,FRSTQW,INXW,OUTXW
  108.     COMMON /VINDEX/ WALKIW,FIGHTW,FOOW
  109.     COMMON /VINDEX/ MELTW,READW,INFLAW,DEFLAW,ALARMW,EXORCW
  110.     COMMON /VINDEX/ PLUGW,KICKW,WAVEW,RAISEW,LOWERW,RUBW
  111.     COMMON /VINDEX/ PUSHW,UNTIEW,TIEW,TIEUPW,TURNW,BREATW
  112.     COMMON /VINDEX/ KNOCKW,LOOKW,EXAMIW,SHAKEW,MOVEW,TRNONW,TRNOFW
  113.     COMMON /VINDEX/ OPENW,CLOSEW,FINDW,WAITW,SPINW,BOARDW,UNBOAW,TAKEW
  114.     COMMON /VINDEX/ INVENW,FILLW,EATW,DRINKW,BURNW
  115.     COMMON /VINDEX/ MUNGW,KILLW,ATTACW,SWINGW
  116.     COMMON /VINDEX/ WALKW,TELLW,PUTW,DROPW,GIVEW,POURW,THROWW
  117.     COMMON /VINDEX/ DIGW,LEAPW,STAYW,FOLLOW
  118.     COMMON /VINDEX/ HELLOW,LOOKIW,LOOKUW,PUMPW,WINDW
  119.     COMMON /VINDEX/ CLMBW,CLMBUW,CLMBDW,TRNTOW
  120. C
  121. C FLAGS
  122. C
  123.     LOGICAL*1 TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF
  124.     LOGICAL*1 DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF
  125.     LOGICAL*1 MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF
  126.     LOGICAL*1 EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF
  127.     LOGICAL*1 GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF
  128.     LOGICAL*1 GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF
  129.     LOGICAL*1 MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF
  130.     LOGICAL*1 FOLLWF,SPELLF,CPOUTF,CPUSHF
  131.     COMMON /FINDEX/ TROLLF,CAGESF,BUCKTF,CAROFF,CAROZF,LWTIDF,
  132.     1    DOMEF,GLACRF,ECHOF,RIDDLF,LLDF,CYCLOF,
  133.     2    MAGICF,LITLDF,SAFEF,GNOMEF,GNODRF,MIRRMF,
  134.     3    EGYPTF,ONPOLF,BLABF,BRIEFF,SUPERF,BUOYF,
  135.     4    GRUNLF,GATEF,RAINBF,CAGETF,EMPTHF,DEFLAF,
  136.     5    GLACMF,FROBZF,ENDGMF,BADLKF,THFENF,SINGSF,
  137.     6    MRPSHF,MROPNF,WDOPNF,MR1F,MR2F,INQSTF,
  138.     7    FOLLWF,SPELLF,CPOUTF,CPUSHF
  139.     COMMON /FINDEX/ BTIEF,BINFF
  140.     COMMON /FINDEX/ RVMNT,RVCLR,RVCYC,RVSND,RVGUA
  141.     COMMON /FINDEX/ ORRUG,ORCAND,ORMTCH,ORLAMP
  142.     COMMON /FINDEX/ MDIR,MLOC,POLEUF
  143.     COMMON /FINDEX/ QUESNO,NQATT,CORRCT
  144.     COMMON /FINDEX/ LCELL,PNUMB,ACELL,DCELL,CPHERE
  145. C
  146. C FUNCTIONS AND DATA
  147. C
  148.     DATA SECHO/'E','C','H','O'/
  149.     DATA GDTSTR/'G','D','T'/
  150. C GAME, PAGE 2
  151. C
  152. C START UP, DESCRIBE CURRENT LOCATION.
  153. C
  154.     CALL RSPEAK(1)                !WELCOME ABOARD.
  155.     F=RMDESC(3)                !START GAME.
  156. C
  157. C NOW LOOP, READING AND EXECUTING COMMANDS.
  158. C
  159. 100    WINNER=PLAYER                !PLAYER MOVING.
  160.     TELFLG=.FALSE.                !ASSUME NOTHING TOLD.
  161.     IF(PRSCON.LE.1) CALL RDLINE(INLINE,INLNT,1) !READ COMMAND.
  162. C
  163.     DO 150 I=1,3                !CALL ON GDT?
  164.       IF(INLINE(I+PRSCON-1).NE.GDTSTR(I)) GO TO 200
  165. 150    CONTINUE
  166.     CALL GDT                !YES, INVOKE.
  167.     GO TO 100                !ONWARD.
  168. C
  169. 200    MOVES=MOVES+1
  170.     PRSWON=PARSE(INLINE,INLNT,.TRUE.)    !PARSE INPUT, NORMAL MODE.
  171.     IF(.NOT.PRSWON) GO TO 400        !PARSE LOSES?
  172.     IF(XVEHIC(1)) GO TO 400            !VEHICLE HANDLE?
  173. C
  174.     IF(PRSA.EQ.TELLW) GO TO 2000        !TELL?
  175. 300    IF((PRSO.EQ.VALUA).OR.(PRSO.EQ.EVERY)) GO TO 900
  176.     IF(.NOT.VAPPLI(PRSA)) GO TO 400        !VERB OK?
  177. 350    IF(.NOT.ECHOF.AND.(HERE.EQ.ECHOR)) GO TO 1000
  178.     F=RAPPLI(RACTIO(HERE))
  179. C
  180. 400    CALL XENDMV(TELFLG)            !DO END OF MOVE.
  181.     IF(.NOT.LIT(HERE)) PRSCON=1
  182.     GO TO 100
  183. C
  184. 900    CALL VALUAC(VALUA)
  185.     GO TO 350
  186. C GAME, PAGE 3
  187. C
  188. C SPECIAL CASE-- ECHO ROOM.
  189. C IF INPUT IS NOT 'ECHO' OR A DIRECTION, JUST ECHO.
  190. C
  191. 1000    CALL RDLINE(INLINE,INLNT,0)        !READ LINE.
  192.     MOVES=MOVES+1                !CHARGE FOR MOVES.
  193.     DO 1100 I=1,4                !INPUT = ECHO?
  194.       IF(INLINE(I).NE.SECHO(I)) GO TO 1300
  195. 1100    CONTINUE
  196. C
  197.     DO 1200 I=5,78                !REST BLANK?
  198.       IF(INLINE(I).NE.' ') GO TO 1300
  199. 1200    CONTINUE
  200. C
  201.     CALL RSPEAK(571)            !KILL THE ECHO.
  202.     ECHOF=.TRUE.
  203.     OFLAG2(BAR)=OFLAG2(BAR).AND. .NOT.SCRDBT !LET THIEF STEAL BAR.
  204.     PRSWON=.TRUE.                !FAKE OUT PARSER.
  205.     PRSCON=1                !FORCE NEW INPUT.
  206.     GO TO 400
  207. C
  208. 1300    PRSWON=PARSE(INLINE,INLNT,.FALSE.)    !PARSE INPUT, ECHO MODE.
  209.     IF(.NOT.PRSWON .OR. (PRSA.NE.WALKW))
  210.     1    GO TO 1400            !WALK?
  211.     IF(FINDXT(PRSO,HERE)) GO TO 300        !VALID EXIT?
  212. C
  213. 1400    WRITE(OUTCH,1410) (INLINE(J),J=1,INLNT)    !ECHO INPUT.
  214. 1410    FORMAT(1X,78A1)
  215.     TELFLG=.TRUE.                !INDICATE OUTPUT.
  216.     GO TO 1000                !MORE ECHO ROOM.
  217. C GAME, PAGE 4
  218. C
  219. C SPECIAL CASE-- TELL <ACTOR>, NEW COMMAND
  220. C NOTE THAT WE CANNOT BE IN THE ECHO ROOM.
  221. C
  222. 2000    IF((OFLAG2(PRSO).AND.ACTRBT).NE.0) GO TO 2100 !ACTOR?
  223.     CALL RSPEAK(602)            !CANT DO IT.
  224.     GO TO 350                !VAPPLI SUCCEEDS.
  225. C
  226. 2100    WINNER=OACTOR(PRSO)            !NEW PLAYER.
  227.     HERE=AROOM(WINNER)            !NEW LOCATION.
  228.     IF(PRSCON.LE.1) GO TO 2700        !ANY INPUT?
  229.     IF(PARSE(INLINE,INLNT,.TRUE.)) GO TO 2150    !PARSE COMMAND.
  230. 2700    I=341                    !FAILS.
  231.     IF(TELFLG) I=604            !GIVE RESPONSE.
  232.     CALL RSPEAK(I)
  233. 2600    WINNER=PLAYER                !RESTORE STATE.
  234.     HERE=AROOM(WINNER)
  235.     GO TO 350
  236. C
  237. 2150    IF(AAPPLI(AACTIO(WINNER))) GO TO 2400    !ACTOR HANDLE?
  238.     IF(XVEHIC(1)) GO TO 2400        !VEHICLE HANDLE?
  239.     IF((PRSO.EQ.VALUA).OR.(PRSO.EQ.EVERY)) GO TO 2900
  240.     IF(.NOT.VAPPLI(PRSA)) GO TO 2400    !VERB HANDLE?
  241. 2350    F=RAPPLI(RACTIO(HERE))
  242. C
  243. 2400    CALL XENDMV(TELFLG)            !DO END OF MOVE.
  244.     GO TO 2600                !DONE.
  245. C
  246. 2900    CALL VALUAC(VALUA)            !ALL OR VALUABLES.
  247.     GO TO 350
  248. C
  249.     END
  250. C XENDMV-    EXECUTE END OF MOVE FUNCTIONS.
  251. C
  252. C DECLARATIONS
  253. C
  254.     SUBROUTINE XENDMV(FLAG)
  255.     IMPLICIT INTEGER(A-Z)
  256.     LOGICAL F,CLOCKD,FLAG,XVEHIC
  257. C
  258. C PARSER OUTPUT
  259. C
  260.     LOGICAL PRSWON
  261.     COMMON /PRSVEC/ PRSA,PRSO,PRSI,PRSWON,PRSCON
  262. C
  263. C VILLAINS AND DEMONS
  264. C
  265.     LOGICAL THFFLG,SWDACT,THFACT
  266.     COMMON /HACK/ THFPOS,THFFLG,THFACT,SWDACT,SWDSTA
  267. C
  268.     IF(.NOT.FLAG) CALL RSPEAK(341)        !DEFAULT REMARK.
  269.     IF(THFACT) CALL THIEFD            !THIEF DEMON.
  270.     IF(PRSWON) CALL FIGHTD            !FIGHT DEMON.
  271.     IF(SWDACT) CALL SWORDD            !SWORD DEMON.
  272.     IF(PRSWON) F=CLOCKD(X)            !CLOCK DEMON.
  273.     IF(PRSWON) F=XVEHIC(2)            !VEHICLE READOUT.
  274.     RETURN
  275.     END
  276. C XVEHIC- EXECUTE VEHICLE FUNCTION
  277. C
  278. C DECLARATIONS
  279. C
  280.     LOGICAL FUNCTION XVEHIC(N)
  281.     IMPLICIT INTEGER(A-Z)
  282.     LOGICAL OAPPLI
  283. C
  284. C GAME STATE
  285. C
  286.     LOGICAL TELFLG
  287.     COMMON /PLAY/ WINNER,HERE,TELFLG
  288. C
  289. C OBJECTS
  290. C
  291.     COMMON /OBJCTS/ OLNT,ODESC1(220),ODESC2(220),ODESCO(220),
  292.     1    OACTIO(220),OFLAG1(220),OFLAG2(220),OFVAL(220),
  293.     2    OTVAL(220),OSIZE(220),OCAPAC(220),OROOM(220),
  294.     3    OADV(220),OCAN(220),OREAD(220)
  295. C
  296. C ADVENTURERS
  297. C
  298.     COMMON /ADVS/ ALNT,AROOM(4),ASCORE(4),AVEHIC(4),
  299.     1    AOBJ(4),AACTIO(4),ASTREN(4),AFLAG(4)
  300. C
  301.     XVEHIC=.FALSE.                !ASSUME LOSES.
  302.     AV=AVEHIC(WINNER)            !GET VEHICLE.
  303.     IF(AV.NE.0) XVEHIC=OAPPLI(OACTIO(AV),N)
  304.     RETURN
  305.     END
  306.