home *** CD-ROM | disk | FTP | other *** search
/ Programmer 7500 / MAX_PROGRAMMERS.iso / INFO / FORTH / 4THPROG.ZIP / OTHELLO.FOR < prev    next >
Encoding:
Text File  |  1982-05-31  |  11.4 KB  |  413 lines
  1.       INTEGER B(10,10),DIR(30,8),CHT(8) 
  2.       INTEGER MOVEI,MOVEJ 
  3.       DIMENSION DRSPON(4),IAA(8),JAA(8),MOVESI(30)
  4.      +,MOVESJ(30),LC(30),NFLIP(30)
  5.       COMMON /OCOMMN/ OC
  6.       DATA DRSPON/'YES','NO','Y','N'/ 
  7.       DATA IAA/-1,-1,-1,0,1,1,1,0/
  8.       DATA JAA/-1,0,1,1,1,0,-1,-1/
  9.       DATA CHT/'A','B','C','D','E','F','G','H'/ 
  10.       JFLAG=0
  11.    22 DO 10 I=1,10
  12.       DO 10 J=1,10
  13.       B(I,J)=0
  14.       IF(I.EQ.1.OR.I.EQ.10)B(I,J)=100 
  15.    10 IF(J.EQ.1.OR.J.EQ.10)B(I,J)=100 
  16.       B(5,5)=1
  17.       B(5,6)=-1 
  18.       B(6,5)=-1 
  19.       B(6,6)=1
  20.       WRITE(1,601)
  21.   601 FORMAT(////////////////////////,
  22.      +1X,'"OTHELLO" - DO YOU WISH TO GO FIRST ?' 
  23.      +,/,1X,'YOU ARE "X" IF YOU ARE FIRST. ') 
  24.       READ(1,876)RESPON 
  25.   876 FORMAT(A3)
  26.       OC=1
  27.       IF(RESPON.EQ.DRSPON(2))GOTO 11
  28.       IF(RESPON.EQ.DRSPON(4))GOTO 11
  29.       CALL HANDIC(OC,B,DRSPON,NHD)
  30.       NM=NHD
  31.       CALL BOARDP(B,NM,NHD) 
  32.     8 IF(NM.EQ.60)GOTO 15 
  33.       CALL MOVEG(B,-OC,NM,MOVESI,MOVESJ,DIR,LC,JAA,IAA, 
  34.      +IM,NOMVE,NFLIP) 
  35.       IF(IM.EQ.0)GOTO 12
  36.       WRITE(1,713)
  37.   713 FORMAT(46X,'WHAT IS YOUR MOVE ? ') 
  38.       IF(JFLAG.GT.0)GOTO 14
  39.       WRITE(1,714)
  40.   714 FORMAT(1X,'EXAMPLE - UPPER LEFT CORNER IS A1  ')
  41.       JFLAG=1.
  42.    14 READ(1,678)MOVEI,MOVEJ
  43.   678 FORMAT(A1,I1) 
  44.       MOVEI=MOVEI-1HA+2 
  45.       MOVEJ=MOVEJ+1 
  46.       DO 9 I=1,IM 
  47.       IF(MOVESI(I).EQ.MOVEI.AND.MOVESJ(I).EQ.MOVEJ)GOTO 13
  48.     9 CONTINUE
  49.       WRITE(1,701)
  50.   701 FORMAT(1X,'MOVE INVALID. PLEASE RE-ENTER. ')
  51.       GOTO 14 
  52.    13 NM=NM+1 
  53.       CALL BOARDC(MOVESI,MOVESJ,I,IAA,JAA,B,-OC,DIR,LC) 
  54.       CALL BOARDP(B,NM,NHD) 
  55.       GOTO 2
  56.    11 OC=-1 
  57.       CALL HANDIC(OC,B,DRSPON,NHD)
  58.       B(5,7)=1
  59.       B(5,6)=1
  60.       NM=NHD+1
  61.       CALL BOARDP(B,NM,NHD) 
  62.       GOTO 8
  63.    12 WRITE(1,756)
  64.   756 FORMAT(1X,'I SEE NO MOVE FOR YOU, SO I WILL MOVE IF I CAN') 
  65.     2 IF(NM.EQ.60)GOTO 15 
  66.       CALL MOVEG(B,OC,NM,MOVESI,MOVESJ,DIR,LC,JAA,IAA,
  67.      +IM,NOMVE,NFLIP) 
  68.       IF(IM.EQ.0)GOTO 20
  69.       CALL MOVEE(B,OC,NM,MOVESI,MOVESJ,NFLIP,DIR,LC,IM,IF,IAA,JAA)
  70.       MOVEI=MOVESI(IF)-2+1HA
  71.       MOVEJ=MOVESJ(IF)-1
  72.       WRITE(1,603)MOVEI,MOVEJ 
  73.   603 FORMAT(46X,'MY MOVE IS : ',A1,I1)
  74.       CALL BOARDC(MOVESI,MOVESJ,IF,IAA,JAA,B,OC,DIR,LC) 
  75.       NM=NM+1 
  76.       CALL BOARDP(B,NM,NHD) 
  77.       GOTO 8
  78.    20 WRITE(1,602)
  79.   602 FORMAT(1X,'DO YOU HAVE A MOVE? ') 
  80.       READ(1,876)RESPON 
  81.       IF(RESPON.EQ.DRSPON(1))GOTO 8 
  82.       IF(RESPON.EQ.DRSPON(3))GOTO 8
  83.       IF(IM.NE.0)GOTO 2 
  84.    15 CALL COUNT(B,OC,NOC)
  85.       CALL COUNT(B,-OC,NC)
  86.       IF(NOC.LE.NC)GOTO 900 
  87.       WRITE(1,610)
  88.   610 FORMAT(/,1X,'CONGRATULATIONS, YOU PLAYED WELL AND HAVE WON.'
  89.      +,1X,'THANK YOU FOR A FINE GAME.') 
  90.       GOTO 920
  91.   900 IF(NOC.EQ.NC)GOTO 910 
  92.       WRITE(1,611)
  93.   611 FORMAT(/,1X,'YOU PLAYED WELL; HOWEVER, YOUR LUCK WAS BAD AND' 
  94.      +,1X,'I HAVE WON. THANK YOU FOR A FINE GAME.') 
  95.       GOTO 920
  96.   910 WRITE(1,612)
  97.   612 FORMAT(/,1X,'YOU PLAYED WELL AND WE HAVE TIED. I WAS LUCKY.'
  98.      +,1X,'THANK YOU FOR A FINE GAME.') 
  99.   920 WRITE(1,613)
  100.   613 FORMAT(/,1X,'DO YOU WISH TO PLAY AGAIN? ')
  101.       READ(1,876)RESPON 
  102.       IF(RESPON.EQ.DRSPON(1))GOTO 22
  103.       IF(RESPON.EQ.DRSPON(3))GOTO 22
  104.       STOP
  105.       END 
  106.       SUBROUTINE MOVEG(B,OC,NM,MOVESI,MOVESJ,DIR,LC,JAA,IAA,IM
  107.      +,NOMVE,NFLIP) 
  108.       INTEGER B(10,10),DIR(30,8)
  109.       DIMENSION MOVESI(30),MOVESJ(30),LC(30),NFLIP(30)
  110.      +,IAA(1),JAA(1)
  111.       COMMON /OCOMMN/ OCA 
  112.       DO 1 I=1,30 
  113.       LC(I)=0 
  114.     1 NFLIP(I)=0
  115.       IM=0
  116.       DO 20 I=2,9 
  117.       DO 20 J=2,9 
  118.       IF(B(I,J).NE.0)GOTO 20
  119.       IC=0
  120.       DO 5 L=1,8
  121.       IA=IAA(L) 
  122.       JA=JAA(L) 
  123.       IAT=I+IA
  124.       JAT=J+JA
  125.       IF(B(IAT,JAT).NE.OC)GOTO 5
  126.       IV=1
  127.     4 IV=IV+1 
  128.       MVI=I+IV*IA 
  129.       MVJ=J+IV*JA 
  130.       IF(B(MVI,MVJ).EQ.0)GOTO 5 
  131.       IF(B(MVI,MVJ).EQ.100)GOTO 5 
  132.       IF(B(MVI,MVJ).EQ.OC)GOTO 4
  133.       IF(IC.EQ.1)GOTO 12
  134.       IM=IM+1 
  135.       IC=1
  136.    12 NFLIP(IM)=NFLIP(IM)+IV
  137.       LC(IM)=LC(IM)+1 
  138.       LDX=LC(IM)
  139.       DIR(IM,LDX)=L 
  140.     5 CONTINUE
  141.       IF(IC.EQ.0)GOTO 20
  142.       MOVESI(IM)=I
  143.       MOVESJ(IM)=J
  144.    20 CONTINUE
  145.       IF(IM.GT.0)GOTO 30
  146.       IF(OCA.NE.OC)GOTO 30
  147.       WRITE(1,100)
  148.   100 FORMAT(1X,'I HAVE NO MOVE AND MUST PASS.')
  149.    30 RETURN
  150.       END 
  151.       SUBROUTINE BOARDP(B,NM,NHD) 
  152.       DIMENSION OUT(3),POUT(10,10)
  153.       INTEGER B(10,1),CHT(8)
  154.       COMMON /OCOMMN/ OCA 
  155.       DATA OUT/'O','-','X'/ 
  156.       DATA CHT/'A','B','C','D','E','F','G','H'/ 
  157.       NMP=NM-NHD
  158.       TOC=OCA 
  159.       CALL COUNT(B,TOC,NOC) 
  160.       TOC=0-TOC 
  161.       CALL COUNT(B,TOC,NC)
  162.       WRITE(1,100)NMP,NOC,NC
  163.   100 FORMAT(6X,'BOARD POSITION AFTER ',I2,' MOVES' 
  164.      +,' YOU HAVE ',I2,' PIECES, I HAVE ',I2,/) 
  165.       WRITE(1,101)
  166.   101 FORMAT(24X,'   1 2 3 4 5 6 7 8') 
  167.       DO 9 I=2,9
  168.       DO 9 J=2,9
  169.       IS=B(I,J)+2 
  170.     9 POUT(I,J)=OUT(IS) 
  171.       DO 10 I=2,9 
  172.       I1=I-1
  173.    10 WRITE(1,104)CHT(I1),(POUT(I,J),J=2,9) 
  174.   104 FORMAT(24X,A1,2X,8(A1,1X)) 
  175.       RETURN
  176.       END 
  177.       SUBROUTINE COUNT(B,OC,NOC)
  178.       INTEGER B(10,1) 
  179.       NOC=0 
  180.       DO 10 I=2,9 
  181.       DO 10 J=2,9 
  182.       IF(B(I,J).NE.OC)GOTO 10 
  183.       NOC=NOC+1 
  184.    10 CONTINUE
  185.       RETURN
  186.       END 
  187.       SUBROUTINE BOARDC(MOVESI,MOVESJ,IF,IAA,JAA,B,OC,DIR,LC) 
  188.       INTEGER B(10,10),DIR(30,8)
  189.       DIMENSION MOVESI(30),MOVESJ(30),IAA(1),JAA(1),LC(30)
  190.       MI=MOVESI(IF) 
  191.       MJ=MOVESJ(IF) 
  192.       B(MI,MJ)=-OC
  193.       NDIR=LC(IF) 
  194.       DO 40 I=1,NDIR
  195.       L=DIR(IF,I) 
  196.       IA=IAA(L) 
  197.       JA=JAA(L) 
  198.       IV=0
  199.    31 IV=IV+1 
  200.       MVI=MI+IV*IA
  201.       MVJ=MJ+IV*JA
  202.       IF(B(MVI,MVJ).EQ.-OC)GOTO 40
  203.       B(MVI,MVJ)=-OC
  204.       GOTO 31 
  205.    40 CONTINUE
  206.       RETURN
  207.       END 
  208.       SUBROUTINE MOVEE(B,OC,NM,MOVESI,MOVESJ,NFLIP,DIR,LC 
  209.      +,IM,IF,IAA,JAA) 
  210.       INTEGER B(10,1),DIR(30,1),BT(10,10),BTT(10,10),DIRB(20,8) 
  211.      +,BTTS(9,9,20),DIRBB(20,8) 
  212.       DIMENSION MOVESI(1),MOVESJ(1),LC(1),NFLIP(1),MBI(20),MBJ(20)
  213.      +,LCB(20),NFLIPB(30),IAA(1),JAA(1),IY(24),JY(24) 
  214.      +,IMID(24),JMID(24),ID(24),JD(24),NCORNI(4),NCORNJ(4)
  215.      +,MBBI(20),MBBJ(20),LCBB(20),NFLIB(30) 
  216.       DATA NCORNI,NCORNJ/2,2,9,9,2,9,9,2/ 
  217.       DATA ID,JD/3,4,5,6,7,8,6*9,8,7,6,5,4,3,12*2,3,4,5,6,7,8 
  218.      +,6*9,8,7,6,5,4,3/ 
  219.       DATA IY,JY/5,1,3,8,1,6,9,1,9,9,1,9,6,1,8,3,1,5,2,1,2,2,1,2
  220.      +,2,1,2,2,1,2,5,1,3,8,1,6,9,1,9,9,1,9,6,1,8,3,1,5/ 
  221.       DATA IMID,JMID/4,1,4,7,1,7,9,1,9,9,1,9,7,1,7,4,1,4,2,1,2
  222.      +,2,1,2,2,1,2,2,1,2,4,1,4,7,1,7,9,1,9,9,1,9,7,1,7,4,1,4/ 
  223.       ICO=0 
  224.       IF=1
  225.       IF(NM.EQ.59)GOTO 20 
  226.    10 DO 12 I=1,IM
  227.       MI=MOVESI(I)
  228.       MJ=MOVESJ(I)
  229.       IF(MI.NE.3.AND.MI.NE.8)GOTO 13
  230.       IF(MJ.NE.3.AND.MJ.NE.8)GOTO 13
  231.       IF(MI.EQ.3.AND.MJ.EQ.3)IC=1 
  232.       IF(MI.EQ.3.AND.MJ.EQ.8)IC=2 
  233.       IF(MI.EQ.8.AND.MJ.EQ.8)IC=3 
  234.       IF(MI.EQ.8.AND.MJ.EQ.3)IC=4 
  235.       NCI=NCORNI(IC)
  236.       NCJ=NCORNJ(IC)
  237.       IF(B(NCI,NCJ).EQ.0)NFLIP(I)=NFLIP(I)-50 
  238.    13 IF(MI.NE.2.AND.MI.NE.9)GOTO 11
  239.       IF(MJ.NE.2.AND.MJ.NE.9)GOTO 11
  240.       ICO=ICO+1 
  241.       NFLIP(I)=NFLIP(I)+60
  242.    11 IF(MI.LE.3.OR.MI.GE.8)GOTO 2
  243.       IF(MJ.LE.3.OR.MJ.GE.8)GOTO 2
  244.       NFLIP(I)=NFLIP(I)+10
  245.       GOTO 12 
  246.     2 ND=LC(I)
  247.       DO 5 J=1,ND 
  248.       L=DIR(I,J)
  249.       IA=IAA(L) 
  250.       JA=JAA(L) 
  251.       IV=1
  252.     4 IV=IV+1 
  253.       MVI=MI+IV*IA
  254.       MVJ=MJ+IV*JA
  255.       IF(B(MVI,MVJ).EQ.OC)GOTO 4
  256.     6 IV=IV+1 
  257.       MVI=MI+IV*IA
  258.       MVJ=MJ+IV*JA
  259.       IF(B(MVI,MVJ).EQ.OC)GOTO 8
  260.       IF(B(MVI,MVJ).NE.-OC)GOTO 5 
  261.       GOTO 6
  262.     8 MIT=MI-IA 
  263.       MJT=MJ-JA 
  264.       IF(B(MIT,MJT).NE.0)GOTO 5 
  265.       NFLIP(I)=NFLIP(I)-5 
  266.       GOTO 12 
  267.     5 CONTINUE
  268.    12 CONTINUE
  269.       DO 32 I=1,IM
  270.       NSUBO=0 
  271.       MI=MOVESI(I)
  272.       MJ=MOVESJ(I)
  273.       IC=0
  274.       DO 33 K=1,10
  275.       DO 33 J=1,10
  276.    33 BT(K,J)=B(K,J)
  277.       LL=0
  278.       DO 56 J=1,24
  279.       IPP=ID(J) 
  280.       JPP=JD(J) 
  281.       IF(MOVESI(I).NE.IPP.OR.MOVESJ(I).NE.JPP)GOTO 56 
  282.       LL=J
  283.    56 CONTINUE
  284.       CALL BOARDC(MOVESI,MOVESJ,I,IAA,JAA,BT,OC,DIR,LC) 
  285.       CALL MOVEG(BT,-OC,NM,MBI,MBJ,DIRB,LCB,JAA,IAA,IM1 
  286.      +,NOMVE,NFLIPB)
  287.       IF(IM1.NE.0)GOTO 63 
  288.       NFLIP(I)=NFLIP(I)+100 
  289.       GOTO 32 
  290.    63 DO 36 J=1,IM1 
  291.       DO 34 K=1,10
  292.       DO 34 L=1,10
  293.    34 BTT(K,L)=BT(K,L)
  294.       CALL BOARDC(MBI,MBJ,J,IAA,JAA,BTT,-OC,DIRB,LCB) 
  295.       IF(LL.EQ.0)GOTO 38
  296.       IC=1
  297.       IZ=IY(LL) 
  298.       JZ=JY(LL) 
  299.       IF(B(IZ,JZ).NE.-OC)GOTO 41
  300.       MK=JMID(LL) 
  301.       ML=IMID(LL) 
  302.       IF(B(ML,MK).EQ.0)NSUBO=90 
  303.    41 IF(BTT(MI,MJ).NE.OC)GOTO 38 
  304.       NFLIP(I)=NFLIP(I)-40
  305.       IC=2
  306.    38 CONTINUE
  307.       CALL COUNT(BTT,-OC,NOC) 
  308.       IF(NOC.GT.0)GOTO 42 
  309.       NFLIP(I)=NFLIP(I)-200 
  310.       GOTO 32 
  311.    42 DO 37 K1=2,9
  312.       DO 37 K2=2,9
  313.    37 BTTS(K1,K2,J)=BTT(K1,K2)
  314.       DO 100 IL=2,9 
  315.       DO 100 JL=2,9 
  316.       IF(BTT(IL,JL).EQ.0)GOTO 100 
  317.       IF(BTT(IL,JL).EQ.OC)GOTO 100
  318.       DO 90 IZ=1,8
  319.       IV=0
  320.    80 IV=IV+1 
  321.       ILL=IL+IV*IAA(IZ) 
  322.       JLL=JL+IV*JAA(IZ) 
  323.       IF(BTT(ILL,JLL).EQ.0)GOTO 36
  324.       IF(BTT(ILL,JLL).EQ.100)GOTO 36
  325.       IF(BTT(ILL,JLL).NE.OC)GOTO 80 
  326.    90 CONTINUE
  327.   100 CONTINUE
  328.    95 CALL MOVEG(BTT,OC,NM,MBBI,MBBJ,DIRBB,LCBB,JAA,IAA,IM2 
  329.      +,NOMVE,NFLIB) 
  330.       IF(IM2.EQ.0)GOTO 103
  331.       DO 102 IL=1,IM2 
  332.       IF(MBBI(IL).NE.2.OR.MBBI(IL).NE.9)GOTO 102
  333.       IF(MBBJ(IL).NE.2.OR.MBBJ(IL).NE.9)GOTO 102
  334.       GOTO 36 
  335.   102 CONTINUE
  336.   103 NFLIP(I)=NFLIP(I)-190 
  337.    36 CONTINUE
  338.       IF(IC.NE.1)GOTO 35
  339.       DO 50 K=1,24
  340.       IQ=ID(K)
  341.       JQ=JD(K)
  342.       IF(MI.EQ.IQ.AND.MJ.EQ.JQ)GOTO 50
  343.       IF(B(IQ,JQ).NE.-OC)GOTO 50
  344.       DO 54 K1=1,IM1
  345.    54 IF(BTTS(IQ,JQ,K1).EQ.OC)NFLIP(I)=NFLIP(I)-8 
  346.    50 CONTINUE
  347.       NFLIP(I)=NFLIP(I)+25-NSUBO
  348.    35 DO 60 K=1,4 
  349.       KC1=NCORNI(K) 
  350.       KC2=NCORNJ(K) 
  351.       IF(B(KC1,KC2).NE.0)GOTO 60
  352.       DO 61 K1=1,IM1
  353.    61 IF(BTTS(KC1,KC2,K1).EQ.OC)NFLIP(I)=NFLIP(I)-55
  354.       IF(ICO.LE.1)GOTO 60 
  355.       IF(MI.EQ.KC1.AND.MJ.EQ.KC2)GOTO 60
  356.       DO 62 K1=1,IM1
  357.    62 IF(BTTS(KC1,KC2,K1).EQ.OC)NFLIP(I)=NFLIP(I)-20
  358.    60 CONTINUE
  359.    32 CONTINUE
  360.       NFLIPM=-800 
  361.       DO 15 I=1,IM
  362.       IF(NFLIP(I).LT.NFLIPM)GOTO 15 
  363.       NFLIPM=NFLIP(I) 
  364.       IF=I
  365.    15 CONTINUE
  366.    20 RETURN
  367.       END 
  368.       SUBROUTINE HANDIC(OC,B,DRSPON,NHD)
  369.       DIMENSION DRSPON(1) 
  370.       INTEGER B(10,1) 
  371.       NHD=0 
  372.       WRITE(1,608)
  373.   608 FORMAT(1X,'DO YOU WISH TO BE GIVEN A HANDICAP? ') 
  374.       READ(1,876)RESPON 
  375.   876 FORMAT(A3)
  376.       IF(RESPON.EQ.DRSPON(1))GOTO 7 
  377.       IF(RESPON.EQ.DRSPON(3))GOTO 7
  378.       WRITE(1,610)
  379.   610 FORMAT(1X,'DO YOU WISH TO GIVE ME A HANDICAP? ')
  380.       READ(1,876)RESPON 
  381.       IF(RESPON.EQ.DRSPON(2))GOTO 146 
  382.       IF(RESPON.EQ.DRSPON(4))GOTO 146
  383.       NAH=-OC 
  384.       WRITE(1,609)
  385.   609 FORMAT(1X,'HOW MANY CORNERS? (1-4) ') 
  386.   607 READ(1,678)NHD
  387.   678 FORMAT(I1)
  388.       IF(NHD.LT.1.OR.NHD.GT.4)GOTO 607
  389.       CALL HANDI(B,NHD,NAH,OC)
  390.       CALL BOARDP(B,0,0)
  391.       GOTO 146
  392.     7 NAH=OC
  393.       WRITE(1,609)
  394.   606 READ(1,678)NHD
  395.       IF(NHD.LT.1.OR.NHD.GT.4)GOTO 606
  396.       CALL HANDI(B,NHD,NAH,OC)
  397.   146 WRITE(1,147)
  398.   147 FORMAT(/////////////////////////)
  399.   100 RETURN
  400.       END 
  401.       SUBROUTINE HANDI(B,NHD,NAH,OC)
  402.       INTEGER B(10,1) 
  403.       INTEGER NCORNI(4),NCORNJ(4) 
  404.       DATA NCORNI,NCORNJ/2,2,9,9,2,9,9,2/ 
  405.       SIGN=-1.0 
  406.       IF(NAH.EQ.OC)SIGN=1.0 
  407.       DO 10 I=1,NHD 
  408.       I1=NCORNI(I)
  409.       I2=NCORNJ(I)
  410.    10 B(I1,I2)=SIGN*OC
  411.       RETURN
  412.       END 
  413.