|
ru.algorithms
- RU.ALGORITHMS ----------------------------------------------------------------
From : Vasily Shmelev 2:5020/400 06 Oct 2001 18:55:22
To : Alexey Savyuk
Subject : Re: помогите решить задачку при помощи TP7.0
--------------------------------------------------------------------------------
Hello! Alexey Savyuk wrote in message:
AS> допустим это я понял, но теперь как бы этот алгоритм превратить
AS> в программу на турбо паскале 7.0 ????
Hа:
-------- полетел chk.pas ---------------------------
program Checkers;
uses CRT;
{Описание доски: массив 8x8
0 - пустая клетка
1 - белая шашка
2 - черная шашка
3 - это мы можем съесть}
var board : array [1..8,1..8] of byte;
black_x, black_y : byte; {координаты черной шашки}
{Hачальная инициализация}
procedure init;
var c, c2 : integer;
f : text;
w_x, w_y : byte;
begin
{Заполняем массив нулями}
for c := 1 to 8 do
for c2 := 1 to 8 do
board [c, c2] := 0;
{Заполняем массив из файла board.dat
Формат: 1-ая строка - координаты черной шашки
2-ая строка - число белых шашек
далее - координаты белых шашек.
Координаты: пара [X,Y] разделенная пробелом}
assign (f, 'board.dat');
reset (f);
readln (f, black_x, black_y);
board [black_x, black_y] := 2;
readln (f, c);
for c2 := 1 to c do
begin
readln (f, w_x, w_y);
board [w_x, w_y] := 1;
end;
close (f);
end;
{Рисует доску}
procedure DrawBoard;
var c, c2 : integer;
begin
for c := 1 to 8 do
begin
for c2 := 1 to 8 do
begin
if board [c2, c] = 0 then textcolor (8);
if board [c2, c] = 1 then textcolor (7+8);
if board [c2, c] = 2 then textcolor (1);
if board [c2, c] = 3 then textcolor (4+8);
if board [c2, c] = 0 then write ('0':2);
if board [c2, c] = 1 then write ('Б':2);
if board [c2, c] = 2 then write ('Ч':2);
if board [c2, c] = 3 then write ('X':2);
end;
writeln;
end;
end;
{Проверка на "съедаемость"}
procedure Check (x, y : byte);
var x1, y1 : integer;
begin
{Переставляем черную шашку,
нужно для корректного отображения доски}
board [black_x, black_y] := 0;
black_x := x; black_y := y;
board [black_x, black_y] := 2;
{Рисуем доску}
DrawBoard;
writeln;
readkey;
{ 0 0 0
0 Ч 0 <-- проверяем точку, отмеченную "X"
0 0 X}
x1 := x + 1;
y1 := y + 1;
{При проверке учитываем, что доска 8x8, за нее залезать нельзя!
Если что-то можно съесть, едим и перепрыгиваем. После прыжка
проверяем клетку, в которую прыгнули, если она на доске}
if (x1+1 <= 8) and (y1+1 <= 8) and (board [x1, y1] = 1) then
begin
board [x1, y1] := 3;
if (x+2 <= 8) and (y+2 <= 8) then Check (x+2, y+2);
end;
{ 0 0 0
0 Ч 0 <-- проверяем точку, отмеченную "X"
X 0 0}
x1 := x - 1;
y1 := y + 1;
if (x1-1 >= 0) and (y1+1 <= 8) and (board [x1, y1] = 1) then
begin
board [x1, y1] := 3;
if (x-2 >= 0) and (y+2 <= 8) then Check (x-2, y+2);
end;
{ X 0 0
0 Ч 0 <-- проверяем точку, отмеченную "X"
0 0 0}
x1 := x - 1;
y1 := y - 1;
if (x1-1 >= 0) and (y1-1 >= 0) and (board [x1, y1] = 1) then
begin
board [x1, y1] := 3;
if (x-2 >= 0) and (y-2 >= 0) then Check (x-2, y-2);
end;
{ 0 0 X
0 Ч 0 <-- проверяем точку, отмеченную "X"
0 0 0}
x1 := x + 1;
y1 := y - 1;
if (x1+1 <= 8) and (y1-1 >= 0) and (board [x1, y1] = 1) then
begin
board [x1, y1] := 3;
if (x+2 <= 8) and (y-2 >= 0) then Check (x+2, y-2);
end;
end;
begin
init;
clrscr;
Check (black_x, black_y); {Запуск рекурсии}
textcolor (7);
writeln ('*** Обработка завершена ***');
readkey;
end.
-------- пролетел chk.pas --------------------------
И тестовый пример:
-------- полетел board.dat--------------------------
3 5
7
2 2
4 4
6 6
6 4
8 8
4 8
4 2
-------- пролетел board.dat-------------------------
С уважением,
Василий
--- ifmail v.2.15dev5
* Origin: MTU-Intel ISP (2:5020/400)
Вернуться к списку тем, сортированных по: возрастание даты уменьшение даты тема автор
|
