Змейка на паскале. Хвост

Uses crt;
 
var
  x, y, vx, vy, xap, yap, speed, i, score, go: integer;
  sim, snake,sim2: char;
  loose, begintext, wait: boolean;
 
procedure zone;
var
  i: integer;
begin
  textcolor(lightcyan);
  for i := 1 To 80 Do
    write('*');
  gotoxy(1, 2);
  for i := 1 To 24 Do
    writeln('*');
  gotoxy(2, 25);
  for i := 1 To 79 Do
    write('*');
  for i := 2 To 24 Do
  begin
    gotoxy(80, i);
    write('*');
  end;
  textcolor(white);
end;
 
 
procedure notplay;
var
  sim: char;
begin
  while keypressed Do
  begin
    sim := readkey;
    case sim Of 
      'd','a','w','s','в','ф','ц','ы','D','A','W','S','В','Ф','Ц','Ы':
        begin
          vx := 0;
          vy := -1;
        end;
    End;
  end;
end;
 
begin
  speed := 120;
  snake := '0';
  wait := true;
  SetWindowSize(80, 25);
  TextBackGround(black);
  clrscr;
  begintext := true;
  while begintext = true Do
  begin
    textColor(red);
    writeln('WARNING, NOT EXPAND THE WINDOW ,FOR CONVENIENCE!');
    textcolor(green);
    writeln('To control use "wasd"');
    textcolor(white);
    delay(2000);
    notplay;
    TextBackGround(green);
    begintext := false;
  end;
  clrscr;
  zone;
  x := 40;
  y := 25 Div 2;
  vy := -1;
  xap := random(79) + 2;
  yap := random(23) + 2;
  gotoxy(xap, yap);
  textcolor(red);
  write('+');
  textcolor(white);
  gotoxy(1, 1);
  score := 0;
  textcolor(yellow);
  write('Score: ', score, ' ');
  textcolor(white);
  while (x >= 1) Or (x <= 80) Or (y >= 1) Or (y <= 24) Do
  begin
    gotoxy(x, y);
    textcolor(black);
    write(snake);
    textcolor(white);
    
    while wait = true do 
    begin
      textcolor(red);
      gotoxy(39, 25);
      write(333);
      delay(1000);
      gotoxy(39, 25);
      write(222);
      delay(1000);
      gotoxy(39, 25);
      write(111);
      delay(1000);
      gotoxy(39, 25);
      write('GO!');
      delay(500);
      gotoxy(39, 25);
      textcolor(lightcyan);
      write('***');
      textcolor(white);
      notplay;
      wait := false;
    end;
    
    delay(speed);
    if keypressed Then
    begin
      sim := readkey;
      if ((sim2='d') or (sim2='D') or (sim2='в') or (sim2='В')) and ((sim='a') or (sim='A') or (sim='ф') or (sim='Ф')) then sim:='d';
      if ((sim2='a') or (sim2='A') or (sim2='ф') or (sim2='Ф')) and ((sim='d') or (sim='D') or (sim='в') or (sim='В')) then sim:='a';
      if ((sim2='w') or (sim2='W') or (sim2='ц') or (sim2='Ц')) and ((sim='s') or (sim='S') or (sim='ы') or (sim='Ы')) then sim:='w';
      if ((sim2='s') or (sim2='S') or (sim2='ы') or (sim2='Ы')) and ((sim='w') or (sim='W') or (sim='ц') or (sim='Ц')) then sim:='s';
      sim2:=sim;
      case sim Of 
        'd','D','в','В':
          begin
            vx := 1;
            vy := 0
          end;
          
        'a','A','ф','Ф':
          begin
            vx := -1;
            vy := 0
          end;
        'w','W','ц','Ц':
          begin
            vy := -1;
            vx := 0
          end;
        's','S','ы','Ы':
          begin
            vy := 1;
            vx := 0
          end;
      End;
    end;
    gotoxy(x, y);
    write(' ');
    inc(x, vx);
    inc(y, vy);
    if ((x < 2) Or (x > 79) Or (y < 2) Or (y > 24)) Then begin
      loose := true;
      
      while loose = true Do
      begin
        if (x >= 71) then begin
          gotoxy(x - 9, y);
          textcolor(red);
          Write('You Lose!');   
          textcolor(white); end else begin
          textcolor(red);
          write('You Lose!');
          textcolor(white);
        end;
        delay(5000);
        notplay;
        wait := true;
        loose := false;
      end;
      clrscr;
      zone;
      gotoxy(1, 1);
      score := 0;
      textcolor(yellow);
      write('Score: ', score, ' ');
      textcolor(white);
      if (vx = -1) And (vy = 0) Then
      begin
        vx := 0;
        vy := -1
      end;
      if (vy = 1) And (vx = 0) Then
      begin
        vx := 0;
        vy := -1
      end;
      if (vy = -1) And (vx = 0) Then
      begin
        vx := 0;
        vy := -1
      end;
      if (vx = 1) And (vy = 0) Then
      begin
        vx := 0;
        vy := -1;
      end;
      x := 40;
      y := 25 Div 2;
      gotoxy(x, y);
      textcolor(black);
      writeln(snake);
      textcolor(white);
      xap := random(79) + 2;
      yap := random(23) + 2;
      gotoxy(xap, yap);
      textcolor(red);
      write('+');
      textcolor(white);
      while wait = true do 
      begin
        textcolor(red);
        gotoxy(39, 25);
        write(222);
        delay(1000);
        gotoxy(39, 25);
        write(111);
        delay(1000);
        gotoxy(39, 25);
        write('GO!');
        delay(500);
        gotoxy(39, 25);
        textcolor(lightcyan);
        write('***');
        textcolor(white);
        notplay;
        wait := false;
      end;
    end;
    
    if (x = xap) And (y = yap) Then
    begin
      xap := random(79) + 2;
      yap := random(23) + 2;
      gotoxy(xap, yap);
      textcolor(red);
      write('+');
      textcolor(white);
      gotoxy(1, 1);
      score := score + 1;
      textcolor(yellow);
      write('Score: ', score, ' ');
      textcolor(white);
    end;
  end;
