|
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