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');
setcolor(14);
line(0,0,getmaxy,0);
line(0,0,0,getmaxy);
line(getmaxy,0,getmaxy,getmaxy);
line(0,getmaxy,getmaxy,getmaxy);
newran;
setfillstyle(solidfill,9);
bar(ranx-5,rany-5,ranx+5,rany+5);
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.
А вот мой вариант этой игры:
Внимание
Исходник написан для исправленного модуля CRT ,
там решена проблема с delay, поэтому не старайтесь запускать сразу, либо исправте везде задержку, что не есть хорошо, либо попросите меня скинуть вам пропатченый CRT.
I - часть:
(*=============================================*)
(* *)
(* The Snake Game *)
(* Copyright © 2003 by IvsSoft Corp. *)
(* Writen: Vladislav Isaev, IvsSoft Corp. *)
(* *)
(* Targets: *)
(* MS-DOS 16-bit real mode *)
(* OS/2 console application *)
(* WIN32 console application *)
(* *)
(*=============================================*)
PROGRAM THE_SNAKE;
(*=============================================*)
USES CRT;
CONST
FileName = 'BestRes.rec'; { Файл лучших результатов }
SetBonus : Set of Char = [#1,#2,#3,#4]; { Массив бонусов }
Up = 1; Right = 2; Down = 3; Left = 4; { Управляющие клавиши }
MaxSections = 255; { Максимальная длина змейки }
ScreenX = 80; { Длина поля по оси X }
ScreenY = 50; { Длина поля по оси Y }
SnaKeSym = #177; { Символ части тела змейки }
Bomb = #176; { Символ бомбочки на границе}
Bomb2 = #15; { Символ бомбочки на поле }
ColorSnaKe = LightGray; { Цвет тела змейки }
ColorHat = White; { Цвет головы змейки }
ColorBord = LightGray; { Цвет рамки }
ColorBomb = Cyan; { Цвет бомбочки на границе }
ColorBomb2 = Cyan; { Цвет бомбочки на поле }
Menu : Array[1..6] of string= { Массив элементов меню }
(
'[ Milksop. ]',
'[ Plug Up! ]',
'[ Die Hard ]',
'[ Yo-ho-ho ]',
'[ Best Result ]',
'[ Exit ]'
);
TYPE
Champ = Record { Запись для файла чемп. }
Name : String[8]; { Имя чемп. }
Res : Word; { Результат }
end;
VAR
FileChamp : File of Champ; { Файл Чемпионов }
Work : Champ; { Запись Чемпионов }
iExit : Boolean; { Для выхода из игры }
CurChoice : Byte; { Указатель на позицию меню }
Ch : Char; { Буфер для клавиш }
OrigMode : Integer; { Сохранение режима польз. }
i,j : Word; { Счетчики }
Direction : Word; { Направление движения }
HatX,HatY : Word; { Координаты головы змейки }
Sections : Word; { Количество секций }
Pause : Word; { Задержка }
ix,iy : Word; { Вспомогательные координаты}
CountBombs: Word; { Количество бомбочек }
OldX,OldY : Word; { Сохранение коорд. хвоста }
Bonus : Char; { Символ бонуса }
Score : Word; { Очки }
Speed : Word; { Скорость игры }
LevSpeed : Word; { Изменение скороти }
Num : Word; { Уровень }
SnakeX : Array [1..MaxSections] of Word; { Массив коорд. по оси X }
SnakeY : Array [1..MaxSections] of Word; { Массив коорд. по оси Y }
Screen : Array [1..50,1..80] of Char; { Массив экрана }
Procedure ShowCursor; Assembler;
asm
mov cx,$0E0F
mov ah,1
int $10
end;
Procedure HideCursor; Assembler;
asm
mov cx,$200
mov ah,1
int $10
end;
Procedure TitleText;
const Sn = #219;
var F : Text;
S : String[80];
begin
TextColor(Green);
Assign(F,'logo.res'); Reset(F);
j:=7;
while Not(Eof(F)) do
begin
Readln(F,S);
Gotoxy(10,j);
for i:=1 to length(S) do
begin
Case S[i] of
'1' : Write(Sn);
' ' : Write(' ');
end;
end;
Inc(j);
end;
TextColor(LightGray);
end;
II - часть
Procedure Border;
begin
TextColor(ColorBomb);
for i:=1 to 80 do
begin
Gotoxy(i, 1); Write(Bomb); Screen[ 1,i]:=Bomb;
Gotoxy(i, 3); Write(Bomb); Screen[ 3,i]:=Bomb;
Gotoxy(i,49); Write(Bomb); Screen[49,i]:=Bomb;
Gotoxy(i,47); Write(Bomb); Screen[47,i]:=Bomb;
end;
for i:=1 to 49 do
begin
Gotoxy(1, i); Write(Bomb); Screen[i, 1]:=Bomb;
Gotoxy(80,i); Write(Bomb); Screen[i,80]:=Bomb;
end;
TextColor(ColorSnaKe);
end;
Procedure DrawWindow(x1,y1,x2,y2:word);
const
LU = #201; RU = #187;
LD = #200; RD = #188;
H = #205; L = #186;
begin
Gotoxy(x1,y1); Write(LU); Gotoxy(x2,y1); Write(RU);
Gotoxy(x1,y2); Write(LD); Gotoxy(x2,y2); Write(RD);
for i:=x1+1 to x2-1 do
begin
Gotoxy(i,y1); Write(H);
Gotoxy(i,y2); Write(H);
end;
for i:=y1+1 to y2-1 do
begin
Gotoxy(x1,i); Write(L);
Gotoxy(x2,i); Write(L);
end;
Window(x1+1,y1+1,x2-1,y2-1); ClrScr; Window(1,1,80,50);
end;
Procedure Info;
begin
TextColor(LightMagenta);
Gotoxy(30, 2); Write('Speed : ',Speed:2);
Gotoxy(45, 2); Write('Score : ',Score:2);
TextColor(LightGreen);
Gotoxy( 3,48); Write('Version 1.0 beta');
Gotoxy(35,48); Write('The Snake !');
Gotoxy(62,48); Write('© IvsSoft Corp.');
TextColor(ColorSnaKe);
end;
Procedure ClearField;
begin
Window(2,4,79,46); ClrScr; Window(1,1,80,50);
for i:=4 to 46 do
for j:=2 to 79 do
Screen[i,j]:=' ';
end;
Procedure ViewScore;
begin
TextColor(LightMagenta);
Gotoxy(53,2); Write(Score:2);
TextColor(ColorSnaKe);
end;
Procedure ViewSpeed;
begin
TextColor(LightMagenta);
Gotoxy(38,2); Write(Speed:2);
TextColor(ColorSnaKe);
end;
Procedure PutSymbol(x,y : Word; Symbol : Char);
begin
if (x in [1..ScreenX]) and (y in [1..ScreenY]) then
begin
Gotoxy(x,y);
Write(Symbol);
Screen[y,x]:=Symbol;
end;
end;
Procedure PutBonus;
begin
repeat
ix:=Random(78)+2;
iy:=Random(42)+4;
until Screen[iY,iX]=' ';
Bonus:=Chr(Random(4)+1);
TextColor(Random(5)+10);
PutSymbol(ix,iy,Bonus);
TextColor(ColorSnake);
end;
Procedure CreateBombs;
begin
TextColor(ColorBomb2);
for i:=1 to CountBombs do
begin
repeat
ix:=Random(78)+2;
iy:=Random(42)+4;
until (Screen[iy,ix]=' ') and not(ix in [30..50]) and (iy<>25);
PutSymbol(ix,iy,Bomb2);
end;
TextColor(ColorSnaKe);
end;
Procedure InitSnake(x,y : Word);
begin
for i:=1 to Sections do
begin
SnakeX[i]:=i+X;
SnakeY[i]:=Y;
Screen[Y,i+X]:=SnaKeSym;
end;
HatX:=SnakeX[1];
HatY:=SnakeY[1];
end;
Procedure DeathSnaKe;
const Death : Array [1..6] of char = ('X','x','%',':','.',' ');
begin
for i:=1 to 6 do
begin
for j:=2 to Sections do
begin
Gotoxy(SnakeX[j],SnakeY[j]); Write(Death[i]);
end;
Delay(100);
end;
end;
Procedure BestResults;
begin
Assign(FileChamp,FileName);
Reset(FileChamp);
TextBackGround(Blue);
TextColor(ColorBord);
DrawWindow(26,20,54,40);
TextColor(White);
Gotoxy(34,20); Write(' Best Results ');
Gotoxy(30,23); Write('Level Name Score');
TextColor(LightGreen);
TextBackGround(Black);
Gotoxy(28,26); Write(' Milksop.:');
Seek(FileChamp,0); Read(FileChamp,Work); Write(Work.Name:8,Work.Res:7);
Gotoxy(28,28); Write(' Plug Up!:');
Seek(FileChamp,1); Read(FileChamp,Work); Write(Work.Name:8,Work.Res:7);
Gotoxy(28,30); Write(' Die Hard:');
Seek(FileChamp,2); Read(FileChamp,Work); Write(Work.Name:8,Work.Res:7);
Gotoxy(28,32); Write(' Yo-ho-ho:');
Seek(FileChamp,3); Read(FileChamp,Work); Write(Work.Name:8,Work.Res:7);
Close(FileChamp);
TextColor(White);
TextBackGround(Blue);
Gotoxy(31,37); Write('[ Press any key... ]');
Readkey;
TextBackGround(Black);
TextColor(ColorBord);
end;
III - часть
Procedure MoveSnake;
begin
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;
ну и наконец последняя IV часть:
BEGIN
FillChar(SnakeX,SizeOf(SnakeX),0);
FillChar(SnakeY,SizeOf(SnakeY),0);
FillChar(Screen,SizeOf(Screen),' ');
Assign(FileChamp,FileName);
{$I-}
Reset(FileChamp);
{$I+}
if IOresult<>0 then
begin
Rewrite(FileChamp);
Close(FileChamp);
ClearResults;
end else Close(FileChamp);
OrigMode:=LastMode;
TextMode(CO80 or Font8x8);
HideCursor;
Randomize;
REPEAT
TextColor(ColorBord);
DrawWindow(1,1,80,49);
TitleText;
TextBackGround(Blue);
DrawWindow(26,20,54,40);
TextColor(White);
Gotoxy(31,20);Write(' Choose Game Level ');
TextColor(LightGreen);
TextBackGround(Black);
Gotoxy(3,48); Write('Version 1.0 beta');
Gotoxy(62,48); Write('© IvsSoft Corp.');
j:=24;
CurChoice:=1;
for i:=1 to High(Menu) do
begin
Gotoxy(34,j);
Write(Menu[i]);
if j=30 then j:=34 else Inc(j,2);
end;
j:=24;
TextColor(Black); TextBackGround(Green);
Gotoxy(34,j);
Write(Menu[CurChoice]);
Repeat
if KeyPressed then
begin
Ch:=ReadKey;
if Ch=#0 then
begin
Case ReadKey of
{ Up } #72 : if CurChoice>0 then
begin
Gotoxy(34,j);
TextColor(LightGreen);
TextBackGround(Black);
Write(Menu[CurChoice]);
if j=34 then j:=30 else Dec(j,2);
Dec(CurChoice);
if CurChoice=0 then
begin
CurChoice:=High(Menu);
j:=36;
end;
Gotoxy(34,j);
TextColor(Black);
TextBackGround(Green);
Write(Menu[CurChoice]);
end;
{Down} #80 : if CurChoice <= High(Menu) then
begin
Gotoxy(34,j);
TextColor(LightGreen);
TextBackGround(Black);
Write(Menu[CurChoice]);
if j=30 then j:=34 else Inc(j,2);
Inc(CurChoice);
if CurChoice>High(Menu) then
begin
CurChoice:=1;
j:=24;
end;
Gotoxy(34,j);
TextColor(Black);
TextBackGround(Green);
Write(Menu[CurChoice]);
end;
end;
end;
end;
Until Ch=#13;
TextBackGround(Black);
TextColor(ColorSnaKe);
Repeat
CountBombs:=0;
Case CurChoice of
1 : begin CountBombs:= 0; LevSpeed:=1; end;
2 : begin CountBombs:= 3; LevSpeed:=3; end;
3 : begin CountBombs:= 7; LevSpeed:=4; end;
4 : begin CountBombs:=10; LevSpeed:=5; end;
5 : begin BestResults;ch:=#0; break end;
6 : Break;
end;
Num:=CurChoice;
ClearField;
iExit := FALSE; Speed:=1;
Direction:= Left; Score:= 0;
Sections := 4; Pause:=60;
CreateBombs;
for i:=1 to 5 do PutBonus;
Border;
Info;
TextColor(White);
Gotoxy(34,25); Write('Press Any Key...');
repeat until KeyPressed;
Gotoxy(34,25); Write(' ');
TextColor(ColorSnaKe);
InitSnake(40,25);
Repeat
if KeyPressed then
begin
Ch:=Readkey;
if Ch=#0 then
begin
Case Readkey of
{ UP } #72 : if Direction <> Down then Direction:= Up;
{Down} #80 : if Direction <> Up then Direction:= Down;
{ <- } #75 : if Direction <> Right then Direction:= Left;
{ -> } #77 : if Direction <> Left then Direction:= Right;
end
end else if Ch=#112 then repeat until keypressed;
end;
Delay(Pause);
MoveSnake;
Until (Ch=#27) OR iExit;
TextBackGround(Blue);
TextColor(ColorBord);
DrawWindow(30,22,50,28);
TextColor(White);
Gotoxy(36,24);Write('Game Over');
TextColor(ColorBord);
Gotoxy(32,26);Write('Play again (y/n) ?');
TextBackGround(Black);
repeat
Ch:=UpCase(readkey);
until (Ch='Y') or (Ch='N');
Until Ch='N';
UNTIL CurChoice = 6;
TextMode(OrigMode);
ShowCursor;
END.
Также её можно скачать http://sources.codenet.ru/index.php?path=incoming
Там еще есть процедура вывода logo'типа [TitleText] ,но её можно закоментировать, так как он находится в отдельном файле
Ivs, все права типа пренадлежат тебе?
а у меня всё равно круче!
http://wormball.narod.ru
У тебя станет круче, когда будет графический режим!
Да и не змейка это вовсе. А + к граф. режиму - хотя бы пару строк на асме ;)
графический режим - это мирская суета! крутизна ето когда до тебя ничего подобного не придумывали! к тому же у меня там есь целых 6(! ;D) строк на асме, правда они там мало помогают