C Rename this file from .txt to .f for G77 C C FIAR FIVE IN A ROW GAME SCIENTIFIC CALCULATIONS, INC. C Routine to output game grid on each turn added by C 12 OCT 2012 C James Larson C Programmer/Analyst Consultant C http://www.dst-corp.com/james C jlarson43@juno.com C In God We Trust... PROGRAM FIAR C KWG - MERIT WEIGHTING CONSTANTS C KP - GAME MARKER ARRAY C KN - SOUTH C KNE - SOUTH WEST C KE - WEST C KSE - NORTH WEST C KPL - COMPUTER MARKER COUNTER (PLUS) C KMH - HUMAN MARKER COUNTER (MINUS) DIMENSION KWG(5),KP(12,12),KN(16,12),KNE(16,12),KE(12,12) DIMENSION KSE(12,12),KPL(5),KMH(5) CHARACTER*2 LI(12) ! MARKER LINE FOR BOARD DISPLAY KWG(1)=100 KWG(2)=100 KWG(3)=550 KWG(4)=500 KFMC=0 100 DO 101 K=1,12 DO 101 L=1,12 KN(K,L)=0 KNE(K,L)=0 KE(K,L)=0 KSE(K,L)=0 101 KP(K,L)=0 DO 102 K=1,4 DO 102 L=1,12 KN(K,L)=-10 102 KNE(K,L)=-10 DO 103 K=1,12 DO 103 L=9,12 KNE(K,L)=-10 KE(K,L)=-10 103 KSE(K,L)=-10 DO 104 K=9,12 DO 104 L=1,12 104 KSE(K,L)=-10 DO 105 K=13,16 DO 105 L=1,12 KNE(K,L)=-10 105 KN(K,L)=-10 KDONE=0 WRITE(*,2005) C //////////////////////////////////// C Added by JAL 112 WRITE(*,2044) WRITE(*,2045) DO 330 K=1,12 DO 320 J=1,12 IF (KP(K,J)) 305,310,315 ! TESTING 305 LI(J)=' H' GO TO 320 310 LI(J)=' -' GO TO 320 315 LI(J)=' C' 320 CONTINUE 330 WRITE(*,2050) K,LI IF (KDONE) 100,350,100 C //////////////////////////////////// 350 READ(*,2003) I,J IF(I)117,117,113 113 IF (J) 117,117,114 114 IF (I-12) 115,115,117 115 IF (J-12) 116,116,117 116 IF (KP(I,J)) 117,118,117 117 WRITE (*,2006) GO TO 112 118 KP(I,J)=-1 KPM=-1 GO TO 169 121 MERHI=0 DO 151 I=1,12 DO 151 J=1,12 IF (KP(I,J)) 151,122,151 122 DO 123 K=1,5 KPL(K)=0 123 KMH(K)=0 DO 145 K=1,5 L=K-1 N1=I+L ! SOUTH N2=I-L ! NORTH N3=J-L ! WEST KT=KN(N1,J) ! SOUTH IF (KT+10) 128,128,124 124 KT1=IABS(KT)+1 IF (KT) 126,127,125 125 KMH(KT1)=KMH(KT1)+1 GO TO 128 126 KPL(KT1)=KPL(KT1)+1 GO TO 128 127 KMH(1)=KMH(1)+1 128 IF (N3) 145,145,129 129 KT=KNE(N1,N3) ! SOUTH WEST IF (KT+10) 134,134,130 130 KT1=IABS(KT)+1 IF (KT) 132,133,131 131 KMH(KT1)=KMH(KT1)+1 GO TO 134 132 KPL(KT1)=KPL(KT1)+1 GO TO 134 133 KMH(1)=KMH(1)+1 134 KT=KE(I,N3) ! WEST IF (KT+10) 139,139,135 135 KT1=IABS(KT)+1 IF (KT) 137,138,136 136 KMH(KT1)=KMH(KT1)+1 GO TO 139 137 KPL(KT1)=KPL(KT1)+1 GO TO 139 138 KMH(1)=KMH(1)+1 139 IF (N2) 145,145,140 140 KT=KSE(N2,N3) ! NORTH WEST IF (KT+10) 145,145,141 141 KT1=IABS(KT)+1 IF (KT) 143,144,142 142 KMH(KT1)=KMH(KT1)+1 GO TO 145 143 KPL(KT1)=KPL(KT1)+1 GO TO 145 144 KMH(1)=KMH(1)+1 145 CONTINUE MSUM=4*KMH(2)*(KMH(2)+1) KPSUM=4*KPL(2)*KPL(2) MSUM=MSUM+KWG(1)*KMH(3)*KMH(3) KPSUM=KPSUM+KWG(2)*KPL(3)*(KPL(3)+1) MSUM=MSUM+KWG(3)*KMH(4)*KMH(4)*KMH(4) KPSUM=KPSUM+KWG(4)*KPL(4)*KPL(4)*KPL(4) IF (KMH(5)) 146,146,165 146 IF (KPL(5)) 147,147,148 147 MERIT=MSUM+KPSUM+KMH(1) GO TO 149 148 MERIT=31990 149 IF (MERIT-MERHI) 151,151,150 150 MERHI=MERIT IM=I JM=J 151 CONTINUE I=IM J=JM IF (MERHI) 152,152,153 152 WRITE(*,2009) KDONE=1 GO TO 112 153 IF (MERHI-2*KWG(3)-2*KWG(4)) 165,154,154 154 IF (KFMC-6) 156,156,155 155 KFMC=0 156 KFMC=KFMC+1 GO TO (157,158,159,161,162,163,164),KFMC 157 WRITE (*,2010) GO TO 165 158 WRITE (*,2011) GO TO 165 159 WRITE (*,2012) TS2=17. DO 160 IJ=1,1000 160 TS1=SQRT(TS2) GO TO 165 161 WRITE (*,2013) GO TO 165 162 WRITE (*,2014) GO TO 165 163 WRITE (*,2015) GO TO 165 164 WRITE (*,2016) 165 WRITE (*,2004) I,J KPM=1 KP(I,J)=1 169 DO 199 K=1,5 L=K-1 N1=I+L N2=I-L N3=J-L KT=KN(N1,J) IF (KT+10) 176,176,170 170 IF (KPM) 171,172,172 171 KTEST=-KT GO TO 173 172 KTEST=KT 173 IF (KTEST) 175,174,174 174 KN(N1,J)=KT+KPM IF (IABS(KT)-4) 176,200,200 175 KN(N1,J)=-10 176 IF (N3) 199,199,177 177 KT=KNE(N1,N3) IF (KT+10) 184,184,178 178 IF (KPM) 179,180,180 179 KTEST=-KT GO TO 181 180 KTEST=KT 181 IF (KTEST) 183,182,182 182 KNE(N1,N3)=KT+KPM IF (IABS(KT)-4) 184,200,200 183 KNE(N1,N3)=-10 184 KT=KE(I,N3) IF(KT+10) 191,191,185 185 IF (KPM) 186,187,187 186 KTEST=-KT GO TO 188 187 KTEST=KT 188 IF (KTEST) 190,189,189 189 KE(I,N3)=KT+KPM IF (IABS(KT)-4) 191,200,200 190 KE(I,N3)=-10 191 IF (N2) 199,199,192 192 KT=KSE(N2,N3) IF (KT+10) 199,199,193 193 IF (KPM) 194,195,195 194 KTEST=-KT GO TO 196 195 KTEST=KT 196 IF (KTEST) 198,197,197 197 KSE(N2,N3)=KT+KPM IF (IABS(KT)-4) 199,200,200 198 KSE(N2,N3)=-10 199 CONTINUE IF (KPM) 121,500,500 200 KDONE=1 IF (KPM) 201,202,202 201 WRITE (*,2008) GO TO 112 202 WRITE (*,2007) GO TO 112 C //////////////////////////////////// C Added by Jal 500 GOTO 112 CALL SHOWDEBUG (KN, 16,'KN ') CALL SHOWDEBUG (KNE,16,'KNE') CALL SHOWDEBUG (KE, 12,'KE ') CALL SHOWDEBUG (KSE,12,'KSE') GOTO 112 C //////////////////////////////////// 2003 FORMAT (2I2) 2004 FORMAT (2I2) 2005 FORMAT (/9H NEW GAME/22H YOU MOVE FIRST PLEASE/) 2006 FORMAT (/16H GOOF, TRY AGAIN/) 2007 FORMAT (/22H HARD CHEESE, YOU LOSE/) 2008 FORMAT (/24H WELL, I CANT WIN EM ALL/) 2009 FORMAT (/32H NO USE PROLONGING THIS NONSENSE/) 2010 FORMAT (/37H SCI ALSO DOES PRODUCTIVE PROGRAMMING/) 2011 FORMAT (/17H SAY, WHO IS THIS/) 2012 FORMAT (/22H LET ME THINK A MINUTE/) 2013 FORMAT (/17H ANYONE FOR CHESS/) 2014 FORMAT (/27H YOU'RE PUSHING PRETTY HARD/) 2015 FORMAT (/44H HAPPINESS IS 4 IN A ROW WITH BOTH ENDS OPEN/) 2016 FORMAT (/26H I COULD PLAY THIS ALL DAY/) 2044 FORMAT (26H 1 1 1) 2045 FORMAT (26H 1 2 3 4 5 6 7 8 9 0 1 2) 2050 FORMAT (I2,12A2) END SUBROUTINE SHOWDEBUG (KA,KE,T) DIMENSION KA(KE,12) CHARACTER*4 LI(12) CHARACTER*3 T WRITE(*,2051) T WRITE(*,2044) WRITE(*,2045) DO 330 K=1,12 330 WRITE (*,2052) K,(KA(K,J),J=1,12) 2044 FORMAT (48H 1 1 1) 2045 FORMAT (48H 1 2 3 4 5 6 7 8 9 0 1 2) 2050 FORMAT (I2,12A4) 2051 FORMAT (/A3) 2052 FORMAT (I2,12I4) END