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.
Ivs
26.03.2003 16:08
А вот мой вариант этой игры:
Внимание Исходник написан для исправленного модуля CRT , там решена проблема с delay, поэтому не старайтесь запускать сразу, либо исправте везде задержку, что не есть хорошо, либо попросите меня скинуть вам пропатченый 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 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;
Ivs
26.03.2003 16:10
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 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;
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;
Ivs
26.03.2003 16:17
ну и наконец последняя 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;
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.
Ivs
26.03.2003 16:24
Также её можно скачать здесь Там еще есть процедура вывода logo'типа [TitleText] ,но её можно закоментировать, так как он находится в отдельном файле
У тебя станет круче, когда будет графический режим!
GLuk
8.04.2003 22:19
Да и не змейка это вовсе. А + к граф. режиму - хотя бы пару строк на асме ;)
wormball
12.04.2003 19:51
графический режим - это мирская суета! крутизна ето когда до тебя ничего подобного не придумывали! к тому же у меня там есь целых 6(! ;D) строк на асме, правда они там мало помогают
Это текстовая версия — только основной контент. Для просмотра полной версии этой страницы, пожалуйста, нажмите сюда.