end.

uses crt;
 
const
  maxLength = 1000;
  wndWidth = 80;
  wndHeight = 25;
  
type
  Point = record
    X, Y : Integer;
    
    constructor (X_, Y_ : Integer);
    begin
      X := X_; Y := Y_;
    end;
  end;
 
procedure InitWindow;
begin
  HideCursor;
  TextBackGround(green);
  ClrScr;
  TextColor(LightCyan);
  for var x := 1 to wndWidth do
    begin
      GoToXY(x, 1); Write('*');
      GoToXY(x, wndHeight); Write('*');
    end;
  for var y := 2 to 24 do
    begin
      GoToXY(1, y); Write('*');
      GoToXY(80, y); Write('*');
    end;
  GoToXY(1,1);
end;
 
var
  Snake : array of Point;
  Head, Tail : Integer;
  dir : Integer;
  speed : Integer;
  Steps : Integer;
 
procedure NewSnake;
begin
  (Head, Tail, dir, speed) := (1, 0, 0, 120);
  (Snake[0], Snake[1]) := (New Point(wndWidth div 2, wndHeight div 2 + 1), New Point(wndWidth div 2, wndHeight div 2));
end;
 
procedure ShowSnake;
begin
  TextColor(Black);
  var n := Head;
  GoToXY(Snake[n].X, Snake[n].Y); Write('@');
  while n <> Tail do
    begin
      if n = 0 then n := maxLength; n -= 1;
      GoToXY(Snake[n].X, Snake[n].Y); Write(n = Tail ? ' ' : 'o');
    end;
end;
 
procedure whaitKeyPressed;
begin
  SetWindowTitle('Нажмите любую клавишу для старта');
  ReadKey;
  SetWindowTitle('Движение стрелками');
end;
 
var
  Live := True;
 
