Four in a Row is the Connect Four game for one or two players. Players take turns to drop red or green counters into a 7-column, 6-row grid by pressing 1 to 7; the first to line up four in a row, column or diagonal wins, and a full board is a stalemate. Against the computer you choose your colour and the QL announces “My move – I’m thinking!” while it searches for a reply.
The REMs credit David Nowotnik and date it December 1984.
Program Analysis
The main loop calls start_up, then one_player or two_players. Separate functions test for a win horizontally, vertically and on both diagonals (horizontal, vertical, diag1, diag2), and computer chooses the computer’s column.
Notable Techniques
- Structured SuperBASIC:
SELect ON,DEFine FuNctionand namedREPeatloops throughout.
Potential Issues
- Line 1020 saves the program back to
mdv1_connect; the floppy-image copy saves toflp1_connect.
It came from a QL owner’s floppy copies of QUANTA and IQLUG library material, imaged double-stepped so that only half of each disk survived; this file read back complete. The download holds the files exactly as recovered and a QL5A floppy image, Four in a Row.img, with the same files and their QDOS headers. Mount the image as FLP1_ (drop it on the QLRun page, or use it as a floppy image in sQLux, QPC2 or Q-emuLator) and type lrun flp1_connect_bas. In the image copies only, mdv1_connect reads flp1_connect so the program finds its files on the floppy.
Tested in QLRun with the JS ROM: the menu and a one-player game with the computer replying.
Image Gallery
Source Code
100 REMark Four in a row
110 REMark by David Nowotnik
120 REMark December, 1984
130 REMark
140 REMark Main routine
180 REPeat try
190 init
200 ss=start_up
210 SELect ON ss
220 =1: one_player
230 =2: two_players
240 END SELect
250 END REPeat try
390 REMark ***************************
400 DEFine PROCedure two_players
420 set_up_board
430 colour(1)=2: colour(2)=4
440 nxt= RND (1 TO 2)
450 PRINT #0," Player ";nxt;" goes first": PAUSE 200
460 REPeat game2
465 IF stalemate THEN EXIT game2
470 p=next_play (nxt)
480 q=drop_counter (nxt,p)
490 IF win_check (p,q) THEN EXIT game2
500 nxt=3-nxt
510 END REPeat game2
520 IF stalemate THEN
530 CLS #0: PRINT #0," Stalemate": STOP
540 ELSE
550 CLS #0: PRINT#0,"Player ";nxt;" has won"
560 winner
580 END IF
680 END DEFine
690 REMark ***************************
700 DEFine PROCedure one_player
710 LOCal p,q
720 set_up_board
730 PRINT #0," Select your colour (r/g)"
740 REPeat choose
750 colour$=INKEY$(-1): IF colour$="r" OR colour$="g" THEN EXIT choose
760 END REPeat choose
770 player$(1)="Your move ": player$(2)="Computer's move"
780 IF colour$="r" THEN
790 colour(1)=2: colour(2)=4
800 ELSE : colour(1)=4: colour(2)=2
810 END IF
820 nxt = RND (1 TO 2)
825 CLS #0: PRINT #0,player$(nxt);" first": PAUSE 200
830 REPeat game1
840 IF stalemate THEN EXIT game1
850 SELect nxt
860 =1: p=next_play (nxt)
870 q=drop_counter (nxt,p)
880 =2: p= computer: q=drop_counter (nxt,p)
890 END SELect
900 CLS #0: IF win_check (p,q) THEN EXIT game1
910 nxt=3-nxt
920 END REPeat game1
930 IF stalemate THEN
935 PRINT #0," Stalemate": PAUSE 200: EXIT one_player
940 ELSE
945 SELect nxt
950 =1: PRINT #0," You win"
955 =2: PRINT #0," I win!!"
960 END SELect
970 winner
975 END IF
980 END DEFine
990 REMark ******************************
1000 DEFine PROCedure p_save
1020 DELETE mdv1_connect: SAVE mdv1_connect
1030 END DEFine
1040 REMark *****************************
5000 DEFine PROCedure init
5005 MODE 4
5010 WINDOW #1,512,256,0,0
5020 WINDOW #2,300,180,104,52
5030 PAPER #1,4: PAPER #2,1
5040 INK 2: CLS: INK #2,7
5050 CSIZE#1,2,1
5060 OPEN#4,scr:WINDOW #4,300,30,104,22
5070 PAPER #4,7: INK #4,0: CSIZE #4,2,1
5080 DIM a$(7,6), d$(7,6), c$(7,6), l(4,2), colour(2), mm(7), player$(2,15)
5090 WINDOW #0,300,20,104,234: CSIZE #0,2,1
5100 FOR j=1 TO 7: a$(j)=" ": NEXT j
5180 END DEFine
5190 REMark *****************************
5200 DEFine PROCedure set_up_board
5210 CLS: CLS #2: CLS #4:INK 2
5230 AT 0,14: PRINT "FOUR IN A ROW"
5240 INK 7: circles
5250 CLS#0
5280 END DEFine
5290 REMark *****************************
5300 DEFine FuNction start_up
5305 LOCal z,z$
5310 CLS: AT 2,14: INK 0: PRINT "FOUR IN A ROW"
5320 INK 2: PRINT\" Select:"
5330 PRINT " 1. One Player"
5340 PRINT " 2. Two Players"
5350 INK 0: PRINT " Press '1' or '2'"
5360 REPeat loop
5370 z$=INKEY$(-1)
5380 IF z$="1" OR z$="2" THEN EXIT loop
5390 END REPeat loop
5400 z=z$: RETurn z
5410 END DEFine
5450 REMark ****************************
6000 DEFine PROCedure circles
6010 FOR i=40 TO 110 STEP 11
6020 FOR j=16 TO 76 STEP 11
6030 FILL 1:CIRCLE i,j,5:FILL 0
6040 NEXT j: NEXT i
6060 END DEFine
6080 REMark ******************************
6500 DEFine PROCedure heading
6510 FOR i=1 TO 7
6520 AT #4,0,i*3: PRINT #4,i
6530 NEXT i
6540 END DEFine
6570 REMark ********************************
6600 DEFine FuNction drop_counter (col,pos)
6610 LOCal c,pos1,num,ypos
6620 CLS #4: c= colour(col): INK c
6630 pos1=29+pos*11: FILL 1: CIRCLE pos1,86,5
6640 PAUSE 50: CLS #4: num=6: ypos=71
6650 REPeat falling
6660 FILL 1: INK c: CIRCLE pos1,ypos,5: FILL 0
6670 IF num=1 THEN EXIT falling
6680 IF a$(pos,num-1)<>" " THEN EXIT falling
6690 FILL 1: INK 7: CIRCLE pos1,ypos,5: FILL 0
6700 num=num-1: ypos=ypos-11
6710 END REPeat falling
6720 a$(pos,num)=c/2
6730 RETurn num
6880 END DEFine
6990 REMark *****************************
7000 DEFine FuNction next_play (player)
7010 LOCal c,z,z$
7020 c= colour (player): INK #0,c: heading
7030 PRINT #0," Select column (1 to 7)"
7035 REPeat check
7040 REPeat wait
7050 z$=INKEY$(-1)
7060 IF z$>"0" AND z$<"8" THEN EXIT wait
7070 END REPeat wait
7074 z=z$: IF a$(z,6)=" " THEN EXIT check
7076 END REPeat check
7080 CLS #0: CLS #4
7090 RETurn z
7100 END DEFine
7150 REMark *************************
7200 DEFine FuNction stalemate
7210 LOCal i
7220 FOR i=1 TO 7
7230 IF a$(i,6)=" " THEN EXIT i
7240 NEXT i
7250 RETurn 1
7260 END FOR i
7270 RETurn 0
7280 END DEFine
7290 REMark ***************************
7500 DEFine FuNction win_check (p,q)
7510 LOCal x,y: x=p: y=q
7520 IF horizontal (y) THEN RETurn 1
7530 IF vertical (x) THEN RETurn 1
7540 IF diag1 (x,y) THEN RETurn 1
7550 IF diag2 (x,y) THEN RETurn 1
7560 RETurn 0
7570 END DEFine
7590 REMark ******************************
7600 DEFine FuNction horizontal (hh)
7610 LOCal i,j: j=hh
7615 b$=" ": c=0
7620 FOR i=1 TO 7
7630 IF four_in_row (i,j) THEN RETurn 1
7640 NEXT i
7650 RETurn 0
7660 END DEFine
7690 REMark ***************************
7800 DEFine FuNction four_in_row (i,j)
7820 IF a$(i,j)=" " THEN c=0: b$=" ": RETurn 0
7830 IF a$(i,j)<>b$ THEN
7840 c=1: b$=a$(i,j): l(c,1)=i
7850 l(c,2)=j: RETurn 0
7860 END IF
7870 c=c+1: l(c,1)=i: l(c,2)=j
7880 IF c=4 THEN
7885 RETurn 1
7890 ELSE : RETurn 0
7900 END IF
7910 END DEFine
7950 REMark *******************************
8000 DEFine FuNction vertical (vert)
8010 LOCal i,j: i=vert: b$=" ":c=0
8020 FOR j=1 TO 6
8030 IF four_in_row (i,j) THEN RETurn 1
8040 NEXT j
8050 RETurn 0
8060 END DEFine
8080 REMark ****************************
8100 DEFine FuNction diag1 (e,f)
8105 LOCal h,v: h=e:v=f:b$=" ": c=0
8110 REPeat left
8120 IF h=1 OR v=1 THEN EXIT left
8130 h=h-1: v=v-1
8140 END REPeat left
8150 REPeat find
8160 IF four_in_row (h,v) THEN RETurn 1
8170 h=h+1: v=v+1
8180 IF h>7 OR v>6 THEN EXIT find
8190 END REPeat find
8200 RETurn 0
8210 END DEFine
8240 REMark *************************
8400 DEFine FuNction diag2 (e,f)
8405 LOCal h1,v1: h1=e:v1=f:b$=" ":c=0
8410 REPeat right
8420 IF h1=7 OR v1=1 THEN EXIT right
8430 h1=h1+1: v1=v1-1
8440 END REPeat right
8450 REPeat find1
8460 IF four_in_row (h1,v1) THEN RETurn 1
8470 h1=h1-1: v1=v1+1
8480 IF h1<1 OR v1>6 THEN EXIT find1
8490 END REPeat find1
8500 RETurn 0
8510 END DEFine
8550 REMark *************************
8600 DEFine PROCedure winner
8610 colour (3-nxt)=7: tint=2
8630 FOR i=1 TO 4
8640 l(i,1)=29+l(i,1)*11
8650 l(i,2)=5+l(i,2)*11
8660 NEXT i
8670 REPeat flash4
8680 INK colour (tint)
8690 FOR i=1 TO 4
8700 FILL 1: CIRCLE l(i,1),l(i,2),5: FILL 0
8710 NEXT i
8720 tint=3-tint
8730 IF INKEY$(0)<>"" THEN EXIT flash4
8740 END REPeat flash4
8750 END DEFine
8780 REMark ***********************************
9000 DEFine FuNction computer
9010 LOCal i,j,z: a_to_b
9020 FOR j=1 TO 7: mm(j)=0: NEXT j
9030 CLS #0: PRINT #0," My move - I'm thinking!"
9040 FOR i=1 TO 7
9050 b_to_a: IF a$(i,6)<>" " THEN mm(i)=1: EXIT i
9060 IF can_I_win (i) THEN EXIT i
9070 next_check (i)
9080 can_you_win (i)
9090 END FOR i
9100 b_to_a
9110 FOR j=1 TO 7: IF mm(j)=2 THEN RETurn j: NEXT j
9120 FOR j=1 TO 7
9130 IF mm(j)=2 THEN RETurn j
9140 NEXT j
9150 FOR j=1 TO 7
9160 IF mm(j)=3 THEN RETurn j
9170 NEXT j
9180 FOR i=1 TO 50
9190 z= RND (1 TO 7)
9200 IF mm(z)=0 THEN RETurn z
9210 NEXT i
9220 FOR j=1 TO 7
9230 IF mm(j) <>1 THEN RETurn j
9240 NEXT j
9250 END DEFine
9280 REMark ****************************
9300 DEFine PROCedure a_to_b
9310 LOCal k
9320 FOR k=1 TO 7: d$(k)=a$(k): NEXT k
9330 END DEFine
9340 REMark ****************************
9350 DEFine PROCedure b_to_a
9360 LOCal k
9370 FOR k=1 TO 7: a$(k)=d$(k): NEXT k
9380 END DEFine
9390 REMark ***************************
9400 DEFine PROCedure a_to_c
9410 LOCal k
9420 FOR k=1 TO 7: c$(k)=a$(k): NEXT k
9430 END DEFine
9440 REMark ****************************
9450 DEFine PROCedure c_to_a
9460 LOCal k
9470 FOR k=1 TO 7: a$(k)=c$(k): NEXT k
9480 END DEFine
9490 REMark ****************************
9500 DEFine FuNction drop_one (n,p)
9510 LOCal z
9520 z=6
9530 REPeat skip
9540 IF z=1 THEN a$(p,1)=n: EXIT skip
9550 IF a$(p,z-1)<>" " THEN a$(p,z)=n: EXIT skip
9555 z=z-1
9560 END REPeat skip
9570 RETurn z
9580 END DEFine
9590 REMark ****************************
9600 DEFine FuNction can_I_win (p)
9610 LOCal q: b_to_a
9620 q= drop_one (2,p)
9630 IF win_check (p,q) THEN
9640 mm(p)=2: RETurn 1
9650 ELSE : RETurn 0
9660 END IF
9670 END DEFine
9690 REMark **************************
9700 DEFine PROCedure can_you_win (p)
9710 LOCal q: b_to_a
9720 q=drop_one (1,p)
9730 IF win_check (p,q) THEN mm(p)=3
9740 END DEFine
9780 REMark ****************************
9800 DEFine PROCedure next_check (p)
9810 LOCal q: a_to_c
9820 q=drop_one (1,p)
9830 IF win_check (p,q) THEN mm(p)=4
9840 c_to_a
9850 END DEFine
9870 REMark *****************************Note: Type-in program listings on this website use ZMAKEBAS notation for graphics characters.