Joguinho Tetris
Publicado por Kelyane (última atualização em 30/09/2009)
[ Hits: 21.207 ]
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
Script em Pascal/Kylix para controle de Locadoras sem salvar arquivos em disco
Horas por extenso: convertendo as horas em um TDateTime para texto corrido.
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
Passkeys: A Evolução da Autenticação Digital
Instalação de distro Linux em computadores, netbooks, etc, em rede com o Clonezilla
Título: Descobrindo o IP externo da VPN no Linux
Armazenando a senha de sua carteira Bitcoin de forma segura no Linux
Enviar mensagem ao usuário trabalhando com as opções do php.ini
Dicas
Instalando Brave Browser no Linux Mint 22
vídeo pra quem quer saber como funciona Proteção de Memória:
Encontre seus arquivos facilmente com o Drill
Mouse Logitech MX Ergo Advanced Wireless Trackball no Linux
Compartilhamento de Rede com samba em modo Público/Anônimo de forma simples, rápido e fácil
Tópicos
Programa duplicado no "Abrir com" e na barra de pesquisa do ... (1)
VMs e Interfaces de Rede desapareceram (13)
Como abrir o pycharm no linux [RESOLVIDO] (4)
Top 10 do mês
-
Xerxes
1° lugar - 74.837 pts -
Fábio Berbert de Paula
2° lugar - 54.653 pts -
Mauricio Ferrari
3° lugar - 16.883 pts -
Andre (pinduvoz)
4° lugar - 15.725 pts -
Alberto Federman Neto.
5° lugar - 15.462 pts -
Daniel Lara Souza
6° lugar - 15.128 pts -
Diego Mendes Rodrigues
7° lugar - 14.935 pts -
Buckminster
8° lugar - 13.628 pts -
edps
9° lugar - 12.493 pts -
Alessandro de Oliveira Faria (A.K.A. CABELO)
10° lugar - 11.889 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:
