{++++++++++++++++++++++++++++++++++++++++++++}
{+ Por: |[QuArK]|                           +}
{+                                          +}
{+ Puedes encontrarme en el canal #pascal   +}
{+ del irc hispano. Este c¢digo es de libre +}
{+ distribucion, si cambias algo de ‚l,     +}
{+ espero ser nombrado en los creditos.     +}
{+                                          +}
{++++++++++++++++++++++++++++++++++++++++++++}
uses crt;

label re;

type
  Pp = record
         X,Y : Integer;
       end;
  Dd = (NAD,ARR,ABA,IZQ,DER);
const
{ variables de la "serpiernte" }
  body       : char = #35;
  serp_c     = 2;
{ variables de la comida }
  body_b     : char = #111;
  body_c     = 14;
var
{ otras variables }
  t          : byte;
  tecla      : char;
  oldtecla   : char;
  fin        : boolean;

{ variables de puntuacion }
  val_punt   : byte;
  punt       : longint;
  punt_s     : string;

{ variables de la comida }
  Bola       : pp;
  OBola      : pp;

{ variables del campo }
  x,y,xx,yy  : integer;

{ variables de la "serpiernte" }
  Cuerpo     : Array [1..50] of PP;
  nivel      : Char;         { Indicara el nivel de dificultad del juego }
  dificultad : Integer;      { Indicara la dificultad segun el nivel }
  Dir        : Dd;

Procedure Frame(X1,Y1,X2,Y2:Byte);
procedure WC(x1,y1,f,b:byte;T:Char);
var old:byte; wmo:word;
begin
{ Normal }
  Old:=TextAttr; Wmo:=WindMax;
  WindMax:=(X1) + ((Y1) * 256);
  textcolor(f); textbackground(b);
  gotoxy(x1,y1); write(T);
  WindMax:=Wmo; TextAttr:=Old;
end;
Const BH=#205; BV=#186; ESI=#201; ESD=#187; EII=#200; EID=#188;
Var T1 : Byte;
begin
  Textcolor(15); Textbackground(0);
  for t1:=(x1+1) to (x2-1) do
    begin gotoxy(T1,Y1); Write(BH); gotoxy(T1,Y2); Write(BH); end;
  for t1:=(y1+1) to (y2-1) do
    begin gotoxy(X1,T1); Write(BV); gotoxy(X2,T1); Write(BV); end;
  WC(X1,Y1,15,0,ESI);
  WC(X1,Y2,15,0,EII);
  WC(X2,Y1,15,0,ESD);
  WC(X2,Y2,15,0,EID);
end;

procedure beep;
begin
  sound(220); delay(50); nosound;
end;

procedure Akaba;
begin
  TextMode(co80);
  Writeln('Adios.');
  Halt;
end;

procedure salir;
var ch:char;
begin
  TextColor(15); GotoXY(1,2); Write('¨Quieres salir? s/n');
  ch:=#0;
  repeat
    while keypressed do begin ch:=readkey; ch:=upcase(ch); end;
  until (ch='S') or (ch='N');
  if (ch='S') then fin:=true else fin:=false;
  TextColor(0); GotoXY(1,2); Write('¨Quieres salir? s/n');
end;

procedure seteacuerpo;
begin
  for t:=1 to 50 do Cuerpo[T].X:=t+3;
  for t:=1 to 50 do Cuerpo[T].Y:=10;
end;

procedure Actualiza;
begin
  for t:=1 to 49 do
    begin
      Cuerpo[T].X:=Cuerpo[T+1].X;
      Cuerpo[T].Y:=Cuerpo[T+1].Y;
    end;
end;

procedure Draw(Col:byte);
begin
  for t:=1 to 50 do
    begin
      GotoXY(Cuerpo[T].X, Cuerpo[T].Y);
      TextColor(Col); Write(Body);
    end;
end;

procedure RDraw(Col:byte);
begin
  GotoXY(Cuerpo[50].X, Cuerpo[50].Y);
  TextColor(Col); Write(Body);
end;

function colision : boolean;
var b:boolean;
begin
  b:=false;
  for t:=1 to 49 do
    begin
      if (Cuerpo[T].X = Cuerpo[50].X) and
         (Cuerpo[T].Y = Cuerpo[50].Y) then b:=true;
    end;
  colision:=b;
end;

function onbody(x,y:byte) : boolean;
var b:boolean;
begin
  b:=false;
  for t:=1 to 49 do
    begin
      if (Cuerpo[T].X = X) and
         (Cuerpo[T].Y = Y) then b:=true;
    end;
  onbody:=b;
end;

{ Bucle principal }
Begin
  ClrScr;
  Writeln('Juego de la serpiente en modo texto. Por |[QuArK]|'); Writeln;
  Writeln('Nivel de dificultad: [1-2-3-4-5]');

  repeat
    Nivel:=readkey;
  until (nivel = '1') or (nivel = '2') or (nivel = '3') or (nivel = '4') or (nivel = '5') or (nivel = '0');

  if (nivel = '0') then begin Writeln('Adios...'); Halt; end;
  if (nivel = '5') then begin dificultad:=20; val_punt:=20; end;
  if (nivel = '4') then begin dificultad:=30; val_punt:=15; end;
  if (nivel = '3') then begin dificultad:=40; val_punt:=10; end;
  if (nivel = '2') then begin dificultad:=60; val_punt:=8; end;
  if (nivel = '1') then begin dificultad:=80; val_punt:=4; end;

  TextMode(Co80+Font8x8); TextColor(7); TextBackGround(0); ClrScr;

  { Volver a jugar }
  re:

  { Ajusta el campo de juego }
  x:=1; y:=4; xx:=80; yy:=50;
  Frame(X,Y,XX,YY);

  { Ajusta la bola de comida }
  Randomize;
  Bola.X:=Random((XX-1)-X)+X+1;
  Bola.Y:=Random((YY-1)-Y)+Y+1;
  OBola.X:=0; OBola.Y:=0;

  { Ajusta otros valores }
  Dir:=nad;
  punt:=0;
  tecla:=#77;
  oldtecla:=#0;
  SeteaCuerpo;
  Draw(serp_c);

  { Dibuja la puntuacion }
  Str(Punt, Punt_S);
  TextColor(15); GotoXY(1,1); Write('Puntos: ['+punt_S,']   ');
  TextColor(7);

  Repeat
    { Guarda la ultima tecla }
    if (oldtecla <> tecla) then oldtecla:=tecla;
    { Lee tecla }
    while keypressed do
      begin
        tecla:=readkey; tecla:=upcase(tecla);
      end;
    Delay(Dificultad);
    { Arriba }
    if (tecla = #72) then
      begin
        if (Dir = Aba) then
          begin
            Beep; tecla:=#80;
          end
        else
          begin
            GotoXY(Cuerpo[1].X,Cuerpo[1].Y);
            TextColor(0); Write(Body);
            Actualiza;
            Cuerpo[50].Y:=Cuerpo[50].Y-1;
            Dir:=Arr;
          end;
      end;
    { Abajo }
    if (tecla = #80) then
      begin
        if (Dir = Arr) then
          begin
            Beep; tecla:=#72;
          end
        else
          begin
            GotoXY(Cuerpo[1].X,Cuerpo[1].Y);
            TextColor(0); Write(Body);
            Actualiza;
            Cuerpo[50].Y:=Cuerpo[49].Y+1;
            Dir:=Aba;
          end;
      end;
    { Izquierda }
    if (tecla = #75) then
      begin
        if (Dir = Der) then
          begin
            Beep; tecla:=#77;
          end
        else
          begin
            GotoXY(Cuerpo[1].X,Cuerpo[1].Y);
            TextColor(0); Write(Body);
            Actualiza;
            Cuerpo[50].X:=Cuerpo[50].X-1;
            Dir:=Izq;
          end;
      end;
    { Derecha }
    if (tecla = #77) then
      begin
        if (Dir = Izq) then
          begin
            Beep; tecla:=#75;
          end
        else
          begin
            GotoXY(Cuerpo[1].X,Cuerpo[1].Y);
            TextColor(0); Write(Body);
            Actualiza;
            Cuerpo[50].X:=Cuerpo[50].X+1;
            Dir:=Der;
          end;
      end;
    { Dibuja bola si no se ha dibujado ya }
    if (Obola.X <> Bola.X) or (Obola.Y <> Bola.Y) then
      begin
        GotoXY(Bola.X, Bola.Y); TextColor(body_c); Write(Body_b);
        Obola.X:=Bola.X; Obola.Y:=Bola.Y;
      end;
    { Comprueba si comes la bola }
    if (Bola.X = Cuerpo[50].X) and (Bola.Y = Cuerpo[50].Y) then
      begin
        { Genera una nueva bola }
        repeat
          Bola.X:=Random((XX-1)-X)+X+1;
          Bola.Y:=Random((YY-1)-Y)+Y+1;
        until not onbody(Bola.X, Bola.Y);
        { Aumenta la puntuacion }
        TextColor(0); GotoXY(1,1); Write('Puntos: ['+punt_S,']   ');
        Punt:=Punt+val_punt;
        Str(Punt, Punt_S);
        TextColor(15); GotoXY(1,1); Write('Puntos: ['+punt_S,']   ');
      end;
    { Comprueba limites y colisiones }
    if (Cuerpo[50].X <= X) or (Cuerpo[50].X >= XX) or
       (Cuerpo[50].Y <= Y) or (Cuerpo[50].Y >= YY) or Colision then
      begin
        TextColor(15); GotoXY(1,2); Write('¨Quieres volver a jugar? s/n');
        tecla:=#0;
        repeat
          while keypressed do begin tecla:=readkey; tecla:=upcase(tecla); end;
        until (tecla='S') or (tecla='N');
        TextColor(0); GotoXY(1,2); Write('¨Quieres volver a jugar? s/n');
        if (tecla='N') then
          fin:=true
        else
          begin
            TextColor(7); TextBackGround(0); ClrScr;
            goto re;
          end;
      end;
    { Redibuja la serp }
    RDraw(serp_c);
    { Esc }
    if (tecla =#27) then
      begin salir; tecla:=oldtecla; end;
  until Fin;
  Akaba;

end.