SUBROUTINE XQTCMD(COMMND, ME, DONE) C EXECUTE AN ENTERED COMMAND C COMMON PARAMETER MAXSHP = 8, MAXHOM = 4, MAXTRP = 10 COMMON/TORPE/TLOCS(MAXSHP, MAXTRP, 2), TDIR(MAXSHP, MAXTRP), IT(MA *XSHP) COMMON/TRKDAT/ENERGY(MAXSHP), SHIELD(MAXSHP), XCORD(MAXSHP), YCORD *(MAXSHP), TORPS(MAXSHP), HOLX, HOLY, HOLW, CDRAIN, NDRAIN, TDRAIN, * SCAN(MAXSHP), PHA(MAXSHP), I1, I2, HYPER(MAXSHP), ISENT(MAXSHP, 1 *0), XPOD(MAXSHP), YPOD(MAXSHP), DPOD(MAXSHP), IPODST(MAXSHP), WPOD *(MAXSHP), XHOM(MAXSHP, MAXHOM), YHOM(MAXSHP, MAXHOM), WHOM(MAXSHP, * MAXHOM), NHOM(MAXSHP), TRBEAM(MAXSHP), SCORE(MAXSHP), CREW(MAXSHP *), DIR(MAXSHP), WARP(MAXSHP), LAUNCH(MAXSHP), UNIV(100, 100), MESS *AG(480), THRU, SHPACT(MAXSHP), CLOAK(MAXSHP), NET(MAXSHP), SHPNAM( *10, MAXSHP) REAL LAUNCH, NDRAIN INTEGER*2SCAN, WHOM, CREW, HYPER, TORPS, TRBEAM LOGICAL*1THRU, SHPACT, CLOAK, NET BYTE UNIV, MESSAG BYTE SHPNAM C NOTE: BHOLE AND EMPTY ARE THE CHARACTERS FOR THE BLACK HOLE C AND EMPTY SPACE. C END COMMON LOGICAL*1OK, DONE REAL SC(9), R(9) INTEGER DEFSHP REAL DEFDIR COMMON/DEFLTS/DEFSHP, DEFDIR, DEFSHD LOGICAL CLEARF, VERBOS COMMON/MESS/CLEARF, VERBOS BYTE BLANK(80), MESBUF(60) BYTE BLUNK(2) BYTE BLUNK2(2) BYTE OBUFF( - 9: + 9, - 9: + 9), NBUFF( - 9: + 9, - 9: + 9) BYTE JUNK COMMON/BNDRY/IXX, IYY, ID, MINID8, JUNK, OBUFF, NBUFF EQUIVALENCE(BLUNK(2), NBUFF( - 9, - 9)) EQUIVALENCE(BLUNK2(2), OBUFF( - 9, - 9)) BYTE COMMND INTEGER ME LOGICAL*1LSTOUT CSAVED TARGET SHIP PARAMS INTEGER*2IOLDTX, IOLDTY, OLDTDS, OLDTDR INTEGER OLDSHP COMMON/OLDSTF/OLDSCR(MAXSHP), OLDCRS, OLDWRP, OLDEN, OLDSH, OLDX, *OLDY, IOLDT, IOLDH, IOLDP, OLDDIR, OLDSHP, IOTSHP, IOLDTX, IOLDTY CUSE DEFAULTS AUTOMATICALLY ON MOST COMMANDS LOGICAL*1DEFALT C LOWERCASE COMMANDS USE AUTO DEFAULTS DEFALT = (COMMND .GE. 'a') .AND. (COMMND .LE. 'z') IF (.NOT.(DEFALT)) GOTO 2000 COMMND = COMMND + ('A' - 'a') 2000 CONTINUE I2020=(COMMND) GOTO 2020 2040 CONTINUE C LONG RANGE SCAN COMMAND IF (.NOT.(DEFALT)) GOTO 2050 ITSHP = DEFSHP OK = .TRUE. GOTO 2060 2050 CONTINUE CALL GETINT('TARGET SHIP? ', ITSHP, OK, 1, 8, DEFSHP) 2060 CONTINUE IF (.NOT.(OK)) GOTO 2070 IF (.NOT.(ITSHP .NE. IOTSHP)) GOTO 2090 CUPDATE DEFAULT SHIP DEFSHP = ITSHP IOTSHP = ITSHP CALL TPOS(13, 78) ENCODE(1, 1101, MESBUF) ITSHP 1101 FORMAT(I1) CDISPLAY TARGET SHIP # CALL OUTCH(MESBUF, 1) CALL TPOS(14, 70) CDISPLAY TARGET SHIP NAME CALL OUTCH(SHPNAM(1, ITSHP), 10) CALL OUTCH(0, - 1) 2090 CONTINUE IF (.NOT.(CLOAK(ITSHP))) GOTO 2110 CCAN'T LOCATE CLOAKED SHIPS CALL MESSGE('TARGET NOT VISIBLE!') GOTO 2030 2110 CONTINUE IX = XCORD(ITSHP)/10. IY = YCORD(ITSHP)/10. IF (.NOT.((IX .NE. IOLDTX) .OR. (IY .NE. IOLDTY))) GOTO 2130 IOLDTX = IX IOLDTY = IY CDISPLAY TARGET SECTOR CALL TPOS(17, 75) ENCODE(5, 1071, MESBUF) IX, IY 1071 FORMAT(I2, ',', I2) CALL OUTCH(MESBUF, 5) 2130 CONTINUE CALL DIRDIS(XCORD(ME), YCORD(ME), XCORD(ITSHP), YCORD(ITSHP), *EDIR, EDIS) CCONVERT TO CLOCK FACE DIRECTION EDIRC = CLKDIR(EDIR) IF (.NOT.(EDIS .NE. OLDTDS)) GOTO 2150 OLDTDS = EDIS CALL TPOS(16, 75) ENCODE(5, 1081, MESBUF) EDIS 1081 FORMAT(F5.2) CDISPLAY TARGET DISTANCE CALL OUTCH(MESBUF, 5) 2150 CONTINUE IF (.NOT.(EDIRC .NE. OLDTDR)) GOTO 2170 OLDTDR = EDIRC CALL TPOS(15, 75) ENCODE(5, 1091, MESBUF) EDIRC 1091 FORMAT(F5.2) CDISPLAY TARGET DIRECTION CALL OUTCH(MESBUF, 5) 2170 CONTINUE IF (.NOT.(COMMND .EQ. 'I')) GOTO 2190 C SET DEFAULT DIRECTION TO TORP INTERSECT COURSE CALL INTERS(EDIR, DIR(ITSHP), WARP(ITSHP), 10., DIRINT) DEFDIR = CLKDIR(DIRINT) GOTO 2200 2190 CONTINUE DEFDIR = EDIRC 2200 CONTINUE 2070 CONTINUE GOTO 2030 2210 CONTINUE C TORPEDO COMMAND IF (.NOT.(CLOAK(ME))) GOTO 2220 CALL MESSGE('CLOAKED!') GOTO 2030 2220 CONTINUE IF (.NOT.(LAUNCH(ME) .LT. 0.)) GOTO 2240 IF (.NOT.(TORPS(ME) .GT. 0)) GOTO 2260 IF (.NOT.(DEFALT)) GOTO 2280 VALUE = DEFDIR OK = .TRUE. GOTO 2290 2280 CONTINUE CALL GETREL('TORPEDO COURSE? ', VALUE, OK, 0., 12., DEFDIR *) 2290 CONTINUE IF (.NOT.(OK)) GOTO 2300 DEFDIR = VALUE LAUNCH(ME) = DEGDIR(VALUE) TORPS(ME) = TORPS(ME) - 1 IF (.NOT.(TORPS(ME) .EQ. 0)) GOTO 2320 CALL MESSGE('LAST TORPEDO!') 2320 CONTINUE 2300 CONTINUE GOTO 2270 2260 CONTINUE CALL MESSGE('NO TORPEDOES!') 2270 CONTINUE GOTO 2250 2240 CONTINUE CALL MESSGE('TORPEDOES NOT READY') 2250 CONTINUE GOTO 2030 2340 CONTINUE C PHASER COMMAND IF (.NOT.(CLOAK(ME))) GOTO 2350 CALL MESSGE('CLOAKED!') GOTO 2030 2350 CONTINUE IF (.NOT.(PHA(ME) .LT. 0.)) GOTO 2370 IF (.NOT.(DEFALT)) GOTO 2390 VALUE = DEFDIR OK = .TRUE. GOTO 2400 2390 CONTINUE CALL GETREL('PHASER COURSE? ', VALUE, OK, 0., 12., DEFDIR) 2400 CONTINUE IF (.NOT.(OK)) GOTO 2410 DEFDIR = VALUE PHA(ME) = DEGDIR(VALUE) ENERGY(ME) = ENERGY(ME) - 50. 2410 CONTINUE GOTO 2380 2370 CONTINUE CALL MESSGE('PHASERS NOT READY') 2380 CONTINUE GOTO 2030 2430 CONTINUE C HOMING TORPEDO LAUNCH IF (.NOT.(CLOAK(ME))) GOTO 2440 CALL MESSGE('CLOAKED!') GOTO 2030 2440 CONTINUE LSTOUT = .TRUE. IF (.NOT.(NHOM(ME) .LT. MAXHOM)) GOTO 2460 DO 2480 IH = 1, MAXHOM IF (.NOT.(WHOM(ME, IH) .LT. 0)) GOTO 2500 CLAST LAUNCH NOT DONE LSTOUT = .FALSE. GOTO 2490 2500 CONTINUE 2480 CONTINUE 2490 CONTINUE 2460 CONTINUE IF (.NOT.(LSTOUT)) GOTO 2520 IF (.NOT.(NHOM(ME) .GT. 0)) GOTO 2540 IF (.NOT.(DEFALT)) GOTO 2560 ITSHP = DEFSHP OK = .TRUE. GOTO 2570 2560 CONTINUE CALL GETINT('TARGET SHIP? ', ITSHP, OK, 1, 8, DEFSHP) 2570 CONTINUE IF (.NOT.(OK)) GOTO 2580 DEFSHP = ITSHP IF (.NOT.(ITSHP .EQ. ME)) GOTO 2600 CALL MESSGE('TORPEDOES JAMMED!') NHOM(ME) = 0 TORPS(ME) = 0 GOTO 2610 2600 CONTINUE DO 2620 IH = 1, MAXHOM IF (.NOT.(WHOM(ME, IH) .EQ. 0)) GOTO 2640 CFIND AN IDLE HOMER CSET TO LAUNCH @ ITSHP WHOM(ME, IH) = - ITSHP NHOM(ME) = NHOM(ME) - 1 GOTO 2630 2640 CONTINUE 2620 CONTINUE 2630 CONTINUE 2610 CONTINUE 2580 CONTINUE GOTO 2550 2540 CONTINUE CALL MESSGE('NO HOMERS!') 2550 CONTINUE GOTO 2530 2520 CONTINUE CALL MESSGE('HOMERS NOT READY') 2530 CONTINUE GOTO 2030 2660 CONTINUE C WARP FACTOR COMMAND CALL GETREL('WARP SIR? ', VALUE, OK, 0., 8., WARP(ME)) IF (.NOT.(OK)) GOTO 2670 WARP(ME) = VALUE C MIDDLE KEYPAD DIGIT IS MAX WARP 2670 CONTINUE GOTO 2030 2690 CONTINUE WARP(ME) = 8.0 C THE FOLLOWING CODE IS FOR NEW DEFAULTS LCW 22-JUN-82 C KEYPAD 0 IS DEAD STOP GOTO 2030 2700 CONTINUE WARP(ME) = 0.0 C KEYPAD - IS DECREASE SPEED GOTO 2030 2710 CONTINUE IF (.NOT.(WARP(ME) .GT. 0.0)) GOTO 2720 WARP(ME) = WARP(ME) - 1.0 IF (.NOT.(WARP(ME) .LT. 0.0)) GOTO 2740 WARP(ME) = 0.0 2740 CONTINUE C KEYPAD , IS INCREASE SPEED 2720 CONTINUE GOTO 2030 2760 CONTINUE IF (.NOT.(WARP(ME) .LT. 8.0)) GOTO 2770 WARP(ME) = WARP(ME) + 1.0 IF (.NOT.(WARP(ME) .GT. 8.0)) GOTO 2790 WARP(ME) = 8.0 2790 CONTINUE C END OF NEW DEFAULTS BY LCW 22-JUN-82 2770 CONTINUE GOTO 2030 2810 CONTINUE C COURSE COMMAND CALL GETREL('COURSE SIR? ', VALUE, OK, 0., 12., DEFDIR) IF (.NOT.(OK)) GOTO 2820 DIR(ME) = DEGDIR(VALUE) C DIGITS 1 - 9 ON KEYPAD ARE COURSE CHANGES C C 7 8 9 C 4 6 C 1 2 3 C 2820 CONTINUE GOTO 2030 2840 CONTINUE DIR(ME) = 225.0 GOTO 2030 2850 CONTINUE DIR(ME) = 270.0 GOTO 2030 2860 CONTINUE DIR(ME) = 315.0 GOTO 2030 2870 CONTINUE DIR(ME) = 180.0 GOTO 2030 2880 CONTINUE DIR(ME) = 0.0 GOTO 2030 2890 CONTINUE DIR(ME) = 135.0 GOTO 2030 2900 CONTINUE DIR(ME) = 90.0 GOTO 2030 2910 CONTINUE DIR(ME) = 45.0 GOTO 2030 2920 CONTINUE C EXPLODE ANTI-MATTER DEVICE IF (.NOT.(IPODST(ME) .EQ. 2)) GOTO 2930 IPODST(ME) = 3 CALL MESSGE('DETONATION SIGNALED') GOTO 2940 2930 CONTINUE CALL MESSGE('NO POD!') 2940 CONTINUE GOTO 2030 2950 CONTINUE C CONVERT MOVING ANTI-MATTER POD TO A STATIC MINE IF (.NOT.(IPODST(ME) .EQ. 2)) GOTO 2960 WPOD(ME) = 0. CALL MESSGE('POD POSITIONED') GOTO 2970 2960 CONTINUE CALL MESSGE('NO POD!') 2970 CONTINUE GOTO 2030 2980 CONTINUE C LAUNCH ANTI-MATTER DEVICE IF (.NOT.(CLOAK(ME))) GOTO 2990 CALL MESSGE('CLOAKED!') GOTO 2030 2990 CONTINUE IF (.NOT.((IPODST(ME) .EQ. 0) .OR. (IPODST(ME) .EQ. 4))) GOTO 30 *10 IF (.NOT.(DEFALT)) GOTO 3030 VALUE = DEFDIR OK = .TRUE. GOTO 3040 3030 CONTINUE CALL GETREL('POD COURSE? ', VALUE, OK, 0., 12., DEFDIR) 3040 CONTINUE IF (.NOT.(OK)) GOTO 3050 DEFDIR = VALUE DPOD(ME) = DEGDIR(VALUE) C TAKES ENERGY TO CREATE A NEW POD IF (.NOT.(IPODST(ME) .EQ. 4)) GOTO 3070 ENERGY(ME) = ENERGY(ME) - 500.0 3070 CONTINUE IPODST(ME) = 1 3050 CONTINUE GOTO 3020 3010 CONTINUE CALL MESSGE('NO POD!') 3020 CONTINUE GOTO 2030 3090 CONTINUE C SET HYPERSPACE PORT COMMAND IUNIQ = HYPER(ME) CALL GETINT('HYPER PORT? ', IPORT, OK, 1, 6, IUNIQ) IF (.NOT.(OK)) GOTO 3100 HYPER(ME) = IPORT 3100 CONTINUE GOTO 2030 3120 CONTINUE C SHIELD COMMAND IF (.NOT.(DEFALT)) GOTO 3130 VALUE = DEFSHD OK = .TRUE. GOTO 3140 3130 CONTINUE CALL GETREL('ENERGY CHANGE? ', VALUE, OK, - 1.E36, 1.E36, DEF *SHD) 3140 CONTINUE IF (.NOT.(OK)) GOTO 3150 IF (.NOT.(ENERGY(ME)-VALUE .GE. 0. .AND. SHIELD(ME)+VALUE .GE. * 0.)) GOTO 3170 ENERGY(ME) = ENERGY(ME) - VALUE SHIELD(ME) = SHIELD(ME) + VALUE IF (.NOT.(VALUE.GE.0.0)) GOTO 3190 DEFSHD = VALUE 3190 CONTINUE GOTO 3180 3170 CONTINUE CALL MESSGE('?! IMPOSSIBLE !?') 3180 CONTINUE 3150 CONTINUE GOTO 2030 3210 CONTINUE C FLIP ENERGY NET ON OR OFF NET(ME) = .NOT.NET(ME) GOTO 2030 3220 CONTINUE C TRACTOR BEAM CALL GETINT('BEAM TARGET? ', ITSHP, OK, 0, 8, DEFSHP) IF (.NOT.(OK)) GOTO 3230 IF (.NOT.(ITSHP .NE. 0)) GOTO 3250 IF (.NOT.(CLOAK(ITSHP))) GOTO 3270 CALL MESSGE('TARGET NOT VISIBLE!') GOTO 2030 3270 CONTINUE DEFSHP = ITSHP 3250 CONTINUE IF (.NOT.(ITSHP .EQ. ME)) GOTO 3290 CALL MESSGE('? HUH ?') GOTO 3300 3290 CONTINUE TRBEAM(ME) = ITSHP 3300 CONTINUE 3230 CONTINUE GOTO 2030 3310 CONTINUE C CLOAKING COMMAND IF (.NOT.(.NOT.CLOAK(ME))) GOTO 3320 CLOAK(ME) = .TRUE. GOTO 3330 3320 CONTINUE CALL MESSGE('ALREADY CLOAKED!') 3330 CONTINUE GOTO 2030 3340 CONTINUE C APPEAR COMMAND IF (.NOT.(CLOAK(ME))) GOTO 3350 CLOAK(ME) = .FALSE. GOTO 3360 3350 CONTINUE CALL MESSGE('NOT CLOAKED!') 3360 CONTINUE GOTO 2030 3370 CONTINUE C FLIP VERBOSE MESSAGES ON OR OFF VERBOS = .NOT.VERBOS GOTO 2030 3380 CONTINUE C REFRESH COMMAND CALL STRMOV(BLUNK2, 1, 361, OBUFF, 1) CALL RBUFF CSCRAMBLE SAVED STUFF SO IT REFRESHES CALL CLROLD GOTO 2030 3390 CONTINUE C MESSAGE COMMAND CALL GETINT('UHURA HERE, TO WHOM? ', IVAL, OK, 0, 8, DEFSHP) IF (.NOT.(OK)) GOTO 3400 IF (.NOT.(IVAL .NE. 0)) GOTO 3420 IL = IVAL IH = IVAL GOTO 3430 3420 CONTINUE IL = 1 IH = 8 3430 CONTINUE CALL TPOS(24, 1) CALL OUTCH(BLANK, 79) CALL TPOS(24, 1) CALL OUTSTR(.FALSE., 'MESSAGE CAPTAIN? ', .FALSE.) CALL INCHAR(MESBUF(2), 59, .TRUE., - 1, NC, IERR) CALL TPOS(1, 1) CALL OUTCH(0, 0) IF (.NOT.(IERR .GE. 0 .AND. NC .GT. 0)) GOTO 3440 MESBUF(1) = ME + 48 DO 3460 I = NC + 2, 59 MESBUF(I) = ' ' 3460 CONTINUE 3470 CONTINUE DO 3480 I = IL, IH IF (.NOT.(SHPACT(I))) GOTO 3500 CALL STRMOV(MESBUF, 1, 60, MESSAG, I*60 - 59) 3500 CONTINUE 3480 CONTINUE 3490 CONTINUE 3440 CONTINUE 3400 CONTINUE GOTO 2030 3520 CONTINUE C QUIT COMMAND CALL YESNO('QUIT NOW? ', DONE) GOTO 2030 3530 CONTINUE C HELP COMMAND CALL TPOS(19, 1) CALL OUTSTR(.FALSE., 'A APPEAR (CLOAKING OFF) M SEND MESSAG *E T FIRE TORPEDOES', .TRUE.) CALL OUTSTR(.TRUE., 'C COURSE HEADING N FREEZE ANTI- *MATTER W SET WARP SPEED', .TRUE.) CALL OUTSTR(.TRUE., 'F FADE (CLOAKING ON) P FIRE PHASERS * X DETONATE ANTI-MATTER', .TRUE.) CALL OUTSTR(.TRUE., 'H HYPERSPACE SETTING Q QUIT * Z LAUNCH ANTI-MATTER', .TRUE.) CALL OUTSTR(.TRUE., 'K FIRE HOMING TORPEDO R RESET DISPLA *Y V VERBOSE ON/OFF', .TRUE.) CALL OUTSTR(.TRUE., 'L LOCATE SHIP S SHIELD CHANG *E E ENERGY NETS ON/OFF', .TRUE.) CALL TPOS(1, 1) CALL OUTCH(0, 0) GOTO 2030 3540 CONTINUE C CHANGE DEFAULT SHIP CALL GETINT('DEFAULT SHIP? ', ITSHP, OK, 1, 8, DEFSHP) IF (.NOT.(OK)) GOTO 3550 DEFSHP = ITSHP 3550 CONTINUE GOTO 2030 3570 CONTINUE C DO NOTHING GOTO 2030 3580 CONTINUE C ERROR CALL MESSGE('?! WHAT !?') GOTO 2030 2020 CONTINUE I2020=I2020-31 IF (I2020.LT.1.OR.I2020.GT.59)GOTO 3580 GOTO (3570,3580,3580,3580,3580,3580,3580,3580,3580,3580,3580,3580, *2760,2710,2040,3580,2700,2840,2850,2860,2870,2690,2880,2890,2900,2 *910,3580,3580,3580,3580,3580,3530,3580,3340,3220,2810,3540,3210,33 *10,3580,3090,2040,3580,2430,2040,3390,2950,3580,2340,3520,3380,312 *0,2210,3580,3370,2660,2920,3580,2980), I2020 2030 CONTINUE RETURN END C SCREW UP SAVED OLD STUFF SO IT REFRESHES SUBROUTINE CLROLD PARAMETER MAXSHP = 8 CSAVED TARGET SHIP PARAMS INTEGER*2IOLDTX, IOLDTY, OLDTDS, OLDTDR INTEGER OLDSHP COMMON/OLDSTF/OLDSCR(MAXSHP), OLDCRS, OLDWRP, OLDEN, OLDSH, OLDX, *OLDY, IOLDT, IOLDH, IOLDP, OLDDIR, OLDSHP, IOTSHP, IOLDTX, IOLDTY DO 3590 I = 1, MAXSHP CDISPLAYED SCORES OLDSCR(I) = - 1E - 10 3590 CONTINUE 3600 CONTINUE CENERGY OLDEN = - 1.0 CSHIELDS OLDSH = - 1.0 CCOURSE OLDCRS = - 1.0 CWARP OLDWRP = - 1.0 CX COORD OLDX = - 1.0 CY COORD OLDY = - 1.0 C TORPS IOLDT = - 1 C HOMERS IOLDH = - 1 C HYPER PORT IOLDP = 0 CDEFAULT SHIP OLDSHP = 0 CDEFAULT DIRECTION OLDDIR = - 1.0 CTARGET SHIP IOTSHP = 0 CTARGET X SECTOR IOLDTX = - 1 CTARGET Y SECTOR IOLDTY = - 1 RETURN END