15.FOR

        SUBROUTINE GAME(IZAP,NUM)
 
        INCLUDE 'COMMON.EMP/NOLIST'
 
        REAL REEED(2)
        INTEGER MAPTMP(0:2)
        INTEGER PPN,PRIV(5),IOTAB(16)
 
        DATA PHAZE/'A','F','D','S','T','R','C','B',1,2,4,5,6,10,12,15/
        DATA (MAPTMP(I),I=0,2)/'.','+','*'/
        DATA (IARROW(I),I=0,9)/0,1,-99,-100,-101,-1,99,100,101,0/
        DATA PRIV/0,"272230,"472227,0,0/
        DATA IOTAB/0,500,700,900,1100,1200,1300,1400,1500,2000,
     & 2200,2400,2600,2700,2800,2900/
        CALL ZEROST                     !ZERO START ADDRESS
        IF(IZAP) GOTO 180
        MODE=1
        ISEC=-1
        CALL MSTIME(M)
        CALL SETRAN(M/2*2+1)
        Z3=4
 
* SET PASS TRUE FOR PRIVELEGED USER
        PASS=.FALSE.
        I=INT(GETTAB(2,-1)*1.E+28)
        IF((I==4543105).OR.(I==4540533)) PASS=.TRUE.
 
  110 FORMAT(' PLEASE WAIT 7 DAYS FOR CREATION OF WORLD.(ABOUT'
     &,' A MINUTE OR 2)')
        IB=1
        CALL TRMOP2
