⟦0196bd1f6⟧

TextFile

 	program empire
c
c This program is a war game simulation for video terminals.
c The game was originally written outside of Digital, probably a university.
c This version of the game was made runnable on Digital Equipment VAX/VMS
c FORTRAN by conversion from the TOPS-10/20 sources available around fall 1979.
c After debugging it, numerous changes have been made.
c
c Now that you are the proud owner of the source and you are all gung ho
c to do things right, there are a few things you should be aware of.
c Unfortunately, there are many magic numbers controlling how many different
c kinds of units can exist and how many of each, so think well before you
c attempt to add another unit type. Also, "slight changes" to the way the units
c work will typically have a fairly devastating affect on the computers
c strategy.  If you are interested in really hacking this, there is a plenty
c of room for enhanced computer strategy.  As you'll see, there are some
c very good debugging tools tucked inside, and you will soon discover weak
c points and bugs, that up until you, have remained problems (all the previous
c programmers got lazy or lost interest).  Finally, please be careful with
c the version number and identification at start up to avoid confusion of
c ongoing versions with private copies.  If you make a change don't remove
c the major version id, but rather add something like (V4.0 site.1 20-JUL-80).
c
	IMPLICIT INTEGER(A-Z)

	include 'common.h'
C

	character orders
	character odor ( 2 )
	equivalence ( odor ( 1 ), orders )

	integer i, count, status

	call ttinit
CC	call initst
CC	call gaminit ( 'empire' )
	call rndini
	win = 0
	ncycle = 1
	pass = .false.
	automv = .false.

	call clear
	call topini
	call tpos ( 7, 1 )
	call ver
comment	Special message
cc	call strpos ( 8, 1, 'Detailed directions are in EMPIRE.DOC' )
cc	call cr
	call cflush
c
c	-1/0/1 = restore/start/save game
c
	call game ( -1, num )
comment	Try to restore a previous game
c 
c	Command loop starts here
c
100	continue
	call round ( mdate )
	if ( automv ) goto 4200
comment	Don't ask if in auto move
	call bell
comment	Wake up sleepy commanders
	call topmsg ( 1, 'Your orders? ' )
	call cflush
	call getstr ( jnkbuf, 80, count )
	call addcnt ( 1, count )
	if ( count .gt. 2 ) goto 100
	orders = '  '
	call tupper ( jnkbuf, count )
	odor ( 1 ) = jnkbuf ( 1 )
	if ( odor ( 1 ) .eq. '\26' ) goto 1900
comment	Quit command?
	if ( count .eq. 2 ) odor ( 2 ) = jnkbuf ( 2 )
c
c	Special hack for je command
c
	if ((specal) .and. (orders .eq. 'JE')) goto 3900
c
c	Lookup command
c
	do 200 i = 1,20
200	if ( orders .eq. char(comscn ( i ))) goto 300
	if ( pass ) goto 2200
	call bell
	goto 100
c
c	m, n, o, s, t, v, p, y, c, l, h, j, 1, r, @, q , +, a
c
300	goto ( 400, 500,  600, 700, 800, 900, 1000, 1100, 1200, 1300,
     *	1400, 1500,  1600, 1700, 1800, 1900, 2000, 2100 ) i
	goto 100

400	goto 4200
comment	m - move mode

500	continue
comment	n - free enemy moves
	call topmsg ( 2, 'Number of free enemy moves: ' )
	call addcnt ( 2, 5 )
	call cflush
	call readi(ncycle)
	goto 5300

600	goto 4200
comment	o - move mode (synomn for m)

700	call clear
comment	s - clear the screen
	call topini
	isec = -1
	goto 100

800	call block ( pmap ( 1 ))
comment	t - print out map
	goto 100

900	call game ( +1, 0 )
comment	v - save game
	call topmsg ( 3, 'Game Saved.' )
	goto 100

1000	call sector ( pmap ( 1 ))
comment	p - print out a sector
	goto 100

1100	call direc
comment	y - error msg
	goto 100

1200	goto 5200
comment	c - give one free enemy move

