uses crt,dos,graph;
type
  slist=^listnode;
  listnode=record
           x,y:integer;  direction:1..4;
           shape:pointer;
           front,next:slist;
           end;
  cakere=record
         x,y:integer;
         end;

const cn=5;
var
  snake,tail:slist;
  hs,bs,ts:array[1..4]of pointer;    cs:pointer;
  size,height,width,s1,t1,s2,t2,t:integer;
  cake:array[1..cn]of cakere;
  win,stop,pause:boolean;

function initialize:boolean;
var gd,gm:integer;
begin
  gd:=detect;
  initgraph(gd,gm,'');
  if graphresult<>grok then
     initialize:=false
     else initialize:=true
end;

procedure rotate;
var i,j:integer;     p:pointer;
begin
  for i:=0 to 14 do
   for j:=0 to 14 do
     putpixel(100+j,114-i,getpixel(i,j));
  getmem(p,size);  getimage(100,100,114,114,p^);
  putimage(0,0,p^,normalput);
end;

procedure drawheadshape;
var i:byte;
begin
  setactivepage(1);
  getmem(hs[1],size);
  line(7,0,0,9);  line(7,0,14,9); line(0,9,0,14); line(14,9,14,14);  line(0,14,14,14);
  setcolor(red);  circle(4,9,1);  circle(10,9,1);
  getimage(0,0,14,14,hs[1]^);
  for i:=2 to 4 do  begin
  getmem(hs[i],size);  rotate;   getimage(0,0,14,14,hs[i]^);     end;
  setactivepage(0);
end;

procedure drawbodyshape;
var i:byte;
begin
  setactivepage(1);
  getmem(bs[1],size);  cleardevice;  setcolor(white);
  line(7,0,0,9); line(7,0,14,9);  line(7,6,0,14);  line(7,6,14,14);
  getimage(0,0,14,14,bs[1]^);
  for i:=2 to 4 do  begin
  getmem(bs[i],size);  rotate;    getimage(0,0,14,14,bs[i]^);     end;
  setactivepage(0);
end;

procedure drawtailshape;
var i:byte;
begin
  setactivepage(1);
  getmem(ts[1],size); cleardevice;     setcolor(white);
  line(0,0,14,0);   line(0,0,7,14);  line(14,0,7,14);
  getimage(0,0,14,14,ts[1]^);
  for i:=2 to 4 do begin
  getmem(ts[i],size); rotate;     getimage(0,0,14,14,ts[i]^);  end;
  setactivepage(0);
end;

procedure drawcakeshape;
begin
  setactivepage(1);   cleardevice;
  getmem(cs,size);   setcolor(yellow);
  circle(7,7,6);     setfillstyle(2,yellow);
  floodfill(7,7,yellow);
  getimage(0,0,14,14,cs^);
  setactivepage(0);
end;

procedure drawbasicarea;
begin
  s1:=(640-width*15) div 2;        t1:=(480-height*15) div 2;
  s2:=s1+width*15-1;               t2:=t1+height*15-1;
  setlinestyle(0,0,thickwidth);     setcolor(green);
  line(s1-5,t1-5,s2+5,t1-5);       line(s2+5,t1-5,s2+5,t2+5);
  line(s2+5,t2+5,s1-5,t2+5);       line(s1-5,t2+5,s1-5,t1-5);
  moveto(s1-5,t2+10);
  setcolor(white);   outtext('Enter');  setcolor(darkgray);  outtext(' -start   ');
  setcolor(white);   outtext('Q');      setcolor(darkgray);  outtext(' -quit   ');
  setcolor(white);   outtext('P');      setcolor(darkgray);  outtext(' -pause   ');
end;

procedure getready;
begin
  size:=imagesize(0,0,14,14);
  drawheadshape;
  drawbodyshape;
  drawtailshape;
  drawcakeshape;
  height:=20;  width:=30;
  drawbasicarea;
end;

procedure initsnake;
var temp:slist;
begin
  new(temp);
  with temp^  do begin shape:=hs[4];   x:=2;   y:=1;    direction:=4    end;
  snake:=temp;
  new(temp);
  with temp^  do begin shape:=ts[4];   x:=1;   y:=1;
                       next:=nil;      front:=snake;
                       direction:=4    end;
  tail:=temp;   snake^.next:=tail;         snake^.front:=nil
end;

procedure listappend;
var temp:slist;
begin
  new(temp);
  with temp^ do  begin
     direction:=tail^.direction;     shape:=bs[direction];
     front:=tail^.front;             tail^.front^.next:=temp;
     next:=tail;
     x:=tail^.x;                     y:=tail^.y;
     end;
  case tail^.direction of
       1: tail^.y:=tail^.y+1 ;
       2: tail^.x:=tail^.x+1 ;
       3: tail^.y:=tail^.y-1 ;
       4: tail^.x:=tail^.x-1 ;
     end;
  tail^.front:=temp;
