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