├── 1.FOR ├── 10.FOR ├── 11.FOR ├── 12.FOR ├── 13.FOR ├── 14.FOR ├── 15.FOR ├── 16.FOR ├── 17.FOR ├── 18.FOR ├── 2.FOR ├── 3.FOR ├── 4.FOR ├── 5.FOR ├── 6.FOR ├── 7.FOR ├── 8.FOR ├── 9.FOR ├── COMMON.EMP ├── CURSOR.MAC ├── EMPIRE.FOR ├── EMPIRE.HLP ├── HELP.MAC ├── MUNCH.MAC ├── PACK.MAC ├── PATH.FOR ├── PATH.MAC ├── READ.ME ├── README.md ├── SUBS.MAC └── copyright /1.FOR: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | C SUBROUTINE COLLECTION 1 6 | SUBROUTINE STASIS(Z6,LOC) 7 | INTEGER Z6 8 | COMMON /IARROW/IARROW(0:9) 9 | DO 100 I=1,8 10 | BLAH=A(1,Z6+IARROW(I)) 11 | 100 IF((BLAH>='1').AND.(BLAH<='8')) CALL CMYCOD(LOC,0) 12 | RETURN 13 | END 14 | 15 | SUBROUTINE PROD(HITS,Z6,LIMIT,CRAHIT,CRALOC, 16 | &LOPMAX,AR2S,J,RANGE) 17 | IMPLICIT INTEGER(A-Z) 18 | DIMENSION RANGE(501:700),AR2S(1501:2000) 19 | COMMON/MODE/MODE,KURSOR,JECTOR,ISEC 20 | COMMON /CODE/CODE(1501:3000) 21 | COMMON/IARROW/IARROW(0:9) 22 | 23 | D TYPE 101,CRALOC,LOPMAX 24 | D 101 FORMAT(' CRALOC,LOPMAX:',2G) 25 | DO 100 I=CRALOC+1,LOPMAX+CRALOC 26 | IF(S(I)#0) GOTO 100 27 | IF(I>LIMIT+CRALOC) LIMIT=I-CRALOC 28 | CALL CHAS(I,Z6) 29 | IF(HITS>1) CALL CHITS(CRAHIT+I-CRALOC,HITS) 30 | IF(J>1) CALL CMYCOD(I,0) 31 | IF(J<2) CODE(I)=0 32 | IF(J==1) AR2S(I)=0 33 | IF(CRALOC==2000) RANGE(I-1500)=20 34 | IF(J==3) RANGE(I)=20 35 | GOTO(1,2,3,4,5,6,7,8,9) J 36 | 1 RETURN 37 | 2 CALL STROUT('N ARMY',51) 38 | RETURN 39 | 3 CALL STROUT(' FIGHTER',51) 40 | RETURN 41 | 4 CALL STROUT(' DESTROYER',51) 42 | RETURN 43 | 5 CALL STROUT(' SUBMARINE',51) 44 | RETURN 45 | 6 CALL STROUT(' TROOP TRANSPORT',51) 46 | RETURN 47 | 7 CALL STROUT(' CRUISER',51) 48 | RETURN 49 | 8 CALL STROUT(' AIRCRAFT CARRIER',51) 50 | RETURN 51 | 9 CALL STROUT(' BATTLESHIP',51) 52 | RETURN 53 | 100 CONTINUE 54 | 200 RETURN 55 | END 56 | 57 | SUBROUTINE FIGHTR 58 | INCLUDE 'COMMON.EMP/NOLIST' 59 | 60 | C IFO=7: CITY LOCATION 61 | C IFO=6: CARRIER # 62 | C IFO=5: TARGET LOCATION 63 | C IFO=4: TARGET LOCATION, KAMIKAZE MISSION 64 | C IFO=3: DIRECTIONAL 65 | C IFO=2: DIRECTIONAL, KAMIKAZE MISSION 66 | MONKEY=0 67 | NUMBER(2)=0 68 | IF(CODER==2.) TYPE 100 69 | 100 FORMAT(' FIGHTER CODES') 70 | DO 1000 Y=1,LIMIT(10) 71 | DO 1001 I1=1,Z3 72 | Z6=S(2000+Y) 73 | IF(Z6==0) GOTO 1000 74 | DIR MONKEY=Y 75 | P=0. 76 | Z7=Z6 77 | AB=A(1,Z6) 78 | DO 2000 IA=1,6 79 | DO 2000 IB=1,5 80 | 2000 IF(TROOPT(IA,IB)==Z6) TROOPT(IA,IB)=0 81 | IF((AB#'2').AND.(AB#'X').AND.(AB#'7')) GOTO 500 82 | IF((AB=='X').OR.(AB=='7')) RANG(Y)=Z3*5 83 | IF(RANG(Y)#0) GOTO 499 84 | CALL CHANGE(Z6,D1(Z6),1) 85 | GOTO 500 86 | 87 | C MOVE SELECTION 88 | 499 IF(ILATT(CODE(Y+500))==Z6) GOTO 201 89 | IFO=IFORM(CODE(Y+500)) 90 | ILA=ILATT(CODE(Y+500)) 91 | 92 | * DOES A NEW CODE NEED TO BE SELECTED? 201:YES, 300:NO 93 | GOTO (201,2,3,4,5,6,7) IFO 94 | GOTO 201 95 | 96 | 2 IF(RAN(C1)<.05) ILA=ICORR(ILA+1) 97 | IF(RANG(Y)>=10) GOTO 300 98 | DO 21 I=1,70 99 | 21 IF((X(I)#0).AND.(IDIST(Z6,X(I))<=RANG(Y))) GOTO 22 100 | GOTO 300 101 | 22 IFO=7 102 | ILA=X(I) 103 | GOTO 300 104 | 105 | 3 IF(RAN(C1)<.1) ILA=ICORR(ILA+1) 106 | IF(RANG(Y)<=11) 201,300 107 | 108 | 4 IF(ILA==Z6) 201, 300 109 | 110 | 5 IF((ILA==Z6).OR.(RANG(Y)<=11)) 201, 300 111 | 112 | 6 IF(Z6==S(ILA+2800)) GOTO 201 !IF LANDED 113 | IF(S(ILA+2800)==0) GOTO 201 !IF CARRIER DOESN'T EXIST 114 | IF(IDIST(Z6,S(ILA+2800))>RANG(Y)) 201, 300 !IF OUT OF RANG 115 | 116 | 7 IF(Z6==ILA) GOTO 201 !IF LANDED 117 | IF(IDIST(Z6,ILA)>RANG(Y)) 201, 300 !IF OUT OF RANG 118 | 119 | * NEW CODE SELECTION 120 | 201 ID=0 121 | IF(AB=='2') GOTO 253 !IF FIGHTER IS AIRBORNE 122 | ID=0 123 | GOTO 700 !FIRST OF ALL, LOOK FOR TROOP TRANSPORTS & SUBS 124 | 702 FUEL=RANG(Y) !NO CHOICE BUT BE KAMIKAZE 125 | GOTO 703 !START LOOKING FOR ENEMY TROOP TRANS. 126 | 700 FUEL=RANG(Y)/2 !DO THIS SO CRAFT CAN RETURN TO REFUEL 127 | IF(RAN(C1)<.05) FUEL=RANG(Y) !1 IN 20 IS KAMIKAZE 128 | 703 ISHIPT=3 !ENEMY TROOP TRANSPORTS 129 | *................................. 130 | * LOOK FOR ENEMY TROOP TRANSPORTS, THEN SUBMARINES 131 | 706 DO 704 I=1,5 132 | IF(TROOPT(ISHIPT,I)==0) GOTO 704 133 | IF(IDIST(Z6,TROOPT(ISHIPT,I))>FUEL) GOTO 704 !OUT OF RANG 134 | IFO=5 135 | IF(FUEL==RANG(Y)) IFO=4 136 | ILA=TROOPT(ISHIPT,I) 137 | GOTO 300 !PROCEED TO MOVE CORRECTION 138 | 704 CONTINUE 139 | IF(ISHIPT==2) GOTO 900 !IF ALREADY LOOKED FOR SUBS 140 | ISHIPT=2; GOTO 706 !NOW LOOK FOR SUBS 141 | 900 IF(ID==1000) GOTO 707 !IF NO REFUELING SPOT WITHIN RANG 142 | IF(RAN(C1)<.33) GOTO 707 !LOOK FOR ENEMY CONCENTRATIONS 143 | IF(RAN(C1)<.5) GOTO 253 !MOVE TOWARDS CITY OR CARRIER 144 | *..................................... 145 | * MOVE IN A RANDOM DIRECTION 146 | 701 IFO=3 147 | DIR=ICORR(DIR+1) 148 | ILA=DIR 149 | IF(RAN(C1)<.1) IFO=2 !ONE OUT OF 20 WILL BE KAMIKAZE 150 | IF(NUM2<=2) IFO=3 151 | GOTO 300 !PROCEED TO MOVE CORRECTION 152 | *......................................... 153 | * MOVE TOWARD AN ENEMY CONCENTRATION WITHIN RANG 154 | 707 DO 705 I=1,10 155 | DO 705 J=2,11 156 | IF(LOCI(I,J)==0) GOTO 705 157 | IF(IDIST(Z6,LOCI(I,J))>FUEL) GOTO 705 !IF OUT OF RANG 158 | IFO=5 159 | IF(FUEL==RANG(Y)) IFO=4 !KAMIKAZE 160 | ILA=LOCI(I,J) 161 | GOTO 300 !PROCEED TO MOVE CORRECTION 162 | 705 CONTINUE 163 | IF(ID==1000) GOTO 701 !IF NO CITY OR CARRIER IS WITHIN RANG 164 | *.................................. 165 | * NOW MOVE TOWARDS A CITY CLOSEST TO ENEMY CONCENTRATION 166 | 253 IA=MOD(Y,10)+1 167 | DO 254 IB=IA,IA+9 168 | I=IB 169 | IF(I>10) I=I-10 170 | IF(LOCI(I,2)==0) GOTO 254 171 | LOC=LOCI(I,2) 172 | ID=IDIST(Z6,LOCI(I,2)) 173 | GOTO 800 174 | 254 CONTINUE 175 | LOC=EXPL(DUMMY) 176 | 800 ID=1000 177 | IGARBG=INT(RAN(C1)*FLOAT(70+LIMIT(15))+1.) 178 | DO 255 ILOOP=IGARBG,IGARBG+70+LIMIT(15) 179 | IA=ILOOP 180 | IF(IA>70+LIMIT(15)) IA=IA-70-LIMIT(15) 181 | IF(IA>70) GOTO 256 182 | IF((OWNER(IA)#2).OR.(IDIST(Z6,X(IA))>RANG(Y))) GOTO 255 183 | IF(IDIST(X(IA),LOC)>=ID) GOTO 255 184 | IFO=7 185 | ILA=X(IA) 186 | ID=IDIST(X(IA),LOC) 187 | GOTO 255 188 | 256 IB=IA-70 189 | IF(S(2800+IB)==0) GOTO 255 190 | IF(IDIST(Z6,S(2800+IB))>RANG(Y)) GOTO 255 191 | IF(IDIST(S(2800+IB),LOC)>=ID) GOTO 255 192 | IF((RANG(Y)==20).AND.(IDIST(Z6,S(2800+IB))>12) 193 | &.AND.(MOD(IFORM(CODE(1300+IB)),10)#9)) GOTO 255 194 | IFO=6 195 | ILA=IB 196 | ID=IDIST(S(2800+IB),LOC) 197 | 255 CONTINUE 198 | IF(ID==1000) GOTO 702 199 | GOTO 300 200 | *.................................. 201 | * MOVE CORRECTION 202 | 300 IZOT=0 203 | MOOV=0 204 | IF(ILA>100) IZOT=MOV(Z6,ILA) 205 | IF(ILA<10) IZOT=ILA 206 | IF(IFO==6) IZOT=MOV(Z6,S(2800+ILA)) 207 | IF((IFO<4).AND.(RAN(C1)<.05)) IZOT=ICORR(IZOT+1) 208 | DO 301 I=1,8 209 | AC=A(1,Z6+IARROW(I)) 210 | IF((AC#'D').AND.(AC#'S').AND.(AC#'T') 211 | &.AND.(AC#'F').AND.(AC#'A')) GOTO 301 212 | MOOV=I 213 | GOTO 400 214 | 301 CONTINUE 215 | 216 | ** LOOK FOR TERRITORY TO EXPLOR IN FRONT 217 | IF (RANG(Y)<=10) GOTO 303 !IF LOW ON FUEL 218 | IZOT2=IZOT !STORE IZOT A MOMENT 219 | Z62=Z6+IARROW(ICORR(IZOT2+1)) 220 | IF(ORDER(Z62)#0) GOTO 304 !IF ON THE EDGE OF THE MAP 221 | IF(A(0,Z62)==' ') IZOT=ICORR(IZOT2+1) !IF Z62 IS UNEXPLORED 222 | 304 Z62=Z6+IARROW(ICORR(IZOT2-1)) !TRY OTHER SIDE 223 | IF(ORDER(Z62)#0) GOTO 303 !IF ON THE EDGE OF THE MAP 224 | IF(A(0,Z62)==' ') IZOT=ICORR(IZOT2-1) !IF Z62 IS UNEXPLORED 225 | 226 | 303 DESTIN=ILA 227 | IF(IFO==6) DESTIN=S(2800+ILA) 228 | ID=IZOT 229 | DO 302 I=0,7 230 | IZOT=ICORR(ID+I) 231 | NEWLOC=Z6+IARROW(IZOT) 232 | IF((IFO>3).AND.(IDIST(Z6,DESTIN)<=IDIST(NEWLOC,DESTIN))) 233 | & GOTO 302 234 | AC=A(1,NEWLOC) 235 | IF((((AC>='A').AND.(AC<='T')).OR.(AC=='X').OR.(AC=='.').OR. 236 | &(AC=='7').OR.(AC=='+')).AND.(ORDER(NEWLOC)==0))GOTO400 237 | 302 CONTINUE 238 | IZOT=0 239 | 400 CODE(500+Y)=10000*IFO+ILA 240 | IF(IFO<4) CODE(500+Y)=10000*IFO+IZOT 241 | IB=CODE(500+Y) 242 | IF(CODER==2.) TYPE 101,IB 243 | 101 FORMAT(G) 244 | IF(MOOV#0) IZOT=MOOV 245 | Z6=Z6+IARROW(IZOT) 246 | 247 | C MOVE EVALUATION 248 | IF(AB=='2') CALL CHANGE(Z7,D1(Z7),1) 249 | AB=A(1,Z6) 250 | IF((AB=='.').OR.(AB=='+')) GOTO 600 251 | IF((AB=='X').OR.(AB=='7')) GOTO 601 252 | IF(D1(Z6)=='*') GOTO 500 253 | H2=30 254 | P=1. 255 | H1=1 256 | OWN1='2' 257 | OWN2=AB 258 | CALL FIND(OWN2,Z6,Z8,H2) 259 | CALL FGHT(Z6,H1,H2,OWN1,OWN2) 260 | CALL FIND(OWN2,Z6,Z8,H2) 261 | IF(H1<=0) GOTO 500 262 | 600 CALL CHANGE(Z6,'2',1) 263 | 601 RANG(Y)=RANG(Y)-1 264 | IF(I1==1) NUMBER(2)=NUMBER(2)+1 265 | CALL CHAS(2000+Y,Z6) 266 | CALL SONAR(Z6) 267 | IF(P==1.) CALL SENSOR(Z6) 268 | GOTO 1001 269 | 500 CALL CHAS(2000+Y,0) 270 | CALL SONAR(Z6) 271 | IF(P==1.) CALL SENSOR(Z6) 272 | GOTO 1000 273 | 1001 CONTINUE 274 | 1000 CONTINUE 275 | RETURN 276 | END 277 | 278 | SUBROUTINE ARMCNT(ARMTOT,CODE,TARGET,LIMIT) 279 | INTEGER ARMTOT(20),CODE(1500),TARGET(70),LIMIT(13) 280 | DO 200 I=1,20 281 | 200 ARMTOT(I)=0 282 | DO 100 I=1,LIMIT(9) 283 | IF((CODE(I)<10000).OR.(CODE(I)>19999)) GOTO 100 284 | ILA=ILATT(CODE(I)) 285 | DO 150 I2=1,20 286 | 150 IF(TARGET(I2)==ILA) ARMTOT(I2)=ARMTOT(I2)+1 287 | 100 CONTINUE 288 | RETURN 289 | END 290 | 291 | 292 | 293 | . -------------------------------------------------------------------------------- /10.FOR: -------------------------------------------------------------------------------- 1 | 2 | C SUBROUTINE 10 3 | 4 | 5 | FUNCTION KLINE(KI,JECTOR) 6 | INTEGER FOO(0:3) 7 | DATA FOO/0,1300,2800,4000/ 8 | KI=0 9 | IF(JECTOR>=4) KI=30 10 | INDEX=JECTOR 11 | IF(JECTOR>=4) INDEX=JECTOR-4 12 | KLINE=FOO(INDEX) 13 | RETURN 14 | END 15 | 16 | FUNCTION ISCAPE(I,M) 17 | *: I = # OF TIMES ONE HAS TRIED TO ESCAPE 18 | *M: DIRECTION IN WHICH DANGER LIES 19 | INTEGER ITAB(8) 20 | LOGICAL PASS 21 | COMMON/PASS/PASS 22 | DATA ITAB/4,5,3,6,2,7,1,0/ 23 | ISC=M 24 | IF((PASS).AND.((I<1).OR.(I>8))) GOTO 100 25 | IF((PASS).AND.((ISC<1).OR.(ISC>8))) GOTO 100 26 | ISC=ICORR(M+ITAB(I)) 27 | ISCAPE=ISC 28 | RETURN 29 | 100 TYPE 102,ISC,I,M 30 | 102 FORMAT(' ISCAPE- ISC,M,I:',3G) 31 | RETURN 32 | END 33 | 34 | FUNCTION HITS(OWN) 35 | REAL A(8),B(8) 36 | DATA A/'A','F','D','S','T','R','C','B'/ 37 | DATA B/1. , 1., 3., 2., 3., 8., 8., 12./ 38 | HITS=0.0 39 | DO 1 I=1,8 40 | IF (OWN.EQ.A(I)) GOTO 2 41 | 1 CONTINUE 42 | RETURN 43 | 2 HITS=B(I) 44 | RETURN 45 | END 46 | 47 | FUNCTION ATTACK(OWN1,OWN2,IH1,AGGR) 48 | H1=FLOAT(IH1) 49 | C1=COST(OWN1,H1) 50 | C2=COST(OWN2,0.) 51 | S1=1. 52 | S2=1. 53 | IF(OWN1=='4') S1=3. 54 | IF(OWN2=='S') S2=3. 55 | H2=HITS(OWN2) 56 | H1=IFIX((H1+S2-1.)/S2) 57 | H2=IFIX((H2+S1-1.)/S1) 58 | ATTACK=(C1+C2)*VICTRY(H1,H2)-C1+AGGR 59 | RETURN 60 | END 61 | 62 | SUBROUTINE SECTOR(II) 63 | IMPLICIT INTEGER(A-Z) 64 | COMMON/MODE/MODE,ADDS,JECTOR ,ISEC 65 | COMMON/G2/G2(100) 66 | FF="32 67 | IF(JECTOR==-1) GOTO 108 68 | IF(MODE#1) RETURN 69 | IF(ISEC==JECTOR) RETURN 70 | ISEC=JECTOR 71 | LINE=KLINE(KI,JECTOR) 72 | CALL OUTCHR(FF) 73 | GOTO 691 74 | 108 CALL STROUT('SECTOR?',10) 75 | JECTOR=GETCHX(JECTOR) 76 | JECTOR=IPHASE(JECTOR) 77 | IF((JECTOR<0).OR.(JECTOR>9)) JECTOR=0 78 | CALL OUTCHR(FF) 79 | KI=0 80 | IF(JECTOR<5) GOTO 104; KI=30; JECTOR=JECTOR-5 81 | 104 LINE=JECTOR*1000 !LINE=TOP LINE OF SECTOR 82 | JECTOR=-1 !LET MAIN KNOW THAT UPDATING SECTOR ISNT USED 83 | 691 LINEFI=LINE+2000 !LINEFI=LINE AFTER LAST LINE OF SECTOR 84 | LINEC=LINE-100 !GET SET FOR LINE 205 85 | 205 LINEC=LINEC+100 !GOTO NEXT LINE 86 | IF(LINEC>=LINEFI) GOTO 204 !CHECK FOR END OF SECTOR 87 | KSTART=KI+1 !IF LINE IS BROKEN, KSTART WILL BE MODIFIED 88 | 206 DO 300 J=KSTART,KI+70 !KI ITSELF IS NOT IN SECTOR 89 | AB=A(II,J+LINEC) !GET CHARACTER 90 | 300 IF(AB#' ') GOTO 200 !FIND FIRST NON-BLANK SPOT 91 | GOTO 205 !NO CHARACTERS IN THIS LINE 92 | 200 KINIT=J !AB IS ALREADY CALCULATED 93 | G2(J)=AB !AVOIDS REPITITION 94 | DO 201 J=KINIT+1,KI+70 !LOOK FOR BLANK CHARACTER 95 | AB=A(II,J+LINEC) !GET CHARACTER 96 | IF(AB==' ') GOTO 202 !EXIT LOOP IF BLANK 97 | 201 G2(J)=AB !PUT CHAR. STRING IN AN ARRAY 98 | 202 KFINAL=J-1 !SET END OF CHAR. STRING 99 | CALL CURSOR(KINIT-LINE+LINEC-KI+300) !POSITION CURSOR 100 | DO 10 J=KINIT,KFINAL 101 | 10 CALL OUTCHR(LSH(G2(J),-29)) !PRINT OUT CHAR. STRING 102 | IF(KFINAL>=KI+70) GOTO 205 !NEXT LINE 103 | KSTART=KFINAL+1 !LOOK AT REST OF LINE 104 | GOTO 206 105 | 204 KURSOR=2300 106 | DO 450 I=KI,KI+70,10 107 | CALL CURSOR(KURSOR) 108 | CALL DECPRT(I) 109 | KURSOR=KURSOR+10 110 | 450 CONTINUE 111 | 112 | KURSOR=372 113 | DO 451 I=LINE/100,LINE/100+19,2 114 | CALL CURSOR(KURSOR) 115 | CALL DECPRT(I) 116 | KURSOR=KURSOR+200 117 | 451 CONTINUE 118 | 119 | CALL CURSOR(0) !SET CURSOR TO BEG. OF SCREEN 120 | RETURN 121 | END 122 | 123 | SUBROUTINE HEAD(OWN1,Y,Z6) 124 | IMPLICIT INTEGER(A-Z) 125 | CALL CURSOR(0) 126 | CALL IDEN(OWN1) 127 | CALL DECPRT(Y) 128 | CALL STROUT(' AT',10) 129 | CALL DECPRT(Z6) 130 | CALL SPACE 131 | RETURN 132 | END 133 | 134 | 135 | 136 | . -------------------------------------------------------------------------------- /11.FOR: -------------------------------------------------------------------------------- 1 | 2 | C SUBROUTINE 11 3 | FUNCTION IPORT(Z6) 4 | INTEGER Z6,X(70) 5 | COMMON/IARROW/IARROW(0:9) 6 | COMMON /X/X 7 | IPORT=0 8 | ID=500 9 | DO 100 I=1,70 10 | IF(X(I)==0) GOTO 100 11 | IF((A(1,X(I))#'X').OR.(EDGER(Z6)==0.0)) GOTO 100 12 | IF(IDIST(X(I),Z6)>=ID) GOTO 100 13 | IPORT=X(I) 14 | ID=IDIST(X(I),Z6) 15 | 100 CONTINUE 16 | IF(IPORT#0) RETURN 17 | IPORT=INT(RAN(C1)*5798.+102.) 18 | RETURN 19 | END 20 | 21 | FUNCTION MOVCOR 22 | &(IFO,ITURN,Z6,MOVE,IH1,IS1,AGGR,OWN1,EXPLOR,DIR) 23 | INCLUDE 'COMMON.EMP/NOLIST' 24 | 25 | * CHECK FOR IMPOSSIBLE CONDITION FOR MOVE 26 | IF((.NOT.PASS).OR.(IABS(MOVE)<=8)) GOTO 502 27 | CALL OUTCHR("32) 28 | TYPE 4034,OWN1,Z6,MOVE,IFO 29 | 4034 FORMAT(1X,A1,' @ ',I4,' ATTEMPTED ',G,' WITH IFO ',I4) 30 | 31 | 502 MOVE=IABS(MOVE) 32 | 33 | IF(ITURN==1) BLAH=0. 34 | IF(BLAH<0.) MOVE=ICORR(I2+INT(RAN(C1)*3.)-1) 35 | 36 | * CHECK FOR SOMETHING TO ATTACK, OR, SOMETHING TO RUN FROM 37 | * BLAH<0: RUN 38 | * BLAH>=0: ATTACK 39 | DO 100 IX=1,8 40 | I1=IX 41 | LOC=Z6+IARROW(I1) 42 | AB=A(1,LOC) 43 | IF(D1(LOC)#'.') GOTO 100 44 | IF((AB<'B').OR.(AB>'T')) GOTO 100 !IF SHIP OR PLANE, INVESTIGATE 45 | BLAH=ATTACK(OWN1,AB,IH1,AGGR) 46 | IF(BLAH>=0.) GOTO 402 !ATTACK IT 47 | GOTO 300 !RUN FROM IT 48 | 100 CONTINUE 49 | I1=0 !NOTHING OF INTEREST HERE 50 | GOTO 400 51 | 52 | * SELECT AN APPROPRIATE ESCAPE MOVE 53 | 300 IS=INT(RAN(C1)*3.) 54 | DO 301 IN=1,8 55 | I2=IN 56 | IF((IS==0).OR.(IN>3)) GOTO 501 57 | IF(IS#1) GOTO 500 58 | IF(IN==1) I2=2 59 | IF(IN==2) I2=3 60 | IF(IN==3) I2=1 61 | GOTO 501 62 | 500 IF(IN==1) I2=3 63 | IF(IN==2) I2=1 64 | IF(IN==3) I2=2 65 | 501 I=IARROW(ISCAPE(I2,I1))+Z6 66 | IF((A(1,I)=='.').AND.(ORDER(I)==0)) GOTO 350 67 | 301 CONTINUE 68 | I1=0 69 | GOTO 400 70 | 350 I1=ISCAPE(I2,I1) 71 | IF(D1(I)#'.') CALL STROUT('ISCAPE ERROR',11) 72 | GOTO 402 73 | 74 | 400 IF(EXPLOR==0.) GOTO 405 75 | EXPMAX=0 76 | DO 404 IX=MOVE,MOVE+7 77 | I1=ICORR(IX) 78 | LOC1=Z6+IARROW(I1) 79 | IF(ORDER(LOC1)#0) GOTO 404 80 | IF(A(1,LOC1)#'.') GOTO 404 81 | NEXP=0 82 | IF(A(0,LOC1+IARROW(I1))==' ') NEXP=1 83 | IF(A(0,LOC1+IARROW(ICORR(I1-1)))==' ') NEXP=NEXP+1 84 | IF(A(0,LOC1+IARROW(ICORR(I1+1)))==' ') NEXP=NEXP+1 85 | IF(A(0,LOC1+IARROW(ICORR(I1+2)))==' ') NEXP=NEXP+1 86 | IF(A(0,LOC1+IARROW(ICORR(I1-2)))==' ') NEXP=NEXP+1 87 | IF(NEXP==5) GOTO 402 88 | IF(NEXP<=EXPMAX) GOTO 404 89 | EXPMAX=NEXP 90 | I11=I1 91 | 404 CONTINUE 92 | I1=0 93 | IF(EXPMAX==0) GOTO 405 94 | I1=I11 95 | IF(D1(Z6+IARROW(I1))#'.') CALL STROUT('EXPLOR ERROR',11) 96 | GOTO 402 97 | 405 I2=MOVE 98 | LOC1=Z6+IARROW(MOVE) 99 | AB=A(1,LOC1) 100 | IF((AB=='.').AND.(ORDER(LOC1)==0)) GOTO 402 101 | M=MOVE 102 | IA=ICORR(M-DIR*3) 103 | IF(A(1,Z6+IARROW(IA))#'.') M=IA 104 | DO 401 I=0,7*DIR,DIR 105 | I2=ICORR(M+I) 106 | I3=Z6+IARROW(I2) 107 | 401 IF((A(1,I3)=='.').AND.(ORDER(I3)==0)) GOTO 402 108 | I2=0 109 | 402 IF(I1#0) I2=I1 110 | IF(((OWN1=='5').AND.(IFO#8)).OR. 111 | &(A(1,Z6+IARROW(MOVE))#'X')) MOVE=I2 112 | MOVCOR=MOVE 113 | IF(D1(Z6+IARROW(MOVE))=='+')CALL STROUT('AHEM,AHEM',1) 114 | RETURN 115 | END 116 | 117 | 118 | 119 | 120 | . -------------------------------------------------------------------------------- /12.FOR: -------------------------------------------------------------------------------- 1 | 2 | * MODULE 12 3 | 4 | 5 | SUBROUTINE INITIA 6 | IMPLICIT INTEGER(A-Z) 7 | REAL RAN,C1 8 | INTEGER X(70),Z6,D(300) 9 | COMMON/X/X 10 | COMMON/MAP/MAPS(2574),D,KLIP 11 | DO 10 I=1,6000 12 | P=D1F(I) 13 | CALL CHANGE(I,P,1) 14 | IF(P#'*') GOTO 10 15 | N1=INT(RAN(C1)*70.+1.) 16 | DO 100 N3=N1,N1+70 17 | N=N3; IF(N>70) N=N-70 18 | 100 IF(X(N)==0) GOTO 101 19 | 101 X(N)=I 20 | 10 CONTINUE 21 | RETURN 22 | END 23 | 24 | 25 | SUBROUTINE CHANGE(Z6,TYPE,MAP) 26 | IMPLICIT INTEGER(A-Z) 27 | LOGICAL PASS 28 | COMMON/PASS/PASS 29 | D IF((Z6>=1).AND.(Z6<=6000)) GOTO 100 30 | D IF(PASS) TYPE 1598,Z6 31 | D1598 FORMAT(' CHANGE, Z6=',G) 32 | D RETURN 33 | 100 CALL CHAMAP(Z6,TYPE,MAP) 34 | RETURN 35 | END 36 | 37 | INTEGER FUNCTION A(MAP,Z6) 38 | IMPLICIT INTEGER(A-Z) 39 | LOGICAL PASS 40 | COMMON/PASS/PASS 41 | D IF((Z6>=1).AND.(Z6<=6000)) GOTO 100 42 | D IF(PASS) TYPE 1598,Z6 43 | D1598 FORMAT(1X,/,' A(MAP,Z6), Z6=',G) 44 | D A='+' 45 | D RETURN 46 | 100 A=AMAPP(MAP,Z6) 47 | RETURN 48 | END 49 | 50 | INTEGER FUNCTION D1(Z6) 51 | IMPLICIT INTEGER(A-Z) 52 | LOGICAL PASS 53 | C INTEGER ASCII(0:2),D(0:299),Z6,ZEE6 54 | COMMON/PASS/PASS 55 | C COMMON/MAP/MAPS(2574),D,KLIP 56 | C DATA ASCII/'.','+','*'/ 57 | C ZEE6=Z6-1 58 | *REMOVED FEATURE: IF(KLIP==1) ZEE6=ZEE6+99-2*MOD(ZEE6,100) 59 | D IF((Z6>=1).AND.(Z6<=6000)) GOTO 100 60 | D IF(PASS) TYPE 1598,Z6 61 | D D1='+' 62 | D1598 FORMAT(' D1(Z6), Z6=',G) 63 | D RETURN 64 | C 100 IP=3**MOD(ZEE6,20) 65 | C D1=ASCII(MOD(D(ZEE6/20),IP*3)/IP) 66 | 100 D1=D1F(Z6) !REPLACEMENT MACRO ROUTINE 67 | RETURN 68 | END 69 | 70 | INTEGER FUNCTION MYCODE(IB) 71 | LOGICAL PASS 72 | COMMON/MYCOD/MYCOD2(750) 73 | COMMON/PASS/PASS 74 | D IF((IB>=1).AND.(IB<=1500)) GOTO 200 75 | D IF(PASS) TYPE 1598,IB 76 | D1598 FORMAT(' MYCODE(Y); Y=',G) 77 | D MYCODE=0 78 | D RETURN 79 | 200 ITMP1=(IB+1)/2 80 | IX=MYCOD2(ITMP1) 81 | ITMP2=IB-ITMP1*2 82 | IF(ITMP2==0) GOTO 100 83 | MYCODE=IX/10000 84 | RETURN 85 | 100 MYCODE=IX-IX/10000*10000 86 | RETURN 87 | END 88 | 89 | SUBROUTINE CMYCOD(IB,NEW) 90 | LOGICAL PASS 91 | COMMON /MYCOD/MYCOD2(750) 92 | COMMON/PASS/PASS 93 | D IF((IB>=1).AND.(IB<=1500).AND.(NEW>=0).AND.(NEW<=9999)) 94 | D & GOTO 101 95 | D IF(PASS) TYPE 1598,IB,NEW 96 | D1598 FORMAT(' CMYCOD(IB,NEW):',2G) 97 | D RETURN 98 | 101 ITMP1=(IB+1)/2 99 | IX=MYCOD2(ITMP1) 100 | ITMP2=IB-ITMP1*2 101 | IF(ITMP2==0) GOTO 100 102 | MYCOD2(ITMP1)=IX-IX/10000*10000+NEW*10000 103 | RETURN 104 | 100 MYCOD2(ITMP1)=IX/10000*10000+NEW 105 | RETURN 106 | END 107 | 108 | INTEGER FUNCTION S(IB) 109 | LOGICAL PASS 110 | INTEGER SMAC 111 | COMMON/PASS/PASS 112 | COMMON /LOCS/LOCS(1200) 113 | D IF((IB>=1).AND.(IB<=3000)) GOTO 101 114 | D IF(PASS) TYPE 100,IB 115 | D 100 FORMAT(' S: NUMBER=',G) 116 | D S=0 117 | D RETURN 118 | 101 S=SMAC(IB,LOCS) 119 | D IF((S<0).OR.(S>6000)) TYPE 200, S 120 | D 200 FORMAT(' S: LOC RETURNED='G) 121 | RETURN 122 | END 123 | 124 | INTEGER FUNCTION H(IB) 125 | LOGICAL PASS 126 | COMMON/PASS/PASS 127 | COMMON /J1TS/J1TS(178) 128 | J=IB 129 | D IF((J>=1).AND.(J<=1600)) GOTO 100 130 | D IF(PASS) TYPE 1598,J 131 | D1598 FORMAT(' H(IB), IB=',G) 132 | D H=1 133 | D RETURN 134 | 100 IX=(J+8)/9 135 | IY=MOD(J-1,9) 136 | IY=13^IY 137 | H=MOD(J1TS(IX),IY*13)/IY 138 | RETURN 139 | END 140 | 141 | SUBROUTINE CHITS(IB,NEW) 142 | * PACKS HITS FROM 178 WORD ARRAY, WORDS ARE PACKED IN BASE 12 143 | * J1TS IS THE ARRAY, IX IS WHICH ELEMENT IN THE ARRAY, IY IS THE 144 | * POSITION OF THE DATA IN THE ARRAY ELEMENT 145 | LOGICAL PASS 146 | COMMON/PASS/PASS 147 | COMMON /J1TS/J1TS(178) 148 | J=IB 149 | D IF((J>=1).AND.(J<=6000).AND.(NEW>=0).AND.(NEW<=12)) 150 | D & GOTO 100 151 | D IF(PASS) TYPE 1598, IB, NEW 152 | D1598 FORMAT(' CHITS(IB,NEW):',2G) 153 | D RETURN 154 | 100 IX=(J+8)/9 155 | IY=MOD(J-1,9) 156 | IY=13^IY 157 | J1TS(IX)=NEW*IY+J1TS(IX)/(13*IY)*13*IY 158 | &+MOD(J1TS(IX),IY) 159 | RETURN 160 | END 161 | 162 | SUBROUTINE CHAS(IB,NEW) 163 | LOGICAL PASS 164 | COMMON/PASS/PASS 165 | COMMON/LOCS/LOCS(1200) 166 | D IF((IB>=1).AND.(IB<=3000).AND.(NEW>=0).AND.(NEW<=6000)) 167 | D & GOTO 100 168 | D IF(PASS) TYPE 1598,IB,NEW 169 | D1598 FORMAT(' CHAS(IB,NEW):',2G) 170 | D RETURN 171 | 100 CALL CHSMAC(IB,LOCS,NEW) 172 | RETURN 173 | END 174 | 175 | 176 | 177 | -------------------------------------------------------------------------------- /13.FOR: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | C SUBROUTINE 13 6 | SUBROUTINE ENEMYM 7 | &(OWN1,HITMAX,CRAHIT,CRALOC,NUM) 8 | INCLUDE 'COMMON.EMP/NOLIST' 9 | DIMENSION OK(5),NSHPRF(4,6) 10 | DATA OK/'.',' ','O','*','X'/ 11 | 12 | * NSHPRF IS AN ARRAY WHICH IS REFERENCED TO DETERMINE 13 | * WHETHER A CERTAIN SHIP (D=1,S=2,R=3,B=4) WANTS TO ATTACK 14 | * ANOTHER CERTAIN TYPE OF SHIP. 1 MEANS YES, 0 MEANS NO. 15 | * SECOND VARIABLE: 1=D,2=S,3=T,4=R,5=C,6=B 16 | DATA (NSHPRF(1,J),J=1,6)/1,1,1,0,0,0/ !DESTROYER 17 | DATA (NSHPRF(2,J),J=1,6)/1,1,1,0,0,0/ !SUBMARINE 18 | DATA (NSHPRF(3,J),J=1,6)/1,1,1,1,1,0/ !CRUISER 19 | DATA (NSHPRF(4,J),J=1,6)/1,1,1,1,1,1/ !BATTLESHIP 20 | 21 | *THE FOLLOWING NUMBERS ARE IFO VARIABLES RELATING TO 22 | * CERTAIN TYPES OF MOVEMENT (CODES) 23 | C 7: RANDOM DIRECTION 24 | C 3: CITY TARGET LOC. 25 | C 4: TT# ESCORT 26 | C 5: TARGET 27 | C 8: DAMAGED 28 | C 10: LOOK AT UNEXPLORED TERRITORY 29 | IF(NUM==3) NUMSHP=1 30 | IF(NUM==4) NUMSHP=2 31 | IF(NUM==6) NUMSHP=3 32 | IF(NUM==8) NUMSHP=4 33 | 34 | NUMBER(NUM)=0 35 | IF(INT(CODER)==NUM) TYPE 100,OWN1 36 | 100 FORMAT(1X,A1,' CODES') 37 | MONKEY=0 38 | 39 | DO 1000 Y=1,LIMIT(NUM+8) 40 | Z6=S(Y+CRALOC) 41 | IF(Z6==0) GOTO 1000 42 | DIR=MOD(Y,2)*2-1 43 | H1=H(Y+CRAHIT) 44 | AB=A(1,Z6) 45 | IF(AB=='X') H1=H1+1 46 | IF(H1>HITMAX) H1=HITMAX 47 | 48 | DO 2500 ITURN=1,2 49 | P='NSENS' 50 | IF((ITURN==2).AND.(H1<=HITMAX/2)) GOTO 1000 51 | Z7=Z6 52 | 53 | C MOVE SELECTION 54 | IFO=IFORM(CODE(Y+CRALOC-1500)) 55 | ILA=ILATT(CODE(Y+CRALOC-1500)) 56 | * DOES A NEW CODE NEED TO BE SELECTED? 804:YES, 800:NO 57 | IF((IFO==8).AND.(H1==HITMAX)) IFO=0 58 | IF(IFO==8) GOTO 800 59 | IF(H1==HITMAX) GOTO 801 60 | IFO=8 61 | ILA=IPORT(Z6) 62 | GOTO 800 63 | 801 GOTO (804,2,3,4,5,804,804,804,804,10) IFO 64 | GOTO 804 65 | 66 | 2 GOTO 804 67 | 68 | 3 IF(A(1,ILA)=='X') GOTO 804 69 | IF(IDIST(Z6,ILA)==1) 804,800 70 | 71 | 4 IF(S(2600+ILA)==0) GOTO 804 72 | IF(CODE(1100+ILA)<70000) 804,800 73 | 74 | 5 IF(ILA#Z6) GOTO 800 75 | DO 52 I1=1,6 76 | DO 52 I2=1,5 77 | IF(TROOPT(I1,I2)#ILA) GOTO 52 78 | TROOPT(I1,I2)=0 79 | 52 CONTINUE 80 | GOTO 804 81 | 82 | 10 IF(A(0,ILA)#' ') 804,800 83 | 84 | C NEW CODE SELECTION 85 | * 5:TARGET 86 | 804 ID=500 87 | DO 900 N=1,6 88 | IF(NSHPRF(NUMSHP,N)==0) GOTO 900 89 | DO 900 N2=1,5 90 | IF(TROOPT(N,N2)==0) GOTO 900 91 | IF(IDIST(Z6,TROOPT(N,N2))>=ID) GOTO 900 92 | ID=IDIST(Z6,TROOPT(N,N2)) 93 | ILA=TROOPT(N,N2) 94 | IFO=5 95 | 900 CONTINUE 96 | IF(ID#500) GOTO 800 97 | 803 IF(RAN(C1)>.40) GOTO 808 98 | C 3:CITY TARGET LOC. 99 | IA=INT(RAN(C1)*20.+1.) 100 | IB=IA+70 101 | DO 809 IC=IA,IB 102 | I=IC 103 | IF(I>70) I=IC-70 104 | IF(TARGET(I)==0) GOTO 809 105 | IF(A(1,TARGET(I))#'O') GOTO 809 106 | IF(EDGER(TARGET(I))==0.) GOTO 809 107 | IFO=3 108 | ILA=TARGET(I) 109 | GOTO 800 110 | 809 CONTINUE 111 | C 4:TT# ESCORT 112 | 808 IA=INT(RAN(C1)*FLOAT(LIMIT(13))+1.) 113 | IB=ILA+LIMIT(13) 114 | DO 811 IC=IA,IB 115 | I=IC 116 | IF(I>LIMIT(13)) I=IC-LIMIT(13) 117 | IF(S(2600+I)==0) GOTO 811 118 | IF(CODE(1100+I)<90000) GOTO 811 119 | IFO=4 120 | ILA=I 121 | GOTO 800 122 | 811 CONTINUE 123 | 124 | * 10: EXPLORE 125 | 814 I1=EXPL(DUMMY) 126 | IF(I1==0) GOTO 813 127 | ILA=I1 128 | IFO=10 129 | GOTO 800 130 | 131 | * 1: RANDOM DIRECTION 132 | 813 IF(IFO==7) GOTO 800 133 | ILA=INT(RAN(C1)*8.+1.) 134 | IFO=7 135 | 136 | * MOVE CORRECTION 137 | 800 IF(IFO==7) MOOV=ILA 138 | FLAG=1 139 | IF((IFO==8).OR.(IFO==3).OR.(IFO==5)) 140 | & MOOV=PATH(Z6,ILA,DIR,OK,FLAG) 141 | IF(IFO==4) MOOV=PATH(Z6,S(ITT2+ILA),DIR,OK,FLAG) 142 | IF(FLAG==0) GOTO 814 143 | IF(IFO==10) MOOV=PATH(Z6,ILA,DIR,OK,FLAG) 144 | IF(FLAG==0) GOTO 813 145 | IF(IFO#2) GOTO 812 146 | MOOV=0 147 | IF(IDIST(Z6,ILA)>4) MOOV=MOV(Z6,ILA) 148 | IF(IDIST(Z6,ILA)<4) MOOV=ICORR(MOV(Z6,ILA)-4) 149 | 812 AGGR=0 150 | IS1=1 151 | IF(OWN1=='4') IS1=2 152 | MOOV=MOOV*DIR 153 | MOOV=MOVCOR(IFO,ITURN,Z6,MOOV,H1,IS1,AGGR,OWN1,1.,DIR) 154 | IF((H1='A').AND.(A1<='T')) GOTO 503 169 | TYPE 502,OWN1,Z6,A1 170 | 502 FORMAT(' ENEMY ',A1,' AT ',I4,' RAN AGROUND ON ',A1) 171 | GOTO 600 172 | 503 H2=30 173 | P='SENSE' 174 | OWN2=A1 175 | CALL FIND(OWN2,Z6,Z8,H2) 176 | CALL FGHT(Z6,H1,H2,OWN1,OWN2) 177 | CALL FIND(OWN2,Z6,Z8,H2) 178 | IF(H1<=0) GOTO 600 179 | 500 CALL CHANGE(Z6,OWN1,1) 180 | 501 CALL CHAS(Y+CRALOC,Z6) 181 | CALL CHITS(Y+CRAHIT,H1) 182 | IF(ITURN==1) NUMBER(NUM)=NUMBER(NUM)+1 183 | MONKEY=Y 184 | GOTO 999 185 | 600 CALL CHAS(Y+CRALOC,0) 186 | CODE(Y+CRALOC-1500)=0 187 | CALL CHITS(Y+CRAHIT,0) 188 | 999 CALL SONAR(Z6) 189 | IF(P=='SENSE') CALL SENSOR(Z6) 190 | 2500 CONTINUE 191 | 1000 CONTINUE 192 | LIMIT(NUM+8)=MONKEY 193 | RETURN 194 | END 195 | 196 | 197 | . -------------------------------------------------------------------------------- /14.FOR: -------------------------------------------------------------------------------- 1 | 2 | *MODULE 14 3 | 4 | SUBROUTINE CARIER 5 | * THIS SUBROUTINE COMPUTES AND EVALUATES ALL COMPUTER CARRIER MOVES 6 | 7 | INCLUDE 'COMMON.EMP/NOLIST' 8 | DIMENSION OK(5) 9 | DATA OK/'.',' ','O','*','X'/ 10 | 11 | NUMBER(7)=0 12 | IF(CODER==7.) TYPE 100 13 | 100 FORMAT(' CARRIER CODES') 14 | OWN1='7' 15 | MONKEY=0 16 | 17 | * BEGIN LOOP 18 | DO 3000 Y=1,LIMIT(15) 19 | Z6=S(ICA2+Y) 20 | IF(Z6==0) GOTO 3000 21 | DIR=MOD(Y,2)*2-1 22 | H1=H(ICA2H+Y) 23 | IF(A(1,Z6)=='X') H1=H1+1 24 | IF(H1>8) H1=8 25 | 26 | DO 2501 TURN=1,2 27 | IF((TURN==2).AND.(H1<=4)) GOTO 3000 !MOVE AT 1/2 SPEED 28 | P='NSENS' 29 | N=0 30 | Z7=Z6 31 | AB=A(1,Z6) 32 | IF((AB#'7').AND.(AB#'X')) GOTO 503 33 | 34 | C MOVE SELECTION 35 | IFO=IFORM(CODE(Y)) 36 | ILA=ILATT(CODE(Y)) 37 | IF(H1==8) GOTO 3002 38 | IFO=8 39 | ILA=IPORT(Z6) 40 | GOTO 7000 41 | 42 | * IFO=7: RANDOM DIRECTION 43 | * IFO=6: HEADING TOWARDS STATION 44 | * IFO=8: DAMAGED 45 | * IFO=9: STATIONED 46 | 47 | * DOES A NEW CODE NEED TO BE SELETED? 6000:YES, 7000:NO 48 | 3002 GOTO (6,7,8,9) IFO-5 49 | GOTO 6000 50 | 51 | 6 GOTO 7000 52 | 53 | 7 GOTO 6000 54 | 55 | 8 IF(H1==8) 6000, 7000 56 | 57 | 9 DO 10 I=1,70 58 | IF(TARGET(I)==0) GOTO 10 59 | IF((A(0,TARGET(I))=='O').AND.(IDIST(Z6,TARGET(I))<=10)) 60 | & GOTO 7000 61 | 10 CONTINUE 62 | DO 11 I=1,10 63 | 11 IF(IDIST(LOCI(I,2))<=10) GOTO 7000 64 | GOTO 6000 65 | 66 | * NEW CODE SELECTION 67 | 68 | 6000 DO 6001 J=1,10 69 | IF(LOCI(J,2)==0) GOTO 6001 70 | LOC=LOCI(J,2) 71 | KDORK=0 72 | ID=500 73 | DO 6002 K=1,70 74 | IF(OWNER(K)#2) GOTO 6002 75 | IF(IDIST(X(K),LOC)>=ID) GOTO 6002 76 | ID=IDIST(X(K),LOC) 77 | IF(ID<10) GOTO 6001 78 | KDORK=X(K) 79 | 6002 CONTINUE 80 | DO 6003 K=ICA2+1,ICA2+LIMIT(15) 81 | IS=S(K) 82 | IF(IS==0) GOTO 6003 83 | IF(IDIST(IS,LOC)>=ID) GOTO 6003 84 | IF(MOD(IFORM(CODE(K-ICA2)),10)#9) GOTO 6003 85 | ID=IDIST(IS,LOC) 86 | IF(ID<10) GOTO 6001 87 | KDORK=IS 88 | 6003 CONTINUE 89 | IF(KDORK==0) GOTO 6001 90 | 6004 IF(IDIST(KDORK,LOC)<1) GOTO 6001 91 | LOC=LOC+IARROW(MOV(LOC,KDORK)) 92 | IF(IDIST(KDORK,LOC)>19) GOTO 6004 93 | AGARB=A(0,LOC) 94 | IF((AGARB#' ').AND.(AGARB#'.')) GOTO 6004 95 | IFO=6 96 | ILA=LOC 97 | GOTO 7000 98 | 6001 CONTINUE 99 | 100 | * RANDOM DIRECTION SELECTION 101 | IF(IFO==7) GOTO 7000 102 | IFO=7 103 | KDORK=0 104 | ILA=INT(RAN(C1)*8.+1.) 105 | 106 | * NOW PICK THE MOVE SPECIFIED BY IFO AND ILA 107 | 7000 IF(IFO==8) GOTO 7003 108 | IF(IFO#7) GOTO 7001 109 | MOVE=ILA; GOTO 7010 110 | 7001 IF(IFO#6) GOTO 7002 111 | IF(ILA#Z6) GOTO 7003 112 | IFO=9 113 | GOTO 7002 114 | 7003 MOVE=PATH(Z6,ILA,DIR,OK,FLAG) 115 | GOTO 7010 116 | 7002 IF(Z6#ILA) MOVE=MOV(Z6,ILA) 117 | IF(Z6==ILA) MOVE=INT(RAN(C1)*8.+1.) 118 | 119 | * MOVE CORRECTION 120 | 7010 AGGR=0. 121 | IF((NUMBER(7)>30).AND.(MOD(IFO,10)#9)) AGGR=5. 122 | MOVE=MOVCOR(IFO,TURN,Z6,MOVE,H1,1,AGGR,'7',1.,DIR) 123 | IF((H1<8).AND.(AB=='X')) MOVE=0 124 | IF(IFO==7) ILA=IABS(MOVE) 125 | CODE(Y)=10000*IFO+ILA 126 | IB=CODE(Y) 127 | IF(CODER==7.) TYPE 101,IB 128 | 101 FORMAT(1X,G) 129 | 130 | C MOVE EVALUATION 131 | Z6=Z6+IARROW(IABS(MOVE)) 132 | IF(D1(Z7)#'*') CALL CHANGE(Z7,D1(Z7),1) 133 | AB=A(1,Z6) 134 | IF(AB=='.') GOTO 700 135 | IF(AB=='X') GOTO 701 136 | IF((AB>='A').AND.(AB<='T')) GOTO 703 137 | TYPE 502,OWN1,Z6,AB 138 | 502 FORMAT(' ENEMY ',A1,' AT ',I4,' RAN AGROUND ON ',A1) 139 | 503 H1=0 140 | GOTO 815 141 | 703 H2=30 142 | P='SENSE' 143 | OWN2=AB 144 | CALL FIND(OWN2,Z6,Z8,H2) 145 | CALL FGHT(Z6,H1,H2,'7',OWN2) 146 | CALL FIND(OWN2,Z6,Z8,H2) 147 | IF(H1<=0) GOTO 815 148 | 700 CALL CHANGE(Z6,OWN1,1) 149 | 701 CALL CHAS(Y+ICA2,Z6) 150 | CALL CHITS(Y+ICA2H,H1) 151 | IF(TURN==1) NUMBER(7)=NUMBER(7)+1 152 | 815 N=0 153 | IF(P=='SENSE') CALL SENSOR(Z6) 154 | DO 702 I=1,LIMIT(10) 155 | IF(Z7#S(I+2000)) GOTO 702 156 | N=N+1 157 | CALL CHAS(I+2000,Z6) 158 | IF(N>H1) CALL CHAS(I+2000,0) 159 | 702 CONTINUE 160 | IF(H1<=0) GOTO 850 161 | MONKEY=Y 162 | GOTO 899 163 | 850 CALL CHAS(Y+ICA2,0) 164 | CODE(Y)=0 165 | CALL CHITS(ICA2H+Y,0) 166 | 899 CALL SONAR(Z6) 167 | 2501 CONTINUE 168 | 3000 CONTINUE 169 | LIMIT(15)=MONKEY 170 | 2001 RETURN 171 | END 172 | 173 | 174 | . -------------------------------------------------------------------------------- /15.FOR: -------------------------------------------------------------------------------- 1 | 2 | SUBROUTINE GAME(IZAP,NUM) 3 | 4 | INCLUDE 'COMMON.EMP/NOLIST' 5 | 6 | REAL REEED(2) 7 | INTEGER MAPTMP(0:2) 8 | INTEGER PPN,PRIV(5),IOTAB(16) 9 | 10 | DATA PHAZE/'A','F','D','S','T','R','C','B',1,2,4,5,6,10,12,15/ 11 | DATA (MAPTMP(I),I=0,2)/'.','+','*'/ 12 | DATA (IARROW(I),I=0,9)/0,1,-99,-100,-101,-1,99,100,101,0/ 13 | DATA PRIV/0,"272230,"472227,0,0/ 14 | DATA IOTAB/0,500,700,900,1100,1200,1300,1400,1500,2000, 15 | & 2200,2400,2600,2700,2800,2900/ 16 | CALL ZEROST !ZERO START ADDRESS 17 | IF(IZAP) GOTO 180 18 | MODE=1 19 | ISEC=-1 20 | CALL MSTIME(M) 21 | CALL SETRAN(M/2*2+1) 22 | Z3=4 23 | 24 | * SET PASS TRUE FOR PRIVELEGED USER 25 | PASS=.FALSE. 26 | I=INT(GETTAB(2,-1)*1.E+28) 27 | IF((I==4543105).OR.(I==4540533)) PASS=.TRUE. 28 | 29 | 110 FORMAT(' PLEASE WAIT 7 DAYS FOR CREATION OF WORLD.(ABOUT' 30 | &,' A MINUTE OR 2)') 31 | IB=1 32 | CALL TRMOP2 33 | * CALL TRMOP("2010,-1,IB,IERR) 34 | CALL OUTCHR("32) 35 | TYPE 1349 36 | 1349 FORMAT(1X,/////////////////) 37 | TYPE 2349 38 | 2349 FORMAT(' EMPIRE, VERSION 3'/) 39 | 2350 FORMAT(' THE DSKE: COMMITTEE SUCKS!'/) 40 | * CALL STROUT('DIRECTIONS ARE ON [29970,WBG]',1) 41 | CALL STROUT('COPYRIGHT 1978 BY WALTER BRIGHT',1) 42 | CALL STROUT('DIRECTIONS ARE ON HLP:EMPIRE.HLP',1) 43 | CALL STROUT('FOR QUESTIONS OR BUGS SEND MAIL TO [29970,WBG]',1) 44 | IF(ILDET('EMPIRE.DAT')==1) GOTO 130 45 | TYPE 170 46 | OPEN(UNIT=1,DEVICE='DSK',FILE='EMPIRE.DAT',ACCESS='SEQIN') 47 | READ(1) D 48 | READ(1) MAPS 49 | READ(1) TROOPT 50 | READ(1) LIMIT,MDATE,Z3,PAMELA,REEED,KLIP 51 | READ(1) NUMBER 52 | READ(1) X,TARGET,FOUND,OWNER,PHASE 53 | DO 20 I=1,16 54 | 20 CALL READ(IOTAB(I),LIMIT(I),I) 55 | READ(1) J1TS 56 | READ(1,END=450) NUM 57 | READ(1,END=450) LOCI 58 | READ(1,END=450) NSHIFT,FIPATH 59 | 450 CLOSE(UNIT=1) 60 | TYPE 120,PAMELA,REEED 61 | 120 FORMAT(' READY TO RESUME GAME TERMINATED AT ',A5,' ON ', 62 | &2A5/) 63 | IF(MDATE>200) TYPE 2350 64 | RETURN 65 | 130 CONTINUE 66 | TYPE 110 67 | C-----MAP SELECTION------- 68 | DO 7375 I=1,10 69 | 7375 C1=RAN(C1) 70 | KILL=C1*5 71 | IFILE=-21279760320+32768*KILL 72 | 140 OPEN(UNIT=1,DEVICE='GAM',FILE=IFILE,ACCESS='SEQIN') 73 | READ(1) D 74 | C------- MAP FLIP AND KLIP------ 75 | KLIP=0 76 | C KLIP=INT(RAN(C1)*2.) 77 | IF(RAN(C1)>.5) GOTO 7373 78 | DO 7374 I=0,145,5 79 | IX=295-I 80 | DO 7374 J=1,5 81 | JIX=D(I+J) 82 | D(I +J)=D(IX +J) 83 | 7374 D(IX+J)=JIX 84 | C-----CITY AND A-MAP INITIALIZATION-------- 85 | 7373 CALL INITIA 86 | CLOSE(UNIT=1) 87 | 203 FORMAT(I4) 88 | 365 C=INT(RAN(C1)*70.)+1 89 | ID=INT(RAN(C1)*70.)+1 90 | IF(X(C)==0.OR.X(ID)==0) GO TO 365 91 | IF(X(C)==X(ID))GOTO365 92 | IF((EDGER(X(C))==8.).OR.(EDGER(X(ID))==8.))GO TO 365 93 | Z6=X(ID) 94 | TYPE 103,X(ID) 95 | 103 FORMAT(' YOUR CITY IS AT ',I4) 96 | CALL CHANGE(Z6,'O',1) 97 | CALL CHANGE(X(C),'X',1) 98 | CALL SONAR(X(C)) 99 | CALL SENSOR(Z6) 100 | MODE=0 101 | CALL LTR(Z6) 102 | MODE=1 103 | CALL STROUT('WHAT DO YOU DEMAND THAT THIS CITY PRODUCE? ',10) 104 | OWNER(ID)=1 105 | MDATE=0 106 | CALL PHASIN(ID) 107 | MDATE=6 108 | OWNER(C)=2 109 | PHASE(C)=2 110 | FOUND(C)=5 111 | IBELL="034000000000 112 | TYPE 111,IBELL 113 | 111 FORMAT(1X,A1) 114 | Z6=X(ID) 115 | RETURN 116 | 117 | 118 | 180 IF(MODE==0) TYPE 170 119 | 170 FORMAT(' A FEW MOMENTS PLEASE...'/) 120 | 179 CONTINUE 121 | CALL TIME(PAMELA) 122 | CALL DATE(REEED) 123 | OPEN(UNIT=1,FILE='EMPIRE.DAT',ACCESS='SEQOUT') 124 | WRITE(1) D 125 | WRITE(1) MAPS 126 | WRITE(1) TROOPT 127 | WRITE(1) LIMIT,MDATE,Z3,PAMELA,REEED,KLIP 128 | WRITE(1) NUMBER 129 | WRITE(1) X,TARGET,FOUND,OWNER,PHASE 130 | DO 21 I=1,16 131 | 21 CALL WRITE(IOTAB(I),LIMIT(I),I) 132 | WRITE(1) J1TS 133 | WRITE(1) NUM 134 | WRITE(1) LOCI 135 | WRITE(1) NSHIFT,FIPATH 136 | CLOSE(UNIT=1) 137 | RETURN 138 | END 139 | 140 | SUBROUTINE READ(BEG,LIM,NUM) 141 | COMMON/LOCS/LOCS(1200) 142 | COMMON/CODE/CODE(1501:3000) 143 | COMMON/MYCOD/MYCOD2(750) 144 | COMMON/MISC1/TARGET(70),AR2S(1501:2000),RANGE(501:700),RANG 145 | INTEGER H,RANG(2001:2200),RANGE,TARGET,AR2S,CODE,BEG 146 | DO 100 J=BEG+1,BEG+LIM 147 | IF(MOD(J,5)==1) READ(1) LOCS((J+4)/5*2-1), LOCS((J+4)/5*2) 148 | IF((NUM<9).AND.(MOD(J,2)==1))READ(1)MYCOD2((J+1)/2) 149 | IF(NUM>8)READ(1)CODE(J) 150 | IF(NUM==9)READ(1)AR2S(J) 151 | IF(NUM==2)READ(1)RANGE(J) 152 | IF(NUM==10)READ(1)RANG(J) 153 | 100 CONTINUE 154 | RETURN 155 | END 156 | 157 | 158 | SUBROUTINE WRITE(BEG,LIM,NUM) 159 | COMMON/LOCS/LOCS(1200) 160 | COMMON/CODE/CODE(1501:3000) 161 | COMMON/MYCOD/MYCOD2(750) 162 | COMMON/MISC1/TARGET(70),AR2S(1501:2000),RANGE(501:700),RANG 163 | INTEGER H,RANG(2001:2200),RANGE,TARGET,AR2S,CODE,BEG 164 | DO 100 J=BEG+1,BEG+LIM 165 | IF(MOD(J,5)==1) WRITE(1) LOCS((J+4)/5*2-1), LOCS((J+4)/5*2) 166 | IF((NUM<9).AND.(MOD(J,2)==1))WRITE(1)MYCOD2((J+1)/2) 167 | IF(NUM>8)WRITE(1)CODE(J) 168 | IF(NUM==9)WRITE(1)AR2S(J) 169 | IF(NUM==2)WRITE(1)RANGE(J) 170 | IF(NUM==10)WRITE(1)RANG(J) 171 | 100 CONTINUE 172 | RETURN 173 | END 174 | 175 | 176 | . -------------------------------------------------------------------------------- /16.FOR: -------------------------------------------------------------------------------- 1 | 2 | *MODULE 16 3 | 4 | 5 | SUBROUTINE ARMYMV 6 | * THIS SUBROUTINE HANDLES USER ARMY MOVES 7 | 8 | INCLUDE 'COMMON.EMP/NOLIST' 9 | 10 | ITURN=1 11 | DO 1002 Y=1,LIMIT(1) 12 | Z6=S(Y) 13 | IF(Z6==0) GOTO 1002 14 | MYCOD=MYCODE(Y) 15 | IF((MODE==1).AND.(POSCHK(Z6))==0.) GOTO 1002 16 | Z7=Z6 17 | AB=A(1,Z6) 18 | IF((MYCOD#0).AND.(AB=='O')) GOTO 1050 19 | IF((AB=='A').OR.(AB=='T').OR.(AB=='O')) GOTO 1081 20 | 1050 CALL CURSOR(200) 21 | CALL STROUT('ARMY #',0); CALL DECPRT(Y) 22 | CALL STROUT(' DESTROYED. ',31) 23 | CALL CHAS(Y,0) 24 | GOTO 1002 25 | 26 | 1081 IF(AB#'T') GOTO 1069 27 | DO 1300 I=1,8 28 | 1300 IF(D1(Z6+IARROW(I))#'.') GOTO 1069 29 | GOTO 1002 30 | 31 | 1069 IF(MYCOD==0) GOTO 1083 32 | IF(MYCOD#100) GOTO 1084 33 | Z6=Z6+IARROW(JIGGLE(Z6,Y)) 34 | GOTO 1085 35 | 1084 CALL STASIS(Z6,Y) 36 | 6314 MYCOD=MYCODE(Y) 37 | IF(MYCOD==0) GOTO 1083 38 | IF((MYCOD<100).OR.(MYCOD>6108)) GOTO 1003 39 | IF(MYCOD>6100) GOTO 1086 40 | IF(MYCOD<=6000) GOTO 1089 41 | GOTO 1003 42 | 1089 Z6=Z6+IARROW(MOV(Z6,MYCOD)) 43 | GOTO 1087 44 | 1086 Z6=Z6+IARROW(MYCOD-6100) 45 | 1087 AD=A(1,Z6) 46 | IF(((AD=='+').OR.(AD=='T')).AND.(ORDER(Z6)==0))GOTO 1085 47 | Z6=Z7 48 | CALL SECTOR(2) 49 | CALL STSOUT(MYCOD) 50 | 1083 CALL SECTOR(2) 51 | CALL LTR(Z6,ITURN) 52 | CALL HEAD('A',Y,Z6) 53 | 1640 CALL MVE('A',MDATE,Y,1,Z6,Z7,DISAS,Z6-IADJST) 54 | IF(DISAS==-2) GOTO 6314 !JUST PUT INTO STASIS 55 | 56 | 57 | * MOVE EVALUATION 58 | 1085 IF((A(1,Z7)#'T').AND.(D1(Z7)#'*')) CALL CHANGE(Z7,D1(Z7),1) 59 | IF(Z6==MYCODE(Y)) CALL CMYCOD(Y,0) 60 | AC=A(1,Z6) 61 | IF(AC=='T') GOTO 1006 62 | IF(DISAS==1)GOTO1001 63 | IF((A(1,Z7)#'T').OR.(D1(Z6)#'.')) GOTO 1007 64 | CALL CURSOR(100) 65 | CALL STROUT('YOU ARE INCAPABLE OF ATTACK WHILE 66 | & ON A TRANSPORT. ',31) 67 | CALL STROUT('YOUR ARMY JUMPED INTO THE BRINY AND DROWNED. ',31) 68 | GOTO 1001 69 | 1007 IF((AC#'.').AND.(AC#'+')) GOTO 1004 70 | IF(AC#'.') GOTO 1010 71 | CALL CURSOR(100) 72 | CALL STROUT('YOUR ARMY MARCHED DUTIFULLY INTO THE 73 | & SEA AND DROWNED. ',31) 74 | GOTO 1001 75 | 1010 CALL CHANGE(Z6,'A',1) 76 | 77 | 1006 CALL CHAS(Y,Z6) 78 | GOTO 1003 79 | 1004 H1=1 80 | IF(D1(Z6)#'*') GOTO 1039 81 | DO 1200 IY=1,70 82 | IF(X(IY)#Z6) GOTO 1200 83 | IF(OWNER(IY)#1) GOTO 1070 84 | CALL CHANGE(Z6,'O',1) 85 | CALL CURSOR(100) 86 | CALL STROUT('BASTARDO! YOU ATTACKED YOUR OWN CITY! YOUR ',31) 87 | CALL STROUT('IMPERTINENT ATTACKING ARMY WAS LIQUIDATED. ',31) 88 | GOTO 1001 89 | 1070 IF(RAN(C1)<.5) GOTO 1071 90 | CALL CURSOR(100) 91 | CALL STROUT('THE SCUM DEFENDING THE CITY HAS CRUSHED ',31) 92 | CALL STROUT('YOUR ATTACKING BLITZKRIEGER! ',31) 93 | GOTO 1200 94 | 1071 CALL CURSOR(0) 95 | CALL STROUT('CITY #',0); CALL DECPRT(IY) 96 | CALL STROUT(' HAS BEEN SUBJUGATED! ',31) 97 | CALL STROUT('THE LEADERS OF THE RESISTANCE HAVE BEEN 98 | & EXECUTED. ',31) 99 | CALL STROUT('THE ARMY HAS BEEN DISPERSED TO ENFORCE 100 | & IRON CONTROL. ',31) 101 | CALL CHANGE(Z6,'O',1) 102 | IF(OWNER(IY)#2) GOTO 5943 103 | CALL SONAR(Z6) 104 | PHASE(IY)=0 105 | DO 5944 I=1,70 106 | IF(TARGET(I)==Z6) GOTO 5943 107 | IF(TARGET(I)#0) GOTO 5944 108 | TARGET(I)=Z6 109 | GOTO 5943 110 | 5944 CONTINUE 111 | 5943 OWNER(IY)=1 112 | 113 | 1200 CONTINUE 114 | GOTO 1001 115 | 1039 OWN1='A' 116 | OWN2=AC 117 | H1=1 118 | H2=30 119 | CALL FIND(OWN2,Z6,Z8,H2) 120 | CALL FGHT(Z6,H1,H2,OWN1,OWN2) 121 | CALL FIND(OWN2,Z6,Z8,H2) 122 | IF(H1<=0)GOTO1001 123 | CALL CHANGE(Z6,D1(Z6),1) 124 | IF((OWN2>='1').AND.(OWN2<='8')) CALL SONAR(Z6) 125 | AC=A(1,Z6) 126 | GOTO 1007 127 | 1001 CALL CHAS(Y,0) 128 | CALL CMYCOD(Y,0) 129 | 1003 IF(DISAS#1) CALL SENSOR(Z6) 130 | IF(DISAS==1) CALL SENSOR(Z7) 131 | 1002 CONTINUE 132 | RETURN 133 | END 134 | 135 | 136 | 137 | -------------------------------------------------------------------------------- /17.FOR: -------------------------------------------------------------------------------- 1 | 2 | !SUBROUTINE COLLECTION 17 3 | 4 | SUBROUTINE TROOPM(DUMMY) 5 | INCLUDE 'COMMON.EMP/NOLIST' 6 | DIMENSION OK(5) 7 | DATA OK/'.',' ','O','*','X'/ 8 | C THIS SUBROUTINE HANDLES ENEMY TROOP TRANSPORT MOVES 9 | 10 | MONKEY=0 11 | NUMBER(5)=0 12 | IF(CODER==5.) TYPE 3198 13 | 3198 FORMAT(' TROOP TRANSPORT CODES') 14 | 15 | DO 3200 Y=1,LIMIT(13) 16 | Z6=S(ITT2+Y) 17 | IF(Z6==0) GOTO 3200 18 | MONKEY=Y 19 | DIR=MOD(Y,2)*2-1 !SET DIR TO 1 OR -1 CONSISTENTLY 20 | AB=A(1,Z6) 21 | H1=H(ITT2H+Y) 22 | IF(AB=='X') H1=H1+1 23 | IF(H1>3) H1=3 24 | 25 | C NOW COMPUTE THE NUMBER OF ARMIES ABOARD THE TROOP TRANSPORT 26 | NUMARM=0 27 | DO 6003 I=1,LIMIT(9) 28 | 6003 IF(Z6==S(IAR2+I)) NUMARM=NUMARM+1 29 | IF(NUMARM>6) NUMARM=6 !6 IS MAX. # OF ARMIES ALLOWED 30 | 31 | DO 3195 ITURN=1,2 32 | P=0.0 33 | Z7=Z6 34 | AB=A(1,Z6) 35 | IF((ITURN==2).AND.(H1<=1)) GOTO 3200 36 | C MOVE SELECTION 37 | IFO=IFORM(CODE(Y+ITT2-1500)) 38 | ILA=ILATT(CODE(Y+ITT2-1500)) 39 | 40 | C 6000 IS THE STATEMENT # WHERE THE IFO AND ILA ARE 41 | C PROCESSED TO COME UP WITH A MOVE, WHICH IS THEN FED THRU MOVCOR 42 | C TO COME UP WITH A FINAL MOVE. 43 | 44 | C TAKE CARE OF DAMAGED SHIPS OR JUST REPAIRED SHIPS. 45 | C (DAMAGED SHIPS WILL HAVE AN IFO OF 8) 46 | 47 | IF(H1<3) GOTO 5998 48 | IF(IFO==8) IFO=0 49 | GOTO 6000 50 | 5998 IFO=8 51 | IF((ILA==0).OR.(A(1,ILA)#'X')) ILA=IPORT(Z6) 52 | GOTO 3175 53 | 54 | C IFO=10: MOVE TOWARD UNEXPLORED TERRITORY, LOCATION SPECIFIED BY ILA 55 | C IFO=7: MOVE IN A CONSTANT DIRECTION SPECIFIED BY ILA 56 | C IFO=9: MOVE TOWARD AN UNOWNED CITY SPECIFIED BY ILA 57 | C IFO=0-6: ILA SPECIFIES LOCATION OF WHERE TO MOVE, EITHER 58 | C AN ARMY PRODUCING CITY OR AN ARMY LOOKING FOR A '5'. 59 | C IT COULD ALSO BE A DIRECTION. IFO IS THE # OF ARMIES ON 60 | C BOARD THE TROOP TRANSPORT. 61 | 62 | 6000 IF(IFO<7) IFO=NUMARM 63 | IF(NUMARM==0) IFO=0 64 | IF((IFO==10).AND.(A(0,ILA)#' ')) GOTO 6020 65 | IF(IFO==10) GOTO 3175 66 | IF(IFO==7) GOTO 3173 67 | IF(IFO#9) GOTO 6300 68 | 69 | C IFO=9 70 | DO 6009 I=1,70 71 | 6009 IF(TARGET(I)==ILA) GOTO 3175 72 | IF((IDIST(Z6,ILA)<10).AND.(EDGER(ILA)<8.)) GOTO 3175 73 | C IT SEEMS THAT IT'S TARGET IS NO LONGER ON THE HIT LIST, 74 | C MEANING IT WAS CAPTURED. 75 | 76 | 6300 IF(IFO<=2) GOTO 6301 77 | IF(RAN(C1)<.2) GOTO 6020 !MOVE TOWARDS UNKNOWN TERRITORY 78 | GOTO 6011 !SELECT A TARGET 79 | 80 | C SELECT AN ARMY PRODUCING CITY AND MOVE TOWARDS IT. 81 | C PICK THE CLOSEST ONE. 82 | 6301 IF((ILA<=500).AND.(S(IAR2+ILA)#0)) GOTO 6002 83 | ID=500 84 | DO 6006 I=1,70 85 | IF((X(I)==0).OR.(OWNER(I)#2).OR.(PHASE(I)#1)) GOTO 6006 86 | IF(IDIST(Z6,X(I))>=ID) GOTO 6006 87 | I1=I 88 | ID=IDIST(Z6,X(I1)) 89 | ILA=X(I1) 90 | 6006 CONTINUE 91 | IF(ID#500) GOTO 3175 92 | 93 | C SELECT A RANDOM TARGET CITY 94 | 6011 IFO=9 95 | IA=INT(RAN(C1)*20.+1.) 96 | IB=IA+70 97 | DO 6007 IC=IA,IB 98 | I=IC 99 | IF(I>70) I=I-70 100 | IF(TARGET(I)==0) GOTO 6007 101 | ILA=TARGET(I) 102 | IF(EDGER(ILA)==0.) GOTO 6007 !IF SURROUNDED BY LAND 103 | CALL DIST(Z6,ILA) 104 | GOTO 3175 105 | 6007 CONTINUE 106 | 107 | C MOVE TOWARDS UNKNOWN TERRITORY 108 | 6020 IFO=10 109 | ILA=EXPL(DUMMY) 110 | IF(ILA==0) GOTO 6010 111 | CALL DIST(Z6,ILA) 112 | GOTO 3175 113 | 114 | C MOVE IN SPECIFIED DIRECTION (ILA SPECIFIES WHICH) 115 | 6010 IFO=7 116 | ILA=INT(RAN(C1)*8.+1.) 117 | GOTO 3173 118 | 119 | C NOW PICK A MOVE ACCORDING TO IFO AND ILA 120 | 6002 MOVE=0 121 | IF(IDIST(Z6,S(IAR2+ILA))==1) GOTO 3176 122 | MOVE=MOV(Z6,S(IAR2+ILA)) 123 | GOTO 3174 124 | 3175 MOVE=PATH(Z6,ILA,DIR,OK,FLAG) 125 | IF(FLAG==0) GOTO 6010 126 | GOTO 3174 127 | 3173 MOVE=ILA 128 | 3174 AGGR=FLOAT(-NUMARM) 129 | IF((NUMBER(5)>10).AND.(NUMARM==0)) AGGR=AGGR+2. 130 | IF(IABS(MOVE)>8) TYPE 7777,IFO,ILA,MOVE,CODE(Y+ITT2-1500) 131 | 7777 FORMAT(1X,4G) 132 | EXPLOR=0. 133 | IF(IFO>6) EXPLOR=1. 134 | MOVE=MOVE*DIR 135 | MOVE=MOVCOR(IFO,ITURN,Z6,MOVE,H1,1,AGGR,'5',EXPLOR,DIR) 136 | MOVE=IABS(MOVE) 137 | IF(IFO==7) ILA=MOVE 138 | 3176 CODE(ITT2-1500+Y)=10000*IFO+ILA 139 | Z6=Z6+IARROW(MOVE) 140 | IB=CODE(ITT2-1500+Y) 141 | IF(CODER==5.) TYPE 3197, IB 142 | 3197 FORMAT(1X,G) 143 | 144 | IF(D1(Z7)#'*') CALL CHANGE(Z7,D1(Z7),1) 145 | IF(A(1,Z6)=='.') GOTO 3201 146 | IF(A(1,Z6)=='X') GOTO 3202 147 | IF((A(1,Z6)=='+').OR.(D1(Z6)=='*')) GOTO 3203 148 | AB=A(1,Z6) 149 | TYPE 3297,AB 150 | 3297 FORMAT(' ATTACKING ',A1) 151 | IF(AB=='.') GOTO 3201 152 | P=1. 153 | H2=30 154 | OWN1='5' 155 | OWN2=A(1,Z6) 156 | CALL FIND(OWN2,Z6,Z8,H2) 157 | CALL FGHT(Z6,H1,H2,OWN1,OWN2) 158 | CALL FIND(OWN2,Z6,Z8,H2) 159 | IF(H1<=0) GOTO 3203 160 | IF(D1(Z6)=='+') GOTO 3203 161 | CALL CHITS(ITT2H+Y,H1) 162 | 3201 CALL CHANGE(Z6,'5',1) 163 | 3202 CALL CHAS(ITT2+Y,Z6) 164 | IF(ITURN==1) NUMBER(5)=NUMBER(5)+1 165 | GOTO 3204 166 | 3203 CALL CHAS(ITT2+Y,0) 167 | CALL CHITS(ITT2H+Y,0) 168 | 3204 N=0 169 | IF(P==1.) CALL SENSOR(Z6) 170 | DO 3205 U=IAR2+1,IAR2+LIMIT(9) 171 | IF(S(U)#Z7) GOTO 3205 172 | N=N+1 173 | CALL CHAS(U,Z6) 174 | IF(N>H1*2) CALL CHAS(U,0) 175 | IF(NUMARM>2*H1) NUMARM=2*H1 176 | 3205 CONTINUE 177 | CALL SONAR(Z6) 178 | 3195 CONTINUE 179 | 3200 CONTINUE 180 | LIMIT(13)=MONKEY 181 | RETURN 182 | END 183 | 184 | INTEGER FUNCTION EXPL 185 | INCLUDE 'COMMON.EMP/NOLIST' 186 | DATA STEP/37/,POSIT/65/,START/102/ 187 | 188 | C THIS SUBROUTINE SEARCHES FOR UNKNOWN TERRITORY AND RETURNS A VALUE 189 | C IN EXPL. 190 | 191 | IF(FULL==2) GOTO 300 192 | BEGPOS=START 193 | GOTO 101 194 | 100 IF((A(0,POSIT)==' ').AND.(ORDER(POSIT)==0)) GOTO 200 195 | 101 POSIT=POSIT+STEP 196 | IF(POSIT<5900) GOTO 100 197 | START=START+1 198 | POSIT=START 199 | IF(START==BEGPOS+37) GOTO 300 200 | GOTO 100 201 | 300 EXPL=0 202 | FULL=2 203 | C CALL CURSOR(0,KURSOR) 204 | C TYPE 103,POSIT,STEP,START,BEGPOS,KNOWN 205 | 103 FORMAT('+POSIT,STEP,START,BEGPOS,KNOWN:',5I5$) 206 | RETURN 207 | 200 EXPL=POSIT 208 | RETURN 209 | END 210 | 211 | 212 | 213 | 214 | . -------------------------------------------------------------------------------- /18.FOR: -------------------------------------------------------------------------------- 1 | 2 | ! SUBROUTINE COLLECTION 18 3 | 4 | 5 | 6 | SUBROUTINE ARMYEN(DUMMY) 7 | INCLUDE 'COMMON.EMP/NOLIST' 8 | DIMENSION OK(5) 9 | DATA OK/'+',' ','O','5','*'/ 10 | 11 | C THIS SUBROUTINE HANDLES ENEMY ARMY MOVES 12 | 13 | 3100 MONKEY=0 14 | NUMBER(1)=0 15 | IF(CODER==1.) TYPE 3189 16 | 3189 FORMAT(' ARMY CODES') 17 | 18 | C START ARMY MOVE LOOP 19 | DO 3190 Y=1,LIMIT(9) 20 | Z6=S(IAR2+Y) 21 | IF(Z6==0) GOTO 3190 22 | IF(.NOT.PASS) GOTO 7005 23 | CALL CURSOR(50) 24 | CALL DECPRT(Y) 25 | CALL CURSOR(60) 26 | CALL DECPRT(NPATH) 27 | NPATH=0 28 | 7005 NUMBER(1)=NUMBER(1)+1 29 | Z7=Z6 30 | MONKEY=Y 31 | DIR=MOD(Y,2)*2-1 !SET DIR TO 1 OR -1 32 | P=0.0 33 | AB=A(1,Z6) !SET AB=WHAT IS SHOWING WHERE THE ARMY IS 34 | IF((AB#'1').AND.(AB#'5').AND.(AB#'X')) GOTO 3101 35 | 36 | C AGE AR2S 37 | IF((AR2S(Y)<=100).OR.(AR2S(Y)>1000)) AR2S(Y)=AR2S(Y)-1 38 | IF((AR2S(Y)<0).OR.(AR2S(Y)==1000)) AR2S(Y)=0 39 | 40 | IF(AB#'5') GOTO 3102 41 | IF(ARMJMP(Z6,AR2S(Y))==0) GOTO 3190 42 | 43 | C MOVE SELECTION 44 | 3102 IFO=IFORM(CODE(Y)) 45 | ILA=ILATT(CODE(Y)) 46 | 47 | C IF A PRIORITY MOVE EXISTS, PICK IT AND DON'T BOTHER SLUGGING 48 | C THHROUGH CODE SELECTION AND MOVE SELECTION 49 | MOVE1=PRIORITY(Z6,IFO,ILA,DIR,AB) 50 | IF(MOVE1#0) GOTO 3143 51 | 52 | 53 | C IFO=0: MOVE IN CERTAIN DIRECTION, OR FOLLOW SHORE 54 | C IFO=1: MOVE TOWARDS TARGET CITY 55 | C IFO=2: MOVE TOWARDS AN ENEMY ARMY 56 | C IFO=3: MOVE TOWARDS A TROOP TRANSPORT 57 | 58 | GOTO (10,11,12,13) IFO+1 59 | 60 | 10 GOTO 100 !LOOK FOR TARGETS, LOCI, TT'S 61 | 62 | 11 IF(A(1,ILA)=='X') GOTO 100 !CITY HAS BEEN CAPTURED 63 | GOTO 201 !MOVE 64 | 65 | 12 IF(ILA==Z6) GOTO 100 !ARRIVED AT ENEMY CONCENTRATION 66 | GOTO 201 !MOVE 67 | 68 | 13 IF(ILA>100) GOTO 100 !INVALID VALUE FOR ILA 69 | IF(CODE(ILA+ITT2-1500)>=60000) GOTO 1030 !TT IS FULL 70 | IF(S(ILA+ITT2)==0) GOTO 1030 !TT SUNK 71 | IF(H(ILA+ITT2H)<3) GOTO 1030 !TT DAMAGED 72 | GOTO 202 73 | 74 | C SELECT A NEW CODE 75 | 100 CONTINUE 76 | 77 | C LOOK FOR TARGET CITY 78 | 1010 IA=INT(RAN(C1)*FLOAT(NUMBER(10))+1.0) 79 | IB=IA+NUMBER(10) 80 | DO 3122 IC=IA,IB 81 | I=IC 82 | IF(I>NUMBER(10)) I=I-NUMBER(10) 83 | IF(TARGET(I)==0) GOTO 3122 84 | IF(IDIST(Z6,TARGET(I))>20) GOTO 3122 85 | MOVE=PATH(Z6,TARGET(I),DIR,OK,FLAG) 86 | NPATH=NPATH+1 87 | IF(FLAG==0) GOTO 3122 !CAN'T GET TO IT 88 | IFO=1 89 | ILA=TARGET(I) 90 | GOTO 400 !MOVE 91 | 3122 CONTINUE 92 | 93 | C LOOK FOR AN ARMY THAT IS ON YOUR CONTINENT 94 | IF(LOCI(10,11)#0) LOCI(10,11)=0 95 | DO 101 I=1,10 96 | TEMP=INT(RAN(C1)*10.+2.) 97 | IF(LOCI(I,TEMP)==0) TEMP=2 98 | IF(LOCI(I,TEMP)==0) GOTO 101 99 | TEMP=LOCI(I,TEMP) 100 | MOVE=PATH(Z6,TEMP,DIR,OK,FLAG) 101 | NPATH=NPATH+1 102 | IF(FLAG==0) GOTO 101 103 | IFO=2 104 | ILA=TEMP 105 | GOTO 400 106 | 101 CONTINUE 107 | 108 | C LOOK FOR TT THAT IS SHORT OF ARMIES 109 | 1030 IF(AR2S(Y)#0) GOTO 6000 !INELIGIBLE TO GET ON A TT 110 | IA=INT(RAN(C1)*FLOAT(LIMIT(13))+1.0) 111 | DO 3126 IC=IA,IA+LIMIT(13) 112 | I=IC 113 | IF(I>LIMIT(13)) I=I-LIMIT(13) 114 | IF(S(ITT2+I)==0) GO TO 3126 !TT DOESN'T EXIST 115 | IF(H(ITT2H+I)<3) GOTO 3126 !DAMAGED, I.E. UNSUITABLE 116 | IF(IABS(CODE(ITT2+I-1500))>59999) GOTO 3126 !NOT TAKING ON ARMIES 117 | IF(IDIST(Z6,S(ITT2+I))>25) GOTO 3126 !TOO FAR AWAY 118 | C MOVE=PATH(Z6,S(ITT2+I),DIR,OK,FLAG) 119 | C IF(FLAG==0) GOTO 3126 !CAN'T GET TO IT 120 | MOVE=MOV(Z6,S(ITT2+I)) 121 | IFO=3 122 | ILA=I 123 | CODE(ITT2+I-1500)=IFORM(CODE(ITT2+I-1500))*10000+Y 124 | GOTO 400 125 | 3126 CONTINUE 126 | 127 | C PICK A RANDOM DIRECTION (IFO=0) 128 | 6000 IF((IFO==0).AND.(ILA#0)) GOTO 200 !IF ALREADY ASSIGNED DIRECTION 129 | IFO=0 130 | ILA=INT(RAN(C1)*8.+1.) 131 | C GOTO 200 132 | 133 | 200 MOVE=ILA 134 | I1=ICORR(MOVE-DIR*3) 135 | IF(A(1,Z6+IARROW(I1))#'+') MOVE=I1 136 | GOTO 400 137 | 201 MOVE=PATH(Z6,ILA,DIR,OK,FLAG) 138 | NPATH=NPATH+1 139 | IF(FLAG==0) GOTO 6000 140 | GOTO 400 141 | 202 MOVE=PATH(Z6,S(ILA+ITT2),DIR,OK,FLAG) 142 | NPATH=NPATH+1 143 | 144 | 400 DO 3137 I=0,7*DIR,DIR 145 | MOVE1=ICORR(MOVE+I) 146 | LOC=Z6+IARROW(MOVE1) 147 | AC=A(1,LOC) 148 | IF(AC#'5') GOTO 3132 149 | IF(AR2S(Y)#0) GOTO 3137 150 | NUMARM=0 151 | DO 4148 IZ=ITT2+1,LIMIT(13)+ITT2 152 | 4148 IF(S(IZ)==LOC) GOTO 4149 153 | 4149 IF(H(ITT2H-ITT2+IZ)<3) GOTO 3137 154 | DO 4177 IY=IAR2+1,LIMIT(9)+IAR2 155 | IF(S(IY)==LOC) NUMARM=NUMARM+1 156 | 4177 IF(NUMARM>=6) GOTO 3137 157 | GOTO 3143 158 | 3132 IF((AC=='+').AND.(ORDER(LOC)==0)) GOTO 3143 159 | 3137 CONTINUE 160 | MOVE1=0 161 | 162 | 3143 IF(IFO==0) ILA=IABS(MOVE1) 163 | CODE(Y)=IFO*10000+ILA 164 | IB=CODE(Y) 165 | IF(CODER==1.) TYPE 3136, IB 166 | 3136 FORMAT(1X,7I,3X) 167 | Z6=Z6+IARROW(MOVE1) 168 | 169 | AC=A(1,Z6) 170 | IF(AB#'5') GOTO 7000 171 | IF(AC=='5') GOTO 3104 172 | CODE(Y)=0 173 | AR2S(Y)=1020 174 | GOTO 7002 175 | 7000 IF(D1(Z7)#'*') CALL CHANGE(Z7,D1(Z7),1) 176 | IF(AC#'5') GOTO 7002 177 | AR2S(Y)=100 178 | GOTO 3104 179 | 7002 IF(AC=='+') GOTO 3105 180 | IF((AC=='X').OR.(AC=='.')) GOTO 3101 181 | IF(D1(Z6)#'*') GOTO 3106 182 | IF(RAN(C1)<.5) GOTO 3101 183 | DO 3110 I=1,70 184 | 3110 IF(TARGET(I)==Z6) TARGET(I)=0 185 | DO 3113 I=1,LIMIT(9) 186 | 3113 IF(CODE(I)==10000+Z6) CODE(I)=0 187 | DO 3114 I=1,100 188 | 3114 IF(X(I)==Z6) GOTO 3115 189 | 3115 OWNER(I)=2 190 | PHASE(I)=0 191 | IF(((AC=='O').OR.(AR2S(Y)>0)).AND.(EDGER(Z6)<8.)) PHASE(I)=-1 192 | IF(AC#'O') GOTO 3109 193 | CALL CURSOR(200) 194 | CALL STROUT('CITY AT ',10); CALL DECPRT(Z6) 195 | CALL STROUT(' SURRENDURED TO ENEMY FORCES. ',31) 196 | CALL CHANGE(Z6,'X',1) 197 | CALL SENSOR(Z6) 198 | GOTO 3101 199 | 3109 CALL CHANGE(Z6,'X',1) 200 | GOTO 3101 201 | 7001 AR2S(Y)=100 202 | GOTO 3104 203 | 3106 H1=1 204 | IF(Z7==Z6) GOTO 3104 205 | 6312 FORMAT(1H+,/,' ERROR: ATTACKED ',A1,4G,1X) 206 | P=1.0 207 | OWN1='1' 208 | OWN2=AC 209 | H2=30 210 | CALL FIND(OWN2,Z6,Z8,H2) 211 | CALL FGHT(Z6,H1,H2,OWN1,OWN2) 212 | CALL FIND(OWN2,Z6,Z8,H2) 213 | IF(H1<=0) GOTO 3101 214 | CALL CHANGE(Z6,D1(Z6),1) 215 | IF(A(1,Z6)=='.') GOTO 3101 216 | 3105 CALL CHANGE(Z6,'1',1) 217 | 3104 CALL CHAS(IAR2+Y,Z6) 218 | IF(P==1.0) CALL SENSOR(Z6) 219 | GOTO 3108 220 | 3101 CALL CHAS(IAR2+Y,0) 221 | C IF((AC=='.').OR.((AC=='X').AND.(Z6#Z7))) 222 | C &TYPE 6312,AC,CODE(Y),MOVE1,Z7,Z6 223 | IF(AC#'X') GOTO 6310 224 | DO 6311 I=1,70 225 | 6311 IF(X(I)==Z6) PHASE(I)=0 226 | 6310 IF(P==1.) CALL SENSOR(Z6) 227 | IF(A(1,Z6)#'O') GOTO 3118 228 | CALL CURSOR(200) 229 | CALL STROUT('CITY AT ',10); CALL DECPRT(Z6) 230 | CALL STROUT(' REPELLED ENEMY INVASION. ',31) 231 | 3118 CODE(Y)=0 232 | AR2S(Y)=0 233 | 3108 CALL SONAR(Z6) 234 | 3190 CONTINUE 235 | LIMIT(9)=MONKEY 236 | RETURN 237 | END 238 | 239 | 240 | INTEGER FUNCTION ARMJMP(Z6,AR2SC) 241 | INCLUDE 'COMMON.EMP/NOLIST' 242 | 243 | C THIS SUBROUTINE DETERMINES WHETHER OR NOT AN ARMY SHOULD GET OFF 244 | C THE TROOP TRANSPORT IT IS ON. 0=NO; 1=YES 245 | 246 | ARMJMP=0 247 | DO 100 I=1,8 248 | 100 IF(D1(Z6+IARROW(I))#'.') GOTO 101 !NOT ALL SEA SURROUNDINGS 249 | RETURN 250 | 251 | 101 IF(AR2SC==0) GOTO 103 !BEEN ON TROOP TRANSPORT 252 | !FOR A LONG TIME 253 | DO 102 I=1,8 254 | LOC=Z6+IARROW(I) 255 | IF(D1(LOC)=='.') GOTO 102 256 | IF(ORDER(LOC)#0) GOTO 102 257 | AB=A(1,LOC) 258 | IF((AB=='A').OR.(AB=='F')) GOTO 103 259 | IF((AB=='*').OR.(AB=='O')) GOTO 103 260 | LOC=Z6+2*IARROW(I) 261 | AB=A(0,LOC) 262 | IF(AB==' ') GOTO 103 263 | 102 CONTINUE 264 | RETURN !DON'T JUMP 265 | 103 ARMJMP=1 266 | RETURN !JUMP 267 | END 268 | 269 | 270 | 271 | 272 | SUBROUTINE DIST(Z6,ILA) 273 | INCLUDE 'COMMON.EMP/NOLIST' 274 | C THIS SUBROUTINE SETS AR2S SO THAT THE ARMY WON'T GET 275 | C OFF THE TROOP TRANSPORT PREMATURELY 276 | 277 | ID=2*IDIST(Z6,ILA)+1 278 | DO 6012 L=1+IAR2,LIMIT(9)+IAR2 279 | 6012 IF(S(L)==Z6) AR2S(L-IAR2)=ID 280 | RETURN 281 | END 282 | 283 | 284 | INTEGER FUNCTION PRIORITY(Z6,IFO,ILA,DIR,AC) 285 | INCLUDE 'COMMON.EMP/NOLIST' 286 | DIMENSION PRIOR(7) 287 | 288 | CALL SET(PRIOR,7,0) 289 | EXPMAX=0 290 | 291 | C NOW MAKE A GUESS AS TO WHAT THE MOVE WILL BE 292 | MOVE1=ILA 293 | IF(IFO#0) MOVE1=MOV(Z6,ILA) 294 | IF(IFO==3) MOVE1=MOV(Z6,S(ITT2+ILA)) 295 | 296 | C NOW SEE IF ANY PRIORITY MOVES EXIST 297 | DO 100 I=0,7*DIR,DIR 298 | MOVE=ICORR(MOVE1+I) 299 | LOC=Z6+IARROW(MOVE) 300 | IF(ORDER(LOC)#0) GOTO 100 301 | AB=A(1,LOC) 302 | 303 | C CHECK IF ARMY CAN ATTACK SOMETHING OVER WATER 304 | GROUND=D1(LOC) 305 | OK='YES' 306 | IF((AC=='5').AND.(GROUND=='.')) OK='NO' 307 | 308 | IF(AB=='O') PRIOR(1)=MOVE 309 | IF((AB=='T').AND.(OK=='YES')) PRIOR(3)=MOVE 310 | IF(AB=='*') PRIOR(2)=MOVE 311 | IF(AB=='A') PRIOR(5)=MOVE 312 | IF((AB=='S').AND.(OK=='YES')) PRIOR(6)=MOVE 313 | IF((IFO==0).AND.(AB>='A').AND.(AB<='T').AND.(OK=='YES')) 314 | & PRIOR(7)=MOVE 315 | 316 | IF(GROUND#'+') GOTO 100 317 | N=0 318 | IF(A(0,LOC+IARROW(ICORR(MOVE-2)))==' ') N=1 319 | IF(A(0,LOC+IARROW(ICORR(MOVE-1)))==' ') N=N+1 320 | IF(A(0,LOC+IARROW(MOVE))==' ') N=N+1 321 | IF(A(0,LOC+IARROW(ICORR(MOVE+1)))==' ') N=N+1 322 | IF(A(0,LOC+IARROW(ICORR(MOVE+2)))==' ') N=N+1 323 | C TYPE 478,N,EXPMAX 324 | 478 FORMAT(' N:',I2,' EXPMAX:',I2) 325 | IF(N<=EXPMAX) GOTO 100 326 | PRIOR(4)=MOVE 327 | EXPMAX=N 328 | 100 CONTINUE 329 | C TYPE 479 330 | 479 FORMAT(' XXXXXXXXXXXXXXXX') 331 | 332 | C NOW SELECT THE HIGHEST PRIORITY MOVE 333 | DO 200 I=1,7 334 | 200 IF(PRIOR(I)#0) GOTO 300 335 | PRIORITY=0 336 | RETURN 337 | 300 PRIORITY=PRIOR(I) 338 | RETURN 339 | END 340 | 341 | -------------------------------------------------------------------------------- /2.FOR: -------------------------------------------------------------------------------- 1 | 2 | 3 | * TEST ROUTINES FOR PATH 4 | 5 | SUBROUTINE TEST3(Z5) 6 | INCLUDE 'COMMON.EMP/NOLIST' 7 | DIMENSION OK(5),COMM(30) 8 | DATA OK/'+',' ','O','5','*'/ 9 | DATA COMM/'D','E','W','Q','A','Z','X','C','S', 10 | & 'Q','B','F','T','G','W','J',-1,-1,-1,'O','P','R','I','M','K','H', 11 | & 'S','?','Y','L'/ 12 | 13 | !Q: REFRESH SCREEN 14 | !B: TYPE BEG 15 | !F: TYPE END 16 | !T: TRACE 17 | !G: GO 18 | !O: RETURN 19 | !W: DIR=-DIR 20 | 21 | Z6=Z5 22 | WHTFLG=0 23 | MOVFLG=0 24 | OLDJ=JECTOR 25 | CALL SECTOR(2) 26 | call cursor(240) 27 | call strout('Editor ',21) 28 | 1000 LINE=KLINE(KI,JECTOR) 29 | IADJST=LINE+KI-300 30 | IF(Z6==0) Z6=IADJST+1240 31 | DIR=1 32 | 100 CALL CURSOR(Z6-IADJST) 33 | CALL ECHOFF 34 | CALL OUTCHR("7) 35 | E=GETCHX(E) 36 | Z7=Z6 37 | DO 101 I=1,8 38 | 101 IF(E==COMM(I)) Z6=Z6+IARROW(I) 39 | IF(ORDER(Z6)==0) GOTO 1001 40 | Z6=Z7 41 | GOTO 2000 42 | 1001 IF(Z6==Z7) GOTO 102 43 | GOTO 100 44 | 102 DO 103 I=10,30 45 | J=I 46 | 103 IF(E==COMM(I)) GOTO 104 47 | GOTO 2000 48 | 104 IF(PASS) GOTO (10,11,12,13,14,16,17,18,19) J-9 49 | GOTO (15,21,22,23,24,25,26,27,28,29,30) J-19 50 | GOTO 2000 51 | 10 ISEC=-1 52 | CALL SECTOR(0) 53 | GOTO 100 54 | 11 BEG=Z6 55 | CALL OUTCHR("102) 56 | GOTO 100 57 | 12 END=Z6 58 | CALL OUTCHR("105) 59 | GOTO 100 60 | 13 FLAG=1000 61 | CALL ECHOON 62 | CALL PATH(BEG,END,DIR,OK,FLAG) 63 | CALL ECHOFF 64 | GOTO 100 65 | 14 FLAG=1001 66 | CALL ECHOON 67 | CALL PATH(BEG,END,DIR,OK,FLAG) 68 | CALL ECHOFF 69 | GOTO 100 70 | 15 CALL ECHOON 71 | JECTOR=OLDJ !RESTORE SECTOR NUMBER 72 | call cursor(240) 73 | call outstr(' ') 74 | CALL SECTOR(2) 75 | RETURN 76 | 16 DIR=-DIR 77 | GOTO 100 78 | 17 H2=30 79 | OWN2=A(1,Z6) 80 | CALL FIND(OWN2,Z6,Z8,H2) 81 | CODNUM=CODE(Z8-1500) 82 | CALL CURSOR(50) 83 | CALL STROUT(' code:',0) 84 | TYPE 147,CODNUM 85 | 147 FORMAT('+ ',I7,1X$) 86 | GOTO 100 87 | 18 CONTINUE 88 | 19 CONTINUE 89 | 20 CONTINUE 90 | STOP 91 | 92 | *P: PRINT OUT NEW SECTOR 93 | 21 ISEC=-1 94 | CALL CURSOR(240) 95 | CALL STROUT(' New sector:',0) 96 | CALL ECHOON 97 | CALL OUTCHR("7) 98 | E=GETCHX(E) 99 | JECTOR=IPHASE(E) 100 | CALL SECTOR(2) 101 | ISEC=-1 102 | Z6=0 103 | call cursor(240) 104 | call strout('Editor ',21) 105 | GOTO 1000 106 | 107 | *R: PRINT OUT THE ROUND NUMBER 108 | 22 CALL CURSOR(140) 109 | CALL STROUT(' Round #',0) 110 | CALL DECPRT(MDATE) 111 | CALL SPACE 112 | GOTO 100 113 | 114 | *I: DIRECTIONAL STASIS 115 | 23 AB=A(1,Z6) 116 | IF((AB<'A').OR.(AB>'T')) GOTO 2000 117 | CALL OUTCHR("7) 118 | E=GETCHX(E) 119 | DO 200 I=1,8 120 | J=I 121 | 200 IF(COMM(I)==E) GOTO 201 122 | GOTO 2000 123 | 201 IF(AB#'O') GOTO 202 124 | FIPATH(CITFND(Z6))=J+6100 125 | GOTO 100 126 | 202 H2=30 127 | CALL FIND(AB,Z6,MOVFLG,H2) 128 | CALL CMYCOD(MOVFLG,J+6100) 129 | GOTO 100 130 | 131 | *M: SAY WE WANT TO MOVE TO A LOCATION 132 | 24 AB=A(1,Z6) 133 | IF((AB<'A').OR.(AB>'T')) GOTO 2000 134 | IF(AB#'O') GOTO 301 135 | WHTFLG='CITY' 136 | MOVFLG=CITFND(Z6) 137 | GOTO 100 138 | 301 H2=30 139 | CALL FIND(AB,Z6,MOVFLG,H2) 140 | WHTFLG='UNIT' 141 | GOTO 100 142 | 143 | *K: WAKE UP 144 | 25 AB=A(1,Z6) 145 | IF((AB<'A').OR.(AB>'T')) GOTO 2000 146 | IF(AB#'O') GOTO 401 147 | FIPATH(CITFND(Z6))=0 148 | GOTO 100 149 | 401 H2=30 150 | CALL FIND(AB,Z6,MOVFLG,H2) 151 | CALL CMYCOD(MOVFLG,0) 152 | GOTO 100 153 | 154 | *H: GO HERE 155 | 26 IF(WHTFLG#'CITY') GOTO 501 156 | FIPATH(MOVFLG)=Z6 157 | GOTO 100 158 | 501 IF(WHTFLG#'UNIT') GOTO 2000 159 | CALL CMYCOD(MOVFLG,Z6) 160 | GOTO 100 161 | 162 | *S: GOTO SLEEP 163 | 27 AB=A(1,Z6) 164 | IF((AB<'A').OR.(AB>'T')) GOTO 2000 165 | IF(AB=='O') GOTO 2000 166 | H2=30 167 | CALL FIND(AB,Z6,MOVFLG,H2) 168 | CALL CMYCOD(MOVFLG,50) 169 | GOTO 100 170 | 171 | *?: REQUEST INFO 172 | 28 AB=A(1,Z6) 173 | IF((AB=='X').AND.(PASS)) GOTO 601 174 | IF((AB<'A').OR.(AB>'T')) GOTO 2000 175 | IF(AB=='O') GOTO 601 176 | IF((AB=='A').OR.(AB=='F')) GOTO 604 177 | H2=30 178 | CALL FIND(AB,Z6,MOVFLG,H2) 179 | CALL CURSOR(40) 180 | CALL STROUT(' Hits left:',0) 181 | CALL DECPRT(H(MOVFLG-700)) 182 | CALL SPACE 183 | 604 CALL STSOUT(MYCODE(MOVFLG)) 184 | GOTO 100 185 | 601 J=CITFND(Z6) 186 | CALL CURSOR(200) 187 | CALL STROUT(' Location:',0) ; CALL DECPRT(Z6) 188 | CALL STROUT(' Producing:',0) 189 | DO 602 I=1,8 190 | 602 IF(PHASE(J)==PHAZE(I+8)) TYPE 603,PHAZE(I) 191 | 603 FORMAT('+',A1,$) 192 | CALL STROUT(' Completion:',0) ; CALL DECPRT(FOUND(J)) 193 | CALL STROUT(' FPath:',0) 194 | IF(FIPATH(J)<100) CALL STROUT('Sit',0) 195 | IF((FIPATH(J)>100).AND.(FIPATH(J)<6000)) CALL DECPRT(FIPATH(J)) 196 | IF(FIPATH(J)>6100) TYPE 603, COMM(FIPATH(J)-6100) 197 | CALL SPACE 198 | GOTO 100 199 | 200 | *Y: ENTER NEW PHASE 201 | 29 AB=A(1,Z6) 202 | IF(AB#'O') GOTO 2000 203 | J=CITFND(Z6) 204 | CALL CURSOR(40) 205 | CALL STROUT('New production:',0) 206 | CALL PHASIN(J) 207 | GOTO 100 208 | 209 | *L: SET ARMY TO MOVE AT RANDOM 210 | 30 AB=A(1,Z6) 211 | IF(AB#'A') GOTO 2000 212 | H2=30 213 | CALL FIND(AB,Z6,MOVFLG,H2) 214 | CALL CMYCOD(MOVFLG,100) 215 | GOTO 100 216 | 217 | 2000 CALL HUH 218 | GOTO 100 219 | END 220 | 221 | 222 | SUBROUTINE HUH 223 | CALL CURSOR(40) 224 | CALL STROUT(' Huh? ',0) 225 | END 226 | 227 | SUBROUTINE SPACE 228 | CALL STROUT('',50) 229 | END 230 | 231 | INTEGER FUNCTION CITFND(Z6) 232 | INCLUDE 'COMMON.EMP/NOLIST' 233 | DO 100 I=1,70 234 | 100 IF(X(I)==Z6) GOTO 101 235 | IF(.NOT.PATH) RETURN 236 | CALL STROUT('CITFND ERROR',0) 237 | RETURN 238 | 101 CITFND=I 239 | RETURN 240 | END 241 | 242 | SUBROUTINE DIREC 243 | CALL CURSOR(140) 244 | CALL STROUT(' Read the directions! ',0) 245 | END 246 | 247 | SUBROUTINE PHASIN(NUM) 248 | INCLUDE 'COMMON.EMP/NOLIST' 249 | CALL ECHOON 250 | CALL OUTCHR("7) 251 | E=GETCHX(E) 252 | DO 100 I=1,8 253 | 100 IF(E==PHAZE(I)) GOTO 101 254 | CALL HUH 255 | RETURN 256 | 101 PHASE(NUM)=PHAZE(I+8) 257 | FOUND(NUM)=MDATE+6*PHASE(NUM) 258 | RETURN 259 | END 260 | 261 | SUBROUTINE TEST4(Z6,FLAG,DIR,MOVE1,MOVNUM,BEG, 262 | & END,G2,FLAG2) 263 | IMPLICIT INTEGER(A-Z) 264 | COMMON/KXK/IADJST 265 | DIMENSION G2(100) 266 | 267 | CALL CURSOR(Z6-IADJST,KURSOR) 268 | IF(FLAG2=='MOV') CALL OUTCHR("107) 269 | IF(FLAG2=='SHORE') CALL OUTCHR("110) 270 | IF(FLAG==1001) RETURN 271 | CALL OUTCHR("7) 272 | E=GETCHX(E) 273 | IF(E==' ') RETURN 274 | IF(E=='G') GOTO 100 275 | CALL CURSOR(0,KURSOR) 276 | TYPE 101,Z6,MOVE1,MOVNUM 277 | 101 FORMAT(' Z6:',I4,' MOVE1:',I1,' MOVNUM:',I3) 278 | CALL CURSOR(100,KURSOR) 279 | TYPE 103,BEG,END,IADJST,DIR,FLAG 280 | 103 FORMAT(' BEG:'I4' END:'I4' IADJST:'I4' DIR:'I2' FLAG:'I4) 281 | TYPE 104,FLAG2 282 | 104 FORMAT(' FLAG2:',A5) 283 | RETURN 284 | 100 CALL CURSOR(0,KURSOR) 285 | TYPE 102,G2 286 | 102 FORMAT(1X,16I5) 287 | RETURN 288 | END 289 | 290 | 291 | 292 | 293 | . -------------------------------------------------------------------------------- /3.FOR: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | C SUBROUTINE 3 6 | FUNCTION VICTRY(H1,H2) 7 | SUM=0.0 8 | END=H1-1. 9 | R=H1+H2-1. 10 | DO 100 Y=0.,END 11 | 100 SUM=SUM+1./(FAC(Y)*FAC(R-Y)) 12 | VICTRY=SUM*FAC(R)*(.5^R) 13 | RETURN 14 | END 15 | 16 | FUNCTION FAC(X) 17 | FAC=1.0 18 | IF(X.LT.2)RETURN 19 | DO 1 I=2,INT(X) 20 | 1 FAC=FAC*FLOAT(I) 21 | RETURN 22 | END 23 | 24 | 25 | FUNCTION COST(OWN,H) 26 | REAL COSTAB(14),COSVAL(14) 27 | DATA COSVAL/1.,1.,2.,3.,2.,4.,3.,1.,4.,5.,6.,10.,14.,15./ 28 | DATA COSTAB/'F','D','S','T','R','C','B', 29 | & '2','3','4','5','6','7','8'/ 30 | DO 1 I=1,14 31 | 1 IF(OWN==COSTAB(I))GO TO 2 32 | COST=0. 33 | RETURN 34 | 2 COST=COSVAL(I) 35 | IF(I>=9)COST=COST-H 36 | RETURN 37 | END 38 | 39 | SUBROUTINE LTR(Z6,ITURN) 40 | REAL D2(0:2) 41 | INTEGER L6,Z6 42 | REAL G2(0:6) 43 | COMMON/MODE/MODE,KURSOR,JECTOR ,ISEC 44 | COMMON/IARROW/IARROW(0:9) 45 | IF(MODE#1)GOTO202;CALL SENSOR(Z6); RETURN 46 | 202 IF(ITURN#1) GOTO 301 47 | DO 5000 I7=1,8 48 | I8=Z6+IARROW(I7) 49 | 5000 IF(A(1,I8)#A(2,I8)) GOTO 5001 50 | GOTO 301 51 | 5001 TYPE 100 52 | 100 FORMAT(' BEFORE SENSOR PROBE') 53 | L6=Z6 54 | IF(L6<101) L6=L6+100 55 | IF(L6>5900) L6=L6-100 56 | IF(L6/100*100==L6) L6=L6-1 57 | IF(L6/100*100+1==L6) L6=L6+1 58 | DO 600 I=-101,99,100 59 | DO 659 I9=0,2 60 | 659 D2(I9)=D1(L6+I+I9) 61 | DO 660 I9=0,2 62 | 660 G2(I9)=A(2,L6+I+I9) 63 | 600 TYPE 200,(G2(J),J=0,2),(D2(J),J=0,2) 64 | 200 FORMAT(1X,3A1,3X,3A1) 65 | CALL SENSOR(Z6) 66 | TYPE 300 67 | 300 FORMAT(' AFTER SENSOR PROBE') 68 | 301 L6=Z6 69 | IF(L6<301) L6=L6+300-(L6-1)/100*100 70 | IF(L6>5700) L6=L6-(L6-1)/100*100+5600 71 | IF((L6-1)/100*100+97L6) L6=L6/100*100+4 73 | DO 500 I=-303,297,100 74 | DO 661 I9=0,6 75 | 661 G2(I9)=A(2,L6+I+I9) 76 | 500 TYPE 400, (G2(J),J=0,6) 77 | 400 FORMAT(1X,7A1) 78 | 201 CALL STROUT('',1) 79 | RETURN 80 | END 81 | 82 | 83 | 84 | 85 | 86 | SUBROUTINE TEST(J) 87 | TYPE 100,J 88 | 100 FORMAT(1X/' TEST POINT-',G$/) 89 | RETURN 90 | END 91 | 92 | 93 | 94 | . -------------------------------------------------------------------------------- /4.FOR: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | * SUBROUTINE 4 6 | 7 | SUBROUTINE FIND(OWN,Z6,Z8,H2) 8 | C CROSS-REFERENCE SUBROUTINE, IT FINDS DATA ON WHATEVER 9 | CRAFT IS AT POINT Z6. 10 | INCLUDE 'COMMON.EMP/NOLIST' 11 | 12 | IF(H2>0)GOTO 1010 13 | 14 | * NOW WE MUST DESTROY OWN 15 | * FIRST OF ALL, UPDATE TROOPT 16 | ISHP=0 17 | IF(OWN=='D') ISHP=1 18 | IF(OWN=='S') ISHP=2 19 | IF(OWN=='T') ISHP=3 20 | IF(OWN=='R') ISHP=4 21 | IF(OWN=='C') ISHP=5 22 | IF(OWN=='B') ISHP=6 23 | IF(ISHP==0) GOTO 3100 24 | DO 3000 Z=1,5 25 | 3000 IF(TROOPT(ISHP,Z)==Z6) TROOPT(ISHP,Z)=0 26 | 27 | * NOW DESTROY THE CRAFT, SET S(N)=0 28 | 29 | 3100 IF(OWN#'C') GOTO 3001 30 | DO 1000 Z=1,200 31 | IF(S(500+Z)#Z6) GOTO1000;CALL CHAS(500+Z,0) 32 | IF(MODE==1) CALL CURSOR(300,KURSOR) 33 | TYPE 1002,Z 34 | 1002 FORMAT('+FIGHTER #'I3' SUNK.'$) 35 | 1000 CONTINUE 36 | 37 | 3001 IF(OWN#'T') GOTO 1006 38 | DO 1007 Z=1,500 39 | IF(S(Z)#Z6) GOTO 1007 40 | CALL CHAS(Z,0) 41 | IF(MODE==1) CALL CURSOR(300,KURSOR) 42 | TYPE 1008,Z 43 | 1008 FORMAT('+ARMY #'I3' SUNK.'$) 44 | 1007 CONTINUE 45 | 46 | 1006 IF(OWN#'5') GOTO 1005 47 | DO 1009 Z=1501,2000 48 | 1009 IF(S(Z)==Z6) CALL CHAS(Z,0) 49 | 50 | 1005 IF(OWN#'7') GOTO 1003 51 | DO 1004 Z=2001,2200 52 | 1004 IF(S(Z)==Z6) CALL CHAS(Z,0) 53 | 54 | 1003 CALL CHAS(Z8,0) 55 | IF((OWN>='1').AND.(OWN<='8')) CALL SONAR(Z6) 56 | IF((OWN>='A').AND.(OWN<='T')) CALL SENSOR(Z6) 57 | RETURN 58 | 59 | 1010 IF(H2==30) GOTO 1011 60 | IF((OWN=='A').OR.(OWN=='F').OR.(OWN=='1').OR.(OWN=='2')) 61 | & GOTO 1760 62 | IF((OWN>='A').AND.(OWN<='T')) CALL CHITS(Z8-700,H2) 63 | IF((OWN>='1').AND.(OWN<='8')) CALL CHITS(Z8-1400,H2) 64 | GOTO 1760 65 | 1011 H2=0 66 | IA=1 67 | IF(OWN=='T') IA=1101 68 | IF(OWN=='C') IA=1301 69 | IF(OWN=='5') IA=2601 70 | IF(OWN=='7') IA=2801 71 | DO 1761 Z8=IA,3000 72 | 1761 IF(S(Z8)==Z6) GOTO 1762 73 | IF(PASS) TYPE 1763 74 | 1763 FORMAT(' ERROR IN SUB. FIND') 75 | GOTO 1760 76 | 1762 IF((OWN=='A').OR.(OWN=='F').OR.(OWN=='1').OR.(OWN=='2')) 77 | &H2=1 78 | IF(H2==1) GOTO 1760 79 | IF((OWN>='A').AND.(OWN<='T')) H2=H(Z8-700) 80 | IF((OWN>='1').AND.(OWN<='8')) H2=H(Z8-1400) 81 | 1760 RETURN 82 | END 83 | 84 | FUNCTION POSCHK(Z6) 85 | * DETERMINES IF Z6 IS IN CURRENT SECTOR SHOWING 86 | INTEGER Z6 87 | COMMON/MODE/MODE,KURSOR,JECTOR,ISEC 88 | IF(MODE==1) GOTO 400; POSCHK=1.; GOTO 200 89 | 400 JECT=JECTOR 90 | IF(JECTOR<0) TYPE 500,JECTOR 91 | 500 FORMAT(1XG) 92 | POSCHK=0. 93 | IY=(Z6-1)/100 94 | IX=Z6-IY*100 95 | IF(JECT>3) GOTO 100;IF(IX>50) GOTO 200;GOTO 300 96 | 100 IF(IX<51) GOTO 200;JECT=JECT-4 97 | 300 IF((IYJECT*15+14)) GOTO 200 98 | POSCHK=1. 99 | 200 RETURN 100 | END 101 | 102 | 103 | . -------------------------------------------------------------------------------- /5.FOR: -------------------------------------------------------------------------------- 1 | 2 | C SUBROUTINE 5 3 | 4 | SUBROUTINE SHIPMV (CRALOC,CRAHIT,NUM,OWN1,HITMAX) 5 | INCLUDE 'COMMON.EMP/NOLIST' 6 | 7 | DO 2500 Y=1,LIMIT(NUM) 8 | DO 2499 ITURN=1,2 9 | LOC=CRALOC+Y 10 | Z6=S(LOC) 11 | IF(Z6==0) GOTO 2500 12 | JIT=CRAHIT+Y 13 | H1=H(JIT) 14 | IF((ITURN==2).AND.(H1<=HITMAX/2)) GOTO 2500 15 | IF((MODE==1).AND.(POSCHK(Z6)==0.)) GOTO 2500 16 | Z7=Z6 17 | AB=A(1,Z6) 18 | H1=H(JIT) 19 | 20 | * CHECK TO SEE IF SHIP WAS DESTROYED (IF THE CITY IT WAS IN WAS CAPTURED). 21 | IF((AB==OWN1).OR.(AB=='O')) GOTO 4000 22 | CALL HEAD(OWN1,Y,Z6) 23 | CALL STROUT(' DESTROYED. ',31) 24 | GOTO 2505 25 | 26 | 4000 IF((ITURN==1).AND.(AB=='O')) H1=H1+1 27 | IF(H1>HITMAX) H1=HITMAX 28 | CALL STASIS(Z6,LOC) 29 | 3000 MYCOD=MYCODE(LOC) 30 | IF(MYCOD==0) GOTO 2541 31 | IF((MYCOD#9997).OR.((OWN1#'T').AND.(OWN1#'C'))) GOTO 3001 32 | N=0 33 | NT=2 34 | IA=1 35 | IB=LIMIT(1) 36 | IF(OWN1#'C') GOTO 3003 37 | NT=1 38 | IA=501 39 | IB=LIMIT(2)+500 40 | 3003 DO 3002 J=IA,IB 41 | 3002 IF(S(J)==Z6) N=N+1 42 | IF(N6108)) GOTO 2545 46 | IF(MYCOD<=6000) GOTO 2542 47 | IF(MYCOD>6100) GOTO 2543 48 | GOTO 2545 49 | 2542 Z6=Z6+IARROW(MOV(Z6,MYCOD)) 50 | IF(Z6==MYCOD) CALL CMYCOD(LOC,0) 51 | GOTO 2544 52 | 2543 Z6=Z6+IARROW(MYCOD-6100) 53 | 2544 AD=A(1,Z6) 54 | IF(((AD=='.').OR.(AD=='O')).AND.(ORDER(Z6)==0)) GOTO 2545 55 | Z6=Z7 56 | CALL SECTOR(2) 57 | CALL CURSOR(100) 58 | CALL STSOUT(MYCOD) 59 | 2541 CALL SECTOR(2) 60 | 2513 CALL LTR(Z6,ITURN) 61 | CALL HEAD(OWN1,Y,Z6) 62 | CALL MVE(OWN1,MDATE,LOC,JIT,Z6,Z7,DISAS,Z6-IADJST) 63 | IF(DISAS==-2) GOTO 3000 64 | 65 | 66 | * MOVE EVALUATION 67 | 2545 IF(D1(Z7)#'*') CALL CHANGE(Z7,D1(Z7),1) 68 | IF(DISAS==1) GOTO 2505 69 | AB=A(1,Z6) 70 | IF(AB#'O') GOTO 2511 71 | CALL CURSOR(100) 72 | CALL STROUT('SHIP IS DOCKED. ',31) 73 | GOTO 2512 74 | 2511 IF((AB#'+').AND.(D1(Z6)#'*')) GOTO 2506 75 | 2507 CALL CURSOR(100) 76 | CALL IDEN(OWN1) 77 | CALL STROUT('BROKE UP ON THE SHORE. ',31) 78 | 2505 CALL CHAS(LOC,0) 79 | CALL CMYCOD(LOC,0) 80 | IF(DISAS==1) CALL SENSOR(Z7) 81 | IF(DISAS#1) CALL SENSOR(Z6) 82 | H1=0 83 | GOTO 2533 84 | 2506 IF(AB#'.') GOTO 2509 85 | 2510 CALL CHANGE(Z6,OWN1,1) 86 | 2512 CALL CHAS(LOC,Z6) 87 | CALL CHITS(JIT,H1) 88 | CALL SENSOR(Z6) 89 | 2533 IF((OWN1#'T').AND.(OWN1#'C')) GOTO 2499 90 | N=0 91 | IA=0; IB=LIMIT(1); NT=2 92 | IF(OWN1#'C') GOTO 2534; IA=500; IB=LIMIT(2); NT=1 93 | 2534 DO 2535 I=IA+1,IA+IB 94 | IF(S(I)#Z7) GOTO 2535 95 | CALL CHAS(I,Z6) 96 | N=N+1 97 | IF(N<=NT*H1) GOTO 2535 98 | CALL CHAS(I,0) 99 | CALL CURSOR(100) 100 | IF(OWN1=='C') GOTO 2536 101 | CALL STROUT('ARMY #',0) 102 | GOTO 2538 103 | 2536 CALL STROUT('FIGHTER #',0) 104 | 2538 CALL DECPRT(I-IA); CALL STROUT(' WAS SUNK. ',31) 105 | 2535 CONTINUE 106 | GOTO 2499 107 | 2509 H2=30 108 | OWN2=AB 109 | CALL FIND(OWN2,Z6,Z8,H2) 110 | CALL FGHT(Z6,H1,H2,OWN1,OWN2) 111 | CALL FIND(OWN2,Z6,Z8,H2) 112 | IF(H1<=0) GOTO 2505 113 | IF((OWN2>='1').AND.(OWN2<='8')) CALL SONAR(Z6) 114 | CALL CHANGE(Z6,D1(Z6),1) 115 | IF(A(1,Z6)#'.') GOTO 2507 116 | GOTO 2510 117 | 2499 CONTINUE 118 | 2500 CONTINUE 119 | RETURN 120 | END 121 | 122 | 123 | SUBROUTINE FIGHMV 124 | INCLUDE 'COMMON.EMP/NOLIST' 125 | 126 | DO 2001 Y=1,LIMIT(2) 127 | Z3=MOD(RANGE(Y),4) 128 | IF(Z3==0) Z3=4 129 | DO 2010 ITURN=1,Z3 130 | LOC=500+Y 131 | Z6=S(LOC) 132 | IF(Z6==0) GOTO 2001 133 | IF((MODE==1).AND.(POSCHK(Z6)==0.)) GOTO 2001 134 | AB=A(1,Z6) 135 | 136 | * NOW CHECK TO SEE IF FIGHTER IS IN A CITY; IF IT IS CHANGE THE 137 | * STASIS # OF THE FIGHTER TO THAT SPECIFIED BY FIPATH(I) 138 | IF(AB#'O') GOTO 2100 !IF FIGHTER NOT IN CITY 139 | DO 2101 I=1,70 140 | 2101 IF(X(I)==Z6) GOTO 2102 !FIND CITY # OF CITY AT Z6 141 | 2102 CALL CMYCOD(LOC,FIPATH(I)) !CHANGE STASIS # OF FIGHTER 142 | 143 | * CHECK FOR FI DESTROYED ALONG WITH CARRIER 144 | 2100 IF((AB=='C').OR.(AB=='F').OR.(AB=='O')) GOTO 2018 145 | CALL CURSOR(100) 146 | CALL STROUT('FIGHTER #',0); CALL DECPRT(Y) 147 | CALL STROUT(' DESTROYED. ',31) 148 | GOTO 2009 149 | 2018 Z7=Z6 150 | CALL STASIS(Z6,LOC) 151 | 3000 IF(RANGE(Y)==0) GOTO 2048 152 | MYCOD=MYCODE(LOC) 153 | IF(MYCOD==0) GOTO 2540 154 | IF((MYCOD<101).OR.(MYCOD>6108)) GOTO 2041 155 | IF(MYCOD<=6000) GOTO 2042 156 | IF(MYCOD>6100) GOTO 2043 157 | GOTO 2041 158 | 2042 Z6=Z6+IARROW(MOV(Z6,MYCOD)) 159 | IF(Z6==MYCOD) CALL CMYCOD(LOC,0) !F HAS ARRIVED AT STASIS # 160 | GOTO 2045 161 | 2043 Z6=Z6+IARROW(MYCOD-6100) 162 | 2045 AD=A(1,Z6) 163 | IF(ORDER(Z6)#0) GOTO 2046 164 | IF(RANGE(Y)==10) GOTO 2046 165 | IF((AD=='C').OR.(AD=='O')) GOTO 2041 166 | IF((AD=='+').OR.(AD=='.')) GOTO 2041 167 | 2046 Z6=Z7 168 | CALL SECTOR(2) 169 | CALL STSOUT(MYCOD) 170 | 2540 CALL SECTOR(2) 171 | CALL LTR(Z6,ITURN) 172 | 2048 CALL HEAD('F',Y,Z6) 173 | CALL CURSOR(40) 174 | CALL STROUT('RANGE:',0) 175 | CALL DECPRT(RANGE(Y)) 176 | CALL SPACE 177 | IF(RANGE(Y)>0) GOTO 2011 178 | CALL CURSOR(100) 179 | CALL STROUT('RAN OUT OF FUEL AND CRASHED. ',31) 180 | IF((AB#'C').AND.(D1(Z6)#'*')) CALL CHANGE(Z6,D1(Z6),1) 181 | GOTO 2009 182 | 2011 CALL MVE('F',MDATE,LOC,1,Z6,Z7,DISAS,Z6-IADJST) 183 | IF(DISAS==-2) GOTO 3000 184 | 185 | 186 | * MOVE EVALUATION 187 | 188 | 2041 AC=A(1,Z6) 189 | RANGE(Y)=RANGE(Y)-1 190 | IF((AC=='O').OR.(AC=='C')) RANGE(Y)=20 191 | IF(Z7==Z6) GOTO 2020 192 | IF((AB#'C').AND.(D1(Z7)#'*')) CALL CHANGE(Z7,D1(Z7),1) 193 | IF(AC=='C') GOTO 2014 194 | IF(DISAS==1) GOTO 2009 195 | IF((AC#'.').AND.(AC#'+'))GOTO2004 196 | CALL CHAS(LOC,Z6) 197 | CALL CHANGE(Z6,'F',1) 198 | GOTO 2010 199 | 2004 IF(D1(Z6)#'*') GOTO 2005 200 | IF(AC#'O') GOTO 2006 201 | 2014 CALL CURSOR(100) 202 | IF(MYCODE(LOC)==0) CALL STROUT('LANDING CONFIRMED. ',31) 203 | CALL CHAS(LOC,Z6) 204 | GOTO2020 205 | 2006 CALL CURSOR(100) 206 | CALL STROUT('FIGHTER SHOT DOWN. ',31) 207 | 2009 CALL CHAS(LOC,0) 208 | GOTO2020 209 | 2005 H1=1 210 | OWN1='F' 211 | OWN2=AC 212 | H2=30 213 | CALL FIND(OWN2,Z6,Z8,H2) 214 | CALL FGHT(Z6,H1,H2,OWN1,OWN2) 215 | CALL FIND(OWN2,Z6,Z8,H2) 216 | IF(H1<=0)GOTO2009 217 | CALL CHAS(LOC,Z6) 218 | CALL CHANGE(Z6,'F',1) 219 | IF((OWN2>='1').AND.(OWN2<='8')) CALL SONAR(Z6) 220 | 2010 CALL SENSOR(Z6) 221 | 2020 IF(DISAS#1) CALL SENSOR(Z6) 222 | IF(DISAS==1) CALL SENSOR(Z7) 223 | 2001 CONTINUE 224 | RETURN 225 | END 226 | 227 | 228 | 229 | 230 | . -------------------------------------------------------------------------------- /6.FOR: -------------------------------------------------------------------------------- 1 | 2 | C SUBROUTINE 6 3 | 4 | 5 | * THIS HAS BEEN REWRITTEN IN MACRO (EXACT EQUIVALENT) 6 | C INTEGER FUNCTION ORDER(I6) 7 | C IMPLICIT INTEGER(A-Z) 8 | C ORDER=0 9 | C IF((I6<101).OR.(I6>5900).OR.(I6/100*100==I6) 10 | C &.OR.(I6/100*100+1==I6)) ORDER=1 11 | C RETURN 12 | C END 13 | 14 | INTEGER FUNCTION IFORM(I) 15 | IFORM=IABS(I/10000) 16 | RETURN 17 | END 18 | 19 | INTEGER FUNCTION ILATT(I) 20 | ILATT=IABS(MOD(I,10000)) 21 | RETURN 22 | END 23 | 24 | SUBROUTINE SONAR(Z6) 25 | INCLUDE 'COMMON.EMP/NOLIST' 26 | DIMENSION OK(5) 27 | DATA OK/'+',' ','X','*','O'/ 28 | 29 | DO 100 I=1,8 30 | LOCUS=Z6+IARROW(I) 31 | AB=A(1,LOCUS) 32 | IF(AB#A(0,LOCUS)) CALL CHANGE(LOCUS,AB,0) 33 | IF((AB#'*').AND.(AB#'O')) GOTO 200 34 | DO 300 I1=1,70 35 | 300 IF(TARGET(I1)==LOCUS) GOTO 100 36 | DO 301 I1=1,70 37 | 301 IF(TARGET(I1)==0) GOTO 302 38 | 302 TARGET(I1)=LOCUS 39 | GOTO 100 40 | 200 IF((AB<'A').OR.(AB>'T')) GOTO 100 41 | IF(AB#'A') GOTO 201 42 | 43 | * WE MUST NOW FIGURE OUT IF THE ARMY IS A THREAT TO ANY OF THE COMPUTER'S 44 | * CITIES, I.E. IF IT IS ON THE CONTINENT WITH ANY OF THEM. IF SO, PUT 45 | * THE ARMY IN THE LOCI ARRAY. THE FIRST INDEX IS THE CONTINENT, THE 46 | * SECOND IS THE NTH ARMY DISCOVERED ON THAT CONTINENT - 1. THE (N,1) 47 | * ARGUMENT IS THE DATE OF THE LAST ARMY DISCOVERED ON THE 48 | * NTH CONTINENT. THUS WE HAVE A MEANS OF DETERMINING THE AGE OF THE DATA. 49 | 50 | DO 901 K=1,70 51 | IF((OWNER(K)#2).OR.(PHASE(K)==1)) GOTO 901 52 | IF(FOUND(K)#MDATE+5*PHASE(K)-1) GOTO 901 53 | MOVE=PATH(X(K),LOCUS,1,OK,FLAG) 54 | IF(FLAG#0) PHASE(K)=-1 55 | 901 CONTINUE 56 | 57 | DO 903 K=1,10 58 | IF(LOCI(K,1)100) GOTO 200 21 | FUNC='SENTRY' 22 | IF(MYCOD==0) FUNC='AWAKE' 23 | IF(MYCOD==100) FUNC='RANDOM' 24 | 202 TYPE 201, FUNC 25 | 201 FORMAT('+',A10,$) 26 | RETURN 27 | 200 FUNC='FILL' 28 | IF(MYCOD==9997) GOTO 202 29 | CALL DECPRT(MYCOD) 30 | 203 CALL SPACE 31 | RETURN 32 | END 33 | 34 | SUBROUTINE IDEN(OWN) 35 | COMMON/MODE/MODE,KURSOR,JECTOR ,ISEC 36 | IF((OWN>='1').AND.(OWN<='8')) CALL STROUT('ENEMY',10) 37 | IF((OWN<='T').AND.(OWN>='A')) CALL STROUT('YOUR',10) 38 | IF((OWN=='A').OR.(OWN=='1')) GOTO 702 39 | IF((OWN=='F').OR.(OWN=='2')) GOTO 703 40 | IF((OWN=='D').OR.(OWN=='3')) GOTO 704 41 | IF((OWN=='S').OR.(OWN=='4')) GOTO 705 42 | IF((OWN=='T').OR.(OWN=='5')) GOTO 706 43 | IF((OWN=='R').OR.(OWN=='6')) GOTO 707 44 | IF((OWN=='C').OR.(OWN=='7')) GOTO 708 45 | * THEN IT IS A BATTLESHIP! 46 | CALL STROUT('BATTLESHIP',10) 47 | RETURN 48 | 702 CALL STROUT('ARMY',10) 49 | RETURN 50 | 703 CALL STROUT('FIGHTER',10) 51 | RETURN 52 | 704 CALL STROUT('DESTROYER',10) 53 | RETURN 54 | 705 CALL STROUT('SUBMARINE',10) 55 | RETURN 56 | 706 CALL STROUT('TROOP TRANSPORT',10) 57 | RETURN 58 | 707 CALL STROUT('CRUISER',10) 59 | RETURN 60 | 708 CALL STROUT('AIRCRAFT CARRIER',10) 61 | RETURN 62 | END 63 | 64 | SUBROUTINE CITYCT 65 | INCLUDE 'COMMON.EMP/NOLIST' 66 | DIMENSION INDEX(15) 67 | DATA (INDEX(J),J=1,15)/11,12,0,13,14,15,0,0,0,16,0,17,0,0,18/ 68 | NUMBER(9)=0 69 | DO 100 I=11,18 70 | 100 NUMBER(I)=0 71 | DO 200 I=1,70 72 | IF(OWNER(I)#2) GOTO 200 73 | NUMBER(9)=NUMBER(9)+1 74 | IF(PHASE(I)==0) GOTO 200 75 | INDEXX=INDEX(PHASE(I)) 76 | NUMBER(INDEXX)=NUMBER(INDEXX)+1 77 | 200 CONTINUE 78 | 79 | * NOW LET NUMBER(10)=LAST FILLED SLOT IN TARGET 80 | NUMBER(10)=1 81 | DO 300 I=70,1,-1 82 | J=I !DO INDICES ARE NOT SAVED AFTER THE DO LOOP ENDS 83 | 300 IF(TARGET(I)#0) GOTO 301 84 | RETURN 85 | 301 NUMBER(10)=J 86 | RETURN 87 | END 88 | 89 | FUNCTION EDGER(I) 90 | COMMON /IARROW/IARROW(0:9) 91 | EDGER=0.0 92 | DO 100 IA=1,8 93 | 100 IF(D1(I+IARROW(IA))=='.') EDGER=EDGER+1.0 94 | RETURN 95 | END 96 | 97 | FUNCTION IPHASE(I) 98 | IA=(I-I/536870912*536870912)/4194304-48 99 | IF (IA==-16)GO TO 3786 100 | IPHASE=(I/536870912-48)*10+IA 101 | GO TO 3787 102 | 3786 IPHASE=I/536870912-48 103 | 3787 RETURN 104 | END 105 | 106 | 107 | FUNCTION JIGGLE(Z6,NUM) 108 | INCLUDE 'COMMON.EMP/NOLIST' 109 | INTEGER AB(9) 110 | DO 201 I=1,9 111 | 201 AB(I)=A(1,Z6+IARROW(I)) 112 | IF(AB(9)#'T') GOTO 200 113 | JIGGLE=0 114 | CALL CMYCOD(NUM,0) 115 | RETURN 116 | 117 | 200 DO 100 I1=1,9 118 | 100 IF((AB(I1)=='*').OR.(AB(I1)=='X')) GOTO 101 119 | 101 DO 102 I2=1,9 120 | 102 IF((AB(I2)>='1').AND.(AB(I2)<='8')) GOTO 103 121 | 103 DO 104 I3=1,9 122 | 104 IF(AB(I3)=='T') GOTO 105 123 | 105 M1=INT(RAN(C1)*8.0+1.0) 124 | M2=M1+7 125 | DO 106 I4=M1,M2 126 | I5=ICORR(I4) 127 | I=Z6+IARROW(I5) 128 | 106 IF((ORDER(I)==0).AND.(AB(I5)=='+')) GOTO 107 129 | I4=0 130 | 107 M=I1 131 | IF(M==9) M=I3 132 | IF(M==9) M=I2 133 | IF(M==9) M=I5 134 | IF(I4==0) M=9 135 | JIGGLE=M 136 | RETURN 137 | END 138 | 139 | 140 | 141 | -------------------------------------------------------------------------------- /8.FOR: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | C SUBROUTINE 8 6 | 7 | SUBROUTINE CITYPH 8 | INCLUDE 'COMMON.EMP/NOLIST' 9 | DIMENSION PH(8),OVRPOP(0:15,2),OK(5) 10 | DATA PH/1,2,4,5,6,10,12,15/ 11 | DATA OK/'+',' ','*','X','O'/ 12 | DATA OVRPOP/ 13 | & 9,001,002,9,003,004,05,9,9,9,06,9,07,9,9,08, 14 | & 0,499,199,0,199,199,83,0,0,0,99,0,99,0,0,99/ 15 | 16 | C NUMBER(1-8): #'S OF UNITS 17 | C NUMBER(11-18): #'S OF CITIES WITH EACH PHASE 18 | C NUMBER(9): # OF CITIES 19 | C NUMBER(10): # OF TARGET CITIES 20 | 21 | 22 | DO 100 I=1,70 23 | IF(OWNER(I)#2) GOTO 100 24 | IF((PHASE(I)>0).AND.(FOUND(I)#MDATE+5*PHASE(I)-1)) GOTO 100 25 | INT=PHASE(I) 26 | IF(PHASE(I)#-1) GOTO 102 27 | PHASE(I)=1 28 | GOTO 400 29 | 102 EDGE=INT(EDGER(X(I))) 30 | 31 | * IF WE HAVE JUST MADE A FIGHTER, AND HAVE ONE CITY, MAKE SOMETHING ELSE 32 | IF((NUMBER(9)==1).AND.(PHASE(I)==2)) PHASE(I)=0 33 | 34 | * IF WE HAVE A PHASE OF 0, MAKE SOMETHING! 35 | IF(PHASE(I)==0) GOTO 300 36 | 37 | * IF CITY IS SURROUNDED BY ARMIES, MAKE SOMETHING ELSE 38 | CROWD=.FALSE. 39 | IF(PHASE(I)#1) GOTO 701 40 | DO 702 J=1,8 41 | 702 IF(A(1,X(I)+IARROW(J))=='+') GOTO 701 42 | CROWD=.TRUE. 43 | GOTO 300 44 | 45 | * IF CRAFT NUMBERS ARE GETTING GROSSLY LARGE, PRODUCE SOMETHING ELSE 46 | 701 IF(NUMBER(OVRPOP(PHASE(I),1))>OVRPOP(PHASE(I),2)) GOTO 300 47 | 48 | IF(EDGE#8) GOTO 101 49 | IF((NUMBER(9)>1).AND.(PHASE(I)==1)) GOTO 600 50 | IF(NUMBER(9)>1) GOTO 100 51 | IF(NUMBER(5)<1) PHASE(I)=6 52 | IF(NUMBER(5)>0) PHASE(I)=1 53 | GOTO 100 54 | 55 | 101 IF(PHASE(I)#1) GOTO 100 56 | N=0 57 | DO 503 J=IAR2+1,IAR2+LIMIT(9) 58 | Z=S(J) 59 | IF((Z==0).OR.(IDIST(X(I),Z)>6)) GOTO 503 60 | IF(A(0,Z)=='5') GOTO 503 61 | MOVE=PATH(X(I),Z,1,OK,FLAG) 62 | IF(FLAG==0) GOTO 503 63 | N=N+1 64 | 503 CONTINUE 65 | IF((N>5).AND.(NUMBER(11)>1)) GOTO 300 66 | GOTO 100 67 | 68 | * SELECT A NEW PHASE FOR THE CITY 69 | 300 CONTINUE 70 | * IF THERE ARE ENEMY ARMIES ON THE CONTINENT, PRODUCE ARMIES! 71 | IF(EDGE==8) GOTO 600 72 | DO 500 J=1,10 73 | IF(LOCI(J,2)==0) GOTO 500 74 | MOVE=PATH(X(I),LOCI(J,2),1,OK,FLAG) 75 | IF(FLAG==0) GOTO 500 76 | PHASE(I)=1 77 | GOTO 400 78 | 500 CONTINUE 79 | 80 | 504 PHASE(I)=2 81 | IF(EDGE>0) GOTO 501 !IF NOT LANDLOCKED 82 | IF(NUMBER(1)<=3*NUMBER(2)) PHASE(I)=1 !IF SMALL # OF ARMIES 83 | GOTO 400 84 | 85 | 501 PHASE(I)=1 86 | N=0 87 | DO 502 J=IAR2+1,IAR2+LIMIT(9) 88 | Z=S(J) 89 | IF((Z==0).OR.(IDIST(X(I),Z)>6)) GOTO 502 90 | IF(A(0,Z)=='5') GOTO 502 !IF ON TROOP TRANSPORT 91 | MOVE=PATH(X(I),Z,1,OK,FLAG) 92 | IF(FLAG==0) GOTO 502 93 | N=N+1 94 | 502 CONTINUE 95 | IF(N<3) GOTO 400 96 | PHASE(I)=2 97 | IF(NUMBER(2)=NUMBER(J+9)) PHASE(I)=PH(J-1) 104 | IF(NUMBER(17)==0) PHASE(I)=12 105 | IF(NUMBER(15)<2) PHASE(I)=6 106 | GOTO 400 107 | 108 | 400 IF((NUMBER(9)>1).AND.(NUMBER(15)==0).AND.(EDGE>0)) PHASE(I)=6 109 | IF(INT==PHASE(I)) GOTO 100 110 | FOUND(I)=6*PHASE(I)+MDATE 111 | CALL CITYCT(OWNER,NUMBER,PHASE) 112 | IF(CODER<9.) GOTO 100 113 | CALL CURSOR(100,KURSOR) 114 | TYPE 131,X(I),INT,PHASE(I),EDGE 115 | 131 FORMAT('+CITY:',I4,' FROM:',I2,' TO:',I2,' EDGE:',I1,3X$) 116 | 100 CONTINUE 117 | RETURN 118 | END 119 | 120 | * THIS HAS BEEN REWRITTEN IN MACRO (EXACT EQUIVALENT) 121 | C FUNCTION MOV(I6,I7) 122 | C IY6=(I6-1)/100 123 | C IY7=(I7-1)/100 124 | C IX6=I6-100*IY6 125 | C IX7=I7-100*IY7 126 | C IY=IY7-IY6 127 | C IX=IX7-IX6 128 | C IF((IY<0).AND.(IX>0)) MOV=2 129 | C IF((IY<0).AND.(IX==0)) MOV=3 130 | C IF((IY<0).AND.(IX<0)) MOV=4 131 | C IF((IY==0).AND.(IX<0)) MOV=5 132 | C IF((IY>0).AND.(IX<0)) MOV=6 133 | C IF((IY>0).AND.(IX==0)) MOV=7 134 | C IF((IY>0).AND.(IX>0)) MOV=8 135 | C IF((IY==0).AND.(IX>0)) MOV=1 136 | C IF((IX==0).AND.(IY==0)) MOV=0 137 | C RETURN 138 | C RETURN 139 | C END 140 | 141 | 142 | . -------------------------------------------------------------------------------- /9.FOR: -------------------------------------------------------------------------------- 1 | 2 | 3 | C SUBPROGRAM COLLECTION 9 4 | SUBROUTINE FGHT(Z6,H1,H2,OWN1,OWN2) 5 | INCLUDE 'COMMON.EMP/NOLIST' 6 | IF((OWN2<'A').OR.(OWN2>'T')) GOTO 200 7 | IF(MODE==1) CALL CURSOR(100,KURSOR) 8 | CALL IDEN(OWN2); CALL STROUT('IS UNDER ATTACK AT',10) 9 | CALL DECPRT(Z6) 10 | CALL STROUT('',51) 11 | 200 CALL CURSOR(200) 12 | S1=1 13 | S2=1 14 | IF((OWN1=='S').OR.(OWN1=='4')) S1=3 15 | IF((OWN2=='S').OR.(OWN2=='4')) S2=3 16 | IF(H2==0) GOTO 700 17 | 702 IF(RAN(C1)<=.5) GOTO700 18 | H1=H1-S2 19 | H=H2 20 | IF(H1>0) GOTO702 21 | OWN=OWN1 22 | CALL IDEN(OWN) 23 | OWN=OWN2 24 | CALL STROUT('DESTROYED,',10) 25 | GOTO 799 26 | 700 H2=H2-S1 27 | H=H1 28 | IF(H2>0) GOTO702 29 | OWN=OWN2 30 | CALL IDEN(OWN) 31 | OWN=OWN1 32 | CALL STROUT('DESTROYED,',10) 33 | 799 CALL IDEN(OWN) 34 | CALL STROUT('HAS',10); CALL DECPRT(H) 35 | CALL STROUT(' HITS LEFT.',0) 36 | IF(MODE==0) CALL STROUT('',1) 37 | RETURN 38 | END 39 | 40 | 41 | SUBROUTINE SENSOR(Z6) 42 | INTEGER Z6,ARROW(1:9) 43 | COMMON/MODE/MODE,KURSOR,JECTOR ,ISEC 44 | DATA (ARROW(J),J=1,9)/-101,-100,-99,-1,0,1,99,100,101/ 45 | IBEFOR=-100 46 | DO 100 I=1,9 47 | I1=Z6+ARROW(I) 48 | AB=A(1,I1) 49 | IF(AB==A(2,I1)) GOTO 100 50 | CALL CHANGE(I1,AB,2) 51 | IF(JECTOR==-1) GOTO 100 52 | IF(ISEC==-1) GOTO 100 53 | LINE=KLINE(KI,ISEC) 54 | IY=(I1-1)/100*100 55 | IX=I1-IY 56 | IF((IYLINE+1900).OR.(IX<=KI).OR.(IX>KI+70))GOTO100 57 | I1=I1-LINE-KI 58 | IF(IBEFOR+1#I1) CALL CURSOR(I1+300,KURSOR) 59 | IBEFOR=I1 60 | CALL OUTCHR(LSH(AB,-29)) 61 | 100 CONTINUE 62 | RETURN 63 | END 64 | 65 | 66 | 67 | SUBROUTINE MVE(OWN1,MDATE,NUM,N2,Z6,Z7,DISAS,JURSOR) 68 | IMPLICIT INTEGER(A-Z) 69 | DIMENSION KBTBL(9),CMYTBL(9),KBFUDG(9),COMMAND(20) 70 | REAL EDGER,RAN,C1 71 | LOGICAL PASS 72 | COMMON/PASS/PASS 73 | COMMON/IARROW/IARROW(0:9) 74 | COMMON/MODE/MODE,KURSOR,JECTOR,ISEC 75 | COMMON/X/X(70) 76 | COMMON/MISC1/TARGET(70),AR2S(500),RANGE(200),RANG(200) 77 | COMMON/CITY/FOUND(70),OWNER(70),PHASE(70) 78 | DATA KBTBL/'Q','W','E','A','D','Z','X','C',' '/ 79 | DATA CMYTBL/6104,6103,6102,6105,6101,6106,6107,6108,0/ 80 | DATA KBFUDG/-101,-100,-99,-1,1,99,100,101,0/ 81 | DATA COMMAND/'S','R','I','K','O','L','F','G','P','H', 82 | & 'Y','T','V','J','?',0,0,'U','N','+'/ 83 | 84 | DISAS=0 85 | 300 CALL ECHOFF 86 | CALL SECTOR(2) 87 | CALL CURSOR(JURSOR) 88 | CALL OUTCHR(BELL) 89 | 301 E=GETCHX(E) 90 | CALL ECHOON 91 | 92 | * MOVEMENT 93 | Z7=Z6 94 | DO 60 I=1,9 95 | IND=I 96 | 60 IF (E==KBTBL(IND)) GOTO 61 97 | GOTO 62 !THEREFORE COMMAND IS NOT A MOVE 98 | 61 Z6=Z6+KBFUDG(IND) 99 | GOTO 100 100 | 101 | 62 END=15 102 | IF(PASS) END=20 103 | DO 302 I=1,END 104 | 302 IF(E==COMMAND(I)) GOTO 303 105 | I=0 106 | 303 GOTO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15,304,304,18,19,10) I 107 | 304 GOTO 300 108 | 109 | *S: PUT TO SLEEP 110 | 1 IF(A(1,Z6)=='O') RETURN 111 | CALL CMYCOD(NUM,50) 112 | RETURN 113 | 114 | *R: RANDOM MOVEMENT 115 | 2 IF(OWN1#'A') GOTO 300 !ONLY FOR ARMIES 116 | CALL CMYCOD(NUM,100) 117 | Z6=Z6+IARROW(JIGGLE(Z6,NUM)) 118 | RETURN 119 | 120 | *I: PUT IN DIRECTIONAL STASIS 121 | 3 CALL ECHOFF 122 | CALL OUTCHR(BELL) 123 | E=GETCHX(E) 124 | CALL ECHOON 125 | DO 70 I=1,9 126 | IND=I 127 | IF (E == KBTBL(IND)) GOTO 21 128 | 70 CONTINUE 129 | GOTO 22 130 | 21 CALL CMYCOD(NUM,CMYTBL(IND)) 131 | 22 IF(MYCODE(NUM)==0) GOTO 300 132 | DISAS=-2 133 | RETURN 134 | 135 | *K: KILL STASIS NUMBERS ON TRANSPORT/CARRIER 136 | 4 IF(OWN1#'T') GOTO 4093 137 | DO 4094 J=1,500 138 | 4094 IF(S(J)==Z6) CALL CMYCOD(J,0) 139 | GOTO 300 140 | 4093 IF(OWN1#'C') GOTO 300 141 | DO 4095 J=501,700 142 | 4095 IF(S(J)==Z6) CALL CMYCOD(J,0) 143 | GOTO 300 144 | 145 | *O: CONCENTRATIONS 146 | 5 CONTINUE 147 | GOTO 600 148 | 149 | *L: SET UP CITY STASIS NUMBERS 150 | 6 CALL DIREC 151 | GOTO 600 152 | 153 | *F: 154 | 7 CALL DIREC 155 | GOTO 600 156 | 157 | *G: PUT T/C TO SLEEP 158 | 8 IF((OWN1#'T').AND.(OWN1#'C')) GOTO 300 159 | CALL CMYCOD(NUM,9997) 160 | DISAS=-2 161 | RETURN 162 | 163 | *P: SECTOR PRINTOUT 164 | 9 ISEC=-1 165 | CALL SECTOR(2) 166 | GOTO 600 167 | 168 | *H: GET HELP 169 | 10 CALL OUTCHR(FF) 170 | CALL HELP 171 | CALL OUTCHR(BELL) 172 | E=GETCHX(E) 173 | ISEC=-1 174 | GOTO 600 175 | 176 | *Y: CHANGE PHASE OF A CITY 177 | 11 CALL DIREC 178 | GOTO 600 179 | 180 | *T: BLOCK PRINTOUT 181 | 12 CALL OUTCHR(FF) 182 | CALL BLOCK(2) 183 | ISEC=-1 184 | GOTO 600 185 | 186 | *V: SAVE GAME 187 | 13 CALL GAME(.TRUE.,NUM) 188 | GOTO 300 189 | 190 | *J: PUT IN EDIT MODE 191 | 14 CALL TEST3(Z6) 192 | IF(MYCODE(NUM)==0) GOTO 300 193 | DISAS=-2 194 | RETURN 195 | 196 | *?: HOW MANY HITS? LOADED? 197 | 15 IF((OWN1=='A').OR.(OWN1=='F')) GOTO 300 198 | IB=H(N2) 199 | IF(MODE==1) CALL CURSOR(100,KURSOR) 200 | CALL STROUT('HITS LEFT-',0); CALL DECPRT(IB) 201 | CALL STROUT('',51) 202 | N=0 203 | DO 402 I=1,500 204 | 402 IF(S(I)==Z6) N=N+1 205 | IF(N==0) GOTO 700 206 | IF(MODE==1) CALL CURSOR(200,KURSOR) 207 | CALL DECPRT(N); CALL STROUT(' ARMIES ABOARD.',1) 208 | GOTO 600 209 | 700 DO 405 I=1,200 210 | 405 IF(S(I+500)==Z6) N=N+1 211 | IF(N==0) GOTO 600 212 | IF(MODE==1) CALL CURSOR(200,KURSOR) 213 | CALL DECPRT(N); CALL STROUT(' FIGHTERS ABOARD.',1) 214 | GOTO 600 215 | 216 | *U: CALL REFERENCE MAP 217 | 18 ISEC=-1 218 | CALL SECTOR(1) 219 | GOTO 600 220 | 221 | *N: CALL ENEMY MAP 222 | 19 ISEC=-1 223 | CALL SECTOR(0) 224 | GOTO 600 225 | 226 | *+: BLOCK PRINT REF. MAP 227 | 20 CALL OUTCHR(FF) 228 | ISEC=-1 229 | CALL BLOCK(1) 230 | E=GETCHX(E) 231 | GOTO 600 232 | 233 | 600 CALL LTR(Z6,2) 234 | GOTO 300 235 | 100 IF(ORDER(Z6)==0) GOTO 50 236 | IF(MODE==1) CALL CURSOR(100,KURSOR) 237 | CALL STROUT('YOU CANNOT MOVE ONTO THE EDGE OF THE WORLD.',1) 238 | CALL STROUT('HARD RADIATION PREVAILS THERE. MOVE AGAIN.',1) 239 | Z6=Z7 240 | GOTO 600 241 | 50 RETURN 242 | END 243 | 244 | SUBROUTINE BLOCK(II) 245 | DOUBLE PRECISION TTY 246 | INTEGER ROW 247 | COMMON/MODE/MODE,KURSOR,JECTOR ,ISEC 248 | COMMON/G2/G2(100) 249 | ISEC=-1 250 | CALL OUTCHR(FF) 251 | JECTOR=-1 252 | CALL STROUT(' TTY#?',10) 253 | ACCEPT 601,TTY 254 | 601 FORMAT(A10) 255 | CALL OUTCHR(FF) 256 | IF(TTY=='') TTY='TTY' 257 | OPEN(UNIT=2,DEVICE=TTY,ACCESS='SEQOUT') 258 | DO 300 J=0,5900,100 259 | DO 400 K=100,1,-1 260 | AB=A(II,K+J) 261 | 400 IF(AB#' ') GOTO 401 262 | GOTO 300 263 | 401 DO 404 L=1,K 264 | 404 G2(L)=A(II,J+L) 265 | WRITE(2,403) (G2(L),L=1,K) 266 | 403 FORMAT(1X,100A1) 267 | 300 CONTINUE 268 | CLOSE(UNIT=2) 269 | RETURN 270 | END 271 | 272 | 273 | 274 | 275 | . -------------------------------------------------------------------------------- /COMMON.EMP: -------------------------------------------------------------------------------- 1 | 2 | C THIS FILE IS TO BE INCLUDED, IT CONTAINS COMMON STATEMENTS 3 | C FOR GLOBAL SYMBOLS. 4 | 5 | IMPLICIT INTEGER (A-Z) 6 | 7 | PARAMETER BELL="7,ADMFF="32,ADDSFF=12 8 | PARAMETER IAR=0,IFI=500,IDE=700,ISU=900,ITT=1100,ICR=1200, 9 | & ICA=1300,IBA=1400,IAR2=1500,IFI2=2000, 10 | & IDE2=2200,ISU2=2400,ITT2=2600,ICR2=2700,ICA2=2800, 11 | & IBA2=2900,IDEH=0,ISUH=200,ITTH=400,ICRH=500,ICAH=600, 12 | & IBAH=700,IDE2H=800,ISU2H=1000,ITT2H=1200,ICR2H=1300, 13 | & ICA2H=1400,IBA2H=1500 14 | 15 | REAL EXPLOR,AGGR,GETTAB 16 | REAL ATTACK,BLAH,RAN,C1,P,POSCHK,STASIS,EDGER,CODER 17 | LOGICAL SPECAL,PASS,ADDS,CROWD,IZAP,PAS 18 | COMMON/MODE/MODE,ADDS,JECTOR,ISEC 19 | COMMON/KXK/IADJST,FF 20 | COMMON/PASS/PASS 21 | COMMON/CODE/CODE(1500) 22 | COMMON/IARROW/IARROW(0:9) 23 | COMMON/COD/CODER 24 | COMMON/X/X(70) 25 | COMMON/CITY/FOUND(70),OWNER(70),PHASE(70) 26 | COMMON/MISC1/TARGET(70),AR2S(500),RANGE(200),RANG(200) 27 | COMMON/P1/PHAZE(16) 28 | COMMON/MISC2/LOCI(10,11),NUMBER(18),LIMIT(16),MDATE,Z3 29 | COMMON/TEST2/SUCCES,FAILUR 30 | COMMON/ARMTOT/ARMTOT(20) 31 | COMMON/TROOP/TROOPT(6,5) 32 | COMMON/FIPATH/FIPATH(70) 33 | COMMON/G2/G2(100) 34 | COMMON/MAP/MAPS(2574),D(300),KLIP 35 | COMMON/LOCS/LOCS(1200) 36 | COMMON/J1TS/J1TS(178) 37 | COMMON/MYCOD/MYCOD2(750) 38 | DATA FF/ADMFF/ 39 | 40 | 41 | C EXPLOR: THIS IS SET TO 1 IF THE ENEMY SHIP IS TO EXPLORE UNKNOWN 42 | C TERRITORY ADJACENT TO IT, 0 IF NOT. 43 | C AGGR: THIS IS A MEASURE OF THE ENEMY SHIPS AGGRESSIVENESS, 44 | C THIS VALUE IS ADDED TO THE COST-EFFECTIVENESS OF ATTACKING AN 45 | C ENEMY UNIT TO DETERMINE IF THE SHIP WILL ATTACK OR RUN FROM THE 46 | C ENEMY. 47 | C BLAH: RANDOM VARIABLE 48 | C CODER: USED FOR DEBUG FLAG 49 | C PASS: SET TO .TRUE. IF IT IS A PRIVILEGED USER 50 | C CROWD: USED IF CITY IS SURROUNDED BY ARMIES 51 | C IZAP: MAILED TO GAME; .TRUE.=SAVE GAME, .FALSE.=INITIALIZE 52 | C MODE: 1=IN MODE 2, 0=IN MODE 1 53 | C KURSOR: SET TO POSITION OF CURSOR 54 | C JECTOR: SECTOR PROGRAM IS LOOKING AT 55 | C ISEC: SECTOR TERMINAL IS SHOWING 56 | C IADJST: SUBTRACTED FROM Z6 SO CURSOR WILL NOT BE MOVED OFF SCREEN 57 | C CODE: CONTAINS A NUMBER THAT DETERMINES WHAT THAT COMPUTER CRAFT 58 | C IS ASSIGNED TO DO, IS SEPERATED INTO 2 NUMBERS, IFO AND ILA. IFO 59 | C GIVES THE FUNCTION, ILA GIVES DETAILS. 60 | C IARROW: ADDED TO Z6 SO MOVES [1,2,3,4,5,6,7,8,9] ARE CONVERTED 61 | C TO [+1,-99,-100,-101,ETC.] 62 | C X: LOCATIONS OF CITIES 63 | C FOUND: COMPLETION DATES FOR CITIES 64 | C OWNER: WHO OWNS THE CITY: 0>NOBODY, 1>PLAYER, 2>COMPUTER 65 | C PHASE: PHASE OF CITY 66 | C FIPATH: STASIS # TO BE GIVEN TO FIGHTER IN THAT CITY 67 | C ALL CITIES ARE REFERENCED BY CITY NUMBER, AS IN X(N)=LOC OF CITY #N 68 | 69 | 70 | . -------------------------------------------------------------------------------- /CURSOR.MAC: -------------------------------------------------------------------------------- 1 | 2 | TITLE CURSOR 3 | ENTRY CURSOR,ICORR,CORR 4 | 5 | T0=0 6 | T1=1 7 | P=17 8 | 9 | .COMMON MODE [4] 10 | ADDS=MODE + 1 ;SET < 0 IF WE'RE ON AN ADDS TERMINAL 11 | 12 | CURSOR: SKIPN ,MODE 13 | POPJ P, ;RETURN IF MODE=1 14 | MOVE T0,@(16) ;GET DESIRED POSITION 15 | SKIPGE ,ADDS ;SKIP IF WE'RE NOT ON AN ADDS TERMINAL 16 | JRST ADDSFOR 17 | OUTSTR [BYTE (7)33,"="];PREFIX 18 | IDIVI T0,^D100 ;SPLIT Y INTO T0, X INTO T1 19 | ADDI T0," " ;ADD BASE 20 | IONEOU T0 ;AND OUTPUT Y COORD 21 | ADDI T1," " ;ADD BASE TO X 22 | IONEOU T1 ;AND OUTPUT X COORD 23 | POPJ P, ;RETURN 24 | 25 | ADDSFOR: 26 | IDIVI T0,^D100 ;SEPARATE INTO X AND Y 27 | OUTCHR [^D11] 28 | IONEOU T0 ;OUTPUT Y VECTOR 29 | OUTCHR [^D16] 30 | MOVE T0,T1 31 | IDIVI T0,^D10 ;CONVERT TO BCD 32 | LSH T0,4 ;HIGH BCD DIGIT 33 | IOR T0,T1 34 | IONEOU T0 35 | POPJ P, 36 | 37 | ICORR: MOVE T0,@0(16) ;GET FORTRAN ARGUMENT 38 | CORR: CAILE T0,^D8 39 | SUBI T0,^D8 ;IF(T0>8) T0=T0-8 40 | CAIGE T0,1 41 | ADDI T0,^D8 ;IF(T0<1) T0=T0+8 42 | POPJ P, 43 | 44 | ENTRY TRMOP2,ECHOON,ECHOFF,GETCHX 45 | 46 | TTY==12 ;RANDOM CHANNEL 47 | 48 | D1: XWD 64240,703566 49 | XWD 354000,1 50 | XWD 351005,520212 51 | XWD 466411,151212 52 | XWD 202350,551210 53 | XWD 205024,120432 54 | XWD 50000,0 55 | 56 | TRMOP2: SETO 0 57 | TRMNO. 58 | EXIT 0, 59 | MOVEM TTYY 60 | MOVE [XWD 3,FUNC] 61 | TRMOP. 62 | EXIT 0, 63 | POPJ 17, 64 | 65 | FUNC: 2010 66 | TTYY: BLOCK 1 67 | EXP -1 68 | 69 | ECHOON: SETSTS TTY,1 70 | POPJ 17, 71 | 72 | ECHOFF: INIT TTY,201 73 | 'TTY ' 74 | Z 75 | HALT . 76 | SETOM TRMARG+1 77 | GETLCH TRMARG+1 78 | HRRZS TRMARG+1 79 | MOVE 0,[3,,TRMARG] 80 | TRMOP. 0, 81 | HALT . 82 | POPJ 17, 83 | 84 | TRMARG: 2010 85 | 0 86 | 1 87 | 88 | GETCHX: CLRBFI 89 | INCHRW 0 90 | ROT -7 91 | OR [BYTE(7) 0,40,40,40,40] 92 | POPJ 17, 93 | 94 | XPUNGE 95 | END 96 | 97 | 98 | . -------------------------------------------------------------------------------- /EMPIRE.FOR: -------------------------------------------------------------------------------- 1 | 2 | PROGRAM DEBUG 3 | INCLUDE 'COMMON.EMP/NOLIST' 4 | DIMENSION COMSCN(40) 5 | DIMENSION LOPMAX(15) 6 | DIMENSION HITS(15),TIPE(15),CRAHIT(15),CRALOC(15) 7 | DATA COMSCN/'M','N','O','A','T','V','P','Y','C','L','H','J', 8 | & '1','R','@',0,0,0,0,0,'LO','NU','LI','TR','AR','TA','PA','A1', 9 | & 'T3','A0','CO','CH','Q0','Q','JE','CY','EX',0,0,0/ 10 | C 11 | C ARGUMENTS FOR PROD SUBROUTINE 12 | DATA HITS/1,1,0,3,2,3,0,0,0,8,0,8,0,0,12/ 13 | DATA TIPE/1,2,0,3,4,5,0,0,0,6,0,7,0,0,8/ 14 | DATA CRAHIT/0,0,0,0,ISUH,ITTH,0,0,0,ICRH,0,ICAH,0,0,IBAH/ 15 | DATA CRALOC/0,IFI,0,IDE,ISU,ITT,0,0,0,ICR,0,ICA,0,0,IBA/ 16 | DATA LOPMAX/500,200,0,200,200,100,0,0,0,100,0,100,0,0,100/ 17 | 18 | C .FALSE. = BEGIN OF GAME 19 | CALL ECHOFF 20 | CALL ECHOON 21 | NCYCLE=1 22 | CALL GAME(.FALSE.,NUM) 23 | C IF YOU SAVED THE GAME IN THE MIDDLE OF A MOVE, DO THE ENEMY MOVE NOW. 24 | IF(NUM#0) GOTO 3000 25 | C 26 | C COMMAND LOOP STARTS HERE. 27 | 521 CALL CURSOR(0) 28 | CALL STROUT('YOUR ORDERS? ',10) 29 | 520 CALL OUTCHR(BELL) 30 | ACCEPT 108, ORDERS 31 | 108 FORMAT(A2) 32 | IF((SPECAL).AND.(ORDERS=='JE')) GOTO 35 33 | DO 100 I=1,20 34 | 100 IF(ORDERS==COMSCN(I)) GOTO 101 35 | IF(PASS) 102,521 36 | 101 GOTO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15) I 37 | GOTO 521 38 | 1 GOTO 1000 !START MOVE 39 | 2 CALL CURSOR(100) 40 | CALL STROUT('NUMBER OF FREE ENEMY MOVES:',0) 41 | ACCEPT 525,NCYCLE 42 | GOTO 3049 43 | 3 GOTO 1000 44 | 4 CALL OUTCHR(FF) 45 | ISEC=-1 46 | GOTO 521 47 | 5 CALL BLOCK(2) 48 | GOTO 521 49 | 6 CALL GAME('END',0) 50 | CALL STROUT('GAME SAVED',11) 51 | GOTO 521 52 | 7 CALL SECTOR(2) 53 | GOTO 521 54 | 8 CALL DIREC 55 | GOTO 521 56 | 9 GOTO 3000 57 | 10 CALL DIREC 58 | GOTO 521 59 | 11 CALL OUTCHR(FF) 60 | CALL HELP 61 | ISEC=-1 62 | GOTO 521 63 | 12 MODE=1 64 | Z6=0 65 | CALL TEST3(Z6) 66 | GOTO 521 67 | 13 MODE=0 68 | JECTOR=-1 69 | GOTO 521 70 | 14 CALL CURSOR(50) 71 | CALL STROUT(' ROUND #',0) 72 | TYPE 104,MDATE 73 | 104 FORMAT('+',I4,1X$) 74 | GOTO 521 75 | 15 ADDS=.TRUE. 76 | FF=ADDSFF 77 | GOTO 521 78 | C 79 | 102 DO 250 I=21,40 80 | 250 IF(ORDERS==COMSCN(I)) GOTO 251 81 | GOTO 521 82 | 251 GOTO (21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37) I-20 83 | GOTO 521 84 | 21 TYPE 111, ((LOCI(I,J),J=1,11),I=1,10) 85 | GOTO 521 86 | 22 TYPE 6500,NUMBER 87 | GOTO 521 88 | 23 TYPE 6499, LIMIT 89 | GOTO 521 90 | 24 TYPE 6498,TROOPT 91 | GOTO 521 92 | 25 TYPE 6500,ARMTOT 93 | GOTO 521 94 | 26 TYPE 6500,TARGET 95 | GOTO 521 96 | 27 TYPE 6497, SUCCESS,FAILURE 97 | GOTO 521 98 | 28 CALL BLOCK(1) 99 | GOTO 521 100 | 29 GOTO 521 101 | 30 CALL BLOCK(0) 102 | GOTO 521 103 | 31 ACCEPT 525,I1 104 | ACCEPT 525,I2 105 | 525 FORMAT(G) 106 | TYPE 527, (CODE(J),J=I1,I1+I2) 107 | GOTO 521 108 | 32 ACCEPT 523,CODER 109 | GOTO 521 110 | 33 CALL SECTOR(0) 111 | GOTO 521 112 | 34 CALL SECTOR(1) 113 | GOTO 521 114 | 35 ACCEPT 108,JECTOR 115 | JECTOR=IPHASE(JECTOR) 116 | CALL SECTOR(0) 117 | ISEC=JECTOR 118 | GOTO 521 119 | 36 GOTO 521 120 | 37 E=EXPL(DUMMY) 121 | TYPE 522,E 122 | GOTO 521 123 | C 124 | 522 FORMAT('+EXP VALUE:',I5$) 125 | 6499 FORMAT(1X,8I4) 126 | 6498 FORMAT(1X,5I6) 127 | 6500 FORMAT(1X,10I5) 128 | 6497 FORMAT(' SUCCESS:',I6,' FAILURE:',I6) 129 | 527 FORMAT(1X,10I7) 130 | 111 FORMAT(11I5) 131 | 523 FORMAT(G) 132 | C 133 | C BEGIN MOVEMENT 134 | C 135 | C ******************* 136 | C USER MOVE 137 | C 138 | 1000 IF(MODE==0) GOTO 8001 139 | IF(JECTOR#-1) GOTO 997; CALL OUTCHR(FF); JECTOR=0; ISEC=-1 140 | 997 ISTART=ISEC 141 | IF(ISEC<0) ISTART=0 142 | 8001 DO 8000 JECT=ISTART,ISTART+7 143 | IF(MODE==0) GOTO 8003 144 | JECTOR=JECT; IF(JECT>7) JECTOR=JECT-8 145 | LINE=KLINE(KI,JECTOR) 146 | IADJST=LINE+KI-300 147 | 8003 CALL SHIPMV(ITT,ITTH,5,'T',3) 148 | CALL SHIPMV(ICA,ICAH,7,'C',8) 149 | CALL SHIPMV(IBA,IBAH,8,'B',12) 150 | CALL SHIPMV(ICR,ICRH,6,'R',8) 151 | CALL SHIPMV(ISU,ISUH,4,'S',2) 152 | CALL SHIPMV(IDE,0,3,'D',3) 153 | CALL ARMYMV 154 | CALL FIGHMV 155 | IF(MODE==0) GOTO 8005 156 | 8000 CONTINUE 157 | 8005 CONTINUE 158 | C 159 | C HARDWARE PRODUCTION 160 | DO 1020 Y=1,70 161 | IF(OWNER(Y)#1)GOTO1020 162 | IF(PHASE(Y)==14) GOTO 1020 163 | CALL SENSOR(X(Y)) 164 | IF(PHASE(Y)==8) GOTO 1050 165 | IF((PHASE(Y)<1).OR.(PHASE(Y)>15)) GOTO 1050 166 | IF(MOD(PHASE(Y),2)==0) GOTO 1024 167 | IF(MOD(PHASE(Y),5)==0) GOTO 1024 168 | IF(PHASE(Y)==1) GOTO 1024 169 | C BAD PHASE 170 | 1050 CALL OUTCHR(FF); ISEC=-1; TYPE 2313,X(Y) 171 | 2313 FORMAT(' LTR READOUT AROUND CITY AT',I5) 172 | I1=MODE; MODE=0; CALL LTR(X(Y)); MODE=I1 173 | CALL STROUT('WHAT ARE YOUR PRODUCTION DEMANDS FOR THIS CITY? ',10) 174 | CALL PHASIN(Y) 175 | GOTO 1020 176 | 1024 IF(MDATEN/2) GOTO 500 251 | TYPE 502 252 | 502 FORMAT(' THE COMPUTER ACKNOWLEDGES DEFEAT. DO'/ 253 | &' YOU WISH TO SMASH THE REST OF THE ENEMY?') 254 | ACCEPT 503,ORDERS 255 | 503 FORMAT(A1) 256 | IF(ORDERS#'Y') STOP 257 | TYPE 504 258 | 504 FORMAT(' THE ENEMY INADVERTANTLY REVEALED ITS CODE USED FOR'/ 259 | &' RECEIVING BATTLE INFORMATION. YOU CAN DISPLAY WHAT THEY''VE'/ 260 | &' LEARNED THROUGH THE COMMAND ''JE'', , FOLLOWED BY THE'/ 261 | &' SECTOR NUMBER.') 262 | CH=10. 263 | SPECAL=.TRUE. 264 | WIN=2. 265 | GOTO 521 266 | 500 IF((NUMBER(9)>0).OR.(LIMIT(9)>0)) GOTO 516 267 | CALL OUTCHR(FF) 268 | TYPE 4960 269 | 4960 FORMAT(' THE ENEMY IS INCAPABLE OF DEFEATING YOU.'/ 270 | &' YOU ARE FREE TO RAPE THE EMPIRE AS YOU WISH.'/ 271 | &' THERE MAY BE, HOWEVER, REMNANTS OF THE ENEMY FLEET'/ 272 | &' TO BE ROUTED OUT AND DESTROYED.') 273 | WIN=1. 274 | GOTO 521 275 | 516 DO 519 I=1,70 276 | 519 IF(OWNER(I)==1) GOTO 520 277 | DO 517 I=1,LIMIT(1) 278 | 517 IF(S(I)#0) GOTO 520 279 | CALL OUTCHR(FF) 280 | WIN=1. 281 | TYPE 518 282 | 518 FORMAT(' YOU HAVE BEEN RENDERED INCAPABLE OF'/ 283 | &' DEFEATING THE RAMPAGING ENEMY FASCISTS! THE'/ 284 | &' EMPIRE IS LOST. IF YOU HAVE ANY SHIPS LEFT, YOU MAY'/ 285 | &' ATTEMPT TO HARASS ENEMY SHIPPING.') 286 | GOTO 521 287 | END 288 | C 289 | SUBROUTINE HERE(MSG) 290 | INCLUDE 'COMMON.EMP/NOLIST' 291 | DOUBLE PRECISION MSG 292 | IF(.NOT.PASS) RETURN 293 | CALL CURSOR(40) 294 | TYPE 100,MSG 295 | 100 FORMAT('+',A10,$) 296 | RETURN 297 | END 298 | 299 | 300 | . -------------------------------------------------------------------------------- /EMPIRE.HLP: -------------------------------------------------------------------------------- 1 | 2 | 3 | .HELP EMPIRE 4 | 5 | EMPIRE 6 | ------ 7 | 8 | 9 | 10 | (THE WARGAME OF THE CENTURY) 11 | 12 | 13 | EMPIRE IS A SIMULATION OF A FULL-SCALE WAR BETWEEN TWO EMPERORS, 14 | THE COMPUTER AND YOU. NATURALLY, THERE IS ONLY ROOM FOR 1 SO THE 15 | OBJECT OF THE GAME IS TO DESTROY THE OTHER. THE COMPUTER PLAYS BY 16 | THE SAME RULES THAT YOU DO. 17 | 18 | THE MAP IS A RECTANGLE 600*1000 MILES ON A SIDE. THE RESOLUTION 19 | IS 10, SO THE MAP YOU SEE IS 60*100. THE MAP CONSISTS OF '.': SEA, 20 | '+': LAND, '*': UNCONTROLLED CITIES, 'X': COMPUTER-CONTROLLED CITIES, 21 | 'O': YOUR DOMINATED CITIES. EACH EMPEROR GETS 1 MOVE PER ROUND (1 22 | ROUND=1 DAY), MOVES ARE DONE SEQUENTIALLY. 23 | 24 | THE PIECES ARE AS FOLLOWS: 25 | 26 | 27 | PIECE YOURS ENEMY HITS PHASE MAX. 28 | 29 | ARMY A 1 1 1 500 30 | FIGHTER F 2 1 2 200 31 | DESTROYER D 3 3 4 200 32 | SUBMARINE S 4 2 5 200 33 | TROOP TRANSPORT T 5 3 6 100 34 | CRUISER R 6 8 10 100 35 | AIRCRAFT CARRIER C 7 8 12 100 36 | BATTLESHIP B 8 12 15 100 37 | 38 | 39 | THE SECOND COLUMN GIVES THE REPRESENTATIONS FOR YOUR UNITS, THE 40 | THIRD GIVES THE REPRESENTATIONS OF ENEMY UNITS. HITS IS THE AMOUNT 41 | OF DAMAGE A UNIT CAN TAKE BEFORE IT IS DESTROYED. DAMAGE IS 42 | CUMULATIVE. PHASE IS THE NUMBER GIVEN TO A CITY THAT FORCES IT TO 43 | PRODUCE WHATEVER CORRESPONDS TO THAT PHASE. THE AMOUNT OF 44 | TIME REQUIRED TO PRODUCE EACH UNIT=5*PHASE. MAX IS THE MAXIMUM 45 | NUMBER OF EACH UNIT YOU CAN HAVE. 46 | 47 | 48 | ARMY: ARMIES MOVE ONLY ON LAND. ONLY ARMIES CAN CAPTURE CITIES. 49 | THEY HAVE A 50% PROBABILITY OF DOING SO. ATTACKING ONE'S 50 | OWN CITIES RESULTS IN THE ARMY'S DESTRUCTION. ARMIES CAN 51 | BE CARRIED BY TROOP TRANSPORTS. JUST MOVE THE ARMY 52 | ON THE TRANSPORT AND WHEN THE TRANSPORT MOVES THE ARMY 53 | MOVES WITH IT. YOU CANNOT ATTACK ANY SHIPS WHILE ON BOARD 54 | A TRANSPORT. YOU CANNOT MOVE BACK ON A CITY WITH AN ARMY. 55 | THIS IS TRUE EVEN IF YOU ARE ON A TROOP TRANSPORT. 56 | 57 | FIGHTER: FIGHTERS MOVE ON SEA OR LAND. THEY MOVE 4 TIMES PER DAY. 58 | THEY ARE REFUELED AT CONTROLLED CITIES AND CARRIERS. THEY 59 | ARE SHOT DOWN OVER UNCONTROLLED CITIES. THEY HAVE A MAX. 60 | RANGE OF 20 SPACES. 61 | 62 | DESTROYER: LIKE ALL SHIPS, DESTROYERS CAN MOVE ONLY ON THE SEA, 63 | UNLESS THEY DOCK IN A CONTROLLED CITY, IN WHICH CASE DAMAGE 64 | IS REPAIRED AT THE RATE OF 1 HIT PER DAY. 65 | 66 | SUBMARINE: SUBMARINES FIRE TORPEDOES. THUS, WHEN A SUBMARINE 67 | SCORES A HIT, 3 HITS ARE EXACTED INSTEAD OF THE USUAL 1 68 | FROM THE ENEMY UNIT. 69 | 70 | TROOP TRANSPORT: TROOP TRANSPORTS CAN CARRY A MAXIMUM OF 2* THE 71 | NUMBER OF HITS LEFT OF ARMIES. 72 | 73 | CRUISERS: TYPICAL SHIP 74 | 75 | AIRCRAFT CARRIERS: CARRIERS CAN CARRY A MAXIMUM OF 1* 76 | THE NUMBER OF HITS LEFT OF FIGHTERS. 77 | 78 | BATTLESHIP: TYPICAL SHIP 79 | 80 | 81 | ATTACKING SOMETHING IS ACCOMPLISHED BY MOVING ONTO THE SQUARE OF 82 | THE UNIT YOU WISH TO ATTACK. HITS ARE TRADED OFF AT 50% PROBABILITY 83 | OF A HIT LANDING ON ONE OR THE OTHER UNITS UNTIL ONE UNIT IS TOTALLY 84 | DESTROYED. THERE IS ONLY 1 POSSIBLE WINNER. 85 | 86 | [YOUR ORDERS?] 87 | 88 | COMMANDS ARE THE FOLLOWING: 89 | 90 | M: BEGIN MOVEMENT 91 | O: SAME AS 'M' 92 | T: REQUEST A BLOCK PRINTOUT OF THE ENTIRE MAP. USE TTYNNN IN 93 | RESPONSE TO THE REQUEST FOR A TTY NUMBER. DEFAULT IS YOUR OWN 94 | TTY NUMBER. 95 | V: SAVE GAME 96 | P: REQUEST SECTOR PRINTOUT. THERE ARE 10 SECTORS, EACH 97 | REPRESENTING A 20*70 AREA OF THE MAP, ARRANGED AS FOLLOWS: 98 | 99 | 0 5 100 | 1 6 101 | 2 7 102 | 3 8 103 | 4 9 104 | 105 | THE SECTORS OVERLAP BY 10 VERTICALLY, AND 40 HORIZONTALLY. 106 | NOTE THAT THE SECTORS FOR UPDATING 107 | ARE SLIGHTLY DIFFERENT, BUT THIS IS UNIMPORTANT. 108 | J: PUT YOU IN EDITING MODE, WHERE YOU CAN EXAMINE AND/OR CHANGE THE 109 | FUNCTIONS ASSOCIATED WITH YOUR PIECES AND CITIES (EXPLAINED LATER). 110 | C: GIVE THE COMPUTER A FREE MOVE. THE GAME GETS MORE INTERESTING IF 111 | YOU GIVE THE COMPUTER A HEADSTART OF 100 ROUNDS OR SO! 112 | N: GIVE THE COMPUTER A BUNCH OF FREE MOVES (50 TO 150 IS GOOD 113 | AT THE START OF THE GAME). 114 | R: DISPLAY THE ROUND NUMBER. 115 | H: HELP! 116 | 117 | 118 | FUNCTIONS TO WHICH YOU CAN ASSIGN YOUR PIECES: 119 | 120 | AWAKE: NO FUNCTION (YOU WILL BE ASKED TO MOVE THE PIECE EVERY TURN). 121 | SENTRY: STAY PUT. DO NOT ASK THE USER TO MOVE THE PIECE. WAKE UP IF 122 | AN ENEMY PIECE COMES WITHIN SENSOR RANGE. 123 | RANDOM: (FOR ARMIES ONLY) MOVE AT RANDOM SUBJECT TO THE FOLLOWING CONDITIONS: 124 | IF AN UNCONTROLLED CITY IS ADJACENT, ATTACK IT. 125 | IF AN ENEMY UNIT IS ADJACENT, ATTACK IT. 126 | IF AN UNFILLED TROOP TRANSPORT OF YOURS IS ADJACENT, GET ON IT AND 127 | WAKE UP. 128 | MOVE IF POSSIBLE WITHOUT ATTACKING ANY OF YOUR OWN UNITS. 129 | IT WILL NOT DESTROY ITSELF UNLESS IT IS IN A CITY 130 | SURROUNDED BY YOUR UNITS. 131 | AN EASY WAY TO GIVE IT THIS FUNCTION IS TYPE 'R' WHEN A MOVE 132 | IS REQUESTED. 133 | MOVE: MOVE TOWARDS LOCATION ASSIGNED TO THE PIECE (IN EDITING MODE). 134 | WAKE UP IF ENEMY PIECE IS ENCOUNTERED. WAKE UP TEMPORARILY IF OBSTACLE IS 135 | IN PATH OF MOVEMENT. 136 | DIRECTION: MOVE IN SPECIFIED DIRECTION, WAKE UP IF ENEMY PIECE IS 137 | ENCOUNTERED. WAKE UP TEMPORARILY IF OBSTACLE IS IN PATH OF MOVEMENT. 138 | FILL: (TROOP TRANSPORTS AND AIRCRAFT CARRIERS ONLY) GO ON SENTRY DUTY 139 | UNTIL FULL OF ARMIES OR FIGHTERS. 140 | 141 | ------------- 142 | 143 | SENSOR PROBES ARE DONE BEFORE AND AFTER EVERY MOVE. SENSOR PROBES 144 | SHOW ONLY THE 8 SQUARES ADJACENT TO YOUR UNIT. THE MAP DISPLAYS ALL 145 | THE MOST RECENT INFORMATION. 146 | 147 | COORDINATES ARE 4-DIGIT NUMBERS. THE FIRST 2 ARE THE ROW, THE 148 | SECOND 2 ARE THE COLUMN. 149 | 150 | MOVING ONTO THE EDGE OF THE MAP IS A FATAL ERROR. 151 | 152 | MOVEMENT 153 | -------- 154 | COMMANDS ARE: 155 | 156 | QWE 157 | A D 158 | ZXC 159 | 160 | MOVE IN THE DIRECTION OF THE KEY FROM S. THE TERMINAL IS SET 161 | NO ECHO AND ONLY 1 CHARACTER IS ACCEPTED, SO NO NEED FOR . 162 | HIT THE SPACE BAR IF YOU WANT THE PIECE TO STAY PUT. 163 | 164 | THE FOLLOWING COMMANDS HAVE THE SAME EFFECT AS IN [YOUR ORDERS?] 165 | P,J,H,T,V 166 | 167 | OTHER COMMANDS ARE: 168 | R: IF IT'S AN ARMY, SET IT TO MOVING AT RANDOM 169 | S: PUT ON SENTRY DUTY. 170 | I: SET UNIT TO MOVING IN A DIRECTION SPECIFIED BY THE NEXT CHARACTER 171 | TYPED IN, I.E. QWE 172 | A D 173 | ZXC 174 | G: PUT THE TROOP TRANSPORT (OR AIRCRAFT CARRIER) TO SLEEP UNTIL IT 175 | ACCUMULATES 6 ARMIES (OR 8 FIGHTERS), THEN WAKE IT UP. THIS IS EQUIVALENT 176 | TO PUTTING IT IN FUNCTION FILL. IF THE SHIP IS DAMAGED, THE SHIP WILL 177 | WAKE UP WHEN IT HAS ALL IT CAN TAKE. 178 | K: WAKE UP ALL ARMIES (OR FIGHTERS) ON THE TROOP TRANSPORT (OR AIRCRAFT 179 | CARRIER). 180 | ?: REQUEST THE NUMBER OF HITS LEFT ON A CRAFT. IT ALSO DISPLAYS THE 181 | NUMBER OF ARMIES (OR FIGHTERS) ABOARD. 182 | H: HELP! (AFTER THIS IS PRINTED, THE COMPUTER WILL WAIT FOR YOU 183 | TO FINISH READING IT. WHEN YOU DO, TYPE ANY CHARACTER, AFTER WHICH THE 184 | SCREEN WILL BE REFRESHED.) 185 | 186 | GARBAGEY COMMANDS WILL BE IGNORED. A BELL WILL PROMPT YOU IF INPUT IS EXPECTED. 187 | 188 | 189 | EDITING MODE 190 | ------------ 191 | 192 | QWE 193 | A D 194 | ZXC 195 | 196 | THIS MOVES THE CURSOR AROUND. 197 | O: EXIT FROM EDITING MODE. 198 | P: PRINT NEW SECTOR. 199 | R: DISPLAY ROUND #. 200 | I: GIVE PIECE (OR CITY) THE FUNCTION 'DIRECTION', ENTER THE KEY 201 | SPECIFYING THE DIRECTION FOLLOWING THE 'I'. 202 | K: WAKE UP PIECE (OR CITY). 203 | S: PUT PIECE (OR CITY) TO SLEEP. 204 | ?: REQUEST INFO ON PIECE OR CITY. IRRELEVANT FOR FIGHTERS OR ARMIES. 205 | Y: CHANGE PHASE OF CITY THAT CURSOR IS ON TOP OF. WHEN PROGRAM ASKS FOR 206 | PRODUCTION DEMANDS, KEY IN THE LETTER CORRESPONDING TO WHAT YOU WANT 207 | PRODUCED. 208 | L: PUT ARMY IN 'RANDOM'. 209 | M: PUT PIECE (OR CITY) IN 'MOVE' FUNCTION. 210 | THEN MOVE THE CURSOR TO WHERE YOU WANT IT TO GO, AND TYPE 'H'. 211 | 212 | YOU CAN GIVE CITIES FUNCTIONS. THIS DOESN'T AFFECT THE CITY ANY, BUT ANY 213 | FIGHTER LANDING IN THAT CITY WILL PICK UP THE SPECIFIED FUNCTION. THIS IS 214 | USEFUL FOR SETTING UP AUTOMATIC FIGHTER MOVEMENTS. 215 | 216 | NOTE THAT YOU CANNOT AFFECT ANYTHING INSIDE A CITY WITH THE EDITOR. THIS 217 | ALSO HOLDS FOR ANYTHING ON BOARD A TROOP TRANSPORT OR AN AIRCRAFT CARRIER. 218 | 219 | FIGHTERS MOVING UNDER THE COMMAND OF A FUNCTION WILL DROP OUT WHEN THEY HAVE 220 | 10 ROUNDS OF FUEL LEFT. THIS IS TO ENABLE YOU TO DECIDE WHETHER YOU WANT TO 221 | MAKE IT KAMIKAZE OR SEND IT BACK TO A CITY FOR REFUELING. 222 | 223 | 224 | .TY CTLB 225 | 226 | 227 | . -------------------------------------------------------------------------------- /HELP.MAC: -------------------------------------------------------------------------------- 1 | 2 | TITLE HELP 3 | ENTRY HELP 4 | 5 | T0=0 6 | T1=1 7 | P=17 8 | 9 | HLPFIL: 5 10 | ^D29970,,'WBG'-202020 11 | 'EMPHLP' 12 | 'HLP ' 13 | BLOCK 2 14 | 15 | HELP: OPEN 11,[400000,,17 16 | 'ALL ' 17 | Z] 18 | POPJ P, 19 | LOOKUP 11,HLPFIL 20 | JRST DONE 21 | MOVE T0,.JBFF## 22 | MOVE T1,T0 23 | ADD T1,HLPFIL+5 24 | CORE T1, 25 | HALT . 26 | SOJ T0, 27 | MOVN T1,HLPFIL+5 28 | HRL T0,T1 29 | SETZ T1, 30 | INPUT 11, T0 31 | OUTSTR @.JBFF## 32 | MOVE T0,.JBFF## 33 | CORE T0, 34 | JFCL 35 | DONE: RELEAS 11, 36 | POPJ P, 37 | 38 | END 39 | 40 | 41 | . -------------------------------------------------------------------------------- /MUNCH.MAC: -------------------------------------------------------------------------------- 1 | 2 | TITLE MUNCH 3 | ENTRY ZEROST,EXITER 4 | 5 | .JBAPR=^O125 6 | 7 | ZEROST: CLEARM 120 ;ZERO START ADDRESS 8 | 9 | MOVEI TRPBLK 10 | MOVEM .JBAPR 11 | 12 | POPJ 17, 13 | 14 | TRPBLK: XWD 4,INTRTN 15 | XWD 400000,1B34!1B30 16 | 0 17 | 0 18 | 19 | INTRTN: PUSH 17,TRPBLK+2 20 | SETZM TRPBLK+2 21 | PUSH 17,0 ;SAVE AC 0 22 | MOVE 0,TRPBLK+3 23 | TLNE 2 24 | JRST EXITER 25 | TLNN 40 26 | HALT . 27 | POP 17,0 28 | POPJ 17, ;GO BACK WHERE YOU CAME FROM 29 | 30 | EXITER: MOVEI 0,[EXP 'SYS ','MONSIM',0,0,0,0] 31 | RUN 200000 32 | HALT . 33 | END 34 | 35 | 36 | . -------------------------------------------------------------------------------- /PACK.MAC: -------------------------------------------------------------------------------- 1 | 2 | SALL 3 | TITLE PACK SUBROUTINE TO PACK EMP.DAT TO EMPIRE.DAT 4 | ENTRY PACK 5 | .DIRECT .XTABM 6 | K=0 7 | T1=1 8 | T2=2 9 | T3=3 10 | T4=4 11 | Z=5 12 | I=6 13 | J=7 14 | C=10 15 | R=11 16 | RT=12 17 | ND=13 18 | L=14 19 | B=15 20 | P=17 21 | ICHN==1 22 | OCHN==2 23 | NUMBER==123456 24 | BIT==400000 25 | MAXLEN==1000 26 | 27 | PACK: MOVE T1,[T2,,SAVEAC] 28 | BLT T1,SAVEAC+13 29 | MOVEI Z,11 30 | SKIPL C,@0(16) 31 | JRST COMPRS 32 | RESTOR: MOVEI T1,^D36 33 | PUSHJ P,SETIN 34 | PUSHJ P,READHD 35 | MOVEI T1,(Z) 36 | PUSHJ P,SETOUT 37 | PUSHJ P,DECODE 38 | JRST FINISH 39 | COMPRS: MOVEI T1,(Z) 40 | PUSHJ P,SETIN 41 | MOVEI T1,^D36 42 | PUSHJ P,SETOUT 43 | MOVE T1,[LINKS,,LINKS+1] 44 | SETZM LINKS 45 | BLT T1,LINKS+MAXLEN-1 46 | MOVEI T1,4 47 | IMUL T1,INBLK+5 48 | MOVEM T1,TOTAL 49 | PUSHJ P,COUNT 50 | MOVE T2,LENGTH 51 | PUSHJ P,LINK 52 | PUSHJ P,BITMAK 53 | SETZM CNTIN 54 | SETZM CNTOUT 55 | PUSHJ P,WRITHD 56 | WAIT ICHN, 57 | USETI ICHN,1 58 | HRRZ T1,IBUF 59 | MOVEI T2,(T1) 60 | MOVSI T3,400000 61 | ZAPBUF: ANDCAM T3,(T2) 62 | HRRZ T2,(T2) 63 | CAIE T2,(T1) 64 | JRST ZAPBUF 65 | IORM T3,IBUF 66 | SETZM IBUF+2 67 | PUSHJ P,ENCODE 68 | JRST FINISH 69 | WRITHD: MOVSI T1,NUMBER 70 | IORI T1,(Z) 71 | PUSHJ P,PUTWRD 72 | LDB T1,[POINT 4,INBLK+4,12] 73 | HLL T1,INBLK+3 74 | PUSHJ P,PUTWRD 75 | MOVE T1,TOTAL 76 | PUSHJ P,PUTWRD 77 | HRLZ T1,LENGTH 78 | SUBI T1,-1 79 | PUSHJ P,PUTWRD 80 | MOVN T2,LENGTH 81 | MOVSI T2,1(T2) 82 | MOVE T1,LINKS+1(T2) 83 | PUSHJ P,PUTWRD 84 | AOBJN T2,.-2 85 | POPJ P, 86 | PUTWRD: SOSG OBUF+2 87 | JRST PUTBF 88 | PUTBFC: IDPB T1,OBUF+1 89 | POPJ P, 90 | PUTBF: AOS CNTOUT 91 | OUT OCHN, 92 | JRST PUTBFC 93 | HALT 94 | ENCODE: SETZB T1,T2 95 | MOVEI T3,^D36 96 | MOVE T4,TOTAL 97 | SETZM BITTTL 98 | CODLOP: PUSHJ P,CHARIN 99 | HALT 100 | MOVE T2,BITS(C) 101 | SKIPN C,COUNTS(C) 102 | HALT 103 | ADDM C,BITTTL 104 | SUBI T3,(C) 105 | CODPUT: ROTC T1,(C) 106 | JUMPG T3,CODNXT 107 | ROTC T1,(T3) 108 | PUSHJ P,PUTWRD 109 | MOVN C,T3 110 | ADDI T3,^D36 111 | JUMPN C,CODPUT 112 | CODNXT: SOJG T4,CODLOP 113 | CAIN T3,^D36 114 | POPJ P, 115 | LSH T1,(T3) 116 | JRST PUTWRD 117 | LINK: MOVE ND,LENGTH 118 | SOS RT,ND 119 | LSH RT,-1 120 | JUMPN RT,MKHEAP 121 | MKLINK: MOVE T1,CHARS 122 | MOVE T2,CHARS+1 123 | MOVE T3,COUNTS(T1) 124 | ADD T3,COUNTS(T2) 125 | MOVEM T3,BITS(ND) 126 | TRZN T1,MAXLEN 127 | ORI T1,BIT 128 | TRZN T2,MAXLEN 129 | ORI T2,BIT 130 | HRLI T1,(T2) 131 | MOVEM T1,LINKS(ND) 132 | MOVEI T1,MAXLEN(ND) 133 | MOVEM T1,CHARS 134 | MOVE T1,CHARS(ND) 135 | MOVEM T1,CHARS+1 136 | SOJLE ND,CPOPJ 137 | MOVEI RT,1 138 | MKHEAP: MOVE R,CHARS(RT) 139 | MOVE K,COUNTS(R) 140 | MOVE J,RT 141 | GODOWN: MOVE I,J 142 | LSH J,1 143 | CAILE J,(ND) 144 | JRST PTRSAV 145 | CAIL J,(ND) 146 | JRST MOVEON 147 | MOVE T1,CHARS(J) 148 | MOVE T1,COUNTS(T1) 149 | MOVE T2,CHARS+1(J) 150 | CAMLE T1,COUNTS(T2) 151 | AOS J 152 | MOVEON: MOVE T1,CHARS(J) 153 | CAMG K,COUNTS(T1) 154 | JRST PTRSAV 155 | MOVEM T1,CHARS(I) 156 | JRST GODOWN 157 | PTRSAV: MOVEM R,CHARS(I) 158 | SOJG RT,MKHEAP 159 | JUMPL RT,MKLINK 160 | MOVE R,CHARS 161 | MOVE K,COUNTS(R) 162 | SETZ I, 163 | MOVEI J,2 164 | JRST GODOWN+2 165 | CPOPJ: POPJ P, 166 | BITMAK: MOVE T1,[COUNTS,,COUNTS+1] 167 | SETZM COUNTS 168 | BLT T1,COUNTS+MAXLEN-1 169 | HRLOI T1,377777 170 | MOVEM T1,BITMIN 171 | SETZB L,BITMAX 172 | MOVEI I,1 173 | RECURS: ADDI L,1 174 | CAILE L,^D36 175 | HALT 176 | MOVE I,LINKS(I) 177 | ANDCM B,BITTAB(L) 178 | HLLM I,(P) 179 | PUSHJ P,DOWNGO 180 | HLRZ I,(P) 181 | IOR B,BITTAB(L) 182 | DOWNGO: TRZE I,BIT 183 | JRST TERMIN 184 | PUSHJ P,RECURS 185 | SOJA L,CPOPJ 186 | TERMIN: MOVEM L,COUNTS(I) 187 | CAMLE L,BITMAX 188 | MOVEM L,BITMAX 189 | CAMGE L,BITMIN 190 | MOVEM L,BITMIN 191 | MOVEM B,BITS(I) 192 | POPJ P, 193 | FINISH: CLOSE OCHN, 194 | RELEASE OCHN, 195 | MOVEI T1,4 196 | MOVEM T1,INBLK 197 | SETZ T1, 198 | DPB T1,[POINT 9,INBLK+4,8] 199 | RENAME ICHN,INBLK 200 | JFCL 201 | SETZM INBLK+2 202 | RENAME ICHN,INBLK 203 | OUTSTR [ASCIZ/UNABLE TO DELETE INPUT FILE 204 | /] 205 | RELEASE ICHN, 206 | MOVE T1,[SAVEAC,,T2] 207 | BLT T1,B 208 | POPJ P, 209 | DECODE: MOVE T2,TOTAL 210 | SETZ T3, 211 | DECLOP: MOVE I,LINKS 212 | DECBIT: MOVE I,LINKS(I) 213 | SOJG T3,DECSMW 214 | MOVEI T3,^D36 215 | PUSHJ P,GETWRD 216 | SKIPA T4,T1 217 | DECSMW: LSH T4,1 218 | JUMPGE T4,.+2 219 | MOVS I,I 220 | TRNN I,BIT 221 | JRST DECBIT 222 | MOVEI T1,(I) 223 | PUSHJ P,PUTWRD 224 | SOJG T2,DECLOP 225 | POPJ P, 226 | SETIN: MOVEI T2,14 227 | MOVE T3,DEV 228 | MOVEI T4,IBUF 229 | OPEN ICHN,T2 230 | OPERR: JRST [OUTSTR [ASCIZ/CANT OPEN INPUT DEVICE 231 | /] 232 | HALT] 233 | MOVE T2,[INBLK,,INBLK+1] 234 | SETZM INBLK 235 | BLT T2,INBLK+14 236 | MOVEI T2,14 237 | MOVEM T2,INBLK 238 | SKIPL C,@0(16) 239 | JRST COMN 240 | MOVE T2,DAT 241 | INCON: MOVEM T2,INBLK+2 242 | MOVE T2,EXT 243 | HLLM T2,INBLK+3 244 | SETZM INBLK+1 245 | LOOKUP ICHN,INBLK 246 | LKERR: JRST [OUTSTR [ASCIZ\CANT LOOKUP/ENTER FILE 247 | \] 248 | HALT] 249 | SKIPN Z,T1 250 | JRST [OUTSTR [ASCIZ/NOT A CHANCE/] 251 | HALT] 252 | DPB Z,[POINT 6,IBUF+1,11] 253 | INBUF ICHN,3 254 | POPJ P, 255 | COMN: MOVE T2,TMP 256 | JRST INCON 257 | SETOUT: MOVEI T2,14 258 | MOVE T3,DEV 259 | MOVSI T4,OBUF 260 | OPEN OCHN,T2 261 | JRST OPERR 262 | DPB T1,[POINT 6,OBUF+1,11] 263 | MOVE T1,[INBLK,,OUTBLK] 264 | BLT T1,OUTBLK+14 265 | SETZM OUTBLK+11 266 | SKIPL C,@0(16) 267 | JRST SETC 268 | MOVE T1,TMP 269 | SETOU1: MOVEM T1,OUTBLK+2 270 | ENTER OCHN,OUTBLK 271 | JRST LKERR 272 | OUTBUF OCHN,3 273 | POPJ P, 274 | SETC: MOVE T1,DAT 275 | JRST SETOU1 276 | GETWRD: SOSGE IBUF+2 277 | JRST GETWRB 278 | ILDB T1,IBUF+1 279 | POPJ P, 280 | GETWRB: AOS CNTIN 281 | IN ICHN, 282 | JRST GETWRD 283 | HALT 284 | COUNT: SETZB C,LENGTH 285 | MOVE T1,[CHARS,,CHARS+1] 286 | SETZM CHARS 287 | BLT T1,CHARS+MAXLEN-1 288 | MOVE T1,[COUNTS,,COUNTS+1] 289 | SETZM COUNTS 290 | BLT T1,COUNTS+MAXLEN-1 291 | MOVE T2,TOTAL 292 | CNTLOP: PUSHJ P,CHARIN 293 | HALT 294 | SKIPE COUNTS(C) 295 | JRST CNTMOR 296 | AOS T1,LENGTH 297 | MOVEM C,CHARS-1(T1) 298 | CNTMOR: AOS COUNTS(C) 299 | SOJG T2,CNTLOP 300 | POPJ P, 301 | CHARIN: SOSGE IBUF+2 302 | JRST GETBF 303 | IBP IBUF+1 304 | LDB C,IBUF+1 305 | AOS (P) 306 | POPJ P, 307 | GETBF: AOS CNTIN 308 | IN ICHN, 309 | JRST CHARIN 310 | STATZ ICHN,740000 311 | HALT 312 | POPJ P, 313 | READHD: PUSHJ P,GETWRD 314 | TLC T1,NUMBER 315 | TLNE T1,-1 316 | JRST [OUTSTR [ASCIZ/WRONG HEADER DATE IN FILE 317 | /] 318 | HALT] 319 | MOVEI Z,(T1) 320 | PUSHJ P,GETWRD 321 | PUSHJ P,GETWRD 322 | MOVEM T1,TOTAL 323 | PUSHJ P,GETWRD 324 | MOVEI T4,1 325 | LSH T4,(Z) 326 | HLRZ T2,T1 327 | SKIPE T2 328 | CAILE T2,(T4) 329 | HALT 330 | MOVEM T2,LENGTH 331 | MOVEI T2,(T1) 332 | SKIPE T2 333 | CAILE T2,(T4) 334 | HALT 335 | MOVEM T2,LINKS 336 | MOVN T2,LENGTH 337 | MOVSI T2,(T2) 338 | HDRRDL: PUSHJ P,GETWRD 339 | MOVEM T1,LINKS+1(T2) 340 | JUMPE T1,HDRRDN 341 | HLRZ T3,T1 342 | TRZN T3,BIT 343 | SKIPE T3 344 | CAILE T3,(4) 345 | HALT 346 | MOVEI T1,(T1) 347 | TRZN T1,BIT 348 | SKIPE T1 349 | CAILE T1,(T4) 350 | HALT 351 | HDRRDN: AOBJN T2,HDRRDL 352 | POPJ P, 353 | BITTAB: EXP 0 354 | XX==1B0 355 | REPEAT ^D36,< 356 | EXP XX 357 | XX==XX_<-1> 358 | > 359 | DAT: 'EMPIRE' 360 | EXT: 'DAT ' 361 | DEV: 'DSK ' 362 | TMP: 'EMP ' 363 | IBUF: BLOCK 3 364 | OBUF: BLOCK 3 365 | INBLK: BLOCK 15 366 | OUTBLK: BLOCK 15 367 | SAVEAC: BLOCK 14 368 | BITMAX: BLOCK 1 369 | BITMIN: BLOCK 1 370 | TOTAL: BLOCK 1 371 | BITTTL: BLOCK 1 372 | LENGTH: BLOCK 1 373 | CNTIN: BLOCK 1 374 | CNTOUT: BLOCK 1 375 | CHARS: BLOCK MAXLEN 376 | COUNTS: BLOCK MAXLEN 377 | BITS: BLOCK MAXLEN 378 | LINKS: BLOCK MAXLEN 379 | XPUNGE 380 | END 381 | 382 | 383 | . -------------------------------------------------------------------------------- /PATH.FOR: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | 5 | INTEGER FUNCTION PATH(BEG,END,DIR2,OK,FLAG) 6 | INCLUDE 'COMMON.EMP/NOLIST' 7 | DIMENSION OK(5) 8 | 9 | DIR=DIR2 !DON'T CHANGE DIR BACK IN CALLING PROG 10 | 11 | * CHECK FOR ERRORS 12 | IF(.NOT.PASS) GOTO 2116 13 | IF((DIR#1).AND.(DIR#-1)) TYPE 2222,BEG,END,DIR 14 | IF((BEG<1).OR.(BEG>6000)) TYPE 2222,BEG,END,DIR 15 | IF((END<1).OR.(END>6000)) TYPE 2222,BEG,END,DIR 16 | 2222 FORMAT(' PATH: BEG,END,DIR-',3G) 17 | 18 | * INITIALIZATION 19 | 2116 BACKUP=1 20 | BEGDIR=DIR 21 | MOVNUM=0 22 | MAXMVE=2*IDIST(BEG,END)+1 23 | Z6=BEG 24 | CALL SET(G2,100,0) !ZERO G2 25 | 26 | * PICK A MOVE IN THE DIRECTION OF THE DESTINATION 27 | 102 MOVE=MOV(Z6,END) 28 | Z62=Z6+IARROW(MOVE) 29 | AB=AMAPP(Z62,0,MAPS) 30 | DO 100 I=1,3 31 | 100 IF(OK(I)==AB) GOTO 101 32 | IF(D1(Z62)==OK(1)) GOTO 101 33 | GOTO 1000 !RUN UP AGAINST AN OBSTACLE 34 | 35 | * MOVE IS ACCEPTABLE 36 | 101 MOVNUM=MOVNUM+1 37 | IF(Z6==BEG) MOVE1=MOVE 38 | Z6=Z62 39 | IF(FLAG>=1000) CALL TEST4(Z6,FLAG,DIR,MOVE1, 40 | &MOVNUM,BEG,END,G2,'MOV') 41 | 42 | *NOW CHECK TO SEE IF Z6 IS RIGHT NEXT TO END, AND END # OK(N) 43 | IF(IDIST(Z6,END)#1) GOTO 103 !IF NOT NEXT TO END 44 | AB=AMAPP(END,0,MAPS) 45 | DO 104 I=1,3 46 | 104 IF(AB==OK(I)) GOTO 102 !END IS LEGAL MOVE 47 | IF(D1(END)==OK(1)) GOTO 102 !DITTO 48 | GOTO 2000 !STOP HERE 49 | 50 | 103 IF(Z6==END) GOTO 2000 51 | IF(MOVNUM>=MAXMVE) GOTO 3000 52 | GOTO 102 53 | 54 | * TRY ANOTHER DIRECTION 55 | 3000 DIR=-DIR 56 | IF(BEGDIR==DIR) GOTO 4000 57 | MOVNUM=0 58 | BACKUP=1 59 | Z6=BEG 60 | CALL SET(G2,100,0) !ZERO G2 61 | GOTO 102 62 | 63 | * RETURN, HAVING SUCCEEDED 64 | 2000 PATH=MOVE1 65 | SUCCESS=SUCCESS+1 66 | FLAG=1 !INDICATING SUCCESS 67 | RETURN 68 | 69 | * FOLLOW SHORE 70 | 1000 MOV1=ICORR(MOVE-DIR*3) 71 | Z62=Z6+IARROW(MOV1) 72 | AB=AMAPP(Z62,0,MAPS) 73 | DO 1008 I=1,3 74 | 1008 IF(AB==OK(I)) GOTO 1009 75 | IF(D1(Z62)==OK(1)) GOTO 1009 76 | GOTO 1010 77 | 1009 MOV1=MOVE 78 | 79 | 1010 DO 1001 J=MOV1,MOV1+DIR*7,DIR 80 | MOVE=ICORR(J) 81 | Z62=Z6+IARROW(MOVE) 82 | IF(ORDER(Z62)#0.0) GOTO 1001 83 | AB=AMAPP(Z62,0,MAPS) 84 | DO 1002 K=1,3 85 | 1002 IF(AB==OK(K)) GOTO 1003 86 | IF(D1(Z62)==OK(1)) GOTO 1003 87 | GOTO 1001 88 | 89 | * MOVE IS ACCEPTABLE 90 | 1003 MOVNUM=MOVNUM+1 91 | IF(Z6==BEG) MOVE1=MOVE 92 | Z6=Z62 93 | IF(FLAG>=1000) CALL TEST4(Z6,FLAG,DIR,MOVE1, 94 | &MOVNUM,BEG,END,G2,'SHORE') 95 | IF(IDIST(Z6,END)#1) GOTO 105 96 | AB=AMAPP(END,0,MAPS) 97 | DO 106 I=1,3 98 | 106 IF(AB==OK(I)) GOTO 102 99 | IF(D1(END)==OK(1)) GOTO 102 100 | GOTO 2000 101 | 105 IF(Z6==END) GOTO 2000 102 | IF(MOVNUM>=MAXMVE) GOTO 3000 103 | GOTO 1007 104 | 1001 CONTINUE 105 | 106 | * RETURN, HAVING FAILED TO FIND A PATH FROM BEG TO END 107 | 4000 PATH=MOV(BEG,END) 108 | FAILURE=FAILURE+1 109 | FLAG=0 !INDICATING FAILURE 110 | RETURN 111 | 112 | 1007 MOVE2=MOV(Z6,END) 113 | Z62=Z6+IARROW(MOVE2) 114 | AB=AMAPP(Z62,0,MAPS) 115 | DO 1004 I=1,3 116 | 1004 IF(AB==OK(I)) GOTO 1005 117 | IF(D1(Z62)==OK(1)) GOTO 1005 118 | GOTO 1000 119 | 1005 DO 1006 I=1,BACKUP 120 | 1006 IF(Z6==G2(I)) GOTO 1000 121 | G2(BACKUP)=Z6 122 | BACKUP=BACKUP+1 123 | IF(BACKUP>100) GOTO 3000 124 | GOTO 102 125 | 126 | END 127 | 128 | 129 | 130 | 131 | SUBROUTINE TEST3 132 | INCLUDE 'COMMON.EMP/NOLIST' 133 | DIMENSION OK(5),COMM(20) 134 | DATA OK/'+','5',' ',' ',-1/ 135 | DATA COMM/'D','E','W','Q','A','Z','X','C','S', 136 | & 'P','B','F','T','G','V','I','J',-1,-1,-1/ 137 | 138 | !P: REFRESH SCREEN 139 | !B: TYPE BEG 140 | !F: TYPE END 141 | !T: TRACE 142 | !G: GO 143 | !V: RETURN 144 | !I: DIR=-DIR 145 | 146 | LINE=KLINE(KI,JECTOR) 147 | IADJST=LINE+KI-300 148 | Z6=IADJST+300 149 | DIR=1 150 | 100 CALL CURSOR(Z6-IADJST,KURSOR) 151 | CALL ECHOFF 152 | CALL OUTCHR("7) 153 | E=GETCHX(E) 154 | Z7=Z6 155 | DO 101 I=1,8 156 | 101 IF(E==COMM(I)) Z6=Z6+IARROW(I) 157 | IF(Z6==Z7) GOTO 102 158 | GOTO 100 159 | 102 DO 103 I=10,20 160 | J=I 161 | 103 IF(E==COMM(I)) GOTO 104 162 | GOTO 100 163 | 104 GOTO (10,11,12,13,14,15,16,17,18,19,20) J-9 164 | 10 CALL SECTOR(0) 165 | GOTO 100 166 | 11 BEG=Z6 167 | CALL OUTCHR("102) 168 | GOTO 100 169 | 12 END=Z6 170 | CALL OUTCHR("105) 171 | GOTO 100 172 | 13 FLAG=1000 173 | CALL PATH(BEG,END,DIR,OK,FLAG) 174 | GOTO 100 175 | 14 FLAG=1001 176 | CALL PATH(BEG,END,DIR,OK,FLAG) 177 | GOTO 100 178 | 15 CALL ECHOON 179 | RETURN 180 | 16 DIR=-DIR 181 | GOTO 100 182 | 17 H2=30 183 | OWN2=A(1,Z6) 184 | CALL FIND(OWN2,Z6,Z8,H2) 185 | CODNUM=CODE(Z8-1500) 186 | CALL CURSOR(50,KURSOR) 187 | CALL STROUT(' CODE:',0) 188 | TYPE 147,CODNUM 189 | 147 FORMAT('+ ',I7,1X$) 190 | GOTO 100 191 | 18 CONTINUE 192 | 19 CONTINUE 193 | 20 CONTINUE 194 | END 195 | 196 | 197 | SUBROUTINE TEST4(Z6,FLAG,DIR,MOVE1,MOVNUM,BEG, 198 | & END,G2,FLAG2) 199 | IMPLICIT INTEGER(A-Z) 200 | COMMON/KXK/IADJST 201 | DIMENSION G2(100) 202 | 203 | CALL CURSOR(Z6-IADJST,KURSOR) 204 | IF(FLAG2=='MOV') CALL OUTCHR("107) 205 | IF(FLAG2=='SHORE') CALL OUTCHR("110) 206 | IF(FLAG==1001) RETURN 207 | CALL OUTCHR("7) 208 | E=GETCHX(E) 209 | IF(E==' ') RETURN 210 | IF(E=='G') GOTO 100 211 | CALL CURSOR(0,KURSOR) 212 | TYPE 101,Z6,MOVE1,MOVNUM 213 | 101 FORMAT(' Z6:',I4,' MOVE1:',I1,' MOVNUM:',I3) 214 | CALL CURSOR(100,KURSOR) 215 | TYPE 103,BEG,END,IADJST,DIR,FLAG 216 | 103 FORMAT(' BEG:'I4' END:'I4' IADJST:'I4' DIR:'I2' FLAG:'I4) 217 | RETURN 218 | 100 CALL CURSOR(0,KURSOR) 219 | TYPE 102,G2 220 | 102 FORMAT(1X,16I5) 221 | RETURN 222 | END 223 | 224 | 225 | 226 | 227 | . -------------------------------------------------------------------------------- /PATH.MAC: -------------------------------------------------------------------------------- 1 | 2 | TITLE PATH 3 | ENTRY PATH 4 | T0=0 5 | T1=1 6 | OK=10 ;TEMP DEFINITIONS 7 | 8 | ;CALLING SEQUENCE: MOVE=PATH(BEG,END,DIR,OK,FLAG) 9 | ;THIS ROUTINE COMPUTES A PATH FROM BEG TO END 10 | 11 | ;FORTRAN COMMON BLOCKS NEEDED: 12 | .COMMON IARROW [^D10] ;DIRECTIONS 13 | .COMMON G2 [^D100] ;ARRAY WHICH BACKUP POINTS INTO 14 | .COMMON TEST2 [^D2] ;REPORT SUCCESS OR FAILURE HERE 15 | 16 | 17 | ;HERE ARE THE ARGUMENTS FOR THE FIRST MACRO 18 | ARG1: BLOCK 1 19 | ARG2: BLOCK 2 20 | -2,,0 21 | AP: ARG1 22 | ARG2 23 | 24 | ;MACRO TO CALL FORTRAN SUBROUTINE WITH 2 ARGUMENTS 25 | ; IN ACCUMULATORS. 26 | DEFINE CALLF2 (AC1,AC2,SUBROU) 27 | < 28 | MOVEM AC1,ARG1 ;PUT FIRST ACC IN FIRST ARG 29 | MOVEM AC2,ARG2 ;SET UP SECOND ARG 30 | MOVEI 16,AP ;SET UP VARIABLE POINTER 31 | PUSHJ 17,SUBROU ;CALL SUBROUTINE 32 | > 33 | 34 | ;HERE IS THE ARGUMENT BLOCK FOR THE SECOND MACRO 35 | ARG3: BLOCK 1 36 | -1,,0 37 | AP2: ARG3 38 | 39 | ;MACRO TO CALL FORTRAN SUBROUTINE WITH 1 ARG IN AC 40 | DEFINE CALLF1 (AC,SUBROU) 41 | < 42 | MOVEM AC,ARG3 43 | MOVEI 16,AP2 44 | PUSHJ P,SUBROU 45 | > 46 | 47 | ;MACRO TO CALL FORTRAN MOV SUBROUTINE 48 | DEFINE MOOV (START,FINISH,RETVAL) 49 | < 50 | MOVE 0,START 51 | MOVE 1,FINISH 52 | CALLF2 (0,1,MOV##) 53 | MOVEM 0,RETVAL 54 | > 55 | 56 | 57 | ;MACRO TO COMPUTE LOC2=LOC+IARROW(MOVE3) 58 | DEFINE NEWZ6 (LOC2,LOC,MOVE3) 59 | < 60 | MOVE LOC2,IARROW(MOVE3) 61 | ADD LOC2,LOC 62 | > 63 | 64 | ;MACRO TO GET AC=A(MAP,LOC) 65 | DEFINE AMAP (VAR,LOC,MAP) 66 | < 67 | MOVEI T0,MAP 68 | MOVE T1,LOC 69 | CALLF2 (T0,T1,AMAPP##) 70 | MOVEM T0,VAR 71 | > 72 | 73 | ;MACRO TO SEE IF AC AT LOC IS SUITABLE 74 | DEFINE COMPARE (AC,LOC,RETADR) 75 | < 76 | CAMN AC,0(OK) 77 | JRST RETADR 78 | ; MOVE T0,LOC 79 | ; CALLF1 (T0,D1##) 80 | MOVE T1,LOC 81 | PUSHJ P,D1M## ;GET D1(LOC) 82 | CAMN T0,0(OK) ;OK IF D1(LOC)=OK(1) 83 | JRST RETADR ;JUMP OUT 84 | CAMN AC,1(OK) 85 | JRST RETADR 86 | CAMN AC,2(OK) 87 | JRST RETADR 88 | CAMN AC,3(OK) 89 | JRST RETADR 90 | CAMN AC,4(OK) 91 | JRST RETADR 92 | > 93 | 94 | 95 | ;ACCUMULATOR DEFINITIONS: 96 | 97 | T0=0 ;RANDOM ACCUMULATOR 98 | T1=1 ;RANDOM ACCUMULATOR 99 | INDEX=2 ;LOOP INDEX 100 | FLAG=3 ;FLAG TO AND FROM CALLING ROUTINE 101 | MOVNUM=4 ;# OF TRIES ELAPSED 102 | MOOVE=5 ;DIRECTION OF MOVE 103 | Z6=6 ;CURRENT LOCATION 104 | Z62=7 ;TRIAL Z6 105 | OK=10 ;ADDRESS OF START OF OK ARRAY 106 | BEG=11 ;STARTING POSITION 107 | END=12 ;ENDING POSITION 108 | AB=13 ;VALUE OF MAP AT A POINT 109 | BACKUP=14 ;POINTER TO BACKUP ARRAY 110 | LOPMAX=15 ;=MOV1+DIR*7 111 | VARSTK=16 ;FORTRAN VARIABLE POINTER 112 | P=17 ;STACK POINTER 113 | 114 | 115 | ;MORE RANDOM VARIABLES: 116 | 117 | DIR: BLOCK 1 ;DIRECTION TO FOLLOW ON SHORE 118 | MAXMVE: BLOCK 1 ;MAXIMUM # OF TRIES 119 | SAVACS: BLOCK ^D12 ;SAVE ACCUMULATORS HERE 120 | BEGDIR: BLOCK 1 ;STARTING DIRECTION 121 | BAKADR: BLOCK 1 ;RETURN ADDRESS FROM MACRO COMPARE 122 | MOVE1: BLOCK 1 ;STORE MOVE A MOMENT 123 | MOV1: BLOCK 1 ; " " " " 124 | MOVE2: BLOCK 1 ; " " " " 125 | DIR3: BLOCK 1 ;=DIR*3 126 | 127 | PATH: MOVE T1,[2,,SAVACS] 128 | BLT T1,SAVACS+^D11 ;SAVE ACS 2-15 129 | 130 | SETZ BACKUP, ;INITIALIZE POINTER 131 | 132 | MOVE T0,@2(16) 133 | MOVEM T0,DIR ;GET AND STORE DIR 134 | 135 | MOVEM T0,BEGDIR ;STORE BEGDIR 136 | 137 | MOVEI FLAG,@4(16) ;GET ADDRESS OF FLAG 138 | 139 | MOVEI OK,@3(16) ;GET ADDRESS OF OK ARRAY 140 | 141 | IMULI T0,3 142 | MOVEM T0,DIR3 ;STORE DIR3 143 | 144 | MOVE T0,@0(16) ;GET FIRST ARG 145 | MOVE T1,@1(16) ;GET SECOND ARG 146 | MOVE BEG,T0 ;INITIALIZE BEG 147 | MOVE END,T1 ;INITIALIZE END 148 | MOVE Z6,BEG ;INITIALIZE Z6 149 | CALLF2 (BEG,END,IDIST##) ;COMPUTE DISTANCE BETWEEN BEG,END 150 | IMULI T0,2 ;MUL DISTANCE*2 151 | ADDI T0,1 ;ADD 1 152 | MOVEM T0,MAXMVE ;MAXMVE=2*IDIST(BEG,END)+1 153 | MOVE MOVNUM,T0 ;INITIALIZE MOVNUM TO MAXMVE 154 | 155 | PUSHJ P,G20 ;ZERO G2 ARRAY 156 | 157 | STRGHT: MOOV (Z6,END,MOOVE) 158 | NEWZ6 (Z62,Z6,MOOVE) 159 | 160 | AMAP (AB,Z62,0) 161 | 162 | COMPARE (AB,Z62,OKSET) ;SEE IF MOVE IS OK 163 | JRST FOLSHR ;GIVE UP AND FOLLOW THE SHORE 164 | 165 | OKSET: MOVEI T0,STRGHT 166 | MOVEM T0,BAKADR ;STORE RETURN ADDRESS 167 | 168 | ;................................................................. 169 | OKMOVE: CAMN Z6,BEG 170 | MOVEM MOOVE,MOVE1 ;IF(Z6==BEG) MOVE1=MOOVE 171 | 172 | MOVE Z6,Z62 ;Z6 IS NOW NEW POSITION 173 | 174 | MOVEI T0,^D1000 175 | CAMG T0,@FLAG 176 | PUSHJ P,TEST ;IF FLAG>=1000 CALL TEST4 177 | 178 | CAMN Z6,END 179 | JRST SUCCES ;IF Z6==END, WE ARE DONE 180 | 181 | DOMORE: SOJE MOVNUM,TRYDIR ;TRY NEW DIR IF MOVNUM=0 182 | JRST @BAKADR ;CONTINUE ON MUNCHING 183 | ;.................................................... 184 | 185 | TRYDIR: MOVNS ,DIR3 ;NEGATE DIR3 186 | MOVNS T1,DIR ;NEGATE DIR 187 | 188 | CAMN T1,BEGDIR 189 | JRST FAILUR ;IF DIR=BEGDIR, FAILURE 190 | 191 | MOVE MOVNUM,MAXMVE ;RESET MOVNUM 192 | SETZ BACKUP, ;ZERO BACKUP POINTER 193 | MOVE Z6,BEG ;SET Z6 BACK TO START 194 | PUSHJ P,G20 ;ZERO BACKUP ARRAY 195 | JRST STRGHT ;START OVER 196 | 197 | SUCCES: MOVE T0,MOVE1 ;PASS MOVE1 TO CALLING PROG 198 | AOS T1,TEST2 ;ADD 1 TO SUCCESS VARIABLE 199 | MOVEI T1,1 200 | MOVEM T1,@FLAG ;SET FLAG TO 1 201 | JRST RETURN 202 | 203 | FOLSHR: MOVE T0,MOOVE 204 | SUB T0,DIR3 205 | PUSHJ P,CORR## 206 | MOVEM T0,MOV1 ;MOV1=CORR(MOVE-DIR*3) 207 | 208 | MOVE T1,T0 ;SO WE CAN INDEX BY MOV1 209 | NEWZ6 (Z62,Z6,T1) ;NOTE T1=MOV1 210 | 211 | AMAP (AB,Z62,0) 212 | 213 | COMPARE (AB,Z62,SIDEOK) 214 | SKIPA 215 | SIDEOK: MOVEM MOOVE,MOV1 ;INITIAL CONTACT WITH SHORE 216 | 217 | STFOL: MOVE INDEX,MOV1 218 | MOVE T0,DIR 219 | IMULI T0,^D8 220 | ADD T0,MOV1 221 | MOVEM T0,LOPMAX ;DO INDEX=MOV1,MOV1+7*DIR,DIR 222 | ;LOPMAX=FINAL LOOP INDEX VALUE+DIR 223 | LOOP: MOVE T0,INDEX 224 | PUSHJ P,CORR## 225 | MOVE MOOVE,T0 ;MOVE=CORR(INDEX) 226 | 227 | NEWZ6 (Z62,Z6,MOOVE) 228 | 229 | MOVE T1,Z62 ;SET UP ARGUMENT FOR ORDERM 230 | PUSHJ P,ORDERM## ;IF ORDER=0, WE ARE NOT ON EDGE 231 | ; CALLF1 (Z62,ORDER##) 232 | JUMPN T0,EOLOOP ;IF ON EDGE, TRY A NEW MOVE 233 | 234 | AMAP (AB,Z62,0) 235 | COMPARE (AB,Z62,OKSET2) ;IS IT A GOOD MOVE? 236 | JRST EOLOOP 237 | 238 | OKSET2: MOVEI T0,CHKNXT 239 | MOVEM T0,BAKADR ;STORE RETURN ADDRESS 240 | JRST OKMOVE ;MUNCH NOW THAT THAT MOVE IS OK 241 | 242 | EOLOOP: ADD INDEX,DIR ;INCREMENT LOOP INDEX 243 | CAME INDEX,LOPMAX ;IF INDEX IS EXPIRED 244 | JRST LOOP ;IF NOT CONTINUE LOOPING 245 | 246 | FAILUR: MOOV (BEG,END,T0) 247 | AOS ,TEST2+1 ;INCREMENT FAILURE COUNT 248 | CLEARM ,@FLAG ;SET FLAG TO 0 INDICATING FAILURE 249 | 250 | RETURN: MOVS T1,[2,,SAVACS] 251 | BLT T1,15 252 | POPJ P, ;RESTORE ACS AND RETURN 253 | 254 | CHKNXT: MOOV (Z6,END,T1) 255 | NEWZ6 (Z62,Z6,T1) 256 | AMAP (AB,Z62,0) 257 | COMPARE (AB,Z62,STBACK) 258 | JRST FOLSHR ;FOLLOW SHORE 259 | 260 | STBACK: MOVE INDEX,BACKUP ;SET UP LOOP INDEX 261 | 262 | LOOP2: CAMN Z6,G2(INDEX) ;SEE IF Z6 IS IN ARRAY 263 | JRST FOLSHR ;IF IT IS, FOLLOW THE SHORE 264 | SOJGE INDEX,LOOP2 ;CONTINUE TILL INDEX GOES NEGATIVE 265 | 266 | MOVEM Z6,G2(BACKUP) ;PUT Z6 INTO ARRAY AT TOP 267 | AOJ BACKUP, ;INCREMENT POINTER TO TOP OF ARRAY 268 | 269 | CAIL BACKUP,^D100 ;SEE IF ARRAY HAS OVERFLOWED 270 | JRST TRYDIR ;IF IT HAS, TRY A NEW DIRECTION 271 | JRST STRGHT ;GO STRAIGHT NOW 272 | 273 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 274 | ;SUBROUTINE TO CLEAR THE G2 ARRAY 275 | G20: 276 | MOVEI 16,AP3 ;SET UP FORTRAN ARG POINTER 277 | PUSHJ P,SET## ;JUMP TO SET SUBROUTINE 278 | POPJ P, ;RETURN 279 | 280 | ARG4: ^D100 ;# OF ELEMENTS IN ARRAY 281 | ARG5: 0 ;# TO SET ARRAY ELEMENTS TO 282 | -3,,0 ;# OF ARGUMENTS 283 | AP3: G2 284 | ARG4 285 | ARG5 ;ADDRESSES OF ARGUMENTS 286 | 287 | ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;; 288 | ;SUBROUTINE TO CALL TEST4(Z6,FLAG,DIR,MOVE1,MOVNUM,BEG,END,G2,FLAG2) 289 | 290 | ARGZ6: BLOCK 1 291 | ARGMVN: BLOCK 1 292 | ARGBEG: BLOCK 1 293 | ARGEND: BLOCK 1 294 | SWITCH: BLOCK 1 295 | -9,,0 296 | ARGBLK: ARGZ6 297 | BLOCK 1 ;RESERVE SPOT FOR FLAG ADDRESS 298 | DIR 299 | MOVE1 300 | ARGMVN 301 | ARGBEG 302 | ARGEND 303 | G2 304 | SWITCH 305 | 306 | SAVAC2: BLOCK ^D12 307 | 308 | TEST: 309 | MOVE T1,[2,,SAVAC2] 310 | BLT T1,SAVAC2+^D11 ;SAVE ACS 311 | 312 | MOVEM Z6,ARGZ6 ;SET UP Z6 ARG 313 | MOVEM FLAG,ARGBLK+1 ;SET UP POINTER TO FLAG 314 | MOVEM MOVNUM,ARGMVN ;SET UP MOVNUM ARG 315 | MOVEM BACKUP,ARGBEG ;SET UP BEG ARG 316 | MOVE T0,DIR3 317 | MOVEM T0,ARGEND ;SET UP END ARG 318 | MOVE T0,[ASCII /MOV /] 319 | MOVE T1,BAKADR 320 | CAIN T1,CHKNXT 321 | MOVE T0,[ASCII /SHORE/] 322 | MOVEM T0,SWITCH ;SET UP SWITCH ARG 323 | MOVEI 16,ARGBLK ;SET UP ARG POINTER 324 | PUSHJ P,TEST4## ;CALL TEST4 325 | 326 | MOVS T1,[2,,SAVAC2] 327 | BLT T1,15 328 | POPJ P, ;RETURN 329 | 330 | 331 | XPUNGE 332 | END 333 | 334 | 335 | . -------------------------------------------------------------------------------- /READ.ME: -------------------------------------------------------------------------------- 1 | This is the last PDP-10 version that I made. The file dates are 2 | screwed up because they were downloaded from the Caltech PDP-10 3 | via phone to a PDP-11 in 4 | 1979, and downloaded again from my H11 to my Club AT via RS-232C 5 | cable (I don't have 8" disk drives on my AT!). 6 | 7 | The copyright notice is in 15.FOR (I know, terrible file names). 8 | -------------------------------------------------------------------------------- /README.md: -------------------------------------------------------------------------------- 1 | # Empire Written In FORTRAN-10 for the PDP-10 Circa 1978 # 2 | 3 | For more information about Empire, see [classicempire.com](https://classicempire.com) 4 | 5 | ![Empire](https://classicempire.com/empire2.jpg "Wargame of the Century") 6 | -------------------------------------------------------------------------------- /SUBS.MAC: -------------------------------------------------------------------------------- 1 | 2 | 3 | 4 | ; CALL STROUT('TEXT',1 OR 0) 5 | ; 1 FOR CRLF, 0 FOR NO CRLF 6 | 7 | TITLE STROUT 8 | ENTRY STROUT 9 | 10 | STROUT: CAIA 11 | PUSH 17,EXITC.## 12 | MOVEI 2,@(16) 13 | LP: MOVE (2) 14 | SKIPE 15 | AOJA 2,LP 16 | SOJ 2, 17 | MOVE (2) 18 | LSH 0,-1 19 | MOVNI 3,5 20 | LPI: LSHC 0,-7 21 | CAME 1,BLK 22 | JRST LAS 23 | SETZ 1, 24 | AOJL 3,LPI 25 | LAS: ADDI 3,6 26 | IMULI 3,7 27 | ADDI 3,1 28 | LSHC (3) 29 | MOVEM (2) 30 | OUTSTR @(16) 31 | MOVE 4,@1(16) 32 | IDIVI 4,12 33 | SETZB 0,1 34 | CAILE 4,5 35 | MOVEI 4,5 36 | LP2: SOJL 4,LAS1 37 | LSH -7 38 | OR BLK 39 | JRST LP2 40 | LAS1: CAIE 41 | OUTSTR 42 | CAIN 5, 43 | POPJ 17, 44 | OUTSTR CRLF 45 | POPJ 17, 46 | BLK: 200000,,0 47 | CRLF: 64240,,0 48 | 49 | PRGEND 50 | ;--------------------------------------- 51 | 52 | TITLE PAK 53 | ENTRY SMAC,CHSMAC 54 | ;SMAC - UNPACKS A 14 BIT BINARY INTEGER FROM 1 OF 5 14 BIT FIELDS 55 | ;OF THE NTH PAIR OF TWO 36 BIT WORDS (RIGHTMOST BIT UNUSED). 56 | ; 57 | ;I=UNPACK(LOC,ARRAY) 58 | ;LOC=NUMBER OF FIELD POSITION IN ARRAY (1 TO 2.5*SIZE OF ARRAY) 59 | ;ARRAY=ADDRESS OF STORAGE ARRAY 60 | ; 61 | T0=0 62 | T1=1 63 | T2=2 64 | T3=3 65 | T4=4 66 | T5=5 67 | L=16 68 | P=17 69 | SMAC: MOVE T0,[T2,,SAVACS] 70 | BLT T0,SAVACS+3 71 | PUSHJ P,FNDPAR ;SET UP INDEX AND REMAINDER 72 | MOVN T5,T5 73 | ADDI T5,^D72 74 | MOVE T2,(T4) ;GET THE TWO WORDS 75 | MOVE T3,1(T4) 76 | ROTC T2,(T5) ;ROTATE VALUE LEFT 77 | ANDI T3,37777 ;REMOVE EXTRA BITS 78 | MOVE T0,T3 ;PUT INTO T0 79 | MOVE T1,[SAVACS,,T2] 80 | BLT T1,T5 81 | POPJ P,0 82 | ; 83 | ;CHSMAC - PACKS A 14 BIT BINARY INTEGER INTO 1 OF 5 14 BIT FIELDS 84 | ;OF THE NTH PAIR OF TWO 36 BIT WORDS (RIGHTMOST BIT UNUSED). 85 | ; 86 | ;CALL PACK(LOC,ARRAY,VALUE) 87 | ;LOC=NUMBER OF FIELD POSITION IN ARRAY (1 TO 2.5*SIZE OF ARRAY) 88 | ;ARRAY=ADDRESS OF STORAGE ARRAY 89 | ;VALUE=VALUE TO BE STORED 90 | ; 91 | CHSMAC: MOVE T0,[T2,,SAVACS] 92 | BLT T0,SAVACS+3 93 | PUSHJ P,FNDPAR ;SET UP INDEX AND REMAINDER 94 | SETOB T2,T3 ;SET UP TWO AC MASK 95 | TRZ T3,37777 96 | ROTC T2,(T5) ;SHIFT MASK 97 | ANDM T2,(T4) ;AND OUT OLD FIELD VALUE 98 | ANDM T3,1(T4) 99 | SETZ T2, ;GET VALUE IN TWO ACS 100 | MOVE T3,@2(L) 101 | ROTC T2,(T5) ;SHIFT NEW VALUE INTO POSITION 102 | ORM T2,(T4) ;OR IN NEW VALUE 103 | ORM T3,1(T4) 104 | MOVE T0,[SAVACS,,T2] 105 | BLT T0,T5 106 | POPJ P,0 107 | SAVACS: BLOCK 4 108 | ; 109 | ;FNDPAR - PUTS FIRST INPUT ARG INTO T4 AND THEN CONVERTS T4 INTO 110 | ;A PAIR WORD POINTER AND A FIELD POSITION COUNTER. 111 | ; 112 | FNDPAR: MOVE T4,@0(L) ;GET VALUE OF LOC 113 | SUBI T4,1 ;CONVERT TO NUMBER OF WORD PAIR 114 | IDIVI T4,5 ;REMAINDER IS IN T5 115 | ASH T4,1 116 | ADDI T4,@1(L) ;ADD ADDRESS OF ARRAY 117 | ADDI T5,1 ;MAKE REMAINDER BETWEEN 1 AND 5 INCL. 118 | IMULI T5,^D14 ;MULTIPLY BY 14 119 | MOVN T5,T5 ;(RIGHT SHIFT) 120 | ADDI T5,^D70 121 | POPJ P,0 122 | PRGEND 123 | 124 | 125 | 126 | ;-------------------------------- 127 | TITLE IDIST 128 | ENTRY IDIST 129 | 130 | ; COMPUTES DISTANCE BETWEEN ANY TWO POINTS ON THE MAP 131 | 132 | T0=0 133 | T1=1 134 | Y1=2 135 | X1=3 136 | Y2=4 137 | X2=5 138 | 139 | SAVACS: BLOCK 4 140 | 141 | IDIST: MOVE T1,[2,,SAVACS] 142 | BLT T1,SAVACS+3 ;SAVE ACS 143 | 144 | MOVE Y1,@0(16) 145 | MOVE Y2,@1(16) ;GET THE TWO LOCATIONS 146 | 147 | SUBI Y1,1 148 | SUBI Y2,1 ;REMEMBER THAT 100 IS A COLUMN, NOT A ROW 149 | 150 | IDIVI Y1,^D100 151 | IDIVI Y2,^D100 ;SEPARATE INTO X AND Y 152 | 153 | SUB Y1,Y2 154 | SUB X1,X2 ;CONVERT TO DELTA X AND DELTA Y 155 | 156 | MOVM Y1,Y1 157 | MOVM X1,X1 ;TAKE ABSOLUTE VALUE 158 | 159 | MOVE T0,Y1 160 | CAMGE Y1,X1 161 | MOVE T0,X1 162 | 163 | MOVS T1,[2,,SAVACS] 164 | BLT T1,5 ;RESTORE ACS 165 | 166 | POPJ 17, 167 | 168 | PRGEND 169 | 170 | 171 | 172 | ;---------------------------------- 173 | 174 | ;AMAPP AND CHAMAP PACK AND UNPACK EMPIRE MAPS 175 | 176 | TITLE A.MAC 177 | ENTRY AMAPP, CHAMAP 178 | 179 | ; A=AMAPP(MAPP,Z6) 180 | ; A= OBJECT RESIDING AT LOCATION Z6 181 | ; Z6= LOCATION ON MAP 182 | ; MAPP= WHICH ONE OF THREE MAPS YOU WANT TO LOOK AT, 183 | ; 0: ENEMY MAP 184 | ; 1: REFERENCE MAP 185 | ; 2: PLAYER MAP 186 | ; EACH MAP HAS 6000 LOCATIONS IN IT, 7 ARE STORED PER WORD 187 | ; IN 5-BIT BYTES. THERE ARE 858 WORDS PER MAP. 188 | 189 | T0=0 190 | T1=1 191 | Z6=2 192 | POINTR=3 193 | MAPP=4 194 | VARSTK=16 195 | P=17 196 | 197 | POIN: POINT 5,(Z6),4 ;7 BYTE POINTERS, ONE FOR EACH MAP LOC IN A WORD 198 | POINT 5,(Z6),9 199 | POINT 5,(Z6),14 200 | POINT 5,(Z6),19 201 | POINT 5,(Z6),24 202 | POINT 5,(Z6),29 203 | POINT 5,(Z6),34 204 | 205 | SYMBOL: ASCII/ / 206 | ASCII/. / 207 | ASCII/+ / 208 | ASCII/1 / 209 | ASCII/A / 210 | ASCII/5 / 211 | ASCII/O / 212 | ASCII/X / 213 | ASCII/S / 214 | ASCII/4 / 215 | ASCII/T / 216 | ASCII/D / 217 | ASCII/3 / 218 | ASCII/F / 219 | ASCII/2 / 220 | ASCII/6 / 221 | ASCII/R / 222 | ASCII/7 / 223 | ASCII/C / 224 | ASCII/8 / 225 | ASCII/B / 226 | ASCII/* / 227 | 228 | .COMMON MAP [^D2875] ;VARIABLES 229 | 230 | SYMNUM=.-SYMBOL ;NUMBER OF ENTRIES IN THIS TABLE 231 | 232 | 233 | SAVACS: BLOCK 3 234 | 235 | AMAPP: MOVE T1,[2,,SAVACS] 236 | BLT T1,SAVACS+2 ;SAVE ACS 237 | 238 | MOVE Z6,@1(VARSTK) 239 | SUBI Z6,1 ;Z6=(Z6-1)/7, REMAINDER GOES IN POINTR 240 | IDIVI Z6,7 241 | 242 | MOVE MAPP,@0(VARSTK) 243 | IMULI MAPP,^D858 ;MAPP=MAPP*858 244 | 245 | ADD Z6,MAPP ;Z6=Z6+MAPP+ADDRESS OF ARRAY 246 | ADDI Z6,MAP 247 | 248 | LDB T1,POIN(POINTR) 249 | MOVE T0,SYMBOL(T1) ;GET THE SYMBOL RELATING TO T0 250 | 251 | MOVS T1,[2,,SAVACS] 252 | BLT T1,4 ;RESTORE ACS 253 | POPJ P,0 254 | 255 | ; CALLING SEQUENCE: CALL CHAMAP(Z6,TYPE,MAPP) 256 | ; Z6, MAPP ARE THE SAME AS BEFORE 257 | ; TYPE=THE CHARACTER YOU WISH TO INSERT INTO MAP LOCATION Z6 258 | 259 | CHAMAP: MOVE T0,[2,,SAVACS] 260 | BLT T0,SAVACS+2 ;SAVE ACCUMULATORS 261 | 262 | MOVE T0,@1(VARSTK) 263 | MOVSI POINTR,-SYMNUM ;GET -SYMNUM,,0 IN POINTR 264 | 265 | LOOP: CAME T0,SYMBOL(POINTR) 266 | AOBJN POINTR,LOOP 267 | TLZE POINTR,777777 ;SKIP IF DIDN'T FIND A MATCH 268 | JRST DONE ;GOT IT 269 | OUTSTR [ASCIZ/?ERROR IN CHAMAP: /] 270 | SETZ 1, 271 | OUTSTR 0 272 | EXIT 273 | DONE: MOVE T0,POINTR 274 | 275 | MOVE Z6,@0(VARSTK) 276 | SUBI Z6,1 277 | IDIVI Z6,7 278 | 279 | MOVE MAPP,@2(VARSTK) 280 | IMULI MAPP,^D858 281 | 282 | ADD Z6,MAPP 283 | ADDI Z6,MAP 284 | 285 | DPB T0,POIN(POINTR) 286 | 287 | MOVS T0,[2,,SAVACS] 288 | BLT T0,4 ;RESTORE ACS 289 | POPJ P, 290 | 291 | PRGEND 292 | ;------------------------------------ 293 | 294 | TITLE SET 295 | ENTRY SET 296 | 297 | ; THIS SUBROUTINE SETS AN ARRAY TO ALL ONE VALUE SPECIFIED BY ARG3 298 | ; CALLING SEQUENCE: CALL SET(ARRAY,DIM,SET) 299 | ; ARRAY: THE ARRAY THAT YOU WANT CLEARED 300 | ; DIM: THE SIZE IN WORDS OF THE ARRAY 301 | ; SET: THE VALUE THAT YOU WANT THE ARRAY SET TO 302 | 303 | SET: MOVEI 0,@0(16) ;MOVE ADDRESS OF ARRAY INTO AC0 304 | MOVE 1,@2(16) ;MOVE VALUE OF SET INTO AC1 305 | MOVEM 1,@0 ;SET FIRST VALUE OF ARRAY TO SET 306 | HRRZ 1,0 ;SET RIGHT OF 1 TO ARRAY 307 | HRL 0,0 ;NOW RIGHT AND LEFT OF AC0 CONTAIN ARRAY 308 | ADDI 0,1 ; AC0=[ARRAY,,ARRAY+1] 309 | ADD 1,@1(16) ; AC1=[0,,ARRAY+DIM] 310 | SUBI 1,1 ; AC1=[0,,ARRAY+DIM-1]=FINAL ADDRESS OF ARRAY 311 | BLT 0,(1) ;SET THE ARRAY TO SET 312 | POPJ 17,0 313 | 314 | PRGEND 315 | ;------------------------------------------------ 316 | TITLE D1 317 | ENTRY D1F,D1M 318 | ;CALLING SEQUENCE: D1F(Z6) 319 | ;D1M IS FOR MACRO ROUTINES CALLING IT 320 | ;MAP LOCATIONS ARE PACKED 20 TO A WORD, IN POWERS OF 3 321 | ;FAST UNPACKING ROUTINES FOR THE D MAP 322 | 323 | RADIX ^D10 ;OCTAL SUCKS 324 | .COMMON MAP[2574+300+1] 325 | D=MAP+2574 ;START OF D ARRAY 326 | 327 | T0=0 328 | T1=1 329 | T2=2 330 | T3=3 331 | V=14 332 | P=15 333 | 334 | D1F:: MOVE T1,@0(V) ;GET MAP LOCATION 335 | D1M:: PUSH P,T2 ;SAVE AC 2 336 | SUBI T1,1 ;CONVERT INDEX TO 0-5999 FROM 1-6000 337 | IDIVI T1,20 ;20 LOCATIONS PER WORD 338 | MOVE T0,D(T1) ;GET WORD ASSOCIATED WITH LOCATION 339 | IDIV T0,POW3+1(T2) ;DIVIDE AWAY EXTRA JUNK ABOVE WHAT WE WANT 340 | IDIV T1,POW3(T2) ;DIVIDE OFF ANYTHING BELOW WHAT WE WANT 341 | MOVE T0,ASCI(T1) ;GET ASCII CHAR ASSOCIATED WITH IT 342 | POP P,T2 ;RESTORE AC 2 343 | POPJ P, ;RETURN 344 | 345 | ASCI: ASCII /. / 346 | ASCII /+ / 347 | ASCII /* / 348 | POW3: 349 | POWER3=1 350 | REPEAT 20,< 351 | POWER3 352 | POWER3=POWER3*3 ;GENERATE TABLE OF POWERS OF 3 353 | > 354 | PRGEND 355 | ;---------------------------------------------------------- 356 | RADIX 8 357 | TITLE ORDER 358 | ENTRY ORDER,ORDERM 359 | ;FAST ROUTINES EQUIVALENT TO FORTRAN ORDER(Z6) 360 | T0=0 361 | T1=1 362 | V=16 363 | P=17 364 | RADIX ^D10 365 | 366 | ORDER:: 367 | MOVE T1,@0(V) 368 | ORDERM:: 369 | CAIG T1,100 370 | JRST YES 371 | CAILE T1,5900 372 | JRST YES 373 | MOVE T0,T1 374 | PUSH P,2 ;SAVE AC 2 375 | IDIVI T1,100 376 | POP P,2 ;THE IDIVI DESTROYED AC 2 377 | IMULI T1,100 378 | CAMN T1,T0 379 | JRST YES 380 | ADDI T1,1 381 | CAMN T1,T0 382 | JRST YES 383 | MOVEI T0,0 384 | POPJ P, 385 | YES: MOVEI T0,1 386 | POPJ P, 387 | PRGEND 388 | ;------------------------------------------------- 389 | RADIX 8 390 | TITLE MOV 391 | ENTRY MOV 392 | ;MACRO VERSION OF MOV SUBROUTINE 393 | ;CALLING SEQUENCE: MOV(BEG,END) 394 | ;VALUE RETURNED IS THE DIRECTION IN WHICH TO GO TO GET FROM BEG TO END 395 | 396 | T0=0 397 | T1=1 398 | T2=2 399 | T3=3 400 | V=16 401 | P=17 402 | 403 | MOV:: PUSH P,T2 404 | PUSH P,T3 405 | MOVE T0,@0(16) 406 | MOVE T2,@1(16) 407 | SUBI T0,1 408 | SUBI T2,1 409 | IDIVI T0,^D100 410 | IDIVI T2,^D100 411 | SUB T2,T0 412 | SUB T3,T1 413 | JUMPGE T2,NOTL 414 | MOVEI T0,4 415 | SKIPLE ,T3 416 | MOVEI T0,2 417 | SKIPN ,T3 418 | MOVEI T0,3 419 | JRST DONE 420 | NOTL: JUMPE T2,NOTG 421 | MOVEI T0,6 422 | SKIPLE ,T3 423 | MOVEI T0,^D8 424 | SKIPN ,T3 425 | MOVEI T0,7 426 | JRST DONE 427 | NOTG: MOVEI T0,5 428 | SKIPLE ,T3 429 | MOVEI T0,1 430 | SKIPN ,T3 431 | MOVEI T0,0 432 | DONE: POP P,T3 433 | POP P,T2 434 | POPJ P, 435 | XPUNGE 436 | END 437 | 438 | -------------------------------------------------------------------------------- /copyright: -------------------------------------------------------------------------------- 1 | This program and source is copyrighted by Walter Bright. 2 | Empire, Wargame of the Century (tm) is trademarked by Walter Bright. 3 | You may use it for personal, non-commercial use only. If 4 | you wish to redistribute it, use it commercially, or create 5 | derived versions of it, please contact emperor@classicempire.com 6 | for a license. Thank-you! 7 | --------------------------------------------------------------------------------