EMPIRE.FOR

        PROGRAM DEBUG
         INCLUDE 'COMMON.EMP/NOLIST'
        DIMENSION COMSCN(40)
        DIMENSION LOPMAX(15)
        DIMENSION HITS(15),TIPE(15),CRAHIT(15),CRALOC(15)
        DATA COMSCN/'M','N','O','A','T','V','P','Y','C','L','H','J',
     & '1','R','@',0,0,0,0,0,'LO','NU','LI','TR','AR','TA','PA','A1',
     & 'T3','A0','CO','CH','Q0','Q','JE','CY','EX',0,0,0/
C
C  ARGUMENTS FOR PROD SUBROUTINE
        DATA HITS/1,1,0,3,2,3,0,0,0,8,0,8,0,0,12/
        DATA TIPE/1,2,0,3,4,5,0,0,0,6,0,7,0,0,8/
        DATA CRAHIT/0,0,0,0,ISUH,ITTH,0,0,0,ICRH,0,ICAH,0,0,IBAH/
        DATA CRALOC/0,IFI,0,IDE,ISU,ITT,0,0,0,ICR,0,ICA,0,0,IBA/
        DATA LOPMAX/500,200,0,200,200,100,0,0,0,100,0,100,0,0,100/

C       .FALSE. = BEGIN OF GAME
        CALL ECHOFF
        CALL ECHOON
        NCYCLE=1
        CALL GAME(.FALSE.,NUM)
C  IF YOU SAVED THE GAME IN THE MIDDLE OF A MOVE, DO THE ENEMY MOVE NOW.
        IF(NUM#0) GOTO 3000
C
C  COMMAND LOOP STARTS HERE.
  521   CALL CURSOR(0)
        CALL STROUT('YOUR ORDERS? ',10)
  520   CALL OUTCHR(BELL)
        ACCEPT 108, ORDERS
  108   FORMAT(A2)
        IF((SPECAL).AND.(ORDERS=='JE')) GOTO 35
        DO 100 I=1,20
  100   IF(ORDERS==COMSCN(I)) GOTO 101
        IF(PASS) 102,521
  101   GOTO (1,2,3,4,5,6,7,8,9,10,11,12,13,14,15) I
        GOTO 521
    1   GOTO 1000                       !START MOVE
    2   CALL CURSOR(100)
        CALL STROUT('NUMBER OF FREE ENEMY MOVES:',0)
        ACCEPT 525,NCYCLE
        GOTO 3049
    3   GOTO 1000
    4   CALL OUTCHR(FF)
        ISEC=-1
        GOTO 521
    5   CALL BLOCK(2)
        GOTO 521
    6   CALL GAME('END',0)
        CALL STROUT('GAME SAVED',11)
        GOTO 521
    7   CALL SECTOR(2)
        GOTO 521
    8   CALL DIREC
        GOTO 521
    9   GOTO 3000
   10   CALL DIREC
        GOTO 521
   11   CALL OUTCHR(FF)
        CALL HELP
        ISEC=-1
        GOTO 521
   12   MODE=1
        Z6=0
        CALL TEST3(Z6)
        GOTO 521
   13   MODE=0
        JECTOR=-1
        GOTO 521
   14   CALL CURSOR(50)
        CALL STROUT(' ROUND #',0)
        TYPE 104,MDATE
  104   FORMAT('+',I4,1X$)
        GOTO 521
   15   ADDS=.TRUE.
        FF=ADDSFF
        GOTO 521
C
  102   DO 250 I=21,40
  250   IF(ORDERS==COMSCN(I)) GOTO 251
        GOTO 521
  251   GOTO (21,22,23,24,25,26,27,28,29,30,31,32,33,34,35,36,37) I-20
        GOTO 521
   21   TYPE 111, ((LOCI(I,J),J=1,11),I=1,10)
        GOTO 521
   22   TYPE 6500,NUMBER
        GOTO 521
   23   TYPE 6499, LIMIT
        GOTO 521
   24   TYPE 6498,TROOPT
        GOTO 521
   25   TYPE 6500,ARMTOT
        GOTO 521
   26   TYPE 6500,TARGET
        GOTO 521
   27   TYPE 6497, SUCCESS,FAILURE
        GOTO 521
   28   CALL BLOCK(1)
        GOTO 521
  29    GOTO 521
   30   CALL BLOCK(0)
        GOTO 521
   31   ACCEPT 525,I1
        ACCEPT 525,I2
  525   FORMAT(G)
        TYPE 527, (CODE(J),J=I1,I1+I2)
        GOTO 521
   32   ACCEPT 523,CODER
        GOTO 521
   33   CALL SECTOR(0)
        GOTO 521
   34   CALL SECTOR(1)
        GOTO 521
   35   ACCEPT 108,JECTOR
        JECTOR=IPHASE(JECTOR)
        CALL SECTOR(0)
        ISEC=JECTOR
        GOTO 521
   36   GOTO 521
   37   E=EXPL(DUMMY)
        TYPE 522,E
        GOTO 521
C
  522   FORMAT('+EXP VALUE:',I5$)
 6499   FORMAT(1X,8I4)
 6498   FORMAT(1X,5I6)
 6500   FORMAT(1X,10I5)
 6497   FORMAT(' SUCCESS:',I6,' FAILURE:',I6)
  527   FORMAT(1X,10I7)
  111   FORMAT(11I5)
  523   FORMAT(G)
C
C  BEGIN MOVEMENT
C
C *******************
C USER MOVE
C
 1000   IF(MODE==0) GOTO 8001
        IF(JECTOR#-1) GOTO 997; CALL OUTCHR(FF); JECTOR=0; ISEC=-1
  997   ISTART=ISEC
        IF(ISEC<0) ISTART=0
 8001   DO 8000 JECT=ISTART,ISTART+7
        IF(MODE==0) GOTO 8003
        JECTOR=JECT; IF(JECT>7) JECTOR=JECT-8
        LINE=KLINE(KI,JECTOR)
        IADJST=LINE+KI-300
 8003   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,0,3,'D',3)
        CALL ARMYMV
        CALL FIGHMV
        IF(MODE==0) GOTO 8005
 8000   CONTINUE
 8005   CONTINUE
C
C HARDWARE PRODUCTION
        DO 1020 Y=1,70
        IF(OWNER(Y)#1)GOTO1020
        IF(PHASE(Y)==14) GOTO 1020
        CALL SENSOR(X(Y))
        IF(PHASE(Y)==8) GOTO 1050
        IF((PHASE(Y)<1).OR.(PHASE(Y)>15)) GOTO 1050
        IF(MOD(PHASE(Y),2)==0) GOTO 1024
        IF(MOD(PHASE(Y),5)==0) GOTO 1024
        IF(PHASE(Y)==1) GOTO 1024
C  BAD PHASE
 1050   CALL OUTCHR(FF); ISEC=-1; TYPE 2313,X(Y)
 2313   FORMAT(' LTR READOUT AROUND CITY AT',I5)
        I1=MODE; MODE=0; CALL LTR(X(Y)); MODE=I1
        CALL STROUT('WHAT ARE YOUR PRODUCTION DEMANDS FOR THIS CITY? ',10)
        CALL PHASIN(Y)
        GOTO 1020
 1024   IF(MDATE<FOUND(Y)) GOTO 1020
        FOUND(Y)=MDATE+PHASE(Y)*5
        CALL CURSOR(200)
        CALL STROUT('CITY #',0); CALL DECPRT(Y)
        CALL STROUT(' AT',10); CALL DECPRT(X(Y))
        CALL STROUT(' HAS COMPLETED A',0)
        K=PHASE(Y)
D       TYPE 765, HITS(K),X(Y),TIPE(K),CRAHIT(K),CRALOC(K),
D     &LOPMAX(K),K
D  765  FORMAT(' HITS:',I5,' X(Y):',I5,' TIPE(K):',I5,' CRAHIT(K):',I5,/
D     &,' CRALOC(K):',I5,' LOPMAX(K):',I5,' K:',G)
        CALL PROD(HITS(K),X(Y),LIMIT(TIPE(K)),CRAHIT(K),CRALOC(K),
     &LOPMAX(K),AR2S,TIPE(K)+1,RANGE)
 1020   CONTINUE
 3000   CONTINUE
C
 
C
C ***************************
COMPUTER MOVE
C
 3049   DO 3001 I=1,NCYCLE
C
        CALL ARMCNT(ARMTOT,CODE,TARGET,LIMIT)
C
        CALL HERE('TROOP T')
        CALL TROOPM(DUMMY)
        CALL HERE('ARMY')
        CALL ARMYEN(DUMMY)
C
        CALL HERE('CARRIER')
        CALL CARIER
        CALL HERE('BATTLESHIP')
        IF(GETTAB("120,-1)==0) CALL SLEEP(300)
        CALL ENEMYM('8',12,IBA2H,IBA2,8)
        CALL HERE('CRUISER')
        CALL ENEMYM('6',8,ICR2H,ICR2,6)
        CALL HERE('SUBMARINE')
        CALL ENEMYM('4',2,ISU2H,ISU2,4)
        CALL HERE('DESTROYER')
        CALL ENEMYM('3',3,IDE2H,IDE2,3)
C
 
        CALL HERE('FIGHTER')
        CALL FIGHTR
C
        CALL CURSOR(0)
        CALL STROUT('YOUR ORDERS? ',10)
C
C PRODUCTION OF ENEMY HARDWARE
        CALL CITYCT
        CALL CITYPH
        DO 3299 Y=1,70
        IF((X(Y)==0).OR.(OWNER(Y)#2)) GOTO 3299
        CALL SONAR(X(Y))
        IF(MDATE<FOUND(Y)) GOTO 3299
        FOUND(Y)=MDATE+5*PHASE(Y)
        K=PHASE(Y)
        J=0
        IF(K==1) J=1
        CALL PROD(HITS(K),X(Y),LIMIT(TIPE(K)+8),CRAHIT(K)+IDE2H,
     &CRALOC(K)+1500,LOPMAX(K),AR2S,J,RANG)
 3299   CONTINUE
        MDATE=MDATE+1
        IF(MDATE/4*4==MDATE) CALL GAME ('END',0)
 3001   CONTINUE
        NCYCLE=1
C
        IF(WIN==1.) GOTO 520
        IF(WIN==2.) GOTO 500
        N=0
        DO 501 J=1,70
  501   IF(OWNER(J)==1) N=N+1
        IF(N<30) GOTO 500
        IF(NUMBER(9)>N/2) GOTO 500
        TYPE 502
  502   FORMAT(' THE COMPUTER ACKNOWLEDGES DEFEAT. DO'/
     &' YOU WISH TO SMASH THE REST OF THE ENEMY?')
        ACCEPT 503,ORDERS
  503   FORMAT(A1)
        IF(ORDERS#'Y') STOP
        TYPE 504
  504   FORMAT(' THE ENEMY INADVERTANTLY REVEALED ITS CODE USED FOR'/
     &' RECEIVING BATTLE INFORMATION. YOU CAN DISPLAY WHAT THEY''VE'/
     &' LEARNED THROUGH THE COMMAND ''JE'', <CR><LF>, FOLLOWED BY THE'/
     &' SECTOR NUMBER.')
        CH=10.
        SPECAL=.TRUE.
        WIN=2.
        GOTO 521
  500   IF((NUMBER(9)>0).OR.(LIMIT(9)>0)) GOTO 516
        CALL OUTCHR(FF)
        TYPE 4960
 4960   FORMAT(' THE ENEMY IS INCAPABLE OF DEFEATING YOU.'/
     &' YOU ARE FREE TO RAPE THE EMPIRE AS YOU WISH.'/
     &' THERE MAY BE, HOWEVER, REMNANTS OF THE ENEMY FLEET'/
     &' TO BE ROUTED OUT AND DESTROYED.')
        WIN=1.
        GOTO 521
  516   DO 519 I=1,70
  519   IF(OWNER(I)==1) GOTO 520
        DO 517 I=1,LIMIT(1)
  517   IF(S(I)#0) GOTO 520
        CALL OUTCHR(FF)
        WIN=1.
        TYPE 518
  518   FORMAT(' YOU HAVE BEEN RENDERED INCAPABLE OF'/
     &' DEFEATING THE RAMPAGING ENEMY FASCISTS! THE'/
     &' EMPIRE IS LOST. IF YOU HAVE ANY SHIPS LEFT, YOU MAY'/
     &' ATTEMPT TO HARASS ENEMY SHIPPING.')
        GOTO 521
        END
C
        SUBROUTINE HERE(MSG)
        INCLUDE 'COMMON.EMP/NOLIST'
        DOUBLE PRECISION MSG
        IF(.NOT.PASS) RETURN
        CALL CURSOR(40)
        TYPE 100,MSG
  100   FORMAT('+',A10,$)
        RETURN
        END


.