! Fortran version of Battleship -- 2002 December 6
       PROGRAM Battleship
       IMPLICIT NONE
       DIMENSION Mine(9,9), Theirs(9,9)
       INTEGER Mine, Theirs, ShowOut, Tries, iseed, IntRand, Lim19
       INTEGER mod, RandomShot, RimShot, GoodShot, BetterShot
       INTEGER ix, tx, zx, ro, co, here, thar, up, wide, tall
! StartGame
       iseed = 2233
       CALL Read3I(up)
       DO ix=1,up
         tx = IntRand(iseed,2)
         END DO
       DO ro=1,9 ! Zapit..
         DO co=1,9
           Mine(ro,co) = 0
           Theirs(ro,co) = 0
           END DO
         END DO
       DO ix=5,1,-1
         wide = ix
         IF (ix<2) wide = 2
         up = IntRand(iseed,2)
         tall = wide*up
         wide = wide*(1-up)
         DO
           here = IntRand(iseed,9-tall+up)
           thar = IntRand(iseed,10-wide-up)
           DO ro=tall+1-up,1,-1
             DO co=wide+up,1,-1
               IF (Mine(here+ro,thar+co)>0) THEN
                 here = -1
                 EXIT
                 END IF
               END DO
             IF (here<0) EXIT
             END DO
           IF (here>=0) THEN
             DO ro=tall+1-up,1,-1
               DO co=wide+up,1,-1
                 Mine(here+ro,thar+co) = ix
                 END DO
               END DO
             EXIT
             END IF
           END DO
         END DO
       ShowOut = 0
       CALL ShowArrays(Mine, Theirs, ShowOut)
       Tries = 40
