⟦be35d5926⟧

TextFile

	subroutine troopm
c
c	This subroutine handles enemy troop transport moves
c 
	IMPLICIT INTEGER(A-Z)

	include 'common.h'
C
	integer tttc(-1:20,0:50)

	monkey = 0
	number ( 5 ) = 0
	if ( coder .eq. 5 ) print 999
999	format(' Troop transport codes')

	do 2300 y=1,limit(13)
	z6=rlmap(itt2+y)
	if (z6.eq.0) goto 2300
	monkey=y
	dir=mod(y,2)*2-1
comment	set dir to 1 or -1 consistently
	ab=rmap(z6)
	h1=j1ts(itt2h+y)
	if (ab.eq.'X') h1=h1+1
	if (h1.gt.3)    h1=3
c 
c	Now compute the number of armies aboard the troop transport
c
	numarm=0
	do 100 i=1,limit(9)
100	if (z6.eq.rlmap(iar2+i)) numarm=numarm+1
	if (numarm.gt.6) numarm=6
comment	max # armies = 6
 
	orig=z6
	do 2200 iturn=1,2
	p=0
	z7=z6
	ab=rmap(z6)
	if ((iturn.eq.2).and.(h1.le.1)) goto 2300
c
c	Move selection
c
	ifo=codefu(y+itt2-1500)
	ila=codela(y+itt2-1500)
c 
c	300 is the statement number where the ifo and ila are
c	processed to come up with a move, which is then fed thru movcor
c	to come up with a final move.
c 
c	take care of damaged ships or just repaired ships.
c	(damaged ships will have an ifo of 8)
c 
	if (h1.lt.3) goto 200
	if (ifo.eq.8) ifo=0
	goto 300
200	ifo=8
	if (ila.eq.0) goto 250
	if (rmap(ila).eq.'X') goto 1300
250	ila=iport(z6)
	goto 1300
c 
c ifo=10  move toward unexplored territory, location specified by ila
c ifo=7   move in a constant direction specified by ila
c ifo=9   move toward an unowned city specified by ila
c ifo=0-6 ila specifies location of where to move, either
c	an army producing city or an army looking for a 't'.
c	it could also be a direction. ifo is the number of armies on
c	board the troop transport.
c 
300	if (ifo.lt.7) ifo=numarm
	if (numarm.eq.0) ifo=0
	if ((ifo.eq.10).and.(emap(ila).ne.' ')) goto 1000
	if (ifo.eq.10) goto 1300
	if (ifo.eq.7) goto 1350
	if (ifo.ne.9) goto 500
c 
c	ifo=9
c
	do 400 i=1,70
	if (target(i).ne.ila) goto 400
	move=0
	if ((iturn.eq.2).and.(idist(z6,ila).eq.1)) goto 1600
	goto 1300
400	continue
	if ((idist(z6,ila).lt.10).and.(edger(ila).lt.8).and.(irand(100).gt.10))
     1 goto 1300
c
c	It seems that it's target is no longer on the hit list,
c	meaning it was captured.
c 
500	if (ifo.le.2) goto 600
	if (ifo.eq.3) then
	 if (irand(100).lt.96) goto 600
	endif
	if (ifo.eq.4) then
	 if (irand(100).lt.90) goto 600
	endif
	goto 800
comment	select a target
c
c	Select an army producing city and move towards it.
c	pick the closest one.
c
600	if (ila.eq.0.or.ila.gt.500) goto 650
	if ((codefu(ila).eq.3).and.(rlmap(iar2+ila).ne.0)) goto 1200
650	aflag=0
	id=35
670	do 700 i=1,70
	if ((x(i).eq.0).or.(owner(i).ne.2)) goto 700
	if (edger(x(i)).eq.0) goto 700
	if ((aflag.eq.0).and.(phase(i).ne.1)) goto 700
	if (idist(z6,x(i)).ge.id) goto 700
	do 680 j=1,limit(13)
	if (j.eq.y) goto 680
	if (codela(j+itt2-1500).ne.x(i)) goto 680
	if (idist(rlmap(j+itt2),x(i)).le.2) goto 700
680	continue
	id=idist(z6,x(i))
	ila=x(i)
700	continue
	if (id.ne.35) goto 1300
	if (aflag.eq.1) goto 1000
	aflag=1
	goto 670
c 
c	Perform troop transport to target city assignment
c
800	if (number(10).eq.0) goto 1000
	tm=0
	do 820 i=1,limit(13)
	if (rlmap(itt2+i).eq.0) goto 820
	if (i.eq.y) goto 810
	if (codefu(itt2-1500+i).eq.8) goto 820
	if (codefu(itt2-1500+i).le.3) goto 820
810	tm=tm+1
	if (codefu(itt2-1500+i).eq.9) codefu(itt2-1500+i)=0
	tttc(tm,0)=i
820	continue
	cm=0
	do 840 i=1,number(10)
	if (target(i).eq.0) goto 840
	ila=target(i)
	if (edger(ila).eq.0) goto 840
	cm=cm+1
	tttc(0,cm)=ila
	tttc(-1,cm)=-1
	if (rmap(ila).eq.'O') tttc(-1,cm)=1
