DataMuseum.dk

Presents historical artifacts from the history of:

DKUUG/EUUG Conference tapes

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about DKUUG/EUUG Conference tapes

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - metrics - download
Index: T a

⟦daa6b7db1⟧ TextFile

    Length: 5112 (0x13f8)
    Types: TextFile
    Names: »armymv.f«

Derivation

└─⟦b20c6495f⟧ Bits:30007238 EUUGD18: Wien-båndet, efterår 1987
    └─⟦this⟧ »EUUGD18/General/Empire/armymv.f« 

TextFile

	subroutine armymv
c
c	This routine handles player's army moves
c 
	IMPLICIT INTEGER(A-Z)

	include 'common.h'
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 cflush
	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
comment	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)
comment	do random move
	goto 1200
500	call stasis(z6,y)
comment	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)
comment	do a move toward a location
	goto 900
800	z6=z6+iarrow(mycod-6100+1)
comment	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
comment	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
comment	getting on a transport?
	if ((rmap(z7) .ne. 'T') .or. (ao .ne. '.')) goto 1300
	if (.not. fatal(1)) goto 2800
comment	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 cflush
	call delay(30)
	goto 2500

1300	if (ao .ne. '.') goto 1600
comment	make sure not sea
	if (.not. fatal(1)) goto 2800
comment	ask about drowning
	if (ac .ne. '.') goto 1800
	call topmsg ( 3, 'Your army marched dutifully into the
     * sea and drowned.' )
	call cflush
	call delay(30)
	goto 2500

1400	h1=30
comment	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
comment	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
comment	check if clear
	rmap(z6) = 'A'
comment	put army on the map
1700	rlmap(y) = z6
comment	record new location
	goto 2600
c
c	We're attacking something
c
1800	h1=1
comment	armies have one hit
	if (omap(z6) .ne. '*') goto 2400
	do 2300 iy=1,70
comment	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
comment	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 cflush
	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 cflush
	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 cflush
	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
comment	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
comment	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 cflush
	call delay(30)

2500	rlmap(y)=0
comment	"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
comment	go back to old location
	rmap(z6)=ab
comment	change it back to previous
	goto 1000
	end