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