old/PAS/OLD/LINE31.PAS

Uses CRT,Graph,DOS;
Type main = record
  n : integer;
  c : byte;
end;
Type Hiscore = record
  Name  : string[13];
  Score : Word;
  Sp    : byte;
end;
const
  rt : byte = 77;
  lt : byte = 72;
Var
 s         : SearchRec;
 Tbl       : file of HiScore;
 MAX,col   : HiScore;
 C         : char;
 W, e      : word;
 Dir, b,cl : byte;
 Num       : integer;
 en        : array [1..2] of byte;
 bg        : array [1..2] of byte;
 a         : array [20..80, 2..25] of main;
 i,j,k,l,r : byte;
{-----------------======================-----------------}
Procedure Setup; forward;
Procedure Stat(bg1,bg2:byte); forward;
Procedure Apple ; forward;
Procedure Ext ; forward;
Procedure StartUp; forward;
Procedure DrawTable; forward;
Procedure Game(lt,rt:byte); forward;
{---------------------------------------------------------}
Procedure Setup;
begin
  CloseGraph;
  ClrScr;
  TextMode(CO80);
  GotoXY(10, 5);
  Write('1 :  Скорость');
  GotoXY(10, 10);
  Write('2 :  Установить Клавиши');
  GotoXY(10, 15);
  Write('3 :  Завершить настроики');
  GotoXY(1,1);
  Case readkey of
    '1' : begin
            GotoXY(12,20);
            Write('Введите скорость 1..10 (5) ');
            repeat
             Readln(max.sp);
            until (max.sp > 0) and (max.sp < 11);
           end;
    '2' : begin
            GotoXY(12,20);
            Write('Лево ');
            c := readkey;
            if c = #0 then
              begin
                lt := ord(readkey);
                write(lt);
              end
            else
              begin
                lt := ord(c);
                Write(lt);
              end;
            GotoXY(12,21);
            Write('Право ');
            c := readkey;
            if c = #0 then
              begin
                rt := ord(readkey);
                write(rt);
              end
            else
              begin
                rt := ord(c);
                Write(rt);
              end;
          end;
    end;
end;
{--------------------------------------------------------}
Procedure Stat;
Var g,h,n :byte;
begin
  n := 0;
  TextColor(7);
  GotoXY(2,5);
  Write('X           : ',bg1-1);
  GotoXY(2,7);
  Write('                  ');
  GotoXY(WhereX-18,WhereY);
  Write('Y           : ',bg2);
  GotoXY(2,9);
  Write('Длина змея  : ', col.score);
  GotoXY(2,11);
  Write('Число ходов : ',num);
  GotoXY(6,13);
  Write('Лучший ');
  GotoXY(2,14);
  Write(max.name);
  GotoXY(16,14);
  Write(Max.score);
  GotoXY(bg1,bg2);
  TextColor(cl);
end; {stat}
{--------------------------------------------------------}
Procedure Apple;
Var i,j,k,b1,b2 : byte;
begin
  randomize;
  repeat
    i := random(78);
    j := random(23);
    k := random(9);
    r := random(14);
  until (i > 20) and (i < 80) and (j > 2 ) and (j < 25)
  and (k <> 0) and (a[i,j].n = 0) and (r <> 0) and (r <> 7) and (r <> cl);
  b1 := WhereX;
  b2 := WhereY;
  GotoXY(i,j);
  TextColor(r);
  Write(k);
  TextColor(cl);
  a[i,j].n := - k;
  a[i,j].c := r;
  GotoXY(b1,b2);
end;
{-------------------------------------------------------}
Procedure Ext;
var Gd, Gm :integer;
begin
  {Sound(100);
  Delay(2000);
  Nosound;}
  if col.score > max.score then
    begin
      ClrScr;
      GotoXY(30,10);
      max.score := col.score;
      TextColor(cyan);
      Write('П О З Д Р А В Л Я Ю');
      GotoXY(30,12);
      TextColor(Blue);
      Write('Вы поставили рекорд');
      GotoXY(12,17);
      TextColor(Yellow);
      Write('Введите свое имя до 13 символов ');
      TextColor(lightgreen);
      Read(max.name);
      TextColor(7);
    end;
  Seek(tbl,0);
  Write(tbl,max);
  Gd := Detect;
  InitGraph(Gd, Gm, '');
  if GraphResult <> grOk then Halt(1);
  ClearDevice;
  SetColor(Magenta);
  SetTextStyle(TriplexFont, HorizDir,10);
  OutTextXY(150,100,'Game');
  OutTextXY(170,200,'OveR');
  SetColor(Green);
  SetTextStyle(SmallFont, HorizDir,20);
  OutTextXY(180,430,'Another Game ? ');
  if (readkey = 'y') or (readkey = 'Y') then
    begin
      CloseGraph;
      Game(lt,rt);
    end;
  Close(Tbl);
  Halt;
