edjames@ic.Berkeley.EDU (Ed James) (12/21/86)
BYTE PAMELA(8),REEED(9)
byte jnkbuf ( 80 )
INTEGER RLMAP(3000)
LOGICAL AUTOMV
COMMON/AB9/AB9,PRIOR,NSHPRF
COMMON/ARMTOT/ARMTOT
COMMON/CHRT/COMMAN,COMM,COMSCN,KBTBL
COMMON/CHR2/IFILE,KILL,TTY
COMMON/CITY/FOUND(70),OWNER(70),PHASE(70)
COMMON/CMYTBL/CMYTBL,KBFUDG
COMMON/COD/CODER
COMMON/CODE/CODEFU,CODELA
COMMON/CRAHL/HITS,TIPE,CRAHIT,CRALOC
COMMON/FIPATH/FIPATH(70)
COMMON/G2/G2
COMMON/IARROW/IARROW(10),ARROW,INDEX,LOPMAX
COMMON/IOTAB/IOTAB
COMMON/J1TS/J1TS
COMMON/KXK/IADJST
COMMON/MAP/D
COMMON/MAPBLK/EMAP,RMAP,PMAP,RLMAP
COMMON/OMAP/OMAP
COMMON/MISC1/TARGET,AR2S,RANGE,RANG
COMMON/MISC2/LOCI(10,11),NUMBER(18),LIMIT,MDATE,VERSION
COMMON/MODE/MODE,JECTOR,ISEC,NEWRND
COMMON/MFLAGS/MOVEDFLAG
COMMON/MYCOD/D2,MYCODE
COMMON/OKS/OKA,OKB,OKC
COMMON/OVRPOP/OVRPOP
COMMON/P1/PHAZE,PHAZEE,PH
COMMON/DAYTIM/PAMELA,REEED
COMMON/PASS/PASS,SPECAL,AUTOMV
COMMON/SAVBUF/SAVBUF
COMMON/SPS/STEP,POSIT,START
COMMON/TEST2/SUCCES,FAILUR,FULL
COMMON/TROOP/TROOPT(6,5)
COMMON/X/X(70)
common /jnkbuf/ jnkbuf, ptr
C
C AGGR: THIS IS A MEASURE OF THE ENEMY SHIPS AGGRESSIVENESS,
C THIS VALUE IS ADDED TO THE COST-EFFECTIVENESS OF ATTACKING AN
C ENEMY UNIT TO DETERMINE IF THE SHIP WILL ATTACK OR RUN FROM THE
C ENEMY.
C ALL CITIES ARE REFERENCED BY CITY NUMBER, AS IN X(N)=LOC OF CITY #N
C CODFU/CODELA: CONTAINS A NUMBER THAT DETERMINES WHAT THAT COMPUTER CRAFT
C IS ASSIGNED TO DO, IS SEPERATED INTO 2 NUMBERS, IFO AND ILA. IFO
C GIVES THE FUNCTION, ILA GIVES DETAILS.
C CODER: USED FOR DEBUG FLAG
C CROWD: USED IF CITY IS SURROUNDED BY ARMIES
C D: ORIGINAL MAP, ENCODED IN MOD 3
C EXPLOR: THIS IS SET TO 1 IF THE ENEMY SHIP IS TO EXPLORE UNKNOWN
C TERRITORY ADJACENT TO IT, 0 IF NOT.
C FIPATH: STASIS # TO BE GIVEN TO FIGHTER IN THAT CITY
C FOUND: COMPLETION DATES FOR CITIES
C IADJST: SUBTRACTED FROM Z6 SO CURSOR WILL NOT BE MOVED OFF SCREEN
C IARROW: ADDED TO Z6 SO MOVES [1,2,3,4,5,6,7,8,9] ARE CONVERTED
C TO [+1,-99,-100,-101,ETC.]
C ISEC: SECTOR TERMINAL IS SHOWING
C IZAP: .TRUE.=SAVE GAME, .FALSE.=INITIALIZE
C JECTOR: SECTOR PROGRAM IS LOOKING AT
C KURSOR: SET TO POSITION OF CURSOR
C MODE: 1=IN MODE 2, 0=IN MODE 1
C OWNER: WHO OWNS THE CITY: 0>NOBODY, 1>PLAYER, 2>COMPUTER
C PASS: SET TO .TRUE. IF IT IS A PRIVILEGED USER
C PHASE: PHASE OF CITY
C X: LOCATIONS OF CITIES
C
C
C NUMBER(1-8): NUMBERS OF UNITS
C NUMBER(11-18): NUMBERS OF CITIES WITH EACH PHASE
C NUMBER(9): NUMBER OF CITIES
C NUMBER(10): NUMBER OF TARGET CITIES
C
INT=PHASE(I)
IF (PHASE(I).NE.-1) GOTO 100
PHASE(I)=1
GOTO 1400
100 EDGE=EDGER(X(I))
C
C IF WE HAVE A PHASE OF 0, MAKE SOMETHING!
C
IF (PHASE(I).EQ.0) GOTO 600
C
C IF CITY IS SURROUNDED BY ARMIES, MAKE SOMETHING ELSE
C
IF (PHASE(I).NE.1) GOTO 300
DO 200 J=1,8
200 IF (RMAP(X(I)+IARROW(J+1)).EQ.'+') GOTO 300 !**
GOTO 600
C
C IF CRAFT NUMBERS ARE GETTING GROSSLY LARGE, PRODUCE SOMETHING ELSE
C
300 IF (NUMBER(OVRPOP(PHASE(I)+1,1)).GT.
1 OVRPOP(PHASE(I)+1,2)) GOTO 600 !**
C
IF (EDGE.NE.8) GOTO 400
IF ((NUMBER(9).GT.1).AND.(PHASE(I).EQ.1)) GOTO 1100
IF (NUMBER(9).GT.1) GOTO 1400
IF (NUMBER(5).LT.1) PHASE(I)=6
IF (NUMBER(5).GT.0) PHASE(I)=1
GOTO 1400
C
400 IF (PHASE(I).NE.1) GOTO 600
N=0
DO 500 J=IAR2+1,IAR2+LIMIT(9)
Z=RLMAP(J)
IF (Z.EQ.0) GOTO 500
IF (IDIST(X(I),Z).GT.6) GOTO 500
IF (EMAP(Z).EQ.'t') GOTO 500
MOVE=PATH(X(I),Z,1,OKA,FLAG)
IF (FLAG.EQ.0) GOTO 500
N=N+1
IF ((N.GT.6).AND.(NUMBER(11).GT.1)) GOTO 800
500 CONTINUE
IF ((N.GT.3).AND.(NUMBER(11).GT.1)) GOTO 600
GOTO 1400
C
C SELECT A NEW PHASE FOR THE CITY
C
600 CONTINUE
C
C IF THERE ARE ENEMY ARMIES ON THE CONTINENT, PRODUCE ARMIES!
C
IF (EDGE.EQ.8) GOTO 1050
DO 700 J=1,10
IF (LOCI(J,2).EQ.0) GOTO 700
MOVE=PATH(X(I),LOCI(J,2),1,OKA,FLAG)
IF (FLAG.EQ.0) GOTO 700
PHASE(I)=1
GOTO 1300
700 CONTINUE
C
800 PHASE(I)=2
IF (EDGE.GT.0) GOTO 900 !IF NOT LANDLOCKED
IF (NUMBER(1).LE.3*NUMBER(2)) PHASE(I)=1 !IF SMALL .NE. OF ARMIES
GOTO 1300
C
900 PHASE(I)=1
N=0
DO 1000 J=IAR2+1,IAR2+LIMIT(9)
Z=RLMAP(J)
IF (Z.EQ.0) GOTO 1000
IF (IDIST(X(I),Z).GT.6) GOTO 1000
IF (EMAP(Z).EQ.'t') GOTO 1000 !IF ON TROOP TRANSPORT
MOVE=PATH(X(I),Z,1,OKA,FLAG)
IF (FLAG.EQ.0) GOTO 1000
N=N+1
1000 CONTINUE
IF (N.LT.3) GOTO 1300
1050 PHASE(I)=2
IF (NUMBER(2)*2.GT.NUMBER(9)) GOTO 1100
IF ((NUMBER(5).LT.3).AND.(NUMBER(15).LT.2)) GOTO 1100
IF (NUMBER(2)*4.LT.NUMBER(9)) GOTO 1300
IF (INT.EQ.2) GOTO 1300
IF (INT.GT.2) GOTO 1100
IF (irand(100).LT.50) GOTO 1300
C
C SELECT A SHIP, GUARANTEEING AT LEAST TWO CITIES PRODUCING TROOP TRANSPORTS
C
1100 PHASE(I)=PH(8)
DO 1200 J=8,4,-1
1200 IF (NUMBER(J+10).GE.NUMBER(J+9)) PHASE(I)=PH(J-1)
IF (INT.GT.2) PHASE(I)=INT
IF (NUMBER(17).EQ.0) PHASE(I)=12
IF (NUMBER(15).LT.2) PHASE(I)=6
C
1300 IF ((NUMBER(9).GT.1).AND.(NUMBER(15).EQ.0).AND.(EDGE.GT.0))
1 PHASE(I)=6
1400 FOUND(I)=5*PHASE(I)+MDATE
IF (INT.EQ.PHASE(I)) GOTO 1500
FOUND(I)=6*PHASE(I)+MDATE
CALL CITYCT
IF (CODER.NE.9) GOTO 1500
CALL tpos(2,1)
TYPE 999,X(I),INT,PHASE(I),EDGE
999 FORMAT('+CITY:',I4,' FROM:',I2,' TO:',I2,' EDGE:',I1,3X,$)
CALL GETCHX(E)
1500 RETURN
END
ccc clreol - clear to end of the line
subroutine clreol(line, icol, eolpos)
integer line, icol, eolpos
c
c synopsis
c
c call clreol(line, icol, eolpos)
c
c line - line
c icol - column to clear
c eolpos - postion of the last character on this line
c (or zero if position is not known)
c
c This routine assumes that the cursor is positioned and
c positions it it the same place
c
c
c Common terminal
c
parameter tt_bufsiz = 750 ! size of buffer in bytes
common /ioempire/ TT_VT52, TT_VT100,
$ TT_ANN, TT_HP, TT_ADM, TT_HZ15,
$ in_chan, out_chan, tt_nbuf, tt_type, tt_flag, tt_buf
integer TT_VT52, TT_VT100
integer TT_ANN, TT_HP, TT_ADM, TT_HZ15
integer in_chan ! input channel
integer out_chan ! output channel
integer tt_nbuf ! number of characters to output
integer tt_type ! terminal type
logical tt_flag ! flag for non-buffered i/o
byte tt_buf(tt_bufsiz) ! the buffer
byte blank(80)
byte vt52l(2), vt100l(3)
data blank /80*' '/
data vt52l /"33, 'K'/
data vt100l /"33, '[', 'K'/
if (icol .gt. eolpos) return
if (tt_type .eq. TT_VT52) goto 1000
if (tt_type .eq. TT_VT100) goto 2000
c
c Handle dumb terminals here
c
call bufout(blank, eolpos - icol + 1)
call tpos(line, icol)
return
c
c Handle vt52
c
1000 call bufout(vt52l, 2)
return
c
c Handle vt100
c
2000 call bufout(vt100l, 3)
return
end
FUNCTION COMPAR(AB,Z62,OKVECT)
C
C USED BY PATH, CHECKS IF AB OR LOCATION Z62 IS A TYPE CONTAINED IN OKVECT
C
IMPLICIT INTEGER(A-Z)
BYTE OKVECT(5),AB
BYTE OMAP(6000)
COMMON/OMAP/OMAP
C
COMPAR = 1
IF (AB .EQ. OKVECT(1)) RETURN
IF (OMAP(Z62) .EQ. OKVECT(1)) RETURN
IF (AB .EQ. OKVECT(2)) RETURN
IF (AB .EQ. OKVECT(3)) RETURN
IF (AB .EQ. OKVECT(4)) RETURN
IF (AB .EQ. OKVECT(5)) RETURN
COMPAR = 0
RETURN
END
function cost(own,h)
implicit integer(a-z)
integer cosval ( 14 )
byte costab ( 14 ), own
data cosval / 0, 2, 4, 6, 3, 5, 4, 1, 3, 3, 7,
* 5, 11, 11/
data costab /'F','D','S','T','R','C','B','f','d','s','t',
* 'r','c','b'/
do 100 i = 1, 14
100 if ( own .eq. costab ( i )) goto 200
pause 'BAD CALL TO FUNCTION COST!'
cost = 0
return
200 cost = cosval ( i )
if ( i .ge. 9 ) cost = cost - h
return
end
ccc cursor - position cursor to map location
subroutine cursor ( n )
integer n
c
c synopsis
c
c call cursor ( n )
c
c n - map location
c
integer i, j
i = n / 100 + 1
j = mod ( n, 100 ) + 1
call tpos ( i, j )
call flush
return
end
subroutine data
c
c Block data for empire
c
IMPLICIT INTEGER(A-Z)
PARAMETER IAR=0,IFI=500,IDE=700,ISU=900,ITT=1100,
1 ICR=1200,ICA=1300,IBA=1400
PARAMETER IAR2=1500,IFI2=2000,IDE2=2200,ISU2=2400,ITT2=2600,
1 ICR2=2700,ICA2=2800,IBA2=2900
PARAMETER IDEH=0,ISUH=200,ITTH=400,ICRH=500,ICAH=600,IBAH=700
PARAMETER IDE2H=800,ISU2H=1000,ITT2H=1200,ICR2H=1300,
1 ICA2H=1400,IBA2H=1500
INTEGER G2(100)
INTEGER HITS(15),TIPE(15),CRAHIT(15),CRALOC(15)
INTEGER INDEX(15)
INTEGER CMYTBL(9),KBFUDG(9)
INTEGER LOPMAX(15),COMSCN(40)
INTEGER NSHPRF(4,6)
INTEGER PH(8),OVRPOP(16,2)
INTEGER PRIOR(7)
INTEGER RANGE(200),AR2S(500)
INTEGER ARMTOT(20),CODEFU(1500),CODELA(1500),TARGET(70),LIMIT(16)
INTEGER ARROW(9)
INTEGER D2(3)
INTEGER*2 D(667)
INTEGER MYCODE(1500)
INTEGER RANG(200)
INTEGER IOTAB(16)
INTEGER PHAZEE(8)
integer ptr
BYTE SPECAL,PASS
BYTE AB,AC,AD,AO,E,OWN1,OWN2,OWN !AVOID WORD REFERENCES TO THESE
BYTE KBTBL(9),AB9(9)
BYTE COMM(30),PHAZE(8)
BYTE IFILE(11),KILL
BYTE COMMAN(20),OKA(5),OKB(5),OKC(5)
BYTE TTY(20)
BYTE MOVEDFLAG(1500)
BYTE J1TS(1600)
BYTE EMAP(6000),RMAP(6000),PMAP(6000),OMAP(6000)
BYTE PAMELA(8),REEED(9)
byte jnkbuf ( 80 )
INTEGER RLMAP(3000)
LOGICAL AUTOMV
COMMON/AB9/AB9,PRIOR,NSHPRF
COMMON/ARMTOT/ARMTOT
COMMON/CHRT/COMMAN,COMM,COMSCN,KBTBL
COMMON/CHR2/IFILE,KILL,TTY
COMMON/CITY/FOUND(70),OWNER(70),PHASE(70)
COMMON/CMYTBL/CMYTBL,KBFUDG
COMMON/COD/CODER
COMMON/CODE/CODEFU,CODELA
COMMON/CRAHL/HITS,TIPE,CRAHIT,CRALOC
COMMON/FIPATH/FIPATH(70)
COMMON/G2/G2
COMMON/IARROW/IARROW(10),ARROW,INDEX,LOPMAX
COMMON/IOTAB/IOTAB
COMMON/J1TS/J1TS
COMMON/KXK/IADJST
COMMON/MAP/D
COMMON/MAPBLK/EMAP,RMAP,PMAP,RLMAP
COMMON/OMAP/OMAP
COMMON/MISC1/TARGET,AR2S,RANGE,RANG
COMMON/MISC2/LOCI(10,11),NUMBER(18),LIMIT,MDATE,VERSION
COMMON/MODE/MODE,JECTOR,ISEC,NEWRND
COMMON/MFLAGS/MOVEDFLAG
COMMON/MYCOD/D2,MYCODE
COMMON/OKS/OKA,OKB,OKC
COMMON/OVRPOP/OVRPOP
COMMON/P1/PHAZE,PHAZEE,PH
COMMON/DAYTIM/PAMELA,REEED
COMMON/PASS/PASS,SPECAL,AUTOMV
COMMON/SAVBUF/SAVBUF
COMMON/SPS/STEP,POSIT,START
COMMON/TEST2/SUCCES,FAILUR,FULL
COMMON/TROOP/TROOPT(6,5)
COMMON/X/X(70)
common /jnkbuf/ jnkbuf, ptr
C
C AGGR: THIS IS A MEASURE OF THE ENEMY SHIPS AGGRESSIVENESS,
C THIS VALUE IS ADDED TO THE COST-EFFECTIVENESS OF ATTACKING AN
C ENEMY UNIT TO DETERMINE IF THE SHIP WILL ATTACK OR RUN FROM THE
C ENEMY.
C ALL CITIES ARE REFERENCED BY CITY NUMBER, AS IN X(N)=LOC OF CITY #N
C CODFU/CODELA: CONTAINS A NUMBER THAT DETERMINES WHAT THAT COMPUTER CRAFT
C IS ASSIGNED TO DO, IS SEPERATED INTO 2 NUMBERS, IFO AND ILA. IFO
C GIVES THE FUNCTION, ILA GIVES DETAILS.
C CODER: USED FOR DEBUG FLAG
C CROWD: USED IF CITY IS SURROUNDED BY ARMIES
C D: ORIGINAL MAP, ENCODED IN MOD 3
C EXPLOR: THIS IS SET TO 1 IF THE ENEMY SHIP IS TO EXPLORE UNKNOWN
C TERRITORY ADJACENT TO IT, 0 IF NOT.
C FIPATH: STASIS # TO BE GIVEN TO FIGHTER IN THAT CITY
C FOUND: COMPLETION DATES FOR CITIES
C IADJST: SUBTRACTED FROM Z6 SO CURSOR WILL NOT BE MOVED OFF SCREEN
C IARROW: ADDED TO Z6 SO MOVES [1,2,3,4,5,6,7,8,9] ARE CONVERTED
C TO [+1,-99,-100,-101,ETC.]
C ISEC: SECTOR TERMINAL IS SHOWING
C IZAP: .TRUE.=SAVE GAME, .FALSE.=INITIALIZE
C JECTOR: SECTOR PROGRAM IS LOOKING AT
C KURSOR: SET TO POSITION OF CURSOR
C MODE: 1=IN MODE 2, 0=IN MODE 1
C OWNER: WHO OWNS THE CITY: 0>NOBODY, 1>PLAYER, 2>COMPUTER
C PASS: SET TO .TRUE. IF IT IS A PRIVILEGED USER
C PHASE: PHASE OF CITY
C X: LOCATIONS OF CITIES
C
data comman/'S','R','I','K','O','L','F','G','P','H',
1 'Y','T','V','J','?',0,0,'U','N','+'/
data comm/'D','E','W','Q','A','Z','X','C','S',
1 'L','B','F','T','G','V','J','U',-1,-1,
2 'O','P','R','I','M','K','N',
3 'S','?','Y','H'/
data iotab/0,500,700,900,1100,1200,1300,1400,1500,2000,
1 2200,2400,2600,2700,2800,2900/
data ovrpop/
1 9,001,002,9,003,004,05,9,9,9,06,9,07,9,9,08,
2 0,499,199,0,199,199,83,0,0,0,99,0,99,0,0,99/
data comscn/'M','N','O','S','T','V','P','Y','C','L','H','J',
1 '1','R','@','Q','+','A',0,0,
2 'LO','NU','LI','TR','AR','TA','PA','A1',
3 'T3','A0','CO','CH','Q0','Q1','JE','CY','EX',0,0,0/
data arrow/-101,-100,-99,-1,0,1,99,100,101/
data cmytbl/6104,6103,6102,6105,6101,6106,6107,6108,0/
data crahit/0,0,0,0, 200, 400,0,0,0, 500,0, 600,0,0, 700/
data craloc/0,500,0,700,900,1100,0,0,0,1200,0,1300,0,0,1400/
data hits/1,1,0,3,2,3,0,0,0,8,0,8,0,0,12/
data iarrow/0,1,-99,-100,-101,-1,99,100,101,0/
data index/11,12,0,13,14,15,0,0,0,16,0,17,0,0,18/
data kbfudg/-101,-100,-99,-1,1,99,100,101,0/
data kbtbl/'Q','W','E','A','D','Z','X','C',' '/
data lopmax/500,200,0,200,200,100,0,0,0,100,0,100,0,0,100/
data oka/'+',' ','*','X','O'/
data okb/'+',' ','O','t','*'/
data okc/'.',' ','O','*','X'/
data ph/1,2,4,5,6,10,12,15/
data phaze/'A','F','D','S','T','R','C','B'/
data phazee/1,2,4,5,6,10,12,15/
data step/37/,posit/65/,start/102/
data tipe/1,2,0,3,4,5,0,0,0,6,0,7,0,0,8/
end
BYTE FUNCTION DECODE(Z6)
C
C UNPACK MAP DEFINITION FILE
C D() = MAP DEFINITION FROM MAP FILE
C Z6 = LOCATION
C DECODE = CHARACTER AT Z6
C
C MAPS ARE ENCODED USING MOD 3 ARITHMETIC TO FIT 9 CHARACTERS INTO ONE 16-BIT
C WORD.
C
IMPLICIT INTEGER(A-Z)
INTEGER MSKTAB(9)
INTEGER*2 D(667)
BYTE ASCII(3)
DATA ASCII/'.','+','*'/
DATA MSKTAB/1,3,9,27,81,243,729,2187,6561/
COMMON/MAP/D
C
IX=((Z6-1)/9)+1
IY=MOD(Z6-1,9)+1
DECODE=ASCII(MOD(D(IX)/MSKTAB(IY),3)+1)
RETURN
END
ccc delay - wait for 1/60's of a second
subroutine delay ( ticks )
integer ticks
parameter efn = 4
integer status, sys$setimr, sys$waitfr
integer*4 delta ( 2 )
data delta/ 0, -1 /
delta ( 1 ) = - ticks * 166667
status = sys$setimr ( %val ( efn ), delta, , )
status = sys$waitfr ( %val ( efn ))
return
end
subroutine direc
call topmsg ( 2, 'H for Help!' )
end
SUBROUTINE DIST(Z6,ILA)
C
C THIS SUBROUTINE SETS AR2S SO THAT THE ARMY WON'T GET
C OFF THE TROOP TRANSPORT PREMATURELY
C
IMPLICIT INTEGER(A-Z)
PARAMETER IAR=0,IFI=500,IDE=700,ISU=900,ITT=1100,
1 ICR=1200,ICA=1300,IBA=1400
PARAMETER IAR2=1500,IFI2=2000,IDE2=2200,ISU2=2400,ITT2=2600,
1 ICR2=2700,ICA2=2800,IBA2=2900
PARAMETER IDEH=0,ISUH=200,ITTH=400,ICRH=500,ICAH=600,IBAH=700
PARAMETER IDE2H=800,ISU2H=1000,ITT2H=1200,ICR2H=1300,
1 ICA2H=1400,IBA2H=1500
INTEGER G2(100)
INTEGER HITS(15),TIPE(15),CRAHIT(15),CRALOC(15)
INTEGER INDEX(15)
INTEGER CMYTBL(9),KBFUDG(9)
INTEGER LOPMAX(15),COMSCN(40)
INTEGER NSHPRF(4,6)
INTEGER PH(8),OVRPOP(16,2)
INTEGER PRIOR(7)
INTEGER RANGE(200),AR2S(500)
INTEGER ARMTOT(20),CODEFU(1500),CODELA(1500),TARGET(70),LIMIT(16)
INTEGER ARROW(9)
INTEGER D2(3)
INTEGER*2 D(667)
INTEGER MYCODE(1500)
INTEGER RANG(200)
INTEGER IOTAB(16)
INTEGER PHAZEE(8)
integer ptr
BYTE SPECAL,PASS
BYTE AB,AC,AD,AO,E,OWN1,OWN2,OWN !AVOID WORD REFERENCES TO THESE
BYTE KBTBL(9),AB9(9)
BYTE COMM(30),PHAZE(8)
BYTE IFILE(11),KILL
BYTE COMMAN(20),OKA(5),OKB(5),OKC(5)
BYTE TTY(20)
BYTE MOVEDFLAG(1500)
BYTE J1TS(1600)
BYTE EMAP(6000),RMAP(6000),PMAP(6000),OMAP(6000)
BYTE PAMELA(8),REEED(9)
byte jnkbuf ( 80 )
INTEGER RLMAP(3000)
LOGICAL AUTOMV
COMMON/AB9/AB9,PRIOR,NSHPRF
COMMON/ARMTOT/ARMTOT
COMMON/CHRT/COMMAN,COMM,COMSCN,KBTBL
COMMON/CHR2/IFILE,KILL,TTY
COMMON/CITY/FOUND(70),OWNER(70),PHASE(70)
COMMON/CMYTBL/CMYTBL,KBFUDG
COMMON/COD/CODER
COMMON/CODE/CODEFU,CODELA
COMMON/CRAHL/HITS,TIPE,CRAHIT,CRALOC
COMMON/FIPATH/FIPATH(70)
COMMON/G2/G2
COMMON/IARROW/IARROW(10),ARROW,INDEX,LOPMAX
COMMON/IOTAB/IOTAB
COMMON/J1TS/J1TS
COMMON/KXK/IADJST
COMMON/MAP/D
COMMON/MAPBLK/EMAP,RMAP,PMAP,RLMAP
COMMON/OMAP/OMAP
COMMON/MISC1/TARGET,AR2S,RANGE,RANG
COMMON/MISC2/LOCI(10,11),NUMBER(18),LIMIT,MDATE,VERSION
COMMON/MODE/MODE,JECTOR,ISEC,NEWRND
COMMON/MFLAGS/MOVEDFLAG
COMMON/MYCOD/D2,MYCODE
COMMON/OKS/OKA,OKB,OKC
COMMON/OVRPOP/OVRPOP
COMMON/P1/PHAZE,PHAZEE,PH
COMMON/DAYTIM/PAMELA,REEED
COMMON/PASS/PASS,SPECAL,AUTOMV
COMMON/SAVBUF/SAVBUF
COMMON/SPS/STEP,POSIT,START
COMMON/TEST2/SUCCES,FAILUR,FULL
COMMON/TROOP/TROOPT(6,5)
COMMON/X/X(70)
common /jnkbuf/ jnkbuf, ptr
C
C AGGR: THIS IS A MEASURE OF THE ENEMY SHIPS AGGRESSIVENESS,
C THIS VALUE IS ADDED TO THE COST-EFFECTIVENESS OF ATTACKING AN
C ENEMY UNIT TO DETERMINE IF THE SHIP WILL ATTACK OR RUN FROM THE
C ENEMY.
C ALL CITIES ARE REFERENCED BY CITY NUMBER, AS IN X(N)=LOC OF CITY #N
C CODFU/CODELA: CONTAINS A NUMBER THAT DETERMINES WHAT THAT COMPUTER CRAFT
C IS ASSIGNED TO DO, IS SEPERATED INTO 2 NUMBERS, IFO AND ILA. IFO
C GIVES THE FUNCTION, ILA GIVES DETAILS.
C CODER: USED FOR DEBUG FLAG
C CROWD: USED IF CITY IS SURROUNDED BY ARMIES
C D: ORIGINAL MAP, ENCODED IN MOD 3
C EXPLOR: THIS IS SET TO 1 IF THE ENEMY SHIP IS TO EXPLORE UNKNOWN
C TERRITORY ADJACENT TO IT, 0 IF NOT.
C FIPATH: STASIS # TO BE GIVEN TO FIGHTER IN THAT CITY
C FOUND: COMPLETION DATES FOR CITIES
C IADJST: SUBTRACTED FROM Z6 SO CURSOR WILL NOT BE MOVED OFF SCREEN
C IARROW: ADDED TO Z6 SO MOVES [1,2,3,4,5,6,7,8,9] ARE CONVERTED
C TO [+1,-99,-100,-101,ETC.]
C ISEC: SECTOR TERMINAL IS SHOWING
C IZAP: .TRUE.=SAVE GAME, .FALSE.=INITIALIZE
C JECTOR: SECTOR PROGRAM IS LOOKING AT
C KURSOR: SET TO POSITION OF CURSOR
C MODE: 1=IN MODE 2, 0=IN MODE 1
C OWNER: WHO OWNS THE CITY: 0>NOBODY, 1>PLAYER, 2>COMPUTER
C PASS: SET TO .TRUE. IF IT IS A PRIVILEGED USER
C PHASE: PHASE OF CITY
C X: LOCATIONS OF CITIES
C
C
ID=2*IDIST(Z6,ILA)+1
DO 100 L=1+IAR2,LIMIT(9)+IAR2
100 IF (RLMAP(L).EQ.Z6) AR2S(L-IAR2)=ID
RETURN
END
FUNCTION EDGER(I)
C
C RETURN NUMBER OF SEA SQUARES THAT ARE ADJACENT TO LOCATION I
C
IMPLICIT INTEGER(A-Z)
PARAMETER IAR=0,IFI=500,IDE=700,ISU=900,ITT=1100,
1 ICR=1200,ICA=1300,IBA=1400
PARAMETER IAR2=1500,IFI2=2000,IDE2=2200,ISU2=2400,ITT2=2600,
1 ICR2=2700,ICA2=2800,IBA2=2900
PARAMETER IDEH=0,ISUH=200,ITTH=400,ICRH=500,ICAH=600,IBAH=700
PARAMETER IDE2H=800,ISU2H=1000,ITT2H=1200,ICR2H=1300,
1 ICA2H=1400,IBA2H=1500
INTEGER G2(100)
INTEGER HITS(15),TIPE(15),CRAHIT(15),CRALOC(15)
INTEGER INDEX(15)
INTEGER CMYTBL(9),KBFUDG(9)
INTEGER LOPMAX(15),COMSCN(40)
INTEGER NSHPRF(4,6)
INTEGER PH(8),OVRPOP(16,2)
INTEGER PRIOR(7)
INTEGER RANGE(200),AR2S(500)
INTEGER ARMTOT(20),CODEFU(1500),CODELA(1500),TARGET(70),LIMIT(16)
INTEGER ARROW(9)
INTEGER D2(3)
INTEGER*2 D(667)
INTEGER MYCODE(1500)
INTEGER RANG(200)
INTEGER IOTAB(16)
INTEGER PHAZEE(8)
integer ptr
BYTE SPECAL,PASS
BYTE AB,AC,AD,AO,E,OWN1,OWN2,OWN !AVOID WORD REFERENCES TO THESE
BYTE KBTBL(9),AB9(9)
BYTE COMM(30),PHAZE(8)
BYTE IFILE(11),KILL
BYTE COMMAN(20),OKA(5),OKB(5),OKC(5)
BYTE TTY(20)
BYTE MOVEDFLAG(1500)
BYTE J1TS(1600)
BYTE EMAP(6000),RMAP(6000),PMAP(6000),OMAP(6000)
BYTE PAMELA(8),REEED(9)
byte jnkbuf ( 80 )
INTEGER RLMAP(3000)
LOGICAL AUTOMV
COMMON/AB9/AB9,PRIOR,NSHPRF
COMMON/ARMTOT/ARMTOT
COMMON/CHRT/COMMAN,COMM,COMSCN,KBTBL
COMMON/CHR2/IFILE,KILL,TTY
COMMON/CITY/FOUND(70),OWNER(70),PHASE(70)
COMMON/CMYTBL/CMYTBL,KBFUDG
COMMON/COD/CODER
COMMON/CODE/CODEFU,CODELA
COMMON/CRAHL/HITS,TIPE,CRAHIT,CRALOC
COMMON/FIPATH/FIPATH(70)
COMMON/G2/G2
COMMON/IARROW/IARROW(10),ARROW,INDEX,LOPMAX
COMMON/IOTAB/IOTAB
COMMON/J1TS/J1TS
COMMON/KXK/IADJST
COMMON/MAP/D
COMMON/MAPBLK/EMAP,RMAP,PMAP,RLMAP
COMMON/OMAP/OMAP
COMMON/MISC1/TARGET,AR2S,RANGE,RANG
COMMON/MISC2/LOCI(10,11),NUMBER(18),LIMIT,MDATE,VERSION
COMMON/MODE/MODE,JECTOR,ISEC,NEWRND
COMMON/MFLAGS/MOVEDFLAG
COMMON/MYCOD/D2,MYCODE
COMMON/OKS/OKA,OKB,OKC
COMMON/OVRPOP/OVRPOP
COMMON/P1/PHAZE,PHAZEE,PH
COMMON/DAYTIM/PAMELA,REEED
COMMON/PASS/PASS,SPECAL,AUTOMV
COMMON/SAVBUF/SAVBUF
COMMON/SPS/STEP,POSIT,START
COMMON/TEST2/SUCCES,FAILUR,FULL
COMMON/TROOP/TROOPT(6,5)
COMMON/X/X(70)
common /jnkbuf/ jnkbuf, ptr
C
C AGGR: THIS IS A MEASURE OF THE ENEMY SHIPS AGGRESSIVENESS,
C THIS VALUE IS ADDED TO THE COST-EFFECTIVENESS OF ATTACKING AN
C ENEMY UNIT TO DETERMINE IF THE SHIP WILL ATTACK OR RUN FROM THE
C ENEMY.
C ALL CITIES ARE REFERENCED BY CITY NUMBER, AS IN X(N)=LOC OF CITY #N
C CODFU/CODELA: CONTAINS A NUMBER THAT DETERMINES WHAT THAT COMPUTER CRAFT
C IS ASSIGNED TO DO, IS SEPERATED INTO 2 NUMBERS, IFO AND ILA. IFO
C GIVES THE FUNCTION, ILA GIVES DETAILS.
C CODER: USED FOR DEBUG FLAG
C CROWD: USED IF CITY IS SURROUNDED BY ARMIES
C D: ORIGINAL MAP, ENCODED IN MOD 3
C EXPLOR: THIS IS SET TO 1 IF THE ENEMY SHIP IS TO EXPLORE UNKNOWN
C TERRITORY ADJACENT TO IT, 0 IF NOT.
C FIPATH: STASIS # TO BE GIVEN TO FIGHTER IN THAT CITY
C FOUND: COMPLETION DATES FOR CITIES
C IADJST: SUBTRACTED FROM Z6 SO CURSOR WILL NOT BE MOVED OFF SCREEN
C IARROW: ADDED TO Z6 SO MOVES [1,2,3,4,5,6,7,8,9] ARE CONVERTED
C TO [+1,-99,-100,-101,ETC.]
C ISEC: SECTOR TERMINAL IS SHOWING
C IZAP: .TRUE.=SAVE GAME, .FALSE.=INITIALIZE
C JECTOR: SECTOR PROGRAM IS LOOKING AT
C KURSOR: SET TO POSITION OF CURSOR
C MODE: 1=IN MODE 2, 0=IN MODE 1
C OWNER: WHO OWNS THE CITY: 0>NOBODY, 1>PLAYER, 2>COMPUTER
C PASS: SET TO .TRUE. IF IT IS A PRIVILEGED USER
C PHASE: PHASE OF CITY
C X: LOCATIONS OF CITIES
C
C
EDGER=0
DO 100 IA=1,8
100 IF (OMAP(I+IARROW(IA+1)).EQ.'.') EDGER=EDGER+1
RETURN
END
subroutine edit(z5)
c
c Edit mode command subroutine
c test routines for path
c
IMPLICIT INTEGER(A-Z)
PARAMETER IAR=0,IFI=500,IDE=700,ISU=900,ITT=1100,
1 ICR=1200,ICA=1300,IBA=1400
PARAMETER IAR2=1500,IFI2=2000,IDE2=2200,ISU2=2400,ITT2=2600,
1 ICR2=2700,ICA2=2800,IBA2=2900
PARAMETER IDEH=0,ISUH=200,ITTH=400,ICRH=500,ICAH=600,IBAH=700
PARAMETER IDE2H=800,ISU2H=1000,ITT2H=1200,ICR2H=1300,
1 ICA2H=1400,IBA2H=1500
INTEGER G2(100)
INTEGER HITS(15),TIPE(15),CRAHIT(15),CRALOC(15)
INTEGER INDEX(15)
INTEGER CMYTBL(9),KBFUDG(9)
INTEGER LOPMAX(15),COMSCN(40)
INTEGER NSHPRF(4,6)
INTEGER PH(8),OVRPOP(16,2)
INTEGER PRIOR(7)
INTEGER RANGE(200),AR2S(500)
INTEGER ARMTOT(20),CODEFU(1500),CODELA(1500),TARGET(70),LIMIT(16)
INTEGER ARROW(9)
INTEGER D2(3)
INTEGER*2 D(667)
INTEGER MYCODE(1500)
INTEGER RANG(200)
INTEGER IOTAB(16)
INTEGER PHAZEE(8)
integer ptr
BYTE SPECAL,PASS
BYTE AB,AC,AD,AO,E,OWN1,OWN2,OWN !AVOID WORD REFERENCES TO THESE
BYTE KBTBL(9),AB9(9)
BYTE COMM(30),PHAZE(8)
BYTE IFILE(11),KILL
BYTE COMMAN(20),OKA(5),OKB(5),OKC(5)
BYTE TTY(20)
BYTE MOVEDFLAG(1500)
BYTE J1TS(1600)
BYTE EMAP(6000),RMAP(6000),PMAP(6000),OMAP(6000)
BYTE PAMELA(8),REEED(9)
byte jnkbuf ( 80 )
INTEGER RLMAP(3000)
LOGICAL AUTOMV
COMMON/AB9/AB9,PRIOR,NSHPRF
COMMON/ARMTOT/ARMTOT
COMMON/CHRT/COMMAN,COMM,COMSCN,KBTBL
COMMON/CHR2/IFILE,KILL,TTY
COMMON/CITY/FOUND(70),OWNER(70),PHASE(70)
COMMON/CMYTBL/CMYTBL,KBFUDG
COMMON/COD/CODER
COMMON/CODE/CODEFU,CODELA
COMMON/CRAHL/HITS,TIPE,CRAHIT,CRALOC
COMMON/FIPATH/FIPATH(70)
COMMON/G2/G2
COMMON/IARROW/IARROW(10),ARROW,INDEX,LOPMAX
COMMON/IOTAB/IOTAB
COMMON/J1TS/J1TS
COMMON/KXK/IADJST
COMMON/MAP/D
COMMON/MAPBLK/EMAP,RMAP,PMAP,RLMAP
COMMON/OMAP/OMAP
COMMON/MISC1/TARGET,AR2S,RANGE,RANG
COMMON/MISC2/LOCI(10,11),NUMBER(18),LIMIT,MDATE,VERSION
COMMON/MODE/MODE,JECTOR,ISEC,NEWRND
COMMON/MFLAGS/MOVEDFLAG
COMMON/MYCOD/D2,MYCODE
COMMON/OKS/OKA,OKB,OKC
COMMON/OVRPOP/OVRPOP
COMMON/P1/PHAZE,PHAZEE,PH
COMMON/DAYTIM/PAMELA,REEED
COMMON/PASS/PASS,SPECAL,AUTOMV
COMMON/SAVBUF/SAVBUF
COMMON/SPS/STEP,POSIT,START
COMMON/TEST2/SUCCES,FAILUR,FULL
COMMON/TROOP/TROOPT(6,5)
COMMON/X/X(70)
common /jnkbuf/ jnkbuf, ptr
C
C AGGR: THIS IS A MEASURE OF THE ENEMY SHIPS AGGRESSIVENESS,
C THIS VALUE IS ADDED TO THE COST-EFFECTIVENESS OF ATTACKING AN
C ENEMY UNIT TO DETERMINE IF THE SHIP WILL ATTACK OR RUN FROM THE
C ENEMY.
C ALL CITIES ARE REFERENCED BY CITY NUMBER, AS IN X(N)=LOC OF CITY #N
C CODFU/CODELA: CONTAINS A NUMBER THAT DETERMINES WHAT THAT COMPUTER CRAFT
C IS ASSIGNED TO DO, IS SEPERATED INTO 2 NUMBERS, IFO AND ILA. IFO
C GIVES THE FUNCTION, ILA GIVES DETAILS.
C CODER: USED FOR DEBUG FLAG
C CROWD: USED IF CITY IS SURROUNDED BY ARMIES
C D: ORIGINAL MAP, ENCODED IN MOD 3
C EXPLOR: THIS IS SET TO 1 IF THE ENEMY SHIP IS TO EXPLORE UNKNOWN
C TERRITORY ADJACENT TO IT, 0 IF NOT.
C FIPATH: STASIS # TO BE GIVEN TO FIGHTER IN THAT CITY
C FOUND: COMPLETION DATES FOR CITIES
C IADJST: SUBTRACTED FROM Z6 SO CURSOR WILL NOT BE MOVED OFF SCREEN
C IARROW: ADDED TO Z6 SO MOVES [1,2,3,4,5,6,7,8,9] ARE CONVERTED
C TO [+1,-99,-100,-101,ETC.]
C ISEC: SECTOR TERMINAL IS SHOWING
C IZAP: .TRUE.=SAVE GAME, .FALSE.=INITIALIZE
C JECTOR: SECTOR PROGRAM IS LOOKING AT
C KURSOR: SET TO POSITION OF CURSOR
C MODE: 1=IN MODE 2, 0=IN MODE 1
C OWNER: WHO OWNS THE CITY: 0>NOBODY, 1>PLAYER, 2>COMPUTER
C PASS: SET TO .TRUE. IF IT IS A PRIVILEGED USER
C PHASE: PHASE OF CITY
C X: LOCATIONS OF CITIES
C
byte char
z6=z5
whtflg=0
movflg=0
oldj=jector
call sector(pmap(1))
100 line=kline(ki,jector)
iadjst=line+ki-300
if (z6.eq.0) z6=iadjst+1240
dir=1
200 call cursor(z6-iadjst)
e=getchx()
z7 = z6
do 300 i=1,8
300 if (e.eq.comm(i)) z6=z6+iarrow(i+1)
! if cursor move, change location
if ((scrchk(z6).eq.1).and.(order(z6).eq.0)) goto 400
z6=z7 ! if not on screen, get back
goto 4500
400 if (z6.eq.z7) goto 500
goto 200
500 do 600 i=10,30
j=i
600 if (e.eq.comm(i)) goto 700
goto 4500
c
c l, b, f, t, g, v, j, u,-1,-1 priv cmds
c
700 if (pass) goto (800,900,1000,1100,1200,1400,1500,1600,1700,1800) j-9
c
c o, p, r, i, m, k, n, s, ?, y, h normal cmds
c
goto (1300,1900,4300,2100,2500,2700,2900,3100,3200,4200,4400) j-19
goto 4500
800 isec=-1 !n - display enemy sector
call sector(emap(1))
goto 200
900 beg=z6 !b - set beg
ix='B'
type 999,ix
999 format('+',a1,$)
goto 200
1000 end=z6 !f - set end
ix='E'
type 999,ix
goto 200
1100 flag=1000 !t - single step & trace path
call path(beg,end,dir,okc,flag)
goto 200
1200 flag=1001 !g - show path chosen
call path(beg,end,dir,okc,flag)
goto 200
1300 continue !o - return to caller
jector=oldj !restore sector number
line=kline(ki,jector)
iadjst=line+ki-300
call sector(pmap(1)) ! refresh our map
return
1400 dir=-dir !v - reverse direction
goto 200
1500 h2=30 !j - display code values for
own2=rmap(z6) ! enemy units
if (own2.lt.'a' .or. own2.gt.'9') goto 4500
call find(own2,z6,z8,h2)
ptr = 0
call addstr ( 'Code: ', jnkbuf, ptr )
call addint ( codefu ( z8 - 1500 ), jnkbuf, ptr )
call addstr ( ' ', jnkbuf, ptr )
call addint ( codela ( z8 - 1500 ), jnkbuf, ptr )
call bufpos ( 1, 50, jnkbuf, ptr )
call flush
goto 200
1600 isec=-1 !u - display reference sector
call sector(rmap(1))
goto 200
1700 continue ! shouldn't happen
1800 continue
stop
c
c p: print out new sector
c
1900 isec=-1
call topmsg ( 3, 0 )
call topmsg ( 2, 0 )
call topmsg ( 1, 'New Sector: ')
call flush
jector = iphase(getchx())
call addcnt ( 1, 1 )
if ( jector .lt. 0 .or. jector .gt. 9 ) goto 1900
call sector ( pmap ( 1 ))
isec = -1
z6 = 0
goto 100
c
c r: print out the round number
c
c2000 call TPOS(2,50)
c call SSTROUT ( ' Round #',12)
c call decprt(mdate)
c call eol
c goto 200
c
c i: directional stasis
c
2100 ab=rmap(z6)
if ((ab.lt.'A').or.(ab.gt.'T')) goto 4500
e=getchx()
do 2200 i=1,8
j=i
2200 if (comm(i).eq.e) goto 2300
goto 4500
2300 if (ab.ne.'O') goto 2400
fipath(citfnd(z6))=j+6100
goto 200
2400 h2=30
call find(ab,z6,movflg,h2)
mycode(movflg)=j+6100
goto 200
c
c m: say we want to move to a location
c
2500 ab=rmap(z6)
if ((ab.lt.'A').or.(ab.gt.'T')) goto 4500
if (ab.ne.'O') goto 2600
whtflg='CI'
movflg=citfnd(z6)
goto 200
2600 h2=30
call find(ab,z6,movflg,h2)
whtflg='UN'
goto 200
c
c k: wake up anything and everything
c
2700 ab=rmap(z6)
if ((ab.lt.'A').or.(ab.gt.'T')) goto 4500
if (ab.ne.'O') goto 2800
fipath(citfnd(z6))=0 !if city, kill flight path
do 2750 i=501,1500 !wake any fighters or ships
if (rlmap(i).eq.z6) mycode(i)=0
2750 continue
goto 200
2800 h2=30 !not a city, find the unit
call find(ab,z6,movflg,h2)
mycode(movflg)=0 !zero any function code
if (ab.ne.'T') goto 2817 !if transport, wake armies aboard
do 2816 j=1,500
2816 if (rlmap(j).eq.z6) mycode(j)=0
goto 200
2817 if (ab.ne.'C') goto 200 !if carrier, wake fighters aboard
do 2818 j=501,700
2818 if (rlmap(j).eq.z6) mycode(j)=0
goto 200
c
c n: go here
c
2900 if (whtflg.ne.'CI') goto 3000
fipath(movflg)=z6
goto 200
3000 if (whtflg.ne.'UN') goto 4500
mycode(movflg)=z6
goto 200
c
c s: goto sleep
c
3100 ab=rmap(z6)
if ((ab.lt.'A').or.(ab.gt.'T')) goto 4500
if (ab.eq.'O') goto 4500
h2=30
call find(ab,z6,movflg,h2)
mycode(movflg)=50
goto 200
c
c ?: request info
c
3200 ab = rmap ( z6 )
if (ab.eq.'O') goto 3800
if ((ab.eq.'X').and.(pass)) goto 3800
if ((ab.ge.'A').and.(ab.le.'T')) goto 3250
if ((ab.ge.'a').and.(ab.le.'t').and.(pass)) goto 3250
goto 4500
3250 h2=30
call find(ab,z6,movflg,h2)
if (movflg.le.1500) then
do 3300 i=1,8
3300 if (ab.eq. phaze(i)) relnum=movflg-craloc(phazee(i))
call topmsg ( 3, 0 )
call topmsg ( 2, 0 ) ! clear line
call head (ab, relnum, movflg, z6, h2 ) ! display standard header
else
call tpos ( 1, 1 )
type 989,movflg,codefu(movflg-1500),codela(movflg-1500),h2
989 format ( '+ unit=',i5,' function=',i5,' sub func=',i5,
1 ' hits=',i2,$)
endif
if ((ab.eq.'A').or.(ab.eq.'F').or.(ab.eq.'a').or.(ab.eq.'f')) goto 200
n=0
base=0
if (movflg.gt.1500) base=1500
if ((ab.ne.'T').and.(ab.ne.'t')) goto 3500
do 3400 i=1,500 !count armies
3400 if (rlmap(i+base).eq.z6) n=n+1
if (n.eq.0) goto 3700
ptr = 0
call addint ( n, jnkbuf, ptr )
if ( n .eq. 1 ) call addstr ( ' army', jnkbuf, ptr )
if ( n .gt. 1 ) call addstr ( ' armies', jnkbuf, ptr )
call addstr ( ' aboard', jnkbuf, ptr )
jnkbuf ( ptr + 1 ) = 0
call topmsg ( 3, jnkbuf )
call flush
goto 200
3500 if ((ab.ne.'C').and.(ab.ne.'c')) goto 200
do 3600 i=1,200 ! count fighters
3600 if (rlmap(i+500+base).eq.z6) n=n+1
if (n.eq.0) goto 3700
cc if (mode.eq.1) call TPOS(3,1)
ptr = 0
call addint ( n, jnkbuf, ptr )
call addstr ( ' fighter', jnkbuf, ptr )
if ( n .gt. 1 ) call addstr ( 's', jnkbuf, ptr )
call addstr ( ' aboard', jnkbuf, ptr )
jnkbuf ( ptr + 1 ) = 0
call topmsg ( 3, jnkbuf )
call flush
goto 200
3700 continue ! nothing there
cc if (mode.eq.1) call TPOS(3,1)
call topmsg ( 3, 'Nothing aboard' )
call flush
goto 200
c
c Display info on city
c
3800 continue
call topmsg ( 2, 0 ) ! clear line
j=citfnd(z6) ! find city
base=0
if (owner(j).eq.2) base=1500
n=0
do 3900 i=base+501,base+700 ! count fighters
3900 if (rlmap(i).eq.z6) n=n+1
cc call tpos(2,1)
ptr = 0
call addint ( n, jnkbuf, ptr )
call addstr ( ' fighter', jnkbuf, ptr )
if ( n .ne. 1 ) call addstr ( 's', jnkbuf, ptr )
call addstr ( ' landed, ', jnkbuf, ptr )
n=0
do 4000 i=base+701,base+1500 ! count ships
4000 if (rlmap(i).eq.z6) n=n+1
call addint ( n, jnkbuf, ptr )
call addstr ( ' ship', jnkbuf, ptr )
if ( n .ne. 1 ) call addstr ( 's', jnkbuf, ptr )
call addstr ( ' docked', jnkbuf, ptr )
jnkbuf ( ptr + 1 ) = 0
call topmsg ( 3, jnkbuf )
4150 continue ! explain production
ptr = 0
call addstr ( 'City at location ', jnkbuf, ptr )
call addint ( z6, jnkbuf, ptr )
call addstr ( ', will complete a', jnkbuf, ptr )
do 4100 i=1,8
if (phase(j) .eq. phazee(i)) char = phaze ( i )
4100 continue
if (( char .eq. 'A') .or. ( char .eq. 'a' ))
* call addstr ( 'n', jnkbuf, ptr )
call addstr ( ' ', jnkbuf, ptr )
call addpei ( char, jnkbuf, ptr )
call addstr ( ' on ', jnkbuf, ptr )
call addint ( found ( j ), jnkbuf, ptr )
call addstr ( ', fpath: ', jnkbuf, ptr )
if (fipath(j).lt.100) call addstr ( 'sit', jnkbuf, ptr )
if ((fipath(j).gt.100).and.(fipath(j).lt.6000))
* call addint ( fipath ( j ), jnkbuf, ptr )
if ( fipath ( j ) .le. 6100 ) goto 4126
ptr = ptr + 1
jnkbuf ( ptr ) = comm ( fipath ( j ) - 6100 )
4126 continue
jnkbuf ( ptr + 1 ) = 0
call topmsg ( 1, jnkbuf )
call flush
goto 200
c
c y: enter new city production
c
4200 ab = rmap ( z6 )
if ( ab .ne. 'O' ) goto 4500
j = citfnd ( z6 )
call topmsg ( 3, 0 )
call topmsg ( 2, 0 )
call topmsg ( 1, 'New Production: ' )
call flush
call phasin ( j, e )
call addcnt ( 1, 1 )
call putc ( e )
call flush
goto 4150
c
c r: set army to move at random
c
4300 ab = rmap ( z6 )
if ( ab .ne. 'A' ) goto 4500
h2 = 30
call find ( ab, z6, movflg, h2 )
mycode ( movflg ) = 100
goto 200
c
c h: get help
c
4400 call help
e = getchx()
isec = -1
call sector(pmap(1))
isec = -1
goto 100
c
c Default mistake message
c
4500 call huh
goto 200
end
subroutine empend
CC call gamend
CC call endst(0)
call exit
end
SUBROUTINE ENEMYM(OWN1,HITMAX,ACRAHIT,ACRALOC,NUM)
C
C THIS SUBROUTINE HANDLES ENEMY SHIP MOVES OTHER THAN T'S AND C'S
C
IMPLICIT INTEGER(A-Z)
PARAMETER IAR=0,IFI=500,IDE=700,ISU=900,ITT=1100,
1 ICR=1200,ICA=1300,IBA=1400
PARAMETER IAR2=1500,IFI2=2000,IDE2=2200,ISU2=2400,ITT2=2600,
1 ICR2=2700,ICA2=2800,IBA2=2900
PARAMETER IDEH=0,ISUH=200,ITTH=400,ICRH=500,ICAH=600,IBAH=700
PARAMETER IDE2H=800,ISU2H=1000,ITT2H=1200,ICR2H=1300,
1 ICA2H=1400,IBA2H=1500
INTEGER G2(100)
INTEGER HITS(15),TIPE(15),CRAHIT(15),CRALOC(15)
INTEGER INDEX(15)
INTEGER CMYTBL(9),KBFUDG(9)
INTEGER LOPMAX(15),COMSCN(40)
INTEGER NSHPRF(4,6)
INTEGER PH(8),OVRPOP(16,2)
INTEGER PRIOR(7)
INTEGER RANGE(200),AR2S(500)
INTEGER ARMTOT(20),CODEFU(1500),CODELA(1500),TARGET(70),LIMIT(16)
INTEGER ARROW(9)
INTEGER D2(3)
INTEGER*2 D(667)
INTEGER MYCODE(1500)
INTEGER RANG(200)
INTEGER IOTAB(16)
INTEGER PHAZEE(8)
integer ptr
BYTE SPECAL,PASS
BYTE AB,AC,AD,AO,E,OWN1,OWN2,OWN !AVOID WORD REFERENCES TO THESE
BYTE KBTBL(9),AB9(9)
BYTE COMM(30),PHAZE(8)
BYTE IFILE(11),KILL
BYTE COMMAN(20),OKA(5),OKB(5),OKC(5)
BYTE TTY(20)
BYTE MOVEDFLAG(1500)
BYTE J1TS(1600)
BYTE EMAP(6000),RMAP(6000),PMAP(6000),OMAP(6000)
BYTE PAMELA(8),REEED(9)
byte jnkbuf ( 80 )
INTEGER RLMAP(3000)
LOGICAL AUTOMV
COMMON/AB9/AB9,PRIOR,NSHPRF
COMMON/ARMTOT/ARMTOT
COMMON/CHRT/COMMAN,COMM,COMSCN,KBTBL
COMMON/CHR2/IFILE,KILL,TTY
COMMON/CITY/FOUND(70),OWNER(70),PHASE(70)
COMMON/CMYTBL/CMYTBL,KBFUDG
COMMON/COD/CODER
COMMON/CODE/CODEFU,CODELA
COMMON/CRAHL/HITS,TIPE,CRAHIT,CRALOC
COMMON/FIPATH/FIPATH(70)
COMMON/G2/G2
COMMON/IARROW/IARROW(10),ARROW,INDEX,LOPMAX
COMMON/IOTAB/IOTAB
COMMON/J1TS/J1TS
COMMON/KXK/IADJST
COMMON/MAP/D
COMMON/MAPBLK/EMAP,RMAP,PMAP,RLMAP
COMMON/OMAP/OMAP
COMMON/MISC1/TARGET,AR2S,RANGE,RANG
COMMON/MISC2/LOCI(10,11),NUMBER(18),LIMIT,MDATE,VERSION
COMMON/MODE/MODE,JECTOR,ISEC,NEWRND
COMMON/MFLAGS/MOVEDFLAG
COMMON/MYCOD/D2,MYCODE
COMMON/OKS/OKA,OKB,OKC
COMMON/OVRPOP/OVRPOP
COMMON/P1/PHAZE,PHAZEE,PH
COMMON/DAYTIM/PAMELA,REEED
COMMON/PASS/PASS,SPECAL,AUTOMV
COMMON/SAVBUF/SAVBUF
COMMON/SPS/STEP,POSIT,START
COMMON/TEST2/SUCCES,FAILUR,FULL
COMMON/TROOP/TROOPT(6,5)
COMMON/X/X(70)
common /jnkbuf/ jnkbuf, ptr
C
C AGGR: THIS IS A MEASURE OF THE ENEMY SHIPS AGGRESSIVENESS,
C THIS VALUE IS ADDED TO THE COST-EFFECTIVENESS OF ATTACKING AN
C ENEMY UNIT TO DETERMINE IF THE SHIP WILL ATTACK OR RUN FROM THE
C ENEMY.
C ALL CITIES ARE REFERENCED BY CITY NUMBER, AS IN X(N)=LOC OF CITY #N
C CODFU/CODELA: CONTAINS A NUMBER THAT DETERMINES WHAT THAT COMPUTER CRAFT
C IS ASSIGNED TO DO, IS SEPERATED INTO 2 NUMBERS, IFO AND ILA. IFO
C GIVES THE FUNCTION, ILA GIVES DETAILS.
C CODER: USED FOR DEBUG FLAG
C CROWD: USED IF CITY IS SURROUNDED BY ARMIES
C D: ORIGINAL MAP, ENCODED IN MOD 3
C EXPLOR: THIS IS SET TO 1 IF THE ENEMY SHIP IS TO EXPLORE UNKNOWN
C TERRITORY ADJACENT TO IT, 0 IF NOT.
C FIPATH: STASIS # TO BE GIVEN TO FIGHTER IN THAT CITY
C FOUND: COMPLETION DATES FOR CITIES
C IADJST: SUBTRACTED FROM Z6 SO CURSOR WILL NOT BE MOVED OFF SCREEN
C IARROW: ADDED TO Z6 SO MOVES [1,2,3,4,5,6,7,8,9] ARE CONVERTED
C TO [+1,-99,-100,-101,ETC.]
C ISEC: SECTOR TERMINAL IS SHOWING
C IZAP: .TRUE.=SAVE GAME, .FALSE.=INITIALIZE
C JECTOR: SECTOR PROGRAM IS LOOKING AT
C KURSOR: SET TO POSITION OF CURSOR
C MODE: 1=IN MODE 2, 0=IN MODE 1
C OWNER: WHO OWNS THE CITY: 0>NOBODY, 1>PLAYER, 2>COMPUTER
C PASS: SET TO .TRUE. IF IT IS A PRIVILEGED USER
C PHASE: PHASE OF CITY
C X: LOCATIONS OF CITIES
C
C
C NSHPRF IS AN ARRAY WHICH IS REFERENCED TO DETERMINE
C WHETHER A CERTAIN SHIP (D=1,S=2,R=3,B=4) WANTS TO ATTACK
C ANOTHER CERTAIN TYPE OF SHIP. 1 MEANS YES, 0 MEANS NO.
C SECOND VARIABLE: 1=D,2=S,3=T,4=R,5=C,6=B
C
DATA NSHPRF/1,1,1,0,0,0,1,1,1,0,0,0,1,1,1,1,1,0,1,1,1,1,1,1/
C
CTHE FOLLOWING NUMBERS ARE IFO VARIABLES RELATING TO
C CERTAIN TYPES OF MOVEMENT (CODES)
C 7: RANDOM DIRECTION
C 3: CITY TARGET LOC.
C 4: TT NUMBER ESCORT
C 5: TARGET
C 8: DAMAGED
C 10: LOOK AT UNEXPLORED TERRITORY
C
IF (NUM.EQ.3) NUMSHP=1
IF (NUM.EQ.4) NUMSHP=2
IF (NUM.EQ.6) NUMSHP=3
IF (NUM.EQ.8) NUMSHP=4
C
NUMBER(NUM)=0
IF (CODER.EQ.NUM) TYPE 999,OWN1
999 FORMAT(1X,A1,' CODES')
MONKEY=0
C
DO 2400 Y=1,LIMIT(NUM+8)
Z6=RLMAP(Y+ACRALOC)
IF (Z6.EQ.0) GOTO 2400
DIR=MOD(Y,2)*2-1
H1=J1TS(Y+ACRAHIT)
AB=RMAP(Z6)
IF (AB.EQ.'X') H1=H1+1
IF (H1.GT.HITMAX) H1=HITMAX
C
ORIG=Z6
DO 2300 ITURN=1,2
P='NS'
IF ((ITURN.EQ.2).AND.(H1.LE.HITMAX/2)) GOTO 2400
Z7=Z6
C
C MOVE SELECTION
C
IFO=CODEFU(Y+ACRALOC-1500)
ILA=CODELA(Y+ACRALOC-1500)
C
C DOES A NEW CODE NEED TO BE SELECTED? 800:YES, 1600:NO
C
IF ((IFO.EQ.8).AND.(H1.EQ.HITMAX)) IFO=0
IF (IFO.EQ.8) GOTO 1600
IF (H1.EQ.HITMAX) GOTO 100
IFO=8
ILA=IPORT(Z6)
GOTO 1600
100 GOTO (800,200,300,400,500,800,800,800,800,700) IFO
GOTO 800
C
200 GOTO 800
C
300 IF (RMAP(ILA).EQ.'X') GOTO 800
IF (IDIST(Z6,ILA).EQ.1) GOTO 800
GOTO 1600
C
400 IF (RLMAP(2600+ILA).EQ.0) GOTO 800
IF (CODEFU(1100+ILA).LT.7) GOTO 800
GOTO 1600
C
500 IF (ILA.NE.Z6) GOTO 1600
DO 600 I1=1,6
DO 600 I2=1,5
IF (TROOPT(I1,I2).NE.ILA) GOTO 600
TROOPT(I1,I2)=0
600 CONTINUE
GOTO 800
C
700 IF (EMAP(ILA).NE.' ') GOTO 800
GOTO 1600
C
C NEW CODE SELECTION
C 5:TARGET
C
800 ID=500
DO 900 N=1,6
IF (NSHPRF(NUMSHP,N).EQ.0) GOTO 900
DO 900 N2=1,5
IF (TROOPT(N,N2).EQ.0) GOTO 900
IF (IDIST(Z6,TROOPT(N,N2)).GE.ID) GOTO 900
ID=IDIST(Z6,TROOPT(N,N2))
ILA=TROOPT(N,N2)
IFO=5
900 CONTINUE
IF (ID.NE.500) GOTO 1600
IF (irand(100).GT.40) GOTO 1200 !**
C
C 3:CITY TARGET LOC.
C
IA=irand(20)+1 !**
IB=IA+70
DO 1100 IC=IA,IB
I=IC
IF (I.GT.70) I=IC-70
IF (TARGET(I).EQ.0) GOTO 1100
IF (RMAP(TARGET(I)).NE.'O') GOTO 1100
IF (EDGER(TARGET(I)).EQ.0) GOTO 1100
IFO=3
ILA=TARGET(I)
GOTO 1600
1100 CONTINUE
C
C 4:TT NUMBER ESCORT
C
1200 IA=irand(LIMIT(13))+1 !**
IB=IA+LIMIT(13)
DO 1300 IC=IA,IB
I=IC
IF (I.GT.LIMIT(13)) I=IC-LIMIT(13)
IF (RLMAP(2600+I).EQ.0) GOTO 1300
IF (CODEFU(1100+I).LT.9) GOTO 1300
IFO=4
ILA=I
GOTO 1600
1300 CONTINUE
C
C 10: EXPLORE
C
1400 I1=EXPL()
IF (I1.EQ.0) GOTO 1500
ILA=I1
IFO=10
GOTO 1600
C
C 1: RANDOM DIRECTION
C
1500 IF (IFO.EQ.7) GOTO 1600
ILA=irand(8)+1 !**
IFO=7
C
C MOVE CORRECTION
C
1600 IF (IFO.EQ.7) MOOV=ILA
FLAG=1
IF ((IFO.EQ.8).OR.(IFO.EQ.3).OR.(IFO.EQ.5))
1 MOOV=PATH(Z6,ILA,DIR,OKC,FLAG)
IF (IFO.EQ.4) MOOV=PATH(Z6,RLMAP(ITT2+ILA),DIR,OKC,FLAG)
IF (FLAG.EQ.0) GOTO 1400
IF (IFO.EQ.10) MOOV=PATH(Z6,ILA,DIR,OKC,FLAG)
IF (FLAG.EQ.0) GOTO 1500
IF (IFO.NE.2) GOTO 1700
MOOV=0
IF (IDIST(Z6,ILA).GT.4) MOOV=MOV(Z6,ILA)
IF (IDIST(Z6,ILA).LT.4) MOOV=ICORR(MOV(Z6,ILA)-4)
1700 AGGR=0
IS1=1
IF (OWN1.EQ.'s') IS1=2
MOOV=MOOV*DIR
MOOV=MOVCOR(IFO,ITURN,Z6,MOOV,H1,IS1,AGGR,OWN1,1,DIR,-1,ORIG,HITMAX)
IF (IFO.EQ.7) ILA=IABS(MOOV)
CODEFU(Y+ACRALOC-1500)=IFO
CODELA(Y+ACRALOC-1500)=ILA
MOOV=IABS(MOOV)
IF (CODER.EQ.NUM) TYPE 998,IFO,ILA
998 FORMAT(I)
C
C MOVE EVALUATION
C
Z6=Z6+IARROW(MOOV+1) !**
IF (OMAP(Z7).NE.'*') RMAP(Z7)=OMAP(Z7)
AD=RMAP(Z6)
IF (AD.EQ.'.') GOTO 1900
IF (AD.EQ.'X') GOTO 2000
IF ((AD.GE.'A').AND.(AD.LE.'T')) GOTO 1800
TYPE 997,OWN1,Z6,AD
997 FORMAT(' ENEMY ',A1,' AT ',I4,' RAN AGROUND ON ',A1)
GOTO 2100
1800 H2=30
P='SE'
OWN2=AD
CALL FIND(OWN2,Z6,Z8,H2)
CALL FGHT(Z6,H1,H2,OWN1,OWN2)
CALL FIND(OWN2,Z6,Z8,H2)
IF (H1.LE.0) GOTO 2100
1900 RMAP(Z6)=OWN1
2000 RLMAP(Y+ACRALOC)=Z6
J1TS(Y+ACRAHIT)=H1
IF (ITURN.EQ.1) NUMBER(NUM)=NUMBER(NUM)+1
MONKEY=Y
GOTO 2200
2100 RLMAP(Y+ACRALOC)=0
CODEFU(Y+ACRALOC-1500)=0
CODELA(Y+ACRALOC-1500)=0
J1TS(Y+ACRAHIT)=0
2200 CALL SONAR(Z6)
IF (P.EQ.'SE') CALL SENSOR(Z6)
2300 CONTINUE
2400 CONTINUE
LIMIT(NUM+8)=MONKEY
RETURN
END
FUNCTION EXPL
C
C THIS SUBROUTINE SEARCHES FOR UNKNOWN TERRITORY AND RETURNS A VALUE
C IN EXPL.
C
IMPLICIT INTEGER(A-Z)
PARAMETER IAR=0,IFI=500,IDE=700,ISU=900,ITT=1100,
1 ICR=1200,ICA=1300,IBA=1400
PARAMETER IAR2=1500,IFI2=2000,IDE2=2200,ISU2=2400,ITT2=2600,
1 ICR2=2700,ICA2=2800,IBA2=2900
PARAMETER IDEH=0,ISUH=200,ITTH=400,ICRH=500,ICAH=600,IBAH=700
PARAMETER IDE2H=800,ISU2H=1000,ITT2H=1200,ICR2H=1300,
1 ICA2H=1400,IBA2H=1500
INTEGER G2(100)
INTEGER HITS(15),TIPE(15),CRAHIT(15),CRALOC(15)
INTEGER INDEX(15)
INTEGER CMYTBL(9),KBFUDG(9)
INTEGER LOPMAX(15),COMSCN(40)
INTEGER NSHPRF(4,6)
INTEGER PH(8),OVRPOP(16,2)
INTEGER PRIOR(7)
INTEGER RANGE(200),AR2S(500)
INTEGER ARMTOT(20),CODEFU(1500),CODELA(1500),TARGET(70),LIMIT(16)
INTEGER ARROW(9)
INTEGER D2(3)
INTEGER*2 D(667)
INTEGER MYCODE(1500)
INTEGER RANG(200)
INTEGER IOTAB(16)
INTEGER PHAZEE(8)
integer ptr
BYTE SPECAL,PASS
BYTE AB,AC,AD,AO,E,OWN1,OWN2,OWN !AVOID WORD REFERENCES TO THESE
BYTE KBTBL(9),AB9(9)
BYTE COMM(30),PHAZE(8)
BYTE IFILE(11),KILL
BYTE COMMAN(20),OKA(5),OKB(5),OKC(5)
BYTE TTY(20)
BYTE MOVEDFLAG(1500)
BYTE J1TS(1600)
BYTE EMAP(6000),RMAP(6000),PMAP(6000),OMAP(6000)
BYTE PAMELA(8),REEED(9)
byte jnkbuf ( 80 )
INTEGER RLMAP(3000)
LOGICAL AUTOMV
COMMON/AB9/AB9,PRIOR,NSHPRF
COMMON/ARMTOT/ARMTOT
COMMON/CHRT/COMMAN,COMM,COMSCN,KBTBL
COMMON/CHR2/IFILE,KILL,TTY
COMMON/CITY/FOUND(70),OWNER(70),PHASE(70)
COMMON/CMYTBL/CMYTBL,KBFUDG
COMMON/COD/CODER
COMMON/CODE/CODEFU,CODELA
COMMON/CRAHL/HITS,TIPE,CRAHIT,CRALOC
COMMON/FIPATH/FIPATH(70)
COMMON/G2/G2
COMMON/IARROW/IARROW(10),ARROW,INDEX,LOPMAX
COMMON/IOTAB/IOTAB
COMMON/J1TS/J1TS
COMMON/KXK/IADJST
COMMON/MAP/D
COMMON/MAPBLK/EMAP,RMAP,PMAP,RLMAP
COMMON/OMAP/OMAP
COMMON/MISC1/TARGET,AR2S,RANGE,RANG
COMMON/MISC2/LOCI(10,11),NUMBER(18),LIMIT,MDATE,VERSION
COMMON/MODE/MODE,JECTOR,ISEC,NEWRND
COMMON/MFLAGS/MOVEDFLAG
COMMON/MYCOD/D2,MYCODE
COMMON/OKS/OKA,OKB,OKC
COMMON/OVRPOP/OVRPOP
COMMON/P1/PHAZE,PHAZEE,PH
COMMON/DAYTIM/PAMELA,REEED
COMMON/PASS/PASS,SPECAL,AUTOMV
COMMON/SAVBUF/SAVBUF
COMMON/SPS/STEP,POSIT,START
COMMON/TEST2/SUCCES,FAILUR,FULL
COMMON/TROOP/TROOPT(6,5)
COMMON/X/X(70)
common /jnkbuf/ jnkbuf, ptr
C
C AGGR: THIS IS A MEASURE OF THE ENEMY SHIPS AGGRESSIVENESS,
C THIS VALUE IS ADDED TO THE COST-EFFECTIVENESS OF ATTACKING AN
C ENEMY UNIT TO DETERMINE IF THE SHIP WILL ATTACK OR RUN FROM THE
C ENEMY.
C ALL CITIES ARE REFERENCED BY CITY NUMBER, AS IN X(N)=LOC OF CITY #N
C CODFU/CODELA: CONTAINS A NUMBER THAT DETERMINES WHAT THAT COMPUTER CRAFT
C IS ASSIGNED TO DO, IS SEPERATED INTO 2 NUMBERS, IFO AND ILA. IFO
C GIVES THE FUNCTION, ILA GIVES DETAILS.
C CODER: USED FOR DEBUG FLAG
C CROWD: USED IF CITY IS SURROUNDED BY ARMIES
C D: ORIGINAL MAP, ENCODED IN MOD 3
C EXPLOR: THIS IS SET TO 1 IF THE ENEMY SHIP IS TO EXPLORE UNKNOWN
C TERRITORY ADJACENT TO IT, 0 IF NOT.
C FIPATH: STASIS # TO BE GIVEN TO FIGHTER IN THAT CITY
C FOUND: COMPLETION DATES FOR CITIES
C IADJST: SUBTRACTED FROM Z6 SO CURSOR WILL NOT BE MOVED OFF SCREEN
C IARROW: ADDED TO Z6 SO MOVES [1,2,3,4,5,6,7,8,9] ARE CONVERTED
C TO [+1,-99,-100,-101,ETC.]
C ISEC: SECTOR TERMINAL IS SHOWING
C IZAP: .TRUE.=SAVE GAME, .FALSE.=INITIALIZE
C JECTOR: SECTOR PROGRAM IS LOOKING AT
C KURSOR: SET TO POSITION OF CURSOR
C MODE: 1=IN MODE 2, 0=IN MODE 1
C OWNER: WHO OWNS THE CITY: 0>NOBODY, 1>PLAYER, 2>COMPUTER
C PASS: SET TO .TRUE. IF IT IS A PRIVILEGED USER
C PHASE: PHASE OF CITY
C X: LOCATIONS OF CITIES
C
C
IF (FULL.EQ.2) GOTO 300
BEGPOS=START
GOTO 200
100 IF ((EMAP(POSIT).EQ.' ').AND.(ORDER(POSIT).EQ.0)) GOTO 400
200 POSIT=POSIT+STEP
IF (POSIT.LT.5900) GOTO 100
START=START+1
POSIT=START
IF (START.EQ.BEGPOS+37) GOTO 300
GOTO 100
300 EXPL=0
FULL=2
C CALL tpos(1,1)
C TYPE 999,POSIT,STEP,START,BEGPOS,KNOWN
C999 FORMAT('+POSIT,STEP,START,BEGPOS,KNOWN:',5I5$)
RETURN
400 EXPL=POSIT
RETURN
END
logical function fatal ( dummy )
c
c Ask player if wants to reconsider
c
implicit integer(a-z)
logical fat
byte char
goto ( 100, 200, 300, 400, 500, 600 ) dummy
100 call topmsg ( 2, 'The troops cannot swim too well, Sir!
* Are you sure you want to GOTO sea? ' )
goto 700
200 call topmsg ( 2, 'SIR! Those are OUR men!
* Do you really want to attack them? ' )
goto 700
300 call topmsg ( 2, 'That''s NEVER worked before, Sir!
* Are sure you want to try? ' )
goto 700
400 call topmsg ( 2, 'Ships need SEA to float, Sir!
* Do you really want go on shore? ' )
goto 700
500 call topmsg ( 2, 'That''s OUR city, Sir!
* Do you really want to attack the garrison? ' )
goto 700
600 call topmsg ( 2, 'Sorry Sir, there is no room
* left on the transport. Do you insist? ' )
700 continue
call flush
char = getchx()
call topmsg ( 2, 0 ) ! clear the line
fat = .false.
if (( char .eq. 'Y') .or. ( char .eq. 'y' )) fat = .true.
fatal = fat
return
end
subroutine fght(z6,h1,h2,own1,own2)
IMPLICIT INTEGER(A-Z)
PARAMETER IAR=0,IFI=500,IDE=700,ISU=900,ITT=1100,
1 ICR=1200,ICA=1300,IBA=1400
PARAMETER IAR2=1500,IFI2=2000,IDE2=2200,ISU2=2400,ITT2=2600,
1 ICR2=2700,ICA2=2800,IBA2=2900
PARAMETER IDEH=0,ISUH=200,ITTH=400,ICRH=500,ICAH=600,IBAH=700
PARAMETER IDE2H=800,ISU2H=1000,ITT2H=1200,ICR2H=1300,
1 ICA2H=1400,IBA2H=1500
INTEGER G2(100)
INTEGER HITS(15),TIPE(15),CRAHIT(15),CRALOC(15)
INTEGER INDEX(15)
INTEGER CMYTBL(9),KBFUDG(9)
INTEGER LOPMAX(15),COMSCN(40)
INTEGER NSHPRF(4,6)
INTEGER PH(8),OVRPOP(16,2)
INTEGER PRIOR(7)
INTEGER RANGE(200),AR2S(500)
INTEGER ARMTOT(20),CODEFU(1500),CODELA(1500),TARGET(70),LIMIT(16)
INTEGER ARROW(9)
INTEGER D2(3)
INTEGER*2 D(667)
INTEGER MYCODE(1500)
INTEGER RANG(200)
INTEGER IOTAB(16)
INTEGER PHAZEE(8)
integer ptr
BYTE SPECAL,PASS
BYTE AB,AC,AD,AO,E,OWN1,OWN2,OWN !AVOID WORD REFERENCES TO THESE
BYTE KBTBL(9),AB9(9)
BYTE COMM(30),PHAZE(8)
BYTE IFILE(11),KILL
BYTE COMMAN(20),OKA(5),OKB(5),OKC(5)
BYTE TTY(20)
BYTE MOVEDFLAG(1500)
BYTE J1TS(1600)
BYTE EMAP(6000),RMAP(6000),PMAP(6000),OMAP(6000)
BYTE PAMELA(8),REEED(9)
byte jnkbuf ( 80 )
INTEGER RLMAP(3000)
LOGICAL AUTOMV
COMMON/AB9/AB9,PRIOR,NSHPRF
COMMON/ARMTOT/ARMTOT
COMMON/CHRT/COMMAN,COMM,COMSCN,KBTBL
COMMON/CHR2/IFILE,KILL,TTY
COMMON/CITY/FOUND(70),OWNER(70),PHASE(70)
COMMON/CMYTBL/CMYTBL,KBFUDG
COMMON/COD/CODER
COMMON/CODE/CODEFU,CODELA
COMMON/CRAHL/HITS,TIPE,CRAHIT,CRALOC
COMMON/FIPATH/FIPATH(70)
COMMON/G2/G2
COMMON/IARROW/IARROW(10),ARROW,INDEX,LOPMAX
COMMON/IOTAB/IOTAB
COMMON/J1TS/J1TS
COMMON/KXK/IADJST
COMMON/MAP/D
COMMON/MAPBLK/EMAP,RMAP,PMAP,RLMAP
COMMON/OMAP/OMAP
COMMON/MISC1/TARGET,AR2S,RANGE,RANG
COMMON/MISC2/LOCI(10,11),NUMBER(18),LIMIT,MDATE,VERSION
COMMON/MODE/MODE,JECTOR,ISEC,NEWRND
COMMON/MFLAGS/MOVEDFLAG
COMMON/MYCOD/D2,MYCODE
COMMON/OKS/OKA,OKB,OKC
COMMON/OVRPOP/OVRPOP
COMMON/P1/PHAZE,PHAZEE,PH
COMMON/DAYTIM/PAMELA,REEED
COMMON/PASS/PASS,SPECAL,AUTOMV
COMMON/SAVBUF/SAVBUF
COMMON/SPS/STEP,POSIT,START
COMMON/TEST2/SUCCES,FAILUR,FULL
COMMON/TROOP/TROOPT(6,5)
COMMON/X/X(70)
common /jnkbuf/ jnkbuf, ptr
C
C AGGR: THIS IS A MEASURE OF THE ENEMY SHIPS AGGRESSIVENESS,
C THIS VALUE IS ADDED TO THE COST-EFFECTIVENESS OF ATTACKING AN
C ENEMY UNIT TO DETERMINE IF THE SHIP WILL ATTACK OR RUN FROM THE
C ENEMY.
C ALL CITIES ARE REFERENCED BY CITY NUMBER, AS IN X(N)=LOC OF CITY #N
C CODFU/CODELA: CONTAINS A NUMBER THAT DETERMINES WHAT THAT COMPUTER CRAFT
C IS ASSIGNED TO DO, IS SEPERATED INTO 2 NUMBERS, IFO AND ILA. IFO
C GIVES THE FUNCTION, ILA GIVES DETAILS.
C CODER: USED FOR DEBUG FLAG
C CROWD: USED IF CITY IS SURROUNDED BY ARMIES
C D: ORIGINAL MAP, ENCODED IN MOD 3
C EXPLOR: THIS IS SET TO 1 IF THE ENEMY SHIP IS TO EXPLORE UNKNOWN
C TERRITORY ADJACENT TO IT, 0 IF NOT.
C FIPATH: STASIS # TO BE GIVEN TO FIGHTER IN THAT CITY
C FOUND: COMPLETION DATES FOR CITIES
C IADJST: SUBTRACTED FROM Z6 SO CURSOR WILL NOT BE MOVED OFF SCREEN
C IARROW: ADDED TO Z6 SO MOVES [1,2,3,4,5,6,7,8,9] ARE CONVERTED
C TO [+1,-99,-100,-101,ETC.]
C ISEC: SECTOR TERMINAL IS SHOWING
C IZAP: .TRUE.=SAVE GAME, .FALSE.=INITIALIZE
C JECTOR: SECTOR PROGRAM IS LOOKING AT
C KURSOR: SET TO POSITION OF CURSOR
C MODE: 1=IN MODE 2, 0=IN MODE 1
C OWNER: WHO OWNS THE CITY: 0>NOBODY, 1>PLAYER, 2>COMPUTER
C PASS: SET TO .TRUE. IF IT IS A PRIVILEGED USER
C PHASE: PHASE OF CITY
C X: LOCATIONS OF CITIES
C
if ((own2.lt.'A').or.(own2.gt.'T')) goto 100
cc if (mode.eq.1) call TPOS(2,1)
ptr = 0
call addidt ( own2, jnkbuf, ptr )
call addstr ( ' is under attack at ', jnkbuf, ptr )
call addint ( z6, jnkbuf, ptr )
jnkbuf ( ptr + 1 ) = 0
call topmsg ( 2, jnkbuf )
call flush
100 continue
s1=1
s2=1
if ((own1.eq.'S').or.(own1.eq.'s')) s1=3
if ((own2.eq.'S').or.(own2.eq.'s')) s2=3
ptr = 0
if (h2.eq.0) goto 300
200 if (irand(100).le.50) goto 300 !**
h1=h1-s2
h=h2
if (h1.gt.0) goto 200
own=own1
call addidt ( own, jnkbuf, ptr )
own=own2
call addstr ( ' destroyed, ', jnkbuf, ptr )
goto 400
300 h2=h2-s1
h=h1
if (h2.gt.0) goto 200
own=own2
call addidt ( own, jnkbuf, ptr )
own=own1
call addstr ( ' destroyed, ', jnkbuf, ptr )
400 continue
call addidt ( own, jnkbuf, ptr )
call addstr ( ' has ', jnkbuf, ptr )
call addint ( h, jnkbuf, ptr )
call addstr ( ' hit', jnkbuf, ptr )
if ( h .gt. 1 ) call addstr ( 's', jnkbuf, ptr )
call addstr ( ' left', jnkbuf, ptr )
jnkbuf ( ptr + 1 ) = 0
call topmsg ( 3, jnkbuf )
call flush
call delay(30)
return
end
subroutine fighmv
c
c This subroutine handles player's fighter moves
c
IMPLICIT INTEGER(A-Z)
PARAMETER IAR=0,IFI=500,IDE=700,ISU=900,ITT=1100,
1 ICR=1200,ICA=1300,IBA=1400
PARAMETER IAR2=1500,IFI2=2000,IDE2=2200,ISU2=2400,ITT2=2600,
1 ICR2=2700,ICA2=2800,IBA2=2900
PARAMETER IDEH=0,ISUH=200,ITTH=400,ICRH=500,ICAH=600,IBAH=700
PARAMETER IDE2H=800,ISU2H=1000,ITT2H=1200,ICR2H=1300,
1 ICA2H=1400,IBA2H=1500
INTEGER G2(100)
INTEGER HITS(15),TIPE(15),CRAHIT(15),CRALOC(15)
INTEGER INDEX(15)
INTEGER CMYTBL(9),KBFUDG(9)
INTEGER LOPMAX(15),COMSCN(40)
INTEGER NSHPRF(4,6)
INTEGER PH(8),OVRPOP(16,2)
INTEGER PRIOR(7)
INTEGER RANGE(200),AR2S(500)
INTEGER ARMTOT(20),CODEFU(1500),CODELA(1500),TARGET(70),LIMIT(16)
INTEGER ARROW(9)
INTEGER D2(3)
INTEGER*2 D(667)
INTEGER MYCODE(1500)
INTEGER RANG(200)
INTEGER IOTAB(16)
INTEGER PHAZEE(8)
integer ptr
BYTE SPECAL,PASS
BYTE AB,AC,AD,AO,E,OWN1,OWN2,OWN !AVOID WORD REFERENCES TO THESE
BYTE KBTBL(9),AB9(9)
BYTE COMM(30),PHAZE(8)
BYTE IFILE(11),KILL
BYTE COMMAN(20),OKA(5),OKB(5),OKC(5)
BYTE TTY(20)
BYTE MOVEDFLAG(1500)
BYTE J1TS(1600)
BYTE EMAP(6000),RMAP(6000),PMAP(6000),OMAP(6000)
BYTE PAMELA(8),REEED(9)
byte jnkbuf ( 80 )
INTEGER RLMAP(3000)
LOGICAL AUTOMV
COMMON/AB9/AB9,PRIOR,NSHPRF
COMMON/ARMTOT/ARMTOT
COMMON/CHRT/COMMAN,COMM,COMSCN,KBTBL
COMMON/CHR2/IFILE,KILL,TTY
COMMON/CITY/FOUND(70),OWNER(70),PHASE(70)
COMMON/CMYTBL/CMYTBL,KBFUDG
COMMON/COD/CODER
COMMON/CODE/CODEFU,CODELA
COMMON/CRAHL/HITS,TIPE,CRAHIT,CRALOC
COMMON/FIPATH/FIPATH(70)
COMMON/G2/G2
COMMON/IARROW/IARROW(10),ARROW,INDEX,LOPMAX
COMMON/IOTAB/IOTAB
COMMON/J1TS/J1TS
COMMON/KXK/IADJST
COMMON/MAP/D
COMMON/MAPBLK/EMAP,RMAP,PMAP,RLMAP
COMMON/OMAP/OMAP
COMMON/MISC1/TARGET,AR2S,RANGE,RANG
COMMON/MISC2/LOCI(10,11),NUMBER(18),LIMIT,MDATE,VERSION
COMMON/MODE/MODE,JECTOR,ISEC,NEWRND
COMMON/MFLAGS/MOVEDFLAG
COMMON/MYCOD/D2,MYCODE
COMMON/OKS/OKA,OKB,OKC
COMMON/OVRPOP/OVRPOP
COMMON/P1/PHAZE,PHAZEE,PH
COMMON/DAYTIM/PAMELA,REEED
COMMON/PASS/PASS,SPECAL,AUTOMV
COMMON/SAVBUF/SAVBUF
COMMON/SPS/STEP,POSIT,START
COMMON/TEST2/SUCCES,FAILUR,FULL
COMMON/TROOP/TROOPT(6,5)
COMMON/X/X(70)
common /jnkbuf/ jnkbuf, ptr
C
C AGGR: THIS IS A MEASURE OF THE ENEMY SHIPS AGGRESSIVENESS,
C THIS VALUE IS ADDED TO THE COST-EFFECTIVENESS OF ATTACKING AN
C ENEMY UNIT TO DETERMINE IF THE SHIP WILL ATTACK OR RUN FROM THE
C ENEMY.
C ALL CITIES ARE REFERENCED BY CITY NUMBER, AS IN X(N)=LOC OF CITY #N
C CODFU/CODELA: CONTAINS A NUMBER THAT DETERMINES WHAT THAT COMPUTER CRAFT
C IS ASSIGNED TO DO, IS SEPERATED INTO 2 NUMBERS, IFO AND ILA. IFO
C GIVES THE FUNCTION, ILA GIVES DETAILS.
C CODER: USED FOR DEBUG FLAG
C CROWD: USED IF CITY IS SURROUNDED BY ARMIES
C D: ORIGINAL MAP, ENCODED IN MOD 3
C EXPLOR: THIS IS SET TO 1 IF THE ENEMY SHIP IS TO EXPLORE UNKNOWN
C TERRITORY ADJACENT TO IT, 0 IF NOT.
C FIPATH: STASIS # TO BE GIVEN TO FIGHTER IN THAT CITY
C FOUND: COMPLETION DATES FOR CITIES
C IADJST: SUBTRACTED FROM Z6 SO CURSOR WILL NOT BE MOVED OFF SCREEN
C IARROW: ADDED TO Z6 SO MOVES [1,2,3,4,5,6,7,8,9] ARE CONVERTED
C TO [+1,-99,-100,-101,ETC.]
C ISEC: SECTOR TERMINAL IS SHOWING
C IZAP: .TRUE.=SAVE GAME, .FALSE.=INITIALIZE
C JECTOR: SECTOR PROGRAM IS LOOKING AT
C KURSOR: SET TO POSITION OF CURSOR
C MODE: 1=IN MODE 2, 0=IN MODE 1
C OWNER: WHO OWNS THE CITY: 0>NOBODY, 1>PLAYER, 2>COMPUTER
C PASS: SET TO .TRUE. IF IT IS A PRIVILEGED USER
C PHASE: PHASE OF CITY
C X: LOCATIONS OF CITIES
C
logical fatal
do 2100 y = 1, limit ( 2 )
loc = 500 + y
if (movedflag(loc).ne.0) goto 2100
z6=rlmap(loc)
if (z6.eq.0) goto 2100
if ((mode.eq.1).and.(poschk(z6,'F').eq.0)) goto 2100
movedflag(loc)=1
z3=min(range(y),4)
if (z3.eq.0) z3=4
do 1900 iturn=1,z3
loc=500+y
z6=rlmap(loc)
if (z6.eq.0) goto 2100
ab=rmap(z6)
c
c Now check to see if fighter is in a city, if it is change the
c stasis number of the fighter to that specified by fipath(i)
c
if ( ab .ne. 'O' ) goto 300 ! if fighter not in city
do 100 i = 1, 70
100 if ( x ( i ) .eq. z6 ) goto 200 ! find city at z6
200 mycode(loc)=fipath(i) ! change statis of fighter
c
c Check for fighters destroyed along with carrier or city
c
300 if ((ab.eq.'C').or.(ab.eq.'F').or.(ab.eq.'O')) goto 400
ptr = 0
call addstr ( 'Fighter # ', jnkbuf, ptr )
call addint ( y, jnkbuf, ptr )
call addstr ( ' destroyed', jnkbuf, ptr )
jnkbuf ( ptr + 1 ) = 0
call topmsg ( 3, jnkbuf )
call flush
call delay(30)
goto 1700
400 z7 = z6
call stasis ( z6, loc )
500 if ( range ( y ) .ne. 0 ) goto 600 ! check for fuel
call head ( 'F', y, loc, z6, 1 )
call topmsg ( 3, 'Ran out of fuel and crashed' )
call flush
call delay(30)
if (( ab .ne. 'C').and.(omap(z6).ne.'*')) rmap(z6)=omap(z6)
goto 1700
600 mycod=mycode(loc) ! get my function code
if (mycod.eq.0) goto 1100 ! none, skip ahead
if ((mycod.lt.101).or.(mycod.gt.6108)) goto 1300
if (mycod.le.6000) goto 700
if (mycod.gt.6100) goto 800
goto 1300
700 z6=z6+iarrow(mov(z6,mycod)+1) ! destination function
if ((range(y).eq.10).and.(idist(z6,mycod).le.10)) goto 902
goto 900
800 z6=z6+iarrow(mycod-6100+1) !directional functions
900 if (range(y).eq.10) goto 1000
902 if (order(z6).ne.0) goto 1000
ad=rmap(z6) !check new location
if ((ad.eq.'C').or.(ad.eq.'O')) goto 1300
if ((ad.eq.'+').or.(ad.eq.'.')) goto 1300
1000 z6=z7
1100 call sector(pmap(1))
call ltr(z6,iturn)
1200 call mve('F',mdate,y,loc,1,z6,z7,disas,z6-iadjst)
if (disas.eq.-2) goto 500
c
c Move evaluation
c
1300 ac=rmap(z6)
ao=omap(z6)
if (z6.eq.mycode(loc)) mycode(loc)=0 ! arrived at destination
if ((ac.ne.'O').and.(ac.ne.'C')) range(y)=range(y)-1
if (z7.eq.z6) goto 2000 !didnt go anywhere, end move
if ((ab.ne.'C').and.(omap(z7).ne.'*')) rmap(z7)=omap(z7)
! change prev loc
if (ao.eq.'*') goto 1400 ! check on cities
if (ac.eq.'C') goto 1500 ! landing on a carrier
if ((ac .ne. '.') .and. (ac .ne. '+')) goto 1800
! attack any other units
rmap ( z6 ) = 'F' ! normal move
rlmap ( loc ) = z6
goto 1900
1400 if (ac.ne.'O') goto 1600 ! is it my city?
1500 continue ! landed in a city or carrier
if (mycode(loc) .ne. 0) goto 1313
call topmsg ( 3, 'Landing confirmed' )
call flush
call delay(30)
1313 continue
mycode ( loc ) = 0 ! zero my function
rlmap(loc)=z6
range(y)=20
goto 2000
1600 if (.not.fatal(3)) goto 2200 ! ask about flying over enemy city
call topmsg ( 3, 'Fighter shot down' )
call flush
call delay(30)
1700 rlmap ( loc ) = 0
goto 2000
c
c Attacking a unit
c
1800 if ((ac .lt. 'A') .or. (ac .gt. 'T')) goto 1314
if (.not.fatal(2)) goto 2200
1314 continue
h1=1
own1='F'
own2=ac
h2=30
call find(own2,z6,z8,h2)
call fght(z6,h1,h2,own1,own2)
call find(own2,z6,z8,h2)
if (h1.le.0) goto 1700
rmap(z6)='F'
rlmap(loc)=z6
if ((own2.ge.'a').and.(own2.le.'t')) call sonar(z6)
1900 call sensor(z6) ! bottom of per turn loop
2000 call sensor(z6) ! bottom of per unit loop
2100 continue
return
c
c Recover from fatal move
c
2200 z6 = z7 ! go back to old location
rmap(z6) = ab ! restore map to previous
range(y) = range(y)+1 ! get your fuel back
goto 1200
end
SUBROUTINE FIGHTR
C
C THIS SUBROUTINE HANDLES ENEMY FIGHTER MOVES
C
IMPLICIT INTEGER(A-Z)
PARAMETER IAR=0,IFI=500,IDE=700,ISU=900,ITT=1100,
1 ICR=1200,ICA=1300,IBA=1400
PARAMETER IAR2=1500,IFI2=2000,IDE2=2200,ISU2=2400,ITT2=2600,
1 ICR2=2700,ICA2=2800,IBA2=2900
PARAMETER IDEH=0,ISUH=200,ITTH=400,ICRH=500,ICAH=600,IBAH=700
PARAMETER IDE2H=800,ISU2H=1000,ITT2H=1200,ICR2H=1300,
1 ICA2H=1400,IBA2H=1500
INTEGER G2(100)
INTEGER HITS(15),TIPE(15),CRAHIT(15),CRALOC(15)
INTEGER INDEX(15)
INTEGER CMYTBL(9),KBFUDG(9)
INTEGER LOPMAX(15),COMSCN(40)
INTEGER NSHPRF(4,6)
INTEGER PH(8),OVRPOP(16,2)
INTEGER PRIOR(7)
INTEGER RANGE(200),AR2S(500)
INTEGER ARMTOT(20),CODEFU(1500),CODELA(1500),TARGET(70),LIMIT(16)
INTEGER ARROW(9)
INTEGER D2(3)
INTEGER*2 D(667)
INTEGER MYCODE(1500)
INTEGER RANG(200)
INTEGER IOTAB(16)
INTEGER PHAZEE(8)
integer ptr
BYTE SPECAL,PASS
BYTE AB,AC,AD,AO,E,OWN1,OWN2,OWN !AVOID WORD REFERENCES TO THESE
BYTE KBTBL(9),AB9(9)
BYTE COMM(30),PHAZE(8)
BYTE IFILE(11),KILL
BYTE COMMAN(20),OKA(5),OKB(5),OKC(5)
BYTE TTY(20)
BYTE MOVEDFLAG(1500)
BYTE J1TS(1600)
BYTE EMAP(6000),RMAP(6000),PMAP(6000),OMAP(6000)
BYTE PAMELA(8),REEED(9)
byte jnkbuf ( 80 )
INTEGER RLMAP(3000)
LOGICAL AUTOMV
COMMON/AB9/AB9,PRIOR,NSHPRF
COMMON/ARMTOT/ARMTOT
COMMON/CHRT/COMMAN,COMM,COMSCN,KBTBL
COMMON/CHR2/IFILE,KILL,TTY
COMMON/CITY/FOUND(70),OWNER(70),PHASE(70)
COMMON/CMYTBL/CMYTBL,KBFUDG
COMMON/COD/CODER
COMMON/CODE/CODEFU,CODELA
COMMON/CRAHL/HITS,TIPE,CRAHIT,CRALOC
COMMON/FIPATH/FIPATH(70)
COMMON/G2/G2
COMMON/IARROW/IARROW(10),ARROW,INDEX,LOPMAX
COMMON/IOTAB/IOTAB
COMMON/J1TS/J1TS
COMMON/KXK/IADJST
COMMON/MAP/D
COMMON/MAPBLK/EMAP,RMAP,PMAP,RLMAP
COMMON/OMAP/OMAP
COMMON/MISC1/TARGET,AR2S,RANGE,RANG
COMMON/MISC2/LOCI(10,11),NUMBER(18),LIMIT,MDATE,VERSION
COMMON/MODE/MODE,JECTOR,ISEC,NEWRND
COMMON/MFLAGS/MOVEDFLAG
COMMON/MYCOD/D2,MYCODE
COMMON/OKS/OKA,OKB,OKC
COMMON/OVRPOP/OVRPOP
COMMON/P1/PHAZE,PHAZEE,PH
COMMON/DAYTIM/PAMELA,REEED
COMMON/PASS/PASS,SPECAL,AUTOMV
COMMON/SAVBUF/SAVBUF
COMMON/SPS/STEP,POSIT,START
COMMON/TEST2/SUCCES,FAILUR,FULL
COMMON/TROOP/TROOPT(6,5)
COMMON/X/X(70)
common /jnkbuf/ jnkbuf, ptr
C
C AGGR: THIS IS A MEASURE OF THE ENEMY SHIPS AGGRESSIVENESS,
C THIS VALUE IS ADDED TO THE COST-EFFECTIVENESS OF ATTACKING AN
C ENEMY UNIT TO DETERMINE IF THE SHIP WILL ATTACK OR RUN FROM THE
C ENEMY.
C ALL CITIES ARE REFERENCED BY CITY NUMBER, AS IN X(N)=LOC OF CITY #N
C CODFU/CODELA: CONTAINS A NUMBER THAT DETERMINES WHAT THAT COMPUTER CRAFT
C IS ASSIGNED TO DO, IS SEPERATED INTO 2 NUMBERS, IFO AND ILA. IFO
C GIVES THE FUNCTION, ILA GIVES DETAILS.
C CODER: USED FOR DEBUG FLAG
C CROWD: USED IF CITY IS SURROUNDED BY ARMIES
C D: ORIGINAL MAP, ENCODED IN MOD 3
C EXPLOR: THIS IS SET TO 1 IF THE ENEMY SHIP IS TO EXPLORE UNKNOWN
C TERRITORY ADJACENT TO IT, 0 IF NOT.
C FIPATH: STASIS # TO BE GIVEN TO FIGHTER IN THAT CITY
C FOUND: COMPLETION DATES FOR CITIES
C IADJST: SUBTRACTED FROM Z6 SO CURSOR WILL NOT BE MOVED OFF SCREEN
C IARROW: ADDED TO Z6 SO MOVES [1,2,3,4,5,6,7,8,9] ARE CONVERTED
C TO [+1,-99,-100,-101,ETC.]
C ISEC: SECTOR TERMINAL IS SHOWING
C IZAP: .TRUE.=SAVE GAME, .FALSE.=INITIALIZE
C JECTOR: SECTOR PROGRAM IS LOOKING AT
C KURSOR: SET TO POSITION OF CURSOR
C MODE: 1=IN MODE 2, 0=IN MODE 1
C OWNER: WHO OWNS THE CITY: 0>NOBODY, 1>PLAYER, 2>COMPUTER
C PASS: SET TO .TRUE. IF IT IS A PRIVILEGED USER
C PHASE: PHASE OF CITY
C X: LOCATIONS OF CITIES
C
C
C IFO=7: CITY LOCATION
C IFO=6: CARRIER NUMBER
C IFO=5: TARGET LOCATION
C IFO=4: TARGET LOCATION, KAMIKAZE MISSION
C IFO=3: DIRECTIONAL
C IFO=2: DIRECTIONAL, KAMIKAZE MISSION
C
MONKEY=0
NUMBER(2)=0
IF (CODER.EQ.2) TYPE 999
999 FORMAT(' FIGHTER CODES')
DO 3600 Y=1,LIMIT(10)
DO 3500 I1=1,4
Z6=RLMAP(2000+Y)
IF (Z6.EQ.0) GOTO 3600
C DIR=MOD(Y,2)*2-1 !UNUSED
MONKEY=Y
STOPF=1
P=0
Z7=Z6
AB=RMAP(Z6)
DO 100 IA=1,6
DO 100 IB=1,5
100 IF (TROOPT(IA,IB).EQ.Z6) TROOPT(IA,IB)=0
IF ((AB.NE.'f').AND.(AB.NE.'X').AND.(AB.NE.'c')) GOTO 3400
IF ((AB.EQ.'X').OR.(AB.EQ.'c')) RANG(Y)=20
IF (RANG(Y).NE.0) GOTO 200
RMAP(Z6)=OMAP(Z6)
GOTO 3400
C
C MOVE SELECTION
C
200 IF (CODELA(Y+IFI2-1500).EQ.Z6) GOTO 1100
IFO=CODEFU(Y+IFI2-1500)
ILA=CODELA(Y+IFI2-1500)
C
C DOES A NEW CODE NEED TO BE SELECTED? 1100:YES, 2600:NO
C
GOTO (1100,300,600,700,800,900,1000) IFO
GOTO 1100
C
300 IF (irand(100).LT.5) ILA=ICORR(ILA+1) !**
IF (RANG(Y).GT.10) GOTO 2600
DO 400 I=1,70
IF (X(I).EQ.0.OR.OWNER(I).NE.2) GOTO 400
IF (IDIST(Z6,X(I)).GT.RANG(Y)) GOTO 400
IFO=7
ILA=X(I)
GOTO 2600
400 CONTINUE
C
600 IF (irand(100).LT.10) ILA=ICORR(ILA+1) !**
IF (RANG(Y).LE.11) GOTO 1100
GOTO 2600
C
700 IF (ILA.EQ.Z6) GOTO 1100
GOTO 2600
C
800 IF ((ILA.EQ.Z6).OR.(RANG(Y).LE.11)) GOTO 1100
GOTO 2600
C
900 IF (Z6.EQ.RLMAP(ILA+2800)) GOTO 1100 !IF LANDED
IF (RLMAP(ILA+2800).EQ.0) GOTO 1100 !IF CARRIER DOESN'T EXIST
IF (IDIST(Z6,RLMAP(ILA+2800)).GT.RANG(Y)) GOTO 1100 !IF OUT OF RANG
GOTO 2600
C
1000 IF (Z6.EQ.ILA) GOTO 1100 !IF LANDED
IF (IDIST(Z6,ILA).GT.RANG(Y)) GOTO 1100 !IF OUT OF RANG
GOTO 2600
C
C NEW CODE SELECTION
C
1200 FUEL=RANG(Y) !NO CHOICE BUT BE KAMIKAZE
GOTO 1400 !START LOOKING FOR ENEMY TROOP TRANS.
1100 IF (AB.EQ.'f') GOTO 2100 !IF FIGHTER IS AIRBORNE
ID=0
1300 FUEL=RANG(Y)/2 !DO THIS SO CRAFT CAN RETURN TO REFUEL
IF (irand(100).LT.5) FUEL=RANG(Y) !** 1 IN 20 IS KAMIKAZE
1400 ISHIPT=3 !ENEMY TROOP TRANSPORTS
C
C LOOK FOR ENEMY TROOP TRANSPORTS, THEN SUBMARINES
C
1500 DO 1600 I=1,5
IF (TROOPT(ISHIPT,I).EQ.0) GOTO 1600
IF (IDIST(Z6,TROOPT(ISHIPT,I)).GT.FUEL) GOTO 1600 !OUT OF RANG
IFO=5
IF (FUEL.EQ.RANG(Y)) IFO=4
ILA=TROOPT(ISHIPT,I)
GOTO 2600 !PROCEED TO MOVE CORRECTION
1600 CONTINUE
IF (ISHIPT.EQ.2) GOTO 1700 !IF ALREADY LOOKED FOR SUBS
ISHIPT=2
GOTO 1500 !NOW LOOK FOR SUBS
1700 IF (ID.EQ.1000) GOTO 1900 !IF NO REFUELING SPOT WITHIN RANG
IF (irand(100).LT.33) GOTO 1900 !** LOOK FOR ENEMY CONCENTRATIONS
IF (irand(100).LT.50) GOTO 2100 !** MOVE TOWARDS CITY OR CARRIER
C
C MOVE IN A RANDOM DIRECTION
C
1800 IFO=3
ILA=irand(8)+1
IF (irand(100).LT.5) IFO=2 !** ONE OUT OF 20 WILL BE KAMIKAZE
IF (NUMBER(2).LE.2) IFO=3
GOTO 2600 !PROCEED TO MOVE CORRECTION
C
C MOVE TOWARD AN ENEMY CONCENTRATION WITHIN RANG
C
1900 DO 2000 I=1,10
DO 2000 J=2,11
IF (LOCI(I,J).EQ.0) GOTO 2000
IF (IDIST(Z6,LOCI(I,J)).GT.FUEL) GOTO 2000 !IF OUT OF RANG
IFO=5
IF (FUEL.EQ.RANG(Y)) IFO=4 !KAMIKAZE
ILA=LOCI(I,J)
GOTO 2600 !PROCEED TO MOVE CORRECTION
2000 CONTINUE
IF (ID.EQ.1000) GOTO 1800 !IF NO CITY OR CARRIER IS WITHIN RANG
C
C NOW MOVE TOWARDS A CITY CLOSEST TO ENEMY CONCENTRATION
C
2100 IA=MOD(Y,10)+1
DO 2200 IB=IA,IA+9
I=IB
IF (I.GT.10) I=I-10
IF (LOCI(I,2).EQ.0) GOTO 2200
LOC=LOCI(I,2)
ID=IDIST(Z6,LOCI(I,2))
GOTO 2300
2200 CONTINUE
LOC=EXPL()
2300 ID=1000
IGARBG=irand(70+LIMIT(15))+1 !**
DO 2500 ILOOP=IGARBG,IGARBG+70+LIMIT(15)
IA=ILOOP
IF (IA.GT.70+LIMIT(15)) IA=IA-70-LIMIT(15)
IF (IA.GT.70) GOTO 2400
IF (OWNER(IA).NE.2) GOTO 2500
IF (IDIST(Z6,X(IA)).GT.RANG(Y)) GOTO 2500
IF (IDIST(X(IA),LOC).GE.ID) GOTO 2500
IFO=7
ILA=X(IA)
ID=IDIST(X(IA),LOC)
GOTO 2500
2400 IB=IA-70
IF (RLMAP(2800+IB).EQ.0) GOTO 2500
IF (IDIST(Z6,RLMAP(2800+IB)).GT.RANG(Y)) GOTO 2500
IF (IDIST(RLMAP(2800+IB),LOC).GE.ID) GOTO 2500
IF ((RANG(Y).EQ.20).AND.(IDIST(Z6,RLMAP(2800+IB)).GT.12)
1 .AND.(CODEFU(1300+IB).NE.9)) GOTO 2500
IFO=6
ILA=IB
ID=IDIST(RLMAP(2800+IB),LOC)
2500 CONTINUE
IF (ID.EQ.1000) GOTO 1200
GOTO 2600
C
C MOVE CORRECTION
C
2600 IZOT=0
MOOV=0
IF (ILA.GT.100) IZOT=MOV(Z6,ILA)
IF (ILA.LT.10) IZOT=ILA
IF (IFO.EQ.6) IZOT=MOV(Z6,RLMAP(2800+ILA))
IF ((IFO.LT.4).AND.(irand(100).LT.5)) IZOT=ICORR(IZOT+1) !**
DO 2700 I=1,8
AC=RMAP(Z6+IARROW(I+1)) !**
IF ((AC.NE.'D').AND.(AC.NE.'S').AND.(AC.NE.'T')
1 .AND.(AC.NE.'F').AND.(AC.NE.'A')) GOTO 2700
MOOV=I
GOTO 3100
2700 CONTINUE
C
C LOOK FOR TERRITORY TO EXPLOR IN FRONT
C
IF (RANG(Y).LE.10) GOTO 2900 !IF LOW ON FUEL
IZOT2=IZOT !STORE IZOT A MOMENT
Z62=Z6+IARROW(ICORR(IZOT2+1)+1) !**
IF (ORDER(Z62).NE.0) GOTO 2800 !IF ON THE EDGE OF THE MAP
IF (EMAP(Z62).EQ.' ') IZOT=ICORR(IZOT2+1) !IF Z62 IS UNEXPLORED
2800 Z62=Z6+IARROW(ICORR(IZOT2-1)+1) !**TRY OTHER SIDE
IF (ORDER(Z62).NE.0) GOTO 2900 !IF ON THE EDGE OF THE MAP
IF (EMAP(Z62).EQ.' ') IZOT=ICORR(IZOT2-1) !IF Z62 IS UNEXPLORED
C
2900 DESTIN=ILA
IF (IFO.EQ.6) DESTIN=RLMAP(2800+ILA)
ID=IZOT
DO 3000 I=0,7
IZOT=ICORR(ID+I)
NEWLOC=Z6+IARROW(IZOT+1) !**
IF (IFO.GT.3) THEN
IF (IDIST(Z6,DESTIN).LE.IDIST(NEWLOC,DESTIN)) GOTO 3000
ENDIF
AC=RMAP(NEWLOC)
IF ((((AC.GE.'A').AND.(AC.LE.'T')).OR.
1 (AC.EQ.'X').OR.(AC.EQ.'.').OR.
1 (AC.EQ.'c').OR.(AC.EQ.'+')).AND.(ORDER(NEWLOC).EQ.0))
1 GOTO 3100
3000 CONTINUE
IZOT=0
3100 CODEFU(IFI2-1500+Y)=IFO
CODELA(IFI2-1500+Y)=ILA
IF (IFO.LT.4) CODELA(IFI2-1500+Y)=IZOT
IF (CODER.EQ.2) TYPE 998,IFO,CODELA(IFI2-1500+Y)
998 FORMAT(I)
IF (MOOV.NE.0) IZOT=MOOV
Z6=Z6+IARROW(IZOT+1) !**
C
C MOVE EVALUATION
C
IF (AB.EQ.'f') RMAP(Z7)=OMAP(Z7)
AB=RMAP(Z6)
IF ((AB.EQ.'.').OR.(AB.EQ.'+')) GOTO 3200
IF ((AB.EQ.'X').OR.(AB.EQ.'c')) GOTO 3300
IF (OMAP(Z6).EQ.'*') GOTO 3400
H2=30
P=1
H1=1
OWN1='f'
OWN2=AB
CALL FIND(OWN2,Z6,Z8,H2)
CALL FGHT(Z6,H1,H2,OWN1,OWN2)
CALL FIND(OWN2,Z6,Z8,H2)
IF (H1.LE.0) GOTO 3400
3200 RMAP(Z6)='f'
STOPF=0
3300 RANG(Y)=RANG(Y)-1
IF (I1.EQ.1) NUMBER(2)=NUMBER(2)+1
RLMAP(2000+Y)=Z6
CALL SONAR(Z6)
IF (P.EQ.1) CALL SENSOR(Z6)
IF (STOPF.EQ.1) GOTO 3600
3500 CONTINUE
GOTO 3600
3400 RLMAP(2000+Y)=0
CALL SONAR(Z6)
IF (P.EQ.1) CALL SENSOR(Z6)
3600 CONTINUE
RETURN
END
subroutine find(own, z6, z8, h2)
c
c Cross-reference subroutine, it finds data on whatever
c craft is at point z6.
c
IMPLICIT INTEGER(A-Z)
PARAMETER IAR=0,IFI=500,IDE=700,ISU=900,ITT=1100,
1 ICR=1200,ICA=1300,IBA=1400
PARAMETER IAR2=1500,IFI2=2000,IDE2=2200,ISU2=2400,ITT2=2600,
1 ICR2=2700,ICA2=2800,IBA2=2900
PARAMETER IDEH=0,ISUH=200,ITTH=400,ICRH=500,ICAH=600,IBAH=700
PARAMETER IDE2H=800,ISU2H=1000,ITT2H=1200,ICR2H=1300,
1 ICA2H=1400,IBA2H=1500
INTEGER G2(100)
INTEGER HITS(15),TIPE(15),CRAHIT(15),CRALOC(15)
INTEGER INDEX(15)
INTEGER CMYTBL(9),KBFUDG(9)
INTEGER LOPMAX(15),COMSCN(40)
INTEGER NSHPRF(4,6)
INTEGER PH(8),OVRPOP(16,2)
INTEGER PRIOR(7)
INTEGER RANGE(200),AR2S(500)
INTEGER ARMTOT(20),CODEFU(1500),CODELA(1500),TARGET(70),LIMIT(16)
INTEGER ARROW(9)
INTEGER D2(3)
INTEGER*2 D(667)
INTEGER MYCODE(1500)
INTEGER RANG(200)
INTEGER IOTAB(16)
INTEGER PHAZEE(8)
integer ptr
BYTE SPECAL,PASS
BYTE AB,AC,AD,AO,E,OWN1,OWN2,OWN !AVOID WORD REFERENCES TO THESE
BYTE KBTBL(9),AB9(9)
BYTE COMM(30),PHAZE(8)
BYTE IFILE(11),KILL
BYTE COMMAN(20),OKA(5),OKB(5),OKC(5)
BYTE TTY(20)
BYTE MOVEDFLAG(1500)
BYTE J1TS(1600)
BYTE EMAP(6000),RMAP(6000),PMAP(6000),OMAP(6000)
BYTE PAMELA(8),REEED(9)
byte jnkbuf ( 80 )
INTEGER RLMAP(3000)
LOGICAL AUTOMV
COMMON/AB9/AB9,PRIOR,NSHPRF
COMMON/ARMTOT/ARMTOT
COMMON/CHRT/COMMAN,COMM,COMSCN,KBTBL
COMMON/CHR2/IFILE,KILL,TTY
COMMON/CITY/FOUND(70),OWNER(70),PHASE(70)
COMMON/CMYTBL/CMYTBL,KBFUDG
COMMON/COD/CODER
COMMON/CODE/CODEFU,CODELA
COMMON/CRAHL/HITS,TIPE,CRAHIT,CRALOC
COMMON/FIPATH/FIPATH(70)
COMMON/G2/G2
COMMON/IARROW/IARROW(10),ARROW,INDEX,LOPMAX
COMMON/IOTAB/IOTAB
COMMON/J1TS/J1TS
COMMON/KXK/IADJST
COMMON/MAP/D
COMMON/MAPBLK/EMAP,RMAP,PMAP,RLMAP
COMMON/OMAP/OMAP
COMMON/MISC1/TARGET,AR2S,RANGE,RANG
COMMON/MISC2/LOCI(10,11),NUMBER(18),LIMIT,MDATE,VERSION
COMMON/MODE/MODE,JECTOR,ISEC,NEWRND
COMMON/MFLAGS/MOVEDFLAG
COMMON/MYCOD/D2,MYCODE
COMMON/OKS/OKA,OKB,OKC
COMMON/OVRPOP/OVRPOP
COMMON/P1/PHAZE,PHAZEE,PH
COMMON/DAYTIM/PAMELA,REEED
COMMON/PASS/PASS,SPECAL,AUTOMV
COMMON/SAVBUF/SAVBUF
COMMON/SPS/STEP,POSIT,START
COMMON/TEST2/SUCCES,FAILUR,FULL
COMMON/TROOP/TROOPT(6,5)
COMMON/X/X(70)
common /jnkbuf/ jnkbuf, ptr
C
C AGGR: THIS IS A MEASURE OF THE ENEMY SHIPS AGGRESSIVENESS,
C THIS VALUE IS ADDED TO THE COST-EFFECTIVENESS OF ATTACKING AN
C ENEMY UNIT TO DETERMINE IF THE SHIP WILL ATTACK OR RUN FROM THE
C ENEMY.
C ALL CITIES ARE REFERENCED BY CITY NUMBER, AS IN X(N)=LOC OF CITY #N
C CODFU/CODELA: CONTAINS A NUMBER THAT DETERMINES WHAT THAT COMPUTER CRAFT
C IS ASSIGNED TO DO, IS SEPERATED INTO 2 NUMBERS, IFO AND ILA. IFO
C GIVES THE FUNCTION, ILA GIVES DETAILS.
C CODER: USED FOR DEBUG FLAG
C CROWD: USED IF CITY IS SURROUNDED BY ARMIES
C D: ORIGINAL MAP, ENCODED IN MOD 3
C EXPLOR: THIS IS SET TO 1 IF THE ENEMY SHIP IS TO EXPLORE UNKNOWN
C TERRITORY ADJACENT TO IT, 0 IF NOT.
C FIPATH: STASIS # TO BE GIVEN TO FIGHTER IN THAT CITY
C FOUND: COMPLETION DATES FOR CITIES
C IADJST: SUBTRACTED FROM Z6 SO CURSOR WILL NOT BE MOVED OFF SCREEN
C IARROW: ADDED TO Z6 SO MOVES [1,2,3,4,5,6,7,8,9] ARE CONVERTED
C TO [+1,-99,-100,-101,ETC.]
C ISEC: SECTOR TERMINAL IS SHOWING
C IZAP: .TRUE.=SAVE GAME, .FALSE.=INITIALIZE
C JECTOR: SECTOR PROGRAM IS LOOKING AT
C KURSOR: SET TO POSITION OF CURSOR
C MODE: 1=IN MODE 2, 0=IN MODE 1
C OWNER: WHO OWNS THE CITY: 0>NOBODY, 1>PLAYER, 2>COMPUTER
C PASS: SET TO .TRUE. IF IT IS A PRIVILEGED USER
C PHASE: PHASE OF CITY
C X: LOCATIONS OF CITIES
C
if (h2 .gt. 0) goto 1100
c
c Now we must destroy own
c first of all, update troopt
c
ishp = 0
if (own .eq. 'D') ishp = 1
if (own .eq. 'S') ishp = 2
if (own .eq. 'T') ishp = 3
if (own .eq. 'R') ishp = 4
if (own .eq. 'C') ishp = 5
if (own .eq. 'B') ishp = 6
if (ishp .eq. 0) goto 200
do 100 z = 1, 5
100 if (troopt(ishp, z) .eq. z6) troopt(ishp, z) = 0
c
c Now destroy the craft, set rlmap(n)=0
c
200 if (own .ne. 'C') goto 400
do 300 z = 1, 200
if (rlmap(500 + z) .ne. z6) goto 300
rlmap(500 + z) = 0
if (mode .eq. 1) call tpos(2, 60)
type 999, z
999 format('+Fighter #'I3' sunk'$)
300 continue
400 if (own .ne. 'T') goto 600
do 500 z = 1, 500
if (rlmap(z) .ne. z6) goto 500
rlmap(z) = 0
if (mode .eq. 1) call tpos(2, 60)
type 998, z
998 format('+Army #'I3' sunk'$)
500 continue
600 if (own .ne. 't') goto 800
do 700 z = 1501, 2000
700 if (rlmap(z) .eq. z6) rlmap(z) = 0
800 if (own .ne. 'c') goto 1000
do 900 z = 2001, 2200
900 if (rlmap(z) .eq. z6) rlmap(z) = 0
1000 rlmap(z8) = 0
if ((own .ge. 'a') .and. (own .le. 't')) call sonar(z6)
if ((own .ge. 'A') .and. (own .le. 'T')) call sensor(z6)
return
1100 if (h2 .eq. 30) goto 1200
if ((own .eq. 'A') .or. (own .eq. 'F') .or. (own .eq. 'a') .or.
$ (own .eq. 'f')) return
if ((own .ge. 'A') .and. (own .le. 'T')) j1ts(z8 - 700) = h2
if ((own .ge. 'a') .and. (own .le. 't')) j1ts(z8 - 1400) = h2
return
1200 h2 = 0
ia = 1
if (own .eq. 'T') ia = 1101
if (own .eq. 'O') ia = 1101 ! special hack for docking
if (own .eq. 'C') ia = 1301
if (own .eq. 'a') ia = 1501
if (own .eq. 'f') ia = 2001
if (own .eq. 't') ia = 2601
if (own .eq. 'c') ia = 2801
do 1300 z8 = ia, 3000
if (rlmap(z8) .eq. z6) goto 1400
1300 continue
pause ' Error in subroutine find, "CONTINUE" to continue'
997 format(' ERROR IN SUB. FIND')
return
1400 if ((own .eq. 'A') .or. (own .eq. 'F') .or. (own .eq. 'a') .or.
$ (own .eq. 'f')) h2 = 1
if (h2 .eq. 1) return
if ((own .ge. 'A') .and. (own .le. 'T')) h2 = j1ts(z8 - 700)
if ((own .ge. 'a') .and. (own .le. 't')) h2 = j1ts(z8 - 1400)
return
end
subroutine game ( icode, num )
c
c This subroutine reads in the game map and initializes the
c map arrays it also saves and restores the game from the
c save file using the codes: -1 = restore, 0 = init, 1 = save
c
IMPLICIT INTEGER(A-Z)
PARAMETER IAR=0,IFI=500,IDE=700,ISU=900,ITT=1100,
1 ICR=1200,ICA=1300,IBA=1400
PARAMETER IAR2=1500,IFI2=2000,IDE2=2200,ISU2=2400,ITT2=2600,
1 ICR2=2700,ICA2=2800,IBA2=2900
PARAMETER IDEH=0,ISUH=200,ITTH=400,ICRH=500,ICAH=600,IBAH=700
PARAMETER IDE2H=800,ISU2H=1000,ITT2H=1200,ICR2H=1300,
1 ICA2H=1400,IBA2H=1500
INTEGER G2(100)
INTEGER HITS(15),TIPE(15),CRAHIT(15),CRALOC(15)
INTEGER INDEX(15)
INTEGER CMYTBL(9),KBFUDG(9)
INTEGER LOPMAX(15),COMSCN(40)
INTEGER NSHPRF(4,6)
INTEGER PH(8),OVRPOP(16,2)
INTEGER PRIOR(7)
INTEGER RANGE(200),AR2S(500)
INTEGER ARMTOT(20),CODEFU(1500),CODELA(1500),TARGET(70),LIMIT(16)
INTEGER ARROW(9)
INTEGER D2(3)
INTEGER*2 D(667)
INTEGER MYCODE(1500)
INTEGER RANG(200)
INTEGER IOTAB(16)
INTEGER PHAZEE(8)
integer ptr
BYTE SPECAL,PASS
BYTE AB,AC,AD,AO,E,OWN1,OWN2,OWN !AVOID WORD REFERENCES TO THESE
BYTE KBTBL(9),AB9(9)
BYTE COMM(30),PHAZE(8)
BYTE IFILE(11),KILL
BYTE COMMAN(20),OKA(5),OKB(5),OKC(5)
BYTE TTY(20)
BYTE MOVEDFLAG(1500)
BYTE J1TS(1600)
BYTE EMAP(6000),RMAP(6000),PMAP(6000),OMAP(6000)
BYTE PAMELA(8),REEED(9)
byte jnkbuf ( 80 )
INTEGER RLMAP(3000)
LOGICAL AUTOMV
COMMON/AB9/AB9,PRIOR,NSHPRF
COMMON/ARMTOT/ARMTOT
COMMON/CHRT/COMMAN,COMM,COMSCN,KBTBL
COMMON/CHR2/IFILE,KILL,TTY
COMMON/CITY/FOUND(70),OWNER(70),PHASE(70)
COMMON/CMYTBL/CMYTBL,KBFUDG
COMMON/COD/CODER
COMMON/CODE/CODEFU,CODELA
COMMON/CRAHL/HITS,TIPE,CRAHIT,CRALOC
COMMON/FIPATH/FIPATH(70)
COMMON/G2/G2
COMMON/IARROW/IARROW(10),ARROW,INDEX,LOPMAX
COMMON/IOTAB/IOTAB
COMMON/J1TS/J1TS
COMMON/KXK/IADJST
COMMON/MAP/D
COMMON/MAPBLK/EMAP,RMAP,PMAP,RLMAP
COMMON/OMAP/OMAP
COMMON/MISC1/TARGET,AR2S,RANGE,RANG
COMMON/MISC2/LOCI(10,11),NUMBER(18),LIMIT,MDATE,VERSION
COMMON/MODE/MODE,JECTOR,ISEC,NEWRND
COMMON/MFLAGS/MOVEDFLAG
COMMON/MYCOD/D2,MYCODE
COMMON/OKS/OKA,OKB,OKC
COMMON/OVRPOP/OVRPOP
COMMON/P1/PHAZE,PHAZEE,PH
COMMON/DAYTIM/PAMELA,REEED
COMMON/PASS/PASS,SPECAL,AUTOMV
COMMON/SAVBUF/SAVBUF
COMMON/SPS/STEP,POSIT,START
COMMON/TEST2/SUCCES,FAILUR,FULL
COMMON/TROOP/TROOPT(6,5)
COMMON/X/X(70)
common /jnkbuf/ jnkbuf, ptr
C
C AGGR: THIS IS A MEASURE OF THE ENEMY SHIPS AGGRESSIVENESS,
C THIS VALUE IS ADDED TO THE COST-EFFECTIVENESS OF ATTACKING AN
C ENEMY UNIT TO DETERMINE IF THE SHIP WILL ATTACK OR RUN FROM THE
C ENEMY.
C ALL CITIES ARE REFERENCED BY CITY NUMBER, AS IN X(N)=LOC OF CITY #N
C CODFU/CODELA: CONTAINS A NUMBER THAT DETERMINES WHAT THAT COMPUTER CRAFT
C IS ASSIGNED TO DO, IS SEPERATED INTO 2 NUMBERS, IFO AND ILA. IFO
C GIVES THE FUNCTION, ILA GIVES DETAILS.
C CODER: USED FOR DEBUG FLAG
C CROWD: USED IF CITY IS SURROUNDED BY ARMIES
C D: ORIGINAL MAP, ENCODED IN MOD 3
C EXPLOR: THIS IS SET TO 1 IF THE ENEMY SHIP IS TO EXPLORE UNKNOWN
C TERRITORY ADJACENT TO IT, 0 IF NOT.
C FIPATH: STASIS # TO BE GIVEN TO FIGHTER IN THAT CITY
C FOUND: COMPLETION DATES FOR CITIES
C IADJST: SUBTRACTED FROM Z6 SO CURSOR WILL NOT BE MOVED OFF SCREEN
C IARROW: ADDED TO Z6 SO MOVES [1,2,3,4,5,6,7,8,9] ARE CONVERTED
C TO [+1,-99,-100,-101,ETC.]
C ISEC: SECTOR TERMINAL IS SHOWING
C IZAP: .TRUE.=SAVE GAME, .FALSE.=INITIALIZE
C JECTOR: SECTOR PROGRAM IS LOOKING AT
C KURSOR: SET TO POSITION OF CURSOR
C MODE: 1=IN MODE 2, 0=IN MODE 1
C OWNER: WHO OWNS THE CITY: 0>NOBODY, 1>PLAYER, 2>COMPUTER
C PASS: SET TO .TRUE. IF IT IS A PRIVILEGED USER
C PHASE: PHASE OF CITY
C X: LOCATIONS OF CITIES
C
common / cities / cities ( 128 )
data ifile /'G','A','M','E','S',':','E','M','R','A',0/
if ( icode ) 1800, 100, 1500 ! -1/0/+1 = restore/init/save
c
c Here to initialize the game
c
100 do 200 i = 1, 70 ! clear arrays
x ( i ) = 0
found ( i ) = 0
owner ( i ) = 0
phase ( i ) = 0
target ( i ) = 0
fipath ( i ) = 0
200 continue
do 300 i=1,1500
codefu ( i ) = 0
codela ( i ) = 0
mycode ( i ) = 0
300 continue
do 400 i = 1, 200
range ( i ) = 0
rang ( i ) = 0
400 continue
do 500 i = 1, 500
500 ar2s ( i ) = 0
do 600 i = 1, 3000
rlmap ( i ) = 0
600 continue
do 700 i = 1, 6000
emap ( i ) = ' '
pmap ( i ) = ' '
700 continue
mode = 1
isec = -1
call time ( pamela )
call date ( reeed )
reeed ( 5 ) = reeed ( 5 ) + "40 ! make lower case
reeed ( 6 ) = reeed ( 6 ) + "40
version = 6 ! version of data within emsave.dat
ib=1
c
c Map selection. Pick one of the maps randomly. Maps are in files a-f
c
try = 0 ! try again
900 try = try + 1
ifile ( 10 ) = 'a'
ifile ( 10 ) = ifile ( 10 ) + irand ( 10 )
! currently six maps, allow 4 extra
if ( try .le. 8 ) goto 1000 ! try again if you don't have them all
call cr
call strout ( 'Generating new map...')
call flush
call gen
try = 0
goto 1100
1000 open ( unit=1, name=ifile, access = 'SEQUENTIAL',
* form = 'UNFORMATTED', type = 'OLD', readonly, err=900 )
read ( 1 ) ( d ( I ), i = 1, 223 )
read ( 1 ) ( d ( I ), i = 224, 446 )
read ( 1 ) ( d ( I ), i = 447, 667 )
close ( unit = 1 )
c
c City and a-map initialization
c
1100 call initia ( try ) ! transfer map from d() into mapbuf
1200 c = irand ( 70 ) + 1 ! ** pick our city
id = irand ( 70 ) + 1 ! pick enemy city
if (x(c) .eq. 0 .or. x(id) .eq. 0) goto 1200
if (x(c) .eq. x(id)) goto 1200
if ((edger(x(c)) .eq. 8) .or. (edger(x(id)) .eq. 8)) goto 1200
if ( try .ne. 0 ) goto 1300
1250 pcon = cities(rmap(x(id)))
econ = cities(rmap(x(c)))
if (pcon.le.100) goto 1200 ! note rmap is really owner
if (econ.le.100) goto 1200 ! from map generator
ptot=pcon/100+mod(pcon,100)
etot=econ/100+mod(econ,100)
if (ptot.le.etot) goto 1275
i = c
c = id
id = i
goto 1250
1275 diff=min(11,((etot*2*100+45)/ptot)/100)-1
if ( pcon .eq. econ ) diff = 3
call cr
ptr = 0
call addstr ( 'Difficulty estimate: ', jnkbuf, ptr )
call addint ( diff, jnkbuf, ptr )
call addstr ( ' where 1 is easy and 10 is most challenging.',
* jnkbuf, ptr )
jnkbuf ( ptr + 1 ) = 0
call cr
call strout ( jnkbuf )
1300 z6 = x ( id )
ptr = 0
call addstr ( 'Your city is at ', jnkbuf, ptr )
call addint ( x ( id ), jnkbuf, ptr )
jnkbuf ( ptr + 1 ) = 0
call cr
call cr
call strout ( jnkbuf )
call cr
do 1400 i=1,6000
1400 rmap ( i ) = omap ( i )
rmap(z6) = 'O' ! mark it on map
rmap(x(c)) = 'X'
call sonar(x(c)) ! do sensor scans
call sensor(z6)
mode = 0
call ltr ( z6, 0 ) ! show the city
mode=1
call strout ( 'What do you demand that this city produce? ' )
call flush
owner(id)=1
mdate = 0
call phasin(id,e)
call putc ( e )
call flush
owner ( c ) = 2
phase ( c ) = 1
found ( c ) = 5
z6 = x ( id )
return ! return to orders mode
c
c Here to save a game
c
1500 if (mode .ne. 0) goto 1600
call cr
call strout ( 'A few moments please...' )
call cr
call flush
1600 continue
call time ( pamela )
call date ( reeed )
reeed ( 5 ) = reeed ( 5 ) + "40 ! make lower case
reeed ( 6 ) = reeed ( 6 ) + "40
open ( unit=1, name='EMSAVE', access='SEQUENTIAL',
* form='UNFORMATTED', status='UNKNOWN' )
write ( 1 ) limit, mdate, version, pamela, reeed
write ( 1 ) emap, rmap, pmap, omap
write ( 1 ) rlmap
write ( 1 ) troopt
write ( 1 ) number
write ( 1 ) x, target, found
write ( 1 ) owner, phase
do 1700 i = 1, 16
1700 call write ( iotab ( I ), limit ( I ), i )
write ( 1 ) j1ts
write ( 1 ) num
write ( 1 ) loci
write ( 1 ) nshift, fipath
close ( unit=1 )
return
c
c Here to restore a game
c
1800 continue
call cr
call strout ( 'A few moments please...' )
call flush
open ( unit=1, name='EMSAVE', access='SEQUENTIAL',
* form='UNFORMATTED', status='OLD',err=2200)
read(1) limit,mdate,version,pamela,reeed
read(1) emap,rmap,pmap,omap
if(version.ge.6) goto 1850
version=6 ! translate to new version
do 1850 i=1,6000
if((emap ( I ).ge.'1').and.(emap ( I ).le.'8')) call tran(emap ( I ))
if((rmap ( I ).ge.'1').and.(rmap ( I ).le.'8')) call tran(rmap ( I ))
if((pmap ( I ).ge.'1').and.(pmap ( I ).le.'8')) call tran(pmap ( I ))
1850 continue
read(1) rlmap
read(1) troopt
read(1) number
read(1) x,target,found
read(1) owner,phase
do 1900 i=1,16
1900 call read ( iotab ( i ), limit ( i ), i )
if (version.le.4) read(1) (j1ts ( I ),i=1,1500)
if (version.ge.5) read(1) j1ts
read(1) num
read(1) loci
read(1) nshift,fipath
2000 close(unit=1)
ptr = 59
encode ( ptr, 996, jnkbuf ) pamela, reeed
996 FORMAT('Ready to resume game terminated at ', 8A1,
* ' on ', 7a1, '19', 2a1 )
call cr
call bufout ( jnkbuf, ptr )
mode=1
isec=-1
return
2200 continue
call cr
call strout ( 'Unable to open save file, EMSAVE.DAT,
* Starting new game.' )
call flush
goto 100
end
C
C RANDOM MAP GENERATION SUBROUTINES
C
SUBROUTINE GEN
IMPLICIT INTEGER(A-Z)
PARAMETER WIDTH=100,HEIGHT=60
BYTE MAP(WIDTH,HEIGHT)
BYTE SUBMAP(39,39)
BYTE OWNER(WIDTH,HEIGHT)
INTEGER SIZES(128)
COMMON/CITIES/CITIES(128)
COMMON/SMAP/SUBMAP
BYTE EMAP(6000),RMAP(6000),PMAP(6000),OMAP(6000)
INTEGER RLMAP(3000)
COMMON/MAPBLK/EMAP,RMAP,PMAP,RLMAP
COMMON/OMAP/OMAP
EQUIVALENCE (MAP(1,1),OMAP(1)),(OWNER(1,1),RMAP(1))
100 DO 200 I=1,WIDTH
DO 200 J=1,HEIGHT
200 MAP(I,J)='.'
HSECTS=3+irand(4)
VSECTS=3+irand(3)
HSPACE=WIDTH/HSECTS
VSPACE=HEIGHT/VSECTS
DO 400 I=1,HSECTS
DO 400 J=1,VSECTS
DO 400 K=1,irand(2)+irand(3)
CALL MAKELAND
YPOS=(J-1)*VSPACE+irand(VSPACE)
XPOS=(I-1)*HSPACE+irand(HSPACE)
DO 300 L=1,39
DO 300 M=1,39
IF (SUBMAP(L,M).EQ.' ') GOTO 300
IF (((XPOS+L-20).LE.0).OR.((XPOS+L-20).GT.100)) GOTO 300
IF (((YPOS+M-20).LE.0).OR.((YPOS+M-20).GT.60)) GOTO 300
MAP(XPOS+L-20,YPOS+M-20)=SUBMAP(L,M)
300 CONTINUE
400 CONTINUE
COUNT=0
DO 500 I=1,100
DO 500 J=1,60
IF (MAP(I,J).EQ.'.') COUNT=COUNT+1
500 CONTINUE
IF (COUNT.LT.4000.AND.COUNT.GT.2500) GOTO 600
C TYPE 999,COUNT
C WRITE (1,999) COUNT
C999 FORMAT(' FAILED SEA CHECK, COUNT=',I5)
GOTO 100
C600 TYPE 998,COUNT
C WRITE (1,998) COUNT
C998 FORMAT(' COUNT=',I5)
600 DO 800 I=1,100
DO 800 J=1,60
OWNER(I,J)=0
800 CONTINUE
LAREA=1
WAREA=33
DO 1000 I=2,99
DO 1000 J=2,59
IF (OWNER(I,J).NE.0) GOTO 1000
IF (MAP(I,J).EQ.'.') THEN
IF (SET(I,J,WAREA,'.',12000).EQ.0) GOTO 100
WAREA=WAREA+1