procedure NextStep;
begin
  Steps += 1;
  var H := Snake[Head];
  case dir of
    0 : H.Y -= 1;
    1 : H.X += 1;
    2 : H.Y += 1;
    3 : H.X -= 1;
  end;
  Head += 1; if Head = maxLength then Head := 0;
  Snake[Head] := H;
  if Steps mod 20 > 0 then
    begin
      Tail += 1; if Tail = maxLength then Tail := 0;
    end;
  if (H.X = 1) or (H.X = wndWidth) or (H.Y = 1) or (H.Y = wndHeight) then
    Live := False
  else
    begin
      var n := Head;
      while n <> Tail do
        begin
          if n = 0 then n := maxLength; n -= 1;
          if (n <> Tail) and (H.X = Snake[n].X) and (H.Y = Snake[n].Y) then
            Live := False;
        end;
    end;
end;
 
procedure onKeyPressed(c : Char);
begin
  case c of
    #37 : if dir <> 1 then dir := 3;
    #38 : if dir <> 2 then dir := 0;
    #39 : if dir <> 3 then dir := 1;
    #40 : if dir <> 0 then dir := 2;
  else
    SetWindowTitle(Ord(c).ToString);
  end;
end;
 
begin
  SetLength(Snake, maxLength);
  NewSnake;
  InitWindow;
  ShowSnake;
  whaitKeyPressed;
  repeat
    NextStep;
    ShowSnake;
    Sleep(speed);
    if KeyPressed then
      begin
        var c := ReadKey;
        if c = #0 then
          onKeyPressed(ReadKey);
      end;
  until Not Live;
  SetWindowTitle('Вы проиграли');
  GoToXY(1,1);
end.

uses crt;
 
const
  maxLength = 1000;
  wndWidth = 80;
  wndHeight = 25;
  maxRabbits = (wndWidth * wndHeight) div 6;
  newRabbitByStep = 1;
  
type
  Point = record
    X, Y : Integer;
    
    constructor (X_, Y_ : Integer);
    begin
      X := X_; Y := Y_;
    end;
  end;
 
procedure InitWindow;
begin
  HideCursor;
  TextBackGround(green);
  ClrScr;
  TextColor(LightCyan);
  for var x := 1 to wndWidth do
    begin
      GoToXY(x, 1); Write('*');
      GoToXY(x, wndHeight); Write('*');
    end;
  for var y := 2 to 24 do
    begin
      GoToXY(1, y); Write('*');
      GoToXY(80, y); Write('*');
    end;
  GoToXY(1,1);
end;
 
var
  Snake : array of Point;
  Head, Tail : Integer;
  dir : Integer;
  speed : Integer;
  Steps : Integer;
  Rabbits : array of Point;
  countRabbits : Integer;
 
procedure AddRabbit;
begin
  if countRabbits = maxRabbits then Exit;
  
  var Ok := False;
  var R := New Point;
  repeat
    R.X := Random(2, wndWidth - 2);
    R.Y := Random(2, wndHeight - 2);
    Ok := True;
    for var n := 0 to countRabbits-1 do
      if (R.X = Rabbits[n].X) and (R.Y = Rabbits[n].Y) then
        Ok := False;
    if Ok then
      begin
        var n := Head;
        while Ok and (n <> Tail) do
          begin
            if (R.X = Snake[n].X) and (R.Y = Snake[n].Y) then
              Ok := False;
            if n = 0 then n := maxLength; n -= 1;
          end;
      end;
  until Ok;
  Rabbits[countRabbits] := R; countRabbits += 1;
end;
 
procedure NewSnake;
begin
  (Head, Tail, dir, speed) := (1, 0, 0, 120);
  (Snake[0], Snake[1]) := (New Point(wndWidth div 2, wndHeight div 2 + 1), New Point(wndWidth div 2, wndHeight div 2));
  countRabbits := 0; AddRabbit;
end;
 
