DataMuseum.dk

Presents historical artifacts from the history of:

DKUUG/EUUG Conference tapes

This is an automatic "excavation" of a thematic subset of
artifacts from Datamuseum.dk's BitArchive.

See our Wiki for more about DKUUG/EUUG Conference tapes

Excavated with: AutoArchaeologist - Free & Open Source Software.


top - metrics - download
Index: T g

⟦fcb7f98aa⟧ TextFile

    Length: 5547 (0x15ab)
    Types: TextFile
    Names: »game.f«

Derivation

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

TextFile

	subroutine game ( icode, num )
c
c	This subroutine reads in the game map and initializes the
c	map arrays it also saves and restores the game from the
c	save file using the codes: -1 = restore, 0 = init, 1 = save
c
	IMPLICIT INTEGER(A-Z)

	include 'common.h'
C
	data ifile /'G','A','M','E','S',':','E','M','R','A','\0'/

	if ( icode ) 1800, 100, 1500
comment	-1/0/+1 = restore/init/save
c
c	Here to initialize the game
c
100	do 200 i = 1, 70
comment	clear arrays
	x ( i ) = 0
	found ( i ) = 0
	owner ( i ) = 0
	phase ( i ) = 0
	target ( i ) = 0
	fipath ( i ) = 0
200	continue
	do 300 i=1,1500
	codefu ( i ) = 0
	codela ( i ) = 0
	mycode ( i ) = 0
300	continue
	do 400 i = 1, 200
	range ( i ) = 0
	rang ( i ) = 0
400	continue
	do 500 i = 1, 500
500	ar2s ( i ) = 0
	do 600 i = 1, 3000
	rlmap ( i ) = 0
600	continue
	do 700 i = 1, 6000
	emap ( i ) = ' '
	pmap ( i ) = ' '
700	continue

	mode = 1
	isec = -1
	call time ( pamela )
c	call date ( reeed )
c	reeed ( 5 ) = reeed ( 5 ) + o'40'
comment	make lower case
c	reeed ( 6 ) = reeed ( 6 ) + o'40'
	

	version = 6
comment	version of data within emsave.dat
	ib=1
c
c	Map selection. Pick one of the maps randomly. Maps are in files a-f
C
C	We don't have the maps anyway.
C
c	try = 0
comment	try again 
c900	try = try + 1
c	ifile ( 10 ) = 'a'
c	ifile ( 10 ) = ifile ( 10 ) + irand ( 10 )
c
ccomment	currently six maps, allow 4 extra
c	if ( try .le. 8 ) goto 1000
ccomment	try again if you don't have them all
	call cr
	call strout ( 'Generating new map...') 
	call cflush
	call gen
	try = 0
	goto 1100
c1000	open ( unit=1, file=ifile, access = 'SEQUENTIAL',
c     *	form = 'UNFORMATTED', type = 'OLD', readonly, err=900 )
c	read ( 1 ) ( d ( I ), i = 1, 223 )
c	read ( 1 ) ( d ( I ), i = 224, 446 )
c	read ( 1 ) ( d ( I ), i = 447, 667 )
c	close ( unit = 1 )
c
c	City and a-map initialization
c
1100	call initia ( try )
comment	transfer map from d() into mapbuf
1200	c = irand ( 70 ) + 1
comment	** pick our city
	id = irand ( 70 ) + 1
comment	pick enemy city
	if (x(c) .eq. 0 .or. x(id) .eq. 0) goto 1200
	if (x(c) .eq. x(id)) goto 1200
	if ((edger(x(c)) .eq. 8) .or. (edger(x(id)) .eq. 8)) goto 1200
	if ( try .ne. 0 ) goto 1300
1250	pcon = cities(int(rmap(x(id))))
	econ = cities(int(rmap(x(c))))
	if (pcon.le.100) goto 1200
comment	note rmap is really owner
	if (econ.le.100) goto 1200
comment	from map generator
	ptot=pcon/100+mod(pcon,100)
	etot=econ/100+mod(econ,100)
	if (ptot.le.etot) goto 1275
	i = c
	c = id
	id = i
	goto 1250
