COMMENT **** STAR TREK IN FORTRAN ****
COMMENT
IMPLICIT INTEGER (A-Z)
REAL X, C1, W1, RAN
COMMENT
COMMON G(8,8), Q(8,8), K(3,3), C(9,2),
1 ZSTR(2,6), D(6), NQ(3), CSTR(2),
2 QSTR(5), QOUT(8),
3 Q1, Q2, S1, S2, R1, R2,
4 K9, K3, E , S , P , T,
5 NR
COMMENT
DATA C/0, -1, -1, -1, 0, 1, 1, 1, 0,
1 1, 1, 0, -1,-1,-1, 0, 1, 1/
DATA ZSTR/10HWARP ENGNS, 10HLR SENSORS,
1 10HPHASER CTL, 10HPHOTON TBS,
2 10HSHIELD CTL, 10HCOMPUTER /
DATA QSTR/3H . ,3H E ,3H K ,3H * ,3H B /
DATA D/6*0/
COMMENT
COMMENT LINE FUNCTIONS
FNA(IR)= INT(IR * RAN(NR) + 1)
FND(DK)= SQRT(FLOAT((K(I,1)-S1)**2 + (K(I,2)-S2)**2))
COMMENT
COMMENT START RANDOM NUMBERS AT DIFFERENT PLACES
COMMENT
TYPE 9050
9050 FORMAT('0ENTER A POSITIVE INTEGER: ',$)
ACCEPT 8000, NR
CALL SETRAN (NR)
COMMENT
COMMENT
T0= (FNA(20) + 20) * 100
T = T0
E = 4000
P = 15
S = 3000
Q1= FNA(8)
Q2= FNA(8)
S1= FNA(8)
S2= FNA(8)
COMMENT C(9,2) AND D(6) IN DATA STMTS
COMMENT SET UP GALAXY
COMMENT
200 B9= 0
K9= 0
DO 330 I= 1,8
DO 320 J= 1,8
K3= 0
B3= 0
IF(RAN(1).LT.0.8) GO TO 270
K3= FNA(3)
K9= K9 + K3
270 IF(RAN(1).LT.0.96) GO TO 300
B3= 1
B9= B9 + 1
300 S3= FNA(5)
G(I,J)= K3*100 + B3*10 + S3
320 CONTINUE
330 CONTINUE
IF(K9.EQ.0.OR.B9.EQ.0) GO TO 200
COMMENT
COMMENT INSTRUCTIONS
COMMENT
GO TO 3570
COMMENT
360 IF(Q1.GE.1) GO TO 380
S1= 1
Q1= 1
380 IF(Q1.LE.8) GO TO 400
S1= 8
Q1= 8
400 IF(Q2.GE.1) GO TO 420
S2= 1
Q2= 1
420 IF(Q2.LE.8) GO TO 440
S2= 8
Q2= 8
COMMENT
440 X= FLOAT(G(Q1,Q2))/100.0
K3= INT(X)
B3= INT((X-K3)*10)
S3= G(Q1,Q2) - (B3*10) - (K3*100)
IF(K3.EQ.0) GO TO 520
TYPE 9000
9000 FORMAT('0COMBAT AREA',5X,'CONDITION RED')
IF(S.GT.K3*100) GO TO 520
TYPE 9001
9001 FORMAT(' SHIELDS DANGEROUSLY LOW')
COMMENT
COMMENT SET UP QUADRANT
COMMENT
520 DO 525 I= 1,3
DO 525 J= 1,3
K(I,J)= 0
525 CONTINUE
DO 530 I= 1,8
DO 530 J= 1,8
Q(I,J)= 0
530 CONTINUE
Q(S1,S2)= 1
IF(K3.EQ.0) GO TO 620
DO 610 I= 1,K3
CALL QUAD
Q(R1,R2)= 2
K(I,1)= R1
K(I,2)= R2
K(I,3)= 200
610 CONTINUE
620 IF(B3.EQ.0) GO TO 650
CALL QUAD
Q(R1,R2)= 4
650 DO 680 I= 1,S3
CALL QUAD
Q(R1,R2)= 3
680 CONTINUE
COMMENT
COMMENT SHORT RANGE SCAN
COMMENT
690 CALL SHORT
COMMENT
700 TYPE 9002
9002 FORMAT(1H ,'COMMAND: ',$)
ACCEPT 8000,A
8000 FORMAT(I)
IF(A.LT.200) GO TO 710
CALL CHEAT
GO TO 700
710 R1= A + 1
IF(R1.LT.1.OR.R1.GT.7) GO TO 790
IF(D(R1).GE.0) GO TO 780
DO 720 I= 1,6
IF(D(I).GE.0) GO TO 720
TYPE 9003, (ZSTR(J,I), J=1,2)
9003 FORMAT(1H ,2A5,' NOT OPERATIONAL')
720 CONTINUE
GO TO 700
COMMENT
780 GO TO (890, 1520, 1640, 1800, 2200, 3010, 3550), R1
COMMENT
790 TYPE 9004
9004 FORMAT(1H0,'0 = SET COURSE',T22,'4 3 2'/
1 ' 1 = LONG RANGE SCAN',T23,'^ /'/
2 ' 2 = PHASER CTRL',T24,'\ /'/
3 ' 3 = TORPEDO CTRL',T21,'5---*---1'/
4 ' 4 = SHIELDS',T24,'/ \'/
5 ' 5 = LIBRARY COMPUTER', T23,'/ \'/
6 ' 6 = RESIGNATION',T22,'6 7 8'/1H )
GO TO 700
COMMENT
COMMENT SET COURSE AND GO
COMMENT
890 TYPE 9005
9005 FORMAT(1H ,'COURSE (1-8.9999): ',$)
ACCEPT 8001, C1
8001 FORMAT(F)
IF(C1.LT.1.0.OR.C1.GT.8.9999) GO TO 700
920 TYPE 9006
9006 FORMAT(1H ,'WARP FACTOR (0-8): ',$)
ACCEPT 8001, W1
IF(W1.LE.0.0.OR.W1.GT.8.0) GO TO 700
IF(D(1).GE.0.OR.W1.LE.0.5) GO TO 980
TYPE 9007
9007 FORMAT(1H ,'ENGINES ARE DAMAGED, MAXIMUM SPEED = WARP 0.5')
GO TO 920
COMMENT
980 IF(E-(W1*8).GT.0) GO TO 1030
IF(S.LT.1) GO TO 2470
TYPE 9008, E, S
9008 FORMAT(1H ,'YOU HAVE ONLY',I5,' UNITS. SUGGEST YOU'
1 'CROSS-CIRCUIT FROM SHIELDS WHICH HAVE',I5,' UNITS')
GO TO 700
COMMENT REPAIRS
1030 DO 1060 I= 1,6
IF(D(I).GE.0) GO TO 1060
D(I)= D(I) + 1
1060 CONTINUE
COMMENT RANDOM DAMAGE
IF(FNA(10).NE.5.OR.W1.LT.2.0) GO TO 1120
R1= FNA(6)
D(R1)= D(R1) - FNA(5)
TYPE 9009 , (ZSTR(J,R1), J=1,2)
9009 FORMAT(1HO,'DAMAGE CTRL REPORTS ',2A5,' DAMAGED')
COMMENT
1120 N= INT(W1*8.0)
Q(S1,S2)= 0
XX= S1
YY= S2
C2= INT(C1)
X1= C(C2,1) + (C(C2+1,1) - C(C2,1)) * (C1-C2)
X2= C(C2,2) + (C(C2+1,2) - C(C2,2)) * (C1-C2)
DO 1270 I= 1,N
S1= S1 + X1
S2= S2 + X2
IF(S1.LT.1.OR.S1.GT.8.OR.S2.LT.1.OR.S2.GT.8) GO TO 1360
IF(Q(S1,S2).EQ.0) GO TO 1270
S1= S1 - X1
S2= S2 - X2
GO TO 1280
1270 CONTINUE
1280 Q(S1,S2)= 1
E= E - N
COMMENT LESS THAN 1 QUADRANT
IF(W1.LT.1.0) GO TO 690
COMMENT IF TIME UP -- STOP
T= T + 1
IF(T.GT.T0+30) GO TO 2500
GO TO 690
COMMENT MORE THAN 1 QUADRANT
1360 XX= Q1*8 + XX + X1*N
YY= Q2*8 + YY + X2*N
Q1= XX/8
Q2= YY/8
S1= INT(XX - Q1*8 + 0.5)
S2= INT(YY - Q2*8 + 0.5)
IF(S1.GT.0) GO TO 1450
Q1= Q1 - 1
S1= 8
1450 IF(S2.GT.0) GO TO 1480
Q2= Q2 - 1
S2= 8
1480 T= T + 1
E= E - (N + 5)
IF(T.GT.T0+30) GO TO 2500
COMMENT SET UP NEW QUADRANT
GO TO 360
COMMENT
COMMENT LONG RANGE SCAN
COMMENT
1520 TYPE 9010
9010 FORMAT(1H0,17(1H-))
DO 1610 I= Q1-1, Q1+1
DO 1540 NN= 1,3
NQ(NN)= 0
1540 CONTINUE
DO 1580 J= Q2-1, Q2+1
IF(I.LT.1.OR.I.GT.8.OR.J.LT.1.OR.J.GT.8) GO TO 1580
NQ(J-Q2+2)= G(I,J)
1580 CONTINUE
TYPE 9011, (NQ(NN), NN=1,3)
9011 FORMAT(3H : , 3(I3,3H : ))
TYPE 9010
1610 CONTINUE
GO TO 700
COMMENT
COMMENT PHASERS
COMMENT
1640 IF(K3.GT.0) GO TO 1650
2350 TYPE 9012
9012 FORMAT(1H ,'SHORT RANGE SENSORS REPORT NO KLINGONS'/
1 'IN THIS QUADRANT')
GO TO 700
1650 TYPE 9013, E
9013 FORMAT(1H ,'ENERGY AVAILABLE = ',I6/
1 1H 'NUMBER OF UNITS TO FIRE: ',$)
ACCEPT 8000, XP
IF(XP.LT.1) GO TO 700
IF(E-XP.LT.0) GO TO 1650
E= E-XP
DO 1780 I= 1,3
IF(K(I,3).EQ.0) GO TO 1780
H= XP/K3/FND(0)
K(I,3)= K(I,3) - H
TYPE 9014, H
9014 FORMAT(I6,' UNIT HIT ON KLINGON')
IF(K(I,3).GT.0) GO TO 1780
CALL KDEAD(I)
1780 CONTINUE
COMMENT
CALL KFIRE
GO TO 700
COMMENT
COMMENT PHOTON TORPEDOES
COMMENT
1800 IF(P.GT.0) GO TO 1830
TYPE 9015
9015 FORMAT(1H ,'ALL PHOTON TORPEDOES EXPENDED')
GO TO 700
1830 TYPE 9016
9016 FORMAT(1H ,'TORPEDO COURSE (1-8.9999): ',$)
ACCEPT 8001, C1
IF(C1.LT.1.0.OR.C1.GT.8.9999) GO TO 700
C2= INT(C1)
X1= C(C2,1) + (C(C2+1,1) - C(C2,1)) * (C1-C2)
X2= C(C2,2) + (C(C2+1,2) - C(C2,2)) * (C1-C2)
XX= S1
YY= S2
P= P - 1
1930 XX= XX + X1
YY= YY + X2
IF(XX.LT.1.OR.XX.GT.8.OR.YY.LT.1.OR.YY.GT.8) GO TO 2180
IF(Q(XX,YY).EQ.0.AND.Q(XX+1,YY+1).EQ.0) GO TO 1930
DO 2000 I= 1,3
IF(XX.EQ.K(I,1).AND.YY.EQ.K(I,2)) GO TO 2020
IF(XX+1.EQ.K(I,1).AND.YY+1.EQ.K(I,2)) GO TO 2020
IF(XX-1.EQ.K(I,1).AND.YY-1.EQ.K(I,2)) GO TO 2020
2000 CONTINUE
GO TO 2120
COMMENT
2020 CALL KDEAD(I)
COMMENT
CALL KFIRE
GO TO 700
COMMENT
2120 IF(Q(XX,YY).NE.3) GO TO 2150
TYPE 9017
9017 FORMAT(1H ,'YOU CAN''T DESTROY STARS, SILLY')
GO TO 2180
2150 IF(Q(XX,YY).NE.4) GO TO 2180
TYPE 9018
9018 FORMAT(1H ,'***STARBASE DESTROYED***'/
1 ' YOU ARE HEREBY RELIEVED OF DUTY. GOOD-BYE***')
STOP
COMMENT
2180 TYPE 9019
9019 FORMAT(1H ,'TORPEDO MISSED')
CALL KFIRE
GO TO 700
COMMENT
COMMENT SHIELDS - ENERGY INTERCHANGE
COMMENT
2200 TYPE 9020, E, S
9020 FORMAT(1H0,'ENERGY AVAILABLE = ',I6/
1 ' AND IN SHIELDS = ',I6/
2 ' WHICH WAY TO TRANSFER--'/
3 ' 1. ENERGY TO SHIELDS'/
4 ' 2. SHIELDS TO ENERGY')
ACCEPT 8000, ES
IF(ES.LT.1.OR.ES.GT.2) GO TO 700
2210 TYPE 9021
9021 FORMAT(1H ,'NUMBER OF UNITS TO TRANSFER: ',$)
ACCEPT 8000, EX
IF(EX.LT.0) GO TO 700
IF(E+S-EX.LT.0) GO TO 2210
GO TO (2220, 2240), ES
COMMENT ENERGY TO SHIELDS
2220 E= E - EX
S= S + EX
GO TO 700
COMMENT SHIELDS TO ENERGY
2240 E= E + EX
S= S - EX
GO TO 700
COMMENT
COMMENT LIBRARY COMPUTER
COMMENT
3010 TYPE 9022
9022 FORMAT(1H0,'COMPUTER ACTIVE AND AWAITING COMMAND')
ACCEPT 8000, A
IF(A.GE.0.AND.A.LT.3) GO TO 3030
TYPE 9023
9023 FORMAT(1H ,'FUNCTIONS AVAILABLE FROM COMPUTER'/
1 1H ,' 0 = DAMAGE REPORT'/
2 1H ,' 1 = PHOTON TORPEDO DATA'/
3 1H ,' 2 = SHORT RANGE SCAN')
GO TO 3010
COMMENT
3030 GO TO (2280, 3100, 3310), A+1
COMMENT
COMMENT DAMAGE REPORT
COMMENT
2280 TYPE 9024
9024 FORMAT(1H0,'DEVICE',6X,'STATE OF REPAIR')
DO 2300 I= 1,6
TYPE 9025, (ZSTR(J,I), J=1,2), D(I)
9025 FORMAT(1H ,2A5,8X,I3)
2300 CONTINUE
GO TO 700
COMMENT
COMMENT TORPEDO DATA
COMMENT
3100 DO 3200 I= 1,3
IF(K(I,3).LE.0) GO TO 3200
XX= K(I,2) - S2
YY= S1- K(I,1)
IF(XX.EQ.0) GO TO 3240
A= INT(((57.3*ATAN(FLOAT(YY/XX)))/45 + 1) * 100)/100
IF(XX.GT.0.AND.YY.LT.0) GO TO 3290
IF(XX.LT.0) GO TO 3220
3190 TYPE 9026, A
9026 FORMAT(1H ,'DIRECTION = ',I4)
GO TO 3200
COMMENT
3220 A= A + 4
GO TO 3190
3240 IF(YY.LT.0) GO TO 3270
A = 3
GO TO 3190
3270 A = 7
GO TO 3190
3290 A = A + 8
GO TO 3190
COMMENT
3200 CONTINUE
GO TO 700
COMMENT
COMMENT SHORT RANGE SCAN
COMMENT
3310 CALL SHORT
GO TO 700
COMMENT
COMMENT RESIGINATION AND END
COMMENT
3550 TYPE 9027
9027 FORMAT(1H0,'YOUR RESIGNATION HAS BEEN ACCEPTED')
STOP
2500 TYPE 9028, T
9028 FORMAT(1H0,'IT IS STARDATE = ',I5)
STOP
2470 TYPE 9029
9029 FORMAT(1HO,'THE ENTERPRISE IS DEAD IN SPACE.'
1 ' IT MUST BE EVACUATED.'/' THE FEDERATION WILL BE CONQUERED**')
STOP
COMMENT
COMMENT INSTRUCTIONS
COMMENT
3570 TYPE 9030
9030 FORMAT(1H0,'DO YOU NEED INSTRUCTIONS\ Y OR N ',$)
ACCEPT 8002, A
8002 FORMAT(A1)
IF(A.NE.'Y') GO TO 440
TYPE 9031
9031 FORMAT(1H ,'THIS PART IS NOT WRITTEN YET')
GO TO 440
END
SUBROUTINE QUAD
COMMENT
IMPLICIT INTEGER (A-Z)
REAL X, C1, W1, RAN
COMMENT
COMMON G(8,8), Q(8,8), K(3,3), C(9,2),
1 ZSTR(2,6), D(6), NQ(3), CSTR(2),
2 QSTR(5), QOUT(8),
3 Q1, Q2, S1, S2, R1, R2,
4 K9, K3, E , S , P , T,
5 NR
COMMENT
COMMENT
FNA(IR)= INT(IR * RAN(NR) + 1)
COMMENT
3510 R1= FNA(8)
R2= FNA(8)
IF(Q(R1,R2).NE.0) GO TO 3510
RETURN
END
SUBROUTINE SHORT
COMMENT SHORT RANGE SCAN
COMMENT
IMPLICIT INTEGER (A-Z)
REAL X, C1, W1, RAN
COMMENT
COMMON G(8,8), Q(8,8), K(3,3), C(9,2),
1 ZSTR(2,6), D(6), NQ(3), CSTR(2),
2 QSTR(5), QOUT(8),
3 Q1, Q2, S1, S2, R1, R2,
4 K9, K3, E , S , P , T,
5 NR
COMMENT
DO 2650 I= S1-1, S1+1
DO 2640 J= S2-1, S2+1
IF(I.LT.1.OR.I.GT.8.OR.J.LT.1.OR.J.GT.8) GO TO 2640
IF(Q(I,J).EQ.4) GO TO 2670
2640 CONTINUE
2650 CONTINUE
GO TO 2730
COMMENT
2670 CSTR(1)= 'DOCKE'
CSTR(2)= 'D '
E= 4000
P= 15
DO 2700 I= 1,6
D(I)= 0
2700 CONTINUE
S= 3000
GO TO 2810
COMMENT
2730 TYPE 9000
9000 FORMAT(1H )
IF(K3.GT.0) GO TO 2780
IF(E.LT.300) GO TO 2800
CSTR(1)= 'GREEN'
CSTR(2)= ' '
GO TO 2810
2780 CSTR(1)= '*RED*'
CSTR(2)= ' '
GO TO 2810
2800 CSTR(1)= 'YELLO'
CSTR(2)= 'W '
COMMENT
2810 TYPE 9001
9001 FORMAT(1H ,24(1H-))
Z= 1
CALL QSET (Z)
TYPE 9002, (QOUT(I), I=1,8), T
9002 FORMAT(8A3,5X,8HSTARDATE,5X,I4)
Z=2
CALL QSET (Z)
TYPE 9003, (QOUT(I), I=1,8), CSTR
9003 FORMAT(8A3,5X,9HCONDITION,4X,2A5)
Z= 3
CALL QSET (Z)
TYPE 9004, (QOUT(I), I=1,8), Q1, Q2
9004 FORMAT(8A3,5X,8HQUADRANT,5X,I1,1H-,I1)
Z= 4
CALL QSET (Z)
TYPE 9005, (QOUT(I), I=1,8), S1, S2
9005 FORMAT(8A3,5X,6HSECTOR,7X,I1,1H-,I1)
Z= 5
CALL QSET (Z)
TYPE 9006, (QOUT(I), I=1,8), E
9006 FORMAT(8A3,5X,6HENERGY,7X,I4)
Z= 6
CALL QSET (Z)
TYPE 9007, (QOUT(I), I=1,8), P
9007 FORMAT(8A3,5X,9HTORPEDOES,4X,I4)
Z= 7
CALL QSET (Z)
TYPE 9008, (QOUT(I), I=1,8), S
9008 FORMAT(8A3,5X,7HSHIELDS,6X,I4)
Z= 8
CALL QSET (Z)
TYPE 9009, (QOUT(I), I=1,8), K9
9009 FORMAT(8A3,5X,8HKLINGONS, 5X,I4)
TYPE 9001
RETURN
END
SUBROUTINE QSET (Z)
COMMENT
IMPLICIT INTEGER (A-Z)
REAL X, C1, W1, RAN
COMMENT
COMMON G(8,8), Q(8,8), K(3,3), C(9,2),
1 ZSTR(2,6), D(6), NQ(3), CSTR(2),
2 QSTR(5), QOUT(8),
3 Q1, Q2, S1, S2, R1, R2,
4 K9, K3, E , S , P , T,
5 NR
COMMENT
DO 100 I= 1,8
J= Q(Z,I) + 1
QOUT(I)= QSTR(J)
100 CONTINUE
RETURN
END
SUBROUTINE CHEAT
COMMENT
COMMENT PUTS OUT GALAXY WITH BASES AND KLINGONS
COMMENT
IMPLICIT INTEGER (A-Z)
REAL X, C1, W1, RAN
COMMENT
COMMON G(8,8), Q(8,8), K(3,3), C(9,2),
1 ZSTR(2,6), D(6), NQ(3), CSTR(2),
2 QSTR(5), QOUT(8),
3 Q1, Q2, S1, S2, R1, R2,
4 K9, K3, E , S , P , T,
5 NR
COMMENT
DO 100 I= 1,8
TYPE 9000, (G(I,J),J=1,8)
100 CONTINUE
9000 FORMAT(1H ,40(1H-)/40 I5)
TYPE 9001
9001 FORMAT(1H ,40(1H-)/1H )
RETURN
END
SUBROUTINE KDEAD (I)
COMMENT
IMPLICIT INTEGER (A-Z)
REAL X, C1, W1, RAN
COMMENT
COMMON G(8,8), Q(8,8), K(3,3), C(9,2),
1 ZSTR(2,6), D(6), NQ(3), CSTR(2),
2 QSTR(5), QOUT(8),
3 Q1, Q2, S1, S2, R1, R2,
4 K9, K3, E , S , P , T,
5 NR
COMMENT
K(I,3)= 0
I1= K(I,1)
I2= K(I,2)
Q(I1,I2)= 0
TYPE 9000
9000 FORMAT(1H0,'***KLINGON DESTROYED***')
K3= K3 - 1
K9= K9 - 1
IF(K9.EQ.0) GO TO 2550
G(Q1,Q2)= G(Q1,Q2) - 100
RETURN
COMMENT END OF GAME---ALL KLINGONS GONE
2550 TYPE 9001
9001 FORMAT(1H0,'THE LAST KLINGON BATTLE CRUSIER DESTROYED.'/
1 ' THE FEDERATION HAS BEEN SAVED*** CONGRATULATIONS***')
STOP
END
SUBROUTINE KFIRE
COMMENT
IMPLICIT INTEGER (A-Z)
REAL X, C1, W1, RAN
COMMENT
COMMON G(8,8), Q(8,8), K(3,3), C(9,2),
1 ZSTR(2,6), D(6), NQ(3), CSTR(2),
2 QSTR(5), QOUT(8),
3 Q1, Q2, S1, S2, R1, R2,
4 K9, K3, E , S , P , T,
5 NR
COMMENT
FND(DK)= SQRT(FLOAT((K(I,1)-S1)**2 + (K(I,2)-S2)**2))
COMMENT
IF(CSTR(1).EQ.'DOCKE') GO TO 2460
IF(K3.EQ.0) GO TO 2460
DO 2450 I= 1,3
IF(K(I,3).EQ.0) GO TO 2450
H= K(I,3)/FND(0) + 1
S= S -H
TYPE 9000, H
9000 FORMAT(I5,' UNIT HIT ON ENTERPRISE')
IF(S.LT.0) GO TO 2520
2450 CONTINUE
2460 RETURN
COMMENT ENTERPRISE DESTROYED----STOP
2520 TYPE 9001
9001 FORMAT(1H0,'***THE ENTERPRISE HAS BEEN DESTROYED***'/
1 ' THE FEDERATION WILL BE CONQUERED***')
STOP
END