⟦dab075714⟧

TextFile

ccc shipmv - this subroutine handles player's ship moves
	subroutine shipmv (  acraloc, acrahit, num, own1, hitmax )
c
c synopsis
c
	IMPLICIT INTEGER(A-Z)

	include 'common.h'
C
	logical fatal
 
	do 2600 y=1,limit(num)
	loc=acraloc+y
	if (movedflag(loc).ne.0) goto 2600
	z6=rlmap(loc)
	if (z6.eq.0) goto 2600
	if ((mode.eq.1).and.(poschk(z6,own1).eq.0)) goto 2600
	movedflag(loc)=1

	do 2500 iturn=1,2
	loc=acraloc+y
	z6=rlmap(loc)
	if (z6.eq.0) goto 2600
	jit=acrahit+y
	h1=j1ts(jit)
	if ((iturn.eq.2).and.(h1.le.hitmax/2)) goto 2600
	z7=z6
	ab=rmap(z6)
c 
c	Check to see if ship was destroyed becuase the city
c	it was in was captured
c
	if ((ab.eq.own1).or.(ab.eq.'O')) goto 100
	call head ( own1, y, loc, z6, h1 )
	call topmsg ( 2, 'was destroyed' )
	call cflush
	call delay(30)
	goto 1500

100	if ((iturn.eq.1).and.(ab.eq.'O')) h1=h1+1
comment	repair if in port
	if (h1.gt.hitmax) h1=hitmax
	call stasis(z6,loc)
200	mycod=mycode(loc)
comment	get my function code
	if (mycod.eq.0) goto 900
comment	if zero, skip ahead
	if ((mycod.ne.9997).or.((own1.ne.'T').and.(own1.ne.'C')))
     1	goto 500
comment	check transports and carriers
	n = 0
comment	for overloading
	nt = 2
	ia = 1
	ib=limit(1)
	if (own1.ne.'C') goto 300
	nt=1
	ia=501
	ib=limit(2)+500
300	do 400 j=ia,ib
400	if (rlmap(j).eq.z6) n=n+1
	if (n.lt.nt*h1) goto 500
	mycode(loc)=0
	goto 900

500	if ((mycod.lt.101).or.(mycod.gt.6108)) goto 1100
	if (mycod.le.6000) goto 600
	if (mycod.gt.6100) goto 700
	goto 1100

600	z6=z6+iarrow(mov(z6,mycod)+1)
comment	destination move
	goto 800

700	z6=z6+iarrow(mycod-6100+1)
comment	directional move
800	ad=rmap(z6)
	if (((ad.eq.'.').or.(ad.eq.'O')).and.(order(z6).eq.0)) goto 1100
	z6=z7
900	call sector(pmap(1))
1000	call ltr(z6,iturn)
	call mve ( own1, mdate, y, loc, jit, z6, z7, disas, z6-iadjst )
	if (disas.eq.-2) goto 200
c 
c	Move evaluation. z6 = to, z7 = from, check out new location
c
1100	if (omap(z7).ne.'*') rmap(z7)=omap(z7)
comment	remove unit from map
	ac = rmap ( z6 )
	ao = omap ( z6 )
	if (z6.eq.mycode(loc)) mycode(loc)=0
comment	arrived at destination
	if ( ac .ne. 'O' ) goto 1200
comment	is it our city?
	call topmsg ( 3, 'Ship is docked' )
comment	ship is in city
	call cflush
	call delay(30)
	goto 1800

1200	if ( ao .eq. '.' ) goto 1600
comment	if sea, skip ahead
1300	if (.not. fatal(4)) goto 2700
	if ((ac.ne.'+').and.(ao.ne.'*')) goto 2400
comment	check for enemy to fight
1400	continue
	ptr = 0
	call addidt ( own1, jnkbuf, ptr )
	call addstr( ' broke up on the shore', jnkbuf, ptr )
	jnkbuf ( ptr + 1 ) = '\0'
	call topmsg ( 2, jnkbuf )
	call cflush
	call delay(30)
	goto 1500

1600	if (ac.ne.'.') goto 2400
	rmap(z6)=own1
comment	normal move
1800	rlmap(loc)=z6
	j1ts(jit)=h1

1900	if ((own1.ne.'T').and.(own1.ne.'C')) goto 2500
	n=0
comment	if we're carring something, bring it along
	ia=0
comment	set up for transport
	ib=limit(1)
	nt=2
	if (own1.ne.'C') goto 2000
	ia=500
comment	set up for carrier
	ib=limit(2)
	nt=1
2000	do 2300 i=ia+1,ia+ib
comment	find pieces and move them
	if (rlmap(i).ne.z7) goto 2300
	if (n+1.gt.nt*h1) goto 2050
	rlmap(i)=z6
	n=n+1
	goto 2300
2050	if (rmap(z7).eq.'O') goto 2300
	rlmap(i)=0
c
c	Tell about peices lost when ship went down
c
	ptr = 0
	if (own1.eq.'C') goto 2100
	call addstr ( 'Army # ', jnkbuf, ptr )
	goto 2200
2100	continue
	call addstr ( 'Fighter # ', jnkbuf, ptr )
2200	continue
	call addint ( i - ia, jnkbuf, ptr )
	call addstr ( ' was sunk', jnkbuf, ptr )
	jnkbuf ( ptr + 1 ) = '\0'
	call topmsg ( 2, jnkbuf )
	call cflush
	call delay(30)
2300	continue
	goto 2500

2400	if ((ac.ge.'A').and.(ac.le.'T')) then
		 if (.not.fatal(2)) goto 2700
		endif
	h2=30
comment	going to fight another unit
	own2=ac
	call find(own2,z6,z8,h2)
	call fght(z6,h1,h2,own1,own2)
	call find(own2,z6,z8,h2)
	if (h1.le.0) goto 1500
	rmap(z6)=own1
comment	put us on the map
	if ((own2.ge.'a').and.(own2.le.'t')) call sonar(z6)
	if (ao.eq.'.') goto 1800
	rmap(z6)=ao
comment	won the battle, but...
	if ((own2.ge.'a').and.(own2.le.'t')) call sonar(z6)
	call topmsg ( 2, 'Your ship successfully clears the
     * enemy from the beach before, CRUNCH!, grounding itself' )
	call cflush
	call delay(30)

1500	rlmap(loc)=0
comment	kill my unit
	mycode(loc)=0
	call sensor(z6)
	h1=0
	goto 1900

2500	call sensor(z6)
2600	continue
	return
c
c	Recover from fatal moves
c
2700	z6=z7
comment	restore old location
	rmap(z6)=ab
comment	restore map
	goto 900
comment	try again
	end
DataMuseum.dk

DKUUG/EUUG Conference tapes

⟦dab075714⟧ TextFile

Derivation

TextFile