procedure ShowSnake;
begin
  TextColor(Black);
  var n := Head;
  GoToXY(Snake[n].X, Snake[n].Y); Write('@');
  while n <> Tail do
    begin
      if n = 0 then n := maxLength; n -= 1;
      GoToXY(Snake[n].X, Snake[n].Y); Write(n = Tail ? ' ' : 'o');
    end;
end;
 
procedure ShowRabbits;
begin
  TextColor(White);
  for var i := 0 to countRabbits - 1 do
    begin
      GoToXY(Rabbits[i].X, Rabbits[i].Y); Write('R');
    end;
end;
 
procedure whaitKeyPressed;
begin
  SetWindowTitle('Нажмите любую клавишу для старта');
  ReadKey;
  SetWindowTitle('Движение стрелками');
end;
 
var
  Live := True;
 
procedure NextStep;
begin
  Steps += 1;
  var H := Snake[Head];
  case dir of
    0 : H.Y -= 1;
    1 : H.X += 1;
    2 : H.Y += 1;
    3 : H.X -= 1;
  end;
  Head += 1; if Head = maxLength then Head := 0;
  Snake[Head] := H;
  if (H.X = 1) or (H.X = wndWidth) or (H.Y = 1) or (H.Y = wndHeight) then
    Live := False
  else
    begin
      var n := Head;
      while n <> Tail do
        begin
          if n = 0 then n := maxLength; n -= 1;
          if (n <> Tail) and (H.X = Snake[n].X) and (H.Y = Snake[n].Y) then
            Live := False;
        end;
    end;
  var n := 0;
  while n < countRabbits do
    begin
      if (H.X = Rabbits[n].X) and (H.Y = Rabbits[n].Y) then
        begin
          countRabbits -= 1;
          repeat
            Rabbits[n] := Rabbits[n + 1];
            n += 1;
          until n >= countRabbits;
          Exit;
        end;
      n += 1;
    end;
    
  Tail += 1; if Tail = maxLength then Tail := 0;
  if Steps mod newRabbitByStep = 0 then
    AddRabbit;
end;
 
procedure onKeyPressed(c : Char);
begin
  case c of
    #37 : if dir <> 1 then dir := 3;
    #38 : if dir <> 2 then dir := 0;
    #39 : if dir <> 3 then dir := 1;
    #40 : if dir <> 0 then dir := 2;
  else
    SetWindowTitle(Ord(c).ToString);
  end;
end;
 
begin
  SetLength(Snake, maxLength);
  SetLength(Rabbits, maxRabbits);
  NewSnake;
  InitWindow;
  ShowSnake;
  whaitKeyPressed;
  repeat
    NextStep;
    ShowSnake;
    ShowRabbits;
    Sleep(speed);
    if KeyPressed then
      begin
        var c := ReadKey;
        if c = #0 then
          onKeyPressed(ReadKey);
      end;
  until Not Live;
  SetWindowTitle('Вы проиграли');
  GoToXY(1,1);
end.

uses graphWPF;
 