! DoTurn
       DO ! forever..
         READ *,up
         IF (up>599) EXIT
         ShowOut = mod(ShowOut,100)
         IF (up==0) THEN
           CALL Read3I(up)
           PRINT *,"You played ",up
           END IF
         IF (up<0) up = 0
         tx = up/100
         up = mod(up,100)
         ro = up/10
         co = mod(up,10)
         ! PRINT *,"??",ShowOut,tx,up,ro,co, ShowOut/10, mod(ShowOut,10)
         IF (ShowOut*tx>0) THEN
           IF (tx==1) THEN ! got something, dunno what..
             Theirs(ShowOut/10, mod(ShowOut,10)) = 9
           ELSE
             CALL SunkIt(Theirs, tx, ShowOut/10, mod(ShowOut,10))
             END IF
           END IF
         up = 0
         ShowOut = 0
         IF (ro*co>0) THEN ! process this shot against me..
           ShowOut = Mine(ro,co)
           IF (ShowOut>5) THEN
             ShowOut = 1 ! repeat shot, just report hit
           ELSE IF (ShowOut>0) THEN
             Mine(ro,co) = ShowOut+5
             DO zx=Lim19(ro-4),Lim19(ro+4)
               tx = Mine(zx,co)
               IF (tx==ShowOut) up = up+1 ! not sunk yet
               END DO
             IF (up==0) THEN 
               DO zx=Lim19(co-4),Lim19(co+4)
                 tx = Mine(ro,zx)
                 IF (tx==ShowOut) up = up+1
                 END DO
               END IF
             IF (up>0) THEN
               ShowOut = 1
             ELSE IF (ShowOut<2) THEN
               ShowOut = 2
               END IF
             END IF
           END IF
         ro = 0
         co = BetterShot(Theirs) ! try to extend a line of hits
         IF (co==0) co = GoodShot(Theirs) ! try for near a hit
         IF (co==0) co = RimShot(Theirs) ! try for a rim
         IF (co==0) co = RandomShot(Theirs, iseed, Tries) ! no directed shots, try a random shot
         IF (co>0) THEN
           Theirs(co/10,mod(co,10)) = -1
           IF (mod(ro+co,2)>0) Tries = Tries-1
         ELSE 
           ShowOut = 9 ! huh? somebody cheated
           END IF
         ShowOut = ShowOut*100+co
         CALL ShowArrays(Mine, Theirs, ShowOut)
         END DO
       END PROGRAM

       SUBROUTINE SunkIt(Theirs, whom, rx, cx)
       IMPLICIT NONE
       DIMENSION Theirs(9,9)
       INTEGER Theirs, whom, rx, cx, ix, hi, lo
       ! PRINT *,"SunkIt", whom, rx, cx
       Theirs(rx,cx) = 9
       lo = rx-1
       DO
         IF (lo<1) EXIT
         IF (Theirs(lo,cx)<6) EXIT
         lo = lo-1
         END DO
       hi = rx+1
       DO
         IF (hi>9) EXIT
         IF (Theirs(hi,cx)<6) EXIT
         hi = hi+1
         END DO
       IF (hi-lo==whom+1) THEN
         DO ix=lo+1,hi-1
           Theirs(ix,cx) = whom
           END DO
       ELSE
         lo = cx-1
         DO 
           IF (lo<1) EXIT
           IF (Theirs(rx,lo)<6) EXIT
           lo = lo-1
           END DO
         hi = cx+1
         DO
           IF (hi>9) EXIT
           IF (Theirs(rx,hi)<6) EXIT
           hi = hi+1
           END DO
         IF (hi-lo==whom+1) THEN
           DO ix=lo+1,hi-1
             Theirs(rx,ix) = whom
             END DO
         ELSE
           Theirs(rx,cx) = whom
           END IF
         END IF
       END SUBROUTINE

       FUNCTION BetterShot(Theirs)
       IMPLICIT NONE
       DIMENSION Theirs(9,9)
       INTEGER BetterShot, Theirs, ro, co
       ! PRINT *,"Better"
       BetterShot = 0
       DO ro=1,9
         DO co=1,7
           IF (Theirs(ro,co)==0) THEN
             IF (Theirs(ro,co+1)>5) THEN
               IF (Theirs(ro,co+2)>5) THEN
                 BetterShot = ro*10+co
                 END IF
               END IF
             END IF
           END DO
         DO co=9,3,-1
           IF (Theirs(ro,co)==0) THEN
             IF (Theirs(ro,co-1)>5) THEN
               IF (Theirs(ro,co-2)>5) THEN
                 BetterShot = ro*10+co
                 END IF
               END IF
             END IF
           END DO
         END DO
       DO co=1,9
         DO ro=1,7
           IF (Theirs(ro,co)==0) THEN 
             IF (Theirs(ro+1,co)>5) THEN
               IF (Theirs(ro+2,co)>5) THEN
                 BetterShot = ro*10+co
                 END IF
               END IF
             END IF
           END DO
         DO ro=9,3,-1 
           IF (Theirs(ro,co)==0) THEN
             IF (Theirs(ro-1,co)>5) THEN
               IF (Theirs(ro-2,co)>5) THEN
                 BetterShot = ro*10+co
                 END IF
               END IF
             END IF
           END DO
         END DO
       END FUNCTION

       FUNCTION GoodShot(Theirs)
       IMPLICIT NONE
       DIMENSION Theirs(9,9)
       INTEGER GoodShot, Lim19, Theirs, ro, co, ix
       ! PRINT *,"Good"
       GoodShot = 0
       DO ro=1,9
         DO co=1,9
           IF (Theirs(ro,co)>5) THEN
             ix = Lim19(ro-1);
             IF (Theirs(ix,co)==0) GoodShot = ix*10+co
             ix = Lim19(ro+1);
             IF (Theirs(ix,co)==0) GoodShot = ix*10+co
             ix = Lim19(co-1);
             IF (Theirs(ro,ix)==0) GoodShot = ro*10+ix
             ix = Lim19(co+1);
             IF (Theirs(ro,ix)==0) GoodShot = ro*10+ix
             END IF
           END DO
         END DO
       END FUNCTION

       FUNCTION RimShot(Theirs)
       IMPLICIT NONE
       DIMENSION Theirs(9,9)
       INTEGER RimShot, Theirs, ix
       ! PRINT *,"Rim"
       RimShot = 0
       DO ix=1,4
         IF (Theirs(ix*2,1)==0) RimShot = ix*20+1
         IF (Theirs(ix*2,9)==0) RimShot = ix*20+9
         IF (Theirs(1,ix*2)==0) RimShot = ix*2+10
         IF (Theirs(9,ix*2)==0) RimShot = ix*2+90
         END DO
       END FUNCTION

       FUNCTION RandomShot(Theirs, iseed, Tries)
       IMPLICIT NONE
       DIMENSION Theirs(9,9)
       INTEGER RandomShot, Lim19, IntRand, Theirs, iseed, Tries
       INTEGER ro, co, cnt, mask, res
       res = 0
       cnt = IntRand(iseed, Tries)
       DO mask=0,2
         ! PRINT *,"Random: ",mask,cnt,Tries
         DO ro=1,9
           DO co=1,9
             IF (mod(ro+co,2)+(mask/2)>0) THEN
               IF (Theirs(ro,co)==0) THEN
                 cnt = cnt-1
                 IF (cnt<0) THEN
                   res = 0
                   Theirs(ro,co) = -1 ! assume nothing there
                   IF (Theirs(Lim19(ro-1),co)<0) THEN
                     IF (Theirs(Lim19(ro+1),co)<0) THEN
                       IF (Theirs(ro,Lim19(co-1))<0) THEN
                         IF (Theirs(ro,Lim19(co+1))<0) THEN ! it can't be a ship..
                           Tries = Tries-1
                           res = -1
                           END IF
                         END IF
                       END IF
                     END IF
                   IF (res==0) THEN
                     res = ro*10+co
                     EXIT
                     END IF
                   END IF
                 END IF
               END IF
             END DO
           IF (res>0) EXIT
           END DO
         IF (res>0) EXIT
         END DO
       RandomShot = res
       END FUNCTION

       FUNCTION Lim19(theNum)
       IMPLICIT NONE
       INTEGER Lim19, theNum, res
       res = theNum
       IF (theNum<1) res = 1
       IF (theNum>9) res = 9
       Lim19 = res
       END FUNCTION

       SUBROUTINE ShowArrays(Mine, Theirs, ShowOut)
       IMPLICIT NONE
       DIMENSION Mine(9,9), Theirs(9,9), chars(19), digits(-1:10)
       INTEGER Mine, Theirs, ShowOut, r, c, ix
       CHARACTER chars, digits
       digits(-1) = "*"
       digits(0) = "."
       digits(1) = "1"
       digits(2) = "2"
       digits(3) = "3"
       digits(4) = "4"
       digits(5) = "5"
       digits(6) = "6"
       digits(7) = "7"
       digits(8) = "8"
       digits(9) = "9"
       digits(10) = "0"
       DO r=1,9
         DO c=1,9
           chars(c) = digits(Mine(r,c))
           END DO
         chars(10) = "|"
         DO c=1,9
           chars(c+10) = digits(Theirs(r,c))
           END DO
         PRINT 100,chars
         END DO
       digits(0) = "0"
       ix = ShowOut
       DO c=3,1,-1
         r = ix/10
         chars(c) = digits(ix-r*10)
         ix = r
         END DO
       PRINT 101,(chars(c),c=1,3)
 100   FORMAT(20(1X,A1))
 101   FORMAT(" My play=", 3A1, ", Yours:")
       CALL Write3I(ShowOut)
       END SUBROUTINE

       SUBROUTINE Write3I(theNum)
       IMPLICIT NONE
       INTEGER theNum
       open (unit=3, file="F:/Play.txt", status="OLD")
       write (3,111),theNum
       close (unit=3)
 111   FORMAT(I3)
       END SUBROUTINE

       SUBROUTINE Read3I(theNum)
       IMPLICIT NONE
       INTEGER theNum
       open (unit=3, file="F:/Play.txt", status="OLD")
       read (3,111),theNum
       close (unit=3)
 111   FORMAT(I3)
       END SUBROUTINE

       FUNCTION IntRand(iseed, modulus)
       IMPLICIT NONE
       INTEGER iseed, modulus, IntRand, mod
       iseed = iseed*2233
       IF (iseed<0) iseed = -iseed
       IntRand = mod(iseed/76,modulus)
       ! PRINT *,"Rnd=",iseed,modulus,IntRand
       END FUNCTION

       FUNCTION mod(num, modulus)
       INTEGER num, modulus, mod
       mod = num-(num/modulus)*modulus
       END FUNCTION