Unit Snake;
interface
uses graph,crt,nmenu_2;
procedure Delay(time:longint);
procedure prov;
procedure In_rec(points:integer);
procedure Records;
procedure zmeika;


Type
     Rec = record
       Name   : string ;
       Points : integer;
     end;


var

    x_min, y_min, x_max, y_max, x, y, score, best: word;
    size,level,zvet: byte;
    food:longint;
    v, k: word;
    way_x, way_y: shortint;
    points_str, best_str: string[6];
    ch, level_ch: char;
    stop,point,quit:boolean;
    koor: array[1..400,1..2] of word;
    nm:pmenu;
    dln:word;
    points:integer;


implementation
procedure Delay(time:longint);
var
   ctime,time2:Longint;
begin
 ctime:=meml[$40:$006c];
 time2:=time div 55+ctime;
 while time2>meml[$40:$006c] do;
end;


{============Proverka=======================}
{proverka na nali4ie rec.rec }
Procedure prov;
  var
    f    : file of rec;
    temp : rec;
    i    : byte;
  begin
    Assign( F , 'Rec.snk');
    {$I-}
    reset(f);
    If IoResult <> 0 then begin
       rewrite(f);
       temp.name:='NoName';
       temp.points:=0;
       for i:=1 to 10 do
       write(f,temp);
    end;
    close(f);
    {$I+}
  end;
{===========================================}
{===============In Records==================}
{ add in rec }
Procedure In_Rec(Points : integer);
{-----------------------------------------------}
  Function ReadName : String;
    Var
     CH : Char;
     Name : String;
    Begin
    Name :='';
    Bar(190,150,299,170);
         repeat
           CH:=readkey;
           Bar(175,140,299,190);
           If CH in ['a'..'z','A'..'Z','0'..'9'] then
              Name:=Name+CH;
           If CH = #8 then begin
              Name:='';
              Bar(175,140,299,190);
           end;
           If Length( Name ) > 8 Then Delete( Name , 9 , 1 );
           OutTextXY(230,150,Name);
         until ( CH = #13 ) ;
       ReadName := Name;
    End;
{-----------------------------------------------}
  var
    temp,Help : rec;
    f    : file of rec;
    i    : byte;
    CH   : char;
    tem  : rec;
  begin
    prov;
    Assign( F , 'Rec.snk');
    reset(f);
    SetFillStyle( 1,green );
    Bar( 0,0,640,480 );
    SetFillStyle( 1,yellow );
    Bar( 170,100,470,200 );
    Rectangle(170,100,470,200);
    Seek( F , FileSize( F ) - 1 );
    Read( F , Temp );
    if (points<= temp.points) then exit;
    Seek( F , 0 );
    OutTextXY(260,120,'Введите своё имя');
    Temp.Name := ReadName;
         {-----------------Cheat---------------------}
         If Temp.Name = 'PCheat' Then Begin
            OutTextXY(200,120,'Введиет свое имя ещё раз');
            Bar(190,150,299,170);
            Temp.Name := ReadName;
            Bar( 200 , 110 , 400 , 140 );
            OutTextXY(230,120,'Введите очки');
            ReadLn( Points );
         End;
         {-------------------------------------------}
    For i:=0 to 9 do begin
      read(f,Help);
      if ( Help.points < points ) then begin
         seek(f,i);
         Dec( I );
         break;
      end;
      end;
      temp.points:=points;
      For i:=i+1 to 9 do begin
         read(f,tem);
         seek(f,i);
         write(f,temp);
         temp:=tem;
      end;
  close(f);
  end;
{===========================================}

{==================Records==================}
{write rec }
Procedure Records;
  var
    f    : file of rec         ;
    temp : rec                 ;
    i    : byte                ;
    s    : string              ;
  begin
    prov;
    Assign( F , 'Rec.snk');
    reset(f);
    SetfillStyle( 1,blue );
    Bar(0,0,640,480);
    SetFillStyle( 1,yellow );
    Bar( 195,90,445,390 );
    setlinestyle(solidln,15,thickwidth);
    setcolor(green);
    Rectangle( 195,90,445,390 );
    setcolor(darkgray);
    OutTextXY( 250,100,'Имя');
    OutTextXY( 395,100,'Очки');
    setcolor(green);
    Line ( 345,90,345,390 );
    for i:=1 to 10 do begin
      read(f,temp);
      str(temp.points,s);
      setcolor(green);
      Line( 195,140+(i-1)*25+2,445,140+(i-1)*25+2 );
      setcolor(darkgray);
      OutTextXY( 250,150+(i-1)*25+2,temp.name);
      OutTextXY( 395,150+(i-1)*25+2,s);
    end;
  Close( F );
  repeat
    ch:=readkey;
  until ch=#13;
  Setlinestyle(solidln,15,normwidth);
  End;

Procedure Pause;
{Пауза в игре}
  begin
    SetFillStyle(1,red);
    bar(250,305,360,340);
    SetColor(14);
    SetTextStyle(7,0,3);
    OutTextXY(300,315,'Пауза');
    SetFillStyle(1,red);
    bar(80,355,540,390);
    SetColor(14);
    SetTextStyle(7,0,3);
    OutTextXY(313,370,'Для продолжения нажмите Enter');

    repeat
      ch:=readkey;
     until ch=#13;
    SetTextStyle(0,0,0);
    SetFillStyle(1,green);
    bar(250,305,360,340);
    bar(80,355,540,390);
  end;



procedure zmeika;
begin
  zvet:=random(10);
  points:=0;
  x_min:=30;
  y_min:=45;
  x_max:=600;
  y_max:=450;
  k:=15;
  setbkcolor(blue);

  setfillstyle(1,lightgray);
  bar(x_min-15,y_min-15,x_max+15,y_max+15);{серая раммочка вогруг поля}
  setfillstyle(1,green);
  bar(x_min,y_min,x_max,y_max);{игровое поле}

  size:=5;{hfpvth pvtqrb}
  x:=x_min+size*k;
  y:=y_max div 2;
  setfillstyle(1,14);
  bar(x-size*k,y,x,y+k);{начальные местоположение змейки на экране}
  way_x:=1;
  way_y:=0;
  for v:=1 to size do
  begin
    koor[v,1]:=x-v*k+k;
    koor[v,2]:=y
  end;
  point:=false;

  settextstyle(0,0,1);               { Текст навеpху }
  setcolor(red);
  setlinestyle(solidln,15,thickwidth);
  setfillstyle(1,yellow);
  bar(15,0,100,29);
  rectangle(15,0,102,29);
  bar(103,0,300,29);
  bar(303,0,615,29);
  rectangle(302,0,615,29);
  rectangle(102,0,302,29);
  setcolor(blue);
  outtextxy(50,15,'Очки: ');
  outtextxy(80,15,'0');
  outtextxy(200,15,'Выберите уровень от 1-9');
  outtextxy(450,10,'Завершения игры нажмите Esc');
  outtextxy(450,20,'Для паузы нажтите P');


  repeat
    level_ch:=readkey;
  until (level_ch>=#49) and (level_ch<=#57);
  val(level_ch,level,v);
  setfillstyle(1,yellow);
  bar(107,5,297,23);
  setcolor(blue);
  outtextxy(185,15,'Уpовень:');
  setcolor(blue);
  outtextxy(235,15,level_ch);

  repeat
    if keypressed then ch:=readkey;
    case ch of
      #72: if way_y=0 then
           begin
             way_x:=0;
             way_y:=-1
           end;
      #75: if way_x=0 then
           begin
             way_x:=-1;
             way_y:=0
           end;
      #77: if way_x=0 then
           begin
             way_x:=1;
             way_y:=0
           end;
      #80: if way_y=0 then
           begin
             way_x:=0;
             way_y:=1
           end;
      #27: break;

      #112: pause;
    end;

    {стирание за собой следа}
    setfillstyle(1,green);
    bar(koor[size,1]-k, koor[size,2], koor[size,1], koor[size,2]+k);

    for v:=size downto 2 do            { Пеpесчет кооpдинат }
    begin
      koor[v,1]:=koor[v-1,1];
      koor[v,2]:=koor[v-1,2]
    end;
    koor[1,1]:=koor[1,1]+way_x*k;
    koor[1,2]:=koor[1,2]+way_y*k;

    if (koor[1,1]>x_max) or (koor[1,2]=y_max) or (koor[1,1]=x_min) or
       (koor[1,2]<y_min) then       { Попадание в стену }
    begin
      sound(100);
      delay(100);
      nosound;
      break
    end;

    if point=false then           { Рисование точек }
    begin
      repeat
        randomize;
        x:=(random((x_max-x_min) div k)+1)*k+x_min;
        y:=(random((y_max-y_min) div k)+1)*k+y_min;
        point:=true;
        for v:=1 to size do
          if (x=koor[v,1]) and (y=koor[v,2]+k) then point:=false

      until point;
      setfillstyle(1,red);{цвет цели}
      setcolor(white);
      fillellipse(x-7,y-7,6,6);{форма цели}
      setcolor(0);
      line(0,0,0,15)
    end;

    if (x=koor[1,1]) and (y=koor[1,2]+k) then      { Съедание точек }
    begin
      sound(900);
      inc(size);

      setfillstyle(1,yellow);
      bar(70,4,100,22);
      inc(points,5);
      str(points,points_str);
      setcolor(blue);
      outtextxy(80,15,points_str);

      point:=false
    end;

    for v:=2 to size do       { Самопеpесечение }
      if (koor[1,1]=koor[v,1]) and (koor[1,2]=koor[v,2]) then
      begin
        sound(150);
        delay(100);
        nosound;
        quit:=true;
        break
        end;


    setfillstyle(1,14);
    bar(koor[1,1]-k, koor[1,2], koor[1,1], koor[1,2]+k);

    delay(181-9*level);
    if point=false then nosound;
    if keypressed then ch:=readkey

  until (ch=#27) or quit ;
  prov;
  setfillstyle(1,yellow);
  if points>50 then begin
  setfillstyle(1,yellow);
  setcolor(blue);
  setlinestyle(solidln,15,thickwidth);
  rectangle(168,148,462,302);
  bar(170,150,460,300);
  setcolor(blue);
  settextstyle(0,horizdir,3);
  outtextxy(314,220,'Y O U  W I N');
   readkey;
   settextstyle(0,horizdir,1);
   In_rec(points);
   bar(0,0,640,480);
   settextstyle(0,horizdir,1);
   records;
  end
  else begin
  setfillstyle(1,yellow);
  setcolor(red);
  setlinestyle(solidln,15,thickwidth);
  rectangle(168,148,462,302);
  bar(170,150,460,300);
  setcolor(red);
  settextstyle(0,horizdir,2);
  outtextxy(314,220,'G A M E  O V E R');
  readkey;
  bar(0,0,640,480);
  settextstyle(0,horizdir,1);
  records;
  end;
  settextstyle(0,horizdir,1);
  setlinestyle(solidln,0,normwidth);
end;

end.