*       CALL TRMOP("2010,-1,IB,IERR)
        CALL OUTCHR("32)
        TYPE 1349
 1349   FORMAT(1X,/////////////////)
        TYPE 2349
 2349   FORMAT(' EMPIRE, VERSION 3'/)
 2350   FORMAT(' THE DSKE: COMMITTEE SUCKS!'/)
*       CALL STROUT('DIRECTIONS ARE ON [29970,WBG]',1)
        CALL STROUT('COPYRIGHT 1978 BY WALTER BRIGHT',1)
        CALL STROUT('DIRECTIONS ARE ON HLP:EMPIRE.HLP',1)
        CALL STROUT('FOR QUESTIONS OR BUGS SEND MAIL TO [29970,WBG]',1)
        IF(ILDET('EMPIRE.DAT')==1) GOTO 130
        TYPE 170
        OPEN(UNIT=1,DEVICE='DSK',FILE='EMPIRE.DAT',ACCESS='SEQIN')
        READ(1) D
        READ(1) MAPS
        READ(1) TROOPT
        READ(1) LIMIT,MDATE,Z3,PAMELA,REEED,KLIP
        READ(1) NUMBER
        READ(1) X,TARGET,FOUND,OWNER,PHASE
        DO 20 I=1,16
20      CALL READ(IOTAB(I),LIMIT(I),I)
        READ(1) J1TS
        READ(1,END=450) NUM
        READ(1,END=450) LOCI
        READ(1,END=450) NSHIFT,FIPATH
  450   CLOSE(UNIT=1)
        TYPE  120,PAMELA,REEED
  120 FORMAT(' READY TO RESUME GAME TERMINATED AT ',A5,' ON ',
     &2A5/)
        IF(MDATE>200) TYPE 2350
        RETURN
  130   CONTINUE
        TYPE  110
C-----MAP SELECTION-------
        DO 7375 I=1,10
 7375   C1=RAN(C1)
      KILL=C1*5
        IFILE=-21279760320+32768*KILL
  140   OPEN(UNIT=1,DEVICE='GAM',FILE=IFILE,ACCESS='SEQIN')
        READ(1) D
C------- MAP FLIP AND KLIP------
        KLIP=0
C       KLIP=INT(RAN(C1)*2.)
        IF(RAN(C1)>.5) GOTO 7373
        DO 7374 I=0,145,5
        IX=295-I
        DO 7374 J=1,5
        JIX=D(I+J)
        D(I +J)=D(IX +J)
 7374   D(IX+J)=JIX
C-----CITY AND A-MAP INITIALIZATION--------
 7373   CALL INITIA
        CLOSE(UNIT=1)
  203   FORMAT(I4)
  365   C=INT(RAN(C1)*70.)+1
        ID=INT(RAN(C1)*70.)+1
        IF(X(C)==0.OR.X(ID)==0) GO TO 365
        IF(X(C)==X(ID))GOTO365
        IF((EDGER(X(C))==8.).OR.(EDGER(X(ID))==8.))GO TO 365
        Z6=X(ID)
        TYPE 103,X(ID)
  103 FORMAT(' YOUR CITY IS AT ',I4)
        CALL CHANGE(Z6,'O',1)
        CALL CHANGE(X(C),'X',1)
        CALL SONAR(X(C))
        CALL SENSOR(Z6)
        MODE=0
        CALL LTR(Z6)
        MODE=1
        CALL STROUT('WHAT DO YOU DEMAND THAT THIS CITY PRODUCE? ',10)
        OWNER(ID)=1
        MDATE=0
        CALL PHASIN(ID)
        MDATE=6
        OWNER(C)=2
        PHASE(C)=2
        FOUND(C)=5
        IBELL="034000000000
        TYPE 111,IBELL
  111 FORMAT(1X,A1)
        Z6=X(ID)
        RETURN
 
 
  180   IF(MODE==0) TYPE  170
  170   FORMAT(' A FEW MOMENTS PLEASE...'/)
  179   CONTINUE
        CALL TIME(PAMELA)
        CALL DATE(REEED)
        OPEN(UNIT=1,FILE='EMPIRE.DAT',ACCESS='SEQOUT')
        WRITE(1) D
        WRITE(1) MAPS
        WRITE(1) TROOPT
        WRITE(1) LIMIT,MDATE,Z3,PAMELA,REEED,KLIP
        WRITE(1) NUMBER
        WRITE(1) X,TARGET,FOUND,OWNER,PHASE
        DO 21 I=1,16
21      CALL WRITE(IOTAB(I),LIMIT(I),I)
        WRITE(1) J1TS
        WRITE(1) NUM
        WRITE(1) LOCI
        WRITE(1) NSHIFT,FIPATH
        CLOSE(UNIT=1)
        RETURN
        END
 
        SUBROUTINE READ(BEG,LIM,NUM)
        COMMON/LOCS/LOCS(1200)
        COMMON/CODE/CODE(1501:3000)
        COMMON/MYCOD/MYCOD2(750)
        COMMON/MISC1/TARGET(70),AR2S(1501:2000),RANGE(501:700),RANG
        INTEGER H,RANG(2001:2200),RANGE,TARGET,AR2S,CODE,BEG
        DO 100 J=BEG+1,BEG+LIM
        IF(MOD(J,5)==1) READ(1) LOCS((J+4)/5*2-1), LOCS((J+4)/5*2)
        IF((NUM<9).AND.(MOD(J,2)==1))READ(1)MYCOD2((J+1)/2)
        IF(NUM>8)READ(1)CODE(J)
        IF(NUM==9)READ(1)AR2S(J)
        IF(NUM==2)READ(1)RANGE(J)
        IF(NUM==10)READ(1)RANG(J)
  100   CONTINUE
        RETURN
        END
 
 
        SUBROUTINE WRITE(BEG,LIM,NUM)
        COMMON/LOCS/LOCS(1200)
        COMMON/CODE/CODE(1501:3000)
        COMMON/MYCOD/MYCOD2(750)
        COMMON/MISC1/TARGET(70),AR2S(1501:2000),RANGE(501:700),RANG
        INTEGER H,RANG(2001:2200),RANGE,TARGET,AR2S,CODE,BEG
        DO 100 J=BEG+1,BEG+LIM
        IF(MOD(J,5)==1) WRITE(1) LOCS((J+4)/5*2-1), LOCS((J+4)/5*2)
        IF((NUM<9).AND.(MOD(J,2)==1))WRITE(1)MYCOD2((J+1)/2)
        IF(NUM>8)WRITE(1)CODE(J)
        IF(NUM==9)WRITE(1)AR2S(J)
        IF(NUM==2)WRITE(1)RANGE(J)
        IF(NUM==10)WRITE(1)RANG(J)
  100   CONTINUE
        RETURN
        END


.