Help with Tetris

tyuo9980 · **Posted:** Sat Mar 26, 2011 10:56 pm

After many fixes and a complete redo from scratch, I've come across a problem.

How would you be able to stack the pieces?

How would you be able to delete a row?

code:

var x, y : int
var x2, y2 : int

var shape : int
var totalpieces : int

var difficultyl : string %game vars
var input : string
var name : string
var delay1 : int
var score : int
var lines : int
var combo : int
var ptimenow, ptimelast : int
var timenow, timelast : int
var timer : int
var counter : int

var back2menu : boolean
var stopped : boolean
var retry : boolean

var grid : array 0 .. 10, 0 .. 26 of boolean %checks if true/false
var boxx : array 0 .. 10 of int
var boxy : array 0 .. 28 of int
var sx : array 1 .. 4 of int
var sy : array 1 .. 4 of int
var sxt : array 1 .. 4 of int
var syt : array 1 .. 4 of int
var pivotx : int
var pivoty : int

var oldsx : array 1 .. 9999 of int
var oldsy : array 1 .. 9999 of int
var colr : int %colour of pieces
var colrold : array 1 .. 9999 of int
var p1, p2, p3, p4, p5, p6, p7 : int := 0 %tally of pieces

var key : string (1) %input vars
var chars : array char of boolean

var prevtext : array 1 .. 20 of string %scoreboard vars
var fnum : int
var highscorenames : array 1 .. 21 of string
var highscore : array 1 .. 21 of int

x := 1 %800x600 resolution
y := 1
x2 := 800
y2 := 600
prevtext (1) := "" %filler
fnum := 1
score := 0

View.Set ("graphics:800;600, nocursor, offscreenonly, nobuttonbar")

process add1
Music.PlayFile ("add1.wav")
end add1

process musiclose
Music.PlayFile ("lose.wav")
end musiclose

process musicintro
Music.PlayFile ("intro.wav")
end musicintro

process mainmusic
Music.PlayFileLoop ("tetris.mp3")
end mainmusic

procedure setmap
Draw.Box (x, y, x2, y2, black)
Draw.FillBox (x, y, x2, y2, black)
colourback (black)
colour (white)
end setmap

procedure intro
fork musicintro

for a : 16 .. 31
locatexy (230, 300)
color (a)
put "This pro tetris game is by..."
View.Update
delay (50)
end for

for decreasing b : 31 .. 16
locatexy (230, 300)
color (b)
put "This pro tetris game is by..."
View.Update
delay (50)
end for

for c : 16 .. 31
locatexy (435, 300)
color (c)
put "Peter Li"
View.Update
delay (100)
end for

delay (1250)
end intro

procedure difficulty %Higher delay = slower
loop %Lower delay = faster
cls
put "Enter difficulty level"
put "[1] Easy"
put "[2] Normal"
put "[3] Hard"
put "[4] 1337"
put "[5] Custom"
put ""
put "[0] Back"
View.Update
getch (key)
if key = "1" then
delay1 := 1200
difficultyl := "Easy"
exit
elsif key = "2" then
delay1 := 1000
difficultyl := "Normal"
exit
elsif key = "3" then
delay1 := 800
difficultyl := "Hard"
exit
elsif key = "4" then
delay1 := 600
difficultyl := "1337"
exit
elsif key = "5" then
View.Set ("graphics:800;600, nobuttonbar, nocursor, nooffscreenonly")
put "Enter delay - 15 = 1337, 25 = Hard, 40 = Normal, 70 = Easy"
get input
if strintok (input) then
delay1 := strint (input)
difficultyl := input
else
put "Invalid input"
end if
View.Set ("graphics:800;600, nobuttonbar, nocursor, offscreenonly")
exit
elsif key = "0" then
back2menu := true
exit
end if
end loop
end difficulty

procedure reset %variable reset
cls
setmap

retry := false
back2menu := false
stopped := true
score := 0
timer := 0
lines := 0
combo := 0
counter := 0
totalpieces := 0

for x : 1 .. 4
sx (x) := 0
sy (x) := 0
end for

for x : 1 .. 10
for y : 1 .. 26
grid (x, y) := false
end for
end for
end reset

procedure instructions
cls
locatexy (330, 300)
put "Use Arrow Keys to move"
View.Update
delay (1500)
end instructions

procedure savefile
Music.PlayFileStop

fork musiclose

var swap : boolean := false
var tempname : string
var temp : int

View.Set ("graphics:800;600, nobuttonbar, nocursor, nooffscreenonly")
locatexy (375, 500)
put "Enter name"
locatexy (375, 475)
get name : *

