16.FOR

*MODULE 16
 
 
        SUBROUTINE ARMYMV
* THIS SUBROUTINE HANDLES USER ARMY MOVES
 
        INCLUDE 'COMMON.EMP/NOLIST'
 
        ITURN=1
        DO 1002 Y=1,LIMIT(1)
        Z6=S(Y)
        IF(Z6==0) GOTO 1002
        MYCOD=MYCODE(Y)
        IF((MODE==1).AND.(POSCHK(Z6))==0.) GOTO 1002
        Z7=Z6
        AB=A(1,Z6)
        IF((MYCOD#0).AND.(AB=='O')) GOTO 1050
        IF((AB=='A').OR.(AB=='T').OR.(AB=='O')) GOTO 1081
 1050   CALL CURSOR(200)
        CALL STROUT('ARMY #',0); CALL DECPRT(Y)
        CALL STROUT(' DESTROYED.   ',31)
        CALL CHAS(Y,0)
        GOTO 1002
 
 1081   IF(AB#'T') GOTO 1069
        DO 1300 I=1,8
 1300   IF(D1(Z6+IARROW(I))#'.') GOTO 1069
        GOTO 1002
 
 1069   IF(MYCOD==0) GOTO 1083
        IF(MYCOD#100) GOTO 1084
        Z6=Z6+IARROW(JIGGLE(Z6,Y))
        GOTO 1085
 1084   CALL STASIS(Z6,Y)
 6314   MYCOD=MYCODE(Y)
        IF(MYCOD==0) GOTO 1083
        IF((MYCOD<100).OR.(MYCOD>6108)) GOTO 1003
        IF(MYCOD>6100) GOTO 1086
        IF(MYCOD<=6000) GOTO 1089
        GOTO 1003
 1089   Z6=Z6+IARROW(MOV(Z6,MYCOD))
        GOTO 1087
 1086   Z6=Z6+IARROW(MYCOD-6100)
 1087   AD=A(1,Z6)
        IF(((AD=='+').OR.(AD=='T')).AND.(ORDER(Z6)==0))GOTO 1085
        Z6=Z7
        CALL SECTOR(2)
        CALL STSOUT(MYCOD)
 1083   CALL SECTOR(2)
        CALL LTR(Z6,ITURN)
        CALL HEAD('A',Y,Z6)
 1640   CALL MVE('A',MDATE,Y,1,Z6,Z7,DISAS,Z6-IADJST)
        IF(DISAS==-2) GOTO 6314         !JUST PUT INTO STASIS
 
 
* MOVE EVALUATION
 1085   IF((A(1,Z7)#'T').AND.(D1(Z7)#'*')) CALL CHANGE(Z7,D1(Z7),1)
        IF(Z6==MYCODE(Y)) CALL CMYCOD(Y,0)
        AC=A(1,Z6)
        IF(AC=='T') GOTO 1006
        IF(DISAS==1)GOTO1001
        IF((A(1,Z7)#'T').OR.(D1(Z6)#'.')) GOTO 1007
        CALL CURSOR(100)
        CALL STROUT('YOU ARE INCAPABLE OF ATTACK WHILE
     & ON A TRANSPORT.   ',31)
        CALL STROUT('YOUR ARMY JUMPED INTO THE BRINY AND DROWNED.   ',31)
        GOTO 1001
 1007   IF((AC#'.').AND.(AC#'+')) GOTO 1004
        IF(AC#'.') GOTO 1010
        CALL CURSOR(100)
        CALL STROUT('YOUR ARMY MARCHED DUTIFULLY INTO THE
     & SEA AND DROWNED.   ',31)
        GOTO 1001
 1010   CALL CHANGE(Z6,'A',1)
 
 1006   CALL CHAS(Y,Z6)
        GOTO 1003
 1004 H1=1
        IF(D1(Z6)#'*') GOTO 1039
        DO 1200 IY=1,70
        IF(X(IY)#Z6) GOTO 1200
        IF(OWNER(IY)#1) GOTO 1070
        CALL CHANGE(Z6,'O',1)
        CALL CURSOR(100)
        CALL STROUT('BASTARDO! YOU ATTACKED YOUR OWN CITY! YOUR   ',31)
        CALL STROUT('IMPERTINENT ATTACKING ARMY WAS LIQUIDATED.   ',31)
        GOTO 1001
 1070   IF(RAN(C1)<.5) GOTO 1071
        CALL CURSOR(100)
        CALL STROUT('THE SCUM DEFENDING THE CITY HAS CRUSHED   ',31)
        CALL STROUT('YOUR ATTACKING BLITZKRIEGER!   ',31)
        GOTO 1200
 1071   CALL CURSOR(0)
        CALL STROUT('CITY #',0); CALL DECPRT(IY)
        CALL STROUT(' HAS BEEN SUBJUGATED!   ',31)
        CALL STROUT('THE LEADERS OF THE RESISTANCE HAVE BEEN
     & EXECUTED.   ',31)
        CALL STROUT('THE ARMY HAS BEEN DISPERSED TO ENFORCE
     & IRON CONTROL.   ',31)
        CALL CHANGE(Z6,'O',1)
        IF(OWNER(IY)#2) GOTO 5943
        CALL SONAR(Z6)
        PHASE(IY)=0
        DO 5944 I=1,70
        IF(TARGET(I)==Z6) GOTO 5943
        IF(TARGET(I)#0) GOTO 5944
        TARGET(I)=Z6
        GOTO 5943
 5944   CONTINUE
 5943   OWNER(IY)=1
 
 1200   CONTINUE
        GOTO 1001
 1039 OWN1='A'
        OWN2=AC
        H1=1
        H2=30
        CALL FIND(OWN2,Z6,Z8,H2)
        CALL FGHT(Z6,H1,H2,OWN1,OWN2)
        CALL FIND(OWN2,Z6,Z8,H2)
        IF(H1<=0)GOTO1001
         CALL CHANGE(Z6,D1(Z6),1)
        IF((OWN2>='1').AND.(OWN2<='8')) CALL SONAR(Z6)
        AC=A(1,Z6)
        GOTO 1007
 1001   CALL CHAS(Y,0)
        CALL CMYCOD(Y,0)
 1003   IF(DISAS#1) CALL SENSOR(Z6)
        IF(DISAS==1) CALL SENSOR(Z7)
 1002   CONTINUE
        RETURN
        END