Кто поможет переписать программу с графикой 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, происходит обмен значениями между текущей и соседней клетками
- Если игра завершена, выводится сообщение о количестве ходов
- Код может быть адаптирован для игры
Змейка
или другой игры, использующей сетку. - Возможно, игра плохо работает из-за ошибок в коде, например, из-за неправильного управления памятью или из-за неправильной обработки ввода пользователя.
ИИ поможет Вам:
- решить любую задачу по программированию
- объяснить код
- расставить комментарии в коде
- и т.д