|
|
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 g
Length: 5547 (0x15ab)
Types: TextFile
Names: »game.f«
└─⟦b20c6495f⟧ Bits:30007238 EUUGD18: Wien-båndet, efterår 1987
└─⟦this⟧ »EUUGD18/General/Empire/game.f«
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