00010COMMENT **** STAR TREK IN FORTRAN ****
00020COMMENT
00030 IMPLICIT INTEGER (A-Z)
00040 REAL X, C1, W1, RAN
00050COMMENT
00060 COMMON G(8,8), Q(8,8), K(3,3), C(9,2),
00070 1 ZSTR(2,6), D(6), NQ(3), CSTR(2),
00080 2 QSTR(5), QOUT(8),
00090 3 Q1, Q2, S1, S2, R1, R2,
00100 4 K9, K3, E , S , P , T,
00110 5 NR
00120COMMENT
00130 DATA C/0, -1, -1, -1, 0, 1, 1, 1, 0,
00140 1 1, 1, 0, -1,-1,-1, 0, 1, 1/
00150 DATA ZSTR/10HWARP ENGNS, 10HLR SENSORS,
00160 1 10HPHASER CTL, 10HPHOTON TBS,
00170 2 10HSHIELD CTL, 10HCOMPUTER /
00180 DATA QSTR/3H . ,3H E ,3H K ,3H * ,3H B /
00190 DATA D/6*0/
00200COMMENT
00210COMMENT LINE FUNCTIONS
00220 FNA(IR)= INT(IR * RAN(NR) + 1)
00230 FND(DK)= SQRT(FLOAT((K(I,1)-S1)**2 + (K(I,2)-S2)**2))
00240COMMENT
00250COMMENT START RANDOM NUMBERS AT DIFFERENT PLACES
00260COMMENT
00270 TYPE 9050
002809050 FORMAT('0ENTER A POSITIVE INTEGER: ',$)
00290 ACCEPT 8000, NR
00300 CALL SETRAN (NR)
00310COMMENT
00320COMMENT
00330 T0= (FNA(20) + 20) * 100
00340 T = T0
00350 E = 4000
00360 P = 15
00370 S = 3000
00380 Q1= FNA(8)
00390 Q2= FNA(8)
00400 S1= FNA(8)
00410 S2= FNA(8)
00420COMMENT C(9,2) AND D(6) IN DATA STMTS
00430COMMENT SET UP GALAXY
00440COMMENT
00450200 B9= 0
00460 K9= 0
00470 DO 330 I= 1,8
00480 DO 320 J= 1,8
00490 K3= 0
00500 B3= 0
00510 IF(RAN(1).LT.0.8) GO TO 270
00520 K3= FNA(3)
00530 K9= K9 + K3
00540270 IF(RAN(1).LT.0.96) GO TO 300
00550 B3= 1
00560 B9= B9 + 1
00570300 S3= FNA(5)
00580 G(I,J)= K3*100 + B3*10 + S3
00590320 CONTINUE
00600330 CONTINUE
00610 IF(K9.EQ.0.OR.B9.EQ.0) GO TO 200
00620COMMENT
00630COMMENT INSTRUCTIONS
00640COMMENT
00650 GO TO 3570
00660COMMENT
00670360 IF(Q1.GE.1) GO TO 380
00680 S1= 1
00690 Q1= 1
00700380 IF(Q1.LE.8) GO TO 400
00710 S1= 8
00720 Q1= 8
00730400 IF(Q2.GE.1) GO TO 420
00740 S2= 1
00750 Q2= 1
00760420 IF(Q2.LE.8) GO TO 440
00770 S2= 8
00780 Q2= 8
00790COMMENT
00800440 X= FLOAT(G(Q1,Q2))/100.0
00810 K3= INT(X)
00820 B3= INT((X-K3)*10)
00830 S3= G(Q1,Q2) - (B3*10) - (K3*100)
00840 IF(K3.EQ.0) GO TO 520
00850 TYPE 9000
008609000 FORMAT('0COMBAT AREA',5X,'CONDITION RED')
00870 IF(S.GT.K3*100) GO TO 520
00880 TYPE 9001
008909001 FORMAT(' SHIELDS DANGEROUSLY LOW')
00900COMMENT
00910COMMENT SET UP QUADRANT
00920COMMENT
00930520 DO 525 I= 1,3
00940 DO 525 J= 1,3
00950 K(I,J)= 0
00960525 CONTINUE
00970 DO 530 I= 1,8
00980 DO 530 J= 1,8
00990 Q(I,J)= 0
01000530 CONTINUE
01010 Q(S1,S2)= 1
01020 IF(K3.EQ.0) GO TO 620
01030 DO 610 I= 1,K3
01040 CALL QUAD
01050 Q(R1,R2)= 2
01060 K(I,1)= R1
01070 K(I,2)= R2
01080 K(I,3)= 200
01090610 CONTINUE
01100620 IF(B3.EQ.0) GO TO 650
01110 CALL QUAD
01120 Q(R1,R2)= 4
01130650 DO 680 I= 1,S3
01140 CALL QUAD
01150 Q(R1,R2)= 3
01160680 CONTINUE
01170COMMENT
01180COMMENT SHORT RANGE SCAN
01190COMMENT
01200690 CALL SHORT
01210COMMENT
01220700 TYPE 9002
012309002 FORMAT(1H ,'COMMAND: ',$)
01240 ACCEPT 8000,A
012508000 FORMAT(I)
01260 IF(A.LT.200) GO TO 710
01270 CALL CHEAT
01280 GO TO 700
01290710 R1= A + 1
01300 IF(R1.LT.1.OR.R1.GT.7) GO TO 790
01310 IF(D(R1).GE.0) GO TO 780
01320 DO 720 I= 1,6
01330 IF(D(I).GE.0) GO TO 720
01340 TYPE 9003, (ZSTR(J,I), J=1,2)
013509003 FORMAT(1H ,2A5,' NOT OPERATIONAL')
01360720 CONTINUE
01370 GO TO 700
01380COMMENT
01390780 GO TO (890, 1520, 1640, 1800, 2200, 3010, 3550), R1
01400COMMENT
01410790 TYPE 9004
014209004 FORMAT(1H0,'0 = SET COURSE',T22,'4 3 2'/
01430 1 ' 1 = LONG RANGE SCAN',T23,'^ /'/
01440 2 ' 2 = PHASER CTRL',T24,'\ /'/
01450 3 ' 3 = TORPEDO CTRL',T21,'5---*---1'/
01460 4 ' 4 = SHIELDS',T24,'/ \'/
01470 5 ' 5 = LIBRARY COMPUTER', T23,'/ \'/
01480 6 ' 6 = RESIGNATION',T22,'6 7 8'/1H )
01490 GO TO 700
01500COMMENT
01510COMMENT SET COURSE AND GO
01520COMMENT
01530890 TYPE 9005
015409005 FORMAT(1H ,'COURSE (1-8.9999): ',$)
01550 ACCEPT 8001, C1
015608001 FORMAT(F)
01570 IF(C1.LT.1.0.OR.C1.GT.8.9999) GO TO 700
01580920 TYPE 9006
015909006 FORMAT(1H ,'WARP FACTOR (0-8): ',$)
01600 ACCEPT 8001, W1
01610 IF(W1.LE.0.0.OR.W1.GT.8.0) GO TO 700
01620 IF(D(1).GE.0.OR.W1.LE.0.5) GO TO 980
01630 TYPE 9007
016409007 FORMAT(1H ,'ENGINES ARE DAMAGED, MAXIMUM SPEED = WARP 0.5')
01650 GO TO 920
01660COMMENT
01670980 IF(E-(W1*8).GT.0) GO TO 1030
01680 IF(S.LT.1) GO TO 2470
01690 TYPE 9008, E, S
017009008 FORMAT(1H ,'YOU HAVE ONLY',I5,' UNITS. SUGGEST YOU'
01710 1 'CROSS-CIRCUIT FROM SHIELDS WHICH HAVE',I5,' UNITS')
01720 GO TO 700
01730COMMENT REPAIRS
017401030 DO 1060 I= 1,6
01750 IF(D(I).GE.0) GO TO 1060
01760 D(I)= D(I) + 1
017701060 CONTINUE
01780COMMENT RANDOM DAMAGE
01790 IF(FNA(10).NE.5.OR.W1.LT.2.0) GO TO 1120
01800 R1= FNA(6)
01810 D(R1)= D(R1) - FNA(5)
01820 TYPE 9009 , (ZSTR(J,R1), J=1,2)
018309009 FORMAT(1HO,'DAMAGE CTRL REPORTS ',2A5,' DAMAGED')
01840COMMENT
018501120 N= INT(W1*8.0)
01860 Q(S1,S2)= 0
01870 XX= S1
01880 YY= S2
01890 C2= INT(C1)
01900 X1= C(C2,1) + (C(C2+1,1) - C(C2,1)) * (C1-C2)
01910 X2= C(C2,2) + (C(C2+1,2) - C(C2,2)) * (C1-C2)
01920 DO 1270 I= 1,N
01930 S1= S1 + X1
01940 S2= S2 + X2
01950 IF(S1.LT.1.OR.S1.GT.8.OR.S2.LT.1.OR.S2.GT.8) GO TO 1360
01960 IF(Q(S1,S2).EQ.0) GO TO 1270
01970 S1= S1 - X1
01980 S2= S2 - X2
01990 GO TO 1280
020001270 CONTINUE
020101280 Q(S1,S2)= 1
02020 E= E - N
02030COMMENT LESS THAN 1 QUADRANT
02040 IF(W1.LT.1.0) GO TO 690
02050COMMENT IF TIME UP -- STOP
02060 T= T + 1
02070 IF(T.GT.T0+30) GO TO 2500
02080 GO TO 690
02090COMMENT MORE THAN 1 QUADRANT
021001360 XX= Q1*8 + XX + X1*N
02110 YY= Q2*8 + YY + X2*N
02120 Q1= XX/8
02130 Q2= YY/8
02140 S1= INT(XX - Q1*8 + 0.5)
02150 S2= INT(YY - Q2*8 + 0.5)
02160 IF(S1.GT.0) GO TO 1450
02170 Q1= Q1 - 1
02180 S1= 8
021901450 IF(S2.GT.0) GO TO 1480
02200 Q2= Q2 - 1
02210 S2= 8
022201480 T= T + 1
02230 E= E - (N + 5)
02240 IF(T.GT.T0+30) GO TO 2500
02250COMMENT SET UP NEW QUADRANT
02260 GO TO 360
02270COMMENT
02280COMMENT LONG RANGE SCAN
02290COMMENT
023001520 TYPE 9010
023109010 FORMAT(1H0,17(1H-))
02320 DO 1610 I= Q1-1, Q1+1
02330 DO 1540 NN= 1,3
02340 NQ(NN)= 0
023501540 CONTINUE
02360 DO 1580 J= Q2-1, Q2+1
02370 IF(I.LT.1.OR.I.GT.8.OR.J.LT.1.OR.J.GT.8) GO TO 1580
02380 NQ(J-Q2+2)= G(I,J)
023901580 CONTINUE
02400 TYPE 9011, (NQ(NN), NN=1,3)
024109011 FORMAT(3H : , 3(I3,3H : ))
02420 TYPE 9010
024301610 CONTINUE
02440 GO TO 700
02450COMMENT
02460COMMENT PHASERS
02470COMMENT
024801640 IF(K3.GT.0) GO TO 1650
024902350 TYPE 9012
025009012 FORMAT(1H ,'SHORT RANGE SENSORS REPORT NO KLINGONS'/
02510 1 'IN THIS QUADRANT')
02520 GO TO 700
025301650 TYPE 9013, E
025409013 FORMAT(1H ,'ENERGY AVAILABLE = ',I6/
02550 1 1H 'NUMBER OF UNITS TO FIRE: ',$)
02560 ACCEPT 8000, XP
02570 IF(XP.LT.1) GO TO 700
02580 IF(E-XP.LT.0) GO TO 1650
02590 E= E-XP
02600 DO 1780 I= 1,3
02610 IF(K(I,3).EQ.0) GO TO 1780
02620 H= XP/K3/FND(0)
02630 K(I,3)= K(I,3) - H
02640 TYPE 9014, H
026509014 FORMAT(I6,' UNIT HIT ON KLINGON')
02660 IF(K(I,3).GT.0) GO TO 1780
02670 CALL KDEAD(I)
026801780 CONTINUE
02690COMMENT
02700 CALL KFIRE
02710 GO TO 700
02720COMMENT
02730COMMENT PHOTON TORPEDOES
02740COMMENT
027501800 IF(P.GT.0) GO TO 1830
02760 TYPE 9015
027709015 FORMAT(1H ,'ALL PHOTON TORPEDOES EXPENDED')
02780 GO TO 700
027901830 TYPE 9016
028009016 FORMAT(1H ,'TORPEDO COURSE (1-8.9999): ',$)
02810 ACCEPT 8001, C1
02820 IF(C1.LT.1.0.OR.C1.GT.8.9999) GO TO 700
02830 C2= INT(C1)
02840 X1= C(C2,1) + (C(C2+1,1) - C(C2,1)) * (C1-C2)
02850 X2= C(C2,2) + (C(C2+1,2) - C(C2,2)) * (C1-C2)
02860 XX= S1
02870 YY= S2
02880 P= P - 1
028901930 XX= XX + X1
02900 YY= YY + X2
02910 IF(XX.LT.1.OR.XX.GT.8.OR.YY.LT.1.OR.YY.GT.8) GO TO 2180
02920 IF(Q(XX,YY).EQ.0.AND.Q(XX+1,YY+1).EQ.0) GO TO 1930
02930 DO 2000 I= 1,3
02940 IF(XX.EQ.K(I,1).AND.YY.EQ.K(I,2)) GO TO 2020
02950 IF(XX+1.EQ.K(I,1).AND.YY+1.EQ.K(I,2)) GO TO 2020
02960 IF(XX-1.EQ.K(I,1).AND.YY-1.EQ.K(I,2)) GO TO 2020
029702000 CONTINUE
02980 GO TO 2120
02990COMMENT
030002020 CALL KDEAD(I)
03010COMMENT
03020 CALL KFIRE
03030 GO TO 700
03040COMMENT
030502120 IF(Q(XX,YY).NE.3) GO TO 2150
03060 TYPE 9017
030709017 FORMAT(1H ,'YOU CAN''T DESTROY STARS, SILLY')
03080 GO TO 2180
030902150 IF(Q(XX,YY).NE.4) GO TO 2180
03100 TYPE 9018
031109018 FORMAT(1H ,'***STARBASE DESTROYED***'/
03120 1 ' YOU ARE HEREBY RELIEVED OF DUTY. GOOD-BYE***')
03130 STOP
03140COMMENT
031502180 TYPE 9019
031609019 FORMAT(1H ,'TORPEDO MISSED')
03170 CALL KFIRE
03180 GO TO 700
03190COMMENT
03200COMMENT SHIELDS - ENERGY INTERCHANGE
03210COMMENT
032202200 TYPE 9020, E, S
032309020 FORMAT(1H0,'ENERGY AVAILABLE = ',I6/
03240 1 ' AND IN SHIELDS = ',I6/
03250 2 ' WHICH WAY TO TRANSFER--'/
03260 3 ' 1. ENERGY TO SHIELDS'/
03270 4 ' 2. SHIELDS TO ENERGY')
03280 ACCEPT 8000, ES
03290 IF(ES.LT.1.OR.ES.GT.2) GO TO 700
033002210 TYPE 9021
033109021 FORMAT(1H ,'NUMBER OF UNITS TO TRANSFER: ',$)
03320 ACCEPT 8000, EX
03330 IF(EX.LT.0) GO TO 700
03340 IF(E+S-EX.LT.0) GO TO 2210
03350 GO TO (2220, 2240), ES
03360COMMENT ENERGY TO SHIELDS
033702220 E= E - EX
03380 S= S + EX
03390 GO TO 700
03400COMMENT SHIELDS TO ENERGY
034102240 E= E + EX
03420 S= S - EX
03430 GO TO 700
03440COMMENT
03450COMMENT LIBRARY COMPUTER
03460COMMENT
034703010 TYPE 9022
034809022 FORMAT(1H0,'COMPUTER ACTIVE AND AWAITING COMMAND')
03490 ACCEPT 8000, A
03500 IF(A.GE.0.AND.A.LT.3) GO TO 3030
03510 TYPE 9023
035209023 FORMAT(1H ,'FUNCTIONS AVAILABLE FROM COMPUTER'/
03530 1 1H ,' 0 = DAMAGE REPORT'/
03540 2 1H ,' 1 = PHOTON TORPEDO DATA'/
03550 3 1H ,' 2 = SHORT RANGE SCAN')
03560 GO TO 3010
03570COMMENT
035803030 GO TO (2280, 3100, 3310), A+1
03590COMMENT
03600COMMENT DAMAGE REPORT
03610COMMENT
036202280 TYPE 9024
036309024 FORMAT(1H0,'DEVICE',6X,'STATE OF REPAIR')
03640 DO 2300 I= 1,6
03650 TYPE 9025, (ZSTR(J,I), J=1,2), D(I)
036609025 FORMAT(1H ,2A5,8X,I3)
036702300 CONTINUE
03680 GO TO 700
03690COMMENT
03700COMMENT TORPEDO DATA
03710COMMENT
037203100 DO 3200 I= 1,3
03730 IF(K(I,3).LE.0) GO TO 3200
03740 XX= K(I,2) - S2
03750 YY= S1- K(I,1)
03760 IF(XX.EQ.0) GO TO 3240
03770 A= INT(((57.3*ATAN(FLOAT(YY/XX)))/45 + 1) * 100)/100
03780 IF(XX.GT.0.AND.YY.LT.0) GO TO 3290
03790 IF(XX.LT.0) GO TO 3220
038003190 TYPE 9026, A
038109026 FORMAT(1H ,'DIRECTION = ',I4)
03820 GO TO 3200
03830COMMENT
038403220 A= A + 4
03850 GO TO 3190
038603240 IF(YY.LT.0) GO TO 3270
03870 A = 3
03880 GO TO 3190
038903270 A = 7
03900 GO TO 3190
039103290 A = A + 8
03920 GO TO 3190
03930COMMENT
039403200 CONTINUE
03950 GO TO 700
03960COMMENT
03970COMMENT SHORT RANGE SCAN
03980COMMENT
039903310 CALL SHORT
04000 GO TO 700
04010COMMENT
04020COMMENT RESIGINATION AND END
04030COMMENT
040403550 TYPE 9027
040509027 FORMAT(1H0,'YOUR RESIGNATION HAS BEEN ACCEPTED')
04060 STOP
040702500 TYPE 9028, T
040809028 FORMAT(1H0,'IT IS STARDATE = ',I5)
04090 STOP
041002470 TYPE 9029
041109029 FORMAT(1HO,'THE ENTERPRISE IS DEAD IN SPACE.'
04120 1 ' IT MUST BE EVACUATED.'/' THE FEDERATION WILL BE CONQUERED**')
04130 STOP
04140COMMENT
04150COMMENT INSTRUCTIONS
04160COMMENT
041703570 TYPE 9030
041809030 FORMAT(1H0,'DO YOU NEED INSTRUCTIONS\ Y OR N ',$)
04190 ACCEPT 8002, A
042008002 FORMAT(A1)
04210 IF(A.NE.'Y') GO TO 440
04220 TYPE 9031
042309031 FORMAT(1H ,'THIS PART IS NOT WRITTEN YET')
04240 GO TO 440
04250 END
04260 SUBROUTINE QUAD
04270COMMENT
04280 IMPLICIT INTEGER (A-Z)
04290 REAL X, C1, W1, RAN
04300COMMENT
04310 COMMON G(8,8), Q(8,8), K(3,3), C(9,2),
04320 1 ZSTR(2,6), D(6), NQ(3), CSTR(2),
04330 2 QSTR(5), QOUT(8),
04340 3 Q1, Q2, S1, S2, R1, R2,
04350 4 K9, K3, E , S , P , T,
04360 5 NR
04370COMMENT
04380COMMENT
04390 FNA(IR)= INT(IR * RAN(NR) + 1)
04400COMMENT
044103510 R1= FNA(8)
04420 R2= FNA(8)
04430 IF(Q(R1,R2).NE.0) GO TO 3510
04440 RETURN
04450 END
04460 SUBROUTINE SHORT
04470COMMENT SHORT RANGE SCAN
04480COMMENT
04490 IMPLICIT INTEGER (A-Z)
04500 REAL X, C1, W1, RAN
04510COMMENT
04520 COMMON G(8,8), Q(8,8), K(3,3), C(9,2),
04530 1 ZSTR(2,6), D(6), NQ(3), CSTR(2),
04540 2 QSTR(5), QOUT(8),
04550 3 Q1, Q2, S1, S2, R1, R2,
04560 4 K9, K3, E , S , P , T,
04570 5 NR
04580COMMENT
04590 DO 2650 I= S1-1, S1+1
04600 DO 2640 J= S2-1, S2+1
04610 IF(I.LT.1.OR.I.GT.8.OR.J.LT.1.OR.J.GT.8) GO TO 2640
04620 IF(Q(I,J).EQ.4) GO TO 2670
046302640 CONTINUE
046402650 CONTINUE
04650 GO TO 2730
04660COMMENT
046702670 CSTR(1)= 'DOCKE'
04680 CSTR(2)= 'D '
04690 E= 4000
04700 P= 15
04710 DO 2700 I= 1,6
04720 D(I)= 0
047302700 CONTINUE
04740 S= 3000
04750 GO TO 2810
04760COMMENT
047702730 TYPE 9000
047809000 FORMAT(1H )
04790 IF(K3.GT.0) GO TO 2780
04800 IF(E.LT.300) GO TO 2800
04810 CSTR(1)= 'GREEN'
04820 CSTR(2)= ' '
04830 GO TO 2810
048402780 CSTR(1)= '*RED*'
04850 CSTR(2)= ' '
04860 GO TO 2810
048702800 CSTR(1)= 'YELLO'
04880 CSTR(2)= 'W '
04890COMMENT
049002810 TYPE 9001
049109001 FORMAT(1H ,24(1H-))
04920 Z= 1
04930 CALL QSET (Z)
04940 TYPE 9002, (QOUT(I), I=1,8), T
049509002 FORMAT(8A3,5X,8HSTARDATE,5X,I4)
04960 Z=2
04970 CALL QSET (Z)
04980 TYPE 9003, (QOUT(I), I=1,8), CSTR
049909003 FORMAT(8A3,5X,9HCONDITION,4X,2A5)
05000 Z= 3
05010 CALL QSET (Z)
05020 TYPE 9004, (QOUT(I), I=1,8), Q1, Q2
050309004 FORMAT(8A3,5X,8HQUADRANT,5X,I1,1H-,I1)
05040 Z= 4
05050 CALL QSET (Z)
05060 TYPE 9005, (QOUT(I), I=1,8), S1, S2
050709005 FORMAT(8A3,5X,6HSECTOR,7X,I1,1H-,I1)
05080 Z= 5
05090 CALL QSET (Z)
05100 TYPE 9006, (QOUT(I), I=1,8), E
051109006 FORMAT(8A3,5X,6HENERGY,7X,I4)
05120 Z= 6
05130 CALL QSET (Z)
05140 TYPE 9007, (QOUT(I), I=1,8), P
051509007 FORMAT(8A3,5X,9HTORPEDOES,4X,I4)
05160 Z= 7
05170 CALL QSET (Z)
05180 TYPE 9008, (QOUT(I), I=1,8), S
051909008 FORMAT(8A3,5X,7HSHIELDS,6X,I4)
05200 Z= 8
05210 CALL QSET (Z)
05220 TYPE 9009, (QOUT(I), I=1,8), K9
052309009 FORMAT(8A3,5X,8HKLINGONS, 5X,I4)
05240 TYPE 9001
05250 RETURN
05260 END
05270 SUBROUTINE QSET (Z)
05280COMMENT
05290 IMPLICIT INTEGER (A-Z)
05300 REAL X, C1, W1, RAN
05310COMMENT
05320 COMMON G(8,8), Q(8,8), K(3,3), C(9,2),
05330 1 ZSTR(2,6), D(6), NQ(3), CSTR(2),
05340 2 QSTR(5), QOUT(8),
05350 3 Q1, Q2, S1, S2, R1, R2,
05360 4 K9, K3, E , S , P , T,
05370 5 NR
05380COMMENT
05390 DO 100 I= 1,8
05400 J= Q(Z,I) + 1
05410 QOUT(I)= QSTR(J)
05420100 CONTINUE
05430 RETURN
05440 END
05450 SUBROUTINE CHEAT
05460COMMENT
05470COMMENT PUTS OUT GALAXY WITH BASES AND KLINGONS
05480COMMENT
05490 IMPLICIT INTEGER (A-Z)
05500 REAL X, C1, W1, RAN
05510COMMENT
05520 COMMON G(8,8), Q(8,8), K(3,3), C(9,2),
05530 1 ZSTR(2,6), D(6), NQ(3), CSTR(2),
05540 2 QSTR(5), QOUT(8),
05550 3 Q1, Q2, S1, S2, R1, R2,
05560 4 K9, K3, E , S , P , T,
05570 5 NR
05580COMMENT
05590 DO 100 I= 1,8
05600 TYPE 9000, (G(I,J),J=1,8)
05610100 CONTINUE
056209000 FORMAT(1H ,40(1H-)/40 I5)
05630 TYPE 9001
056409001 FORMAT(1H ,40(1H-)/1H )
05650 RETURN
05660 END
05670 SUBROUTINE KDEAD (I)
05680COMMENT
05690 IMPLICIT INTEGER (A-Z)
05700 REAL X, C1, W1, RAN
05710COMMENT
05720 COMMON G(8,8), Q(8,8), K(3,3), C(9,2),
05730 1 ZSTR(2,6), D(6), NQ(3), CSTR(2),
05740 2 QSTR(5), QOUT(8),
05750 3 Q1, Q2, S1, S2, R1, R2,
05760 4 K9, K3, E , S , P , T,
05770 5 NR
05780COMMENT
05790 K(I,3)= 0
05800 I1= K(I,1)
05810 I2= K(I,2)
05820 Q(I1,I2)= 0
05830 TYPE 9000
058409000 FORMAT(1H0,'***KLINGON DESTROYED***')
05850 K3= K3 - 1
05860 K9= K9 - 1
05870 IF(K9.EQ.0) GO TO 2550
05880 G(Q1,Q2)= G(Q1,Q2) - 100
05890 RETURN
05900COMMENT END OF GAME---ALL KLINGONS GONE
059102550 TYPE 9001
059209001 FORMAT(1H0,'THE LAST KLINGON BATTLE CRUSIER DESTROYED.'/
05930 1 ' THE FEDERATION HAS BEEN SAVED*** CONGRATULATIONS***')
05940 STOP
05950 END
05960 SUBROUTINE KFIRE
05970COMMENT
05980 IMPLICIT INTEGER (A-Z)
05990 REAL X, C1, W1, RAN
06000COMMENT
06010 COMMON G(8,8), Q(8,8), K(3,3), C(9,2),
06020 1 ZSTR(2,6), D(6), NQ(3), CSTR(2),
06030 2 QSTR(5), QOUT(8),
06040 3 Q1, Q2, S1, S2, R1, R2,
06050 4 K9, K3, E , S , P , T,
06060 5 NR
06070COMMENT
06080 FND(DK)= SQRT(FLOAT((K(I,1)-S1)**2 + (K(I,2)-S2)**2))
06090COMMENT
06100 IF(CSTR(1).EQ.'DOCKE') GO TO 2460
06110 IF(K3.EQ.0) GO TO 2460
06120 DO 2450 I= 1,3
06130 IF(K(I,3).EQ.0) GO TO 2450
06140 H= K(I,3)/FND(0) + 1
06150 S= S -H
06160 TYPE 9000, H
061709000 FORMAT(I5,' UNIT HIT ON ENTERPRISE')
06180 IF(S.LT.0) GO TO 2520
061902450 CONTINUE
062002460 RETURN
06210COMMENT ENTERPRISE DESTROYED----STOP
062202520 TYPE 9001
062309001 FORMAT(1H0,'***THE ENTERPRISE HAS BEEN DESTROYED***'/
06240 1 ' THE FEDERATION WILL BE CONQUERED***')
06250 STOP
06260 END