Hra Snake v pascale

{ SNAKE.PAS                                   Copyright (c) Mohamad }
{                                                                   }
{ Hra had. Mate za ulohu zbierat rozhadzane cisla. Kazdym zjedenym  }
{ cislom sa predlzi chvost hada. Pozor nesmiete za zahryznut do     } 
{ vlastneho chvosta.                                                }
{                                                                   }
{ Author: Mohamad                                                   }
{ Date  : 18.12.2006                           http://www.trsek.com }
 
program SNAKE;
uses crt;
type
 
TWORM=record
      L:byte;
      W:array [1..46,1..2]of integer;
      EOG:boolean;
      D:INTEGER;
      end;
var
 N:integer;
 S:byte;
 K:byte;
 MW:TWORM;
 C:char;
 F:boolean;
 I, J:integer;
 SCREEN:array[1..25,1..80] of word absolute $B800:0000;
 
{This instruction will read your key}
function FUN_KEY (var C:char):boolean;
begin
   FUN_KEY:=FALSE;
   F:=FALSE;
    C:=Readkey;
   if C=#0 then begin
                   FUN_KEY:=true;
                   F:=TRUE;
                   C:=readkey;
                   end;
end;
 
procedure INIT;
var
X,Y:integer;
I:integer;
begin
for I:=1 to 23 do
    for J:=1 to 73 do
     SCREEN[I,J]:=15*256+219;
     for I:=1 to 25 do
     for J:=74 to 80 do
     SCREEN[I,J]:=0;
    for I:=24 to 25 do
    for J:=1 to 80 do
    SCREEN[I,J]:=0;
     end;
 
{****************************************************************
{******************************************************************}
procedure SETSEED(S:byte);
var
X,Y:byte;
begin
  randomize;
  X:=random(23)+1;
  Y:=random(73)+1;
  while SCREEN[X,Y]<>15*256+219 do
  begin
    X:=random(23)+1;
    Y:=random(73)+1;
  end;
  SCREEN[X,Y]:=4*256+(48+S);
end;
 
procedure NGAME;
begin
randomize;
  INIT;
  MW.L:=1;
  MW.W[1,1]:=22;
  MW.W[1,2]:=40;
  K:=0;
  S:=1;
  MW.D:=1;
  SETSEED(S);
  N:=N div 2;
end;
 
{*******************************************************************}
procedure MOVE;
begin
   SCREEN[MW.W[MW.L,1],MW.W[MW.L,2]]:=15*256+219;
   if K>0 then
   begin
      MW.L:=MW.L+1;
      dec(K);
      end;
 
   for J:=MW.L downto 2 do
   begin
   MW.W[J,1]:=MW.W[J-1,1];
   MW.W[J,2]:=MW.W[J-1,2];
    SCREEN[MW.W[J,1],MW.W[J,2]]:=11*256+7;
   end;
 
   if MW.D= 1 then begin
                      if MW.W[1,1]=1 then MW.W[1,1]:=24;
                      MW.W[1,1]:=MW.W[1,1]-1;
                      end
   else if MW.D= 2 then begin
                      if MW.W[1,1]=23 then MW.W[1,1]:=0;
                      MW.W[1,1]:=MW.W[1,1]+1;
                      end
   else if MW.D= 3 then begin
                      if MW.W[1,2]=73 then MW.W[1,2]:=0;
                      MW.W[1,2]:=MW.W[1,2]+1;
                      end
   else  if MW.D= 4 then begin
                      if MW.W[1,2]=1 then MW.W[1,2]:=74;
                      MW.W[1,2]:=MW.W[1,2]-1;
                      end;
   if SCREEN[MW.W[1,1],MW.W[1,2]]=11*256+7 then
   begin
   gotoxy(1,24);
   textcolor(green);
   write('Game Over...');
   delay(100);
   MW.EOG:=false;
   end;
   if SCREEN[MW.W[1,1],MW.W[1,2]]=4*256+(48+S) then
   begin
   MW.L:=MW.L+1;
   K:=S-1+K;
   inc(S);
   MW.W[MW.L,1]:=MW.W[MW.L-1,1];
   MW.W[MW.L,2]:=MW.W[MW.L-1,2];
   if S=10 then NGAME
   else SETSEED(S);
   end
   else SCREEN[MW.W[1,1],MW.W[1,2]]:=3*256+42;
end;
 
{****************************************************************}
procedure EVENT(C:char;F:boolean);
begin
   if F and (C=#72) then
   if MW.D<>2 then MW.D:=1;
   if F and (C=#80) then
   if MW.D<>1 then MW.D:=2;
   if F and (C=#77) then
   if MW.D<>4 then MW.D:=3;
   if F and (C=#75) then
   if MW.D<>3 then MW.D:=4;
end;
 
{***************************************************************}
begin
  Randomize;
  INIT;
 
  FOR I:=2 to 46 do
  begin
  MW.W[I,1]:=1;
  MW.W[I,2]:=1;
  end;
 
  MW.L:=1;
  MW.W[1,1]:=22;
  MW.W[1,2]:=40;
  MW.D:=1;
  MW.EOG:=true;
  S:=1;
  SETSEED(S);
  N:=60;
 
  while (MW.EOG and not((not F) and (C=#27))) do
  begin
    MOVE;
    if keypressed then F:=FUN_KEY(C);
       EVENT(C,F);
       mem[$40:$1C]:=mem[$40:$1A];
       delay(N);
  end;
end.