10 rem Columns for Applesoft BASIC
20 rem Programmed by Arthur Allen
30 rem Based on Columns by Jay Geertsen

50 def fnsym(i) = int (symbols * rnd(1)) + 1 : def fncolr(i) = asc(mid$("@AFDCMKLEBGIHNJO",i + 1,1)) - 64
60 dim array(40, 42), erase(25)
70 dim shape(2), nshape(3), check(40, 42)

90 gosub 2840: rem Interactive pre-screen

350 home
360 rem Fill in borders in array
370 rem Fill bottom row
380 for fill = 0 to width + 6
390 array(fill, height+1) = 15
400 next fill

410 rem Fill left and right sides
420 for fill = 0 to height + 3
430 array(left, fill) = 15
440 array(left+width+1, fill) = 15
450 next fill
455 if renew then vtab 21 : htab left + int(width/2) + 1 : print "^" : rem print only if replay selected

460 rem Prefill board
465 gosub 4320 : rem blank out part of screen above prefill
470 guess = 1

480 if rows = 0 goto 720 : rem Skip if rows = 0, otherwise loop will still execute once
540 for i = 3 to width + 2
550 for j = height - rows + 1 to height
555 cycle = 0

570 rem Top of while flag loop
580 flag = 0
583 rem Set i back by one if a stable cell (one that won't trip a three in a row) isn't found in 10 attempts.  Set i to 3 if i is less than 3
585 cycle = cycle + 1
587 if cycle > 10 then guess = guess + 1 : vtab 22 : print "Attempt: "; guess; ", x pos: "; i; "  " : i = i - 1 : if i < 3 then i = 3

590 candidate = fnsym(0)

600 rem Proximity checking
610 if array(i - 1, j) = candidate then if array(i - 2, j) = candidate then flag = 1 : rem same symbol horz left
620 if array(i, j - 1) = candidate then if array(i, j - 2) = candidate then flag = 1 : rem same symbol up
630 if array(i - 1, j - 1) = candidate then if array(i - 2, j - 2) = candidate then flag = 1 : rem same symbol diag left & up
640 if array(i - 1, j + 1) = candidate then if array(i - 2, j + 2) = candidate then flag = 1 : rem same symbol diag left & down
660 if flag goto 570 : rem Back to top of while flag loop

670 array(i, j) = candidate
680 color= fncolr(candidate)
690 plot i, j
700 next j
710 next i

720 rem Pick piece for initial Next window
730 rem Pick shape
740 for s = 0 to 2
750 nshape(s) = fnsym(0)
780 next s

790 rem Make turn
800 x = int(width/2) + 2
810 y = 0
820 rem Copy Next to current shape, get new Next
830 for s = 0 to 2
840 shape(s) = nshape(s)
910 nshape(s) = fnsym(0)
920 color= fncolr(nshape(s))
930 plot width + 5, s
940 next s

1020 t1 = time
1050 bot = 0
1060 drop = 0

1120 rem Check for end of play
1130 rem Check for conflict
1140 cfl = array(x, y) or array(x, y+1) or array(x, y+2)
1145 if cfl then gosub 3000 : goto 350 : rem end of game, go to front end

1150 rem Make move loop
1160 if drop then t1 = 1
1170 for clock = 0 to t1
1180 if peek (49152) > 127 then gosub 1320 : rem Process input if input detected
1190 next clock

1200 y1 = y : x1 = x
1210 y = y + 1
1220 cfl = 0
1240 if not bot then gosub 1670 : rem Move piece
1260 if cfl goto 2060 : rem Add to shape & check for complete three in a row
1270 if not bot then 1150 : rem Back to top of Make move loop, else force to bottom
1280 y = y - 1 : xdr = 1
1290 color= 0 : vlin  y, y+2 at x : rem Erase shape
1300 y = y + 1 : xdr = 0
1310 goto 1530  : rem Send piece to bottom

1320 rem Process input
1330 for s = 0 to 1 : a = PEEK (49152) : s = a > 127 : next
1340 get g$
1350 if g$ = " " goto 1970 : rem Check for rotate
1360 s = (g$ = "D" or a = 138) * 2 + (g$ = "K" or a = 149) - (g$ = "J" or a = 136)
1370 if s goto 1590 : rem move left/right/down
1390 if g$ = "M" then bot = 1 : return : rem Send piece to bottom
1400 if g$ = "S" then drop = 1 : rem Speed up piece
1410 if g$ = "P" goto 2580 : rem Pause game
1415 if g$ = "R" goto 460 : rem restart at prefill
1420 return

1530 rem Send piece to bottom
1540 y = y + 1
1545 cfl = 0
1550 if array(x, y+2) then cfl = 1 : rem Check for conflict
1560 if cfl then y = y - 1 : gosub 2010 : goto 2070  : rem Draw, then Add to bottom
1570 goto 1540

1580 rem shift piece left, right, or down
1590 y1 = y : x1 = x : s = (s<2) * s
1600 x = x + s : y = y + not s

1630 rem move piece
1670 cfl = 0
1680 if array(x, y) or array(x, y+1) or array(x, y+2) then cfl = 1 : rem Check for conflict
1700 if cfl then x = x1 : y = y1 : return : rem Return old values
1710 color= 0
1720 vlin  y1, y1+2 at x1
1730 goto 2010

1960 rem Rotate
1970 swap = shape (2)
1980 shape (2) = shape (1)
1990 shape (1) = shape (0)
2000 shape (0) = swap

2010 for s = 0 to 2 : rem Draw shape, called from 1560 & 1730
2020 color= fncolr(shape(s))
2030 plot x, y+s
2040 next s
2050 return

2060 rem Check field

2070 rem Add shape to board
2080 for s = 0 to 2
2090 array(x, y + s) = shape(s)
2100 next s

2110 rem While found (contol at line 2340. End of loop at 2560)
2120 found = 0

2130 rem Initialize array
2140 for i = 3 to width + 3
2150 for j = 0 to height
2160 check(i, j) = 0
2170 next j
2180 next i

2190 rem Start checking for three in a row
2200 for j = 2 to height
2210 for i = 3 to width + 2
2220 if not array(i, j) goto 2320 : rem Skip dead cells

2230 rem Check horizontal
2240 if array(i, j) = array(i - 1, j) and array(i, j) = array(i + 1, j) then check(i - 1, j) = 1 : check(i, j) = 1 : check(i + 1, j) =1 : found = 1

2250 rem Check vertical
2260 if array(i, j) = array(i, j - 1) and array(i, j) = array(i, j + 1) then check(i, j - 1) = 1 : check(i, j) = 1 : check(i, j + 1) = 1 : found = 1 : rem vtab 21 : htab 1 : print "2260 found vertical, j+1 = ";  j+1; : rem temp code

2270 rem Check diagonal left
2280 if array(i, j) = array(i - 1, j - 1) and array(i, j) = array(i + 1, j + 1) then check(i - 1, j - 1) = 1 : check(i, j) = 1 : check(i + 1, j + 1) = 1 : found = 1

2290 rem Check diagonal right
2300 if array(i, j) = array(i + 1, j - 1) and array(i, j) = array(i - 1, j + 1) then check(i + 1, j - 1) = 1 : check(i, j) = 1 : check(i - 1, j + 1) = 1 : found = 1

2310 rem End if skip dead cells
2320 next i
2330 next j

2335 gosub 2740 : rem Count cells to be removed.

2357 rem while not found control:
2340 if not found goto 800 : rem Goto Make turn

2350 rem Flash cells
2355 rem gosub 2610 : rem Draw parallel field of check cells
2360 for blink = 0 to 1

2370 color= 0
2380 for j = 2 to height
2390 for i = 3 to width + 2
2400 if check(i, j) then plot i, j
2410 next i
2420 next j

2430 for j = 2 to height
2440 for i = 3 to width + 2
2450 if check(i, j) then color= fncolr(array(i, j)) : plot i, j
2460 next i
2470 next j
2480 next blink

2490 rem Remove cells from board
2500 for i = 3 to width + 2
2505 offset = 0
2510 for j = height to 0 step -1
2520 if not check(i,j) then array(i, j + offset) = array(i, j) : color= fncolr(array(i, j)): plot i, j + offset
2530 if check(i, j) then offset = offset + 1 
2540 next j
2550 next i

2555 if renew then if rows > 0 then if check(left + int(width/2),height) goto 460 : rem end of screen, go to prefill board

2560 goto 2110 : rem To top of while found loop
2570 rem End of Check field subroutine

2580 rem Pause game
2590 if peek (49152) = 141 then get g$ : return
2600 goto 2580

2740 rem Count deleted cells
2745 nowdead = 0
2750 for j = 2 to height
2760 for i = 3 to width + 2
2770 if check (i, j) then dead = dead + 1: nowdead = nowdead + 1
2780 next i
2790 next j
2800 vtab 22 : htab 1 : print "Cleared: "; nowdead; : call -868
2810 print : print "Total:" spc(3) dead
2820 return

2830 rem Front end screen

2840 gosub 5000 : rem Show animated splash screen

2860 rem setup default values and screen
2870 rows = 20 : rem Prefill rows
2880 width = 6
2890 symbols = 5
2900 renew = 1 : rem replay value (yes = 1/no = 0)

2920 height = 39 : rem Full GR screen with text window. Cannot be larger than 39
2930 left = 2

2935 rem End of game gosubs to here, past splash screen and default values

3000 time = 500 : sd=RND(-PEEK(79)*999-PEEK(78))
3005 gosub 4200 : home : print "--> Replay on cleared cell above ^ "; : gosub 4180 : print
3010 htab 5 : print "Width (3 - 34) "; width; tab(24) "[ENTER] to start"
3020 htab 5 : print "Prefill (0 - 30) "; rows
3030 htab 5 : print "Colors (3 - 13) "; symbols;
3040 if cfl then htab 26 : print "[ESC] to exit"; : htab 1
3050 vtab 21 : choice = 21 : rem vtab position of menu choice

4000 rem Process Input
4020 for s = 0 to 1 : a = PEEK (49152) : s = a > 127 : next : get g$

4050 i = (g$ = "D" or g$ = "M" or a = 138) - (g$ = "I" or a = 139)
4060 if i then i = choice + i : htab 1 : print spc(3) : choice = ((i = 20) - (i = 25)) * 4 + i : vtab choice : htab 1 : print "-->"; : goto 4020 : rem up/down
4070 if a = 141 then return : rem enter/return to start the game.  This is why Process Input is not a subroutine
4075 if cfl and a = 155 then pop : home : print : print "BYE!" : end
4080 a = (g$ = "K" or a = 149) - (g$ = "J" or a = 136)
4090 on not a goto 4020 : on choice - 20 gosub 4130,4140,4150,4160
4092 on not a goto 4020 : vtab choice : htab asc(mid$("dTVU",choice - 20,1)) - 64
4094 if choice > 21 then print i spc(1) : on choice/12 gosub 4200,4250 : if choice = 23 and (rows = a or not rows) then vtab 21 : htab 36 : a=2
4095 if choice = 21 or a = 2 then gosub 4180 : htab 1
4100 vtab choice : goto 4020

4120 rem Left & Right Choices
4130 renew = 1 - renew: a = rows : return : rem toggle Renew
4140 i = width + a : a = (i > 2 and i < 35) * a : width = width + a : return : rem width
4150 i = rows + a : a = (i >= 0 and i < 31) * a : rows = rows + a : return : rem prefill height
4160 i = symbols + a : a = (i > 2 and i < 14) * a : symbols = symbols + a : return : rem colors

4180 print mid$("N/ANO YES",(rows > 0) * (renew + 1) * 3 + 1,3); : return

4200 gr : color= 15 : rem Draw white borders
4210 vlin 0, height at left
4220 vlin 0, height at left + width + 1

4240 rem Draw top line to indicate prefill height.
4250 if not rows then return
4260 for s = 3 to width + 2
4270 color= fncolr(fnsym(1))
4290 plot s, height - rows + 1
4300 next
4310 return

4320 rem Blank out the part of screen above prefill. Called at start of every screen, and on an "R" press
4330 color = 0 : rem black
4340 for j = left + 1 to width + 2
4350 vlin 0, height - rows at j
4360 for i = 0 to height - rows : array(j,i) = 0 : next i,j
4370 return

4990 rem Animated splash screen by Alan Ratliff
5000 pr#0 : gr : color= 3 : vlin 1,9 at 2 : plot 3,28 : plot 3,38 : plot 4,0 : plot 4,10 : plot 5, 29 : plot 5,37
5010 vlin 13,37 at 32 : vlin 16,34 at 26 : vlin 11,24 at 16 : vlin 14,27 at 11
5020 home : color= 1 : vlin 29,37 at 7 : plot 8,0 : plot 8,10 : plot 9,28 : plot 9, 38 : vlin 1,9 at 10
5030 vlin 14,30 at 36 : vlin 15,36 at 22 : vlin 16,32 at 2 : plot 30,11 : plot 13,25 : vlin 2,8 at 17
5040 color= 11 : vlin 0,10 at 12 : plot 13,38 : plot 14,10 : plot 15, 38
5050 vlin 15,38 at 30 : vlin 13,34 at 20 : vlin 11,24 at 6 : plot 26,13
5060 color= 9 : vlin 28,37 at 17 : plot 18,10 : plot 19,38 : vlin 0,9 at 20
5070 vlin 17,33 at 34 : vlin 12,37 at 24 : vlin 8,23 at 9 : plot 12,36
5080 color= 13 : vlin 0,10 at 22 : vlin 30,31 at 23 : vlin 4,6 at 24 : vlin 30,31 at 25 : vlin 0,10 at 26
5090 vlin 17,36 at 14 : vlin 14,35 at 4 : plot 34,12 : vlin 2,9 at 7
5100 color= 4 : vlin 0,10 at 28 : vlin 30,31 at 29 : vlin 4,6 at 30 : vlin 35,36 at 31 : vlin 0,10 at 32
5110 vlin 14,30 at 18 : plot 37,2 : plot 37,8 : plot 34,36 : plot 26,38 : plot 2,12 : plot 2,36 : vlin 30,37 at 10 : vlin 1,8 at 5
5120 color= 6 : vlin 1,4 at 34 : plot 34,9 : plot 35,28 : plot 35,33 : plot 35,38 : plot 36,0 : plot 36,5 : plot 36,10 : plot 37,29 : vlin 34,37 at 37
5130 vlin 14,37 at 28 : vlin 21,31 at 8 : plot 19,4 : plot 13,13 : vlin 1,8 at 15 : vlin 27,33 at 12
5140 for i = 1 to 2000 : next i : a = 21 ^ not a : for a = a to (a > 1) * 37 + 14 : for s = 2 to 18 step 2
5150 for i = 0 to 1 : k = a - (s + i + 18) * (a > 20) : k = (k > 0 and k < 15) * k : on not k goto 5400 : y = 39 - s * 2
5160 for j = 0 to y step y : x = sgn(1-j) * i + s + j : y = x / 2 : y = int(y) = y : k = abs(k) : if y then k = -k
5170 h = sgn(k) : y = 28 - y * 18 - k : for y = y to h * 10 + y step h : color= scrn(x,y+h) : plot x,y : next
5180 color= 0 : hlin x,x - h at y : next
5400 next i,s,a : a = 1.5 : for x = 34 to 37 : color= (a<2) * 8 + a : a = a * 2 : y = x * 2
5410 hlin 39 - x,x at 79 - y : hlin 39 - x,x at y - 41 : next
5420 htab 9 : print "Created by JAY GEERTSEN"
5430 for a = 1 to 12000 : next a
5440 print : htab 5 : print "Applesoft coding by ARTHUR ALLEN"

5580 rem Key guide screen
5590 for a = 1 to 48000 : next a : text : home
5600 vtab 3 : print "Keys used:" : print
5610 print "<-- or J to move piece left"
5620 print "--> or K to move piece right"
5630 print "<SPACE> to rotate colors downward"
5640 print " |" spc(4) "M to send piece to bottom"
5650 print " | or D to force piece down"
5660 print "\|/" spc(3) "S to speed up piece"
5670 htab 7 : print "R to restart at prefill level"
5680 htab 7 : print "P to pause game"
5690 vtab 21 : print "Press a key to choose game settings"
5700 print : print "(or <-- or --> to see Splash again) "; : get g$
5710 i = asc(g$) : a = i = 21 : on i = 8 or a goto 5000 : home : return