本人第二次发帖

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;
gd,gm:integer;

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
gd:=detect;
initgraph(gd,gm,'..\bgi');
getready;
play;
closegraph;
end.