end; {Ext}
{-------------------------------------------------------}
Procedure StartUp;
var
  Gd, Gm : Integer;
begin
  Gd := Detect;
  InitGraph(Gd, Gm, '');
  if GraphResult <> grOk then Halt(1);
  ClearDevice;
  SetColor(Blue);
  SetTextStyle(3, HorizDir,8);
  OutTextXY(80,100,'Game Piton');
  SetColor(White);
  SetTextStyle(1,HorizDir,2);
  OutTextXY(20,450,'Press "S" for Setup, "Q" to Quit, any other to continue');
  case ReadKey of
    's','S' : setup;
    'q','Q' : begin
                CloseGraph;
                halt;
              end;
  end;
  CloseGraph;
  Game(lt,rt);
end; {StartUp}
{------------------==================-------------------}
Procedure DrawTable;
 var y:integer;
 begin
   clrscr;
   TextColor(blue);
   GotoXY(40,2);
   Write('Game PITON');
   TextColor(7);
   for y := 20 to 79 do
     begin
       GotoXY(y, 3);
       Write('═');
       GotoXY(y, 25);
       Write('═');
     end;
   Write('╝');
   GotoXY(80, 2);
   Write('╗');
   For y := 3 to 23 do
     begin
       GotoXY(20, y);
       Write ('║');
       GotoXY(WhereX-1, WhereY + 1);
       Write('╚');
       GotoXY(80, y);
         Write ('║')
      end;
   GotoXY(20,2);
   Write('╔');
