Joguinho Tetris
Publicado por Kelyane (última atualização em 30/09/2009)
[ Hits: 21.655 ]
Homepage: http://blog.kelyane.com
Joguinho de Tetris colorido.
Código-fonte tirado dos exemplos do programa PascalZim -http://www.ziggi.com.br/downloads/pascal-zim
Program tetris;
Const
HEIGHT = 20; // Altura do grid (área interna, sem contar as bordas)
HeightPlusOne = 21; // Altura do grid + 1
WIDTH = 11; // Largura do grid (área interna, sem contar as bordas)
WidthPlusOne = 12; // Largura do grid + 1
LEFT = -1; // Identificação dos movimentos horizontais
RIGHT = 1; // (utilizado na chamada ao procedure move)
Type
T_coordinate = record // Coordenada cartesiana (x,y)
x : integer;
y : integer;
end;
T_objgrid = array[1..4, 1..4] of boolean; // Forma de peças. Constituida por uma array bidimensional
// de 4x4 do tipo boolean. Por exemplo, a forma da peça "L"
// é representada da seguinte maneira: 0 0 1 0
// 1 1 1 0
// (0 = FALSE, 1 = TRUE) 0 0 0 0
// 0 0 0 0
T_grid = record // Informações sobre um ponto do grid, se ele está
status : boolean; // preenchido ou não (status) e de que cor ele está
color : integer; // preenchido, se for o caso.
end;
T_object = record // Peças.
pos : T_coordinate; // posição
cell : T_objgrid; // formato
size : integer; // tamanho (ver comentário abaixo)
color : integer; // cor
end;
{ Quanto ao tamanho das peças, existem peças de 4x4 (size=4) e de 3x3 (size=3). No
caso das de 4x4, o eixo de rotação é bem no meio da array. Exemplo (retângulo):
| | | | |
0 1 0 0 -> 0 0 0 0 -> 0 0 1 0 -> 0 0 0 0 -> 0 1 0 0
_ 0 1 0 0 _ -> _ 1 1 1 1 _ -> _ 0 0 1 0 _ -> _ 0 0 0 0 _ -> _ 0 1 0 0 _
0 1 0 0 -> 0 0 0 0 -> 0 0 1 0 -> 1 1 1 1 -> 0 1 0 0
0 1 0 0 -> 0 0 0 0 -> 0 0 1 0 -> 0 0 0 0 -> 0 1 0 0
| | | | |
Já nas peças de 3x3, o eixo de rotação é na célula (2,2). Exemplo ("L"):
| | | | |
0 0 0 0 -> 1 0 0 0 1 1 1 0 0 1 1 0 0 0 0 0
- 0 0 1 0 - -> - 1 0 0 0 - -> - 1 0 0 0 - -> - 0 0 1 0 - -> - 0 0 1 0 -
1 1 1 0 -> 1 1 0 0 -> 0 0 0 0 -> 0 0 1 0 -> 1 1 1 0
0 0 0 0 -> 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0 0
| | | | |
Repare que a estrutura utilizada para representar as formas de 4x4 e de 3x3 é a
mesma, uma array bidimensional de 4x4. Contudo, nas peças de 3x3, existem 7
células (as da última coluna e as da úllima linha) que são inutilizadas. }
Var
grid : array[0..WidthPlusOne, 0..HeightPlusOne] of T_grid; // Grid (incluindo bordas)
obj : T_object; // Peça caindo no grid
next : T_object; // Próxima peça (fixa)
level : integer; // Nível em que se encontra o jogador
score : integer; // Pontuação
cycle : record
freq : integer; // Intervalo entre decaimentos da peça.
status : integer; // Tempo decorrido desde último decaimento.
step : integer; // Tempo entre ciclos de execução. É a cada ciclo o programa
// checa se o usuário pressionou alguma tecla.
end; // (medidas em milisegundos)
orig : T_coordinate; // Origem - posição do canto superior esquerdo do grid na tela.
gameover : boolean; // O jogo acabou?
quit : boolean; // O usuário deseja sair do jogo?
i, j : integer; // Contadores
c : char; // Variavel auxiliar (recebe input)
{ ------------------------------------------------------------------
Procedure Xclrscr: Fornecidos 4 pontos x1, y1, x2, y2, limpa uma
área na tela equivalente ao retângulo de vértices superior
direito = (x1, y1) e inferior esquerdo = (x2, y2).
Equivale a: window( x1, y1, x2, y2 );
clrscr;
------------------------------------------------------------------ }
Procedure Xclrscr( x1, y1, x2, y2 : integer );
Var x, y : integer;
Begin
for y := y1 to y2 do
begin
gotoxy(x1, y);
for x := x1 to x2 do
write(' ');
end;
End;
{ ------------------------------------------------------------------
Function shock: Verifica se a peça está livre para mover-se
horizontalmente xmov unidades e verticalmente ymov unidades.
------------------------------------------------------------------ }
Function shock( xmov, ymov : integer ): boolean;
Var i, j : integer;
return : boolean;
Begin
gotoxy(1,1);
return := FALSE;
for i := 1 to 4 do
for j := 1 to 4 do
if (obj.cell[i,j])
and (obj.pos.x + i + xmov >= 0)
and (obj.pos.x + i + xmov <= WIDTH+1)
and (grid[obj.pos.x+i+xmov, obj.pos.y+j+ymov].status) // esta condição precisa aparecer por último!
then return := TRUE;
shock := return;
End;
{ ------------------------------------------------------------------
Procedure rotate: Roda a peça no sentido horário, se possível.
------------------------------------------------------------------ }
Procedure rotate;
Var i, j : integer;
old : T_objgrid;
Begin
for i := 1 to 4 do
for j := 1 to 4 do
old[i,j] := obj.cell[i,j];
for i := 1 to obj.size do
for j := 1 to obj.size do
obj.cell[i,j] := old[j,obj.size+1-i];
if (shock(0,0)) then
for i := 1 to 4 do
for j := 1 to 4 do
obj.cell[i,j] := old[i,j];
End;
{ ------------------------------------------------------------------
Procedure move: Move a peça para a direita ou para a esquerda,
se possível.
------------------------------------------------------------------ }
Procedure move( xmov : integer );
Begin
if (not shock(xmov, 0))
then obj.pos.x := obj.pos.x + xmov;
End;
{ ------------------------------------------------------------------
Procedure consolidate: Prende a peça ao local onde ela se
encontra. Após isso, a peça perde seu status de peça e passa a
ser apenas parte do grid. Este procedimento é chamado quando a
peça chega ao fundo do grid, ou encontra com outra abaixo dela.
------------------------------------------------------------------ }
Procedure consolidate;
Var i, j : integer;
Begin
for i := 1 to 4 do
for j := 1 to 4 do
if (obj.cell[i,j]) then
begin
grid[obj.pos.x+i, obj.pos.y+j].status := TRUE;
grid[obj.pos.x+i, obj.pos.y+j].color := obj.color;
end;
End;
{ ------------------------------------------------------------------
Procedure checklines: Checa se alguma linha do grid foi
completada. Se sim, apaga o conteudo dela, trazendo todas as
linhas acima para baixo (as linhas que estão acima da que foi
completada 'caem'). Também recalcula o score, o level e o
cycle.freq.
------------------------------------------------------------------ }
Procedure checklines;
Var i, j, down : integer;
LineCleared : boolean;
Begin
down := 0;
for j := HEIGHT downto 1 do
begin
LineCleared := TRUE;
for i := 1 to WIDTH do
if not (grid[i,j].status)
then LineCleared := FALSE;
if (LineCleared)
then
begin
down := down + 1;
score := score + 10;
end
else
for i := 1 to WIDTH do
begin
grid[i,j+down].status := grid[i,j].status;
grid[i,j+down].color := grid[i,j].color;
end;
end;
level := score div 200;
cycle.freq := trunc( 500 * exp(level*ln(0.85)) );
textcolor(YELLOW);
gotoxy( orig.x + (WIDTH+2)*2 + 18, orig.y + 15 );
write(level);
gotoxy( orig.x + (WIDTH+2)*2 + 30, orig.y + 15 );
write(score);
End;
{ ------------------------------------------------------------------
Procedure hideobj: esconde a peça da tela.
------------------------------------------------------------------ }
Procedure hideobj( obj : T_object );
Var i, j : integer;
Begin
for i := 1 to 4 do
for j := 1 to 4 do
if (obj.cell[i,j]) then
begin
gotoxy( orig.x + (obj.pos.x + i) * 2, orig.y + obj.pos.y+j );
write(' ');
end;
gotoxy( orig.x, orig.y );
End;
{ ------------------------------------------------------------------
Procedure drawobj: desenha a peça na tela.
------------------------------------------------------------------ }
Procedure drawobj( obj : T_object );
Var i, j : integer;
Begin
textcolor(obj.color);
for i := 1 to 4 do
for j := 1 to 4 do
if (obj.cell[i,j]) then
begin
gotoxy( orig.x + (obj.pos.x + i) * 2, orig.y + obj.pos.y + j );
write(#219, #219);
end;
gotoxy( orig.x, orig.y );
End;
{ ------------------------------------------------------------------
Procedure refresh: redesenha todo o grid na tela.
------------------------------------------------------------------ }
Procedure refresh;
Var i, j : integer;
Begin
for i := 0 to WIDTH+1 do
for j := 0 to HEIGHT+1 do
begin
gotoxy( orig.x + 2*i, orig.y + j );
if (grid[i,j].status)
then
begin
textcolor(grid[i,j].color);
write(#219, #219);
end
else
write(' ');
end;
gotoxy( orig.x, orig.y );
End;
{ ------------------------------------------------------------------
Procedure createtgt: pega a peça já gerada anteriormente que está
na caixa "next" (variável next) e a transforma na peça atual.
Depois, gera nova peça randomicamente, posicionando-a na caixa
"next".
------------------------------------------------------------------ }
Procedure createtgt;
Var i, j : integer;
Begin
hideobj(next);
obj := next;
obj.pos.x := WIDTH div 2 - 2;
obj.pos.y := 0;
next.pos.x := WIDTH + 4;
next.pos.y := 6;
for i := 1 to 4 do
for j := 1 to 4 do
next.cell[i,j] := FALSE;
case random(7) of
0: begin // Quadrado
next.cell[2,2] := TRUE;
next.cell[2,3] := TRUE;
next.cell[3,2] := TRUE;
next.cell[3,3] := TRUE;
next.size := 4;
next.color := WHITE;
end;
1: begin // Retangulo
next.cell[2,1] := TRUE;
next.cell[2,2] := TRUE;
next.cell[2,3] := TRUE;
next.cell[2,4] := TRUE;
next.size := 4;
next.color := LIGHTRED;
end;
2: begin // "L"
next.cell[3,2] := TRUE;
next.cell[1,3] := TRUE;
next.cell[2,3] := TRUE;
next.cell[3,3] := TRUE;
next.size := 3;
next.color := LIGHTGREEN;
end;
3: begin // "L" invertido
next.cell[1,2] := TRUE;
next.cell[1,3] := TRUE;
next.cell[2,3] := TRUE;
next.cell[3,3] := TRUE;
next.size := 3;
next.color := LIGHTBLUE;
end;
4: begin // "S"
next.cell[2,2] := TRUE;
next.cell[2,3] := TRUE;
next.cell[3,1] := TRUE;
next.cell[3,2] := TRUE;
next.size := 4;
next.color := LIGHTCYAN;
end;
5: begin // "Z"
next.cell[2,2] := TRUE;
next.cell[2,3] := TRUE;
next.cell[3,3] := TRUE;
next.cell[3,4] := TRUE;
next.size := 4;
next.color := LIGHTMAGENTA;
end;
6: begin // "T"
next.cell[1,2] := TRUE;
next.cell[2,1] := TRUE;
next.cell[2,2] := TRUE;
next.cell[2,3] := TRUE;
next.size := 3;
next.color := LIGHTGRAY;
end;
end;
drawobj(next);
End;
{ ------------------------------------------------------------------
Procedure prninfo: imprime as informações presentes ao lado
do grid (contorno da caixa "next" e comandos do jogo).
------------------------------------------------------------------ }
Procedure prninfo( xpos, ypos : integer );
Begin
// window( xpos, ypos, 80, 40 );
Xclrscr( xpos, ypos, 80, 24 );
textcolor(WHITE);
gotoxy( xpos, ypos+0 );
write(#218, #196, #196, ' Next ', #196, #196, #191);
gotoxy( xpos, ypos+1 );
write(#179, ' ', #179);
gotoxy( xpos, ypos+2 );
write(#179, ' ', #179);
gotoxy( xpos, ypos+3 );
write(#179, ' ', #179);
gotoxy( xpos, ypos+4 );
write(#179, ' ', #179);
gotoxy( xpos, ypos+5 );
write(#179, ' ', #179);
gotoxy( xpos, ypos+6 );
write(#179, ' ', #179);
gotoxy( xpos, ypos+7 );
write(#192, #196, #196, #196, #196, #196, #196, #196, #196, #196, #196, #217);
textcolor(YELLOW);
gotoxy( xpos, ypos+10 );
write(' Level: 0 Score: 0');
// window( xpos+17, ypos+1, 80, 40 );
gotoxy( xpos+17, ypos+1 );
write('Controles:');
gotoxy( xpos+17, ypos+2 );
write(' Mover : [setas]');
gotoxy( xpos+17, ypos+3 );
write(' Girar : [space]');
gotoxy( xpos+17, ypos+4 );
write(' Cair : [enter]');
gotoxy( xpos+17, ypos+5 );
write(' Pausa : "P"');
gotoxy( xpos+17, ypos+6 );
write(' Sair : [esc]');
// window(1,1,80,40);
End;
{ ------------------------------------------------------------------
Procedure prnGameover: imprime mensagem de "game over" ao lado
do grid.
------------------------------------------------------------------ }
Procedure prnGameover( xpos, ypos : integer );
Begin
// window( xpos, ypos, 80, 40 );
Xclrscr( xpos, ypos, 80, 24 );
textcolor(WHITE);
gotoxy( xpos, ypos+2 );
writeln(' * * * FIM DE JOGO * * *');
gotoxy( xpos, ypos+6 );
write('Deseja iniciar um ');
textcolor(LIGHTRED);
write('N');
textcolor(WHITE);
write('ovo jogo ou ');
textcolor(LIGHTRED);
write('S');
textcolor(WHITE);
write('air?');
// window( 1, 1, 80, 40 );
End;
{ ------------------------------------------------------------------
PROGRAMA PRINCIPAL
------------------------------------------------------------------ }
Begin
randomize;
orig.x := 2;
orig.y := 2;
clrscr;
gotoxy( orig.x + (WIDTH+2)*2 + 5, orig.y + 1 );
textcolor(WHITE);
write('> > > Tetris < < <');
repeat
prninfo( orig.x + (WIDTH+2)*2 + 4, orig.y + 5 );
for i := 0 to WIDTH+1 do // Preenche todo o grid (inclusive bordas)
for j := 0 to HEIGHT+1 do
begin
grid[i,j].status := TRUE;
grid[i,j].color := DARKGRAY;
end;
for i := 1 to WIDTH do // Esvazia área interna do grid (deixando apenas
for j := 1 to HEIGHT do // as bordas preenchidas)
grid[i,j].status := FALSE;
refresh;
gameover := FALSE;
quit := FALSE;
cycle.freq := 500;
cycle.step := 50;
cycle.status := 0;
score := 0;
createtgt;
createtgt;
refresh;
while not (gameover or quit) do
begin
if (keypressed) then // Se o usuário pressionou uma tecla (keypressed = TRUE),
begin // é preciso agir de acordo com o comando correspondente.
case upcase(readkey) of
#0: case (readkey) of
#75: begin // seta para esquerda
hideobj(obj);
move(left);
drawobj(obj);
end;
#77: begin // seta para direita
hideobj(obj);
move(right);
drawobj(obj);
end;
#80: cycle.status := 0; // seta para baixo
end;
#13: begin // [enter]
while (not shock(0,1)) do
obj.pos.y := obj.pos.y + 1;
cycle.status := 0;
end;
#27: quit := TRUE; // [esc]
#32: begin // espaço
hideobj(obj);
rotate;
drawobj(obj);
end;
'P': begin
textbackground(LIGHTGRAY);
for i := 1 to WIDTH do
for j := 1 to HEIGHT do
begin
gotoxy( orig.x + 2*i, orig.y + j );
write(' ');
end;
textbackground(BLACK);
textcolor(LIGHTGRAY);
gotoxy( orig.x + WIDTH - 2, orig.y + HEIGHT div 2 - 1 );
write(' ');
gotoxy( orig.x + WIDTH - 2, orig.y + HEIGHT div 2 );
write(' PAUSE ');
gotoxy( orig.x + WIDTH - 2, orig.y + HEIGHT div 2 + 1 );
write(' ');
gotoxy( orig.x, orig.y );
repeat
c := upcase(readkey);
until (c = 'P') or (c = #27);
if (c = #27) then quit := TRUE;
refresh;
drawobj(obj);
end;
end;
end;
if (cycle.status < cycle.step) then // Já está na hora de fazer um decaimento?
begin // Se sim...
hideobj(obj); // esconde peça
if (shock(0,1))
then
begin // Se a peça não pode mover-se para baixo:
consolidate; // ancora a peça
checklines; // checa por linhas completadas
refresh; // redesenha todo o grid
createtgt; // cria nova peça
if shock(0, 0) then gameover := TRUE; // caso já não haja espaço no grid para essa nova peça,
end // o jogo está acabado
else // Se a peça pode mover-se para baixo:
obj.pos.y := obj.pos.y + 1; // move a peça para baixo
drawobj(obj); // desenha peça
end;
cycle.status := (cycle.status + cycle.step) mod cycle.freq;
delay(cycle.step);
end;
if (quit) then break;
prnGameover( orig.x + (WIDTH+2)*2 + 4, orig.y + 5 );
repeat
c := upcase(readkey);
until (c = 'N') or (c = 'S');
until (c = 'S');
clrscr;
gotoxy( 25, 12 );
textcolor(WHITE);
write('Pressione [ENTER] para sair . . .');
End.
Scripts recomendados
Tocador de Vídeo no Lazarus(Player de Vídeo)
Script em Pascal/Kylix para controle de Locadoras sem salvar arquivos em disco
Ordenando um vetor sem utilização de variáveis de contagem ou auxiliar
Comentários
[1] Comentário enviado por doradu em 26/02/2010 - 17:31h
o nome do cara é Leonardo Pignataro
excelente jogo
o nome do cara é Leonardo Pignataro
excelente jogo
Patrocínio
Site hospedado pelo provedor RedeHost.
Destaques
Artigos
Cirurgia para acelerar o openSUSE em HD externo via USB
Void Server como Domain Control
Modo Simples de Baixar e Usar o bash-completion
Monitorando o Preço do Bitcoin ou sua Cripto Favorita em Tempo Real com um Widget Flutuante
Dicas
[Resolvido] VirtualBox can't enable the AMD-V extension
Como verificar a saúde dos discos no Linux
Como instalar , particionar, formatar e montar um HD adicional no Linux?
Como automatizar sua instalação do Ubuntu para desenvolvimento de software.
Tópicos
Fiz uma pergunta no fórum mas não consigo localizar (20)
Quais os códigos mais dificeis que vcs sabem fazer? (8)
Pfsense inacessivel após um periodo de tempo (1)
Não consigo instalar distro antiga no virtualbox nem direto no hd (9)
Top 10 do mês
-
Xerxes
1° lugar - 147.323 pts -
Fábio Berbert de Paula
2° lugar - 70.416 pts -
Mauricio Ferrari
3° lugar - 22.254 pts -
Buckminster
4° lugar - 20.362 pts -
Alberto Federman Neto.
5° lugar - 20.223 pts -
edps
6° lugar - 19.645 pts -
Daniel Lara Souza
7° lugar - 19.398 pts -
Andre (pinduvoz)
8° lugar - 18.340 pts -
Alessandro de Oliveira Faria (A.K.A. CABELO)
9° lugar - 16.550 pts -
Diego Mendes Rodrigues
10° lugar - 14.545 pts
Scripts
A maior comunidade GNU/Linux da América Latina! Artigos, dicas, tutoriais, fórum, scripts e muito mais. Ideal para quem busca auto-ajuda.
Site hospedado por:
