Кто поможет переписать программу с графикой PascalABC на FreePascal? Или подскажите почему игра плохо работает - Free Pascal
Формулировка задачи:
Вот код на PascalABC. Помогите переделать под Free или Turbo Pascal. И почему программа на ABC не до конца работает?
program z4;
uses graphABC;
const n=9; kw=4; kbl=4;m=50;
var i,p:byte; key:char; t:array[1..11] of byte;
procedure clrBar(i:byte);
begin
SetPenColor(clwhite);SetPenWidth(3);
Circle(25+i*m,m+25,20) ;
FloodFill(25+i*m,m+25,clwhite);
end;
procedure drB(i:byte);
begin
SetPenColor(clBlack);SetPenWidth(1);
Circle(25+i*m,m+25,20) ;
FloodFill(25+i*m,m+25,clBlack);
end;
procedure drW(i:byte);
begin
SetPenColor(clBlack);SetPenWidth(1);
Circle(25+i*m,m+25,20) ;
end;
procedure drSt(i:byte);
begin
SetPenColor(clBlack);SetPenWidth(1);
line(25+i*m,110,25+i*m,140);
line(25+i*m,110,25+i*m+10,120);
line(25+i*m,110,25+i*m-10,120);
end;
procedure delSt(i:byte);
begin
SetPenColor(clWhite);SetPenWidth(3);
line(25+i*m,110,25+i*m,140);
line(25+i*m,110,25+i*m+10,120);
line(25+i*m,110,25+i*m-10,120);
end;
begin
//сетка
for i:=1 to n do
Rectangle(m*i,m,m*i+m,2*m);
//нач поз черных
for I:=1 to kw do
begin
Circle(25+i*m,m+25,20) ;
FloodFill(25+i*m,m+25,clBlack);
t[i]:=2;
end;
t[6]:=0;
// нач поз белых
for I:=1+5 to kw+5 do
begin
Circle(25+i*m,m+25,20) ;
t[i]:=1;
end;
drSt(5); p:=5; key:=#13;
writeln('Выбрать кружек - l/r');
writeln('Сделать ход - пробел');
writeln('Выход - E');
repeat
read(key);
// key:=readkey;
case key of
'l': if p>1 then
begin
delSt(p); p:=p-1; drSt(p);
end;
'r': if p<11 then
begin
delSt(p); p:=p+1; drSt(p);
end;
' ':begin
if t[p]=2 then //если на черном
begin
if t[p+1]=0 then //рядом свободно
begin
clrBar(p);
drB(p+1);
t[p]:=0; t[p+1]:=2;
end;
if (t[p+1]>0)and (t[p+2]=0) then //рядом свободно
begin
clrBar(p);
drB(p+2);
t[p]:=0; t[p+2]:=2;
end;
end;
if t[p]=1 then // если на белом
begin
if t[p-1]=0 then //рядом свободно
begin
clrBar(p);
drW(p-1);
t[p]:=0; t[p-1]:=1;
end;
if (t[p-1]>0)and (t[p-2]=0) then //рядом свободно
begin
clrBar(p);
drW(p-2);
t[p]:=0; t[p-2]:=1;
end;
end;
end;
end;//case
until key='e';
end.Решение задачи: «Кто поможет переписать программу с графикой PascalABC на FreePascal? Или подскажите почему игра плохо работает»
textual
Листинг программы
uses WinGraph,WinCrt;
const n=8;
var
s,m,gd,gm,k:integer;
a:array[0..8] of longword=(1,1,1,1,0,2,2,2,2);//это инициализация массива, если другое n, то и массив должен быть другим 1- синий, 2 - красный, 0 - пустая клетка
c:char;
finish:boolean;
procedure DrawPole;
var
x,y,i:integer;
function pc(t:integer):longword;
begin
case t of
1:pc:=Blue;
2:pc:=Red;
0:pc:=Black;
end;
end;
begin
ClearViewPort;
x:=getmaxx div (n+1);
y:=getmaxy div 2;
SetLineStyle(SolidLn,NormWidth,1);
for i:=0 to n do begin
SetFillStyle(SolidFill,pc(a[i]));
SetColor(pc(a[i]));
Circle(x*i+x div 2,y,x div 3);
FloodFill(x*i+x div 2,y,pc(a[i]));
SetColor(White);
Rectangle(x*i,y-y div 5,x*(i+1),y+y div 5);
end;
if m>-1 then begin
SetColor(Yellow);
SetLineStyle(DottedLn,QuadWidth,4);
Rectangle(x*m,y-y div 5,x*(m+1),y+y div 5);
end;
SetColor(Green);
SetLineStyle(DashedLn,QuadWidth,4);
Rectangle(x*s,y-y div 5,x*(s+1),y+y div 5);
finish:=true;
for i:=0 to n div 2-1 do
if a[i]<>2 then finish:=false;
for i:=n downto n div 2+1 do
if a[i]<>1 then finish:=false;
end;
begin
s:=4;m:=-1;k:=0;
initgraph(gd,gm,'');
repeat
DrawPole;
k:=k+1;
c:=ReadKey;
case c of
#0: case ReadKey of
#75:if s>0 then s:=s-1;
#77:if s<n then s:=s+1;
end;
#32,#13:begin
if m=-1 then begin
if a[s]>0 then m:=s;
end else
if (abs(s-m)<3) and (a[s]=0) then begin
a[s]:=a[m];
a[m]:=0;
m:=-1;
end else m:=-1;
end;
end;
until (c=#27) or (finish);
CloseGraph;
if finish then writeln('Done in ',k,' moves') else writeln('Program terminated');
end.
Объяснение кода листинга программы
- Программа написана на языке программирования Free Pascal.
- Она использует библиотеку WinGraph для работы с графикой.
- В начале кода определены константы и переменные:
- n = 8 (размер поля)
- s, m, gd, gm, k = 4, -1, 0, 0, 0 (переменные для управления игрой)
- a = (1,1,1,1,0,2,2,2,2) (массив для представления игрового поля)
- c = '' (для чтения ключей клавиатуры)
- finish = false (для контроля окончания игры)
- В процедуре DrawPole рисуется игровое поле:
- Задаются координаты для осей x и y
- Рисуются линии сетки
- Рисуются круги на клетках с числами 1 и 2
- Заполняются прямоугольники вокруг клеток с числами 1 и 2
- Рисуется прямоугольник вокруг текущей клетки
- В основной части программы выполняется цикл, в котором:
- Рисуется поле
- Увеличивается счетчик k
- Считывается ключ с клавиатуры
- Если нажата клавиша со стрелкой, меняется значение переменной s или m
- Если нажаты клавиши пробел или enter, происходит обмен значениями между текущей и соседней клетками
- Если игра завершена, выводится сообщение о количестве ходов
- Код может быть адаптирован для игры
Змейкаили другой игры, использующей сетку. - Возможно, игра плохо работает из-за ошибок в коде, например, из-за неправильного управления памятью или из-за неправильной обработки ввода пользователя.