Игра "Змейка" ! Опции

[Clane]

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.

[Ivs]

А вот мой вариант этой игры:

Внимание
Исходник написан для исправленного модуля 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;