|
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