begin
  window.SetSize(20 * 30 - 10, 20 * 30 - 10);
  Window.IsFixedSize := True; 
  var NewGame: boolean; 
  var q := new queue<integer>;//очередь для нажатых клавиш
  OnKeyDown := procedure (k: key) →
  case k of
    key.Left: q.Enqueue(1);
    Key.Right: q.Enqueue(2);
    Key.Up: q.Enqueue(8);
    Key.Down: q.Enqueue(9);
    Key.Escape: halt();
    Key.Enter: NewGame := true; //по нажатию Enter - новая игра
  end;
  repeat
    NewGame := false;
    Window.Clear;
    var (i, j) := (-1, 0); //координаты головы
    var n := 5; //длина змейки
    var p := 2; //направление следующего шага для головы
    var a := |(-1, 0)| * n; //создаем массив индексов для звеньев змейки
    var (bi, bj) := Random2(2, 19); //координаты еды
    FillRectangle(bi * 30, bj * 30, 30, 30, Colors.DarkCyan); //вывод еды на экран
    repeat
      var newp := if q.Any then q.Dequeue else p; //перебираем очередь
      while q.Any and (abs(newp - p) < 2) do newp := q.Dequeue; //всё не нужное выбрасываем
      if abs(newp - p) > 2 then p := newp; //если новое направление "поворот", то записываем его в p
      case p of //меняем индекс для головы змейки в  торону p
        1: i -= 1; //влево
        2: i += 1;//вправо
        8: j -= 1;//вверх
        9: j += 1;//вниз
      end;
      if i = -1 then i := 19 else if i = 20 then i := 0; //перескок от стенки до стенки в другой конец экрана
      if j = -1 then j := 19 else if j = 20 then j := 0;
      if a.Contains((i, j)) and (a[n - 1] <> (i, j)) then //проверка на столкновение головы с телом змейки
      begin FillRectangle(i * 30, j * 30, 30, 30, Colors.Magenta); break; end;
      if (i = bi) and (j = bj) then //поели? удлиняем змейку на три клетки
      begin
        a := a + |a[n - 1]| * 3; //массив змейки увеличить на 3 элемента
        n += 3; 
        (bi, bj) := Random2(0, 19); //новые координаты еды, которые..
        while a.Contains((bi, bj)) do (bi, bj) := Random2(0, 19); //..не совпадут с телом змейки
        FillRectangle(bi * 30, bj * 30, 30, 30, Colors.DarkCyan);//вывод еды на экран
      end;
      var pXBOCT: integer; //направление в котором нужно затирать клетку хвоста (след после хвоста)
      if abs(a[n - 2].Item1 - a[n - 3].Item1 + (a[n - 2].Item2 - a[n - 3].Item2) * 2 + 3) < 6 then//не перескчили в другой край экрана?
        pXBOCT := (a[n - 2].Item1 - a[n - 3].Item1 + (a[n - 2].Item2 - a[n - 3].Item2) * 2 + 3); 
      for var f := n - 1 downto 1 do a[f] := a[f - 1]; a[0] := (i, j); //каждая клетка змейки продвинулась на шаг впреред
      for var f := 0 to 29 do //вывод головы и затирание хвоста
      begin
        case p of //рисуем плавный шаг головы в новой клетке
          1: FillRectangle(29 - f + i * 30, j * 30, 1, 30, Colors.Red);
          2: FillRectangle(i * 30 + f, j * 30, 1, 30, Colors.Red);
          8: FillRectangle(i * 30, 29 - f + j * 30, 30, 1, Colors.Red);
          9: FillRectangle(i * 30, j * 30 + f, 30, 1, Colors.Red);
        end;
        case pXBOCT of //затираем плавно последнюю клетку хвоста
          4: FillRectangle(29 - f + a[n - 1].Item1 * 30, a[n - 1].Item2 * 30, 1, 30, Colors.White); //лево
          2: FillRectangle(a[n - 1].Item1 * 30 + f, a[n - 1].Item2 * 30, 1, 30, Colors.White); //право
          5: FillRectangle(a[n - 1].Item1 * 30, 29 - f + a[n - 1].Item2 * 30, 30, 1, Colors.White);//вверх
          1: FillRectangle(a[n - 1].Item1 * 30, a[n - 1].Item2 * 30 + f, 30, 1, Colors.White); //вниз
        end;      
        sleep(7);//скорость змейки
      end
    until NewGame;
    repeat sleep(100) until NewGame; //ждем нажатия Enter или Escape
  until false;
end.

lock q do begin //блокируем q от второго потока OnKeyDown во избежание получения мусора 
 var newp := if q.Any then q.Dequeue else p; //перебираем очередь
 while q.Any and (abs(newp - p) < 2) do newp := q.Dequeue; //всё не нужное выбрасываем
 if abs(newp - p) > 2 then p := newp; //если новое направление "поворот", то записываем его в p
end;

n += 3; 
SetLength(a,n);
for var f := 1 to 3 do a[n-f] := a[n - 4];