игра змейка.

[Deniska_777]

Привет всем !
пишу змейку.Возникла проблема.
не знаю как прописать что бы тело змеи(т.е окружности)
жвигались за первой окружностью (головой) .
и надо рекорды написать (что бы в текстовом файле лежали, ахотя можно и не обязательно, но главное что бы были).
заранее спс .
то что есть :

program igrashe;
uses crt, graph;
var
  num: integer;
  x, y, dx, eda, edax, eday: integer;
  gd, gm: integer;
  c, key: char;

procedure nachalo;
  procedure paint(x, y, cl: integer);
  begin
    setcolor(cl);

    floodfill(x, y, red);
    circle(x, y, 10);
    if (edax = x) and (eday = y) then eda := 0;
  end;
  procedure lol(var edax, eday, eda: integer);
  begin
    if eda = 0 then begin
      setcolor(blue);
      edax := random(64) * 10;
      eday := random(48) * 10;
      circle(edax, eday, 10);
      eda := 1;
    end;
  end;
begin
  randomize;
  gd := detect;
  initgraph(gd, gm, 'c:\tp\bgi');
  x := 315;
  y := 200;
  repeat
    lol(edax, eday, eda);
    paint(x, y, red);
    c := readkey;
    if c = chr(0) then begin
      paint(x, y, black);
      c := readkey;
      if c = chr(72) then y := y - 5; {vverx}
      if c = chr(75) then x := x - 5; {vlevo}
      if c = chr(77) then x := x + 5; {vpravo}
      if c = chr(80) then y := y + 5; {vniz}
      if x < 0 then x := 640;
      if x > 640 then x := 0;
      if y < 0 then y := 480;
      if y > 480 then y := 0;
      paint(x, y, green);
    end;

  until c = chr(27);
  closegraph;
end;

procedure helpro;
begin
  initgraph(gd, gm, 'c:\tp\bgi');
  SetBkColor(yellow);
  Setcolor(red);
  SETTEXTSTYLE(7, 0, 1);
  Outtextxy(20, 160, 'PRAVILO GAME:');
  outtextxy(20, 200, '1.VASHA CEL EAT KRYSHOCHKI,NE POPASTSYA POD OBSTREL');
  outtextxy(20, 220, '2.YPRAVLENIE STRELOCHKAMI S KLAVIATYRI');
  outtextxy(20, 240, '3.YDACHNOI GAME');
  readkey;
  closegraph;
end;

procedure conec;
begin
  textbackground(yellow);
  textcolor(white);
  clrscr;
  gotoxy(30, 10);
  writeln('Thanks for game!!!');
  readkey;
end;

function menu_my: integer;
const ss: array[1..3] of string = ('1.IGRAT', '2.Pomoch', '3.Vixod');
var
  m: integer;
  cf, cb: byte;
  x, y: integer;
  c: char;
  procedure out(s: string; x, y: integer; cf, cb: integer);
  begin
    textcolor(cf);
    textbackground(cb);
    gotoxy(x + 25, y);
    write(s);
  end;
begin
  cb := yellow;
  cf := black;
  x := 10;
  textcolor(cf);
  textbackground(cb);
  clrscr;
  m := 0;
  for y := 11 to 13 do begin
    gotoxy(x, y);
    out(ss[y - 10], x, y, cf, cb);
  end;
  y := 13;
  out(ss[y - 10], x, y, cb, cf);
  repeat
    c := readkey; { write (c,' ', ord(c)); readln;}
    if (c >= ' 1') and (c <= ' 3') then begin
      out(ss[y - 10], x, y, cb, cf);
      y := 10 + ord(c) - ord('0');
      out(ss[y - 10], x, y, cb, cf);
    end
    else if ord(c) = 0 then begin
      c := readkey;
      out(ss[y - 10], x, y, cf, cb);
      case ord(c) of
        72: begin
            if y = 11 then y := 13 else y := y - 1;
          end;
        77: ; { rigth}
        80: begin
            if y = 13 then y := 11 else y := y + 1;
          end;
        75: ; {left}
      end; {case}
      out(ss[y - 10], x, y, cb, cf);
    end;
    if ord(c) = 13 then m := y - 10;
  until (m > 0) and (m <= 3);
  menu_my := m;
end;
begin
  repeat
    num := menu_my;
    case num of
      1: nachalo;
      2: helpro;
      3: conec;
    end;
  until num = 3;
end.

