forked from DigitalMars/Empire-for-PDP-10
-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy path5.FOR
230 lines (211 loc) · 6.35 KB
/
5.FOR
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
C SUBROUTINE 5
SUBROUTINE SHIPMV (CRALOC,CRAHIT,NUM,OWN1,HITMAX)
INCLUDE 'COMMON.EMP/NOLIST'
DO 2500 Y=1,LIMIT(NUM)
DO 2499 ITURN=1,2
LOC=CRALOC+Y
Z6=S(LOC)
IF(Z6==0) GOTO 2500
JIT=CRAHIT+Y
H1=H(JIT)
IF((ITURN==2).AND.(H1<=HITMAX/2)) GOTO 2500
IF((MODE==1).AND.(POSCHK(Z6)==0.)) GOTO 2500
Z7=Z6
AB=A(1,Z6)
H1=H(JIT)
* CHECK TO SEE IF SHIP WAS DESTROYED (IF THE CITY IT WAS IN WAS CAPTURED).
IF((AB==OWN1).OR.(AB=='O')) GOTO 4000
CALL HEAD(OWN1,Y,Z6)
CALL STROUT(' DESTROYED. ',31)
GOTO 2505
4000 IF((ITURN==1).AND.(AB=='O')) H1=H1+1
IF(H1>HITMAX) H1=HITMAX
CALL STASIS(Z6,LOC)
3000 MYCOD=MYCODE(LOC)
IF(MYCOD==0) GOTO 2541
IF((MYCOD#9997).OR.((OWN1#'T').AND.(OWN1#'C'))) GOTO 3001
N=0
NT=2
IA=1
IB=LIMIT(1)
IF(OWN1#'C') GOTO 3003
NT=1
IA=501
IB=LIMIT(2)+500
3003 DO 3002 J=IA,IB
3002 IF(S(J)==Z6) N=N+1
IF(N<NT*H1) GOTO 3001
CALL CMYCOD(LOC,0)
GOTO 2541
3001 IF((MYCOD<101).OR.(MYCOD>6108)) GOTO 2545
IF(MYCOD<=6000) GOTO 2542
IF(MYCOD>6100) GOTO 2543
GOTO 2545
2542 Z6=Z6+IARROW(MOV(Z6,MYCOD))
IF(Z6==MYCOD) CALL CMYCOD(LOC,0)
GOTO 2544
2543 Z6=Z6+IARROW(MYCOD-6100)
2544 AD=A(1,Z6)
IF(((AD=='.').OR.(AD=='O')).AND.(ORDER(Z6)==0)) GOTO 2545
Z6=Z7
CALL SECTOR(2)
CALL CURSOR(100)
CALL STSOUT(MYCOD)
2541 CALL SECTOR(2)
2513 CALL LTR(Z6,ITURN)
CALL HEAD(OWN1,Y,Z6)
CALL MVE(OWN1,MDATE,LOC,JIT,Z6,Z7,DISAS,Z6-IADJST)
IF(DISAS==-2) GOTO 3000
* MOVE EVALUATION
2545 IF(D1(Z7)#'*') CALL CHANGE(Z7,D1(Z7),1)
IF(DISAS==1) GOTO 2505
AB=A(1,Z6)
IF(AB#'O') GOTO 2511
CALL CURSOR(100)
CALL STROUT('SHIP IS DOCKED. ',31)
GOTO 2512
2511 IF((AB#'+').AND.(D1(Z6)#'*')) GOTO 2506
2507 CALL CURSOR(100)
CALL IDEN(OWN1)
CALL STROUT('BROKE UP ON THE SHORE. ',31)
2505 CALL CHAS(LOC,0)
CALL CMYCOD(LOC,0)
IF(DISAS==1) CALL SENSOR(Z7)
IF(DISAS#1) CALL SENSOR(Z6)
H1=0
GOTO 2533
2506 IF(AB#'.') GOTO 2509
2510 CALL CHANGE(Z6,OWN1,1)
2512 CALL CHAS(LOC,Z6)
CALL CHITS(JIT,H1)
CALL SENSOR(Z6)
2533 IF((OWN1#'T').AND.(OWN1#'C')) GOTO 2499
N=0
IA=0; IB=LIMIT(1); NT=2
IF(OWN1#'C') GOTO 2534; IA=500; IB=LIMIT(2); NT=1
2534 DO 2535 I=IA+1,IA+IB
IF(S(I)#Z7) GOTO 2535
CALL CHAS(I,Z6)
N=N+1
IF(N<=NT*H1) GOTO 2535
CALL CHAS(I,0)
CALL CURSOR(100)
IF(OWN1=='C') GOTO 2536
CALL STROUT('ARMY #',0)
GOTO 2538
2536 CALL STROUT('FIGHTER #',0)
2538 CALL DECPRT(I-IA); CALL STROUT(' WAS SUNK. ',31)
2535 CONTINUE
GOTO 2499
2509 H2=30
OWN2=AB
CALL FIND(OWN2,Z6,Z8,H2)
CALL FGHT(Z6,H1,H2,OWN1,OWN2)
CALL FIND(OWN2,Z6,Z8,H2)
IF(H1<=0) GOTO 2505
IF((OWN2>='1').AND.(OWN2<='8')) CALL SONAR(Z6)
CALL CHANGE(Z6,D1(Z6),1)
IF(A(1,Z6)#'.') GOTO 2507
GOTO 2510
2499 CONTINUE
2500 CONTINUE
RETURN
END
SUBROUTINE FIGHMV
INCLUDE 'COMMON.EMP/NOLIST'
DO 2001 Y=1,LIMIT(2)
Z3=MOD(RANGE(Y),4)
IF(Z3==0) Z3=4
DO 2010 ITURN=1,Z3
LOC=500+Y
Z6=S(LOC)
IF(Z6==0) GOTO 2001
IF((MODE==1).AND.(POSCHK(Z6)==0.)) GOTO 2001
AB=A(1,Z6)
* NOW CHECK TO SEE IF FIGHTER IS IN A CITY; IF IT IS CHANGE THE
* STASIS # OF THE FIGHTER TO THAT SPECIFIED BY FIPATH(I)
IF(AB#'O') GOTO 2100 !IF FIGHTER NOT IN CITY
DO 2101 I=1,70
2101 IF(X(I)==Z6) GOTO 2102 !FIND CITY # OF CITY AT Z6
2102 CALL CMYCOD(LOC,FIPATH(I)) !CHANGE STASIS # OF FIGHTER
* CHECK FOR FI DESTROYED ALONG WITH CARRIER
2100 IF((AB=='C').OR.(AB=='F').OR.(AB=='O')) GOTO 2018
CALL CURSOR(100)
CALL STROUT('FIGHTER #',0); CALL DECPRT(Y)
CALL STROUT(' DESTROYED. ',31)
GOTO 2009
2018 Z7=Z6
CALL STASIS(Z6,LOC)
3000 IF(RANGE(Y)==0) GOTO 2048
MYCOD=MYCODE(LOC)
IF(MYCOD==0) GOTO 2540
IF((MYCOD<101).OR.(MYCOD>6108)) GOTO 2041
IF(MYCOD<=6000) GOTO 2042
IF(MYCOD>6100) GOTO 2043
GOTO 2041
2042 Z6=Z6+IARROW(MOV(Z6,MYCOD))
IF(Z6==MYCOD) CALL CMYCOD(LOC,0) !F HAS ARRIVED AT STASIS #
GOTO 2045
2043 Z6=Z6+IARROW(MYCOD-6100)
2045 AD=A(1,Z6)
IF(ORDER(Z6)#0) GOTO 2046
IF(RANGE(Y)==10) GOTO 2046
IF((AD=='C').OR.(AD=='O')) GOTO 2041
IF((AD=='+').OR.(AD=='.')) GOTO 2041
2046 Z6=Z7
CALL SECTOR(2)
CALL STSOUT(MYCOD)
2540 CALL SECTOR(2)
CALL LTR(Z6,ITURN)
2048 CALL HEAD('F',Y,Z6)
CALL CURSOR(40)
CALL STROUT('RANGE:',0)
CALL DECPRT(RANGE(Y))
CALL SPACE
IF(RANGE(Y)>0) GOTO 2011
CALL CURSOR(100)
CALL STROUT('RAN OUT OF FUEL AND CRASHED. ',31)
IF((AB#'C').AND.(D1(Z6)#'*')) CALL CHANGE(Z6,D1(Z6),1)
GOTO 2009
2011 CALL MVE('F',MDATE,LOC,1,Z6,Z7,DISAS,Z6-IADJST)
IF(DISAS==-2) GOTO 3000
* MOVE EVALUATION
2041 AC=A(1,Z6)
RANGE(Y)=RANGE(Y)-1
IF((AC=='O').OR.(AC=='C')) RANGE(Y)=20
IF(Z7==Z6) GOTO 2020
IF((AB#'C').AND.(D1(Z7)#'*')) CALL CHANGE(Z7,D1(Z7),1)
IF(AC=='C') GOTO 2014
IF(DISAS==1) GOTO 2009
IF((AC#'.').AND.(AC#'+'))GOTO2004
CALL CHAS(LOC,Z6)
CALL CHANGE(Z6,'F',1)
GOTO 2010
2004 IF(D1(Z6)#'*') GOTO 2005
IF(AC#'O') GOTO 2006
2014 CALL CURSOR(100)
IF(MYCODE(LOC)==0) CALL STROUT('LANDING CONFIRMED. ',31)
CALL CHAS(LOC,Z6)
GOTO2020
2006 CALL CURSOR(100)
CALL STROUT('FIGHTER SHOT DOWN. ',31)
2009 CALL CHAS(LOC,0)
GOTO2020
2005 H1=1
OWN1='F'
OWN2=AC
H2=30
CALL FIND(OWN2,Z6,Z8,H2)
CALL FGHT(Z6,H1,H2,OWN1,OWN2)
CALL FIND(OWN2,Z6,Z8,H2)
IF(H1<=0)GOTO2009
CALL CHAS(LOC,Z6)
CALL CHANGE(Z6,'F',1)
IF((OWN2>='1').AND.(OWN2<='8')) CALL SONAR(Z6)
2010 CALL SENSOR(Z6)
2020 IF(DISAS#1) CALL SENSOR(Z6)
IF(DISAS==1) CALL SENSOR(Z7)
2001 CONTINUE
RETURN
END
.