edjames@ic.Berkeley.EDU (Ed James) (12/21/86)
GOTO 1000
ELSE
IF (SET(I,J,LAREA,'+',1200).EQ.1) GOTO 900
C TYPE 997
C WRITE (1,997)
C997 FORMAT(' FAILED SINGLE LAND MASS TEST')
GOTO 100
ENDIF
900 LAREA=LAREA+1
1000 CONTINUE
IF (LAREA.GE.10.AND.LAREA.LE.30) GOTO 1100
C TYPE 996
C WRITE(1,996)
C996 FORMAT(' FAILED SEPARATION TEST')
GOTO 100
C1100 TYPE 995,(('@'+OWNER(I,J),I=1,100),J=1,60)
C WRITE(1,995) (('@'+OWNER(I,J),I=1,100),J=1,60)
C995 FORMAT(1X,100A1)
1100 DO 1300 I=1,128
1300 SIZES(I)=0
DO 1400 I=2,99
DO 1400 J=2,59
SIZES(OWNER(I,J))=SIZES(OWNER(I,J))+1
1400 CONTINUE
SCOUNT=COUNT*40/50
DO 1500 SEA=33,WAREA
1500 IF (SIZES(SEA).GE.SCOUNT) GOTO 1600
C TYPE 994
C WRITE (1,994)
C994 FORMAT(' FAILURE- OCEANS ARE SEPARATED')
GOTO 100
1600 CITS=(6000-COUNT)/50+1
CITS=MAX(52,CITS)
CITS=MIN(70,CITS)
SEACITS=CITS*60/100+irand(12)
LANDCITS=CITS-SEACITS
DO 2100 K=1,SEACITS
1700 I=irand(98)+2
J=irand(58)+2
IF (MAP(I,J).NE.'+') GOTO 1700
DO 1800 L=MAX(2,I-1),MIN(99,I+1)
DO 1800 M=MAX(2,J-1),MIN(59,J+1)
IF (OWNER(L,M).EQ.SEA) GOTO 1900
1800 CONTINUE
GOTO 1700
1900 DO 2000 L=MAX(2,I-3),MIN(99,I+3)
DO 2000 M=MAX(2,J-3),MIN(59,J+3)
IF (OWNER(L,M).NE.OWNER(I,J)) GOTO 2000
IF (MAP(L,M).EQ.'*') GOTO 1700
2000 CONTINUE
MAP(I,J)='*'
CITIES(OWNER(I,J))=CITIES(OWNER(I,J))+100
2100 CONTINUE
DO 2500 K=1,LANDCITS
2200 I=irand(98)+2
J=irand(58)+2
IF (MAP(I,J).NE.'+') GOTO 2200
DO 2300 L=MAX(2,I-1),MIN(99,I+1)
DO 2300 M=MAX(2,J-1),MIN(59,J+1)
IF (MAP(L,M).EQ.'.') GOTO 2200
2300 CONTINUE
DO 2400 L=MAX(2,I-2),MIN(99,I+2)
DO 2400 M=MAX(2,J-2),MIN(59,J+2)
IF (OWNER(L,M).NE.OWNER(I,J)) GOTO 2400
IF (MAP(L,M).EQ.'*') GOTO 2200
2400 CONTINUE
MAP(I,J)='*'
CITIES(OWNER(I,J))=CITIES(OWNER(I,J))+1
2500 CONTINUE
C TYPE 993,((MAP(I,J),I=1,100),J=1,60)
D WRITE(1,993) ((MAP(I,J),I=1,100),J=1,60)
D993 FORMAT(1X,100A1)
END
ccc getchx - read a character with no echo
integer function getchx
c
c synopsis
c
c char = getchx()
c
byte char
call getstrq(char, 1, count)
call tupper(char, 1)
getchx = char
return
end
subroutine head ( own1, y, num, z6, h1 )
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
integer i
ptr = 0
call addidt ( own1, jnkbuf, ptr )
call addstr ( ' ', jnkbuf, ptr )
call addint ( y, jnkbuf, ptr )
call addstr ( ' at ', jnkbuf, ptr )
call addint ( z6, jnkbuf, ptr )
do 100, i = ptr + 1, 40
jnkbuf (i) = ' '
100 continue
ptr = 39
call addsts ( mycode ( num ), jnkbuf, ptr )
if ( own1 .eq. 'A' ) goto 500
do 200, i = ptr + 1, 60
jnkbuf (i) = ' '
200 continue
ptr = 59
if ( own1 .ne. 'F' ) goto 250
call addstr ( 'Range: ', jnkbuf, ptr )
call addint ( range ( y ), jnkbuf, ptr )
goto 500
250 continue
call addstr ( 'Hits left: ', jnkbuf, ptr )
call addint ( h1, jnkbuf, ptr )
500 continue
jnkbuf ( ptr + 1 ) = 0
call topmsg ( 1, jnkbuf )
call flush
return
end
ccc help - give help
subroutine help
call clear
call topini
cc call topmsg ( 'EMPIRE.HLP (see EMPIRE.DOC for more detail)' )
call topmsg ( 2, 'ORDERS MODE-----------
* MOVE MODE------------- EDIT MODE-------------' )
call strpos ( 7, 1, 'A: Stay in Move mode' )
call strpos ( 8, 1, 'C: Give 1 free move' )
call strpos ( 9, 1, 'H: This text' )
call strpos ( 10, 1, 'J: Enter edit mode' )
call strpos ( 11, 1, 'M: Enter move mode' )
call strpos ( 12, 1, 'N: Give n free moves' )
call strpos ( 13, 1, 'P: Refresh sector' )
call strpos ( 14, 1, 'Q: Quit game' )
call strpos ( 15, 1, 'R: Display round #' )
call strpos ( 16, 1, 'S: Clear screen' )
call strpos ( 17, 1, 'T: Print out map' )
call strpos ( 18, 1, 'V: Save game' )
call flush
call strpos( 4, 25, 'QWE: Movement' )
call strpos( 5, 25, 'A D direction' )
call strpos( 6, 25, 'ZXC <space>: Sit' )
cc call strpos( 7, 25, '<space>: Sit' )
call strpos( 8, 25, 'G: Sleep till full T,C' )
call strpos( 9, 25, 'H: This text' )
call strpos( 10, 25, 'I: Set direction' )
call strpos( 11, 25, 'J: Enter edit mode' )
call strpos( 12, 25, 'K: Wake piece' )
call strpos( 13, 25, 'L: Set city direction' )
call strpos( 14, 25, 'O: Cancel auto moves' )
call strpos( 15, 25, 'P: Refresh screen' )
call strpos( 16, 25, 'R: Random for armies' )
call strpos( 17, 25, 'S: Sentry' )
call strpos( 18, 25, '?: Display function' )
call flush
cc call strpos( 4, 49, 'QWE: Cursor' )
cc call strpos( 5, 49, 'A D direction' )
cc call strpos( 6, 49, 'ZXC' )
cc call strpos( 8, 49, 'G: Sleep til full T,C' )
call strpos( 8, 49, 'H: This text' )
call strpos( 9, 49, 'I: Set direction' )
call strpos( 10, 49, 'K: Wake anything' )
call strpos( 11, 49, 'M: Set path start' )
call strpos( 12, 49, 'N: Set path end' )
call strpos( 13, 49, 'O: Exit edit mode' )
call strpos( 14, 49, 'P: Change sector' )
call strpos( 15, 49, 'R: Random for armies' )
call strpos( 16, 49, 'S: Sentry ' )
call strpos( 17, 49, 'Y: Set city production' )
call strpos( 18, 49, '?: Display function' )
call flush
call strpos ( 20, 1, 'Piece---Yours-Enemy-Moves-Hits-Cost
* Piece---Yours-Enemy-Moves-Hits-Cost' )
call strpos ( 21, 1, 'army A a 1 1 5
* transport T t 2 3 30' )
call strpos ( 22, 1, 'fighter F f 4 1 10
* cruiser R r 2 8 50' )
call strpos ( 23, 1, 'destroyer D d 2 3 20
* carrier C c 2 8 60' )
call strpos ( 24, 1, 'submarine S s 2 2 25
* battleship B b 2 12 75' )
call flush
return
end
INTEGER FUNCTION HITS(OWN)
IMPLICIT INTEGER(A-Z)
INTEGER B(8)
BYTE ATYP(8),OWN
DATA ATYP/'A','F','D','S','T','R','C','B'/
DATA B/ 1 , 1, 3, 2, 3, 8, 8, 12 /
C
HITS=0
DO 100 I=1,8
IF (OWN.EQ.ATYP(I)) GOTO 200
100 CONTINUE
RETURN
200 HITS=B(I)
RETURN
END
subroutine huh
call topmsg ( 2, 'Huh?' )
call flush
return
end
FUNCTION ICORR(N)
IMPLICIT INTEGER(A-Z)
ICORR=N
IF (ICORR.GT.8) ICORR=ICORR-8
IF (ICORR.LT.1) ICORR=ICORR+8
RETURN
END
FUNCTION IDIST(N1,N2)
C
C RETURN DISTANCE BETWEEN LOCATION N1 AND N2
C
IMPLICIT INTEGER(A-Z)
X1=IABS(MOD(N1-1,100)-MOD(N2-1,100))
Y1=IABS(((N1-1)/100)-((N2-1)/100))
IDIST=MAX0(X1,Y1)
RETURN
END
subroutine initia(flag)
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 decode
external decode
do 300 i=1,6000
if (flag.ne.0) omap(i)=decode(i)
if (omap(i).ne.'*') goto 300
n1=irand(70)+1 !**
do 100 n3=n1,n1+70
n=n3
if (n.gt.70) n=n-70
100 if (x(n).eq.0) goto 200
200 x(n)=i
300 continue
return
end
ccc iphase - return integer of ascii i as a sector number
integer function iphase ( i )
integer i
integer j
parameter zero = "60
parameter nine = "71
j = 0
j = i .and. "177
if (( j .ge. zero ) .and. ( j .le. nine )) j = j - zero
iphase = j
return
end
FUNCTION IPORT(Z6)
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
IPORT=0
ID=500
DO 100 I=1,70
IF (X(I).EQ.0) GOTO 100
IF (RMAP(X(I)).NE.'X') GOTO 100
IF (EDGER(Z6).EQ.0) GOTO 100
IF (IDIST(X(I),Z6).GE.ID) GOTO 100
IPORT=X(I)
ID=IDIST(X(I),Z6)
100 CONTINUE
IF (IPORT.NE.0) RETURN
IPORT=irand(5798)+102
RETURN
END
FUNCTION ISCAPE(I,M)
IMPLICIT INTEGER(A-Z)
C
C: I = NUMBER OF TIMES ONE HAS TRIED TO ESCAPE
CM: DIRECTION IN WHICH DANGER LIES
C
INTEGER ITAB(8)
BYTE PASS
COMMON/PASS/PASS
DATA ITAB/4,5,3,6,2,7,1,0/
C
ISC=M
IF ((PASS).AND.((I.LT.1).OR.(I.GT.8))) GOTO 100
IF ((PASS).AND.((ISC.LT.1).OR.(ISC.GT.8))) GOTO 100
ISC=ICORR(M+ITAB(I))
ISCAPE=ISC
RETURN
100 TYPE 999,ISC,I,M
999 FORMAT(' ISCAPE- ISC,M,I:',3I)
RETURN
END
FUNCTION JIGGLE(Z6,NUM)
C
C DO RANDOM MOVE FOR PLAYER'S ARMY
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
DO 100 I=1,9
100 AB9(I)=RMAP(Z6+IARROW(I+1)) !**
IF (AB9(9).NE.'T') GOTO 200
JIGGLE=0
MYCODE(NUM)=0
RETURN
C
200 DO 300 I1=1,9
300 IF ((AB9(I1).EQ.'*').OR.(AB9(I1).EQ.'X')) GOTO 400
I1=9
400 DO 500 I2=1,9
500 IF ((AB9(I2).GE.'a').AND.(AB9(I2).LE.'t')) GOTO 600
I2=9
600 DO 700 I3=1,9
700 IF (AB9(I3).EQ.'T') GOTO 800
I3=9
800 M1=irand(8)+1 !**
M2=M1+7
DO 900 I4=M1,M2
I5=ICORR(I4)
I=Z6+IARROW(I5+1) !**
900 IF ((ORDER(I).EQ.0).AND.(AB9(I5).EQ.'+')) GOTO 1000
I4=0
1000 M=I1
IF (M.EQ.9) M=I3
IF (M.EQ.9) M=I2
IF (M.EQ.9) M=I5
IF (I4.EQ.0) M=9
JIGGLE=M
RETURN
END
function kline(ki,jector)
implicit integer (a-z)
ki = 0
ject = jector
if ( jector .le. 4 ) goto 13
ki = 30
ject = ject - 5
13 continue
kline = ( ject * 10 ) * 100
return
end
subroutine ltr(z6,iturn)
c
c Does short range scan around location 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 (mode.ne.1) goto 100
call sensor(z6)
return
100 if (iturn.ne.1) goto 700
do 200 i7=1,8
i8=z6+iarrow(i7+1) !**
200 if ( rmap ( i8 ) .eq. pmap ( i8 )) goto 700
call cr
call strout ( 'Before sensor probe' )
l6=z6
if (l6.lt.101) l6=l6+100
if (l6.gt.5900) l6=l6-100
if (l6/100*100.eq.l6) l6=l6-1
if (l6/100*100+1.eq.l6) l6=l6+1
do 600 i=-101,99,100
do 400 i9=0,2
400 d2(i9+1)=omap(l6+i+i9) !**
do 500 i9=0,2
500 g2(i9+1)=pmap(l6+i+i9) !**
600 continue
call putc ( g2 ( 1 ))
call putc ( g2 ( 2 ))
call putc ( g2 ( 3 ))
call putc ( d2 ( 1 ))
call putc ( d2 ( 2 ))
call putc ( d2 ( 3 ))
call sensor(z6)
call cr
call strout ( 'After sensor probe' )
700 continue
l6=z6
if (l6.lt.301) l6=l6+300-(l6-1)/100*100
if (l6.gt.5700) l6=l6-(l6-1)/100*100+5600
if ((l6-1)/100*100+97.lt.l6) l6=97+(l6-1)/100*100
if ((l6-1)/100*100+4.gt.l6) l6=l6/100*100+4
do 900 i=-303,297,100
do 800 i9=0,6
g2(i9+1)=pmap(l6+i+i9) !**
jnkbuf ( i9 + 1 ) = g2( i9 + 1 )
800 continue
call bufout ( jnkbuf, 7 )
call cr
900 continue
1000 continue
return
end
SUBROUTINE MAKELAND
IMPLICIT INTEGER(A-Z)
BYTE SUBMAP(39,39)
REAL DIVER,RAD,COSANG,SINANG
COMMON/SMAP/SUBMAP
DO 100 I=1,39
DO 100 J=1,39
SUBMAP(I,J)=' '
100 CONTINUE
SUBMAP(20,20)='+'
VARY=2+irand(3)
RADIUS=irand(4)+irand(3)
START=90-irand(180)
DO 400 ROT=START,START+360,3
IF (RADIUS.LE.0) GOTO 300
COSANG=COS(FLOAT(ROT)/3.14159)
SINANG=SIN(FLOAT(ROT)/3.14159)
RAD=0
DIVER=.5/(ABS(COSANG)+ABS(SINANG))
200 IF (RAD.GT.RADIUS) GOTO 300
RAD=RAD+DIVER
SUBMAP(20+RAD*COSANG,20+RAD*SINANG)='+'
GOTO 200
300 IF (MOD(ROT,10).NE.0) GOTO 400
RADIUS=RADIUS+irand(VARY)-(VARY/2)
IF ((VARY.AND.1).EQ.0) RADIUS=RADIUS+irand(2)
IF (RADIUS.GE.12) RADIUS=11
400 CONTINUE
RETURN
END
FUNCTION MOV(I6,I7)
C
C RETURNS THE INDEX-1 INTO IARROW FOR THE DIRECTION OF THE MOVE
C FROM I6 TO I7
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 XMAJOR
C
IY6=(I6-1)/100
IY7=(I7-1)/100
IX6=I6-(100*IY6)
IX7=I7-(100*IY7)
IY=IY7-IY6
IX=IX7-IX6
C SCREEN OUT TRIVIAL CASES
IF (IX.EQ.0) THEN
DIR=SIGN(100,IY)
GOTO 100
ENDIF
IF (IY.EQ.0) THEN
DIR=SIGN(1,IX)
GOTO 100
ENDIF
C THIS ATTEMPTS A LINE-OF-SIGHT APPROXIMATION
C unfortunately a true LOS requires knowing where you came from!
C this routine currently tries to keep near a 3 to 1 ratio.
DX=ABS(IX) !GET DELTA X
DY=ABS(IY) !GET DELTA Y
XMAJOR=.TRUE. !ASSUME X IS MAJOR CHANGE
IF (DY.GT.DX) THEN ! IF WRONG, SWITCH
DX=DY
DY=ABS(IX)
XMAJOR=.FALSE.
ENDIF
C ! the divisor determines the slope
C ! perfect case would be delta y at start
IF (IFIX(FLOAT(DX)/3+.5).GT.DY) THEN !IF MAJOR IS LONG, GO STRAIGHT
IF (XMAJOR) THEN
DIR=SIGN(1,IX)
ELSE
DIR=SIGN(100,IY)
ENDIF
ELSE !OTHERWISE, TAKE DIAGONAL
DIR=SIGN(100,IY)+SIGN(1,IX)
ENDIF
100 DO 200 I=1,9 !FIND THE INDEX
200 IF (IARROW(I).EQ.DIR) GOTO 300
300 MOV=I-1 !FOR COMPATIBILITY (?)
C OLD WAY: FOR HISTORIANS
C THIS DOES NOT DO A "TRUE" LINE OF SIGHT, FAVORS DIAGONALS
C IF ((IY.LT.0).AND.(IX.GT.0)) MOV=2
C IF ((IY.LT.0).AND.(IX.EQ.0)) MOV=3
C IF ((IY.LT.0).AND.(IX.LT.0)) MOV=4
C IF ((IY.EQ.0).AND.(IX.LT.0)) MOV=5
C IF ((IY.GT.0).AND.(IX.LT.0)) MOV=6
C IF ((IY.GT.0).AND.(IX.EQ.0)) MOV=7
C IF ((IY.GT.0).AND.(IX.GT.0)) MOV=8
C IF ((IY.EQ.0).AND.(IX.GT.0)) MOV=1
C IF ((IX.EQ.0).AND.(IY.EQ.0)) MOV=0
RETURN
END
FUNCTION MOVCOR
1 (IFO,ITURN,Z6,MOVE,IH1,IS1,AGGR,OWN1,EXPLOR,DIR,DEST,ORIG,HMAX)
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 CHECK FOR IMPOSSIBLE CONDITION FOR MOVE
C
IF ((.NOT.PASS).OR.(IABS(MOVE).LE.8)) GOTO 100
call clear
call topini
TYPE 999,OWN1,Z6,MOVE,IFO
999 FORMAT(1X,A1,' @ ',I4,' ATTEMPTED ',I,' WITH IFO ',I4)
C
100 MOVE=IABS(MOVE)
C
IF (ITURN.EQ.1) BLAH=0 !**
IF (BLAH.LT.0) MOVE=ICORR(I2+irand(3)-1) !**
C
C CHECK FOR SOMETHING TO ATTACK, OR, SOMETHING TO RUN FROM
C BLAH.LT.0: RUN
C BLAH.GE.0: ATTACK
C
DO 200 IX=1,8
I1=IX
LOC=Z6+IARROW(I1+1) !**
AB=RMAP(LOC)
IF (OMAP(LOC).NE.'.') GOTO 200
IF ((AB.LT.'B').OR.(AB.GT.'T')) GOTO 200 !IF SH/PL, LOOK
BLAH=ATTACK(OWN1,AB,IH1,AGGR)
IF (BLAH.GE.0) GOTO 1200 !** ATTACK IT
GOTO 300 !RUN FROM IT
200 CONTINUE
I1=0 !NOTHING OF INTEREST HERE
GOTO 800
C
C SELECT AN APPROPRIATE ESCAPE MOVE
C
300 IS=irand(3)
DO 600 IN=1,8
I2=IN
IF ((IS.EQ.0).OR.(IN.GT.3)) GOTO 500
IF (IS.NE.1) GOTO 400
IF (IN.EQ.1) I2=2
IF (IN.EQ.2) I2=3
IF (IN.EQ.3) I2=1
GOTO 500
400 IF (IN.EQ.1) I2=3
IF (IN.EQ.2) I2=1
IF (IN.EQ.3) I2=2
500 I=IARROW(ISCAPE(I2,I1)+1)+Z6 !**
IF ((RMAP(I).EQ.'.').AND.(ORDER(I).EQ.0)) GOTO 700
600 CONTINUE
I1=0
GOTO 800
700 I1=ISCAPE(I2,I1)
IF (OMAP(I).NE.'.') call topmsg ( 3, 'ISCAPE ERROR' )
GOTO 1200
C
800 IF (EXPLOR.EQ.0) GOTO 1000 !**
EXPMAX=0
DO 900 IX=MOVE,MOVE+7
I1=ICORR(IX)
LOC1=Z6+IARROW(I1+1) !**
IF (ORDER(LOC1).NE.0) GOTO 900
IF (RMAP(LOC1).NE.'.') GOTO 900
IF (DEST.GT.0) THEN
IF (IDIST(Z6,DEST).LT.IDIST(LOC1,DEST)) GOTO 900
ENDIF
NEXP=0
IF (EMAP(LOC1+IARROW(I1+1)).EQ.' ') NEXP=1 !**
IF (EMAP(LOC1+IARROW(ICORR(I1-1)+1)).EQ.' ') NEXP=NEXP+1 !**
IF (EMAP(LOC1+IARROW(ICORR(I1+1)+1)).EQ.' ') NEXP=NEXP+1 !**
IF (EMAP(LOC1+IARROW(ICORR(I1+2)+1)).EQ.' ') NEXP=NEXP+1 !**
IF (EMAP(LOC1+IARROW(ICORR(I1-2)+1)).EQ.' ') NEXP=NEXP+1 !**
IF (NEXP.EQ.5) GOTO 1200
IF (NEXP.LE.EXPMAX) GOTO 900
EXPMAX=NEXP
I11=I1
900 CONTINUE
I1=0
IF (EXPMAX.EQ.0) GOTO 1000
I1=I11
GOTO 1200
1000 I2=MOVE
LOC1=Z6+IARROW(MOVE+1) !**
AB=RMAP(LOC1)
IF (LOC1.NE.ORIG) THEN
IF (((AB.EQ.'.').OR.(AB.EQ.'X')).AND.(ORDER(LOC1).EQ.0)) GOTO 1200
ENDIF
M=MOVE
IA=ICORR(M-DIR*3)
IF (RMAP(Z6+IARROW(IA+1)).NE.'.') M=IA !**
DO 1100 I=0,7*DIR,DIR
I2=ICORR(M+I)
I3=Z6+IARROW(I2+1) !**
IF ((RMAP(I3).EQ.'.').AND.(ORDER(I3).EQ.0).AND.(I3.NE.ORIG)) GOTO 1200
1100 CONTINUE
I2=0
1200 IF (I1.NE.0) I2=I1
IF (RMAP(Z6+IARROW(MOVE+1)).NE.'X') MOVE=I2 !**
IF ((RMAP(Z6).EQ.'X').AND.(IH1.LT.HMAX)) MOVE=0
MOVCOR=MOVE
RETURN
END
ccc mve - handle player move mode
subroutine mve(own1,xxxmdate,relnum,num,n2,z6,z7,disas,jursor)
c
c inputs:
c own1 = char of piece (ie: 'a' for army)
c xxxmdate = round number
c relnum = relative piece number to type
c num = piece index to rlmap
c n2 = piece index to hits
c z6 = location, return new location
c z7 = old location
c disas = 0:ok, -2:stasis
c jursor = current cursor
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
disas=0
c
c Get command character with no echo
c
100 call sector ( pmap ( 1 ))
ib = j1ts ( n2 )
call head ( own1, relnum, num, z6, ib ) ! display header
call cursor ( jursor )
200 e = getchx()
call topmsg ( 2, 0 ) ! clear line
call topmsg ( 3, 0 ) ! clear line
call flush
c
c Look at the command
c
z7 = z6
do 300 i = 1, 9
ind = i
300 if ( e .eq. kbtbl ( ind )) goto 400
goto 500 ! command is not a direction
400 z6 = z6 + kbfudg ( ind )
goto 4200
500 end = 15
if ( pass ) end = 20
do 600 i = 1, end
600 if ( e .eq. comman ( i )) goto 700
i = 0
c
c s, r, i, k, o, l, f, g, p, h, y, t, v, j, ?, 0, 0, u, n, +
c
700 goto ( 900, 1000, 1100, 1500, 1900, 2000, 2300, 2400, 2500, 2600,
* 2700, 2800, 2900, 3200, 3300, 800, 800, 3800, 3900, 2600 ) i
800 goto 100
c
c s: put to sleep
c
900 if ( rmap ( z6 ) .eq. 'O' ) return
mycode ( num ) = 50
return
c
c r: random movement
c
1000 if ( own1 .ne. 'A' ) goto 100 ! only for armies
mycode ( num ) = 100
z6 = z6 + iarrow ( jiggle ( z6, num ) + 1 )
return
c
c i: put in directional stasis
c
1100 call cursor(jursor) !cuz of clear lines above
e=getchx()
do 1200 i=1,9
if (e .eq. kbtbl(i)) goto 1300
1200 continue
goto 1400
1300 mycode(num)=cmytbl(i)
1400 if (mycode(num).eq.0) goto 100
disas=-2
return
c
c k: kill stasis number on piece
c
1500 mycode(num)=0 ! zero function code for anything
if (own1.ne.'T') goto 1700 ! if transport, wake armies aboard
do 1600 j=1,500
1600 if (rlmap(j).eq.z6) mycode(j)=0
goto 100
1700 if (own1.ne.'C') goto 100 ! if carrier, wake fighters aboard
do 1800 j=501,700
1800 if (rlmap(j).eq.z6) mycode(j)=0
goto 100
c
c o: cancel auto move mode
c
1900 continue
if ( .not. automv ) goto 1913
automv = .false.
call topmsg ( 3, 'Auto move mode canceled' )
goto 100
1913 continue
call topmsg ( 3, 'Not in auto mode!' )
goto 100
C
C L: SET UP CITY STASIS NUMBERS
C
2000 IF (OMAP(Z6).NE.'*') GOTO 2300 !BETTER BE A CITY
E=GETCHX()
DO 2100 I=1,9
IF (E .EQ. KBTBL(I)) GOTO 2200
2100 CONTINUE
GOTO 4100
2200 FIPATH(CITFND(Z6))=CMYTBL(I) !SET STASIS NUMBER
DISAS=-2
RETURN
C
C F:
C
2300 CALL DIREC
GOTO 4100
C
C G: PUT T/C TO SLEEP
C
2400 IF ((OWN1.NE.'T').AND.(OWN1.NE.'C')) GOTO 100
MYCODE(NUM)=9997
DISAS=-2
RETURN
C
C P: SECTOR PRINTOUT
C
2500 ISEC=-1
CALL SECTOR(PMAP(1))
GOTO 4100
c
c h: get help
c
2600 call help
e = getchx()
isec = -1
goto 4100
C
C Y: CHANGE PHASE OF A CITY
C
2700 CALL DIREC
GOTO 4100
C
C T: BLOCK PRINTOUT
C
C2800 CALL CLEAR
C CALL BLOCK(PMAP(1))
C ISEC=-1
C GOTO 4100
C
C V: SAVE GAME
C
C2900 CALL GAME(1,NUM) !NOT SURE THIS WILL WORK AS PLAYERS EXPECT
2800 CONTINUE
2900 CALL DIREC
GOTO 100
C
C J: PUT IN EDIT MODE
C
3200 CALL EDIT(Z6)
IF (MYCODE(NUM).EQ.0) GOTO 100
DISAS=-2
RETURN
c
c ?: how many hits? loaded?
c
3300 if ((own1.eq.'A').or.(own1.eq.'F')) goto 100
ib=j1ts(n2) ! display hits left
ptr = 0
C CALL sstrout ( ' Hits left:',10)
n = 0 ! count armies
if ( own1 .ne. 'T' ) goto 3500
do 3400 i = 1, 500
3400 if ( rlmap ( i ) .eq. z6 ) n = n + 1
if ( n .eq. 0 ) goto 3700
cc if (mode.eq.1) call tpos(3,1)
call addint ( n, jnkbuf, ptr )
if ( n .eq. 1 ) call addstr ( ' army', jnkbuf, ptr )
if ( n .gt. 1 ) call addstr ( ' armies', jnkbuf, ptr )
goto 1313
3500 if ( own1 .ne. 'C' ) goto 4100
do 3600 i = 1, 200 ! count fighters
3600 if ( rlmap ( i + 500 ) .eq. z6 ) n = n + 1
if ( n .eq. 0 ) goto 3700
cc if (mode.eq.1) call tpos(3,1)
call addstr ( ' fighter', jnkbuf, ptr )
if ( n .gt. 1 ) call addstr ( 's', jnkbuf, ptr )
1313 continue
call addstr ( ' aboard', jnkbuf, ptr )
jnkbuf(ptr + 1) = 0
call topmsg ( 3, jnkbuf )
call flush
goto 4100
3700 continue ! nothing aboard
cc if (mode.eq.1) call tpos(3,1)
call topmsg ( 3, 'Nothing aboard' )
call flush
GOTO 4100
C
C U: CALL REFERENCE MAP
C
3800 ISEC=-1
CALL SECTOR(RMAP(1))
GOTO 4100
C
C N: CALL ENEMY MAP
C
3900 ISEC=-1
CALL SECTOR(EMAP(1))
GOTO 4100
C
C +: BLOCK PRINT REF. MAP
C
4000 call clear
call topini
ISEC=-1
CALL BLOCK(RMAP(1))
E=GETCHX()
GOTO 4100
C
4100 call ltr(z6,2)
call flush
goto 100
4200 if (order(z6).eq.0) goto 4300
cc if (mode.eq.1) call tpos(3,1)
call topmsg ( 3, 'You cannot move onto the edge of the world' )
z6 = z7
goto 4100
4300 return
end
FUNCTION ORDER(I6)
C
C RETURN =1 IF OFF THE EDGE OF THE MAP
C
IMPLICIT INTEGER(A-Z)
ORDER=1
IF ((I6.LE.101).OR.(I6.GE.5900)) RETURN
IF (MOD(I6,100).LE.1) RETURN
ORDER=0
RETURN
END
FUNCTION PATH(BEG,END,DIR,OKVECT,FLAG)
C
C PATH SUBROUTINE FOR EMPIRE
C FINDS DIRECTION TO MOVE UNIT, FROM BEG TO END, OKVECT SPECIFIES OK TERRAIN.
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 OKVECT(5)
C
BACKUP=1
TDIR=DIR ! GET A DIRECTION TO FIDDLE WITH
DIR3=TDIR*3
Z6=BEG
MAXMVE=(2 * IDIST(BEG,END))+1 ! COMPUTE MAX MOVES TO GET THERE
MOVNUM=MAXMVE
100 DO 200 I=1,100 ! CLEAR G2 ARRAY
G2(I)=0
200 CONTINUE
C STRGHT: ! TRY STRAIGHT MOVE FIRST
300 MOOVE= MOV(Z6,END)
Z62=Z6+IARROW(MOOVE+1)
AB=EMAP(Z62)
IF (COMPAR(AB,Z62,OKVECT).EQ.0) GOTO 900 !IF NO GOOD, FOLLOW SHORE
C OKSET: ! STRAGHT MOVE WORKING
400 BAKADR=1
C OKMOVE:
500 IF (Z6 .EQ. BEG) MOVE1=MOOVE
Z6=Z62
IF (FLAG.GE.1000) CALL TEST4(Z6,FLAG,TDIR,MOVE1,MOVNUM,BEG,
1 END,G2,BAKADR)
IF (Z6 .EQ. END) GOTO 800 ! IF Z6=END, WE'RE DONE
C DOMORE:
600 MOVNUM=MOVNUM-1
IF (MOVNUM .EQ. 0) GOTO 700 ! REACHED MAX MOVES, TRY NEW DIRECTION
C STRGHT, CHKNXT
GOTO (300, 1300), BAKADR ! CONTINUE, IN SAME MANNER
C TRYDIR::
700 DIR3=-DIR3 ! NEGATE CURRENT DIRECTION
TDIR=-TDIR
IF (TDIR .EQ. DIR) GOTO 1200 ! GIVE UP IF BACK TO START
MOVNUM=MAXMVE ! ELSE, TRY AGAIN
BACKUP=1
Z6=BEG
GOTO 100
C SUCCES: SUCCESS, RETURN
800 PATH=MOVE1
SUCCES=SUCCES+1
FLAG=1
RETURN
C FOLSHR: FOLLOW THE SHORE
900 MOV1=ICORR(MOOVE-DIR3) ! TRY AGAIN
Z62=Z6+IARROW(MOV1+1)
AB=EMAP(Z62)
IF (COMPAR(AB,Z62,OKVECT).EQ.1) MOV1=MOOVE ! ???
C STFOL:
1000 DO 1100 IVAR= MOV1,MOV1+7*TDIR,TDIR
MOOVE=ICORR(IVAR)
Z62=Z6+IARROW(MOOVE+1)
IF (ORDER(Z62) .NE. 0) GOTO 1100
AB=EMAP(Z62)
IF (COMPAR(AB,Z62,OKVECT).EQ.0) GOTO 1100
C OKSET2:
BAKADR=2
GOTO 500
1100 CONTINUE
C FAILUR:
1200 PATH=MOV(BEG,END)
FAILUR=FAILUR+1
FLAG=0
RETURN
C CHKNXT:
1300 T1=MOV(Z6,END)
Z62=Z6+IARROW(T1+1)
AB=EMAP(Z62)
IF (COMPAR(AB,Z62,OKVECT).EQ.0) GOTO 900
DO 1400 IVAR=BACKUP,1,-1
IF (Z6 .EQ. G2(IVAR)) GOTO 900
1400 CONTINUE
G2(BACKUP)=Z6
BACKUP=BACKUP+1
IF (BACKUP .LE. 100) GOTO 300
GOTO 700
END
subroutine phasin(num,e)
c
c Prompt for city production type, set prod accordingly
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
e = getchx()
do 200 i=1,8
200 if ( e .eq. phaze ( i )) goto 300
call huh
e = ' '
return !if he doesn't do it right, leave it
300 phase ( num) = phazee ( i )
found ( num ) = mdate + 6 * phase ( num )
return
end
FUNCTION POSCHK(Z6,OWN)
C
C DETERMINES IF Z6 IS IN CURRENT UPDATE SECTOR SHOWING
C 0=NO, 1=YES
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
INTEGER LOWSCRS(5),HIGHSCRS(5)
DATA LOWSCRS/1,14,24,34,44/
DATA HIGHSCRS/15,25,35,45,58/
C
IF (MODE.EQ.1) GOTO 100
POSCHK=1
GOTO 400
100 JECT=JECTOR
POSCHK=0
IY=(Z6-1)/100
IX=Z6-IY*100
ADJUST=1
IF (OWN.EQ.'F') ADJUST=0
IF (JECT.GT.4) GOTO 200
IF (IX.GT.(64+ADJUST)) GOTO 400
GOTO 300
200 IF (IX.LT.(36-ADJUST)) GOTO 400
JECT=JECT-5
300 IF ((IY.LT.(LOWSCRS(JECT+1)-ADJUST)).OR.
1 (IY.GT.(HIGHSCRS(JECT+1)+ADJUST))) GOTO 400
POSCHK=1
400 RETURN
END
FUNCTION PRIORI(Z6,IFO,ILA,DIR,AC)
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 GROUND,OK
C
DO 100 I=1,7
100 PRIOR(I)=0
EXPMAX=0
C
C NOW MAKE A GUESS AS TO WHAT THE MOVE WILL BE
C
MOVE1=ILA
IF (IFO.EQ.1.OR.IFO.EQ.2) MOVE1=MOV(Z6,ILA)
IF (IFO.EQ.3) MOVE1=MOV(Z6,RLMAP(ITT2+ILA))
C
C NOW SEE IF ANY PRIORITY MOVES EXIST
C
DO 200 I=0,7*DIR,DIR
MOVE=ICORR(MOVE1+I)
LOC=Z6+IARROW(MOVE+1) !**
IF (ORDER(LOC).NE.0) GOTO 200
AB=RMAP(LOC)
C
C CHECK IF ARMY CAN ATTACK SOMETHING OVER WATER
C
GROUND=OMAP(LOC)
OK='Y'
IF ((AC.EQ.'t').AND.(GROUND.EQ.'.')) OK='N'
C
IF (AB.EQ.'O') PRIOR(1)=MOVE
IF ((AB.EQ.'T').AND.(OK.EQ.'Y')) PRIOR(3)=MOVE
IF (AB.EQ.'*') PRIOR(2)=MOVE
IF (AB.EQ.'A') PRIOR(5)=MOVE
IF ((AB.EQ.'S').AND.(OK.EQ.'Y')) PRIOR(6)=MOVE
IF ((IFO.EQ.0).AND.(AB.GE.'A').AND.(AB.LE.'T').AND.(OK.EQ.'Y'))
1 PRIOR(7)=MOVE
C
IF (GROUND.NE.'+') GOTO 200
N=0
IF (EMAP(LOC+IARROW(ICORR(MOVE-2)+1)).EQ.' ') N=1 !**
IF (EMAP(LOC+IARROW(ICORR(MOVE-1)+1)).EQ.' ') N=N+1 !**
IF (EMAP(LOC+IARROW(MOVE+1)).EQ.' ') N=N+1 !**
IF (EMAP(LOC+IARROW(ICORR(MOVE+1)+1)).EQ.' ') N=N+1 !**
IF (EMAP(LOC+IARROW(ICORR(MOVE+2)+1)).EQ.' ') N=N+1 !**
C TYPE 999,N,EXPMAX
C999 FORMAT(' N:',I2,' EXPMAX:',I2)
IF (N.LE.EXPMAX) GOTO 200
PRIOR(4)=MOVE
EXPMAX=N
200 CONTINUE
C TYPE 998
C998 FORMAT(' XXXXXXXXXXXXXXXX')
C
C NOW SELECT THE HIGHEST PRIORITY MOVE
C
DO 300 I=1,7
300 IF (PRIOR(I).NE.0) GOTO 400
PRIORI=0
RETURN
400 PRIORI=PRIOR(I)
RETURN
END
subroutine prod ( ahits, z6, alimit, acrahit, acraloc, alopmax,
* aar2s, j, arange, string, point )
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 string ( 80 )
integer point
integer aar2s(500),arange(200)
do 1000 i = acraloc + 1, alopmax + acraloc
if ( rlmap ( i ) .ne. 0 ) goto 1000
if ( i .gt. alimit + acraloc ) alimit = i - acraloc
rlmap ( i ) = z6
if ( ahits .gt. 1 ) j1ts ( acrahit + i - acraloc ) = ahits
if ( j .gt. 1 ) mycode ( i ) = 0
if ( j .lt. 2 ) codefu ( i - 1500 ) = 0
if ( j .lt. 2 ) codela ( i - 1500 ) = 0
if ( j .eq. 1 ) aar2s ( i - 1500 ) = 0
if ( acraloc .eq. 2000 ) arange ( i - 2000 ) = 20
if ( j .eq. 3 ) arange ( i - 500 ) = 20
cc if (( j .le. 1 ) .or. ( j .ge. 10 )) return
call addrock ( j, string, point )
return
1000 continue
return
end
subroutine read(beg,lim,num)
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
do 100 j = beg + 1, beg + lim
read ( 1 ) k
rlmap ( j ) = k
if (num .lt. 9) read ( 1 ) mycode(j)
if (num .gt. 8) read ( 1 ) codefu(j-1500),codela(j-1500)
if (num .eq. 9) read ( 1 ) ar2s(j-1500)
if (num .eq. 2) read ( 1 ) range(j-500)
if (num .eq. 10) read ( 1 ) rang(j-2000)
100 continue
return
end
ccc irand - produce a random number
integer function irand(ihigh)
integer ihigh
integer rndint
irand = rndint ( 0, ihigh - 1 )
return
end
ccc round - display the round number
subroutine round ( mdate )
integer mdate
byte jnkbuf ( 10 )
integer i
do 100 i = 1, 3
jnkbuf ( i ) = ' '
100 continue
i = 0
call addint ( mdate, jnkbuf, i ) ! date in jnkbuf
call bufpos ( 20, 78, jnkbuf ( 1 ), 1 )
call bufpos ( 21, 78, jnkbuf ( 2 ), 1 )
call bufpos ( 22, 78, jnkbuf ( 3 ), 1 )
return
end
FUNCTION SCRCHK(Z6)
C
C DETERMINES IF Z6 IS IN CURRENT SCREEN SECTOR SHOWING
C 0=NO, 1=YES
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 (MODE.EQ.1) GOTO 100
SCRCHK=1
GOTO 400
100 JECT=JECTOR
SCRCHK=0
IY=(Z6-1)/100
IX=Z6-IY*100
IF (JECT.GT.4) GOTO 200 !CHECK X COORD FIRST
IF (IX.GT.70) GOTO 400
GOTO 300
200 IF (IX.LT.30) GOTO 400
JECT=JECT-5
300 IF ((IY.LT.(JECT*10)).OR.(IY.GT.(JECT*10+19))) GOTO 400
SCRCHK=1 !PASSED, IT'S GOOD
400 RETURN
END
subroutine sector ( amap )
c
c This subroutine display sector jector from map ii
c if isec=jector, map will not be displayed again
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 amap ( 6000 )
if ( jector .eq. -1 ) goto 200
if ( mode .ne. 1 ) return
if ( isec .ne. jector ) goto 100
if ( newrnd .eq. 1 ) goto 1300
return
100 isec=jector
goto 300
200 call topmsg ( 1, 'Sector? ' )
jector=iphase(getchx())
if ((jector.lt.0).or.(jector.gt.9)) goto 200
isec=jector
jector=-1 ! let main know that updating sector isn't used
300 continue
call flush
call delay ( 45 ) ! delay before zapping old sector
call clear
call topini
line=kline(ki,isec)
linefi=line+2000 ! linefi=line after last line of sector
linec=line-100 ! get set for line 400
400 linec=linec+100 ! goto next line
if (linec.ge.linefi) goto 1000 ! check for end of sector
kstart = ki + 1 ! if line is broken, kstart will be modified
500 do 600 j=kstart,ki+70 ! ki itself is not in sector
ab = amap ( j + linec ) ! get character
600 if (ab.ne.' ') goto 700 ! find first non-blank spot
goto 400 ! no characters in this line
700 kinit = j ! ab is already calculated
g2(j)=ab ! avoids repitition
do 800 j=kinit+1,ki+70 ! look for blank character
ab=amap(j+linec) ! get character
if (ab.eq.' ') goto 900 ! exit loop if blank
800 g2(j)=ab ! put char. string in an array
900 kfinal=j-1 !set end of char. string
call cursor(kinit-line+linec-ki+300) ! position cursor
encode (kfinal-kinit+2,999,jnkbuf)(g2(j),j=kinit,kfinal),0
999 format(<kfinal-kinit+2>a1)
call strout ( jnkbuf )
if (kfinal.ge.ki+70) goto 400 ! next line
kstart = kfinal + 1 ! look at rest of line
goto 500
1000 kursor = 2300
c
c Print x coordinates
c
do 1100 i = ki, ki + 70, 10
call cursor ( kursor )
ptr = 0
call addint ( i, jnkbuf, ptr )
jnkbuf ( ptr + 1 ) = 0
call strout ( jnkbuf )
kursor = kursor + 10
1100 continue
c
c Print y coordinates
c
kursor=372
do 1200 i=line/100,line/100+19,2
call cursor ( kursor )
ptr = 0
call addint ( i, jnkbuf, ptr )
jnkbuf ( ptr + 1 ) = 0
call strout ( jnkbuf )
kursor=kursor+200
1200 continue
call flush
cc do 1314 ptr = 1, 3
cc jnkbuf ( ptr ) = ' '
cc1314 continue
cc ptr = 1
cc call addint ( mdate, jnkbuf, ptr ) ! date in jnkbuf
call strpos ( 5, 78, 'S' )
call strpos ( 6, 78, 'e' )
call strpos ( 7, 78, 'c' )
call strpos ( 8, 78, 't' )
call strpos ( 9, 78, 'o' )
call strpos ( 10, 78, 'r' )
call bufpos ( 12, 78, isec + "60, 1 )
call strpos ( 14, 78, 'R' )
call strpos ( 15, 78, 'o' )
call strpos ( 16, 78, 'u' )
call strpos ( 17, 78, 'n' )
call strpos ( 18, 78, 'd' )
cc call bufpos ( 20, 78, jnkbuf ( 1 ), 1 )
cc call bufpos ( 21, 78, jnkbuf ( 2 ), 1 )
cc call bufpos ( 22, 78, jnkbuf ( 3 ), 1 )
call round ( mdate )
call flush
1300 continue
newrnd = 0
return
end
subroutine sensor(z6)
c
c Updates player's map around location z6
c and screen if current sector is displayed
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)