Pascalban szeretném a kukacos játékot megcsinálni valaki letudja írni a programkódot?

#1 vagyok

Egyébként pedig "pascal snake" keresésre (Google) elég sok megoldást lehet találni.

:-)

A játék ezen változatát nem modulárisan (eljárásokkal) csináltam meg, hogy "egyben" látszódjon a kód!

-------------------------------

Program Kukac;

Uses Crt;

Type

hely=Record

x,y:Byte;

End;

Var

i,o:Integer;

Ch:Char;

irany:Byte;

farok:Array[0..1793] of hely;

hossz:Word;

kellkaja,ok:Boolean;

kx,ky:Byte;

Begin

RaNDomize;CursorOFF;TextColor(BLACK);TextColor(WHITE);ClrScr;

GotoXY(38,1);Write('KUKAC');

GotoXY(2,25);Write('IRÁNYÍTÁS: kurzormozgató billentyűkkel');

GotoXY(65,25);Write('KILÉPɐS: ESCape');

TextBackGround(LIGHTBLUE);

for o:=2 to 24 do

for i:=2 to 79 do begin

GotoXY(i,o);Write(' ');

end;

farok[0].x:=39;farok[0].y:=12;irany:=RaNDom(4)+1;hossz:=1;

farok[hossz].x:=40;farok[hossz].y:=12;

kellkaja:=True;

Repeat

if kellkaja then begin

repeat

ok:=True;

kx:=RaNDom(78)+2;

ky:=RaNDom(23)+2;

for i:=0 to hossz do if (farok[i].x=kx) and (farok[i].y=ky) then ok:=False;

until ok;

TextColor(YELLOW);GotoXY(kx,ky);Write('*');

kellkaja:=False;

end else begin

TextColor(RaNDom(16));GotoXY(kx,ky);Write('*');

end;

TextColor(WHITE);GotoXY(farok[0].x,farok[0].y);Write('#');

TextColor(YELLOW);GotoXY(farok[1].x,farok[1].y);Write('@');

Delay(100);

if KeyPressed then begin

Ch:=ReadKey;

if Ch=#0 then begin

Ch:=ReadKey;

case Ch of

#72: irany:=1;

#80: irany:=2;

#77: irany:=3;

#75: irany:=4;

end;

end;

end;

if (farok[0].x=kx) and (farok[0].y=ky) then begin

Inc(hossz);

farok[hossz].x:=1;

farok[hossz].y:=1;

kellkaja:=True;

end;

GotoXY(farok[hossz].x,farok[hossz].y);Write(' ');

for i:=hossz downto 1 do farok[i]:=farok[i-1];

case irany of

1: if farok[0].y>2 then Dec(farok[0].y) else Ch:=Chr(27);

2: if farok[0].y<24 then Inc(farok[0].y) else Ch:=Chr(27);

3: if farok[0].x<79 then Inc(farok[0].x) else Ch:=Chr(27);

4: if farok[0].x>2 then Dec(farok[0].x) else Ch:=Chr(27);

end;

for i:=1 to hossz do

if (farok[0].x=farok[i].x) and (farok[0].y=farok[i].y) then Ch:=Chr(27);

Until Ch=Chr(27);

CursorON;

TextBackGround(BLACK);TextColor(WHITE);

ClrScr;

WriteLn('VÉGE A JÁTɐKNAK!');

WriteLn;

WriteLn('A farkad hossza: ',hossz,' mm :-)');

WriteLn;

WriteLn('Nyomd le a SPACE-t a folytatáshoz!');

repeat

Ch:=ReadKey;

until Ch=Chr(32);

End.

--------------------

Persze lehetne még optimalizálni, meg elhagyni egy pár felesleges részt, de remélem válaszoltam a kérdésre így is!

:-)