1300	call direc
comment	l - error msg
	goto 100

1400	call help
comment	h - help
	isec = -1
	goto 100

1500	mode = 1
comment	j - edit mode
	z6 = 0
	call edit ( z6 )
	goto 100

1600	mode = 0
comment	1 - set mode=0
	jector = -1
	goto 100

1700	continue
comment	r - display round number
	ptr = 0
	call addstr ( 'Round # ', jnkbuf, ptr )
	call addint ( mdate, jnkbuf, ptr )
	jnkbuf ( ptr + 1 ) = '\0'
	call topmsg ( 2, jnkbuf )
	call cflush
	goto 100

1800	continue
comment	@ - restore game
	jector = -1
	call clear
	call topini
	call game ( -1, num )
	if ( num .ne. 0 ) goto 5200
comment	**
	goto 100

1900	continue
comment	q - quit
	call topmsg ( 3, 0 )
comment	clear line
	call topmsg ( 2, 'QUIT - Are you sure? ' )
	call cflush
	e = char(getchx())
	call putc ( e )
	call cflush
	call addcnt ( 2, 1 )
	if ( e .ne. 'y' .and. e .ne. 'Y' ) goto 100
	call clear
	call topini
	call cflush
	call empend

2000	e = char(getchx())
comment	+ - turn on pass
	if ( e .eq. '+' ) pass = .true.
	if ( e .eq. '-' ) pass = .false.
comment	or off
	goto 100

2100	automv = .true.
c	call topmsg(2, 'Now in Auto-Mode')
comment	a - turn on auto move mode
	goto 4200

2200	do 2300 i=21,40
comment	debugging commands
2300	if (orders.eq.char(comscn(i))) goto 2400
	goto 100
c
c	lo,nu,li,tr,ar,ta,pa,a1,t3,a0,co,ch,q0, q1,je,cy,ex
c
2400	goto (2500,2600,2700,2800,2900,3000,3100,3200,3300,
     1 3400,3500,3600,3700,3800,3900,4000,4100) i-20
	goto 100

2500	print 986, ((loci(i,j),j=1,11),i=1,10)
comment	lo -
	goto 100

2600	print 989, number
comment	nu -
	goto 100

2700	print 991, limit
comment	li -
	goto 100

2800	print 990, troopt
comment	tr -
	goto 100

2900	print 989, armtot
comment	ar -
	goto 100

3000	print 989, target
comment	ta -
	goto 100

3100	print 988, succes,failur
comment	pa -
	goto 100

3200	call block(rmap(1))
comment	a1 - print reference map
	goto 100

3300	goto 100
comment	t3 - ignored

3400	call block(emap(1))
comment	a0 - print computer's map
	goto 100

3500	call readi(i1)
comment	co -
	call readi(i2)
993	format(i)
	print 987, (codefu(j),codela(j),j=i1,i1+i2)
	goto 100

3600	call readi(coder)
comment	ch - set coder variable
	goto 100

3700	isec = -1
comment	q0 - display enemy map sector
	call topmsg ( 2, 'Sector? ' )
	call cflush
	call addcnt ( 2, 1 )
	jector = iphase ( getchx())
	call sector ( emap ( 1 ))
	goto 100

3800	isec=-1
comment	q1 - display reference map sector
	call topmsg ( 2, 'Sector? ' )
	call cflush
	call addcnt ( 2, 1 )
	jector = iphase ( getchx())
	call sector(rmap(1))
	goto 100

3900	isec=-1
	call topmsg ( 2, 'Sector? ' )
	call cflush
	jector=iphase(getchx())
comment	je - display enemy sector of choice
	if (jector.lt.0.or.jector.gt.9) goto 3900
	call sector(emap(1))
	isec=-1
	goto 100

4000	goto 100
comment	cy - ignored

4100	ex=expl()
comment	ex - disply explore function value
	print 992,ex
	goto 100
 