end; {DrawTable}
{-------------------------------------------------------}
Procedure Game;
begin
  ClrScr;
  TextBackGround(0);
  DrawTable;
  assign(Tbl,'hiscr.dat');
  {$I-}
  Reset(Tbl);
  {$I+}
  if IOResult <> 0 then
    ReWrite(tbl);
  FindFirst('Hiscore.dat',AnyFile,s);
  if s.size = 0 then
    begin
      if max.sp = 0 then
        max.sp := 5 ;
      max.Score := 9;
      max.name := 'Coder';
      Seek(tbl,0);
      Write(tbl,max);
      Close(tbl);
      Reset(tbl);
    end;
  {$I-}
  Read(tbl,max);
  {$I+}
  If IOResult <> 0 then Halt;
  for i := 20 to 80 do
    for j := 2 to 25 do
      begin
        a[i,j].c := 7;
        a[i,j].n := 0;
      end;
  cl := 7;
  e := 1;
  en[1] := 39;
  en[2] := 13;
  Num := 1;
  Dir := 1;
  b := 10;
  col.score := 9;
  a[39,13].n := 1;
  GotoXY(40,13);
  repeat
    l := 0;
    if keypressed then
      begin
        c := readkey;
        if c = #0 then w := ord(readkey)
        else w := ord(c);
            if (w = rt) or (w = lt) then
              begin
                l := 1;
                case w of
                 11 : case dir of
                       1 : begin
                             if WhereX > 79 then ext;
                             if a[whereX,WhereY].n > 0 then ext;
                             if a[WhereX,WhereY].n < 0 then
                               begin
                                 b := b - a[WhereX,WhereY].n;
                                 inc(col.score,-a[whereX,WhereY].n);
                               end;
                             If a[WhereX,WhereY].c <> 7 then
                               begin
                                 TextColor(a[WhereX,WhereY].c);
                                 cl := a[WhereX,WhereY].c;
                               end;
                             Write('╗');
                             inc(num);
                             a[WhereX-1,WhereY].n := Num;
                             dir := 2
                           end;
                       2 : begin
                             if (WhereY + 1) > 24 then ext;
                             if a[whereX-1,WhereY+1].n > 0 then ext;
                             if a[WhereX-1,WhereY+1].n < 0 then
                               begin
                                 b := b - a[WhereX-1,WhereY+1].n;
                                 inc(col.score, -a[WhereX-1,WhereY+1].n);
                               end;
                             If a[WhereX-1,WhereY+1].c <> 7 then
                               begin
                                 TextColor(a[WhereX-1,WhereY+1].c);
                                 cl := a[WhereX-1,WhereY + 1].c;
                               end;
                             GotoXY(WhereX-1,WhereY+1);
                             Write('╝');
                             inc(num);
                             a[WhereX-1,WhereY].n := Num;
                             a[WhereX-1,WhereY].c := a[WhereX-1,WhereY-1].c;
                             dir := 3;
                           end;
                       3 : begin
                             if (WhereX - 2) < 21 then ext;
                             if a[whereX-2,WhereY].n > 0 then ext;
                             if a[WhereX-2,WhereY].n < 0 then
                               begin
                                 b := b - a[WhereX-2,WhereY].n;
                                 inc(col.score, -a[WhereX-2,WhereY].n);
                               end;
                             If a[WhereX-2,WhereY].c <> 7 then
                               begin
                                 TextColor(a[WhereX-2,WhereY].c);
                                 cl := a[WhereX-2,WhereY].c;
                               end;
                             GotoXY(WhereX-2,WhereY);
                             Write('╚');
                             inc(num);
                             a[WhereX-1,WhereY].n := num;
                             a[WhereX-1,WhereY].c := a[WhereX,WhereY].c;
                             Dir := 4
                           end;
                       4 : begin
                             if (WhereY - 1) < 3 then ext;
                             if a[whereX-1,WhereY-1].n > 0 then ext;
                             if a[WhereX-1,WhereY-1].n < 0 then
                               begin
                                 b := b - a[WhereX-1,WhereY-1].n;
                                 inc(col.score, -a[WhereX-1,WhereY-1].n);
                               end;
                             If a[WhereX - 1,WhereY - 1].c <> 7 then
                               begin
                                  TextColor(a[WhereX-1,WhereY-1].c);
                                  cl := a[WhereX-1,WhereY - 1].c;
                               end;
                             GotoXY(WhereX-1,WhereY-1);
                             Write('╔');
                             inc(num);
                             a[WhereX-1,WhereY].n := Num;
                             a[WhereX-1,WhereY].c := a[WhereX-1,WhereY+1].c;
                             Dir := 1
                           end;
                       end;
                12 : case dir of
                       1 : begin
                             if WhereX > 79 then ext;
                             if a[whereX,WhereY].n > 0 then ext;
                             if a[WhereX,WhereY].n < 0 then
                               begin
                                 b := b - a[WhereX,WhereY].n;
                                 inc(col.score, -a[WhereX,WhereY].n);
                               end;
                             If a[WhereX,WhereY].c <> 7 then
                               begin
                                 TextColor(a[WhereX,WhereY].c);
                                 cl := a[WhereX,WhereY].c;
                               end;
                             Write('╝');
                             inc(num);
                             a[WhereX-1,WhereY].n := Num ;
                             dir := 4
                           end;
                       2 : begin
                             if WhereY + 1 > 23 then ext;
                             if a[whereX-1,WhereY+1].n > 0 then ext;
                             if a[WhereX-1,WhereY+1].n < 0 then
                               begin
                                 b := b - a[WhereX-1,WhereY+1].n;
                                 inc(col.score, -a[WhereX-1,WhereY+1].n);
                               end;
                             If a[WhereX-1,WhereY+1].c <> 7 then
                               begin
                                 TextColor(a[WhereX-1,WhereY+1].c);
                                 cl := a[WhereX-1,WhereY + 1].c;
                               end;
                             GotoXY(WhereX-1,WhereY + 1);
                             Write('╚');
                             inc(num);
                             a[WhereX-1,WhereY].c := a[WhereX-1,WhereY-1].c;
                             a[WhereX-1,WhereY].n := Num;
                             dir := 1;
                           end;
                       3 : begin
                             if WhereX - 2 < 21 then ext;
                             if a[whereX-2,WhereY].n > 0 then ext;
                             if a[WhereX-2,WhereY].n < 0 then
                               begin
                                 b := b - a[WhereX-2,WhereY].n;
                                 inc(col.score, -a[WhereX-2,WhereY].n);
                               end;
                             If a[WhereX-2,WhereY].c <> 7 then
                               begin
                                 TextColor(a[WhereX-2,WhereY].c);
                                 cl := a[WhereX-2,WhereY].c;
                               end;
                             GotoXY(WhereX-2,WhereY);
                             Write('╔');
                             inc(num);
                             a[WhereX-1,WhereY].n := num;
                             a[WhereX-1,WhereY].c := a[WhereX,WhereY].c;
                             Dir := 2
                           end;
                       4 : begin
                             if WhereY - 1 < 3 then ext;
                             if a[whereX-1,WhereY-1].n > 0 then ext;
                             if a[WhereX-1,WhereY-1].n < 0 then
                               begin
                                 b := b - a[WhereX-1,WhereY-1].n;
                                 inc(col.score, -a[WhereX-1,WhereY-1].n);
                               end;
                             If a[WhereX-1,WhereY-1].c <> 7 then
                               begin
                                 TextColor(a[WhereX-1,WhereY-1].c);
                                 cl := a[WhereX-1,WhereY - 1].c;
                               end;
                             GotoXY(WhereX-1,WhereY - 1);
                             Write('╗');
                             inc(num);
                             a[WhereX-1,WhereY].n := num ;
                             a[WhereX-1,WhereY].c := a[WhereX-1,WhereY+1].c;
                             Dir := 3
                            end;
                 end;
            end;
          end;
      end;
      begin
        if l = 0 then
          begin
            case dir of
            1 : if WhereX > 79 then ext
                else
                  if a[WhereX,WhereY].n > 0 then ext
                  else
                   begin
                      if a[WhereX,WhereY].n < 0 then
                        begin
                          b:=b-a[WhereX,WhereY].n;
                          inc(col.score,-a[whereX,WhereY].n);
                        end;
                      If a[WhereX,WhereY].c <> 7 then
                        begin
                          TextColor(a[WhereX,WhereY].c);
                          cl := a[WhereX,WhereY].c;
                        end;
                      Write('═');
                      inc(num);
                      a[WhereX-1,WhereY].n := Num;
                      a[WhereX-1,WhereY].c := a[WhereX-2,WhereY].c;
                      if b > 0 then b := b - 1;
                    end;
            2: if (WhereY + 1) > 23 then ext
               else
                  if a[WhereX-1,WhereY+1].n > 0 then ext
                  else
                    begin
                      if a[WhereX-1,WhereY+1].n < 0 then
                        begin
                          b := b-a[WhereX-1,WhereY+1].n;
                          inc(col.score, -a[WhereX-1,WhereY+1].n);
                        end;
                      If a[WhereX-1,WhereY+1].c <> 7 then
                        begin
                          TextColor(a[WhereX-1,WhereY+1].c);
                          cl := a[WhereX-1,WhereY + 1].c;
                        end;
                      GotoXY(WhereX-1,WhereY+1);
                      Write('║');
                      inc(num);
                      a[WhereX-1,WhereY].n := Num;
                      a[WhereX-1,WhereY].c := a[WhereX-1,WhereY-1].c;
                      if b > 0 then b := b - 1;
                    end;
            3 : if (WhereX-2) < 21 then ext
                else
                  if a[WhereX-2,WhereY].n > 0 then ext
                  else
                    begin
                      if a[WhereX-2,WhereY].n < 0 then
                        begin
                          b:=b-a[WhereX-2,WhereY].n;
                          inc(col.score, -a[WhereX-2,WhereY].n);
                        end;
                      If a[WhereX-2,WhereY].c <> 7 then
                        begin
                          TextColor(a[WhereX-2,WhereY].c);
                          cl := a[WhereX-2,WhereY].c;
                        end;
                      GotoXY(Wherex-2,WhereY);
                      Write('═');
                      inc(Num);
                      a[WhereX-1,WhereY].n := Num ;
                      a[WhereX-1,WhereY].c := a[WhereX,WhereY].c;
                      if b > 0 then b := b - 1;
                    end;
            4 : if (WhereY - 1) < 3 then ext
               else
                  if a[WhereX-1,WhereY-1].n > 0 then ext
                  else
                    begin
                      if a[WhereX-1,WhereY-1].n < 0 then
                        begin
                          b := b - a[WhereX-1,WhereY-1].n;
                          inc(col.score, -a[WhereX-1,WhereY-1].n);
                        end;
                      If a[WhereX-1,WhereY-1].c <> 7 then
                        begin
                          TextColor(a[WhereX-1,WhereY-1].c);
                          cl := a[WhereX-1,WhereY - 1].c;
                        end;
                      GotoXY(WhereX-1,WhereY-1);
                      Write('║');
                      inc(Num);
                      a[WhereX-1,WhereY].n := Num ;
                      a[WhereX-1,WhereY].c := a[WhereX-1,WhereY+1].c;
                      if b > 0 then b := b - 1;
                    end;
           end;
         end;
    end;
    Stat(WhereX,WhereY);
    if b = 0 then
      begin
        bg[1] := WhereX;
        bg[2] := WhereY;
        GotoXY(en[1],en[2]);
        Write(' ');
        a[WhereX-1,WhereY].n := 0;
        a[WhereX-1,WhereY].c := 7;
        if a[WhereX,WhereY].n = e + 1 then
          begin
            en[1] := WhereX;
            en[2] := WhereY;
            inc(e);
          end;
        if a[WhereX-2,WhereY].n = e + 1 then
          begin
            en[1] := WhereX-2;
            en[2] := WhereY;
            inc(e);
          end;
        if a[WhereX-1,WhereY+1].n = e + 1 then
          begin
            en[1] := WhereX-1;
            en[2] := WhereY+1;
            inc(e);
          end;
        if a[WhereX-1,WhereY-1].n = e + 1 then
          begin
            en[1] := WhereX-1;
            en[2] := WhereY-1;
            inc(e)
          end;
        GotoXY(bg[1],bg[2]);
      end;
  Delay(1000 + max.sp * 100);
  k := 0;
  for i := 21 to 79 do
    for j := 3 to 24 do
      if a[i,j].n < 0 then k := 1;
  if k = 0 then apple;
  until false;
end;
Begin
  StartUp;
end.