yılan
 

uses crt,dos;

var
yilanx:array[1..3500] of integer;
yilany:array[1..3500] of integer;
doy:array[1..6] of string;
dpu:array[1..6] of integer;
duv,yemsay,c,n,i,j,yemx,yemy:byte;
R:REGISTERS;
kytsay,puan,hiz:integer;
tus,tus1:char;
ses,d,k,yem,yanma,a:boolean;
d1:text;
eyoy:string[20]; eypuan:integer; isim:string[20];
mesaj:string;

function sor:boolean;
var
tus:char;
begin
write(mesaj);
repeat tus:=readkey; until tus in ['E','e','H','h'];
if tus in ['e','E'] then sor:=true
else sor:=false
end;

procedure cerceve(x1,y1,x2,y2:byte);
var
i:byte;
begin
gotoxy(x1,y1); write(#201);
for i:=x1+1 to x2-1 do write(#205);
write(#187);
for i:=y1+1 to y2-1 do
begin
gotoxy(x1,i); write(#186);
gotoxy(x2,i); write(#186);
end;
gotoxy(x1,y2); write(#200);
for i:=x1+1 to x2-1 do write(#205);
write(#188);
end;

procedure renk(x,y:byte);
begin
textcolor(x); textbackground(y);
end;



procedure duv2;
begin
gotoxy(22,13); write(#201); {sol ?st}
gotoxy(57,13); write(#187); {sag ?st}
gotoxy(22,35); write(#200); {sol alt}
for i:=23 to 56 do
begin
gotoxy(i,13); write(#205); {?st x}
gotoxy(i,35); write(#205); {alt x}
end;
write(#188); {sag alt}
for i:=14 to 21 do
begin
gotoxy(22,i); write(#186);
gotoxy(57,i); write(#186);
gotoxy(22,i+13); write(#186);
gotoxy(57,i+13); write(#186);
end;
end;

procedure duv3;
begin
j:=0;
repeat
j:=j+10;
for i:=9 to 38 do
begin
gotoxy(j+6,i);
write(#186);
end;
until j=60;
end;

procedure duv4;
begin
gotoxy(1,1); write(#201);
j:=0;
for i:=2 to 79 do
begin
gotoxy(i,1); write(#205);
gotoxy(i,49); write(#205);
j:=j+1;
if j in [1..21,60..79] then
begin
gotoxy(i,18); write(#205);
gotoxy(i,33); write(#205);
end;
end;
write(#187);
for i:=2 to 49 do
if i in [2..17,34..48] then
begin
gotoxy(1,i); write(#186);
gotoxy(80,i); write(#186);
end;
write(#200);
gotoxy(80,1); write(#187);
gotoxy(80,49); write(#188);
gotoxy(1,18); write(#200);
gotoxy(80,18); write(#188);
gotoxy(1,33); write(#201);
end;



procedure skortablosu;
var
skoy:string[20];
satir,skpu:integer;
begin
R.CH:=31;
R.CL:=0;
R.Ah:=1;
R.Al:=0;
INTR($10,R);

kytsay:=0; satir:=0; clrscr;
assign(d1,'skor.dat'); reset(d1);
while not eof(d1) do
begin
kytsay:=kytsay+1;
readln(d1); readln(d1);
end; close(d1); reset(d1);
cerceve(20,20,48,23+kytsay);
gotoxy(28,20); write('SKOR TABLOSU');
gotoxy(21,21); write('Isim'); gotoxy(42,21); write('Puan');
gotoxy(21,22); write('----'); gotoxy(42,22); write('----');
while not eof(d1) do
begin
satir:=satir+1;
readln(d1,skoy); readln(d1,skpu);
gotoxy(21,22+satir); write(satir,'-',skoy);
gotoxy(42,22+satir); write(skpu);
end;
readln;
end;



procedure skor(ppuan:integer);
var
durum:boolean;
sayac,tutpu:integer;
tutoy,adi:string[20];
doy:array[1..6] of string;
dpu:array[1..6] of integer;
begin
assign(d1,'skor.dat');
reset(d1);
sayac:=0; kytsay:=0; durum:=false;
while not eof(d1) do
begin
kytsay:=kytsay+1;
readln(d1); readln(d1);
end;
if kytsay<6 then kytsay:=kytsay+1;
close(d1); reset(d1);
if not(ppuan=0) then
begin
for i:=1 to kytsay do
begin
sayac:=sayac+1; tutpu:=0;
if (kytsay>1) then
readln(d1,tutoy,tutpu);
if (ppuan>tutpu) and (durum=false) then
begin
clrscr; gotoxy(20,20); write('Skor tablosuna girmeye hak kazandiniz.');
gotoxy(33,21); write('Isminiz:'); readln(adi);
doy[sayac]:=adi; dpu[sayac]:=ppuan;
if (kytsay>1) and (not(kytsay=sayac)) then
begin
sayac:=sayac+1;
doy[sayac]:=tutoy; dpu[sayac]:=tutpu;
end;
durum:=true;
end
else if ppuan>0 then begin doy[sayac]:=tutoy; dpu[sayac]:=tutpu; end;
if sayac=kytsay then break;
end;
close(d1);
rewrite(d1);
for i:=1 to kytsay do
begin
writeln(d1,doy[i]); writeln(d1,dpu[i]);
end;
close(d1);
skortablosu;
end;

end;

procedure yemcikar;
begin
repeat
yem:=true;
yemx:=random(79); yemy:=random(48);
for i:=1 to n do
if (yemx=yilanx[i]) and (yemy=yilany[i]) then yem:=false;

if (yemx in [0,1]) or (yemy in [0,1]) then yem:=false; {duv2 yem engel}

if (duv=3) then if (yemy in [13,35]) and (yemx in [22..57])
or (yemx in [22,57]) and (yemy in [14..21]) {duv3 yem engel}
or (yemx in [22,57]) and (yemy in [27..34]) then yem:=false;

if (duv=4) and (yemy in [9..38]) then
if (yemx in [16,26,36,46,56,66]) then yem:=false; {duv4 yem engel}

if (yemy in [1,80]) or (yemx in [1..22,61..79])
and (yemy in [18,33]) or (yemy in [1..17,34..48])
and (yemx in [1,80]) then yem:=false; {duv5 yem engel}

until yem=true;
gotoxy(yemx,yemy); write('*');
end;

procedure puanlama;
begin
gotoxy(70,49);
write('PUAN=',puan);
puan:=puan+10;
end;

procedure harmenu(adet:byte; m1,m2,m3,m4,m5,m6:string);
var
x,y:byte;
tus:char;
b:boolean;
procedure giris;
begin
repeat
tus:=readkey;
b:=false;
if tus=#27 then halt;
if tus=#13 then b:=true;
if tus=#0 then
begin
tus:=readkey;
if tus=#80 then begin if c=adet then c:=1 else c:=c+1; end;
if tus=#72 then begin if c=1 then c:=adet else c:=c-1; end;
end;
until tus in [#72,#80,#13];
end;

procedure menu;
begin
renk(white,black);
gotoxy(32,15); write(m1);
gotoxy(32,16); write(m2);
gotoxy(32,17); write(m3);
gotoxy(32,18); write(m4);
gotoxy(32,19); write(m5);
gotoxy(32,20); write(m6);
end;

begin
menu; c:=1;
repeat
if c=1 then begin gotoxy(32,15); renk(1,7); write(m1);
giris; menu; continue; end;
if c=2 then begin gotoxy(32,16); renk(1,7); write(m2);
giris; menu; continue; end;
if c=3 then begin gotoxy(32,17); renk(1,7); write(m3);
giris; menu; continue; end;
if c=4 then begin gotoxy(32,18); renk(1,7); write(m4);
giris; menu; continue; end;
if c=5 then begin gotoxy(32,19); renk(1,7); write(m5);
giris; menu; continue; end;
if c=6 then begin gotoxy(32,20); renk(1,7); write(m6);
giris; menu; continue; end;

until b;

end; {harmenu}

begin {ana program}
randomize;
duv:=1;
repeat {sona}
R.CH:=31;
R.CL:=0;
R.Ah:=1;
R.Al:=0;
INTR($10,R);

clrscr;
puan:=0; yanma:=false;
repeat
clrscr;
cerceve(28,12,48,22);
harmenu(5,'Yeni oyun..','Seviye..','Ses..','Duvarlar','Skor tablasi','');
if c=1 then break;
if c=2 then
begin
clrscr;
cerceve(28,12,48,24);
harmenu(6,'Seviye 1','Seviye 2','Seviye 3','Seviye 4','Seviye 5','Seviye 6');
d:=true;
case c of
1 : hiz:=8500;
2 : hiz:=7000;
3 : hiz:=5500;
4 : hiz:=4000;
5 : hiz:=2400;
6 : hiz:=1750;
end;
c:=2;
end;
if c=3 then
begin
clrscr;
cerceve(28,12,48,20);
harmenu(2,'A?ik','Kapali','','','','');
if c=1 then ses:=false;
if c=2 then ses:=True;
end;
if c=4 then
begin
clrscr;
cerceve(28,12,48,22);
harmenu(5,'Duvar yok','Duvar1','Duvar2','Duvar3','Duvar4','');
duv:=c;
end;
if c=5 then skortablosu;
until 1=2;

if d=false then hiz:=3500;
clrscr;
if duv=2 then cerceve(1,1,80,49);
if duv=3 then duv2;
if duv=4 then duv3;
if duv=5 then duv4;

puanlama;
gotoxy(2,22);
write(#9#9#9#9#9);
n:=5; yemsay:=5;

yemcikar;
for i:=2 to n+1 do
begin yilanx[i-1]:=i; yilany[i-1]:=22; end; {baslangi? yilani}

repeat tus:=readkey;
if tus=#0 then tus:=readkey;
until ord(tus) in [72,77,80];

repeat {d?ng? basi}

if ord(tus) in [72,75,77,80] then
begin

gotoxy(yilanx[1],yilany[1]); write(' '); {silme}

for i:=1 to n-1 do
begin
yilanx[i]:=yilanx[i+1]; {kuyruk degeri artirma}
yilany[i]:=yilany[i+1];
end;

if tus=#77 then yilanx[n]:=yilanx[n]+1;
if tus=#75 then yilanx[n]:=yilanx[n]-1; {bas degeri artirma}
if tus=#72 then yilany[n]:=yilany[n]-1;
if tus=#80 then yilany[n]:=yilany[n]+1;

if duv in [1,3,4] then
begin
if yilanx[n]=1 then yilanx[n]:=79;
if yilanx[n]=80 then yilanx[n]:=2;
if yilany[n]=1 then yilany[n]:=48; {duvar yok}
if yilany[n]=49 then yilany[n]:=2;
end;
if (duv=2) and (yilanx[n] in [1,80]) or (yilany[n] in [1,49]) then
yanma:=true; {yanma kenarlara}
if (duv=3) then if (yilany[n] in [13,35]) and (yilanx[n] in [22..57])
or (yilanx[n] in [22,57]) and (yilany[n] in [14..21])
or (yilanx[n] in [22,57]) and (yilany[n] in [27..34]) then
yanma:=true; {duvar2 yanma}
if (duv=4) and (yilany[n] in [9..38]) then
if (yilanx[n] in [16,26,36,46,56,66]) then
yanma:=true; {duvar3 yanma}

if duv=5 then
begin
if (yilanx[n]=1) and (yilany[n] in [19..32]) then
yilanx[n]:=79;
if (yilanx[n]=80) and (yilany[n] in [19..32]) then
yilanx[n]:=2; {duvar4 ge?is}

if (yilany[n] in [1,80]) or (yilanx[n] in [1..22,61..79])
and (yilany[n] in [18,33]) or (yilany[n] in [1..17,34..48])
and (yilanx[n] in [1,80]) then yanma:=true; {duvar4 yanma}
end;

for i:=1 to n-1 do
if (yilanx[n]=yilanx[i]) and (yilany[n]=yilany[i]) then
yanma:=true; {yanma kuyruga}
if yanma then break;

for i:=1 to n do
begin
gotoxy(yilanx[i],yilany[i]);
if i=n then write(' ')
else write(#9);

end; {ilerletme}

if k=true then begin yemcikar; k:=false end;

if (yilanx[n]=yemx) and (yilany[n]=yemy) then
begin
n:=n+1; k:=true; yilanx[n]:=yilanx[n-1]; yilany[n]:=yilany[n-1];
yemsay:=yemsay+1;
if ses=false then
begin
sound(180); delay(2000); nosound;
end;
puanlama;
end; {yem yeme}

{if (k=true) and (yemsay mod 10=0) then hiz:=hiz-500; hiz artirma
if hiz<1000 then hiz:=1000;}
delay(100); {yilan hizi}

if keypressed then
begin
tus1:=readkey;
if tus1=#0 then tus1:=readkey;
if ord(tus1) in [72,75,77,80,27] then a:=true
else a:=false;
if (ord(tus) in [72,80]) and (ord(tus1) in [72,80]) then a:=false;
if (ord(tus) in [75,77]) and (ord(tus1) in [75,77]) then a:=false;
end;
end;
if a=true then begin tus:=tus1; a:=false end;

until tus=#27;

if (yanma=true) and (ses=false) then begin sound(50); delay(5000); nosound; end;
clrscr;
cerceve(33,19,47,22);
gotoxy(34,20); write('OYUN BITTI');
gotoxy(34,21); write('Puaniniz:',puan-10); readln;
R.CH:=31;
R.CL:=31;
R.Ah:=1;
R.Al:=0;
INTR($10,R);
skor(puan-10);
until 1=2; {bastan}

end.