DataMuseum.dk

top - metrics - download

    Length: 4814 (0x12ce)
    Types: TextFile
    Names: »mve.f«

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

TextFile

ccc mve - handle player move mode
	subroutine mve(own1,xxxmdate,relnum,num,n2,z6,z7,disas,jursor)
c
c	inputs:
c		own1 = char of piece (ie: 'a' for army)
c		xxxmdate = round number
c		relnum = relative piece number to type
c		num = piece index to rlmap
c		n2 = piece index to hits
c		z6 = location, return new location
c		z7 = old location
c		disas = 0:ok, -2:stasis
c		jursor = current cursor
c
	IMPLICIT INTEGER(A-Z)

	include 'common.h'
C
	disas=0
c
c	Get command character with no echo
c
100	call sector ( pmap ( 1 ))
	ib = j1ts ( n2 )
	call head ( own1, relnum, num, z6, ib )
comment	display header
	call cursor ( jursor )
200	e = char(getchx())
	call topmsg ( 2, 0 )
comment	clear line
	call topmsg ( 3, 0 )
comment	clear line
	call cflush
c 
c	Look at the command
c
	z7 = z6
	do 300 i = 1, 9
	ind = i
300	if ( e .eq. kbtbl ( ind )) goto 400
	goto 500
comment	command is not a direction
400	z6 = z6 + kbfudg ( ind )
	goto 4200

500	end = 15
	if ( pass ) end = 20
	do 600 i = 1, end
600	if ( e .eq. comman ( i )) goto 700
	i = 0
c
c	s, r, i, k, o, l, f, g, p, h, y, t, v, j, ?,  0,  0, u, n, +
c
700	goto ( 900, 1000, 1100, 1500, 1900, 2000, 2300, 2400, 2500, 2600,
     *	2700, 2800, 2900, 3200, 3300, 800, 800, 3800, 3900, 2600 ) i
800	goto 100
c 
c	s: put to sleep
c
900	if ( rmap ( z6 ) .eq. 'O' ) return
	mycode ( num ) = 50
	return
c 
c	r: random movement
c
1000	if ( own1 .ne. 'A' ) goto 100
comment	only for armies
	mycode ( num ) = 100
	z6 = z6 + iarrow ( jiggle ( z6, num ) + 1 )
	return
c 
c	i: put in directional stasis
c
1100	call cursor(jursor)
comment	cuz of clear lines above
	e=char(getchx())
	do 1200 i=1,9
	if (e .eq. kbtbl(i)) goto 1300
1200	continue
	goto 1400
1300	mycode(num)=cmytbl(i)
1400	if (mycode(num).eq.0) goto 100
	disas=-2
	return
c 
c	k: kill stasis number on piece
c
1500	mycode(num)=0
comment	zero function code for anything

	if (own1.ne.'T') goto 1700
comment	if transport, wake armies aboard
	do 1600 j=1,500
1600	if (rlmap(j).eq.z6) mycode(j)=0
	goto 100
1700	if (own1.ne.'C') goto 100
comment	if carrier, wake fighters aboard
	do 1800 j=501,700
1800	if (rlmap(j).eq.z6) mycode(j)=0
	goto 100
c 
c	o: cancel auto move mode
c
1900	continue
	if ( .not. automv ) goto 1913
	automv = .false.
	call topmsg ( 3, 'Auto move mode canceled' )
	goto 100
1913	continue
	call topmsg ( 3, 'Not in auto mode!' )
	goto 100
C 
C L: SET UP CITY STASIS NUMBERS
C
2000	IF (OMAP(Z6).NE.'*') GOTO 2300
comment	BETTER BE A CITY
	E=char(GETCHX())
	DO 2100 I=1,9
	IF (E .EQ. KBTBL(I)) GOTO 2200
2100	CONTINUE
	GOTO 4100
