362 lines
10 KiB
Plaintext
362 lines
10 KiB
Plaintext
10 rem Tetris code
|
|
80 DEF FN SHCOLR(a) = ASC(MID$("@ACFIKLM",a + 1,1)) - 64
|
|
90 gosub 4550 : rem Title screen
|
|
100 time = 500
|
|
110 height = 39 : rem Cannot be larger than 47 (REALLY 39)
|
|
120 left = 0
|
|
130 width = 9
|
|
140 dim array(width + 1, height + 1), erase(height)
|
|
145 dim sp(7), tl(4)
|
|
150 gr
|
|
160 home
|
|
165 gosub 1850 : rem Set up shapes at bottom of screen
|
|
|
|
170 gosub 4240 : rem Set up total line labels
|
|
180 color= 15 : rem Draw borders
|
|
190 vlin 0, height at left
|
|
200 vlin 0, height at left + width + 1
|
|
|
|
210 rem Fill in borders in array
|
|
215 rem Fill bottom row
|
|
220 for fill = 0 to width + 1
|
|
230 array(fill, height+1) = 15
|
|
240 next fill
|
|
|
|
245 rem Fill left and right sides
|
|
250 for fill = 0 to height
|
|
260 array(0, fill) = 15 : erase(fill) = 0
|
|
265 FOR a = 1 TO width : array(a,fill) = 0 : NEXT
|
|
270 array(width+1, fill) = 15
|
|
275 next fill
|
|
|
|
280 sd = RND (-PEEK(79) * 999 - PEEK(78)): rem random number seed
|
|
285 eg=0 : tt = 0
|
|
290 gosub 3250: rem Choose piece
|
|
295 lshape = shape
|
|
|
|
300 rem Start playing
|
|
310 gosub 2020: rem Make turn
|
|
320 if not eg then 310
|
|
|
|
325 REM END OF GAME
|
|
330 VTAB 23 : HTAB 21 : PRINT "GAME OVER"
|
|
340 HTAB 20 : PRINT "PLAY AGAIN?";
|
|
350 a = PEEK(49152) : IF a < 128 GOTO 350
|
|
360 POKE 49168,0 : a = a - (a > 223) * 32
|
|
365 IF a = 206 THEN HTAB 20 : PRINT " GOODBYE FOR NOW!"; : END
|
|
370 IF a <> 217 GOTO 350
|
|
380 COLOR= 0 : FOR a = 1 TO width : VLIN 0,height AT a : NEXT
|
|
390 GOSUB 1700 : HOME : GOTO 170
|
|
|
|
395 REM CREATE SHAPE ARRAYS, READ SHAPE DATA (VARIANT OF OLD SUGGESTION)
|
|
400 DIM D1(7,4),D2(7,4),D3(7,4),D4(7,4),E1(7,4),E2(7,4),E3(7,4),E4(7,4)
|
|
410 FOR x = 1 TO 7
|
|
420 FOR y = 1 TO (x > 1 AND x < 5) * 2 + (x <> 5) + 1
|
|
430 READ D1(x,y),E1(x,y), D2(x,y),E2(x,y), D3(x,y),E3(x,y), D4(x,y),E4(x,y)
|
|
440 NEXT y,x
|
|
450 RETURN
|
|
|
|
490 rem Shape data
|
|
|
|
500 DATA -2,0, -1,0, 0,0, 1,0: rem Shape 1, rot 1; straight piece horizontal
|
|
510 DATA 0,-1, 0,0, 0,1, 0,2: rem Shape 1, rot 2; straight piece vertical
|
|
|
|
520 DATA -1,0, 0,0, 1,0, 1,-1: rem Shape 2, rot 1; L shape horizontal
|
|
530 DATA -1,-1, 0,-1, 0,0, 0,1:rem Shape 2, rot 2; L shape vertical
|
|
590 DATA -1,1, -1,0, 0,0, 1,0: rem Shape 2, rot 3
|
|
650 DATA 0,-1, 0,0, 0,1, 1,1: rem Shape 2, rot 4
|
|
|
|
710 DATA -1,0, 0,0, 1,0, 1,1: rem shape 3, rot 1; Reverse L shape
|
|
770 DATA 1,-1, 0,-1, 0,0, 0,1: rem shape 3, rot 2
|
|
830 DATA -1,-1, -1,0, 0,0, 1,0:rem shape 3, rot 3
|
|
840 DATA 0,-1, 0,0, 0,1, -1,1: rem shape 3, rot 4
|
|
|
|
850 DATA 0,-1, -1,0, 0,0, 1,0: rem shape 4, rot 1; T shape
|
|
860 DATA 0,-1, -1,0, 0,0, 0,1: rem shape 4, rot 2
|
|
870 DATA -1,0, 0,0, 1,0, 0,1: rem shape 4, rot 3
|
|
880 DATA 0,-1, 0,0, 1,0, 0,1: rem shape 4, rot 4
|
|
|
|
890 DATA 0,-1, 1,-1, 0,0, 1,0: rem shape 5; square
|
|
|
|
900 DATA 0,0, 1,0, -1,1, 0,1: rem shape 6, rot 1; S shape
|
|
910 DATA 0,-1, 0,0, 1,0, 1,1: rem shape 6, rot 2
|
|
|
|
920 DATA -1,-1, 0,-1, 0,0, 1,0:rem shape 7, rot 1; Z shape
|
|
930 DATA 0,-1, -1,0, 0,0, -1,1:rem shape 7, rot 2
|
|
|
|
1490 rem Shape "directory"
|
|
1500 a1 = D1(shape,rt) + x : b1 = E1(shape,rt) + y
|
|
1510 a2 = D2(shape,rt) + x : b2 = E2(shape,rt) + y
|
|
1520 a3 = D3(shape,rt) + x : b3 = E3(shape,rt) + y
|
|
1530 a4 = D4(shape,rt) + x : b4 = E4(shape,rt) + y
|
|
1540 return
|
|
|
|
1590 rem PAUSE
|
|
1600 VTAB 23 : HTAB 20 : PRINT "== PAUSED =="; : HTAB 20
|
|
1610 FOR a = 0 TO 1 : a = PEEK(49152) > 127 : NEXT
|
|
1620 POKE 49168,0 : CALL -868
|
|
1630 RETURN
|
|
|
|
1690 REM ERASE SHAPE IN "NEXT" WINDOW
|
|
1700 x = left + width + 5 : rem Offset shape for drawing in Next window
|
|
1710 y = 1 : rt = 1
|
|
1720 shape = lshape
|
|
1730 xdr = 1 : rem Set variable for erasing shape in last "next" window
|
|
|
|
1760 rem Draw shape
|
|
1770 color= 0 : if not xdr then color= FN SHCOLR(shape)
|
|
1790 gosub 1500 : rem get shape from directory
|
|
1800 plot a1, b1
|
|
1810 plot a2, b2
|
|
1820 plot a3, b3
|
|
1830 plot a4, b4
|
|
1840 return
|
|
|
|
1850 rem Set up shapes at bottom of screen
|
|
1860 rt = 1
|
|
1870 x = 14
|
|
1880 for shape = 1 to 7
|
|
1890 y = 38 - (shape = 3 OR shape = 6)
|
|
1900 gosub 1770 : rem Draw shape
|
|
1910 x = x + 4
|
|
1920 next shape
|
|
1930 return
|
|
|
|
1940 rem Check conflict
|
|
1945 rem Called from 4450 (Send piece to bottom) and 4790 (Move piece)
|
|
1950 cfl = 0
|
|
1960 gosub 1500 : rem Shape directory
|
|
1965 if a1 < 0 or b1 < 0 or a2 < 0 or b2 < 0 or a3 < 0 or b3 < 0 or a4 < 0 or b4 < 0 then cfl = 1 : return
|
|
1970 cfl = array(a1, b1) or array(a2, b2) or array(a3, b3) or array(a4, b4)
|
|
2010 return
|
|
|
|
2020 rem Make turn
|
|
2030 null = peek (49168) : rem Reset keyboard strobe
|
|
2040 t1 = time
|
|
2050 bot = 0
|
|
2060 drop = 0
|
|
2070 gosub 1700 : rem Draw (erase) shape in "next" window
|
|
2080 xdr = 0
|
|
2090 ns = lshape
|
|
2100 gosub 3250 : rem Pick shape
|
|
2110 gosub 1770 : rem Draw shape in "next" window
|
|
2120 lshape = shape
|
|
2130 shape = ns
|
|
2135 gosub 4160 : rem Calculate & print total shapes picked
|
|
2140 rem (Arbitrary numbering shift to 3000s due to typo)
|
|
3140 x = 1 + int(width/2) : rem Set x to middle of field for start of round
|
|
|
|
3150 rem Check for end of play
|
|
3160 gosub 1940 : rem Check for conflict
|
|
3170 if cfl then eg = 1 : return
|
|
3175 gosub 1770 : rem Draw shape
|
|
|
|
3180 rem Make move loop
|
|
3185 if drop then t1 = 1
|
|
3187 for clock = 0 to t1
|
|
3190 if peek (49152) > 127 then gosub 3280 : rem Process input if input detected
|
|
3200 next clock
|
|
|
|
3205 y1 = y : x1 = x : r1 = rt
|
|
3210 y = y + 1
|
|
3215 cfl = 0
|
|
3220 if not bot then gosub 4740 : rem Move piece
|
|
3230 if cfl goto 3660 : rem Add to shape & check for complete line
|
|
3233 if not bot goto 3180 : rem Back to top of Make move loop, else force to bottom
|
|
3235 y = y - 1 : xdr = 1
|
|
3239 gosub 1770 : rem Draw shape (erase)
|
|
3242 y = y + 1 : xdr = 0
|
|
3245 goto 4440 : rem Send piece to bottom
|
|
|
|
3250 rem Pick shape
|
|
3260 shape = int (rnd(sd) * 7) + 1
|
|
3270 return
|
|
|
|
3280 rem Process input
|
|
3285 a = PEEK (49152)
|
|
3290 get g$
|
|
3300 if g$ = " " goto 3480 : rem Check for rotate
|
|
3310 if g$ = "J" or a = 136 then a = -1 : goto 4720 : rem Check for move left
|
|
3320 if g$ = "K" or a = 149 then a = 1 : goto 4720 : rem Check for move right
|
|
3325 if g$ = "D" or a = 138 goto 4480 : rem Force down
|
|
3330 if g$ = "M" then bot = 1 : return : rem Send piece to bottom
|
|
3335 if g$ = "S" then drop = 1 : rem Speed up piece
|
|
3337 if g$ = "P" then goto 1600 : rem Pause game
|
|
3340 return
|
|
|
|
3470 rem Check for rotate (SHAPE 5 DOES NOT CHANGE)
|
|
3480 if shape = 5 then return
|
|
3490 r1 = rt : x1 = x : y1 = y
|
|
3500 gosub 3600 : rem Rotate directory
|
|
3510 goto 4740 : rem Move piece
|
|
|
|
3590 rem Rotate directory
|
|
3600 if shape = 1 or shape > 5 then rt = 3 - rt : return : rem Two way rotate
|
|
3610 if shape < 5 then rt = (rt < 4) * rt + 1 : rem Four way rotate
|
|
3620 return
|
|
|
|
3660 rem Check for complete line
|
|
3665 gosub 3770 : rem Add piece to board
|
|
3670 line = 0
|
|
3673 if y + 2 < height then dw = y + 2
|
|
3677 if y + 2 = > height then dw = height
|
|
3680 for row = y - 1 to dw
|
|
3690 hit = 0
|
|
3700 for c = 1 to width
|
|
3710 if not array (c, row) then hit = 1
|
|
3720 next c
|
|
3730 if not hit then erase(row) = 1 : line = line + 1
|
|
3740 next row
|
|
3750 if line goto 3850 : rem Blink & erase lines
|
|
3760 return
|
|
|
|
3770 rem Add to board
|
|
3790 gosub 1500 : rem Shape directory
|
|
3800 array (a1, b1) = shape
|
|
3810 array (a2, b2) = shape
|
|
3820 array (a3, b3) = shape
|
|
3830 array (a4, b4) = shape
|
|
3840 return
|
|
|
|
3850 rem Blink & erase lines
|
|
3853 gosub 4310 : rem Calculate & print total lines cleared
|
|
3860 for blink = 0 to 3
|
|
3865 color= 0
|
|
3870 for row = y - 1 to dw
|
|
3880 if erase (row) then hlin left + 1, left + width at row
|
|
3890 next row
|
|
3895 for zz = 0 to 300 : next zz : rem Time delay
|
|
3900 for row = y - 1 to dw
|
|
3910 if erase(row) then gosub 3950 : rem redraw line
|
|
3920 next row
|
|
3925 for zz = 0 to 300 : next zz : rem Time delay
|
|
3930 next blink
|
|
3933 goto 4020 : rem Restack shape
|
|
|
|
3950 rem Redraw line
|
|
3960 for c = 1 to width
|
|
3980 color= FN SHCOLR(array(c, row))
|
|
3990 plot c, row
|
|
4000 next c
|
|
4010 return
|
|
|
|
4020 rem Restack shape
|
|
4025 l1 = 0
|
|
4030 sh = 0
|
|
4040 row = dw
|
|
4043 rem Top of loop
|
|
4044 if row < 0 then gosub 4980 : goto 4060 : rem Clear top of shape
|
|
4045 if not erase (row) then gosub 4080 : goto 4060 : rem Shift row
|
|
4050 if erase (row) then sh = sh + 1 : erase (row) = 0
|
|
4060 row = row - 1
|
|
4065 if row + sh > 0 then 4044
|
|
4070 return
|
|
|
|
4080 rem Shift row
|
|
4085 hit = 0
|
|
4090 for c = 1 to width
|
|
4095 if array (c, row) then hit = 1 :rem If there is an active cell, it's not a completely blank line.
|
|
4100 array (c, row + sh) = array (c, row)
|
|
4110 color= FN SHCOLR(array (c, row))
|
|
4120 plot c, row + sh
|
|
4130 next c
|
|
4135 if not hit then l1 = l1 + 1 : rem If the line is completely blank
|
|
4140 if l1 > line then row = -4
|
|
4150 return
|
|
|
|
4160 rem calculate & print total shapes picked
|
|
4170 sp (shape) = sp (shape) + 1
|
|
4190 vtab 21
|
|
4200 htab shape * 4 + 10
|
|
4210 print sp(shape);
|
|
4230 return
|
|
|
|
4240 rem set up total line labels
|
|
4250 htab 1: vtab 21 : print "SIN"
|
|
4260 print "DOU" : print "TRI"
|
|
4270 print "TET" tab (10) "TOT";
|
|
4280 FOR a = 0 TO 4 : tl(a) = 0 : NEXT
|
|
4290 FOR a = 1 TO 7 : sp(a) = 0 : NEXT
|
|
4300 return
|
|
|
|
4310 rem calculate & print total lines cleared
|
|
4320 tl(line) = tl(line) + 1 : tt = tt + line
|
|
4350 htab 6
|
|
4360 vtab 20 + line
|
|
4370 print tl(line);
|
|
4390 htab 15
|
|
4400 vtab 24
|
|
4410 print tt;
|
|
4420 return
|
|
|
|
4430 rem Send piece to bottom - DROP IT DOWN UNTIL "CONFLICT" OCCURS (HITS OTHER PIECES OR BOTTOM)
|
|
4440 y = y + 1
|
|
4450 gosub 1940 : rem Check for conflict
|
|
4460 if cfl then y = y - 1 : gosub 1770 : goto 3660 : rem Draw, Add to bottom
|
|
4470 goto 4440
|
|
|
|
4480 rem Force piece down
|
|
4490 y1 = y : x1 = x : r1 = rt
|
|
4500 y = y + 1
|
|
4510 goto 4740 : rem Move piece
|
|
|
|
4550 rem Title screen
|
|
4555 pr#0
|
|
4560 text : home
|
|
4570 print "Tetris for Applesoft BASIC"
|
|
4580 print "Programmed by Arthur Allen"
|
|
4590 print "Based on Tetris by Alexey Pajitnov"
|
|
4600 print : print : print "Keys:"
|
|
4610 print "<-- or J to move piece left"
|
|
4620 print "--> or K to move piece right"
|
|
4630 print "<SPACE> to rotate piece anti-clockwise"
|
|
4640 print " | M to send piece to bottom"
|
|
4650 print " | or D to force piece down"
|
|
4660 print "\|/ S to speed up piece"
|
|
4670 htab 7 : print "P to pause game"
|
|
4680 print : GOSUB 400 : REM READ SHAPE DATA
|
|
4690 INPUT "Press Enter to begin";g$
|
|
4695 RETURN
|
|
|
|
4710 rem PREPARE TO MOVE PIECE LEFT OR RIGHT, THEN MOVE IT
|
|
4720 x1 = x : y1 = y : r1 = rt : x = x + a
|
|
|
|
4730 rem move piece
|
|
4740 c1 = a1 : d1 = b1
|
|
4760 c2 = a2 : d2 = b2
|
|
4770 c3 = a3 : d3 = b3
|
|
4780 c4 = a4 : d4 = b4
|
|
4790 gosub 1940 : rem Check for conflict
|
|
4800 if cfl goto 4900 : rem Return old values
|
|
4805 color= 0
|
|
4810 plot c1, d1
|
|
4820 plot c2, d2
|
|
4830 plot c3, d3
|
|
4840 plot c4, d4
|
|
4845 color= FN SHCOLR(shape)
|
|
4850 plot a1, b1
|
|
4860 plot a2, b2
|
|
4870 plot a3, b3
|
|
4880 plot a4, b4
|
|
4885 return
|
|
|
|
4890 rem Return old values
|
|
4900 a1 = c1 : b1 = d1
|
|
4910 a2 = c2 : b2 = d2
|
|
4920 a3 = c3 : b3 = d3
|
|
4930 a4 = c4 : b4 = d4
|
|
4940 rt = r1
|
|
4950 x = x1
|
|
4960 y = y1
|
|
4965 goto 1500 : rem Shape directory
|
|
|
|
4980 rem Clear top of shape
|
|
4990 color= 0
|
|
5000 hlin 1, width at row + sh
|
|
5010 for c = 1 to width
|
|
5020 array (c, row + sh) = 0
|
|
5030 next c
|
|
5040 return
|
|
|
|
5050 rem End of listing
|