highscorenames (11) := name
highscore (11) := score

for x : 1 .. 10 %bubblesort
swap := false
for y : 1 .. 11 - x
if highscore (y) < highscore (y + 1) then
temp := highscore (y)
tempname := highscorenames (y)
highscore (y) := highscore (y + 1)
highscorenames (y) := highscorenames (y + 1)
highscore (y + 1) := temp
highscorenames (y + 1) := tempname
swap := true
end if
end for
exit when swap = false
end for

open : fnum, "scoresurvival.txt", put
for x : 1 .. 10
put : fnum, highscorenames (x), " ", highscore (x)
end for
close : fnum

View.Set ("graphics:800;600, nobuttonbar, nocursor, offscreenonly")
end savefile

procedure setgrid
for x : 0 .. 10 %applies grid system
boxx (x) := 280 + (20 * x)
end for

for y : 0 .. 28
boxy (y) := 10 + (20 * y)
end for

for bug : 0 .. 1
boxx (bug) := 300
boxy (bug) := 30
end for
end setgrid

procedure clgrid
for x : 1 .. 10
for y : 1 .. 26
grid (x, y) := false
end for
end for
end clgrid

procedure drawgrid %draws grid lines
for vertical : 0 .. 10
Draw.Line (300 + (20 * vertical), 30, 300 + (20 * vertical), 550, white)
end for

for horizontal : 0 .. 26
Draw.Line (300, 30 + (20 * horizontal), 500, 30 + (20 * horizontal), white)
end for
end drawgrid

procedure savecoords %stores coords after block stops
for x : ((totalpieces - 1) * 4) + 1 .. totalpieces * 4
oldsx (x) := sx (x - ((totalpieces - 1) * 4))
oldsy (x) := sy (x - ((totalpieces - 1) * 4))
colrold (x) := colr
end for
end savecoords

/*
procedure stack
for x : 1 .. 4
for y : 1 .. 4
if grid (sx (x), sy (y) - 1) = true then
stopped := true
savecoords
exit
end if
end for
end for
end stack
*/

procedure collide
for y : 1 .. 4 %hits bottom
if sy (y) = 1 then
stopped := true
savecoords
exit
end if
end for

for y : 1 .. 4 %hits top
if sy (y) > 29 then
savefile
end if
end for
end collide

procedure fullrow
for y : 1 .. 26
if grid (1, y) = true and grid (2, y) = true and grid (3, y) = true and grid (4, y) = true and grid (5, y) = true and grid (6, y) = true and grid (7, y) = true and grid (8, y) = true and
grid (9, y) = true and grid (10, y) = true then
put "true"
end if
end for
end fullrow

procedure spawnpiece
randint (shape, 1, 7)
stopped := false
case shape of %sets spawn coordinates
label 1 : %square
p1 += 1
sx (1) := 4
sx (2) := 4
sx (3) := 5
sx (4) := 5
sy (1) := 26
sy (2) := 25
sy (3) := 26
sy (4) := 25
label 2 : %bar
p2 += 1
sx (1) := 4
sx (2) := 5
sx (3) := 6
sx (4) := 7
sy (1) := 26
sy (2) := 26
sy (3) := 26
sy (4) := 26
label 3 : %T
p3 += 1
sx (1) := 4
sx (2) := 5
sx (3) := 5
sx (4) := 6
sy (1) := 25
sy (2) := 26
sy (3) := 25
sy (4) := 25
label 4 : %Z
p4 += 1
sx (1) := 4
sx (2) := 5
sx (3) := 5
sx (4) := 6
sy (1) := 26
sy (2) := 26
sy (3) := 25
sy (4) := 25
label 5 : %reverse Z
p5 += 1
sx (1) := 4
sx (2) := 5
sx (3) := 5
sx (4) := 6
sy (1) := 25
sy (2) := 26
sy (3) := 25
sy (4) := 26
label 6 : %L
p6 += 1
sx (1) := 4
sx (2) := 5
sx (3) := 6
sx (4) := 6
sy (1) := 25
sy (2) := 25
sy (3) := 26
sy (4) := 25
label 7 : %reverse L
p7 += 1
sx (1) := 4
sx (2) := 4
sx (3) := 5
sx (4) := 6
sy (1) := 26
sy (2) := 25
sy (3) := 25
sy (4) := 25
end case
end spawnpiece

procedure drawpiece
if stopped = true then
totalpieces += 1
spawnpiece
end if

collide

ptimenow := Time.Elapsed

