Posts: 2,765
Threads: 138
Joined: Nov 2002
arrow keys and maybe a reverse would be cool
![[Image: sig.php]](http://josh.whtiger.net/images/sig.php)
Back by popular demand!
I will byte and nibble you bit by bit until nothing remains but crumbs.
Posts: 3,343
Threads: 83
Joined: Mar 2003
Definately na_th, this stuff is good! I'll throw it all in with the next update. (All submissions get recognition guys, if that's any incentive).
I'd enter too (I've started loads of games in 1 hour) but I don't have time...
Posts: 691
Threads: 5
Joined: Apr 2002
Another one, this took slightly longer than an hour but I thought I would post it anyway. Its a text based Tetris game, use the arrow keys to move the block and spacebar to rotate it. Points are scored by creating filled horizontal lines, and the game gets faster as you score more points. Its still got a few bugs and the checkForLines sub is anything but optimal (note the recursion), but I didnt want to spend much more than an hour on it.
Code: '**** TextTris ****
'**** LooseCaboose ****
DECLARE SUB updateScore ()
DECLARE SUB checkForLines ()
DECLARE SUB rotateBlock ()
DECLARE SUB gameOver ()
DECLARE SUB dropBlock ()
DECLARE SUB undrawBlock ()
DECLARE SUB moveBlock (direction AS INTEGER)
DECLARE SUB gameLoop ()
DECLARE SUB drawPlayField ()
DECLARE SUB createBlock ()
DECLARE SUB drawBlock ()
CONST DOWN = 1
CONST LEFT = 2
CONST RIGHT = 3
CONST NUMBLOCKS = 7
DIM SHARED playField(11, 21)
DIM SHARED block(4, 4)
DIM SHARED bx AS INTEGER, by AS INTEGER
DIM SHARED gameTicks AS SINGLE, gameSpeed AS SINGLE
DIM SHARED nextBlock AS INTEGER
DIM SHARED score AS INTEGER
CLS
RANDOMIZE TIMER
nextBlock = INT(NUMBLOCKS * RND + 1)
drawPlayField
gameLoop
SUB checkForLines
lineFilled = 1
'**** Check for filled Lines ****
FOR i = by + 3 TO by STEP -1
'**** Assume the line is full ****
lineFilled = 1
FOR j = 1 TO 10
IF playField(j, i) = 0 THEN
lineFilled = 0
END IF
NEXT
IF lineFilled = 1 THEN
'**** Do flashy thing ****
COLOR 12
LOCATE i + 1, 15: PRINT STRING$(10, CHR$(176));
SOUND 100, .2
LOCATE i + 1, 15: PRINT STRING$(10, CHR$(177));
SOUND 200, .2
LOCATE i + 1, 15: PRINT STRING$(10, CHR$(178));
SOUND 100, .2
score = score + 1
updateScore
'**** Redraw the playField ****
FOR k = i TO 2 STEP -1
FOR l = 1 TO 10
playField(l, k) = playField(l, k - 1)
COLOR playField(l, k)
LOCATE k + 1, l + 14
PRINT "Ã";
NEXT
LOCATE k - 1, 15: PRINT STRING$(10, " ");
NEXT
'**** Recursion ****
checkForLines
END IF
NEXT
END SUB
SUB createBlock
'**** Clear old block ****
FOR i = 1 TO 4
FOR j = 1 TO 4
block(i, j) = 0
NEXT
NEXT
SELECT CASE nextBlock
'**** Box ****
CASE 1:
block(2, 2) = 1
block(2, 3) = 1
block(3, 2) = 1
block(3, 3) = 1
CASE 2:
'**** Pipe ****
block(1, 4) = 4
block(2, 4) = 4
block(3, 4) = 4
block(4, 4) = 4
CASE 3:
'**** Zig-zag 1 ****
block(1, 3) = 5
block(2, 2) = 5
block(2, 3) = 5
block(3, 2) = 5
CASE 4:
'**** Zig-zag 2 ****
block(2, 2) = 11
block(3, 2) = 11
block(3, 3) = 11
block(4, 3) = 11
CASE 5:
'**** L-Shape 1 ****
block(2, 2) = 14
block(2, 3) = 14
block(2, 4) = 14
block(3, 4) = 14
CASE 6:
'**** L-Shape 2 ****
block(3, 2) = 9
block(3, 3) = 9
block(3, 4) = 9
block(2, 4) = 9
CASE 7:
'**** T-Shape ****
block(1, 2) = 10
block(2, 2) = 10
block(3, 2) = 10
block(2, 3) = 10
END SELECT
'**** Set the next block ****
nextBlock = INT(NUMBLOCKS * RND + 1)
'**** Start it a the top of the screen ****
bx = 4: by = 1
drawBlock
END SUB
SUB drawBlock
FOR i = 1 TO 4
FOR j = 1 TO 4
LOCATE by + j, bx + i + 13
IF block(i, j) <> 0 THEN
COLOR block(i, j)
PRINT CHR$(219);
END IF
NEXT
NEXT
END SUB
SUB drawPlayField
SCREEN 7
COLOR 7
FOR i = 2 TO 21
LOCATE i, 14
PRINT CHR$(177) + STRING$(10, " ") + CHR$(177)
NEXT
LOCATE 22, 14
PRINT STRING$(12, CHR$(177))
updateScore
END SUB
SUB dropBlock
'**** Drop a block onto the playField ****
FOR i = 1 TO 4
FOR j = 1 TO 4
IF block(i, j) <> 0 THEN
playField(i + bx - 1, j + by - 1) = block(i, j)
END IF
NEXT
NEXT
checkForLines
'**** Create the next block ****
createBlock
END SUB
SUB gameLoop
createBlock
drawBlock
gameSpeed = .2
gameTicks = TIMER
DO
i$ = INKEY$
SELECT CASE i$
CASE CHR$(0) + "K"
moveBlock LEFT
CASE CHR$(0) + "M"
moveBlock RIGHT
CASE CHR$(0) + "P"
moveBlock DOWN
CASE " "
rotateBlock
CASE CHR$(27)
END
END SELECT
'**** Get game time ****
IF TIMER > gameTicks + gameSpeed THEN
moveBlock DOWN
gameTicks = TIMER
END IF
LOOP
END SUB
SUB gameOver
COLOR 12
LOCATE 11, 15: PRINT "GAME OVER!"
END
END SUB
SUB moveBlock (direction AS INTEGER)
SELECT CASE direction
CASE DOWN
FOR i = 1 TO 4
FOR j = 4 TO 1 STEP -1
IF block(i, j) <> 0 THEN
IF playField(i + bx - 1, j + by) <> 0 OR by + j > 20 THEN
'**** Hit something ****
IF by = 1 THEN
'**** Didnt fall, game over ****
gameOver
ELSE
dropBlock
END IF
EXIT SUB
END IF
END IF
NEXT
NEXT
'**** Didnt hit anything ****
undrawBlock
by = by + 1
drawBlock
CASE LEFT
FOR i = 1 TO 4
FOR j = 1 TO 4
IF block(j, i) <> 0 THEN
IF playField(j + bx - 2, i + by - 1) <> 0 OR (bx + j) - 2 <= 0 THEN
'**** Hit something ****
EXIT SUB
END IF
END IF
NEXT
NEXT
'**** Didnt hit anything ****
undrawBlock
bx = bx - 1
drawBlock
CASE RIGHT
FOR i = 1 TO 4
FOR j = 4 TO 1 STEP -1
IF block(j, i) <> 0 THEN
IF playField(j + bx, i + by - 1) <> 0 OR (bx + j) > 10 THEN
'**** Hit something ****
EXIT SUB
END IF
END IF
NEXT
NEXT
'**** Didnt hit anything ****
undrawBlock
bx = bx + 1
drawBlock
END SELECT
END SUB
SUB rotateBlock
DIM rotate(4, 4)
FOR i = 1 TO 4
FOR j = 1 TO 4
rotate(i, j) = block(5 - j, i)
NEXT
NEXT
'**** Check if it intersects with the playfield ****
FOR i = 1 TO 4
FOR j = 1 TO 4
IF rotate(i, j) <> 0 THEN
IF playField(j + bx - 1, i + by - 1) <> 0 THEN
'**** Hit something ****
EXIT SUB
END IF
END IF
NEXT
NEXT
'**** Swap block for the rotated version ****
undrawBlock
FOR i = 1 TO 4
FOR j = 1 TO 4
block(i, j) = rotate(i, j)
NEXT
NEXT
drawBlock
END SUB
SUB undrawBlock
FOR i = 1 TO 4
FOR j = 1 TO 4
LOCATE by + j, bx + i + 13
IF block(i, j) <> 0 THEN
PRINT " ";
END IF
NEXT
NEXT
END SUB
SUB updateScore
LOCATE 11, 2
COLOR 15
PRINT "Lines:"; score
IF score <> 0 AND score MOD 5 = 0 THEN
gameSpeed = gameSpeed / 1.5
END IF
END SUB
esus saves.... Passes to Moses, shoots, he scores!
Posts: 1,166
Threads: 62
Joined: Apr 2003
Awesome, I love tetris! One glitch I noticed was I could rotate and break into the wall or another piece or something...
am an asshole. Get used to it.
Posts: 691
Threads: 5
Joined: Apr 2002
Yeah, thats the bug that I found too. Its probably a simple fix, but I couldnt be bothered.
esus saves.... Passes to Moses, shoots, he scores!
Posts: 3,343
Threads: 83
Joined: Mar 2003
That's really good Loose.... off day at Uni?
If you don't mind I may alter it a little bit before putting it on QBNZ... it's impossible to get more than 15 lines, it's so fast...
Posts: 3,288
Threads: 167
Joined: Nov 2001
Quote:na_th_an Wrote:(will it be one of my thousands of failure forum-related attempts?)
I think so. But Relsoft might appear with something stupid like the last time. (do you remember the racing game?)
Wanna bet?
Posts: 691
Threads: 5
Joined: Apr 2002
Quote:That's really good Loose.... off day at Uni?
If you don't mind I may alter it a little bit before putting it on QBNZ... it's impossible to get more than 15 lines, it's so fast...
Im actually in the middle of exams, so it was kind of a procrastination thing (Yay! Study break ;-)).
I don't mind if you alter the source, once exams are finished I might tidy it up a little, fix the bugs, add another player or something. Are there any other Tetris clones in QBasic?
esus saves.... Passes to Moses, shoots, he scores!
Posts: 3,343
Threads: 83
Joined: Mar 2003
http://qbnz.com/pages/downloads/strategy/qbtetris.zip (67.6K zipped)
That's the best one I've come across, but there's many others... But your one gets the crown for 1 hour's work!
In the middle of exams? You finishing at the end of the first trimester? Did you start late/early?
Posts: 749
Threads: 4
Joined: Jun 2002
GW-Basic, for example...
Code: SCREEN 0, 1: WIDTH 40: KEY OFF: COLOR 15, 0: CLS : CLEAR : DEFINT A-Z: E$ = CHR$(219)
PRINT "Score", , , , "Lijn", , " 0", , "Next", , , , , , , , , , "Level", , " 0", , "(c) 1992"
FOR I = 1 TO 23: LOCATE I, 13: PRINT E$; : COLOR 0: PRINT STRING$(12, E$); : COLOR 15
PRINT E$; : NEXT I: PRINT " Stats", "GW-Tetris 3 "; STRING$(14, E$); "Sjoerd Verweij";
READ N: DIM P$(N, 4), R(N, 4, 4, 4), Q(N), H(N, 4), B(N, 4), A(24), M(N), F$(3), D(3), C(4)
FOR I = 1 TO 3: READ F$(I), D(I): NEXT: FOR I = 1 TO 4: READ C(I): NEXT
FOR H = 1 TO N: READ W$: Q(H) = LEN(W$) / 16: FOR I = 1 TO Q(H): READ K$
RANDOMIZE -TIMER * RND: FOR G = 1 TO LEN(K$)
P$(H, I) = P$(H, I) + CHR$(C(VAL(MID$(K$, G, 1)))): NEXT: FOR J = 1 TO 4
IF (INSTR(MID$(W$, (I - 1) * 16 + (J - 1) * 4 + 1, 4), "1") > 0) THEN H(H, I) = H(H, I) + 1
FOR K = 1 TO 4: C$ = MID$(W$, (I - 1) * 16 + (J - 1) * 4 + K, 1)
R(H, I, J, K) = VAL(C$): IF C$ = "1" AND B(H, I) < K THEN B(H, I) = K
NEXT K, J, I, H: T# = 1.5: RANDOMIZE -TIMER: B1 = 5
24 B = B1: X = 2: Y = 6: S = 1: GOSUB 49: B2 = B: B1 = INT(RND * N) + 1: B = B1: GOSUB 48: B = B2: Y = 0: X = 20
SC! = SC! + Q(B) * INT(RND * 15): COLOR 15: LOCATE 2, 1: PRINT SC!; : M(B) = M(B) + 1
IF M(B) / 5 = M(B) \ 5 AND M(B) < 100 THEN COLOR B: LOCATE 23 - M(B) / 5, B + 27: PRINT E$;
27 Y = Y + 1: T1! = TIMER: GOSUB 48: WHILE T1! + T# > TIMER
Z$ = INKEY$: IF LEN(Z$) > 1 THEN Z = ASC(RIGHT$(Z$, 1)) - 70 ELSE Z = ASC(Z$ + CHR$(0)) - 23
IF Z = -10 THEN O = 0: U = S: W = X: V = Y - 1: WHILE O = 0: V = V + 1: GOSUB 45: WEND: Y = V - 1: T1! = T1! - 3
IF Z = 10 THEN T1! = T1! - 3
IF Z = 5 THEN GOSUB 41 ELSE IF Z = 9 THEN GOSUB 42 ELSE IF Z = 7 THEN GOSUB 44
WEND: U = S: V = Y + 1: W = X: GOSUB 45: IF O = 0 THEN 27
ON (Y > 1) + 1 GOTO 39: GOSUB 48: FOR I = 0 TO H(B, S) - 1: FOR J = 0 TO B(B, S) - 1
A(Y + I) = A(Y + I) + R(B, S, I + 1, J + 1) * (2 ^ (X + J - 14)): NEXT J, I: M = 0: FOR H = Y TO 23
IF A(H) = 4095 THEN GOSUB 50: M = M + 1: SC! = SC! + INT(RND * 100)
NEXT: IF M < 2 THEN 24
COLOR 15: LOCATE 15, 1: PRINT F$(M - 1); : SC! = SC! + D(M - 1): NU! = TIMER
WHILE TIMER < NU! + 1.25: WEND: LOCATE 15, 1: PRINT SPC(10); : GOTO 24
39 CLS : COLOR 14, 0: PRINT "Volgens mij ben je dood! Nog eens?": I$ = INPUT$(1)
IF I$ = "j" OR I$ = "J" THEN RUN ELSE WIDTH 80: CLS : KEY ON: END
41 U = S: V = Y: W = X - 1: GOSUB 45: X = X + (O = 0): GOSUB 48: RETURN
42 U = S + 1: IF U > Q(B) THEN U = 1
V = Y: W = X: GOSUB 45: S = -(O = 0) + (S AND (S < Q(B) OR O = 1)): GOSUB 48: RETURN
44 U = S: V = Y: W = X + 1: GOSUB 45: X = X - (O = 0): GOSUB 48: RETURN
45 GOSUB 49: O = -(W > 27 - B(B, S)) - (W < 14): FOR I = 0 TO H(B, U) - 1: FOR J = 0 TO B(B, U) - 1
IF R(B, U, I + 1, J + 1) = 1 AND SCREEN(V + I, W + J, 1) > 0 THEN O = 1
NEXT J, I: RETURN
48 COLOR B: LOCATE Y, X: PRINT P$(B, S); : COLOR 15: RETURN
49 COLOR 0: LOCATE Y, X: PRINT P$(B, S); : COLOR 15: RETURN
50 D = D + 1: FOR I = H TO 2 STEP -1: A(I) = A(I - 1): FOR J = 14 TO 25: LOCATE I, J
COLOR SCREEN(I - 1, J, 1): PRINT E$; : NEXT J, I: SOUND 1000, 1: LOCATE 4, 1: COLOR 15
PRINT D; : IF D / 20 = D \ 20 THEN T# = T# * .7: SOUND 2000, 2: L = L + 1: LOCATE 11, 1: PRINT L
ON (L > 3 AND D / 15 = D \ 15) + 1 GOTO 56: FOR I = 2 TO 23: FOR J = 14 TO 25: LOCATE I, J
COLOR SCREEN(I + 1, J, 1): PRINT E$; : NEXT: A(I) = A(I + 1): NEXT: SOUND 100, 1: COLOR 0
LOCATE 23, 14: IF L < 8 THEN PRINT STRING$(12, E$);
56 RETURN: DATA 7,DOUBLE,150,TRIPLE,300,TETRIS,900,28,219,29,31
DATA 1100110000000000,2243322,11110000000000001000100010001000,2222,2432432432,0100111000000000100011001000000011100100000000000100110001000000,12433222,243224332,2224332,1243322432
DATA 1110100000000000110001000100000000101110000000001000100011000000,22243332,22432432,1124333222,24324322,1110001000000000010001001100000010001110000000001100100010000000,222432,1243243322,243222,224332432
DATA 01101100000000001000110001000000,122433322,24322432,11000110000000000100110010000000,224322,12433224332
As we say here, Tetris clones are as older as black thread. :wink:
img]http://usuarios.vtr.net/~disaster/sigs/annoyizer.php[/img]
|
![[Image: anya2.jpg]](http://rel.betterwebber.com/Mypics/anya2.jpg)