Question

СРОЧНО!! НА КОДЕ PASKALABC Нужно сделать лабиринт который можно пройти клавишами лабиринт среднего размера и цвет стенок должен быть фиолетовый и при прохождении лабиринта выскакивала надпись YOU WIN !

Answer 1

uses crt;

const

 Width = 10;

 Height = 10;

var

 Maze: array[1..Height, 1..Width] of char;

 PlayerX, PlayerY, ExitX, ExitY: integer;

 Key: char;

begin

 // Определяем размер лабиринта

 ExitX := Width - 2;

 ExitY := Height - 2;

 // Создаем лабиринт

 for var i := 1 to Height do

   for var j := 1 to Width do

     if (i = 1) or (j = 1) or (i = Height) or (j = Width) then

       Maze[i, j] := '#'

     else

       Maze[i, j] := ' ';

 // Устанавливаем начальные координаты игрока

 PlayerX := 1;

 PlayerY := 1;

 // Основной цикл программы

 repeat

   // Очищаем экран

   clrscr;

   // Отображаем лабиринт

   for var i := 1 to Height do

   begin

     for var j := 1 to Width do

     begin

       if (i = PlayerY) and (j = PlayerX) then

         write('P')

       else if (i = ExitY) and (j = ExitX) then

         write('E')

       else

         write(Maze[i, j]);

     end;

     writeln;

   end;

   // Просим игрока выбрать направление движения

   Key := readkey;

   // Обрабатываем клавиши для перемещения игрока

   case Key of

     #72: // Стрелка вверх

       begin

         if Maze[PlayerY - 1, PlayerX] = ' ' then

           PlayerY := PlayerY - 1;

       end;

     #80: // Стрелка вниз

       begin

         if Maze[PlayerY + 1, PlayerX] = ' ' then

           PlayerY := PlayerY + 1;

       end;

     #75: // Стрелка влево

       begin

         if Maze[PlayerY, PlayerX - 1] = ' ' then

           PlayerX := PlayerX - 1;

       end;

     #77: // Стрелка вправо

       begin

         if Maze[PlayerY, PlayerX + 1] = ' ' then

           PlayerX := PlayerX + 1;

       end;

   end;

 until (PlayerX = ExitX) and (PlayerY = ExitY);

 // Пользователь выиграл

 clrscr;

 writeln('YOU WIN!');

 readln;

end.

Answer 2

Вот пример кода на языке PascalABC, который создает лабиринт среднего размера, фиолетовыми стенами, и выводит сообщение "YOU WIN!" при успешном прохождении:

pascalCopy code
program MazeGame;

uses
  Crt;

const
  Width = 10;   // Ширина лабиринта
  Height = 10;  // Высота лабиринта

type
  MazeArray = array[1..Width, 1..Height] of char;

var
  Maze: MazeArray;
  PlayerX, PlayerY: Integer;

procedure InitializeMaze;
var
  x, y: Integer;
begin
  // Заполнение лабиринта
  for x := 1 to Width do
  begin
    for y := 1 to Height do
    begin
      if (x = 1) or (x = Width) or (y = 1) or (y = Height) then
        Maze[x, y] := '#'
      else
        Maze[x, y] := ' ';
    end;
  end;

  // Установка начальной позиции игрока
  PlayerX := 2;
  PlayerY := 2;

  // Установка цели в конечной точке лабиринта
  Maze[Width - 1, Height - 1] := 'X';
end;

procedure DrawMaze;
var
  x, y: Integer;
begin
  ClrScr;

  // Вывод лабиринта
  for y := 1 to Height do
  begin
    for x := 1 to Width do
    begin
      if Maze[x, y] = '#' then
        TextColor(Purple)
      else if (x = PlayerX) and (y = PlayerY) then
        TextColor(Yellow)
      else if Maze[x, y] = 'X' then
        TextColor(Green)
      else
        TextColor(White);

      Write(Maze[x, y]);
    end;
    Writeln;
  end;
end;

procedure HandleInput;
var
  Key: Char;
  NewPlayerX, NewPlayerY: Integer;
begin
  Key := ReadKey;
  NewPlayerX := PlayerX;
  NewPlayerY := PlayerY;

  case Key of
    #72: Dec(NewPlayerY);  // Вверх
    #80: Inc(NewPlayerY);  // Вниз
    #75: Dec(NewPlayerX);  // Влево
    #77: Inc(NewPlayerX);  // Вправо
  end;

  if (Maze[NewPlayerX, NewPlayerY] <> '#') and (NewPlayerX >= 1) and (NewPlayerX <= Width) and
    (NewPlayerY >= 1) and (NewPlayerY <= Height) then
  begin
    PlayerX := NewPlayerX;
    PlayerY := NewPlayerY;
  end;

  // Проверка условия победы
  if (PlayerX = Width - 1) and (PlayerY = Height - 1) then
  begin
    Maze[Width - 1, Height - 1] := ' ';
    Maze[PlayerX, PlayerY] := '@';  // Обозначение победы
    DrawMaze;
    WriteLn('YOU WIN!');
    Halt;  // Завершение