edjames@ic.Berkeley.EDU (Ed James) (12/21/86)
#----cut here-----cut here-----cut here-----cut here-----
#! /bin/sh
# This is a shell archive, meaning:
# 1. Remove everything above the #! /bin/sh line.
# 2. Save the resulting text in a file.
# 3. Execute the file with /bin/sh (not csh) to create the files:
# real_vms_empire
# This archive created by edjames at Sat Dec 20 13:00:15 1986
export PATH; PATH=/bin:$PATH
if test ! -d 'real_vms_empire'
then
mkdir 'real_vms_empire'
fi
cd 'real_vms_empire'
if test -f 'compile.com'
then
echo shar: will not over-write existing file "'compile.com'"
else
cat << \SHAR_EOF > 'compile.com'
$ delete *.obj;*
$ !
$ fort getnow
$ fort rndlb
$ fort empire
SHAR_EOF
if test 62 -ne "`wc -c < 'compile.com'`"
then
echo shar: error transmitting "'compile.com'" '(should have been 62 characters)'
fi
fi # end of overwriting check
if test -f 'empire.doc'
then
echo shar: will not over-write existing file "'empire.doc'"
else
cat << \SHAR_EOF > 'empire.doc'
empire(tool) 27Sep84 empire(tool)
NAME
empire - the wargame of the century
SYNOPSIS
empire
DESCRIPTION
Empire is a simulation of a full-scale war between two
emperors, the computer and you. Naturally, there is only
room for one, so the object of the game is to destroy
the other. the computer plays by the same rules that you
do.
1 Introduction 1. Introduction _. ____________ 1. Introduction
The map is a rectangle 600*1000 miles on a side. The
resolution is 10, so the map you see is 60*100. The map
consists of sea='.', land='+', Uncontrolled cities='*',
Computer-controlled cities='X', and Your dominated
cities='O'. Each emperor gets 1 move per round (1
round=1 day), moves are done sequentially.
The map is displayed on the player's screen during
movement. Each piece is represented by a unique
character on the map. With a few exceptions, you can
only have ONE piece on a given location. On the map, you
are shown only the 8 squares adjacent to your units.
This information is updated before and after every move.
The map displays the most recent information known.
The game starts by assigning you one city and the
computer one city. Cities can produce new units. Every
city that you own produces more pieces for you according
to the cost of the desired unit. The typical play of the
game is to issue the Automove command until you decide
to do something special. During movement in each round,
the player is prompted to move each piece that does not
otherwise have an assigned function.
Map coordinates are 4-digit numbers. the first two
digits are the row, the second two digits are the
column.
The pieces are as follows:
Piece Yours Enemy Moves Hits Cost Maximum
Number
Army A a 1 1 5(6) 500
- 1 -
empire(tool) 27Sep84 empire(tool)
Fighter F f 4 1 10(12) 200
Destroyer D d 2 3 20(24) 200
Submarine S s 2 2 25(30) 200
Troop transport T t 2 3 30(36) 100
Cruiser R r 2 8 50(60) 100
Aircraft carrier C c 2 8 60(72) 100
Battleship B b 2 12 75(90) 100
The second column shows the map representation for your
units.
The third shows the representations of enemy units.
Moves is the number of squares that unit can move in a
single round.
Hits is the amount of damage a unit can take before it
is destroyed.
Cost is the number of rounds needed to produce another
of the same unit.
The number in parenthesis is the cost for a city to
produce the 1st unit.
The last column is the maximum number of that unit that
you can have.
2 Description of the pieces 2. Description of the pieces _. ___________ __ ___ ______ 2. Description of the pieces
Army: Armies move only on land. ONLY ARMIES CAN CAPTURE
CITIES. They have a 50% probability of doing so.
Attacking one's own cities results in the army's
destruction. Armies can be carried by troop transports.
Just move the army on the transport and when the
transport moves the army moves with it. You cannot
attack any ships while on board a transport. YOU CANNOT
MOVE BACK ON A CITY WITH AN ARMY.
Fighter: Fighters move over sea or land. They move 4
times per round. They are refueled at controlled cities
and carriers. They are shot down over uncontrolled
cities. They have a max range of 20 spaces.
Ships, general: All ships can move only on the sea.
They move two times per round. Ships can also dock in a
controlled city. Docked ships have damage repaired at
rate of 1 hit per day. If a ship is hit badly, it will
slow to 1 move per round.
Destroyer: Typical ship, quickest to produce.
- 2 -
empire(tool) 27Sep84 empire(tool)
Submarine: When a submarine scores a hit, 3 hits are
exacted instead of the usual 1 from the enemy unit. This
is the only unit having this property.
Troop Transport: Troop Transports are the only units
that can carry armies. They can carry a maximum of 2 *
(the number of hits left) of armies. Armies that cannot
be carried will drown.
Cruisers: Typical ship.
Aircraft Carriers: Carriers are the only ships that can
carry fighters. Carriers carry a maximum of the number
of hits left of fighters.
Battleship: Typical ship.
3 Functions to which you can assign your pieces 3. Functions to which you can assign your pieces _. _________ __ _____ ___ ___ ______ ____ ______ 3. Functions to which you can assign your pieces Other
than just moving your pieces you can assign them the
following automatic functions:
awake: Cancel current automatic function and return to
manual moves.
sentry: Stay put, do not ask the player to move the
piece, wake up if an enemy piece comes within
sensor range.
direction: Move in specified direction, wake up if an
enemy piece, enemy city, or unoccupied city is
encountered. Temporary wake up if an obstacle is
in path of movement, after getting a manual move
from you, THE UNIT IS STILL ASSIGNED A
DIRECTION. A direction assignment is represented
by the key which sets that direction (e.g.: D
means east).
move: Move towards location assigned to the piece (in
editing mode). Wake up if enemy piece is
encountered. Wake up temporarily if obstacle is
in path of movement. Represented by the
coordinate the piece is moving toward.
fill: (Troop transports and aircraft carriers only) go
on sentry duty until full to capacity of armies
or fighters.
random: (Armies only) move at random subject to the
following conditions:
If an uncontrolled city is adjacent, attack it.
If an enemy unit is adjacent, attack it (even if
it is a ship).
- 3 -
empire(tool) 27Sep84 empire(tool)
If an unfilled troop transport of yours is
adjacent, get on it and wake up.
Move if possible without attacking any of your
own units.
It will not destroy itself unless it is in a
city surrounded by your units.
4 Orders mode 4. Orders mode _. ______ ____ 4. Orders mode The top level prompt is:
Your Orders?
This is asked between each round (if you are not in Auto
move mode). The following commands are valid at this
time:
A: Auto move. Begin movement, stay there until "O"
in move mode cancels the auto move.
C: Give the computer a free move.
H: Display the Help screen. Contains a brief
description of all the commands.
J: Puts you into Editing Mode (explained later),
where you can examine and/or change the
functions associated with your pieces and
cities.
M: Move. Cause a round to be played by you and the
computer.
N: Give the computer the number of free moves you
specify. The game gets more interesting if you
give the computer 10 to 30 free moves at the
start.
P: Re-display current sector on screen.
R: Display the round number.
S: Clears the screen.
T: Request a printout of the entire map. You must
supply a file spec for where you want the map
put.
Q: Quit the game. Be sure to save first. ip V:,8
Save game.
- 4 -
empire(tool) 27Sep84 empire(tool)
5 Movement mode 5. Movement mode _. ________ ____ 5. Movement mode To simply move a piece, type one of the
following keys;
Q W E
\|/
A--+--D
/|\
Z X C
These keys move in the direction of the key from S. The
characters are not echoed and only 1 character is
accepted, so no need for a <Return>. Hit the SPACE BAR
if you want the piece to stay put.
Other commands are:
H: Display Help text (hit any character to continue
moving)
J: Enter Editing Mode
G: Fill: put the troop transport (or aircraft
carrier) to sleep until it accumulates 6 armies
(or 8 fighters), then wake it up. If the ship
is damaged, the ship will wake up when it has
all it can take.
I: Set unit to moving in a direction specified by
the next character typed in
K: Wake up piece. If piece is a troop transport or
carrier, all armies or fighters on board are
also woken up.
L: Set fighter path for city to be the direction
following the "L".
O: Cancel auto move. At the end of the round,
Orders Mode will prompt. Doesn't affect current
piece.
P: Refresh the screen
R: If it's an army, set it to moving at random.
S: Put on sentry duty.
?: Display information about the piece. Shows the
function, hits left, range and number of armies
or fighters aboard.
- 5 -
empire(tool) 27Sep84 empire(tool)
ATTACKING something is accomplished by moving onto the
square of the unit you wish to attack. Hits are traded
off at 50% probability of a hit landing on one or the
other units until one unit is totally destroyed. There
is only 1 possible winner.
If you give a piece a direction or move function, they
will wake TEMPORARILY if they run into an obstacle (or
enemy). You must explicitly wake the piece to regain
complete control or assign it a new function.
Fighters moving under the command of a function will
wake up when they have 10 rounds of fuel left. This is
to enable you to decide whether you want to make it
kamikaze or send it back to a city for refueling. Be
careful to cancel any currently assigned function before
trying to bring the fighter back.
You are "allowed" to do FATAL things like, attack your
own cities or other pieces. If you try to do fatal move
that involve terrain restrictions, like, drive armys
into the sea and ships into land, you are given a chance
to reconsider. Answer with an "n" if you want to commit
suicide. You cannot move onto the edge of the world.
6 Editing mode 6. Editing mode _. _______ ____ 6. Editing mode Editing mode allows you to move around
the ``world'' and check on things. You can assign and
deassign movements and inquire on the production of
cities. Movements assigned during editing mode do not
take effect until the next round.
To move the cursor around, use the standard direction
keys.
Other commands are:
H: Display Help text (hit any character to continue
editing).
O: Exit from editing mode.
I: Give piece (or city) the function 'direction',
enter the key specifying the direction following
the 'I'.
K: Wake up piece (or cancel city fighter path).
M: Put piece (or city) in 'move' function. Type M
over piece (or city), then move the cursor to
where you want it to go, and type 'N'. Assigning
a 'move' to a city, effects any fighters that
land there.
- 6 -
empire(tool) 27Sep84 empire(tool)
N: Specify the end point of a move (see M command).
P: Display new sector. Each sector represents a
20*70 area of the map, arranged as follows:
0 5
1 6
2 7
3 8
4 9
The sectors overlap by 8 vertically, and 40
horizontally.
R: Put army in 'random'.
S: Put piece in Sentry mode.
Y: Change phase of city that cursor is on top of.
When program asks for production demands, key in
the letter corresponding to what you want
produced.
?: Display information about piece or city. For
pieces, displays function, range, hits left, any
pieces aboard. Cities display production,
fighter paths, and any pieces in the city.
You can give cities functions. This doesn't affect the
city any, but any fighter landing in that city will pick
up the specified function. This is useful for setting up
automatic fighter movements.
Note that you cannot affect anything inside a city with
the editor.
AUTHOR(S)
Mario DeNobili and Thomas N. Paulson.
Support for different terminal types added by Craig Leres.
- 7 -
SHAR_EOF
echo shar: 1 control character may be missing from "'empire.doc'"
if test 17322 -ne "`wc -c < 'empire.doc'`"
then
echo shar: error transmitting "'empire.doc'" '(should have been 17322 characters)'
fi
fi # end of overwriting check
if test -f 'empire.for'
then
echo shar: will not over-write existing file "'empire.for'"
else
cat << \SHAR_EOF > 'empire.for'
c 01b 27May85 cal .Fixed round number update bug. Made truename simple.
c 01a 01Sep83 cal .Taken from a Decus tape
subroutine ver
call strout('EMPIRE, Version 4.1x 27-May-1985')
return
end
program empire
c
c This program is a war game simulation for video terminals.
c The game was originally written outside of Digital, probably a university.
c This version of the game was made runnable on Digital Equipment VAX/VMS
c FORTRAN by conversion from the TOPS-10/20 sources available around fall 1979.
c After debugging it, numerous changes have been made.
c
c Now that you are the proud owner of the source and you are all gung ho
c to do things right, there are a few things you should be aware of.
c Unfortunately, there are many magic numbers controlling how many different
c kinds of units can exist and how many of each, so think well before you
c attempt to add another unit type. Also, "slight changes" to the way the units
c work will typically have a fairly devastating affect on the computers
c strategy. If you are interested in really hacking this, there is a plenty
c of room for enhanced computer strategy. As you'll see, there are some
c very good debugging tools tucked inside, and you will soon discover weak
c points and bugs, that up until you, have remained problems (all the previous
c programmers got lazy or lost interest). Finally, please be careful with
c the version number and identification at start up to avoid confusion of
c ongoing versions with private copies. If you make a change don't remove
c the major version id, but rather add something like (V4.0 site.1 20-JUL-80).
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 odor ( 2 )
equivalence ( odor ( 1 ), orders )
integer i, count, status
call ttinit
CC call initst
CC call gaminit ( 'empire' )
call rndini ( 0, 0 )
win = 0
ncycle = 1
pass = .false.
automv = .false.
call clear
call topini
call tpos ( 7, 1 )
call ver ! Special message
cc call strpos ( 8, 1, 'Detailed directions are in EMPIRE.DOC' )
cc call cr
call flush
c
c -1/0/1 = restore/start/save game
c
call game ( -1, num ) ! Try to restore a previous game
c
c Command loop starts here
c
100 continue
call round ( mdate )
if ( automv ) goto 4200 ! Don't ask if in auto move
call bell ! Wake up sleepy commanders
call topmsg ( 1, 'Your orders? ' )
call flush
call getstr ( jnkbuf, 80, count )
call addcnt ( 1, count )
if ( count .gt. 2 ) goto 100
orders = ' '
call tupper ( jnkbuf, count )
odor ( 1 ) = jnkbuf ( 1 )
if ( odor ( 1 ) .eq. "32 ) goto 1900 ! Quit command?
if ( count .eq. 2 ) odor ( 2 ) = jnkbuf ( 2 )
c
c Special hack for je command
c
if ((specal) .and. (orders .eq. 'JE')) goto 3900
c
c Lookup command
c
do 200 i = 1,20
200 if ( orders .eq. comscn ( i )) goto 300
if ( pass ) goto 2200
goto 100
c
c m, n, o, s, t, v, p, y, c, l, h, j, 1, r, @, q , +, a
c
300 goto ( 400, 500, 600, 700, 800, 900, 1000, 1100, 1200, 1300,
* 1400, 1500, 1600, 1700, 1800, 1900, 2000, 2100 ) i
goto 100
400 goto 4200 ! m - move mode
500 continue ! n - free enemy moves
call topmsg ( 2, 'Number of free enemy moves: ' )
call addcnt ( 2, 5 )
call flush
accept 993, ncycle
goto 5300
600 goto 4200 ! o - move mode (synomn for m)
700 call clear ! s - clear the screen
call topini
isec = -1
goto 100
800 call block ( pmap ( 1 )) ! t - print out map
goto 100
900 call game ( +1, 0 ) ! v - save game
call topmsg ( 3, 'Game Saved.' )
goto 100
1000 call sector ( pmap ( 1 )) ! p - print out a sector
goto 100
1100 call direc ! y - error msg
goto 100
1200 goto 5200 ! c - give one free enemy move
1300 call direc ! l - error msg
goto 100
1400 call help ! h - help
isec = -1
goto 100
1500 mode = 1 ! j - edit mode
z6 = 0
call edit ( z6 )
goto 100
1600 mode = 0 ! 1 - set mode=0
jector = -1
goto 100
1700 continue ! r - display round number
ptr = 0
call addstr ( 'Round # ', jnkbuf, ptr )
call addint ( mdate, jnkbuf, ptr )
jnkbuf ( ptr + 1 ) = 0
call topmsg ( 2, jnkbuf )
call flush
goto 100
1800 continue ! @ - restore game
jector = -1
call clear
call topini
call game ( -1, num )
if ( num .ne. 0 ) goto 5200 !**
goto 100
1900 continue ! q - quit
call topmsg ( 3, 0 ) ! clear line
call topmsg ( 2, 'QUIT - Are you sure? ' )
call flush
e = getchx()
call putc ( e )
call flush
call addcnt ( 2, 1 )
if ( e .ne. 'y' .and. e .ne. 'Y' ) goto 100
call clear
call topini
call flush
call empend
2000 e = getchx() ! + - turn on pass
if ( e .eq. '+' ) pass = .true.
if ( e .eq. '-' ) pass = .false. ! or off
goto 100
2100 automv = .true. ! a - turn on auto move mode
goto 4200
2200 do 2300 i=21,40 ! debugging commands
2300 if (orders.eq.comscn(i)) goto 2400
goto 100
c
c lo,nu,li,tr,ar,ta,pa,a1,t3,a0,co,ch,q0, q1,je,cy,ex
c
2400 goto (2500,2600,2700,2800,2900,3000,3100,3200,3300,
1 3400,3500,3600,3700,3800,3900,4000,4100) i-20
goto 100
2500 type 986, ((loci(i,j),j=1,11),i=1,10) !lo -
goto 100
2600 type 989, number !nu -
goto 100
2700 type 991, limit !li -
goto 100
2800 type 990, troopt !tr -
goto 100
2900 type 989, armtot ! ar -
goto 100
3000 type 989, target ! ta -
goto 100
3100 type 988, succes,failur ! pa -
goto 100
3200 call block(rmap(1)) ! a1 - print reference map
goto 100
3300 goto 100 ! t3 - ignored
3400 call block(emap(1)) ! a0 - print computer's map
goto 100
3500 accept 993,i1 ! co -
accept 993,i2
993 format(i)
type 987, (codefu(j),codela(j),j=i1,i1+i2)
goto 100
3600 accept 985,coder ! ch - set coder variable
goto 100
3700 isec = -1 ! q0 - display enemy map sector
call topmsg ( 2, 'Sector? ' )
call flush
call addcnt ( 2, 1 )
jector = iphase ( getchx())
call sector ( emap ( 1 ))
goto 100
3800 isec=-1 ! q1 - display reference map sector
call topmsg ( 2, 'Sector? ' )
call flush
call addcnt ( 2, 1 )
jector = iphase ( getchx())
call sector(rmap(1))
goto 100
3900 isec=-1
call topmsg ( 2, 'Sector? ' )
call flush
jector=iphase(getchx()) ! je - display enemy sector of choice
if (jector.lt.0.or.jector.gt.9) goto 3900
call sector(emap(1))
isec=-1
goto 100
4000 goto 100 ! cy - ignored
4100 ex=expl() ! ex - disply explore function value
type 992,ex
goto 100
992 FORMAT('+EXP VALUE:',I5$)
991 FORMAT(1X,8I4)
990 FORMAT(1X,5I6)
989 FORMAT(1X,10I5)
988 FORMAT(' SUCCESS:',I6,' FAILURE:',I6)
987 FORMAT(1X,10I7)
986 FORMAT(11I5)
985 format(i)
c
c Begin movement
c
c User move
c
4200 if ( mode .eq. 0 ) goto 4400
if ( jector .ne. -1 ) goto 4300
call clear
call topini
jector = 0
isec = -1
4300 istart = isec
if ( isec .lt. 0 ) istart = 0
4400 do 4500 i = 1, 1500
4500 movedflag ( i ) = 0
do 4700 ject = istart, istart + 9
if ( mode .eq. 0 ) goto 4600
jector = ject
if ( ject .gt. 9 ) jector = ject - 10
line = kline ( ki, jector )
iadjst = line + ki - 300
4600 call shipmv ( itt, itth, 5, 'T', 3 )
call shipmv ( ica, icah, 7, 'C', 8 )
call shipmv ( iba, ibah, 8, 'B', 12 )
call shipmv ( icr, icrh, 6, 'R', 8 )
call shipmv ( isu, isuh, 4, 'S', 2 )
call shipmv ( ide, ideh, 3, 'D', 3 )
call armymv
call fighmv
if ( mode .eq. 0 ) goto 4800
4700 continue
4800 continue
c
c Hardware production
c
do 5100 y = 1, 70
if ( owner ( y ) .ne. 1 ) goto 5100
if ( phase ( y ) .eq. 14 ) goto 5100
call sensor ( x ( y ))
if ( phase(y).eq.8) goto 4900
if (( phase(y) .lt. 1 ) .or. ( phase(y) .gt. 15 )) goto 4900
if ( mod ( phase ( y ), 2 ) .eq. 0 ) goto 5000
if ( mod ( phase ( y ), 5 ) .eq. 0 ) goto 5000
if ( phase ( y ) .eq. 1 ) goto 5000
c
c City phase incorrect or we just took it
c
4900 continue
call clear
call topini
isec = -1
ptr = 0
call addstr ( 'Readout around city at ', jnkbuf, ptr )
call addint ( x ( y ), jnkbuf, ptr )
call bufpos ( 4, 1, jnkbuf, ptr )
call cr
call cr
i1 = mode
mode = 0
call ltr ( x ( y ), 0 )
mode = i1
call cr
call strout ( 'What are your production demands for this city? ' )
call flush
call phasin ( y, e )
call putc ( e )
call flush
call delay ( 45 )
call clear
call topini
call flush
goto 5100
5000 if ( mdate .lt. found ( y )) goto 5100
found ( y ) = mdate + phase ( y ) * 5
c
c A city has built something; build up a line
c
ptr = 0
call addstr ( 'City # ', jnkbuf, ptr )
call addint ( y, jnkbuf, ptr )
call addstr ( ' at ', jnkbuf, ptr )
call addint ( x(y), jnkbuf, ptr )
call addstr ( ' has completed a', jnkbuf, ptr )
k = phase ( y )
cd type 983, hits ( k ), x ( y ), tipe ( k ), crahit ( k ), craloc ( k ),
cd 1 lopmax ( k ), k
cd983 format(' hits:',i5,' x(y):',i5,' tipe(k):',i5,' crahit(k):',i5,/
cd 1 ,' craloc(k):',i5,' lopmax(k):',i5,' k:',i)
call prod ( hits ( k ), x ( y ), limit ( tipe ( k )),
* crahit ( k ), craloc ( k ), lopmax ( k ), ar2s,
* tipe ( k ) + 1, range, jnkbuf, ptr )
jnkbuf ( ptr + 1 ) = 0
call topmsg ( 3, jnkbuf )
call flush
call delay(30)
5100 continue
5200 continue
c
c Computer move
c
5300 continue
d call pme_init
do 5500 i=1,ncycle
call armcnt
call troopm
call topmsg ( 1, 'My turn, thinking..' )
call flush
call armyen
call topmsg ( 1, 0 ) ! Blank the thinking
call flush
call carier
call enemym ( 'b', 12 ,iba2h, iba2, 8 )
call enemym ( 'r', 8 ,icr2h, icr2, 6 )
call enemym ( 's', 2 ,isu2h, isu2, 4 )
call enemym ( 'd', 3 ,ide2h, ide2, 3 )
call topmsg ( 1, 'My turn, thinking...' )
call flush
call fightr
c
c Age known enemy army locations
c
do 5350 k = 1, 10
if ( loci ( k, 1 ) + 21 .gt. mdate ) goto 5350 ! If data is not old
do 5340 j = 1, 11
5340 loci ( k, j ) = 0 ! Zero that line
5350 continue
c
c Production of enemy hardware
c
call cityct
do 5400 y = 1, 70
if ((x(y) .eq. 0) .or. (owner(y) .ne. 2)) goto 5400
call sonar ( x ( y ))
if ((phase(y) .le. 0) .or. (mdate .lt. found(y))) goto 5380
k = phase ( y )
j = 0
if ( k .eq. 1 ) j = 1
ptr = 0 ! To fake out prod
call prod(hits(k),x(y),limit(tipe(k)+8),crahit(k)+ide2h,
* craloc(k)+1500,lopmax(k),ar2s,j,rang, jnkbuf, ptr )
5380 if ((phase(y).le.0).or.(mdate.ge.found(y))) call cityph(y)
5400 continue
mdate = mdate + 1
newrnd = 1
if (mod(mdate,4).eq.0.or.(mdate.gt.160)) call game (+1,0)
5500 continue
d call pme_exit
ncycle = 1
c
if ( win .eq. 1 ) goto 100
if ( win .eq. 2 ) goto 5700
n = 0
do 5600 j = 1, 70
5600 if (owner(j) .eq. 1) n = n + 1
if (n.lt.30) goto 5700
if (number(9).gt.n/2) goto 5700
call topmsg ( 1, 'The computer acknowledges defeat. Do' )
call topmsg ( 2, 'you wish to smash the rest of the enemy? ')
call flush
call addcnt ( 2, 1 )
if ( getchx() .eq. 'Y' ) call empend
call cr
call strout ( 'The enemy inadvertantly revealed its code used for' )
call cr
call strout ( 'receiving battle information. You can display what' )
call cr
call strout ( 'they''ve learned through the command ''JE''(cr)(lf),' )
call cr
call strout ( 'followed by the sector number.' )
call flush
specal = .true.
win = 2
automv = .false.
goto 100
5700 if ((number(9).gt.0).or.(limit(9).gt.0)) goto 5800
call clear
call topini
call strout ( 'The enemy is incapable of defeating you.' )
call cr
call strout ( 'You are free to rape the empire as you wish.' )
call cr
call strout ( 'There may be, however, remnants of the enemy fleet' )
call cr
call strout ( 'to be routed out and destroyed.' )
win = 1
automv = .false.
goto 100
5800 do 5900 i=1,70
5900 if (owner(i).eq.1) goto 100
do 6000 i=1,limit(1)
6000 if (rlmap(i).ne.0) goto 100
call clear
call topini
win = 1
call strout ( 'You have been rendered incapable of' )
call cr
call strout ( 'defeating the rampaging enemy fascists! The' )
call cr
call strout ( 'empire is lost. If you have any ships left, you may' )
call cr
call strout ( 'attempt to harass enemy shipping.' )
automv = .false.
goto 100
end
ccc addidt - identify peice and add to string
ccc addpei - add peice to string
subroutine addidt ( own, string, iptr )
byte own, string ( 80 )
integer iptr
c
c synopsis
c
c call addidt ( own, string, iptr )
c
integer i
if ((own.ge.'a').and.(own.le.'t'))
* call addstr ( 'Enemy ', string, iptr )
if ((own.le.'T').and.(own.ge.'A'))
* call addstr ( 'Your ', string, iptr )
entry addpei ( own, string, iptr )
i = 99 ! In case it doesn't exist
if ((own.eq.'A').or.(own.eq.'a')) i = 2
if ((own.eq.'F').or.(own.eq.'f')) i = 3
if ((own.eq.'D').or.(own.eq.'d')) i = 4
if ((own.eq.'S').or.(own.eq.'s')) i = 5
if ((own.eq.'T').or.(own.eq.'t')) i = 6
if ((own.eq.'R').or.(own.eq.'r')) i = 7
if ((own.eq.'C').or.(own.eq.'c')) i = 8
if ((own.eq.'B').or.(own.eq.'b')) i = 9
call addfoo ( i, string, iptr )
return
end
ccc addrock - copy peice into buffer
ccc addfoo - copy peice into buffer with extra character(s)
subroutine addrock ( peice, string, ptr )
integer peice, ptr
byte string ( 80 )
c
c synopsis
c
c call addrock ( peice, string, ptr )
c call addfoo ( peice, string, ptr )
c
c peice - integer value of peice
c string - byte array to put string into
c ptr - pointer to next unused element in string
c
if ( peice .eq. 2 ) call addstr ( 'n', string, ptr )
call addstr ( ' ', string, ptr )
entry addfoo ( peice, string, ptr )
goto ( 100, 200, 300, 400, 500, 600, 700, 800, 900 ) peice
call addstr ( 'steam beer', string, ptr )
100 return
200 call addstr ( 'army', string, ptr )
return
300 call addstr ( 'fighter', string, ptr )
return
400 call addstr ( 'destroyer', string, ptr )
return
500 call addstr ( 'submarine', string, ptr )
return
600 call addstr ( 'troop transport', string, ptr )
return
700 call addstr ( 'cruiser', string, ptr )
return
800 call addstr ( 'aircraft carrier', string, ptr )
return
900 call addstr ( 'battleship', string, ptr )
return
end
ccc addsts - display mycod function in english
subroutine addsts ( mycod, string, iptr )
c
c synopsis
c
c call addsts ( mycod, string, iptr )
c
c mycod - function code
c string - byte array to add strings to
c iptr - current length of string
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 string ( 80 )
integer iptr
call addstr ( 'Function: ', string, iptr )
c
c Awake if mycod = 0
c
if ( mycod .ne. 0 ) goto 100
call addstr ( 'awake', string, iptr )
return
c
c Sentry if 0 < mycod < 100
c
100 continue
if (( mycod .le. 0 ) .or. ( mycod .ge. 100 )) goto 200
call addstr ( 'sentry', string, iptr )
return
c
c Random if mycod = 100
c
200 continue
if ( mycod .ne. 100 ) goto 300
call addstr ( 'random', string, iptr )
return
c
c Aimed at a location if 100 < mycod < 6101
c
300 continue
if (( mycod .le. 100 ) .or. ( mycod .ge. 6101 )) goto 400
call addint ( mycod, string, iptr )
return
c
c Set in a direction if 6101 <= mycod <= 6108
c
400 continue
if (( mycod .lt. 6101 ) .or. ( mycod .gt. 6108 )) goto 500
iptr = iptr + 1
do 450 i = 6101, 6108
if ( i .eq. mycod ) string ( iptr ) = comm ( i - 6100 )
450 continue
return
c
c Fill if mycod = 9997
c
500 continue
if ( mycod .ne. 9997 ) goto 600
call addstr ( 'fill', string, iptr )
return
c
c Not assigned a valid function; goofing off
c
600 continue
call addstr ( 'taking drugs', string, iptr )
return
end
SUBROUTINE ARMCNT
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,20
100 ARMTOT(I)=0
DO 300 I=1,LIMIT(9)
IF (CODEFU(I).NE.1) GOTO 300
ILA=CODELA(I)
DO 200 I2=1,20
200 IF (TARGET(I2).EQ.ILA) ARMTOT(I2)=ARMTOT(I2)+1
300 CONTINUE
RETURN
END
function armjmp(z6,ar2sc)
c
c This subroutine determines whether or not an army should get off
c the troop transport it is on. 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
armjmp=0
do 100 i=1,8
100 if (omap(z6+iarrow(i+1)).ne.'.') goto 200 ! not all sea surround
return
200 if (ar2sc.eq.0) goto 400 ! been on troop transport
! for a long time
do 300 i=1,8
loc=z6+iarrow(i+1)
if (omap(loc).eq.'.') goto 300
if (order(loc).ne.0) goto 300
ab=rmap(loc)
if ((ab.eq.'A').or.(ab.eq.'F')) goto 400
if ((ab.eq.'*').or.(ab.eq.'O')) goto 400
loc=z6+2*iarrow(i+1)
ab=emap(loc)
if (ab.eq.' ') goto 400
300 continue
return ! don't jump
400 armjmp=1
return ! jump
end
subroutine armyen
c
c This subroutine handles enemy army 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
cc integer irand
monkey=0
number(1)=0
if (coder.eq.1) type 999
999 format(' army codes')
c
c start army move loop
c
do 4200 y=1,limit(9)
z6=rlmap(iar2+y)
if (z6.eq.0) goto 4200
if (coder.eq.0) goto 200
ptr = 0
call addint ( y, jnkbuf, ptr )
call addstr ( ' ', jnkbuf, ptr )
call addint ( npath, jnkbuf, ptr )
npath=0
200 z7=z6
monkey=y
dir=mod(y,2)*2-1 ! set dir to 1 or -1
p=0
ab=rmap(z6) ! set ab=what is showing where the army is
ac=0
if ((ab.ne.'a').AND.(AB.NE.'t').and.(ab.ne.'X')) goto 3700
c
c Age ar2s
c
if ((ar2s(y).le.100).or.(ar2s(y).gt.1000)) ar2s(y)=ar2s(y)-1
if ((ar2s(y).lt.0).or.(ar2s(y).eq.1000)) ar2s(y)=0
if (ab.eq.'a') goto 300
if (ab.eq.'X') then
do 250 i=1,limit(13)
if (rlmap(itt2+i).eq.z6) goto 270
250 continue
goto 300
endif
270 if (armjmp(z6,ar2s(y)).eq.0) goto 4150
c
c Move selection
c
300 ifo=codefu(y)
ila=codela(y)
c
c If a priority move exists, pick it and don't bother slugging
c through code selection and move selection
c
move1=priori(z6,ifo,ila,dir,ab)
if (move1.ne.0) goto 2400
c
c ifo = 0 move in certain direction, or follow shore
c ifo = 1 move towards target city
c ifo = 2 move towards an enemy army
c ifo = 3 move towards a troop transport
c
goto ( 400, 500, 600, 700 ) ifo + 1
400 goto 800 ! look for targets, loci, tt's
500 if (rmap(ila).eq.'X') goto 800 ! city has been captured
goto 1600 ! move
600 if (ila.eq.z6) goto 800 ! arrived at enemy concentration
goto 1600 ! move
700 if (ila.gt.100) goto 800 ! invalid value for ila
if (codefu(ila+itt2-1500).ge.6) goto 1200
if (rlmap(ila+itt2).eq.0) goto 1200 ! tt sunk
if (j1ts(ila+itt2h).lt.3) goto 1200 ! tt damaged
goto 1700
c
c Select a new code
c
800 continue
c
c Look for target city
c
if (number(10).eq.0) goto 1050
ia=irand(number(10))+1
ib=ia+number(10)-1
do 1000 ic=ia,ib
i=ic
if (i.gt.number(10)) i=i-number(10)
if (target(i).eq.0) goto 1000
if (idist(z6,target(i)).gt.14) goto 1000
move=path(z6,target(i),dir,okb,flag)
npath=npath+1
if (flag.eq.0) goto 1000 ! can't get to it
ifo=1
ila=target(i)
goto 1800 ! move
1000 continue
c
c Look for an army that is on your continent
c
1050 if (loci(10,11).ne.0) loci(10,11)=0
do 1100 i=1,10
temp=irand(10)+2 !**
if (loci(i,temp).eq.0) temp=2
if (loci(i,temp).eq.0) goto 1100
temp=loci(i,temp)
move=path(z6,temp,dir,okb,flag)
npath=npath+1
if (flag.eq.0) goto 1100
ifo=2
ila=temp
goto 1800
1100 continue
c
c Look for tt that is short of armies
c
1200 if (ar2s(y).ne.0) goto 1400 ! ineligible to get on a tt
ia=irand(limit(13))+1 ! **
do 1300 ic=ia,ia+limit(13)
i=ic
if (i.gt.limit(13)) i=i-limit(13)
if (rlmap(itt2+i).eq.0) goto 1300 ! tt doesn't exist
if (j1ts(itt2h+i).lt.3) goto 1300 ! damaged, i.e. unsuitable
if (iabs(codefu(itt2+i-1500)).ge.6) goto 1300
if (idist(z6,rlmap(itt2+i)).gt.20) goto 1300 ! too far away
move=path(z6,rlmap(itt2+i),dir,okb,flag)
npath=npath+1
if (flag.eq.0) goto 1300 ! can't get to it
move=mov(z6,rlmap(itt2+i))
ifo=3
ila=i
codela(itt2+i-1500)=y
goto 1800
1300 continue
c
c Pick a random direction (ifo=0)
c
1400 if ((ifo.eq.0).and.(ila.ne.0)) goto 1500
! if already ass'd direc
ifo=0
ila=irand(8)+1 !**
1500 move=ila
i1=icorr(move-dir*3)
if (rmap(z6+iarrow(i1+1)).ne.'+') move=i1 !**
goto 1800
1600 move=path(z6,ila,dir,okb,flag)
npath=npath+1
if (flag.eq.0) goto 1400
goto 1800
1700 move=path(z6,rlmap(ila+itt2),dir,okb,flag)
npath=npath+1
1800 do 2300 i=0,7*dir,dir
move1=icorr(move+i)
loc=z6+iarrow(move1+1) !**
ac=rmap(loc)
if (ac.ne.'t') goto 2200
if (ifo.eq.3) ifo=0
if (ar2s(y).ne.0) goto 2300
numarm=0
do 1900 iz=itt2+1,limit(13)+itt2
1900 if (rlmap(iz).eq.loc) goto 2000
2000 if (j1ts(itt2h-itt2+iz).lt.3) goto 2300
do 2100 iy=iar2+1,limit(9)+iar2
if (rlmap(iy).eq.loc) numarm=numarm+1
2100 if (numarm.ge.6) goto 2300
goto 2400
2200 if ((ac.eq.'+').and.(order(loc).eq.0)) goto 2400
2300 continue
move1=0
c
2400 if (ifo.eq.0) ila=iabs(move1)
codefu(y)=ifo
codela(y)=ila
if (coder.eq.1) type 998,ifo,ila
998 format(1x,7i,3x)
z6=z6+iarrow(move1+1) !**
c
ac=rmap(z6)
if (ab.ne.'t') goto 2500
if (ac.eq.'t') goto 3600
codefu(y)=0
codela(y)=0
ar2s(y)=1020
goto 2600
2500 if (omap(z7).ne.'*') rmap(z7)=omap(z7)
if (ac.ne.'t') goto 2600
ar2s(y)=100
goto 3600
2600 if (ac.eq.'+') goto 3500
if ((ac.eq.'X').or.(ac.eq.'.')) goto 3700
if (omap(z6).ne.'*') goto 3400
if (irand(100).lt.50) then
id=10
do 2650 i=1,limit(9)
if (rlmap(iar2+i).eq.0) goto 2650
if (i.eq.y) goto 2650
if (codefu(i).ne.0) goto 2650
if (idist(rlmap(iar2+i),z6).ge.id) goto 2650
move=path(rlmap(iar2+i),z6,1,okb,flag)
npath=npath+1
if (flag.eq.0) goto 2650 !can't get to it
id=idist(rlmap(iar2+i),z6)
iy=i
2650 continue
if (id.lt.10) then
ifo=1
ila=z6
endif
goto 3700
endif
do 2700 i=1,70
2700 if (target(i).eq.z6) target(i)=0
do 2800 i=1,limit(9)
2800 if (codefu(i).ne.1.or.codela(i).ne.z6) goto 2900
codefu(i)=0
codela(i)=0
2900 do 3000 i=1,100
3000 if (x(i).eq.z6) goto 3100
3100 owner(i)=2
phase(i)=0
if (((ac.eq.'O').or.(ar2s(y).gt.0)).and.(edger(z6).lt.8))
* phase(i)=-1
if (ac.ne.'O') goto 3200
ptr = 0
call addstr ( 'City at ', jnkbuf, ptr )
call addint ( z6, jnkbuf, ptr )
call addstr ( ' surrendered to enemy forces', jnkbuf, ptr )
jnkbuf ( ptr + 1 ) = 0
call topmsg ( 3, jnkbuf )
call flush
call delay(30)
rmap(z6)='X'
call sensor(z6)
goto 3700
3200 rmap(z6)='X'
goto 3700
3300 ar2s(y)=100
goto 3600
3400 h1=1
if (z7.eq.z6) goto 3600
997 format(1h+,/,' Error: attacked ',a1,4i,1x)
p=1
own1='a'
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 3700
rmap(z6)=omap(z6)
if (rmap(z6).eq.'.') goto 3700
3500 rmap(z6)='a'
3600 rlmap(iar2+y)=z6
if (p.eq.1) call sensor(z6)
goto 4100
3700 rlmap(iar2+y)=0
if (ac.ne.'X') goto 3900
do 3800 i=1,70
3800 if (x(i).eq.z6) phase(i)=0
3900 if (p.eq.1) call sensor(z6)
if (rmap(z6).ne.'O') goto 4000
ptr = 0
call addstr ( 'City at ', jnkbuf, ptr )
call addint ( z6, jnkbuf, ptr )
call addstr ( ' repelled enemy invasion', jnkbuf, ptr )
jnkbuf(ptr + 1) = 0
call topmsg ( 3, jnkbuf )
call flush
call delay(30)
4000 codefu(y)=0
codela(y)=0
ar2s(y)=0
4100 call sonar(z6)
4150 if (rlmap(iar2+y).ne.0) number(1)=number(1)+1
4200 continue
limit(9)=monkey
return
end
subroutine armymv
c
c This routine handles player's army 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
iturn = 1
do 2700 y = 1, limit (1)
if (movedflag(y) .ne. 0) goto 2700
z6 = rlmap(y)
if (z6 .eq. 0) goto 2700
mycod = mycode(y)
if ((mode.eq.1).and.(poschk(z6,'A').eq.0)) goto 2700
movedflag(y)=1
z7=z6
ab=rmap(z6)
if ((ab.eq.'A').or.(ab.eq.'T').or.(ab.eq.'O')) goto 200
100 continue
ptr = 0
call addstr('Army # ', 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 2500
200 if (ab.ne.'T') goto 400
do 300 i=1,8
if (rmap(z6+iarrow(i+1)).eq.'T') goto 400
300 if (omap(z6+iarrow(i+1)).ne.'.') goto 400 ! don't ask if nowhere to go
goto 2700
400 if (mycod .eq. 0) goto 1000
if (mycod .ne. 100) goto 500
z6 = z6 + iarrow(jiggle(z6, y) + 1) ! do random move
goto 1200
500 call stasis(z6,y) ! wake up if near enemy
600 mycod=mycode(y)
if (mycod.eq.0) goto 1000
if ((mycod.lt.100).or.(mycod.gt.6108)) goto 1200
if (mycod.gt.6100) goto 800
if (mycod.le.6000) goto 700
goto 1200
700 z6=z6+iarrow(mov(z6,mycod)+1) ! do a move toward a location
goto 900
800 z6=z6+iarrow(mycod-6100+1) ! do direction moves
900 ad = rmap(z6)
if (((ad.eq.'+').or.(ad.eq.'T')).and.(order(z6).eq.0)) goto 1200
z6=z7
1000 call sector(pmap(1))
call ltr(z6,iturn)
1100 call mve('A',mdate,y,y,1,z6,z7,disas,z6-iadjst)
if (disas.eq.-2) goto 600 ! just put into stasis
c
c Move evaluation, z6=to, z7=from, check out new location
c
1200 if ((rmap(z7).ne.'T').and.(omap(z7).ne.'*')) rmap(z7)=omap(z7)
if (z6.eq.mycode(y)) mycode(y)=0
ac = rmap(z6)
ao = omap(z6)
if (ac .eq. 'T') goto 1400 ! getting on a transport?
if ((rmap(z7) .ne. 'T') .or. (ao .ne. '.')) goto 1300
if (.not. fatal(1)) goto 2800 ! cannot attack on transports, ask
call topmsg ( 2, 'You are incapable of attack
* while on a transport.' )
call topmsg ( 3, 'Your army jumped into the briny and drowned.' )
call flush
call delay(30)
goto 2500
1300 if (ao .ne. '.') goto 1600 ! make sure not sea
if (.not. fatal(1)) goto 2800 ! ask about drowning
if (ac .ne. '.') goto 1800
call topmsg ( 3, 'Your army marched dutifully into the
* sea and drowned.' )
call flush
call delay(30)
goto 2500
1400 h1=30 ! check if room on transport
call find(ac,z6,z8,h1)
n=0
do 1500 i=1,limit(1)
if (rlmap(i).ne.z6) goto 1500
if (i.eq.y) goto 1500 ! dont count ourself
n=n+1
1500 continue
if (n.lt.h1*2) goto 1700
if (.not. fatal(6)) goto 2800
if (mycode(y).gt.50) mycode(y)=0
goto 1700
1600 if (ac .ne. '+') goto 1800 ! check if clear
rmap(z6) = 'A' ! put army on the map
1700 rlmap(y) = z6 ! record new location
goto 2600
c
c We're attacking something
c
1800 h1=1 !armies have one hit
if (omap(z6) .ne. '*') goto 2400
do 2300 iy=1,70 !it's a city, find who owns it
if (x(iy).ne.z6) goto 2300
if (owner(iy).ne.1) goto 1900
do 1850 jy=1,limit(5)
if (z6.eq.rlmap(itt+jy)) goto 1400
1850 continue
if (.not. fatal(5)) goto 2800 !ask about fatal move
rmap(z6)='O'
call topmsg ( 2, 'BASTARDO! You attacked your own city!' )
call topmsg ( 3, 'Your impertinent attacking army was liquidated.' )
call flush
call delay(30)
goto 2500
1900 if (irand(100).lt.50) goto 2000
call topmsg ( 3, 'The scum defending the city has crushed
* your attacking blitzkrieger!' )
call flush
call delay(30)
goto 2300
2000 call sector(pmap(1))
ptr = 0
call addstr ( 'City # ', jnkbuf, ptr )
call addint ( iy, jnkbuf, ptr )
call addstr( ' has been subjugated!', jnkbuf, ptr )
jnkbuf ( ptr + 1 ) = 0
call topmsg ( 2, jnkbuf )
call topmsg ( 3, 'The army has been dispersed to enforce control.' )
call topmsg ( 1, 'What are your production demands for this city? ' )
call flush
rmap ( z6 )= 'O'
call sensor ( z6 )
call cursor(z6-iadjst)
phase ( iy ) = 0
found ( iy ) = 10000
call phasin ( iy, e )
if ( owner ( iy ) .ne. 2 ) goto 2200 ! if enemy owned it, tell him
call sonar ( z6 )
do 2100 i = 1, 70
if (target(i).eq.z6) goto 2200
if (target(i).ne.0) goto 2100
target(i)=z6
goto 2200
2100 continue
2200 owner(iy)=1
2300 continue
goto 2500
c
c Attacking another unit
c
2400 if ((ac.ge.'A').and.(ac.le.'T')) then
if (.not.fatal(2)) goto 2800
endif
own1='A'
own2=ac
h1=1
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 2500 ! did I lose?, Yes, wipe up
rmap(z6)='A'
if ((own2.ge.'a').and.(own2.le.'t')) call sonar(z6)
if (ao.eq.'+') goto 1700
rmap(z6)=ao
if ((own2.ge.'a').and.(own2.le. 't')) call sonar(z6)
call topmsg ( 2, 'Your army regretfully drowns after
* its successful assault' )
call flush
call delay(30)
2500 rlmap(y)=0 ! "kill" my army
mycode(y)=0
2600 call sensor(z6)
2700 continue
return
c
c Recover from fatal move, and try again
c
2800 z6=z7 ! go back to old location
rmap(z6)=ab ! change it back to previous
goto 1000
end
FUNCTION ATTACK(OWN1,OWN2,IH1,AGGR)
IMPLICIT INTEGER(A-Z)
BYTE OWN1,OWN2
H1=IH1
C1=COST(OWN1,H1)
C2=COST(OWN2,0)
S1=1
S2=1
IF (OWN1.EQ.'s') S1=3
IF (OWN2.EQ.'S') S2=3
H2=HITS(OWN2)
H1=(H1+S2-1)/S2
H2=(H2+S1-1)/S1
ATTACK=(((C2*100)*H1)/H2)-(C1*100)+(AGGR*100)
RETURN
END
subroutine block ( amap )
c
c This subroutine makes a copy of map ii into supplied file spec
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)
integer i
isec=-1
call clear
call topini
jector=-1
call strout ( 'Output file: ' )
call flush
call getstr ( tty, 20, i )
call clear
call topini
tty ( i + 1 ) = 0
open ( unit=2, name=tty, access='SEQUENTIAL',
* form='FORMATTED', status='NEW', err=600 )
do 500 j=0,5900,100
do 200 k=100,1,-1
ab=amap(k+j)
200 if (ab.ne.' ') goto 300
goto 500
300 do 400 l=1,k
400 g2(l)=amap(j+l)
write(2,998) (g2(l),l=1,k)
998 format(1x,100a1)
500 continue
close(unit=2)
return
600 continue
ptr = 0
call addstr ( 'ERROR, Unable to open output file ', jnkbuf, ptr )
call addstr ( tty, jnkbuf, ptr )
jnkbuf ( ptr + 1 ) = 0
call topmsg ( 1, jnkbuf )
call flush
return
end
subroutine carier
c
c This subroutine handles enemy carrier 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
NUMBER(7)=0
IF (CODER.EQ.7) TYPE 999
999 FORMAT(' CARRIER CODES')
OWN1='c'
MONKEY=0
c
c Begin loop
c
DO 2700 Y=1,LIMIT(15)
Z6=RLMAP(ICA2+Y)
IF (Z6.EQ.0) GOTO 2700
DIR=MOD(Y,2)*2-1
H1=J1TS(ICA2H+Y)
IF (RMAP(Z6).EQ.'X') H1=H1+1
IF (H1.GT.8) H1=8
C
ORIG=Z6
DO 2600 TURN=1,2
IF ((TURN.EQ.2).AND.(H1.LE.4)) GOTO 2700 !MOVE AT 1/2 SPEED
P='NS'
N=0
Z7=Z6
AB=RMAP(Z6)
IF ((AB.NE.'c').AND.(AB.NE.'X')) GOTO 1800
C
C MOVE SELECTION
C
IFO=CODEFU(Y+ICA2-1500)
ILA=CODELA(Y+ICA2-1500)
IF (H1.EQ.8) GOTO 100
IFO=8
ILA=IPORT(Z6)
GOTO 1300
C
C IFO=7: RANDOM DIRECTION
C IFO=6: HEADING TOWARDS STATION
C IFO=8: DAMAGED
C IFO=9: STATIONED
C
C DOES A NEW CODE NEED TO BE SELETED? 800:YES, 1300:NO
C
100 GOTO (200,300,400,500) IFO-5
GOTO 800
C
200 GOTO 1300
C
300 GOTO 800
C
400 IF (H1.EQ.8) GOTO 800
GOTO 1300
C
500 DO 600 I=1,70
IF (TARGET(I).EQ.0) GOTO 600
IF ((EMAP(TARGET(I)).EQ.'O').AND.(IDIST(Z6,TARGET(I)).LE.10))
1 GOTO 1300
600 CONTINUE
DO 700 I=1,10
700 IF (IDIST(Z6,LOCI(I,2)).LE.10) GOTO 1300
GOTO 800
C
C NEW CODE SELECTION
C
800 DO 1200 J=1,10
IF (LOCI(J,2).EQ.0) GOTO 1200
LOC=LOCI(J,2)
KDORK=0
ID=500
DO 900 K=1,70
IF (OWNER(K).NE.2) GOTO 900
IF (IDIST(X(K),LOC).GE.ID) GOTO 900
ID=IDIST(X(K),LOC)
IF (ID.LT.10) GOTO 1200
KDORK=X(K)
900 CONTINUE
DO 1000 K=ICA2+1,ICA2+LIMIT(15)
IS=RLMAP(K)
IF (IS.EQ.0) GOTO 1000
IF (IDIST(IS,LOC).GE.ID) GOTO 1000
IF (CODEFU(K-1500).NE.9) GOTO 1000
ID=IDIST(IS,LOC)
IF (ID.LT.10) GOTO 1200
KDORK=IS
1000 CONTINUE
IF (KDORK.EQ.0) GOTO 1200
1100 IF (IDIST(KDORK,LOC).LT.1) GOTO 1200
LOC=LOC+IARROW(MOV(LOC,KDORK)+1) !**
IF (IDIST(KDORK,LOC).GT.19) GOTO 1100
AD=EMAP(LOC)
IF ((AD.NE.' ').AND.(AD.NE.'.')) GOTO 1100
IFO=6
ILA=LOC
GOTO 1300
1200 CONTINUE
C
C RANDOM DIRECTION SELECTION
C
IF (IFO.EQ.7) GOTO 1300
IFO=7
KDORK=0
ILA=irand(8)+1 !**
C
C NOW PICK THE MOVE SPECIFIED BY IFO AND ILA
C
1300 IF (IFO.EQ.8) GOTO 1500
IF (IFO.NE.7) GOTO 1400
MOVE=ILA
GOTO 1700
1400 IF (IFO.NE.6) GOTO 1600
IF (ILA.NE.Z6) GOTO 1500
IFO=9
GOTO 1600
1500 MOVE=PATH(Z6,ILA,DIR,OKC,FLAG)
GOTO 1700
1600 IF (Z6.NE.ILA) MOVE=MOV(Z6,ILA)
IF (Z6.EQ.ILA) MOVE=irand(8)+1 !**
C
C MOVE CORRECTION
C
1700 AGGR=0
IF ((NUMBER(7).GT.3).AND.(IFO.NE.9)) AGGR=5
MOVE=MOVCOR(IFO,TURN,Z6,MOVE,H1,1,AGGR,'c',1,DIR,-1,ORIG,8)
IF (IFO.EQ.7) ILA=IABS(MOVE)
CODEFU(Y+ICA2-1500)=IFO
CODELA(Y+ICA2-1500)=ILA
IF (CODER.EQ.7) TYPE 998,IFO,ILA
998 FORMAT(1X,I)
C
C MOVE EVALUATION
C
Z6=Z6+IARROW(IABS(MOVE)+1)
IF (OMAP(Z7).NE.'*') RMAP(Z7)=OMAP(Z7)
AB=RMAP(Z6)
IF (AB.EQ.'.') GOTO 2000
IF (AB.EQ.'X') GOTO 2100
IF ((AB.GE.'A').AND.(AB.LE.'T')) GOTO 1900
TYPE 997,OWN1,Z6,AB
997 FORMAT(' ENEMY ',A1,' AT ',I4,' RAN AGROUND ON ',A1)
1800 H1=0
GOTO 2200
1900 H2=30
P='SE'
OWN2=AB
CALL FIND(OWN2,Z6,Z8,H2)
CALL FGHT(Z6,H1,H2,'c',OWN2)
CALL FIND(OWN2,Z6,Z8,H2)
IF (H1.LE.0) GOTO 2200
2000 RMAP(Z6)=OWN1
2100 RLMAP(Y+ICA2)=Z6
J1TS(Y+ICA2H)=H1
IF (TURN.EQ.1) NUMBER(7)=NUMBER(7)+1
2200 N=0
IF (P.EQ.'SE') CALL SENSOR(Z6)
DO 2300 I=1,LIMIT(10)
IF (Z7.NE.RLMAP(I+2000)) GOTO 2300
IF (N+1.GT.H1) THEN
IF (RMAP(Z7).NE.'X') RLMAP(I+2000)=0
GOTO 2300
ENDIF
N=N+1
RLMAP(I+2000)=Z6
2300 CONTINUE
IF (H1.LE.0) GOTO 2400
MONKEY=Y
GOTO 2500
2400 RLMAP(Y+ICA2)=0
CODEFU(Y+ICA2-1500)=0
CODELA(Y+ICA2-1500)=0
J1TS(ICA2H+Y)=0
2500 CALL SONAR(Z6)
2600 CONTINUE
2700 CONTINUE
LIMIT(15)=MONKEY
RETURN
END
FUNCTION CITFND(Z6)
C
C FIND CITY AT LOCATION Z6, RETURN INDEX INTO X()
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,70
100 IF (X(I).EQ.Z6) GOTO 200
IF (.NOT.PASS) RETURN
call topmsg ( 3, 'CITFND ERROR' )
RETURN
200 CITFND=I
RETURN
END
SUBROUTINE CITYCT
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
NUMBER(9)=0
DO 100 I=11,18
100 NUMBER(I)=0
DO 200 I=1,70
IF (OWNER(I).NE.2) GOTO 200
NUMBER(9)=NUMBER(9)+1
IF (PHASE(I).LE.0) GOTO 200 !HANDLES JUST CAPTURED CITY
INDEXX=INDEX(PHASE(I))
NUMBER(INDEXX)=NUMBER(INDEXX)+1
200 CONTINUE
C
C NOW LET NUMBER(10)=LAST FILLED SLOT IN TARGET
C
DO 300 I=70,1,-1
IF (TARGET(I).EQ.0) GOTO 300
NUMBER(10)=I
GOTO 400
300 CONTINUE
NUMBER(10)=0
400 RETURN
END
SUBROUTINE CITYPH(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)