992	FORMAT('+EXP VALUE:',I5$)
991	FORMAT(1X,8I4)
990	FORMAT(1X,5I6)
989	FORMAT(1X,10I5)
988	FORMAT(' SUCCESS:',I6,' FAILURE:',I6)
987	FORMAT(1X,10I7)
986	FORMAT(11I5)
985	format(i)
c 
c	Begin movement
c
c	User move
c 
4200	if ( mode .eq. 0 ) goto 4400
	if ( jector .ne. -1 ) goto 4300
	call clear
	call topini
	jector = 0
	isec = -1
4300	istart = isec
	if ( isec .lt. 0 ) istart = 0
4400	do 4500 i = 1, 1500
4500	movedflag ( i ) = 0
	do 4700 ject = istart, istart + 9
	if ( mode .eq. 0 ) goto 4600
	jector = ject
	if ( ject .gt. 9 ) jector = ject - 10
	line = kline ( ki, jector )
	iadjst = line + ki - 300
4600	call shipmv ( itt, itth, 5, 'T', 3 )
	call shipmv ( ica, icah, 7, 'C', 8 )
	call shipmv ( iba, ibah, 8, 'B', 12 )
	call shipmv ( icr, icrh, 6, 'R', 8 )
	call shipmv ( isu, isuh, 4, 'S', 2 )
	call shipmv ( ide, ideh, 3, 'D', 3 )
	call armymv
	call fighmv
	if ( mode .eq. 0 ) goto 4800
4700	continue
4800	continue
c 
c	Hardware production
c
	do 5100 y = 1, 70
	if ( owner ( y ) .ne. 1 ) goto 5100
	if ( phase ( y ) .eq. 14 ) goto 5100
	call sensor ( x ( y ))
	if ( phase(y).eq.8) goto 4900
	if (( phase(y) .lt. 1 ) .or. ( phase(y) .gt. 15 )) goto 4900
	if ( mod ( phase ( y ), 2 ) .eq. 0 ) goto 5000
	if ( mod ( phase ( y ), 5 ) .eq. 0 ) goto 5000
	if ( phase ( y ) .eq. 1 ) goto 5000
c
c	City phase incorrect or we just took it
c
4900	continue
	call clear
	call topini
	isec = -1
	ptr = 0
	call addstr ( 'Readout around city at ', jnkbuf, ptr )
	call addint ( x ( y ), jnkbuf, ptr )
	call bufpos ( 4, 1, jnkbuf, ptr )
	call cr
	call cr
	i1 = mode
	mode = 0
	call ltr ( x ( y ), 0 )
	mode = i1
	call cr
	call strout ( 'What are your production demands for this city? ' )
	call cflush
	call phasin ( y, e )
	call putc ( e )
	call cflush
	call delay ( 45 )
	call clear
	call topini
	call cflush
	goto 5100
5000	if ( mdate .lt. found ( y )) goto 5100
	found ( y ) = mdate + phase ( y ) * 5
c
c	A city has built something; build up a line
c
	ptr = 0
	call addstr ( 'City # ', jnkbuf, ptr )
	call addint ( y, jnkbuf, ptr )
	call addstr ( ' at ', jnkbuf, ptr )
	call addint ( x(y), jnkbuf, ptr )
	call addstr ( ' has completed a', jnkbuf, ptr )
	k = phase ( y )
c	print 983, hits ( k ), x ( y ), tipe ( k ), crahit ( k ), craloc ( k ),
c     1 lopmax ( k ), k
c983	format(' hits:',i5,' x(y):',i5,' tipe(k):',i5,' crahit(k):',i5,/
c     1 ,' craloc(k):',i5,' lopmax(k):',i5,' k:',i)
	call prod ( hits ( k ), x ( y ), limit ( tipe ( k )),
     *	crahit ( k ), craloc ( k ), lopmax ( k ), ar2s,
     *	tipe ( k ) + 1, range, jnkbuf, ptr )

	jnkbuf ( ptr + 1 ) = '\0'
	call topmsg ( 3, jnkbuf )
	call cflush
	call delay(30)
