Pascal/Delphi O primeiro jogo que eu fiz.

[KXSY]

Venho aqui trazer para vocês o meu primeiro jogo que eu fiz.

E em modo texto e utiliza o console e bem maluco, porque eu tentei usar tudo que eu sabia na época e tem vários bugs.

Fonte para quem só quer passar o olho.

Programa principal.

program Cobrinha;
{$MODE OBJFPC}
uses
  Crt,SistemaV2,Controle,SysUtils;
  
var
  Jogo:TJogo;

procedure MatrixEfeito;
var
  X,Y:byte;
begin
   randomize;
   TextColor(LightGray);
   for X:=MinX to 80 do
      for Y:=MinY to 25 do
      begin
         write(#178);
      end;
   TextColor(white);
end;

procedure Paredes;
var
  N:byte;
  
begin
   TextColor(green);
   HighVideo;
   for N:=MinY to MaxY do
   begin
      GotoXY(MaxX+1,N);
      write(#178);
   end;
   for N:=MinX to MaxX+1 do 
   begin
      GotoXY(N,MaxY+1);
      write(#178);
   end;
   TextColor(white);
   LowVideo;
end;

begin
   Repeat
      Jogo:=TJogo.IniciaJogo;
      Jogo.Level(100);
      MatrixEfeito;
      Jogo.Principal;
      FreeAndNil(Jogo);
      readln;
      writeln('Quer ir de novo digite S/N');
   until UpCase(Readkey)='N';
end.

Unidades auxiliares.

{unidade responsável por toda a mecânica do jogo.}
unit SistemaV2;
{inclui o modo objeto do freepascal.}
{$MODE OBJFPC}
interface
uses
  Controle,Crt;                            //unidade com as definições do controle
  
const
  {tamanho máximo da tela}
  MaxX=60;
  MaxY=20;
  {tamanho minimo da tela}
  MinX=1;
  MinY=1;

type
  {uma sessão da cobra}
  TPedacoCobra=record
   X,Y:byte;                           //local onde o pedaço está
   Comida:boolean;                     //se a comida ou não
  end;
  
  TBuffer=array[MinX..MaxX,MinY..MaxY] of byte;
  
  {ponteiro para TCobra}
  PCobra=^TCobra;
  {definição das sessões da cobra}
  TCobra=record
   Pedaco:TPedacoCobra;                //local da cobra e se a comida
   Anterior:PCobra;                    //ponteiro anterior da lista
  end;
  
  {gerencia o corpo da cobra}
  TGerenciaCobra=class
  private
   Cobra:PCobra;                       //ponteiro para o corpo da cobra
  Public
   Constructor IniciaCobra(X,Y:byte);  //inicia em um local predefinido
   Destructor FinalizaCobra;           //finaliza o objeto e destrói o corpo da cobra
   procedure CresceCobra(X,Y:byte;C:boolean);    //cresce o corpo da cobra
   procedure MovimentaCobra(X,Y:byte); //movimenta a cobra
   property PonteiroCobra:PCobra read Cobra;
  end;
  
  {definição do tamanho da grade.}
  TGrade=array[MinX..MaxX,MinY..MaxY] of byte;
  {gerencia a grade do jogo e onde ficara o alimento da cobra}
  TGerenciaGrade=class
  private
   Grade:TGrade;                       //variável grade
  public
   constructor IniciaGrade;            //inicia a grade
   procedure LimpaGrade;               //limpa a grade
   procedure ColocaNaGrade(X,Y,V:byte);//coloca dados na grade
   procedure TiraDaGrade(X,Y:byte);    //tira os dados da grade
   function PassaValoresGrade(X,Y:byte):byte;//passa o valor na posição da grade
   function ChecaGrade(X,Y:byte; Var V:byte):boolean;//checa se a algum valor na grade
  end;
  
  TJogo=class
  private
   Pontuacao:LongInt;
   Dificudade:integer;
   GerenciaGrade:TGerenciaGrade;
   GerenciaCobra:TGerenciaCobra;
   Movimentos:TMovimentos;
  public
   Constructor IniciaJogo;
   Destructor Finaliza;
   procedure Principal;
   procedure Level(L:LongInt);
  end;
   
implementation

Constructor TGerenciaCobra.IniciaCobra(X,Y:byte);
var
  I:byte; //usada no for
begin
   {ultimo ponteiro}
   Cobra:=Nil;
   {cria quatro pedaços da cobra}
   for I:=Y to Y+4 do
      CresceCobra(X,I,False);
end;

Destructor TGerenciaCobra.FinalizaCobra;
var
  Aux:PCobra; //ponteiro genérico
begin
   {limpa a memoria}
   while Cobra<>Nil do
   begin
      Aux:=Cobra;
      Cobra:=Cobra^.Anterior;
      Dispose(Aux);
   end;
   {chama o destrutor herdado}
   Inherited Destroy;
end;

procedure TGerenciaCobra.CresceCobra(X,Y:byte;C:boolean);
var 
  Aux:PCobra; //ponteiro genérico
begin
   {cria um novo pedaço}
   New(Aux);
   {passa todos os dados}
   Aux^.Pedaco.X:=X;
   Aux^.Pedaco.Y:=Y;
   Aux^.Pedaco.Comida:=C;
   {aponta para o anterior}
   Aux^.Anterior:=Cobra;
   {prepara para o próximo ponteiro}
   Cobra:=Aux;
end;

procedure TGerenciaCobra.MovimentaCobra(X,Y:byte);
var
  Aux,P:PCobra;                        //variáveis auxilio 
  
begin
   {cria um novo pedaço da cobra}
   CresceCobra(X,Y,False);
   Aux:=Cobra;
   while Aux^.Anterior<>Nil do 
   begin
      P:=Aux;
      Aux:=Aux^.Anterior;
   end;
   {e descarta o ultimo}
   Aux:=P^.Anterior;
   P^.Anterior:=Nil;
   Dispose(Aux);
end;

Constructor TGerenciaGrade.IniciaGrade;
begin
   {inicia a grade, limpando a mesma}
   LimpaGrade;
end;

procedure TGerenciaGrade.LimpaGrade;
var
  X,Y:byte;
begin
   for X:=MinX to MaxX do
      for Y:=MinY to MaxY do
         Grade[X,Y]:=0;
end;

procedure TGerenciaGrade.ColocaNaGrade(X,Y,V:byte);
begin
   Grade[X,Y]:=V;
end;

procedure TGerenciaGrade.TiraDaGrade(X,Y:byte);
begin
   Grade[X,Y]:=0;
end;

function TGerenciaGrade.PassaValoresGrade(X,Y:byte):byte;
begin
   PassaValoresGrade:=Grade[X,Y];
end;

function TGerenciaGrade.ChecaGrade(X,Y:byte; Var V:byte):boolean;
begin
   ChecaGrade:=True;
   if Grade[X,Y]<>0 then
      V:=Grade[X,Y]
   else
      ChecaGrade:=False;
end;

Constructor TJogo.IniciaJogo;
begin
   Pontuacao:=0;
   GerenciaGrade:=TGerenciaGrade.IniciaGrade;
   Movimentos:=TMovimentos.Inicia(Random(5)+2,Random(5)+2);
   GerenciaCobra:=TGerenciaCobra.IniciaCobra(Movimentos.X,Movimentos.Y);
end;

Destructor TJogo.Finaliza;
begin
   Movimentos.Finaliza;
   GerenciaCobra.FinalizaCobra;
   GerenciaGrade.Destroy;
   Inherited Destroy;
end;

procedure TJogo.Principal;
var
  Perdeu:boolean;
  Cobra:PCobra;
  
procedure ColocaComidaNaGrade;
var
  Aux:PCobra;
  X,Y:byte;
  
begin
   X:=Random(MaxX);
   Y:=Random(MaxY);
   Aux:=GerenciaCobra.PonteiroCobra;
   while Aux<>Nil do
   begin
      if (X=Aux^.Pedaco.X)And(Y=Aux^.Pedaco.Y) then
      begin
         Aux:=Nil;
         ColocaComidaNaGrade;
      end
      else
         Aux:=Aux^.Anterior;
   end;
   if (X In [MinX..MaxX])And(Y In [MinY..MaxY]) then
      GerenciaGrade.ColocaNaGrade(X,Y,Random(254)+1)
   else
      ColocaComidaNaGrade;
end;

procedure ChecaColisao;
var 
  Aux:PCobra;
  T:TPedacoCobra;
  S:byte;
begin
   Perdeu:=False;
   Aux:=GerenciaCobra.PonteiroCobra;
   if GerenciaGrade.ChecaGrade(Aux^.Pedaco.X,Aux^.Pedaco.Y,S) then
   begin
      GerenciaCobra.CresceCobra(Movimentos.X,Movimentos.Y,True);
      GerenciaGrade.TiraDaGrade(Aux^.Pedaco.X,Aux^.Pedaco.Y);
      ColocaComidaNaGrade;
      Inc(Pontuacao,S);
   end;
   T:=Aux^.Pedaco;
   Aux:=Aux^.Anterior;
   while Aux<>Nil do
   begin
      if (T.X=Aux^.Pedaco.X)And(T.Y=Aux^.Pedaco.Y) then
      begin
         Perdeu:=True;
         Aux:=Nil;
      end
      else
         Aux:=Aux^.Anterior;
   end;
end;

procedure MostraJogo;
var 
  I,L:byte;
  S:byte;
  Buffer:TBuffer;
  
begin
   Cobra:=GerenciaCobra.PonteiroCobra;
   GotoXY(MaxX+1,MinY);
   TextColor(White);
   writeln('PONTUA',#128,#142,'O:',Pontuacao);
   Window(MinX,MinY,MaxX,MaxY);
   ClrScr;
   TextColor(LightRed);
   for I:=MinX to MaxX do
      for L:=MinY to MaxY do
      begin
         GotoXY(I,L);
         if GerenciaGrade.ChecaGrade(I,L,S) then 
         begin
            write(#64)
         end;
      end;
   while Cobra<>Nil do
   begin
      TextColor(LightGreen);
      GotoXY(Cobra^.Pedaco.X,Cobra^.Pedaco.Y);
      if Cobra^.Pedaco.Comida then
         write('O')
      else
         write('o');
      Cobra:=Cobra^.Anterior;
   end;
   {for I:=MinX to MaxX do
      for L:=MinY to MaxY do
      begin
         GotoXY(I,L);
         Case Buffer[I,L] of
         1:begin TextColor(White); write(#64); end;
         2:begin TextColor(Green); write(#178); end;
         3:begin TextColor(Green); write(#184); end;
         end;
      end;}
   Window(1,1,80,25);
end;
function Comida:byte;
begin
   Comida:=Random(255);
end;
begin
   Perdeu:=False;
   CursorOff;
   ColocaComidaNaGrade;
   HighVideo;
   repeat
      Movimentos.ChecaMovimento;
      GerenciaCobra.MovimentaCobra(Movimentos.X,Movimentos.Y);
      ChecaColisao;
      MostraJogo;
      Delay(Dificudade);
   until Perdeu=True;
end;
procedure TJogo.Level(L:LongInt);
begin
   Dificudade:=L;
end;

end.

Unit Controle;
{inclui o modo objeto do freepascal.}
{$MODE OBJFPC}

interface  
const 
  TeclasPermitidas=['A','S','W','D'];
type
  {busca por teclas pressionadas pelo usuário.}  
  TTeclas=class
  private
   Botao:char;  //tecla pressionada no momento 
  public
   constructor Inicia; 
   procedure ChecaTecla;  //checa se alguma tecla foi pressionada
   property PassaTecla:char read Botao;  //passa a tecla pressionada
  end;
  
  TMovimentos=class
  private
   D,V:byte;
   Teclas:TTeclas; //objeto teclas
   UltimaTecla:char;
  Public
   Constructor Inicia(X1,Y1:byte); //inicia com locais predefinidos
   Destructor Finaliza;
   procedure ChecaMovimento;  //checa se alguma tecla foi pressionada então atualiza
   procedure Debug;
   property X:byte read D;  //Linha
   property Y:byte read V;  //Coluna
  end;
  
implementation
uses
  Crt,SistemaV2;
  
constructor TTeclas.Inicia;
begin
   Botao:='D';
end;

procedure TTeclas.ChecaTecla;
var
  C:char;
begin
   if KeyPressed then
   begin
      C:=UpCase(ReadKey);
      if C in TeclasPermitidas then
         Botao:=C;
   end;
end;

Constructor TMovimentos.Inicia(X1,Y1:byte);
begin
   Teclas:=TTeclas.Inicia;
   D:=X1;
   V:=Y1;
end;

Destructor TMovimentos.Finaliza;
begin
   Teclas.Destroy;
   Inherited Destroy;
end;

procedure TMovimentos.ChecaMovimento;
var
  C:char;
begin
   Teclas.ChecaTecla;
   C:=Teclas.PassaTecla;
   case UpCase(C) of
   'A':if UltimaTecla='D' then
      C:=UltimaTecla;
   'D':if UltimaTecla='A' then
      C:=UltimaTecla;
   'S':if UltimaTecla='W' then
      C:=UltimaTecla;
   'W':if UltimaTecla='S' then
      C:=UltimaTecla;
   end;
   case UpCase(C) of 
   'A':if D>MinX then
         Dec(D)
      else
         D:=MaxX;
   'D':if D<MaxX then
         Inc(D)
      else
         D:=MinX;
   'W':if V>MinY then
         Dec(V)
      else
         V:=MaxY;
   'S':if V<MaxY then
         Inc(V)
      else
         V:=MinY;
   end;
   UltimaTecla:=C;
end;

procedure TMovimentos.Debug;
begin
   GotoXY(40,1);
   writeln(Teclas.PassaTecla,'-');
   GotoXY(40,2);
   writeln(X);
   GotoXY(40,3);
   writeln(Y);
end;

end.

O anexo para download tem as fontes.

Eu lembro que eu portei ele para o Nintendo DS mais não achei as fontes então vou ficar devendo.

S1.zip