if ptimenow - ptimelast >= delay1 then
for y : 1 .. 4
sy (y) -= 1
end for
ptimelast := ptimenow
end if

case shape of
label 1 : %box:
colr := 14 %yellow
label 2 : %bar:
colr := 11 %cyan
pivotx := sx (2)
pivoty := sy (2)
label 3 : %T:
colr := 34 %violet
pivotx := sx (2)
pivoty := sy (2)
label 4 : %Z:
colr := 12 %red
pivotx := sx (2)
pivoty := sy (2)
label 5 : %rZ:
colr := 10 %green
pivotx := sx (2)
pivoty := sy (2)
label 6 : %L:
colr := 42 %orange
pivotx := sx (2)
pivoty := sy (2)
label 7 : %rL:
colr := 55 %blue
pivotx := sx (2)
pivoty := sy (2)
end case

for draw : 1 .. 4
Draw.FillBox (boxx (sx (draw)) + 1, boxy (sy (draw)) + 1, boxx (sx (draw)) + 19, boxy (sy (draw)) + 19, colr)
grid (sx (draw), sy (draw)) := true
end for

end drawpiece

procedure drawoldpiece
if totalpieces > 1 then
for draw : 1 .. (totalpieces - 1) * 4
Draw.FillBox (boxx (oldsx (draw)) + 1, boxy (oldsy (draw)) + 1, boxx (oldsx (draw)) + 19, boxy (oldsy (draw)) + 19, colrold (draw))
grid (oldsx (draw), oldsy (draw)) := true
end for
end if
end drawoldpiece

procedure rotate
if shape > 1 then %rotates all shapes except for square
for turn : 1 .. 4
sxt (turn) := pivotx + (pivoty - sy (turn)) %turns 90 degrees CC
syt (turn) := pivoty - (pivotx - sx (turn)) %stores to temp array
end for

for save : 1 .. 4
sx (save) := sxt (save)
sy (save) := syt (save)
end for
end if

for checkright : 1 .. 4 %keeps right side in bounds
if sx (checkright) > 10 then
for moveleft : 1 .. 4
sx (moveleft) -= 1
end for
end if
end for

for checkleft : 1 .. 4 %keeps left side in bounds
if sx (checkleft) < 1 then
for moveright : 1 .. 4
sx (moveright) += 1
end for
end if
end for
end rotate

procedure drawstats %for debug purposes
locatexy (0, 500)
put "Square: ", p1
put "Bar: ", p2
put "T: ", p3
put "Z: ", p4
put "rZ: ", p5
put "L: ", p6
put "rL: ", p7
put "Total: ", totalpieces

locatexy (20, 585) %scoreboard
put "Press 0 to return to menu"
locatexy (375, 585)
put "Time: ", timer
locatexy (650, 585)
put "Score: ", round (score)
end drawstats

procedure leaderboard
loop
cls
put "[0] Return"
put ""
View.Update

open : fnum, "scoresurvival.txt", get
for x : 1 .. 10
exit when eof (fnum)
get : fnum, name, score
highscore (x) := score
highscorenames (x) := name
end for
close : fnum

for x : 1 .. 10
put highscorenames (x) : 25, " ", highscore (x)
end for

View.Update

getch (key)
if key = "0" then
exit
end if

end loop
end leaderboard

procedure getinput
Input.KeyDown (chars)
if chars (KEY_UP_ARROW) then
rotate
elsif chars (KEY_LEFT_ARROW) then
for x : 1 .. 4 %moves left
if sx (x) = 1 then
sx (1) += 1
sx (2) += 1
sx (3) += 1
sx (4) += 1
end if
end for

for x : 1 .. 4
sx (x) -= 1
end for
elsif chars (KEY_RIGHT_ARROW) then
for x : 1 .. 4 %moves right
if sx (x) = 10 then
sx (1) -= 1
sx (2) -= 1
sx (3) -= 1
sx (4) -= 1
end if
end for

for x : 1 .. 4
sx (x) += 1
end for
elsif chars (KEY_DOWN_ARROW) then %speeds up
for y : 1 .. 4
sy (y) -= 1
ptimelast := ptimenow %resets time
end for
elsif chars (' ') then %auto drop
loop
for y : 1 .. 4
sy (y) -= 1
end for
%exit when
end loop
elsif chars ('p') or chars ('P') then %pause
cls
put "Enter any key to resume"
getch (key)
elsif chars ('0') then %exit
loop
cls
put "Are you sure you want to quit? (Y/N)"
Input.KeyDown (chars)
if chars ('y') or chars ('Y') then
back2menu := true
exit
elsif chars ('n') or chars ('N') then
exit
end if

