Public feed
#602104
program SnakeByShoshan_2003_copyRIGHT;{last updated on 09-01-2005}
uses crt,wincrt,graph;
const
max=2000;
left='K';
down='P';
right='M';
up='H';
x=49;
y=49;
x2=589;
y2=429;
bstep=17;
mstep=13;
hstep=9;
type
pos=record
x:1..640;
y:1..480;
end;
ar=array[1..max]of pos;
var
snake:ar;
ball,head,pos0:pos;
size,i,j:smallint;
hscr:word;{DONT FORGET TO THIS (high score)}
f:text; { }
gd,gm:integer;
c,tempchar:char;
fleg:boolean;
timestep,step:byte;
temp:string[10];
width :1..640;
height:1..480;
procedure doball(ps:pos;step:byte);
const
bll:array[0..8,0..8]of byte=(
(00,00,00,00,10,10,00,00,00),
(00,00,00,00,10,00,00,00,00),
(00,00,00,12,00,12,00,00,00),
(00,12,12,12,12,12,12,12,00),
(12,12,12,12,12,12,12,12,12),
(12,12,12,12,12,12,12,12,12),
(12,12,12,12,12,12,12,12,12),
(00,00,12,12,12,12,12,15,00),
(00,00,00,00,12,12,00,00,00));
bll1:array[0..12,0..12]of byte=(
(00,00,00,00,00,00,10,10,00,00,00,00,00),
(00,00,00,00,00,00,10,00,00,00,00,00,00),
(00,00,00,00,00,12,10,12,12,00,00,00,00),
(00,00,00,12,12,12,12,12,12,12,00,00,00),
(00,00,12,12,12,12,12,12,12,12,12,00,00),
(00,12,12,12,12,12,12,12,12,12,12,12,00),
(12,12,12,12,12,12,12,12,12,12,12,12,12),
(12,12,12,12,12,12,12,15,12,12,12,12,12),
(12,12,12,12,12,12,12,12,12,12,12,12,12),
(12,12,12,12,12,12,12,12,12,12,12,12,12),
(00,12,12,12,12,12,12,12,12,12,12,12,00),
(00,00,00,12,12,12,12,12,12,12,00,00,00),
(00,00,00,00,00,12,12,12,00,00,00,00,00));
bll2:array[0..16,0..16]of byte=(
(00,00,00,00,00,00,00,00,10,10,10,00,00,00,00,00,00),
(00,00,00,00,00,00,00,00,10,10,00,00,00,00,00,00,00),
(00,00,00,00,00,00,00,00,10,00,00,00,00,00,00,00,00),
(00,00,00,00,00,00,00,00,10,00,00,00,00,00,00,00,00),
(00,00,00,00,00,12,12,12,12,12,12,12,00,00,00,00,00),
(00,00,00,00,12,15,12,12,12,12,12,12,12,12,00,00,00),
(00,00,12,12,12,12,12,12,12,12,12,12,12,12,12,00,00),
(00,12,12,12,12,12,12,15,12,12,12,12,12,12,12,12,00),
(00,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,00),
(12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12),
(12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12),
(12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12),
(00,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,00),
(00,12,12,12,12,12,12,12,12,12,12,12,12,12,12,12,00),
(00,00,12,12,12,12,12,12,12,12,12,12,12,12,12,00,00),
(00,00,00,12,12,12,12,12,12,12,12,12,12,12,00,00,00),
(00,00,00,00,00,12,12,12,12,12,12,12,00,00,00,00,00));
var
i,j:byte;
begin
case step of
bstep:
for i:=0 to bstep-1 do
for j:=0 to bstep-1 do
putpixel(ps.x+j,ps.y+i,bll2[i,j]);
mstep:
for i:=0 to mstep-1 do
for j:=0 to mstep-1 do
putpixel(ps.x+j,ps.y+i,bll1[i,j]);
hstep:
for i:=0 to hstep-1 do
for j:=0 to hstep-1 do
putpixel(ps.x+j,ps.y+i,bll[i,j]);
end;
end;
function isthere(head:pos;snake:ar;long:smallint):boolean;
var
i:smallint;
fleg:boolean;
begin
fleg:=false;
for i:=1 to long do
if (head.x=snake[i].x)and((head.y=snake[i].y)) then
begin
fleg:=true;
i:=long;
end;
isthere:=fleg;
end;
procedure dosnk(ps:pos;step:byte);
const
snk:array[0..8,0..8]of byte=(
(00,10,10,10,10,10,10,10,00),
(10,00,00,10,10,10,00,00,10),
(10,00,10,00,00,00,10,00,10),
(10,10,00,12,12,12,00,10,10),
(10,10,00,12,12,12,00,10,10),
(10,10,00,12,12,12,00,10,10),
(10,00,10,00,00,00,10,00,10),
(10,00,00,10,10,10,00,00,10),
(00,10,10,10,10,10,10,10,00));
snk1:array[0..12,0..12]of byte=(
(00,10,10,10,10,10,10,10,10,10,10,10,00),
(10,00,00,00,00,10,10,10,00,00,00,00,10),
(10,00,00,00,10,00,00,00,10,00,00,00,10),
(10,00,00,10,00,12,12,12,00,10,00,00,10),
(10,00,10,00,12,12,12,12,12,00,10,00,10),
(10,10,00,12,12,12,12,12,12,12,00,10,10),
(10,10,12,12,12,12,12,12,12,12,12,10,10),
(10,10,00,12,12,12,12,12,12,12,00,10,10),
(10,00,10,00,12,12,12,12,12,00,10,00,10),
(10,00,00,10,00,12,12,12,00,10,00,00,10),
(10,00,00,00,10,00,00,00,10,00,00,00,10),
(10,00,00,00,00,10,10,10,00,00,00,00,10),
(00,10,10,10,10,10,10,10,10,10,10,01,00));
snk2:array[0..16,0..16]of byte=(
(00,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,00),
(00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,00,10),
(10,00,00,00,00,00,10,10,10,10,10,00,00,00,00,00,10),
(10,00,00,00,10,10,00,00,00,00,00,10,10,00,00,00,10),
(10,00,10,10,00,00,00,12,12,12,00,00,00,10,10,00,10),
(10,10,00,00,00,12,12,12,12,12,12,12,00,00,00,10,10),
(10,10,00,12,12,12,12,12,12,12,12,12,12,12,00,10,10),
(10,10,00,12,12,12,12,12,12,12,12,12,12,12,00,10,10),
(10,10,00,12,12,12,12,12,12,12,12,12,12,12,00,10,10),
(10,10,00,12,12,12,12,12,12,12,12,12,12,12,00,10,10),
(10,10,00,12,12,12,12,12,12,12,12,12,12,12,00,10,10),
(10,10,00,12,12,12,12,12,12,12,12,12,12,12,00,10,10),
(10,10,00,12,12,12,12,12,12,12,12,12,12,00,00,10,10),
(10,00,10,00,00,00,00,12,12,12,00,00,00,00,10,00,10),
(10,00,00,10,10,10,00,00,00,00,00,10,10,10,00,00,10),
(10,00,00,00,00,00,10,10,10,10,10,00,00,00,00,00,10),
(00,10,10,10,10,10,10,10,10,10,10,10,10,10,10,10,00));
var
i,j:byte;
begin
case step of
bstep:
for i:=0 to bstep-1 do
for j:=0 to bstep-1 do
putpixel(ps.x+j,ps.y+i,snk2[i,j]);
mstep:
for i:=0 to mstep-1 do
for j:=0 to mstep-1 do
putpixel(ps.x+j,ps.y+i,snk1[i,j]);
hstep:
for i:=0 to hstep-1 do
for j:=0 to hstep-1 do
putpixel(ps.x+j,ps.y+i,snk[i,j]);
end;
end;
procedure doitall;
{ B E G I N ! ! ! } begin { }
randomize;
assign(f,'high-score.txt');
{$I-}
reset(f);
if IOResult=0 then
begin
readln(f,temp);
val(temp,hscr);
end;
{$I+}
for i:=1 to max do
snake[i].x:=640;
clrscr;
textcolor(15);
writeln('By Shoshan ... All Rights Reserved !!!');
writeln;
gd:=vga;
gm:=vgahi;
initgraph(gd,gm,'c:/pp/new/bgi/');
setbkcolor(0);
cleardevice;
settextstyle(10,0,4);
setcolor(10);
outtextxy(10,50,'Instructions :');
setcolor(15);
settextstyle(0,0,2);
outtextxy(50,100,'Right .......... - (right)');
outtextxy(50,125,'Left .......... - (left )');
outtextxy(50,150,'Up .......... (up )');
outtextxy(50,175,'Down .......... (down )');
outtextxy(50,200,'Turbo .......... T');
outtextxy(50,225,'Auto .......... A');
outtextxy(50,250,'Stop .......... S');
outtextxy(50,275,'Exit .......... Esc');
c:=readkey;
cleardevice;
settextstyle(10,0,4);
setcolor(10);
outtextxy(50,50,'Choose A Level :');
setcolor(15);
settextstyle(10,0,3);
outtextxy(215,120,'E');
settextstyle(0,0,2);
outtextxy(240,130,'asy');
settextstyle(10,0,3);
outtextxy(215,205,'M');
settextstyle(0,0,2);
outtextxy(240,215,'edium');
settextstyle(10,0,3);
outtextxy(215,270,'H');
settextstyle(0,0,2);
outtextxy(240,280,'ard');
setcolor(12);
settextstyle(10,0,1);
outtextxy(50,getmaxy-50,'By Shoshan --- psclil@gmail.com --- ');
setcolor(15);
settextstyle(0,0,0);
c:='L';
repeat
c:=upcase(readkey);
case c of
'E':begin
step:=bstep;
timestep:=120;
end;
'M':begin
step:=mstep;
timestep:=65;
end;
'H':begin
step:=hstep;
timestep:=35;
end;
end;
if (c='E')or(c='M')or(c='H') then
begin
gd:=timestep;
size:=10;
width :=(x2-x)div step-1;
height:=(y2-y)div step-1;
end;
until (c='E')or(c='M')or(c='H');
{ }
cleardevice;
outtextxy(5,5,' SCORE : 0 points');
str(hscr,temp);
outtextxy(5,15,' RECORD: '+temp+' points');
line(x,y,x2,y);
line(x,y2,x2,y2);
line(x,y,x,y2);
line(x2,y,x2,y2);
head.y:=y+1;
head.x:=x+1;
c:=right;
fleg:=false;{DO NOT CHANGE !!!!!}
ball.x:=x+1+random(width)*step;
ball.y:=y+1+random(height)*step;
doball(ball,step);
{* * * * * * * * * * * }
{ * * * * * * * * * * * * * * * * * * * * * }
{ * * * * * * * * * * * * * * * * * * * * * }
{ * * * * * * * * * * *}
tempchar:=right;
while not(fleg) do
begin
if keypressed then
tempchar:=upcase(readkey);
case tempchar of
up:if(c<>down)then c:=tempchar;
down:if(c<>up)then c:=tempchar;
left:if(c<>right)then c:=tempchar;
right:if(c<>left)then c:=tempchar;
'/':begin
tempchar:='L';
size:=size+1;
end;
'T':begin
if gd=timestep then
timestep:=2
else
timestep:=gd;
tempchar:=c;
end;
'A':begin {'+' MEANS AUTO MOVE BUT THE COMPUTER IN SUTUPID}
{ SO IT'LL SELF DESTRUCT!}
if (head.x>ball.x)and(C<>right) then
c:=left
else
if (head.x<ball.x)and(C<>left) then
c:=right
else
if (head.y>ball.y)and(c<>down) then
c:=up
else
c:=down;
case c of
up :begin
pos0:=head;
pos0.y:=pos0.y-step;
if isthere(pos0,snake,size) then
begin
pos0:=head;
pos0.x:=pos0.x+step;
if (not(isthere(pos0,snake,size))) then
if head.x>=ball.x then
c:=right
else
c:=left
else
c:=left;
end;
end;
down :begin
pos0:=head;
pos0.y:=pos0.y+step;
if isthere(pos0,snake,size) then
begin
pos0:=head;
pos0.x:=pos0.x+step;
if (not(isthere(pos0,snake,size))) then
if head.x>=ball.x then
c:=right
else
c:=left
else
c:=left;
end;
end;
right:begin
pos0:=head;
pos0.x:=pos0.x+step;
if isthere(pos0,snake,size) then
begin
pos0:=head;
pos0.y:=pos0.y-step;
if (not(isthere(pos0,snake,size))) then
if head.y<=ball.y then
c:=up
else
c:=down
else
c:=down;
end;
end;
left :begin
pos0:=head;
pos0.x:=pos0.x-step;
if isthere(pos0,snake,size) then
begin
pos0:=head;
pos0.y:=pos0.y-step;
if (not(isthere(pos0,snake,size))) then
if head.y<=ball.y then
c:=up
else
c:=down
else
c:=down;
end;
end;
end;{END OF CASE OF C}
end;{the + posibility}
'S':begin
tempchar:=c;
while upcase(readkey)<>'S' do
begin end;
end;
end;
case c of
up:head.y:=head.y-step;
down:head.y:=head.y+step;
left:head.x:=head.x-step;
right:head.x:=head.x+step;
end;
if head.x<x+1 then head.x:=x2+1-step;
if head.x>x2+1-step then head.x:=x+1;
if head.y<y+1 then head.y:=y2+1-step;
if head.y>y2+1-step then head.y:=y+1;
dosnk(head,step);
if ((head.x=ball.x)and(head.y=ball.y))or(getpixel(ball.x+7,ball.y+7)<>15) then
begin
setcolor(0);
outtextxy(69,5,'');
setcolor(15);
str(((size-9)*(18-step)),temp);
outtextxy(77,5,temp);
size:=size+1;
repeat
ball.x:=x+1+random(width)*step;
ball.y:=y+1+random(height)*step;
until not(isthere(ball,snake,size));
doball(ball,step);
end
else
begin
for i:=0 to step-1 do
for j:=0 to step-1 do
putpixel(snake[1].x+i,snake[1].y+j,0);
for i:=1 to size-1 do
snake[i]:=snake[i+1];
end;
fleg:=isthere(head,snake,size);
if fleg then
writeln('SNAKE ATE IT SELF !');
snake[size]:=head;
line(x,y2,x2,y2);
line(x2,y,x2,y2);
if fleg=false then
begin
fleg:=size>=max;
if fleg then
writeln('WOW - SNAKE GOT TO MAX SIZE !');
end;
if fleg=false then
begin
fleg:=tempchar='';
if fleg then
writeln('EXIT KEY Esc WAS PRESSED.');
end;
delay(timestep);
end;
closegraph;
if ((size-9)*(18-step))>hscr then
begin
rewrite(f);
writeln(f,((size-9)*(18-step)));
close(f);
end;
writeln;
writeln('SCORE : ',((size-10)*(18-step)));
if keypressed then readkey;
end; {END OF PROCEDURE DOITALL}
begin
repeat
doitall;
gotoxy(1,20);
writeln('would you like to play again (y/n) ?');
readln(temp);
gotoxy(1,21);
clreol;
until upcase(copy(temp,1,1))='N';
end.
{By Shoshan in a freepascal 7.0 compiler}