Back in 1992, I had written a version of Tetris for QuickBasic. It certainly runs faster now on the processors currently available. It won't run under Vista, as that does not allow DOS full-screen graphics, but it works under XP Home and XP Professional. But it was a quick modification to limit it to a given number of columns, and to override the random choice of piece with a constant piece.
As mentioned before, if you want to run this, the QuickBasic 4.5 IDE is available at http://www.winsite.com/bin/Info?14000000036569, http://www.qbcafe.net/qbc/english/download/compiler/qbasic_compiler.shtml and other sites. Also see the Wikipedia article http://en.wikipedia.org/wiki/QuickBASIC.
The QuickBasic environment is entered from a Command Prompt in the directory in which the above software was loaded. In the case of this program, which needs large arrays, the /AH switch is needed on QB's invocation:
QB /AH
You can slow down the speed with - or speed it up with +. It's intended for use with NumLock on so it uses 4 to go left, 6 to go right, 2 to drop the piece into place and 5 to rotate CCW.
This version is only for tetrominoes, not pentominos.
It's set for piece 3 (the L) with 3 columns, as in part 1 of the puzzle, but perpetPiece and gWidth are set early in the program and can be changed:
DEFINT A-Z
RANDOMIZE TIMER
SCREEN 12
' $DYNAMIC
perpetPiece = 3
gWidth = 3
DIM sh&(850, 1 TO 7, 1 TO 4), area&(10000)
DIM grid(20, gWidth)
DATA 6,14
DATA -2,0, -1,0, 0,0, 1,0, 0,-2, 0,-1, 0,0, 0,1 : '****
DATA -2,0, -1,0, 0,0, 1,0, 0,-2, 0,-1, 0,0, 0,1
DATA 4,13
DATA -1,0, 0,0, 1,0, 0,1, 0,-1, 0,0, 0,1, 1,0 : '***
DATA -1,0, 0,0, 1,0, 0,-1, 0,-1, 0,0, 0,1, -1,0 : ' *
DATA 2,14
DATA -1,0, 0,0, 1,0, -1,1, 0,-1, 0,0, 0,1, 1,1 : '***
DATA -1,0, 0,0, 1,0, 1,-1, 0,-1, 0,0, 0,1, -1,-1: '*
DATA 4,14
DATA -1,0, 0,0, 1,0, 1,1, 0,-1, 0,0, 0,1, 1,-1 : '***
DATA -1,0, 0,0, 1,0, -1,-1, 0,-1, 0,0, 0,1, -1,1 : ' *
DATA 15,7
DATA -1,1, 0,1, -1,0, 0,0, -1,1, 0,1, -1,0, 0,0 : ' **
DATA -1,1, 0,1, -1,0, 0,0, -1,1, 0,1, -1,0, 0,0 : ' **
DATA 4,12
DATA -1,0, 0,0, 0,1, 1,1, 1,-1, 1,0, 0,0, 0,1 : ' **
DATA -1,0, 0,0, 0,1, 1,1, 1,-1, 1,0, 0,0, 0,1 : ' **
DATA 1,9
DATA 1,0, 0,0, 0,1, -1,1, 1,1, 1,0, 0,0, 0,-1 : ' **
DATA 1,0, 0,0, 0,1, -1,1, 1,1, 1,0, 0,0, 0,-1 : ' **
CLS
FOR piece = 1 TO 7
READ color1(piece), color2(piece)
FOR rot = 1 TO 4
FOR square = 1 TO 4
READ x(piece, rot, square), y(piece, rot, square)
NEXT
x1 = piece * 80: y1 = rot * 100 - 30
FOR square = 1 TO 4
x = x(piece, rot, square): y = y(piece, rot, square)
x = x * 20 + x1: y = y * 20 + y1
LINE (x, y)-(x + 19, y + 19), color2(piece), B
LINE (x + 1, y + 1)-(x + 18, y + 18), color2(piece), B
PAINT (x + 10, y + 10), color1(piece), color2(piece)
NEXT
GET (x1 - 40, y1 - 40)-(x1 + 39, y1 + 39), sh&(0, piece, rot)
NEXT
NEXT
t# = TIMER: DO: LOOP UNTIL TIMER >= t# + 2 OR TIMER < t#
' DO: a$ = INKEY$: LOOP UNTIL a$ > "": IF a$ = CHR$(27) THEN END
CLS
top = 40: left = 219
LINE (left, top)-(left + 20 * gWidth + 1, top + 401), 15, B
ERASE grid: REDIM grid(20, gWidth)
delay! = .5
piece = INT(RND(1) * 7 + 1): rot = 1
nxtPiece = piece
DO
piece = nxtPiece
nxtPiece = INT(RND(1) * 7 + 1): rot = 1
IF perpetPiece > 0 THEN nxtPiece = perpetPiece: piece = perpetPiece
PUT (5, 20), sh&(0, nxtPiece, 1), PSET
row = 1: col = 2
DO
flag = 0
FOR sq = 1 TO 4
IF y(piece, rot, sq) + row < 0 THEN
flag = 1
ELSEIF grid(y(piece, rot, sq) + row, x(piece, rot, sq) + col) > 0 THEN
EndIt = 1
END IF
NEXT
IF EndIt = 1 THEN GOTO GameOver
IF flag > 0 THEN row = row + 1
LOOP UNTIL flag = 0
initRow = row
old.x = 0: old.y = 0
DO
y = top + row * 20 - 59: x = left + col * 20 - 59
IF old.x > 0 THEN PUT (old.x, old.y), sh&(0, piece, old.rot), XOR
PUT (x, y), sh&(0, piece, rot), XOR
old.x = x: old.y = y: old.rot = rot
t# = TIMER
DO
a$ = INKEY$: IF a$ > "" THEN GOSUB Keyboard
LOOP UNTIL TIMER > t# + delay! OR accel = 1
hit = 0
FOR i = 1 TO 4
trow = y(piece, rot, i) + row + 1
IF trow > 20 THEN hit = 1: EXIT FOR
IF grid(trow, x(piece, rot, i) + col) > 0 THEN hit = 1
NEXT
IF hit = 1 THEN GOSUB HandleHit: EXIT DO: ELSE row = row + 1
LOOP
LOOP
END
GameOver:
LOCATE 30, 36: PRINT "Game Over.";
DO: a$ = INKEY$: LOOP UNTIL a$ > "": IF a$ = CHR$(27) THEN END
RUN
HandleHit:
rMax = 0
FOR i = 1 TO 4
r = row + y(piece, rot, i): c = col + x(piece, rot, i)
grid(r, c) = 1
IF r > rMax THEN rMax = r
NEXT
r = rMax
DO
all = 1
FOR i = 1 TO gWidth
IF grid(r, i) = 0 THEN all = 0: EXIT FOR
NEXT
IF all = 1 THEN GOSUB DelRow ELSE r = r - 1
IF r < 2 OR r < rMax - 4 THEN EXIT DO
LOOP
accel = 0
RETURN
DelRow:
FOR i = 1 TO gWidth
FOR row = r TO 2 STEP -1
grid(row, i) = grid(row - 1, i)
NEXT
grid(1, i) = 0
NEXT
GET (left + 1, top + 1)-(left + 20 * gWidth, top + (r - 1) * 20), area&
PUT (left + 1, top + 21), area&, PSET
LINE (left + 1, top + 1)-(left + 20 * gWidth, top + 20), 0, BF
RETURN
Keyboard:
DO
SELECT CASE a$
CASE CHR$(27)
END
CASE "5"
rot = rot + 1: IF rot > 4 THEN rot = 1
hit = 0
FOR i = 1 TO 4
trow = y(piece, rot, i) + row + 1
tcol = x(piece, rot, i) + col
IF trow > 20 THEN hit = 1: EXIT FOR
IF tcol > gWidth OR tcol < 1 THEN hit = 1: EXIT FOR
IF grid(trow, tcol) > 0 THEN hit = 1
NEXT
IF hit = 1 THEN rot = rot - 1: IF rot < 1 THEN rot = 4
CASE "6"
good = 1
FOR i = 1 TO 4
xp = x(piece, rot, i) + col: yp = y(piece, rot, i) + row
IF xp >= gWidth THEN good = 0: EXIT FOR
IF yp > 0 THEN IF grid(yp, xp + 1) > 0 THEN good = 0: EXIT FOR
NEXT
IF good = 1 THEN col = col + 1
CASE "4"
good = 1
FOR i = 1 TO 4
xp = x(piece, rot, i) + col: yp = y(piece, rot, i) + row
IF xp <= 1 THEN good = 0: EXIT FOR
IF yp > 0 THEN IF grid(yp, xp - 1) > 0 THEN good = 0: EXIT FOR
NEXT
IF good = 1 THEN col = col - 1
CASE "2"
accel = 1
CASE "+"
delay! = delay! / 2
CASE "-"
delay! = delay! * 2
END SELECT
y = top + row * 20 - 60: x = left + col * 20 - 59
IF old.x > 0 THEN PUT (old.x, old.y), sh&(0, piece, old.rot), XOR
PUT (x, y), sh&(0, piece, rot), XOR
old.x = x: old.y = y: old.rot = rot
a$ = INKEY$: IF a$ = CHR$(27) THEN END
LOOP WHILE a$ > ""
RETURN
|
|
Posted by Charlie
on 2007-12-19 14:23:17 |
a way to play around with this
