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}