home *** CD-ROM | disk | FTP | other *** search
/ ittybittycomputers.com / www.ittybittycomputers.com.tar / www.ittybittycomputers.com / Courses / Prior / Fortran / Battle.f next >
Text File  |  2006-10-18  |  11KB  |  365 lines
  1.        ! Fortran version of Battleship -- 2002 December 6
  2.        PROGRAM Battleship
  3.        IMPLICIT NONE
  4.        DIMENSION Mine(9,9), Theirs(9,9)
  5.        INTEGER Mine, Theirs, ShowOut, Tries, iseed, IntRand, Lim19
  6.        INTEGER mod, RandomShot, RimShot, GoodShot, BetterShot
  7.        INTEGER ix, tx, zx, ro, co, here, thar, up, wide, tall
  8. ! StartGame
  9.        iseed = 2233
  10.        CALL Read3I(up)
  11.        DO ix=1,up
  12.          tx = IntRand(iseed,2)
  13.          END DO
  14.        DO ro=1,9 ! Zapit..
  15.          DO co=1,9
  16.            Mine(ro,co) = 0
  17.            Theirs(ro,co) = 0
  18.            END DO
  19.          END DO
  20.        DO ix=5,1,-1
  21.          wide = ix
  22.          IF (ix<2) wide = 2
  23.          up = IntRand(iseed,2)
  24.          tall = wide*up
  25.          wide = wide*(1-up)
  26.          DO
  27.            here = IntRand(iseed,9-tall+up)
  28.            thar = IntRand(iseed,10-wide-up)
  29.            DO ro=tall+1-up,1,-1
  30.              DO co=wide+up,1,-1
  31.                IF (Mine(here+ro,thar+co)>0) THEN
  32.                  here = -1
  33.                  EXIT
  34.                  END IF
  35.                END DO
  36.              IF (here<0) EXIT
  37.              END DO
  38.            IF (here>=0) THEN
  39.              DO ro=tall+1-up,1,-1
  40.                DO co=wide+up,1,-1
  41.                  Mine(here+ro,thar+co) = ix
  42.                  END DO
  43.                END DO
  44.              EXIT
  45.              END IF
  46.            END DO
  47.          END DO
  48.        ShowOut = 0
  49.        CALL ShowArrays(Mine, Theirs, ShowOut)
  50.        Tries = 40
  51. ! DoTurn
  52.        DO ! forever..
  53.          READ *,up
  54.          IF (up>599) EXIT
  55.          ShowOut = mod(ShowOut,100)
  56.          IF (up==0) THEN
  57.            CALL Read3I(up)
  58.            PRINT *,"You played ",up
  59.            END IF
  60.          IF (up<0) up = 0
  61.          tx = up/100
  62.          up = mod(up,100)
  63.          ro = up/10
  64.          co = mod(up,10)
  65.          ! PRINT *,"??",ShowOut,tx,up,ro,co, ShowOut/10, mod(ShowOut,10)
  66.          IF (ShowOut*tx>0) THEN
  67.            IF (tx==1) THEN ! got something, dunno what..
  68.              Theirs(ShowOut/10, mod(ShowOut,10)) = 9
  69.            ELSE
  70.              CALL SunkIt(Theirs, tx, ShowOut/10, mod(ShowOut,10))
  71.              END IF
  72.            END IF
  73.          up = 0
  74.          ShowOut = 0
  75.          IF (ro*co>0) THEN ! process this shot against me..
  76.            ShowOut = Mine(ro,co)
  77.            IF (ShowOut>5) THEN
  78.              ShowOut = 1 ! repeat shot, just report hit
  79.            ELSE IF (ShowOut>0) THEN
  80.              Mine(ro,co) = ShowOut+5
  81.              DO zx=Lim19(ro-4),Lim19(ro+4)
  82.                tx = Mine(zx,co)
  83.                IF (tx==ShowOut) up = up+1 ! not sunk yet
  84.                END DO
  85.              IF (up==0) THEN 
  86.                DO zx=Lim19(co-4),Lim19(co+4)
  87.                  tx = Mine(ro,zx)
  88.                  IF (tx==ShowOut) up = up+1
  89.                  END DO
  90.                END IF
  91.              IF (up>0) THEN
  92.                ShowOut = 1
  93.              ELSE IF (ShowOut<2) THEN
  94.                ShowOut = 2
  95.                END IF
  96.              END IF
  97.            END IF
  98.          ro = 0
  99.          co = BetterShot(Theirs) ! try to extend a line of hits
  100.          IF (co==0) co = GoodShot(Theirs) ! try for near a hit
  101.          IF (co==0) co = RimShot(Theirs) ! try for a rim
  102.          IF (co==0) co = RandomShot(Theirs, iseed, Tries) ! no directed shots, try a random shot
  103.          IF (co>0) THEN
  104.            Theirs(co/10,mod(co,10)) = -1
  105.            IF (mod(ro+co,2)>0) Tries = Tries-1
  106.          ELSE 
  107.            ShowOut = 9 ! huh? somebody cheated
  108.            END IF
  109.          ShowOut = ShowOut*100+co
  110.          CALL ShowArrays(Mine, Theirs, ShowOut)
  111.          END DO
  112.        END PROGRAM
  113.  
  114.        SUBROUTINE SunkIt(Theirs, whom, rx, cx)
  115.        IMPLICIT NONE
  116.        DIMENSION Theirs(9,9)
  117.        INTEGER Theirs, whom, rx, cx, ix, hi, lo
  118.        ! PRINT *,"SunkIt", whom, rx, cx
  119.        Theirs(rx,cx) = 9
  120.        lo = rx-1
  121.        DO
  122.          IF (lo<1) EXIT
  123.          IF (Theirs(lo,cx)<6) EXIT
  124.          lo = lo-1
  125.          END DO
  126.        hi = rx+1
  127.        DO
  128.          IF (hi>9) EXIT
  129.          IF (Theirs(hi,cx)<6) EXIT
  130.          hi = hi+1
  131.          END DO
  132.        IF (hi-lo==whom+1) THEN
  133.          DO ix=lo+1,hi-1
  134.            Theirs(ix,cx) = whom
  135.            END DO
  136.        ELSE
  137.          lo = cx-1
  138.          DO 
  139.            IF (lo<1) EXIT
  140.            IF (Theirs(rx,lo)<6) EXIT
  141.            lo = lo-1
  142.            END DO
  143.          hi = cx+1
  144.          DO
  145.            IF (hi>9) EXIT
  146.            IF (Theirs(rx,hi)<6) EXIT
  147.            hi = hi+1
  148.            END DO
  149.          IF (hi-lo==whom+1) THEN
  150.            DO ix=lo+1,hi-1
  151.              Theirs(rx,ix) = whom
  152.              END DO
  153.          ELSE
  154.            Theirs(rx,cx) = whom
  155.            END IF
  156.          END IF
  157.        END SUBROUTINE
  158.  
  159.        FUNCTION BetterShot(Theirs)
  160.        IMPLICIT NONE
  161.        DIMENSION Theirs(9,9)
  162.        INTEGER BetterShot, Theirs, ro, co
  163.        ! PRINT *,"Better"
  164.        BetterShot = 0
  165.        DO ro=1,9
  166.          DO co=1,7
  167.            IF (Theirs(ro,co)==0) THEN
  168.              IF (Theirs(ro,co+1)>5) THEN
  169.                IF (Theirs(ro,co+2)>5) THEN
  170.                  BetterShot = ro*10+co
  171.                  END IF
  172.                END IF
  173.              END IF
  174.            END DO
  175.          DO co=9,3,-1
  176.            IF (Theirs(ro,co)==0) THEN
  177.              IF (Theirs(ro,co-1)>5) THEN
  178.                IF (Theirs(ro,co-2)>5) THEN
  179.                  BetterShot = ro*10+co
  180.                  END IF
  181.                END IF
  182.              END IF
  183.            END DO
  184.          END DO
  185.        DO co=1,9
  186.          DO ro=1,7
  187.            IF (Theirs(ro,co)==0) THEN 
  188.              IF (Theirs(ro+1,co)>5) THEN
  189.                IF (Theirs(ro+2,co)>5) THEN
  190.                  BetterShot = ro*10+co
  191.                  END IF
  192.                END IF
  193.              END IF
  194.            END DO
  195.          DO ro=9,3,-1 
  196.            IF (Theirs(ro,co)==0) THEN
  197.              IF (Theirs(ro-1,co)>5) THEN
  198.                IF (Theirs(ro-2,co)>5) THEN
  199.                  BetterShot = ro*10+co
  200.                  END IF
  201.                END IF
  202.              END IF
  203.            END DO
  204.          END DO
  205.        END FUNCTION
  206.  
  207.        FUNCTION GoodShot(Theirs)
  208.        IMPLICIT NONE
  209.        DIMENSION Theirs(9,9)
  210.        INTEGER GoodShot, Lim19, Theirs, ro, co, ix
  211.        ! PRINT *,"Good"
  212.        GoodShot = 0
  213.        DO ro=1,9
  214.          DO co=1,9
  215.            IF (Theirs(ro,co)>5) THEN
  216.              ix = Lim19(ro-1);
  217.              IF (Theirs(ix,co)==0) GoodShot = ix*10+co
  218.              ix = Lim19(ro+1);
  219.              IF (Theirs(ix,co)==0) GoodShot = ix*10+co
  220.              ix = Lim19(co-1);
  221.              IF (Theirs(ro,ix)==0) GoodShot = ro*10+ix
  222.              ix = Lim19(co+1);
  223.              IF (Theirs(ro,ix)==0) GoodShot = ro*10+ix
  224.              END IF
  225.            END DO
  226.          END DO
  227.        END FUNCTION
  228.  
  229.        FUNCTION RimShot(Theirs)
  230.        IMPLICIT NONE
  231.        DIMENSION Theirs(9,9)
  232.        INTEGER RimShot, Theirs, ix
  233.        ! PRINT *,"Rim"
  234.        RimShot = 0
  235.        DO ix=1,4
  236.          IF (Theirs(ix*2,1)==0) RimShot = ix*20+1
  237.          IF (Theirs(ix*2,9)==0) RimShot = ix*20+9
  238.          IF (Theirs(1,ix*2)==0) RimShot = ix*2+10
  239.          IF (Theirs(9,ix*2)==0) RimShot = ix*2+90
  240.          END DO
  241.        END FUNCTION
  242.  
  243.        FUNCTION RandomShot(Theirs, iseed, Tries)
  244.        IMPLICIT NONE
  245.        DIMENSION Theirs(9,9)
  246.        INTEGER RandomShot, Lim19, IntRand, Theirs, iseed, Tries
  247.        INTEGER ro, co, cnt, mask, res
  248.        res = 0
  249.        cnt = IntRand(iseed, Tries)
  250.        DO mask=0,2
  251.          ! PRINT *,"Random: ",mask,cnt,Tries
  252.          DO ro=1,9
  253.            DO co=1,9
  254.              IF (mod(ro+co,2)+(mask/2)>0) THEN
  255.                IF (Theirs(ro,co)==0) THEN
  256.                  cnt = cnt-1
  257.                  IF (cnt<0) THEN
  258.                    res = 0
  259.                    Theirs(ro,co) = -1 ! assume nothing there
  260.                    IF (Theirs(Lim19(ro-1),co)<0) THEN
  261.                      IF (Theirs(Lim19(ro+1),co)<0) THEN
  262.                        IF (Theirs(ro,Lim19(co-1))<0) THEN
  263.                          IF (Theirs(ro,Lim19(co+1))<0) THEN ! it can't be a ship..
  264.                            Tries = Tries-1
  265.                            res = -1
  266.                            END IF
  267.                          END IF
  268.                        END IF
  269.                      END IF
  270.                    IF (res==0) THEN
  271.                      res = ro*10+co
  272.                      EXIT
  273.                      END IF
  274.                    END IF
  275.                  END IF
  276.                END IF
  277.              END DO
  278.            IF (res>0) EXIT
  279.            END DO
  280.          IF (res>0) EXIT
  281.          END DO
  282.        RandomShot = res
  283.        END FUNCTION
  284.  
  285.        FUNCTION Lim19(theNum)
  286.        IMPLICIT NONE
  287.        INTEGER Lim19, theNum, res
  288.        res = theNum
  289.        IF (theNum<1) res = 1
  290.        IF (theNum>9) res = 9
  291.        Lim19 = res
  292.        END FUNCTION
  293.  
  294.        SUBROUTINE ShowArrays(Mine, Theirs, ShowOut)
  295.        IMPLICIT NONE
  296.        DIMENSION Mine(9,9), Theirs(9,9), chars(19), digits(-1:10)
  297.        INTEGER Mine, Theirs, ShowOut, r, c, ix
  298.        CHARACTER chars, digits
  299.        digits(-1) = "*"
  300.        digits(0) = "."
  301.        digits(1) = "1"
  302.        digits(2) = "2"
  303.        digits(3) = "3"
  304.        digits(4) = "4"
  305.        digits(5) = "5"
  306.        digits(6) = "6"
  307.        digits(7) = "7"
  308.        digits(8) = "8"
  309.        digits(9) = "9"
  310.        digits(10) = "0"
  311.        DO r=1,9
  312.          DO c=1,9
  313.            chars(c) = digits(Mine(r,c))
  314.            END DO
  315.          chars(10) = "|"
  316.          DO c=1,9
  317.            chars(c+10) = digits(Theirs(r,c))
  318.            END DO
  319.          PRINT 100,chars
  320.          END DO
  321.        digits(0) = "0"
  322.        ix = ShowOut
  323.        DO c=3,1,-1
  324.          r = ix/10
  325.          chars(c) = digits(ix-r*10)
  326.          ix = r
  327.          END DO
  328.        PRINT 101,(chars(c),c=1,3)
  329.  100   FORMAT(20(1X,A1))
  330.  101   FORMAT(" My play=", 3A1, ", Yours:")
  331.        CALL Write3I(ShowOut)
  332.        END SUBROUTINE
  333.  
  334.        SUBROUTINE Write3I(theNum)
  335.        IMPLICIT NONE
  336.        INTEGER theNum
  337.        open (unit=3, file="F:/Play.txt", status="OLD")
  338.        write (3,111),theNum
  339.        close (unit=3)
  340.  111   FORMAT(I3)
  341.        END SUBROUTINE
  342.  
  343.        SUBROUTINE Read3I(theNum)
  344.        IMPLICIT NONE
  345.        INTEGER theNum
  346.        open (unit=3, file="F:/Play.txt", status="OLD")
  347.        read (3,111),theNum
  348.        close (unit=3)
  349.  111   FORMAT(I3)
  350.        END SUBROUTINE
  351.  
  352.        FUNCTION IntRand(iseed, modulus)
  353.        IMPLICIT NONE
  354.        INTEGER iseed, modulus, IntRand, mod
  355.        iseed = iseed*2233
  356.        IF (iseed<0) iseed = -iseed
  357.        IntRand = mod(iseed/76,modulus)
  358.        ! PRINT *,"Rnd=",iseed,modulus,IntRand
  359.        END FUNCTION
  360.  
  361.        FUNCTION mod(num, modulus)
  362.        INTEGER num, modulus, mod
  363.        mod = num-(num/modulus)*modulus
  364.        END FUNCTION
  365.