mirror of
https://github.com/inexorabletash/jsbasic.git
synced 2024-05-28 22:41:34 +00:00
4a27231196
* Applesoft Basic Columns Game Columns Game using lores graphics. * Update index.html Added links to Tetris and Columns games
357 lines
11 KiB
Plaintext
357 lines
11 KiB
Plaintext
10 rem Columns for Applesoft BASIC
|
|
20 rem Programed by Arthur Allen
|
|
30 rem Based on Columns by Jay Geertsen
|
|
|
|
|
|
60 dim array(50, 50), erase(25)
|
|
70 dim shape(2), nshape(3), check(50, 50)
|
|
|
|
90 gosub 2830: 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 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 = 1 + int (symbols * rnd(sd))
|
|
|
|
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 then goto 570 : rem Back to top of while flag loop
|
|
|
|
670 array(i, j) = candidate
|
|
680 color= 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) = 1 + int (symbols * rnd(sd))
|
|
780 next s
|
|
|
|
790 rem Make turn
|
|
800 x = 2 + int(width/2)
|
|
810 y = 0
|
|
820 rem Copy Next to current shape
|
|
830 for s = 0 to 2
|
|
840 shape(s) = nshape(s)
|
|
850 next s
|
|
|
|
890 rem pick next Next
|
|
900 for s = 0 to 2
|
|
910 nshape(s) = 1 + int (symbols * rnd(sd))
|
|
920 color= nshape(s)
|
|
930 plot width + 5 , y+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 if array(x, y) or array(x, y+1) or array(x, y+3) then goto 90 : 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 1630 : rem Move piece
|
|
1260 if cfl then 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 gosub 1920 : rem Draw shape (erase)
|
|
1300 y = y + 1 : xdr = 0
|
|
1310 goto 1530 : rem Send piece to bottom
|
|
|
|
|
|
1320 rem Process input
|
|
1330 a = PEEK (49152)
|
|
1340 get g$
|
|
1350 if g$ = " " then gosub 1960 : return : rem Check for rotate
|
|
1360 if g$ = "J" or a = 136 then gosub 1430 : return : rem Check for move left
|
|
1370 if g$ = "K" or a = 149 then gosub 1480 : return : rem Check for move right
|
|
1380 if g$ = "D" or a = 138 then gosub 1580 : return : rem Force 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" then gosub 2580 : return : rem Pause game
|
|
1415 if g$ = "R" then goto 460 : rem restart at prefill
|
|
1420 return
|
|
|
|
1430 rem Check for move left
|
|
1440 x1 = x : y1 = y
|
|
1450 x = x - 1
|
|
1460 gosub 1630 : rem Move piece
|
|
1470 return
|
|
|
|
1480 rem Check for move right
|
|
1490 x1 = x : y1 = y
|
|
1500 x = x + 1
|
|
1510 gosub 1630 : rem Move piece
|
|
1520 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 2060 : rem Draw, then Add to bottom
|
|
1570 goto 1530
|
|
|
|
1580 rem Force piece down
|
|
1590 y1 = y : x1 = x
|
|
1600 y = y + 1
|
|
1610 gosub 1630 : rem Move piece
|
|
1620 return
|
|
|
|
|
|
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 gosub 1820 : return : rem Return old values
|
|
1710 color= 0
|
|
1720 vlin y1, y1+2 at x1
|
|
1730 for s = 0 to 2
|
|
1740 color= shape(s)
|
|
1750 plot x, y+s
|
|
1760 next s
|
|
1770 return
|
|
|
|
1820 rem Return old values
|
|
1880 x = x1
|
|
1890 y = y1
|
|
1910 return
|
|
|
|
1920 rem Erase piece
|
|
1930 color=0
|
|
1940 vlin y, y+2 at x
|
|
1950 return
|
|
|
|
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
|
|
2020 color= 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 array(i, j) = 0 then goto 2310 : 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 then goto 790 : 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= 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= 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) then 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$ : null = peek (49168) : 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; " "
|
|
2810 vtab 23 : htab 1 : print "Total: "; dead
|
|
2820 return
|
|
|
|
2830 rem Front end screen
|
|
|
|
2840 rem gosub ? : rem Future 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)
|
|
2905 choice = 21 : rem vtab position of menu choice
|
|
|
|
2910 time = 500
|
|
2920 height = 39 : rem Full GR screen with text window. Cannot be larger than 47
|
|
2930 left = 2
|
|
|
|
2935 rem End of game gosubs to here, past splash screen and default values
|
|
|
|
2940 gr
|
|
2950 home
|
|
2970 color= 15 : rem Draw white borders
|
|
2980 vlin 0, height at left
|
|
2990 vlin 0, height at left + width + 1
|
|
2995 gosub 4240 : rem draw top line to indicate height.
|
|
|
|
3000 vtab 21 : print " Replay on cleared cell above ^ ";
|
|
3003 if renew then print "YES"
|
|
3005 if not renew then print "NO "
|
|
3007 if rows = 0 then vtab 21 : htab 36 : print "N/A"
|
|
3010 print " Width (3 - 34) "; width; : print " [ENTER] to start"
|
|
3020 print " Prefill (0 - 30) "; rows
|
|
3030 print " Colors (3 - 14) "; symbols;
|
|
3035 vtab choice : htab 1 : print "-->"; : rem draw arrow
|
|
|
|
3040 rem Combine the random number seed with a loop that polls for input for game options
|
|
3050 for sd = 0 to 32767
|
|
|
|
3060 if peek (49152) > 127 then goto 4000 : rem Process input if input detected
|
|
3070 a = rnd (sd * -1) : rem Dummy variable, just used to increment random number
|
|
|
|
3080 next sd
|
|
|
|
3090 goto 3050 : REM Return to top of sd to begin poll again
|
|
|
|
4000 rem Process Input
|
|
4010 a = PEEK (49152)
|
|
4020 get g$
|
|
|
|
4030 if g$ = "J" or a = 136 then gosub 4120 : rem left option
|
|
4040 if g$ = "K" or a = 149 then gosub 4180: rem right option
|
|
4050 if g$ = "D" or g$ = "M" or a = 138 then choice = choice + 1: rem down
|
|
4060 if g$ = "I" or a = 139 then choice = choice - 1: rem up
|
|
4070 if a = 141 then return : rem enter/return to start the game. This is why Process Input is not a subroutine
|
|
|
|
4080 if choice < 21 then choice = 24
|
|
4090 if choice > 24 then choice = 21
|
|
|
|
4110 goto 2940 : rem redraw screen
|
|
|
|
4120 rem Left Choice
|
|
4130 if choice = 21 then renew = 1 + renew * (-1): rem toggle Renew
|
|
4140 if choice = 22 then if width > 3 then width = width - 1: rem width
|
|
4150 if choice = 23 then if rows > 0 then rows = rows - 1 : rem prefill height
|
|
4160 if choice = 24 then if symbols > 3 then symbols = symbols - 1 : rem colors
|
|
4170 return
|
|
|
|
4180 rem Right Choice
|
|
4190 if choice = 21 then renew = 1 + renew * (-1): rem toggle Renew
|
|
4200 if choice = 22 then if width < 34 then width = width + 1: rem width
|
|
4210 if choice = 23 then if rows < 30 then rows = rows + 1 : rem prefill height
|
|
4220 if choice = 24 then if symbols < 14 then symbols = symbols + 1 : rem colors
|
|
4230 return
|
|
|
|
4240 rem Draw top line to indicate prefill height.
|
|
4250 if rows = 0 then return
|
|
4260 for i = 3 to width + 2
|
|
4270 candidate = 1 + int (symbols * rnd(sd))
|
|
4280 color= candidate
|
|
4290 plot i, 39 - rows
|
|
4300 next i
|
|
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 - 1 at j
|
|
4560 next j
|
|
4570 return
|
|
|