C PROGRAM SIMULATES TV PROGRAM STAR TREK C FORTRAN IV VERSION BY KAY R. FISHER ...DEC C ORIGINAL BASIC PROGRAM BY MIKE MAYFIELD C CENTERLINE ENGINEERING INTEGER ENERGY,QUAD1,QUAD2,SECT1,SECT2,CHART(9,2) INTEGER TKLING,TBASES,BASES3,STARS3,ARRAY(8,8,3) INTEGER KLINST(3,3),LRSENS(3),SHIELD INTEGER ZONE1,ZONE2,RANK1,RANK2,OK,COMM,DOCKED,TORPED INTEGER COND,HELL,LONG(3),HIT REAL NO,DAMAGE(8) COMMON ARRAY,ZONE1,ZONE2,INSERT,RANK1,RANK2,OK,IRA,JONES COMMON DOCKED,KLING3,KLINST,SECT1,SECT2,SHIELD DATA YES/'YES'/,NO/'NO'/ C ************************************************* C THIS MADNESS IS THE NAVIGATION CHART C ************************************************* DATA CHART(2,1)/-1/,CHART(3,1)/-1/,CHART(4,1)/-1/ DATA CHART(4,2)/-1/,CHART(5,2)/-1/,CHART(6,2)/-1/ DATA CHART(1,1)/0/,CHART(3,2)/0/,CHART(5,1)/0/ DATA CHART(7,2)/0/,CHART(9,1)/0/,CHART(1,2)/1/ DATA CHART(2,2)/1/,CHART(6,1)/1/,CHART(7,1)/1/ DATA CHART(8,1)/1/,CHART(8,2)/1/,CHART(9,2)/1/ C ************************************************* C IT LOOKS LIKE THIS C ************************************************* C 0 1 C 1 1 C 1 0 C 1 -1 C 0 -1 C -1 -1 C -1 0 C -1 1 C 0 1 C ************************************************* WRITE (7,1) 1 FORMAT (////,1X,'PLEASE ENTER THE TIME (24 HOUR FORMAT),IE: 4:30 1P.M. = 1630.',/,1X,'TIME?',$) READ (5,1290) ITEMP IRA = INT((FLOAT(ITEMP))/100) JONES = INT(ITEMP-IRA*100) ASSIGN 1270 TO HELL 5 KSHELD = 200 DOCKED = 0 TORPED = 10 SHIELD = 0 DO 9 I=1,8 DAMAGE(I)=0. 9 CONTINUE WRITE(7,10) 10 FORMAT(////,T20,'* * * STAR TREK * * *' 1/,T20,'FORTRAN IV VERSION BY KAY R. FISHER ...DEC') 25 WRITE(7,30) 30 FORMAT(////,1X,'DO YOU WANT INSTRUCTIONS (THEY ARE LONG!)?',$) READ(5,40)ANSWER 40 FORMAT(A3) IF(ANSWER.EQ.YES) GOTO 20000 IF(ANSWER.EQ.NO) GOTO 100 WRITE(7,50) 50 FORMAT(1X,'PLEASE ANSWER YES OR NO!') GOTO 25 100 DATLFT=30.0 ENERGY=3000 SHIELD=0 C THIS ARRAY REPRESENTS KLINGON POSITIONS C AND THERE REMAINING SHIELD ENERGY!! C FOR UP TO 3 KLINGONS(I.E. ONE SECTOR'S WORTH) DO 105 I=1,3 DO 105 J=1,3 KLINST(I,J) = 0 105 CONTINUE C THIS ARRAY WILL REPRESENT 3-8X8 PLANES C PLANE 1 = MASTER GALAXY LAYOUT C PLANE 2 = LIBRARY RECORD OF ALL LONG RANGE SENSOR SCANS C PLANE 3 = PRESENT SECTOR LAYOUT DO 200 I=1,8 DO 200 J=1,8 DO 200 K=1,3 ARRAY(I,J,K)=0. 200 CONTINUE C PUT THE ENTERPRISE SOMEWHERE QUAD1=INT(RAN(IRA,JONES)*8+1) QUAD2=INT(RAN(IRA,JONES)*8+1) SECT1=INT(RAN(IRA,JONES)*8+1) SECT2=INT(RAN(IRA,JONES)*8+1) C SETS UP WHAT EXISTS IN GALAXY TKLING=0. TBASES=0. DO 750 I=1,8 DO 750 J=1,8 RND=RAN(IRA,JONES) IF (RND.GT..98) GOTO 580 IF(RND.GT..95) GOTO 610 IF(RND.GT..8) GOTO 640 KLING3=0. GOTO 660 580 KLING3=3. TKLING=TKLING+3. GOTO 660 610 KLING3=2. TKLING=TKLING+2. GOTO 660 640 KLING3=1. TKLING=TKLING+1. 660 RND=RAN(IRA,JONES) IF(RND.GT..96) GOTO 700 BASES3=0. GOTO 720 700 BASES3=1. TBASES=TBASES+1. 720 STARS3=INT(RAN(IRA,JONES)*8+1) ARRAY(I,J,1)=KLING3*100+BASES3*10+STARS3 750 CONTINUE KLING7=TKLING IF(TBASES.GT.0.) GOTO 780 IRND1=INT(RAN(IRA,JONES)*8+1) IRND2=INT(RAN(IRA,JONES)*8+1) ARRAY(IRND1,IRND2,1)=ARRAY(IRND1,IRND2,1)+10. TBASES=1. 780 WRITE(7,800)TKLING,DATLFT,TBASES 800 FORMAT(//,1X,'YOU MUST DESTROY',1X,I2,1X,'KLINGONS 1 IN',F6.1,1X,'STARDATES WITH',I2,1X,'STARBASES!!!',////////) TIME = INT(RAN(IRA,JONES)*20+20)*100 TIME0 = TIME C OK NOW CLEAR THIS SECTOR!!!!! 810 STARS3=0 KLING3=0 BASES3=0 C THIS CHECKS TO SEE IF WE ARE IN OUR ASSIGNED C REGION OF THE GALAXY!!! IF (QUAD1.LT.1) GOTO 920 IF (QUAD1.GT.8) GOTO 920 IF (QUAD2.LT.1) GOTO 920 IF (QUAD2.GT.8) GOTO 920 C IF NOT GO TO 920 C OK THEN LET'S SEE WHAT IS IN THIS QUADRANT TEMP = ARRAY(QUAD1,QUAD2,1)*.01 KLING3=INT(TEMP) BASES3 = INT((TEMP-KLING3)*10) STARS3=ARRAY(QUAD1,QUAD2,1)-INT(ARRAY(QUAD1,QUAD2,1)*.1)*10 C IF THERE'S NO KLINGONS HERE THEN IT'S C NOT CONDITION RED IF (KLING3.EQ.0) GOTO 920 C LET'S SEE IF THE SHIELDS ARE LOW? IF (SHIELD.GE.200) GOTO 900 WRITE(7,890) 890 FORMAT(//,1X,' SHIELDS DANGEROUSLY LOW') 900 WRITE(7,910) 910 FORMAT(1X,'COMBAT AREA CONDITION RED') C CLEAR OUT THE KLINGON SHIELD POWER ARRAY 920 DO 940 I=1,3 KLINST(I,3) = 0 940 CONTINUE C PUT THE ENTERPRISE SOMEWHERE ZONE1 = SECT1 ZONE2 = SECT2 DO 970 I=1,8 DO 970 J=1,8 ARRAY(I,J,3)=0 970 CONTINUE C INSERT=1=ENTERPRISE INSERT = 1 C PLACE - PLACE - PLACE - PLACE ARRAY (ZONE1,ZONE2,3) = INSERT C PUT KLINGONS SOMEWHERE IF (KLING3.EQ.0) GOTO 1120 DO 1110 I=1,KLING3 CALL SECTOR C INSERT=2=KLINGON INSERT = 2 ZONE1 = RANK1 ZONE2 = RANK2 C PLACE - PLACE - PLACE - PLACE ARRAY(ZONE1,ZONE2,3) = INSERT C UPDATE KLINGON STATUS ARRAY (KLINST) KLINST(I,1) = RANK1 KLINST(I,2) = RANK2 KLINST(I,3) = KSHELD 1110 CONTINUE C PUT STARBASE SOMEWHERE 1120 IF (BASES3.EQ.0) GOTO 1190 CALL SECTOR C INSERT=3=STARBASE INSERT = 3 ZONE1 = RANK1 ZONE2 = RANK2 C PLACE - PLACE - PLACE - PLACE ARRAY(ZONE1,ZONE2,3) = INSERT C PUT STARS SOMEWHERE 1190 IF (STARS3.EQ.0) GOTO 1260 DO 1250 I=1,STARS3 CALL SECTOR C INSERT=4=STARS INSERT = 4 ZONE1 = RANK1 ZONE2 = RANK2 C PLACE - PLACE - PLACE - PLACE ARRAY(ZONE1,ZONE2,3) = INSERT 1250 CONTINUE C ************************************** C THIS IS THE SHORT RANGE SENSOR SCAN C ************************************** C CHECK FOR DOCKING 1260 DO 4200 I=1,3 DO 4200 J=1,3 ZONE1 = SECT1+I-2 IF (ZONE1.LT.1) GOTO 4200 IF (ZONE1.GT.8) GOTO 4200 ZONE2 = SECT2+J-2 IF (ZONE2.LT.1) GOTO 4200 IF (ZONE2.GT.8) GOTO 4200 INSERT = 3 C CHECKING FOR A STARBASE CALL CHECK IF (OK.EQ.1) GOTO 4240 4200 CONTINUE DOCKED = 0 GOTO 4310 C WE ARE DOCKED 4240 DOCKED = 1 ENERGY = 3000 TORPED = 10 C GET REPAIRS DO 4260 I=1,8 IF (DAMAGE(I).GE.0) GOTO 4260 DAMAGE(I) = 0 4260 CONTINUE WRITE (7,4280) 4280 FORMAT (1X,'SHIELDS DROPPED FOR DOCKING PURPOSES') SHIELD = 0 COND = 1 GOTO 4380 4310 IF (KLING3.GT.0) GOTO 4350 IF (ENERGY.LT.300) GOTO 4370 COND = 0 GOTO 4380 4350 COND = 3 GOTO 4380 4370 COND = 2 4380 IF (DAMAGE(2).GE.0) GOTO 4430 WRITE (7,4390) 4390 FORMAT (/,1X,'*** SHORT RANGE SENSORS ARE OUT ***',/) GOTO HELL C WILL THE REAL SHORT RANGE SENSOR PLEASE STAND UP? 4430 WRITE(7,4432) 4432 FORMAT(///,1X,'SHORT RANGE SENSOR SCAN',/) WRITE(7,4435) 4435 FORMAT('+------------------------',/) DO 4500 I=1,8 DO 4450 J=1,8 IF(ARRAY(I,J,3).EQ.1) GOTO 4441 IF(ARRAY(I,J,3).EQ.2) GOTO 4442 IF(ARRAY(I,J,3).EQ.3) GOTO 4443 IF(ARRAY(I,J,3).EQ.4) GOTO 4444 WRITE(7,4445) GOTO 4450 4441 WRITE(7,4446) GOTO 4450 4442 WRITE(7,4447) GOTO 4450 4443 WRITE(7,4448) GOTO 4450 4444 WRITE(7,4449) 4445 FORMAT('+ ',$) 4446 FORMAT('+<*>',$) 4447 FORMAT('++++',$) 4448 FORMAT('+>!<',$) 4449 FORMAT('+ * ',$) 4450 CONTINUE C WHAT LINE ARE WE TYPING? GOTO (4458,4462,4476,4480,4484,4488,4492,4456) I 4456 WRITE(7,4457) 4457 FORMAT('+',/) GOTO 4500 4458 WRITE(7,4459) TIME 4459 FORMAT('+',4X,'STARDATE',7X,F7.1,/) GOTO 4500 4462 WRITE(7,4463) 4463 FORMAT('+',4X,'CONDITION',7X,$) IF(COND.EQ.1) GOTO 4465 IF(COND.EQ.2) GOTO 4467 IF(COND.EQ.3) GOTO 4469 WRITE(7,4464) 4464 FORMAT('+ GREEN',/) GOTO 4500 4465 WRITE(7,4466) 4466 FORMAT('+DOCKED',/) GOTO 4500 4467 WRITE(7,4468) 4468 FORMAT('+YELLOW',/) GOTO 4500 4469 WRITE(7,4470) 4470 FORMAT('+ RED',/) GOTO 4500 4476 WRITE(7,4477) QUAD1,QUAD2 4477 FORMAT('+',4X,'QUADRANT',9X,I2,',',I2,/) GOTO 4500 4480 WRITE(7,4481) SECT1,SECT2 4481 FORMAT('+',4X,'SECTOR',11X,I2,',',I2,/) GOTO 4500 4484 WRITE(7,4485) ENERGY 4485 FORMAT('+',4X,'TOTAL ENERGY',6X,I4,/) GOTO 4500 4488 WRITE(7,4489) TORPED 4489 FORMAT('+',4X,'PHOTON TORPEDOES',4X,I2,/) GOTO 4500 4492 WRITE(7,4493) SHIELD 4493 FORMAT('+',4X,'SHIELDS',11X,I4,/) 4500 CONTINUE WRITE(7,4435) C ********************************************************* C INPUT COMMAND-----INPUT COMMAND-----INPUT COMMAND C ********************************************************* 1270 WRITE(7,1280) 1280 FORMAT(//,1X,'COMMAND:'$) READ(5,1290)COMM 1290 FORMAT(I4) C COMMAND 69 = CHEAT/TEST/DEBUG IF (COMM.EQ.69) GOTO 10000 IF (COMM.LT.0) GOTO 1300 IF (COMM.GT.8) GOTO 1300 IF (COMM.EQ.0) GOTO 1410 GOTO (1260,2330,2530,2800,3460,3560,4630,5) COMM 1300 WRITE(7,1310) 1310 FORMAT(//,4X,'0 = SET COURSE',/, 14X,'1 = SHORT RANGE SENSOR SCAN',/, 24X,'2 = LONGE RANGE SENSOR SCAN',/, 34X,'3 = FIRE PHASERS',/, 44X,'4 = FIRE PHOTON TORPEDOES',/, 54X,'5 = SHIELD CONTROL',/, 64X,'6 = DAMAGE CONTROL REPORT',/, 74X,'7 = CALL ON LIBRARY COMPUTER',/, 84X,'8 = BEGIN NEW CONTEST',/,) GO TO HELL C ************************************************** C THIS IS THE COURSE CONTROL CODE C ************************************************** 1410 WRITE (7,1415) 1415 FORMAT (1X,'COURSE (1-9):?',$) READ (5,1420) COURSE 1420 FORMAT (F16.0) IF (COURSE.EQ.0) GO TO HELL IF (COURSE.LT.0.OR.COURSE.GE.9) GO TO 1410 WRITE (7,1450) 1450 FORMAT (1X,'WARP FACTOR (0-8):?',$) READ (5,1420) WARP IF (WARP.LE.0.OR.WARP.GT.8) GO TO HELL IF (WARP.LE..2.OR.DAMAGE(1).GE.0) GO TO 1510 WRITE (7,1490) 1490 FORMAT (1X,'WARP DRIVE IS DISABLED!',/, 11X,'IMPULSE ENGINES ACTIVATED.',/, 21X,'MAXIMUM SPEED = WARP .2') GO TO HELL 1510 IF (KLING3.LE.0) GO TO 1560 CALL SHOOT IF (SHIELD.LT.0) GOTO 4000 IF (KLING3.LE.0) GO TO 1560 IF (SHIELD.GE.0) GOTO 1610 4000 WRITE (7,4010) 4010 FORMAT (/,1X,'THE ENTERPRISE HAS BEEN DESTROYED. THE 1FEDERATION WILL BE CONQUERED.') 4020 WRITE (7,4011) TKLING 4011 FORMAT (1X,'THERE ARE STILL ',I3,' KLINGON BATTLE 1CRUISERS.') WRITE (7,4012) 4012 FORMAT (1X,'YOU GET ANOTHER CHANCE....') GO TO 5 1560 IF (ENERGY.GT.0) GO TO 1610 IF (SHIELD.GE.1) GO TO 1580 3920 WRITE (7,3930) 3930 FORMAT (1X,'THE ENTERPRISE IS DEAD IN SPACE. IF YOU SURVIVE 1ALL IMPENDING',/,1X,'ATTACKS YOU WILL BE DEMOTED TO THE 2RANK OF PRIVATE.') 3940 IF (KLING3.LE.0) GO TO 4020 CALL SHOOT IF (SHIELD.LT.0) GO TO 4000 GO TO 3940 GOTO 5 1580 WRITE (7,1590) ENERGY,SHIELD 1590 FORMAT (1X,'YOU HAVE ',I5,' UNITS OF ENERGY',/, 11X,'SUGGEST YOU GET SOME FROM YOUR SHIELDS WHICH HAVE ', 2I5,' UNITS LEFT.') GO TO HELL C FIX ANY DAMAGED DEVICE MR. SCOTT 1610 DO 1640 I=1,8 IF (DAMAGE(I).GE.0) GOTO 1640 DAMAGE(I) = DAMAGE(I)+1. 1640 CONTINUE IF (RAN(IRA,JONES).GT..2) GO TO 1810 ITEMP = INT(RAN(IRA,JONES)*8+1) IF (RAN(IRA,JONES).GE..5) GOTO 1750 DAMAGE(ITEMP) = DAMAGE(ITEMP)-(RAN(IRA,JONES)*5+1) WRITE (7,1690) 1690 FORMAT (/,1X,'DAMAGE CONTROL REPORTS:',$) GOTO (1692,1694,1696,1700,1702,1704,1706,1708) ITEMP 1692 WRITE (7,1693) 1693 FORMAT('+ WARP DRIVE ',$) GOTO 1720 1694 WRITE(7,1695) 1695 FORMAT('+ SHORT RANGE SENSORS ',$) GOTO 1720 1696 WRITE(7,1697) 1697 FORMAT('+ LONG RANGE SENSORS ',$) GOTO 1720 1700 WRITE(7,1701) 1701 FORMAT('+ PHASER CONTROL ',$) GOTO 1720 1702 WRITE(7,1703) 1703 FORMAT('+ PHOTON TUBES ',$) GOTO 1720 1704 WRITE(7,1705) 1705 FORMAT('+ DAMAGE CONTROL ',$) GOTO 1720 1706 WRITE(7,1707) 1707 FORMAT('+ SHIELD CONTROL ',$) GOTO 1720 1708 WRITE(7,1709) 1709 FORMAT('+ COMPUTER ',$) 1720 WRITE(7,1722) 1722 FORMAT('+DAMAGED',/) GOTO 1810 1750 DAMAGE(ITEMP) = DAMAGE(ITEMP)+(RAN(IRA,JONES)*5+1) WRITE(7,1690) GOTO (1752,1754,1756,1758,1760,1762,1764,1766) ITEMP 1752 WRITE(7,1693) GOTO 1790 1754 WRITE(7,1695) GOTO 1790 1756 WRITE(7,1697) GOTO 1790 1758 WRITE(7,1701) GOTO 1790 1760 WRITE(7,1703) GOTO 1790 1762 WRITE(7,1705) GOTO 1790 1764 WRITE(7,1707) GOTO 1790 1766 WRITE(7,1709) 1790 WRITE (7,1792) 1792 FORMAT ('+STATE OF REPAIR IMPROVED',/) 1810 MOVE = INT((WARP+.0625)*8) ZONE1 = SECT1 ZONE2 = SECT2 INSERT = 0 C ZERO THE SECTOR WE LEAVE ARRAY(ZONE1,ZONE2,3) = INSERT X = SECT1 Y = SECT2 X1=CHART(INT(COURSE),1)+(CHART(INT(COURSE+1.),1)-CHART(INT( 1COURSE),1))*(COURSE-INT(COURSE)) X2=CHART(INT(COURSE),2)+(CHART(INT(COURSE+1.),2)-CHART(INT( 1COURSE),2))*(COURSE-INT(COURSE)) DO 2070 I=1,MOVE X=X+X1 Y=Y+X2 C DID WE FLY OUT OF OUR SECTOR? IF(X.LT.1..OR.X.GE.9..OR.Y.LT.1..OR.Y.GE.9.) GOTO 2170 C DID WE HIT ANYTHING? ZONE1 = X ZONE2 = Y INSERT = 0 CALL CHECK C WHEN WE RETURN OK BETTER = 1 IF (OK.EQ.1) GOTO 2070 C COLLISION COURSE - BACK UP 1 SECTOR SECT1 = INT(X-X1) SECT2 = INT(Y-X2) ZONE1 = SECT1 ZONE2 = SECT2 WRITE (7,2030) SECT1,SECT2 2030 FORMAT (1X,'WARP ENGINES SHUTDOWN AT SECTOR ',I2,' ,',I2, 1' DUE TO BAD NAVAGATION') GOTO 2080 2070 CONTINUE SECT1 = INT(X) SECT2 = INT(Y) ZONE1 = SECT1 ZONE2 = SECT2 2080 INSERT = 1 C HERE WE ARE LET'S PARK THE ENTERPRISE ARRAY(ZONE1,ZONE2,3) = INSERT ENERGY = ENERGY-MOVE+5 TIME = TIME+.1 IF (WARP.LT.1) GOTO 2150 TIME = TIME+.9 2150 IF(TIME.LE.TIME0+DATLFT)GOTO 1260 3969 WRITE (7,3970) TIME 3970 FORMAT(1X,'IT IS STARDATE ',F7.1) GOTO 4020 2170 X = QUAD1*8+SECT1+X1*MOVE Y = QUAD2*8+SECT2+X2*MOVE QUAD1 = INT(X/8) QUAD2 = INT(Y/8) SECT1 = INT(X-QUAD1*8) SECT2 = INT(Y-QUAD2*8) C IN THIS CRAZY MATH IT IS POSSIBLE TO ARRIVE C AT SECTOR X,0 OR 0,X IN WHICH CASE WE C MUST FALL BACKWARDS INTO ANOTHER QUADRANT C AT SECTOR X,8 OR 8,X IF (SECT1.NE.0) GOTO 2260 QUAD1 = QUAD1-1 SECT1 = 8 2260 IF (SECT2.NE.0) GOTO 2290 QUAD2 = QUAD2-1 SECT2 = 8 2290 TIME = TIME+1. ENERGY = ENERGY-MOVE+5 IF (TIME.GT.TIME0+DATLFT) GOTO 3969 GOTO 810 C ************************************************** C THIS IS THE PHOTON TORPEDOE CONTROL C ************************************************** 2800 IF (DAMAGE(5).GE.0) GOTO 2830 WRITE (7,2810) 2810 FORMAT (1X,'PHOTON TUBES ARE NOT OPERATIONL') GO TO HELL 2830 IF (TORPED.GT.0) GOTO 2860 WRITE (7,2840) 2840 FORMAT (1X,'ALL PHOTON TORPEDOES EXPENDED') GO TO HELL 2860 WRITE (7,2862) 2862 FORMAT (1X,'TORPEDO COURSE (1-9):?',$) READ (5,1420) COURSE IF (COURSE.EQ.0) GO TO HELL IF (COURSE.LT.1.OR.COURSE.GE.9) GOTO 2860 X1=CHART(INT(COURSE),1)+(CHART(INT(COURSE)+1,1)-CHART(INT 1(COURSE),1))*(COURSE-INT(COURSE)) X2=CHART(INT(COURSE),2)+(CHART(INT(COURSE)+1,2)-CHART(INT 1(COURSE),2))*(COURSE-INT(COURSE)) X = SECT1 Y = SECT2 TORPED = TORPED-1 WRITE (7,2950) 2950 FORMAT (1X,'TORPEDO TRACK:') 2960 X = X+X1 Y = Y+X2 IF(X.LT.1.OR.X.GE.9.OR.Y.LT.1.OR.Y.GE.9) GOTO 3420 WRITE (7,2990) X,Y 2990 FORMAT (15X,G16.8,',',G16.8) IF (INT(X+.25).NE.INT(X+.75)) GOTO 2960 IF (INT(Y+.25).NE.INT(Y+.75)) GOTO 2960 ZONE1 = INT(X+.5) ZONE2 = INT(Y+.5) INSERT = 0 CALL CHECK IF (OK.EQ.1) GOTO 2960 INSERT = 2 CALL CHECK IF (OK.EQ.0) GOTO 3220 WRITE (7,3120) 3120 FORMAT(1X,'*** KLINGON DESTROYED ***') C NEGATE 1 KLINGON KLING3 = KLING3-1 TKLING = TKLING-1 IF (TKLING.LE.0) GOTO 4040 DO 3190 I=1,3 IF (ZONE1.NE.KLINST(I,1).OR.ZONE2.NE.KLINST(I,2))GOTO3190 KLINST(I,3) = 0 3190 CONTINUE GOTO 3360 3220 INSERT = 4 CALL CHECK IF (OK.EQ.0) GOTO 3290 WRITE (7,3270) 3270 FORMAT (1X,'YOU CAN''T DESTROY STARS, SILLY') GOTO 3420 3290 INSERT = 3 CALL CHECK IF (OK.EQ.0) GOTO 2960 WRITE (7,3340) 3340 FORMAT (1X,'*** STAR BASE DESTROYED ***......CONGRATULATIONS') C DECREMENT 1 STARBASE BASES3 = BASES3-1 TBASES =TBASES-1 3360 INSERT = 0 C PLACE - PLACE - PLACE - PLACE ARRAY(ZONE1,ZONE2,3) = INSERT C UPDATE GALAXY ARRAY(QUAD1,QUAD2,1) = KLING3*100+BASES3*10+STARS3 IF (ARRAY(QUAD1,QUAD2,2).LT.1) GOTO 3410 ARRAY(QUAD1,QUAD2,2) = ARRAY(QUAD1,QUAD2,1) 3410 GOTO 3430 3420 WRITE (7,3422) 3422 FORMAT (1X,'TORPEDO MISSED') 3430 CALL SHOOT IF (SHIELD.LT.0.OR.ENERGY.LT.0) GOTO 4000 GO TO HELL C ************************************************** C THIS IS THE FIRE PHASER COMMAND C ************************************************** 2530 IF (KLING3.GT.0) GOTO 2540 WRITE (7,3670) 3670 FORMAT(1X,'SHORT RANGE SENSORS REPORT NO KLINGONS IN THIS 1 QUADRANT') GO TO HELL 2540 IF (DAMAGE(4).GE.0) GOTO 2570 WRITE (7,2550) 2550 FORMAT(1X,'PHASERS NOT OPERATIONAL') GO TO HELL 2570 IF(DAMAGE(8).GE.0) GOTO 2590 WRITE (7,2580) 2580 FORMAT (2X,'COMPUTER FAILURE HAMPERS ACCURACY') 2590 WRITE (7,2592) ENERGY 2592 FORMAT (1X,'PHASERS LOCKED ON TARGET. ENERGY AVAILABLE = ', 1I4,/,1X,'NUMBER OF UNITS TO FIRE:?',$) READ (5,1420) X ITEMP = INT(X) IF (ITEMP.LE.0) GO TO HELL IF (ENERGY-ITEMP.LT.0) GOTO 2590 ENERGY = ENERGY-ITEMP CALL SHOOT IF (SHIELD.LT.0) GOTO 4000 IF (DAMAGE(8).GE.0) GOTO 2680 X = X*RAN(IRA,JONES) 2680 DO 2770 I=1,3 IF(KLINST(I,3).LE.0) GOTO 2770 TEMP=SQRT(FLOAT((KLINST(I,1)-SECT1)**2+(KLINST(I,2)-SECT2)**2)) HIT = INT((X/KLING3/TEMP)*(2*RAN(IRA,JONES))) KLINST(I,3) = KLINST(I,3)-HIT WRITE (7,2720) HIT,KLINST(I,1),KLINST(I,2),KLINST(I,3) 2720 FORMAT(1X,I4,' UNIT HIT ON KLINGON AT SECTOR ',I2,',',I2, 15X,'(',I5,' LEFT)') IF (KLINST(I,3).GT.0) GOTO 2770 WRITE (7,3690)KLINST(I,1),KLINST(I,2) 3690 FORMAT(1X,'*** KLINGON AT SECTOR ',I2,',',I2,' DESTROYED ***') C NEGATE ONE KLINGON KLING3 = KLING3-1 TKLING = TKLING-1 ZONE1 = KLINST(I,1) ZONE2 = KLINST(I,2) INSERT = 0 C PLACE - PLACE - PLACE - PLACE ARRAY(ZONE1,ZONE2,3) = INSERT C UPDATE GALAXY ARRAY(QUAD1,QUAD2,1) = KLING3*100+BASES3*10+STARS3 IF (ARRAY(QUAD1,QUAD2,2).LT.1) GOTO 2760 ARRAY(QUAD1,QUAD2,2) = ARRAY(QUAD1,QUAD2,1) 2760 IF (TKLING.LE.0) GOTO 4040 2770 CONTINUE IF (ENERGY.LT.0) GOTO 4000 GO TO HELL 4040 WRITE (7,4042) 4042 FORMAT(//,1X,'THE LAST KLINGON BATTLE CRUISER HAS BEEN 1DESTROYED',/,1X,'THE FEDERATION HAS BEEN SAVED!!!!!',/) EFF = ((KLING7/(TIME-TIME0))*1000) WRITE(7,4080) EFF,TIME-TIME0 4080 FORMAT(1X,'YOUR EFFICIENCY RATING = ',F16.2,/, 11X,'YOUR ACTUAL TIME OF MISSION = ',F16.1,' STARDATES',///, 21X,'DO YOU WANT TO TRY AGAIN?',$) 4106 READ (5,40) ANSWER IF (ANSWER.EQ.YES) GOTO 5 IF(ANSWER.EQ.NO) STOP WRITE(7,50) GOTO 4106 C ************************************************** C THIS IS THE LONG RANGE SENSOR SCAN CODE C ************************************************** 2330 IF (DAMAGE(3).GE.0) GOTO 2370 WRITE (7,2340) 2340 FORMAT (1X,'LONG RANGE SENSORS ARE INOPERABLE') GO TO HELL 2370 WRITE (7,2375) QUAD1,QUAD2 2375 FORMAT(1X,'LONG RANGE SENSOR SCAN FOR QUADRANT ',I2,', ',I2) WRITE (7,2380) 2380 FORMAT (1X,'-------------------') DO 2500 I=1,3 DO 2470 J=1,3 IX = I+QUAD1-2 JX = J+QUAD2-2 IF(IX.LT.1.OR.IX.GT.8.OR.JX.LT.1.OR.JX.GT.8) GOTO 2460 LONG(JX-QUAD2+2) = ARRAY(IX,JX,1) IF (DAMAGE(8).LT.0) GOTO 2470 ARRAY(IX,JX,2) = ARRAY(IX,JX,1) GOTO 2470 2460 LONG(JX-QUAD2+2) = 0 2470 CONTINUE WRITE (7,2472) LONG(1),LONG(2),LONG(3) 2472 FORMAT (1X,':',I4,' :',I4,' :',I4,' :') WRITE (7,2380) 2500 CONTINUE GO TO HELL C ************************************************** C THIS IS THE DAMAGE CONTROL REPORT CODE C ************************************************** 3560 IF (DAMAGE(6).GE.0) GO TO 3580 WRITE (7,3570) 3570 FORMAT (1X,'DAMAGE CONTROL REPORT IS NOT AVAILABLE') GO TO HELL 3580 WRITE (7,3590) DAMAGE(1),DAMAGE(2),DAMAGE(3),DAMAGE(4), 1DAMAGE(5),DAMAGE(6),DAMAGE(7),DAMAGE(8) 3590 FORMAT (/,1X,'DAMAGE CONTROL REPORT:',//, 11X,'DEVICE STATE OF REPAIR',/, 21X,'WARP DRIVE',T27,F16.2,/, 31X,'S.R. SENSORS',T27,F16.2,/, 41X,'L.R. SENSORS',T27,F16.2,/, 51X,'PHASER CONTROL',T27,F16.2,/, 61X,'PHOTON TUBES',T27,F16.2,/, 71X,'DAMAGE CONTROL',T27,F16.2,/, 81X,'SHIELD CONTROL',T27,F16.2,/, 91X,'COMPUTER',T27,F16.2,/) GO TO HELL C ************************************************** C THIS IS THE SHIELD CONTROL CODE C ************************************************** 3460 IF (DAMAGE(7).GE.0) GOTO 3480 WRITE (7,3470) 3470 FORMAT (1X,'SHIELD CONTROL IS NON-OPERATIONAL') GO TO HELL 3480 WRITE (7,3490) ENERGY+SHIELD 3490 FORMAT (1X,'ENERGY AVAILABLE = ',I5,/, 14X,'NUMBER OF UNITS TO SHIELDS:?',$) READ (5,1290) ITEMP IF (ITEMP.LT.0) GO TO HELL IF (ENERGY+SHIELD-ITEMP.LT.0) GOTO 3480 ENERGY = ENERGY+SHIELD-ITEMP SHIELD = ITEMP GO TO HELL C ************************************************** C LIBRARY COMPUTER CODE C ************************************************** 4630 IF (DAMAGE(8).GE.0) GOTO 4660 WRITE (7,4640) 4640 FORMAT (1X,'COMPUTER DISABLED') GO TO HELL 4660 WRITE (7,4662) 4662 FORMAT(1X,'COMPUTER ACTIVE AND AWAITING COMMAND:?',$) READ (5,1290) ITEMP IF (ITEMP.EQ.0) GOTO 4740 IF (ITEMP.EQ.1) GOTO 4830 IF (ITEMP.EQ.2) GOTO 4880 WRITE (7,4690) 4690 FORMAT (1X,'FUNCTIONS AVIALABLE FROM COMPUTER',/,4X, 1'0 = CUMULATIVE GALACTIC RECORD',/,4X, 2'1 = STATUS REPORT',/,4X,'2 = PHOTON TORPEDO DATA') GO TO 4660 C CUMULATIVE GALACTIC RECORD CODE BEGINS HERE 4740 WRITE (7,4750) 4750 FORMAT (1X,'COMPUTER RECORD OF GALAXY FOR ALL LONG RANGE 1SENSOR SCANS',/,6X,'1 2 3 4 5 2 6 7 8') WRITE(7,4770) 4770 FORMAT(4X,'----- ----- ----- ----- ----- ----- ----- -----') DO 4810 I=1,8 WRITE (7,4795) I,ARRAY(I,1,2),ARRAY(I,2,2),ARRAY(I,3,2), 1ARRAY(I,4,2),ARRAY(I,5,2),ARRAY(I,6,2),ARRAY(I,7,2),ARRAY(I,8,2) 4795 FORMAT(1X,I2,T5,I3,T11,I3,T17,I3,T23,I3,T29,I3,T35,I3,T41,I3, 1T47,I3) WRITE (7,4770) 4810 CONTINUE GO TO HELL C STATUS REPORT CODE BEGINS HERE 4830 WRITE(7,4840)TKLING,TIME0+DATLFT-TIME,TBASES 4840 FORMAT (4X,'STATUS REPORT',/,1X, 1'NUMBER OF KLINGONS LEFT = ',I3,/,1X, 2'NUMBER OF STARDATES LEFT = ',F7.1,/,1X, 3'NUMBER OF STARBASES LEFT = ',I3) C TRANSFER TO DAMAGE CONTROL REPORT CODE GO TO 3560 C LIBRARY PHOTON TORPEDO DATA CODE BEGINS HERE 4880 PH8 = 0 DO 5260 I=1,3 IF (KLINST(I,3).LE.0) GOTO 5260 PC1 = SECT1 PA = SECT2 PW1 = KLINST(I,1) PX = KLINST(I,2) GO TO 5010 4970 WRITE (7,4972)QUAD1,QUAD2,SECT1,SECT2 4972 FORMAT(1X,'YOU ARE AT QUADRANT (',I3,' ,',I3,' ) SECTOR (', 1I3,' ,',I3,' )',/,1X,'SHIP AND TARGET COORDINATES ARE:?',$) READ (5,4990)PC1,PA,PW1,PX 4990 FORMAT(4F16.0) 5010 PX = PX-PA PA = PC1-PW1 IF (PX.LT.0) GOTO 5130 IF (PA.LT.0) GOTO 5190 IF (PX.GT.0) GOTO 5070 IF (PA.EQ.0) GOTO 5150 5070 PC1 = 1. 5080 IF (ABS(PA).LE.ABS(PX)) GOTO 5110 TEMP = PC1+(((ABS(PA)-ABS(PX))+ABS(PA))/ABS(PA)) WRITE(7,5090)TEMP 5090 FORMAT(1X,'DIRECTION = ',G16.6) GOTO 5240 5110 WRITE(7,5090)PC1+(ABS(PA)/ABS(PX)) GOTO 5240 5130 IF (PA.GT.0) GOTO 5170 IF (PX.GT.0) GOTO 5190 5150 PC1 = 5. GOTO 5080 5170 PC1 = 3. GOTO 5200 5190 PC1 = 7. 5200 IF (ABS(PA).GE.ABS(PX)) GOTO 5230 WRITE(7,5090)PC1+(((ABS(PX)-ABS(PA))+ABS(PX))/ABS(PX)) GOTO 5240 5230 WRITE(7,5090)PC1+(ABS(PX)/ABS(PA)) 5240 WRITE(7,5242) SQRT(PX**2+PA**2) 5242 FORMAT(1X,'DISTANCE = ',G16.6) IF (PH8.EQ.1) GO TO HELL 5260 CONTINUE PH8 = 0. 5280 WRITE(7,5282) 5282 FORMAT(1X,'DO YOU WANT TO USE THE CALCULATOR?',$) READ (5,40) ANSWER IF (ANSWER.EQ.YES) GOTO 4970 IF (ANSWER.EQ.NO) GO TO HELL WRITE (7,50) GOTO 5280 C *********************************************** C THIS IS COMMAND 69 - CHEAT/TEST/DEBUG C *********************************************** 10000 WRITE(7,10010) ARRAY 10010 FORMAT(8I5) GO TO HELL 20000 WRITE (7,20010) 20010 FORMAT (6X,'INSTRUCTIONS',//, 11X,'THE GALAXY IS DIVIDED INTO AN 8,8 QUADRANT GRID',/, 21X,'WHICH IS IN TURN DIVIDED INTO AN 8,8 SECTOR GRID.',//, 31X,'THE CAST OF CHARACTERS IS AS FOLLOWS:',/, 41X,'<*> = ENTERPRISE',/,1X,'+++ = KLINGON',/,1X,'>!< = 4 STARBASE',/, 52X,'* = STAR',/,1X,'COMMAND 0 = WARP ENGINE CONTROL:',/, 63X,'COURSE IS IN A CIRCULAR NUMERICAL 4 3 2',/, 73X,'VECTOR ARRANGEMENT AS SHOWN. \ ^ /',/, 83X,'INTEGER AND REAL VALUES MAY BE \^/',/, 93X,'USED. THEREFORE COURSE 1.5 IS 5 ----- 1') WRITE (7,20020) 20020 FORMAT(3X,'HALF WAY BETWEEN 1 AND 2. /!\',/, 143X,'/ ! \',/, 23X,'A VECTOR OF 9 IS UNDEFINED, BUT 6 7 8',/, 33X,'VALUES MAY APPROACH 9.',17X,'COURSE',//, 43X,'ONE WARP FACTOR IS THE SIZE OF',/, 53X,'ONE QUADRANT. THEREFORE TO GET',/, 63X,'FROM QUADRANT 6,5 TO 5,5 YOU WOULD',/, 73X,'USE COURSE 3. WARP FACTOR 1.',//, 81X,'COMMAND 1 = SHORT RANGE SENSOR SCAN',/, 93X,'PRINTS THE QUADRANT YOU ARE CURRENTLY IN. INCLUDING') WRITE (7,20030) 20030 FORMAT(3X,'STARS, KLINGONS, STARBASES, AND THE ENTERPRISE. 1 ALONG',/, 13X,'WITH OTHER PERTINATE INFORMATION.',//, 21X,'COMMAND 2 = LONG RANGE SENSOR SCAN',/, 33X,'SHOWS CONDITIONS IN SPACE FOR ONE QUADRANT ON EACH SIDE',/, 43X,'OF THE ENTERPRISE IN THE MIDDLE OF THE SCAN. THE SCAN',/, 53X,'IS CODED IN THE FORM "KBS", WHERE K IS THE NUMBER',/, 63X,'OF KLINGONS, B IS THE NUMBER OF STARBASES, AND S IS',/, 73X,'THE NUMBER OF STARS.',//, 81X,'COMMAND 3 = PHASER CONTROL',/, 93X,'ALLOWS YOU TO DESTROY THE KLINGONS BY HITTING THEM WITH') WRITE (7,20040) 20040 FORMAT(3X,'SUITABLY LARGE NUMBERS OF ENERGY UNITS TO DEPLETE 1 THEIR',/, 13X,'SHIELD POWER. KEEP IN MIND THAT WHEN YOU SHOOT AT THEM.',/, 23X,'THEY GONNA SHOOT AT YOU, TOO!',//, 31X,'COMMAND 4 = PHOTON TORPEDO CONTROL',/, 43X,'COURSE IS THE SAME AS USED IN WARP ENGINE CONTROL',/, 53X,'IF YOU HIT THE KLINGON, HE IS DESTROYED AND CANNOT FIRE',/, 63X,'BACK AT YOU. IF YOU MISS, YOU ARE SUBJECT TO HIS',/, 73X,'PHASER FIRE.',//, 83X,'NOTE: THE LIBRARY COMPUTER (COMMAND 7) HAS AN OPTION',/, 93X,'TO COMPUTE TORPEDO TRAJECTORY FOR YOU (OPTION 2).',/,) WRITE (7,20050) 20050 FORMAT(1X,'COMMAND 5 = SHIELD CONTROL',/, 13X,'DEFINES NUMBER OF ENERGY UNITS TO BE ASSIGNED TO SHIELDS.',/, 23X,'ENERGY IS TAKEN FROM TOTAL SHIP''S ENERGY.',/, 33X,'NOTE: TOTAL ENERGY INCLUDES SHIELD ENERGY.',//, 41X,'COMMAND 6 = DAMAGE CONTROL REPORT',/, 53X,'GIVES STATE OF REPAIRS OF ALL DEVICES. A STATE OF REPAIR',/, 63X,'LESS THAN ZERO SHOWS THAT THE DEVICE IS TEMPORALLY',/, 73X,'DAMAGED.',//, 81X,'COMMAND 7 = LIBRARY COMPUTER',/, 93X,'THE LIBRARY COMPUTER CONTAINS THREE OPTIONS:') WRITE (7,20060) 20060 FORMAT(5X,'OPTION 0 = CUMULATIVE GALACTIC RECORD',/, 17X,'WHICH SHOWS COMPUTER MEMORY OF THE RESULTS',/, 27X,'OF ALL PREVIOUS LONG RANGE SENSOR SCANS.',/, 35X,'OPTION 1 = STATUS REPORT',/, 47X,'WHISH SHOWS NUMBER OF KLINGONS, STARBASES,',/, 57X,'AND STARDATES LEFT.',/, 65X,'OPTION 2 = PHOTON TORPEDO DATA',/, 77X,'GIVES TRAJECTORY AND DISTANCE BETWEEN THE',/, 87X,'ENTERPRISE AND ALL KLINGONS IN YOUR QUADRANT',/, 89X,'IF YOU WISH TO USE THE COMPUTER''S CALCULATOR',/, 89X,'TO AID NAVIGATION OR DOCKING THEN ENTER',/, 89X,'COORDINATES (QUADRANT OR SECTOR)',/, 89X,'OF SHIP AND TARGET - IN SOURCE,DESTINATION',/, 89X,'FORMAT - EG...S,S,T,T',/) WRITE (7,20070) 20070 FORMAT (1X,'COMMAND 8 = BEGIN NEW CONTEST',/, 13X,'STARTS PROGRAM OVER AGAIN WITH ALL NEW DATA.',/, 23X,'USED TO CREATE MORE CHALLENGING SETUP - IE: MORE',/, 33X,'KLINGONS AND FEWER STARBASES!',///) GO TO 100 END C ************************************************************* C ************************************************************* C THIS IS 'THE ENEMY SHOOTS BACK' SUBROUTINE C THE CALL MUST BE FOLLOWED BY 'IF(SHIELD.LT.0) GOTO 4000' SUBROUTINE SHOOT COMMON ARRAY,ZONE1,ZONE2,INSERT,RANK1,RANK2,OK,IRA,JONES COMMON DOCKED,KLING3,KLINST,SECT1,SECT2,SHIELD INTEGER ARRAY(8,8,3),ZONE1,ZONE2,RANK1,RANK2,OK,DOCKED INTEGER KLINST(3,3),HIT,SECT1,SECT2,SHIELD IF (DOCKED.EQ.0) GOTO 3820 WRITE(7,3800) 3800 FORMAT(1X,'STAR BASE SHIELDS PROTECT THE ENTERPRISE.') RETURN 3820 IF (KLING3.LE.0) GOTO 3910 DO 3900 I=1,3 IF (KLINST(I,3).LE.0) GOTO 3900 TEMP = SQRT(FLOAT((KLINST(I,1)-SECT1)**2+(KLINST(I,2)-SECT2)**2)) HIT = INT((KLINST(I,3)/TEMP)*(2.+RAN(IRA,JONES))) SHIELD = SHIELD-HIT WRITE(7,3860)HIT,KLINST(I,1),KLINST(I,2),SHIELD 3860 FORMAT(1X,'KLINGON ATTACK',/,1X, 1I4,' UNIT HIT ON ENTERPRISE FROM SECTOR ',I2,' ,',I2, 25X,'(',I5,' LEFT)') IF (SHIELD.LT.0) GOTO 3910 3900 CONTINUE 3910 RETURN END C ************************************************************* C ************************************************************* C THIS SUBROUTINE GENERATES SECTOR COORDINATES -- RANK1 & RANK2 SUBROUTINE SECTOR COMMON ARRAY,ZONE1,ZONE2,INSERT,RANK1,RANK2,OK,IRA,JONES INTEGER ARRAY(8,8,3),ZONE1,ZONE2,RANK1,RANK2,OK 5380 RANK1 = INT(RAN(IRA,JONES)*8+1) RANK2 = INT(RAN(IRA,JONES)*8+1) INSERT = 0 ZONE1 = RANK1 ZONE2 = RANK2 CALL CHECK IF (OK.EQ.0) GOTO 5380 RETURN END C ***************************************************************** C ***************************************************************** C THIS SUBROUTINE CHECKS TO SEE IF SECTOR LACATION = "INSERT" VALUE SUBROUTINE CHECK COMMON ARRAY,ZONE1,ZONE2,INSERT,RANK1,RANK2,OK INTEGER ARRAY(8,8,3),ZONE1,ZONE2,RANK1,RANK2,OK OK = 0 IF (ARRAY(ZONE1,ZONE2,3).NE.INSERT) GOTO 5810 OK = 1 5810 RETURN END