⟦4d9e6fc0f⟧

TextFile

	subroutine armyen
c 
c	This subroutine handles enemy army moves
c 
	IMPLICIT INTEGER(A-Z)

	include 'common.h'
C
cc	integer irand

	monkey=0
	number(1)=0
	if (coder.eq.1) print 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
c
comment	set dir to 1 or -1
	dir=mod(y,2)*2-1
	p=0
c
comment	set ab=what is showing where the army is
	ab=rmap(z6)
	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

c
comment	look for targets, loci, tt's
400	goto 800

500	if (rmap(ila).eq.'X') goto 800	
c
comment	city has been captured
	goto 1600
c
comment	move

600	if (ila.eq.z6) goto 800
c
comment	arrived at enemy concentration
	goto 1600
c
comment	move

700	if (ila.gt.100) goto 800
c
comment	invalid value for ila
	if (codefu(ila+itt2-1500).ge.6) goto 1200
	if (rlmap(ila+itt2).eq.0) goto 1200
c
comment	tt sunk
	if (j1ts(ila+itt2h).lt.3) goto 1200		
c	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
c
comment	can't get to it
	ifo=1
	ila=target(i)
	goto 1800
c
comment	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) .or. (limit(13) .eq. 0)) goto 1400
c				added or here
c
comment	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
c
comment	tt doesn't exist
	if (j1ts(itt2h+i).lt.3) goto 1300
c
comment	damaged, i.e. unsuitable
	if (iabs(codefu(itt2+i-1500)).ge.6) goto 1300
	if (idist(z6,rlmap(itt2+i)).gt.20) goto 1300
c
comment	too far away
	move=path(z6,rlmap(itt2+i),dir,okb,flag)
	npath=npath+1
	if (flag.eq.0) goto 1300
comment	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

comment	if already ass'd direc
	ifo=0
	ila=irand(8)+1
comment	**
 
1500	move=ila
	i1=icorr(move-dir*3)
	if (rmap(z6+iarrow(i1+1)).ne.'+') move=i1
comment	**
	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)
comment	**
	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) print 998,ifo,ila
998	format(1x,7i,3x)
	z6=z6+iarrow(move1+1)
comment	**
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
comment	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 cflush
	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 cflush
	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
DataMuseum.dk

DKUUG/EUUG Conference tapes

⟦4d9e6fc0f⟧ TextFile

Derivation

TextFile
