4 In a row - FreeWare, listed 06-19-2004 10 ' 4row2004.bas - FreeWare 20 GOTO 190 ' begin 30 SAVE"4row2004":LIST-170 40 GOTO 520 ' scan for 4-in-a-row -- | \ / 50 GOTO 1060 ' print @ to locate 60 GOTO 1080 ' print board 70 GOTO 1170 ' draw X at v=9, f=1 80 GOTO 1180 ' draw X at screen position 90 GOTO 1190 ' draw X at lowest row 100 GOTO 1240 ' draw O at v=9, f=1 110 GOTO 1250 ' draw O at screen position 120 GOTO 1260 ' draw O at lowest row 130 GOTO 1310 ' blank X or O at screen position 140 GOTO 1320 ' blank X or O at v=9, f=1 150 GOTO 1350 ' print 1 to 7 160 GOTO 1370 ' get key 170 GOTO 1420 ' delay 180 ' begin 190 CLS:SCREEN 0:KEY OFF:COLOR 15,0 200 PRINT "*******************************" 210 PRINT "* F O U R I N A R O W *" 220 PRINT "* GW-Basic *" 230 PRINT "* by Eric F. Tchong *" 240 PRINT "* September 4, 1995 *" 250 PRINT "*******************************" 260 DIM H(6,7), T(6,7):B$="1":DEFSTR Q:Q=MKI$(0) 270 C$=CHR$(219):B1$=C$+C$+" "+C$+C$:B2$=" "+CHR$(222)+C$+CHR$(221)+" " 280 C1$=C$+C$+C$+C$+C$:C2$=C$+CHR$(221)+" "+CHR$(222)+C$:A$=" " 290 ' initialize 42 screen positions 300 FOR A=1 TO 6:FOR B=1 TO 7:READ T(A,B):NEXT:NEXT 310 DATA 15, 23, 31, 39, 47, 55, 63, 271, 279, 287, 295, 303, 311, 319 320 DATA 527, 535, 543, 551, 559, 567, 575, 783, 791, 799, 807, 815, 823, 831 330 DATA 1039,1047,1055,1063,1071,1079,1087,1295,1303,1311,1319,1327,1335,1343 340 RESTORE 350 FOR A=1 TO 6:FOR B=1 TO 7:H(A,B)=0:NEXT:NEXT 360 GOSUB 70 :LOCATE 9,10:PRINT "Player 1 ..........":LOCATE 9,20:INPUT S1$ 370 GOSUB 100:LOCATE 9,10:PRINT "Player 2 ..........":LOCATE 9,20:INPUT S2$ 380 ' draw board 390 CLS:GOSUB 60:GOSUB 150 ' board, 1 to 7 400 LOCATE 5,1:PRINT "PLAYER :":LOCATE 7,1:PRINT S1$:GOSUB 70 410 IF BT=42 THEN 1010 ELSE LOCATE 16,1:PRINT "Column? ":LOCATE 16,9:PRINT " " 420 GOSUB 160 ' get key 430 IF ASC(Q)<49 OR ASC(Q)>55 THEN 410 ELSE K=6 440 LOCATE 16,9:PRINT Q;:KK=VAL(Q) 450 IF H(K,KK)=0 THEN 470 ELSE K=K-1:GOTO 460 460 IF K=0 THEN 1030 ELSE GOTO 450 470 IF B$="1" THEN H(K,KK)=1 ELSE H(K,KK)=-1 480 Z=T(K,KK):GOSUB 50:PRINT "";:BT=BT+1 490 IF B$="1" THEN GOSUB 90:B$="2":LOCATE 7,1:PRINT STRING$(10,32);:GOSUB 40:IF W=1 OR W=2 OR W=3 OR W=4 THEN 730 ELSE LOCATE 7,1:PRINT S2$:GOSUB 100:GOTO 410 500 GOSUB 120:B$="1":LOCATE 7,1:PRINT STRING$(10,32);:GOSUB 40:IF W=1 OR W=2 OR W=3 OR W=4 THEN 730 ELSE LOCATE 7,1:PRINT S1$:GOSUB 70:GOTO 410 510 ' horizontal scan -- 520 A=K 530 FOR B=1 TO 4:Y=H(A,B)+H(A,B+1)+H(A,B+2)+H(A,B+3) 540 IF ABS(Y)=4 THEN W=1:RETURN ' 4-in-a-row -- 550 NEXT 560 ' vertical scan | 570 FOR A=1 TO 3:B=KK:Y=H(A,B)+H(A+1,B)+H(A+2,B)+H(A+3,B) 580 IF ABS(Y)=4 THEN W=2:RETURN ' 4-in-a-row | 590 NEXT 600 ' diagonal scan \ 610 FOR A=1 TO 3 620 FOR B=1 TO 4:Y=H(A,B)+H(A+1,B+1)+H(A+2,B+2)+H(A+3,B+3) 630 IF ABS(Y)=4 THEN W=3:RETURN ' 4-in-a-row \ 640 NEXT 650 NEXT 660 ' diagonal scan / 670 FOR A=1 TO 3 680 FOR B=4 TO 7:Y=H(A,B)+H(A+1,B-1)+H(A+2,B-2)+H(A+3,B-3) 690 IF ABS(Y)=4 THEN W=4:RETURN ' 4-in-a-row / 700 NEXT 710 NEXT:RETURN 720 ' there is a win 730 LOCATE 16,1:PRINT STRING$(9,32);:V=9:F=1:GOSUB 140 740 IF B$="2" THEN LOCATE 16,1:PRINT S1$; ELSE LOCATE 16,1:PRINT S2$; 750 LOCATE 17,1:PRINT "wins..."; 760 ON W GOTO 780,790,800,810 770 ' 1=-- 2=| 3=\ 4=/ 780 AA=T(A,B):BB=T(A,B+1):CC=T(A,B+2):DD=T(A,B+3):GOTO 830 790 AA=T(A,B):BB=T(A+1,B):CC=T(A+2,B):DD=T(A+3,B):GOTO 830 800 AA=T(A,B):BB=T(A+1,B+1):CC=T(A+2,B+2):DD=T(A+3,B+3):GOTO 830 810 AA=T(A,B):BB=T(A+1,B-1):CC=T(A+2,B-2):DD=T(A+3,B-3) 820 ' blank and flash winning blocks 830 FOR D=1 TO 10 840 Z=AA:GOSUB 130:Z=BB:GOSUB 130:Z=CC:GOSUB 130 850 Z=DD:GOSUB 130:GOSUB 170 ' delay 860 IF B$="1" THEN 880 870 Z=AA:GOSUB 80:Z=BB:GOSUB 80:Z=CC:GOSUB 80:Z=DD:GOSUB 80:GOTO 890 880 Z=AA:GOSUB 110:Z=BB:GOSUB 110:Z=CC:GOSUB 110:Z=DD:GOSUB 110 890 GOSUB 170 ' delay 900 NEXT 910 LOCATE 18,1:PRINT "Again (y/n) ?"; 920 GOSUB 160 ' get key 930 IF ASC(Q)=78 OR ASC(Q)=110 THEN 1450 ' N n 940 ' initialize new game 950 FOR X=1 TO 6:FOR Y=1 TO 7:Z=T(X,Y):GOSUB 130:H(X,Y)=0:NEXT:NEXT 960 LOCATE 16,1:PRINT STRING$(9,32);:LOCATE 17,1:PRINT STRING$(7,32):W=0 970 GOSUB 150:BT=0:B$="1" 980 LOCATE 18,1:PRINT STRING$(13,32);:X=0 990 LOCATE 7,1:PRINT S1$:GOSUB 70:GOTO 410 1000 ' it's a draw 1010 LOCATE 7,1:PRINT STRING$(9,32);:V=9:F=1:GOSUB 140 1020 LOCATE 16,1:PRINT STRING$(9,32);:LOCATE 16,1:PRINT "DRAW";:GOTO 910 1030 LOCATE 18,1:PRINT "FULL":BEEP 1040 GOSUB 170:LOCATE 18,1:PRINT STRING$(4,32);:GOTO 410 1050 ' print @ to locate 1060 V=INT(Z/64)+1:F=(V-1)*64:F=(Z-F)+1:LOCATE V,F:RETURN 1070 ' board 1080 FOR X=4 TO 20 STEP 4:LOCATE X,15:PRINT STRING$(55,196):NEXT 1090 FOR Y=22 TO 62 STEP 8:FOR X=1 TO 23:LOCATE X,Y:PRINT CHR$(179):NEXT:NEXT 1100 FOR X=4 TO 20 STEP 4:FOR Y=22 TO 62 STEP 8:LOCATE X,Y:PRINT CHR$(197):NEXT:NEXT 1110 COLOR 14,0 1120 LOCATE 1,1:PRINT "Þ Û IN A R" 1130 LOCATE 2,1:PRINT "ÛÜÛ O" 1140 LOCATE 3,1:PRINT " Û ROW" 1150 COLOR 15,0:RETURN 1160 ' draw X 1170 V=9:F=1:GOTO 1190 1180 GOSUB 50 ' draw at screen position 1190 COLOR 12,0 1200 FOR EQ=0 TO 2 1210 LOCATE V+EQ,F:IF EQ=1 THEN PRINT C2$ ELSE PRINT C1$ 1220 NEXT:COLOR 15,0:RETURN 1230 ' draw O 1240 V=9:F=1:GOTO 1260 1250 GOSUB 50 ' draw at screen position 1260 COLOR 10,0 1270 FOR EQ=0 TO 2 1280 LOCATE V+EQ,F:IF EQ=1 THEN PRINT B2$ ELSE PRINT B1$ 1290 NEXT:COLOR 15,0:RETURN 1300 ' blank X or O 1310 GOSUB 50 ' draw at screen position 1320 FOR EQ=0 TO 2:LOCATE V+EQ,F:PRINT A$ 1330 NEXT:RETURN 1340 ' print 1 to 7 1350 FOR Y=1 TO 7:Z=T(1,Y):GOSUB 50:PRINT Y:NEXT:RETURN 1360 ' get key 1370 LSET Q=MKI$(0) 1380 WHILE CVI(Q)=0:MID$(Q,1)=INKEY$:WEND 1390 IF ASC(Q)=27 THEN 1450 1400 RETURN 1410 ' delay a little 1420 T=TIMER+.0625 1430 WHILE TIMER