840	continue
	do 850 i=1,tm
	do 850 j=1,cm
	tttc(i,j)=idist(rlmap(itt2+tttc(i,0)),tttc(0,j))
850	continue

	ac='*'
860	min=1000
	do 880 i=1,tm
	if (tttc(i,0).eq.0) goto 880
	do 880 j=1,cm
	if (emap(tttc(0,j)).ne.ac) goto 880
	if (tttc(i,j).ge.min) goto 880
	if (tttc(-1,j).eq.0) then
	  do 870 k=1,cm
	  if (tttc(-1,k).eq.-1) goto 880
870	  continue
	endif
	move=path(rlmap(itt2+tttc(i,0)),tttc(0,j),1,okc,flag)
	if (flag.eq.0) then
	  tttc(i,j)=1000
	  goto 880
	endif
	min=tttc(i,j)
	ir=i
	ic=j
880	continue
	if (min.ne.1000) then
comment	don't change function if dest is <3 from old?
	  codefu(itt2-1500+tttc(ir,0))=9
	  codela(itt2-1500+tttc(ir,0))=tttc(0,ic)
	  call dist(rlmap(itt2+tttc(ir,0)),tttc(0,ic))
	  tttc(ir,0)=0
	  tttc(ir,ic)=1001
	  tttc(-1,ic)=0
	  goto 860
	endif
	ifo=codefu(itt2-1500+y)
	ila=codela(itt2-1500+y)
	if (number(9)+number(10).le.38) then
	  if (ifo.eq.9) goto 1500
	  goto 1000
	endif
	if (ac.eq.'*') then
	  ac='o'
	  goto 860
	endif
	if (ifo.eq.9) goto 1500
c 
c	Move towards unknown territory
c
1000	ifo=10
	ila=expl()
	if (ila.eq.0) goto 1100
	call dist(z6,ila)
	goto 1300
c 
c	Move in specified direction (ila specifies which)
c
1100	ifo=7
	ila=irand(8)+1
comment	**
	goto 1400
c 
c	Now pick a move according to ifo and ila
c
1200	move=0
	if (idist(z6,rlmap(iar2+ila)).eq.1) goto 1600
	move=mov(z6,rlmap(iar2+ila))
	goto 1500
1300	move=path(z6,ila,dir,okc,flag)
	if (flag.eq.0) goto 1100
	goto 1500
1350	if (number(10).eq.0) goto 1400
	if (irand(100).lt.40) goto 800
1400	move=ila
1500	aggr=-numarm
	if ((number(5).gt.10).and.(numarm.eq.0)) aggr=aggr+2
	explor=0
	if (ifo.gt.6) explor=1
	move=move*dir
	dest=-1
	if ((ifo.eq.9).or.(ifo.eq.10)) dest=ila
	move=movcor(ifo,iturn,z6,move,h1,1,aggr,'t',explor,dir,dest,orig,3)
	move=iabs(move)
	if (ifo.eq.7) ila=move
1600	codefu(itt2-1500+y)=ifo
	codela(itt2-1500+y)=ila
	z6=z6+iarrow(move+1)
comment	**
	if (coder.eq.5) print 997, ifo,ila
997	format(1x,i)
c 
	if (omap(z7).ne.'*') rmap(z7)=omap(z7)
	if (rmap(z6).eq.'.') goto 1700
	if (rmap(z6).eq.'X') goto 1800
	if ((rmap(z6).eq.'+').or.(omap(z6).eq.'*')) goto 1900
	ab=rmap(z6)
	if (coder.eq.5) print 996,ab
comment	fix this conditional, kludged
996	format(' attacking ',a1)
	if (ab.eq.'.') goto 1700
	p=1
	h2=30
	own1='t'
	own2=rmap(z6)
	call find(own2,z6,z8,h2)
	call fght(z6,h1,h2,own1,own2)
	call find(own2,z6,z8,h2)
	if (h1.le.0) goto 1900
	if (omap(z6).eq.'+') goto 1900
	j1ts(itt2h+y)=h1
1700	rmap(z6)='t'
1800	rlmap(itt2+y)=z6
	j1ts(itt2h+y)=h1
	if (iturn.eq.1) number(5)=number(5)+1
	goto 2000
1900	rlmap(itt2+y)=0
	j1ts(itt2h+y)=0
2000	n=0
	if (p.eq.1) call sensor(z6)
	do 2100 u=iar2+1,iar2+limit(9)
	if (rlmap(u).ne.z7) goto 2100
	if (n+1.gt.h1*2) then
	 if (rmap(z7).ne.'X') rlmap(u)=0
	 goto 2100
	endif
	n=n+1
	rlmap(u)=z6
2100	continue
	if (numarm.gt.2*h1) numarm=2*h1
	call sonar(z6)
2200	continue
2300	continue
	limit(13)=monkey
	return
	end
DataMuseum.dk

DKUUG/EUUG Conference tapes

⟦be35d5926⟧ TextFile

Derivation

TextFile
