|
|
DataMuseum.dkPresents historical artifacts from the history of: DKUUG/EUUG Conference tapes |
This is an automatic "excavation" of a thematic subset of
See our Wiki for more about DKUUG/EUUG Conference tapes Excavated with: AutoArchaeologist - Free & Open Source Software. |
top - metrics - downloadIndex: T a
Length: 5112 (0x13f8)
Types: TextFile
Names: »armymv.f«
└─⟦b20c6495f⟧ Bits:30007238 EUUGD18: Wien-båndet, efterår 1987
└─⟦this⟧ »EUUGD18/General/Empire/armymv.f«
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