1275	diff=min(11,((etot*2*100+45)/ptot)/100)-1
	if ( pcon .eq. econ ) diff = 3
	call cr
	ptr = 0
	call addstr ( 'Difficulty estimate: ', jnkbuf, ptr )
	call addint ( diff, jnkbuf, ptr )
	call addstr ( ' where 1 is easy and 10 is most challenging.',
     *	jnkbuf, ptr )
	jnkbuf ( ptr + 1 ) = '\0'
	call cr
	call strout ( jnkbuf )
1300	z6 = x ( id )
	ptr = 0
	call addstr ( 'Your city is at ', jnkbuf, ptr )
	call addint ( x ( id ), jnkbuf, ptr )
	jnkbuf ( ptr + 1 ) = '\0'
	call cr
	call cr
	call strout ( jnkbuf )
	call cr
	do 1400 i=1,6000
1400	rmap ( i ) = omap ( i )
	rmap(z6) = 'O'
comment	mark it on map
	rmap(x(c)) = 'X'
	call sonar(x(c))
comment	do sensor scans
	call sensor(z6)
	mode = 0
	call ltr ( z6, 0 )
comment	show the city
	mode=1
	call strout ( 'What do you demand that this city produce? ' )
	call cflush
	owner(id)=1
	mdate = 0
	call phasin(id,e)
	call putc ( e )
	call cflush
	owner ( c ) = 2
	phase ( c ) = 1
	found ( c ) = 5
	z6 = x ( id )
	return
comment	return to orders mode
c
c	Here to save a game
c 
1500	if (mode .ne. 0) goto 1600
	call cr
	call strout ( 'A few moments please...' )
	call cr
	call cflush
1600	continue
	call time ( pamela )
c	call date ( reeed )
c	reeed ( 5 ) = reeed ( 5 ) + ' '
comment	make lower case
c	reeed ( 6 ) = reeed ( 6 ) + ' '
	open ( unit=1, file='EMSAVE', access='SEQUENTIAL',
     *	form='UNFORMATTED', status='UNKNOWN' )
	write ( 1 ) limit, mdate, version, pamela, reeed
	write ( 1 ) emap, rmap, pmap, omap
	write ( 1 ) rlmap
	write ( 1 ) troopt
	write ( 1 ) number
	write ( 1 ) x, target, found
	write ( 1 ) owner, phase
	do 1700 i = 1, 16
1700	call write ( iotab ( I ), limit ( I ), i )
	write ( 1 ) j1ts
	write ( 1 ) num
	write ( 1 ) loci
	write ( 1 ) nshift, fipath
	close ( unit=1 )
	return
c
c	Here to restore a game
c
1800	continue
	call cr
	call strout ( 'A few moments please...' )
	call cflush
	open ( unit=1, file='EMSAVE', access='SEQUENTIAL',
     *	form='UNFORMATTED', status='OLD',err=2200)
	read(1) limit,mdate,version,pamela,reeed
	read(1) emap,rmap,pmap,omap
	if(version.ge.6) goto 1850
	version=6
comment	translate to new version
	do 1850 i=1,6000
	if((emap ( I ).ge.'1').and.(emap ( I ).le.'8')) call tran(emap ( I ))
	if((rmap ( I ).ge.'1').and.(rmap ( I ).le.'8')) call tran(rmap ( I ))
	if((pmap ( I ).ge.'1').and.(pmap ( I ).le.'8')) call tran(pmap ( I ))
1850	continue
	read(1) rlmap
	read(1) troopt
	read(1) number
	read(1) x,target,found
	read(1) owner,phase
	do 1900 i=1,16
1900	call read ( iotab ( i ), limit ( i ), i )
	if (version.le.4) read(1) (j1ts ( I ),i=1,1500)
	if (version.ge.5) read(1) j1ts
	read(1) num
	read(1) loci
	read(1) nshift,fipath
2000	close(unit=1)
	ptr = 59
c	encode ( ptr, 996, jnkbuf ) pamela, reeed
c996	FORMAT('Ready to resume game terminated at ', 8A1,
c     *	' on ', 7a1, '19', 2a1 )
	print 996
996	FORMAT('Ready to resume game terminated at ???')
	call cr
	call bufout ( jnkbuf, ptr )

	mode=1
	isec=-1
	return

2200	continue
	call cr
	call strout ( 'Unable to open save file, EMSAVE.DAT,
     * Starting new game.' )
	call cflush
	goto 100	
	end