uses crt,graph; const x='x'; y='y'; var p:array['x'..'y',1..2000] of integer; i,j,l,x0,y0,len,ranx,rany,num,sk,speed:integer; esc,quit,pause:boolean; dir,newdir:byte; {=====================} function mkstr(a:longint):string; var s: string; begin str(a,s); mkstr := s; end; {---------------------} procedure newran; var r1,r2,r3,r4:integer; begin repeat ranx:=random(getmaxy) div 5 *5; rany:=random(getmaxy) div 5 *5; r1:=getpixel(ranx+5,rany); r2:=getpixel(ranx-5,rany); r3:=getpixel(ranx,rany+5); r4:=getpixel(ranx,rany-5); until ((ranx>7)and(ranx<getmaxy-7)and(rany>7)and(rany<getmaxy-7))and ((r1<>10)and(r2<>10)and(r3<>10)and(r4<>10)); end; {---------------------} procedure playing; BEGIN cleardevice; esc:=false; dir:=1; x0:=getmaxx div 2-200; y0:=getmaxy div 2; len:=20; num:=0;sk:=0;
setcolor(14); settextstyle(defaultfont,horizdir,2); outtextxy(getmaxx div 2 -250,getmaxy div 2 ,'SELECT THE SPEED: (0..9)...'); repeat speed:=ord(readkey)-48; until (speed<=9)and(speed>=0); outtextxy(getmaxx div 2 +185,getmaxy div 2,mkstr(speed)); delay(30000); cleardevice; setcolor(15); settextstyle(defaultfont,horizdir,1); outtextxy(getmaxx-100,30,'SPEED '); outtextxy(getmaxx-50,30,mkstr(speed)); outtextxy(getmaxx-100,15,'SKORE '); outtextxy(getmaxx-50,15,mkstr(0)); setcolor(12); outtextxy(getmaxx-150,250,'Press <Esc>'); outtextxy(getmaxx-150,265,'for exit'); outtextxy(getmaxx-150,300,'Press <Space>'); outtextxy(getmaxx-150,315,'for pause');
for i:=0 to 2000 do begin p[x,i]:=getmaxx; p[y,i]:=getmaxy; end;
repeat if keypressed then begin case readkey of #77: newdir:=1; #80: newdir:=2; #75: newdir:=3; #72: newdir:=4; #27:esc:=true; #32:pause:=true; end; if pause=true then begin pause:=false; repeat until keypressed; end; memw[0:$41a]:=memw[0:$41c]; end; if (newdir=1)and(dir<>3)then dir:=newdir; if (newdir=2)and(dir<>4)then dir:=newdir; if (newdir=3)and(dir<>1)then dir:=newdir; if (newdir=4)and(dir<>2)then dir:=newdir; case dir of 1: x0:=x0+5; 2: y0:=y0+5; 3: x0:=x0-5; 4: y0:=y0-5; end; p[x,1]:=x0; p[y,1]:=y0; for i:=len downto 2 do begin p[x,i]:=p[x,i-1]; p[y,i]:=p[y,i-1]; end; if (x0<=5)or(x0>=getmaxy-5)or(y0<=5)or(y0>=getmaxy-5) then esc:=true;
if (dir=1)and(getpixel(x0+5,y0)=10)then esc:=true; if (dir=2)and(getpixel(x0,y0+5)=10)then esc:=true; if (dir=3)and(getpixel(x0-5,y0)=10)then esc:=true; if (dir=4)and(getpixel(x0,y0-5)=10)then esc:=true;
if (((x0+10>=ranx)and(ranx>=x0-10))and((y0+10>=rany)and(rany>=y0-10)))then begin num:=num+1; setcolor(0); settextstyle(defaultfont,horizdir,1); outtextxy(getmaxx-51,15,'ЫЫЫЫЫ'); setcolor(15); outtextxy(getmaxx-50,15,mkstr(num)); len:=len+5; setfillstyle(solidfill,0); bar(ranx-5,rany-5,ranx+5,rany+5); newran; setfillstyle(solidfill,9); bar(ranx-5,rany-5,ranx+5,rany+5); end; setfillstyle(solidfill,10); bar(x0-4,y0-4,x0+4,y0+4); setfillstyle(solidfill,0); bar(p[x,len]-4,p[y,len]-4,p[x,len]+4,p[y,len]+4);
delay(3000-2500*speed div 9); until esc; END; {=====================} begin initgraph(i,i,''); randomize; esc:=false; playing; repeat setcolor(12); settextstyle(defaultfont,horizdir,4); outtextxy(getmaxx div 2 -250,getmaxy div 2,'GAME OVER'); setcolor(15); settextstyle(defaultfont,horizdir,2); outtextxy(getmaxx div 2 -250,getmaxy div 2 +100,'Play again? (y/n)...'); case readkey of 'y': playing; 'n': quit:=true; end; until quit; closegraph; end.
PutSymbol(SnakeX[Sections],SnakeY[Sections],' '); OldX:=SnakeX[Sections]; OldY:=SnakeY[Sections]; for i:=Sections downto 2 do begin SnakeX[i]:=SnakeX[i-1]; SnakeY[i]:=SnakeY[i-1]; end;
Case Direction of Up : Dec(HatY); Down : Inc(HatY); Right : Inc(HatX); Left : Dec(HatX); end; SnakeX[1]:=HatX; SnakeY[1]:=HatY; if Screen[HatY,HatX] in SetBonus then begin Inc(Sections); SnakeX[Sections]:=OldX; SnakeY[Sections]:=OldY; PutSymbol(OldX,OldY,SnaKeSym); PutBonus; Inc(Score,10); if Score=Speed*100 then begin Inc(Speed); ViewSpeed; Dec(Pause,LevSpeed); end; ViewScore; end else if Screen[HatY,HatX]<>' ' then begin DeathSnaKe; Assign(FileChamp,FileName); Reset(FileChamp); Seek(FileChamp,Num-1); Read(FileChamp,Work); Seek(FileChamp,Num-1); if Score > Work.Res then begin ShowCursor; TextBackGround(Blue); TextColor(ColorBord); DrawWindow(30,22,50,28); TextColor(White); Gotoxy(34,24);Write('Best Result!'); TextColor(ColorBord); Gotoxy(32,26);Write('Your Name: '); Readln(Work.Name); TextBackGround(Black); Work.Res:=Score; Write(FileChamp,Work); HideCursor; end; Close(FileChamp); iExit:=TRUE; Exit; end; TextColor(ColorHat); PutSymbol(HatX,HatY,SnaKeSym); TextColor(ColorSnaKe); PutSymbol(SnakeX[2],SnakeY[2],SnaKeSym);
end;
Procedure ClearResults; begin Assign(FileChamp,FileName); Reset(FileChamp); for i:=0 to 4 do begin Seek(FileChamp,i); with Work do begin Name:='none'; Res :=0; Write(FileChamp,Work); end; end; Close(FileChamp); end;
--------------------
Если вы хотите чаще встречаться с понравившейся девушкой установите ей Windows'95