end;

procedure createcake(i:integer);
var k:integer;   n:integer;    b:boolean;    temp:slist;
begin
  repeat
   b:=true;
   n:=random(height*width)+1;
   for k:=1 to cn do
    if ((cake[k].y-1)*width+cake[k].x)=n then b:=false;
   temp:=snake;
   while temp<>nil do
   begin   if ((temp^.y-1)*width+temp^.x)=n then b:=false;
          temp:=temp^.next;end;
  until b;
  if n mod width=0 then cake[i].x:=width
                 else cake[i].x:=n mod width;
  cake[i].y:=n div width+1;
  putimage((cake[i].x-1)*15+s1,(cake[i].y-1)*15+t1,cs^,normalput);
end;

procedure timer(flags,cs,ip,ax,bx,cx,dx,si,di,ds,es,bp:word);interrupt;
var s:string;    key:char;            tt1,tt2:integer;
begin
  if keypressed then  begin
      key:=readkey;
      case key of
       #75    :if snake^.direction<>4 then begin snake^.direction:=2; snake^.shape:=hs[snake^.direction] end;
       #77    :if snake^.direction<>2 then begin snake^.direction:=4; snake^.shape:=hs[snake^.direction] end;
       #80    :if snake^.direction<>1 then begin snake^.direction:=3; snake^.shape:=hs[snake^.direction] end;
       #72    :if snake^.direction<>3 then begin snake^.direction:=1; snake^.shape:=hs[snake^.direction] end;
       'p','P':pause:=true;
       'q','Q':stop:=true;
      end   end;
  t:=t+1;
  setviewport(s2-50,t1-20,s2-10,t1-10,clipon);  clearviewport;
  setviewport(0,0,639,479,clipon);      moveto(s2-50,t1-20);
  str(t div 1080,s);
  if (t div 1080<10) then outtext('0');
  outtext(s);        outtext(':');
  str((t mod 1080)div 18,s);
  if ((t mod 1080)div 18<10) then outtext('0');
  outtext(s);
end;

procedure play;
var key:char;     i,j:integer;   temp:slist;
    cx,cy,dd:integer;     oldvec,newvec:pointer;
begin
  initsnake;     randomize;       win:=true;     stop:=false;  pause:=false;
  for i:=1 to cn do   createcake(i);
  cx:=1;  cy:=1;  dd:=4;  t:=0;
  getintvec($1c,oldvec);
  newvec:=@timer;
  setintvec($1c,newvec);
  repeat
    if pause then begin setintvec($1c,oldvec);  readln;
                        setintvec($1c,newvec);  pause:=false;
                  end;
    putimage((snake^.x-1)*15+s1,(snake^.y-1)*15+t1,snake^.shape^,normalput);
    if (cx>=1)and(cx<=width)and(cy>=1)and(cy<=height) then
    putimage((cx-1)*15+s1,(cy-1)*15+t1,ts[dd]^,xorput);
    cx:=tail^.x;    cy:=tail^.y;        dd:=tail^.direction;
    temp:=tail;
    while temp^.front<>nil do
      begin   with temp^ do begin
              if (x>=1)and(x<=width)and(y>=1)and(y<=height)
                then putimage((x-1)*15+s1,(y-1)*15+t1,shape^,normalput);
              x:=front^.x;   y:=front^.y;
              direction:=front^.direction;
              shape:=bs[direction];  end;
              temp:=temp^.front     end;
    tail^.shape:=ts[tail^.direction];
    case snake^.direction of
      1:snake^.y:=snake^.y-1;
      2:snake^.x:=snake^.x-1;
      3:snake^.y:=snake^.y+1;
      4:snake^.x:=snake^.x+1;
      end;
    for i:=1 to cn do
      if (snake^.x=cake[i].x)and(snake^.y=cake[i].y)
      then  begin listappend;   createcake(i)  end;
    temp:=snake^.next;
    while temp<>nil do
      begin if (temp^.x=snake^.x)and(temp^.y=snake^.y) then
          begin stop:=true;  win:=false; exit end; temp:=temp^.next;  end;
    if (snake^.x<1)or(snake^.x>width)or(snake^.y<1)or(snake^.y>height)
     then begin  win:=false;  exit;  end;
  delay(300);
  until stop=true;
  setintvec($1c,oldvec);
end;

begin
  if not initialize then exit;
  getready;
  play;
  closegraph
end.