old/PAS/OLD/PITON.PAS

Uses CRT,Graph,DOS;
Type main = record
  n : integer;
  c : byte;
end;
Type Hiscore = record
  Name  : array[1..10] of string[18];
  Score : array[1..10] of Word;
  Sp    : byte;
end;
Var
 rcrd      : boolean;
 s         : SearchRec;
 Tbl       : file of HiScore;
 MAX,col   : HiScore;
 C         : char;
 lt, rt    : Byte;
 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; forward;
{---------------------------------------------------------}
Procedure Recrd(i : byte);
Var t : byte;
Begin
  t := 0;
  if rcrd then begin
    ClrScr;
    GotoXY(30,10);
    if i = 10 then max.score[10] := col.score[1]
    else
      for t := 9 downto i do begin
        max.score[t+1] := max.score[t];
        max.name[t+1] := max.name[t]
      end;
    max.score[i] := col.score[1];
    TextColor(cyan);
    Write('П О З Д Р А В Л Я Ю');
    GotoXY(30,12);
    TextColor(Blue);
    Write('Вы поставили рекорд');
    GotoXY(12,17);
    TextColor(Yellow);
    Write('Введите свое имя до 20 символов ');
    TextColor(lightgreen);
    Readln(max.name[i]);
    TextColor(7);
    Seek(tbl,0);
    Write(tbl,max);
    Close(tbl);
    Reset(tbl);
  end;
end;
{-----------------------------------------------------------}
Procedure SetCursorSize(size:word);
var
  reg : registers;
begin
  with reg do begin
    AH := $01;
    CH := hi(size);
    CL := lo(size);
    Intr($10,reg);
  end;
end;
{------------------------------------------------------------}
Procedure Setup;
begin
  CloseGraph;
  ClrScr;
  TextMode(CO80);
  SetCursorSize(16*256);
  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
        end;
    end;
end;
{--------------------------------------------------------}
Procedure Stat;
Var n :byte;
begin
  n := 0;
  TextColor(Yellow);
  GotoXY(2,3);
  Write('                  ');
  GotoXY(2,3);
  Write('X           : ',bg1-21);
  GotoXY(2,5);
  Write('                  ');
  GotoXY(WhereX-18,WhereY);
  Write('Y           : ',bg2-2);
  GotoXY(2,7);
  Write('Длина змея  : ', col.score[1]);
  GotoXY(2,9);
  Write('Число ходов : ',num);
  GotoXY(7,12);
  TextColor(LightBlue);
  Write('Лучшие ');
  TextColor(LightGreen);
  for n := 1 to 10 do begin
    GotoXY(2,13 + n);
    TextColor(Random(15));
    Write(max.name[n], Max.score[n]:(17 - length(max.name[n])));
  end;
  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;
 k : byte;
begin
  Sound(100);
  Delay(2000);
  Nosound;
  Rcrd := true;
  For k := 1 to 10 do
    if col.score[1] > max.score[k] then begin
        Recrd(k);
        rcrd := false;
      end;
  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;
    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');
  SetTextStyle(2,HorizDir,5);
  SetColor(LightGreen);
  OutTextXY(230,460,'Game PITON written in 1998 by Kesha Enikeew AKA Ray');
  SetColor(White);
  SetTextStyle(1,HorizDir,2);
  OutTextXY(20,400,'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
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
  SetCursorSize(16*256);
  ClrScr;
  TextBackGround(0);
  DrawTable;
  assign(Tbl,'hiscore.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[1] := 9;
      max.name[1] := '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[1] := 9;
  a[39,13].n := 1;
  GotoXY(40,13);
  repeat
    l := 0;
    if keypressed then
      begin
        c := readkey;
        if c = #0 then
          Begin
            w := ord(readkey);
            if (w = 77) or (w = 75) then
              begin
                l := 1;
                case w of

                 77 : 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[1],-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[1], -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[1], -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[1], -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;
                75 : 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[1], -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[1], -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[1], -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[1], -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
        else if c = #27 then Ext;
      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[1],-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[1], -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[1], -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[1], -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;
  Game;
end.