LeSeNkA
Умник
Может кому пригодится) Давно писал 
Пэкман (Обновлено. Дописал ИИ для противника)
карта (текстовый файл):
1 - стена
2 - игрок
3 - Противник
4 - монетки
И змейка:
Крестики - нолики
Автор: lesenka
Пэкман (Обновлено. Дописал ИИ для противника)
PHP:
uses GraphABC, Events, Timers;
const
r = 10; d = 20; { Радиус тела пэкмана 10, диаметр - (r*2 = 20)
Учитывая, что размер поля 540x540,
540/20= 27 - это кол-во клеток в которых пэкман может находится по оси x, и по оси y}
cr = 5;
type
KeysType=(Left, Right, Up, Down, empty);
var
px,py, ex, ey: integer; // координаты пэкмана, и противников
fl: array [1..27,1..27] of integer; // Матрица (двух-мерный массив), будет содержать бонусы/стены/врагов/позицию игрока и т.д
// x y
{
1 - стена
2 - игрок
3 - противник
4 - монетка
5 - бонус
1 - left
2 - up
3 - right
4 - down
}
xy: array [1..27] of integer; // Создадим массив, который будет содержать координат клеточек.
tm: integer; // таймер
scor, i: integer;
key, oldkey, enemykey, oldenemykey: KeysType;
press, start, eleft, eright, eup, edown: boolean;
score: integer; // счет
scr: string[50];
Procedure wrtField; // Вычисляем координаты каждой клеточки.
var
i:integer;
begin
xy[1]:=r;
for i:=1 to 26 do xy[i+1]:=xy[i]+d;
end;
Procedure DrawWall(x,y: integer);
begin
SetBrushColor(clBlue);
SetPenColor(clBlack);
Rectangle(x-10,y-10,x+r,y+r);
end;
Procedure DrawCoin(x, y: integer);
begin
SetBrushColor(clWhite);
SetPenColor(clWhite);
Circle(x, y, cr);
end;
Procedure DrawPac(x,y: integer);
begin
SetPenColor(clBlack);
SetBrushColor(clYellow);
Circle(x,y,r);
end;
Procedure HidePac(x,y: integer);
begin
SetPenColor(clBlack);
SetBrushColor(clBlack);
Circle(x,y,r);
end;
Procedure DrawEnemy(x,y: integer);
begin
SetPenColor(clBlack);
SetBrushColor(clRed);
Circle(x,y,r);
end;
Procedure HideEnemy(x,y: integer);
begin
SetPenColor(clBlack);
SetBrushColor(clBlack);
Circle(x,y,r);
if (fl[ex,ey] = 4) then DrawCoin(x,y)
else
if (fl[ex, ey] = 3) then
begin
fl[ex, ey]:= 4;
DrawCoin(x,y);
end;
end;
Procedure DrawMap;
var
i,j: integer;
begin
for i:=1 to 27 do // читаем x
begin
for j:=1 to 27 do // читаем y
begin
case fl[i,j] of
0: continue; // Ничего
1: DrawWall(xy[i],xy[j]); // стена
2:
begin
DrawPac(xy[i],xy[j]); // Игрок
px:=i; py:=j;
end;
3:
begin
DrawEnemy(xy[i], xy[j]); // противник
ex:=i; ey:=j;
end;
4: begin
DrawCoin(xy[i],xy[j]); // Монетки
inc(scor);
end;
5: continue; // бонусы
end;
end;
end;
inc(scor);
end;
procedure LoadMap;
var
t:text;
sym,str:integer;
a:char;
begin
assign(t, 'D:\Программирование\PascalABC\Программы\map.txt');
reset(t);
for str:=1 to 27 do
begin
for sym:=1 to 27 do
begin
read(t,a);
fl[sym,str]:=strToInt(a);
end;
readln(t,a);
end;
close(t);
end;
Procedure KeyDown(k: integer);
begin
case k of
vk_left:
begin
press:=true;
oldkey:=key;
key:= left;
end;
vk_right:
begin
press:=true;
oldkey:=key;
key:= right;
end;
vk_up:
begin
press:=true;
oldkey:=key;
key:= up;
end;
vk_down:
begin
press:=true;
oldkey:=key;
key:= down;
end;
end;
end;
Procedure AI; //Искуственный интелект противника
var a: integer;
begin
if start = true then
begin
if (fl[ex-1, ey] <> 1) then eleft:=true;
if (fl[ex+1, ey] <> 1) then eright:=true;
if (fl[ex, ey-1] <> 1) then eup:=true;
if (fl[ex, ey+1] <> 1) then edown:=true;
a:=random(4)+1;
case a of
1:
begin // Left
if eleft = true then
begin
HideEnemy(xy[ex], xy[ey]);
Dec(ex);
DrawEnemy(xy[ex], xy[ey]);
EnemyKey:= Left;
start:=false;
SetWindowCaption('Left');
end
else AI;
end;
2:
begin // Up
if eup = true then
begin
HideEnemy(xy[ex], xy[ey]);
Dec(ey);
DrawEnemy(xy[ex], xy[ey]);
EnemyKey:= Up;
start:=false;
SetWindowCaption('up');
end
else AI;
end;
3:
begin // right
if eright = true then
begin
HideEnemy(xy[ex], xy[ey]);
inc(ex);
DrawEnemy(xy[ex], xy[ey]);
EnemyKey:= Right;
start:=false;
SetWindowCaption('right');
end
else AI;
end;
4:
begin // down
if edown = true then
begin
HideEnemy(xy[ex],xy[ey]);
inc(ey);
DrawEnemy(xy[ex], xy[ey]);
EnemyKey:= Down;
start:=false;
SetWindowCaption('down');
end
else AI;
end;
end;
end
else
begin
case enemykey of
left:
begin
if (fl[ex-1, ey] <> 1) then // Если слева нет стены
begin
if (fl[ex,ey-1] <> 1) or (fl[ex, ey+1] <> 1) then // Если в верху, или в низу нету стены..
begin
if (fl[ex, ey-1] <> 1) then
begin
inc(i);
eUp:= true;
end;
if (fl[ex, ey+1] <> 1) then
begin
inc(i);
eDown:= true;
end;
case i of
1: // Если найден только 1 возможный путь..
begin
a:=random(2)+1;
case a of
1: // 1 - продолжаем двигаться по старой траектории
begin
HideEnemy(xy[ex], xy[ey]);
Dec(ex);
DrawEnemy(xy[ex], xy[ey]);
end;
2: // 2 - Меняем траекторию
begin
if (eUp = true) then
begin
HideEnemy(xy[ex], xy[ey]);
Dec(ey);
DrawEnemy(xy[ex], xy[ey]);
EnemyKey:= Up;
end else
begin
HideEnemy(xy[ex], xy[ey]);
Inc(ey);
DrawEnemy(xy[ex], xy[ey]);
EnemyKey:= Down;
end;
end;
end;
end;
2: // Если найдено 2 возможных пути
begin
a:=random(3)+1;
case a of
1: // 1 - Продолжаем двигаться по старой траектории
begin
HideEnemy(xy[ex], xy[ey]);
Dec(ex);
DrawEnemy(xy[ex], xy[ey]);
end;
2: // 2 - Меняем траекторию, двигаемся вверх
begin
HideEnemy(xy[ex], xy[ey]);
Dec(ey);
DrawEnemy(xy[ex], xy[ey]);
EnemyKey:= Up;
end;
3: // 3 - Меняем траекторию, двигаемя вниз
begin
HideEnemy(xy[ex], xy[ey]);
Inc(ey);
DrawEnemy(xy[ex], xy[ey]);
EnemyKey:= Down;
end;
end;
end;
end;
end
else begin // Если в низу и в верху есть стена, то передвигаем противника далее
HideEnemy(xy[ex], xy[ey]);
Dec(ex);
DrawEnemy(xy[ex], xy[ey]);
end;
end
else
begin // Если слева стоит стена
a:= random(2)+1;
{
1 = Верх
2 = Низ
}
case a of
1: // UP
begin
if (EnemyKey = Up) then AI
else
begin
if (fl[ex, ey-1] <> 1) then
begin // Если сверху нет стены, то передвигаем противника
HideEnemy(xy[ex], xy[ey]);
Dec(ey);
DrawEnemy(xy[ex], xy[ey]);
EnemyKey:= Up;
end else AI;
end;
end;
2: // Down
begin
if (EnemyKey = Down) then AI
else
begin
if (fl[ex, ey+1] <> 1) then
begin // Если снизу нет стены, то передвигаем противника
HideEnemy(xy[ex], xy[ey]);
Inc(ey);
DrawEnemy(xy[ex], xy[ey]);
EnemyKey:= Down;
end else AI;
end;
end;
end;
end;
end;
right:
begin
if (fl[ex+1, ey] <> 1) then // Если справа нет стены
begin
if (fl[ex,ey-1] <> 1) or (fl[ex, ey+1] <> 1) then // Если в верху, или в низу нету стены..
begin
if (fl[ex, ey-1] <> 1) then
begin
inc(i);
eUp:= true;
end;
if (fl[ex, ey+1] <> 1) then
begin
inc(i);
eDown:= true;
end;
case i of
1: // Если найден только 1 возможный путь..
begin
a:=random(2)+1;
case a of
1: // 1 - продолжаем двигаться по старой траектории
begin
HideEnemy(xy[ex], xy[ey]);
Inc(ex);
DrawEnemy(xy[ex], xy[ey]);
end;
2: // 2 - Меняем траекторию
begin
if (eUp = true) then
begin
HideEnemy(xy[ex], xy[ey]);
Dec(ey);
DrawEnemy(xy[ex], xy[ey]);
EnemyKey:= Up;
end else
begin
HideEnemy(xy[ex], xy[ey]);
Inc(ey);
DrawEnemy(xy[ex], xy[ey]);
EnemyKey:= Down;
end;
end;
end;
end;
2: // Если найдено 2 возможных пути
begin
a:=random(3)+1;
case a of
1: // 1 - Продолжаем двигаться по старой траектории
begin
HideEnemy(xy[ex], xy[ey]);
Inc(ex);
DrawEnemy(xy[ex], xy[ey]);
end;
2: // 2 - Меняем траекторию, двигаемся вверх
begin
HideEnemy(xy[ex], xy[ey]);
Dec(ey);
DrawEnemy(xy[ex], xy[ey]);
EnemyKey:= Up;
end;
3: // 3 - Меняем траекторию, двигаемя вниз
begin
HideEnemy(xy[ex], xy[ey]);
Inc(ey);
DrawEnemy(xy[ex], xy[ey]);
EnemyKey:= Down;
end;
end;
end;
end;
end
else begin // Если в низу и в верху есть стена, то передвигаем противника далее
HideEnemy(xy[ex], xy[ey]);
Inc(ex);
DrawEnemy(xy[ex], xy[ey]);
end;
end
else
begin // Если справа стоит стена
a:=random(2)+1;
{
1 = Up
2 = Down
}
case a of
1: // UP
begin
if (EnemyKey = Up) then AI
else
begin
if (fl[ex, ey-1] <> 1) then
begin // Если сверху нет стены, то передвигаем противника
HideEnemy(xy[ex], xy[ey]);
Dec(ey);
DrawEnemy(xy[ex], xy[ey]);
EnemyKey:= Up;
end else AI;
end;
end;
2: // Down
begin
if (EnemyKey = Down) then AI
else
begin
if (fl[ex, ey+1] <> 1) then
begin // Если снизу нет стены, то передвигаем противника
HideEnemy(xy[ex], xy[ey]);
Inc(ey);
DrawEnemy(xy[ex], xy[ey]);
EnemyKey:= Down;
end else AI;
end;
end;
end;
end;
end;
up:
begin
if(fl[ex, ey-1] <> 1) then // Если сверху нет стены
begin
if (fl[ex+1, ey] <> 1) or (fl[ex-1, ey] <> 1) then // Если слева и справа ничего нет..
begin
if (fl[ex-1, ey] <> 1) then
begin
inc(i);
eLeft:= true;
end;
if (fl[ex+1, ey] <> 1) then
begin
inc(i);
eRight:= true;
end;
case i of
1: // Если найден только 1 возможный путь..
begin
a:=random(2)+1;
case a of
1: // 1 - продолжаем двигаться по старой траектории
begin
HideEnemy(xy[ex], xy[ey]);
Dec(ey);
DrawEnemy(xy[ex], xy[ey]);
end;
2: // 2 - Меняем траекторию
begin
if (eLeft = true) then
begin
HideEnemy(xy[ex], xy[ey]);
Dec(ex);
DrawEnemy(xy[ex], xy[ey]);
EnemyKey:= Left;
end else
begin
HideEnemy(xy[ex], xy[ey]);
Inc(ex);
DrawEnemy(xy[ex], xy[ey]);
EnemyKey:= Right;
end;
end;
end;
end;
2: // Если найдено 2 возможных пути
begin
a:=random(3)+1;
case a of
1: // 1 - Продолжаем двигаться по старой траектории
begin
HideEnemy(xy[ex], xy[ey]);
Dec(ey);
DrawEnemy(xy[ex], xy[ey]);
end;
2: // 2 - Меняем траекторию, двигаемся влево
begin
HideEnemy(xy[ex], xy[ey]);
Dec(ex);
DrawEnemy(xy[ex], xy[ey]);
EnemyKey:= Left;
end;
3: // 3 - Меняем траекторию, двигаемся вправо
begin
HideEnemy(xy[ex], xy[ey]);
Inc(ex);
DrawEnemy(xy[ex], xy[ey]);
EnemyKey:= Right;
end;
end;
end;
end;
end
else
begin
HideEnemy(xy[ex], xy[ey]);
Dec(ey);
DrawEnemy(xy[ex], xy[ey]);
end;
end
else
begin // Если сверху стоит стена
a:=random(2)+1;
{
1 = Left
2 = Right
}
case a of
1: // Left
begin
if (EnemyKey = Left) then AI
else
begin
if (fl[ex-1, ey] <> 1) then
begin // Если слева нет стены, то передвигаем противника
HideEnemy(xy[ex], xy[ey]);
Dec(ex);
DrawEnemy(xy[ex], xy[ey]);
EnemyKey:= Left;
end else AI;
end;
end;
2: // Right
begin
if (EnemyKey = Right) then AI
else
begin
if (fl[ex+1, ey] <> 1) then
begin
HideEnemy(xy[ex], xy[ey]);
Inc(ex);
DrawEnemy(xy[ex], xy[ey]);
EnemyKey:= Right;
end else AI;
end;
end;
end;
end;
end;
down:
begin
if(fl[ex, ey+1] <> 1) then // Если снизу нет стены
begin
if (fl[ex+1, ey] <> 1) or (fl[ex-1, ey] <> 1) then // Если слева и справа ничего нет..
begin
if (fl[ex-1, ey] <> 1) then
begin
inc(i);
eLeft:= true;
end;
if (fl[ex+1, ey] <> 1) then
begin
inc(i);
eRight:= true;
end;
case i of
1: // Если найден только 1 возможный путь..
begin
a:=random(2)+1;
case a of
1: // 1 - продолжаем двигаться по старой траектории
begin
HideEnemy(xy[ex], xy[ey]);
Inc(ey);
DrawEnemy(xy[ex], xy[ey]);
end;
2: // 2 - Меняем траекторию
begin
if (eLeft = true) then
begin
HideEnemy(xy[ex], xy[ey]);
Dec(ex);
DrawEnemy(xy[ex], xy[ey]);
EnemyKey:= Left;
end else
begin
HideEnemy(xy[ex], xy[ey]);
Inc(ex);
DrawEnemy(xy[ex], xy[ey]);
EnemyKey:= Right;
end;
end;
end;
end;
2: // Если найдено 2 возможных пути
begin
a:=random(3)+1;
case a of
1: // 1 - Продолжаем двигаться по старой траектории
begin
HideEnemy(xy[ex], xy[ey]);
Inc(ey);
DrawEnemy(xy[ex], xy[ey]);
end;
2: // 2 - Меняем траекторию, двигаемся влево
begin
HideEnemy(xy[ex], xy[ey]);
Dec(ex);
DrawEnemy(xy[ex], xy[ey]);
EnemyKey:= Left;
end;
3: // 3 - Меняем траекторию, двигаемся вправо
begin
HideEnemy(xy[ex], xy[ey]);
Inc(ex);
DrawEnemy(xy[ex], xy[ey]);
EnemyKey:= Right;
end;
end;
end;
end;
end
else
begin
HideEnemy(xy[ex], xy[ey]);
Inc(ey);
DrawEnemy(xy[ex], xy[ey]);
end;
end
else
begin // Если сверху стоит стена
a:=random(2)+1;
//1 = Left
//2 = Right
case a of
1: // Left
begin
if (EnemyKey = Left) then AI
else
begin
if (fl[ex-1, ey] <> 1) then
begin // Если слева нет стены, то передвигаем противника
HideEnemy(xy[ex], xy[ey]);
Dec(ex);
DrawEnemy(xy[ex], xy[ey]);
EnemyKey:= Left;
end else AI;
end;
end;
2: // Right
begin
if (EnemyKey = Right) then AI
else
begin
if (fl[ex+1, ey] <> 1) then
begin
HideEnemy(xy[ex], xy[ey]);
Inc(ex);
DrawEnemy(xy[ex], xy[ey]);
EnemyKey:= Right;
end else AI;
end;
end;
end;
end;
end;
end;
end;
if (px = ex) and (py = ey) then
begin
SetBrushColor(clRed);
Circle(xy[px], xy[py], r);
setFontSize(20);
TextOut(200,250, 'You Lose!');
stopTimer(tm);
end;
end;
Procedure checkkey;
begin
case key of
left:
begin // если нажата левая кнопка
if px = 1 then key:= empty
else begin
if (fl[px-1,py] <> 1) then // если слева от игрока нету стены..
begin
HidePac(xy[px], xy[py]);
Dec(px); // перезаписываем координаты пэкмана
if fl[px,py] = 4 then inc(score); // Если слева от игрока есть монетка, то увеличиваем счетчик монет на 1
fl[px,py]:= 2; // перемещаем пэкмана в памяти таблицы
DrawPac(xy[px], xy[py]); // перерисовываем пэкмана
end;
end;
end;
Right:
begin // правая
if px = 27 then key:= empty
else begin
if (fl[px+1,py] <> 1) then
begin
HidePac(xy[px],xy[py]);
Inc(px);
if(fl[px,py] = 4) then inc(score);
fl[px, py]:= 2;
DrawPac(xy[px], xy[py]);
end;
end;
end;
Up:
begin // верхняя
if py = 1 then key:= empty
else begin
if (fl[px,py-1] <> 1) then
begin
HidePac(xy[px],xy[py]);
Dec(py);
if(fl[px,py] = 4) then inc(score);
fl[px, py]:= 2;
DrawPac(xy[px], xy[py]);
end;
end;
end;
Down:
begin // нижняя
if py = 27 then key:= empty
else begin
if (fl[px,py+1] <> 1) then
begin
HidePac(xy[px],xy[py]);
Inc(py);
if(fl[px,py] = 4) then inc(score);
fl[px, py]:= 2;
DrawPac(xy[px], xy[py]);
end;
end;
end;
end;
end;
Procedure TimerProc;
begin
OnKeyDown:=KeyDown;
SetWindowCaption(scr);
AI;
case key of
left:
begin // если нажата левая кнопка
if px = 1 then key:= empty
else begin
if (fl[px-1,py] <> 1) then // если слева от игрока нету стены..
begin
HidePac(xy[px], xy[py]);
Dec(px); // перезаписываем координаты пэкмана
if fl[px,py] = 4 then inc(score); // Если слева от игрока есть монетка, то увеличиваем счетчик монет на 1
fl[px,py]:= 2; // перемещаем пэкмана в памяти таблицы
DrawPac(xy[px], xy[py]); // перерисовываем пэкмана
end
else if(press=true) then
begin
key:=oldkey;
checkkey;
end;
end;
end;
Right:
begin // правая
if px = 27 then key:= empty
else begin
if (fl[px+1,py] <> 1) then
begin
HidePac(xy[px],xy[py]);
Inc(px);
if(fl[px,py] = 4) then inc(score);
fl[px, py]:= 2;
DrawPac(xy[px], xy[py]);
end
else if(press=true) then
begin
key:=oldkey;
checkkey;
end;
end;
end;
Up:
begin // верхняя
if py = 1 then key:= empty
else begin
if (fl[px,py-1] <> 1) then
begin
HidePac(xy[px],xy[py]);
Dec(py);
if(fl[px,py] = 4) then inc(score);
fl[px, py]:= 2;
DrawPac(xy[px], xy[py]);
end
else if(press=true) then
begin
key:=oldkey;
checkkey;
end;
end;
end;
Down:
begin // нижняя
if py = 27 then key:= empty
else begin
if (fl[px,py+1] <> 1) then
begin
HidePac(xy[px],xy[py]);
Inc(py);
if(fl[px,py] = 4) then inc(score);
fl[px, py]:= 2;
DrawPac(xy[px], xy[py]);
end
else if(press=true) then
begin
key:=oldkey;
checkkey;
end;
end;
end;
end;
scr:= 'Score: ' + IntTostr(score);
if score = scor then
begin
SetBrushColor(clLime);
SetFontSize(20);
TextOut(200,250, 'You WIN!');
stopTimer(tm);
end;
if (px = ex) and (py = ey) then
begin
SetBrushColor(clRed);
Circle(xy[px], xy[py], r);
setFontSize(20);
TextOut(200,250, 'You Lose!');
stopTimer(tm);
end;
press:=false;
eup:=false;
edown:=false;
eleft:=false;
eright:=false;
i:= 0;
end;
begin
clearWindow(clBlack);
SetWindowSize(540, 540);
CenterWindow;
wrtField;
LoadMap;
DrawMap;
key:= Right;
oldkey:=empty;
enemykey:=empty;
oldenemykey:=empty;
start:=true;
tm:= CreateTimer(130, TimerProc);
end.карта (текстовый файл):
111111111111111111111111111
144444443444414444444444441
141111411111414111114111141
141111411111414111114111141
144444444444444444444444441
141111414111111111414111141
144444414444414444414444441
111111411111414111114111111
000001414444444444414100000
111111414111111111414111111
244444444100000001444444444
111111414111111111414111111
000001414444444444414100000
111111414111111111414111111
144444444444414444444444441
141111411111414111114111141
144441444444444444414444441
111141414111111111414111111
144444414444414444414444441
141111111111414111111111141
144444414444444444414444441
141111414111111111414111141
144444444444444444444444441
141111411111414111114111141
141111411111414111114111141
144444444444414444444444441
111111111111111111111111111
144444443444414444444444441
141111411111414111114111141
141111411111414111114111141
144444444444444444444444441
141111414111111111414111141
144444414444414444414444441
111111411111414111114111111
000001414444444444414100000
111111414111111111414111111
244444444100000001444444444
111111414111111111414111111
000001414444444444414100000
111111414111111111414111111
144444444444414444444444441
141111411111414111114111141
144441444444444444414444441
111141414111111111414111111
144444414444414444414444441
141111111111414111111111141
144444414444444444414444441
141111414111111111414111141
144444444444444444444444441
141111411111414111114111141
141111411111414111114111141
144444444444414444444444441
111111111111111111111111111
1 - стена
2 - игрок
3 - Противник
4 - монетки
И змейка:
PHP:
uses
GraphABC, Events, Timers ,ABCobjects;
type
KeyPressed = (Up, Down, Left, Right, None);
const
r = 10; {радиус круга}
var
i, ii, q,api{кол-во съеденных яблок},apX{X яблока},apY{Y яблока},x{х головы},y{y головы}: integer;
{массивы координат поля}
xx, yy: array[0..25] of integer;
{массивы координат змейки}
tX, tY: array [0..300] of integer;
g,h,o: PictureABC;
onKey: KeyPressed;
{Вычислим для каждого поля координаты рисования}
procedure Field;
var i: integer;
begin
for i:= 1 to 25 do
begin
xx[i]:= ii;
yy[i]:= ii;
ii:=ii+20;
end;
end;
{Процедура рисования красного круга с координатами x,y и радиусом r
Рисуем голову змейки}
procedure Draw;
begin
SetBrushColor(clRed);
SetPenColor(clRed);
circle(x, y, r);
end;
{Процедура скрытия конца хвоста}
procedure HideEndHvost;
begin
SetPenColor(clWhite);
SetBrushColor(clWhite);
Circle(Tx[api], Ty[api], r);
end;
{Процедура рисования начала хвоста}
procedure DrawBegHvost;
begin
{Проверим, что хвост есть и тогда рисуем}
if api > 1 then
begin
SetPenColor(clYellow);
SetBrushColor(clYellow);
Circle(Tx[1], Ty[1], r);
end;
end;
{Процедура сдвига координат хвоста за ход}
procedure hvost;
var
i: Integer;
begin
for i := api downto 1 do
begin
tX[i] := tX[i - 1];
tY[i] := tY[i - 1];
end;
tX[0] := x;
tY[0] := y;
end;
{Рисование яблока по случайным координатам apX, apY}
Procedure Apple;
begin
SetBrushColor(clGreen);
SetPenColor(clGreen);
apX:= xx[Random(25)];
apY:= yy[Random(25)];
Circle(apX,apY,r);
end;
{Процедура нажатии клавиши изменить статус onKey}
procedure KeyDown(key: integer);
begin
case key of
vk_Left: onKey := Left;
vk_Right: onKey := Right;
vk_Up: onKey := Up;
vk_Down: onKey := Down;
end;
end;
{Рисование поля, обработчик таймера}
procedure DrawField;
var
oldx, oldy: Integer; {старые координаты x и y}
begin
oldx := x;
oldy := y;
{Вычисляем новые координаты}
if onKey = Up then
y := y - 20;
if OnKey = Down then
y := y + 20;
if OnKey = Right then
x := x + 20;
if OnKey = Left then
x := x - 20;
{Проверим, что координаты не выходят за допустимые}
if x < 0 then x := WindowWidth - 20;
if y < 0 then y := WindowHeight - 20;
if x > WindowWidth then x := 20;
if y > WindowHeight then y := 20;
{Если координаты изменились, значит ход был}
if (oldx <> x) or (oldy <> y) then
begin
Draw; {рисуем голову змейки}
{Проверим на совпадение с яблоком}
if (apX = x) and (apY = y) then
begin
Inc(api); {+1 к длине змейки}
Hvost; {Процедура сдвига координат хвоста за ход}
DrawBegHvost; {Процедура рисования начала хвоста}
Apple; {рисуем яблоко}
end
else
begin
Hvost; {Процедура сдвига координат хвоста за ход}
DrawBegHvost; {Процедура рисования начала хвоста}
HideEndHvost; {Процедура скрытия конца хвоста}
end;
end;
end;
begin
SetWindowCaption('Snake');
SetWindowSize(500,500); {размер поля рисования 25 клеток размером в диаметр}
onKeyDown := KeyDown; {обработчик нажатия клавиши}
OnKey := None;
Field; {Вычиcлим для каждого поля координаты рисования}
api := 1; {первоначальная длина змейки}
{первоначальные координаты змейки случайно}
x := xx[Random(25)];
y := yy[Random(25)];
tX[0] := x; tY[0] := y;
{рисуем голову змейки}
Draw;
{рисуем яблоко}
Apple;
{Создаем таймер и назначаем обработчик таймера процедуру DrawField}
CreateTimer(200, DrawField);
end.Крестики - нолики
PHP:
uses GraphABC, Events, Utils;
var
step,eend: boolean; // true - крестики, false - нолики // будет содержать игрока, который будет делать ход
field: array [1..3,1..3] of byte; // 2 - крестик, 1 - нолик
Procedure DrawField;
begin
Rectangle(0,0,50,50);
Rectangle(50,0,100,50);
Rectangle(100,0,150,50);
Rectangle(0,50,50,100);
Rectangle(50,50,100,100);
Rectangle(100,50,150,100);
Rectangle(0,100,50,150);
Rectangle(50,100,100,150);
Rectangle(100,100,150,150);
end;
Procedure DrawKrst11;
begin
Line(0,0,50,50);
Line(0,50,50,0);
end;
Procedure DrawKrst12;
begin
Line(50,50,100,0);
Line(50,0,100,50);
end;
Procedure DrawKrst13;
begin
Line(100,0,150,50);
Line(150,0,100,50);
end;
Procedure DrawKrst21;
begin
Line(0,100,50,50);
Line(0,50,50,100);
end;
Procedure DrawKrst22;
begin
Line(50,50,100,100);
Line(50,100,100,50);
end;
Procedure DrawKrst23;
begin
Line(100,50,150,100);
Line(150,50,100,100);
end;
Procedure DrawKrst31;
begin
Line(0,100,50,150);
Line(0,150,50,100);
end;
Procedure DrawKrst32;
begin
Line(50,100,100,150);
Line(50,150,100,100);
end;
Procedure DrawKrst33;
begin
Line(100,100,150,150);
Line(150,100,100,150);
end;
Procedure DrawCirc11;
begin
Circle(25,25,15);
end;
Procedure DrawCirc12;
begin
Circle(75,25,15);
end;
Procedure DrawCirc13;
begin
Circle(125,25,15);
end;
Procedure DrawCirc21;
begin
Circle(25,75,15);
end;
Procedure DrawCirc22;
begin
Circle(75,75,15);
end;
Procedure DrawCirc23;
begin
Circle(125,75,15);
end;
Procedure DrawCirc31;
begin
Circle(25,125,15);
end;
Procedure DrawCirc32;
begin
Circle(75,125,15);
end;
Procedure DrawCirc33;
begin
Circle(125,125,15);
end;
Procedure findWin;
var i: integer;
begin
for i:=1 to 2 do
begin
if (field[1,1]=i) and (field[1,2]=i) and (field[1,3]=i) then
begin
eend:=true;
end;
if (field[2,1]=i) and (field[2,2]=i) and (field[2,3]=i) then
begin
eend:=true;
end;
if (field[3,1]=i) and (field[3,2]=i) and (field[3,3]=i) then
begin
eend:=true;
end;
if (field[1,1]=i) and (field[2,1]=i) and (field[3,1]=i) then
begin
eend:=true;
end;
if (field[1,2]=i) and (field[2,2]=i) and (field[3,2]=i) then
begin
eend:=true;
end;
if (field[1,3]=i) and (field[2,3]=i) and (field[3,3]=i) then
begin
eend:=true;
end;
if (field[1,1]=i) and (field[2,2]=i) and (field[3,3]=i) then
begin
eend:=true;
end;
if (field[3,1]=i) and (field[2,2]=i) and (field[1,3]=i) then
begin
eend:=true;
end;
end;
end;
Procedure MouseDown(x,y,mb: integer);
begin
if (eend=true) then
begin
ShowMessage('Игра закончена');
end
else
begin
if (x>0) and (x<50) and (y>0) and (y<50) then
begin
if (field[1,1] = 0) then
begin
if (step = true) then
begin
DrawKrst11;
field[1,1]:=2;
step:= false;
end
else
begin
DrawCirc11;
field[1,1]:=1;
step:=true;
end;
end;
end;
if (x>50) and (x<100) and (y>0) and (y<50) then
begin
if (field[1,2] = 0) then
begin
if (step = true) then
begin
DrawKrst12;
field[1,2]:=2;
step:= false;
end
else
begin
DrawCirc12;
field[1,2]:=1;
step:=true;
end;
end;
end;
if (x>100) and (x<150) and (y>0) and (y<50) then
begin
if (field[1,3] = 0) then
begin
if (step = true) then
begin
DrawKrst13;
field[1,3]:=2;
step:= false;
end
else
begin
DrawCirc13;
field[1,3]:=1;
step:=true;
end;
end;
end;
if (x>0) and (x<50) and (y>50) and (y<100) then
begin
if (field[2,1] = 0) then
begin
if (step = true) then
begin
DrawKrst21;
field[2,1]:=2;
step:= false;
end
else
begin
DrawCirc21;
field[2,1]:=1;
step:=true;
end;
end;
end;
if (x>50) and (x<100) and (y>50) and (y<100) then
begin
if (field[2,2] = 0) then
begin
if (step = true) then
begin
DrawKrst22;
field[2,2]:=2;
step:= false;
end
else
begin
DrawCirc22;
field[2,2]:=1;
step:=true;
end;
end;
end;
if (x>100) and (x<150) and (y>50) and (y<100) then
begin
if (field[2,3] = 0) then
begin
if (step = true) then
begin
DrawKrst23;
field[2,3]:=2;
step:= false;
end
else
begin
DrawCirc23;
field[2,3]:=1;
step:=true;
end;
end;
end;
if (x>0) and (x<50) and (y>100) and (y<150) then
begin
if (field[3,1] = 0) then
begin
if (step = true) then
begin
DrawKrst31;
field[3,1]:=2;
step:= false;
end
else
begin
DrawCirc31;
field[3,1]:=1;
step:=true;
end;
end;
end;
if (x>50) and (x<100) and (y>100) and (y<150) then
begin
if (field[3,2] = 0) then
begin
if (step = true) then
begin
DrawKrst32;
field[3,2]:=2;
step:= false;
end
else
begin
DrawCirc32;
field[3,2]:=1;
step:=true;
end;
end;
end;
if (x>100) and (x<150) and (y>100) and (y<150) then
begin
if (field[3,3] = 0) then
begin
if (step = true) then
begin
DrawKrst33;
field[3,3]:=2;
step:= false;
end
else
begin
DrawCirc33;
field[3,3]:=1;
step:=true;
end;
end;
end;
end;
findWin;
end;
begin
SetWindowCaption('Tic-tac toe');
SetWindowSize(150,150);
step:= true;
DrawField;
OnMouseDown:=MouseDown;
end.Автор: lesenka
Последнее редактирование: