335 lines
13 KiB
Plaintext
335 lines
13 KiB
Plaintext
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
|