________
Код нужно оформлять по правилам:
тегом [CODE]..[/СODE] (это кнопочка с решёточкой #)
Не забывайте об этом!
Модератор.

[Летучий_СкилетиК]

рабочий код

program zmeika;
uses crt,graph,loadbmp;
var
y,x:array[1..10000] of integer;
u,l,e,r,z,n,m,t,p,i,j,q,w,a,o:integer;
k,ch:char;
mm,b:boolean;
f:text;
punkt,gm,gd:integer;
procedure nastr;
begin
closegraph;
textcolor(red);
writeln('SPEED ->?');
readln(l);
assign(f,'config.ini');
reset(f);
readln(f,o);
close(f);
assign(f,'config.ini');
rewrite(f);
writeln(f,o);
writeln(f,l);
close(f);
initgraph(gd,gm,'');
loadbmpfile('menu.bmp',240,120);
u:=180;
punkt:=1;
end;
procedure dvij;
label 2,1,3;
begin
textcolor(yellow);
gotoxy(55,10);
writeln('SCORE-',W);
textcolor(yellow);
gotoxy(55,11);
writeln('RECORD-',o);
textcolor(yellow);
for a:=1 to 25 do begin
gotoxy(50,a);
write('#');
end;
for a:=1 to 50 do begin
gotoxy(a,25);
write('#');
end;
textcolor(red);
gotoxy(z,n);
write('$');
if m mod 8=0 then begin
textcolor(yellow);
gotoxy(e,r);
write('&');
end;
textcolor(green);
gotoxy(i,j);
write('*');
delay(l);
if (i=e) and (j=r) then begin m:=m+1; w:=w+50; end;
if (i=z) and (j=n) then begin
if m mod 7=0 then begin 1:e:=random(49); r:=random(24);
if (e=0) or (r=0) then goto 1;end;
w:=w+10; m:=m+1;2:z:=random(49); n:=random(24);
if (z=0) or (n=0) then goto 2;
end;
for t:=q-m to q do if (i=x[t]) and (i<>1) and (j=y[t]) and (j<>1) then mm:=true;
x[q]:=i;
y[q]:=j;
if (i=0) or (i=50) or (j=0) or (j=25) then mm:=true;
if q-m>0 then begin
textcolor(0);
gotoxy(x[q-m],y[q-m]);
write('*');
end;
if m>q then q:=1;
end;
begin
randomize;
gd:=installuserdriver ('svga256', nil); ;
gm:=2;
initgraph(gd,gm,'');
setbkcolor(black);
setfillstyle(solidfill,black);
loadbmpfile('menu.bmp',240,120);
u:=130;
p:=4;
repeat
setcolor(0);
bar(220,u,245,u+25);
bar(400,u,425,u+25);
if (k=chr(72)) and (u-50>=130) then begin p:=p+1;u:=u-50; end;
if (k=chr(80)) and (u+50<=280) then begin p:=p-1;u:=u+50; end;
loadbmpfile('018.bmp',220,u);
loadbmpfile('018.bmp',400,u);
k:=readkey;
if (p=1) and (k=chr(13)) then k:=chr(27);
if (p=3) and (k=chr(13)) then nastr;
if (p=4) and (k=chr(13)) then begin
closegraph;
clrscr;
i:=1; j:=1; q:=1; m:=1; w:=0;
z:=random(49);
n:=random(24);
textcolor(red);
gotoxy(z,n);
write('$');
assign(f,'config.ini');
reset(f);
read(f,o);
read(f,l);
close(f);
repeat
mm:=false;
b:=keypressed;
if b=true then begin
ch:=readkey;
end else begin
if (ch=chr(75)) then begin i:=i-1;q:=q+1; dvij; end;
if (ch=chr(77)) then begin i:=i+1;q:=q+1; dvij; end;
if (ch=chr(72)) then begin j:=j-1;q:=q+1; dvij; end;
if (ch=chr(80)) then begin j:=j+1;q:=q+1; dvij; end;
end;
until mm=true;
clrscr;
textcolor(red);
writeln('    YOU DEAD!!! YOU DEAD!!! YOU DEAD!!! YOU DEAD!!! YOU DEAD!!! YOU DEAD!!!');
if w>o then begin writeln('NEW RECORD');
assign(f,'config.ini');
rewrite(f);
writeln(f,w);
writeln(f,l);
close(f);
for i:=1 to 100 do begin x[i]:=0; y[i]:=0; end;
i:=1; j:=1; q:=1; m:=1; w:=0;
end;
initgraph(gd,gm,'');
loadbmpfile('menu.bmp',240,120);
u:=130;
punkt:=4;
ch:=readkey;
end;
until k=chr(27);
end

[Deniska_777]

он у меня не идёт.
loadbmp.tpu нету.

мне бы кто нибудь объяснил
потратьте кто нить мин 40 плз
я со школы пришёл и сижу.
не могу написать, точнее не знаю.

блин только наверное платно с репетитором прийдётся.
а так наверное никто не поможет
(с)бесплатный сыр только в мышиловке.

[Smitt&Wesson]

Сообщение от Deniska_777

блин только наверное платно с репетитором прийдётся.
а так наверное никто не поможет
(с)бесплатный сыр только в мышиловке.

Дело не в бесплатном сыре, а в объёме приведённого кода.
Локализуй участок кода где, по твоиму мнению, "не идёт" и тебе помогут.

[Летучий_СкилетиК]

он у меня не идёт.
loadbmp.tpu нету.

ну этот модуль не оьязателен (импортирует bmp-шные фотки в exe приложение), можете его отклбчить
ну и еще закоментируйте эту функцию:

loadbmpfile('menu.bmp',240,120);

[Deniska_777]

dвозник вопрос:
написал по другому.
след.(тело змеи как бы) ест шарик и когда он его съел то след затирается.
как сделать так, что бы когда голова следа(окр) залезала на свой след , то он пишет проиграл.
примерно есть иди.
if окр=окр тогда
врайт...

как то так,через иф что если окружнасти совпадают.

[Летучий_СкилетиК]

как сделать так, что бы когда голова следа(окр) залезала на свой след , то он пишет проигра

Пусть Скажем голова белого цвета след белого цвета, фон синий, как только фрагмент головы попадает на свой след, то цвет опр. пикселя меняется с цвета фона на цвет следа. Как только это произошло, то все конец игры.

[Deniska_777]

о круто.
теперь осталось подумать как это записать
тогда вообще всё кул будет.
через цикл надо будет ?
можно через процедуру написать?(ещё одну)

или лучше в той где рисуется след и голова.?

[Летучий_СкилетиК]

или лучше в той где рисуется след и голова.?

ну я так делал

[Deniska_777]

ок спс попробую
.