5100	continue
5200	continue
c 
c	Computer move
c 
5300	continue
c d	call pme_init
	do 5500 i=1,ncycle

	call armcnt
	call troopm

	call topmsg ( 1, 'My turn, thinking..' )
	call cflush

	call armyen
 
	call topmsg ( 1, 0 )
comment	Blank the thinking
	call cflush

	call carier
	call enemym ( 'b', 12 ,iba2h, iba2, 8 )
	call enemym ( 'r', 8 ,icr2h, icr2, 6 )
	call enemym ( 's', 2 ,isu2h, isu2, 4 )
	call enemym ( 'd', 3 ,ide2h, ide2, 3 )
 
	call topmsg ( 1, 'My turn, thinking...' )
	call cflush
	call fightr
c
c	Age known enemy army locations
c
	do 5350 k = 1, 10
	if ( loci ( k, 1 ) + 21 .gt. mdate ) goto 5350
comment	If data is not old
	do 5340 j = 1, 11
5340	loci ( k, j ) = 0
comment	Zero that line
5350	continue
c 
c	Production of enemy hardware
c
	call cityct
	do 5400 y = 1, 70
	if ((x(y) .eq. 0) .or. (owner(y) .ne. 2)) goto 5400
	call sonar ( x ( y ))
	if ((phase(y) .le. 0) .or. (mdate .lt. found(y))) goto 5380
	k = phase ( y )
	j = 0
	if ( k .eq. 1 ) j = 1
	ptr = 0
comment	To fake out prod
	call prod(hits(k),x(y),limit(tipe(k)+8),crahit(k)+ide2h,
     *	craloc(k)+1500,lopmax(k),ar2s,j,rang, jnkbuf, ptr )
5380	if ((phase(y).le.0).or.(mdate.ge.found(y))) call cityph(y)
5400	continue
	mdate = mdate + 1
	newrnd = 1
	if (mod(mdate,4).eq.0.or.(mdate.gt.160)) call game (+1,0)
5500	continue
c d	call pme_exit
	ncycle = 1
c 
	if ( win .eq. 1 ) goto 100
	if ( win .eq. 2 ) goto 5700
	n = 0
	do 5600 j = 1, 70
5600	if (owner(j) .eq. 1) n = n + 1
	if (n.lt.30) goto 5700
	if (number(9).gt.n/2) goto 5700
	call topmsg ( 1, 'The computer acknowledges defeat. Do' )
	call topmsg ( 2, 'you wish to smash the rest of the enemy? ')
	call cflush
	call addcnt ( 2, 1 )
	if ( char(getchx()) .ne. 'Y' ) call empend
	call cr
	call strout ( 'The enemy inadvertantly revealed its code used for' )
	call cr
	call strout ( 'receiving battle information. You can display what' )
	call cr
	call strout ( 'they''ve learned through the command ''JE''(cr)(lf),' )
	call cr
	call strout ( 'followed by the sector number.' )
	call cflush
	specal = .true.
	win = 2
	automv = .false.
	goto 100
5700	if ((number(9).gt.0).or.(limit(9).gt.0)) goto 5800
	call clear
	call topini
	call strout ( 'The enemy is incapable of defeating you.' )
	call cr
	call strout ( 'You are free to rape the empire as you wish.' )
	call cr
	call strout ( 'There may be, however, remnants of the enemy fleet' )
	call cr
	call strout ( 'to be routed out and destroyed.' )
	win = 1
	automv = .false.
	goto 100
5800	do 5900 i=1,70
5900	if (owner(i).eq.1) goto 100
	do 6000 i=1,limit(1)
6000	if (rlmap(i).ne.0) goto 100
	call clear
	call topini
	win = 1
	call strout ( 'You have been rendered incapable of' )
	call cr
	call strout ( 'defeating the rampaging enemy fascists! The' )
	call cr
	call strout ( 'empire is lost. If you have any ships left, you may' )
	call cr
	call strout ( 'attempt to harass enemy shipping.' )
	automv = .false.
	goto 100
	end
DataMuseum.dk

DKUUG/EUUG Conference tapes

⟦0196bd1f6⟧ TextFile

Derivation

TextFile