View.Update
end loop
end if
end getinput

procedure calctime
timenow := Time.Elapsed
if timenow - timelast >= 1000 then
timer += 1
timelast := timenow
end if
end calctime

procedure endless
fork mainmusic

loop

if back2menu = true then
exit
end if

reset
difficulty

if back2menu = true then
exit
end if

instructions
timelast := Time.Elapsed
ptimelast := Time.Elapsed

loop
cls
clgrid
drawstats
drawgrid
drawpiece
drawoldpiece
%stack
getinput
calctime
fullrow

if back2menu = true then
exit
end if

View.Update

delay (100)

end loop
end loop
end endless

procedure campaign

end campaign

setmap
%intro
setgrid

loop
Music.PlayFileStop
reset
cls
put "[1] Survival"
put "[2] Campaign"
put "[3] Survival Scoreboard"
put ""
put "[0] Exit"

View.Update

getch (key)
if key = "1" then
endless
elsif key = "2" then
campaign
elsif key = "3" then
cls
setmap
leaderboard
elsif key = "0" then
loop
cls
put "Are you sure you want to quit? (Y/N)"
Input.KeyDown (chars)
if chars ('y') or chars ('Y') then
quit
elsif chars ('n') or chars ('N') then
exit
end if

View.Update

end loop
end if
end loop

Raknarg · **Posted:** Sun Mar 27, 2011 2:32 pm

I'm throwing out radom ideas again...
Well, maybe what you could do is have a status for each piece in the grid. The what you do is whenever a piece is placed, if all the squares in the same row have a "filled" status, delete the row and move everything else above down one. To stack them, you could just see if the status under piece is filled. If it is, place the block there.

tyuo9980 · **Posted:** Sun Mar 27, 2011 3:17 pm

What i was thinking was to assign every block a t/f status. and if its true then you would Draw.FillBox. and then after a row is filled change the status of that row to false and move everything above it down one.

only if i did that in the beginning... this will be my 3rd revision, and hopefully the last.

Raknarg · **Posted:** Sun Mar 27, 2011 3:19 pm

so... wait, do you have an array for the boxes that goes up to 9999?

tyuo9980 · **Posted:** Sun Mar 27, 2011 5:28 pm

Raknarg @ Sun Mar 27, 2011 3:19 pm wrote:

so... wait, do you have an array for the boxes that goes up to 9999?

i put it to 9999 in case some person is pro and just doesnt die and generates 1250 shapes. i might use a flexible array later since all you really need is 2 arrays that go up to 260.

anyways im ALMOST done my tetris. can you suggest a way to detect if its gameover?

Tony · **Posted:** Sun Mar 27, 2011 5:48 pm

tyuo9980 @ Sun Mar 27, 2011 5:28 pm wrote:

i put it to 9999 in case some person is pro and just doesnt die and generates 1250 shapes.

Do you need to remember all the shapes ever generated?

tyuo9980 @ Sun Mar 27, 2011 5:28 pm wrote:

can you suggest a way to detect if its gameover?

That should be straight forward from the definition of that condition. When _should_ the game end? (Typically, when a block stops above certain height.)

tyuo9980 · **Posted:** Sun Mar 27, 2011 6:27 pm

Tony @ Sun Mar 27, 2011 5:48 pm wrote:

tyuo9980 @ Sun Mar 27, 2011 5:28 pm wrote:

i put it to 9999 in case some person is pro and just doesnt die and generates 1250 shapes.

Do you need to remember all the shapes ever generated?

tyuo9980 @ Sun Mar 27, 2011 5:28 pm wrote:

can you suggest a way to detect if its gameover?

That should be straight forward from the definition of that condition. When _should_ the game end? (Typically, when a block stops above certain height.)

yea i made the detection and everything. i just cant find a way to delete the variables after a row is filled up

Raknarg · **Posted:** Sun Mar 27, 2011 6:29 pm

you should look into flexible arrays for the 9999 arrays, they're a waste of time, and im pretty sure having arrays like that is bad programming practice. You should only have as many elements as you need.

Tony · **Posted:** Sun Mar 27, 2011 7:24 pm

tyuo9980 @ Sun Mar 27, 2011 6:27 pm wrote:

i just cant find a way to delete the variables after a row is filled up

Once a piece lands on a board, you no longer need to know about that piece. The board should tell you what's on it.

	Computer Science Canada Programming C, C++, Java, PHP, Ruby, Turing, VB Username: Password: Register
Wiki Blog Search Turing Chat Room Members