2200	FIPATH(CITFND(Z6))=CMYTBL(I)
comment	SET STASIS NUMBER
	DISAS=-2
	RETURN
C 
C F:
C
2300	CALL DIREC
	GOTO 4100
C 
C G: PUT T/C TO SLEEP
C
2400	IF ((OWN1.NE.'T').AND.(OWN1.NE.'C')) GOTO 100
	MYCODE(NUM)=9997
	DISAS=-2
	RETURN
C 
C P: SECTOR PRINTOUT
C
2500	ISEC=-1
	CALL SECTOR(PMAP(1))
	GOTO 4100
c 
c	h: get help
c
2600	call help
	e = char(getchx())
	isec = -1
	goto 4100
C 
C Y: CHANGE PHASE OF A CITY
C
2700	CALL DIREC
	GOTO 4100
C 
C T: BLOCK PRINTOUT
C
C2800	CALL CLEAR
C	CALL BLOCK(PMAP(1))
C	ISEC=-1
C	GOTO 4100
C 
C V: SAVE GAME
C
C2900	CALL GAME(1,NUM)
comment	NOT SURE THIS WILL WORK AS PLAYERS EXPECT
2800	CONTINUE
2900	CALL DIREC
	GOTO 100
C 
C J: PUT IN EDIT MODE
C
3200	CALL EDIT(Z6)
	IF (MYCODE(NUM).EQ.0) GOTO 100
	DISAS=-2
	RETURN
c 
c	?: how many hits? loaded?
c
3300	if ((own1.eq.'A').or.(own1.eq.'F')) goto 100
	ib=j1ts(n2)
comment	display hits left
	ptr = 0
C	CALL sstrout ( ' Hits left:',10)
	n = 0
comment	count armies
	if ( own1 .ne. 'T' ) goto 3500
	do 3400 i = 1, 500
3400	if ( rlmap ( i ) .eq. z6 ) n = n + 1
	if ( n .eq. 0 ) goto 3700
cc	if (mode.eq.1) call tpos(3,1)
	call addint ( n, jnkbuf, ptr )
	if ( n .eq. 1 ) call addstr ( ' army', jnkbuf, ptr )
	if ( n .gt. 1 ) call addstr ( ' armies', jnkbuf, ptr )
	goto 1313

3500	if ( own1 .ne. 'C' ) goto 4100
	do 3600 i = 1, 200
comment	count fighters
3600	if ( rlmap ( i + 500 ) .eq. z6 ) n = n + 1
	if ( n .eq. 0 ) goto 3700
cc	if (mode.eq.1) call tpos(3,1)

	call addstr ( ' fighter', jnkbuf, ptr )
	if ( n .gt. 1 ) call addstr ( 's', jnkbuf, ptr )
1313	continue
	call addstr ( ' aboard', jnkbuf, ptr )
	jnkbuf(ptr + 1) = '\0'
	call topmsg ( 3, jnkbuf )
	call cflush
	goto 4100

3700	continue
comment	nothing aboard
cc	if (mode.eq.1) call tpos(3,1)
	call topmsg ( 3, 'Nothing aboard' )
	call cflush
	GOTO 4100
C 
C U: CALL REFERENCE MAP
C
3800	ISEC=-1
	CALL SECTOR(RMAP(1))
	GOTO 4100
C 
C N: CALL ENEMY MAP
C
3900	ISEC=-1
	CALL SECTOR(EMAP(1))
	GOTO 4100
C 
C +: BLOCK PRINT REF. MAP
C
4000	call clear
	call topini
	ISEC=-1
	CALL BLOCK(RMAP(1))
	E=char(GETCHX())
	GOTO 4100
C 
4100	call ltr(z6,2)
	call cflush
	goto 100
4200	if (order(z6).eq.0) goto 4300
cc	if (mode.eq.1) call tpos(3,1)
	call topmsg ( 3, 'You cannot move onto the edge of the world' )
	z6 = z7
	goto 4100
4300	return
	end